diff --git a/RealRooted.lean b/RealRooted.lean index e0a7d820..0bbf9892 100644 --- a/RealRooted.lean +++ b/RealRooted.lean @@ -21,8 +21,11 @@ import RealRooted.AllCombo import RealRooted.Apolarity import RealRooted.Basic import RealRooted.Bezoutian -import RealRooted.BoundarySpecializationRight +import RealRooted.BorceaBranden.Applications.BidiagonalSymbol +import RealRooted.BorceaBranden.Applications.HomogenizeStable +import RealRooted.BorceaBranden.Applications.UnivariateSymbol import RealRooted.BorceaBranden.BoundarySpecialization +import RealRooted.BorceaBranden.FiniteSymbolBasis import RealRooted.BorceaBranden.FiniteSymbolCoefficient import RealRooted.BorceaBranden.FiniteSymbolContraction import RealRooted.BorceaBranden.FiniteSymbolDegree @@ -32,10 +35,7 @@ import RealRooted.BorceaBranden.FiniteSymbolProduct import RealRooted.BorceaBranden.FiniteSymbolReciprocal import RealRooted.BorceaBranden.FiniteSymbolReconstruction import RealRooted.BorceaBranden.FiniteSymbolReconstructionCore -import RealRooted.BorceaBranden.FiniteSymbolBasis -import RealRooted.BorceaBranden.Applications.BidiagonalSymbol -import RealRooted.BorceaBranden.Applications.HomogenizeStable -import RealRooted.BorceaBranden.Applications.UnivariateSymbol +import RealRooted.BoundarySpecializationRight import RealRooted.CauchyInterlacing import RealRooted.Challenges.AissenSchoenbergWhitney import RealRooted.Challenges.BorceaBranden @@ -131,6 +131,7 @@ import RealRooted.Hadamard import RealRooted.HadamardProduct import RealRooted.HeilmannLieb import RealRooted.HermiteBiehler +import RealRooted.HosterStumpInterlacing import RealRooted.HurwitzMatrix import RealRooted.InterlacingSequence import RealRooted.InterlacingSequenceBasic @@ -195,21 +196,35 @@ import RealRooted.Mathlib.Algebra.Polynomial.Homogenize import RealRooted.Mathlib.Algebra.Polynomial.Roots import RealRooted.Mathlib.Algebra.Polynomial.Splits import RealRooted.Mathlib.Analysis.Complex.OpenMapping +import RealRooted.Mathlib.Analysis.SpecialFunctions.ExpIntegral import RealRooted.Mathlib.Analysis.SpecialFunctions.Trigonometric.Basic import RealRooted.Mathlib.Combinatorics.Enumerative.OrderedSubsetPairs +import RealRooted.Mathlib.Data.Fin.Basic +import RealRooted.Mathlib.Data.List.Basic +import RealRooted.Mathlib.Data.List.Destutter import RealRooted.Mathlib.Data.List.Interleave +import RealRooted.Mathlib.Data.List.OfFn import RealRooted.Mathlib.Data.List.Zip import RealRooted.Mathlib.Data.Nat.Cast.Basic import RealRooted.Mathlib.Data.Nat.Choose.Cast import RealRooted.Mathlib.LinearAlgebra.Matrix.Determinant.Basic +import RealRooted.Mathlib.LinearAlgebra.Matrix.Determinant.CauchyBinet +import RealRooted.Mathlib.LinearAlgebra.Matrix.Determinant.Integral +import RealRooted.Mathlib.LinearAlgebra.Matrix.Gaussian import RealRooted.Mathlib.LinearAlgebra.Matrix.KernelSignVariation +import RealRooted.Mathlib.LinearAlgebra.Matrix.SignRegular +import RealRooted.Mathlib.LinearAlgebra.Matrix.SignRegularRankDeficient +import RealRooted.Mathlib.LinearAlgebra.Matrix.SignRegularStrictification +import RealRooted.Mathlib.LinearAlgebra.Matrix.SignRegularVariation import RealRooted.Mathlib.LinearAlgebra.Matrix.SignVariation +import RealRooted.Mathlib.LinearAlgebra.Matrix.SignVariationTopology import RealRooted.Mathlib.LinearAlgebra.Matrix.TotallyNonneg import RealRooted.Mathlib.LinearAlgebra.Matrix.VariationDiminishing +import RealRooted.Mathlib.LinearAlgebra.Vandermonde import RealRooted.MatrixInterlacing -import RealRooted.MultiaffineReciprocalRight import RealRooted.Multiaffine import RealRooted.MultiaffineReciprocal +import RealRooted.MultiaffineReciprocalRight import RealRooted.MultiplierSequence import RealRooted.MultivariateStability import RealRooted.NarayanaTransformation diff --git a/RealRooted/ASWKarlinKernel.lean b/RealRooted/ASWKarlinKernel.lean index 6b19a581..d69ee433 100644 --- a/RealRooted/ASWKarlinKernel.lean +++ b/RealRooted/ASWKarlinKernel.lean @@ -2,6 +2,7 @@ import RealRooted.ASWKarlinMatrix import RealRooted.ASWKarlinThreshold import RealRooted.ASWKarlinVariation import RealRooted.ASWKarlinVectors +import RealRooted.Mathlib.LinearAlgebra.Matrix.SignRegularRankDeficient import Mathlib.Analysis.Complex.Basic import Mathlib.Analysis.SpecialFunctions.Complex.Arg @@ -120,6 +121,49 @@ lemma complex_root_ne_zero_of_coeff_zero_pos {p : ℝ[X]} {z : ℂ} exact heval linarith +/-- Karlin's repeated matrices force a linear lower bound on the sampled sine +vector's sign variations, up to the fixed two-endpoint perturbation loss. -/ +theorem aswKarlinRepeatedSineVariationLowerBound + {p : ℝ[X]} {z : ℂ} (hz : z ∈ (p.map (algebraMap ℝ ℂ)).roots) + (hdegree : 0 < p.natDegree) (hconst : 0 < p.coeff 0) + (hpf : IsPolyaFreqSeq p.coeff) {order blocks : ℕ} + (horder : 0 < order) (hblocks : 0 < blocks) (him : z.im ≠ 0) : + blocks * order - 1 ≤ + Fin.signVariations + (aswKarlinSineVector z.arg p.natDegree order blocks) + 2 := by + have hwidth : 0 < blocks * (p.natDegree + order - 1) := + Nat.mul_pos hblocks (by lia) + have hcols : + blocks * (p.natDegree + order - 1) + 1 = + (blocks * (p.natDegree + order - 1) - 1) + 2 := by + lia + have hnodal : + ∀ i : Fin (blocks * (p.natDegree + order - 1) - 1), + aswKarlinRootVector z p.natDegree order blocks + (Fin.cast hcols.symm i.succ.castSucc) = 0 → + aswKarlinRootVector z p.natDegree order blocks + (Fin.cast hcols.symm i.castSucc.castSucc) * + aswKarlinRootVector z p.natDegree order blocks + (Fin.cast hcols.symm i.succ.succ) < 0 := by + intro i hi + change (z ^ ((i : ℕ) + 1)).im = 0 at hi + change (z ^ (i : ℕ)).im * (z ^ ((i : ℕ) + 2)).im < 0 + exact + im_pow_mul_im_pow_add_two_neg_of_im_pow_add_one_eq_zero him i hi + have hbound := + Matrix.IsTotallyNonnegRect.card_sub_one_le_signVariations_add_two_of_surjective_of_card_eq + (hpf.aswKarlinMatrix_isTotallyNonnegRect + p.natDegree order blocks) + hcols + (aswKarlinMatrix_mulVec_surjective p.natDegree order blocks + hdegree horder hconst) + (aswKarlinMatrix_mulVec_rootVector hz order blocks hdegree horder) + hnodal + rw [signVariations_aswKarlinRootVector_eq_sine + (complex_root_ne_zero_of_coeff_zero_pos hz hconst) + p.natDegree order blocks] at hbound + exact hbound + /-- A real complex root of a positive-constant PF polynomial lies on the negative real ray. -/ lemma arg_eq_pi_of_real_complex_root_of_isPolyaFreqSeq_coeff {p : ℝ[X]} {z : ℂ} @@ -194,19 +238,83 @@ theorem aswKarlinSectorThreshold_le_abs_arg_of_im_ne_zero_of_classicalInput /-- Karlin's finite-order sector estimate for a nonreal complex root of a positive constant-coefficient PF polynomial. -The checked algebraic inputs above provide the repeated totally nonnegative -coefficient-window matrix, its full row rank from the positive constant -coefficient, and the root-supplied kernel vector. The remaining hard ingredient -is the classical variation-diminishing/sign-regular kernel theorem. -/ +The proof uses the repeated totally nonnegative coefficient-window matrices, +their full row rank, the root-supplied kernel vectors, and the sampled-sine +floor bound. Taking sufficiently many blocks absorbs the fixed two-endpoint +perturbation loss. -/ theorem aswKarlinSectorThreshold_le_abs_arg_of_im_ne_zero {p : ℝ[X]} {z : ℂ} (hz : z ∈ (p.map (algebraMap ℝ ℂ)).roots) (hdegree : 0 < p.natDegree) (hconst : 0 < p.coeff 0) (hpf : IsPolyaFreqSeq p.coeff) {order : ℕ} (horder : 0 < order) (him : z.im ≠ 0) : - aswSectorThreshold p.natDegree order ≤ |z.arg| := - aswKarlinSectorThreshold_le_abs_arg_of_im_ne_zero_of_classicalInput - aswKarlinKernelSignVariationClassicalInput hz hdegree hconst hpf horder - him + aswSectorThreshold p.natDegree order ≤ |z.arg| := by + by_contra hnot + have hθlt : + |z.arg| < aswSectorThreshold p.natDegree order := + lt_of_not_ge hnot + have hden_pos := + aswSectorThreshold_denom_pos p.natDegree order hdegree horder + have hspan_cast : + ((p.natDegree + order - 1 : ℕ) : ℝ) = + (order : ℝ) + p.natDegree - 1 := by + rw [Nat.cast_sub (by lia)] + push_cast + ring + have hmul := mul_lt_mul_of_pos_left hθlt hden_pos + have hnormalize : + ((order : ℝ) + p.natDegree - 1) * + aswSectorThreshold p.natDegree order = + (order : ℝ) * Real.pi := by + rw [aswSectorThreshold] + field_simp [hden_pos.ne'] + rw [hnormalize] at hmul + have hslope_lt : + (((p.natDegree + order - 1 : ℕ) : ℝ) * |z.arg|) / + Real.pi < (order : ℝ) := by + apply (div_lt_iff₀ Real.pi_pos).2 + rw [hspan_cast] + exact hmul + let gap : ℝ := + (order : ℝ) - + (((p.natDegree + order - 1 : ℕ) : ℝ) * |z.arg|) / Real.pi + have hgap : 0 < gap := by + dsimp [gap] + linarith + obtain ⟨blocks, hblocks⟩ := exists_nat_gt (3 / gap) + have hblocks_pos : 0 < blocks := by + have hfrac : (0 : ℝ) < 3 / gap := by positivity + exact_mod_cast hfrac.trans hblocks + have hlarge : (3 : ℝ) < (blocks : ℝ) * gap := by + have hmulGap := mul_lt_mul_of_pos_right hblocks hgap + rw [div_mul_cancel₀ _ hgap.ne'] at hmulGap + exact hmulGap + have hlower := + aswKarlinRepeatedSineVariationLowerBound + hz hdegree hconst hpf horder hblocks_pos him + have hupper := + signVariations_aswKarlinSineVector_le_floor_div_pi_abs + z.arg p.natDegree order blocks + let x : ℝ := + (((blocks * (p.natDegree + order - 1) : ℕ) : ℝ) * |z.arg|) / + Real.pi + have hnat : blocks * order ≤ ⌊x⌋₊ + 3 := by + dsimp [x] + lia + have hcast : ((blocks * order : ℕ) : ℝ) ≤ (⌊x⌋₊ : ℝ) + 3 := by + exact_mod_cast hnat + have hfloor : (⌊x⌋₊ : ℝ) ≤ x := Nat.floor_le (by dsimp [x]; positivity) + have hx_eq : + x = + (blocks : ℝ) * + ((((p.natDegree + order - 1 : ℕ) : ℝ) * |z.arg|) / + Real.pi) := by + dsimp [x] + push_cast + ring + rw [hx_eq] at hcast hfloor + dsimp [gap] at hlarge + push_cast at hcast + linarith /-- Conditional Karlin finite-order sector estimate for one complex root, with the classical sign-variation input supplied explicitly. -/ @@ -231,8 +339,12 @@ theorem aswKarlinSectorThreshold_le_abs_arg {p : ℝ[X]} {z : ℂ} (hz : z ∈ (p.map (algebraMap ℝ ℂ)).roots) (hdegree : 0 < p.natDegree) (hconst : 0 < p.coeff 0) (hpf : IsPolyaFreqSeq p.coeff) {order : ℕ} (horder : 0 < order) : - aswSectorThreshold p.natDegree order ≤ |z.arg| := - aswKarlinSectorThreshold_le_abs_arg_of_classicalInput - aswKarlinKernelSignVariationClassicalInput hz hdegree hconst hpf horder + aswSectorThreshold p.natDegree order ≤ |z.arg| := by + by_cases him : z.im = 0 + · rw [arg_eq_pi_of_real_complex_root_of_isPolyaFreqSeq_coeff hz hconst hpf him, + abs_of_pos Real.pi_pos] + exact aswSectorThreshold_le_pi p.natDegree order hdegree horder + · exact aswKarlinSectorThreshold_le_abs_arg_of_im_ne_zero + hz hdegree hconst hpf horder him end RealRooted diff --git a/RealRooted/ASWKarlinSineBounds.lean b/RealRooted/ASWKarlinSineBounds.lean index d769962f..4d11953d 100644 --- a/RealRooted/ASWKarlinSineBounds.lean +++ b/RealRooted/ASWKarlinSineBounds.lean @@ -226,6 +226,50 @@ lemma signVariations_sin_mul_lt_of_last_le_nat_mul_pi simp [k] exact lt_trans hlt hk_lt +/-- The sampled sine vector has at most the number of completed half-turns in +its final angle. -/ +lemma signVariations_sin_mul_le_floor_div_pi + {N : ℕ} {θ : ℝ} (hθ0 : 0 ≤ θ) : + Fin.signVariations + (fun j : Fin (N + 1) => Real.sin ((j : ℕ) * θ)) ≤ + ⌊((N : ℝ) * θ) / Real.pi⌋₊ := by + let r : ℕ := ⌊((N : ℝ) * θ) / Real.pi⌋₊ + have hquot : + ((N : ℝ) * θ) / Real.pi < ((r + 1 : ℕ) : ℝ) := by + simpa only [r, Nat.cast_add, Nat.cast_one] using + Nat.lt_floor_add_one (((N : ℝ) * θ) / Real.pi) + have hlast : + (N : ℝ) * θ ≤ ((r + 1 : ℕ) : ℝ) * Real.pi := by + have hmul := mul_lt_mul_of_pos_right hquot Real.pi_pos + rw [div_mul_cancel₀ _ Real.pi_ne_zero] at hmul + exact hmul.le + have hlt := + signVariations_sin_mul_lt_of_last_le_nat_mul_pi + (N := N) (order := r + 1) (by positivity) hθ0 hlast + exact Nat.lt_succ_iff.mp + (by simpa only [Nat.succ_eq_add_one] using hlt) + +/-- Absolute-angle form of the sampled-sine floor bound for Karlin's repeated +vector. -/ +lemma signVariations_aswKarlinSineVector_le_floor_div_pi_abs + (θ : ℝ) (degree order blocks : ℕ) : + Fin.signVariations (aswKarlinSineVector θ degree order blocks) ≤ + ⌊(((blocks * (degree + order - 1) : ℕ) : ℝ) * |θ|) / + Real.pi⌋₊ := by + by_cases hθ : 0 ≤ θ + · rw [abs_of_nonneg hθ] + change Fin.signVariations + (fun j : Fin (blocks * (degree + order - 1) + 1) => + Real.sin ((j : ℕ) * θ)) ≤ _ + exact signVariations_sin_mul_le_floor_div_pi hθ + · have hθneg : θ < 0 := lt_of_not_ge hθ + rw [← signVariations_aswKarlinSineVector_neg θ degree order blocks, + abs_of_neg hθneg] + change Fin.signVariations + (fun j : Fin (blocks * (degree + order - 1) + 1) => + Real.sin ((j : ℕ) * -θ)) ≤ _ + exact signVariations_sin_mul_le_floor_div_pi (neg_nonneg.mpr hθneg.le) + /-- One-block Karlin sine vectors inherit the general sampled-sine sign-variation bound from a last-angle estimate. -/ lemma signVariations_aswKarlinSineVector_lt_of_last_le_order_pi diff --git a/RealRooted/ASWKarlinVariation.lean b/RealRooted/ASWKarlinVariation.lean index bc077c24..6c5c16ea 100644 --- a/RealRooted/ASWKarlinVariation.lean +++ b/RealRooted/ASWKarlinVariation.lean @@ -63,31 +63,6 @@ theorem IsPolyaFreqSeq.aswKarlinKernelSignVariationLowerBound_of_classicalInput exact hclassical hdegree horder hconst hlead hsupport htn hsurj hker hvec_ne -/-- Remaining classical sign-regular kernel lower bound for a full-row-rank -totally nonnegative one-block Karlin coefficient-window matrix. - -This is the only remaining non-elementary input in the current Karlin sector -proof. It should eventually be proved from the specialized sign-regular -variation-diminishing theorem for a full-row-rank totally nonnegative Toeplitz -window matrix. -/ -theorem aswKarlinKernelSignVariationClassicalInput : - AswKarlinKernelSignVariationClassicalInputStatement := by - intro u degree order hdegree horder hconst hlead hsupport htn hsurj v hker hvec_ne - -- Remaining classical step: use `htn`, `hsurj`, the endpoint/support data, - -- `hker`, and `hvec_ne` to prove the kernel sign-variation lower bound. - sorry - -/-- Classical sign-regular kernel lower bound for a PF one-block Karlin -coefficient-window matrix. -/ -theorem IsPolyaFreqSeq.aswKarlinKernelSignVariationLowerBound - {u : ℕ → ℝ} (hpf : IsPolyaFreqSeq u) (degree order : ℕ) - (hdegree : 0 < degree) (horder : 0 < order) (hconst : 0 < u 0) - (hlead : 0 < u degree) (hsupport : ∀ k, degree < k → u k = 0) : - AswKarlinKernelSignVariationLowerBound degree order u := by - exact hpf.aswKarlinKernelSignVariationLowerBound_of_classicalInput - aswKarlinKernelSignVariationClassicalInput degree order hdegree horder - hconst hlead hsupport - /-- The final sector inequality follows once the two sign-variation bounds are available: a lower bound from the full-row-rank TN kernel theorem and an upper bound for the sampled sine vector inside the forbidden sector. -/ diff --git a/RealRooted/ASWKarlinVectors.lean b/RealRooted/ASWKarlinVectors.lean index 64dc177f..e8e10e67 100644 --- a/RealRooted/ASWKarlinVectors.lean +++ b/RealRooted/ASWKarlinVectors.lean @@ -46,6 +46,72 @@ lemma im_pow_eq_norm_pow_mul_sin_arg (z : ℂ) (n : ℕ) : Complex.exp_im] simp +/-- If a nonreal complex geometric progression has an interior zero imaginary +part, the adjacent imaginary parts have opposite strict signs. -/ +lemma im_pow_mul_im_pow_add_two_neg_of_im_pow_add_one_eq_zero + {z : ℂ} (him : z.im ≠ 0) (i : ℕ) + (hzero : (z ^ (i + 1)).im = 0) : + (z ^ i).im * (z ^ (i + 2)).im < 0 := by + let θ := z.arg + have hz : z ≠ 0 := by + intro hz + apply him + simp [hz] + have hnorm : 0 < ‖z‖ := norm_pos_iff.mpr hz + have hsin : Real.sin θ ≠ 0 := by + have hpolar := im_pow_eq_norm_pow_mul_sin_arg z 1 + simp only [pow_one, Nat.cast_one, one_mul] at hpolar + intro hs + apply him + rw [hpolar, hs, mul_zero] + have hzeroSin : Real.sin ((i + 1 : ℕ) * θ) = 0 := by + rw [im_pow_eq_norm_pow_mul_sin_arg] at hzero + exact (mul_eq_zero.mp hzero).resolve_left (pow_ne_zero _ hnorm.ne') + have hcos : Real.cos ((i + 1 : ℕ) * θ) ≠ 0 := by + intro hc + have hsq := Real.sin_sq_add_cos_sq ((i + 1 : ℕ) * θ) + rw [hzeroSin, hc] at hsq + norm_num at hsq + have hprev : + Real.sin (i * θ) = + -Real.cos ((i + 1 : ℕ) * θ) * Real.sin θ := by + have harg : + (i : ℝ) * θ = ((i + 1 : ℕ) : ℝ) * θ - θ := by + push_cast + ring + rw [harg, Real.sin_sub, hzeroSin] + ring + have hnext : + Real.sin ((i + 2 : ℕ) * θ) = + Real.cos ((i + 1 : ℕ) * θ) * Real.sin θ := by + have harg : + ((i + 2 : ℕ) : ℝ) * θ = + ((i + 1 : ℕ) : ℝ) * θ + θ := by + push_cast + ring + rw [harg, Real.sin_add, hzeroSin] + ring + have htrig : + Real.sin (i * θ) * Real.sin ((i + 2 : ℕ) * θ) < 0 := by + rw [hprev, hnext] + calc + (-Real.cos ((i + 1 : ℕ) * θ) * Real.sin θ) * + (Real.cos ((i + 1 : ℕ) * θ) * Real.sin θ) = + -(Real.cos ((i + 1 : ℕ) * θ) ^ 2 * Real.sin θ ^ 2) := by + ring + _ < 0 := neg_lt_zero.mpr + (mul_pos (sq_pos_of_ne_zero hcos) (sq_pos_of_ne_zero hsin)) + rw [im_pow_eq_norm_pow_mul_sin_arg, + im_pow_eq_norm_pow_mul_sin_arg] + calc + (‖z‖ ^ i * Real.sin (i * θ)) * + (‖z‖ ^ (i + 2) * Real.sin ((i + 2 : ℕ) * θ)) = + (‖z‖ ^ i * ‖z‖ ^ (i + 2)) * + (Real.sin (i * θ) * Real.sin ((i + 2 : ℕ) * θ)) := by + ring + _ < 0 := mul_neg_of_pos_of_neg + (mul_pos (pow_pos hnorm _) (pow_pos hnorm _)) htrig + /-- A nonzero complex number's root vector and sampled sine vector have the same coordinate signs. -/ lemma signVariations_aswKarlinRootVector_eq_sine {z : ℂ} (hz : z ≠ 0) diff --git a/RealRooted/AissenSchoenbergWhitney.lean b/RealRooted/AissenSchoenbergWhitney.lean index 6aded912..f4c44b77 100644 --- a/RealRooted/AissenSchoenbergWhitney.lean +++ b/RealRooted/AissenSchoenbergWhitney.lean @@ -301,9 +301,12 @@ theorem aswSectorThreshold_le_abs_arg_of_isPolyaFreqSeq_coeff {p : ℝ[X]} {z : (hdegree : 0 < p.natDegree) (hconst : 0 < p.coeff 0) (hpf : IsPolyaFreqSeq p.coeff) (hz : z ∈ (p.map (algebraMap ℝ ℂ)).roots) (order : ℕ) : - aswSectorThreshold p.natDegree order ≤ |z.arg| := - aswSectorThreshold_le_abs_arg_of_isPolyaFreqSeq_coeff_of_classicalInput - aswKarlinKernelSignVariationClassicalInput hdegree hconst hpf hz order + aswSectorThreshold p.natDegree order ≤ |z.arg| := by + by_cases horder : order = 0 + · simp [aswSectorThreshold, horder] + · exact aswKarlinSectorThreshold_le_abs_arg + (p := p) (z := z) hz hdegree hconst hpf + (horder := Nat.pos_of_ne_zero horder) /-! ### Reduction to positive constant coefficient -/ diff --git a/RealRooted/Basic.lean b/RealRooted/Basic.lean index 12e857f8..9f622659 100644 --- a/RealRooted/Basic.lean +++ b/RealRooted/Basic.lean @@ -557,6 +557,207 @@ def Prec (f g : ℝ[X]) : Prop := (f ≠ 0 ∧ f.Splits) ∧ (g ≠ 0 ∧ g.Spli ((ss.length + 1 = rs.length ∧ ListInterlaces ss rs) ∨ (ss.length = rs.length ∧ ListAlternates ss rs)) +private lemma listInterlaces_right_tail_ge : + ∀ {ss rs : List ℝ} {r : ℝ}, ListInterlaces ss (r :: rs) → ∀ x ∈ rs, r ≤ x + | [], [], _, _ => by simp + | [], _ :: _, _, h => by simp [ListInterlaces] at h + | _ :: _, [], _, _ => by simp + | s :: ss, r₂ :: rs, r, h => by + rcases h with ⟨hr_s, hs_r₂, htail⟩ + intro x hx + rcases List.mem_cons.mp hx with rfl | hx + · exact le_trans hr_s hs_r₂ + · exact le_trans (le_trans hr_s hs_r₂) + (listInterlaces_right_tail_ge htail x hx) + +private lemma listInterlaces_left_ge_head : + ∀ {ss rs : List ℝ} {r : ℝ}, ListInterlaces ss (r :: rs) → ∀ x ∈ ss, r ≤ x + | [], _, _, _ => by simp + | _ :: _, [], _, h => by simp [ListInterlaces] at h + | s :: ss, r₂ :: rs, r, h => by + rcases h with ⟨hr_s, hs_r₂, htail⟩ + intro x hx + rcases List.mem_cons.mp hx with rfl | hx + · exact hr_s + · exact le_trans (le_trans hr_s hs_r₂) + (listInterlaces_left_ge_head htail x hx) + +private lemma listInterlaces_count_left_le_right_of_head (u : ℝ) : + ∀ {ss rs : List ℝ}, ListInterlaces ss (u :: rs) → + ss.count u ≤ (u :: rs).count u + | [], _, _ => by simp + | _ :: _, [], h => by simp [ListInterlaces] at h + | s :: ss, r₂ :: rs, h => by + rcases h with ⟨hus, hs_r₂, htail⟩ + by_cases hs : s = u + · subst s + by_cases hr₂ : r₂ = u + · subst r₂ + have ih := listInterlaces_count_left_le_right_of_head u htail + simp at ih ⊢ + lia + · have hu_lt_r₂ : u < r₂ := lt_of_le_of_ne hs_r₂ (Ne.symm hr₂) + have htail_no_mem : u ∉ r₂ :: rs := by + intro hu_mem + rcases List.mem_cons.mp hu_mem with hu_eq | hu_rs + · exact hr₂ hu_eq.symm + · have hge := listInterlaces_right_tail_ge htail u hu_rs + linarith + have hss_no_mem : u ∉ ss := by + intro hu_mem + have hge := listInterlaces_left_ge_head htail u hu_mem + linarith + simp [List.count_eq_zero.mpr htail_no_mem, + List.count_eq_zero.mpr hss_no_mem] + · have hu_lt_s : u < s := lt_of_le_of_ne hus (Ne.symm hs) + have hu_lt_r₂ : u < r₂ := lt_of_lt_of_le hu_lt_s hs_r₂ + have htail_no_mem : u ∉ r₂ :: rs := by + intro hu_mem + rcases List.mem_cons.mp hu_mem with hu_eq | hu_rs + · exact ne_of_gt hu_lt_r₂ hu_eq.symm + · have hge := listInterlaces_right_tail_ge htail u hu_rs + linarith + have hss_no_mem : u ∉ ss := by + intro hu_mem + have hge := listInterlaces_left_ge_head htail u hu_mem + linarith + simp [hs, List.count_eq_zero.mpr htail_no_mem, + List.count_eq_zero.mpr hss_no_mem] + +private lemma listInterlaces_count_right_le_left_add_one (u : ℝ) : + ∀ {ss rs : List ℝ}, ListInterlaces ss rs → rs.count u ≤ ss.count u + 1 + | [], [], _ => by simp + | [], [r], _ => by + by_cases hr : r = u <;> simp [hr] + | [], _ :: _ :: _, h => by simp [ListInterlaces] at h + | _ :: _, [], h => by simp [ListInterlaces] at h + | _ :: _, [_], h => by simp [ListInterlaces] at h + | s :: ss, r₁ :: r₂ :: rs, h => by + rcases h with ⟨hr₁s, hs_r₂, htail⟩ + by_cases hr₁ : r₁ = u + · by_cases hs : s = u + · subst r₁ + subst s + have ih := listInterlaces_count_right_le_left_add_one u htail + simp [List.count_cons] at ih ⊢ + lia + · subst r₁ + have hu_lt_s : u < s := lt_of_le_of_ne hr₁s (by simpa [eq_comm] using hs) + have hu_lt_r₂ : u < r₂ := lt_of_lt_of_le hu_lt_s hs_r₂ + have htail_no_mem : u ∉ r₂ :: rs := by + intro hu_mem + rcases List.mem_cons.mp hu_mem with hu_eq | hu_rs + · exact ne_of_gt hu_lt_r₂ hu_eq.symm + · have hge := listInterlaces_right_tail_ge htail u hu_rs + linarith + have htail_count : (r₂ :: rs).count u = 0 := + List.count_eq_zero.mpr htail_no_mem + have hss_no_mem : u ∉ ss := by + intro hu_mem + have hge := listInterlaces_left_ge_head htail u hu_mem + linarith + have hss_count : ss.count u = 0 := List.count_eq_zero.mpr hss_no_mem + simp [htail_count, hss_count, hs] + · have ih := listInterlaces_count_right_le_left_add_one u htail + by_cases hs : s = u + · simp [hr₁, hs] at ih ⊢ + lia + · simpa [hr₁, hs] using ih + +private lemma listInterlaces_count_left_le_right_add_one (u : ℝ) : + ∀ {ss rs : List ℝ}, ListInterlaces ss rs → ss.count u ≤ rs.count u + 1 + | [], [], _ => by simp + | [], [_], _ => by simp + | [], _ :: _ :: _, h => by simp [ListInterlaces] at h + | _ :: _, [], h => by simp [ListInterlaces] at h + | _ :: _, [_], h => by simp [ListInterlaces] at h + | s :: ss, r₁ :: r₂ :: rs, h => by + rcases h with ⟨hr₁s, hs_r₂, htail⟩ + have ih := listInterlaces_count_left_le_right_add_one u htail + by_cases hs : s = u + · by_cases hr₁ : r₁ = u + · simp [hs, hr₁] at ih ⊢ + lia + · by_cases hr₂ : r₂ = u + · subst r₂ + have hstrong := listInterlaces_count_left_le_right_of_head u htail + simp [hs, hr₁] at hstrong ⊢ + lia + · have hu_lt_r₂ : u < r₂ := by + rw [hs] at hs_r₂ + exact lt_of_le_of_ne hs_r₂ (Ne.symm hr₂) + have htail_no_mem : u ∉ r₂ :: rs := by + intro hu_mem + rcases List.mem_cons.mp hu_mem with hu_eq | hu_rs + · exact hr₂ hu_eq.symm + · have hge := listInterlaces_right_tail_ge htail u hu_rs + linarith + have hss_no_mem : u ∉ ss := by + intro hu_mem + have hge := listInterlaces_left_ge_head htail u hu_mem + linarith + have htail_count : (r₂ :: rs).count u = 0 := + List.count_eq_zero.mpr htail_no_mem + have hss_count : ss.count u = 0 := List.count_eq_zero.mpr hss_no_mem + simp [hs, hr₁, htail_count, hss_count] + · by_cases hr₁ : r₁ = u + · simp [hs, hr₁] at ih ⊢ + lia + · simp [hs, hr₁] at ih ⊢ + lia + +private lemma listAlternates_count_bounds (u : ℝ) : + ∀ {ss rs : List ℝ}, ListAlternates ss rs → + ss.count u ≤ rs.count u + 1 ∧ rs.count u ≤ ss.count u + 1 + | [], [], _ => by simp + | [], _ :: _, h => by simp [ListAlternates] at h + | _ :: _, [], h => by simp [ListAlternates] at h + | s :: ss, r :: rs, h => by + rcases h with ⟨hsr, htail⟩ + constructor + · have ih := listInterlaces_count_left_le_right_add_one u htail + by_cases hs : s = u + · by_cases hr : r = u + · subst r + have hstrong := listInterlaces_count_left_le_right_of_head u htail + simp [hs] at hstrong ⊢ + lia + · have hu_lt_r : u < r := by + rw [hs] at hsr + exact lt_of_le_of_ne hsr (Ne.symm hr) + have hss_no_mem : u ∉ ss := by + intro hu_mem + have hge := listInterlaces_left_ge_head htail u hu_mem + linarith + have hss_count : ss.count u = 0 := List.count_eq_zero.mpr hss_no_mem + simp [hs, hr, hss_count] + · simpa [hs] using ih + · have ih := listInterlaces_count_right_le_left_add_one u htail + by_cases hs : s = u + · simp [hs] at ih ⊢ + lia + · simpa [hs] using ih + +/-- In proper position, the multiplicities of every real root differ by at +most one. -/ +theorem rootMultiplicity_bounds_of_prec {f g : ℝ[X]} (h : Prec f g) (u : ℝ) : + f.rootMultiplicity u - 1 ≤ g.rootMultiplicity u ∧ + g.rootMultiplicity u - 1 ≤ f.rootMultiplicity u := by + rcases h with ⟨_, _, ss, rs, _, _, hss_eq, hrs_eq, hshape⟩ + have hcount : ss.count u ≤ rs.count u + 1 ∧ rs.count u ≤ ss.count u + 1 := by + rcases hshape with ⟨_, hint⟩ | ⟨_, halt⟩ + · exact ⟨listInterlaces_count_left_le_right_add_one u hint, + listInterlaces_count_right_le_left_add_one u hint⟩ + · exact listAlternates_count_bounds u halt + have hrs_count : rs.count u = g.rootMultiplicity u := by + rw [← count_roots g, ← hrs_eq] + exact (Multiset.coe_count u rs).symm + have hss_count : ss.count u = f.rootMultiplicity u := by + rw [← count_roots f, ← hss_eq] + exact (Multiset.coe_count u ss).symm + rw [hss_count, hrs_count] at hcount + lia + lemma natDegree_bounds_of_prec {f g : ℝ[X]} (hfg : Prec f g) : f.natDegree ≤ g.natDegree ∧ g.natDegree ≤ f.natDegree + 1 := by rcases hfg with ⟨hf, hg, ss, rs, _, _, hss_eq, hrs_eq, _⟩ diff --git a/RealRooted/Challenges/BorceaBranden.lean b/RealRooted/Challenges/BorceaBranden.lean index 6e96d8eb..0ee1627b 100644 --- a/RealRooted/Challenges/BorceaBranden.lean +++ b/RealRooted/Challenges/BorceaBranden.lean @@ -45,8 +45,14 @@ def PreservesRealRootedUpTo (d : ℕ) (T : ℝ[X] →ₗ[ℝ] ℝ[X]) : Prop := ∀ {p : ℝ[X]}, p.natDegree ≤ d → p.Splits → T p = 0 ∨ (T p).Splits -/-- Finite-degree Borcea--Branden algebraic-symbol theorem, as a named -classical interface. -/ +/-- The positive-symbol sufficiency direction of Borcea--Branden, +Theorem 1.2(b), specialized to one real source variable of degree at most `d`. + +The paper's symbol is `T((z + w)^d)`, which is `finiteAlgebraicSymbol d T` +after expanding in the monomial basis. The complex counterpart is +Theorem 1.1(b). The statement below records only the application-facing +implication to real-rooted inputs and zero-aware outputs, not the converse, +the signed-symbol branch, or the low-rank alternative. -/ def finiteSymbolTheoremStatement : Prop := ∀ {d : ℕ} {T : ℝ[X] →ₗ[ℝ] ℝ[X]}, MvUpperHalfPlaneStable (complexifyMv (finiteAlgebraicSymbol d T)) → diff --git a/RealRooted/Challenges/BraunJal.lean b/RealRooted/Challenges/BraunJal.lean index ad4b3381..be966b4c 100644 --- a/RealRooted/Challenges/BraunJal.lean +++ b/RealRooted/Challenges/BraunJal.lean @@ -101,16 +101,14 @@ abbrev OrderPolytopeHStarTheorem41Target (hStar : NonNestingRookPolynomialFamily) : Prop := OrderPolytopeHStarTheorem41Statement hStar -/-- Concrete Braun--Jal Theorem 4.1 from the accepted combinatorial model -inputs. The parameter-two Narayana identity is the board-model fact; all -proper-position and real-rootedness deductions are checked in Lean. -/ +/-- Braun--Jal Theorem 4.1 from the accepted combinatorial model inputs. +The recurrence and coefficient hypotheses are the source board-model facts; +all proper-position and real-rootedness deductions are checked in Lean. -/ theorem theorem41_of_modifiedModelInputs {M : NonNestingRookPolynomialFamily} (hrec2 : AuxiliaryGRecurrence ModifiedNarayanaPolynomial AuxiliaryG) (hH_nonneg : ∀ n : ℕ, 1 ≤ n → HasNonnegCoeffs (AuxiliaryG n - AuxiliaryG (n - 1))) - (hG_model : ∀ n : ℕ, 1 ≤ n → - AuxiliaryG n = C (n : ℝ) * narayanaPolynomial 2 (n - 1)) (hrec : Theorem35GeneralizedSnakeRecurrenceStatement M ModifiedNarayanaPolynomial AuxiliaryG) (hM_nonneg : ∀ w : SnakeWord, HasNonnegCoeffs (M w)) @@ -119,8 +117,37 @@ theorem theorem41_of_modifiedModelInputs (hM_const : ∀ {w : SnakeWord}, w.IsConstant → M w = ModifiedNarayanaPolynomial (w.length + 1)) : Theorem41Target M := - theorem41NonNestingRook_modified_of_modelInputs hrec2 hH_nonneg hG_model - hrec hM_nonneg hdeg hM_const + theorem41NonNestingRook_modified_of_sourceInputs hrec2 hH_nonneg hrec + hM_nonneg hdeg hM_const + +/-- Braun--Jal Theorem 4.1 for the concrete generalized-snake rook model. + +The five hypotheses are intentionally the combinatorial trust boundary from +Braun--Jal, arXiv:2607.00922v1. Equation `(2)` defines the auxiliary family, +`hH_nonneg` comes from its board-difference interpretation, `hrec` is Theorem +3.5, `hdeg` is the maximum-rook/degree identity, and `hM_const` identifies +constant snake boards with staircases. Formalizing the entire rook-placement +model is outside the present scope. All analytic conclusions are derived in +Lean. -/ +theorem generalizedSnakeRookModel_theorem41 + (hrec2 : AuxiliaryGRecurrence ModifiedNarayanaPolynomial AuxiliaryG) + (hH_nonneg : ∀ n : ℕ, 1 ≤ n → + HasNonnegCoeffs (AuxiliaryG n - AuxiliaryG (n - 1))) + (hrec : Theorem35GeneralizedSnakeRecurrenceStatement + generalizedSnakeRookModel.snakePolynomial + ModifiedNarayanaPolynomial AuxiliaryG) + (hdeg : ∀ {w : SnakeWord}, 1 ≤ w.length → + (generalizedSnakeRookModel.snakePolynomial w.deleteFinal).natDegree + 1 = + (generalizedSnakeRookModel.snakePolynomial w).natDegree) + (hM_const : ∀ {w : SnakeWord}, w.IsConstant → + generalizedSnakeRookModel.snakePolynomial w = + ModifiedNarayanaPolynomial (w.length + 1)) : + Theorem41Target generalizedSnakeRookModel.snakePolynomial := by + exact theorem41_of_modifiedModelInputs hrec2 hH_nonneg hrec + (fun w => by + rw [generalizedSnakeRookModel_snakePolynomial] + exact FiniteSkewBoard.rookPolynomial_hasNonnegCoeffs _) + hdeg hM_const /-- Order-polytope `h*` form of Braun--Jal Theorem 4.1 from the accepted combinatorial model inputs. The matching hypothesis is the Stanley/ @@ -131,8 +158,6 @@ theorem orderPolytopeHStarTheorem41_of_modifiedModelInputs (hrec2 : AuxiliaryGRecurrence ModifiedNarayanaPolynomial AuxiliaryG) (hH_nonneg : ∀ n : ℕ, 1 ≤ n → HasNonnegCoeffs (AuxiliaryG n - AuxiliaryG (n - 1))) - (hG_model : ∀ n : ℕ, 1 ≤ n → - AuxiliaryG n = C (n : ℝ) * narayanaPolynomial 2 (n - 1)) (hrec : Theorem35GeneralizedSnakeRecurrenceStatement M ModifiedNarayanaPolynomial AuxiliaryG) (hM_nonneg : ∀ w : SnakeWord, HasNonnegCoeffs (M w)) @@ -143,8 +168,8 @@ theorem orderPolytopeHStarTheorem41_of_modifiedModelInputs (hmatch : OrderPolytopeHStarMatchesNonNestingRook hStar M) : OrderPolytopeHStarTheorem41Target hStar := orderPolytopeHStarTheorem41_of_theorem41 - (theorem41_of_modifiedModelInputs hrec2 hH_nonneg hG_model hrec - hM_nonneg hdeg hM_const) + (theorem41_of_modifiedModelInputs hrec2 hH_nonneg hrec hM_nonneg hdeg + hM_const) hmatch /-- The real-rootedness projection of Braun--Jal Theorem 4.1. -/ diff --git a/RealRooted/Challenges/HosterStump.lean b/RealRooted/Challenges/HosterStump.lean index e76c61f6..b79be574 100644 --- a/RealRooted/Challenges/HosterStump.lean +++ b/RealRooted/Challenges/HosterStump.lean @@ -29,8 +29,8 @@ Section 2 backend map: * the `f << g -> g << X * f` shift: `prec_mul_X_of_prec_of_nonneg` and `prec0_mul_X_of_prec0`; * gamma real-rootedness transfer: `gammaRealRootedIffPolynomialRealRootedNonpos`; -* missing backend lemma for this route: adjacent-degree gamma interlacing - transfer, recorded below as `GammaAdjacentInterlacingTransferStatement`; +* adjacent-degree gamma interlacing transfer: + `GammaAdjacentInterlacingTransferStatement`; * missing convenience lemmas for this route: lower, upper, moving-window, and `X`-shifted split partial sums of an interlacing sequence, recorded below as statement interfaces. @@ -128,12 +128,20 @@ def lowerPartialSums : List ℝ[X] → List ℝ[X] def upperPartialSums (fs : List ℝ[X]) : List ℝ[X] := (lowerPartialSums fs.reverse).reverse -/-- The Section 2 lower-partial-sum closure lemma needed by the route. -/ +/-- Legacy translation of Hoster--Stump Lemma 2.3(2) to finite lists. + +The source requires every sequence member to be real-rooted and uses a special +degree-at-most-one convention. `IsInterlacingSeq0Nonneg` records neither +condition, so this interface is false as stated; issue #326 tracks the +source-faithful predicate. -/ def LowerPartialSumsPreserveInterlacingStatement : Prop := ∀ {fs : List ℝ[X]}, IsInterlacingSeq0Nonneg fs → IsInterlacingSeq0Nonneg (lowerPartialSums fs) -/-- The Section 2 upper-partial-sum closure lemma needed by the route. -/ +/-- Legacy translation of Hoster--Stump Lemma 2.3(3) to finite lists. + +It has the same missing source hypotheses as the lower-partial-sum interface +and must not be used as a theorem backend. -/ def UpperPartialSumsPreserveInterlacingStatement : Prop := ∀ {fs : List ℝ[X]}, IsInterlacingSeq0Nonneg fs → IsInterlacingSeq0Nonneg (upperPartialSums fs) @@ -142,7 +150,12 @@ def UpperPartialSumsPreserveInterlacingStatement : Prop := def movingWindowSums (width : ℕ) (fs : List ℝ[X]) : List ℝ[X] := (List.range (fs.length - width)).map fun k => (fs.drop k |>.take (width + 1)).sum -/-- The Section 2 moving-window-sum closure lemma needed by the route. -/ +/-- Legacy translation of Hoster--Stump Lemma 2.3(4), with `width` equal to +the paper's `ell`. + +Each output is the sum of `width + 1` consecutive entries, and the Lean length +matches the displayed source range. The source tuple has an inconsistent final +subscript. The input predicate remains too weak for the source theorem. -/ def MovingWindowSumsPreserveInterlacingStatement : Prop := ∀ {width : ℕ} {fs : List ℝ[X]}, width < fs.length → IsInterlacingSeq0Nonneg fs → @@ -153,26 +166,55 @@ def xShiftedSplitSums (fs : List ℝ[X]) : List ℝ[X] := (List.range (fs.length + 1)).map fun k => X * (fs.take k).sum + (fs.drop k).sum -/-- The Section 2 `X`-shifted split-sum closure lemma needed by the route. -/ +/-- Legacy translation of Hoster--Stump Lemma 2.3(5) to zero-based list +splits. + +The formula and endpoint indexing match the paper, but the input predicate +omits source-required elementwise real-rootedness and the low-degree +interlacing convention. -/ def XShiftedSplitSumsPreserveInterlacingStatement : Prop := ∀ {fs : List ℝ[X]}, IsInterlacingSeq0Nonneg fs → IsInterlacingSeq0Nonneg (xShiftedSplitSums fs) -/-- Adjacent-degree gamma interlacing transfer from Hoster--Stump -Proposition 2.5, expressed through the project gamma-transform API. -/ -def GammaAdjacentInterlacingTransferStatement : Prop := - ∀ {d : ℕ} {f g γ δ : ℝ[X]}, - γ.natDegree ≤ d / 2 → - δ.natDegree ≤ (d + 1) / 2 → - f.natDegree = d → - g.natDegree = d + 1 → - IdTransform d f = f → - IdTransform (d + 1) g = g → - IsGammaExpansion d f γ → - IsGammaExpansion (d + 1) g δ → - HasNonnegCoeffs f → - HasNonnegCoeffs g → - (Prec f g ↔ Prec γ δ) +/-- Hoster--Stump Proposition 2.5 in the project gamma-transform API. + +The source assumes nonnegative coefficients for both polynomials and both +gamma polynomials, together with nonzero exact degrees. These conditions must +be explicit because local `Prec` is defined for arbitrary real polynomials and +Lean has `natDegree 0 = 0`. Without the gamma coefficient hypotheses the +statement is false: for `d = 2` and `γ = δ = 1 - X`, the gamma transforms have +nonnegative coefficients and the required symmetry and degrees, and `Prec γ δ` +holds, but `gammaTransform 2 γ = X ^ 2 + X + 1` does not split over `ℝ`. + +The separate nonzero hypotheses exclude the spurious `d = 0`, `f = 0` case +allowed by Lean's `natDegree 0 = 0`. -/ +theorem GammaAdjacentInterlacingTransferStatement + {d : ℕ} {f g γ δ : ℝ[X]} + (hγdeg : γ.natDegree ≤ d / 2) + (hδdeg : δ.natDegree ≤ (d + 1) / 2) + (hf0 : f ≠ 0) + (hg0 : g ≠ 0) + (hfdeg : f.natDegree = d) + (hgdeg : g.natDegree = d + 1) + (_hfFix : IdTransform d f = f) + (_hgFix : IdTransform (d + 1) g = g) + (hfGamma : IsGammaExpansion d f γ) + (hgGamma : IsGammaExpansion (d + 1) g δ) + (_hfnn : HasNonnegCoeffs f) + (_hgnn : HasNonnegCoeffs g) + (hγnn : HasNonnegCoeffs γ) + (hδnn : HasNonnegCoeffs δ) : + Prec f g ↔ Prec γ δ := by + change f = gammaTransform d γ at hfGamma + change g = gammaTransform (d + 1) δ at hgGamma + have hγ0 : γ.coeff 0 ≠ 0 := by + rw [← coeff_ambient_gammaTransform d γ, ← hfGamma, ← hfdeg] + exact Polynomial.leadingCoeff_ne_zero.mpr hf0 + have hδ0 : δ.coeff 0 ≠ 0 := by + rw [← coeff_ambient_gammaTransform (d + 1) δ, ← hgGamma, ← hgdeg] + exact Polynomial.leadingCoeff_ne_zero.mpr hg0 + rw [hfGamma, hgGamma] + exact prec_gammaTransform_succ_iff hγdeg hδdeg hγnn hδnn hγ0 hδ0 /-- Abstract Chow-polynomial data attached to a finite graded simplicial poset. -/ structure ChowPolynomialModel where @@ -237,7 +279,6 @@ structure StrategyInputs upperPartialSums : UpperPartialSumsPreserveInterlacingStatement movingWindowSums : MovingWindowSumsPreserveInterlacingStatement xShiftedSplitSums : XShiftedSplitSumsPreserveInterlacingStatement - gammaAdjacentInterlacing : GammaAdjacentInterlacingTransferStatement /-- Proof-template-facing statement: once the Section 2/3 route ingredients are available for a model, the Hoster--Stump final theorem follows. -/ diff --git a/RealRooted/CommonInterleaver/PairBridge.lean b/RealRooted/CommonInterleaver/PairBridge.lean index d6a2178e..c19fb499 100644 --- a/RealRooted/CommonInterleaver/PairBridge.lean +++ b/RealRooted/CommonInterleaver/PairBridge.lean @@ -1126,6 +1126,14 @@ theorem posComboNoCommonSuccDegreeSlotData_of_forward_asw_and_rootCrossing posComboNoCommonSuccDegreeSlotData_of_leftSplits_and_rootCrossing (PosComboSuccDegreeLeftSplitsNonnegStatement_of_forward_asw hASW) hcross +/-- Succ-degree slot data from the proved ASW left endpoint and the +descending-root crossing inequalities. -/ +theorem posComboNoCommonSuccDegreeSlotData_of_asw_and_rootCrossing + (hcross : PosComboNoCommonSuccDegreeRootCrossingNonnegStatement) : + PosComboNoCommonSuccDegreeSlotDataNonnegStatement := + posComboNoCommonSuccDegreeSlotData_of_leftSplits_and_rootCrossing + PosComboSuccDegreeLeftSplitsNonnegStatement_of_asw hcross + /-- Succ-degree slot data from the splitting-only ASW target and the root-crossing target. -/ theorem posComboNoCommonSuccDegreeSlotData_of_forward_asw_splits_and_rootCrossing @@ -1145,6 +1153,14 @@ theorem succDegreePairHasCommonInterleaver_nonneg_of_leftSplits_and_rootCrossing (PosComboSuccDegreeLeftSplitsNonnegStatement_of_forward_asw hASW) hcross +/-- Succ-degree pair interleavers from the proved ASW left endpoint and the +descending-root crossing inequalities. -/ +theorem succDegreePairHasCommonInterleaver_nonneg_of_asw_and_rootCrossing + (hcross : PosComboNoCommonSuccDegreeRootCrossingNonnegStatement) : + PosComboNoCommonSuccDegreePairHasCommonInterleaverNonnegStatement := + succDegreePairHasCommonInterleaver_nonneg_of_leftSplits_and_rootCrossing + PosComboSuccDegreeLeftSplitsNonnegStatement_of_asw hcross + /-- Succ-degree pair interleavers from the splitting-only ASW target and the root-crossing target. -/ theorem diff --git a/RealRooted/CommonInterleaver/SuccDegreeEndpoint.lean b/RealRooted/CommonInterleaver/SuccDegreeEndpoint.lean index 6f9c7672..cd1af54c 100644 --- a/RealRooted/CommonInterleaver/SuccDegreeEndpoint.lean +++ b/RealRooted/CommonInterleaver/SuccDegreeEndpoint.lean @@ -251,6 +251,25 @@ theorem PosComboRealRooted.left_splits_of_forward_asw hASW hf_pos.ne_zero hfnn hgnn fun {_} hμ => (hfg.isRealRooted_add_right hμ).2 +/-- The succ-degree left endpoint from the proved forward ASW theorem, with no +backend argument required from the caller. -/ +theorem PosComboRealRooted.left_splits_of_asw + {f g : ℝ[X]} + (hfg : PosComboRealRooted f g) + (hf_pos : HasPosLeadingCoeff f) + (hfnn : HasNonnegCoeffs f) (hgnn : HasNonnegCoeffs g) : + f.Splits := + IsPFPolynomial.splits_of_forall_pos_add_C_mul + hf_pos.ne_zero hfnn hgnn + fun {_} hμ => (hfg.isRealRooted_add_right hμ).2 + +/-- Unconditional package form of `PosComboRealRooted.left_splits_of_asw` for +the milestone-B2 endpoint statement. -/ +theorem PosComboSuccDegreeLeftSplitsNonnegStatement_of_asw : + PosComboSuccDegreeLeftSplitsNonnegStatement := by + intro f g hf_pos _ hfnn hgnn hfg _ + exact hfg.left_splits_of_asw hf_pos hfnn hgnn + /-- Conditional package form of `PosComboRealRooted.left_splits_of_forward_asw` for the milestone-B2 endpoint statement. -/ theorem PosComboSuccDegreeLeftSplitsNonnegStatement_of_forward_asw diff --git a/RealRooted/GammaRealRoots.lean b/RealRooted/GammaRealRoots.lean index ce32e03c..fe0d0c24 100644 --- a/RealRooted/GammaRealRoots.lean +++ b/RealRooted/GammaRealRoots.lean @@ -267,6 +267,62 @@ lemma gammaTransform_odd (m : ℕ) (γ : ℝ[X]) : _ = (X + 1) * gammaTransform (2 * m) γ := by simp [gammaTransform, hhalf_even] +/-- Repeated source-degree padding factors off two copies of `X + 1` at each +step. -/ +lemma gammaTransform_add_two_mul (d k : ℕ) {γ : ℝ[X]} + (hγ : γ.natDegree ≤ d / 2) : + gammaTransform (d + 2 * k) γ = + (X + 1) ^ (2 * k) * gammaTransform d γ := by + induction k with + | zero => simp + | succ k ih => + have hkdeg : γ.natDegree ≤ (d + 2 * k) / 2 := by lia + calc + gammaTransform (d + 2 * (k + 1)) γ = + gammaTransform ((d + 2 * k) + 2) γ := by congr 1 + _ = (X + 1) ^ 2 * gammaTransform (d + 2 * k) γ := + gammaTransform_pad_two hkdeg + _ = (X + 1) ^ 2 * + ((X + 1) ^ (2 * k) * gammaTransform d γ) := by rw [ih] + _ = (X + 1) ^ (2 * (k + 1)) * gammaTransform d γ := by + rw [show 2 * (k + 1) = 2 + 2 * k by lia, pow_add] + ring + +/-- Hoster--Stump, Proposition 2.5, equation (2.2), factorization input: +the excess ambient degree is exactly a power of `X + 1`. -/ +theorem gammaTransform_eq_X_add_one_pow_mul_minimal + {d : ℕ} {γ : ℝ[X]} (hγ : γ.natDegree ≤ d / 2) : + gammaTransform d γ = + (X + 1) ^ (d - 2 * γ.natDegree) * + gammaTransform (2 * γ.natDegree) γ := by + let n := γ.natDegree + let m := d / 2 + change gammaTransform d γ = + (X + 1) ^ (d - 2 * n) * gammaTransform (2 * n) γ + have hnm : n ≤ m := hγ + have hbase : n ≤ (2 * n) / 2 := by simp + have hiter := gammaTransform_add_two_mul (2 * n) (m - n) hbase + rcases Nat.mod_two_eq_zero_or_one d with heven | hodd + · have hd : d = 2 * m := by dsimp [m]; lia + calc + gammaTransform d γ = + gammaTransform (2 * n + 2 * (m - n)) γ := by + congr 1 + lia + _ = (X + 1) ^ (2 * (m - n)) * gammaTransform (2 * n) γ := hiter + _ = (X + 1) ^ (d - 2 * n) * gammaTransform (2 * n) γ := by + rw [show 2 * (m - n) = d - 2 * n by lia] + · have hd : d = 2 * m + 1 := by dsimp [m]; lia + calc + gammaTransform d γ = gammaTransform (2 * m + 1) γ := by congr 1 + _ = (X + 1) * gammaTransform (2 * m) γ := gammaTransform_odd m γ + _ = (X + 1) * + ((X + 1) ^ (2 * (m - n)) * gammaTransform (2 * n) γ) := by + rw [show 2 * m = 2 * n + 2 * (m - n) by lia, hiter] + _ = (X + 1) ^ (d - 2 * n) * gammaTransform (2 * n) γ := by + rw [show d - 2 * n = 2 * (m - n) + 1 by lia, pow_succ'] + ring + lemma gammaTransform_even_succ (m : ℕ) (γ : ℝ[X]) : gammaTransform (2 * (m + 1)) γ = (X + 1) * gammaTransform (2 * m + 1) γ + C (γ.coeff (m + 1)) * X ^ (m + 1) := by @@ -318,6 +374,31 @@ lemma gammaTransform_even_eval_neg_one (m : ℕ) (γ : ℝ[X]) : simp [gammaBasisTerm, hpow_pos.ne'] · simp +/-- The minimal even gamma transform does not vanish at `-1`. -/ +lemma gammaTransform_minimal_eval_neg_one_ne_zero {γ : ℝ[X]} (hγ : γ ≠ 0) : + (gammaTransform (2 * γ.natDegree) γ).eval (-1) ≠ 0 := by + rw [gammaTransform_even_eval_neg_one, Polynomial.coeff_natDegree] + exact mul_ne_zero (Polynomial.leadingCoeff_ne_zero.mpr hγ) + (pow_ne_zero _ (by norm_num)) + +/-- Equation (2.2) in Hoster--Stump, Proposition 2.5: +https://arxiv.org/abs/2508.15538. -/ +theorem rootMultiplicity_neg_one_gammaTransform + {d : ℕ} {γ : ℝ[X]} (hγdeg : γ.natDegree ≤ d / 2) (hγ : γ ≠ 0) : + (gammaTransform d γ).rootMultiplicity (-1) = d - 2 * γ.natDegree := by + have hcore_eval := gammaTransform_minimal_eval_neg_one_ne_zero hγ + have hcore_ne : gammaTransform (2 * γ.natDegree) γ ≠ 0 := by + intro hzero + simp [hzero] at hcore_eval + have hcore_not_root : + ¬(gammaTransform (2 * γ.natDegree) γ).IsRoot (-1) := by + rw [Polynomial.IsRoot.def] + exact hcore_eval + have hlinear : (X + 1 : ℝ[X]) = X - C (-1) := by norm_num + rw [gammaTransform_eq_X_add_one_pow_mul_minimal hγdeg, mul_comm, hlinear, + rootMultiplicity_mul_X_sub_C_pow hcore_ne, + rootMultiplicity_eq_zero hcore_not_root, zero_add] + lemma gammaTransform_even_isRoot_neg_one_iff (m : ℕ) (γ : ℝ[X]) : (gammaTransform (2 * m) γ).IsRoot (-1) ↔ γ.coeff m = 0 := by rw [Polynomial.IsRoot.def, gammaTransform_even_eval_neg_one] @@ -512,6 +593,118 @@ lemma natDegree_gammaTransform_le (d : ℕ) (γ : ℝ[X]) : (gammaTransform d γ have hcoeff := congrArg (fun p : ℝ[X] => p.coeff d) hfix simpa [IdTransform, Polynomial.coeff_reflect, Polynomial.revAt_zero] using hcoeff.symm +/-- The root map `ρ ↦ ρ / (1 + ρ)²` in Hoster--Stump, Proposition 2.5, +equation (2.1). Reciprocal roots of a palindromic polynomial have the same +image under this map. -/ +def gammaRootMap (x : ℝ) : ℝ := x / (1 + x) ^ 2 + +/-- The surjectivity part of Hoster--Stump equation (2.1) on the preferred +reciprocal branch. For `y < 0`, the polynomial `x - y * (1 + x)^2` has +opposite signs at `-1` and `0`, so the intermediate value theorem supplies the +required representative in `(-1, 0)`. -/ +theorem exists_mem_Ioo_gammaRootMap_eq {y : ℝ} (hy : y < 0) : + ∃ x ∈ Set.Ioo (-1 : ℝ) 0, gammaRootMap x = y := by + let q : ℝ[X] := X - C y * (X + 1) ^ 2 + have hzero : (0 : ℝ) ∈ Set.Icc (q.eval (-1)) (q.eval 0) := by + simpa [q] using le_of_lt hy + obtain ⟨x, hx, hxzero⟩ := + intermediate_value_Icc (by norm_num : (-1 : ℝ) ≤ 0) + q.continuous.continuousOn hzero + have hx_ne_left : x ≠ -1 := by + intro h + subst x + dsimp [q] at hxzero + norm_num at hxzero + have hx_ne_right : x ≠ 0 := by + intro h + subst x + dsimp [q] at hxzero + simp at hxzero + linarith + have hxmem : x ∈ Set.Ioo (-1 : ℝ) 0 := + ⟨lt_of_le_of_ne hx.1 (Ne.symm hx_ne_left), + lt_of_le_of_ne hx.2 hx_ne_right⟩ + refine ⟨x, hxmem, ?_⟩ + have hone : 1 + x ≠ 0 := by linarith [hxmem.1] + dsimp [q] at hxzero + simp only [eval_sub, eval_X, eval_mul, eval_C, eval_pow, eval_add, eval_one] at hxzero + unfold gammaRootMap + field_simp [hone] + nlinarith + +/-- The gamma root map identifies a nonzero real number with its reciprocal. -/ +lemma gammaRootMap_inv {x : ℝ} (hx : x ≠ 0) : + gammaRootMap x⁻¹ = gammaRootMap x := by + by_cases h1x : 1 + x = 0 + · have hxneg : x = -1 := by linarith + simp [gammaRootMap, hxneg] + · unfold gammaRootMap + have hone : 1 + x⁻¹ = (1 + x) / x := by + field_simp [hx] + ring + rw [hone, div_pow] + field_simp [hx, h1x] + +/-- Hoster--Stump, Proposition 2.5: the gamma root map is strictly increasing +on the interval `(-1, 0)`. -/ +theorem strictMonoOn_gammaRootMap : + StrictMonoOn gammaRootMap (Set.Ioo (-1) 0) := by + intro a ha b hb hab + have ha1 : 0 < 1 + a := by linarith [ha.1] + have hb1 : 0 < 1 + b := by linarith [hb.1] + have hab_pos : 0 < b - a := sub_pos.mpr hab + have hone : 0 < 1 - a * b := by + have hproduct : 0 < (1 + a) * (1 - b) := + mul_pos ha1 (by linarith [hb.2]) + nlinarith + have hfactor := mul_pos hab_pos hone + simp only [gammaRootMap] + rw [div_lt_div_iff₀ (sq_pos_of_pos ha1) (sq_pos_of_pos hb1)] + nlinarith + +/-- The monotone root-map step in Hoster--Stump, Proposition 2.5: +mapping roots in `(-1, 0)` by equation (2.1) preserves and reflects their +weak interleaving order. See https://arxiv.org/abs/2508.15538. -/ +theorem interleaves_map_gammaRootMap_iff : + ∀ {ss rs : List ℝ} + (_ : ∀ x ∈ ss, x ∈ Set.Ioo (-1) 0) + (_ : ∀ x ∈ rs, x ∈ Set.Ioo (-1) 0), + List.Interleaves (fun x y : ℝ => x ≤ y) + (ss.map gammaRootMap) (rs.map gammaRootMap) ↔ + List.Interleaves (fun x y : ℝ => x ≤ y) ss rs + | [], rs, _, _ => by + cases rs <;> simp + | _ :: _, [], _, _ => by simp + | s :: ss, r :: rs, hss, hrs => by + rw [List.map_cons, List.map_cons, List.interleaves_cons_cons, + List.interleaves_cons_cons, + strictMonoOn_gammaRootMap.le_iff_le + (hrs r (by simp)) (hss s (by simp))] + apply and_congr_right + intro _ + simpa only [List.map_cons] using + interleaves_map_gammaRootMap_iff + (ss := rs) (rs := s :: ss) + (fun x hx => hrs x (List.mem_cons_of_mem r hx)) hss +termination_by ss rs => ss.length + rs.length + +/-- The quadratic reciprocal-pair factor in Hoster--Stump, Proposition 2.5, +equation (2.1). See https://arxiv.org/abs/2508.15538. -/ +lemma gammaQuadraticFactor_eq_mul_reciprocal {x : ℝ} + (hx0 : x ≠ 0) (hx1 : x ≠ -1) : + X - C (gammaRootMap x) * (X + 1) ^ 2 = + C (-gammaRootMap x) * (X - C x) * (X - C x⁻¹) := by + have h1x : 1 + x ≠ 0 := by + intro h + apply hx1 + linarith + apply Polynomial.funext + intro y + simp only [eval_sub, eval_X, eval_mul, eval_C, eval_pow, eval_add, eval_one] + unfold gammaRootMap + field_simp [hx0, h1x] + ring + lemma eval_gammaTransform_eq_mul_eval_gammaUntransform {d : ℕ} {γ : ℝ[X]} (hγdeg : γ.natDegree ≤ d / 2) {x : ℝ} (hx : x ≠ -1) : (gammaTransform d γ).eval x = (1 + x) ^ d * γ.eval (x / (1 + x) ^ 2) := by @@ -610,6 +803,601 @@ lemma gammaTransform_X_sub_C_mul_two {d : ℕ} {γ : ℝ[X]} _ = (X - C r * (X + 1) ^ 2) * gammaTransform d γ := by grind +/-- Iterated form of the quadratic factor in Hoster--Stump, Proposition 2.5, +equation (2.1). -/ +lemma gammaTransform_X_sub_C_pow_mul_two + {d : ℕ} {γ : ℝ[X]} (hγ : γ.natDegree ≤ d / 2) (r : ℝ) : + ∀ m : ℕ, + gammaTransform (d + 2 * m) ((X - C r) ^ m * γ) = + (X - C r * (X + 1) ^ 2) ^ m * gammaTransform d γ + | 0 => by simp + | m + 1 => by + have hdeg : + ((X - C r) ^ m * γ).natDegree ≤ (d + 2 * m) / 2 := by + calc + ((X - C r) ^ m * γ).natDegree + ≤ ((X - C r) ^ m).natDegree + γ.natDegree := + natDegree_mul_le + _ ≤ m * (X - C r).natDegree + γ.natDegree := + Nat.add_le_add_right natDegree_pow_le _ + _ ≤ m * 1 + d / 2 := + Nat.add_le_add (Nat.mul_le_mul_left m (natDegree_X_sub_C_le r)) hγ + _ ≤ (d + 2 * m) / 2 := by lia + calc + gammaTransform (d + 2 * (m + 1)) ((X - C r) ^ (m + 1) * γ) = + gammaTransform ((d + 2 * m) + 2) + ((X - C r) * ((X - C r) ^ m * γ)) := by + rw [show d + 2 * (m + 1) = (d + 2 * m) + 2 by lia] + congr 1 + rw [pow_succ] + ring + _ = (X - C r * (X + 1) ^ 2) * + gammaTransform (d + 2 * m) ((X - C r) ^ m * γ) := + gammaTransform_X_sub_C_mul_two hdeg r + _ = (X - C r * (X + 1) ^ 2) * + ((X - C r * (X + 1) ^ 2) ^ m * gammaTransform d γ) := by + rw [gammaTransform_X_sub_C_pow_mul_two hγ r m] + _ = (X - C r * (X + 1) ^ 2) ^ (m + 1) * + gammaTransform d γ := by + rw [pow_succ] + ring + +/-- Algebraic reciprocal-pair factorization away from `0` and `-1`. -/ +lemma gammaTransform_X_sub_C_pow_gammaRootMap_of_ne + {d m : ℕ} {γ : ℝ[X]} (hγ : γ.natDegree ≤ d / 2) {x : ℝ} + (hx0 : x ≠ 0) (hx1 : x ≠ -1) : + gammaTransform (d + 2 * m) ((X - C (gammaRootMap x)) ^ m * γ) = + (C (-gammaRootMap x) * (X - C x) * (X - C x⁻¹)) ^ m * + gammaTransform d γ := by + rw [gammaTransform_X_sub_C_pow_mul_two hγ, + gammaQuadraticFactor_eq_mul_reciprocal hx0 hx1] + +/-- A gamma root of multiplicity `m` yields reciprocal transform roots, each +with the same extracted multiplicity, in Hoster--Stump equation (2.1). -/ +lemma gammaTransform_X_sub_C_pow_gammaRootMap + {d m : ℕ} {γ : ℝ[X]} (hγ : γ.natDegree ≤ d / 2) {x : ℝ} + (hx : x ∈ Set.Ioo (-1) 0) : + gammaTransform (d + 2 * m) ((X - C (gammaRootMap x)) ^ m * γ) = + (C (-gammaRootMap x) * (X - C x) * (X - C x⁻¹)) ^ m * + gammaTransform d γ := + gammaTransform_X_sub_C_pow_gammaRootMap_of_ne hγ + (ne_of_lt hx.2) (ne_of_gt hx.1) + +/-- Extracting one gamma root produces the reciprocal transform-root pair in +Hoster--Stump, Proposition 2.5, equation (2.1). -/ +lemma gammaTransform_X_sub_C_gammaRootMap + {d : ℕ} {γ : ℝ[X]} (hγ : γ.natDegree ≤ d / 2) {x : ℝ} + (hx : x ∈ Set.Ioo (-1) 0) : + gammaTransform (d + 2) ((X - C (gammaRootMap x)) * γ) = + (C (-gammaRootMap x) * (X - C x) * (X - C x⁻¹)) * + gammaTransform d γ := by + simpa using + (gammaTransform_X_sub_C_pow_gammaRootMap (m := 1) hγ hx) + +/-- Multiplicity form of Hoster--Stump, Proposition 2.5, equation (2.1), on +both reciprocal halves of the negative real axis. -/ +theorem rootMultiplicity_gammaTransform_of_neg + {d : ℕ} {γ : ℝ[X]} (hγdeg : γ.natDegree ≤ d / 2) + (hγ : γ ≠ 0) {x : ℝ} (hx : x < 0) (hx1 : x ≠ -1) : + (gammaTransform d γ).rootMultiplicity x = + γ.rootMultiplicity (gammaRootMap x) := by + let r := gammaRootMap x + let m := γ.rootMultiplicity r + obtain ⟨q, hγq, hq_not_dvd⟩ := + γ.exists_eq_pow_rootMultiplicity_mul_and_not_dvd hγ r + change γ = (X - C r) ^ m * q at hγq + have hq : q ≠ 0 := by + intro hzero + apply hγ + rw [hγq, hzero, mul_zero] + have hdeg_eq : γ.natDegree = m + q.natDegree := by + rw [hγq, natDegree_mul (pow_ne_zero _ (X_sub_C_ne_zero r)) hq, + natDegree_pow, natDegree_X_sub_C, mul_one] + have hm : 2 * m ≤ d := by + have hbound : m + q.natDegree ≤ d / 2 := hdeg_eq ▸ hγdeg + lia + have hqdeg : q.natDegree ≤ (d - 2 * m) / 2 := by + have hbound : m + q.natDegree ≤ d / 2 := hdeg_eq ▸ hγdeg + lia + have hx0 : x ≠ 0 := ne_of_lt hx + have htransform := + gammaTransform_X_sub_C_pow_gammaRootMap_of_ne + (d := d - 2 * m) (m := m) hqdeg hx0 hx1 + have hambient : d - 2 * m + 2 * m = d := by lia + have hfull := htransform + rw [hambient, ← hγq] at hfull + have h1x : 1 + x ≠ 0 := by + intro h + apply hx1 + linarith + have hr0 : r ≠ 0 := by + dsimp [r, gammaRootMap] + exact div_ne_zero hx0 (pow_ne_zero _ h1x) + have hxxinv : x ≠ x⁻¹ := by + intro heq + have hmul : x * x⁻¹ = 1 := mul_inv_cancel₀ hx0 + rw [← heq] at hmul + rcases lt_or_gt_of_ne hx1 with hlt | hgt <;> nlinarith + have hcore_not_root : + ¬(gammaTransform (d - 2 * m) q).IsRoot x := by + intro hroot + apply hq_not_dvd + rw [dvd_iff_isRoot] + simpa [r, gammaRootMap] using + isRoot_gamma_of_isRoot_gammaTransform hqdeg hx1 hroot + have hcore_eval : (gammaTransform (d - 2 * m) q).eval x ≠ 0 := by + simpa [Polynomial.IsRoot.def] using hcore_not_root + let p := + (C (-r) * (X - C x⁻¹)) ^ m * gammaTransform (d - 2 * m) q + have hp_eval : p.eval x ≠ 0 := by + dsimp [p] + simp only [eval_mul, eval_pow, eval_C, eval_sub, eval_X] + exact mul_ne_zero + (pow_ne_zero _ (mul_ne_zero (neg_ne_zero.mpr hr0) + (sub_ne_zero.mpr hxxinv))) + hcore_eval + have hp : p ≠ 0 := by + intro hzero + apply hp_eval + simp [hzero] + have hp_not_root : ¬p.IsRoot x := by + rw [Polynomial.IsRoot.def] + exact hp_eval + have hfactor : + gammaTransform d γ = p * (X - C x) ^ m := by + rw [hfull] + dsimp [p, r] + simp only [mul_pow] + ring + change (gammaTransform d γ).rootMultiplicity x = m + rw [hfactor, rootMultiplicity_mul_X_sub_C_pow hp, + rootMultiplicity_eq_zero hp_not_root, zero_add] + +/-- Multiplicity form of Hoster--Stump equation (2.1) on the preferred branch +`(-1, 0)`. -/ +theorem rootMultiplicity_gammaTransform_of_mem_Ioo + {d : ℕ} {γ : ℝ[X]} (hγdeg : γ.natDegree ≤ d / 2) + (hγ : γ ≠ 0) {x : ℝ} (hx : x ∈ Set.Ioo (-1) 0) : + (gammaTransform d γ).rootMultiplicity x = + γ.rootMultiplicity (gammaRootMap x) := + rootMultiplicity_gammaTransform_of_neg hγdeg hγ hx.2 (ne_of_gt hx.1) + +/-! ## Ordered root completion for Hoster--Stump Proposition 2.5 + +The following private helpers formalize the two cases after equation (2.2). +Preferred roots lie in `(-1, 0)`; their reciprocal roots lie below `-1`, and +the replicated center block records the multiplicity of `-1`. +-/ + +private noncomputable def reciprocalCenterRoots (m : ℕ) (s : List ℝ) : List ℝ := + (s.map fun x => x⁻¹).reverse ++ (List.replicate m (-1) ++ s) + +private lemma map_interleave (f : α → β) : ∀ l₁ l₂ : List α, + (l₁.interleave l₂).map f = (l₁.map f).interleave (l₂.map f) + | _, [] => by simp + | l₁, b :: l₂ => by + simp only [List.interleave_cons, List.map_cons] + rw [map_interleave f l₂ l₁] +termination_by l₁ l₂ => l₁.length + l₂.length + +private lemma mem_interleave_of_lengths {x : α} : ∀ l₁ l₂ : List α, + (l₁.length = l₂.length ∨ l₁.length + 1 = l₂.length) → + x ∈ l₁.interleave l₂ → x ∈ l₁ ∨ x ∈ l₂ + | _, [], _, hx => by simp at hx + | l₁, b :: l₂, hlen, hx => by + rw [List.interleave_cons, List.mem_cons] at hx + rcases hx with rfl | hx + · exact Or.inr (by simp) + · have htail : l₂.length = l₁.length ∨ l₂.length + 1 = l₁.length := by + simp only [List.length_cons] at hlen + lia + rcases mem_interleave_of_lengths l₂ l₁ htail hx with hx | hx + · exact Or.inr (by simp [hx]) + · exact Or.inl hx +termination_by l₁ l₂ => l₁.length + l₂.length + +private lemma interleave_replicate_succ (m : ℕ) (a : α) : + (List.replicate m a).interleave (List.replicate (m + 1) a) = + List.replicate (2 * m + 1) a := by + induction m with + | zero => simp + | succ m ih => + rw [List.replicate_succ (n := m)] + rw [List.replicate_succ (n := m + 1)] + rw [List.interleave_cons, List.interleave_cons] + rw [ih] + rw [show 2 * (m + 1) + 1 = (2 * m + 1) + 2 by lia] + rfl + +private lemma isChain_reverse_inv_center_iff + {l : List ℝ} (m : ℕ) + (hlmem : ∀ x ∈ l, x ∈ Set.Ioo (-1 : ℝ) 0) : + ((l.reverse.map fun x => x⁻¹) ++ + (List.replicate (2 * m + 1) (-1) ++ l)).IsChain (· ≤ ·) ↔ + l.IsChain (· ≤ ·) := by + let a := l.reverse.map fun x => x⁻¹ + let c := List.replicate (2 * m + 1) (-1 : ℝ) + constructor + · intro h + have hp := h.pairwise + rw [List.pairwise_append, List.pairwise_append] at hp + exact hp.2.1.2.1.isChain + · intro hl + have ha : a.Pairwise (· ≤ ·) := by + dsimp [a] + rw [List.pairwise_map, List.pairwise_reverse] + exact hl.pairwise.imp_of_mem fun hx hy hxy => + inv_antitoneOn_Iio (hlmem _ hx).2 (hlmem _ hy).2 hxy + have hc : c.Pairwise (· ≤ ·) := by + simp [c] + have hac : (a ++ c).Pairwise (· ≤ ·) := by + rw [List.pairwise_append] + refine ⟨ha, hc, ?_⟩ + intro x hx y hy + dsimp [a] at hx + rw [List.mem_map] at hx + rcases hx with ⟨z, hz, rfl⟩ + have hzmem : z ∈ l := List.mem_reverse.mp hz + have hzlt : z⁻¹ < -1 := by + rw [inv_eq_one_div] + exact (div_lt_iff_of_neg (hlmem z hzmem).2).2 + (by nlinarith [(hlmem z hzmem).1]) + have hy' : y = -1 := by + simpa [c] using hy + linarith + have hacl : ((a ++ c) ++ l).Pairwise (· ≤ ·) := by + rw [List.pairwise_append] + refine ⟨hac, hl.pairwise, ?_⟩ + intro x hx y hy + rw [List.mem_append] at hx + rcases hx with hx | hx + · dsimp [a] at hx + rw [List.mem_map] at hx + rcases hx with ⟨z, hz, rfl⟩ + have hzmem : z ∈ l := List.mem_reverse.mp hz + have hzlt : z⁻¹ < -1 := by + rw [inv_eq_one_div] + exact (div_lt_iff_of_neg (hlmem z hzmem).2).2 + (by nlinarith [(hlmem z hzmem).1]) + linarith [(hlmem y hy).1] + · have hx' : x = -1 := by + simpa [c] using hx + linarith [(hlmem y hy).1] + simpa [a, c, List.append_assoc] using hacl.isChain + +private lemma interleave_reciprocalCenterRoots_same + {ss rs : List ℝ} (m : ℕ) (hlen : ss.length = rs.length) : + (reciprocalCenterRoots m ss).interleave + (reciprocalCenterRoots (m + 1) rs) = + ((rs.interleave ss).reverse.map fun x => x⁻¹) ++ + (List.replicate (2 * m + 1) (-1) ++ rs.interleave ss) := by + unfold reciprocalCenterRoots + rw [List.interleave_append_append_of_length_eq_length] + · rw [List.interleave_append_append_of_length_add_one_eq_length] + · rw [interleave_replicate_succ] + congr 1 + simpa only [map_interleave, List.map_reverse] using + (List.reverse_interleave_of_length_eq_length + (l₁ := rs.map fun x => x⁻¹) (l₂ := ss.map fun x => x⁻¹) + (by simpa only [List.length_map] using hlen.symm)).symm + · simp + · simp [hlen] + +private lemma interleave_reciprocalCenterRoots_succ + {ss rs : List ℝ} (m : ℕ) (hlen : ss.length + 1 = rs.length) : + (reciprocalCenterRoots (m + 1) ss).interleave + (reciprocalCenterRoots m rs) = + ((ss.interleave rs).reverse.map fun x => x⁻¹) ++ + (List.replicate (2 * m + 1) (-1) ++ ss.interleave rs) := by + unfold reciprocalCenterRoots + rw [List.interleave_append_append_of_length_add_one_eq_length] + · rw [List.interleave_append_append_of_length_add_one_eq_length] + · rw [interleave_replicate_succ] + congr 1 + simpa only [map_interleave, List.map_reverse] using + (List.reverse_interleave_of_length_add_one_eq_length + (l₁ := ss.map fun x => x⁻¹) (l₂ := rs.map fun x => x⁻¹) + (by simpa only [List.length_map] using hlen)).symm + · simp + · simp [hlen] + +/-- Equal gamma degrees give one additional central root on the right transform. +This is the first backward case in Hoster--Stump, Proposition 2.5. -/ +private lemma listInterlaces_reciprocalCenterRoots_same_iff + {ss rs : List ℝ} (m : ℕ) + (hss : ∀ x ∈ ss, x ∈ Set.Ioo (-1 : ℝ) 0) + (hrs : ∀ x ∈ rs, x ∈ Set.Ioo (-1 : ℝ) 0) + (hlen : ss.length = rs.length) : + ListInterlaces (reciprocalCenterRoots m ss) + (reciprocalCenterRoots (m + 1) rs) ↔ + ListAlternates ss rs := by + have hfull_len : + (reciprocalCenterRoots m ss).length + 1 = + (reciprocalCenterRoots (m + 1) rs).length := by + simp [reciprocalCenterRoots, hlen] + lia + rw [listInterlaces_iff_interleaves_of_length hfull_len] + constructor + · intro h + have hc := ((List.interleaves_iff_length_isChain_interleave).1 h).2 + rw [interleave_reciprocalCenterRoots_same m hlen, + isChain_reverse_inv_center_iff m] at hc + · apply (listAlternates_iff_interleaves_of_length hlen).2 + apply (List.interleaves_iff_length_isChain_interleave).2 + exact ⟨Or.inl hlen.symm, hc⟩ + · intro x hx + rcases mem_interleave_of_lengths rs ss (Or.inl hlen.symm) hx with hx | hx + · exact hrs x hx + · exact hss x hx + · intro h + have hi := (listAlternates_iff_interleaves_of_length hlen).1 h + apply (List.interleaves_iff_length_isChain_interleave).2 + refine ⟨Or.inr hfull_len, ?_⟩ + rw [interleave_reciprocalCenterRoots_same m hlen, + isChain_reverse_inv_center_iff m] + · exact ((List.interleaves_iff_length_isChain_interleave).1 hi).2 + · intro x hx + rcases mem_interleave_of_lengths rs ss (Or.inl hlen.symm) hx with hx | hx + · exact hrs x hx + · exact hss x hx + +/-- Successive gamma degrees remove one central root from the right transform. +This is the second backward case in Hoster--Stump, Proposition 2.5. -/ +private lemma listInterlaces_reciprocalCenterRoots_succ_iff + {ss rs : List ℝ} (m : ℕ) + (hss : ∀ x ∈ ss, x ∈ Set.Ioo (-1 : ℝ) 0) + (hrs : ∀ x ∈ rs, x ∈ Set.Ioo (-1 : ℝ) 0) + (hlen : ss.length + 1 = rs.length) : + ListInterlaces (reciprocalCenterRoots (m + 1) ss) + (reciprocalCenterRoots m rs) ↔ + ListInterlaces ss rs := by + have hfull_len : + (reciprocalCenterRoots (m + 1) ss).length + 1 = + (reciprocalCenterRoots m rs).length := by + simp [reciprocalCenterRoots] + lia + rw [listInterlaces_iff_interleaves_of_length hfull_len] + constructor + · intro h + have hc := ((List.interleaves_iff_length_isChain_interleave).1 h).2 + rw [interleave_reciprocalCenterRoots_succ m hlen, + isChain_reverse_inv_center_iff m] at hc + · apply (listInterlaces_iff_interleaves_of_length hlen).2 + apply (List.interleaves_iff_length_isChain_interleave).2 + exact ⟨Or.inr hlen, hc⟩ + · intro x hx + rcases mem_interleave_of_lengths ss rs (Or.inr hlen) hx with hx | hx + · exact hss x hx + · exact hrs x hx + · intro h + have hi := (listInterlaces_iff_interleaves_of_length hlen).1 h + apply (List.interleaves_iff_length_isChain_interleave).2 + refine ⟨Or.inr hfull_len, ?_⟩ + rw [interleave_reciprocalCenterRoots_succ m hlen, + isChain_reverse_inv_center_iff m] + · exact ((List.interleaves_iff_length_isChain_interleave).1 hi).2 + · intro x hx + rcases mem_interleave_of_lengths ss rs (Or.inr hlen) hx with hx | hx + · exact hss x hx + · exact hrs x hx + +/-- Exact root-multiset form of Hoster--Stump, Proposition 2.5, equations +(2.1) and (2.2): the roots of the gamma transform consist of reciprocal +pairs, together with the exceptional roots at `-1` prescribed by the degree. +-/ +theorem roots_gammaTransform_eq_reciprocal_add_neg_one_add + {d : Nat} {γ : Real[X]} (hγdeg : γ.natDegree ≤ d / 2) + (hγ : γ ≠ 0) + (hneg : ∀ x ∈ (gammaTransform d γ).roots, x < 0) : + (gammaTransform d γ).roots = + ((gammaTransform d γ).roots.filter + (fun x => x ∈ Set.Ioo (-1 : Real) 0)).map (fun x => x⁻¹) + + Multiset.replicate (d - 2 * γ.natDegree) (-1 : Real) + + (gammaTransform d γ).roots.filter + (fun x => x ∈ Set.Ioo (-1 : Real) 0) := by + classical + let s := (gammaTransform d γ).roots.filter + (fun x => x ∈ Set.Ioo (-1 : Real) 0) + change (gammaTransform d γ).roots = + s.map (fun x => x⁻¹) + + Multiset.replicate (d - 2 * γ.natDegree) (-1 : Real) + s + have hs_Ioo {x : Real} (hx : x ∈ s) : x ∈ Set.Ioo (-1 : Real) 0 := by + change x ∈ (gammaTransform d γ).roots.filter + (fun z => z ∈ Set.Ioo (-1 : Real) 0) at hx + exact (Multiset.mem_filter.mp hx).2 + have hinv_Ioo {x : Real} (hx : x < -1) : x⁻¹ ∈ Set.Ioo (-1 : Real) 0 := by + constructor + · rw [inv_eq_one_div] + exact (lt_div_iff_of_neg (by linarith)).2 (by nlinarith) + · exact inv_lt_zero.mpr (by linarith) + have hinv_lt_neg_one {x : Real} (hx : x ∈ Set.Ioo (-1 : Real) 0) : + x⁻¹ < -1 := by + rw [inv_eq_one_div] + exact (div_lt_iff_of_neg hx.2).2 (by nlinarith [hx.1]) + refine Multiset.ext.mpr fun x => ?_ + by_cases hxlt : x < -1 + · have hx0 : x ≠ 0 := by linarith + have hxi := hinv_Ioo hxlt + have hcount_inv : + (gammaTransform d γ).roots.count x = + (s.map (fun z => z⁻¹)).count x := by + calc + (gammaTransform d γ).roots.count x = + (gammaTransform d γ).rootMultiplicity x := + Polynomial.count_roots (gammaTransform d γ) + _ = γ.rootMultiplicity (gammaRootMap x) := + rootMultiplicity_gammaTransform_of_neg hγdeg hγ + (by linarith) (by linarith) + _ = γ.rootMultiplicity (gammaRootMap x⁻¹) := by + rw [gammaRootMap_inv hx0] + _ = (gammaTransform d γ).rootMultiplicity x⁻¹ := + (rootMultiplicity_gammaTransform_of_neg hγdeg hγ hxi.2 + (ne_of_gt hxi.1)).symm + _ = (gammaTransform d γ).roots.count x⁻¹ := + (Polynomial.count_roots (gammaTransform d γ)).symm + _ = s.count x⁻¹ := by + simpa [s] using + (Multiset.count_filter_of_pos + (s := (gammaTransform d γ).roots) (a := x⁻¹) + (p := fun z : Real => z ∈ Set.Ioo (-1) 0) hxi).symm + _ = (s.map (fun z => z⁻¹)).count x := by + simpa using + (Multiset.count_map_eq_count' (fun z : Real => z⁻¹) s + inv_injective x⁻¹).symm + have hs_zero : s.count x = 0 := by + apply Multiset.count_filter_of_neg + intro hxmem + linarith [hxmem.1] + have hrep_zero : + (Multiset.replicate (d - 2 * γ.natDegree) (-1 : Real)).count x = 0 := by + rw [Multiset.count_replicate] + simp [Ne.symm (ne_of_lt hxlt)] + calc + (gammaTransform d γ).roots.count x = + (s.map (fun z => z⁻¹)).count x := hcount_inv + _ = (s.map (fun z => z⁻¹) + + Multiset.replicate (d - 2 * γ.natDegree) (-1 : Real) + s).count x := by + simp [Multiset.count_add, hs_zero, hrep_zero] + · by_cases hxeq : x = -1 + · subst x + have hs_zero : s.count (-1) = 0 := by + apply Multiset.count_filter_of_neg + simp + have hinv_zero : (s.map (fun z => z⁻¹)).count (-1) = 0 := by + apply Multiset.count_eq_zero_of_notMem + rw [Multiset.mem_map] + rintro ⟨z, hzs, hz⟩ + have hzlt := hinv_lt_neg_one (hs_Ioo hzs) + rw [hz] at hzlt + linarith + calc + (gammaTransform d γ).roots.count (-1) = + (gammaTransform d γ).rootMultiplicity (-1) := + Polynomial.count_roots (gammaTransform d γ) + _ = d - 2 * γ.natDegree := + rootMultiplicity_neg_one_gammaTransform hγdeg hγ + _ = (s.map (fun z => z⁻¹) + + Multiset.replicate (d - 2 * γ.natDegree) (-1 : Real) + s).count (-1) := by + simp [Multiset.count_add, hs_zero, hinv_zero] + · by_cases hxneg : x < 0 + · have hxmem : x ∈ Set.Ioo (-1 : Real) 0 := + ⟨lt_of_le_of_ne (le_of_not_gt hxlt) (Ne.symm hxeq), hxneg⟩ + have hinv_zero : (s.map (fun z => z⁻¹)).count x = 0 := by + apply Multiset.count_eq_zero_of_notMem + rw [Multiset.mem_map] + rintro ⟨z, hzs, hz⟩ + have hzlt := hinv_lt_neg_one (hs_Ioo hzs) + rw [hz] at hzlt + linarith [hxmem.1] + have hs_count : + (gammaTransform d γ).roots.count x = s.count x := by + simpa [s] using + (Multiset.count_filter_of_pos + (s := (gammaTransform d γ).roots) (a := x) + (p := fun z : Real => z ∈ Set.Ioo (-1) 0) hxmem).symm + have hrep_zero : + (Multiset.replicate (d - 2 * γ.natDegree) (-1 : Real)).count x = 0 := by + rw [Multiset.count_replicate] + simp [Ne.symm hxeq] + calc + (gammaTransform d γ).roots.count x = s.count x := hs_count + _ = (s.map (fun z => z⁻¹) + + Multiset.replicate (d - 2 * γ.natDegree) (-1 : Real) + s).count x := by + simp [Multiset.count_add, hinv_zero, hrep_zero] + · have hx_not_mem : x ∉ (gammaTransform d γ).roots := by + intro hxroot + exact hxneg (hneg x hxroot) + have hs_zero : s.count x = 0 := by + apply Multiset.count_filter_of_neg + intro hxmem + exact hxneg hxmem.2 + have hinv_zero : (s.map (fun z => z⁻¹)).count x = 0 := by + apply Multiset.count_eq_zero_of_notMem + rw [Multiset.mem_map] + rintro ⟨z, hzs, hz⟩ + have hzlt := hinv_lt_neg_one (hs_Ioo hzs) + rw [hz] at hzlt + linarith + have hrep_zero : + (Multiset.replicate (d - 2 * γ.natDegree) (-1 : Real)).count x = 0 := by + rw [Multiset.count_replicate] + simp [Ne.symm hxeq] + calc + (gammaTransform d γ).roots.count x = 0 := + Multiset.count_eq_zero_of_notMem hx_not_mem + _ = (s.map (fun z => z⁻¹) + + Multiset.replicate (d - 2 * γ.natDegree) (-1 : Real) + s).count x := by + simp [Multiset.count_add, hs_zero, hinv_zero, hrep_zero] + +/-- Exact root-multiset form of Hoster--Stump, Proposition 2.5, equation +(2.1): the negative gamma roots are the images of the transform roots on the +preferred reciprocal branch `(-1, 0)`, with multiplicity. -/ +theorem roots_eq_map_filter_roots_gammaTransform + {d : ℕ} {γ : ℝ[X]} (hγdeg : γ.natDegree ≤ d / 2) (hγ : γ ≠ 0) + (hγneg : ∀ y ∈ γ.roots, y < 0) : + γ.roots = + ((gammaTransform d γ).roots.filter + (fun x => x ∈ Set.Ioo (-1 : ℝ) 0)).map gammaRootMap := by + classical + let s := (gammaTransform d γ).roots.filter + (fun x => x ∈ Set.Ioo (-1 : ℝ) 0) + have hs_Ioo {x : ℝ} (hx : x ∈ s) : x ∈ Set.Ioo (-1 : ℝ) 0 := by + change x ∈ (gammaTransform d γ).roots.filter + (fun z => z ∈ Set.Ioo (-1 : ℝ) 0) at hx + exact (Multiset.mem_filter.mp hx).2 + refine Multiset.ext.mpr fun y => ?_ + by_cases hy : y < 0 + · obtain ⟨x, hx, hxy⟩ := exists_mem_Ioo_gammaRootMap_eq hy + have hcount_map : (s.map gammaRootMap).count y = s.count x := by + rw [← hxy] + calc + (s.map gammaRootMap).count (gammaRootMap x) = + (s.filter + (fun z => gammaRootMap x = gammaRootMap z)).card := + Multiset.count_map gammaRootMap s (gammaRootMap x) + _ = (s.filter (fun z => x = z)).card := by + exact congrArg Multiset.card <| + Multiset.filter_congr fun z hz => + strictMonoOn_gammaRootMap.injOn.eq_iff hx (hs_Ioo hz) + _ = s.count x := + (Multiset.count_eq_card_filter_eq s x).symm + calc + γ.roots.count y = γ.rootMultiplicity y := + Polynomial.count_roots γ + _ = γ.rootMultiplicity (gammaRootMap x) := by rw [hxy] + _ = (gammaTransform d γ).rootMultiplicity x := + (rootMultiplicity_gammaTransform_of_mem_Ioo hγdeg hγ hx).symm + _ = (gammaTransform d γ).roots.count x := + (Polynomial.count_roots (gammaTransform d γ)).symm + _ = s.count x := by + simpa [s] using + (Multiset.count_filter_of_pos + (s := (gammaTransform d γ).roots) (a := x) + (p := fun z : ℝ => z ∈ Set.Ioo (-1) 0) hx).symm + _ = (s.map gammaRootMap).count y := hcount_map.symm + _ = (((gammaTransform d γ).roots.filter + (fun x => x ∈ Set.Ioo (-1 : ℝ) 0)).map gammaRootMap).count y := by + rfl + · have hy_not_mem : y ∉ γ.roots := by + intro hyroot + exact hy (hγneg y hyroot) + have hy_not_map : y ∉ s.map gammaRootMap := by + rw [Multiset.mem_map] + rintro ⟨x, hxs, hxy⟩ + apply hy + rw [← hxy] + unfold gammaRootMap + exact div_neg_of_neg_of_pos (hs_Ioo hxs).2 + (sq_pos_of_pos (by linarith [(hs_Ioo hxs).1])) + calc + γ.roots.count y = 0 := + Multiset.count_eq_zero_of_notMem hy_not_mem + _ = (s.map gammaRootMap).count y := + (Multiset.count_eq_zero_of_notMem hy_not_map).symm + _ = (((gammaTransform d γ).roots.filter + (fun x => x ∈ Set.Ioo (-1 : ℝ) 0)).map gammaRootMap).count y := by + rfl + lemma hasNonnegCoeffs_gammaQuadraticFactor {r : ℝ} (hr : r ≤ 0) : HasNonnegCoeffs (X - C r * (X + 1) ^ 2) := by have hneg : 0 ≤ -r := by simp_all @@ -1051,4 +1839,362 @@ theorem gammaRealRootedIffPolynomialRealRootedNonpos : (d := d) (γ := γ) hγdeg hp.1.1 hp.1.2 hp.2 end +private lemma roots_neg_of_nonnegCoeffs_of_coeff_zero_ne + {p : ℝ[X]} (hnn : HasNonnegCoeffs p) (hzero : p.coeff 0 ≠ 0) : + ∀ x ∈ p.roots, x < 0 := by + intro x hx + have hxle := roots_nonpos_of_hasNonnegCoeffs hnn x hx + have hxne : x ≠ 0 := by + intro hxeq + subst x + have hroot : p.eval 0 = 0 := isRoot_of_mem_roots hx + apply hzero + rw [Polynomial.coeff_zero_eq_eval_zero] + exact hroot + exact lt_of_le_of_ne hxle hxne + +private noncomputable def preferredRoots (d : ℕ) (γ : ℝ[X]) : List ℝ := + ((gammaTransform d γ).roots.filter + (fun x => x ∈ Set.Ioo (-1 : ℝ) 0)).sort (· ≤ ·) + +private lemma preferredRoots_pairwise (d : ℕ) (γ : ℝ[X]) : + (preferredRoots d γ).Pairwise (· ≤ ·) := by + exact Multiset.pairwise_sort _ _ + +private lemma mem_preferredRoots {d : ℕ} {γ : ℝ[X]} {x : ℝ} + (hx : x ∈ preferredRoots d γ) : x ∈ Set.Ioo (-1 : ℝ) 0 := by + rw [preferredRoots, Multiset.mem_sort] at hx + exact (Multiset.mem_filter.mp hx).2 + +private lemma coe_map_gammaRootMap_preferredRoots + {d : ℕ} {γ : ℝ[X]} (hγdeg : γ.natDegree ≤ d / 2) + (hγ : γ ≠ 0) (hγneg : ∀ x ∈ γ.roots, x < 0) : + (↑((preferredRoots d γ).map gammaRootMap) : Multiset ℝ) = γ.roots := by + change Multiset.map gammaRootMap (↑(preferredRoots d γ) : Multiset ℝ) = γ.roots + rw [show (↑(preferredRoots d γ) : Multiset ℝ) = + (gammaTransform d γ).roots.filter + (fun x => x ∈ Set.Ioo (-1 : ℝ) 0) by simp [preferredRoots]] + exact (roots_eq_map_filter_roots_gammaTransform hγdeg hγ hγneg).symm + +private lemma length_preferredRoots + {d : ℕ} {γ : ℝ[X]} (hγdeg : γ.natDegree ≤ d / 2) + (hγ : γ ≠ 0) (hγsplits : γ.Splits) + (hγneg : ∀ x ∈ γ.roots, x < 0) : + (preferredRoots d γ).length = γ.natDegree := by + have hcoe := coe_map_gammaRootMap_preferredRoots hγdeg hγ hγneg + have hcard := congrArg Multiset.card hcoe + simpa [card_roots_of_splits hγsplits] using hcard + +private lemma map_gammaRootMap_preferredRoots_pairwise (d : ℕ) (γ : ℝ[X]) : + ((preferredRoots d γ).map gammaRootMap).Pairwise (· ≤ ·) := by + rw [List.pairwise_map] + exact (preferredRoots_pairwise d γ).imp_of_mem fun hx hy hxy => + strictMonoOn_gammaRootMap.monotoneOn + (mem_preferredRoots hx) (mem_preferredRoots hy) hxy + +private lemma Prec.sorted_roots_shape {f g : ℝ[X]} (h : Prec f g) : + let ss := f.roots.sort (· ≤ ·) + let rs := g.roots.sort (· ≤ ·) + ((ss.length + 1 = rs.length ∧ ListInterlaces ss rs) ∨ + (ss.length = rs.length ∧ ListAlternates ss rs)) := by + rcases h with ⟨_, _, ss, rs, hss, hrs, hss_eq, hrs_eq, hshape⟩ + have hss_sort : ss = f.roots.sort (· ≤ ·) := by + apply List.Perm.eq_of_pairwise' hss (Multiset.pairwise_sort _ _) + exact Multiset.coe_eq_coe.mp (hss_eq.trans (Multiset.sort_eq _ _).symm) + have hrs_sort : rs = g.roots.sort (· ≤ ·) := by + apply List.Perm.eq_of_pairwise' hrs (Multiset.pairwise_sort _ _) + exact Multiset.coe_eq_coe.mp (hrs_eq.trans (Multiset.sort_eq _ _).symm) + simpa [hss_sort, hrs_sort] using hshape + +private lemma sort_roots_eq_map_gammaRootMap_preferredRoots + {d : ℕ} {γ : ℝ[X]} (hγdeg : γ.natDegree ≤ d / 2) + (hγ : γ ≠ 0) (hγneg : ∀ x ∈ γ.roots, x < 0) : + γ.roots.sort (· ≤ ·) = (preferredRoots d γ).map gammaRootMap := by + apply List.Perm.eq_of_pairwise' (Multiset.pairwise_sort _ _) + (map_gammaRootMap_preferredRoots_pairwise d γ) + exact Multiset.coe_eq_coe.mp + ((Multiset.sort_eq _ _).trans + (coe_map_gammaRootMap_preferredRoots hγdeg hγ hγneg).symm) + +private lemma reciprocalCenterRoots_pairwise + {s : List ℝ} (m : ℕ) (hs : s.Pairwise (· ≤ ·)) + (hsmem : ∀ x ∈ s, x ∈ Set.Ioo (-1 : ℝ) 0) : + (reciprocalCenterRoots m s).Pairwise (· ≤ ·) := by + let a := s.reverse.map fun x => x⁻¹ + let c := List.replicate m (-1 : ℝ) + have ha : a.Pairwise (· ≤ ·) := by + dsimp [a] + rw [List.pairwise_map, List.pairwise_reverse] + exact hs.imp_of_mem fun hx hy hxy => + inv_antitoneOn_Iio (hsmem _ hx).2 (hsmem _ hy).2 hxy + have hc : c.Pairwise (· ≤ ·) := by simp [c] + have hac : (a ++ c).Pairwise (· ≤ ·) := by + rw [List.pairwise_append] + refine ⟨ha, hc, ?_⟩ + intro x hx y hy + dsimp [a] at hx + rw [List.mem_map] at hx + rcases hx with ⟨z, hz, rfl⟩ + have hzmem : z ∈ s := List.mem_reverse.mp hz + have hzlt : z⁻¹ < -1 := by + rw [inv_eq_one_div] + exact (div_lt_iff_of_neg (hsmem z hzmem).2).2 + (by nlinarith [(hsmem z hzmem).1]) + have hy' : y = -1 := by + dsimp [c] at hy + exact (List.mem_replicate.mp hy).2 + linarith + have hacs : ((a ++ c) ++ s).Pairwise (· ≤ ·) := by + rw [List.pairwise_append] + refine ⟨hac, hs, ?_⟩ + intro x hx y hy + rw [List.mem_append] at hx + rcases hx with hx | hx + · dsimp [a] at hx + rw [List.mem_map] at hx + rcases hx with ⟨z, hz, rfl⟩ + have hzmem : z ∈ s := List.mem_reverse.mp hz + have hzlt : z⁻¹ < -1 := by + rw [inv_eq_one_div] + exact (div_lt_iff_of_neg (hsmem z hzmem).2).2 + (by nlinarith [(hsmem z hzmem).1]) + linarith [(hsmem y hy).1] + · have hx' : x = -1 := by + dsimp [c] at hx + exact (List.mem_replicate.mp hx).2 + linarith [(hsmem y hy).1] + simpa [reciprocalCenterRoots, a, c, List.append_assoc] using hacs + +private lemma coe_reciprocalCenterRoots_eq_roots + {d : ℕ} {γ : ℝ[X]} (hγdeg : γ.natDegree ≤ d / 2) + (hγ : γ ≠ 0) (hneg : ∀ x ∈ (gammaTransform d γ).roots, x < 0) : + (↑(reciprocalCenterRoots (d - 2 * γ.natDegree) + (preferredRoots d γ)) : Multiset ℝ) = (gammaTransform d γ).roots := by + let s := preferredRoots d γ + unfold reciprocalCenterRoots + calc + (↑((s.map fun x => x⁻¹).reverse ++ + (List.replicate (d - 2 * γ.natDegree) (-1 : ℝ) ++ s)) : Multiset ℝ) = + (↑((s.map fun x => x⁻¹).reverse) : Multiset ℝ) + + ((↑(List.replicate (d - 2 * γ.natDegree) (-1 : ℝ)) : Multiset ℝ) + + (↑s : Multiset ℝ)) := by + rfl + _ = Multiset.map (fun x : ℝ => x⁻¹) (↑s : Multiset ℝ) + + (Multiset.replicate (d - 2 * γ.natDegree) (-1) + + (↑s : Multiset ℝ)) := by + rw [Multiset.coe_reverse, Multiset.coe_replicate] + rfl + _ = (gammaTransform d γ).roots := by + rw [show (↑s : Multiset ℝ) = + (gammaTransform d γ).roots.filter + (fun x => x ∈ Set.Ioo (-1 : ℝ) 0) by simp [s, preferredRoots]] + simpa only [add_assoc] using + (roots_gammaTransform_eq_reciprocal_add_neg_one_add hγdeg hγ hneg).symm + +private lemma sort_roots_gammaTransform_eq_reciprocalCenterRoots + {d : ℕ} {γ : ℝ[X]} (hγdeg : γ.natDegree ≤ d / 2) + (hγ : γ ≠ 0) (hneg : ∀ x ∈ (gammaTransform d γ).roots, x < 0) : + (gammaTransform d γ).roots.sort (· ≤ ·) = + reciprocalCenterRoots (d - 2 * γ.natDegree) (preferredRoots d γ) := by + apply List.Perm.eq_of_pairwise' (Multiset.pairwise_sort _ _) + (reciprocalCenterRoots_pairwise _ (preferredRoots_pairwise d γ) + (fun _ hx => mem_preferredRoots hx)) + exact Multiset.coe_eq_coe.mp + ((Multiset.sort_eq _ _).trans + (coe_reciprocalCenterRoots_eq_roots hγdeg hγ hneg).symm) + +/-- Hoster--Stump, Proposition 2.5: proper position is equivalent before and +after applying adjacent-degree gamma transforms. -/ +theorem prec_gammaTransform_succ_iff + {d : ℕ} {γ δ : ℝ[X]} + (hγdeg : γ.natDegree ≤ d / 2) + (hδdeg : δ.natDegree ≤ (d + 1) / 2) + (hγnn : HasNonnegCoeffs γ) + (hδnn : HasNonnegCoeffs δ) + (hγ0 : γ.coeff 0 ≠ 0) + (hδ0 : δ.coeff 0 ≠ 0) : + Prec (gammaTransform d γ) (gammaTransform (d + 1) δ) ↔ + Prec γ δ := by + have hγ : γ ≠ 0 := by + intro hzero + apply hγ0 + simp [hzero] + have hδ : δ ≠ 0 := by + intro hzero + apply hδ0 + simp [hzero] + have hγmul : γ.natDegree * 2 ≤ d := Nat.mul_le_of_le_div 2 _ _ hγdeg + have hδmul : δ.natDegree * 2 ≤ d + 1 := Nat.mul_le_of_le_div 2 _ _ hδdeg + have hTγnn : HasNonnegCoeffs (gammaTransform d γ) := + hasNonnegCoeffs_gammaTransform hγnn + have hTδnn : HasNonnegCoeffs (gammaTransform (d + 1) δ) := + hasNonnegCoeffs_gammaTransform hδnn + have hTγ0 : (gammaTransform d γ).coeff 0 ≠ 0 := by + simpa [coeff_zero_gammaTransform] using hγ0 + have hTδ0 : (gammaTransform (d + 1) δ).coeff 0 ≠ 0 := by + simpa [coeff_zero_gammaTransform] using hδ0 + have hTγneg := roots_neg_of_nonnegCoeffs_of_coeff_zero_ne hTγnn hTγ0 + have hTδneg := roots_neg_of_nonnegCoeffs_of_coeff_zero_ne hTδnn hTδ0 + let ss := preferredRoots d γ + let rs := preferredRoots (d + 1) δ + have hss : ∀ x ∈ ss, x ∈ Set.Ioo (-1 : ℝ) 0 := by + exact fun _ hx => mem_preferredRoots hx + have hrs : ∀ x ∈ rs, x ∈ Set.Ioo (-1 : ℝ) 0 := by + exact fun _ hx => mem_preferredRoots hx + constructor + · intro hTprec + have hγrr := + isRealRooted_and_hasRootsNonpos_of_isRealRooted_gammaTransform_of_natDegree_le + hγdeg hTprec.1.1 hTprec.1.2 + (roots_nonpos_of_hasNonnegCoeffs hTγnn) + have hδrr := + isRealRooted_and_hasRootsNonpos_of_isRealRooted_gammaTransform_of_natDegree_le + hδdeg hTprec.2.1.1 hTprec.2.1.2 + (roots_nonpos_of_hasNonnegCoeffs hTδnn) + have hsslen : ss.length = γ.natDegree := by + exact length_preferredRoots hγdeg hγ hγrr.1.2 + (roots_neg_of_nonnegCoeffs_of_coeff_zero_ne hγnn hγ0) + have hrslen : rs.length = δ.natDegree := by + exact length_preferredRoots hδdeg hδ hδrr.1.2 + (roots_neg_of_nonnegCoeffs_of_coeff_zero_ne hδnn hδ0) + have hmult := rootMultiplicity_bounds_of_prec hTprec (-1) + rw [rootMultiplicity_neg_one_gammaTransform hγdeg hγ, + rootMultiplicity_neg_one_gammaTransform hδdeg hδ] at hmult + have hdegcases : γ.natDegree = δ.natDegree ∨ + γ.natDegree + 1 = δ.natDegree := by + lia + have hsorted := hTprec.sorted_roots_shape + rw [sort_roots_gammaTransform_eq_reciprocalCenterRoots hγdeg hγ hTγneg, + sort_roots_gammaTransform_eq_reciprocalCenterRoots hδdeg hδ hTδneg] at hsorted + have hfull : + ListInterlaces + (reciprocalCenterRoots (d - 2 * γ.natDegree) ss) + (reciprocalCenterRoots (d + 1 - 2 * δ.natDegree) rs) := by + rcases hsorted with hsorted | hsorted + · exact hsorted.2 + · exfalso + simp [reciprocalCenterRoots] at hsorted + lia + have hpreferred : + ((ss.length + 1 = rs.length ∧ ListInterlaces ss rs) ∨ + (ss.length = rs.length ∧ ListAlternates ss rs)) := by + rcases hdegcases with hsame | hsucc + · right + have hlen : ss.length = rs.length := by lia + refine ⟨hlen, ?_⟩ + have hcenter : d + 1 - 2 * δ.natDegree = + (d - 2 * γ.natDegree) + 1 := by + lia + rw [hcenter] at hfull + exact (listInterlaces_reciprocalCenterRoots_same_iff + (d - 2 * γ.natDegree) hss hrs hlen).1 hfull + · left + have hlen : ss.length + 1 = rs.length := by lia + refine ⟨hlen, ?_⟩ + have hcenter : d - 2 * γ.natDegree = + (d + 1 - 2 * δ.natDegree) + 1 := by + lia + rw [hcenter] at hfull + exact (listInterlaces_reciprocalCenterRoots_succ_iff + (d + 1 - 2 * δ.natDegree) hss hrs hlen).1 hfull + have hγneg := roots_neg_of_nonnegCoeffs_of_coeff_zero_ne hγnn hγ0 + have hδneg := roots_neg_of_nonnegCoeffs_of_coeff_zero_ne hδnn hδ0 + refine ⟨hγrr.1, hδrr.1, ss.map gammaRootMap, rs.map gammaRootMap, + ?_, ?_, coe_map_gammaRootMap_preferredRoots hγdeg hγ hγneg, + coe_map_gammaRootMap_preferredRoots hδdeg hδ hδneg, ?_⟩ + · exact map_gammaRootMap_preferredRoots_pairwise d γ + · exact map_gammaRootMap_preferredRoots_pairwise (d + 1) δ + · rcases hpreferred with ⟨hlen, hint⟩ | ⟨hlen, halt⟩ + · left + refine ⟨by simpa using hlen, ?_⟩ + apply (listInterlaces_iff_interleaves_of_length (by simpa using hlen)).2 + apply (interleaves_map_gammaRootMap_iff hss hrs).2 + exact (listInterlaces_iff_interleaves_of_length hlen).1 hint + · right + refine ⟨by simpa using hlen, ?_⟩ + apply (listAlternates_iff_interleaves_of_length (by simpa using hlen)).2 + apply (interleaves_map_gammaRootMap_iff hrs hss).2 + exact (listAlternates_iff_interleaves_of_length hlen).1 halt + · intro hprec + have hγneg := roots_neg_of_nonnegCoeffs_of_coeff_zero_ne hγnn hγ0 + have hδneg := roots_neg_of_nonnegCoeffs_of_coeff_zero_ne hδnn hδ0 + have hsslen : ss.length = γ.natDegree := + length_preferredRoots hγdeg hγ hprec.1.2 hγneg + have hrslen : rs.length = δ.natDegree := + length_preferredRoots hδdeg hδ hprec.2.1.2 hδneg + have hsorted := hprec.sorted_roots_shape + rw [sort_roots_eq_map_gammaRootMap_preferredRoots hγdeg hγ hγneg, + sort_roots_eq_map_gammaRootMap_preferredRoots hδdeg hδ hδneg] at hsorted + have hpreferred : + ((ss.length + 1 = rs.length ∧ ListInterlaces ss rs) ∨ + (ss.length = rs.length ∧ ListAlternates ss rs)) := by + rcases hsorted with ⟨hlen, hint⟩ | ⟨hlen, halt⟩ + · left + have hlen' : ss.length + 1 = rs.length := by simpa using hlen + refine ⟨hlen', ?_⟩ + apply (listInterlaces_iff_interleaves_of_length hlen').2 + apply (interleaves_map_gammaRootMap_iff hss hrs).1 + exact (listInterlaces_iff_interleaves_of_length hlen).1 hint + · right + have hlen' : ss.length = rs.length := by simpa using hlen + refine ⟨hlen', ?_⟩ + apply (listAlternates_iff_interleaves_of_length hlen').2 + apply (interleaves_map_gammaRootMap_iff hrs hss).1 + exact (listAlternates_iff_interleaves_of_length hlen).1 halt + have hTγrr := + isRealRooted_gammaTransform_of_isRealRooted_of_hasNonnegCoeffs + hγdeg hγ hprec.1.2 hγnn + have hTδrr := + isRealRooted_gammaTransform_of_isRealRooted_of_hasNonnegCoeffs + hδdeg hδ hprec.2.1.2 hδnn + rcases hpreferred with ⟨hlen, hint⟩ | ⟨hlen, halt⟩ + · have hcenter : d - 2 * γ.natDegree = + (d + 1 - 2 * δ.natDegree) + 1 := by + rw [hsslen, hrslen] at hlen + lia + have hfull : + ListInterlaces + (reciprocalCenterRoots (d - 2 * γ.natDegree) ss) + (reciprocalCenterRoots (d + 1 - 2 * δ.natDegree) rs) := by + rw [hcenter] + exact (listInterlaces_reciprocalCenterRoots_succ_iff + (d + 1 - 2 * δ.natDegree) hss hrs hlen).2 hint + have hfull_len : + (reciprocalCenterRoots (d - 2 * γ.natDegree) ss).length + 1 = + (reciprocalCenterRoots (d + 1 - 2 * δ.natDegree) rs).length := by + simp [reciprocalCenterRoots, hsslen, hrslen] + lia + have hi := (listInterlaces_iff_interleaves_of_length hfull_len).1 hfull + refine ⟨hTγrr, hTδrr, + reciprocalCenterRoots (d - 2 * γ.natDegree) ss, + reciprocalCenterRoots (d + 1 - 2 * δ.natDegree) rs, + hi.pairwise_left, hi.pairwise_right, + coe_reciprocalCenterRoots_eq_roots hγdeg hγ hTγneg, + coe_reciprocalCenterRoots_eq_roots hδdeg hδ hTδneg, + Or.inl ⟨hfull_len, hfull⟩⟩ + · have hcenter : d + 1 - 2 * δ.natDegree = + (d - 2 * γ.natDegree) + 1 := by + rw [hsslen, hrslen] at hlen + lia + have hfull : + ListInterlaces + (reciprocalCenterRoots (d - 2 * γ.natDegree) ss) + (reciprocalCenterRoots (d + 1 - 2 * δ.natDegree) rs) := by + rw [hcenter] + exact (listInterlaces_reciprocalCenterRoots_same_iff + (d - 2 * γ.natDegree) hss hrs hlen).2 halt + have hfull_len : + (reciprocalCenterRoots (d - 2 * γ.natDegree) ss).length + 1 = + (reciprocalCenterRoots (d + 1 - 2 * δ.natDegree) rs).length := by + simp [reciprocalCenterRoots, hsslen, hrslen] + lia + have hi := (listInterlaces_iff_interleaves_of_length hfull_len).1 hfull + refine ⟨hTγrr, hTδrr, + reciprocalCenterRoots (d - 2 * γ.natDegree) ss, + reciprocalCenterRoots (d + 1 - 2 * δ.natDegree) rs, + hi.pairwise_left, hi.pairwise_right, + coe_reciprocalCenterRoots_eq_roots hγdeg hγ hTγneg, + coe_reciprocalCenterRoots_eq_roots hδdeg hδ hTδneg, + Or.inl ⟨hfull_len, hfull⟩⟩ + end RealRooted diff --git a/RealRooted/GarloffWagner.lean b/RealRooted/GarloffWagner.lean index 9df47d88..b0123273 100644 --- a/RealRooted/GarloffWagner.lean +++ b/RealRooted/GarloffWagner.lean @@ -1213,103 +1213,13 @@ theorem gwTheorem11Prec_of_rightWeightedExpansion rcases h hfg k with ⟨l, hf, hnonneg, hprec, hpos, hex⟩ exact gwJL_prec_of_rightWeightedExpansion hf hnonneg hprec hpos hex -private lemma listInterlaces_right_tail_ge : - ∀ {ss rs : List ℝ} {r : ℝ}, ListInterlaces ss (r :: rs) → ∀ x ∈ rs, r ≤ x - | [], [], _, _ => by simp - | [], _ :: _, _, h => by simp [ListInterlaces] at h - | _ :: _, [], _, _ => by simp - | s :: ss, r₂ :: rs, r, h => by - rcases h with ⟨hr_s, hs_r₂, htail⟩ - intro x hx - rcases List.mem_cons.mp hx with rfl | hx - · exact le_trans hr_s hs_r₂ - · exact le_trans (le_trans hr_s hs_r₂) - (listInterlaces_right_tail_ge htail x hx) - -private lemma listInterlaces_left_ge_head : - ∀ {ss rs : List ℝ} {r : ℝ}, ListInterlaces ss (r :: rs) → ∀ x ∈ ss, r ≤ x - | [], _, _, _ => by simp - | _ :: _, [], _, h => by simp [ListInterlaces] at h - | s :: ss, r₂ :: rs, r, h => by - rcases h with ⟨hr_s, hs_r₂, htail⟩ - intro x hx - rcases List.mem_cons.mp hx with rfl | hx - · exact hr_s - · exact le_trans (le_trans hr_s hs_r₂) - (listInterlaces_left_ge_head htail x hx) - -private lemma listInterlaces_count_right_le_left_add_one (u : ℝ) : - ∀ {ss rs : List ℝ}, ListInterlaces ss rs → rs.count u ≤ ss.count u + 1 - | [], [], _ => by simp - | [], [r], _ => by - by_cases hr : r = u <;> simp [hr] - | [], _ :: _ :: _, h => by simp [ListInterlaces] at h - | _ :: _, [], h => by simp [ListInterlaces] at h - | _ :: _, [_], h => by simp [ListInterlaces] at h - | s :: ss, r₁ :: r₂ :: rs, h => by - rcases h with ⟨hr₁s, hs_r₂, htail⟩ - by_cases hr₁ : r₁ = u - · by_cases hs : s = u - · subst r₁ - subst s - have ih := listInterlaces_count_right_le_left_add_one u htail - simp [List.count_cons] at ih ⊢ - lia - · subst r₁ - have hu_lt_s : u < s := lt_of_le_of_ne hr₁s (by simpa [eq_comm] using hs) - have hu_lt_r₂ : u < r₂ := lt_of_lt_of_le hu_lt_s hs_r₂ - have htail_no_mem : u ∉ r₂ :: rs := by - intro hu_mem - rcases List.mem_cons.mp hu_mem with hu_eq | hu_rs - · exact ne_of_gt hu_lt_r₂ hu_eq.symm - · have hge := listInterlaces_right_tail_ge htail u hu_rs - linarith - have htail_count : (r₂ :: rs).count u = 0 := - List.count_eq_zero.mpr htail_no_mem - have hss_no_mem : u ∉ ss := by - intro hu_mem - have hge := listInterlaces_left_ge_head htail u hu_mem - linarith - have hss_count : ss.count u = 0 := List.count_eq_zero.mpr hss_no_mem - simp [htail_count, hss_count, hs] - · have ih := listInterlaces_count_right_le_left_add_one u htail - by_cases hs : s = u - · simp [hr₁, hs] at ih ⊢ - lia - · simpa [hr₁, hs] using ih - -private lemma listAlternates_count_right_le_left_add_one (u : ℝ) : - ∀ {ss rs : List ℝ}, ListAlternates ss rs → rs.count u ≤ ss.count u + 1 - | [], [], _ => by simp - | [], _ :: _, h => by simp [ListAlternates] at h - | _ :: _, [], h => by simp [ListAlternates] at h - | s :: ss, _ :: rs, h => by - rcases h with ⟨_, htail⟩ - have ih := listInterlaces_count_right_le_left_add_one u htail - by_cases hs : s = u - · simp [hs] at ih ⊢ - lia - · simpa [hs] using ih - /-- Proper position forces every root of the right polynomial to occur on the left with multiplicity at least one less. This is the first multiplicity input for the Garloff--Wagner Lemma 7/Krein expansion. -/ theorem rootMultiplicity_sub_one_le_of_prec_right {f g : ℝ[X]} (h : Prec f g) (u : ℝ) : g.rootMultiplicity u - 1 ≤ f.rootMultiplicity u := by - rcases h with ⟨_, _, ss, rs, _, _, hss_eq, hrs_eq, hshape⟩ - have hcount : rs.count u ≤ ss.count u + 1 := by - rcases hshape with ⟨_, hint⟩ | ⟨_, halt⟩ - · exact listInterlaces_count_right_le_left_add_one u hint - · exact listAlternates_count_right_le_left_add_one u halt - have hrs_count : rs.count u = g.rootMultiplicity u := by - rw [← count_roots g, ← hrs_eq] - exact (Multiset.coe_count u rs).symm - have hss_count : ss.count u = f.rootMultiplicity u := by - rw [← count_roots f, ← hss_eq] - exact (Multiset.coe_count u ss).symm - rw [hrs_count, hss_count] at hcount - lia + exact (rootMultiplicity_bounds_of_prec h u).2 /-- If `f ≪ g` and `u` is a root of `g`, then `f` is divisible by all but one copy of the `u`-factor of `g`. This is the quotient of the left input diff --git a/RealRooted/GeneralizedSnakePosets/MatrixInduction.lean b/RealRooted/GeneralizedSnakePosets/MatrixInduction.lean index e24a389c..a8880b16 100644 --- a/RealRooted/GeneralizedSnakePosets/MatrixInduction.lean +++ b/RealRooted/GeneralizedSnakePosets/MatrixInduction.lean @@ -1,13 +1,14 @@ import RealRooted.GeneralizedSnakePosets.Statements import RealRooted.MatrixInterlacing +import RealRooted.PFPolynomial /-! # Braun-Jal matrix-induction step -This module isolates the local two-row matrix step used in Braun-Jal's proof -of Theorem 4.1. The theorem statements stay close to the paper recurrence: -the matrix with rows `[P_{m-1}, G_{m-1}]` and `[P_m, G_m]` acts on the -induction pair `[f, X * g]`. +This module isolates the local two-row matrix step used in Braun--Jal's proof +of Theorem 4.1 (arXiv:2607.00922v1, p. 10). The source matrix has rows +`[P_{m-1}, G_{m-1}]` and `[Q_m, H_m]`, where `Q_m = P_m - P_{m-1}` and +`H_m = G_m - G_{m-1}`, and acts on the induction pair `[f, X * g]`. -/ open Polynomial @@ -19,7 +20,8 @@ namespace GeneralizedSnakePosets /-- The two-row matrix for one Braun-Jal Theorem 4.1 induction step. -/ def theorem41StepMatrix (P G : ℕ → ℝ[X]) (m : ℕ) : List (List ℝ[X]) := - [[P (m - 1), G (m - 1)], [P m, G m]] + [[P (m - 1), G (m - 1)], + [narayanaDifference P m, auxiliaryDifference G m]] @[simp] theorem theorem41StepMatrix_length (P G : ℕ → ℝ[X]) (m : ℕ) : (theorem41StepMatrix P G m).length = 2 := by @@ -30,18 +32,22 @@ theorem theorem41StepMatrix_rect (P G : ℕ → ℝ[X]) (m : ℕ) : ∀ row ∈ theorem41StepMatrix P G m, row.length = 2 := by intro row hrow have hrow' : - row = [P (m - 1), G (m - 1)] ∨ row = [P m, G m] := by + row = [P (m - 1), G (m - 1)] ∨ + row = [narayanaDifference P m, auxiliaryDifference G m] := by simpa [theorem41StepMatrix] using hrow rcases hrow' with rfl | rfl <;> simp /-- Entrywise nonnegativity for the Braun-Jal step matrix. -/ theorem theorem41StepMatrix_entry_nonneg {P G : ℕ → ℝ[X]} {m : ℕ} (hP_nonneg : ∀ n, HasNonnegCoeffs (P n)) - (hG_nonneg : ∀ n, HasNonnegCoeffs (G n)) : + (hG_nonneg : ∀ n, HasNonnegCoeffs (G n)) + (hQ_nonneg : HasNonnegCoeffs (narayanaDifference P m)) + (hH_nonneg : HasNonnegCoeffs (auxiliaryDifference G m)) : ∀ row ∈ theorem41StepMatrix P G m, ∀ p ∈ row, HasNonnegCoeffs p := by intro row hrow p hp have hrow' : - row = [P (m - 1), G (m - 1)] ∨ row = [P m, G m] := by + row = [P (m - 1), G (m - 1)] ∨ + row = [narayanaDifference P m, auxiliaryDifference G m] := by simpa [theorem41StepMatrix] using hrow rcases hrow' with rfl | rfl · have hp' : p = P (m - 1) ∨ p = G (m - 1) := by @@ -49,18 +55,20 @@ theorem theorem41StepMatrix_entry_nonneg {P G : ℕ → ℝ[X]} {m : ℕ} rcases hp' with rfl | rfl · exact hP_nonneg (m - 1) · exact hG_nonneg (m - 1) - · have hp' : p = P m ∨ p = G m := by + · have hp' : + p = narayanaDifference P m ∨ p = auxiliaryDifference G m := by simpa using hp rcases hp' with rfl | rfl - · exact hP_nonneg m - · exact hG_nonneg m + · exact hQ_nonneg + · exact hH_nonneg /-- The step matrix action gives the two recurrence sums appearing in the nonconstant induction step. -/ theorem theorem41StepMatrix_action_pair (P G : ℕ → ℝ[X]) (m : ℕ) (f g : ℝ[X]) : matPolyAction (theorem41StepMatrix P G m) [f, X * g] = - [f * P (m - 1) + X * g * G (m - 1), f * P m + X * g * G m] := by + [f * P (m - 1) + X * g * G (m - 1), + f * narayanaDifference P m + X * g * auxiliaryDifference G m] := by simp [theorem41StepMatrix, matPolyAction, mul_comm, mul_left_comm] /-- The induction hypothesis `g << f` makes `[f, X * g]` a nonnegative @@ -79,17 +87,84 @@ theorem theorem41InputPair_interlacingSeqNonneg {f g : ℝ[X]} · rw [isInterlacingSeq_iff_pairwise] simp [prec_mul_X_of_prec_of_nonneg hgf hg_nonneg hf_nonneg] -/-- Claim `(7)` supplies the nontrivial cross `2 x 2` affine test for the -Braun-Jal step matrix. -/ -theorem theorem41StepMatrix_cross_has2x2_of_claim7 +/-- Claim `(6)` is exactly the cross `2 x 2` affine test for the source matrix +in Braun--Jal's proof of Theorem 4.1. -/ +theorem theorem41StepMatrix_cross_has2x2_of_matrixClaim + {P G : ℕ → ℝ[X]} (hclaim : Theorem41MatrixClaimStatement P G) + {m : ℕ} (hm : 2 ≤ m) : + Has2x2InterlacingProperty (P (m - 1)) (G (m - 1)) + (narayanaDifference P m) (auxiliaryDifference G m) := by + intro s t hs ht + exact hclaim hm hs.le ht.le + +/-- Claim `(6)` and the source matrix send the induction pair to a proper-position +pair. Repeated column indices use the real-rootedness already contained in the +same Claim `(6)` instance. -/ +theorem theorem41Step_difference_prec_of_matrixClaim + {P G : ℕ → ℝ[X]} {m : ℕ} {f g : ℝ[X]} + (hclaim : Theorem41MatrixClaimStatement P G) (hm : 2 ≤ m) + (hP_ne : P (m - 1) ≠ 0) + (hP_nonneg : ∀ n, HasNonnegCoeffs (P n)) + (hG_nonneg : ∀ n, HasNonnegCoeffs (G n)) + (hQ_nonneg : HasNonnegCoeffs (narayanaDifference P m)) + (hH_nonneg : HasNonnegCoeffs (auxiliaryDifference G m)) + (hgf : Prec g f) + (hf_nonneg : HasNonnegCoeffs f) (hg_nonneg : HasNonnegCoeffs g) : + Prec (f * P (m - 1) + X * g * G (m - 1)) + (f * narayanaDifference P m + X * g * auxiliaryDifference G m) := by + have hQ_ne : narayanaDifference P m ≠ 0 := by + have hzero := hclaim (m := m) (lam := 0) (mu := 0) hm (by norm_num) (by norm_num) + simpa using hzero.2.1.1 + have hpair := prec_zipWith_sum_pair_of_2x2 + (n := 2) (row₁ := [P (m - 1), G (m - 1)]) + (row₂ := [narayanaDifference P m, auxiliaryDifference G m]) + (fs := [f, X * g]) + (hn := by decide) + (hrow₁_len := by simp) + (hrow₂_len := by simp) + (hrow₁_head_ne := by simpa using hP_ne) + (hrow₂_head_ne := by simpa using hQ_ne) + (hrow₁_nonneg := by + intro p hp + simp only [List.mem_cons, List.not_mem_nil, or_false] at hp + rcases hp with rfl | rfl + · exact hP_nonneg (m - 1) + · exact hG_nonneg (m - 1)) + (hrow₂_nonneg := by + intro p hp + simp only [List.mem_cons, List.not_mem_nil, or_false] at hp + rcases hp with rfl | rfl + · exact hQ_nonneg + · exact hH_nonneg) + (h2x2 := by + intro j₁ j₂ hj + fin_cases j₁ <;> fin_cases j₂ + · intro s t hs ht + have hcross := hclaim (m := m) (lam := s) (mu := t) hm hs.le ht.le + simpa using prec_refl hcross.2.1.1 hcross.2.1.2 + · simpa using theorem41StepMatrix_cross_has2x2_of_matrixClaim hclaim hm + · simp at hj + · intro s t hs ht + have hcross := hclaim (m := m) (lam := s) (mu := t) hm hs.le ht.le + simpa using prec_refl hcross.1.1 hcross.1.2) + (hfs_len := by simp) + (hfs := theorem41InputPair_interlacingSeqNonneg hgf hf_nonneg hg_nonneg) + simpa [mul_comm, mul_left_comm] using hpair + +/-- Claim `(7)` supplies the cross affine test for the stronger consecutive-row +matrix with rows `[P_{m-1}, G_{m-1}]` and `[P_m, G_m]`. This is an auxiliary +route, not the matrix displayed in Braun--Jal's proof. -/ +theorem theorem41ConsecutiveMatrix_cross_has2x2_of_claim7 {P G : ℕ → ℝ[X]} (hclaim : Theorem41Claim7Statement P G) {m : ℕ} (hm : 2 ≤ m) : Has2x2InterlacingProperty (P (m - 1)) (G (m - 1)) (P m) (G m) := by intro s t hs ht exact hclaim (m := m) (lam := s) (nu := t) hm hs.le (by linarith) -/-- Claim `(7)`, the column interlacings, and the induction pair propagate -proper position through one nonconstant recurrence step. -/ +/-- A stronger alternative to the source matrix step: Claim `(7)` plus proper +position in both consecutive columns propagates the induction pair directly. +The paper instead applies Claim `(6)` to `theorem41StepMatrix` and then uses +Lemma 2.6. -/ theorem theorem41Step_prec_of_claim7 {P G : ℕ → ℝ[X]} {m : ℕ} {f g : ℝ[X]} (hclaim : Theorem41Claim7Statement P G) (hm : 2 ≤ m) @@ -105,7 +180,7 @@ theorem theorem41Step_prec_of_claim7 have hpair := prec_add_mul_pair_of_2x2 (p₁ := P (m - 1)) (q₁ := G (m - 1)) (p₂ := P m) (q₂ := G m) (u := f) (v := X * g) - hP hG (theorem41StepMatrix_cross_has2x2_of_claim7 hclaim hm) hinput + hP hG (theorem41ConsecutiveMatrix_cross_has2x2_of_claim7 hclaim hm) hinput (hP_nonneg (m - 1)) (hG_nonneg (m - 1)) (hP_nonneg m) (hG_nonneg m) hf_nonneg hg_nonneg.X_mul simpa [mul_comm, mul_left_comm] using hpair @@ -159,6 +234,78 @@ theorem theorem41NonconstantStep_prec_of_claim7 (hM_nonneg (w.takePrefix (k + 1))) (hM_nonneg (w.takePrefix k)) rwa [hrec_del, hrec_w] +/-- The nonconstant Braun--Jal induction step through the source +`[P, G; Q, H]` matrix. Unlike the consecutive-row shortcut above, this is the +argument on p. 10 of the paper and requires no adjacent-`G` proper position. -/ +theorem theorem41NonconstantStep_prec_of_matrixClaim + {M : SnakeWord → ℝ[X]} {P G : ℕ → ℝ[X]} {w : SnakeWord} {k : ℕ} + (hrec : Theorem35GeneralizedSnakeRecurrenceStatement M P G) + (hclaim : Theorem41MatrixClaimStatement P G) + (hlast : w.IsLastChangeIndex k) + (hk : k + 1 < w.deleteFinal.length) + (hP_ne : ∀ n, P n ≠ 0) + (hP_nonneg : ∀ n, HasNonnegCoeffs (P n)) + (hG_nonneg : ∀ n, HasNonnegCoeffs (G n)) + (hQ_nonneg : ∀ {m : ℕ}, 2 ≤ m → + HasNonnegCoeffs (narayanaDifference P m)) + (hH_nonneg : ∀ {m : ℕ}, 2 ≤ m → + HasNonnegCoeffs (auxiliaryDifference G m)) + (hprefix : Prec (M (w.takePrefix k)) (M (w.takePrefix (k + 1)))) + (hM_nonneg : ∀ u, HasNonnegCoeffs (M u)) : + Prec (M w.deleteFinal) (M w) := by + let f : ℝ[X] := M (w.takePrefix (k + 1)) + let g : ℝ[X] := M (w.takePrefix k) + let m : ℕ := w.length - (k + 1) + have hm : 2 ≤ m := by + dsimp [m] + rw [SnakeWord.length_deleteFinal] at hk + lia + have hkp1_le : k + 1 ≤ w.deleteFinal.length := le_of_lt hk + have hk_le : k ≤ w.deleteFinal.length := by lia + have hrec_w : M w = f * P m + X * g * G m := by + dsimp [f, g, m] + exact hrec hlast.not_isConstant hlast + have hlast_del : w.deleteFinal.IsLastChangeIndex k := hlast.deleteFinal hk + have hrec_del : + M w.deleteFinal = f * P (m - 1) + X * g * G (m - 1) := by + have hbase := hrec hlast_del.not_isConstant hlast_del + dsimp [f, g, m] + rw [hbase] + rw [SnakeWord.takePrefix_deleteFinal_eq_takePrefix_of_le hkp1_le] + rw [SnakeWord.takePrefix_deleteFinal_eq_takePrefix_of_le hk_le] + rw [SnakeWord.length_deleteFinal_sub_eq] + have hrec_diff : + M w - M w.deleteFinal = + f * narayanaDifference P m + X * g * auxiliaryDifference G m := by + rw [hrec_w, hrec_del] + unfold narayanaDifference auxiliaryDifference + ring + have hf_nonneg : HasNonnegCoeffs f := hM_nonneg _ + have hg_nonneg : HasNonnegCoeffs g := hM_nonneg _ + have hdiff_nonneg : HasNonnegCoeffs (M w - M w.deleteFinal) := by + rw [hrec_diff] + exact (hf_nonneg.mul (hQ_nonneg hm)).add + (hg_nonneg.X_mul.mul (hH_nonneg hm)) + have hstep : Prec (M w.deleteFinal) (M w - M w.deleteFinal) := by + have hstep_raw := theorem41Step_difference_prec_of_matrixClaim + hclaim hm (hP_ne (m - 1)) hP_nonneg hG_nonneg + (hQ_nonneg hm) (hH_nonneg hm) hprefix hf_nonneg hg_nonneg + rw [← hrec_del, ← hrec_diff] at hstep_raw + exact hstep_raw + have hsum0 : Prec0 (M w.deleteFinal) + (M w.deleteFinal + (M w - M w.deleteFinal)) := + prec0_add_right_of_common_left_of_nonneg + (prec_refl hstep.1.1 hstep.1.2).toPrec0 hstep.toPrec0 + (hM_nonneg w.deleteFinal) hdiff_nonneg + have hsum_ne : M w.deleteFinal + (M w - M w.deleteFinal) ≠ 0 := + add_ne_zero_of_hasNonnegCoeffs_of_right_ne_zero + (hM_nonneg w.deleteFinal) hdiff_nonneg hstep.2.1.1 + have hfinal := hsum0.toPrec_of_ne hstep.1.1 hsum_ne + have hsum_eq : M w.deleteFinal + (M w - M w.deleteFinal) = M w := by + ring + rw [hsum_eq] at hfinal + exact hfinal + /-- Polynomial form of the exceptional `m = 1` Braun-Jal step. If `g ≪ f` and both polynomials have nonnegative coefficients, then @@ -218,40 +365,6 @@ theorem theorem41StepOne_prec_of_recurrence (hM_nonneg (w.takePrefix (k + 1))) (hM_nonneg (w.takePrefix k)) rwa [hdel, hrec_w] -/-- Matrix Claim `(6)` gives the same recurrence-step proper-position result -via the existing Claim `(6)`/Claim `(7)` reindexing. -/ -theorem theorem41Step_prec_of_matrixClaim - {P G : ℕ → ℝ[X]} {m : ℕ} {f g : ℝ[X]} - (hclaim : Theorem41MatrixClaimStatement P G) (hm : 2 ≤ m) - (hP : Prec (P (m - 1)) (P m)) (hG : Prec (G (m - 1)) (G m)) - (hgf : Prec g f) - (hP_nonneg : ∀ n, HasNonnegCoeffs (P n)) - (hG_nonneg : ∀ n, HasNonnegCoeffs (G n)) - (hf_nonneg : HasNonnegCoeffs f) (hg_nonneg : HasNonnegCoeffs g) : - Prec (f * P (m - 1) + X * g * G (m - 1)) - (f * P m + X * g * G m) := - theorem41Step_prec_of_claim7 - ((theorem41MatrixClaim_iff_claim7 P G).mp hclaim) hm - hP hG hgf hP_nonneg hG_nonneg hf_nonneg hg_nonneg - -/-- Matrix Claim `(6)` version of the nonconstant word-level recurrence step. -/ -theorem theorem41NonconstantStep_prec_of_matrixClaim - {M : SnakeWord → ℝ[X]} {P G : ℕ → ℝ[X]} {w : SnakeWord} {k : ℕ} - (hrec : Theorem35GeneralizedSnakeRecurrenceStatement M P G) - (hclaim : Theorem41MatrixClaimStatement P G) - (hlast : w.IsLastChangeIndex k) - (hk : k + 1 < w.deleteFinal.length) - (hP : ∀ {m : ℕ}, 2 ≤ m → Prec (P (m - 1)) (P m)) - (hG : ∀ {m : ℕ}, 2 ≤ m → Prec (G (m - 1)) (G m)) - (hprefix : Prec (M (w.takePrefix k)) (M (w.takePrefix (k + 1)))) - (hP_nonneg : ∀ n, HasNonnegCoeffs (P n)) - (hG_nonneg : ∀ n, HasNonnegCoeffs (G n)) - (hM_nonneg : ∀ u, HasNonnegCoeffs (M u)) : - Prec (M w.deleteFinal) (M w) := - theorem41NonconstantStep_prec_of_claim7 - (P := P) (G := G) hrec ((theorem41MatrixClaim_iff_claim7 P G).mp hclaim) - hlast hk hP hG hprefix hP_nonneg hG_nonneg hM_nonneg - /-- Length-induction skeleton for Braun-Jal Theorem 4.1. If every nonconstant word step turns the prefix induction hypothesis into @@ -432,6 +545,79 @@ theorem theorem41_of_claim7_of_constant_cases (M := M) (P := P) (G := G) (w := w) (k := k) hrec hP_one hG_one hlast hsuffix hprefix_prec hM_nonneg +/-- Source-matrix length induction from Claim `(6)` to Braun--Jal Theorem 4.1. + +The long-suffix branch uses the displayed `[P, G; Q, H]` matrix, while the +suffix-one branch uses `P_1 = 1 + X` and `G_1 = 1`. In particular, no +adjacent-`G` proper-position hypothesis occurs. -/ +theorem theorem41_of_matrixClaim_of_constant_cases + {M : SnakeWord → ℝ[X]} {P G : ℕ → ℝ[X]} + (hrec : Theorem35GeneralizedSnakeRecurrenceStatement M P G) + (hclaim : Theorem41MatrixClaimStatement P G) + (hP_ne : ∀ n, P n ≠ 0) + (hP_one : P 1 = 1 + X) (hG_one : G 1 = 1) + (hP_nonneg : ∀ n, HasNonnegCoeffs (P n)) + (hG_nonneg : ∀ n, HasNonnegCoeffs (G n)) + (hQ_nonneg : ∀ {m : ℕ}, 2 ≤ m → + HasNonnegCoeffs (narayanaDifference P m)) + (hH_nonneg : ∀ {m : ℕ}, 2 ≤ m → + HasNonnegCoeffs (auxiliaryDifference G m)) + (hM_nonneg : ∀ w, HasNonnegCoeffs (M w)) + (hdeg : + ∀ {w : SnakeWord}, 1 ≤ w.length → + (M w.deleteFinal).natDegree + 1 = (M w).natDegree) + (hconst : + ∀ {w : SnakeWord}, 1 ≤ w.length → w.IsConstant → + (M w ≠ 0 ∧ (M w).Splits) ∧ Interlaces (M w.deleteFinal) (M w)) : + Theorem41NonNestingRookStatement M := by + refine theorem41_of_prec_step (M := M) ?_ hdeg hconst + intro w k _hconstw hlast hprefix_prec + by_cases hk : k + 1 < w.deleteFinal.length + · exact theorem41NonconstantStep_prec_of_matrixClaim + (M := M) (P := P) (G := G) (w := w) (k := k) + hrec hclaim hlast hk hP_ne hP_nonneg hG_nonneg + hQ_nonneg hH_nonneg hprefix_prec hM_nonneg + · have hsuffix : w.length - (k + 1) = 1 := by + rw [SnakeWord.length_deleteFinal] at hk + have hlast_suffix := hlast.succ_lt_length + lia + exact theorem41StepOne_prec_of_recurrence + (M := M) (P := P) (G := G) (w := w) (k := k) + hrec hP_one hG_one hlast hsuffix hprefix_prec hM_nonneg + +/-- Source-matrix induction with the constant branch reduced to the concrete +successor-length identity `M w = P (w.length + 1)`. -/ +theorem theorem41_of_matrixClaim_of_constant_matches_succ_length + {M : SnakeWord → ℝ[X]} {P G : ℕ → ℝ[X]} + (hrec : Theorem35GeneralizedSnakeRecurrenceStatement M P G) + (hclaim : Theorem41MatrixClaimStatement P G) + (hP_ne : ∀ n, P n ≠ 0) + (hP_interlaces : ∀ n : ℕ, Interlaces (P n) (P (n + 1))) + (hP_one : P 1 = 1 + X) (hG_one : G 1 = 1) + (hP_nonneg : ∀ n, HasNonnegCoeffs (P n)) + (hG_nonneg : ∀ n, HasNonnegCoeffs (G n)) + (hQ_nonneg : ∀ {m : ℕ}, 2 ≤ m → + HasNonnegCoeffs (narayanaDifference P m)) + (hH_nonneg : ∀ {m : ℕ}, 2 ≤ m → + HasNonnegCoeffs (auxiliaryDifference G m)) + (hM_nonneg : ∀ w, HasNonnegCoeffs (M w)) + (hdeg : + ∀ {w : SnakeWord}, 1 ≤ w.length → + (M w.deleteFinal).natDegree + 1 = (M w).natDegree) + (hM_const : ∀ {w : SnakeWord}, w.IsConstant → + M w = P (w.length + 1)) : + Theorem41NonNestingRookStatement M := by + have hconst : + ∀ {w : SnakeWord}, 1 ≤ w.length → w.IsConstant → + (M w ≠ 0 ∧ (M w).Splits) ∧ Interlaces (M w.deleteFinal) (M w) := + theorem41_constant_of_matches_succ_length + (M := M) (P := P) hM_const hP_interlaces + intro w hw + exact theorem41_of_matrixClaim_of_constant_cases + (M := M) (P := P) (G := G) hrec hclaim hP_ne hP_one hG_one + hP_nonneg hG_nonneg hQ_nonneg hH_nonneg hM_nonneg hdeg hconst + (w := w) hw + /-- The deletion degree bridge follows from the length-indexed degree formula for the whole snake-word family. -/ theorem theorem41_degree_bridge_of_natDegree_length @@ -589,32 +775,6 @@ theorem theorem41InductionRoute_of_claim7_of_constant_matches_succ_length (hP_nonneg := hP_nonneg) (hG_nonneg := hG_nonneg) (hM_nonneg := hM_nonneg) (hdeg := hdeg) (hM_const := hM_const) -/-- Matrix Claim `(6)` version of the abstract route bridge, using the -successor-length constant-word identity from the concrete indexing. -/ -theorem theorem41InductionRoute_of_matrixClaim_of_constant_matches_succ_length - {M : SnakeWord → ℝ[X]} {P G : ℕ → ℝ[X]} - (hmatrix_of_inputs : - Lemma33AuxiliaryGInterlacesStatement P G → - Lemma34ModifiedNarayanaInterlacingStatement P → - Theorem41MatrixClaimStatement P G) - (hP_interlaces : ∀ n : ℕ, Interlaces (P n) (P (n + 1))) - (hG : ∀ {m : ℕ}, 2 ≤ m → Prec (G (m - 1)) (G m)) - (hP_one : P 1 = 1 + X) (hG_one : G 1 = 1) - (hP_nonneg : ∀ n, HasNonnegCoeffs (P n)) - (hG_nonneg : ∀ n, HasNonnegCoeffs (G n)) - (hM_nonneg : ∀ w, HasNonnegCoeffs (M w)) - (hdeg : - ∀ {w : SnakeWord}, 1 ≤ w.length → - (M w.deleteFinal).natDegree + 1 = (M w).natDegree) - (hM_const : ∀ {w : SnakeWord}, w.IsConstant → M w = P (w.length + 1)) : - Theorem41InductionRouteStatement M P G := - theorem41InductionRoute_of_claim7_of_constant_matches_succ_length - (M := M) (P := P) (G := G) - (fun h33 h34 => (theorem41MatrixClaim_iff_claim7 P G).mp - (hmatrix_of_inputs h33 h34)) - hP_interlaces hG hP_one hG_one hP_nonneg hG_nonneg hM_nonneg hdeg - hM_const - /-- Section 3 equation `(2)` plus the local Claim `(7)` side conditions give the abstract induction route, using the concrete successor-length indexing for constant words. diff --git a/RealRooted/GeneralizedSnakePosets/Narayana/Claim7.lean b/RealRooted/GeneralizedSnakePosets/Narayana/Claim7.lean index e80bc986..042554da 100644 --- a/RealRooted/GeneralizedSnakePosets/Narayana/Claim7.lean +++ b/RealRooted/GeneralizedSnakePosets/Narayana/Claim7.lean @@ -165,11 +165,13 @@ private theorem prec_narayanaPolynomial_two (n : ℕ) : simpa [Nat.succ_eq_add_one, Nat.add_assoc] using prec_narayanaPolynomial_succ 2 n -/-- Consecutive auxiliary polynomials are in proper position once the rook -model identifies `G n` with `n` times the parameter-two generalized Narayana -polynomial. This identity is accepted as combinatorial input: formalizing its -board bijection is outside scope, while the proper-position deduction is -proved here from the generalized Narayana recurrence. -/ +/-- Consecutive auxiliary polynomials are in proper position under an additional +identification with parameter-two generalized Narayana polynomials. + +This identity is not an input used in Braun--Jal's proof of Theorem 4.1; their +proof instead uses the `[P, G; Q, H]` matrix and Claim `(6)`. This theorem is +therefore an optional stronger route and `hG_model` requires an independent +justification. -/ theorem auxiliaryG_prec_succ_of_narayanaTwoModel (hG_model : ∀ n : ℕ, 1 ≤ n → FiniteSkewBoard.auxiliaryG n = @@ -221,13 +223,52 @@ theorem theorem41NonNestingRook_modified_of_modelInputs_of_adjacentG (lemma33AuxiliaryGInterlaces_modified hrec2 hH_nonneg) lemma34ModifiedNarayanaInterlacing_modified hrec -/-- -Braun--Jal Theorem 4.1 from combinatorial model inputs. The hypotheses below are an intentional -trust boundary: in particular, `hG_model` records only the rook-model identification from the -paper, whose full rook and order-polytope models are outside the scope of this project. They do -not assume interlacing or real-rootedness; those conclusions are derived here from the formalized -recurrence and generalized Narayana theory. --/ +/-- Braun--Jal Theorem 4.1 through the source `[P, G; Q, H]` matrix. + +The hypotheses are the intended combinatorial trust boundary. Equation `(2)`, +nonnegativity of the board difference `H`, Theorem 3.5, the degree identity, +and the constant-word staircase identity come from the non-nesting-rook model; +formalizing that complete model is outside the present scope. No hypothesis +assumes real-rootedness, interlacing, proper position, or splitting. -/ +theorem theorem41NonNestingRook_modified_of_sourceInputs + {M : SnakeWord → ℝ[X]} + (hrec2 : NarayanaAuxiliaryGRecurrenceStatement + modifiedNarayanaPolynomial FiniteSkewBoard.auxiliaryG) + (hH_nonneg : ∀ n : ℕ, 1 ≤ n → + HasNonnegCoeffs + (FiniteSkewBoard.auxiliaryG n - + FiniteSkewBoard.auxiliaryG (n - 1))) + (hrec : Theorem35GeneralizedSnakeRecurrenceStatement M + modifiedNarayanaPolynomial FiniteSkewBoard.auxiliaryG) + (hM_nonneg : ∀ w : SnakeWord, HasNonnegCoeffs (M w)) + (hdeg : ∀ {w : SnakeWord}, 1 ≤ w.length → + (M w.deleteFinal).natDegree + 1 = (M w).natDegree) + (hM_const : ∀ {w : SnakeWord}, w.IsConstant → + M w = modifiedNarayanaPolynomial (w.length + 1)) : + Theorem41NonNestingRookStatement M := by + exact theorem41_of_matrixClaim_of_constant_matches_succ_length + (M := M) (P := modifiedNarayanaPolynomial) + (G := FiniteSkewBoard.auxiliaryG) + hrec + ((theorem41MatrixClaim_iff_claim7 _ _).mpr + (theorem41Claim7_modified hrec2 hH_nonneg)) + modifiedNarayanaPolynomial_ne_zero + modifiedNarayanaPolynomial_interlaces_succ + modifiedNarayanaPolynomial_one FiniteSkewBoard.auxiliaryG_one + modifiedNarayanaPolynomial_hasNonnegCoeffs + FiniteSkewBoard.auxiliaryG_hasNonnegCoeffs + (fun {_m} hm => narayanaDifference_modified_hasNonnegCoeffs (by lia)) + (fun {_m} hm => by + simpa [auxiliaryDifference] using hH_nonneg _ (by lia)) + hM_nonneg hdeg hM_const + +/-- An alternative Theorem 4.1 endpoint using the additional generalized +Narayana identity `hG_model`. + +Braun--Jal do not use or state this identity in their proof. The source-faithful +route goes through the `[P, G; Q, H]` matrix and Claim `(6)`, so this result must +not be presented as depending only on the paper's combinatorial boundary facts. +It remains useful when `hG_model` is independently established. -/ theorem theorem41NonNestingRook_modified_of_modelInputs {M : SnakeWord → ℝ[X]} (hrec2 : NarayanaAuxiliaryGRecurrenceStatement diff --git a/RealRooted/GeneralizedSnakePosets/Statements.lean b/RealRooted/GeneralizedSnakePosets/Statements.lean index e247466d..e3235817 100644 --- a/RealRooted/GeneralizedSnakePosets/Statements.lean +++ b/RealRooted/GeneralizedSnakePosets/Statements.lean @@ -23,8 +23,13 @@ namespace GeneralizedSnakePosets universe u -/-- Statement interface for Braun--Jal Theorem 4.1, with the non-nesting rook -polynomial supplied as a parameter. -/ +/-- Braun--Jal Theorem 4.1, abstracted over the polynomial model. + +The source theorem concerns the concrete non-nesting rook polynomial `M_w`: it +asserts real-rootedness and that deleting the final letter gives +`M_{w'} << M_w`. This interface is only an abstract package for arbitrary `M`. +A source-facing theorem must instantiate `generalizedSnakeRookModel` and prove +the degree and model-identification bridges needed to use local `Interlaces`. -/ def Theorem41NonNestingRookStatement (M : SnakeWord → ℝ[X]) : Prop := ∀ {w : SnakeWord}, 1 ≤ w.length → (M w ≠ 0 ∧ (M w).Splits) ∧ diff --git a/RealRooted/Hadamard.lean b/RealRooted/Hadamard.lean index 84e61573..c6f507e6 100644 --- a/RealRooted/Hadamard.lean +++ b/RealRooted/Hadamard.lean @@ -2743,12 +2743,18 @@ theorem hadamardPreservesHurwitzMatrixTNDetLeThree_of_matrixTN hadamardPreservesHurwitzMatrixTNDetLeThreeStatement := fun {_a _b} ha hb {_n} {_rows} {_cols} hrows hcols _hn => h ha hb hrows hcols -/-- The Hurwitz-matrix Hadamard leaf reduces to the pure matrix Schur core. +/-- Legacy reduction to the false unrestricted Hurwitz Schur interface. Using `hurwitz_mul_entrywise_matrix`, this strips away the coefficient bookkeeping from `hadamardPreservesHurwitzMatrixTNStatement`; the remaining input is only that entrywise products of totally nonnegative Hurwitz matrices -are totally nonnegative. -/ +are totally nonnegative. + +This implication is logically valid but unusable: `HurwitzMatrix.lean` proves +`not_hurwitzMatrixSchurProductTNStatement`. Garloff--Wagner, *Hadamard +products of stable polynomials are stable*, J. Math. Anal. Appl. 202 (1996), +797--809, Theorem 13, does not supply this unrestricted infinite-matrix +hypothesis. -/ theorem hadamardPreservesHurwitzMatrixTN_of_schur (hSchur : HurwitzMatrixSchurProductTNStatement) : hadamardPreservesHurwitzMatrixTNStatement := @@ -3526,6 +3532,15 @@ theorem polyaFrequencyHadamardCoeff_of_schurPolyaWagner (hSPW (IsPFPolynomial.of_sequence hASW hp) (IsPFPolynomial.of_sequence hASW hq)).to_sequence +/-- Polynomial-coefficient Pólya-frequency closure from Schur--Pólya--Wagner, +using the proved forward ASW theorem rather than a caller-supplied backend. -/ +theorem polyaFrequencyHadamardCoeff_of_schurPolyaWagner_asw + (hSPW : schurPolyaWagnerHadamardPFStatement) : + polyaFrequencyHadamardCoeffStatement := + fun hp hq => + (hSPW (IsPFPolynomial.of_polyaFreqSeq hp) + (IsPFPolynomial.of_polyaFreqSeq hq)).to_sequence + theorem polyaFrequencyHadamardCoeff_of_garloffWagner_prec0 (hASW : aissenSchoenbergWhitneyForwardOrZeroStatement) (hGW : garloffWagnerHadamardPFPrec0Statement) : diff --git a/RealRooted/HosterStumpInterlacing.lean b/RealRooted/HosterStumpInterlacing.lean index bb154916..9865caf9 100644 --- a/RealRooted/HosterStumpInterlacing.lean +++ b/RealRooted/HosterStumpInterlacing.lean @@ -21,6 +21,15 @@ def SourcePrec (f g : ℝ[X]) : Prop := (f = 0 ∨ g = 0 ∨ (f.natDegree ≤ 1 ∧ g.natDegree ≤ 1) ∨ Prec f g) +lemma SourcePrec.of_prec {f g : ℝ[X]} (h : Prec f g) : SourcePrec f g := + ⟨Or.inr h.1, Or.inr h.2.1, Or.inr (Or.inr (Or.inr h))⟩ + +lemma SourcePrec.of_lowDegree {f g : ℝ[X]} + (hf : IsSourceRealRooted f) (hg : IsSourceRealRooted g) + (hfdeg : f.natDegree ≤ 1) (hgdeg : g.natDegree ≤ 1) : + SourcePrec f g := + ⟨hf, hg, Or.inr (Or.inr (Or.inl ⟨hfdeg, hgdeg⟩))⟩ + /-- Source-faithful interlacing sequences from Hoster--Stump, Section 2 and Lemma 2.3. Empty lists are admitted as a harmless Lean extension; unlike the weak `IsInterlacingSeq0Nonneg`, singleton lists still record real-rootedness. -/ @@ -51,6 +60,151 @@ def xShiftedSplitSums (fs : List ℝ[X]) : List ℝ[X] := (List.range (fs.length + 1)).map fun k => X * (fs.take k).sum + (fs.drop k).sum +/-! +## The source low-degree convention + +Hoster--Stump, arXiv:2508.15538, p. 4, declares every pair of polynomials of +degree zero or one to interlace. With that convention, Lemma 2.3(2) is false +for mixed linear/quadratic sequences. The following exact example records the +obstruction; in particular, the source-exact predicate must not be used as the +hypothesis of an unconditional lower-partial-sum preservation theorem. +-/ + +def lowDegreeCounterexampleLeft : ℝ[X] := X + C 1 + +def lowDegreeCounterexampleMiddle : ℝ[X] := C 2 * (X + C 3) + +def lowDegreeCounterexampleRight : ℝ[X] := (X + C 1) * (X + C 3) + +private lemma lowDegreeCounterexample_left_prec_right : + Prec lowDegreeCounterexampleLeft lowDegreeCounterexampleRight := by + have hbase : Prec (1 : ℝ[X]) (X + C 3) := + (interlaces_one_linear (Polynomial.natDegree_X_add_C (3 : ℝ))).toPrec + have hlinear := isRealRooted_of_degree_one + (Polynomial.natDegree_X_add_C (1 : ℝ)) + have hcommon := prec_mul_common_factor + (d := X + C 1) (f := 1) (g := X + C 3) hlinear.1 hlinear.2 hbase + simpa [lowDegreeCounterexampleLeft, lowDegreeCounterexampleRight] using hcommon + +private lemma lowDegreeCounterexample_middle_prec_right : + Prec lowDegreeCounterexampleMiddle lowDegreeCounterexampleRight := by + have hbase : Prec (1 : ℝ[X]) (X + C 1) := + (interlaces_one_linear (Polynomial.natDegree_X_add_C (1 : ℝ))).toPrec + have hlinear := isRealRooted_of_degree_one + (Polynomial.natDegree_X_add_C (3 : ℝ)) + have hcommon := prec_mul_common_factor + (d := X + C 3) (f := 1) (g := X + C 1) hlinear.1 hlinear.2 hbase + have hscaled := prec_C_mul_left hcommon (by norm_num : (2 : ℝ) ≠ 0) + simpa [lowDegreeCounterexampleMiddle, lowDegreeCounterexampleRight, mul_comm] + using hscaled + +/-- The degree-at-most-one convention makes the source version of +Hoster--Stump Lemma 2.3(2) false. The input is source-interlacing, but its first +and third lower partial sums are `X + 1` and `(X + 2) * (X + 5)`, respectively. +-/ +theorem source_lowerPartialSums_counterexample : + IsInterlacingSeq + [lowDegreeCounterexampleLeft, lowDegreeCounterexampleMiddle, + lowDegreeCounterexampleRight] ∧ + ¬IsInterlacingSeq + (lowerPartialSums + [lowDegreeCounterexampleLeft, lowDegreeCounterexampleMiddle, + lowDegreeCounterexampleRight]) := by + have hlr := lowDegreeCounterexample_left_prec_right + have hmr := lowDegreeCounterexample_middle_prec_right + have hlrr : IsSourceRealRooted lowDegreeCounterexampleLeft := Or.inr hlr.1 + have hmrr : IsSourceRealRooted lowDegreeCounterexampleMiddle := Or.inr hmr.1 + have hrrr : IsSourceRealRooted lowDegreeCounterexampleRight := Or.inr hlr.2.1 + have hlm : SourcePrec lowDegreeCounterexampleLeft lowDegreeCounterexampleMiddle := + SourcePrec.of_lowDegree hlrr hmrr + (by simpa [lowDegreeCounterexampleLeft] using + (Polynomial.natDegree_X_add_C (1 : ℝ)).le) + (by + rw [lowDegreeCounterexampleMiddle, + natDegree_mul (by norm_num) + (isRealRooted_of_degree_one + (Polynomial.natDegree_X_add_C (3 : ℝ))).1] + simp) + have hlr' : SourcePrec lowDegreeCounterexampleLeft lowDegreeCounterexampleRight := + SourcePrec.of_prec hlr + have hmr' : SourcePrec lowDegreeCounterexampleMiddle lowDegreeCounterexampleRight := + SourcePrec.of_prec hmr + constructor + · refine ⟨?_, ?_, ?_⟩ + · intro f hf + simp only [List.mem_cons, List.not_mem_nil, or_false] at hf + rcases hf with rfl | rfl | rfl + · exact hasNonnegCoeffs_X_add_C (by norm_num) + · exact (hasNonnegCoeffs_C (by norm_num)).mul + (hasNonnegCoeffs_X_add_C (by norm_num)) + · exact (hasNonnegCoeffs_X_add_C (by norm_num)).mul + (hasNonnegCoeffs_X_add_C (by norm_num)) + · intro f hf + simp only [List.mem_cons, List.not_mem_nil, or_false] at hf + rcases hf with rfl | rfl | rfl + · exact hlrr + · exact hmrr + · exact hrrr + · simpa using (show + (SourcePrec lowDegreeCounterexampleLeft lowDegreeCounterexampleMiddle ∧ + SourcePrec lowDegreeCounterexampleLeft lowDegreeCounterexampleRight) ∧ + SourcePrec lowDegreeCounterexampleMiddle lowDegreeCounterexampleRight from + ⟨⟨hlm, hlr'⟩, hmr'⟩) + · intro hout + have hsum : + lowerPartialSums + [lowDegreeCounterexampleLeft, lowDegreeCounterexampleMiddle, + lowDegreeCounterexampleRight] = + [lowDegreeCounterexampleLeft, + lowDegreeCounterexampleLeft + lowDegreeCounterexampleMiddle, + lowDegreeCounterexampleLeft + + (lowDegreeCounterexampleMiddle + lowDegreeCounterexampleRight)] := by + simp [lowerPartialSums] + have hfactor : + lowDegreeCounterexampleLeft + + (lowDegreeCounterexampleMiddle + lowDegreeCounterexampleRight) = + (X + C 2) * (X + C 5) := by + simp only [lowDegreeCounterexampleLeft, lowDegreeCounterexampleMiddle, + lowDegreeCounterexampleRight] + rw [show C (1 : ℝ) = (1 : ℝ[X]) by exact map_one C, + show C (2 : ℝ) = (2 : ℝ[X]) by exact map_ofNat C 2, + show C (3 : ℝ) = (3 : ℝ[X]) by exact map_ofNat C 3, + show C (5 : ℝ) = (5 : ℝ[X]) by exact map_ofNat C 5] + ring + have hpairs := hout.pairwise + rw [hsum] at hpairs + have hfirstLast : + SourcePrec lowDegreeCounterexampleLeft + (lowDegreeCounterexampleLeft + + (lowDegreeCounterexampleMiddle + lowDegreeCounterexampleRight)) := + (List.pairwise_cons.mp hpairs).1 _ (by simp) + rw [hfactor] at hfirstLast + have htwo := isRealRooted_of_degree_one + (Polynomial.natDegree_X_add_C (2 : ℝ)) + have hfive := isRealRooted_of_degree_one + (Polynomial.natDegree_X_add_C (5 : ℝ)) + rcases hfirstLast.2.2 with hzero | hzero | hlow | hprec + · exact hlr.1.1 hzero + · exact (mul_ne_zero htwo.1 hfive.1) hzero + · have hdeg : ((X + C 2) * (X + C 5) : ℝ[X]).natDegree = 2 := by + rw [natDegree_mul htwo.1 hfive.1] + simp + lia + · have hbound : ∀ r ∈ ((X + C 2) * (X + C 5) : ℝ[X]).roots, r ≤ -2 := by + intro r hr + rw [roots_mul (mul_ne_zero htwo.1 hfive.1), roots_X_add_C, + roots_X_add_C] at hr + simp only [Multiset.mem_add, Multiset.mem_singleton] at hr + rcases hr with rfl | rfl + · norm_num + · norm_num + have hleftRoot : (-1 : ℝ) ∈ lowDegreeCounterexampleLeft.roots := by + change (-1 : ℝ) ∈ (X + C 1 : ℝ[X]).roots + rw [roots_X_add_C] + simp + have := roots_le_of_prec_right hprec hbound (-1) hleftRoot + norm_num at this + /-- The non-real-rooted polynomial used to check that the old weak sequence predicate is insufficient when a zero masks a neighboring entry. -/ def weakQuadratic : ℝ[X] := C 1 * X ^ 2 + C 1 * X + C 1 diff --git a/RealRooted/HurwitzMatrix.lean b/RealRooted/HurwitzMatrix.lean index d98e9486..1cc91620 100644 --- a/RealRooted/HurwitzMatrix.lean +++ b/RealRooted/HurwitzMatrix.lean @@ -194,13 +194,16 @@ theorem hurwitz_mul_entrywise_matrix (a b : ℕ → ℝ) : ext i j simpa using hurwitz_mul_entrywise a b i j -/-- Proposed infinite-matrix extension of the finite nonsingular Hurwitz-matrix -form of Garloff--Wagner Theorem 1. - -The cited theorem proves closure for finite nonsingular Hurwitz matrices. The -statement below is kept as an explicit interface because neither that theorem -nor the current development justifies the unrestricted infinite, possibly -singular version. -/ +/-- False proposed extension of a finite nonsingular result proved by +Garloff--Wagner, *Hadamard products of stable polynomials are stable*, J. Math. +Anal. Appl. 202 (1996), 797--809, Theorem 13. + +The cited source proves Hadamard stability and discusses closure for finite +nonsingular Hurwitz matrices. It does not justify closure for arbitrary +infinite, possibly singular matrices in the row-oriented convention below. +The unrestricted statement is refuted by +`not_hurwitzMatrixSchurProductTNStatement`, whose `3 x 3` minor is `-4`. +It must not be used as an available theorem backend. -/ abbrev HurwitzMatrixSchurProductTNStatement : Prop := ∀ {a b : ℕ → ℝ}, (hurwitz a).IsTotallyNonneg → diff --git a/RealRooted/Mathlib/Analysis/SpecialFunctions/ExpIntegral.lean b/RealRooted/Mathlib/Analysis/SpecialFunctions/ExpIntegral.lean new file mode 100644 index 00000000..23e1803d --- /dev/null +++ b/RealRooted/Mathlib/Analysis/SpecialFunctions/ExpIntegral.lean @@ -0,0 +1,30 @@ +module + +public import Mathlib.Analysis.SpecialFunctions.ExpDeriv +public import Mathlib.MeasureTheory.Integral.IntervalIntegral.FundThmCalculus + +/-! +# Interval integrals of exponential functions + +This file contains a fundamental-theorem-of-calculus identity for exponential +differences. +-/ + +public section + +open scoped Interval + +namespace Real + +/-- The integral form of the adjacent-difference identity for the exponential kernel. -/ +theorem intervalIntegral_mul_exp_mul (a b z : ℝ) : + (∫ t in a..b, z * exp (t * z)) = exp (b * z) - exp (a * z) := by + apply intervalIntegral.integral_eq_sub_of_hasDerivAt + · intro t _ + simpa [Function.comp_def, mul_comm] using + (Real.hasDerivAt_exp (t * z)).comp t ((hasDerivAt_id t).mul_const z) + · exact + (continuous_const.mul + (Real.continuous_exp.comp (continuous_id.mul continuous_const))).intervalIntegrable _ _ + +end Real diff --git a/RealRooted/Mathlib/Data/Fin/Basic.lean b/RealRooted/Mathlib/Data/Fin/Basic.lean new file mode 100644 index 00000000..6fa9625d --- /dev/null +++ b/RealRooted/Mathlib/Data/Fin/Basic.lean @@ -0,0 +1,113 @@ +module + +public import Mathlib.Data.Fin.SuccPred + +/-! +# Additional lemmas about finite indices + +This file contains compatibility lemmas intended for upstreaming to +`Mathlib.Data.Fin.Basic`. +-/ + +public section + +namespace Fin + +/-- `succAbove` preserves three consecutive coordinates lying before the omitted index. -/ +theorem succAbove_triple_eq_castSucc_of_right_lt + {n : ℕ} (p : Fin (n + 3)) (i : Fin n) + (h : i.succ.succ.castSucc < p) : + p.succAbove i.castSucc.castSucc = i.castSucc.castSucc.castSucc ∧ + p.succAbove i.succ.castSucc = i.succ.castSucc.castSucc ∧ + p.succAbove i.succ.succ = i.succ.succ.castSucc := by + change (i : ℕ) + 2 < (p : ℕ) at h + have hleft : i.castSucc.castSucc.castSucc < p := by + change (i : ℕ) < (p : ℕ) + lia + have hcenter : i.succ.castSucc.castSucc < p := by + change (i : ℕ) + 1 < (p : ℕ) + lia + exact ⟨Fin.succAbove_of_castSucc_lt p _ hleft, + Fin.succAbove_of_castSucc_lt p _ hcenter, + Fin.succAbove_of_castSucc_lt p _ h⟩ + +/-- `succAbove` shifts three consecutive coordinates lying after the omitted index. -/ +theorem succAbove_triple_eq_succ_of_le_left + {n : ℕ} (p : Fin (n + 3)) (i : Fin n) + (h : p ≤ i.castSucc.castSucc.castSucc) : + p.succAbove i.castSucc.castSucc = i.castSucc.castSucc.succ ∧ + p.succAbove i.succ.castSucc = i.succ.castSucc.succ ∧ + p.succAbove i.succ.succ = i.succ.succ.succ := by + change (p : ℕ) ≤ (i : ℕ) at h + have hcenter : p ≤ i.succ.castSucc.castSucc := by + change (p : ℕ) ≤ (i : ℕ) + 1 + lia + have hright : p ≤ i.succ.succ.castSucc := by + change (p : ℕ) ≤ (i : ℕ) + 2 + lia + exact ⟨Fin.succAbove_of_le_castSucc p _ h, + Fin.succAbove_of_le_castSucc p _ hcenter, + Fin.succAbove_of_le_castSucc p _ hright⟩ + +/-- Omitting an interior center sends the corresponding new center to its old right +neighbor. -/ +theorem succAbove_center_eq_right (i : Fin n) : + (i.succ.castSucc.castSucc).succAbove i.succ.castSucc = + i.succ.succ.castSucc := by + rw [Fin.succAbove_of_le_castSucc _ _ (by + change (i : ℕ) + 1 ≤ (i : ℕ) + 1 + exact Nat.le_refl _)] + congr + +/-- Omitting the old right neighbor sends the corresponding new center to its old value. -/ +theorem succAbove_center_eq_left (i : Fin n) : + (i.succ.succ.castSucc).succAbove i.succ.castSucc = + i.succ.castSucc.castSucc := by + rw [Fin.succAbove_of_castSucc_lt _ _ (by + change (i : ℕ) + 1 < (i : ℕ) + 2 + lia)] + +/-- Deleting an interior full-vector coordinate agrees with deleting its +corresponding interior coordinate. -/ +theorem succAbove_succ_castSucc + {n : ℕ} (k : Fin (n + 1)) (i : Fin n) : + k.succ.castSucc.succAbove i.succ.castSucc = + (k.succAbove i).succ.castSucc := by + by_cases h : i.castSucc < k + · have h' : i.succ.castSucc.castSucc < k.succ.castSucc := by + change (i : ℕ) + 1 < (k : ℕ) + 1 + exact Nat.succ_lt_succ h + rw [Fin.succAbove_of_castSucc_lt _ _ h', + Fin.succAbove_of_castSucc_lt _ _ h] + exact Fin.ext rfl + · have hki : k ≤ i.castSucc := by + change (k : ℕ) ≤ (i : ℕ) + change ¬(i : ℕ) < (k : ℕ) at h + exact Nat.le_of_not_gt h + have h' : k.succ.castSucc ≤ i.succ.castSucc.castSucc := by + change (k : ℕ) + 1 ≤ (i : ℕ) + 1 + exact Nat.succ_le_succ hki + rw [Fin.succAbove_of_le_castSucc _ _ h', + Fin.succAbove_of_le_castSucc _ _ hki] + exact Fin.ext rfl + +/-- Deleting an interior coordinate preserves the first coordinate. -/ +theorem succAbove_zero_of_interior + {n : ℕ} (k : Fin (n + 1)) : + k.succ.castSucc.succAbove (0 : Fin (n + 2)) = 0 := by + rw [Fin.succAbove_of_castSucc_lt _ _ (by + change 0 < (k : ℕ) + 1 + lia)] + exact Fin.ext rfl + +/-- Deleting an interior coordinate preserves the final coordinate. -/ +theorem succAbove_last_of_interior + {n : ℕ} (k : Fin (n + 1)) : + k.succ.castSucc.succAbove (Fin.last (n + 1)) = + Fin.last (n + 2) := by + rw [Fin.succAbove_of_le_castSucc _ _ (by + change (k : ℕ) + 1 ≤ n + 1 + lia)] + exact Fin.ext rfl + +end Fin diff --git a/RealRooted/Mathlib/Data/List/Basic.lean b/RealRooted/Mathlib/Data/List/Basic.lean new file mode 100644 index 00000000..b14f55fe --- /dev/null +++ b/RealRooted/Mathlib/Data/List/Basic.lean @@ -0,0 +1,38 @@ +module + +public import Mathlib.Data.List.Basic + +/-! +# Additional basic list lemmas + +This file contains compatibility lemmas intended for upstreaming to +`Mathlib.Data.List.Basic`. +-/ + +public section + +namespace List + +/-- Erasing an entry rejected by a filter does not change the filtered list. -/ +theorem filter_eraseIdx_eq_of_getElem_not + {α : Type*} {p : α → Bool} {l : List α} {i : ℕ} + (hi : i < l.length) (hpi : ¬p l[i]) : + (l.eraseIdx i).filter p = l.filter p := by + rw [eraseIdx_eq_take_drop_succ, filter_append] + conv_rhs => + rw [← take_append_drop i l, filter_append, + drop_eq_getElem_cons hi, filter_cons_of_neg hpi] + +/-- Erasing an index inside the middle block of a three-block concatenation. -/ +theorem eraseIdx_append_middle + {α : Type*} (pre middle post : List α) (i : ℕ) + (hi : i < middle.length) : + (pre ++ middle ++ post).eraseIdx (pre.length + i) = + pre ++ middle.eraseIdx i ++ post := by + rw [append_assoc, + eraseIdx_append_of_length_le (by simp), + Nat.add_sub_cancel_left, + eraseIdx_append_of_lt_length hi, + append_assoc] + +end List diff --git a/RealRooted/Mathlib/Data/List/Destutter.lean b/RealRooted/Mathlib/Data/List/Destutter.lean new file mode 100644 index 00000000..c08af3b4 --- /dev/null +++ b/RealRooted/Mathlib/Data/List/Destutter.lean @@ -0,0 +1,195 @@ +module + +public import Mathlib.Data.List.Destutter + +/-! +# Additional lemmas about list destuttering + +This file contains compatibility lemmas intended for upstreaming to +`Mathlib.Data.List.Destutter`. +-/ + +public section + +namespace List + +private theorem singleton_prefix_destutter' + {α : Type*} (R : α → α → Prop) [DecidableRel R] + (a : α) (l : List α) : + [a] <+: l.destutter' R a := by + induction l generalizing a with + | nil => + exact ⟨[], rfl⟩ + | cons b l ih => + rw [List.destutter'_cons] + by_cases hab : R a b + · rw [if_pos hab] + exact ⟨l.destutter' R b, rfl⟩ + · rw [if_neg hab] + exact ih a + +private theorem destutter'_prefix_append + {α : Type*} (R : α → α → Prop) [DecidableRel R] + (a : α) (l t : List α) : + l.destutter' R a <+: (l ++ t).destutter' R a := by + induction l generalizing a with + | nil => + exact singleton_prefix_destutter' R a t + | cons b l ih => + simp only [List.cons_append] + rw [List.destutter'_cons, List.destutter'_cons] + by_cases hab : R a b + · rw [if_pos hab, if_pos hab] + rcases ih b with ⟨u, hu⟩ + exact ⟨u, by simpa using congrArg (List.cons a) hu⟩ + · rw [if_neg hab, if_neg hab] + exact ih a + +private theorem destutter_prefix_append + {α : Type*} (R : α → α → Prop) [DecidableRel R] + (l t : List α) : + l.destutter R <+: (l ++ t).destutter R := by + cases l with + | nil => + exact ⟨t.destutter R, by simp⟩ + | cons a l => + exact destutter'_prefix_append R a l t + +/-- Destuttering preserves list prefixhood. -/ +theorem IsPrefix.destutter + {α : Type*} {R : α → α → Prop} [DecidableRel R] + {l₁ l₂ : List α} (h : l₁ <+: l₂) : + l₁.destutter R <+: l₂.destutter R := by + rcases h with ⟨t, rfl⟩ + exact destutter_prefix_append R l₁ t + +private theorem getLast?_cons_eq_tail_of_ne_nil + {α : Type*} {a : α} {l : List α} (hl : l ≠ []) : + (a :: l).getLast? = l.getLast? := by + rw [List.getLast?_cons, List.getLast?_eq_some_getLast hl] + simp + +private theorem getLast?_destutter'_ne + {α : Type*} [DecidableEq α] (a : α) (l : List α) : + (l.destutter' (· ≠ ·) a).getLast? = + (a :: l).getLast? := by + induction l generalizing a with + | nil => + simp + | cons b l ih => + rw [List.destutter'_cons] + by_cases hab : a ≠ b + · rw [if_pos hab] + calc + (a :: l.destutter' (· ≠ ·) b).getLast? = + (l.destutter' (· ≠ ·) b).getLast? := + getLast?_cons_eq_tail_of_ne_nil (List.destutter'_ne_nil _ _) + _ = (b :: l).getLast? := ih b + _ = (a :: b :: l).getLast? := + (getLast?_cons_eq_tail_of_ne_nil (by simp)).symm + · have hab_eq : a = b := not_ne_iff.mp hab + subst b + rw [if_neg (by simp)] + calc + (l.destutter' (· ≠ ·) a).getLast? = + (a :: l).getLast? := ih a + _ = (a :: a :: l).getLast? := + (getLast?_cons_eq_tail_of_ne_nil (by simp)).symm + +/-- Destuttering by disequality preserves the final element. -/ +theorem getLast?_destutter_ne + {α : Type*} [DecidableEq α] (l : List α) : + (l.destutter (· ≠ ·)).getLast? = l.getLast? := by + cases l with + | nil => + simp + | cons a l => + exact getLast?_destutter'_ne a l + +/-- Equal-length destuttered prefixes have the same final element. -/ +theorem IsPrefix.getLast?_eq_of_destutter_length_le + {α : Type*} [DecidableEq α] + {l₁ l₂ : List α} (h : l₁ <+: l₂) + (hlen : + (l₂.destutter (· ≠ ·)).length ≤ + (l₁.destutter (· ≠ ·)).length) : + l₁.getLast? = l₂.getLast? := by + have heq : + l₁.destutter (· ≠ ·) = + l₂.destutter (· ≠ ·) := + (h.destutter (R := fun x y : α => x ≠ y)).eq_of_length_le hlen + simpa only [List.getLast?_destutter_ne] using + congrArg List.getLast? heq + +private theorem destutter'_append_cons_self_ne + {α : Type*} [DecidableEq α] (b a : α) (l₁ l₂ : List α) : + (l₁ ++ a :: a :: l₂).destutter' (· ≠ ·) b = + (l₁ ++ a :: l₂).destutter' (· ≠ ·) b := by + induction l₁ generalizing b with + | nil => + by_cases hba : b = a + · subst b + simp + · simp [hba] + | cons c l ih => + simp only [cons_append, List.destutter'_cons] + by_cases hbc : b ≠ c + · rw [if_pos hbc, if_pos hbc, ih c] + · rw [if_neg hbc, if_neg hbc, ih b] + +/-- Deleting one of two adjacent equal entries does not change disequality destuttering. -/ +theorem destutter_append_cons_self_ne + {α : Type*} [DecidableEq α] (l₁ l₂ : List α) (a : α) : + (l₁ ++ a :: a :: l₂).destutter (· ≠ ·) = + (l₁ ++ a :: l₂).destutter (· ≠ ·) := by + cases l₁ with + | nil => + simp [List.destutter_cons'] + | cons b l => + simp only [cons_append, List.destutter_cons'] + exact destutter'_append_cons_self_ne b a l l₂ + +/-- Deleting the second of two adjacent equal entries after a fixed entry does not change +disequality destuttering. -/ +theorem destutter_append_cons_cons_self_ne + {α : Type*} [DecidableEq α] (l₁ l₂ : List α) (a b : α) : + (l₁ ++ a :: b :: b :: l₂).destutter (· ≠ ·) = + (l₁ ++ a :: b :: l₂).destutter (· ≠ ·) := by + simpa only [append_assoc, singleton_append] using + destutter_append_cons_self_ne (l₁ ++ [a]) l₂ b + +/-- Prepending an entry increases the length after disequality destuttering by at most one. -/ +theorem length_destutter_cons_ne_le_succ + {α : Type*} [DecidableEq α] (a : α) (l : List α) : + ((a :: l).destutter (· ≠ ·)).length ≤ + (l.destutter (· ≠ ·)).length + 1 := by + cases l with + | nil => simp + | cons b l => + simp only [List.destutter_cons', List.destutter'_cons] + split_ifs <;> simp_all + +private theorem length_destutter'_append_singleton_ne_le_succ + {α : Type*} [DecidableEq α] (b a : α) (l : List α) : + ((l ++ [a]).destutter' (· ≠ ·) b).length ≤ + (l.destutter' (· ≠ ·) b).length + 1 := by + induction l generalizing b with + | nil => + simp [List.destutter'_cons] + split_ifs <;> simp + | cons c l ih => + simp only [cons_append, List.destutter'_cons] + split_ifs <;> simp_all + +/-- Appending an entry increases the length after disequality destuttering by at most one. -/ +theorem length_destutter_append_singleton_ne_le_succ + {α : Type*} [DecidableEq α] (l : List α) (a : α) : + ((l ++ [a]).destutter (· ≠ ·)).length ≤ + (l.destutter (· ≠ ·)).length + 1 := by + cases l with + | nil => simp + | cons b l => + simp only [cons_append, List.destutter_cons'] + exact length_destutter'_append_singleton_ne_le_succ b a l + +end List diff --git a/RealRooted/Mathlib/Data/List/OfFn.lean b/RealRooted/Mathlib/Data/List/OfFn.lean new file mode 100644 index 00000000..904129d6 --- /dev/null +++ b/RealRooted/Mathlib/Data/List/OfFn.lean @@ -0,0 +1,61 @@ +module + +public import Mathlib.Data.List.OfFn +public import RealRooted.Mathlib.Data.Fin.Basic + +/-! +# Additional lemmas about lists of finite functions + +This file contains compatibility lemmas intended for upstreaming to +`Mathlib.Data.List.OfFn`. +-/ + +public section + +namespace List + +/-- Removing a finite-function coordinate agrees with erasing that list index. -/ +theorem ofFn_succAbove_eq_eraseIdx + {α : Type*} {n : ℕ} + (f : Fin (n + 1) → α) (p : Fin (n + 1)) : + List.ofFn (fun i : Fin n => f (p.succAbove i)) = + (List.ofFn f).eraseIdx p := by + apply List.ext_getElem + · simp [List.length_eraseIdx, p.isLt] + · intro i hi₁ _ + simp only [List.getElem_ofFn, List.getElem_eraseIdx] + split + · rw [Fin.succAbove_of_castSucc_lt p _ (by + change i < (p : ℕ) + exact ‹i < (p : ℕ)›)] + congr + · rw [Fin.succAbove_of_le_castSucc p _ (by + change (p : ℕ) ≤ i + exact Nat.le_of_not_gt ‹¬i < (p : ℕ)›)] + congr + +/-- Removing an interior coordinate agrees with erasing its interior-list index. -/ +theorem ofFn_interior_succAbove_eq_eraseIdx + {α : Type*} {n : ℕ} + (f : Fin (n + 3) → α) (k : Fin (n + 1)) : + List.ofFn + (fun i : Fin n => + f (k.succ.castSucc.succAbove i.succ.castSucc)) = + (List.ofFn + (fun i : Fin (n + 1) => f i.succ.castSucc)).eraseIdx k := by + simpa only [Fin.succAbove_succ_castSucc] using + List.ofFn_succAbove_eq_eraseIdx + (fun i : Fin (n + 1) => f i.succ.castSucc) k + +/-- A finite-function list splits into its two endpoints and interior coordinates. -/ +theorem ofFn_two_endpoints + {α : Type*} {n : ℕ} (f : Fin (n + 2) → α) : + List.ofFn f = + f 0 :: + (List.ofFn (fun i : Fin n => f i.succ.castSucc) ++ + [f (Fin.last (n + 1))]) := by + rw [List.ofFn_succ, List.ofFn_succ'] + simp only [List.concat_eq_append] + congr + +end List diff --git a/RealRooted/Mathlib/LinearAlgebra/Matrix/Determinant/Basic.lean b/RealRooted/Mathlib/LinearAlgebra/Matrix/Determinant/Basic.lean index a3cf55b2..84b4aa3a 100644 --- a/RealRooted/Mathlib/LinearAlgebra/Matrix/Determinant/Basic.lean +++ b/RealRooted/Mathlib/LinearAlgebra/Matrix/Determinant/Basic.lean @@ -10,6 +10,12 @@ variable {n R : Type*} [DecidableEq n] [Fintype n] [CommRing R] -- TODO: Replace `det_zero` @[simp] lemma det_zero' [Nonempty n] : (0 : Matrix n n R).det = 0 := det_zero ‹_› +/-- The Leibniz formula for a determinant, with rows indexed before columns. -/ +theorem det_apply_row (M : Matrix n n R) : + M.det = ∑ σ : Equiv.Perm n, Equiv.Perm.sign σ • ∏ i, M i (σ i) := by + rw [← Matrix.det_transpose, Matrix.det_apply] + rfl + /-- The alternating vector of maximal row-deletion minors of a rectangular matrix lies in the kernel of its transpose. This is the Laplace expansion of the matrix obtained by adjoining a duplicate of any chosen column. -/ @@ -33,4 +39,41 @@ theorem transpose_mulVec_alternating_det_submatrix_succAbove {q : ℕ} simp_rw [hminor] at hdet simpa [mulVec, dotProduct, A, mul_comm, mul_left_comm, mul_assoc] using hdet +/-- Expanding a matrix with constant first column after adjacent row subtraction. -/ +theorem det_eq_det_adjacentRowDiff_of_firstColumn_eq_one {n : ℕ} + (A : Matrix (Fin (n + 1)) (Fin (n + 1)) R) + (hA : ∀ i, A i 0 = 1) : + A.det = + (Matrix.of fun (i j : Fin n) => + A i.succ j.succ - A i.castSucc j.succ).det := by + let B : Matrix (Fin (n + 1)) (Fin (n + 1)) R := + fun i j => Fin.cases (A 0 j) + (fun k => A k.succ j - A k.castSucc j) i + have hdet : A.det = B.det := by + apply det_eq_of_forall_row_eq_smul_add_pred (fun _ => 1) + · intro j + simp [B] + · intro i j + simp [B] + rw [hdet, det_succ_column_zero, Fin.sum_univ_succ] + have hminor : + B.submatrix Fin.succ Fin.succ = + Matrix.of fun (i j : Fin n) => + A i.succ j.succ - A i.castSucc j.succ := by + ext i j + rfl + simpa [B, hA] using congrArg Matrix.det hminor + +/-- A submatrix with a noninjective column selector has zero determinant. -/ +theorem det_submatrix_eq_zero_of_not_injective_right + {R m κ q : Type*} [CommRing R] [DecidableEq q] [Fintype q] + (L : Matrix m κ R) (rows : q → m) (f : q → κ) + (hf : ¬ Function.Injective f) : + (L.submatrix rows f).det = 0 := by + obtain ⟨i, j, hfij, hij⟩ := Function.not_injective_iff.mp hf + apply Matrix.det_zero_of_column_eq hij + intro k + simp only [Matrix.submatrix_apply] + rw [hfij] + end Matrix diff --git a/RealRooted/Mathlib/LinearAlgebra/Matrix/Determinant/CauchyBinet.lean b/RealRooted/Mathlib/LinearAlgebra/Matrix/Determinant/CauchyBinet.lean new file mode 100644 index 00000000..232ed465 --- /dev/null +++ b/RealRooted/Mathlib/LinearAlgebra/Matrix/Determinant/CauchyBinet.lean @@ -0,0 +1,300 @@ +import RealRooted.Mathlib.LinearAlgebra.Matrix.Determinant.Basic +import Mathlib.LinearAlgebra.Basis.VectorSpace +import Mathlib.LinearAlgebra.Matrix.ToLin +import Mathlib.Order.Hom.PowersetCard + +/-! +# Cauchy-Binet determinant expansions + +This file develops the rectangular Cauchy-Binet formula. It expands a selected +minor into a sum over intermediate maps, proves that noninjective maps vanish, +and factors each injective map through the increasing enumeration of its image. +The remaining step transports permutation signs and groups by image subset. +-/ + +open scoped BigOperators + +namespace Matrix + +/-- Leibniz expansion of a selected minor of a rectangular matrix product. -/ +theorem det_submatrix_mul_eq_sum_perm_fun + {R : Type*} [CommRing R] {l n m q : ℕ} + (L : Matrix (Fin l) (Fin n) R) + (A : Matrix (Fin n) (Fin m) R) + (rows : Fin q → Fin l) (cols : Fin q → Fin m) : + ((L * A).submatrix rows cols).det = + ∑ σ : Equiv.Perm (Fin q), Equiv.Perm.sign σ • + ∑ f : Fin q → Fin n, + ∏ i, L (rows (σ i)) (f i) * A (f i) (cols i) := by + rw [Matrix.det_apply] + simp only [Matrix.submatrix_apply, Matrix.mul_apply, Finset.prod_univ_sum] + simp + +/-- Reassemble the permutation sum for each intermediate-index map. -/ +theorem det_submatrix_mul_eq_sum_fun_det + {R : Type*} [CommRing R] {l n m q : ℕ} + (L : Matrix (Fin l) (Fin n) R) + (A : Matrix (Fin n) (Fin m) R) + (rows : Fin q → Fin l) (cols : Fin q → Fin m) : + ((L * A).submatrix rows cols).det = + ∑ f : Fin q → Fin n, + (L.submatrix rows f).det * ∏ i, A (f i) (cols i) := by + rw [det_submatrix_mul_eq_sum_perm_fun] + simp_rw [Finset.smul_sum] + rw [Finset.sum_comm] + apply Fintype.sum_congr + intro f + rw [Matrix.det_apply] + simp only [Matrix.submatrix_apply, Finset.prod_mul_distrib] + rw [Finset.sum_mul] + simp_rw [smul_mul_assoc] + +end Matrix + +private theorem coe_ofFinEmb_eq_range {q : ℕ} {I : Type*} (f : Fin q ↪ I) : + (Set.powersetCard.ofFinEmb q I f : Set I) = Set.range f := by + ext x + simp [Set.powersetCard.ofFinEmb, Set.powersetCard.map] + + +private theorem range_orderEmbOfPowersetCard {q : ℕ} {I : Type*} + [LinearOrder I] (s : Set.powersetCard I q) : + Set.range (Set.powersetCard.ofFinEmbEquiv.symm s) = (s : Set I) := by + let e : Fin q ↪o I := Set.powersetCard.ofFinEmbEquiv.symm s + calc + Set.range e = (Set.powersetCard.ofFinEmb q I e.toEmbedding : Set I) := + (coe_ofFinEmb_eq_range e.toEmbedding).symm + _ = (s : Set I) := congrArg + (fun t : Set.powersetCard I q => (t : Set I)) + (Set.powersetCard.ofFinEmbEquiv.apply_symm_apply s) + +/-- An injective finite map into a linear order factors through the increasing +enumeration of its image and a permutation of its domain. -/ +theorem Set.powersetCard.exists_orderEmb_comp_perm_eq_of_injective + {q : ℕ} {I : Type*} [LinearOrder I] + (f : Fin q → I) (hf : Function.Injective f) : + ∃ s : Set.powersetCard I q, ∃ p : Equiv.Perm (Fin q), + ∀ i, Set.powersetCard.ofFinEmbEquiv.symm s (p i) = f i := by + let emb : Fin q ↪ I := ⟨f, hf⟩ + let s : Set.powersetCard I q := Set.powersetCard.ofFinEmb q I emb + let e : Fin q ↪o I := Set.powersetCard.ofFinEmbEquiv.symm s + have hfRange : Set.range f = (s : Set I) := + (coe_ofFinEmb_eq_range emb).symm + have hRange : Set.range f = Set.range e := + hfRange.trans (range_orderEmbOfPowersetCard s).symm + let ee : Fin q ≃ Set.range e := Equiv.ofInjective e e.injective + let p : Equiv.Perm (Fin q) := + (Equiv.ofInjective f hf).trans + ((Equiv.setCongr hRange).trans ee.symm) + refine ⟨s, p, ?_⟩ + intro i + have hfi : f i ∈ Set.range e := hRange ▸ ⟨i, rfl⟩ + change e (ee.symm ⟨f i, hfi⟩) = f i + exact congrArg Subtype.val (ee.apply_symm_apply ⟨f i, hfi⟩) + +private theorem range_comp_perm {q : ℕ} {I : Type*} + (e : Fin q → I) (p : Equiv.Perm (Fin q)) : + Set.range (fun i => e (p i)) = Set.range e := by + ext x + constructor + · rintro ⟨i, rfl⟩ + exact ⟨p i, rfl⟩ + · rintro ⟨j, rfl⟩ + exact ⟨p.symm j, by simp⟩ + +/-- The ordered-image/permutation representation of an injective finite map is +unique. -/ +theorem Set.powersetCard.orderEmb_comp_perm_injective + {q : ℕ} {I : Type*} [LinearOrder I] : + Function.Injective + (fun z : Set.powersetCard I q × Equiv.Perm (Fin q) => + fun i => Set.powersetCard.ofFinEmbEquiv.symm z.1 (z.2 i)) := by + rintro ⟨s, p⟩ ⟨t, r⟩ h + let es : Fin q ↪o I := Set.powersetCard.ofFinEmbEquiv.symm s + let et : Fin q ↪o I := Set.powersetCard.ofFinEmbEquiv.symm t + have hst : s = t := by + apply Subtype.ext + apply Finset.coe_injective + calc + (s : Set I) = Set.range es := (range_orderEmbOfPowersetCard s).symm + _ = Set.range (fun i => es (p i)) := (range_comp_perm es p).symm + _ = Set.range (fun i => et (r i)) := congrArg Set.range h + _ = Set.range et := range_comp_perm et r + _ = (t : Set I) := range_orderEmbOfPowersetCard t + subst t + have hpr : p = r := by + apply Equiv.ext + intro i + exact es.injective (congrFun h i) + exact Prod.ext rfl hpr + +/-- Ordered image and a domain permutation parameterize all finite embeddings. -/ +noncomputable def Set.powersetCard.orderEmbPermEquivEmbedding + {q : ℕ} {I : Type*} [LinearOrder I] : + Set.powersetCard I q × Equiv.Perm (Fin q) ≃ (Fin q ↪ I) := + Equiv.ofBijective + (fun z => + ⟨fun i => Set.powersetCard.ofFinEmbEquiv.symm z.1 (z.2 i), + (Set.powersetCard.ofFinEmbEquiv.symm z.1).injective.comp + z.2.injective⟩) + ⟨by + intro z w h + apply Set.powersetCard.orderEmb_comp_perm_injective + funext i + exact congrArg (fun g : Fin q ↪ I => g i) h, + by + intro f + obtain ⟨s, p, h⟩ := + Set.powersetCard.exists_orderEmb_comp_perm_eq_of_injective f f.injective + refine ⟨(s, p), ?_⟩ + ext i + exact h i⟩ + +/-- Reindex a sum over finite embeddings by ordered image and permutation. -/ +theorem Set.powersetCard.sum_embedding_eq_sum_orderEmb_perm + {q : ℕ} {I M : Type*} [LinearOrder I] [Fintype I] [AddCommMonoid M] + (g : (Fin q ↪ I) → M) : + ∑ f : Fin q ↪ I, g f = + ∑ s : Set.powersetCard I q, ∑ p : Equiv.Perm (Fin q), + g ⟨fun i => Set.powersetCard.ofFinEmbEquiv.symm s (p i), + (Set.powersetCard.ofFinEmbEquiv.symm s).injective.comp p.injective⟩ := by + calc + ∑ f : Fin q ↪ I, g f = + ∑ z, g (Set.powersetCard.orderEmbPermEquivEmbedding z) := + (Set.powersetCard.orderEmbPermEquivEmbedding.sum_comp g).symm + _ = ∑ s : Set.powersetCard I q, ∑ p : Equiv.Perm (Fin q), + g (Set.powersetCard.orderEmbPermEquivEmbedding (s, p)) := + Fintype.sum_prod_type _ + _ = _ := by + simp [Set.powersetCard.orderEmbPermEquivEmbedding] + +private theorem sum_function_eq_sum_embedding_of_zero_noninjective + {q : ℕ} {I M : Type*} [Fintype I] [AddCommMonoid M] + (g : (Fin q → I) → M) + (hzero : ∀ f, ¬ Function.Injective f → g f = 0) : + ∑ f : Fin q → I, g f = ∑ e : Fin q ↪ I, g e := by + classical + calc + ∑ f : Fin q → I, g f = + (∑ f : {f : Fin q → I // Function.Injective f}, g f) + + ∑ f : {f : Fin q → I // ¬ Function.Injective f}, g f := + (Fintype.sum_subtype_add_sum_subtype Function.Injective g).symm + _ = ∑ f : {f : Fin q → I // Function.Injective f}, g f := by + rw [show (∑ f : {f : Fin q → I // ¬ Function.Injective f}, g f) = 0 by + apply Finset.sum_eq_zero + intro f _ + exact hzero f f.property, add_zero] + _ = ∑ f : Fin q ↪ I, g f := by + exact Fintype.sum_equiv + (Equiv.subtypeInjectiveEquivEmbedding (Fin q) I) _ _ fun _ => rfl + +private theorem sum_perm_det_submatrix_comp_mul_prod_eq + {R : Type*} [CommRing R] {l n m q : ℕ} + (L : Matrix (Fin l) (Fin n) R) + (A : Matrix (Fin n) (Fin m) R) + (rows : Fin q → Fin l) (cols : Fin q → Fin m) + (e : Fin q → Fin n) : + (∑ p : Equiv.Perm (Fin q), + (L.submatrix rows (fun i => e (p i))).det * + ∏ i, A (e (p i)) (cols i)) = + (L.submatrix rows e).det * (A.submatrix e cols).det := by + calc + _ = (L.submatrix rows e).det * + ∑ p : Equiv.Perm (Fin q), + Equiv.Perm.sign p • ∏ i, A (e (p i)) (cols i) := by + rw [Finset.mul_sum] + apply Fintype.sum_congr + intro p + rw [show L.submatrix rows (fun i => e (p i)) = + (L.submatrix rows e).submatrix id p by rfl] + rw [Matrix.det_permute', Units.smul_def, + ← Int.cast_smul_eq_zsmul R, smul_eq_mul] + ac_rfl + _ = (L.submatrix rows e).det * (A.submatrix e cols).det := by + congr 1 + rw [Matrix.det_apply] + rfl + +/-- Rectangular Cauchy--Binet for selected square minors. -/ +theorem Matrix.det_submatrix_mul_eq_sum_powersetCard + {R : Type*} [CommRing R] {l n m q : ℕ} + (L : Matrix (Fin l) (Fin n) R) + (A : Matrix (Fin n) (Fin m) R) + (rows : Fin q → Fin l) (cols : Fin q → Fin m) : + ((L * A).submatrix rows cols).det = + ∑ s : Set.powersetCard (Fin n) q, + (L.submatrix rows + (Set.powersetCard.ofFinEmbEquiv.symm s)).det * + (A.submatrix + (Set.powersetCard.ofFinEmbEquiv.symm s) cols).det := by + classical + rw [Matrix.det_submatrix_mul_eq_sum_fun_det] + rw [sum_function_eq_sum_embedding_of_zero_noninjective] + · rw [Set.powersetCard.sum_embedding_eq_sum_orderEmb_perm] + apply Fintype.sum_congr + intro s + simpa using sum_perm_det_submatrix_comp_mul_prod_eq L A rows cols + (Set.powersetCard.ofFinEmbEquiv.symm s) + · intro f hf + rw [Matrix.det_submatrix_eq_zero_of_not_injective_right L rows f hf, + zero_mul] + +private theorem selected_mulVec_injective + {R : Type*} [Field R] {n m q : ℕ} + (A : Matrix (Fin n) (Fin m) R) + (hA : Function.Injective A.mulVec) + (cols : Fin q → Fin m) (hcols : StrictMono cols) : + Function.Injective (A.submatrix id cols).mulVec := by + rw [Matrix.mulVec_injective_iff] + have h := (Matrix.mulVec_injective_iff.mp hA).comp cols hcols.injective + rw [show (A.submatrix id cols).col = A.col ∘ cols by + ext j i + rfl] + exact h + +private theorem exists_left_inverse_matrix + {R : Type*} [Field R] {n q : ℕ} + (B : Matrix (Fin n) (Fin q) R) + (hB : Function.Injective B.mulVec) : + ∃ C : Matrix (Fin q) (Fin n) R, C * B = 1 := by + let f := Matrix.toLin' B + have hf : LinearMap.ker f = ⊥ := by + rw [LinearMap.ker_eq_bot] + intro x y hxy + apply hB + simpa only [f, Matrix.toLin'_apply] using hxy + obtain ⟨g, hg⟩ := f.exists_leftInverse_of_injective hf + refine ⟨LinearMap.toMatrix' g, ?_⟩ + rw [← LinearMap.toMatrix'_toLin' B, ← LinearMap.toMatrix'_comp, hg, + ← Matrix.toLin'_one, LinearMap.toMatrix'_toLin'] + +/-- Full column rank gives a nonzero maximal minor on strictly increasing rows. + +The proof restricts the independent columns, takes a linear left inverse, and +applies rectangular Cauchy--Binet to the resulting identity matrix. -/ +theorem Matrix.exists_ordered_minor_ne_zero_of_mulVec_injective + {R : Type*} [Field R] {n m q : ℕ} + (A : Matrix (Fin n) (Fin m) R) + (hA : Function.Injective A.mulVec) + (cols : Fin q → Fin m) (hcols : StrictMono cols) : + ∃ rows : Fin q → Fin n, StrictMono rows ∧ + (A.submatrix rows cols).det ≠ 0 := by + classical + let B := A.submatrix id cols + have hB : Function.Injective B.mulVec := by + exact selected_mulVec_injective A hA cols hcols + obtain ⟨C, hCB⟩ := exists_left_inverse_matrix B hB + have hsum : + (∑ s : Set.powersetCard (Fin n) q, + (C.submatrix id + (Set.powersetCard.ofFinEmbEquiv.symm s)).det * + (B.submatrix + (Set.powersetCard.ofFinEmbEquiv.symm s) id).det) ≠ 0 := by + rw [← Matrix.det_submatrix_mul_eq_sum_powersetCard C B id id, hCB] + simp + obtain ⟨s, _, hs⟩ := Finset.exists_ne_zero_of_sum_ne_zero + (s := Finset.univ) (by simpa using hsum) + refine ⟨Set.powersetCard.ofFinEmbEquiv.symm s, + (Set.powersetCard.ofFinEmbEquiv.symm s).strictMono, ?_⟩ + have hminor := (mul_ne_zero_iff.mp hs).2 + simpa [B] using hminor diff --git a/RealRooted/Mathlib/LinearAlgebra/Matrix/Determinant/Integral.lean b/RealRooted/Mathlib/LinearAlgebra/Matrix/Determinant/Integral.lean new file mode 100644 index 00000000..bafbebc0 --- /dev/null +++ b/RealRooted/Mathlib/LinearAlgebra/Matrix/Determinant/Integral.lean @@ -0,0 +1,111 @@ +module + +public import RealRooted.Mathlib.LinearAlgebra.Matrix.Determinant.Basic +public import Mathlib.MeasureTheory.Integral.IntervalIntegral.Basic +public import Mathlib.MeasureTheory.Integral.Pi +public import Mathlib.Topology.Algebra.Module.FiniteDimension + +/-! +# Determinants and interval integrals + +This file records how determinant multilinearity interacts with interval +integrals in one matrix row. +-/ + +public section + +open scoped Interval + +namespace Matrix + +private noncomputable def detUpdateRowLinearMap + {n : Type*} [DecidableEq n] [Fintype n] (M : Matrix n n ℝ) (i : n) : + (n → ℝ) →ₗ[ℝ] ℝ := + { toFun := fun row => (M.updateRow i row).det + map_add' := fun u v => det_updateRow_add M i u v + map_smul' := fun c u => by + simpa only [RingHom.id_apply, smul_eq_mul] using det_updateRow_smul M i c u } + +/-- A determinant commutes with an interval integral in one fixed row. -/ +theorem det_updateRow_intervalIntegral + {n : Type*} [DecidableEq n] [Fintype n] (M : Matrix n n ℝ) (i : n) + (f : ℝ → n → ℝ) (a b : ℝ) + (hf : IntervalIntegrable f MeasureTheory.volume a b) : + (M.updateRow i (∫ t in a..b, f t)).det = + ∫ t in a..b, (M.updateRow i (f t)).det := by + let L := (detUpdateRowLinearMap M i).toContinuousLinearMap + exact (L.intervalIntegral_comp_comm hf).symm + +/-- A pointwise determinant is integrable under a product measure when every entry is. -/ +theorem integrable_det_rows + {n E : Type*} [DecidableEq n] [Fintype n] [MeasurableSpace E] + (μ : n → MeasureTheory.Measure E) [∀ i, MeasureTheory.SigmaFinite (μ i)] + (f : n → E → n → ℝ) + (hf : ∀ i j, MeasureTheory.Integrable (fun x => f i x j) (μ i)) : + MeasureTheory.Integrable + (fun x : n → E => (Matrix.of fun i j => f i (x i) j).det) + (MeasureTheory.Measure.pi μ) := by + have hfun : + (fun x : n → E => (Matrix.of fun i j => f i (x i) j).det) = + fun x => ∑ σ : Equiv.Perm n, ((Equiv.Perm.sign σ : ℤ) : ℝ) * + ∏ i, f i (x i) (σ i) := by + funext x + rw [Matrix.det_apply_row] + simp_rw [Units.smul_def, ← Int.cast_smul_eq_zsmul ℝ] + rfl + rw [hfun] + apply MeasureTheory.integrable_finsetSum Finset.univ + intro σ _ + exact (MeasureTheory.Integrable.fintype_prod fun i => hf i (σ i)).const_mul _ + +/-- The determinant of rowwise integrals is the integral of the pointwise determinant. -/ +theorem det_integral_rows_eq_integral_det + {n E : Type*} [DecidableEq n] [Fintype n] [MeasurableSpace E] + (μ : n → MeasureTheory.Measure E) [∀ i, MeasureTheory.SigmaFinite (μ i)] + (f : n → E → n → ℝ) + (hf : ∀ i j, MeasureTheory.Integrable (fun x => f i x j) (μ i)) : + (Matrix.of fun i j => ∫ x, f i x j ∂μ i).det = + ∫ x : n → E, + (Matrix.of fun i j => f i (x i) j).det ∂MeasureTheory.Measure.pi μ := by + have hdet (M : Matrix n n ℝ) : + M.det = ∑ σ : Equiv.Perm n, ((Equiv.Perm.sign σ : ℤ) : ℝ) * + ∏ i, M i (σ i) := by + rw [Matrix.det_apply_row] + simp_rw [Units.smul_def, ← Int.cast_smul_eq_zsmul ℝ] + rfl + have hprod (σ : Equiv.Perm n) : + MeasureTheory.Integrable + (fun x : n → E => ∏ i, f i (x i) (σ i)) (MeasureTheory.Measure.pi μ) := + MeasureTheory.Integrable.fintype_prod fun i => hf i (σ i) + calc + (Matrix.of fun i j => ∫ x, f i x j ∂μ i).det = + ∑ σ : Equiv.Perm n, ((Equiv.Perm.sign σ : ℤ) : ℝ) * + ∏ i, ∫ x, f i x (σ i) ∂μ i := + hdet _ + _ = ∑ σ : Equiv.Perm n, ((Equiv.Perm.sign σ : ℤ) : ℝ) * + ∫ x : n → E, ∏ i, f i (x i) (σ i) ∂MeasureTheory.Measure.pi μ := by + apply Finset.sum_congr rfl + intro σ _ + apply congrArg (((Equiv.Perm.sign σ : ℤ) : ℝ) * ·) + exact (MeasureTheory.integral_fintype_prod_eq_prod + (fun i x => f i x (σ i))).symm + _ = ∑ σ : Equiv.Perm n, + ∫ x : n → E, ((Equiv.Perm.sign σ : ℤ) : ℝ) * + ∏ i, f i (x i) (σ i) ∂MeasureTheory.Measure.pi μ := by + apply Finset.sum_congr rfl + intro σ _ + rw [MeasureTheory.integral_const_mul] + _ = ∫ x : n → E, ∑ σ : Equiv.Perm n, + ((Equiv.Perm.sign σ : ℤ) : ℝ) * + ∏ i, f i (x i) (σ i) ∂MeasureTheory.Measure.pi μ := by + symm + apply MeasureTheory.integral_finsetSum + intro σ _ + exact (hprod σ).const_mul _ + _ = ∫ x : n → E, + (Matrix.of fun i j => f i (x i) j).det ∂MeasureTheory.Measure.pi μ := by + apply congrArg fun g : (n → E) → ℝ => ∫ x, g x ∂MeasureTheory.Measure.pi μ + funext x + exact (hdet _).symm + +end Matrix diff --git a/RealRooted/Mathlib/LinearAlgebra/Matrix/Gaussian.lean b/RealRooted/Mathlib/LinearAlgebra/Matrix/Gaussian.lean new file mode 100644 index 00000000..9e30695c --- /dev/null +++ b/RealRooted/Mathlib/LinearAlgebra/Matrix/Gaussian.lean @@ -0,0 +1,394 @@ +import RealRooted.Mathlib.Analysis.SpecialFunctions.ExpIntegral +import RealRooted.Mathlib.LinearAlgebra.Matrix.Determinant.Integral +import Mathlib.Tactic.Positivity +import Mathlib.Tactic.Ring +import Mathlib.Topology.Instances.Matrix +import RealRooted.Mathlib.LinearAlgebra.Vandermonde + +/-! +# Karlin's finite Gaussian matrices + +This file starts the formalization of Karlin, *Total Positivity*, Vol. I, +Chapter V, Section 1, Proposition 1.1. Karlin uses the Gaussian matrix + +`F(a) i j = exp (-a * (i - j) ^ 2)`. + +The proposition has two parts: `F(a)` tends to the identity as `a` tends to +positive infinity, and `F(a)` is strictly totally positive when `a > 0`. +This file proves Gaussian convergence and strict positivity of all strictly +ordered finite minors using Karlin.s exponential-kernel argument. +-/ + +public section + +open scoped Interval + +open Filter MeasureTheory Topology + +namespace Matrix + +/-- Karlin's finite Gaussian matrix from Proposition V.1.1. -/ +noncomputable def gaussianMatrix (n : ℕ) (a : ℝ) : Matrix (Fin n) (Fin n) ℝ := + fun i j => Real.exp (-a * (((i : ℕ) : ℝ) - ((j : ℕ) : ℝ)) ^ 2) + +@[simp] lemma gaussianMatrix_apply (n : ℕ) (a : ℝ) (i j : Fin n) : + gaussianMatrix n a i j = + Real.exp (-a * (((i : ℕ) : ℝ) - ((j : ℕ) : ℝ)) ^ 2) := + rfl + +@[simp] lemma gaussianMatrix_apply_self (n : ℕ) (a : ℝ) (i : Fin n) : + gaussianMatrix n a i i = 1 := by + simp + +lemma gaussianMatrix_apply_pos (n : ℕ) (a : ℝ) (i j : Fin n) : + 0 < gaussianMatrix n a i j := + Real.exp_pos _ + +/-- Karlin's Gaussian matrix converges entrywise to the identity as its +parameter tends to positive infinity. -/ +theorem tendsto_gaussianMatrix_atTop (n : ℕ) : + Tendsto (gaussianMatrix n) atTop + (𝓝 (1 : Matrix (Fin n) (Fin n) ℝ)) := by + change Tendsto + (fun a => (gaussianMatrix n a : Fin n → Fin n → ℝ)) atTop + (𝓝 ((1 : Matrix (Fin n) (Fin n) ℝ) : Fin n → Fin n → ℝ)) + apply tendsto_pi_nhds.2 + intro i + apply tendsto_pi_nhds.2 + intro j + by_cases hij : i = j + · subst j + simp only [gaussianMatrix_apply_self, one_apply, if_pos] + exact tendsto_const_nhds + · have hcast : + (((i : ℕ) : ℝ) - ((j : ℕ) : ℝ)) ≠ 0 := by + rw [sub_ne_zero] + intro heq + have hval : (i : ℕ) = (j : ℕ) := by + exact_mod_cast heq + exact hij (Fin.ext hval) + have hsquare : + 0 < (((i : ℕ) : ℝ) - ((j : ℕ) : ℝ)) ^ 2 := + sq_pos_of_ne_zero hcast + have hneg : + -(((i : ℕ) : ℝ) - ((j : ℕ) : ℝ)) ^ 2 < 0 := + neg_lt_zero.mpr hsquare + have hlinear : + Tendsto + (fun a : ℝ => + a * -(((i : ℕ) : ℝ) - ((j : ℕ) : ℝ)) ^ 2) + atTop atBot := + tendsto_id.atTop_mul_const_of_neg hneg + have hexp := + Real.tendsto_exp_atBot.comp hlinear + convert hexp using 1 + · funext a + simp only [Function.comp_apply, gaussianMatrix_apply] + ring_nf + · simp [hij] + +/-- The finite restriction of Karlin's exponential kernel `exp (x * y)`. -/ +noncomputable def exponentialKernelMatrix {i j : Type*} + (x : i → ℝ) (y : j → ℝ) : Matrix i j ℝ := + fun i j => Real.exp (x i * y j) + +@[simp] lemma exponentialKernelMatrix_apply {i j : Type*} + (x : i → ℝ) (y : j → ℝ) (r : i) (c : j) : + exponentialKernelMatrix x y r c = Real.exp (x r * y c) := + rfl + +/-- Adjacent exponential-kernel row differences are interval integrals. -/ +lemma exponentialKernelMatrix_succ_sub_castSucc_eq_intervalIntegral {n : ℕ} + (x : Fin (n + 1) → ℝ) (y : Fin n → ℝ) (i j : Fin n) : + exponentialKernelMatrix x y i.succ j - + exponentialKernelMatrix x y i.castSucc j = + ∫ t in x i.castSucc..x i.succ, y j * Real.exp (t * y j) := by + rw [Real.intervalIntegral_mul_exp_mul] + rfl + +/-- The adjacent-difference determinant is a restricted-volume product integral. -/ +theorem det_adjacentRowDiff_exponentialKernelMatrix_eq_integral {n : ℕ} + (x : Fin (n + 1) → ℝ) (y : Fin n → ℝ) (hx : StrictMono x) : + (Matrix.of fun i j => + exponentialKernelMatrix x y i.succ j - + exponentialKernelMatrix x y i.castSucc j).det = + ∫ t : Fin n → ℝ, + (Matrix.of fun i j => y j * Real.exp (t i * y j)).det + ∂Measure.pi (fun i => + volume.restrict (Set.Ioc (x i.castSucc) (x i.succ))) := by + let μ : Fin n → Measure ℝ := fun i => + volume.restrict (Set.Ioc (x i.castSucc) (x i.succ)) + let f : Fin n → ℝ → Fin n → ℝ := fun _ t j => + y j * Real.exp (t * y j) + have hf : ∀ i j, Integrable (fun t => f i t j) (μ i) := by + intro i j + change IntegrableOn (fun t => f i t j) + (Set.Ioc (x i.castSucc) (x i.succ)) volume + rw [← intervalIntegrable_iff_integrableOn_Ioc_of_le + (hx i.castSucc_lt_succ).le] + exact + (continuous_const.mul + (Real.continuous_exp.comp (continuous_id.mul continuous_const))).intervalIntegrable _ _ + have hmatrix : + Matrix.of (fun i j => + exponentialKernelMatrix x y i.succ j - + exponentialKernelMatrix x y i.castSucc j) = + Matrix.of fun i j => ∫ t, f i t j ∂μ i := by + ext i j + simp only [Matrix.of_apply] + rw [exponentialKernelMatrix_succ_sub_castSucc_eq_intervalIntegral] + rw [intervalIntegral.integral_of_le (hx i.castSucc_lt_succ).le] + rw [hmatrix, det_integral_rows_eq_integral_det μ f hf] + +/-- Translating all first coordinates multiplies the exponential-kernel +determinant by an explicit positive column factor. -/ +theorem det_exponentialKernelMatrix_add_const_left {q : ℕ} + (x y : Fin q → ℝ) (c : ℝ) : + (exponentialKernelMatrix (fun i => x i + c) y).det = + (∏ j, Real.exp (c * y j)) * + (exponentialKernelMatrix x y).det := by + have hmatrix : + exponentialKernelMatrix (fun i => x i + c) y = + of fun i j => + Real.exp (c * y j) * exponentialKernelMatrix x y i j := by + ext i j + simp only [exponentialKernelMatrix_apply, of_apply] + rw [show (x i + c) * y j = c * y j + x i * y j by ring, + Real.exp_add] + rw [hmatrix, det_mul_row] + +/-- Translating all second coordinates multiplies the exponential-kernel +determinant by an explicit positive row factor. -/ +theorem det_exponentialKernelMatrix_add_const_right {q : ℕ} + (x y : Fin q → ℝ) (c : ℝ) : + (exponentialKernelMatrix x (fun j => y j + c)).det = + (∏ i, Real.exp (x i * c)) * + (exponentialKernelMatrix x y).det := by + have hmatrix : + exponentialKernelMatrix x (fun j => y j + c) = + of fun i j => + Real.exp (x i * c) * exponentialKernelMatrix x y i j := by + ext i j + simp only [exponentialKernelMatrix_apply, of_apply] + rw [show x i * (y j + c) = x i * c + x i * y j by ring, + Real.exp_add] + rw [hmatrix, det_mul_column] + +theorem det_exponentialKernelMatrix_add_const_left_pos_iff {q : ℕ} + (x y : Fin q → ℝ) (c : ℝ) : + 0 < (exponentialKernelMatrix (fun i => x i + c) y).det ↔ + 0 < (exponentialKernelMatrix x y).det := by + rw [det_exponentialKernelMatrix_add_const_left] + exact mul_pos_iff_of_pos_left (by positivity) + +theorem det_exponentialKernelMatrix_add_const_right_pos_iff {q : ℕ} + (x y : Fin q → ℝ) (c : ℝ) : + 0 < (exponentialKernelMatrix x (fun j => y j + c)).det ↔ + 0 < (exponentialKernelMatrix x y).det := by + rw [det_exponentialKernelMatrix_add_const_right] + exact mul_pos_iff_of_pos_left (by positivity) + +/-- The transpose of the Wronskian matrix of the functions +`t ↦ exp (y i * t)`. -/ +noncomputable def exponentialWronskianMatrix {q : ℕ} + (y : Fin q → ℝ) (t : ℝ) : Matrix (Fin q) (Fin q) ℝ := + fun i j => iteratedDeriv (j : ℕ) (fun s => Real.exp (y i * s)) t + +@[simp] lemma exponentialWronskianMatrix_apply {q : ℕ} + (y : Fin q → ℝ) (t : ℝ) (i j : Fin q) : + exponentialWronskianMatrix y t i j = + y i ^ (j : ℕ) * Real.exp (t * y i) := by + rw [exponentialWronskianMatrix, + congrFun (iteratedDeriv_exp_const_mul (j : ℕ) (y i)) t] + congr 2 + exact mul_comm _ _ + +/-- Karlin's exponential Wronskian is a positive exponential factor times a +Vandermonde determinant. -/ +theorem det_exponentialWronskianMatrix_eq {q : ℕ} + (y : Fin q → ℝ) (t : ℝ) : + (exponentialWronskianMatrix y t).det = + (∏ i, Real.exp (t * y i)) * (vandermonde y).det := by + have hmatrix : + exponentialWronskianMatrix y t = + of fun i j => + Real.exp (t * y i) * vandermonde y i j := by + ext i j + simp only [exponentialWronskianMatrix_apply, of_apply, + vandermonde_apply] + ring + rw [hmatrix, det_mul_column] + +/-- The exponential Wronskian has the positive orientation required in +Karlin's extended-determinant argument. -/ +theorem det_exponentialWronskianMatrix_pos {q : ℕ} + {y : Fin q → ℝ} (hy : StrictMono y) (t : ℝ) : + 0 < (exponentialWronskianMatrix y t).det := by + rw [det_exponentialWronskianMatrix_eq] + exact mul_pos (by positivity) (det_vandermonde_pos_of_strictMono hy) + +/-- A Gaussian minor is an exponential-kernel minor times positive row and +column factors. This is the algebraic reduction in Karlin's proof of +Proposition V.1.1. -/ +theorem det_gaussianMatrix_submatrix_eq {n q : ℕ} (a : ℝ) + (rows cols : Fin q → Fin n) : + ((gaussianMatrix n a).submatrix rows cols).det = + (∏ i, Real.exp (-a * (((rows i : Fin n) : ℕ) : ℝ) ^ 2)) * + (∏ j, Real.exp (-a * (((cols j : Fin n) : ℕ) : ℝ) ^ 2)) * + (exponentialKernelMatrix + (fun i => 2 * a * (((rows i : Fin n) : ℕ) : ℝ)) + (fun j => (((cols j : Fin n) : ℕ) : ℝ))).det := by + let rowFactor : Fin q → ℝ := + fun i => Real.exp (-a * (((rows i : Fin n) : ℕ) : ℝ) ^ 2) + let colFactor : Fin q → ℝ := + fun j => Real.exp (-a * (((cols j : Fin n) : ℕ) : ℝ) ^ 2) + let E : Matrix (Fin q) (Fin q) ℝ := + exponentialKernelMatrix + (fun i => 2 * a * (((rows i : Fin n) : ℕ) : ℝ)) + (fun j => (((cols j : Fin n) : ℕ) : ℝ)) + have hmatrix : + (gaussianMatrix n a).submatrix rows cols = + of fun i j => rowFactor i * (colFactor j * E i j) := by + ext i j + simp only [submatrix_apply, gaussianMatrix_apply, of_apply, rowFactor, + colFactor, E, exponentialKernelMatrix_apply] + rw [show + -a * ((((rows i : Fin n) : ℕ) : ℝ) - + (((cols j : Fin n) : ℕ) : ℝ)) ^ 2 = + -a * (((rows i : Fin n) : ℕ) : ℝ) ^ 2 + + (-a * (((cols j : Fin n) : ℕ) : ℝ) ^ 2 + + (2 * a * (((rows i : Fin n) : ℕ) : ℝ)) * + (((cols j : Fin n) : ℕ) : ℝ)) by ring] + rw [Real.exp_add, Real.exp_add] + have hcol : + (of fun i j => colFactor j * E i j).det = + (∏ j, colFactor j) * E.det := + det_mul_row colFactor E + rw [hmatrix, det_mul_column] + change + (∏ i, rowFactor i) * + (of fun i j => colFactor j * E i j).det = + _ + rw [hcol] + dsimp only [rowFactor, colFactor, E] + ring + +/-- Transfer positivity from the exponential-kernel minor to the corresponding +Gaussian minor. + +The hypothesis is intentionally explicit: it is exactly Karlin III.1's +strict-total-positivity input. Keeping that analytic boundary visible lets us +formalize the Gaussian factorization without assuming Proposition V.1.1. -/ +theorem det_gaussianMatrix_submatrix_pos_of_exponentialKernel {n q : ℕ} + (a : ℝ) (rows cols : Fin q → Fin n) + (hkernel : + 0 < (exponentialKernelMatrix + (fun i => 2 * a * (((rows i : Fin n) : ℕ) : ℝ)) + (fun j => (((cols j : Fin n) : ℕ) : ℝ))).det) : + 0 < ((gaussianMatrix n a).submatrix rows cols).det := by + rw [det_gaussianMatrix_submatrix_eq] + positivity + +/-- The adjacent-difference determinant is positive under the smaller-minor hypothesis. -/ +theorem det_adjacentRowDiff_exponentialKernelMatrix_pos {n : ℕ} + (x : Fin (n + 1) → ℝ) (y : Fin n → ℝ) (hx : StrictMono x) + (hy : ∀ j, 0 < y j) + (hdet : ∀ t : Fin n → ℝ, StrictMono t → + 0 < (exponentialKernelMatrix t y).det) : + 0 < (Matrix.of fun i j => + exponentialKernelMatrix x y i.succ j - + exponentialKernelMatrix x y i.castSucc j).det := by + rw [det_adjacentRowDiff_exponentialKernelMatrix_eq_integral x y hx] + let μ : Fin n → Measure ℝ := fun i => + volume.restrict (Set.Ioc (x i.castSucc) (x i.succ)) + let f : Fin n → ℝ → Fin n → ℝ := fun _ t j => + y j * Real.exp (t * y j) + have hf : ∀ i j, Integrable (fun t => f i t j) (μ i) := by + intro i j + change IntegrableOn (fun t => f i t j) + (Set.Ioc (x i.castSucc) (x i.succ)) volume + rw [← intervalIntegrable_iff_integrableOn_Ioc_of_le + (hx i.castSucc_lt_succ).le] + exact + (continuous_const.mul + (Real.continuous_exp.comp (continuous_id.mul continuous_const))).intervalIntegrable _ _ + have hbox : ∀ᵐ t ∂Measure.pi μ, + ∀ i, t i ∈ Set.Ioc (x i.castSucc) (x i.succ) := by + rw [Filter.eventually_all] + intro i + exact Measure.tendsto_eval_ae_ae.eventually + (ae_restrict_mem measurableSet_Ioc) + have hpoint_pos : ∀ᵐ t ∂Measure.pi μ, + 0 < (Matrix.of fun i j => f i (t i) j).det := by + filter_upwards [hbox] with t ht + have htmono : StrictMono t := by + intro i j hij + exact (ht i).2.trans_lt + ((hx.monotone (Fin.mk_le_mk.mpr (Nat.succ_le_of_lt hij))).trans_lt (ht j).1) + rw [show Matrix.of (fun i j => f i (t i) j) = + Matrix.of fun i j => + y j * exponentialKernelMatrix t y i j by + ext i j + rfl, + Matrix.det_mul_row] + exact mul_pos (Finset.prod_pos fun j _ => hy j) (hdet t htmono) + have hdetInt : Integrable + (fun t : Fin n → ℝ => (Matrix.of fun i j => f i (t i) j).det) + (Measure.pi μ) := + integrable_det_rows μ f hf + have hsupp : Function.support + (fun t : Fin n → ℝ => (Matrix.of fun i j => f i (t i) j).det) =ᵐ[Measure.pi μ] + Set.univ := hpoint_pos.mono fun t ht => by + apply propext + change ((Matrix.of fun i j => f i (t i) j).det ≠ 0) ↔ True + exact iff_true_intro ht.ne' + rw [integral_pos_iff_support_of_nonneg_ae + (hpoint_pos.mono fun _ h => h.le) hdetInt, + measure_congr hsupp, Measure.pi_univ] + rw [pos_iff_ne_zero, Finset.prod_ne_zero_iff] + intro i _ + simpa [μ, Real.volume_Ioc] using hx i.castSucc_lt_succ + +/-- Strictly ordered exponential-kernel minors are positive. -/ +theorem det_exponentialKernelMatrix_pos {q : ℕ} + {x y : Fin q → ℝ} (hx : StrictMono x) (hy : StrictMono y) : + 0 < (exponentialKernelMatrix x y).det := by + induction q with + | zero => simp + | succ n ih => + let y0 : Fin (n + 1) → ℝ := fun j => y j - y 0 + have hy0 : StrictMono y0 := fun _ _ hij => + sub_lt_sub_right (hy hij) _ + have hy00 : y0 0 = 0 := by simp [y0] + have hy_eq : y = fun j => y0 j + y 0 := by + funext j + simp [y0] + rw [hy_eq] + apply (det_exponentialKernelMatrix_add_const_right_pos_iff + x y0 (y 0)).2 + have hfirst : ∀ i, exponentialKernelMatrix x y0 i 0 = 1 := by + intro i + change Real.exp (x i * y0 0) = 1 + rw [hy00] + simp + rw [det_eq_det_adjacentRowDiff_of_firstColumn_eq_one _ hfirst] + let yTail : Fin n → ℝ := fun j => y0 j.succ + have hyTail : StrictMono yTail := hy0.comp Fin.strictMono_succ + have hyTail_pos : ∀ j, 0 < yTail j := by + intro j + exact hy00 ▸ hy0 (by simp) + exact det_adjacentRowDiff_exponentialKernelMatrix_pos + x yTail hx hyTail_pos (fun t ht => ih ht hyTail) + +/-- Strictly ordered minors of Karlin's Gaussian matrix are positive. -/ +theorem det_gaussianMatrix_submatrix_pos {n q : ℕ} + (a : ℝ) (rows cols : Fin q → Fin n) (ha : 0 < a) + (hrows : StrictMono rows) (hcols : StrictMono cols) : + 0 < ((gaussianMatrix n a).submatrix rows cols).det := by + apply det_gaussianMatrix_submatrix_pos_of_exponentialKernel a rows cols + apply det_exponentialKernelMatrix_pos + · exact (Nat.strictMono_cast.comp + (Fin.val_strictMono.comp hrows)).const_mul (by positivity) + · exact Nat.strictMono_cast.comp (Fin.val_strictMono.comp hcols) + +end Matrix diff --git a/RealRooted/Mathlib/LinearAlgebra/Matrix/SignRegular.lean b/RealRooted/Mathlib/LinearAlgebra/Matrix/SignRegular.lean new file mode 100644 index 00000000..11a7dbea --- /dev/null +++ b/RealRooted/Mathlib/LinearAlgebra/Matrix/SignRegular.lean @@ -0,0 +1,177 @@ +import RealRooted.Mathlib.LinearAlgebra.Matrix.TotallyNonneg + +/-! +# Sign-consistent and sign-regular rectangular matrices + +This file introduces orientation-free predicates for Karlin's sign-consistent +and sign-regular matrices. Two minors have a common weak (respectively strict) +sign exactly when their product is nonnegative (respectively positive). +-/ + +public section + +namespace Matrix + +variable {R ι κ : Type*} [CommRing R] [PartialOrder R] +variable [Preorder ι] [Preorder κ] + +/-- The minors of order `q` of `M` have a common weak sign. -/ +def IsSignConsistentOrder (M : Matrix ι κ R) (q : ℕ) : Prop := + ∀ ⦃rows rows' : Fin q → ι⦄ ⦃cols cols' : Fin q → κ⦄, + StrictMono rows → StrictMono rows' → StrictMono cols → StrictMono cols' → + 0 ≤ (M.submatrix rows cols).det * (M.submatrix rows' cols').det + +/-- The minors of order `q` of `M` are nonzero and have a common strict sign. -/ +def IsStrictlySignConsistentOrder (M : Matrix ι κ R) (q : ℕ) : Prop := + ∀ ⦃rows rows' : Fin q → ι⦄ ⦃cols cols' : Fin q → κ⦄, + StrictMono rows → StrictMono rows' → StrictMono cols → StrictMono cols' → + 0 < (M.submatrix rows cols).det * (M.submatrix rows' cols').det + +/-- A matrix is sign regular if its minors have a common weak sign at every order. -/ +def IsSignRegular (M : Matrix ι κ R) : Prop := + ∀ q, M.IsSignConsistentOrder q + +/-- A matrix is strictly sign regular if its minors have a common strict sign +at every order. -/ +def IsStrictlySignRegular (M : Matrix ι κ R) : Prop := + ∀ q, M.IsStrictlySignConsistentOrder q + +protected lemma IsSignConsistentOrder.submatrix + {ι' κ' : Type*} [Preorder ι'] [Preorder κ'] {M : Matrix ι κ R} {q : ℕ} + (hM : M.IsSignConsistentOrder q) {rows : ι' → ι} {cols : κ' → κ} + (hrows : StrictMono rows) (hcols : StrictMono cols) : + (M.submatrix rows cols).IsSignConsistentOrder q := by + intro rows₁ rows₂ cols₁ cols₂ hrows₁ hrows₂ hcols₁ hcols₂ + simpa using hM (hrows.comp hrows₁) (hrows.comp hrows₂) + (hcols.comp hcols₁) (hcols.comp hcols₂) + +protected lemma IsStrictlySignConsistentOrder.submatrix + {ι' κ' : Type*} [Preorder ι'] [Preorder κ'] {M : Matrix ι κ R} {q : ℕ} + (hM : M.IsStrictlySignConsistentOrder q) {rows : ι' → ι} {cols : κ' → κ} + (hrows : StrictMono rows) (hcols : StrictMono cols) : + (M.submatrix rows cols).IsStrictlySignConsistentOrder q := by + intro rows₁ rows₂ cols₁ cols₂ hrows₁ hrows₂ hcols₁ hcols₂ + simpa using hM (hrows.comp hrows₁) (hrows.comp hrows₂) + (hcols.comp hcols₁) (hcols.comp hcols₂) + +omit [PartialOrder R] [Preorder ι] [Preorder κ] in +private lemma det_transpose_submatrix + (M : Matrix ι κ R) {q : ℕ} (rows : Fin q → κ) (cols : Fin q → ι) : + (M.transpose.submatrix rows cols).det = (M.submatrix cols rows).det := by + rw [← Matrix.det_transpose (M.submatrix cols rows), Matrix.transpose_submatrix] + +protected lemma IsSignConsistentOrder.transpose {M : Matrix ι κ R} {q : ℕ} + (hM : M.IsSignConsistentOrder q) : M.transpose.IsSignConsistentOrder q := by + intro rows rows' cols cols' hrows hrows' hcols hcols' + rw [det_transpose_submatrix M rows cols, det_transpose_submatrix M rows' cols'] + exact hM hcols hcols' hrows hrows' + +protected lemma IsStrictlySignConsistentOrder.transpose {M : Matrix ι κ R} {q : ℕ} + (hM : M.IsStrictlySignConsistentOrder q) : + M.transpose.IsStrictlySignConsistentOrder q := by + intro rows rows' cols cols' hrows hrows' hcols hcols' + rw [det_transpose_submatrix M rows cols, det_transpose_submatrix M rows' cols'] + exact hM hcols hcols' hrows hrows' + +protected lemma IsSignRegular.submatrix + {ι' κ' : Type*} [Preorder ι'] [Preorder κ'] {M : Matrix ι κ R} + (hM : M.IsSignRegular) {rows : ι' → ι} {cols : κ' → κ} + (hrows : StrictMono rows) (hcols : StrictMono cols) : + (M.submatrix rows cols).IsSignRegular := + fun q ↦ (hM q).submatrix hrows hcols + +protected lemma IsStrictlySignRegular.submatrix + {ι' κ' : Type*} [Preorder ι'] [Preorder κ'] {M : Matrix ι κ R} + (hM : M.IsStrictlySignRegular) {rows : ι' → ι} {cols : κ' → κ} + (hrows : StrictMono rows) (hcols : StrictMono cols) : + (M.submatrix rows cols).IsStrictlySignRegular := + fun q ↦ (hM q).submatrix hrows hcols + +protected lemma IsSignRegular.transpose {M : Matrix ι κ R} + (hM : M.IsSignRegular) : M.transpose.IsSignRegular := + fun q ↦ (hM q).transpose + +protected lemma IsStrictlySignRegular.transpose {M : Matrix ι κ R} + (hM : M.IsStrictlySignRegular) : M.transpose.IsStrictlySignRegular := + fun q ↦ (hM q).transpose + +protected lemma IsStrictlySignConsistentOrder.toSignConsistentOrder + {M : Matrix ι κ R} {q : ℕ} (hM : M.IsStrictlySignConsistentOrder q) : + M.IsSignConsistentOrder q := by + intro rows rows' cols cols' hrows hrows' hcols hcols' + exact (hM hrows hrows' hcols hcols').le + +protected lemma IsStrictlySignRegular.toSignRegular {M : Matrix ι κ R} + (hM : M.IsStrictlySignRegular) : M.IsSignRegular := + fun q ↦ (hM q).toSignConsistentOrder + +section OrderedRing + +variable [IsStrictOrderedRing R] +variable {ι' κ' : Type*} [PartialOrder ι'] [PartialOrder κ'] + +lemma IsTotallyNonnegRect.isSignConsistentOrder {M : Matrix ι' κ' R} + (hM : M.IsTotallyNonnegRect) (q : ℕ) : M.IsSignConsistentOrder q := by + intro rows rows' cols cols' hrows hrows' hcols hcols' + exact mul_nonneg (hM hrows hcols) (hM hrows' hcols') + +lemma IsTotallyNonnegRect.isSignRegular {M : Matrix ι' κ' R} + (hM : M.IsTotallyNonnegRect) : M.IsSignRegular := + fun q ↦ hM.isSignConsistentOrder q + +lemma isStrictlySignConsistentOrder_of_posMinors {M : Matrix ι κ R} {q : ℕ} + (hM : + ∀ ⦃rows : Fin q → ι⦄ ⦃cols : Fin q → κ⦄, + StrictMono rows → StrictMono cols → 0 < (M.submatrix rows cols).det) : + M.IsStrictlySignConsistentOrder q := by + intro rows rows' cols cols' hrows hrows' hcols hcols' + exact mul_pos (hM hrows hcols) (hM hrows' hcols') + +end OrderedRing + +lemma IsSignConsistentOrder.minorProduct_nonneg {M : Matrix ι κ R} {q : ℕ} + (hM : M.IsSignConsistentOrder q) {cols : Fin q → κ} (hcols : StrictMono cols) : + ∀ ⦃rows rows' : Fin q → ι⦄, + StrictMono rows → StrictMono rows' → + 0 ≤ (M.submatrix rows cols).det * (M.submatrix rows' cols).det := by + intro rows rows' hrows hrows' + exact hM hrows hrows' hcols hcols + +lemma IsStrictlySignConsistentOrder.minorProduct_pos + {M : Matrix ι κ R} {q : ℕ} (hM : M.IsStrictlySignConsistentOrder q) + {cols : Fin q → κ} (hcols : StrictMono cols) : + ∀ ⦃rows rows' : Fin q → ι⦄, + StrictMono rows → StrictMono rows' → + 0 < (M.submatrix rows cols).det * (M.submatrix rows' cols).det := by + intro rows rows' hrows hrows' + exact hM hrows hrows' hcols hcols + +section LinearOrder + +variable {S : Type*} [CommRing S] [LinearOrder S] [IsStrictOrderedRing S] + +lemma IsSignConsistentOrder.minor_nonneg_of_pos + {M : Matrix ι κ S} {q : ℕ} (hM : M.IsSignConsistentOrder q) + {rows₀ : Fin q → ι} {cols₀ : Fin q → κ} + (hrows₀ : StrictMono rows₀) (hcols₀ : StrictMono cols₀) + (href : 0 < (M.submatrix rows₀ cols₀).det) + {rows : Fin q → ι} {cols : Fin q → κ} + (hrows : StrictMono rows) (hcols : StrictMono cols) : + 0 ≤ (M.submatrix rows cols).det := + nonneg_of_mul_nonneg_left + (hM hrows hrows₀ hcols hcols₀) href + +lemma IsSignConsistentOrder.minor_nonpos_of_neg + {M : Matrix ι κ S} {q : ℕ} (hM : M.IsSignConsistentOrder q) + {rows₀ : Fin q → ι} {cols₀ : Fin q → κ} + (hrows₀ : StrictMono rows₀) (hcols₀ : StrictMono cols₀) + (href : (M.submatrix rows₀ cols₀).det < 0) + {rows : Fin q → ι} {cols : Fin q → κ} + (hrows : StrictMono rows) (hcols : StrictMono cols) : + (M.submatrix rows cols).det ≤ 0 := + nonpos_of_mul_nonneg_left + (hM hrows hrows₀ hcols hcols₀) href + +end LinearOrder + +end Matrix diff --git a/RealRooted/Mathlib/LinearAlgebra/Matrix/SignRegularRankDeficient.lean b/RealRooted/Mathlib/LinearAlgebra/Matrix/SignRegularRankDeficient.lean new file mode 100644 index 00000000..debb5ae4 --- /dev/null +++ b/RealRooted/Mathlib/LinearAlgebra/Matrix/SignRegularRankDeficient.lean @@ -0,0 +1,930 @@ +import Mathlib.LinearAlgebra.LinearIndependent.Lemmas +import Mathlib.LinearAlgebra.Matrix.Rank +import RealRooted.Mathlib.LinearAlgebra.Matrix.SignRegularVariation + +/-! +# Rank-deficient sign-consistent matrices + +This file develops the rank-deficient induction in Karlin, *Total Positivity*, +Volume I, Chapter V, Section 1, Theorem 1.3. The first lemmas formalize the +selected-row kernel perturbation in equations (1.1) on printed pages 221--222. +-/ + +/-- A finite matrix of rank `r` has a nonzero `r`-minor with increasingly +ordered row and column selectors. -/ +theorem Matrix.exists_ordered_minor_ne_zero_of_rank_eq + {R : Type*} [Field R] {n m r : ℕ} + (A : Matrix (Fin n) (Fin m) R) (hrank : A.rank = r) : + ∃ rows : Fin r → Fin n, ∃ cols : Fin r → Fin m, + StrictMono rows ∧ StrictMono cols ∧ + (A.submatrix rows cols).det ≠ 0 := by + obtain ⟨κ, a, ha, hspan, hli⟩ := + exists_linearIndependent' R A.col + letI : Finite κ := Finite.of_injective a ha + letI : Fintype κ := Fintype.ofFinite κ + have hcard : Fintype.card κ = r := by + calc + Fintype.card κ = + Module.finrank R (Submodule.span R (Set.range (A.col ∘ a))) := + (finrank_span_eq_card hli).symm + _ = Module.finrank R (Submodule.span R (Set.range A.col)) := by + rw [hspan] + _ = A.rank := (Matrix.rank_eq_finrank_span_cols A).symm + _ = r := hrank + let e : Fin r ≃ κ := (Fintype.equivFinOfCardEq hcard).symm + let f : Fin r → Fin m := a ∘ e + have hf : Function.Injective f := ha.comp e.injective + let B : Matrix (Fin n) (Fin r) R := A.submatrix id f + have hB : Function.Injective B.mulVec := by + rw [Matrix.mulVec_injective_iff] + change LinearIndependent R (A.col ∘ f) + simpa only [f, Function.comp_assoc] using hli.comp e e.injective + obtain ⟨rows, hrows, hdet⟩ := + Matrix.exists_ordered_minor_ne_zero_of_mulVec_injective + B hB id strictMono_id + have hdetf : (A.submatrix rows f).det ≠ 0 := by + simpa only [B, Matrix.submatrix_submatrix, Function.id_comp, + Function.comp_id] using hdet + obtain ⟨s, p, hp⟩ := + Set.powersetCard.exists_orderEmb_comp_perm_eq_of_injective f hf + let cols : Fin r ↪o Fin m := Set.powersetCard.ofFinEmbEquiv.symm s + refine ⟨rows, cols, hrows, cols.strictMono, ?_⟩ + intro hzero + apply hdetf + have hmatrix : + A.submatrix rows f = + (A.submatrix rows cols).submatrix id p := by + ext i j + simp only [Matrix.submatrix_apply, id_eq] + rw [hp j] + rw [hmatrix, Matrix.det_permute', hzero, mul_zero] + +/-- Karlin's signed row-cofactor vector of a singular square matrix lies in +its kernel. The retained-row equations come from the rectangular alternating +minor identity; Laplace expansion supplies the omitted-row equation. -/ +theorem Matrix.mulVec_signedRowCofactor_eq_zero_of_det_eq_zero + {R : Type*} [CommRing R] {k : ℕ} + (B : Matrix (Fin (k + 1)) (Fin (k + 1)) R) + (i0 : Fin (k + 1)) (hdet : B.det = 0) : + B.mulVec (fun j => (-1 : R) ^ (i0 + j : ℕ) * + (B.submatrix i0.succAbove j.succAbove).det) = 0 := by + let C : Matrix (Fin k) (Fin (k + 1)) R := + B.submatrix i0.succAbove id + have hminor (j : Fin (k + 1)) : + ((C.transpose).submatrix j.succAbove id).det = + (B.submatrix i0.succAbove j.succAbove).det := by + rw [← Matrix.det_transpose] + rfl + let z0 : Fin (k + 1) → R := fun j => + (-1 : R) ^ (j : ℕ) * (B.submatrix i0.succAbove j.succAbove).det + let z : Fin (k + 1) → R := fun j => + (-1 : R) ^ (i0 + j : ℕ) * (B.submatrix i0.succAbove j.succAbove).det + have hremoved0 : C.mulVec z0 = 0 := by + have hkernel := + Matrix.transpose_mulVec_alternating_det_submatrix_succAbove C.transpose + rw [Matrix.transpose_transpose] at hkernel + simp_rw [hminor] at hkernel + simpa only [z0] using hkernel + have hz : z = (-1 : R) ^ (i0 : ℕ) • z0 := by + funext j + simp only [z, z0, Pi.smul_apply, smul_eq_mul, pow_add, mul_assoc] + have hremoved : C.mulVec z = 0 := by + rw [hz, Matrix.mulVec_smul, hremoved0, smul_zero] + change B.mulVec z = 0 + apply funext + refine Fin.succAboveCases i0 ?_ (fun i => ?_) + · simp only [Matrix.mulVec, dotProduct, z, Pi.zero_apply] + calc + ∑ j : Fin (k + 1), B i0 j * ((-1 : R) ^ + ((i0 : ℕ) + (j : ℕ)) * + (B.submatrix i0.succAbove j.succAbove).det) = + ∑ j : Fin (k + 1), (-1 : R) ^ ((i0 : ℕ) + (j : ℕ)) * + B i0 j * (B.submatrix i0.succAbove j.succAbove).det := by + apply Finset.sum_congr rfl + intro j _ + ring + _ = B.det := (Matrix.det_succ_row B i0).symm + _ = 0 := hdet + · have hi := congrFun hremoved i + simpa only [C, Matrix.mulVec, dotProduct, Matrix.submatrix_apply, id_eq, + Pi.zero_apply] using hi + +/-- Deleting a column preserves the rank when a maximal nonzero minor avoids +that column. This is the common rank step in Karlin's two deficient-rank +branches; the cofactor and rank-basis kernel constructions remain separate. -/ +theorem Matrix.rank_deleteColumn_eq_of_minor_ne_zero + {R : Type*} [Field R] {n k r : ℕ} + (A : Matrix (Fin n) (Fin (k + 1)) R) + (hrank : A.rank = r) (j0 : Fin (k + 1)) + (rows : Fin r → Fin n) (cols : Fin r → Fin k) + (hminor : + (A.submatrix rows (j0.succAbove ∘ cols)).det ≠ 0) : + (A.submatrix id j0.succAbove).rank = r := by + let A' : Matrix (Fin n) (Fin k) R := A.submatrix id j0.succAbove + have hdet : (A'.submatrix rows cols).det ≠ 0 := by + simpa only [A', Matrix.submatrix_submatrix, Function.id_comp] using hminor + have hunit : IsUnit (A'.submatrix rows cols) := by + rw [Matrix.isUnit_iff_isUnit_det, isUnit_iff_ne_zero] + exact hdet + apply le_antisymm + · calc + A'.rank ≤ A.rank := Matrix.rank_submatrix_le A id j0.succAbove + _ = r := hrank + · calc + r = (A'.submatrix rows cols).rank := by + simpa using (Matrix.rank_of_isUnit _ hunit).symm + _ ≤ A'.rank := Matrix.rank_submatrix_le A' rows cols + +/-- Karlin's nonzero-cofactor branch for a selected singular square submatrix. +The displayed signed cofactor vector witnesses the selected-row kernel, while +the same cofactor proves both the ambient rank and rank-preserving deletion. -/ +theorem Matrix.signedRowCofactor_spec_of_minor_ne_zero + {R : Type*} [Field R] {n k : ℕ} + (A : Matrix (Fin n) (Fin (k + 1)) R) + (rows : Fin (k + 1) → Fin n) (i0 j0 : Fin (k + 1)) + (hrank_lt : A.rank < k + 1) + (hminor : + ((A.submatrix rows id).submatrix + i0.succAbove j0.succAbove).det ≠ 0) : + let B := A.submatrix rows id + let z : Fin (k + 1) → R := fun j => + (-1 : R) ^ (i0 + j : ℕ) * + (B.submatrix i0.succAbove j.succAbove).det + A.rank = k ∧ B.mulVec z = 0 ∧ z j0 ≠ 0 ∧ + (A.submatrix id j0.succAbove).rank = k := by + let B : Matrix (Fin (k + 1)) (Fin (k + 1)) R := + A.submatrix rows id + let z : Fin (k + 1) → R := fun j => + (-1 : R) ^ (i0 + j : ℕ) * + (B.submatrix i0.succAbove j.succAbove).det + change A.rank = k ∧ B.mulVec z = 0 ∧ z j0 ≠ 0 ∧ + (A.submatrix id j0.succAbove).rank = k + have hunit : IsUnit (B.submatrix i0.succAbove j0.succAbove) := by + rw [Matrix.isUnit_iff_isUnit_det, isUnit_iff_ne_zero] + simpa only [B] using hminor + have hcofactor_rank : + (B.submatrix i0.succAbove j0.succAbove).rank = k := by + simpa using Matrix.rank_of_isUnit _ hunit + have hrank_ge : k ≤ A.rank := by + calc + k = (B.submatrix i0.succAbove j0.succAbove).rank := + hcofactor_rank.symm + _ ≤ B.rank := + Matrix.rank_submatrix_le B i0.succAbove j0.succAbove + _ ≤ A.rank := Matrix.rank_submatrix_le A rows id + have hrank : A.rank = k := by + lia + have hdet : B.det = 0 := by + by_contra hdet + have hBunit : IsUnit B := by + rw [Matrix.isUnit_iff_isUnit_det, isUnit_iff_ne_zero] + exact hdet + have hBrank : B.rank = k + 1 := by + simpa using Matrix.rank_of_isUnit B hBunit + have hle : B.rank ≤ A.rank := Matrix.rank_submatrix_le A rows id + rw [hBrank, hrank] at hle + lia + have hkernel : B.mulVec z = 0 := by + exact B.mulVec_signedRowCofactor_eq_zero_of_det_eq_zero i0 hdet + have hzj0 : z j0 ≠ 0 := by + exact mul_ne_zero (pow_ne_zero _ (by simp)) (by + simpa only [B] using hminor) + have hminorA : + (A.submatrix (rows ∘ i0.succAbove) + (j0.succAbove ∘ (id : Fin k → Fin k))).det ≠ 0 := by + simpa only [B, Matrix.submatrix_submatrix, Function.id_comp, + Function.comp_id] using hminor + have hdelete : + (A.submatrix id j0.succAbove).rank = k := + A.rank_deleteColumn_eq_of_minor_ne_zero hrank j0 + (rows ∘ i0.succAbove) id hminorA + exact ⟨hrank, hkernel, hzj0, hdelete⟩ + +/-- A zero coefficient can be removed together with its matrix column when +forming a matrix-vector product. -/ +theorem Matrix.mulVec_eq_deleteColumn_mulVec_removeNth_of_apply_eq_zero + {R : Type*} [NonUnitalNonAssocSemiring R] {n k : ℕ} + (A : Matrix (Fin n) (Fin (k + 1)) R) + (d : Fin (k + 1) → R) (j0 : Fin (k + 1)) + (hd : d j0 = 0) : + A.mulVec d = + (A.submatrix id j0.succAbove).mulVec (Fin.removeNth j0 d) := by + funext i + simp only [Matrix.mulVec, dotProduct, Matrix.submatrix_apply, id_eq, + Fin.removeNth] + rw [Fin.sum_univ_succAbove (fun j => A i j * d j) j0, hd, mul_zero, + zero_add] + +/-- Karlin's coefficient cancellation: perturb by the unique scalar that +zeros coordinate `j0`, then remove that coordinate and its matrix column. -/ +theorem Matrix.mulVec_add_neg_div_smul_eq_deleteColumn_mulVec + {R : Type*} [DivisionRing R] {n k : ℕ} + (A : Matrix (Fin n) (Fin (k + 1)) R) + (c z : Fin (k + 1) → R) (j0 : Fin (k + 1)) + (hz : z j0 ≠ 0) : + A.mulVec (c + (-c j0 / z j0) • z) = + (A.submatrix id j0.succAbove).mulVec + (Fin.removeNth j0 (c + (-c j0 / z j0) • z)) := by + apply A.mulVec_eq_deleteColumn_mulVec_removeNth_of_apply_eq_zero + simp only [Pi.add_apply, Pi.smul_apply, smul_eq_mul] + rw [div_mul_cancel₀ _ hz, add_neg_cancel] + +/-- Perturbing coefficients along a vector annihilated by a selected-row +submatrix does not change the selected coordinates of the matrix-vector +product. -/ +theorem Matrix.mulVec_add_smul_apply_eq_of_submatrix_mulVec_eq_zero + {n m k : ℕ} (A : Matrix (Fin n) (Fin m) ℝ) + (rows : Fin k → Fin n) (c z : Fin m → ℝ) + (hz : (A.submatrix rows id).mulVec z = 0) + (t : ℝ) (i : Fin k) : + A.mulVec (c + t • z) (rows i) = A.mulVec c (rows i) := by + have hzi : A.mulVec z (rows i) = 0 := by + have hi := congrFun hz i + simpa only [Matrix.mulVec, dotProduct, Matrix.submatrix_apply, id_eq, + Pi.zero_apply] using hi + rw [Matrix.mulVec_add, Matrix.mulVec_smul] + simp [hzi] + +/-- A selected alternating witness survives Karlin's kernel perturbation of +the coefficient vector. -/ +theorem Fin.StrictlyAlternates.matrix_mulVec_add_smul + {n m k : ℕ} {A : Matrix (Fin n) (Fin m) ℝ} + {rows : Fin (k + 1) → Fin n} {c z : Fin m → ℝ} + (h : StrictlyAlternates (fun i => A.mulVec c (rows i))) + (hz : (A.submatrix rows id).mulVec z = 0) + (t : ℝ) : + StrictlyAlternates (fun i => A.mulVec (c + t • z) (rows i)) := by + intro i + change + A.mulVec (c + t • z) (rows i.castSucc) * + A.mulVec (c + t • z) (rows i.succ) < 0 + have heq (j : Fin (k + 1)) := + A.mulVec_add_smul_apply_eq_of_submatrix_mulVec_eq_zero rows c z hz t j + rw [heq i.castSucc, heq i.succ] + exact h i + +/-- Karlin's nonzero-cofactor branch contradicts the full-rank variation +bound after the source-prescribed coefficient cancellation and column +deletion. -/ +theorem Matrix.IsSignConsistentOrder.not_strictlyAlternates_mulVec_of_cofactor_ne_zero + {n k : ℕ} {A : Matrix (Fin n) (Fin (k + 1)) ℝ} + (hA : A.IsSignConsistentOrder k) + (hk : 0 < k) + (rows : Fin (k + 1) → Fin n) (hrows : StrictMono rows) + (i0 j0 : Fin (k + 1)) + (hrank_lt : A.rank < k + 1) + (hminor : + ((A.submatrix rows id).submatrix + i0.succAbove j0.succAbove).det ≠ 0) + (c : Fin (k + 1) → ℝ) + (hAlt : Fin.StrictlyAlternates (fun i => A.mulVec c (rows i))) : + False := by + let B : Matrix (Fin (k + 1)) (Fin (k + 1)) ℝ := + A.submatrix rows id + let z : Fin (k + 1) → ℝ := fun j => + (-1 : ℝ) ^ (i0 + j : ℕ) * + (B.submatrix i0.succAbove j.succAbove).det + let A' : Matrix (Fin n) (Fin k) ℝ := + A.submatrix id j0.succAbove + have hcase : + A.rank = k ∧ B.mulVec z = 0 ∧ z j0 ≠ 0 ∧ A'.rank = k := by + simpa only [B, z, A'] using + A.signedRowCofactor_spec_of_minor_ne_zero + rows i0 j0 hrank_lt hminor + obtain ⟨_hrank, hkernel, hzj0, hdelete⟩ := hcase + let t0 : ℝ := -c j0 / z j0 + let d : Fin (k + 1) → ℝ := c + t0 • z + let d' : Fin k → ℝ := Fin.removeNth j0 d + have hAltPert : + Fin.StrictlyAlternates (fun i => A.mulVec d (rows i)) := by + simpa only [d, t0] using + hAlt.matrix_mulVec_add_smul hkernel t0 + have hreassemble : A.mulVec d = A'.mulVec d' := by + simpa only [A', d', d, t0] using + A.mulVec_add_neg_div_smul_eq_deleteColumn_mulVec c z j0 hzj0 + have hAltDeleted : + Fin.StrictlyAlternates (fun i => A'.mulVec d' (rows i)) := by + rw [hreassemble] at hAltPert + exact hAltPert + have hA' : A'.IsSignConsistentOrder k := by + exact hA.submatrix strictMono_id (Fin.strictMono_succAbove j0) + have hk1n : k + 1 ≤ n := by + simpa using Fintype.card_le_of_injective rows hrows.injective + have hkn : k ≤ n := (Nat.le_succ k).trans hk1n + have hA'inj : Function.Injective A'.mulVec := by + rw [Matrix.mulVec_injective_iff, + linearIndependent_iff_card_eq_finrank_span] + simpa only [Fintype.card_fin, Set.finrank] using + hdelete.symm.trans (Matrix.rank_eq_finrank_span_cols A') + have hlower : k ≤ Fin.signVariations (A'.mulVec d') := + hAltDeleted.le_signVariations_of_strictMono hrows + have hupper : Fin.signVariations (A'.mulVec d') ≤ k - 1 := + hA'.signVariations_mulVec_le_card_sub_one hkn hA'inj d' + lia + +/-- Extending a coefficient vector by zero along an injective column selector +turns the ambient matrix-vector product into the selected-column product. -/ +theorem Matrix.mulVec_extend_eq_submatrix_mulVec + {R : Type*} [NonUnitalNonAssocSemiring R] + {ι κ κ' : Type*} [Fintype κ] [Fintype κ'] + (A : Matrix ι κ R) (cols : κ' → κ) + (hcols : Function.Injective cols) (d : κ' → R) : + A.mulVec (Function.extend cols d 0) = + (A.submatrix id cols).mulVec d := by + classical + funext i + simp only [Matrix.mulVec, dotProduct, Matrix.submatrix_apply, id_eq] + symm + apply Fintype.sum_of_injective cols hcols + · intro j hj + rw [Function.extend_apply' d (0 : κ → R) j hj, Pi.zero_apply, + mul_zero] + · intro j + rw [hcols.extend_apply d (0 : κ → R) j] + +/-- Karlin's repaired Case B relation after coordinates of the omitted column +in the retained column basis have been chosen. The relation is explicitly +supported on those basis columns and `j0`; no arbitrary kernel coordinate is +prescribed. -/ +theorem Matrix.supportedColumnRelation_spec + {R : Type*} [Field R] {n m r : ℕ} + (A : Matrix (Fin n) (Fin (m + 1)) R) + (j0 : Fin (m + 1)) + (rows : Fin r → Fin n) (cols : Fin r → Fin m) + (hcols : Function.Injective cols) + (hrank : A.rank = r) + (hminor : + (A.submatrix rows (j0.succAbove ∘ cols)).det ≠ 0) + (d : Fin r → R) + (hcombo : + (A.submatrix id (j0.succAbove ∘ cols)).mulVec d = A.col j0) : + let selected := j0.succAbove ∘ cols + let z : Fin (m + 1) → R := + Function.extend selected d 0 - Pi.single j0 1 + A.mulVec z = 0 ∧ z j0 = -1 ∧ + (A.submatrix id j0.succAbove).rank = r := by + let selected : Fin r → Fin (m + 1) := j0.succAbove ∘ cols + let z : Fin (m + 1) → R := + Function.extend selected d 0 - Pi.single j0 1 + change A.mulVec z = 0 ∧ z j0 = -1 ∧ + (A.submatrix id j0.succAbove).rank = r + have hselected : Function.Injective selected := + (Fin.strictMono_succAbove j0).injective.comp hcols + have hj0 : j0 ∉ Set.range selected := by + rintro ⟨i, hi⟩ + exact (Fin.succAbove_ne j0 (cols i)) (by + simpa only [selected, Function.comp_apply] using hi) + have hkernel : A.mulVec z = 0 := by + change A.mulVec + (Function.extend selected d 0 - Pi.single j0 1) = 0 + rw [Matrix.mulVec_sub, + A.mulVec_extend_eq_submatrix_mulVec selected hselected d, + Matrix.mulVec_single_one] + simpa only [selected] using sub_eq_zero.mpr hcombo + have hzj0 : z j0 = -1 := by + simp only [z, Pi.sub_apply] + rw [Function.extend_apply' d (0 : Fin (m + 1) → R) j0 hj0, + Pi.zero_apply, Pi.single_eq_same, zero_sub] + exact ⟨hkernel, hzj0, + A.rank_deleteColumn_eq_of_minor_ne_zero hrank j0 rows cols hminor⟩ + +/-- A rank-sized minor avoiding `j0` produces Karlin's supported Case B +relation and proves that deleting `j0` preserves rank. The printed source's +arbitrary-coordinate assertion is not used: equality of the retained and +ambient column-space dimensions supplies the omitted column's coordinates. -/ +theorem Matrix.exists_supportedColumnRelation_of_minor_ne_zero + {R : Type*} [Field R] {n m r : ℕ} + (A : Matrix (Fin n) (Fin (m + 1)) R) + (j0 : Fin (m + 1)) + (rows : Fin r → Fin n) (cols : Fin r → Fin m) + (hcols : Function.Injective cols) + (hrank : A.rank = r) + (hminor : + (A.submatrix rows (j0.succAbove ∘ cols)).det ≠ 0) : + ∃ d : Fin r → R, + let selected := j0.succAbove ∘ cols + let z : Fin (m + 1) → R := + Function.extend selected d 0 - Pi.single j0 1 + A.mulVec z = 0 ∧ z j0 = -1 ∧ + (A.submatrix id j0.succAbove).rank = r := by + let selected : Fin r → Fin (m + 1) := j0.succAbove ∘ cols + let B : Matrix (Fin n) (Fin r) R := A.submatrix id selected + have hunit : IsUnit (B.submatrix rows id) := by + rw [Matrix.isUnit_iff_isUnit_det, isUnit_iff_ne_zero] + simpa only [B, selected, Matrix.submatrix_submatrix, + Function.id_comp, Function.comp_id] using hminor + have hminor_rank : (B.submatrix rows id).rank = r := by + simpa using Matrix.rank_of_isUnit _ hunit + have hBge : r ≤ B.rank := by + calc + r = (B.submatrix rows id).rank := hminor_rank.symm + _ ≤ B.rank := Matrix.rank_submatrix_le B rows id + have hBle : B.rank ≤ r := by + calc + B.rank ≤ A.rank := Matrix.rank_submatrix_le A id selected + _ = r := hrank + have hBrank : B.rank = r := le_antisymm hBle hBge + have hrange_le : + LinearMap.range B.mulVecLin ≤ LinearMap.range A.mulVecLin := by + rw [Matrix.range_mulVecLin, Matrix.range_mulVecLin] + apply Submodule.span_mono + rintro _ ⟨j, rfl⟩ + exact ⟨selected j, rfl⟩ + have hrange : + LinearMap.range B.mulVecLin = LinearMap.range A.mulVecLin := + Submodule.eq_of_le_of_finrank_le hrange_le (by + change A.rank ≤ B.rank + rw [hrank, hBrank]) + have hcol : A.col j0 ∈ LinearMap.range B.mulVecLin := by + rw [hrange] + refine ⟨Pi.single j0 1, ?_⟩ + simpa only [Matrix.mulVecLin_apply] using A.mulVec_single_one j0 + obtain ⟨d, hd⟩ := hcol + refine ⟨d, ?_⟩ + have hcombo : + (A.submatrix id (j0.succAbove ∘ cols)).mulVec d = + A.col j0 := by + simpa only [B, selected, Matrix.mulVecLin_apply] using hd + exact A.supportedColumnRelation_spec j0 rows cols hcols hrank + hminor d hcombo + +/-- Karlin's deficient-rank induction adapter. The printed proof's claim that +an arbitrary kernel coordinate can be prescribed is false in general. Instead, +we choose `j0` outside the columns of a nonzero rank-sized minor. That minor +survives deletion of `j0`, while the selected columns express column `j0` +and produce a kernel relation whose `j0` coordinate is nonzero. -/ +theorem Matrix.exists_kernelVector_apply_ne_zero_rank_deleteColumn_eq_of_rank_lt + {R : Type*} [Field R] {n k r : ℕ} + (A : Matrix (Fin n) (Fin (k + 1)) R) + (hrank : A.rank = r) (hrank_lt : r < k + 1) : + ∃ j0 : Fin (k + 1), ∃ z : Fin (k + 1) → R, + A.mulVec z = 0 ∧ z j0 ≠ 0 ∧ + (A.submatrix id j0.succAbove).rank = r := by + classical + obtain ⟨rows, cols, _, hcols, hminor⟩ := + A.exists_ordered_minor_ne_zero_of_rank_eq hrank + have hcols_not_surj : ¬ Function.Surjective cols := by + intro hsurj + apply not_le_of_gt hrank_lt + simpa only [Fintype.card_fin] using + Fintype.card_le_of_surjective cols hsurj + obtain ⟨j0, hj0⟩ : ∃ j0, ∀ i, cols i ≠ j0 := by + simpa only [Function.Surjective, not_forall, not_exists] using + hcols_not_surj + choose cols' hcols' using fun i => + Fin.exists_succAbove_eq (hj0 i) + have hcols_factor : j0.succAbove ∘ cols' = cols := by + funext i + exact hcols' i + have hcols'_inj : Function.Injective cols' := by + intro i j hij + apply hcols.injective + rw [← hcols_factor] + exact congrArg j0.succAbove hij + have hminor' : + (A.submatrix rows (j0.succAbove ∘ cols')).det ≠ 0 := by + simpa only [hcols_factor] using hminor + obtain ⟨d, hkernel, hzj0, hdelete⟩ := + A.exists_supportedColumnRelation_of_minor_ne_zero + j0 rows cols' hcols'_inj hrank hminor' + refine ⟨j0, + Function.extend (j0.succAbove ∘ cols') d 0 - Pi.single j0 1, + hkernel, ?_, hdelete⟩ + rw [hzj0] + exact neg_ne_zero.mpr one_ne_zero + +/-- Karlin's positive-rank, one-column induction step for the deficient-rank +case. The induction hypothesis handles the rank-preserving matrix obtained by +deleting the column selected by +`exists_kernelVector_apply_ne_zero_rank_deleteColumn_eq_of_rank_lt`. -/ +theorem Matrix.IsSignConsistentOrder.signVariations_mulVec_le_rank_sub_one_of_induction + {n k r : ℕ} + {A : Matrix (Fin n) (Fin (k + 1)) ℝ} + (hA : A.IsSignConsistentOrder r) + (hrank : A.rank = r) + (hrank_lt : r < k + 1) + (hr : 0 < r) + (hind : + ∀ {B : Matrix (Fin n) (Fin k) ℝ}, + B.IsSignConsistentOrder r → + B.rank = r → + ∀ d : Fin k → ℝ, + Fin.signVariations (B.mulVec d) ≤ r - 1) + (c : Fin (k + 1) → ℝ) : + Fin.signVariations (A.mulVec c) ≤ r - 1 := by + by_contra hle + have hbad : r ≤ Fin.signVariations (A.mulVec c) := by + lia + obtain ⟨rows, hrows, halt⟩ := + Fin.exists_strictMono_strictlyAlternates_of_le_signVariations hr hbad + obtain ⟨j0, z, hkernel, hzj0, hdelete⟩ := + A.exists_kernelVector_apply_ne_zero_rank_deleteColumn_eq_of_rank_lt + hrank hrank_lt + have hzrows : (A.submatrix rows id).mulVec z = 0 := by + funext i + simpa only [Matrix.mulVec, Matrix.submatrix_apply, id_eq, + Pi.zero_apply] using congrFun hkernel (rows i) + let t : ℝ := -c j0 / z j0 + let d : Fin (k + 1) → ℝ := c + t • z + let B : Matrix (Fin n) (Fin k) ℝ := + A.submatrix id j0.succAbove + let d' : Fin k → ℝ := Fin.removeNth j0 d + have halt_d : + Fin.StrictlyAlternates (fun i => A.mulVec d (rows i)) := by + simpa only [d] using halt.matrix_mulVec_add_smul hzrows t + have hcancel : A.mulVec d = B.mulVec d' := by + simpa only [d, t, B, d'] using + A.mulVec_add_neg_div_smul_eq_deleteColumn_mulVec c z j0 hzj0 + have halt_delete : + Fin.StrictlyAlternates (fun i => B.mulVec d' (rows i)) := by + rw [← hcancel] + exact halt_d + have hB : B.IsSignConsistentOrder r := + hA.submatrix strictMono_id (Fin.strictMono_succAbove j0) + have hupper := hind hB hdelete d' + have hlower := halt_delete.le_signVariations_of_strictMono hrows + lia + +open Filter Topology + +/-- Karlin's rank-sensitive variation bound, proved by induction on the number +of columns. Rank zero gives the zero linear map, full column rank uses the +injective variation bound, and positive deficient rank uses the +rank-preserving deletion step. -/ +theorem Matrix.IsSignConsistentOrder.signVariations_mulVec_le_rank_sub_one + {n m r : ℕ} + {A : Matrix (Fin n) (Fin m) ℝ} + (hA : A.IsSignConsistentOrder r) + (hrank : A.rank = r) + (c : Fin m → ℝ) : + Fin.signVariations (A.mulVec c) ≤ r - 1 := by + have hzero : + ∀ {p : ℕ} {B : Matrix (Fin n) (Fin p) ℝ}, + B.rank = 0 → + ∀ d : Fin p → ℝ, + Fin.signVariations (B.mulVec d) ≤ 0 := by + intro p B hBrank d + have hlin : B.mulVecLin = 0 := + LinearMap.range_eq_bot.mp + (Submodule.finrank_eq_zero.mp hBrank) + rw [← Matrix.mulVecLin_apply, hlin, LinearMap.zero_apply, + Fin.signVariations_zero] + induction m generalizing r with + | zero => + have hrzero : r = 0 := by + have hrle : r ≤ 0 := hrank ▸ A.rank_le_width + exact Nat.eq_zero_of_le_zero hrle + rw [hrzero] at hrank ⊢ + exact hzero hrank c + | succ k ih => + by_cases hrzero : r = 0 + · rw [hrzero] at hrank ⊢ + exact hzero hrank c + · have hrpos : 0 < r := Nat.pos_of_ne_zero hrzero + have hrle : r ≤ k + 1 := by + rw [← hrank] + exact A.rank_le_width + by_cases hrfull : r = k + 1 + · rw [hrfull] at hA hrank ⊢ + have hkn : k + 1 ≤ n := hrank ▸ A.rank_le_height + have hAinj : Function.Injective A.mulVec := by + rw [Matrix.mulVec_injective_iff, + linearIndependent_iff_card_eq_finrank_span] + simpa only [Fintype.card_fin, Set.finrank] using + hrank.symm.trans (Matrix.rank_eq_finrank_span_cols A) + exact hA.signVariations_mulVec_le_card_sub_one hkn hAinj c + · have hrlt : r < k + 1 := lt_of_le_of_ne hrle hrfull + exact hA.signVariations_mulVec_le_rank_sub_one_of_induction + hrank hrlt hrpos ih c + +private lemma mul_mul_nonneg_of_cross_mul_nonneg + {a b c d : ℝ} (hac : 0 ≤ a * c) (hbd : 0 ≤ b * d) : + 0 ≤ (a * b) * (c * d) := by + calc + 0 ≤ (a * c) * (b * d) := mul_nonneg hac hbd + _ = (a * b) * (c * d) := by ring + +/-- Right multiplication by a totally nonnegative rectangular matrix preserves +the common weak sign of ordered minors of a fixed size. Cauchy--Binet expands +the product of two output minors as a double sum; sign consistency controls the +left-minor products and total nonnegativity controls the right-minor products. -/ +theorem Matrix.IsSignConsistentOrder.mul_of_right_isTotallyNonnegRect + {l n m r : ℕ} + {L : Matrix (Fin l) (Fin n) ℝ} + {A : Matrix (Fin n) (Fin m) ℝ} + (hL : L.IsSignConsistentOrder r) + (hA : A.IsTotallyNonnegRect) : + (L * A).IsSignConsistentOrder r := by + classical + intro rows rows' cols cols' hrows hrows' hcols hcols' + rw [Matrix.det_submatrix_mul_eq_sum_powersetCard L A rows cols, + Matrix.det_submatrix_mul_eq_sum_powersetCard L A rows' cols'] + rw [Finset.sum_mul] + apply Finset.sum_nonneg + intro s hs + rw [Finset.mul_sum] + apply Finset.sum_nonneg + intro t ht + let es : Fin r ↪o Fin n := + Set.powersetCard.ofFinEmbEquiv.symm s + let et : Fin r ↪o Fin n := + Set.powersetCard.ofFinEmbEquiv.symm t + have hsign : + 0 ≤ + (L.submatrix rows es).det * + (L.submatrix rows' et).det := + hL hrows hrows' es.strictMono et.strictMono + have hright : + 0 ≤ + (A.submatrix es cols).det * + (A.submatrix et cols').det := + mul_nonneg + (hA es.strictMono hcols) + (hA et.strictMono hcols') + exact mul_mul_nonneg_of_cross_mul_nonneg hsign hright + +/-- The weighted incidence matrix associated with a block map. -/ +def Matrix.weightedIncidence + {n q : ℕ} + (block : Fin n → Fin q) + (weight : Fin n → ℝ) : + Matrix (Fin n) (Fin q) ℝ := + fun j s => if block j = s then weight j else 0 + +@[simp] +theorem Matrix.weightedIncidence_apply + {n q : ℕ} + (block : Fin n → Fin q) + (weight : Fin n → ℝ) + (j : Fin n) + (s : Fin q) : + Matrix.weightedIncidence block weight j s = + if block j = s then weight j else 0 := + rfl + +/-- The minor of a monotone weighted incidence matrix is diagonal or singular. + +This is the elementary incidence-matrix step in Karlin's proof of Theorem V.1.4: +monotonicity forces every nonzero Leibniz term to use the identity permutation. +Thus no separate combinatorial model is needed for this bridge. -/ +theorem Matrix.det_submatrix_monotoneWeightedIncidence + {n q r : ℕ} + (block : Fin n → Fin q) + (hblock : Monotone block) + (weight : Fin n → ℝ) + {rows : Fin r → Fin n} + {cols : Fin r → Fin q} + (hrows : StrictMono rows) + (hcols : StrictMono cols) : + ((Matrix.weightedIncidence block weight).submatrix rows cols).det = + if ∀ i, block (rows i) = cols i then + ∏ i, weight (rows i) + else 0 := by + classical + let W := Matrix.weightedIncidence block weight + change (W.submatrix rows cols).det = + if ∀ i, block (rows i) = cols i then + ∏ i, weight (rows i) + else 0 + by_cases hdiag : ∀ i, block (rows i) = cols i + · rw [if_pos hdiag] + have hmatrix : + W.submatrix rows cols = + Matrix.diagonal (fun i => weight (rows i)) := by + ext i j + simp only [Matrix.submatrix_apply, W, + Matrix.weightedIncidence_apply] + rw [hdiag i] + by_cases hij : i = j + · subst j + simp + · have hc : cols i ≠ cols j := fun h => + hij (hcols.injective h) + simp [hc, hij] + rw [hmatrix, Matrix.det_diagonal] + · rw [if_neg hdiag, Matrix.det_apply'] + apply Finset.sum_eq_zero + intro sigma hsigma + by_cases hterm : ∀ i, block (rows (sigma i)) = cols i + · have hsigma_mono : StrictMono sigma := by + intro i j hij + by_contra hnot + have hle : sigma j ≤ sigma i := le_of_not_gt hnot + have hf : + block (rows (sigma j)) ≤ block (rows (sigma i)) := + (hblock.comp hrows.monotone) hle + rw [hterm j, hterm i] at hf + exact (not_le_of_gt (hcols hij)) hf + have hsigma_eq : ∀ i, sigma i = i := fun i => + le_antisymm (hsigma_mono.le_id i) (hsigma_mono.id_le i) + exfalso + apply hdiag + intro i + simpa only [hsigma_eq i] using hterm i + · simp only [not_forall] at hterm + obtain ⟨i, hi⟩ := hterm + have hprod : + (∏ j, (W.submatrix rows cols) (sigma j) j) = 0 := by + apply Finset.prod_eq_zero (Finset.mem_univ i) + simp only [Matrix.submatrix_apply, W, + Matrix.weightedIncidence_apply] + rw [if_neg hi] + rw [hprod, mul_zero] + +/-- A monotone weighted incidence matrix is totally nonnegative when its weights are +nonnegative. -/ +theorem Matrix.isTotallyNonnegRect_monotoneWeightedIncidence + {n q : ℕ} + (block : Fin n → Fin q) + (hblock : Monotone block) + (weight : Fin n → ℝ) + (hweight : ∀ j, 0 ≤ weight j) : + Matrix.IsTotallyNonnegRect + (Matrix.weightedIncidence block weight) := by + intro r rows cols hrows hcols + rw [Matrix.det_submatrix_monotoneWeightedIncidence + block hblock weight hrows hcols] + split_ifs + · exact Finset.prod_nonneg fun i _ => hweight (rows i) + · exact le_rfl + +/-- Right multiplication by a weighted incidence matrix forms weighted block sums. -/ +theorem Matrix.mul_weightedIncidence_apply + {l n q : ℕ} + (L : Matrix (Fin l) (Fin n) ℝ) + (block : Fin n → Fin q) + (weight : Fin n → ℝ) + (i : Fin l) + (s : Fin q) : + (L * Matrix.weightedIncidence block weight) i s = + ∑ j with block j = s, L i j * weight j := by + rw [Matrix.mul_apply, Finset.sum_filter] + simp only [Matrix.weightedIncidence_apply, mul_ite, mul_zero] + +/-- A weighted incidence matrix sends block coefficients to their weighted +pullback along the block map. -/ +@[simp] +theorem Matrix.weightedIncidence_mulVec + {n q : ℕ} + (block : Fin n → Fin q) + (weight : Fin n → ℝ) + (sign : Fin q → ℝ) : + (Matrix.weightedIncidence block weight).mulVec sign = + fun j => weight j * sign (block j) := by + ext j + simp [Matrix.mulVec, dotProduct] + +/-- Multiplying an aggregated matrix by block coefficients reconstructs the +corresponding coefficient vector before multiplication by the original matrix. -/ +theorem Matrix.mul_weightedIncidence_mulVec + {l n q : ℕ} + (L : Matrix (Fin l) (Fin n) ℝ) + (block : Fin n → Fin q) + (weight : Fin n → ℝ) + (sign : Fin q → ℝ) : + (L * Matrix.weightedIncidence block weight).mulVec sign = + L.mulVec (fun j => weight j * sign (block j)) := by + rw [← Matrix.mulVec_mulVec sign L + (Matrix.weightedIncidence block weight), + Matrix.weightedIncidence_mulVec] + +/-- Aggregating consecutive columns with nonnegative weights preserves sign +consistency of every fixed order. -/ +theorem Matrix.IsSignConsistentOrder.mul_weightedIncidence + {l n q r : ℕ} + {L : Matrix (Fin l) (Fin n) ℝ} + (hL : L.IsSignConsistentOrder r) + (block : Fin n → Fin q) + (hblock : Monotone block) + (weight : Fin n → ℝ) + (hweight : ∀ j, 0 ≤ weight j) : + (L * Matrix.weightedIncidence block weight).IsSignConsistentOrder r := + hL.mul_of_right_isTotallyNonnegRect + (Matrix.isTotallyNonnegRect_monotoneWeightedIncidence + block hblock weight hweight) + +/-- Karlin's V.1.4 inequality from explicit sign-block decomposition data. + +The only remaining finite combinatorial step for the general theorem is to +construct `Fin.SignBlockDecomposition c`; all matrix and rank arguments are +discharged here. -/ +theorem Matrix.IsSignRegular.signVariations_mulVec_le_of_signBlockDecomposition + {l n : ℕ} + {A : Matrix (Fin l) (Fin n) ℝ} + (hA : A.IsSignRegular) + (c : Fin n → ℝ) + (d : Fin.SignBlockDecomposition c) : + Fin.signVariations (A.mulVec c) ≤ Fin.signVariations c := by + let B := + A * Matrix.weightedIncidence d.block d.weight + have hBsign : B.IsSignConsistentOrder B.rank := by + simpa only [B] using + (hA B.rank).mul_weightedIncidence + d.block d.block_mono d.weight d.weight_nonneg + have hbound : + Fin.signVariations (B.mulVec d.coeff) ≤ B.rank - 1 := + hBsign.signVariations_mulVec_le_rank_sub_one rfl d.coeff + have hmul : B.mulVec d.coeff = A.mulVec c := by + calc + B.mulVec d.coeff = + A.mulVec (fun j => d.weight j * d.coeff (d.block j)) := by + simpa only [B] using + Matrix.mul_weightedIncidence_mulVec + A d.block d.weight d.coeff + _ = A.mulVec c := + congrArg A.mulVec (funext fun j => d.reconstruct j) + calc + Fin.signVariations (A.mulVec c) = + Fin.signVariations (B.mulVec d.coeff) := + congrArg Fin.signVariations hmul.symm + _ ≤ B.rank - 1 := hbound + _ ≤ d.numBlocks - 1 := + (Nat.sub_le_sub_right B.rank_le_width) 1 + _ = Fin.signVariations c := d.numBlocks_sub_one + +/-- Karlin's variation-diminishing theorem for sign-regular matrices. -/ +theorem Matrix.IsSignRegular.signVariations_mulVec_le + {l n : ℕ} + {A : Matrix (Fin l) (Fin n) ℝ} + (hA : A.IsSignRegular) (c : Fin n → ℝ) : + Fin.signVariations (A.mulVec c) ≤ Fin.signVariations c := + hA.signVariations_mulVec_le_of_signBlockDecomposition + c (Fin.signBlockDecomposition c) + +/-- Karlin's forward variation-diminishing theorem for finite rectangular +totally nonnegative matrices. -/ +theorem Matrix.IsTotallyNonnegRect.signVariations_mulVec_le + {l n : ℕ} + {A : Matrix (Fin l) (Fin n) ℝ} + (hA : A.IsTotallyNonnegRect) (c : Fin n → ℝ) : + Fin.signVariations (A.mulVec c) ≤ Fin.signVariations c := + hA.isSignRegular.signVariations_mulVec_le c + +/-- A surjective totally nonnegative matrix forces a nodal kernel vector to +have at least the row count minus one sign variations, up to the two endpoint +variations lost under perturbation. -/ +theorem Matrix.IsTotallyNonnegRect.card_sub_one_le_signVariations_add_two_of_surjective_of_nodal + {rows n : ℕ} {A : Matrix (Fin rows) (Fin (n + 2)) ℝ} + (hA : A.IsTotallyNonnegRect) + (hsurj : Function.Surjective A.mulVec) + {x : Fin (n + 2) → ℝ} + (hker : A.mulVec x = 0) + (hnodal : ∀ i : Fin n, x i.succ.castSucc = 0 → + x i.castSucc.castSucc * x i.succ.succ < 0) : + rows - 1 ≤ Fin.signVariations x + 2 := by + cases rows with + | zero => simp + | succ k => + let alt : Fin (k + 1) → ℝ := fun i => (-1 : ℝ) ^ (i : ℕ) + obtain ⟨z, hz⟩ := hsurj alt + let f : ℝ → Fin (n + 2) → ℝ := fun t => x + t • z + have hf : + Tendsto f (nhdsWithin (0 : ℝ) (Set.Ioi 0)) (𝓝 x) := by + have hfull : + Tendsto f (𝓝 (0 : ℝ)) (𝓝 (x + (0 : ℝ) • z)) := + tendsto_const_nhds.add (tendsto_id.smul_const z) + have hle : + nhdsWithin (0 : ℝ) (Set.Ioi 0) ≤ 𝓝 (0 : ℝ) := by + simp only [nhdsWithin] + exact inf_le_left + have hrestricted := hfull.mono_left hle + simpa only [zero_smul, add_zero] using hrestricted + have hbound := + Fin.eventually_signVariations_le_add_two_of_tendsto_of_interior_nodal + hf hnodal + have hpos : + ∀ᶠ t in nhdsWithin (0 : ℝ) (Set.Ioi 0), 0 < t := + self_mem_nhdsWithin + obtain ⟨t, htbound, ht⟩ := (hbound.and hpos).exists + have himage : + A.mulVec (f t) = + fun i : Fin (k + 1) => (-1 : ℝ) ^ (i : ℕ) * t := by + rw [show f t = x + t • z by rfl, Matrix.mulVec_add, + Matrix.mulVec_smul, hker, hz] + funext i + simp only [Pi.smul_apply, zero_add, alt, smul_eq_mul, mul_comm] + have halt : Fin.StrictlyAlternates (A.mulVec (f t)) := by + rw [himage] + exact Fin.strictlyAlternates_alternating k ht + have hlower : k ≤ Fin.signVariations (A.mulVec (f t)) := + halt.le_signVariations_of_strictMono strictMono_id + simpa using + hlower.trans ((hA.signVariations_mulVec_le (f t)).trans htbound) + +/-- Cardinality-equality wrapper for the surjective totally nonnegative nodal +kernel bound. -/ +theorem Matrix.IsTotallyNonnegRect.card_sub_one_le_signVariations_add_two_of_surjective_of_card_eq + {rows cols n : ℕ} {A : Matrix (Fin rows) (Fin cols) ℝ} + (hA : A.IsTotallyNonnegRect) + (hcols : cols = n + 2) + (hsurj : Function.Surjective A.mulVec) + {x : Fin cols → ℝ} + (hker : A.mulVec x = 0) + (hnodal : ∀ i : Fin n, + x (Fin.cast hcols.symm i.succ.castSucc) = 0 → + x (Fin.cast hcols.symm i.castSucc.castSucc) * + x (Fin.cast hcols.symm i.succ.succ) < 0) : + rows - 1 ≤ Fin.signVariations x + 2 := by + subst cols + exact hA.card_sub_one_le_signVariations_add_two_of_surjective_of_nodal + hsurj hker (by simpa using hnodal) diff --git a/RealRooted/Mathlib/LinearAlgebra/Matrix/SignRegularStrictification.lean b/RealRooted/Mathlib/LinearAlgebra/Matrix/SignRegularStrictification.lean new file mode 100644 index 00000000..9367984e --- /dev/null +++ b/RealRooted/Mathlib/LinearAlgebra/Matrix/SignRegularStrictification.lean @@ -0,0 +1,102 @@ +import RealRooted.Mathlib.LinearAlgebra.Matrix.Determinant.CauchyBinet +import RealRooted.Mathlib.LinearAlgebra.Matrix.Gaussian +import RealRooted.Mathlib.LinearAlgebra.Matrix.SignRegular + +/-! +# Strictifying sign-consistent matrices + +This file formalizes Karlin, *Total Positivity*, Vol. I, Chapter V, Section 1, +Proposition 1.2. A positive-minor left factor strictifies a full-column-rank +sign-consistent matrix. Karlin applies this with a Gaussian matrix and then +lets the Gaussian parameter tend to infinity. +-/ + +public section + +open Filter +open scoped Topology + +namespace Matrix + +/-- Positive ordered minors in a left factor strictify a full-column-rank +sign-consistent right factor. -/ +theorem IsSignConsistentOrder.isStrictlySignConsistentOrder_mul_of_posMinors + {S : Type*} [Field S] [LinearOrder S] [IsStrictOrderedRing S] + {l n m q : ℕ} {L : Matrix (Fin l) (Fin n) S} + {A : Matrix (Fin n) (Fin m) S} + (hA : A.IsSignConsistentOrder q) + (hAinj : Function.Injective A.mulVec) + (hL : ∀ ⦃rows : Fin q → Fin l⦄ ⦃cols : Fin q → Fin n⦄, + StrictMono rows → StrictMono cols → + 0 < (L.submatrix rows cols).det) : + (L * A).IsStrictlySignConsistentOrder q := by + classical + intro rows rows' cols cols' hrows hrows' hcols hcols' + obtain ⟨rows₀, hrows₀, href_ne⟩ := + exists_ordered_minor_ne_zero_of_mulVec_injective A hAinj cols hcols + rcases lt_or_gt_of_ne href_ne with href_neg | href_pos + · have hneg : ∀ ⦃r : Fin q → Fin l⦄ ⦃c : Fin q → Fin m⦄, + StrictMono r → StrictMono c → + ((L * A).submatrix r c).det < 0 := by + intro r c hr hc + rw [det_submatrix_mul_eq_sum_powersetCard] + apply Finset.sum_neg' + · intro s _ + exact mul_nonpos_of_nonneg_of_nonpos + (hL hr (Set.powersetCard.ofFinEmbEquiv.symm s).strictMono).le + (hA.minor_nonpos_of_neg hrows₀ hcols href_neg + (Set.powersetCard.ofFinEmbEquiv.symm s).strictMono hc) + · obtain ⟨r₁, hr₁, href₁_ne⟩ := + exists_ordered_minor_ne_zero_of_mulVec_injective A hAinj c hc + have href₁_neg : (A.submatrix r₁ c).det < 0 := + lt_of_le_of_ne + (hA.minor_nonpos_of_neg hrows₀ hcols href_neg hr₁ hc) href₁_ne + let e := OrderEmbedding.ofStrictMono r₁ hr₁ + refine ⟨Set.powersetCard.ofFinEmbEquiv e, Finset.mem_univ _, ?_⟩ + simpa [e] using mul_neg_of_pos_of_neg (hL hr hr₁) href₁_neg + exact mul_pos_of_neg_of_neg (hneg hrows hcols) (hneg hrows' hcols') + · have hpos : ∀ ⦃r : Fin q → Fin l⦄ ⦃c : Fin q → Fin m⦄, + StrictMono r → StrictMono c → + 0 < ((L * A).submatrix r c).det := by + intro r c hr hc + rw [det_submatrix_mul_eq_sum_powersetCard] + apply Finset.sum_pos' + · intro s _ + exact mul_nonneg + (hL hr (Set.powersetCard.ofFinEmbEquiv.symm s).strictMono).le + (hA.minor_nonneg_of_pos hrows₀ hcols href_pos + (Set.powersetCard.ofFinEmbEquiv.symm s).strictMono hc) + · obtain ⟨r₁, hr₁, href₁_ne⟩ := + exists_ordered_minor_ne_zero_of_mulVec_injective A hAinj c hc + have href₁_pos : 0 < (A.submatrix r₁ c).det := + lt_of_le_of_ne + (hA.minor_nonneg_of_pos hrows₀ hcols href_pos hr₁ hc) href₁_ne.symm + let e := OrderEmbedding.ofStrictMono r₁ hr₁ + refine ⟨Set.powersetCard.ofFinEmbEquiv e, Finset.mem_univ _, ?_⟩ + simpa [e] using mul_pos (hL hr hr₁) href₁_pos + exact mul_pos (hpos hrows hcols) (hpos hrows' hcols') + +/-- Karlin's Gaussian left multiplier strictifies a full-column-rank +sign-consistent matrix. -/ +theorem IsSignConsistentOrder.isStrictlySignConsistentOrder_gaussianMatrix_mul + {n m q : ℕ} {A : Matrix (Fin n) (Fin m) ℝ} + (hA : A.IsSignConsistentOrder q) (hAinj : Function.Injective A.mulVec) + {a : ℝ} (ha : 0 < a) : + (gaussianMatrix n a * A).IsStrictlySignConsistentOrder q := by + apply hA.isStrictlySignConsistentOrder_mul_of_posMinors hAinj + intro rows cols hrows hcols + exact det_gaussianMatrix_submatrix_pos a rows cols ha hrows hcols + +/-- Gaussian left multiplication converges entrywise to the original matrix. -/ +theorem tendsto_gaussianMatrix_mul_atTop {n m : ℕ} + (A : Matrix (Fin n) (Fin m) ℝ) : + Tendsto (fun a => gaussianMatrix n a * A) atTop (𝓝 A) := by + have hmul : Continuous (fun M : Matrix (Fin n) (Fin n) ℝ => M * A) := + continuous_id.matrix_mul continuous_const + convert hmul.continuousAt.tendsto.comp + (tendsto_gaussianMatrix_atTop n) using 1 + · funext a + rfl + · simp + +end Matrix diff --git a/RealRooted/Mathlib/LinearAlgebra/Matrix/SignRegularVariation.lean b/RealRooted/Mathlib/LinearAlgebra/Matrix/SignRegularVariation.lean new file mode 100644 index 00000000..e2f8e23e --- /dev/null +++ b/RealRooted/Mathlib/LinearAlgebra/Matrix/SignRegularVariation.lean @@ -0,0 +1,39 @@ +import RealRooted.Mathlib.LinearAlgebra.Matrix.SignRegularStrictification +import RealRooted.Mathlib.LinearAlgebra.Matrix.SignVariationTopology +import RealRooted.Mathlib.LinearAlgebra.Matrix.VariationDiminishing + +/-! +# Variation bounds for sign-consistent matrices + +This file proves the full-column-rank case of the variation bound in Karlin, +*Total Positivity*, Volume I, Chapter V, Section 1, Theorem 1.3. Gaussian +strictification reduces the result to the strict maximal-minor theorem, and +lower semicontinuity of sign variations passes the bound to the limit. +-/ + +open Filter + +/-- A full-column-rank sign-consistent matrix has at most `q - 1` sign +variations in every vector in its range. -/ +theorem Matrix.IsSignConsistentOrder.signVariations_mulVec_le_card_sub_one + {m q : ℕ} {A : Matrix (Fin m) (Fin q) ℝ} + (hA : A.IsSignConsistentOrder q) + (hqm : q ≤ m) + (hAinj : Function.Injective A.mulVec) + (x : Fin q → ℝ) : + Fin.signVariations (A.mulVec x) ≤ q - 1 := by + refine Fin.signVariations_le_of_tendsto + (l := (atTop : Filter ℝ)) + (f := fun a => (Matrix.gaussianMatrix m a * A).mulVec x) ?_ ?_ + · have hcont : Continuous + (fun M : Matrix (Fin m) (Fin q) ℝ => M.mulVec x) := + continuous_id.matrix_mulVec continuous_const + exact hcont.continuousAt.tendsto.comp + (Matrix.tendsto_gaussianMatrix_mul_atTop A) + · filter_upwards [Filter.eventually_gt_atTop (0 : ℝ)] with a ha + have hstrict : + (Matrix.gaussianMatrix m a * A).IsStrictlySignConsistentOrder q := + hA.isStrictlySignConsistentOrder_gaussianMatrix_mul hAinj ha + exact Matrix.signVariations_mulVec_le_card_sub_one_of_strictMaximalMinors + hqm (fun ⦃rows rows'⦄ hrows hrows' => + hstrict hrows hrows' strictMono_id strictMono_id) x diff --git a/RealRooted/Mathlib/LinearAlgebra/Matrix/SignVariation.lean b/RealRooted/Mathlib/LinearAlgebra/Matrix/SignVariation.lean index e1c483eb..3542ae72 100644 --- a/RealRooted/Mathlib/LinearAlgebra/Matrix/SignVariation.lean +++ b/RealRooted/Mathlib/LinearAlgebra/Matrix/SignVariation.lean @@ -4,6 +4,9 @@ public import Mathlib.Algebra.Polynomial.RuleOfSigns public import Mathlib.Data.List.ChainOfFn public import Mathlib.Data.List.NodupEquivFin public import Mathlib.Tactic +public import RealRooted.Mathlib.Data.List.Destutter +public import RealRooted.Mathlib.Data.List.Basic +public import RealRooted.Mathlib.Data.List.OfFn /-! # Sign variations of finite vectors @@ -356,6 +359,237 @@ lemma signVariations_append_nonpos_le_succ (l₁ l₂ : List ℝ) end List +/-- Taking the sign of a sign is the identity. -/ +@[simp] +theorem SignType.sign_sign (s : SignType) : SignType.sign s = s := by + fin_cases s <;> rfl + +private lemma add_one_le_pred_add_two (n : ℕ) : + n + 1 ≤ n - 1 + 1 + 1 := by + cases n <;> simp + +/-- Prepending one sign increases the number of sign variations by at most one. -/ +theorem List.signVariations_cons_le_succ (a : SignType) (l : List SignType) : + (a :: l).signVariations ≤ l.signVariations + 1 := by + have h := List.length_destutter_cons_ne_le_succ a + ((l.map SignType.sign).filter (· ≠ 0)) + by_cases ha : a = 0 + · simp [List.signVariations, ha] + · simpa [List.signVariations, ha] using h.trans (add_one_le_pred_add_two _) + +/-- Appending one sign increases the number of sign variations by at most one. -/ +theorem List.signVariations_append_singleton_signType_le_succ + (l : List SignType) (a : SignType) : + (l ++ [a]).signVariations ≤ l.signVariations + 1 := by + have h := List.length_destutter_append_singleton_ne_le_succ + ((l.map SignType.sign).filter (· ≠ 0)) a + by_cases ha : a = 0 + · simp [List.signVariations, ha] + · simpa [List.signVariations, ha] using h.trans (add_one_le_pred_add_two _) + +/-- Inserting any sign between opposite nonzero signs does not change sign variations. + +This is the finite local step used for nodal interior zeros in Karlin's perturbation +argument: after zero signs are removed, the inserted sign either disappears or duplicates +one of its two neighbors. -/ +theorem List.signVariations_insert_between_opposite + (l₁ l₂ : List SignType) (a b z : SignType) + (ha : a ≠ 0) (hb : b ≠ 0) (hab : a ≠ b) : + (l₁ ++ [a, z, b] ++ l₂).signVariations = + (l₁ ++ [a, b] ++ l₂).signVariations := by + fin_cases a <;> fin_cases b <;> fin_cases z <;> + simp_all [List.signVariations, List.destutter_append_cons_self_ne, + List.destutter_append_cons_cons_self_ne] + +namespace List + +private theorem filter_map_sign_filter_ne_zero (l : List SignType) : + ((l.filter (· ≠ 0)).map SignType.sign).filter (· ≠ 0) = + (l.map SignType.sign).filter (· ≠ 0) := by + have hsign : (SignType.sign : SignType → SignType) = id := funext SignType.sign_sign + simp [hsign] + +/-- Filtering zero signs does not change sign variations. -/ +theorem signVariations_filter_ne_zero (l : List SignType) : + (l.filter (· ≠ 0)).signVariations = l.signVariations := by + simp only [List.signVariations, filter_map_sign_filter_ne_zero] + +/-- One insertion at an interior nodal position. + +This inductive relation is structural data recording an explicit list operation, +not an unproved mathematical assertion packaged as a proposition. -/ +inductive NodalInsertion : List SignType → List SignType → Prop + | insert (l₁ l₂ : List SignType) (a b z : SignType) + (ha : a ≠ 0) (hb : b ≠ 0) (hab : a ≠ b) : + NodalInsertion (l₁ ++ [a, b] ++ l₂) (l₁ ++ [a, z, b] ++ l₂) + +/-- Adding unchanged list context preserves one nodal insertion. -/ +protected theorem NodalInsertion.append_context + {l l' : List SignType} (h : NodalInsertion l l') + (pre post : List SignType) : + NodalInsertion (pre ++ l ++ post) (pre ++ l' ++ post) := by + cases h with + | insert l₁ l₂ a b z ha hb hab => + simpa only [append_assoc] using + NodalInsertion.insert (pre ++ l₁) (l₂ ++ post) a b z ha hb hab + +/-- Erasing an entry between opposite nonzero neighbors is one nodal insertion in reverse. -/ +protected theorem NodalInsertion.eraseIdx_succ + (l : List SignType) (i : ℕ) (hi : i + 2 < l.length) + (ha : l[i] ≠ 0) (hb : l[i + 2] ≠ 0) + (hab : l[i] ≠ l[i + 2]) : + NodalInsertion (l.eraseIdx (i + 1)) l := by + induction l generalizing i with + | nil => simp at hi + | cons x l ih => + cases i with + | zero => + cases l with + | nil => simp at hi + | cons z l => + cases l with + | nil => simp at hi + | cons b l => + exact NodalInsertion.insert [] l x b z + (by simpa using ha) (by simpa using hb) + (by simpa using hab) + | succ i => + have h := ih i + (by + simp only [length_cons] at hi + lia) + (by simpa [Nat.succ_eq_add_one] using ha) + (by simpa [Nat.succ_eq_add_one] using hb) + (by simpa [Nat.succ_eq_add_one] using hab) + simpa [Nat.succ_eq_add_one] using h.append_context [x] [] + +/-- Erasing an entry between opposite nonzero neighbors inside a middle block +is one nodal insertion in reverse, with unchanged surrounding context. -/ +protected theorem NodalInsertion.eraseIdx_append_middle + (pre middle post : List SignType) (i : ℕ) + (hi : i + 2 < middle.length) + (ha : middle[i] ≠ 0) (hb : middle[i + 2] ≠ 0) + (hab : middle[i] ≠ middle[i + 2]) : + NodalInsertion + ((pre ++ middle ++ post).eraseIdx (pre.length + (i + 1))) + (pre ++ middle ++ post) := by + have hi' : i + 1 < middle.length := by lia + rw [List.eraseIdx_append_middle pre middle post (i + 1) hi'] + exact + (NodalInsertion.eraseIdx_succ middle i hi ha hb hab).append_context + pre post + +/-- Deleting the first element of a middle block is a nodal insertion when +its left neighbor is a retained singleton and its right neighbor is the +second middle entry. -/ +protected theorem NodalInsertion.eraseIdx_first_middle + (a : SignType) (middle post : List SignType) + (hmiddle : 1 < middle.length) + (ha : a ≠ 0) + (hb : middle[1] ≠ 0) + (hab : a ≠ middle[1]) : + NodalInsertion + ([a] ++ middle.eraseIdx 0 ++ post) + ([a] ++ middle ++ post) := by + rw [← List.eraseIdx_append_middle [a] middle post 0 (by lia)] + change NodalInsertion + (([a] ++ middle ++ post).eraseIdx 1) + ([a] ++ middle ++ post) + simpa only [List.nil_append, List.length_nil, zero_add, + List.append_assoc] using + NodalInsertion.eraseIdx_append_middle + [] ([a] ++ middle) post 0 + (by + simp only [List.length_append, List.length_singleton] + lia) + (by simpa using ha) + (by simpa using hb) + (by simpa using hab) + +/-- Deleting the final entry of a middle block is one nodal insertion in +reverse when its preceding entry and a retained singleton endpoint have +opposite nonzero signs. -/ +protected theorem NodalInsertion.eraseIdx_last_append_singleton + (pre middle : List SignType) (b : SignType) (i : ℕ) + (hlen : middle.length = i + 2) + (ha : middle[i] ≠ 0) (hb : b ≠ 0) + (hab : middle[i] ≠ b) : + NodalInsertion + (pre ++ middle.eraseIdx (i + 1) ++ [b]) + (pre ++ middle ++ [b]) := by + have hi : i < middle.length := by simp [hlen] + have hiErase : i + 1 < middle.length := by simp [hlen] + have hiLocal : i + 2 < (middle ++ [b]).length := by simp [hlen] + have hleft : (middle ++ [b])[i] = middle[i] := + List.getElem_append_left hi + have hright : (middle ++ [b])[i + 2] = b := by + simp [List.getElem_append_right, hlen] + rw [← List.eraseIdx_append_middle + pre middle [b] (i + 1) hiErase] + simpa only [List.append_nil, List.append_assoc] using + NodalInsertion.eraseIdx_append_middle + pre (middle ++ [b]) [] i hiLocal + (by rw [hleft]; exact ha) + (by rw [hright]; exact hb) + (by rw [hleft, hright]; exact hab) + +/-- Adding unchanged list context preserves repeated nodal insertions. -/ +protected theorem NodalInsertion.reflTransGen_append_context + {l l' : List SignType} + (h : Relation.ReflTransGen NodalInsertion l l') + (pre post : List SignType) : + Relation.ReflTransGen NodalInsertion + (pre ++ l ++ post) (pre ++ l' ++ post) := by + induction h with + | refl => exact .refl + | tail h huv ih => + exact ih.tail (huv.append_context pre post) + +/-- Repeated insertions at interior nodal positions preserve sign variations. -/ +theorem signVariations_eq_of_nodalInsertions + {l l' : List SignType} + (h : Relation.ReflTransGen NodalInsertion l l') : + l'.signVariations = l.signVariations := by + induction h with + | refl => rfl + | tail h huv ih => + cases huv with + | insert l₁ l₂ a b z ha hb hab => + calc + (l₁ ++ [a, z, b] ++ l₂).signVariations = + (l₁ ++ [a, b] ++ l₂).signVariations := + signVariations_insert_between_opposite l₁ l₂ a b z ha hb hab + _ = l.signVariations := ih + +/-- Repeated interior nodal insertions and two arbitrary endpoint insertions increase sign +variations by at most two. -/ +theorem signVariations_endpoints_le_add_two_of_nodalInsertions + {l l' : List SignType} + (h : Relation.ReflTransGen NodalInsertion l l') + (a b : SignType) : + ((a :: l') ++ [b]).signVariations ≤ l.signVariations + 2 := by + calc + ((a :: l') ++ [b]).signVariations ≤ + (l' ++ [b]).signVariations + 1 := by + simpa only [List.cons_append] using + signVariations_cons_le_succ a (l' ++ [b]) + _ ≤ (l'.signVariations + 1) + 1 := + Nat.add_le_add_right + (signVariations_append_singleton_signType_le_succ l' b) 1 + _ = l.signVariations + 2 := by + rw [signVariations_eq_of_nodalInsertions h] + +end List + +/-- A negative product of real numbers has nonzero, opposite signs. -/ +theorem SignType.sign_ne_zero_and_ne_of_mul_neg + {a b : ℝ} (h : a * b < 0) : + SignType.sign a ≠ 0 ∧ SignType.sign b ≠ 0 ∧ + SignType.sign a ≠ SignType.sign b := by + rcases (mul_neg_iff.mp h) with ⟨ha, hb⟩ | ⟨ha, hb⟩ + · simp [SignType.sign, ha, hb, not_lt_of_ge hb.le] + · simp [SignType.sign, ha, hb, not_lt_of_ge ha.le] + namespace Fin /-- The number of sign changes in a finite vector, in index order and ignoring @@ -364,6 +598,557 @@ def signVariations {R : Type*} [Zero R] [LinearOrder R] {n : ℕ} (x : Fin n → R) : ℕ := (List.ofFn x).signVariations +/-- A finite real vector has the same variation count as its explicit sign list. -/ +theorem signVariations_eq_signList {n : ℕ} (x : Fin n → ℝ) : + Fin.signVariations x = + (List.ofFn (SignType.sign ∘ x)).signVariations := by + simp [Fin.signVariations, List.signVariations, Function.comp_def] + +/-- Filtering the explicit sign list computes finite-vector sign variations. -/ +theorem filtered_signList_signVariations {n : ℕ} (x : Fin n → ℝ) : + ((List.ofFn (SignType.sign ∘ x)).filter (· ≠ 0)).signVariations = + Fin.signVariations x := by + simpa only [List.signVariations_filter_ne_zero] using + (Fin.signVariations_eq_signList x).symm + +/-- Perturbed signs at all interior coordinates and at the original nonzero +endpoints. + +Interior zeros are retained because the coordinate-removal induction constructs +them by nodal insertions. A zero original endpoint is omitted and handled by the +final two-endpoint variation bound. -/ +def nodalPerturbationCoreSigns + {n : ℕ} (x y : Fin (n + 2) → ℝ) : List SignType := + (if x 0 = 0 then [] else [SignType.sign (y 0)]) ++ + List.ofFn + (fun i : Fin n => SignType.sign (y i.succ.castSucc)) ++ + (if x (Fin.last (n + 1)) = 0 then [] + else [SignType.sign (y (Fin.last (n + 1)))]) + +/-- At the splice created by deleting a nodal zero, the new center is nonzero. -/ +theorem succAbove_center_ne_zero_of_mul_neg + {n : ℕ} (x : Fin (n + 3) → ℝ) (i : Fin n) + (h : x i.castSucc.castSucc.castSucc * x i.succ.succ.castSucc < 0) : + x ((i.succ.castSucc.castSucc).succAbove i.succ.castSucc) ≠ 0 := by + rw [Fin.succAbove_center_eq_right] + exact right_ne_zero_of_mul (ne_of_lt h) + +/-- If the omitted nodal zero was the old right neighbor, the new center is nonzero. -/ +theorem succAbove_center_ne_zero_of_omit_right_mul_neg + {n : ℕ} (x : Fin (n + 3) → ℝ) (i : Fin n) + (h : x i.succ.castSucc.castSucc * x i.succ.succ.succ < 0) : + x ((i.succ.succ.castSucc).succAbove i.succ.castSucc) ≠ 0 := by + rw [Fin.succAbove_center_eq_left] + exact left_ne_zero_of_mul (ne_of_lt h) + +/-- Deleting an interior nodal zero preserves strict interior nodality. -/ +theorem interiorNodal_succAbove + {n : ℕ} (x : Fin (n + 3) → ℝ) (k : Fin (n + 1)) + (hk : x k.succ.castSucc = 0) + (hnodal : ∀ j : Fin (n + 1), x j.succ.castSucc = 0 → + x j.castSucc.castSucc * x j.succ.succ < 0) : + ∀ i : Fin n, + x (k.succ.castSucc.succAbove i.succ.castSucc) = 0 → + x (k.succ.castSucc.succAbove i.castSucc.castSucc) * + x (k.succ.castSucc.succAbove i.succ.succ) < 0 := by + intro i hi + by_cases hki : (k : ℕ) < (i : ℕ) + · have hp : k.succ.castSucc ≤ i.castSucc.castSucc.castSucc := by + change (k : ℕ) + 1 ≤ (i : ℕ) + lia + rcases Fin.succAbove_triple_eq_succ_of_le_left k.succ.castSucc i hp with + ⟨hleft, hcenter, hright⟩ + rw [hcenter] at hi + rw [hleft, hright] + simpa using hnodal i.succ (by simpa using hi) + · by_cases hik : (i : ℕ) < (k : ℕ) + · by_cases hnext : (k : ℕ) = (i : ℕ) + 1 + · have hkeq : k = i.succ := by + apply Fin.ext + exact hnext + subst k + have hn := hnodal i.succ (by simpa using hk) + have hne := Fin.succAbove_center_ne_zero_of_omit_right_mul_neg x i + (by simpa using hn) + exact (hne (by simpa using hi)).elim + · have hp : i.succ.succ.castSucc < k.succ.castSucc := by + change (i : ℕ) + 2 < (k : ℕ) + 1 + lia + rcases Fin.succAbove_triple_eq_castSucc_of_right_lt k.succ.castSucc i hp with + ⟨hleft, hcenter, hright⟩ + rw [hcenter] at hi + rw [hleft, hright] + simpa using hnodal i.castSucc (by simpa using hi) + · have hkeq : k = i.castSucc := by + apply Fin.ext + change (k : ℕ) = (i : ℕ) + lia + subst k + have hn := hnodal i.castSucc (by simpa using hk) + have hne := Fin.succAbove_center_ne_zero_of_mul_neg x i + (by simpa using hn) + exact (hne (by simpa using hi)).elim + + +/-- Remove one interior zero, apply the shorter nodal-insertion chain, and reinsert it. + +This is the finite induction step in the endpoint-perturbation route used in Karlin's +Chapter 8, Section 3 argument. +-/ +theorem nodalInsertions_coreSigns_remove + {n : ℕ} + (ih : + ∀ {u v : Fin (n + 2) → ℝ}, + (∀ i, u i ≠ 0 → + SignType.sign (v i) = SignType.sign (u i)) → + (∀ i : Fin n, u i.succ.castSucc = 0 → + u i.castSucc.castSucc * u i.succ.succ < 0) → + Relation.ReflTransGen List.NodalInsertion + ((List.ofFn (SignType.sign ∘ u)).filter (· ≠ 0)) + (Fin.nodalPerturbationCoreSigns u v)) + {x y : Fin (n + 3) → ℝ} + (hsign : ∀ i, x i ≠ 0 → + SignType.sign (y i) = SignType.sign (x i)) + (hnodal : ∀ i : Fin (n + 1), x i.succ.castSucc = 0 → + x i.castSucc.castSucc * x i.succ.succ < 0) + (k : Fin (n + 1)) + (hk : x k.succ.castSucc = 0) : + Relation.ReflTransGen List.NodalInsertion + ((List.ofFn (SignType.sign ∘ x)).filter (· ≠ 0)) + (Fin.nodalPerturbationCoreSigns x y) := by + let p : Fin (n + 3) := k.succ.castSucc + let x' : Fin (n + 2) → ℝ := fun i => x (p.succAbove i) + let y' : Fin (n + 2) → ℝ := fun i => y (p.succAbove i) + have hsign' : + ∀ i, x' i ≠ 0 → + SignType.sign (y' i) = SignType.sign (x' i) := by + intro i hi + simpa only [x', y'] using + hsign (p.succAbove i) (by simpa only [x'] using hi) + have hnodal' : + ∀ i : Fin n, x' i.succ.castSucc = 0 → + x' i.castSucc.castSucc * x' i.succ.succ < 0 := by + simpa only [x', p] using + Fin.interiorNodal_succAbove x k hk hnodal + have hrec : + Relation.ReflTransGen List.NodalInsertion + ((List.ofFn (SignType.sign ∘ x')).filter (· ≠ 0)) + (Fin.nodalPerturbationCoreSigns x' y') := + ih hsign' hnodal' + have hofFn : + List.ofFn (fun i => SignType.sign (x' i)) = + (List.ofFn (fun i => SignType.sign (x i))).eraseIdx p := by + simpa only [x', p] using + List.ofFn_succAbove_eq_eraseIdx + (fun i => SignType.sign (x i)) p + have hlenSource : + (p : ℕ) < + (List.ofFn (fun i => SignType.sign (x i))).length := by + simpa only [List.length_ofFn] using p.isLt + have hvalueSource : + (List.ofFn (fun i => SignType.sign (x i)))[(p : ℕ)] = 0 := by + rw [List.getElem_ofFn hlenSource] + change SignType.sign (x p) = 0 + rw [show p = k.succ.castSucc from rfl, hk] + norm_num [SignType.sign] + have hfilteredSource : + ¬(fun z : SignType => decide (z ≠ 0)) + (List.ofFn (fun i => SignType.sign (x i)))[(p : ℕ)] := by + rw [hvalueSource] + decide + have hsource : + (List.ofFn (fun i => SignType.sign (x' i))).filter (· ≠ 0) = + (List.ofFn (fun i => SignType.sign (x i))).filter (· ≠ 0) := by + rw [hofFn] + exact List.filter_eraseIdx_eq_of_getElem_not + hlenSource hfilteredSource + have hxzero : x' 0 = x 0 := by + simp only [x', p, Fin.succAbove_zero_of_interior] + have hyzero : y' 0 = y 0 := by + simp only [y', p, Fin.succAbove_zero_of_interior] + have hxlast : + x' (Fin.last (n + 1)) = x (Fin.last (n + 2)) := by + simp only [x', p, Fin.succAbove_last_of_interior] + have hylast : + y' (Fin.last (n + 1)) = y (Fin.last (n + 2)) := by + simp only [y', p, Fin.succAbove_last_of_interior] + have hinterior : + List.ofFn + (fun i : Fin n => + SignType.sign (y' i.succ.castSucc)) = + (List.ofFn + (fun i : Fin (n + 1) => + SignType.sign (y i.succ.castSucc))).eraseIdx k := by + simpa only [y', p, Function.comp_apply] using + List.ofFn_interior_succAbove_eq_eraseIdx + (SignType.sign ∘ y) k + let left : List SignType := + if x 0 = 0 then [] else [SignType.sign (y 0)] + let middle : List SignType := + List.ofFn + (fun i : Fin (n + 1) => + SignType.sign (y i.succ.castSucc)) + let right : List SignType := + if x (Fin.last (n + 2)) = 0 then [] + else [SignType.sign (y (Fin.last (n + 2)))] + let full : List SignType := left ++ middle ++ right + let reduced : List SignType := + left ++ middle.eraseIdx k ++ right + have hfull : + Fin.nodalPerturbationCoreSigns x y = full := by + rfl + have hreduced : + Fin.nodalPerturbationCoreSigns x' y' = reduced := by + simp only [Fin.nodalPerturbationCoreSigns, reduced, left, middle, + right, hxzero, hyzero, hxlast, hylast, hinterior] + have hmul : + x k.castSucc.castSucc * x k.succ.succ < 0 := + hnodal k hk + have hxleft : x k.castSucc.castSucc ≠ 0 := + left_ne_zero_of_mul (ne_of_lt hmul) + have hxright : x k.succ.succ ≠ 0 := + right_ne_zero_of_mul (ne_of_lt hmul) + have hopposite : + SignType.sign (y k.castSucc.castSucc) ≠ 0 ∧ + SignType.sign (y k.succ.succ) ≠ 0 ∧ + SignType.sign (y k.castSucc.castSucc) ≠ + SignType.sign (y k.succ.succ) := by + simpa only [hsign k.castSucc.castSucc hxleft, + hsign k.succ.succ hxright] using + SignType.sign_ne_zero_and_ne_of_mul_neg hmul + have hstep : List.NodalInsertion reduced full := by + by_cases hn : n = 0 + · subst n + have hkzero : k = 0 := Fin.eq_zero k + subst k + have hleftIndex : + (0 : Fin 1).castSucc.castSucc = (0 : Fin 3) := by + exact Fin.ext rfl + have hcenterIndex : + (0 : Fin 1).succ.castSucc = (1 : Fin 3) := by + exact Fin.ext rfl + have hrightIndex : + (0 : Fin 1).succ.succ = (2 : Fin 3) := by + exact Fin.ext rfl + have hlastIndex : + (Fin.last 2 : Fin 3) = (2 : Fin 3) := by + exact Fin.ext rfl + have hxzero' : x (0 : Fin 3) ≠ 0 := by + simpa only [hleftIndex] using hxleft + have hxtwo : x (2 : Fin 3) ≠ 0 := by + simpa only [hrightIndex] using hxright + have hsignLeft : SignType.sign (y 0) ≠ 0 := by + simpa only [hleftIndex] using hopposite.1 + have hsignTwo : SignType.sign (y 2) ≠ 0 := by + simpa only [hrightIndex] using hopposite.2.1 + have hsignNe : + SignType.sign (y 0) ≠ SignType.sign (y 2) := by + simpa only [hleftIndex, hrightIndex] using hopposite.2.2 + simpa [full, reduced, left, middle, right, hxzero', hxtwo, + hcenterIndex, hlastIndex] using + List.NodalInsertion.insert [] [] + (SignType.sign (y 0)) + (SignType.sign (y 2)) + (SignType.sign (y 1)) + hsignLeft hsignTwo hsignNe + · have hnpos : 0 < n := Nat.pos_of_ne_zero hn + by_cases hkzero : (k : ℕ) = 0 + · have hkeq : k = 0 := Fin.ext hkzero + subst k + have hxzero' : x 0 ≠ 0 := by + simpa using hxleft + have hmiddleLength : 1 < middle.length := by + simp [middle] + lia + simpa [full, reduced, left, hxzero'] using + List.NodalInsertion.eraseIdx_first_middle + (SignType.sign (y 0)) middle right + hmiddleLength + (by simpa using hopposite.1) + (by simpa [middle] using hopposite.2.1) + (by simpa [middle] using hopposite.2.2) + · by_cases hklast : (k : ℕ) = n + · have hkeq : k = Fin.last n := Fin.ext hklast + subst k + have hxlast' : x (Fin.last (n + 2)) ≠ 0 := by + simpa using hxright + have hpred : n - 1 + 1 = n := by lia + have hlen : middle.length = n - 1 + 2 := by + simp [middle] + lia + have hleftBound : n - 1 < middle.length := by + rw [hlen] + lia + have hleftMiddle : + middle[n - 1]'hleftBound = + SignType.sign + (y (Fin.last n).castSucc.castSucc) := by + rw [List.getElem_ofFn hleftBound] + congr 2 + apply Fin.ext + simp only [Fin.val_castSucc, Fin.val_succ, Fin.val_last] + lia + have hrightEndpoint : + SignType.sign (y (Fin.last (n + 2))) = + SignType.sign (y (Fin.last n).succ.succ) := by + congr 2 + have haMiddle : middle[n - 1] ≠ 0 := by + rw [hleftMiddle] + exact hopposite.1 + have hbEndpoint : + SignType.sign (y (Fin.last (n + 2))) ≠ 0 := by + rw [hrightEndpoint] + exact hopposite.2.1 + have habMiddle : + middle[n - 1] ≠ + SignType.sign (y (Fin.last (n + 2))) := by + rw [hleftMiddle, hrightEndpoint] + exact hopposite.2.2 + simpa [full, reduced, right, hxlast', hpred] using + List.NodalInsertion.eraseIdx_last_append_singleton + left middle + (SignType.sign (y (Fin.last (n + 2)))) + (n - 1) hlen haMiddle hbEndpoint habMiddle + · have hkpos : 0 < (k : ℕ) := Nat.pos_of_ne_zero hkzero + have hklt : (k : ℕ) < n := by lia + have hpred : + (k : ℕ) - 1 + 1 = (k : ℕ) := by lia + have hsucc : + (k : ℕ) - 1 + 2 = (k : ℕ) + 1 := by lia + have hleftBound : + (k : ℕ) - 1 < middle.length := by + simp [middle] + have hrightBound : + (k : ℕ) - 1 + 2 < middle.length := by + simp [middle] + lia + have hleftMiddle : + middle[(k : ℕ) - 1]'hleftBound = + SignType.sign (y k.castSucc.castSucc) := by + rw [List.getElem_ofFn hleftBound] + congr 2 + apply Fin.ext + simp only [Fin.val_castSucc, Fin.val_succ] + lia + have hrightMiddle : + middle[(k : ℕ) - 1 + 2]'hrightBound = + SignType.sign (y k.succ.succ) := by + rw [List.getElem_ofFn hrightBound] + congr 2 + apply Fin.ext + simp only [Fin.val_castSucc, Fin.val_succ] + lia + have haMiddle : middle[(k : ℕ) - 1] ≠ 0 := by + rw [hleftMiddle] + exact hopposite.1 + have hbMiddle : middle[(k : ℕ) - 1 + 2] ≠ 0 := by + rw [hrightMiddle] + exact hopposite.2.1 + have habMiddle : + middle[(k : ℕ) - 1] ≠ + middle[(k : ℕ) - 1 + 2] := by + rw [hleftMiddle, hrightMiddle] + exact hopposite.2.2 + have hlocal : + List.NodalInsertion + ((left ++ middle ++ right).eraseIdx + (left.length + ((k : ℕ) - 1 + 1))) + (left ++ middle ++ right) := + List.NodalInsertion.eraseIdx_append_middle + left middle right ((k : ℕ) - 1) + hrightBound haMiddle hbMiddle habMiddle + have hkMiddle : (k : ℕ) < middle.length := by + simpa [middle] using k.isLt + rw [hpred] at hlocal + rw [List.eraseIdx_append_middle + left middle right (k : ℕ) hkMiddle] at hlocal + simpa [full, reduced] using hlocal + have hstepCore : + List.NodalInsertion + (Fin.nodalPerturbationCoreSigns x' y') + (Fin.nodalPerturbationCoreSigns x y) := by + rw [hreduced, hfull] + exact hstep + have hsourceComp : + (List.ofFn (SignType.sign ∘ x')).filter (· ≠ 0) = + (List.ofFn (SignType.sign ∘ x)).filter (· ≠ 0) := by + calc + _ = (List.ofFn (fun i => SignType.sign (x' i))).filter + (· ≠ 0) := by + congr 2 + _ = (List.ofFn (fun i => SignType.sign (x i))).filter + (· ≠ 0) := hsource + _ = _ := by + congr 2 + rw [hsourceComp] at hrec + exact hrec.tail hstepCore + +/-- If there is no interior zero, filtering the original signs already gives +the perturbed core signs. -/ +theorem nodalPerturbationCoreSigns_eq_of_no_interior_zero + {n : ℕ} {x y : Fin (n + 2) → ℝ} + (hsign : ∀ i, x i ≠ 0 → + SignType.sign (y i) = SignType.sign (x i)) + (hinterior : ∀ i : Fin n, x i.succ.castSucc ≠ 0) : + (List.ofFn (SignType.sign ∘ x)).filter (· ≠ 0) = + Fin.nodalPerturbationCoreSigns x y := by + let sourceMiddle : List SignType := + List.ofFn (fun i : Fin n => + SignType.sign (x i.succ.castSucc)) + let targetMiddle : List SignType := + List.ofFn (fun i : Fin n => + SignType.sign (y i.succ.castSucc)) + have hsourceMiddle : + sourceMiddle.filter (· ≠ 0) = sourceMiddle := by + apply List.filter_eq_self.2 + intro s hs + simp only [sourceMiddle, List.mem_ofFn] at hs + obtain ⟨i, rfl⟩ := hs + exact decide_eq_true (sign_ne_zero.mpr (hinterior i)) + have hmiddle : sourceMiddle = targetMiddle := by + simp only [sourceMiddle, targetMiddle] + congr 1 + funext i + exact (hsign i.succ.castSucc (hinterior i)).symm + have hfilterEndpoint (i : Fin (n + 2)) : + [SignType.sign (x i)].filter (· ≠ 0) = + if x i = 0 then [] else [SignType.sign (y i)] := by + by_cases hi : x i = 0 + · simp [hi, SignType.sign] + · rw [if_neg hi, List.filter_singleton] + have hs := sign_ne_zero.mpr hi + have hp : decide (SignType.sign (x i) ≠ 0) = true := + decide_eq_true hs + rw [hp] + change [SignType.sign (x i)] = [SignType.sign (y i)] + rw [hsign i hi] + rw [List.ofFn_two_endpoints] + change + (([SignType.sign (x 0)] ++ sourceMiddle ++ + [SignType.sign (x (Fin.last (n + 1)))]).filter (· ≠ 0)) = + (if x 0 = 0 then [] else [SignType.sign (y 0)]) ++ + targetMiddle ++ + (if x (Fin.last (n + 1)) = 0 then [] + else [SignType.sign (y (Fin.last (n + 1)))]) + rw [List.filter_append, List.filter_append, hfilterEndpoint, + hsourceMiddle, hmiddle, hfilterEndpoint] + +/-- Nodal insertions transform the filtered original sign list into the +perturbed core sign list. -/ +theorem nodalInsertions_coreSigns + {n : ℕ} {x y : Fin (n + 2) → ℝ} + (hsign : ∀ i, x i ≠ 0 → + SignType.sign (y i) = SignType.sign (x i)) + (hnodal : ∀ i : Fin n, x i.succ.castSucc = 0 → + x i.castSucc.castSucc * x i.succ.succ < 0) : + Relation.ReflTransGen List.NodalInsertion + ((List.ofFn (SignType.sign ∘ x)).filter (· ≠ 0)) + (Fin.nodalPerturbationCoreSigns x y) := by + induction n with + | zero => + have hinterior : + ∀ i : Fin 0, x i.succ.castSucc ≠ 0 := by + exact fun i => Fin.elim0 i + rw [Fin.nodalPerturbationCoreSigns_eq_of_no_interior_zero + hsign hinterior] + | succ n ih => + by_cases hzero : + ∃ k : Fin (n + 1), x k.succ.castSucc = 0 + · obtain ⟨k, hk⟩ := hzero + exact Fin.nodalInsertions_coreSigns_remove + ih hsign hnodal k hk + · have hinterior : + ∀ i : Fin (n + 1), x i.succ.castSucc ≠ 0 := by + intro i hi + exact hzero ⟨i, hi⟩ + rw [Fin.nodalPerturbationCoreSigns_eq_of_no_interior_zero + hsign hinterior] + +/-- A sign-preserving perturbation increases variations by at most two when +all interior zeros are nodal. + +This is Karlin's finite endpoint-loss estimate: interior nodal insertions cost +nothing, while the two endpoints cost at most one variation each. +-/ +theorem signVariations_le_add_two_of_sign_eq_on_nonzero_of_interior_nodal + {n : ℕ} {x y : Fin (n + 2) → ℝ} + (hsign : ∀ i, x i ≠ 0 → + SignType.sign (y i) = SignType.sign (x i)) + (hnodal : ∀ i : Fin n, x i.succ.castSucc = 0 → + x i.castSucc.castSucc * x i.succ.succ < 0) : + Fin.signVariations y ≤ Fin.signVariations x + 2 := by + let middle : List SignType := + List.ofFn (fun i : Fin n => + SignType.sign (y i.succ.castSucc)) + let core := Fin.nodalPerturbationCoreSigns x y + have hchain : + Relation.ReflTransGen List.NodalInsertion + ((List.ofFn (SignType.sign ∘ x)).filter (· ≠ 0)) core := by + exact Fin.nodalInsertions_coreSigns hsign hnodal + have hcore : core.signVariations = Fin.signVariations x := by + rw [List.signVariations_eq_of_nodalInsertions hchain] + exact Fin.filtered_signList_signVariations x + have hsplit : + List.ofFn (SignType.sign ∘ y) = + SignType.sign (y 0) :: + (middle ++ [SignType.sign (y (Fin.last (n + 1)))]) := by + simpa only [middle, Function.comp_apply] using + List.ofFn_two_endpoints (SignType.sign ∘ y) + rw [Fin.signVariations_eq_signList, hsplit] + by_cases hzero : x 0 = 0 + · by_cases hlast : x (Fin.last (n + 1)) = 0 + · have hfull : + SignType.sign (y 0) :: + (middle ++ [SignType.sign (y (Fin.last (n + 1)))]) = + (SignType.sign (y 0) :: core) ++ + [SignType.sign (y (Fin.last (n + 1)))] := by + simp [core, middle, Fin.nodalPerturbationCoreSigns, + hzero, hlast] + rw [hfull] + calc + ((SignType.sign (y 0) :: core) ++ + [SignType.sign (y (Fin.last (n + 1)))]).signVariations ≤ + (SignType.sign (y 0) :: core).signVariations + 1 := + List.signVariations_append_singleton_signType_le_succ _ _ + _ ≤ (core.signVariations + 1) + 1 := + Nat.add_le_add_right + (List.signVariations_cons_le_succ (SignType.sign (y 0)) core) 1 + _ = Fin.signVariations x + 2 := by rw [hcore] + · have hfull : + SignType.sign (y 0) :: + (middle ++ [SignType.sign (y (Fin.last (n + 1)))]) = + SignType.sign (y 0) :: core := by + simp [core, middle, Fin.nodalPerturbationCoreSigns, + hzero, hlast] + rw [hfull] + calc + (SignType.sign (y 0) :: core).signVariations ≤ + core.signVariations + 1 := + List.signVariations_cons_le_succ _ _ + _ ≤ Fin.signVariations x + 2 := by rw [hcore]; lia + · by_cases hlast : x (Fin.last (n + 1)) = 0 + · have hfull : + SignType.sign (y 0) :: + (middle ++ [SignType.sign (y (Fin.last (n + 1)))]) = + core ++ [SignType.sign (y (Fin.last (n + 1)))] := by + simp [core, middle, Fin.nodalPerturbationCoreSigns, + hzero, hlast] + rw [hfull] + calc + (core ++ + [SignType.sign (y (Fin.last (n + 1)))]).signVariations ≤ + core.signVariations + 1 := + List.signVariations_append_singleton_signType_le_succ _ _ + _ ≤ Fin.signVariations x + 2 := by rw [hcore]; lia + · have hfull : + SignType.sign (y 0) :: + (middle ++ [SignType.sign (y (Fin.last (n + 1)))]) = + core := by + simp [core, middle, Fin.nodalPerturbationCoreSigns, + hzero, hlast] + rw [hfull, hcore] + lia + /-- A finite vector has at most one fewer sign variation than its length. -/ lemma signVariations_le_card_sub_one {R : Type*} [Zero R] [LinearOrder R] {n : ℕ} (x : Fin n → R) : signVariations x ≤ n - 1 := by @@ -530,7 +1315,7 @@ lemma exists_strictMono_strictlyAlternates_of_le_signVariations have hh : q ≤ d.length - 1 := by simpa [signVariations, List.signVariations, d, nz, raw, List.map_ofFn] using h - have hlen : q + 1 ≤ d.length := by omega + have hlen : q + 1 ≤ d.length := by lia have hsub : d.Sublist raw := (List.destutter_sublist (R := fun a b : SignType => a ≠ b) nz).trans List.filter_sublist @@ -547,7 +1332,7 @@ lemma exists_strictMono_strictlyAlternates_of_le_signVariations · intro i let k0 : Fin d.length := Fin.castLE hlen i.castSucc let k1 : Fin d.length := Fin.castLE hlen i.succ - have hklt : (i : ℕ) + 1 < d.length := by omega + have hklt : (i : ℕ) + 1 < d.length := by lia have hchain : d.IsChain (· ≠ ·) := List.isChain_destutter (R := fun a b : SignType => a ≠ b) nz have hkd : d.get k0 ≠ d.get k1 := by @@ -578,6 +1363,84 @@ lemma exists_strictMono_strictlyAlternates_of_le_signVariations · rw [← he0, ← he1] exact hkd +/-- A strictly alternating subsequence gives a lower bound on the sign +variations of the ambient vector. -/ +lemma StrictlyAlternates.le_signVariations_of_strictMono + {m q : ℕ} {y : Fin m → ℝ} + {rows : Fin (q + 1) → Fin m} + (h : StrictlyAlternates (fun i => y (rows i))) + (hrows : StrictMono rows) : q ≤ signVariations y := by + by_cases hq : q = 0 + · simp [hq] + have hnonzero : ∀ i, y (rows i) ≠ 0 := by + intro i + refine Fin.cases ?_ (fun j => ?_) i + · intro hy + let i0 : Fin q := ⟨0, Nat.pos_of_ne_zero hq⟩ + have hneg := h i0 + change y (rows 0) * y (rows i0.succ) < 0 at hneg + rw [hy, zero_mul] at hneg + exact (lt_irrefl 0) hneg + · intro hy + have hneg := h j + change y (rows j.castSucc) * y (rows j.succ) < 0 at hneg + rw [hy, mul_zero] at hneg + exact (lt_irrefl 0) hneg + have hsub : + (List.ofFn (SignType.sign ∘ fun i => y (rows i))).Sublist + (List.ofFn (SignType.sign ∘ y)) := by + rw [List.sublist_iff_exists_fin_orderEmbedding_get_eq] + let e0 : + Fin (List.ofFn (SignType.sign ∘ fun i => y (rows i))).length ≃o + Fin (q + 1) := + Fin.castOrderIso List.length_ofFn + let e1 : Fin (q + 1) ↪o Fin m := + OrderEmbedding.ofStrictMono rows hrows + let e2 : + Fin m ≃o Fin (List.ofFn (SignType.sign ∘ y)).length := + (Fin.castOrderIso List.length_ofFn).symm + refine ⟨e0.toOrderEmbedding.trans (e1.trans e2.toOrderEmbedding), ?_⟩ + intro i + simp only [List.get_ofFn, e0, e1, e2, RelEmbedding.trans_apply, + Function.comp_apply] + apply congrArg SignType.sign + apply congrArg y + apply Fin.ext + rfl + have hfilter : + (List.ofFn (SignType.sign ∘ fun i => y (rows i))).filter + (· ≠ 0) = + List.ofFn (SignType.sign ∘ fun i => y (rows i)) := by + rw [List.filter_eq_self] + intro s hs + simp only [List.mem_ofFn] at hs + obtain ⟨i, rfl⟩ := hs + simp [Function.comp_apply, hnonzero i] + have hsub_nonzero : + (List.ofFn (SignType.sign ∘ fun i => y (rows i))).Sublist + ((List.ofFn (SignType.sign ∘ y)).filter (· ≠ 0)) := by + rw [← hfilter] + exact List.Sublist.filter (· ≠ 0) hsub + have hchain : + (List.ofFn (SignType.sign ∘ fun i => y (rows i))).IsChain + (· ≠ ·) := by + rw [List.isChain_ofFn] + intro i hi + change SignType.sign (y (rows ⟨i, by lia⟩)) ≠ + SignType.sign (y (rows ⟨i + 1, hi⟩)) + have hneg := h (⟨i, by lia⟩ : Fin q) + change y (rows ⟨i, by lia⟩) * y (rows ⟨i + 1, hi⟩) < 0 at hneg + rcases mul_neg_iff.mp hneg with ⟨hleft, hright⟩ | ⟨hleft, hright⟩ + · rw [sign_pos hleft, sign_neg hright] + simp + · rw [sign_neg hleft, sign_pos hright] + simp + have hlen := + List.IsChain.length_le_length_destutter_ne hsub_nonzero hchain + rw [signVariations, List.signVariations, List.map_ofFn] + simp only [List.length_ofFn] at hlen + lia + /-- Two nonzero strictly alternating vectors have pointwise products of one strict sign. -/ lemma StrictlyAlternates.pointwise_mul_pos_or_neg {n : ℕ} @@ -700,3 +1563,254 @@ lemma strictlyAlternates_alternating (n : ℕ) {ε : ℝ} (hε : 0 < ε) : _ < 0 := neg_lt_zero.mpr (sq_pos_of_pos hε) end Fin + +/-- Sign variation is monotone under taking a list prefix. -/ +theorem List.signVariations_mono_of_prefix + {R : Type*} [Zero R] [LinearOrder R] + {l₁ l₂ : List R} (h : l₁ <+: l₂) : + l₁.signVariations ≤ l₂.signVariations := by + rw [List.signVariations, List.signVariations] + have hsign : + (l₁.map SignType.sign).filter (· ≠ 0) <+: + (l₂.map SignType.sign).filter (· ≠ 0) := + (h.map SignType.sign).filter (· ≠ 0) + exact (Nat.sub_le_sub_right + (hsign.destutter (R := fun x y : SignType => x ≠ y)).length_le) 1 + +/-- Taking a list prefix cannot increase sign variation. -/ +theorem List.signVariations_take_le + {R : Type*} [Zero R] [LinearOrder R] + (l : List R) (k : ℕ) : + (l.take k).signVariations ≤ l.signVariations := + List.signVariations_mono_of_prefix (List.take_prefix k l) + +/-- A nonzero endpoint survives sign filtering as the final sign of its prefix. -/ +theorem List.getLast?_filter_sign_take_succ + {R : Type*} [Zero R] [LinearOrder R] + (l : List R) {i : ℕ} (hi : i < l.length) + (hne : l[i] ≠ 0) : + (((l.take (i + 1)).map SignType.sign).filter + (· ≠ 0)).getLast? = some (SignType.sign l[i]) := by + rw [List.take_succ_eq_append_getElem hi, List.map_append, + List.filter_append] + simp [sign_ne_zero.mpr hne] + +/-- Appending one real entry increases sign variation by at most one. -/ +theorem List.signVariations_append_singleton_le_succ + (l : List ℝ) (x : ℝ) : + (l ++ [x]).signVariations ≤ l.signVariations + 1 := by + rcases le_total 0 x with hx | hx + · apply List.signVariations_append_nonneg_le_succ + simpa using hx + · apply List.signVariations_append_nonpos_le_succ + simpa using hx + +/-- Data expressing a finite vector as nonnegative weights pulled back from an +ordered collection of sign blocks. + +This is an interface for the elementary finite-list decomposition in Karlin's +proof, not an assertion that the decomposition already exists. Separating the +data keeps later matrix arguments independent of how maximal same-sign blocks +are constructed and avoids formalizing an unrelated combinatorial model. -/ +structure Fin.SignBlockDecomposition {n : ℕ} (c : Fin n → ℝ) where + numBlocks : ℕ + numBlocks_pos : 0 < numBlocks + block : Fin n → Fin numBlocks + block_mono : Monotone block + weight : Fin n → ℝ + weight_nonneg : ∀ j, 0 ≤ weight j + coeff : Fin numBlocks → ℝ + reconstruct : ∀ j, weight j * coeff (block j) = c j + numBlocks_sub_one : numBlocks - 1 = Fin.signVariations c + +/-- The sign variation of the prefix ending at `j`. -/ +def Fin.prefixSignVariations + {n : ℕ} (c : Fin n → ℝ) (j : Fin n) : ℕ := + ((List.ofFn c).take (j + 1)).signVariations + +/-- Prefix sign variation is at most the index of the prefix endpoint. -/ +theorem Fin.prefixSignVariations_le_val + {n : ℕ} (c : Fin n → ℝ) (j : Fin n) : + Fin.prefixSignVariations c j ≤ j := by + unfold Fin.prefixSignVariations + calc + ((List.ofFn c).take (j + 1)).signVariations ≤ + ((List.ofFn c).take (j + 1)).length - 1 := + List.signVariations_le_length_sub_one _ + _ = j := by simp + +/-- At the final index, prefix sign variation is full-vector sign variation. -/ +theorem Fin.prefixSignVariations_last + {n : ℕ} (c : Fin (n + 1) → ℝ) : + Fin.prefixSignVariations c (Fin.last n) = + Fin.signVariations c := by + rw [Fin.prefixSignVariations, Fin.signVariations] + have hlength : + (Fin.last n : ℕ) + 1 = (List.ofFn c).length := by + simp + rw [hlength, List.take_length] + +/-- Prefix sign variation is monotone in the prefix endpoint. -/ +theorem Fin.monotone_prefixSignVariations + {n : ℕ} (c : Fin n → ℝ) : + Monotone (Fin.prefixSignVariations c) := by + intro i j hij + unfold Fin.prefixSignVariations + apply List.signVariations_mono_of_prefix + exact List.take_prefix_take_left (Nat.add_le_add_right hij 1) + +/-- Prefix sign variation is bounded by full-vector sign variation. -/ +theorem Fin.prefixSignVariations_le_signVariations + {n : ℕ} (c : Fin n → ℝ) (j : Fin n) : + Fin.prefixSignVariations c j ≤ Fin.signVariations c := by + unfold Fin.prefixSignVariations Fin.signVariations + exact List.signVariations_take_le _ _ + +/-- The sign-block index of an entry, counted by prefix sign variation. -/ +@[expose] +def Fin.signBlockIndex + {n : ℕ} (c : Fin n → ℝ) (j : Fin n) : + Fin (Fin.signVariations c + 1) := + ⟨Fin.prefixSignVariations c j, + Nat.lt_succ_of_le (Fin.prefixSignVariations_le_signVariations c j)⟩ + +@[simp] +theorem Fin.val_signBlockIndex + {n : ℕ} (c : Fin n → ℝ) (j : Fin n) : + (Fin.signBlockIndex c j : ℕ) = + Fin.prefixSignVariations c j := + rfl + +@[simp] +theorem Fin.signBlockIndex_last + {n : ℕ} (c : Fin (n + 1) → ℝ) : + Fin.signBlockIndex c (Fin.last n) = + Fin.last (Fin.signVariations c) := by + apply Fin.ext + exact Fin.prefixSignVariations_last c + +/-- Sign-block indices are monotone in the original index. -/ +theorem Fin.monotone_signBlockIndex + {n : ℕ} (c : Fin n → ℝ) : + Monotone (Fin.signBlockIndex c) := by + intro i j hij + exact Fin.monotone_prefixSignVariations c hij + +/-- Adjacent prefix sign-variation values differ by at most one. -/ +theorem Fin.prefixSignVariations_succ_le + {n : ℕ} (c : Fin (n + 1) → ℝ) (i : Fin n) : + Fin.prefixSignVariations c i.succ ≤ + Fin.prefixSignVariations c i.castSucc + 1 := by + unfold Fin.prefixSignVariations + have hindex : + (i : ℕ) + 1 < (List.ofFn c).length := by + simp [i.isLt] + rw [show (i.succ : ℕ) + 1 = ((i : ℕ) + 1) + 1 by simp, + List.take_succ_eq_append_getElem hindex] + exact List.signVariations_append_singleton_le_succ _ _ + +/-- Nonzero entries with equal block index and ordered indices have equal signs. -/ +theorem Fin.sign_eq_of_le_of_signBlockIndex_eq + {n : ℕ} (c : Fin n → ℝ) {i j : Fin n} + (hij : i ≤ j) (hi : c i ≠ 0) (hj : c j ≠ 0) + (hblock : Fin.signBlockIndex c i = Fin.signBlockIndex c j) : + SignType.sign (c i) = SignType.sign (c j) := by + let l := List.ofFn c + let sᵢ := + ((l.take (i + 1)).map SignType.sign).filter (· ≠ 0) + let sⱼ := + ((l.take (j + 1)).map SignType.sign).filter (· ≠ 0) + have hprefix : sᵢ <+: sⱼ := + ((List.take_prefix_take_left + (Nat.add_le_add_right hij 1)).map SignType.sign).filter (· ≠ 0) + have hprefEq : + Fin.prefixSignVariations c i = + Fin.prefixSignVariations c j := by + simpa only [Fin.val_signBlockIndex] using congrArg Fin.val hblock + have hvariationEq : + (sᵢ.destutter (· ≠ ·)).length - 1 = + (sⱼ.destutter (· ≠ ·)).length - 1 := by + change (l.take (i + 1)).signVariations = + (l.take (j + 1)).signVariations at hprefEq + change (sᵢ.destutter (· ≠ ·)).length - 1 = + (sⱼ.destutter (· ≠ ·)).length - 1 at hprefEq + exact hprefEq + have hiIndex : (i : ℕ) < l.length := by simp [l] + have hjIndex : (j : ℕ) < l.length := by simp [l] + have hiValue : l[i] ≠ 0 := by simpa [l] using hi + have hjValue : l[j] ≠ 0 := by simpa [l] using hj + have hlastI : + sᵢ.getLast? = some (SignType.sign (c i)) := by + simpa [sᵢ, l] using + List.getLast?_filter_sign_take_succ l hiIndex hiValue + have hlastJ : + sⱼ.getLast? = some (SignType.sign (c j)) := by + simpa [sⱼ, l] using + List.getLast?_filter_sign_take_succ l hjIndex hjValue + have hdestIPos : 0 < (sᵢ.destutter (· ≠ ·)).length := by + rw [List.length_pos_iff] + intro hd + have hlastDest := List.getLast?_destutter_ne sᵢ + rw [hd, hlastI] at hlastDest + simp at hlastDest + have hdestLengthLe : + (sᵢ.destutter (· ≠ ·)).length ≤ + (sⱼ.destutter (· ≠ ·)).length := + (hprefix.destutter + (R := fun x y : SignType => x ≠ y)).length_le + have hlengthEq : + (sᵢ.destutter (· ≠ ·)).length = + (sⱼ.destutter (· ≠ ·)).length := by + lia + have hlastEq : sᵢ.getLast? = sⱼ.getLast? := + hprefix.getLast?_eq_of_destutter_length_le hlengthEq.ge + rw [hlastI, hlastJ] at hlastEq + exact Option.some.inj hlastEq + +/-- Nonzero entries in the same sign block have equal signs. -/ +theorem Fin.sign_eq_of_signBlockIndex_eq + {n : ℕ} (c : Fin n → ℝ) {i j : Fin n} + (hi : c i ≠ 0) (hj : c j ≠ 0) + (hblock : Fin.signBlockIndex c i = Fin.signBlockIndex c j) : + SignType.sign (c i) = SignType.sign (c j) := by + rcases le_total i j with hij | hji + · exact Fin.sign_eq_of_le_of_signBlockIndex_eq c hij hi hj hblock + · exact (Fin.sign_eq_of_le_of_signBlockIndex_eq + c hji hj hi hblock.symm).symm + +/-- The same-sign block decomposition used in Karlin's variation theorem. + +Zero entries receive weight zero. Each block containing a nonzero entry uses +the sign of one such entry as its coefficient; the same-block sign theorem +makes this choice independent of the representative for reconstruction. -/ +noncomputable def Fin.signBlockDecomposition + {n : ℕ} (c : Fin n → ℝ) : Fin.SignBlockDecomposition c := by + classical + let coeff : Fin (Fin.signVariations c + 1) → ℝ := fun b => + if h : ∃ j, c j ≠ 0 ∧ Fin.signBlockIndex c j = b then + (SignType.sign (c h.choose) : ℝ) + else 0 + refine + { numBlocks := Fin.signVariations c + 1 + numBlocks_pos := Nat.succ_pos _ + block := Fin.signBlockIndex c + block_mono := Fin.monotone_signBlockIndex c + weight := fun j => |c j| + weight_nonneg := fun j => abs_nonneg (c j) + coeff := coeff + reconstruct := ?_ + numBlocks_sub_one := Nat.add_sub_cancel _ _ } + intro j + by_cases hj : c j = 0 + · simp only [hj, abs_zero, zero_mul] + · have hex : + ∃ k, c k ≠ 0 ∧ + Fin.signBlockIndex c k = Fin.signBlockIndex c j := + ⟨j, hj, rfl⟩ + change |c j| * coeff (Fin.signBlockIndex c j) = c j + rw [show coeff (Fin.signBlockIndex c j) = + (SignType.sign (c hex.choose) : ℝ) by + simp only [coeff, dif_pos hex], + ← Fin.sign_eq_of_signBlockIndex_eq c hj + hex.choose_spec.1 hex.choose_spec.2.symm, + abs_mul_sign] diff --git a/RealRooted/Mathlib/LinearAlgebra/Matrix/SignVariationTopology.lean b/RealRooted/Mathlib/LinearAlgebra/Matrix/SignVariationTopology.lean new file mode 100644 index 00000000..48f7fb56 --- /dev/null +++ b/RealRooted/Mathlib/LinearAlgebra/Matrix/SignVariationTopology.lean @@ -0,0 +1,116 @@ +import RealRooted.Mathlib.LinearAlgebra.Matrix.SignVariation + +/-! +# Topological properties of sign variations + +This file proves the finite-dimensional lower semicontinuity of sign variations. +The result supplies the limit step in Karlin's Gaussian approximation argument +for variation-diminishing matrices. +-/ + +open Filter Topology + +namespace Fin + +/-- Nonzero coordinates eventually retain their signs under convergence. -/ +theorem eventually_sign_eq_of_tendsto + {α : Type*} {l : Filter α} [l.NeBot] {n : ℕ} + {f : α → Fin n → ℝ} {x : Fin n → ℝ} + (hf : Tendsto f l (𝓝 x)) : + ∀ᶠ a in l, ∀ i, x i ≠ 0 → + SignType.sign (f a i) = SignType.sign (x i) := by + have hsign : + ∀ i : Fin n, ∀ᶠ a in l, x i ≠ 0 → + SignType.sign (f a i) = SignType.sign (x i) := by + intro i + by_cases hi : x i = 0 + · exact Filter.Eventually.of_forall fun _ hne => (hne hi).elim + · have hiLimit := tendsto_pi_nhds.mp hf i + rcases lt_or_gt_of_ne hi with hneg | hpos + · filter_upwards [hiLimit.eventually_lt_const hneg] with a ha + intro + rw [sign_neg ha, sign_neg hneg] + · filter_upwards [hiLimit.eventually_const_lt hpos] with a ha + intro + rw [sign_pos ha, sign_pos hpos] + exact Filter.eventually_all.mpr hsign + +/-- Sign variations cannot increase when a convergent net reaches its limit. -/ +theorem signVariations_le_of_tendsto + {α : Type*} {l : Filter α} [l.NeBot] {n r : ℕ} + {f : α → Fin n → ℝ} {x : Fin n → ℝ} + (hf : Tendsto f l (𝓝 x)) + (hr : ∀ᶠ a in l, signVariations (f a) ≤ r) : + signVariations x ≤ r := by + let raw : List SignType := List.ofFn (SignType.sign ∘ x) + let nz : List SignType := raw.filter (· ≠ 0) + let d : List SignType := nz.destutter (· ≠ ·) + have hsub : d.Sublist raw := + (List.destutter_sublist (· ≠ ·) nz).trans List.filter_sublist + obtain ⟨e, he⟩ := + List.sublist_iff_exists_fin_orderEmbedding_get_eq.mp hsub + have hrawlen : raw.length = n := by + simp [raw] + let eN : Fin d.length ↪o Fin n := + e.trans (Fin.castOrderIso hrawlen).toOrderEmbedding + have he' (k : Fin d.length) : + d.get k = SignType.sign (x (eN k)) := by + rw [he k] + simp only [raw, List.get_ofFn, Function.comp_apply] + congr 2 + have hd_ne (z : SignType) (hz : z ∈ d) : z ≠ 0 := by + have hz_nz : z ∈ nz := + (List.destutter_sublist (· ≠ ·) nz).mem hz + exact of_decide_eq_true (List.mem_filter.mp hz_nz).2 + have hd_filter : d.filter (· ≠ 0) = d := by + rw [List.filter_eq_self] + intro z hz + simp [hd_ne z hz] + have hsign : + ∀ᶠ a in l, ∀ k : Fin d.length, + d.get k = SignType.sign (f a (eN k)) := by + filter_upwards [eventually_sign_eq_of_tendsto hf] with a ha + intro k + have hxne : x (eN k) ≠ 0 := by + rw [← sign_ne_zero, ← he' k] + exact hd_ne _ (List.get_mem d k) + rw [he' k, ha (eN k) hxne] + have hmono : + ∀ᶠ a in l, signVariations x ≤ signVariations (f a) := by + filter_upwards [hsign] with a ha + let rawA : List SignType := List.ofFn (SignType.sign ∘ f a) + have hrawAlen : rawA.length = n := by + simp [rawA] + let eA : Fin d.length ↪o Fin rawA.length := + eN.trans (Fin.castOrderIso hrawAlen.symm).toOrderEmbedding + have hdsub : d.Sublist rawA := by + apply List.sublist_iff_exists_fin_orderEmbedding_get_eq.mpr + refine ⟨eA, ?_⟩ + intro k + rw [ha k] + simp only [rawA, List.get_ofFn, Function.comp_apply] + congr 2 + have hdsub_nz : d.Sublist (rawA.filter (· ≠ 0)) := by + simpa only [hd_filter] using hdsub.filter (· ≠ 0) + have hlen := + (List.isChain_destutter (· ≠ ·) nz).length_le_length_destutter_ne hdsub_nz + simpa only [signVariations, List.signVariations, List.map_ofFn, d, nz, raw, + rawA] using Nat.sub_le_sub_right hlen 1 + obtain ⟨a, hxa, har⟩ := (hmono.and hr).exists + exact hxa.trans har + +/-- A convergent perturbation of a vector with nodal interior zeros eventually +has at most two additional sign variations. -/ +theorem eventually_signVariations_le_add_two_of_tendsto_of_interior_nodal + {α : Type*} {l : Filter α} [l.NeBot] + {n : ℕ} {f : α → Fin (n + 2) → ℝ} + {x : Fin (n + 2) → ℝ} + (hf : Tendsto f l (𝓝 x)) + (hnodal : ∀ i : Fin n, x i.succ.castSucc = 0 → + x i.castSucc.castSucc * x i.succ.succ < 0) : + ∀ᶠ a in l, + signVariations (f a) ≤ signVariations x + 2 := by + filter_upwards [eventually_sign_eq_of_tendsto hf] with a ha + exact signVariations_le_add_two_of_sign_eq_on_nonzero_of_interior_nodal ha hnodal + +end Fin diff --git a/RealRooted/Mathlib/LinearAlgebra/Vandermonde.lean b/RealRooted/Mathlib/LinearAlgebra/Vandermonde.lean new file mode 100644 index 00000000..34a02cb5 --- /dev/null +++ b/RealRooted/Mathlib/LinearAlgebra/Vandermonde.lean @@ -0,0 +1,27 @@ +import Mathlib.LinearAlgebra.Vandermonde + +/-! +# Ordered Vandermonde determinants + +This file adds the strict positivity consequence of the Vandermonde +determinant formula for a strictly increasing family. +-/ + +public section + +namespace Matrix + +variable {R : Type*} [CommRing R] [LinearOrder R] [IsStrictOrderedRing R] + +/-- A Vandermonde determinant on a strictly increasing family is positive. -/ +theorem det_vandermonde_pos_of_strictMono {q : ℕ} + {y : Fin q → R} (hy : StrictMono y) : + 0 < (vandermonde y).det := by + rw [det_vandermonde] + apply Finset.prod_pos + intro i hi + apply Finset.prod_pos + intro j hj + exact sub_pos.mpr (hy (Finset.mem_Ioi.mp hj)) + +end Matrix diff --git a/RealRooted/PFPolynomial.lean b/RealRooted/PFPolynomial.lean index c8683993..0e530ec4 100644 --- a/RealRooted/PFPolynomial.lean +++ b/RealRooted/PFPolynomial.lean @@ -187,6 +187,14 @@ theorem of_sequence let hpnn := hasNonnegCoeffs_of_IsPolyaFreqSeq_coeff hpf ⟨hpnn, hASW hpnn hpf⟩ +/-- Construct a PF polynomial directly from its Pólya-frequency coefficient +sequence using the proved forward ASW theorem. -/ +theorem of_polyaFreqSeq {p : ℝ[X]} + (hpf : IsPolyaFreqSeq (fun n => p.coeff n)) : + IsPFPolynomial p := + let hpnn := hasNonnegCoeffs_of_IsPolyaFreqSeq_coeff hpf + ⟨hpnn, aissenSchoenbergWhitneyForwardOrZero hpnn hpf⟩ + /-- Forward-ASW endpoint closure for positive affine coefficient limits. -/ theorem of_forall_pos_add_C_mul_of_forward (hASW : aissenSchoenbergWhitneyForwardOrZeroStatement) @@ -207,6 +215,25 @@ theorem splits_of_forall_pos_add_C_mul_of_forward p.Splits := (of_forall_pos_add_C_mul_of_forward hASW hpnn hqnn hfamily).ne_zero_and_splits hp0 |>.2 +/-- PF endpoint closure for positive affine coefficient limits, using the +proved forward ASW theorem. -/ +theorem of_forall_pos_add_C_mul + {p q : ℝ[X]} + (hpnn : HasNonnegCoeffs p) (hqnn : HasNonnegCoeffs q) + (hfamily : ∀ {μ : ℝ}, 0 < μ → (p + C μ * q).Splits) : + IsPFPolynomial p := + IsPFPolynomial.of_polyaFreqSeq <| + IsPolyaFreqSeq.of_forall_pos_add_C_mul_splits hpnn hqnn hfamily + +/-- Splitting form of `IsPFPolynomial.of_forall_pos_add_C_mul`. -/ +theorem splits_of_forall_pos_add_C_mul + {p q : ℝ[X]} + (hp0 : p ≠ 0) + (hpnn : HasNonnegCoeffs p) (hqnn : HasNonnegCoeffs q) + (hfamily : ∀ {μ : ℝ}, 0 < μ → (p + C μ * q).Splits) : + p.Splits := + (of_forall_pos_add_C_mul hpnn hqnn hfamily).ne_zero_and_splits hp0 |>.2 + theorem to_sequence {p : ℝ[X]} (hp : IsPFPolynomial p) : diff --git a/RealRooted/Tactic/Examples/Favard.lean b/RealRooted/Tactic/Examples/Favard.lean index 8341ec25..71ef6f20 100644 --- a/RealRooted/Tactic/Examples/Favard.lean +++ b/RealRooted/Tactic/Examples/Favard.lean @@ -35,6 +35,23 @@ example {P : Nat → ℝ[X]} {α β : Nat → ℝ} ∀ n : Nat, Prec (P n) (P (n + 1)) := by rr_favard using hrec, hbeta +/-- Exact local inference ignores an unrelated Favard certificate packet. -/ +example {P Q : Nat → ℝ[X]} {α β γ δ : Nat → ℝ} + (_hrecDecoy : SatisfiesFavardRecurrence Q γ δ) + -- This guards against the positivity proof fixing the wrong coefficient sequence. + (_hbetaDecoy : ∀ n : Nat, 0 < δ (n + 1)) + (hrec : SatisfiesFavardRecurrence P α β) + (hbeta : ∀ n : Nat, 0 < β (n + 1)) : + ∀ n : Nat, Prec (P n) (P (n + 1)) := by + rr_favard + +/-- The inferred auto form retains positivity automation. -/ +example {P Q : Nat → ℝ[X]} {γ δ : Nat → ℝ} + (_hrecDecoy : SatisfiesFavardRecurrence Q γ δ) + (hrec : SatisfiesFavardRecurrence P (fun _ => 0) (fun _ => 1)) : + ∀ n : Nat, (P n).Splits := by + rr_favard_auto + example {P : Nat → ℝ[X]} {α β : Nat → ℝ} (hrec : SatisfiesFavardRecurrence P α β) (hbeta : ∀ n : Nat, 0 < β (n + 1)) : @@ -577,6 +594,77 @@ example {P : Nat → ℝ[X]} base_one := hP1', step := hstep' +/-- The inferred affine router finds the standard certificate packet while the +coefficient families and recurrence remain explicit. -/ +example {P Q : Nat → ℝ[X]} {s α β u v w : Nat → ℝ} + (_hsDecoy : ∀ n : Nat, 0 < u n) + (_hβDecoy : ∀ n : Nat, 0 < w (n + 1)) + (_hQ0 : Q 0 = 1) + (_hQ1 : Q 1 = C (u 0) * X - C (v 0)) + (hs : ∀ n : Nat, 0 < s n) + (hβ : ∀ n : Nat, 0 < β (n + 1)) + (hP0 : P 0 = 1) + (hP1 : P 1 = C (s 0) * X - C (α 0)) + (hstep : ∀ n : Nat, + P (n + 2) = + (C (s (n + 1)) * X - C (α (n + 1))) * P (n + 1) - + C (β (n + 1)) * P n) : + ∀ n : Nat, (P n).Splits := by + rr_favard_affine_param_infer using + slope := s, + alpha := α, + beta := β, + step := hstep + +/-- The inferred form proves elementary positivity but still requires the two +base certificates from the local context or tagged declarations. -/ +example {P : Nat → ℝ[X]} + (hP0 : P 0 = 1) + (hP1 : P 1 = C (2 : ℝ) * X) + (hstep : ∀ n : Nat, + P (n + 2) = + (C (2 : ℝ) * X - C (((n + 1 : Nat) : ℝ))) * P (n + 1) - + C ((((n + 1 : Nat) : ℝ) + 1)) * P n) : + ∀ n : Nat, Prec (P n) (P (n + 1)) := by + rr_favard_affine_param_infer using + slope := fun _ : Nat => (2 : ℝ), + alpha := fun m : Nat => (m : ℝ), + beta := fun m : Nat => (m : ℝ) + 1, + step := hstep + +/-- Mixed packets can combine automatic slope positivity with a looked-up lag +certificate. -/ +example {P : Nat → ℝ[X]} {β : Nat → ℝ} + (hβ : ∀ n : Nat, 0 < β (n + 1)) + (hP0 : P 0 = 1) + (hP1 : P 1 = C (2 : ℝ) * X) + (hstep : ∀ n : Nat, + P (n + 2) = + (C (2 : ℝ) * X - C (((n + 1 : Nat) : ℝ))) * P (n + 1) - + C (β (n + 1)) * P n) : + ∀ n : Nat, (P n).Splits := by + rr_favard_affine_param_infer using + slope := fun _ : Nat => (2 : ℝ), + alpha := fun m : Nat => (m : ℝ), + beta := β, + step := hstep + +/-- Base certificates are intentionally not synthesized by the inferred form. -/ +example {P : Nat → ℝ[X]} + (_hP0 : P 0 = 1) + (_hstep : ∀ n : Nat, + P (n + 2) = + (C (2 : ℝ) * X - C (((n + 1 : Nat) : ℝ))) * P (n + 1) - P n) + (hgoal : ∀ n : Nat, (P n).Splits) : + ∀ n : Nat, (P n).Splits := by + fail_if_success + rr_favard_affine_param_infer using + slope := fun _ : Nat => (2 : ℝ), + alpha := fun m : Nat => (m : ℝ), + beta := fun _ : Nat => (1 : ℝ), + step := _hstep + exact hgoal + /-- Positive-slope parameterized affine Favard smoke test with a scalar denominator on the displayed recurrence. -/ example {P : Nat → ℝ[X]} {d : Nat → ℝ} @@ -1385,6 +1473,24 @@ example {P : Nat → ℝ[X]} {s α β : Nat → ℝ} base_one := hP1, step := hstep +/-- The inferred router rolls back from the standard orientation and finds the +row-sign certificate packet. -/ +example {P : Nat → ℝ[X]} {s α β : Nat → ℝ} {n : Nat} + (hs : ∀ n : Nat, 0 < s n) + (hβ : ∀ n : Nat, 0 < β (n + 1)) + (hP0 : P 0 = 1) + (hP1 : P 1 = -(C (s 0) * X - C (α 0))) + (hstep : ∀ n : Nat, + P (n + 2) = + -(C (s (n + 1)) * X - C (α (n + 1))) * P (n + 1) - + C (β (n + 1)) * P n) : + P n ≠ 0 := by + rr_favard_affine_param_infer using + slope := s, + alpha := α, + beta := β, + step := hstep + /-- Automatic positivity for parameterized affine row-sign wrappers. -/ example {P : Nat → ℝ[X]} (hP0 : P 0 = 1) diff --git a/RealRooted/Tactic/Examples/FiniteSymbol.lean b/RealRooted/Tactic/Examples/FiniteSymbol.lean index c60802d1..81d30db8 100644 --- a/RealRooted/Tactic/Examples/FiniteSymbol.lean +++ b/RealRooted/Tactic/Examples/FiniteSymbol.lean @@ -29,5 +29,21 @@ example {sigma tau : Type*} [Fintype sigma] symbol_stable := hSymbol, input_stable := hf +example {sigma tau : Type*} [Fintype sigma] + (T : MvPolynomial.degreeOfLE sigma ℂ (fun _ => 1) →ₗ[ℂ] + MvPolynomial tau ℂ) + (S : MvPolynomial.degreeOfLE sigma ℂ (fun _ => 1) →ₗ[ℂ] + MvPolynomial tau ℂ) + (_hSymbolS : MvUpperHalfPlaneStable + (MvPolynomial.algebraicSymbol (fun _ : sigma => 1) S)) + (hSymbol : MvUpperHalfPlaneStable + (MvPolynomial.algebraicSymbol (fun _ : sigma => 1) T)) + (g : MvPolynomial.degreeOfLE sigma ℂ (fun _ => 1)) + (_hg : MvUpperHalfPlaneStable g.1) + (f : MvPolynomial.degreeOfLE sigma ℂ (fun _ => 1)) + (hf : MvUpperHalfPlaneStable f.1) : + MvUpperHalfPlaneStableOrZero (T f) := by + rr_finite_symbol_stable_or_zero_auto + end Tactic end RealRooted diff --git a/RealRooted/Tactic/Examples/Hadamard.lean b/RealRooted/Tactic/Examples/Hadamard.lean index c572f565..d892553a 100644 --- a/RealRooted/Tactic/Examples/Hadamard.lean +++ b/RealRooted/Tactic/Examples/Hadamard.lean @@ -386,6 +386,37 @@ example {f g p q : ℝ[X]} first_prec := hfg, second_prec := hpq +example {f g p q : ℝ[X]} + (hf : IsPFPolynomial f) (hg : IsPFPolynomial g) + (hp : IsPFPolynomial p) (hq : IsPFPolynomial q) + (hfg : Prec0 f g) (hpq : Prec0 p q) : + Prec0 (hadamardProduct f p) (hadamardProduct g q) := by + rr_hadamard_pf_prec0 + +example {f g p : ℝ[X]} + (hf : IsPFPolynomial f) (hg : IsPFPolynomial g) (hp : IsPFPolynomial p) + (hfg : Prec0 f g) : + Prec0 (hadamardProduct f p) (hadamardProduct g p) := by + rr_hadamard_pf_prec0 + +example {f p q : ℝ[X]} + (hf : IsPFPolynomial f) (hp : IsPFPolynomial p) (hq : IsPFPolynomial q) + (hpq : Prec0 p q) : + Prec0 (hadamardProduct f p) (hadamardProduct f q) := by + rr_hadamard_pf_prec0 + +example {F G P Q : Nat → ℝ[X]} + (hF : ∀ i : Nat, IsPFPolynomial (F i)) + (hG : ∀ i : Nat, IsPFPolynomial (G i)) + (hP : ∀ i : Nat, IsPFPolynomial (P i)) + (hQ : ∀ i : Nat, IsPFPolynomial (Q i)) + (hFG : ∀ i : Nat, Prec0 (F i) (G i)) + (hPQ : ∀ i : Nat, Prec0 (P i) (Q i)) : + ∀ n : Nat, + Prec0 (hadamardProduct (F n) (P n)) (hadamardProduct (G n) (Q n)) := by + intro n + rr_hadamard_pf_prec0 + example {P Q : Nat → ℝ[X]} (hP : ∀ i : Nat, IsPFPolynomial (P i)) (hQ : ∀ i : Nat, IsPFPolynomial (Q i)) : diff --git a/RealRooted/Tactic/Examples/LiuWang.lean b/RealRooted/Tactic/Examples/LiuWang.lean index 06515dfb..3ea4e339 100644 --- a/RealRooted/Tactic/Examples/LiuWang.lean +++ b/RealRooted/Tactic/Examples/LiuWang.lean @@ -4863,5 +4863,65 @@ example {P : Nat → ℝ[X]} {A R : Nat → ℝ[X]} degree_succ := hdeg_succ, no_common_roots := hno +section InferredSequenceCertificates + +variable {P A B R Q : Nat → ℝ[X]} +variable (hbase : Prec (P 0) (P 1)) +variable (hpos : ∀ n : Nat, HasPosLeadingCoeff (P n)) +variable (hdeg_succ : ∀ n : Nat, (P n).natDegree + 1 = (P (n + 1)).natDegree) +variable (hno : ∀ n : Nat, ∀ r, (P (n + 1)).IsRoot r → ¬ (P n).IsRoot r) + +variable (hB : ∀ n : Nat, ∀ r, (P (n + 1)).IsRoot r → (B n).eval r ≤ 0) +variable (hrecB : ∀ n : Nat, P (n + 2) = A n * P (n + 1) + B n * P n) + +/-- A supplied recurrence fixes both hidden coefficient families before lookup. -/ +example : ∀ n : Nat, Prec (P n) (P (n + 1)) := by + rr_lw_nonpos_lag_sequence using recurrence := hrecB + +/-- The inferred nonpositive-lag shell returns its full real-rooted endpoint. -/ +example : ∀ n : Nat, P n ≠ 0 ∧ (P n).Splits := by + rr_lw_nonpos_lag_sequence_realrooted using recurrence := hrecB + +/-- The inferred nonpositive-lag shell supports the splitting projection. -/ +example : ∀ n : Nat, (P n).Splits := by + rr_lw_nonpos_lag_sequence_realrooted using recurrence := hrecB + +/-- The inferred nonpositive-lag shell supports the nonzero projection. -/ +example : ∀ n : Nat, P n ≠ 0 := by + rr_lw_nonpos_lag_sequence_realrooted using recurrence := hrecB + +/-- The inferred nonpositive-lag shell supports an indexed splitting projection. -/ +example : (P 3).Splits := by + rr_lw_nonpos_lag_sequence_realrooted using recurrence := hrecB + +variable (_hQ : ∀ n : Nat, ∀ r, (P (n + 1)).IsRoot r → 0 ≤ (Q n).eval r) +variable (hnonneg : ∀ n : Nat, HasNonnegCoeffs (P n)) +variable (hR : ∀ n : Nat, ∀ r, (P (n + 1)).IsRoot r → 0 ≤ (R n).eval r) +variable (hrecR : ∀ n : Nat, + P (n + 2) = A n * P (n + 1) + (X * R n) * P n) +variable (hraw : ∀ n : Nat, + P (n + 2) = A n * P (n + 1) + X * (R n * P n)) + +/-- The tR recurrence selects its factor family ahead of the decoy before lookup. -/ +example : ∀ n : Nat, Prec (P n) (P (n + 1)) := by + rr_lw_tR_lag_sequence using recurrence := hrecR + +/-- The inferred tR shell returns its full real-rooted endpoint. -/ +example : ∀ n : Nat, P n ≠ 0 ∧ (P n).Splits := by + rr_lw_tR_lag_sequence_realrooted using recurrence := hrecR + +/-- The inferred tR shell supports an indexed splitting projection. -/ +example : (P 3).Splits := by + rr_lw_tR_lag_sequence_realrooted using recurrence := hrecR + +/-- An ascribed normalizer fixes the hidden factor family before its tactic runs. -/ +example : ∀ n : Nat, Prec (P n) (P (n + 1)) := by + rr_lw_tR_lag_sequence using recurrence := + (show ∀ n : Nat, + P (n + 2) = A n * P (n + 1) + (X * R n) * P n from + fun n => by simpa only [mul_assoc] using hraw n) + +end InferredSequenceCertificates + end Tactic end RealRooted diff --git a/RealRooted/Tactic/Examples/Lookup.lean b/RealRooted/Tactic/Examples/Lookup.lean index 1f960ba0..902ac656 100644 --- a/RealRooted/Tactic/Examples/Lookup.lean +++ b/RealRooted/Tactic/Examples/Lookup.lean @@ -24,5 +24,94 @@ example : True := by example : True := by rr_lookup [rr_pos_lc] +def RRLookupSmokeRel {α : Type} (x : α) : Prop := x = x + +/-- This relation remains untagged so these examples can only use locals. -/ +def RRLookupFreshRel (n : Nat) : Prop := n = n + +def RRLookupFreshPolyRel {α : Type} (x : α) : Prop := x = x + +example (_h : ∀ n : Nat, RRLookupFreshRel n) : RRLookupFreshRel 5 := by + rr_lookup + +example (_h : ∀ n : Nat, RRLookupFreshRel n) : RRLookupFreshRel 5 := by + rr_lookup [rr_nonneg] + +example (_hbad : False → RRLookupFreshRel 5) : RRLookupFreshRel 5 := by + fail_if_success rr_lookup + rfl + +example (_hloose : ∀ _n : Nat, RRLookupFreshRel 5) : RRLookupFreshRel 5 := by + fail_if_success rr_lookup + rfl + +theorem rr_lookup_mvar_goal_smoke {n : Nat} (_h : RRLookupFreshRel n) : True := + trivial + +example (_h : ∀ n : Nat, RRLookupFreshRel n) : True := by + fail_if_success (apply rr_lookup_mvar_goal_smoke; rr_lookup) + trivial + +@[rr_matrix_rect] theorem rr_lookup_forall_smoke (m : ℕ) : + ∀ n : ℕ, RRLookupSmokeRel (n + m) := by + intro n + rfl + +example : ∀ n : ℕ, RRLookupSmokeRel (n + 3) := by + rr_lookup [rr_matrix_rect] + +@[rr_base_prec] theorem rr_lookup_full_forall_smoke : + ∀ n : ℕ, RRLookupSmokeRel n := by + intro n + rfl + +example : ∀ n : ℕ, RRLookupSmokeRel n := by + rr_lookup [rr_base_prec] + +@[rr_degree] theorem rr_lookup_determined_smoke : 37 = 37 := by + rfl + +@[rr_degree] theorem rr_lookup_partial_decoy_smoke (h : False) : 37 = 37 := by + contradiction + +example : 37 = 37 := by + rr_lookup [rr_degree] + +class RRLookupSmokeClass (α : Type) : Prop where + witness : True + +class RRLookupMissingClass (α : Type) : Prop where + witness : True + +instance : RRLookupSmokeClass ℕ := ⟨trivial⟩ + +example + (_h : ∀ {α : Type} [RRLookupSmokeClass α] (x : α), + RRLookupFreshPolyRel x) : + RRLookupFreshPolyRel (37 : Nat) := by + rr_lookup + +@[rr_nonneg] theorem rr_lookup_missing_typeclass_decoy {α : Type} + [RRLookupMissingClass α] (x : α) : RRLookupSmokeRel x := rfl + +@[rr_nonneg] theorem rr_lookup_typeclass_smoke {α : Type} [RRLookupSmokeClass α] + (x : α) : RRLookupSmokeRel x := rfl + +example : RRLookupSmokeRel (37 : ℕ) := by + rr_lookup [rr_nonneg] + +local syntax (name := rr_lookup_attr_macro_smoke) "rr_lookup_attr_macro_smoke" : tactic + +local macro_rules + | `(tactic| rr_lookup_attr_macro_smoke) => + `(tactic| rr_lookup [rr_pos_lc]) + +example : True := by + rr_lookup_attr_macro_smoke + +example (h : True) : True := by + fail_if_success rr_lookup [rr_missing_attr] + exact h + end Tactic end RealRooted diff --git a/RealRooted/Tactic/Examples/MaWang.lean b/RealRooted/Tactic/Examples/MaWang.lean index 5e591cba..5a67796a 100644 --- a/RealRooted/Tactic/Examples/MaWang.lean +++ b/RealRooted/Tactic/Examples/MaWang.lean @@ -26,6 +26,7 @@ example {n : Nat} : 1 - ((n : ℝ) + 3) ≠ 0 := by example : ∀ n : Nat, 1 - ((n : ℝ) + 3) ≠ 0 := by rr_scalar_active_den_all +/-- A supplied recurrence fixes the hidden target before atomic lookup. -/ example {f F u v : ℝ[X]} (hf : f.Splits) (hdegf : 2 ≤ f.natDegree) @@ -46,6 +47,46 @@ example {f F u v : ℝ[X]} source_pos_lc := hf_pos, coeff_nonpos := hv_nonpos +/-- Recurrence normalization completes before certificate lookup starts. -/ +example {f F u v : ℝ[X]} + (hf : f.Splits) + (hdegf : 2 ≤ f.natDegree) + (hrec : F = u * f + v * f.derivative) + (hF_pos : HasPosLeadingCoeff F) + (hdeg_lo : f.natDegree ≤ F.natDegree) + (hdeg_hi : F.natDegree ≤ f.natDegree + 1) + (hf_pos : HasPosLeadingCoeff f) + (hv_nonpos : ∀ r, f.IsRoot r → v.eval r ≤ 0) : + Prec f (u * f + v * f.derivative) := by + rr_mw_derivative_nonpos_step using recurrence := hrec + +example {f F u v : ℝ[X]} + (hf : f.Splits) + (hdegf : 2 ≤ f.natDegree) + (hraw : F = v * f.derivative + u * f) + (hF_pos : HasPosLeadingCoeff F) + (hdeg_lo : f.natDegree ≤ F.natDegree) + (hdeg_hi : F.natDegree ≤ f.natDegree + 1) + (hf_pos : HasPosLeadingCoeff f) + (hv_nonpos : ∀ r, f.IsRoot r → v.eval r ≤ 0) : + Prec f (u * f + v * f.derivative) := by + rr_mw_derivative_nonpos_step using recurrence := + (by simpa [add_comm] using hraw : F = u * f + v * f.derivative) + +/-- The inferred step instantiates indexed local certificate families. -/ +example {P U V : Nat → ℝ[X]} {n : Nat} + (hsplits : ∀ k, (P (k + 1)).Splits) + (hdeg_two : ∀ k, 2 ≤ (P (k + 1)).natDegree) + (hrec : ∀ k, + P (k + 2) = U k * P (k + 1) + V k * (P (k + 1)).derivative) + (hpos : ∀ k, HasPosLeadingCoeff (P k)) + (hdeg_lo : ∀ k, (P (k + 1)).natDegree ≤ (P (k + 2)).natDegree) + (hdeg_hi : ∀ k, (P (k + 2)).natDegree ≤ (P (k + 1)).natDegree + 1) + (hcoeff : ∀ k r, (P (k + 1)).IsRoot r → (V k).eval r ≤ 0) : + Prec (P (n + 1)) + (U n * P (n + 1) + V n * (P (n + 1)).derivative) := by + rr_mw_derivative_nonpos_step using recurrence := hrec n + example {f u v : ℝ[X]} (hf : f.Splits) (hdegf : 2 ≤ f.natDegree) @@ -136,6 +177,48 @@ example {f u v : ℝ[X]} source_pos_lc := hf_pos, root_sign := hroot_sign +example {f u v g a b : ℝ[X]} + (_hg : g.Splits) + (_hdegg : 2 ≤ g.natDegree) + (_hdeg_g_lo : g.natDegree ≤ (a * g + b * g.derivative).natDegree) + (_hdeg_g_hi : (a * g + b * g.derivative).natDegree ≤ g.natDegree + 1) + (_hG_pos : HasPosLeadingCoeff (a * g + b * g.derivative)) + (_hg_pos : HasPosLeadingCoeff g) + (_hroot_sign_g : + ∀ r, g.IsRoot r → b.eval r * (g.derivative.eval r) ^ 2 < 0) + (hf : f.Splits) + (hdegf : 2 ≤ f.natDegree) + (hdeg_lo : f.natDegree ≤ (u * f + v * f.derivative).natDegree) + (hdeg_hi : (u * f + v * f.derivative).natDegree ≤ f.natDegree + 1) + (hF_pos : HasPosLeadingCoeff (u * f + v * f.derivative)) + (hf_pos : HasPosLeadingCoeff f) + (hroot_sign : + ∀ r, f.IsRoot r → v.eval r * (f.derivative.eval r) ^ 2 < 0) : + Prec f (u * f + v * f.derivative) := by + rr_ma_wang + +example {f u v : ℝ[X]} + (hf : f.Splits) + (hdegf : 2 ≤ f.natDegree) + (hdeg : (u * f + v * f.derivative).natDegree = f.natDegree) + (hF_pos : HasPosLeadingCoeff (u * f + v * f.derivative)) + (hf_pos : HasPosLeadingCoeff f) + (hroot_sign : + ∀ r, f.IsRoot r → v.eval r * (f.derivative.eval r) ^ 2 < 0) : + Prec f (u * f + v * f.derivative) := by + rr_ma_wang_same + +example {f u v : ℝ[X]} + (hf : f.Splits) + (hdegf : 2 ≤ f.natDegree) + (hdeg : (u * f + v * f.derivative).natDegree = f.natDegree + 1) + (hF_pos : HasPosLeadingCoeff (u * f + v * f.derivative)) + (hf_pos : HasPosLeadingCoeff f) + (hroot_sign : + ∀ r, f.IsRoot r → v.eval r * (f.derivative.eval r) ^ 2 < 0) : + Prec f (u * f + v * f.derivative) := by + rr_ma_wang_succ + example {f g a b : ℝ[X]} (hgf : Interlaces g f) (hg_pos : HasPosLeadingCoeff g) @@ -200,6 +283,59 @@ example {f u v : ℝ[X]} source_pos_lc := hf_pos, coeff_nonpos := hv_nonpos +/-- The bare derivative form selects indexed certificates for the displayed +target despite unrelated local families. -/ +example {P Q U V : Nat → ℝ[X]} {n : Nat} + (_hQ_splits : ∀ k, (Q k).Splits) + (hP_splits : ∀ k, (P k).Splits) + (hP_degree : ∀ k, 2 ≤ (P k).natDegree) + (hdeg_lo : ∀ k, + (P k).natDegree ≤ (U k * P k + V k * (P k).derivative).natDegree) + (hdeg_hi : ∀ k, + (U k * P k + V k * (P k).derivative).natDegree ≤ (P k).natDegree + 1) + (htarget_pos : ∀ k, + HasPosLeadingCoeff (U k * P k + V k * (P k).derivative)) + (hsource_pos : ∀ k, HasPosLeadingCoeff (P k)) + (hcoeff : ∀ k r, (P k).IsRoot r → (V k).eval r ≤ 0) : + Prec (P n) (U n * P n + V n * (P n).derivative) := by + rr_mw_derivative_nonpos + +/-- A successor-degree equality supplies both derivative-step degree bounds. -/ +example {f u v : ℝ[X]} + (hf : f.Splits) + (hdegf : 2 ≤ f.natDegree) + (hdeg : (u * f + v * f.derivative).natDegree = f.natDegree + 1) + (hF_pos : HasPosLeadingCoeff (u * f + v * f.derivative)) + (hf_pos : HasPosLeadingCoeff f) + (hv_nonpos : ∀ r, f.IsRoot r → v.eval r ≤ 0) : + Prec f (u * f + v * f.derivative) := by + rr_mw_derivative_nonpos using degree := hdeg + +/-- The generic bare form selects the displayed indexed interlacer despite an +unrelated local family. -/ +example {P G H A B : Nat → ℝ[X]} {n : Nat} + (_hdecoy : ∀ k, Interlaces (H k) (P k)) + (hinterlaces : ∀ k, Interlaces (G k) (P k)) + (hsource_pos : ∀ k, HasPosLeadingCoeff (G k)) + (hdeg_lo : ∀ k, + (P k).natDegree ≤ (A k * P k + B k * G k).natDegree) + (hdeg_hi : ∀ k, + (A k * P k + B k * G k).natDegree ≤ (P k).natDegree + 1) + (htarget_pos : ∀ k, HasPosLeadingCoeff (A k * P k + B k * G k)) + (hcoeff : ∀ k r, (P k).IsRoot r → (B k).eval r ≤ 0) : + Prec (P n) (A n * P n + B n * G n) := by + rr_prec_evalCoeff_nonpos + +/-- A same-degree equality supplies both generic evaluation-step bounds. -/ +example {f g a b : ℝ[X]} + (hgf : Interlaces g f) + (hg_pos : HasPosLeadingCoeff g) + (hdeg : (a * f + b * g).natDegree = f.natDegree) + (hF_pos : HasPosLeadingCoeff (a * f + b * g)) + (hb_nonpos : ∀ r, f.IsRoot r → b.eval r ≤ 0) : + Prec f (a * f + b * g) := by + rr_prec_evalCoeff_nonpos using degree := hdeg + /-- Scalar left denominators are normalized before the Ma--Wang wrapper. -/ example {d : ℝ} (hd : d ≠ 0) {F RHS : ℝ[X]} (hraw : C d * F = RHS) : @@ -648,6 +784,72 @@ example {P : Nat → ℝ[X]} {U V : Nat → ℝ[X]} degree_lower := hdeg_lo, degree_upper := hdeg_hi +section InferredWeakSequence + +variable {P : Nat → ℝ[X]} {U V : Nat → ℝ[X]} +variable (hbase : Prec (P 0) (P 1)) +variable (hpos : ∀ n : Nat, HasPosLeadingCoeff (P n)) +variable (hdeg_two : ∀ n : Nat, 2 ≤ (P (n + 1)).natDegree) +variable (hV : ∀ n : Nat, ∀ r, (P (n + 1)).IsRoot r → (V n).eval r ≤ 0) +variable (hrec : ∀ n : Nat, + P (n + 2) = U n * P (n + 1) + V n * (P (n + 1)).derivative) +variable (hdeg_lo : ∀ n : Nat, (P (n + 1)).natDegree ≤ (P (n + 2)).natDegree) +variable (hdeg_hi : ∀ n : Nat, + (P (n + 2)).natDegree ≤ (P (n + 1)).natDegree + 1) + +/-- A supplied recurrence fixes both hidden coefficient families before lookup. +The unmentioned section hypotheses are deliberately left for lookup. -/ +example : ∀ n : Nat, Prec (P n) (P (n + 1)) := by + rr_mw_derivative_nonpos_sequence using recurrence := hrec + +/-- The inferred real-rooted shell returns its full conjunction endpoint. -/ +example : ∀ n : Nat, P n ≠ 0 ∧ (P n).Splits := by + rr_mw_derivative_nonpos_sequence_realrooted using recurrence := hrec + +/-- The inferred real-rooted shell supports the splitting projection. -/ +example : ∀ n : Nat, (P n).Splits := by + rr_mw_derivative_nonpos_sequence_realrooted using recurrence := hrec + +/-- The inferred real-rooted shell supports the nonzero projection. -/ +example : ∀ n : Nat, P n ≠ 0 := by + rr_mw_derivative_nonpos_sequence_realrooted using recurrence := hrec + +/-- The inferred real-rooted shell supports an indexed splitting projection. -/ +example : (P 3).Splits := by + rr_mw_derivative_nonpos_sequence_realrooted using recurrence := hrec + +end InferredWeakSequence + +/-- Recurrence inference selects the coefficient family before indexed lookup. -/ +example {P : Nat → ℝ[X]} {U V W : Nat → ℝ[X]} + (_hW : ∀ n : Nat, ∀ r, (P (n + 1)).IsRoot r → (W n).eval r ≤ 0) + (hbase : Prec (P 0) (P 1)) + (hpos : ∀ n : Nat, HasPosLeadingCoeff (P n)) + (hdeg_two : ∀ n : Nat, 2 ≤ (P (n + 1)).natDegree) + (hV : ∀ k : Nat, ∀ r, (P (k + 1)).IsRoot r → (V k).eval r ≤ 0) + (hrec : ∀ n : Nat, + P (n + 2) = U n * P (n + 1) + V n * (P (n + 1)).derivative) + (hdeg_lo : ∀ n : Nat, (P (n + 1)).natDegree ≤ (P (n + 2)).natDegree) + (hdeg_hi : ∀ n : Nat, (P (n + 2)).natDegree ≤ (P (n + 1)).natDegree + 1) : + ∀ n : Nat, Prec (P n) (P (n + 1)) := by + rr_mw_derivative_nonpos_sequence using recurrence := hrec + +/-- An ascribed normalizer fixes the hidden families before its tactic runs. -/ +example {P : Nat → ℝ[X]} {U V : Nat → ℝ[X]} + (hbase : Prec (P 0) (P 1)) + (hpos : ∀ n : Nat, HasPosLeadingCoeff (P n)) + (hdeg_two : ∀ n : Nat, 2 ≤ (P (n + 1)).natDegree) + (hV : ∀ n : Nat, ∀ r, (P (n + 1)).IsRoot r → (V n).eval r ≤ 0) + (hraw : ∀ n : Nat, + P (n + 2) = V n * (P (n + 1)).derivative + U n * P (n + 1)) + (hdeg_lo : ∀ n : Nat, (P (n + 1)).natDegree ≤ (P (n + 2)).natDegree) + (hdeg_hi : ∀ n : Nat, (P (n + 2)).natDegree ≤ (P (n + 1)).natDegree + 1) : + ∀ n : Nat, Prec (P n) (P (n + 1)) := by + rr_mw_derivative_nonpos_sequence using recurrence := + (show ∀ n : Nat, + P (n + 2) = U n * P (n + 1) + V n * (P (n + 1)).derivative from + fun n => by simpa [add_comm] using hraw n) + /-- Family D shell: globally nonpositive negative-constant derivative term. -/ example {P : Nat → ℝ[X]} {U : Nat → ℝ[X]} {c : Nat → ℝ} (hbase : Prec (P 0) (P 1)) diff --git a/RealRooted/Tactic/Examples/Matrix.lean b/RealRooted/Tactic/Examples/Matrix.lean index 1ef6966c..4330b09b 100644 --- a/RealRooted/Tactic/Examples/Matrix.lean +++ b/RealRooted/Tactic/Examples/Matrix.lean @@ -24,7 +24,7 @@ example {n : ℕ} (hn : 0 < n) (G : List (List ℝ[X])) (fs : List ℝ[X]) (hfs_len : fs.length = n) (hfs : IsInterlacingSeqNonneg fs) : IsInterlacingSeqNonneg (matPolyAction G fs) := by - rr_matrix using hn, G, hG_rect, hG_nonneg, hG_affine, fs, hfs_len, hfs + rr_matrix example {n : ℕ} (hn : 0 < n) (G : List (List ℝ[X])) (fs : List ℝ[X]) (hG_rect : ∀ row ∈ G, row.length = n) @@ -62,7 +62,7 @@ example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hfs_len : fs.length = n) (hfs : IsInterlacingSeqNonneg fs) : IsInterlacingSeq0Nonneg (matPolyAction G fs) := by - rr_matrix0 using G, hG_rect, hG_nonneg, hG_affine, fs, hfs_len, hfs + rr_matrix0 example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hG_rect : ∀ row ∈ G, row.length = n) @@ -99,8 +99,7 @@ example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hfs_len : fs.length = n) (hfs : IsInterlacingSeqNonneg fs) : IsInterlacingSeqNonneg ((matPolyAction G fs).filter (· ≠ 0)) := by - rr_matrix0_filter_ne_zero using - G, hG_rect, hG_nonneg, hG_affine, fs, hfs_len, hfs + rr_matrix0_filter_ne_zero example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hG_rect : ∀ row ∈ G, row.length = n) @@ -138,7 +137,7 @@ example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hfs : IsInterlacingSeqNonneg fs) : IsInterlacingSeq0Nonneg (matPolyAction G fs) ∧ ∀ f ∈ matPolyAction G fs, f ≠ 0 → (f ≠ 0 ∧ f.Splits) := by - rr_matrix0_realrooted using G, hG_rect, hG_nonneg, hG_affine, fs, hfs_len, hfs + rr_matrix0_realrooted example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hG_rect : ∀ row ∈ G, row.length = n) @@ -178,8 +177,7 @@ example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hfs_real : ∀ f ∈ fs, f ≠ 0 → (f ≠ 0 ∧ f.Splits)) : IsInterlacingSeq0Nonneg (matPolyAction G fs) ∧ ∀ f ∈ matPolyAction G fs, f ≠ 0 → (f ≠ 0 ∧ f.Splits) := by - rr_matrix0_weak using - G, hG_rect, hG_nonneg, hG_affine, fs, hfs_len, hfs, hfs_real + rr_matrix0_weak example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hG_rect : ∀ row ∈ G, row.length = n) @@ -220,8 +218,7 @@ example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hfs : IsInterlacingSeq0Nonneg fs) (hfs_real : ∀ f ∈ fs, f ≠ 0 → (f ≠ 0 ∧ f.Splits)) : IsInterlacingSeqNonneg ((matPolyAction G fs).filter (· ≠ 0)) := by - rr_matrix0_filter_ne_zero_weak using - G, hG_rect, hG_nonneg, hG_affine, fs, hfs_len, hfs, hfs_real + rr_matrix0_filter_ne_zero_weak example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hG_rect : ∀ row ∈ G, row.length = n) @@ -283,8 +280,7 @@ example {n : ℕ} (hn : 0 < n) (G : List (List ℝ[X])) (fs : List ℝ[X]) (hfs_len : fs.length = n) (hfs : IsInterlacingSeqNonneg fs) : IsInterlacingSeqNonneg (matPolyAction G fs) := by - rr_row_threshold_matrix using - hn, G, hG_rect, hG_threshold, hG_affine, fs, hfs_len, hfs + rr_row_threshold_matrix example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hG_rect : ∀ row ∈ G, row.length = n) @@ -321,8 +317,7 @@ example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hfs_len : fs.length = n) (hfs : IsInterlacingSeqNonneg fs) : IsInterlacingSeq0Nonneg (matPolyAction G fs) := by - rr_row_threshold_matrix0 using - G, hG_rect, hG_threshold, hG_affine, fs, hfs_len, hfs + rr_row_threshold_matrix0 example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hG_rect : ∀ row ∈ G, row.length = n) @@ -364,8 +359,7 @@ example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hfs_real : ∀ f ∈ fs, f ≠ 0 → (f ≠ 0 ∧ f.Splits)) : IsInterlacingSeq0Nonneg (matPolyAction G fs) ∧ ∀ f ∈ matPolyAction G fs, f ≠ 0 → (f ≠ 0 ∧ f.Splits) := by - rr_row_threshold_matrix0_weak using - G, hG_rect, hG_threshold, hG_affine, fs, hfs_len, hfs, hfs_real + rr_row_threshold_matrix0_weak example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hG_rect : ∀ row ∈ G, row.length = n) @@ -405,8 +399,7 @@ example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hfs : IsInterlacingSeq0Nonneg fs) (hfs_real : ∀ f ∈ fs, f ≠ 0 → (f ≠ 0 ∧ f.Splits)) : IsInterlacingSeqNonneg ((matPolyAction G fs).filter (· ≠ 0)) := by - rr_row_threshold_matrix0_filter_ne_zero_weak using - G, hG_rect, hG_threshold, hG_affine, fs, hfs_len, hfs, hfs_real + rr_row_threshold_matrix0_filter_ne_zero_weak example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hG_rect : ∀ row ∈ G, row.length = n) @@ -445,8 +438,7 @@ example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hfs : IsInterlacingSeqNonneg fs) : IsInterlacingSeq0Nonneg (matPolyAction G fs) ∧ ∀ f ∈ matPolyAction G fs, f ≠ 0 → (f ≠ 0 ∧ f.Splits) := by - rr_row_threshold_matrix0_realrooted using - G, hG_rect, hG_threshold, hG_affine, fs, hfs_len, hfs + rr_row_threshold_matrix0_realrooted example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hG_rect : ∀ row ∈ G, row.length = n) @@ -483,8 +475,7 @@ example {n : ℕ} (G : List (List ℝ[X])) (fs : List ℝ[X]) (hfs_len : fs.length = n) (hfs : IsInterlacingSeqNonneg fs) : IsInterlacingSeqNonneg ((matPolyAction G fs).filter (· ≠ 0)) := by - rr_row_threshold_matrix0_filter_ne_zero using - G, hG_rect, hG_threshold, hG_affine, fs, hfs_len, hfs + rr_row_threshold_matrix0_filter_ne_zero example {G : List (List ℝ[X])} (hG_threshold : HasRowThresholdLinearStructure G) : @@ -494,7 +485,102 @@ example {G : List (List ℝ[X])} example {G : List (List ℝ[X])} (hG_threshold : HasRowThresholdLinearStructure G) : ∀ row ∈ G, ∀ p ∈ row, HasNonnegCoeffs p := by - rr_row_threshold_entry_nonneg using hG_threshold + rr_row_threshold_entry_nonneg + +namespace MatrixInferenceSmoke + +def baseMatrix : List (List ℝ[X]) := [] + +def decoyMatrix : List (List ℝ[X]) := [[]] + +theorem baseMatrix_rect : ∀ row ∈ baseMatrix, row.length = 0 := by + simp [baseMatrix] + +theorem decoyMatrix_rect : ∀ row ∈ decoyMatrix, row.length = 0 := by + simp [decoyMatrix] + +theorem baseMatrix_wrongWidth_rect (h : False) : + ∀ row ∈ baseMatrix, row.length = 1 := by + contradiction + +theorem baseMatrix_nonneg : + ∀ row ∈ baseMatrix, ∀ p ∈ row, HasNonnegCoeffs p := by + simp [baseMatrix] + +theorem decoyMatrix_nonneg : + ∀ row ∈ decoyMatrix, ∀ p ∈ row, HasNonnegCoeffs p := by + simp [decoyMatrix] + +def ZeroWidthTwoByTwo (G : List (List ℝ[X])) : Prop := + ∀ (i₁ i₂ : Fin G.length) (j₁ j₂ : Fin 0), + i₁ ≤ i₂ → j₁ ≤ j₂ → + Has2x2InterlacingProperty0 + ((G.get i₁).get ⟨j₁, by exact Fin.elim0 j₁⟩) + ((G.get i₁).get ⟨j₂, by exact Fin.elim0 j₂⟩) + ((G.get i₂).get ⟨j₁, by exact Fin.elim0 j₁⟩) + ((G.get i₂).get ⟨j₂, by exact Fin.elim0 j₂⟩) + +theorem zeroWidth_twoByTwo (G : List (List ℝ[X])) : + ZeroWidthTwoByTwo G := by + unfold ZeroWidthTwoByTwo + intro _ _ j₁ + exact Fin.elim0 j₁ + +theorem baseMatrix_twoByTwo : ZeroWidthTwoByTwo baseMatrix := + zeroWidth_twoByTwo baseMatrix + +theorem decoyMatrix_twoByTwo : ZeroWidthTwoByTwo decoyMatrix := + zeroWidth_twoByTwo decoyMatrix + +theorem baseMatrix_threshold : HasRowThresholdLinearStructure baseMatrix := by + simp [HasRowThresholdLinearStructure, baseMatrix] + +theorem decoyMatrix_threshold : + HasRowThresholdLinearStructure decoyMatrix := by + refine ⟨fun _ => 0, ?_, ?_⟩ + · intro i + fin_cases i + simp [HasRowThreshold, decoyMatrix] + · intro i j _ + simp + +attribute [rr_matrix_rect] + baseMatrix_wrongWidth_rect baseMatrix_rect decoyMatrix_rect +attribute [rr_matrix_nonneg] baseMatrix_nonneg decoyMatrix_nonneg +attribute [rr_matrix_2x2] baseMatrix_twoByTwo decoyMatrix_twoByTwo +attribute [rr_matrix_threshold] baseMatrix_threshold decoyMatrix_threshold + +example (hfs_len : ([] : List ℝ[X]).length = 0) + (hfs : IsInterlacingSeqNonneg ([] : List ℝ[X])) : + IsInterlacingSeq0Nonneg (matPolyAction baseMatrix []) := by + rr_matrix0 + +example (hfs_len : ([] : List ℝ[X]).length = 0) + (hfs : IsInterlacingSeqNonneg ([] : List ℝ[X])) : + IsInterlacingSeq0Nonneg (matPolyAction decoyMatrix []) := by + rr_matrix0 + +example (hfs_len : ([] : List ℝ[X]).length = 0) + (hfs : IsInterlacingSeqNonneg ([] : List ℝ[X])) : + IsInterlacingSeqNonneg ((matPolyAction decoyMatrix []).filter (· ≠ 0)) := by + rr_matrix0_filter_ne_zero + +example (hfs_len : ([] : List ℝ[X]).length = 0) + (hfs : IsInterlacingSeqNonneg ([] : List ℝ[X])) : + IsInterlacingSeq0Nonneg (matPolyAction baseMatrix []) := by + rr_row_threshold_matrix0 + +example (hfs_len : ([] : List ℝ[X]).length = 0) + (hfs : IsInterlacingSeq0Nonneg ([] : List ℝ[X])) + (hfs_real : ∀ f ∈ ([] : List ℝ[X]), f ≠ 0 → (f ≠ 0 ∧ f.Splits)) : + IsInterlacingSeq0Nonneg (matPolyAction baseMatrix []) ∧ + ∀ f ∈ matPolyAction baseMatrix [], f ≠ 0 → (f ≠ 0 ∧ f.Splits) := by + rr_matrix0_weak + +example : ∀ row ∈ baseMatrix, ∀ p ∈ row, HasNonnegCoeffs p := by + rr_row_threshold_entry_nonneg + +end MatrixInferenceSmoke end Tactic end RealRooted diff --git a/RealRooted/Tactic/Examples/Product.lean b/RealRooted/Tactic/Examples/Product.lean index 8dcf0b7f..fa842dc3 100644 --- a/RealRooted/Tactic/Examples/Product.lean +++ b/RealRooted/Tactic/Examples/Product.lean @@ -253,6 +253,26 @@ example {P F : Nat → ℝ[X]} factor_realrooted := hfactor, recurrence := hrec +/-- The recurrence fixes the family and factor; local certificates are inferred. -/ +example {P F Q G : Nat → ℝ[X]} + (_hdecoyBase : Q 0 ≠ 0 ∧ (Q 0).Splits) + (_hdecoyFactor : ∀ n : Nat, G n ≠ 0 ∧ (G n).Splits) + (hbase : P 0 ≠ 0 ∧ (P 0).Splits) + (hfactor : ∀ n : Nat, F n ≠ 0 ∧ (F n).Splits) + (hrec : ∀ n : Nat, P (n + 1) = F n * P n) : + ∀ n : Nat, P n ≠ 0 ∧ (P n).Splits := by + rr_product_factor_sequence using recurrence := hrec + +/-- Recurrence inference also detects right-factor orientation and projections. -/ +example {P F Q G : Nat → ℝ[X]} + (_hdecoyBase : Q 0 ≠ 0 ∧ (Q 0).Splits) + (_hdecoyFactor : ∀ n : Nat, G n ≠ 0 ∧ (G n).Splits) + (hbase : P 0 ≠ 0 ∧ (P 0).Splits) + (hfactor : ∀ n : Nat, F n ≠ 0 ∧ (F n).Splits) + (hrec : ∀ n : Nat, P (n + 1) = P n * F n) : + ∀ n : Nat, (P n).Splits := by + rr_product_factor_sequence using recurrence := hrec + /-- Lag-two product recurrences advance the even and odd subsequences together. -/ example {P F : Nat → ℝ[X]} (hbase_zero : P 0 ≠ 0 ∧ (P 0).Splits) @@ -275,6 +295,29 @@ example {P F : Nat → ℝ[X]} factor_realrooted := hfactor, recurrence := hrec +/-- Lag-two recurrence inference fixes both families and finds all certificates. -/ +example {P F Q G : Nat → ℝ[X]} + (_hdecoyZero : Q 0 ≠ 0 ∧ (Q 0).Splits) + (_hdecoyOne : P 2 ≠ 0 ∧ (P 2).Splits) + (_hdecoyFactor : ∀ n : Nat, G n ≠ 0 ∧ (G n).Splits) + (hbase_zero : P 0 ≠ 0 ∧ (P 0).Splits) + (hbase_one : P 1 ≠ 0 ∧ (P 1).Splits) + (hfactor : ∀ n : Nat, F n ≠ 0 ∧ (F n).Splits) + (hrec : ∀ n : Nat, P (n + 2) = F n * P n) : + ∀ n : Nat, P n = 0 ∨ (P n).Splits := by + rr_lag_product_factor_sequence using recurrence := hrec + +/-- Lag-two inference also detects right factors and indexed projections. -/ +example {P F Q G : Nat → ℝ[X]} + (_hdecoyZero : Q 0 ≠ 0 ∧ (Q 0).Splits) + (_hdecoyFactor : ∀ n : Nat, G n ≠ 0 ∧ (G n).Splits) + (hbase_zero : P 0 ≠ 0 ∧ (P 0).Splits) + (hbase_one : P 1 ≠ 0 ∧ (P 1).Splits) + (hfactor : ∀ n : Nat, F n ≠ 0 ∧ (F n).Splits) + (hrec : ∀ n : Nat, P (n + 2) = P n * F n) : + (P 4).Splits := by + rr_lag_product_factor_sequence using recurrence := hrec + /-- Lag-two product recurrences also accept the supplied factor on the right. -/ example {P F : Nat → ℝ[X]} (hbase_zero : P 0 ≠ 0 ∧ (P 0).Splits) @@ -314,6 +357,49 @@ example {P F : Nat → ℝ[X]} cutoff := N, recurrence := hrec +/-- Tail recurrence inference keeps the cutoff explicit and finds interval certificates. -/ +example {P F Q G : Nat → ℝ[X]} + (N : Nat) + (_hdecoyBase : ∀ n : Nat, n ≤ N → Q n ≠ 0 ∧ (Q n).Splits) + (_hdecoyFactor : ∀ n : Nat, N ≤ n → G n ≠ 0 ∧ (G n).Splits) + (hbase : ∀ n : Nat, n ≤ N → P n ≠ 0 ∧ (P n).Splits) + (hfactor : ∀ n : Nat, N ≤ n → F n ≠ 0 ∧ (F n).Splits) + (hrec : ∀ n : Nat, N ≤ n → P (n + 1) = F n * P n) : + ∀ n : Nat, P n ≠ 0 := by + rr_product_factor_sequence using cutoff := N, recurrence := hrec + +/-- Explicit tail cutoffs also accept right factors and indexed projections. -/ +example {P F : Nat → ℝ[X]} + (N : Nat) + (hbase : ∀ n : Nat, n ≤ N → P n ≠ 0 ∧ (P n).Splits) + (hfactor : ∀ n : Nat, N ≤ n → F n ≠ 0 ∧ (F n).Splits) + (hrec : ∀ n : Nat, N ≤ n → P (n + 1) = P n * F n) : + (P 3).Splits := by + rr_product_factor_sequence using cutoff := N, recurrence := hrec + +/-- The recurrence can determine a tail cutoff before certificate lookup. -/ +example {P F Q G : Nat → ℝ[X]} + (N : Nat) + (_hwrongCutoff : ∀ n : Nat, n ≤ N + 1 → P n ≠ 0 ∧ (P n).Splits) + (_hdecoyBase : ∀ n : Nat, n ≤ N → Q n ≠ 0 ∧ (Q n).Splits) + (_hdecoyFactor : ∀ n : Nat, N ≤ n → G n ≠ 0 ∧ (G n).Splits) + (hbase : ∀ n : Nat, n ≤ N → P n ≠ 0 ∧ (P n).Splits) + (hfactor : ∀ n : Nat, N ≤ n → F n ≠ 0 ∧ (F n).Splits) + (hrec : ∀ n : Nat, N ≤ n → P (n + 1) = F n * P n) : + ∀ n : Nat, P n = 0 ∨ (P n).Splits := by + rr_product_factor_sequence using recurrence := hrec + +/-- Inferred tail cutoffs also accept right factors and indexed projections. -/ +example {P F Q G : Nat → ℝ[X]} + (N : Nat) + (_hdecoyBase : ∀ n : Nat, n ≤ N → Q n ≠ 0 ∧ (Q n).Splits) + (_hdecoyFactor : ∀ n : Nat, N ≤ n → G n ≠ 0 ∧ (G n).Splits) + (hbase : ∀ n : Nat, n ≤ N → P n ≠ 0 ∧ (P n).Splits) + (hfactor : ∀ n : Nat, N ≤ n → F n ≠ 0 ∧ (F n).Splits) + (hrec : ∀ n : Nat, N ≤ n → P (n + 1) = P n * F n) : + (P 3).Splits := by + rr_product_factor_sequence using recurrence := hrec + /-- Direct finite-product formula route. -/ example {P : Nat → ℝ[X]} {root : Nat → Nat → ℝ} (hroot : ∀ n : Nat, diff --git a/RealRooted/Tactic/Examples/RecurrenceIdentification.lean b/RealRooted/Tactic/Examples/RecurrenceIdentification.lean index 4f88d0e0..fbde77b9 100644 --- a/RealRooted/Tactic/Examples/RecurrenceIdentification.lean +++ b/RealRooted/Tactic/Examples/RecurrenceIdentification.lean @@ -23,6 +23,14 @@ example {α : Sort*} {P Q : Nat → α} {upd : Nat → α → α} target_recurrence := hP, model_recurrence := hQ +example {α : Sort*} {P Q : Nat → α} {upd : Nat → α → α} + (hzero : P 0 = Q 0) + (hP : ∀ n : Nat, P (n + 1) = upd n (P n)) + (hQ : ∀ n : Nat, Q (n + 1) = upd n (Q n)) : + ∀ n : Nat, P n = Q n := by + rr_identify_lag_one_sequence using + update := upd + example {α : Sort*} {P Q : Nat → α} {upd : Nat → α → α → α} (hzero : P 0 = Q 0) (hone : P 1 = Q 1) @@ -36,6 +44,31 @@ example {α : Sort*} {P Q : Nat → α} {upd : Nat → α → α → α} target_recurrence := hP, model_recurrence := hQ +example {α : Sort*} {P Q : Nat → α} {upd : Nat → α → α → α} + (hzero : P 0 = Q 0) + (hone : P 1 = Q 1) + (hP : ∀ n : Nat, P (n + 2) = upd n (P (n + 1)) (P n)) + (hQ : ∀ n : Nat, Q (n + 2) = upd n (Q (n + 1)) (Q n)) : + ∀ n : Nat, P n = Q n := by + rr_identify_lag_two_sequence using + update := upd + +/-- Conclusion-first unification handles an active tail and a concrete update +at the same time. -/ +example {P Q : Nat → ℝ[X]} + (hzero : P 3 = Q 0) + (hone : P 4 = Q 1) + (hP : ∀ n : Nat, + P (n + 5) = + X * (C (1 : ℝ) * (P (n + 4)).derivative + C ((n : ℝ) + 4) * P (n + 3))) + (hQ : ∀ n : Nat, + Q (n + 2) = + X * (C (1 : ℝ) * (Q (n + 1)).derivative + C ((n : ℝ) + 4) * Q n)) : + ∀ n : Nat, P (n + 3) = Q n := by + rr_identify_lag_two_sequence using + update := fun n p q => + X * (C (1 : ℝ) * p.derivative + C ((n : ℝ) + 4) * q) + example {α : Sort*} {P Q : Nat → α} {upd : Nat → α → α → α → α} (hzero : P 0 = Q 0) (hone : P 1 = Q 1) @@ -53,6 +86,18 @@ example {α : Sort*} {P Q : Nat → α} {upd : Nat → α → α → α → α} target_recurrence := hP, model_recurrence := hQ +example {α : Sort*} {P Q : Nat → α} {upd : Nat → α → α → α → α} + (hzero : P 0 = Q 0) + (hone : P 1 = Q 1) + (htwo : P 2 = Q 2) + (hP : ∀ n : Nat, + P (n + 3) = upd n (P (n + 2)) (P (n + 1)) (P n)) + (hQ : ∀ n : Nat, + Q (n + 3) = upd n (Q (n + 2)) (Q (n + 1)) (Q n)) : + ∀ n : Nat, P n = Q n := by + rr_identify_lag_three_sequence using + update := upd + example {P Q : Nat → ℝ[X]} {upd : Nat → ℝ[X] → ℝ[X]} (hmodel : ∀ n : Nat, Q n ≠ 0 ∧ (Q n).Splits) (hzero : P 0 = Q 0) @@ -66,6 +111,16 @@ example {P Q : Nat → ℝ[X]} {upd : Nat → ℝ[X] → ℝ[X]} target_recurrence := hP, model_recurrence := hQ +example {P Q : Nat → ℝ[X]} {upd : Nat → ℝ[X] → ℝ[X]} + (hmodel : ∀ n : Nat, Q n ≠ 0 ∧ (Q n).Splits) + (hzero : P 0 = Q 0) + (hP : ∀ n : Nat, P (n + 1) = upd n (P n)) + (hQ : ∀ n : Nat, Q (n + 1) = upd n (Q n)) : + ∀ n : Nat, P n ≠ 0 ∧ (P n).Splits := by + rr_model_lag_one_sequence using + model_realrooted := hmodel, + update := upd + example {P Q : Nat → ℝ[X]} {upd : Nat → ℝ[X] → ℝ[X] → ℝ[X]} (hmodel : ∀ n : Nat, Q n ≠ 0 ∧ (Q n).Splits) (hzero : P 0 = Q 0) @@ -81,6 +136,33 @@ example {P Q : Nat → ℝ[X]} {upd : Nat → ℝ[X] → ℝ[X] → ℝ[X]} target_recurrence := hP, model_recurrence := hQ +example {P Q : Nat → ℝ[X]} {upd : Nat → ℝ[X] → ℝ[X] → ℝ[X]} + (hmodel : ∀ n : Nat, Q n ≠ 0 ∧ (Q n).Splits) + (hzero : P 0 = Q 0) + (hone : P 1 = Q 1) + (hP : ∀ n : Nat, P (n + 2) = upd n (P (n + 1)) (P n)) + (hQ : ∀ n : Nat, Q (n + 2) = upd n (Q (n + 1)) (Q n)) : + (P 5).Splits := by + rr_model_lag_two_sequence using + model_realrooted := hmodel, + update := upd + +example {P Q : Nat → ℝ[X]} + (hmodel : ∀ n : Nat, Q n ≠ 0 ∧ (Q n).Splits) + (hzero : P 3 = Q 0) + (hone : P 4 = Q 1) + (hP : ∀ n : Nat, + P (n + 5) = + X * (C (1 : ℝ) * (P (n + 4)).derivative + C ((n : ℝ) + 4) * P (n + 3))) + (hQ : ∀ n : Nat, + Q (n + 2) = + X * (C (1 : ℝ) * (Q (n + 1)).derivative + C ((n : ℝ) + 4) * Q n)) : + ∀ n : Nat, P (n + 3) ≠ 0 ∧ (P (n + 3)).Splits := by + rr_model_lag_two_sequence using + model_realrooted := hmodel, + update := fun n p q => + X * (C (1 : ℝ) * p.derivative + C ((n : ℝ) + 4) * q) + example {P Q : Nat → ℝ[X]} {upd : Nat → ℝ[X] → ℝ[X] → ℝ[X] → ℝ[X]} (hmodel : ∀ n : Nat, Q n ≠ 0 ∧ (Q n).Splits) @@ -101,6 +183,21 @@ example {P Q : Nat → ℝ[X]} target_recurrence := hP, model_recurrence := hQ +example {P Q : Nat → ℝ[X]} + {upd : Nat → ℝ[X] → ℝ[X] → ℝ[X] → ℝ[X]} + (hmodel : ∀ n : Nat, Q n ≠ 0 ∧ (Q n).Splits) + (hzero : P 0 = Q 0) + (hone : P 1 = Q 1) + (htwo : P 2 = Q 2) + (hP : ∀ n : Nat, + P (n + 3) = upd n (P (n + 2)) (P (n + 1)) (P n)) + (hQ : ∀ n : Nat, + Q (n + 3) = upd n (Q (n + 2)) (Q (n + 1)) (Q n)) : + ∀ n : Nat, P n ≠ 0 ∧ (P n).Splits := by + rr_model_lag_three_sequence using + model_realrooted := hmodel, + update := upd + example {P Q : Nat → ℝ[X]} (hmodel : ∀ n : Nat, Q n ≠ 0 ∧ (Q n).Splits) (hzero : P 0 = Q 0) @@ -116,5 +213,34 @@ example {P Q : Nat → ℝ[X]} target_recurrence := hP, model_recurrence := hQ +/-- A concrete update can be kept explicit while all local recurrence and +initial certificates are inferred. -/ +example {P Q : Nat → ℝ[X]} + (hmodel : ∀ n : Nat, Q n ≠ 0 ∧ (Q n).Splits) + (hzero : P 0 = Q 0) + (hP : ∀ n : Nat, + P (n + 1) = (X + C (n : ℝ)) * P n + (P n).derivative) + (hQ : ∀ n : Nat, + Q (n + 1) = (X + C (n : ℝ)) * Q n + (Q n).derivative) : + ∀ n : Nat, (P n).Splits := by + rr_model_lag_one_sequence using + model_realrooted := hmodel, + update := fun n p => (X + C (n : ℝ)) * p + p.derivative + +/-- The inferred form refuses to invent a missing initial equality. -/ +example {P Q : Nat → ℝ[X]} + (_hmodel : ∀ n : Nat, Q n ≠ 0 ∧ (Q n).Splits) + (_hP : ∀ n : Nat, + P (n + 1) = (X + C (n : ℝ)) * P n + (P n).derivative) + (_hQ : ∀ n : Nat, + Q (n + 1) = (X + C (n : ℝ)) * Q n + (Q n).derivative) + (hgoal : ∀ n : Nat, (P n).Splits) : + ∀ n : Nat, (P n).Splits := by + fail_if_success + rr_model_lag_one_sequence using + model_realrooted := _hmodel, + update := fun n p => (X + C (n : ℝ)) * p + p.derivative + exact hgoal + end Tactic end RealRooted diff --git a/RealRooted/Tactic/Examples/RootCount.lean b/RealRooted/Tactic/Examples/RootCount.lean index 53b86fd0..9d557731 100644 --- a/RealRooted/Tactic/Examples/RootCount.lean +++ b/RealRooted/Tactic/Examples/RootCount.lean @@ -1950,5 +1950,70 @@ example {F G : Nat → ℝ[X]} no_common_roots := hno, left_degree_le_three := hFdeg +section ZeroParameterEndpoint + +section Scalar + +variable {f g : ℝ[X]} {x μ : ℝ} +variable (hμ_pos : 0 < μ) +variable (hdeg : ∀ η ∈ Set.Icc (0 : ℝ) μ, + (f + C η * g).natDegree = (f + C (0 : ℝ) * g).natDegree) +variable (_hsplit_prefix : ∀ _ν : ℝ, ∀ η ∈ Set.Icc (0 : ℝ) μ, + (f + C η * g).Splits) +variable (hsplit : ∀ η ∈ Set.Icc (0 : ℝ) μ, (f + C η * g).Splits) +variable (hne : ∀ η ∈ Set.Icc (0 : ℝ) μ, ¬ (f + C η * g).IsRoot x) + +/-- The named form exposes all four zero-endpoint transport certificates. -/ +example : + ((f + C μ * g).roots.filter (x < ·)).card = + (f.roots.filter (x < ·)).card := by + rr_rightFamily_card_roots_gt_eq_zero_param using + parameter_pos := hμ_pos, + degree_on_interval := hdeg, + splits_on_interval := hsplit, + threshold_not_root := hne + +/-- Lookup rejects a split certificate whose extra prefix remains unresolved. -/ +example : + ((f + C μ * g).roots.filter (x < ·)).card = + (f.roots.filter (x < ·)).card := by + rr_rightFamily_card_roots_gt_eq_zero_param + +end Scalar + +section Sequence + +variable {F G : Nat → ℝ[X]} {x μ : Nat → ℝ} +variable (hμ_pos : ∀ i : Nat, 0 < μ i) +variable (hdeg : ∀ i : Nat, ∀ η ∈ Set.Icc (0 : ℝ) (μ i), + (F i + C η * G i).natDegree = + (F i + C (0 : ℝ) * G i).natDegree) +variable (_hsplit_prefix : ∀ _ν : ℝ, ∀ i : Nat, + ∀ η ∈ Set.Icc (0 : ℝ) (μ i), (F i + C η * G i).Splits) +variable (hsplit : ∀ i : Nat, ∀ η ∈ Set.Icc (0 : ℝ) (μ i), + (F i + C η * G i).Splits) +variable (hne : ∀ i : Nat, ∀ η ∈ Set.Icc (0 : ℝ) (μ i), + ¬ (F i + C η * G i).IsRoot (x i)) + +/-- The sequence form applies the proved zero-endpoint equality pointwise. -/ +example : ∀ i : Nat, + ((F i + C (μ i) * G i).roots.filter (x i < ·)).card = + ((F i).roots.filter (x i < ·)).card := by + rr_rightFamily_card_roots_gt_eq_zero_param_sequence using + parameter_pos := hμ_pos, + degree_on_interval := hdeg, + splits_on_interval := hsplit, + threshold_not_root := hne + +/-- Sequence inference resolves complete pointwise certificate families. -/ +example : ∀ i : Nat, + ((F i + C (μ i) * G i).roots.filter (x i < ·)).card = + ((F i).roots.filter (x i < ·)).card := by + rr_rightFamily_card_roots_gt_eq_zero_param_sequence + +end Sequence + +end ZeroParameterEndpoint + end Tactic end RealRooted diff --git a/RealRooted/Tactic/Examples/Wagner.lean b/RealRooted/Tactic/Examples/Wagner.lean index 020313da..b64b7d7a 100644 --- a/RealRooted/Tactic/Examples/Wagner.lean +++ b/RealRooted/Tactic/Examples/Wagner.lean @@ -79,5 +79,40 @@ example {F G : Nat → ℝ[X]} longer := hG, degree := hdeg +example {f g h : ℝ[X]} (hfh : Prec f h) (hgh : Prec g h) + (hf_pos : HasPosLeadingCoeff f) (hg_pos : HasPosLeadingCoeff g) : + Prec (f + g) h := by + rr_wagner_common_right_add_pos_lc using + left_interlaces_common := hfh, + right_interlaces_common := hgh, + left_pos_lc := hf_pos, + right_pos_lc := hg_pos + +example {f g h : ℝ[X]} (hfh : Prec f h) (hgh : Prec g h) + (hf_pos : HasPosLeadingCoeff f) (hg_pos : HasPosLeadingCoeff g) : + Prec (f + g) h := by + rr_wagner_common_right_add_pos_lc + +example {f g : ℝ[X]} (r : ℝ) + (h : Prec ((X - C r) * f) ((X - C r) * g)) : Prec f g := by + rr_prec_cancel_common_linear_factor using + root := r, + multiplied_interlacing := h + +example {f g : ℝ[X]} (r : ℝ) + (h : Prec ((X - C r) * f) ((X - C r) * g)) : Prec f g := by + rr_prec_cancel_common_linear_factor using root := r + +example {d f g : ℝ[X]} (hd_ne : d ≠ 0) (hd_splits : d.Splits) + (h : Prec f g) : Prec (d * f) (d * g) := by + rr_prec_mul_common_factor using + factor_nonzero := hd_ne, + factor_splits := hd_splits, + base_interlacing := h + +example {d f g : ℝ[X]} (hd_ne : d ≠ 0) (hd_splits : d.Splits) + (h : Prec f g) : Prec (d * f) (d * g) := by + rr_prec_mul_common_factor + end Tactic end RealRooted diff --git a/RealRooted/Tactic/Examples/WagnerX.lean b/RealRooted/Tactic/Examples/WagnerX.lean index 3828f4a7..a77d65a5 100644 --- a/RealRooted/Tactic/Examples/WagnerX.lean +++ b/RealRooted/Tactic/Examples/WagnerX.lean @@ -36,6 +36,13 @@ example {f g : ℝ[X]} left_nonneg := hfnn, right_nonneg := hgnn +example {f g : ℝ[X]} + (hfg : Prec f g) + (hfnn : HasNonnegCoeffs f) + (hgnn : HasNonnegCoeffs g) : + Prec g (X * f) := by + rr_prec_mul_X + /-- Narayana/singleton-free-set-partition style common `X` factor: nonnegative coefficients discharge the root-nonpositive side conditions. -/ example {f g : ℝ[X]} @@ -48,6 +55,13 @@ example {f g : ℝ[X]} left_nonneg := hfnn, right_nonneg := hgnn +example {f g : ℝ[X]} + (hfg : Prec f g) + (hfnn : HasNonnegCoeffs f) + (hgnn : HasNonnegCoeffs g) : + Prec (X * f) (X * g) := by + rr_prec_mul_X_both + example {f g : ℝ[X]} {c : ℝ} (hfg : Prec f g) (hfnn : HasNonnegCoeffs f) @@ -60,6 +74,14 @@ example {f g : ℝ[X]} {c : ℝ} right_nonneg := hgnn, coeff_ne := hc +example {f g : ℝ[X]} {c : ℝ} + (hfg : Prec f g) + (hfnn : HasNonnegCoeffs f) + (hgnn : HasNonnegCoeffs g) + (hc : c ≠ 0) : + Prec g ((C c * X) * f) := by + rr_prec_C_mul_X using coeff_ne := hc + example {f g : ℝ[X]} {c : ℝ} (hfg : Prec f g) (hfnn : HasNonnegCoeffs f) @@ -72,6 +94,14 @@ example {f g : ℝ[X]} {c : ℝ} right_nonneg := hgnn, coeff_pos := hc +example {f g : ℝ[X]} {c : ℝ} + (hfg : Prec f g) + (hfnn : HasNonnegCoeffs f) + (hgnn : HasNonnegCoeffs g) + (hc : 0 < c) : + Prec g ((C c * X) * f) := by + rr_prec_C_mul_X using coeff_pos := hc + /-- Derivative-lag bridge: a nonnegative real-rooted row gives `X * P'_n ≪ X * P_n`. -/ example {f : ℝ[X]} @@ -84,6 +114,29 @@ example {f : ℝ[X]} degree_two := hdeg, nonneg_coeffs := hfnn +example {f : ℝ[X]} + (hf : f.Splits) + (hdeg : 2 ≤ f.natDegree) + (hfnn : HasNonnegCoeffs f) : + Prec (X * f.derivative) (X * f) := by + rr_prec_X_derivative_X_self + +namespace WagnerXInferenceSmoke + +@[rr_base_prec] theorem one_prec_one : Prec (1 : ℝ[X]) 1 := + prec_refl (by simp) (by simp) + +@[rr_nonneg] theorem one_nonneg : HasNonnegCoeffs (1 : ℝ[X]) := + hasNonnegCoeffs_one + +@[rr_nonneg] theorem zero_nonneg : HasNonnegCoeffs (0 : ℝ[X]) := + hasNonnegCoeffs_zero + +example : Prec (1 : ℝ[X]) (X * 1) := by + rr_prec_mul_X + +end WagnerXInferenceSmoke + /-- Plateau sequence bridge: from the adjacent `Prec` invariant on `P_n,P_{n+1}`, the Wagner `X`-shift gives the positive-lag target `P_{n+1} ≪ X P_n` without requiring a differ-by-one `Interlaces` certificate. -/ @@ -96,6 +149,12 @@ example {P : Nat → ℝ[X]} {n : Nat} left_nonneg := hnonneg n, right_nonneg := hnonneg (n + 1) +example {P : Nat → ℝ[X]} {n : Nat} + (hprev : Prec (P n) (P (n + 1))) + (hnonneg : ∀ k : Nat, HasNonnegCoeffs (P k)) : + Prec (P (n + 1)) (X * P n) := by + rr_prec_mul_X + /-- OEIS-style scalar positive-lag bridge for recurrences with `c_n t P_{n-2}`. -/ example {P : Nat → ℝ[X]} {c : Nat → ℝ} {n : Nat} @@ -324,6 +383,53 @@ example {f g : ℝ[X]} {a c : ℝ} lag_coeff_pos := ha, derivative_coeff_pos := hc +/-- The same step can infer all certificates once the displayed target fixes +the two polynomials and both scalar coefficients. -/ +example {f g : ℝ[X]} {a c : ℝ} + (hfg : Prec f g) + (hfnn : HasNonnegCoeffs f) + (hgnn : HasNonnegCoeffs g) + (hdeg : 2 ≤ g.natDegree) + (ha : 0 < a) + (hc : 0 < c) : + Prec g (X * (C c * g.derivative + C a * f)) := by + rr_prec_wagner_derivative_gap_lag + +/-- Indexed local families supply the active step without pointwise aliases. -/ +example {P : Nat → ℝ[X]} {a c : Nat → ℝ} {n : Nat} + (hprev : Prec (P n) (P (n + 1))) + (hnonneg : ∀ k : Nat, HasNonnegCoeffs (P k)) + (hdeg : ∀ k : Nat, 2 ≤ (P (k + 1)).natDegree) + (ha : ∀ k : Nat, 0 < a k) + (hc : ∀ k : Nat, 0 < c k) : + Prec (P (n + 1)) + (X * (C (c n) * (P (n + 1)).derivative + C (a n) * P n)) := by + rr_prec_wagner_derivative_gap_lag + +/-- Shifted families may instantiate offset certificate families and mix +indexed with arithmetic scalar bounds. -/ +example {P : Nat → ℝ[X]} {a : Nat → ℝ} {n : Nat} + (hchain : ∀ k : Nat, Prec (P k) (P (k + 1))) + (hnonneg : ∀ k : Nat, HasNonnegCoeffs (P k)) + (hdeg : ∀ k : Nat, 2 ≤ (P (k + 1)).natDegree) + (ha : ∀ k : Nat, 0 < a k) : + Prec (P (n + 4)) + (X * (C ((n : ℝ) + 4) * (P (n + 4)).derivative + + C (a (n + 3)) * P (n + 3))) := by + rr_prec_wagner_derivative_gap_lag + +/-- A recurrence rewrite exposes the rigid target consumed by the bare step. -/ +example {P : Nat → ℝ[X]} {n : Nat} + (hprev : Prec (P n) (P (n + 1))) + (hnonneg : ∀ k : Nat, HasNonnegCoeffs (P k)) + (hdeg : ∀ k : Nat, 2 ≤ (P (k + 1)).natDegree) + (hrec : ∀ k : Nat, + P (k + 2) = X * (C (1 : ℝ) * (P (k + 1)).derivative + + C ((k : ℝ) + 1) * P k)) : + Prec (P (n + 1)) (P (n + 2)) := by + rw [hrec n] + rr_prec_wagner_derivative_gap_lag + /-- Scalar-left single-step wrapper for unnormalized recurrence certificates. -/ example {f g p : ℝ[X]} {a c d : ℝ} (hfg : Prec f g) diff --git a/RealRooted/Tactic/Favard.lean b/RealRooted/Tactic/Favard.lean index 779fde95..8c9fd817 100644 --- a/RealRooted/Tactic/Favard.lean +++ b/RealRooted/Tactic/Favard.lean @@ -11,13 +11,20 @@ open Polynomial The tactic ```lean +rr_favard rr_favard using hrec, hbeta +rr_favard_auto ``` applies the already-formalized Favard interface to goals that match `favardInterlacing`, `isRealRooted_of_favard`, or `isGeneralizedSturmSeq_reverse_range_map_of_favard`. +The bare forms infer exact local recurrence and positivity hypotheses. Use an +explicit `using` form when more than one Favard certificate packet is in scope. +`rr_favard_affine_param_infer` keeps the coefficient families and recurrence +explicit while inferring positivity, base certificates, and the standard or +row-sign orientation. First intended regression examples: @@ -1081,6 +1088,10 @@ syntax (name := rr_favard_base_one) "rr_favard_base_one " term : term syntax (name := rr_favard_base_one_dsimp) "rr_favard_base_one_dsimp " term : term +syntax (name := rr_favard_base_lookup_term) "rr_favard_base_lookup_term" : term + +syntax (name := rr_favard_positive_lookup_term) "rr_favard_positive_lookup_term" : term + macro_rules | `(rr_favard_step_seq $hstep:term) => `(fun n => by simpa using $hstep n) @@ -1109,8 +1120,20 @@ macro_rules | (dsimp; simp) | (simp; ring_nf) | simp)) + | `(rr_favard_base_lookup_term) => + `(by + first + | rr_lookup + | ((first | dsimp | skip); (first | simp | skip); rr_lookup)) + | `(rr_favard_positive_lookup_term) => + `(by + first + | rr_lookup + | rr_positivity_seq) syntax (name := rr_favard) "rr_favard" " using " term ", " term : tactic +syntax (name := rr_favard_inferred) "rr_favard" : tactic + syntax (name := rr_favard_named) "rr_favard" " using " "recurrence" ":=" term "," @@ -1122,6 +1145,8 @@ syntax (name := rr_favard_auto_named) "recurrence" ":=" term : tactic +syntax (name := rr_favard_auto_inferred) "rr_favard_auto" : tactic + syntax (name := rr_favard_const) "rr_favard_const" " using " term ", " term ", " term ", " term ", " term ", " term : tactic @@ -1294,6 +1319,14 @@ syntax (name := rr_favard_affine_param_auto_named) "step" ":=" term : tactic +syntax (name := rr_favard_affine_param_infer_named) + "rr_favard_affine_param_infer" " using " + "slope" ":=" term "," + "alpha" ":=" term "," + "beta" ":=" term "," + "step" ":=" term : + tactic + syntax (name := rr_favard_affine_param_den_named) "rr_favard_affine_param_den" " using " "slope" ":=" term "," @@ -2167,6 +2200,15 @@ syntax (name := rr_favard_exact_realrooted_positivity_seq) tactic macro_rules + | `(tactic| rr_favard) => + `(tactic| + rr_favard using + recurrence := (by assumption), + beta_pos := (by assumption)) + | `(tactic| rr_favard_auto) => + `(tactic| + rr_favard_auto using + recurrence := (by assumption)) | `(tactic| rr_favard_refine_positivity_seq $h:term) => `(tactic| rr_refine_then $h with rr_positivity_seq) | `(tactic| rr_favard_exact_realrooted_positivity_seq $h:term) => @@ -2510,6 +2552,32 @@ macro_rules base_zero := $hP0, base_one := $hP1, step := $hstep) + | `(tactic| + rr_favard_affine_param_infer using + slope := $s:term, + alpha := $α:term, + beta := $β:term, + step := $hstep:term) => + `(tactic| + first + | rr_favard_affine_param using + slope := $s, + alpha := $α, + beta := $β, + slope_pos := rr_favard_positive_lookup_term, + beta_pos := rr_favard_positive_lookup_term, + base_zero := rr_favard_base_lookup_term, + base_one := rr_favard_base_lookup_term, + step := rr_favard_step_dsimp_seq $hstep + | rr_favard_affine_param_row_sign using + slope := $s, + alpha := $α, + beta := $β, + slope_pos := rr_favard_positive_lookup_term, + beta_pos := rr_favard_positive_lookup_term, + base_zero := rr_favard_base_lookup_term, + base_one := rr_favard_base_lookup_term, + step := rr_favard_step_dsimp_seq $hstep) | `(tactic| rr_favard_affine_param using $s:term, $α:term, $β:term, $hs:term, $hβ:term, $hP0:term, $hP1:term, diff --git a/RealRooted/Tactic/FiniteSymbol.lean b/RealRooted/Tactic/FiniteSymbol.lean index ce424cc4..c11e52ba 100644 --- a/RealRooted/Tactic/FiniteSymbol.lean +++ b/RealRooted/Tactic/FiniteSymbol.lean @@ -3,8 +3,8 @@ import RealRooted.BorceaBranden.FiniteSymbolPreserver /-! # Finite-symbol stable-or-zero tactic frontend -Thin certificate-driven wrappers around the proved multiaffine finite-symbol -stability theorem. +Thin explicit and automatic wrappers around the proved multiaffine +finite-symbol stability theorem. -/ namespace RealRooted @@ -24,6 +24,9 @@ syntax (name := rr_finite_symbol_stable_or_zero_inferred) "input_stable" ":=" term : tactic +syntax (name := rr_finite_symbol_stable_or_zero_auto) + "rr_finite_symbol_stable_or_zero_auto" : tactic + macro_rules | `(tactic| rr_finite_symbol_stable_or_zero using @@ -41,6 +44,11 @@ macro_rules `(tactic| exact RealRooted.BorceaBranden.finiteSymbol_preserves_stability _ $hSymbol _ $hf) + | `(tactic| rr_finite_symbol_stable_or_zero_auto) => + `(tactic| + rr_finite_symbol_stable_or_zero using + symbol_stable := (by assumption), + input_stable := (by assumption)) end Tactic end RealRooted diff --git a/RealRooted/Tactic/FiniteSymbolPF.lean b/RealRooted/Tactic/FiniteSymbolPF.lean index 57623c5b..3227a5e9 100644 --- a/RealRooted/Tactic/FiniteSymbolPF.lean +++ b/RealRooted/Tactic/FiniteSymbolPF.lean @@ -345,7 +345,15 @@ theorem finiteSymbol_congr_of_eq_on_degree /-! ## Classical interfaces -/ -/-- Finite-degree Borcea-Branden preserver theorem, kept as a named interface. -/ +/-- Legacy homogeneous finite-symbol interface. + +This is not the affine algebraic-symbol theorem of Borcea--Branden, +Theorem 1.2(b), whose symbol is `T((z + w)^d)`; the complex counterpart is +Theorem 1.1(b). In fact, this proposition is false: for +`d = 1`, `alpha = [1, 0]`, and `beta = [2, 1]`, the homogeneous symbol is +`(X + Y)^2`, but the operator sends `1 + 2 * X` to +`1 + 2 * X + 2 * X^2`, which is not real-rooted. See issue #314. New proofs +must use the genuine affine symbol and must not assume this interface. -/ def finiteSymbolBBStatement : Prop := ∀ {alpha beta : ℕ → ℝ} {d : ℕ}, IsBivariateUpperStable (complexifyMv (finiteSymbol alpha beta d)) → diff --git a/RealRooted/Tactic/Hadamard.lean b/RealRooted/Tactic/Hadamard.lean index 63265c8d..d6f19ade 100644 --- a/RealRooted/Tactic/Hadamard.lean +++ b/RealRooted/Tactic/Hadamard.lean @@ -482,6 +482,9 @@ syntax (name := rr_hadamard_prec0_named) "second_prec" ":=" term : tactic +syntax (name := rr_hadamard_pf_prec0_named) + "rr_hadamard_pf_prec0" : tactic + syntax (name := rr_hadamard_sequence_pf_named) "rr_hadamard_sequence_pf" " using " "left_pf" ":=" term "," @@ -802,6 +805,18 @@ macro_rules `(tactic| exact RealRooted.Tactic.hadamardProduct_prec0_of_nonneg_prec $hf $hg $hp $hq $hfg $hpq) + | `(tactic| rr_hadamard_pf_prec0) => + `(tactic| + first + | exact RealRooted.hadamardProduct_preserves_prec0_right + RealRooted.garloffWagnerHadamardPFPrec0_of_nonnegPrec + rr_lookup_term rr_lookup_term rr_lookup_term rr_lookup_term + | exact RealRooted.hadamardProduct_preserves_prec0_left + RealRooted.garloffWagnerHadamardPFPrec0_of_nonnegPrec + rr_lookup_term rr_lookup_term rr_lookup_term rr_lookup_term + | exact RealRooted.garloffWagnerHadamardPFPrec0_of_nonnegPrec + rr_lookup_term rr_lookup_term rr_lookup_term rr_lookup_term + rr_lookup_term rr_lookup_term) | `(tactic| rr_hadamard_sequence_pf using left_pf := $hp:term, diff --git a/RealRooted/Tactic/LiuWang.lean b/RealRooted/Tactic/LiuWang.lean index 3c434dd3..eea45fdb 100644 --- a/RealRooted/Tactic/LiuWang.lean +++ b/RealRooted/Tactic/LiuWang.lean @@ -14,6 +14,23 @@ rr_liu_wang rr_liu_wang_strict ``` +For whole sequences whose coefficient families are hidden from the goal, use + +```lean +rr_lw_nonpos_lag_sequence using recurrence := hrec +rr_lw_nonpos_lag_sequence_realrooted using recurrence := hrec +rr_lw_tR_lag_sequence using recurrence := hrec +rr_lw_tR_lag_sequence_realrooted using recurrence := hrec +``` + +The goal fixes the polynomial family and the recurrence then fixes the hidden +coefficient families before lookup obtains the remaining certificates. Lookup +expects those families in the theorem's literal shapes; use an explicit form +when a certificate first needs reshaping. In particular, keep the displayed +`(X * R n) * P n` association literal for the `tR` forms, or give a nested +normalizer an explicit expected type. The real-rooted forms close the full +conjunction as well as splitting, nonzero, and indexed projections. + Primary target: finite weighted sums where one or more previous polynomials interlace a common base polynomial, and the coefficient polynomials have the required sign at @@ -2806,6 +2823,9 @@ syntax (name := rr_lw_nonpos_lag_sequence_named) "no_common_roots" ":=" term : tactic +syntax (name := rr_lw_nonpos_lag_sequence_inferred_of_recurrence) + "rr_lw_nonpos_lag_sequence" " using " "recurrence" ":=" term : tactic + syntax (name := rr_lw_nonpos_lag_sequence_realrooted_named) "rr_lw_nonpos_lag_sequence_realrooted" " using " "base" ":=" term "," @@ -2816,6 +2836,9 @@ syntax (name := rr_lw_nonpos_lag_sequence_realrooted_named) "no_common_roots" ":=" term : tactic +syntax (name := rr_lw_nonpos_lag_sequence_realrooted_inferred_of_recurrence) + "rr_lw_nonpos_lag_sequence_realrooted" " using " "recurrence" ":=" term : tactic + syntax (name := rr_lw_global_nonpos_sequence_auto_named) "rr_lw_global_nonpos_sequence_auto" " using " "base" ":=" term "," @@ -4407,6 +4430,9 @@ syntax (name := rr_lw_tR_lag_sequence_named) "no_common_roots" ":=" term : tactic +syntax (name := rr_lw_tR_lag_sequence_inferred_of_recurrence) + "rr_lw_tR_lag_sequence" " using " "recurrence" ":=" term : tactic + syntax (name := rr_lw_tR_lag_sequence_realrooted_named) "rr_lw_tR_lag_sequence_realrooted" " using " "base" ":=" term "," @@ -4418,6 +4444,9 @@ syntax (name := rr_lw_tR_lag_sequence_realrooted_named) "no_common_roots" ":=" term : tactic +syntax (name := rr_lw_tR_lag_sequence_realrooted_inferred_of_recurrence) + "rr_lw_tR_lag_sequence_realrooted" " using " "recurrence" ":=" term : tactic + syntax (name := rr_lw_c_tR_lag_sequence_named) "rr_lw_c_tR_lag_sequence" " using " "base" ":=" term "," @@ -5388,6 +5417,12 @@ macro_rules `(tactic| exact RealRooted.prec_lw_nonpos_lag_sequence $hbase $hpos $hB $hrec $hdeg_succ $hno) + | `(tactic| rr_lw_nonpos_lag_sequence using recurrence := $hrec:term) => + `(tactic| + rr_refine_then + (RealRooted.prec_lw_nonpos_lag_sequence + ?_ ?_ ?_ $hrec ?_ ?_) + with rr_lookup) | `(tactic| rr_lw_nonpos_lag_sequence_realrooted using base := $hbase:term, @@ -5400,6 +5435,13 @@ macro_rules rr_exact_realrooted_sequence_or_projection (RealRooted.isRealRooted_of_lw_nonpos_lag_sequence $hbase $hpos $hB $hrec $hdeg_succ $hno)) + | `(tactic| + rr_lw_nonpos_lag_sequence_realrooted using recurrence := $hrec:term) => + `(tactic| + rr_exact_realrooted_refine_then + (RealRooted.isRealRooted_of_lw_nonpos_lag_sequence + ?_ ?_ ?_ $hrec ?_ ?_) + with rr_lookup) | `(tactic| rr_lw_global_nonpos_sequence_auto using base := $hbase:term, @@ -7975,6 +8017,12 @@ macro_rules recurrence := $hrec, degree_succ := $hdeg_succ, no_common_roots := $hno) + | `(tactic| rr_lw_tR_lag_sequence using recurrence := $hrec:term) => + `(tactic| + rr_refine_then + (RealRooted.prec_lw_tR_lag_sequence + ?_ ?_ ?_ ?_ $hrec ?_ ?_) + with rr_lookup) | `(tactic| rr_lw_tR_lag_sequence_realrooted using base := $hbase:term, @@ -7993,6 +8041,13 @@ macro_rules recurrence := $hrec, degree_succ := $hdeg_succ, no_common_roots := $hno) + | `(tactic| + rr_lw_tR_lag_sequence_realrooted using recurrence := $hrec:term) => + `(tactic| + rr_exact_realrooted_refine_then + (RealRooted.isRealRooted_of_lw_tR_lag_sequence + ?_ ?_ ?_ ?_ $hrec ?_ ?_) + with rr_lookup) | `(tactic| rr_lw_c_tR_lag_sequence using base := $hbase:term, diff --git a/RealRooted/Tactic/Lookup.lean b/RealRooted/Tactic/Lookup.lean index d2725398..1666b746 100644 --- a/RealRooted/Tactic/Lookup.lean +++ b/RealRooted/Tactic/Lookup.lean @@ -9,9 +9,14 @@ Minimal exact lookup for RealRooted certificate tactics. The lookup order is intentionally conservative: 1. exact local hypotheses; -2. uniquely matching declarations tagged with one of the `rr_*` certificate +2. local hypotheses with a fully determined `forall` prefix; +3. uniquely matching declarations tagged with one of the `rr_*` certificate attributes. +Both `rr_lookup` and `rr_lookup [attr]` run the first two steps over the whole +local context; `[attr]` restricts only the third step. A local match therefore +takes precedence over tagged-certificate ambiguity. + If no certificate is found, or if several tagged declarations match, the tactic fails with a short diagnostic. -/ @@ -29,24 +34,56 @@ private def namesString (names : Array Name) : String := else String.intercalate ", " (names.toList.map toString) +private def instantiateCertificateProof? (proof : Expr) : TacticM (Option Expr) := do + let proof ← instantiateMVars proof + return if proof.hasMVar then none else some proof + +private partial def mkProofFromPrefixFor? (proof proofType target : Expr) + (args : Array Expr) (binderInfos : Array BinderInfo) : + TacticM (Option Expr) := do + if ← isDefEq proofType target then + synthAppInstances `rr_lookup (← getMainGoal) args binderInfos + (synthAssignedInstances := false) (allowSynthFailures := true) + if let some proof ← instantiateCertificateProof? (mkAppN proof args) then + return some proof + let (newArgs, newBinderInfos, conclusion) ← + forallMetaBoundedTelescope proofType 1 + if newArgs.isEmpty then + return none + mkProofFromPrefixFor? proof conclusion target (args ++ newArgs) + (binderInfos ++ newBinderInfos) + +/-- Find an exact local proof of `target`, then one whose syntactic `forall` +prefix is fully determined by `target`. Returned proofs contain no metavariables +and remain valid after the search state is restored. -/ def findLocalProofByType? (target : Expr) : TacticM (Option Expr) := withMainContext do - for ldecl in ← getLCtx do + let lctx ← getLCtx + for ldecl in lctx do unless ldecl.isImplementationDetail do let type ← instantiateMVars ldecl.type if ← withNewMCtxDepth <| isDefEq type target then return some (mkFVar ldecl.fvarId) + for ldecl in lctx do + unless ldecl.isImplementationDetail do + let type ← instantiateMVars ldecl.type + if type.isForall then + let proof? ← withoutModifyingState <| withNewMCtxDepth do + let (args, binderInfos, conclusion) ← + forallMetaBoundedTelescope type 1 + mkProofFromPrefixFor? (mkFVar ldecl.fvarId) conclusion target + args binderInfos + if let some proof := proof? then + return some proof return none def mkProofFromDeclFor? (decl : Name) (target : Expr) : TacticM (Option Expr) := withMainContext do - withNewMCtxDepth do - let proof ← mkConstWithFreshMVarLevels decl - let (args, _, conclusion) ← forallMetaTelescopeReducing (← inferType proof) - if ← isDefEq conclusion target then - return some (← instantiateMVars (mkAppN proof args)) - else - return none + withoutModifyingState do + withNewMCtxDepth do + let proof ← mkConstWithFreshMVarLevels decl + let proofType ← inferType proof + mkProofFromPrefixFor? proof proofType target #[] #[] def findTaggedProofsByType (attr : Lean.TagAttribute) (target : Expr) : TacticM (Array (Name × Expr)) := do @@ -93,12 +130,13 @@ elab_rules : tactic closeWithTaggedMatches found | `(tactic| rr_lookup [ $attrName:ident ]) => withMainContext do + let attrName := attrName.getId.eraseMacroScopes + let some attr := certificateAttrByName? attrName + | throwError "rr_lookup failed: unknown certificate attribute [{attrName}]" let target ← getMainTarget if let some proof ← findLocalProofByType? target then closeMainGoal `rr_lookup proof return - let some attr := certificateAttrByName? attrName.getId - | throwError "rr_lookup failed: unknown certificate attribute [{attrName.getId}]" closeWithTaggedMatches (← findTaggedProofsByType attr target) end Tactic diff --git a/RealRooted/Tactic/MaWang.lean b/RealRooted/Tactic/MaWang.lean index 67e4a1f8..f0477bd4 100644 --- a/RealRooted/Tactic/MaWang.lean +++ b/RealRooted/Tactic/MaWang.lean @@ -1,6 +1,7 @@ import RealRooted.LiuWangRecursion import RealRooted.MaWang import RealRooted.Tactic.Finish +import RealRooted.Tactic.Lookup import RealRooted.Tactic.RootBounds import RealRooted.Tactic.ScalarDen import RealRooted.Tactic.Sign @@ -28,6 +29,50 @@ P (n + 1) = u n * P n + v n * (P n).derivative. The tactic should apply existing theorems such as `prec_ma_wang` and `prec_of_interlaces_evalCoeff_nonpos`, then discharge certificate side goals. +For weak derivative steps whose auxiliary target polynomial is hidden from the +goal, use + +```lean +rr_mw_derivative_nonpos_step using recurrence := hrec +``` + +The goal must display the normalized derivative sum. The recurrence then fixes +the hidden polynomial before exact-local, local-family, or tagged certificate +lookup. Use the explicit form when the displayed target or a certificate does +not determine its prefix. + +When the goal itself displays either + +```text +Prec f (u * f + v * f.derivative) +Prec f (a * f + b * g) +``` + +use bare `rr_mw_derivative_nonpos` for the first shape and bare +`rr_prec_evalCoeff_nonpos` for the second. Each tactic infers the displayed +polynomials and uses certificate lookup. Their `using degree :=` forms run `lia` +independently for the lower and upper degree goals, so both bounds must follow +from the supplied arithmetic hint. Keep the displayed product association +literal; use an explicit form after reassociation. The generic tactic also +accepts derivative goals, but the derivative-specific form usually has the more +natural certificates. In the generic tactic, `source_pos_lc` refers to the +interlacer `g`. + +For a whole sequence whose coefficient families are hidden from the goal, use + +```lean +rr_mw_derivative_nonpos_sequence using recurrence := hrec +rr_mw_derivative_nonpos_sequence_realrooted using recurrence := hrec +``` + +The goal fixes `P`; the recurrence then fixes `U` and `V` before lookup obtains +the remaining certificates. A normalized recurrence supplied by a nested tactic +block needs an explicit expected type. Lookup expects the shifted degree-two +and coefficient-sign families and both degree inequalities in the theorem's +literal shapes; use the named form when those facts first need reshaping. The +real-rooted form closes the full conjunction as well as splitting, nonzero, and +indexed projections. + First intended regression examples: - `touchard`; @@ -1793,6 +1838,8 @@ syntax (name := rr_ma_wang) "rr_ma_wang" " using " term ", " term ", " term ", " term ", " term ", " term ", " term : tactic +syntax (name := rr_ma_wang_inferred) "rr_ma_wang" : tactic + syntax (name := rr_ma_wang_named) "rr_ma_wang" " using " "splits" ":=" term "," @@ -1808,6 +1855,8 @@ syntax (name := rr_ma_wang_same) "rr_ma_wang_same" " using " term ", " term ", " term ", " term ", " term ", " term : tactic +syntax (name := rr_ma_wang_same_inferred) "rr_ma_wang_same" : tactic + syntax (name := rr_ma_wang_same_named) "rr_ma_wang_same" " using " "splits" ":=" term "," @@ -1822,6 +1871,8 @@ syntax (name := rr_ma_wang_succ) "rr_ma_wang_succ" " using " term ", " term ", " term ", " term ", " term ", " term : tactic +syntax (name := rr_ma_wang_succ_inferred) "rr_ma_wang_succ" : tactic + syntax (name := rr_ma_wang_succ_named) "rr_ma_wang_succ" " using " "splits" ":=" term "," @@ -1851,6 +1902,12 @@ syntax (name := rr_prec_evalCoeff_nonpos_degree_named) "coeff_nonpos" ":=" term : tactic +syntax (name := rr_prec_evalCoeff_nonpos_inferred) + "rr_prec_evalCoeff_nonpos" : tactic + +syntax (name := rr_prec_evalCoeff_nonpos_degree_inferred) + "rr_prec_evalCoeff_nonpos" " using " "degree" ":=" term : tactic + syntax (name := rr_mw_derivative_nonpos) "rr_mw_derivative_nonpos" " using " term ", " term ", " term ", " term ", " term ", " term ", " term : @@ -1879,6 +1936,9 @@ syntax (name := rr_mw_derivative_nonpos_step_named) "coeff_nonpos" ":=" term : tactic +syntax (name := rr_mw_derivative_nonpos_step_inferred_of_recurrence) + "rr_mw_derivative_nonpos_step" " using " "recurrence" ":=" term : tactic + syntax (name := rr_mw_derivative_nonpos_degree_named) "rr_mw_derivative_nonpos" " using " "splits" ":=" term "," @@ -1889,6 +1949,12 @@ syntax (name := rr_mw_derivative_nonpos_degree_named) "coeff_nonpos" ":=" term : tactic +syntax (name := rr_mw_derivative_nonpos_inferred) + "rr_mw_derivative_nonpos" : tactic + +syntax (name := rr_mw_derivative_nonpos_degree_inferred) + "rr_mw_derivative_nonpos" " using " "degree" ":=" term : tactic + syntax (name := rr_mw_derivative_sign_roots_nonpos_named) "rr_mw_derivative_sign_roots_nonpos" " using " "splits" ":=" term "," @@ -2117,6 +2183,9 @@ syntax (name := rr_mw_derivative_nonpos_sequence_named) "degree_upper" ":=" term : tactic +syntax (name := rr_mw_derivative_nonpos_sequence_inferred_of_recurrence) + "rr_mw_derivative_nonpos_sequence" " using " "recurrence" ":=" term : tactic + syntax (name := rr_mw_derivative_nonpos_sequence_realrooted_named) "rr_mw_derivative_nonpos_sequence_realrooted" " using " "base" ":=" term "," @@ -2128,6 +2197,10 @@ syntax (name := rr_mw_derivative_nonpos_sequence_realrooted_named) "degree_upper" ":=" term : tactic +syntax (name := rr_mw_derivative_nonpos_sequence_realrooted_inferred_of_recurrence) + "rr_mw_derivative_nonpos_sequence_realrooted" " using " + "recurrence" ":=" term : tactic + syntax (name := rr_mw_derivative_global_nonpos_sequence_auto_named) "rr_mw_derivative_global_nonpos_sequence_auto" " using " "base" ":=" term "," @@ -3493,6 +3566,34 @@ macro_rules rr_mw_three_variants $hleft:term, $hmiddle:term, $hright:term) => `(tactic| rr_first_exact_then_realrooted_sequence_or_projection $hleft, $hmiddle, $hright) + | `(tactic| rr_ma_wang) => + `(tactic| + rr_ma_wang using + splits := (by rr_lookup), + degree_two := (by rr_lookup [rr_degree]), + degree_lower := (by rr_lookup [rr_degree]), + degree_upper := (by rr_lookup [rr_degree]), + target_pos_lc := (by rr_lookup [rr_pos_lc]), + source_pos_lc := (by rr_lookup [rr_pos_lc]), + root_sign := (by rr_lookup)) + | `(tactic| rr_ma_wang_same) => + `(tactic| + rr_ma_wang_same using + splits := (by rr_lookup), + degree_two := (by rr_lookup [rr_degree]), + degree := (by rr_lookup [rr_degree]), + target_pos_lc := (by rr_lookup [rr_pos_lc]), + source_pos_lc := (by rr_lookup [rr_pos_lc]), + root_sign := (by rr_lookup)) + | `(tactic| rr_ma_wang_succ) => + `(tactic| + rr_ma_wang_succ using + splits := (by rr_lookup), + degree_two := (by rr_lookup [rr_degree]), + degree := (by rr_lookup [rr_degree]), + target_pos_lc := (by rr_lookup [rr_pos_lc]), + source_pos_lc := (by rr_lookup [rr_pos_lc]), + root_sign := (by rr_lookup)) | `(tactic| rr_ma_wang using $hf:term, $hdegf:term, $hdeg_lo:term, $hdeg_hi:term, $hF_pos:term, @@ -3572,6 +3673,23 @@ macro_rules degree_lower := (by rr_mw_degree_from $hdeg), degree_upper := (by rr_mw_degree_from $hdeg), coeff_nonpos := $hb_nonpos) + | `(tactic| rr_prec_evalCoeff_nonpos) => + `(tactic| + rr_prec_evalCoeff_nonpos using + interlaces := (by rr_lookup), + source_pos_lc := (by rr_lookup [rr_pos_lc]), + target_pos_lc := (by rr_lookup [rr_pos_lc]), + degree_lower := (by rr_lookup [rr_degree]), + degree_upper := (by rr_lookup [rr_degree]), + coeff_nonpos := (by rr_lookup)) + | `(tactic| rr_prec_evalCoeff_nonpos using degree := $hdeg:term) => + `(tactic| + rr_prec_evalCoeff_nonpos using + interlaces := (by rr_lookup), + source_pos_lc := (by rr_lookup [rr_pos_lc]), + target_pos_lc := (by rr_lookup [rr_pos_lc]), + degree := $hdeg, + coeff_nonpos := (by rr_lookup)) | `(tactic| rr_mw_derivative_nonpos_step using splits := $hf:term, @@ -3585,6 +3703,12 @@ macro_rules `(tactic| exact RealRooted.prec_mw_derivative_of_nonpos_of_recurrence $hf $hdegf $hrec $hF_pos $hdeg_lo $hdeg_hi $hf_pos $hv_nonpos) + | `(tactic| rr_mw_derivative_nonpos_step using recurrence := $hrec:term) => + `(tactic| + rr_refine_then + (RealRooted.prec_mw_derivative_of_nonpos_of_recurrence + ?_ ?_ $hrec ?_ ?_ ?_ ?_ ?_) + with rr_lookup) | `(tactic| rr_mw_derivative_nonpos using $hf:term, $hdegf:term, $hdeg_lo:term, $hdeg_hi:term, $hF_pos:term, @@ -3621,6 +3745,25 @@ macro_rules target_pos_lc := $hF_pos, source_pos_lc := $hf_pos, coeff_nonpos := $hv_nonpos) + | `(tactic| rr_mw_derivative_nonpos) => + `(tactic| + rr_mw_derivative_nonpos using + splits := (by rr_lookup), + degree_two := (by rr_lookup [rr_degree]), + degree_lower := (by rr_lookup [rr_degree]), + degree_upper := (by rr_lookup [rr_degree]), + target_pos_lc := (by rr_lookup [rr_pos_lc]), + source_pos_lc := (by rr_lookup [rr_pos_lc]), + coeff_nonpos := (by rr_lookup)) + | `(tactic| rr_mw_derivative_nonpos using degree := $hdeg:term) => + `(tactic| + rr_mw_derivative_nonpos using + splits := (by rr_lookup), + degree_two := (by rr_lookup [rr_degree]), + degree := $hdeg, + target_pos_lc := (by rr_lookup [rr_pos_lc]), + source_pos_lc := (by rr_lookup [rr_pos_lc]), + coeff_nonpos := (by rr_lookup)) | `(tactic| rr_mw_derivative_sign_roots_nonpos using splits := $hf:term, @@ -3913,6 +4056,13 @@ macro_rules `(tactic| exact RealRooted.prec_mw_derivative_nonpos_sequence $hbase $hpos $hdeg_two $hV $hrec $hdeg_lo $hdeg_hi) + | `(tactic| + rr_mw_derivative_nonpos_sequence using recurrence := $hrec:term) => + `(tactic| + rr_refine_then + (RealRooted.prec_mw_derivative_nonpos_sequence + ?_ ?_ ?_ ?_ $hrec ?_ ?_) + with rr_lookup) | `(tactic| rr_mw_derivative_nonpos_sequence_realrooted using base := $hbase:term, @@ -3926,6 +4076,14 @@ macro_rules rr_exact_realrooted_sequence_or_projection (RealRooted.isRealRooted_of_mw_derivative_nonpos_sequence $hbase $hpos $hdeg_two $hV $hrec $hdeg_lo $hdeg_hi)) + | `(tactic| + rr_mw_derivative_nonpos_sequence_realrooted using + recurrence := $hrec:term) => + `(tactic| + rr_exact_realrooted_refine_then + (RealRooted.isRealRooted_of_mw_derivative_nonpos_sequence + ?_ ?_ ?_ ?_ $hrec ?_ ?_) + with rr_lookup) | `(tactic| rr_mw_derivative_global_nonpos_sequence_auto using base := $hbase:term, diff --git a/RealRooted/Tactic/Matrix.lean b/RealRooted/Tactic/Matrix.lean index ebddc558..e774e2ec 100644 --- a/RealRooted/Tactic/Matrix.lean +++ b/RealRooted/Tactic/Matrix.lean @@ -1,6 +1,7 @@ import RealRooted.MatrixInterlacing import RealRooted.RowThreshold import RealRooted.StaircaseSum +import RealRooted.Tactic.Lookup import RealRooted.Tactic.SideGoals /-! @@ -15,10 +16,13 @@ rr_matrix0_weak rr_matrix0_realrooted rr_matrix0_filter_ne_zero rr_matrix0_filter_ne_zero_weak +rr_row_threshold_matrix +rr_row_threshold_matrix0 rr_row_threshold_matrix0_weak rr_row_threshold_matrix0_realrooted rr_row_threshold_matrix0_filter_ne_zero rr_row_threshold_matrix0_filter_ne_zero_weak +rr_row_threshold_entry_nonneg ``` Primary target: @@ -33,6 +37,12 @@ The tactics apply `matrix_preserves_interlacing_seq`, the user supplies the matrix action, rectangularity, entry nonnegativity, and `2 x 2` Branden conditions. +Every matrix form has a bare variant inferring the matrix and input from the +goal. The positive-width forms also use an exact local width-positivity proof. +Bare forms use exact local length and input certificates, then the registered +matrix certificate attributes. The bare `rr_row_threshold_entry_nonneg` form +infers its matrix from the target. + Family J warning: do not attack raw scalar long-lag recurrences. First derive a refined vector or production-matrix recurrence. @@ -64,6 +74,8 @@ syntax (name := rr_matrix_named) "input_interlacing" ":=" term : tactic +syntax (name := rr_matrix_inferred) "rr_matrix" : tactic + syntax (name := rr_matrix0) "rr_matrix0" " using " term ", " term ", " @@ -85,6 +97,8 @@ syntax (name := rr_matrix0_named) "input_interlacing" ":=" term : tactic +syntax (name := rr_matrix0_inferred) "rr_matrix0" : tactic + syntax (name := rr_matrix0_weak) "rr_matrix0_weak" " using " term ", " term ", " @@ -108,6 +122,8 @@ syntax (name := rr_matrix0_weak_named) "input_real_rooted" ":=" term : tactic +syntax (name := rr_matrix0_weak_inferred) "rr_matrix0_weak" : tactic + syntax (name := rr_matrix0_realrooted) "rr_matrix0_realrooted" " using " term ", " term ", " @@ -129,6 +145,9 @@ syntax (name := rr_matrix0_realrooted_named) "input_interlacing" ":=" term : tactic +syntax (name := rr_matrix0_realrooted_inferred) + "rr_matrix0_realrooted" : tactic + syntax (name := rr_matrix0_filter_ne_zero) "rr_matrix0_filter_ne_zero" " using " term ", " term ", " @@ -150,6 +169,9 @@ syntax (name := rr_matrix0_filter_ne_zero_named) "input_interlacing" ":=" term : tactic +syntax (name := rr_matrix0_filter_ne_zero_inferred) + "rr_matrix0_filter_ne_zero" : tactic + syntax (name := rr_matrix0_filter_ne_zero_weak) "rr_matrix0_filter_ne_zero_weak" " using " term ", " term ", " @@ -173,6 +195,9 @@ syntax (name := rr_matrix0_filter_ne_zero_weak_named) "input_real_rooted" ":=" term : tactic +syntax (name := rr_matrix0_filter_ne_zero_weak_inferred) + "rr_matrix0_filter_ne_zero_weak" : tactic + syntax (name := rr_row_threshold_matrix_named) "rr_row_threshold_matrix" " using " "n_pos" ":=" term "," @@ -196,6 +221,9 @@ syntax (name := rr_row_threshold_matrix) term : tactic +syntax (name := rr_row_threshold_matrix_inferred) + "rr_row_threshold_matrix" : tactic + syntax (name := rr_row_threshold_matrix0_named) "rr_row_threshold_matrix0" " using " "matrix" ":=" term "," @@ -217,6 +245,9 @@ syntax (name := rr_row_threshold_matrix0) term : tactic +syntax (name := rr_row_threshold_matrix0_inferred) + "rr_row_threshold_matrix0" : tactic + syntax (name := rr_row_threshold_matrix0_weak_named) "rr_row_threshold_matrix0_weak" " using " "matrix" ":=" term "," @@ -240,6 +271,9 @@ syntax (name := rr_row_threshold_matrix0_weak) term : tactic +syntax (name := rr_row_threshold_matrix0_weak_inferred) + "rr_row_threshold_matrix0_weak" : tactic + syntax (name := rr_row_threshold_matrix0_filter_ne_zero_weak_named) "rr_row_threshold_matrix0_filter_ne_zero_weak" " using " "matrix" ":=" term "," @@ -263,6 +297,9 @@ syntax (name := rr_row_threshold_matrix0_filter_ne_zero_weak) term : tactic +syntax (name := rr_row_threshold_matrix0_filter_ne_zero_weak_inferred) + "rr_row_threshold_matrix0_filter_ne_zero_weak" : tactic + syntax (name := rr_row_threshold_matrix0_realrooted_named) "rr_row_threshold_matrix0_realrooted" " using " "matrix" ":=" term "," @@ -284,6 +321,9 @@ syntax (name := rr_row_threshold_matrix0_realrooted) term : tactic +syntax (name := rr_row_threshold_matrix0_realrooted_inferred) + "rr_row_threshold_matrix0_realrooted" : tactic + syntax (name := rr_row_threshold_matrix0_filter_ne_zero_named) "rr_row_threshold_matrix0_filter_ne_zero" " using " "matrix" ":=" term "," @@ -305,6 +345,9 @@ syntax (name := rr_row_threshold_matrix0_filter_ne_zero) term : tactic +syntax (name := rr_row_threshold_matrix0_filter_ne_zero_inferred) + "rr_row_threshold_matrix0_filter_ne_zero" : tactic + syntax (name := rr_row_threshold_entry_nonneg_named) "rr_row_threshold_entry_nonneg" " using " "row_threshold" ":=" term : @@ -314,7 +357,133 @@ syntax (name := rr_row_threshold_entry_nonneg) "rr_row_threshold_entry_nonneg" " using " term : tactic +syntax (name := rr_row_threshold_entry_nonneg_inferred) + "rr_row_threshold_entry_nonneg" : tactic + +-- The local length proof fixes the hidden width before positivity and frozen lookup. macro_rules + | `(tactic| rr_matrix) => + `(tactic| + exact (by + apply RealRooted.matrix_preserves_interlacing_seq + case hfs_len => assumption + case hn => assumption + case hG_rect => rr_lookup [rr_matrix_rect] + case hG_nonneg => rr_lookup [rr_matrix_nonneg] + case hG_affine => rr_lookup [rr_matrix_2x2] + case hfs => assumption)) + | `(tactic| rr_matrix0) => + `(tactic| + exact (by + apply RealRooted.matrix_preserves_interlacing_seq0_of_2x2 + case hfs_len => assumption + case hG_rect => rr_lookup [rr_matrix_rect] + case hG_nonneg => rr_lookup [rr_matrix_nonneg] + case hG_affine => rr_lookup [rr_matrix_2x2] + case hfs => assumption)) + | `(tactic| rr_matrix0_weak) => + `(tactic| + exact (by + apply RealRooted.matrix_preserves_interlacing_seq0_of_2x2_weak + case hfs_len => assumption + case hG_rect => rr_lookup [rr_matrix_rect] + case hG_nonneg => rr_lookup [rr_matrix_nonneg] + case hG_affine => rr_lookup [rr_matrix_2x2] + case hfs => assumption + case hfs_real => assumption)) + | `(tactic| rr_matrix0_realrooted) => + `(tactic| + exact (by + apply RealRooted.matrix_preserves_interlacing_seq0_of_2x2_realRooted + case hfs_len => assumption + case hG_rect => rr_lookup [rr_matrix_rect] + case hG_nonneg => rr_lookup [rr_matrix_nonneg] + case hG_affine => rr_lookup [rr_matrix_2x2] + case hfs => assumption)) + | `(tactic| rr_matrix0_filter_ne_zero) => + `(tactic| + exact (by + apply RealRooted.matrix_preserves_interlacing_seq0_filter_ne_zero_of_2x2 + case hfs_len => assumption + case hG_rect => rr_lookup [rr_matrix_rect] + case hG_nonneg => rr_lookup [rr_matrix_nonneg] + case hG_affine => rr_lookup [rr_matrix_2x2] + case hfs => assumption)) + | `(tactic| rr_matrix0_filter_ne_zero_weak) => + `(tactic| + exact (by + apply + RealRooted.matrix_preserves_interlacing_seq0_filter_ne_zero_of_2x2_weak + case hfs_len => assumption + case hG_rect => rr_lookup [rr_matrix_rect] + case hG_nonneg => rr_lookup [rr_matrix_nonneg] + case hG_affine => rr_lookup [rr_matrix_2x2] + case hfs => assumption + case hfs_real => assumption)) + | `(tactic| rr_row_threshold_matrix) => + `(tactic| + exact (by + apply RealRooted.rowThreshold_matrix_preserves_interlacing_seq_of_2x2 + case hfs_len => assumption + case hn => assumption + case hG_rect => rr_lookup [rr_matrix_rect] + case hG_threshold => rr_lookup [rr_matrix_threshold] + case hG_affine => rr_lookup [rr_matrix_2x2] + case hfs => assumption)) + | `(tactic| rr_row_threshold_matrix0) => + `(tactic| + exact (by + apply RealRooted.rowThreshold_matrix_preserves_interlacing_seq0_of_2x2 + case hfs_len => assumption + case hG_rect => rr_lookup [rr_matrix_rect] + case hG_threshold => rr_lookup [rr_matrix_threshold] + case hG_affine => rr_lookup [rr_matrix_2x2] + case hfs => assumption)) + | `(tactic| rr_row_threshold_matrix0_weak) => + `(tactic| + exact (by + apply RealRooted.rowThreshold_matrix_preserves_interlacing_seq0_of_2x2_weak + case hfs_len => assumption + case hG_rect => rr_lookup [rr_matrix_rect] + case hG_threshold => rr_lookup [rr_matrix_threshold] + case hG_affine => rr_lookup [rr_matrix_2x2] + case hfs => assumption + case hfs_real => assumption)) + | `(tactic| rr_row_threshold_matrix0_realrooted) => + `(tactic| + exact (by + apply + RealRooted.rowThreshold_matrix_preserves_interlacing_seq0_of_2x2_realRooted + case hfs_len => assumption + case hG_rect => rr_lookup [rr_matrix_rect] + case hG_threshold => rr_lookup [rr_matrix_threshold] + case hG_affine => rr_lookup [rr_matrix_2x2] + case hfs => assumption)) + | `(tactic| rr_row_threshold_matrix0_filter_ne_zero) => + `(tactic| + exact (by + apply + RealRooted.rowThreshold_matrix_preserves_interlacing_seq0_filter_ne_zero_of_2x2 + case hfs_len => assumption + case hG_rect => rr_lookup [rr_matrix_rect] + case hG_threshold => rr_lookup [rr_matrix_threshold] + case hG_affine => rr_lookup [rr_matrix_2x2] + case hfs => assumption)) + | `(tactic| rr_row_threshold_matrix0_filter_ne_zero_weak) => + `(tactic| + exact (by + apply + RealRooted.rowThreshold_matrix_preserves_interlacing_seq0_filter_ne_zero_of_2x2_weak + case hfs_len => assumption + case hG_rect => rr_lookup [rr_matrix_rect] + case hG_threshold => rr_lookup [rr_matrix_threshold] + case hG_affine => rr_lookup [rr_matrix_2x2] + case hfs => assumption + case hfs_real => assumption)) + | `(tactic| rr_row_threshold_entry_nonneg) => + `(tactic| + rr_row_threshold_entry_nonneg using + row_threshold := (by rr_lookup [rr_matrix_threshold])) | `(tactic| rr_matrix using $hn:term, $G:term, $hG_rect:term, $hG_nonneg:term, $hG_affine:term, diff --git a/RealRooted/Tactic/PFBidiagonal.lean b/RealRooted/Tactic/PFBidiagonal.lean index da5936bf..a93ad1b6 100644 --- a/RealRooted/Tactic/PFBidiagonal.lean +++ b/RealRooted/Tactic/PFBidiagonal.lean @@ -368,9 +368,14 @@ def BidiagonalJensenPencilCertificate ∀ lam : ℝ, 0 ≤ lam → IsPFPolynomial (bidiagonalJensenPencil alpha beta d lam) -/-- Backend theorem statement: a valid finite Jensen-pencil certificate implies -that the corresponding coefficient-bidiagonal operator preserves PF -polynomials up to degree `d`. -/ +/-- Open Jensen-pencil backend for coefficient-bidiagonal PF preservers. + +This implication is not stated in Borcea--Branden or Garloff--Wagner. The +certificate controls a one-sided real pencil, not upper-half-plane stability +of the genuine affine symbol `T((z + w)^d)`. Garloff--Wagner Theorem 12 assumes +an oriented proper-position relation rather than deriving it from this pencil. +Keep this as an explicit project conjecture; issue #240 tracks it, while issue +#297 tracks the separate affine-symbol route. -/ def jensenPencilBidiagonalPreserverStatement : Prop := ∀ {alpha beta : ℕ → ℝ} {d : ℕ}, BidiagonalJensenPencilCertificate alpha beta d → diff --git a/RealRooted/Tactic/PLAN.md b/RealRooted/Tactic/PLAN.md index d7c327ec..a3179e02 100644 --- a/RealRooted/Tactic/PLAN.md +++ b/RealRooted/Tactic/PLAN.md @@ -882,6 +882,16 @@ direct model-transfer frontends for common fixed-lag shapes: - `rr_identify_lag_two_sequence` and `rr_model_lag_two_sequence`; - `rr_identify_lag_three_sequence` and `rr_model_lag_three_sequence`. +Each tactic also has a certificate-inferred form. The caller supplies the +common update function; the tactic reuses exact local initial equalities and +target and model recurrence facts, with only definitional and natural-number +offset normalization. The model-transfer forms additionally require +`model_realrooted := ...`. This makes active tails such as `fun n => P (n + k)` +first-class targets while keeping concrete recurrence expressions explicit. +The fully explicit forms remain the deterministic fallback when several +recurrences are in scope. Context inference does not discover a model family +or prove its recurrence; those facts remain explicit mathematical obligations. + The recurrence step is an arbitrary function of the index and preceding rows, so the same API covers polynomial multiplication, affine Favard steps, and derivative recurrences without naming any OEIS sequence. The companion OEIS diff --git a/RealRooted/Tactic/Product.lean b/RealRooted/Tactic/Product.lean index a4fb26dc..10c3deca 100644 --- a/RealRooted/Tactic/Product.lean +++ b/RealRooted/Tactic/Product.lean @@ -2692,6 +2692,17 @@ syntax (name := rr_product_factor_sequence) "rr_product_factor_sequence" " using " term ", " term ", " term : tactic +syntax (name := rr_product_factor_sequence_inferred_of_recurrence) + "rr_product_factor_sequence" " using " + "recurrence" ":=" term : + tactic + +syntax (name := rr_product_factor_sequence_from_inferred_of_recurrence) + "rr_product_factor_sequence" " using " + "cutoff" ":=" term "," + "recurrence" ":=" term : + tactic + syntax (name := rr_lag_product_factor_sequence_named) "rr_lag_product_factor_sequence" " using " "base_zero" ":=" term "," @@ -2705,6 +2716,11 @@ syntax (name := rr_lag_product_factor_sequence) term ", " term ", " term ", " term : tactic +syntax (name := rr_lag_product_factor_sequence_inferred_of_recurrence) + "rr_lag_product_factor_sequence" " using " + "recurrence" ":=" term : + tactic + syntax (name := rr_affine_product_sequence_named) "rr_affine_product_sequence" " using " "formula" ":=" term : tactic @@ -4137,6 +4153,39 @@ macro_rules base := $hbase, factor_realrooted := $hfactor, recurrence := $hstep) + | `(tactic| + rr_product_factor_sequence using + recurrence := $hstep:term) => + `(tactic| + first + | rr_product_factor_sequence using cutoff := _, recurrence := $hstep + | rr_first_realrooted_sequence_or_projection + (by + rr_refine_then + (RealRooted.isRealRooted_of_product_factor_sequence + ?_ ?_ $hstep) + with rr_lookup), + (by + rr_refine_then + (RealRooted.isRealRooted_of_product_factor_right_sequence + ?_ ?_ $hstep) + with rr_lookup)) + | `(tactic| + rr_product_factor_sequence using + cutoff := $N:term, + recurrence := $hstep:term) => + `(tactic| + rr_first_realrooted_sequence_or_projection + (by + rr_refine_then + (RealRooted.isRealRooted_of_product_factor_sequence_from + $N ?_ ?_ $hstep) + with rr_lookup), + (by + rr_refine_then + (RealRooted.isRealRooted_of_product_factor_right_sequence_from + $N ?_ ?_ $hstep) + with rr_lookup)) | `(tactic| rr_lag_product_factor_sequence using base_zero := $hbase_zero:term, @@ -4158,6 +4207,21 @@ macro_rules base_one := $hbase_one, factor_realrooted := $hfactor, recurrence := $hstep) + | `(tactic| + rr_lag_product_factor_sequence using + recurrence := $hstep:term) => + `(tactic| + rr_first_realrooted_sequence_or_projection + (by + rr_refine_then + (RealRooted.isRealRooted_of_lag_product_factor_sequence + ?_ ?_ ?_ $hstep) + with rr_lookup), + (by + rr_refine_then + (RealRooted.isRealRooted_of_lag_product_factor_right_sequence + ?_ ?_ ?_ $hstep) + with rr_lookup)) | `(tactic| rr_affine_product_sequence using formula := $hroot:term) => `(tactic| exact RealRooted.finiteLinearProductSequence_realRooted $hroot) diff --git a/RealRooted/Tactic/RecurrenceIdentification.lean b/RealRooted/Tactic/RecurrenceIdentification.lean index 0ea363cd..116e0d5a 100644 --- a/RealRooted/Tactic/RecurrenceIdentification.lean +++ b/RealRooted/Tactic/RecurrenceIdentification.lean @@ -6,6 +6,9 @@ import RealRooted.Tactic.Product Generic uniqueness lemmas identify two sequences from equal initial rows and the same fixed-lag recurrence. The tactic frontends either prove the pointwise identification or transfer real-rootedness from the identified model sequence. +Explicit forms accept every certificate. The inferred forms keep the update +function explicit and reuse matching certificates from the local context. +Context inference does not discover a model family or prove its recurrence. -/ open Polynomial @@ -88,6 +91,21 @@ syntax (name := rr_identify_lag_three_sequence_named) "model_recurrence" ":=" term : tactic +syntax (name := rr_identify_lag_one_sequence_update_inferred) + "rr_identify_lag_one_sequence" " using " + "update" ":=" term : + tactic + +syntax (name := rr_identify_lag_two_sequence_update_inferred) + "rr_identify_lag_two_sequence" " using " + "update" ":=" term : + tactic + +syntax (name := rr_identify_lag_three_sequence_update_inferred) + "rr_identify_lag_three_sequence" " using " + "update" ":=" term : + tactic + syntax (name := rr_model_lag_one_sequence_named) "rr_model_lag_one_sequence" " using " "model_realrooted" ":=" term "," @@ -118,7 +136,37 @@ syntax (name := rr_model_lag_three_sequence_named) "model_recurrence" ":=" term : tactic +syntax (name := rr_model_lag_one_sequence_update_inferred) + "rr_model_lag_one_sequence" " using " + "model_realrooted" ":=" term "," + "update" ":=" term : + tactic + +syntax (name := rr_model_lag_two_sequence_update_inferred) + "rr_model_lag_two_sequence" " using " + "model_realrooted" ":=" term "," + "update" ":=" term : + tactic + +syntax (name := rr_model_lag_three_sequence_update_inferred) + "rr_model_lag_three_sequence" " using " + "model_realrooted" ":=" term "," + "update" ":=" term : + tactic + +syntax (name := rr_recurrence_identification_fact_term) + "rr_recurrence_identification_fact_term" : term + macro_rules + | `(rr_recurrence_identification_fact_term) => + `(by + first + | assumption + | rr_lookup + | rfl + | (simp only [Nat.add_assoc, Nat.reduceAdd]; + first | assumption | rr_lookup | rfl) + | fail "recurrence identification could not infer this certificate; pass it explicitly") | `(tactic| rr_identify_lag_one_sequence using update := $upd:term, @@ -188,5 +236,71 @@ macro_rules (RealRooted.isRealRooted_of_model_sequence $hmodel (RealRooted.sequence_eq_of_same_lag_three_recurrence $upd $hzero $hone $htwo $hP $hQ))) + | `(tactic| + rr_identify_lag_one_sequence using + update := $upd:term) => + `(tactic| + rr_identify_lag_one_sequence using + update := $upd, + initial := rr_recurrence_identification_fact_term, + target_recurrence := rr_recurrence_identification_fact_term, + model_recurrence := rr_recurrence_identification_fact_term) + | `(tactic| + rr_identify_lag_two_sequence using + update := $upd:term) => + `(tactic| + rr_identify_lag_two_sequence using + update := $upd, + initial_zero := rr_recurrence_identification_fact_term, + initial_one := rr_recurrence_identification_fact_term, + target_recurrence := rr_recurrence_identification_fact_term, + model_recurrence := rr_recurrence_identification_fact_term) + | `(tactic| + rr_identify_lag_three_sequence using + update := $upd:term) => + `(tactic| + rr_identify_lag_three_sequence using + update := $upd, + initial_zero := rr_recurrence_identification_fact_term, + initial_one := rr_recurrence_identification_fact_term, + initial_two := rr_recurrence_identification_fact_term, + target_recurrence := rr_recurrence_identification_fact_term, + model_recurrence := rr_recurrence_identification_fact_term) + | `(tactic| + rr_model_lag_one_sequence using + model_realrooted := $hmodel:term, + update := $upd:term) => + `(tactic| + rr_model_lag_one_sequence using + model_realrooted := $hmodel, + update := $upd, + initial := rr_recurrence_identification_fact_term, + target_recurrence := rr_recurrence_identification_fact_term, + model_recurrence := rr_recurrence_identification_fact_term) + | `(tactic| + rr_model_lag_two_sequence using + model_realrooted := $hmodel:term, + update := $upd:term) => + `(tactic| + rr_model_lag_two_sequence using + model_realrooted := $hmodel, + update := $upd, + initial_zero := rr_recurrence_identification_fact_term, + initial_one := rr_recurrence_identification_fact_term, + target_recurrence := rr_recurrence_identification_fact_term, + model_recurrence := rr_recurrence_identification_fact_term) + | `(tactic| + rr_model_lag_three_sequence using + model_realrooted := $hmodel:term, + update := $upd:term) => + `(tactic| + rr_model_lag_three_sequence using + model_realrooted := $hmodel, + update := $upd, + initial_zero := rr_recurrence_identification_fact_term, + initial_one := rr_recurrence_identification_fact_term, + initial_two := rr_recurrence_identification_fact_term, + target_recurrence := rr_recurrence_identification_fact_term, + model_recurrence := rr_recurrence_identification_fact_term) end RealRooted diff --git a/RealRooted/Tactic/RootCount.lean b/RealRooted/Tactic/RootCount.lean index 4136baaa..cc8fd106 100644 --- a/RealRooted/Tactic/RootCount.lean +++ b/RealRooted/Tactic/RootCount.lean @@ -1,16 +1,27 @@ import RealRooted.DegreeIncreasingLocalLowerCount +import RealRooted.PositiveParameterLocalLowerCount import RealRooted.RootContinuity import RealRooted.RootCountJump import RealRooted.SameDegreeCountFromAnalytic import RealRooted.SameDegreeCubicSecondRootFromAnalytic import RealRooted.SmallPositiveParameterCount import RealRooted.SuccDegreeLeftEndpoint +import RealRooted.Tactic.Lookup +import RealRooted.Tactic.SideGoals /-! # Root-count and continuity tactic frontends Thin wrappers for public root-count and local-continuity endpoints used in succ-degree positive-parameter arguments. + +For a constant-degree split pencil on `[0, μ]` that avoids a fixed threshold, +use `rr_rightFamily_card_roots_gt_eq_zero_param`. The sequence sibling applies +the same proved endpoint pointwise. Their bare forms infer the four complete +certificate families from the local context; neither tactic proves an +interlacing or proper-position conclusion. The target orientation is the +upper-endpoint count equal to the normalized zero-endpoint count: +`card (roots (f + C μ * g) above x) = card (roots f above x)`. -/ open Polynomial @@ -79,6 +90,22 @@ theorem positiveParameter_local_lower_count_sequence RealRooted.positiveParameter_local_lower_count (hsplit i) (hdeg i) (hμ i) (hρ i) +theorem rightFamily_card_roots_gt_eq_zero_param_sequence + {F G : Nat → ℝ[X]} {x μ : Nat → ℝ} + (hμ_pos : ∀ i : Nat, 0 < μ i) + (hdeg : ∀ i : Nat, ∀ η ∈ Set.Icc (0 : ℝ) (μ i), + (F i + C η * G i).natDegree = + (F i + C (0 : ℝ) * G i).natDegree) + (hsplit : ∀ i : Nat, ∀ η ∈ Set.Icc (0 : ℝ) (μ i), + (F i + C η * G i).Splits) + (hne : ∀ i : Nat, ∀ η ∈ Set.Icc (0 : ℝ) (μ i), + ¬ (F i + C η * G i).IsRoot (x i)) : + ∀ i : Nat, + ((F i + C (μ i) * G i).roots.filter (x i < ·)).card = + ((F i).roots.filter (x i < ·)).card := fun i => + RealRooted.rightFamily_card_roots_gt_eq_zero_param_of_constant_degree + (hμ_pos i) (hdeg i) (hsplit i) (hne i) + theorem rightFamily_card_roots_gt_eq_local_lower_sequence {F G : Nat → ℝ[X]} {μ₀ μ₁ x : Nat → ℝ} (hμ₁ : ∀ i : Nat, μ₀ i ≤ μ₁ i) @@ -1064,6 +1091,28 @@ syntax (name := rr_positiveParameter_local_lower_count_sequence_named) "radius_pos" ":=" term : tactic +syntax (name := rr_rightFamily_card_roots_gt_eq_zero_param_named) + "rr_rightFamily_card_roots_gt_eq_zero_param" " using " + "parameter_pos" ":=" term "," + "degree_on_interval" ":=" term "," + "splits_on_interval" ":=" term "," + "threshold_not_root" ":=" term : + tactic + +syntax (name := rr_rightFamily_card_roots_gt_eq_zero_param_inferred) + "rr_rightFamily_card_roots_gt_eq_zero_param" : tactic + +syntax (name := rr_rightFamily_card_roots_gt_eq_zero_param_sequence_named) + "rr_rightFamily_card_roots_gt_eq_zero_param_sequence" " using " + "parameter_pos" ":=" term "," + "degree_on_interval" ":=" term "," + "splits_on_interval" ":=" term "," + "threshold_not_root" ":=" term : + tactic + +syntax (name := rr_rightFamily_card_roots_gt_eq_zero_param_sequence_inferred) + "rr_rightFamily_card_roots_gt_eq_zero_param_sequence" : tactic + syntax (name := rr_rightFamily_card_roots_gt_eq_local_lower_named) "rr_rightFamily_card_roots_gt_eq_local_lower" " using " "interval_order" ":=" term "," @@ -2077,6 +2126,38 @@ macro_rules `(tactic| exact RealRooted.Tactic.positiveParameter_local_lower_count_sequence $hsplit $hdeg $hμ $hρ) + | `(tactic| + rr_rightFamily_card_roots_gt_eq_zero_param using + parameter_pos := $hμ:term, + degree_on_interval := $hdeg:term, + splits_on_interval := $hsplit:term, + threshold_not_root := $hne:term) => + `(tactic| + exact + RealRooted.rightFamily_card_roots_gt_eq_zero_param_of_constant_degree + $hμ $hdeg $hsplit $hne) + | `(tactic| rr_rightFamily_card_roots_gt_eq_zero_param) => + `(tactic| + rr_refine_then + (RealRooted.rightFamily_card_roots_gt_eq_zero_param_of_constant_degree + ?_ ?_ ?_ ?_) + with rr_lookup) + | `(tactic| + rr_rightFamily_card_roots_gt_eq_zero_param_sequence using + parameter_pos := $hμ:term, + degree_on_interval := $hdeg:term, + splits_on_interval := $hsplit:term, + threshold_not_root := $hne:term) => + `(tactic| + exact + RealRooted.Tactic.rightFamily_card_roots_gt_eq_zero_param_sequence + $hμ $hdeg $hsplit $hne) + | `(tactic| rr_rightFamily_card_roots_gt_eq_zero_param_sequence) => + `(tactic| + rr_refine_then + (RealRooted.Tactic.rightFamily_card_roots_gt_eq_zero_param_sequence + ?_ ?_ ?_ ?_) + with rr_lookup) | `(tactic| rr_rightFamily_card_roots_gt_eq_local_lower using interval_order := $hμ₁:term, diff --git a/RealRooted/Tactic/Wagner.lean b/RealRooted/Tactic/Wagner.lean index 650a858b..bdb14f48 100644 --- a/RealRooted/Tactic/Wagner.lean +++ b/RealRooted/Tactic/Wagner.lean @@ -1,9 +1,14 @@ import RealRooted.Challenges.Wagner +import RealRooted.Tactic.Lookup /-! # Wagner challenge tactic frontends Thin wrappers around the challenge-facing Wagner lemma forms. + +Production-facing adapters also expose hypothesis-light common-right addition, +common-factor transport, and linear-factor cancellation without +sequence-specific names. -/ open Polynomial @@ -88,6 +93,38 @@ syntax (name := rr_wagner_mulX_iff_sequence_named) "degree" ":=" term : tactic +syntax (name := rr_wagner_common_right_add_pos_lc_named) + "rr_wagner_common_right_add_pos_lc" " using " + "left_interlaces_common" ":=" term "," + "right_interlaces_common" ":=" term "," + "left_pos_lc" ":=" term "," + "right_pos_lc" ":=" term : + tactic + +syntax (name := rr_wagner_common_right_add_pos_lc_inferred) + "rr_wagner_common_right_add_pos_lc" : tactic + +syntax (name := rr_prec_cancel_common_linear_factor_named) + "rr_prec_cancel_common_linear_factor" " using " + "root" ":=" term "," + "multiplied_interlacing" ":=" term : + tactic + +syntax (name := rr_prec_cancel_common_linear_factor_inferred) + "rr_prec_cancel_common_linear_factor" " using " + "root" ":=" term : + tactic + +syntax (name := rr_prec_mul_common_factor_named) + "rr_prec_mul_common_factor" " using " + "factor_nonzero" ":=" term "," + "factor_splits" ":=" term "," + "base_interlacing" ":=" term : + tactic + +syntax (name := rr_prec_mul_common_factor_inferred) + "rr_prec_mul_common_factor" : tactic + macro_rules | `(tactic| rr_wagner_common_right_add using @@ -143,6 +180,49 @@ macro_rules degree := $hdeg:term) => `(tactic| exact RealRooted.Tactic.wagner_mulX_iff_sequence $hf $hg $hdeg) + | `(tactic| + rr_wagner_common_right_add_pos_lc using + left_interlaces_common := $hfh:term, + right_interlaces_common := $hgh:term, + left_pos_lc := $hf_pos:term, + right_pos_lc := $hg_pos:term) => + `(tactic| + exact RealRooted.prec_add_of_prec_right_of_posLeadingCoeff + $hfh $hgh $hf_pos $hg_pos) + | `(tactic| rr_wagner_common_right_add_pos_lc) => + `(tactic| + exact (by + apply RealRooted.prec_add_of_prec_right_of_posLeadingCoeff + case hfh => rr_lookup [rr_base_prec] + case hgh => rr_lookup [rr_base_prec] + case hf_pos => rr_lookup [rr_pos_lc] + case hg_pos => rr_lookup [rr_pos_lc])) + | `(tactic| + rr_prec_cancel_common_linear_factor using + root := $r:term, + multiplied_interlacing := $h:term) => + `(tactic| exact RealRooted.prec_of_prec_mul_X_sub_C_both $r $h) + | `(tactic| + rr_prec_cancel_common_linear_factor using + root := $r:term) => + `(tactic| + exact (by + apply RealRooted.prec_of_prec_mul_X_sub_C_both $r + rr_lookup [rr_base_prec])) + | `(tactic| + rr_prec_mul_common_factor using + factor_nonzero := $hd_ne:term, + factor_splits := $hd_splits:term, + base_interlacing := $h:term) => + `(tactic| + exact RealRooted.prec_mul_common_factor $hd_ne $hd_splits $h) + | `(tactic| rr_prec_mul_common_factor) => + `(tactic| + exact (by + apply RealRooted.prec_mul_common_factor + case hd_ne => rr_lookup [rr_nonzero] + case hd_splits => assumption + case h => rr_lookup [rr_base_prec])) end Tactic end RealRooted diff --git a/RealRooted/Tactic/WagnerX.lean b/RealRooted/Tactic/WagnerX.lean index 0a9d3d4e..0a9e587d 100644 --- a/RealRooted/Tactic/WagnerX.lean +++ b/RealRooted/Tactic/WagnerX.lean @@ -1,12 +1,20 @@ import RealRooted.PosCombo import RealRooted.AffineFamily import RealRooted.Tactic.Finish +import RealRooted.Tactic.Lookup /-! # Wagner `X`-shift tactics Small wrappers for the Wagner `X`-multiplication bridge used in plateau positive-`t` lag recurrences. + +Bare one-step forms consume exact local hypotheses, local hypotheses with a +fully determined `forall` prefix, or tagged certificates. They preserve the +displayed product association rather than searching through reassociated +targets. Use the explicit forms when a local prefix is not determined by the +goal. The derivative-gap form may also close its two strict scalar bounds with +`rr_wagner_pos` arithmetic. -/ open Polynomial @@ -420,6 +428,9 @@ syntax (name := rr_prec_mul_X) "right_nonneg" ":=" term : tactic +syntax (name := rr_prec_mul_X_inferred) + "rr_prec_mul_X" : tactic + syntax (name := rr_prec_mul_X_both) "rr_prec_mul_X_both" " using " "proper" ":=" term "," @@ -427,6 +438,9 @@ syntax (name := rr_prec_mul_X_both) "right_nonneg" ":=" term : tactic +syntax (name := rr_prec_mul_X_both_inferred) + "rr_prec_mul_X_both" : tactic + syntax (name := rr_prec_C_mul_X) "rr_prec_C_mul_X" " using " "proper" ":=" term "," @@ -443,6 +457,16 @@ syntax (name := rr_prec_C_mul_X_pos) "coeff_pos" ":=" term : tactic +syntax (name := rr_prec_C_mul_X_inferred) + "rr_prec_C_mul_X" " using " + "coeff_ne" ":=" term : + tactic + +syntax (name := rr_prec_C_mul_X_pos_inferred) + "rr_prec_C_mul_X" " using " + "coeff_pos" ":=" term : + tactic + syntax (name := rr_prec_X_derivative_X_self) "rr_prec_X_derivative_X_self" " using " "splits" ":=" term "," @@ -450,6 +474,9 @@ syntax (name := rr_prec_X_derivative_X_self) "nonneg_coeffs" ":=" term : tactic +syntax (name := rr_prec_X_derivative_X_self_inferred) + "rr_prec_X_derivative_X_self" : tactic + syntax (name := rr_prec_wagner_derivative_gap_lag) "rr_prec_wagner_derivative_gap_lag" " using " "proper" ":=" term "," @@ -460,6 +487,9 @@ syntax (name := rr_prec_wagner_derivative_gap_lag) "derivative_coeff_pos" ":=" term : tactic +syntax (name := rr_prec_wagner_derivative_gap_lag_inferred) + "rr_prec_wagner_derivative_gap_lag" : tactic + syntax (name := rr_prec_wagner_derivative_gap_lag_den) "rr_prec_wagner_derivative_gap_lag_den" " using " "proper" ":=" term "," @@ -615,6 +645,7 @@ macro_rules `(fun n => by simpa using $hrec n) macro_rules + -- Each conclusion fixes its hidden polynomial and scalar parameters first. | `(tactic| rr_prec_mul_X using proper := $hprec:term, @@ -622,6 +653,13 @@ macro_rules right_nonneg := $hgnn:term) => `(tactic| exact RealRooted.prec_mul_X_of_prec_of_nonneg $hprec $hfnn $hgnn) + | `(tactic| rr_prec_mul_X) => + `(tactic| + exact (by + apply RealRooted.prec_mul_X_of_prec_of_nonneg + case h => rr_lookup [rr_base_prec] + case hfnn => rr_lookup [rr_nonneg] + case hgnn => rr_lookup [rr_nonneg])) | `(tactic| rr_prec_mul_X_both using proper := $hprec:term, @@ -629,6 +667,13 @@ macro_rules right_nonneg := $hgnn:term) => `(tactic| exact RealRooted.prec_mul_X_both_of_prec_of_nonneg $hprec $hfnn $hgnn) + | `(tactic| rr_prec_mul_X_both) => + `(tactic| + exact (by + apply RealRooted.prec_mul_X_both_of_prec_of_nonneg + case h => rr_lookup [rr_base_prec] + case hfnn => rr_lookup [rr_nonneg] + case hgnn => rr_lookup [rr_nonneg])) | `(tactic| rr_prec_C_mul_X using proper := $hprec:term, @@ -646,6 +691,26 @@ macro_rules `(tactic| exact RealRooted.prec_C_mul_X_of_prec_of_nonneg $hprec $hfnn $hgnn ($hc).ne') + | `(tactic| + rr_prec_C_mul_X using + coeff_ne := $hc:term) => + `(tactic| + exact (by + apply RealRooted.prec_C_mul_X_of_prec_of_nonneg + case h => rr_lookup [rr_base_prec] + case hfnn => rr_lookup [rr_nonneg] + case hgnn => rr_lookup [rr_nonneg] + case hc => exact $hc)) + | `(tactic| + rr_prec_C_mul_X using + coeff_pos := $hc:term) => + `(tactic| + exact (by + apply RealRooted.prec_C_mul_X_of_prec_of_nonneg + case h => rr_lookup [rr_base_prec] + case hfnn => rr_lookup [rr_nonneg] + case hgnn => rr_lookup [rr_nonneg] + case hc => exact ($hc).ne')) | `(tactic| rr_prec_X_derivative_X_self using splits := $hf:term, @@ -654,6 +719,13 @@ macro_rules `(tactic| exact RealRooted.prec_X_mul_derivative_X_mul_self_of_splits_nonneg $hf $hdeg $hfnn) + | `(tactic| rr_prec_X_derivative_X_self) => + `(tactic| + exact (by + apply RealRooted.prec_X_mul_derivative_X_mul_self_of_splits_nonneg + case hf => rr_lookup + case hdeg => rr_lookup [rr_degree] + case hfnn => rr_lookup [rr_nonneg])) | `(tactic| rr_prec_wagner_derivative_gap_lag using proper := $hprec:term, @@ -665,6 +737,16 @@ macro_rules `(tactic| exact RealRooted.prec_wagner_derivative_gap_lag_step $hprec $hfnn $hgnn $hdeg $ha $hc) + | `(tactic| rr_prec_wagner_derivative_gap_lag) => + `(tactic| + exact (by + apply RealRooted.prec_wagner_derivative_gap_lag_step + case h => rr_lookup [rr_base_prec] + case hfnn => rr_lookup [rr_nonneg] + case hgnn => rr_lookup [rr_nonneg] + case hdeg => rr_lookup [rr_degree] + case ha => first | rr_lookup | rr_wagner_pos + case hc => first | rr_lookup | rr_wagner_pos)) | `(tactic| rr_prec_wagner_derivative_gap_lag_den using proper := $hprec:term,