diff --git a/LeanPool.lean b/LeanPool.lean index 194c50053d..a3d9db40cc 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -5582,6 +5582,26 @@ import LeanPool.PentagonalNumberTheorem.Generic import LeanPool.PentagonalNumberTheorem.Old import LeanPool.PentagonalNumberTheorem.Partition import LeanPool.PentagonalNumberTheorem.PowerSeries +import LeanPool.PentagonalNumberTheoremAnalytic +import LeanPool.PentagonalNumberTheoremAnalytic.Franklin +import LeanPool.PentagonalNumberTheoremAnalytic.Franklin.Defs +import LeanPool.PentagonalNumberTheoremAnalytic.Franklin.FormalPowerSeries +import LeanPool.PentagonalNumberTheoremAnalytic.Franklin.Helpers +import LeanPool.PentagonalNumberTheoremAnalytic.Franklin.Lemmas +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.CauchyIdentity +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.Defs +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.EulerIdentities +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.FPS +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.FPSAlgebra +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.FPSEuler +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.FiniteBinomial +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.InfPochhammer +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.JTPAnalytic +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.JTPCore +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.JTPKeyIdentity +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.JacobiTripleProduct +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.PentagonalNumber import LeanPool.PermanentFormulaLowerBound import LeanPool.PhaseRetrieval import LeanPool.PhaseRetrieval.Constant diff --git a/LeanPool/PentagonalNumberTheoremAnalytic.lean b/LeanPool/PentagonalNumberTheoremAnalytic.lean new file mode 100644 index 0000000000..ae4bc9f695 --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic.lean @@ -0,0 +1,19 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ + +import LeanPool.PentagonalNumberTheoremAnalytic.Franklin +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries + +/-! +# Euler's pentagonal number theorem, two independent proofs, and the Jacobi triple product + +Source: url:https://viazovska.github.io/PentagonalNumberTheorem +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +Status: verified +Main declarations: `PentagonalNumberTheorem.Franklin.euler_pentagonal_number_theorem_packaged` +Tags: number-theory, partitions, q-series, pentagonal-number-theorem, jacobi-triple-product +MSC: 11P81, 11P84, 05A17, 05A19, 33D15 +-/ diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/Franklin.lean b/LeanPool/PentagonalNumberTheoremAnalytic/Franklin.lean new file mode 100644 index 0000000000..59f0c5055b --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/Franklin.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ + +import LeanPool.PentagonalNumberTheoremAnalytic.Franklin.Defs +import LeanPool.PentagonalNumberTheoremAnalytic.Franklin.FormalPowerSeries +import LeanPool.PentagonalNumberTheoremAnalytic.Franklin.Helpers +import LeanPool.PentagonalNumberTheoremAnalytic.Franklin.Lemmas diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/Franklin/Defs.lean b/LeanPool/PentagonalNumberTheoremAnalytic/Franklin/Defs.lean new file mode 100644 index 0000000000..1155dffcde --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/Franklin/Defs.lean @@ -0,0 +1,126 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import Mathlib.Algebra.BigOperators.Group.Finset.Basic +import Mathlib.Algebra.BigOperators.Ring.Finset +import Mathlib.Algebra.Order.BigOperators.Group.Finset +import Mathlib.Combinatorics.Enumerative.Partition.GenFun +import Mathlib.Data.Finset.Powerset +import Mathlib.Data.Nat.Choose.Basic +import Mathlib.Order.Interval.Finset.Nat +import Mathlib.RingTheory.PowerSeries.Basic +import Mathlib.RingTheory.PowerSeries.PiTopology +import Mathlib.Tactic.Linarith +import Mathlib.Tactic.Ring +import Mathlib.Tactic.FieldSimp +import Mathlib.Tactic.Positivity + +/-! +# Pentagonal Number Theorem — Definitions + +Core definitions for the formalization of the Euler Pentagonal Number Theorem +via Franklin's involution. + +## Main definitions + +* `consecutiveTopRun`: length of the maximal consecutive run ending at `m` in `S` +* `distinctPartitions`: partitions of `n` into distinct positive parts +* `distinctPartitionsEven`, `distinctPartitionsOdd`: partitions with an even (resp. odd) + number of parts +* `pe`, `po`: cardinalities of `distinctPartitionsEven n`, `distinctPartitionsOdd n` +* `partBase`, `partMax`, `partSlope`, `partSlopeSet`: structural invariants of a partition +* `distinctPartitionsAlpha`, `distinctPartitionsBeta`, `distinctPartitionsSpecial`: + three-way decomposition of `distinctPartitions n` by Franklin's involution +* `smkSet`, `spkSet`: the special pentagonal partitions `S_{−k}` and `S_k` +* `alphaOp`, `betaOp`: Franklin's involution maps on `distinctPartitionsAlpha` and + `distinctPartitionsBeta` +-/ +open Finset + +namespace PentagonalNumberTheorem.Franklin + +/-- The length of the maximal consecutive run of elements of `S` ending at `m`, counted downward. -/ +def consecutiveTopRun (S : Finset ℕ) : ℕ → ℕ + | 0 => if (0 : ℕ) ∈ S then 1 else 0 + | m + 1 => if m + 1 ∈ S then 1 + consecutiveTopRun S m else 0 + +/-- The set of subsets `S ⊆ {1, …, n}` with `∑_{s ∈ S} s = n`, i.e., partitions of `n` into +distinct positive parts. -/ +def distinctPartitions (n : ℕ) : Finset (Finset ℕ) := + (Icc 1 n).powerset.filter (fun S ↦ S.sum id = n) + +/-- Partitions of `n` into distinct positive parts with an even number of parts. -/ +def distinctPartitionsEven (n : ℕ) : Finset (Finset ℕ) := + (distinctPartitions n).filter (fun S ↦ S.card % 2 = 0) + +/-- Partitions of `n` into distinct positive parts with an odd number of parts. -/ +def distinctPartitionsOdd (n : ℕ) : Finset (Finset ℕ) := + (distinctPartitions n).filter (fun S ↦ S.card % 2 = 1) + +/-- Number of partitions of `n` into an even number of distinct positive parts. -/ +def pe (n : ℕ) : ℕ := (distinctPartitionsEven n).card + +/-- Number of partitions of `n` into an odd number of distinct positive parts. -/ +def po (n : ℕ) : ℕ := (distinctPartitionsOdd n).card + +/-- The smallest element of a partition, returning 0 for the empty set. -/ +def partBase (S : Finset ℕ) : ℕ := + if h : S.Nonempty then S.min' h else 0 + +/-- The largest element of a partition, returning 0 for the empty set. -/ +def partMax (S : Finset ℕ) : ℕ := + if h : S.Nonempty then S.max' h else 0 + +/-- The length of the maximal consecutive run from `max(S)` downward in `S`. -/ +def partSlope (S : Finset ℕ) : ℕ := consecutiveTopRun S (partMax S) + +/-- The interval `{max(S) − slope(S) + 1, …, max(S)}` (the "slope set" of `S`). -/ +def partSlopeSet (S : Finset ℕ) : Finset ℕ := + Icc (partMax S - partSlope S + 1) (partMax S) + +/-- Partitions `S ∈ distinctPartitions n` that are nonempty and satisfy +`(b ≤ s ∧ b ∉ D) ∨ b + 1 ≤ s`, with `b = partBase S`, `s = partSlope S`. -/ +def distinctPartitionsAlpha (n : ℕ) : Finset (Finset ℕ) := + (distinctPartitions n).filter (fun S ↦ + 0 < S.card ∧ + ((partBase S ≤ partSlope S ∧ ¬(partMax S - partSlope S + 1 ≤ partBase S)) ∨ + partBase S + 1 ≤ partSlope S)) + +/-- Partitions `S ∈ distinctPartitions n` that are nonempty and satisfy +`(s < b ∧ b ∉ D) ∨ s + 2 ≤ b`, with `b = partBase S`, `s = partSlope S`. -/ +def distinctPartitionsBeta (n : ℕ) : Finset (Finset ℕ) := + (distinctPartitions n).filter (fun S ↦ + 0 < S.card ∧ + ((partSlope S < partBase S ∧ ¬(partMax S - partSlope S + 1 ≤ partBase S)) ∨ + partSlope S + 2 ≤ partBase S)) + +/-- Partitions of `n` into distinct parts that are either empty or satisfy +`base(S) ∈ slopeSet(S)` with `base(S) = slope(S)` or `base(S) = slope(S) + 1`. -/ +def distinctPartitionsSpecial (n : ℕ) : Finset (Finset ℕ) := + (distinctPartitions n).filter (fun S ↦ + S.card = 0 ∨ + (0 < S.card ∧ + partMax S - partSlope S + 1 ≤ partBase S ∧ + (partBase S = partSlope S ∨ partBase S = partSlope S + 1))) + +/-- The pentagonal partition `S_{−k} = {k, k+1, …, 2k−1}` of `(3k²−k)/2`. -/ +def smkSet (k : ℕ) : Finset ℕ := Icc k (2 * k - 1) + +/-- The pentagonal partition `S_k = {k+1, k+2, …, 2k}` of `(3k²+k)/2`. -/ +def spkSet (k : ℕ) : Finset ℕ := Icc (k + 1) (2 * k) + +/-- For `S ∈ 𝒫_α(n)` with base `b` and max `m`, `α(S) = (S \ {b, m−b+1}) ∪ {m+1}`. -/ +def alphaOp (S : Finset ℕ) : Finset ℕ := + let b := partBase S + let m := partMax S + insert (m + 1) ((S.erase b).erase (m - b + 1)) + +/-- For `S ∈ 𝒫_β(n)` with slope `s` and max `m`, `β(S) = (S ∪ {s, m−s}) \ {m}`. -/ +def betaOp (S : Finset ℕ) : Finset ℕ := + let s := partSlope S + let m := partMax S + (insert s (insert (m - s) S)).erase m + +end PentagonalNumberTheorem.Franklin diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/Franklin/FormalPowerSeries.lean b/LeanPool/PentagonalNumberTheoremAnalytic/Franklin/FormalPowerSeries.lean new file mode 100644 index 0000000000..36d12caf83 --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/Franklin/FormalPowerSeries.lean @@ -0,0 +1,231 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import Mathlib.Algebra.BigOperators.Group.Finset.Basic +import Mathlib.Algebra.BigOperators.Ring.Finset +import Mathlib.Algebra.Order.BigOperators.Group.Finset +import Mathlib.Combinatorics.Enumerative.Partition.GenFun +import Mathlib.Data.Finset.Powerset +import Mathlib.Data.Nat.Choose.Basic +import Mathlib.Order.Interval.Finset.Nat +import Mathlib.RingTheory.PowerSeries.Basic +import Mathlib.RingTheory.PowerSeries.PiTopology +import Mathlib.Tactic.Linarith +import Mathlib.Tactic.Ring +import Mathlib.Tactic.FieldSimp +import Mathlib.Tactic.Positivity +import Mathlib.Tactic.LinearCombination +import Mathlib.Tactic.Zify +import LeanPool.PentagonalNumberTheoremAnalytic.Franklin.Defs +import LeanPool.PentagonalNumberTheoremAnalytic.Franklin.Helpers +import LeanPool.PentagonalNumberTheoremAnalytic.Franklin.Lemmas + +/-! # Pentagonal Number Theorem — Formal Power Series Statements +This file contains the formal power series identities from the source document +"Pentagonal Number Theorem" by Jonathan Conrad, Paula Muermann, Maryna Viazovska (May 11, 2026). +These results connect the combinatorial content (proved in `Lemmas.lean`) +to the algebraic identities involving generating functions. +-/ + +open Finset PowerSeries +open scoped PowerSeries.WithPiTopology + +namespace PentagonalNumberTheorem.Franklin + +/-- The unrestricted partition count `p(n)`: the number of ways to write +`n` as a sum of positive integers (with repetition allowed, order ignored). -/ +noncomputable def pCount (n : ℕ) : ℕ := Fintype.card n.Partition + +/-- The generating function for `pCount`: a formal power series in `ℤ⟦X⟧` +whose coefficients are the partition counts. -/ +noncomputable def pGenFun : ℤ⟦X⟧ := Nat.Partition.genFun fun _ _ => (1 : ℤ) + +/-- +**Lemma 3 (combinatorial side).** The `n`-th coefficient of the partition +generating function is `p(n)`. +-/ +theorem coeff_pGenFun_eq_p_count (n : ℕ) : + (coeff n) pGenFun = (pCount n : ℤ) := by + simp [pGenFun, pCount, Finsupp.prod_fun_one] + +/-- +**Lemma 3 (product side).** The generating function equals the formal product +`∏_{k≥1} (1 + X^k + X^{2k} + ...)` (the geometric series expansion of each +`(1 - X^k)^{-1}`). The product is taken in the X-adic topology on `ℤ⟦X⟧`, +where it converges (each `[X^n]` only sees finitely many factors). +-/ +theorem pGenFun_eq_prod : + pGenFun + = ∏' i, ((1 : ℤ⟦X⟧) + ∑' j, (1 : ℤ) • X^((i+1)*(j+1))) := + Nat.Partition.genFun_eq_tprod (fun _ _ => (1 : ℤ)) + +/-- +The coefficient of `X^n` in `∏_{k ∈ T} (-X^k)` is `(-1)^|T|` if `∑_{k ∈ T} k = n`, +and `0` otherwise: the product collapses to `(-1)^|T| · X^{T.sum id}`. +-/ +theorem coeff_prod_neg_X_pow (n : ℕ) (T : Finset ℕ) : + (coeff n) (∏ k ∈ T, (-(X ^ k) : ℤ⟦X⟧)) = if T.sum id = n then (-1 : ℤ) ^ T.card else 0 := by + rw [prod_neg, show (∏ x ∈ T, (X : ℤ⟦X⟧) ^ x) = X ^ T.sum id from prod_pow_eq_pow_sum T id X, + ← map_one (C (R := ℤ)), ← map_neg, ← map_pow, coeff_C_mul_X_pow] + simp [eq_comm] + +/-- +**Lemma 5a (combinatorial expansion).** The coefficient of `X^n` in the +truncated product `∏_{k=1}^{n}(1 - X^k)` equals `∑_{S ∈ distinctPartitions n} (-1)^|S|`. + +**Proof sketch.** Rewrite each factor as `1 + (-X^k)` and use the classical +expansion of a product of `1 + a_k` over subsets (`Finset.prod_one_add`): +`∏_{k ∈ {1,…,n}} (1 + (-X^k)) = ∑_{T ⊆ {1,…,n}} ∏_{k ∈ T} (-X^k)` +` = ∑_{T ⊆ {1,…,n}} (-1)^|T| · X^{T.sum id}`. +Since `coeff n` is linear, `coeff_prod_neg_X_pow` turns the coefficient into a sum of +`if T.sum id = n then (-1)^|T| else 0` over the powerset, and that is by definition the +sum over `distinctPartitions n` (`Finset.sum_filter`). +-/ +theorem coeff_prod_eq_signed_partition_sum (n : ℕ) : + (coeff n) (∏ k ∈ Finset.Icc 1 n, (1 - X^k : ℤ⟦X⟧)) = + ∑ S ∈ distinctPartitions n, (-1 : ℤ)^S.card := by + have h : ∀ k : ℕ, (1 - X ^ k : ℤ⟦X⟧) = 1 + -X ^ k := fun _ => by ring + simp only [h, prod_one_add, map_sum, coeff_prod_neg_X_pow] + exact (sum_filter _ _).symm + +/-- +**Lemma 5b (parity split).** The signed partition sum equals `p_e(n) - p_o(n)`. + +The sum splits over the partition +`distinctPartitions n = distinctPartitionsEven n ⊔ distinctPartitionsOdd n`. +On `distinctPartitionsEven`, `(-1)^|S| = 1`; on `distinctPartitionsOdd`, `(-1)^|S| = -1`. +The two pieces give `|distinctPartitionsEven|` and `-|distinctPartitionsOdd|`, +i.e. `p_e(n)` and `-p_o(n)`. +-/ +theorem signed_partition_sum_eq_pe_sub_po (n : ℕ) : + ∑ S ∈ distinctPartitions n, (-1 : ℤ)^S.card = (pe n : ℤ) - po n := by + have h_sign : ∀ S ∈ distinctPartitions n, + (-1 : ℤ) ^ S.card = if S.card % 2 = 0 then (1 : ℤ) else -1 := fun S _ => by + rcases Nat.even_or_odd S.card with h | h + · rw [h.neg_one_pow, ite_eq_left (Nat.even_iff.1 h)] + · rw [h.neg_one_pow, ite_eq_right (by rw [Nat.odd_iff] at h; omega)] + have hodd : {S ∈ distinctPartitions n | ¬S.card % 2 = 0} = distinctPartitionsOdd n := + filter_congr fun S _ => by omega + rw [sum_congr rfl h_sign, sum_ite, hodd, sum_const, sum_const] + simp [pe, po, distinctPartitionsEven, sub_eq_add_neg] + +/-- +**Lemma 5 (Source).** For each `n`, the coefficient of `X^n` in the +truncated product `∏_{k=1}^{n}(1 - X^k)` in `ℤ⟦X⟧` equals `p_e(n) - p_o(n)`. + +(The truncation matches the infinite product `∏_{k≥1}(1 - X^k)` on this +coefficient because factors with `k > n` are `≡ 1 mod X^{n+1}`.) +-/ +theorem coeff_prod_eq_pe_sub_po (n : ℕ) : + (coeff n) (∏ k ∈ Finset.Icc 1 n, (1 - X^k : ℤ⟦X⟧)) = (pe n : ℤ) - po n := by + rw [coeff_prod_eq_signed_partition_sum, signed_partition_sum_eq_pe_sub_po] + +/-- +**PNT (Euler), zero case.** `[X^0] ∏_{k=1}^{0}(1 - X^k) = 1`. +(The product is empty, so this is just `coeff 0 1 = 1`; we state it via +`coeff_prod_eq_pe_sub_po` for uniformity with the other cases.) +-/ +theorem coeff_prod_pentagonal_zero : + (coeff 0) (∏ k ∈ Finset.Icc 1 0, (1 - X^k : ℤ⟦X⟧)) = 1 := by + rw [coeff_prod_eq_pe_sub_po]; exact pe_minus_po_zero + +/-- +**PNT (Euler), non-pentagonal case.** For `n ≥ 1` with `2n` not of the +form `3k² - k` nor `3k² + k` for any `k ≥ 1`, +`[X^n] ∏_{k=1}^{n}(1 - X^k) = 0`. +-/ +theorem coeff_prod_pentagonal_nonpent (n : ℕ) (hn : 1 ≤ n) + (h1 : ∀ k, 1 ≤ k → 2 * n ≠ 3 * k ^ 2 - k) + (h2 : ∀ k, 1 ≤ k → 2 * n ≠ 3 * k ^ 2 + k) : + (coeff n) (∏ k ∈ Finset.Icc 1 n, (1 - X^k : ℤ⟦X⟧)) = 0 := by + rw [coeff_prod_eq_pe_sub_po]; exact pe_minus_po_nonpent n hn h1 h2 + +/-- +**PNT (Euler), pentagonal `(3k²-k)/2` case.** If `2n = 3k² - k` for some +`k ≥ 1` (equivalently, `n = (3k²-k)/2`), then +`[X^n] ∏_{k'=1}^{n}(1 - X^{k'}) = (-1)^k`. +-/ +theorem coeff_prod_pentagonal_minus (n k : ℕ) (hk : 1 ≤ k) (hn : 2 * n = 3 * k ^ 2 - k) : + (coeff n) (∏ k' ∈ Finset.Icc 1 n, (1 - X^k' : ℤ⟦X⟧)) = (-1)^k := by + rw [coeff_prod_eq_pe_sub_po]; exact pe_minus_po_pent_minus n k hk hn + +/-- +**PNT (Euler), pentagonal `(3k²+k)/2` case.** If `2n = 3k² + k` for some +`k ≥ 1` (equivalently, `n = (3k²+k)/2`), then +`[X^n] ∏_{k'=1}^{n}(1 - X^{k'}) = (-1)^k`. +-/ +theorem coeff_prod_pentagonal_plus (n k : ℕ) (hk : 1 ≤ k) (hn : 2 * n = 3 * k ^ 2 + k) : + (coeff n) (∏ k' ∈ Finset.Icc 1 n, (1 - X^k' : ℤ⟦X⟧)) = (-1)^k := by + rw [coeff_prod_eq_pe_sub_po]; exact pe_minus_po_pent_plus n k hk hn + +/-- `k * (3 * k - 1)` is always even, so over `ℤ` the generalized pentagonal equation +`n = k(3k-1)/2` is equivalent to its subtraction-free form `2n = k(3k-1)`. -/ +lemma natCast_eq_gen_pent_div_two_iff (n : ℕ) (k : ℤ) : + (n : ℤ) = k * (3 * k - 1) / 2 ↔ 2 * (n : ℤ) = k * (3 * k - 1) := by + obtain ⟨m, hm⟩ := Int.even_mul_pred_self k + have : (2 : ℤ) ∣ k * (3 * k - 1) := ⟨3 * m + k, by linear_combination 3 * hm⟩ + omega + +/-- **Franklin/Euler in unified integer-index form.** If `2n = k(3k-1)` for some `k : ℤ`, +then `p_e(n) - p_o(n) = (-1)^|k|`. This subsumes the three pentagonal cases: +`k = 0` forces `n = 0`, `k = j > 0` gives `2n = 3j² - j`, and `k = -j < 0` gives +`2n = 3j² + j`. -/ +theorem pe_minus_po_of_gen_pent (n : ℕ) (k : ℤ) (hk : 2 * (n : ℤ) = k * (3 * k - 1)) : + (pe n : ℤ) - po n = (-1 : ℤ) ^ k.natAbs := by + rcases lt_trichotomy k 0 with h | rfl | h + · obtain ⟨j, rfl⟩ : ∃ j : ℕ, k = -(j : ℤ) := ⟨k.natAbs, by omega⟩ + rw [show (-(j : ℤ)).natAbs = j by omega] + refine pe_minus_po_pent_plus n j (by omega) ?_ + exact_mod_cast (by linear_combination hk : (2 * n : ℤ) = 3 * (j : ℤ) ^ 2 + (j : ℤ)) + · rw [show n = 0 by omega] + simpa using pe_minus_po_zero + · obtain ⟨j, rfl⟩ : ∃ j : ℕ, k = (j : ℤ) := ⟨k.natAbs, by omega⟩ + rw [show ((j : ℤ)).natAbs = j by omega] + refine pe_minus_po_pent_minus n j (by omega) ?_ + have hz : 2 * n + j = 3 * j ^ 2 := + mod_cast (by linear_combination hk : (2 * n : ℤ) + (j : ℤ) = 3 * (j : ℤ) ^ 2) + omega + +/-- Converse bookkeeping: both `ℕ`-indexed pentagonal families `2n = 3j² ∓ j` (with `j ≥ 1`) +produce an integer index `k` with `2n = k(3k-1)`, namely `k = j` and `k = -j`. -/ +lemma exists_gen_pent_of_pent (n j : ℕ) (hj : 1 ≤ j) + (h : 2 * n = 3 * j ^ 2 - j ∨ 2 * n = 3 * j ^ 2 + j) : + ∃ k : ℤ, 2 * (n : ℤ) = k * (3 * k - 1) := by + have hjle : j ≤ 3 * j ^ 2 := by have := Nat.le_self_pow two_ne_zero j; omega + rcases h with h | h + · exact ⟨j, by zify [hjle] at h; linear_combination h⟩ + · exact ⟨-j, by zify at h; linear_combination h⟩ + +/-- +**PNT (Euler), Maryna's unified form.** For every `n`, either `n` is a +generalized pentagonal number `k(3k-1)/2` for some `k ∈ ℤ` — in which case +`p_e(n) - p_o(n) = (-1)^|k|` — or it is not, in which case the difference +vanishes. + +This repackages the four cases (`pe_minus_po_zero`, `pe_minus_po_pent_minus`, +`pe_minus_po_pent_plus`, `pe_minus_po_nonpent`) under a single integer index: +`k = 0` gives `n = 0`, `k ≥ 1` gives the `(3k²-k)/2` family, and `k ≤ -1` +(with `m = |k|`) gives the `(3m²+m)/2` family. All the arithmetic lives in +`natCast_eq_gen_pent_div_two_iff`, `pe_minus_po_of_gen_pent` and +`exists_gen_pent_of_pent`; what is left here is pure case bookkeeping. +-/ +theorem euler_pentagonal_number_theorem_packaged (n : ℕ) : + (∃ k : ℤ, (n = (k * (3 * k - 1)) / 2) ∧ + ((pe n : ℤ) - (po n : ℤ) = (-1 : ℤ) ^ (Int.natAbs k) )) ∨ + ((¬ ∃ k : ℤ, n = (k * (3 * k - 1)) / 2 ) ∧ + ((pe n : ℤ) - (po n : ℤ) = 0 )) := by + have hpent : ∀ j, 1 ≤ j → 2 * n = 3 * j ^ 2 - j ∨ 2 * n = 3 * j ^ 2 + j → + ∃ k : ℤ, (n : ℤ) = k * (3 * k - 1) / 2 := fun j hj h => + (exists_gen_pent_of_pent n j hj h).imp fun k => (natCast_eq_gen_pent_div_two_iff n k).2 + by_cases hP : ∃ k : ℤ, (n : ℤ) = k * (3 * k - 1) / 2 + · obtain ⟨k, hk⟩ := hP + exact .inl ⟨k, hk, pe_minus_po_of_gen_pent n k ((natCast_eq_gen_pent_div_two_iff n k).1 hk)⟩ + · refine .inr ⟨hP, pe_minus_po_nonpent n ?_ (fun j hj h => hP (hpent j hj (.inl h))) + (fun j hj h => hP (hpent j hj (.inr h)))⟩ + rcases Nat.eq_zero_or_pos n with rfl | h + · exact absurd ⟨0, by norm_num⟩ hP + · exact h + +end PentagonalNumberTheorem.Franklin diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/Franklin/Helpers.lean b/LeanPool/PentagonalNumberTheoremAnalytic/Franklin/Helpers.lean new file mode 100644 index 0000000000..00d72d2a28 --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/Franklin/Helpers.lean @@ -0,0 +1,438 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import Mathlib.Algebra.BigOperators.Group.Finset.Basic +import Mathlib.Algebra.BigOperators.Ring.Finset +import Mathlib.Algebra.Order.BigOperators.Group.Finset +import Mathlib.Combinatorics.Enumerative.Partition.GenFun +import Mathlib.Data.Finset.Powerset +import Mathlib.Data.Nat.Choose.Basic +import Mathlib.Order.Interval.Finset.Nat +import Mathlib.RingTheory.PowerSeries.Basic +import Mathlib.RingTheory.PowerSeries.PiTopology +import Mathlib.Tactic.Linarith +import Mathlib.Tactic.Ring +import Mathlib.Tactic.FieldSimp +import Mathlib.Tactic.Positivity +import LeanPool.PentagonalNumberTheoremAnalytic.Franklin.Defs +/-! +# Helper lemmas for Franklin's involution + +Helper lemmas about `consecutiveTopRun`, partition membership, +and properties of `αOp`/`βOp`. + +## Main results + +* `ctr_zero`, `ctr_succ`: defining equations for `consecutiveTopRun` +* `ctr_eq_of`: the characterisation of `consecutiveTopRun S m` as the unique `r` with + `m - j ∈ S` for all `j < r` and `m - r ∉ S` +* `mem_DP`: membership in `distinctPartitions` +* `sum_Icc_id_mul_two`, `Icc_sum_id`: Gauss' summation formula over `Finset.Icc` in `ℕ` +* `consecutiveTopRun_Icc`, `partBase_Icc`, `partMax_Icc`, `partSlope_Icc`: the structural + invariants of an interval, which is the shape both pentagonal families `smkSet`/`spkSet` take +-/ + +open Finset + +namespace PentagonalNumberTheorem.Franklin + +/-- Base case: `consecutiveTopRun S 0 = 1` if `0 ∈ S`, else `0`. -/ +@[simp] +lemma ctr_zero (S : Finset ℕ) : consecutiveTopRun S 0 = if (0 : ℕ) ∈ S then 1 else 0 := by + simp [consecutiveTopRun] +/-- Recurrence: `consecutiveTopRun S (m+1)` is `1 + consecutiveTopRun S m` if `m+1 ∈ S`, +else `0`. -/ +@[simp] +lemma ctr_succ (S : Finset ℕ) (m : ℕ) : + consecutiveTopRun S (m + 1) = if m + 1 ∈ S then 1 + consecutiveTopRun S m else 0 := by + simp [consecutiveTopRun] +/-- If `m ∉ S` then `consecutiveTopRun S m = 0`. -/ +lemma ctr_not_mem (S : Finset ℕ) (m : ℕ) (h : m ∉ S) : consecutiveTopRun S m = 0 := by + cases m with + | zero => simp [h] + | succ m => rw [ctr_succ, ite_eq_right h] +/-- If `m ∈ S` then `consecutiveTopRun S m > 0`. -/ +lemma ctr_pos_of_mem (S : Finset ℕ) (m : ℕ) (h : m ∈ S) : 0 < consecutiveTopRun S m := by + cases m with + | zero => simp [h] + | succ m => rw [ctr_succ, ite_eq_left h]; omega +/-- If `0 ∉ S` then `consecutiveTopRun S m ≤ m`. -/ +lemma ctr_le (S : Finset ℕ) (m : ℕ) (h : (0 : ℕ) ∉ S) : consecutiveTopRun S m ≤ m := by + induction m with + | zero => simp [h] + | succ m ih => rw [ctr_succ]; split_ifs <;> omega +/-- If `j < consecutiveTopRun S m` then `m - j ∈ S`. -/ +lemma ctr_mem_of_lt (S : Finset ℕ) (m j : ℕ) (hj : j < consecutiveTopRun S m) : + m - j ∈ S := by + induction m generalizing j with + | zero => + rw [ctr_zero] at hj + split_ifs at hj with h + · obtain rfl : j = 0 := by omega + simpa using h + · omega + | succ m ih => + rw [ctr_succ] at hj + split_ifs at hj with h + · cases j with + | zero => simpa using h + | succ j => simpa using ih j (by omega) + · omega +/-- Lower bound for `consecutiveTopRun`: a run of length `r` below `m` forces +`r ≤ consecutiveTopRun S m`. -/ +lemma ctr_ge_of_mem (S : Finset ℕ) (m r : ℕ) (hrm : r ≤ m) (h : ∀ j < r, m - j ∈ S) : + r ≤ consecutiveTopRun S m := by + induction m generalizing r with + | zero => omega + | succ m ih => + cases r with + | zero => exact Nat.zero_le _ + | succ r => + rw [ctr_succ, ite_eq_left (by simpa using h 0 (Nat.succ_pos r))] + have := ih r (by omega) fun j hj => by simpa using h (j + 1) (by omega) + omega +/-- `consecutiveTopRun S m` is the unique `r ≤ m` with `m - j ∈ S` for every `j < r` and +`m - r ∉ S`. -/ +lemma ctr_eq_of (S : Finset ℕ) (m r : ℕ) (hrm : r ≤ m) (hmem : ∀ j < r, m - j ∈ S) + (hnot : m - r ∉ S) : consecutiveTopRun S m = r := + le_antisymm (by by_contra hc; exact hnot (ctr_mem_of_lt S m r (by omega))) + (ctr_ge_of_mem S m r hrm hmem) +/-- If `0 ∉ S` and `m ∈ S` then `m - consecutiveTopRun S m ∉ S`. -/ +lemma ctr_not_mem_boundary (S : Finset ℕ) (m : ℕ) (h0 : (0 : ℕ) ∉ S) (hm : m ∈ S) : + m - consecutiveTopRun S m ∉ S := by + induction m with + | zero => exact absurd hm h0 + | succ m ih => + rw [ctr_succ, ite_eq_left hm] + by_cases h : m ∈ S + · rw [show m + 1 - (1 + consecutiveTopRun S m) = m - consecutiveTopRun S m by omega] + exact ih h + · rw [ctr_not_mem S m h] + simpa using h +/-- `S ∈ distinctPartitions n` iff `S ⊆ Icc 1 n` and `S.sum id = n`. -/ +lemma mem_DP (n : ℕ) (S : Finset ℕ) : + S ∈ distinctPartitions n ↔ S ⊆ Icc 1 n ∧ S.sum id = n := by + simp [distinctPartitions] +/-- Every element of a distinct partition of n is positive. -/ +lemma DP_pos_mem (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitions n) {x : ℕ} (hx : x ∈ S) : + 1 ≤ x := + (mem_Icc.mp (mem_powerset.mp (mem_filter.mp hS).1 hx)).1 +/-- Every element of `S ∈ distinctPartitions n` is at most n. -/ +lemma DP_le_mem (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitions n) {x : ℕ} (hx : x ∈ S) : + x ≤ n := + (mem_Icc.mp (mem_powerset.mp (mem_filter.mp hS).1 hx)).2 +/-- `0` is not in any distinct partition. -/ +lemma DP_zero_not_mem (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitions n) : (0 : ℕ) ∉ S := + fun h => absurd (DP_pos_mem n S hS h) (by omega) +/-- The sum of a distinct partition of n equals n. -/ +lemma DP_sum (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitions n) : S.sum id = n := + (mem_filter.mp hS).2 +/-- Every α-partition is a distinct partition. -/ +lemma DPalpha_mem_DP (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsAlpha n) : + S ∈ distinctPartitions n := + (mem_filter.mp hS).1 +/-- Every β-partition is a distinct partition. -/ +lemma DPbeta_mem_DP (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsBeta n) : + S ∈ distinctPartitions n := + (mem_filter.mp hS).1 +/-- Every α-partition is nonempty. -/ +lemma DPalpha_nonempty (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsAlpha n) : + S.Nonempty := + card_pos.mp (mem_filter.mp hS).2.1 +/-- Every β-partition is nonempty. -/ +lemma DPbeta_nonempty (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsBeta n) : S.Nonempty := + card_pos.mp (mem_filter.mp hS).2.1 +/-- `partBase S ∈ S` for nonempty S. -/ +lemma partBase_mem (S : Finset ℕ) (hne : S.Nonempty) : partBase S ∈ S := by + simp only [partBase, dite_eq_left hne] + exact min'_mem _ hne +/-- `partMax S ∈ S` for nonempty S. -/ +lemma partMax_mem (S : Finset ℕ) (hne : S.Nonempty) : partMax S ∈ S := by + simp only [partMax, dite_eq_left hne] + exact max'_mem _ hne +/-- `partBase S ≤ x` for any `x ∈ S`. -/ +lemma partBase_le (S : Finset ℕ) (hne : S.Nonempty) {x : ℕ} (hx : x ∈ S) : + partBase S ≤ x := by + simp only [partBase, dite_eq_left hne] + exact min'_le _ _ hx +/-- `x ≤ partMax S` for any `x ∈ S`. -/ +lemma le_partMax (S : Finset ℕ) (hne : S.Nonempty) {x : ℕ} (hx : x ∈ S) : + x ≤ partMax S := by + simp only [partMax, dite_eq_left hne] + exact le_max' _ _ hx +/-- `partBase S ≤ partMax S` for nonempty S. -/ +lemma partBase_le_partMax (S : Finset ℕ) (hne : S.Nonempty) : partBase S ≤ partMax S := + partBase_le S hne (partMax_mem S hne) +/-- `partSlope S > 0` when `S` is nonempty. -/ +lemma partSlope_pos (S : Finset ℕ) (hne : S.Nonempty) : 0 < partSlope S := + ctr_pos_of_mem S _ (partMax_mem S hne) +/-- `partSlope S ≤ partMax S` when `0 ∉ S`. -/ +lemma partSlope_le_partMax (S : Finset ℕ) (h0 : (0 : ℕ) ∉ S) : + partSlope S ≤ partMax S := + ctr_le S _ h0 +/-- For S ∈ α(n), `partBase S ≤ partSlope S`. -/ +lemma DPalpha_base_le_slope (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsAlpha n) : + partBase S ≤ partSlope S := by + have := (mem_filter.mp hS).2.2 + omega +/-- For S ∈ β(n), `partSlope S < partBase S`. -/ +lemma DPbeta_slope_lt_base (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsBeta n) : + partSlope S < partBase S := by + have := (mem_filter.mp hS).2.2 + omega +/-- The bottom of the top run, `partMax S - partSlope S + 1`, is an element of `S`, hence is +at least `partBase S`. This is the common core of `DPalpha_max_ge_2base` and +`DPbeta_max_ge_2slope_add_1`. -/ +private lemma base_le_max_sub_slope_add_one (S : Finset ℕ) (hne : S.Nonempty) + (h0 : (0 : ℕ) ∉ S) : partBase S ≤ partMax S - partSlope S + 1 := by + have hs := partSlope_pos S hne + have hsm := partSlope_le_partMax S h0 + have := partBase_le S hne + (ctr_mem_of_lt S (partMax S) (partSlope S - 1) (by change partSlope S - 1 < partSlope S; omega)) + omega +/-- For S ∈ α(n), `partMax S ≥ 2 * partBase S`. -/ +lemma DPalpha_max_ge_2base (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsAlpha n) : + 2 * partBase S ≤ partMax S := by + have hne := DPalpha_nonempty n S hS + have h0 := DP_zero_not_mem n S (DPalpha_mem_DP n S hS) + have := base_le_max_sub_slope_add_one S hne h0 + have := partSlope_pos S hne + have := partSlope_le_partMax S h0 + have := (mem_filter.mp hS).2.2 + omega +/-- For S ∈ β(n), `partMax S ≥ 2 * partSlope S + 1`. -/ +lemma DPbeta_max_ge_2slope_add_1 (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsBeta n) : + 2 * partSlope S + 1 ≤ partMax S := by + have hne := DPbeta_nonempty n S hS + have h0 := DP_zero_not_mem n S (DPbeta_mem_DP n S hS) + have := base_le_max_sub_slope_add_one S hne h0 + have := partSlope_pos S hne + have := partSlope_le_partMax S h0 + have := (mem_filter.mp hS).2.2 + omega + +/-! ### Intervals + +Both pentagonal families are intervals — `smkSet k = Icc k (2 * k - 1)` and +`spkSet k = Icc (k + 1) (2 * k)` — and a *special* partition is an interval too +(`DPspecial_*` in `Lemmas.lean`). The lemmas below compute the sum and the three structural +invariants of an arbitrary `Finset.Icc a b` once and for all. -/ + +/-- Gauss' summation formula over `Finset.Icc` in `ℕ`, in `* 2` form: no division and no +truncated subtraction on the left. Unconditional — both sides are `0` when `b < a`. -/ +theorem sum_Icc_id_mul_two (a b : ℕ) : (∑ i ∈ Icc a b, i) * 2 = (b + 1 - a) * (a + b) := by + rcases le_or_gt a b with h | h + · obtain ⟨n, rfl⟩ := Nat.exists_eq_add_of_le h + have hc : a + n + 1 - a = n + 1 := by omega + rw [← Ico_add_one_right_eq_Icc, sum_Ico_eq_sum_range, hc, sum_add_distrib, sum_const, + card_range, smul_eq_mul, add_mul, sum_range_id_mul_two, Nat.add_sub_cancel] + ring + · rw [Icc_eq_empty (by omega), sum_empty, Nat.sub_eq_zero_of_le (by omega), Nat.zero_mul, + Nat.zero_mul] + +/-- Gauss' summation formula over `Finset.Icc` in `ℕ`. -/ +theorem sum_Icc_id (a b : ℕ) : ∑ i ∈ Icc a b, i = (b + 1 - a) * (a + b) / 2 := by + rw [← sum_Icc_id_mul_two, Nat.mul_div_cancel _ Nat.zero_lt_two] + +/-- `sum_Icc_id_mul_two` in `Finset.sum _ id` phrasing, which is what `distinctPartitions` uses. +`rw` cannot see through `id`, so this restatement is what call sites need. -/ +theorem Icc_sum_id_mul_two (a b : ℕ) : (Icc a b).sum id * 2 = (b + 1 - a) * (a + b) := + sum_Icc_id_mul_two a b + +/-- `sum_Icc_id` in `Finset.sum _ id` phrasing. -/ +theorem Icc_sum_id (a b : ℕ) : (Icc a b).sum id = (b + 1 - a) * (a + b) / 2 := + sum_Icc_id a b + +/-- The consecutive-run function on an interval: every element of `Icc a b` continues the run +back down to `a`, and everything outside has run length `0`. -/ +theorem consecutiveTopRun_Icc (a b m : ℕ) : + consecutiveTopRun (Icc a b) m = if a ≤ m ∧ m ≤ b then m - a + 1 else 0 := by + induction m with + | zero => simp only [ctr_zero, mem_Icc]; split_ifs <;> omega + | succ m ih => rw [ctr_succ, ih]; simp only [mem_Icc]; split_ifs <;> omega + +/-- The base of a nonempty interval is its left endpoint. -/ +theorem partBase_Icc {a b : ℕ} (hab : a ≤ b) : partBase (Icc a b) = a := by + have hne : (Icc a b).Nonempty := nonempty_Icc.mpr hab + simp only [partBase, dite_eq_left hne] + exact le_antisymm (min'_le _ _ (mem_Icc.mpr ⟨le_rfl, hab⟩)) + (le_min' _ _ _ fun x hx => (mem_Icc.mp hx).1) + +/-- The max of a nonempty interval is its right endpoint. -/ +theorem partMax_Icc {a b : ℕ} (hab : a ≤ b) : partMax (Icc a b) = b := by + have hne : (Icc a b).Nonempty := nonempty_Icc.mpr hab + simp only [partMax, dite_eq_left hne] + exact le_antisymm (max'_le _ _ _ fun x hx => (mem_Icc.mp hx).2) + (le_max' _ _ (mem_Icc.mpr ⟨hab, le_rfl⟩)) + +/-- A nonempty interval is one single run, so its slope is its whole length. -/ +theorem partSlope_Icc {a b : ℕ} (hab : a ≤ b) : partSlope (Icc a b) = b - a + 1 := by + rw [partSlope, partMax_Icc hab, consecutiveTopRun_Icc, ite_eq_left ⟨hab, le_rfl⟩] + +/-- For S ∈ α(n), `partMax S - partBase S + 1 ∈ S`. -/ +lemma DPalpha_m_sub_b_add_1_mem (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsAlpha n) : + partMax S - partBase S + 1 ∈ S := by + have hne := DPalpha_nonempty n S hS + have hb1 : 1 ≤ partBase S := DP_pos_mem n S (DPalpha_mem_DP n S hS) (partBase_mem S hne) + have hbm := partBase_le_partMax S hne + have hbs := DPalpha_base_le_slope n S hS + have h := ctr_mem_of_lt S (partMax S) (partBase S - 1) + (by change partBase S - 1 < partSlope S; omega) + rwa [show partMax S - (partBase S - 1) = partMax S - partBase S + 1 by omega] at h +/-- For S ∈ α(n), `partBase S ≠ partMax S - partBase S + 1`. -/ +lemma DPalpha_base_ne_m_sub_b_add_1 (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsAlpha n) : + partBase S ≠ partMax S - partBase S + 1 := by + have := DPalpha_max_ge_2base n S hS + omega +/-- `partMax S + 1 ∉ S` for nonempty S. -/ +lemma partMax_succ_not_mem (S : Finset ℕ) (hne : S.Nonempty) : + partMax S + 1 ∉ S := + fun h => absurd (le_partMax S hne h) (by omega) +/-- Membership in `αOp S`, with the two `let`s of the definition unfolded. -/ +lemma mem_alphaOp {S : Finset ℕ} {x : ℕ} : + x ∈ alphaOp S ↔ + x = partMax S + 1 ∨ (x ≠ partMax S - partBase S + 1 ∧ x ≠ partBase S ∧ x ∈ S) := by + simp only [alphaOp, mem_insert, mem_erase] +/-- The α-operation preserves the sum of parts. -/ +lemma alphaOp_sum (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsAlpha n) : + (alphaOp S).sum id = S.sum id := by + have hne := DPalpha_nonempty n S hS + have hbm := partBase_le_partMax S hne + have hb : partBase S ∈ S := partBase_mem S hne + have hm1 : partMax S - partBase S + 1 ∈ S.erase (partBase S) := + mem_erase.mpr ⟨(DPalpha_base_ne_m_sub_b_add_1 n S hS).symm, DPalpha_m_sub_b_add_1_mem n S hS⟩ + have hins : partMax S + 1 ∉ (S.erase (partBase S)).erase (partMax S - partBase S + 1) := + fun h => partMax_succ_not_mem S hne (mem_of_mem_erase (mem_of_mem_erase h)) + have key : S.sum id + = ((S.erase (partBase S)).erase (partMax S - partBase S + 1)).sum id + + (partMax S - partBase S + 1) + partBase S := by + rw [← sum_erase_add S id hb, ← sum_erase_add _ id hm1] + rfl + rw [show alphaOp S = insert (partMax S + 1) + ((S.erase (partBase S)).erase (partMax S - partBase S + 1)) from rfl, + sum_insert hins, key] + simp only [id_eq] + omega +/-- For S ∈ α(n), `partMax (αOp S) = partMax S + 1`. -/ +lemma alphaOp_partMax (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsAlpha n) : + partMax (alphaOp S) = partMax S + 1 := by + have hne := DPalpha_nonempty n S hS + have hmem : partMax S + 1 ∈ alphaOp S := mem_alphaOp.mpr (Or.inl rfl) + have hneA : (alphaOp S).Nonempty := ⟨_, hmem⟩ + have hub : ∀ x ∈ alphaOp S, x ≤ partMax S + 1 := by + intro x hx + rcases mem_alphaOp.mp hx with rfl | ⟨-, -, hxS⟩ + · exact le_rfl + · exact Nat.le_succ_of_le (le_partMax S hne hxS) + simp only [partMax, dite_eq_left hneA] + exact le_antisymm (max'_le _ _ _ hub) (le_max' _ _ hmem) +/-- For S ∈ α(n), `partSlope (αOp S) = partBase S`. -/ +lemma alphaOp_partSlope (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsAlpha n) : + partSlope (alphaOp S) = partBase S := by + have hne := DPalpha_nonempty n S hS + have h0 := DP_zero_not_mem n S (DPalpha_mem_DP n S hS) + have hb1 : 1 ≤ partBase S := DP_pos_mem n S (DPalpha_mem_DP n S hS) (partBase_mem S hne) + have hbm := partBase_le_partMax S hne + have h2b := DPalpha_max_ge_2base n S hS + have hbs := DPalpha_base_le_slope n S hS + have hsm := partSlope_le_partMax S h0 + rw [partSlope, alphaOp_partMax n S hS] + refine ctr_eq_of _ _ _ (by omega) (fun j hj => ?_) ?_ + · rcases Nat.eq_zero_or_pos j with rfl | hj0 + · exact mem_alphaOp.mpr (Or.inl (by omega)) + · have h := ctr_mem_of_lt S (partMax S) (j - 1) (by change j - 1 < partSlope S; omega) + rw [show partMax S - (j - 1) = partMax S + 1 - j by omega] at h + exact mem_alphaOp.mpr (Or.inr ⟨by omega, by omega, h⟩) + · rw [show partMax S + 1 - partBase S = partMax S - partBase S + 1 by omega] + intro hmem + rcases mem_alphaOp.mp hmem with h | ⟨h, -, -⟩ + · omega + · exact h rfl +/-- For S ∈ β(n), `partSlope S ∉ S`. -/ +lemma DPbeta_slope_not_mem (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsBeta n) : + partSlope S ∉ S := fun h => + absurd (partBase_le S (DPbeta_nonempty n S hS) h) + (by have := DPbeta_slope_lt_base n S hS; omega) +/-- For S ∈ β(n), `partMax S - partSlope S ∉ S`. -/ +lemma DPbeta_m_sub_s_not_mem (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsBeta n) : + partMax S - partSlope S ∉ S := + ctr_not_mem_boundary S (partMax S) (DP_zero_not_mem n S (DPbeta_mem_DP n S hS)) + (partMax_mem S (DPbeta_nonempty n S hS)) +/-- For S ∈ β(n), `partSlope S ≠ partMax S - partSlope S`. -/ +lemma DPbeta_slope_ne_m_sub_slope (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsBeta n) : + partSlope S ≠ partMax S - partSlope S := by + have := DPbeta_max_ge_2slope_add_1 n S hS + omega +/-- For S ∈ β(n), `βOp S` inserts the slope and `partMax S - partSlope S` into `S`, after +deleting the maximum. -/ +lemma betaOp_eq (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsBeta n) : + betaOp S + = insert (partSlope S) (insert (partMax S - partSlope S) (S.erase (partMax S))) := by + have hne := DPbeta_nonempty n S hS + have h0 := DP_zero_not_mem n S (DPbeta_mem_DP n S hS) + have := partSlope_pos S hne + have := DPbeta_max_ge_2slope_add_1 n S hS + simp only [betaOp, erase_insert_of_ne (by omega : partSlope S ≠ partMax S), + erase_insert_of_ne (by omega : partMax S - partSlope S ≠ partMax S)] +/-- The β-operation preserves the sum of parts. -/ +lemma betaOp_sum (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsBeta n) : + (betaOp S).sum id = S.sum id := by + have hne := DPbeta_nonempty n S hS + have h0 := DP_zero_not_mem n S (DPbeta_mem_DP n S hS) + have hsm := partSlope_le_partMax S h0 + have hmS : partMax S ∈ S := partMax_mem S hne + have hsS := DPbeta_slope_not_mem n S hS + have hmsS := DPbeta_m_sub_s_not_mem n S hS + have hs_ne := DPbeta_slope_ne_m_sub_slope n S hS + rw [betaOp_eq n S hS, sum_insert (by simp [hs_ne, hsS]), + sum_insert (fun h => hmsS (mem_of_mem_erase h)), ← sum_erase_add S id hmS] + simp only [id_eq] + omega +/-- For S ∈ β(n), `partMax (βOp S) = partMax S - 1`. -/ +lemma betaOp_partMax (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsBeta n) : + partMax (betaOp S) = partMax S - 1 := by + have hne := DPbeta_nonempty n S hS + have h0 := DP_zero_not_mem n S (DPbeta_mem_DP n S hS) + have hs0 := partSlope_pos S hne + have h2s := DPbeta_max_ge_2slope_add_1 n S hS + have hmem : partMax S - 1 ∈ betaOp S := by + rw [betaOp_eq n S hS] + by_cases h : partSlope S = 1 + · exact mem_insert_of_mem (by rw [h]; exact mem_insert_self _ _) + · refine mem_insert_of_mem (mem_insert_of_mem (mem_erase.mpr ⟨by omega, ?_⟩)) + exact ctr_mem_of_lt S (partMax S) 1 (by change (1 : ℕ) < partSlope S; omega) + have hneB : (betaOp S).Nonempty := ⟨_, hmem⟩ + have hub : ∀ x ∈ betaOp S, x ≤ partMax S - 1 := by + intro x hx + rw [betaOp_eq n S hS] at hx + simp only [mem_insert, mem_erase] at hx + rcases hx with rfl | rfl | ⟨hxm, hxS⟩ + · omega + · omega + · have := le_partMax S hne hxS; omega + simp only [partMax, dite_eq_left hneB] + exact le_antisymm (max'_le _ _ _ hub) (le_max' _ _ hmem) +/-- For S ∈ β(n), `partBase (βOp S) = partSlope S`. -/ +lemma betaOp_partBase (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsBeta n) : + partBase (betaOp S) = partSlope S := by + have hne := DPbeta_nonempty n S hS + have h0 := DP_zero_not_mem n S (DPbeta_mem_DP n S hS) + have h2s := DPbeta_max_ge_2slope_add_1 n S hS + have hsb := DPbeta_slope_lt_base n S hS + have hmem : partSlope S ∈ betaOp S := by + rw [betaOp_eq n S hS]; exact mem_insert_self _ _ + have hneB : (betaOp S).Nonempty := ⟨_, hmem⟩ + have hlb : ∀ x ∈ betaOp S, partSlope S ≤ x := by + intro x hx + rw [betaOp_eq n S hS] at hx + simp only [mem_insert, mem_erase] at hx + rcases hx with rfl | rfl | ⟨-, hxS⟩ + · exact le_rfl + · omega + · have := partBase_le S hne hxS; omega + simp only [partBase, dite_eq_left hneB] + exact le_antisymm (min'_le _ _ hmem) (le_min' _ _ _ hlb) + +end PentagonalNumberTheorem.Franklin diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/Franklin/Lemmas.lean b/LeanPool/PentagonalNumberTheoremAnalytic/Franklin/Lemmas.lean new file mode 100644 index 0000000000..ad44ae4182 --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/Franklin/Lemmas.lean @@ -0,0 +1,508 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import Mathlib.Algebra.BigOperators.Group.Finset.Basic +import Mathlib.Algebra.BigOperators.Ring.Finset +import Mathlib.Algebra.Order.BigOperators.Group.Finset +import Mathlib.Combinatorics.Enumerative.Partition.GenFun +import Mathlib.Data.Finset.Powerset +import Mathlib.Data.Nat.Choose.Basic +import Mathlib.Order.Interval.Finset.Nat +import Mathlib.RingTheory.PowerSeries.Basic +import Mathlib.RingTheory.PowerSeries.PiTopology +import Mathlib.Tactic.Linarith +import Mathlib.Tactic.Ring +import Mathlib.Tactic.FieldSimp +import Mathlib.Tactic.Positivity +import LeanPool.PentagonalNumberTheoremAnalytic.Franklin.Defs +import LeanPool.PentagonalNumberTheoremAnalytic.Franklin.Helpers +/-! +# Pentagonal Number Theorem — Lemmas + +This file contains the key lemmas for the Pentagonal Number Theorem, +following Franklin's involution argument. + +## Main results + +* `distinct_parts_disjoint_union`: the partition classes α/β/special are disjoint with union +* `special_partition_char`: characterization of special partitions +* `franklin_involution_bijection`: Franklin's involution is a bijection +* `parity_flip`: Franklin's involution flips even/odd parity +* `signed_partition_main`: pe(n) - po(n) = (-1)^k for pentagonal n, 0 otherwise +-/ + +open Finset + +namespace PentagonalNumberTheorem.Franklin + +/-- α-partitions and β-partitions are disjoint. -/ +theorem DPalpha_inter_DPbeta (n : ℕ) : + distinctPartitionsAlpha n ∩ distinctPartitionsBeta n = ∅ := by + simp only [distinctPartitionsAlpha, distinctPartitionsBeta, ← filter_and, filter_eq_empty_iff] + intro S _ + omega +/-- α-partitions and special partitions are disjoint. -/ +theorem DPalpha_inter_DPspecial (n : ℕ) : + distinctPartitionsAlpha n ∩ distinctPartitionsSpecial n = ∅ := by + simp only [distinctPartitionsAlpha, distinctPartitionsSpecial, ← filter_and, filter_eq_empty_iff] + intro S _ + omega +/-- β-partitions and special partitions are disjoint. -/ +theorem DPbeta_inter_DPspecial (n : ℕ) : + distinctPartitionsBeta n ∩ distinctPartitionsSpecial n = ∅ := by + simp only [distinctPartitionsBeta, distinctPartitionsSpecial, ← filter_and, filter_eq_empty_iff] + intro S _ + omega +/-- Every distinct partition is in exactly one of α, β, or special. -/ +theorem DP_eq_union (n : ℕ) : + distinctPartitions n = + distinctPartitionsAlpha n ∪ distinctPartitionsBeta n ∪ distinctPartitionsSpecial n := by + simp only [distinctPartitionsAlpha, distinctPartitionsBeta, distinctPartitionsSpecial, + ← filter_or] + exact (filter_true_of_mem fun S _ => by omega).symm +/-- The pentagonal identity `a * (3 * a - 1) = 3 * a ^ 2 - a`, stated without truncated +subtraction so that `omega` can use it. -/ +theorem mul_three_sub_one_add_self (a : ℕ) : a * (3 * a - 1) + a = 3 * a ^ 2 := by + cases a with + | zero => rfl + | succ b => rw [show 3 * (b + 1) - 1 = 3 * b + 2 by omega]; ring +/-- The set smkSet(k) has exactly k elements. -/ +theorem SmkSet_card (k : ℕ) (hk : 1 ≤ k) : (smkSet k).card = k := by + unfold smkSet; rw [Nat.card_Icc]; omega +/-- The sum of smkSet(k) equals (3k²-k)/2. -/ +theorem SmkSet_sum (k : ℕ) (hk : 1 ≤ k) : (smkSet k).sum id = (3 * k ^ 2 - k) / 2 := by + have key := mul_three_sub_one_add_self k + rw [smkSet, Icc_sum_id, show 2 * k - 1 + 1 - k = k by omega, + show k + (2 * k - 1) = 3 * k - 1 by omega] + omega +/-- The set spkSet(k) has exactly k elements. -/ +theorem SpkSet_card (k : ℕ) (hk : 1 ≤ k) : (spkSet k).card = k := by + unfold spkSet; rw [Nat.card_Icc]; omega +/-- The sum of spkSet(k) equals (3k²+k)/2. -/ +theorem SpkSet_sum (k : ℕ) (hk : 1 ≤ k) : (spkSet k).sum id = (3 * k ^ 2 + k) / 2 := by + rw [spkSet, Icc_sum_id, show 2 * k + 1 - (k + 1) = k by omega] + congr 1 + ring +/-- A nonempty distinct partition whose top run reaches all the way down to its base is the +whole interval `Icc (partBase S) (partMax S)`. -/ +theorem DP_eq_Icc_of_run_reaches_base (S : Finset ℕ) (hne : S.Nonempty) + (h : partMax S - partSlope S + 1 ≤ partBase S) : + S = Icc (partBase S) (partMax S) := by + refine Subset.antisymm (fun x hx => mem_Icc.mpr ⟨partBase_le S hne hx, le_partMax S hne hx⟩) + fun x hx => ?_ + obtain ⟨h1, h2⟩ := mem_Icc.mp hx + have hs := partSlope_pos S hne + have hmem := ctr_mem_of_lt S (partMax S) (partMax S - x) + (show partMax S - x < partSlope S by omega) + rwa [Nat.sub_sub_self h2] at hmem +/-- A nonempty *special* partition of `n` is exactly the interval `Icc b m` running from its +base `b` to its max `m`. Consequently its slope is the full length `m - b + 1` of that interval, +and `2 * n = s * (b + m)` by Gauss' summation formula. -/ +theorem DPspecial_eq_Icc (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsSpecial n) + (hne : S.Nonempty) : + S = Icc (partBase S) (partMax S) ∧ partSlope S = partMax S - partBase S + 1 ∧ + 2 * n = partSlope S * (partBase S + partMax S) := by + obtain ⟨hDP, hcond⟩ := mem_filter.mp hS + have hbm : partBase S ≤ partMax S := partBase_le_partMax S hne + have hlow : partMax S - partSlope S + 1 ≤ partBase S := by + rcases hcond with h | h + · exact absurd (card_pos.mpr hne) (by omega) + · exact h.2.1 + have hSeq : S = Icc (partBase S) (partMax S) := + DP_eq_Icc_of_run_reaches_base S hne hlow + have hslope : partSlope S = partMax S - partBase S + 1 := by + conv_lhs => rw [hSeq] + exact partSlope_Icc hbm + refine ⟨hSeq, hslope, ?_⟩ + have hsum : S.sum id = n := DP_sum n S hDP + rw [hSeq] at hsum + have h2 := Icc_sum_id_mul_two (partBase S) (partMax S) + rw [hsum, show partMax S + 1 - partBase S = partSlope S by omega] at h2 + omega +/-- For non-pentagonal n ≥ 1, there are no special partitions. -/ +theorem DPspecial_empty_of_nonpent (n : ℕ) (hn : 1 ≤ n) + (h1 : ∀ k, 1 ≤ k → 2 * n ≠ 3 * k ^ 2 - k) + (h2 : ∀ k, 1 ≤ k → 2 * n ≠ 3 * k ^ 2 + k) : + distinctPartitionsSpecial n = ∅ := by + refine eq_empty_of_forall_notMem fun S hS => ?_ + obtain ⟨hDP, hcond⟩ := mem_filter.mp hS + have hne : S.Nonempty := by + rcases hcond with h | h + · exfalso + have h0 := DP_sum n S hDP + rw [card_eq_zero.mp h] at h0 + simp at h0 + omega + · exact card_pos.mp h.1 + have hcase : partBase S = partSlope S ∨ partBase S = partSlope S + 1 := by + rcases hcond with h | h + · exact absurd (card_pos.mpr hne) (by omega) + · exact h.2.2 + obtain ⟨-, hslope, hsum⟩ := DPspecial_eq_Icc n S hS hne + have hbm : partBase S ≤ partMax S := partBase_le_partMax S hne + obtain ⟨t, ht⟩ : ∃ t, partSlope S = t + 1 := ⟨partSlope S - 1, by omega⟩ + have e2 : 3 * (t + 1) ^ 2 = 3 * t ^ 2 + 6 * t + 3 := by ring + rcases hcase with hc | hc + · refine h1 (t + 1) (by omega) ?_ + rw [ht, show partBase S = t + 1 by omega, show partMax S = 2 * t + 1 by omega] at hsum + have e1 : (t + 1) * (t + 1 + (2 * t + 1)) = 3 * t ^ 2 + 5 * t + 2 := by ring + omega + · refine h2 (t + 1) (by omega) ?_ + rw [ht, show partBase S = t + 2 by omega, show partMax S = 2 * t + 2 by omega] at hsum + have e1 : (t + 1) * (t + 2 + (2 * t + 2)) = 3 * t ^ 2 + 7 * t + 4 := by ring + omega +/-- `x ↦ 3x² − x` is injective on `ℕ`, stated without truncated subtraction. -/ +theorem pent_minus_inj {a b : ℕ} (h : 3 * a ^ 2 + b = 3 * b ^ 2 + a) : a = b := by + rcases lt_trichotomy a b with h' | h' | h' + · obtain ⟨d, rfl⟩ : ∃ d, b = a + 1 + d := ⟨b - a - 1, by omega⟩ + exfalso; nlinarith + · exact h' + · obtain ⟨d, rfl⟩ : ∃ d, a = b + 1 + d := ⟨a - b - 1, by omega⟩ + exfalso; nlinarith +/-- The two pentagonal families never collide: `3j² + j ≠ 3k² − k` when `1 ≤ k`. -/ +theorem pent_plus_ne_pent_minus {j k : ℕ} (hk : 1 ≤ k) + (h : 3 * j ^ 2 + j + k = 3 * k ^ 2) : False := by + rcases lt_or_ge j k with hjk | hjk + · obtain ⟨d, rfl⟩ : ∃ d, k = j + 1 + d := ⟨k - j - 1, by omega⟩ + nlinarith + · obtain ⟨d, rfl⟩ : ∃ d, j = k + d := ⟨j - k, by omega⟩ + nlinarith +/-- For n = (3k²-k)/2 (pentagonal minus), the only special partition is smkSet(k). -/ +theorem DPspecial_pent_minus (n k : ℕ) (hk : 1 ≤ k) (hn : 2 * n = 3 * k ^ 2 - k) : + distinctPartitionsSpecial n = {smkSet k} := by + have ek := mul_three_sub_one_add_self k + have hk3 : k < 3 * k ^ 2 := by nlinarith + have hn2 : 2 * n + k = 3 * k ^ 2 := by omega + have hkk : k ≤ 2 * k - 1 := by omega + have hsum : (smkSet k).sum id = n := by rw [SmkSet_sum k hk]; omega + refine eq_singleton_iff_unique_mem.mpr ⟨?_, fun S hS => ?_⟩ + · refine mem_filter.mpr ⟨(mem_DP n _).mpr ⟨?_, hsum⟩, Or.inr ⟨?_, ?_, Or.inl ?_⟩⟩ + · have h5 : 5 * k ≤ 3 * k ^ 2 + 2 := by nlinarith + simp only [smkSet] + exact Icc_subset_Icc hk (by omega) + · rw [SmkSet_card k hk]; omega + · rw [smkSet, partMax_Icc hkk, partSlope_Icc hkk, partBase_Icc hkk]; omega + · rw [smkSet, partSlope_Icc hkk, partBase_Icc hkk]; omega + · obtain ⟨hSDP, hc | ⟨hc, hle, hbs⟩⟩ := mem_filter.mp hS + · rw [card_eq_zero] at hc + have h0 := DP_sum n S hSDP + rw [hc, sum_empty] at h0 + exfalso; omega + · have hne : S.Nonempty := card_pos.mp hc + obtain ⟨hSeq, hslope, hsum2⟩ := DPspecial_eq_Icc n S hS hne + have hbm : partBase S ≤ partMax S := partBase_le_partMax S hne + have hb1 : 1 ≤ partBase S := DP_pos_mem n S hSDP (partBase_mem S hne) + rcases hbs with hbs | hbs + · have hm2 : partMax S = 2 * partBase S - 1 := by omega + rw [show partSlope S = partBase S by omega, + show partBase S + partMax S = 3 * partBase S - 1 by omega] at hsum2 + have eb := mul_three_sub_one_add_self (partBase S) + rw [hSeq, hm2, pent_minus_inj (a := partBase S) (b := k) (by omega)] + rfl + · exfalso + obtain ⟨j, hj⟩ : ∃ j, partBase S = j + 1 := ⟨partBase S - 1, by omega⟩ + rw [show partSlope S = j by omega, + show partBase S + partMax S = 3 * j + 1 by omega] at hsum2 + have e : j * (3 * j + 1) = 3 * j ^ 2 + j := by ring + exact pent_plus_ne_pent_minus (j := j) hk (by omega) +/-- The base of `spkSet k` is `k + 1`. -/ +theorem partBase_spkSet {k : ℕ} (hk : 1 ≤ k) : partBase (spkSet k) = k + 1 := by + rw [spkSet]; exact partBase_Icc (by omega) +/-- The largest part of `spkSet k` is `2 * k`. -/ +theorem partMax_spkSet {k : ℕ} (hk : 1 ≤ k) : partMax (spkSet k) = 2 * k := by + rw [spkSet]; exact partMax_Icc (by omega) +/-- `spkSet k` is one single run, so its slope is its whole length `k`. -/ +theorem partSlope_spkSet {k : ℕ} (hk : 1 ≤ k) : partSlope (spkSet k) = k := by + rw [spkSet, partSlope_Icc (show k + 1 ≤ 2 * k by omega)]; omega +/-- The pentagonal numbers of the second kind are pairwise distinct: `a ↦ a * (3 * a + 1)` +is injective. -/ +theorem pent_plus_inj {a b : ℕ} (h : a * (3 * a + 1) = 3 * b ^ 2 + b) : a = b := by + rcases lt_trichotomy a b with hab | hab | hab + · exfalso; nlinarith + · exact hab + · exfalso; nlinarith +/-- No pentagonal number of the first kind is also one of the second kind: with `a = c + 1`, +`a * (3 * a - 1) = (c + 1) * (3 * c + 2)` never equals `b * (3 * b + 1)`. -/ +theorem pent_minus_ne_pent_plus (c b : ℕ) : (c + 1) * (3 * c + 2) ≠ 3 * b ^ 2 + b := by + intro hc + have e : (c + 1) * (3 * c + 2) + (c + 1) = 3 * (c + 1) ^ 2 := by ring + exact pent_plus_ne_pent_minus (j := b) (k := c + 1) (by omega) (by omega) +/-- For n = (3k²+k)/2 (pentagonal plus), the only special partition is spkSet(k). -/ +theorem DPspecial_pent_plus (n k : ℕ) (hk : 1 ≤ k) (hn : 2 * n = 3 * k ^ 2 + k) : + distinctPartitionsSpecial n = {spkSet k} := by + have hb : partBase (spkSet k) = k + 1 := partBase_spkSet hk + have hm : partMax (spkSet k) = 2 * k := partMax_spkSet hk + have hs : partSlope (spkSet k) = k := partSlope_spkSet hk + have hspk : spkSet k ∈ distinctPartitionsSpecial n := by + refine mem_filter.mpr ⟨(mem_DP n _).mpr ⟨?_, ?_⟩, Or.inr ⟨?_, by omega, Or.inr (by omega)⟩⟩ + · rw [spkSet]; exact Icc_subset_Icc (by omega) (by nlinarith) + · rw [SpkSet_sum k hk]; omega + · rw [SpkSet_card k hk]; omega + ext S + simp only [mem_singleton] + refine ⟨fun hS => ?_, fun h => h ▸ hspk⟩ + obtain ⟨hSDP, hcond⟩ := mem_filter.mp hS + have hsum : S.sum id = n := DP_sum n S hSDP + rcases hcond with hcard | ⟨hcard, hbase, hbs⟩ + · rw [card_eq_zero] at hcard + rw [hcard, sum_empty] at hsum + exfalso; omega + have hne : S.Nonempty := card_pos.mp hcard + have hs_pos : 0 < partSlope S := partSlope_pos S hne + have hbm : partBase S ≤ partMax S := partBase_le_partMax S hne + obtain ⟨hSeq, hslope, hsum2⟩ := DPspecial_eq_Icc n S hS hne + rcases hbs with hbs | hbs + · -- `base = slope` would make `n` pentagonal of the first kind, which is impossible. + obtain ⟨c, hc⟩ : ∃ c, partSlope S = c + 1 := ⟨partSlope S - 1, by omega⟩ + refine absurd ?_ (pent_minus_ne_pent_plus c k) + rw [← hn, hsum2, hc, show partBase S + partMax S = 3 * c + 2 by omega] + · -- `base = slope + 1` forces `slope = k`, hence `S = Icc (k + 1) (2 * k) = spkSet k`. + have hsk : partSlope S = k := by + refine pent_plus_inj ?_ + rw [← hn, hsum2, show partBase S + partMax S = 3 * partSlope S + 1 by omega] + rw [hSeq, show partBase S = k + 1 by omega, show partMax S = 2 * k by omega, spkSet] +/-- The Franklin α-operation maps α-partitions into β-partitions. -/ +theorem alphaOp_mem_DPbeta (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsAlpha n) : + alphaOp S ∈ distinctPartitionsBeta n := by + have hne := DPalpha_nonempty n S hS + have hDP := DPalpha_mem_DP n S hS + have hsum : (alphaOp S).sum id = n := by rw [alphaOp_sum n S hS, DP_sum n S hDP] + have hne' : (alphaOp S).Nonempty := ⟨partMax S + 1, mem_insert_self _ _⟩ + have hlow : ∀ x ∈ alphaOp S, partBase S + 1 ≤ x := by + intro x hx + rcases mem_insert.mp hx with rfl | hx' + · have := partBase_le_partMax S hne + omega + · have h1 := partBase_le S hne (mem_of_mem_erase (mem_of_mem_erase hx')) + have h2 := ne_of_mem_erase (mem_of_mem_erase hx') + omega + refine mem_filter.mpr ⟨(mem_DP n _).mpr ⟨fun x hx => mem_Icc.mpr ⟨?_, ?_⟩, hsum⟩, ?_⟩ + · have := hlow x hx + omega + · exact hsum ▸ single_le_sum (f := id) (fun i _ => Nat.zero_le i) hx + · have hbase := hlow _ (partBase_mem _ hne') + have hslope := alphaOp_partSlope n S hS + have hmax := alphaOp_partMax n S hS + have hcard := card_pos.mpr hne' + have h2b := DPalpha_max_ge_2base n S hS + omega +/-- The Franklin β-operation maps β-partitions into α-partitions. -/ +theorem betaOp_mem_DPalpha (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsBeta n) : + betaOp S ∈ distinctPartitionsAlpha n := by + have hne := DPbeta_nonempty n S hS + have hDP := DPbeta_mem_DP n S hS + have h0 := DP_zero_not_mem n S hDP + have hspos := partSlope_pos S hne + have hm2 := DPbeta_max_ge_2slope_add_1 n S hS + have hmn : partMax S ≤ n := DP_le_mem n S hDP (partMax_mem S hne) + have hbm := betaOp_partMax n S hS + have hDP' : betaOp S ∈ distinctPartitions n := by + refine (mem_DP n _).mpr ⟨fun x hx => ?_, betaOp_sum n S hS ▸ DP_sum n S hDP⟩ + simp only [betaOp, mem_erase, mem_insert] at hx + obtain ⟨-, rfl | rfl | hx'⟩ := hx + · exact mem_Icc.mpr ⟨by omega, by omega⟩ + · exact mem_Icc.mpr ⟨by omega, by omega⟩ + · exact mem_Icc.mpr ⟨DP_pos_mem n S hDP hx', DP_le_mem n S hDP hx'⟩ + have hsmem : partSlope S ∈ betaOp S := by + simp only [betaOp, mem_erase, mem_insert] + exact ⟨by omega, Or.inl trivial⟩ + have hcard : 0 < (betaOp S).card := card_pos.mpr ⟨_, hsmem⟩ + have hrun : ∀ j < partSlope S, partMax S - 1 - j ∈ betaOp S := by + intro j hj + have hps : partSlope S = consecutiveTopRun S (partMax S) := rfl + simp only [betaOp, mem_erase, mem_insert] + refine ⟨by omega, ?_⟩ + rcases Nat.lt_or_ge (j + 1) (partSlope S) with h | h + · refine Or.inr (Or.inr ?_) + rw [Nat.sub_sub] + exact ctr_mem_of_lt S _ (1 + j) (by omega) + · exact Or.inr (Or.inl (by omega)) + have hslope : partSlope S ≤ partSlope (betaOp S) := by + by_contra hcon + have hlt := not_le.mp hcon + refine ctr_not_mem_boundary (betaOp S) (partMax (betaOp S)) + (DP_zero_not_mem n _ hDP') (partMax_mem _ (card_pos.mp hcard)) ?_ + change partMax (betaOp S) - partSlope (betaOp S) ∈ betaOp S + rw [hbm] + exact hrun _ hlt + have hbase := betaOp_partBase n S hS + exact mem_filter.mpr ⟨hDP', by omega⟩ +/-- The β-operation is a left inverse of the α-operation. -/ +theorem betaOp_alphaOp (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsAlpha n) : + betaOp (alphaOp S) = S := by + have hne := DPalpha_nonempty n S hS + have hbm := partBase_le_partMax S hne + have hb_mem := partBase_mem S hne + have hmb_mem := DPalpha_m_sub_b_add_1_mem n S hS + simp only [betaOp, alphaOp_partSlope n S hS, alphaOp_partMax n S hS] + simp only [alphaOp] + ext x + simp only [mem_insert, mem_erase, ne_eq] + constructor + · rintro ⟨hx, rfl | rfl | rfl | ⟨-, -, hx'⟩⟩ + · exact hb_mem + · rw [show partMax S + 1 - partBase S = partMax S - partBase S + 1 by omega] + exact hmb_mem + · exact absurd rfl hx + · exact hx' + · intro hx + have hle := le_partMax S hne hx + refine ⟨by omega, ?_⟩ + by_cases h1 : x = partBase S + · exact Or.inl h1 + · by_cases h2 : x = partMax S - partBase S + 1 + · exact Or.inr (Or.inl (by omega)) + · exact Or.inr (Or.inr (Or.inr ⟨h2, h1, hx⟩)) +/-- The α-operation is a left inverse of the β-operation. -/ +theorem alphaOp_betaOp (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsBeta n) : + alphaOp (betaOp S) = S := by + have hne := DPbeta_nonempty n S hS + have h0 := DP_zero_not_mem n S (DPbeta_mem_DP n S hS) + have hspos := partSlope_pos S hne + have hm2 := DPbeta_max_ge_2slope_add_1 n S hS + have hs_not := DPbeta_slope_not_mem n S hS + have hms_not := DPbeta_m_sub_s_not_mem n S hS + have hmax := partMax_mem S hne + simp only [alphaOp, betaOp_partBase n S hS, betaOp_partMax n S hS] + simp only [betaOp] + ext x + simp only [mem_insert, mem_erase, ne_eq] + constructor + · rintro (rfl | ⟨h1, h2, -, rfl | rfl | hx⟩) + · rw [show partMax S - 1 + 1 = partMax S by omega] + exact hmax + · exact absurd rfl h2 + · exact absurd (by omega) h1 + · exact hx + · intro hx + by_cases hxm : x = partMax S + · exact Or.inl (by omega) + · refine Or.inr ⟨?_, ?_, hxm, Or.inr (Or.inr hx)⟩ + · rintro rfl + exact hms_not (by rwa [show partMax S - 1 - partSlope S + 1 = partMax S - partSlope S + by omega] at hx) + · rintro rfl + exact hs_not hx +/-- `alphaOp` is injective on `distinctPartitionsAlpha n`, since `betaOp` is a left inverse. -/ +theorem alphaOp_inj (n : ℕ) {S T : Finset ℕ} (hS : S ∈ distinctPartitionsAlpha n) + (hT : T ∈ distinctPartitionsAlpha n) (h : alphaOp S = alphaOp T) : S = T := by + rw [← betaOp_alphaOp n S hS, ← betaOp_alphaOp n T hT, h] +/-- Franklin's involution gives a bijection: |α(n)| = |β(n)|. -/ +theorem DPalpha_card_eq_DPbeta_card (n : ℕ) : + (distinctPartitionsAlpha n).card = (distinctPartitionsBeta n).card := + card_bij (fun S _ => alphaOp S) (fun S hS => alphaOp_mem_DPbeta n S hS) + (fun _ h₁ _ h₂ h => alphaOp_inj n h₁ h₂ h) + fun T hT => ⟨betaOp T, betaOp_mem_DPalpha n T hT, alphaOp_betaOp n T hT⟩ +/-- The α-operation preserves the number of parts. -/ +theorem alphaOp_card (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsAlpha n) : + (alphaOp S).card + 1 = S.card := by + have hne := DPalpha_nonempty n S hS + have hb : partBase S ∈ S := partBase_mem S hne + have hm : partMax S - partBase S + 1 ∈ S := DPalpha_m_sub_b_add_1_mem n S hS + have hbm : partBase S ≠ partMax S - partBase S + 1 := DPalpha_base_ne_m_sub_b_add_1 n S hS + have h2 : 1 < S.card := one_lt_card.mpr ⟨_, hb, _, hm, hbm⟩ + have hnot : partMax S + 1 ∉ (S.erase (partBase S)).erase (partMax S - partBase S + 1) := + fun h => partMax_succ_not_mem S hne (mem_of_mem_erase (mem_of_mem_erase h)) + simp only [alphaOp] + rw [card_insert_of_notMem hnot, card_erase_of_mem (mem_erase_of_ne_of_mem hbm.symm hm), + card_erase_of_mem hb] + omega +/-- The β-operation preserves the number of parts. -/ +theorem betaOp_card (n : ℕ) (S : Finset ℕ) (hS : S ∈ distinctPartitionsBeta n) : + (betaOp S).card = S.card + 1 := by + have hs : partSlope S ∉ S := DPbeta_slope_not_mem n S hS + have hms : partMax S - partSlope S ∉ S := DPbeta_m_sub_s_not_mem n S hS + have hne : partSlope S ≠ partMax S - partSlope S := DPbeta_slope_ne_m_sub_slope n S hS + have hm : partMax S ∈ S := partMax_mem S (DPbeta_nonempty n S hS) + simp only [betaOp] + rw [card_erase_of_mem (mem_insert_of_mem (mem_insert_of_mem hm)), + card_insert_of_notMem (by simp [hne, hs]), card_insert_of_notMem hms] + omega +/-- Franklin's involution refined by a condition on the number of parts: `α` matches the members +of `𝒫_α(n)` whose size satisfies `p` with those of `𝒫_β(n)` whose size satisfies `q`, provided +`p (a + 1)` and `q a` always agree (recall `|α(S)| + 1 = |S|`). -/ +theorem DPalpha_filter_card_eq (n : ℕ) (p q : ℕ → Prop) [DecidablePred p] [DecidablePred q] + (hpq : ∀ a : ℕ, p (a + 1) ↔ q a) : + ((distinctPartitionsAlpha n).filter fun S => p S.card).card = + ((distinctPartitionsBeta n).filter fun S => q S.card).card := by + refine card_bij (fun S _ => alphaOp S) ?_ (fun _ h₁ _ h₂ h => + alphaOp_inj n (mem_filter.mp h₁).1 (mem_filter.mp h₂).1 h) ?_ + · intro S hS + obtain ⟨hS, hp⟩ := mem_filter.mp hS + exact mem_filter.mpr ⟨alphaOp_mem_DPbeta n S hS, (hpq _).mp (by rwa [alphaOp_card n S hS])⟩ + · intro T hT + obtain ⟨hT, hq⟩ := mem_filter.mp hT + refine ⟨betaOp T, mem_filter.mpr ⟨betaOp_mem_DPalpha n T hT, ?_⟩, alphaOp_betaOp n T hT⟩ + rw [betaOp_card n T hT] + exact (hpq _).mpr hq +/-- |{S ∈ α(n) : |S| odd}| = |{S ∈ β(n) : |S| even}|. -/ +theorem DPalpha_odd_card_eq_DPbeta_even_card (n : ℕ) : + ((distinctPartitionsAlpha n).filter (fun S => S.card % 2 = 1)).card = + ((distinctPartitionsBeta n).filter (fun S => S.card % 2 = 0)).card := + DPalpha_filter_card_eq n (· % 2 = 1) (· % 2 = 0) fun _ => by omega +/-- |{S ∈ α(n) : |S| even}| = |{S ∈ β(n) : |S| odd}|. -/ +theorem DPalpha_even_card_eq_DPbeta_odd_card (n : ℕ) : + ((distinctPartitionsAlpha n).filter (fun S => S.card % 2 = 0)).card = + ((distinctPartitionsBeta n).filter (fun S => S.card % 2 = 1)).card := + DPalpha_filter_card_eq n (· % 2 = 0) (· % 2 = 1) fun _ => by omega +/-- Any filtered count of `distinctPartitions n` splits along the α/β/special decomposition. -/ +theorem DP_card_filter_split (n : ℕ) (P : Finset ℕ → Prop) [DecidablePred P] : + ((distinctPartitions n).filter P).card = + ((distinctPartitionsAlpha n).filter P).card + ((distinctPartitionsBeta n).filter P).card + + ((distinctPartitionsSpecial n).filter P).card := by + have hab : Disjoint (distinctPartitionsAlpha n) (distinctPartitionsBeta n) := + disjoint_iff_inter_eq_empty.mpr (DPalpha_inter_DPbeta n) + have hac : Disjoint (distinctPartitionsAlpha n) (distinctPartitionsSpecial n) := + disjoint_iff_inter_eq_empty.mpr (DPalpha_inter_DPspecial n) + have hbc : Disjoint (distinctPartitionsBeta n) (distinctPartitionsSpecial n) := + disjoint_iff_inter_eq_empty.mpr (DPbeta_inter_DPspecial n) + rw [DP_eq_union, filter_union, filter_union, + card_union_of_disjoint (disjoint_union_left.mpr + ⟨disjoint_filter_filter hac, disjoint_filter_filter hbc⟩), + card_union_of_disjoint (disjoint_filter_filter hab)] +/-- pe(n) - po(n) equals the signed count of special partitions. -/ +theorem pe_minus_po_eq_special (n : ℕ) : + (pe n : ℤ) - po n = + ((distinctPartitionsSpecial n).filter (fun S => S.card % 2 = 0)).card - + ((distinctPartitionsSpecial n).filter (fun S => S.card % 2 = 1)).card := by + have h0 := DP_card_filter_split n fun S => S.card % 2 = 0 + have h1 := DP_card_filter_split n fun S => S.card % 2 = 1 + have he := DPalpha_even_card_eq_DPbeta_odd_card n + have ho := DPalpha_odd_card_eq_DPbeta_even_card n + simp only [pe, po, distinctPartitionsEven, distinctPartitionsOdd] + omega +/-- **Lemma 24 (Source), case n = 0**: `p_e(0) − p_o(0) = 1`. -/ +theorem pe_minus_po_zero : (pe 0 : ℤ) - po 0 = 1 := by decide +/-- For non-pentagonal n ≥ 1, pe(n) - po(n) = 0. -/ +theorem pe_minus_po_nonpent (n : ℕ) (hn : 1 ≤ n) + (h1 : ∀ k, 1 ≤ k → 2 * n ≠ 3 * k ^ 2 - k) + (h2 : ∀ k, 1 ≤ k → 2 * n ≠ 3 * k ^ 2 + k) : + (pe n : ℤ) - po n = 0 := by + rw [pe_minus_po_eq_special, DPspecial_empty_of_nonpent n hn h1 h2] + simp +/-- The signed count of a one-element family of partitions with `k` parts is `(-1) ^ k`. -/ +theorem signed_card_of_singleton (T : Finset ℕ) (k : ℕ) (hT : T.card = k) : + ((({T} : Finset (Finset ℕ)).filter (fun S => S.card % 2 = 0)).card : ℤ) - + (({T} : Finset (Finset ℕ)).filter (fun S => S.card % 2 = 1)).card = (-1) ^ k := by + rw [filter_singleton, filter_singleton, hT] + rcases Nat.even_or_odd k with h | h + · have hk : k % 2 = 0 := Nat.even_iff.mp h + rw [ite_eq_left hk, ite_eq_right (by omega), h.neg_one_pow] + simp + · have hk : k % 2 = 1 := Nat.odd_iff.mp h + rw [ite_eq_right (by omega), ite_eq_left hk, h.neg_one_pow] + simp +/-- For n = (3k²-k)/2, pe(n) - po(n) = (-1)^k. -/ +theorem pe_minus_po_pent_minus (n k : ℕ) (hk : 1 ≤ k) (hn : 2 * n = 3 * k ^ 2 - k) : + (pe n : ℤ) - po n = (-1) ^ k := by + rw [pe_minus_po_eq_special, DPspecial_pent_minus n k hk hn] + exact signed_card_of_singleton _ k (SmkSet_card k hk) +/-- For n = (3k²+k)/2, pe(n) - po(n) = (-1)^k. -/ +theorem pe_minus_po_pent_plus (n k : ℕ) (hk : 1 ≤ k) (hn : 2 * n = 3 * k ^ 2 + k) : + (pe n : ℤ) - po n = (-1) ^ k := by + rw [pe_minus_po_eq_special, DPspecial_pent_plus n k hk hn] + exact signed_card_of_singleton _ k (SpkSet_card k hk) + +end PentagonalNumberTheorem.Franklin diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/QSeries.lean b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries.lean new file mode 100644 index 0000000000..226e603362 --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries.lean @@ -0,0 +1,19 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ + +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.CauchyIdentity +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.Defs +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.EulerIdentities +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.FPS +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.FPSAlgebra +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.FPSEuler +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.FiniteBinomial +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.InfPochhammer +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.JTPAnalytic +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.JTPCore +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.JTPKeyIdentity +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.JacobiTripleProduct +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.PentagonalNumber diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/CauchyIdentity.lean b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/CauchyIdentity.lean new file mode 100644 index 0000000000..7e9a26a4a6 --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/CauchyIdentity.lean @@ -0,0 +1,260 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.InfPochhammer +import Mathlib.Analysis.Normed.Group.Tannery + +/-! +# The Cauchy identity (infinite q-binomial theorem) + +This file proves the **infinite q-binomial / Cauchy identity**: +for $\|q\| < 1$ and $\|z\| < 1$, +$$\sum_{n=0}^{\infty} \frac{(a;q)_n}{(q;q)_n} z^n = \frac{(az;q)_\infty}{(z;q)_\infty}.$$ + +The proof follows Heine's classical functional-equation argument. + +## Main results + +* `QSeries.hasSum_qPochhammer_div_mul_pow` — the Cauchy identity. +-/ + +open Finset Filter +open scoped Topology + +namespace QSeries + +section CauchyIdentity + +/-- A product of two complex numbers of norm `< 1` again has norm `< 1`. -/ +private theorem norm_mul_lt_one {q z : ℂ} (hq : ‖q‖ < 1) (hz : ‖z‖ < 1) : + ‖q * z‖ < 1 := by + rw [norm_mul] + nlinarith [norm_nonneg q, norm_nonneg z] + +/-- If `‖q‖ < 1` and `‖z‖ < 1` then `‖q ^ n * z‖ < 1` for every `n`. -/ +private theorem norm_pow_mul_lt_one {q z : ℂ} (hq : ‖q‖ < 1) (hz : ‖z‖ < 1) (n : ℕ) : + ‖q ^ n * z‖ < 1 := by + rw [norm_mul, norm_pow] + nlinarith [pow_le_one₀ (norm_nonneg q) hq.le (n := n), norm_nonneg z, + pow_nonneg (norm_nonneg q) n] + +/-- The coefficient sequence $c_n = (a;q)_n / (q;q)_n$. -/ +noncomputable def cauchyCoeff (a q : ℂ) (n : ℕ) : ℂ := + qPochhammer a q n / qPochhammer q q n + +/-- The zeroth Cauchy coefficient $c_0 = 1$. -/ +@[simp] theorem cauchyCoeff_zero (a q : ℂ) : cauchyCoeff a q 0 = 1 := by + simp [cauchyCoeff] + +/-- **Coefficient recurrence.** $c_{n+1}(1 - q^{n+1}) = c_n(1 - aq^n)$. -/ +theorem cauchyCoeff_succ_mul {q : ℂ} (hq : ‖q‖ < 1) (a : ℂ) (n : ℕ) : + cauchyCoeff a q (n + 1) * (1 - q ^ (n + 1)) + = cauchyCoeff a q n * (1 - a * q ^ n) := by + unfold cauchyCoeff + have hqn : qPochhammer q q n ≠ 0 := qPochhammer_self_ne_zero hq n + have hqn1 : qPochhammer q q (n + 1) ≠ 0 := qPochhammer_self_ne_zero hq (n + 1) + rw [qPochhammer_succ a q n, qPochhammer_succ q q n, + show (1 : ℂ) - q * q ^ n = 1 - q ^ (n + 1) from by ring] + have hq_ne : (1 : ℂ) - q ^ (n + 1) ≠ 0 := fun habs => + hqn1 (by rw [qPochhammer_succ q q n, + show (1 : ℂ) - q * q ^ n = 1 - q ^ (n + 1) from by ring, habs, mul_zero]) + field_simp + +/-- **Boundedness of the coefficients.** + +The quotients `(a;q)_n / (q;q)_n` converge, hence form a bounded sequence. -/ +theorem exists_norm_cauchyCoeff_le {q : ℂ} (hq : ‖q‖ < 1) (a : ℂ) : + ∃ C, ∀ n, ‖cauchyCoeff a q n‖ ≤ C := by + have h : Tendsto (fun n => ‖cauchyCoeff a q n‖) atTop + (𝓝 ‖qPochhammerInf a q / qPochhammerInf q q‖) := + ((tendsto_qPochhammer hq).div (tendsto_qPochhammer hq) + (qPochhammerInf_ne_zero hq hq)).norm + obtain ⟨C, hC⟩ := h.bddAbove_range + exact ⟨C, fun n => hC ⟨n, rfl⟩⟩ + +/-- The series $\sum_n c_n z^n$ is summable for $\|z\| < 1$. -/ +theorem summable_cauchyCoeff_mul_pow {a q z : ℂ} (hq : ‖q‖ < 1) (hz : ‖z‖ < 1) : + Summable (fun n : ℕ => cauchyCoeff a q n * z ^ n) := by + obtain ⟨C, hC⟩ := exists_norm_cauchyCoeff_le hq a + have hCnn : 0 ≤ C := le_trans (norm_nonneg _) (hC 0) + refine Summable.of_norm_bounded (g := fun n => C * ‖z‖ ^ n) + ((summable_geometric_of_lt_one (norm_nonneg z) hz).mul_left C) fun n => ?_ + rw [norm_mul, norm_pow] + exact mul_le_mul (hC n) le_rfl (pow_nonneg (norm_nonneg z) n) hCnn + +/-- **Functional equation for $G$.** +$(1-z)\, G(z) = (1 - az)\, G(qz)$. -/ +theorem one_sub_mul_qPochhammerInf_div_eq (a z : ℂ) {q : ℂ} (hq : ‖q‖ < 1) (hz : ‖z‖ < 1) : + (1 - z) * (qPochhammerInf (a * z) q / qPochhammerInf z q) + = (1 - a * z) * + (qPochhammerInf (a * z * q) q / qPochhammerInf (z * q) q) := by + have hz_ne : qPochhammerInf z q ≠ 0 := qPochhammerInf_ne_zero hz hq + have hzq_ne : qPochhammerInf (z * q) q ≠ 0 := + qPochhammerInf_ne_zero (norm_mul_lt_one hz hq) hq + have hone_sub_z_ne : (1 : ℂ) - z ≠ 0 := fun h => by + rw [show z = 1 from by linear_combination -h] at hz; norm_num at hz + rw [qPochhammerInf_eq_one_sub_mul (z := z) hq, qPochhammerInf_eq_one_sub_mul (z := a * z) hq] + field_simp + +/-- **The shifted-difference series.** + +If `d 0 = 1` and `∑ d n zⁿ = S`, then the series with terms `(d n - u * d (n-1)) zⁿ` +(and constant term `1`) sums to `(1 - u z) S`. This is the single computation behind +both sides of the functional equation for `F`. -/ +private theorem hasSum_ite_sub_mul_pow {d : ℕ → ℂ} {z u S : ℂ} (hd0 : d 0 = 1) + (hd : HasSum (fun n : ℕ => d n * z ^ n) S) : + HasSum (fun n : ℕ => if n = 0 then (1 : ℂ) else (d n - u * d (n - 1)) * z ^ n) + ((1 - u * z) * S) := by + set g : ℕ → ℂ := fun n => if n = 0 then 0 else u * d (n - 1) * z ^ n with hg_def + have hg : HasSum g (u * z * S) := by + refine (hasSum_nat_add_iff' (f := g) 1).mp ?_ + have hshift : (fun n : ℕ => g (n + 1)) = fun n : ℕ => u * z * (d n * z ^ n) := by + funext n + simp only [hg_def, ite_eq_right (Nat.succ_ne_zero n), Nat.add_sub_cancel, pow_succ] + ring + rw [hshift] + simpa [hg_def] using hd.mul_left (u * z) + have hfun : (fun n : ℕ => if n = 0 then (1 : ℂ) else (d n - u * d (n - 1)) * z ^ n) + = fun n : ℕ => d n * z ^ n - g n := by + funext n + by_cases hn : n = 0 + · simp [hn, hg_def, hd0] + · simp only [ite_eq_right hn, hg_def]; ring + rw [hfun, show (1 - u * z) * S = S - u * z * S from by ring] + exact hd.sub hg + +private theorem hasSum_one_sub_mul_tsum_cauchyCoeff {a q z : ℂ} (hq : ‖q‖ < 1) (hz : ‖z‖ < 1) : + HasSum (fun n : ℕ => if n = 0 then (1 : ℂ) + else (cauchyCoeff a q n - cauchyCoeff a q (n - 1)) * z ^ n) + ((1 - z) * ∑' n, cauchyCoeff a q n * z ^ n) := by + simpa using hasSum_ite_sub_mul_pow (u := 1) (cauchyCoeff_zero a q) + (summable_cauchyCoeff_mul_pow hq hz).hasSum + +private theorem hasSum_one_sub_mul_tsum_cauchyCoeff_mul_pow {a q z : ℂ} (hq : ‖q‖ < 1) + (hz : ‖z‖ < 1) : + HasSum (fun n : ℕ => if n = 0 then (1 : ℂ) + else (cauchyCoeff a q n * q ^ n + - a * cauchyCoeff a q (n - 1) * q ^ (n - 1)) * z ^ n) + ((1 - a * z) * ∑' n, cauchyCoeff a q n * (q * z) ^ n) := by + have hd : HasSum (fun n : ℕ => cauchyCoeff a q n * q ^ n * z ^ n) + (∑' n, cauchyCoeff a q n * (q * z) ^ n) := by + simpa [mul_pow, mul_assoc] using + (summable_cauchyCoeff_mul_pow hq (norm_mul_lt_one hq hz)).hasSum + simpa [mul_assoc] using + hasSum_ite_sub_mul_pow (u := a) (d := fun n => cauchyCoeff a q n * q ^ n) + (by simp) hd + +/-- **Functional equation for $F$.** +$(1-z)\, F(z) = (1 - az)\, F(qz)$. -/ +theorem one_sub_mul_tsum_cauchyCoeff_eq {a q z : ℂ} (hq : ‖q‖ < 1) (hz : ‖z‖ < 1) : + (1 - z) * ∑' n, cauchyCoeff a q n * z ^ n + = (1 - a * z) * ∑' n, cauchyCoeff a q n * (q * z) ^ n := by + have hL := hasSum_one_sub_mul_tsum_cauchyCoeff (a := a) (q := q) (z := z) hq hz + have hfunc : (fun n : ℕ => if n = 0 then (1 : ℂ) + else (cauchyCoeff a q n - cauchyCoeff a q (n - 1)) * z ^ n) + = (fun n : ℕ => if n = 0 then (1 : ℂ) + else (cauchyCoeff a q n * q ^ n + - a * cauchyCoeff a q (n - 1) * q ^ (n - 1)) * z ^ n) := by + ext n + obtain _ | m := n + · simp + · simp only [ite_eq_right (Nat.succ_ne_zero m), Nat.succ_sub_one] + rw [show cauchyCoeff a q (m + 1) - cauchyCoeff a q m + = cauchyCoeff a q (m + 1) * q ^ (m + 1) - a * cauchyCoeff a q m * q ^ m from by + linear_combination cauchyCoeff_succ_mul (a := a) hq m] + rw [hfunc] at hL + exact hL.unique (hasSum_one_sub_mul_tsum_cauchyCoeff_mul_pow hq hz) + +/-- **Iterated functional equation.** -/ +theorem mul_qPochhammer_eq_of_functional_eq {H : ℂ → ℂ} {a q : ℂ} (hq : ‖q‖ < 1) + (hH : ∀ w, ‖w‖ < 1 → (1 - w) * H w = (1 - a * w) * H (q * w)) + {z : ℂ} (hz : ‖z‖ < 1) : + ∀ n : ℕ, H z * qPochhammer z q n + = H (q ^ n * z) * qPochhammer (a * z) q n := by + intro n + induction n with + | zero => simp + | succ n ih => + have key := hH _ (norm_pow_mul_lt_one hq hz n) + rw [show q * (q ^ n * z) = q ^ (n + 1) * z from by ring] at key + rw [qPochhammer_succ z q n, qPochhammer_succ (a * z) q n] + linear_combination (1 - q ^ n * z) * ih + qPochhammer (a * z) q n * key + +/-- **$F(q^n z) \to 1$ as $n \to \infty$**, by Tannery's theorem. -/ +theorem tendsto_tsum_cauchyCoeff_mul_pow {a q z : ℂ} (hq : ‖q‖ < 1) (hz : ‖z‖ < 1) : + Tendsto (fun n : ℕ => ∑' k, cauchyCoeff a q k * (q ^ n * z) ^ k) + atTop (𝓝 1) := by + obtain ⟨C, hC⟩ := exists_norm_cauchyCoeff_le hq a + have hCnn : 0 ≤ C := le_trans (norm_nonneg _) (hC 0) + set g : ℕ → ℂ := fun k => if k = 0 then 1 else 0 with hg_def + have hab : ∀ k : ℕ, Tendsto (fun n : ℕ => cauchyCoeff a q k * (q ^ n * z) ^ k) + atTop (𝓝 (g k)) := by + intro k + obtain _ | m := k + · simp [hg_def] + · have hqpow : ‖q ^ (m + 1)‖ < 1 := by + rw [norm_pow]; exact pow_lt_one₀ (norm_nonneg _) hq (Nat.succ_ne_zero m) + have hmul := (tendsto_pow_atTop_nhds_zero_of_norm_lt_one hqpow).const_mul + (cauchyCoeff a q (m + 1) * z ^ (m + 1)) + simp only [hg_def, ite_eq_right (Nat.succ_ne_zero m), mul_zero] at hmul ⊢ + exact hmul.congr fun n => by ring + have h_bound : ∀ᶠ n in atTop, ∀ k : ℕ, + ‖cauchyCoeff a q k * (q ^ n * z) ^ k‖ ≤ C * ‖z‖ ^ k := by + refine Filter.Eventually.of_forall fun n k => ?_ + rw [norm_mul, norm_pow, norm_mul, norm_pow, mul_pow] + calc ‖cauchyCoeff a q k‖ * ((‖q‖ ^ n) ^ k * ‖z‖ ^ k) + = ‖cauchyCoeff a q k‖ * (‖q‖ ^ n) ^ k * ‖z‖ ^ k := by ring + _ ≤ C * 1 * ‖z‖ ^ k := by + gcongr + · exact hC k + · exact pow_le_one₀ (pow_nonneg (norm_nonneg _) n) + (pow_le_one₀ (norm_nonneg _) hq.le) + _ = C * ‖z‖ ^ k := by ring + have h := tendsto_tsum_of_dominated_convergence + ((summable_geometric_of_lt_one (norm_nonneg z) hz).mul_left C) hab h_bound + have hgsum : (∑' k : ℕ, g k) = 1 := by + rw [tsum_eq_single 0 fun k hk => by simp [hg_def, hk]]; simp [hg_def] + rwa [hgsum] at h + +/-- **Infinite q-binomial / Cauchy identity.** + +For $\|q\| < 1$ and $\|z\| < 1$, +$$\sum_{n=0}^{\infty} \frac{(a;q)_n}{(q;q)_n} z^n = \frac{(az;q)_\infty}{(z;q)_\infty}.$$ -/ +theorem hasSum_qPochhammer_div_mul_pow (a z q : ℂ) (hq : ‖q‖ < 1) (hz : ‖z‖ < 1) : + HasSum (fun n : ℕ => qPochhammer a q n / qPochhammer q q n * z ^ n) + (qPochhammerInf (a * z) q / qPochhammerInf z q) := by + change HasSum (fun n => cauchyCoeff a q n * z ^ n) _ + have hF_summable : Summable (fun n : ℕ => cauchyCoeff a q n * z ^ n) := + summable_cauchyCoeff_mul_pow hq hz + set F : ℂ := ∑' n, cauchyCoeff a q n * z ^ n with hF_def + have hden_ne : qPochhammerInf z q ≠ 0 := qPochhammerInf_ne_zero hz hq + suffices hFG : F * qPochhammerInf z q = qPochhammerInf (a * z) q by + rw [← (eq_div_iff hden_ne).mpr hFG] + exact hF_summable.hasSum + set H : ℂ → ℂ := fun w => if ‖w‖ < 1 then ∑' k, cauchyCoeff a q k * w ^ k else 0 + with hH_def + have hH_disc : ∀ w, ‖w‖ < 1 → H w = ∑' k, cauchyCoeff a q k * w ^ k := + fun w hw => by simp [hH_def, hw] + have hH_fe : ∀ w, ‖w‖ < 1 → (1 - w) * H w = (1 - a * w) * H (q * w) := by + intro w hw + rw [hH_disc w hw, hH_disc _ (norm_mul_lt_one hq hw)] + exact one_sub_mul_tsum_cauchyCoeff_eq hq hw + have key : ∀ n : ℕ, + F * qPochhammer z q n = H (q ^ n * z) * qPochhammer (a * z) q n := by + rw [hF_def, ← hH_disc z hz] + exact mul_qPochhammer_eq_of_functional_eq hq hH_fe hz + have hH_lim : Tendsto (fun n => H (q ^ n * z)) atTop (𝓝 1) := + (tendsto_tsum_cauchyCoeff_mul_pow hq hz).congr fun n => + (hH_disc _ (norm_pow_mul_lt_one hq hz n)).symm + have hLHS : Tendsto (fun n => F * qPochhammer z q n) atTop + (𝓝 (F * qPochhammerInf z q)) := (tendsto_qPochhammer hq).const_mul F + have hRHS : Tendsto (fun n => H (q ^ n * z) * qPochhammer (a * z) q n) atTop + (𝓝 (qPochhammerInf (a * z) q)) := by + simpa using hH_lim.mul (tendsto_qPochhammer (a := a * z) hq) + exact tendsto_nhds_unique (by simpa [key] using hLHS) hRHS + +end CauchyIdentity + +end QSeries diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/Defs.lean b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/Defs.lean new file mode 100644 index 0000000000..3f3bcf8c25 --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/Defs.lean @@ -0,0 +1,175 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import Mathlib.Algebra.BigOperators.Group.Finset.Basic +import Mathlib.Data.Nat.Choose.Basic +import Mathlib.Tactic.Linarith +import Mathlib.Tactic.LinearCombination +import Mathlib.Tactic.Ring.RingNF +import Mathlib.Topology.Defs.Filter + +/-! +# q-Pochhammer symbol and Gaussian binomial coefficient + +This file defines the finite q-Pochhammer symbol $(a;q)_n$ and the Gaussian +binomial coefficient $\binom{n}{k}_q$, together with their basic properties. + +## Main definitions + +* `QSeries.qPochhammer a q n` — the finite q-Pochhammer symbol + $(a;q)_n = \prod_{k=0}^{n-1}(1 - a q^k)$. +* `QSeries.qBinom n k q` — the Gaussian binomial coefficient $\binom{n}{k}_q$, + defined via the q-Pascal recurrence. + +## Main results + +* `QSeries.qPochhammer_succ` — the recurrence $(a;q)_{n+1} = (a;q)_n (1 - aq^n)$. +* `QSeries.qBinom_succ_succ` — the q-Pascal recurrence. +* `QSeries.qBinom_eq_zero_of_lt` — vanishing above the diagonal. +* `QSeries.qBinom_self` — diagonal value is 1. +* `QSeries.qBinom_mul_qPochhammer_mul_qPochhammer` — closed-form identity + $\binom{n}{k}_q (q;q)_k (q;q)_{n-k} = (q;q)_n$. +-/ + +open Finset Filter +open scoped Topology + +namespace QSeries.Nat + +/-- Pascal's rule specialised to `C(·, 2)`. -/ +theorem choose_two_succ (n : ℕ) : (n + 1).choose 2 = n.choose 2 + n := by + rw [Nat.choose_succ_succ, Nat.choose_one_right, add_comm] + +/-- `C(m+k,2) + C(m,2) + m = C(k,2) + m*(m+k)`. -/ +theorem choose_two_add_choose_two (m k : ℕ) : + (m + k).choose 2 + m.choose 2 + m = k.choose 2 + m * (m + k) := by + induction m with + | zero => simp + | succ m ih => + rw [show m + 1 + k = (m + k) + 1 from by omega, choose_two_succ, choose_two_succ]; linarith + +/-- `C(n,2) + C(n+l+1,2) + (n+l+1) = C(l+2,2) + n*(n+l+1)`. -/ +theorem choose_two_add_choose_two' (n l : ℕ) : + n.choose 2 + (n + (l + 1)).choose 2 + (n + (l + 1)) = + (l + 2).choose 2 + n * (n + (l + 1)) := by + have h := choose_two_add_choose_two n (l + 1) + have h2 : (l + 2).choose 2 = (l + 1).choose 2 + (l + 1) := choose_two_succ (l + 1) + linarith + +/-- `C(k,2)` is at least `k - 1`. -/ +theorem le_choose_two_add_one (k : ℕ) : k ≤ k.choose 2 + 1 := by + induction k with + | zero => omega + | succ k ih => rw [choose_two_succ]; omega + +/-- `C(k,2)` eventually dominates: `d < C(k,2)` as soon as `d + 2 ≤ k`. -/ +theorem lt_choose_two_of_add_two_le {d k : ℕ} (hk : d + 2 ≤ k) : d < k.choose 2 := by + have := le_choose_two_add_one k + omega + +end QSeries.Nat + +namespace QSeries + +variable {R : Type*} + +/-- **Finite q-Pochhammer symbol.** +$(a;q)_n = \prod_{k=0}^{n-1} (1 - a q^k)$. -/ +def qPochhammer [CommRing R] (a q : R) (n : ℕ) : R := + ∏ k ∈ range n, (1 - a * q ^ k) + +/-- The empty q-Pochhammer product $(a;q)_0 = 1$. -/ +@[simp] +theorem qPochhammer_zero [CommRing R] (a q : R) : qPochhammer a q 0 = 1 := by + simp [qPochhammer] + +/-- **Recurrence for q-Pochhammer.** $(a;q)_{n+1} = (a;q)_n \cdot (1 - a q^n)$. -/ +theorem qPochhammer_succ [CommRing R] (a q : R) (n : ℕ) : + qPochhammer a q (n + 1) = qPochhammer a q n * (1 - a * q ^ n) := by + simp [qPochhammer, prod_range_succ] + +/-- **Gaussian binomial coefficient** $\binom{n}{k}_q$. + +Defined by the q-Pascal recurrence so that the result is always a polynomial +in $q$ (no division). The boundary cases are +$\binom{0}{0}_q = 1$, $\binom{0}{k+1}_q = 0$, $\binom{n+1}{0}_q = 1$. -/ +def qBinom [CommRing R] : ℕ → ℕ → R → R + | 0, 0, _ => 1 + | 0, _ + 1, _ => 0 + | _ + 1, 0, _ => 1 + | n + 1, k + 1, q => qBinom n (k + 1) q + q ^ (n - k) * qBinom n k q + +/-- The Gaussian binomial coefficient $\binom{0}{0}_q = 1$. -/ +@[simp] theorem qBinom_zero_zero [CommRing R] (q : R) : qBinom 0 0 q = 1 := rfl + +/-- The Gaussian binomial coefficient $\binom{0}{k+1}_q = 0$. -/ +@[simp] theorem qBinom_zero_succ [CommRing R] (k : ℕ) (q : R) : + qBinom 0 (k + 1) q = 0 := rfl + +/-- The Gaussian binomial coefficient $\binom{n+1}{0}_q = 1$. -/ +@[simp] theorem qBinom_succ_zero [CommRing R] (n : ℕ) (q : R) : + qBinom (n + 1) 0 q = 1 := rfl + +/-- The Gaussian binomial coefficient $\binom{n}{0}_q = 1$ for all $n$. -/ +@[simp] theorem qBinom_zero_right [CommRing R] (n : ℕ) (q : R) : + qBinom n 0 q = 1 := by cases n <;> rfl + +/-- The q-Pascal recurrence $\binom{n+1}{k+1}_q = \binom{n}{k+1}_q + q^{n-k}\binom{n}{k}_q$. -/ +theorem qBinom_succ_succ [CommRing R] (n k : ℕ) (q : R) : + qBinom (n + 1) (k + 1) q + = qBinom n (k + 1) q + q ^ (n - k) * qBinom n k q := rfl + +/-- $\binom{n}{k}_q = 0$ whenever $k > n$. -/ +theorem qBinom_eq_zero_of_lt [CommRing R] (q : R) : + ∀ {n k : ℕ}, n < k → qBinom n k q = 0 + | 0, 0, h => absurd h (Nat.lt_irrefl _) + | 0, _ + 1, _ => rfl + | _ + 1, 0, h => absurd h (Nat.not_lt_zero _) + | n + 1, k + 1, h => by + rw [qBinom_succ_succ, + qBinom_eq_zero_of_lt q (show n < k + 1 by omega), + qBinom_eq_zero_of_lt q (show n < k by omega)] + ring + +/-- $\binom{n}{n}_q = 1$. -/ +theorem qBinom_self [CommRing R] (q : R) : ∀ n : ℕ, qBinom n n q = 1 + | 0 => rfl + | n + 1 => by + rw [qBinom_succ_succ, qBinom_eq_zero_of_lt q (Nat.lt_succ_self n), + qBinom_self q n, Nat.sub_self, pow_zero] + ring + +/-- **Closed-form identity.** +For $k \leq n$: $\binom{n}{k}_q (q;q)_k (q;q)_{n-k} = (q;q)_n$. -/ +theorem qBinom_mul_qPochhammer_mul_qPochhammer [CommRing R] (q : R) : + ∀ {n k : ℕ}, k ≤ n → + qBinom n k q * qPochhammer q q k * qPochhammer q q (n - k) + = qPochhammer q q n := by + intro n + induction n with + | zero => + rintro k hk + obtain rfl : k = 0 := by omega + simp + | succ n ih => + rintro (_ | k) hk + · simp + obtain hlt | rfl : k + 1 ≤ n ∨ n = k := by omega + · -- Interior case: write `n = k + 1 + m` and feed in both induction hypotheses. + obtain ⟨m, rfl⟩ : ∃ m, n = k + 1 + m := ⟨n - (k + 1), by omega⟩ + have ih1 := ih (show k + 1 ≤ k + 1 + m by omega) + have ih2 := ih (show k ≤ k + 1 + m by omega) + rw [show k + 1 + m - (k + 1) = m from by omega, qPochhammer_succ q q k] at ih1 + rw [show k + 1 + m - k = m + 1 from by omega, qPochhammer_succ q q m] at ih2 + rw [qBinom_succ_succ, show k + 1 + m + 1 - (k + 1) = m + 1 from by omega, + show k + 1 + m - k = m + 1 from by omega, qPochhammer_succ q q k, + qPochhammer_succ q q m, qPochhammer_succ q q (k + 1 + m)] + linear_combination (1 - q * q ^ m) * ih1 + q ^ (m + 1) * (1 - q * q ^ k) * ih2 + · -- Diagonal case `k = n`. + rw [qBinom_succ_succ, qBinom_eq_zero_of_lt q (Nat.lt_succ_self _), qBinom_self, + Nat.sub_self, Nat.sub_self, pow_zero, qPochhammer_zero] + ring + +end QSeries diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/EulerIdentities.lean b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/EulerIdentities.lean new file mode 100644 index 0000000000..3896df8d21 --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/EulerIdentities.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import Mathlib.LinearAlgebra.Complex.FiniteDimensional +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.CauchyIdentity +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.FiniteBinomial + +/-! +# Euler's q-exponential identities + +Two classical specializations of the Cauchy identity: + +1. **First Euler identity** ($a = 0$): + $$\frac{1}{(z;q)_\infty} = \sum_{n \geq 0} \frac{z^n}{(q;q)_n}.$$ + +2. **Second Euler identity** (limit of the finite q-binomial theorem): + $$(-z;q)_\infty = \sum_{n \geq 0} \frac{q^{\binom{n}{2}}}{(q;q)_n} z^n.$$ + +## Main results + +* `QSeries.euler_first_identity` — the first Euler identity. +* `QSeries.euler_second_identity` — the second Euler identity. +-/ + +open Finset Filter +open scoped Topology + +namespace QSeries + +variable {R : Type*} + +/-- $(0;q)_n = 1$ for all $n$. -/ +@[simp] +theorem qPochhammer_zero_left [CommRing R] (q : R) (n : ℕ) : + qPochhammer 0 q n = 1 := by + simp [qPochhammer] + +/-- $(0;q)_\infty = 1$. -/ +@[simp] +theorem qPochhammerInf_zero_left (q : ℂ) : qPochhammerInf 0 q = 1 := by + simp [qPochhammerInf] + +/-- **First Euler identity.** +$$\sum_{n=0}^{\infty} \frac{z^n}{(q;q)_n} = \frac{1}{(z;q)_\infty}$$ +for $\|q\| < 1$ and $\|z\| < 1$. -/ +theorem euler_first_identity {q z : ℂ} (hq : ‖q‖ < 1) (hz : ‖z‖ < 1) : + HasSum (fun n : ℕ => z ^ n / qPochhammer q q n) + (1 / qPochhammerInf z q) := by + have h := hasSum_qPochhammer_div_mul_pow 0 z q hq hz + simp only [qPochhammer_zero_left, one_div] at h + convert h using 1 + · ext n; ring + · simp [zero_mul] + +section SecondEuler + +/-- The finite q-binomial theorem specialised to $z = -1$ gives a vanishing alternating sum +for every positive $n$. -/ +theorem sum_pow_choose_two_mul_qBinom_mul_neg_one_pow [CommRing R] (q : R) (n : ℕ) (hn : 0 < n) : + ∑ k ∈ Finset.range (n + 1), q ^ k.choose 2 * qBinom n k q * (-1) ^ k = 0 := by + rw [← prod_one_add_mul_pow_eq_sum_qBinom] + exact Finset.prod_eq_zero (Finset.mem_range.mpr hn) (by ring) + +/-- The series $\sum_{n \geq 0} q^{\binom{n}{2}} z^n / (q;q)_n$ is summable for $\|q\| < 1$ +and $\|z\| < 1$. -/ +theorem summable_euler_second {q z : ℂ} (hq : ‖q‖ < 1) (hz : ‖z‖ < 1) : + Summable (fun n : ℕ => q ^ n.choose 2 * z ^ n / qPochhammer q q n) := by + have h_const_mul : Summable fun n : ℕ => z ^ n / qPochhammer q q n := + (euler_first_identity hq hz).summable + rw [← summable_norm_iff] at h_const_mul ⊢ + refine Summable.of_nonneg_of_le (fun n => norm_nonneg _) (fun n => ?_) h_const_mul + rw [mul_div_assoc, norm_mul, norm_pow] + exact mul_le_of_le_one_left (norm_nonneg _) (pow_le_one₀ (norm_nonneg q) hq.le) + +/-- For $\|q\| < 1$ the ratio $(q;q)_N / (q;q)_{N-k}$ tends to $1$ as $N \to \infty$. -/ +private theorem tendsto_qPochhammer_self_div {q : ℂ} (hq : ‖q‖ < 1) (k : ℕ) : + Tendsto (fun N => qPochhammer q q N / qPochhammer q q (N - k)) atTop (𝓝 1) := by + have hne : qPochhammerInf q q ≠ 0 := qPochhammerInf_ne_zero hq hq + have h : Tendsto (fun N => qPochhammer q q (N + k) / qPochhammer q q N) atTop (𝓝 1) := by + have h1 : Tendsto (fun N => qPochhammer q q (N + k)) atTop (𝓝 (qPochhammerInf q q)) := + (tendsto_qPochhammer hq).comp (tendsto_add_atTop_nat k) + simpa [div_self hne, Pi.div_def] using h1.div (tendsto_qPochhammer hq) hne + rw [← tendsto_add_atTop_iff_nat k] + simpa using h + +/-- The ratios $(q;q)_N / (q;q)_{N-k}$ are bounded uniformly in both $k$ and $N$. -/ +private theorem exists_norm_qPochhammer_self_div_le {q : ℂ} (hq : ‖q‖ < 1) : + ∃ C, ∀ k N : ℕ, ‖qPochhammer q q N / qPochhammer q q (N - k)‖ ≤ C := by + have hne : qPochhammerInf q q ≠ 0 := qPochhammerInf_ne_zero hq hq + obtain ⟨A, hA⟩ := ((tendsto_qPochhammer hq).norm).bddAbove_range + obtain ⟨B, hB⟩ := (((tendsto_qPochhammer hq).inv₀ hne).norm).bddAbove_range + refine ⟨A * B, fun k N => ?_⟩ + rw [div_eq_mul_inv, norm_mul] + exact mul_le_mul (hA ⟨N, rfl⟩) (hB ⟨N - k, rfl⟩) (norm_nonneg _) + ((norm_nonneg _).trans (hA ⟨0, rfl⟩)) + +/-- **Second Euler identity**: for $\|q\|, \|z\| < 1$, the infinite product $(-z;q)_\infty$ +equals the series $\sum_{n \geq 0} q^{\binom{n}{2}} z^n / (q;q)_n$. -/ +theorem euler_second_identity {q z : ℂ} (hq : ‖q‖ < 1) (hz : ‖z‖ < 1) : + HasSum (fun n : ℕ => q ^ n.choose 2 * z ^ n / qPochhammer q q n) + (qPochhammerInf (-z) q) := by + have h_limit : Tendsto (fun N => ∑ k ∈ Finset.range (N + 1), + q ^ k.choose 2 * qBinom N k q * z ^ k) atTop (𝓝 (qPochhammerInf (-z) q)) := by + have hprod : Tendsto (fun N => ∏ k ∈ Finset.range N, (1 + z * q ^ k)) atTop + (𝓝 (qPochhammerInf (-z) q)) := by + convert tendsto_qPochhammer (a := -z) hq using 1 + exact funext fun n => Finset.prod_congr rfl fun _ _ => by ring + exact hprod.congr fun N => prod_one_add_mul_pow_eq_sum_qBinom q z N + have h_rewrite : ∀ N : ℕ, ∑ k ∈ Finset.range (N + 1), q ^ k.choose 2 * qBinom N k q * z ^ k = + ∑ k ∈ Finset.range (N + 1), q ^ k.choose 2 * z ^ k / qPochhammer q q k * + (qPochhammer q q N / qPochhammer q q (N - k)) := by + refine fun N => Finset.sum_congr rfl fun k hk => ?_ + have h_eq : qBinom N k q = + qPochhammer q q N / (qPochhammer q q k * qPochhammer q q (N - k)) := by + rw [eq_div_iff (mul_ne_zero (qPochhammer_self_ne_zero hq k) + (qPochhammer_self_ne_zero hq (N - k))), ← mul_assoc, + qBinom_mul_qPochhammer_mul_qPochhammer q (Finset.mem_range_succ_iff.mp hk)] + rw [h_eq] + field_simp + have h_tsum : Tendsto (fun N => ∑ k ∈ Finset.range (N + 1), + q ^ k.choose 2 * z ^ k / qPochhammer q q k * + (qPochhammer q q N / qPochhammer q q (N - k))) atTop + (𝓝 (∑' k : ℕ, q ^ k.choose 2 * z ^ k / qPochhammer q q k)) := by + obtain ⟨C, hC⟩ := exists_norm_qPochhammer_self_div_le (q := q) hq + have hC0 : 0 ≤ C := (norm_nonneg _).trans (hC 0 0) + have hdom : Tendsto (fun N => ∑' k : ℕ, if k < N + 1 then + q ^ k.choose 2 * z ^ k / qPochhammer q q k * + (qPochhammer q q N / qPochhammer q q (N - k)) else 0) atTop + (𝓝 (∑' k : ℕ, q ^ k.choose 2 * z ^ k / qPochhammer q q k)) := by + refine tendsto_tsum_of_dominated_convergence + (bound := fun k => ‖q ^ k.choose 2 * z ^ k / qPochhammer q q k‖ * C) + ((summable_euler_second hq hz).norm.mul_right C) (fun k => ?_) (.of_forall fun N k => ?_) + · have h1 : Tendsto (fun N => q ^ k.choose 2 * z ^ k / qPochhammer q q k * + (qPochhammer q q N / qPochhammer q q (N - k))) atTop + (𝓝 (q ^ k.choose 2 * z ^ k / qPochhammer q q k)) := by + simpa using tendsto_const_nhds.mul (tendsto_qPochhammer_self_div hq k) + refine h1.congr' ?_ + filter_upwards [eventually_gt_atTop k] with N hN + exact (ite_eq_left (by omega)).symm + · split_ifs + · rw [norm_mul] + exact mul_le_mul_of_nonneg_left (hC k N) (norm_nonneg _) + · simp only [norm_zero] + exact mul_nonneg (norm_nonneg _) hC0 + refine hdom.congr fun N => ?_ + rw [tsum_eq_sum (s := Finset.range (N + 1)) fun i hi => ite_eq_right (by simpa using hi)] + exact Finset.sum_congr rfl fun i hi => ite_eq_left (Finset.mem_range.mp hi) + have key : ∑' k : ℕ, q ^ k.choose 2 * z ^ k / qPochhammer q q k = qPochhammerInf (-z) q := + tendsto_nhds_unique h_tsum (h_limit.congr h_rewrite) + rw [← key] + exact (summable_euler_second hq hz).hasSum + +end SecondEuler + +end QSeries diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/FPS.lean b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/FPS.lean new file mode 100644 index 0000000000..184be2c97e --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/FPS.lean @@ -0,0 +1,214 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import Mathlib.Algebra.Polynomial.Laurent +import Mathlib.Basic.Complex.Basic +import Mathlib.RingTheory.PowerSeries.Inverse +import Mathlib.RingTheory.PowerSeries.PiTopology + +/-! +# q-Pochhammer symbols as formal power series + +This file reformulates the q-Pochhammer symbols and the Jacobi triple product +identity in the ring of formal power series `A⟦q⟧`, where `A = ℂ[z, z⁻¹]` +is the ring of Laurent polynomials. + +## Key idea + +The variable `q` is the formal power series indeterminate `X`, while `z` lives in +the coefficient ring `A = LaurentPolynomial ℂ`. The q-Pochhammer symbol +`(a; q)_∞ = ∏_{k ≥ 0} (1 - a qᵏ)` is a well-defined element of `A⟦X⟧` +because the factors converge to `1` in the `X`-adic (pi) topology — no analytic +convergence hypotheses are needed. + +## Main definitions + +* `QSeries.FormalPowerSeries.qPochhammer` — Finite q-Pochhammer `(a; X)_n` in `R⟦X⟧`. +* `QSeries.FormalPowerSeries.qPochhammerInf` — Infinite q-Pochhammer `(a; X)_∞` in `R⟦X⟧` + (via `tprod`). + +## Main results + +* `QSeries.FormalPowerSeries.multipliable_one_sub_mul_pow` — The infinite product is multipliable. +* `QSeries.FormalPowerSeries.qPochhammerInf_eq_one_sub_mul` — `(a; X)_∞ = (1 - a) · (aX; X)_∞`. +* `QSeries.FormalPowerSeries.qPochhammerInf_eq_mk` — Coefficient-wise characterisation. +* `QSeries.FormalPowerSeries.jacobiTripleProduct` — The Jacobi triple product in `A⟦X⟧` + (proved in `QSeries.FPSAlgebra`). +-/ + +noncomputable section + +open scoped MvPowerSeries.WithPiTopology +open PowerSeries Finset + +namespace QSeries.FormalPowerSeries + +section Finite + +variable {R : Type*} [CommRing R] + +/-- **Finite q-Pochhammer symbol** in `R⟦X⟧`. +`(a; X)_n = ∏_{k=0}^{n-1} (1 - a · X^k)` where `a ∈ R⟦X⟧`. -/ +def qPochhammer (a : R⟦X⟧) (n : ℕ) : R⟦X⟧ := + ∏ k ∈ range n, (1 - a * X ^ k) + +/-- The empty finite q-Pochhammer product `(a; X)_0 = 1`. -/ +@[simp] +theorem qPochhammer_zero (a : R⟦X⟧) : qPochhammer a 0 = 1 := by + simp [qPochhammer] + +/-- The recurrence `(a; X)_{n+1} = (a; X)_n * (1 - a X^n)`. -/ +theorem qPochhammer_succ (a : R⟦X⟧) (n : ℕ) : + qPochhammer a (n + 1) = qPochhammer a n * (1 - a * X ^ n) := by + simp [qPochhammer, prod_range_succ] + +/-- The shift identity `(a; X)_{n+1} = (1 - a) * (aX; X)_n`. -/ +theorem qPochhammer_succ_eq_one_sub_mul (a : R⟦X⟧) (n : ℕ) : + qPochhammer a (n + 1) = (1 - a) * qPochhammer (a * X) n := by + induction n with + | zero => simp [qPochhammer] + | succ n ih => rw [qPochhammer_succ, ih, qPochhammer_succ]; ring + +end Finite + +section Stabilisation + +variable {R : Type*} [CommRing R] + +/-- For `d < n`, the `d`-th coefficient of `(a; X)_{n+1}` equals that of `(a; X)_n`. -/ +theorem coeff_qPochhammer_succ (a : R⟦X⟧) {d n : ℕ} (hdn : d < n) : + coeff d (qPochhammer a (n + 1)) = coeff d (qPochhammer a n) := by + rw [qPochhammer_succ, mul_sub, mul_one, map_sub, ← mul_assoc, + PowerSeries.coeff_mul_X_pow', ite_eq_right hdn.not_ge, sub_zero] + +/-- For `N ≥ M > d`, the `d`-th coefficient of `(a; X)_N` equals that of `(a; X)_M`. -/ +theorem coeff_qPochhammer_eq_of_le (a : R⟦X⟧) {d M N : ℕ} + (hM : d < M) (hN : M ≤ N) : + coeff d (qPochhammer a N) = coeff d (qPochhammer a M) := by + induction hN with + | refl => rfl + | step hN ih => + convert coeff_qPochhammer_succ a (lt_of_lt_of_le hM hN) using 1 + exact ih.symm + +end Stabilisation + +section Infinite + +variable {R : Type*} [CommRing R] [TopologicalSpace R] [DiscreteTopology R] + +omit [DiscreteTopology R] in +/-- The infinite product `∏_{k ≥ 0} (1 - a X^k)` is multipliable in `R⟦X⟧`. -/ +theorem multipliable_one_sub_mul_pow (a : R⟦X⟧) : + Multipliable (fun k : ℕ => 1 - a * X ^ k) := by + have hord : ∀ k : ℕ, (k : ℕ∞) ≤ (-(a * X ^ k) : R⟦X⟧).order := fun k => + PowerSeries.le_order _ _ fun i hi => by + have hik : i < k := by exact_mod_cast hi + rw [map_neg, PowerSeries.coeff_mul_X_pow', ite_eq_right hik.not_ge, neg_zero] + simp only [sub_eq_add_neg] + refine WithPiTopology.multipliable_one_add_of_tendsto_order_atTop_nhds_top R + (ENat.tendsto_nhds_top_iff_natCast_lt.2 fun n => Filter.eventually_atTop.2 ⟨n + 1, ?_⟩) + exact fun k hk => lt_of_lt_of_le (by exact_mod_cast hk) (hord k) + +/-- **Infinite q-Pochhammer symbol** `(a; X)_∞ = ∏_{k ≥ 0} (1 - a · X^k)`. +Well-defined in `R⟦X⟧` with the pi topology. -/ +def qPochhammerInf (a : R⟦X⟧) : R⟦X⟧ := + ∏' k : ℕ, (1 - a * X ^ k) + +/-- The `d`-th coefficient of `(a; X)_∞` equals the `d`-th coefficient of `(a; X)_{d+1}`. -/ +theorem coeff_qPochhammerInf (a : R⟦X⟧) (d : ℕ) : + coeff d (qPochhammerInf a) = coeff d (qPochhammer a (d + 1)) := by + have h_limit : Filter.Tendsto (fun n => coeff d (qPochhammer a n)) Filter.atTop + (nhds (coeff d (qPochhammerInf a))) := + ((WithPiTopology.continuous_coeff R d).tendsto _).comp + (multipliable_one_sub_mul_pow a).hasProd.tendsto_prod_nat + refine tendsto_nhds_unique h_limit (tendsto_const_nhds.congr' ?_) + filter_upwards [Filter.eventually_ge_atTop (d + 1)] with n hn + exact (coeff_qPochhammer_eq_of_le a (Nat.lt_succ_self _) hn).symm + +/-- **Coefficient-wise definition.** -/ +theorem qPochhammerInf_eq_mk (a : R⟦X⟧) : + qPochhammerInf a = mk fun d => coeff d (qPochhammer a (d + 1)) := by + ext d; rw [coeff_mk, coeff_qPochhammerInf] + +/-- If the constant coefficient of `a` is zero, then that of `(a; X)_∞` is `1`. -/ +theorem coeff_zero_qPochhammerInf (a : R⟦X⟧) (ha : coeff 0 a = 0) : + coeff 0 (qPochhammerInf a) = 1 := by + rw [coeff_qPochhammerInf, qPochhammer_succ, qPochhammer_zero] + simp [-coeff_zero_eq_constantCoeff, ha] + +/-- The recursion `(a; X)_∞ = (1 - a) * (aX; X)_∞`. -/ +theorem qPochhammerInf_eq_one_sub_mul (a : R⟦X⟧) : + qPochhammerInf a = (1 - a) * qPochhammerInf (a * X) := by + -- The shifted partial products converge to `(aX; X)_∞`. + have h_shift : Filter.Tendsto (fun n => ∏ k ∈ range n, (1 - a * X ^ (k + 1))) Filter.atTop + (nhds (qPochhammerInf (a * X))) := + (multipliable_one_sub_mul_pow (a * X)).hasProd.tendsto_prod_nat.congr + fun n => prod_congr rfl fun k _ => by ring + -- The partial products of `(a; X)_∞`, reindexed, converge to `(a; X)_∞`. + have h_all : Filter.Tendsto (fun n => ∏ k ∈ range (n + 1), (1 - a * X ^ k)) Filter.atTop + (nhds (qPochhammerInf a)) := + (multipliable_one_sub_mul_pow a).hasProd.tendsto_prod_nat.comp (Filter.tendsto_add_atTop_nat 1) + refine tendsto_nhds_unique h_all ?_ + have hsplit : ∀ n : ℕ, ∏ k ∈ range (n + 1), (1 - a * X ^ k) + = (1 - a) * ∏ k ∈ range n, (1 - a * X ^ (k + 1)) := fun n => by + rw [prod_range_succ', pow_zero, mul_one, mul_comm] + simp_rw [hsplit] + exact tendsto_const_nhds.mul h_shift + +/-- `(a; X)_∞` is a unit in `R⟦X⟧` whenever `1 - coeff 0 a` is a unit in `R`. -/ +theorem isUnit_qPochhammerInf (a : R⟦X⟧) (ha : IsUnit (1 - coeff 0 a : R)) : + IsUnit (qPochhammerInf a) := by + rw [PowerSeries.isUnit_iff_constantCoeff, ← coeff_zero_eq_constantCoeff_apply, + coeff_qPochhammerInf, qPochhammer_succ, qPochhammer_zero, one_mul, pow_zero, mul_one] + simpa using ha + +end Infinite + +section JTP + +local notation "A" => LaurentPolynomial ℂ + +/-- The discrete topology on `LaurentPolynomial ℂ`, the coefficient ring of the formal-power-series +Jacobi triple product. It is all the `X`-adic arguments below require. + +This is `scoped` deliberately: a *global* instance would silently equip Mathlib's +`LaurentPolynomial ℂ` with a discrete topology for every downstream import, which is not this +library's decision to make. Consumers opt in with `open scoped QSeries.FormalPowerSeries`. -/ +scoped instance instTopologicalSpaceLaurentPolyComplex : TopologicalSpace A := ⊥ + +/-- The topology on `LaurentPolynomial ℂ` from the scoped instance above is discrete. -/ +scoped instance instDiscreteTopologyLaurentPolyComplex : DiscreteTopology A := ⟨rfl⟩ + +local notation "PS" => (PowerSeries.C : A →+* A⟦X⟧) + +/-- `z = T(1)` viewed as a constant power series in `A⟦X⟧`. -/ +abbrev laurentZ : A⟦X⟧ := PS (LaurentPolynomial.T 1) + +/-- `z⁻¹ = T(-1)` viewed as a constant power series in `A⟦X⟧`. -/ +abbrev laurentZInv : A⟦X⟧ := PS (LaurentPolynomial.T (-1)) + +/-- `(q; q)_∞` in `A⟦X⟧`. -/ +def qPochhammerInfX : A⟦X⟧ := qPochhammerInf X + +/-- `(-z; q)_∞` in `A⟦X⟧`. -/ +def qPochhammerInfNegZ : A⟦X⟧ := qPochhammerInf (-laurentZ) + +/-- `(-q/z; q)_∞` in `A⟦X⟧`. -/ +def qPochhammerInfNegXMulZInv : A⟦X⟧ := qPochhammerInf (-X * laurentZInv) + +/-- The **Jacobi triple product** (LHS) as an element of `A⟦X⟧`. -/ +def jacobiProd : A⟦X⟧ := qPochhammerInfX * qPochhammerInfNegZ * qPochhammerInfNegXMulZInv + +/-- The **bilateral theta series** (RHS). -/ +def jacobiBilateral : A⟦X⟧ := + (∑' n : ℕ, PS (LaurentPolynomial.T (n : ℤ)) * X ^ n.choose 2) + + (∑' m : ℕ, PS (LaurentPolynomial.T (-(↑m + 1))) * X ^ (m + 2).choose 2) + +end JTP + +end QSeries.FormalPowerSeries + +end diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/FPSAlgebra.lean b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/FPSAlgebra.lean new file mode 100644 index 0000000000..43ee8f3f0c --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/FPSAlgebra.lean @@ -0,0 +1,717 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.FPSEuler +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.FiniteBinomial + +/-! +# Algebraic identities for FPS q-series + +Purely algebraic proofs of the **Euler second identity** and the **key identity** +`S_k = (qPochhammerInf X)⁻¹` in the formal power series ring `R⟦X⟧` over any +commutative ring with discrete topology. Combined with the product expansion +and Cauchy product, these identities yield the Jacobi triple product. + +## Main results + +* `QSeries.FormalPowerSeries.euler_second_identity` — FPS Euler second identity. +* `QSeries.FormalPowerSeries.keySum_eq_qPochhammerInfInv` — `S_k = (qPochhammerInf X)⁻¹` + for all `k`. +* `QSeries.FormalPowerSeries.hasSum_pow_choose_two_nonneg` — Cauchy diagonal coefficient + for `n ≥ 0`. +* `QSeries.FormalPowerSeries.hasSum_pow_choose_two_neg` — Cauchy diagonal coefficient for `n < 0`. +* `QSeries.FormalPowerSeries.jacobiTripleProduct` — FPS Jacobi Triple Product Identity. +-/ + +noncomputable section + +open scoped MvPowerSeries.WithPiTopology +open PowerSeries Finset + +namespace QSeries.FormalPowerSeries + +variable {R : Type*} [CommRing R] [TopologicalSpace R] [DiscreteTopology R] + + +/-- Inverse of `qPochhammer X k` in `R⟦X⟧`, defined via `invOfUnit` since the +constant coefficient is `1`. -/ +def qPochhammerInv (k : ℕ) : R⟦X⟧ := + MvPowerSeries.invOfUnit (qPochhammer (X : R⟦X⟧) k) 1 + +omit [TopologicalSpace R] [DiscreteTopology R] in +/-- `qPochhammer X k` times its formal power series inverse equals 1. -/ +@[simp] +theorem qPochhammer_X_mul_qPochhammerInv (k : ℕ) : + qPochhammer (X : R⟦X⟧) k * qPochhammerInv (R := R) k = 1 := + PowerSeries.mul_invOfUnit _ 1 (by simpa using constantCoeff_qPochhammer_X (R := R) k) + +omit [TopologicalSpace R] [DiscreteTopology R] in +/-- The formal power series inverse of `qPochhammer X k` times `qPochhammer X k` equals 1. -/ +@[simp] +theorem qPochhammerInv_mul_qPochhammer_X (k : ℕ) : + qPochhammerInv (R := R) k * qPochhammer (X : R⟦X⟧) k = 1 := by + rw [mul_comm, qPochhammer_X_mul_qPochhammerInv] + +omit [TopologicalSpace R] [DiscreteTopology R] in +/-- The recursion `(1 - X^{k+1}) * qPochhammerInv(k+1) = qPochhammerInv(k)` for the inverse +q-Pochhammer symbol. -/ +theorem one_sub_pow_mul_qPochhammerInv_succ (k : ℕ) : + (1 - (X : R⟦X⟧) ^ (k + 1)) * qPochhammerInv (R := R) (k + 1) = qPochhammerInv k := by + have h1 := qPochhammer_X_mul_qPochhammerInv (R := R) (k + 1) + rw [qPochhammer_succ, ← pow_succ'] at h1 + refine (isUnit_qPochhammer_X (R := R) k).mul_left_cancel ?_ + rw [qPochhammer_X_mul_qPochhammerInv, ← mul_assoc, h1] + +/-- `qPochhammerInf X` is a unit. -/ +theorem isUnit_qPochhammerInf_X : IsUnit (qPochhammerInf (X : R⟦X⟧)) := + isUnit_qPochhammerInf X (by simp) + +/-- Inverse of `qPochhammerInf X`. -/ +def qPochhammerInfInv : R⟦X⟧ := ↑(isUnit_qPochhammerInf_X (R := R)).unit⁻¹ + +/-- `qPochhammerInf X` times its formal power series inverse equals 1. -/ +@[simp] +theorem qPochhammerInf_X_mul_qPochhammerInfInv : + qPochhammerInf (X : R⟦X⟧) * qPochhammerInfInv (R := R) = 1 := + isUnit_qPochhammerInf_X.mul_val_inv + +/-- The formal power series inverse of `qPochhammerInf X` times `qPochhammerInf X` equals 1. -/ +@[simp] +theorem qPochhammerInfInv_mul_qPochhammerInf_X : + qPochhammerInfInv (R := R) * qPochhammerInf (X : R⟦X⟧) = 1 := + isUnit_qPochhammerInf_X.val_inv_mul + +/-- `qPochhammerInf X * qPochhammerInv n = qPochhammerInf (X * X^n)`: multiplying the infinite +product by the `n`-th inverse Pochhammer symbol shifts the argument. -/ +theorem qPochhammerInf_X_mul_qPochhammerInv (n : ℕ) : + qPochhammerInf (X : R⟦X⟧) * qPochhammerInv (R := R) n = qPochhammerInf (X * X ^ n) := by + rw [qPochhammerInf_X_eq_qPochhammer_mul n, mul_right_comm, qPochhammer_X_mul_qPochhammerInv, + one_mul] + +section Euler2 + +omit [TopologicalSpace R] [DiscreteTopology R] in +/-- Every finite q-Pochhammer product is `1` plus a multiple of its argument: +`(a; X)_k = 1 + a * g` for some `g`. -/ +private theorem exists_qPochhammer_eq_one_add_mul (a : R⟦X⟧) (k : ℕ) : + ∃ g : R⟦X⟧, qPochhammer a k = 1 + a * g := by + induction k with + | zero => exact ⟨0, by simp⟩ + | succ k ih => + obtain ⟨g, hg⟩ := ih + exact ⟨g - X ^ k - a * g * X ^ k, by rw [qPochhammer_succ, hg]; ring⟩ + +omit [TopologicalSpace R] [DiscreteTopology R] in +/-- For `j ≤ m` the `j`-th coefficient of `(X·X^m; X)_k` agrees with that of `1`. -/ +private theorem coeff_qPochhammer_X_mul_pow (m k : ℕ) {j : ℕ} (hj : j < m + 1) : + PowerSeries.coeff j (qPochhammer ((X : R⟦X⟧) * X ^ m) k) = PowerSeries.coeff j 1 := by + obtain ⟨g, hg⟩ := exists_qPochhammer_eq_one_add_mul ((X : R⟦X⟧) * X ^ m) k + rw [hg, map_add, ← pow_succ', PowerSeries.coeff_X_pow_mul', ite_eq_right hj.not_ge, add_zero] + +omit [TopologicalSpace R] [DiscreteTopology R] in +/-- Telescoping split `(X; X)_n = (X; X)_{n-k} · (X·X^{n-k}; X)_k` for `k ≤ n`. -/ +private theorem qPochhammer_X_eq_qPochhammer_mul {k n : ℕ} (hkn : k ≤ n) : + qPochhammer (X : R⟦X⟧) n = + qPochhammer (X : R⟦X⟧) (n - k) * qPochhammer ((X : R⟦X⟧) * X ^ (n - k)) k := by + conv_lhs => rw [show n = n - k + k from (Nat.sub_add_cancel hkn).symm] + rw [qPochhammer, qPochhammer, qPochhammer, Finset.prod_range_add] + exact congrArg _ (Finset.prod_congr rfl fun i _ => by ring) + +omit [TopologicalSpace R] [DiscreteTopology R] in +/-- Two power series agreeing in all coefficients below `N` still agree there after +multiplication by a common factor. -/ +private theorem coeff_mul_congr {f g b : R⟦X⟧} {N j : ℕ} (hj : j < N) + (h : ∀ i < N, PowerSeries.coeff i f = PowerSeries.coeff i g) : + PowerSeries.coeff j (f * b) = PowerSeries.coeff j (g * b) := by + have hd : (X : R⟦X⟧) ^ N ∣ f - g := + PowerSeries.X_pow_dvd_iff.mpr fun i hi => by rw [map_sub, h i hi, sub_self] + have hj0 := PowerSeries.X_pow_dvd_iff.mp (hd.mul_right b) j hj + rwa [sub_mul, map_sub, sub_eq_zero] at hj0 + + + +omit [TopologicalSpace R] [DiscreteTopology R] in +/-- For `j + k ≤ n`, the `j`-th coefficient of `qBinom n k X` equals that of `qPochhammerInv k`. -/ +theorem coeff_qBinom_eq_coeff_qPochhammerInv {k j n : ℕ} (hjk : j + k ≤ n) : + PowerSeries.coeff j (QSeries.qBinom n k (X : R⟦X⟧)) = + PowerSeries.coeff j (qPochhammerInv (R := R) k) := by + have hkn : k ≤ n := by omega + have h_eq : QSeries.qBinom n k (X : R⟦X⟧) * qPochhammer (X : R⟦X⟧) k * + qPochhammer (X : R⟦X⟧) (n - k) = qPochhammer (X : R⟦X⟧) n := + QSeries.qBinom_mul_qPochhammer_mul_qPochhammer (X : R⟦X⟧) hkn + have hcancel : QSeries.qBinom n k (X : R⟦X⟧) * qPochhammer (X : R⟦X⟧) k + = qPochhammer ((X : R⟦X⟧) * X ^ (n - k)) k := by + refine (isUnit_qPochhammer_X (R := R) (n - k)).mul_right_cancel ?_ + rw [h_eq, qPochhammer_X_eq_qPochhammer_mul hkn] + exact mul_comm _ _ + have hdvd : (X : R⟦X⟧) ^ (n - k + 1) ∣ + QSeries.qBinom n k (X : R⟦X⟧) - qPochhammerInv (R := R) k := by + refine (IsUnit.dvd_mul_right (isUnit_qPochhammer_X (R := R) k)).mp ?_ + rw [PowerSeries.X_pow_dvd_iff] + intro m hm + rw [sub_mul, hcancel, qPochhammerInv_mul_qPochhammer_X, map_sub, + coeff_qPochhammer_X_mul_pow _ _ hm, sub_self] + rw [← sub_eq_zero, ← map_sub] + exact PowerSeries.X_pow_dvd_iff.mp hdvd j (by omega) + +omit [TopologicalSpace R] [DiscreteTopology R] in +private theorem qPochhammer_neg_eq_sum (a : R⟦X⟧) (n : ℕ) : + qPochhammer (-a) n = ∑ k ∈ Finset.range (n + 1), + X ^ k.choose 2 * QSeries.qBinom n k (X : R⟦X⟧) * a ^ k := by + rw [qPochhammer, ← QSeries.prod_one_add_mul_pow_eq_sum_qBinom (X : R⟦X⟧) a n] + exact Finset.prod_congr rfl fun _ _ => by ring + +omit [TopologicalSpace R] [DiscreteTopology R] in +private theorem coeff_eq_zero_of_lt_choose_two (a : R⟦X⟧) (d k : ℕ) (hk : d < k.choose 2) : + PowerSeries.coeff d (X ^ k.choose 2 * a ^ k * qPochhammerInv (R := R) k) = 0 := by + rw [mul_assoc, PowerSeries.coeff_X_pow_mul', ite_eq_right hk.not_ge] + +omit [DiscreteTopology R] in +/-- The Euler-second summands `X^{C(k,2)} · a^k · (X; X)_k⁻¹` form a summable family. -/ +private theorem summable_pow_choose_two_mul_pow_mul_qPochhammerInv (a : R⟦X⟧) : + Summable fun k : ℕ => (X : R⟦X⟧) ^ k.choose 2 * a ^ k * qPochhammerInv (R := R) k := by + refine (WithPiTopology.summable_iff_summable_coeff R).mpr fun d => ?_ + refine summable_of_ne_finset_zero (s := Finset.range (d + 2)) fun k hk => ?_ + exact coeff_eq_zero_of_lt_choose_two a d k (Nat.lt_choose_two_of_add_two_le (by simpa using hk)) + +omit [TopologicalSpace R] [DiscreteTopology R] in +/-- Termwise agreement, in degree `n`, between the finite q-binomial expansion of +`(-a; X)_{n+1}` and the Euler-second summands. -/ +private theorem coeff_pow_choose_two_mul_qBinom_mul_pow (a : R⟦X⟧) (n k : ℕ) : + PowerSeries.coeff n ((X : R⟦X⟧) ^ k.choose 2 * QSeries.qBinom (n + 1) k X * a ^ k) = + PowerSeries.coeff n ((X : R⟦X⟧) ^ k.choose 2 * a ^ k * qPochhammerInv (R := R) k) := by + rw [mul_assoc, show (X : R⟦X⟧) ^ k.choose 2 * a ^ k * qPochhammerInv (R := R) k + = X ^ k.choose 2 * (qPochhammerInv (R := R) k * a ^ k) from by ring, + PowerSeries.coeff_X_pow_mul', PowerSeries.coeff_X_pow_mul'] + split_ifs with h + · refine coeff_mul_congr (N := n - k.choose 2 + 1) (by omega) fun i hi => ?_ + exact coeff_qBinom_eq_coeff_qPochhammerInv (by have := Nat.le_choose_two_add_one k; omega) + · rfl + +/-- FPS Euler second identity: `qPochhammerInf(-a) = Σ_{k≥0} X^{C(k,2)} · a^k · (qPochhammer X k)⁻¹` +in `R⟦X⟧`. -/ +theorem euler_second_identity (a : R⟦X⟧) : + qPochhammerInf (-a) = ∑' k : ℕ, X ^ k.choose 2 * a ^ k * qPochhammerInv (R := R) k := by + ext n + have hcoeff : + ∑' k : ℕ, PowerSeries.coeff n ((X : R⟦X⟧) ^ k.choose 2 * a ^ k * qPochhammerInv (R := R) k) + = PowerSeries.coeff n + (∑' k : ℕ, (X : R⟦X⟧) ^ k.choose 2 * a ^ k * qPochhammerInv (R := R) k) := + ((summable_pow_choose_two_mul_pow_mul_qPochhammerInv a).hasSum.map + (PowerSeries.coeff n).toAddMonoidHom (WithPiTopology.continuous_coeff R n)).tsum_eq + rw [coeff_qPochhammerInf, qPochhammer_neg_eq_sum, ← hcoeff, + tsum_eq_sum (s := Finset.range (n + 2)) fun k hk => + coeff_eq_zero_of_lt_choose_two a n k (Nat.lt_choose_two_of_add_two_le (by simpa using hk)), + map_sum] + exact Finset.sum_congr rfl fun k _ => coeff_pow_choose_two_mul_qBinom_mul_pow a n k + +end Euler2 + + +section KeyIdentity + +omit [DiscreteTopology R] in +/-- A family `m ↦ X ^ e m * g m` in `R⟦X⟧` is summable as soon as the exponents `e m` +eventually exceed every fixed degree: only finitely many terms contribute to each +coefficient. -/ +private theorem summable_X_pow_mul {e : ℕ → ℕ} + (he : ∀ d : ℕ, ∃ N : ℕ, ∀ m ≥ N, d < e m) (g : ℕ → R⟦X⟧) : + Summable fun m : ℕ => (X : R⟦X⟧) ^ e m * g m := by + refine (PowerSeries.WithPiTopology.summable_iff_summable_coeff R).mpr fun d => ?_ + obtain ⟨N, hN⟩ := he d + refine summable_of_ne_finset_zero (s := Finset.range N) fun m hm => ?_ + rw [Finset.mem_range, not_lt] at hm + rw [PowerSeries.coeff_X_pow_mul', ite_eq_right (by have := hN m hm; omega)] + +/-- The exponents `m * (m + k)` eventually exceed every fixed degree. -/ +private theorem exists_forall_lt_mul (k d : ℕ) : ∃ N : ℕ, ∀ m ≥ N, d < m * (m + k) := + ⟨d + 1, fun m hm => lt_of_lt_of_le (by omega) (Nat.le_mul_of_pos_right m (by omega))⟩ + +/-- The exponents `C(m, 2)` eventually exceed every fixed degree. -/ +private theorem exists_forall_lt_choose_two (d : ℕ) : + ∃ N : ℕ, ∀ m ≥ N, d < m.choose 2 := by + refine ⟨d + 2, fun m hm => ?_⟩ + obtain ⟨j, rfl⟩ : ∃ j, m = j + 1 := ⟨m - 1, by omega⟩ + rw [Nat.choose_two_succ] + omega + +/-- The key sum `S_k = ∑_m X^{m(m+k)} / ((X;X)_m (X;X)_{m+k})`. -/ +def keySum (k : ℕ) : R⟦X⟧ := + ∑' m : ℕ, X ^ (m * (m + k)) * qPochhammerInv (R := R) m * qPochhammerInv (m + k) + +omit [DiscreteTopology R] in +/-- The defining series for `keySum k` is summable in `R⟦X⟧`. -/ +theorem summable_keySummand (k : ℕ) : + Summable (fun m : ℕ => + X ^ (m * (m + k)) * qPochhammerInv (R := R) m * qPochhammerInv (m + k)) := by + simpa [mul_assoc] using summable_X_pow_mul (R := R) + (exists_forall_lt_mul k) fun m => qPochhammerInv m * qPochhammerInv (m + k) + +omit [TopologicalSpace R] [DiscreteTopology R] in +/-- Key auxiliary: `qPochhammerInv(n-1) + X^n * qPochhammerInv(n) = qPochhammerInv(n)`. + Equivalently, + `(1 - X^{n+1}) * qPochhammerInv(n+1) + X^{n+1} * qPochhammerInv(n+1) = qPochhammerInv(n+1)`. -/ +private theorem qPochhammerInv_add_pow_mul_qPochhammerInv_succ (n : ℕ) : + qPochhammerInv (R := R) n + X ^ (n + 1) * qPochhammerInv (R := R) (n + 1) = + qPochhammerInv (R := R) (n + 1) := by + rw [← one_sub_pow_mul_qPochhammerInv_succ (R := R) n]; ring + +/-- The intermediate sum `T_k = ∑ m, X^{m(m+k)} * qPochhammerInv(m) * qPochhammerInv(m+k+1)`. -/ +private def keySumShift (k : ℕ) : R⟦X⟧ := + ∑' m : ℕ, X ^ (m * (m + k)) * qPochhammerInv (R := R) m * qPochhammerInv (m + k + 1) + + +private theorem keySumShift_eq_keySum_add (k : ℕ) : + keySumShift (R := R) k = keySum k + X ^ (k + 1) * keySum (k + 1) := by + unfold keySumShift keySum + rw [← Summable.tsum_mul_left _ (summable_keySummand (R := R) (k + 1)), + ← Summable.tsum_add (summable_keySummand (R := R) k) + (Summable.mul_left _ (summable_keySummand (R := R) (k + 1)))] + refine tsum_congr fun m => ?_ + simp only [← add_assoc] + have hpow : (X : R⟦X⟧) ^ (k + 1) * X ^ (m * (m + k + 1)) = + X ^ (m + k + 1) * X ^ (m * (m + k)) := by + rw [← pow_add, ← pow_add]; congr 1; ring + rw [← one_sub_pow_mul_qPochhammerInv_succ (R := R) (m + k), ← mul_assoc ((X : R⟦X⟧) ^ (k + 1)), + ← mul_assoc ((X : R⟦X⟧) ^ (k + 1)), hpow] + generalize (X : R⟦X⟧) ^ (m * (m + k)) = A + ring + +/-- The shifted form of `X^{k+1} · S_{k+2}` as a `HasSum` statement. -/ +private theorem hasSum_pow_mul_keySum (k : ℕ) : + HasSum (fun n : ℕ => + X ^ ((n + 1) * (n + 1 + k)) * qPochhammerInv (R := R) n * qPochhammerInv (n + k + 2)) + (X ^ (k + 1) * keySum (R := R) (k + 2)) := by + have hfun : (fun n : ℕ => (X : R⟦X⟧) ^ (k + 1) * + (X ^ (n * (n + (k + 2))) * qPochhammerInv (R := R) n * qPochhammerInv (n + (k + 2)))) = + fun n : ℕ => X ^ ((n + 1) * (n + 1 + k)) * qPochhammerInv (R := R) n * + qPochhammerInv (n + k + 2) := by + funext n + rw [show n + (k + 2) = n + k + 2 from by omega, + show (n + 1) * (n + 1 + k) = k + 1 + n * (n + k + 2) from by ring, pow_add] + ring + exact hfun ▸ (summable_keySummand (R := R) (k + 2)).hasSum.mul_left _ + + +private theorem keySumShift_eq_keySum_succ_add (k : ℕ) : + keySumShift (R := R) k = keySum (k + 1) + X ^ (k + 1) * keySum (k + 2) := by + have hA := (hasSum_nat_add_iff' (f := fun m : ℕ => + X ^ (m * (m + (k + 1))) * qPochhammerInv (R := R) m * qPochhammerInv (m + (k + 1))) 1).mpr + (summable_keySummand (R := R) (k + 1)).hasSum + refine HasSum.tsum_eq ((hasSum_nat_add_iff' 1).mp ?_) + convert hA.add (hasSum_pow_mul_keySum (R := R) k) using 1 + · funext n + rw [show n + 1 + k + 1 = n + k + 2 from by omega, + show n + 1 + (k + 1) = n + k + 2 from by omega, + show (n + 1) * (n + k + 2) = (n + 1) * (n + 1 + k) + (n + 1) from by ring, pow_add] + conv_lhs => rw [← qPochhammerInv_add_pow_mul_qPochhammerInv_succ (R := R) n] + ring + · simp only [keySum, Finset.sum_range_one, Nat.zero_mul, Nat.zero_add, pow_zero, one_mul] + ring + +/-- The recurrence: `S_k − S_{k+1} = X^{k+1} (S_{k+2} − S_{k+1})`. -/ +theorem keySum_sub_keySum_succ (k : ℕ) : + keySum (R := R) k - keySum (k + 1) = + X ^ (k + 1) * (keySum (R := R) (k + 2) - keySum (k + 1)) := by + have h := (keySumShift_eq_keySum_add (R := R) k).symm.trans (keySumShift_eq_keySum_succ_add k) + rw [mul_sub, sub_eq_sub_iff_add_eq_add] + exact h.trans (add_comm _ _) + +/-- `keySum k` is independent of `k`: all values are equal to `keySum 0`. -/ +theorem keySum_eq_keySum_zero (k : ℕ) : keySum (R := R) k = keySum 0 := by + -- `S_j - S_{j+1}` is divisible by `X ^ N` for every `N`, hence zero. + have key : ∀ N j : ℕ, ∃ g : R⟦X⟧, keySum (R := R) j - keySum (j + 1) = X ^ N * g := by + intro N + induction N with + | zero => exact fun j => ⟨_, (one_mul _).symm⟩ + | succ N ih => + intro j + obtain ⟨g, hg⟩ := ih (j + 1) + refine ⟨-(X ^ j * g), ?_⟩ + rw [keySum_sub_keySum_succ j, ← neg_sub (keySum (R := R) (j + 1)), hg] + ring + have hzero : ∀ j : ℕ, keySum (R := R) j = keySum (j + 1) := by + intro j + rw [← sub_eq_zero] + ext d + obtain ⟨g, hg⟩ := key (d + 1) j + rw [hg, PowerSeries.coeff_X_pow_mul', ite_eq_right (by omega), map_zero] + induction k with + | zero => rfl + | succ k ih => rw [← hzero k, ih] + +/-- Below degree `k + 1` the series `(X·X^k; X)_∞` is indistinguishable from `1`. -/ +private theorem coeff_qPochhammerInf_X_mul_pow {k j : ℕ} (hj : j < k + 1) : + PowerSeries.coeff j (qPochhammerInf ((X : R⟦X⟧) * X ^ k)) = PowerSeries.coeff j 1 := by + obtain ⟨g, hg⟩ := exists_qPochhammer_eq_one_add_mul ((X : R⟦X⟧) * X ^ k) (j + 1) + rw [coeff_qPochhammerInf, hg, map_add, ← pow_succ', PowerSeries.coeff_X_pow_mul', + ite_eq_right hj.not_ge, add_zero] + +/-- For `d < k`, the `d`-th coefficient of `qPochhammerInv k` equals the `d`-th coefficient +of `qPochhammerInfInv`. -/ +theorem coeff_qPochhammerInv_eq_coeff_qPochhammerInfInv {k d : ℕ} (hkd : d < k) : + PowerSeries.coeff d (qPochhammerInv (R := R) k) = + PowerSeries.coeff d (qPochhammerInfInv (R := R)) := by + have hQ : ∀ j < k, PowerSeries.coeff j (qPochhammerInf (X : R⟦X⟧) * + (qPochhammerInv (R := R) k - qPochhammerInfInv (R := R))) = 0 := fun j hj => by + rw [mul_sub, qPochhammerInf_X_mul_qPochhammerInv, qPochhammerInf_X_mul_qPochhammerInfInv, + map_sub, sub_eq_zero, coeff_qPochhammerInf_X_mul_pow (by omega)] + rw [← sub_eq_zero, ← map_sub, show qPochhammerInv (R := R) k - qPochhammerInfInv (R := R) = + qPochhammerInfInv (R := R) * (qPochhammerInf (X : R⟦X⟧) * + (qPochhammerInv (R := R) k - qPochhammerInfInv)) from by + rw [← mul_assoc, qPochhammerInfInv_mul_qPochhammerInf_X, one_mul], PowerSeries.coeff_mul] + exact Finset.sum_eq_zero fun p hp => by + rw [hQ p.2 (by have := Finset.mem_antidiagonal.mp hp; omega), mul_zero] + +/-- Taking the `d`-th coefficient commutes with a convergent `tsum` in `R⟦X⟧`. -/ +private theorem coeff_tsum {f : ℕ → R⟦X⟧} (hf : Summable f) (d : ℕ) : + PowerSeries.coeff d (∑' m, f m) = ∑' m, PowerSeries.coeff d (f m) := + ((hf.hasSum.map (PowerSeries.coeff d).toAddMonoidHom + (WithPiTopology.continuous_coeff R d)).tsum_eq).symm + +omit [TopologicalSpace R] [DiscreteTopology R] in +/-- `qPochhammerInv 0 = 1`. -/ +private theorem qPochhammerInv_zero : qPochhammerInv (R := R) 0 = 1 := by + simpa using qPochhammer_X_mul_qPochhammerInv (R := R) 0 + +/-- For `d < k`, the `d`-th coefficient of `keySum k` equals the `d`-th coefficient +of `qPochhammerInfInv`. -/ +theorem coeff_keySum_eq_coeff_qPochhammerInfInv (k : ℕ) (d : ℕ) (hkd : d < k) : + PowerSeries.coeff d (keySum (R := R) k) = PowerSeries.coeff d (qPochhammerInfInv (R := R)) := by + rw [keySum, coeff_tsum (summable_keySummand k), tsum_eq_single 0 fun m hm => by + rw [mul_assoc, PowerSeries.coeff_X_pow_mul', + ite_eq_right (by have := Nat.pos_of_ne_zero hm; nlinarith)]] + simpa [qPochhammerInv_zero] using coeff_qPochhammerInv_eq_coeff_qPochhammerInfInv (R := R) hkd + +/-- **Key identity**: `S_k = (qPochhammerInf X)⁻¹` for all `k ≥ 0`. -/ +theorem keySum_eq_qPochhammerInfInv (k : ℕ) : keySum (R := R) k = qPochhammerInfInv := by + ext d + rw [keySum_eq_keySum_zero k, ← keySum_eq_keySum_zero (R := R) (d + 1)] + exact coeff_keySum_eq_coeff_qPochhammerInfInv (d + 1) d (Nat.lt_succ_self d) + +end KeyIdentity + + +section Cauchy + +/-- `qPochhammerInf X * qPochhammerInf(-a) = Σ_n X^{C(n,2)} a^n qPochhammerInf(X · X^n)` +in `R⟦X⟧`. -/ +theorem qPochhammerInf_X_mul_qPochhammerInf_neg (a : R⟦X⟧) : + qPochhammerInf (X : R⟦X⟧) * qPochhammerInf (-a) = + ∑' n : ℕ, X ^ n.choose 2 * a ^ n * qPochhammerInf (X * X ^ n) := by + have hs : Summable fun n : ℕ => X ^ n.choose 2 * a ^ n * qPochhammerInv (R := R) n := by + simpa [mul_assoc] using summable_X_pow_mul (R := R) + exists_forall_lt_choose_two fun n => a ^ n * qPochhammerInv n + rw [euler_second_identity a, ← Summable.tsum_mul_left _ hs] + exact tsum_congr fun n => by rw [← qPochhammerInf_X_mul_qPochhammerInv n]; ring + +/-- The common core of the two Cauchy diagonal computations: after collecting the powers of `X` +the diagonal is `X ^ e` times the key sum `S_k`, and `S_k = qPochhammerInfInv` cancels +`qPochhammerInf X`. -/ +private theorem hasSum_pow_mul_qPochhammerInf_mul_qPochhammerInv (k e : ℕ) : + HasSum (fun m : ℕ => X ^ (e + m * (m + k)) * qPochhammerInf (X : R⟦X⟧) * + qPochhammerInv (R := R) m * qPochhammerInv (m + k)) (X ^ e : R⟦X⟧) := by + have h : HasSum (fun m : ℕ => + X ^ (m * (m + k)) * qPochhammerInv (R := R) m * qPochhammerInv (m + k)) + (qPochhammerInfInv (R := R)) := by + rw [← keySum_eq_qPochhammerInfInv (R := R) k] + exact (summable_keySummand k).hasSum + have key := h.mul_left ((X : R⟦X⟧) ^ e * qPochhammerInf X) + rw [mul_assoc, qPochhammerInf_X_mul_qPochhammerInfInv, mul_one] at key + have hfun : (fun m : ℕ => (X : R⟦X⟧) ^ e * qPochhammerInf X * + (X ^ (m * (m + k)) * qPochhammerInv (R := R) m * qPochhammerInv (m + k))) = + fun m : ℕ => X ^ (e + m * (m + k)) * qPochhammerInf (X : R⟦X⟧) * + qPochhammerInv (R := R) m * qPochhammerInv (m + k) := by + funext m; rw [pow_add]; ring + exact hfun ▸ key + +/-- Cauchy diagonal coefficient for non-negative index `k`: the `(m+k, m)` diagonal of the +double series sums to `X^{C(k,2)}` in `R⟦X⟧`. -/ +theorem hasSum_pow_choose_two_nonneg (k : ℕ) : + HasSum (fun m : ℕ => + X ^ (m + k).choose 2 * qPochhammerInf (X * X ^ (m + k)) * + (X ^ m.choose 2 * X ^ m * qPochhammerInv (R := R) m)) + (X ^ k.choose 2 : R⟦X⟧) := by + convert hasSum_pow_mul_qPochhammerInf_mul_qPochhammerInv (R := R) k (k.choose 2) using 1 + funext m + rw [← qPochhammerInf_X_mul_qPochhammerInv (m + k), ← Nat.choose_two_add_choose_two m k] + ring + +/-- Cauchy diagonal coefficient for negative index `-(l+1)`: the `(n, n+l+1)` diagonal of the +double series sums to `X^{C(l+2,2)}` in `R⟦X⟧`. -/ +theorem hasSum_pow_choose_two_neg (l : ℕ) : + HasSum (fun n : ℕ => + X ^ n.choose 2 * qPochhammerInf (X * X ^ n) * + (X ^ (n + (l + 1)).choose 2 * X ^ (n + (l + 1)) * qPochhammerInv (R := R) (n + (l + 1)))) + (X ^ (l + 2).choose 2 : R⟦X⟧) := by + convert hasSum_pow_mul_qPochhammerInf_mul_qPochhammerInv (R := R) (l + 1) + ((l + 2).choose 2) using 1 + funext n + rw [← qPochhammerInf_X_mul_qPochhammerInv n, ← Nat.choose_two_add_choose_two' n l] + ring + +end Cauchy + + +section JTP + +private theorem jacobiProd_eq_tsum_mul_tsum : + @jacobiProd = (∑' n : ℕ, X ^ n.choose 2 * laurentZ ^ n * qPochhammerInf (X * X ^ n)) * + (∑' m : ℕ, X ^ (m.choose 2 + m) * laurentZInv ^ m * qPochhammerInv m) := by + convert congr_arg₂ (· * ·) (qPochhammerInf_X_mul_qPochhammerInf_neg laurentZ) _ using 1 + all_goals try rfl + convert euler_second_identity (X * laurentZInv) using 1 + · exact tprod_congr fun _ => by ring + · simp +decide [pow_add, mul_pow, mul_assoc, mul_comm, mul_left_comm] + +open LaurentPolynomial in +/-- `z * zinv = 1` in `A⟦X⟧`. -/ +private theorem laurentZ_mul_laurentZInv : laurentZ * laurentZInv = 1 := by + rw [← map_mul, ← T_add] + simp + +open LaurentPolynomial in +/-- `z ^ n * zinv ^ n = 1` for all `n`. -/ +private theorem laurentZ_pow_mul_laurentZInv_pow (n : ℕ) : laurentZ ^ n * laurentZInv ^ n = 1 := by + rw [← mul_pow, laurentZ_mul_laurentZInv, one_pow] + +open LaurentPolynomial in +/-- `z ^ n = PS (T n)` for natural `n`. -/ +private theorem laurentZ_pow (n : ℕ) : + laurentZ ^ n = (PowerSeries.C : LaurentPolynomial ℂ →+* _) (T (n : ℤ)) := by + rw [← map_pow] + congr 1 + simp + +open LaurentPolynomial in +/-- `zinv ^ (m + 1) = PS (T (-(↑m + 1)))`. -/ +private theorem laurentZInv_pow (m : ℕ) : + laurentZInv ^ (m + 1) = (PowerSeries.C : LaurentPolynomial ℂ →+* _) (T (-(↑m + 1))) := by + rw [← map_pow] + congr 1 + rw [T_pow] + push_cast + ring_nf + +open LaurentPolynomial in +/-- Cancelling `zinv ^ m` against the first `m` factors of `z ^ (m + k)`. -/ +private theorem laurentZ_pow_add_mul_laurentZInv_pow (m k : ℕ) : + laurentZ ^ (m + k) * laurentZInv ^ m = laurentZ ^ k := by + rw [pow_add, mul_right_comm, laurentZ_pow_mul_laurentZInv_pow, one_mul] + +open LaurentPolynomial in +/-- Cancelling `z ^ n` against the first `n` factors of `zinv ^ (n + l)`. -/ +private theorem laurentZInv_pow_add_mul_laurentZ_pow (n l : ℕ) : + laurentZInv ^ (n + l) * laurentZ ^ n = laurentZInv ^ l := by + rw [pow_add, mul_right_comm, mul_comm (laurentZInv ^ n) (laurentZ ^ n), + laurentZ_pow_mul_laurentZInv_pow, one_mul] + +open LaurentPolynomial in +/-- Non-negative diagonal of the Cauchy product: HasSum giving `z^k * X^{C(k,2)}`. -/ +private theorem hasSum_diagonal_nonneg (k : ℕ) : + HasSum (fun m : ℕ => + (X ^ (m + k).choose 2 * laurentZ ^ (m + k) * qPochhammerInf (X * X ^ (m + k))) * + (X ^ (m.choose 2 + m) * laurentZInv ^ m * qPochhammerInv m)) + (laurentZ ^ k * X ^ k.choose 2) := by + have key : ∀ m : ℕ, + (X ^ (m + k).choose 2 * laurentZ ^ (m + k) * qPochhammerInf (X * X ^ (m + k))) * + (X ^ (m.choose 2 + m) * laurentZInv ^ m * qPochhammerInv (R := LaurentPolynomial ℂ) m) = + laurentZ ^ k * (X ^ (m + k).choose 2 * qPochhammerInf (X * X ^ (m + k)) * + (X ^ m.choose 2 * X ^ m * qPochhammerInv m)) := fun m => by + rw [← laurentZ_pow_add_mul_laurentZInv_pow m k] + ring + simp_rw [key] + exact HasSum.mul_left _ (hasSum_pow_choose_two_nonneg k) + +open LaurentPolynomial in +/-- Negative diagonal of the Cauchy product: HasSum giving `zinv^{l+1} * X^{C(l+2,2)}`. -/ +private theorem hasSum_diagonal_neg (l : ℕ) : + HasSum (fun n : ℕ => + (X ^ n.choose 2 * laurentZ ^ n * qPochhammerInf (X * X ^ n)) * + (X ^ ((n + (l + 1)).choose 2 + (n + (l + 1))) * laurentZInv ^ (n + (l + 1)) * + qPochhammerInv (n + (l + 1)))) + (laurentZInv ^ (l + 1) * X ^ (l + 2).choose 2) := by + have key : ∀ n : ℕ, (X ^ n.choose 2 * laurentZ ^ n * qPochhammerInf (X * X ^ n)) * + (X ^ ((n + (l + 1)).choose 2 + (n + (l + 1))) * laurentZInv ^ (n + (l + 1)) * + qPochhammerInv (R := LaurentPolynomial ℂ) (n + (l + 1))) = + laurentZInv ^ (l + 1) * (X ^ n.choose 2 * qPochhammerInf (X * X ^ n) * + (X ^ (n + (l + 1)).choose 2 * X ^ (n + (l + 1)) * + qPochhammerInv (n + (l + 1)))) := fun n => by + rw [← laurentZInv_pow_add_mul_laurentZ_pow n (l + 1)] + ring + simp_rw [key] + exact HasSum.mul_left _ (hasSum_pow_choose_two_neg l) + +/-- The equivalence ℕ × ℕ ≃ (ℕ × ℕ) ⊕ (ℕ × ℕ) splitting along the diagonal: + (n, m) ↦ if m ≤ n then inl (n - m, m) else inr (m - n - 1, n). -/ +private def diagonalEquiv : ℕ × ℕ ≃ (ℕ × ℕ) ⊕ (ℕ × ℕ) where + toFun p := if p.2 ≤ p.1 then Sum.inl (p.1 - p.2, p.2) else Sum.inr (p.2 - p.1 - 1, p.1) + invFun s := match s with + | Sum.inl (k, m) => (m + k, m) + | Sum.inr (l, n) => (n, n + l + 1) + left_inv := by intro ⟨n, m⟩; simp only; split_ifs with h <;> simp <;> omega + right_inv := by + intro s + rcases s with ⟨k, m⟩ | ⟨l, n⟩ <;> simp + omega + +open LaurentPolynomial in +private abbrev leftSummand (n : ℕ) : (LaurentPolynomial ℂ)⟦X⟧ := + X ^ n.choose 2 * laurentZ ^ n * qPochhammerInf (X * X ^ n) + +open LaurentPolynomial in +private abbrev rightSummand (m : ℕ) : (LaurentPolynomial ℂ)⟦X⟧ := + X ^ (m.choose 2 + m) * laurentZInv ^ m * qPochhammerInv m + +open LaurentPolynomial in +/-- `leftSummand n` is divisible by `X ^ C(n, 2)`, so its lower coefficients vanish. -/ +private theorem coeff_leftSummand_eq_zero {d n : ℕ} (h : d < n.choose 2) : + PowerSeries.coeff d (leftSummand n) = 0 := by + have hrw : leftSummand n = X ^ n.choose 2 * (laurentZ ^ n * qPochhammerInf (X * X ^ n)) := by + unfold leftSummand; ring + rw [hrw, PowerSeries.coeff_X_pow_mul', ite_eq_right h.not_ge] + +open LaurentPolynomial in +/-- `rightSummand m` is divisible by `X ^ (C(m, 2) + m)`, so its lower coefficients vanish. -/ +private theorem coeff_rightSummand_eq_zero {d m : ℕ} (h : d < m.choose 2 + m) : + PowerSeries.coeff d (rightSummand m) = 0 := by + have hrw : rightSummand m = X ^ (m.choose 2 + m) * (laurentZInv ^ m * qPochhammerInv m) := by + unfold rightSummand; ring + rw [hrw, PowerSeries.coeff_X_pow_mul', ite_eq_right h.not_ge] + +open LaurentPolynomial in +/-- `leftSummand i * rightSummand j` is divisible by `X ^ (C(i, 2) + (C(j, 2) + j))`. -/ +private theorem coeff_leftSummand_mul_rightSummand_eq_zero {d i j : ℕ} + (h : d < i.choose 2 + (j.choose 2 + j)) : + PowerSeries.coeff d (leftSummand i * rightSummand j) = 0 := by + have hrw : leftSummand i * rightSummand j = X ^ (i.choose 2 + (j.choose 2 + j)) * + (laurentZ ^ i * qPochhammerInf (X * X ^ i) * (laurentZInv ^ j * qPochhammerInv j)) := by + unfold leftSummand rightSummand; ring + rw [hrw, PowerSeries.coeff_X_pow_mul', ite_eq_right h.not_ge] + +open LaurentPolynomial in +/-- The leftSummand sequence is summable. -/ +private theorem summable_leftSummand : Summable leftSummand := by + refine (PowerSeries.WithPiTopology.summable_iff_summable_coeff (LaurentPolynomial ℂ)).mpr + fun d => summable_of_ne_finset_zero (s := Finset.range (d + 2)) fun n hn => ?_ + rw [Finset.mem_range, not_lt] at hn + exact coeff_leftSummand_eq_zero (Nat.lt_choose_two_of_add_two_le hn) + +open LaurentPolynomial in +/-- The rightSummand sequence is summable. -/ +private theorem summable_rightSummand : Summable rightSummand := by + refine (PowerSeries.WithPiTopology.summable_iff_summable_coeff (LaurentPolynomial ℂ)).mpr + fun d => summable_of_ne_finset_zero (s := Finset.range (d + 1)) fun m hm => ?_ + rw [Finset.mem_range, not_lt] at hm + exact coeff_rightSummand_eq_zero (by omega) + +open LaurentPolynomial in +/-- The double product sequence is summable. -/ +private theorem summable_leftSummand_mul_rightSummand : + Summable (fun p : ℕ × ℕ => leftSummand p.1 * rightSummand p.2) := by + refine (PowerSeries.WithPiTopology.summable_iff_summable_coeff (LaurentPolynomial ℂ)).mpr + fun d => summable_of_ne_finset_zero + (s := Finset.range (d + 2) ×ˢ Finset.range (d + 1)) fun p hp => ?_ + simp only [Finset.mem_product, Finset.mem_range, not_and_or, not_lt] at hp + refine coeff_leftSummand_mul_rightSummand_eq_zero ?_ + rcases hp with h | h + · have := Nat.lt_choose_two_of_add_two_le h + omega + · omega + +open LaurentPolynomial in +/-- HasSum for the double product giving jacobiProd. -/ +private theorem hasSum_leftSummand_mul_rightSummand_jacobiProd : + HasSum (fun p : ℕ × ℕ => leftSummand p.1 * rightSummand p.2) jacobiProd := by + have h : jacobiProd = ∑' p : ℕ × ℕ, leftSummand p.1 * rightSummand p.2 := by + rw [jacobiProd_eq_tsum_mul_tsum] + exact summable_leftSummand.hasSum.mul_eq summable_rightSummand.hasSum + summable_leftSummand_mul_rightSummand.hasSum + rw [h] + exact summable_leftSummand_mul_rightSummand.hasSum + + + +open LaurentPolynomial in +/-- Summability of the non-negative diagonal rearrangement. -/ +private theorem summable_diagonal_nonneg : + Summable (fun p : ℕ × ℕ => leftSummand (p.2 + p.1) * rightSummand p.2) := by + refine (PowerSeries.WithPiTopology.summable_iff_summable_coeff (LaurentPolynomial ℂ)).mpr + fun d => summable_of_ne_finset_zero + (s := Finset.range (d + 2) ×ˢ Finset.range (d + 2)) fun p hp => ?_ + simp only [Finset.mem_product, Finset.mem_range, not_and_or, not_lt] at hp + refine coeff_leftSummand_mul_rightSummand_eq_zero ?_ + rcases hp with h | h + · have := Nat.lt_choose_two_of_add_two_le (show d + 2 ≤ p.2 + p.1 by omega) + omega + · omega + +open LaurentPolynomial in +/-- Summability of the negative diagonal rearrangement. -/ +private theorem summable_diagonal_neg : + Summable (fun p : ℕ × ℕ => leftSummand p.2 * rightSummand (p.2 + p.1 + 1)) := by + refine (PowerSeries.WithPiTopology.summable_iff_summable_coeff (LaurentPolynomial ℂ)).mpr + fun d => summable_of_ne_finset_zero + (s := Finset.range (d + 1) ×ˢ Finset.range (d + 1)) fun p hp => ?_ + simp only [Finset.mem_product, Finset.mem_range, not_and_or, not_lt] at hp + refine coeff_leftSummand_mul_rightSummand_eq_zero ?_ + rcases hp with h | h <;> omega + +open LaurentPolynomial in +/-- Splitting a `HasSum` over `ℕ × ℕ` into the diagonals `(m + k, m)` and `(n, n + l + 1)`. -/ +private theorem hasSum_split_diagonal (f : ℕ × ℕ → (LaurentPolynomial ℂ)⟦X⟧) + {a b : (LaurentPolynomial ℂ)⟦X⟧} + (h1 : HasSum (fun p : ℕ × ℕ => f (p.2 + p.1, p.2)) a) + (h2 : HasSum (fun p : ℕ × ℕ => f (p.2, p.2 + p.1 + 1)) b) : + HasSum f (a + b) := + diagonalEquiv.symm.hasSum_iff.mp (h1.sum h2) + +open LaurentPolynomial in +/-- A family indexed by `ℕ × ℕ` sums to the sum of its row sums. -/ +private theorem hasSum_of_hasSum_fiberwise {f : ℕ × ℕ → (LaurentPolynomial ℂ)⟦X⟧} + {g : ℕ → (LaurentPolynomial ℂ)⟦X⟧} (hf : Summable f) + (hrow : ∀ k : ℕ, HasSum (fun m : ℕ => f (k, m)) (g k)) : + HasSum f (∑' k : ℕ, g k) := by + rw [(hf.hasSum.prod_fiberwise hrow).tsum_eq] + exact hf.hasSum + +open LaurentPolynomial in +/-- HasSum for the non-negative diagonal (combined over all k). -/ +private theorem hasSum_diagonal_nonneg_part : + HasSum (fun p : ℕ × ℕ => leftSummand (p.2 + p.1) * rightSummand p.2) + (∑' k : ℕ, laurentZ ^ k * X ^ k.choose 2) := + hasSum_of_hasSum_fiberwise summable_diagonal_nonneg hasSum_diagonal_nonneg + +open LaurentPolynomial in +/-- HasSum for the negative diagonal (combined over all l). -/ +private theorem hasSum_diagonal_neg_part : + HasSum (fun p : ℕ × ℕ => leftSummand p.2 * rightSummand (p.2 + p.1 + 1)) + (∑' l : ℕ, laurentZInv ^ (l + 1) * X ^ (l + 2).choose 2) := + hasSum_of_hasSum_fiberwise summable_diagonal_neg hasSum_diagonal_neg + +open LaurentPolynomial in +/-- HasSum for the double product giving jacobiBilateral. -/ +private theorem hasSum_leftSummand_mul_rightSummand_jacobiBilateral : + HasSum (fun p : ℕ × ℕ => leftSummand p.1 * rightSummand p.2) jacobiBilateral := by + have h : jacobiBilateral = (∑' k : ℕ, laurentZ ^ k * X ^ k.choose 2) + + ∑' l : ℕ, laurentZInv ^ (l + 1) * X ^ (l + 2).choose 2 := by + unfold jacobiBilateral + congr 1 + · exact tsum_congr fun n => by rw [laurentZ_pow] + · exact tsum_congr fun m => by rw [laurentZInv_pow] + rw [h] + exact hasSum_split_diagonal _ hasSum_diagonal_nonneg_part hasSum_diagonal_neg_part + +open LaurentPolynomial in +/-- jacobiProd = jacobiBilateral via HasSum.mul, diagonalEquiv, and diagonal HasSum results. -/ +theorem jacobiTripleProduct : @jacobiProd = @jacobiBilateral := + hasSum_leftSummand_mul_rightSummand_jacobiProd.unique + hasSum_leftSummand_mul_rightSummand_jacobiBilateral + +end JTP + +end QSeries.FormalPowerSeries + +end diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/FPSEuler.lean b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/FPSEuler.lean new file mode 100644 index 0000000000..55ea7c4cf6 --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/FPSEuler.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.FPS + +/-! +# FPS Euler Second Identity + +We prove the Euler second identity purely algebraically in the formal power series ring: + `qPochhammerInf(-a) = Σ_{n≥0} X^{C(n,2)} · aⁿ · (qPochhammer(X, n))⁻¹` + +The proof uses the finite q-binomial theorem (which holds in any commutative ring) +and takes the limit in the pi topology. The key step is showing that the +Gaussian binomial coefficient `qBinom(N, k, X)` converges to `(qPochhammer(X, k))⁻¹` +as N → ∞. +-/ + +noncomputable section + +open scoped MvPowerSeries.WithPiTopology +open PowerSeries Finset + +namespace QSeries.FormalPowerSeries + +variable {R : Type*} [CommRing R] [TopologicalSpace R] [DiscreteTopology R] + +omit [TopologicalSpace R] [DiscreteTopology R] in +/-- The constant term of `qPochhammer X n` is 1. -/ +theorem constantCoeff_qPochhammer_X (n : ℕ) : + constantCoeff (qPochhammer (X : R⟦X⟧) n) = 1 := by + induction n with + | zero => simp [qPochhammer] + | succ n ih => + rw [qPochhammer_succ] + simp [map_mul, map_sub, ih] + +omit [TopologicalSpace R] [DiscreteTopology R] in +/-- `qPochhammer X n` is a unit in `R⟦X⟧` (its constant term is 1). -/ +theorem isUnit_qPochhammer_X (n : ℕ) : IsUnit (qPochhammer (X : R⟦X⟧) n) := by + rw [PowerSeries.isUnit_iff_constantCoeff, constantCoeff_qPochhammer_X] + exact isUnit_one + +/-- `qPochhammerInf a = qPochhammer a n · qPochhammerInf (a · X^n)`. -/ +theorem qPochhammerInf_eq_qPochhammer_mul (a : R⟦X⟧) (n : ℕ) : + qPochhammerInf a = qPochhammer a n * qPochhammerInf (a * X ^ n) := by + induction n with + | zero => simp [qPochhammer] + | succ n ih => + rw [ih, qPochhammer_succ, mul_assoc] + congr 1 + rw [qPochhammerInf_eq_one_sub_mul] + ring_nf + +/-- `qPochhammerInf X = qPochhammer X n · qPochhammerInf (X * X^n)`. -/ +theorem qPochhammerInf_X_eq_qPochhammer_mul (n : ℕ) : + qPochhammerInf (X : R⟦X⟧) = qPochhammer X n * qPochhammerInf (X * X ^ n) := + qPochhammerInf_eq_qPochhammer_mul X n + +end QSeries.FormalPowerSeries + +end diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/FiniteBinomial.lean b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/FiniteBinomial.lean new file mode 100644 index 0000000000..26c4685596 --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/FiniteBinomial.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.Defs +import Mathlib.Algebra.BigOperators.Ring.Finset + +/-! +# Finite q-binomial theorem + +This file proves the finite q-binomial theorem: +$$\prod_{k=0}^{n-1}(1 + z q^k) = \sum_{k=0}^{n} q^{\binom{k}{2}} \binom{n}{k}_q z^k.$$ + +## Main results + +* `QSeries.prod_one_add_mul_pow_eq_sum_qBinom` — the finite q-binomial theorem. +-/ + +open Finset Filter +open scoped Topology + +namespace QSeries + +variable {R : Type*} + + +/-- **Finite q-binomial theorem.** +$$\prod_{k=0}^{n-1}(1 + z q^k) = \sum_{k=0}^{n} q^{\binom{k}{2}} \binom{n}{k}_q z^k.$$ -/ +theorem prod_one_add_mul_pow_eq_sum_qBinom [CommRing R] (q z : R) (n : ℕ) : + ∏ k ∈ Finset.range n, (1 + z * q ^ k) + = ∑ k ∈ Finset.range (n + 1), q ^ k.choose 2 * qBinom n k q * z ^ k := by + induction n with + | zero => simp + | succ n ih => + rw [Finset.prod_range_succ, ih] + rw [Finset.sum_range_succ' + (fun k => q ^ k.choose 2 * qBinom (n + 1) k q * z ^ k) (n + 1)] + simp only [Nat.choose_zero_succ, pow_zero, qBinom_succ_zero, mul_one] + have stepB : + (∑ k ∈ Finset.range (n + 1), + q ^ (k + 1).choose 2 * qBinom (n + 1) (k + 1) q * z ^ (k + 1)) + = (∑ k ∈ Finset.range (n + 1), + q ^ (k + 1).choose 2 * qBinom n (k + 1) q * z ^ (k + 1)) + + ∑ k ∈ Finset.range (n + 1), + q ^ (k + 1).choose 2 * q ^ (n - k) * qBinom n k q + * z ^ (k + 1) := by + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro k _ + rw [qBinom_succ_succ] + ring + rw [stepB] + have stepC : + (∑ k ∈ Finset.range (n + 1), + q ^ (k + 1).choose 2 * q ^ (n - k) * qBinom n k q * z ^ (k + 1)) + = z * q ^ n * + ∑ k ∈ Finset.range (n + 1), + q ^ k.choose 2 * qBinom n k q * z ^ k := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro k hk + have hkle : k ≤ n := Nat.lt_succ_iff.mp (Finset.mem_range.mp hk) + rw [Nat.choose_two_succ k, pow_add q (k.choose 2) k, + mul_assoc (q ^ k.choose 2) (q ^ k) (q ^ (n - k)), + ← pow_add q k (n - k), + show k + (n - k) = n from by omega, + pow_succ z k] + ring + rw [stepC] + have stepD : + (∑ k ∈ Finset.range (n + 1), q ^ k.choose 2 * qBinom n k q * z ^ k) + = (∑ k ∈ Finset.range (n + 1), + q ^ (k + 1).choose 2 * qBinom n (k + 1) q * z ^ (k + 1)) + 1 := by + have h := Finset.sum_range_succ' + (fun k => q ^ k.choose 2 * qBinom n k q * z ^ k) (n + 1) + simp only [Nat.choose_zero_succ, pow_zero, qBinom_zero_right, mul_one] at h + rw [Finset.sum_range_succ + (f := fun k => q ^ k.choose 2 * qBinom n k q * z ^ k) (n := n + 1), + qBinom_eq_zero_of_lt q (Nat.lt_succ_self n)] at h + simp only [mul_zero, zero_mul, add_zero] at h + exact h + linear_combination stepD + +end QSeries diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/InfPochhammer.lean b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/InfPochhammer.lean new file mode 100644 index 0000000000..f37e2be05a --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/InfPochhammer.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.Defs +import Mathlib.Analysis.SpecialFunctions.Log.Summable + +/-! +# Infinite q-Pochhammer symbol + +Under $\|q\| < 1$, the infinite product $(a;q)_\infty = \prod_{k \geq 0}(1 - aq^k)$ +converges. We define it via `tprod` and prove convergence, non-vanishing, and +partial-product convergence. + +## Main definitions + +* `QSeries.qPochhammerInf a q` — the infinite q-Pochhammer symbol $(a;q)_\infty$. + +## Main results + +* `QSeries.multipliable_one_sub_mul_pow` — multipliability for $\|q\| < 1$. +* `QSeries.tendsto_qPochhammer` — partial products converge to $(a;q)_\infty$. +* `QSeries.qPochhammerInf_ne_zero` — non-vanishing for $\|z\| < 1$, $\|q\| < 1$. +* `QSeries.qPochhammerInf_eq_one_sub_mul` — telescoping $(z;q)_\infty = (1-z)(zq;q)_\infty$. +-/ + +open Finset Filter +open scoped Topology + +namespace QSeries + +/-- **Infinite q-Pochhammer symbol** $(a;q)_\infty = \prod_{k=0}^{\infty}(1 - aq^k)$. + +Defined unconditionally as a `tprod`; convergence (under $\|q\| < 1$) is provided +by `multipliable_one_sub_mul_pow`. -/ +noncomputable def qPochhammerInf (a q : ℂ) : ℂ := ∏' k : ℕ, (1 - a * q ^ k) + +/-- For $\|q\| < 1$ the sequence $n \mapsto \|{-}(a q^n)\|$ is summable: it is the +geometric series $\|a\| \cdot \|q\|^n$. -/ +theorem summable_norm_neg_mul_pow {a q : ℂ} (hq : ‖q‖ < 1) : + Summable fun n : ℕ => ‖-(a * q ^ n)‖ := by + simpa [norm_neg, norm_mul, norm_pow] using + (summable_geometric_of_lt_one (norm_nonneg q) hq).mul_left ‖a‖ + +/-- If $\|z\| < 1$ and $\|q\| \le 1$ then $z q^k \ne 1$, so the q-Pochhammer factors +$1 - z q^k$ are all nonzero. -/ +theorem one_sub_mul_pow_ne_zero {z q : ℂ} (hz : ‖z‖ < 1) (hq : ‖q‖ ≤ 1) (k : ℕ) : + (1 : ℂ) - z * q ^ k ≠ 0 := by + intro h + have hnorm : ‖z‖ * ‖q‖ ^ k = 1 := by + rw [← norm_pow, ← norm_mul, show z * q ^ k = 1 from by linear_combination -h, norm_one] + nlinarith [norm_nonneg z, pow_le_one₀ (norm_nonneg q) hq (n := k), + pow_nonneg (norm_nonneg q) k] + +/-- For $\|q\| < 1$, the product $\prod_{k \geq 0}(1 - aq^k)$ is multipliable. -/ +theorem multipliable_one_sub_mul_pow {a q : ℂ} (hq : ‖q‖ < 1) : + Multipliable (fun k : ℕ => 1 - a * q ^ k) := by + simpa [sub_eq_add_neg] using + multipliable_one_add_of_summable (summable_norm_neg_mul_pow (a := a) hq) + +/-- **Non-vanishing of $(q;q)_n$ for $\|q\| < 1$.** -/ +theorem qPochhammer_self_ne_zero {q : ℂ} (hq : ‖q‖ < 1) (n : ℕ) : + qPochhammer q q n ≠ 0 := + Finset.prod_ne_zero_iff.mpr fun k _ => one_sub_mul_pow_ne_zero hq hq.le k + +/-- **Non-vanishing of $(z;q)_n$ when $\|z\| < 1$ and $\|q\| \le 1$.** -/ +theorem qPochhammer_ne_zero {z q : ℂ} (hz : ‖z‖ < 1) (hq : ‖q‖ ≤ 1) + (n : ℕ) : qPochhammer z q n ≠ 0 := + Finset.prod_ne_zero_iff.mpr fun k _ => one_sub_mul_pow_ne_zero hz hq k + +/-- Helper: $(a;q)_\infty \neq 0$ when every factor is nonzero. -/ +theorem qPochhammerInf_ne_zero_of_forall_ne_zero {a q : ℂ} (hq : ‖q‖ < 1) + (hfac : ∀ k : ℕ, (1 : ℂ) - a * q ^ k ≠ 0) : + qPochhammerInf a q ≠ 0 := by + have h_main := tprod_one_add_ne_zero_of_summable + (f := fun k : ℕ => -(a * q ^ k)) + (fun i => by rw [← sub_eq_add_neg]; exact hfac i) (summable_norm_neg_mul_pow hq) + simpa [qPochhammerInf, sub_eq_add_neg] using h_main + +/-- **Non-vanishing of $(z;q)_\infty$ for $\|z\| < 1, \|q\| < 1$.** -/ +theorem qPochhammerInf_ne_zero {z q : ℂ} (hz : ‖z‖ < 1) (hq : ‖q‖ < 1) : + qPochhammerInf z q ≠ 0 := + qPochhammerInf_ne_zero_of_forall_ne_zero hq fun k => one_sub_mul_pow_ne_zero hz hq.le k + +/-- **Partial products converge to $(a;q)_\infty$.** -/ +theorem tendsto_qPochhammer {a q : ℂ} (hq : ‖q‖ < 1) : + Tendsto (fun n => qPochhammer a q n) atTop (𝓝 (qPochhammerInf a q)) := by + have hmul : Multipliable (fun k : ℕ => 1 - a * q ^ k) := + multipliable_one_sub_mul_pow hq + simpa [qPochhammer, qPochhammerInf] using hmul.hasProd.tendsto_prod_nat + +/-- **Telescoping recursion for $(z;q)_\infty$.** +$(z;q)_\infty = (1 - z) \cdot (zq;q)_\infty$. -/ +theorem qPochhammerInf_eq_one_sub_mul {z q : ℂ} (hq : ‖q‖ < 1) : + qPochhammerInf z q = (1 - z) * qPochhammerInf (z * q) q := by + have h_fin : ∀ n : ℕ, + qPochhammer z q (n + 1) = (1 - z) * qPochhammer (z * q) q n := by + intro n + rw [qPochhammer, qPochhammer, Finset.prod_range_succ', mul_comm] + simp [pow_succ', mul_assoc] + have hLHS : Tendsto (fun n => (1 - z) * qPochhammer (z * q) q n) atTop + (𝓝 (qPochhammerInf z q)) := by + simpa only [h_fin] using + (tendsto_add_atTop_iff_nat 1).mpr (tendsto_qPochhammer (a := z) hq) + exact tendsto_nhds_unique hLHS ((tendsto_qPochhammer (a := z * q) hq).const_mul (1 - z)) + +end QSeries diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/JTPAnalytic.lean b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/JTPAnalytic.lean new file mode 100644 index 0000000000..39e658962f --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/JTPAnalytic.lean @@ -0,0 +1,474 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import Mathlib.Analysis.Normed.Module.MultipliableUniformlyOn +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.JacobiTripleProduct + +/-! +# Locally uniform convergence and analytic Jacobi triple product + +We prove that both sides of the Jacobi triple product (JTP) identity converge +locally uniformly for $\|q\| < 1$ on $\{z \neq 0\}$, and deduce the **analytic JTP**: +the identity holds for **all** $\|q\| < 1$ and $z \neq 0$ (removing the earlier +restriction $\|z\| < 1$). + +## Main results + +* `QSeries.summable_pow_mul_pow_choose_two'` — Summability of the nonneg bilateral + sum for **all** $z$ when $\|q\| < 1$. +* `QSeries.tendstoLocallyUniformlyOn_jacobiProd` — The product side converges + locally uniformly on $\{z \neq 0\}$. +* `QSeries.tendstoLocallyUniformlyOn_jacobiBilateral` — The series side + converges locally uniformly on $\{z \neq 0\}$. +* `QSeries.jacobiTripleProduct'` — The analytic JTP for all + $\|q\| < 1$ and $z \neq 0$. +-/ + +open Finset Filter +open scoped Topology + +namespace QSeries + +noncomputable section + +/-- Ratio-test core for the Weierstrass `M`-test bounds appearing in the Jacobi triple +product: for `‖q‖ < 1` the family `k ↦ c ^ (k + j) * ‖q‖ ^ (k + 2 * j).choose 2` is summable +for every real `c` and every shift `j`. -/ +theorem summable_pow_add_mul_norm_pow_choose_two {q : ℂ} (hq : ‖q‖ < 1) (c : ℝ) (j : ℕ) : + Summable fun k : ℕ => c ^ (k + j) * ‖q‖ ^ (k + 2 * j).choose 2 := by + have h_lim : Tendsto (fun k : ℕ => |c| * ‖q‖ ^ (k + 2 * j)) atTop (𝓝 0) := by + simpa using + (((tendsto_pow_atTop_nhds_zero_of_lt_one (norm_nonneg q) hq).comp + (tendsto_add_atTop_nat (2 * j))).const_mul |c|) + refine summable_of_ratio_norm_eventually_le (r := 1 / 2) (by norm_num) ?_ + filter_upwards [h_lim.eventually (gt_mem_nhds (by norm_num : (0 : ℝ) < 1 / 2))] with k hk + have hstep : (k + 1 + 2 * j).choose 2 = (k + 2 * j).choose 2 + (k + 2 * j) := by + rw [show k + 1 + 2 * j = k + 2 * j + 1 by ring, Nat.choose_succ_succ, + Nat.choose_one_right, add_comm] + have key : ‖c ^ (k + 1 + j) * ‖q‖ ^ (k + 1 + 2 * j).choose 2‖ + = |c| * ‖q‖ ^ (k + 2 * j) * ‖c ^ (k + j) * ‖q‖ ^ (k + 2 * j).choose 2‖ := by + rw [hstep] + simp only [norm_mul, norm_pow, Real.norm_eq_abs, abs_norm] + ring + rw [key] + exact mul_le_mul_of_nonneg_right hk.le (norm_nonneg _) + +/-- The nonneg bilateral sum $\sum_{k \ge 0} z^k q^{\binom{k}{2}}$ converges +for **all** $z \in \mathbb{C}$ when $\|q\| < 1$. -/ +theorem summable_pow_mul_pow_choose_two' {q z : ℂ} (hq : ‖q‖ < 1) : + Summable (fun k : ℕ => z ^ k * q ^ k.choose 2) := by + refine Summable.of_norm ?_ + simpa using summable_pow_add_mul_norm_pow_choose_two hq ‖z‖ 0 + +/-- Summability of the Weierstrass M-test bound $R^k \|q\|^{\binom{k}{2}}$ for any real $R$. -/ +theorem summable_pow_mul_norm_pow_choose_two {q : ℂ} (hq : ‖q‖ < 1) (R : ℝ) : + Summable (fun k : ℕ => R ^ k * ‖q‖ ^ k.choose 2) := by + simpa using summable_pow_add_mul_norm_pow_choose_two hq R 0 + +/-- Summability of the Weierstrass M-test bound $(R')^{m+1} \|q\|^{\binom{m+2}{2}}$ +for any real $R'$. -/ +theorem summable_pow_succ_mul_norm_pow_choose_two {q : ℂ} (hq : ‖q‖ < 1) (R' : ℝ) : + Summable (fun m : ℕ => R' ^ (m + 1) * ‖q‖ ^ (m + 2).choose 2) := by + simpa using summable_pow_add_mul_norm_pow_choose_two hq R' 1 + +/-- Extended product expansion for all $z$. -/ +theorem hasSum_pow_choose_two_mul_pow_mul_qPochhammerInf' {q z : ℂ} (hq : ‖q‖ < 1) : + HasSum (fun n : ℕ => q ^ n.choose 2 * z ^ n * qPochhammerInf (q * q ^ n) q) + (qPochhammerInf q q * qPochhammerInf (-z) q) := by + (convert HasSum.mul_left (qPochhammerInf q q) (euler_second_identity' hq) using 1; try rfl) + ext n + by_cases hn : qPochhammer q q n = 0 + · exact absurd hn <| qPochhammer_ne_zero hq (by linarith) n + · simp only [div_eq_mul_inv, mul_assoc, mul_comm] + congr 1 + rw [qPochhammerInf_self_eq_qPochhammer_mul hq n] + field_simp + +/-- The nonneg partial sums $\sum_{k < N} z^k q^{\binom{k}{2}}$ converge uniformly on +$\{z : \|z\| \le R\}$ by the Weierstrass M-test. -/ +theorem tendstoUniformlyOn_sum_pow_mul_pow_choose_two {q : ℂ} (hq : ‖q‖ < 1) (R : ℝ) : + TendstoUniformlyOn + (fun N z => ∑ k ∈ Finset.range N, z ^ k * q ^ k.choose 2) + (fun z => ∑' k : ℕ, z ^ k * q ^ k.choose 2) + atTop (Metric.closedBall 0 R) := by + refine tendstoUniformlyOn_tsum_nat (summable_pow_mul_norm_pow_choose_two hq R) fun n z hz => ?_ + rw [norm_mul, norm_pow, norm_pow] + exact mul_le_mul_of_nonneg_right + (pow_le_pow_left₀ (norm_nonneg z) (mem_closedBall_zero_iff.mp hz) n) (by positivity) + +/-- The negative-index partial sums converge uniformly on $\{z : \|z^{-1}\| \le R'\}$. -/ +theorem tendstoUniformlyOn_sum_inv_pow_mul_pow_choose_two {q : ℂ} (hq : ‖q‖ < 1) (R' : ℝ) : + TendstoUniformlyOn + (fun N z => ∑ m ∈ Finset.range N, z⁻¹ ^ (m + 1) * q ^ (m + 2).choose 2) + (fun z => ∑' m : ℕ, z⁻¹ ^ (m + 1) * q ^ (m + 2).choose 2) + atTop {z : ℂ | ‖z⁻¹‖ ≤ R'} := by + refine tendstoUniformlyOn_tsum_nat (summable_pow_succ_mul_norm_pow_choose_two hq R') + fun m z hz => ?_ + rw [norm_mul, norm_pow, norm_pow] + exact mul_le_mul_of_nonneg_right + (pow_le_pow_left₀ (norm_nonneg _) hz (m + 1)) (by positivity) + +/-- Convert Finset-indexed `TendstoUniformlyOn` to ℕ-indexed via `Finset.range`. -/ +private lemma tendstoUniformlyOn_prod_range_of_finset {α β : Type*} + [CommMonoid β] [UniformSpace β] {f : ℕ → α → β} {g : α → β} {s : Set α} + (h : TendstoUniformlyOn (fun (S : Finset ℕ) (x : α) => ∏ i ∈ S, f i x) g + Filter.atTop s) : + TendstoUniformlyOn (fun (n : ℕ) (x : α) => ∏ i ∈ Finset.range n, f i x) g + Filter.atTop s := by + intro U hU + have h1 := h U hU + rw [Filter.Eventually] at h1 ⊢ + have h_range : Filter.Tendsto Finset.range (Filter.atTop : Filter ℕ) + (Filter.atTop : Filter (Finset ℕ)) := by + rw [Filter.tendsto_atTop_atTop] + intro s + exact ⟨(s.sup id) + 1, fun n hn x hx => + Finset.mem_range.mpr (by have := Finset.le_sup (f := id) hx; simp at this; omega)⟩ + exact h_range.eventually h1 + +/-- The partial Pochhammer products $(a;q)_n$ converge locally uniformly in $a$ +when $\|q\| < 1$. -/ +theorem tendstoLocallyUniformly_qPochhammer {q : ℂ} (hq : ‖q‖ < 1) : + TendstoLocallyUniformly + (fun n a => qPochhammer a q n) + (fun a => qPochhammerInf a q) atTop := by + unfold qPochhammer qPochhammerInf + have h_uniform : ∀ K : Set ℂ, IsCompact K → + TendstoUniformlyOn (fun n a => ∏ k ∈ Finset.range n, (1 - a * q ^ k)) + (fun a => ∏' k : ℕ, (1 - a * q ^ k)) atTop K := by + intro K hK + set M := sSup ((fun a : ℂ => ‖a‖) '' K) + have h_summable : Summable fun k : ℕ => M * ‖q‖ ^ k := + Summable.mul_left _ <| summable_geometric_of_lt_one (norm_nonneg q) hq + have h_le : ∀ x ∈ K, ‖x‖ ≤ M := fun x hx => + le_csSup (hK.image continuous_norm).bddAbove (Set.mem_image_of_mem _ hx) + have h_bound : ∀ᶠ i in cofinite, ∀ x ∈ K, ‖-x * q ^ i‖ ≤ M * ‖q‖ ^ i := by + filter_upwards with i x hx + simpa using mul_le_mul_of_nonneg_right (h_le x hx) (by positivity : (0 : ℝ) ≤ ‖q‖ ^ i) + have h_prod := Summable.hasProdUniformlyOn_one_add hK h_summable h_bound + fun i => continuousOn_id.neg.mul continuousOn_const + convert tendstoUniformlyOn_prod_range_of_finset h_prod.tendstoUniformlyOn using 1 + · exact funext fun n => funext fun x => Finset.prod_congr rfl fun _ _ => by ring + · exact funext fun x => tprod_congr fun i => by ring + rw [Metric.tendstoLocallyUniformly_iff] + intro ε hε x + have hK := Metric.tendstoUniformlyOn_iff.mp + (h_uniform (Metric.closedBall x 1) (ProperSpace.isCompact_closedBall x 1)) + exact ⟨Metric.closedBall x 1, Metric.closedBall_mem_nhds _ zero_lt_one, hK ε hε⟩ + +/-- Precomposing a uniform limit with a map sending `s` into the domain set `t`. -/ +private lemma tendstoUniformlyOn_comp_of_mapsTo {s t : Set ℂ} {f : ℕ → ℂ → ℂ} {F φ : ℂ → ℂ} + (h : TendstoUniformlyOn f F atTop t) (hφ : ∀ z ∈ s, φ z ∈ t) : + TendstoUniformlyOn (fun n z => f n (φ z)) (fun z => F (φ z)) atTop s := by + intro U hU + filter_upwards [h U hU] with n hn z hz + exact hn (φ z) (hφ z hz) + +/-- On the closed ball of radius `‖z₀‖ / 2` around `z₀` every point has norm at least +`‖z₀‖ / 2`; so on such a ball `z` stays away from `0`. -/ +private lemma half_norm_le_norm_of_mem_closedBall {z₀ z : ℂ} + (hz : z ∈ Metric.closedBall z₀ (‖z₀‖ / 2)) : ‖z₀‖ / 2 ≤ ‖z‖ := by + rw [Metric.mem_closedBall, dist_eq_norm'] at hz + have := norm_sub_norm_le z₀ z + linarith + +/-- On a ball of radius `‖z₀‖ / 2` around `z₀ ≠ 0` the inverse `z⁻¹` is bounded +by `2 / ‖z₀‖`. -/ +private lemma norm_inv_le_of_mem_ball {z₀ z : ℂ} (hz₀ : z₀ ≠ 0) + (hz : z ∈ Metric.ball z₀ (‖z₀‖ / 2)) : ‖z⁻¹‖ ≤ 2 / ‖z₀‖ := by + have hz₀' : 0 < ‖z₀‖ := norm_pos_iff.mpr hz₀ + have hzn := half_norm_le_norm_of_mem_closedBall (Metric.ball_subset_closedBall hz) + rw [norm_inv, inv_eq_one_div, div_le_div_iff₀ (by linarith) hz₀'] + linarith + +/-- The partial sums of the bilateral Jacobi series converge locally uniformly on +$\{z \neq 0\}$ for fixed $\|q\| < 1$. -/ +theorem tendstoLocallyUniformlyOn_jacobiBilateral {q : ℂ} (hq : ‖q‖ < 1) : + TendstoLocallyUniformlyOn + (fun N z => + (∑ k ∈ Finset.range N, z ^ k * q ^ k.choose 2) + + (∑ m ∈ Finset.range N, z⁻¹ ^ (m + 1) * q ^ (m + 2).choose 2)) + (fun z => jacobiBilateral q z) atTop {z : ℂ | z ≠ 0} := by + refine TendstoLocallyUniformlyOn.add ?_ ?_ + · apply TendstoLocallyUniformly.tendstoLocallyUniformlyOn + rw [Metric.tendstoLocallyUniformly_iff] + intro ε hε x + have h_nonneg := Metric.tendstoUniformlyOn_iff.mp + (tendstoUniformlyOn_sum_pow_mul_pow_choose_two hq (‖x‖ + 1)) + exact ⟨Metric.closedBall 0 (‖x‖ + 1), + Metric.closedBall_mem_nhds_of_mem (by norm_num), h_nonneg ε hε⟩ + · intro ε hε z₀ hz₀ + have hr₀ : 0 < ‖z₀‖ / 2 := by + have : 0 < ‖z₀‖ := norm_pos_iff.mpr hz₀ + linarith + have hsub : Metric.ball z₀ (‖z₀‖ / 2) ∩ {z : ℂ | z ≠ 0} ⊆ {z : ℂ | ‖z⁻¹‖ ≤ 2 / ‖z₀‖} := + fun x hx => norm_inv_le_of_mem_ball hz₀ hx.1 + have hr := (tendstoUniformlyOn_sum_inv_pow_mul_pow_choose_two hq (2 / ‖z₀‖)).mono hsub + exact ⟨Metric.ball z₀ (‖z₀‖ / 2) ∩ {z | z ≠ 0}, + Filter.inter_mem (mem_nhdsWithin_of_mem_nhds (Metric.ball_mem_nhds z₀ hr₀)) + self_mem_nhdsWithin, hr ε hε⟩ + +/-- Uniform convergence of the product of two bounded sequences in a normed ring. -/ +lemma tendstoUniformlyOn_mul_of_bounded {s : Set ℂ} + {f₁ f₂ : ℕ → ℂ → ℂ} {F₁ F₂ : ℂ → ℂ} + (h₁ : TendstoUniformlyOn f₁ F₁ atTop s) + (h₂ : TendstoUniformlyOn f₂ F₂ atTop s) + (hb₁ : ∃ C, ∀ n, ∀ z ∈ s, ‖f₁ n z‖ ≤ C) + (hb₂ : ∃ C, ∀ z ∈ s, ‖F₂ z‖ ≤ C) : + TendstoUniformlyOn (fun n z => f₁ n z * f₂ n z) (fun z => F₁ z * F₂ z) atTop s := by + obtain ⟨C₁, hC₁⟩ := hb₁ + obtain ⟨C₂, hC₂⟩ := hb₂ + rcases s.eq_empty_or_nonempty with rfl | ⟨z₀, hz₀⟩ + · simp [TendstoUniformlyOn] + have hC₁0 : 0 ≤ C₁ := (norm_nonneg _).trans (hC₁ 0 z₀ hz₀) + have hC₂0 : 0 ≤ C₂ := (norm_nonneg _).trans (hC₂ z₀ hz₀) + rw [Metric.tendstoUniformlyOn_iff] at h₁ h₂ ⊢ + intro ε hε + filter_upwards [h₁ _ (by positivity : 0 < ε / (2 * (C₂ + 1))), + h₂ _ (by positivity : 0 < ε / (2 * (C₁ + 1)))] with n hn₁ hn₂ z hz + have e₁ : ‖F₁ z - f₁ n z‖ * (2 * (C₂ + 1)) < ε := by + rw [← lt_div_iff₀ (by positivity), ← dist_eq_norm]; exact hn₁ z hz + have e₂ : ‖F₂ z - f₂ n z‖ * (2 * (C₁ + 1)) < ε := by + rw [← lt_div_iff₀ (by positivity), ← dist_eq_norm]; exact hn₂ z hz + have h_diff : ‖F₁ z * F₂ z - f₁ n z * f₂ n z‖ + ≤ ‖F₁ z - f₁ n z‖ * ‖F₂ z‖ + ‖f₁ n z‖ * ‖F₂ z - f₂ n z‖ := by + rw [show F₁ z * F₂ z - f₁ n z * f₂ n z + = (F₁ z - f₁ n z) * F₂ z + f₁ n z * (F₂ z - f₂ n z) from by ring, + ← norm_mul, ← norm_mul] + exact norm_add_le _ _ + rw [dist_eq_norm] + refine h_diff.trans_lt (lt_of_le_of_lt (add_le_add + (mul_le_mul_of_nonneg_left (hC₂ z hz) (norm_nonneg _)) + (mul_le_mul_of_nonneg_right (hC₁ n z hz) (norm_nonneg _))) ?_) + nlinarith [norm_nonneg (F₁ z - f₁ n z), norm_nonneg (F₂ z - f₂ n z)] + +/-- The partial Pochhammer products are uniformly bounded on any closed ball. -/ +lemma exists_norm_qPochhammer_le {q : ℂ} (hq : ‖q‖ < 1) (R : ℝ) : + ∃ C, ∀ n, ∀ a ∈ Metric.closedBall (0 : ℂ) R, ‖qPochhammer a q n‖ ≤ C := by + refine ⟨Real.exp (R / (1 - ‖q‖)), fun n a ha => ?_⟩ + have haR : ‖a‖ ≤ R := mem_closedBall_zero_iff.mp ha + have hR : 0 ≤ R := (norm_nonneg a).trans haR + have hterm : ∀ k : ℕ, 0 ≤ R * ‖q‖ ^ k := fun k => mul_nonneg hR (by positivity) + have h_prod_le : ‖qPochhammer a q n‖ ≤ ∏ k ∈ Finset.range n, (1 + R * ‖q‖ ^ k) := by + have h_bound : ∀ k ∈ Finset.range n, ‖1 - a * q ^ k‖ ≤ 1 + R * ‖q‖ ^ k := fun k _ => + (norm_sub_le _ _).trans <| by + simpa [norm_mul] using + add_le_add_left (mul_le_mul_of_nonneg_right haR (by positivity : (0 : ℝ) ≤ ‖q‖ ^ k)) 1 + simpa [qPochhammer] using Finset.prod_le_prod₀ (fun _ _ => norm_nonneg _) h_bound + have h_exp_bound : ∏ k ∈ Finset.range n, (1 + R * ‖q‖ ^ k) + ≤ Real.exp (∑ k ∈ Finset.range n, R * ‖q‖ ^ k) := by + rw [Real.exp_sum] + exact Finset.prod_le_prod₀ (fun k _ => by linarith [hterm k]) + fun k _ => by rw [add_comm]; exact Real.add_one_le_exp _ + refine h_prod_le.trans <| h_exp_bound.trans <| Real.exp_le_exp.mpr ?_ + rw [← Finset.mul_sum, div_eq_mul_inv] + refine mul_le_mul_of_nonneg_left ?_ hR + rw [← tsum_geometric_of_lt_one (norm_nonneg q) hq] + exact Summable.sum_le_tsum _ (fun _ _ => by positivity) + (summable_geometric_of_lt_one (norm_nonneg q) hq) + +/-- The Pochhammer products $(a;q)_n$ converge uniformly on any closed ball as $n \to \infty$. -/ +lemma tendstoUniformlyOn_qPochhammer_closedBall {q : ℂ} (hq : ‖q‖ < 1) (R : ℝ) : + TendstoUniformlyOn (fun n a => qPochhammer a q n) + (fun a => qPochhammerInf a q) atTop (Metric.closedBall 0 R) := + (tendstoLocallyUniformlyOn_iff_tendstoUniformlyOn_of_compact + (ProperSpace.isCompact_closedBall (0 : ℂ) R)).mp + (tendstoLocallyUniformly_qPochhammer hq).tendstoLocallyUniformlyOn + +/-- The infinite Pochhammer product $\mathrm{qPochhammerInf}$ is uniformly bounded on any +closed ball. -/ +lemma exists_norm_qPochhammerInf_le {q : ℂ} (hq : ‖q‖ < 1) (R : ℝ) : + ∃ C, ∀ a ∈ Metric.closedBall (0 : ℂ) R, ‖qPochhammerInf a q‖ ≤ C := by + obtain ⟨C, hC⟩ := exists_norm_qPochhammer_le hq R + obtain ⟨N, hN⟩ : ∃ N, ∀ n ≥ N, ∀ a ∈ Metric.closedBall (0 : ℂ) R, + ‖qPochhammerInf a q - qPochhammer a q n‖ < 1 := by + simpa [dist_eq_norm] using Metric.tendstoUniformlyOn_iff.mp + (tendstoUniformlyOn_qPochhammer_closedBall hq R) 1 zero_lt_one + refine ⟨C + 1, fun a ha => ?_⟩ + have h1 := hN N le_rfl a ha + have h2 := hC N a ha + refine le_trans ?_ (by linarith : + ‖qPochhammerInf a q - qPochhammer a q N‖ + ‖qPochhammer a q N‖ ≤ C + 1) + simpa using norm_add_le (qPochhammerInf a q - qPochhammer a q N) (qPochhammer a q N) + +/-- For `z` in the closed ball of radius `‖z₀‖ / 2` around `z₀ ≠ 0`, +`-q / z` lies in the closed ball of radius `2 * ‖q‖ / ‖z₀‖` around `0`. -/ +private lemma neg_div_mem_closedBall {q z₀ z : ℂ} (hz₀ : z₀ ≠ 0) + (hz : z ∈ Metric.closedBall z₀ (‖z₀‖ / 2)) : + -q / z ∈ Metric.closedBall (0 : ℂ) (2 * ‖q‖ / ‖z₀‖) := by + have hz₀' : 0 < ‖z₀‖ := norm_pos_iff.mpr hz₀ + have hzn := half_norm_le_norm_of_mem_closedBall hz + rw [mem_closedBall_zero_iff, norm_div, norm_neg, div_le_div_iff₀ (by linarith) hz₀'] + nlinarith [norm_nonneg q] + +/-- The Pochhammer products `qPochhammer (-z) q n` converge uniformly to +`qPochhammerInf (-z) q` on any `Metric.closedBall z₀ r` when `‖q‖ < 1`. -/ +lemma tendstoUniformlyOn_qPochhammer_neg_closedBall {q : ℂ} (hq : ‖q‖ < 1) (z₀ : ℂ) (r : ℝ) : + TendstoUniformlyOn (fun n z => qPochhammer (-z) q n) + (fun z => qPochhammerInf (-z) q) atTop (Metric.closedBall z₀ r) := by + refine tendstoUniformlyOn_comp_of_mapsTo + (tendstoUniformlyOn_qPochhammer_closedBall hq (‖z₀‖ + r)) fun z hz => ?_ + rw [Metric.mem_closedBall, dist_eq_norm] at hz + rw [mem_closedBall_zero_iff, norm_neg] + linarith [norm_sub_norm_le z z₀] + +/-- The Pochhammer products `qPochhammer (-q / z) q n` converge uniformly to +`qPochhammerInf (-q / z) q` on `Metric.closedBall z₀ (‖z₀‖ / 2)` for `z₀ ≠ 0`, +`‖q‖ < 1`. -/ +lemma tendstoUniformlyOn_qPochhammer_neg_div {q : ℂ} (hq : ‖q‖ < 1) {z₀ : ℂ} (hz₀ : z₀ ≠ 0) : + TendstoUniformlyOn (fun n z => qPochhammer (-q / z) q n) + (fun z => qPochhammerInf (-q / z) q) atTop (Metric.closedBall z₀ (‖z₀‖ / 2)) := + tendstoUniformlyOn_comp_of_mapsTo + (tendstoUniformlyOn_qPochhammer_closedBall hq (2 * ‖q‖ / ‖z₀‖)) + fun _ hz => neg_div_mem_closedBall hz₀ hz + +/-- The partial products `qPochhammer q q n * qPochhammer (-z) q n * qPochhammer (-q / z) q n` +converge locally uniformly to `jacobiProd q z` on `{z : ℂ | z ≠ 0}` when `‖q‖ < 1`. -/ +theorem tendstoLocallyUniformlyOn_jacobiProd {q : ℂ} (hq : ‖q‖ < 1) : + TendstoLocallyUniformlyOn + (fun n z => qPochhammer q q n * qPochhammer (-z) q n * qPochhammer (-q / z) q n) + (fun z => jacobiProd q z) atTop {z : ℂ | z ≠ 0} := by + have h_suff : ∀ z₀ : ℂ, z₀ ≠ 0 → + TendstoUniformlyOn + (fun n z => qPochhammer q q n * qPochhammer (-z) q n * qPochhammer (-q / z) q n) + (fun z => jacobiProd q z) atTop (Metric.closedBall z₀ (‖z₀‖ / 2)) := by + intro z₀ hz₀ + have hmem₁ : ∀ z ∈ Metric.closedBall z₀ (‖z₀‖ / 2), + -z ∈ Metric.closedBall (0 : ℂ) (‖z₀‖ + ‖z₀‖ / 2) := by + intro z hz + rw [Metric.mem_closedBall, dist_eq_norm] at hz + rw [mem_closedBall_zero_iff, norm_neg] + linarith [norm_sub_norm_le z z₀] + have hmem₂ : ∀ z ∈ Metric.closedBall z₀ (‖z₀‖ / 2), + -q / z ∈ Metric.closedBall (0 : ℂ) (2 * ‖q‖ / ‖z₀‖) := + fun z hz => neg_div_mem_closedBall hz₀ hz + have hmemq : ∀ z ∈ Metric.closedBall z₀ (‖z₀‖ / 2), q ∈ Metric.closedBall (0 : ℂ) 1 := + fun _ _ => mem_closedBall_zero_iff.mpr hq.le + have h_neg := tendstoUniformlyOn_qPochhammer_neg_closedBall hq z₀ (‖z₀‖ / 2) + have h_div := tendstoUniformlyOn_qPochhammer_neg_div hq hz₀ + have h_qq : TendstoUniformlyOn (fun n z => qPochhammer q q n) + (fun _ : ℂ => qPochhammerInf q q) atTop (Metric.closedBall z₀ (‖z₀‖ / 2)) := + tendstoUniformlyOn_comp_of_mapsTo (φ := fun _ => q) + (tendstoUniformlyOn_qPochhammer_closedBall hq 1) hmemq + obtain ⟨B₁, hB₁⟩ := exists_norm_qPochhammer_le hq (‖z₀‖ + ‖z₀‖ / 2) + obtain ⟨Bq, hBq⟩ := exists_norm_qPochhammer_le hq 1 + obtain ⟨C₁, hC₁⟩ := exists_norm_qPochhammerInf_le hq (‖z₀‖ + ‖z₀‖ / 2) + obtain ⟨C₂, hC₂⟩ := exists_norm_qPochhammerInf_le hq (2 * ‖q‖ / ‖z₀‖) + have h_BC := tendstoUniformlyOn_mul_of_bounded h_neg h_div + ⟨B₁, fun n z hz => hB₁ n (-z) (hmem₁ z hz)⟩ + ⟨C₂, fun z hz => hC₂ _ (hmem₂ z hz)⟩ + have hb : ∀ z ∈ Metric.closedBall z₀ (‖z₀‖ / 2), + ‖qPochhammerInf (-z) q * qPochhammerInf (-q / z) q‖ ≤ C₁ * C₂ := by + intro z hz + rw [norm_mul] + exact mul_le_mul (hC₁ _ (hmem₁ z hz)) (hC₂ _ (hmem₂ z hz)) (norm_nonneg _) + ((norm_nonneg _).trans (hC₁ _ (hmem₁ z hz))) + have h_ABC := tendstoUniformlyOn_mul_of_bounded h_qq h_BC + ⟨Bq, fun n z hz => hBq n q (hmemq z hz)⟩ ⟨C₁ * C₂, hb⟩ + simpa only [← mul_assoc, jacobiProd] using h_ABC + intro ε hε z₀ hz₀ + refine ⟨Metric.closedBall z₀ (‖z₀‖ / 2) ∩ {z | z ≠ 0}, ?_, ?_⟩ + · exact mem_nhdsWithin_of_mem_nhds (Filter.inter_mem + (Metric.closedBall_mem_nhds _ <| half_pos <| norm_pos_iff.mpr hz₀) + (isOpen_ne.mem_nhds hz₀)) + · exact (h_suff z₀ hz₀ ε hε).mono fun n hn y hy => hn y hy.1 + +/-- The bilateral series satisfies $g(qz) = g(z)/z$ for **all** $z \neq 0$. -/ +theorem jacobiBilateral_mul_eq_div' {q z : ℂ} (hq : ‖q‖ < 1) (hq' : q ≠ 0) + (hz' : z ≠ 0) : + jacobiBilateral q (q * z) = jacobiBilateral q z / z := by + have h_split : jacobiBilateral q (q * z) = + jacobiBilateralPos q (q * z) + jacobiBilateralNeg q (q * z) := rfl + have h_pos : jacobiBilateralPos q (q * z) = (jacobiBilateralPos q z - 1) / z := by + unfold jacobiBilateralPos + rw [eq_div_iff hz']; symm + simp +decide only [mul_comm] + rw [← Summable.sum_add_tsum_nat_add 1] + · norm_num [pow_succ', mul_pow, mul_assoc, mul_comm, mul_left_comm, tsum_mul_left] + norm_num [Nat.choose_succ_succ, pow_add, mul_assoc, mul_comm, mul_left_comm] + · convert summable_pow_mul_pow_choose_two' hq using 1 + have h_neg : jacobiBilateralNeg q (q * z) = (jacobiBilateralNeg q z + 1) / z := by + unfold jacobiBilateralNeg + simp +decide only [mul_inv_rev, mul_comm, pow_succ, mul_assoc, tsum_mul_left, inv_pow, + div_eq_mul_inv] + ring_nf + rw [Summable.tsum_eq_zero_add] + · norm_num [hq', hz']; ring_nf + simp +decide only [ne_eq, hq', not_false_eq_true, mul_inv_cancel₀, mul_comm, mul_one, + inv_pow, mul_left_comm, tsum_mul_left, mul_assoc, add_right_inj] + ring_nf + rw [← tsum_mul_left]; rw [← tsum_mul_left]; congr; ext x + rw [show (3 + x).choose 2 = (2 + x).choose 2 + (2 + x) by + simp +arith +decide [Nat.choose]]; ring_nf + simp +decide [mul_assoc, mul_comm, mul_left_comm, hq'] + · have := summable_inv_pow_mul_pow_choose_two (z := q * z) hq + (convert this.mul_left (q * z) using 2; first | rfl | ring_nf) + simp +decide [hq', hz', mul_assoc, mul_comm q] + rw [h_split, h_pos, h_neg, + show jacobiBilateral q z = jacobiBilateralPos q z + jacobiBilateralNeg q z from rfl] + ring + +/-- Iterating the product-side FE $N$ times. -/ +theorem jacobiProd_eq_pow_mul_pow_choose_two_mul {q z : ℂ} (hq : ‖q‖ < 1) (hq' : q ≠ 0) + (hz : z ≠ 0) (N : ℕ) : + jacobiProd q z = z ^ N * q ^ N.choose 2 * jacobiProd q (q ^ N * z) := by + induction N with + | zero => norm_num + | succ N ih => + rw [ih, pow_succ'] + rw [show jacobiProd q (q ^ N * z) = + jacobiProd q (q * (q ^ N * z)) * (q ^ N * z) by + rw [eq_comm, jacobiProd_mul_eq_div] + · rw [div_mul_cancel₀ _ (mul_ne_zero (pow_ne_zero _ hq') hz)] + · exact hq + · assumption + · aesop]; ring_nf + rw [show (1 + N).choose 2 = N.choose 2 + N by + rw [Nat.add_comm, Nat.choose_succ_succ]; norm_num; ring]; ring + +/-- Iterating the series-side FE $N$ times. -/ +theorem jacobiBilateral_eq_pow_mul_pow_choose_two_mul {q z : ℂ} (hq : ‖q‖ < 1) (hq' : q ≠ 0) + (hz : z ≠ 0) (N : ℕ) : + jacobiBilateral q z = + z ^ N * q ^ N.choose 2 * jacobiBilateral q (q ^ N * z) := by + induction N with + | zero => norm_num + | succ N ih => + have h_fe : jacobiBilateral q (q * (q ^ N * z)) = + jacobiBilateral q (q ^ N * z) / (q ^ N * z) := + jacobiBilateral_mul_eq_div' hq hq' (mul_ne_zero (pow_ne_zero _ hq') hz) + simp_all +decide [Nat.choose_succ_succ, pow_succ', mul_assoc, mul_comm, + mul_left_comm, div_eq_mul_inv] + simp +decide [pow_add, mul_assoc, hq'] + +/-- **Analytic Jacobi triple product identity.** +For $\|q\| < 1$ and $z \neq 0$: +$$(q;q)_\infty \cdot (-z;q)_\infty \cdot (-q/z;q)_\infty + \;=\; \sum_{k \in \mathbb{Z}} z^k \, q^{k(k-1)/2}.$$ + +This extends the basic JTP (which required $\|z\| < 1$) to **all** $z \neq 0$ +using the functional equation $f(qz) = f(z)/z$ satisfied by both sides. -/ +theorem jacobiTripleProduct' {q z : ℂ} (hq : ‖q‖ < 1) (hz : z ≠ 0) : + jacobiProd q z = jacobiBilateral q z := by + by_cases hq' : q = 0 + · subst hq' + unfold jacobiProd jacobiBilateral jacobiBilateralPos jacobiBilateralNeg qPochhammerInf + norm_num [Finset.sum_range_succ', Nat.choose] + rw [tprod_eq_prod, tsum_eq_sum] + any_goals exact {0, 1} + · norm_num [Finset.prod, Finset.sum] + · rintro (_ | _ | b) <;> simp +decide [Nat.choose] + · aesop + · obtain ⟨N, hN⟩ : ∃ N : ℕ, ‖q ^ N * z‖ < 1 := by + simpa using (summable_geometric_of_lt_one (by positivity) hq) |> fun h => + h.mul_right _ |> fun h => + h.tendsto_atTop_zero.eventually (gt_mem_nhds zero_lt_one) |> fun h => h.exists + rw [jacobiProd_eq_pow_mul_pow_choose_two_mul hq hq' hz N, + jacobiBilateral_eq_pow_mul_pow_choose_two_mul hq hq' hz N, + jacobiTripleProduct hq hN (by aesop)] + +end + +end QSeries diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/JTPCore.lean b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/JTPCore.lean new file mode 100644 index 0000000000..f9dc9411bb --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/JTPCore.lean @@ -0,0 +1,182 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.JTPKeyIdentity + +/-! +# Core lemmas for the Jacobi triple product proof + +The proof strategy: Show $(q;q)_∞ (-z;q)_∞ (-q/z;q)_∞ = g(z)$ by: +1. Dividing both sides by $(-q/z;q)_∞$ (nonzero for ‖q/z‖ < 1) +2. Showing $g(z) / (-q/z;q)_∞ = (q;q)_∞ (-z;q)_∞$ +3. This follows from the Cauchy product and the Euler 2nd identity + +Key identity: $(q;q)_∞ / (q;q)_n = (q^{n+1};q)_∞$ (telescoping) +-/ + +open Finset Filter +open scoped Topology + +namespace QSeries + +noncomputable section + +/-- Telescoping factorisation: $(q;q)_\infty = (q;q)_n \cdot (q \cdot q^n; q)_\infty$. -/ +theorem qPochhammerInf_self_eq_qPochhammer_mul {q : ℂ} (hq : ‖q‖ < 1) (n : ℕ) : + qPochhammerInf q q = qPochhammer q q n * qPochhammerInf (q * q ^ n) q := by + rw [qPochhammerInf_mul_pow_eq_div hq n, mul_div_cancel₀ _ (qPochhammer_self_ne_zero hq n)] + +/-- Euler's second identity evaluated at $z = -q^{n+1}$, giving $(q^{n+1}; q)_\infty$. -/ +theorem euler_second_identity_neg_pow {q : ℂ} (hq : ‖q‖ < 1) (n : ℕ) : + HasSum (fun m : ℕ => q ^ m.choose 2 * (-q ^ (n + 1)) ^ m / qPochhammer q q m) + (qPochhammerInf (q ^ (n + 1)) q) := by + convert euler_second_identity hq ?_ using 1 + · norm_num + · simpa using pow_lt_one₀ (norm_nonneg q) hq (by omega) + +/-- The product $(q;q)_\infty (-z;q)_\infty$ equals +$\sum_n q^{\binom{n}{2}} z^n (q^{n+1};q)_\infty$, via Euler's second identity. -/ +theorem hasSum_pow_choose_two_mul_pow_mul_qPochhammerInf {q z : ℂ} (hq : ‖q‖ < 1) (hz : ‖z‖ < 1) : + HasSum (fun n : ℕ => q ^ n.choose 2 * z ^ n * qPochhammerInf (q * q ^ n) q) + (qPochhammerInf q q * qPochhammerInf (-z) q) := by + refine ((euler_second_identity hq hz).mul_left (qPochhammerInf q q)).congr_fun fun n => ?_ + rw [qPochhammerInf_mul_pow_eq_div hq n] + ring + +/-- Key identity: the n-th coefficient of the product (q;q)_∞ (-z;q)_∞ +expanded using Euler 2nd, multiplied by (q;q)_∞, gives the JTP coefficient. +Specifically: qPochhammerInf (q * q^n) q = qPochhammerInf (q^(n+1)) q. -/ +theorem qPochhammerInf_mul_pow {q : ℂ} (n : ℕ) : + qPochhammerInf (q * q ^ n) q = qPochhammerInf (q ^ (n + 1)) q := by + congr 1; ring + +/-- The Jacobi triple product identity at $q = 0$, verified directly. -/ +theorem jacobiTripleProduct_zero {z : ℂ} (hz' : z ≠ 0) : + qPochhammerInf 0 0 * qPochhammerInf (-z) 0 * qPochhammerInf (-0 / z) 0 = + (∑' k : ℕ, z ^ k * (0 : ℂ) ^ k.choose 2) + + (∑' m : ℕ, z⁻¹ ^ (m + 1) * (0 : ℂ) ^ (m + 2).choose 2) := by + norm_num [qPochhammerInf] + rw [tprod_eq_prod] + any_goals exact {0} + · rw [tsum_eq_sum, tsum_eq_single 0] <;> norm_num + any_goals exact {0, 1} + · norm_num [Finset.sum_pair] + · exact fun n hn => Or.inr <| Nat.ne_of_gt <| Nat.choose_pos <| by omega + · intro b hb; rcases b with (_ | _ | b) <;> simp_all [Nat.choose] + · aesop + +/-- Euler's second identity evaluated at $z = -q/z$, giving $(-q/z; q)_\infty$. -/ +theorem euler_second_identity_div {q z : ℂ} (hq : ‖q‖ < 1) (hzq : ‖q‖ < ‖z‖) + (hz' : z ≠ 0) : + HasSum (fun m : ℕ => q ^ m.choose 2 * q ^ m * z⁻¹ ^ m / qPochhammer q q m) + (qPochhammerInf (-q / z) q) := by + have hnorm : ‖q / z‖ < 1 := by + rw [norm_div] + exact (div_lt_one (norm_pos_iff.mpr hz')).2 hzq + rw [neg_div] + exact (euler_second_identity hq hnorm).congr_fun fun n => by ring + +/-! ### The diagonal splitting of a double series over `ℕ × ℕ` -/ + +/-- The diagonal splitting equivalence `(ℕ × ℕ) ⊕ (ℕ × ℕ) ≃ ℕ × ℕ`: the left summand +enumerates the pairs on or below the diagonal as `(m + k, m)`, the right summand +enumerates the pairs strictly above it as `(n, n + l + 1)`. -/ +private def diagonalEquiv : (ℕ × ℕ) ⊕ (ℕ × ℕ) ≃ ℕ × ℕ where + toFun s := match s with + | .inl p => (p.2 + p.1, p.2) + | .inr p => (p.2, p.2 + (p.1 + 1)) + invFun p := if p.2 ≤ p.1 then .inl (p.1 - p.2, p.2) else .inr (p.2 - p.1 - 1, p.1) + left_inv := by rintro (⟨k, m⟩ | ⟨l, n⟩) <;> simp + right_inv := by rintro ⟨a, b⟩; dsimp only; split_ifs with h <;> simp <;> omega + +/-- `HasSum` form of the diagonal splitting of a family indexed by `ℕ × ℕ`. -/ +private theorem hasSum_split_diagonal {f : ℕ × ℕ → ℂ} {a b : ℂ} + (h1 : HasSum (fun p : ℕ × ℕ => f (p.2 + p.1, p.2)) a) + (h2 : HasSum (fun p : ℕ × ℕ => f (p.2, p.2 + (p.1 + 1))) b) : + HasSum f (a + b) := + diagonalEquiv.hasSum_iff.mp (HasSum.sum (f := f ∘ diagonalEquiv) h1 h2) + +/-- Splitting a summable family over `ℕ × ℕ` along the diagonal: +$\sum_p f(p) = \sum_k \sum_m f(m+k, m) + \sum_l \sum_n f(n, n+l+1)$. -/ +theorem tsum_split_diagonal {f : ℕ × ℕ → ℂ} (hf : Summable f) : + ∑' p : ℕ × ℕ, f p = + (∑' k : ℕ, ∑' m : ℕ, f (m + k, m)) + ∑' l : ℕ, ∑' n : ℕ, f (n, n + (l + 1)) := by + have hc : Summable (f ∘ diagonalEquiv) := diagonalEquiv.summable_iff.mpr hf + have hl : Summable fun p : ℕ × ℕ => f (p.2 + p.1, p.2) := hc.comp_injective Sum.inl_injective + have hr : Summable fun p : ℕ × ℕ => f (p.2, p.2 + (p.1 + 1)) := + hc.comp_injective Sum.inr_injective + rw [(hasSum_split_diagonal hl.hasSum hr.hasSum).tsum_eq, hl.tsum_prod, hr.tsum_prod] + +/-! ### The Jacobi triple product from two `HasSum` inputs -/ + +/-- Cancellation `z ^ (m + k) * (z⁻¹) ^ m = z ^ k` for `z ≠ 0`. -/ +private theorem pow_add_mul_inv_pow {z : ℂ} (hz : z ≠ 0) (m k : ℕ) : + z ^ (m + k) * z⁻¹ ^ m = z ^ k := by + rw [pow_add, mul_right_comm, ← mul_pow, mul_inv_cancel₀ hz, one_pow, one_mul] + +/-- Cancellation `z ^ n * (z⁻¹) ^ (n + j) = (z⁻¹) ^ j` for `z ≠ 0`. -/ +private theorem pow_mul_inv_pow_add {z : ℂ} (hz : z ≠ 0) (n j : ℕ) : + z ^ n * z⁻¹ ^ (n + j) = z⁻¹ ^ j := by + rw [pow_add, ← mul_assoc, ← mul_pow, mul_inv_cancel₀ hz, one_pow, one_mul] + +/-- The `z ^ k` diagonal of the Jacobi triple product double series sums to +`z ^ k * q ^ (k choose 2)`. -/ +theorem hasSum_diagonal_nonneg {q z : ℂ} (hq : ‖q‖ < 1) (hz' : z ≠ 0) (k : ℕ) : + HasSum (fun m : ℕ => + q ^ (m + k).choose 2 * z ^ (m + k) * qPochhammerInf (q * q ^ (m + k)) q * + (q ^ m.choose 2 * q ^ m * z⁻¹ ^ m / qPochhammer q q m)) (z ^ k * q ^ k.choose 2) := by + refine ((hasSum_pow_choose_two_nonneg hq k).mul_left (z ^ k)).congr_fun fun m => ?_ + rw [div_eq_mul_inv, div_eq_mul_inv, ← pow_add_mul_inv_pow hz' m k] + ring + +/-- The `z⁻¹ ^ (l + 1)` diagonal of the Jacobi triple product double series sums to +`z⁻¹ ^ (l + 1) * q ^ (l + 2 choose 2)`. -/ +theorem hasSum_diagonal_neg {q z : ℂ} (hq : ‖q‖ < 1) (hz' : z ≠ 0) (l : ℕ) : + HasSum (fun n : ℕ => + q ^ n.choose 2 * z ^ n * qPochhammerInf (q * q ^ n) q * + (q ^ (n + (l + 1)).choose 2 * q ^ (n + (l + 1)) * z⁻¹ ^ (n + (l + 1)) / + qPochhammer q q (n + (l + 1)))) (z⁻¹ ^ (l + 1) * q ^ (l + 2).choose 2) := by + refine ((hasSum_pow_choose_two_neg hq l).mul_left (z⁻¹ ^ (l + 1))).congr_fun fun n => ?_ + rw [div_eq_mul_inv, div_eq_mul_inv, ← pow_mul_inv_pow_add hz' n (l + 1)] + ring + +/-- The Jacobi triple product identity, given Euler's second identity in the two shapes +needed: `hA` expands $(q;q)_\infty(-z;q)_\infty$ and `hB` expands $(-q/z;q)_\infty$. +Multiplying the two series, applying Fubini and splitting the resulting double series +along the diagonal reduces everything to `hasSum_diagonal_nonneg` / `hasSum_diagonal_neg`. -/ +theorem jacobiTripleProduct_of_hasSum {q z : ℂ} (hq : ‖q‖ < 1) (hz' : z ≠ 0) + (hA : HasSum (fun n : ℕ => q ^ n.choose 2 * z ^ n * qPochhammerInf (q * q ^ n) q) + (qPochhammerInf q q * qPochhammerInf (-z) q)) + (hB : HasSum (fun m : ℕ => q ^ m.choose 2 * q ^ m * z⁻¹ ^ m / qPochhammer q q m) + (qPochhammerInf (-q / z) q)) : + qPochhammerInf q q * qPochhammerInf (-z) q * qPochhammerInf (-q / z) q = + (∑' k : ℕ, z ^ k * q ^ k.choose 2) + + (∑' m : ℕ, z⁻¹ ^ (m + 1) * q ^ (m + 2).choose 2) := by + have hprod : Summable fun p : ℕ × ℕ => + q ^ p.1.choose 2 * z ^ p.1 * qPochhammerInf (q * q ^ p.1) q * + (q ^ p.2.choose 2 * q ^ p.2 * z⁻¹ ^ p.2 / qPochhammer q q p.2) := + .of_norm (by simpa using Summable.mul_norm hA.summable.norm hB.summable.norm) + have hfubini : qPochhammerInf q q * qPochhammerInf (-z) q * qPochhammerInf (-q / z) q = + ∑' p : ℕ × ℕ, q ^ p.1.choose 2 * z ^ p.1 * qPochhammerInf (q * q ^ p.1) q * + (q ^ p.2.choose 2 * q ^ p.2 * z⁻¹ ^ p.2 / qPochhammer q q p.2) := by + rw [← hA.tsum_eq, ← hB.tsum_eq, hprod.tsum_prod] + simp only [tsum_mul_left, tsum_mul_right] + rw [hfubini, tsum_split_diagonal hprod] + congr 1 + · exact tsum_congr fun k => (hasSum_diagonal_nonneg hq hz' k).tsum_eq + · exact tsum_congr fun l => (hasSum_diagonal_neg hq hz' l).tsum_eq + +/-- The Jacobi triple product identity in the annulus $\|q\| < \|z\| < 1$. -/ +theorem jacobiTripleProduct_annulus {q z : ℂ} (hq : ‖q‖ < 1) + (hzq : ‖q‖ < ‖z‖) (hz : ‖z‖ < 1) (hz' : z ≠ 0) : + qPochhammerInf q q * qPochhammerInf (-z) q * qPochhammerInf (-q / z) q = + (∑' k : ℕ, z ^ k * q ^ k.choose 2) + + (∑' m : ℕ, z⁻¹ ^ (m + 1) * q ^ (m + 2).choose 2) := + jacobiTripleProduct_of_hasSum hq hz' (hasSum_pow_choose_two_mul_pow_mul_qPochhammerInf hq hz) + (euler_second_identity_div hq hzq hz') + +end + +end QSeries diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/JTPKeyIdentity.lean b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/JTPKeyIdentity.lean new file mode 100644 index 0000000000..789dd7362e --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/JTPKeyIdentity.lean @@ -0,0 +1,335 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import Mathlib.Tactic.LinearCombination +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.EulerIdentities + +/-! +# Key identity for the Jacobi triple product + +We prove that for ‖q‖ < 1 and all k ≥ 0: + +$$S_k(q) := \sum_{m=0}^{\infty} \frac{q^{m(m+k)}}{(q;q)_m (q;q)_{m+k}} = \frac{1}{(q;q)_\infty}$$ + +The proof uses a recurrence: + S_k - S_{k+1} = q^{k+1} (S_{k+2} - S_{k+1}) + +This forces all differences to be zero (since S_k → 1/(q;q)_∞), +so all S_k are equal to 1/(q;q)_∞. +-/ + +open Finset Filter +open scoped Topology + +namespace QSeries + +noncomputable section + +/-- The key sum S_k(q) = Σ_{m≥0} q^{m(m+k)} / ((q;q)_m (q;q)_{m+k}). -/ +def keySum (q : ℂ) (k : ℕ) : ℂ := + ∑' m : ℕ, q ^ (m * (m + k)) / (qPochhammer q q m * qPochhammer q q (m + k)) + +/-- The summand of S_k. -/ +def keySummand (q : ℂ) (k : ℕ) (m : ℕ) : ℂ := + q ^ (m * (m + k)) / (qPochhammer q q m * qPochhammer q q (m + k)) + +/-- Unfolds `keySum` as the tsum of `keySummand`. -/ +theorem keySum_eq_tsum (q : ℂ) (k : ℕ) : + keySum q k = ∑' m, keySummand q k m := rfl + +/-- A sequence of positive reals converging to a positive limit is bounded below by a +positive constant. -/ +private theorem exists_pos_le_of_tendsto {f : ℕ → ℝ} {L : ℝ} (hL : 0 < L) + (hf : Tendsto f atTop (𝓝 L)) (hpos : ∀ n, 0 < f n) : ∃ C > 0, ∀ n, C ≤ f n := by + obtain ⟨N, hN⟩ := eventually_atTop.mp (hf.eventually (lt_mem_nhds (half_lt_self hL))) + have hne : (Finset.range (N + 1)).Nonempty := ⟨0, by simp⟩ + refine ⟨min (L / 2) ((Finset.range (N + 1)).inf' hne f), ?_, fun n => ?_⟩ + · exact lt_min (by linarith) ((Finset.lt_inf'_iff hne).2 fun i _ => hpos i) + · rcases le_or_gt n N with h | h + · exact (min_le_right _ _).trans (Finset.inf'_le f (Finset.mem_range.2 (by omega))) + · exact (min_le_left _ _).trans (hN n h.le).le + +/-- The finite q-Pochhammer symbols `(q;q)_n` are bounded away from `0` uniformly in `n`, +since they converge to the nonzero limit `(q;q)_∞`. -/ +theorem exists_pos_le_norm_qPochhammer_self {q : ℂ} (hq : ‖q‖ < 1) : + ∃ C > 0, ∀ n : ℕ, C ≤ ‖qPochhammer q q n‖ := + exists_pos_le_of_tendsto (norm_pos_iff.mpr (qPochhammerInf_ne_zero hq hq)) + (tendsto_qPochhammer hq).norm fun n => norm_pos_iff.mpr (qPochhammer_self_ne_zero hq n) + +/-- The series defining $S_k(q)$ is summable for $\|q\| < 1$. -/ +theorem summable_keySummand {q : ℂ} (hq : ‖q‖ < 1) (k : ℕ) : + Summable (keySummand q k) := by + obtain ⟨C, hC₀, hC⟩ := exists_pos_le_norm_qPochhammer_self hq + have hsq : Summable fun m : ℕ => ‖q‖ ^ (m ^ 2) := + Summable.comp_injective (summable_geometric_of_lt_one (norm_nonneg q) hq) + fun a b h => by simpa using h + refine Summable.of_norm <| (hsq.mul_right (C * C)⁻¹).of_nonneg_of_le + (fun m => norm_nonneg _) fun m => ?_ + have h1 : ‖q‖ ^ (m * (m + k)) ≤ ‖q‖ ^ (m ^ 2) := + pow_le_pow_of_le_one (norm_nonneg q) hq.le (by nlinarith) + have h2 : C * C ≤ ‖qPochhammer q q m‖ * ‖qPochhammer q q (m + k)‖ := + mul_le_mul (hC m) (hC (m + k)) hC₀.le (hC₀.le.trans (hC m)) + rw [keySummand, norm_div, norm_pow, norm_mul, ← div_eq_mul_inv] + exact div_le_div₀ (by positivity) h1 (by positivity) h2 + +/-- As $k \to \infty$, $S_k(q)$ converges to $1/(q;q)_\infty$. -/ +theorem tendsto_keySum {q : ℂ} (hq : ‖q‖ < 1) : + Tendsto (keySum q) atTop (𝓝 (1 / qPochhammerInf q q)) := by + obtain ⟨C, hC₀, hC⟩ := exists_pos_le_norm_qPochhammer_self hq + have hCC : ∀ m k : ℕ, C * C ≤ ‖qPochhammer q q m * qPochhammer q q (m + k)‖ := fun m k => by + rw [norm_mul] + exact mul_le_mul (hC m) (hC (m + k)) hC₀.le (hC₀.le.trans (hC m)) + have hCC₀ : (0 : ℝ) < C * C := mul_pos hC₀ hC₀ + have h_m_zero : Tendsto (fun k => 1 / qPochhammer q q k) atTop (𝓝 (1 / qPochhammerInf q q)) := + tendsto_const_nhds.div (tendsto_qPochhammer hq) (qPochhammerInf_ne_zero hq hq) + have h_sum_zero : Tendsto (fun k => ∑' m : ℕ, (if m = 0 then 0 else + q ^ (m * (m + k)) / (qPochhammer q q m * qPochhammer q q (m + k)))) atTop (𝓝 0) := by + have h_dominated : ∀ m, m ≠ 0 → Tendsto (fun k : ℕ => + q ^ (m * (m + k)) / (qPochhammer q q m * qPochhammer q q (m + k))) atTop (𝓝 0) := by + intro m hm + have h_lim : Tendsto (fun k : ℕ => q ^ (m * (m + k))) atTop (𝓝 0) := + (tendsto_pow_atTop_nhds_zero_of_norm_lt_one hq).comp <| + tendsto_atTop_mono (fun k => by nlinarith [Nat.one_le_iff_ne_zero.mpr hm]) + tendsto_natCast_atTop_atTop + have h_bnd : Tendsto (fun k : ℕ => ‖q ^ (m * (m + k))‖ / (C * C)) atTop (𝓝 0) := by + simpa using h_lim.norm.div_const (C * C) + refine squeeze_zero_norm (fun k => ?_) h_bnd + rw [norm_div] + exact div_le_div_of_nonneg_left (norm_nonneg _) hCC₀ (hCC m k) + have h_dom_conv : Tendsto (fun k => ∑' m : ℕ, (if m = 0 then 0 else + q ^ (m * (m + k)) / (qPochhammer q q m * qPochhammer q q (m + k)))) atTop + (𝓝 (∑' _ : ℕ, (0 : ℂ))) := by + refine tendsto_tsum_of_dominated_convergence + (bound := fun m : ℕ => if m = 0 then 0 else ‖q‖ ^ (m * m) / (C * C)) ?_ ?_ ?_ + · rw [← summable_nat_add_iff 1] + refine Summable.mul_right _ <| Summable.of_nonneg_of_le (fun n => by positivity) + (fun n => ?_) <| summable_geometric_of_lt_one (norm_nonneg q) hq + simpa using pow_le_pow_of_le_one (norm_nonneg q) hq.le (by nlinarith) + · intro m + by_cases hm : m = 0 + · simp only [hm] + exact tendsto_const_nhds + · simpa only [ite_eq_right hm] using h_dominated m hm + · refine Filter.Eventually.of_forall fun k m => ?_ + by_cases hm : m = 0 + · simp [hm] + · simp only [ite_eq_right hm, norm_div] + refine div_le_div₀ (by positivity) ?_ hCC₀ (hCC m k) + rw [norm_pow] + exact pow_le_pow_of_le_one (norm_nonneg q) hq.le (by nlinarith) + simpa using h_dom_conv + convert h_m_zero.add h_sum_zero using 2 <;> norm_num [keySum] + rw [Summable.tsum_eq_add_tsum_ite] + any_goals exact Nat.zero + · norm_num [qPochhammer] + · exact summable_keySummand hq _ + +/-- For `‖q‖ < 1` and `n ≥ 1` the tail factor `1 - qⁿ` is bounded away from zero, +uniformly in `n`, by the constant `1 - ‖q‖`. -/ +theorem one_sub_norm_le_norm_one_sub_pow {q : ℂ} (hq : ‖q‖ < 1) {n : ℕ} (hn : 1 ≤ n) : + 1 - ‖q‖ ≤ ‖1 - q ^ n‖ := by + refine le_trans ?_ (norm_sub_norm_le (1 : ℂ) (q ^ n)) + have h : ‖q‖ ^ n ≤ ‖q‖ ^ 1 := pow_le_pow_of_le_one (norm_nonneg q) hq.le hn + simp only [norm_one, norm_pow, pow_one] at h ⊢ + linarith + +/-- The shifted family `q ^ (m * (m + k)) / ((q;q)_m (q;q)_{m+k+1})` is summable: +it is `keySummand q k` scaled by the uniformly bounded factor `(1 - q ^ (m+k+1))⁻¹`. -/ +theorem summable_pow_div_qPochhammer_succ {q : ℂ} (hq : ‖q‖ < 1) (k : ℕ) : + Summable fun m : ℕ => + q ^ (m * (m + k)) / (qPochhammer q q m * qPochhammer q q (m + k + 1)) := by + have hpos : (0 : ℝ) < 1 - ‖q‖ := by linarith + refine Summable.of_norm <| + ((summable_keySummand hq k).norm.mul_right (1 - ‖q‖)⁻¹).of_nonneg_of_le + (fun m => norm_nonneg _) fun m => ?_ + rw [qPochhammer_succ, ← mul_assoc, ← pow_succ', div_mul_eq_div_div, norm_div, div_eq_mul_inv, + keySummand] + gcongr + exact one_sub_norm_le_norm_one_sub_pow hq (by omega) + +/-- Multiplying the shifted family by the bounded factor `1 - q ^ m` preserves summability. -/ +theorem summable_pow_mul_one_sub_pow_div_qPochhammer {q : ℂ} (hq : ‖q‖ < 1) (k : ℕ) : + Summable fun m : ℕ => + q ^ (m * (m + k)) * (1 - q ^ m) / (qPochhammer q q m * qPochhammer q q (m + k + 1)) := by + refine Summable.of_norm <| + ((summable_pow_div_qPochhammer_succ hq k).norm.mul_right 2).of_nonneg_of_le + (fun m => norm_nonneg _) fun m => ?_ + rw [← div_mul_eq_mul_div, norm_mul] + gcongr + refine le_trans (norm_sub_le _ _) ?_ + have : ‖q‖ ^ m ≤ 1 := pow_le_one₀ (norm_nonneg q) hq.le + simp only [norm_one, norm_pow] + linarith + +/-- The recurrence $S_k - S_{k+1} = q^{k+1}(S_{k+2} - S_{k+1})$ satisfied by $S_k(q)$. -/ +theorem keySum_sub_keySum_succ {q : ℂ} (hq : ‖q‖ < 1) (k : ℕ) : + keySum q k - keySum q (k + 1) = q ^ (k + 1) * (keySum q (k + 2) - keySum q (k + 1)) := by + have h_split : ∑' m : ℕ, (q ^ (m * (m + k)) * (1 - q ^ m - q ^ (m + k + 1))) / + (qPochhammer q q m * qPochhammer q q (m + k + 1)) = + q ^ (k + 1) * (keySum q (k + 2) - keySum q (k + 1)) := by + have h_split : ∑' m : ℕ, q ^ (m * (m + k)) * (1 - q ^ m) / + (qPochhammer q q m * qPochhammer q q (m + k + 1)) = + ∑' m : ℕ, q ^ ((m + 1) * (m + 1 + k)) / + (qPochhammer q q m * qPochhammer q q (m + k + 2)) := by + rw [Summable.tsum_eq_zero_add (summable_pow_mul_one_sub_pow_div_qPochhammer hq k)] + norm_num [qPochhammer_succ] + refine tsum_congr fun m => ?_ + have hne : (1 - q ^ (m + 1)) ≠ 0 := sub_ne_zero_of_ne <| Ne.symm <| + ne_of_apply_ne Norm.norm <| by + norm_num + exact ne_of_lt <| pow_lt_one₀ (by positivity) hq (by positivity) + convert mul_div_mul_right _ _ hne using 1 + first | rfl | ring_nf + rw [show 1 + m + k = m + k + 1 by ring, qPochhammer_succ] + ring + have hsum1 := summable_pow_mul_one_sub_pow_div_qPochhammer hq k + have hsum2 : Summable fun m : ℕ => -(q ^ (m * (m + k)) * q ^ (m + k + 1)) / + (qPochhammer q q m * qPochhammer q q (m + k + 1)) := by + have h : Summable fun m : ℕ => + q ^ (m * (m + k + 1)) / (qPochhammer q q m * qPochhammer q q (m + k + 1)) := by + exact summable_keySummand hq (k + 1) + (convert h.mul_left (-q ^ (k + 1)) using 2; first | rfl | ring_nf) + convert congr_arg₂ (· + ·) h_split + (show ∑' m : ℕ, -(q ^ (m * (m + k)) * q ^ (m + k + 1)) / + (qPochhammer q q m * qPochhammer q q (m + k + 1)) = -q ^ (k + 1) * keySum q (k + 1) + from ?_) using 1 + · rw [← Summable.tsum_add hsum1 hsum2] + congr + ext m + ring + · unfold keySum + ring_nf + norm_num [mul_assoc, mul_comm, mul_left_comm, ← tsum_mul_left] + ring_nf + · unfold keySum + norm_num [div_eq_mul_inv, mul_assoc, mul_comm, mul_left_comm, ← tsum_mul_left] + exact tsum_congr fun n => by ring_nf + rw [← h_split, keySum, keySum, ← Summable.tsum_sub] + · refine tsum_congr fun m => ?_ + rw [div_sub_div, div_eq_div_iff] + · rw [show m + (k + 1) = m + k + 1 by ring, qPochhammer_succ] + ring + · exact mul_ne_zero (mul_ne_zero (qPochhammer_self_ne_zero hq m) + (qPochhammer_self_ne_zero hq (m + k))) + (mul_ne_zero (qPochhammer_self_ne_zero hq m) (qPochhammer_self_ne_zero hq (m + (k + 1)))) + · exact mul_ne_zero (qPochhammer_self_ne_zero hq m) (qPochhammer_self_ne_zero hq (m + k + 1)) + · exact mul_ne_zero (qPochhammer_self_ne_zero hq m) (qPochhammer_self_ne_zero hq (m + k)) + · exact mul_ne_zero (qPochhammer_self_ne_zero hq _) (qPochhammer_self_ne_zero hq _) + · exact summable_keySummand hq k + · exact summable_keySummand hq (k + 1) + +/-- All $S_k(q)$ are equal to $1/(q;q)_\infty$ for $\|q\| < 1$. -/ +theorem keySum_eq_one_div_qPochhammerInf_self {q : ℂ} (hq : ‖q‖ < 1) (k : ℕ) : + keySum q k = 1 / qPochhammerInf q q := by + have h_ind : ∀ k : ℕ, keySum q k - keySum q (k + 1) = 0 := by + intro k + have h_induction : ∀ n : ℕ, ‖keySum q k - keySum q (k + 1)‖ ≤ + ‖q‖ ^ (n * (2 * k + n + 1) / 2) * ‖keySum q (k + n) - keySum q (k + n + 1)‖ := by + intro n + induction n with + | zero => norm_num + | succ n ih => + have h_induction_step : ‖keySum q (k + n) - keySum q (k + n + 1)‖ ≤ + ‖q‖ ^ (k + n + 1) * ‖keySum q (k + n + 1) - keySum q (k + n + 2)‖ := by + rw [keySum_sub_keySum_succ hq (k + n), norm_mul, norm_pow, norm_sub_rev] + convert le_trans ih (mul_le_mul_of_nonneg_left h_induction_step <| by positivity) using 1 + all_goals first | rfl | ring_nf + rw [show (2 + n * 3 + n * k * 2 + n ^ 2 + k * 2) / 2 = + n + k + (n + n * k * 2 + n ^ 2) / 2 + 1 from + Nat.div_eq_of_eq_mul_left zero_lt_two <| by + linarith [Nat.div_mul_cancel (show 2 ∣ n + n * k * 2 + n ^ 2 from + even_iff_two_dvd.mp <| by simp [parity_simps])]] + ring + have h_diff_zero : + Tendsto (fun n => keySum q (k + n) - keySum q (k + n + 1)) atTop (𝓝 0) := by + convert Filter.Tendsto.sub + ((tendsto_keySum hq).comp + (tendsto_atTop_mono (fun n => Nat.le_add_left _ _) tendsto_id)) + ((tendsto_keySum hq).comp + (tendsto_atTop_mono (fun n => Nat.le_succ_of_le <| Nat.le_add_left _ _) tendsto_id)) + using 2 <;> try rfl + norm_num + have h_exp_zero : Tendsto (fun n => ‖q‖ ^ (n * (2 * k + n + 1) / 2)) atTop (𝓝 0) := + (tendsto_pow_atTop_nhds_zero_of_lt_one (norm_nonneg q) hq).comp <| + tendsto_atTop_atTop.mpr fun x => + ⟨2 * x + 1, fun n hn => Nat.le_div_iff_mul_le zero_lt_two |>.2 <| by nlinarith⟩ + exact norm_le_zero_iff.mp (le_of_tendsto_of_tendsto' tendsto_const_nhds + (by simpa using h_exp_zero.mul h_diff_zero.norm) h_induction) + have h_const : ∀ n : ℕ, keySum q n = keySum q 0 := + fun n => Nat.recOn n rfl fun n ih => by linear_combination ih - h_ind n + convert tendsto_nhds_unique (tendsto_const_nhds.congr fun n => (h_const n).symm) + (tendsto_keySum hq) using 1 + exact h_const k + +/-- Telescoping: `(q;q)_∞ = (q;q)_n * (q^{n+1};q)_∞`. -/ +private lemma qPochhammerInf_eq_qPochhammer_mul {q : ℂ} (hq : ‖q‖ < 1) (n : ℕ) : + qPochhammerInf q q = qPochhammer q q n * qPochhammerInf (q * q ^ n) q := by + induction n with + | zero => simp [qPochhammer] + | succ n ih => + rw [ih, qPochhammer_succ, mul_assoc] + congr 1 + rw [qPochhammerInf_eq_one_sub_mul hq] + ring_nf + +/-- `qPochhammerInf (q * q^n) q = (q;q)_∞ / (q;q)_n`. -/ +theorem qPochhammerInf_mul_pow_eq_div {q : ℂ} (hq : ‖q‖ < 1) (n : ℕ) : + qPochhammerInf (q * q ^ n) q = qPochhammerInf q q / qPochhammer q q n := by + rw [eq_div_iff (qPochhammer_self_ne_zero hq n), mul_comm] + exact (qPochhammerInf_eq_qPochhammer_mul hq n).symm + +/-- The sum over $m$ of the $z^k$ cross-terms in the JTP double product has sum +$q^{\binom{k}{2}}$. -/ +theorem hasSum_pow_choose_two_nonneg {q : ℂ} (hq : ‖q‖ < 1) (k : ℕ) : + HasSum (fun m : ℕ => + q ^ (m + k).choose 2 * qPochhammerInf (q * q ^ (m + k)) q * + (q ^ m.choose 2 * q ^ m / qPochhammer q q m)) + (q ^ k.choose 2) := by + have h_base : HasSum (fun m : ℕ => + q ^ (m * (m + k)) / (qPochhammer q q m * qPochhammer q q (m + k))) + (1 / qPochhammerInf q q) := by + convert keySum_eq_one_div_qPochhammerInf_self hq k using 1 + exact ⟨fun h => h.tsum_eq, fun h => h ▸ (summable_keySummand hq k).hasSum⟩ + have h_scaled : HasSum (fun m : ℕ => q ^ (k.choose 2 + m * (m + k)) * qPochhammerInf q q / + (qPochhammer q q (m + k) * qPochhammer q q m)) (q ^ k.choose 2) := by + convert h_base.mul_left (q ^ k.choose 2 * qPochhammerInf q q) using 1 <;> + first | rfl | ring_nf + · ac_rfl + · rw [mul_assoc, mul_inv_cancel₀ (qPochhammerInf_ne_zero hq hq), mul_one] + have h_sum : HasSum (fun m : ℕ => + q ^ ((m + k).choose 2 + m.choose 2 + m) * qPochhammerInf q q / + (qPochhammer q q (m + k) * qPochhammer q q m)) (q ^ k.choose 2) := by + convert h_scaled using 3 + rw [Nat.choose_two_add_choose_two] + convert h_sum using 2 + push_cast [qPochhammerInf_mul_pow_eq_div hq] + ring + +/-- The sum over $n$ of the $z^{-(l+1)}$ cross-terms in the JTP double product has sum +$q^{\binom{l+2}{2}}$. -/ +theorem hasSum_pow_choose_two_neg {q : ℂ} (hq : ‖q‖ < 1) (l : ℕ) : + HasSum (fun n : ℕ => + q ^ n.choose 2 * qPochhammerInf (q * q ^ n) q * + (q ^ (n + (l + 1)).choose 2 * q ^ (n + (l + 1)) / qPochhammer q q (n + (l + 1)))) + (q ^ (l + 2).choose 2) := by + have h_simp : HasSum (fun n : ℕ => + q ^ (n.choose 2 + (n + (l + 1)).choose 2 + (n + (l + 1))) * qPochhammerInf q q / + (qPochhammer q q n * qPochhammer q q (n + (l + 1)))) (q ^ (l + 2).choose 2) := by + convert HasSum.mul_left (q ^ (l + 2).choose 2 * qPochhammerInf q q) + (summable_keySummand hq (l + 1)).hasSum using 1 <;> try rfl + · ext n + rw [keySummand, Nat.choose_two_add_choose_two'] + ring + · rw [show (∑' n : ℕ, keySummand q (l + 1) n) = 1 / qPochhammerInf q q from ?_] + · rw [mul_assoc, mul_one_div_cancel (qPochhammerInf_ne_zero hq hq), mul_one] + · convert keySum_eq_one_div_qPochhammerInf_self hq (l + 1) using 1 + exact (keySum_eq_tsum q (l + 1)).symm + convert h_simp using 2 + rw [qPochhammerInf_mul_pow_eq_div hq] + ring_nf + +end + +end QSeries diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/JacobiTripleProduct.lean b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/JacobiTripleProduct.lean new file mode 100644 index 0000000000..b057dbfeda --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/JacobiTripleProduct.lean @@ -0,0 +1,286 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.JTPCore + +/-! +# Jacobi triple product identity + +The **Jacobi triple product identity** states that for $\|q\| < 1$ and $z \neq 0$: +$$(q;q)_\infty \cdot (-z;q)_\infty \cdot (-q/z;q)_\infty + = \sum_{k \in \mathbb{Z}} z^k \, q^{k(k-1)/2}.$$ + +## Proof strategy + +The proof uses: +1. Both sides satisfy the functional equation $H(qz) = H(z)/z$. +2. The Euler identities (first and second) provide series expansions. +3. The Cauchy identity (`hasSum_qPochhammer_div_mul_pow`) relates the product to sums. +4. Extension from the annulus ‖q‖ < ‖z‖ < 1 to the full punctured disk. + +## Main results + +* `QSeries.jacobiTripleProduct` — the Jacobi triple product identity. +-/ + +open Finset Filter +open scoped Topology + +namespace QSeries + +noncomputable section + + +/-- For `‖q‖ < 1` the q-Pochhammer factor `1 - q ^ (n + 1)` is nonzero. -/ +private theorem one_sub_pow_ne_zero {q : ℂ} (hq : ‖q‖ < 1) (n : ℕ) : + (1 : ℂ) - q ^ (n + 1) ≠ 0 := by + intro h + have h1 : ‖q‖ ^ (n + 1) = 1 := by + rw [← norm_pow, show q ^ (n + 1) = 1 from by linear_combination -h, norm_one] + have h2 : ‖q‖ ^ (n + 1) < 1 := pow_lt_one₀ (norm_nonneg q) hq (Nat.succ_ne_zero n) + linarith + +/-- Summability of the non-negative part $\sum_{k \geq 0} z^k q^{\binom{k}{2}}$. -/ +theorem summable_pow_mul_pow_choose_two {q z : ℂ} (hq : ‖q‖ < 1) (hz : ‖z‖ < 1) : + Summable (fun k : ℕ => z ^ k * q ^ k.choose 2) := by + refine Summable.of_norm ?_ + simp only [norm_mul, norm_pow] + exact Summable.of_nonneg_of_le (fun n => by positivity) + (fun n => mul_le_of_le_one_right (by positivity) (pow_le_one₀ (by positivity) hq.le)) + (summable_geometric_of_lt_one (by positivity) hz) + +/-- Summability of the negative-index part $\sum_{m \geq 0} z^{-(m+1)} q^{\binom{m+2}{2}}$ +for $\|q\| < 1$ and $z \neq 0$. -/ +theorem summable_inv_pow_mul_pow_choose_two {q z : ℂ} (hq : ‖q‖ < 1) : + Summable (fun m : ℕ => (z⁻¹) ^ (m + 1) * q ^ (m + 2).choose 2) := by + have hr : (0 : ℝ) < ‖q‖ + (1 - ‖q‖) / 2 := by linarith [norm_nonneg q] + refine summable_of_ratio_norm_eventually_le (r := ‖q‖ + (1 - ‖q‖) / 2) (by linarith) ?_ + have h0 : Tendsto (fun n : ℕ => ‖z⁻¹‖ * ‖q‖ ^ (n + 2)) atTop (𝓝 0) := by + simpa using tendsto_const_nhds.mul + ((tendsto_pow_atTop_nhds_zero_of_lt_one (norm_nonneg q) hq).comp + (tendsto_add_atTop_nat 2)) + filter_upwards [h0.eventually (gt_mem_nhds hr)] with n hn + have hstep : (n + 1 + 2).choose 2 = (n + 2).choose 2 + (n + 2) := Nat.choose_two_succ (n + 2) + calc ‖z⁻¹ ^ (n + 1 + 1) * q ^ (n + 1 + 2).choose 2‖ + = ‖z⁻¹ ^ (n + 1) * q ^ (n + 2).choose 2‖ * (‖z⁻¹‖ * ‖q‖ ^ (n + 2)) := by + rw [hstep, pow_add] + simp only [norm_mul, norm_pow, pow_succ] + ring + _ ≤ ‖z⁻¹ ^ (n + 1) * q ^ (n + 2).choose 2‖ * (‖q‖ + (1 - ‖q‖) / 2) := + mul_le_mul_of_nonneg_left hn.le (norm_nonneg _) + _ = _ := by ring + +/-- The Jacobi triple product function +$f(z) = (q;q)_\infty \cdot (-z;q)_\infty \cdot (-q/z;q)_\infty$. -/ +def jacobiProd (q z : ℂ) : ℂ := + qPochhammerInf q q * qPochhammerInf (-z) q * qPochhammerInf (-q / z) q + +/-- The bilateral Jacobi series (non-negative part). -/ +def jacobiBilateralPos (q z : ℂ) : ℂ := + ∑' k : ℕ, z ^ k * q ^ k.choose 2 + +/-- The bilateral Jacobi series (negative part). +For $k = -(m+1)$ with $m \geq 0$, the exponent is $\binom{m+2}{2} = (m+1)(m+2)/2$. -/ +def jacobiBilateralNeg (q z : ℂ) : ℂ := + ∑' m : ℕ, (z⁻¹) ^ (m + 1) * q ^ (m + 2).choose 2 + +/-- The full bilateral Jacobi series. -/ +def jacobiBilateral (q z : ℂ) : ℂ := + jacobiBilateralPos q z + jacobiBilateralNeg q z + +/-- **Telescoping for $(-z;q)_\infty$**: $(-z;q)_\infty = (1+z)(-zq;q)_\infty$. -/ +theorem qPochhammerInf_neg_eq_one_add_mul {z q : ℂ} (hq : ‖q‖ < 1) : + qPochhammerInf (-z) q = (1 + z) * qPochhammerInf (-(z * q)) q := by + have h := qPochhammerInf_eq_one_sub_mul (z := -z) hq + rw [show (1 : ℂ) - -z = 1 + z from by ring, + show -z * q = -(z * q) from by ring] at h + exact h + +/-- The product satisfies $f(qz) = f(z)/z$ when $q \neq 0$ and $z \neq 0$. -/ +theorem jacobiProd_mul_eq_div {q z : ℂ} (hq : ‖q‖ < 1) (hq' : q ≠ 0) (hz : z ≠ 0) : + jacobiProd q (q * z) = jacobiProd q z / z := by + unfold jacobiProd + have hqz : q * z ≠ 0 := mul_ne_zero hq' hz + have h1 := qPochhammerInf_neg_eq_one_add_mul (z := z) hq + have h2 := qPochhammerInf_neg_eq_one_add_mul (z := z⁻¹) hq + rw [show -(q * z) = -(z * q) from by ring] + rw [show -q / (q * z) = -(z⁻¹) from by field_simp] + rw [show -(z⁻¹ * q) = -q / z from by field_simp] at h2 + rw [h1, h2] + have hzinv : z * z⁻¹ = 1 := mul_inv_cancel₀ hz + field_simp + ring + +/-- The bilateral Jacobi series satisfies the same functional equation $f(qz) = f(z)/z$ +as the triple product. -/ +theorem jacobiBilateral_mul_eq_div {q z : ℂ} (hq : ‖q‖ < 1) (hq' : q ≠ 0) (hz : ‖z‖ < 1) + (hz' : z ≠ 0) : + jacobiBilateral q (q * z) = jacobiBilateral q z / z := by + rw [eq_div_iff hz', mul_comm] + have h_pos : z * jacobiBilateralPos q (q * z) = + ∑' k : ℕ, if k = 0 then 0 else z ^ k * q ^ k.choose 2 := by + rw [eq_comm, Summable.tsum_eq_zero_add] + · simp +decide only [↓reduceIte, Nat.add_eq_zero_iff, and_false, pow_succ', + Nat.choose_succ_succ, Nat.choose_one_right, Nat.succ_eq_add_one, Nat.reduceAdd, + mul_assoc, tsum_mul_left, zero_add, mul_eq_mul_left_iff] + exact Or.inl (tsum_congr fun n => by ring) + · have h_summable : Summable (fun k : ℕ => z ^ k * q ^ k.choose 2) := + summable_pow_mul_pow_choose_two hq hz + rw [← summable_nat_add_iff 1] at *; aesop + have h_neg : z * jacobiBilateralNeg q (q * z) = + ∑' m : ℕ, z ^ (-m : ℤ) * q ^ (m + 1).choose 2 := by + unfold jacobiBilateralNeg + simp +decide [pow_add, mul_assoc, mul_comm, tsum_mul_left] + simp +decide [Nat.choose_succ_succ] + simp +decide [add_comm, add_left_comm, add_assoc, pow_add, mul_left_comm, tsum_mul_left, + hq', hz'] + simp +decide [mul_pow, mul_assoc, hq'] + convert congr_arg₂ (· + ·) h_pos h_neg using 1 + · rw [← mul_add, jacobiBilateral] + · unfold jacobiBilateral jacobiBilateralPos jacobiBilateralNeg + rw [Summable.tsum_eq_zero_add] + · rw [eq_comm, Summable.tsum_eq_zero_add] + · norm_num [Nat.choose_succ_succ, pow_succ'] + rw [eq_comm, Summable.tsum_eq_zero_add] + · norm_num [add_comm, add_left_comm, add_assoc, mul_assoc, mul_comm, mul_left_comm, + tsum_mul_left, tsum_mul_right] + rw [eq_comm, Summable.tsum_eq_zero_add] + · norm_num [Nat.choose_succ_succ, pow_succ', mul_assoc, mul_comm, mul_left_comm, + tsum_mul_left, tsum_mul_right] + ring_nf + · have := summable_inv_pow_mul_pow_choose_two (z := z) hq + rw [← summable_nat_add_iff 1] + (convert this using 2; try rfl) + norm_num [Nat.choose_succ_succ, pow_succ'] + ring + · refine Summable.of_norm ?_ + norm_num [pow_add, pow_mul] + refine Summable.of_nonneg_of_le (fun n => by positivity) (fun n => ?_) + (summable_geometric_of_lt_one (by positivity) hz) + exact le_trans (mul_le_of_le_one_right (by positivity) + ((mul_le_of_le_one_left (pow_nonneg (by positivity) _) + (pow_le_one₀ (by positivity) hq.le)).trans (pow_le_one₀ (by positivity) hq.le))) + (mul_le_of_le_one_left (by positivity) hz.le) + · rw [← summable_nat_add_iff 1] + exact (summable_pow_mul_pow_choose_two hq hz).comp_injective Nat.succ_injective + · exact summable_pow_mul_pow_choose_two hq hz + +/-- Summability of the Euler second series $\sum_{n \geq 0} q^{\binom{n}{2}} z^n / (q;q)_n$ +for all $z$ when $\|q\| < 1$. -/ +theorem summable_euler_second' {q z : ℂ} (hq : ‖q‖ < 1) : + Summable (fun n : ℕ => q ^ n.choose 2 * z ^ n / qPochhammer q q n) := by + have hr : (0 : ℝ) < ‖q‖ + (1 - ‖q‖) / 2 := by linarith [norm_nonneg q] + refine summable_of_ratio_norm_eventually_le (r := ‖q‖ + (1 - ‖q‖) / 2) (by linarith) ?_ + have h0 : Tendsto (fun n : ℕ => ‖q‖ ^ n * ‖z‖ / ‖1 - q ^ (n + 1)‖) atTop (𝓝 0) := by + simpa [Pi.div_def] using Tendsto.div + ((tendsto_pow_atTop_nhds_zero_of_lt_one (norm_nonneg q) hq).mul_const ‖z‖) + (((tendsto_pow_atTop_nhds_zero_of_norm_lt_one hq).comp + (tendsto_add_atTop_nat 1)).const_sub 1).norm (by norm_num) + filter_upwards [h0.eventually (gt_mem_nhds hr)] with n hn + have hstep : (n + 1).choose 2 = n.choose 2 + n := Nat.choose_two_succ n + have hpoch : qPochhammer q q (n + 1) = qPochhammer q q n * (1 - q ^ (n + 1)) := by + rw [qPochhammer_succ]; ring + calc ‖q ^ (n + 1).choose 2 * z ^ (n + 1) / qPochhammer q q (n + 1)‖ + = ‖q ^ n.choose 2 * z ^ n / qPochhammer q q n‖ * (‖q‖ ^ n * ‖z‖ / ‖1 - q ^ (n + 1)‖) := by + rw [hstep, hpoch, pow_add] + simp only [norm_mul, norm_div, norm_pow, pow_succ] + ring + _ ≤ ‖q ^ n.choose 2 * z ^ n / qPochhammer q q n‖ * (‖q‖ + (1 - ‖q‖) / 2) := + mul_le_mul_of_nonneg_left hn.le (norm_nonneg _) + _ = _ := by ring + +/-- The Euler second series satisfies the recursion $E(z) = (1+z) \cdot E(qz)$. -/ +theorem tsum_euler_second_eq_one_add_mul {q z : ℂ} (hq : ‖q‖ < 1) : + (∑' n : ℕ, q ^ n.choose 2 * z ^ n / qPochhammer q q n) = + (1 + z) * (∑' n : ℕ, q ^ n.choose 2 * (z * q) ^ n / qPochhammer q q n) := by + have h_series : ∀ n : ℕ, (q ^ n.choose 2 * z ^ n / qPochhammer q q n) - + (q ^ n.choose 2 * (z * q) ^ n / qPochhammer q q n) = + z * (q ^ (n - 1).choose 2 * (z * q) ^ (n - 1) / qPochhammer q q (n - 1)) * + (if n = 0 then 0 else 1) := by + rintro (_ | m) + · simp + · have hne := one_sub_pow_ne_zero hq m + have hpne : qPochhammer q q m ≠ 0 := qPochhammer_self_ne_zero hq m + have hpoch : qPochhammer q q (m + 1) = qPochhammer q q m * (1 - q ^ (m + 1)) := by + rw [qPochhammer_succ]; ring + rw [ite_eq_right (Nat.succ_ne_zero m), mul_one, Nat.add_sub_cancel, Nat.choose_two_succ, + hpoch] + field_simp + ring + have h_series_sum : ∑' n : ℕ, (q ^ n.choose 2 * z ^ n / qPochhammer q q n) - + ∑' n : ℕ, (q ^ n.choose 2 * (z * q) ^ n / qPochhammer q q n) = + z * ∑' n : ℕ, (q ^ n.choose 2 * (z * q) ^ n / qPochhammer q q n) := by + rw [← Summable.tsum_sub, tsum_congr h_series] + · rw [← tsum_mul_left] + rw [Summable.tsum_eq_zero_add] + · aesop + · rw [← summable_nat_add_iff 1] + convert Summable.mul_left z + ((summable_euler_second' hq).comp_injective Nat.cast_injective) using 2 <;> try rfl + aesop + · exact summable_euler_second' hq + · exact summable_euler_second' hq + linear_combination h_series_sum + +/-- The finite telescoping $(-z;q)_\infty = \prod_{k simp + | succ N ih => + rw [ih, Finset.prod_range_succ, qPochhammerInf_eq_one_sub_mul (z := -(z * q ^ N)) hq, + show -(z * q ^ N) * q = -(z * q ^ (N + 1)) from by ring] + ring + +/-- Euler second identity for all $z$: the series $\sum_{n \geq 0} q^{\binom{n}{2}} z^n / (q;q)_n$ +has sum $(-z;q)_\infty$. -/ +theorem euler_second_identity' {q z : ℂ} (hq : ‖q‖ < 1) : + HasSum (fun n : ℕ => q ^ n.choose 2 * z ^ n / qPochhammer q q n) + (qPochhammerInf (-z) q) := by + have h_ind : ∀ N : ℕ, (∑' n : ℕ, q ^ n.choose 2 * z ^ n / qPochhammer q q n) = + (∏ k ∈ Finset.range N, (1 + z * q ^ k)) * + ∑' n : ℕ, q ^ n.choose 2 * (z * q ^ N) ^ n / qPochhammer q q n := by + intro N + induction N with + | zero => aesop + | succ N ih => + have h_rec : (∑' n : ℕ, q ^ n.choose 2 * (z * q ^ N) ^ n / qPochhammer q q n) = + (1 + z * q ^ N) * + ∑' n : ℕ, q ^ n.choose 2 * (z * q ^ (N + 1)) ^ n / qPochhammer q q n := by + convert tsum_euler_second_eq_one_add_mul hq using 1; ring_nf + rw [Finset.prod_range_succ, ih, h_rec, mul_assoc] + obtain ⟨N, hN⟩ : ∃ N : ℕ, ‖z * q ^ N‖ < 1 := by + have h_lim : Tendsto (fun N : ℕ => ‖z * q ^ N‖) atTop (𝓝 0) := by + simpa using tendsto_const_nhds.mul (tendsto_pow_atTop_nhds_zero_of_lt_one (norm_nonneg q) hq) + exact (h_lim.eventually (gt_mem_nhds zero_lt_one)).exists + have h_tsum : (∑' n : ℕ, q ^ n.choose 2 * z ^ n / qPochhammer q q n) = + (∏ k ∈ Finset.range N, (1 + z * q ^ k)) * qPochhammerInf (-(z * q ^ N)) q := by + rw [h_ind N, (euler_second_identity hq hN).tsum_eq] + rw [(qPochhammerInf_neg_eq_prod_mul hq N).trans h_tsum.symm] + exact (summable_euler_second' hq).hasSum + +/-- Euler second identity evaluated at $q/z$: the series +$\sum_{m \geq 0} q^{\binom{m}{2}+m} z^{-m} / (q;q)_m$ has sum $(-q/z;q)_\infty$. -/ +theorem euler_second_identity_div' {q z : ℂ} (hq : ‖q‖ < 1) : + HasSum (fun m : ℕ => q ^ m.choose 2 * q ^ m * z⁻¹ ^ m / qPochhammer q q m) + (qPochhammerInf (-q / z) q) := by + convert euler_second_identity' hq |> HasSum.congr_fun <| fun n => ?_ using 1 + rotate_left + exacts [q * z⁻¹, by ring, by ring_nf] + +/-- **Jacobi triple product identity**: $(q;q)_\infty (-z;q)_\infty (-q/z;q)_\infty$ equals the +bilateral theta series $\sum_{k \in \mathbb{Z}} z^k q^{k(k-1)/2}$ for $\|q\| < 1$, $\|z\| < 1$, +and $z \neq 0$. -/ +theorem jacobiTripleProduct {q z : ℂ} (hq : ‖q‖ < 1) (hz : ‖z‖ < 1) (hz' : z ≠ 0) : + jacobiProd q z = jacobiBilateral q z := by + unfold jacobiProd jacobiBilateral jacobiBilateralPos jacobiBilateralNeg + exact jacobiTripleProduct_of_hasSum hq hz' + (hasSum_pow_choose_two_mul_pow_mul_qPochhammerInf hq hz) + (euler_second_identity_div' (z := z) hq) + +end + +end QSeries diff --git a/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/PentagonalNumber.lean b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/PentagonalNumber.lean new file mode 100644 index 0000000000..695ab15906 --- /dev/null +++ b/LeanPool/PentagonalNumberTheoremAnalytic/QSeries/PentagonalNumber.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Jonathan Conrad, Paula Muermann, Maryna Viazovska. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jonathan Conrad, Paula Muermann, Maryna Viazovska +-/ +import LeanPool.PentagonalNumberTheoremAnalytic.QSeries.JacobiTripleProduct + +/-! +# Euler's pentagonal number theorem + +**Euler's pentagonal number theorem** states that for $\|q\| < 1$: +$$\prod_{n=1}^{\infty} (1 - q^n) = \sum_{k \in \mathbb{Z}} (-1)^k q^{k(3k-1)/2}$$ + +This follows from the Jacobi triple product by the substitution +$q \to q^3$, $z \to q$, using the index partition +$\{3n\} \cup \{3n-2\} \cup \{3n-1\} = \mathbb{Z}_{\geq 1}$. + +## Main definitions + +* `QSeries.pentagonal` — the generalized pentagonal number $\omega(k) = k(3k-1)/2$. + +## Main results + +* `QSeries.euler_pentagonal_number` — the pentagonal number theorem. +-/ + +open Finset Filter +open scoped Topology + +namespace QSeries + +noncomputable section + +/-- The $k$-th generalized pentagonal number $\omega(k) = k(3k-1)/2$, +well-defined for $k \in \mathbb{Z}$ (the product $k(3k-1)$ is always even). -/ +def pentagonal (k : ℤ) : ℕ := + (k * (3 * k - 1) / 2).toNat + +/-- At a nonnegative index, $\omega(k) = k + 3\binom{k}{2}$. -/ +private theorem pentagonal_natCast (k : ℕ) : pentagonal (k : ℤ) = k + k.choose 2 * 3 := by + have key : (k : ℤ) * (3 * (k : ℤ) - 1) = 2 * ((k + k.choose 2 * 3 : ℕ) : ℤ) := by + induction k with + | zero => norm_num + | succ n ih => + simp only [Nat.cast_succ, Nat.choose_succ_succ, Nat.choose_one_right] at * + push_cast at * + linarith + unfold pentagonal + rw [key] + omega + +/-- At a negative index, $\omega(-(m+1)) + (m+1) = 3\binom{m+2}{2}$. -/ +private theorem pentagonal_neg_succ_add (m : ℕ) : + pentagonal (-(m + 1) : ℤ) + (m + 1) = (m + 2).choose 2 * 3 := by + have key : (-((m : ℤ) + 1)) * (3 * (-((m : ℤ) + 1)) - 1) = + 2 * (((m + 2).choose 2 * 3 : ℤ) - ((m : ℤ) + 1)) := by + induction m with + | zero => norm_num + | succ n ih => + simp only [Nat.cast_succ, Nat.choose_succ_succ, Nat.choose_one_right, + Nat.choose_zero_right] at * + push_cast at * + linarith + have hle : (m : ℤ) + 1 ≤ ((m + 2).choose 2 * 3 : ℤ) := by + have h : (m + 2).choose 2 = (m + 1) + (m + 1).choose 2 := by + rw [Nat.choose_succ_succ, Nat.choose_one_right] + have : (m + 1 : ℕ) ≤ (m + 2).choose 2 * 3 := by omega + exact_mod_cast this + unfold pentagonal + rw [key] + omega + +/-- $\omega(-(m+1)) \neq 0$: the negative pentagonal numbers are all positive. -/ +private theorem pentagonal_neg_succ_ne_zero (m : ℕ) : pentagonal (-(m + 1) : ℤ) ≠ 0 := by + have hp := pentagonal_neg_succ_add m + have h : (m + 2).choose 2 = (m + 1) + (m + 1).choose 2 := by + rw [Nat.choose_succ_succ, Nat.choose_one_right] + omega + +/-- Partial products of an absolutely convergent product converge to the product. -/ +private theorem tendsto_prod_one_add {f : ℕ → ℂ} (hf : Summable fun k => ‖f k‖) : + Tendsto (fun n => ∏ k ∈ Finset.range n, (1 + f k)) atTop (𝓝 (∏' k : ℕ, (1 + f k))) := + (multipliable_one_add_of_summable hf).hasProd.tendsto_prod_nat + +/-- An absolutely convergent product over `ℕ` splits into its three residue classes mod `3`. -/ +private theorem tprod_one_add_eq_mul_mul {f : ℕ → ℂ} (hf : Summable fun k => ‖f k‖) : + ∏' k : ℕ, (1 + f k) = (∏' k : ℕ, (1 + f (3 * k))) * (∏' k : ℕ, (1 + f (3 * k + 1))) * + ∏' k : ℕ, (1 + f (3 * k + 2)) := by + have hpart : ∀ n : ℕ, ∏ k ∈ Finset.range (3 * n), (1 + f k) = + (∏ k ∈ Finset.range n, (1 + f (3 * k))) * (∏ k ∈ Finset.range n, (1 + f (3 * k + 1))) * + ∏ k ∈ Finset.range n, (1 + f (3 * k + 2)) := by + intro n + induction n with + | zero => simp + | succ n ih => simp only [Nat.mul_succ, Finset.prod_range_succ] at *; rw [ih]; ring + have hL : Tendsto (fun n => ∏ k ∈ Finset.range (3 * n), (1 + f k)) atTop + (𝓝 (∏' k : ℕ, (1 + f k))) := by + simpa [Function.comp_def] using + (tendsto_prod_one_add hf).comp (tendsto_id.nsmul_atTop (three_pos (α := ℕ))) + have hR := ((tendsto_prod_one_add (f := fun k => f (3 * k)) + (hf.comp_injective fun a b h => by omega)).mul + (tendsto_prod_one_add (f := fun k => f (3 * k + 1)) + (hf.comp_injective fun a b h => by omega))).mul + (tendsto_prod_one_add (f := fun k => f (3 * k + 2)) + (hf.comp_injective fun a b h => by omega)) + exact tendsto_nhds_unique hL (hR.congr fun n => (hpart n).symm) + +/-- **Euler's pentagonal number theorem**: for $\|q\| < 1$, the infinite product $(q;q)_\infty$ +equals the bilateral series $\sum_{k \in \mathbb{Z}} (-1)^k q^{\omega(k)}$ over generalized +pentagonal numbers $\omega(k) = k(3k-1)/2$, written as two one-sided sums. -/ +theorem euler_pentagonal_number {q : ℂ} (hq : ‖q‖ < 1) : + qPochhammerInf q q = + (∑' k : ℕ, (-1 : ℂ) ^ k * q ^ pentagonal k) + + ∑' k : ℕ, (-1 : ℂ) ^ (k + 1) * q ^ pentagonal (-(↑k + 1)) := by + by_cases hq0 : q = 0 + · subst hq0 + have h1 : ∀ k : ℕ, k ≠ 0 → (-1 : ℂ) ^ k * (0 : ℂ) ^ pentagonal (k : ℤ) = 0 := fun k hk => by + rw [pentagonal_natCast, zero_pow (by omega), mul_zero] + have h2 : ∀ k : ℕ, (-1 : ℂ) ^ (k + 1) * (0 : ℂ) ^ pentagonal (-(↑k + 1)) = 0 := fun k => by + rw [zero_pow (pentagonal_neg_succ_ne_zero k), mul_zero] + rw [tsum_eq_single 0 h1] + simp only [h2, tsum_zero, add_zero] + simp [qPochhammerInf, pentagonal] + · have h3 : ‖q ^ 3‖ < 1 := by simpa using pow_lt_one₀ (norm_nonneg q) hq (by norm_num) + have hzq : ‖q ^ 3‖ < ‖-q‖ := by + simpa using pow_lt_self_of_lt_one₀ (norm_pos_iff.mpr hq0) hq (by norm_num : (1 : ℕ) < 3) + have hf : Summable fun k : ℕ => ‖-q ^ (k + 1)‖ := by + simpa using (summable_nat_add_iff 1).2 (summable_geometric_of_lt_one (norm_nonneg q) hq) + have hprod : qPochhammerInf q q = qPochhammerInf (q ^ 3) (q ^ 3) * + qPochhammerInf (-(-q)) (q ^ 3) * qPochhammerInf (-(q ^ 3) / -q) (q ^ 3) := by + have hd : (-(q ^ 3) / -q : ℂ) = q ^ 2 := by field_simp + have e0 : qPochhammerInf q q = ∏' k : ℕ, (1 + -q ^ (k + 1)) := + tprod_congr fun k => by ring + have e1 : qPochhammerInf (-(-q)) (q ^ 3) = ∏' k : ℕ, (1 + -q ^ (3 * k + 1)) := + tprod_congr fun k => by rw [neg_neg]; ring + have e2 : qPochhammerInf (q ^ 2) (q ^ 3) = ∏' k : ℕ, (1 + -q ^ (3 * k + 2)) := + tprod_congr fun k => by ring + have e3 : qPochhammerInf (q ^ 3) (q ^ 3) = ∏' k : ℕ, (1 + -q ^ (3 * k + 3)) := + tprod_congr fun k => by ring + rw [hd, e0, e1, e2, e3, tprod_one_add_eq_mul_mul hf] + ring + have hsum1 : ∑' k : ℕ, (-1 : ℂ) ^ k * q ^ pentagonal (k : ℤ) = + ∑' k : ℕ, (-q) ^ k * (q ^ 3) ^ k.choose 2 := + tsum_congr fun k => by rw [pentagonal_natCast, neg_pow]; ring + have hsum2 : ∑' k : ℕ, (-1 : ℂ) ^ (k + 1) * q ^ pentagonal (-(↑k + 1)) = + ∑' m : ℕ, (-q : ℂ)⁻¹ ^ (m + 1) * (q ^ 3) ^ (m + 2).choose 2 := by + refine tsum_congr fun m => ?_ + have hp := pentagonal_neg_succ_add m + have key : (q ^ 3) ^ (m + 2).choose 2 = q ^ pentagonal (-(↑m + 1)) * q ^ (m + 1) := by + rw [← pow_mul, ← pow_add] + congr 1 + omega + rw [key, show (-q : ℂ)⁻¹ ^ (m + 1) * (q ^ pentagonal (-(↑m + 1)) * q ^ (m + 1)) = + ((-q : ℂ)⁻¹ * q) ^ (m + 1) * q ^ pentagonal (-(↑m + 1)) from by rw [mul_pow]; ring, + show ((-q : ℂ)⁻¹ * q) = -1 from by field_simp] + rw [hprod, hsum1, hsum2] + exact jacobiTripleProduct_annulus h3 hzq (by simpa using hq) (neg_ne_zero.mpr hq0) + +end + +end QSeries diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index 15ae128455..a051985de1 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -9284,3 +9284,86 @@ projects: - cycle-decompositions msc: - "05C45" + - slug: pentagonal-number-theorem-analytic + title: Euler's pentagonal number theorem, two independent proofs, and the Jacobi triple product + summary: >- + Two independent proofs of Euler's pentagonal number theorem that share no lemmas, so each + confirms the result on its own. The primary development is combinatorial: Franklin's sign-reversing involution on partitions into distinct parts, + giving p_e(n) - p_o(n) = (-1)^|k| when n is the generalized pentagonal number k(3k-1)/2 + and 0 otherwise, stated under a single integer index, together with the identification of + that signed count with the coefficient of X^n in the truncated product over ℤ⟦X⟧. It + builds on Mathlib's Nat.Partition.genFun. The second route develops q-Pochhammer symbols, + the Gaussian binomial coefficient, Euler's two identities and the Cauchy identity, proves + the Jacobi triple product both as a formal power series identity in + (LaurentPolynomial ℂ)⟦X⟧ and analytically over ℂ for ‖q‖ < 1, and reaches the same + theorem for the infinite product by specialization. The Lean proofs in both routes were largely + generated by Aristotle; the Franklin route additionally has an author-written blueprint + that the formalization follows lemma by lemma, and carries substantially more manual + intervention and review, whereas the q-series route is machine-generated blueprint and + all. The Franklin route and the analytic pentagonal number theorem overlap the pooled + `pentagonal-number-theorem` development, which states its analytic form over RCLike fields + rather than only over the complex numbers; the q-Pochhammer, Gaussian binomial and Euler + identity definitions overlap arXiv:2607.01544. The project's distinct contribution is the + complex-analytic layer: an analytic Jacobi triple product over the complex numbers for + norm q < 1, its extension to the punctured disc, the analytic Cauchy identity, and the + summability and locally-uniform-convergence machinery they require. Neither the pooled + entry nor the non-archimedean development of arXiv:2607.01544 covers that setting. + branch: number theory and enumerative combinatorics + entry_module: LeanPool.PentagonalNumberTheoremAnalytic + authors: + - Jonathan Conrad + - Paula Muermann + - Maryna Viazovska + source: + title: Pentagonal Number Theorem + authors: + - Jonathan Conrad + - Paula Muermann + - Maryna Viazovska + url: https://viazovska.github.io/PentagonalNumberTheorem + github_repo: viazovska/PentagonalNumberTheorem + revision: "5c3413265fcb44f74e67ebb5abddcac4b82e611b" + license: Apache-2.0 + status: verified + provenance: AI + main_declarations: + - PentagonalNumberTheorem.Franklin.euler_pentagonal_number_theorem_packaged + main_results: + - declaration: PentagonalNumberTheorem.Franklin.euler_pentagonal_number_theorem_packaged + informal: >- + The primary result. For every n, either n is a generalized pentagonal number + k(3k-1)/2 for some integer k, in which case the number of partitions of n into an + even number of distinct parts exceeds the number with an odd number of distinct + parts by exactly (-1)^|k|; or n is not of that form, in which case the two counts + are equal. Proved by Franklin's sign-reversing involution. + - declaration: PentagonalNumberTheorem.Franklin.coeff_prod_eq_pe_sub_po + informal: >- + The coefficient of X^n in the truncated product ∏_{k=1}^{n}(1 - X^k) over ℤ⟦X⟧ equals + p_e(n) - p_o(n), the signed count of partitions of n into distinct parts. Truncating + at n is harmless because the omitted factors are ≡ 1 mod X^{n+1}. + - declaration: QSeries.jacobiTripleProduct + informal: >- + For ‖q‖ < 1, ‖z‖ < 1 and z ≠ 0, the product (q;q)_∞ (-z;q)_∞ (-q/z;q)_∞ equals the + bilateral theta series ∑_{k ∈ ℤ} z^k q^{k(k-1)/2}. + - declaration: QSeries.euler_pentagonal_number + informal: >- + For ‖q‖ < 1, the infinite product (q;q)_∞ equals ∑_{k ∈ ℤ} (-1)^k q^{ω(k)} over the + generalized pentagonal numbers ω(k) = k(3k-1)/2, written as two one-sided sums. + Obtained from the Jacobi triple product by specialization. + - declaration: QSeries.FormalPowerSeries.jacobiTripleProduct + informal: >- + The Jacobi triple product as an identity of formal power series in + (LaurentPolynomial ℂ)-coefficient power series, with no convergence hypothesis: the + product of q-Pochhammer symbols equals the bilateral theta series coefficientwise. + tags: + - number-theory + - partitions + - q-series + - pentagonal-number-theorem + - jacobi-triple-product + msc: + - "11P81" + - "11P84" + - "05A17" + - "05A19" + - "33D15"