/- Every scalar real polynomial minimal graph in dimension eight is affine. Submission body for Math30Catalog.source29. The challenge supplies its imports and the surrounding Bounty namespace. -/ /- Component: LeadingReduction.lean -/ /-! # All-degree leading-component reduction for polynomial minimal graphs Extracted and adapted from the PolynomialBasics component of `QuarticMinimalGraphs.lean` (the Math30Catalog.source28 submission body). The statements below make no upper bound assumption on polynomial degree. This is a proved dependency toward Math30Catalog.source29, not a proof of that target. -/ /- Component: PolynomialBasics -/ section ComponentPolynomialBasics noncomputable section open scoped BigOperators open MvPolynomial namespace QuarticPolynomialBasics variable {σ : Type*} lemma totalDegree_pderiv_le_of_totalDegree_le (P : MvPolynomial σ ℝ) (i : σ) (d : ℕ) (h : P.totalDegree ≤ d + 1) : (pderiv i P).totalDegree ≤ d := by classical apply Finset.sup_le intro m hm change m.degree ≤ d have hc : P.coeff (m + Finsupp.single i 1) ≠ 0 := by have hh := mem_support_iff.mp hm rw [coeff_pderiv] at hh exact (mul_ne_zero_iff.mp hh).1 have hd := le_totalDegree (mem_support_iff.mpr hc) change (m + Finsupp.single i 1).degree ≤ P.totalDegree at hd simp only [map_add, Finsupp.degree_single] at hd omega lemma totalDegree_pderiv_le (P : MvPolynomial σ ℝ) (i : σ) : (pderiv i P).totalDegree ≤ P.totalDegree - 1 := totalDegree_pderiv_le_of_totalDegree_le P i _ (by omega) lemma pderiv_homogeneousComponent (P : MvPolynomial σ ℝ) (i : σ) (d : ℕ) : pderiv i (homogeneousComponent (d + 1) P) = homogeneousComponent d (pderiv i P) := by classical ext m simp only [coeff_pderiv, coeff_homogeneousComponent, map_add, Finsupp.degree_single] by_cases h : m.degree = d <;> simp [h] lemma totalDegree_sub_homogeneousComponent_le (P : MvPolynomial σ ℝ) (d : ℕ) (h : P.totalDegree ≤ d) : (P - homogeneousComponent d P).totalDegree ≤ d - 1 := by classical apply Finset.sup_le intro m hm change m.degree ≤ d - 1 have hc := mem_support_iff.mp hm simp only [coeff_sub, coeff_homogeneousComponent] at hc split_ifs at hc with hd · exact False.elim (hc (sub_self _)) · simp only [sub_zero] at hc have hh := le_totalDegree (mem_support_iff.mpr hc) change m.degree ≤ P.totalDegree at hh omega lemma top_homogeneousComponent_ne_zero (P : MvPolynomial σ ℝ) (h : 0 < P.totalDegree) : homogeneousComponent P.totalDegree P ≠ 0 := by intro hh have hdeg := totalDegree_sub_homogeneousComponent_le P P.totalDegree le_rfl rw [hh, sub_zero] at hdeg omega lemma homogeneousComponent_mul_top (P Q : MvPolynomial σ ℝ) (d e : ℕ) (hP : P.totalDegree ≤ d) (hQ : Q.totalDegree ≤ e) : homogeneousComponent (d + e) (P * Q) = homogeneousComponent d P * homogeneousComponent e Q := by by_cases hd : d = 0 · subst d have hp0 : P.totalDegree = 0 := Nat.eq_zero_of_le_zero hP rw [(totalDegree_eq_zero_iff_eq_C.mp hp0)] simp [homogeneousComponent_C_mul, homogeneousComponent_zero] by_cases he : e = 0 · subst e have hq0 : Q.totalDegree = 0 := Nat.eq_zero_of_le_zero hQ rw [(totalDegree_eq_zero_iff_eq_C.mp hq0)] rw [mul_comm P (C (Q.coeff 0)), homogeneousComponent_C_mul] simp [homogeneousComponent_zero, mul_comm] have hdp := totalDegree_sub_homogeneousComponent_le P d hP have hdq := totalDegree_sub_homogeneousComponent_le Q e hQ have htp : (homogeneousComponent d P).totalDegree ≤ d := (homogeneousComponent_isHomogeneous d P).totalDegree_le have hz1 : homogeneousComponent (d + e) ((P - homogeneousComponent d P) * Q) = 0 := by apply homogeneousComponent_eq_zero have hh := totalDegree_mul (P - homogeneousComponent d P) Q omega have hz2 : homogeneousComponent (d + e) (homogeneousComponent d P * (Q - homogeneousComponent e Q)) = 0 := by apply homogeneousComponent_eq_zero have hh := totalDegree_mul (homogeneousComponent d P) (Q - homogeneousComponent e Q) omega have heq : P * Q = homogeneousComponent d P * homogeneousComponent e Q + ((P - homogeneousComponent d P) * Q + homogeneousComponent d P * (Q - homogeneousComponent e Q)) := by ring rw [heq, map_add, map_add, hz1, hz2, add_zero, add_zero] exact homogeneousComponent_eq_self ((homogeneousComponent_isHomogeneous d P).mul (homogeneousComponent_isHomogeneous e Q)) /-- The polynomial numerator of the scalar minimal graph equation. This is definitionally equal to the corresponding operator in the challenge. -/ def minimalGraphOperator {n : ℕ} (P : MvPolynomial (Fin n) ℝ) : MvPolynomial (Fin n) ℝ := (1 + ∑ i : Fin n, (pderiv i P) ^ 2) * (∑ i : Fin n, pderiv i (pderiv i P)) - ∑ i : Fin n, ∑ j : Fin n, pderiv i P * pderiv j P * pderiv i (pderiv j P) def polynomialLaplacian {n : ℕ} (P : MvPolynomial (Fin n) ℝ) : MvPolynomial (Fin n) ℝ := ∑ i : Fin n, pderiv i (pderiv i P) def cubicOperator {n : ℕ} (P : MvPolynomial (Fin n) ℝ) : MvPolynomial (Fin n) ℝ := (∑ i : Fin n, (pderiv i P) ^ 2) * polynomialLaplacian P - ∑ i : Fin n, ∑ j : Fin n, pderiv i P * pderiv j P * pderiv i (pderiv j P) lemma minimalGraphOperator_eq_laplacian_add_cubic {n : ℕ} (P : MvPolynomial (Fin n) ℝ) : minimalGraphOperator P = polynomialLaplacian P + cubicOperator P := by unfold minimalGraphOperator cubicOperator polynomialLaplacian ring lemma totalDegree_second_partial_le (P : MvPolynomial σ ℝ) (d : ℕ) (h : P.totalDegree ≤ d + 2) (i j : σ) : (pderiv i (pderiv j P)).totalDegree ≤ d := by apply totalDegree_pderiv_le_of_totalDegree_le exact totalDegree_pderiv_le_of_totalDegree_le P j (d + 1) (by omega) lemma homogeneousComponent_second_partial (P : MvPolynomial σ ℝ) (d : ℕ) (i j : σ) : homogeneousComponent d (pderiv i (pderiv j P)) = pderiv i (pderiv j (homogeneousComponent (d + 2) P)) := by rw [← pderiv_homogeneousComponent, ← pderiv_homogeneousComponent] lemma homogeneousComponent_derivative_triple (P : MvPolynomial σ ℝ) (d : ℕ) (h : P.totalDegree ≤ d + 2) (i j k l : σ) : homogeneousComponent (3 * d + 2) (pderiv i P * pderiv j P * pderiv k (pderiv l P)) = pderiv i (homogeneousComponent (d + 2) P) * pderiv j (homogeneousComponent (d + 2) P) * pderiv k (pderiv l (homogeneousComponent (d + 2) P)) := by have hgi : (pderiv i P).totalDegree ≤ d + 1 := totalDegree_pderiv_le_of_totalDegree_le P i (d + 1) (by omega) have hgj : (pderiv j P).totalDegree ≤ d + 1 := totalDegree_pderiv_le_of_totalDegree_le P j (d + 1) (by omega) have hpair : (pderiv i P * pderiv j P).totalDegree ≤ (d + 1) + (d + 1) := (totalDegree_mul _ _).trans (Nat.add_le_add hgi hgj) have hkl := totalDegree_second_partial_le P d h k l rw [show 3 * d + 2 = ((d + 1) + (d + 1)) + d by omega, homogeneousComponent_mul_top _ _ _ _ hpair hkl, homogeneousComponent_mul_top _ _ _ _ hgi hgj, ← pderiv_homogeneousComponent, ← pderiv_homogeneousComponent, homogeneousComponent_second_partial] lemma homogeneousComponent_cubicOperator_top {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (d : ℕ) (h : P.totalDegree ≤ d + 2) : homogeneousComponent (3 * d + 2) (cubicOperator P) = cubicOperator (homogeneousComponent (d + 2) P) := by unfold cubicOperator polynomialLaplacian simp only [Finset.sum_mul, Finset.mul_sum, map_sub, map_sum, pow_two] simp_rw [homogeneousComponent_derivative_triple P d h] lemma homogeneousComponent_minimalGraphOperator_top {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (d : ℕ) (h : P.totalDegree ≤ d + 2) : homogeneousComponent (3 * d + 2) (minimalGraphOperator P) = cubicOperator (homogeneousComponent (d + 2) P) := by rw [minimalGraphOperator_eq_laplacian_add_cubic, map_add, homogeneousComponent_cubicOperator_top P d h] have hlap : (polynomialLaplacian P).totalDegree ≤ d := by apply totalDegree_finsetSum_le intro i hi exact totalDegree_second_partial_le P d h i i have hz : homogeneousComponent (3 * d + 2) (polynomialLaplacian P) = 0 := by apply homogeneousComponent_eq_zero omega rw [hz, zero_add] lemma cubicOperator_top_eq_zero {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (m : ℕ) (hm : 2 ≤ m) (hdeg : P.totalDegree ≤ m) (h : minimalGraphOperator P = 0) : cubicOperator (homogeneousComponent m P) = 0 := by obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm have ht := homogeneousComponent_minimalGraphOperator_top P d (by omega) rw [h, map_zero] at ht simpa [Nat.add_comm] using ht.symm /-- Every nonaffine polynomial minimal graph has a nonzero leading homogeneous component annihilated by the cubic part of the minimal graph operator. -/ theorem leading_component_data {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) : let F := homogeneousComponent P.totalDegree P F ≠ 0 ∧ F.IsHomogeneous P.totalDegree ∧ cubicOperator F = 0 := by refine ⟨top_homogeneousComponent_ne_zero P (by omega), homogeneousComponent_isHomogeneous _ _, ?_⟩ exact cubicOperator_top_eq_zero P P.totalDegree hdeg le_rfl hmin /-- The strict degree interval appearing in dimension eight contains no integer. -/ theorem no_integer_degree_between_three_and_four (d : ℕ) (hlower : (3 : ℝ) < d) (hupper : (d : ℝ) < 4) : False := by have hlower' : 3 < d := by exact_mod_cast hlower have hupper' : d < 4 := by exact_mod_cast hupper omega end QuarticPolynomialBasics end end ComponentPolynomialBasics /- Component: HomogeneousFactor.lean -/ /-! # Homogeneous factors of a nonzero homogeneous polynomial The proof encodes total degree by a new univariate parameter. The largest and smallest degrees of a nonzero product add, so a product supported in one degree forces each factor to be supported in one degree as well. -/ namespace Source29HomogeneousFactor open MvPolynomial open scoped BigOperators variable {σ R : Type*} [CommRing R] noncomputable def degreeEncoding : MvPolynomial σ R →+* Polynomial (MvPolynomial σ R) := eval₂Hom (Polynomial.C.comp C) (fun i => Polynomial.C (X i) * Polynomial.X) lemma degreeEncoding_monomial (e : σ →₀ ℕ) (c : R) : degreeEncoding (monomial e c) = Polynomial.monomial e.degree (monomial e c) := by classical rw [degreeEncoding, eval₂Hom_monomial] simp only [RingHom.comp_apply, Finsupp.prod, mul_pow, Finset.prod_mul_distrib, ← Polynomial.C_pow, ← map_prod, Finset.prod_pow_eq_pow_sum, ← Polynomial.C_mul_X_pow_eq_monomial] rw [← mul_assoc, ← Polynomial.C_mul] change Polynomial.C (C c * e.prod (fun i k => X i ^ k)) * Polynomial.X ^ e.degree = Polynomial.C (monomial e c) * Polynomial.X ^ e.degree rw [← monomial_eq] lemma coeff_degreeEncoding (P : MvPolynomial σ R) (d : ℕ) : (degreeEncoding P).coeff d = homogeneousComponent d P := by classical induction P using MvPolynomial.induction_on' with | monomial e c => rw [degreeEncoding_monomial, Polynomial.coeff_monomial, homogeneousComponent_of_mem (isHomogeneous_monomial c rfl)] simp [eq_comm] | add P Q hP hQ => simp only [map_add, Polynomial.coeff_add, hP, hQ] lemma degreeEncoding_ne_zero {P : MvPolynomial σ R} (hP : P ≠ 0) : degreeEncoding P ≠ 0 := by intro hzero apply hP rw [← sum_homogeneousComponent P] apply Finset.sum_eq_zero intro d hd rw [← coeff_degreeEncoding, hzero, Polynomial.coeff_zero] lemma degreeEncoding_of_homogeneous {P : MvPolynomial σ R} {m : ℕ} (hP : P.IsHomogeneous m) : degreeEncoding P = Polynomial.monomial m P := by ext d rw [coeff_degreeEncoding, homogeneousComponent_of_mem hP, Polynomial.coeff_monomial] simp [eq_comm] lemma homogeneous_of_encoding_equal_degrees {P : MvPolynomial σ R} (hdegree : (degreeEncoding P).natDegree = (degreeEncoding P).natTrailingDegree) : P.IsHomogeneous (degreeEncoding P).natDegree := by classical intro e he change (Finsupp.weight fun _ : σ => (1 : ℕ)) e = _ rw [← Finsupp.degree_eq_weight_one] have hcoeff : (degreeEncoding P).coeff e.degree ≠ 0 := by rw [coeff_degreeEncoding] intro hz have h := congrArg (fun Q : MvPolynomial σ R => Q.coeff e) hz apply he simpa [coeff_homogeneousComponent] using h have hlo := Polynomial.natTrailingDegree_le_of_ne_zero hcoeff have hhi := Polynomial.le_natDegree_of_ne_zero hcoeff omega variable [IsDomain R] /-- Every factor of a nonzero homogeneous product is homogeneous. -/ theorem left_factor_isHomogeneous (P Q : MvPolynomial σ R) {m : ℕ} (hne : P * Q ≠ 0) (hhom : (P * Q).IsHomogeneous m) : P.IsHomogeneous P.totalDegree := by have hP : P ≠ 0 := left_ne_zero_of_mul hne have hQ : Q ≠ 0 := right_ne_zero_of_mul hne have hA := degreeEncoding_ne_zero hP have hB := degreeEncoding_ne_zero hQ have heq : degreeEncoding P * degreeEncoding Q = Polynomial.monomial m (P * Q) := by rw [← map_mul] exact degreeEncoding_of_homogeneous hhom have htop := congrArg Polynomial.natDegree heq rw [Polynomial.natDegree_mul hA hB, Polynomial.natDegree_monomial_eq m hne] at htop have hbottom := congrArg Polynomial.natTrailingDegree heq rw [Polynomial.natTrailingDegree_mul hA hB, Polynomial.natTrailingDegree_monomial hne] at hbottom have hAle := Polynomial.natTrailingDegree_le_natDegree (degreeEncoding P) have hBle := Polynomial.natTrailingDegree_le_natDegree (degreeEncoding Q) have hsame : (degreeEncoding P).natDegree = (degreeEncoding P).natTrailingDegree := by omega have hhomP := homogeneous_of_encoding_equal_degrees hsame simpa only [hhomP.totalDegree hP] using hhomP /-- A divisor of a nonzero homogeneous polynomial is homogeneous of its total degree. -/ theorem divisor_isHomogeneous (F h : MvPolynomial σ R) {m : ℕ} (hne : F ≠ 0) (hhom : F.IsHomogeneous m) (hdiv : h ∣ F) : h.IsHomogeneous h.totalDegree := by obtain ⟨g, rfl⟩ := hdiv exact left_factor_isHomogeneous h g hne hhom end Source29HomogeneousFactor /- Component: FactorInheritance.lean -/ namespace Source29FactorInheritance open scoped BigOperators open MvPolynomial section Algebra variable {R ι : Type*} [CommRing R] [Fintype ι] noncomputable def form (g : ι → R) (U : ι → ι → R) : R := ∑ i, ∑ j, (g i ^ 2 * U j j - g i * g j * U i j) lemma form_scaled (s t : R) (g : ι → R) (U : ι → ι → R) : form (fun i => s * g i) (fun i j => t * U i j) = s ^ 2 * t * form g U := by simp only [form, Finset.mul_sum] apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro j hj ring noncomputable def remainderPair (t k v : R) (g b : ι → R) (U V : ι → ι → R) (i j : ι) : R := (k^2*v^2*g i^2*V j j + 2*k^2*v*g i*b i*(v*U j j+2*g j*b j) + k*(k-1)*v*b i^2*g j^2 - k^2*v^2*g i*g j*V i j - k^2*v*(g i*b j+g j*b i)*(v*U i j+g i*b j+g j*b i) - k*(k-1)*v*b i*b j*g i*g j) + t * (2*k*v*g i*b i*V j j + k*b i^2*(v*U j j+2*g j*b j) - k*v*(g i*b j+g j*b i)*V i j - k*b i*b j*(v*U i j+g i*b j+g j*b i)) + t^2*(b i^2*V j j-b i*b j*V i j) lemma form_normalized (t k v : R) (g b : ι → R) (U V : ι → ι → R) : ∃ r : R, form (fun i => k*v*g i+t*b i) (fun i j => k*(k-1)*v*g i*g j + t*k*(v*U i j+g i*b j+g j*b i)+t^2*V i j) = t*(k^3*v^3*form g U+t*r) := by classical let r := ∑ i, ∑ j, remainderPair t k v g b U V i j refine ⟨r, ?_⟩ have hcross : (∑ i, ∑ j, (g i^2*g j*b j-g i*g j^2*b i)) = 0 := by simp only [Finset.sum_sub_distrib, sub_eq_zero] rw [Finset.sum_comm] apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro j hj ring calc _ = ∑ i, ∑ j, t * (k^3*v^3*(g i^2*U j j-g i*g j*U i j) + k^2*v^2*(g i^2*g j*b j-g i*g j^2*b i) + t*remainderPair t k v g b U V i j) := by unfold form apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro j hj dsimp [remainderPair] ring _ = t*(k^3*v^3*form g U + k^2*v^2* (∑ i, ∑ j, (g i^2*g j*b j-g i*g j^2*b i)) + t*r) := by simp only [r, form, mul_add, Finset.sum_add_distrib, ← Finset.mul_sum] _ = _ := by rw [hcross]; ring end Algebra section Polynomial variable {R ι : Type*} [CommRing R] [Fintype ι] noncomputable def cubicOperator (f : MvPolynomial ι R) : MvPolynomial ι R := (∑ i, (pderiv i f)^2)*(∑ j, pderiv j (pderiv j f)) - ∑ i, ∑ j, pderiv i f*pderiv j f*pderiv i (pderiv j f) lemma cubicOperator_eq_form (f : MvPolynomial ι R) : cubicOperator f = form (fun i => pderiv i f) (fun i j => pderiv i (pderiv j f)) := by simp only [cubicOperator, form, Finset.sum_sub_distrib, Finset.sum_mul, Finset.mul_sum] rw [Finset.sum_comm] lemma scaled_pderiv_pow_mul (h v : MvPolynomial ι R) (a : ℕ) (i : ι) : h * pderiv i (h^a*v) = h^a * ((a : MvPolynomial ι R)*v*pderiv i h + h*pderiv i v) := by cases a with | zero => simp | succ a => rw [pderiv_mul, pderiv_pow, Nat.succ_sub_one] simp only [pow_succ, Nat.cast_add, Nat.cast_one] ring lemma scaled_pderiv_pow (h : MvPolynomial ι R) (a : ℕ) (i : ι) : h * pderiv i (h^a) = h^a * (a : MvPolynomial ι R) * pderiv i h := by simpa only [mul_one, pderiv_one, mul_zero, add_zero, mul_assoc] using scaled_pderiv_pow_mul h 1 a i lemma scaled_second_pderiv_pow_mul (h v : MvPolynomial ι R) (a : ℕ) (i j : ι) : h^2 * pderiv i (pderiv j (h^a*v)) = h^a * ((a : MvPolynomial ι R)*((a : MvPolynomial ι R)-1)*v*pderiv i h*pderiv j h + h*(a : MvPolynomial ι R)*(v*pderiv i (pderiv j h) + pderiv i h*pderiv j v + pderiv j h*pderiv i v) + h^2*pderiv i (pderiv j v)) := by let F := h^a*v have hg : h*pderiv j F = h^a*((a : MvPolynomial ι R)*v*pderiv j h+ h*pderiv j v) := scaled_pderiv_pow_mul h v a j have hd := congrArg (pderiv i) hg simp only [pderiv_mul, map_add, Derivation.map_natCast, zero_mul, zero_add] at hd have hp := scaled_pderiv_pow h a i change h^2*pderiv i (pderiv j F) = _ linear_combination h * hd - (pderiv i h) * hg + ((a : MvPolynomial ι R)*v*pderiv j h + h*pderiv j v) * hp /-- A denominator-free form of factor inheritance, valid for every multiplicity. -/ lemma scaled_cubicOperator_pow_mul (h v : MvPolynomial ι R) (a : ℕ) : ∃ r : MvPolynomial ι R, h^4 * cubicOperator (h^a*v) = (h^a)^3*h*((a : MvPolynomial ι R)^3*v^3*cubicOperator h+h*r) := by obtain ⟨r, hr⟩ := form_normalized h (a : MvPolynomial ι R) v (fun i => pderiv i h) (fun i => pderiv i v) (fun i j => pderiv i (pderiv j h)) (fun i j => pderiv i (pderiv j v)) refine ⟨r, ?_⟩ calc _ = form (fun i => h*pderiv i (h^a*v)) (fun i j => h^2*pderiv i (pderiv j (h^a*v))) := by rw [form_scaled, ← cubicOperator_eq_form] ring _ = form (fun i => h^a*((a : MvPolynomial ι R)*v*pderiv i h+h*pderiv i v)) (fun i j => h^a*((a : MvPolynomial ι R)*((a : MvPolynomial ι R)-1)*v* pderiv i h*pderiv j h + h*(a : MvPolynomial ι R)* (v*pderiv i (pderiv j h)+pderiv i h*pderiv j v+pderiv j h*pderiv i v)+ h^2*pderiv i (pderiv j v))) := by simp_rw [scaled_pderiv_pow_mul, scaled_second_pderiv_pow_mul] _ = _ := by rw [form_scaled, hr, ← cubicOperator_eq_form] ring /-- The exact multiplicity identity stated in the proof candidate. -/ lemma cubicOperator_pow_mul [IsDomain R] (h v : MvPolynomial ι R) (a : ℕ) (ha : 1 ≤ a) (hh : h ≠ 0) : ∃ r : MvPolynomial ι R, cubicOperator (h^a*v) = h^(3*a-3)*((a : MvPolynomial ι R)^3*v^3*cubicOperator h+h*r) := by obtain ⟨r, hr⟩ := scaled_cubicOperator_pow_mul h v a refine ⟨r, ?_⟩ apply mul_left_cancel₀ (pow_ne_zero 4 hh) rw [hr] have hp : (h^a)^3*h = h^(3*a+1) := by rw [← pow_mul, ← pow_succ] congr 1 omega rw [hp, ← mul_assoc, ← pow_add] congr 2 omega end Polynomial /-- Every irreducible factor of a polynomial annihilated by the cubic operator inherits the operator equation modulo that factor, with arbitrary multiplicity. -/ theorem factor_inheritance {ι : Type*} [Fintype ι] (h v : MvPolynomial ι ℂ) (a : ℕ) (ha : 1 ≤ a) (hh : Irreducible h) (hv : ¬h ∣ v) (hF : cubicOperator (h^a*v) = 0) : h ∣ cubicOperator h := by obtain ⟨r, hr⟩ := scaled_cubicOperator_pow_mul h v a have hz : (h^a)^3*h*((a : MvPolynomial ι ℂ)^3*v^3*cubicOperator h+h*r) = 0 := by rw [← hr, hF, mul_zero] have hnz : (h^a)^3*h ≠ 0 := mul_ne_zero (pow_ne_zero _ (pow_ne_zero _ hh.ne_zero)) hh.ne_zero have hb := (mul_eq_zero.mp hz).resolve_left hnz have hd : h ∣ (a : MvPolynomial ι ℂ)^3*v^3*cubicOperator h := by refine ⟨-r, ?_⟩ linear_combination hb have hau : IsUnit (a : MvPolynomial ι ℂ) := by have hauc : IsUnit (a : ℂ) := isUnit_iff_ne_zero.mpr (Nat.cast_ne_zero.mpr (by omega)) simpa using hauc.map (C : ℂ →+* MvPolynomial ι ℂ) have hprime := hh.prime rcases hprime.dvd_or_dvd hd with hleft | hright · rcases hprime.dvd_or_dvd hleft with hnat | hpow · exact False.elim (hh.not_dvd_isUnit (hau.pow 3) hnat) · exact False.elim (hv (hprime.dvd_of_dvd_pow hpow)) · exact hright end Source29FactorInheritance /- Component: QuadricIrreducible.lean -/ namespace Source29Quadric open MvPolynomial open scoped BigOperators Polynomial /- The following compatibility lemma is adapted from Mathlib/RingTheory/MvPolynomial/IrreducibleQuadratic.lean. Copyright (c) 2025 Antoine Chambert-Loir. All rights reserved. Released under Apache 2.0 license as described in mathlib's LICENSE. Authors: Antoine Chambert-Loir, Johan Commelin, Andrew Yang. -/ lemma irreducible_mul_X_add {n R : Type*} [CommRing R] [IsDomain R] (f g : MvPolynomial n R) (i : n) (hf0 : f ≠ 0) (hif : i ∉ f.vars) (hig : i ∉ g.vars) (h : IsRelPrime f g) : Irreducible (f * X i + g) := by classical let S := MvPolynomial { j // j ≠ i } R let e : MvPolynomial n R ≃ₐ[R] S[X] := (renameEquiv R (Equiv.optionSubtypeNe i).symm).trans (optionEquivLeft R _) have he : e.symm.toAlgHom.comp Polynomial.CAlgHom = rename (↑) := by ext simp [e, S, MvPolynomial.optionEquivLeft_X_none] obtain ⟨f, rfl⟩ : f ∈ (e.symm.toAlgHom.comp Polynomial.CAlgHom).range := he ▸ exists_rename_eq_of_vars_subset_range _ _ Subtype.val_injective (by simpa [Set.subset_def]) obtain ⟨g, rfl⟩ : g ∈ (e.symm.toAlgHom.comp Polynomial.CAlgHom).range := he ▸ exists_rename_eq_of_vars_subset_range _ _ Subtype.val_injective (by simpa [Set.subset_def]) refine .of_map (f := e) ?_ simpa [e, S, MvPolynomial.optionEquivLeft_X_none] using Polynomial.irreducible_C_mul_X_add_C (by aesop) (IsRelPrime.of_map Polynomial.C (IsRelPrime.of_map e.symm h)) abbrev Poly := MvPolynomial (Fin 8) ℂ noncomputable def tailQuadric : Poly := X 2^2 + X 3^2 + X 4^2 + X 5^2 + X 6^2 + X 7^2 lemma tailQuadric_no_zero_var : (0 : Fin 8) ∉ tailQuadric.vars := by have hsum {p q : Poly} (hp : (0 : Fin 8) ∉ p.vars) (hq : (0 : Fin 8) ∉ q.vars) : (0 : Fin 8) ∉ (p+q).vars := by intro hm exact (Finset.mem_union.mp (vars_add_subset p q hm)).elim hp hq have hp (i : Fin 8) (hi : (0 : Fin 8) ≠ i) : (0 : Fin 8) ∉ (X i ^ 2 : Poly).vars := by intro hm have hx := vars_pow (X i : Poly) 2 hm simpa [hi] using hx exact hsum (hsum (hsum (hsum (hsum (hp 2 (by decide)) (hp 3 (by decide))) (hp 4 (by decide))) (hp 5 (by decide))) (hp 6 (by decide))) (hp 7 (by decide)) lemma X_one_not_dvd_tail : ¬ (X (1 : Fin 8) : Poly) ∣ tailQuadric := by rintro ⟨p, hp⟩ have he := congrArg (eval (fun i : Fin 8 => if i = 2 then (1 : ℂ) else 0)) hp norm_num [tailQuadric] at he lemma splitQuadric_irreducible : Irreducible (X (1 : Fin 8) * X 0 + tailQuadric) := by apply irreducible_mul_X_add · exact X_ne_zero 1 · simp · exact tailQuadric_no_zero_var · exact (X_prime (R := ℂ) (i := (1 : Fin 8))).irreducible.isRelPrime_iff_not_dvd.mpr X_one_not_dvd_tail lemma half_mul_two : C (1/2 : ℂ) * (2 : Poly) = 1 := by have hh := congrArg (C : ℂ →+* Poly) (show (1/2 : ℂ)*2=1 by norm_num) simpa only [map_mul, map_ofNat, map_one] using hh noncomputable def forward : Poly →ₐ[ℂ] Poly := aeval (fun i : Fin 8 => if i = 0 then X 0 + C Complex.I * X 1 else if i = 1 then X 0 - C Complex.I * X 1 else X i) noncomputable def backward : Poly →ₐ[ℂ] Poly := aeval (fun i : Fin 8 => if i = 0 then C (1/2 : ℂ) * (X 0 + X 1) else if i = 1 then -C Complex.I * C (1/2 : ℂ) * (X 0 - X 1) else X i) lemma forward_backward : forward.comp backward = AlgHom.id ℂ Poly := by apply MvPolynomial.algHom_ext intro i fin_cases i <;> simp [forward, backward] all_goals ring_nf all_goals norm_num [← map_pow, Complex.I_sq] all_goals first | linear_combination (X 0 : Poly)*half_mul_two | linear_combination (X 1 : Poly)*half_mul_two lemma backward_forward : backward.comp forward = AlgHom.id ℂ Poly := by apply MvPolynomial.algHom_ext intro i fin_cases i <;> simp [forward, backward] all_goals ring_nf all_goals norm_num [← map_pow, Complex.I_sq] all_goals first | linear_combination (X 0 : Poly)*half_mul_two | linear_combination (X 1 : Poly)*half_mul_two noncomputable def splitEquiv : Poly ≃ₐ[ℂ] Poly := AlgEquiv.ofAlgHom forward backward forward_backward backward_forward noncomputable def quadric : Poly := ∑ i : Fin 8, X i^2 lemma forward_splitQuadric : forward (X (1 : Fin 8)*X 0+tailQuadric) = quadric := by simp [forward, tailQuadric, quadric, Fin.sum_univ_succ] ring_nf norm_num [← map_pow, Complex.I_sq] theorem quadric_irreducible : Irreducible quadric := by have hh := splitQuadric_irreducible.map splitEquiv change Irreducible (forward _) at hh rwa [forward_splitQuadric] at hh end Source29Quadric /- Component: RadialIdentity.lean -/ namespace Source29Radial open Finset variable {R ι : Type*} [CommRing R] [Fintype ι] [DecidableEq ι] def dot (u v : ι → R) : R := ∑ i, u i * v i def trace (H : ι → ι → R) : R := ∑ i, H i i def contract (H : ι → ι → R) (u v : ι → R) : R := ∑ i, ∑ j, u i * v j * H i j def jetL (u : ι → R) (H : ι → ι → R) : R := dot u u * trace H - contract H u u lemma dot_add_left (u v w : ι → R) : dot (fun i => u i + v i) w = dot u w + dot v w := by simp [dot, add_mul, Finset.sum_add_distrib] lemma dot_add_right (u v w : ι → R) : dot u (fun i => v i + w i) = dot u v + dot u w := by simp [dot, mul_add, Finset.sum_add_distrib] lemma dot_mul_left (a : R) (u v : ι → R) : dot (fun i => a * u i) v = a * dot u v := by simp [dot, mul_assoc, Finset.mul_sum] lemma dot_mul_right (a : R) (u v : ι → R) : dot u (fun i => a * v i) = a * dot u v := by simp [dot, ← mul_assoc, mul_comm _ a, Finset.mul_sum] lemma dot_comm (u v : ι → R) : dot u v = dot v u := by simp [dot, mul_comm] lemma contract_add_left (H : ι → ι → R) (u v w : ι → R) : contract H (fun i => u i + v i) w = contract H u w + contract H v w := by simp [contract, add_mul, Finset.sum_add_distrib] lemma contract_add_right (H : ι → ι → R) (u v w : ι → R) : contract H u (fun i => v i + w i) = contract H u v + contract H u w := by simp [contract, mul_add, add_mul, Finset.sum_add_distrib] lemma contract_mul_left (H : ι → ι → R) (a : R) (u v : ι → R) : contract H (fun i => a * u i) v = a * contract H u v := by simp [contract, mul_assoc, Finset.mul_sum] lemma contract_mul_right (H : ι → ι → R) (a : R) (u v : ι → R) : contract H u (fun i => a * v i) = a * contract H u v := by simp [contract, ← mul_assoc, mul_comm _ a, Finset.mul_sum] lemma contract_add_matrix (H K : ι → ι → R) (u v : ι → R) : contract (fun i j => H i j + K i j) u v = contract H u v + contract K u v := by simp [contract, mul_add, Finset.sum_add_distrib] lemma contract_mul_matrix (a : R) (H : ι → ι → R) (u v : ι → R) : contract (fun i j => a * H i j) u v = a * contract H u v := by simp [contract, ← mul_assoc, mul_comm _ a, Finset.mul_sum] lemma contract_outer (x y u v : ι → R) : contract (fun i j => x i * y j) u v = dot u x * dot v y := by unfold contract dot rw [Finset.sum_mul] simp only [Finset.mul_sum] apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro j hj ring lemma contract_identity (u v : ι → R) : contract (fun i j => if i = j then (1 : R) else 0) u v = dot u v := by classical simp [contract, dot] lemma trace_add (H K : ι → ι → R) : trace (fun i j => H i j + K i j) = trace H + trace K := by simp [trace, Finset.sum_add_distrib] lemma trace_mul (a : R) (H : ι → ι → R) : trace (fun i j => a * H i j) = a * trace H := by simp [trace, Finset.mul_sum] lemma trace_outer (x y : ι → R) : trace (fun i j => x i * y j) = dot x y := rfl lemma trace_identity : trace (fun i j : ι => if i = j then (1 : R) else 0) = (Fintype.card ι : R) := by simp [trace] lemma contract_right_action (H : ι → ι → R) (u v : ι → R) : contract H u v = dot u (fun i => ∑ j, H i j * v j) := by simp only [contract, dot, Finset.mul_sum] apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro j hj ring lemma contract_symm (H : ι → ι → R) (hH : ∀ i j, H i j = H j i) (u v : ι → R) : contract H u v = contract H v u := by unfold contract rw [Finset.sum_comm] apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro j hj rw [hH] ring /-- The scaled gradient factor in q * grad(q^a g) = q^a * radialGradient. -/ def radialGradient (a q g : R) (z b : ι → R) : ι → R := fun i => q * b i + (2 * a * g) * z i /-- The scaled Hessian factor in q^2 * Hess(q^a g) = q^a * radialHessian. -/ def radialHessian (a q g : R) (z b : ι → R) (H : ι → ι → R) : ι → ι → R := fun i j => q^2 * H i j + (2 * a * q) * (z i * b j + b i * z j + g * (if i = j then 1 else 0)) + (4 * a * (a - 1) * g) * (z i * z j) lemma radialGradient_dot (a q g d : R) (z b : ι → R) (hq : dot z z = q) (hd : dot z b = d * g) : dot (radialGradient a q g z b) (radialGradient a q g z b) = q^2 * dot b b + 4 * a * (a + d) * q * g^2 := by have hd' : dot b z = d * g := (dot_comm b z).trans hd unfold radialGradient simp only [ dot_add_left, dot_add_right, dot_mul_left, dot_mul_right, hq, hd, hd'] ring lemma radialGradient_dot_z (a q g d : R) (z b : ι → R) (hq : dot z z = q) (hd : dot z b = d * g) : dot (radialGradient a q g z b) z = q * g * (d + 2 * a) := by have hd' : dot b z = d * g := (dot_comm b z).trans hd unfold radialGradient simp only [ dot_add_left, dot_mul_left, hq, hd'] ring lemma radialGradient_dot_b (a q g d : R) (z b : ι → R) (hd : dot z b = d * g) : dot (radialGradient a q g z b) b = q * dot b b + 2 * a * d * g^2 := by unfold radialGradient simp only [ dot_add_left, dot_mul_left, hd] ring lemma radialHessian_trace (a q g d : R) (z b : ι → R) (H : ι → ι → R) (hq : dot z z = q) (hd : dot z b = d * g) : trace (radialHessian a q g z b H) = q^2 * trace H + 2 * a * q * (2 * d + Fintype.card ι + 2 * a - 2) * g := by have hd' : dot b z = d * g := (dot_comm b z).trans hd unfold radialHessian simp only [ trace_add, trace_mul, trace_outer, trace_identity, hq, hd, hd'] ring lemma radialGradient_contract (a q g d : R) (z b : ι → R) (H : ι → ι → R) (hH : ∀ i j, H i j = H j i) (hd : dot z b = d * g) (hEuler : ∀ i, (∑ j, H i j * z j) = (d - 1) * b i) : contract H (radialGradient a q g z b) (radialGradient a q g z b) = q^2 * contract H b b + 4 * a * (d - 1) * q * g * dot b b + 4 * a^2 * d * (d - 1) * g^3 := by have hbz : contract H b z = (d - 1) * dot b b := by rw [contract_right_action] simp only [hEuler, dot_mul_right] have hzb : contract H z b = (d - 1) * dot b b := by rw [contract_symm H hH z b, hbz] have hzz : contract H z z = (d - 1) * d * g := by rw [contract_right_action] simp only [hEuler, dot_mul_right, hd] ring unfold radialGradient simp only [ contract_add_left, contract_add_right, contract_mul_left, contract_mul_right, hbz, hzb, hzz] ring /-- Division-free finite-dimensional contraction form of equation (12) in the candidate. The two Euler hypotheses are the first and differentiated Euler identities for g. The formula is valid over every commutative ring, including at q=0. -/ theorem radial_jet_identity (a q g d : R) (z b : ι → R) (H : ι → ι → R) (hq : dot z z = q) (hd : dot z b = d * g) (hH : ∀ i j, H i j = H j i) (hEuler : ∀ i, (∑ j, H i j * z j) = (d - 1) * b i) : jetL (radialGradient a q g z b) (radialHessian a q g z b H) = q^2 * (q^2 * jetL b H + 2 * a * (Fintype.card ι - 2 * d - 1 - 2 * a) * q * g * dot b b + 4 * a * (a + d) * q * g^2 * trace H + 4 * a * (a + d) * (2 * a * (Fintype.card ι - 1) + d) * g^3) := by unfold jetL rw [radialGradient_dot a q g d z b hq hd, radialHessian_trace a q g d z b H hq hd] unfold radialHessian simp only [ contract_add_matrix, contract_mul_matrix, contract_outer, contract_identity] rw [radialGradient_contract a q g d z b H hH hd hEuler, radialGradient_dot_z a q g d z b hq hd, radialGradient_dot_b a q g d z b hd, radialGradient_dot a q g d z b hq hd] ring lemma jetL_scale (r s : R) (u : ι → R) (H : ι → ι → R) : jetL (fun i => r * u i) (fun i j => s * H i j) = r^2 * s * jetL u H := by unfold jetL simp only [dot_mul_left, dot_mul_right, trace_mul, contract_mul_matrix, contract_mul_left, contract_mul_right] ring section Polynomial open MvPolynomial Finsupp noncomputable def radialPolynomial : MvPolynomial ι R := ∑ i : ι, (X i)^2 lemma pderiv_radialPolynomial (i : ι) : pderiv i (radialPolynomial : MvPolynomial ι R) = 2 * X i := by classical simp [radialPolynomial, pderiv_pow, pderiv_X, Pi.single_apply] noncomputable def polynomialL (g : MvPolynomial ι R) : MvPolynomial ι R := jetL (fun i => pderiv i g) (fun i j => pderiv i (pderiv j g)) lemma scaled_first_partial (a : ℕ) (g : MvPolynomial ι R) (i : ι) : radialPolynomial * pderiv i (radialPolynomial^a * g) = radialPolynomial^a * radialGradient (a : MvPolynomial ι R) radialPolynomial g X (fun j => pderiv j g) i := by cases a with | zero => simp [radialGradient] | succ a => rw [pderiv_mul, pderiv_pow, pderiv_radialPolynomial] simp only [Nat.succ_sub_one, pow_succ, radialGradient, Nat.cast_succ] ring lemma pderiv_natCast (n : ℕ) (i : ι) : pderiv i (n : MvPolynomial ι R) = 0 := by simpa only [map_natCast] using (pderiv_C (a := (n : R)) (i := i)) lemma scaled_second_partial (a : ℕ) (g : MvPolynomial ι R) (i j : ι) : radialPolynomial^2 * pderiv i (pderiv j (radialPolynomial^a * g)) = radialPolynomial^a * radialHessian (a : MvPolynomial ι R) radialPolynomial g X (fun k => pderiv k g) (fun k l => pderiv k (pderiv l g)) i j := by have htwo : pderiv i (2 : MvPolynomial ι R) = 0 := pderiv_natCast 2 i cases a with | zero => simp [radialHessian] | succ a => cases a with | zero => simp only [pow_one, Nat.cast_one, pderiv_mul, map_add, pderiv_radialPolynomial, pderiv_natCast, htwo, zero_mul, zero_add, pderiv_X, Pi.single_apply, radialHessian] by_cases hij : i = j · subst j; simp; ring · simp [hij, Ne.symm hij]; ring | succ a => simp only [pderiv_mul, pderiv_pow, Nat.succ_sub_one, map_add, pderiv_radialPolynomial, pderiv_natCast, htwo, zero_mul, zero_add, pderiv_X, Pi.single_apply, radialHessian] simp only [pow_succ, Nat.cast_succ] by_cases hij : i = j · subst j; simp; ring · simp [hij, Ne.symm hij]; ring lemma polynomial_second_partial_comm (g : MvPolynomial ι R) (i j : ι) : pderiv i (pderiv j g) = pderiv j (pderiv i g) := by classical ext r simp only [coeff_pderiv] by_cases h : i = j · subst j; rfl · simp [h, Ne.symm h, add_right_comm, mul_right_comm] /- This Euler proof is adapted from Mathlib/RingTheory/MvPolynomial/EulerIdentity.lean. Copyright (c) 2024 Junyan Xu. Apache 2.0 license. -/ lemma weighted_euler {g : MvPolynomial ι R} {w : ι → ℕ} {d : ℕ} (h : g.IsWeightedHomogeneous w d) : ∑ i : ι, w i • (X i * pderiv i g) = d • g := by rw [← mem_weightedHomogeneousSubmodule, weightedHomogeneousSubmodule_eq_finsupp_supported, AddMonoidAlgebra.supported_eq_span_single] at h refine Submodule.span_induction ?_ ?_ (fun p q _ _ hp hq ↦ ?_) (fun r p _ h ↦ ?_) h · rintro _ ⟨m, hm, rfl⟩ simp_rw [single_eq_monomial, X_mul_pderiv_monomial, smul_smul, ← sum_smul, mul_comm (w _)] congr rwa [Set.mem_ofPred, Finsupp.weight_apply, Finsupp.sum_fintype] at hm intro; apply zero_smul · simp · simp_rw [map_add, left_distrib, smul_add, sum_add_distrib, hp, hq] · simp_rw [(pderiv _).map_smul, nsmul_eq_mul, mul_smul_comm, ← Finset.smul_sum, ← nsmul_eq_mul, h] lemma homogeneous_euler {g : MvPolynomial ι R} {d : ℕ} (h : g.IsHomogeneous d) : dot X (fun i => pderiv i g) = (d : MvPolynomial ι R) * g := by have he := weighted_euler h simpa [dot, nsmul_eq_mul] using he lemma differentiated_euler {g : MvPolynomial ι R} {d : ℕ} (h : dot X (fun i => pderiv i g) = (d : MvPolynomial ι R) * g) (i : ι) : (∑ j, pderiv i (pderiv j g) * X j) = ((d : MvPolynomial ι R) - 1) * pderiv i g := by have hd := congrArg (pderiv i) h simp only [dot, map_sum, pderiv_mul, pderiv_X] at hd have hc : pderiv i (d : MvPolynomial ι R) = 0 := by simpa only [map_natCast] using (pderiv_C (a := (d : R)) (i := i)) rw [hc, zero_mul, zero_add] at hd simp only [Finset.sum_add_distrib, Pi.single_apply, ite_mul, one_mul, zero_mul, Finset.sum_ite_eq', Finset.mem_univ, ite_true] at hd calc (∑ j, pderiv i (pderiv j g) * X j) = ∑ j, X j * pderiv i (pderiv j g) := by apply Finset.sum_congr rfl intro j hj ring _ = ((d : MvPolynomial ι R) - 1) * pderiv i g := by linear_combination hd lemma radialPolynomial_ne_zero [IsDomain R] [Nonempty ι] : (radialPolynomial : MvPolynomial ι R) ≠ 0 := by classical obtain ⟨i⟩ := ‹Nonempty ι› intro h have he := congrArg (eval (Pi.single i (1 : R))) h simpa [radialPolynomial, Pi.single_apply] using he theorem radial_polynomial_identity [IsDomain R] [Nonempty ι] (a d : ℕ) (ha : 1 ≤ a) (g : MvPolynomial ι R) (hg : g.IsHomogeneous d) : polynomialL (radialPolynomial^a * g) = radialPolynomial^(3*a-2) * (radialPolynomial^2 * polynomialL g + 2 * (a : MvPolynomial ι R) * ((Fintype.card ι : MvPolynomial ι R) - 2 * (d : MvPolynomial ι R) - 1 - 2 * (a : MvPolynomial ι R)) * radialPolynomial * g * dot (fun i => pderiv i g) (fun i => pderiv i g) + 4 * (a : MvPolynomial ι R) * ((a : MvPolynomial ι R) + (d : MvPolynomial ι R)) * radialPolynomial * g^2 * trace (fun i j => pderiv i (pderiv j g)) + 4 * (a : MvPolynomial ι R) * ((a : MvPolynomial ι R) + (d : MvPolynomial ι R)) * (2 * (a : MvPolynomial ι R) * ((Fintype.card ι : MvPolynomial ι R) - 1) + (d : MvPolynomial ι R)) * g^3) := by let q : MvPolynomial ι R := radialPolynomial let u : ι → MvPolynomial ι R := fun i => pderiv i g let H : ι → ι → MvPolynomial ι R := fun i j => pderiv i (pderiv j g) let F : MvPolynomial ι R := q^a * g have hgrad : (fun i => q * pderiv i F) = (fun i => q^a * radialGradient (a : MvPolynomial ι R) q g X u i) := by funext i exact scaled_first_partial a g i have hhess : (fun i j => q^2 * pderiv i (pderiv j F)) = (fun i j => q^a * radialHessian (a : MvPolynomial ι R) q g X u H i j) := by funext i j exact scaled_second_partial a g i j have heuler : dot X u = (d : MvPolynomial ι R) * g := homogeneous_euler hg have hformula := radial_jet_identity (a : MvPolynomial ι R) q g (d : MvPolynomial ι R) X u H (by simp [dot, q, radialPolynomial, pow_two]) heuler (polynomial_second_partial_comm g) (differentiated_euler heuler) have hscaled : q^4 * polynomialL F = q^(3*a) * jetL (radialGradient (a : MvPolynomial ι R) q g X u) (radialHessian (a : MvPolynomial ι R) q g X u H) := by calc q^4 * polynomialL F = jetL (fun i => q * pderiv i F) (fun i j => q^2 * pderiv i (pderiv j F)) := by rw [jetL_scale] unfold polynomialL ring _ = jetL (fun i => q^a * radialGradient (a : MvPolynomial ι R) q g X u i) (fun i j => q^a * radialHessian (a : MvPolynomial ι R) q g X u H i j) := by rw [hgrad, hhess] _ = q^(3*a) * jetL (radialGradient (a : MvPolynomial ι R) q g X u) (radialHessian (a : MvPolynomial ι R) q g X u H) := by rw [jetL_scale, show 3*a = a*3 by omega, pow_mul] ring have hpower : q^(3*a) * q^2 = q^4 * q^(3*a-2) := by rw [← pow_add, ← pow_add] congr 1 omega apply mul_left_cancel₀ (pow_ne_zero 4 (radialPolynomial_ne_zero (R := R) (ι := ι))) change q^4 * polynomialL F = _ rw [hscaled, hformula] rw [← mul_assoc, hpower, mul_assoc] rfl noncomputable def radialCoefficient (a d : ℕ) : MvPolynomial ι R := 4 * (a : MvPolynomial ι R) * ((a : MvPolynomial ι R) + (d : MvPolynomial ι R)) * (2 * (a : MvPolynomial ι R) * ((Fintype.card ι : MvPolynomial ι R) - 1) + (d : MvPolynomial ι R)) /-- Reduction of the radial identity modulo the prime radial polynomial. -/ theorem radial_factor_descent [IsDomain R] [Nonempty ι] (a d : ℕ) (ha : 1 ≤ a) (g : MvPolynomial ι R) (hg : g.IsHomogeneous d) (hqPrime : Prime (radialPolynomial : MvPolynomial ι R)) (hcUnit : IsUnit (radialCoefficient (R := R) (ι := ι) a d)) (hL : polynomialL (radialPolynomial^a * g) = 0) : (radialPolynomial : MvPolynomial ι R) ∣ g := by let q : MvPolynomial ι R := radialPolynomial let c : MvPolynomial ι R := radialCoefficient a d let t : MvPolynomial ι R := q * polynomialL g + 2 * (a : MvPolynomial ι R) * ((Fintype.card ι : MvPolynomial ι R) - 2 * (d : MvPolynomial ι R) - 1 - 2 * (a : MvPolynomial ι R)) * g * dot (fun i => pderiv i g) (fun i => pderiv i g) + 4 * (a : MvPolynomial ι R) * ((a : MvPolynomial ι R) + (d : MvPolynomial ι R)) * g^2 * trace (fun i j => pderiv i (pderiv j g)) have hmul : q^(3*a-2) * (q*t+c*g^3) = 0 := by calc q^(3*a-2) * (q*t+c*g^3) = polynomialL (radialPolynomial^a * g) := by rw [radial_polynomial_identity a d ha g hg] dsimp only [q, t, c, radialCoefficient] ring _ = 0 := hL have hzero : q*t+c*g^3 = 0 := (mul_eq_zero.mp hmul).resolve_left (pow_ne_zero _ radialPolynomial_ne_zero) have hdiv : q ∣ c*g^3 := by use -t linear_combination hzero rcases hqPrime.dvd_mul.mp hdiv with hc | hpow · exact False.elim (hqPrime.not_isUnit (isUnit_of_dvd_unit hc hcUnit)) · exact hqPrime.dvd_of_dvd_pow hpow end Polynomial section Field open MvPolynomial variable {K : Type*} [Field K] [CharZero K] lemma radialCoefficient_isUnit (hn : 2 ≤ Fintype.card ι) (a d : ℕ) (ha : 1 ≤ a) : IsUnit (radialCoefficient (R := K) (ι := ι) a d) := by let N : ℕ := 4*a*(a+d)*(2*a*(Fintype.card ι-1)+d) have hNpos : 0 < N := by dsimp [N] apply Nat.mul_pos · apply Nat.mul_pos · exact Nat.mul_pos (by decide) (by omega) · omega · have : 0 < 2*a*(Fintype.card ι-1) := Nat.mul_pos (Nat.mul_pos (by decide) (by omega)) (by omega) omega have hNnz : (N : K) ≠ 0 := Nat.cast_ne_zero.mpr (Nat.ne_of_gt hNpos) have hu : IsUnit (C (N : K) : MvPolynomial ι K) := (isUnit_iff_ne_zero.mpr hNnz).map C convert hu using 1 dsimp only [radialCoefficient, N] simp only [Nat.cast_mul, Nat.cast_add, Nat.cast_sub (show 1 ≤ Fintype.card ι by omega), Nat.cast_ofNat, Nat.cast_one, map_mul, map_add, map_sub, map_natCast, map_ofNat, map_one] /-- No positive power of the radial polynomial times a radial-primitive homogeneous polynomial can solve L(F)=0. Irreducibility of the radial polynomial is supplied separately. -/ theorem no_radial_factor_primitive (hn : 2 ≤ Fintype.card ι) (hqPrime : Prime (radialPolynomial : MvPolynomial ι K)) (a d : ℕ) (ha : 1 ≤ a) (g : MvPolynomial ι K) (hg : g.IsHomogeneous d) (hprimitive : ¬(radialPolynomial : MvPolynomial ι K) ∣ g) : polynomialL (radialPolynomial^a * g) ≠ 0 := by haveI : Nonempty ι := Fintype.card_pos_iff.mp (by omega) intro hL exact hprimitive (radial_factor_descent a d ha g hg hqPrime (radialCoefficient_isUnit hn a d ha) hL) /-- The full radial obstruction, with the standard homogeneous-divisor theorem provided as the quotient-homogeneity hypothesis. -/ theorem no_radial_factor_of_homogeneous_quotients (hn : 2 ≤ Fintype.card ι) (hqPrime : Prime (radialPolynomial : MvPolynomial ι K)) (F : MvPolynomial ι K) (hF : F ≠ 0) (hL : polynomialL F = 0) (hquot : ∀ (a : ℕ) (g : MvPolynomial ι K), F = radialPolynomial^a * g → ∃ d : ℕ, g.IsHomogeneous d) : ¬(radialPolynomial : MvPolynomial ι K) ∣ F := by intro hdiv obtain ⟨a, g, hprimitive, hfactor⟩ := WfDvdMonoid.max_power_factor' hF hqPrime.not_isUnit have ha : 1 ≤ a := by by_contra hh have haz : a = 0 := by omega subst a simp only [pow_zero, one_mul] at hfactor exact hprimitive (hfactor ▸ hdiv) obtain ⟨d, hg⟩ := hquot a g hfactor exact (no_radial_factor_primitive hn hqPrime a d ha g hg hprimitive) (hfactor ▸ hL) end Field end Source29Radial /- Component: ComplexMaximum.lean -/ open scoped BigOperators namespace Source29ComplexMaximum noncomputable section /-- The finite-dimensional contradiction at the end of the complex maximum argument. -/ theorem trace_contradiction {ι : Type*} [Fintype ι] [Nonempty ι] (u : ι → ℂ) (c : ℂ) (κ : ℝ) (hsum : ∑ i, u i = 0) (hκ : κ < 1) (hbound : ∀ i, ‖1 + c * u i‖ ≤ κ) : False := by have hpoint : ∀ i, (c * u i).re < 0 := by intro i have hr := Complex.re_le_norm (1 + c * u i) have hb := hbound i simp only [Complex.add_re, Complex.one_re] at hr linarith have hneg : ∑ i, (c * u i).re < 0 := by exact Finset.sum_neg (fun i _ => hpoint i) Finset.univ_nonempty have hzero : ∑ i, (c * u i).re = 0 := by rw [← Complex.re_sum, ← Finset.mul_sum, hsum, mul_zero, Complex.zero_re] linarith /-- The bilinear form used in the paper has no conjugation in its definition. -/ def bilinear {ι : Type*} [Fintype ι] (z w : ι → ℂ) : ℂ := ∑ i, z i * w i theorem bilinear_comm {ι : Type*} [Fintype ι] (z w : ι → ℂ) : bilinear z w = bilinear w z := by unfold bilinear congr 1 funext i ring theorem bilinear_sub_left {ι : Type*} [Fintype ι] (z v w : ι → ℂ) : bilinear (fun i => z i - v i) w = bilinear z w - bilinear v w := by simp [bilinear, sub_mul, Finset.sum_sub_distrib] theorem bilinear_sub_right {ι : Type*} [Fintype ι] (z v w : ι → ℂ) : bilinear z (fun i => v i - w i) = bilinear z v - bilinear z w := by simp [bilinear, mul_sub, Finset.sum_sub_distrib] theorem bilinear_smul_left {ι : Type*} [Fintype ι] (a : ℂ) (z w : ι → ℂ) : bilinear (fun i => a * z i) w = a * bilinear z w := by simp [bilinear, mul_assoc, Finset.mul_sum] theorem bilinear_smul_right {ι : Type*} [Fintype ι] (a : ℂ) (z w : ι → ℂ) : bilinear z (fun i => a * w i) = a * bilinear z w := by rw [bilinear_comm, bilinear_smul_left, bilinear_comm w z] /-- The normal vector at a normalized maximum is bilinearly orthogonal to the point. -/ theorem normal_orthogonal {ι : Type*} [Fintype ι] (z : ι → ℂ) (κ : ℝ) (hq : bilinear z z = κ) (hnorm : bilinear (fun i => star (z i)) z = 1) : bilinear (fun i => z i - (κ : ℂ) * star (z i)) z = 0 := by rw [bilinear_sub_left, bilinear_smul_left, hq, hnorm] ring /-- The normal's squared bilinear length is negative and nonzero for 0 < κ < 1. -/ theorem normal_square {ι : Type*} [Fintype ι] (z : ι → ℂ) (κ : ℝ) (hq : bilinear z z = κ) (hnorm : bilinear (fun i => star (z i)) z = 1) : bilinear (fun i => z i - (κ : ℂ) * star (z i)) (fun i => z i - (κ : ℂ) * star (z i)) = -(κ : ℂ) * (1 - κ ^ 2) := by have hconj : bilinear (fun i => star (z i)) (fun i => star (z i)) = κ := by have hs := congrArg star hq simpa [bilinear, map_sum, map_mul] using hs have hcross : bilinear z (fun i => star (z i)) = 1 := by rw [bilinear_comm] exact hnorm rw [bilinear_sub_left, bilinear_sub_right, bilinear_sub_right, bilinear_smul_right, bilinear_smul_left, bilinear_smul_left, bilinear_smul_right, hq, hnorm, hcross, hconj] ring theorem normal_square_ne_zero (κ : ℝ) (hpos : 0 < κ) (hlt : κ < 1) : -(κ : ℂ) * (1 - κ ^ 2) ≠ 0 := by have hr : -(κ : ℝ) * (1 - κ ^ 2) ≠ 0 := by have hs : κ ^ 2 < 1 := by nlinarith exact ne_of_lt (mul_neg_of_neg_of_pos (neg_neg_of_pos hpos) (sub_pos.mpr hs)) exact_mod_cast hr /-- The power-sum identity that controls imaginary parts in the sheet-bound lemma. -/ theorem imaginary_squares_identity {ι : Type*} [Fintype ι] (w : ι → ℂ) : ∑ i, (w i).im ^ 2 = (∑ i, (w i).re ^ 2) - (∑ i, w i ^ 2).re := by simp only [Complex.re_sum, pow_two, Complex.mul_re] rw [← Finset.sum_sub_distrib] congr 1 funext i ring /-- A finite root bound, independent of how the roots are locally labelled. -/ theorem imaginary_square_le {ι : Type*} [Fintype ι] (w : ι → ℂ) (A B : ℝ) (hre : ∑ i, (w i).re ^ 2 ≤ A) (hpower : -B ≤ (∑ i, w i ^ 2).re) (i : ι) : (w i).im ^ 2 ≤ A + B := by have hi : (w i).im ^ 2 ≤ ∑ j, (w j).im ^ 2 := Finset.single_le_sum (fun j _ => sq_nonneg ((w j).im)) (Finset.mem_univ i) rw [imaginary_squares_identity] at hi linarith end end Source29ComplexMaximum /- Component: ComplexPhase.lean -/ namespace Source29ComplexPhase /-- Multiplication by a unit complex scalar makes a nonzero quadratic value real and positive. The scalar acts quadratically on the value. -/ theorem exists_quadratic_phase (a : ℂ) (ha : a ≠ 0) : ∃ c : ℂ, ‖c‖ = 1 ∧ c ^ 2 * a = (‖a‖ : ℂ) := by let b : ℂ := (‖a‖ : ℂ) / a let c : ℂ := b ^ ((2 : ℂ)⁻¹) have hc : c ^ 2 = b := Complex.cpow_nat_inv_pow b (by decide : (2 : ℕ) ≠ 0) have hb : ‖b‖ = 1 := by simp only [b, norm_div, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg (norm_nonneg a)] exact div_self (norm_ne_zero_iff.mpr ha) have hn : ‖c‖ ^ 2 = 1 := by rw [← norm_pow, hc, hb] refine ⟨c, ?_, ?_⟩ · nlinarith [norm_nonneg c] · rw [hc] exact div_mul_cancel₀ _ ha end Source29ComplexPhase /- Component: ComplexFTA.lean -/ /-! # Elementary fundamental theorem of algebra compatibility A nonconstant complex polynomial attains a minimum of its norm. Factoring out the lowest nonzero Taylor power gives a direction that strictly decreases any positive minimum. This proof uses polynomial continuity and complex nth roots; it does not use Liouville's theorem or a complex integration theorem. -/ namespace Source29FTA open Polynomial open scoped Topology /-- A nonzero constant plus a nontrivial lowest power can be made smaller in norm. -/ theorem exists_norm_lt_of_power_factor (a : ℂ) (ha : a ≠ 0) (q : Polynomial ℂ) (hq : q.eval 0 ≠ 0) (k : ℕ) (hk : 0 < k) : ∃ z : ℂ, ‖a + z ^ k * q.eval z‖ < ‖a‖ := by let b : ℂ := (-a / q.eval 0) ^ ((k : ℂ)⁻¹) have hb : b ^ k = -a / q.eval 0 := Complex.cpow_nat_inv_pow _ hk.ne' let E : ℝ → ℂ := fun t => b ^ k * q.eval ((t : ℂ) * b) + a have hE0 : E 0 = 0 := by simp [E, hb, hq] have hEcont : Continuous E := by exact (continuous_const.mul (q.continuous.comp (Complex.continuous_ofReal.mul_const b))).add continuous_const have haNorm : 0 < ‖a‖ := norm_pos_iff.mpr ha obtain ⟨δ, hδ, hbound⟩ := Metric.continuousAt_iff.mp hEcont.continuousAt (‖a‖ / 2) (by positivity) let t : ℝ := min δ 1 / 2 have ht0 : 0 < t := by dsimp [t]; positivity have htδ : dist t 0 < δ := by rw [Real.dist_eq, sub_zero, abs_of_pos ht0] have hmin := min_le_left δ (1 : ℝ) dsimp [t] nlinarith have ht1 : t < 1 := by have hmin := min_le_right δ (1 : ℝ) dsimp [t] nlinarith have hsmall : ‖E t‖ < ‖a‖ / 2 := by simpa only [hE0, dist_zero_right] using hbound htδ have htk0 : 0 < t ^ k := pow_pos ht0 _ have htk1 : t ^ k < 1 := pow_lt_one₀ ht0.le ht1 hk.ne' refine ⟨(t : ℂ) * b, ?_⟩ have heq : a + ((t : ℂ) * b) ^ k * q.eval ((t : ℂ) * b) = ((1 - t ^ k : ℝ) : ℂ) * a + ((t ^ k : ℝ) : ℂ) * E t := by dsimp [E] push_cast rw [mul_pow] ring rw [heq] have hnorm : ‖((1 - t ^ k : ℝ) : ℂ) * a + ((t ^ k : ℝ) : ℂ) * E t‖ ≤ (1 - t ^ k) * ‖a‖ + t ^ k * ‖E t‖ := by calc _ ≤ ‖((1 - t ^ k : ℝ) : ℂ) * a‖ + ‖((t ^ k : ℝ) : ℂ) * E t‖ := norm_add_le _ _ _ = _ := by simp only [norm_mul, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg (sub_nonneg.mpr htk1.le), abs_of_pos htk0] have hmul := mul_lt_mul_of_pos_left hsmall htk0 nlinarith /-- Every nonconstant complex polynomial has a root, by minimum modulus. -/ theorem exists_root {p : Polynomial ℂ} (hp : 0 < p.degree) : ∃ z : ℂ, p.IsRoot z := by obtain ⟨z₀, hmin⟩ := p.exists_forall_norm_le refine ⟨z₀, ?_⟩ change p.eval z₀ = 0 by_contra ha let r : Polynomial ℂ := taylor z₀ p - C (p.eval z₀) have hrne : r ≠ 0 := by intro hz have heq : taylor z₀ p = C (p.eval z₀) := sub_eq_zero.mp hz have hd := congrArg Polynomial.natDegree heq rw [natDegree_taylor, natDegree_C] at hd have hp' := natDegree_pos_iff_degree_pos.mpr hp omega have hr0 : r.IsRoot 0 := by simp [r, IsRoot, taylor_eval] let k := r.rootMultiplicity 0 have hk : 0 < k := (rootMultiplicity_pos hrne).mpr hr0 obtain ⟨q, hfactor, hq⟩ := r.exists_eq_pow_rootMultiplicity_mul_and_not_dvd hrne 0 have hfactor' : r = X ^ k * q := by simpa [k] using hfactor have hq0 : q.eval 0 ≠ 0 := by intro hz exact hq (dvd_iff_isRoot.mpr hz) obtain ⟨z, hz⟩ := exists_norm_lt_of_power_factor (p.eval z₀) ha q hq0 k hk have heval : p.eval (z + z₀) = p.eval z₀ + z ^ k * q.eval z := by have heq := congrArg (Polynomial.eval z) hfactor' simp only [r, eval_sub, taylor_eval, eval_C, eval_mul, eval_pow, eval_X] at heq linear_combination heq have hmin' := hmin (z + z₀) rw [heval] at hmin' exact (not_lt_of_ge hmin') hz /-- Algebraic closedness of ℂ, with all analytical prerequisites proved above. -/ theorem complex_isAlgClosed : IsAlgClosed ℂ := IsAlgClosed.of_exists_root ℂ fun _p _ hp => exists_root (degree_pos_of_irreducible hp) end Source29FTA /- Component: ZeroLocus.lean -/ namespace Source29ZeroLocus open MvPolynomial variable {K : Type*} [Field K] [IsAlgClosed K] noncomputable section /-- Nullstellensatz in the divisibility form used by the complex obstruction. -/ theorem irreducible_dvd_of_vanishing {ι : Type*} [Fintype ι] (h p : MvPolynomial ι K) (hh : Irreducible h) (hvan : ∀ z : ι → K, eval z h = 0 → eval z p = 0) : h ∣ p := by let J : Ideal (MvPolynomial ι K) := Ideal.span {h} have : J.IsPrime := Ideal.isPrime_span_singleton_of_prime hh.prime have hp : p ∈ vanishingIdeal K (zeroLocus K J) := by intro z hz have hhmem : h ∈ J := Ideal.subset_span (Set.mem_singleton h) have hz' := hz h hhmem simpa using hvan z (by simpa using hz') rw [MvPolynomial.IsPrime.vanishingIdeal_zeroLocus] at hp exact Ideal.mem_span_singleton.mp hp /-- An irreducible hypersurface over an algebraically closed field in at least two variables has a nonzero point. -/ theorem exists_nonzero_zero {ι : Type*} [Fintype ι] [Nontrivial ι] (h : MvPolynomial ι K) (hh : Irreducible h) : ∃ z : ι → K, z ≠ 0 ∧ eval z h = 0 := by classical by_contra hnone push Not at hnone have hdiv (i : ι) : h ∣ X i := by apply irreducible_dvd_of_vanishing h (X i) hh intro z hz have hz0 : z = 0 := by by_contra hne exact hnone z hne hz simp [hz0] obtain ⟨i, j, hij⟩ := exists_pair_ne ι have hback : X i ∣ h := (hh.associated_of_dvd (X_prime (i := i)).irreducible (hdiv i)).symm.dvd exact hij (X_dvd_X.mp (dvd_trans hback (hdiv j))) end end Source29ZeroLocus /- Component: ProjectiveStrict.lean -/ namespace Source29ProjectiveMaximum open Finset MvPolynomial abbrev CSpace (n : ℕ) := EuclideanSpace ℂ (Fin n) def sphericalZeroSet {n : ℕ} (h : MvPolynomial (Fin n) ℂ) : Set (CSpace n) := {z | ‖z‖ = 1 ∧ eval (fun i => z i) h = 0} noncomputable def quadricNorm {n : ℕ} (z : CSpace n) : ℝ := ‖∑ i : Fin n, (z i)^2‖ lemma eval_scale_of_isHomogeneous {ι : Type*} (h : MvPolynomial ι ℂ) (d : ℕ) (hh : h.IsHomogeneous d) (x : ι → ℂ) (c : ℂ) : eval (fun i => c * x i) h = c^d * eval x h := by rw [eval_eq, eval_eq, Finset.mul_sum] apply Finset.sum_congr rfl intro r hr simp only [mul_pow, Finset.prod_mul_distrib, Finset.prod_pow_eq_pow_sum, ← hh.degree_eq_sum_deg_support hr] ring lemma continuous_polynomial_eval {n : ℕ} (h : MvPolynomial (Fin n) ℂ) : Continuous (fun z : CSpace n => eval (fun i => z i) h) := by apply MvPolynomial.induction_on h · intro c simpa using (continuous_const : Continuous (fun _ : CSpace n => c)) · intro p q hp hq simpa only [map_add, Pi.add_def] using hp.add hq · intro p i hp have hi : Continuous (fun z : CSpace n => z i) := PiLp.continuous_apply (p := 2) (β := fun _ : Fin n => ℂ) i simpa only [map_mul, eval_X, Pi.mul_def] using hp.mul hi lemma continuous_quadricNorm {n : ℕ} : Continuous (@quadricNorm n) := by apply Continuous.norm apply continuous_finsetSum intro i hi exact (PiLp.continuous_apply (p := 2) (β := fun _ : Fin n => ℂ) i).pow 2 lemma sphericalZeroSet_isCompact {n : ℕ} (h : MvPolynomial (Fin n) ℂ) : IsCompact (sphericalZeroSet h) := by have hc : IsClosed (sphericalZeroSet h) := (isClosed_eq continuous_norm continuous_const).inter (isClosed_eq (continuous_polynomial_eval h) continuous_const) apply (isCompact_sphere (0 : CSpace n) 1).of_isClosed_subset hc intro z hz simpa [Metric.mem_sphere] using hz.1 lemma sphericalZeroSet_nonempty {n d : ℕ} (h : MvPolynomial (Fin n) ℂ) (hh : h.IsHomogeneous d) (z : CSpace n) (hz : z ≠ 0) (hzero : eval (fun i => z i) h = 0) : (sphericalZeroSet h).Nonempty := by let c : ℂ := (‖z‖ : ℂ)⁻¹ refine ⟨c • z, ?_, ?_⟩ · rw [norm_smul] simp only [c, norm_inv, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg (norm_nonneg z)] exact inv_mul_cancel₀ (norm_ne_zero_iff.mpr hz) · change eval (fun i => c * z i) h = 0 rw [eval_scale_of_isHomogeneous h d hh, hzero, mul_zero] lemma quadricNorm_nonneg {n : ℕ} (z : CSpace n) : 0 ≤ quadricNorm z := norm_nonneg _ lemma quadricNorm_le_norm_sq {n : ℕ} (z : CSpace n) : quadricNorm z ≤ ‖z‖^2 := by unfold quadricNorm calc ‖∑ i : Fin n, (z i)^2‖ ≤ ∑ i : Fin n, ‖(z i)^2‖ := norm_sum_le _ _ _ = ‖z‖^2 := by simp only [norm_pow, EuclideanSpace.norm_sq_eq] lemma quadricNorm_le_one {n : ℕ} (z : CSpace n) (hz : ‖z‖ = 1) : quadricNorm z ≤ 1 := by simpa [hz] using quadricNorm_le_norm_sq z /-- A homogeneous complex hypersurface with a nonzero zero has a compact, nonempty unit-sphere slice, on which the quadric norm attains a maximum in [0,1]. -/ theorem exists_spherical_maximum {n d : ℕ} (h : MvPolynomial (Fin n) ℂ) (hh : h.IsHomogeneous d) (z : CSpace n) (hz : z ≠ 0) (hzero : eval (fun i => z i) h = 0) : ∃ (κ : ℝ) (zmax : CSpace n), 0 ≤ κ ∧ κ ≤ 1 ∧ ‖zmax‖ = 1 ∧ eval (fun i => zmax i) h = 0 ∧ quadricNorm zmax = κ ∧ ∀ w ∈ sphericalZeroSet h, quadricNorm w ≤ κ := by obtain ⟨zmax, hzmax, hmax⟩ := (sphericalZeroSet_isCompact h).exists_isMaxOn (sphericalZeroSet_nonempty h hh z hz hzero) continuous_quadricNorm.continuousOn exact ⟨quadricNorm zmax, zmax, quadricNorm_nonneg zmax, quadricNorm_le_one zmax hzmax.1, hzmax.1, hzmax.2, rfl, hmax⟩ /-- Equality in the quadric norm bound forces a complex scalar multiple of the vector to have real coordinates. This uses equality in Cauchy-Schwarz. -/ lemma real_multiple_of_quadricNorm_eq_one {n : ℕ} (z : CSpace n) (hzunit : ‖z‖ = 1) (hquad : quadricNorm z = 1) : ∃ (c : ℂ) (x : Fin n → ℝ), c ≠ 0 ∧ x ≠ 0 ∧ ∀ i, (x i : ℂ) = c * z i := by let zb : CSpace n := WithLp.toLp 2 (fun i => star (z i)) have hnorm : ‖zb‖ = ‖z‖ := by apply (sq_eq_sq₀ (norm_nonneg _) (norm_nonneg _)).mp simp [EuclideanSpace.norm_sq_eq, zb] have hz : z ≠ 0 := by intro h simpa [h] using hzunit have hzb : zb ≠ 0 := by intro h have he := hnorm.trans hzunit simpa [h] using he have hinner : inner ℂ zb z = ∑ i : Fin n, (z i)^2 := by simp [PiLp.inner_apply, zb, pow_two] have hcs : ‖inner ℂ zb z‖ = ‖zb‖ * ‖z‖ := by rw [hinner, hnorm, hzunit] simpa [quadricNorm] using hquad obtain ⟨r, hr, hscale⟩ := (norm_inner_eq_norm_iff (𝕜 := ℂ) hzb hz).mp hcs have hcoords (j : Fin n) : z j = r * star (z j) := by have he := congrArg (fun v : CSpace n => v j) hscale simpa [zb] using he obtain ⟨i, hi⟩ : ∃ i : Fin n, z i ≠ 0 := by by_contra h push Not at h apply hz ext i exact h i let c : ℂ := star (z i) have hc : c ≠ 0 := by simpa [c] using hi have him (j : Fin n) : (c * z j).im = 0 := by have hconj : star (c * z j) = c * z j := by change star (star (z i) * z j) = star (z i) * z j rw [star_mul, star_star] calc star (z j) * z i = star (z j) * (r * star (z i)) := congrArg (fun t : ℂ => star (z j) * t) (hcoords i) _ = star (z i) * (r * star (z j)) := by ring _ = star (z i) * z j := congrArg (fun t : ℂ => star (z i) * t) (hcoords j).symm have he := congrArg Complex.im hconj simp only [Complex.star_def, Complex.conj_im] at he linarith let x : Fin n → ℝ := fun j => (c * z j).re have hreal (j : Fin n) : (x j : ℂ) = c * z j := by apply Complex.ext · rfl · simpa only [Complex.ofReal_im] using (him j).symm have hx : x ≠ 0 := by intro he have hxi := hreal i rw [he] at hxi simp only [Pi.zero_apply, Complex.ofReal_zero] at hxi exact (mul_ne_zero hc hi) hxi.symm exact ⟨c, x, hc, hx, hreal⟩ lemma quadricNorm_lt_one_of_no_real_zero {n d : ℕ} (h : MvPolynomial (Fin n) ℂ) (hh : h.IsHomogeneous d) (hreal : ∀ x : Fin n → ℝ, x ≠ 0 → eval (fun i => (x i : ℂ)) h ≠ 0) (z : CSpace n) (hzunit : ‖z‖ = 1) (hzero : eval (fun i => z i) h = 0) : quadricNorm z < 1 := by have hle := quadricNorm_le_one z hzunit by_contra hlt have heq : quadricNorm z = 1 := le_antisymm hle (le_of_not_gt hlt) obtain ⟨c, x, hc, hx, hcoords⟩ := real_multiple_of_quadricNorm_eq_one z hzunit heq apply hreal x hx calc eval (fun i => (x i : ℂ)) h = eval (fun i => c * z i) h := by rw [show (fun i => (x i : ℂ)) = (fun i => c * z i) from funext hcoords] _ = c^d * eval (fun i => z i) h := eval_scale_of_isHomogeneous h d hh _ c _ = 0 := by rw [hzero, mul_zero] /-- The compact maximum is strictly below one when there is no nonzero real zero. -/ theorem exists_strict_spherical_maximum {n d : ℕ} (h : MvPolynomial (Fin n) ℂ) (hh : h.IsHomogeneous d) (hreal : ∀ x : Fin n → ℝ, x ≠ 0 → eval (fun i => (x i : ℂ)) h ≠ 0) (z : CSpace n) (hz : z ≠ 0) (hzero : eval (fun i => z i) h = 0) : ∃ (κ : ℝ) (zmax : CSpace n), 0 ≤ κ ∧ κ < 1 ∧ ‖zmax‖ = 1 ∧ eval (fun i => zmax i) h = 0 ∧ quadricNorm zmax = κ ∧ ∀ w ∈ sphericalZeroSet h, quadricNorm w ≤ κ := by obtain ⟨κ, zmax, hk, hkle, hzunit, hzzero, hval, hmax⟩ := exists_spherical_maximum h hh z hz hzero refine ⟨κ, zmax, hk, ?_, hzunit, hzzero, hval, hmax⟩ rw [← hval] exact quadricNorm_lt_one_of_no_real_zero h hh hreal zmax hzunit hzzero end Source29ProjectiveMaximum /- Component: ProjectiveScaling.inc -/ namespace Source29ProjectiveMaximum open Finset MvPolynomial lemma quadricNorm_smul {n : ℕ} (c : ℂ) (z : CSpace n) : quadricNorm (c • z) = ‖c‖^2 * quadricNorm z := by unfold quadricNorm change ‖∑ i : Fin n, (c * z i)^2‖ = ‖c‖^2 * ‖∑ i : Fin n, (z i)^2‖ simp_rw [mul_pow] rw [← Finset.mul_sum, norm_mul, norm_pow] lemma normalized_mem_sphericalZeroSet {n d : ℕ} (h : MvPolynomial (Fin n) ℂ) (hh : h.IsHomogeneous d) (z : CSpace n) (hz : z ≠ 0) (hzero : eval (fun i => z i) h = 0) : ((‖z‖ : ℂ)⁻¹ • z) ∈ sphericalZeroSet h := by refine ⟨?_, ?_⟩ · rw [norm_smul] simp only [norm_inv, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg (norm_nonneg z)] exact inv_mul_cancel₀ (norm_ne_zero_iff.mpr hz) · change eval (fun i => (‖z‖ : ℂ)⁻¹ * z i) h = 0 rw [eval_scale_of_isHomogeneous h d hh, hzero, mul_zero] /-- A maximum on the unit-sphere slice gives the homogeneous inequality on the entire complex zero set, including its origin. -/ theorem global_quadric_bound {n d : ℕ} (h : MvPolynomial (Fin n) ℂ) (hh : h.IsHomogeneous d) (κ : ℝ) (hmax : ∀ z ∈ sphericalZeroSet h, quadricNorm z ≤ κ) (w : CSpace n) (hwzero : eval (fun i => w i) h = 0) : quadricNorm w ≤ κ * ‖w‖^2 := by by_cases hw : w = 0 · simp [hw, quadricNorm] have hm := hmax ((‖w‖ : ℂ)⁻¹ • w) (normalized_mem_sphericalZeroSet h hh w hw hwzero) rw [quadricNorm_smul] at hm simp only [norm_inv, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg (norm_nonneg w), inv_pow] at hm have hn : 0 < ‖w‖^2 := sq_pos_of_pos (norm_pos_iff.mpr hw) calc quadricNorm w = ‖w‖^2 * ((‖w‖^2)⁻¹ * quadricNorm w) := by rw [← mul_assoc, mul_inv_cancel₀ hn.ne', one_mul] _ ≤ ‖w‖^2 * κ := mul_le_mul_of_nonneg_left hm hn.le _ = κ * ‖w‖^2 := mul_comm _ _ end Source29ProjectiveMaximum /- Component: RootPersistence.lean -/ namespace Source29RootPersistence open Polynomial Filter open scoped Topology noncomputable section lemma product_bound (s : Multiset ℂ) (z : ℂ) (C : ℝ) (hC : 0 ≤ C) (hbound : ∀ r ∈ s, ‖z - r‖ ≤ C * ‖r‖) : ‖(s.map (fun r => z - r)).prod‖ ≤ C ^ s.card * ‖(s.map (fun r => (0 : ℂ) - r)).prod‖ := by induction s using Multiset.induction_on with | empty => simp | @cons r s ih => have hr := hbound r (Multiset.mem_cons_self r s) have hs := ih (fun x hx => hbound x (Multiset.mem_cons_of_mem hx)) simp only [Multiset.map_cons, Multiset.prod_cons, norm_mul, Multiset.card_cons, zero_sub, norm_neg] at * calc ‖z - r‖ * ‖(s.map (fun r => z - r)).prod‖ ≤ (C * ‖r‖) * (C ^ s.card * ‖(s.map (fun r => -r)).prod‖) := mul_le_mul hr hs (norm_nonneg _) (mul_nonneg hC (norm_nonneg _)) _ = C ^ (s.card + 1) * (‖r‖ * ‖(s.map (fun r => -r)).prod‖) := by rw [pow_succ] ring /-- A bounded-degree polynomial without a root near zero cannot be small at zero while remaining large at another fixed point. This works even when a limiting polynomial loses degree. -/ theorem eval_bound_of_no_small_roots (p : Polynomial ℂ) (hsplit : p.Splits) (D : ℕ) (hD : p.natDegree ≤ D) (ε : ℝ) (hε : 0 < ε) (hroots : ∀ r : ℂ, p.eval r = 0 → ε ≤ ‖r‖) (z : ℂ) : ‖p.eval z‖ ≤ (1 + ‖z‖ / ε) ^ D * ‖p.eval 0‖ := by let C : ℝ := 1 + ‖z‖ / ε have hC : 1 ≤ C := by dsimp [C] have := div_nonneg (norm_nonneg z) hε.le linarith have hbound : ∀ r ∈ p.roots, ‖z - r‖ ≤ C * ‖r‖ := by intro r hr have hrε := hroots r (isRoot_of_mem_roots hr) have hrz : ‖z‖ ≤ (‖z‖ / ε) * ‖r‖ := by have hh := mul_le_mul_of_nonneg_left hrε (div_nonneg (norm_nonneg z) hε.le) rwa [div_mul_cancel₀ _ hε.ne'] at hh calc ‖z - r‖ ≤ ‖z‖ + ‖r‖ := norm_sub_le _ _ _ ≤ C * ‖r‖ := by dsimp [C]; nlinarith have hprod := product_bound p.roots z C (by positivity) hbound have hpow : C ^ p.roots.card ≤ C ^ D := by exact pow_le_pow_right₀ hC (le_trans (card_roots' p) hD) rw [hsplit.eval_eq_prod_roots z, hsplit.eval_eq_prod_roots 0, norm_mul, norm_mul] calc ‖p.leadingCoeff‖ * ‖(p.roots.map (fun r => z - r)).prod‖ ≤ ‖p.leadingCoeff‖ * (C ^ p.roots.card * ‖(p.roots.map (fun r => (0 : ℂ) - r)).prod‖) := mul_le_mul_of_nonneg_left hprod (norm_nonneg _) _ ≤ ‖p.leadingCoeff‖ * (C ^ D * ‖(p.roots.map (fun r => (0 : ℂ) - r)).prod‖) := by gcongr _ = (1 + ‖z‖ / ε) ^ D * (‖p.leadingCoeff‖ * ‖(p.roots.map (fun r => (0 : ℂ) - r)).prod‖) := by dsimp [C] ring /-- Roots persist under pointwise limits of bounded-degree split polynomials. No assumption that the degrees or leading coefficients stay constant is needed. -/ theorem eventually_exists_root_near_zero {α : Type*} {l : Filter α} (p : α → Polynomial ℂ) (P : Polynomial ℂ) (D : ℕ) (hsplit : ∀ t, (p t).Splits) (hD : ∀ᶠ t in l, (p t).natDegree ≤ D) (hlim : ∀ z : ℂ, Tendsto (fun t => (p t).eval z) l (𝓝 (P.eval z))) (hP : P ≠ 0) (hzero : P.eval 0 = 0) (ε : ℝ) (hε : 0 < ε) : ∀ᶠ t in l, ∃ z : ℂ, (p t).eval z = 0 ∧ ‖z‖ < ε := by obtain ⟨z, hz⟩ : ∃ z : ℂ, P.eval z ≠ 0 := by by_contra hn push Not at hn apply hP apply Polynomial.funext simpa using hn let C : ℝ := (1 + ‖z‖ / ε) ^ D have hsmall : Tendsto (fun t => C * ‖(p t).eval 0‖) l (𝓝 0) := by simpa [hzero] using tendsto_const_nhds.mul (hlim 0).norm have hlarge := (hlim z).norm have hlt : ∀ᶠ t in l, C * ‖(p t).eval 0‖ < ‖(p t).eval z‖ := hsmall.eventually_lt hlarge (norm_pos_iff.mpr hz) filter_upwards [hD, hlt] with t htD htlt by_contra hnone push Not at hnone have hbound := eval_bound_of_no_small_roots (p t) (hsplit t) D htD ε hε hnone z exact (not_lt_of_ge hbound) htlt end end Source29RootPersistence /- Component: SlicePolynomial.lean -/ /-! # Restricting a multivariate polynomial to an affine complex line -/ namespace Source29SlicePolynomial open MvPolynomial open scoped BigOperators noncomputable section /-- The univariate polynomial obtained by substituting v + tau*u. -/ def lineSlice {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (v u : Fin n → ℂ) : Polynomial ℂ := eval₂ Polynomial.C (fun i => Polynomial.C (v i)+Polynomial.X*Polynomial.C (u i)) P theorem eval_lineSlice {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (v u : Fin n → ℂ) (tau : ℂ) : Polynomial.eval tau (lineSlice P v u) = eval (fun i => v i+tau*u i) P := by induction P using MvPolynomial.induction_on with | C c => simp [lineSlice] | add p q hp hq => simpa [lineSlice] using congrArg₂ (fun a b : ℂ => a+b) hp hq | mul_X p i hp => simp only [lineSlice, eval₂_mul, eval₂_X, Polynomial.eval_mul, Polynomial.eval_add, Polynomial.eval_C, Polynomial.eval_X, eval_mul, eval_X] exact congrArg (fun a : ℂ => a*(v i+tau*u i)) hp lemma affine_natDegree_le (v u : ℂ) : (Polynomial.C v+Polynomial.X*Polynomial.C u).natDegree ≤ 1 := by apply Polynomial.natDegree_add_le_of_degree_le · simp · exact (Polynomial.natDegree_mul_C_le _ _).trans (by simp) lemma affine_pow_natDegree_le (v u : ℂ) (k : ℕ) : ((Polynomial.C v+Polynomial.X*Polynomial.C u)^k).natDegree ≤ k := by simpa using Polynomial.natDegree_pow_le_of_le k (affine_natDegree_le v u) theorem natDegree_lineSlice_le {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (v u : Fin n → ℂ) : (lineSlice P v u).natDegree ≤ P.totalDegree := by classical rw [lineSlice, eval₂_eq] apply Polynomial.natDegree_sum_le_of_forall_le intro e he apply (Polynomial.natDegree_C_mul_le _ _).trans apply (Polynomial.natDegree_prod_le _ _).trans apply le_trans (Finset.sum_le_sum (fun i hi => affine_pow_natDegree_le (v i) (u i) (e i))) exact le_totalDegree he /-- The coefficient at the sum of separate degree bounds is the product of coefficients at those bounds, even when some factors have smaller degree. -/ lemma coeff_prod_sum_of_natDegree_le {R ι : Type*} [CommSemiring R] (s : Finset ι) (f : ι → Polynomial R) (d : ι → ℕ) (hd : ∀ i ∈ s, (f i).natDegree ≤ d i) : (∏ i ∈ s, f i).coeff (∑ i ∈ s, d i) = ∏ i ∈ s, (f i).coeff (d i) := by classical induction s using Finset.induction_on with | empty => simp | @insert i s his ih => rw [Finset.prod_insert his, Finset.sum_insert his, Finset.prod_insert his] rw [Polynomial.coeff_mul_add_eq_of_natDegree_le (hd i (by simp))] · rw [ih (fun j hj => hd j (by simp [hj]))] · exact (Polynomial.natDegree_prod_le _ _).trans (Finset.sum_le_sum (fun j hj => hd j (by simp [hj]))) lemma affine_pow_top_coeff (v u : ℂ) (k : ℕ) : ((Polynomial.C v+Polynomial.X*Polynomial.C u)^k).coeff k = u^k := by have h := Polynomial.coeff_pow_of_natDegree_le (m := k) (affine_natDegree_le v u) simpa using h /-- A homogeneous polynomial has a line-slice top coefficient independent of the base point; it is evaluation of that polynomial on the direction vector. -/ theorem coeff_lineSlice_of_isHomogeneous {n s : ℕ} (P : MvPolynomial (Fin n) ℂ) (hP : P.IsHomogeneous s) (v u : Fin n → ℂ) : (lineSlice P v u).coeff s = eval u P := by classical rw [lineSlice, eval₂_eq, Polynomial.finsetSum_coeff, eval_eq] apply Finset.sum_congr rfl intro e he rw [Polynomial.coeff_C_mul, hP.degree_eq_sum_deg_support he] congr 1 rw [coeff_prod_sum_of_natDegree_le _ _ (fun i => e i) (fun i hi => affine_pow_natDegree_le (v i) (u i) (e i))] apply Finset.prod_congr rfl intro i hi exact affine_pow_top_coeff (v i) (u i) (e i) /-- A direction where the homogeneous polynomial is nonzero ensures a nonzero line restriction through every base point. -/ theorem lineSlice_ne_zero_of_isHomogeneous {n s : ℕ} (P : MvPolynomial (Fin n) ℂ) (hP : P.IsHomogeneous s) (v u : Fin n → ℂ) (hu : eval u P ≠ 0) : lineSlice P v u ≠ 0 := by intro hz apply hu rw [← coeff_lineSlice_of_isHomogeneous P hP v u, hz, Polynomial.coeff_zero] end end Source29SlicePolynomial /- Component: LowestRescale.inc -/ /- A polynomial rescaling at its first homogeneous component. The rescaled family is defined without division, so it is continuous even at parameter zero. -/ namespace Source29LowestRescale open MvPolynomial Finset open scoped Topology noncomputable section def rescale {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (s : ℕ) (t : ℂ) : MvPolynomial (Fin n) ℂ := ∑ k ∈ range (P.totalDegree + 1), C (t ^ (k - s)) * homogeneousComponent k P theorem totalDegree_rescale_le {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (s : ℕ) (t : ℂ) : (rescale P s t).totalDegree ≤ P.totalDegree := by apply totalDegree_finsetSum_le intro k hk have hcomp := (homogeneousComponent_isHomogeneous k P).totalDegree_le calc (C (t ^ (k - s)) * homogeneousComponent k P).totalDegree ≤ (C (t ^ (k - s)) : MvPolynomial (Fin n) ℂ).totalDegree + (homogeneousComponent k P).totalDegree := totalDegree_mul _ _ _ ≤ P.totalDegree := by rw [totalDegree_C, zero_add] exact le_trans hcomp (Nat.le_of_lt_succ (mem_range.mp hk)) theorem rescale_zero {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (s : ℕ) (hs : s ≤ P.totalDegree) (hlow : ∀ k < s, homogeneousComponent k P = 0) : rescale P s 0 = homogeneousComponent s P := by unfold rescale rw [Finset.sum_eq_single s] · simp · intro k hk hks by_cases hlt : k < s · simp [hlow k hlt] · have hpos : 0 < k - s := by omega simp [zero_pow hpos.ne'] · intro hnot exact False.elim (hnot (mem_range.mpr (Nat.lt_succ_of_le hs))) /-- Evaluating the rescaled family recovers the original polynomial under a scalar dilation, with the lowest power removed. The equality holds at zero too. -/ theorem eval_rescale_mul {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (s : ℕ) (hlow : ∀ k < s, homogeneousComponent k P = 0) (t : ℂ) (y : Fin n → ℂ) : t ^ s * eval y (rescale P s t) = eval (fun i => t * y i) P := by calc t ^ s * eval y (rescale P s t) = ∑ k ∈ range (P.totalDegree + 1), t ^ s * (t ^ (k - s) * eval y (homogeneousComponent k P)) := by simp only [rescale, map_sum, map_mul, eval_C, Finset.mul_sum] _ = ∑ k ∈ range (P.totalDegree + 1), t ^ k * eval y (homogeneousComponent k P) := by apply Finset.sum_congr rfl intro k hk by_cases hlt : k < s · simp [hlow k hlt] · rw [← mul_assoc, ← pow_add, Nat.add_sub_of_le (Nat.le_of_not_gt hlt)] _ = eval (fun i => t * y i) P := by conv_rhs => rw [← sum_homogeneousComponent P] simp only [map_sum] apply Finset.sum_congr rfl intro k hk exact (Source29ProjectiveMaximum.eval_scale_of_isHomogeneous _ k (homogeneousComponent_isHomogeneous k P) y t).symm theorem continuous_eval_rescale {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (s : ℕ) (y : Fin n → ℂ) : Continuous (fun t : ℂ => eval y (rescale P s t)) := by simp only [rescale, map_sum, map_mul, eval_C] apply continuous_finsetSum intro k hk exact (continuous_id.pow (k - s)).mul continuous_const end end Source29LowestRescale /- Component: SmallZeroApprox.inc -/ /- Realization of zeros of the initial homogeneous form by nearby zeros. The only root-persistence argument used here is the bounded-degree algebraic estimate proved in Source29RootPersistence. -/ namespace Source29SmallZeroApprox open MvPolynomial Filter open Source29SlicePolynomial Source29LowestRescale open scoped Topology noncomputable section theorem exists_small_scaled_zero {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (s : ℕ) (hs : s ≤ P.totalDegree) (hlow : ∀ k < s, homogeneousComponent k P = 0) (v u : Fin n → ℂ) (hv : eval v (homogeneousComponent s P) = 0) (hu : eval u (homogeneousComponent s P) ≠ 0) (ε : ℝ) (hε : 0 < ε) : ∃ t : ℝ, ∃ τ : ℂ, 0 < t ∧ t < ε ∧ ‖τ‖ < ε ∧ eval (fun i => (t : ℂ) * (v i + τ * u i)) P = 0 := by letI : IsAlgClosed ℂ := Source29FTA.complex_isAlgClosed let family : ℝ → Polynomial ℂ := fun t => lineSlice (rescale P s (t : ℂ)) v u let initial : Polynomial ℂ := lineSlice (homogeneousComponent s P) v u have hsplit : ∀ t, (family t).Splits := fun t => IsAlgClosed.splits _ have hdegree : ∀ᶠ t in 𝓝[>] (0 : ℝ), (family t).natDegree ≤ P.totalDegree := by apply Filter.Eventually.of_forall intro t exact (natDegree_lineSlice_le _ v u).trans (totalDegree_rescale_le P s _) have hlimit (τ : ℂ) : Tendsto (fun t => (family t).eval τ) (𝓝[>] (0 : ℝ)) (𝓝 (initial.eval τ)) := by have hc := (continuous_eval_rescale P s (fun i => v i + τ * u i)).comp Complex.continuous_ofReal have ht : Tendsto (fun t : ℝ => eval (fun i => v i + τ * u i) (rescale P s (t : ℂ))) (𝓝[>] (0 : ℝ)) (𝓝 (eval (fun i => v i + τ * u i) (rescale P s (0 : ℂ)))) := (hc.continuousAt (x := (0 : ℝ))).tendsto.mono_left nhdsWithin_le_nhds simpa [family, initial, eval_lineSlice, rescale_zero P s hs hlow] using ht have hinitial : initial ≠ 0 := lineSlice_ne_zero_of_isHomogeneous _ (homogeneousComponent_isHomogeneous s P) v u hu have hinitial0 : initial.eval 0 = 0 := by simpa [initial, eval_lineSlice] using hv have hroots := Source29RootPersistence.eventually_exists_root_near_zero family initial P.totalDegree hsplit hdegree hlimit hinitial hinitial0 ε hε have hsmall : ∀ᶠ t in 𝓝[>] (0 : ℝ), t < ε := (eventually_lt_nhds hε).filter_mono nhdsWithin_le_nhds have hpositive : ∀ᶠ t in 𝓝[>] (0 : ℝ), 0 < t := self_mem_nhdsWithin obtain ⟨t, htpos, htε, τ, hτ, hτnorm⟩ := (hpositive.and (hsmall.and hroots)).exists refine ⟨t, τ, htpos, htε, hτnorm, ?_⟩ rw [← eval_rescale_mul P s hlow] have heq : eval (fun i => v i + τ * u i) (rescale P s (t : ℂ)) = 0 := by simpa [family, eval_lineSlice] using hτ rw [heq, mul_zero] end end Source29SmallZeroApprox /- Component: TangentRealization.lean -/ open Filter open scoped Topology namespace Source29TangentRealization noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] [NormedSpace ℝ E] [IsScalarTower ℝ ℂ E] /-- A family of nearby zeros with positive real radial scale supplies a positive real tangent direction. The complex correction may tend to zero at any rate. -/ theorem mem_posTangentConeAt_of_sequences {S : Set E} {z v u : E} (t : ℕ → ℝ) (τ : ℕ → ℂ) (htpos : ∀ n, 0 < t n) (ht : Tendsto t atTop (𝓝 0)) (hτ : Tendsto τ atTop (𝓝 0)) (hS : ∀ n, z + t n • (v + τ n • u) ∈ S) : v ∈ posTangentConeAt S z := by let c : ℕ → NNReal := fun n => ⟨(t n)⁻¹, (inv_pos.mpr (htpos n)).le⟩ let d : ℕ → E := fun n => t n • (v + τ n • u) have hv : Tendsto (fun n => v + τ n • u) atTop (𝓝 v) := by simpa using tendsto_const_nhds.add (hτ.smul_const u) refine mem_tangentConeAt_of_seq atTop c d ?_ (Filter.Eventually.of_forall hS) ?_ · simpa [d] using ht.smul hv · have heq : (fun n => c n • d n) = fun n => v + τ n • u := by funext n change (t n)⁻¹ • (t n • (v + τ n • u)) = v + τ n • u rw [smul_smul, inv_mul_cancel₀ (ne_of_gt (htpos n)), one_smul] rw [heq] exact hv /-- Quantitative approximation, convenient for use after persistence of roots of one-variable polynomial slices, implies membership in the tangent cone. -/ theorem mem_posTangentConeAt_of_approximations {S : Set E} {z v u : E} (happrox : ∀ ε : ℝ, 0 < ε → ∃ t : ℝ, ∃ τ : ℂ, 0 < t ∧ t < ε ∧ ‖τ‖ < ε ∧ z + t • (v + τ • u) ∈ S) : v ∈ posTangentConeAt S z := by let ε : ℕ → ℝ := fun n => 1 / ((n : ℝ) + 1) have hεpos : ∀ n, 0 < ε n := by intro n; dsimp [ε]; positivity choose t τ htpos htbound hτbound hS using fun n => happrox (ε n) (hεpos n) have hε : Tendsto ε atTop (𝓝 0) := by simpa [ε] using (tendsto_one_div_add_atTop_nhds_zero_nat (𝕜 := ℝ)) have ht : Tendsto t atTop (𝓝 0) := squeeze_zero (fun n => (htpos n).le) (fun n => (htbound n).le) hε have hτ : Tendsto τ atTop (𝓝 0) := by apply tendsto_zero_iff_norm_tendsto_zero.mpr exact squeeze_zero (fun n => norm_nonneg _) (fun n => (hτbound n).le) hε exact mem_posTangentConeAt_of_sequences t τ htpos ht hτ hS /-- An eventual small correction for each error tolerance is enough; no continuous or holomorphic choice of the correcting root is required. -/ theorem mem_posTangentConeAt_of_eventual_corrections {S : Set E} {z v u : E} (hcorrection : ∀ ε : ℝ, 0 < ε → ∀ᶠ t : ℝ in 𝓝[>] 0, ∃ τ : ℂ, ‖τ‖ < ε ∧ z + t • (v + τ • u) ∈ S) : v ∈ posTangentConeAt S z := by apply mem_posTangentConeAt_of_approximations intro ε hε have hsmall : ∀ᶠ t : ℝ in 𝓝[>] 0, t ∈ Set.Ioo 0 ε := Ioo_mem_nhdsGT hε obtain ⟨t, ht, hroot⟩ := (hsmall.and (hcorrection ε hε)).exists obtain ⟨τ, hτ, hS⟩ := hroot exact ⟨t, τ, ht.1, ht.2, hτ, hS⟩ end end Source29TangentRealization /- Component: PolynomialTranslation.lean -/ namespace Source29PolynomialTranslation open Finset MvPolynomial noncomputable section variable {R ι : Type*} [CommRing R] /-- Translate the variables by the vector z. -/ def translate (P : MvPolynomial ι R) (z : ι → R) : MvPolynomial ι R := eval₂ C (fun i => X i + C (z i)) P lemma translate_C (r : R) (z : ι → R) : translate (C r) z = C r := by simp [translate] lemma translate_X (i : ι) (z : ι → R) : translate (X i) z = X i + C (z i) := by simp [translate] lemma translate_add (P Q : MvPolynomial ι R) (z : ι → R) : translate (P + Q) z = translate P z + translate Q z := by simp [translate] lemma translate_mul (P Q : MvPolynomial ι R) (z : ι → R) : translate (P * Q) z = translate P z * translate Q z := by simp [translate] lemma translate_zero_polynomial (z : ι → R) : translate (0 : MvPolynomial ι R) z = 0 := by simp [translate] lemma eval_translate (P : MvPolynomial ι R) (z y : ι → R) : eval y (translate P z) = eval (fun i => z i + y i) P := by apply MvPolynomial.induction_on P · intro r simp [translate_C] · intro p q hp hq simp only [translate_add, map_add, hp, hq] · intro p i hp simp only [translate_mul, translate_X, map_mul, map_add, eval_X, eval_C, hp] ring lemma translate_translate (P : MvPolynomial ι R) (z w : ι → R) : translate (translate P z) w = translate P (fun i => z i + w i) := by apply MvPolynomial.induction_on P · intro r simp only [translate_C] · intro p q hp hq simp only [translate_add, hp, hq] · intro p i hp simp only [translate_mul, translate_add, translate_X, translate_C, hp, map_add] ring lemma translate_zero_vector (P : MvPolynomial ι R) : translate P (0 : ι → R) = P := by apply MvPolynomial.induction_on P · intro r exact translate_C r 0 · intro p q hp hq rw [translate_add, hp, hq] · intro p i hp rw [translate_mul, hp, translate_X] simp lemma translate_inverse (P : MvPolynomial ι R) (z : ι → R) : translate (translate P z) (fun i => -z i) = P := by rw [translate_translate] have hz : (fun i => z i + -z i) = (0 : ι → R) := by funext i simp rw [hz, translate_zero_vector] lemma translate_injective (z : ι → R) : Function.Injective (fun P : MvPolynomial ι R => translate P z) := by intro P Q h have hh := congrArg (fun F : MvPolynomial ι R => translate F (fun i => -z i)) h simpa only [translate_inverse] using hh lemma translate_eq_zero_iff (P : MvPolynomial ι R) (z : ι → R) : translate P z = 0 ↔ P = 0 := by constructor · intro h apply translate_injective z simpa only [translate_zero_polynomial] using h · intro h rw [h, translate_zero_polynomial] lemma translate_ne_zero (P : MvPolynomial ι R) (z : ι → R) (hP : P ≠ 0) : translate P z ≠ 0 := by intro h exact hP ((translate_eq_zero_iff P z).mp h) lemma eval_zero_translate (P : MvPolynomial ι R) (z : ι → R) : eval (0 : ι → R) (translate P z) = eval z P := by rw [eval_translate] simp lemma homogeneousComponent_zero_of_eval_zero (P : MvPolynomial ι R) (hP : eval (0 : ι → R) P = 0) : homogeneousComponent 0 P = 0 := by rw [homogeneousComponent_zero] have hc : P.coeff 0 = 0 := by simpa only [eval_zero, constantCoeff_eq] using hP rw [hc, map_zero] /-- A nonzero polynomial vanishing at the origin has a first nonzero homogeneous component, whose degree is positive and bounded by its total degree. -/ theorem exists_lowest_nonzero_component (P : MvPolynomial ι R) (hne : P ≠ 0) (hzero : eval (0 : ι → R) P = 0) : ∃ s : ℕ, 0 < s ∧ s ≤ P.totalDegree ∧ homogeneousComponent s P ≠ 0 ∧ ∀ k : ℕ, k < s → homogeneousComponent k P = 0 := by classical have hex : ∃ s : ℕ, homogeneousComponent s P ≠ 0 := by by_contra h push Not at h apply hne rw [← sum_homogeneousComponent P] simp only [h, Finset.sum_const_zero] let s : ℕ := Nat.find hex have hs : homogeneousComponent s P ≠ 0 := Nat.find_spec hex have hspos : 0 < s := by have hsz : s ≠ 0 := by intro heq apply hs rw [heq] exact homogeneousComponent_zero_of_eval_zero P hzero omega have hsdegree : s ≤ P.totalDegree := by by_contra h exact hs (homogeneousComponent_eq_zero s P (by omega)) refine ⟨s, hspos, hsdegree, hs, ?_⟩ intro k hk exact not_not.mp (Nat.find_min hex hk) /-- Apply the lowest-component result to the polynomial expanded around a root. -/ theorem exists_lowest_component_at_root (P : MvPolynomial ι R) (hne : P ≠ 0) (z : ι → R) (hroot : eval z P = 0) : ∃ s : ℕ, 0 < s ∧ s ≤ (translate P z).totalDegree ∧ homogeneousComponent s (translate P z) ≠ 0 ∧ ∀ k : ℕ, k < s → homogeneousComponent k (translate P z) = 0 := by apply exists_lowest_nonzero_component (translate P z) (translate_ne_zero P z hne) rwa [eval_zero_translate] lemma translate_one (z : ι → R) : translate (1 : MvPolynomial ι R) z = 1 := by simp [translate] lemma translate_pow (P : MvPolynomial ι R) (z : ι → R) (n : ℕ) : translate (P^n) z = (translate P z)^n := by simp [translate] lemma translate_sum {α : Type*} (s : Finset α) (f : α → MvPolynomial ι R) (z : ι → R) : translate (∑ a ∈ s, f a) z = ∑ a ∈ s, translate (f a) z := by simp [translate] lemma translate_dvd (P Q : MvPolynomial ι R) (z : ι → R) (h : P ∣ Q) : translate P z ∣ translate Q z := by obtain ⟨v, hv⟩ := h use translate v z rw [hv, translate_mul] /-- Partial differentiation commutes with translation by a constant vector. -/ lemma pderiv_translate (P : MvPolynomial ι R) (z : ι → R) (i : ι) : pderiv i (translate P z) = translate (pderiv i P) z := by classical apply MvPolynomial.induction_on P · intro r simp only [translate_C, pderiv_C, translate_zero_polynomial] · intro p q hp hq simp only [translate_add, map_add, hp, hq] · intro p j hp by_cases hij : j = i · subst j simp only [translate_mul, translate_X, pderiv_mul, map_add, pderiv_C, pderiv_X_self, translate_add, translate_one, hp, add_zero] · simp only [translate_mul, translate_X, pderiv_mul, map_add, pderiv_C, pderiv_X_of_ne hij, translate_add, translate_zero_polynomial, hp, zero_add, add_zero, mul_zero] end end Source29PolynomialTranslation /- Component: ComplexTangent.lean -/ open scoped BigOperators Topology namespace Source29ComplexTangent noncomputable section variable {ι : Type*} [Fintype ι] /-- Complex bilinear pairing, without conjugation. -/ def dot (z v : EuclideanSpace ℂ ι) : ℂ := ∑ i, z i * v i /-- Squared Euclidean size. -/ def energy (z : EuclideanSpace ℂ ι) : ℝ := ‖z‖ ^ 2 /-- A polynomial objective for the projective maximum, avoiding `log` and division. -/ def objective (κ : ℝ) (z : EuclideanSpace ℂ ι) : ℝ := ‖dot z z‖ ^ 2 - κ ^ 2 * energy z ^ 2 /-- The complex linear form associated to the bilinear pairing. -/ def dotCLM (z : EuclideanSpace ℂ ι) : EuclideanSpace ℂ ι →L[ℂ] ℂ := ∑ i, z i • EuclideanSpace.proj i theorem dotCLM_apply (z v : EuclideanSpace ℂ ι) : dotCLM z v = dot z v := by simp [dotCLM, dot] /-- Differential of the quadric as a real differential. -/ theorem hasFDerivAt_quadric (z : EuclideanSpace ℂ ι) : HasFDerivAt (fun w : EuclideanSpace ℂ ι => dot w w) (2 • (dotCLM z).restrictScalars ℝ) z := by have h := HasFDerivAt.sum (u := Finset.univ) (fun i _ => ((EuclideanSpace.proj i).restrictScalars ℝ).hasFDerivAt.mul ((EuclideanSpace.proj i).restrictScalars ℝ).hasFDerivAt (x := z)) convert h using 1 · funext w simp [dot] · ext v simp [dotCLM, two_mul, Finset.sum_add_distrib] /-- An extremum annihilates a complex tangent direction once its four real phases belong to the positive tangent cone. This does not assume the algebraic tangent-cone realization theorem: that geometric hypothesis remains explicit. -/ theorem annihilates_four_phases {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] [NormedSpace ℝ E] [IsScalarTower ℝ ℂ E] {f : E → ℝ} {S : Set E} {z v : E} (L : E →L[ℂ] ℂ) (a : ℝ) (ha : a ≠ 0) (hmax : IsLocalMaxOn f S z) (hd : HasFDerivAt f (a • (Complex.reCLM.comp (L.restrictScalars ℝ))) z) (hv : v ∈ posTangentConeAt S z) (hmv : -v ∈ posTangentConeAt S z) (hiv : Complex.I • v ∈ posTangentConeAt S z) (hmiv : -(Complex.I • v) ∈ posTangentConeAt S z) : L v = 0 := by have hreal := hmax.hasFDerivWithinAt_eq_zero hd.hasFDerivWithinAt hv hmv have himag := hmax.hasFDerivWithinAt_eq_zero hd.hasFDerivWithinAt hiv hmiv have hr : (L v).re = 0 := by have hh : a * (L v).re = 0 := by simpa using hreal exact (mul_eq_zero.mp hh).resolve_left ha have hi : (L v).im = 0 := by have hh : a * -(L v).im = 0 := by simpa [map_smul, Complex.mul_re] using himag exact neg_eq_zero.mp ((mul_eq_zero.mp hh).resolve_left ha) exact Complex.ext hr hi /-- Normal covector at a normalized maximum of the projective quadric ratio. -/ def normalCLM (κ : ℝ) (z : EuclideanSpace ℂ ι) : EuclideanSpace ℂ ι →L[ℂ] ℂ := dotCLM z - (κ : ℂ) • innerSL ℂ z theorem normalCLM_apply (κ : ℝ) (z v : EuclideanSpace ℂ ι) : normalCLM κ z v = ∑ i, (z i - (κ : ℂ) * star (z i)) * v i := by simp only [normalCLM, sub_apply, smul_apply, dotCLM_apply, dot, innerSL_apply_apply, PiLp.inner_apply, RCLike.inner_apply, smul_eq_mul, Finset.mul_sum, sub_mul, Finset.sum_sub_distrib] congr 1 apply Finset.sum_congr rfl intro i _ simp only [starRingEnd_apply] ring /-- First derivative of the polynomial maximum objective. -/ theorem hasFDerivAt_objective (κ : ℝ) (z : EuclideanSpace ℂ ι) (hq : dot z z = κ) (hz : ‖z‖ = 1) : HasFDerivAt (objective κ) ((4 * κ) • (Complex.reCLM.comp ((normalCLM κ z).restrictScalars ℝ))) z := by have h₁ := (hasFDerivAt_quadric z).norm_sq have h₂ := (((hasFDerivAt_id z).norm_sq).pow 2).const_mul (κ ^ 2) convert h₁.sub h₂ using 1 · funext w rfl · ext v simp [hq, hz, normalCLM, dotCLM_apply, real_inner_eq_re_inner ℂ, RCLike.inner_apply, Complex.mul_re, PiLp.inner_apply, Complex.re_sum] ring /-- The pointwise bound supplied by the projective maximum makes this objective nonpositive on the zero set, with value zero at the normalized maximizing point. -/ theorem objective_isLocalMaxOn (κ : ℝ) (S : Set (EuclideanSpace ℂ ι)) (z : EuclideanSpace ℂ ι) (hκ : 0 ≤ κ) (hq : dot z z = κ) (hz : ‖z‖ = 1) (hbound : ∀ w ∈ S, ‖dot w w‖ ≤ κ * ‖w‖ ^ 2) : IsLocalMaxOn (objective κ) S z := by apply IsMaxOn.isLocalMaxOn intro w hw have hb := hbound w hw have hs : ‖dot w w‖ ^ 2 ≤ (κ * ‖w‖ ^ 2) ^ 2 := by exact pow_le_pow_left₀ (norm_nonneg _) hb 2 have hn : ‖(κ : ℂ)‖ = κ := by simp [abs_of_nonneg hκ] change objective κ w ≤ objective κ z simp only [objective, energy, hq, hz, hn] nlinarith /-- First-order hyperplane restriction at the projective maximum. The sole geometric input here is membership of the four phases in the positive tangent cone; obtaining this from the lowest homogeneous Taylor term is separate. -/ theorem tangent_in_normal_hyperplane (κ : ℝ) (S : Set (EuclideanSpace ℂ ι)) (z v : EuclideanSpace ℂ ι) (hκ : 0 < κ) (hq : dot z z = κ) (hz : ‖z‖ = 1) (hbound : ∀ w ∈ S, ‖dot w w‖ ≤ κ * ‖w‖ ^ 2) (hv : v ∈ posTangentConeAt S z) (hmv : -v ∈ posTangentConeAt S z) (hiv : Complex.I • v ∈ posTangentConeAt S z) (hmiv : -(Complex.I • v) ∈ posTangentConeAt S z) : normalCLM κ z v = 0 := by exact annihilates_four_phases (normalCLM κ z) (4 * κ) (mul_ne_zero (by norm_num) (ne_of_gt hκ)) (objective_isLocalMaxOn κ S z hκ.le hq hz hbound) (hasFDerivAt_objective κ z hq hz) hv hmv hiv hmiv end end Source29ComplexTangent /- Component: InitialTangent.inc -/ /- The singular tangent-cone step of the maximum argument, realized through bounded-degree polynomial roots rather than a complex-analytic perturbation theorem. -/ namespace Source29InitialTangent open MvPolynomial open Source29ProjectiveMaximum Source29PolynomialTranslation open scoped BigOperators noncomputable section def zeroSet {n : ℕ} (h : MvPolynomial (Fin n) ℂ) : Set (CSpace n) := {w | eval (fun i => w i) h = 0} theorem initial_zero_mem_posTangentConeAt {n : ℕ} (h : MvPolynomial (Fin n) ℂ) (z : CSpace n) (s : ℕ) (hs : s ≤ (translate h (fun i => z i)).totalDegree) (hlow : ∀ k < s, homogeneousComponent k (translate h (fun i => z i)) = 0) (v : CSpace n) (u : Fin n → ℂ) (hv : eval (fun i => v i) (homogeneousComponent s (translate h (fun i => z i))) = 0) (hu : eval u (homogeneousComponent s (translate h (fun i => z i))) ≠ 0) : v ∈ posTangentConeAt (zeroSet h) z := by apply Source29TangentRealization.mem_posTangentConeAt_of_approximations (u := WithLp.toLp 2 u) intro ε hε obtain ⟨t, τ, htpos, htε, hτ, hzero⟩ := Source29SmallZeroApprox.exists_small_scaled_zero (translate h (fun i => z i)) s hs hlow (fun i => v i) u hv hu ε hε refine ⟨t, τ, htpos, htε, hτ, ?_⟩ rw [eval_translate] at hzero exact hzero /-- At the normalized maximum, every zero of the first homogeneous Taylor form lies in the complex normal hyperplane. This includes singular maximizing points. -/ theorem initial_zero_in_normal_hyperplane {n : ℕ} (h : MvPolynomial (Fin n) ℂ) (z : CSpace n) (s : ℕ) (hs : s ≤ (translate h (fun i => z i)).totalDegree) (hlow : ∀ k < s, homogeneousComponent k (translate h (fun i => z i)) = 0) (hne : homogeneousComponent s (translate h (fun i => z i)) ≠ 0) (κ : ℝ) (hk : 0 < κ) (hzunit : ‖z‖ = 1) (hzq : (∑ i : Fin n, (z i)^2) = (κ : ℂ)) (hbound : ∀ w : CSpace n, eval (fun i => w i) h = 0 → quadricNorm w ≤ κ * ‖w‖^2) (v : CSpace n) (hv : eval (fun i => v i) (homogeneousComponent s (translate h (fun i => z i))) = 0) : ∑ i : Fin n, (z i - (κ : ℂ) * star (z i)) * v i = 0 := by let H := homogeneousComponent s (translate h (fun i => z i)) have hhom : H.IsHomogeneous s := homogeneousComponent_isHomogeneous _ _ obtain ⟨u, hu⟩ : ∃ u : Fin n → ℂ, eval u H ≠ 0 := by by_contra hnone push Not at hnone exact hne (hhom.eq_zero_of_forall_eval_eq_zero hnone) have hmem (w : CSpace n) (hw : eval (fun i => w i) H = 0) : w ∈ posTangentConeAt (zeroSet h) z := initial_zero_mem_posTangentConeAt h z s hs hlow w u hw hu have hscale (a : ℂ) : eval (fun i => a * v i) H = 0 := by rw [eval_scale_of_isHomogeneous H s hhom, hv, mul_zero] have hq : Source29ComplexTangent.dot z z = (κ : ℂ) := by simpa only [Source29ComplexTangent.dot, pow_two] using hzq have hb : ∀ w ∈ zeroSet h, ‖Source29ComplexTangent.dot w w‖ ≤ κ * ‖w‖^2 := by intro w hw simpa only [Source29ComplexTangent.dot, quadricNorm, pow_two] using hbound w hw have hn := Source29ComplexTangent.tangent_in_normal_hyperplane κ (zeroSet h) z v hk hq hzunit hb (hmem v hv) (hmem (-v) (by simpa using hscale (-1))) (hmem (Complex.I • v) (by simpa using hscale Complex.I)) (hmem (-(Complex.I • v)) (by simpa using hscale (-Complex.I))) simpa only [Source29ComplexTangent.normalCLM_apply] using hn end end Source29InitialTangent /- Component: NormalCoordinates.lean -/ namespace Source29NormalCoordinates open Finset variable {ι : Type*} [Fintype ι] def dot (z w : ι → ℂ) : ℂ := ∑ i, z i * w i def conjugate (z : ι → ℂ) : ι → ℂ := fun i => star (z i) def realPart (z : ι → ℂ) : ι → ℂ := fun i => ((z i).re : ℂ) def imagPart (z : ι → ℂ) : ι → ℂ := fun i => ((z i).im : ℂ) def normal (z : ι → ℂ) (κ : ℝ) : ι → ℂ := fun i => z i - (κ : ℂ) * star (z i) lemma dot_comm (z w : ι → ℂ) : dot z w = dot w z := by simp [dot, mul_comm] lemma dot_add_left (z v w : ι → ℂ) : dot (fun i => z i + v i) w = dot z w + dot v w := by simp [dot, add_mul, Finset.sum_add_distrib] lemma dot_sub_left (z v w : ι → ℂ) : dot (fun i => z i - v i) w = dot z w - dot v w := by simp [dot, sub_mul, Finset.sum_sub_distrib] lemma dot_sub_right (z v w : ι → ℂ) : dot z (fun i => v i - w i) = dot z v - dot z w := by simp [dot, mul_sub, Finset.sum_sub_distrib] lemma dot_mul_left (c : ℂ) (z w : ι → ℂ) : dot (fun i => c * z i) w = c * dot z w := by simp [dot, mul_assoc, Finset.mul_sum] lemma dot_mul_right (c : ℂ) (z w : ι → ℂ) : dot z (fun i => c * w i) = c * dot z w := by rw [dot_comm, dot_mul_left, dot_comm w z] lemma dot_realPart (z v : ι → ℂ) : 2 * dot (realPart z) v = dot z v + dot (conjugate z) v := by unfold dot realPart conjugate rw [← Finset.sum_add_distrib, Finset.mul_sum] apply Finset.sum_congr rfl intro i hi have he : (2 : ℂ) * ((z i).re : ℂ) = z i + star (z i) := by apply Complex.ext <;> simp [Complex.mul_re, Complex.mul_im] <;> ring calc (2 : ℂ) * (((z i).re : ℂ) * v i) = (2 * ((z i).re : ℂ)) * v i := by ring _ = (z i + star (z i)) * v i := by rw [he] _ = z i * v i + star (z i) * v i := by ring lemma dot_imagPart (z v : ι → ℂ) : (2 * Complex.I) * dot (imagPart z) v = dot z v - dot (conjugate z) v := by unfold dot imagPart conjugate rw [← Finset.sum_sub_distrib, Finset.mul_sum] apply Finset.sum_congr rfl intro i hi have he : (2 * Complex.I) * ((z i).im : ℂ) = z i - star (z i) := by apply Complex.ext <;> simp [Complex.mul_re, Complex.mul_im] <;> ring calc (2 * Complex.I) * (((z i).im : ℂ) * v i) = ((2 * Complex.I) * ((z i).im : ℂ)) * v i := by ring _ = (z i - star (z i)) * v i := by rw [he] _ = z i * v i - star (z i) * v i := by ring lemma real_imag_orthogonal_iff (z v : ι → ℂ) : (dot (realPart z) v = 0 ∧ dot (imagPart z) v = 0) ↔ (dot z v = 0 ∧ dot (conjugate z) v = 0) := by have hr := dot_realPart z v have hi := dot_imagPart z v constructor · rintro ⟨hxr, hxi⟩ rw [hxr, mul_zero] at hr rw [hxi, mul_zero] at hi constructor · linear_combination -(hr + hi) / 2 · linear_combination -(hr - hi) / 2 · rintro ⟨hz, hzb⟩ rw [hz, hzb, add_zero] at hr rw [hz, hzb, sub_zero] at hi constructor · exact (mul_eq_zero.mp hr).resolve_left (by norm_num) · exact (mul_eq_zero.mp hi).resolve_left (by norm_num) /-- Real and imaginary parts of a unit complex vector whose bilinear square is real. -/ theorem real_imag_normalization {n : ℕ} (z : EuclideanSpace ℂ (Fin n)) (κ : ℝ) (hz : ‖z‖ = 1) (hq : ∑ i : Fin n, (z i)^2 = (κ : ℂ)) : (∑ i : Fin n, (z i).re * (z i).im) = 0 ∧ (∑ i : Fin n, (z i).re^2) = (1 + κ) / 2 ∧ (∑ i : Fin n, (z i).im^2) = (1 - κ) / 2 := by have hr := congrArg Complex.re hq simp only [Complex.re_sum, pow_two, Complex.mul_re, Complex.ofReal_re, Finset.sum_sub_distrib] at hr have hi := congrArg Complex.im hq simp only [Complex.im_sum, pow_two, Complex.mul_im, Complex.ofReal_im, Finset.sum_add_distrib] at hi have hc : (∑ i : Fin n, (z i).im * (z i).re) = ∑ i : Fin n, (z i).re * (z i).im := by apply Finset.sum_congr rfl intro i hi ring rw [hc] at hi have hn := EuclideanSpace.norm_sq_eq z rw [hz] at hn simp only [one_pow, Complex.sq_norm, Complex.normSq_apply, Finset.sum_add_distrib] at hn simp only [pow_two] constructor · linarith constructor <;> linarith lemma dot_add_right (z v w : ι → ℂ) : dot z (fun i => v i + w i) = dot z v + dot z w := by simp [dot, mul_add, Finset.sum_add_distrib] lemma dot_single_right [DecidableEq ι] (z : ι → ℂ) (i : ι) : dot z (Pi.single i 1) = z i := by simp [dot, Pi.single_apply] /-- A nonisotropic normal gives a nondegenerate bilinear metric on its perpendicular space. -/ theorem perpendicular_nondegenerate [DecidableEq ι] (N : ι → ℂ) (hN : dot N N ≠ 0) (w : ι → ℂ) (hw : dot N w = 0) (horth : ∀ v : ι → ℂ, dot N v = 0 → dot w v = 0) : w = 0 := by have hwN : dot w N = 0 := by rw [dot_comm]; exact hw ext i let v : ι → ℂ := fun j => ((Pi.single i (1 : ℂ)) : ι → ℂ) j - (N i / dot N N) * N j have hv : dot N v = 0 := by dsimp only [v] rw [dot_sub_right, dot_mul_right, dot_single_right] field_simp ring have hh := horth v hv dsimp only [v] at hh rw [dot_sub_right, dot_mul_right, dot_single_right, hwN, mul_zero, sub_zero] at hh exact hh /-- The normal perpendicular space splits as the radial complex line plus the space perpendicular to both real and imaginary parts. -/ theorem tangent_decomposition (z : ι → ℂ) (κ : ℝ) (hq : dot z z = (κ : ℂ)) (hnorm : dot (conjugate z) z = 1) (v : ι → ℂ) (hv : dot (normal z κ) v = 0) : ∃ (a : ℂ) (e : ι → ℂ), v = (fun i => a * z i + e i) ∧ dot (realPart z) e = 0 ∧ dot (imagPart z) e = 0 := by let a : ℂ := dot (conjugate z) v let e : ι → ℂ := fun i => v i - a * z i have hez : dot z e = 0 := by change dot (fun i => z i - (κ : ℂ) * star (z i)) v = 0 at hv rw [dot_sub_left, dot_mul_left] at hv dsimp only [e] rw [dot_sub_right, dot_mul_right, hq] change dot z v - dot (conjugate z) v * (κ : ℂ) = 0 change dot z v - (κ : ℂ) * dot (conjugate z) v = 0 at hv linear_combination hv have hebar : dot (conjugate z) e = 0 := by dsimp only [e] rw [dot_sub_right, dot_mul_right, hnorm] dsimp only [a] ring have he := (real_imag_orthogonal_iff z e).mpr ⟨hez, hebar⟩ refine ⟨a, e, ?_, he.1, he.2⟩ funext i dsimp only [e] ring /-- The radial coefficient and complementary vector in the splitting are unique. -/ theorem tangent_decomposition_unique (z : ι → ℂ) (hnorm : dot (conjugate z) z = 1) (v : ι → ℂ) (a b : ℂ) (e f : ι → ℂ) (he : dot (realPart z) e = 0 ∧ dot (imagPart z) e = 0) (hf : dot (realPart z) f = 0 ∧ dot (imagPart z) f = 0) (hve : v = fun i => a * z i + e i) (hvf : v = fun i => b * z i + f i) : a = b ∧ e = f := by have hebar := ((real_imag_orthogonal_iff z e).mp he).2 have hfbar := ((real_imag_orthogonal_iff z f).mp hf).2 have hcoeff : a = b := by have hh := congrArg (dot (conjugate z)) (hve.symm.trans hvf) rw [dot_add_right, dot_add_right, dot_mul_right, dot_mul_right, hnorm, hebar, hfbar] at hh simpa using hh refine ⟨hcoeff, ?_⟩ funext i have hh := congrArg (fun w : ι → ℂ => w i) (hve.symm.trans hvf) rw [hcoeff] at hh exact add_left_cancel hh lemma hermitian_dot_eq_norm_sq {n : ℕ} (z : EuclideanSpace ℂ (Fin n)) : dot (conjugate (fun i => z i)) (fun i => z i) = ((‖z‖^2 : ℝ) : ℂ) := by calc dot (conjugate (fun i => z i)) (fun i => z i) = ∑ i : Fin n, ((‖z i‖^2 : ℝ) : ℂ) := by unfold dot conjugate apply Finset.sum_congr rfl intro i hi simpa only [Complex.normSq_eq_norm_sq, Complex.star_def] using (Complex.normSq_eq_conj_mul_self (z := z i)).symm _ = ((∑ i : Fin n, ‖z i‖^2 : ℝ) : ℂ) := by simp _ = ((‖z‖^2 : ℝ) : ℂ) := by rw [EuclideanSpace.norm_sq_eq] lemma hermitian_dot_eq_one {n : ℕ} (z : EuclideanSpace ℂ (Fin n)) (hz : ‖z‖ = 1) : dot (conjugate (fun i => z i)) (fun i => z i) = 1 := by rw [hermitian_dot_eq_norm_sq, hz] norm_num lemma normal_square (z : ι → ℂ) (κ : ℝ) (hq : dot z z = (κ : ℂ)) (hnorm : dot (conjugate z) z = 1) : dot (normal z κ) (normal z κ) = -(κ : ℂ) * (1 - (κ : ℂ)^2) := by have hconj : dot (conjugate z) (conjugate z) = (κ : ℂ) := by have he := congrArg star hq simpa [dot, conjugate, map_sum, map_mul] using he have hcross : dot z (conjugate z) = 1 := by rw [dot_comm]; exact hnorm unfold normal change dot (fun i => z i - (κ : ℂ) * conjugate z i) (fun i => z i - (κ : ℂ) * conjugate z i) = _ rw [dot_sub_left, dot_sub_right, dot_sub_right, dot_mul_right, dot_mul_left, dot_mul_left, dot_mul_right, hq, hnorm, hcross, hconj] ring lemma normal_square_ne_zero (z : ι → ℂ) (κ : ℝ) (hpos : 0 < κ) (hlt : κ < 1) (hq : dot z z = (κ : ℂ)) (hnorm : dot (conjugate z) z = 1) : dot (normal z κ) (normal z κ) ≠ 0 := by rw [normal_square z κ hq hnorm] have hr : -(κ : ℝ) * (1 - κ^2) ≠ 0 := by have hs : κ^2 < 1 := by nlinarith exact ne_of_lt (mul_neg_of_neg_of_pos (neg_neg_of_pos hpos) (sub_pos.mpr hs)) exact_mod_cast hr /-- Nondegeneracy of the complex bilinear metric on the tangent hyperplane. -/ theorem tangent_metric_nondegenerate [DecidableEq ι] (z : ι → ℂ) (κ : ℝ) (hpos : 0 < κ) (hlt : κ < 1) (hq : dot z z = (κ : ℂ)) (hnorm : dot (conjugate z) z = 1) (w : ι → ℂ) (hw : dot (normal z κ) w = 0) (horth : ∀ v : ι → ℂ, dot (normal z κ) v = 0 → dot w v = 0) : w = 0 := perpendicular_nondegenerate (normal z κ) (normal_square_ne_zero z κ hpos hlt hq hnorm) w hw horth /-- Nondegeneracy of the complex bilinear metric on the complement of the real and imaginary parts of the normalized point. -/ theorem transverse_metric_nondegenerate [DecidableEq ι] (z : ι → ℂ) (κ : ℝ) (hpos : 0 < κ) (hlt : κ < 1) (hq : dot z z = (κ : ℂ)) (hnorm : dot (conjugate z) z = 1) (w : ι → ℂ) (hw : dot (realPart z) w = 0 ∧ dot (imagPart z) w = 0) (horth : ∀ v : ι → ℂ, dot (realPart z) v = 0 → dot (imagPart z) v = 0 → dot w v = 0) : w = 0 := by have hwc := (real_imag_orthogonal_iff z w).mp hw have hwn : dot (normal z κ) w = 0 := by unfold normal change dot (fun i => z i - (κ : ℂ) * conjugate z i) w = 0 rw [dot_sub_left, dot_mul_left, hwc.1, hwc.2] ring have hwz : dot w z = 0 := by rw [dot_comm]; exact hwc.1 apply tangent_metric_nondegenerate z κ hpos hlt hq hnorm w hwn intro v hv obtain ⟨a, e, hve, her, hei⟩ := tangent_decomposition z κ hq hnorm v hv have he := horth e her hei rw [hve, dot_add_right, dot_mul_right, hwz, he] ring lemma normal_radial_orthogonal (z : ι → ℂ) (κ : ℝ) (hq : dot z z = (κ : ℂ)) (hnorm : dot (conjugate z) z = 1) : dot (normal z κ) z = 0 := by unfold normal change dot (fun i => z i - (κ : ℂ) * conjugate z i) z = 0 rw [dot_sub_left, dot_mul_left, hq, hnorm] ring lemma radial_plus_transverse_mem_tangent (z : ι → ℂ) (κ : ℝ) (hq : dot z z = (κ : ℂ)) (hnorm : dot (conjugate z) z = 1) (a : ℂ) (e : ι → ℂ) (he : dot (realPart z) e = 0 ∧ dot (imagPart z) e = 0) : dot (normal z κ) (fun i => a * z i + e i) = 0 := by have hec := (real_imag_orthogonal_iff z e).mp he have hen : dot (normal z κ) e = 0 := by unfold normal change dot (fun i => z i - (κ : ℂ) * conjugate z i) e = 0 rw [dot_sub_left, dot_mul_left, hec.1, hec.2] ring rw [dot_add_right, dot_mul_right, normal_radial_orthogonal z κ hq hnorm, hen] ring /-- An exact characterization of the tangent hyperplane as the orthogonal sum of the radial complex line and the real/imaginary perpendicular space. -/ theorem tangent_decomposition_iff (z : ι → ℂ) (κ : ℝ) (hq : dot z z = (κ : ℂ)) (hnorm : dot (conjugate z) z = 1) (v : ι → ℂ) : dot (normal z κ) v = 0 ↔ ∃ (a : ℂ) (e : ι → ℂ), v = (fun i => a * z i + e i) ∧ dot (realPart z) e = 0 ∧ dot (imagPart z) e = 0 := by constructor · exact tangent_decomposition z κ hq hnorm v · rintro ⟨a, e, rfl, her, hei⟩ exact radial_plus_transverse_mem_tangent z κ hq hnorm a e ⟨her, hei⟩ lemma real_imag_nonzero {n : ℕ} (z : EuclideanSpace ℂ (Fin n)) (κ : ℝ) (hpos : 0 < κ) (hlt : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin n, (z i)^2 = (κ : ℂ)) : (fun i => (z i).re) ≠ 0 ∧ (fun i => (z i).im) ≠ 0 := by obtain ⟨hxy, hx, hy⟩ := real_imag_normalization z κ hz hq constructor · intro hzero have hh : (∑ i : Fin n, (z i).re^2) = 0 := by apply Finset.sum_eq_zero intro i hi have he := congrArg (fun f : Fin n → ℝ => f i) hzero change (z i).re = 0 at he rw [he] norm_num linarith · intro hzero have hh : (∑ i : Fin n, (z i).im^2) = 0 := by apply Finset.sum_eq_zero intro i hi have he := congrArg (fun f : Fin n → ℝ => f i) hzero change (z i).im = 0 at he rw [he] norm_num linarith end Source29NormalCoordinates /- Component: LinearForm.lean -/ namespace Source29LinearForm open MvPolynomial open scoped BigOperators noncomputable section variable {K ι : Type*} [Field K] [Fintype ι] /-- The homogeneous linear polynomial associated to a coefficient vector. -/ def linearForm (a : ι → K) : MvPolynomial ι K := ∑ i, C (a i) * X i theorem eval_linearForm (a x : ι → K) : eval x (linearForm a) = ∑ i, a i * x i := by simp [linearForm] theorem coeff_linearForm (a : ι → K) (j : ι) : (linearForm a).coeff (Finsupp.single j 1) = a j := by classical simp only [linearForm, coeff_sum, coeff_C_mul, coeff_X] rw [Finset.sum_eq_single j] · simp · intro i _ hij have hd : Finsupp.single j 1 ≠ Finsupp.single i (1 : ℕ) := by simpa [Finsupp.single_left_inj Nat.one_ne_zero] using Ne.symm hij simp [Ne.symm hd] · simp theorem linearForm_isHomogeneous (a : ι → K) : (linearForm a).IsHomogeneous 1 := by apply IsHomogeneous.sum intro i _ exact (isHomogeneous_X K i).C_mul (a i) theorem linearForm_ne_zero (a : ι → K) (ha : ∃ i, a i ≠ 0) : linearForm a ≠ 0 := by obtain ⟨i, hi⟩ := ha intro hz have hc := congrArg (fun p : MvPolynomial ι K => p.coeff (Finsupp.single i 1)) hz apply hi simpa [coeff_linearForm] using hc theorem linearForm_totalDegree (a : ι → K) (ha : ∃ i, a i ≠ 0) : (linearForm a).totalDegree = 1 := (linearForm_isHomogeneous a).totalDegree (linearForm_ne_zero a ha) /-- Elementary degree proof, adapted from mathlib's `RingTheory/MvPolynomial/IrreducibleQuadratic.lean`; that file is outside the permitted import closure. Over a field a nonzero constant is a unit. -/ theorem irreducible_of_totalDegree_one (p : MvPolynomial ι K) (hp : p.totalDegree = 1) : Irreducible p := by have hpne : p ≠ 0 := by intro h; simp [h] at hp refine ⟨?_, ?_⟩ · intro hu have hd := totalDegree_le_of_dvd_of_isDomain (hu.dvd : p ∣ (1 : MvPolynomial ι K)) (one_ne_zero : (1 : MvPolynomial ι K) ≠ 0) simp [hp] at hd · intro f g hfg have hfn : f ≠ 0 := left_ne_zero_of_mul (hfg ▸ hpne) have hgn : g ≠ 0 := right_ne_zero_of_mul (hfg ▸ hpne) have hd : f.totalDegree + g.totalDegree = 1 := by rw [← totalDegree_mul_of_isDomain hfn hgn, ← hfg, hp] have hconst (q : MvPolynomial ι K) (hq : q ≠ 0) (hqd : q.totalDegree = 0) : IsUnit q := by have he := totalDegree_eq_zero_iff_eq_C.mp hqd rw [he] apply IsUnit.map C apply isUnit_iff_ne_zero.mpr intro hc apply hq rw [he, hc, map_zero] by_cases hf : f.totalDegree = 0 · exact Or.inl (hconst f hfn hf) · exact Or.inr (hconst g hgn (by omega)) theorem linearForm_irreducible (a : ι → K) (ha : ∃ i, a i ≠ 0) : Irreducible (linearForm a) := irreducible_of_totalDegree_one _ (linearForm_totalDegree a ha) end end Source29LinearForm /- Component: HyperplanePower.lean -/ namespace Source29HyperplanePower open MvPolynomial noncomputable section variable {K ι : Type*} [Field K] [IsAlgClosed K] [Fintype ι] /-- A polynomial whose zero set lies in one irreducible hypersurface is a unit times a power of its defining polynomial. Applied to a nonzero linear form, this is the algebraic conclusion of the tangent-hyperplane argument. -/ theorem associated_pow_of_zero_set_subset (H L : MvPolynomial ι K) (hL : Irreducible L) (hvan : ∀ z : ι → K, eval z H = 0 → eval z L = 0) : ∃ s : ℕ, Associated H (L ^ s) := by let J : Ideal (MvPolynomial ι K) := Ideal.span {H} have hmem : L ∈ vanishingIdeal K (zeroLocus K J) := by intro z hz have hH : H ∈ J := Ideal.subset_span (Set.mem_singleton H) have hzH := hz H hH simpa using hvan z (by simpa using hzH) rw [vanishingIdeal_zeroLocus_eq_radical] at hmem obtain ⟨n, hn⟩ := hmem obtain ⟨s, _, hs⟩ := (dvd_prime_pow hL.prime n).mp (Ideal.mem_span_singleton.mp hn) exact ⟨s, hs⟩ /-- For a homogeneous polynomial and a degree-one defining form, the power is exactly the homogeneous degree. -/ theorem associated_degree_pow_of_zero_set_subset (H L : MvPolynomial ι K) (s : ℕ) (hH : H.IsHomogeneous s) (hHne : H ≠ 0) (hL : Irreducible L) (hLdegree : L.totalDegree = 1) (hvan : ∀ z : ι → K, eval z H = 0 → eval z L = 0) : Associated H (L ^ s) := by obtain ⟨k, hk⟩ := associated_pow_of_zero_set_subset H L hL hvan have hpow : ∀ k : ℕ, (L ^ k).totalDegree = k := by intro k induction k with | zero => simp | succ k ih => rw [pow_succ, totalDegree_mul_of_isDomain (pow_ne_zero _ hL.ne_zero) hL.ne_zero, ih, hLdegree] have hd : H.totalDegree = (L ^ k).totalDegree := le_antisymm (totalDegree_le_of_dvd_of_isDomain hk.dvd (pow_ne_zero _ hL.ne_zero)) (totalDegree_le_of_dvd_of_isDomain hk.symm.dvd hHne) have hsk : s = k := by simpa only [hH.totalDegree hHne, hpow] using hd simpa only [← hsk] using hk /-- Coordinate form of the tangent-cone conclusion, with an explicit nonzero scalar coefficient. -/ theorem eq_C_mul_degree_pow_of_zero_set_subset (H L : MvPolynomial ι K) (s : ℕ) (hH : H.IsHomogeneous s) (hHne : H ≠ 0) (hL : Irreducible L) (hLdegree : L.totalDegree = 1) (hvan : ∀ z : ι → K, eval z H = 0 → eval z L = 0) : ∃ a : K, a ≠ 0 ∧ H = C a * L ^ s := by have hassoc := associated_degree_pow_of_zero_set_subset H L s hH hHne hL hLdegree hvan obtain ⟨u, hu⟩ := hassoc.symm have hdegree : (u : MvPolynomial ι K).totalDegree = 0 := by have hle := totalDegree_le_of_dvd_of_isDomain (u.isUnit.dvd : (u : MvPolynomial ι K) ∣ (1 : MvPolynomial ι K)) (one_ne_zero : (1 : MvPolynomial ι K) ≠ 0) simpa using hle have hua := totalDegree_eq_zero_iff_eq_C.mp hdegree refine ⟨(u : MvPolynomial ι K).coeff 0, ?_, ?_⟩ · intro hc apply u.ne_zero rw [hua, hc, map_zero] · rw [← hu, hua, mul_comm] simp end end Source29HyperplanePower /- Component: InitialNormalPower.inc -/ /- At any possibly singular normalized maximum, the first nonzero Taylor polynomial is a nonzero multiple of a power of the normal linear form. -/ namespace Source29InitialNormalPower open MvPolynomial open Source29ProjectiveMaximum Source29PolynomialTranslation open scoped BigOperators noncomputable section theorem initial_is_normal_power {n : ℕ} (h : MvPolynomial (Fin n) ℂ) (z : CSpace n) (s : ℕ) (hs : s ≤ (translate h (fun i => z i)).totalDegree) (hlow : ∀ k < s, homogeneousComponent k (translate h (fun i => z i)) = 0) (hne : homogeneousComponent s (translate h (fun i => z i)) ≠ 0) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hzunit : ‖z‖ = 1) (hzq : (∑ i : Fin n, (z i)^2) = (κ : ℂ)) (hbound : ∀ w : CSpace n, eval (fun i => w i) h = 0 → quadricNorm w ≤ κ * ‖w‖^2) : ∃ a : ℂ, a ≠ 0 ∧ homogeneousComponent s (translate h (fun i => z i)) = C a * (Source29LinearForm.linearForm (fun i => z i - (κ : ℂ) * star (z i))) ^ s := by letI : IsAlgClosed ℂ := Source29FTA.complex_isAlgClosed let N : Fin n → ℂ := fun i => z i - (κ : ℂ) * star (z i) have hq : Source29NormalCoordinates.dot (fun i => z i) (fun i => z i) = κ := by simpa only [Source29NormalCoordinates.dot, pow_two] using hzq have hnorm := Source29NormalCoordinates.hermitian_dot_eq_one z hzunit have hN : Source29NormalCoordinates.dot N N ≠ 0 := Source29NormalCoordinates.normal_square_ne_zero (fun i => z i) κ hk hk1 hq hnorm have hNsome : ∃ i, N i ≠ 0 := by by_contra hnone push Not at hnone exact hN (by simp [Source29NormalCoordinates.dot, hnone]) apply Source29HyperplanePower.eq_C_mul_degree_pow_of_zero_set_subset _ _ s (homogeneousComponent_isHomogeneous _ _) hne (Source29LinearForm.linearForm_irreducible N hNsome) (Source29LinearForm.linearForm_totalDegree N hNsome) intro x hx rw [Source29LinearForm.eval_linearForm] exact Source29InitialTangent.initial_zero_in_normal_hyperplane h z s hs hlow hne κ hk hzunit hzq hbound (WithLp.toLp 2 x) hx /-- The complete initial-form conclusion needs only a nonzero polynomial and a normalized maximum. No smoothness assumption on that point is made. -/ theorem exists_normal_power_initial {n : ℕ} (h : MvPolynomial (Fin n) ℂ) (hne : h ≠ 0) (z : CSpace n) (hzero : eval (fun i => z i) h = 0) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hzunit : ‖z‖ = 1) (hzq : (∑ i : Fin n, (z i)^2) = (κ : ℂ)) (hbound : ∀ w : CSpace n, eval (fun i => w i) h = 0 → quadricNorm w ≤ κ * ‖w‖^2) : ∃ (s : ℕ) (a : ℂ), 0 < s ∧ s ≤ (translate h (fun i => z i)).totalDegree ∧ a ≠ 0 ∧ (∀ k < s, homogeneousComponent k (translate h (fun i => z i)) = 0) ∧ homogeneousComponent s (translate h (fun i => z i)) = C a * (Source29LinearForm.linearForm (fun i => z i - (κ : ℂ) * star (z i))) ^ s := by obtain ⟨s, hspos, hsdegree, hsne, hlow⟩ := exists_lowest_component_at_root h hne (fun i => z i) hzero obtain ⟨a, ha, hform⟩ := initial_is_normal_power h z s hsdegree hlow hsne κ hk hk1 hzunit hzq hbound exact ⟨s, a, hspos, hsdegree, ha, hlow, hform⟩ end end Source29InitialNormalPower /- Component: MetricJet.lean -/ /-! # Metric algebra for local defining functions These are identities of covectors and Hessian arrays. No assertion about the existence or regularity of analytic defining functions is assumed or proved. -/ namespace Source29MetricJet open scoped BigOperators variable {R ι : Type*} [CommRing R] [Fintype ι] noncomputable def dot (v w : ι → R) : R := ∑ i, v i*w i noncomputable def raiseIndex (M : ι → ι → R) (g : ι → R) (i : ι) : R := ∑ j, M i j*g j noncomputable def metricPair (M : ι → ι → R) (g b : ι → R) : R := ∑ i, ∑ j, M i j*g i*b j noncomputable def metricTrace (M H : ι → ι → R) : R := ∑ i, ∑ j, M i j*H i j noncomputable def contract (H : ι → ι → R) (v w : ι → R) : R := ∑ i, ∑ j, H i j*v i*w j noncomputable def operator (M : ι → ι → R) (g : ι → R) (H : ι → ι → R) : R := metricPair M g g * metricTrace M H - contract H (raiseIndex M g) (raiseIndex M g) lemma raiseIndex_scale (M : ι → ι → R) (g : ι → R) (u : R) : raiseIndex M (fun i => u*g i) = fun i => u*raiseIndex M g i := by funext i simp only [raiseIndex, Finset.mul_sum] apply Finset.sum_congr rfl intro j hj ring lemma metricPair_scale (M : ι → ι → R) (g b : ι → R) (u v : R) : metricPair M (fun i => u*g i) (fun i => v*b i) = u*v*metricPair M g b := by simp only [metricPair, Finset.mul_sum] apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro j hj ring lemma metricPair_symm (M : ι → ι → R) (hM : ∀ i j, M i j = M j i) (g b : ι → R) : metricPair M g b = metricPair M b g := by unfold metricPair rw [Finset.sum_comm] apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro j hj rw [hM j i] ring lemma dot_raiseIndex (M : ι → ι → R) (g b : ι → R) : dot g (raiseIndex M b) = metricPair M g b := by simp only [dot, raiseIndex, metricPair, Finset.mul_sum] apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro j hj ring lemma metricTrace_add (M H K : ι → ι → R) : metricTrace M (fun i j => H i j+K i j) = metricTrace M H+metricTrace M K := by simp only [metricTrace, mul_add, Finset.sum_add_distrib] lemma metricTrace_scale (M H : ι → ι → R) (u : R) : metricTrace M (fun i j => u*H i j) = u*metricTrace M H := by simp only [metricTrace, Finset.mul_sum] apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro j hj ring lemma metricTrace_outer (M : ι → ι → R) (g b : ι → R) : metricTrace M (fun i j => g i*b j) = metricPair M g b := by simp only [metricTrace, metricPair, mul_assoc] lemma contract_add (H K : ι → ι → R) (v w : ι → R) : contract (fun i j => H i j+K i j) v w = contract H v w+contract K v w := by simp only [contract, add_mul, Finset.sum_add_distrib] lemma contract_scale (H : ι → ι → R) (u : R) (v w : ι → R) : contract (fun i j => u*H i j) v w = u*contract H v w := by simp only [contract, Finset.mul_sum, mul_assoc] lemma contract_scale_vectors (H : ι → ι → R) (u v : R) (g b : ι → R) : contract H (fun i => u*g i) (fun i => v*b i) = u*v*contract H g b := by simp only [contract, Finset.mul_sum] apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro j hj ring lemma contract_outer (g b v w : ι → R) : contract (fun i j => g i*b j) v w = dot g v*dot b w := by simp only [contract, dot, Finset.sum_mul, Finset.mul_sum] rw [Finset.sum_comm] apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro j hj ring /-- At a zero of a defining function, multiplication by a scalar function has these gradient/Hessian jets. Their cubic metric operator scales by u^3. This algebraic identity does not require u to be invertible or H symmetric. -/ theorem defining_function_unit_identity (M : ι → ι → R) (hM : ∀ i j, M i j = M j i) (g b : ι → R) (H : ι → ι → R) (u : R) : operator M (fun i => u*g i) (fun i j => u*H i j+g i*b j+b i*g j) = u^3*operator M g H := by unfold operator rw [raiseIndex_scale, metricPair_scale, metricTrace_add, metricTrace_add, metricTrace_scale, metricTrace_outer, metricTrace_outer, contract_scale_vectors, contract_add, contract_add, contract_scale, contract_outer, contract_outer, dot_raiseIndex, dot_raiseIndex] rw [metricPair_symm M hM b g] ring /-- Block inverse metric, with the normal coordinate indexed by `none`. -/ def blockMetric (M : ι → ι → R) (d : R) : Option ι → Option ι → R | none, none => d | some i, some j => M i j | _, _ => 0 /-- The covector of the formal defining function w-f. -/ def graphCovector (g : ι → R) : Option ι → R | none => 1 | some i => -g i /-- The Hessian array of the formal defining function w-f. -/ def graphHessian (H : ι → ι → R) : Option ι → Option ι → R | some i, some j => -H i j | _, _ => 0 lemma raiseIndex_graph_none (M : ι → ι → R) (d : R) (g : ι → R) : raiseIndex (blockMetric M d) (graphCovector g) none = d := by simp [raiseIndex, blockMetric, graphCovector, Fintype.sum_option] lemma raiseIndex_graph_some (M : ι → ι → R) (d : R) (g : ι → R) (i : ι) : raiseIndex (blockMetric M d) (graphCovector g) (some i) = -raiseIndex M g i := by simp [raiseIndex, blockMetric, graphCovector, Fintype.sum_option] lemma metricPair_graph (M : ι → ι → R) (d : R) (g : ι → R) : metricPair (blockMetric M d) (graphCovector g) (graphCovector g) = d+metricPair M g g := by simp [metricPair, blockMetric, graphCovector, Fintype.sum_option] lemma metricTrace_graph (M H : ι → ι → R) (d : R) : metricTrace (blockMetric M d) (graphHessian H) = -metricTrace M H := by simp [metricTrace, blockMetric, graphHessian, Fintype.sum_option] lemma contract_graph (M H : ι → ι → R) (d : R) (g : ι → R) : contract (graphHessian H) (raiseIndex (blockMetric M d) (graphCovector g)) (raiseIndex (blockMetric M d) (graphCovector g)) = -contract H (raiseIndex M g) (raiseIndex M g) := by simp [contract, graphHessian, Fintype.sum_option, raiseIndex_graph_some] lemma graph_operator (M : ι → ι → R) (d : R) (g : ι → R) (H : ι → ι → R) : operator (blockMetric M d) (graphCovector g) (graphHessian H) = -(d+metricPair M g g)*metricTrace M H + contract H (raiseIndex M g) (raiseIndex M g) := by rw [operator, metricPair_graph, metricTrace_graph, contract_graph] ring /-- Multiplying the implicit operator by -c, where c*d=1, gives precisely (1+c*A)*trace(M*H)-c*H(M*g,M*g), the graph expression in the PDF's equation (2). All inputs are derivative arrays; analytic product/chain rules are separate. -/ theorem graph_equation_identity (M : ι → ι → R) (c d : R) (hcd : c*d=1) (g : ι → R) (H : ι → ι → R) : -c*operator (blockMetric M d) (graphCovector g) (graphHessian H) = (1+c*metricPair M g g)*metricTrace M H - c*contract H (raiseIndex M g) (raiseIndex M g) := by rw [graph_operator] linear_combination (metricTrace M H)*hcd /-- Zero implicit operator gives the graph PDE for the same derivative data. -/ theorem graph_equation_of_operator_zero (M : ι → ι → R) (c d : R) (hcd : c*d=1) (g : ι → R) (H : ι → ι → R) (hL : operator (blockMetric M d) (graphCovector g) (graphHessian H) = 0) : (1+c*metricPair M g g)*metricTrace M H - c*contract H (raiseIndex M g) (raiseIndex M g) = 0 := by rw [← graph_equation_identity M c d hcd g H, hL, mul_zero] end Source29MetricJet /- Component: RealComplexBridge.inc -/ namespace Source29RealComplex open MvPolynomial noncomputable section theorem cubicOperator_map {R S ι : Type*} [CommRing R] [CommRing S] [Fintype ι] (f : R →+* S) (P : MvPolynomial ι R) : map f (Source29FactorInheritance.cubicOperator P) = Source29FactorInheritance.cubicOperator (map f P) := by simp only [Source29FactorInheritance.cubicOperator, map_sub, map_mul, map_sum, map_pow, pderiv_map] def complexify {ι : Type*} (P : MvPolynomial ι ℝ) : MvPolynomial ι ℂ := map (algebraMap ℝ ℂ) P theorem complexify_ne_zero {ι : Type*} (P : MvPolynomial ι ℝ) (hP : P ≠ 0) : complexify P ≠ 0 := by intro h apply hP apply map_injective (algebraMap ℝ ℂ) (algebraMap ℝ ℂ).injective simpa [complexify] using h theorem eval_complexify {ι : Type*} (P : MvPolynomial ι ℝ) (x : ι → ℝ) : eval (fun i => (x i : ℂ)) (complexify P) = (eval x P : ℂ) := by exact (MvPolynomial.map_eval (algebraMap ℝ ℂ) x P).symm theorem complexify_isHomogeneous {ι : Type*} (P : MvPolynomial ι ℝ) (m : ℕ) (hP : P.IsHomogeneous m) : (complexify P).IsHomogeneous m := hP.map (algebraMap ℝ ℂ) theorem complexify_cubic_zero {ι : Type*} [Fintype ι] (P : MvPolynomial ι ℝ) (hP : Source29FactorInheritance.cubicOperator P = 0) : Source29FactorInheritance.cubicOperator (complexify P) = 0 := by rw [complexify, ← cubicOperator_map, hP, map_zero] /-- Every complex factor of a strictly positive real polynomial has no nonzero real zero. -/ theorem factor_no_nonzero_real_zero {ι : Type*} (Q : MvPolynomial ι ℝ) (h : MvPolynomial ι ℂ) (hQ : ∀ x : ι → ℝ, x ≠ 0 → 0 < eval x Q) (hdiv : h ∣ complexify Q) : ∀ x : ι → ℝ, x ≠ 0 → eval (fun i => (x i : ℂ)) h ≠ 0 := by obtain ⟨v, hv⟩ := hdiv intro x hx he have hz : eval (fun i => (x i : ℂ)) (complexify Q) = 0 := by rw [hv, map_mul, he, zero_mul] rw [eval_complexify] at hz have hz' : eval x Q = 0 := by exact_mod_cast hz exact (ne_of_gt (hQ x hx)) hz' /-- The maximal multiplicity of an arbitrary irreducible divisor supplies the factorization required by the operator-inheritance identity. -/ theorem irreducible_divisor_inherits {ι : Type*} [Fintype ι] (F h : MvPolynomial ι ℂ) (hF : F ≠ 0) (hL : Source29FactorInheritance.cubicOperator F = 0) (hh : Irreducible h) (hdiv : h ∣ F) : h ∣ Source29FactorInheritance.cubicOperator h := by have hf : FiniteMultiplicity h F := FiniteMultiplicity.of_not_isUnit hh.not_isUnit hF obtain ⟨v, hv, hnot⟩ := hf.exists_eq_pow_mul_and_not_dvd have ha : 1 ≤ multiplicity h F := by have hne := (multiplicity_ne_zero hf).mpr hdiv omega apply Source29FactorInheritance.factor_inheritance h v (multiplicity h F) ha hh hnot rwa [← hv] end end Source29RealComplex /- Component: ClosingReduction.inc -/ /-! # Conditional closing reduction for Math30Catalog.source29 This fragment is appended to LeadingReduction.lean for compilation. It proves the final implication from two explicitly stated geometric inputs. Neither input is established here; this fragment does not solve the challenge. -/ namespace Source29Closing open MvPolynomial abbrev Polynomial8 := MvPolynomial (Fin 8) ℝ /-- Strict positivity at every nonzero real point. -/ def PositiveAwayFromZero (Q : Polynomial8) : Prop := ∀ x : Fin 8 → ℝ, x ≠ 0 → 0 < eval x Q /-- The precise leading-term structure and degree bounds needed by the final argument. Establishing this data from minimality remains a geometric obligation. The positivity clause incorporates the dimension-eight zero-set argument. -/ def GuoData8 (P : Polynomial8) : Prop := ∃ (p Q : Polynomial8) (k : ℕ), 1 ≤ k ∧ Q.IsHomogeneous Q.totalDegree ∧ homogeneousComponent P.totalDegree P = p ^ k * Q ∧ PositiveAwayFromZero Q ∧ (3 : ℝ) < (p.totalDegree : ℝ) + (Q.totalDegree : ℝ) / (k : ℝ) ∧ (p.totalDegree : ℝ) + (Q.totalDegree : ℝ) / (k : ℝ) < 4 /-- A positive homogeneous divisor of a nonzero homogeneous solution of the cubic minimal-graph equation must be constant. This geometric obstruction is an explicit assumption, not an axiom or an asserted established theorem. -/ def PositiveHomogeneousDivisorObstruction8 : Prop := ∀ (F Q : Polynomial8) (m : ℕ), F ≠ 0 → F.IsHomogeneous m → QuarticPolynomialBasics.cubicOperator F = 0 → Q.IsHomogeneous Q.totalDegree → PositiveAwayFromZero Q → Q ∣ F → Q.totalDegree = 0 /-- Once the two geometric inputs are supplied, the all-degree leading-term reduction and the strict integer-degree contradiction prove the exact target. -/ theorem problem29_of_geometric_inputs (hGuo : ∀ P : Polynomial8, Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → GuoData8 P) (hDivisor : PositiveHomogeneousDivisorObstruction8) : Math30.Problem29 := by intro P hminimal change P.totalDegree ≤ 1 by_contra hnonaffine have hdegree : 2 ≤ P.totalDegree := by omega obtain ⟨p, Q, k, _hk, hQhom, hfactor, hQpos, hlower, hupper⟩ := hGuo P hminimal hdegree obtain ⟨hne, hhom, hleading⟩ := QuarticPolynomialBasics.leading_component_data P hminimal hdegree have hdiv : Q ∣ homogeneousComponent P.totalDegree P := ⟨p ^ k, hfactor.trans (mul_comm _ _)⟩ have hQdegree : Q.totalDegree = 0 := hDivisor (homogeneousComponent P.totalDegree P) Q P.totalDegree hne hhom hleading hQhom hQpos hdiv apply QuarticPolynomialBasics.no_integer_degree_between_three_and_four p.totalDegree · simpa only [hQdegree, Nat.cast_zero, zero_div, add_zero] using hlower · simpa only [hQdegree, Nat.cast_zero, zero_div, add_zero] using hupper end Source29Closing /- Component: PositiveDivisor.inc -/ /-! # Conditional positive-divisor obstruction in dimension eight The complex geometric obstruction is an explicit hypothesis. All algebraic steps from it to the positive-divisor obstruction and the closing implication are established here. This fragment does not assert the geometric hypothesis. -/ namespace Source29PositiveDivisor open MvPolynomial open scoped BigOperators noncomputable section abbrev ComplexPolynomial8 := MvPolynomial (Fin 8) ℂ /-- The geometric complex-hypersurface input still to be proved. -/ def ComplexObstruction8 : Prop := ∀ h : ComplexPolynomial8, Irreducible h → h.IsHomogeneous h.totalDegree → h ∣ Source29FactorInheritance.cubicOperator h → (∀ x : Fin 8 → ℝ, x ≠ 0 → eval (fun i => (x i : ℂ)) h ≠ 0) → Source29Quadric.quadric ∣ h lemma complexify_totalDegree {ι : Type*} (Q : MvPolynomial ι ℝ) : (Source29RealComplex.complexify Q).totalDegree = Q.totalDegree := by simp only [totalDegree, Source29RealComplex.complexify, MvPolynomial.support_map_of_injective _ (algebraMap ℝ ℂ).injective] lemma radialOperator_eq_cubic (F : ComplexPolynomial8) : Source29Radial.polynomialL F = Source29FactorInheritance.cubicOperator F := by simp only [Source29Radial.polynomialL, Source29Radial.jetL, Source29Radial.dot, Source29Radial.trace, Source29Radial.contract, Source29FactorInheritance.cubicOperator, pow_two] /-- Homogeneity of polynomial factors supplies the quotient hypothesis of the radial descent theorem. -/ theorem homogeneous_cubic_no_radial_factor (F : ComplexPolynomial8) (m : ℕ) (hF : F ≠ 0) (hhom : F.IsHomogeneous m) (hL : Source29FactorInheritance.cubicOperator F = 0) : ¬Source29Quadric.quadric ∣ F := by apply Source29Radial.no_radial_factor_of_homogeneous_quotients (K := ℂ) (ι := Fin 8) (by decide) (show Prime (Source29Radial.radialPolynomial : ComplexPolynomial8) from Source29Quadric.quadric_irreducible.prime) F hF · rwa [radialOperator_eq_cubic] · intro a g hfactor refine ⟨g.totalDegree, ?_⟩ apply Source29HomogeneousFactor.divisor_isHomogeneous F g hF hhom exact ⟨Source29Radial.radialPolynomial^a, hfactor.trans (mul_comm _ _)⟩ /-- The complex obstruction implies the real positive homogeneous divisor obstruction used in the final degree argument. -/ theorem positive_divisor_obstruction_of_complex_obstruction (hcomplex : ComplexObstruction8) : Source29Closing.PositiveHomogeneousDivisorObstruction8 := by intro F Q m hF hhom hL _hQhom hQpos hQdiv by_contra hdegree have hFc : Source29RealComplex.complexify F ≠ 0 := Source29RealComplex.complexify_ne_zero F hF have hQne : Q ≠ 0 := by intro hz rw [hz, zero_dvd_iff] at hQdiv exact hF hQdiv have hQc : Source29RealComplex.complexify Q ≠ 0 := Source29RealComplex.complexify_ne_zero Q hQne have hQunit : ¬ IsUnit (Source29RealComplex.complexify Q) := by intro hu apply hdegree rw [← complexify_totalDegree Q] obtain ⟨v, hv⟩ := hu.exists_right_inv have hprod : Source29RealComplex.complexify Q * v ≠ 0 := by rw [hv] exact one_ne_zero have hd := congrArg MvPolynomial.totalDegree hv rw [MvPolynomial.totalDegree_mul_of_isDomain hQc (right_ne_zero_of_mul hprod), MvPolynomial.totalDegree_one] at hd omega obtain ⟨h, hh, hhQ⟩ := WfDvdMonoid.exists_irreducible_factor hQunit hQc have hQFc : Source29RealComplex.complexify Q ∣ Source29RealComplex.complexify F := by obtain ⟨v, hv⟩ := hQdiv refine ⟨Source29RealComplex.complexify v, ?_⟩ simp only [Source29RealComplex.complexify, hv, map_mul] have hhF := dvd_trans hhQ hQFc have hFhom := Source29RealComplex.complexify_isHomogeneous F m hhom have hFzero : Source29FactorInheritance.cubicOperator (Source29RealComplex.complexify F) = 0 := by apply Source29RealComplex.complexify_cubic_zero exact hL have hhirredHom := Source29HomogeneousFactor.divisor_isHomogeneous (Source29RealComplex.complexify F) h hFc hFhom hhF have hhinherit := Source29RealComplex.irreducible_divisor_inherits (Source29RealComplex.complexify F) h hFc hFzero hh hhF have hhnozeros := Source29RealComplex.factor_no_nonzero_real_zero Q h hQpos hhQ have hqh := hcomplex h hh hhirredHom hhinherit hhnozeros exact homogeneous_cubic_no_radial_factor (Source29RealComplex.complexify F) m hFc hFhom hFzero (dvd_trans hqh hhF) /-- Conditional closing theorem: the exact challenge follows from the stated Guo input and complex geometric obstruction. -/ theorem problem29_of_Guo_and_complex_obstruction (hGuo : ∀ P : Source29Closing.Polynomial8, Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → Source29Closing.GuoData8 P) (hcomplex : ComplexObstruction8) : Math30.Problem29 := by exact Source29Closing.problem29_of_geometric_inputs hGuo (positive_divisor_obstruction_of_complex_obstruction hcomplex) end end Source29PositiveDivisor /- Component: LocalMaximumBound.lean -/ namespace Source29LocalMaximumBound noncomputable section abbrev CSpace (n : ℕ) := EuclideanSpace ℂ (Fin n) variable {n : ℕ} def dot (z w : CSpace n) : ℂ := ∑ i, z i * w i def quadric (z : CSpace n) : ℂ := ∑ i, (z i)^2 def conjugate (z : CSpace n) : CSpace n := WithLp.toLp 2 (fun i => star (z i)) def normal (z : CSpace n) (κ : ℝ) : CSpace n := z - (κ : ℂ) • conjugate z lemma dot_comm (z w : CSpace n) : dot z w = dot w z := by simp [dot, mul_comm] lemma dot_add_right (z v w : CSpace n) : dot z (v + w) = dot z v + dot z w := by simp [dot, mul_add, Finset.sum_add_distrib] lemma dot_smul_right (c : ℂ) (z w : CSpace n) : dot z (c • w) = c * dot z w := by simp [dot, mul_left_comm, Finset.mul_sum] lemma dot_normal (z δ : CSpace n) (κ : ℝ) : dot (normal z κ) δ = dot z δ - (κ : ℂ) * dot (conjugate z) δ := by simp [dot, normal, sub_mul, Finset.sum_sub_distrib, mul_assoc, Finset.mul_sum] lemma quadric_add (z δ : CSpace n) : quadric (z + δ) = quadric z + 2 * dot z δ + quadric δ := by unfold quadric dot simp only [PiLp.add_apply, add_sq, Finset.sum_add_distrib] congr 1 congr 1 rw [Finset.mul_sum] apply Finset.sum_congr rfl intro i hi ring lemma dot_conjugate_eq_inner (z δ : CSpace n) : dot (conjugate z) δ = inner ℂ z δ := by simp [dot, conjugate, PiLp.inner_apply, mul_comm] lemma norm_add_sq_expansion (z δ : CSpace n) : ‖z + δ‖^2 = ‖z‖^2 + 2 * (dot (conjugate z) δ).re + ‖δ‖^2 := by rw [dot_conjugate_eq_inner] exact norm_add_sq (𝕜 := ℂ) z δ lemma quadric_norm_le (δ : CSpace n) : ‖quadric δ‖ ≤ ‖δ‖^2 := by calc ‖quadric δ‖ ≤ ∑ i : Fin n, ‖(δ i)^2‖ := norm_sum_le _ _ _ = ‖δ‖^2 := by simp only [norm_pow, EuclideanSpace.norm_sq_eq] lemma neg_norm_sq_le_quadric_re (δ : CSpace n) : -‖δ‖^2 ≤ (quadric δ).re := by have h := (abs_le.mp (Complex.abs_re_le_norm (quadric δ))).1 have hb := quadric_norm_le δ linarith /-- The global projective maximum inequality directly bounds the real normal component of any displacement. No local remainder or smallness assumption is needed. -/ theorem normal_displacement_bound_sharp (z δ : CSpace n) (κ : ℝ) (hz : ‖z‖ = 1) (hq : quadric z = (κ : ℂ)) (hmaximum : ‖quadric (z + δ)‖ ≤ κ * ‖z + δ‖^2) : (dot (normal z κ) δ).re ≤ ((κ + 1) / 2) * ‖δ‖^2 := by have hr := (Complex.re_le_norm (quadric (z + δ))).trans hmaximum rw [quadric_add, hq] at hr norm_num [Complex.add_re, Complex.mul_re] at hr rw [norm_add_sq_expansion, hz, one_pow] at hr rw [dot_normal] simp only [Complex.sub_re, Complex.mul_re, Complex.ofReal_re, Complex.ofReal_im, zero_mul, sub_zero] have hl := neg_norm_sq_le_quadric_re δ nlinarith /-- In the range relevant to the normalized maximum, the bound has constant one. -/ theorem normal_displacement_bound (z δ : CSpace n) (κ : ℝ) (hz : ‖z‖ = 1) (hq : quadric z = (κ : ℂ)) (hκ : κ ≤ 1) (hmaximum : ‖quadric (z + δ)‖ ≤ κ * ‖z + δ‖^2) : (dot (normal z κ) δ).re ≤ ‖δ‖^2 := by have h := normal_displacement_bound_sharp z δ κ hz hq hmaximum have hk := mul_le_mul_of_nonneg_right hκ (sq_nonneg ‖δ‖) nlinarith /-- A tangent plus normal decomposition identifies the controlled component with the normal coefficient times the bilinear square of the normal. -/ theorem normal_coefficient_bound (z ζ : CSpace n) (w : ℂ) (κ : ℝ) (hz : ‖z‖ = 1) (hq : quadric z = (κ : ℂ)) (hκ : κ ≤ 1) (hζ : dot (normal z κ) ζ = 0) (hmaximum : ‖quadric (z + (ζ + w • normal z κ))‖ ≤ κ * ‖z + (ζ + w • normal z κ)‖^2) : (dot (normal z κ) (normal z κ) * w).re ≤ ‖ζ + w • normal z κ‖^2 := by have h := normal_displacement_bound z (ζ + w • normal z κ) κ hz hq hκ hmaximum rw [dot_add_right, dot_smul_right, hζ, zero_add] at h simpa only [mul_comm] using h lemma norm_conjugate (z : CSpace n) : ‖conjugate z‖ = ‖z‖ := by have h : ‖conjugate z‖^2 = ‖z‖^2 := by simp [EuclideanSpace.norm_sq_eq, conjugate] nlinarith [norm_nonneg (conjugate z), norm_nonneg z] lemma inner_conjugate (z : CSpace n) : inner ℂ z (conjugate z) = star (quadric z) := by simp [PiLp.inner_apply, conjugate, quadric, pow_two] /-- The normal's Hermitian squared norm at a normalized real phase maximum. -/ lemma norm_normal_sq (z : CSpace n) (κ : ℝ) (hz : ‖z‖ = 1) (hq : quadric z = (κ : ℂ)) : ‖normal z κ‖^2 = 1 - κ^2 := by unfold normal rw [norm_sub_sq (𝕜 := ℂ), norm_smul, inner_smul_right, inner_conjugate, hq, norm_conjugate, hz] simp [Complex.norm_real, Real.norm_eq_abs, sq_abs] ring lemma norm_normal_le_one (z : CSpace n) (κ : ℝ) (hz : ‖z‖ = 1) (hq : quadric z = (κ : ℂ)) : ‖normal z κ‖ ≤ 1 := by have h := norm_normal_sq z κ hz hq nlinarith [norm_nonneg (normal z κ), sq_nonneg κ] /-- A form suitable for estimates in the tangent and normal coordinates. -/ theorem normal_coefficient_bound_coordinates (z ζ : CSpace n) (w : ℂ) (κ : ℝ) (hz : ‖z‖ = 1) (hq : quadric z = (κ : ℂ)) (hκ : κ ≤ 1) (hζ : dot (normal z κ) ζ = 0) (hmaximum : ‖quadric (z + (ζ + w • normal z κ))‖ ≤ κ * ‖z + (ζ + w • normal z κ)‖^2) : (dot (normal z κ) (normal z κ) * w).re ≤ 2 * (‖ζ‖^2 + ‖w‖^2) := by have h := normal_coefficient_bound z ζ w κ hz hq hκ hζ hmaximum have hN := norm_normal_le_one z κ hz hq have hwN : ‖w • normal z κ‖ ≤ ‖w‖ := by rw [norm_smul] simpa only [mul_one] using mul_le_mul_of_nonneg_left hN (norm_nonneg w) have hs : ‖ζ + w • normal z κ‖ ≤ ‖ζ‖ + ‖w‖ := (norm_add_le ζ (w • normal z κ)).trans (add_le_add le_rfl hwN) have hs2 := sq_le_sq₀ (norm_nonneg (ζ + w • normal z κ)) (add_nonneg (norm_nonneg ζ) (norm_nonneg w)) have hsq := hs2.mpr hs nlinarith [sq_nonneg (‖ζ‖ - ‖w‖)] end end Source29LocalMaximumBound /- Component: SmallSlope.inc -/ /- Uniform tangent control near a polynomial zero, obtained by compactness of normalized directions rather than a choice of analytic branches. -/ namespace Source29SmallSlope open MvPolynomial Finset open scoped Topology noncomputable section abbrev CSpace (n : ℕ) := EuclideanSpace ℂ (Fin n) lemma continuous_eval_rescale_joint {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (s : ℕ) : Continuous (fun p : ℂ × CSpace n => eval (fun i => p.2 i) (Source29LowestRescale.rescale P s p.1)) := by simp only [Source29LowestRescale.rescale, map_sum, map_mul, eval_C] apply continuous_finsetSum intro k hk exact (continuous_fst.pow (k - s)).mul ((Source29ProjectiveMaximum.continuous_polynomial_eval _).comp continuous_snd) lemma uniform_nonzero_near_zero {n : ℕ} (F : ℂ × CSpace n → ℂ) (hF : Continuous F) (K : Set (CSpace n)) (hK : IsCompact K) (hzero : ∀ y ∈ K, F (0, y) ≠ 0) : ∃ r : ℝ, 0 < r ∧ ∀ t : ℂ, ‖t‖ < r → ∀ y ∈ K, F (t, y) ≠ 0 := by have he : ∀ᶠ t : ℂ in 𝓝 0, ∀ y ∈ K, F (t, y) ≠ 0 := by apply hK.eventually_forall_of_forall_eventually intro y hy exact hF.continuousAt.eventually_ne (hzero y hy) obtain ⟨r, hr, hrsub⟩ := Metric.mem_nhds_iff.mp he refine ⟨r, hr, ?_⟩ intro t ht y hy exact hrsub (by simpa only [Metric.mem_ball, dist_zero_right] using ht) y hy /-- Every nearby zero approaches the kernel of the initial form, uniformly in the direction of approach. This statement only needs containment of the initial zero set in a linear hyperplane. -/ theorem exists_small_linear_bound {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (s : ℕ) (hs : s ≤ P.totalDegree) (hlow : ∀ k < s, homogeneousComponent k P = 0) (L : CSpace n →L[ℂ] ℂ) (hinitial : ∀ v : CSpace n, eval (fun i => v i) (homogeneousComponent s P) = 0 → L v = 0) (ε : ℝ) (hε : 0 < ε) : ∃ r : ℝ, 0 < r ∧ ∀ x : CSpace n, ‖x‖ < r → eval (fun i => x i) P = 0 → ‖L x‖ ≤ ε * ‖x‖ := by let K : Set (CSpace n) := {v | ‖v‖ = 1 ∧ ε ≤ ‖L v‖} have hKclosed : IsClosed K := (isClosed_eq continuous_norm continuous_const).inter (isClosed_le continuous_const L.continuous.norm) have hK : IsCompact K := (isCompact_sphere (0 : CSpace n) 1).of_isClosed_subset hKclosed (by intro v hv; simpa [Metric.mem_sphere] using hv.1) let F : ℂ × CSpace n → ℂ := fun p => eval (fun i => p.2 i) (Source29LowestRescale.rescale P s p.1) have hF : Continuous F := continuous_eval_rescale_joint P s have hFzero : ∀ v ∈ K, F (0, v) ≠ 0 := by intro v hv heq have hvzero : eval (fun i => v i) (homogeneousComponent s P) = 0 := by simpa only [F, Source29LowestRescale.rescale_zero P s hs hlow] using heq have hvL := hinitial v hvzero have hh := hv.2 rw [hvL, norm_zero] at hh linarith obtain ⟨r, hr, hrF⟩ := uniform_nonzero_near_zero F hF K hK hFzero refine ⟨r, hr, ?_⟩ intro x hx hzero by_cases hx0 : x = 0 · simp [hx0] have hxnorm : 0 < ‖x‖ := norm_pos_iff.mpr hx0 let t : ℂ := (‖x‖ : ℂ) let v : CSpace n := t⁻¹ • x have htne : t ≠ 0 := by dsimp only [t] exact_mod_cast hxnorm.ne' have htnorm : ‖t‖ = ‖x‖ := by simp [t] have hvnorm : ‖v‖ = 1 := by simp only [v, norm_smul, norm_inv, htnorm] exact inv_mul_cancel₀ hxnorm.ne' have htv : ∀ i, t * v i = x i := by intro i simp [v, htne] have hscaled := Source29LowestRescale.eval_rescale_mul P s hlow t (fun i => v i) have hres : F (t, v) = 0 := by have ht : (fun i => t * v i) = (fun i => x i) := funext htv rw [ht, hzero] at hscaled exact (mul_eq_zero.mp hscaled).resolve_left (pow_ne_zero _ htne) have hvLnorm : ‖L v‖ = ‖t‖⁻¹ * ‖L x‖ := by simp [v] by_contra hnot have hstrict : ε * ‖x‖ < ‖L x‖ := lt_of_not_ge hnot have hvK : v ∈ K := by refine ⟨hvnorm, ?_⟩ rw [hvLnorm, htnorm, ← div_eq_inv_mul] exact le_of_lt ((lt_div_iff₀ hxnorm).mpr hstrict) exact hrF t (by simpa [htnorm] using hx) v hvK hres /-- Control of a linear form relative to the ambient displacement controls the normal coordinate relative to the tangential coordinate. -/ lemma exists_linear_tolerance {n : ℕ} (L : CSpace n →L[ℂ] ℂ) (N : CSpace n) (hN : L N ≠ 0) (ε : ℝ) (hε : 0 < ε) : ∃ η : ℝ, 0 < η ∧ ∀ (ζ : CSpace n) (w : ℂ), L ζ = 0 → ‖L (ζ + w • N)‖ ≤ η * ‖ζ + w • N‖ → ‖w‖ ≤ ε * ‖ζ‖ := by let c : ℝ := ‖L N‖ let b : ℝ := ‖N‖ have hc : 0 < c := norm_pos_iff.mpr hN have hb : 0 ≤ b := norm_nonneg N let η := min (c / (2 * (b + 1))) (ε * c / 2) have hden : 0 < 2 * (b + 1) := by positivity have hη : 0 < η := lt_min (div_pos hc hden) (by positivity) have hηb : 2 * η * b ≤ c := by have hd : η * (2 * (b + 1)) ≤ c := (le_div_iff₀ hden).mp (min_le_left _ _) nlinarith have hηε : 2 * η ≤ ε * c := by have hh : η ≤ ε * c / 2 := min_le_right _ _ linarith refine ⟨η, hη, ?_⟩ intro ζ w hζ hbound have hL : ‖L (ζ + w • N)‖ = ‖w‖ * c := by simp [map_add, map_smul, hζ, c] rw [hL] at hbound have htriangle : ‖ζ + w • N‖ ≤ ‖ζ‖ + ‖w‖ * b := by simpa only [norm_smul, b] using norm_add_le ζ (w • N) have hh := hbound.trans (mul_le_mul_of_nonneg_left htriangle hη.le) have he := mul_le_mul_of_nonneg_right hηε (norm_nonneg ζ) have hn := mul_le_mul_of_nonneg_right hηb (norm_nonneg w) apply (mul_le_mul_iff_left₀ hc).mp nlinarith /-- Uniform small slope of polynomial zeros follows from the initial zero set lying in the tangential hyperplane. -/ theorem exists_small_slope {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (s : ℕ) (hs : s ≤ P.totalDegree) (hlow : ∀ k < s, homogeneousComponent k P = 0) (L : CSpace n →L[ℂ] ℂ) (hinitial : ∀ v : CSpace n, eval (fun i => v i) (homogeneousComponent s P) = 0 → L v = 0) (N : CSpace n) (hN : L N ≠ 0) (ε : ℝ) (hε : 0 < ε) : ∃ r : ℝ, 0 < r ∧ ∀ (ζ : CSpace n) (w : ℂ), L ζ = 0 → ‖ζ + w • N‖ < r → eval (fun i => (ζ + w • N) i) P = 0 → ‖w‖ ≤ ε * ‖ζ‖ := by obtain ⟨η, hη, hηbound⟩ := exists_linear_tolerance L N hN ε hε obtain ⟨r, hr, hrbound⟩ := exists_small_linear_bound P s hs hlow L hinitial η hη refine ⟨r, hr, ?_⟩ intro ζ w hζ hsmall hzero exact hηbound ζ w hζ (hrbound (ζ + w • N) hsmall hzero) /-- The pure initial normal power obtained at a singular maximum supplies the uniform small-slope estimate without using a Weierstrass preparation theorem. -/ theorem exists_small_slope_of_initial_power {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (s : ℕ) (hs : s ≤ P.totalDegree) (hlow : ∀ k < s, homogeneousComponent k P = 0) (L : CSpace n →L[ℂ] ℂ) (a : ℂ) (ha : a ≠ 0) (hinitial : ∀ v : CSpace n, eval (fun i => v i) (homogeneousComponent s P) = a * (L v)^s) (N : CSpace n) (hN : L N ≠ 0) (ε : ℝ) (hε : 0 < ε) : ∃ r : ℝ, 0 < r ∧ ∀ (ζ : CSpace n) (w : ℂ), L ζ = 0 → ‖ζ + w • N‖ < r → eval (fun i => (ζ + w • N) i) P = 0 → ‖w‖ ≤ ε * ‖ζ‖ := by apply exists_small_slope P s hs hlow L _ N hN ε hε intro v hv by_contra hLv rw [hinitial] at hv exact mul_ne_zero ha (pow_ne_zero _ hLv) hv end end Source29SmallSlope /- Component: OneSidedOrder.lean -/ namespace Source29OneSidedOrder open Filter open scoped Topology noncomputable section /-- A one-sided real-part bound excludes a smaller positive vanishing order. The phase choice is essential: the leading complex coefficient becomes positive on a suitable complex ray. Only continuity of the nonvanishing factor is used. -/ theorem order_ge_of_one_sided_bound (g : ℂ → ℂ) (hg : ContinuousAt g 0) (hg0 : g 0 ≠ 0) (d k : ℕ) (hd : 0 < d) (C : ℝ) (hbound : ∀ᶠ z in 𝓝 (0 : ℂ), (z ^ d * g z).re ≤ C * ‖z‖ ^ k) : k ≤ d := by by_contra hnot have hdk : d < k := Nat.lt_of_not_ge hnot let c : ℂ := (star (g 0)) ^ ((d : ℂ)⁻¹) have hc : c ^ d = star (g 0) := Complex.cpow_nat_inv_pow _ hd.ne' have hpath : Tendsto (fun t : ℝ => (t : ℂ) * c) (𝓝[>] (0 : ℝ)) (𝓝 (0 : ℂ)) := by have hcont : Continuous (fun t : ℝ => (t : ℂ) * c) := Complex.continuous_ofReal.mul_const c simpa using (hcont.continuousAt (x := 0)).tendsto.mono_left (show 𝓝[>] (0 : ℝ) ≤ 𝓝 (0 : ℝ) from nhdsWithin_le_nhds) have hleft : Tendsto (fun t : ℝ => (c ^ d * g ((t : ℂ) * c)).re) (𝓝[>] (0 : ℝ)) (𝓝 ((star (g 0) * g 0).re)) := by have hm : Tendsto (fun t : ℝ => c ^ d * g ((t : ℂ) * c)) (𝓝[>] (0 : ℝ)) (𝓝 (c ^ d * g 0)) := tendsto_const_nhds.mul (hg.tendsto.comp hpath) simpa only [hc, Function.comp_def] using Complex.continuous_re.continuousAt.tendsto.comp hm have hright : Tendsto (fun t : ℝ => C * ‖c‖ ^ k * t ^ (k - d)) (𝓝[>] (0 : ℝ)) (𝓝 (0 : ℝ)) := by have hcont : Continuous (fun t : ℝ => C * ‖c‖ ^ k * t ^ (k - d)) := continuous_const.mul (continuous_id.pow _) simpa [zero_pow (by omega : k - d ≠ 0)] using (hcont.continuousAt (x := 0)).tendsto.mono_left (show 𝓝[>] (0 : ℝ) ≤ 𝓝 (0 : ℝ) from nhdsWithin_le_nhds) have hle : ∀ᶠ (t : ℝ) in 𝓝[>] (0 : ℝ), (c ^ d * g ((t : ℂ) * c)).re ≤ C * ‖c‖ ^ k * t ^ (k - d) := by have hpositive : ∀ᶠ (t : ℝ) in 𝓝[>] (0 : ℝ), 0 < t := self_mem_nhdsWithin filter_upwards [hpath.eventually hbound, hpositive] with t ht htpos have hpos : 0 < t := htpos have hL : (((t : ℂ) * c) ^ d * g ((t : ℂ) * c)).re = t ^ d * (c ^ d * g ((t : ℂ) * c)).re := by calc _ = (((t ^ d : ℝ) : ℂ) * (c ^ d * g ((t : ℂ) * c))).re := by congr 1 push_cast ring _ = _ := by simp only [Complex.mul_re, Complex.ofReal_re, Complex.ofReal_im, zero_mul, sub_zero] have hR : C * ‖(t : ℂ) * c‖ ^ k = t ^ d * (C * ‖c‖ ^ k * t ^ (k - d)) := by rw [norm_mul, Complex.norm_real, Real.norm_eq_abs, abs_of_pos hpos, mul_pow] have hp : t ^ k = t ^ d * t ^ (k - d) := by rw [← pow_add, Nat.add_sub_of_le hdk.le] rw [hp] ring rw [hL, hR] at ht exact (mul_le_mul_iff_right₀ (pow_pos hpos d)).mp ht have hlim := le_of_tendsto_of_tendsto hleft hright hle have hid : (star (g 0) * g 0).re = ‖g 0‖ ^ 2 := by simp [Complex.mul_re, Complex.sq_norm, Complex.normSq_apply] rw [hid] at hlim exact (not_le_of_gt (sq_pos_of_pos (norm_pos_iff.mpr hg0))) hlim /-- For an analytic function vanishing at the origin, a one-sided real-part bound forces a holomorphic factor of the same order. -/ theorem exists_analytic_factor_of_one_sided_bound (f : ℂ → ℂ) (hf : AnalyticAt ℂ f 0) (hf0 : f 0 = 0) (k : ℕ) (C : ℝ) (hbound : ∀ᶠ z in 𝓝 (0 : ℂ), (f z).re ≤ C * ‖z‖ ^ k) : ∃ g : ℂ → ℂ, AnalyticAt ℂ g 0 ∧ ∀ᶠ z in 𝓝 (0 : ℂ), f z = z ^ k * g z := by by_cases hzero : ∀ᶠ z in 𝓝 (0 : ℂ), f z = 0 · refine ⟨fun _ => 0, analyticAt_const, ?_⟩ simpa using hzero obtain ⟨d, g, hg, hg0, hfactor⟩ := hf.exists_eventuallyEq_pow_smul_nonzero_iff.mpr hzero have hfactor' : ∀ᶠ z in 𝓝 (0 : ℂ), f z = z ^ d * g z := by simpa only [sub_zero, smul_eq_mul] using hfactor have hd : 0 < d := by by_contra hnot have hd0 : d = 0 := by omega have h0 := hfactor'.self_of_nhds rw [hd0, pow_zero, one_mul, hf0] at h0 exact hg0 h0.symm have hgbound : ∀ᶠ z in 𝓝 (0 : ℂ), (z ^ d * g z).re ≤ C * ‖z‖ ^ k := by filter_upwards [hfactor', hbound] with z hz hb rwa [hz] at hb have hkd := order_ge_of_one_sided_bound g hg.continuousAt hg0 d k hd C hgbound refine ⟨fun z => z ^ (d - k) * g z, (analyticAt_id.pow _).mul hg, ?_⟩ filter_upwards [hfactor'] with z hz rw [hz, ← mul_assoc, ← pow_add, Nat.add_sub_of_le hkd] /-- The one-sided estimate also yields the two-sided norm estimate used in the sheet-bound argument. This statement is local in one complex variable. -/ theorem norm_bound_of_one_sided_bound (f : ℂ → ℂ) (hf : AnalyticAt ℂ f 0) (hf0 : f 0 = 0) (k : ℕ) (C : ℝ) (hbound : ∀ᶠ z in 𝓝 (0 : ℂ), (f z).re ≤ C * ‖z‖ ^ k) : ∃ A : ℝ, 0 < A ∧ ∀ᶠ z in 𝓝 (0 : ℂ), ‖f z‖ ≤ A * ‖z‖ ^ k := by obtain ⟨g, hg, hfactor⟩ := exists_analytic_factor_of_one_sided_bound f hf hf0 k C hbound let A : ℝ := ‖g 0‖ + 1 have hA : 0 < A := by dsimp [A]; positivity have hsmall : ∀ᶠ z in 𝓝 (0 : ℂ), ‖g z‖ < A := hg.continuousAt.norm.tendsto.eventually (eventually_lt_nhds (by dsimp [A]; linarith)) refine ⟨A, hA, ?_⟩ filter_upwards [hfactor, hsmall] with z hz hb rw [hz, norm_mul, norm_pow] calc ‖z‖ ^ k * ‖g z‖ ≤ ‖z‖ ^ k * A := mul_le_mul_of_nonneg_left hb.le (pow_nonneg (norm_nonneg z) k) _ = A * ‖z‖ ^ k := mul_comm _ _ end end Source29OneSidedOrder /- Component: OneSidedMultivariate.inc -/ namespace Source29OneSidedMultivariate open Filter open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] /-- Complex homogeneity upgrades a one-sided higher-order bound to vanishing of the homogeneous form, by restricting to each complex line. -/ theorem diagonal_zero_of_one_sided_bound {d : ℕ} (p : E [×d]→L[ℂ] ℂ) (hd : 0 < d) (C : ℝ) (hbound : ∀ᶠ y in 𝓝 (0 : E), (p (fun _ => y)).re ≤ C * ‖y‖ ^ (d + 1)) (y : E) : p (fun _ => y) = 0 := by by_contra hne have hpath : Tendsto (fun z : ℂ => z • y) (𝓝 0) (𝓝 (0 : E)) := by have hc : Continuous (fun z : ℂ => z • y) := continuous_id.smul continuous_const simpa using (hc.continuousAt (x := (0 : ℂ))).tendsto have hline : ∀ᶠ z in 𝓝 (0 : ℂ), (z ^ d * p (fun _ => y)).re ≤ (C * ‖y‖ ^ (d + 1)) * ‖z‖ ^ (d + 1) := by filter_upwards [hpath.eventually hbound] with z hz have hp : p (fun _ => z • y) = z ^ d * p (fun _ => y) := by simpa [Finset.prod_const, Finset.card_fin, smul_eq_mul] using p.map_smul_univ (fun _ : Fin d => z) (fun _ : Fin d => y) rw [hp, norm_smul, mul_pow] at hz convert hz using 1 <;> ring have himpossible := Source29OneSidedOrder.order_ge_of_one_sided_bound (fun _ : ℂ => p (fun _ => y)) continuousAt_const hne d (d + 1) hd (C * ‖y‖ ^ (d + 1)) hline omega /-- In any complex normed space, the one-sided real-part bound forces every lower Taylor form to vanish on the diagonal. -/ theorem lower_coefficients_zero (f : E → ℂ) (p : FormalMultilinearSeries ℂ E ℂ) (hf : HasFPowerSeriesAt f p 0) (hf0 : f 0 = 0) (k : ℕ) (C : ℝ) (hbound : ∀ᶠ y in 𝓝 (0 : E), (f y).re ≤ C * ‖y‖ ^ k) : ∀ d < k, ∀ y : E, p d (fun _ => y) = 0 := by intro d induction d using Nat.strong_induction_on with | h d ih => intro hdk y by_cases hd0 : d = 0 · subst d rw [hf.coeff_zero, hf0] have hd : 0 < d := Nat.pos_of_ne_zero hd0 have hpsum : p.partialSum (d + 1) = fun v => p d (fun _ => v) := by funext v apply Finset.sum_eq_single d · intro b hb hbd have hbd' : b < d := by have hb' := Finset.mem_range.mp hb omega exact ih b hbd' (lt_trans hbd' hdk) v · intro hn exact False.elim (hn (Finset.mem_range.mpr (Nat.lt_succ_self d))) obtain ⟨M, hM, hrest⟩ := (hf.isBigO_sub_partialSum_pow (d + 1)).exists_pos have hrem : ∀ᶠ v in 𝓝 (0 : E), ‖f v - p d (fun _ => v)‖ ≤ M * ‖v‖ ^ (d + 1) := by simpa only [zero_add, hpsum, norm_pow, norm_norm] using (Asymptotics.isBigOWith_iff.mp hrest) have hsmall : ∀ᶠ v in 𝓝 (0 : E), ‖v‖ < 1 := by have hball := Metric.ball_mem_nhds (0 : E) (by norm_num : (0 : ℝ) < 1) filter_upwards [hball] with v hv simpa only [Metric.mem_ball, dist_zero_right] using hv apply diagonal_zero_of_one_sided_bound (p d) hd (|C| + M) _ y filter_upwards [hbound, hrem, hsmall] with v hv hr hs have hpow : ‖v‖ ^ k ≤ ‖v‖ ^ (d + 1) := pow_le_pow_of_le_one (norm_nonneg v) hs.le (by omega) have hc : C * ‖v‖ ^ k ≤ |C| * ‖v‖ ^ (d + 1) := by calc C * ‖v‖ ^ k ≤ |C| * ‖v‖ ^ k := mul_le_mul_of_nonneg_right (le_abs_self C) (pow_nonneg (norm_nonneg v) k) _ ≤ |C| * ‖v‖ ^ (d + 1) := mul_le_mul_of_nonneg_left hpow (abs_nonneg C) have hre := (abs_le.mp (Complex.abs_re_le_norm (f v - p d (fun _ => v)))).1 simp only [Complex.sub_re] at hre nlinarith /-- A one-sided bound for a complex analytic function vanishing at zero implies a uniform norm bound of the same order, also in several variables. -/ theorem norm_bound_of_one_sided_bound (f : E → ℂ) (hf : AnalyticAt ℂ f 0) (hf0 : f 0 = 0) (k : ℕ) (C : ℝ) (hbound : ∀ᶠ y in 𝓝 (0 : E), (f y).re ≤ C * ‖y‖ ^ k) : ∃ A : ℝ, 0 < A ∧ ∀ᶠ y in 𝓝 (0 : E), ‖f y‖ ≤ A * ‖y‖ ^ k := by obtain ⟨p, hp⟩ := hf have hvan := lower_coefficients_zero f p hp hf0 k C hbound have hpsum : p.partialSum k = 0 := by funext y apply Finset.sum_eq_zero intro d hd exact hvan d (Finset.mem_range.mp hd) y obtain ⟨A, hA, hrest⟩ := (hp.isBigO_sub_partialSum_pow k).exists_pos refine ⟨A, hA, ?_⟩ simpa only [zero_add, hpsum, Pi.zero_apply, sub_zero, norm_pow, norm_norm] using (Asymptotics.isBigOWith_iff.mp hrest) end end Source29OneSidedMultivariate /- Component: QuadraticSheetBound.inc -/ /- A finite family of roots needs only analytic first and second power sums: individual roots need not admit continuous or analytic labels. -/ namespace Source29QuadraticSheetBound open Filter Finset open scoped Topology noncomputable section lemma finite_real_part_bound {ι : Type*} [Fintype ι] (w : ι → ℂ) (A B t : ℝ) (hA : 0 ≤ A) (hB : 0 ≤ B) (ht : 0 ≤ t) (hupper : ∀ j, (w j).re ≤ B * t) (hsum : ‖∑ j, w j‖ ≤ A * t) (j : ι) : |(w j).re| ≤ (A + ((Fintype.card ι : ℝ) + 1) * B) * t := by classical have hm : (0 : ℝ) ≤ Fintype.card ι := Nat.cast_nonneg _ have hD : B ≤ A + ((Fintype.card ι : ℝ) + 1) * B := by nlinarith have hupper' : (w j).re ≤ (A + ((Fintype.card ι : ℝ) + 1) * B) * t := (hupper j).trans (mul_le_mul_of_nonneg_right hD ht) have hlower : -(A * t) ≤ (∑ i, w i).re := by have hh := (abs_le.mp (Complex.abs_re_le_norm (∑ i, w i))).1 linarith have hdeficit : B * t - (w j).re ≤ ∑ i, (B * t - (w i).re) := by exact single_le_sum (fun i _ => sub_nonneg.mpr (hupper i)) (mem_univ j) have hsumdef : (∑ i, (B * t - (w i).re)) = (Fintype.card ι : ℝ) * (B * t) - (∑ i, w i).re := by simp [Finset.sum_sub_distrib, Complex.re_sum] rw [hsumdef] at hdeficit apply abs_le.mpr constructor · nlinarith [mul_nonneg hB ht] · exact hupper' lemma finite_norm_square_bound {ι : Type*} [Fintype ι] (w : ι → ℂ) (D B t : ℝ) (hre : ∀ j, (w j).re^2 ≤ D * t) (hpower : ‖∑ j, (w j)^2‖ ≤ B * t) (j : ι) : ‖w j‖^2 ≤ (((Fintype.card ι : ℝ) + 1) * D + B) * t := by have hresum : (∑ i, (w i).re^2) ≤ (Fintype.card ι : ℝ) * D * t := by calc (∑ i, (w i).re^2) ≤ ∑ i : ι, D * t := sum_le_sum (fun i _ => hre i) _ = _ := by simp [mul_assoc] have hlower : -(B * t) ≤ (∑ i, (w i)^2).re := by have hh := (abs_le.mp (Complex.abs_re_le_norm (∑ i, (w i)^2))).1 linarith have him := Source29ComplexMaximum.imaginary_square_le w ((Fintype.card ι : ℝ) * D * t) (B * t) hresum hlower j have hj := hre j rw [Complex.sq_norm, Complex.normSq_apply] nlinarith variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] /-- Analytic first and second power sums upgrade one-sided quadratic real-part bounds to uniform quadratic norm bounds on every root. -/ theorem quadratic_sheet_bound {ι : Type*} [Fintype ι] (w : E → ι → ℂ) (hzero : ∀ j, w 0 j = 0) (hS1 : AnalyticAt ℂ (fun x => ∑ j, w x j) 0) (hS2 : AnalyticAt ℂ (fun x => ∑ j, (w x j)^2) 0) (C : ℝ) (hupper : ∀ᶠ x in 𝓝 (0 : E), ∀ j, (w x j).re ≤ C * ‖x‖^2) : ∃ A : ℝ, 0 < A ∧ ∀ᶠ x in 𝓝 (0 : E), ∀ j, ‖w x j‖ ≤ A * ‖x‖^2 := by let m : ℝ := Fintype.card ι have hm : 0 ≤ m := Nat.cast_nonneg _ have hupperB : ∀ᶠ x in 𝓝 (0 : E), ∀ j, (w x j).re ≤ |C| * ‖x‖^2 := by filter_upwards [hupper] with x hx j exact (hx j).trans (mul_le_mul_of_nonneg_right (le_abs_self C) (sq_nonneg ‖x‖)) have hsumUpper : ∀ᶠ x in 𝓝 (0 : E), (∑ j, w x j).re ≤ (m * |C|) * ‖x‖^2 := by filter_upwards [hupperB] with x hx rw [Complex.re_sum] calc (∑ j, (w x j).re) ≤ ∑ j : ι, |C| * ‖x‖^2 := sum_le_sum (fun j _ => hx j) _ = _ := by simp [m, mul_assoc] obtain ⟨A1, hA1, hsumBound⟩ := Source29OneSidedMultivariate.norm_bound_of_one_sided_bound (fun x => ∑ j, w x j) hS1 (by simp [hzero]) 2 (m * |C|) hsumUpper let D : ℝ := A1 + (m + 1) * |C| have hD : 0 < D := by dsimp [D]; positivity have hreal : ∀ᶠ x in 𝓝 (0 : E), ∀ j, |(w x j).re| ≤ D * ‖x‖^2 := by filter_upwards [hupperB, hsumBound] with x hx hs j exact finite_real_part_bound (w x) A1 |C| (‖x‖^2) hA1.le (abs_nonneg C) (sq_nonneg ‖x‖) hx hs j have hrealSq : ∀ᶠ x in 𝓝 (0 : E), ∀ j, (w x j).re^2 ≤ D^2 * ‖x‖^4 := by filter_upwards [hreal] with x hx j have hh := (sq_le_sq₀ (abs_nonneg ((w x j).re)) (mul_nonneg hD.le (sq_nonneg ‖x‖))).mpr (hx j) nlinarith [sq_abs ((w x j).re)] have hS2upper : ∀ᶠ x in 𝓝 (0 : E), (∑ j, (w x j)^2).re ≤ (m * D^2) * ‖x‖^4 := by filter_upwards [hrealSq] with x hx rw [Complex.re_sum] calc (∑ j, ((w x j)^2).re) ≤ ∑ j, (w x j).re^2 := by apply sum_le_sum intro j hj simp only [pow_two, Complex.mul_re] nlinarith [sq_nonneg ((w x j).im)] _ ≤ ∑ j : ι, D^2 * ‖x‖^4 := sum_le_sum (fun j _ => hx j) _ = _ := by simp [m, mul_assoc] obtain ⟨A2, hA2, hS2bound⟩ := Source29OneSidedMultivariate.norm_bound_of_one_sided_bound (fun x => ∑ j, (w x j)^2) hS2 (by simp [hzero]) 4 (m * D^2) hS2upper let K : ℝ := (m + 1) * D^2 + A2 have hK : 0 < K := by dsimp [K]; positivity have hKsq : K ≤ (K + 1)^2 := by nlinarith [sq_nonneg K] refine ⟨K + 1, by positivity, ?_⟩ filter_upwards [hrealSq, hS2bound] with x hx hs j have hj : ‖w x j‖^2 ≤ K * ‖x‖^4 := finite_norm_square_bound (w x) (D^2) A2 (‖x‖^4) hx hs j have hsq : ‖w x j‖^2 ≤ ((K + 1) * ‖x‖^2)^2 := by calc ‖w x j‖^2 ≤ K * ‖x‖^4 := hj _ ≤ (K + 1)^2 * ‖x‖^4 := mul_le_mul_of_nonneg_right hKsq (pow_nonneg (norm_nonneg x) 4) _ = _ := by ring exact (sq_le_sq₀ (norm_nonneg (w x j)) (by positivity)).mp hsq /-- The version directly matching a one-sided estimate on the normal linear form, with a fixed nonzero normal-square coefficient. -/ theorem quadratic_sheet_bound_scaled {ι : Type*} [Fintype ι] (w : E → ι → ℂ) (hzero : ∀ j, w 0 j = 0) (hS1 : AnalyticAt ℂ (fun x => ∑ j, w x j) 0) (hS2 : AnalyticAt ℂ (fun x => ∑ j, (w x j)^2) 0) (c : ℂ) (hc : c ≠ 0) (C : ℝ) (hupper : ∀ᶠ x in 𝓝 (0 : E), ∀ j, (c * w x j).re ≤ C * ‖x‖^2) : ∃ A : ℝ, 0 < A ∧ ∀ᶠ x in 𝓝 (0 : E), ∀ j, ‖w x j‖ ≤ A * ‖x‖^2 := by have h1 : AnalyticAt ℂ (fun x => ∑ j, c * w x j) 0 := by simpa only [Pi.mul_def, Finset.mul_sum] using (analyticAt_const.mul hS1 : AnalyticAt ℂ (fun x => c * ∑ j, w x j) 0) have h2 : AnalyticAt ℂ (fun x => ∑ j, (c * w x j)^2) 0 := by simpa only [Pi.mul_def, Finset.mul_sum, mul_pow] using (analyticAt_const.mul hS2 : AnalyticAt ℂ (fun x => c^2 * ∑ j, (w x j)^2) 0) obtain ⟨A, hA, hbound⟩ := quadratic_sheet_bound (fun x j => c * w x j) (by intro j; simp [hzero]) h1 h2 C hupper have hcpos : 0 < ‖c‖ := norm_pos_iff.mpr hc refine ⟨A / ‖c‖, div_pos hA hcpos, ?_⟩ filter_upwards [hbound] with x hx j have hj := hx j rw [norm_mul] at hj calc ‖w x j‖ ≤ (A * ‖x‖^2) / ‖c‖ := (le_div_iff₀ hcpos).mpr (by simpa only [mul_comm] using hj) _ = (A / ‖c‖) * ‖x‖^2 := by ring end end Source29QuadraticSheetBound /- Component: LocalFactorLinear.lean -/ /-! The finite dimensional linear algebra behind local polynomial preparation. This file proves no analytic factorization or convergence assertion. -/ namespace Source29LocalFactorLinear open Polynomial noncomputable section variable {K : Type*} [Field K] /-- Finite coefficient vectors as polynomials. -/ def coeffPolynomial (k : ℕ) (v : Fin k → K) : K[X] := ((degreeLTEquiv K k).symm v : degreeLT K k).val /-- The finite coefficient multiplication map used for local preparation. -/ def factorMap (s r : ℕ) (ab : (Fin s → K) × (Fin (r+1) → K)) : Fin (s+r+1) → K := fun i => ((X^s + coeffPolynomial s ab.1) * coeffPolynomial (r+1) ab.2).coeff i lemma degree_coeffPolynomial_lt (k : ℕ) (v : Fin k → K) : (coeffPolynomial k v).degree < k := mem_degreeLT.mp ((degreeLTEquiv K k).symm v).property lemma degree_factorPolynomial_lt (s r : ℕ) (ab : (Fin s → K) × (Fin (r+1) → K)) : ((X^s + coeffPolynomial s ab.1) * coeffPolynomial (r+1) ab.2).degree < (s+r+1 : WithBot ℕ) := by have hA : (X^s + coeffPolynomial s ab.1).degree ≤ (s : WithBot ℕ) := (degree_add_le _ _).trans (max_le (by simp) (degree_coeffPolynomial_lt _ _).le) by_cases h0 : X^s + coeffPolynomial s ab.1 = 0 · simp [h0] apply (degree_mul_le _ _).trans_lt have h := WithBot.add_lt_add_of_le_of_lt (by simpa using h0) hA (degree_coeffPolynomial_lt (r+1) ab.2) simpa only [Nat.cast_add, Nat.cast_one, add_assoc] using h /-- Equality in the finite coefficient space is exact polynomial equality. -/ theorem factorMap_eq_iff (s r : ℕ) (ab : (Fin s → K) × (Fin (r+1) → K)) (P : K[X]) (hP : P.degree < (s+r+1 : WithBot ℕ)) : factorMap s r ab = (fun i : Fin (s+r+1) => P.coeff i) ↔ (X^s + coeffPolynomial s ab.1) * coeffPolynomial (r+1) ab.2 = P := by constructor · intro h ext i by_cases hi : i < s+r+1 · exact congrFun h ⟨i, hi⟩ · have hle : (s+r+1 : WithBot ℕ) ≤ i := by exact_mod_cast (Nat.le_of_not_gt hi) rw [coeff_eq_zero_of_degree_lt ((degree_factorPolynomial_lt s r ab).trans_le hle), coeff_eq_zero_of_degree_lt (hP.trans_le hle)] · intro h funext i exact congrArg (fun p : K[X] => p.coeff i) h /-- The derivative of `(A,B) ↦ (X^s+A)B` at `(0,g)`, on the indicated degree bounded polynomial spaces. -/ def factorDerivative (s r : ℕ) (g : K[X]) (hg : g.natDegree ≤ r) : (degreeLT K s × degreeLT K (r+1)) →ₗ[K] degreeLT K (s+r+1) where toFun ab := ⟨g * (ab.1 : K[X]) + X^s * (ab.2 : K[X]), by apply mem_degreeLT.mpr apply (degree_add_le _ _).trans_lt apply max_lt · by_cases hg0 : g = 0 · simp [hg0] have hga := degree_mul_le g (ab.1 : K[X]) have ha := mem_degreeLT.mp ab.1.property have hg' := degree_le_of_natDegree_le hg have h := WithBot.add_lt_add_of_le_of_lt (by simpa using hg0) hg' ha exact hga.trans_lt (h.trans_le (by norm_cast; omega)) · have hxb := degree_mul_le (X^s : K[X]) (ab.2 : K[X]) rw [degree_X_pow] at hxb have hb := mem_degreeLT.mp ab.2.property have h := WithBot.add_lt_add_of_le_of_lt (by simp : (s : WithBot ℕ) ≠ ⊥) le_rfl hb exact hxb.trans_lt (h.trans_eq (by simp [Nat.add_assoc]))⟩ map_add' ab cd := by ext1; dsimp; ring map_smul' c ab := by ext1; simp [smul_eq_C_mul]; ring lemma coprime_X_pow_of_coeff_zero_ne (s : ℕ) (g : K[X]) (hg : g.coeff 0 ≠ 0) : IsCoprime (X^s) g := by apply IsCoprime.pow_left apply IsRelPrime.isCoprime apply (irreducible_X (R := K)).isRelPrime_iff_not_dvd.mpr simpa only [X_dvd_iff] using hg theorem factorDerivative_injective (s r : ℕ) (g : K[X]) (hg : g.natDegree ≤ r) (hg0 : g.coeff 0 ≠ 0) : Function.Injective (factorDerivative s r g hg) := by apply (LinearMap.ker_eq_bot).mp apply LinearMap.ker_eq_bot'.mpr intro ab hab have heq : g * (ab.1 : K[X]) + X^s * (ab.2 : K[X]) = 0 := congrArg Subtype.val hab have hdiv : (X^s : K[X]) ∣ g * (ab.1 : K[X]) := by refine ⟨-(ab.2 : K[X]), ?_⟩ linear_combination heq have haDiv := (coprime_X_pow_of_coeff_zero_ne s g hg0).dvd_of_dvd_mul_left hdiv have ha : (ab.1 : K[X]) = 0 := eq_zero_of_dvd_of_degree_lt haDiv (by rw [degree_X_pow] exact mem_degreeLT.mp ab.1.property) have hb : (ab.2 : K[X]) = 0 := by rw [ha, mul_zero, zero_add] at heq exact (mul_eq_zero.mp heq).resolve_left (pow_ne_zero _ X_ne_zero) exact Prod.ext (Subtype.ext ha) (Subtype.ext hb) /-- The same derivative written in finite coefficient coordinates. -/ def factorDerivativeCoeff (s r : ℕ) (g : K[X]) (hg : g.natDegree ≤ r) : ((Fin s → K) × (Fin (r+1) → K)) →ₗ[K] (Fin (s+r+1) → K) := (degreeLTEquiv K (s+r+1)).toLinearMap.comp ((factorDerivative s r g hg).comp (((degreeLTEquiv K s).symm.prodCongr (degreeLTEquiv K (r+1)).symm).toLinearMap)) lemma factorDerivativeCoeff_apply (s r : ℕ) (g : K[X]) (hg : g.natDegree ≤ r) (ab : (Fin s → K) × (Fin (r+1) → K)) (i : Fin (s+r+1)) : factorDerivativeCoeff s r g hg ab i = (g * coeffPolynomial s ab.1 + X^s * coeffPolynomial (r+1) ab.2).coeff i := rfl theorem factorDerivativeCoeff_injective (s r : ℕ) (g : K[X]) (hg : g.natDegree ≤ r) (hg0 : g.coeff 0 ≠ 0) : Function.Injective (factorDerivativeCoeff s r g hg) := (degreeLTEquiv K (s+r+1)).injective.comp ((factorDerivative_injective s r g hg hg0).comp ((degreeLTEquiv K s).symm.prodCongr (degreeLTEquiv K (r+1)).symm).injective) /-- Coprimality makes the coefficient derivative an isomorphism. -/ def factorDerivativeEquiv (s r : ℕ) (g : K[X]) (hg : g.natDegree ≤ r) (hg0 : g.coeff 0 ≠ 0) : ((Fin s → K) × (Fin (r+1) → K)) ≃ₗ[K] (Fin (s+r+1) → K) := (factorDerivativeCoeff s r g hg).linearEquivOfInjective (factorDerivativeCoeff_injective s r g hg hg0) (by simp [Module.finrank_prod, Nat.add_assoc]) lemma factorDerivativeEquiv_apply (s r : ℕ) (g : K[X]) (hg : g.natDegree ≤ r) (hg0 : g.coeff 0 ≠ 0) (ab : (Fin s → K) × (Fin (r+1) → K)) : factorDerivativeEquiv s r g hg hg0 ab = factorDerivativeCoeff s r g hg ab := rfl end end Source29LocalFactorLinear /- Component: LocalFactorAnalytic.inc -/ namespace Source29LocalFactorAnalytic open Polynomial Source29LocalFactorLinear open scoped BigOperators noncomputable section /-- Each coefficient of a finite coefficient vector is a continuous linear functional, including coefficients beyond its truncation length. -/ def coefficientCLM (k n : ℕ) : (Fin k → ℂ) →L[ℂ] ℂ := ((Polynomial.lcoeff ℂ n).comp ((degreeLT ℂ k).subtype.comp (degreeLTEquiv ℂ k).symm.toLinearMap)).toContinuousLinearMap lemma coefficientCLM_apply (k n : ℕ) (v : Fin k → ℂ) : coefficientCLM k n v = (coeffPolynomial k v).coeff n := rfl theorem analyticAt_coeffPolynomial (k n : ℕ) (v : Fin k → ℂ) : AnalyticAt ℂ (fun x => (coeffPolynomial k x).coeff n) v := (coefficientCLM k n).analyticAt v /-- Multiplication of finite coefficient vectors is analytic. This supplies analytic regularity for the local polynomial factorization construction. -/ theorem analyticAt_factorMap (s r : ℕ) (ab : (Fin s → ℂ) × (Fin (r+1) → ℂ)) : AnalyticAt ℂ (factorMap s r) ab := by apply AnalyticAt.pi intro i simp only [factorMap, coeff_mul, coeff_add] apply Finset.analyticAt_fun_sum intro q hq exact (analyticAt_const.add ((analyticAt_coeffPolynomial s q.1 ab.1).comp analyticAt_fst)).mul ((analyticAt_coeffPolynomial (r+1) q.2 ab.2).comp analyticAt_snd) end end Source29LocalFactorAnalytic /- Component: LocalFactorDerivative.inc -/ namespace Source29LocalFactorAnalytic open Polynomial Source29LocalFactorLinear open scoped BigOperators noncomputable section lemma coeffPolynomial_zero (k : ℕ) : coeffPolynomial k (0 : Fin k → ℂ) = 0 := by simp [coeffPolynomial] /-- The derivative of coefficient multiplication at a separated factorization is precisely the algebraic coefficient derivative. -/ theorem hasFDerivAt_factorMap (s r : ℕ) (g : ℂ[X]) (hg : g.natDegree ≤ r) (b : Fin (r+1) → ℂ) (hb : coeffPolynomial (r+1) b = g) : HasFDerivAt (factorMap s r) (factorDerivativeCoeff s r g hg).toContinuousLinearMap (0, b) := by let D := (Fin s → ℂ) × (Fin (r+1) → ℂ) let A (n : ℕ) : D →L[ℂ] ℂ := (coefficientCLM s n).comp (ContinuousLinearMap.fst ℂ _ _) let B (n : ℕ) : D →L[ℂ] ℂ := (coefficientCLM (r+1) n).comp (ContinuousLinearMap.snd ℂ _ _) have hA (n : ℕ) (ab : D) : A n ab = (coeffPolynomial s ab.1).coeff n := rfl have hB (n : ℕ) (ab : D) : B n ab = (coeffPolynomial (r+1) ab.2).coeff n := rfl apply hasFDerivAt_pi'' intro i have hterm (q : ℕ × ℕ) : HasFDerivAt (fun ab : D => ((X^s : ℂ[X]).coeff q.1 + A q.1 ab) * B q.2 ab) ((((X^s : ℂ[X]).coeff q.1 + A q.1 (0, b)) • B q.2) + B q.2 (0, b) • A q.1) (0, b) := by convert! ((hasFDerivAt_const ((X^s : ℂ[X]).coeff q.1) ((0, b) : D)).add (A q.1).hasFDerivAt).mul (B q.2).hasFDerivAt using 1 <;> simp have hsum := HasFDerivAt.sum (u := Finset.antidiagonal (i : ℕ)) (fun q _ => hterm q) convert hsum using 1 · funext ab simp [factorMap, coeff_mul, coeff_add, hA, hB] · apply ContinuousLinearMap.ext intro ab change (g * coeffPolynomial s ab.1 + X^s * coeffPolynomial (r+1) ab.2).coeff (i : ℕ) = _ have hswap : (∑ q ∈ Finset.antidiagonal (i : ℕ), g.coeff q.1 * (coeffPolynomial s ab.1).coeff q.2) = ∑ q ∈ Finset.antidiagonal (i : ℕ), g.coeff q.2 * (coeffPolynomial s ab.1).coeff q.1 := by simpa using (Finset.Nat.sum_antidiagonal_swap (n := (i : ℕ)) (f := fun q => g.coeff q.1 * (coeffPolynomial s ab.1).coeff q.2)).symm simp only [sum_apply, add_apply, smul_apply] simp [hA, hB, coeffPolynomial_zero, hb, coeff_mul, coeff_add, Finset.sum_add_distrib, mul_comm, add_comm, hswap] /-- Analytic coefficient multiplication has the same strict derivative, so the finite-dimensional inverse function theorem applies to the separated factors. -/ theorem hasStrictFDerivAt_factorMap (s r : ℕ) (g : ℂ[X]) (hg : g.natDegree ≤ r) (b : Fin (r+1) → ℂ) (hb : coeffPolynomial (r+1) b = g) : HasStrictFDerivAt (factorMap s r) (factorDerivativeCoeff s r g hg).toContinuousLinearMap (0, b) := by have h := (analyticAt_factorMap s r (0, b)).hasStrictFDerivAt rw [(hasFDerivAt_factorMap s r g hg b hb).fderiv] at h exact h end end Source29LocalFactorAnalytic /- Component: LocalPolynomialPreparation.inc -/ namespace Source29LocalPreparation open Polynomial Source29LocalFactorLinear Source29LocalFactorAnalytic open scoped Topology BigOperators noncomputable section /-- The analytic inverse theorem, packaged as a local right inverse. -/ theorem exists_analytic_local_inverse {E F : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] [CompleteSpace E] [NormedAddCommGroup F] [NormedSpace ℂ F] (f : E → F) (a : E) (e : E ≃L[ℂ] F) (ha : AnalyticAt ℂ f a) (hd : HasStrictFDerivAt f (e : E →L[ℂ] F) a) : ∃ u : F → E, AnalyticAt ℂ u (f a) ∧ u (f a) = a ∧ ∀ᶠ y in 𝓝 (f a), f (u y) = y := by let L := hd.toOpenPartialHomeomorph f have hL : (L : E → F) = f := hd.toOpenPartialHomeomorph_coe have hLa : a ∈ L.source := hd.mem_toOpenPartialHomeomorph_source refine ⟨L.symm, ?_, ?_, ?_⟩ · have h := L.analyticAt_symm' (i := e) hLa (show AnalyticAt ℂ L a by simpa only [hL] using ha) (show fderiv ℂ L a = e by simpa only [hL] using hd.hasFDerivAt.fderiv) simpa only [hL] using h · simpa only [hL] using L.left_inv hLa · have ht := L.open_target.mem_nhds (L.map_source hLa) have hright : ∀ᶠ y in 𝓝 (L a), L (L.symm y) = y := Filter.Eventually.mono ht (fun _ hy => L.right_inv hy) simpa only [hL] using hright /-- A uniformly degree bounded family with analytic coefficients has analytic joint evaluation in its parameter and polynomial variable. -/ theorem analyticAt_joint_eval {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] (B : E → ℂ[X]) (a : E) (w : ℂ) (k : ℕ) (hdegree : ∀ x, (B x).degree < (k : WithBot ℕ)) (hcoeff : ∀ n, AnalyticAt ℂ (fun x => (B x).coeff n) a) : AnalyticAt ℂ (fun y : E × ℂ => (B y.1).eval y.2) (a,w) := by have heq : (fun y : E × ℂ => (B y.1).eval y.2) = (fun y => ∑ i : Fin k, (B y.1).coeff i * y.2^(i : ℕ)) := by funext y exact eval_eq_sum_degreeLTEquiv (mem_degreeLT.mpr (hdegree y.1)) y.2 rw [heq] apply Finset.analyticAt_fun_sum intro i _ have hf : AnalyticAt ℂ (fun y : E × ℂ => (B y.1).coeff i) (a,w) := AnalyticAt.comp (g := fun x : E => (B x).coeff (i : ℕ)) (f := fun y : E × ℂ => y.1) (x := (a,w)) (hcoeff (i : ℕ)) analyticAt_fst have hw : AnalyticAt ℂ (fun y : E × ℂ => y.2) (a,w) := analyticAt_snd exact hf.mul (hw.pow (i : ℕ)) theorem eventually_joint_eval_ne_zero {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] (B : E → ℂ[X]) (a : E) (k : ℕ) (hdegree : ∀ x, (B x).degree < (k : WithBot ℕ)) (hcoeff : ∀ n, AnalyticAt ℂ (fun x => (B x).coeff n) a) (hzero : (B a).coeff 0 ≠ 0) : ∀ᶠ y : E × ℂ in 𝓝 (a,0), (B y.1).eval y.2 ≠ 0 := by apply (analyticAt_joint_eval B a 0 k hdegree hcoeff).continuousAt.eventually_ne simpa only [← coeff_zero_eq_eval_zero] using hzero /-- Local polynomial preparation obtained from a finite coefficient inverse. The degree bound is uniform, but the leading coefficient need not be nonzero at the base point. -/ theorem local_polynomial_preparation {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] (P : E → ℂ[X]) (a : E) (s r : ℕ) (g : ℂ[X]) (hg : g.natDegree ≤ r) (hg0 : g.coeff 0 ≠ 0) (hbase : P a = X^s * g) (hdegree : ∀ᶠ x in 𝓝 a, (P x).degree < (s+r+1 : WithBot ℕ)) (hcoeff : ∀ i : Fin (s+r+1), AnalyticAt ℂ (fun x => (P x).coeff i) a) : ∃ W B : E → ℂ[X], (∀ x, (W x).Monic ∧ (W x).natDegree = s) ∧ W a = X^s ∧ B a = g ∧ (∀ n, AnalyticAt ℂ (fun x => (W x).coeff n) a) ∧ (∀ n, AnalyticAt ℂ (fun x => (B x).coeff n) a) ∧ (∀ x, (B x).degree < (r+1 : WithBot ℕ)) ∧ (∀ᶠ y : E × ℂ in 𝓝 (a,0), (B y.1).eval y.2 ≠ 0) ∧ ∀ᶠ x in 𝓝 a, W x * B x = P x := by let b : Fin (r+1) → ℂ := fun i => g.coeff i have hgmem : g ∈ degreeLT ℂ (r+1) := by apply mem_degreeLT.mpr exact (degree_le_of_natDegree_le hg).trans_lt (by exact_mod_cast Nat.lt_succ_self r) have hb : coeffPolynomial (r+1) b = g := congrArg Subtype.val ((degreeLTEquiv ℂ (r+1)).symm_apply_apply ⟨g, hgmem⟩) let e := (factorDerivativeEquiv s r g hg hg0).toContinuousLinearEquiv have hd : HasStrictFDerivAt (factorMap s r) (e : _ →L[ℂ] _) (0,b) := by have he : (e : _ →L[ℂ] _) = (factorDerivativeCoeff s r g hg).toContinuousLinearMap := by apply ContinuousLinearMap.ext intro x rfl rw [he] exact hasStrictFDerivAt_factorMap s r g hg b hb obtain ⟨u, hu, hubase, hulocal⟩ := exists_analytic_local_inverse (factorMap s r) (0,b) e (analyticAt_factorMap s r (0,b)) hd let Q : E → (Fin (s+r+1) → ℂ) := fun x i => (P x).coeff i have hQ : AnalyticAt ℂ Q a := AnalyticAt.pi hcoeff have hQbase : Q a = factorMap s r (0,b) := by funext i change (P a).coeff i = ((X^s+coeffPolynomial s 0)*coeffPolynomial (r+1) b).coeff i have hz : coeffPolynomial s (0 : Fin s → ℂ) = 0 := by simp [coeffPolynomial] rw [hbase, hb, hz, add_zero] have hua : AnalyticAt ℂ (fun x => u (Q x)) a := by apply AnalyticAt.comp _ hQ simpa only [hQbase] using hu have hua0 : u (Q a) = (0,b) := by simpa only [hQbase] using hubase let W : E → ℂ[X] := fun x => X^s + coeffPolynomial s (u (Q x)).1 let B : E → ℂ[X] := fun x => coeffPolynomial (r+1) (u (Q x)).2 refine ⟨W, B, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ · intro x refine ⟨monic_X_pow_add (degree_coeffPolynomial_lt _ _), ?_⟩ dsimp [W] rw [natDegree_add_eq_left_of_degree_lt] · simp · simpa only [degree_X_pow] using degree_coeffPolynomial_lt s (u (Q x)).1 · change X^s + coeffPolynomial s (u (Q a)).1 = X^s rw [hua0] simp [coeffPolynomial] · change coeffPolynomial (r+1) (u (Q a)).2 = g simpa only [hua0] using hb · intro n change AnalyticAt ℂ (fun x => (X^s+coeffPolynomial s (u (Q x)).1).coeff n) a simp only [coeff_add] exact analyticAt_const.add ((analyticAt_coeffPolynomial s n _).comp (analyticAt_fst.comp hua)) · intro n exact (analyticAt_coeffPolynomial (r+1) n _).comp (analyticAt_snd.comp hua) · intro x exact degree_coeffPolynomial_lt (r+1) (u (Q x)).2 · apply eventually_joint_eval_ne_zero B a (r+1) · intro x exact degree_coeffPolynomial_lt (r+1) (u (Q x)).2 · intro n exact (analyticAt_coeffPolynomial (r+1) n _).comp (analyticAt_snd.comp hua) · change (coeffPolynomial (r+1) (u (Q a)).2).coeff 0 ≠ 0 simpa only [hua0, hb] using hg0 · have hev : ∀ᶠ x in 𝓝 a, factorMap s r (u (Q x)) = Q x := hQ.continuousAt.tendsto.eventually (by simpa only [← hQbase] using hulocal) filter_upwards [hdegree, hev] with x hx hux exact (factorMap_eq_iff s r (u (Q x)) (P x) hx).mp hux end end Source29LocalPreparation /- Component: SliceAnalytic.inc -/ namespace Source29SliceAnalytic open Polynomial MvPolynomial Source29SlicePolynomial open scoped BigOperators noncomputable section lemma analyticAt_affine_coeff {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] (v : E → ℂ) (a : E) (u : ℂ) (k : ℕ) (hv : AnalyticAt ℂ v a) : AnalyticAt ℂ (fun x => (Polynomial.C (v x)+Polynomial.X*Polynomial.C u).coeff k) a := by have hC : AnalyticAt ℂ (fun x => (Polynomial.C (v x)).coeff k) a := by simp only [Polynomial.coeff_C] split_ifs · exact hv · exact analyticAt_const simpa only [Polynomial.coeff_add, Pi.add_def] using hC.add (show AnalyticAt ℂ (fun _ : E => (Polynomial.X*Polynomial.C u).coeff k) a from analyticAt_const) /-- A polynomial restricted to moving affine complex lines has analytic coefficients whenever the base point coordinates vary analytically. -/ theorem analyticAt_lineSlice_coeff {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (v : E → Fin n → ℂ) (u : Fin n → ℂ) (a : E) (hv : ∀ i, AnalyticAt ℂ (fun x => v x i) a) (k : ℕ) : AnalyticAt ℂ (fun x => (lineSlice P (v x) u).coeff k) a := by induction P using MvPolynomial.induction_on generalizing k with | C c => simpa only [lineSlice, MvPolynomial.eval₂_C] using (show AnalyticAt ℂ (fun _ : E => (Polynomial.C c).coeff k) a from analyticAt_const) | add p q hp hq => simpa only [lineSlice, MvPolynomial.eval₂_add, Polynomial.coeff_add, Pi.add_def] using (hp k).add (hq k) | mul_X p i hp => simp only [lineSlice, MvPolynomial.eval₂_mul, MvPolynomial.eval₂_X, Polynomial.coeff_mul] apply Finset.analyticAt_fun_sum intro q _ exact (hp q.1).mul (analyticAt_affine_coeff (fun x => v x i) a (u i) q.2 (hv i)) end end Source29SliceAnalytic /- Component: SlicePreparation.inc -/ namespace Source29SlicePreparation open Polynomial Source29SlicePolynomial Source29SliceAnalytic Source29LocalPreparation open scoped Topology noncomputable section /-- Polynomial-specific preparation for moving affine slices of a fixed multivariate polynomial. -/ theorem lineSlice_preparation {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (v : E → Fin n → ℂ) (u : Fin n → ℂ) (a : E) (hv : ∀ i, AnalyticAt ℂ (fun x => v x i) a) (s r : ℕ) (g : ℂ[X]) (hg : g.natDegree ≤ r) (hg0 : g.coeff 0 ≠ 0) (hdegree : P.totalDegree ≤ s+r) (hbase : lineSlice P (v a) u = X^s*g) : ∃ W B : E → ℂ[X], (∀ x, (W x).Monic ∧ (W x).natDegree = s) ∧ W a = X^s ∧ B a = g ∧ (∀ k, AnalyticAt ℂ (fun x => (W x).coeff k) a) ∧ (∀ k, AnalyticAt ℂ (fun x => (B x).coeff k) a) ∧ (∀ x, (B x).degree < (r+1 : WithBot ℕ)) ∧ (∀ᶠ y : E × ℂ in 𝓝 (a,0), (B y.1).eval y.2 ≠ 0) ∧ ∀ᶠ x in 𝓝 a, W x * B x = lineSlice P (v x) u := by apply local_polynomial_preparation (fun x => lineSlice P (v x) u) a s r g hg hg0 hbase · apply Filter.Eventually.of_forall intro x have h := degree_le_of_natDegree_le ((natDegree_lineSlice_le P (v x) u).trans hdegree) exact h.trans_lt (by exact_mod_cast Nat.lt_succ_self (s+r)) · intro i exact analyticAt_lineSlice_coeff P v u a hv i end end Source29SlicePreparation /- Component: RootCluster.lean -/ namespace Source29RootCluster open Polynomial Filter open scoped BigOperators Topology noncomputable section /-- At a root of a monic polynomial, the leading power is bounded by the contributions of the lower coefficients. -/ theorem root_power_le (p : ℂ[X]) (s : ℕ) (hp : p.Monic) (hs : p.natDegree = s) (w : ℂ) (hw : p.eval w = 0) : ‖w‖ ^ s ≤ ∑ i ∈ Finset.range s, ‖p.coeff i‖ * ‖w‖ ^ i := by have hc : p.coeff s = 1 := by rw [← hs, coeff_natDegree, hp.leadingCoeff] have he : (∑ i ∈ Finset.range s, p.coeff i * w ^ i) = -(w ^ s) := by rw [eval_eq_sum_range, hs, Finset.sum_range_succ, hc, one_mul] at hw exact eq_neg_of_add_eq_zero_left hw calc ‖w‖ ^ s = ‖∑ i ∈ Finset.range s, p.coeff i * w ^ i‖ := by rw [he, norm_neg, norm_pow] _ ≤ ∑ i ∈ Finset.range s, ‖p.coeff i * w ^ i‖ := norm_sum_le _ _ _ = ∑ i ∈ Finset.range s, ‖p.coeff i‖ * ‖w‖ ^ i := by simp only [norm_mul, norm_pow] /-- A small sum of lower coefficients forces every root into a prescribed small disk. This elementary estimate needs no root enumeration or continuity of a chosen root. -/ theorem root_norm_lt_of_coeff_sum_lt (p : ℂ[X]) (s : ℕ) (hp : p.Monic) (hs : p.natDegree = s) (ρ : ℝ) (hρ : 0 < ρ) (hρone : ρ ≤ 1) (hc : (∑ i ∈ Finset.range s, ‖p.coeff i‖) < ρ ^ s) (w : ℂ) (hw : p.eval w = 0) : ‖w‖ < ρ := by have hroot := root_power_le p s hp hs w hw by_contra hn have hlarge : ρ ≤ ‖w‖ := le_of_not_gt hn by_cases hwone : ‖w‖ ≤ 1 · have hsum : (∑ i ∈ Finset.range s, ‖p.coeff i‖ * ‖w‖ ^ i) ≤ ∑ i ∈ Finset.range s, ‖p.coeff i‖ := by apply Finset.sum_le_sum intro i hi exact mul_le_of_le_one_right (norm_nonneg _) (pow_le_one₀ (norm_nonneg _) hwone) have hpow : ρ ^ s ≤ ‖w‖ ^ s := pow_le_pow_left₀ hρ.le hlarge s exact (not_lt_of_ge (hpow.trans (hroot.trans hsum))) hc · have hwpos : 0 < ‖w‖ := hρ.trans_le hlarge have hsum : (∑ i ∈ Finset.range s, ‖p.coeff i‖ * ‖w‖ ^ i) ≤ (∑ i ∈ Finset.range s, ‖p.coeff i‖) * ‖w‖ ^ s := by rw [Finset.sum_mul] apply Finset.sum_le_sum intro i hi exact mul_le_mul_of_nonneg_left (pow_le_pow_right₀ (le_of_lt (lt_of_not_ge hwone)) (Nat.le_of_lt (Finset.mem_range.mp hi))) (norm_nonneg _) have hmass : (∑ i ∈ Finset.range s, ‖p.coeff i‖) < 1 := hc.trans_le (pow_le_one₀ hρ.le hρone) have hstrict := mul_lt_mul_of_pos_right hmass (pow_pos hwpos s) simp only [one_mul] at hstrict exact (not_lt_of_ge (hroot.trans hsum)) hstrict /-- In any filter, a monic fixed-degree family with lower coefficients tending to zero has all its roots tending uniformly to zero. -/ theorem eventually_roots_norm_lt_of_coeff_tendsto {α : Type*} {l : Filter α} (W : α → ℂ[X]) (s : ℕ) (hmonic : ∀ᶠ x in l, (W x).Monic) (hdegree : ∀ᶠ x in l, (W x).natDegree = s) (hcoeff : ∀ i < s, Tendsto (fun x => (W x).coeff i) l (𝓝 0)) (ε : ℝ) (hε : 0 < ε) : ∀ᶠ x in l, ∀ w : ℂ, (W x).eval w = 0 → ‖w‖ < ε := by let ρ := min ε 1 have hρ : 0 < ρ := lt_min hε zero_lt_one have hmass : Tendsto (fun x => ∑ i ∈ Finset.range s, ‖(W x).coeff i‖) l (𝓝 0) := by simpa using tendsto_finset_sum (Finset.range s) (fun i hi => (hcoeff i (Finset.mem_range.mp hi)).norm) have hsmall := hmass.eventually_lt_const (pow_pos hρ s) filter_upwards [hmonic, hdegree, hsmall] with x hm hd hc intro w hw exact (root_norm_lt_of_coeff_sum_lt (W x) s hm hd ρ hρ (min_le_right _ _) hc w hw).trans_le (min_le_left _ _) /-- Continuity-at-a-point version for a locally monic family specializing to `X^s`. Only continuity of the lower `s` coefficient functions is required. -/ theorem eventually_roots_norm_lt {E : Type*} [TopologicalSpace E] (W : E → ℂ[X]) (a : E) (s : ℕ) (ha : W a = X ^ s) (hmonic : ∀ᶠ x in 𝓝 a, (W x).Monic) (hdegree : ∀ᶠ x in 𝓝 a, (W x).natDegree = s) (hcoeff : ∀ i < s, ContinuousAt (fun x => (W x).coeff i) a) (ε : ℝ) (hε : 0 < ε) : ∀ᶠ x in 𝓝 a, ∀ w : ℂ, (W x).eval w = 0 → ‖w‖ < ε := by apply eventually_roots_norm_lt_of_coeff_tendsto W s hmonic hdegree _ ε hε intro i hi simpa [ha, coeff_X_pow, ne_of_lt hi] using (hcoeff i hi).tendsto end end Source29RootCluster /- Component: RootEnumeration.lean -/ namespace Source29RootEnumeration open Polynomial open scoped BigOperators noncomputable section /-- Enumerate a multiset with multiplicity, without imposing any regularity on the chosen order. -/ theorem exists_multiset_enumeration {α : Type*} (m : Multiset α) : ∃ w : Fin m.card → α, (List.ofFn w : Multiset α) = m := by refine Quotient.inductionOn m ?_ intro l change ∃ w : Fin l.length → α, (List.ofFn w : Multiset α) = (l : Multiset α) exact ⟨l.get, by rw [List.ofFn_get]⟩ variable {K : Type*} [Field K] lemma esymm_two_cons (a : K) (m : Multiset K) : (a ::ₘ m).esymm 2 = m.esymm 2 + a * m.sum := by simp only [Multiset.esymm, Multiset.powersetCard_cons, Multiset.map_add, Multiset.sum_add, Multiset.powersetCard_one, Multiset.map_map, Function.comp_def, Multiset.prod_cons, Multiset.prod_singleton] congr 1 simpa using (Multiset.sum_map_mul_left (s := m) (a := a) (f := id)) /-- The second Newton identity in a form that does not require a choice of root labels. -/ theorem sum_squares_eq (m : Multiset K) : (m.map (fun x => x ^ 2)).sum = m.sum ^ 2 - 2 * m.esymm 2 := by induction m using Multiset.induction_on with | empty => have he : (0 : Multiset K).esymm 2 = 0 := Multiset.esymm_of_card_lt (by simp) simp [he] | @cons a m ih => rw [Multiset.map_cons, Multiset.sum_cons, Multiset.sum_cons, esymm_two_cons, ih] ring /-- The second upper coefficient is zero in degrees zero and one. -/ def secondUpperCoeff (p : K[X]) (s : ℕ) : K := if 2 ≤ s then p.coeff (s - 2) else 0 lemma roots_esymm_two (p : K[X]) (s : ℕ) (hp : p.Monic) (hs : p.natDegree = s) (hsplit : p.Splits) : p.roots.esymm 2 = secondUpperCoeff p s := by by_cases htwo : 2 ≤ s · have he := coeff_eq_esymm_roots_of_splits hsplit (k := s - 2) (by omega) have hn : s - (s - 2) = 2 := by omega simpa [hs, hp.leadingCoeff, hn, secondUpperCoeff, htwo] using he.symm · have hc : p.roots.card < 2 := by rw [splits_iff_card_roots.mp hsplit, hs]; omega simp [Multiset.esymm_of_card_lt hc, secondUpperCoeff, htwo] lemma roots_sum (p : K[X]) (s : ℕ) (hp : p.Monic) (hs : p.natDegree = s) (hpos : 0 < s) (hsplit : p.Splits) : p.roots.sum = -p.coeff (s - 1) := by have he := hsplit.nextCoeff_eq_neg_sum_roots_of_monic hp have hn : p.nextCoeff = p.coeff (s - 1) := by simp [Polynomial.nextCoeff, hs, hpos.ne'] rw [hn] at he exact (neg_eq_iff_eq_neg.mpr he).symm /-- Every monic split polynomial admits a full root tuple whose first two power sums are its upper coefficient expressions. -/ theorem exists_root_tuple (p : K[X]) (s : ℕ) (hp : p.Monic) (hs : p.natDegree = s) (hpos : 0 < s) (hsplit : p.Splits) : ∃ w : Fin s → K, (List.ofFn w : Multiset K) = p.roots ∧ (∀ i, p.eval (w i) = 0) ∧ (∑ i, w i) = -p.coeff (s - 1) ∧ (∑ i, (w i)^2) = p.coeff (s - 1)^2 - 2 * secondUpperCoeff p s := by have hcard : p.roots.card = s := (splits_iff_card_roots.mp hsplit).trans hs obtain ⟨w, hw⟩ : ∃ w : Fin s → K, (List.ofFn w : Multiset K) = p.roots := by cases hcard exact exists_multiset_enumeration p.roots refine ⟨w, hw, ?_, ?_, ?_⟩ · intro i apply isRoot_of_mem_roots rw [← hw] exact List.mem_ofFn.mpr ⟨i, rfl⟩ · have he := roots_sum p s hp hs hpos hsplit rw [← hw] at he simpa [List.sum_ofFn] using he · have he := sum_squares_eq p.roots rw [roots_sum p s hp hs hpos hsplit, roots_esymm_two p s hp hs hsplit, ← hw] at he simpa [Multiset.map_coe, List.map_ofFn, List.sum_ofFn, Function.comp_def] using he end end Source29RootEnumeration /- Component: RootFamily.inc -/ namespace Source29RootEnumeration open Polynomial Filter open scoped BigOperators Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] /-- The root labels can be chosen arbitrarily pointwise. Their first two power sums are nevertheless analytic because they are coefficient expressions. -/ theorem exists_analytic_power_sum_root_family (W : E → Polynomial ℂ) (a : E) (s : ℕ) (hs : 0 < s) (ha : W a = X ^ s) (hmonic : ∀ x, (W x).Monic) (hdegree : ∀ x, (W x).natDegree = s) (hsplit : ∀ x, (W x).Splits) (hcoeff : ∀ i, AnalyticAt ℂ (fun x => (W x).coeff i) a) : ∃ w : E → Fin s → ℂ, (∀ x, (List.ofFn (w x) : Multiset ℂ) = (W x).roots) ∧ (∀ x i, (W x).eval (w x i) = 0) ∧ (∀ i, w a i = 0) ∧ AnalyticAt ℂ (fun x => ∑ i, w x i) a ∧ AnalyticAt ℂ (fun x => ∑ i, (w x i) ^ 2) a := by choose w hw hroot hsum hsquare using fun x => exists_root_tuple (W x) s (hmonic x) (hdegree x) hs (hsplit x) refine ⟨w, hw, hroot, ?_, ?_, ?_⟩ · intro i have hz := hroot a i rw [ha, eval_pow, eval_X] at hz exact eq_zero_of_pow_eq_zero hz · have he : (fun x => ∑ i, w x i) = fun x => -(W x).coeff (s - 1) := funext hsum rw [he] exact (hcoeff (s - 1)).neg · have he : (fun x => ∑ i, (w x i) ^ 2) = fun x => (W x).coeff (s - 1)^2 - 2 * secondUpperCoeff (W x) s := funext hsquare rw [he] have hsecond : AnalyticAt ℂ (fun x => secondUpperCoeff (W x) s) a := by by_cases htwo : 2 ≤ s · simpa only [secondUpperCoeff, if_pos htwo] using hcoeff (s - 2) · simp only [secondUpperCoeff, if_neg htwo] exact analyticAt_const exact ((hcoeff (s - 1)).pow 2).sub (analyticAt_const.mul hsecond) end end Source29RootEnumeration /- Component: SliceInitialFactor.inc -/ namespace Source29SliceInitialFactor open MvPolynomial Source29SlicePolynomial open scoped BigOperators Topology noncomputable section /-- Restriction through the origin records precisely the homogeneous pieces. -/ theorem lineSlice_zero_eq_sum {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (N : Fin n → ℂ) : lineSlice P 0 N = ∑ k ∈ Finset.range (P.totalDegree+1), Polynomial.C (eval N (homogeneousComponent k P)) * Polynomial.X^k := by apply Polynomial.funext intro t rw [eval_lineSlice] simp only [Pi.zero_apply, zero_add] conv_lhs => rw [← sum_homogeneousComponent P] simp only [map_sum, Polynomial.eval_finsetSum, Polynomial.eval_mul, Polynomial.eval_C, Polynomial.eval_pow, Polynomial.eval_X] apply Finset.sum_congr rfl intro k hk rw [Source29ProjectiveMaximum.eval_scale_of_isHomogeneous _ k (homogeneousComponent_isHomogeneous k P) N t] ring theorem coeff_lineSlice_zero {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (N : Fin n → ℂ) (k : ℕ) : (lineSlice P 0 N).coeff k = eval N (homogeneousComponent k P) := by classical rw [lineSlice_zero_eq_sum, Polynomial.finsetSum_coeff] simp only [Polynomial.coeff_C_mul_X_pow] by_cases hk : k < P.totalDegree+1 · simp [hk] · have hdeg : P.totalDegree < k := by omega simp [hk, homogeneousComponent_eq_zero k P hdeg] /-- A nonzero lowest homogeneous coefficient in direction N gives the exact power of X in the normal slice, with a nonzero constant coefficient remaining. -/ theorem exists_slice_factor_of_lowest {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (N : Fin n → ℂ) (s : ℕ) (hlow : ∀ k < s, homogeneousComponent k P = 0) (hs : eval N (homogeneousComponent s P) ≠ 0) : ∃ g : Polynomial ℂ, lineSlice P 0 N = Polynomial.X^s*g ∧ g.coeff 0 = eval N (homogeneousComponent s P) ∧ g.coeff 0 ≠ 0 ∧ s+g.natDegree ≤ P.totalDegree := by have hd : (Polynomial.X^s : Polynomial ℂ) ∣ lineSlice P 0 N := by apply Polynomial.X_pow_dvd_iff.mpr intro k hk rw [coeff_lineSlice_zero, hlow k hk, map_zero] obtain ⟨g, hg⟩ := hd have hc : g.coeff 0 = eval N (homogeneousComponent s P) := by rw [← coeff_lineSlice_zero P N s, hg] simpa only [zero_add] using (Polynomial.coeff_X_pow_mul g s 0).symm have hgc : g.coeff 0 ≠ 0 := by rw [hc] exact hs have hgn : g ≠ 0 := by intro h exact hgc (by simp [h]) have hdegree := natDegree_lineSlice_le P 0 N rw [hg, Polynomial.natDegree_mul (pow_ne_zero s Polynomial.X_ne_zero) hgn, Polynomial.natDegree_X_pow] at hdegree exact ⟨g, hg, hc, hgc, hdegree⟩ /-- In particular the initial normal-power conclusion supplies the base factorization needed by polynomial preparation. -/ theorem exists_slice_factor_of_initial_power {n : ℕ} (P L : MvPolynomial (Fin n) ℂ) (N : Fin n → ℂ) (s : ℕ) (a : ℂ) (ha : a ≠ 0) (hlow : ∀ k < s, homogeneousComponent k P = 0) (hinit : homogeneousComponent s P = C a * L^s) (hLN : eval N L ≠ 0) : ∃ g : Polynomial ℂ, lineSlice P 0 N = Polynomial.X^s*g ∧ g.coeff 0 = a*(eval N L)^s ∧ g.coeff 0 ≠ 0 ∧ s+g.natDegree ≤ P.totalDegree := by have heval : eval N (homogeneousComponent s P) = a*(eval N L)^s := by rw [hinit, map_mul, eval_C, map_pow] simpa only [heval] using exists_slice_factor_of_lowest P N s hlow (by rw [heval]; exact mul_ne_zero ha (pow_ne_zero s hLN)) /-- Applying local preparation after the initial-power calculation. The parameter map may in particular be the inclusion of the tangent hyperplane. -/ theorem preparation_of_initial_power {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] {n : ℕ} (P L : MvPolynomial (Fin n) ℂ) (N : Fin n → ℂ) (s : ℕ) (c : ℂ) (hc : c ≠ 0) (hlow : ∀ k < s, homogeneousComponent k P = 0) (hinit : homogeneousComponent s P = C c * L^s) (hLN : eval N L ≠ 0) (v : E → Fin n → ℂ) (a : E) (hv0 : v a = 0) (hv : ∀ i, AnalyticAt ℂ (fun x => v x i) a) : ∃ W B : E → Polynomial ℂ, (∀ x, (W x).Monic ∧ (W x).natDegree = s) ∧ W a = Polynomial.X^s ∧ (B a).coeff 0 = c*(eval N L)^s ∧ (∀ k, AnalyticAt ℂ (fun x => (W x).coeff k) a) ∧ (∀ k, AnalyticAt ℂ (fun x => (B x).coeff k) a) ∧ (∀ x, (B x).degree < (P.totalDegree+1 : WithBot ℕ)) ∧ (∀ᶠ y : E × ℂ in 𝓝 (a,0), (B y.1).eval y.2 ≠ 0) ∧ ∀ᶠ x in 𝓝 a, W x * B x = lineSlice P (v x) N := by obtain ⟨g, hg, hg0, hgne, hgdegree⟩ := exists_slice_factor_of_initial_power P L N s c hc hlow hinit hLN have hgr : g.natDegree ≤ P.totalDegree := by omega have hb : lineSlice P (v a) N = Polynomial.X^s*g := by simpa only [hv0] using hg obtain ⟨W, B, hW, hWa, hBa, hWana, hBana, hBdegree, hBunit, hWB⟩ := Source29SlicePreparation.lineSlice_preparation P v N a hv s P.totalDegree g hgr hgne (by omega) hb refine ⟨W, B, hW, hWa, ?_, hWana, hBana, hBdegree, hBunit, hWB⟩ rw [hBa] exact hg0 /-- The preceding preparation applies on any linear parameter subspace, in particular the kernel of the initial normal linear form. -/ theorem preparation_on_subspace {n : ℕ} (P L : MvPolynomial (Fin n) ℂ) (N : Fin n → ℂ) (s : ℕ) (c : ℂ) (hc : c ≠ 0) (hlow : ∀ k < s, homogeneousComponent k P = 0) (hinit : homogeneousComponent s P = C c * L^s) (hLN : eval N L ≠ 0) (T : Submodule ℂ (Fin n → ℂ)) : ∃ W B : T → Polynomial ℂ, (∀ x, (W x).Monic ∧ (W x).natDegree = s) ∧ W 0 = Polynomial.X^s ∧ (B 0).coeff 0 = c*(eval N L)^s ∧ (∀ k, AnalyticAt ℂ (fun x => (W x).coeff k) 0) ∧ (∀ k, AnalyticAt ℂ (fun x => (B x).coeff k) 0) ∧ (∀ x, (B x).degree < (P.totalDegree+1 : WithBot ℕ)) ∧ (∀ᶠ y : T × ℂ in 𝓝 (0,0), (B y.1).eval y.2 ≠ 0) ∧ ∀ᶠ x in 𝓝 (0 : T), W x * B x = lineSlice P (x : Fin n → ℂ) N := by apply preparation_of_initial_power P L N s c hc hlow hinit hLN (fun x : T => (x : Fin n → ℂ)) 0 (by rfl) intro i exact ((ContinuousLinearMap.proj i).comp T.subtypeL).analyticAt 0 end end Source29SliceInitialFactor /- Component: RootMaximumBridge.inc -/ /- From a local polynomial root family to the quadratic sheet bound at a normalized maximum. Tangent coordinates are represented by a linear isometry. -/ namespace Source29RootMaximumBridge open MvPolynomial Filter open scoped Topology noncomputable section abbrev CSpace (n : ℕ) := EuclideanSpace ℂ (Fin n) /-- The local polynomial root-cluster theorem applies to any choice of labels. -/ lemma root_family_clusters {E : Type*} [TopologicalSpace E] [Zero E] {ι : Type*} (W : E → Polynomial ℂ) (d : ℕ) (hW0 : W 0 = Polynomial.X^d) (hmonic : ∀ᶠ x in 𝓝 (0 : E), (W x).Monic) (hdegree : ∀ᶠ x in 𝓝 (0 : E), (W x).natDegree = d) (hcoeff : ∀ i < d, ContinuousAt (fun x => (W x).coeff i) 0) (w : E → ι → ℂ) (hroot : ∀ᶠ x in 𝓝 (0 : E), ∀ j, (W x).eval (w x j) = 0) : ∀ ε : ℝ, 0 < ε → ∀ᶠ x in 𝓝 (0 : E), ∀ j, ‖w x j‖ < ε := by intro ε hε have hcluster := Source29RootCluster.eventually_roots_norm_lt W (0 : E) d hW0 hmonic hdegree hcoeff ε hε filter_upwards [hcluster, hroot] with x hx hr j exact hx (w x j) (hr j) variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] lemma eventually_displacement_small {n : ℕ} {ι : Type*} (T : E →ₗᵢ[ℂ] CSpace n) (N : CSpace n) (w : E → ι → ℂ) (hcluster : ∀ ε : ℝ, 0 < ε → ∀ᶠ x in 𝓝 (0 : E), ∀ j, ‖w x j‖ < ε) (r : ℝ) (hr : 0 < r) : ∀ᶠ x in 𝓝 (0 : E), ∀ j, ‖T x + w x j • N‖ < r := by let δ : ℝ := r / (2 * (‖N‖ + 1)) have hδ : 0 < δ := by dsimp [δ]; positivity have hsmall : ∀ᶠ x in 𝓝 (0 : E), ‖x‖ < r / 2 := by filter_upwards [Metric.ball_mem_nhds (0 : E) (half_pos hr)] with x hx simpa only [Metric.mem_ball, dist_zero_right] using hx filter_upwards [hsmall, hcluster δ hδ] with x hx hw j have hprod := mul_lt_mul_of_pos_right (hw j) (by positivity : 0 < ‖N‖ + 1) have hδeq : δ * (‖N‖ + 1) = r / 2 := by dsimp [δ] field_simp rw [hδeq] at hprod have htri := norm_add_le (T x) (w x j • N) rw [T.norm_map, norm_smul] at htri nlinarith [norm_nonneg (w x j)] /-- Uniform clustering brings every root into the small-slope neighborhood. -/ theorem eventually_small_slope {n : ℕ} {ι : Type*} (P : MvPolynomial (Fin n) ℂ) (s : ℕ) (hs : s ≤ P.totalDegree) (hlow : ∀ k < s, homogeneousComponent k P = 0) (L : CSpace n →L[ℂ] ℂ) (hinitial : ∀ v : CSpace n, eval (fun i => v i) (homogeneousComponent s P) = 0 → L v = 0) (N : CSpace n) (hN : L N ≠ 0) (T : E →ₗᵢ[ℂ] CSpace n) (hT : ∀ x, L (T x) = 0) (w : E → ι → ℂ) (hroot : ∀ᶠ x in 𝓝 (0 : E), ∀ j, eval (fun i => (T x + w x j • N) i) P = 0) (hcluster : ∀ ε : ℝ, 0 < ε → ∀ᶠ x in 𝓝 (0 : E), ∀ j, ‖w x j‖ < ε) (ε : ℝ) (hε : 0 < ε) : ∀ᶠ x in 𝓝 (0 : E), ∀ j, ‖w x j‖ ≤ ε * ‖x‖ := by obtain ⟨r, hr, hrbound⟩ := Source29SmallSlope.exists_small_slope P s hs hlow L hinitial N hN ε hε have hsmall := eventually_displacement_small T N w hcluster r hr filter_upwards [hsmall, hroot] with x hx hzero j simpa only [T.norm_map] using hrbound (T x) (w x j) (hT x) (hx j) (hzero j) lemma normal_form_eq_dot {n : ℕ} (z v : CSpace n) (κ : ℝ) : Source29ComplexTangent.normalCLM κ z v = Source29LocalMaximumBound.dot (Source29LocalMaximumBound.normal z κ) v := by rw [Source29ComplexTangent.normalCLM_apply] simp [Source29LocalMaximumBound.dot, Source29LocalMaximumBound.normal, Source29LocalMaximumBound.conjugate] lemma normal_square_ne_zero {n : ℕ} (z : CSpace n) (κ : ℝ) (hz : ‖z‖ = 1) (hq : Source29LocalMaximumBound.quadric z = (κ : ℂ)) (hk : 0 < κ) (hk1 : κ < 1) : Source29LocalMaximumBound.dot (Source29LocalMaximumBound.normal z κ) (Source29LocalMaximumBound.normal z κ) ≠ 0 := by have hq' : Source29ComplexMaximum.bilinear (fun i => z i) (fun i => z i) = (κ : ℂ) := by simpa only [Source29ComplexMaximum.bilinear, Source29LocalMaximumBound.quadric, pow_two] using hq have hnorm : Source29ComplexMaximum.bilinear (fun i => star (z i)) (fun i => z i) = 1 := by change Source29LocalMaximumBound.dot (Source29LocalMaximumBound.conjugate z) z = 1 rw [Source29LocalMaximumBound.dot_conjugate_eq_inner, inner_self_eq_norm_sq_to_K, hz] norm_num have hsq := Source29ComplexMaximum.normal_square (fun i => z i) κ hq' hnorm have hne := Source29ComplexMaximum.normal_square_ne_zero κ hk hk1 rw [← hsq] at hne simpa [Source29ComplexMaximum.bilinear, Source29LocalMaximumBound.dot, Source29LocalMaximumBound.normal, Source29LocalMaximumBound.conjugate] using hne /-- Every sufficiently small sheet root satisfies a quadratic one-sided bound in tangent coordinates, with the explicit constant four. -/ theorem eventually_root_real_bound {n : ℕ} {ι : Type*} (P : MvPolynomial (Fin n) ℂ) (s : ℕ) (hs : s ≤ P.totalDegree) (hlow : ∀ k < s, homogeneousComponent k P = 0) (z : CSpace n) (κ : ℝ) (hz : ‖z‖ = 1) (hq : Source29LocalMaximumBound.quadric z = (κ : ℂ)) (hk : 0 < κ) (hk1 : κ < 1) (hinitial : ∀ v : CSpace n, eval (fun i => v i) (homogeneousComponent s P) = 0 → Source29ComplexTangent.normalCLM κ z v = 0) (hmaximum : ∀ δ : CSpace n, eval (fun i => δ i) P = 0 → ‖Source29LocalMaximumBound.quadric (z + δ)‖ ≤ κ * ‖z + δ‖^2) (T : E →ₗᵢ[ℂ] CSpace n) (hT : ∀ x, Source29ComplexTangent.normalCLM κ z (T x) = 0) (w : E → ι → ℂ) (hroot : ∀ᶠ x in 𝓝 (0 : E), ∀ j, eval (fun i => (T x + w x j • Source29LocalMaximumBound.normal z κ) i) P = 0) (hcluster : ∀ ε : ℝ, 0 < ε → ∀ᶠ x in 𝓝 (0 : E), ∀ j, ‖w x j‖ < ε) : ∀ᶠ x in 𝓝 (0 : E), ∀ j, (Source29LocalMaximumBound.dot (Source29LocalMaximumBound.normal z κ) (Source29LocalMaximumBound.normal z κ) * w x j).re ≤ 4 * ‖x‖^2 := by have hN : Source29ComplexTangent.normalCLM κ z (Source29LocalMaximumBound.normal z κ) ≠ 0 := by rw [normal_form_eq_dot] exact normal_square_ne_zero z κ hz hq hk hk1 have hslope := eventually_small_slope P s hs hlow (Source29ComplexTangent.normalCLM κ z) hinitial (Source29LocalMaximumBound.normal z κ) hN T hT w hroot hcluster 1 (by norm_num) filter_upwards [hslope, hroot] with x hx hzero j have hTx : Source29LocalMaximumBound.dot (Source29LocalMaximumBound.normal z κ) (T x) = 0 := by rw [← normal_form_eq_dot] exact hT x have hb := Source29LocalMaximumBound.normal_coefficient_bound_coordinates z (T x) (w x j) κ hz hq hk1.le hTx (hmaximum _ (hzero j)) rw [T.norm_map] at hb have hs := hx j simp only [one_mul] at hs have hsq := (sq_le_sq₀ (norm_nonneg (w x j)) (norm_nonneg x)).mpr hs linarith /-- The concrete geometric root-family hypotheses give a uniform quadratic bound as soon as the first two power sums are analytic. -/ theorem quadratic_root_bound {n : ℕ} {ι : Type*} [Fintype ι] (P : MvPolynomial (Fin n) ℂ) (s : ℕ) (hs : s ≤ P.totalDegree) (hlow : ∀ k < s, homogeneousComponent k P = 0) (z : CSpace n) (κ : ℝ) (hz : ‖z‖ = 1) (hq : Source29LocalMaximumBound.quadric z = (κ : ℂ)) (hk : 0 < κ) (hk1 : κ < 1) (hinitial : ∀ v : CSpace n, eval (fun i => v i) (homogeneousComponent s P) = 0 → Source29ComplexTangent.normalCLM κ z v = 0) (hmaximum : ∀ δ : CSpace n, eval (fun i => δ i) P = 0 → ‖Source29LocalMaximumBound.quadric (z + δ)‖ ≤ κ * ‖z + δ‖^2) (T : E →ₗᵢ[ℂ] CSpace n) (hT : ∀ x, Source29ComplexTangent.normalCLM κ z (T x) = 0) (w : E → ι → ℂ) (hroot : ∀ᶠ x in 𝓝 (0 : E), ∀ j, eval (fun i => (T x + w x j • Source29LocalMaximumBound.normal z κ) i) P = 0) (hcluster : ∀ ε : ℝ, 0 < ε → ∀ᶠ x in 𝓝 (0 : E), ∀ j, ‖w x j‖ < ε) (hS1 : AnalyticAt ℂ (fun x => ∑ j, w x j) 0) (hS2 : AnalyticAt ℂ (fun x => ∑ j, (w x j)^2) 0) : ∃ A : ℝ, 0 < A ∧ ∀ᶠ x in 𝓝 (0 : E), ∀ j, ‖w x j‖ ≤ A * ‖x‖^2 := by have hzero : ∀ j, w 0 j = 0 := by intro j by_contra hj have hp : 0 < ‖w 0 j‖ := norm_pos_iff.mpr hj have hbad := (hcluster _ hp).self_of_nhds j exact (lt_irrefl _) hbad have hreal := eventually_root_real_bound P s hs hlow z κ hz hq hk hk1 hinitial hmaximum T hT w hroot hcluster exact Source29QuadraticSheetBound.quadratic_sheet_bound_scaled w hzero hS1 hS2 (Source29LocalMaximumBound.dot (Source29LocalMaximumBound.normal z κ) (Source29LocalMaximumBound.normal z κ)) (normal_square_ne_zero z κ hz hq hk hk1) 4 hreal end end Source29RootMaximumBridge /- Component: LocalQuadraticPreparation.inc -/ /- The analytic preparation and the geometric maximum estimates are assembled here without assuming any regularity of the individual root labels. -/ namespace Source29LocalQuadratic open MvPolynomial Filter open scoped Topology BigOperators noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] {n : ℕ} abbrev CSpace (n : ℕ) := EuclideanSpace ℂ (Fin n) structure PreparedRoots (P : MvPolynomial (Fin n) ℂ) (T : E →ₗᵢ[ℂ] CSpace n) (N : CSpace n) where s : ℕ s_pos : 0 < s W : E → Polynomial ℂ B : E → Polynomial ℂ roots : E → Fin s → ℂ monic_degree : ∀ x, (W x).Monic ∧ (W x).natDegree = s base : W 0 = Polynomial.X^s coefficients_analytic : ∀ k, AnalyticAt ℂ (fun x => (W x).coeff k) 0 unit_coefficients_analytic : ∀ k, AnalyticAt ℂ (fun x => (B x).coeff k) 0 unit_degree : ∀ x, (B x).degree < (P.totalDegree+1 : WithBot ℕ) unit_nonzero : ∀ᶠ y : E × ℂ in 𝓝 (0,0), (B y.1).eval y.2 ≠ 0 factorization : ∀ᶠ x in 𝓝 (0 : E), W x * B x = Source29SlicePolynomial.lineSlice P (fun i => T x i) (fun i => N i) root_multiset : ∀ x, (List.ofFn (roots x) : Multiset ℂ) = (W x).roots root_polynomial : ∀ x j, (W x).eval (roots x j) = 0 root_original : ∀ᶠ x in 𝓝 (0 : E), ∀ j, eval (fun i => (T x + roots x j • N) i) P = 0 base_roots : ∀ j, roots 0 j = 0 sum_analytic : AnalyticAt ℂ (fun x => ∑ j, roots x j) 0 sum_squares_analytic : AnalyticAt ℂ (fun x => ∑ j, (roots x j)^2) 0 quadratic_bound : ∃ A : ℝ, 0 < A ∧ ∀ᶠ x in 𝓝 (0 : E), ∀ j, ‖roots x j‖ ≤ A * ‖x‖^2 /-- At a possibly singular normalized maximum, preparation and a uniform quadratic bound hold on any isometrically parameterized tangent subspace. -/ theorem exists_prepared_roots_at_maximum (h : MvPolynomial (Fin n) ℂ) (hne : h ≠ 0) (z : CSpace n) (hzero : eval (fun i => z i) h = 0) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hzunit : ‖z‖ = 1) (hzq : (∑ i : Fin n, (z i)^2) = (κ : ℂ)) (hbound : ∀ v : CSpace n, eval (fun i => v i) h = 0 → Source29ProjectiveMaximum.quadricNorm v ≤ κ * ‖v‖^2) (T : E →ₗᵢ[ℂ] CSpace n) (hT : ∀ x, Source29ComplexTangent.normalCLM κ z (T x) = 0) : Nonempty (PreparedRoots (Source29PolynomialTranslation.translate h (fun i => z i)) T (Source29LocalMaximumBound.normal z κ)) := by letI : IsAlgClosed ℂ := Source29FTA.complex_isAlgClosed let P := Source29PolynomialTranslation.translate h (fun i => z i) let N := Source29LocalMaximumBound.normal z κ let L := Source29LinearForm.linearForm (fun i => z i - (κ : ℂ) * star (z i)) obtain ⟨s, a, hs, hsdegree, ha, hlow, hinit⟩ := Source29InitialNormalPower.exists_normal_power_initial h hne z hzero κ hk hk1 hzunit hzq hbound have hLeval (v : CSpace n) : eval (fun i => v i) L = Source29ComplexTangent.normalCLM κ z v := by rw [Source29ComplexTangent.normalCLM_apply] exact Source29LinearForm.eval_linearForm _ _ have hLN : eval (fun i => N i) L ≠ 0 := by rw [hLeval, Source29RootMaximumBridge.normal_form_eq_dot] exact Source29RootMaximumBridge.normal_square_ne_zero z κ hzunit hzq hk hk1 have hv : ∀ i, AnalyticAt ℂ (fun x : E => T x i) 0 := by intro i exact ((EuclideanSpace.proj i).comp T.toContinuousLinearMap).analyticAt 0 obtain ⟨W, B, hW, hW0, hB0, hWa, hBa, hBd, hBu, hWB⟩ := Source29SliceInitialFactor.preparation_of_initial_power P L (fun i => N i) s a ha hlow hinit hLN (fun x : E => fun i => T x i) 0 (by ext i; simp) hv obtain ⟨w, hwtuple, hwroot, hw0, hw1, hw2⟩ := Source29RootEnumeration.exists_analytic_power_sum_root_family W (0 : E) s hs hW0 (fun x => (hW x).1) (fun x => (hW x).2) (fun x => IsAlgClosed.splits _) hWa have hroot : ∀ᶠ x in 𝓝 (0 : E), ∀ j, eval (fun i => (T x + w x j • N) i) P = 0 := by filter_upwards [hWB] with x hx j have he := congrArg (fun p : Polynomial ℂ => p.eval (w x j)) hx rw [Polynomial.eval_mul, hwroot x j, zero_mul, Source29SlicePolynomial.eval_lineSlice] at he exact he.symm have hcluster := Source29RootMaximumBridge.root_family_clusters W s hW0 (Filter.Eventually.of_forall fun x => (hW x).1) (Filter.Eventually.of_forall fun x => (hW x).2) (fun i _ => (hWa i).continuousAt) w (Filter.Eventually.of_forall hwroot) have hinitial : ∀ v : CSpace n, eval (fun i => v i) (homogeneousComponent s P) = 0 → Source29ComplexTangent.normalCLM κ z v = 0 := by intro v hvzero change homogeneousComponent s P = C a * L^s at hinit rw [hinit, map_mul, eval_C, map_pow, hLeval] at hvzero exact eq_zero_of_pow_eq_zero ((mul_eq_zero.mp hvzero).resolve_left ha) have hmaximum : ∀ δ : CSpace n, eval (fun i => δ i) P = 0 → ‖Source29LocalMaximumBound.quadric (z + δ)‖ ≤ κ * ‖z + δ‖^2 := by intro δ hδ apply hbound (z + δ) exact (Source29PolynomialTranslation.eval_translate h (fun i => z i) (fun i => δ i)).symm.trans hδ have hquad := Source29RootMaximumBridge.quadratic_root_bound P s hsdegree hlow z κ hzunit hzq hk hk1 hinitial hmaximum T hT w hroot hcluster hw1 hw2 exact ⟨{ s := s, s_pos := hs, W := W, B := B, roots := w, monic_degree := hW, base := hW0, coefficients_analytic := hWa, unit_coefficients_analytic := hBa, unit_degree := hBd, unit_nonzero := hBu, factorization := hWB, root_multiset := hwtuple, root_polynomial := hwroot, root_original := hroot, base_roots := hw0, sum_analytic := hw1, sum_squares_analytic := hw2, quadratic_bound := hquad }⟩ end end Source29LocalQuadratic /- Component: AnalyticMaximum.inc -/ /- Scalar maximum principles derived from the finite-order phase argument. This avoids adding complex integration to the challenge import closure. -/ namespace Source29AnalyticMaximum open Filter open scoped Topology noncomputable section theorem eventually_zero_of_re_nonpos (f : ℂ → ℂ) (hf : AnalyticAt ℂ f 0) (hf0 : f 0 = 0) (hbound : ∀ᶠ z in 𝓝 (0 : ℂ), (f z).re ≤ 0) : ∀ᶠ z in 𝓝 (0 : ℂ), f z = 0 := by by_contra hnot obtain ⟨d, g, hg, hg0, hfactor⟩ := hf.exists_eventuallyEq_pow_smul_nonzero_iff.mpr hnot have hfactor' : ∀ᶠ z in 𝓝 (0 : ℂ), f z = z ^ d * g z := by simpa only [sub_zero, smul_eq_mul] using hfactor have hd : 0 < d := by by_contra hnotd have hd0 : d = 0 := by omega have h0 := hfactor'.self_of_nhds rw [hd0, pow_zero, one_mul, hf0] at h0 exact hg0 h0.symm have hgbound : ∀ᶠ z in 𝓝 (0 : ℂ), (z ^ d * g z).re ≤ (0 : ℝ) * ‖z‖ ^ (d + 1) := by filter_upwards [hfactor', hbound] with z hz hb simpa only [hz, zero_mul] using hb have himpossible := Source29OneSidedOrder.order_ge_of_one_sided_bound g hg.continuousAt hg0 d (d + 1) hd 0 hgbound omega theorem eventually_constant_of_norm_max_zero (f : ℂ → ℂ) (hf : AnalyticAt ℂ f 0) (hbound : ∀ᶠ z in 𝓝 (0 : ℂ), ‖f z‖ ≤ ‖f 0‖) : ∀ᶠ z in 𝓝 (0 : ℂ), f z = f 0 := by by_cases hf0 : f 0 = 0 · filter_upwards [hbound] with z hz simpa only [hf0, norm_zero, norm_le_zero_iff] using hz let F : ℂ → ℂ := fun z => star (f 0) * (f z - f 0) have hF : AnalyticAt ℂ F 0 := analyticAt_const.mul (hf.sub analyticAt_const) have hF0 : F 0 = 0 := by simp [F] have hFbound : ∀ᶠ z in 𝓝 (0 : ℂ), (F z).re ≤ 0 := by filter_upwards [hbound] with z hz have hr := Complex.re_le_norm (star (f 0) * f z) have hn := mul_le_mul_of_nonneg_left hz (norm_nonneg (f 0)) have hsq : (star (f 0) * f 0).re = ‖f 0‖ ^ 2 := by simp [Complex.mul_re, Complex.sq_norm, Complex.normSq_apply] rw [norm_mul, norm_star] at hr change (star (f 0) * (f z - f 0)).re ≤ 0 rw [mul_sub, Complex.sub_re, hsq] nlinarith have hzero := eventually_zero_of_re_nonpos F hF hF0 hFbound filter_upwards [hzero] with z hz change star (f 0) * (f z - f 0) = 0 at hz have hn : star (f 0) ≠ 0 := by simpa using hf0 exact sub_eq_zero.mp ((mul_eq_zero.mp hz).resolve_left hn) /-- Scalar analytic maximum modulus principle, in its local form. -/ theorem eventually_constant_of_norm_max (f : ℂ → ℂ) (c : ℂ) (hf : AnalyticAt ℂ f c) (hbound : ∀ᶠ z in 𝓝 c, ‖f z‖ ≤ ‖f c‖) : ∀ᶠ z in 𝓝 c, f z = f c := by let F : ℂ → ℂ := fun z => f (c + z) have hF : AnalyticAt ℂ F 0 := by have hg : AnalyticAt ℂ (fun z : ℂ => c + z) 0 := analyticAt_const.add analyticAt_id have hf' : AnalyticAt ℂ f ((fun z : ℂ => c + z) 0) := by simpa using hf exact hf'.comp hg have hpath : Tendsto (fun z : ℂ => c + z) (𝓝 0) (𝓝 c) := by simpa using tendsto_const_nhds.add (tendsto_id (x := (𝓝 (0 : ℂ)))) have hFbound : ∀ᶠ z in 𝓝 (0 : ℂ), ‖F z‖ ≤ ‖F 0‖ := by simpa only [F, add_zero] using hpath.eventually hbound have hFconstant := eventually_constant_of_norm_max_zero F hF hFbound have hback : Tendsto (fun z : ℂ => z - c) (𝓝 c) (𝓝 0) := by simpa using (tendsto_id (x := 𝓝 c)).sub (tendsto_const_nhds : Tendsto (fun _ : ℂ => c) (𝓝 c) (𝓝 c)) simpa only [F, add_sub_cancel, add_zero] using hback.eventually hFconstant end end Source29AnalyticMaximum /- Component: AnalyticDerivativeBounds.inc -/ /- Maximum and derivative bounds obtained from the local analytic maximum principle, the identity theorem, and removable divided differences. No complex integration theorem is required. -/ namespace Source29AnalyticDerivativeBounds open Filter Set open scoped Topology noncomputable section /-- The scalar maximum modulus principle on a closed complex ball. -/ theorem norm_le_of_sphere_bound (f : ℂ → ℂ) (c : ℂ) (R M : ℝ) (hR : 0 < R) (hf : AnalyticOnNhd ℂ f (Metric.closedBall c R)) (hbound : ∀ z ∈ Metric.sphere c R, ‖f z‖ ≤ M) : ∀ z ∈ Metric.closedBall c R, ‖f z‖ ≤ M := by obtain ⟨z, hz, hmax⟩ := (isCompact_closedBall c R).exists_isMaxOn ⟨c, Metric.mem_closedBall_self hR.le⟩ hf.continuousOn.norm have hzM : ‖f z‖ ≤ M := by by_cases hze : dist z c = R · exact hbound z hze have hzi : z ∈ Metric.ball c R := lt_of_le_of_ne (show dist z c ≤ R from hz) hze have hlocal : ∀ᶠ w in 𝓝 z, ‖f w‖ ≤ ‖f z‖ := by filter_upwards [Metric.isOpen_ball.mem_nhds hzi] with w hw exact hmax (Metric.ball_subset_closedBall hw) have he := Source29AnalyticMaximum.eventually_constant_of_norm_max f z (hf z hz) hlocal have hall : EqOn f (fun _ => f z) (Metric.closedBall c R) := hf.eqOn_of_preconnected_of_eventuallyEq (fun _ _ => analyticAt_const) (convex_closedBall c R).isPreconnected hz he have hb : c + (R : ℂ) ∈ Metric.sphere c R := by simp [Metric.mem_sphere, dist_eq_norm, hR.le] calc ‖f z‖ = ‖f (c + (R : ℂ))‖ := congrArg norm (hall (Metric.sphere_subset_closedBall hb)).symm _ ≤ M := hbound _ hb intro w hw exact (hmax hw).trans hzM /-- A divided difference is analytic at its removable central singularity and at every other point where the original function is analytic. -/ theorem analyticAt_dslope (f : ℂ → ℂ) (c z : ℂ) (hf : AnalyticAt ℂ f z) : AnalyticAt ℂ (dslope f c) z := by by_cases hzc : z = c · subst z obtain ⟨p, hp⟩ := hf exact hp.has_fpower_series_dslope_fslope.analyticAt · have hq : AnalyticAt ℂ (fun w => (f w - f c) / (w - c)) z := (hf.sub analyticAt_const).div (analyticAt_id.sub analyticAt_const) (sub_ne_zero.mpr hzc) apply hq.congr filter_upwards [eventually_ne_nhds hzc] with w hw rw [dslope_of_ne f hw, slope_def_module, smul_eq_mul] ring /-- Schwarz's divided-difference estimate, stated using the oscillation from the centre on the boundary. -/ theorem norm_deriv_le_of_sphere_oscillation (f : ℂ → ℂ) (c : ℂ) (R B : ℝ) (hR : 0 < R) (hf : AnalyticOnNhd ℂ f (Metric.closedBall c R)) (hbound : ∀ z ∈ Metric.sphere c R, ‖f z - f c‖ ≤ B) : ‖deriv f c‖ ≤ B / R := by have hg : AnalyticOnNhd ℂ (dslope f c) (Metric.closedBall c R) := fun z hz => analyticAt_dslope f c z (hf z hz) have hb : ∀ z ∈ Metric.sphere c R, ‖dslope f c z‖ ≤ B / R := by intro z hz have hdist : dist z c = R := hz have hne : z ≠ c := by intro he subst z simp only [dist_self] at hdist linarith rw [dslope_of_ne f hne, slope_def_module, norm_smul, norm_inv, ← dist_eq_norm, hdist, mul_comm] exact div_le_div_of_nonneg_right (hbound z hz) hR.le simpa only [dslope_same] using norm_le_of_sphere_bound (dslope f c) c R (B / R) hR hg hb c (Metric.mem_closedBall_self hR.le) /-- A convenient derivative bound from a uniform bound on a closed ball. -/ theorem norm_deriv_le_of_sphere_bound (f : ℂ → ℂ) (c : ℂ) (R M : ℝ) (hR : 0 < R) (hf : AnalyticOnNhd ℂ f (Metric.closedBall c R)) (hbound : ∀ z ∈ Metric.sphere c R, ‖f z‖ ≤ M) : ‖deriv f c‖ ≤ 2 * M / R := by apply norm_deriv_le_of_sphere_oscillation f c R (2 * M) hR hf have hc := norm_le_of_sphere_bound f c R M hR hf hbound c (Metric.mem_closedBall_self hR.le) intro z hz calc ‖f z - f c‖ ≤ ‖f z‖ + ‖f c‖ := norm_sub_le _ _ _ ≤ 2 * M := by linarith [hbound z hz] end end Source29AnalyticDerivativeBounds /- Component: AnalyticHigherBounds.inc -/ namespace Source29AnalyticDerivativeBounds open Filter Set open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] /-- Scalar restriction to a complex line gives a directional derivative bound. The direction need only have norm at most one. -/ theorem norm_fderiv_apply_le (f : E → ℂ) (c : E) (R M : ℝ) (hR : 0 < R) (hf : AnalyticOnNhd ℂ f (Metric.closedBall c R)) (hbound : ∀ x ∈ Metric.closedBall c R, ‖f x‖ ≤ M) (v : E) (hv : ‖v‖ ≤ 1) : ‖fderiv ℂ f c v‖ ≤ 2 * M / R := by let g : ℂ → ℂ := fun z => f (c + z • v) have hmap : ∀ z ∈ Metric.closedBall (0 : ℂ) R, c + z • v ∈ Metric.closedBall c R := by intro z hz change dist (c + z • v) c ≤ R rw [dist_eq_norm, add_sub_cancel_left, norm_smul] calc ‖z‖ * ‖v‖ ≤ ‖z‖ * 1 := mul_le_mul_of_nonneg_left hv (norm_nonneg z) _ ≤ R := by simpa only [mul_one, Metric.mem_closedBall, dist_zero_right] using hz have hg : AnalyticOnNhd ℂ g (Metric.closedBall (0 : ℂ) R) := by intro z hz have hc : AnalyticAt ℂ (fun _ : ℂ => c) z := analyticAt_const have hi : AnalyticAt ℂ (fun a : ℂ => a) z := analyticAt_id have hv' : AnalyticAt ℂ (fun _ : ℂ => v) z := analyticAt_const have hp : AnalyticAt ℂ (fun a : ℂ => c + a • v) z := by convert! hc.add (hi.smul hv') using 1 exact AnalyticAt.comp (f := fun a : ℂ => c + a • v) (g := f) (hf _ (hmap z hz)) hp have hgb : ∀ z ∈ Metric.sphere (0 : ℂ) R, ‖g z‖ ≤ M := by intro z hz exact hbound _ (hmap z (Metric.sphere_subset_closedBall hz)) have hpath : HasDerivAt (fun z : ℂ => c + z • v) v 0 := by convert! ((hasDerivAt_id (0 : ℂ)).smul_const v).const_add c using 1 <;> simp have hcomp : HasDerivAt g (fderiv ℂ f c v) 0 := by have hd := (hf c (Metric.mem_closedBall_self hR.le)).differentiableAt.hasFDerivAt have hd' : HasFDerivAt f (fderiv ℂ f c) (c + (0 : ℂ) • v) := by simpa only [zero_smul, add_zero] using hd convert! hd'.comp_hasDerivAt 0 hpath using 1 rw [← hcomp.deriv] exact norm_deriv_le_of_sphere_bound g 0 R M hR hg hgb /-- Applying the first estimate to a directional derivative on a half-radius ball bounds every mixed second directional derivative. -/ theorem norm_second_fderiv_apply_le (f : E → ℂ) (c : E) (R M : ℝ) (hR : 0 < R) (hf : AnalyticOnNhd ℂ f (Metric.closedBall c R)) (hbound : ∀ x ∈ Metric.closedBall c R, ‖f x‖ ≤ M) (u v : E) (hu : ‖u‖ ≤ 1) (hv : ‖v‖ ≤ 1) : ‖fderiv ℂ (fun x => fderiv ℂ f x v) c u‖ ≤ 16 * M / R ^ 2 := by have hhalf : 0 < R / 2 := half_pos hR have hsub : ∀ z ∈ Metric.closedBall c (R / 2), Metric.closedBall z (R / 2) ⊆ Metric.closedBall c R := by intro z hz x hx change dist x c ≤ R have h1 : dist x z ≤ R / 2 := hx have h2 : dist z c ≤ R / 2 := hz linarith [dist_triangle x z c] have hcenter : Metric.closedBall c (R / 2) ⊆ Metric.closedBall c R := by intro z hz have hh : dist z c ≤ R / 2 := hz change dist z c ≤ R linarith let g : E → ℂ := fun x => fderiv ℂ f x v have hg : AnalyticOnNhd ℂ g (Metric.closedBall c (R / 2)) := by intro x hx have he : AnalyticAt ℂ (fun L : E →L[ℂ] ℂ => L v) (fderiv ℂ f x) := (ContinuousLinearMap.apply ℂ ℂ v).analyticAt _ exact AnalyticAt.comp (f := fderiv ℂ f) (g := fun L : E →L[ℂ] ℂ => L v) he (hf x (hcenter hx)).fderiv have hgb : ∀ x ∈ Metric.closedBall c (R / 2), ‖g x‖ ≤ 4 * M / R := by intro x hx have hh := norm_fderiv_apply_le f x (R / 2) M hhalf (hf.mono (hsub x hx)) (fun z hz => hbound z (hsub x hx hz)) v hv convert hh using 1 <;> ring have hh := norm_fderiv_apply_le g c (R / 2) (4 * M / R) hhalf hg hgb u hu convert hh using 1 <;> ring /-- The scalar second derivative is a special case of the mixed bound. -/ theorem norm_deriv_deriv_le (f : ℂ → ℂ) (c : ℂ) (R M : ℝ) (hR : 0 < R) (hf : AnalyticOnNhd ℂ f (Metric.closedBall c R)) (hbound : ∀ x ∈ Metric.closedBall c R, ‖f x‖ ≤ M) : ‖deriv (deriv f) c‖ ≤ 16 * M / R ^ 2 := by convert! norm_second_fderiv_apply_le f c R M hR hf hbound (1 : ℂ) 1 (by simp) (by simp) using 1 end end Source29AnalyticDerivativeBounds /- Component: AnalyticScaledBounds.inc -/ namespace Source29AnalyticDerivativeBounds open Filter Set open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] /-- The mixed bound also applies directly to the iterated Fréchet derivative. -/ theorem norm_iterated_fderiv_apply_le (f : E → ℂ) (c : E) (R M : ℝ) (hR : 0 < R) (hf : AnalyticOnNhd ℂ f (Metric.closedBall c R)) (hbound : ∀ x ∈ Metric.closedBall c R, ‖f x‖ ≤ M) (u v : E) (hu : ‖u‖ ≤ 1) (hv : ‖v‖ ≤ 1) : ‖fderiv ℂ (fderiv ℂ f) c u v‖ ≤ 16 * M / R ^ 2 := by have hd := (hf c (Metric.mem_closedBall_self hR.le)).fderiv.differentiableAt.hasFDerivAt have heval := (ContinuousLinearMap.apply ℂ ℂ v).hasFDerivAt.comp c hd have heq : fderiv ℂ (fun x => fderiv ℂ f x v) c u = fderiv ℂ (fderiv ℂ f) c u v := by exact congrArg (fun L : E →L[ℂ] ℂ => L u) heval.fderiv rw [← heq] exact norm_second_fderiv_apply_le f c R M hR hf hbound u v hu hv /-- A quadratic bound on a ball whose radius is linear in a positive scale implies linear first derivative bounds and bounded second derivatives. -/ theorem directional_bounds_scaled_ball (f : E → ℂ) (c : E) (ε M t : ℝ) (hε : 0 < ε) (ht : 0 < t) (hf : AnalyticOnNhd ℂ f (Metric.closedBall c (ε * t))) (hbound : ∀ x ∈ Metric.closedBall c (ε * t), ‖f x‖ ≤ M * t ^ 2) (u v : E) (hu : ‖u‖ ≤ 1) (hv : ‖v‖ ≤ 1) : ‖fderiv ℂ f c u‖ ≤ (2 * M / ε) * t ∧ ‖fderiv ℂ (fderiv ℂ f) c u v‖ ≤ 16 * M / ε ^ 2 := by have hR : 0 < ε * t := mul_pos hε ht constructor · have hh := norm_fderiv_apply_le f c (ε * t) (M * t ^ 2) hR hf hbound u hu have he : 2 * (M * t ^ 2) / (ε * t) = (2 * M / ε) * t := by field_simp [hε.ne', ht.ne'] <;> ring rwa [he] at hh · have hh := norm_iterated_fderiv_apply_le f c (ε * t) (M * t ^ 2) hR hf hbound u v hu hv have he : 16 * (M * t ^ 2) / (ε * t) ^ 2 = 16 * M / ε ^ 2 := by field_simp [hε.ne', ht.ne'] <;> ring rwa [he] at hh end end Source29AnalyticDerivativeBounds /- Component: AnalyticFamilyBounds.inc -/ namespace Source29AnalyticDerivativeBounds open Filter Set open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] variable {α : Type*} {l : Filter α} /-- No regularity of the root labels in the external scale parameter is needed: analyticity on each shrinking ball and a common quadratic bound suffice. -/ theorem scaled_family_derivative_limits (f : α → E → ℂ) (c : α → E) (scale : α → ℝ) (ε M : ℝ) (hε : 0 < ε) (hscale : Tendsto scale l (𝓝 0)) (hpos : ∀ᶠ a in l, 0 < scale a) (hf : ∀ᶠ a in l, AnalyticOnNhd ℂ (f a) (Metric.closedBall (c a) (ε * scale a))) (hbound : ∀ᶠ a in l, ∀ x ∈ Metric.closedBall (c a) (ε * scale a), ‖f a x‖ ≤ M * scale a ^ 2) (u v : E) (hu : ‖u‖ ≤ 1) (hv : ‖v‖ ≤ 1) : Tendsto (fun a => fderiv ℂ (f a) (c a) u) l (𝓝 0) ∧ ∀ᶠ a in l, ‖fderiv ℂ (fderiv ℂ (f a)) (c a) u v‖ ≤ 16 * M / ε ^ 2 := by have hb : ∀ᶠ a in l, ‖fderiv ℂ (f a) (c a) u‖ ≤ (2 * M / ε) * scale a ∧ ‖fderiv ℂ (fderiv ℂ (f a)) (c a) u v‖ ≤ 16 * M / ε ^ 2 := by filter_upwards [hpos, hf, hbound] with a ha hfa hba exact directional_bounds_scaled_ball (f a) (c a) ε M (scale a) hε ha hfa hba u v hu hv constructor · apply squeeze_zero_norm' (hb.mono fun _ ha => ha.1) simpa using (tendsto_const_nhds (x := 2 * M / ε) (f := l)).mul hscale · exact hb.mono fun _ ha => ha.2 end end Source29AnalyticDerivativeBounds /- Component: GraphTraceLimit.inc -/ /- Passing from the graph PDE to the trace limit uses only a vanishing first derivative and bounded second derivatives. -/ namespace Source29GraphTraceLimit open Filter Source29MetricJet open scoped Topology BigOperators noncomputable section variable {α ι : Type*} [Fintype ι] {l : Filter α} lemma bounded_mul_tendsto_zero (a b : α → ℂ) (C : ℝ) (ha : ∀ᶠ x in l, ‖a x‖ ≤ C) (hb : Tendsto b l (𝓝 0)) : Tendsto (fun x => a x * b x) l (𝓝 0) := by have hbound : ∀ᶠ x in l, ‖a x * b x‖ ≤ C * ‖b x‖ := by filter_upwards [ha] with x hx rw [norm_mul] exact mul_le_mul_of_nonneg_right hx (norm_nonneg _) apply squeeze_zero_norm' hbound simpa using (tendsto_const_nhds (x := C) (f := l)).mul hb.norm lemma metricPair_tendsto_zero (M : ι → ι → ℂ) (g : α → ι → ℂ) (hg : ∀ i, Tendsto (fun x => g x i) l (𝓝 0)) : Tendsto (fun x => metricPair M (g x) (g x)) l (𝓝 0) := by unfold metricPair have ht (i j : ι) : Tendsto (fun x => M i j * g x i * g x j) l (𝓝 0) := by simpa using ((tendsto_const_nhds (x := M i j) (f := l)).mul (hg i)).mul (hg j) simpa using tendsto_finsetSum Finset.univ (fun i _ => tendsto_finsetSum Finset.univ (fun j _ => ht i j)) lemma raiseIndex_tendsto_zero (M : ι → ι → ℂ) (g : α → ι → ℂ) (hg : ∀ i, Tendsto (fun x => g x i) l (𝓝 0)) (i : ι) : Tendsto (fun x => raiseIndex M (g x) i) l (𝓝 0) := by unfold raiseIndex simpa using tendsto_finsetSum Finset.univ (fun j _ => tendsto_const_nhds.mul (hg j)) lemma bounded_contract_tendsto_zero (H : α → ι → ι → ℂ) (v : α → ι → ℂ) (hH : ∀ i j, ∃ C : ℝ, ∀ᶠ x in l, ‖H x i j‖ ≤ C) (hv : ∀ i, Tendsto (fun x => v x i) l (𝓝 0)) : Tendsto (fun x => contract (H x) (v x) (v x)) l (𝓝 0) := by have ht (i j : ι) : Tendsto (fun x => H x i j * v x i * v x j) l (𝓝 0) := by obtain ⟨C, hC⟩ := hH i j have hh := bounded_mul_tendsto_zero (fun x => H x i j) (fun x => v x i * v x j) C hC (by simpa using (hv i).mul (hv j)) simpa only [mul_assoc] using hh simpa only [contract, Finset.sum_const_zero] using tendsto_finsetSum Finset.univ (fun i _ => tendsto_finsetSum Finset.univ (fun j _ => ht i j)) lemma vanishing_mul_metricTrace (M : ι → ι → ℂ) (H : α → ι → ι → ℂ) (a : α → ℂ) (ha : Tendsto a l (𝓝 0)) (hH : ∀ i j, ∃ C : ℝ, ∀ᶠ x in l, ‖H x i j‖ ≤ C) : Tendsto (fun x => a x * metricTrace M (H x)) l (𝓝 0) := by have ht (i j : ι) : Tendsto (fun x => a x * (M i j * H x i j)) l (𝓝 0) := by obtain ⟨C, hC⟩ := hH i j have hh := bounded_mul_tendsto_zero (fun x => H x i j) (fun x => a x * M i j) C hC (by simpa using ha.mul tendsto_const_nhds) convert hh using 1 <;> ext x <;> ring simpa only [metricTrace, Finset.mul_sum, Finset.sum_const_zero] using tendsto_finsetSum Finset.univ (fun i _ => tendsto_finsetSum Finset.univ (fun j _ => ht i j)) /-- The graph PDE forces its metric trace to vanish in the limit, even when the individual Hessian entries have no limit. -/ theorem metricTrace_tendsto_zero (M : ι → ι → ℂ) (c : ℂ) (g : α → ι → ℂ) (H : α → ι → ι → ℂ) (hg : ∀ i, Tendsto (fun x => g x i) l (𝓝 0)) (hH : ∀ i j, ∃ C : ℝ, ∀ᶠ x in l, ‖H x i j‖ ≤ C) (hPDE : ∀ᶠ x in l, (1+c*metricPair M (g x) (g x))*metricTrace M (H x) - c*contract (H x) (raiseIndex M (g x)) (raiseIndex M (g x)) = 0) : Tendsto (fun x => metricTrace M (H x)) l (𝓝 0) := by have hA := metricPair_tendsto_zero M g hg have hB := bounded_contract_tendsto_zero H (fun x => raiseIndex M (g x)) hH (raiseIndex_tendsto_zero M g hg) have hAT := vanishing_mul_metricTrace M H _ hA hH have ht : Tendsto (fun x => c*contract (H x) (raiseIndex M (g x)) (raiseIndex M (g x)) - c*(metricPair M (g x) (g x)*metricTrace M (H x))) l (𝓝 0) := by simpa using (tendsto_const_nhds.mul hB).sub (tendsto_const_nhds.mul hAT) apply ht.congr' filter_upwards [hPDE] with x hx linear_combination -hx /-- A continuous trace of a finite sheet mean is zero at the limiting point once each sheet satisfies the PDE and derivative bounds. -/ theorem sum_trace_limit_eq_zero {σ : Type*} [Fintype σ] [NeBot l] (M : ι → ι → ℂ) (c : ℂ) (g : σ → α → ι → ℂ) (H : σ → α → ι → ι → ℂ) (hg : ∀ j i, Tendsto (fun x => g j x i) l (𝓝 0)) (hH : ∀ j i k, ∃ C : ℝ, ∀ᶠ x in l, ‖H j x i k‖ ≤ C) (hPDE : ∀ j, ∀ᶠ x in l, (1+c*metricPair M (g j x) (g j x))*metricTrace M (H j x) - c*contract (H j x) (raiseIndex M (g j x)) (raiseIndex M (g j x)) = 0) (L : ℂ) (hL : Tendsto (fun x => ∑ j, metricTrace M (H j x)) l (𝓝 L)) : L = 0 := by have hz : Tendsto (fun x => ∑ j, metricTrace M (H j x)) l (𝓝 0) := by simpa using tendsto_finsetSum Finset.univ (fun j _ => metricTrace_tendsto_zero M c (g j) (H j) (hg j) (hH j) (hPDE j)) exact tendsto_nhds_unique hL hz end end Source29GraphTraceLimit /- Component: WholeSliceBezout.lean -/ namespace Source29WholeSliceBezout open Polynomial noncomputable section /-- Clearing denominators of a fraction-field Bezout identity yields a nonzero constant-polynomial certificate over the coefficient domain. -/ theorem exists_nonzero_bezout_of_fraction_coprime {R : Type*} [CommRing R] [IsDomain R] (K : Type*) [Field K] [Algebra R K] [IsFractionRing R K] (p q : R[X]) (h : IsCoprime (p.map (algebraMap R K)) (q.map (algebraMap R K))) : ∃ (D : R) (A B : R[X]), D ≠ 0 ∧ A*p+B*q = C D := by obtain ⟨a,b,hab⟩ := h obtain ⟨c,hc,hca⟩ := IsLocalization.integerNormalization_spec (nonZeroDivisors R) a obtain ⟨d,hd,hdb⟩ := IsLocalization.integerNormalization_spec (nonZeroDivisors R) b let A := C d * IsLocalization.integerNormalization (nonZeroDivisors R) a let B := C c * IsLocalization.integerNormalization (nonZeroDivisors R) b refine ⟨c*d, A, B, mul_ne_zero (nonZeroDivisors.ne_zero hc) (nonZeroDivisors.ne_zero hd), ?_⟩ apply Polynomial.map_injective (algebraMap R K) (IsFractionRing.injective R K) rw [Algebra.smul_def, Polynomial.algebraMap_apply] at hca hdb simp only [A, B, Polynomial.map_add, Polynomial.map_mul, Polynomial.map_C, hca, hdb, map_mul] calc _ = C (algebraMap R K c) * C (algebraMap R K d) * (a * p.map (algebraMap R K) + b * q.map (algebraMap R K)) := by ring _ = C (algebraMap R K c) * C (algebraMap R K d) := by rw [hab, mul_one] /-- A nonconstant irreducible polynomial over a GCD domain has a nonzero coefficient-domain certificate for its polynomial and derivative. -/ theorem exists_nonzero_bezout_of_irreducible {R : Type*} [CommRing R] [IsDomain R] [IsGCDMonoid R] (K : Type*) [Field K] [CharZero K] [Algebra R K] [IsFractionRing R K] (p : R[X]) (hp : Irreducible p) (hdegree : p.natDegree ≠ 0) : ∃ (D : R) (A B : R[X]), D ≠ 0 ∧ A*p+B*p.derivative = C D := by have hpK : Irreducible (p.map (algebraMap R K)) := (hp.isPrimitive hdegree).irreducible_iff_irreducible_map_fraction_map.mp hp apply exists_nonzero_bezout_of_fraction_coprime K p p.derivative simpa only [Polynomial.Separable, ← Polynomial.derivative_map] using hpK.separable /-- Away from the certificate's zero locus, specialization preserves separability of the whole polynomial slice. -/ theorem separable_map_of_bezout {R : Type*} [CommRing R] {F : Type*} [Field F] (p : R[X]) (D : R) (A B : R[X]) (h : A*p+B*p.derivative = C D) (f : R →+* F) (hD : f D ≠ 0) : (p.map f).Separable := by have hm := congrArg (Polynomial.map f) h simp only [Polynomial.map_add, Polynomial.map_mul, Polynomial.map_C] at hm refine ⟨C ((f D)⁻¹)*A.map f, C ((f D)⁻¹)*B.map f, ?_⟩ rw [Polynomial.derivative_map] calc _ = C ((f D)⁻¹)*(A.map f*p.map f+B.map f*p.derivative.map f) := by ring _ = 1 := by rw [hm, ← C_mul, inv_mul_cancel₀ hD, C_1] /-- Every local factor is simple wherever the whole specialized slice is certified simple; no analytic reduced-germ theorem is involved. -/ theorem separable_factor_of_bezout {R : Type*} [CommRing R] {F : Type*} [Field F] (p : R[X]) (D : R) (A B : R[X]) (h : A*p+B*p.derivative = C D) (f : R →+* F) (hD : f D ≠ 0) (W U : F[X]) (hWU : p.map f = W*U) : W.Separable := (separable_map_of_bezout p D A B h f hD).of_dvd ⟨U,hWU⟩ /-- Every root of the local factor has nonzero derivative away from the exceptional polynomial. -/ theorem factor_root_derivative_ne_zero {R : Type*} [CommRing R] {F : Type*} [Field F] (p : R[X]) (D : R) (A B : R[X]) (h : A*p+B*p.derivative = C D) (f : R →+* F) (hD : f D ≠ 0) (W U : F[X]) (hWU : p.map f = W*U) (w : F) (hw : W.eval w = 0) : W.derivative.eval w ≠ 0 := by have hs := separable_factor_of_bezout p D A B h f hD W U hWU simpa only [Polynomial.eval₂_id] using hs.eval₂_derivative_ne_zero (RingHom.id F) (by simpa only [Polynomial.eval₂_id] using hw) /-- In polynomial parameter space the exceptional certificate is itself a nonzero multivariate polynomial. -/ theorem exists_exceptional_polynomial {n : ℕ} (p : Polynomial (MvPolynomial (Fin n) ℂ)) (hp : Irreducible p) (hdegree : p.natDegree ≠ 0) : ∃ (D : MvPolynomial (Fin n) ℂ) (A B : Polynomial (MvPolynomial (Fin n) ℂ)), D ≠ 0 ∧ A*p+B*p.derivative = C D := exists_nonzero_bezout_of_irreducible (FractionRing (MvPolynomial (Fin n) ℂ)) p hp hdegree end end Source29WholeSliceBezout /- Component: AffinePolynomialChart.lean -/ namespace Source29AffinePolynomialChart open MvPolynomial open scoped BigOperators noncomputable section abbrev Vec (n : ℕ) := Fin n → ℂ abbrev Poly (n : ℕ) := MvPolynomial (Fin n) ℂ /-- Finite-variable polynomial extensionality over the complex numbers. This is the finite-variable induction underlying mathlib's MvPolynomial.Funext, whose general theorem is outside the permitted import closure. -/ theorem eq_of_eval_eq {n : ℕ} (P Q : Poly n) (h : ∀ x : Vec n, eval x P = eval x Q) : P = Q := by induction n with | zero => apply (MvPolynomial.isEmptyRingEquiv ℂ (Fin 0)).injective simpa only [isEmptyRingEquiv_eq_coeff_zero, eval_zero, constantCoeff_eq] using h 0 | succ n ih => apply (finSuccEquiv ℂ n).injective apply Polynomial.ext intro k apply ih intro x have hx : Polynomial.map (eval x) (finSuccEquiv ℂ n P) = Polynomial.map (eval x) (finSuccEquiv ℂ n Q) := by apply Polynomial.funext intro t rw [← eval_eq_eval_mv_eval', ← eval_eq_eval_mv_eval'] exact h (Fin.cons t x) simpa only [Polynomial.coeff_map] using congrArg (fun p : Polynomial ℂ => p.coeff k) hx /-- Polynomial for one coordinate of a linear transformation. -/ def linearCoordinate {n : ℕ} (A : Vec n →ₗ[ℂ] Vec n) (i : Fin n) : Poly n := ∑ j, C (A (Pi.single j 1) i) * X j theorem eval_linearCoordinate {n : ℕ} (A : Vec n →ₗ[ℂ] Vec n) (i : Fin n) (x : Vec n) : eval x (linearCoordinate A i) = A x i := by simp only [linearCoordinate, map_sum, map_mul, eval_C, eval_X] conv_rhs => rw [pi_eq_sum_univ' x] simp only [map_sum, map_smul, Finset.sum_apply, Pi.smul_apply, smul_eq_mul] apply Finset.sum_congr rfl intro j _ ring /-- Pull a polynomial back by the affine map x ↦ z+A x. -/ def affinePullback {n : ℕ} (A : Vec n →ₗ[ℂ] Vec n) (z : Vec n) : Poly n →ₐ[ℂ] Poly n := aeval (fun i => C (z i) + linearCoordinate A i) lemma affinePullback_X {n : ℕ} (A : Vec n →ₗ[ℂ] Vec n) (z : Vec n) (i : Fin n) : affinePullback A z (X i) = C (z i) + linearCoordinate A i := by simp [affinePullback] theorem eval_affinePullback {n : ℕ} (A : Vec n →ₗ[ℂ] Vec n) (z x : Vec n) (P : Poly n) : eval x (affinePullback A z P) = eval (z+A x) P := by induction P using MvPolynomial.induction_on with | C c => simp [affinePullback] | add p q hp hq => simp only [map_add, hp, hq] | mul_X p i hp => simp only [map_mul, affinePullback_X, map_add, eval_C, eval_linearCoordinate, eval_X, Pi.add_apply, hp] theorem affinePullback_inverse_left {n : ℕ} (A : Vec n ≃ₗ[ℂ] Vec n) (z : Vec n) (P : Poly n) : affinePullback A.symm.toLinearMap (-A.symm z) (affinePullback A.toLinearMap z P) = P := by apply eq_of_eval_eq intro x rw [eval_affinePullback, eval_affinePullback] simp theorem affinePullback_inverse_right {n : ℕ} (A : Vec n ≃ₗ[ℂ] Vec n) (z : Vec n) (P : Poly n) : affinePullback A.toLinearMap z (affinePullback A.symm.toLinearMap (-A.symm z) P) = P := by apply eq_of_eval_eq intro x rw [eval_affinePullback, eval_affinePullback] simp /-- Invertible affine changes of variables act by algebra equivalences. -/ def affineEquiv {n : ℕ} (A : Vec n ≃ₗ[ℂ] Vec n) (z : Vec n) : Poly n ≃ₐ[ℂ] Poly n := AlgEquiv.ofAlgHom (affinePullback A.toLinearMap z) (affinePullback A.symm.toLinearMap (-A.symm z)) (by apply DFunLike.ext; intro P; exact affinePullback_inverse_right A z P) (by apply DFunLike.ext; intro P; exact affinePullback_inverse_left A z P) lemma affineEquiv_apply {n : ℕ} (A : Vec n ≃ₗ[ℂ] Vec n) (z : Vec n) (P : Poly n) : affineEquiv A z P = affinePullback A.toLinearMap z P := rfl lemma affineEquiv_symm_apply {n : ℕ} (A : Vec n ≃ₗ[ℂ] Vec n) (z : Vec n) (P : Poly n) : (affineEquiv A z).symm P = affinePullback A.symm.toLinearMap (-A.symm z) P := rfl theorem affine_irreducible {n : ℕ} (A : Vec n ≃ₗ[ℂ] Vec n) (z : Vec n) (P : Poly n) (hP : Irreducible P) : Irreducible (affineEquiv A z P) := (MulEquiv.irreducible_iff (affineEquiv A z)).mpr hP /-- First change coordinates, then distinguish the zeroth coordinate as the univariate polynomial variable. There remain n parameter variables. -/ def curriedChart {n : ℕ} (A : Vec (n+1) ≃ₗ[ℂ] Vec (n+1)) (z : Vec (n+1)) : Poly (n+1) ≃ₐ[ℂ] Polynomial (Poly n) := (affineEquiv A z).trans (finSuccEquiv ℂ n) lemma curriedChart_apply {n : ℕ} (A : Vec (n+1) ≃ₗ[ℂ] Vec (n+1)) (z : Vec (n+1)) (P : Poly (n+1)) : curriedChart A z P = finSuccEquiv ℂ n (affinePullback A.toLinearMap z P) := rfl theorem curried_irreducible {n : ℕ} (A : Vec (n+1) ≃ₗ[ℂ] Vec (n+1)) (z : Vec (n+1)) (P : Poly (n+1)) (hP : Irreducible P) : Irreducible (curriedChart A z P) := (MulEquiv.irreducible_iff (curriedChart A z)).mpr hP theorem eval_curriedChart {n : ℕ} (A : Vec (n+1) ≃ₗ[ℂ] Vec (n+1)) (z : Vec (n+1)) (P : Poly (n+1)) (ζ : Vec n) (w : ℂ) : Polynomial.eval w (Polynomial.map (eval ζ) (curriedChart A z P)) = eval (z+A (Fin.cons w ζ)) P := by rw [curriedChart_apply, ← eval_eq_eval_mv_eval', eval_affinePullback] rfl /-- A positive-order root in a specialization ensures positive degree in the distinguished variable before specialization. -/ theorem natDegree_ne_zero_of_specialization_factor {R F : Type*} [Semiring R] [Semiring F] [Nontrivial F] (p : Polynomial R) (f : R →+* F) (s : ℕ) (hs : 0 < s) (g : Polynomial F) (hg : g.coeff 0 ≠ 0) (hp : p.map f = Polynomial.X^s*g) : p.natDegree ≠ 0 := by have hc : (p.map f).coeff s ≠ 0 := by rw [hp] have hcs : (Polynomial.X^s*g).coeff s = g.coeff 0 := by simpa only [zero_add] using Polynomial.coeff_X_pow_mul g s 0 rw [hcs] exact hg have hle := (Polynomial.le_natDegree_of_ne_zero hc).trans Polynomial.natDegree_map_le omega end end Source29AffinePolynomialChart /- Component: AffinePolynomialChartSlice.inc -/ namespace Source29AffinePolynomialChart open MvPolynomial Source29SlicePolynomial Source29PolynomialTranslation noncomputable section theorem cons_split {n : ℕ} (w : ℂ) (ζ : Vec n) : Fin.cons w ζ = Fin.cons 0 ζ + w • Fin.cons 1 (0 : Vec n) := by funext i refine Fin.cases ?_ (fun j => ?_) i · simp · simp /-- Specializing the parameter coefficients of the curried chart gives the actual affine line through z+A(0,zeta) in direction A(1,0). -/ theorem specialize_curriedChart_eq_lineSlice {n : ℕ} (A : Vec (n+1) ≃ₗ[ℂ] Vec (n+1)) (z : Vec (n+1)) (P : Poly (n+1)) (ζ : Vec n) : Polynomial.map (eval ζ) (curriedChart A z P) = lineSlice P (z+A (Fin.cons 0 ζ)) (A (Fin.cons 1 (0 : Vec n))) := by apply Polynomial.funext intro w rw [eval_curriedChart, eval_lineSlice, cons_split, map_add, map_smul] apply congrArg (fun x : Vec (n+1) => eval x P) funext i simp [Pi.add_apply, Pi.smul_apply, smul_eq_mul, add_assoc] theorem lineSlice_translate {n : ℕ} (P : Poly n) (z v N : Vec n) : lineSlice (translate P z) v N = lineSlice P (z+v) N := by apply Polynomial.funext intro w rw [eval_lineSlice, eval_lineSlice, eval_translate] apply congrArg (fun x : Vec n => eval x P) funext i simp [Pi.add_apply, add_assoc] theorem specialize_zero_eq_translatedSlice {n : ℕ} (A : Vec (n+1) ≃ₗ[ℂ] Vec (n+1)) (z : Vec (n+1)) (P : Poly (n+1)) : Polynomial.map (eval (0 : Vec n)) (curriedChart A z P) = lineSlice (translate P z) 0 (A (Fin.cons 1 (0 : Vec n))) := by rw [specialize_curriedChart_eq_lineSlice, lineSlice_translate] have h0 : (Fin.cons 0 (0 : Vec n) : Vec (n+1)) = 0 := by funext i exact Fin.cases rfl (fun _ => rfl) i simp only [h0, map_zero, add_zero] /-- An irreducible polynomial and an invertible affine chart produce a nonzero exceptional parameter polynomial once the normal slice has positive order. This instantiates the whole-slice Bezout certificate for the chart. -/ theorem exists_chart_exceptional_polynomial {n : ℕ} (A : Vec (n+1) ≃ₗ[ℂ] Vec (n+1)) (z : Vec (n+1)) (P : Poly (n+1)) (hP : Irreducible P) (s : ℕ) (hs : 0 < s) (g : Polynomial ℂ) (hg : g.coeff 0 ≠ 0) (hbase : lineSlice (translate P z) 0 (A (Fin.cons 1 (0 : Vec n))) = Polynomial.X^s*g) : ∃ (D : Poly n) (B C : Polynomial (Poly n)), D ≠ 0 ∧ B*curriedChart A z P+C*(curriedChart A z P).derivative = Polynomial.C D := by apply Source29WholeSliceBezout.exists_exceptional_polynomial (curriedChart A z P) (curried_irreducible A z P hP) apply natDegree_ne_zero_of_specialization_factor (curriedChart A z P) (eval (0 : Vec n)) s hs g hg rw [specialize_zero_eq_translatedSlice, hbase] end end Source29AffinePolynomialChart /- Component: PolynomialNonvanishingCone.inc -/ /- A polynomial is uniformly nonzero in a sufficiently narrow cone around any ray where its first nonzero homogeneous component is nonzero. The rescaling is polynomial in the scale variable, including at scale zero. -/ namespace Source29PolynomialNonvanishingCone open MvPolynomial Filter Finset open scoped Topology noncomputable section abbrev CSpace (n : ℕ) := EuclideanSpace ℂ (Fin n) /-- Nonvanishing of the initial homogeneous form in one direction persists on closed balls of radius proportional to the distance along that ray. -/ theorem nonzero_on_shrinking_balls_of_initial {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (d : ℕ) (hd : d ≤ P.totalDegree) (hlow : ∀ k < d, homogeneousComponent k P = 0) (v : CSpace n) (hv : eval (fun i => v i) (homogeneousComponent d P) ≠ 0) : ∃ ε δ : ℝ, 0 < ε ∧ 0 < δ ∧ ∀ t : ℝ, 0 < t → t < δ → ∀ x : CSpace n, ‖x - (t : ℂ) • v‖ ≤ ε * t → eval (fun i => x i) P ≠ 0 := by let F : ℂ × CSpace n → ℂ := fun p => eval (fun i => p.2 i) (Source29LowestRescale.rescale P d p.1) have hF : Continuous F := Source29SmallSlope.continuous_eval_rescale_joint P d have hF0 : F (0, v) ≠ 0 := by simpa only [F, Source29LowestRescale.rescale_zero P d hd hlow] using hv have hevent : ∀ᶠ p in 𝓝 (0, v), F p ≠ 0 := hF.continuousAt.eventually_ne hF0 obtain ⟨r, hr, hrF⟩ := Metric.mem_nhds_iff.mp hevent refine ⟨r / 2, r / 2, half_pos hr, half_pos hr, ?_⟩ intro t ht htδ x hx have htne : (t : ℂ) ≠ 0 := by exact_mod_cast ht.ne' have htnorm : ‖(t : ℂ)‖ = t := by simp [ht.le] let y : CSpace n := (t : ℂ)⁻¹ • x have hdiff : y - v = (t : ℂ)⁻¹ • (x - (t : ℂ) • v) := by simp only [y, smul_sub, smul_smul, inv_mul_cancel₀ htne, one_smul] have hy : ‖y - v‖ ≤ r / 2 := by rw [hdiff, norm_smul, norm_inv, htnorm] calc t⁻¹ * ‖x - (t : ℂ) • v‖ ≤ t⁻¹ * (r / 2 * t) := mul_le_mul_of_nonneg_left hx (inv_nonneg.mpr ht.le) _ = r / 2 := by field_simp have hpair : ((t : ℂ), y) ∈ Metric.ball (0, v) r := by simp only [Metric.mem_ball, Prod.dist_eq, dist_zero_right, max_lt_iff, htnorm] exact ⟨lt_trans htδ (by linarith), lt_of_le_of_lt (by simpa [dist_eq_norm] using hy) (by linarith)⟩ have hres : F ((t : ℂ), y) ≠ 0 := hrF hpair have hxy : (fun i => (t : ℂ) * y i) = (fun i => x i) := by funext i simp [y, htne] have heval := Source29LowestRescale.eval_rescale_mul P d hlow (t : ℂ) (fun i => y i) rw [hxy] at heval rw [← heval] exact mul_ne_zero (pow_ne_zero d htne) hres /-- A nonzero polynomial has some initial form and direction to which the shrinking-ball nonvanishing result applies, including the constant-term case. -/ theorem exists_nonzero_shrinking_balls {n : ℕ} (P : MvPolynomial (Fin n) ℂ) (hP : P ≠ 0) : ∃ v : CSpace n, ∃ ε δ : ℝ, 0 < ε ∧ 0 < δ ∧ ∀ t : ℝ, 0 < t → t < δ → ∀ x : CSpace n, ‖x - (t : ℂ) • v‖ ≤ ε * t → eval (fun i => x i) P ≠ 0 := by have hex : ∃ d : ℕ, homogeneousComponent d P ≠ 0 := by by_contra h push Not at h apply hP rw [← sum_homogeneousComponent P] simp only [h, Finset.sum_const_zero] let d := Nat.find hex have hdne : homogeneousComponent d P ≠ 0 := Nat.find_spec hex have hlow : ∀ k < d, homogeneousComponent k P = 0 := by intro k hk exact not_not.mp (Nat.find_min hex hk) have hd : d ≤ P.totalDegree := by by_contra h exact hdne (homogeneousComponent_eq_zero d P (by omega)) have hv : ∃ v : CSpace n, eval (fun i => v i) (homogeneousComponent d P) ≠ 0 := by by_contra h push Not at h apply hdne apply (homogeneousComponent_isHomogeneous d P).eq_zero_of_forall_eval_eq_zero intro x simpa only [PiLp.toLp_apply] using h (WithLp.toLp 2 x) obtain ⟨v, hv⟩ := hv obtain ⟨ε, δ, hε, hδ, hb⟩ := nonzero_on_shrinking_balls_of_initial P d hd hlow v hv exact ⟨v, ε, δ, hε, hδ, hb⟩ end end Source29PolynomialNonvanishingCone /- Component: TransverseTraceBound.inc -/ /- A real transverse path suffices for the final trace contradiction. -/ namespace Source29TransverseTraceBound open Filter Finset open scoped Topology noncomputable section def mean {ι : Type*} [Fintype ι] (w : ι → ℂ) : ℂ := (∑ j, w j) / ((Fintype.card ι : ℝ) : ℂ) lemma mean_ratio_real {ι : Type*} [Fintype ι] (w : ι → ℂ) (c t : ℝ) : 2 * ((c : ℂ) * (mean w / ((t^2 : ℝ) : ℂ))).re = (∑ j, 2 * ((c : ℂ) * w j).re / t^2) / (Fintype.card ι : ℝ) := by simp only [mean, Complex.mul_re, Complex.ofReal_re, Complex.ofReal_im, zero_mul, sub_zero, Complex.div_ofReal_re, Complex.re_sum, ← Finset.sum_div, ← Finset.mul_sum] ring /-- Exact transverse maximum algebra; the remainder is bounded by a fourth power using only the quadratic root bound. -/ lemma transverse_scalar_bound (κ b A t : ℝ) (w : ℂ) (hb : 0 ≤ b) (hA : 0 ≤ A) (hroot : ‖w‖ ≤ A * t^2) (hmax : κ + t^2 + (((-b : ℝ) : ℂ) * w^2).re ≤ κ + κ*t^2 + 2*b*w.re + b*‖w‖^2) : 2 * (((-b : ℝ) : ℂ) * w).re ≤ (κ - 1)*t^2 + 2*b*A^2*t^4 := by have hsq := (sq_le_sq₀ (norm_nonneg w) (mul_nonneg hA (sq_nonneg t))).mpr hroot have hre : w.re^2 ≤ A^2*t^4 := by rw [Complex.sq_norm, Complex.normSq_apply] at hsq nlinarith [sq_nonneg w.im] have hbr := mul_le_mul_of_nonneg_left hre (by positivity : 0 ≤ 2*b) rw [Complex.sq_norm, Complex.normSq_apply] at hmax simp only [Complex.mul_re, Complex.ofReal_re, Complex.ofReal_im, zero_mul, sub_zero, pow_two] at hmax ⊢ nlinarith /-- Taking the average and the real limit produces the desired diagonal second-derivative inequality. No complex-phase limit is required. -/ theorem transverse_mean_limit {ι : Type*} [Fintype ι] [Nonempty ι] (w : ℝ → ι → ℂ) (κ A : ℝ) (hκ : 0 ≤ κ) (hκ1 : κ < 1) (hA : 0 ≤ A) (hroot : ∀ᶠ t in 𝓝 (0 : ℝ), ∀ j, ‖w t j‖ ≤ A*t^2) (hmax : ∀ᶠ t in 𝓝 (0 : ℝ), ∀ j, κ + t^2 + (((-κ*(1-κ^2) : ℝ) : ℂ) * (w t j)^2).re ≤ κ * (1 + t^2 + 2*(1-κ^2)*(w t j).re + (1-κ^2)*‖w t j‖^2)) (μ : ℂ) (hmean : Tendsto (fun t : ℝ => mean (w t) / ((t^2 : ℝ) : ℂ)) (𝓝[≠] (0 : ℝ)) (𝓝 (μ / 2))) : (((-κ*(1-κ^2) : ℝ) : ℂ) * μ).re ≤ κ - 1 := by let b : ℝ := κ*(1-κ^2) have hb : 0 ≤ b := by dsimp [b]; nlinarith have hm : (0 : ℝ) < Fintype.card ι := Nat.cast_pos.mpr Fintype.card_pos have hevent : ∀ᶠ t in 𝓝[≠] (0 : ℝ), 2 * (((-b : ℝ) : ℂ) * (mean (w t) / ((t^2 : ℝ) : ℂ))).re ≤ κ - 1 + 2*b*A^2*t^2 := by filter_upwards [hroot.filter_mono nhdsWithin_le_nhds, hmax.filter_mono nhdsWithin_le_nhds, self_mem_nhdsWithin] with t hr hx ht have ht0 : t ≠ 0 := by simpa only [Set.mem_compl_iff, Set.mem_singleton_iff] using ht have ht2 : 0 < t^2 := sq_pos_of_ne_zero ht0 have hpoint (j : ι) : 2 * (((-b : ℝ) : ℂ) * w t j).re / t^2 ≤ κ - 1 + 2*b*A^2*t^2 := by have hmx : κ + t^2 + (((-b : ℝ) : ℂ) * (w t j)^2).re ≤ κ + κ*t^2 + 2*b*(w t j).re + b*‖w t j‖^2 := by convert hx j using 1 <;> dsimp [b] <;> ring have hh := transverse_scalar_bound κ b A t (w t j) hb hA (hr j) hmx apply (div_le_iff₀ ht2).mpr nlinarith rw [mean_ratio_real] apply (div_le_iff₀ hm).mpr calc (∑ j, 2 * (((-b : ℝ) : ℂ) * w t j).re / t^2) ≤ ∑ j : ι, (κ - 1 + 2*b*A^2*t^2) := sum_le_sum (fun j _ => hpoint j) _ = (κ - 1 + 2*b*A^2*t^2) * (Fintype.card ι : ℝ) := by simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] ring have hleftC : Tendsto (fun t : ℝ => (2 : ℂ) * (((-b : ℝ) : ℂ) * (mean (w t) / ((t^2 : ℝ) : ℂ)))) (𝓝[≠] (0 : ℝ)) (𝓝 (((-b : ℝ) : ℂ) * μ)) := by convert (tendsto_const_nhds.mul (tendsto_const_nhds.mul hmean)) using 1 <;> ring have hleft : Tendsto (fun t : ℝ => 2 * (((-b : ℝ) : ℂ) * (mean (w t) / ((t^2 : ℝ) : ℂ))).re) (𝓝[≠] (0 : ℝ)) (𝓝 (((-b : ℝ) : ℂ) * μ).re) := by simpa [Function.comp_def, Complex.mul_re] using (Complex.continuous_re.tendsto _).comp hleftC have ht : Tendsto (fun t : ℝ => t) (𝓝[≠] (0 : ℝ)) (𝓝 0) := tendsto_id.mono_left nhdsWithin_le_nhds have hright : Tendsto (fun t : ℝ => κ - 1 + 2*b*A^2*t^2) (𝓝[≠] (0 : ℝ)) (𝓝 (κ - 1)) := by simpa using tendsto_const_nhds.add (tendsto_const_nhds.mul (ht.pow 2)) have hh := le_of_tendsto_of_tendsto hleft hright hevent simpa only [b, neg_mul] using hh /-- Strictly negative real diagonal contributions are incompatible with a zero complex trace. -/ theorem trace_contradiction_of_real_bounds {ι : Type*} [Fintype ι] [Nonempty ι] (u : ι → ℂ) (c : ℂ) (κ : ℝ) (hκ : κ < 1) (hbound : ∀ i, (c * u i).re ≤ κ - 1) (htrace : ∑ i, u i = 0) : False := by have hneg : ∀ i, (c * u i).re < 0 := fun i => (hbound i).trans_lt (by linarith) have hs : (∑ i, (c * u i).re) < 0 := Finset.sum_neg (fun i _ => hneg i) Finset.univ_nonempty have hz : (∑ i, (c * u i).re) = 0 := by rw [← Complex.re_sum, ← Finset.mul_sum, htrace, mul_zero, Complex.zero_re] linarith end end Source29TransverseTraceBound /- Component: TransverseCoordinates.inc -/ /- Exact bilinear and Hermitian formulas in a real unit transverse direction. -/ namespace Source29TransverseCoordinates open Source29LocalMaximumBound noncomputable section variable {n : ℕ} lemma dot_add_left (z v w : CSpace n) : dot (z + v) w = dot z w + dot v w := by simp [dot, add_mul, Finset.sum_add_distrib] lemma dot_smul_left (a : ℂ) (z w : CSpace n) : dot (a • z) w = a * dot z w := by simp [dot, mul_assoc, Finset.mul_sum] lemma quadric_eq_dot_self (z : CSpace n) : quadric z = dot z z := by simp [quadric, dot, pow_two] lemma quadric_smul (a : ℂ) (z : CSpace n) : quadric (a • z) = a^2 * quadric z := by simp [quadric, mul_pow, Finset.mul_sum] lemma conjugate_eq_self_of_real (e : CSpace n) (hreal : ∀ i, (e i).im = 0) : conjugate e = e := by ext i : 1 exact Complex.conj_eq_iff_im.mpr (hreal i) lemma dot_conjugate_real_right (z e : CSpace n) (hreal : ∀ i, (e i).im = 0) : dot (conjugate z) e = star (dot z e) := by have he : ∀ i, star (e i) = e i := fun i => Complex.conj_eq_iff_im.mpr (hreal i) simp [dot, conjugate, he] lemma quadric_real_unit (e : CSpace n) (hreal : ∀ i, (e i).im = 0) (he : ‖e‖ = 1) : quadric e = 1 := by calc quadric e = dot e e := quadric_eq_dot_self e _ = dot (conjugate e) e := by rw [conjugate_eq_self_of_real e hreal] _ = inner ℂ e e := dot_conjugate_eq_inner e e _ = 1 := by rw [inner_self_eq_norm_sq_to_K, he]; norm_num lemma dot_normal_point (z : CSpace n) (κ : ℝ) (hz : ‖z‖ = 1) (hq : quadric z = (κ : ℂ)) : dot z (normal z κ) = 0 := by rw [dot_comm, dot_normal, ← quadric_eq_dot_self, hq, dot_conjugate_eq_inner, inner_self_eq_norm_sq_to_K, hz] norm_num lemma quadric_normal (z : CSpace n) (κ : ℝ) (hz : ‖z‖ = 1) (hq : quadric z = (κ : ℂ)) : quadric (normal z κ) = ((-κ * (1-κ^2) : ℝ) : ℂ) := by have hq' : Source29ComplexMaximum.bilinear (fun i => z i) (fun i => z i) = (κ : ℂ) := by simpa only [Source29ComplexMaximum.bilinear, quadric, pow_two] using hq have hn : Source29ComplexMaximum.bilinear (fun i => star (z i)) (fun i => z i) = 1 := by change dot (conjugate z) z = 1 rw [dot_conjugate_eq_inner, inner_self_eq_norm_sq_to_K, hz] norm_num have hs := Source29ComplexMaximum.normal_square (fun i => z i) κ hq' hn rw [quadric_eq_dot_self] convert hs using 1 · simp [Source29ComplexMaximum.bilinear, dot, normal, conjugate] · push_cast ring lemma inner_point_normal (z : CSpace n) (κ : ℝ) (hz : ‖z‖ = 1) (hq : quadric z = (κ : ℂ)) : inner ℂ z (normal z κ) = ((1-κ^2 : ℝ) : ℂ) := by unfold normal rw [inner_sub_right, inner_smul_right, inner_conjugate, hq, inner_self_eq_norm_sq_to_K, hz] simp [Complex.ofReal_sub, pow_two] lemma transverse_orthogonality (z e : CSpace n) (κ : ℝ) (hreal : ∀ i, (e i).im = 0) (hze : dot z e = 0) : dot e (normal z κ) = 0 ∧ inner ℂ z e = 0 ∧ inner ℂ e (normal z κ) = 0 := by have hbar : dot (conjugate z) e = 0 := by rw [dot_conjugate_real_right z e hreal, hze, star_zero] have heN : dot e (normal z κ) = 0 := by rw [dot_comm, dot_normal, hze, hbar] ring refine ⟨heN, ?_, ?_⟩ · rw [← dot_conjugate_eq_inner, hbar] · rw [← dot_conjugate_eq_inner, conjugate_eq_self_of_real e hreal, heN] /-- The bilinear quadric has no mixed terms in these three directions. -/ theorem transverse_quadric (z e : CSpace n) (κ : ℝ) (hz : ‖z‖ = 1) (hq : quadric z = (κ : ℂ)) (hreal : ∀ i, (e i).im = 0) (he : ‖e‖ = 1) (hze : dot z e = 0) (t w : ℂ) : quadric (z + t • e + w • normal z κ) = (κ : ℂ) + t^2 + ((-κ*(1-κ^2) : ℝ) : ℂ) * w^2 := by have hqE := quadric_real_unit e hreal he have hqN := quadric_normal z κ hz hq have hzN := dot_normal_point z κ hz hq have heN := (transverse_orthogonality z e κ hreal hze).1 simp only [quadric_add, quadric_smul, dot_add_left, dot_smul_left, dot_smul_right, hq, hqE, hqN, hzN, heN, hze, mul_zero, add_zero, mul_one] ring /-- The Hermitian norm retains exactly the real normal displacement term. -/ theorem transverse_norm_sq (z e : CSpace n) (κ : ℝ) (hz : ‖z‖ = 1) (hq : quadric z = (κ : ℂ)) (hreal : ∀ i, (e i).im = 0) (he : ‖e‖ = 1) (hze : dot z e = 0) (t w : ℂ) : ‖z + t • e + w • normal z κ‖^2 = 1 + ‖t‖^2 + 2*(1-κ^2)*w.re + (1-κ^2)*‖w‖^2 := by have horth := transverse_orthogonality z e κ hreal hze have hzN := inner_point_normal z κ hz hq have hNnorm := norm_normal_sq z κ hz hq simp only [norm_add_sq (𝕜 := ℂ), inner_add_left, inner_smul_left, inner_smul_right, norm_smul, mul_pow, hz, he, hNnorm, horth.2.1, horth.2.2, hzN, mul_zero, add_zero, mul_one, one_pow] simp only [RCLike.re_eq_complex_re, Complex.zero_re, Complex.mul_re, Complex.ofReal_re, Complex.ofReal_im, mul_zero, sub_zero] ring /-- A pointwise instance of the global maximum inequality supplies exactly the scalar hypothesis used by the real transverse trace limit. -/ theorem transverse_real_maximum (z e : CSpace n) (κ : ℝ) (hz : ‖z‖ = 1) (hq : quadric z = (κ : ℂ)) (hreal : ∀ i, (e i).im = 0) (he : ‖e‖ = 1) (hze : dot z e = 0) (t : ℝ) (w : ℂ) (hmaximum : ‖quadric (z + (t : ℂ) • e + w • normal z κ)‖ ≤ κ * ‖z + (t : ℂ) • e + w • normal z κ‖^2) : κ + t^2 + (((-κ*(1-κ^2) : ℝ) : ℂ) * w^2).re ≤ κ * (1 + t^2 + 2*(1-κ^2)*w.re + (1-κ^2)*‖w‖^2) := by have hr := (Complex.re_le_norm (quadric (z + (t : ℂ) • e + w • normal z κ))).trans hmaximum rw [transverse_quadric z e κ hz hq hreal he hze, transverse_norm_sq z e κ hz hq hreal he hze] at hr simpa only [Complex.add_re, ← Complex.ofReal_pow, Complex.ofReal_re, Complex.norm_real, Real.norm_eq_abs, sq_abs] using hr end end Source29TransverseCoordinates /- Component: AnalyticSimpleRoot.inc -/ /- Local analytic roots follow from degree-one polynomial preparation. -/ namespace Source29AnalyticSimpleRoot open Polynomial Filter Source29LocalFactorLinear open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] lemma analyticAt_linear_polynomial_functional (P : E → Polynomial ℂ) (a : E) (D : ℕ) (hdegree : ∀ x, (P x).natDegree ≤ D) (hcoeff : ∀ k, AnalyticAt ℂ (fun x => (P x).coeff k) a) (F : Polynomial ℂ →ₗ[ℂ] ℂ) : AnalyticAt ℂ (fun x => F (P x)) a := by let v : E → Fin (D+1) → ℂ := fun x i => (P x).coeff i let L : (Fin (D+1) → ℂ) →L[ℂ] ℂ := (F.comp ((degreeLT ℂ (D+1)).subtype.comp (degreeLTEquiv ℂ (D+1)).symm.toLinearMap)).toContinuousLinearMap have hv : AnalyticAt ℂ v a := AnalyticAt.pi (fun i => hcoeff i) have heq (x : E) : coeffPolynomial (D+1) (v x) = P x := by have hm : P x ∈ degreeLT ℂ (D+1) := mem_degreeLT.mpr ((degree_le_of_natDegree_le (hdegree x)).trans_lt (by exact_mod_cast Nat.lt_succ_self D)) exact congrArg Subtype.val ((degreeLTEquiv ℂ (D+1)).symm_apply_apply ⟨P x, hm⟩) have h := (L.analyticAt (v a)).comp hv change AnalyticAt ℂ (fun x => F (coeffPolynomial (D+1) (v x))) a at h simpa only [heq] using h lemma simple_root_at_zero (P : E → Polynomial ℂ) (a : E) (D : ℕ) (hdegree : ∀ x, (P x).natDegree ≤ D) (hcoeff : ∀ k, AnalyticAt ℂ (fun x => (P x).coeff k) a) (hzero : (P a).coeff 0 = 0) (hsimple : (P a).coeff 1 ≠ 0) : ∃ f : E → ℂ, AnalyticAt ℂ f a ∧ f a = 0 ∧ (∀ᶠ x in 𝓝 a, (P x).eval (f x) = 0) ∧ ∀ᶠ y : E × ℂ in 𝓝 (a,0), (P y.1).eval y.2 = 0 ↔ y.2 = f y.1 := by have hdiv : (X : Polynomial ℂ) ∣ P a := X_dvd_iff.mpr hzero obtain ⟨g, hg⟩ := hdiv have hg0 : g.coeff 0 ≠ 0 := by have he : (P a).coeff 1 = g.coeff 0 := by rw [hg]; simp rwa [he] at hsimple have hgn : g ≠ 0 := by intro hz; exact hg0 (by simp [hz]) have hgd : g.natDegree ≤ D := by have hh := hdegree a rw [hg, natDegree_mul X_ne_zero hgn, natDegree_X] at hh omega have hd : ∀ᶠ x in 𝓝 a, (P x).degree < (1+D+1 : WithBot ℕ) := by apply Filter.Eventually.of_forall intro x exact (degree_le_of_natDegree_le (hdegree x)).trans_lt (by exact_mod_cast (show D < 1+D+1 by omega)) obtain ⟨W, B, hW, hWa, hBa, hWcoeff, hBcoeff, hBdeg, hBunit, hWB⟩ := Source29LocalPreparation.local_polynomial_preparation P a 1 D g hgd hg0 (by simpa using hg) hd (fun i => hcoeff i) let f : E → ℂ := fun x => -(W x).coeff 0 have hf : AnalyticAt ℂ f a := (hWcoeff 0).neg have hfa : f a = 0 := by simp [f, hWa] have hwlin (x : E) : W x = X + C ((W x).coeff 0) := (hW x).1.eq_X_add_C (hW x).2 have hroot : ∀ᶠ x in 𝓝 a, (P x).eval (f x) = 0 := by filter_upwards [hWB] with x hx rw [← hx, eval_mul, hwlin] simp [f] refine ⟨f, hf, hfa, hroot, ?_⟩ have hp : Tendsto (fun y : E × ℂ => y.1) (𝓝 (a,0)) (𝓝 a) := continuous_fst.tendsto _ filter_upwards [hBunit, hp.eventually hWB] with y hy he rw [← he, eval_mul, hwlin, eval_add, eval_X, eval_C] simp only [mul_eq_zero, hy, or_false, f] exact add_eq_zero_iff_eq_neg /-- A simple root in a bounded-degree analytic polynomial family has a unique local analytic branch. The uniqueness is joint in the parameter and root. -/ theorem exists_local_analytic_root (P : E → Polynomial ℂ) (a : E) (D : ℕ) (r : ℂ) (hdegree : ∀ x, (P x).natDegree ≤ D) (hcoeff : ∀ k, AnalyticAt ℂ (fun x => (P x).coeff k) a) (hroot : (P a).eval r = 0) (hsimple : (P a).derivative.eval r ≠ 0) : ∃ f : E → ℂ, AnalyticAt ℂ f a ∧ f a = r ∧ (∀ᶠ x in 𝓝 a, (P x).eval (f x) = 0) ∧ ∀ᶠ y : E × ℂ in 𝓝 (a,r), (P y.1).eval y.2 = 0 ↔ y.2 = f y.1 := by let Q : E → Polynomial ℂ := fun x => taylor r (P x) have hQd : ∀ x, (Q x).natDegree ≤ D := by intro x simpa only [Q, natDegree_taylor] using hdegree x have hQa : ∀ k, AnalyticAt ℂ (fun x => (Q x).coeff k) a := by intro k exact analyticAt_linear_polynomial_functional P a D hdegree hcoeff ((Polynomial.lcoeff ℂ k).comp (taylor r)) obtain ⟨g, hg, hga, hgr, hgu⟩ := simple_root_at_zero Q a D hQd hQa (by simpa only [Q, taylor_coeff_zero] using hroot) (by simpa only [Q, taylor_coeff_one] using hsimple) refine ⟨fun x => g x + r, hg.add analyticAt_const, by simp [hga], ?_, ?_⟩ · simpa only [Q, taylor_eval] using hgr · have ht : Tendsto (fun y : E × ℂ => (y.1, y.2-r)) (𝓝 (a,r)) (𝓝 (a,0)) := by have ht := continuous_fst.continuousAt.tendsto.prodMk (continuous_snd.continuousAt.tendsto.sub (tendsto_const_nhds : Tendsto (fun _ : E × ℂ => r) (𝓝 (a,r)) (𝓝 r))) simpa only [sub_self, nhds_prod_eq] using ht filter_upwards [ht.eventually hgu] with y hy simpa only [Q, taylor_eval, sub_add_cancel, sub_eq_iff_eq_add] using hy end end Source29AnalyticSimpleRoot /- Component: AnalyticSimpleRootFamily.inc -/ namespace Source29AnalyticSimpleRoot open Polynomial Filter open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] /-- Bounded degree turns the infinitely stated coefficient hypothesis into a finite one, so all coefficients are analytic on one common neighborhood. -/ theorem eventually_analytic_coefficients (P : E → Polynomial ℂ) (a : E) (D : ℕ) (hdegree : ∀ x, (P x).natDegree ≤ D) (hcoeff : ∀ k, AnalyticAt ℂ (fun x => (P x).coeff k) a) : ∀ᶠ x in 𝓝 a, ∀ k, AnalyticAt ℂ (fun y => (P y).coeff k) x := by let v : E → Fin (D+1) → ℂ := fun x i => (P x).coeff i have hv : AnalyticAt ℂ v a := AnalyticAt.pi (fun i => hcoeff i) filter_upwards [hv.eventually_analyticAt] with x hx k by_cases hk : k < D+1 · exact ((ContinuousLinearMap.proj (⟨k, hk⟩ : Fin (D+1))).analyticAt (v x)).comp hx · have he : (fun y => (P y).coeff k) = fun _ : E => (0 : ℂ) := by funext y exact coeff_eq_zero_of_natDegree_lt (by have := hdegree y; omega) rw [he] exact analyticAt_const /-- Every simple root over a nearby parameter has a locally unique analytic branch, with a common parameter neighborhood for the coefficient regularity. -/ theorem eventually_local_analytic_roots (P : E → Polynomial ℂ) (a : E) (D : ℕ) (hdegree : ∀ x, (P x).natDegree ≤ D) (hcoeff : ∀ k, AnalyticAt ℂ (fun x => (P x).coeff k) a) : ∀ᶠ x in 𝓝 a, ∀ r : ℂ, (P x).eval r = 0 → (P x).derivative.eval r ≠ 0 → ∃ f : E → ℂ, AnalyticAt ℂ f x ∧ f x = r ∧ (∀ᶠ y in 𝓝 x, (P y).eval (f y) = 0) ∧ ∀ᶠ y : E × ℂ in 𝓝 (x,r), (P y.1).eval y.2 = 0 ↔ y.2 = f y.1 := by filter_upwards [eventually_analytic_coefficients P a D hdegree hcoeff] with x hx r hr hs exact exists_local_analytic_root P x D r hdegree hx hr hs end end Source29AnalyticSimpleRoot /- Component: AnalyticMeanHessian.inc -/ namespace Source29AnalyticMeanHessian open Filter Source29MetricJet open scoped Topology BigOperators noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] theorem fderiv_fderiv_sum {σ : Type*} [Fintype σ] (f : σ → E → ℂ) (x : E) (hf : ∀ j, AnalyticAt ℂ (f j) x) : fderiv ℂ (fderiv ℂ (fun y => ∑ j, f j y)) x = ∑ j, fderiv ℂ (fderiv ℂ (f j)) x := by have he : ∀ᶠ y in 𝓝 x, ∀ j, AnalyticAt ℂ (f j) y := Filter.eventually_all.mpr (fun j => (hf j).eventually_analyticAt) have hd : fderiv ℂ (fun y => ∑ j, f j y) =ᶠ[𝓝 x] (fun y => ∑ j, fderiv ℂ (f j) y) := by filter_upwards [he] with y hy exact fderiv_fun_sum (fun j _ => (hy j).differentiableAt) rw [hd.fderiv_eq] exact fderiv_fun_sum (fun j _ => (hf j).fderiv.differentiableAt) /-- A local identity for the finite sum of sheets passes to their complete second derivative. No labeling regularity in an external parameter is used. -/ theorem sum_second_derivative {σ : Type*} [Fintype σ] (f : σ → E → ℂ) (μ : E → ℂ) (c : ℂ) (x : E) (hf : ∀ j, AnalyticAt ℂ (f j) x) (hμ : AnalyticAt ℂ μ x) (hsum : (fun y => ∑ j, f j y) =ᶠ[𝓝 x] (fun y => c*μ y)) : ∑ j, fderiv ℂ (fderiv ℂ (f j)) x = c • fderiv ℂ (fderiv ℂ μ) x := by have hs : (fun y => ∑ j, f j y) =ᶠ[𝓝 x] c • μ := hsum have hsecond := (hs.fderiv (𝕜 := ℂ)).fderiv_eq (𝕜 := ℂ) rw [fderiv_fderiv_sum f x hf] at hsecond rw [fderiv_const_smul_field] at hsecond rw [fderiv_const_smul hμ.fderiv.differentiableAt c] at hsecond exact hsecond theorem sum_hessian_entries {σ : Type*} [Fintype σ] (f : σ → E → ℂ) (μ : E → ℂ) (c : ℂ) (x u v : E) (hf : ∀ j, AnalyticAt ℂ (f j) x) (hμ : AnalyticAt ℂ μ x) (hsum : (fun y => ∑ j, f j y) =ᶠ[𝓝 x] (fun y => c*μ y)) : ∑ j, fderiv ℂ (fderiv ℂ (f j)) x u v = c * fderiv ℂ (fderiv ℂ μ) x u v := by have h := congrArg (fun D : E →L[ℂ] E →L[ℂ] ℂ => D u v) (sum_second_derivative f μ c x hf hμ hsum) simpa only [sum_apply, smul_apply, smul_eq_mul] using h theorem continuousAt_hessian_entry (μ : E → ℂ) (x u v : E) (hμ : AnalyticAt ℂ μ x) : ContinuousAt (fun y => fderiv ℂ (fderiv ℂ μ) y u v) x := (hμ.fderiv.fderiv.continuousAt.clm_apply continuousAt_const).clm_apply continuousAt_const theorem tendsto_hessian_entry {α : Type*} {l : Filter α} (μ : E → ℂ) (x u v : E) (hμ : AnalyticAt ℂ μ x) (p : α → E) (hp : Tendsto p l (𝓝 x)) : Tendsto (fun a => fderiv ℂ (fderiv ℂ μ) (p a) u v) l (𝓝 (fderiv ℂ (fderiv ℂ μ) x u v)) := (continuousAt_hessian_entry μ x u v hμ).tendsto.comp hp /-- Metric trace of the analytic Hessian in a fixed family of directions. -/ def hessianTrace {ι : Type*} [Fintype ι] (M : ι → ι → ℂ) (e : ι → E) (f : E → ℂ) (x : E) : ℂ := metricTrace M (fun i k => fderiv ℂ (fderiv ℂ f) x (e i) (e k)) lemma metricTrace_sum {σ ι : Type*} [Fintype σ] [Fintype ι] (M : ι → ι → ℂ) (H : σ → ι → ι → ℂ) : metricTrace M (fun i k => ∑ j, H j i k) = ∑ j, metricTrace M (H j) := by simp only [metricTrace, Finset.mul_sum] calc _ = ∑ i, ∑ j, ∑ k, M i k * H j i k := by apply Finset.sum_congr rfl intro i _ rw [Finset.sum_comm] _ = _ := by rw [Finset.sum_comm] theorem sum_hessianTrace {σ ι : Type*} [Fintype σ] [Fintype ι] (M : ι → ι → ℂ) (e : ι → E) (f : σ → E → ℂ) (μ : E → ℂ) (c : ℂ) (x : E) (hf : ∀ j, AnalyticAt ℂ (f j) x) (hμ : AnalyticAt ℂ μ x) (hsum : (fun y => ∑ j, f j y) =ᶠ[𝓝 x] (fun y => c*μ y)) : ∑ j, hessianTrace M e (f j) x = c*hessianTrace M e μ x := by unfold hessianTrace rw [← metricTrace_sum] simp_rw [sum_hessian_entries f μ c x _ _ hf hμ hsum] exact metricTrace_scale M _ c theorem tendsto_hessianTrace {α ι : Type*} [Fintype ι] {l : Filter α} (M : ι → ι → ℂ) (e : ι → E) (μ : E → ℂ) (x : E) (hμ : AnalyticAt ℂ μ x) (p : α → E) (hp : Tendsto p l (𝓝 x)) : Tendsto (fun a => hessianTrace M e μ (p a)) l (𝓝 (hessianTrace M e μ x)) := by unfold hessianTrace metricTrace apply tendsto_finsetSum Finset.univ intro i _ apply tendsto_finsetSum Finset.univ intro k _ exact tendsto_const_nhds.mul (tendsto_hessian_entry μ x (e i) (e k) hμ p hp) /-- Sheet labels may vary arbitrarily with the external parameter. Local analyticity and the local sum identity at each center suffice to pass to the Hessian trace of the analytic mean at the limiting point. -/ theorem tendsto_sum_sheet_traces {α σ ι : Type*} [Fintype σ] [Fintype ι] {l : Filter α} (M : ι → ι → ℂ) (e : ι → E) (f : α → σ → E → ℂ) (μ : E → ℂ) (c : ℂ) (x : E) (hμ : AnalyticAt ℂ μ x) (p : α → E) (hp : Tendsto p l (𝓝 x)) (hf : ∀ᶠ a in l, ∀ j, AnalyticAt ℂ (f a j) (p a)) (hsum : ∀ᶠ a in l, (fun y => ∑ j, f a j y) =ᶠ[𝓝 (p a)] (fun y => c*μ y)) : Tendsto (fun a => ∑ j, hessianTrace M e (f a j) (p a)) l (𝓝 (c*hessianTrace M e μ x)) := by have ht := (tendsto_const_nhds (x := c) (f := l)).mul (tendsto_hessianTrace M e μ x hμ p hp) have hμa : ∀ᶠ a in l, AnalyticAt ℂ μ (p a) := hp.eventually hμ.eventually_analyticAt apply ht.congr' filter_upwards [hf, hsum, hμa] with a hfa hsa hμa exact (sum_hessianTrace M e (f a) μ c (p a) hfa hμa hsa).symm end end Source29AnalyticMeanHessian /- Component: AnalyticSheetMeanTrace.inc -/ /- Final trace step for analytic sheets with a uniform quadratic bound. The labels may depend arbitrarily on the external parameter. All geometric inputs are explicit: the balls, the mean identity, and the graph equation. -/ namespace Source29AnalyticSheetMeanTrace open Filter Source29MetricJet Source29AnalyticMeanHessian open scoped Topology BigOperators noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] variable {α σ ι : Type*} [Fintype σ] [Fintype ι] {l : Filter α} [NeBot l] /-- The metric trace of the mean Hessian vanishes. Gradient convergence and boundedness of the sheet Hessians follow from the shrinking-ball bound and are not additional hypotheses. No continuity of the labeling is required. -/ theorem mean_hessianTrace_eq_zero (M : ι → ι → ℂ) (e : ι → E) (he : ∀ i, ‖e i‖ ≤ 1) (f : α → σ → E → ℂ) (p : α → E) (scale : α → ℝ) (ε B : ℝ) (hε : 0 < ε) (hscale : Tendsto scale l (𝓝 0)) (hpos : ∀ᶠ a in l, 0 < scale a) (hp : Tendsto p l (𝓝 0)) (hf : ∀ᶠ a in l, ∀ j, AnalyticOnNhd ℂ (f a j) (Metric.closedBall (p a) (ε * scale a))) (hbound : ∀ᶠ a in l, ∀ j, ∀ y ∈ Metric.closedBall (p a) (ε * scale a), ‖f a j y‖ ≤ B * scale a ^ 2) (μ : E → ℂ) (hμ : AnalyticAt ℂ μ 0) (c : ℂ) (hc : c ≠ 0) (hsum : ∀ᶠ a in l, (fun y => ∑ j, f a j y) =ᶠ[𝓝 (p a)] (fun y => c * μ y)) (q : ℂ) (hPDE : ∀ j, ∀ᶠ a in l, let g := fun i => fderiv ℂ (f a j) (p a) (e i) let H := fun i k => fderiv ℂ (fderiv ℂ (f a j)) (p a) (e i) (e k) (1 + q * metricPair M g g) * metricTrace M H - q * contract H (raiseIndex M g) (raiseIndex M g) = 0) : hessianTrace M e μ 0 = 0 := by let g : σ → α → ι → ℂ := fun j a i => fderiv ℂ (f a j) (p a) (e i) let H : σ → α → ι → ι → ℂ := fun j a i k => fderiv ℂ (fderiv ℂ (f a j)) (p a) (e i) (e k) have hb (j : σ) (i k : ι) := Source29AnalyticDerivativeBounds.scaled_family_derivative_limits (fun a => f a j) p scale ε B hε hscale hpos (hf.mono fun _ ha => ha j) (hbound.mono fun _ ha => ha j) (e i) (e k) (he i) (he k) have hg : ∀ j i, Tendsto (fun a => g j a i) l (𝓝 0) := fun j i => (hb j i i).1 have hH : ∀ j i k, ∃ C : ℝ, ∀ᶠ a in l, ‖H j a i k‖ ≤ C := fun j i k => ⟨16 * B / ε ^ 2, (hb j i k).2⟩ have hcenter : ∀ᶠ a in l, ∀ j, AnalyticAt ℂ (f a j) (p a) := by filter_upwards [hf, hpos] with a hfa hpa intro j apply hfa j exact Metric.mem_closedBall_self (le_of_lt (mul_pos hε hpa)) have hlimit := tendsto_sum_sheet_traces M e f μ c 0 hμ p hp hcenter hsum have hz : c * hessianTrace M e μ 0 = 0 := Source29GraphTraceLimit.sum_trace_limit_eq_zero M q g H hg hH hPDE (c * hessianTrace M e μ 0) hlimit exact (mul_eq_zero.mp hz).resolve_left hc end end Source29AnalyticSheetMeanTrace /- Component: RadialLift.lean -/ /- The parametric lift-continuity proofs below are adapted from Mathlib/Topology/Homotopy/Lifting.lean, copyright (c) 2025 Junyan Xu, released under Apache 2.0. Only the interval-local lifting core is used; no fundamental group, homotopy classes, or covering-space imports are added. -/ namespace Source29RadialLift open Function Topology unitInterval noncomputable section variable {E X A : Type*} [TopologicalSpace E] [TopologicalSpace X] [TopologicalSpace A] {p : E → X} variable (homeo : IsLocalHomeomorph p) include homeo theorem exists_lift_nhds {f : C(I × A, X)} {g : I × A → E} (g_lifts : p ∘ g = f) (cont_0 : Continuous (g ⟨0, ·⟩)) (a : A) (cont_a : Continuous (g ⟨·, a⟩)) : ∃ N ∈ 𝓝 a, ∃ g' : I × A → E, ContinuousOn g' (Set.univ ×ˢ N) ∧ p ∘ g' = f ∧ (∀ a, g' (0, a) = g (0, a)) ∧ ∀ t, g' (t, a) = g (t, a) := by -- For every `e : E`, upgrade `p` to a LocalHomeomorph `q e` around `e`. choose q mem_source hpq using homeo /- Using the hypothesis `cont_a`, we partition the unit interval so that for each subinterval `[tₙ, tₙ₊₁]`, the image `g ([tₙ, tₙ₊₁] × {a})` is contained in the domain of some local homeomorphism `q e`. -/ obtain ⟨t, t_0, t_mono, ⟨n_max, h_max⟩, t_sub⟩ := exists_monotone_Icc_subset_open_cover_unitInterval (fun e ↦ (q e).open_source.preimage cont_a) fun t _ ↦ Set.mem_iUnion.mpr ⟨g (t, a), mem_source _⟩ /- We aim to inductively prove the existence of Nₙ and g' continuous on [0, tₙ] × Nₙ for each n, and get the desired result by taking some n with tₙ = 1. -/ suffices ∀ n, ∃ N, a ∈ N ∧ IsOpen N ∧ ∃ g' : I × A → E, ContinuousOn g' (Set.Icc 0 (t n) ×ˢ N) ∧ p ∘ g' = f ∧ (∀ a, g' (0, a) = g (0, a)) ∧ ∀ t' ≤ t n, g' (t', a) = g (t', a) by obtain ⟨N, haN, N_open, hN⟩ := this n_max simp_rw [h_max _ le_rfl] at hN refine ⟨N, N_open.mem_nhds haN, ?_⟩; convert! hN · rw [eq_comm, Set.eq_univ_iff_forall]; exact fun t ↦ ⟨bot_le, le_top⟩ · rw [imp_iff_right]; exact le_top refine Nat.rec ⟨_, Set.mem_univ a, isOpen_univ, g, ?_, g_lifts, fun a ↦ rfl, fun _ _ ↦ rfl⟩ (fun n ⟨N, haN, N_open, g', cont_g', g'_lifts, g'_0, g'_a⟩ ↦ ?_) · -- the n = 0 case is covered by the hypothesis cont_0. refine (cont_0.comp continuous_snd).continuousOn.congr (fun ta ⟨ht, _⟩ ↦ ?_) rw [t_0, Set.Icc_self, Set.mem_singleton_iff] at ht; rw [← ta.eta, ht]; rfl /- Since g ([tₙ, tₙ₊₁] × {a}) is contained in the domain of some local homeomorphism `q e` and g lifts f, f ([tₙ, tₙ₊₁] × {a}) is contained in the codomain (`target`) of `q e`. -/ obtain ⟨e, h_sub⟩ := t_sub n have : Set.Icc (t n) (t (n + 1)) ×ˢ {a} ⊆ f ⁻¹' (q e).target := by rintro ⟨t0, a'⟩ ⟨ht, ha⟩ rw [Set.mem_singleton_iff] at ha; dsimp only at ha rw [← g_lifts, hpq e, ha] exact (q e).map_source (h_sub ht) /- Using compactness of [tₙ, tₙ₊₁], we can find a neighborhood v of a such that f ([tₙ, tₙ₊₁] × v) is contained in the codomain of `q e`. -/ obtain ⟨u, v, -, v_open, hu, hav, huv⟩ := generalized_tube_lemma isClosed_Icc.isCompact isCompact_singleton ((q e).open_target.preimage f.continuous) this classical /- Use the inverse of `q e` to extend g' from [0, tₙ] × Nₙ₊₁ to [0, tₙ₊₁] × Nₙ₊₁, where Nₙ₊₁ ⊆ v ∩ Nₙ is such that {tₙ} × Nₙ₊₁ is mapped to the domain (`source`) of `q e` by `g'`. -/ refine ⟨_, ?_, v_open.inter <| (cont_g'.comp (Continuous.prodMk_right <| t n).continuousOn fun a ha ↦ ⟨?_, ha⟩).isOpen_inter_preimage N_open (q e).open_source, fun ta ↦ if ta.1 ≤ t n then g' ta else if f ta ∈ (q e).target then (q e).symm (f ta) else g ta, .if (fun ta ⟨⟨_, hav, _, ha⟩, hfr⟩ ↦ ?_) (cont_g'.mono fun ta ⟨hta, ht⟩ ↦ ?_) ?_, ?_, fun a ↦ ?_, fun t0 htn1 ↦ ?_⟩ · refine ⟨Set.singleton_subset_iff.mp hav, haN, ?_⟩ change g' (t n, a) ∈ (q e).source; rw [g'_a _ le_rfl] exact h_sub ⟨le_rfl, t_mono n.le_succ⟩ · rw [← t_0]; exact ⟨t_mono n.zero_le, le_rfl⟩ · have ht := Set.mem_ofPred.mp (frontier_le_subset_eq continuous_fst continuous_const hfr) have : f ta ∈ (q e).target := huv ⟨hu (by rw [ht]; exact ⟨le_rfl, t_mono n.le_succ⟩), hav⟩ rw [ite_eq_left this] -- here we use that {tₙ} × Nₙ₊₁ is mapped to the domain of `q e` apply (q e).injOn (by rwa [← ta.eta, ht]) ((q e).map_target this) rw [(q e).right_inv this, ← hpq e]; exact congr($g'_lifts ta) · rw [closure_le_eq continuous_fst continuous_const] at ht exact ⟨⟨hta.1.1, ht⟩, hta.2.2.1⟩ · simp_rw [not_le]; exact (ContinuousOn.congr ((q e).continuousOn_invFun.comp f.2.continuousOn fun _ h ↦ huv ⟨hu ⟨h.2, h.1.1.2⟩, h.1.2.1⟩) fun _ h ↦ ite_eq_left <| huv ⟨hu ⟨h.2, h.1.1.2⟩, h.1.2.1⟩).mono (Set.inter_subset_inter_right _ <| closure_lt_subset_le continuous_const continuous_fst) · ext ta; rw [Function.comp_apply]; split_ifs with _ hv · exact congr($g'_lifts ta) · rw [hpq e, (q e).right_inv hv] · exact congr($g_lifts ta) · rw [← g'_0]; exact ite_eq_left bot_le · dsimp only; split_ifs with htn hf · exact g'_a t0 htn · apply (q e).injOn ((q e).map_target hf) (h_sub ⟨le_of_not_ge htn, htn1⟩) rw [(q e).right_inv hf, ← hpq e]; exact congr($g_lifts _).symm · rfl variable (sep : IsSeparatedMap p) include sep theorem continuous_lift (f : C(I × A, X)) {g : I × A → E} (g_lifts : p ∘ g = f) (cont_0 : Continuous (g ⟨0, ·⟩)) (cont_A : ∀ a, Continuous (g ⟨·, a⟩)) : Continuous g := by rw [continuous_iff_continuousAt] intro ⟨t, a⟩ obtain ⟨N, haN, g', cont_g', g'_lifts, g'_0, -⟩ := exists_lift_nhds homeo g_lifts cont_0 a (cont_A a) refine (cont_g'.congr fun ⟨t, a⟩ ⟨_, ha⟩ ↦ ?_).continuousAt (prod_mem_nhds Filter.univ_mem haN) refine congr_fun (sep.eq_of_comp_eq homeo.isLocallyInjective (cont_A a) (cont_g'.comp_continuous (.prodMk_left a) fun _ ↦ ⟨⟨⟩, ha⟩) ?_ 0 (g'_0 a).symm) t ext t; apply congr_fun (g_lifts.trans g'_lifts.symm) end end Source29RadialLift /- Component: LocalSectionsPathLift.inc -/ namespace Source29RadialLift open Function Topology unitInterval noncomputable section variable {E X A : Type*} [TopologicalSpace E] [TopologicalSpace X] [TopologicalSpace A] {p : E → X} /-- A common base neighborhood supports a local continuous section through any point above it. A finite collection of exhaustive root charts provides this property directly, without introducing the general covering-map API. -/ def HasLocalSections (p : E → X) : Prop := ∀ x : X, ∃ U : Set X, x ∈ U ∧ IsOpen U ∧ ∀ e : E, p e ∈ U → ∃ q : X → E, ContinuousOn q U ∧ (∀ y ∈ U, p (q y) = y) ∧ q (p e) = e /-- Finite-subdivision path lifting. Adapted from Junyan Xu's `IsCoveringMap.exists_path_lifts` in Mathlib/Topology/Homotopy/Lifting.lean (Apache 2.0); local sections replace the general bundle trivialization. -/ theorem exists_path_lifts (cover : HasLocalSections p) (γ : C(I, X)) (e : E) (γ_0 : γ 0 = p e) : ∃ Γ : C(I, E), p ∘ Γ = γ ∧ Γ 0 = e := by choose U mem_base U_open sections using cover obtain ⟨t, t_0, t_mono, ⟨n_max, h_max⟩, t_sub⟩ := exists_monotone_Icc_subset_open_cover_unitInterval (fun x => (U_open x).preimage γ.continuous) (fun t _ => Set.mem_iUnion.2 ⟨γ t, mem_base _⟩) suffices ∀ n, ∃ Γ : I → E, ContinuousOn Γ (Set.Icc 0 (t n)) ∧ (Set.Icc 0 (t n)).EqOn (p ∘ Γ) γ ∧ Γ 0 = e by obtain ⟨Γ, cont, eqOn, Γ_0⟩ := this n_max rw [h_max _ le_rfl] at cont eqOn exact ⟨⟨Γ, continuousOn_univ.mp (by convert! cont; rw [eq_comm, Set.eq_univ_iff_forall]; exact fun t => ⟨bot_le, le_top⟩)⟩, funext (fun _ => eqOn ⟨bot_le, le_top⟩), Γ_0⟩ intro n induction n with | zero => refine ⟨fun _ => e, continuous_const.continuousOn, ?_, rfl⟩ intro t ht rw [t_0, Set.Icc_self, Set.mem_singleton_iff] at ht subst t exact γ_0.symm | succ n ih => obtain ⟨Γ, cont, eqOn, Γ_0⟩ := ih obtain ⟨x, t_sub⟩ := t_sub n have pΓtn : p (Γ (t n)) = γ (t n) := eqOn ⟨t_0 ▸ t_mono n.zero_le, le_rfl⟩ obtain ⟨q, hqcont, hqlift, hqstart⟩ := sections x (Γ (t n)) (by rw [pΓtn]; exact t_sub ⟨le_rfl, t_mono n.le_succ⟩) refine ⟨fun s => if s ≤ t n then Γ s else q (γ s), .if (fun s hs => ?_) (cont.mono fun _ h => ?_) ?_, ?_, ?_⟩ · cases frontier_Iic_subset _ hs.2 rw [← pΓtn] exact hqstart.symm · rw [closure_le_eq continuous_id' continuous_const] at h exact ⟨h.1.1, h.2⟩ · apply hqcont.comp γ.2.continuousOn simp_rw [not_le] intro s h exact t_sub ⟨closure_lt_subset_le continuous_const continuous_subtype_val h.2, h.1.2⟩ · intro s hs simp only [Function.comp_apply] split_ifs with h · exact eqOn ⟨hs.1, h⟩ · exact hqlift _ (t_sub ⟨le_of_not_ge h, hs.2⟩) · dsimp only rwa [ite_eq_left (t_0 ▸ t_mono n.zero_le)] end end Source29RadialLift /- Component: ContractedSection.inc -/ namespace Source29RadialLift open Function Topology unitInterval noncomputable section variable {E X : Type*} [TopologicalSpace E] [TopologicalSpace X] [T2Space E] {p : E → X} /-- Lifting an explicit strong contraction gives a continuous section through any prescribed point of the central fiber. No simply-connected-space or homotopy-group interface is needed. -/ theorem exists_continuous_section_of_contraction (homeo : IsLocalHomeomorph p) (cover : HasLocalSections p) (H : C(I × X, X)) (x₀ : X) (hzero : ∀ x, H (0, x) = x₀) (hone : ∀ x, H (1, x) = x) (hfix : ∀ t, H (t, x₀) = x₀) (e₀ : E) (he₀ : p e₀ = x₀) : ∃ S : C(X, E), p ∘ S = id ∧ S x₀ = e₀ := by let γ (x : X) : C(I, X) := ⟨fun t => H (t, x), H.continuous.comp (continuous_id.prodMk continuous_const)⟩ have hγ0 (x : X) : γ x 0 = p e₀ := (hzero x).trans he₀.symm choose Γ hΓlift hΓzero using fun x => exists_path_lifts cover (γ x) e₀ (hγ0 x) let F : I × X → E := fun tx => Γ tx.2 tx.1 have hFlift : p ∘ F = H := by funext tx exact congrFun (hΓlift tx.2) tx.1 have hFzero : Continuous (F ⟨0, ·⟩) := by have he : (fun x : X => F (0, x)) = (fun _ : X => e₀) := funext hΓzero rw [he] exact continuous_const have hFcont : Continuous F := continuous_lift homeo (T2Space.isSeparatedMap p) H hFlift hFzero (fun x => (Γ x).continuous) let S : C(X, E) := ⟨fun x => F (1, x), hFcont.comp (continuous_const.prodMk continuous_id)⟩ refine ⟨S, ?_, ?_⟩ · funext x exact (congrFun hFlift (1, x)).trans (hone x) · have he : Γ x₀ = (fun _ : I => e₀) := by apply (T2Space.isSeparatedMap p).eq_of_comp_eq homeo.isLocallyInjective (Γ x₀).continuous continuous_const _ 0 (hΓzero x₀) funext t exact (congrFun (hΓlift x₀) t).trans ((hfix t).trans he₀.symm) exact congrFun he 1 /-- Continuous sections through different initial fiber points stay distinct on a connected base. -/ theorem sections_ne_of_ne_at [PreconnectedSpace X] (homeo : IsLocalHomeomorph p) (S T : C(X, E)) (hS : p ∘ S = id) (hT : p ∘ T = id) (x₀ : X) (hneq : S x₀ ≠ T x₀) (x : X) : S x ≠ T x := by intro he have heq := (T2Space.isSeparatedMap p).eq_of_comp_eq homeo.isLocallyInjective S.continuous T.continuous (hS.trans hT.symm) x he exact hneq (congrFun heq x₀) end end Source29RadialLift /- Component: BallSection.inc -/ namespace Source29RadialLift open Function Topology unitInterval noncomputable section variable {V : Type*} [NormedAddCommGroup V] [NormedSpace ℝ V] variable {E : Type*} [TopologicalSpace E] [T2Space E] /-- The radial contraction supplies continuous sections over an open ball. -/ theorem exists_continuous_section_on_ball (c : V) (R : ℝ) (hR : 0 < R) (p : E → Metric.ball c R) (homeo : IsLocalHomeomorph p) (cover : HasLocalSections p) (e₀ : E) (he₀ : p e₀ = ⟨c, Metric.mem_ball_self hR⟩) : ∃ S : C(Metric.ball c R, E), p ∘ S = id ∧ S ⟨c, Metric.mem_ball_self hR⟩ = e₀ := by let H : C(I × Metric.ball c R, Metric.ball c R) := { toFun := fun tx => ⟨c + (tx.1 : ℝ) • ((tx.2 : V) - c), by rw [Metric.mem_ball, dist_eq_norm, add_sub_cancel_left, norm_smul, Real.norm_eq_abs, abs_of_nonneg tx.1.2.1] calc (tx.1 : ℝ) * ‖(tx.2 : V) - c‖ ≤ 1 * ‖(tx.2 : V) - c‖ := mul_le_mul_of_nonneg_right tx.1.2.2 (norm_nonneg _) _ < R := by simpa only [one_mul, ← dist_eq_norm, Metric.mem_ball] using tx.2.2⟩ continuous_toFun := by fun_prop } apply exists_continuous_section_of_contraction homeo cover H ⟨c, Metric.mem_ball_self hR⟩ _ _ _ e₀ he₀ · intro x apply Subtype.ext simp [H] · intro x apply Subtype.ext simp [H] · intro t apply Subtype.ext simp [H] end end Source29RadialLift /- Component: RootSectionAnalytic.lean -/ namespace Source29RootSectionAnalytic open Filter open scoped Topology noncomputable section variable {V : Type*} [NormedAddCommGroup V] [NormedSpace ℂ V] /-- A continuous root choice agrees locally with the unique analytic branch. This upgrades the section obtained by radial lifting to an analytic label. -/ theorem analyticAt_of_continuous_root_choice (P : V → Polynomial ℂ) (w : V → ℂ) (a : V) (hw : ContinuousAt w a) (hroot : ∀ᶠ x in 𝓝 a, (P x).eval (w x) = 0) (hlocal : ∃ f : V → ℂ, AnalyticAt ℂ f a ∧ ∀ᶠ p : V × ℂ in 𝓝 (a, w a), (P p.1).eval p.2 = 0 ↔ p.2 = f p.1) : AnalyticAt ℂ w a := by obtain ⟨f, hf, huniq⟩ := hlocal apply hf.congr have hp : Tendsto (fun x => (x, w x)) (𝓝 a) (𝓝 (a, w a)) := (continuousAt_id.prodMk hw).tendsto filter_upwards [hp.eventually huniq, hroot] with x hx hr exact (hx.mp hr).symm end end Source29RootSectionAnalytic /- Component: TransverseBasis.inc -/ /- The real transverse space and its orthonormal basis at a normalized point. -/ namespace Source29TransverseBasis open scoped BigOperators Matrix noncomputable section abbrev RSpace (n : ℕ) := EuclideanSpace ℝ (Fin n) abbrev CSpace (n : ℕ) := EuclideanSpace ℂ (Fin n) variable {n : ℕ} def realVector (z : CSpace n) : RSpace n := WithLp.toLp 2 (fun i => (z i).re) def imagVector (z : CSpace n) : RSpace n := WithLp.toLp 2 (fun i => (z i).im) def normalPlane (z : CSpace n) : Submodule ℝ (RSpace n) := Submodule.span ℝ (Set.range ![realVector z, imagVector z]) def transverseSpace (z : CSpace n) : Submodule ℝ (RSpace n) := (normalPlane z)ᗮ def complexify (v : RSpace n) : CSpace n := WithLp.toLp 2 (fun i => (v i : ℂ)) lemma real_imag_inner (z : CSpace n) (κ : ℝ) (hz : ‖z‖ = 1) (hq : ∑ i : Fin n, (z i)^2 = (κ : ℂ)) : inner ℝ (realVector z) (imagVector z) = 0 := by have h := (Source29NormalCoordinates.real_imag_normalization z κ hz hq).1 simpa [PiLp.inner_apply, realVector, imagVector, mul_comm] using h lemma real_imag_ne_zero (z : CSpace n) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin n, (z i)^2 = (κ : ℂ)) : realVector z ≠ 0 ∧ imagVector z ≠ 0 := by obtain ⟨hx, hy⟩ := Source29NormalCoordinates.real_imag_nonzero z κ hk hk1 hz hq constructor · intro h apply hx funext i exact congrArg (fun v : RSpace n => v i) h · intro h apply hy funext i exact congrArg (fun v : RSpace n => v i) h lemma real_imag_independent (z : CSpace n) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin n, (z i)^2 = (κ : ℂ)) : LinearIndependent ℝ ![realVector z, imagVector z] := by obtain ⟨hx, hy⟩ := real_imag_ne_zero z κ hk hk1 hz hq have hxy := real_imag_inner z κ hz hq have hyx : inner ℝ (imagVector z) (realVector z) = 0 := by rw [real_inner_comm, hxy] apply linearIndependent_of_ne_zero_of_inner_eq_zero · intro i fin_cases i <;> simp [hx, hy] · intro i j hij fin_cases i <;> fin_cases j <;> simp_all lemma normalPlane_finrank (z : CSpace n) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin n, (z i)^2 = (κ : ℂ)) : Module.finrank ℝ (normalPlane z) = 2 := by unfold normalPlane have h := finrank_span_eq_card (real_imag_independent z κ hk hk1 hz hq) norm_num at h exact h /-- The real transverse space has codimension two. -/ theorem transverseSpace_finrank (z : CSpace n) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin n, (z i)^2 = (κ : ℂ)) : Module.finrank ℝ (transverseSpace z) = n - 2 := by have h := (normalPlane z).finrank_add_finrank_orthogonal rw [normalPlane_finrank z κ hk hk1 hz hq, finrank_euclideanSpace_fin] at h change 2 + Module.finrank ℝ (transverseSpace z) = n at h omega def transverseBasis (z : CSpace n) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin n, (z i)^2 = (κ : ℂ)) : OrthonormalBasis (Fin (n-2)) ℝ (transverseSpace z) := (stdOrthonormalBasis ℝ (transverseSpace z)).reindex (finCongr (transverseSpace_finrank z κ hk hk1 hz hq)) lemma mem_transverse_inner (z : CSpace n) (v : RSpace n) (hv : v ∈ transverseSpace z) : inner ℝ (realVector z) v = 0 ∧ inner ℝ (imagVector z) v = 0 := by have hx : realVector z ∈ normalPlane z := Submodule.subset_span (Set.mem_range.mpr ⟨(0 : Fin 2), rfl⟩) have hy : imagVector z ∈ normalPlane z := Submodule.subset_span (Set.mem_range.mpr ⟨(1 : Fin 2), rfl⟩) exact ⟨hv _ hx, hv _ hy⟩ lemma complexify_real (v : RSpace n) (i : Fin n) : (complexify v i).im = 0 := by simp [complexify] lemma complexify_norm (v : RSpace n) : ‖complexify v‖ = ‖v‖ := by have hs : ‖complexify v‖^2 = ‖v‖^2 := by simp [EuclideanSpace.norm_sq_eq, complexify] nlinarith [norm_nonneg (complexify v), norm_nonneg v] lemma complexify_inner (v w : RSpace n) : inner ℂ (complexify v) (complexify w) = (inner ℝ v w : ℂ) := by simp [PiLp.inner_apply, complexify, mul_comm] lemma complexify_transverse_dot (z : CSpace n) (v : RSpace n) (hv : v ∈ transverseSpace z) : (∑ i : Fin n, z i * complexify v i) = 0 := by obtain ⟨hx, hy⟩ := mem_transverse_inner z v hv have hr : (∑ i : Fin n, (z i).re * v i) = 0 := by simpa [PiLp.inner_apply, realVector, mul_comm] using hx have hi : (∑ i : Fin n, (z i).im * v i) = 0 := by simpa [PiLp.inner_apply, imagVector, mul_comm] using hy apply Complex.ext <;> simp [Complex.re_sum, Complex.im_sum, complexify, Complex.mul_re, Complex.mul_im, hr, hi] def complexBasisVector (z : CSpace n) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin n, (z i)^2 = (κ : ℂ)) (j : Fin (n-2)) : CSpace n := complexify ((transverseBasis z κ hk hk1 hz hq j : transverseSpace z) : RSpace n) lemma complexBasisVector_real (z : CSpace n) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin n, (z i)^2 = (κ : ℂ)) (j : Fin (n-2)) (i : Fin n) : (complexBasisVector z κ hk hk1 hz hq j i).im = 0 := by exact complexify_real _ i lemma complexBasisVector_norm (z : CSpace n) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin n, (z i)^2 = (κ : ℂ)) (j : Fin (n-2)) : ‖complexBasisVector z κ hk hk1 hz hq j‖ = 1 := by unfold complexBasisVector rw [complexify_norm] exact (transverseBasis z κ hk hk1 hz hq).orthonormal.norm_eq_one j lemma complexBasisVector_dot (z : CSpace n) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin n, (z i)^2 = (κ : ℂ)) (j : Fin (n-2)) : (∑ i : Fin n, z i * complexBasisVector z κ hk hk1 hz hq j i) = 0 := by exact complexify_transverse_dot _ _ (transverseBasis z κ hk hk1 hz hq j).property /-- The lifted real basis is also an orthonormal complex family. -/ theorem complexBasisVector_orthonormal (z : CSpace n) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin n, (z i)^2 = (κ : ℂ)) : Orthonormal ℂ (complexBasisVector z κ hk hk1 hz hq) := by rw [orthonormal_iff_ite] intro i j unfold complexBasisVector rw [complexify_inner] have h := (orthonormal_iff_ite.mp (transverseBasis z κ hk hk1 hz hq).orthonormal) i j change inner ℝ ((transverseBasis z κ hk hk1 hz hq i : transverseSpace z) : RSpace n) ((transverseBasis z κ hk hk1 hz hq j : transverseSpace z) : RSpace n) = _ at h rw [h] split_ifs <;> norm_num /-- In dimension eight, the constructed real transverse basis supplies exactly six real, unit, complex-orthonormal transverse vectors. -/ theorem exists_six_transverse_vectors (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : ∃ e : Fin 6 → CSpace 8, Orthonormal ℂ e ∧ (∀ j i, (e j i).im = 0) ∧ (∀ j, ‖e j‖ = 1) ∧ (∀ j, ∑ i : Fin 8, z i * e j i = 0) := by exact ⟨complexBasisVector z κ hk hk1 hz hq, complexBasisVector_orthonormal z κ hk hk1 hz hq, complexBasisVector_real z κ hk hk1 hz hq, complexBasisVector_norm z κ hk hk1 hz hq, complexBasisVector_dot z κ hk hk1 hz hq⟩ end end Source29TransverseBasis /- Component: TangentBasis.inc -/ /- A concrete orthonormal basis of the complex tangent hyperplane. -/ namespace Source29TangentBasis open Source29LocalMaximumBound open Source29TransverseBasis (complexBasisVector) open scoped BigOperators Matrix noncomputable section abbrev Tangent (z : CSpace 8) (κ : ℝ) := (Source29ComplexTangent.normalCLM κ z).ker lemma normalCLM_eq_dot (z v : CSpace 8) (κ : ℝ) : Source29ComplexTangent.normalCLM κ z v = dot (normal z κ) v := by rw [Source29ComplexTangent.normalCLM_apply] rfl lemma normalCLM_normal (z : CSpace 8) (κ : ℝ) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : Source29ComplexTangent.normalCLM κ z (normal z κ) = ((-κ*(1-κ^2) : ℝ) : ℂ) := by rw [normalCLM_eq_dot, ← Source29TransverseCoordinates.quadric_eq_dot_self] exact Source29TransverseCoordinates.quadric_normal z κ hz hq lemma tangent_finrank (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : Module.finrank ℂ (Tangent z κ) = 7 := by have hcR : -κ*(1-κ^2) ≠ 0 := by nlinarith [sq_nonneg κ] have hc : ((-κ*(1-κ^2) : ℝ) : ℂ) ≠ 0 := by exact_mod_cast hcR have hsurj : Function.Surjective (Source29ComplexTangent.normalCLM κ z) := by intro a refine ⟨(a / ((-κ*(1-κ^2) : ℝ) : ℂ)) • normal z κ, ?_⟩ rw [map_smul, normalCLM_normal z κ hz hq, smul_eq_mul, div_mul_cancel₀ _ hc] have hrange : LinearMap.range (Source29ComplexTangent.normalCLM κ z).toLinearMap = ⊤ := LinearMap.range_eq_top.mpr hsurj have hdim := (Source29ComplexTangent.normalCLM κ z).toLinearMap.finrank_range_add_finrank_ker rw [hrange, finrank_top, Module.finrank_self, finrank_euclideanSpace_fin] at hdim change 1 + Module.finrank ℂ (Tangent z κ) = 8 at hdim omega def ambientVector (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : Fin 7 → CSpace 8 := Matrix.vecCons z (complexBasisVector z κ hk hk1 hz hq) lemma ambientVector_mem (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (j : Fin 7) : ambientVector z κ hk hk1 hz hq j ∈ Tangent z κ := by change Source29ComplexTangent.normalCLM κ z _ = 0 rw [normalCLM_eq_dot] refine Fin.cases ?_ (fun i => ?_) j · change dot (normal z κ) z = 0 rw [dot_comm] exact Source29TransverseCoordinates.dot_normal_point z κ hz hq · change dot (normal z κ) (complexBasisVector z κ hk hk1 hz hq i) = 0 rw [dot_comm] exact (Source29TransverseCoordinates.transverse_orthogonality z _ κ (Source29TransverseBasis.complexBasisVector_real z κ hk hk1 hz hq i) (Source29TransverseBasis.complexBasisVector_dot z κ hk hk1 hz hq i)).1 lemma ambientVector_orthonormal (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : Orthonormal ℂ (ambientVector z κ hk hk1 hz hq) := by rw [ambientVector, orthonormal_vecCons_iff] refine ⟨hz, ?_, Source29TransverseBasis.complexBasisVector_orthonormal z κ hk hk1 hz hq⟩ intro i exact (Source29TransverseCoordinates.transverse_orthogonality z _ κ (Source29TransverseBasis.complexBasisVector_real z κ hk hk1 hz hq i) (Source29TransverseBasis.complexBasisVector_dot z κ hk hk1 hz hq i)).2.1 def tangentVector (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (j : Fin 7) : Tangent z κ := ⟨ambientVector z κ hk hk1 hz hq j, ambientVector_mem z κ hk hk1 hz hq j⟩ lemma tangentVector_orthonormal (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : Orthonormal ℂ (tangentVector z κ hk hk1 hz hq) := by rw [orthonormal_iff_ite] exact orthonormal_iff_ite.mp (ambientVector_orthonormal z κ hk hk1 hz hq) /-- Coordinate zero is the radial direction; the other six are the real transverse basis. -/ def tangentBasis (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : OrthonormalBasis (Fin 7) ℂ (Tangent z κ) := let b := basisOfOrthonormalOfCardEqFinrank (tangentVector_orthonormal z κ hk hk1 hz hq) (by simpa using (tangent_finrank z κ hk hk1 hz hq).symm) b.toOrthonormalBasis (by simpa only [b, coe_basisOfOrthonormalOfCardEqFinrank] using tangentVector_orthonormal z κ hk hk1 hz hq) lemma tangentBasis_apply (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (j : Fin 7) : (tangentBasis z κ hk hk1 hz hq j : CSpace 8) = ambientVector z κ hk hk1 hz hq j := by simp [tangentBasis, tangentVector] /-- The isometric coordinate map used for the affine tangent chart. -/ def tangentCoordinates (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : EuclideanSpace ℂ (Fin 7) ≃ₗᵢ[ℂ] Tangent z κ := (tangentBasis z κ hk hk1 hz hq).repr.symm /-- The corresponding linear isometric embedding into the ambient space. -/ def tangentEmbedding (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : EuclideanSpace ℂ (Fin 7) →ₗᵢ[ℂ] CSpace 8 := (Tangent z κ).subtypeₗᵢ.comp (tangentCoordinates z κ hk hk1 hz hq).toLinearIsometry lemma tangentEmbedding_normal (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (x : EuclideanSpace ℂ (Fin 7)) : Source29ComplexTangent.normalCLM κ z (tangentEmbedding z κ hk hk1 hz hq x) = 0 := (tangentCoordinates z κ hk hk1 hz hq x).property lemma tangentEmbedding_range (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : LinearMap.range (tangentEmbedding z κ hk hk1 hz hq).toLinearMap = Tangent z κ := by ext v constructor · rintro ⟨x, rfl⟩ exact tangentEmbedding_normal z κ hk hk1 hz hq x · intro hv refine ⟨(tangentCoordinates z κ hk hk1 hz hq).symm ⟨v, hv⟩, ?_⟩ exact congrArg Subtype.val ((tangentCoordinates z κ hk hk1 hz hq).apply_symm_apply ⟨v, hv⟩) lemma tangentEmbedding_single (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (j : Fin 7) : tangentEmbedding z κ hk hk1 hz hq (EuclideanSpace.single j 1) = ambientVector z κ hk hk1 hz hq j := by change ((tangentBasis z κ hk hk1 hz hq).repr.symm (EuclideanSpace.single j 1) : CSpace 8) = _ rw [OrthonormalBasis.repr_symm_single, tangentBasis_apply] lemma dot_real_left (v w : CSpace 8) (hv : ∀ i, (v i).im = 0) : dot v w = inner ℂ v w := by rw [← dot_conjugate_eq_inner, Source29TransverseCoordinates.conjugate_eq_self_of_real v hv] lemma ambientVector_metric (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (i j : Fin 7) : dot (ambientVector z κ hk hk1 hz hq i) (ambientVector z κ hk hk1 hz hq j) = if i = j then (if i = 0 then (κ : ℂ) else 1) else 0 := by refine Fin.cases ?_ (fun a => ?_) i <;> refine Fin.cases ?_ (fun b => ?_) j · simpa [ambientVector, dot, pow_two] using hq · simpa [ambientVector, dot, Fin.succ_ne_zero, eq_comm] using Source29TransverseBasis.complexBasisVector_dot z κ hk hk1 hz hq b · rw [dot_comm] simpa [ambientVector, dot, Fin.succ_ne_zero, eq_comm] using Source29TransverseBasis.complexBasisVector_dot z κ hk hk1 hz hq a · change dot (complexBasisVector z κ hk hk1 hz hq a) (complexBasisVector z κ hk hk1 hz hq b) = _ rw [dot_real_left _ _ (Source29TransverseBasis.complexBasisVector_real z κ hk hk1 hz hq a)] simpa using (orthonormal_iff_ite.mp (Source29TransverseBasis.complexBasisVector_orthonormal z κ hk hk1 hz hq)) a b /-- The complex bilinear metric has diagonal entries κ,1,1,1,1,1,1. -/ theorem tangentBasis_metric (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (i j : Fin 7) : dot (tangentBasis z κ hk hk1 hz hq i : CSpace 8) (tangentBasis z κ hk hk1 hz hq j : CSpace 8) = if i = j then (if i = 0 then (κ : ℂ) else 1) else 0 := by rw [tangentBasis_apply, tangentBasis_apply] exact ambientVector_metric z κ hk hk1 hz hq i j end end Source29TangentBasis /- Component: FullNormalChart.inc -/ /- The full affine coordinate chart: normal first, then radial and six transverse directions. -/ namespace Source29FullNormalChart open Source29LocalMaximumBound Source29TangentBasis Matrix open scoped BigOperators noncomputable section abbrev Vec (n : ℕ) := Fin n → ℂ def normalWeight (κ : ℝ) : ℂ := ((-κ*(1-κ^2) : ℝ) : ℂ) def metricWeights (κ : ℝ) : Fin 8 → ℂ := Fin.cons (normalWeight κ) (fun i : Fin 7 => if i = 0 then (κ : ℂ) else 1) lemma normalWeight_ne_zero (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) : normalWeight κ ≠ 0 := by have h : -κ*(1-κ^2) ≠ 0 := by nlinarith [sq_nonneg κ] dsimp [normalWeight] exact_mod_cast h lemma metricWeights_ne_zero (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (i : Fin 8) : metricWeights κ i ≠ 0 := by refine Fin.cases (normalWeight_ne_zero κ hk hk1) (fun j => ?_) i change (if j = 0 then (κ : ℂ) else 1) ≠ 0 split_ifs · exact_mod_cast ne_of_gt hk · exact one_ne_zero def tailVector (x : Vec 8) : CSpace 7 := WithLp.toLp 2 (fun i => x i.succ) def chartMap (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : Vec 8 →ₗ[ℂ] Vec 8 where toFun x := fun i => (tangentEmbedding z κ hk hk1 hz hq (tailVector x) + x 0 • normal z κ) i map_add' x y := by have ht : tailVector (x+y) = tailVector x + tailVector y := rfl funext i simp only [ht, map_add, Pi.add_apply, add_smul, PiLp.add_apply] ring map_smul' a x := by have ht : tailVector (a • x) = a • tailVector x := rfl funext i simp only [ht, map_smul, Pi.smul_apply, PiLp.smul_apply, smul_add, smul_smul, PiLp.add_apply, smul_eq_mul, RingHom.id_apply] ring lemma chartMap_eq_zero (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (x : Vec 8) (hx : chartMap z κ hk hk1 hz hq x = 0) : x = 0 := by have hzero : tangentEmbedding z κ hk hk1 hz hq (tailVector x) + x 0 • normal z κ = 0 := by ext i exact congrFun hx i have hL := congrArg (Source29ComplexTangent.normalCLM κ z) hzero simp only [map_add, tangentEmbedding_normal, map_smul, normalCLM_normal z κ hz hq, map_zero, zero_add, smul_eq_mul] at hL have hx0 : x 0 = 0 := (mul_eq_zero.mp hL).resolve_right (normalWeight_ne_zero κ hk hk1) have ht : tailVector x = 0 := by apply (tangentEmbedding z κ hk hk1 hz hq).injective simpa only [hx0, zero_smul, add_zero, map_zero] using hzero funext i refine Fin.cases hx0 (fun j => ?_) i exact congrArg (fun v : CSpace 7 => v j) ht lemma chartMap_injective (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : Function.Injective (chartMap z κ hk hk1 hz hq) := by intro x y hxy apply sub_eq_zero.mp apply chartMap_eq_zero z κ hk hk1 hz hq rw [map_sub, hxy, sub_self] /-- The invertible finite-coordinate linear map underlying the affine polynomial chart. -/ def chart (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : Vec 8 ≃ₗ[ℂ] Vec 8 := LinearEquiv.ofInjectiveEndo (chartMap z κ hk hk1 hz hq) (chartMap_injective z κ hk hk1 hz hq) /-- The distinguished polynomial variable is precisely the normal displacement. -/ theorem chart_cons (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (w : ℂ) (ζ : Vec 7) : chart z κ hk hk1 hz hq (Fin.cons w ζ) = fun i => (tangentEmbedding z κ hk hk1 hz hq (WithLp.toLp 2 ζ) + w • normal z κ) i := by rfl lemma chart_cons_zero (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (ζ : Vec 7) : chart z κ hk hk1 hz hq (Fin.cons 0 ζ) = fun i => tangentEmbedding z κ hk hk1 hz hq (WithLp.toLp 2 ζ) i := by rw [chart_cons] simp lemma chart_normal (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : chart z κ hk hk1 hz hq (Fin.cons 1 (0 : Vec 7)) = fun i => normal z κ i := by rw [chart_cons] simp def direction (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : Fin 8 → CSpace 8 := Fin.cons (normal z κ) (ambientVector z κ hk hk1 hz hq) lemma chart_single (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (j : Fin 8) : chart z κ hk hk1 hz hq (Pi.single j 1) = fun i => direction z κ hk hk1 hz hq j i := by refine Fin.cases ?_ (fun a => ?_) j · have hs : (Pi.single (0 : Fin 8) (1 : ℂ)) = (Fin.cons (1 : ℂ) (0 : Vec 7) : Vec 8) := by funext i refine Fin.cases (by simp) (fun a => ?_) i simp [Pi.single_apply, Fin.succ_ne_zero] rw [hs, chart_normal] rfl · have hs : (Pi.single a.succ (1 : ℂ)) = (Fin.cons (0 : ℂ) (Pi.single a (1 : ℂ) : Vec 7) : Vec 8) := by funext i refine Fin.cases (by simp [Pi.single_apply, Fin.succ_ne_zero, eq_comm]) (fun b => ?_) i simp [Pi.single_apply] rw [hs, chart_cons_zero] change (fun i => tangentEmbedding z κ hk hk1 hz hq (EuclideanSpace.single a 1) i) = _ rw [tangentEmbedding_single] rfl lemma direction_metric (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (i j : Fin 8) : dot (direction z κ hk hk1 hz hq i) (direction z κ hk hk1 hz hq j) = if i = j then metricWeights κ i else 0 := by refine Fin.cases ?_ (fun a => ?_) i <;> refine Fin.cases ?_ (fun b => ?_) j · change dot (normal z κ) (normal z κ) = _ rw [← normalCLM_eq_dot, normalCLM_normal z κ hz hq] simp [metricWeights, normalWeight] · have h := ambientVector_mem z κ hk hk1 hz hq b change Source29ComplexTangent.normalCLM κ z (ambientVector z κ hk hk1 hz hq b) = 0 at h rw [normalCLM_eq_dot] at h simpa [direction, metricWeights, Fin.succ_ne_zero, eq_comm] using h · rw [dot_comm] have h := ambientVector_mem z κ hk hk1 hz hq a change Source29ComplexTangent.normalCLM κ z (ambientVector z κ hk hk1 hz hq a) = 0 at h rw [normalCLM_eq_dot] at h simpa [direction, metricWeights, Fin.succ_ne_zero, eq_comm] using h · simpa [direction, metricWeights] using ambientVector_metric z κ hk hk1 hz hq a b def chartMatrix (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : Matrix (Fin 8) (Fin 8) ℂ := (chart z κ hk hk1 hz hq).toLinearMap.toMatrix' lemma chartMatrix_apply (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (i j : Fin 8) : chartMatrix z κ hk hk1 hz hq i j = direction z κ hk hk1 hz hq j i := by change chart z κ hk hk1 hz hq (Pi.single j 1) i = _ rw [chart_single] /-- The full covariant metric is diag(c,κ,1,...,1), where c=-κ(1-κ²). -/ theorem chartMatrix_gram (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : (chartMatrix z κ hk hk1 hz hq)ᵀ * chartMatrix z κ hk hk1 hz hq = Matrix.diagonal (metricWeights κ) := by ext i j simpa only [Matrix.mul_apply, Matrix.transpose_apply, chartMatrix_apply, Matrix.diagonal_apply, Source29LocalMaximumBound.dot] using direction_metric z κ hk hk1 hz hq i j lemma chartMatrix_isUnit_det (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : IsUnit (chartMatrix z κ hk hk1 hz hq).det := by apply (Matrix.isUnit_iff_isUnit_det _).mp apply LinearMap.isUnit_toMatrix'_iff.mpr apply (LinearMap.isUnit_iff_ker_eq_bot _).mpr exact LinearMap.ker_eq_bot.mpr (chart z κ hk hk1 hz hq).injective def inverseMetric (κ : ℝ) : Matrix (Fin 8) (Fin 8) ℂ := Matrix.diagonal (fun i => (metricWeights κ i)⁻¹) /-- The inverse metric is diag(c⁻¹,κ⁻¹,1,...,1). -/ theorem chartMatrix_inverseMetric (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : (chartMatrix z κ hk hk1 hz hq)⁻¹ * ((chartMatrix z κ hk hk1 hz hq)⁻¹)ᵀ = inverseMetric κ := by rw [Matrix.transpose_nonsing_inv, ← Matrix.mul_inv_rev, chartMatrix_gram] apply Matrix.inv_eq_right_inv rw [inverseMetric, Matrix.diagonal_mul_diagonal] ext i j simp [Matrix.diagonal_apply, Matrix.one_apply, metricWeights_ne_zero κ hk hk1] lemma metric_mul_inverseMetric (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) : Matrix.diagonal (metricWeights κ) * inverseMetric κ = 1 := by rw [inverseMetric, Matrix.diagonal_mul_diagonal] ext i j simp [Matrix.diagonal_apply, Matrix.one_apply, metricWeights_ne_zero κ hk hk1] lemma inverseMetric_symmetric (κ : ℝ) (i j : Fin 8) : inverseMetric κ i j = inverseMetric κ j i := by by_cases hij : i = j · subst j; rfl · simp [inverseMetric, Matrix.diagonal_apply, hij, Ne.symm hij] lemma inverseMetric_zero_zero (κ : ℝ) : inverseMetric κ 0 0 = (normalWeight κ)⁻¹ := by simp [inverseMetric, metricWeights] lemma inverseMetric_tail (κ : ℝ) (i j : Fin 7) : inverseMetric κ i.succ j.succ = if i = j then (if i = 0 then (κ : ℂ)⁻¹ else 1) else 0 := by simp only [inverseMetric, Matrix.diagonal_apply, Fin.succ_inj, metricWeights, Fin.cons_succ] split_ifs <;> simp_all end end Source29FullNormalChart /- Component: MetricCoordinateChange.inc -/ /- Coordinate covariance of the cubic metric operator. These are identities of derivative arrays; the analytic chain rule is a separate statement. -/ namespace Source29MetricCoordinateChange open Source29MetricJet Matrix open scoped BigOperators noncomputable section variable {R ι : Type*} [CommRing R] [Fintype ι] lemma metricPair_eq_dotProduct (M : Matrix ι ι R) (g b : ι → R) : metricPair M g b = g ⬝ᵥ (M *ᵥ b) := (dot_raiseIndex M g b).symm lemma contract_eq_dotProduct (H : Matrix ι ι R) (v w : ι → R) : contract H v w = v ⬝ᵥ (H *ᵥ w) := metricPair_eq_dotProduct H v w lemma metricTrace_eq_trace (M H : Matrix ι ι R) : metricTrace M H = (M * Hᵀ).trace := by simp only [metricTrace, Matrix.trace, Matrix.diag, Matrix.mul_apply, Matrix.transpose_apply] lemma transpose_mulVec_dotProduct (A : Matrix ι ι R) (u v : ι → R) : (Aᵀ *ᵥ u) ⬝ᵥ v = u ⬝ᵥ (A *ᵥ v) := by rw [dotProduct_comm, Matrix.dotProduct_transpose_mulVec] lemma contract_coordinate_change (A H : Matrix ι ι R) (v w : ι → R) : contract (Aᵀ * H * A) v w = contract H (A *ᵥ v) (A *ᵥ w) := by rw [contract_eq_dotProduct, ← Matrix.mulVec_mulVec, ← Matrix.mulVec_mulVec] rw [Matrix.dotProduct_transpose_mulVec, dotProduct_comm, contract_eq_dotProduct] lemma inverseMetric_symmetric (B : Matrix ι ι R) (i j : ι) : (B * Bᵀ) i j = (B * Bᵀ) j i := by simp only [Matrix.mul_apply, Matrix.transpose_apply, mul_comm] variable [DecidableEq ι] lemma inverse_transpose_cancel (A B : Matrix ι ι R) (hAB : A * B = 1) : Bᵀ * Aᵀ = 1 := by rw [← Matrix.transpose_mul, hAB, Matrix.transpose_one] lemma raiseIndex_coordinate_change (A B M : Matrix ι ι R) (hAB : A * B = 1) (g : ι → R) : raiseIndex (B * M * Bᵀ) (Aᵀ *ᵥ g) = B *ᵥ (M *ᵥ g) := by change (B * M * Bᵀ) *ᵥ (Aᵀ *ᵥ g) = B *ᵥ (M *ᵥ g) rw [Matrix.mulVec_mulVec, Matrix.mul_assoc (B * M), inverse_transpose_cancel A B hAB, Matrix.mul_one, Matrix.mulVec_mulVec] lemma metricPair_coordinate_change (A B M : Matrix ι ι R) (hAB : A * B = 1) (g b : ι → R) : metricPair (B * M * Bᵀ) (Aᵀ *ᵥ g) (Aᵀ *ᵥ b) = metricPair M g b := by have hr : (B * M * Bᵀ) *ᵥ (Aᵀ *ᵥ b) = B *ᵥ (M *ᵥ b) := raiseIndex_coordinate_change A B M hAB b rw [metricPair_eq_dotProduct, hr] rw [transpose_mulVec_dotProduct, Matrix.mulVec_mulVec, hAB, Matrix.one_mulVec, metricPair_eq_dotProduct] lemma metricTrace_coordinate_change (A B M H : Matrix ι ι R) (hAB : A * B = 1) : metricTrace (B * M * Bᵀ) (Aᵀ * H * A) = metricTrace M H := by rw [metricTrace_eq_trace, metricTrace_eq_trace] simp only [Matrix.transpose_mul, Matrix.transpose_transpose] calc ((B * M * Bᵀ) * (Aᵀ * (Hᵀ * A))).trace = (B * M * (Bᵀ * Aᵀ) * Hᵀ * A).trace := by simp only [Matrix.mul_assoc] _ = (B * M * Hᵀ * A).trace := by rw [inverse_transpose_cancel A B hAB, Matrix.mul_one] _ = (A * (B * M * Hᵀ)).trace := Matrix.trace_mul_comm _ _ _ = (M * Hᵀ).trace := by simp only [← Matrix.mul_assoc, hAB, Matrix.one_mul] /-- Under x=A y the covector is Aᵀ g and the Hessian is Aᵀ H A. The inverse metric is B M Bᵀ, where B is an inverse of A. The cubic operator is unchanged. Symmetry of either input matrix is unnecessary. -/ theorem operator_coordinate_change (A B M : Matrix ι ι R) (hAB : A * B = 1) (g : ι → R) (H : Matrix ι ι R) : operator (B * M * Bᵀ) (Aᵀ *ᵥ g) (Aᵀ * H * A) = operator M g H := by unfold operator rw [metricPair_coordinate_change A B M hAB, metricTrace_coordinate_change A B M H hAB, raiseIndex_coordinate_change A B M hAB, contract_coordinate_change] rw [Matrix.mulVec_mulVec, hAB, Matrix.one_mulVec] rfl /-- Euclidean specialization: the inverse metric in the y coordinates is A⁻¹ A⁻ᵀ. Over the complex numbers the transpose is bilinear, with no conjugation. -/ theorem operator_euclidean_coordinate_change (A : Matrix ι ι R) (hA : IsUnit A.det) (g : ι → R) (H : Matrix ι ι R) : operator (A⁻¹ * (A⁻¹)ᵀ) (Aᵀ *ᵥ g) (Aᵀ * H * A) = operator (1 : Matrix ι ι R) g H := by simpa only [Matrix.mul_one] using operator_coordinate_change A A⁻¹ 1 (Matrix.mul_nonsing_inv A hA) g H lemma operator_identity (g : ι → R) (H : Matrix ι ι R) : operator (1 : Matrix ι ι R) g H = (∑ i, g i ^ 2) * (∑ i, H i i) - ∑ i, ∑ j, H i j * g i * g j := by simp [operator, metricPair, metricTrace, raiseIndex, contract, Matrix.one_apply, pow_two] /-- The transformed operator is the usual Euclidean cubic polynomial in the original gradient and Hessian entries. -/ theorem operator_euclidean_coordinate_formula (A : Matrix ι ι R) (hA : IsUnit A.det) (g : ι → R) (H : Matrix ι ι R) : operator (A⁻¹ * (A⁻¹)ᵀ) (Aᵀ *ᵥ g) (Aᵀ * H * A) = (∑ i, g i ^ 2) * (∑ i, H i i) - ∑ i, ∑ j, H i j * g i * g j := by rw [operator_euclidean_coordinate_change A hA, operator_identity] end end Source29MetricCoordinateChange /- Component: AnalyticJetRules.inc -/ /- Analytic chain and product rules for the first two derivative arrays. -/ namespace Source29AnalyticJetRules open Filter Source29MetricJet open scoped Topology BigOperators noncomputable section variable {E F : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] [NormedAddCommGroup F] [NormedSpace ℂ F] lemma analyticAt_directional (f : E → ℂ) (x v : E) (hf : AnalyticAt ℂ f x) : AnalyticAt ℂ (fun y => fderiv ℂ f y v) x := AnalyticAt.comp (f := fderiv ℂ f) (g := fun L : E →L[ℂ] ℂ => L v) ((ContinuousLinearMap.apply ℂ ℂ v).analyticAt _) hf.fderiv lemma directional_second (f : E → ℂ) (x u v : E) (hf : AnalyticAt ℂ f x) : fderiv ℂ (fun y => fderiv ℂ f y v) x u = fderiv ℂ (fderiv ℂ f) x u v := by have h := (ContinuousLinearMap.apply ℂ ℂ v).hasFDerivAt.comp x hf.fderiv.differentiableAt.hasFDerivAt exact congrArg (fun L : E →L[ℂ] ℂ => L u) h.fderiv lemma fderiv_affine (f : F → ℂ) (A : E →L[ℂ] F) (z : F) (x u : E) (hf : AnalyticAt ℂ f (z + A x)) : fderiv ℂ (fun y => f (z + A y)) x u = fderiv ℂ f (z + A x) (A u) := by have hA : HasFDerivAt (fun y => z + A y) A x := A.hasFDerivAt.const_add z exact congrArg (fun L : E →L[ℂ] ℂ => L u) (hf.differentiableAt.hasFDerivAt.comp x hA).fderiv theorem hessian_affine (f : F → ℂ) (A : E →L[ℂ] F) (z : F) (x u v : E) (hf : AnalyticAt ℂ f (z + A x)) : fderiv ℂ (fderiv ℂ (fun y => f (z + A y))) x u v = fderiv ℂ (fderiv ℂ f) (z + A x) (A u) (A v) := by have hA : AnalyticAt ℂ (fun y => z + A y) x := analyticAt_const.add (A.analyticAt x) have hc : AnalyticAt ℂ (fun y => f (z + A y)) x := AnalyticAt.comp (f := fun y => z + A y) (g := f) hf hA rw [← directional_second _ x u v hc] have heq : (fun y => fderiv ℂ (fun t => f (z + A t)) y v) =ᶠ[𝓝 x] (fun y => fderiv ℂ f (z + A y) (A v)) := by filter_upwards [hA.continuousAt.tendsto.eventually hf.eventually_analyticAt] with y hy exact fderiv_affine f A z y v hy rw [heq.fderiv_eq] rw [fderiv_affine _ A z x u (analyticAt_directional f _ (A v) hf), directional_second f _ (A u) (A v) hf] lemma fderiv_product (U f : E → ℂ) (x v : E) (hU : AnalyticAt ℂ U x) (hf : AnalyticAt ℂ f x) : fderiv ℂ (fun y => U y * f y) x v = U x * fderiv ℂ f x v + f x * fderiv ℂ U x v := by rw [fderiv_fun_mul hU.differentiableAt hf.differentiableAt] rfl theorem hessian_product (U f : E → ℂ) (x u v : E) (hU : AnalyticAt ℂ U x) (hf : AnalyticAt ℂ f x) : fderiv ℂ (fderiv ℂ (fun y => U y * f y)) x u v = U x * fderiv ℂ (fderiv ℂ f) x u v + f x * fderiv ℂ (fderiv ℂ U) x u v + fderiv ℂ f x u * fderiv ℂ U x v + fderiv ℂ U x u * fderiv ℂ f x v := by rw [← directional_second (fun y => U y * f y) x u v (hU.mul hf)] have heq : (fun y => fderiv ℂ (fun t => U t * f t) y v) =ᶠ[𝓝 x] (fun y => U y * fderiv ℂ f y v + f y * fderiv ℂ U y v) := by filter_upwards [hU.eventually_analyticAt, hf.eventually_analyticAt] with y hyU hyf exact fderiv_product U f y v hyU hyf rw [heq.fderiv_eq] have hDf := analyticAt_directional f x v hf have hDU := analyticAt_directional U x v hU rw [fderiv_fun_add (f := fun y => U y * fderiv ℂ f y v) (g := fun y => f y * fderiv ℂ U y v) (hU.mul hDf).differentiableAt (hf.mul hDU).differentiableAt] simp only [add_apply] rw [fderiv_product U _ x u hU hDf, fderiv_product f _ x u hf hDU, directional_second f x u v hf, directional_second U x u v hU] ring variable {ι : Type*} [Fintype ι] /-- Cubic metric expression evaluated on the actual derivatives in fixed directions. The directions need not be a basis. -/ def jetOperator (M : ι → ι → ℂ) (e : ι → E) (f : E → ℂ) (x : E) : ℂ := operator M (fun i => fderiv ℂ f x (e i)) (fun i j => fderiv ℂ (fderiv ℂ f) x (e i) (e j)) theorem jetOperator_affine (M : ι → ι → ℂ) (e : ι → E) (f : F → ℂ) (A : E →L[ℂ] F) (z : F) (x : E) (hf : AnalyticAt ℂ f (z + A x)) : jetOperator M e (fun y => f (z + A y)) x = jetOperator M (fun i => A (e i)) f (z + A x) := by unfold jetOperator simp_rw [fderiv_affine f A z x _ hf, hessian_affine f A z x _ _ hf] /-- Multiplication of a local defining function by an analytic factor scales its cubic metric expression by the cube of the factor at a zero. -/ theorem jetOperator_product_at_zero (M : ι → ι → ℂ) (hM : ∀ i j, M i j = M j i) (e : ι → E) (U f : E → ℂ) (x : E) (hU : AnalyticAt ℂ U x) (hf : AnalyticAt ℂ f x) (hf0 : f x = 0) : jetOperator M e (fun y => U y * f y) x = U x ^ 3 * jetOperator M e f x := by unfold jetOperator simp_rw [fderiv_product U f x _ hU hf, hessian_product U f x _ _ hU hf, hf0, zero_mul, add_zero] exact defining_function_unit_identity M hM _ _ _ (U x) theorem jetOperator_congr (M : ι → ι → ℂ) (e : ι → E) (f g : E → ℂ) (x : E) (hfg : f =ᶠ[𝓝 x] g) : jetOperator M e f x = jetOperator M e g x := by unfold jetOperator rw [hfg.fderiv_eq, (hfg.fderiv (𝕜 := ℂ)).fderiv_eq] /-- A local analytic unit can be removed from a defining equation at a zero. The factorization is needed only as an equality of germs near the point. -/ theorem jetOperator_zero_of_analytic_unit (M : ι → ι → ℂ) (hM : ∀ i j, M i j = M j i) (e : ι → E) (h U f : E → ℂ) (x : E) (hU : AnalyticAt ℂ U x) (hf : AnalyticAt ℂ f x) (hf0 : f x = 0) (hU0 : U x ≠ 0) (hlocal : h =ᶠ[𝓝 x] (fun y => U y * f y)) (hL : jetOperator M e h x = 0) : jetOperator M e f x = 0 := by rw [jetOperator_congr M e h _ x hlocal, jetOperator_product_at_zero M hM e U f x hU hf hf0] at hL exact (mul_eq_zero.mp hL).resolve_left (pow_ne_zero _ hU0) end end Source29AnalyticJetRules /- Component: AnalyticMetricCoordinate.inc -/ /- Coordinate covariance for actual analytic derivatives. -/ namespace Source29AnalyticMetricCoordinate open Matrix Source29MetricJet Source29MetricCoordinateChange Source29AnalyticJetRules open scoped BigOperators noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] variable {ι : Type*} [Fintype ι] def coordinateDirections (e : ι → E) (A : Matrix ι ι ℂ) (j : ι) : E := ∑ i, A i j • e i lemma gradient_coordinateDirections (e : ι → E) (A : Matrix ι ι ℂ) (D : E →L[ℂ] ℂ) : (fun j => D (coordinateDirections e A j)) = Aᵀ *ᵥ (fun i => D (e i)) := by funext j simp [coordinateDirections, Matrix.mulVec, dotProduct, map_sum, map_smul] lemma hessian_coordinateDirections (e : ι → E) (A : Matrix ι ι ℂ) (D : E →L[ℂ] E →L[ℂ] ℂ) : (fun i j => D (coordinateDirections e A i) (coordinateDirections e A j)) = Aᵀ * (show Matrix ι ι ℂ from fun i j => D (e i) (e j)) * A := by funext i j change D (coordinateDirections e A i) (coordinateDirections e A j) = ∑ l, (∑ k, A k i * D (e k) (e l)) * A l j simp only [coordinateDirections, map_sum, map_smul, _root_.sum_apply, _root_.smul_apply, smul_eq_mul, Finset.sum_mul, Finset.mul_sum] apply Finset.sum_congr rfl intro k _ apply Finset.sum_congr rfl intro l _ ring variable [DecidableEq ι] /-- Covariance for actual Fréchet derivatives in any fixed finite family of directions. Analyticity is unnecessary for this purely linear step. -/ theorem jetOperator_coordinateDirections (e : ι → E) (A B M : Matrix ι ι ℂ) (hAB : A * B = 1) (f : E → ℂ) (x : E) : jetOperator (B * M * Bᵀ) (coordinateDirections e A) f x = jetOperator M e f x := by unfold jetOperator rw [gradient_coordinateDirections, hessian_coordinateDirections] exact operator_coordinate_change A B M hAB _ _ def coordinateMatrix (A : (ι → ℂ) →L[ℂ] (ι → ℂ)) : Matrix ι ι ℂ := fun i j => A (Pi.single j 1) i lemma coordinateMatrix_directions (A : (ι → ℂ) →L[ℂ] (ι → ℂ)) : coordinateDirections (fun i => Pi.single i 1) (coordinateMatrix A) = fun i => A (Pi.single i 1) := by funext j exact (pi_eq_sum_univ' (A (Pi.single j 1))).symm /-- The analytic affine chain rule and matrix covariance combined. The inverse relation is stated for the concrete matrix of the coordinate map. -/ theorem jetOperator_affine_coordinates (A : (ι → ℂ) →L[ℂ] (ι → ℂ)) (B M : Matrix ι ι ℂ) (hAB : coordinateMatrix A * B = 1) (f : (ι → ℂ) → ℂ) (z x : ι → ℂ) (hf : AnalyticAt ℂ f (z + A x)) : jetOperator (B * M * Bᵀ) (fun i => Pi.single i 1) (fun y => f (z + A y)) x = jetOperator M (fun i => Pi.single i 1) f (z + A x) := by calc _ = jetOperator (B * M * Bᵀ) (fun i => A (Pi.single i 1)) f (z + A x) := jetOperator_affine (B * M * Bᵀ) _ f A z x hf _ = _ := by simpa only [coordinateMatrix_directions] using jetOperator_coordinateDirections (fun i => Pi.single i 1) (coordinateMatrix A) B M hAB f (z + A x) theorem jetOperator_euclidean_affine_coordinates (A : (ι → ℂ) →L[ℂ] (ι → ℂ)) (hA : IsUnit (coordinateMatrix A).det) (f : (ι → ℂ) → ℂ) (z x : ι → ℂ) (hf : AnalyticAt ℂ f (z + A x)) : jetOperator ((coordinateMatrix A)⁻¹ * ((coordinateMatrix A)⁻¹)ᵀ) (fun i => Pi.single i 1) (fun y => f (z + A y)) x = jetOperator (1 : Matrix ι ι ℂ) (fun i => Pi.single i 1) f (z + A x) := by simpa only [Matrix.mul_one] using jetOperator_affine_coordinates A (coordinateMatrix A)⁻¹ 1 (Matrix.mul_nonsing_inv (coordinateMatrix A) hA) f z x hf end end Source29AnalyticMetricCoordinate /- Component: AnalyticGraphEquation.inc -/ /- Deriving the metric graph PDE from an analytic local defining equation. -/ namespace Source29AnalyticGraphEquation open Filter Source29MetricJet Source29AnalyticJetRules open scoped Topology BigOperators noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] def graphFunction (f : E → ℂ) (p : ℂ × E) : ℂ := p.1 - f p.2 lemma analyticAt_graphFunction (f : E → ℂ) (x : ℂ × E) (hf : AnalyticAt ℂ f x.2) : AnalyticAt ℂ (graphFunction f) x := by exact ((ContinuousLinearMap.fst ℂ ℂ E).analyticAt x).sub (AnalyticAt.comp (f := fun p : ℂ × E => p.2) (g := f) hf ((ContinuousLinearMap.snd ℂ ℂ E).analyticAt x)) lemma fderiv_graphFunction (f : E → ℂ) (x v : ℂ × E) (hf : AnalyticAt ℂ f x.2) : fderiv ℂ (graphFunction f) x v = v.1 - fderiv ℂ f x.2 v.2 := by have hd := hf.differentiableAt.hasFDerivAt.comp x (ContinuousLinearMap.snd ℂ ℂ E).hasFDerivAt exact congrArg (fun L : (ℂ × E) →L[ℂ] ℂ => L v) ((ContinuousLinearMap.fst ℂ ℂ E).hasFDerivAt.sub hd).fderiv lemma hessian_graphFunction (f : E → ℂ) (x u v : ℂ × E) (hf : AnalyticAt ℂ f x.2) : fderiv ℂ (fderiv ℂ (graphFunction f)) x u v = -fderiv ℂ (fderiv ℂ f) x.2 u.2 v.2 := by rw [← directional_second _ x u v (analyticAt_graphFunction f x hf)] have heq : (fun y => fderiv ℂ (graphFunction f) y v) =ᶠ[𝓝 x] (fun y : ℂ × E => v.1 - fderiv ℂ f y.2 v.2) := by filter_upwards [((ContinuousLinearMap.snd ℂ ℂ E).continuous.continuousAt.tendsto.eventually hf.eventually_analyticAt)] with y hy exact fderiv_graphFunction f y v hy rw [heq.fderiv_eq, fderiv_const_sub] have hd := (analyticAt_directional f x.2 v.2 hf).differentiableAt.hasFDerivAt.comp x (ContinuousLinearMap.snd ℂ ℂ E).hasFDerivAt have hv := congrArg (fun L : (ℂ × E) →L[ℂ] ℂ => L u) hd.fderiv have hv' : fderiv ℂ (fun y : ℂ × E => fderiv ℂ f y.2 v.2) x u = fderiv ℂ (fun y : E => fderiv ℂ f y v.2) x.2 u.2 := hv change -(fderiv ℂ (fun y : ℂ × E => fderiv ℂ f y.2 v.2) x u) = _ rw [hv'] rw [directional_second f x.2 u.2 v.2 hf] variable {ι : Type*} def graphDirections (e : ι → E) : Option ι → ℂ × E | none => (1, 0) | some i => (0, e i) lemma graph_gradient (e : ι → E) (f : E → ℂ) (x : ℂ × E) (hf : AnalyticAt ℂ f x.2) : (fun i => fderiv ℂ (graphFunction f) x (graphDirections e i)) = graphCovector (fun i => fderiv ℂ f x.2 (e i)) := by funext i cases i <;> simp [fderiv_graphFunction f x _ hf, graphDirections, graphCovector] lemma graph_hessian (e : ι → E) (f : E → ℂ) (x : ℂ × E) (hf : AnalyticAt ℂ f x.2) : (fun i j => fderiv ℂ (fderiv ℂ (graphFunction f)) x (graphDirections e i) (graphDirections e j)) = graphHessian (fun i j => fderiv ℂ (fderiv ℂ f) x.2 (e i) (e j)) := by funext i j cases i <;> cases j <;> simp [hessian_graphFunction f x _ _ hf, graphDirections, graphHessian] variable [Fintype ι] /-- A zero of the metric implicit operator yields the exact graph equation for actual derivatives of an analytic graph. -/ theorem graph_equation_of_jetOperator_zero (M : ι → ι → ℂ) (c d : ℂ) (hcd : c * d = 1) (e : ι → E) (f : E → ℂ) (x : ℂ × E) (hf : AnalyticAt ℂ f x.2) (hL : jetOperator (blockMetric M d) (graphDirections e) (graphFunction f) x = 0) : let g := fun i => fderiv ℂ f x.2 (e i) let H := fun i j => fderiv ℂ (fderiv ℂ f) x.2 (e i) (e j) (1 + c * metricPair M g g) * metricTrace M H - c * contract H (raiseIndex M g) (raiseIndex M g) = 0 := by unfold jetOperator at hL rw [graph_gradient e f x hf, graph_hessian e f x hf] at hL exact graph_equation_of_operator_zero M c d hcd _ _ hL /-- If an analytic local equation is a nonzero analytic unit times w-f, its zero implicit operator gives the graph PDE. No derivative-array assumptions are required. -/ theorem graph_equation_of_local_unit (M : ι → ι → ℂ) (hM : ∀ i j, M i j = M j i) (c d : ℂ) (hcd : c * d = 1) (e : ι → E) (h U : (ℂ × E) → ℂ) (f : E → ℂ) (x : ℂ × E) (hf : AnalyticAt ℂ f x.2) (hU : AnalyticAt ℂ U x) (hx : x.1 = f x.2) (hU0 : U x ≠ 0) (hlocal : h =ᶠ[𝓝 x] (fun y => U y * graphFunction f y)) (hL : jetOperator (blockMetric M d) (graphDirections e) h x = 0) : let g := fun i => fderiv ℂ f x.2 (e i) let H := fun i j => fderiv ℂ (fderiv ℂ f) x.2 (e i) (e j) (1 + c * metricPair M g g) * metricTrace M H - c * contract H (raiseIndex M g) (raiseIndex M g) = 0 := by have hblock : ∀ i j, blockMetric M d i j = blockMetric M d j i := by intro i j cases i <;> cases j <;> simp [blockMetric, hM] apply graph_equation_of_jetOperator_zero M c d hcd e f x hf exact jetOperator_zero_of_analytic_unit (blockMetric M d) hblock (graphDirections e) h U (graphFunction f) x hU (analyticAt_graphFunction f x hf) (by simp [graphFunction, hx]) hU0 hlocal hL end end Source29AnalyticGraphEquation /- Component: MvPolynomialJet.inc -/ /- Identifying polynomial partial derivatives with analytic derivatives. -/ namespace Source29MvPolynomialJet open MvPolynomial Source29MetricJet Source29MetricCoordinateChange Source29AnalyticJetRules open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem analyticAt_eval (P : MvPolynomial ι ℂ) (x : ι → ℂ) : AnalyticAt ℂ (fun y => eval y P) x := by induction P using MvPolynomial.induction_on with | C c => simpa only [eval_C] using (analyticAt_const : AnalyticAt ℂ (fun _ : ι → ℂ => c) x) | add p q hp hq => simpa only [eval_add, Pi.add_def] using hp.add hq | mul_X p j hp => have hq : AnalyticAt ℂ (fun y : ι → ℂ => y j) x := (ContinuousLinearMap.proj j : (ι → ℂ) →L[ℂ] ℂ).analyticAt x simpa only [eval_mul, eval_X, Pi.mul_def] using hp.mul hq theorem fderiv_eval_single (P : MvPolynomial ι ℂ) (x : ι → ℂ) (i : ι) : fderiv ℂ (fun y => eval y P) x (Pi.single i 1) = eval x (pderiv i P) := by induction P using MvPolynomial.induction_on with | C c => simp | add p q hp hq => simp only [eval_add, map_add] rw [fderiv_fun_add (analyticAt_eval p x).differentiableAt (analyticAt_eval q x).differentiableAt] simpa only [add_apply] using congrArg₂ (· + ·) hp hq | mul_X p j hp => have hc : fderiv ℂ (fun y : ι → ℂ => y j) x (Pi.single i 1) = (Pi.single i (1 : ℂ) : ι → ℂ) j := by exact congrArg (fun L : (ι → ℂ) →L[ℂ] ℂ => L (Pi.single i (1 : ℂ) : ι → ℂ)) (ContinuousLinearMap.proj j : (ι → ℂ) →L[ℂ] ℂ).fderiv simp only [eval_mul, eval_X] rw [fderiv_product (fun y => eval y p) (fun y => y j) x (Pi.single i 1) (analyticAt_eval p x) ((ContinuousLinearMap.proj j : (ι → ℂ) →L[ℂ] ℂ).analyticAt x), hp, hc] by_cases hij : i = j · subst j simp [pderiv_mul, mul_comm, add_comm] · simp [pderiv_mul, pderiv_X, hij, Ne.symm hij, Pi.single_apply] theorem hessian_eval_single (P : MvPolynomial ι ℂ) (x : ι → ℂ) (i j : ι) : fderiv ℂ (fderiv ℂ (fun y => eval y P)) x (Pi.single i 1) (Pi.single j 1) = eval x (pderiv i (pderiv j P)) := by rw [← directional_second _ x (Pi.single i 1) (Pi.single j 1) (analyticAt_eval P x)] simp_rw [fderiv_eval_single P _ j] exact fderiv_eval_single (pderiv j P) x i /-- Evaluation of the polynomial cubic operator is precisely the Euclidean analytic derivative expression, with the same order of partial derivatives. -/ theorem jetOperator_eval (P : MvPolynomial ι ℂ) (x : ι → ℂ) : jetOperator (1 : Matrix ι ι ℂ) (fun i => Pi.single i 1) (fun y => eval y P) x = eval x (Source29FactorInheritance.cubicOperator P) := by change operator (1 : Matrix ι ι ℂ) (fun i => fderiv ℂ (fun y => eval y P) x (Pi.single i (1 : ℂ))) (show Matrix ι ι ℂ from fun i j => fderiv ℂ (fderiv ℂ (fun y => eval y P)) x (Pi.single i (1 : ℂ)) (Pi.single j (1 : ℂ))) = _ rw [operator_identity] simp_rw [fderiv_eval_single, hessian_eval_single] simp only [Source29FactorInheritance.cubicOperator, map_sub, map_mul, map_sum, map_pow] simp only [mul_comm, mul_left_comm, mul_assoc] theorem jetOperator_eval_zero_of_dvd (P : MvPolynomial ι ℂ) (hP : P ∣ Source29FactorInheritance.cubicOperator P) (x : ι → ℂ) (hx : eval x P = 0) : jetOperator (1 : Matrix ι ι ℂ) (fun i => Pi.single i 1) (fun y => eval y P) x = 0 := by rw [jetOperator_eval] obtain ⟨Q, hQ⟩ := hP rw [hQ, map_mul, hx, zero_mul] end end Source29MvPolynomialJet /- Component: RootLocalChartsAlgebra.lean -/ namespace Source29RootLocalCharts open Polynomial noncomputable section lemma roots_nodup_of_simple (P : Polynomial ℂ) (hP : P ≠ 0) (hsimple : ∀ z, P.eval z = 0 → P.derivative.eval z ≠ 0) : P.roots.Nodup := by classical apply Multiset.nodup_iff_count_le_one.mpr intro z rw [Polynomial.count_roots] by_contra h have hm : 1 < P.rootMultiplicity z := Nat.lt_of_not_ge h have hh := (Polynomial.one_lt_rootMultiplicity_iff_isRoot hP).mp hm exact hsimple z hh.1 hh.2 /-- A full set of distinct roots determines the entire root multiset. -/ lemma roots_eq_of_distinct_full_tuple (P : Polynomial ℂ) (s : ℕ) (hP : P ≠ 0) (hdegree : P.natDegree ≤ s) (r : Fin s → ℂ) (hinj : Function.Injective r) (hroot : ∀ i, P.eval (r i) = 0) : (List.ofFn r : Multiset ℂ) = P.roots := by classical let S : Finset ℂ := Finset.univ.map ⟨r, hinj⟩ have hc : S.card = s := by simp [S] have hr : ∀ z ∈ S, P.eval z = 0 := by intro z hz obtain ⟨i, _, rfl⟩ := Finset.mem_map.mp hz exact hroot i have he : P.roots = S.val := Polynomial.roots_eq_of_natDegree_le_card_of_ne_zero hr (by simpa only [hc] using hdegree) hP rw [he] symm change Finset.univ.val.map r = (List.ofFn r : Multiset ℂ) exact Fin.univ_val_map r lemma exhaustive_of_root_multiset (P : Polynomial ℂ) (s : ℕ) (hP : P ≠ 0) (r : Fin s → ℂ) (hr : (List.ofFn r : Multiset ℂ) = P.roots) (z : ℂ) : P.eval z = 0 ↔ ∃ i, r i = z := by change P.IsRoot z ↔ ∃ i, r i = z rw [← Polynomial.mem_roots hP, ← hr] exact List.mem_ofFn end end Source29RootLocalCharts /- Component: RootLocalCharts.inc -/ namespace Source29RootLocalCharts open Polynomial Filter open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] /-- All simple roots of the initial polynomial extend to a single finite analytic chart. Distinctness and exhaustiveness hold on one open neighborhood. -/ theorem exists_local_root_charts_of_split (P : E → Polynomial ℂ) (a : E) (s : ℕ) (hs : 0 < s) (hmonic : ∀ x, (P x).Monic) (hdegree : ∀ x, (P x).natDegree = s) (hcoeff : ∀ k, AnalyticAt ℂ (fun x => (P x).coeff k) a) (hsplit : (P a).Splits) (hsimple : ∀ z, (P a).eval z = 0 → (P a).derivative.eval z ≠ 0) : ∃ f : Fin s → E → ℂ, ∃ U : Set E, IsOpen U ∧ a ∈ U ∧ (∀ i, AnalyticOnNhd ℂ (f i) U) ∧ (∀ x ∈ U, Function.Injective (fun i => f i x)) ∧ (∀ x ∈ U, (List.ofFn (fun i => f i x) : Multiset ℂ) = (P x).roots) ∧ (∀ x ∈ U, ∀ z, (P x).eval z = 0 ↔ ∃ i, f i x = z) := by classical obtain ⟨r, hr, hroot, -, -⟩ := Source29RootEnumeration.exists_root_tuple (P a) s (hmonic a) (hdegree a) hs hsplit have hrinj : Function.Injective r := by apply List.nodup_ofFn.mp apply Multiset.coe_nodup.mp rw [hr] exact roots_nodup_of_simple (P a) (hmonic a).ne_zero hsimple have hlocal (i : Fin s) := Source29AnalyticSimpleRoot.exists_local_analytic_root P a s (r i) (fun x => (hdegree x).le) hcoeff (hroot i) (hsimple (r i) (hroot i)) choose f hf hfa hfroot hfuniq using hlocal have han : ∀ᶠ x in 𝓝 a, ∀ i, AnalyticAt ℂ (f i) x := Filter.eventually_all.mpr (fun i => (hf i).eventually_analyticAt) have hroots : ∀ᶠ x in 𝓝 a, ∀ i, (P x).eval (f i x) = 0 := Filter.eventually_all.mpr hfroot have hpairs (i j : Fin s) : ∀ᶠ x in 𝓝 a, f i x = f j x → i = j := by by_cases hij : i = j · exact Filter.Eventually.of_forall (fun _ _ => hij) have hne : f i a - f j a ≠ 0 := by rw [hfa i, hfa j] exact sub_ne_zero.mpr (hrinj.ne hij) have he := ((hf i).continuousAt.sub (hf j).continuousAt).eventually_ne hne filter_upwards [he] with x hx heq exact False.elim (hx (sub_eq_zero.mpr heq)) have hinj : ∀ᶠ x in 𝓝 a, Function.Injective (fun i => f i x) := Filter.eventually_all.mpr (fun i => Filter.eventually_all.mpr (hpairs i)) obtain ⟨U, hU, hUopen, haU⟩ := mem_nhds_iff.mp (han.and (hinj.and hroots)) refine ⟨f, U, hUopen, haU, ?_, ?_, ?_, ?_⟩ · intro i x hx exact (hU hx).1 i · intro x hx exact (hU hx).2.1 · intro x hx exact roots_eq_of_distinct_full_tuple (P x) s (hmonic x).ne_zero (hdegree x).le (fun i => f i x) (hU hx).2.1 (hU hx).2.2 · intro x hx z apply exhaustive_of_root_multiset (P x) s (hmonic x).ne_zero (fun i => f i x) exact roots_eq_of_distinct_full_tuple (P x) s (hmonic x).ne_zero (hdegree x).le (fun i => f i x) (hU hx).2.1 (hU hx).2.2 /-- Over the complex numbers no splitting hypothesis is needed. -/ theorem exists_local_root_charts (P : E → Polynomial ℂ) (a : E) (s : ℕ) (hs : 0 < s) (hmonic : ∀ x, (P x).Monic) (hdegree : ∀ x, (P x).natDegree = s) (hcoeff : ∀ k, AnalyticAt ℂ (fun x => (P x).coeff k) a) (hsimple : ∀ z, (P a).eval z = 0 → (P a).derivative.eval z ≠ 0) : ∃ f : Fin s → E → ℂ, ∃ U : Set E, IsOpen U ∧ a ∈ U ∧ (∀ i, AnalyticOnNhd ℂ (f i) U) ∧ (∀ x ∈ U, Function.Injective (fun i => f i x)) ∧ (∀ x ∈ U, (List.ofFn (fun i => f i x) : Multiset ℂ) = (P x).roots) ∧ (∀ x ∈ U, ∀ z, (P x).eval z = 0 ↔ ∃ i, f i x = z) := by letI : IsAlgClosed ℂ := Source29FTA.complex_isAlgClosed exact exists_local_root_charts_of_split P a s hs hmonic hdegree hcoeff (IsAlgClosed.splits _) hsimple end end Source29RootLocalCharts /- Component: RootCover.inc -/ namespace Source29RootCover open Filter Topology open scoped Topology noncomputable section variable {X : Type*} [TopologicalSpace X] abbrev RootSpace (R : X → ℂ → Prop) := {p : X × ℂ // R p.1 p.2} def projection (R : X → ℂ → Prop) : RootSpace R → X := fun p => p.1.1 lemma continuous_projection (R : X → ℂ → Prop) : Continuous (projection R) := by exact continuous_fst.comp continuous_subtype_val /-- Extend one local root branch to a total section-valued function by a fixed root-space point outside its domain. Only its local values are used. -/ def localSection (R : X → ℂ → Prop) (U : Set X) (f : X → ℂ) (hroot : ∀ x ∈ U, R x (f x)) (e : RootSpace R) : X → RootSpace R := by classical exact fun x => if hx : x ∈ U then ⟨(x, f x), hroot x hx⟩ else e lemma localSection_apply (R : X → ℂ → Prop) (U : Set X) (f : X → ℂ) (hroot : ∀ x ∈ U, R x (f x)) (e : RootSpace R) (x : X) (hx : x ∈ U) : (localSection R U f hroot e x).1 = (x, f x) := by simp [localSection, hx] lemma continuousOn_localSection (R : X → ℂ → Prop) (U : Set X) (f : X → ℂ) (hroot : ∀ x ∈ U, R x (f x)) (e : RootSpace R) (hf : ContinuousOn f U) : ContinuousOn (localSection R U f hroot e) U := by rw [continuousOn_iff_continuous_domRestrict] have hfU : Continuous (fun x : U => f x) := continuousOn_iff_continuous_domRestrict.mp hf have hc : Continuous (fun x : U => (⟨((x : X), f x), hroot x x.2⟩ : RootSpace R)) := by apply continuous_induced_rng.mpr exact continuous_subtype_val.prodMk hfU convert hc using 1 funext x simp [Set.domRestrict, localSection, x.2] /-- Exhaustive local root charts provide the common-neighborhood sections needed by the interval-lifting theorem. Distinctness is not needed here. -/ theorem hasLocalSections_of_charts (R : X → ℂ → Prop) (s : ℕ) (hcharts : ∀ a : X, ∃ f : Fin s → X → ℂ, ∃ U : Set X, IsOpen U ∧ a ∈ U ∧ (∀ i, ContinuousOn (f i) U) ∧ ∀ x ∈ U, ∀ z, R x z ↔ ∃ i, f i x = z) : Source29RadialLift.HasLocalSections (projection R) := by intro a obtain ⟨f, U, hUopen, haU, hf, hex⟩ := hcharts a refine ⟨U, haU, hUopen, ?_⟩ intro e he obtain ⟨i, hi⟩ := (hex (projection R e) he e.1.2).mp e.2 have hroot : ∀ x ∈ U, R x (f i x) := fun x hx => (hex x hx _).mpr ⟨i, rfl⟩ refine ⟨localSection R U (f i) hroot e, continuousOn_localSection R U (f i) hroot e (hf i), ?_, ?_⟩ · intro x hx simp [projection, localSection_apply R U (f i) hroot e x hx] · apply Subtype.ext rw [localSection_apply R U (f i) hroot e _ he] exact Prod.ext rfl hi /-- A local graph description gives an open partial homeomorphism of the root space with the parameter space. -/ def graphChart (R : X → ℂ → Prop) (U : Set X) (V : Set ℂ) (hU : IsOpen U) (hV : IsOpen V) (f : X → ℂ) (hf : ContinuousOn f U) (hgraph : ∀ x ∈ U, ∀ z ∈ V, R x z ↔ z = f x) (himage : ∀ x ∈ U, f x ∈ V) (e : RootSpace R) : OpenPartialHomeomorph (RootSpace R) X := let hroot : ∀ x ∈ U, R x (f x) := fun x hx => (hgraph x hx _ (himage x hx)).mpr rfl { toFun := projection R invFun := localSection R U f hroot e source := {q | projection R q ∈ U ∧ q.1.2 ∈ V} target := U map_source' := fun _ hq => hq.1 map_target' := by intro x hx simp only [Set.mem_setOf_eq] rw [show projection R (localSection R U f hroot e x) = x from congrArg Prod.fst (localSection_apply R U f hroot e x hx)] exact ⟨hx, by rw [show (localSection R U f hroot e x).1.2 = f x from congrArg Prod.snd (localSection_apply R U f hroot e x hx)]; exact himage x hx⟩ left_inv' := by intro q hq apply Subtype.ext rw [localSection_apply R U f hroot e _ hq.1] exact Prod.ext rfl ((hgraph _ hq.1 _ hq.2).mp q.2).symm right_inv' := by intro x hx exact congrArg Prod.fst (localSection_apply R U f hroot e x hx) open_source := (hU.preimage (continuous_projection R)).inter (hV.preimage (continuous_snd.comp continuous_subtype_val)) open_target := hU continuousOn_toFun := (continuous_projection R).continuousOn continuousOn_invFun := continuousOn_localSection R U f hroot e hf } /-- A local unique-root graph at every point makes root projection a local homeomorphism. -/ theorem isLocalHomeomorph_of_graphs (R : X → ℂ → Prop) (hgraphs : ∀ e : RootSpace R, ∃ U : Set X, ∃ V : Set ℂ, IsOpen U ∧ IsOpen V ∧ projection R e ∈ U ∧ e.1.2 ∈ V ∧ ∃ f : X → ℂ, ContinuousOn f U ∧ (∀ x ∈ U, f x ∈ V) ∧ ∀ x ∈ U, ∀ z ∈ V, R x z ↔ z = f x) : IsLocalHomeomorph (projection R) := by intro e obtain ⟨U, V, hU, hV, heU, heV, f, hf, himage, hgraph⟩ := hgraphs e exact ⟨graphChart R U V hU hV f hf hgraph himage e, ⟨heU, heV⟩, rfl⟩ end end Source29RootCover /- Component: PolynomialRootCover.inc -/ namespace Source29RootCover open Filter Topology open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] /-- Joint uniqueness of an analytic root branch gives an open graph chart. -/ lemma exists_open_root_graph (P : E → Polynomial ℂ) (a : E) (r : ℂ) (hlocal : ∃ f : E → ℂ, AnalyticAt ℂ f a ∧ f a = r ∧ ∀ᶠ p : E × ℂ in 𝓝 (a,r), (P p.1).eval p.2 = 0 ↔ p.2 = f p.1) : ∃ U : Set E, ∃ V : Set ℂ, IsOpen U ∧ IsOpen V ∧ a ∈ U ∧ r ∈ V ∧ ∃ f : E → ℂ, ContinuousOn f U ∧ (∀ x ∈ U, f x ∈ V) ∧ ∀ x ∈ U, ∀ z ∈ V, (P x).eval z = 0 ↔ z = f x := by obtain ⟨f, hf, hfa, huniq⟩ := hlocal obtain ⟨U, V, hU, ha, hV, hr, hgraph⟩ := mem_nhds_prod_iff'.mp huniq have hpre : ∀ᶠ x in 𝓝 a, f x ∈ V := hf.continuousAt.eventually (by rw [hfa]; exact hV.mem_nhds hr) obtain ⟨W, hWsub, hW, haW⟩ := mem_nhds_iff.mp (hf.eventually_analyticAt.and hpre) refine ⟨U ∩ W, V, hU.inter hW, hV, ⟨ha,haW⟩, hr, f, ?_, ?_, ?_⟩ · intro x hx exact ((hWsub hx.2).1.continuousAt).continuousWithinAt · intro x hx exact (hWsub hx.2).2 · intro x hx z hz exact hgraph (show (x,z) ∈ U ×ˢ V from ⟨hx.1,hz⟩) /-- The root projection has common-neighborhood sections on any parameter subset on which all roots are simple and the coefficients are analytic. -/ theorem polynomial_hasLocalSections (P : E → Polynomial ℂ) (s : ℕ) (hs : 0 < s) (B : Set E) (hmonic : ∀ x, (P x).Monic) (hdegree : ∀ x, (P x).natDegree = s) (hcoeff : ∀ a ∈ B, ∀ k, AnalyticAt ℂ (fun x => (P x).coeff k) a) (hsimple : ∀ a ∈ B, ∀ z, (P a).eval z = 0 → (P a).derivative.eval z ≠ 0) : Source29RadialLift.HasLocalSections (projection (fun (a : B) z => (P a).eval z = 0)) := by apply hasLocalSections_of_charts _ s intro a obtain ⟨f,U,hU,ha,hf,-,-,hex⟩ := Source29RootLocalCharts.exists_local_root_charts P a s hs hmonic hdegree (hcoeff a a.2) (hsimple a a.2) refine ⟨fun i x => f i x, Subtype.val ⁻¹' U, hU.preimage continuous_subtype_val, ha, ?_, ?_⟩ · intro i exact ((hf i).continuousOn).comp continuous_subtype_val.continuousOn (fun _ hx => hx) · intro x hx z exact hex x hx z /-- Local unique analytic branches identify root projection as a local homeomorphism, including after restriction to a parameter subset. -/ theorem polynomial_isLocalHomeomorph (P : E → Polynomial ℂ) (s : ℕ) (B : Set E) (hdegree : ∀ x, (P x).natDegree ≤ s) (hcoeff : ∀ a ∈ B, ∀ k, AnalyticAt ℂ (fun x => (P x).coeff k) a) (hsimple : ∀ a ∈ B, ∀ z, (P a).eval z = 0 → (P a).derivative.eval z ≠ 0) : IsLocalHomeomorph (projection (fun (a : B) z => (P a).eval z = 0)) := by apply isLocalHomeomorph_of_graphs intro e obtain ⟨f,hf,hfa,-,huniq⟩ := Source29AnalyticSimpleRoot.exists_local_analytic_root P e.1.1 s e.1.2 hdegree (hcoeff _ e.1.1.2) e.2 (hsimple _ e.1.1.2 _ e.2) obtain ⟨U,V,hU,hV,ha,hr,f,hf,himage,hgraph⟩ := exists_open_root_graph P e.1.1 e.1.2 ⟨f,hf,hfa,huniq⟩ refine ⟨Subtype.val ⁻¹' U, V, hU.preimage continuous_subtype_val, hV, ha, hr, fun x => f x, ?_, ?_, ?_⟩ · exact hf.comp continuous_subtype_val.continuousOn (fun _ hx => hx) · intro x hx exact himage x hx · intro x hx z hz exact hgraph x hx z hz end end Source29RootCover /- Component: RootBallLabels.inc -/ namespace Source29RootCover open Filter Topology Function open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] /-- Radial lifting labels all roots continuously on a ball without requiring any individual root formula. Distinctness follows from uniqueness of lifts. -/ theorem exists_continuous_root_labels_on_ball (P : E → Polynomial ℂ) (s : ℕ) (hs : 0 < s) (c : E) (R : ℝ) (hR : 0 < R) (hmonic : ∀ x, (P x).Monic) (hdegree : ∀ x, (P x).natDegree = s) (hcoeff : ∀ a ∈ Metric.ball c R, ∀ k, AnalyticAt ℂ (fun x => (P x).coeff k) a) (hsimple : ∀ a ∈ Metric.ball c R, ∀ z, (P a).eval z = 0 → (P a).derivative.eval z ≠ 0) : ∃ w : Fin s → C(Metric.ball c R, ℂ), (∀ x : Metric.ball c R, Function.Injective (fun i => w i x)) ∧ (∀ x : Metric.ball c R, (List.ofFn (fun i => w i x) : Multiset ℂ) = (P x).roots) ∧ (∀ (x : Metric.ball c R) z, (P x).eval z = 0 ↔ ∃ i, w i x = z) := by classical let B := Metric.ball c R let rel : B → ℂ → Prop := fun a z => (P a).eval z = 0 let cB : B := ⟨c, Metric.mem_ball_self hR⟩ have hhomeo : IsLocalHomeomorph (projection rel) := polynomial_isLocalHomeomorph P s B (fun x => (hdegree x).le) hcoeff hsimple have hcover : Source29RadialLift.HasLocalSections (projection rel) := polynomial_hasLocalSections P s hs B hmonic hdegree hcoeff hsimple obtain ⟨r,U,hU,hcU,-,hrinj,hrroots,hrex⟩ := Source29RootLocalCharts.exists_local_root_charts P c s hs hmonic hdegree (hcoeff c cB.2) (hsimple c cB.2) let e (i : Fin s) : RootSpace rel := ⟨(cB,r i c), (hrex c hcU (r i c)).mpr ⟨i,rfl⟩⟩ have hlift (i : Fin s) := Source29RadialLift.exists_continuous_section_on_ball c R hR (projection rel) hhomeo hcover (e i) rfl choose S hS hS0 using hlift let w (i : Fin s) : C(B,ℂ) := ⟨fun x => (S i x).1.2, continuous_snd.comp (continuous_subtype_val.comp (S i).continuous)⟩ have hproj (i : Fin s) (x : B) : (S i x).1.1 = x := congrFun (hS i) x have hroot (i : Fin s) (x : B) : (P x).eval (w i x) = 0 := by have h := (S i x).2 change (P (S i x).1.1).eval (w i x) = 0 at h simpa only [hproj i x] using h have hinj (x : B) : Function.Injective (fun i => w i x) := by letI : PreconnectedSpace B := Subtype.preconnectedSpace (convex_ball c R).isPreconnected intro i j hij by_contra hne have hseed : S i cB ≠ S j cB := by rw [hS0 i, hS0 j] intro heq have heq' : r i c = r j c := congrArg (fun q : RootSpace rel => q.1.2) heq exact hne (hrinj c hcU heq') apply Source29RadialLift.sections_ne_of_ne_at hhomeo (S i) (S j) (hS i) (hS j) cB hseed x apply Subtype.ext exact Prod.ext ((hproj i x).trans (hproj j x).symm) hij have hmult (x : B) : (List.ofFn (fun i => w i x) : Multiset ℂ) = (P x).roots := Source29RootLocalCharts.roots_eq_of_distinct_full_tuple (P x) s (hmonic x).ne_zero (hdegree x).le (fun i => w i x) (hinj x) (fun i => hroot i x) exact ⟨w, hinj, hmult, fun x => Source29RootLocalCharts.exhaustive_of_root_multiset (P x) s (hmonic x).ne_zero (fun i => w i x) (hmult x)⟩ /-- Give a root label an arbitrary total extension outside its parameter set. -/ def extendLabel (B : Set E) (w : C(B,ℂ)) : E → ℂ := by classical exact fun x => if hx : x ∈ B then w ⟨x,hx⟩ else 0 lemma extendLabel_apply (B : Set E) (w : C(B,ℂ)) (x : B) : extendLabel B w x = w x := by simp [extendLabel, x.2] lemma continuousOn_extendLabel (B : Set E) (w : C(B,ℂ)) : ContinuousOn (extendLabel B w) B := by rw [continuousOn_iff_continuous_domRestrict] convert w.continuous using 1 funext x exact extendLabel_apply B w x /-- A monic analytic family with simple roots on a ball has globally defined analytic labels there, with every root represented exactly once. -/ theorem exists_analytic_root_labels_on_ball (P : E → Polynomial ℂ) (s : ℕ) (hs : 0 < s) (c : E) (R : ℝ) (hR : 0 < R) (hmonic : ∀ x, (P x).Monic) (hdegree : ∀ x, (P x).natDegree = s) (hcoeff : ∀ a ∈ Metric.ball c R, ∀ k, AnalyticAt ℂ (fun x => (P x).coeff k) a) (hsimple : ∀ a ∈ Metric.ball c R, ∀ z, (P a).eval z = 0 → (P a).derivative.eval z ≠ 0) : ∃ f : Fin s → E → ℂ, (∀ i, AnalyticOnNhd ℂ (f i) (Metric.ball c R)) ∧ (∀ x ∈ Metric.ball c R, Function.Injective (fun i => f i x)) ∧ (∀ x ∈ Metric.ball c R, (List.ofFn (fun i => f i x) : Multiset ℂ) = (P x).roots) ∧ (∀ x ∈ Metric.ball c R, ∀ z, (P x).eval z = 0 ↔ ∃ i, f i x = z) := by classical obtain ⟨w,hinj,hmult,hex⟩ := exists_continuous_root_labels_on_ball P s hs c R hR hmonic hdegree hcoeff hsimple let f (i : Fin s) := extendLabel (Metric.ball c R) (w i) have heq (i : Fin s) (x : Metric.ball c R) : f i x = w i x := extendLabel_apply _ _ x have hroot (i : Fin s) (x : E) (hx : x ∈ Metric.ball c R) : (P x).eval (f i x) = 0 := by rw [heq i ⟨x,hx⟩] exact (hex ⟨x,hx⟩ _).mpr ⟨i,rfl⟩ refine ⟨f, ?_, ?_, ?_, ?_⟩ · intro i a ha apply Source29RootSectionAnalytic.analyticAt_of_continuous_root_choice P (f i) a · exact (continuousOn_extendLabel _ _).continuousAt (Metric.isOpen_ball.mem_nhds ha) · filter_upwards [Metric.isOpen_ball.mem_nhds ha] with x hx exact hroot i x hx · obtain ⟨g,hg,-,-,huniq⟩ := Source29AnalyticSimpleRoot.exists_local_analytic_root P a s (f i a) (fun x => (hdegree x).le) (hcoeff a ha) (hroot i a ha) (hsimple a ha _ (hroot i a ha)) exact ⟨g,hg,huniq⟩ · intro x hx have heqx (i : Fin s) : f i x = w i ⟨x,hx⟩ := heq i ⟨x,hx⟩ simpa only [heqx] using hinj ⟨x,hx⟩ · intro x hx have heqx (i : Fin s) : f i x = w i ⟨x,hx⟩ := heq i ⟨x,hx⟩ simpa only [heqx] using hmult ⟨x,hx⟩ · intro x hx z have heqx (i : Fin s) : f i x = w i ⟨x,hx⟩ := heq i ⟨x,hx⟩ simpa only [heqx] using hex ⟨x,hx⟩ z end end Source29RootCover /- Component: QuadraticTaylorLimit.inc -/ /- Recover the actual second derivative in the transverse ratio limit. -/ namespace Source29QuadraticTaylorLimit open Filter open scoped Topology noncomputable section lemma second_deriv_of_quadratic_factor (f g : ℂ → ℂ) (hg : AnalyticAt ℂ g 0) (hfg : f =ᶠ[𝓝 (0 : ℂ)] (fun z => z^2 * g z)) : deriv (deriv f) 0 = 2*g 0 := by let K : ℂ → ℂ := fun z => 2*(z*g z) + z^2*deriv g z have hfirst : deriv f =ᶠ[𝓝 (0 : ℂ)] K := by filter_upwards [hfg.deriv, hg.eventually_analyticAt] with z hz hgz rw [hz] have hd := ((hasDerivAt_id z).pow 2).mul hgz.differentiableAt.hasDerivAt simpa [K, mul_assoc, Pi.mul_def, Pi.pow_def] using hd.deriv have hsecond : HasDerivAt K (2*g 0) 0 := by have h1 := ((hasDerivAt_id (0 : ℂ)).mul hg.differentiableAt.hasDerivAt).const_mul 2 have h2 := ((hasDerivAt_id (0 : ℂ)).pow 2).mul hg.deriv.differentiableAt.hasDerivAt simpa [K, Pi.add_def, Pi.mul_def, Pi.pow_def] using h1.add h2 rw [hfirst.deriv_eq] exact hsecond.deriv /-- A quadratic analytic bound determines the normalized real-path limit as half of the complex second derivative. -/ theorem real_quadratic_ratio_limit (f : ℂ → ℂ) (hf : AnalyticAt ℂ f 0) (hf0 : f 0 = 0) (C : ℝ) (hbound : ∀ᶠ z in 𝓝 (0 : ℂ), ‖f z‖ ≤ C*‖z‖^2) : Tendsto (fun t : ℝ => f (t : ℂ) / ((t^2 : ℝ) : ℂ)) (𝓝[≠] (0 : ℝ)) (𝓝 (deriv (deriv f) 0 / 2)) := by have hreal : ∀ᶠ z in 𝓝 (0 : ℂ), (f z).re ≤ C*‖z‖^2 := hbound.mono (fun z hz => (Complex.re_le_norm (f z)).trans hz) obtain ⟨g, hg, hfg⟩ := Source29OneSidedOrder.exists_analytic_factor_of_one_sided_bound f hf hf0 2 C hreal have hsecond := second_deriv_of_quadratic_factor f g hg hfg have hpath : Tendsto (fun t : ℝ => (t : ℂ)) (𝓝[≠] (0 : ℝ)) (𝓝 (0 : ℂ)) := by simpa using (Complex.continuous_ofReal.tendsto (0 : ℝ)).mono_left nhdsWithin_le_nhds have heq : (fun t : ℝ => f (t : ℂ) / ((t^2 : ℝ) : ℂ)) =ᶠ[𝓝[≠] (0 : ℝ)] (fun t => g (t : ℂ)) := by filter_upwards [hpath.eventually hfg, self_mem_nhdsWithin] with t ht hne have htne : t ≠ 0 := by simpa only [Set.mem_compl_iff, Set.mem_singleton_iff] using hne have hcn : (t : ℂ) ≠ 0 := by exact_mod_cast htne rw [ht] push_cast field_simp have hlim := hg.continuousAt.tendsto.comp hpath rw [hsecond] convert hlim.congr' heq.symm using 1 <;> ring end end Source29QuadraticTaylorLimit /- Component: QuadraticDirectionalLimit.inc -/ namespace Source29QuadraticTaylorLimit open Filter open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] lemma second_deriv_line (f : E → ℂ) (hf : AnalyticAt ℂ f 0) (v : E) : deriv (deriv (fun z : ℂ => f (z • v))) 0 = fderiv ℂ (fderiv ℂ f) 0 v v := by let g : E → ℂ := fun x => fderiv ℂ f x v have hpath : Tendsto (fun z : ℂ => z • v) (𝓝 0) (𝓝 (0 : E)) := by have hc : Continuous (fun z : ℂ => z • v) := continuous_id.smul continuous_const simpa using hc.tendsto (0 : ℂ) have hfirst : deriv (fun z : ℂ => f (z • v)) =ᶠ[𝓝 (0 : ℂ)] (fun z => g (z • v)) := by filter_upwards [hpath.eventually hf.eventually_analyticAt] with z hz have hl : HasDerivAt (fun z : ℂ => z • v) v z := by simpa using (hasDerivAt_id z).smul_const v exact (hz.differentiableAt.hasFDerivAt.comp_hasDerivAt z hl).deriv let ev : (E →L[ℂ] ℂ) →L[ℂ] ℂ := ContinuousLinearMap.apply ℂ ℂ v have hg : HasFDerivAt g (ev.comp (fderiv ℂ (fderiv ℂ f) 0)) 0 := ev.hasFDerivAt.comp 0 hf.fderiv.differentiableAt.hasFDerivAt have hl : HasDerivAt (fun z : ℂ => z • v) v 0 := by simpa using (hasDerivAt_id (0 : ℂ)).smul_const v have hd : HasDerivAt (fun z : ℂ => g (z • v)) (fderiv ℂ (fderiv ℂ f) 0 v v) 0 := by have hg' : HasFDerivAt g (ev.comp (fderiv ℂ (fderiv ℂ f) 0)) ((0 : ℂ) • v) := by simpa using hg exact hg'.comp_hasDerivAt 0 hl rw [hfirst.deriv_eq] exact hd.deriv /-- Quadratic analytic growth gives the transverse limit with the actual iterated Fréchet derivative, in any complex direction. -/ theorem directional_quadratic_ratio_limit (f : E → ℂ) (hf : AnalyticAt ℂ f 0) (hf0 : f 0 = 0) (C : ℝ) (hbound : ∀ᶠ x in 𝓝 (0 : E), ‖f x‖ ≤ C*‖x‖^2) (v : E) : Tendsto (fun t : ℝ => f ((t : ℂ) • v) / ((t^2 : ℝ) : ℂ)) (𝓝[≠] (0 : ℝ)) (𝓝 (fderiv ℂ (fderiv ℂ f) 0 v v / 2)) := by let F : ℂ → ℂ := fun z => f (z • v) have hl : AnalyticAt ℂ (fun z : ℂ => z • v) 0 := analyticAt_id.smul analyticAt_const have hF : AnalyticAt ℂ F 0 := by have hf' : AnalyticAt ℂ f ((0 : ℂ) • v) := by simpa using hf exact AnalyticAt.comp (g := f) (f := fun z : ℂ => z • v) (x := 0) hf' hl have hF0 : F 0 = 0 := by simpa [F] using hf0 have hpath : Tendsto (fun z : ℂ => z • v) (𝓝 0) (𝓝 (0 : E)) := by simpa using hl.continuousAt.tendsto have hb : ∀ᶠ z in 𝓝 (0 : ℂ), ‖F z‖ ≤ (C*‖v‖^2)*‖z‖^2 := by filter_upwards [hpath.eventually hbound] with z hz simpa only [F, norm_smul, mul_pow, mul_assoc, mul_left_comm, mul_comm] using hz have hr := real_quadratic_ratio_limit F hF hF0 (C*‖v‖^2) hb rwa [second_deriv_line f hf v] at hr end end Source29QuadraticTaylorLimit /- Component: RadialRootVanishing.inc -/ /- Homogeneity forces the local roots along the radial tangent direction to vanish, without choosing analytic root labels. -/ namespace Source29RadialRootVanishing open MvPolynomial Filter open scoped Topology noncomputable section lemma radial_eval_scaling {n : ℕ} (h : MvPolynomial (Fin n) ℂ) (d : ℕ) (hh : h.IsHomogeneous d) (z N : Fin n → ℂ) (a w : ℂ) (ha : 1+a ≠ 0) : eval (fun i => (1+a)*z i+w*N i) h = (1+a)^d * (Source29SlicePolynomial.lineSlice h z N).eval (w/(1+a)) := by rw [Source29SlicePolynomial.eval_lineSlice] have ht := Source29ProjectiveMaximum.eval_scale_of_isHomogeneous h d hh (fun i => z i + w/(1+a)*N i) (1+a) have he : (fun i => (1+a)*z i+w*N i) = (fun i => (1+a)*(z i+w/(1+a)*N i)) := by funext i field_simp <;> ring rw [he] exact ht /-- A small root in a homogeneous radial family must be zero once its fixed normal-slice complementary factor is nonzero. -/ lemma radial_root_eq_zero {n : ℕ} (h : MvPolynomial (Fin n) ℂ) (d : ℕ) (hh : h.IsHomogeneous d) (z N : Fin n → ℂ) (s : ℕ) (g : Polynomial ℂ) (hfactor : Source29SlicePolynomial.lineSlice h z N = Polynomial.X^s*g) (a w : ℂ) (ha : 1+a ≠ 0) (hg : g.eval (w/(1+a)) ≠ 0) (hroot : eval (fun i => (1+a)*z i+w*N i) h = 0) : w = 0 := by rw [radial_eval_scaling h d hh z N a w ha, hfactor, Polynomial.eval_mul, Polynomial.eval_pow, Polynomial.eval_X] at hroot have h1 := (mul_eq_zero.mp hroot).resolve_left (pow_ne_zero d ha) have h2 := (mul_eq_zero.mp h1).resolve_right hg have h3 : w/(1+a) = 0 := eq_zero_of_pow_eq_zero h2 have h4 := (div_eq_iff ha).mp h3 simpa using h4 /-- Any finite choice of roots tending to zero vanishes identically near the origin along the radial line. No regularity of the root labels is required. -/ theorem eventually_radial_roots_zero {n : ℕ} {ι : Type*} [Fintype ι] (h : MvPolynomial (Fin n) ℂ) (d : ℕ) (hh : h.IsHomogeneous d) (z N : Fin n → ℂ) (s : ℕ) (g : Polynomial ℂ) (hfactor : Source29SlicePolynomial.lineSlice h z N = Polynomial.X^s*g) (hg0 : g.coeff 0 ≠ 0) (w : ℂ → ι → ℂ) (hw : ∀ j, Tendsto (fun a => w a j) (𝓝 (0 : ℂ)) (𝓝 0)) (hroot : ∀ᶠ a in 𝓝 (0 : ℂ), ∀ j, eval (fun i => (1+a)*z i+w a j*N i) h = 0) : ∀ᶠ a in 𝓝 (0 : ℂ), ∀ j, w a j = 0 := by have ha : ∀ᶠ a in 𝓝 (0 : ℂ), 1+a ≠ 0 := by have hc : ContinuousAt (fun a : ℂ => 1+a) 0 := continuousAt_const.add continuousAt_id simpa using hc.eventually_ne (by norm_num : (1 : ℂ)+0 ≠ 0) have hgne (j : ι) : ∀ᶠ a in 𝓝 (0 : ℂ), g.eval (w a j/(1+a)) ≠ 0 := by have hden : Tendsto (fun a : ℂ => 1+a) (𝓝 0) (𝓝 1) := by simpa using (tendsto_const_nhds (x := (1 : ℂ)) (f := 𝓝 (0 : ℂ))).add tendsto_id have hratio : Tendsto (fun a : ℂ => w a j/(1+a)) (𝓝 0) (𝓝 0) := by simpa only [Pi.div_def, zero_div] using (hw j).div hden one_ne_zero have hcont : Continuous (fun b : ℂ => g.eval b) := g.continuous have hne : ∀ᶠ b in 𝓝 (0 : ℂ), g.eval b ≠ 0 := hcont.continuousAt.eventually_ne (by simpa only [← Polynomial.coeff_zero_eq_eval_zero] using hg0) exact hratio.eventually hne filter_upwards [ha, hroot, Filter.eventually_all.mpr hgne] with a ha hr hg j exact radial_root_eq_zero h d hh z N s g hfactor a (w a j) ha (hg j) (hr j) end end Source29RadialRootVanishing /- Component: RootMeanBounds.inc -/ namespace Source29RootMean open Filter Finset Source29TransverseTraceBound open scoped Topology noncomputable section variable {ι : Type*} [Fintype ι] [Nonempty ι] lemma norm_mean_le (w : ι → ℂ) (B : ℝ) (hw : ∀ j, ‖w j‖ ≤ B) : ‖mean w‖ ≤ B := by have hc : (0 : ℝ) < Fintype.card ι := Nat.cast_pos.mpr Fintype.card_pos have hn : ‖(((Fintype.card ι : ℝ) : ℂ))‖ = (Fintype.card ι : ℝ) := by simp rw [mean, norm_div, hn] apply (div_le_iff₀ hc).mpr calc ‖∑ j, w j‖ ≤ ∑ j, ‖w j‖ := norm_sum_le _ _ _ ≤ ∑ _j : ι, B := sum_le_sum (fun j _ => hw j) _ = B * (Fintype.card ι : ℝ) := by simp [mul_comm] variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] lemma analyticAt_mean (w : E → ι → ℂ) (a : E) (hsum : AnalyticAt ℂ (fun x => ∑ j, w x j) a) : AnalyticAt ℂ (fun x => mean (w x)) a := by exact hsum.div_const theorem mean_quadratic_bound (w : E → ι → ℂ) (A : ℝ) (hroot : ∀ᶠ x in 𝓝 (0 : E), ∀ j, ‖w x j‖ ≤ A*‖x‖^2) : ∀ᶠ x in 𝓝 (0 : E), ‖mean (w x)‖ ≤ A*‖x‖^2 := hroot.mono (fun x hx => norm_mean_le (w x) _ hx) /-- The analytic mean automatically has the exact second-order directional limit required by the transverse maximum argument. -/ theorem mean_directional_ratio_limit (w : E → ι → ℂ) (A : ℝ) (hroot : ∀ᶠ x in 𝓝 (0 : E), ∀ j, ‖w x j‖ ≤ A*‖x‖^2) (hsum : AnalyticAt ℂ (fun x => ∑ j, w x j) 0) (v : E) : Tendsto (fun t : ℝ => mean (w ((t : ℂ) • v)) / ((t^2 : ℝ) : ℂ)) (𝓝[≠] (0 : ℝ)) (𝓝 (fderiv ℂ (fderiv ℂ (fun x => mean (w x))) 0 v v / 2)) := by have hb := mean_quadratic_bound w A hroot have hz : mean (w 0) = 0 := by have hh := hb.self_of_nhds simpa only [norm_zero, zero_pow (by decide : 2 ≠ 0), mul_zero, norm_le_zero_iff] using hh exact Source29QuadraticTaylorLimit.directional_quadratic_ratio_limit (fun x => mean (w x)) (analyticAt_mean w 0 hsum) hz A hb v end end Source29RootMean /- Component: PreparedRadialMean.inc -/ /- The radial identity for the actual prepared root family. -/ namespace Source29PreparedRadialMean open MvPolynomial Filter Source29LocalQuadratic Source29TransverseTraceBound open scoped Topology BigOperators noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] {n : ℕ} /-- The prepared polynomial at the base point is the normal slice of h. -/ lemma base_slice_factorization (h : MvPolynomial (Fin n) ℂ) (z N : CSpace n) (T : E →ₗᵢ[ℂ] CSpace n) (data : PreparedRoots (Source29PolynomialTranslation.translate h (fun i => z i)) T N) : Source29SlicePolynomial.lineSlice h (fun i => z i) (fun i => N i) = Polynomial.X ^ data.s * data.B 0 := by have hb := data.factorization.self_of_nhds rw [data.base] at hb simpa only [map_zero, PiLp.zero_apply, Source29AffinePolynomialChart.lineSlice_translate, Pi.add_def, add_zero] using hb.symm /-- Homogeneity forces every prepared root on the radial tangent line to be zero, even when the chosen root functions are not individually analytic. -/ theorem eventually_radial_roots_zero (h : MvPolynomial (Fin n) ℂ) (d : ℕ) (hh : h.IsHomogeneous d) (z N : CSpace n) (T : E →ₗᵢ[ℂ] CSpace n) (data : PreparedRoots (Source29PolynomialTranslation.translate h (fun i => z i)) T N) (u : E) (hu : T u = z) : ∀ᶠ a in 𝓝 (0 : ℂ), ∀ j, data.roots (a • u) j = 0 := by have hpath : Tendsto (fun a : ℂ => a • u) (𝓝 0) (𝓝 (0 : E)) := by have hc : Continuous (fun a : ℂ => a • u) := continuous_id.smul continuous_const simpa using hc.tendsto (0 : ℂ) obtain ⟨A, -, hquad⟩ := data.quadratic_bound have hroots (j : Fin data.s) : Tendsto (fun a : ℂ => data.roots (a • u) j) (𝓝 0) (𝓝 0) := by apply squeeze_zero_norm' ((hpath.eventually hquad).mono (fun a ha => ha j)) simpa using (tendsto_const_nhds (x := A) (f := 𝓝 (0 : ℂ))).mul (hpath.norm.pow 2) have hunit : (data.B 0).coeff 0 ≠ 0 := by simpa only [Polynomial.coeff_zero_eq_eval_zero] using data.unit_nonzero.self_of_nhds have hactual : ∀ᶠ a in 𝓝 (0 : ℂ), ∀ j, eval (fun i => (1+a)*z i + data.roots (a • u) j*N i) h = 0 := by filter_upwards [hpath.eventually data.root_original] with a ha j have hz := ha j rw [Source29PolynomialTranslation.eval_translate] at hz have he : (fun i => (1+a)*z i + data.roots (a • u) j*N i) = (fun i => z i + (T (a • u) + data.roots (a • u) j • N) i) := by rw [map_smul, hu] funext i change (1+a)*z i + data.roots (a • u) j*N i = z i + (a*z i + data.roots (a • u) j*N i) ring rwa [he] exact Source29RadialRootVanishing.eventually_radial_roots_zero h d hh (fun i => z i) (fun i => N i) data.s (data.B 0) (base_slice_factorization h z N T data) hunit (fun a j => data.roots (a • u) j) hroots hactual /-- The radial entry of the analytic mean's Hessian vanishes. -/ theorem radial_mean_hessian_zero (h : MvPolynomial (Fin n) ℂ) (d : ℕ) (hh : h.IsHomogeneous d) (z N : CSpace n) (T : E →ₗᵢ[ℂ] CSpace n) (data : PreparedRoots (Source29PolynomialTranslation.translate h (fun i => z i)) T N) (u : E) (hu : T u = z) : fderiv ℂ (fderiv ℂ (fun x => mean (data.roots x))) 0 u u = 0 := by letI : NeZero data.s := ⟨Nat.ne_of_gt data.s_pos⟩ have hf := Source29RootMean.analyticAt_mean data.roots 0 data.sum_analytic have hzero : (fun a : ℂ => mean (data.roots (a • u))) =ᶠ[𝓝 (0 : ℂ)] (fun _ => (0 : ℂ)) := by filter_upwards [eventually_radial_roots_zero h d hh z N T data u hu] with a ha simp only [mean, ha, Finset.sum_const_zero, zero_div] rw [← Source29QuadraticTaylorLimit.second_deriv_line _ hf u, hzero.deriv.deriv_eq] simp end end Source29PreparedRadialMean /- Component: PreparedMaximumTrace.inc -/ /- The actual prepared mean has negative transverse contributions at a strict normalized maximum. Combined with radial homogeneity, its metric trace cannot vanish. -/ namespace Source29PreparedMaximumTrace open MvPolynomial Filter Source29TransverseTraceBound open Source29LocalQuadratic (PreparedRoots) open Source29LocalMaximumBound open scoped Topology BigOperators noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] {n : ℕ} theorem transverse_hessian_bound (h : MvPolynomial (Fin n) ℂ) (z : CSpace n) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : quadric z = (κ : ℂ)) (hbound : ∀ v : CSpace n, eval (fun i => v i) h = 0 → Source29ProjectiveMaximum.quadricNorm v ≤ κ * ‖v‖^2) (T : E →ₗᵢ[ℂ] CSpace n) (data : PreparedRoots (Source29PolynomialTranslation.translate h (fun i => z i)) T (normal z κ)) (u : E) (hu : ‖u‖ = 1) (hreal : ∀ i, (T u i).im = 0) (hdot : dot z (T u) = 0) : (((-κ*(1-κ^2) : ℝ) : ℂ) * fderiv ℂ (fderiv ℂ (fun x => mean (data.roots x))) 0 u u).re ≤ κ - 1 := by letI : NeZero data.s := ⟨Nat.ne_of_gt data.s_pos⟩ obtain ⟨A, hA, hquad⟩ := data.quadratic_bound have hpath : Tendsto (fun t : ℝ => (t : ℂ) • u) (𝓝 0) (𝓝 (0 : E)) := by have hc : Continuous (fun t : ℝ => (t : ℂ) • u) := Complex.continuous_ofReal.smul continuous_const simpa using hc.tendsto (0 : ℝ) have hr : ∀ᶠ t : ℝ in 𝓝 (0 : ℝ), ∀ j, ‖data.roots ((t : ℂ) • u) j‖ ≤ A*t^2 := by filter_upwards [hpath.eventually hquad] with t ht j simpa only [norm_smul, hu, mul_one, Complex.norm_real, Real.norm_eq_abs, sq_abs] using ht j have hm : ∀ᶠ t : ℝ in 𝓝 (0 : ℝ), ∀ j, κ + t^2 + (((-κ*(1-κ^2) : ℝ) : ℂ) * (data.roots ((t : ℂ) • u) j)^2).re ≤ κ * (1 + t^2 + 2*(1-κ^2)*(data.roots ((t : ℂ) • u) j).re + (1-κ^2)*‖data.roots ((t : ℂ) • u) j‖^2) := by filter_upwards [hpath.eventually data.root_original] with t ht j have hroot := ht j rw [Source29PolynomialTranslation.eval_translate] at hroot have hv : eval (fun i => (z + (t : ℂ) • T u + data.roots ((t : ℂ) • u) j • normal z κ) i) h = 0 := by simpa only [map_smul, PiLp.add_apply, add_assoc] using hroot apply Source29TransverseCoordinates.transverse_real_maximum z (T u) κ hz hq hreal (by simpa only [T.norm_map] using hu) hdot t (data.roots ((t : ℂ) • u) j) exact hbound _ hv exact transverse_mean_limit (fun t j => data.roots ((t : ℂ) • u) j) κ A hk.le hk1 hA.le hr hm _ (Source29RootMean.mean_directional_ratio_limit data.roots A hquad data.sum_analytic u) def tangentMetric (κ : ℝ) : Matrix (Fin 7) (Fin 7) ℂ := fun i j => Source29FullNormalChart.inverseMetric κ i.succ j.succ lemma tangent_metric_trace (κ : ℝ) (H : Fin 7 → Fin 7 → ℂ) : Source29MetricJet.metricTrace (tangentMetric κ) H = (κ : ℂ)⁻¹ * H 0 0 + ∑ i : Fin 6, H i.succ i.succ := by unfold Source29MetricJet.metricTrace tangentMetric simp only [Source29FullNormalChart.inverseMetric_tail, ite_mul, zero_mul, Finset.sum_ite_eq', Finset.mem_univ, if_true] rw [Fin.sum_univ_succ] simp /-- For the concrete seven-dimensional tangent chart, the analytic mean cannot have zero inverse-metric Hessian trace at a strict maximum. -/ theorem prepared_mean_trace_ne_zero (h : MvPolynomial (Fin 8) ℂ) (d : ℕ) (hh : h.IsHomogeneous d) (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : quadric z = (κ : ℂ)) (hbound : ∀ v : CSpace 8, eval (fun i => v i) h = 0 → Source29ProjectiveMaximum.quadricNorm v ≤ κ * ‖v‖^2) (data : PreparedRoots (Source29PolynomialTranslation.translate h (fun i => z i)) (Source29TangentBasis.tangentEmbedding z κ hk hk1 hz hq) (normal z κ)) : Source29AnalyticMeanHessian.hessianTrace (tangentMetric κ) (fun i : Fin 7 => EuclideanSpace.single i 1) (fun x => mean (data.roots x)) 0 ≠ 0 := by let T := Source29TangentBasis.tangentEmbedding z κ hk hk1 hz hq let e : Fin 7 → CSpace 7 := fun i => EuclideanSpace.single i 1 let H : Fin 7 → Fin 7 → ℂ := fun i j => fderiv ℂ (fderiv ℂ (fun x => mean (data.roots x))) 0 (e i) (e j) have hradial : H 0 0 = 0 := by apply Source29PreparedRadialMean.radial_mean_hessian_zero h d hh z (normal z κ) T data (e 0) exact Source29TangentBasis.tangentEmbedding_single z κ hk hk1 hz hq 0 have hneg (i : Fin 6) : (((-κ*(1-κ^2) : ℝ) : ℂ) * H i.succ i.succ).re ≤ κ - 1 := by apply transverse_hessian_bound h z κ hk hk1 hz hq hbound T data (e i.succ) · simp [e, EuclideanSpace.norm_single] · have he : T (e i.succ) = Source29TransverseBasis.complexBasisVector z κ hk hk1 hz hq i := Source29TangentBasis.tangentEmbedding_single z κ hk hk1 hz hq i.succ rw [he] exact Source29TransverseBasis.complexBasisVector_real z κ hk hk1 hz hq i · have he : T (e i.succ) = Source29TransverseBasis.complexBasisVector z κ hk hk1 hz hq i := Source29TangentBasis.tangentEmbedding_single z κ hk hk1 hz hq i.succ rw [he] exact Source29TransverseBasis.complexBasisVector_dot z κ hk hk1 hz hq i intro hzero have htrace : Source29MetricJet.metricTrace (tangentMetric κ) H = 0 := hzero rw [tangent_metric_trace, hradial, mul_zero, zero_add] at htrace exact trace_contradiction_of_real_bounds (fun i : Fin 6 => H i.succ i.succ) (((-κ*(1-κ^2) : ℝ) : ℂ)) κ hk1 hneg htrace end end Source29PreparedMaximumTrace /- Component: AnalyticSimpleRootUnit.inc -/ /- Factorization at a simple root with its actual nonvanishing analytic unit. -/ namespace Source29AnalyticSimpleRootUnit open Polynomial Filter open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] /-- A given analytic simple root has a local equation equal to a nonzero analytic unit times the graph equation w-f(x). The variables are normal first. -/ theorem exists_analytic_unit_at_simple_root (P : E → Polynomial ℂ) (a : E) (D : ℕ) (hdegree : ∀ x, (P x).natDegree ≤ D) (hcoeff : ∀ k, AnalyticAt ℂ (fun x => (P x).coeff k) a) (f : E → ℂ) (hf : AnalyticAt ℂ f a) (hroot : ∀ᶠ x in 𝓝 a, (P x).eval (f x) = 0) (hsimple : (P a).derivative.eval (f a) ≠ 0) : ∃ U : (ℂ × E) → ℂ, AnalyticAt ℂ U (f a, a) ∧ U (f a, a) ≠ 0 ∧ (fun y : ℂ × E => (P y.2).eval y.1) =ᶠ[𝓝 (f a, a)] (fun y => U y * (y.1 - f y.2)) := by let r := f a let Q : E → Polynomial ℂ := fun x => taylor r (P x) have hQd : ∀ x, (Q x).natDegree ≤ D := by intro x simpa only [Q, natDegree_taylor] using hdegree x have hQa : ∀ k, AnalyticAt ℂ (fun x => (Q x).coeff k) a := by intro k exact Source29AnalyticSimpleRoot.analyticAt_linear_polynomial_functional P a D hdegree hcoeff ((Polynomial.lcoeff ℂ k).comp (taylor r)) have hzero : (Q a).coeff 0 = 0 := by simpa only [Q, taylor_coeff_zero, r] using hroot.self_of_nhds have hsimpleQ : (Q a).coeff 1 ≠ 0 := by simpa only [Q, taylor_coeff_one, r] using hsimple obtain ⟨g, hg⟩ := X_dvd_iff.mpr hzero have hg0 : g.coeff 0 ≠ 0 := by have he : (Q a).coeff 1 = g.coeff 0 := by rw [hg]; simp rwa [he] at hsimpleQ have hgn : g ≠ 0 := by intro hz; exact hg0 (by simp [hz]) have hgd : g.natDegree ≤ D := by have hh := hQd a rw [hg, natDegree_mul X_ne_zero hgn, natDegree_X] at hh omega have hd : ∀ᶠ x in 𝓝 a, (Q x).degree < (1+D+1 : WithBot ℕ) := by apply Filter.Eventually.of_forall intro x exact (degree_le_of_natDegree_le (hQd x)).trans_lt (by exact_mod_cast (show D < 1+D+1 by omega)) obtain ⟨W, B, hW, hWa, hBa, hWcoeff, hBcoeff, hBdeg, hBunit, hWB⟩ := Source29LocalPreparation.local_polynomial_preparation Q a 1 D g hgd hg0 (by simpa using hg) hd (fun i => hQa i) have hwlin (x : E) : W x = X + C ((W x).coeff 0) := (hW x).1.eq_X_add_C (hW x).2 have hpath : Tendsto (fun x : E => (x, f x-r)) (𝓝 a) (𝓝 (a,0)) := by simpa only [id_eq, r, sub_self, nhds_prod_eq] using tendsto_id.prodMk (hf.continuousAt.tendsto.sub (tendsto_const_nhds (x := r))) have hrelation : ∀ᶠ x in 𝓝 a, f x-r+(W x).coeff 0 = 0 := by filter_upwards [hroot, hWB, hpath.eventually hBunit] with x hx he hu have hqx : (Q x).eval (f x-r) = 0 := by simpa only [Q, taylor_eval, sub_add_cancel] using hx rw [← he, eval_mul, hwlin, eval_add, eval_X, eval_C] at hqx exact (mul_eq_zero.mp hqx).resolve_right hu let U : (ℂ × E) → ℂ := fun y => (B y.2).eval (y.1-r) have hmap : AnalyticAt ℂ (fun y : ℂ × E => (y.2, y.1-r)) (r,a) := analyticAt_snd.prod (analyticAt_fst.sub analyticAt_const) have hU : AnalyticAt ℂ U (r,a) := by have hb : AnalyticAt ℂ (fun y : E × ℂ => (B y.1).eval y.2) (a,r-r) := by simpa only [sub_self] using Source29LocalPreparation.analyticAt_joint_eval B a 0 (D+1) hBdeg hBcoeff exact AnalyticAt.comp (g := fun y : E × ℂ => (B y.1).eval y.2) (f := fun y : ℂ × E => (y.2, y.1-r)) (x := (r,a)) hb hmap refine ⟨U, hU, ?_, ?_⟩ · simpa only [U, r, sub_self] using hBunit.self_of_nhds · have hp : Tendsto (fun y : ℂ × E => y.2) (𝓝 (f a,a)) (𝓝 a) := continuous_snd.tendsto _ filter_upwards [hp.eventually hWB, hp.eventually hrelation] with y he hr have hv := congrArg (fun p : Polynomial ℂ => p.eval (y.1-r)) he rw [eval_mul, hwlin, eval_add, eval_X, eval_C] at hv have hw : y.1-r+(W y.2).coeff 0 = y.1-f y.2 := by linear_combination hr rw [hw] at hv simpa only [Q, taylor_eval, sub_add_cancel, U, mul_comm] using hv.symm end end Source29AnalyticSimpleRootUnit /- Component: SimpleRootGraphEquation.inc -/ namespace Source29SimpleRootGraphEquation open Filter Source29MetricJet Source29AnalyticJetRules Source29AnalyticGraphEquation open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] variable {ι : Type*} [Fintype ι] /-- The graph PDE for an actual analytic simple root of a polynomial family. The local unit is constructed from polynomial preparation. -/ theorem graph_equation_of_simple_root (P : E → Polynomial ℂ) (a : E) (D : ℕ) (hdegree : ∀ x, (P x).natDegree ≤ D) (hcoeff : ∀ k, AnalyticAt ℂ (fun x => (P x).coeff k) a) (f : E → ℂ) (hf : AnalyticAt ℂ f a) (hroot : ∀ᶠ x in 𝓝 a, (P x).eval (f x) = 0) (hsimple : (P a).derivative.eval (f a) ≠ 0) (M : ι → ι → ℂ) (hM : ∀ i j, M i j = M j i) (c d : ℂ) (hcd : c*d = 1) (e : ι → E) (hL : jetOperator (blockMetric M d) (graphDirections e) (fun y : ℂ × E => (P y.2).eval y.1) (f a,a) = 0) : let g := fun i => fderiv ℂ f a (e i) let H := fun i j => fderiv ℂ (fderiv ℂ f) a (e i) (e j) (1 + c * metricPair M g g) * metricTrace M H - c * contract H (raiseIndex M g) (raiseIndex M g) = 0 := by obtain ⟨U, hU, hU0, hlocal⟩ := Source29AnalyticSimpleRootUnit.exists_analytic_unit_at_simple_root P a D hdegree hcoeff f hf hroot hsimple exact graph_equation_of_local_unit M hM c d hcd e _ U f (f a,a) hf hU rfl hU0 hlocal hL end end Source29SimpleRootGraphEquation /- Component: ChartPolynomialJet.inc -/ /- The polynomial divisibility hypothesis gives the zero implicit operator in the actual full normal chart. -/ namespace Source29ChartPolynomialJet open Source29FullNormalChart Source29AnalyticMetricCoordinate Source29AnalyticJetRules open Source29LocalMaximumBound open scoped BigOperators noncomputable section def chartCLM (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : (Fin 8 → ℂ) →L[ℂ] (Fin 8 → ℂ) := (chart z κ hk hk1 hz hq).toContinuousLinearEquiv.toContinuousLinearMap lemma coordinateMatrix_chartCLM (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) : coordinateMatrix (chartCLM z κ hk hk1 hz hq) = chartMatrix z κ hk hk1 hz hq := by rfl theorem chart_jetOperator_zero (h : MvPolynomial (Fin 8) ℂ) (hdiv : h ∣ Source29FactorInheritance.cubicOperator h) (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (x : Fin 8 → ℂ) (hx : MvPolynomial.eval ((fun i => z i) + chartCLM z κ hk hk1 hz hq x) h = 0) : jetOperator (inverseMetric κ) (fun i => Pi.single i 1) (fun y => MvPolynomial.eval ((fun i => z i) + chartCLM z κ hk hk1 hz hq y) h) x = 0 := by have hA : IsUnit (coordinateMatrix (chartCLM z κ hk hk1 hz hq)).det := by rw [coordinateMatrix_chartCLM] exact chartMatrix_isUnit_det z κ hk hk1 hz hq have he := jetOperator_euclidean_affine_coordinates (chartCLM z κ hk hk1 hz hq) hA (fun v => MvPolynomial.eval v h) (fun i => z i) x (Source29MvPolynomialJet.analyticAt_eval h _) rw [coordinateMatrix_chartCLM, chartMatrix_inverseMetric] at he rw [he] exact Source29MvPolynomialJet.jetOperator_eval_zero_of_dvd h hdiv _ hx end end Source29ChartPolynomialJet /- Component: MetricReindex.inc -/ namespace Source29MetricReindex open Source29MetricJet Source29AnalyticJetRules open scoped BigOperators noncomputable section variable {ι η R : Type*} [Fintype ι] [Fintype η] [CommRing R] lemma sum_two_reindex (e : η ≃ ι) (F : ι → ι → R) : (∑ i : η, ∑ j : η, F (e i) (e j)) = ∑ i : ι, ∑ j : ι, F i j := by calc _ = ∑ i : η, ∑ j : ι, F (e i) j := Finset.sum_congr rfl (fun i _ => e.sum_comp (F (e i))) _ = _ := e.sum_comp (fun i => ∑ j : ι, F i j) lemma raiseIndex_reindex (e : η ≃ ι) (M : ι → ι → R) (g : ι → R) (i : η) : raiseIndex (fun i j => M (e i) (e j)) (fun i => g (e i)) i = raiseIndex M g (e i) := e.sum_comp (fun j => M (e i) j * g j) lemma metricPair_reindex (e : η ≃ ι) (M : ι → ι → R) (g b : ι → R) : metricPair (fun i j => M (e i) (e j)) (fun i => g (e i)) (fun i => b (e i)) = metricPair M g b := sum_two_reindex e (fun i j => M i j * g i * b j) lemma metricTrace_reindex (e : η ≃ ι) (M H : ι → ι → R) : metricTrace (fun i j => M (e i) (e j)) (fun i j => H (e i) (e j)) = metricTrace M H := sum_two_reindex e (fun i j => M i j * H i j) lemma contract_reindex (e : η ≃ ι) (H : ι → ι → R) (g b : ι → R) : contract (fun i j => H (e i) (e j)) (fun i => g (e i)) (fun i => b (e i)) = contract H g b := sum_two_reindex e (fun i j => H i j * g i * b j) lemma operator_reindex (e : η ≃ ι) (M H : ι → ι → R) (g : ι → R) : operator (fun i j => M (e i) (e j)) (fun i => g (e i)) (fun i j => H (e i) (e j)) = operator M g H := by have hr : raiseIndex (fun i j => M (e i) (e j)) (fun i => g (e i)) = (fun i => raiseIndex M g (e i)) := funext (raiseIndex_reindex e M g) have hc : contract (fun i j => H (e i) (e j)) (raiseIndex (fun i j => M (e i) (e j)) (fun i => g (e i))) (raiseIndex (fun i j => M (e i) (e j)) (fun i => g (e i))) = contract H (raiseIndex M g) (raiseIndex M g) := by rw [hr] exact contract_reindex e H (raiseIndex M g) (raiseIndex M g) exact congrArg₂ (· - ·) (congrArg₂ (· * ·) (metricPair_reindex e M g g) (metricTrace_reindex e M H)) hc variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] theorem jetOperator_reindex (e : η ≃ ι) (M : ι → ι → ℂ) (v : ι → E) (f : E → ℂ) (x : E) : jetOperator (fun i j => M (e i) (e j)) (fun i => v (e i)) f x = jetOperator M v f x := by unfold jetOperator exact operator_reindex (R := ℂ) e M (fun i j => fderiv ℂ (fderiv ℂ f) x (v i) (v j)) (fun i => fderiv ℂ f x (v i)) end end Source29MetricReindex /- Component: NormalProductCoordinates.inc -/ namespace Source29NormalProductCoordinates open Source29FullNormalChart Source29AnalyticGraphEquation Source29MetricJet open Source29LocalMaximumBound noncomputable section def normalIndex : Option (Fin 7) ≃ Fin 8 := (finSuccEquiv' 0).symm lemma normalIndex_none : normalIndex none = 0 := by simp [normalIndex] lemma normalIndex_some (i : Fin 7) : normalIndex (some i) = i.succ := by simp [normalIndex] def pack : (ℂ × CSpace 7) →L[ℂ] (Fin 8 → ℂ) := LinearMap.toContinuousLinearMap { toFun := fun x => Fin.cons x.1 (fun i => x.2 i) map_add' := by intro x y funext i refine Fin.cases ?_ (fun j => ?_) i <;> simp map_smul' := by intro a x funext i refine Fin.cases ?_ (fun j => ?_) i <;> simp } lemma pack_apply (x : ℂ × CSpace 7) : pack x = Fin.cons x.1 (fun i => x.2 i) := rfl lemma pack_graphDirections (i : Option (Fin 7)) : pack (graphDirections (fun j : Fin 7 => EuclideanSpace.single j 1) i) = Pi.single (normalIndex i) 1 := by cases i with | none => rw [normalIndex_none] funext j refine Fin.cases ?_ (fun k => ?_) j <;> simp [pack_apply, graphDirections, Pi.single_apply, Fin.succ_ne_zero] | some i => rw [normalIndex_some] funext j refine Fin.cases ?_ (fun k => ?_) j <;> simp [pack_apply, graphDirections, Pi.single_apply, Fin.succ_ne_zero, eq_comm] lemma inverseMetric_block (κ : ℝ) : (fun i j => inverseMetric κ (normalIndex i) (normalIndex j)) = blockMetric (Source29PreparedMaximumTrace.tangentMetric κ) (normalWeight κ)⁻¹ := by funext i j cases i <;> cases j <;> simp [normalIndex_none, normalIndex_some, blockMetric, Source29PreparedMaximumTrace.tangentMetric, inverseMetric, metricWeights, Fin.succ_ne_zero, eq_comm] end end Source29NormalProductCoordinates /- Component: NormalSliceGraphEquation.inc -/ /- The graph equation for actual simple roots in the normalized tangent chart. -/ namespace Source29NormalSliceGraphEquation open Source29LocalMaximumBound Source29TangentBasis Source29FullNormalChart open Source29ChartPolynomialJet Source29NormalProductCoordinates open Source29AnalyticJetRules Source29AnalyticGraphEquation Source29MetricJet open Filter open scoped Topology BigOperators noncomputable section def normalSlice (h : MvPolynomial (Fin 8) ℂ) (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (x : CSpace 7) : Polynomial ℂ := Source29SlicePolynomial.lineSlice (Source29PolynomialTranslation.translate h (fun i => z i)) (fun i => tangentEmbedding z κ hk hk1 hz hq x i) (fun i => normal z κ i) lemma normalSlice_eval (h : MvPolynomial (Fin 8) ℂ) (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (y : ℂ × CSpace 7) : (normalSlice h z κ hk hk1 hz hq y.2).eval y.1 = MvPolynomial.eval ((fun i => z i) + chartCLM z κ hk hk1 hz hq (pack y)) h := by unfold normalSlice rw [Source29SlicePolynomial.eval_lineSlice, Source29PolynomialTranslation.eval_translate] have hp : chartCLM z κ hk hk1 hz hq (pack y) = fun i => (tangentEmbedding z κ hk hk1 hz hq y.2 + y.1 • normal z κ) i := by change chart z κ hk hk1 hz hq (Fin.cons y.1 (fun i => y.2 i)) = _ exact chart_cons z κ hk hk1 hz hq y.1 (fun i => y.2 i) rw [hp] rfl lemma normalSlice_coeff_analytic (h : MvPolynomial (Fin 8) ℂ) (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (a : CSpace 7) (k : ℕ) : AnalyticAt ℂ (fun x => (normalSlice h z κ hk hk1 hz hq x).coeff k) a := by apply Source29SliceAnalytic.analyticAt_lineSlice_coeff intro i exact ((EuclideanSpace.proj i).comp (tangentEmbedding z κ hk hk1 hz hq).toContinuousLinearMap).analyticAt a theorem normalSlice_jet_zero (h : MvPolynomial (Fin 8) ℂ) (hdiv : h ∣ Source29FactorInheritance.cubicOperator h) (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (y : ℂ × CSpace 7) (hy : (normalSlice h z κ hk hk1 hz hq y.2).eval y.1 = 0) : jetOperator (blockMetric (Source29PreparedMaximumTrace.tangentMetric κ) (normalWeight κ)⁻¹) (graphDirections (fun i : Fin 7 => EuclideanSpace.single i 1)) (fun p : ℂ × CSpace 7 => (normalSlice h z κ hk hk1 hz hq p.2).eval p.1) y = 0 := by let F : (Fin 8 → ℂ) → ℂ := fun x => MvPolynomial.eval ((fun i => z i) + chartCLM z κ hk hk1 hz hq x) h have hF : AnalyticAt ℂ F (pack y) := by exact AnalyticAt.comp (g := fun v => MvPolynomial.eval v h) (f := fun x => (fun i => z i) + chartCLM z κ hk hk1 hz hq x) (x := pack y) (Source29MvPolynomialJet.analyticAt_eval h _) (analyticAt_const.add ((chartCLM z κ hk hk1 hz hq).analyticAt _)) have hfuneq : (fun p : ℂ × CSpace 7 => (normalSlice h z κ hk hk1 hz hq p.2).eval p.1) = (fun p => F (pack p)) := funext (normalSlice_eval h z κ hk hk1 hz hq) rw [hfuneq] have he := jetOperator_affine (blockMetric (Source29PreparedMaximumTrace.tangentMetric κ) (normalWeight κ)⁻¹) (graphDirections (fun i : Fin 7 => EuclideanSpace.single i 1)) F pack 0 y (by simpa only [zero_add] using hF) simp only [zero_add, pack_graphDirections] at he rw [he, ← inverseMetric_block κ, Source29MetricReindex.jetOperator_reindex normalIndex (inverseMetric κ) (fun i => Pi.single i 1) F (pack y)] apply chart_jetOperator_zero h hdiv z κ hk hk1 hz hq (pack y) rwa [normalSlice_eval] at hy /-- The implicit polynomial equation itself supplies the PDE for any local analytic simple root; no graph-PDE premise is assumed. -/ theorem normalSlice_graph_equation (h : MvPolynomial (Fin 8) ℂ) (hdiv : h ∣ Source29FactorInheritance.cubicOperator h) (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (f : CSpace 7 → ℂ) (a : CSpace 7) (hf : AnalyticAt ℂ f a) (hroot : ∀ᶠ x in 𝓝 a, (normalSlice h z κ hk hk1 hz hq x).eval (f x) = 0) (hsimple : (normalSlice h z κ hk hk1 hz hq a).derivative.eval (f a) ≠ 0) : let M := Source29PreparedMaximumTrace.tangentMetric κ let e := fun i : Fin 7 => EuclideanSpace.single i 1 let g := fun i => fderiv ℂ f a (e i) let H := fun i j => fderiv ℂ (fderiv ℂ f) a (e i) (e j) (1 + normalWeight κ * metricPair M g g) * metricTrace M H - normalWeight κ * contract H (raiseIndex M g) (raiseIndex M g) = 0 := by apply Source29SimpleRootGraphEquation.graph_equation_of_simple_root (normalSlice h z κ hk hk1 hz hq) a (Source29PolynomialTranslation.translate h (fun i => z i)).totalDegree (fun x => Source29SlicePolynomial.natDegree_lineSlice_le _ _ _) (normalSlice_coeff_analytic h z κ hk hk1 hz hq a) f hf hroot hsimple (Source29PreparedMaximumTrace.tangentMetric κ) (fun i j => inverseMetric_symmetric κ i.succ j.succ) (normalWeight κ) (normalWeight κ)⁻¹ (mul_inv_cancel₀ (normalWeight_ne_zero κ hk hk1)) (fun i : Fin 7 => EuclideanSpace.single i 1) exact normalSlice_jet_zero h hdiv z κ hk hk1 hz hq (f a,a) hroot.self_of_nhds end end Source29NormalSliceGraphEquation /- Component: NormalSliceExceptional.inc -/ /- Discriminant-free shrinking balls for the actual normal polynomial family. -/ namespace Source29NormalSliceExceptional open MvPolynomial Source29LocalMaximumBound Source29TangentBasis Source29FullNormalChart open Source29NormalSliceGraphEquation Source29AffinePolynomialChart open Source29LocalQuadratic (PreparedRoots) noncomputable section lemma specialized_chart_eq_normalSlice (h : MvPolynomial (Fin 8) ℂ) (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (x : CSpace 7) : Polynomial.map (eval (fun i => x i)) (curriedChart (chart z κ hk hk1 hz hq) (fun i => z i) h) = normalSlice h z κ hk hk1 hz hq x := by rw [specialize_curriedChart_eq_lineSlice, chart_cons_zero, chart_normal] unfold normalSlice rw [lineSlice_translate] theorem exists_exceptional_polynomial (h : MvPolynomial (Fin 8) ℂ) (hirr : Irreducible h) (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (data : PreparedRoots (Source29PolynomialTranslation.translate h (fun i => z i)) (tangentEmbedding z κ hk hk1 hz hq) (normal z κ)) : ∃ D : MvPolynomial (Fin 7) ℂ, D ≠ 0 ∧ ∀ x : CSpace 7, eval (fun i => x i) D ≠ 0 → ∀ w : ℂ, (normalSlice h z κ hk hk1 hz hq x).eval w = 0 → (normalSlice h z κ hk hk1 hz hq x).derivative.eval w ≠ 0 := by have hunit : (data.B 0).coeff 0 ≠ 0 := by simpa only [Polynomial.coeff_zero_eq_eval_zero] using data.unit_nonzero.self_of_nhds have hbase : Source29SlicePolynomial.lineSlice (Source29PolynomialTranslation.translate h (fun i => z i)) 0 (chart z κ hk hk1 hz hq (Fin.cons 1 (0 : Fin 7 → ℂ))) = Polynomial.X^data.s * data.B 0 := by rw [chart_normal] have he := data.factorization.self_of_nhds simpa only [map_zero, PiLp.zero_apply, Pi.zero_def, data.base] using he.symm obtain ⟨D, B, C, hD, hcert⟩ := exists_chart_exceptional_polynomial (chart z κ hk hk1 hz hq) (fun i => z i) h hirr data.s data.s_pos (data.B 0) hunit hbase refine ⟨D, hD, ?_⟩ intro x hx w hw have hs := Source29WholeSliceBezout.separable_map_of_bezout _ D B C hcert (eval (fun i => x i)) hx rw [specialized_chart_eq_normalSlice] at hs simpa only [Polynomial.eval₂_id] using hs.eval₂_derivative_ne_zero (RingHom.id ℂ) (by simpa only [Polynomial.eval₂_id] using hw) /-- Every strict maximum with an irreducible defining polynomial admits a ray and shrinking balls where every normal-slice root is simple. -/ theorem exists_simple_slice_balls (h : MvPolynomial (Fin 8) ℂ) (hirr : Irreducible h) (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (data : PreparedRoots (Source29PolynomialTranslation.translate h (fun i => z i)) (tangentEmbedding z κ hk hk1 hz hq) (normal z κ)) : ∃ v : CSpace 7, ∃ ε δ : ℝ, 0 < ε ∧ 0 < δ ∧ ∀ t : ℝ, 0 < t → t < δ → ∀ x : CSpace 7, ‖x - (t : ℂ) • v‖ ≤ ε*t → ∀ w : ℂ, (normalSlice h z κ hk hk1 hz hq x).eval w = 0 → (normalSlice h z κ hk hk1 hz hq x).derivative.eval w ≠ 0 := by obtain ⟨D, hD, hs⟩ := exists_exceptional_polynomial h hirr z κ hk hk1 hz hq data obtain ⟨v, ε, δ, hε, hδ, hballs⟩ := Source29PolynomialNonvanishingCone.exists_nonzero_shrinking_balls D hD exact ⟨v, ε, δ, hε, hδ, fun t ht htδ x hx => hs x (hballs t ht htδ x hx)⟩ end end Source29NormalSliceExceptional /- Component: ShrinkingBallControl.inc -/ namespace Source29ShrinkingBallControl open Filter open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] lemma norm_le_on_shrinking_ball (v x : E) (ε t : ℝ) (ht : 0 ≤ t) (hx : ‖x - (t : ℂ) • v‖ ≤ ε*t) : ‖x‖ ≤ (‖v‖+ε)*t := by have hnorm : ‖(t : ℂ) • v‖ = t * ‖v‖ := by rw [norm_smul] simp only [Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg ht] calc ‖x‖ = ‖(x - (t : ℂ) • v) + (t : ℂ) • v‖ := by rw [sub_add_cancel] _ ≤ ‖x - (t : ℂ) • v‖ + ‖(t : ℂ) • v‖ := norm_add_le _ _ _ ≤ ε*t + t*‖v‖ := by rw [hnorm] exact add_le_add hx le_rfl _ = (‖v‖+ε)*t := by ring /-- Every neighborhood property holds uniformly on sufficiently small balls whose radius and center are both proportional to a positive scale. -/ theorem eventually_on_shrinking_balls (v : E) (ε : ℝ) (hε : 0 < ε) (P : E → Prop) (hP : ∀ᶠ x in 𝓝 (0 : E), P x) : ∀ᶠ t : ℝ in 𝓝 0, 0 < t → ∀ x : E, ‖x - (t : ℂ) • v‖ ≤ ε*t → P x := by obtain ⟨r, hr, hball⟩ := Metric.mem_nhds_iff.mp hP have hb : 0 < ‖v‖+ε := add_pos_of_nonneg_of_pos (norm_nonneg v) hε have hδ : 0 < r/(‖v‖+ε) := div_pos hr hb filter_upwards [eventually_lt_nhds hδ] with t ht htpos x hx apply hball rw [Metric.mem_ball, dist_zero_right] exact (norm_le_on_shrinking_ball v x ε t htpos.le hx).trans_lt (by simpa [mul_comm] using (lt_div_iff₀ hb).mp ht) theorem quadratic_bound_on_shrinking_ball (v x : E) (ε t A : ℝ) (hε : 0 ≤ ε) (ht : 0 ≤ t) (hA : 0 ≤ A) (hx : ‖x - (t : ℂ) • v‖ ≤ ε*t) (w : ℂ) (hw : ‖w‖ ≤ A*‖x‖^2) : ‖w‖ ≤ (A*(‖v‖+ε)^2)*t^2 := by have hn := norm_le_on_shrinking_ball v x ε t ht hx have hs := (sq_le_sq₀ (norm_nonneg x) (mul_nonneg (add_nonneg (norm_nonneg v) hε) ht)).mpr hn calc ‖w‖ ≤ A*‖x‖^2 := hw _ ≤ A*((‖v‖+ε)*t)^2 := mul_le_mul_of_nonneg_left hs hA _ = (A*(‖v‖+ε)^2)*t^2 := by ring end end Source29ShrinkingBallControl /- Component: PreparedBallSheets.inc -/ namespace Source29PreparedBallSheets open Source29LocalMaximumBound Source29TangentBasis Source29NormalSliceGraphEquation open Source29LocalQuadratic (PreparedRoots) open scoped BigOperators noncomputable section /-- On any ball where preparation holds and the full slice has simple roots, the prepared roots admit analytic labels with their original mean and bound. -/ theorem exists_analytic_sheets_on_ball (h : MvPolynomial (Fin 8) ℂ) (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (data : PreparedRoots (Source29PolynomialTranslation.translate h (fun i => z i)) (tangentEmbedding z κ hk hk1 hz hq) (normal z κ)) (a : CSpace 7) (R A : ℝ) (hR : 0 < R) (hcoeff : ∀ x ∈ Metric.ball a R, ∀ k, AnalyticAt ℂ (fun y => (data.W y).coeff k) x) (hfactor : ∀ x ∈ Metric.ball a R, data.W x * data.B x = normalSlice h z κ hk hk1 hz hq x) (hquad : ∀ x ∈ Metric.ball a R, ∀ j, ‖data.roots x j‖ ≤ A*‖x‖^2) (hsimple : ∀ x ∈ Metric.ball a R, ∀ w : ℂ, (normalSlice h z κ hk hk1 hz hq x).eval w = 0 → (normalSlice h z κ hk hk1 hz hq x).derivative.eval w ≠ 0) : ∃ f : Fin data.s → CSpace 7 → ℂ, (∀ j, AnalyticOnNhd ℂ (f j) (Metric.ball a R)) ∧ (∀ x ∈ Metric.ball a R, (∑ j, f j x) = ∑ j, data.roots x j) ∧ (∀ x ∈ Metric.ball a R, ∀ j, ‖f j x‖ ≤ A*‖x‖^2) ∧ (∀ x ∈ Metric.ball a R, ∀ j, (normalSlice h z κ hk hk1 hz hq x).eval (f j x) = 0) ∧ (∀ x ∈ Metric.ball a R, ∀ j, (normalSlice h z κ hk hk1 hz hq x).derivative.eval (f j x) ≠ 0) := by have hfull (x : CSpace 7) (hx : x ∈ Metric.ball a R) (w : ℂ) (hw : (data.W x).eval w = 0) : (normalSlice h z κ hk hk1 hz hq x).eval w = 0 := by rw [← hfactor x hx, Polynomial.eval_mul, hw, zero_mul] have hsimpleW : ∀ x ∈ Metric.ball a R, ∀ w : ℂ, (data.W x).eval w = 0 → (data.W x).derivative.eval w ≠ 0 := by intro x hx w hw hd apply hsimple x hx w (hfull x hx w hw) rw [← hfactor x hx, Polynomial.derivative_mul, Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_mul, hd, hw] ring obtain ⟨f, hf, hinj, hmult, hex⟩ := Source29RootCover.exists_analytic_root_labels_on_ball data.W data.s data.s_pos a R hR (fun x => (data.monic_degree x).1) (fun x => (data.monic_degree x).2) hcoeff hsimpleW have hrootW (x : CSpace 7) (hx : x ∈ Metric.ball a R) (j : Fin data.s) : (data.W x).eval (f j x) = 0 := (hex x hx (f j x)).mpr ⟨j,rfl⟩ refine ⟨f, hf, ?_, ?_, ?_, ?_⟩ · intro x hx have he := congrArg Multiset.sum ((hmult x hx).trans (data.root_multiset x).symm) simpa only [Multiset.sum_coe, List.sum_ofFn] using he · intro x hx j have hm : f j x ∈ (List.ofFn (data.roots x) : Multiset ℂ) := by rw [data.root_multiset, ← hmult x hx] exact List.mem_ofFn.mpr ⟨j,rfl⟩ obtain ⟨k, hk⟩ := List.mem_ofFn.mp hm rw [← hk] exact hquad x hx k · intro x hx j exact hfull x hx (f j x) (hrootW x hx j) · intro x hx j exact hsimple x hx (f j x) (hfull x hx (f j x) (hrootW x hx j)) end end Source29PreparedBallSheets /- Component: PreparedShrinkingSheets.inc -/ namespace Source29PreparedShrinkingSheets open Source29LocalMaximumBound Source29TangentBasis Source29NormalSliceGraphEquation open Source29LocalQuadratic (PreparedRoots) open Filter open scoped Topology BigOperators noncomputable section theorem exists_shrinking_sheet_family (h : MvPolynomial (Fin 8) ℂ) (hirr : Irreducible h) (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (data : PreparedRoots (Source29PolynomialTranslation.translate h (fun i => z i)) (tangentEmbedding z κ hk hk1 hz hq) (normal z κ)) : ∃ (v : CSpace 7) (ε A : ℝ) (f : ℝ → Fin data.s → CSpace 7 → ℂ), 0 < ε ∧ 0 < A ∧ ∀ᶠ t : ℝ in 𝓝[>] 0, (∀ j, AnalyticOnNhd ℂ (f t j) (Metric.ball ((t : ℂ) • v) (ε*t))) ∧ (∀ x ∈ Metric.ball ((t : ℂ) • v) (ε*t), (∑ j, f t j x) = ∑ j, data.roots x j) ∧ (∀ x ∈ Metric.ball ((t : ℂ) • v) (ε*t), ∀ j, ‖f t j x‖ ≤ A*‖x‖^2) ∧ (∀ x ∈ Metric.ball ((t : ℂ) • v) (ε*t), ∀ j, (normalSlice h z κ hk hk1 hz hq x).eval (f t j x) = 0) ∧ (∀ x ∈ Metric.ball ((t : ℂ) • v) (ε*t), ∀ j, (normalSlice h z κ hk hk1 hz hq x).derivative.eval (f t j x) ≠ 0) := by obtain ⟨v, ε, δ, hε, hδ, hsimple⟩ := Source29NormalSliceExceptional.exists_simple_slice_balls h hirr z κ hk hk1 hz hq data obtain ⟨A, hA, hquad⟩ := data.quadratic_bound have hcoeff := Source29AnalyticSimpleRoot.eventually_analytic_coefficients data.W 0 data.s (fun x => (data.monic_degree x).2.le) data.coefficients_analytic have hcb := Source29ShrinkingBallControl.eventually_on_shrinking_balls v ε hε _ hcoeff have hfb := Source29ShrinkingBallControl.eventually_on_shrinking_balls v ε hε _ data.factorization have hqb := Source29ShrinkingBallControl.eventually_on_shrinking_balls v ε hε _ hquad have hex : ∀ᶠ t : ℝ in 𝓝[>] 0, ∃ g : Fin data.s → CSpace 7 → ℂ, (∀ j, AnalyticOnNhd ℂ (g j) (Metric.ball ((t : ℂ) • v) (ε*t))) ∧ (∀ x ∈ Metric.ball ((t : ℂ) • v) (ε*t), (∑ j, g j x) = ∑ j, data.roots x j) ∧ (∀ x ∈ Metric.ball ((t : ℂ) • v) (ε*t), ∀ j, ‖g j x‖ ≤ A*‖x‖^2) ∧ (∀ x ∈ Metric.ball ((t : ℂ) • v) (ε*t), ∀ j, (normalSlice h z κ hk hk1 hz hq x).eval (g j x) = 0) ∧ (∀ x ∈ Metric.ball ((t : ℂ) • v) (ε*t), ∀ j, (normalSlice h z κ hk hk1 hz hq x).derivative.eval (g j x) ≠ 0) := by filter_upwards [self_mem_nhdsWithin, (eventually_lt_nhds hδ).filter_mono nhdsWithin_le_nhds, hcb.filter_mono nhdsWithin_le_nhds, hfb.filter_mono nhdsWithin_le_nhds, hqb.filter_mono nhdsWithin_le_nhds] with t ht htδ hc hf hqbnd have htpos : 0 < t := ht apply Source29PreparedBallSheets.exists_analytic_sheets_on_ball h z κ hk hk1 hz hq data ((t : ℂ) • v) (ε*t) A (mul_pos hε htpos) · intro x hx exact hc htpos x (by simpa only [dist_eq_norm] using (Metric.mem_ball.mp hx).le) · intro x hx exact hf htpos x (by simpa only [dist_eq_norm] using (Metric.mem_ball.mp hx).le) · intro x hx exact hqbnd htpos x (by simpa only [dist_eq_norm] using (Metric.mem_ball.mp hx).le) · intro x hx exact hsimple t htpos htδ x (by simpa only [dist_eq_norm] using (Metric.mem_ball.mp hx).le) obtain ⟨f, hf⟩ := hex.choice exact ⟨v, ε, A, f, hε, hA, hf⟩ end end Source29PreparedShrinkingSheets /- Component: PreparedMeanTraceZero.inc -/ namespace Source29PreparedMeanTraceZero open Source29LocalMaximumBound Source29TangentBasis Source29NormalSliceGraphEquation open Source29PreparedMaximumTrace Source29TransverseTraceBound open Source29LocalQuadratic (PreparedRoots) open Filter open scoped Topology BigOperators noncomputable section theorem prepared_mean_trace_zero (h : MvPolynomial (Fin 8) ℂ) (hirr : Irreducible h) (hdiv : h ∣ Source29FactorInheritance.cubicOperator h) (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (data : PreparedRoots (Source29PolynomialTranslation.translate h (fun i => z i)) (tangentEmbedding z κ hk hk1 hz hq) (normal z κ)) : Source29AnalyticMeanHessian.hessianTrace (tangentMetric κ) (fun i : Fin 7 => EuclideanSpace.single i 1) (fun x => mean (data.roots x)) 0 = 0 := by letI : NeZero data.s := ⟨Nat.ne_of_gt data.s_pos⟩ obtain ⟨v, ε, A, f, hε, hA, hfamily⟩ := Source29PreparedShrinkingSheets.exists_shrinking_sheet_family h hirr z κ hk hk1 hz hq data let p : ℝ → CSpace 7 := fun t => (t : ℂ) • v let e : Fin 7 → CSpace 7 := fun i => EuclideanSpace.single i 1 let μ : CSpace 7 → ℂ := fun x => mean (data.roots x) let B := A*(‖v‖+ε/2)^2 have hpos : ∀ᶠ t : ℝ in 𝓝[>] 0, 0 < t := self_mem_nhdsWithin have hscale : Tendsto (fun t : ℝ => t) (𝓝[>] 0) (𝓝 0) := tendsto_id.mono_left nhdsWithin_le_nhds have hp : Tendsto p (𝓝[>] 0) (𝓝 0) := by have hp' : Continuous p := Complex.continuous_ofReal.smul continuous_const simpa only [p, Complex.ofReal_zero, zero_smul] using (hp'.tendsto (0 : ℝ)).mono_left nhdsWithin_le_nhds have hsub (t : ℝ) (ht : 0 < t) : Metric.closedBall (p t) ((ε/2)*t) ⊆ Metric.ball (p t) (ε*t) := by intro x hx apply Metric.mem_ball.mpr exact (Metric.mem_closedBall.mp hx).trans_lt (mul_lt_mul_of_pos_right (by linarith : ε/2 < ε) ht) have hcenter (t : ℝ) (ht : 0 < t) : p t ∈ Metric.ball (p t) (ε*t) := Metric.mem_ball_self (mul_pos hε ht) have hf : ∀ᶠ t : ℝ in 𝓝[>] 0, ∀ j, AnalyticOnNhd ℂ (f t j) (Metric.closedBall (p t) ((ε/2)*t)) := by filter_upwards [hfamily, hpos] with t ht htpos intro j x hx exact ht.1 j x (hsub t htpos hx) have hb : ∀ᶠ t : ℝ in 𝓝[>] 0, ∀ j, ∀ x ∈ Metric.closedBall (p t) ((ε/2)*t), ‖f t j x‖ ≤ B*t^2 := by filter_upwards [hfamily, hpos] with t ht htpos j x hx exact Source29ShrinkingBallControl.quadratic_bound_on_shrinking_ball v x (ε/2) t A (half_pos hε).le htpos.le hA.le (by simpa only [p, Metric.mem_closedBall, dist_eq_norm] using hx) (f t j x) (ht.2.2.1 x (hsub t htpos hx) j) have hμ : AnalyticAt ℂ μ 0 := Source29RootMean.analyticAt_mean data.roots 0 data.sum_analytic have hc : (data.s : ℂ) ≠ 0 := by exact_mod_cast Nat.ne_of_gt data.s_pos have hsum : ∀ᶠ t : ℝ in 𝓝[>] 0, (fun x => ∑ j, f t j x) =ᶠ[𝓝 (p t)] (fun x => (data.s : ℂ)*μ x) := by filter_upwards [hfamily, hpos] with t ht htpos filter_upwards [Metric.isOpen_ball.mem_nhds (hcenter t htpos)] with x hx rw [ht.2.1 x hx] simp only [μ, mean, Fintype.card_fin, Complex.ofReal_natCast] field_simp have hPDE : ∀ j, ∀ᶠ t : ℝ in 𝓝[>] 0, let g := fun i => fderiv ℂ (f t j) (p t) (e i) let H := fun i k => fderiv ℂ (fderiv ℂ (f t j)) (p t) (e i) (e k) (1 + Source29FullNormalChart.normalWeight κ * Source29MetricJet.metricPair (tangentMetric κ) g g) * Source29MetricJet.metricTrace (tangentMetric κ) H - Source29FullNormalChart.normalWeight κ * Source29MetricJet.contract H (Source29MetricJet.raiseIndex (tangentMetric κ) g) (Source29MetricJet.raiseIndex (tangentMetric κ) g) = 0 := by intro j filter_upwards [hfamily, hpos] with t ht htpos apply normalSlice_graph_equation h hdiv z κ hk hk1 hz hq (f t j) (p t) (ht.1 j (p t) (hcenter t htpos)) · filter_upwards [Metric.isOpen_ball.mem_nhds (hcenter t htpos)] with x hx exact ht.2.2.2.1 x hx j · exact ht.2.2.2.2 (p t) (hcenter t htpos) j exact Source29AnalyticSheetMeanTrace.mean_hessianTrace_eq_zero (tangentMetric κ) e (fun i => by simp [e]) f p (fun t => t) (ε/2) B (half_pos hε) hscale hpos hp hf hb μ hμ (data.s : ℂ) hc hsum (Source29FullNormalChart.normalWeight κ) hPDE end end Source29PreparedMeanTraceZero /- Component: ComplexDichotomy.inc -/ /- The algebraic and compactness part of the complex obstruction. The positive maximum alternative still needs the local hypersurface argument. -/ namespace Source29ComplexDichotomy open MvPolynomial open Source29ProjectiveMaximum open scoped BigOperators noncomputable section /-- Unless the irreducible hypersurface is the null quadric, it has a zero at which the quadric is nonzero. This is the precise Nullstellensatz step. -/ theorem exists_nonisotropic_zero (h : MvPolynomial (Fin 8) ℂ) (hh : Irreducible h) (hnq : ¬Source29Quadric.quadric ∣ h) : ∃ x : Fin 8 → ℂ, eval x h = 0 ∧ eval x Source29Quadric.quadric ≠ 0 := by letI : IsAlgClosed ℂ := Source29FTA.complex_isAlgClosed by_contra hnone push Not at hnone have hd := Source29ZeroLocus.irreducible_dvd_of_vanishing h Source29Quadric.quadric hh hnone exact hnq (hh.associated_of_dvd Source29Quadric.quadric_irreducible hd).symm.dvd /-- The maximum is positive whenever the hypersurface is not the null quadric. -/ theorem exists_positive_maximum (h : MvPolynomial (Fin 8) ℂ) (d : ℕ) (hh : Irreducible h) (hhom : h.IsHomogeneous d) (hreal : ∀ x : Fin 8 → ℝ, x ≠ 0 → eval (fun i => (x i : ℂ)) h ≠ 0) (hnq : ¬Source29Quadric.quadric ∣ h) : ∃ (κ : ℝ) (z : CSpace 8), 0 < κ ∧ κ < 1 ∧ ‖z‖ = 1 ∧ eval (fun i => z i) h = 0 ∧ quadricNorm z = κ ∧ ∀ w : CSpace 8, eval (fun i => w i) h = 0 → quadricNorm w ≤ κ * ‖w‖ ^ 2 := by obtain ⟨x, hxh, hxq⟩ := exists_nonisotropic_zero h hh hnq have hxne : x ≠ 0 := by intro he apply hxq simp [Source29Quadric.quadric, he] let w : CSpace 8 := WithLp.toLp 2 x have hwne : w ≠ 0 := by intro he apply hxne funext i exact congrArg (fun u : CSpace 8 => u i) he obtain ⟨κ, z, hk0, hk1, hzunit, hzh, hzq, hmax⟩ := exists_strict_spherical_maximum h hhom hreal w hwne hxh have hglobal := global_quadric_bound h hhom κ hmax have hwqpos : 0 < quadricNorm w := by apply norm_pos_iff.mpr simpa [Source29Quadric.quadric, w] using hxq have hkpos : 0 < κ := by by_contra hnot have hkneg : κ ≤ 0 := le_of_not_gt hnot have hbound := hglobal w hxh have hnonpos := mul_nonpos_of_nonpos_of_nonneg hkneg (sq_nonneg ‖w‖) linarith exact ⟨κ, z, hkpos, hk1, hzunit, hzh, hzq, hglobal⟩ /-- The complete global reduction used before the local analytic argument: either the desired divisibility holds, or there is a strictly positive, phase-normalized maximum. No differential equation has yet been used. -/ theorem quadric_dvd_or_normalized_maximum (h : MvPolynomial (Fin 8) ℂ) (d : ℕ) (hh : Irreducible h) (hhom : h.IsHomogeneous d) (hreal : ∀ x : Fin 8 → ℝ, x ≠ 0 → eval (fun i => (x i : ℂ)) h ≠ 0) : Source29Quadric.quadric ∣ h ∨ ∃ (κ : ℝ) (z : CSpace 8), 0 < κ ∧ κ < 1 ∧ ‖z‖ = 1 ∧ eval (fun i => z i) h = 0 ∧ (∑ i : Fin 8, (z i)^2) = (κ : ℂ) ∧ ∀ w : CSpace 8, eval (fun i => w i) h = 0 → quadricNorm w ≤ κ * ‖w‖ ^ 2 := by by_cases hq : Source29Quadric.quadric ∣ h · exact Or.inl hq right obtain ⟨κ, z, hk0, hk1, hzunit, hzh, hzq, hglobal⟩ := exists_positive_maximum h d hh hhom hreal hq have hnonzero : (∑ i : Fin 8, (z i)^2) ≠ 0 := by apply norm_pos_iff.mp change 0 < quadricNorm z rwa [hzq] obtain ⟨c, hcunit, hcq⟩ := Source29ComplexPhase.exists_quadratic_phase _ hnonzero refine ⟨κ, c • z, hk0, hk1, ?_, ?_, ?_, hglobal⟩ · rw [norm_smul, hcunit, hzunit, one_mul] · change eval (fun i => c * z i) h = 0 rw [eval_scale_of_isHomogeneous h d hhom, hzh, mul_zero] · change (∑ i : Fin 8, (c * z i)^2) = (κ : ℂ) simp only [mul_pow, ← Finset.mul_sum] rw [hcq] exact congrArg Complex.ofReal hzq end end Source29ComplexDichotomy /- Component: ComplexObstruction.inc -/ /- The local trace argument completes the complex hypersurface obstruction. -/ namespace Source29ComplexObstruction open MvPolynomial Source29LocalMaximumBound Source29TangentBasis open scoped BigOperators noncomputable section theorem no_positive_strict_maximum (h : MvPolynomial (Fin 8) ℂ) (hirr : Irreducible h) (d : ℕ) (hhom : h.IsHomogeneous d) (hdiv : h ∣ Source29FactorInheritance.cubicOperator h) (z : CSpace 8) (κ : ℝ) (hk : 0 < κ) (hk1 : κ < 1) (hz : ‖z‖ = 1) (hzero : eval (fun i => z i) h = 0) (hq : ∑ i : Fin 8, (z i)^2 = (κ : ℂ)) (hbound : ∀ v : CSpace 8, eval (fun i => v i) h = 0 → Source29ProjectiveMaximum.quadricNorm v ≤ κ * ‖v‖^2) : False := by obtain ⟨data⟩ := Source29LocalQuadratic.exists_prepared_roots_at_maximum h hirr.ne_zero z hzero κ hk hk1 hz hq hbound (tangentEmbedding z κ hk hk1 hz hq) (tangentEmbedding_normal z κ hk hk1 hz hq) exact Source29PreparedMaximumTrace.prepared_mean_trace_ne_zero h d hhom z κ hk hk1 hz hq hbound data (Source29PreparedMeanTraceZero.prepared_mean_trace_zero h hirr hdiv z κ hk hk1 hz hq data) /-- An irreducible homogeneous complex polynomial satisfying the divisor equation and having no nonzero real zero is divisible by the null quadric. -/ theorem complex_obstruction : Source29PositiveDivisor.ComplexObstruction8 := by intro h hirr hhom hdiv hreal rcases Source29ComplexDichotomy.quadric_dvd_or_normalized_maximum h h.totalDegree hirr hhom hreal with hquad | ⟨κ, z, hk, hk1, hz, hzero, hq, hbound⟩ · exact hquad · exact (no_positive_strict_maximum h hirr h.totalDegree hhom hdiv z κ hk hk1 hz hzero hq hbound).elim /-- The complex obstruction gives the positive homogeneous divisor result needed for the final all-degree argument. -/ theorem positive_divisor_obstruction : Source29Closing.PositiveHomogeneousDivisorObstruction8 := Source29PositiveDivisor.positive_divisor_obstruction_of_complex_obstruction complex_obstruction /-- The only remaining input here is the separately stated Guo leading-term theorem. This conditional result is not the requested submission target. -/ theorem problem29_of_Guo (hGuo : ∀ P : Source29Closing.Polynomial8, Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → Source29Closing.GuoData8 P) : Math30.Problem29 := Source29Closing.problem29_of_geometric_inputs hGuo positive_divisor_obstruction end end Source29ComplexObstruction /- Component: QuarticReuse.inc -/ /- Proven source28 components reused for the homogeneous cubic and quartic endpoint arguments. -/ namespace Source29QuarticReuse /- Component: Compatibility -/ section ComponentCompatibility /- The extensionality proofs below are adapted from Mathlib/Algebra/MvPolynomial/Funext.lean. Copyright (c) 2020 Johan Commelin. All rights reserved. Released under Apache 2.0 license as described in Mathlib's LICENSE. Authors: Johan Commelin. The evaluation compatibility proofs are adapted from Mathlib/Algebra/MvPolynomial/Polynomial.lean. Copyright (c) 2023 Kim Morrison. All rights reserved. Released under Apache 2.0 license as described in Mathlib's LICENSE. Authors: Kim Morrison. The homogeneous derivative and Euler proofs are adapted from Mathlib/RingTheory/MvPolynomial/EulerIdentity.lean. Copyright (c) 2024 Junyan Xu. All rights reserved. Released under Apache 2.0 license as described in Mathlib's LICENSE. Authors: Junyan Xu. -/ namespace QuarticCompatibility open MvPolynomial theorem polynomial_eval_eval₂ {R S σ : Type*} [CommSemiring R] [CommSemiring S] {x : S} (f : R →+* Polynomial S) (g : σ → Polynomial S) (p : MvPolynomial σ R) : Polynomial.eval x (eval₂ f g p) = eval₂ ((Polynomial.evalRingHom x).comp f) (fun s => Polynomial.eval x (g s)) p := by apply induction_on p · simp · intro p q hp hq simp [hp, hq] · intro p n hp simp [hp] theorem eval_polynomial_eval_finSuccEquiv {R : Type*} {n : ℕ} {x : Fin n → R} [CommSemiring R] (f : MvPolynomial (Fin (n + 1)) R) (q : MvPolynomial (Fin n) R) : (eval x) (Polynomial.eval q (finSuccEquiv R n f)) = eval (Fin.cases (eval x q) x) f := by simp only [finSuccEquiv_apply, coe_eval₂Hom, polynomial_eval_eval₂, eval_eval₂] conv in RingHom.comp _ _ => refine @RingHom.ext _ _ _ _ _ (RingHom.id _) fun r => ?_ simp simp only [eval₂_id] congr funext i refine Fin.cases (by simp) (by simp) i section Extensionality variable {R : Type*} [CommRing R] [IsDomain R] theorem polynomial_funext_fin {n : ℕ} {p : MvPolynomial (Fin n) R} (s : Fin n → Set R) (hs : ∀ i, (s i).Infinite) (h : ∀ x ∈ Set.pi .univ s, eval x p = 0) : p = 0 := by induction n with | zero => have hp := h 0 finZeroElim rw [eq_C_of_isEmpty p, eval_C] at hp rw [eq_C_of_isEmpty p, hp, map_zero] | succ n ih => apply (finSuccEquiv R n).injective rw [map_zero] apply Polynomial.eq_zero_of_infinite_isRoot apply ((hs 0).image (C_injective ..).injOn).mono rintro _ ⟨r, hr, rfl⟩ refine ih (s ·.succ) (fun _ ↦ hs _) fun x hx ↦ ?_ rw [eval_polynomial_eval_finSuccEquiv] exact h _ fun i _ ↦ i.cases (by simpa [eval_C] using hr) (by simpa using hx) theorem polynomial_funext_set {σ : Type*} {p q : MvPolynomial σ R} (s : σ → Set R) (hs : ∀ i, (s i).Infinite) (h : ∀ x ∈ Set.pi .univ s, eval x p = eval x q) : p = q := by suffices ∀ p, (∀ x ∈ Set.pi .univ s, eval x p = 0) → p = 0 by rw [← sub_eq_zero, this (p - q)] intro x hx simp_rw [map_sub, h x hx, sub_self] intro p h obtain ⟨n, f, hf, p, rfl⟩ := exists_fin_rename p suffices p = 0 by rw [this, map_zero] refine polynomial_funext_fin (s ∘ f) (fun _ ↦ hs _) fun x hx ↦ ?_ choose g hg using fun i ↦ (hs i).nonempty convert! h (Function.extend f x g) fun i _ ↦ ?_ · simp only [eval, eval₂Hom_rename, Function.extend_comp hf] obtain ⟨i, rfl⟩ | nex := em (∃ x, f x = i) · rw [hf.extend_apply]; exact hx _ ⟨⟩ · simp_rw [Function.extend, dite_eq_right nex, hg] theorem polynomial_funext [Infinite R] {σ : Type*} {p q : MvPolynomial σ R} (h : ∀ x : σ → R, eval x p = eval x q) : p = q := polynomial_funext_set _ (fun _ ↦ Set.infinite_univ) fun _ _ ↦ h _ end Extensionality section Homogeneity open Finsupp variable {R σ M : Type*} [CommSemiring R] {φ : MvPolynomial σ R} theorem weighted_homogeneous_pderiv [AddCancelCommMonoid M] {w : σ → M} {n n' : M} {i : σ} (h : φ.IsWeightedHomogeneous w n) (h' : n' + w i = n) : (pderiv i φ).IsWeightedHomogeneous w n' := by rw [← mem_weightedHomogeneousSubmodule, weightedHomogeneousSubmodule_eq_finsupp_supported, AddMonoidAlgebra.supported_eq_span_single] at h refine Submodule.span_induction ?_ ?_ (fun p q _ _ hp hq ↦ ?_) (fun r p _ h ↦ ?_) h · rintro _ ⟨m, hm, rfl⟩ simp_rw [single_eq_monomial, pderiv_monomial, one_mul] by_cases hi : m i = 0 · rw [hi, Nat.cast_zero, monomial_zero]; apply isWeightedHomogeneous_zero convert! isWeightedHomogeneous_monomial .. rw [← add_right_cancel_iff (a := w i), h', ← hm, weight_sub_single_add hi] · rw [map_zero]; apply isWeightedHomogeneous_zero · rw [map_add]; exact hp.add hq · rw [(pderiv i).map_smul]; exact (weightedHomogeneousSubmodule ..).smul_mem _ h theorem homogeneous_pderiv {n : ℕ} {i : σ} (h : φ.IsHomogeneous n) : (pderiv i φ).IsHomogeneous (n - 1) := by obtain _ | n := n · rw [← totalDegree_zero_iff_isHomogeneous, totalDegree_eq_zero_iff_eq_C] at h rw [h, pderiv_C]; apply isHomogeneous_zero · exact weighted_homogeneous_pderiv h rfl variable [Fintype σ] {n : ℕ} open Finset in theorem weighted_sum_X_mul_pderiv {w : σ → ℕ} (h : φ.IsWeightedHomogeneous w n) : ∑ i : σ, w i • (X i * pderiv i φ) = n • φ := by rw [← mem_weightedHomogeneousSubmodule, weightedHomogeneousSubmodule_eq_finsupp_supported, AddMonoidAlgebra.supported_eq_span_single] at h refine Submodule.span_induction ?_ ?_ (fun p q _ _ hp hq ↦ ?_) (fun r p _ h ↦ ?_) h · rintro _ ⟨m, hm, rfl⟩ simp_rw [single_eq_monomial, X_mul_pderiv_monomial, smul_smul, ← sum_smul, mul_comm (w _)] congr rwa [Set.mem_ofPred, weight_apply, sum_fintype] at hm intro; apply zero_smul · simp · simp_rw [map_add, left_distrib, smul_add, sum_add_distrib, hp, hq] · simp_rw [(pderiv _).map_smul, nsmul_eq_mul, mul_smul_comm, ← Finset.smul_sum, ← nsmul_eq_mul, h] theorem sum_X_mul_pderiv (h : φ.IsHomogeneous n) : ∑ i : σ, X i * pderiv i φ = n • φ := by simp_rw [← weighted_sum_X_mul_pderiv h, Pi.one_apply, one_smul] end Homogeneity end QuarticCompatibility end ComponentCompatibility /- Component: MatrixAlgebra -/ section ComponentMatrixAlgebra /-! Algebraic invariance of the minimal-graph numerator under a matrix whose rows are orthonormal. The identities hold over any commutative ring, including a multivariate polynomial ring. -/ namespace QuarticMinimal.MatrixAlgebra open Matrix variable {R : Type*} [CommRing R] variable {m n : Type*} [Fintype m] [Fintype n] [DecidableEq m] theorem dot_transpose_mulVec (A : Matrix m n R) (hA : A * Aᵀ = 1) (v w : m → R) : (Aᵀ *ᵥ v) ⬝ᵥ (Aᵀ *ᵥ w) = v ⬝ᵥ w := by rw [dotProduct_transpose_mulVec, mulVec_mulVec, hA, one_mulVec, dotProduct_comm] theorem trace_conjugate (A : Matrix m n R) (hA : A * Aᵀ = 1) (H : Matrix m m R) : trace (Aᵀ * H * A) = trace H := by rw [trace_mul_cycle, hA, one_mul] theorem conjugate_mulVec (A : Matrix m n R) (hA : A * Aᵀ = 1) (H : Matrix m m R) (v : m → R) : (Aᵀ * H * A) *ᵥ (Aᵀ *ᵥ v) = Aᵀ *ᵥ (H *ᵥ v) := by calc (Aᵀ * H * A) *ᵥ (Aᵀ *ᵥ v) = (Aᵀ * H * (A * Aᵀ)) *ᵥ v := by rw [mulVec_mulVec, Matrix.mul_assoc] _ = (Aᵀ * H) *ᵥ v := by rw [hA, Matrix.mul_one] _ = Aᵀ *ᵥ (H *ᵥ v) := (mulVec_mulVec v Aᵀ H).symm theorem contraction_conjugate (A : Matrix m n R) (hA : A * Aᵀ = 1) (H : Matrix m m R) (v : m → R) : (Aᵀ *ᵥ v) ⬝ᵥ ((Aᵀ * H * A) *ᵥ (Aᵀ *ᵥ v)) = v ⬝ᵥ (H *ᵥ v) := by rw [conjugate_mulVec A hA, dot_transpose_mulVec A hA] theorem minimal_expression_invariant (A : Matrix m n R) (hA : A * Aᵀ = 1) (H : Matrix m m R) (v : m → R) : (1 + (Aᵀ *ᵥ v) ⬝ᵥ (Aᵀ *ᵥ v)) * trace (Aᵀ * H * A) - (Aᵀ *ᵥ v) ⬝ᵥ ((Aᵀ * H * A) *ᵥ (Aᵀ *ᵥ v)) = (1 + v ⬝ᵥ v) * trace H - v ⬝ᵥ (H *ᵥ v) := by rw [dot_transpose_mulVec A hA, trace_conjugate A hA, contraction_conjugate A hA] omit [Fintype m] in theorem map_mul_transpose {S : Type*} [CommRing S] (f : R →+* S) (A : Matrix m n R) (hA : A * Aᵀ = 1) : A.map f * (A.map f)ᵀ = 1 := by have hm := congrArg (fun M : Matrix m m R => M.map f) hA simpa [Matrix.transpose_map] using hm omit [Fintype m] in theorem algebraMap_mul_transpose [Algebra ℝ R] (A : Matrix m n ℝ) (hA : A * Aᵀ = 1) : A.map (algebraMap ℝ R) * (A.map (algebraMap ℝ R))ᵀ = 1 := map_mul_transpose (algebraMap ℝ R) A hA end QuarticMinimal.MatrixAlgebra end ComponentMatrixAlgebra /- Component: PolynomialBasics -/ section ComponentPolynomialBasics noncomputable section open scoped BigOperators open MvPolynomial namespace QuarticPolynomialBasics variable {σ : Type*} lemma exponent_decompose_one (m : σ →₀ ℕ) (h : 1 ≤ m.degree) : ∃ (i : σ) (r : σ →₀ ℕ), r + Finsupp.single i 1 = m := by classical have hm : m ≠ 0 := by intro hm; simp [hm] at h obtain ⟨i, hi⟩ : ∃ i, m i ≠ 0 := by by_contra hh push Not at hh exact hm (Finsupp.ext hh) exact ⟨i, m - Finsupp.single i 1, Finsupp.sub_add_single_one_cancel hi⟩ lemma exponent_decompose_two (m : σ →₀ ℕ) (h : 2 ≤ m.degree) : ∃ (i j : σ) (r : σ →₀ ℕ), r + Finsupp.single i 1 + Finsupp.single j 1 = m := by obtain ⟨j, s, hs⟩ := exponent_decompose_one m (by omega) have hsdeg : 1 ≤ s.degree := by have hh := congrArg Finsupp.degree hs simp only [map_add, Finsupp.degree_single] at hh omega obtain ⟨i, r, hr⟩ := exponent_decompose_one s hsdeg exact ⟨i, j, r, by rw [hr, hs]⟩ lemma coeff_second_partial (P : MvPolynomial σ ℝ) (i j : σ) (r : σ →₀ ℕ) : (pderiv i (pderiv j P)).coeff r = P.coeff (r + Finsupp.single i 1 + Finsupp.single j 1) * (((r + Finsupp.single i 1 : σ →₀ ℕ) j : ℝ) + 1) * (r i + 1) := by rw [coeff_pderiv, coeff_pderiv] lemma second_partial_comm (P : MvPolynomial σ ℝ) (i j : σ) : pderiv i (pderiv j P) = pderiv j (pderiv i P) := by classical ext r rw [coeff_second_partial, coeff_second_partial] by_cases h : i = j · subst j; rfl · simp [h, Ne.symm h, add_right_comm, mul_right_comm] lemma totalDegree_le_one_of_second_partials_zero (P : MvPolynomial σ ℝ) (h : ∀ i j, pderiv i (pderiv j P) = 0) : P.totalDegree ≤ 1 := by classical apply Finset.sup_le intro m hm change m.degree ≤ 1 by_contra hh obtain ⟨i, j, r, hr⟩ := exponent_decompose_two m (by omega) have hc := congrArg (fun Q : MvPolynomial σ ℝ ↦ Q.coeff r) (h i j) rw [coeff_second_partial, hr, AddMonoidAlgebra.coeff_zero] at hc have hn : P.coeff m ≠ 0 := mem_support_iff.mp hm have ha : (((r + Finsupp.single i 1 : σ →₀ ℕ) j : ℕ) : ℝ) + 1 ≠ 0 := by positivity have hb : ((r i : ℕ) : ℝ) + 1 ≠ 0 := by positivity exact (mul_ne_zero (mul_ne_zero hn ha) hb) hc lemma second_partials_zero_of_totalDegree_le_one (P : MvPolynomial σ ℝ) (h : P.totalDegree ≤ 1) (i j : σ) : pderiv i (pderiv j P) = 0 := by classical ext r rw [coeff_second_partial, AddMonoidAlgebra.coeff_zero] have hc : P.coeff (r + Finsupp.single i 1 + Finsupp.single j 1) = 0 := by apply coeff_eq_zero_of_totalDegree_lt change P.totalDegree < (r + Finsupp.single i 1 + Finsupp.single j 1).degree simp only [map_add, Finsupp.degree_single] omega simp [hc] lemma totalDegree_le_one_iff_second_partials_zero (P : MvPolynomial σ ℝ) : P.totalDegree ≤ 1 ↔ ∀ i j, pderiv i (pderiv j P) = 0 := ⟨second_partials_zero_of_totalDegree_le_one P, totalDegree_le_one_of_second_partials_zero P⟩ lemma totalDegree_pderiv_le_of_totalDegree_le (P : MvPolynomial σ ℝ) (i : σ) (d : ℕ) (h : P.totalDegree ≤ d + 1) : (pderiv i P).totalDegree ≤ d := by classical apply Finset.sup_le intro m hm change m.degree ≤ d have hc : P.coeff (m + Finsupp.single i 1) ≠ 0 := by have hh := mem_support_iff.mp hm rw [coeff_pderiv] at hh exact (mul_ne_zero_iff.mp hh).1 have hd := le_totalDegree (mem_support_iff.mpr hc) change (m + Finsupp.single i 1).degree ≤ P.totalDegree at hd simp only [map_add, Finsupp.degree_single] at hd omega lemma totalDegree_pderiv_le (P : MvPolynomial σ ℝ) (i : σ) : (pderiv i P).totalDegree ≤ P.totalDegree - 1 := totalDegree_pderiv_le_of_totalDegree_le P i _ (by omega) lemma pderiv_homogeneousComponent (P : MvPolynomial σ ℝ) (i : σ) (d : ℕ) : pderiv i (homogeneousComponent (d + 1) P) = homogeneousComponent d (pderiv i P) := by classical ext m simp only [coeff_pderiv, coeff_homogeneousComponent, map_add, Finsupp.degree_single] by_cases h : m.degree = d <;> simp [h] lemma isHomogeneous_pderiv_succ (P : MvPolynomial σ ℝ) (i : σ) (d : ℕ) (h : P.IsHomogeneous (d + 1)) : (pderiv i P).IsHomogeneous d := by have hh := pderiv_homogeneousComponent P i d rw [homogeneousComponent_eq_self h] at hh rw [hh] exact homogeneousComponent_isHomogeneous _ _ lemma totalDegree_sub_homogeneousComponent_le (P : MvPolynomial σ ℝ) (d : ℕ) (h : P.totalDegree ≤ d) : (P - homogeneousComponent d P).totalDegree ≤ d - 1 := by classical apply Finset.sup_le intro m hm change m.degree ≤ d - 1 have hc := mem_support_iff.mp hm simp only [coeff_sub, coeff_homogeneousComponent] at hc split_ifs at hc with hd · exact False.elim (hc (sub_self _)) · simp only [sub_zero] at hc have hh := le_totalDegree (mem_support_iff.mpr hc) change m.degree ≤ P.totalDegree at hh omega lemma top_homogeneousComponent_ne_zero (P : MvPolynomial σ ℝ) (h : 0 < P.totalDegree) : homogeneousComponent P.totalDegree P ≠ 0 := by intro hh have hdeg := totalDegree_sub_homogeneousComponent_le P P.totalDegree le_rfl rw [hh, sub_zero] at hdeg omega lemma totalDegree_sub_top_homogeneousComponent_lt (P : MvPolynomial σ ℝ) (h : 0 < P.totalDegree) : (P - homogeneousComponent P.totalDegree P).totalDegree < P.totalDegree := by have hdeg := totalDegree_sub_homogeneousComponent_le P P.totalDegree le_rfl omega lemma homogeneousComponent_mul_top (P Q : MvPolynomial σ ℝ) (d e : ℕ) (hP : P.totalDegree ≤ d) (hQ : Q.totalDegree ≤ e) : homogeneousComponent (d + e) (P * Q) = homogeneousComponent d P * homogeneousComponent e Q := by by_cases hd : d = 0 · subst d have hp0 : P.totalDegree = 0 := Nat.eq_zero_of_le_zero hP rw [(totalDegree_eq_zero_iff_eq_C.mp hp0)] simp [homogeneousComponent_C_mul, homogeneousComponent_zero] by_cases he : e = 0 · subst e have hq0 : Q.totalDegree = 0 := Nat.eq_zero_of_le_zero hQ rw [(totalDegree_eq_zero_iff_eq_C.mp hq0)] rw [mul_comm P (C (Q.coeff 0)), homogeneousComponent_C_mul] simp [homogeneousComponent_zero, mul_comm] have hdp := totalDegree_sub_homogeneousComponent_le P d hP have hdq := totalDegree_sub_homogeneousComponent_le Q e hQ have htp : (homogeneousComponent d P).totalDegree ≤ d := (homogeneousComponent_isHomogeneous d P).totalDegree_le have hz1 : homogeneousComponent (d + e) ((P - homogeneousComponent d P) * Q) = 0 := by apply homogeneousComponent_eq_zero have hh := totalDegree_mul (P - homogeneousComponent d P) Q omega have hz2 : homogeneousComponent (d + e) (homogeneousComponent d P * (Q - homogeneousComponent e Q)) = 0 := by apply homogeneousComponent_eq_zero have hh := totalDegree_mul (homogeneousComponent d P) (Q - homogeneousComponent e Q) omega have heq : P * Q = homogeneousComponent d P * homogeneousComponent e Q + ((P - homogeneousComponent d P) * Q + homogeneousComponent d P * (Q - homogeneousComponent e Q)) := by ring rw [heq, map_add, map_add, hz1, hz2, add_zero, add_zero] exact homogeneousComponent_eq_self ((homogeneousComponent_isHomogeneous d P).mul (homogeneousComponent_isHomogeneous e Q)) /-- The polynomial numerator of the scalar minimal graph equation. This is definitionally equal to the corresponding operator in the challenge. -/ def minimalGraphOperator {n : ℕ} (P : MvPolynomial (Fin n) ℝ) : MvPolynomial (Fin n) ℝ := (1 + ∑ i : Fin n, (pderiv i P) ^ 2) * (∑ i : Fin n, pderiv i (pderiv i P)) - ∑ i : Fin n, ∑ j : Fin n, pderiv i P * pderiv j P * pderiv i (pderiv j P) lemma minimalGraphOperator_zero_variables (P : MvPolynomial (Fin 0) ℝ) : minimalGraphOperator P = 0 := by simp [minimalGraphOperator] lemma totalDegree_zero_variables (P : MvPolynomial (Fin 0) ℝ) : P.totalDegree = 0 := by rw [MvPolynomial.eq_C_of_isEmpty P, totalDegree_C] lemma minimalGraphOperator_one_variable (P : MvPolynomial (Fin 1) ℝ) : minimalGraphOperator P = pderiv 0 (pderiv 0 P) := by simp only [minimalGraphOperator, Fin.sum_univ_one] ring lemma affine_of_minimalGraphOperator_eq_zero_one_variable (P : MvPolynomial (Fin 1) ℝ) (h : minimalGraphOperator P = 0) : P.totalDegree ≤ 1 := by apply totalDegree_le_one_of_second_partials_zero intro i j have hi : i = 0 := Subsingleton.elim _ _ have hj : j = 0 := Subsingleton.elim _ _ subst i; subst j rwa [minimalGraphOperator_one_variable] at h lemma minimalGraphOperator_eq_zero_of_totalDegree_le_one {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (h : P.totalDegree ≤ 1) : minimalGraphOperator P = 0 := by simp [minimalGraphOperator, second_partials_zero_of_totalDegree_le_one P h] def polynomialLaplacian {n : ℕ} (P : MvPolynomial (Fin n) ℝ) : MvPolynomial (Fin n) ℝ := ∑ i : Fin n, pderiv i (pderiv i P) def cubicOperator {n : ℕ} (P : MvPolynomial (Fin n) ℝ) : MvPolynomial (Fin n) ℝ := (∑ i : Fin n, (pderiv i P) ^ 2) * polynomialLaplacian P - ∑ i : Fin n, ∑ j : Fin n, pderiv i P * pderiv j P * pderiv i (pderiv j P) lemma minimalGraphOperator_eq_laplacian_add_cubic {n : ℕ} (P : MvPolynomial (Fin n) ℝ) : minimalGraphOperator P = polynomialLaplacian P + cubicOperator P := by unfold minimalGraphOperator cubicOperator polynomialLaplacian ring lemma totalDegree_second_partial_le (P : MvPolynomial σ ℝ) (d : ℕ) (h : P.totalDegree ≤ d + 2) (i j : σ) : (pderiv i (pderiv j P)).totalDegree ≤ d := by apply totalDegree_pderiv_le_of_totalDegree_le exact totalDegree_pderiv_le_of_totalDegree_le P j (d + 1) (by omega) lemma homogeneousComponent_second_partial (P : MvPolynomial σ ℝ) (d : ℕ) (i j : σ) : homogeneousComponent d (pderiv i (pderiv j P)) = pderiv i (pderiv j (homogeneousComponent (d + 2) P)) := by rw [← pderiv_homogeneousComponent, ← pderiv_homogeneousComponent] lemma homogeneousComponent_derivative_triple (P : MvPolynomial σ ℝ) (d : ℕ) (h : P.totalDegree ≤ d + 2) (i j k l : σ) : homogeneousComponent (3 * d + 2) (pderiv i P * pderiv j P * pderiv k (pderiv l P)) = pderiv i (homogeneousComponent (d + 2) P) * pderiv j (homogeneousComponent (d + 2) P) * pderiv k (pderiv l (homogeneousComponent (d + 2) P)) := by have hgi : (pderiv i P).totalDegree ≤ d + 1 := totalDegree_pderiv_le_of_totalDegree_le P i (d + 1) (by omega) have hgj : (pderiv j P).totalDegree ≤ d + 1 := totalDegree_pderiv_le_of_totalDegree_le P j (d + 1) (by omega) have hpair : (pderiv i P * pderiv j P).totalDegree ≤ (d + 1) + (d + 1) := (totalDegree_mul _ _).trans (Nat.add_le_add hgi hgj) have hkl := totalDegree_second_partial_le P d h k l rw [show 3 * d + 2 = ((d + 1) + (d + 1)) + d by omega, homogeneousComponent_mul_top _ _ _ _ hpair hkl, homogeneousComponent_mul_top _ _ _ _ hgi hgj, ← pderiv_homogeneousComponent, ← pderiv_homogeneousComponent, homogeneousComponent_second_partial] lemma homogeneousComponent_cubicOperator_top {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (d : ℕ) (h : P.totalDegree ≤ d + 2) : homogeneousComponent (3 * d + 2) (cubicOperator P) = cubicOperator (homogeneousComponent (d + 2) P) := by unfold cubicOperator polynomialLaplacian simp only [Finset.sum_mul, Finset.mul_sum, map_sub, map_sum, pow_two] simp_rw [homogeneousComponent_derivative_triple P d h] lemma homogeneousComponent_minimalGraphOperator_top {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (d : ℕ) (h : P.totalDegree ≤ d + 2) : homogeneousComponent (3 * d + 2) (minimalGraphOperator P) = cubicOperator (homogeneousComponent (d + 2) P) := by rw [minimalGraphOperator_eq_laplacian_add_cubic, map_add, homogeneousComponent_cubicOperator_top P d h] have hlap : (polynomialLaplacian P).totalDegree ≤ d := by apply totalDegree_finsetSum_le intro i hi exact totalDegree_second_partial_le P d h i i have hz : homogeneousComponent (3 * d + 2) (polynomialLaplacian P) = 0 := by apply homogeneousComponent_eq_zero omega rw [hz, zero_add] lemma cubicOperator_top_eq_zero {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (m : ℕ) (hm : 2 ≤ m) (hdeg : P.totalDegree ≤ m) (h : minimalGraphOperator P = 0) : cubicOperator (homogeneousComponent m P) = 0 := by obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm have ht := homogeneousComponent_minimalGraphOperator_top P d (by omega) rw [h, map_zero] at ht simpa [Nat.add_comm] using ht.symm lemma eq_zero_of_weighted_sum_sq_eq_zero {ι : Type*} (s : Finset ι) (w : ι → ℝ) (P : ι → MvPolynomial σ ℝ) (hw : ∀ i ∈ s, 0 < w i) (h : ∑ i ∈ s, C (w i) * (P i) ^ 2 = 0) : ∀ i ∈ s, P i = 0 := by intro i hi apply QuarticCompatibility.polynomial_funext intro x have he := congrArg (eval x) h simp only [map_sum, map_mul, eval_C, map_pow, map_zero] at he have hn : ∀ j ∈ s, 0 ≤ w j * eval x (P j) ^ 2 := by intro j hj exact mul_nonneg (le_of_lt (hw j hj)) (sq_nonneg _) have hz := (Finset.sum_eq_zero_iff_of_nonneg hn).mp he i hi have hiw : w i ≠ 0 := ne_of_gt (hw i hi) have hp : eval x (P i) ^ 2 = 0 := (mul_eq_zero.mp hz).resolve_left hiw simpa only [map_zero] using (sq_eq_zero_iff.mp hp) lemma eq_zero_of_sum_sq_eq_zero {ι : Type*} (s : Finset ι) (P : ι → MvPolynomial σ ℝ) (h : ∑ i ∈ s, (P i) ^ 2 = 0) : ∀ i ∈ s, P i = 0 := by apply eq_zero_of_weighted_sum_sq_eq_zero s (fun _ ↦ 1) P · intros; norm_num · simpa using h lemma eq_zero_of_scalar_weighted_sum_sq_eq_zero {ι : Type*} (s : Finset ι) (a : ℝ) (ha : a ≠ 0) (P : ι → MvPolynomial σ ℝ) (h : C a * (∑ i ∈ s, (P i) ^ 2) = 0) : ∀ i ∈ s, P i = 0 := by apply eq_zero_of_sum_sq_eq_zero s P exact (mul_eq_zero.mp h).resolve_left (by simpa using ha) section Analysis variable [Fintype σ] def evalFDeriv (P : MvPolynomial σ ℝ) (x : σ → ℝ) : (σ → ℝ) →L[ℝ] ℝ := ∑ i, eval x (pderiv i P) • ContinuousLinearMap.proj i lemma evalFDeriv_apply (P : MvPolynomial σ ℝ) (x v : σ → ℝ) : evalFDeriv P x v = ∑ i, eval x (pderiv i P) * v i := by simp [evalFDeriv] lemma evalFDeriv_C (a : ℝ) (x : σ → ℝ) : evalFDeriv (C a) x = 0 := by simp [evalFDeriv] lemma evalFDeriv_X (i : σ) (x : σ → ℝ) : evalFDeriv (X i) x = ContinuousLinearMap.proj i := by classical simp [evalFDeriv, pderiv_X, Pi.single_apply] lemma evalFDeriv_add (P Q : MvPolynomial σ ℝ) (x : σ → ℝ) : evalFDeriv (P + Q) x = evalFDeriv P x + evalFDeriv Q x := by simp [evalFDeriv, add_smul, Finset.sum_add_distrib] lemma evalFDeriv_mul (P Q : MvPolynomial σ ℝ) (x : σ → ℝ) : evalFDeriv (P * Q) x = eval x P • evalFDeriv Q x + eval x Q • evalFDeriv P x := by ext v simp only [evalFDeriv_apply, add_apply, smul_apply, smul_eq_mul, pderiv_mul, map_add, map_mul, Finset.mul_sum, ← Finset.sum_add_distrib] apply Finset.sum_congr rfl intro i hi ring lemma hasFDerivAt_eval (P : MvPolynomial σ ℝ) (x : σ → ℝ) : HasFDerivAt (fun y : σ → ℝ ↦ eval y P) (evalFDeriv P x) x := by induction P using MvPolynomial.induction_on with | C a => simpa [evalFDeriv_C] using (hasFDerivAt_const (𝕜 := ℝ) a x) | add P Q hp hq => simpa [evalFDeriv_add] using hp.fun_add hq | mul_X P i hp => simpa [evalFDeriv_mul, evalFDeriv_X] using hp.fun_mul (hasFDerivAt_apply i x) lemma hasStrictFDerivAt_eval (P : MvPolynomial σ ℝ) (x : σ → ℝ) : HasStrictFDerivAt (fun y : σ → ℝ ↦ eval y P) (evalFDeriv P x) x := by induction P using MvPolynomial.induction_on with | C a => simpa [evalFDeriv_C] using (hasStrictFDerivAt_const (𝕜 := ℝ) a x) | add P Q hp hq => simpa [evalFDeriv_add] using hp.fun_add hq | mul_X P i hp => simpa [evalFDeriv_mul, evalFDeriv_X] using hp.fun_mul (hasStrictFDerivAt_apply i x) lemma evalFDeriv_self_of_isHomogeneous (P : MvPolynomial σ ℝ) (d : ℕ) (h : P.IsHomogeneous d) (x : σ → ℝ) : evalFDeriv P x x = d * eval x P := by have hh := congrArg (eval x) (QuarticCompatibility.sum_X_mul_pderiv h) simpa [evalFDeriv_apply, mul_comm] using hh def spherePolynomial : MvPolynomial σ ℝ := ∑ i : σ, (X i) ^ 2 lemma eval_spherePolynomial (x : σ → ℝ) : eval x spherePolynomial = ∑ i : σ, (x i) ^ 2 := by simp [spherePolynomial] lemma pderiv_spherePolynomial (i : σ) : pderiv i (spherePolynomial : MvPolynomial σ ℝ) = 2 * X i := by classical simp [spherePolynomial, pderiv_X, Pi.single_apply] lemma evalFDeriv_spherePolynomial (x v : σ → ℝ) : evalFDeriv spherePolynomial x v = 2 * ∑ i : σ, x i * v i := by simp [evalFDeriv_apply, pderiv_spherePolynomial, Finset.mul_sum, mul_assoc] lemma evalFDeriv_basis [DecidableEq σ] (P : MvPolynomial σ ℝ) (x : σ → ℝ) (i : σ) : evalFDeriv P x (Pi.single i 1) = eval x (pderiv i P) := by classical simp [evalFDeriv_apply, Pi.single_apply] lemma exists_gradient_multiplier_of_local_extremum_on_sphere (P : MvPolynomial σ ℝ) (x : σ → ℝ) (hx : ∑ i, (x i) ^ 2 = 1) (he : IsLocalExtrOn (fun y : σ → ℝ ↦ eval y P) {y | ∑ i, (y i) ^ 2 = 1} x) : ∃ c : ℝ, ∀ i, eval x (pderiv i P) = c * x i := by classical have he' : IsLocalExtrOn (fun y : σ → ℝ ↦ eval y P) {y | eval y spherePolynomial = eval x spherePolynomial} x := by simpa only [eval_spherePolynomial, hx] using he obtain ⟨a, b, hab, hd⟩ := he'.exists_multipliers_of_hasStrictFDerivAt_1d (hasStrictFDerivAt_eval spherePolynomial x) (hasStrictFDerivAt_eval P x) have hdx := congrArg (fun f : (σ → ℝ) →L[ℝ] ℝ ↦ f x) hd simp only [add_apply, smul_apply, smul_eq_mul, zero_apply, evalFDeriv_spherePolynomial, ← pow_two, hx] at hdx have hb : b ≠ 0 := by intro hb have ha : a = 0 := by simp [hb] at hdx; linarith exact hab (by simp [ha, hb]) refine ⟨-2 * a / b, fun i ↦ ?_⟩ have hdi := congrArg (fun f : (σ → ℝ) →L[ℝ] ℝ ↦ f (Pi.single i 1)) hd simp only [add_apply, smul_apply, smul_eq_mul, zero_apply, evalFDeriv_basis, pderiv_spherePolynomial, map_mul, map_ofNat, eval_X] at hdi rw [div_mul_eq_mul_div] apply (eq_div_iff hb).2 nlinarith lemma gradient_at_homogeneous_sphere_extremum (P : MvPolynomial σ ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (x : σ → ℝ) (hx : ∑ i, (x i) ^ 2 = 1) (he : IsLocalExtrOn (fun y : σ → ℝ ↦ eval y P) {y | ∑ i, (y i) ^ 2 = 1} x) : ∀ i, eval x (pderiv i P) = (d * eval x P) * x i := by obtain ⟨c, hc⟩ := exists_gradient_multiplier_of_local_extremum_on_sphere P x hx he have hh := evalFDeriv_self_of_isHomogeneous P d hP x rw [evalFDeriv_apply] at hh simp_rw [hc, mul_assoc, ← pow_two] at hh rw [← Finset.mul_sum, hx, mul_one] at hh simpa only [hh] using hc lemma fderiv_eval (P : MvPolynomial σ ℝ) (x : σ → ℝ) : fderiv ℝ (fun y : σ → ℝ ↦ eval y P) x = evalFDeriv P x := (hasFDerivAt_eval P x).fderiv lemma differentiable_eval (P : MvPolynomial σ ℝ) : Differentiable ℝ (fun x : σ → ℝ ↦ eval x P) := fun x ↦ (hasFDerivAt_eval P x).differentiableAt end Analysis end QuarticPolynomialBasics end end ComponentPolynomialBasics /- Component: LowDegree -/ section ComponentLowDegree /- Requires PolynomialBasics.lean. -/ noncomputable section open scoped BigOperators Matrix open MvPolynomial namespace QuarticMinimal variable {ι : Type*} theorem eq_C_of_pderiv_eq_zero (P : MvPolynomial ι ℝ) (hP : ∀ i, pderiv i P = 0) : P = C (P.coeff 0) := by classical apply totalDegree_eq_zero_iff_eq_C.mp apply Nat.eq_zero_of_le_zero apply Finset.sup_le intro m hm change m.degree ≤ 0 by_contra hn obtain ⟨i, r, hr⟩ := QuarticPolynomialBasics.exponent_decompose_one m (by omega) have hc := congrArg (fun Q : MvPolynomial ι ℝ => Q.coeff r) (hP i) rw [coeff_pderiv, hr, AddMonoidAlgebra.coeff_zero] at hc have hcoeff : P.coeff m ≠ 0 := mem_support_iff.mp hm have hnat : (r i : ℝ) + 1 ≠ 0 := by positivity exact (mul_ne_zero hcoeff hnat) hc theorem pderiv_eq_C_of_totalDegree_le_one (P : MvPolynomial ι ℝ) (hP : P.totalDegree ≤ 1) (i : ι) : pderiv i P = C ((pderiv i P).coeff 0) := by apply eq_C_of_pderiv_eq_zero intro j exact QuarticPolynomialBasics.second_partials_zero_of_totalDegree_le_one P hP j i variable [Fintype ι] theorem affine_expansion (P : MvPolynomial ι ℝ) (hP : P.totalDegree ≤ 1) : P = C (P.coeff 0) + ∑ i, C ((pderiv i P).coeff 0) * X i := by classical let L : MvPolynomial ι ℝ := ∑ i, C ((pderiv i P).coeff 0) * X i have hL (j : ι) : pderiv j L = C ((pderiv j P).coeff 0) := by simp [L, pderiv_X, Pi.single_apply] have hQ : P - L = C ((P - L).coeff 0) := by apply eq_C_of_pderiv_eq_zero intro j rw [map_sub, hL] exact sub_eq_zero.mpr (pderiv_eq_C_of_totalDegree_le_one P hP j) have hLc : L.coeff 0 = 0 := by simp [L, coeff_C_mul] rw [coeff_sub, hLc, sub_zero] at hQ exact sub_eq_iff_eq_add.mp hQ theorem eval_affine_expansion (P : MvPolynomial ι ℝ) (hP : P.totalDegree ≤ 1) (x : ι → ℝ) : eval x P = P.coeff 0 + ∑ i, (pderiv i P).coeff 0 * x i := by conv_lhs => rw [affine_expansion P hP] simp def hessianCoeff (P : MvPolynomial ι ℝ) : Matrix ι ι ℝ := fun i j => (pderiv i (pderiv j P)).coeff 0 omit [Fintype ι] in theorem hessianCoeff_symmetric (P : MvPolynomial ι ℝ) : (hessianCoeff P).IsSymm := by ext i j simp only [hessianCoeff, Matrix.transpose_apply] rw [QuarticPolynomialBasics.second_partial_comm] omit [Fintype ι] in theorem second_partial_eq_C_of_totalDegree_le_two (P : MvPolynomial ι ℝ) (hP : P.totalDegree ≤ 2) (i j : ι) : pderiv i (pderiv j P) = C (hessianCoeff P i j) := by exact pderiv_eq_C_of_totalDegree_le_one (pderiv j P) (QuarticPolynomialBasics.totalDegree_pderiv_le_of_totalDegree_le P j 1 hP) i theorem eval_quadratic_gradient (P : MvPolynomial ι ℝ) (hP : P.totalDegree ≤ 2) (x : ι → ℝ) (j : ι) : eval x (pderiv j P) = (hessianCoeff P *ᵥ x) j + (pderiv j P).coeff 0 := by rw [eval_affine_expansion (pderiv j P) (QuarticPolynomialBasics.totalDegree_pderiv_le_of_totalDegree_le P j 1 hP)] rw [add_comm] simp only [Matrix.mulVec, dotProduct, hessianCoeff] congr 1 apply Finset.sum_congr rfl intro i hi rw [QuarticPolynomialBasics.second_partial_comm] theorem homogeneous_linear_expansion (P : MvPolynomial ι ℝ) (hP : P.IsHomogeneous 1) : P = ∑ i, C ((pderiv i P).coeff 0) * X i := by have hc : P.coeff 0 = 0 := hP.coeff_eq_zero (by simp) simpa only [hc, map_zero, zero_add] using affine_expansion P hP.totalDegree_le theorem homogeneous_quadratic_expansion (P : MvPolynomial ι ℝ) (hP : P.IsHomogeneous 2) : P = C (1 / 2 : ℝ) * ∑ i, ∑ j, C (hessianCoeff P i j) * X i * X j := by have he := QuarticCompatibility.sum_X_mul_pderiv hP have hp (i : ι) : pderiv i P = ∑ j, C (hessianCoeff P j i) * X j := by exact homogeneous_linear_expansion (pderiv i P) (by simpa using QuarticCompatibility.homogeneous_pderiv (i := i) hP) simp_rw [hp, Finset.mul_sum] at he norm_num [nsmul_eq_mul] at he have he' : (∑ i, ∑ j, C (hessianCoeff P i j) * X i * X j) = 2 * P := by rw [← he] apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro j hj have hs : hessianCoeff P i j = hessianCoeff P j i := by simp only [hessianCoeff] rw [QuarticPolynomialBasics.second_partial_comm] rw [hs] ring rw [he'] have hc : C (1 / 2 : ℝ) * (2 : MvPolynomial ι ℝ) = 1 := by calc C (1 / 2 : ℝ) * 2 = C (1 / 2 : ℝ) * C (2 : ℝ) := by rw [map_ofNat] _ = C ((1 / 2 : ℝ) * 2) := (map_mul C _ _).symm _ = 1 := by norm_num rw [← mul_assoc, hc, one_mul] end QuarticMinimal end end ComponentLowDegree /- Component: ChangeVariables -/ section ComponentChangeVariables noncomputable section open scoped BigOperators Matrix open MvPolynomial namespace QuarticMinimal variable {ι κ : Type*} [Fintype ι] theorem pderiv_aeval_chain (f : ι → MvPolynomial κ ℝ) (P : MvPolynomial ι ℝ) (j : κ) : pderiv j (aeval f P) = ∑ i, aeval f (pderiv i P) * pderiv j (f i) := by classical induction P using MvPolynomial.induction_on with | C r => simp | add P Q hP hQ => simp only [map_add, hP, hQ, add_mul, Finset.sum_add_distrib] | mul_X P k hP => have hterm (i : ι) : aeval f (pderiv i (P * X k)) * pderiv j (f i) = (aeval f (pderiv i P) * pderiv j (f i)) * f k + if i = k then aeval f P * pderiv j (f k) else 0 := by by_cases hi : i = k · subst i simp only [pderiv_mul, pderiv_X_self, map_add, map_mul, aeval_X, mul_one, ite_true] ring · simp only [pderiv_mul, pderiv_X_of_ne (Ne.symm hi), mul_zero, add_zero, map_mul, aeval_X, hi, ite_false] ring calc pderiv j (aeval f (P * X k)) = (∑ i, aeval f (pderiv i P) * pderiv j (f i)) * f k + aeval f P * pderiv j (f k) := by rw [map_mul, aeval_X, pderiv_mul, hP] _ = ∑ i, aeval f (pderiv i (P * X k)) * pderiv j (f i) := by symm simp_rw [hterm] simp only [Finset.sum_add_distrib, Finset.sum_ite_eq', Finset.mem_univ, ite_true, Finset.sum_mul] variable [Fintype κ] def linearSubstitution (A : Matrix ι κ ℝ) (i : ι) : MvPolynomial κ ℝ := ∑ j, C (A i j) * X j omit [Fintype ι] in theorem pderiv_linearSubstitution (A : Matrix ι κ ℝ) (i : ι) (j : κ) : pderiv j (linearSubstitution A i) = C (A i j) := by classical simp [linearSubstitution, pderiv_X, Pi.single_apply] def changeVariables (A : Matrix ι κ ℝ) : MvPolynomial ι ℝ →ₐ[ℝ] MvPolynomial κ ℝ := aeval (linearSubstitution A) theorem pderiv_changeVariables (A : Matrix ι κ ℝ) (P : MvPolynomial ι ℝ) (j : κ) : pderiv j (changeVariables A P) = ∑ i, changeVariables A (pderiv i P) * C (A i j) := by simp only [changeVariables, pderiv_aeval_chain, pderiv_linearSubstitution] theorem pderiv_pderiv_changeVariables (A : Matrix ι κ ℝ) (P : MvPolynomial ι ℝ) (j k : κ) : pderiv j (pderiv k (changeVariables A P)) = ∑ i, ∑ l, changeVariables A (pderiv l (pderiv i P)) * C (A l j) * C (A i k) := by simp only [pderiv_changeVariables, map_sum, pderiv_mul, pderiv_C, mul_zero, add_zero, Finset.sum_mul] def gradient (P : MvPolynomial ι ℝ) (i : ι) : MvPolynomial ι ℝ := pderiv i P def hessian (P : MvPolynomial ι ℝ) : Matrix ι ι (MvPolynomial ι ℝ) := fun i j => pderiv i (pderiv j P) theorem gradient_changeVariables (A : Matrix ι κ ℝ) (P : MvPolynomial ι ℝ) : gradient (changeVariables A P) = (A.map (C : ℝ →+* MvPolynomial κ ℝ)).transpose *ᵥ (fun i => changeVariables A (gradient P i)) := by funext j simp only [gradient, pderiv_changeVariables, Matrix.mulVec, dotProduct, Matrix.transpose_apply, Matrix.map_apply] apply Finset.sum_congr rfl intro i hi exact mul_comm _ _ theorem hessian_changeVariables (A : Matrix ι κ ℝ) (P : MvPolynomial ι ℝ) : hessian (changeVariables A P) = (A.map (C : ℝ →+* MvPolynomial κ ℝ)).transpose * ((hessian P).map (changeVariables A)) * (A.map (C : ℝ →+* MvPolynomial κ ℝ)) := by funext j k simp only [hessian, pderiv_pderiv_changeVariables, Matrix.mul_apply, Matrix.transpose_apply, Matrix.map_apply, Finset.sum_mul] apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro l hl ring def minimalOperator (P : MvPolynomial ι ℝ) : MvPolynomial ι ℝ := (1 + ∑ i, (pderiv i P) ^ 2) * (∑ i, pderiv i (pderiv i P)) - ∑ i, ∑ j, pderiv i P * pderiv j P * pderiv i (pderiv j P) theorem minimalOperator_eq_matrix (P : MvPolynomial ι ℝ) : minimalOperator P = (1 + dotProduct (gradient P) (gradient P)) * Matrix.trace (hessian P) - dotProduct (gradient P) ((hessian P) *ᵥ (gradient P)) := by have hc : dotProduct (gradient P) ((hessian P) *ᵥ (gradient P)) = ∑ i, ∑ j, pderiv i P * pderiv j P * pderiv i (pderiv j P) := by simp only [dotProduct, Matrix.mulVec, gradient, hessian, Finset.mul_sum] apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro j hj ring rw [hc] simp only [minimalOperator, dotProduct, Matrix.trace, Matrix.diag, gradient, hessian, pow_two] end QuarticMinimal end end ComponentChangeVariables /- Component: OperatorInvariance -/ section ComponentOperatorInvariance /- This development component follows MatrixAlgebra and ChangeVariables in the single-file build. -/ noncomputable section open MvPolynomial open scoped BigOperators Matrix namespace QuarticMinimal variable {ι κ : Type*} [Fintype ι] [Fintype κ] [DecidableEq ι] theorem minimalOperator_changeVariables (A : Matrix ι κ ℝ) (hA : A * A.transpose = 1) (P : MvPolynomial ι ℝ) : minimalOperator (changeVariables A P) = changeVariables A (minimalOperator P) := by have hAc := MatrixAlgebra.map_mul_transpose (C : ℝ →+* MvPolynomial κ ℝ) A hA rw [minimalOperator_eq_matrix, gradient_changeVariables, hessian_changeVariables, MatrixAlgebra.minimal_expression_invariant _ hAc] rw [minimalOperator_eq_matrix] simp only [dotProduct, Matrix.trace, Matrix.diag, Matrix.map_apply, Matrix.mulVec, map_sub, map_mul, map_add, map_one, map_sum] theorem minimalOperator_changeVariables_eq_zero (A : Matrix ι κ ℝ) (hA : A * A.transpose = 1) (P : MvPolynomial ι ℝ) (hP : minimalOperator P = 0) : minimalOperator (changeVariables A P) = 0 := by rw [minimalOperator_changeVariables A hA, hP, map_zero] def laplacian (P : MvPolynomial ι ℝ) : MvPolynomial ι ℝ := ∑ i, pderiv i (pderiv i P) def leadingOperator (P : MvPolynomial ι ℝ) : MvPolynomial ι ℝ := (∑ i, (pderiv i P) ^ 2) * laplacian P - ∑ i, ∑ j, pderiv i P * pderiv j P * pderiv i (pderiv j P) omit [DecidableEq ι] in theorem minimalOperator_eq_laplacian_add_leading (P : MvPolynomial ι ℝ) : minimalOperator P = laplacian P + leadingOperator P := by simp only [minimalOperator, leadingOperator, laplacian] ring omit [DecidableEq ι] in theorem laplacian_eq_trace_hessian (P : MvPolynomial ι ℝ) : laplacian P = Matrix.trace (hessian P) := rfl theorem laplacian_changeVariables (A : Matrix ι κ ℝ) (hA : A * A.transpose = 1) (P : MvPolynomial ι ℝ) : laplacian (changeVariables A P) = changeVariables A (laplacian P) := by have hAc := MatrixAlgebra.map_mul_transpose (C : ℝ →+* MvPolynomial κ ℝ) A hA rw [laplacian_eq_trace_hessian, hessian_changeVariables, MatrixAlgebra.trace_conjugate _ hAc] simp only [Matrix.trace, Matrix.diag, Matrix.map_apply, laplacian, hessian, map_sum] theorem leadingOperator_changeVariables (A : Matrix ι κ ℝ) (hA : A * A.transpose = 1) (P : MvPolynomial ι ℝ) : leadingOperator (changeVariables A P) = changeVariables A (leadingOperator P) := by have hm := minimalOperator_changeVariables A hA P rw [minimalOperator_eq_laplacian_add_leading, minimalOperator_eq_laplacian_add_leading, map_add, laplacian_changeVariables A hA] at hm exact add_left_cancel hm theorem leadingOperator_changeVariables_eq_zero (A : Matrix ι κ ℝ) (hA : A * A.transpose = 1) (P : MvPolynomial ι ℝ) (hP : leadingOperator P = 0) : leadingOperator (changeVariables A P) = 0 := by rw [leadingOperator_changeVariables A hA, hP, map_zero] end QuarticMinimal end end ComponentOperatorInvariance /- Component: LinearSubstitution -/ section ComponentLinearSubstitution /- Requires ChangeVariables.lean in the single-file assembly. -/ noncomputable section open scoped BigOperators Matrix open MvPolynomial namespace QuarticMinimal variable {ι κ ν : Type*} [Fintype ι] [Fintype κ] [Fintype ν] omit [Fintype ι] in theorem eval_linearSubstitution (A : Matrix ι κ ℝ) (x : κ → ℝ) (i : ι) : eval x (linearSubstitution A i) = (A *ᵥ x) i := by simp [linearSubstitution, Matrix.mulVec, dotProduct] omit [Fintype ι] in theorem eval_changeVariables (A : Matrix ι κ ℝ) (x : κ → ℝ) (P : MvPolynomial ι ℝ) : eval x (changeVariables A P) = eval (A *ᵥ x) P := by change aeval x (aeval (linearSubstitution A) P) = aeval (A *ᵥ x) P rw [comp_aeval_apply] have hf : (fun i => aeval x (linearSubstitution A i)) = A *ᵥ x := by funext i exact eval_linearSubstitution A x i rw [hf] omit [Fintype ι] in theorem changeVariables_linearSubstitution (A : Matrix ι κ ℝ) (B : Matrix κ ν ℝ) (i : ι) : changeVariables B (linearSubstitution A i) = linearSubstitution (A * B) i := by simp only [linearSubstitution, map_sum, map_mul, changeVariables, aeval_C, algebraMap_eq, aeval_X, Matrix.mul_apply, map_sum, Finset.sum_mul, map_mul, Finset.mul_sum] rw [Finset.sum_comm] apply Finset.sum_congr rfl intro j hj apply Finset.sum_congr rfl intro k hk ring omit [Fintype ι] in theorem changeVariables_comp (A : Matrix ι κ ℝ) (B : Matrix κ ν ℝ) (P : MvPolynomial ι ℝ) : changeVariables B (changeVariables A P) = changeVariables (A * B) P := by change (changeVariables B) (aeval (linearSubstitution A) P) = _ rw [comp_aeval_apply] change aeval _ P = aeval _ P have hf : (fun i => changeVariables B (linearSubstitution A i)) = linearSubstitution (A * B) := by funext i exact changeVariables_linearSubstitution A B i rw [hf] theorem linearSubstitution_one [DecidableEq ι] (i : ι) : linearSubstitution (1 : Matrix ι ι ℝ) i = X i := by simp [linearSubstitution, Matrix.one_apply] theorem changeVariables_one [DecidableEq ι] (P : MvPolynomial ι ℝ) : changeVariables (1 : Matrix ι ι ℝ) P = P := by have hf : linearSubstitution (1 : Matrix ι ι ℝ) = X := funext linearSubstitution_one simp only [changeVariables, hf, aeval_X_left_apply] theorem changeVariables_transpose_leftInverse [DecidableEq ι] (A : Matrix ι κ ℝ) (hA : A * A.transpose = 1) : Function.LeftInverse (changeVariables A.transpose) (changeVariables A) := by intro P rw [changeVariables_comp, hA, changeVariables_one] theorem changeVariables_injective [DecidableEq ι] (A : Matrix ι κ ℝ) (hA : A * A.transpose = 1) : Function.Injective (changeVariables A) := (changeVariables_transpose_leftInverse A hA).injective omit [Fintype ι] in theorem isHomogeneous_linearSubstitution (A : Matrix ι κ ℝ) (i : ι) : (linearSubstitution A i).IsHomogeneous 1 := by apply IsHomogeneous.sum intro j hj exact isHomogeneous_C_mul_X _ _ omit [Fintype ι] in theorem isHomogeneous_changeVariables (A : Matrix ι κ ℝ) (P : MvPolynomial ι ℝ) (d : ℕ) (hP : P.IsHomogeneous d) : (changeVariables A P).IsHomogeneous d := by simpa only [one_mul, changeVariables] using hP.aeval (linearSubstitution A) (isHomogeneous_linearSubstitution A) omit [Fintype ι] in theorem totalDegree_changeVariables_le (A : Matrix ι κ ℝ) (P : MvPolynomial ι ℝ) : (changeVariables A P).totalDegree ≤ P.totalDegree := by classical conv_lhs => rw [← sum_homogeneousComponent P] rw [map_sum] apply totalDegree_finsetSum_le intro d hd exact (isHomogeneous_changeVariables A _ d (homogeneousComponent_isHomogeneous d P)).totalDegree_le.trans (Nat.lt_succ_iff.mp (Finset.mem_range.mp hd)) theorem totalDegree_changeVariables [DecidableEq ι] (A : Matrix ι κ ℝ) (hA : A * A.transpose = 1) (P : MvPolynomial ι ℝ) : (changeVariables A P).totalDegree = P.totalDegree := by apply le_antisymm (totalDegree_changeVariables_le A P) calc P.totalDegree = (changeVariables A.transpose (changeVariables A P)).totalDegree := by rw [changeVariables_transpose_leftInverse A hA P] _ ≤ (changeVariables A P).totalDegree := totalDegree_changeVariables_le _ _ end QuarticMinimal end end ComponentLinearSubstitution /- Component: DistinguishedVariable -/ section ComponentDistinguishedVariable namespace QuarticMinimal.DistinguishedVariable open MvPolynomial variable {R : Type*} [CommSemiring R] {n : ℕ} theorem cons_add_single_zero (m : Fin n →₀ ℕ) (k : ℕ) : m.cons k + Finsupp.single 0 1 = m.cons (k + 1) := by ext i cases i using Fin.cases <;> simp theorem cons_add_single_succ (m : Fin n →₀ ℕ) (k : ℕ) (i : Fin n) : m.cons k + Finsupp.single i.succ 1 = (m + Finsupp.single i 1).cons k := by ext j cases j using Fin.cases <;> simp [Finsupp.single_apply, Fin.succ_inj] theorem finSuccEquiv_pderiv_zero (P : MvPolynomial (Fin (n + 1)) R) : finSuccEquiv R n (pderiv 0 P) = Polynomial.derivative (finSuccEquiv R n P) := by apply Polynomial.ext intro k apply MvPolynomial.ext intro m rw [finSuccEquiv_coeff_coeff, coeff_pderiv, Polynomial.coeff_derivative] have hcast : (k : MvPolynomial (Fin n) R) + 1 = C ((k : R) + 1) := by simp rw [hcast, mul_comm _ (C _), coeff_C_mul, finSuccEquiv_coeff_coeff] simp [cons_add_single_zero, mul_comm] theorem coeff_finSuccEquiv_pderiv_succ (P : MvPolynomial (Fin (n + 1)) R) (i : Fin n) (k : ℕ) : (finSuccEquiv R n (pderiv i.succ P)).coeff k = pderiv i ((finSuccEquiv R n P).coeff k) := by apply MvPolynomial.ext intro m rw [finSuccEquiv_coeff_coeff, coeff_pderiv, coeff_pderiv, finSuccEquiv_coeff_coeff] simp [cons_add_single_succ] /-- Differentiate the multivariate coefficients while leaving the distinguished univariate variable fixed. -/ noncomputable def coefficientPartial (i : Fin n) (Q : Polynomial (MvPolynomial (Fin n) R)) : Polynomial (MvPolynomial (Fin n) R) := Polynomial.ofFinsupp (AddMonoidAlgebra.ofCoeff (Q.coeff.mapRange (pderiv i) (map_zero (pderiv i)))) theorem coeff_coefficientPartial (i : Fin n) (Q : Polynomial (MvPolynomial (Fin n) R)) (k : ℕ) : (coefficientPartial i Q).coeff k = pderiv i (Q.coeff k) := rfl theorem finSuccEquiv_pderiv_succ (P : MvPolynomial (Fin (n + 1)) R) (i : Fin n) : finSuccEquiv R n (pderiv i.succ P) = coefficientPartial i (finSuccEquiv R n P) := by apply Polynomial.ext intro k exact coeff_finSuccEquiv_pderiv_succ P i k theorem coefficientPartial_eq_transport (i : Fin n) (Q : Polynomial (MvPolynomial (Fin n) R)) : coefficientPartial i Q = finSuccEquiv R n (pderiv i.succ ((finSuccEquiv R n).symm Q)) := by rw [finSuccEquiv_pderiv_succ, AlgEquiv.apply_symm_apply] theorem coefficientPartial_add (i : Fin n) (Q T : Polynomial (MvPolynomial (Fin n) R)) : coefficientPartial i (Q + T) = coefficientPartial i Q + coefficientPartial i T := by ext k simp [coeff_coefficientPartial] theorem coefficientPartial_mul (i : Fin n) (Q T : Polynomial (MvPolynomial (Fin n) R)) : coefficientPartial i (Q * T) = Q * coefficientPartial i T + T * coefficientPartial i Q := by simp only [coefficientPartial_eq_transport, map_mul, pderiv_mul, map_add] simp only [AlgEquiv.apply_symm_apply] ring theorem coefficientPartial_C (i : Fin n) (a : MvPolynomial (Fin n) R) : coefficientPartial i (Polynomial.C a) = Polynomial.C (pderiv i a) := by ext k simp only [coeff_coefficientPartial, Polynomial.coeff_C] split_ifs <;> simp theorem coefficientPartial_X (i : Fin n) : coefficientPartial i (Polynomial.X : Polynomial (MvPolynomial (Fin n) R)) = 0 := by ext k simp only [coeff_coefficientPartial, Polynomial.coeff_X, Polynomial.coeff_zero] split_ifs <;> simp theorem coefficientPartial_zero (i : Fin n) : coefficientPartial i (0 : Polynomial (MvPolynomial (Fin n) R)) = 0 := by ext k simp [coeff_coefficientPartial] theorem coefficientPartial_pow (i : Fin n) (Q : Polynomial (MvPolynomial (Fin n) R)) (k : ℕ) : coefficientPartial i (Q ^ k) = k * Q ^ (k - 1) * coefficientPartial i Q := by simp only [coefficientPartial_eq_transport, map_pow, pderiv_pow, map_mul, map_natCast, AlgEquiv.apply_symm_apply] theorem coefficientPartial_derivative (i : Fin n) (Q : Polynomial (MvPolynomial (Fin n) R)) : coefficientPartial i (Polynomial.derivative Q) = Polynomial.derivative (coefficientPartial i Q) := by apply Polynomial.ext intro k simp only [coeff_coefficientPartial, Polynomial.coeff_derivative] have hcast : (k : MvPolynomial (Fin n) R) + 1 = C ((k : R) + 1) := by simp rw [hcast, pderiv_mul, pderiv_C, mul_zero, add_zero] theorem finSuccEquiv_pderiv_zero_zero (P : MvPolynomial (Fin (n + 1)) R) : finSuccEquiv R n (pderiv 0 (pderiv 0 P)) = Polynomial.derivative (Polynomial.derivative (finSuccEquiv R n P)) := by rw [finSuccEquiv_pderiv_zero, finSuccEquiv_pderiv_zero] theorem coeff_finSuccEquiv_pderiv_succ_succ (P : MvPolynomial (Fin (n + 1)) R) (i j : Fin n) (k : ℕ) : (finSuccEquiv R n (pderiv i.succ (pderiv j.succ P))).coeff k = pderiv i (pderiv j ((finSuccEquiv R n P).coeff k)) := by rw [coeff_finSuccEquiv_pderiv_succ, coeff_finSuccEquiv_pderiv_succ] theorem coeff_finSuccEquiv_totalDegree_le (P : MvPolynomial (Fin (n + 1)) R) {m : ℕ} (hP : P.totalDegree ≤ m) (k : ℕ) : ((finSuccEquiv R n P).coeff k).totalDegree ≤ m - k := by by_cases hk : (finSuccEquiv R n P).coeff k = 0 · simp [hk] · have h := totalDegree_coeff_finSuccEquiv_add_le P k hk omega theorem coeff_finSuccEquiv_eq_zero (P : MvPolynomial (Fin (n + 1)) R) {m k : ℕ} (hP : P.totalDegree ≤ m) (hk : m < k) : (finSuccEquiv R n P).coeff k = 0 := by by_contra hne have h := totalDegree_coeff_finSuccEquiv_add_le P k hne omega theorem finSuccEquiv_natDegree_le (P : MvPolynomial (Fin (n + 1)) R) {m : ℕ} (hP : P.totalDegree ≤ m) : (finSuccEquiv R n P).natDegree ≤ m := by apply Polynomial.natDegree_le_iff_coeff_eq_zero.mpr intro k hk exact coeff_finSuccEquiv_eq_zero P hP hk theorem finSuccEquiv_eq_sum (P : MvPolynomial (Fin (n + 1)) R) {m : ℕ} (hP : P.totalDegree ≤ m) : finSuccEquiv R n P = ∑ k ∈ Finset.range (m + 1), Polynomial.C ((finSuccEquiv R n P).coeff k) * Polynomial.X ^ k := by exact Polynomial.as_sum_range_C_mul_X_pow' _ (Nat.lt_succ_of_le (finSuccEquiv_natDegree_le P hP)) theorem finSuccEquiv_quartic (P : MvPolynomial (Fin (n + 1)) R) (hP : P.totalDegree ≤ 4) : finSuccEquiv R n P = Polynomial.C ((finSuccEquiv R n P).coeff 4) * Polynomial.X ^ 4 + Polynomial.C ((finSuccEquiv R n P).coeff 3) * Polynomial.X ^ 3 + Polynomial.C ((finSuccEquiv R n P).coeff 2) * Polynomial.X ^ 2 + Polynomial.C ((finSuccEquiv R n P).coeff 1) * Polynomial.X + Polynomial.C ((finSuccEquiv R n P).coeff 0) := by conv_lhs => rw [finSuccEquiv_eq_sum P hP] simp only [Finset.sum_range_succ, Finset.sum_range_zero, pow_zero, pow_one, mul_one, zero_add] ring theorem coeff_finSuccEquiv_isHomogeneous (P : MvPolynomial (Fin (n + 1)) R) {m : ℕ} (hP : P.IsHomogeneous m) (k : ℕ) : ((finSuccEquiv R n P).coeff k).IsHomogeneous (m - k) := by by_cases hk : k ≤ m · exact hP.finSuccEquiv_coeff_isHomogeneous k (m - k) (Nat.add_sub_of_le hk) · rw [coeff_finSuccEquiv_eq_zero P hP.totalDegree_le (Nat.lt_of_not_ge hk)] exact isHomogeneous_zero (Fin n) R _ section MinimalExpression variable {S : Type*} [CommRing S] /-- Separating one coordinate in the algebraic minimal-graph expression. -/ theorem minimal_expression_split {ι : Type*} [Fintype ι] (d dd : S) (v dv : ι → S) (h : ι → ι → S) : (1 + (d ^ 2 + ∑ i, v i ^ 2)) * (dd + ∑ i, h i i) - (d * d * dd + (∑ i, d * v i * dv i) + ∑ i, (v i * d * dv i + ∑ j, v i * v j * h i j)) = (1 + ∑ i, v i ^ 2) * dd + (1 + d ^ 2 + ∑ i, v i ^ 2) * (∑ i, h i i) - 2 * d * (∑ i, dv i * v i) - ∑ i, ∑ j, v i * v j * h i j := by rw [Finset.sum_add_distrib] have hc : (∑ i, d * v i * dv i) = d * ∑ i, dv i * v i := by rw [Finset.mul_sum] apply Finset.sum_congr rfl intro i _ ring have hc' : (∑ i, v i * d * dv i) = d * ∑ i, dv i * v i := by rw [Finset.mul_sum] apply Finset.sum_congr rfl intro i _ ring rw [hc, hc'] ring /-- The minimal-graph numerator after separating the zeroth variable. -/ noncomputable def splitMinimalExpression (Q : Polynomial (MvPolynomial (Fin n) S)) : Polynomial (MvPolynomial (Fin n) S) := (1 + ∑ i, coefficientPartial i Q ^ 2) * Polynomial.derivative (Polynomial.derivative Q) + (1 + Polynomial.derivative Q ^ 2 + ∑ i, coefficientPartial i Q ^ 2) * (∑ i, coefficientPartial i (coefficientPartial i Q)) - 2 * Polynomial.derivative Q * (∑ i, Polynomial.derivative (coefficientPartial i Q) * coefficientPartial i Q) - ∑ i, ∑ j, coefficientPartial i Q * coefficientPartial j Q * coefficientPartial i (coefficientPartial j Q) theorem finSuccEquiv_minimalExpression (P : MvPolynomial (Fin (n + 1)) S) : finSuccEquiv S n ((1 + ∑ i, pderiv i P ^ 2) * (∑ i, pderiv i (pderiv i P)) - ∑ i, ∑ j, pderiv i P * pderiv j P * pderiv i (pderiv j P)) = splitMinimalExpression (finSuccEquiv S n P) := by simp only [map_sub, map_mul, map_add, map_one, map_sum, map_pow, Fin.sum_univ_succ, finSuccEquiv_pderiv_zero, finSuccEquiv_pderiv_succ, coefficientPartial_derivative] exact minimal_expression_split (Polynomial.derivative (finSuccEquiv S n P)) (Polynomial.derivative (Polynomial.derivative (finSuccEquiv S n P))) (fun i : Fin n => coefficientPartial i (finSuccEquiv S n P)) (fun i : Fin n => Polynomial.derivative (coefficientPartial i (finSuccEquiv S n P))) (fun i j : Fin n => coefficientPartial i (coefficientPartial j (finSuccEquiv S n P))) end MinimalExpression end QuarticMinimal.DistinguishedVariable end ComponentDistinguishedVariable /- Component: HomogeneousHessian -/ section ComponentHomogeneousHessian /- Requires PolynomialBasics and LowDegree. -/ noncomputable section open scoped BigOperators Matrix open MvPolynomial namespace QuarticMinimal variable {ι : Type*} [Fintype ι] theorem eval_homogeneous_quadratic_expansion (P : MvPolynomial ι ℝ) (hP : P.IsHomogeneous 2) (x : ι → ℝ) : eval x P = (1 / 2 : ℝ) * ∑ i, ∑ j, hessianCoeff P i j * x i * x j := by conv_lhs => rw [homogeneous_quadratic_expansion P hP] simp only [map_mul, map_sum, eval_C, eval_X] omit [Fintype ι] in theorem fourth_partial_pair_comm (P : MvPolynomial ι ℝ) (i j k l : ι) : pderiv k (pderiv l (pderiv i (pderiv j P))) = pderiv i (pderiv j (pderiv k (pderiv l P))) := by simp only [QuarticPolynomialBasics.second_partial_comm] theorem sum_four_swap (f : ι → ι → ι → ι → ℝ) : (∑ i, ∑ j, ∑ k, ∑ l, f i j k l) = ∑ k, ∑ l, ∑ i, ∑ j, f i j k l := by simpa only [Fintype.sum_prod_type] using (Finset.sum_comm (s := (Finset.univ : Finset (ι × ι))) (t := (Finset.univ : Finset (ι × ι))) (f := fun ij : ι × ι => fun kl : ι × ι => f ij.1 ij.2 kl.1 kl.2)) theorem quartic_mixed_hessian_symmetry (P : MvPolynomial ι ℝ) (hP : P.IsHomogeneous 4) (x y : ι → ℝ) : (∑ i, ∑ j, y i * y j * eval x (pderiv i (pderiv j P))) = ∑ i, ∑ j, x i * x j * eval y (pderiv i (pderiv j P)) := by have hp (i j : ι) : (pderiv i (pderiv j P)).IsHomogeneous 2 := by simpa only [Nat.reduceSub] using QuarticCompatibility.homogeneous_pderiv (i := i) (QuarticCompatibility.homogeneous_pderiv (i := j) hP) simp_rw [eval_homogeneous_quadratic_expansion _ (hp _ _), Finset.mul_sum] conv_lhs => rw [sum_four_swap] apply Finset.sum_congr rfl intro k hk apply Finset.sum_congr rfl intro l hl apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro j hj simp only [hessianCoeff, fourth_partial_pair_comm] ring end QuarticMinimal end end ComponentHomogeneousHessian /- Component: HomogeneousQuarticCoefficients -/ section ComponentHomogeneousQuarticCoefficients open scoped BigOperators open Polynomial namespace HomogeneousQuarticCoefficients variable {R : Type*} [CommRing R] noncomputable def longitudinal (a A B : R) : R[X] := C (4*a)*X^3+C (2*A)*X+C B noncomputable def longitudinalSecond (a A : R) : R[X] := C (12*a)*X^2+C (2*A) noncomputable def transverse (α β γ : R) : R[X] := C α*X^2+C β*X+C γ noncomputable def mixedSecond (α β : R) : R[X] := C (2*α)*X+C β noncomputable def transverseTrace (h k l : R) : R[X] := C h*X^2+C k*X+C l noncomputable def baseTerm (a A B h k l : R) : R[X] := longitudinal a A B^2*transverseTrace h k l noncomputable def singleTerm (a A B h k l α β γ : R) : R[X] := transverse α β γ^2*(longitudinalSecond a A+transverseTrace h k l)- 2*longitudinal a A B*mixedSecond α β*transverse α β γ noncomputable def hessianTerm (α β γ α' β' γ' H K L : R) : R[X] := transverse α β γ*transverse α' β' γ'*(C H*X^2+C K*X+C L) theorem base_coeff8 (a A B h k l : R) : (baseTerm a A B h k l).coeff 8 = 16*a^2*h := by unfold baseTerm longitudinal transverseTrace ring_nf simp [mul_assoc, ← map_mul, ← map_pow, Polynomial.coeff_X, Polynomial.coeff_C] ring theorem base_coeff7 (a A B h k l : R) : (baseTerm a A B h k l).coeff 7 = 16*a^2*k := by unfold baseTerm longitudinal transverseTrace ring_nf simp [mul_assoc, ← map_mul, ← map_pow, Polynomial.coeff_X, Polynomial.coeff_C] ring theorem base_coeff6 (a A B h k l : R) : (baseTerm a A B h k l).coeff 6 = 16*a^2*l+16*a*A*h := by unfold baseTerm longitudinal transverseTrace ring_nf simp [mul_assoc, ← map_mul, ← map_pow, Polynomial.coeff_X, Polynomial.coeff_C] ring theorem single_coeff8 (a A B h k l α β γ : R) : (singleTerm a A B h k l α β γ).coeff 8 = 0 := by unfold singleTerm transverse longitudinalSecond longitudinal mixedSecond transverseTrace ring_nf simp [mul_assoc, ← map_mul, ← map_pow, Polynomial.coeff_X, Polynomial.coeff_C] theorem single_coeff7 (a A B h k l α β γ : R) : (singleTerm a A B h k l α β γ).coeff 7 = 0 := by unfold singleTerm transverse longitudinalSecond longitudinal mixedSecond transverseTrace ring_nf simp [mul_assoc, ← map_mul, ← map_pow, Polynomial.coeff_X, Polynomial.coeff_C] theorem single_coeff6 (a A B h k l α β γ : R) : (singleTerm a A B h k l α β γ).coeff 6 = (h-4*a)*α^2 := by unfold singleTerm transverse longitudinalSecond longitudinal mixedSecond transverseTrace ring_nf simp [mul_assoc, ← map_mul, ← map_pow, Polynomial.coeff_X, Polynomial.coeff_C] ring theorem hessian_coeff8 (α β γ α' β' γ' H K L : R) : (hessianTerm α β γ α' β' γ' H K L).coeff 8 = 0 := by unfold hessianTerm transverse ring_nf simp [mul_assoc, ← map_mul, Polynomial.coeff_X, Polynomial.coeff_C] theorem hessian_coeff7 (α β γ α' β' γ' H K L : R) : (hessianTerm α β γ α' β' γ' H K L).coeff 7 = 0 := by unfold hessianTerm transverse ring_nf simp [mul_assoc, ← map_mul, Polynomial.coeff_X, Polynomial.coeff_C] theorem hessian_coeff6 (α β γ α' β' γ' H K L : R) : (hessianTerm α β γ α' β' γ' H K L).coeff 6 = α*α'*H := by unfold hessianTerm transverse ring_nf simp [mul_assoc, ← map_mul, Polynomial.coeff_X, Polynomial.coeff_C] variable {ι : Type*} [Fintype ι] /-- The cubic part of the minimal-graph operator for homogeneous quartic data. -/ noncomputable def operator (a A B h k l : R) (α β γ : ι → R) (H K L : ι → ι → R) : R[X] := (∑ i, transverse (α i) (β i) (γ i)^2)*longitudinalSecond a A+ (longitudinal a A B^2+∑ i, transverse (α i) (β i) (γ i)^2)*transverseTrace h k l- 2*longitudinal a A B*(∑ i, mixedSecond (α i) (β i)*transverse (α i) (β i) (γ i))- ∑ i, ∑ j, hessianTerm (α i) (β i) (γ i) (α j) (β j) (γ j) (H i j) (K i j) (L i j) theorem operator_decomposition (a A B h k l : R) (α β γ : ι → R) (H K L : ι → ι → R) : operator a A B h k l α β γ H K L = baseTerm a A B h k l+ (∑ i, singleTerm a A B h k l (α i) (β i) (γ i))- ∑ i, ∑ j, hessianTerm (α i) (β i) (γ i) (α j) (β j) (γ j) (H i j) (K i j) (L i j) := by unfold operator baseTerm singleTerm simp only [mul_add, add_mul, Finset.sum_add_distrib, Finset.sum_sub_distrib, Finset.mul_sum, Finset.sum_mul, mul_assoc] abel theorem operator_coeff8 (a A B h k l : R) (α β γ : ι → R) (H K L : ι → ι → R) : (operator a A B h k l α β γ H K L).coeff 8=16*a^2*h := by simp [operator_decomposition, base_coeff8, single_coeff8, hessian_coeff8] theorem operator_coeff7 (a A B h k l : R) (α β γ : ι → R) (H K L : ι → ι → R) : (operator a A B h k l α β γ H K L).coeff 7=16*a^2*k := by simp [operator_decomposition, base_coeff7, single_coeff7, hessian_coeff7] theorem operator_coeff6 (a A B h k l : R) (α β γ : ι → R) (H K L : ι → ι → R) : (operator a A B h k l α β γ H K L).coeff 6= 16*a^2*l+16*a*A*h+(h-4*a)*(∑ i, (α i)^2)- ∑ i, ∑ j, α i*α j*H i j := by simp only [operator_decomposition, coeff_add, coeff_sub, finsetSum_coeff, base_coeff6, single_coeff6, hessian_coeff6, ← Finset.mul_sum] theorem operator_coeff6_of_trace_zero (a A B k l : R) (α β γ : ι → R) (H K L : ι → ι → R) : (operator a A B 0 k l α β γ H K L).coeff 6= 16*a^2*l-4*a*(∑ i, (α i)^2)-∑ i, ∑ j, α i*α j*H i j := by rw [operator_coeff6] ring section Domain variable {F : Type*} [CommRing F] [IsDomain F] [CharZero F] theorem traces_zero_of_operator_zero (a A B h k l : F) (ha : a ≠ 0) (α β γ : ι → F) (H K L : ι → ι → F) (hop : operator a A B h k l α β γ H K L = 0) : h = 0 ∧ k = 0 := by have h8 := congrArg (fun p : F[X] => p.coeff 8) hop have h7 := congrArg (fun p : F[X] => p.coeff 7) hop rw [operator_coeff8, coeff_zero] at h8 rw [operator_coeff7, coeff_zero] at h7 have hn : (16:F)*a^2 ≠ 0 := mul_ne_zero (by norm_num) (pow_ne_zero 2 ha) exact ⟨(mul_eq_zero.mp h8).resolve_left hn, (mul_eq_zero.mp h7).resolve_left hn⟩ theorem laplacian_scalar_relation (a A B h k l : F) (ha : a ≠ 0) (α β γ : ι → F) (H K L : ι → ι → F) (hop : operator a A B h k l α β γ H K L = 0) : 16*a^2*l-4*a*(∑ i, (α i)^2)-∑ i, ∑ j, α i*α j*H i j = 0 := by obtain ⟨hh, _⟩ := traces_zero_of_operator_zero a A B h k l ha α β γ H K L hop subst h have h6 := congrArg (fun p : F[X] => p.coeff 6) hop simpa only [operator_coeff6_of_trace_zero, coeff_zero] using h6 end Domain open Matrix theorem dot_move_symmetric (S : Matrix ι ι R) (hS : S.IsSymm) (x y : ι → R) : (S *ᵥ x) ⬝ᵥ y = x ⬝ᵥ (S *ᵥ y) := by rw [dotProduct_mulVec, ← mulVec_transpose, hS] theorem sum_pairing_eq_dot (H : Matrix ι ι R) (x y : ι → R) : (∑ i, ∑ j, x i*y j*H i j) = x ⬝ᵥ (H *ᵥ y) := by simp only [dotProduct, mulVec, Finset.mul_sum] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ ring variable [DecidableEq ι] theorem gradient_square_relation (S : Matrix ι ι R) (hS : S.IsSymm) (y : ι → R) : (∑ i, (2*(S *ᵥ y) i)^2) = 4*(y ⬝ᵥ (S^2 *ᵥ y)) := by calc _ = ((2:R) • (S *ᵥ y)) ⬝ᵥ ((2:R) • (S *ᵥ y)) := by simp [dotProduct, Pi.smul_apply, smul_eq_mul, pow_two] _ = 4*((S *ᵥ y) ⬝ᵥ (S *ᵥ y)) := by rw [smul_dotProduct, dotProduct_smul] simp only [smul_eq_mul] ring _ = 4*(y ⬝ᵥ (S^2 *ᵥ y)) := by rw [dot_move_symmetric S hS] simp only [pow_two, mulVec_mulVec] theorem gradient_hessian_relation (S : Matrix ι ι R) (hS : S.IsSymm) (y : ι → R) : (∑ i, ∑ j, (2*(S *ᵥ y) i)*(2*(S *ᵥ y) j)*(2*S i j)) = 8*(y ⬝ᵥ (S^3 *ᵥ y)) := by change (∑ i, ∑ j, (((2:R) • (S *ᵥ y)) i)*(((2:R) • (S *ᵥ y)) j)* (((2:R) • S) i j)) = _ rw [sum_pairing_eq_dot, smul_mulVec, mulVec_smul, smul_dotProduct, dotProduct_smul, dotProduct_smul] simp only [smul_eq_mul] rw [dot_move_symmetric S hS] simp only [pow_succ, pow_zero, Matrix.one_mul, Matrix.mul_assoc, mulVec_mulVec] ring section Field variable {F : Type*} [Field F] [CharZero F] /-- The tangential Laplacian identity after writing `A(y)=yᵀ S y`. The assumptions are the polynomial operator equation and the explicit gradient/Hessian of `A`. -/ theorem laplacian_matrix_relation (a A B h k l : F) (ha : a ≠ 0) (S : Matrix ι ι F) (hS : S.IsSymm) (y β γ : ι → F) (K L : ι → ι → F) (hop : operator a A B h k l (fun i => 2*(S *ᵥ y) i) β γ (fun i j => 2*S i j) K L = 0) : l = y ⬝ᵥ ((a⁻¹ • S^2+(2*a^2)⁻¹ • S^3) *ᵥ y) := by have hc := laplacian_scalar_relation a A B h k l ha (fun i => 2*(S *ᵥ y) i) β γ (fun i j => 2*S i j) K L hop rw [gradient_square_relation S hS y, gradient_hessian_relation S hS y] at hc simp only [add_mulVec, smul_mulVec, dotProduct_add, dotProduct_smul, smul_eq_mul] field_simp [ha] linear_combination (1/8:F)*hc /-- The full Laplacian polynomial in the distinguished variable, in matrix form. -/ theorem laplacian_polynomial_relation (a B h k l : F) (ha : a ≠ 0) (S : Matrix ι ι F) (hS : S.IsSymm) (y β γ : ι → F) (K L : ι → ι → F) (hop : operator a (y ⬝ᵥ (S *ᵥ y)) B h k l (fun i => 2*(S *ᵥ y) i) β γ (fun i j => 2*S i j) K L = 0) : longitudinalSecond a (y ⬝ᵥ (S *ᵥ y))+transverseTrace h k l = C (12*a)*X^2+ C (y ⬝ᵥ (((2:F) • S+a⁻¹ • S^2+(2*a^2)⁻¹ • S^3) *ᵥ y)) := by obtain ⟨hh, hk⟩ := traces_zero_of_operator_zero a (y ⬝ᵥ (S *ᵥ y)) B h k l ha (fun i => 2*(S *ᵥ y) i) β γ (fun i j => 2*S i j) K L hop have hl := laplacian_matrix_relation a (y ⬝ᵥ (S *ᵥ y)) B h k l ha S hS y β γ K L hop simp [longitudinalSecond, transverseTrace, hh, hk, hl, add_mulVec, smul_mulVec, dotProduct_add, dotProduct_smul, smul_eq_mul, C_add, add_assoc] end Field end HomogeneousQuarticCoefficients end ComponentHomogeneousQuarticCoefficients /- Component: QuarticNormalForm -/ section ComponentQuarticNormalForm /- This component follows DistinguishedVariable and HomogeneousQuarticCoefficients. -/ namespace QuarticMinimal.QuarticNormalForm open MvPolynomial open QuarticMinimal.DistinguishedVariable variable {n : ℕ} noncomputable def laplacian (A : MvPolynomial (Fin n) ℝ) : MvPolynomial (Fin n) ℝ := ∑ i, pderiv i (pderiv i A) noncomputable def leadingExpression (P : MvPolynomial (Fin n) ℝ) : MvPolynomial (Fin n) ℝ := (∑ i, pderiv i P ^ 2) * (∑ i, pderiv i (pderiv i P)) - ∑ i, ∑ j, pderiv i P * pderiv j P * pderiv i (pderiv j P) noncomputable def splitLeadingExpression (Q : Polynomial (MvPolynomial (Fin n) ℝ)) : Polynomial (MvPolynomial (Fin n) ℝ) := (∑ i, coefficientPartial i Q ^ 2) * Polynomial.derivative (Polynomial.derivative Q) + (Polynomial.derivative Q ^ 2 + ∑ i, coefficientPartial i Q ^ 2) * (∑ i, coefficientPartial i (coefficientPartial i Q)) - 2 * Polynomial.derivative Q * (∑ i, Polynomial.derivative (coefficientPartial i Q) * coefficientPartial i Q) - ∑ i, ∑ j, coefficientPartial i Q * coefficientPartial j Q * coefficientPartial i (coefficientPartial j Q) theorem leading_expression_split {S ι : Type*} [CommRing S] [Fintype ι] (d dd : S) (v dv : ι → S) (h : ι → ι → S) : (d ^ 2 + ∑ i, v i ^ 2) * (dd + ∑ i, h i i) - (d * d * dd + (∑ i, d * v i * dv i) + ∑ i, (v i * d * dv i + ∑ j, v i * v j * h i j)) = (∑ i, v i ^ 2) * dd + (d ^ 2 + ∑ i, v i ^ 2) * (∑ i, h i i) - 2 * d * (∑ i, dv i * v i) - ∑ i, ∑ j, v i * v j * h i j := by have hm := minimal_expression_split d dd v dv h linear_combination hm theorem finSuccEquiv_leadingExpression (P : MvPolynomial (Fin (n + 1)) ℝ) : finSuccEquiv ℝ n (leadingExpression P) = splitLeadingExpression (finSuccEquiv ℝ n P) := by simp only [leadingExpression, map_sub, map_mul, map_add, map_sum, map_pow, Fin.sum_univ_succ, finSuccEquiv_pderiv_zero, finSuccEquiv_pderiv_succ, coefficientPartial_derivative] exact leading_expression_split (Polynomial.derivative (finSuccEquiv ℝ n P)) (Polynomial.derivative (Polynomial.derivative (finSuccEquiv ℝ n P))) (fun i : Fin n => coefficientPartial i (finSuccEquiv ℝ n P)) (fun i : Fin n => Polynomial.derivative (coefficientPartial i (finSuccEquiv ℝ n P))) (fun i j : Fin n => coefficientPartial i (coefficientPartial j (finSuccEquiv ℝ n P))) noncomputable def normalForm (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) : Polynomial (MvPolynomial (Fin n) ℝ) := Polynomial.C (C a) * Polynomial.X ^ 4 + Polynomial.C A * Polynomial.X ^ 2 + Polynomial.C B * Polynomial.X + Polynomial.C D theorem finSuccEquiv_normalForm (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (hP : P.totalDegree ≤ 4) (h4 : (finSuccEquiv ℝ n P).coeff 4 = C a) (h3 : (finSuccEquiv ℝ n P).coeff 3 = 0) : finSuccEquiv ℝ n P = normalForm a ((finSuccEquiv ℝ n P).coeff 2) ((finSuccEquiv ℝ n P).coeff 1) ((finSuccEquiv ℝ n P).coeff 0) := by conv_lhs => rw [finSuccEquiv_quartic P hP] simp only [h4, h3, map_zero, zero_mul, add_zero, normalForm] theorem derivative_normalForm (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) : Polynomial.derivative (normalForm a A B D) = HomogeneousQuarticCoefficients.longitudinal (C a) A B := by simp [normalForm, HomogeneousQuarticCoefficients.longitudinal, Polynomial.C_ofNat] ring theorem second_derivative_normalForm (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) : Polynomial.derivative (Polynomial.derivative (normalForm a A B D)) = HomogeneousQuarticCoefficients.longitudinalSecond (C a) A := by rw [derivative_normalForm] simp [HomogeneousQuarticCoefficients.longitudinal, HomogeneousQuarticCoefficients.longitudinalSecond, Polynomial.C_ofNat] ring theorem coefficientPartial_normalForm (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) (i : Fin n) : coefficientPartial i (normalForm a A B D) = HomogeneousQuarticCoefficients.transverse (pderiv i A) (pderiv i B) (pderiv i D) := by simp [normalForm, HomogeneousQuarticCoefficients.transverse, coefficientPartial_add, coefficientPartial_mul, coefficientPartial_C, coefficientPartial_pow, coefficientPartial_X] theorem derivative_transverse (α β γ : MvPolynomial (Fin n) ℝ) : Polynomial.derivative (HomogeneousQuarticCoefficients.transverse α β γ) = HomogeneousQuarticCoefficients.mixedSecond α β := by simp [HomogeneousQuarticCoefficients.transverse, HomogeneousQuarticCoefficients.mixedSecond, Polynomial.C_ofNat] ring theorem coefficientPartial_transverse (α β γ : MvPolynomial (Fin n) ℝ) (i : Fin n) : coefficientPartial i (HomogeneousQuarticCoefficients.transverse α β γ) = HomogeneousQuarticCoefficients.transverse (pderiv i α) (pderiv i β) (pderiv i γ) := by simp [HomogeneousQuarticCoefficients.transverse, coefficientPartial_add, coefficientPartial_mul, coefficientPartial_C, coefficientPartial_pow, coefficientPartial_X] theorem sum_transverse (α β γ : Fin n → MvPolynomial (Fin n) ℝ) : (∑ i, HomogeneousQuarticCoefficients.transverse (α i) (β i) (γ i)) = HomogeneousQuarticCoefficients.transverseTrace (∑ i, α i) (∑ i, β i) (∑ i, γ i) := by simp only [HomogeneousQuarticCoefficients.transverse, HomogeneousQuarticCoefficients.transverseTrace, Finset.sum_add_distrib, ← Finset.sum_mul, ← map_sum] theorem splitLeadingExpression_normalForm (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) : splitLeadingExpression (normalForm a A B D) = HomogeneousQuarticCoefficients.operator (C a) A B (laplacian A) (laplacian B) (laplacian D) (fun i => pderiv i A) (fun i => pderiv i B) (fun i => pderiv i D) (fun i j => pderiv i (pderiv j A)) (fun i j => pderiv i (pderiv j B)) (fun i j => pderiv i (pderiv j D)) := by simp only [splitLeadingExpression, coefficientPartial_normalForm, derivative_normalForm, derivative_transverse, coefficientPartial_transverse, sum_transverse] rw [show Polynomial.derivative (HomogeneousQuarticCoefficients.longitudinal (C a) A B) = HomogeneousQuarticCoefficients.longitudinalSecond (C a) A from by simpa only [derivative_normalForm] using second_derivative_normalForm a A B D] rfl theorem finSuccEquiv_leadingExpression_normalForm (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) (hQ : finSuccEquiv ℝ n P = normalForm a A B D) : finSuccEquiv ℝ n (leadingExpression P) = HomogeneousQuarticCoefficients.operator (C a) A B (laplacian A) (laplacian B) (laplacian D) (fun i => pderiv i A) (fun i => pderiv i B) (fun i => pderiv i D) (fun i j => pderiv i (pderiv j A)) (fun i j => pderiv i (pderiv j B)) (fun i j => pderiv i (pderiv j D)) := by rw [finSuccEquiv_leadingExpression, hQ, splitLeadingExpression_normalForm] theorem actual_constraints_of_normalForm (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) (ha : a ≠ 0) (hQ : finSuccEquiv ℝ n P = normalForm a A B D) (hP : leadingExpression P = 0) : laplacian A = 0 ∧ laplacian B = 0 ∧ 16 * C a ^ 2 * laplacian D - 4 * C a * (∑ i, pderiv i A ^ 2) - ∑ i, ∑ j, pderiv i A * pderiv j A * pderiv i (pderiv j A) = 0 := by have hop := finSuccEquiv_leadingExpression_normalForm P a A B D hQ rw [hP, map_zero] at hop have hCa : (C a : MvPolynomial (Fin n) ℝ) ≠ 0 := C_ne_zero.mpr ha obtain ⟨hA, hB⟩ := HomogeneousQuarticCoefficients.traces_zero_of_operator_zero (C a) A B (laplacian A) (laplacian B) (laplacian D) hCa (fun i => pderiv i A) (fun i => pderiv i B) (fun i => pderiv i D) (fun i j => pderiv i (pderiv j A)) (fun i j => pderiv i (pderiv j B)) (fun i j => pderiv i (pderiv j D)) hop.symm refine ⟨hA, hB, ?_⟩ exact HomogeneousQuarticCoefficients.laplacian_scalar_relation (C a) A B (laplacian A) (laplacian B) (laplacian D) hCa (fun i => pderiv i A) (fun i => pderiv i B) (fun i => pderiv i D) (fun i j => pderiv i (pderiv j A)) (fun i j => pderiv i (pderiv j B)) (fun i j => pderiv i (pderiv j D)) hop.symm theorem finSuccEquiv_laplacian_normalForm (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) (hQ : finSuccEquiv ℝ n P = normalForm a A B D) (hA : laplacian A = 0) (hB : laplacian B = 0) : finSuccEquiv ℝ n (laplacian P) = Polynomial.C (12 * C a) * Polynomial.X ^ 2 + Polynomial.C (2 * A + laplacian D) := by conv_lhs => simp only [laplacian, map_add, map_sum, Fin.sum_univ_succ, finSuccEquiv_pderiv_zero, finSuccEquiv_pderiv_succ] rw [hQ] simp only [second_derivative_normalForm, coefficientPartial_normalForm, coefficientPartial_transverse, sum_transverse] change HomogeneousQuarticCoefficients.longitudinalSecond (C a) A + HomogeneousQuarticCoefficients.transverseTrace (laplacian A) (laplacian B) (laplacian D) = Polynomial.C (12 * C a) * Polynomial.X ^ 2 + Polynomial.C (2 * A + laplacian D) simp [HomogeneousQuarticCoefficients.longitudinalSecond, HomogeneousQuarticCoefficients.transverseTrace, hA, hB, add_assoc] theorem homogeneous_coefficients (P : MvPolynomial (Fin (n + 1)) ℝ) (hP : P.IsHomogeneous 4) : ((finSuccEquiv ℝ n P).coeff 2).IsHomogeneous 2 ∧ ((finSuccEquiv ℝ n P).coeff 1).IsHomogeneous 3 ∧ ((finSuccEquiv ℝ n P).coeff 0).IsHomogeneous 4 := by exact ⟨coeff_finSuccEquiv_isHomogeneous P hP 2, coeff_finSuccEquiv_isHomogeneous P hP 1, coeff_finSuccEquiv_isHomogeneous P hP 0⟩ theorem homogeneous_quartic_constraints (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (ha : a ≠ 0) (hP : P.IsHomogeneous 4) (h4 : (finSuccEquiv ℝ n P).coeff 4 = C a) (h3 : (finSuccEquiv ℝ n P).coeff 3 = 0) (hL : leadingExpression P = 0) : let A := (finSuccEquiv ℝ n P).coeff 2 let B := (finSuccEquiv ℝ n P).coeff 1 let D := (finSuccEquiv ℝ n P).coeff 0 laplacian A = 0 ∧ laplacian B = 0 ∧ 16 * C a ^ 2 * laplacian D - 4 * C a * (∑ i, pderiv i A ^ 2) - ∑ i, ∑ j, pderiv i A * pderiv j A * pderiv i (pderiv j A) = 0 := by exact actual_constraints_of_normalForm P a _ _ _ ha (finSuccEquiv_normalForm P a hP.totalDegree_le h4 h3) hL theorem laplacian_relation_at (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) (ha : a ≠ 0) (hQ : finSuccEquiv ℝ n P = normalForm a A B D) (hP : leadingExpression P = 0) (y : Fin n → ℝ) : 16 * a ^ 2 * eval y (laplacian D) - 4 * a * (∑ i, eval y (pderiv i A) ^ 2) - ∑ i, ∑ j, eval y (pderiv i A) * eval y (pderiv j A) * eval y (pderiv i (pderiv j A)) = 0 := by have h := (actual_constraints_of_normalForm P a A B D ha hQ hP).2.2 have he := congrArg (eval y) h simpa only [map_sub, map_mul, map_pow, map_sum, map_ofNat, eval_C, map_zero] using he /- The remaining lemmas also use LowDegree.lean. -/ open Matrix noncomputable def quadraticMatrix (A : MvPolynomial (Fin n) ℝ) : Matrix (Fin n) (Fin n) ℝ := (1 / 2 : ℝ) • QuarticMinimal.hessianCoeff A theorem quadraticMatrix_symmetric (A : MvPolynomial (Fin n) ℝ) : (quadraticMatrix A).IsSymm := (QuarticMinimal.hessianCoeff_symmetric A).smul (1 / 2 : ℝ) theorem eval_homogeneous_quadratic_gradient (A : MvPolynomial (Fin n) ℝ) (hA : A.IsHomogeneous 2) (y : Fin n → ℝ) (i : Fin n) : eval y (pderiv i A) = 2 * (quadraticMatrix A *ᵥ y) i := by rw [QuarticMinimal.eval_quadratic_gradient A hA.totalDegree_le] have hc : (pderiv i A).coeff 0 = 0 := (QuarticCompatibility.homogeneous_pderiv (i := i) hA).coeff_eq_zero (by simp) simp only [hc, add_zero, quadraticMatrix, Matrix.smul_mulVec, Pi.smul_apply, smul_eq_mul] ring theorem eval_homogeneous_quadratic_hessian (A : MvPolynomial (Fin n) ℝ) (hA : A.IsHomogeneous 2) (y : Fin n → ℝ) (i j : Fin n) : eval y (pderiv i (pderiv j A)) = 2 * quadraticMatrix A i j := by rw [QuarticMinimal.second_partial_eq_C_of_totalDegree_le_two A hA.totalDegree_le] simp [quadraticMatrix] theorem eval_homogeneous_quadratic (A : MvPolynomial (Fin n) ℝ) (hA : A.IsHomogeneous 2) (y : Fin n → ℝ) : eval y A = y ⬝ᵥ (quadraticMatrix A *ᵥ y) := by conv_lhs => rw [QuarticMinimal.homogeneous_quadratic_expansion A hA] simp only [map_mul, map_sum, eval_C, eval_X, quadraticMatrix, Matrix.smul_mulVec, dotProduct_smul, smul_eq_mul] congr 1 simp only [dotProduct, Matrix.mulVec, Finset.mul_sum] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ ring theorem actual_laplacian_matrix_relation (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) (ha : a ≠ 0) (hA : A.IsHomogeneous 2) (hQ : finSuccEquiv ℝ n P = normalForm a A B D) (hP : leadingExpression P = 0) (y : Fin n → ℝ) : eval y (laplacian D) = y ⬝ᵥ ((a⁻¹ • quadraticMatrix A ^ 2 + (2 * a ^ 2)⁻¹ • quadraticMatrix A ^ 3) *ᵥ y) := by have hc := laplacian_relation_at P a A B D ha hQ hP y simp_rw [eval_homogeneous_quadratic_gradient A hA y, eval_homogeneous_quadratic_hessian A hA y] at hc rw [HomogeneousQuarticCoefficients.gradient_square_relation (quadraticMatrix A) (quadraticMatrix_symmetric A) y, HomogeneousQuarticCoefficients.gradient_hessian_relation (quadraticMatrix A) (quadraticMatrix_symmetric A) y] at hc simp only [Matrix.add_mulVec, Matrix.smul_mulVec, dotProduct_add, dotProduct_smul, smul_eq_mul] field_simp [ha] linear_combination (1 / 8 : ℝ) * hc theorem actual_full_laplacian_at (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) (ha : a ≠ 0) (hA : A.IsHomogeneous 2) (hQ : finSuccEquiv ℝ n P = normalForm a A B D) (hP : leadingExpression P = 0) (y : Fin n → ℝ) (t : ℝ) : eval (Fin.cons t y) (laplacian P) = 12 * a * t ^ 2 + y ⬝ᵥ (((2 : ℝ) • quadraticMatrix A + a⁻¹ • quadraticMatrix A ^ 2 + (2 * a ^ 2)⁻¹ • quadraticMatrix A ^ 3) *ᵥ y) := by obtain ⟨hAz, hBz, _⟩ := actual_constraints_of_normalForm P a A B D ha hQ hP rw [eval_eq_eval_mv_eval' y t, finSuccEquiv_laplacian_normalForm P a A B D hQ hAz hBz] simp only [Polynomial.map_add, Polynomial.map_mul, Polynomial.map_pow, Polynomial.map_C, Polynomial.map_X, Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_pow, Polynomial.eval_C, Polynomial.eval_X, map_mul, map_add, Polynomial.map_ofNat, Polynomial.eval_ofNat, map_ofNat, eval_C] rw [eval_homogeneous_quadratic A hA y, actual_laplacian_matrix_relation P a A B D ha hA hQ hP y] simp only [Matrix.add_mulVec, Matrix.smul_mulVec, dotProduct_add, dotProduct_smul, smul_eq_mul] ring theorem homogeneous_quartic_laplacian_at (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (ha : a ≠ 0) (hP : P.IsHomogeneous 4) (h4 : (finSuccEquiv ℝ n P).coeff 4 = C a) (h3 : (finSuccEquiv ℝ n P).coeff 3 = 0) (hL : leadingExpression P = 0) (y : Fin n → ℝ) (t : ℝ) : let A := (finSuccEquiv ℝ n P).coeff 2 eval (Fin.cons t y) (laplacian P) = 12 * a * t ^ 2 + y ⬝ᵥ (((2 : ℝ) • quadraticMatrix A + a⁻¹ • quadraticMatrix A ^ 2 + (2 * a ^ 2)⁻¹ • quadraticMatrix A ^ 3) *ᵥ y) := by exact actual_full_laplacian_at P a _ _ _ ha (homogeneous_coefficients P hP).1 (finSuccEquiv_normalForm P a hP.totalDegree_le h4 h3) hL y t end QuarticMinimal.QuarticNormalForm end ComponentQuarticNormalForm /- Component: AmbientQuartic -/ section ComponentAmbientQuartic /- Requires ChangeVariables, LinearSubstitution, LowDegree, and QuarticNormalForm. -/ noncomputable section open scoped BigOperators Matrix open MvPolynomial open QuarticMinimal.QuarticNormalForm namespace QuarticMinimal.AmbientQuartic variable {ι κ : Type*} [Fintype ι] [Fintype κ] def realHessian (P : MvPolynomial ι ℝ) (x : ι → ℝ) : Matrix ι ι ℝ := (QuarticMinimal.hessian P).map (eval x) omit [Fintype ι] in theorem realHessian_apply (P : MvPolynomial ι ℝ) (x : ι → ℝ) (i j : ι) : realHessian P x i j = eval x (pderiv i (pderiv j P)) := rfl omit [Fintype ι] in theorem realHessian_symmetric (P : MvPolynomial ι ℝ) (x : ι → ℝ) : (realHessian P x).IsSymm := by ext i j simp only [realHessian_apply, Matrix.transpose_apply] rw [QuarticPolynomialBasics.second_partial_comm] omit [Fintype ι] in theorem realHessian_zero (P : MvPolynomial ι ℝ) : realHessian P 0 = QuarticMinimal.hessianCoeff P := by ext i j simp only [realHessian_apply, eval_zero, constantCoeff_eq, QuarticMinimal.hessianCoeff] theorem realHessian_changeVariables (U : Matrix ι κ ℝ) (P : MvPolynomial ι ℝ) (x : κ → ℝ) : realHessian (changeVariables U P) x = U.transpose * realHessian P (U *ᵥ x) * U := by ext j k simp only [realHessian_apply, pderiv_pderiv_changeVariables, map_sum, map_mul, eval_changeVariables, eval_C, Matrix.mul_apply, Matrix.transpose_apply, Finset.sum_mul] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro l _ ring theorem hessianCoeff_changeVariables (U : Matrix ι κ ℝ) (P : MvPolynomial ι ℝ) : hessianCoeff (changeVariables U P) = U.transpose * hessianCoeff P * U := by have h := realHessian_changeVariables U P 0 simpa only [Matrix.mulVec_zero, realHessian_zero] using h variable {n m : ℕ} theorem quadraticMatrix_changeVariables (U : Matrix (Fin n) (Fin m) ℝ) (P : MvPolynomial (Fin n) ℝ) : quadraticMatrix (changeVariables U P) = U.transpose * quadraticMatrix P * U := by rw [quadraticMatrix, hessianCoeff_changeVariables, quadraticMatrix] simp only [Matrix.mul_smul, Matrix.smul_mul] def canonicalS (P : MvPolynomial ι ℝ) (a : ℝ) (e : ι → ℝ) : Matrix ι ι ℝ := (1 / 2 : ℝ) • realHessian P e - (6 * a) • Matrix.vecMulVec e e omit [Fintype ι] in theorem canonicalS_symmetric (P : MvPolynomial ι ℝ) (a : ℝ) (e : ι → ℝ) : (canonicalS P a e).IsSymm := by apply Matrix.IsSymm.sub ((realHessian_symmetric P e).smul _) apply Matrix.IsSymm.smul ext i j simp only [Matrix.transpose_apply, Matrix.vecMulVec_apply] ring omit [Fintype κ] in theorem outer_conjugate (U : Matrix ι κ ℝ) (e : ι → ℝ) : U.transpose * Matrix.vecMulVec e e * U = Matrix.vecMulVec (U.transpose *ᵥ e) (U.transpose *ᵥ e) := by rw [Matrix.mul_vecMulVec, Matrix.vecMulVec_mul, ← Matrix.mulVec_transpose] theorem canonicalS_changeVariables [DecidableEq ι] (U : Matrix ι ι ℝ) (hU : U * U.transpose = 1) (P : MvPolynomial ι ℝ) (a : ℝ) (x : ι → ℝ) : canonicalS (changeVariables U P) a x = U.transpose * canonicalS P a (U *ᵥ x) * U := by have hUt : U.transpose * U = 1 := mul_eq_one_comm.mp hU simp only [canonicalS, realHessian_changeVariables, Matrix.mul_sub, Matrix.sub_mul, Matrix.mul_smul, Matrix.smul_mul, outer_conjugate] rw [Matrix.mulVec_mulVec, hUt, Matrix.one_mulVec] theorem symmetric_matrix_ext [DecidableEq ι] (A B : Matrix ι ι ℝ) (hA : A.IsSymm) (hB : B.IsSymm) (h : ∀ x, x ⬝ᵥ (A *ᵥ x) = x ⬝ᵥ (B *ᵥ x)) : A = B := by ext i j have hi := h (Pi.single i 1) have hj := h (Pi.single j 1) have hij := h (Pi.single i 1 + Pi.single j 1) simp only [Matrix.mulVec_single_one, single_one_dotProduct] at hi hj simp only [Matrix.mulVec_add, dotProduct_add, add_dotProduct, Matrix.mulVec_single_one, single_one_dotProduct] at hij change A i i = B i i at hi change A j j = B j j at hj change A i i + A j i + (A i j + A j j) = B i i + B j i + (B i j + B j j) at hij rw [hA.apply i j, hB.apply i j] at hij linarith theorem conjugate_mul [DecidableEq ι] (U S T : Matrix ι ι ℝ) (hU : U * U.transpose = 1) : (U.transpose * S * U) * (U.transpose * T * U) = U.transpose * (S * T) * U := by calc _ = U.transpose * S * (U * U.transpose) * T * U := by noncomm_ring _ = _ := by rw [hU]; simp only [Matrix.mul_one, Matrix.mul_assoc] theorem conjugate_pow [DecidableEq ι] (U S : Matrix ι ι ℝ) (hU : U * U.transpose = 1) (k : ℕ) : (U.transpose * S * U) ^ k = U.transpose * S ^ k * U := by have hUt : U.transpose * U = 1 := mul_eq_one_comm.mp hU induction k with | zero => simp [hUt] | succ k hk => rw [pow_succ, hk, conjugate_mul U (S ^ k) S hU, pow_succ] def cubicMatrix [DecidableEq ι] (a : ℝ) (S : Matrix ι ι ℝ) : Matrix ι ι ℝ := (2 : ℝ) • S + a⁻¹ • S ^ 2 + (2 * a ^ 2)⁻¹ • S ^ 3 theorem cubicMatrix_symmetric [DecidableEq ι] (a : ℝ) (S : Matrix ι ι ℝ) (hS : S.IsSymm) : (cubicMatrix a S).IsSymm := ((hS.smul _).add ((hS.pow 2).smul _)).add ((hS.pow 3).smul _) theorem cubicMatrix_conjugate [DecidableEq ι] (a : ℝ) (U S : Matrix ι ι ℝ) (hU : U * U.transpose = 1) : cubicMatrix a (U.transpose * S * U) = U.transpose * cubicMatrix a S * U := by simp only [cubicMatrix, conjugate_pow U S hU, Matrix.mul_add, Matrix.add_mul, Matrix.mul_smul, Matrix.smul_mul] def axis (n : ℕ) : Fin (n + 1) → ℝ := Fin.cons 1 0 def liftMatrix (S : Matrix (Fin n) (Fin n) ℝ) : Matrix (Fin (n + 1)) (Fin (n + 1)) ℝ := fun i j => Fin.cases 0 (fun i => Fin.cases 0 (fun j => S i j) j) i theorem liftMatrix_symmetric (S : Matrix (Fin n) (Fin n) ℝ) (hS : S.IsSymm) : (liftMatrix S).IsSymm := by ext i j cases i using Fin.cases <;> cases j using Fin.cases <;> simp [liftMatrix, Matrix.transpose_apply, hS.apply] theorem liftMatrix_mulVec (S : Matrix (Fin n) (Fin n) ℝ) (t : ℝ) (y : Fin n → ℝ) : liftMatrix S *ᵥ Fin.cons t y = Fin.cons 0 (S *ᵥ y) := by funext i cases i using Fin.cases <;> simp [liftMatrix, Matrix.mulVec, dotProduct, Fin.sum_univ_succ] theorem liftMatrix_quadratic (S : Matrix (Fin n) (Fin n) ℝ) (t : ℝ) (y : Fin n → ℝ) : (Fin.cons t y) ⬝ᵥ (liftMatrix S *ᵥ Fin.cons t y) = y ⬝ᵥ (S *ᵥ y) := by rw [liftMatrix_mulVec] simp [dotProduct, Fin.sum_univ_succ] theorem outer_mulVec (e x : ι → ℝ) : Matrix.vecMulVec e e *ᵥ x = (e ⬝ᵥ x) • e := by funext i simp only [Matrix.mulVec, dotProduct, Matrix.vecMulVec_apply, Pi.smul_apply, smul_eq_mul, Finset.sum_mul] apply Finset.sum_congr rfl intro j _ ring theorem outer_quadratic (e x : ι → ℝ) : x ⬝ᵥ (Matrix.vecMulVec e e *ᵥ x) = (e ⬝ᵥ x) ^ 2 := by rw [outer_mulVec, dotProduct_smul, dotProduct_comm x e] simp only [smul_eq_mul, pow_two] theorem axis_dot_cons (t : ℝ) (y : Fin n → ℝ) : axis n ⬝ᵥ Fin.cons t y = t := by simp [axis, dotProduct, Fin.sum_univ_succ] theorem liftMatrix_mul (S T : Matrix (Fin n) (Fin n) ℝ) : liftMatrix (S * T) = liftMatrix S * liftMatrix T := by ext i j cases i using Fin.cases <;> cases j using Fin.cases <;> simp [liftMatrix, Matrix.mul_apply, Fin.sum_univ_succ] theorem liftMatrix_add (S T : Matrix (Fin n) (Fin n) ℝ) : liftMatrix (S + T) = liftMatrix S + liftMatrix T := by ext i j cases i using Fin.cases <;> cases j using Fin.cases <;> simp [liftMatrix] theorem liftMatrix_smul (r : ℝ) (S : Matrix (Fin n) (Fin n) ℝ) : liftMatrix (r • S) = r • liftMatrix S := by ext i j cases i using Fin.cases <;> cases j using Fin.cases <;> simp [liftMatrix] theorem cubicMatrix_lift (a : ℝ) (S : Matrix (Fin n) (Fin n) ℝ) : cubicMatrix a (liftMatrix S) = liftMatrix (cubicMatrix a S) := by simp only [cubicMatrix, pow_succ, pow_zero, Matrix.one_mul, ← liftMatrix_mul, liftMatrix_add, liftMatrix_smul] omit [Fintype ι] in theorem eval_zero_of_homogeneous (P : MvPolynomial ι ℝ) {d : ℕ} (hP : P.IsHomogeneous d) (hd : 0 < d) : eval 0 P = 0 := by rw [eval_zero, constantCoeff_eq] exact hP.coeff_eq_zero (by simp; omega) theorem realHessian_normalForm_zero_zero (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) (hQ : finSuccEquiv ℝ n P = normalForm a A B D) (t : ℝ) (y : Fin n → ℝ) : realHessian P (Fin.cons t y) 0 0 = 12 * a * t ^ 2 + 2 * eval y A := by rw [realHessian_apply, eval_eq_eval_mv_eval' y t, DistinguishedVariable.finSuccEquiv_pderiv_zero_zero, hQ, second_derivative_normalForm] simp [HomogeneousQuarticCoefficients.longitudinalSecond, Polynomial.C_ofNat] theorem realHessian_normalForm_zero_succ (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) (hQ : finSuccEquiv ℝ n P = normalForm a A B D) (t : ℝ) (y : Fin n → ℝ) (j : Fin n) : realHessian P (Fin.cons t y) 0 j.succ = 2 * eval y (pderiv j A) * t + eval y (pderiv j B) := by rw [realHessian_apply, eval_eq_eval_mv_eval' y t, DistinguishedVariable.finSuccEquiv_pderiv_zero, DistinguishedVariable.finSuccEquiv_pderiv_succ, hQ, coefficientPartial_normalForm, derivative_transverse] simp [HomogeneousQuarticCoefficients.mixedSecond, Polynomial.C_ofNat] theorem realHessian_normalForm_succ_succ (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) (hQ : finSuccEquiv ℝ n P = normalForm a A B D) (t : ℝ) (y : Fin n → ℝ) (i j : Fin n) : realHessian P (Fin.cons t y) i.succ j.succ = eval y (pderiv i (pderiv j A)) * t ^ 2 + eval y (pderiv i (pderiv j B)) * t + eval y (pderiv i (pderiv j D)) := by rw [realHessian_apply, eval_eq_eval_mv_eval' y t, DistinguishedVariable.finSuccEquiv_pderiv_succ, DistinguishedVariable.finSuccEquiv_pderiv_succ, hQ, coefficientPartial_normalForm, coefficientPartial_transverse] simp [HomogeneousQuarticCoefficients.transverse] theorem realHessian_at_axis (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) (hA : A.IsHomogeneous 2) (hB : B.IsHomogeneous 3) (hD : D.IsHomogeneous 4) (hQ : finSuccEquiv ℝ n P = normalForm a A B D) : realHessian P (axis n) = (12 * a) • Matrix.vecMulVec (axis n) (axis n) + (2 : ℝ) • liftMatrix (quadraticMatrix A) := by have h00 : realHessian P (axis n) 0 0 = 12 * a := by rw [axis, realHessian_normalForm_zero_zero P a A B D hQ] rw [eval_zero_of_homogeneous A hA (by decide)] ring have h0j (j : Fin n) : realHessian P (axis n) 0 j.succ = 0 := by rw [axis, realHessian_normalForm_zero_succ P a A B D hQ] rw [eval_zero_of_homogeneous (pderiv j A) (QuarticCompatibility.homogeneous_pderiv hA) (by decide), eval_zero_of_homogeneous (pderiv j B) (QuarticCompatibility.homogeneous_pderiv hB) (by decide)] ring have hij (i j : Fin n) : realHessian P (axis n) i.succ j.succ = 2 * quadraticMatrix A i j := by rw [axis, realHessian_normalForm_succ_succ P a A B D hQ] rw [eval_zero_of_homogeneous (pderiv i (pderiv j B)) (QuarticCompatibility.homogeneous_pderiv (QuarticCompatibility.homogeneous_pderiv hB)) (by decide), eval_zero_of_homogeneous (pderiv i (pderiv j D)) (QuarticCompatibility.homogeneous_pderiv (QuarticCompatibility.homogeneous_pderiv hD)) (by decide), eval_homogeneous_quadratic_hessian A hA] ring ext i j cases i using Fin.cases <;> cases j using Fin.cases · simpa [axis, liftMatrix, Matrix.vecMulVec_apply] using h00 · simpa [axis, liftMatrix, Matrix.vecMulVec_apply] using h0j _ · rw [(realHessian_symmetric P (axis n)).apply 0] simpa [axis, liftMatrix, Matrix.vecMulVec_apply] using h0j _ · simpa [axis, liftMatrix, Matrix.vecMulVec_apply] using hij _ _ theorem canonicalS_at_axis (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) (hA : A.IsHomogeneous 2) (hB : B.IsHomogeneous 3) (hD : D.IsHomogeneous 4) (hQ : finSuccEquiv ℝ n P = normalForm a A B D) : canonicalS P a (axis n) = liftMatrix (quadraticMatrix A) := by rw [canonicalS, realHessian_at_axis P a A B D hA hB hD hQ] ext i j simp only [Matrix.sub_apply, Matrix.add_apply, Matrix.smul_apply, smul_eq_mul] ring omit [Fintype ι] in theorem outer_symmetric (e : ι → ℝ) : (Matrix.vecMulVec e e).IsSymm := by ext i j simp only [Matrix.transpose_apply, Matrix.vecMulVec_apply] ring theorem laplacian_isHomogeneous (P : MvPolynomial (Fin n) ℝ) (hP : P.IsHomogeneous 4) : (QuarticNormalForm.laplacian P).IsHomogeneous 2 := by unfold QuarticNormalForm.laplacian apply IsHomogeneous.sum intro i _ simpa using QuarticCompatibility.homogeneous_pderiv (i := i) (QuarticCompatibility.homogeneous_pderiv hP) theorem local_Q_normalForm (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (A B D : MvPolynomial (Fin n) ℝ) (ha : a ≠ 0) (hP : P.IsHomogeneous 4) (hA : A.IsHomogeneous 2) (hQ : finSuccEquiv ℝ n P = normalForm a A B D) (hL : leadingExpression P = 0) : quadraticMatrix (QuarticNormalForm.laplacian P) = (12 * a) • Matrix.vecMulVec (axis n) (axis n) + liftMatrix (cubicMatrix a (quadraticMatrix A)) := by apply symmetric_matrix_ext _ _ (quadraticMatrix_symmetric _) (((outer_symmetric (axis n)).smul _).add (liftMatrix_symmetric _ (cubicMatrix_symmetric _ _ (quadraticMatrix_symmetric _)))) intro x have hx : x = Fin.cons (x 0) (fun i => x i.succ) := by funext i cases i using Fin.cases <;> rfl rw [hx, ← eval_homogeneous_quadratic _ (laplacian_isHomogeneous P hP)] rw [actual_full_laplacian_at P a A B D ha hA hQ hL] simp only [cubicMatrix, Matrix.add_mulVec, Matrix.smul_mulVec, dotProduct_add, dotProduct_smul, outer_quadratic, axis_dot_cons, liftMatrix_quadratic, smul_eq_mul] theorem local_Q_canonical (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (ha : a ≠ 0) (hP : P.IsHomogeneous 4) (h4 : (finSuccEquiv ℝ n P).coeff 4 = C a) (h3 : (finSuccEquiv ℝ n P).coeff 3 = 0) (hL : leadingExpression P = 0) : quadraticMatrix (QuarticNormalForm.laplacian P) = (12 * a) • Matrix.vecMulVec (axis n) (axis n) + cubicMatrix a (canonicalS P a (axis n)) := by obtain ⟨hA, hB, hD⟩ := homogeneous_coefficients P hP have hQ := finSuccEquiv_normalForm P a hP.totalDegree_le h4 h3 rw [local_Q_normalForm P a _ _ _ ha hP hA hQ hL, canonicalS_at_axis P a _ _ _ hA hB hD hQ, cubicMatrix_lift] theorem conjugate_injective [DecidableEq ι] (U : Matrix ι ι ℝ) (hU : U * U.transpose = 1) : Function.Injective (fun M : Matrix ι ι ℝ => U.transpose * M * U) := by intro A B h have hh := congrArg (fun M => U * M * U.transpose) h have hc (M : Matrix ι ι ℝ) : U * (U.transpose * M * U) * U.transpose = M := by calc _ = (U * U.transpose) * M * (U * U.transpose) := by noncomm_ring _ = M := by rw [hU]; simp simpa only [hc] using hh theorem ambient_Q_identity (P : MvPolynomial (Fin (n + 1)) ℝ) (U : Matrix (Fin (n + 1)) (Fin (n + 1)) ℝ) (hU : U * U.transpose = 1) (a : ℝ) (ha : a ≠ 0) (hP : P.IsHomogeneous 4) (h4 : (finSuccEquiv ℝ n (changeVariables U P)).coeff 4 = C a) (h3 : (finSuccEquiv ℝ n (changeVariables U P)).coeff 3 = 0) (hL : leadingExpression P = 0) : quadraticMatrix (QuarticNormalForm.laplacian P) = (12 * a) • Matrix.vecMulVec (U *ᵥ axis n) (U *ᵥ axis n) + cubicMatrix a (canonicalS P a (U *ᵥ axis n)) := by have hUt : U.transpose * U = 1 := mul_eq_one_comm.mp hU have hR := isHomogeneous_changeVariables U P 4 hP have hLR : leadingExpression (changeVariables U P) = 0 := leadingOperator_changeVariables_eq_zero U hU P hL have hh := local_Q_canonical (changeVariables U P) a ha hR h4 h3 hLR have hLap : QuarticNormalForm.laplacian (changeVariables U P) = changeVariables U (QuarticNormalForm.laplacian P) := laplacian_changeVariables U hU P rw [hLap, quadraticMatrix_changeVariables, canonicalS_changeVariables U hU, cubicMatrix_conjugate a U _ hU] at hh apply conjugate_injective U hU dsimp only rw [hh] simp only [Matrix.mul_add, Matrix.add_mul, Matrix.mul_smul, Matrix.smul_mul, outer_conjugate] rw [Matrix.mulVec_mulVec, hUt, Matrix.one_mulVec] theorem canonicalS_axis_kernel (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (hP : P.IsHomogeneous 4) (h4 : (finSuccEquiv ℝ n P).coeff 4 = C a) (h3 : (finSuccEquiv ℝ n P).coeff 3 = 0) : canonicalS P a (axis n) *ᵥ axis n = 0 := by obtain ⟨hA, hB, hD⟩ := homogeneous_coefficients P hP have hQ := finSuccEquiv_normalForm P a hP.totalDegree_le h4 h3 rw [canonicalS_at_axis P a _ _ _ hA hB hD hQ, axis, liftMatrix_mulVec] simp only [Matrix.mulVec_zero] funext i cases i using Fin.cases <;> rfl theorem canonicalS_ambient_kernel (P : MvPolynomial (Fin (n + 1)) ℝ) (U : Matrix (Fin (n + 1)) (Fin (n + 1)) ℝ) (hU : U * U.transpose = 1) (a : ℝ) (hP : P.IsHomogeneous 4) (h4 : (finSuccEquiv ℝ n (changeVariables U P)).coeff 4 = C a) (h3 : (finSuccEquiv ℝ n (changeVariables U P)).coeff 3 = 0) : canonicalS P a (U *ᵥ axis n) *ᵥ (U *ᵥ axis n) = 0 := by have hk := canonicalS_axis_kernel (changeVariables U P) a (isHomogeneous_changeVariables U P 4 hP) h4 h3 rw [canonicalS_changeVariables U hU] at hk have hv : U.transpose *ᵥ (canonicalS P a (U *ᵥ axis n) *ᵥ (U *ᵥ axis n)) = 0 := by simpa only [Matrix.mulVec_mulVec, Matrix.mul_assoc] using hk have hh := congrArg (fun v => U *ᵥ v) hv rwa [Matrix.mulVec_mulVec, hU, Matrix.one_mulVec, Matrix.mulVec_zero] at hh theorem ambient_axis_unit (U : Matrix (Fin (n + 1)) (Fin (n + 1)) ℝ) (hU : U * U.transpose = 1) : (U *ᵥ axis n) ⬝ᵥ (U *ᵥ axis n) = 1 := by have hUt : U.transpose * U = 1 := mul_eq_one_comm.mp hU have h := MatrixAlgebra.dot_transpose_mulVec U.transpose (by simpa using hUt) (axis n) (axis n) have hn : axis n ⬝ᵥ axis n = 1 := axis_dot_cons 1 0 simpa only [Matrix.transpose_transpose, hn] using h theorem cubicMatrix_kernel [DecidableEq ι] (a : ℝ) (S : Matrix ι ι ℝ) (v : ι → ℝ) (hS : S *ᵥ v = 0) : cubicMatrix a S *ᵥ v = 0 := by simp [cubicMatrix, Matrix.add_mulVec, Matrix.smul_mulVec, pow_succ, ← Matrix.mulVec_mulVec, hS] theorem ambient_Q_action (P : MvPolynomial (Fin (n + 1)) ℝ) (U : Matrix (Fin (n + 1)) (Fin (n + 1)) ℝ) (hU : U * U.transpose = 1) (a : ℝ) (ha : a ≠ 0) (hP : P.IsHomogeneous 4) (h4 : (finSuccEquiv ℝ n (changeVariables U P)).coeff 4 = C a) (h3 : (finSuccEquiv ℝ n (changeVariables U P)).coeff 3 = 0) (hL : leadingExpression P = 0) : let e := U *ᵥ axis n let Q := quadraticMatrix (QuarticNormalForm.laplacian P) let S := canonicalS P a e Q *ᵥ e = (12 * a) • e ∧ ∀ v, e ⬝ᵥ v = 0 → cubicMatrix a S *ᵥ v = Q *ᵥ v := by dsimp only have hQ := ambient_Q_identity P U hU a ha hP h4 h3 hL constructor · rw [hQ, Matrix.add_mulVec, Matrix.smul_mulVec, outer_mulVec, ambient_axis_unit U hU, one_smul, cubicMatrix_kernel a _ _ (canonicalS_ambient_kernel P U hU a hP h4 h3), add_zero] · intro v hv rw [hQ, Matrix.add_mulVec, Matrix.smul_mulVec, outer_mulVec, hv, zero_smul, smul_zero, zero_add] theorem realHessian_mixed_symmetry (P : MvPolynomial ι ℝ) (hP : P.IsHomogeneous 4) (e f : ι → ℝ) : f ⬝ᵥ (realHessian P e *ᵥ f) = e ⬝ᵥ (realHessian P f *ᵥ e) := by have hm := QuarticMinimal.quartic_mixed_hessian_symmetry P hP e f change (∑ i, ∑ j, f i * f j * realHessian P e i j) = ∑ i, ∑ j, e i * e j * realHessian P f i j at hm simpa only [HomogeneousQuarticCoefficients.sum_pairing_eq_dot] using hm theorem canonicalS_mixed_symmetry (P : MvPolynomial ι ℝ) (hP : P.IsHomogeneous 4) (a b : ℝ) (e f : ι → ℝ) (hef : e ⬝ᵥ f = 0) : f ⬝ᵥ (canonicalS P a e *ᵥ f) = e ⬝ᵥ (canonicalS P b f *ᵥ e) := by have hfe : f ⬝ᵥ e = 0 := by rw [dotProduct_comm, hef] simp only [canonicalS, Matrix.sub_mulVec, Matrix.smul_mulVec, dotProduct_sub, dotProduct_smul, outer_quadratic, smul_eq_mul, hef, hfe, zero_pow (by decide : 2 ≠ 0), mul_zero, sub_zero] rw [realHessian_mixed_symmetry P hP e f] end QuarticMinimal.AmbientQuartic end end ComponentAmbientQuartic /- Component: OrthogonalNormalization -/ section ComponentOrthogonalNormalization noncomputable section open scoped BigOperators Matrix open MvPolynomial namespace QuarticNormalization variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- A Euclidean unit vector may be chosen as any specified column of an orthogonal matrix. The convention is that new coordinates `x` map to `A *ᵥ x`. -/ theorem exists_orthogonal_with_column (j : ι) (e : ι → ℝ) (he : ∑ i, (e i) ^ 2 = 1) : ∃ A : Matrix ι ι ℝ, A.transpose * A = 1 ∧ A * A.transpose = 1 ∧ ∀ i, A i j = e i := by let b := EuclideanSpace.basisFun ι ℝ let w : EuclideanSpace ℝ ι := WithLp.toLp 2 e have hw : ‖w‖ = 1 := by have h := EuclideanSpace.real_norm_sq_eq w have hh : ‖w‖ ^ 2 = 1 := by simpa [w, he] using h nlinarith [norm_nonneg w] let R := Submodule.reflection (ℝ ∙ (b j - w))ᗮ have hR : R (b j) = w := Submodule.reflection_sub (by rw [b.norm_eq_one, hw]) let c := b.map R let A : Matrix ι ι ℝ := b.toBasis.toMatrix c refine ⟨A, ?_, ?_, ?_⟩ · simpa only [Matrix.conjTranspose_eq_transpose_of_trivial] using b.toMatrix_orthonormalBasis_conjTranspose_mul_self c · simpa only [Matrix.conjTranspose_eq_transpose_of_trivial] using b.toMatrix_orthonormalBasis_self_mul_conjTranspose c · intro i change b.toBasis.repr (R (b j)) i = e i rw [hR] rfl omit [DecidableEq ι] in /-- The Euclidean unit sphere is compact in the ordinary finite function-space topology. -/ theorem isCompact_coordinate_sphere : IsCompact {x : ι → ℝ | ∑ i, (x i) ^ 2 = 1} := by have hc : IsClosed {x : ι → ℝ | ∑ i, (x i) ^ 2 = 1} := by apply isClosed_eq <;> fun_prop apply (isCompact_Icc : IsCompact (Set.Icc (fun _ : ι => (-1 : ℝ)) (fun _ => 1))).of_isClosed_subset hc intro x hx constructor <;> intro i · have hi : (x i) ^ 2 ≤ ∑ j, (x j) ^ 2 := Finset.single_le_sum (fun j _ => sq_nonneg (x j)) (Finset.mem_univ i) change ∑ j, (x j) ^ 2 = 1 at hx nlinarith · have hi : (x i) ^ 2 ≤ ∑ j, (x j) ^ 2 := Finset.single_le_sum (fun j _ => sq_nonneg (x j)) (Finset.mem_univ i) change ∑ j, (x j) ^ 2 = 1 at hx nlinarith omit [DecidableEq ι] in /-- Every polynomial with a positive value on the sphere has a positive spherical maximum. -/ theorem exists_positive_sphere_maximum (P : MvPolynomial ι ℝ) (y : ι → ℝ) (hy : ∑ i, (y i) ^ 2 = 1) (hPy : 0 < eval y P) : ∃ e : ι → ℝ, (∑ i, (e i) ^ 2 = 1) ∧ 0 < eval e P ∧ IsLocalExtrOn (fun x : ι → ℝ => eval x P) {x | ∑ i, (x i) ^ 2 = 1} e := by obtain ⟨e, he, hmax⟩ := isCompact_coordinate_sphere.exists_isMaxOn ⟨y, hy⟩ (QuarticPolynomialBasics.differentiable_eval P).continuous.continuousOn exact ⟨e, he, lt_of_lt_of_le hPy (hmax hy), Or.inr hmax.isLocalMaxOn⟩ omit [DecidableEq ι] in /-- Substitution by a matrix evaluates as multiplication by that matrix. -/ theorem eval_changeVariables (A : Matrix ι ι ℝ) (P : MvPolynomial ι ℝ) (x : ι → ℝ) : eval x (QuarticMinimal.changeVariables A P) = eval (A *ᵥ x) P := by induction P using MvPolynomial.induction_on with | C r => simp [QuarticMinimal.changeVariables] | add P Q hP hQ => simp only [map_add, hP, hQ] | mul_X P i hP => simp only [map_mul, hP] congr 1 simp [QuarticMinimal.changeVariables, QuarticMinimal.linearSubstitution, Matrix.mulVec, dotProduct] omit [DecidableEq ι] in theorem isHomogeneous_changeVariables (A : Matrix ι ι ℝ) (P : MvPolynomial ι ℝ) (d : ℕ) (hP : P.IsHomogeneous d) : (QuarticMinimal.changeVariables A P).IsHomogeneous d := by simpa only [QuarticMinimal.changeVariables, one_mul] using hP.aeval (QuarticMinimal.linearSubstitution A) (fun i => IsHomogeneous.sum _ _ _ (fun j _ => isHomogeneous_C_mul_X (A i j) j)) /-- A critical direction becomes the selected coordinate axis; all tangential first derivatives vanish there. -/ theorem normalized_gradient (P : MvPolynomial ι ℝ) (e : ι → ℝ) (j : ι) (A : Matrix ι ι ℝ) (hA : A.transpose * A = 1) (hcol : ∀ i, A i j = e i) (c : ℝ) (hg : ∀ i, eval e (pderiv i P) = c * e i) : ∀ k, eval (Pi.single j 1) (pderiv k (QuarticMinimal.changeVariables A P)) = if j = k then c else 0 := by intro k have hx : A *ᵥ Pi.single j 1 = e := by ext i simp [Matrix.mulVec, dotProduct, Pi.single_apply, hcol] have hik := congrArg (fun B : Matrix ι ι ℝ => B j k) hA simp only [Matrix.mul_apply, Matrix.transpose_apply, Matrix.one_apply] at hik simp only [QuarticMinimal.pderiv_changeVariables, map_sum, map_mul, eval_changeVariables, hx, hg, eval_C] simp_rw [← hcol, mul_assoc] rw [← Finset.mul_sum, hik] split_ifs <;> simp_all /-- Evaluating a homogeneous polynomial at a coordinate unit vector extracts its pure-power coefficient. -/ theorem eval_basis_of_isHomogeneous (P : MvPolynomial ι ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (j : ι) : eval (Pi.single j 1) P = P.coeff (Finsupp.single j d) := by rw [eval_eq'] rw [Finset.sum_eq_single (Finsupp.single j d)] · have hprod : (∏ i, (Pi.single j (1 : ℝ) i) ^ (Finsupp.single j d i)) = (1 : ℝ) := by apply Finset.prod_eq_one intro i _ by_cases hi : i = j · subst i; simp · simp [hi] rw [hprod, mul_one] · intro r hr hne have hd : r.degree = d := by simpa only [Finsupp.degree_eq_weight_one, Pi.one_def] using hP (mem_support_iff.mp hr) have hex : ∃ i, i ≠ j ∧ r i ≠ 0 := by by_contra h push Not at h have heq : r = Finsupp.single j (r j) := by ext i by_cases hi : i = j · subst i; simp · simp [h i hi, Ne.symm hi] have hd' : r j = d := by have hh := congrArg (fun r : ι →₀ ℕ => r.degree) heq rw [Finsupp.degree_single] at hh exact hh.symm.trans hd exact hne (heq.trans (congrArg (Finsupp.single j) hd')) obtain ⟨i, hij, hri⟩ := hex have hz : (∏ k, (Pi.single j (1 : ℝ) k) ^ (r k)) = (0 : ℝ) := by apply Finset.prod_eq_zero (Finset.mem_univ i) simp [Ne.symm hij, hri] rw [hz, mul_zero] · intro hn have hz : P.coeff (Finsupp.single j d) = 0 := by by_contra hh exact hn (mem_support_iff.mpr hh) simp only [hz, zero_mul] /-- A tangential derivative on the coordinate axis extracts the coefficient of the monomial with one tangential variable. -/ theorem eval_pderiv_basis_of_isHomogeneous (P : MvPolynomial ι ℝ) (d : ℕ) (hP : P.IsHomogeneous (d + 1)) (j k : ι) (hjk : j ≠ k) : eval (Pi.single j 1) (pderiv k P) = P.coeff (Finsupp.single j d + Finsupp.single k 1) := by rw [eval_basis_of_isHomogeneous (pderiv k P) d (QuarticPolynomialBasics.isHomogeneous_pderiv_succ P k d hP) j, coeff_pderiv] simp [hjk] theorem normalized_tangential_coeff_zero (P : MvPolynomial ι ℝ) (d : ℕ) (hP : P.IsHomogeneous (d + 1)) (e : ι → ℝ) (j : ι) (A : Matrix ι ι ℝ) (hA : A.transpose * A = 1) (hcol : ∀ i, A i j = e i) (c : ℝ) (hg : ∀ i, eval e (pderiv i P) = c * e i) : ∀ k, j ≠ k → (QuarticMinimal.changeVariables A P).coeff (Finsupp.single j d + Finsupp.single k 1) = 0 := by intro k hjk have hh := normalized_gradient P e j A hA hcol c hg k rw [eval_pderiv_basis_of_isHomogeneous _ d (isHomogeneous_changeVariables A P (d + 1) hP) j k hjk] at hh simpa [hjk] using hh /-- Normal form at a positive spherical maximum, including the vanishing of all coefficients with exactly one tangential variable. -/ theorem exists_normalized_positive_direction (P : MvPolynomial ι ℝ) (d : ℕ) (hP : P.IsHomogeneous (d + 1)) (j : ι) (y : ι → ℝ) (hy : ∑ i, (y i) ^ 2 = 1) (hPy : 0 < eval y P) : ∃ A : Matrix ι ι ℝ, A.transpose * A = 1 ∧ A * A.transpose = 1 ∧ 0 < (QuarticMinimal.changeVariables A P).coeff (Finsupp.single j (d + 1)) ∧ ∀ k, j ≠ k → (QuarticMinimal.changeVariables A P).coeff (Finsupp.single j d + Finsupp.single k 1) = 0 := by obtain ⟨e, he, hPe, hmax⟩ := exists_positive_sphere_maximum P y hy hPy obtain ⟨A, hA, hA', hcol⟩ := exists_orthogonal_with_column j e he refine ⟨A, hA, hA', ?_, ?_⟩ · rw [← eval_basis_of_isHomogeneous _ (d + 1) (isHomogeneous_changeVariables A P (d + 1) hP) j, eval_changeVariables] have hx : A *ᵥ Pi.single j 1 = e := by ext i simp [Matrix.mulVec, dotProduct, Pi.single_apply, hcol] simpa only [hx] using hPe · exact normalized_tangential_coeff_zero P d hP e j A hA hcol ((d + 1 : ℕ) * eval e P) (QuarticPolynomialBasics.gradient_at_homogeneous_sphere_extremum P (d + 1) hP e he hmax) omit [Fintype ι] [DecidableEq ι] in /-- Real homogeneity as a scaling identity for polynomial evaluation. -/ theorem eval_scale_of_isHomogeneous (P : MvPolynomial ι ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (x : ι → ℝ) (c : ℝ) : eval (fun i => c * x i) P = c ^ d * eval x P := by rw [eval_eq, eval_eq, Finset.mul_sum] apply Finset.sum_congr rfl intro r hr simp only [mul_pow, Finset.prod_mul_distrib, Finset.prod_pow_eq_pow_sum, ← hP.degree_eq_sum_deg_support hr] ring omit [DecidableEq ι] in /-- A positive value of a positive-degree homogeneous polynomial can be moved to the Euclidean unit sphere by a positive scaling. -/ theorem exists_positive_sphere_value (P : MvPolynomial ι ℝ) (d : ℕ) (hP : P.IsHomogeneous (d + 1)) (x : ι → ℝ) (hPx : 0 < eval x P) : ∃ y : ι → ℝ, (∑ i, (y i) ^ 2 = 1) ∧ 0 < eval y P := by have hzero : eval (0 : ι → ℝ) P = 0 := by simpa using eval_scale_of_isHomogeneous P (d + 1) hP x 0 have hx : x ≠ 0 := by intro hh rw [hh, hzero] at hPx exact (lt_irrefl 0) hPx have hsnonneg : 0 ≤ ∑ i, (x i) ^ 2 := Finset.sum_nonneg (fun i _ => sq_nonneg (x i)) have hsne : (∑ i, (x i) ^ 2) ≠ 0 := by intro hh apply hx ext i have hi : (x i) ^ 2 ≤ ∑ j, (x j) ^ 2 := Finset.single_le_sum (fun j _ => sq_nonneg (x j)) (Finset.mem_univ i) simp only [Pi.zero_apply] nlinarith let r := Real.sqrt (∑ i, (x i) ^ 2) have hr : 0 < r := Real.sqrt_pos.mpr (lt_of_le_of_ne hsnonneg (Ne.symm hsne)) have hr2 : r ^ 2 = ∑ i, (x i) ^ 2 := Real.sq_sqrt hsnonneg refine ⟨fun i => r⁻¹ * x i, ?_, ?_⟩ · simp only [mul_pow, ← Finset.mul_sum, inv_pow, ← hr2] exact inv_mul_cancel₀ (pow_ne_zero 2 (ne_of_gt hr)) · rw [eval_scale_of_isHomogeneous P (d + 1) hP x r⁻¹] exact mul_pos (pow_pos (inv_pos.mpr hr) _) hPx theorem exists_normalized_positive_direction_of_value (P : MvPolynomial ι ℝ) (d : ℕ) (hP : P.IsHomogeneous (d + 1)) (j : ι) (x : ι → ℝ) (hPx : 0 < eval x P) : ∃ A : Matrix ι ι ℝ, A.transpose * A = 1 ∧ A * A.transpose = 1 ∧ 0 < (QuarticMinimal.changeVariables A P).coeff (Finsupp.single j (d + 1)) ∧ ∀ k, j ≠ k → (QuarticMinimal.changeVariables A P).coeff (Finsupp.single j d + Finsupp.single k 1) = 0 := by obtain ⟨y, hy, hPy⟩ := exists_positive_sphere_value P d hP x hPx exact exists_normalized_positive_direction P d hP j y hy hPy theorem exists_normalized_negative_direction_of_value (P : MvPolynomial ι ℝ) (d : ℕ) (hP : P.IsHomogeneous (d + 1)) (j : ι) (x : ι → ℝ) (hPx : eval x P < 0) : ∃ A : Matrix ι ι ℝ, A.transpose * A = 1 ∧ A * A.transpose = 1 ∧ (QuarticMinimal.changeVariables A P).coeff (Finsupp.single j (d + 1)) < 0 ∧ ∀ k, j ≠ k → (QuarticMinimal.changeVariables A P).coeff (Finsupp.single j d + Finsupp.single k 1) = 0 := by obtain ⟨A, hA, hA', hp, hz⟩ := exists_normalized_positive_direction_of_value (-P) d hP.neg j x (by simpa only [map_neg, neg_pos] using hPx) refine ⟨A, hA, hA', ?_, ?_⟩ · simpa only [map_neg, coeff_neg, neg_pos] using hp · intro k hjk simpa only [map_neg, coeff_neg, neg_eq_zero] using hz k hjk omit [Fintype ι] [DecidableEq ι] in /-- Every nonzero homogeneous polynomial of odd degree assumes positive values. -/ theorem exists_positive_value_of_odd (P : MvPolynomial ι ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : Odd d) (hne : P ≠ 0) : ∃ x : ι → ℝ, 0 < eval x P := by by_contra hh push Not at hh apply hne apply QuarticCompatibility.polynomial_funext intro x have hx := hh x have hnx := hh (fun i => -x i) have he := eval_scale_of_isHomogeneous P d hP x (-1) rw [hd.neg_one_pow] at he simp only [neg_one_mul] at he rw [he] at hnx simp only [map_zero] linarith end QuarticNormalization end end ComponentOrthogonalNormalization /- Component: CoefficientNormalization -/ section ComponentCoefficientNormalization /- Requires PolynomialBasics, LowDegree, ChangeVariables, OrthogonalNormalization. -/ noncomputable section open scoped BigOperators Matrix open MvPolynomial namespace QuarticNormalization variable {n : ℕ} /-- The highest coefficient in the distinguished variable is constant for a homogeneous polynomial of the same degree. -/ theorem finSuccEquiv_top_coeff (P : MvPolynomial (Fin (n + 1)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) : (finSuccEquiv ℝ n P).coeff d = C (P.coeff (Finsupp.single 0 d)) := by have hh := hP.finSuccEquiv_coeff_isHomogeneous d 0 (by omega) have hd := Nat.eq_zero_of_le_zero hh.totalDegree_le rw [totalDegree_eq_zero_iff_eq_C.mp hd, finSuccEquiv_coeff_coeff] simp only [Finsupp.cons_zero_eq_single_zero] /-- Vanishing coefficients with one tangential variable eliminate the entire next-to-leading coefficient in distinguished-variable normal form. -/ theorem finSuccEquiv_next_coeff_eq_zero (P : MvPolynomial (Fin (n + 1)) ℝ) (d : ℕ) (hP : P.IsHomogeneous (d + 1)) (hz : ∀ i : Fin n, P.coeff (Finsupp.single 0 d + Finsupp.single i.succ 1) = 0) : (finSuccEquiv ℝ n P).coeff d = 0 := by have hh := hP.finSuccEquiv_coeff_isHomogeneous d 1 rfl rw [QuarticMinimal.homogeneous_linear_expansion _ hh] apply Finset.sum_eq_zero intro i _ have hs : (Finsupp.single i 1).cons d = Finsupp.single 0 d + Finsupp.single i.succ 1 := by ext j cases j using Fin.cases <;> simp [Finsupp.single_apply] simp only [coeff_pderiv, zero_add, Finsupp.zero_apply, Nat.cast_zero, zero_add, mul_one, finSuccEquiv_coeff_coeff, hs, hz, map_zero, zero_mul] /-- The positive normal form used by the cubic and quartic coefficient arguments. -/ theorem exists_positive_normal_form (P : MvPolynomial (Fin (n + 1)) ℝ) (d : ℕ) (hP : P.IsHomogeneous (d + 1)) (x : Fin (n + 1) → ℝ) (hx : 0 < eval x P) : ∃ (A : Matrix (Fin (n + 1)) (Fin (n + 1)) ℝ) (a : ℝ), A.transpose * A = 1 ∧ A * A.transpose = 1 ∧ 0 < a ∧ (finSuccEquiv ℝ n (QuarticMinimal.changeVariables A P)).coeff (d + 1) = C a ∧ (finSuccEquiv ℝ n (QuarticMinimal.changeVariables A P)).coeff d = 0 := by obtain ⟨A, hA, hA', ha, hz⟩ := exists_normalized_positive_direction_of_value P d hP 0 x hx refine ⟨A, (QuarticMinimal.changeVariables A P).coeff (Finsupp.single 0 (d + 1)), hA, hA', ha, ?_, ?_⟩ · exact finSuccEquiv_top_coeff _ _ (isHomogeneous_changeVariables A P _ hP) · apply finSuccEquiv_next_coeff_eq_zero _ d (isHomogeneous_changeVariables A P _ hP) intro i exact hz i.succ (Ne.symm (Fin.succ_ne_zero i)) theorem exists_negative_normal_form (P : MvPolynomial (Fin (n + 1)) ℝ) (d : ℕ) (hP : P.IsHomogeneous (d + 1)) (x : Fin (n + 1) → ℝ) (hx : eval x P < 0) : ∃ (A : Matrix (Fin (n + 1)) (Fin (n + 1)) ℝ) (a : ℝ), A.transpose * A = 1 ∧ A * A.transpose = 1 ∧ a < 0 ∧ (finSuccEquiv ℝ n (QuarticMinimal.changeVariables A P)).coeff (d + 1) = C a ∧ (finSuccEquiv ℝ n (QuarticMinimal.changeVariables A P)).coeff d = 0 := by obtain ⟨A, hA, hA', ha, hz⟩ := exists_normalized_negative_direction_of_value P d hP 0 x hx refine ⟨A, (QuarticMinimal.changeVariables A P).coeff (Finsupp.single 0 (d + 1)), hA, hA', ha, ?_, ?_⟩ · exact finSuccEquiv_top_coeff _ _ (isHomogeneous_changeVariables A P _ hP) · apply finSuccEquiv_next_coeff_eq_zero _ d (isHomogeneous_changeVariables A P _ hP) intro i exact hz i.succ (Ne.symm (Fin.succ_ne_zero i)) end QuarticNormalization end end ComponentCoefficientNormalization /- Component: QuarticSpectral -/ section ComponentQuarticSpectral open scoped BigOperators open Matrix namespace QuarticSpectral /-- The scalar polynomial arising in the quartic tangential Laplacian identity. -/ noncomputable def scalarFa (a s : ℝ) : ℝ := 2*s+s^2/a+s^3/(2*a^2) theorem scalarFa_factor (a s : ℝ) (ha : a ≠ 0) : scalarFa a s = s/2*((s/a+1)^2+3) := by unfold scalarFa field_simp ring theorem scalarFa_strictMono (a : ℝ) (ha : a ≠ 0) : StrictMono (scalarFa a) := by intro x y hxy have hN : 0 < x^2+x*y+y^2+2*a*(x+y)+4*a^2 := by nlinarith [sq_nonneg (3*x+3*y+4*a), sq_nonneg (x-y), sq_pos_of_ne_zero ha] have hd : 0 < 2*a^2 := mul_pos (by norm_num) (sq_pos_of_ne_zero ha) have hid : scalarFa a y-scalarFa a x = (y-x)*(x^2+x*y+y^2+2*a*(x+y)+4*a^2)/(2*a^2) := by unfold scalarFa field_simp ring have hp : 0 < scalarFa a y-scalarFa a x := by rw [hid] exact div_pos (mul_pos (sub_pos.mpr hxy) hN) hd linarith theorem scalarFa_zero (a : ℝ) : scalarFa a 0 = 0 := by simp [scalarFa] theorem scalarFa_pos_iff (a s : ℝ) (ha : a ≠ 0) : 0 < scalarFa a s ↔ 0 < s := by simpa only [scalarFa_zero] using (scalarFa_strictMono a ha).lt_iff_lt (a := 0) (b := s) theorem scalarFa_neg_iff (a s : ℝ) (ha : a ≠ 0) : scalarFa a s < 0 ↔ s < 0 := by simpa only [scalarFa_zero] using (scalarFa_strictMono a ha).lt_iff_lt (a := s) (b := 0) variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Polynomial functional calculus at a real matrix. -/ noncomputable def matrixFa (a : ℝ) (S : Matrix ι ι ℝ) : Matrix ι ι ℝ := (2:ℝ) • S+a⁻¹ • S^2+(2*a^2)⁻¹ • S^3 theorem matrixFa_mulVec (a : ℝ) (S : Matrix ι ι ℝ) (v : ι → ℝ) : matrixFa a S *ᵥ v = (2:ℝ) • (S *ᵥ v)+a⁻¹ • (S *ᵥ (S *ᵥ v))+ (2*a^2)⁻¹ • (S *ᵥ (S *ᵥ (S *ᵥ v))) := by simp [matrixFa, add_mulVec, smul_mulVec, pow_succ, ← mulVec_mulVec] omit [DecidableEq ι] in theorem dot_move_symmetric (S : Matrix ι ι ℝ) (hS : S.IsSymm) (x y : ι → ℝ) : (S *ᵥ x) ⬝ᵥ y = x ⬝ᵥ (S *ᵥ y) := by rw [dotProduct_mulVec, ← mulVec_transpose, hS] omit [DecidableEq ι] in theorem dot_self_nonneg (v : ι → ℝ) : 0 ≤ v ⬝ᵥ v := by exact Finset.sum_nonneg (fun i _ => mul_self_nonneg (v i)) omit [DecidableEq ι] in theorem dot_self_pos (v : ι → ℝ) (hv : v ≠ 0) : 0 < v ⬝ᵥ v := by exact lt_of_le_of_ne (dot_self_nonneg v) (Ne.symm (dotProduct_self_eq_zero.not.mpr hv)) /-- A sum-of-squares identity replaces diagonalization in the sign argument. -/ theorem matrixFa_energy (a : ℝ) (ha : a ≠ 0) (S : Matrix ι ι ℝ) (hS : S.IsSymm) (v : ι → ℝ) : (S *ᵥ v) ⬝ᵥ (matrixFa a S *ᵥ v) = (3/2:ℝ)*((S *ᵥ v) ⬝ᵥ (S *ᵥ v))+ (2*a^2)⁻¹*((S *ᵥ (S *ᵥ v)+a • (S *ᵥ v)) ⬝ᵥ (S *ᵥ (S *ᵥ v)+a • (S *ᵥ v))) := by have hh := dot_move_symmetric S hS (S *ᵥ v) (S *ᵥ (S *ᵥ v)) have hcross := dotProduct_comm (S *ᵥ (S *ᵥ v)) (S *ᵥ v) rw [matrixFa_mulVec] simp only [dotProduct_add, add_dotProduct, dotProduct_smul, smul_dotProduct, smul_eq_mul] rw [← hh, hcross] field_simp ring /-- Every nonzero eigenvector of `Fa(S)` inherits the sign of its eigenvalue in the quadratic form of `S`. -/ theorem eigenvalue_times_quadratic_pos (a c : ℝ) (ha : a ≠ 0) (hc : c ≠ 0) (S : Matrix ι ι ℝ) (hS : S.IsSymm) (v : ι → ℝ) (hv : v ≠ 0) (heig : matrixFa a S *ᵥ v = c • v) : 0 < c*(v ⬝ᵥ (S *ᵥ v)) := by have hsv : S *ᵥ v ≠ 0 := by intro hz have hz' : matrixFa a S *ᵥ v = 0 := by simp only [matrixFa_mulVec, hz, mulVec_zero, smul_zero, add_zero] rw [heig] at hz' exact hv ((smul_eq_zero.mp hz').resolve_left hc) have he := matrixFa_energy a ha S hS v rw [heig, dotProduct_smul, smul_eq_mul, dotProduct_comm (S *ᵥ v) v] at he rw [he] exact add_pos_of_pos_of_nonneg (mul_pos (by norm_num) (dot_self_pos _ hsv)) (mul_nonneg (inv_nonneg.mpr (by positivity)) (dot_self_nonneg _)) theorem quadratic_neg_of_matrixFa_eigenvalue_neg (a c : ℝ) (ha : a ≠ 0) (hc : c < 0) (S : Matrix ι ι ℝ) (hS : S.IsSymm) (v : ι → ℝ) (hv : v ≠ 0) (heig : matrixFa a S *ᵥ v = c • v) : v ⬝ᵥ (S *ᵥ v) < 0 := by have hp := eigenvalue_times_quadratic_pos a c ha (ne_of_lt hc) S hS v hv heig by_contra hn have hnonpos := mul_nonpos_of_nonpos_of_nonneg (le_of_lt hc) (le_of_not_gt hn) linarith theorem quadratic_pos_of_matrixFa_eigenvalue_pos (a c : ℝ) (ha : a ≠ 0) (hc : 0 < c) (S : Matrix ι ι ℝ) (hS : S.IsSymm) (v : ι → ℝ) (hv : v ≠ 0) (heig : matrixFa a S *ᵥ v = c • v) : 0 < v ⬝ᵥ (S *ᵥ v) := by have hp := eigenvalue_times_quadratic_pos a c ha (ne_of_gt hc) S hS v hv heig by_contra hn have hnonpos := mul_nonpos_of_nonneg_of_nonpos (le_of_lt hc) (le_of_not_gt hn) linarith omit [DecidableEq ι] in /-- Distinct real eigenvalues of a symmetric matrix have orthogonal eigenvectors. -/ theorem eigenvectors_orthogonal (Q : Matrix ι ι ℝ) (hQ : Q.IsSymm) (e f : ι → ℝ) (c d : ℝ) (hcd : c ≠ d) (he : Q *ᵥ e = c • e) (hf : Q *ᵥ f = d • f) : e ⬝ᵥ f = 0 := by have heq := dot_move_symmetric Q hQ e f rw [he, hf, smul_dotProduct, dotProduct_smul, smul_eq_mul, smul_eq_mul] at heq have hm : (c-d)*(e ⬝ᵥ f) = 0 := by linear_combination heq exact (mul_eq_zero.mp hm).resolve_left (sub_ne_zero.mpr hcd) /-- The two opposite critical values cannot give the same mixed quartic coefficient. This is the algebraic contradiction in Proposition 4, with no spectral theorem. -/ theorem two_critical_directions_impossible (a b : ℝ) (ha : 0 < a) (hb : b < 0) (S T : Matrix ι ι ℝ) (hS : S.IsSymm) (hT : T.IsSymm) (e f : ι → ℝ) (he : e ≠ 0) (hf : f ≠ 0) (hSf : matrixFa a S *ᵥ f = (12*b) • f) (hTe : matrixFa b T *ᵥ e = (12*a) • e) (hmixed : f ⬝ᵥ (S *ᵥ f) = e ⬝ᵥ (T *ᵥ e)) : False := by have hn := quadratic_neg_of_matrixFa_eigenvalue_neg a (12*b) (ne_of_gt ha) (mul_neg_of_pos_of_neg (by norm_num) hb) S hS f hf hSf have hp := quadratic_pos_of_matrixFa_eigenvalue_pos b (12*a) (ne_of_lt hb) (mul_pos (by norm_num) ha) T hT e he hTe rw [hmixed] at hn linarith /-- A shared symmetric Laplacian matrix and its two tangential formulas yield exactly the contradiction above. Orthogonality follows from the two critical values. -/ theorem two_critical_directions_from_laplacian (a b : ℝ) (ha : 0 < a) (hb : b < 0) (Q S T : Matrix ι ι ℝ) (hQ : Q.IsSymm) (hS : S.IsSymm) (hT : T.IsSymm) (e f : ι → ℝ) (he : e ≠ 0) (hf : f ≠ 0) (hQe : Q *ᵥ e = (12*a) • e) (hQf : Q *ᵥ f = (12*b) • f) (hSe : ∀ x : ι → ℝ, e ⬝ᵥ x = 0 → matrixFa a S *ᵥ x = Q *ᵥ x) (hTf : ∀ x : ι → ℝ, f ⬝ᵥ x = 0 → matrixFa b T *ᵥ x = Q *ᵥ x) (hmixed : f ⬝ᵥ (S *ᵥ f) = e ⬝ᵥ (T *ᵥ e)) : False := by have hef : e ⬝ᵥ f = 0 := eigenvectors_orthogonal Q hQ e f (12*a) (12*b) (by nlinarith) hQe hQf have hfe : f ⬝ᵥ e = 0 := by simpa only [dotProduct_comm] using hef exact two_critical_directions_impossible a b ha hb S T hS hT e f he hf ((hSe f hef).trans hQf) ((hTf e hfe).trans hQe) hmixed end QuarticSpectral end ComponentQuarticSpectral /- Component: QuarticSign -/ section ComponentQuarticSign /- Requires CoefficientNormalization, AmbientQuartic, and QuarticSpectral. -/ noncomputable section open scoped BigOperators Matrix open MvPolynomial open QuarticMinimal.QuarticNormalForm QuarticMinimal.AmbientQuartic namespace QuarticMinimal variable {n : ℕ} /-- An actual homogeneous quartic solution of the leading minimal-graph operator cannot have both a positive value and a negative value. -/ theorem homogeneous_quartic_no_opposite_signs (P : MvPolynomial (Fin (n + 1)) ℝ) (hP : P.IsHomogeneous 4) (hL : leadingOperator P = 0) (x y : Fin (n + 1) → ℝ) (hx : 0 < eval x P) (hy : eval y P < 0) : False := by obtain ⟨U, a, _hUt, hU, ha, h4U, h3U⟩ := QuarticNormalization.exists_positive_normal_form P 3 hP x hx obtain ⟨V, b, _hVt, hV, hb, h4V, h3V⟩ := QuarticNormalization.exists_negative_normal_form P 3 hP y hy let e := U *ᵥ axis n let f := V *ᵥ axis n let Q := quadraticMatrix (QuarticNormalForm.laplacian P) let S := canonicalS P a e let T := canonicalS P b f have hQa := ambient_Q_action P U hU a (ne_of_gt ha) hP h4U h3U hL have hQb := ambient_Q_action P V hV b (ne_of_lt hb) hP h4V h3V hL have he : e ≠ 0 := by intro he have hu : e ⬝ᵥ e = 1 := ambient_axis_unit U hU simp [he] at hu have hf : f ≠ 0 := by intro hf have hv : f ⬝ᵥ f = 1 := ambient_axis_unit V hV simp [hf] at hv have hQs : Q.IsSymm := quadraticMatrix_symmetric _ have hSs : S.IsSymm := canonicalS_symmetric P a e have hTs : T.IsSymm := canonicalS_symmetric P b f have hef : e ⬝ᵥ f = 0 := QuarticSpectral.eigenvectors_orthogonal Q hQs e f (12 * a) (12 * b) (by nlinarith) hQa.1 hQb.1 have hmixed : f ⬝ᵥ (S *ᵥ f) = e ⬝ᵥ (T *ᵥ e) := canonicalS_mixed_symmetry P hP a b e f hef exact QuarticSpectral.two_critical_directions_from_laplacian a b ha hb Q S T hQs hSs hTs e f he hf hQa.1 hQb.1 hQa.2 hQb.2 hmixed /-- Every homogeneous quartic solution of the leading minimal-graph operator has one weak sign, in every finite dimension. -/ theorem homogeneous_quartic_has_one_sign (P : MvPolynomial (Fin n) ℝ) (hP : P.IsHomogeneous 4) (hL : leadingOperator P = 0) : (∀ x, 0 ≤ eval x P) ∨ (∀ x, eval x P ≤ 0) := by cases n with | zero => left intro x have hx : x = 0 := Subsingleton.elim _ _ rw [hx, eval_zero_of_homogeneous P hP (by decide)] | succ n => by_cases hp : ∃ x, 0 < eval x P · left obtain ⟨x, hx⟩ := hp intro y by_contra hy exact homogeneous_quartic_no_opposite_signs P hP hL x y hx (lt_of_not_ge hy) · right intro x exact le_of_not_gt (fun hx => hp ⟨x, hx⟩) end QuarticMinimal end end ComponentQuarticSign /- Component: QuadraticScalar -/ section ComponentQuadraticScalar /-! The diagonal quadratic minimal-graph obstruction. The proof evaluates the equation at points that cancel the gradient in each nonzero eigendirection. The reduction of a quadratic polynomial to this diagonal equation is not asserted here. -/ namespace QuarticMinimal.QuadraticScalar noncomputable def cancelPoint {ι : Type*} (eigenvalue c : ι → ℝ) (i : ι) : ℝ := -c i / eigenvalue i theorem velocity_cancel {ι : Type*} (eigenvalue c : ι → ℝ) (i : ι) (hi : eigenvalue i ≠ 0) : eigenvalue i * cancelPoint eigenvalue c i + c i = 0 := by unfold cancelPoint field_simp ring theorem weighted_velocity_cancel {ι : Type*} (eigenvalue c : ι → ℝ) (i : ι) : eigenvalue i * (eigenvalue i * cancelPoint eigenvalue c i + c i) ^ 2 = 0 := by by_cases hi : eigenvalue i = 0 · simp [hi] · simp [velocity_cancel eigenvalue c i hi] theorem trace_zero_of_diagonal_equation {ι : Type*} [Fintype ι] (eigenvalue c : ι → ℝ) (s : ℝ) (hM : ∀ x : ι → ℝ, (1 + ∑ i, (eigenvalue i * x i + c i) ^ 2) * s - ∑ i, eigenvalue i * (eigenvalue i * x i + c i) ^ 2 = 0) : s = 0 := by have hbase := hM (cancelPoint eigenvalue c) have hweighted : (∑ i, eigenvalue i * (eigenvalue i * cancelPoint eigenvalue c i + c i) ^ 2) = 0 := Finset.sum_eq_zero (fun i _ => weighted_velocity_cancel eigenvalue c i) rw [hweighted, sub_zero] at hbase have hpos : 0 < 1 + ∑ i, (eigenvalue i * cancelPoint eigenvalue c i + c i) ^ 2 := by have hs : 0 ≤ ∑ i, (eigenvalue i * cancelPoint eigenvalue c i + c i) ^ 2 := Finset.sum_nonneg (fun i _ => sq_nonneg _) linarith exact (mul_eq_zero.mp hbase).resolve_left (ne_of_gt hpos) theorem eigenvalues_zero_of_diagonal_equation {ι : Type*} [Fintype ι] (eigenvalue c : ι → ℝ) (s : ℝ) (hM : ∀ x : ι → ℝ, (1 + ∑ i, (eigenvalue i * x i + c i) ^ 2) * s - ∑ i, eigenvalue i * (eigenvalue i * x i + c i) ^ 2 = 0) : ∀ i, eigenvalue i = 0 := by classical have hs := trace_zero_of_diagonal_equation eigenvalue c s hM intro j by_contra hj let x : ι → ℝ := Function.update (cancelPoint eigenvalue c) j ((1 - c j) / eigenvalue j) have hxj : eigenvalue j * x j + c j = 1 := by simp only [x, Function.update_self] field_simp ring have hweighted : (∑ i, eigenvalue i * (eigenvalue i * x i + c i) ^ 2) = eigenvalue j := by rw [Finset.sum_eq_single j] · simp [hxj] · intro i _ hij have hxi : x i = cancelPoint eigenvalue c i := by simp [x, hij] rw [hxi] exact weighted_velocity_cancel eigenvalue c i · simp have htest := hM x rw [hs, mul_zero, hweighted, zero_sub] at htest exact hj (neg_eq_zero.mp htest) theorem diagonal_quadratic_obstruction {ι : Type*} [Fintype ι] (eigenvalue c : ι → ℝ) (hM : ∀ x : ι → ℝ, (1 + ∑ i, (eigenvalue i * x i + c i) ^ 2) * (∑ i, eigenvalue i) - ∑ i, eigenvalue i * (eigenvalue i * x i + c i) ^ 2 = 0) : ∀ i, eigenvalue i = 0 := eigenvalues_zero_of_diagonal_equation eigenvalue c _ hM end QuarticMinimal.QuadraticScalar end ComponentQuadraticScalar /- Component: QuadraticMatrix -/ section ComponentQuadraticMatrix /- Requires MatrixAlgebra and QuadraticScalar in the single-file build. -/ noncomputable section open scoped BigOperators Matrix open Matrix namespace QuarticMinimal variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem quadratic_matrix_obstruction (H : Matrix ι ι ℝ) (hH : H.IsSymm) (c : ι → ℝ) (hM : ∀ x : ι → ℝ, (1 + dotProduct (H *ᵥ x + c) (H *ᵥ x + c)) * trace H - dotProduct (H *ᵥ x + c) (H *ᵥ (H *ᵥ x + c)) = 0) : H = 0 := by have hHerm : H.IsHermitian := isHermitian_iff_isSymm.mpr hH let U : Matrix ι ι ℝ := hHerm.eigenvectorUnitary let d : ι → ℝ := hHerm.eigenvalues have hUU : U * U.transpose = 1 := by simpa only [U, Unitary.coe_star, star_eq_conjTranspose, conjTranspose_eq_transpose_of_trivial] using Unitary.coe_mul_star_self hHerm.eigenvectorUnitary have hD : U.transpose * H * U = diagonal d := by simpa only [U, d, Unitary.conjStarAlgAut_star_apply, star_eq_conjTranspose, conjTranspose_eq_transpose_of_trivial, RCLike.ofReal_real_eq_id, Function.id_comp] using hHerm.conjStarAlgAut_star_eigenvectorUnitary let c' := U.transpose *ᵥ c have hv (x : ι → ℝ) : U.transpose *ᵥ (H *ᵥ (U *ᵥ x) + c) = diagonal d *ᵥ x + c' := by rw [mulVec_add, mulVec_mulVec, mulVec_mulVec, hD] have heq (x : ι → ℝ) : (1 + dotProduct (diagonal d *ᵥ x + c') (diagonal d *ᵥ x + c')) * trace (diagonal d) - dotProduct (diagonal d *ᵥ x + c') (diagonal d *ᵥ (diagonal d *ᵥ x + c')) = 0 := by have hi := MatrixAlgebra.minimal_expression_invariant U hUU H (H *ᵥ (U *ᵥ x) + c) rw [hv x, hD, hM (U *ᵥ x)] at hi exact hi have hd : ∀ i, d i = 0 := by apply QuadraticScalar.diagonal_quadratic_obstruction d c' intro x convert heq x using 1 simp only [dotProduct, mulVec_diagonal, Pi.add_apply, trace_diagonal, pow_two] congr 1 apply Finset.sum_congr rfl intro i hi ring exact hHerm.eigenvalues_eq_zero_iff.mp (funext hd) end QuarticMinimal end end ComponentQuadraticMatrix /- Component: QuadraticObstruction -/ section ComponentQuadraticObstruction /- Requires ChangeVariables, LowDegree, QuadraticMatrix. -/ noncomputable section open scoped BigOperators Matrix open MvPolynomial namespace QuarticMinimal variable {ι : Type*} [Fintype ι] theorem affine_of_quadratic_minimal (P : MvPolynomial ι ℝ) (hdegree : P.totalDegree ≤ 2) (hminimal : minimalOperator P = 0) : P.totalDegree ≤ 1 := by classical let H := hessianCoeff P let c : ι → ℝ := fun i => (pderiv i P).coeff 0 have hH : H = 0 := by apply quadratic_matrix_obstruction H (hessianCoeff_symmetric P) c intro x have hm := congrArg (eval x) hminimal have hg (i : ι) : eval x (pderiv i P) = (H *ᵥ x + c) i := eval_quadratic_gradient P hdegree x i have hh (i j : ι) : eval x (pderiv i (pderiv j P)) = H i j := by rw [second_partial_eq_C_of_totalDegree_le_two P hdegree i j, eval_C] simp only [minimalOperator, map_sub, map_mul, map_add, map_one, map_sum, map_pow, map_zero, hg, hh] at hm have hc : dotProduct (H *ᵥ x + c) (H *ᵥ (H *ᵥ x + c)) = ∑ i, ∑ j, (H *ᵥ x + c) i * (H *ᵥ x + c) j * H i j := by simp only [dotProduct, Matrix.mulVec, Finset.mul_sum] apply Finset.sum_congr rfl intro i hi apply Finset.sum_congr rfl intro j hj ring rw [hc] simpa only [dotProduct, Matrix.trace, Matrix.diag, pow_two] using hm apply QuarticPolynomialBasics.totalDegree_le_one_of_second_partials_zero intro i j rw [second_partial_eq_C_of_totalDegree_le_two P hdegree i j] change C (H i j) = 0 simp [hH] end QuarticMinimal end end ComponentQuadraticObstruction /- Component: HomogeneousCubicCoefficients -/ section ComponentHomogeneousCubicCoefficients open scoped BigOperators open Polynomial namespace HomogeneousCubicCoefficients variable {R : Type*} [CommRing R] noncomputable def longitudinal (a A : R) : R[X] := C (3*a)*X^2+C A noncomputable def longitudinalSecond (a : R) : R[X] := C (6*a)*X noncomputable def transverse (α β : R) : R[X] := C α*X+C β noncomputable def baseTerm (a A h k : R) : R[X] := longitudinal a A^2*transverse h k noncomputable def singleTerm (a A h k α β : R) : R[X] := transverse α β^2*(longitudinalSecond a+transverse h k)- 2*longitudinal a A*C α*transverse α β noncomputable def hessianTerm (α β α' β' H K : R) : R[X] := transverse α β*transverse α' β'*transverse H K theorem base_coeff5 (a A h k : R) : (baseTerm a A h k).coeff 5 = 9*a^2*h := by unfold baseTerm longitudinal transverse ring_nf simp [mul_assoc, ← map_mul, ← map_pow, Polynomial.coeff_X, Polynomial.coeff_C] ring theorem base_coeff4 (a A h k : R) : (baseTerm a A h k).coeff 4 = 9*a^2*k := by unfold baseTerm longitudinal transverse ring_nf simp [mul_assoc, ← map_mul, ← map_pow, Polynomial.coeff_X, Polynomial.coeff_C] ring theorem base_coeff3 (a A h k : R) : (baseTerm a A h k).coeff 3 = 6*a*A*h := by unfold baseTerm longitudinal transverse ring_nf simp [mul_assoc, ← map_mul, ← map_pow, Polynomial.coeff_X, Polynomial.coeff_C] ring theorem single_coeff5 (a A h k α β : R) : (singleTerm a A h k α β).coeff 5 = 0 := by unfold singleTerm longitudinal longitudinalSecond transverse ring_nf simp [mul_assoc, ← map_mul, ← map_pow, Polynomial.coeff_X, Polynomial.coeff_C] theorem single_coeff4 (a A h k α β : R) : (singleTerm a A h k α β).coeff 4 = 0 := by unfold singleTerm longitudinal longitudinalSecond transverse ring_nf simp [mul_assoc, ← map_mul, ← map_pow, Polynomial.coeff_X, Polynomial.coeff_C] theorem single_coeff3 (a A h k α β : R) : (singleTerm a A h k α β).coeff 3 = h*α^2 := by unfold singleTerm longitudinal longitudinalSecond transverse ring_nf simp [mul_assoc, ← map_mul, ← map_pow, Polynomial.coeff_X, Polynomial.coeff_C] ring theorem hessian_coeff5 (α β α' β' H K : R) : (hessianTerm α β α' β' H K).coeff 5 = 0 := by unfold hessianTerm transverse ring_nf simp [mul_assoc, ← map_mul, Polynomial.coeff_X, Polynomial.coeff_C] theorem hessian_coeff4 (α β α' β' H K : R) : (hessianTerm α β α' β' H K).coeff 4 = 0 := by unfold hessianTerm transverse ring_nf simp [mul_assoc, ← map_mul, Polynomial.coeff_X, Polynomial.coeff_C] theorem hessian_coeff3 (α β α' β' H K : R) : (hessianTerm α β α' β' H K).coeff 3 = α*α'*H := by unfold hessianTerm transverse ring_nf simp [mul_assoc, ← map_mul, Polynomial.coeff_X, Polynomial.coeff_C] variable {ι : Type*} [Fintype ι] noncomputable def operator (a A h k : R) (α β : ι → R) (H K : ι → ι → R) : R[X] := (∑ i, transverse (α i) (β i)^2)*longitudinalSecond a+ (longitudinal a A^2+∑ i, transverse (α i) (β i)^2)*transverse h k- 2*longitudinal a A*(∑ i, C (α i)*transverse (α i) (β i))- ∑ i, ∑ j, hessianTerm (α i) (β i) (α j) (β j) (H i j) (K i j) theorem operator_decomposition (a A h k : R) (α β : ι → R) (H K : ι → ι → R) : operator a A h k α β H K = baseTerm a A h k + (∑ i, singleTerm a A h k (α i) (β i))- ∑ i, ∑ j, hessianTerm (α i) (β i) (α j) (β j) (H i j) (K i j) := by unfold operator baseTerm singleTerm simp only [add_mul, mul_add, Finset.sum_add_distrib, Finset.sum_sub_distrib, Finset.mul_sum, Finset.sum_mul, mul_assoc] abel theorem operator_coeff5 (a A h k : R) (α β : ι → R) (H K : ι → ι → R) : (operator a A h k α β H K).coeff 5 = 9*a^2*h := by simp [operator_decomposition, base_coeff5, single_coeff5, hessian_coeff5] theorem operator_coeff4 (a A h k : R) (α β : ι → R) (H K : ι → ι → R) : (operator a A h k α β H K).coeff 4 = 9*a^2*k := by simp [operator_decomposition, base_coeff4, single_coeff4, hessian_coeff4] theorem operator_coeff3_of_trace_zero (a A : R) (α β : ι → R) (H K : ι → ι → R) : (operator a A 0 0 α β H K).coeff 3 = - ∑ i, ∑ j, α i*α j*H i j := by simp [operator_decomposition, base_coeff3, single_coeff3, hessian_coeff3] theorem operator_pure_coeff1 (a : R) (β : ι → R) (K : ι → ι → R) : (operator a 0 0 0 (fun _ => 0) β (fun _ _ => 0) K).coeff 1 = 6*a*∑ i, β i^2 := by simp only [operator, transverse, longitudinal, longitudinalSecond, hessianTerm, map_zero, zero_mul, zero_add, add_zero, mul_zero, sub_zero, Finset.sum_const_zero] simp only [← map_pow, ← map_sum, ← map_mul, Polynomial.coeff_sub, Polynomial.coeff_C_mul, Polynomial.coeff_X, ite_true, mul_one, Polynomial.coeff_C, Nat.one_ne_zero, ite_false, sub_zero] ring end HomogeneousCubicCoefficients end ComponentHomogeneousCubicCoefficients /- Component: CubicMatrix -/ section ComponentCubicMatrix noncomputable section open scoped BigOperators Matrix open Matrix namespace CubicMatrix variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem symmetric_eq_zero_of_quadratic_zero (A : Matrix ι ι ℝ) (hA : A.IsSymm) (h : ∀ x, x ⬝ᵥ (A *ᵥ x) = 0) : A = 0 := by ext i j have hi := h (Pi.single i 1) have hj := h (Pi.single j 1) have hij := h (Pi.single i 1 + Pi.single j 1) simp only [Matrix.mulVec_single_one, single_one_dotProduct] at hi hj simp only [Matrix.mulVec_add, dotProduct_add, add_dotProduct, Matrix.mulVec_single_one, single_one_dotProduct] at hij change A i i = 0 at hi change A j j = 0 at hj change A i i + A j i + (A i j + A j j) = 0 at hij rw [hA.apply i j] at hij change A i j = 0 linarith omit [DecidableEq ι] in theorem dot_move (S : Matrix ι ι ℝ) (hS : S.IsSymm) (x y : ι → ℝ) : (S *ᵥ x) ⬝ᵥ y = x ⬝ᵥ (S *ᵥ y) := by rw [dotProduct_mulVec, ← mulVec_transpose, hS] theorem symmetric_cube_zero (S : Matrix ι ι ℝ) (hS : S.IsSymm) (hcube : S ^ 3 = 0) : S = 0 := by have hv (x : ι → ℝ) : S *ᵥ x = 0 := by have hc : S *ᵥ (S *ᵥ (S *ᵥ x)) = 0 := by rw [mulVec_mulVec, mulVec_mulVec] rw [← pow_two, ← pow_succ, hcube, zero_mulVec] have hsq : S *ᵥ (S *ᵥ x) = 0 := by apply dotProduct_self_eq_zero.mp rw [dot_move S hS (S *ᵥ x) (S *ᵥ (S *ᵥ x)), hc, dotProduct_zero] apply dotProduct_self_eq_zero.mp rw [dot_move S hS x (S *ᵥ x), hsq, dotProduct_zero] ext i j have hij := congrArg (fun x : ι → ℝ => x i) (hv (Pi.single j 1)) simpa only [mulVec_single_one, Matrix.col, Matrix.transpose_apply, Pi.zero_apply, Matrix.zero_apply] using hij theorem symmetric_eq_zero_of_cube_quadratic_zero (S : Matrix ι ι ℝ) (hS : S.IsSymm) (h : ∀ x, x ⬝ᵥ (S ^ 3 *ᵥ x) = 0) : S = 0 := symmetric_cube_zero S hS (symmetric_eq_zero_of_quadratic_zero _ (hS.pow 3) h) end CubicMatrix end end ComponentCubicMatrix /- Component: CubicNormalForm -/ section ComponentCubicNormalForm /- Requires DistinguishedVariable, HomogeneousCubicCoefficients, QuarticNormalForm, PolynomialBasics, LowDegree, and CubicMatrix. -/ noncomputable section open scoped BigOperators Matrix open MvPolynomial Matrix namespace QuarticMinimal.CubicNormalForm open DistinguishedVariable open QuarticNormalForm (laplacian leadingExpression splitLeadingExpression) variable {n : ℕ} def normalForm (a : ℝ) (A B : MvPolynomial (Fin n) ℝ) : Polynomial (MvPolynomial (Fin n) ℝ) := Polynomial.C (C a) * Polynomial.X ^ 3 + Polynomial.C A * Polynomial.X + Polynomial.C B theorem finSuccEquiv_normalForm (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (hP : P.totalDegree ≤ 3) (h3 : (finSuccEquiv ℝ n P).coeff 3 = C a) (h2 : (finSuccEquiv ℝ n P).coeff 2 = 0) : finSuccEquiv ℝ n P = normalForm a ((finSuccEquiv ℝ n P).coeff 1) ((finSuccEquiv ℝ n P).coeff 0) := by conv_lhs => rw [finSuccEquiv_eq_sum P hP] simp only [Finset.sum_range_succ, Finset.sum_range_zero, pow_zero, pow_one, mul_one, zero_add, h3, h2, map_zero, zero_mul, add_zero, normalForm] ring theorem derivative_normalForm (a : ℝ) (A B : MvPolynomial (Fin n) ℝ) : Polynomial.derivative (normalForm a A B) = HomogeneousCubicCoefficients.longitudinal (C a) A := by simp [normalForm, HomogeneousCubicCoefficients.longitudinal, Polynomial.C_ofNat] ring theorem second_derivative_normalForm (a : ℝ) (A B : MvPolynomial (Fin n) ℝ) : Polynomial.derivative (Polynomial.derivative (normalForm a A B)) = HomogeneousCubicCoefficients.longitudinalSecond (C a) := by rw [derivative_normalForm] simp [HomogeneousCubicCoefficients.longitudinal, HomogeneousCubicCoefficients.longitudinalSecond, Polynomial.C_ofNat] ring theorem coefficientPartial_normalForm (a : ℝ) (A B : MvPolynomial (Fin n) ℝ) (i : Fin n) : coefficientPartial i (normalForm a A B) = HomogeneousCubicCoefficients.transverse (pderiv i A) (pderiv i B) := by simp [normalForm, HomogeneousCubicCoefficients.transverse, coefficientPartial_add, coefficientPartial_mul, coefficientPartial_C, coefficientPartial_X, coefficientPartial_pow] theorem derivative_transverse (α β : MvPolynomial (Fin n) ℝ) : Polynomial.derivative (HomogeneousCubicCoefficients.transverse α β) = Polynomial.C α := by simp [HomogeneousCubicCoefficients.transverse] theorem coefficientPartial_transverse (α β : MvPolynomial (Fin n) ℝ) (i : Fin n) : coefficientPartial i (HomogeneousCubicCoefficients.transverse α β) = HomogeneousCubicCoefficients.transverse (pderiv i α) (pderiv i β) := by simp [HomogeneousCubicCoefficients.transverse, coefficientPartial_add, coefficientPartial_mul, coefficientPartial_C, coefficientPartial_X] theorem sum_transverse (α β : Fin n → MvPolynomial (Fin n) ℝ) : (∑ i, HomogeneousCubicCoefficients.transverse (α i) (β i)) = HomogeneousCubicCoefficients.transverse (∑ i, α i) (∑ i, β i) := by simp only [HomogeneousCubicCoefficients.transverse, Finset.sum_add_distrib, ← Finset.sum_mul, ← map_sum] theorem splitLeadingExpression_normalForm (a : ℝ) (A B : MvPolynomial (Fin n) ℝ) : splitLeadingExpression (normalForm a A B) = HomogeneousCubicCoefficients.operator (C a) A (laplacian A) (laplacian B) (fun i => pderiv i A) (fun i => pderiv i B) (fun i j => pderiv i (pderiv j A)) (fun i j => pderiv i (pderiv j B)) := by simp only [splitLeadingExpression, coefficientPartial_normalForm, derivative_normalForm, derivative_transverse, coefficientPartial_transverse, sum_transverse] rw [show Polynomial.derivative (HomogeneousCubicCoefficients.longitudinal (C a) A) = HomogeneousCubicCoefficients.longitudinalSecond (C a) from by simpa only [derivative_normalForm] using second_derivative_normalForm a A B] rfl theorem leading_operator_zero_of_normalForm (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (A B : MvPolynomial (Fin n) ℝ) (hQ : finSuccEquiv ℝ n P = normalForm a A B) (hP : leadingExpression P = 0) : HomogeneousCubicCoefficients.operator (C a) A (laplacian A) (laplacian B) (fun i => pderiv i A) (fun i => pderiv i B) (fun i j => pderiv i (pderiv j A)) (fun i j => pderiv i (pderiv j B)) = 0 := by have h := QuarticNormalForm.finSuccEquiv_leadingExpression P rw [hP, map_zero, hQ, splitLeadingExpression_normalForm] at h exact h.symm theorem actual_constraints_of_normalForm (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (A B : MvPolynomial (Fin n) ℝ) (ha : a ≠ 0) (hQ : finSuccEquiv ℝ n P = normalForm a A B) (hP : leadingExpression P = 0) : laplacian A = 0 ∧ laplacian B = 0 ∧ (∑ i, ∑ j, pderiv i A * pderiv j A * pderiv i (pderiv j A)) = 0 := by have hop := leading_operator_zero_of_normalForm P a A B hQ hP have h5 := congrArg (fun Q => Polynomial.coeff Q 5) hop have h4 := congrArg (fun Q => Polynomial.coeff Q 4) hop rw [HomogeneousCubicCoefficients.operator_coeff5, Polynomial.coeff_zero] at h5 rw [HomogeneousCubicCoefficients.operator_coeff4, Polynomial.coeff_zero] at h4 have hfac : (9 : MvPolynomial (Fin n) ℝ) * C a ^ 2 ≠ 0 := mul_ne_zero (by norm_num) (pow_ne_zero _ (C_ne_zero.mpr ha)) have hA := (mul_eq_zero.mp h5).resolve_left hfac have hB := (mul_eq_zero.mp h4).resolve_left hfac refine ⟨hA, hB, ?_⟩ rw [hA, hB] at hop have h3 := congrArg (fun Q => Polynomial.coeff Q 3) hop rw [HomogeneousCubicCoefficients.operator_coeff3_of_trace_zero, Polynomial.coeff_zero] at h3 exact neg_eq_zero.mp h3 theorem quadratic_coefficient_zero (A : MvPolynomial (Fin n) ℝ) (hA : A.IsHomogeneous 2) (hc : (∑ i, ∑ j, pderiv i A * pderiv j A * pderiv i (pderiv j A)) = 0) : A = 0 := by have hm : ∀ y : Fin n → ℝ, y ⬝ᵥ (QuarticNormalForm.quadraticMatrix A ^ 3 *ᵥ y) = 0 := by intro y have he := congrArg (eval y) hc simp only [map_sum, map_mul, map_zero] at he simp_rw [QuarticNormalForm.eval_homogeneous_quadratic_gradient A hA y, QuarticNormalForm.eval_homogeneous_quadratic_hessian A hA y] at he rw [HomogeneousQuarticCoefficients.gradient_hessian_relation (QuarticNormalForm.quadraticMatrix A) (QuarticNormalForm.quadraticMatrix_symmetric A) y] at he linarith have hS := CubicMatrix.symmetric_eq_zero_of_cube_quadratic_zero (QuarticNormalForm.quadraticMatrix A) (QuarticNormalForm.quadraticMatrix_symmetric A) hm apply QuarticCompatibility.polynomial_funext intro y rw [QuarticNormalForm.eval_homogeneous_quadratic A hA, hS, zero_mulVec, dotProduct_zero, map_zero] theorem homogeneous_coefficients_zero (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (A B : MvPolynomial (Fin n) ℝ) (ha : a ≠ 0) (hA : A.IsHomogeneous 2) (hB : B.IsHomogeneous 3) (hQ : finSuccEquiv ℝ n P = normalForm a A B) (hP : leadingExpression P = 0) : A = 0 ∧ B = 0 := by obtain ⟨_, hBlap, hAcubic⟩ := actual_constraints_of_normalForm P a A B ha hQ hP have hAz : A = 0 := quadratic_coefficient_zero A hA hAcubic refine ⟨hAz, ?_⟩ have hop := leading_operator_zero_of_normalForm P a A B hQ hP rw [hAz, hBlap] at hop simp only [laplacian, map_zero, Finset.sum_const_zero] at hop have h1 := congrArg (fun Q => Polynomial.coeff Q 1) hop rw [HomogeneousCubicCoefficients.operator_pure_coeff1, Polynomial.coeff_zero] at h1 have hfac : (6 : MvPolynomial (Fin n) ℝ) * C a ≠ 0 := mul_ne_zero (by norm_num) (C_ne_zero.mpr ha) have hsq := (mul_eq_zero.mp h1).resolve_left hfac have hder : ∀ i, pderiv i B = 0 := fun i => QuarticPolynomialBasics.eq_zero_of_sum_sq_eq_zero Finset.univ (fun i => pderiv i B) hsq i (Finset.mem_univ i) rw [QuarticMinimal.eq_C_of_pderiv_eq_zero B hder, hB.coeff_eq_zero (by simp), map_zero] theorem homogeneous_cubic_pure (P : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (ha : a ≠ 0) (hP : P.IsHomogeneous 3) (h3 : (finSuccEquiv ℝ n P).coeff 3 = C a) (h2 : (finSuccEquiv ℝ n P).coeff 2 = 0) (hL : leadingExpression P = 0) : finSuccEquiv ℝ n P = Polynomial.C (C a) * Polynomial.X ^ 3 := by have hQ := finSuccEquiv_normalForm P a hP.totalDegree_le h3 h2 have hA : ((finSuccEquiv ℝ n P).coeff 1).IsHomogeneous 2 := hP.finSuccEquiv_coeff_isHomogeneous 1 2 rfl have hB : ((finSuccEquiv ℝ n P).coeff 0).IsHomogeneous 3 := hP.finSuccEquiv_coeff_isHomogeneous 0 3 rfl obtain ⟨hAz, hBz⟩ := homogeneous_coefficients_zero P a _ _ ha hA hB hQ hL simpa only [normalForm, hAz, hBz, map_zero, zero_mul, add_zero] using hQ end QuarticMinimal.CubicNormalForm end end ComponentCubicNormalForm /- Component: FullCubicCoefficients -/ section ComponentFullCubicCoefficients open scoped BigOperators open Polynomial namespace FullCubicCoefficients variable {R : Type*} [CommRing R] noncomputable def longitudinal (a b A : R) : R[X] := C (3*a)*X^2+C (2*b)*X+C A noncomputable def longitudinalSecond (a b : R) : R[X] := C (6*a)*X+C (2*b) noncomputable def transverse (α β : R) : R[X] := C α*X+C β noncomputable def baseTerm (a b A d : R) : R[X] := longitudinalSecond a b+(1+longitudinal a b A^2)*C d noncomputable def singleTerm (a b A d α β : R) : R[X] := transverse α β^2*(longitudinalSecond a b+C d)- 2*longitudinal a b A*C α*transverse α β noncomputable def hessianTerm (α β α' β' K : R) : R[X] := transverse α β*transverse α' β'*C K theorem base_coeff4 (a b A d : R) : (baseTerm a b A d).coeff 4 = 9*a^2*d := by unfold baseTerm longitudinal longitudinalSecond ring_nf simp [mul_assoc, ← map_mul, ← map_pow, Polynomial.coeff_X, Polynomial.coeff_C] ring theorem base_coeff1 (a b A d : R) : (baseTerm a b A d).coeff 1 = 6*a+4*b*A*d := by unfold baseTerm longitudinal longitudinalSecond ring_nf simp [mul_assoc, ← map_mul, ← map_pow, Polynomial.coeff_X, Polynomial.coeff_C] ring theorem single_coeff4 (a b A d α β : R) : (singleTerm a b A d α β).coeff 4 = 0 := by unfold singleTerm longitudinal longitudinalSecond transverse ring_nf simp [mul_assoc, ← map_mul, ← map_pow, Polynomial.coeff_X, Polynomial.coeff_C] theorem single_coeff1 (a b A d α β : R) : (singleTerm a b A d α β).coeff 1 = 6*a*β^2-2*A*α^2+2*d*α*β := by unfold singleTerm longitudinal longitudinalSecond transverse ring_nf simp [mul_assoc, ← map_mul, ← map_pow, Polynomial.coeff_X, Polynomial.coeff_C] ring theorem hessian_coeff4 (α β α' β' K : R) : (hessianTerm α β α' β' K).coeff 4 = 0 := by unfold hessianTerm transverse ring_nf simp [mul_assoc, ← map_mul, Polynomial.coeff_X, Polynomial.coeff_C] theorem hessian_coeff1 (α β α' β' K : R) : (hessianTerm α β α' β' K).coeff 1 = (α*β'+β*α')*K := by unfold hessianTerm transverse ring_nf simp [mul_assoc, ← map_mul, Polynomial.coeff_X, Polynomial.coeff_C] variable {ι : Type*} [Fintype ι] noncomputable def operator (a b A d : R) (α β : ι → R) (K : ι → ι → R) : R[X] := (1+∑ i, transverse (α i) (β i)^2)*longitudinalSecond a b+ (1+longitudinal a b A^2+∑ i, transverse (α i) (β i)^2)*C d- 2*longitudinal a b A*(∑ i, C (α i)*transverse (α i) (β i))- ∑ i, ∑ j, hessianTerm (α i) (β i) (α j) (β j) (K i j) theorem operator_decomposition (a b A d : R) (α β : ι → R) (K : ι → ι → R) : operator a b A d α β K = baseTerm a b A d + (∑ i, singleTerm a b A d (α i) (β i))- ∑ i, ∑ j, hessianTerm (α i) (β i) (α j) (β j) (K i j) := by unfold operator baseTerm singleTerm simp only [add_mul, mul_add, Finset.sum_add_distrib, Finset.sum_sub_distrib, Finset.mul_sum, Finset.sum_mul, mul_assoc, one_mul] abel theorem operator_coeff4 (a b A d : R) (α β : ι → R) (K : ι → ι → R) : (operator a b A d α β K).coeff 4 = 9*a^2*d := by simp [operator_decomposition, base_coeff4, single_coeff4, hessian_coeff4] theorem operator_coeff1_of_trace_zero (a b A : R) (α β : ι → R) (K : ι → ι → R) (hK : ∀ i j, K i j = K j i) : (operator a b A 0 α β K).coeff 1 = 6*a*(1+∑ i, β i^2)-2*A*(∑ i, α i^2)-2*(∑ i, ∑ j, α i*β j*K i j) := by simp only [operator_decomposition, coeff_add, coeff_sub, finsetSum_coeff, base_coeff1, single_coeff1, hessian_coeff1, mul_zero, zero_mul, add_zero] simp only [add_mul, Finset.sum_add_distrib, Finset.sum_sub_distrib, ← Finset.mul_sum] have hh : (∑ i, ∑ j, β i*α j*K i j) = ∑ i, ∑ j, α i*β j*K i j := by rw [Finset.sum_comm] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ rw [hK j i] ring rw [hh] ring end FullCubicCoefficients end ComponentFullCubicCoefficients /- Component: CubicScalar -/ section ComponentCubicScalar noncomputable section open scoped BigOperators Matrix open Matrix namespace CubicScalar variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- The linear coefficient in the distinguished variable is already incompatible with a nonzero cubic leading coefficient. -/ theorem obstruction (a c : ℝ) (ha : a ≠ 0) (α δ : ι → ℝ) (K : Matrix ι ι ℝ) (h : ∀ y : ι → ℝ, 6*a*(1+(K *ᵥ y+δ) ⬝ᵥ (K *ᵥ y+δ)) - 2*(c+α ⬝ᵥ y)*(α ⬝ᵥ α)-2*(α ⬝ᵥ (K *ᵥ (K *ᵥ y+δ))) = 0) : False := by have hK : K = 0 := by have hv (y : ι → ℝ) : K *ᵥ y = 0 := by have hp := h y have hn := h (-y) have hz := h 0 simp only [mulVec_neg, mulVec_zero, zero_add, dotProduct_zero, add_zero, mulVec_add, dotProduct_add, add_dotProduct, dotProduct_neg, neg_dotProduct] at hp hn hz have he : (12*a)*((K *ᵥ y) ⬝ᵥ (K *ᵥ y)) = 0 := by linear_combination hp + hn - 2*hz apply dotProduct_self_eq_zero.mp exact (mul_eq_zero.mp he).resolve_left (mul_ne_zero (by norm_num) ha) ext i j have hh := congrArg (fun y : ι → ℝ => y i) (hv (Pi.single j 1)) simpa only [mulVec_single_one, Matrix.col, Matrix.transpose_apply, Pi.zero_apply, Matrix.zero_apply] using hh have hz := h 0 have hα := h α simp only [hK, zero_mulVec, zero_add, dotProduct_zero, mul_zero, sub_zero, add_zero] at hz hα have hnorm : α ⬝ᵥ α = 0 := by nlinarith rw [hnorm, mul_zero, sub_zero] at hz have hn : 0 ≤ δ ⬝ᵥ δ := Finset.sum_nonneg (fun i _ => mul_self_nonneg (δ i)) have hpos : 1+δ ⬝ᵥ δ ≠ 0 := by linarith exact (mul_ne_zero (mul_ne_zero (by norm_num) ha) hpos) hz end CubicScalar end end ComponentCubicScalar /- Component: FullCubicNormalForm -/ section ComponentFullCubicNormalForm /- Requires PolynomialBasics, LowDegree, DistinguishedVariable, FullCubicCoefficients, CubicScalar. -/ noncomputable section open scoped BigOperators Matrix open MvPolynomial Matrix namespace QuarticMinimal.FullCubicNormalForm open DistinguishedVariable variable {n : ℕ} def normalForm (a b : ℝ) (A B : MvPolynomial (Fin n) ℝ) : Polynomial (MvPolynomial (Fin n) ℝ) := Polynomial.C (C a) * Polynomial.X ^ 3 + Polynomial.C (C b) * Polynomial.X ^ 2 + Polynomial.C A * Polynomial.X + Polynomial.C B theorem derivative_normalForm (a b : ℝ) (A B : MvPolynomial (Fin n) ℝ) : Polynomial.derivative (normalForm a b A B) = FullCubicCoefficients.longitudinal (C a) (C b) A := by simp [normalForm, FullCubicCoefficients.longitudinal, Polynomial.C_ofNat] ring theorem second_derivative_normalForm (a b : ℝ) (A B : MvPolynomial (Fin n) ℝ) : Polynomial.derivative (Polynomial.derivative (normalForm a b A B)) = FullCubicCoefficients.longitudinalSecond (C a) (C b) := by rw [derivative_normalForm] simp [FullCubicCoefficients.longitudinal, FullCubicCoefficients.longitudinalSecond, Polynomial.C_ofNat] ring theorem coefficientPartial_normalForm (a b : ℝ) (A B : MvPolynomial (Fin n) ℝ) (i : Fin n) : coefficientPartial i (normalForm a b A B) = FullCubicCoefficients.transverse (pderiv i A) (pderiv i B) := by simp [normalForm, FullCubicCoefficients.transverse, coefficientPartial_add, coefficientPartial_mul, coefficientPartial_C, coefficientPartial_X, coefficientPartial_pow] theorem derivative_transverse (α β : MvPolynomial (Fin n) ℝ) : Polynomial.derivative (FullCubicCoefficients.transverse α β) = Polynomial.C α := by simp [FullCubicCoefficients.transverse] theorem second_coefficientPartial_normalForm (a b : ℝ) (A B : MvPolynomial (Fin n) ℝ) (hA : A.totalDegree ≤ 1) (hB : B.totalDegree ≤ 2) (i j : Fin n) : coefficientPartial i (coefficientPartial j (normalForm a b A B)) = Polynomial.C (C (hessianCoeff B i j)) := by rw [coefficientPartial_normalForm] simp [FullCubicCoefficients.transverse, coefficientPartial_add, coefficientPartial_mul, coefficientPartial_C, coefficientPartial_X, QuarticPolynomialBasics.second_partials_zero_of_totalDegree_le_one A hA i j, second_partial_eq_C_of_totalDegree_le_two B hB i j] theorem splitMinimalExpression_normalForm (a b : ℝ) (A B : MvPolynomial (Fin n) ℝ) (hA : A.totalDegree ≤ 1) (hB : B.totalDegree ≤ 2) : splitMinimalExpression (normalForm a b A B) = FullCubicCoefficients.operator (C a) (C b) A (C (trace (hessianCoeff B))) (fun i => pderiv i A) (fun i => pderiv i B) (fun i j => C (hessianCoeff B i j)) := by unfold splitMinimalExpression rw [second_derivative_normalForm] simp only [coefficientPartial_normalForm, derivative_normalForm, derivative_transverse] have hh (i j : Fin n) : coefficientPartial i (FullCubicCoefficients.transverse (pderiv j A) (pderiv j B)) = Polynomial.C (C (hessianCoeff B i j)) := by simpa only [coefficientPartial_normalForm] using second_coefficientPartial_normalForm a b A B hA hB i j simp only [hh] have hsum : (∑ i, Polynomial.C (C (hessianCoeff B i i))) = Polynomial.C (C (trace (hessianCoeff B)) : MvPolynomial (Fin n) ℝ) := by simp only [trace, diag, map_sum] rw [hsum] rfl theorem matrix_identity_of_minimal_normalForm (P : MvPolynomial (Fin (n + 1)) ℝ) (a b : ℝ) (A B : MvPolynomial (Fin n) ℝ) (ha : a ≠ 0) (hA : A.totalDegree ≤ 1) (hB : B.totalDegree ≤ 2) (hQ : finSuccEquiv ℝ n P = normalForm a b A B) (hP : (1 + ∑ i, pderiv i P ^ 2) * (∑ i, pderiv i (pderiv i P)) - ∑ i, ∑ j, pderiv i P * pderiv j P * pderiv i (pderiv j P) = 0) : ∀ y : Fin n → ℝ, 6*a*(1+(hessianCoeff B *ᵥ y+(fun i => (pderiv i B).coeff 0)) ⬝ᵥ (hessianCoeff B *ᵥ y+(fun i => (pderiv i B).coeff 0))) - 2*(A.coeff 0+(fun i => (pderiv i A).coeff 0) ⬝ᵥ y)* ((fun i => (pderiv i A).coeff 0) ⬝ᵥ (fun i => (pderiv i A).coeff 0)) - 2*((fun i => (pderiv i A).coeff 0) ⬝ᵥ (hessianCoeff B *ᵥ (hessianCoeff B *ᵥ y+(fun i => (pderiv i B).coeff 0)))) = 0 := by have hop := finSuccEquiv_minimalExpression P rw [hP, map_zero, hQ, splitMinimalExpression_normalForm a b A B hA hB] at hop have h4 := congrArg (fun Q => Polynomial.coeff Q 4) hop.symm rw [FullCubicCoefficients.operator_coeff4, Polynomial.coeff_zero] at h4 have hfac : (9 : MvPolynomial (Fin n) ℝ) * C a ^ 2 ≠ 0 := mul_ne_zero (by norm_num) (pow_ne_zero _ (C_ne_zero.mpr ha)) have htrace : C (trace (hessianCoeff B)) = (0 : MvPolynomial (Fin n) ℝ) := (mul_eq_zero.mp h4).resolve_left hfac rw [htrace] at hop have h1 := congrArg (fun Q => Polynomial.coeff Q 1) hop.symm rw [FullCubicCoefficients.operator_coeff1_of_trace_zero _ _ _ _ _ _ (fun i j => congrArg C ((hessianCoeff_symmetric B).apply i j).symm), Polynomial.coeff_zero] at h1 intro y have he := congrArg (eval y) h1 simp only [map_sub, map_mul, map_add, map_pow, map_sum, map_ofNat, eval_C, map_one, map_zero] at he have hEA (i : Fin n) : eval y (pderiv i A) = (pderiv i A).coeff 0 := by simpa only [eval_C] using congrArg (eval y) (pderiv_eq_C_of_totalDegree_le_one A hA i) simp_rw [hEA, eval_quadratic_gradient B hB] at he rw [eval_affine_expansion A hA] at he convert he using 1 simp only [dotProduct, Matrix.mulVec, Pi.add_apply, ← pow_two, Finset.mul_sum, mul_assoc, mul_comm, mul_left_comm] theorem normalForm_not_minimal (P : MvPolynomial (Fin (n + 1)) ℝ) (a b : ℝ) (A B : MvPolynomial (Fin n) ℝ) (ha : a ≠ 0) (hA : A.totalDegree ≤ 1) (hB : B.totalDegree ≤ 2) (hQ : finSuccEquiv ℝ n P = normalForm a b A B) (hP : (1 + ∑ i, pderiv i P ^ 2) * (∑ i, pderiv i (pderiv i P)) - ∑ i, ∑ j, pderiv i P * pderiv j P * pderiv i (pderiv j P) = 0) : False := CubicScalar.obstruction a (A.coeff 0) ha (fun i => (pderiv i A).coeff 0) (fun i => (pderiv i B).coeff 0) (hessianCoeff B) (matrix_identity_of_minimal_normalForm P a b A B ha hA hB hQ hP) end QuarticMinimal.FullCubicNormalForm end end ComponentFullCubicNormalForm /- Component: CubicObstruction -/ section ComponentCubicObstruction /- Requires the cubic normal form components, CoefficientNormalization, OperatorInvariance, and LinearSubstitution. -/ noncomputable section open scoped BigOperators Matrix open MvPolynomial Matrix namespace QuarticMinimal open DistinguishedVariable variable {n : ℕ} theorem exists_full_cubic_normal_form (P p : MvPolynomial (Fin (n + 1)) ℝ) (a : ℝ) (hp : finSuccEquiv ℝ n p = Polynomial.C (C a) * Polynomial.X ^ 3) (hr : (P - p).totalDegree ≤ 2) : ∃ (b : ℝ) (A B : MvPolynomial (Fin n) ℝ), A.totalDegree ≤ 1 ∧ B.totalDegree ≤ 2 ∧ finSuccEquiv ℝ n P = FullCubicNormalForm.normalForm a b A B := by let Q := finSuccEquiv ℝ n (P - p) have h2 : (Q.coeff 2).totalDegree = 0 := by apply Nat.eq_zero_of_le_zero simpa only [Nat.sub_self] using coeff_finSuccEquiv_totalDegree_le (P - p) hr 2 have hc2 : Q.coeff 2 = C ((Q.coeff 2).coeff 0) := totalDegree_eq_zero_iff_eq_C.mp h2 refine ⟨(Q.coeff 2).coeff 0, Q.coeff 1, Q.coeff 0, ?_, ?_, ?_⟩ · exact coeff_finSuccEquiv_totalDegree_le (P - p) hr 1 · exact coeff_finSuccEquiv_totalDegree_le (P - p) hr 0 · have hsum := finSuccEquiv_eq_sum (P - p) hr change Q = _ at hsum simp only [Finset.sum_range_succ, Finset.sum_range_zero, pow_zero, pow_one, mul_one, zero_add] at hsum have hsplit : finSuccEquiv ℝ n P = finSuccEquiv ℝ n p + Q := by change finSuccEquiv ℝ n P = finSuccEquiv ℝ n p + finSuccEquiv ℝ n (P - p) simp only [map_sub] ring rw [hsplit, hp] conv_lhs => rw [hsum, hc2] unfold FullCubicNormalForm.normalForm dsimp only [Q] ring theorem exists_orthogonal_pure_cubic (p : MvPolynomial (Fin (n + 1)) ℝ) (hp : p.IsHomogeneous 3) (hne : p ≠ 0) (hL : leadingOperator p = 0) : ∃ (U : Matrix (Fin (n + 1)) (Fin (n + 1)) ℝ) (a : ℝ), U.transpose * U = 1 ∧ U * U.transpose = 1 ∧ 0 < a ∧ finSuccEquiv ℝ n (changeVariables U p) = Polynomial.C (C a) * Polynomial.X ^ 3 := by obtain ⟨x, hx⟩ := QuarticNormalization.exists_positive_value_of_odd p 3 hp (by decide) hne obtain ⟨U, a, hU, hU', ha, h3, h2⟩ := QuarticNormalization.exists_positive_normal_form p 2 hp x hx refine ⟨U, a, hU, hU', ha, ?_⟩ apply CubicNormalForm.homogeneous_cubic_pure _ a (ne_of_gt ha) (isHomogeneous_changeVariables U p 3 hp) h3 h2 exact leadingOperator_changeVariables_eq_zero U hU' p hL theorem no_degree_three_minimal_polynomial (P : MvPolynomial (Fin (n + 1)) ℝ) (hdeg : P.totalDegree = 3) (hM : minimalOperator P = 0) : False := by let p := homogeneousComponent 3 P have hp : p.IsHomogeneous 3 := homogeneousComponent_isHomogeneous 3 P have hne : p ≠ 0 := by have ht := QuarticPolynomialBasics.top_homogeneousComponent_ne_zero P (by omega) simpa only [hdeg] using ht have hL : leadingOperator p = 0 := by exact QuarticPolynomialBasics.cubicOperator_top_eq_zero P 3 (by omega) (by omega) hM obtain ⟨U, a, hU, hU', ha, hpure⟩ := exists_orthogonal_pure_cubic p hp hne hL have hr : (changeVariables U P - changeVariables U p).totalDegree ≤ 2 := by rw [← map_sub] apply (totalDegree_changeVariables_le U (P - p)).trans exact QuarticPolynomialBasics.totalDegree_sub_homogeneousComponent_le P 3 (by omega) obtain ⟨b, A, B, hA, hB, hform⟩ := exists_full_cubic_normal_form (changeVariables U P) (changeVariables U p) a hpure hr exact FullCubicNormalForm.normalForm_not_minimal _ a b A B (ne_of_gt ha) hA hB hform (minimalOperator_changeVariables_eq_zero U hU' P hM) theorem no_degree_three_minimal_polynomial_any_dimension {m : ℕ} (P : MvPolynomial (Fin m) ℝ) (hdeg : P.totalDegree = 3) (hM : minimalOperator P = 0) : False := by cases m with | zero => have hz := QuarticPolynomialBasics.totalDegree_zero_variables P omega | succ m => exact no_degree_three_minimal_polynomial P hdeg hM end QuarticMinimal end end ComponentCubicObstruction end Source29QuarticReuse /- License for the attributed Mathlib adaptations above: Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "{}" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright {yyyy} {name of copyright owner} Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. -/ /- Component: LowDegreeEndpoints.inc -/ namespace Source29LowDegreeEndpoints open MvPolynomial Source29QuarticReuse.QuarticMinimal noncomputable section def orthogonalChangeEquiv {n : ℕ} (U : Matrix (Fin n) (Fin n) ℝ) (hU : U*U.transpose = 1) (hUt : U.transpose*U = 1) : MvPolynomial (Fin n) ℝ ≃ₐ[ℝ] MvPolynomial (Fin n) ℝ := AlgEquiv.ofBijective (changeVariables U) ⟨changeVariables_injective U hU, by intro p refine ⟨changeVariables U.transpose p, ?_⟩ rw [changeVariables_comp, hUt, changeVariables_one]⟩ /-- The homogeneous cubic classification rules out an irreducible cubic solution of the leading operator, without using the full minimal equation. -/ theorem irreducible_cubic_impossible (p : MvPolynomial (Fin 8) ℝ) (hirr : Irreducible p) (hh : p.IsHomogeneous 3) (hL : Source29FactorInheritance.cubicOperator p = 0) : False := by obtain ⟨U, a, hUt, hU, ha, hpure⟩ := exists_orthogonal_pure_cubic p hh hirr.ne_zero hL have hi : Irreducible (changeVariables U p) := (MulEquiv.irreducible_iff (orthogonalChangeEquiv U hU hUt)).mpr hirr have hi' := (MulEquiv.irreducible_iff (finSuccEquiv ℝ 7)).mpr hi rw [hpure] at hi' have hu : IsUnit (Polynomial.C (C a : MvPolynomial (Fin 7) ℝ)) := ((isUnit_iff_ne_zero.mpr ha.ne').map (C : ℝ →+* MvPolynomial (Fin 7) ℝ)).map Polynomial.C exact not_irreducible_pow (by decide : (3 : ℕ) ≠ 1) ((irreducible_isUnit_mul hu).mp hi') /-- The degree endpoints 3 and 4 are excluded by the checked source28 classifications, once irreducibility and sign change are available. -/ theorem no_irreducible_sign_changing_degree_three_or_four (p : MvPolynomial (Fin 8) ℝ) (hirr : Irreducible p) (hh : p.IsHomogeneous p.totalDegree) (hL : Source29FactorInheritance.cubicOperator p = 0) (hlower : 3 ≤ p.totalDegree) (hupper : p.totalDegree ≤ 4) (hpos : ∃ x, 0 < eval x p) (hneg : ∃ x, eval x p < 0) : False := by have hd : p.totalDegree = 3 ∨ p.totalDegree = 4 := by omega rcases hd with hd | hd · exact irreducible_cubic_impossible p hirr (hd ▸ hh) hL · have hs := homogeneous_quartic_has_one_sign p (hd ▸ hh) hL obtain ⟨x, hx⟩ := hpos obtain ⟨y, hy⟩ := hneg rcases hs with hnonneg | hnonpos · exact (not_lt_of_ge (hnonneg y)) hy · exact (not_lt_of_ge (hnonpos x)) hx end end Source29LowDegreeEndpoints /- Component: PowerOperator.inc -/ namespace Source29PowerOperator open MvPolynomial Source29FactorInheritance open scoped BigOperators noncomputable section lemma form_rank_one {R ι : Type*} [CommRing R] [Fintype ι] (a b c : R) (g : ι → R) (H : ι → ι → R) : form (fun i => a*g i) (fun i j => b*H i j+c*g i*g j) = a^2*b*form g H := by simp only [form, Finset.mul_sum] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ ring lemma scaled_second_pderiv_pow {R ι : Type*} [CommRing R] [Fintype ι] (h : MvPolynomial ι R) (k : ℕ) (i j : ι) : h^2 * pderiv i (pderiv j (h^k)) = h^k * ((k : MvPolynomial ι R)*((k : MvPolynomial ι R)-1)*pderiv i h*pderiv j h + h*(k : MvPolynomial ι R)*pderiv i (pderiv j h)) := by simpa only [mul_one, one_mul, pderiv_one, map_zero, mul_zero, add_zero, zero_mul] using scaled_second_pderiv_pow_mul h 1 k i j /-- A denominator-free exact power identity, including k=0. -/ theorem scaled_cubicOperator_pow {R ι : Type*} [CommRing R] [Fintype ι] (h : MvPolynomial ι R) (k : ℕ) : h^4 * cubicOperator (h^k) = (h^k)^3*h*(k : MvPolynomial ι R)^3*cubicOperator h := by calc _ = form (fun i => h*pderiv i (h^k)) (fun i j => h^2*pderiv i (pderiv j (h^k))) := by rw [form_scaled, ← cubicOperator_eq_form] ring _ = form (fun i => (h^k*(k : MvPolynomial ι R))*pderiv i h) (fun i j => (h^k*h*(k : MvPolynomial ι R))*pderiv i (pderiv j h) + (h^k*(k : MvPolynomial ι R)*((k : MvPolynomial ι R)-1))*pderiv i h*pderiv j h) := by simp_rw [scaled_pderiv_pow, scaled_second_pderiv_pow] congr 1 funext i j ring _ = _ := by rw [form_rank_one, ← cubicOperator_eq_form] ring theorem cubicOperator_pow_zero_imp {R ι : Type*} [CommRing R] [IsDomain R] [CharZero R] [Fintype ι] (h : MvPolynomial ι R) (hh : h ≠ 0) (k : ℕ) (hk : k ≠ 0) (hL : cubicOperator (h^k) = 0) : cubicOperator h = 0 := by have he := scaled_cubicOperator_pow h k rw [hL, mul_zero] at he have hn : (h^k)^3*h*(k : MvPolynomial ι R)^3 ≠ 0 := mul_ne_zero (mul_ne_zero (pow_ne_zero _ (pow_ne_zero _ hh)) hh) (pow_ne_zero _ (Nat.cast_ne_zero.mpr hk)) exact (mul_eq_zero.mp he.symm).resolve_left hn lemma cubicOperator_mul_C {R ι : Type*} [CommRing R] [Fintype ι] (h : MvPolynomial ι R) (a : R) : cubicOperator (h*C a) = (C a)^3*cubicOperator h := by rw [cubicOperator_eq_form, cubicOperator_eq_form] simp only [pderiv_mul, pderiv_C, mul_zero, add_zero] have he := form_scaled (C a) (C a) (fun i => pderiv i h) (fun i j => pderiv i (pderiv j h)) have hp : (C a : MvPolynomial ι R)^2 * C a = (C a)^3 := by ring rw [hp] at he simpa only [mul_comm] using he theorem cubicOperator_pow_mul_C_zero_imp {ι : Type*} [Fintype ι] (h : MvPolynomial ι ℝ) (hh : h ≠ 0) (k : ℕ) (hk : k ≠ 0) (a : ℝ) (ha : a ≠ 0) (hL : cubicOperator (h^k*C a) = 0) : cubicOperator h = 0 := by rw [cubicOperator_mul_C] at hL exact cubicOperator_pow_zero_imp h hh k hk ((mul_eq_zero.mp hL).resolve_left (pow_ne_zero _ (C_ne_zero.mpr ha))) end end Source29PowerOperator /- Component: WeakGuoReduction.inc -/ /- A sufficient version of Guo's input that does not require strict endpoint exclusion. The input remains to be proved from the full minimal equation. -/ namespace Source29WeakGuoReduction open MvPolynomial Source29Closing noncomputable section def GuoStructureAndWeakEstimate8 (P : Polynomial8) : Prop := ∃ (p Q : Polynomial8) (k : ℕ), 1 ≤ k ∧ Irreducible p ∧ p.IsHomogeneous p.totalDegree ∧ Q.IsHomogeneous Q.totalDegree ∧ homogeneousComponent P.totalDegree P = p^k*Q ∧ PositiveAwayFromZero Q ∧ (∃ x, 0 < eval x p) ∧ (∃ x, eval x p < 0) ∧ (3 : ℝ) ≤ (p.totalDegree : ℝ) + (Q.totalDegree : ℝ)/(k : ℝ) ∧ (p.totalDegree : ℝ) + (Q.totalDegree : ℝ)/(k : ℝ) ≤ 4 /-- The verified cubic and quartic classifications exclude both non-strict endpoints after the positive-divisor obstruction makes Q constant. -/ theorem problem29_of_structure_and_weak_estimate (hGuo : ∀ P : Polynomial8, Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → GuoStructureAndWeakEstimate8 P) : Math30.Problem29 := by intro P hminimal change P.totalDegree ≤ 1 by_contra hnonaffine have hdegree : 2 ≤ P.totalDegree := by omega obtain ⟨p, Q, k, hk, hp, hphom, hQhom, hfactor, hQpos, hpos, hneg, hlower, hupper⟩ := hGuo P hminimal hdegree obtain ⟨hne, hhom, hL⟩ := QuarticPolynomialBasics.leading_component_data P hminimal hdegree have hQdiv : Q ∣ homogeneousComponent P.totalDegree P := ⟨p^k, hfactor.trans (mul_comm _ _)⟩ have hQdegree := Source29ComplexObstruction.positive_divisor_obstruction (homogeneousComponent P.totalDegree P) Q P.totalDegree hne hhom hL hQhom hQpos hQdiv have hQconst : Q = C (Q.coeff 0) := totalDegree_eq_zero_iff_eq_C.mp hQdegree have hQne : Q ≠ 0 := by intro hQzero apply hne rw [hfactor, hQzero, mul_zero] have ha : Q.coeff 0 ≠ 0 := by intro hz apply hQne exact hQconst.trans (by simp only [hz, map_zero]) have hpL : Source29FactorInheritance.cubicOperator p = 0 := by apply Source29PowerOperator.cubicOperator_pow_mul_C_zero_imp p hp.ne_zero k (by omega) (Q.coeff 0) ha change QuarticPolynomialBasics.cubicOperator (p^k*C (Q.coeff 0)) = 0 rw [← hQconst, ← hfactor] exact hL have hp3 : 3 ≤ p.totalDegree := by have hr : (3 : ℝ) ≤ p.totalDegree := by simpa only [hQdegree, Nat.cast_zero, zero_div, add_zero] using hlower exact_mod_cast hr have hp4 : p.totalDegree ≤ 4 := by have hr : (p.totalDegree : ℝ) ≤ 4 := by simpa only [hQdegree, Nat.cast_zero, zero_div, add_zero] using hupper exact_mod_cast hr exact Source29LowDegreeEndpoints.no_irreducible_sign_changing_degree_three_or_four p hp hphom hpL hp3 hp4 hpos hneg end end Source29WeakGuoReduction /- Component: FluxReuse.inc -/ /- Reused source28 flux proofs. The original license is included in QuarticReuse.inc. -/ namespace Source29QuarticReuse /- Component: FluxObstruction -/ section ComponentFluxObstruction open MeasureTheory Filter open scoped Topology BigOperators noncomputable section namespace FluxObstruction variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [MeasurableSpace E] [BorelSpace E] [FiniteDimensional ℝ E] {μ : Measure E} [μ.IsAddHaarMeasure] /-- Compact support of the test function supplies every integrability hypothesis in multivariate integration by parts. The second function need not have compact support. -/ theorem integral_mul_fderiv_eq_neg_of_compactSupport {φ g : E → ℝ} (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) (hg : ContDiff ℝ 1 g) (v : E) : ∫ x, φ x * fderiv ℝ g x v ∂μ = - ∫ x, fderiv ℝ φ x v * g x ∂μ := by have hdφ : Continuous (fun x ↦ fderiv ℝ φ x v) := (hφ.continuous_fderiv (by norm_num)).clm_apply continuous_const have hdg : Continuous (fun x ↦ fderiv ℝ g x v) := (hg.continuous_fderiv (by norm_num)).clm_apply continuous_const apply integral_mul_fderiv_eq_neg_fderiv_mul_of_integrable · exact (hdφ.mul hg.continuous).integrable_of_hasCompactSupport (hcφ.fderiv_apply ℝ v).mul_right · exact (hφ.continuous.mul hdg).integrable_of_hasCompactSupport hcφ.mul_right · exact (hφ.continuous.mul hg.continuous).integrable_of_hasCompactSupport hcφ.mul_right · exact fun x _ ↦ hφ.differentiable (by norm_num) x · exact fun x _ ↦ hg.differentiable (by norm_num) x variable {ι : Type*} [Fintype ι] /-- Divergence using an arbitrary finite family of fixed directions. With the coordinate basis this is the usual Euclidean divergence of `F`. -/ def divergence (v : ι → E) (F : E → ι → ℝ) (x : E) : ℝ := ∑ i, fderiv ℝ (fun y ↦ F y i) x (v i) /-- The pairing of a test function's differential with a vector field in fixed coordinates. -/ def testFlux (v : ι → E) (φ : E → ℝ) (F : E → ι → ℝ) (x : E) : ℝ := ∑ i, fderiv ℝ φ x (v i) * F x i omit [MeasurableSpace E] [BorelSpace E] [FiniteDimensional ℝ E] in theorem testFlux_continuous (v : ι → E) {φ : E → ℝ} {F : E → ι → ℝ} (hφ : ContDiff ℝ 1 φ) (hF : ∀ i, Continuous (fun x ↦ F x i)) : Continuous (testFlux v φ F) := by apply continuous_finsetSum intro i _ exact ((hφ.continuous_fderiv (by norm_num)).clm_apply continuous_const).mul (hF i) omit [MeasurableSpace E] [BorelSpace E] [FiniteDimensional ℝ E] in theorem testFlux_hasCompactSupport (v : ι → E) {φ : E → ℝ} {F : E → ι → ℝ} (hcφ : HasCompactSupport φ) : HasCompactSupport (testFlux v φ F) := by convert (HasCompactSupport.finset_sum (s := Finset.univ) (fun i _ ↦ (hcφ.fderiv_apply ℝ (v i)).mul_right (f' := fun x ↦ F x i))) using 1 ext x simp [testFlux] omit [FiniteDimensional ℝ E] in theorem testFlux_integrable (v : ι → E) {φ : E → ℝ} {F : E → ι → ℝ} (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) (hF : ∀ i, Continuous (fun x ↦ F x i)) : Integrable (testFlux v φ F) μ := (testFlux_continuous v hφ hF).integrable_of_hasCompactSupport (testFlux_hasCompactSupport v hcφ) /-- Weak divergence identity on the full space, proved with no boundary integration. -/ theorem integral_mul_divergence_eq_neg_testFlux (v : ι → E) {φ : E → ℝ} {F : E → ι → ℝ} (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) (hF : ∀ i, ContDiff ℝ 1 (fun x ↦ F x i)) : ∫ x, φ x * divergence v F x ∂μ = - ∫ x, testFlux v φ F x ∂μ := by have hi i : Integrable (fun x ↦ φ x * fderiv ℝ (fun y ↦ F y i) x (v i)) μ := (hφ.continuous.mul (((hF i).continuous_fderiv (by norm_num)).clm_apply continuous_const)).integrable_of_hasCompactSupport hcφ.mul_right have hj i : Integrable (fun x ↦ fderiv ℝ φ x (v i) * F x i) μ := (((hφ.continuous_fderiv (by norm_num)).clm_apply continuous_const).mul (hF i).continuous).integrable_of_hasCompactSupport (hcφ.fderiv_apply ℝ (v i)).mul_right simp only [divergence, testFlux, Finset.mul_sum] rw [integral_finsetSum _ (fun i _ ↦ hi i), integral_finsetSum _ (fun i _ ↦ hj i)] simp_rw [integral_mul_fderiv_eq_neg_of_compactSupport hφ hcφ (hF _) (v _)] simp /-- A divergence-free field has zero pairing with every compactly supported C¹ test gradient. -/ theorem integral_testFlux_eq_zero (v : ι → E) {φ : E → ℝ} {F : E → ι → ℝ} (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) (hF : ∀ i, ContDiff ℝ 1 (fun x ↦ F x i)) (hdiv : ∀ x, divergence v F x = 0) : ∫ x, testFlux v φ F x ∂μ = 0 := by have h := integral_mul_divergence_eq_neg_testFlux (μ := μ) v hφ hcφ hF simp only [hdiv, mul_zero, integral_zero] at h linarith /-- An integrable bound for the flux of any field whose components have norm at most one. -/ def testBound (v : ι → E) (φ : E → ℝ) (x : E) : ℝ := ∑ i, ‖fderiv ℝ φ x (v i)‖ omit [MeasurableSpace E] [BorelSpace E] [FiniteDimensional ℝ E] in theorem norm_testFlux_le_testBound (v : ι → E) (φ : E → ℝ) (F : E → ι → ℝ) (x : E) (hF : ∀ i, ‖F x i‖ ≤ 1) : ‖testFlux v φ F x‖ ≤ testBound v φ x := by apply (norm_sum_le _ _).trans apply Finset.sum_le_sum intro i _ rw [norm_mul] exact mul_le_of_le_one_right (norm_nonneg _) (hF i) omit [FiniteDimensional ℝ E] in theorem testBound_integrable (v : ι → E) {φ : E → ℝ} (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) : Integrable (testBound v φ) μ := by apply integrable_finsetSum intro i _ exact ((hφ.continuous_fderiv (by norm_num)).clm_apply continuous_const).norm.integrable_of_hasCompactSupport (hcφ.fderiv_apply ℝ (v i)).norm omit [MeasurableSpace E] [BorelSpace E] [FiniteDimensional ℝ E] in theorem testFlux_tendsto (v : ι → E) (φ : E → ℝ) {F : ℕ → E → ι → ℝ} {G : E → ι → ℝ} {x : E} (hlim : ∀ i, Tendsto (fun n ↦ F n x i) atTop (𝓝 (G x i))) : Tendsto (fun n ↦ testFlux v φ (F n) x) atTop (𝓝 (testFlux v φ G x)) := by apply tendsto_finsetSum intro i _ exact tendsto_const_nhds.mul (hlim i) /-- An almost-everywhere limit of uniformly component-bounded, divergence-free C¹ fields has zero flux against a compactly supported C¹ test gradient. -/ theorem integral_testFlux_limit_eq_zero (v : ι → E) {φ : E → ℝ} {F : ℕ → E → ι → ℝ} {G : E → ι → ℝ} (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) (hF : ∀ n i, ContDiff ℝ 1 (fun x ↦ F n x i)) (hdiv : ∀ n x, divergence v (F n) x = 0) (hbound : ∀ n x i, ‖F n x i‖ ≤ 1) (hlim : ∀ᵐ x ∂μ, ∀ i, Tendsto (fun n ↦ F n x i) atTop (𝓝 (G x i))) : ∫ x, testFlux v φ G x ∂μ = 0 := by have hc : Tendsto (fun n ↦ ∫ x, testFlux v φ (F n) x ∂μ) atTop (𝓝 (∫ x, testFlux v φ G x ∂μ)) := by apply tendsto_integral_of_dominated_convergence (testBound v φ) · exact fun n ↦ (testFlux_continuous v hφ (fun i ↦ (hF n i).continuous)).aestronglyMeasurable · exact testBound_integrable v hφ hcφ · exact fun n ↦ Filter.Eventually.of_forall fun x ↦ norm_testFlux_le_testBound v φ (F n) x (hbound n x) · filter_upwards [hlim] with x hx exact testFlux_tendsto v φ hx have hz : (fun n ↦ ∫ x, testFlux v φ (F n) x ∂μ) = fun _ ↦ 0 := by funext n exact integral_testFlux_eq_zero v hφ hcφ (hF n) (hdiv n) rw [hz] at hc exact tendsto_nhds_unique hc tendsto_const_nhds omit [FiniteDimensional ℝ E] in /-- The limiting test flux is integrable even when the limiting vector field is not continuous (for example, a normalized polynomial gradient at its critical points). -/ theorem testFlux_limit_integrable (v : ι → E) {φ : E → ℝ} {F : ℕ → E → ι → ℝ} {G : E → ι → ℝ} (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) (hF : ∀ n i, Continuous (fun x ↦ F n x i)) (hbound : ∀ n x i, ‖F n x i‖ ≤ 1) (hlim : ∀ᵐ x ∂μ, ∀ i, Tendsto (fun n ↦ F n x i) atTop (𝓝 (G x i))) : Integrable (testFlux v φ G) μ := by have hl : ∀ᵐ x ∂μ, Tendsto (fun n ↦ testFlux v φ (F n) x) atTop (𝓝 (testFlux v φ G x)) := by filter_upwards [hlim] with x hx exact testFlux_tendsto v φ hx have hm : AEStronglyMeasurable (testFlux v φ G) μ := aestronglyMeasurable_of_tendsto_ae atTop (fun n ↦ (testFlux_continuous v hφ (hF n)).aestronglyMeasurable) hl apply (testBound_integrable v hφ hcφ).mono' hm filter_upwards [hl] with x hx exact le_of_tendsto hx.norm (Filter.Eventually.of_forall fun n ↦ norm_testFlux_le_testBound v φ (F n) x (hbound n x)) /-- A nonnegative limiting flux with positive-measure support obstructs a sequence of uniformly bounded divergence-free fields. -/ theorem nonnegative_limit_obstruction (v : ι → E) {φ : E → ℝ} {F : ℕ → E → ι → ℝ} {G : E → ι → ℝ} (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) (hF : ∀ n i, ContDiff ℝ 1 (fun x ↦ F n x i)) (hdiv : ∀ n x, divergence v (F n) x = 0) (hbound : ∀ n x i, ‖F n x i‖ ≤ 1) (hlim : ∀ᵐ x ∂μ, ∀ i, Tendsto (fun n ↦ F n x i) atTop (𝓝 (G x i))) (hnonneg : ∀ᵐ x ∂μ, 0 ≤ testFlux v φ G x) (hpos : 0 < μ (Function.support (testFlux v φ G))) : False := by have hi := testFlux_limit_integrable v hφ hcφ (fun n i ↦ (hF n i).continuous) hbound hlim have hp := (integral_pos_iff_support_of_nonneg_ae hnonneg hi).2 hpos rw [integral_testFlux_limit_eq_zero v hφ hcφ hF hdiv hbound hlim] at hp exact lt_irrefl _ hp section Radial /-- Squared Euclidean radius, used on the coordinate space with its usual sup-norm topology. -/ def radiusSq (x : ι → ℝ) : ℝ := ∑ i, (x i) ^ 2 /-- An increasing radial compactly supported smooth test function. -/ def radialTest (x : ι → ℝ) : ℝ := -expNegInvGlue (1 - radiusSq x) /-- The radial derivative is a nonnegative scalar multiple of the radius vector. -/ def radialWeight (x : ι → ℝ) : ℝ := 2 * ((1 - radiusSq x)⁻¹) ^ 2 * expNegInvGlue (1 - radiusSq x) theorem radiusSq_contDiff : ContDiff ℝ 1 (radiusSq : (ι → ℝ) → ℝ) := by unfold radiusSq fun_prop theorem radialTest_contDiff : ContDiff ℝ 1 (radialTest : (ι → ℝ) → ℝ) := by exact (expNegInvGlue.contDiff.comp (contDiff_const.sub radiusSq_contDiff)).neg theorem radialWeight_nonneg (x : ι → ℝ) : 0 ≤ radialWeight x := by unfold radialWeight exact mul_nonneg (mul_nonneg (by norm_num) (sq_nonneg _)) (expNegInvGlue.nonneg _) theorem radialWeight_pos (x : ι → ℝ) (hx : radiusSq x < 1) : 0 < radialWeight x := by unfold radialWeight have hp : 0 < 1 - radiusSq x := sub_pos.mpr hx exact mul_pos (mul_pos (by norm_num) (sq_pos_of_pos (inv_pos.mpr hp))) (expNegInvGlue.pos_of_pos hp) theorem radialTest_hasCompactSupport : HasCompactSupport (radialTest : (ι → ℝ) → ℝ) := by apply HasCompactSupport.intro (isCompact_closedBall (0 : ι → ℝ) 1) intro x hx have hr : 1 ≤ radiusSq x := by by_contra h have hrs : radiusSq x < 1 := lt_of_not_ge h have hn : ‖x‖ ≤ 1 := by apply (pi_norm_le_iff_of_nonneg (by norm_num)).2 intro i have hs : (x i) ^ 2 ≤ radiusSq x := Finset.single_le_sum (fun j _ ↦ sq_nonneg (x j)) (Finset.mem_univ i) rw [Real.norm_eq_abs, abs_le] constructor <;> nlinarith [sq_nonneg (x i + 1), sq_nonneg (x i - 1)] exact hx (by simpa only [Metric.mem_closedBall, dist_zero_right] using hn) simp only [radialTest, expNegInvGlue.zero_of_nonpos (sub_nonpos.mpr hr), neg_zero] /-- Explicit derivative of the squared radius in any direction. -/ theorem radiusSq_hasFDerivAt (x : ι → ℝ) : HasFDerivAt radiusSq (∑ i, (2 * x i) • (ContinuousLinearMap.proj i : (ι → ℝ) →L[ℝ] ℝ)) x := by unfold radiusSq apply HasFDerivAt.fun_sum intro i _ convert (hasFDerivAt_apply (𝕜 := ℝ) (F' := fun _ : ι ↦ ℝ) i x).pow 2 using 1; simp theorem expNegInvGlue_hasDerivAt (s : ℝ) : HasDerivAt expNegInvGlue (s⁻¹ ^ 2 * expNegInvGlue s) s := by simpa using expNegInvGlue.hasDerivAt_polynomial_eval_inv_mul (1 : Polynomial ℝ) s variable [DecidableEq ι] theorem radialTest_fderiv_coordinate (x : ι → ℝ) (i : ι) : fderiv ℝ radialTest x (Pi.single i 1) = radialWeight x * x i := by have hi : HasFDerivAt (fun y : ι → ℝ ↦ 1 - radiusSq y) (0 - ∑ j, (2 * x j) • (ContinuousLinearMap.proj j : (ι → ℝ) →L[ℝ] ℝ)) x := (hasFDerivAt_const (1 : ℝ) x).sub (radiusSq_hasFDerivAt x) have hd := (expNegInvGlue_hasDerivAt (1 - radiusSq x)).comp_hasFDerivAt x hi have he : fderiv ℝ radialTest x = - (((1 - radiusSq x)⁻¹ ^ 2 * expNegInvGlue (1 - radiusSq x)) • (0 - ∑ j, (2 * x j) • (ContinuousLinearMap.proj j : (ι → ℝ) →L[ℝ] ℝ))) := hd.neg.fderiv rw [he] simp [radialWeight, Pi.single_apply] ring theorem radialTest_flux (F : (ι → ℝ) → ι → ℝ) (x : ι → ℝ) : testFlux (fun i ↦ Pi.single i 1) radialTest F x = radialWeight x * ∑ i, x i * F x i := by simp only [testFlux, radialTest_fderiv_coordinate, Finset.mul_sum] apply Finset.sum_congr rfl intro i _ ring end Radial section Normalization /-- The everywhere-regular normalization used in the minimal graph equation. -/ def normalizedField (g : E → ι → ℝ) (x : E) (i : ι) : ℝ := g x i / Real.sqrt (1 + radiusSq (g x)) omit [NormedAddCommGroup E] [NormedSpace ℝ E] [MeasurableSpace E] [BorelSpace E] [FiniteDimensional ℝ E] in theorem normalization_pos (g : E → ι → ℝ) (x : E) : 0 < 1 + radiusSq (g x) := by have : 0 ≤ radiusSq (g x) := Finset.sum_nonneg fun i _ ↦ sq_nonneg (g x i) linarith omit [MeasurableSpace E] [BorelSpace E] [FiniteDimensional ℝ E] in theorem normalizedField_contDiff {g : E → ι → ℝ} (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (i : ι) : ContDiff ℝ 1 (fun x ↦ normalizedField g x i) := by have hs : ContDiff ℝ 1 (fun x ↦ 1 + radiusSq (g x)) := by apply contDiff_const.add apply ContDiff.sum intro j _ exact (hg j).pow 2 exact (hg i).div (hs.sqrt (fun x ↦ (normalization_pos g x).ne')) (fun x ↦ (Real.sqrt_pos.mpr (normalization_pos g x)).ne') omit [NormedAddCommGroup E] [NormedSpace ℝ E] [MeasurableSpace E] [BorelSpace E] [FiniteDimensional ℝ E] in theorem normalizedField_norm_le_one (g : E → ι → ℝ) (x : E) (i : ι) : ‖normalizedField g x i‖ ≤ 1 := by have hs := Real.sqrt_pos.mpr (normalization_pos g x) have he := Real.sq_sqrt (normalization_pos g x).le have hi : (g x i) ^ 2 ≤ radiusSq (g x) := Finset.single_le_sum (fun j _ ↦ sq_nonneg (g x j)) (Finset.mem_univ i) have hl : |g x i| ≤ Real.sqrt (1 + radiusSq (g x)) := by nlinarith [sq_abs (g x i)] simp only [normalizedField, norm_div, Real.norm_eq_abs, abs_of_pos hs] exact (div_le_one hs).2 hl omit [MeasurableSpace E] [BorelSpace E] [FiniteDimensional ℝ E] in /-- Derivative of the squared denominator in an arbitrary direction. -/ theorem normalization_hasFDerivAt {g : E → ι → ℝ} (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (x : E) : HasFDerivAt (fun y ↦ 1 + radiusSq (g y)) (∑ i, (2 * g x i) • fderiv ℝ (fun y ↦ g y i) x) x := by have hd : HasFDerivAt (fun y ↦ radiusSq (g y)) (∑ i, (2 * g x i) • fderiv ℝ (fun y ↦ g y i) x) x := by apply HasFDerivAt.fun_sum intro i _ convert ((hg i).differentiable (by norm_num) x).hasFDerivAt.pow 2 using 1; simp convert (hasFDerivAt_const (1 : ℝ) x).add hd using 1; simp omit [MeasurableSpace E] [BorelSpace E] [FiniteDimensional ℝ E] in /-- Differentiating the normalized field gives the exact denominator needed by the minimal graph operator. -/ theorem normalizedField_fderiv {g : E → ι → ℝ} (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (x v : E) (i : ι) : fderiv ℝ (fun y ↦ normalizedField g y i) x v = ((1 + radiusSq (g x)) * fderiv ℝ (fun y ↦ g y i) x v - g x i * ∑ j, g x j * fderiv ℝ (fun y ↦ g y j) x v) / (Real.sqrt (1 + radiusSq (g x))) ^ 3 := by let s := 1 + radiusSq (g x) have hs : 0 < s := normalization_pos g x have hroot : Real.sqrt s ≠ 0 := (Real.sqrt_pos.mpr hs).ne' have hsq : Real.sqrt s ^ 2 = s := Real.sq_sqrt hs.le have houter : HasDerivAt (fun r : ℝ ↦ (Real.sqrt r)⁻¹) (-(Real.sqrt s ^ 2)⁻¹ * (1 / (2 * Real.sqrt s))) s := by exact (hasDerivAt_inv hroot).comp s (Real.hasDerivAt_sqrt hs.ne') have hd := houter.comp_hasFDerivAt x (normalization_hasFDerivAt hg x) have hp := (((hg i).differentiable (by norm_num) x).hasFDerivAt).mul hd have he : fderiv ℝ (fun y ↦ normalizedField g y i) x = g x i • ((-(Real.sqrt s ^ 2)⁻¹ * (1 / (2 * Real.sqrt s))) • (∑ j, (2 * g x j) • fderiv ℝ (fun y ↦ g y j) x)) + (Real.sqrt s)⁻¹ • fderiv ℝ (fun y ↦ g y i) x := by simpa only [normalizedField, div_eq_mul_inv, Pi.mul_def, Function.comp_def, s] using hp.fderiv rw [he] simp only [add_apply, smul_apply, sum_apply, smul_eq_mul] change _ = (s * _ - _) / (Real.sqrt s) ^ 3 have hsum : (∑ j, 2 * g x j * fderiv ℝ (fun y ↦ g y j) x v) = 2 * ∑ j, g x j * fderiv ℝ (fun y ↦ g y j) x v := by rw [Finset.mul_sum] apply Finset.sum_congr rfl intro j _ ring rw [hsum] field_simp rw [hsq] ring /-- The numerator of the divergence of the normalized field. For `g = ∇u`, this is the polynomial minimal graph operator. -/ def minimalFieldNumerator (v : ι → E) (g : E → ι → ℝ) (x : E) : ℝ := (1 + radiusSq (g x)) * divergence v g x - ∑ i, ∑ j, g x i * g x j * fderiv ℝ (fun y ↦ g y j) x (v i) omit [MeasurableSpace E] [BorelSpace E] [FiniteDimensional ℝ E] in theorem divergence_normalizedField (v : ι → E) {g : E → ι → ℝ} (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (x : E) : divergence v (normalizedField g) x = minimalFieldNumerator v g x / (Real.sqrt (1 + radiusSq (g x))) ^ 3 := by simp only [divergence, normalizedField_fderiv hg, minimalFieldNumerator, ← Finset.sum_div, Finset.sum_sub_distrib, Finset.mul_sum, mul_assoc] omit [MeasurableSpace E] [BorelSpace E] [FiniteDimensional ℝ E] in theorem divergence_normalizedField_eq_zero (v : ι → E) {g : E → ι → ℝ} (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hmin : ∀ x, minimalFieldNumerator v g x = 0) (x : E) : divergence v (normalizedField g) x = 0 := by rw [divergence_normalizedField v hg x, hmin, zero_div] omit [MeasurableSpace E] [BorelSpace E] [FiniteDimensional ℝ E] in /-- Dilation preserves zero divergence. -/ theorem divergence_dilate (v : ι → E) {F : E → ι → ℝ} (hF : ∀ i, ContDiff ℝ 1 (fun x ↦ F x i)) (r : ℝ) (x : E) : divergence v (fun y ↦ F (r • y)) x = r * divergence v F (r • x) := by unfold divergence rw [Finset.mul_sum] apply Finset.sum_congr rfl intro i _ have hd := (((hF i).differentiable (by norm_num) (r • x)).hasFDerivAt).comp x ((hasFDerivAt_id x).const_smul r) have he := congrArg (fun L : E →L[ℝ] ℝ ↦ L (v i)) hd.fderiv simpa only [Function.comp_def, ContinuousLinearMap.comp_apply, smul_apply, ContinuousLinearMap.id_apply, map_smul, smul_eq_mul] using he end Normalization section LimitNormalization theorem radiusSq_pos_of_ne_zero {z : ι → ℝ} (hz : z ≠ 0) : 0 < radiusSq z := by obtain ⟨i, hi⟩ : ∃ i, z i ≠ 0 := by by_contra h apply hz ext i simpa using not_exists.mp h i exact (sq_pos_of_ne_zero hi).trans_le (Finset.single_le_sum (fun j _ ↦ sq_nonneg (z j)) (Finset.mem_univ i)) /-- A positive rescaling of numerator and denominator exposes the asymptotic limit. -/ theorem normalized_ratio_rescale (z : ι → ℝ) {r : ℝ} (hr : 0 < r) (i : ι) : z i / Real.sqrt (1 + radiusSq z) = (r * z i) / Real.sqrt (r ^ 2 + radiusSq (fun j ↦ r * z j)) := by have he : r ^ 2 + radiusSq (fun j ↦ r * z j) = r ^ 2 * (1 + radiusSq z) := by simp only [radiusSq, mul_pow, Finset.mul_sum, mul_add, mul_one] rw [he, Real.sqrt_mul (sq_nonneg r), Real.sqrt_sq hr.le] exact (mul_div_mul_left (z i) (Real.sqrt (1 + radiusSq z)) hr.ne').symm /-- If a sequence of vectors has a nonzero limit after multiplication by positive scalars tending to zero, its regularized unit vectors converge to the normalization of that limit. -/ theorem normalized_ratio_tendsto {g : ℕ → ι → ℝ} {r : ℕ → ℝ} {z : ι → ℝ} (hr : ∀ n, 0 < r n) (hr0 : Tendsto r atTop (𝓝 0)) (hg : ∀ i, Tendsto (fun n ↦ r n * g n i) atTop (𝓝 (z i))) (hz : z ≠ 0) (i : ι) : Tendsto (fun n ↦ g n i / Real.sqrt (1 + radiusSq (g n))) atTop (𝓝 (z i / Real.sqrt (radiusSq z))) := by have hs : Tendsto (fun n ↦ r n ^ 2 + radiusSq (fun j ↦ r n * g n j)) atTop (𝓝 (radiusSq z)) := by have hsum := tendsto_finsetSum Finset.univ (fun j _ ↦ (hg j).pow 2) simpa only [zero_pow (by norm_num : 2 ≠ 0), zero_add, radiusSq] using (hr0.pow 2).add hsum have hden : Real.sqrt (radiusSq z) ≠ 0 := (Real.sqrt_pos.mpr (radiusSq_pos_of_ne_zero hz)).ne' have ht := (hg i).div hs.sqrt hden convert ht using 1 funext n exact normalized_ratio_rescale (g n) (hr n) i end LimitNormalization section PolynomialZeroSet omit [Fintype ι] in theorem continuous_polynomial_eval (p : MvPolynomial ι ℝ) : Continuous (fun x : ι → ℝ ↦ MvPolynomial.eval x p) := by induction p using MvPolynomial.induction_on with | C a => simpa using (continuous_const : Continuous (fun _ : ι → ℝ ↦ a)) | add p q hp hq => convert hp.add hq using 1 ext x simp | mul_X p i hp => convert hp.mul (continuous_apply i) using 1 ext x simp /-- A nonzero real polynomial in finitely many variables is nonzero almost everywhere. The proof is induction in the number of variables, Fubini, and finiteness of univariate roots. -/ theorem mvPolynomial_eval_ne_zero_ae (n : ℕ) (p : MvPolynomial (Fin n) ℝ) (hp : p ≠ 0) : ∀ᵐ x : Fin n → ℝ, MvPolynomial.eval x p ≠ 0 := by induction n with | zero => apply Filter.Eventually.of_forall intro x hx apply hp apply QuarticCompatibility.polynomial_funext intro y have hxy : y = x := Subsingleton.elim _ _ simp only [hxy, hx, map_zero] | succ n ih => let q := MvPolynomial.finSuccEquiv ℝ n p have hq : q ≠ 0 := by exact (map_ne_zero_iff (MvPolynomial.finSuccEquiv ℝ n) (MvPolynomial.finSuccEquiv ℝ n).injective).2 hp obtain ⟨k, hk⟩ : ∃ k, q.coeff k ≠ 0 := by by_contra h apply hq apply Polynomial.ext intro k simpa using not_exists.mp h k have hc := ih (q.coeff k) hk have heval : Continuous (fun z : ℝ × (Fin n → ℝ) ↦ MvPolynomial.eval (Fin.cons z.1 z.2) p) := by apply (continuous_polynomial_eval p).comp apply continuous_pi intro i refine Fin.cases ?_ (fun j ↦ ?_) i · exact continuous_fst · exact (continuous_apply j).comp continuous_snd have hmeas : MeasurableSet {z : ℝ × (Fin n → ℝ) | MvPolynomial.eval (Fin.cons z.1 z.2) p ≠ 0} := (measurableSet_eq_fun heval.measurable measurable_const).compl have hprod : ∀ᵐ z : ℝ × (Fin n → ℝ), MvPolynomial.eval (Fin.cons z.1 z.2) p ≠ 0 := by apply (Measure.ae_prod_iff_ae_ae hmeas).2 apply (Measure.ae_ae_comm hmeas).2 filter_upwards [hc] with y hy let py := Polynomial.map (MvPolynomial.eval y) q have hpy : py ≠ 0 := by intro hz have hzero := congrArg (fun P : Polynomial ℝ ↦ P.coeff k) hz exact hy (by simpa [py, Polynomial.coeff_map] using hzero) have hroots := (Polynomial.finite_setOfPred_isRoot hpy).measure_zero volume have ha : ∀ᵐ t : ℝ, py.eval t ≠ 0 := by rw [ae_iff] simpa only [not_not, Polynomial.IsRoot] using hroots filter_upwards [ha] with t ht simpa only [MvPolynomial.eval_eq_eval_mv_eval', py, q] using ht have hpres := volume_preserving_piFinSuccAbove (fun _ : Fin (n + 1) ↦ ℝ) 0 have hfinal := hpres.quasiMeasurePreserving.ae hprod filter_upwards [hfinal] with x hx simpa [MeasurableEquiv.piFinSuccAbove_apply, Fin.insertNthEquiv, Fin.removeNth, Fin.succAbove_zero, Fin.cons_self_tail] using hx end PolynomialZeroSet section HomogeneousObstruction variable {n : ℕ} def evaluatedGradient (p : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) (i : Fin n) : ℝ := MvPolynomial.eval x (MvPolynomial.pderiv i p) def leadingNormalizedField (p : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) (i : Fin n) : ℝ := evaluatedGradient p x i / Real.sqrt (radiusSq (evaluatedGradient p x)) theorem euler_evaluatedGradient (p : MvPolynomial (Fin n) ℝ) {d : ℕ} (hp : p.IsHomogeneous d) (x : Fin n → ℝ) : (∑ i, x i * evaluatedGradient p x i) = (d : ℝ) * MvPolynomial.eval x p := by have he := congrArg (MvPolynomial.eval x) (QuarticCompatibility.sum_X_mul_pderiv hp) simpa [evaluatedGradient] using he theorem radial_flux_leadingNormalizedField (p : MvPolynomial (Fin n) ℝ) {d : ℕ} (hp : p.IsHomogeneous d) (x : Fin n → ℝ) : testFlux (fun i ↦ Pi.single i 1) radialTest (leadingNormalizedField p) x = radialWeight x * ((d : ℝ) * MvPolynomial.eval x p / Real.sqrt (radiusSq (evaluatedGradient p x))) := by rw [radialTest_flux] simp only [leadingNormalizedField, ← mul_div_assoc, ← Finset.sum_div] rw [euler_evaluatedGradient p hp x] theorem evaluatedGradient_ne_zero_of_pos (p : MvPolynomial (Fin n) ℝ) {d : ℕ} (hp : p.IsHomogeneous d) (hd : 0 < d) {x : Fin n → ℝ} (hx : 0 < MvPolynomial.eval x p) : evaluatedGradient p x ≠ 0 := by intro hz have he := euler_evaluatedGradient p hp x have hdR : 0 < (d : ℝ) := by exact_mod_cast hd simp only [hz, Pi.zero_apply, mul_zero, Finset.sum_const_zero] at he exact (mul_pos hdR hx).ne' he.symm /-- A nonzero nonnegative homogeneous polynomial of positive degree cannot supply the normalized limit of uniformly bounded divergence-free fields. This is the radial flux obstruction; its zero-set and positive-measure steps are included in the proof. -/ theorem homogeneous_nonnegative_limit_obstruction (p : MvPolynomial (Fin n) ℝ) {d : ℕ} (hp : p.IsHomogeneous d) (hd : 0 < d) (hne : p ≠ 0) (hnonneg : ∀ x, 0 ≤ MvPolynomial.eval x p) {F : ℕ → (Fin n → ℝ) → Fin n → ℝ} (hF : ∀ k i, ContDiff ℝ 1 (fun x ↦ F k x i)) (hdiv : ∀ k x, divergence (fun i ↦ Pi.single i 1) (F k) x = 0) (hbound : ∀ k x i, ‖F k x i‖ ≤ 1) (hlim : ∀ᵐ x, ∀ i, Tendsto (fun k ↦ F k x i) atTop (𝓝 (leadingNormalizedField p x i))) : False := by have hflux_nonneg : ∀ᵐ x, 0 ≤ testFlux (fun i ↦ Pi.single i 1) radialTest (leadingNormalizedField p) x := by apply Filter.Eventually.of_forall intro x rw [radial_flux_leadingNormalizedField p hp x] exact mul_nonneg (radialWeight_nonneg x) (div_nonneg (mul_nonneg (Nat.cast_nonneg d) (hnonneg x)) (Real.sqrt_nonneg _)) have hpositive : ∀ᵐ x : Fin n → ℝ, 0 < MvPolynomial.eval x p := by filter_upwards [mvPolynomial_eval_ne_zero_ae n p hne] with x hx exact lt_of_le_of_ne (hnonneg x) hx.symm have hsupport : {x : Fin n → ℝ | radiusSq x < 1} ≤ᵐ[volume] Function.support (testFlux (fun i ↦ Pi.single i 1) radialTest (leadingNormalizedField p)) := by filter_upwards [hpositive] with x hx intro hr change testFlux (fun i ↦ Pi.single i 1) radialTest (leadingNormalizedField p) x ≠ 0 rw [radial_flux_leadingNormalizedField p hp x] have hgradient := evaluatedGradient_ne_zero_of_pos p hp hd hx have hden : 0 < Real.sqrt (radiusSq (evaluatedGradient p x)) := Real.sqrt_pos.mpr (radiusSq_pos_of_ne_zero hgradient) exact (mul_pos (radialWeight_pos x hr) (div_pos (mul_pos (by exact_mod_cast hd) hx) hden)).ne' have hopen : IsOpen {x : Fin n → ℝ | radiusSq x < 1} := isOpen_lt radiusSq_contDiff.continuous continuous_const have hball : 0 < volume {x : Fin n → ℝ | radiusSq x < 1} := by exact hopen.measure_pos volume ⟨0, by simp [radiusSq]⟩ exact nonnegative_limit_obstruction (fun i ↦ Pi.single i 1) radialTest_contDiff radialTest_hasCompactSupport hF hdiv hbound hlim hflux_nonneg (hball.trans_le (measure_mono_ae hsupport)) end HomogeneousObstruction section PolynomialDilation theorem pow_ratio_tendsto_zero {e d : ℕ} (hed : e < d) : Tendsto (fun r : ℝ ↦ r ^ e / r ^ d) atTop (𝓝 0) := by have hd : d - e ≠ 0 := by omega have ht := (tendsto_inv_atTop_zero : Tendsto (fun r : ℝ ↦ r⁻¹) atTop (𝓝 0)).pow (d - e) have he : (fun r : ℝ ↦ r ^ e / r ^ d) =ᶠ[atTop] (fun r ↦ (r⁻¹) ^ (d - e)) := by filter_upwards [eventually_gt_atTop (0 : ℝ)] with r hr rw [inv_pow, inv_eq_one_div] apply (div_eq_div_iff (pow_ne_zero _ hr.ne') (pow_ne_zero _ hr.ne')).2 rw [one_mul, ← pow_add] congr 1 omega have hz : Tendsto (fun r : ℝ ↦ (r⁻¹) ^ (d - e)) atTop (𝓝 0) := by simpa only [zero_pow hd] using ht exact hz.congr' he.symm theorem eval_dilate_eq_sum (p : MvPolynomial ι ℝ) (x : ι → ℝ) (r : ℝ) : MvPolynomial.eval (r • x) p = ∑ m ∈ p.support, p.coeff m * (r ^ m.degree * ∏ i, (x i) ^ m i) := by change MvPolynomial.eval₂ (RingHom.id ℝ) (r • x) p = _ rw [MvPolynomial.eval₂_eq'] simp only [RingHom.id_apply, Pi.smul_apply, smul_eq_mul, mul_pow, Finset.prod_mul_distrib, Finset.prod_pow_eq_pow_sum, Finsupp.degree_eq_sum] theorem eval_dilate_homogeneous (p : MvPolynomial ι ℝ) {d : ℕ} (hp : p.IsHomogeneous d) (x : ι → ℝ) (r : ℝ) : MvPolynomial.eval (r • x) p = r ^ d * MvPolynomial.eval x p := by rw [eval_dilate_eq_sum] change _ = r ^ d * MvPolynomial.eval₂ (RingHom.id ℝ) x p rw [MvPolynomial.eval₂_eq', Finset.mul_sum] apply Finset.sum_congr rfl intro m hm have hd : m.degree = d := by simpa only [Finsupp.degree_eq_weight_one, Pi.one_def] using hp (MvPolynomial.mem_support_iff.mp hm) simp only [RingHom.id_apply, hd] ring theorem eval_dilate_div_pow_tendsto_zero (p : MvPolynomial ι ℝ) {d : ℕ} (hp : p.totalDegree < d) (x : ι → ℝ) : Tendsto (fun r : ℝ ↦ MvPolynomial.eval (r • x) p / r ^ d) atTop (𝓝 0) := by have ht : Tendsto (fun r : ℝ ↦ ∑ m ∈ p.support, (p.coeff m * ∏ i, (x i) ^ m i) * (r ^ m.degree / r ^ d)) atTop (𝓝 (∑ _m ∈ p.support, (0 : ℝ))) := by apply tendsto_finsetSum intro m hm have hd : m.degree < d := lt_of_le_of_lt (MvPolynomial.le_totalDegree hm) hp simpa using (pow_ratio_tendsto_zero hd).const_mul (p.coeff m * ∏ i, (x i) ^ m i) simp only [Finset.sum_const_zero] at ht convert ht using 1 funext r rw [eval_dilate_eq_sum, Finset.sum_div] apply Finset.sum_congr rfl intro m hm ring end PolynomialDilation end FluxObstruction end end ComponentFluxObstruction /- Component: FluxPolynomial -/ section ComponentFluxPolynomial /- Requires PolynomialBasics and FluxObstruction. -/ noncomputable section open MeasureTheory Filter MvPolynomial open scoped Topology BigOperators namespace FluxPolynomial open QuarticPolynomialBasics FluxObstruction variable {ι : Type*} [Fintype ι] theorem contDiff_eval (p : MvPolynomial ι ℝ) : ContDiff ℝ 1 (fun x : ι → ℝ ↦ eval x p) := by induction p using MvPolynomial.induction_on with | C a => simpa using (contDiff_const : ContDiff ℝ 1 (fun _ : ι → ℝ ↦ a)) | add p q hp hq => simpa using hp.add hq | mul_X p i hp => simpa using hp.mul (by fun_prop : ContDiff ℝ 1 (fun x : ι → ℝ ↦ x i)) theorem eval_dilate_div_pow_tendsto (p : MvPolynomial ι ℝ) {d : ℕ} (hd : 0 < d) (hp : p.totalDegree ≤ d) (x : ι → ℝ) : Tendsto (fun r : ℝ ↦ eval (r • x) p / r ^ d) atTop (𝓝 (eval x (homogeneousComponent d p))) := by let T := homogeneousComponent d p let R := p - T have hRdeg : R.totalDegree < d := by have h := totalDegree_sub_homogeneousComponent_le p d hp dsimp [R, T] omega have hR := eval_dilate_div_pow_tendsto_zero R hRdeg x have hT : Tendsto (fun r : ℝ ↦ eval (r • x) T / r ^ d) atTop (𝓝 (eval x T)) := by have he : (fun r : ℝ ↦ eval (r • x) T / r ^ d) =ᶠ[atTop] fun _ ↦ eval x T := by filter_upwards [eventually_gt_atTop (0 : ℝ)] with r hr rw [eval_dilate_homogeneous T (homogeneousComponent_isHomogeneous d p) x r] field_simp exact tendsto_const_nhds.congr' he.symm have hsplit : p = T + R := by dsimp [T, R]; ring have he : (fun r : ℝ ↦ eval (r • x) p / r ^ d) = (fun r : ℝ ↦ eval (r • x) T / r ^ d + eval (r • x) R / r ^ d) := by funext r rw [hsplit, map_add, add_div] rw [he] simpa only [add_zero] using hT.add hR variable {n : ℕ} theorem minimalFieldNumerator_evaluatedGradient (p : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) : minimalFieldNumerator (fun i ↦ Pi.single i 1) (evaluatedGradient p) x = eval x (minimalGraphOperator p) := by simp [minimalFieldNumerator, divergence, evaluatedGradient, radiusSq, minimalGraphOperator, fderiv_eval, evalFDeriv_apply, Pi.single_apply] def dilationRadius (k : ℕ) : ℝ := (k + 1 : ℕ) theorem dilationRadius_pos (k : ℕ) : 0 < dilationRadius k := by unfold dilationRadius positivity theorem dilationRadius_tendsto : Tendsto dilationRadius atTop atTop := tendsto_natCast_atTop_atTop.comp (tendsto_add_atTop_nat 1) /-- The flux obstruction for an actual polynomial solution of the minimal graph equation. -/ theorem top_not_nonnegative (p : MvPolynomial (Fin n) ℝ) (hmin : minimalGraphOperator p = 0) (hdeg : 2 ≤ p.totalDegree) : ¬ ∀ x, 0 ≤ eval x (homogeneousComponent p.totalDegree p) := by intro hnonneg let d := p.totalDegree - 1 have hd : 0 < d := by dsimp [d]; omega have hdegree : d + 1 = p.totalDegree := by dsimp [d]; omega let top := homogeneousComponent (d + 1) p have htop : top.IsHomogeneous (d + 1) := homogeneousComponent_isHomogeneous _ _ have hne : top ≠ 0 := by dsimp [top] rw [hdegree] exact top_homogeneousComponent_ne_zero p (by omega) have htop_nonneg : ∀ x, 0 ≤ eval x top := by simpa [top, hdegree] using hnonneg have hg : ∀ i, ContDiff ℝ 1 (fun x ↦ evaluatedGradient p x i) := fun i ↦ contDiff_eval (pderiv i p) have hnorm : ∀ i, ContDiff ℝ 1 (fun x ↦ normalizedField (evaluatedGradient p) x i) := normalizedField_contDiff hg let F : ℕ → (Fin n → ℝ) → Fin n → ℝ := fun k x ↦ normalizedField (evaluatedGradient p) (dilationRadius k • x) have hF : ∀ k i, ContDiff ℝ 1 (fun x ↦ F k x i) := by intro k i exact (hnorm i).comp (by fun_prop) have hdiv : ∀ k x, divergence (fun i ↦ Pi.single i 1) (F k) x = 0 := by intro k x rw [show F k = fun y ↦ normalizedField (evaluatedGradient p) (dilationRadius k • y) from rfl] rw [divergence_dilate _ hnorm] have hz : ∀ y, minimalFieldNumerator (fun i ↦ Pi.single i 1) (evaluatedGradient p) y = 0 := by intro y rw [minimalFieldNumerator_evaluatedGradient, hmin, map_zero] rw [divergence_normalizedField_eq_zero _ hg hz, mul_zero] have hbound : ∀ k x i, ‖F k x i‖ ≤ 1 := by intro k x i exact normalizedField_norm_le_one _ _ _ have hlim : ∀ᵐ x, ∀ i, Tendsto (fun k ↦ F k x i) atTop (𝓝 (leadingNormalizedField top x i)) := by filter_upwards [mvPolynomial_eval_ne_zero_ae n top hne] with x hx have hpx : 0 < eval x top := lt_of_le_of_ne (htop_nonneg x) hx.symm have hgrad : evaluatedGradient top x ≠ 0 := evaluatedGradient_ne_zero_of_pos top htop (by omega) hpx intro i apply normalized_ratio_tendsto (r := fun k ↦ (dilationRadius k)⁻¹ ^ d) · intro k exact pow_pos (inv_pos.mpr (dilationRadius_pos k)) d · have hr := (tendsto_inv_atTop_zero.comp dilationRadius_tendsto).pow d simpa only [zero_pow hd.ne', Function.comp_def] using hr · intro j have hpd : (pderiv j p).totalDegree ≤ d := totalDegree_pderiv_le_of_totalDegree_le p j d (by omega) have hh := (eval_dilate_div_pow_tendsto (pderiv j p) hd hpd x).comp dilationRadius_tendsto simpa only [evaluatedGradient, top, pderiv_homogeneousComponent, Function.comp_def, div_eq_mul_inv, inv_pow, mul_comm] using hh · exact hgrad exact homogeneous_nonnegative_limit_obstruction top htop (by omega) hne htop_nonneg hF hdiv hbound hlim theorem minimalGraphOperator_neg (p : MvPolynomial (Fin n) ℝ) : minimalGraphOperator (-p) = -minimalGraphOperator p := by simp only [minimalGraphOperator, map_neg, neg_sq, mul_neg, Finset.sum_neg_distrib] ring_nf /-- Every nonaffine polynomial minimal graph has a leading homogeneous term taking both positive and negative values. -/ theorem top_changes_sign (p : MvPolynomial (Fin n) ℝ) (hmin : minimalGraphOperator p = 0) (hdeg : 2 ≤ p.totalDegree) : (∃ x, eval x (homogeneousComponent p.totalDegree p) < 0) ∧ (∃ x, 0 < eval x (homogeneousComponent p.totalDegree p)) := by constructor · obtain ⟨x, hx⟩ := not_forall.mp (top_not_nonnegative p hmin hdeg) exact ⟨x, lt_of_not_ge hx⟩ · have hminneg : minimalGraphOperator (-p) = 0 := by rw [minimalGraphOperator_neg, hmin, neg_zero] have hdegneg : 2 ≤ (-p).totalDegree := by simpa using hdeg obtain ⟨x, hx⟩ := not_forall.mp (top_not_nonnegative (-p) hminneg hdegneg) refine ⟨x, ?_⟩ have hn : eval x (homogeneousComponent (-p).totalDegree (-p)) < 0 := lt_of_not_ge hx simpa only [totalDegree_neg, map_neg, neg_lt_zero] using hn end FluxPolynomial end end ComponentFluxPolynomial end Source29QuarticReuse /- Component: GraphAreaConvexity.inc -/ /- The elementary convexity and integrability part of the graph calibration. The conclusion concerns compactly supported vertical graph variations. -/ namespace Source29GraphAreaConvexity open MeasureTheory open scoped BigOperators noncomputable section def areaDensity {n : ℕ} (a : Fin n → ℝ) : ℝ := Real.sqrt (1 + ∑ i, a i ^ 2) theorem areaDensity_pos {n : ℕ} (a : Fin n → ℝ) : 0 < areaDensity a := by apply Real.sqrt_pos.mpr have h : 0 ≤ ∑ i, a i ^ 2 := Finset.sum_nonneg fun i _ ↦ sq_nonneg (a i) linarith theorem areaDensity_sq {n : ℕ} (a : Fin n → ℝ) : areaDensity a ^ 2 = 1 + ∑ i, a i ^ 2 := by apply Real.sq_sqrt have h : 0 ≤ ∑ i, a i ^ 2 := Finset.sum_nonneg fun i _ ↦ sq_nonneg (a i) linarith /-- Supporting-hyperplane inequality for the area integrand. -/ theorem areaDensity_support {n : ℕ} (a b : Fin n → ℝ) : (∑ i, (b i - a i) * (a i / areaDensity a)) ≤ areaDensity b - areaDensity a := by have hcs := Real.sum_mul_le_sqrt_mul_sqrt Finset.univ (Fin.cons (1 : ℝ) a) (Fin.cons (1 : ℝ) b) simp only [Fin.sum_univ_succ, Fin.cons_zero, Fin.cons_succ, one_pow, one_mul] at hcs change 1 + ∑ i, a i * b i ≤ areaDensity a * areaDensity b at hcs have he : (∑ i, (b i - a i) * (a i / areaDensity a)) = ((∑ i, a i * b i) - ∑ i, a i ^ 2) / areaDensity a := by rw [← Finset.sum_sub_distrib, Finset.sum_div] apply Finset.sum_congr rfl intro i _ ring rw [he] apply (div_le_iff₀ (areaDensity_pos a)).mpr nlinarith [areaDensity_sq a] theorem areaDensity_add_support {n : ℕ} (a h : Fin n → ℝ) : (∑ i, h i * (a i / areaDensity a)) ≤ areaDensity (a + h) - areaDensity a := by simpa only [Pi.add_apply, add_sub_cancel_left] using areaDensity_support a (a + h) variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] {n : ℕ} def areaIncrement (g : E → Fin n → ℝ) (v : Fin n → E) (φ : E → ℝ) (x : E) : ℝ := areaDensity (g x + fun i ↦ fderiv ℝ φ x (v i)) - areaDensity (g x) omit [NormedSpace ℝ E] in theorem areaDensity_continuous (g : E → Fin n → ℝ) (hg : ∀ i, Continuous (fun x ↦ g x i)) : Continuous (fun x ↦ areaDensity (g x)) := by apply Continuous.sqrt exact continuous_const.add (continuous_finsetSum _ fun i _ ↦ (hg i).pow 2) theorem areaIncrement_continuous (g : E → Fin n → ℝ) (v : Fin n → E) {φ : E → ℝ} (hg : ∀ i, Continuous (fun x ↦ g x i)) (hφ : ContDiff ℝ 1 φ) : Continuous (areaIncrement g v φ) := by apply Continuous.sub · apply areaDensity_continuous intro i exact (hg i).add ((hφ.continuous_fderiv (by norm_num)).clm_apply continuous_const) · exact areaDensity_continuous g hg theorem areaIncrement_hasCompactSupport (g : E → Fin n → ℝ) (v : Fin n → E) {φ : E → ℝ} (hcφ : HasCompactSupport φ) : HasCompactSupport (areaIncrement g v φ) := by apply HasCompactSupport.of_support_subset_isCompact hcφ intro x hx by_contra hnot have hd : fderiv ℝ φ x = 0 := fderiv_of_notMem_tsupport ℝ hnot have hz : areaIncrement g v φ x = 0 := by simp only [areaIncrement, hd, zero_apply] change areaDensity (g x + 0) - areaDensity (g x) = 0 simp exact hx hz variable [MeasurableSpace E] [BorelSpace E] [FiniteDimensional ℝ E] {μ : Measure E} [μ.IsAddHaarMeasure] omit [FiniteDimensional ℝ E] in theorem areaIncrement_integrable (g : E → Fin n → ℝ) (v : Fin n → E) {φ : E → ℝ} (hg : ∀ i, Continuous (fun x ↦ g x i)) (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) : Integrable (areaIncrement g v φ) μ := (areaIncrement_continuous g v hg hφ).integrable_of_hasCompactSupport (areaIncrement_hasCompactSupport g v hcφ) end end Source29GraphAreaConvexity /- Component: GraphCalibration.inc -/ namespace Source29GraphCalibration open MeasureTheory MvPolynomial open Source29GraphAreaConvexity open Source29QuarticReuse Source29QuarticReuse.FluxObstruction open scoped BigOperators noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [MeasurableSpace E] [BorelSpace E] [FiniteDimensional ℝ E] {μ : Measure E} [μ.IsAddHaarMeasure] {n : ℕ} /-- A divergence-free normalized field calibrates the convex graph-area functional against every compactly supported C¹ vertical variation. -/ theorem area_minimizing_of_divergence_zero (g : E → Fin n → ℝ) (v : Fin n → E) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdiv : ∀ x, divergence v (normalizedField g) x = 0) {φ : E → ℝ} (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) : 0 ≤ ∫ x, areaIncrement g v φ x ∂μ := by have hF := normalizedField_contDiff hg have hf := testFlux_integrable (μ := μ) v hφ hcφ (fun i ↦ (hF i).continuous) have ha := areaIncrement_integrable (μ := μ) g v (fun i ↦ (hg i).continuous) hφ hcφ have hle : ∫ x, testFlux v φ (normalizedField g) x ∂μ ≤ ∫ x, areaIncrement g v φ x ∂μ := by apply integral_mono hf ha intro x exact areaDensity_add_support (g x) (fun i ↦ fderiv ℝ φ x (v i)) rw [integral_testFlux_eq_zero v hφ hcφ hF hdiv] at hle exact hle theorem polynomial_normalizedGradient_divergence_zero (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (x : Fin n → ℝ) : divergence (fun i ↦ Pi.single i 1) (normalizedField (evaluatedGradient P)) x = 0 := by apply divergence_normalizedField_eq_zero (fun i ↦ Pi.single i 1) (fun i ↦ FluxPolynomial.contDiff_eval (pderiv i P)) intro y change minimalFieldNumerator (fun i ↦ Pi.single i 1) (evaluatedGradient P) y = 0 rw [FluxPolynomial.minimalFieldNumerator_evaluatedGradient] change Source29QuarticReuse.QuarticPolynomialBasics.minimalGraphOperator P = 0 at hmin rw [hmin, map_zero] /-- Every polynomial satisfying the full minimal graph equation minimizes graph area under compactly supported C¹ vertical perturbations. -/ theorem polynomial_graph_area_minimizing (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) {φ : (Fin n → ℝ) → ℝ} (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) : 0 ≤ ∫ x, areaIncrement (evaluatedGradient P) (fun i ↦ Pi.single i 1) φ x := by apply area_minimizing_of_divergence_zero (evaluatedGradient P) (fun i ↦ Pi.single i 1) (fun i ↦ FluxPolynomial.contDiff_eval (pderiv i P)) (polynomial_normalizedGradient_divergence_zero P hmin) hφ hcφ end end Source29GraphCalibration /- Component: TopWeakCalibration.inc -/ namespace Source29TopWeakCalibration open MeasureTheory Filter MvPolynomial open Source29QuarticReuse Source29QuarticReuse.FluxObstruction open Source29QuarticReuse.QuarticPolynomialBasics open Source29QuarticReuse.FluxPolynomial open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem evaluatedGradient_ne_zero_of_eval_ne_zero (p : MvPolynomial (Fin n) ℝ) {d : ℕ} (hh : p.IsHomogeneous d) (hd : 0 < d) {x : Fin n → ℝ} (hx : eval x p ≠ 0) : evaluatedGradient p x ≠ 0 := by intro hz have he := euler_evaluatedGradient p hh x simp only [hz, Pi.zero_apply, mul_zero, Finset.sum_const_zero] at he have hd' : (d : ℝ) ≠ 0 := by exact_mod_cast hd.ne' exact hx ((mul_eq_zero.mp he.symm).resolve_left hd') /-- Polynomial scaling gives almost-everywhere convergence of the regularized gradient directions to the unit gradient direction of the leading term. -/ theorem normalizedGradient_dilates_tendsto_ae (P : MvPolynomial (Fin n) ℝ) (hdeg : 2 ≤ P.totalDegree) : ∀ᵐ x : Fin n → ℝ, ∀ i, Tendsto (fun k ↦ normalizedField (evaluatedGradient P) (dilationRadius k • x) i) atTop (𝓝 (leadingNormalizedField (homogeneousComponent P.totalDegree P) x i)) := by let d := P.totalDegree - 1 have hd : 0 < d := by dsimp [d]; omega have hdegree : d + 1 = P.totalDegree := by dsimp [d]; omega let top := homogeneousComponent (d + 1) P have htop : top.IsHomogeneous (d + 1) := homogeneousComponent_isHomogeneous _ _ have hne : top ≠ 0 := by dsimp [top] rw [hdegree] exact top_homogeneousComponent_ne_zero P (by omega) have hlim : ∀ᵐ x : Fin n → ℝ, ∀ i, Tendsto (fun k ↦ normalizedField (evaluatedGradient P) (dilationRadius k • x) i) atTop (𝓝 (leadingNormalizedField top x i)) := by filter_upwards [mvPolynomial_eval_ne_zero_ae n top hne] with x hx have hgrad : evaluatedGradient top x ≠ 0 := evaluatedGradient_ne_zero_of_eval_ne_zero top htop (by omega) hx intro i apply normalized_ratio_tendsto (r := fun k ↦ (dilationRadius k)⁻¹ ^ d) · intro k exact pow_pos (inv_pos.mpr (dilationRadius_pos k)) d · have hr := (tendsto_inv_atTop_zero.comp dilationRadius_tendsto).pow d simpa only [zero_pow hd.ne', Function.comp_def] using hr · intro j have hpd : (pderiv j P).totalDegree ≤ d := totalDegree_pderiv_le_of_totalDegree_le P j d (by omega) have hh := (eval_dilate_div_pow_tendsto (pderiv j P) hd hpd x).comp dilationRadius_tendsto simpa only [evaluatedGradient, top, pderiv_homogeneousComponent, Function.comp_def, div_eq_mul_inv, inv_pow, mul_comm] using hh · exact hgrad simpa only [top, hdegree] using hlim /-- The leading term inherits a weak divergence-free unit gradient field. Integrability and the zero-flux identity include its critical set by an almost-everywhere limiting argument. -/ theorem top_weak_calibration (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) {φ : (Fin n → ℝ) → ℝ} (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) : Integrable (testFlux (fun i ↦ Pi.single i 1) φ (leadingNormalizedField (homogeneousComponent P.totalDegree P))) ∧ (∫ x, testFlux (fun i ↦ Pi.single i 1) φ (leadingNormalizedField (homogeneousComponent P.totalDegree P)) x) = 0 := by have hg : ∀ i, ContDiff ℝ 1 (fun x ↦ evaluatedGradient P x i) := fun i ↦ contDiff_eval (pderiv i P) have hnorm := normalizedField_contDiff hg let F : ℕ → (Fin n → ℝ) → Fin n → ℝ := fun k x ↦ normalizedField (evaluatedGradient P) (dilationRadius k • x) have hF : ∀ k i, ContDiff ℝ 1 (fun x ↦ F k x i) := by intro k i exact (hnorm i).comp (by fun_prop) have hdiv : ∀ k x, divergence (fun i ↦ Pi.single i 1) (F k) x = 0 := by intro k x change divergence (fun i ↦ Pi.single i 1) (fun y ↦ normalizedField (evaluatedGradient P) (dilationRadius k • y)) x = 0 rw [divergence_dilate _ hnorm, Source29GraphCalibration.polynomial_normalizedGradient_divergence_zero P hmin, mul_zero] have hbound : ∀ k x i, ‖F k x i‖ ≤ 1 := by intro k x i exact normalizedField_norm_le_one _ _ _ have hlim := normalizedGradient_dilates_tendsto_ae P hdeg exact ⟨testFlux_limit_integrable (fun i ↦ Pi.single i 1) hφ hcφ (fun k i ↦ (hF k i).continuous) hbound hlim, integral_testFlux_limit_eq_zero (fun i ↦ Pi.single i 1) hφ hcφ hF hdiv hbound hlim⟩ end end Source29TopWeakCalibration /- Component: VariationConvexity.inc -/ namespace Source29VariationConvexity open MeasureTheory open scoped BigOperators noncomputable section def variationDensity {n : ℕ} (a : Fin n → ℝ) : ℝ := Real.sqrt (∑ i, a i ^ 2) theorem variationDensity_sq {n : ℕ} (a : Fin n → ℝ) : variationDensity a ^ 2 = ∑ i, a i ^ 2 := Real.sq_sqrt (Finset.sum_nonneg fun i _ ↦ sq_nonneg (a i)) theorem variationDensity_pos {n : ℕ} {a : Fin n → ℝ} (ha : a ≠ 0) : 0 < variationDensity a := by apply Real.sqrt_pos.mpr obtain ⟨i, hi⟩ : ∃ i, a i ≠ 0 := by by_contra h apply ha ext i simpa using not_exists.mp h i exact (sq_pos_of_ne_zero hi).trans_le (Finset.single_le_sum (fun j _ ↦ sq_nonneg (a j)) (Finset.mem_univ i)) /-- Convexity of the Euclidean norm, with the zero subgradient chosen at zero. -/ theorem variationDensity_support {n : ℕ} (a b : Fin n → ℝ) : (∑ i, (b i - a i) * (a i / variationDensity a)) ≤ variationDensity b - variationDensity a := by by_cases ha : a = 0 · subst a simp [variationDensity] have hcs := Real.sum_mul_le_sqrt_mul_sqrt Finset.univ a b change (∑ i, a i * b i) ≤ variationDensity a * variationDensity b at hcs have he : (∑ i, (b i - a i) * (a i / variationDensity a)) = ((∑ i, a i * b i) - ∑ i, a i ^ 2) / variationDensity a := by rw [← Finset.sum_sub_distrib, Finset.sum_div] apply Finset.sum_congr rfl intro i _ ring rw [he] apply (div_le_iff₀ (variationDensity_pos ha)).mpr nlinarith [variationDensity_sq a] theorem variationDensity_add_support {n : ℕ} (a h : Fin n → ℝ) : (∑ i, h i * (a i / variationDensity a)) ≤ variationDensity (a + h) - variationDensity a := by simpa only [Pi.add_apply, add_sub_cancel_left] using variationDensity_support a (a + h) variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] {n : ℕ} def variationIncrement (g : E → Fin n → ℝ) (v : Fin n → E) (φ : E → ℝ) (x : E) : ℝ := variationDensity (g x + fun i ↦ fderiv ℝ φ x (v i)) - variationDensity (g x) omit [NormedSpace ℝ E] in theorem variationDensity_continuous (g : E → Fin n → ℝ) (hg : ∀ i, Continuous (fun x ↦ g x i)) : Continuous (fun x ↦ variationDensity (g x)) := by apply Continuous.sqrt exact continuous_finsetSum _ fun i _ ↦ (hg i).pow 2 theorem variationIncrement_continuous (g : E → Fin n → ℝ) (v : Fin n → E) {φ : E → ℝ} (hg : ∀ i, Continuous (fun x ↦ g x i)) (hφ : ContDiff ℝ 1 φ) : Continuous (variationIncrement g v φ) := by apply Continuous.sub · apply variationDensity_continuous intro i exact (hg i).add ((hφ.continuous_fderiv (by norm_num)).clm_apply continuous_const) · exact variationDensity_continuous g hg theorem variationIncrement_hasCompactSupport (g : E → Fin n → ℝ) (v : Fin n → E) {φ : E → ℝ} (hcφ : HasCompactSupport φ) : HasCompactSupport (variationIncrement g v φ) := by apply HasCompactSupport.of_support_subset_isCompact hcφ intro x hx by_contra hnot have hd : fderiv ℝ φ x = 0 := fderiv_of_notMem_tsupport ℝ hnot have hz : variationIncrement g v φ x = 0 := by simp only [variationIncrement, hd, zero_apply] change variationDensity (g x + 0) - variationDensity (g x) = 0 simp exact hx hz variable [MeasurableSpace E] [BorelSpace E] {μ : Measure E} [μ.IsAddHaarMeasure] theorem variationIncrement_integrable (g : E → Fin n → ℝ) (v : Fin n → E) {φ : E → ℝ} (hg : ∀ i, Continuous (fun x ↦ g x i)) (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) : Integrable (variationIncrement g v φ) μ := (variationIncrement_continuous g v hg hφ).integrable_of_hasCompactSupport (variationIncrement_hasCompactSupport g v hcφ) theorem variation_minimizing_of_calibration (g : E → Fin n → ℝ) (v : Fin n → E) (hg : ∀ i, Continuous (fun x ↦ g x i)) {φ : E → ℝ} (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) (hflux : Integrable (fun x ↦ ∑ i, fderiv ℝ φ x (v i) * (g x i / variationDensity (g x))) μ) (hzero : (∫ x, ∑ i, fderiv ℝ φ x (v i) * (g x i / variationDensity (g x)) ∂μ) = 0) : 0 ≤ ∫ x, variationIncrement g v φ x ∂μ := by have hle := integral_mono hflux (variationIncrement_integrable g v hg hφ hcφ) (fun x ↦ variationDensity_add_support (g x) (fun i ↦ fderiv ℝ φ x (v i))) rw [hzero] at hle exact hle end end Source29VariationConvexity /- Component: TopVariationMinimizing.inc -/ namespace Source29TopVariationMinimizing open MeasureTheory MvPolynomial open Source29QuarticReuse Source29QuarticReuse.FluxObstruction open Source29VariationConvexity noncomputable section /-- The leading homogeneous polynomial of an entire polynomial minimal graph minimizes total variation against compactly supported C¹ perturbations. The difference of the two densities is integrable although their separate whole-space integrals need not be finite. -/ theorem top_minimizes_total_variation {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) {φ : (Fin n → ℝ) → ℝ} (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) : Integrable (variationIncrement (evaluatedGradient (homogeneousComponent P.totalDegree P)) (fun i ↦ Pi.single i 1) φ) ∧ 0 ≤ ∫ x, variationIncrement (evaluatedGradient (homogeneousComponent P.totalDegree P)) (fun i ↦ Pi.single i 1) φ x := by have hg : ∀ i, Continuous (fun x ↦ evaluatedGradient (homogeneousComponent P.totalDegree P) x i) := fun i ↦ (FluxPolynomial.contDiff_eval (pderiv i _)).continuous obtain ⟨hi, hz⟩ := Source29TopWeakCalibration.top_weak_calibration P hmin hdeg hφ hcφ exact ⟨variationIncrement_integrable _ _ hg hφ hcφ, variation_minimizing_of_calibration _ _ hg hφ hcφ hi hz⟩ end end Source29TopVariationMinimizing /- Component: LengthNullCoverings.inc -/ /- A direct covering formulation of one-dimensional Hausdorff nullity. No Hausdorff-measure library import or geometric regularity theorem is assumed. -/ namespace Source29LengthNullCoverings open Set MeasureTheory open scoped ENNReal NNReal noncomputable section def HasZeroLengthCoverings {E : Type*} [PseudoMetricSpace E] (s : Set E) : Prop := ∀ ε : ℝ≥0∞, 0 < ε → ∃ (c : ℕ → E) (r : ℕ → ℝ≥0), s ⊆ ⋃ j, Metric.ball (c j) (r j) ∧ (∑' j, (2 : ℝ≥0∞) * r j) < ε theorem HasZeroLengthCoverings.mono {E : Type*} [PseudoMetricSpace E] {s t : Set E} (ht : HasZeroLengthCoverings t) (hst : s ⊆ t) : HasZeroLengthCoverings s := by intro ε hε obtain ⟨c, r, hcover, hsum⟩ := ht ε hε exact ⟨c, r, hst.trans hcover, hsum⟩ /-- A distance-nonincreasing real-valued image of a length-null set has Lebesgue measure zero. This statement also applies to nonmeasurable sets. -/ theorem image_volume_eq_zero {E : Type*} [PseudoMetricSpace E] {s : Set E} (hs : HasZeroLengthCoverings s) {f : E → ℝ} (hf : LipschitzWith 1 f) : volume (f '' s) = 0 := by by_contra hne obtain ⟨c, r, hcover, hsum⟩ := hs (volume (f '' s)) (pos_iff_ne_zero.mpr hne) have hcover' : f '' s ⊆ ⋃ j, Metric.ball (f (c j)) (r j) := by rintro _ ⟨x, hx, rfl⟩ obtain ⟨j, hj⟩ := mem_iUnion.mp (hcover hx) refine mem_iUnion.mpr ⟨j, ?_⟩ change dist (f x) (f (c j)) < (r j : ℝ) have hd := hf.dist_le_mul x (c j) simp only [NNReal.coe_one, one_mul] at hd exact hd.trans_lt hj have hvol : volume (f '' s) ≤ ∑' j, (2 : ℝ≥0∞) * r j := calc volume (f '' s) ≤ volume (⋃ j, Metric.ball (f (c j)) (r j)) := measure_mono hcover' _ ≤ ∑' j, volume (Metric.ball (f (c j)) (r j)) := measure_iUnion_le _ _ = ∑' j, (2 : ℝ≥0∞) * r j := by apply tsum_congr intro j simp [Real.volume_ball, ENNReal.ofReal_mul] exact (not_lt_of_ge hvol) hsum /-- A length-null set in a finite Cartesian space cannot contain an entire line through a nonzero vector. A nonzero coordinate maps that line onto ℝ. -/ theorem no_nonzero_line {n : ℕ} {s : Set (Fin n → ℝ)} (hs : HasZeroLengthCoverings s) {x : Fin n → ℝ} (hx : x ≠ 0) (hline : ∀ a : ℝ, a • x ∈ s) : False := by obtain ⟨i, hi⟩ : ∃ i, x i ≠ 0 := by by_contra h apply hx ext i simpa using not_exists.mp h i have hf : LipschitzWith 1 (fun y : Fin n → ℝ ↦ y i) := by apply LipschitzWith.of_dist_le_mul intro y z simpa only [NNReal.coe_one, one_mul] using dist_le_pi_dist y z i have hv := image_volume_eq_zero hs hf have himage : (fun y : Fin n → ℝ ↦ y i) '' s = univ := by apply eq_univ_of_forall intro a refine ⟨(a / x i) • x, hline _, ?_⟩ change (a / x i) * x i = a exact div_mul_cancel₀ a hi rw [himage, Real.volume_univ] at hv exact ENNReal.top_ne_zero hv end end Source29LengthNullCoverings /- Component: HomogeneousZeroCoverings.inc -/ namespace Source29HomogeneousZeroCoverings open MvPolynomial Source29LengthNullCoverings noncomputable section /-- Nonnegativity becomes strict away from the origin when a homogeneous polynomial's zero set admits arbitrarily short countable ball coverings. -/ theorem positive_away_of_zero_length_coverings {n d : ℕ} (Q : MvPolynomial (Fin n) ℝ) (hh : Q.IsHomogeneous d) (hnonneg : ∀ x, 0 ≤ eval x Q) (hsmall : HasZeroLengthCoverings {x : Fin n → ℝ | eval x Q = 0}) : ∀ x : Fin n → ℝ, x ≠ 0 → 0 < eval x Q := by intro x hx apply lt_of_le_of_ne (hnonneg x) intro hzero apply no_nonzero_line hsmall hx intro a change eval (a • x) Q = 0 rw [Source29QuarticReuse.FluxObstruction.eval_dilate_homogeneous Q hh, hzero.symm, mul_zero] theorem nonnegative_homogeneous_divisor_is_constant (F Q : MvPolynomial (Fin 8) ℝ) (d : ℕ) (hF : F ≠ 0) (hFhom : F.IsHomogeneous d) (hL : Source29FactorInheritance.cubicOperator F = 0) (hQhom : Q.IsHomogeneous Q.totalDegree) (hnonneg : ∀ x, 0 ≤ eval x Q) (hsmall : HasZeroLengthCoverings {x : Fin 8 → ℝ | eval x Q = 0}) (hdiv : Q ∣ F) : Q.totalDegree = 0 := by exact Source29ComplexObstruction.positive_divisor_obstruction F Q d hF hFhom hL hQhom (positive_away_of_zero_length_coverings Q hQhom hnonneg hsmall) hdiv end end Source29HomogeneousZeroCoverings /- Component: RealAnalyticMaximum.inc -/ namespace Source29RealAnalyticMaximum open Filter open scoped Topology noncomputable section lemma second_deriv_of_quadratic_factor (f g : ℝ → ℝ) (hg : AnalyticAt ℝ g 0) (hfg : f =ᶠ[𝓝 (0 : ℝ)] (fun t ↦ t^2 * g t)) : deriv (deriv f) 0 = 2 * g 0 := by let K : ℝ → ℝ := fun t ↦ 2*(t*g t) + t^2*deriv g t have hfirst : deriv f =ᶠ[𝓝 (0 : ℝ)] K := by filter_upwards [hfg.deriv, hg.eventually_analyticAt] with t ht hgt rw [ht] have hd := ((hasDerivAt_id t).pow 2).mul hgt.differentiableAt.hasDerivAt simpa [K, mul_assoc, Pi.mul_def, Pi.pow_def] using hd.deriv have hsecond : HasDerivAt K (2*g 0) 0 := by have h1 := ((hasDerivAt_id (0 : ℝ)).mul hg.differentiableAt.hasDerivAt).const_mul 2 have h2 := ((hasDerivAt_id (0 : ℝ)).pow 2).mul hg.deriv.differentiableAt.hasDerivAt simpa [K, Pi.add_def, Pi.mul_def, Pi.pow_def] using h1.add h2 rw [hfirst.deriv_eq] exact hsecond.deriv theorem quadratic_factor_of_double_zero (f : ℝ → ℝ) (hf : AnalyticAt ℝ f 0) (hf0 : f 0 = 0) (hdf0 : deriv f 0 = 0) : ∃ g : ℝ → ℝ, AnalyticAt ℝ g 0 ∧ f =ᶠ[𝓝 (0 : ℝ)] (fun t ↦ t^2 * g t) := by by_cases hz : f =ᶠ[𝓝 (0 : ℝ)] (fun _ ↦ 0) · exact ⟨fun _ ↦ 0, analyticAt_const, by simpa using hz⟩ obtain ⟨d, g, hg, hg0, hfactor⟩ := hf.exists_eventuallyEq_pow_smul_nonzero_iff.mpr hz have hfactor' : f =ᶠ[𝓝 (0 : ℝ)] (fun t ↦ t^d * g t) := by change ∀ᶠ t in 𝓝 (0 : ℝ), f t = t^d * g t simpa only [sub_zero, smul_eq_mul] using hfactor have hd0 : d ≠ 0 := by intro hd have h := hfactor'.self_of_nhds change f 0 = (0 : ℝ)^d * g 0 at h rw [hd, pow_zero, one_mul, hf0] at h exact hg0 h.symm have hd1 : d ≠ 1 := by intro hd have heq : f =ᶠ[𝓝 (0 : ℝ)] (fun t ↦ t * g t) := by simpa only [hd, pow_one] using hfactor' have hderiv : deriv f 0 = g 0 := by rw [heq.deriv_eq] simpa only [Pi.mul_def, id_eq, zero_mul, one_mul, add_zero] using ((hasDerivAt_id (0 : ℝ)).mul hg.differentiableAt.hasDerivAt).deriv exact hg0 (hderiv.symm.trans hdf0) have hd : 2 ≤ d := by omega refine ⟨fun t ↦ t^(d-2)*g t, (analyticAt_id.pow _).mul hg, ?_⟩ filter_upwards [hfactor'] with t ht rw [ht, ← mul_assoc, ← pow_add, Nat.add_sub_of_le hd] /-- The second derivative of a real analytic function is nonpositive at a local maximum. The proof uses its actual quadratic Taylor factor. -/ theorem second_deriv_nonpos (f : ℝ → ℝ) (hf : AnalyticAt ℝ f 0) (hmax : IsLocalMax f 0) : deriv (deriv f) 0 ≤ 0 := by let F : ℝ → ℝ := fun t ↦ f t - f 0 have hF : AnalyticAt ℝ F 0 := hf.sub analyticAt_const have hF0 : F 0 = 0 := sub_self _ have hFm : IsLocalMax F 0 := by change ∀ᶠ t in 𝓝 (0 : ℝ), F t ≤ F 0 filter_upwards [hmax] with t ht simpa only [F, sub_self, sub_nonpos] using ht obtain ⟨g, hg, hfactor⟩ := quadratic_factor_of_double_zero F hF hF0 hFm.deriv_eq_zero have hle : ∀ᶠ t in 𝓝[>] (0 : ℝ), g t ≤ 0 := by filter_upwards [hfactor.filter_mono nhdsWithin_le_nhds, hFm.filter_mono nhdsWithin_le_nhds, self_mem_nhdsWithin] with t ht hm hp have htpos : 0 < t := hp rw [ht, hF0] at hm exact (mul_le_mul_iff_right₀ (sq_pos_of_pos htpos)).mp (by simpa using hm) have hg0 : g 0 ≤ 0 := le_of_tendsto (hg.continuousAt.tendsto.mono_left nhdsWithin_le_nhds) hle have hsecond := second_deriv_of_quadratic_factor F g hg hfactor have hdF : deriv F = deriv f := by funext t exact deriv_sub_const (f 0) rw [hdF] at hsecond linarith theorem second_deriv_linear_combination (f g : ℝ → ℝ) (hf : AnalyticAt ℝ f 0) (hg : AnalyticAt ℝ g 0) (a b : ℝ) : deriv (deriv (fun t ↦ a * f t - b * g t)) 0 = a * deriv (deriv f) 0 - b * deriv (deriv g) 0 := by have hfirst : deriv (fun t ↦ a*f t-b*g t) =ᶠ[𝓝 (0 : ℝ)] (fun t ↦ a*deriv f t-b*deriv g t) := by filter_upwards [hf.eventually_analyticAt, hg.eventually_analyticAt] with t hft hgt exact ((hft.differentiableAt.hasDerivAt.const_mul a).sub (hgt.differentiableAt.hasDerivAt.const_mul b)).deriv rw [hfirst.deriv_eq] exact ((hf.deriv.differentiableAt.hasDerivAt.const_mul a).sub (hg.deriv.differentiableAt.hasDerivAt.const_mul b)).deriv end end Source29RealAnalyticMaximum /- Component: LocalEigenvalueComparison.inc -/ /- The local analytic comparison behind the compact-link eigenvalue bound. The geometric Simons and Jacobi identities are explicit hypotheses here; they are derived later in RegularLinkSimons for the polynomial's regular link. -/ namespace Source29LocalEigenvalueComparison open Filter open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] /-- Compare a positive Jacobi profile with the curvature norm at a maximum of their quotient. The curves represent orthonormal geodesic directions. -/ theorem eigenvalue_bound_at_ratio_maximum (h φ : ι → ℝ → ℝ) (h0 φ0 V m lam : ℝ) (hh : ∀ i, AnalyticAt ℝ (h i) 0) (hφ : ∀ i, AnalyticAt ℝ (φ i) 0) (hh0 : ∀ i, h i 0 = h0) (hφ0 : ∀ i, φ i 0 = φ0) (hpositive : 0 < h0) (φpositive : 0 < φ0) (hmax : ∀ i, IsLocalMax (fun t ↦ h i t / φ i t) 0) (hSimons : (m - V) * h0 ≤ ∑ i, deriv (deriv (h i)) 0) (hJacobi : (∑ i, deriv (deriv (φ i)) 0) + (V + lam) * φ0 = 0) : lam ≤ -m := by have hi : ∀ i, φ0 * deriv (deriv (h i)) 0 - h0 * deriv (deriv (φ i)) 0 ≤ 0 := by intro i let q : ℝ → ℝ := fun t ↦ φ0 * h i t - h0 * φ i t have hq : AnalyticAt ℝ q 0 := (analyticAt_const.mul (hh i)).sub (analyticAt_const.mul (hφ i)) have hq0 : q 0 = 0 := by simp [q, hh0, hφ0, mul_comm] have hqmax : IsLocalMax q 0 := by have hp : ∀ᶠ t in 𝓝 (0 : ℝ), 0 < φ i t := (hφ i).continuousAt.eventually (eventually_gt_nhds (by simpa [hφ0] using φpositive)) change ∀ᶠ t in 𝓝 (0 : ℝ), q t ≤ q 0 filter_upwards [hmax i, hp] with t ht hpt rw [hh0, hφ0] at ht have hmul := (div_le_div_iff₀ hpt φpositive).mp ht rw [hq0] dsimp [q] nlinarith have hs := Source29RealAnalyticMaximum.second_deriv_nonpos q hq hqmax change deriv (deriv (fun t ↦ φ0 * h i t - h0 * φ i t)) 0 ≤ 0 at hs rw [Source29RealAnalyticMaximum.second_deriv_linear_combination (h i) (φ i) (hh i) (hφ i)] at hs exact hs have hsum : φ0 * (∑ i, deriv (deriv (h i)) 0) - h0 * (∑ i, deriv (deriv (φ i)) 0) ≤ 0 := by have hs := Finset.sum_nonpos (s := Finset.univ) (fun i _ ↦ hi i) simpa only [Finset.sum_sub_distrib, ← Finset.mul_sum] using hs have hweighted := mul_le_mul_of_nonneg_left hSimons φpositive.le have hidentity := congrArg (fun t : ℝ ↦ h0 * t) hJacobi have hproduct : (m + lam) * (h0 * φ0) ≤ 0 := by nlinarith have h : m + lam ≤ 0 := (mul_le_mul_iff_left₀ (mul_pos hpositive φpositive)).mp (by simpa using hproduct) linarith /-- Compactness supplies the quotient maximum. This version uses actual analytic test curves on the compact set, so no spectral existence theorem is needed after the indicated geometric differential inequalities are proved. -/ theorem eigenvalue_bound_on_compact_set {E : Type*} [TopologicalSpace E] (s : Set E) (hs : IsCompact s) (h φ V : E → ℝ) (m lam : ℝ) (hc : ContinuousOn h s) (φc : ContinuousOn φ s) (φpos : ∀ x ∈ s, 0 < φ x) (hpos : ∃ x ∈ s, 0 < h x) (curve : E → ι → ℝ → E) (curve0 : ∀ x ∈ s, ∀ i, curve x i 0 = x) (curve_mem : ∀ x ∈ s, ∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), curve x i t ∈ s) (ha : ∀ x ∈ s, 0 < h x → ∀ i, AnalyticAt ℝ (fun t ↦ h (curve x i t)) 0) (φa : ∀ x ∈ s, ∀ i, AnalyticAt ℝ (fun t ↦ φ (curve x i t)) 0) (hSimons : ∀ x ∈ s, 0 < h x → (m - V x) * h x ≤ ∑ i, deriv (deriv (fun t ↦ h (curve x i t))) 0) (hJacobi : ∀ x ∈ s, (∑ i, deriv (deriv (fun t ↦ φ (curve x i t))) 0) + (V x + lam) * φ x = 0) : lam ≤ -m := by obtain ⟨b, hb, hpb⟩ := hpos have hrc : ContinuousOn (fun x ↦ h x / φ x) s := hc.div φc (fun x hx ↦ (φpos x hx).ne') obtain ⟨a, hsa, hmax⟩ := hs.exists_isMaxOn ⟨b, hb⟩ hrc have hratio : 0 < h a / φ a := (div_pos hpb (φpos b hb)).trans_le (hmax hb) have hpa : 0 < h a := by have hh := (lt_div_iff₀ (φpos a hsa)).mp hratio simpa using hh apply eigenvalue_bound_at_ratio_maximum (fun i t ↦ h (curve a i t)) (fun i t ↦ φ (curve a i t)) (h a) (φ a) (V a) m lam (ha a hsa hpa) (φa a hsa) (fun i ↦ congrArg h (curve0 a hsa i)) (fun i ↦ congrArg φ (curve0 a hsa i)) hpa (φpos a hsa) _ (hSimons a hsa hpa) (hJacobi a hsa) intro i change ∀ᶠ t in 𝓝 (0 : ℝ), h (curve a i t) / φ (curve a i t) ≤ h (curve a i 0) / φ (curve a i 0) filter_upwards [curve_mem a hsa i] with t ht simpa only [curve0 a hsa i, Set.mem_setOf_eq] using hmax ht /-- In dimension eight the comparison constant is six. Substituting the homogeneity exponent gives the closed degree interval [3,4]. -/ theorem degree_interval_eight (D lam : ℝ) (hlam : lam = (D - 1)^2 - 5*(D - 1)) (hbound : lam ≤ -(6 : ℝ)) : 3 ≤ D ∧ D ≤ 4 := by constructor · nlinarith [sq_nonneg (D - 3)] · nlinarith [sq_nonneg (D - 4)] end end Source29LocalEigenvalueComparison /- Component: SimonsNormAlgebra.inc -/ /- Algebra converting the tensor Simons identity to the scalar inequality. The tensor identity and the norm differentiation identities remain inputs. -/ namespace Source29SimonsNormAlgebra open scoped BigOperators noncomputable section variable {ι κ : Type*} [Fintype ι] [Fintype κ] /-- Cauchy--Schwarz bounds the derivative of a positive tensor norm. -/ theorem norm_derivative_sq_le (A B : κ → ℝ) (h dh : ℝ) (hh : 0 < h) (hnorm : h^2 = ∑ j, A j^2) (hfirst : h * dh = ∑ j, A j * B j) : dh^2 ≤ ∑ j, B j^2 := by have hc := Finset.sum_mul_sq_le_sq_mul_sq Finset.univ A B rw [← hfirst, ← hnorm, mul_pow] at hc exact (mul_le_mul_iff_right₀ (sq_pos_of_pos hh)).mp hc /-- Given the tensor Laplacian equation and differentiated norm identities, the tensor norm satisfies the scalar Simons inequality at a positive point. -/ theorem scalar_simons_inequality (A : κ → ℝ) (dA ddA : ι → κ → ℝ) (dh ddh : ι → ℝ) (h m : ℝ) (hh : 0 < h) (hnorm : h^2 = ∑ j, A j^2) (hfirst : ∀ i, h * dh i = ∑ j, A j * dA i j) (hsecond : ∀ i, h * ddh i + (dh i)^2 = (∑ j, (dA i j)^2) + ∑ j, A j * ddA i j) (htensor : ∀ j, (∑ i, ddA i j) = (m - h^2) * A j) : (m - h^2) * h ≤ ∑ i, ddh i := by have hk : (∑ i, (dh i)^2) ≤ ∑ i, ∑ j, (dA i j)^2 := by apply Finset.sum_le_sum intro i _ exact norm_derivative_sq_le A (dA i) h (dh i) hh hnorm (hfirst i) have hC : (∑ i, ∑ j, A j * ddA i j) = (m - h^2) * h^2 := by rw [Finset.sum_comm] simp_rw [← Finset.mul_sum, htensor] calc (∑ j, A j * ((m - h^2) * A j)) = (m - h^2) * ∑ j, A j^2 := by rw [Finset.mul_sum] apply Finset.sum_congr rfl intro j _ ring _ = (m - h^2) * h^2 := by rw [← hnorm] have heq : h * (∑ i, ddh i) + (∑ i, (dh i)^2) = (∑ i, ∑ j, (dA i j)^2) + (m - h^2) * h^2 := by have hs := Finset.sum_congr (s₁ := Finset.univ) rfl (fun i _ ↦ hsecond i) simpa only [Finset.sum_add_distrib, ← Finset.mul_sum, hC] using hs apply (mul_le_mul_iff_right₀ hh).mp nlinarith end end Source29SimonsNormAlgebra /- Component: AnalyticNormDerivatives.inc -/ namespace Source29AnalyticNormDerivatives open Filter open scoped Topology BigOperators noncomputable section theorem first_deriv_square (f : ℝ → ℝ) (hf : AnalyticAt ℝ f 0) : deriv (fun t ↦ (f t)^2) 0 = 2 * f 0 * deriv f 0 := by simpa [Pi.pow_def] using (hf.differentiableAt.hasDerivAt.pow 2).deriv theorem second_deriv_square (f : ℝ → ℝ) (hf : AnalyticAt ℝ f 0) : deriv (deriv (fun t ↦ (f t)^2)) 0 = 2 * (deriv f 0)^2 + 2 * f 0 * deriv (deriv f) 0 := by have hfirst : deriv (fun t ↦ (f t)^2) =ᶠ[𝓝 (0 : ℝ)] (fun t ↦ 2 * f t * deriv f t) := by filter_upwards [hf.eventually_analyticAt] with t ht simpa [Pi.pow_def] using (ht.differentiableAt.hasDerivAt.pow 2).deriv rw [hfirst.deriv_eq] have hd := ((hf.differentiableAt.hasDerivAt.const_mul 2).mul hf.deriv.differentiableAt.hasDerivAt).deriv convert hd using 1 <;> ring variable {κ : Type*} [Fintype κ] theorem first_deriv_sum (f : κ → ℝ → ℝ) (hf : ∀ j, AnalyticAt ℝ (f j) 0) : deriv (fun t ↦ ∑ j, f j t) 0 = ∑ j, deriv (f j) 0 := by exact (HasDerivAt.fun_sum (fun j _ ↦ (hf j).differentiableAt.hasDerivAt)).deriv theorem second_deriv_sum (f : κ → ℝ → ℝ) (hf : ∀ j, AnalyticAt ℝ (f j) 0) : deriv (deriv (fun t ↦ ∑ j, f j t)) 0 = ∑ j, deriv (deriv (f j)) 0 := by have hnear : ∀ᶠ t in 𝓝 (0 : ℝ), ∀ j, AnalyticAt ℝ (f j) t := Filter.eventually_all.mpr (fun j ↦ (hf j).eventually_analyticAt) have hfirst : deriv (fun t ↦ ∑ j, f j t) =ᶠ[𝓝 (0 : ℝ)] (fun t ↦ ∑ j, deriv (f j) t) := by filter_upwards [hnear] with t ht exact (HasDerivAt.fun_sum (fun j _ ↦ (ht j).differentiableAt.hasDerivAt)).deriv rw [hfirst.deriv_eq] exact (HasDerivAt.fun_sum (fun j _ ↦ (hf j).deriv.differentiableAt.hasDerivAt)).deriv /-- Differentiate an actual local squared-norm identity twice. -/ theorem norm_first_second (h : ℝ → ℝ) (A : κ → ℝ → ℝ) (hh : AnalyticAt ℝ h 0) (hA : ∀ j, AnalyticAt ℝ (A j) 0) (hnorm : (fun t ↦ (h t)^2) =ᶠ[𝓝 (0 : ℝ)] (fun t ↦ ∑ j, (A j t)^2)) : h 0 * deriv h 0 = (∑ j, A j 0 * deriv (A j) 0) ∧ h 0 * deriv (deriv h) 0 + (deriv h 0)^2 = (∑ j, (deriv (A j) 0)^2) + ∑ j, A j 0 * deriv (deriv (A j)) 0 := by have hsq : ∀ j, AnalyticAt ℝ (fun t ↦ (A j t)^2) 0 := fun j ↦ (hA j).pow 2 have hfirst := hnorm.deriv_eq rw [first_deriv_square h hh, first_deriv_sum _ hsq] at hfirst simp_rw [first_deriv_square _ (hA _)] at hfirst have hsecond := hnorm.deriv.deriv_eq rw [second_deriv_square h hh, second_deriv_sum _ hsq] at hsecond simp_rw [second_deriv_square _ (hA _)] at hsecond have hm : (∑ j, 2 * A j 0 * deriv (A j) 0) = 2 * ∑ j, A j 0 * deriv (A j) 0 := by simp only [Finset.mul_sum, mul_assoc] have hm2 : (∑ j, (2 * (deriv (A j) 0)^2 + 2 * A j 0 * deriv (deriv (A j)) 0)) = 2 * (∑ j, (deriv (A j) 0)^2) + 2 * ∑ j, A j 0 * deriv (deriv (A j)) 0 := by simp only [Finset.sum_add_distrib, Finset.mul_sum, mul_assoc] rw [hm] at hfirst rw [hm2] at hsecond constructor <;> linarith variable {ι : Type*} [Fintype ι] /-- For analytic component curves, the scalar Simons inequality follows from the tensor trace equation and the local norm identity. -/ theorem scalar_simons_of_analytic_components (A : ι → κ → ℝ → ℝ) (h : ι → ℝ → ℝ) (A0 : κ → ℝ) (h0 m : ℝ) (hh : ∀ i, AnalyticAt ℝ (h i) 0) (hA : ∀ i j, AnalyticAt ℝ (A i j) 0) (hh0 : ∀ i, h i 0 = h0) (hA0 : ∀ i j, A i j 0 = A0 j) (hpos : 0 < h0) (hzero : h0^2 = ∑ j, (A0 j)^2) (hnorm : ∀ i, (fun t ↦ (h i t)^2) =ᶠ[𝓝 (0 : ℝ)] (fun t ↦ ∑ j, (A i j t)^2)) (htensor : ∀ j, (∑ i, deriv (deriv (A i j)) 0) = (m - h0^2) * A0 j) : (m - h0^2) * h0 ≤ ∑ i, deriv (deriv (h i)) 0 := by apply Source29SimonsNormAlgebra.scalar_simons_inequality A0 (fun i j ↦ deriv (A i j) 0) (fun i j ↦ deriv (deriv (A i j)) 0) (fun i ↦ deriv (h i) 0) (fun i ↦ deriv (deriv (h i)) 0) h0 m hpos hzero · intro i simpa only [hh0, hA0] using (norm_first_second (h i) (A i) (hh i) (hA i) (hnorm i)).1 · intro i simpa only [hh0, hA0] using (norm_first_second (h i) (A i) (hh i) (hA i) (hnorm i)).2 · exact htensor end end Source29AnalyticNormDerivatives /- Component: RealAnalyticSqrt.inc -/ /- The two local inverse lemmas are adapted to ℝ from Mathlib/Analysis/Calculus/InverseFunctionTheorem/Analytic.lean. Copyright (c) 2025 David Loeffler. Released under Apache 2.0. The full license is included in the reused QuarticReuse component. -/ namespace Source29RealAnalyticSqrt open Filter open scoped Topology noncomputable section theorem local_inverse_analytic {f : ℝ → ℝ} {x : ℝ} (hf : AnalyticAt ℝ f x) (hf' : deriv f x ≠ 0) : AnalyticAt ℝ (hf.hasStrictDerivAt.localInverse _ _ _ hf') (f x) := by let i : ℝ ≃L[ℝ] ℝ := .unitsEquivAut ℝ (.mk0 _ hf') have hfd : HasStrictFDerivAt f i.toContinuousLinearMap x := hf.hasStrictDerivAt let R : OpenPartialHomeomorph ℝ ℝ := hfd.toOpenPartialHomeomorph _ have hx : x ∈ R.source := HasStrictFDerivAt.mem_toOpenPartialHomeomorph_source _ refine R.hasFPowerSeriesAt_symm hx hf.hasFPowerSeriesAt (i := i) ?_ |>.analyticAt ext simp [i] theorem analytic_comp_iff {f g : ℝ → ℝ} {x : ℝ} (hf : AnalyticAt ℝ f x) (hf' : deriv f x ≠ 0) : AnalyticAt ℝ (g ∘ f) x ↔ AnalyticAt ℝ g (f x) := by refine ⟨fun hg ↦ ?_, (AnalyticAt.comp · hf)⟩ let r := hf.hasStrictDerivAt.localInverse _ _ _ hf' have hra : AnalyticAt ℝ r (f x) := local_inverse_analytic hf hf' have hr : r (f x) = x := HasStrictFDerivAt.localInverse_apply_image .. rw [← hr] at hg exact (hg.comp hra).congr <| .fun_comp (HasStrictFDerivAt.eventually_right_inverse ..) g /-- The positive real square root is real analytic on the positive axis. -/ theorem sqrt_analyticAt {a : ℝ} (ha : 0 < a) : AnalyticAt ℝ Real.sqrt a := by let b := Real.sqrt a have hb : 0 < b := Real.sqrt_pos.mpr ha have hb2 : b^2 = a := Real.sq_sqrt ha.le have hs : AnalyticAt ℝ (fun t : ℝ ↦ t^2) b := analyticAt_id.pow 2 have hd : deriv (fun t : ℝ ↦ t^2) b ≠ 0 := by have he : deriv (fun t : ℝ ↦ t^2) b = 2*b := by simpa using ((hasDerivAt_id b).pow 2).deriv rw [he] positivity have heq : (id : ℝ → ℝ) =ᶠ[𝓝 b] (Real.sqrt ∘ fun t : ℝ ↦ t^2) := by filter_upwards [eventually_gt_nhds hb] with t ht exact (Real.sqrt_sq ht.le).symm have hc : AnalyticAt ℝ (Real.sqrt ∘ fun t : ℝ ↦ t^2) b := analyticAt_id.congr heq have hroot := (analytic_comp_iff hs hd).mp hc rwa [hb2] at hroot theorem sqrt_comp_analyticAt {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] {f : E → ℝ} {x : E} (hf : AnalyticAt ℝ f x) (hpos : 0 < f x) : AnalyticAt ℝ (fun y ↦ Real.sqrt (f y)) x := (sqrt_analyticAt hpos).comp hf end end Source29RealAnalyticSqrt /- Component: AnalyticTensorNorm.inc -/ namespace Source29AnalyticTensorNorm open Filter open scoped Topology BigOperators noncomputable section variable {κ : Type*} [Fintype κ] def tensorNorm (a : κ → ℝ) : ℝ := Real.sqrt (∑ j, (a j)^2) theorem tensorNorm_sq (a : κ → ℝ) : (tensorNorm a)^2 = ∑ j, (a j)^2 := Real.sq_sqrt (Finset.sum_nonneg fun j _ ↦ sq_nonneg (a j)) theorem tensorNorm_pos {a : κ → ℝ} (ha : a ≠ 0) : 0 < tensorNorm a := by apply Real.sqrt_pos.mpr obtain ⟨j, hj⟩ : ∃ j, a j ≠ 0 := by by_contra h apply ha ext j simpa using not_exists.mp h j exact (sq_pos_of_ne_zero hj).trans_le (Finset.single_le_sum (fun k _ ↦ sq_nonneg (a k)) (Finset.mem_univ j)) theorem tensorNorm_analyticAt {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] (A : E → κ → ℝ) (x : E) (hA : ∀ j, AnalyticAt ℝ (fun y ↦ A y j) x) (hpos : A x ≠ 0) : AnalyticAt ℝ (fun y ↦ tensorNorm (A y)) x := by have hs : AnalyticAt ℝ (fun y ↦ ∑ j, (A y j)^2) x := by convert Finset.analyticAt_sum Finset.univ (fun j _ ↦ (hA j).pow 2) using 1 ext y simp only [Finset.sum_apply, Pi.pow_apply] apply Source29RealAnalyticSqrt.sqrt_comp_analyticAt hs rw [← tensorNorm_sq] exact sq_pos_of_pos (tensorNorm_pos hpos) variable {ι : Type*} [Fintype ι] /-- The scalar curvature inequality for the actual tensor norm along analytic component curves. Only the tensor trace equation is assumed. -/ theorem scalar_simons_for_tensor_norm (A : ι → κ → ℝ → ℝ) (A0 : κ → ℝ) (m : ℝ) (hA : ∀ i j, AnalyticAt ℝ (A i j) 0) (hA0 : ∀ i j, A i j 0 = A0 j) (hne : A0 ≠ 0) (htensor : ∀ j, (∑ i, deriv (deriv (A i j)) 0) = (m - (tensorNorm A0)^2) * A0 j) : (m - (tensorNorm A0)^2) * tensorNorm A0 ≤ ∑ i, deriv (deriv (fun t ↦ tensorNorm (fun j ↦ A i j t))) 0 := by have hinit : ∀ i, (fun j ↦ A i j 0) = A0 := by intro i funext j exact hA0 i j apply Source29AnalyticNormDerivatives.scalar_simons_of_analytic_components A (fun i t ↦ tensorNorm (fun j ↦ A i j t)) A0 (tensorNorm A0) m · intro i apply tensorNorm_analyticAt (fun t j ↦ A i j t) 0 (hA i) simpa only [hinit] using hne · exact hA · intro i rw [hinit] · exact hA0 · exact tensorNorm_pos hne · exact tensorNorm_sq A0 · intro i exact Filter.Eventually.of_forall (fun t ↦ tensorNorm_sq (fun j ↦ A i j t)) · exact htensor end end Source29AnalyticTensorNorm /- Component: GaussSimonsAlgebra.inc -/ /- Contraction of the Gauss and Codazzi identities for a trace-free second fundamental form. Realizing these arrays geometrically remains a separate obligation. -/ namespace Source29GaussSimonsAlgebra open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def delta (i j : ι) : ℝ := if i = j then 1 else 0 def gaussTensor (A : ι → ι → ℝ) (a b c d : ι) : ℝ := delta a c * delta b d - delta a d * delta b c + A a c * A b d - A a d * A b c def normSq (A : ι → ι → ℝ) : ℝ := ∑ k, ∑ l, (A k l)^2 theorem gauss_contraction (A : ι → ι → ℝ) (hA : ∀ i j, A i j = A j i) (htrace : (∑ k, A k k) = 0) (i j : ι) : (∑ k, ∑ l, (A l j * gaussTensor A l k i k + A k l * gaussTensor A l j i k)) = ((Fintype.card ι : ℝ) - normSq A) * A i j := by have hsphere : (∑ k, ∑ l, (A l j * (delta l i * delta k k - delta l k * delta k i) + A k l * (delta l i * delta j k - delta l k * delta j i))) = (Fintype.card ι : ℝ) * A i j := by simp only [delta, if_true, mul_one, mul_sub, Finset.sum_add_distrib, Finset.sum_sub_distrib, mul_ite, ite_mul, mul_zero, Finset.sum_ite_eq, Finset.sum_ite_eq', Finset.mem_univ] simp only [if_true, Finset.sum_const, Finset.card_univ, nsmul_eq_mul] simp only [Finset.sum_ite_irrel, Finset.sum_ite_eq, Finset.sum_ite_eq', Finset.mem_univ, ite_true, htrace, Finset.sum_const_zero, ite_self, sub_zero] rw [hA j i] ring have htraceTerm : (∑ k, ∑ l, A l j * (A l i * A k k)) = 0 := by have he : ∀ k l, A l j * (A l i * A k k) = A k k * (A l i * A l j) := by intro k l ring simp_rw [he, ← Finset.mul_sum] rw [← Finset.sum_mul, htrace, zero_mul] have hcross : (∑ k, ∑ l, A l j * (A l k * A k i)) = ∑ k, ∑ l, A k l * (A l i * A j k) := by conv_rhs => rw [Finset.sum_comm] apply Finset.sum_congr rfl intro k _ apply Finset.sum_congr rfl intro l _ rw [hA j l] ring have hnormTerm : (∑ k, ∑ l, A k l * (A l k * A j i)) = normSq A * A i j := by have he : ∀ k l, A k l * (A l k * A j i) = (A k l)^2 * A i j := by intro k l rw [hA l k, hA j i] ring simp_rw [he] simp only [normSq, Finset.sum_mul] have hexpand : (∑ k, ∑ l, (A l j * gaussTensor A l k i k + A k l * gaussTensor A l j i k)) = (∑ k, ∑ l, (A l j * (delta l i * delta k k - delta l k * delta k i) + A k l * (delta l i * delta j k - delta l k * delta j i))) + (∑ k, ∑ l, A l j * (A l i * A k k)) - (∑ k, ∑ l, A l j * (A l k * A k i)) + (∑ k, ∑ l, A k l * (A l i * A j k)) - (∑ k, ∑ l, A k l * (A l k * A j i)) := by simp only [gaussTensor, mul_add, mul_sub, Finset.sum_add_distrib, Finset.sum_sub_distrib] ring rw [hexpand, hsphere, htraceTerm, hcross, hnormTerm] ring /-- Tensor Simons identity obtained by commuting derivatives and contracting the Gauss curvature formula. The index order is A_{ab;cd}. -/ theorem simons_of_gauss_codazzi (A : ι → ι → ℝ) (D : ι → ι → ι → ι → ℝ) (hA : ∀ i j, A i j = A j i) (htrace : (∑ k, A k k) = 0) (hSym : ∀ a b c d, D a b c d = D b a c d) (hCodazzi : ∀ a b c d, D a b c d = D c b a d) (hTraceD : ∀ c d, (∑ k, D k k c d) = 0) (hComm : ∀ a b c d, D a b c d - D a b d c = ∑ l, (A l b * gaussTensor A l a c d + A a l * gaussTensor A l b c d)) (i j : ι) : (∑ k, D i j k k) = ((Fintype.card ι : ℝ) - normSq A) * A i j := by have he : ∀ k, D i j k k = D k k j i + ∑ l, (A l j * gaussTensor A l k i k + A k l * gaussTensor A l j i k) := by intro k have hc := hComm k j i k rw [← hCodazzi i j k k, hSym k j k i, hCodazzi j k k i] at hc linarith simp_rw [he] rw [Finset.sum_add_distrib, hTraceD, zero_add] exact gauss_contraction A hA htrace i j end end Source29GaussSimonsAlgebra /- Component: AnalyticInverseNorm.inc -/ namespace Source29AnalyticInverseNorm open Filter open scoped Topology BigOperators noncomputable section theorem second_deriv_product (f g : ℝ → ℝ) (hf : AnalyticAt ℝ f 0) (hg : AnalyticAt ℝ g 0) : deriv (deriv (fun t ↦ f t * g t)) 0 = deriv (deriv f) 0 * g 0 + 2 * deriv f 0 * deriv g 0 + f 0 * deriv (deriv g) 0 := by have he : deriv (fun t ↦ f t * g t) =ᶠ[𝓝 (0 : ℝ)] (fun t ↦ deriv f t * g t + f t * deriv g t) := by filter_upwards [hf.eventually_analyticAt, hg.eventually_analyticAt] with t hft hgt exact (hft.differentiableAt.hasDerivAt.mul hgt.differentiableAt.hasDerivAt).deriv rw [he.deriv_eq] have hd := ((hf.deriv.differentiableAt.hasDerivAt.mul hg.differentiableAt.hasDerivAt).add (hf.differentiableAt.hasDerivAt.mul hg.deriv.differentiableAt.hasDerivAt)).deriv convert hd using 1 <;> ring /-- The second derivative of the reciprocal of an actual analytic norm curve. -/ theorem second_deriv_inv (f : ℝ → ℝ) (hf : AnalyticAt ℝ f 0) (hne : f 0 ≠ 0) : deriv (deriv (fun t ↦ (f t)⁻¹)) 0 = (2 * (deriv f 0)^2 - f 0 * deriv (deriv f) 0) / (f 0)^3 := by let g : ℝ → ℝ := fun t ↦ (f t)⁻¹ have hg : AnalyticAt ℝ g 0 := hf.inv hne have he : (fun t ↦ f t * g t) =ᶠ[𝓝 (0 : ℝ)] (fun _ ↦ (1 : ℝ)) := by filter_upwards [hf.continuousAt.eventually_ne hne] with t ht exact mul_inv_cancel₀ ht have hd : deriv g 0 = -deriv f 0 / (f 0)^2 := by exact (hf.differentiableAt.hasDerivAt.inv hne).deriv have hsecond := he.deriv.deriv_eq rw [second_deriv_product f g hf hg] at hsecond simp only [deriv_const', deriv_const] at hsecond rw [hd] at hsecond change deriv (deriv f) 0 * (f 0)⁻¹ + 2 * deriv f 0 * (-deriv f 0 / (f 0)^2) + f 0 * deriv (deriv g) 0 = 0 at hsecond change deriv (deriv g) 0 = _ field_simp [hne] at hsecond ⊢ nlinarith end end Source29AnalyticInverseNorm /- Component: PolynomialNormalTrace.inc -/ namespace Source29PolynomialNormalTrace open MvPolynomial Source29FactorInheritance open Source29QuarticReuse.QuarticPolynomialBasics (second_partial_comm) open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] /-- In coordinates with gradient along the distinguished normal, Lp=0 forces the tangential Hessian trace to vanish. -/ theorem tangential_trace_zero (P : MvPolynomial (Option ι) ℝ) (x : Option ι → ℝ) (g : ℝ) (hg : g ≠ 0) (hL : cubicOperator P = 0) (hgn : eval x (pderiv none P) = g) (hgt : ∀ i, eval x (pderiv (some i) P) = 0) : (∑ i, eval x (pderiv (some i) (pderiv (some i) P))) = 0 := by have he := congrArg (eval x) hL simp [cubicOperator, Fintype.sum_option, hgn, hgt] at he have hh : g^2 * (∑ i, eval x (pderiv (some i) (pderiv (some i) P))) = 0 := by nlinarith [he] exact (mul_eq_zero.mp hh).resolve_left (pow_ne_zero _ hg) /-- Differentiating the polynomial equation in the normal direction gives the third-derivative trace used by the Jacobi profile. -/ theorem normal_derivative_trace (P : MvPolynomial (Option ι) ℝ) (x : Option ι → ℝ) (g : ℝ) (hg : g ≠ 0) (hL : cubicOperator P = 0) (hgn : eval x (pderiv none P) = g) (hgt : ∀ i, eval x (pderiv (some i) P) = 0) : g * (∑ i, eval x (pderiv none (pderiv (some i) (pderiv (some i) P)))) = 2 * (∑ i, (eval x (pderiv none (pderiv (some i) P)))^2) := by have htrace := tangential_trace_zero P x g hg hL hgn hgt have hsym : ∀ i, eval x (pderiv (some i) (pderiv none P)) = eval x (pderiv none (pderiv (some i) P)) := by intro i rw [second_partial_comm] have he := congrArg (eval x) (congrArg (pderiv none) hL) simp [cubicOperator, pderiv_mul, pderiv_pow, Fintype.sum_option, hgn, hgt, hsym, htrace] at he have hsquare : ∀ i, eval x (pderiv none (pderiv (some i) P)) * (g * eval x (pderiv none (pderiv (some i) P))) = g * (eval x (pderiv none (pderiv (some i) P)))^2 := by intro i ring simp_rw [hsquare, ← Finset.mul_sum] at he have hh : g * (g * (∑ i, eval x (pderiv none (pderiv (some i) (pderiv (some i) P)))) - 2 * (∑ i, (eval x (pderiv none (pderiv (some i) P)))^2)) = 0 := by nlinarith [he] exact sub_eq_zero.mp ((mul_eq_zero.mp hh).resolve_left hg) end end Source29PolynomialNormalTrace /- Component: HomogeneousRadialJets.inc -/ namespace Source29HomogeneousRadialJets open MvPolynomial open Source29QuarticReuse.QuarticPolynomialBasics open Source29QuarticReuse.QuarticCompatibility open scoped BigOperators noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] theorem radial_hessian (P : MvPolynomial κ ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 1 ≤ d) (x : κ → ℝ) (j : κ) : (∑ i, x i * eval x (pderiv i (pderiv j P))) = ((d : ℝ)-1) * eval x (pderiv j P) := by have he := evalFDeriv_self_of_isHomogeneous (pderiv j P) (d-1) (homogeneous_pderiv hP) x simpa only [evalFDeriv_apply, mul_comm, Nat.cast_sub hd, Nat.cast_one] using he theorem radial_third_derivative (P : MvPolynomial κ ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 2 ≤ d) (x : κ → ℝ) (j k : κ) : (∑ i, x i * eval x (pderiv i (pderiv j (pderiv k P)))) = ((d : ℝ)-2) * eval x (pderiv j (pderiv k P)) := by have he := evalFDeriv_self_of_isHomogeneous (pderiv j (pderiv k P)) ((d-1)-1) (homogeneous_pderiv (homogeneous_pderiv hP)) x have heq : d-1-1 = d-2 := by omega rw [heq] at he simpa only [evalFDeriv_apply, mul_comm, Nat.cast_sub hd, Nat.cast_ofNat] using he /-- Euler's identities in a frame whose radial vector is a coordinate vector. -/ theorem radial_coordinate_jets (P : MvPolynomial κ ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 2 ≤ d) (r n : κ) : eval (Pi.single r 1) (pderiv r (pderiv n P)) = ((d : ℝ)-1) * eval (Pi.single r 1) (pderiv n P) ∧ eval (Pi.single r 1) (pderiv r (pderiv r (pderiv n P))) = ((d : ℝ)-2)*((d : ℝ)-1) * eval (Pi.single r 1) (pderiv n P) := by have h1 := radial_hessian P d hP (by omega) (Pi.single r 1) n have h2 := radial_third_derivative P d hP hd (Pi.single r 1) r n simp only [Pi.single_apply, ite_mul, one_mul, zero_mul, Finset.sum_ite_eq', Finset.mem_univ, ite_true] at h1 h2 exact ⟨h1, by rw [h1] at h2; simpa only [mul_assoc] using h2⟩ end end Source29HomogeneousRadialJets /- Component: JacobiProfileJets.inc -/ namespace Source29JacobiProfileJets open Filter open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] /-- The normal derivative of Lp=0 and the radial Euler identities yield Jacobi's equation for the inverse gradient norm. Here the scalar norm jets are supplied explicitly; the conclusion uses actual derivatives. -/ theorem jacobi_from_norm_jets (h : ι → ℝ → ℝ) (g D b : ℝ) (v q a T : ι → ℝ) (hg : 0 < g) (hh : ∀ i, AnalyticAt ℝ (h i) 0) (hh0 : ∀ i, h i 0 = g) (hh1 : ∀ i, deriv (h i) 0 = v i) (hh2 : ∀ i, g * deriv (deriv (h i)) 0 = q i + g*T i - (D-1)*g^2 - b*a i) (ha : (∑ i, a i) = 0) (hT : g * (∑ i, T i) = 2*(∑ i, (v i)^2) + D*(D-1)*g^2) : (∑ i, deriv (deriv (fun t ↦ (h i t)⁻¹)) 0) + ((∑ i, q i)/g^2 + (D-1)*(D-(Fintype.card ι : ℝ))) * g⁻¹ = 0 := by have hne : g ≠ 0 := hg.ne' have hi : ∀ i, g^3 * deriv (deriv (fun t ↦ (h i t)⁻¹)) 0 = 2*(v i)^2 - q i - g*T i + (D-1)*g^2 + b*a i := by intro i rw [Source29AnalyticInverseNorm.second_deriv_inv (h i) (hh i) (by simpa only [hh0] using hne), hh0, hh1] rw [mul_div_cancel₀ _ (pow_ne_zero 3 hne)] rw [hh2] ring have hs := congrArg (fun z : ι → ℝ ↦ ∑ i, z i) (funext hi) simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib, ← Finset.mul_sum, Finset.sum_const, Finset.card_univ, nsmul_eq_mul, ha, mul_zero, add_zero, hT] at hs apply (mul_eq_zero.mp (show g^3 * ((∑ i, deriv (deriv (fun t ↦ (h i t)⁻¹)) 0) + ((∑ i, q i)/g^2 + (D-1)*(D-(Fintype.card ι : ℝ))) * g⁻¹) = 0 from ?_)).resolve_left (pow_ne_zero 3 hne) rw [mul_add, hs] field_simp ring /-- A gradient written in a normal/radial/tangential frame determines the required scalar norm jets without any assumed norm-derivative formula. -/ theorem jacobi_for_gradient_curves (G : ι → Option (Option ι) → ℝ → ℝ) (g D b : ℝ) (v T : ι → ℝ) (H : ι → ι → ℝ) (hg : 0 < g) (hG : ∀ i j, AnalyticAt ℝ (G i j) 0) (hG0n : ∀ i, G i none 0 = g) (hG0t : ∀ i j, G i (some j) 0 = 0) (hG1n : ∀ i, deriv (G i none) 0 = v i) (hG1r : ∀ i, deriv (G i (some none)) 0 = 0) (hG1t : ∀ i j, deriv (G i (some (some j))) 0 = H j i) (hG2n : ∀ i, deriv (deriv (G i none)) 0 = T i - (D-1)*g - b*H i i/g) (htrace : (∑ i, H i i) = 0) (hT : g * (∑ i, T i) = 2*(∑ i, (v i)^2) + D*(D-1)*g^2) : (∑ i, deriv (deriv (fun t ↦ (Source29AnalyticTensorNorm.tensorNorm (fun j ↦ G i j t))⁻¹)) 0) + ((∑ i, ∑ j, (H j i)^2)/g^2 + (D-1)*(D-(Fintype.card ι : ℝ))) * g⁻¹ = 0 := by let h : ι → ℝ → ℝ := fun i t ↦ Source29AnalyticTensorNorm.tensorNorm (fun j ↦ G i j t) have hh0 : ∀ i, h i 0 = g := by intro i simp [h, Source29AnalyticTensorNorm.tensorNorm, Fintype.sum_option, hG0n, hG0t, Real.sqrt_sq hg.le] have hh : ∀ i, AnalyticAt ℝ (h i) 0 := by intro i apply Source29AnalyticTensorNorm.tensorNorm_analyticAt _ _ (hG i) intro he have hz := congrFun he none simp only [hG0n, Pi.zero_apply] at hz exact hg.ne' hz have hjets : ∀ i, g * deriv (h i) 0 = g*v i ∧ g * deriv (deriv (h i)) 0 + (deriv (h i) 0)^2 = (v i)^2 + (∑ j, (H j i)^2) + g*(T i - (D-1)*g - b*H i i/g) := by intro i have he := Source29AnalyticNormDerivatives.norm_first_second (h i) (G i) (hh i) (hG i) (Filter.Eventually.of_forall (fun t ↦ Source29AnalyticTensorNorm.tensorNorm_sq (fun j ↦ G i j t))) simpa only [hh0, Fintype.sum_option, hG0n, hG0t, hG1n, hG1r, hG1t, hG2n, zero_mul, Finset.sum_const_zero, add_zero, zero_add, zero_pow (by decide : 2 ≠ 0)] using he have hh1 : ∀ i, deriv (h i) 0 = v i := by intro i exact (mul_left_cancel₀ hg.ne') (hjets i).1 have hh2 : ∀ i, g * deriv (deriv (h i)) 0 = (∑ j, (H j i)^2) + g*T i - (D-1)*g^2 - b*H i i := by intro i have he := (hjets i).2 rw [hh1] at he have hdiv : g*(b*H i i/g) = b*H i i := mul_div_cancel₀ _ hg.ne' rw [mul_sub, mul_sub, hdiv] at he nlinarith [he] exact jacobi_from_norm_jets h g D b v (fun i ↦ ∑ j, (H j i)^2) (fun i ↦ H i i) T hg hh hh0 hh1 hh2 htrace hT end end Source29JacobiProfileJets /- Component: RealPolynomialCurveJets.inc -/ namespace Source29RealPolynomialCurveJets open Filter MvPolynomial open Source29QuarticReuse.QuarticPolynomialBasics open scoped Topology BigOperators noncomputable section variable {κ : Type*} [Fintype κ] theorem analytic_eval_curve (P : MvPolynomial κ ℝ) (γ : κ → ℝ → ℝ) (s : ℝ) (hγ : ∀ j, AnalyticAt ℝ (γ j) s) : AnalyticAt ℝ (fun t ↦ eval (fun j ↦ γ j t) P) s := by induction P using MvPolynomial.induction_on with | C c => simpa only [eval_C] using (analyticAt_const : AnalyticAt ℝ (fun _ : ℝ ↦ c) s) | add P Q hP hQ => simpa only [eval_add, Pi.add_def] using hP.add hQ | mul_X P j hP => simpa only [eval_mul, eval_X, Pi.mul_def] using hP.mul (hγ j) theorem first_deriv_eval_curve (P : MvPolynomial κ ℝ) (γ : κ → ℝ → ℝ) (s : ℝ) (hγ : ∀ j, AnalyticAt ℝ (γ j) s) : deriv (fun t ↦ eval (fun j ↦ γ j t) P) s = ∑ j, eval (fun k ↦ γ k s) (pderiv j P) * deriv (γ j) s := by have hdγ : HasDerivAt (fun t j ↦ γ j t) (fun j ↦ deriv (γ j) s) s := hasDerivAt_pi.mpr (fun j ↦ (hγ j).differentiableAt.hasDerivAt) simpa only [Function.comp_def, evalFDeriv_apply] using ((hasFDerivAt_eval P (fun j ↦ γ j s)).comp_hasDerivAt s hdγ).deriv /-- Chain rule to second order, stated in polynomial partial derivatives and the actual first and second coordinate derivatives of the curve. -/ theorem second_deriv_eval_curve (P : MvPolynomial κ ℝ) (γ : κ → ℝ → ℝ) (hγ : ∀ j, AnalyticAt ℝ (γ j) 0) : deriv (deriv (fun t ↦ eval (fun j ↦ γ j t) P)) 0 = (∑ j, ∑ k, eval (fun a ↦ γ a 0) (pderiv k (pderiv j P)) * deriv (γ k) 0 * deriv (γ j) 0) + ∑ j, eval (fun a ↦ γ a 0) (pderiv j P) * deriv (deriv (γ j)) 0 := by have he : deriv (fun t ↦ eval (fun j ↦ γ j t) P) =ᶠ[𝓝 (0 : ℝ)] (fun t ↦ ∑ j, eval (fun k ↦ γ k t) (pderiv j P) * deriv (γ j) t) := by have hn := Filter.eventually_all.mpr (fun j ↦ (hγ j).eventually_analyticAt) filter_upwards [hn] with t ht exact first_deriv_eval_curve P γ t ht rw [he.deriv_eq] have hd := (HasDerivAt.fun_sum (fun j (_ : j ∈ Finset.univ) ↦ ((analytic_eval_curve (pderiv j P) γ 0 hγ).differentiableAt.hasDerivAt.mul (hγ j).deriv.differentiableAt.hasDerivAt))).deriv simp only [Pi.mul_apply] at hd rw [hd] simp only [first_deriv_eval_curve _ γ 0 hγ, Finset.sum_add_distrib, Finset.sum_mul] end end Source29RealPolynomialCurveJets /- Component: PolynomialConeTrace.inc -/ namespace Source29PolynomialConeTrace open MvPolynomial Source29FactorInheritance open Source29QuarticReuse.QuarticPolynomialBasics (second_partial_comm) open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- At a regular point of a homogeneous zero cone, the normal derivative of its minimal-level-set equation has the link trace required by Jacobi. -/ theorem link_third_trace (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 2 ≤ d) (g : ℝ) (hg : g ≠ 0) (hL : cubicOperator P = 0) (hgn : eval (Pi.single (some none) 1) (pderiv none P) = g) (hgt : ∀ i, eval (Pi.single (some none) 1) (pderiv (some i) P) = 0) : g * (∑ i, eval (Pi.single (some none) 1) (pderiv none (pderiv (some (some i)) (pderiv (some (some i)) P)))) = 2 * (∑ i, (eval (Pi.single (some none) 1) (pderiv none (pderiv (some (some i)) P)))^2) + (d : ℝ)*((d : ℝ)-1)*g^2 := by have he := Source29PolynomialNormalTrace.normal_derivative_trace P (Pi.single (some none) 1) g hg hL hgn hgt have hj := Source29HomogeneousRadialJets.radial_coordinate_jets P d hP hd (some none) none rw [hgn] at hj have hH : eval (Pi.single (some none) 1) (pderiv none (pderiv (some none) P)) = ((d : ℝ)-1)*g := by rw [second_partial_comm] exact hj.1 have hT : eval (Pi.single (some none) 1) (pderiv none (pderiv (some none) (pderiv (some none) P))) = ((d : ℝ)-2)*((d : ℝ)-1)*g := by rw [second_partial_comm (pderiv (some none) P) none (some none)] rw [second_partial_comm P none (some none)] exact hj.2 rw [Fintype.sum_option, Fintype.sum_option, hH, hT] at he nlinarith [he] end end Source29PolynomialConeTrace /- Component: PolynomialCurveCoordinateJets.inc -/ namespace Source29PolynomialCurveCoordinateJets open MvPolynomial Source29RealPolynomialCurveJets open scoped BigOperators noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] theorem coordinate_velocity_first (P : MvPolynomial κ ℝ) (γ : κ → ℝ → ℝ) (x : κ → ℝ) (v : κ) (hγ : ∀ j, AnalyticAt ℝ (γ j) 0) (hγ0 : ∀ j, γ j 0 = x j) (hγ1 : ∀ j, deriv (γ j) 0 = Pi.single (M := fun _ ↦ ℝ) v (1 : ℝ) j) : deriv (fun t ↦ eval (fun j ↦ γ j t) P) 0 = eval x (pderiv v P) := by rw [first_deriv_eval_curve P γ 0 hγ] have h0 : (fun j ↦ γ j 0) = x := funext hγ0 simp [h0, hγ1, Pi.single_apply] theorem coordinate_velocity_second (P : MvPolynomial κ ℝ) (γ : κ → ℝ → ℝ) (x : κ → ℝ) (v : κ) (hγ : ∀ j, AnalyticAt ℝ (γ j) 0) (hγ0 : ∀ j, γ j 0 = x j) (hγ1 : ∀ j, deriv (γ j) 0 = Pi.single (M := fun _ ↦ ℝ) v (1 : ℝ) j) : deriv (deriv (fun t ↦ eval (fun j ↦ γ j t) P)) 0 = eval x (pderiv v (pderiv v P)) + ∑ j, eval x (pderiv j P) * deriv (deriv (γ j)) 0 := by rw [second_deriv_eval_curve P γ hγ] have h0 : (fun j ↦ γ j 0) = x := funext hγ0 simp [h0, hγ1, Pi.single_apply] end end Source29PolynomialCurveCoordinateJets /- Component: PolynomialLinkJacobi.inc -/ namespace Source29PolynomialLinkJacobi open MvPolynomial Source29FactorInheritance open Source29QuarticReuse.QuarticPolynomialBasics (second_partial_comm) open Source29PolynomialCurveCoordinateJets open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Jacobi's equation for the actual inverse gradient norm along analytic curves with the second-order jets of geodesics of the spherical link. The existence of such curves on a regular link is a separate obligation. -/ theorem jacobi_of_link_curve_jets (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 2 ≤ d) (g : ℝ) (hg : 0 < g) (hL : cubicOperator P = 0) (hgn : eval (Pi.single (M := fun _ ↦ ℝ) (some none) 1) (pderiv none P) = g) (hgt : ∀ j, eval (Pi.single (M := fun _ ↦ ℝ) (some none) 1) (pderiv (some j) P) = 0) (γ : ι → Option (Option ι) → ℝ → ℝ) (hγ : ∀ i j, AnalyticAt ℝ (γ i j) 0) (hγ0 : ∀ i j, γ i j 0 = Pi.single (M := fun _ ↦ ℝ) (some none) (1 : ℝ) j) (hγ1 : ∀ i j, deriv (γ i j) 0 = Pi.single (M := fun _ ↦ ℝ) (some (some i)) (1 : ℝ) j) (hγ2 : ∀ i j, deriv (deriv (γ i j)) 0 = -Pi.single (M := fun _ ↦ ℝ) (some none) (1 : ℝ) j - (eval (Pi.single (M := fun _ ↦ ℝ) (some none) 1) (pderiv (some (some i)) (pderiv (some (some i)) P)) / g) * Pi.single (M := fun _ ↦ ℝ) none (1 : ℝ) j) : (∑ i, deriv (deriv (fun t ↦ (Source29AnalyticTensorNorm.tensorNorm (fun j ↦ eval (fun a ↦ γ i a t) (pderiv j P)))⁻¹)) 0) + ((∑ i, ∑ j, (eval (Pi.single (M := fun _ ↦ ℝ) (some none) 1) (pderiv (some (some j)) (pderiv (some (some i)) P)))^2)/g^2 + ((d : ℝ)-1)*((d : ℝ)-(Fintype.card ι : ℝ))) * g⁻¹ = 0 := by let x : Option (Option ι) → ℝ := Pi.single (M := fun _ ↦ ℝ) (some none) 1 let H : ι → ι → ℝ := fun j i ↦ eval x (pderiv (some (some j)) (pderiv (some (some i)) P)) let G : ι → Option (Option ι) → ℝ → ℝ := fun i j t ↦ eval (fun a ↦ γ i a t) (pderiv j P) let v : ι → ℝ := fun i ↦ eval x (pderiv none (pderiv (some (some i)) P)) let T : ι → ℝ := fun i ↦ eval x (pderiv none (pderiv (some (some i)) (pderiv (some (some i)) P))) let b : ℝ := eval x (pderiv none (pderiv none P)) have hx : ∀ i, (fun j ↦ γ i j 0) = x := fun i ↦ funext (hγ0 i) have hr := Source29HomogeneousRadialJets.radial_coordinate_jets P d hP hd (some none) none rw [hgn] at hr have hrad : eval x (pderiv (some none) (pderiv none P)) = ((d : ℝ)-1)*g := hr.1 have hradzero : ∀ j, eval x (pderiv (some none) (pderiv (some j) P)) = 0 := by intro j have he := Source29HomogeneousRadialJets.radial_coordinate_jets P d hP hd (some none) (some j) rw [hgt] at he simpa only [mul_zero] using he.1 have hfirst : ∀ i j, deriv (G i j) 0 = eval x (pderiv (some (some i)) (pderiv j P)) := by intro i j exact coordinate_velocity_first (pderiv j P) (γ i) x (some (some i)) (hγ i) (hγ0 i) (hγ1 i) have hsecond : ∀ i, deriv (deriv (G i none)) 0 = T i - ((d : ℝ)-1)*g - b*H i i/g := by intro i rw [show G i none = (fun t ↦ eval (fun a ↦ γ i a t) (pderiv none P)) from rfl, coordinate_velocity_second (pderiv none P) (γ i) x (some (some i)) (hγ i) (hγ0 i) (hγ1 i)] have ht : eval x (pderiv (some (some i)) (pderiv (some (some i)) (pderiv none P))) = T i := by dsimp [T] rw [second_partial_comm P (some (some i)) none, second_partial_comm (pderiv (some (some i)) P) (some (some i)) none] rw [ht] simp only [hγ2, mul_sub, mul_neg, Finset.sum_sub_distrib, Finset.sum_neg_distrib, Pi.single_apply, mul_ite, mul_one, mul_zero, Finset.sum_ite_eq, Finset.sum_ite_eq', Finset.mem_univ, ite_true] rw [hrad] dsimp [b, H, x] ring have htrace : (∑ i, H i i) = 0 := by have he := Source29PolynomialNormalTrace.tangential_trace_zero P x g hg.ne' hL hgn hgt rw [Fintype.sum_option, hradzero none, zero_add] at he exact he apply Source29JacobiProfileJets.jacobi_for_gradient_curves G g (d : ℝ) b v T H hg · intro i j exact Source29RealPolynomialCurveJets.analytic_eval_curve (pderiv j P) (γ i) 0 (hγ i) · intro i change eval (fun a ↦ γ i a 0) (pderiv none P) = g rw [hx] exact hgn · intro i j change eval (fun a ↦ γ i a 0) (pderiv (some j) P) = 0 rw [hx] exact hgt j · intro i rw [hfirst, second_partial_comm] · intro i rw [hfirst, second_partial_comm] exact hradzero (some i) · intro i j rw [hfirst, second_partial_comm] · exact hsecond · exact htrace · exact Source29PolynomialConeTrace.link_third_trace P d hP hd g hg.ne' hL hgn hgt end end Source29PolynomialLinkJacobi /- Component: RealAnalyticInverse.inc -/ namespace Source29RealAnalyticInverse open scoped Topology noncomputable section /-- The analytic inverse theorem, packaged as a local right inverse. -/ theorem exists_analytic_local_inverse {E F : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E] [NormedAddCommGroup F] [NormedSpace ℝ F] (f : E → F) (a : E) (e : E ≃L[ℝ] F) (ha : AnalyticAt ℝ f a) (hd : HasStrictFDerivAt f (e : E →L[ℝ] F) a) : ∃ u : F → E, AnalyticAt ℝ u (f a) ∧ u (f a) = a ∧ ∀ᶠ y in 𝓝 (f a), f (u y) = y := by let L := hd.toOpenPartialHomeomorph f have hL : (L : E → F) = f := hd.toOpenPartialHomeomorph_coe have hLa : a ∈ L.source := hd.mem_toOpenPartialHomeomorph_source refine ⟨L.symm, ?_, ?_, ?_⟩ · have h := L.analyticAt_symm' (i := e) hLa (show AnalyticAt ℝ L a by simpa only [hL] using ha) (show fderiv ℝ L a = e by simpa only [hL] using hd.hasFDerivAt.fderiv) simpa only [hL] using h · simpa only [hL] using L.left_inv hLa · have ht := L.open_target.mem_nhds (L.map_source hLa) have hright : ∀ᶠ y in 𝓝 (L a), L (L.symm y) = y := Filter.Eventually.mono ht (fun _ hy => L.right_inv hy) simpa only [hL] using hright end end Source29RealAnalyticInverse /- Component: PolynomialLinkChart.inc -/ namespace Source29PolynomialLinkChart open Filter MvPolynomial open Source29QuarticReuse.QuarticPolynomialBasics open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] abbrev Ambient (ι : Type*) := Option (Option ι) → ℝ def base : Ambient ι := Pi.single (some none) 1 def radialScale (g : ℝ) : Option (Option ι) → ℝ | none => g | some none => 2 | some (some _) => 1 def diagonalEquiv {κ : Type*} [Fintype κ] (a : κ → ℝ) (ha : ∀ j, a j ≠ 0) : (κ → ℝ) ≃L[ℝ] (κ → ℝ) := LinearEquiv.toContinuousLinearEquiv { toFun := fun x j => a j * x j invFun := fun y j => y j / a j left_inv := by intro x; ext j; exact mul_div_cancel_left₀ _ (ha j) right_inv := by intro y; ext j; exact mul_div_cancel₀ _ (ha j) map_add' := by intro x y; ext j; exact mul_add _ _ _ map_smul' := by intro c x ext j simp only [Pi.smul_apply, smul_eq_mul, RingHom.id_apply] ring } theorem diagonalEquiv_apply {κ : Type*} [Fintype κ] (a : κ → ℝ) (ha : ∀ j, a j ≠ 0) (x : κ → ℝ) (j : κ) : diagonalEquiv a ha x j = a j * x j := rfl def constraintPolynomial (P : MvPolynomial (Option (Option ι)) ℝ) : Option (Option ι) → MvPolynomial (Option (Option ι)) ℝ | none => P | some none => spherePolynomial | some (some i) => X (some (some i)) def constraintMap (P : MvPolynomial (Option (Option ι)) ℝ) (x : Ambient ι) : Ambient ι := fun j => eval x (constraintPolynomial P j) def parameterEmbed (y : ι → ℝ) : Ambient ι | none => 0 | some none => 1 | some (some i) => y i theorem analyticAt_eval_real {κ : Type*} [Fintype κ] (P : MvPolynomial κ ℝ) (x : κ → ℝ) : AnalyticAt ℝ (fun y => eval y P) x := by induction P using MvPolynomial.induction_on with | C c => simpa only [eval_C] using (analyticAt_const : AnalyticAt ℝ (fun _ : κ → ℝ => c) x) | add P Q hP hQ => simpa only [eval_add, Pi.add_def] using hP.add hQ | mul_X P j hP => have hj : AnalyticAt ℝ (fun y : κ → ℝ => y j) x := (ContinuousLinearMap.proj j : (κ → ℝ) →L[ℝ] ℝ).analyticAt x simpa only [eval_mul, eval_X, Pi.mul_def] using hP.mul hj theorem constraintMap_base (P : MvPolynomial (Option (Option ι)) ℝ) (hP : eval base P = 0) : constraintMap P base = parameterEmbed 0 := by ext j cases j with | none => exact hP | some j => cases j with | none => simp [constraintMap, constraintPolynomial, eval_spherePolynomial, base, parameterEmbed, Pi.single_apply] | some j => simp [constraintMap, constraintPolynomial, base, parameterEmbed, Pi.single_apply] theorem analytic_parameterEmbed (y : ι → ℝ) : AnalyticAt ℝ parameterEmbed y := by apply AnalyticAt.pi intro j cases j with | none => exact analyticAt_const | some j => cases j with | none => exact analyticAt_const | some j => exact (ContinuousLinearMap.proj j : (ι → ℝ) →L[ℝ] ℝ).analyticAt y /-- An analytic chart of the regular polynomial link in a frame with radial base vector and nonzero gradient along the distinguished normal. -/ theorem exists_link_chart (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (hg : g ≠ 0) (hP : eval base P = 0) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) : ∃ φ : (ι → ℝ) → Ambient ι, AnalyticAt ℝ φ 0 ∧ φ 0 = base ∧ ∀ᶠ y in 𝓝 (0 : ι → ℝ), constraintMap P (φ y) = parameterEmbed y := by have hscale : ∀ j : Option (Option ι), radialScale g j ≠ 0 := by intro j cases j with | none => exact hg | some j => cases j <;> norm_num [radialScale] let e : Ambient ι ≃L[ℝ] Ambient ι := diagonalEquiv (radialScale g) hscale have ha : AnalyticAt ℝ (constraintMap P) base := AnalyticAt.pi (fun j => analyticAt_eval_real (constraintPolynomial P j) base) have hd : HasStrictFDerivAt (constraintMap P) (e : Ambient ι →L[ℝ] Ambient ι) base := by apply hasStrictFDerivAt_pi'.mpr intro j change HasStrictFDerivAt (fun z => eval z (constraintPolynomial P j)) _ _ have hj := hasStrictFDerivAt_eval (constraintPolynomial P j) base convert hj using 1 ext v change e v j = evalFDeriv (constraintPolynomial P j) base v rw [diagonalEquiv_apply] cases j with | none => simp [constraintPolynomial, evalFDeriv_apply, Fintype.sum_option, hgn, hgt, radialScale] | some j => cases j with | none => simp [constraintPolynomial, evalFDeriv_spherePolynomial, base, Pi.single_apply, radialScale] | some j => simp [constraintPolynomial, evalFDeriv_X, radialScale] obtain ⟨u, hu, hu0, hnear⟩ := Source29RealAnalyticInverse.exists_analytic_local_inverse (constraintMap P) base e ha hd have hbase := constraintMap_base P hP rw [hbase] at hu hu0 hnear refine ⟨fun y => u (parameterEmbed y), hu.comp (analytic_parameterEmbed 0), hu0, ?_⟩ exact (analytic_parameterEmbed 0).continuousAt.tendsto.eventually hnear end end Source29PolynomialLinkChart /- Component: PolynomialLinkCurves.inc -/ namespace Source29PolynomialLinkCurves open Filter MvPolynomial Source29PolynomialLinkChart open Source29QuarticReuse.QuarticPolynomialBasics open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Actual analytic curves in the regular link with prescribed linear tangential coordinates. Their normal and radial jets follow by differentiating the two constraints. -/ theorem exists_link_curves (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (hg : g ≠ 0) (hP : eval base P = 0) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) : ∃ γ : ι → Option (Option ι) → ℝ → ℝ, (∀ i j, AnalyticAt ℝ (γ i j) 0) ∧ (∀ i j, γ i j 0 = base j) ∧ (∀ i, (fun t => eval (fun j => γ i j t) P) =ᶠ[𝓝 (0 : ℝ)] (fun _ => 0)) ∧ (∀ i, (fun t => ∑ j, (γ i j t)^2) =ᶠ[𝓝 (0 : ℝ)] (fun _ => 1)) ∧ (∀ i j, γ i (some (some j)) =ᶠ[𝓝 (0 : ℝ)] (fun t => t * (Pi.single (M := fun _ => ℝ) i 1 j))) := by obtain ⟨φ, hφ, hφ0, hnear⟩ := exists_link_chart P g hg hP hgn hgt let line : ι → ℝ → (ι → ℝ) := fun i t => t • Pi.single i 1 have hline0 : ∀ i, line i 0 = 0 := by intro i; simp [line] have hline : ∀ i, AnalyticAt ℝ (line i) 0 := by intro i exact analyticAt_id.smul analyticAt_const have hc : ∀ i, AnalyticAt ℝ (fun t => φ (line i t)) 0 := by intro i apply AnalyticAt.comp _ (hline i) simpa only [hline0] using hφ let γ : ι → Option (Option ι) → ℝ → ℝ := fun i j t => φ (line i t) j have hconstraints : ∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), constraintMap P (φ (line i t)) = parameterEmbed (line i t) := by intro i have ht := (hline i).continuousAt.tendsto rw [hline0] at ht exact ht.eventually hnear refine ⟨γ, ?_, ?_, ?_, ?_, ?_⟩ · intro i j exact ((ContinuousLinearMap.proj j : Ambient ι →L[ℝ] ℝ).analyticAt _).comp (hc i) · intro i j dsimp [γ] rw [hline0, hφ0] · intro i filter_upwards [hconstraints i] with t ht exact congrFun ht none · intro i filter_upwards [hconstraints i] with t ht have he := congrFun ht (some none) simpa only [constraintMap, constraintPolynomial, eval_spherePolynomial, parameterEmbed] using he · intro i j filter_upwards [hconstraints i] with t ht have he := congrFun ht (some (some j)) simpa only [constraintMap, constraintPolynomial, eval_X, parameterEmbed, line, Pi.smul_apply, smul_eq_mul] using he end end Source29PolynomialLinkCurves /- Component: PolynomialLinkCurveJets.inc -/ namespace Source29PolynomialLinkCurveJets open Filter MvPolynomial Source29PolynomialLinkChart open Source29RealPolynomialCurveJets Source29PolynomialCurveCoordinateJets open Source29QuarticReuse.QuarticPolynomialBasics open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem linear_deriv (c t : ℝ) : deriv (fun s : ℝ => s*c) t = c := by simpa using ((hasDerivAt_id t).mul_const c).deriv theorem linear_second_deriv (c : ℝ) : deriv (deriv (fun s : ℝ => s*c)) 0 = 0 := by have he : deriv (fun s : ℝ => s*c) = fun _ => c := funext (linear_deriv c) rw [he] exact deriv_const _ _ /-- Differentiating the actual two link constraints fixes the first and second normal/radial derivatives of each coordinate curve. -/ theorem link_curve_jets (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (hg : g ≠ 0) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (γ : Option (Option ι) → ℝ → ℝ) (i : ι) (hγ : ∀ j, AnalyticAt ℝ (γ j) 0) (hγ0 : ∀ j, γ j 0 = base j) (hzero : (fun t => eval (fun j => γ j t) P) =ᶠ[𝓝 (0 : ℝ)] (fun _ => 0)) (hsphere : (fun t => ∑ j, (γ j t)^2) =ᶠ[𝓝 (0 : ℝ)] (fun _ => 1)) (htangent : ∀ j, γ (some (some j)) =ᶠ[𝓝 (0 : ℝ)] (fun t => t * (Pi.single (M := fun _ => ℝ) i 1 j))) : (∀ j, deriv (γ j) 0 = Pi.single (M := fun _ => ℝ) (some (some i)) 1 j) ∧ (∀ j, deriv (deriv (γ j)) 0 = -Pi.single (M := fun _ => ℝ) (some none) 1 j - (eval base (pderiv (some (some i)) (pderiv (some (some i)) P))/g) * Pi.single (M := fun _ => ℝ) none 1 j) := by have h0 : (fun j => γ j 0) = base := funext hγ0 have hn1 := hzero.deriv_eq rw [first_deriv_eval_curve P γ 0 hγ, deriv_const, h0] at hn1 simp only [Fintype.sum_option, hgn, hgt, zero_mul, Finset.sum_const_zero, add_zero] at hn1 have hn : deriv (γ none) 0 = 0 := (mul_eq_zero.mp hn1).resolve_left hg have hS : (fun t => eval (fun j => γ j t) (spherePolynomial : MvPolynomial (Option (Option ι)) ℝ)) =ᶠ[𝓝 (0 : ℝ)] (fun _ => 1) := by simpa only [eval_spherePolynomial] using hsphere have hr1 := hS.deriv_eq rw [first_deriv_eval_curve spherePolynomial γ 0 hγ, deriv_const, h0, ← evalFDeriv_apply, evalFDeriv_spherePolynomial] at hr1 simp only [base, Pi.single_apply, ite_mul, one_mul, zero_mul, Finset.sum_ite_eq', Finset.mem_univ, ite_true] at hr1 have hr : deriv (γ (some none)) 0 = 0 := by linarith have ht1 : ∀ j, deriv (γ (some (some j))) 0 = Pi.single (M := fun _ => ℝ) i 1 j := by intro j rw [(htangent j).deriv_eq, linear_deriv] have hv : ∀ j, deriv (γ j) 0 = Pi.single (M := fun _ => ℝ) (some (some i)) 1 j := by intro j cases j with | none => simp [hn, Pi.single_apply] | some j => cases j with | none => simp [hr, Pi.single_apply] | some j => simpa only [Pi.single_apply, Option.some.injEq] using ht1 j have hn2 := hzero.deriv.deriv_eq rw [coordinate_velocity_second P γ base (some (some i)) hγ hγ0 hv, deriv_const', deriv_const] at hn2 simp only [Fintype.sum_option, hgn, hgt, zero_mul, Finset.sum_const_zero, add_zero] at hn2 have hnsecond : deriv (deriv (γ none)) 0 = -eval base (pderiv (some (some i)) (pderiv (some (some i)) P))/g := by apply (eq_div_iff hg).mpr nlinarith [hn2] have hr2 := hS.deriv.deriv_eq rw [coordinate_velocity_second spherePolynomial γ base (some (some i)) hγ hγ0 hv, deriv_const', deriv_const] at hr2 have hdiag : eval base (pderiv (some (some i)) (pderiv (some (some i)) (spherePolynomial : MvPolynomial (Option (Option ι)) ℝ))) = 2 := by simp [pderiv_spherePolynomial, pderiv_mul, base, Pi.single_apply] rw [hdiag, ← evalFDeriv_apply, evalFDeriv_spherePolynomial] at hr2 simp only [base, Pi.single_apply, ite_mul, one_mul, zero_mul, Finset.sum_ite_eq', Finset.mem_univ, ite_true] at hr2 have hrsecond : deriv (deriv (γ (some none))) 0 = -1 := by linarith have ht2 : ∀ j, deriv (deriv (γ (some (some j)))) 0 = 0 := by intro j rw [(htangent j).deriv.deriv_eq, linear_second_deriv] refine ⟨hv, ?_⟩ intro j cases j with | none => simpa [Pi.single_apply, neg_div] using hnsecond | some j => cases j with | none => simpa [Pi.single_apply] using hrsecond | some j => simpa [Pi.single_apply] using ht2 j end end Source29PolynomialLinkCurveJets /- Component: PolynomialJacobiCurves.inc -/ namespace Source29PolynomialJacobiCurves open Filter MvPolynomial Source29PolynomialLinkChart open Source29PolynomialLinkCurves Source29PolynomialLinkCurveJets open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def jacobiProfile (P : MvPolynomial (Option (Option ι)) ℝ) (x : Ambient ι) : ℝ := (Source29AnalyticTensorNorm.tensorNorm (fun j => eval x (pderiv j P)))⁻¹ theorem jacobiProfile_positive (P : MvPolynomial (Option (Option ι)) ℝ) (x : Ambient ι) (hg : (fun j => eval x (pderiv j P)) ≠ 0) : 0 < jacobiProfile P x := inv_pos.mpr (Source29AnalyticTensorNorm.tensorNorm_pos hg) theorem jacobiProfile_analyticAt (P : MvPolynomial (Option (Option ι)) ℝ) (x : Ambient ι) (hg : (fun j => eval x (pderiv j P)) ≠ 0) : AnalyticAt ℝ (jacobiProfile P) x := by have hn := Source29AnalyticTensorNorm.tensorNorm_analyticAt (fun y j => eval y (pderiv j P)) x (fun j => analyticAt_eval_real (pderiv j P) x) hg exact hn.inv (Source29AnalyticTensorNorm.tensorNorm_pos hg).ne' theorem jacobiProfile_at_base (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (hg : 0 < g) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) : jacobiProfile P base = g⁻¹ := by simp [jacobiProfile, Source29AnalyticTensorNorm.tensorNorm, Fintype.sum_option, hgn, hgt, Real.sqrt_sq hg.le] /-- The Jacobi equation holds along actual analytic curves in the regular spherical link of a homogeneous polynomial satisfying Lp=0. The curves and their first/second jets are constructed, not assumed. This is in a normalized frame with the radial vector and gradient in the two distinguished coordinates. -/ theorem exists_jacobi_curves (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 2 ≤ d) (g : ℝ) (hg : 0 < g) (hL : Source29FactorInheritance.cubicOperator P = 0) (hzero : eval base P = 0) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) : ∃ γ : ι → Option (Option ι) → ℝ → ℝ, (∀ i j, AnalyticAt ℝ (γ i j) 0) ∧ (∀ i j, γ i j 0 = base j) ∧ (∀ i j, deriv (γ i j) 0 = Pi.single (M := fun _ => ℝ) (some (some i)) 1 j) ∧ (∀ i j, deriv (deriv (γ i j)) 0 = -Pi.single (M := fun _ => ℝ) (some none) 1 j - (eval base (pderiv (some (some i)) (pderiv (some (some i)) P))/g) * Pi.single (M := fun _ => ℝ) none 1 j) ∧ (∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), eval (fun j => γ i j t) P = 0 ∧ (∑ j, (γ i j t)^2) = 1) ∧ (∀ i, AnalyticAt ℝ (fun t => jacobiProfile P (fun j => γ i j t)) 0) ∧ ((∑ i, deriv (deriv (fun t => jacobiProfile P (fun j => γ i j t))) 0) + ((∑ i, ∑ j, (eval base (pderiv (some (some j)) (pderiv (some (some i)) P)))^2)/g^2 + ((d : ℝ)-1)*((d : ℝ)-(Fintype.card ι : ℝ))) * jacobiProfile P base = 0) := by obtain ⟨γ, hγ, hγ0, hγzero, hγsphere, hγtangent⟩ := exists_link_curves P g hg.ne' hzero hgn hgt have hjets : ∀ i, (∀ j, deriv (γ i j) 0 = Pi.single (M := fun _ => ℝ) (some (some i)) 1 j) ∧ (∀ j, deriv (deriv (γ i j)) 0 = -Pi.single (M := fun _ => ℝ) (some none) 1 j - (eval base (pderiv (some (some i)) (pderiv (some (some i)) P))/g) * Pi.single (M := fun _ => ℝ) none 1 j) := fun i => link_curve_jets P g hg.ne' hgn hgt (γ i) i (hγ i) (hγ0 i) (hγzero i) (hγsphere i) (hγtangent i) have hgrad : (fun j => eval base (pderiv j P)) ≠ 0 := by intro he have hz := congrFun he none simp only [hgn, Pi.zero_apply] at hz exact hg.ne' hz refine ⟨γ, hγ, hγ0, (fun i => (hjets i).1), (fun i => (hjets i).2), ?_, ?_, ?_⟩ · intro i filter_upwards [hγzero i, hγsphere i] with t ht hs exact ⟨ht, hs⟩ · intro i have hp : AnalyticAt ℝ (jacobiProfile P) (fun j => γ i j 0) := by have he : (fun j => γ i j 0) = base := funext (hγ0 i) rw [he] exact jacobiProfile_analyticAt P base hgrad have hc := hp.comp (AnalyticAt.pi (hγ i)) exact hc · rw [jacobiProfile_at_base P g hg hgn hgt] exact Source29PolynomialLinkJacobi.jacobi_of_link_curve_jets P d hP hd g hg hL hgn hgt γ hγ hγ0 (fun i => (hjets i).1) (fun i => (hjets i).2) end end Source29PolynomialJacobiCurves /- Component: OrthogonalFrame.inc -/ namespace Source29OrthogonalFrame open scoped BigOperators Matrix noncomputable section /-- Two successive reflections carry one orthogonal pair to another with the same individual lengths. -/ theorem exists_isometry_of_orthogonal_pairs {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℝ E] (u v x y : E) (hux : ‖u‖ = ‖x‖) (hvy : ‖v‖ = ‖y‖) (huv : inner ℝ u v = 0) (hxy : inner ℝ x y = 0) : ∃ T : E ≃ₗᵢ[ℝ] E, T u = x ∧ T v = y := by let R := (ℝ ∙ (u-x))ᗮ.reflection have hR : R u = x := Submodule.reflection_sub hux let S := (ℝ ∙ (R v-y))ᗮ.reflection have hS : S (R v) = y := Submodule.reflection_sub ((R.norm_map v).trans hvy) have hi : inner ℝ x (R v) = 0 := by rw [← hR, R.inner_map_map, huv] have hfix : S x = x := by apply Submodule.reflection_mem_subspace_eq_self rw [Submodule.mem_orthogonal_singleton_iff_inner_left, inner_sub_right, hi, hxy, sub_self] exact ⟨R.trans S, by simpa only [LinearIsometryEquiv.trans_apply, hR] using hfix, hS⟩ variable {κ : Type*} [Fintype κ] [DecidableEq κ] def coordinateUnit (i : κ) : EuclideanSpace ℝ κ := WithLp.toLp 2 (Pi.single i 1) theorem coordinateUnit_norm (i : κ) : ‖coordinateUnit i‖ = 1 := by have hs : ‖coordinateUnit i‖^2 = 1 := by simp [coordinateUnit, EuclideanSpace.norm_sq_eq, Pi.single_apply] nlinarith [norm_nonneg (coordinateUnit i)] theorem coordinateUnit_inner (i j : κ) : inner ℝ (coordinateUnit i) (coordinateUnit j) = if i = j then 1 else 0 := by simp [coordinateUnit, PiLp.inner_apply, Pi.single_apply, eq_comm] /-- An orthogonal matrix whose two chosen columns are an arbitrary orthonormal pair. It supplies the radial/normal normalization of the link. -/ theorem exists_orthogonal_matrix_pair (r n : κ) (hrn : r ≠ n) (x y : EuclideanSpace ℝ κ) (hx : ‖x‖ = 1) (hy : ‖y‖ = 1) (hxy : inner ℝ x y = 0) : ∃ U : Matrix κ κ ℝ, U.transpose * U = 1 ∧ U * U.transpose = 1 ∧ (∀ a, U a r = x a) ∧ (∀ a, U a n = y a) := by obtain ⟨T, hTr, hTn⟩ := exists_isometry_of_orthogonal_pairs (coordinateUnit r) (coordinateUnit n) x y ((coordinateUnit_norm r).trans hx.symm) ((coordinateUnit_norm n).trans hy.symm) (by simp [coordinateUnit_inner, hrn]) hxy let U : Matrix κ κ ℝ := fun a b => T (coordinateUnit b) a have hU : U.transpose * U = 1 := by ext i j have he := T.inner_map_map (coordinateUnit i) (coordinateUnit j) rw [coordinateUnit_inner] at he simpa only [PiLp.inner_apply, RCLike.inner_apply, conj_trivial, mul_comm, Matrix.mul_apply, Matrix.transpose_apply, Matrix.one_apply] using he exact ⟨U, hU, mul_eq_one_comm.mp hU, fun a => congrArg (fun z : EuclideanSpace ℝ κ => z a) hTr, fun a => congrArg (fun z : EuclideanSpace ℝ κ => z a) hTn⟩ end end Source29OrthogonalFrame /- Component: PolynomialNormalFrame.inc -/ namespace Source29PolynomialNormalFrame open MvPolynomial Source29PolynomialLinkChart open Source29QuarticReuse.QuarticMinimal open Source29QuarticReuse.QuarticPolynomialBasics (evalFDeriv_self_of_isHomogeneous evalFDeriv_apply) open scoped BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- At any regular point of the spherical zero set of a homogeneous polynomial, an orthogonal change of variables puts its point and gradient in the radial and normal coordinates used by the link chart. -/ theorem exists_normalized_polynomial (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hL : Source29FactorInheritance.cubicOperator P = 0) (x : Ambient ι) (hx : (∑ a, (x a)^2) = 1) (hzero : eval x P = 0) (hregular : (fun a => eval x (pderiv a P)) ≠ 0) : ∃ (g : ℝ) (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ), 0 < g ∧ U.transpose * U = 1 ∧ U * U.transpose = 1 ∧ U *ᵥ base = x ∧ (changeVariables U P).IsHomogeneous d ∧ Source29FactorInheritance.cubicOperator (changeVariables U P) = 0 ∧ eval base (changeVariables U P) = 0 ∧ eval base (pderiv none (changeVariables U P)) = g ∧ (∀ j, eval base (pderiv (some j) (changeVariables U P)) = 0) := by let X : EuclideanSpace ℝ (Option (Option ι)) := WithLp.toLp 2 x let G : EuclideanSpace ℝ (Option (Option ι)) := WithLp.toLp 2 (fun a => eval x (pderiv a P)) have hG : G ≠ 0 := by intro he apply hregular funext a exact congrArg (fun z : EuclideanSpace ℝ (Option (Option ι)) => z a) he let g : ℝ := ‖G‖ have hg : 0 < g := norm_pos_iff.mpr hG have hX : ‖X‖ = 1 := by have he : ‖X‖^2 = 1 := by simpa only [X, EuclideanSpace.real_norm_sq_eq] using hx nlinarith [norm_nonneg X] have horth : inner ℝ X G = 0 := by have he := evalFDeriv_self_of_isHomogeneous P d hP x rw [hzero, mul_zero] at he simpa only [evalFDeriv_apply, X, G, PiLp.inner_apply, RCLike.inner_apply, conj_trivial, mul_comm] using he have hY : ‖g⁻¹ • G‖ = 1 := by rw [norm_smul, norm_inv, Real.norm_eq_abs, abs_of_pos hg] exact inv_mul_cancel₀ hg.ne' have hXY : inner ℝ X (g⁻¹ • G) = 0 := by simp [inner_smul_right, horth] obtain ⟨U, hUt, hU, hUr, hUn⟩ := Source29OrthogonalFrame.exists_orthogonal_matrix_pair (some none) none (by simp) X (g⁻¹ • G) hX hY hXY have hbase : U *ᵥ base = x := by funext a simpa [Matrix.mulVec, dotProduct, base, Pi.single_apply, X] using hUr a have hgrad : ∀ a, eval x (pderiv a P) = g * U a none := by intro a rw [hUn] change eval x (pderiv a P) = g * (g⁻¹ * eval x (pderiv a P)) rw [← mul_assoc, mul_inv_cancel₀ hg.ne', one_mul] have hcol : ∀ j, (∑ a, U a none * U a j) = if none = j then 1 else 0 := by intro j have he := congrArg (fun M : Matrix (Option (Option ι)) (Option (Option ι)) ℝ => M none j) hUt simpa only [Matrix.mul_apply, Matrix.transpose_apply, Matrix.one_apply] using he have hpartial : ∀ j, eval base (pderiv j (changeVariables U P)) = g * (if none = j then 1 else 0) := by intro j rw [pderiv_changeVariables, map_sum] simp only [map_mul, eval_C, eval_changeVariables, hbase] simp_rw [hgrad, mul_assoc] rw [← Finset.mul_sum, hcol] refine ⟨g, U, hg, hUt, hU, hbase, isHomogeneous_changeVariables U P d hP, ?_, ?_, ?_, ?_⟩ · exact leadingOperator_changeVariables_eq_zero U hU P hL · rw [eval_changeVariables, hbase, hzero] · simpa using hpartial none · intro j simpa using hpartial (some j) end end Source29PolynomialNormalFrame /- Component: PolynomialJacobiTransport.inc -/ namespace Source29PolynomialJacobiTransport open MvPolynomial Source29PolynomialLinkChart Source29PolynomialJacobiCurves open Source29QuarticReuse.QuarticMinimal open scoped BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- The squared gradient norm is unchanged by an orthogonal coordinate change, evaluated at corresponding points. -/ theorem gradient_square_sum_changeVariables (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (hU : U * U.transpose = 1) (P : MvPolynomial (Option (Option ι)) ℝ) (z : Ambient ι) : (∑ j, (eval z (pderiv j (changeVariables U P)))^2) = ∑ j, (eval (U *ᵥ z) (pderiv j P))^2 := by have hgrad : (fun j => eval z (pderiv j (changeVariables U P))) = U.transpose *ᵥ (fun j => eval (U *ᵥ z) (pderiv j P)) := by funext j simp only [pderiv_changeVariables, map_sum, map_mul, eval_C, eval_changeVariables, Matrix.mulVec, dotProduct, Matrix.transpose_apply] apply Finset.sum_congr rfl intro a _ ring have he := MatrixAlgebra.dot_transpose_mulVec U hU (fun j => eval (U *ᵥ z) (pderiv j P)) (fun j => eval (U *ᵥ z) (pderiv j P)) rw [← hgrad] at he simpa only [dotProduct, ← pow_two] using he theorem jacobiProfile_changeVariables (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (hU : U * U.transpose = 1) (P : MvPolynomial (Option (Option ι)) ℝ) (z : Ambient ι) : jacobiProfile (changeVariables U P) z = jacobiProfile P (U *ᵥ z) := by unfold jacobiProfile Source29AnalyticTensorNorm.tensorNorm rw [gradient_square_sum_changeVariables U hU] theorem norm_square_mulVec (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (hUt : U.transpose * U = 1) (z : Ambient ι) : (∑ j, (U *ᵥ z) j ^ 2) = ∑ j, (z j)^2 := by have he := MatrixAlgebra.dot_transpose_mulVec U.transpose (by simpa only [Matrix.transpose_transpose] using hUt) z z simpa only [Matrix.transpose_transpose, dotProduct, ← pow_two] using he /-- Orthogonal transport preserves the real-analytic Jacobi profile along any curves, including its actual second derivatives. -/ theorem jacobiProfile_curve_second (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (hU : U * U.transpose = 1) (P : MvPolynomial (Option (Option ι)) ℝ) (γ : ℝ → Ambient ι) : deriv (deriv (fun t => jacobiProfile (changeVariables U P) (γ t))) 0 = deriv (deriv (fun t => jacobiProfile P (U *ᵥ γ t))) 0 := by simp_rw [jacobiProfile_changeVariables U hU] end end Source29PolynomialJacobiTransport /- Component: CompactPolynomialLink.inc -/ namespace Source29CompactPolynomialLink open MvPolynomial open scoped BigOperators noncomputable section variable {κ : Type*} [Fintype κ] theorem continuous_eval (P : MvPolynomial κ ℝ) : Continuous (fun x : κ → ℝ => eval x P) := by induction P using MvPolynomial.induction_on with | C c => simpa only [eval_C] using (continuous_const : Continuous (fun _ : κ → ℝ => c)) | add P Q hP hQ => simpa only [eval_add, Pi.add_def] using hP.add hQ | mul_X P j hP => simpa only [eval_mul, eval_X, Pi.mul_def] using hP.mul (continuous_apply j) /-- The full spherical polynomial zero set is compact. Regularity is not asserted here and must be proved separately where needed. -/ theorem isCompact_link (P : MvPolynomial κ ℝ) : IsCompact {x : κ → ℝ | eval x P = 0 ∧ (∑ j, (x j)^2) = 1} := by classical have hs : Continuous (fun x : κ → ℝ => ∑ j, (x j)^2) := by fun_prop have hc : IsClosed {x : κ → ℝ | eval x P = 0 ∧ (∑ j, (x j)^2) = 1} := (isClosed_eq (continuous_eval P) continuous_const).inter (isClosed_eq hs continuous_const) apply (isCompact_Icc : IsCompact (Set.Icc (fun _ : κ => (-1 : ℝ)) (fun _ => (1 : ℝ)))).of_isClosed_subset hc intro x hx have hsq : ∀ j, (x j)^2 ≤ 1 := by intro j exact (Finset.single_le_sum (fun k _ => sq_nonneg (x k)) (Finset.mem_univ j)).trans_eq hx.2 constructor <;> intro j · nlinarith [hsq j, sq_nonneg (x j + 1)] · nlinarith [hsq j, sq_nonneg (x j - 1)] end end Source29CompactPolynomialLink /- Component: CurvaturePotentialAlgebra.inc -/ namespace Source29CurvaturePotentialAlgebra open Source29QuarticReuse.QuarticMinimal open scoped BigOperators Matrix noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] def vectorSq (v : κ → ℝ) : ℝ := v ⬝ᵥ v def matrixSq (H : Matrix κ κ ℝ) : ℝ := ∑ i, ∑ j, (H i j)^2 /-- Squared norm of the Hessian restricted to the gradient-orthogonal hyperplane, divided by the squared gradient norm. Its interpretation as curvature is established below at regular polynomial link points. -/ def potential (v : κ → ℝ) (H : Matrix κ κ ℝ) : ℝ := matrixSq H / vectorSq v - 2 * vectorSq (H *ᵥ v) / (vectorSq v)^2 + (v ⬝ᵥ (H *ᵥ v))^2 / (vectorSq v)^3 theorem matrixSq_left (U H : Matrix κ κ ℝ) (hU : U * U.transpose = 1) : matrixSq (U.transpose * H) = matrixSq H := by unfold matrixSq rw [Finset.sum_comm, Finset.sum_comm (f := fun i j => (H i j)^2)] apply Finset.sum_congr rfl intro j _ have he := MatrixAlgebra.dot_transpose_mulVec U hU (fun i => H i j) (fun i => H i j) simpa only [dotProduct, Matrix.mulVec, Matrix.mul_apply, pow_two] using he theorem matrixSq_right (U H : Matrix κ κ ℝ) (hU : U * U.transpose = 1) : matrixSq (H * U) = matrixSq H := by unfold matrixSq apply Finset.sum_congr rfl intro i _ have he := MatrixAlgebra.dot_transpose_mulVec U hU (H i) (H i) simpa only [dotProduct, Matrix.mulVec, Matrix.mul_apply, Matrix.transpose_apply, mul_comm, pow_two] using he theorem matrixSq_conjugate (U H : Matrix κ κ ℝ) (hU : U * U.transpose = 1) : matrixSq (U.transpose * H * U) = matrixSq H := by rw [matrixSq_right U _ hU, matrixSq_left U H hU] theorem potential_conjugate (U H : Matrix κ κ ℝ) (v : κ → ℝ) (hU : U * U.transpose = 1) : potential (U.transpose *ᵥ v) (U.transpose * H * U) = potential v H := by unfold potential vectorSq rw [matrixSq_conjugate U H hU, MatrixAlgebra.conjugate_mulVec U hU H v, MatrixAlgebra.dot_transpose_mulVec U hU v v, MatrixAlgebra.dot_transpose_mulVec U hU (H *ᵥ v) (H *ᵥ v), MatrixAlgebra.dot_transpose_mulVec U hU v (H *ᵥ v)] end end Source29CurvaturePotentialAlgebra /- Component: CurvaturePotentialAxis.inc -/ namespace Source29CurvaturePotentialAxis open Source29CurvaturePotentialAlgebra open scoped BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def axis (g : ℝ) : Option ι → ℝ | none => g | some _ => 0 /-- On a normal coordinate axis the invariant expression is exactly the sum of squares of the tangential Hessian block divided by g². -/ theorem potential_axis (H : Matrix (Option ι) (Option ι) ℝ) (g : ℝ) (hg : g ≠ 0) (hH : ∀ i j, H i j = H j i) : potential (axis g) H = (∑ i, ∑ j, (H (some i) (some j))^2)/g^2 := by have hcol : ∀ i, H (some i) none = H none (some i) := fun i => hH _ _ simp only [potential, vectorSq, matrixSq, dotProduct, Matrix.mulVec, Fintype.sum_option, axis, mul_zero, zero_mul, Finset.sum_const_zero, add_zero, hcol, Finset.sum_add_distrib] simp only [mul_pow, ← Finset.sum_mul] field_simp [hg] simp only [← Finset.mul_sum] ring theorem potential_axis_link (H : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (g : ℝ) (hg : g ≠ 0) (hH : ∀ i j, H i j = H j i) (hrad : ∀ j, H (some none) (some j) = 0) : potential (axis g) H = (∑ i, ∑ j, (H (some (some i)) (some (some j)))^2)/g^2 := by rw [potential_axis H g hg hH] have hc : ∀ i, H (some i) (some none) = 0 := by intro i rw [hH, hrad] simp only [Fintype.sum_option, hrad, hc, zero_pow (by decide : 2 ≠ 0), Finset.sum_const_zero, zero_add] end end Source29CurvaturePotentialAxis /- Component: PolynomialCurvaturePotential.inc -/ namespace Source29PolynomialCurvaturePotential open MvPolynomial Source29CurvaturePotentialAlgebra open Source29QuarticReuse.QuarticMinimal Source29QuarticReuse.QuarticMinimal.AmbientQuartic open scoped BigOperators Matrix noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] def gradientAt (P : MvPolynomial κ ℝ) (x : κ → ℝ) : κ → ℝ := fun i => eval x (pderiv i P) def curvaturePotential (P : MvPolynomial κ ℝ) (x : κ → ℝ) : ℝ := potential (gradientAt P x) (realHessian P x) def curvatureNorm (P : MvPolynomial κ ℝ) (x : κ → ℝ) : ℝ := Real.sqrt (curvaturePotential P x) theorem gradientAt_changeVariables (U : Matrix κ κ ℝ) (P : MvPolynomial κ ℝ) (x : κ → ℝ) : gradientAt (changeVariables U P) x = U.transpose *ᵥ gradientAt P (U *ᵥ x) := by funext j simp only [gradientAt, pderiv_changeVariables, map_sum, map_mul, eval_C, eval_changeVariables, Matrix.mulVec, dotProduct, Matrix.transpose_apply] apply Finset.sum_congr rfl intro a _ ring theorem curvaturePotential_changeVariables (U : Matrix κ κ ℝ) (hU : U * U.transpose = 1) (P : MvPolynomial κ ℝ) (x : κ → ℝ) : curvaturePotential (changeVariables U P) x = curvaturePotential P (U *ᵥ x) := by unfold curvaturePotential rw [gradientAt_changeVariables, realHessian_changeVariables, potential_conjugate U _ _ hU] theorem curvatureNorm_changeVariables (U : Matrix κ κ ℝ) (hU : U * U.transpose = 1) (P : MvPolynomial κ ℝ) (x : κ → ℝ) : curvatureNorm (changeVariables U P) x = curvatureNorm P (U *ᵥ x) := by unfold curvatureNorm rw [curvaturePotential_changeVariables U hU] variable {ι : Type*} [Fintype ι] [DecidableEq ι] open Source29PolynomialLinkChart Source29CurvaturePotentialAxis theorem curvaturePotential_at_base (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 2 ≤ d) (g : ℝ) (hg : g ≠ 0) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) : curvaturePotential P base = (∑ i, ∑ j, (eval base (pderiv (some (some j)) (pderiv (some (some i)) P)))^2)/g^2 := by have hgrad : gradientAt P base = axis g := by funext j cases j with | none => exact hgn | some j => exact hgt j have hs : ∀ i j, realHessian P base i j = realHessian P base j i := by intro i j simp only [realHessian_apply] rw [Source29QuarticReuse.QuarticPolynomialBasics.second_partial_comm] have hr : ∀ j, realHessian P base (some none) (some j) = 0 := by intro j have he := (Source29HomogeneousRadialJets.radial_coordinate_jets P d hP hd (some none) (some j)).1 change realHessian P base (some none) (some j) = ((d : ℝ)-1)*eval base (pderiv (some j) P) at he rw [hgt, mul_zero] at he exact he unfold curvaturePotential rw [hgrad, potential_axis_link _ g hg hs hr] exact congrArg (fun a : ℝ => a/g^2) (Finset.sum_comm (f := fun i j : ι => (realHessian P base (some (some i)) (some (some j)))^2)) end end Source29PolynomialCurvaturePotential /- Component: CurvaturePotentialAnalytic.inc -/ namespace Source29CurvaturePotentialAnalytic open Source29CurvaturePotentialAlgebra open scoped BigOperators Matrix noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] theorem analytic_sum (f : κ → E → ℝ) (x : E) (hf : ∀ j, AnalyticAt ℝ (f j) x) : AnalyticAt ℝ (fun y => ∑ j, f j y) x := by convert Finset.analyticAt_sum Finset.univ (fun j _ => hf j) using 1 ext y simp only [Finset.sum_apply] theorem vectorSq_pos (v : κ → ℝ) (hv : v ≠ 0) : 0 < vectorSq v := by have he := sq_pos_of_pos (Source29AnalyticTensorNorm.tensorNorm_pos hv) rw [Source29AnalyticTensorNorm.tensorNorm_sq] at he simpa only [vectorSq, dotProduct, pow_two] using he theorem vectorSq_analytic (v : E → κ → ℝ) (x : E) (hv : ∀ j, AnalyticAt ℝ (fun y => v y j) x) : AnalyticAt ℝ (fun y => vectorSq (v y)) x := by exact analytic_sum (fun j y => v y j * v y j) x (fun j => (hv j).mul (hv j)) theorem potential_analytic (v : E → κ → ℝ) (H : E → Matrix κ κ ℝ) (x : E) (hv : ∀ j, AnalyticAt ℝ (fun y => v y j) x) (hH : ∀ i j, AnalyticAt ℝ (fun y => H y i j) x) (hne : v x ≠ 0) : AnalyticAt ℝ (fun y => potential (v y) (H y)) x := by have hs := vectorSq_analytic v x hv have hn : vectorSq (v x) ≠ 0 := (vectorSq_pos (v x) hne).ne' have hm : AnalyticAt ℝ (fun y => matrixSq (H y)) x := by apply analytic_sum (fun i y => ∑ j, (H y i j)^2) x intro i exact analytic_sum (fun j y => (H y i j)^2) x (fun j => (hH i j).pow 2) have hw : ∀ i, AnalyticAt ℝ (fun y => (H y *ᵥ v y) i) x := by intro i exact analytic_sum (fun j y => H y i j * v y j) x (fun j => (hH i j).mul (hv j)) have ht := vectorSq_analytic (fun y => H y *ᵥ v y) x hw have hq : AnalyticAt ℝ (fun y => v y ⬝ᵥ (H y *ᵥ v y)) x := analytic_sum (fun j y => v y j * (H y *ᵥ v y) j) x (fun j => (hv j).mul (hw j)) exact ((hm.div hs hn).sub ((analyticAt_const.mul ht).div (hs.pow 2) (pow_ne_zero 2 hn))).add ((hq.pow 2).div (hs.pow 3) (pow_ne_zero 3 hn)) end end Source29CurvaturePotentialAnalytic /- Component: PolynomialCurvatureRegularity.inc -/ namespace Source29PolynomialCurvatureRegularity open MvPolynomial Source29PolynomialCurvaturePotential Source29CurvaturePotentialAnalytic open Source29QuarticReuse.QuarticMinimal.AmbientQuartic open Source29PolynomialLinkChart open scoped BigOperators Matrix noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] theorem curvaturePotential_analyticAt (P : MvPolynomial κ ℝ) (x : κ → ℝ) (hreg : gradientAt P x ≠ 0) : AnalyticAt ℝ (curvaturePotential P) x := potential_analytic (gradientAt P) (realHessian P) x (fun j => analyticAt_eval_real (pderiv j P) x) (fun i j => analyticAt_eval_real (pderiv i (pderiv j P)) x) hreg theorem curvatureNorm_continuousAt (P : MvPolynomial κ ℝ) (x : κ → ℝ) (hreg : gradientAt P x ≠ 0) : ContinuousAt (curvatureNorm P) x := Real.continuous_sqrt.continuousAt.comp (curvaturePotential_analyticAt P x hreg).continuousAt theorem curvatureNorm_analyticAt (P : MvPolynomial κ ℝ) (x : κ → ℝ) (hreg : gradientAt P x ≠ 0) (hpos : 0 < curvaturePotential P x) : AnalyticAt ℝ (curvatureNorm P) x := Source29RealAnalyticSqrt.sqrt_comp_analyticAt (curvaturePotential_analyticAt P x hreg) hpos theorem curvatureNorm_continuousOn (P : MvPolynomial κ ℝ) (s : Set (κ → ℝ)) (hreg : ∀ x ∈ s, gradientAt P x ≠ 0) : ContinuousOn (curvatureNorm P) s := fun x hx => (curvatureNorm_continuousAt P x (hreg x hx)).continuousWithinAt variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem curvaturePotential_nonneg_on_link (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 2 ≤ d) (hL : Source29FactorInheritance.cubicOperator P = 0) (x : Ambient ι) (hx : (∑ a, (x a)^2) = 1) (hzero : eval x P = 0) (hreg : gradientAt P x ≠ 0) : 0 ≤ curvaturePotential P x := by obtain ⟨g, U, hg, hUt, hU, hbase, hQ, hLQ, hQzero, hgn, hgt⟩ := Source29PolynomialNormalFrame.exists_normalized_polynomial P d hP hL x hx hzero hreg have he := curvaturePotential_changeVariables U hU P base rw [hbase, curvaturePotential_at_base _ d hQ hd g hg.ne' hgn hgt] at he rw [← he] exact div_nonneg (Finset.sum_nonneg (fun i _ => Finset.sum_nonneg (fun j _ => sq_nonneg _))) (sq_nonneg g) theorem curvatureNorm_sq_on_link (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 2 ≤ d) (hL : Source29FactorInheritance.cubicOperator P = 0) (x : Ambient ι) (hx : (∑ a, (x a)^2) = 1) (hzero : eval x P = 0) (hreg : gradientAt P x ≠ 0) : (curvatureNorm P x)^2 = curvaturePotential P x := Real.sq_sqrt (curvaturePotential_nonneg_on_link P d hP hd hL x hx hzero hreg) end end Source29PolynomialCurvatureRegularity /- Component: LinearCurveTransport.inc -/ namespace Source29LinearCurveTransport open scoped BigOperators Matrix noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] theorem analytic_mulVec (U : Matrix κ κ ℝ) (γ : κ → ℝ → ℝ) (hγ : ∀ j, AnalyticAt ℝ (γ j) 0) : AnalyticAt ℝ (fun t => U *ᵥ (fun j => γ j t)) 0 := by apply AnalyticAt.pi intro a exact Source29CurvaturePotentialAnalytic.analytic_sum (fun j t => U a j * γ j t) 0 (fun j => analyticAt_const.mul (hγ j)) theorem first_mulVec (U : Matrix κ κ ℝ) (γ : κ → ℝ → ℝ) (hγ : ∀ j, AnalyticAt ℝ (γ j) 0) (a : κ) : deriv (fun t => (U *ᵥ (fun j => γ j t)) a) 0 = ∑ j, U a j * deriv (γ j) 0 := by change deriv (fun t => ∑ j, U a j * γ j t) 0 = _ rw [Source29AnalyticNormDerivatives.first_deriv_sum (fun j t => U a j * γ j t) (fun j => analyticAt_const.mul (hγ j))] apply Finset.sum_congr rfl intro j _ exact ((hγ j).differentiableAt.hasDerivAt.const_mul (U a j)).deriv theorem second_mulVec (U : Matrix κ κ ℝ) (γ : κ → ℝ → ℝ) (hγ : ∀ j, AnalyticAt ℝ (γ j) 0) (a : κ) : deriv (deriv (fun t => (U *ᵥ (fun j => γ j t)) a)) 0 = ∑ j, U a j * deriv (deriv (γ j)) 0 := by change deriv (deriv (fun t => ∑ j, U a j * γ j t)) 0 = _ rw [Source29AnalyticNormDerivatives.second_deriv_sum (fun j t => U a j * γ j t) (fun j => analyticAt_const.mul (hγ j))] apply Finset.sum_congr rfl intro j _ have he := Source29RealAnalyticMaximum.second_deriv_linear_combination (γ j) (fun _ => 0) (hγ j) analyticAt_const (U a j) 0 simpa only [zero_mul, sub_zero] using he end end Source29LinearCurveTransport /- Component: RegularLinkJacobi.inc -/ namespace Source29RegularLinkJacobi open Filter MvPolynomial Source29PolynomialLinkChart Source29PolynomialJacobiCurves open Source29PolynomialCurvaturePotential Source29PolynomialJacobiTransport open Source29QuarticReuse.QuarticMinimal open scoped Topology BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- The Jacobi equation on the original polynomial link, with a coordinate invariant potential and actual analytic curves. The returned first and second jets are the orthonormal link jets needed by the Simons comparison. -/ theorem exists_regular_link_jacobi_curves (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 2 ≤ d) (hL : Source29FactorInheritance.cubicOperator P = 0) (x : Ambient ι) (hx : (∑ a, (x a)^2) = 1) (hzero : eval x P = 0) (hreg : gradientAt P x ≠ 0) : ∃ (g : ℝ) (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (C : ι → ℝ → Ambient ι), 0 < g ∧ U.transpose * U = 1 ∧ U * U.transpose = 1 ∧ U *ᵥ base = x ∧ eval base (pderiv none (changeVariables U P)) = g ∧ (∀ j, eval base (pderiv (some j) (changeVariables U P)) = 0) ∧ (∀ i, AnalyticAt ℝ (C i) 0) ∧ (∀ i, C i 0 = x) ∧ (∀ i a, deriv (fun t => C i t a) 0 = U a (some (some i))) ∧ (∀ i a, deriv (deriv (fun t => C i t a)) 0 = -x a - (eval base (pderiv (some (some i)) (pderiv (some (some i)) (changeVariables U P)))/g) * U a none) ∧ (∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), eval (C i t) P = 0 ∧ (∑ a, (C i t a)^2) = 1) ∧ (∀ i, AnalyticAt ℝ (fun t => jacobiProfile P (C i t)) 0) ∧ ((∑ i, deriv (deriv (fun t => jacobiProfile P (C i t))) 0) + (curvaturePotential P x + ((d : ℝ)-1)*((d : ℝ)-(Fintype.card ι : ℝ))) * jacobiProfile P x = 0) := by obtain ⟨g, U, hg, hUt, hU, hbase, hQ, hLQ, hQzero, hgn, hgt⟩ := Source29PolynomialNormalFrame.exists_normalized_polynomial P d hP hL x hx hzero hreg obtain ⟨γ, hγ, hγ0, hγ1, hγ2, hγmem, hγa, hJ⟩ := exists_jacobi_curves (changeVariables U P) d hQ hd g hg hLQ hQzero hgn hgt let C : ι → ℝ → Ambient ι := fun i t => U *ᵥ (fun a => γ i a t) have hC : ∀ i, AnalyticAt ℝ (C i) 0 := fun i => Source29LinearCurveTransport.analytic_mulVec U (γ i) (hγ i) have hC0 : ∀ i, C i 0 = x := by intro i have he : (fun a => γ i a 0) = base := funext (hγ0 i) change U *ᵥ (fun a => γ i a 0) = x rw [he, hbase] have hrad : ∀ a, U a (some none) = x a := by intro a have he := congrFun hbase a simpa [Matrix.mulVec, dotProduct, base, Pi.single_apply] using he refine ⟨g, U, C, hg, hUt, hU, hbase, hgn, hgt, hC, hC0, ?_, ?_, ?_, ?_, ?_⟩ · intro i a change deriv (fun t => (U *ᵥ (fun b => γ i b t)) a) 0 = _ rw [Source29LinearCurveTransport.first_mulVec U (γ i) (hγ i) a] simp [hγ1, Pi.single_apply] · intro i a change deriv (deriv (fun t => (U *ᵥ (fun b => γ i b t)) a)) 0 = _ rw [Source29LinearCurveTransport.second_mulVec U (γ i) (hγ i) a] simp only [hγ2, mul_sub, mul_neg, Finset.sum_sub_distrib, Finset.sum_neg_distrib, Pi.single_apply, mul_ite, mul_one, mul_zero, Finset.sum_ite_eq', Finset.mem_univ, ite_true] rw [hrad] ring · intro i filter_upwards [hγmem i] with t ht constructor · change eval (U *ᵥ (fun a => γ i a t)) P = 0 rw [← eval_changeVariables] exact ht.1 · change (∑ a, (U *ᵥ (fun b => γ i b t)) a ^ 2) = 1 rw [norm_square_mulVec U hUt] exact ht.2 · intro i have hp : AnalyticAt ℝ (jacobiProfile P) (C i 0) := by rw [hC0] exact jacobiProfile_analyticAt P x hreg have he := hp.comp (hC i) exact he · rw [← curvaturePotential_at_base (changeVariables U P) d hQ hd g hg.ne' hgn hgt, curvaturePotential_changeVariables U hU P base, hbase] at hJ simp_rw [jacobiProfile_changeVariables U hU] at hJ simpa only [hbase] using hJ end end Source29RegularLinkJacobi /- Component: PolynomialTangentialDerivative.inc -/ namespace Source29PolynomialTangentialDerivative open MvPolynomial Source29FactorInheritance open Source29QuarticReuse.QuarticPolynomialBasics (second_partial_comm) open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] /-- The derivative of the tangential Hessian trace in any ambient direction, obtained by differentiating the polynomial equation at a normalized point. -/ theorem derivative_trace (P : MvPolynomial (Option ι) ℝ) (x : Option ι → ℝ) (g : ℝ) (hg : g ≠ 0) (hL : cubicOperator P = 0) (hgn : eval x (pderiv none P) = g) (hgt : ∀ i, eval x (pderiv (some i) P) = 0) (a : Option ι) : g * (∑ i, eval x (pderiv a (pderiv (some i) (pderiv (some i) P)))) = 2 * (∑ i, eval x (pderiv a (pderiv (some i) P)) * eval x (pderiv none (pderiv (some i) P))) := by have htrace := Source29PolynomialNormalTrace.tangential_trace_zero P x g hg hL hgn hgt have hsym : ∀ i, eval x (pderiv (some i) (pderiv none P)) = eval x (pderiv none (pderiv (some i) P)) := by intro i rw [second_partial_comm] have he := congrArg (eval x) (congrArg (pderiv a) hL) simp [cubicOperator, pderiv_mul, pderiv_pow, Fintype.sum_option, hgn, hgt, hsym, htrace] at he have heq : ∀ i, eval x (pderiv none (pderiv (some i) P)) * (g * eval x (pderiv a (pderiv (some i) P))) = g * (eval x (pderiv a (pderiv (some i) P)) * eval x (pderiv none (pderiv (some i) P))) := by intro i ring simp_rw [heq, ← Finset.mul_sum] at he have hh : g * (g * (∑ i, eval x (pderiv a (pderiv (some i) (pderiv (some i) P)))) - 2 * (∑ i, eval x (pderiv a (pderiv (some i) P)) * eval x (pderiv none (pderiv (some i) P)))) = 0 := by nlinarith [he] exact sub_eq_zero.mp ((mul_eq_zero.mp hh).resolve_left hg) def hessian (P : MvPolynomial (Option ι) ℝ) (x : Option ι → ℝ) (a b : Option ι) : ℝ := eval x (pderiv a (pderiv b P)) def third (P : MvPolynomial (Option ι) ℝ) (x : Option ι → ℝ) (a b c : Option ι) : ℝ := eval x (pderiv a (pderiv b (pderiv c P))) theorem hessian_symm (P : MvPolynomial (Option ι) ℝ) (x : Option ι → ℝ) (a b : Option ι) : hessian P x a b = hessian P x b a := by unfold hessian rw [second_partial_comm] theorem third_swap12 (P : MvPolynomial (Option ι) ℝ) (x : Option ι → ℝ) (a b c : Option ι) : third P x a b c = third P x b a c := by unfold third rw [second_partial_comm (pderiv c P) a b] theorem third_swap23 (P : MvPolynomial (Option ι) ℝ) (x : Option ι → ℝ) (a b c : Option ι) : third P x a b c = third P x a c b := by unfold third rw [second_partial_comm P b c] /-- The polynomial expression for the first covariant derivative of the normalized tangential Hessian. Its geometric realization is separate. -/ def firstCovariant (P : MvPolynomial (Option ι) ℝ) (x : Option ι → ℝ) (g : ℝ) (a b c : ι) : ℝ := third P x (some a) (some b) (some c) / g - (hessian P x none (some a) * hessian P x (some b) (some c) + hessian P x none (some b) * hessian P x (some a) (some c) + hessian P x none (some c) * hessian P x (some a) (some b)) / g^2 theorem firstCovariant_swap12 (P : MvPolynomial (Option ι) ℝ) (x : Option ι → ℝ) (g : ℝ) (a b c : ι) : firstCovariant P x g a b c = firstCovariant P x g b a c := by unfold firstCovariant rw [third_swap12 P x (some a) (some b), hessian_symm P x (some b) (some a)] ring theorem firstCovariant_swap23 (P : MvPolynomial (Option ι) ℝ) (x : Option ι → ℝ) (g : ℝ) (a b c : ι) : firstCovariant P x g a b c = firstCovariant P x g a c b := by unfold firstCovariant rw [third_swap23 P x (some a) (some b), hessian_symm P x (some c) (some b)] ring /-- Differentiated minimality makes this symmetric third-order tensor trace-free. This follows directly from Lp=0, not from a geometric hypothesis. -/ theorem firstCovariant_trace_zero (P : MvPolynomial (Option ι) ℝ) (x : Option ι → ℝ) (g : ℝ) (hg : g ≠ 0) (hL : cubicOperator P = 0) (hgn : eval x (pderiv none P) = g) (hgt : ∀ i, eval x (pderiv (some i) P) = 0) (a : ι) : (∑ i, firstCovariant P x g a i i) = 0 := by have ht := Source29PolynomialNormalTrace.tangential_trace_zero P x g hg hL hgn hgt have hd := derivative_trace P x g hg hL hgn hgt (some a) change (∑ i, hessian P x (some i) (some i)) = 0 at ht change g * (∑ i, third P x (some a) (some i) (some i)) = 2 * (∑ i, hessian P x (some a) (some i) * hessian P x none (some i)) at hd simp only [firstCovariant, Finset.sum_sub_distrib, ← Finset.sum_div, Finset.sum_add_distrib, ← Finset.mul_sum, ht, mul_zero, zero_add] have hc : (∑ i, hessian P x none (some i) * hessian P x (some a) (some i)) = ∑ i, hessian P x (some a) (some i) * hessian P x none (some i) := by apply Finset.sum_congr rfl intro i _ ring rw [hc] field_simp nlinarith [hd] end end Source29PolynomialTangentialDerivative /- Component: PolynomialSecondTrace.inc -/ namespace Source29PolynomialSecondTrace open MvPolynomial Source29FactorInheritance Source29PolynomialTangentialDerivative open Source29QuarticReuse.QuarticPolynomialBasics (second_partial_comm) open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] /-- A fourth-order trace identity from two derivatives of Lp=0. -/ theorem second_derivative_trace (P : MvPolynomial (Option ι) ℝ) (x : Option ι → ℝ) (g : ℝ) (hg : g ≠ 0) (hL : cubicOperator P = 0) (hgn : eval x (pderiv none P) = g) (hgt : ∀ i, eval x (pderiv (some i) P) = 0) (a b : Option ι) : g^2 * (∑ i, eval x (pderiv a (pderiv b (pderiv (some i) (pderiv (some i) P))))) = 2 * (∑ i, ∑ j, hessian P x a (some i) * hessian P x b (some j) * hessian P x (some i) (some j)) - 2 * hessian P x none none * (∑ i, hessian P x a (some i) * hessian P x b (some i)) + 2 * g * (∑ i, (third P x a b (some i) * hessian P x none (some i) + hessian P x a (some i) * third P x b none (some i) + hessian P x b (some i) * third P x a none (some i))) - 2 * hessian P x a none * (∑ i, hessian P x b (some i) * hessian P x none (some i)) - 2 * hessian P x b none * (∑ i, hessian P x a (some i) * hessian P x none (some i)) := by have ht := Source29PolynomialNormalTrace.tangential_trace_zero P x g hg hL hgn hgt have ha := derivative_trace P x g hg hL hgn hgt a have hb := derivative_trace P x g hg hL hgn hgt b have hsym : ∀ i, eval x (pderiv (some i) (pderiv none P)) = eval x (pderiv none (pderiv (some i) P)) := by intro i rw [second_partial_comm] have hta : ∀ i, eval x (pderiv a (pderiv (some i) (pderiv none P))) = eval x (pderiv a (pderiv none (pderiv (some i) P))) := by intro i rw [second_partial_comm P (some i) none] have htb : ∀ i, eval x (pderiv b (pderiv (some i) (pderiv none P))) = eval x (pderiv b (pderiv none (pderiv (some i) P))) := by intro i rw [second_partial_comm P (some i) none] have he := congrArg (eval x) (congrArg (pderiv a) (congrArg (pderiv b) hL)) simp [cubicOperator, pderiv_mul, pderiv_pow, Fintype.sum_option, hgn, hgt, hsym, hta, htb, ht] at he have htwo : pderiv a (2 : MvPolynomial (Option ι) ℝ) = 0 := by simpa only [map_ofNat] using (pderiv_C (i := a) (a := (2 : ℝ))) simp only [htwo, map_zero, mul_zero, add_zero, mul_add, add_mul, Finset.sum_add_distrib, ← Finset.mul_sum, ← Finset.sum_mul] at he ring_nf at he have hH : ∀ c e, eval x (pderiv c (pderiv e P)) = hessian P x c e := by intro c e rfl have hT : ∀ c e f, eval x (pderiv c (pderiv e (pderiv f P))) = third P x c e f := by intro c e f rfl simp only [hH, hT] at he ha hb simp only [mul_assoc, ← Finset.mul_sum] at he have hcross : (∑ i, ∑ j, hessian P x (some i) (some j) * (hessian P x b (some i) * hessian P x a (some j))) = ∑ i, ∑ j, hessian P x (some i) (some j) * (hessian P x b (some j) * hessian P x a (some i)) := by rw [Finset.sum_comm] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ rw [hessian_symm P x (some j) (some i)] rw [hcross] at he simp only [Finset.sum_add_distrib] simp only [mul_comm, mul_left_comm, mul_assoc] at he ha hb ⊢ linear_combination he - 2 * hessian P x a none * hb - 2 * hessian P x b none * ha end end Source29PolynomialSecondTrace /- Component: HomogeneousHigherRadialJets.inc -/ namespace Source29HomogeneousHigherRadialJets open MvPolynomial Source29HomogeneousRadialJets open Source29QuarticReuse.QuarticPolynomialBasics Source29QuarticReuse.QuarticCompatibility noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] /-- Euler's third- and fourth-order identities at a coordinate radial point. These remove the radial direction from the twice differentiated equation. -/ theorem radial_coordinate_higher_jets (P : MvPolynomial κ ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (r a b : κ) : eval (Pi.single r 1) (pderiv r (pderiv a (pderiv b P))) = ((d : ℝ)-2) * eval (Pi.single r 1) (pderiv a (pderiv b P)) ∧ eval (Pi.single r 1) (pderiv r (pderiv r (pderiv a (pderiv b P)))) = ((d : ℝ)-3)*((d : ℝ)-2) * eval (Pi.single r 1) (pderiv a (pderiv b P)) := by have h := radial_coordinate_jets (pderiv b P) (d-1) (homogeneous_pderiv hP) (by omega) r a rw [Nat.cast_sub (by omega : 1 ≤ d), Nat.cast_one] at h constructor · convert h.1 using 1 <;> ring · convert h.2 using 1 <;> ring end end Source29HomogeneousHigherRadialJets /- Component: SimonsJetCorrection.inc -/ namespace Source29SimonsJetCorrection open Source29GaussSimonsAlgebra open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def matrixSquare (A : ι → ι → ℝ) (a b : ι) : ℝ := ∑ k, A a k * A k b def matrixCube (A : ι → ι → ℝ) (a b : ι) : ℝ := ∑ k, matrixSquare A a k * A k b def correction (A : ι → ι → ℝ) (a b c d : ι) : ℝ := delta a d * A b c + delta b d * A a c + delta c d * A a b - matrixSquare A a d * A b c - matrixSquare A b d * A a c - matrixSquare A c d * A a b theorem matrixSquare_symm (A : ι → ι → ℝ) (hA : ∀ a b, A a b = A b a) (a b : ι) : matrixSquare A a b = matrixSquare A b a := by apply Finset.sum_congr rfl intro k _ rw [hA a k, hA k b] ring theorem delta_symm (a b : ι) : delta a b = delta b a := by simp only [delta, eq_comm] theorem correction_swap12 (A : ι → ι → ℝ) (hA : ∀ a b, A a b = A b a) (a b c d : ι) : correction A a b c d = correction A b a c d := by unfold correction rw [hA b a] ring theorem correction_swap13 (A : ι → ι → ℝ) (hA : ∀ a b, A a b = A b a) (a b c d : ι) : correction A a b c d = correction A c b a d := by unfold correction rw [hA b a, hA c a, hA c b] ring theorem correction_trace (A : ι → ι → ℝ) (hA : ∀ a b, A a b = A b a) (htrace : (∑ k, A k k) = 0) (c d : ι) : (∑ k, correction A k k c d) = 2 * A c d - 2 * matrixCube A d c := by have hm : (∑ k, matrixSquare A k d * A k c) = matrixCube A d c := by unfold matrixCube apply Finset.sum_congr rfl intro k _ rw [matrixSquare_symm A hA k d] simp only [correction, Finset.sum_add_distrib, Finset.sum_sub_distrib, ← Finset.mul_sum, htrace, mul_zero, delta, ite_mul, one_mul, zero_mul, Finset.sum_ite_eq, Finset.sum_ite_eq', Finset.sum_ite_irrel, Finset.sum_const_zero, ite_self, Finset.mem_univ, ite_true, hm] rw [hA d c] ring theorem gauss_action (A : ι → ι → ℝ) (hA : ∀ a b, A a b = A b a) (a b c d : ι) : (∑ l, (A l b * gaussTensor A l a c d + A a l * gaussTensor A l b c d)) = delta a d * A b c - delta a c * A b d + delta b d * A a c - delta b c * A a d + matrixSquare A b c * A a d - matrixSquare A b d * A a c + matrixSquare A a c * A b d - matrixSquare A a d * A b c := by have hp : ∀ b c d e, (∑ l, A l b * (A l c * A d e)) = matrixSquare A b c * A d e := by intro b c d e simp only [matrixSquare, Finset.sum_mul] apply Finset.sum_congr rfl intro l _ rw [hA l b] ring have hq : ∀ a c d e, (∑ l, A a l * (A l c * A d e)) = matrixSquare A a c * A d e := by intro a c d e simp only [matrixSquare, Finset.sum_mul, mul_assoc] simp only [gaussTensor, mul_add, mul_sub, Finset.sum_add_distrib, Finset.sum_sub_distrib, hp, hq] simp only [delta, mul_ite, ite_mul, mul_one, one_mul, mul_zero, zero_mul, Finset.sum_ite_eq, Finset.sum_ite_eq', Finset.sum_ite_irrel, Finset.sum_const_zero, Finset.mem_univ, ite_true] rw [hA c b, hA d b] ring theorem correction_commutator (A : ι → ι → ℝ) (hA : ∀ a b, A a b = A b a) (a b c d : ι) : correction A a b c d - correction A a b d c = ∑ l, (A l b * gaussTensor A l a c d + A a l * gaussTensor A l b c d) := by rw [gauss_action A hA] unfold correction rw [delta_symm d c, matrixSquare_symm A hA d c] ring /-- A fully symmetric fourth-order tensor with the indicated trace gives the full Simons identity after the explicit curvature correction. -/ theorem simons_of_symmetric_fourth (A : ι → ι → ℝ) (F : ι → ι → ι → ι → ℝ) (hA : ∀ a b, A a b = A b a) (htrace : (∑ k, A k k) = 0) (hF12 : ∀ a b c d, F a b c d = F b a c d) (hF13 : ∀ a b c d, F a b c d = F c b a d) (hF34 : ∀ a b c d, F a b c d = F a b d c) (hFtrace : ∀ c d, (∑ k, F k k c d) = 2 * matrixCube A d c - 2 * A c d) (i j : ι) : (∑ k, (F i j k k + correction A i j k k)) = ((Fintype.card ι : ℝ) - normSq A) * A i j := by apply simons_of_gauss_codazzi A (fun a b c d => F a b c d + correction A a b c d) hA htrace · intro a b c d rw [hF12 a b c d, correction_swap12 A hA a b c d] · intro a b c d rw [hF13 a b c d, correction_swap13 A hA a b c d] · intro c d rw [Finset.sum_add_distrib, hFtrace, correction_trace A hA htrace] ring · intro a b c d rw [hF34 a b c d] simpa only [add_sub_add_left_eq_sub] using correction_commutator A hA a b c d end end Source29SimonsJetCorrection /- Component: SimonsFourthTensor.inc -/ namespace Source29SimonsFourthTensor open Source29SimonsJetCorrection open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def fourthTensor (A V : ι → ι → ℝ) (B : ι → ι → ι → ℝ) (Q : ι → ι → ι → ι → ℝ) (w : ι → ℝ) (z : ℝ) (a b c d : ι) : ℝ := Q a b c d - (A a d * V b c + A b d * V a c + A c d * V a b + V a d * A b c + V b d * A a c + V c d * A a b) + z * (A a d * A b c + A b d * A a c + A c d * A a b) - (w d * B a b c + w a * B b c d + w b * B a c d + w c * B a b d) theorem fourthTensor_swap12 (A V : ι → ι → ℝ) (B : ι → ι → ι → ℝ) (Q : ι → ι → ι → ι → ℝ) (w : ι → ℝ) (z : ℝ) (hA : ∀ a b, A a b = A b a) (hV : ∀ a b, V a b = V b a) (hB : ∀ a b c, B a b c = B b a c) (hQ : ∀ a b c d, Q a b c d = Q b a c d) (a b c d : ι) : fourthTensor A V B Q w z a b c d = fourthTensor A V B Q w z b a c d := by unfold fourthTensor rw [hQ a b c d, hB a b c, hB a b d, hA a b, hV a b] ring theorem fourthTensor_swap13 (A V : ι → ι → ℝ) (B : ι → ι → ι → ℝ) (Q : ι → ι → ι → ι → ℝ) (w : ι → ℝ) (z : ℝ) (hA : ∀ a b, A a b = A b a) (hV : ∀ a b, V a b = V b a) (hB12 : ∀ a b c, B a b c = B b a c) (hB13 : ∀ a b c, B a b c = B c b a) (hQ : ∀ a b c d, Q a b c d = Q c b a d) (a b c d : ι) : fourthTensor A V B Q w z a b c d = fourthTensor A V B Q w z c b a d := by unfold fourthTensor rw [hQ a b c d, hB13 a b c, hB12 b c d, hB12 a c d, hB12 a b d, hA b a, hA c a, hA c b, hV b a, hV c a, hV c b] ring theorem fourthTensor_swap34 (A V : ι → ι → ℝ) (B : ι → ι → ι → ℝ) (Q : ι → ι → ι → ι → ℝ) (w : ι → ℝ) (z : ℝ) (hA : ∀ a b, A a b = A b a) (hV : ∀ a b, V a b = V b a) (hB23 : ∀ a b c, B a b c = B a c b) (hQ : ∀ a b c d, Q a b c d = Q a b d c) (a b c d : ι) : fourthTensor A V B Q w z a b c d = fourthTensor A V B Q w z a b d c := by unfold fourthTensor rw [hQ a b c d, hB23 b c d, hB23 a c d, hA c d, hV c d] ring /-- The polynomial trace identities imply the trace needed for Simons. The fourth-order expression is explicit; no curvature commutator is assumed. -/ theorem fourthTensor_trace (A V : ι → ι → ℝ) (B S : ι → ι → ι → ℝ) (Q : ι → ι → ι → ι → ℝ) (w : ι → ℝ) (z t : ℝ) (hA : ∀ a b, A a b = A b a) (hAtr : (∑ k, A k k) = 0) (hB : ∀ a b c, B a b c = S a b c - w a * A b c - w b * A a c - w c * A a b) (hBtr : ∀ c, (∑ k, B k k c) = 0) (hVtr : (∑ k, V k k) = 2 * (∑ k, (w k)^2) + t) (hQtr : ∀ c d, (∑ k, Q k k c d) = 2 * matrixCube A d c - 2 * z * matrixSquare A c d + 2 * (∑ k, (S k c d * w k + A k c * V k d + A k d * V k c)) - 2 * w c * (∑ k, A k d * w k) - 2 * w d * (∑ k, A k c * w k) + (t-2)*A c d) (c d : ι) : (∑ k, fourthTensor A V B Q w z k k c d) = 2 * matrixCube A d c - 2 * A c d := by have hsquare : (∑ k, A k d * A k c) = matrixSquare A c d := by unfold matrixSquare apply Finset.sum_congr rfl intro k _ rw [hA k c] ring have hsumB : (∑ k, w k * B k c d) = (∑ k, S k c d * w k) - A c d * (∑ k, (w k)^2) - w c * (∑ k, A k d * w k) - w d * (∑ k, A k c * w k) := by calc _ = ∑ k, (S k c d * w k - A c d * (w k)^2 - w c * (A k d * w k) - w d * (A k c * w k)) := by apply Finset.sum_congr rfl intro k _ rw [hB] ring _ = _ := by simp only [Finset.sum_sub_distrib, ← Finset.mul_sum] have hcross : (∑ k, V k d * A k c) = ∑ k, A k c * V k d := by apply Finset.sum_congr rfl intro k _ ring simp only [fourthTensor, Finset.sum_add_distrib, Finset.sum_sub_distrib, ← Finset.mul_sum, hAtr, hBtr, mul_zero, zero_add, add_zero, sub_zero, hsquare, hsumB, hcross, hVtr, hQtr] ring end end Source29SimonsFourthTensor /- Component: PolynomialLinkFourthTrace.inc -/ namespace Source29PolynomialLinkFourthTrace open MvPolynomial Source29PolynomialLinkChart Source29PolynomialTangentialDerivative open Source29QuarticReuse.QuarticPolynomialBasics (second_partial_comm) open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- The twice differentiated polynomial equation, with the radial direction removed by homogeneity. All remaining sums run over the spherical link. -/ theorem link_fourth_trace (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (g : ℝ) (hg : g ≠ 0) (hL : Source29FactorInheritance.cubicOperator P = 0) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (a b : ι) : g^2 * (∑ i, eval base (pderiv (some (some a)) (pderiv (some (some b)) (pderiv (some (some i)) (pderiv (some (some i)) P))))) = 2 * (∑ i, ∑ j, hessian P base (some (some a)) (some (some i)) * hessian P base (some (some b)) (some (some j)) * hessian P base (some (some i)) (some (some j))) - 2 * hessian P base none none * (∑ i, hessian P base (some (some a)) (some (some i)) * hessian P base (some (some b)) (some (some i))) + 2 * g * (∑ i, (third P base (some (some a)) (some (some b)) (some (some i)) * hessian P base none (some (some i)) + hessian P base (some (some a)) (some (some i)) * third P base (some (some b)) none (some (some i)) + hessian P base (some (some b)) (some (some i)) * third P base (some (some a)) none (some (some i)))) - 2 * hessian P base (some (some a)) none * (∑ i, hessian P base (some (some b)) (some (some i)) * hessian P base none (some (some i))) - 2 * hessian P base (some (some b)) none * (∑ i, hessian P base (some (some a)) (some (some i)) * hessian P base none (some (some i))) + ((d : ℝ)*((d : ℝ)-1)-2) * g^2 * hessian P base (some (some a)) (some (some b)) := by have hR : ∀ j, hessian P base (some none) (some j) = 0 := by intro j have he := (Source29HomogeneousRadialJets.radial_coordinate_jets P d hP (by omega) (some none) (some j)).1 change hessian P base (some none) (some j) = ((d : ℝ)-1)*eval base (pderiv (some j) P) at he simpa only [hgt, mul_zero] using he have hR' : ∀ j, hessian P base (some j) (some none) = 0 := by intro j rw [hessian_symm, hR] have hNR : hessian P base none (some none) = ((d : ℝ)-1)*g := by rw [hessian_symm] have he := (Source29HomogeneousRadialJets.radial_coordinate_jets P d hP (by omega) (some none) none).1 change hessian P base (some none) none = ((d : ℝ)-1)*eval base (pderiv none P) at he rw [hgn] at he exact he have hTR : third P base (some (some a)) (some (some b)) (some none) = ((d : ℝ)-2) * hessian P base (some (some a)) (some (some b)) := by have he := (Source29HomogeneousHigherRadialJets.radial_coordinate_higher_jets P d hP hd (some none) (some (some a)) (some (some b))).1 simpa only [third, hessian, base, second_partial_comm] using he have hQR : eval base (pderiv (some (some a)) (pderiv (some (some b)) (pderiv (some none) (pderiv (some none) P)))) = ((d : ℝ)-3)*((d : ℝ)-2) * hessian P base (some (some a)) (some (some b)) := by have he := (Source29HomogeneousHigherRadialJets.radial_coordinate_higher_jets P d hP hd (some none) (some (some a)) (some (some b))).2 simpa only [hessian, base, second_partial_comm] using he have he := Source29PolynomialSecondTrace.second_derivative_trace P base g hg hL hgn hgt (some (some a)) (some (some b)) simp only [Fintype.sum_option, hR, hR', hNR, hTR, hQR, mul_zero, zero_mul, zero_add, add_zero, Finset.sum_const_zero] at he linear_combination he end end Source29PolynomialLinkFourthTrace /- Component: NormalizedLinkJets.inc -/ namespace Source29NormalizedLinkJets open MvPolynomial Source29PolynomialLinkChart Source29PolynomialTangentialDerivative open Source29QuarticReuse.QuarticPolynomialBasics (second_partial_comm) open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def tangent (a : ι) : Option (Option ι) := some (some a) def A (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b : ι) : ℝ := hessian P base (tangent a) (tangent b) / g def w (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a : ι) : ℝ := hessian P base none (tangent a) / g def z (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) : ℝ := hessian P base none none / g def S (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b c : ι) : ℝ := third P base (tangent a) (tangent b) (tangent c) / g def V (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b : ι) : ℝ := third P base none (tangent a) (tangent b) / g def Q (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b c d : ι) : ℝ := eval base (pderiv (tangent a) (pderiv (tangent b) (pderiv (tangent c) (pderiv (tangent d) P)))) / g def B (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b c : ι) : ℝ := S P g a b c - w P g a * A P g b c - w P g b * A P g a c - w P g c * A P g a b theorem A_symm (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b : ι) : A P g a b = A P g b a := by simp only [A, hessian, second_partial_comm] theorem V_symm (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b : ι) : V P g a b = V P g b a := by simp only [V, third, second_partial_comm] theorem S_swap12 (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b c : ι) : S P g a b c = S P g b a c := by simp only [S, third, second_partial_comm] theorem S_swap23 (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b c : ι) : S P g a b c = S P g a c b := by simp only [S, third, second_partial_comm] theorem Q_swap12 (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b c d : ι) : Q P g a b c d = Q P g b a c d := by simp only [Q, second_partial_comm] theorem Q_swap13 (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b c d : ι) : Q P g a b c d = Q P g c b a d := by simp only [Q, second_partial_comm] theorem Q_swap34 (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b c d : ι) : Q P g a b c d = Q P g a b d c := by simp only [Q, second_partial_comm] theorem B_eq_firstCovariant (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b c : ι) : B P g a b c = firstCovariant P base g (some a) (some b) (some c) := by simp only [B, S, w, A, tangent, firstCovariant] ring theorem B_swap12 (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b c : ι) : B P g a b c = B P g b a c := by simp only [B_eq_firstCovariant] exact firstCovariant_swap12 P base g (some a) (some b) (some c) theorem B_swap23 (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b c : ι) : B P g a b c = B P g a c b := by simp only [B_eq_firstCovariant] exact firstCovariant_swap23 P base g (some a) (some b) (some c) theorem B_swap13 (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b c : ι) : B P g a b c = B P g c b a := by rw [B_swap12 P g a b c, B_swap23 P g b a c, B_swap12 P g b c a] end end Source29NormalizedLinkJets /- Component: NormalizedLinkTraces.inc -/ namespace Source29NormalizedLinkTraces open MvPolynomial Source29PolynomialLinkChart Source29PolynomialTangentialDerivative open Source29NormalizedLinkJets open Source29QuarticReuse.QuarticPolynomialBasics (second_partial_comm) open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] variable (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (g : ℝ) (hg : g ≠ 0) (hL : Source29FactorInheritance.cubicOperator P = 0) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) include hP hd hgt in theorem radial_hessian_zero (j : Option ι) : hessian P base (some none) (some j) = 0 := by have he := (Source29HomogeneousRadialJets.radial_coordinate_jets P d hP (by omega) (some none) (some j)).1 change hessian P base (some none) (some j) = ((d : ℝ)-1)*eval base (pderiv (some j) P) at he simpa only [hgt, mul_zero] using he include hP hd hg hL hgn hgt theorem A_trace : (∑ i, A P g i i) = 0 := by have ht := Source29PolynomialNormalTrace.tangential_trace_zero P base g hg hL hgn hgt have hr := radial_hessian_zero P d hP hd hgt none change eval base (pderiv (some none) (pderiv (some none) P)) = 0 at hr rw [Fintype.sum_option, hr, zero_add] at ht change (∑ i, eval base (pderiv (tangent i) (pderiv (tangent i) P)) / g) = 0 rw [← Finset.sum_div] exact div_eq_zero_iff.mpr (Or.inl ht) theorem B_trace (c : ι) : (∑ i, B P g i i c) = 0 := by have hR := radial_hessian_zero P d hP hd hgt have hR' : ∀ j, hessian P base (some j) (some none) = 0 := by intro j rw [hessian_symm, hR] have hT : third P base (tangent c) (some none) (some none) = 0 := by have he := (Source29HomogeneousRadialJets.radial_coordinate_jets P d hP (by omega) (some none) (tangent c)).2 change third P base (some none) (some none) (tangent c) = ((d : ℝ)-2)*((d : ℝ)-1)*eval base (pderiv (some (some c)) P) at he rw [hgt, mul_zero] at he simpa only [third, second_partial_comm] using he change third P base (some (some c)) (some none) (some none) = 0 at hT have hBr : firstCovariant P base g (some c) none none = 0 := by simpa only [firstCovariant, tangent, hT, hR, hR', mul_zero, zero_mul, zero_add, sub_zero, zero_div] using (rfl : (0 : ℝ) = 0) have ht := firstCovariant_trace_zero P base g hg hL hgn hgt (some c) rw [Fintype.sum_option, hBr, zero_add] at ht calc (∑ i, B P g i i c) = ∑ i, B P g c i i := by apply Finset.sum_congr rfl intro i _ exact B_swap13 P g i i c _ = 0 := by simpa only [B_eq_firstCovariant] using ht theorem V_trace : (∑ i, V P g i i) = 2 * (∑ i, (w P g i)^2) + (d : ℝ)*((d : ℝ)-1) := by have ht := Source29PolynomialConeTrace.link_third_trace P d hP (by omega) g hg hL hgn hgt change g * (∑ i, third P base none (tangent i) (tangent i)) = 2 * (∑ i, (hessian P base none (tangent i))^2) + (d : ℝ)*((d : ℝ)-1)*g^2 at ht simp only [V, w, div_pow, ← Finset.sum_div] field_simp [hg] nlinarith [ht] theorem Q_trace_natural (a b : ι) : (∑ i, Q P g a b i i) = 2 * (∑ i, ∑ j, A P g a i * A P g b j * A P g i j) - 2 * z P g * (∑ i, A P g a i * A P g b i) + 2 * (∑ i, (S P g a b i * w P g i + A P g a i * V P g b i + A P g b i * V P g a i)) - 2 * w P g a * (∑ i, A P g b i * w P g i) - 2 * w P g b * (∑ i, A P g a i * w P g i) + ((d : ℝ)*((d : ℝ)-1)-2) * A P g a b := by have he := Source29PolynomialLinkFourthTrace.link_fourth_trace P d hP hd g hg hL hgn hgt a b have hHN : ∀ c, hessian P base (some (some c)) none = hessian P base none (some (some c)) := by intro c exact hessian_symm P base (some (some c)) none have hTN : ∀ c i, third P base (some (some c)) none (some (some i)) = third P base none (some (some c)) (some (some i)) := by intro c i exact third_swap12 P base (some (some c)) none (some (some i)) simp only [hHN, hTN] at he simp only [Q, A, z, S, w, V, tangent, div_mul_div_comm, ← add_div, ← Finset.sum_div] field_simp [hg] linear_combination he end end Source29NormalizedLinkTraces /- Component: PolynomialSimonsTensor.inc -/ namespace Source29PolynomialSimonsTensor open MvPolynomial Source29PolynomialLinkChart Source29PolynomialTangentialDerivative open Source29NormalizedLinkJets Source29SimonsJetCorrection Source29SimonsFourthTensor open Source29QuarticReuse.QuarticPolynomialBasics (second_partial_comm) open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem cubic_contraction (M : ι → ι → ℝ) (hM : ∀ a b, M a b = M b a) (c d : ι) : (∑ i, ∑ j, M c i * M d j * M i j) = matrixCube M d c := by simp only [matrixCube, matrixSquare, Finset.sum_mul] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ rw [hM c i, hM i j] ring theorem square_contraction (M : ι → ι → ℝ) (hM : ∀ a b, M a b = M b a) (c d : ι) : (∑ i, M c i * M d i) = matrixSquare M c d := by unfold matrixSquare apply Finset.sum_congr rfl intro i _ rw [hM d i] def F (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) : ι → ι → ι → ι → ℝ := fourthTensor (A P g) (V P g) (B P g) (Q P g) (w P g) (z P g) /-- Explicit polynomial candidate for the second covariant derivative. Identification with derivatives of an actual moving frame is still separate. -/ def D (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (a b c d : ι) : ℝ := F P g a b c d + correction (A P g) a b c d variable (P : MvPolynomial (Option (Option ι)) ℝ) (degree : ℕ) (hP : P.IsHomogeneous degree) (hdegree : 3 ≤ degree) (g : ℝ) (hg : g ≠ 0) (hL : Source29FactorInheritance.cubicOperator P = 0) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) include hP hdegree hg hL hgn hgt theorem Q_trace (c d : ι) : (∑ k, Q P g k k c d) = 2 * matrixCube (A P g) d c - 2 * z P g * matrixSquare (A P g) c d + 2 * (∑ k, (S P g k c d * w P g k + A P g k c * V P g k d + A P g k d * V P g k c)) - 2 * w P g c * (∑ k, A P g k d * w P g k) - 2 * w P g d * (∑ k, A P g k c * w P g k) + ((degree : ℝ)*((degree : ℝ)-1)-2) * A P g c d := by have hrot : (∑ k, Q P g k k c d) = ∑ k, Q P g c d k k := by apply Finset.sum_congr rfl intro k _ simp only [Q, second_partial_comm] rw [hrot, Source29NormalizedLinkTraces.Q_trace_natural P degree hP hdegree g hg hL hgn hgt, cubic_contraction (A P g) (A_symm P g), square_contraction (A P g) (A_symm P g)] have hS : ∀ k, S P g c d k = S P g k c d := by intro k simp only [S, third, second_partial_comm] simp only [hS, A_symm, V_symm] theorem F_trace (c d : ι) : (∑ k, F P g k k c d) = 2 * matrixCube (A P g) d c - 2 * A P g c d := by apply fourthTensor_trace (A P g) (V P g) (B P g) (S P g) (Q P g) (w P g) (z P g) ((degree : ℝ)*((degree : ℝ)-1)) (A_symm P g) (Source29NormalizedLinkTraces.A_trace P degree hP hdegree g hg hL hgn hgt) (fun a b c => rfl) (Source29NormalizedLinkTraces.B_trace P degree hP hdegree g hg hL hgn hgt) (Source29NormalizedLinkTraces.V_trace P degree hP hdegree g hg hL hgn hgt) (Q_trace P degree hP hdegree g hg hL hgn hgt) /-- Tensor Simons for explicit normalized polynomial jets. No Gauss, Codazzi, or commutator assumptions are needed. Geometric realization of D remains. -/ theorem tensor_simons (i j : ι) : (∑ k, D P g i j k k) = ((Fintype.card ι : ℝ) - Source29GaussSimonsAlgebra.normSq (A P g)) * A P g i j := by apply simons_of_symmetric_fourth (A P g) (F P g) (A_symm P g) (Source29NormalizedLinkTraces.A_trace P degree hP hdegree g hg hL hgn hgt) · exact fourthTensor_swap12 (A P g) (V P g) (B P g) (Q P g) (w P g) (z P g) (A_symm P g) (V_symm P g) (B_swap12 P g) (Q_swap12 P g) · exact fourthTensor_swap13 (A P g) (V P g) (B P g) (Q P g) (w P g) (z P g) (A_symm P g) (V_symm P g) (B_swap12 P g) (B_swap13 P g) (Q_swap13 P g) · exact fourthTensor_swap34 (A P g) (V P g) (B P g) (Q P g) (w P g) (z P g) (A_symm P g) (V_symm P g) (B_swap23 P g) (Q_swap34 P g) · exact F_trace P degree hP hdegree g hg hL hgn hgt /-- The algebraic tensor norm is the already defined invariant potential. -/ theorem normSq_A_eq_curvaturePotential : Source29GaussSimonsAlgebra.normSq (A P g) = Source29PolynomialCurvaturePotential.curvaturePotential P base := by rw [Source29PolynomialCurvaturePotential.curvaturePotential_at_base P degree hP (by omega) g hg hgn hgt] simp only [Source29GaussSimonsAlgebra.normSq, A, hessian, tangent, div_pow, ← Finset.sum_div] exact congrArg (fun v : ℝ => v/g^2) (Finset.sum_comm (f := fun i j : ι => (eval base (pderiv (some (some i)) (pderiv (some (some j)) P)))^2)) end end Source29PolynomialSimonsTensor /- Component: ContractedSimonsNorm.inc -/ namespace Source29ContractedSimonsNorm open Filter open scoped BigOperators Topology noncomputable section variable {ι κ : Type*} [Fintype ι] [Fintype κ] /-- The scalar estimate needs only the contraction of the tensor equation. This permits changes of orthonormal frame whose extra derivative terms are orthogonal to the tensor. -/ theorem scalar_simons_of_contraction (A : κ → ℝ) (dA ddA : ι → κ → ℝ) (dh ddh : ι → ℝ) (h m : ℝ) (hh : 0 < h) (hnorm : h^2 = ∑ j, A j^2) (hfirst : ∀ i, h * dh i = ∑ j, A j * dA i j) (hsecond : ∀ i, h * ddh i + (dh i)^2 = (∑ j, (dA i j)^2) + ∑ j, A j * ddA i j) (hcontract : (∑ i, ∑ j, A j * ddA i j) = (m - h^2)*h^2) : (m - h^2) * h ≤ ∑ i, ddh i := by have hk : (∑ i, (dh i)^2) ≤ ∑ i, ∑ j, (dA i j)^2 := by apply Finset.sum_le_sum intro i _ exact Source29SimonsNormAlgebra.norm_derivative_sq_le A (dA i) h (dh i) hh hnorm (hfirst i) have heq : h * (∑ i, ddh i) + (∑ i, (dh i)^2) = (∑ i, ∑ j, (dA i j)^2) + (m - h^2) * h^2 := by have hs := Finset.sum_congr (s₁ := Finset.univ) rfl (fun i _ => hsecond i) simpa only [Finset.sum_add_distrib, ← Finset.mul_sum, hcontract] using hs apply (mul_le_mul_iff_right₀ hh).mp nlinarith theorem scalar_simons_for_analytic_components (A : ι → κ → ℝ → ℝ) (h : ι → ℝ → ℝ) (A0 : κ → ℝ) (h0 m : ℝ) (hh : ∀ i, AnalyticAt ℝ (h i) 0) (hA : ∀ i j, AnalyticAt ℝ (A i j) 0) (hh0 : ∀ i, h i 0 = h0) (hA0 : ∀ i j, A i j 0 = A0 j) (hpos : 0 < h0) (hzero : h0^2 = ∑ j, (A0 j)^2) (hnorm : ∀ i, (fun t => (h i t)^2) =ᶠ[𝓝 (0 : ℝ)] (fun t => ∑ j, (A i j t)^2)) (hcontract : (∑ i, ∑ j, A0 j * deriv (deriv (A i j)) 0) = (m - h0^2)*h0^2) : (m - h0^2) * h0 ≤ ∑ i, deriv (deriv (h i)) 0 := by apply scalar_simons_of_contraction A0 (fun i j => deriv (A i j) 0) (fun i j => deriv (deriv (A i j)) 0) (fun i => deriv (h i) 0) (fun i => deriv (deriv (h i)) 0) h0 m hpos hzero · intro i simpa only [hh0, hA0] using (Source29AnalyticNormDerivatives.norm_first_second (h i) (A i) (hh i) (hA i) (hnorm i)).1 · intro i simpa only [hh0, hA0] using (Source29AnalyticNormDerivatives.norm_first_second (h i) (A i) (hh i) (hA i) (hnorm i)).2 · exact hcontract end end Source29ContractedSimonsNorm /- Component: AnalyticReflection.inc -/ namespace Source29AnalyticReflection open scoped BigOperators Matrix noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] def reflect (u v : κ → ℝ) : κ → ℝ := WithLp.ofLp ((ℝ ∙ (WithLp.toLp 2 u : EuclideanSpace ℝ κ)).reflection (WithLp.toLp 2 v)) theorem norm_sq_toLp (u : κ → ℝ) : ‖(WithLp.toLp 2 u : EuclideanSpace ℝ κ)‖^2 = u ⬝ᵥ u := by simpa only [dotProduct, pow_two] using EuclideanSpace.real_norm_sq_eq (WithLp.toLp 2 u) theorem reflect_apply (u v : κ → ℝ) (a : κ) : reflect u v a = 2 * ((u ⬝ᵥ v) / (u ⬝ᵥ u)) * u a - v a := by simp [reflect, Submodule.reflection_singleton_apply, norm_sq_toLp, PiLp.inner_apply, RCLike.inner_apply, dotProduct, mul_comm] <;> ring theorem reflect_dot (u v w : κ → ℝ) : reflect u v ⬝ᵥ reflect u w = v ⬝ᵥ w := by have he := (ℝ ∙ (WithLp.toLp 2 u : EuclideanSpace ℝ κ)).reflection.inner_map_map (WithLp.toLp 2 v) (WithLp.toLp 2 w) simpa only [reflect, dotProduct, PiLp.inner_apply, RCLike.inner_apply, conj_trivial, mul_comm] using he theorem reflect_involutive (u v : κ → ℝ) : reflect u (reflect u v) = v := by exact congrArg WithLp.ofLp (Submodule.reflection_reflection (ℝ ∙ (WithLp.toLp 2 u : EuclideanSpace ℝ κ)) (WithLp.toLp 2 v)) theorem reflect_self (u : κ → ℝ) : reflect u u = u := by unfold reflect rw [Submodule.reflection_mem_subspace_eq_self (Submodule.mem_span_singleton_self _)] theorem reflect_smul (u v : κ → ℝ) (c : ℝ) (hc : c ≠ 0) : reflect (c • u) v = reflect u v := by change WithLp.ofLp ((ℝ ∙ (c • WithLp.toLp 2 u : EuclideanSpace ℝ κ)).reflection (WithLp.toLp 2 v)) = _ simp only [Submodule.span_singleton_smul_eq (isUnit_iff_ne_zero.mpr hc)] rfl theorem reflect_orthogonal (u v : κ → ℝ) (h : u ⬝ᵥ v = 0) : reflect u v = -v := by funext a simp only [reflect_apply, h, zero_div, mul_zero, zero_mul, zero_sub, Pi.neg_apply] theorem reflect_sum (u v : κ → ℝ) (h : u ⬝ᵥ u = v ⬝ᵥ v) : reflect (u+v) u = v := by have hn : ‖(WithLp.toLp 2 u : EuclideanSpace ℝ κ)‖ = ‖(WithLp.toLp 2 v : EuclideanSpace ℝ κ)‖ := by have hs : ‖(WithLp.toLp 2 u : EuclideanSpace ℝ κ)‖^2 = ‖(WithLp.toLp 2 v : EuclideanSpace ℝ κ)‖^2 := by simpa only [norm_sq_toLp] using h nlinarith [norm_nonneg (WithLp.toLp 2 u : EuclideanSpace ℝ κ), norm_nonneg (WithLp.toLp 2 v : EuclideanSpace ℝ κ)] have he := Submodule.reflection_sub (v := (WithLp.toLp 2 u : EuclideanSpace ℝ κ)) (w := -(WithLp.toLp 2 v : EuclideanSpace ℝ κ)) (by simpa using hn) rw [sub_neg_eq_add, Submodule.reflection_orthogonal_apply] at he have he' := neg_injective he exact congrArg WithLp.ofLp he' variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] theorem reflect_analyticAt (u v : E → κ → ℝ) (x : E) (hu : ∀ a, AnalyticAt ℝ (fun y => u y a) x) (hv : ∀ a, AnalyticAt ℝ (fun y => v y a) x) (hne : u x ≠ 0) : AnalyticAt ℝ (fun y => reflect (u y) (v y)) x := by have hs := Source29CurvaturePotentialAnalytic.vectorSq_analytic u x hu have hn := (Source29CurvaturePotentialAnalytic.vectorSq_pos (u x) hne).ne' have hp : AnalyticAt ℝ (fun y => u y ⬝ᵥ v y) x := Source29CurvaturePotentialAnalytic.analytic_sum (fun a y => u y a * v y a) x (fun a => (hu a).mul (hv a)) apply AnalyticAt.pi intro a simp only [reflect_apply] exact ((analyticAt_const.mul (hp.div hs hn)).mul (hu a)).sub (hv a) end end Source29AnalyticReflection /- Component: AnalyticPairRotation.inc -/ namespace Source29AnalyticPairRotation open Source29AnalyticReflection open scoped BigOperators Matrix noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] def rotation (u v w : κ → ℝ) : κ → ℝ := reflect (u+v) (reflect u w) def inverseRotation (u v w : κ → ℝ) : κ → ℝ := reflect u (reflect (u+v) w) theorem rotation_dot (u v a b : κ → ℝ) : rotation u v a ⬝ᵥ rotation u v b = a ⬝ᵥ b := by simp only [rotation, reflect_dot] theorem inverseRotation_dot (u v a b : κ → ℝ) : inverseRotation u v a ⬝ᵥ inverseRotation u v b = a ⬝ᵥ b := by simp only [inverseRotation, reflect_dot] theorem rotation_inverse (u v w : κ → ℝ) : rotation u v (inverseRotation u v w) = w := by simp only [rotation, inverseRotation, reflect_involutive] theorem inverse_rotation (u v w : κ → ℝ) : inverseRotation u v (rotation u v w) = w := by simp only [rotation, inverseRotation, reflect_involutive] theorem rotation_move (u v : κ → ℝ) (h : u ⬝ᵥ u = v ⬝ᵥ v) : rotation u v u = v := by rw [rotation, reflect_self, reflect_sum u v h] theorem rotation_self (u w : κ → ℝ) : rotation u u w = w := by have he : u+u = (2 : ℝ) • u := (two_smul ℝ u).symm rw [rotation, he, reflect_smul u _ 2 (by norm_num), reflect_involutive] theorem inverseRotation_self (u w : κ → ℝ) : inverseRotation u u w = w := by have he := inverse_rotation u u w rwa [rotation_self] at he theorem rotation_fix (u v w : κ → ℝ) (hu : u ⬝ᵥ w = 0) (hv : v ⬝ᵥ w = 0) : rotation u v w = w := by have hs : (u+v) ⬝ᵥ (-w) = 0 := by rw [dotProduct_neg, add_dotProduct, hu, hv] ring rw [rotation, reflect_orthogonal u w hu, reflect_orthogonal (u+v) (-w) hs, neg_neg] variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] theorem rotation_analyticAt (u : κ → ℝ) (v w : E → κ → ℝ) (x : E) (hu : u ≠ 0) (hs : u + v x ≠ 0) (hv : ∀ a, AnalyticAt ℝ (fun y => v y a) x) (hw : ∀ a, AnalyticAt ℝ (fun y => w y a) x) : AnalyticAt ℝ (fun y => rotation u (v y) (w y)) x := by have hi := reflect_analyticAt (fun _ : E => u) w x (fun _ => analyticAt_const) hw hu exact reflect_analyticAt (fun y => u + v y) (fun y => reflect u (w y)) x (fun a => analyticAt_const.add (hv a)) (analyticAt_pi_iff.mp hi) hs theorem inverseRotation_analyticAt (u : κ → ℝ) (v w : E → κ → ℝ) (x : E) (hu : u ≠ 0) (hs : u + v x ≠ 0) (hv : ∀ a, AnalyticAt ℝ (fun y => v y a) x) (hw : ∀ a, AnalyticAt ℝ (fun y => w y a) x) : AnalyticAt ℝ (fun y => inverseRotation u (v y) (w y)) x := by have hi := reflect_analyticAt (fun y => u + v y) w x (fun a => analyticAt_const.add (hv a)) hw hs exact reflect_analyticAt (fun _ : E => u) (fun y => reflect (u + v y) (w y)) x (fun _ => analyticAt_const) (analyticAt_pi_iff.mp hi) hu end end Source29AnalyticPairRotation /- Component: AnalyticPairFrame.inc -/ namespace Source29AnalyticPairFrame open Source29AnalyticPairRotation open scoped BigOperators Matrix noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] def frame (u v x y w : κ → ℝ) : κ → ℝ := rotation u x (rotation v (inverseRotation u x y) w) theorem frame_dot (u v x y a b : κ → ℝ) : frame u v x y a ⬝ᵥ frame u v x y b = a ⬝ᵥ b := by simp only [frame, rotation_dot] theorem frame_self (u v w : κ → ℝ) : frame u v u v w = w := by simp only [frame, rotation_self, inverseRotation_self] theorem frame_pair (u v x y : κ → ℝ) (hx : u ⬝ᵥ u = x ⬝ᵥ x) (hy : v ⬝ᵥ v = y ⬝ᵥ y) (huv : u ⬝ᵥ v = 0) (hxy : x ⬝ᵥ y = 0) : frame u v x y u = x ∧ frame u v x y v = y := by let m := inverseRotation u x y have hmnorm : v ⬝ᵥ v = m ⬝ᵥ m := by dsimp [m] rw [inverseRotation_dot] exact hy have hmu : m ⬝ᵥ u = 0 := by have he := rotation_dot u x m u rw [rotation_move u x hx, rotation_inverse] at he rw [← he, dotProduct_comm, hxy] have hvu : v ⬝ᵥ u = 0 := by rw [dotProduct_comm, huv] constructor · change rotation u x (rotation v m u) = x rw [rotation_fix v m u hvu hmu, rotation_move u x hx] · change rotation u x (rotation v m v) = y rw [rotation_move v m hmnorm] exact rotation_inverse u x y variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] theorem frame_analyticAt (u v : κ → ℝ) (x y w : E → κ → ℝ) (p : E) (hu : u ≠ 0) (hv : v ≠ 0) (hx0 : x p = u) (hy0 : y p = v) (hx : ∀ a, AnalyticAt ℝ (fun q => x q a) p) (hy : ∀ a, AnalyticAt ℝ (fun q => y q a) p) (hw : ∀ a, AnalyticAt ℝ (fun q => w q a) p) : AnalyticAt ℝ (fun q => frame u v (x q) (y q) (w q)) p := by have hsu : u + x p ≠ 0 := by rw [hx0, ← two_smul ℝ u] exact smul_ne_zero (by norm_num) hu let m := fun q => inverseRotation u (x q) (y q) have hm : AnalyticAt ℝ m p := inverseRotation_analyticAt u x y p hu hsu hx hy have hm0 : m p = v := by simp only [m, hx0, hy0, inverseRotation_self] have hsv : v + m p ≠ 0 := by rw [hm0, ← two_smul ℝ v] exact smul_ne_zero (by norm_num) hv have hi := rotation_analyticAt v m w p hv hsv (analyticAt_pi_iff.mp hm) hw exact rotation_analyticAt u x (fun q => rotation v (m q) (w q)) p hu hsu hx (analyticAt_pi_iff.mp hi) end end Source29AnalyticPairFrame /- Component: ReflectionCurveDerivative.inc -/ namespace Source29ReflectionCurveDerivative open Source29AnalyticReflection Source29AnalyticPairRotation open scoped BigOperators Matrix noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] theorem hasDerivAt_dot (u v : ℝ → κ → ℝ) (du dv : κ → ℝ) (hu : ∀ a, HasDerivAt (fun t => u t a) (du a) 0) (hv : ∀ a, HasDerivAt (fun t => v t a) (dv a) 0) : HasDerivAt (fun t => u t ⬝ᵥ v t) (du ⬝ᵥ v 0 + u 0 ⬝ᵥ dv) 0 := by simpa only [dotProduct, Finset.sum_add_distrib, Pi.mul_def] using (HasDerivAt.fun_sum (fun a (_ : a ∈ Finset.univ) => (hu a).mul (hv a))) theorem dot_reflect (u v w : κ → ℝ) : v ⬝ᵥ reflect u w = 2 * ((u ⬝ᵥ w)/(u ⬝ᵥ u)) * (v ⬝ᵥ u) - v ⬝ᵥ w := by calc _ = ∑ a, (2*((u ⬝ᵥ w)/(u ⬝ᵥ u))*(v a*u a) - v a*w a) := by apply Finset.sum_congr rfl intro a _ rw [reflect_apply] ring _ = _ := by simp only [Finset.sum_sub_distrib, ← Finset.mul_sum, dotProduct] theorem self_dot_reflect (u v : κ → ℝ) : u ⬝ᵥ reflect u v = u ⬝ᵥ v := by have he := reflect_dot u u v rwa [reflect_self] at he theorem hasDerivAt_reflect (u v : ℝ → κ → ℝ) (du dv : κ → ℝ) (hu : ∀ a, HasDerivAt (fun t => u t a) (du a) 0) (hv : ∀ a, HasDerivAt (fun t => v t a) (dv a) 0) (hne : u 0 ≠ 0) (a : κ) : HasDerivAt (fun t => reflect (u t) (v t) a) (2 * (((du ⬝ᵥ v 0 + u 0 ⬝ᵥ dv)*(u 0 ⬝ᵥ u 0) - (u 0 ⬝ᵥ v 0)*(du ⬝ᵥ u 0 + u 0 ⬝ᵥ du))/(u 0 ⬝ᵥ u 0)^2) * u 0 a + 2*((u 0 ⬝ᵥ v 0)/(u 0 ⬝ᵥ u 0))*du a - dv a) 0 := by have hp := hasDerivAt_dot u v du dv hu hv have hs := hasDerivAt_dot u u du du hu hu have hn : u 0 ⬝ᵥ u 0 ≠ 0 := (Source29CurvaturePotentialAnalytic.vectorSq_pos (u 0) hne).ne' have he := ((((hp.div hs hn).const_mul 2).mul (hu a)).sub (hv a)) simpa only [reflect_apply, Pi.mul_def, Pi.div_def, Pi.sub_def] using he theorem hasDerivAt_reflect_const (u : κ → ℝ) (v : ℝ → κ → ℝ) (dv : κ → ℝ) (hv : ∀ a, HasDerivAt (fun t => v t a) (dv a) 0) (a : κ) : HasDerivAt (fun t => reflect u (v t) a) (reflect u dv a) 0 := by have hp := hasDerivAt_dot (fun _ => u) v 0 dv (fun a => hasDerivAt_const 0 (u a)) hv simp only [zero_dotProduct, zero_add] at hp have he := ((((hp.div_const (u ⬝ᵥ u)).const_mul 2).mul_const (u a)).sub (hv a)) simpa only [reflect_apply, Pi.mul_def, Pi.div_def, Pi.sub_def] using he /-- The two-reflection rotation has the usual infinitesimal skew action at its identity point, proved for actual differentiable coordinate curves. -/ theorem hasDerivAt_rotation (u : κ → ℝ) (v w : ℝ → κ → ℝ) (dv dw : κ → ℝ) (hunit : u ⬝ᵥ u = 1) (hv0 : v 0 = u) (hv : ∀ a, HasDerivAt (fun t => v t a) (dv a) 0) (hw : ∀ a, HasDerivAt (fun t => w t a) (dw a) 0) (a : κ) : HasDerivAt (fun t => rotation u (v t) (w t) a) (dw a + (u ⬝ᵥ w 0)*dv a - (dv ⬝ᵥ w 0)*u a) 0 := by have hz : ∀ a, HasDerivAt (fun t => (u + v t) a) (dv a) 0 := by intro a simpa only [zero_add, Pi.add_def] using (hasDerivAt_const 0 (u a)).add (hv a) have hn : u + v 0 ≠ 0 := by intro he have hs : (u + v 0) ⬝ᵥ (u + v 0) = 4 := by simp only [hv0, add_dotProduct, dotProduct_add, hunit] norm_num rw [he, zero_dotProduct] at hs norm_num at hs have he := hasDerivAt_reflect (fun t => u + v t) (fun t => reflect u (w t)) dv (reflect u dw) hz (hasDerivAt_reflect_const u w dw hw) hn a convert he using 1 · rfl · simp only [hv0, add_dotProduct, dotProduct_add, hunit, self_dot_reflect, dot_reflect, reflect_apply, Pi.add_apply, div_one] rw [dotProduct_comm dv u] ring end end Source29ReflectionCurveDerivative /- Component: PairFrameDerivative.inc -/ namespace Source29PairFrameDerivative open Source29AnalyticPairRotation Source29AnalyticPairFrame Source29ReflectionCurveDerivative open scoped BigOperators Matrix noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] def velocity (f : ℝ → κ → ℝ) : κ → ℝ := fun a => deriv (fun t => f t a) 0 theorem inverseRotation_deriv (u : κ → ℝ) (v w : ℝ → κ → ℝ) (hunit : u ⬝ᵥ u = 1) (hv0 : v 0 = u) (hv : ∀ a, AnalyticAt ℝ (fun t => v t a) 0) (hw : ∀ a, AnalyticAt ℝ (fun t => w t a) 0) (a : κ) : deriv (fun t => inverseRotation u (v t) (w t) a) 0 = velocity w a - (u ⬝ᵥ w 0)*velocity v a + (velocity v ⬝ᵥ w 0)*u a := by have hu : u ≠ 0 := by intro he; rw [he, zero_dotProduct] at hunit; norm_num at hunit have hs : u + v 0 ≠ 0 := by rw [hv0, ← two_smul ℝ u] exact smul_ne_zero (by norm_num) hu let m := fun t => inverseRotation u (v t) (w t) have hm := inverseRotation_analyticAt u v w 0 hu hs hv hw have hm0 : m 0 = w 0 := by simp only [m, hv0, inverseRotation_self] have hd := hasDerivAt_rotation u v m (velocity v) (velocity m) hunit hv0 (fun b => (hv b).differentiableAt.hasDerivAt) (fun b => (analyticAt_pi_iff.mp hm b).differentiableAt.hasDerivAt) a have hf : (fun t => rotation u (v t) (m t) a) = (fun t => w t a) := by funext t exact congrFun (rotation_inverse u (v t) (w t)) a rw [hf] at hd have he := hd.unique (hw a).differentiableAt.hasDerivAt rw [hm0] at he change velocity m a + (u ⬝ᵥ w 0)*velocity v a - (velocity v ⬝ᵥ w 0)*u a = velocity w a at he change velocity m a = _ linarith /-- The frame's derivative on the orthogonal complement has no tangential rotation at its base point. This follows from the actual reflection formula. -/ theorem frame_deriv (u v e : κ → ℝ) (x y : ℝ → κ → ℝ) (hu : u ⬝ᵥ u = 1) (hv : v ⬝ᵥ v = 1) (huv : u ⬝ᵥ v = 0) (hue : u ⬝ᵥ e = 0) (hve : v ⬝ᵥ e = 0) (hx0 : x 0 = u) (hy0 : y 0 = v) (hx : ∀ a, AnalyticAt ℝ (fun t => x t a) 0) (hy : ∀ a, AnalyticAt ℝ (fun t => y t a) 0) (a : κ) : deriv (fun t => frame u v (x t) (y t) e a) 0 = -(velocity x ⬝ᵥ e)*u a - (velocity y ⬝ᵥ e)*v a := by have hun : u ≠ 0 := by intro he; rw [he, zero_dotProduct] at hu; norm_num at hu have hs : u + x 0 ≠ 0 := by rw [hx0, ← two_smul ℝ u] exact smul_ne_zero (by norm_num) hun let m := fun t => inverseRotation u (x t) (y t) have hm := inverseRotation_analyticAt u x y 0 hun hs hx hy have hm0 : m 0 = v := by simp only [m, hx0, hy0, inverseRotation_self] have hdm : velocity m = velocity y + (velocity x ⬝ᵥ v) • u := by funext b have he := inverseRotation_deriv u x y hu hx0 hx hy b simpa only [velocity, m, hy0, huv, zero_mul, sub_zero, Pi.add_apply, Pi.smul_apply, smul_eq_mul] using he have hdot : velocity m ⬝ᵥ e = velocity y ⬝ᵥ e := by rw [hdm, add_dotProduct, smul_dotProduct, hue, smul_zero, add_zero] let b := fun t => rotation v (m t) e have hb0 : b 0 = e := by simp only [b, hm0, rotation_self] have hb : ∀ j, HasDerivAt (fun t => b t j) (-(velocity y ⬝ᵥ e)*v j) 0 := by intro j have he := hasDerivAt_rotation v m (fun _ => e) (velocity m) 0 hv hm0 (fun j => (analyticAt_pi_iff.mp hm j).differentiableAt.hasDerivAt) (fun j => hasDerivAt_const 0 (e j)) j simpa only [Pi.zero_apply, hve, zero_mul, hdot, zero_add, zero_sub, neg_mul] using he have he := hasDerivAt_rotation u x b (velocity x) (fun j => -(velocity y ⬝ᵥ e)*v j) hu hx0 (fun j => (hx j).differentiableAt.hasDerivAt) hb a have hh := he.deriv rw [hb0, hue, zero_mul, add_zero] at hh change deriv (fun t => frame u v (x t) (y t) e a) 0 = _ at hh rw [hh] ring end end Source29PairFrameDerivative /- Component: PolynomialUnitNormal.inc -/ namespace Source29PolynomialUnitNormal open MvPolynomial Source29PolynomialLinkChart Source29PolynomialJacobiCurves open Source29PolynomialCurvaturePotential open Source29QuarticReuse.QuarticPolynomialBasics (evalFDeriv_self_of_isHomogeneous evalFDeriv_apply) open scoped BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def unitNormal (P : MvPolynomial (Option (Option ι)) ℝ) (x : Ambient ι) : Ambient ι := fun a => jacobiProfile P x * eval x (pderiv a P) theorem unitNormal_analyticAt (P : MvPolynomial (Option (Option ι)) ℝ) (x : Ambient ι) (hreg : gradientAt P x ≠ 0) : AnalyticAt ℝ (unitNormal P) x := by apply AnalyticAt.pi intro a exact (jacobiProfile_analyticAt P x hreg).mul (analyticAt_eval_real (pderiv a P) x) theorem unitNormal_dot_self (P : MvPolynomial (Option (Option ι)) ℝ) (x : Ambient ι) (hreg : gradientAt P x ≠ 0) : unitNormal P x ⬝ᵥ unitNormal P x = 1 := by let v := gradientAt P x let q := Source29AnalyticTensorNorm.tensorNorm v have hq : q ≠ 0 := (Source29AnalyticTensorNorm.tensorNorm_pos hreg).ne' have hs : q^2 = ∑ a, (v a)^2 := Source29AnalyticTensorNorm.tensorNorm_sq v change (∑ a, (q⁻¹ * v a) * (q⁻¹ * v a)) = 1 calc _ = q⁻¹^2 * (∑ a, (v a)^2) := by rw [Finset.mul_sum] apply Finset.sum_congr rfl intro a _ ring _ = 1 := by rw [← hs]; field_simp theorem radial_dot_unitNormal (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (x : Ambient ι) (hzero : eval x P = 0) : x ⬝ᵥ unitNormal P x = 0 := by have he := evalFDeriv_self_of_isHomogeneous P d hP x rw [hzero, mul_zero] at he have ht : (∑ a, x a * eval x (pderiv a P)) = 0 := by simpa only [evalFDeriv_apply, mul_comm] using he calc _ = jacobiProfile P x * (∑ a, x a * eval x (pderiv a P)) := by simp only [unitNormal, dotProduct, Finset.mul_sum] apply Finset.sum_congr rfl intro a _ ring _ = 0 := by rw [ht, mul_zero] theorem unitNormal_at_base (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (hg : 0 < g) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) : unitNormal P base = Pi.single none 1 := by funext a cases a with | none => simp [unitNormal, jacobiProfile_at_base P g hg hgn hgt, hgn, hg.ne'] | some a => simp [unitNormal, hgt] end end Source29PolynomialUnitNormal /- Component: PolynomialTangentFrame.inc -/ namespace Source29PolynomialTangentFrame open Filter MvPolynomial Source29PolynomialLinkChart Source29PolynomialCurvaturePotential open Source29PolynomialUnitNormal Source29AnalyticPairFrame Source29NormalizedLinkJets open scoped BigOperators Matrix Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem single_dot_single (a b : Option (Option ι)) : (Pi.single a 1 : Ambient ι) ⬝ᵥ Pi.single b 1 = if a = b then 1 else 0 := by simp [dotProduct, Pi.single_apply, eq_comm] def tangentFrame (P : MvPolynomial (Option (Option ι)) ℝ) (C : ℝ → Ambient ι) (j : ι) (t : ℝ) : Ambient ι := frame base (Pi.single none 1) (C t) (unitNormal P (C t)) (Pi.single (tangent j) 1) /-- Actual analytic orthonormal tangent frames along any analytic link curve through the normalized regular point. Derivative formulas are not assumed. -/ theorem exists_analytic_tangent_frame (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (g : ℝ) (hg : 0 < g) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (hmem : ∀ᶠ t in 𝓝 (0 : ℝ), eval (C t) P = 0 ∧ (∑ a, (C t a)^2) = 1) : ∃ E : ι → ℝ → Ambient ι, E = tangentFrame P C ∧ (∀ j, AnalyticAt ℝ (E j) 0) ∧ (∀ j, E j 0 = Pi.single (tangent j) 1) ∧ (∀ t j k, E j t ⬝ᵥ E k t = if j = k then 1 else 0) ∧ (∀ᶠ t in 𝓝 (0 : ℝ), ∀ j, E j t ⬝ᵥ C t = 0 ∧ E j t ⬝ᵥ unitNormal P (C t) = 0) := by let n : Ambient ι := Pi.single none 1 let e : ι → Ambient ι := fun j => Pi.single (tangent j) 1 let E : ι → ℝ → Ambient ι := tangentFrame P C have hreg : gradientAt P base ≠ 0 := by intro he have hn := congrFun he none simp only [gradientAt, hgn, Pi.zero_apply] at hn exact hg.ne' hn have hN0 : unitNormal P (C 0) = n := by rw [hC0] exact unitNormal_at_base P g hg hgn hgt have hN : AnalyticAt ℝ (fun t => unitNormal P (C t)) 0 := by have hr : gradientAt P (C 0) ≠ 0 := by simpa only [hC0] using hreg exact (unitNormal_analyticAt P (C 0) hr).comp hC have hu : (base : Ambient ι) ≠ 0 := by simp [base] have hn : n ≠ 0 := by simp [n] have hE : ∀ j, AnalyticAt ℝ (E j) 0 := by intro j exact frame_analyticAt base n C (fun t => unitNormal P (C t)) (fun _ => e j) 0 hu hn hC0 hN0 (analyticAt_pi_iff.mp hC) (analyticAt_pi_iff.mp hN) (fun _ => analyticAt_const) have hE0 : ∀ j, E j 0 = e j := by intro j simp only [E, tangentFrame, hC0, unitNormal_at_base P g hg hgn hgt, n, e, frame_self] have hca : AnalyticAt ℝ (fun t => eval (C t) (pderiv none P)) 0 := (analyticAt_eval_real (pderiv none P) (C 0)).comp hC have hcp : 0 < eval (C 0) (pderiv none P) := by simpa only [hC0, hgn] using hg have hnear : ∀ᶠ t in 𝓝 (0 : ℝ), gradientAt P (C t) ≠ 0 := by filter_upwards [hca.continuousAt.eventually (eventually_gt_nhds hcp)] with t ht intro he have hz := congrFun he none exact ht.ne' (by simpa only [gradientAt, Pi.zero_apply] using hz) refine ⟨E, rfl, hE, hE0, ?_, ?_⟩ · intro t j k change frame base n (C t) (unitNormal P (C t)) (e j) ⬝ᵥ frame base n (C t) (unitNormal P (C t)) (e k) = _ rw [frame_dot] simpa only [e, single_dot_single, tangent, Option.some.injEq] using (single_dot_single (tangent j) (tangent k)) · filter_upwards [hmem, hnear] with t ht hr have hx : (base : Ambient ι) ⬝ᵥ base = C t ⬝ᵥ C t := by have hb : (base : Ambient ι) ⬝ᵥ base = 1 := by simp [base, single_dot_single] rw [hb] simpa only [dotProduct, pow_two] using ht.2.symm have hy : n ⬝ᵥ n = unitNormal P (C t) ⬝ᵥ unitNormal P (C t) := by rw [unitNormal_dot_self P (C t) hr] simp [n, single_dot_single] have huv : (base : Ambient ι) ⬝ᵥ n = 0 := by simp [base, n, single_dot_single] have hxy : C t ⬝ᵥ unitNormal P (C t) = 0 := radial_dot_unitNormal P d hP (C t) ht.1 have hp := frame_pair base n (C t) (unitNormal P (C t)) hx hy huv hxy intro j constructor · calc E j t ⬝ᵥ C t = E j t ⬝ᵥ frame base n (C t) (unitNormal P (C t)) base := congrArg (fun z => E j t ⬝ᵥ z) hp.1.symm _ = e j ⬝ᵥ base := frame_dot base n (C t) (unitNormal P (C t)) (e j) base _ = 0 := by simp [e, base, tangent, single_dot_single] · calc E j t ⬝ᵥ unitNormal P (C t) = E j t ⬝ᵥ frame base n (C t) (unitNormal P (C t)) n := congrArg (fun z => E j t ⬝ᵥ z) hp.2.symm _ = e j ⬝ᵥ n := frame_dot base n (C t) (unitNormal P (C t)) (e j) n _ = 0 := by simp [e, n, tangent, single_dot_single] end end Source29PolynomialTangentFrame /- Component: PolynomialTangentFrameJets.inc -/ namespace Source29PolynomialTangentFrameJets open MvPolynomial Source29PolynomialLinkChart Source29PolynomialCurvaturePotential open Source29PolynomialJacobiCurves Source29PolynomialUnitNormal Source29PolynomialTangentFrame open Source29NormalizedLinkJets Source29PairFrameDerivative open scoped BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem unitNormal_tangent_deriv (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (hg : 0 < g) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (i j : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) : deriv (fun t => unitNormal P (C t) (tangent j)) 0 = A P g i j := by have hr : gradientAt P (C 0) ≠ 0 := by rw [hC0] intro he have hn := congrFun he none exact hg.ne' (by simpa only [gradientAt, hgn, Pi.zero_apply] using hn) have hφ := (jacobiProfile_analyticAt P (C 0) hr).comp hC have hv := (analyticAt_eval_real (pderiv (tangent j) P) (C 0)).comp hC have hd := Source29PolynomialCurveCoordinateJets.coordinate_velocity_first (pderiv (tangent j) P) (fun a t => C t a) base (tangent i) (analyticAt_pi_iff.mp hC) (fun a => congrFun hC0 a) hC1 have he := (hφ.differentiableAt.hasDerivAt.mul hv.differentiableAt.hasDerivAt).deriv simp only [Pi.mul_def, Function.comp_def] at he change deriv (fun t => jacobiProfile P (C t) * eval (C t) (pderiv (tangent j) P)) 0 = _ rw [he, hC0, jacobiProfile_at_base P g hg hgn hgt, hd] have hj : eval base (pderiv (tangent j) P) = 0 := hgt (some j) rw [hj] simp only [A, Source29PolynomialTangentialDerivative.hessian] ring /-- The actual analytic tangent frame has zero tangential connection at the base point and the prescribed normal and radial first derivatives. -/ theorem tangentFrame_first_deriv (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (hg : 0 < g) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (i j : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (a : Option (Option ι)) : deriv (fun t => tangentFrame P C j t a) 0 = -(if i = j then 1 else 0) * base a - A P g i j * Pi.single (M := fun _ => ℝ) none 1 a := by let n : Ambient ι := Pi.single none 1 let e : Ambient ι := Pi.single (tangent j) 1 let N := fun t => unitNormal P (C t) have hr : gradientAt P (C 0) ≠ 0 := by rw [hC0] intro he have hn := congrFun he none exact hg.ne' (by simpa only [gradientAt, hgn, Pi.zero_apply] using hn) have hN := (unitNormal_analyticAt P (C 0) hr).comp hC have hN0 : N 0 = n := by change unitNormal P (C 0) = n rw [hC0] exact unitNormal_at_base P g hg hgn hgt have he := frame_deriv base n e C N (by simp [base, single_dot_single]) (by simp [n, single_dot_single]) (by simp [base, n, single_dot_single]) (by simp [base, e, tangent, single_dot_single]) (by simp [n, e, tangent, single_dot_single]) hC0 hN0 (analyticAt_pi_iff.mp hC) (analyticAt_pi_iff.mp hN) a have hdx : velocity C ⬝ᵥ e = if i = j then 1 else 0 := by simp [velocity, e, dotProduct, Pi.single_apply, hC1, tangent, eq_comm] have hdy : velocity N ⬝ᵥ e = A P g i j := by simpa only [velocity, e, N, dotProduct, Pi.single_apply, mul_ite, mul_one, mul_zero, Finset.sum_ite_eq, Finset.sum_ite_eq', Finset.mem_univ, ite_true] using unitNormal_tangent_deriv P g hg hgn hgt C hC hC0 i j hC1 rw [hdx, hdy] at he exact he end end Source29PolynomialTangentFrameJets /- Component: PairFrameMatrix.inc -/ namespace Source29PairFrameMatrix open Source29AnalyticPairFrame open scoped BigOperators Matrix noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] /-- Matrix with columns supplied by the actual reflection frame. -/ def frameMatrix (u v x y : κ → ℝ) : Matrix κ κ ℝ := fun a b => frame u v x y (Pi.single b 1) a theorem frameMatrix_transpose_mul (u v x y : κ → ℝ) : (frameMatrix u v x y).transpose * frameMatrix u v x y = 1 := by ext i j change frame u v x y (Pi.single i 1) ⬝ᵥ frame u v x y (Pi.single j 1) = _ rw [frame_dot] simp [dotProduct, Pi.single_apply, Matrix.one_apply, eq_comm] theorem frameMatrix_mul_transpose (u v x y : κ → ℝ) : frameMatrix u v x y * (frameMatrix u v x y).transpose = 1 := mul_eq_one_comm.mp (frameMatrix_transpose_mul u v x y) theorem frameMatrix_mul_single (u v x y : κ → ℝ) (b : κ) : frameMatrix u v x y *ᵥ Pi.single b 1 = frame u v x y (Pi.single b 1) := by ext a simp [Matrix.mulVec, dotProduct, Pi.single_apply, frameMatrix] end end Source29PairFrameMatrix /- Component: PolynomialFramedCurvature.inc -/ namespace Source29PolynomialFramedCurvature open MvPolynomial Source29PolynomialLinkChart Source29PolynomialCurvaturePotential open Source29PolynomialJacobiCurves Source29PolynomialUnitNormal Source29NormalizedLinkJets open Source29QuarticReuse.QuarticMinimal Source29QuarticReuse.QuarticMinimal.AmbientQuartic open scoped BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- The second fundamental form expressed in the tangent columns of U. -/ def framedSecondForm (P : MvPolynomial (Option (Option ι)) ℝ) (x : Ambient ι) (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (i j : ι) : ℝ := jacobiProfile P x * (U.transpose * realHessian P x * U) (tangent i) (tangent j) /-- A frame with radial column x and normal column the unit gradient normalizes the polynomial without imposing its minimal equation. -/ theorem frame_normalizes_gradient (P : MvPolynomial (Option (Option ι)) ℝ) (x : Ambient ι) (hreg : gradientAt P x ≠ 0) (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (hUt : U.transpose * U = 1) (hbase : U *ᵥ base = x) (hUn : ∀ a, U a none = unitNormal P x a) : eval base (pderiv none (changeVariables U P)) = Source29AnalyticTensorNorm.tensorNorm (gradientAt P x) ∧ (∀ j, eval base (pderiv (some j) (changeVariables U P)) = 0) := by let g := Source29AnalyticTensorNorm.tensorNorm (gradientAt P x) have hg : g ≠ 0 := (Source29AnalyticTensorNorm.tensorNorm_pos hreg).ne' have hgrad : ∀ a, eval x (pderiv a P) = g * U a none := by intro a rw [hUn] change eval x (pderiv a P) = g * (g⁻¹ * eval x (pderiv a P)) rw [← mul_assoc, mul_inv_cancel₀ hg, one_mul] have hcol : ∀ j, (∑ a, U a none * U a j) = if none = j then 1 else 0 := by intro j have he := congrArg (fun M : Matrix (Option (Option ι)) (Option (Option ι)) ℝ => M none j) hUt simpa only [Matrix.mul_apply, Matrix.transpose_apply, Matrix.one_apply] using he have hpartial : ∀ j, eval base (pderiv j (changeVariables U P)) = g * (if none = j then 1 else 0) := by intro j rw [pderiv_changeVariables, map_sum] simp only [map_mul, eval_C, eval_changeVariables, hbase] simp_rw [hgrad, mul_assoc] rw [← Finset.mul_sum, hcol] constructor · simpa using hpartial none · intro j simpa using hpartial (some j) /-- The invariant curvature potential is the squared norm of the Hessian in every orthonormal frame with the prescribed radial and normal columns. -/ theorem framedSecondForm_norm_sq (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 2 ≤ d) (x : Ambient ι) (hreg : gradientAt P x ≠ 0) (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (hUt : U.transpose * U = 1) (hbase : U *ᵥ base = x) (hUn : ∀ a, U a none = unitNormal P x a) : (∑ i, ∑ j, (framedSecondForm P x U i j)^2) = curvaturePotential P x := by let g := Source29AnalyticTensorNorm.tensorNorm (gradientAt P x) have hg : g ≠ 0 := (Source29AnalyticTensorNorm.tensorNorm_pos hreg).ne' obtain ⟨hgn, hgt⟩ := frame_normalizes_gradient P x hreg U hUt hbase hUn have hU : U * U.transpose = 1 := mul_eq_one_comm.mp hUt have he := curvaturePotential_changeVariables U hU P base rw [hbase, curvaturePotential_at_base _ d (isHomogeneous_changeVariables U P d hP) hd g hg hgn hgt] at he rw [← he] have hH := realHessian_changeVariables U P base rw [hbase] at hH change (∑ i, ∑ j, (g⁻¹ * (U.transpose * realHessian P x * U) (tangent i) (tangent j))^2) = _ rw [← hH] simp only [realHessian_apply, mul_pow, ← Finset.mul_sum] rw [Finset.sum_comm] simp only [inv_pow, div_eq_mul_inv, mul_comm, tangent] end end Source29PolynomialFramedCurvature /- Component: PolynomialMovingCurvature.inc -/ namespace Source29PolynomialMovingCurvature open Filter MvPolynomial Source29PolynomialLinkChart Source29PolynomialCurvaturePotential open Source29PolynomialJacobiCurves Source29PolynomialUnitNormal Source29NormalizedLinkJets open Source29PolynomialTangentFrame Source29AnalyticPairFrame Source29PairFrameMatrix open Source29PolynomialFramedCurvature Source29CurvaturePotentialAnalytic open Source29QuarticReuse.QuarticMinimal.AmbientQuartic open scoped BigOperators Matrix Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def linkFrameMatrix (P : MvPolynomial (Option (Option ι)) ℝ) (x : Ambient ι) : Matrix (Option (Option ι)) (Option (Option ι)) ℝ := frameMatrix base (Pi.single none 1) x (unitNormal P x) /-- Actual Hessian components along the constructed analytic tangent frame. -/ def tangentSecondForm (P : MvPolynomial (Option (Option ι)) ℝ) (C : ℝ → Ambient ι) (i j : ι) (t : ℝ) : ℝ := jacobiProfile P (C t) * (∑ b, ∑ a, tangentFrame P C i t a * realHessian P (C t) a b * tangentFrame P C j t b) theorem tangentSecondForm_eq_framed (P : MvPolynomial (Option (Option ι)) ℝ) (C : ℝ → Ambient ι) (i j : ι) (t : ℝ) : tangentSecondForm P C i j t = framedSecondForm P (C t) (linkFrameMatrix P (C t)) i j := by simp only [tangentSecondForm, framedSecondForm, Matrix.mul_apply, Matrix.transpose_apply, Finset.sum_mul, tangentFrame, linkFrameMatrix, frameMatrix] theorem linkFrameMatrix_pair (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (x : Ambient ι) (hx : (∑ a, (x a)^2) = 1) (hz : eval x P = 0) (hr : gradientAt P x ≠ 0) : linkFrameMatrix P x *ᵥ base = x ∧ (∀ a, linkFrameMatrix P x a none = unitNormal P x a) := by have hxx : (base : Ambient ι) ⬝ᵥ base = x ⬝ᵥ x := by have hb : (base : Ambient ι) ⬝ᵥ base = 1 := by simp [base, single_dot_single] rw [hb] simpa only [dotProduct, pow_two] using hx.symm have hnn : (Pi.single none 1 : Ambient ι) ⬝ᵥ Pi.single none 1 = unitNormal P x ⬝ᵥ unitNormal P x := by rw [unitNormal_dot_self P x hr] simp [single_dot_single] have hrn : (base : Ambient ι) ⬝ᵥ Pi.single none 1 = 0 := by simp [base, single_dot_single] have hp := frame_pair base (Pi.single none 1) x (unitNormal P x) hxx hnn hrn (radial_dot_unitNormal P d hP x hz) constructor · simpa only [linkFrameMatrix, base, frameMatrix_mul_single] using hp.1 · intro a exact congrFun hp.2 a theorem tangentSecondForm_norm_sq_at (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 2 ≤ d) (C : ℝ → Ambient ι) (t : ℝ) (hx : (∑ a, (C t a)^2) = 1) (hz : eval (C t) P = 0) (hr : gradientAt P (C t) ≠ 0) : (∑ i, ∑ j, (tangentSecondForm P C i j t)^2) = curvaturePotential P (C t) := by simp_rw [tangentSecondForm_eq_framed] obtain ⟨hbase, hnormal⟩ := linkFrameMatrix_pair P d hP (C t) hx hz hr exact framedSecondForm_norm_sq P d hP hd (C t) hr (linkFrameMatrix P (C t)) (frameMatrix_transpose_mul _ _ _ _) hbase hnormal variable (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (g : ℝ) (hg : 0 < g) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (hmem : ∀ᶠ t in 𝓝 (0 : ℝ), eval (C t) P = 0 ∧ (∑ a, (C t a)^2) = 1) include hg hgn hgt hC0 in theorem regular_at_curve_zero : gradientAt P (C 0) ≠ 0 := by rw [hC0] intro he have hn := congrFun he none exact hg.ne' (by simpa only [gradientAt, hgn, Pi.zero_apply] using hn) include hP hg hgn hgt hC hC0 hmem in theorem tangentSecondForm_analyticAt (i j : ι) : AnalyticAt ℝ (tangentSecondForm P C i j) 0 := by obtain ⟨E, rfl, hE, hE0, horth, htan⟩ := exists_analytic_tangent_frame P d hP g hg hgn hgt C hC hC0 hmem have hφ := (jacobiProfile_analyticAt P (C 0) (regular_at_curve_zero P g hg hgn hgt C hC0)).comp hC have hH : ∀ a b, AnalyticAt ℝ (fun t => realHessian P (C t) a b) 0 := by intro a b exact (analyticAt_eval_real (pderiv a (pderiv b P)) (C 0)).comp hC apply hφ.mul apply analytic_sum intro b apply analytic_sum intro a exact (((analyticAt_pi_iff.mp (hE i)) a).mul (hH a b)).mul ((analyticAt_pi_iff.mp (hE j)) b) include hg hgn hgt hC0 in theorem tangentSecondForm_zero (i j : ι) : tangentSecondForm P C i j 0 = A P g i j := by simp only [tangentSecondForm, tangentFrame, hC0, unitNormal_at_base P g hg hgn hgt, frame_self, jacobiProfile_at_base P g hg hgn hgt] simp [Pi.single_apply, A, Source29PolynomialTangentialDerivative.hessian, realHessian_apply, div_eq_mul_inv, mul_comm] include hP hg hgn hgt hC hC0 hmem in theorem tangentSecondForm_local_norm (hd : 2 ≤ d) : (fun t => (curvatureNorm P (C t))^2) =ᶠ[𝓝 (0 : ℝ)] (fun t => ∑ i, ∑ j, (tangentSecondForm P C i j t)^2) := by have hgrad : AnalyticAt ℝ (fun t => gradientAt P (C t)) 0 := by apply AnalyticAt.pi intro a exact (analyticAt_eval_real (pderiv a P) (C 0)).comp hC have hnear := hgrad.continuousAt.eventually_ne (regular_at_curve_zero P g hg hgn hgt C hC0) filter_upwards [hmem, hnear] with t ht hr have he := tangentSecondForm_norm_sq_at P d hP hd C t ht.2 ht.1 hr have hn : 0 ≤ curvaturePotential P (C t) := by rw [← he] exact Finset.sum_nonneg (fun i _ => Finset.sum_nonneg (fun j _ => sq_nonneg _)) exact (Real.sq_sqrt hn).trans he.symm end end Source29PolynomialMovingCurvature /- Component: PolynomialProfileFirst.inc -/ namespace Source29PolynomialProfileFirst open Filter MvPolynomial Source29PolynomialLinkChart Source29PolynomialCurvaturePotential open Source29PolynomialJacobiCurves Source29NormalizedLinkJets open Source29AnalyticTensorNorm Source29PolynomialMovingCurvature open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem jacobiProfile_tangent_deriv (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (hg : 0 < g) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (i : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) : deriv (fun t => jacobiProfile P (C t)) 0 = -w P g i / g := by let G := fun a t => eval (C t) (pderiv a P) let q := fun t => tensorNorm (fun a => G a t) have hG : ∀ a, AnalyticAt ℝ (G a) 0 := fun a => (analyticAt_eval_real (pderiv a P) (C 0)).comp hC have hq0 : q 0 = g := by simp [q, G, hC0, tensorNorm, Fintype.sum_option, hgn, hgt, Real.sqrt_sq hg.le] have hq : AnalyticAt ℝ q 0 := tensorNorm_analyticAt _ _ hG (regular_at_curve_zero P g hg hgn hgt C hC0) have hnorm := (Source29AnalyticNormDerivatives.norm_first_second q G hq hG (Eventually.of_forall (fun t => tensorNorm_sq (fun a => G a t)))).1 have hgrad : ∀ a, G a 0 = eval base (pderiv a P) := by intro a; simp only [G, hC0] simp only [hq0, hgrad, Fintype.sum_option, hgn, hgt, zero_mul, Finset.sum_const_zero, add_zero] at hnorm have hq1 : deriv q 0 = eval base (pderiv (tangent i) (pderiv none P)) := by have he := mul_left_cancel₀ hg.ne' hnorm rw [he] exact Source29PolynomialCurveCoordinateJets.coordinate_velocity_first (pderiv none P) (fun a t => C t a) base (tangent i) (analyticAt_pi_iff.mp hC) (fun a => congrFun hC0 a) hC1 have he := (hq.differentiableAt.hasDerivAt.inv (by simpa only [hq0] using hg.ne')).deriv simp only [Pi.inv_def] at he change deriv (fun t => (q t)⁻¹) 0 = _ rw [he, hq0, hq1] simp only [w, Source29PolynomialTangentialDerivative.hessian] rw [Source29QuarticReuse.QuarticPolynomialBasics.second_partial_comm] ring end end Source29PolynomialProfileFirst /- Component: AnalyticBilinearDerivative.inc -/ namespace Source29AnalyticBilinearDerivative open scoped BigOperators noncomputable section variable {κ : Type*} [Fintype κ] theorem hasDerivAt_bilinear (u v : ℝ → κ → ℝ) (H : ℝ → κ → κ → ℝ) (du dv : κ → ℝ) (dH : κ → κ → ℝ) (hu : ∀ a, HasDerivAt (fun t => u t a) (du a) 0) (hv : ∀ a, HasDerivAt (fun t => v t a) (dv a) 0) (hH : ∀ a b, HasDerivAt (fun t => H t a b) (dH a b) 0) : HasDerivAt (fun t => ∑ b, ∑ a, u t a * H t a b * v t b) ((∑ b, ∑ a, du a * H 0 a b * v 0 b) + (∑ b, ∑ a, u 0 a * dH a b * v 0 b) + (∑ b, ∑ a, u 0 a * H 0 a b * dv b)) 0 := by have he := HasDerivAt.fun_sum (u := Finset.univ) (fun b _ => HasDerivAt.fun_sum (u := Finset.univ) (fun a _ => ((hu a).mul (hH a b)).mul (hv b))) convert he using 1 simp only [add_mul, Finset.sum_add_distrib, Pi.mul_def] /-- The actual second derivative of a matrix bilinear form along analytic vector and matrix curves, including all frame-derivative terms. -/ theorem second_deriv_bilinear (u v : ℝ → κ → ℝ) (H : ℝ → κ → κ → ℝ) (hu : ∀ a, AnalyticAt ℝ (fun t => u t a) 0) (hv : ∀ a, AnalyticAt ℝ (fun t => v t a) 0) (hH : ∀ a b, AnalyticAt ℝ (fun t => H t a b) 0) : deriv (deriv (fun t => ∑ b, ∑ a, u t a * H t a b * v t b)) 0 = ∑ b, ∑ a, (deriv (deriv (fun t => u t a)) 0 * H 0 a b * v 0 b + u 0 a * deriv (deriv (fun t => H t a b)) 0 * v 0 b + u 0 a * H 0 a b * deriv (deriv (fun t => v t b)) 0 + 2 * deriv (fun t => u t a) 0 * deriv (fun t => H t a b) 0 * v 0 b + 2 * deriv (fun t => u t a) 0 * H 0 a b * deriv (fun t => v t b) 0 + 2 * u 0 a * deriv (fun t => H t a b) 0 * deriv (fun t => v t b) 0) := by classical have ha : ∀ a b, AnalyticAt ℝ (fun t => u t a * H t a b * v t b) 0 := fun a b => ((hu a).mul (hH a b)).mul (hv b) rw [Source29AnalyticNormDerivatives.second_deriv_sum _ (fun b => Source29CurvaturePotentialAnalytic.analytic_sum _ 0 (fun a => ha a b))] apply Finset.sum_congr rfl intro b _ rw [Source29AnalyticNormDerivatives.second_deriv_sum _ (fun a => ha a b)] apply Finset.sum_congr rfl intro a _ rw [Source29AnalyticInverseNorm.second_deriv_product (fun t => u t a * H t a b) (fun t => v t b) ((hu a).mul (hH a b)) (hv b), Source29AnalyticInverseNorm.second_deriv_product (fun t => u t a) (fun t => H t a b) (hu a) (hH a b)] have hd := ((hu a).differentiableAt.hasDerivAt.mul (hH a b).differentiableAt.hasDerivAt).deriv simp only [Pi.mul_def] at hd rw [hd] ring end end Source29AnalyticBilinearDerivative /- Component: PolynomialSecondFormFirst.inc -/ namespace Source29PolynomialSecondFormFirst open Filter MvPolynomial Source29PolynomialLinkChart Source29PolynomialCurvaturePotential open Source29PolynomialJacobiCurves Source29PolynomialUnitNormal Source29NormalizedLinkJets open Source29PolynomialTangentFrame Source29PolynomialTangentFrameJets Source29PolynomialMovingCurvature open Source29QuarticReuse.QuarticMinimal.AmbientQuartic open scoped BigOperators Matrix Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem tangentSecondForm_first_deriv (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 2 ≤ d) (g : ℝ) (hg : 0 < g) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (hmem : ∀ᶠ t in 𝓝 (0 : ℝ), eval (C t) P = 0 ∧ (∑ a, (C t a)^2) = 1) (i j k : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) : deriv (tangentSecondForm P C j k) 0 = B P g i j k := by obtain ⟨E, rfl, hE, hE0, horth, htan⟩ := exists_analytic_tangent_frame P d hP g hg hgn hgt C hC hC0 hmem let H := fun t a b => eval (C t) (pderiv a (pderiv b P)) let T := fun a b => eval base (pderiv (tangent i) (pderiv a (pderiv b P))) let J := fun t => ∑ b, ∑ a, tangentFrame P C j t a * H t a b * tangentFrame P C k t b have hH : ∀ a b, HasDerivAt (fun t => H t a b) (T a b) 0 := by intro a b have ha := (analyticAt_eval_real (pderiv a (pderiv b P)) (C 0)).comp hC have he := Source29PolynomialCurveCoordinateJets.coordinate_velocity_first (pderiv a (pderiv b P)) (fun c t => C t c) base (tangent i) (analyticAt_pi_iff.mp hC) (fun c => congrFun hC0 c) hC1 have hh : HasDerivAt (fun t => H t a b) (deriv (fun t => H t a b) 0) 0 := ha.differentiableAt.hasDerivAt rw [show deriv (fun t => H t a b) 0 = T a b from he] at hh exact hh have hdE : ∀ l a, HasDerivAt (fun t => tangentFrame P C l t a) (-(if i = l then 1 else 0) * base a - A P g i l * Pi.single (M := fun _ => ℝ) none 1 a) 0 := by intro l a have he := tangentFrame_first_deriv P g hg hgn hgt C hC hC0 i l hC1 a exact he ▸ ((analyticAt_pi_iff.mp (hE l)) a).differentiableAt.hasDerivAt have hJ := Source29AnalyticBilinearDerivative.hasDerivAt_bilinear (tangentFrame P C j) (tangentFrame P C k) H (fun a => -(if i = j then 1 else 0) * base a - A P g i j * Pi.single (M := fun _ => ℝ) none 1 a) (fun a => -(if i = k then 1 else 0) * base a - A P g i k * Pi.single (M := fun _ => ℝ) none 1 a) T (hdE j) (hdE k) hH have hrad : ∀ l, realHessian P base (some none) (tangent l) = 0 := by intro l have he := (Source29HomogeneousRadialJets.radial_coordinate_jets P d hP hd (some none) (tangent l)).1 change realHessian P base (some none) (tangent l) = ((d : ℝ)-1)*eval base (pderiv (tangent l) P) at he rw [show eval base (pderiv (tangent l) P) = 0 from hgt (some l), mul_zero] at he exact he have hsym : ∀ a b, realHessian P base a b = realHessian P base b a := by intro a b simp only [realHessian_apply, Source29QuarticReuse.QuarticPolynomialBasics.second_partial_comm] have hJd : deriv J 0 = T (tangent j) (tangent k) - A P g i j * eval base (pderiv none (pderiv (tangent k) P)) - A P g i k * eval base (pderiv none (pderiv (tangent j) P)) := by have he := hJ.deriv change deriv J 0 = _ at he rw [he] have hb : ∀ a, (base : Ambient ι) a = if a = some none then 1 else 0 := by intro a simp [base, Pi.single_apply] simp only [H, hC0, hE0, hb, Pi.single_apply, sub_mul, mul_sub, mul_ite, ite_mul, mul_one, one_mul, mul_zero, zero_mul, Finset.sum_sub_distrib, Finset.sum_ite_irrel, Finset.sum_ite_eq, Finset.sum_ite_eq', Finset.sum_const_zero, Finset.mem_univ, if_true] have hrj : eval base (pderiv (tangent j) (pderiv (some none) P)) = 0 := by rw [Source29QuarticReuse.QuarticPolynomialBasics.second_partial_comm] exact hrad j rw [show eval base (pderiv (some none) (pderiv (tangent k) P)) = 0 from hrad k, hrj] rw [Source29QuarticReuse.QuarticPolynomialBasics.second_partial_comm (i := tangent j) (j := none)] ring have hJ0 : J 0 = eval base (pderiv (tangent j) (pderiv (tangent k) P)) := by simp only [J, H, hC0, hE0, Pi.single_apply, mul_ite, ite_mul, mul_one, one_mul, mul_zero, zero_mul, Finset.sum_ite_irrel, Finset.sum_ite_eq, Finset.sum_ite_eq', Finset.sum_const_zero, Finset.mem_univ, if_true] have hφ := (jacobiProfile_analyticAt P (C 0) (regular_at_curve_zero P g hg hgn hgt C hC0)).comp hC have hφd := Source29PolynomialProfileFirst.jacobiProfile_tangent_deriv P g hg hgn hgt C hC hC0 i hC1 have hJhas : HasDerivAt J (deriv J 0) 0 := hJ.differentiableAt.hasDerivAt have he : deriv (fun t => jacobiProfile P (C t) * J t) 0 = deriv (fun t => jacobiProfile P (C t)) 0 * J 0 + jacobiProfile P (C 0) * deriv J 0 := (hφ.differentiableAt.hasDerivAt.mul hJhas).deriv change deriv (fun t => jacobiProfile P (C t) * J t) 0 = _ rw [he, hφd, hJd, hJ0, hC0, jacobiProfile_at_base P g hg hgn hgt] simp only [B, S, w, A, T, Source29PolynomialTangentialDerivative.hessian, Source29PolynomialTangentialDerivative.third, realHessian_apply] ring end end Source29PolynomialSecondFormFirst /- Component: AnalyticDotSecond.inc -/ namespace Source29AnalyticDotSecond open Source29PairFrameDerivative open scoped BigOperators Matrix noncomputable section variable {κ : Type*} [Fintype κ] def acceleration (f : ℝ → κ → ℝ) : κ → ℝ := fun a => deriv (deriv (fun t => f t a)) 0 theorem second_deriv_dot (u v : ℝ → κ → ℝ) (hu : ∀ a, AnalyticAt ℝ (fun t => u t a) 0) (hv : ∀ a, AnalyticAt ℝ (fun t => v t a) 0) : deriv (deriv (fun t => u t ⬝ᵥ v t)) 0 = acceleration u ⬝ᵥ v 0 + 2 * (velocity u ⬝ᵥ velocity v) + u 0 ⬝ᵥ acceleration v := by simp only [dotProduct] rw [Source29AnalyticNormDerivatives.second_deriv_sum (fun a t => u t a * v t a) (fun a => (hu a).mul (hv a))] simp_rw [Source29AnalyticInverseNorm.second_deriv_product (fun t => u t _) (fun t => v t _) (hu _) (hv _)] simp only [acceleration, velocity, Finset.sum_add_distrib, Finset.mul_sum, mul_assoc] end end Source29AnalyticDotSecond /- Component: PolynomialTangentFrameSecond.inc -/ namespace Source29PolynomialTangentFrameSecond open Filter MvPolynomial Source29PolynomialLinkChart Source29NormalizedLinkJets open Source29PolynomialTangentFrame Source29PolynomialTangentFrameJets open Source29PairFrameDerivative Source29AnalyticDotSecond open scoped BigOperators Matrix Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Orthonormality determines the symmetric tangential part of the actual frame acceleration. It leaves only a skew rotation, which can be contracted out. -/ theorem tangentFrame_second_symmetric (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (g : ℝ) (hg : 0 < g) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (hmem : ∀ᶠ t in 𝓝 (0 : ℝ), eval (C t) P = 0 ∧ (∑ a, (C t a)^2) = 1) (i j k : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) : acceleration (tangentFrame P C j) (tangent k) + acceleration (tangentFrame P C k) (tangent j) = -2 * ((if i = j then 1 else 0) * (if i = k then 1 else 0) + A P g i j * A P g i k) := by obtain ⟨E, rfl, hE, hE0, horth, htan⟩ := exists_analytic_tangent_frame P d hP g hg hgn hgt C hC hC0 hmem have he : (fun t => tangentFrame P C j t ⬝ᵥ tangentFrame P C k t) = (fun _ : ℝ => if j = k then (1 : ℝ) else 0) := funext (fun t => horth t j k) have hz : deriv (deriv (fun t => tangentFrame P C j t ⬝ᵥ tangentFrame P C k t)) 0 = 0 := by rw [he] simp only [deriv_const', deriv_const] rw [second_deriv_dot _ _ (analyticAt_pi_iff.mp (hE j)) (analyticAt_pi_iff.mp (hE k)), hE0, hE0, dotProduct_single_one, single_one_dotProduct] at hz have hd : ∀ l a, velocity (tangentFrame P C l) a = -(if i = l then 1 else 0) * base a - A P g i l * Pi.single (M := fun _ => ℝ) none 1 a := by intro l a exact tangentFrame_first_deriv P g hg hgn hgt C hC hC0 i l hC1 a have hv : velocity (tangentFrame P C j) ⬝ᵥ velocity (tangentFrame P C k) = (if i = j then 1 else 0) * (if i = k then 1 else 0) + A P g i j * A P g i k := by simp only [dotProduct, hd, Fintype.sum_option, base, Pi.single_apply] simp only [Option.some.injEq, reduceCtorEq, ite_true, ite_false, mul_one, mul_zero, sub_zero, zero_sub, neg_mul_neg, zero_mul, Finset.sum_const_zero, add_zero] ring rw [hv] at hz linarith end end Source29PolynomialTangentFrameSecond /- Component: PolynomialNormalSecond.inc -/ namespace Source29PolynomialNormalSecond open Filter MvPolynomial Source29PolynomialLinkChart Source29NormalizedLinkJets open Source29PolynomialUnitNormal Source29PolynomialJacobiCurves Source29PolynomialMovingCurvature open Source29PairFrameDerivative Source29AnalyticDotSecond open Source29QuarticReuse.QuarticPolynomialBasics (second_partial_comm) open scoped BigOperators Matrix Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] variable (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 2 ≤ d) (g : ℝ) (hg : 0 < g) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (i : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) include hg hgn hgt hC hC0 hC1 in theorem unitNormal_first_coordinate (a : Option (Option ι)) : velocity (fun t => unitNormal P (C t)) a = -w P g i / g * eval base (pderiv a P) + g⁻¹ * eval base (pderiv (tangent i) (pderiv a P)) := by have hφ := (jacobiProfile_analyticAt P (C 0) (regular_at_curve_zero P g hg hgn hgt C hC0)).comp hC have hG := (analyticAt_eval_real (pderiv a P) (C 0)).comp hC have he := (hφ.differentiableAt.hasDerivAt.mul hG.differentiableAt.hasDerivAt).deriv simp only [Pi.mul_def, Function.comp_def] at he change deriv (fun t => jacobiProfile P (C t) * eval (C t) (pderiv a P)) 0 = _ rw [he, Source29PolynomialProfileFirst.jacobiProfile_tangent_deriv P g hg hgn hgt C hC hC0 i hC1, Source29PolynomialCurveCoordinateJets.coordinate_velocity_first (pderiv a P) (fun b t => C t b) base (tangent i) (analyticAt_pi_iff.mp hC) (fun b => congrFun hC0 b) hC1, hC0, jacobiProfile_at_base P g hg hgn hgt] include hP hd hg hgn hgt hC hC0 hC1 in theorem unitNormal_first_radial_normal : velocity (fun t => unitNormal P (C t)) (some none) = 0 ∧ velocity (fun t => unitNormal P (C t)) none = 0 := by have hr := (Source29HomogeneousRadialJets.radial_coordinate_jets P d hP hd (some none) (tangent i)).1 change eval base (pderiv (some none) (pderiv (tangent i) P)) = ((d : ℝ)-1)*eval base (pderiv (tangent i) P) at hr rw [show eval base (pderiv (tangent i) P) = 0 from hgt (some i), mul_zero] at hr constructor · rw [unitNormal_first_coordinate P g hg hgn hgt C hC hC0 i hC1, hgt none, mul_zero, zero_add, second_partial_comm, hr, mul_zero] · rw [unitNormal_first_coordinate P g hg hgn hgt C hC hC0 i hC1, hgn] simp only [w, Source29PolynomialTangentialDerivative.hessian] rw [second_partial_comm] field_simp ring include hP hd hg hgn hgt hC hC0 hC1 in theorem unitNormal_second_tangent (hC2 : ∀ a, acceleration C a = -base a - A P g i i * Pi.single (M := fun _ => ℝ) none 1 a) (j : ι) : acceleration (fun t => unitNormal P (C t)) (tangent j) = S P g i i j - A P g i i * w P g j - 2 * w P g i * A P g i j := by let G := fun t => eval (C t) (pderiv (tangent j) P) have hG : AnalyticAt ℝ G 0 := (analyticAt_eval_real (pderiv (tangent j) P) (C 0)).comp hC have hG0 : G 0 = 0 := by simpa only [G, hC0, tangent] using hgt (some j) have hG1 : deriv G 0 = eval base (pderiv (tangent i) (pderiv (tangent j) P)) := Source29PolynomialCurveCoordinateJets.coordinate_velocity_first (pderiv (tangent j) P) (fun a t => C t a) base (tangent i) (analyticAt_pi_iff.mp hC) (fun a => congrFun hC0 a) hC1 have hG2 : deriv (deriv G) 0 = eval base (pderiv (tangent i) (pderiv (tangent i) (pderiv (tangent j) P))) - A P g i i * eval base (pderiv none (pderiv (tangent j) P)) := by have he := Source29PolynomialCurveCoordinateJets.coordinate_velocity_second (pderiv (tangent j) P) (fun a t => C t a) base (tangent i) (analyticAt_pi_iff.mp hC) (fun a => congrFun hC0 a) hC1 change deriv (deriv G) 0 = _ at he rw [he] have hr := (Source29HomogeneousRadialJets.radial_coordinate_jets P d hP hd (some none) (tangent j)).1 change eval base (pderiv (some none) (pderiv (tangent j) P)) = ((d : ℝ)-1)*eval base (pderiv (tangent j) P) at hr rw [show eval base (pderiv (tangent j) P) = 0 from hgt (some j), mul_zero] at hr have hb : ∀ a, (base : Ambient ι) a = if a = some none then 1 else 0 := by intro a simp [base, Pi.single_apply] change _ + (∑ a, eval base (pderiv a (pderiv (tangent j) P)) * acceleration C a) = _ simp only [hC2, hb, Pi.single_apply, mul_sub, mul_neg, mul_ite, mul_one, mul_zero, Finset.sum_sub_distrib, Finset.sum_neg_distrib, Finset.sum_ite_eq', Finset.sum_ite_eq, Finset.mem_univ, if_true, hr] ring have hφ := (jacobiProfile_analyticAt P (C 0) (regular_at_curve_zero P g hg hgn hgt C hC0)).comp hC change deriv (deriv (fun t => jacobiProfile P (C t) * G t)) 0 = _ rw [Source29AnalyticInverseNorm.second_deriv_product (fun t => jacobiProfile P (C t)) G hφ hG, hG0, mul_zero, zero_add, Source29PolynomialProfileFirst.jacobiProfile_tangent_deriv P g hg hgn hgt C hC hC0 i hC1, hG1, hG2, hC0, jacobiProfile_at_base P g hg hgn hgt] simp only [S, w, A, Source29PolynomialTangentialDerivative.third, Source29PolynomialTangentialDerivative.hessian] ring end end Source29PolynomialNormalSecond /- Component: PolynomialFrameNormalAcceleration.inc -/ namespace Source29PolynomialFrameNormalAcceleration open Filter MvPolynomial Source29PolynomialLinkChart Source29NormalizedLinkJets open Source29PolynomialTangentFrame Source29PolynomialTangentFrameJets open Source29PolynomialUnitNormal Source29PolynomialMovingCurvature open Source29PairFrameDerivative Source29AnalyticDotSecond Source29PolynomialNormalSecond open scoped BigOperators Matrix Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Differentiating the actual tangency relation determines the normal component of the frame acceleration, without choosing its skew tangent part. -/ theorem tangentFrame_second_normal (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 2 ≤ d) (g : ℝ) (hg : 0 < g) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (hmem : ∀ᶠ t in 𝓝 (0 : ℝ), eval (C t) P = 0 ∧ (∑ a, (C t a)^2) = 1) (i j : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (hC2 : ∀ a, acceleration C a = -base a - A P g i i * Pi.single (M := fun _ => ℝ) none 1 a) : acceleration (tangentFrame P C j) none = -S P g i i j + A P g i i * w P g j + 2 * w P g i * A P g i j := by obtain ⟨E, rfl, hE, hE0, horth, htan⟩ := exists_analytic_tangent_frame P d hP g hg hgn hgt C hC hC0 hmem have hN : AnalyticAt ℝ (fun t => unitNormal P (C t)) 0 := (unitNormal_analyticAt P (C 0) (regular_at_curve_zero P g hg hgn hgt C hC0)).comp hC have hN0 : unitNormal P (C 0) = Pi.single none 1 := by rw [hC0, unitNormal_at_base P g hg hgn hgt] have hz : (fun t => tangentFrame P C j t ⬝ᵥ unitNormal P (C t)) =ᶠ[𝓝 (0 : ℝ)] (fun _ => (0 : ℝ)) := by filter_upwards [htan] with t ht exact (ht j).2 have he := hz.deriv.deriv_eq simp only [deriv_const', deriv_const] at he rw [second_deriv_dot _ _ (analyticAt_pi_iff.mp (hE j)) (analyticAt_pi_iff.mp hN), hE0, hN0, dotProduct_single_one, single_one_dotProduct] at he have hdE : ∀ a, velocity (tangentFrame P C j) a = -(if i = j then 1 else 0) * base a - A P g i j * Pi.single (M := fun _ => ℝ) none 1 a := by intro a exact tangentFrame_first_deriv P g hg hgn hgt C hC hC0 i j hC1 a have hN1 := unitNormal_first_radial_normal P d hP hd g hg hgn hgt C hC hC0 i hC1 have hv : velocity (tangentFrame P C j) ⬝ᵥ velocity (fun t => unitNormal P (C t)) = 0 := by simp only [dotProduct, hdE, Fintype.sum_option, base, Pi.single_apply] simp only [Option.some.injEq, reduceCtorEq, ite_true, ite_false, mul_one, mul_zero, sub_zero, zero_sub, zero_mul, Finset.sum_const_zero, add_zero, hN1.1, hN1.2] rw [hv, mul_zero, add_zero, unitNormal_second_tangent P d hP hd g hg hgn hgt C hC hC0 i hC1 hC2 j] at he linarith /-- The normal frame acceleration is exactly the negative of the first covariant tensor, evaluated twice in the curve direction. -/ theorem tangentFrame_second_normal_eq_neg_B (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 2 ≤ d) (g : ℝ) (hg : 0 < g) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (hmem : ∀ᶠ t in 𝓝 (0 : ℝ), eval (C t) P = 0 ∧ (∑ a, (C t a)^2) = 1) (i j : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (hC2 : ∀ a, acceleration C a = -base a - A P g i i * Pi.single (M := fun _ => ℝ) none 1 a) : acceleration (tangentFrame P C j) none = -B P g i i j := by rw [tangentFrame_second_normal P d hP hd g hg hgn hgt C hC hC0 hmem i j hC1 hC2] unfold B ring /-- The normal acceleration disappears when summed over all link directions. -/ theorem tangentFrame_normal_acceleration_trace (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (g : ℝ) (hg : 0 < g) (hL : Source29FactorInheritance.cubicOperator P = 0) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ι → ℝ → Ambient ι) (hC : ∀ i, AnalyticAt ℝ (C i) 0) (hC0 : ∀ i, C i 0 = base) (hmem : ∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), eval (C i t) P = 0 ∧ (∑ a, (C i t a)^2) = 1) (hC1 : ∀ i a, deriv (fun t => C i t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (hC2 : ∀ i a, acceleration (C i) a = -base a - A P g i i * Pi.single (M := fun _ => ℝ) none 1 a) (j : ι) : (∑ i, acceleration (tangentFrame P (C i) j) none) = 0 := by simp_rw [tangentFrame_second_normal_eq_neg_B P d hP (by omega) g hg hgn hgt (C _) (hC _) (hC0 _) (hmem _) _ j (hC1 _) (hC2 _)] rw [Finset.sum_neg_distrib, Source29NormalizedLinkTraces.B_trace P d hP hd g hg.ne' hL hgn hgt, neg_zero] end end Source29PolynomialFrameNormalAcceleration /- Component: SymmetricFrameContraction.inc -/ namespace Source29SymmetricFrameContraction open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] /-- A symmetric tensor sees only the symmetric part of the frame acceleration; the undetermined skew rotation contributes zero to the contraction. -/ theorem contract_of_symmetric_part (W E M : ι → ι → ℝ) (hW : ∀ a b, W a b = W b a) (hE : ∀ a b, E a b + E b a = -2 * M a b) : (∑ a, ∑ b, W a b * E a b) = -(∑ a, ∑ b, W a b * M a b) := by have hs : (∑ a, ∑ b, W a b * E b a) = ∑ a, ∑ b, W a b * E a b := by rw [Finset.sum_comm] apply Finset.sum_congr rfl intro a _ apply Finset.sum_congr rfl intro b _ rw [hW b a] have he : (∑ a, ∑ b, W a b * (E a b + E b a)) = -2 * (∑ a, ∑ b, W a b * M a b) := by simp_rw [hE] simp only [Finset.mul_sum] apply Finset.sum_congr rfl intro a _ apply Finset.sum_congr rfl intro b _ ring simp only [mul_add, Finset.sum_add_distrib, hs] at he linarith end end Source29SymmetricFrameContraction /- Component: NormalizedHessianCurve.inc -/ namespace Source29NormalizedHessianCurve open Filter MvPolynomial Source29PolynomialLinkChart Source29NormalizedLinkJets open Source29PolynomialJacobiCurves Source29PolynomialMovingCurvature open Source29AnalyticDotSecond Source29PolynomialTangentialDerivative open Source29QuarticReuse.QuarticPolynomialBasics (second_partial_comm) open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def normalizedHessian (P : MvPolynomial (Option (Option ι)) ℝ) (C : ℝ → Ambient ι) (a b : Option (Option ι)) (t : ℝ) : ℝ := jacobiProfile P (C t) * eval (C t) (pderiv a (pderiv b P)) theorem normalizedHessian_symm (P : MvPolynomial (Option (Option ι)) ℝ) (C : ℝ → Ambient ι) (a b : Option (Option ι)) : normalizedHessian P C a b = normalizedHessian P C b a := by unfold normalizedHessian rw [second_partial_comm P a b] theorem secondForm_eq_normalized_bilinear (P : MvPolynomial (Option (Option ι)) ℝ) (C : ℝ → Ambient ι) (j k : ι) : tangentSecondForm P C j k = fun t => ∑ b, ∑ a, Source29PolynomialTangentFrame.tangentFrame P C j t a * normalizedHessian P C a b t * Source29PolynomialTangentFrame.tangentFrame P C k t b := by funext t simp only [tangentSecondForm, normalizedHessian, Finset.mul_sum, Source29QuarticReuse.QuarticMinimal.AmbientQuartic.realHessian_apply] apply Finset.sum_congr rfl intro b _ apply Finset.sum_congr rfl intro a _ ring variable (P : MvPolynomial (Option (Option ι)) ℝ) (g : ℝ) (hg : 0 < g) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) include hg hgn hgt hC hC0 in theorem normalizedHessian_analyticAt (a b : Option (Option ι)) : AnalyticAt ℝ (normalizedHessian P C a b) 0 := by exact ((jacobiProfile_analyticAt P (C 0) (regular_at_curve_zero P g hg hgn hgt C hC0)).comp hC).mul ((analyticAt_eval_real (pderiv a (pderiv b P)) (C 0)).comp hC) include hg hgn hgt hC0 in theorem normalizedHessian_zero (a b : Option (Option ι)) : normalizedHessian P C a b 0 = hessian P base a b / g := by simp only [normalizedHessian, hC0, jacobiProfile_at_base P g hg hgn hgt, hessian] ring include hg hgn hgt hC hC0 in theorem normalizedHessian_first (i : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (a b : Option (Option ι)) : deriv (normalizedHessian P C a b) 0 = (third P base (tangent i) a b - w P g i * hessian P base a b) / g := by have hφ := (jacobiProfile_analyticAt P (C 0) (regular_at_curve_zero P g hg hgn hgt C hC0)).comp hC have hH := (analyticAt_eval_real (pderiv a (pderiv b P)) (C 0)).comp hC have he := (hφ.differentiableAt.hasDerivAt.mul hH.differentiableAt.hasDerivAt).deriv simp only [Pi.mul_def, Function.comp_def] at he unfold normalizedHessian rw [he, Source29PolynomialProfileFirst.jacobiProfile_tangent_deriv P g hg hgn hgt C hC hC0 i hC1, Source29PolynomialCurveCoordinateJets.coordinate_velocity_first (pderiv a (pderiv b P)) (fun c t => C t c) base (tangent i) (analyticAt_pi_iff.mp hC) (fun c => congrFun hC0 c) hC1, hC0, jacobiProfile_at_base P g hg hgn hgt] simp only [third, hessian] ring include hg hgn hgt hC hC0 in theorem normalizedHessian_second_tangent (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (i : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (hC2 : ∀ a, acceleration C a = -base a - A P g i i * Pi.single (M := fun _ => ℝ) none 1 a) (a b : ι) : deriv (deriv (normalizedHessian P C (tangent a) (tangent b))) 0 = g * A P g a b * deriv (deriv (fun t => jacobiProfile P (C t))) 0 - 2 * w P g i * S P g i a b + Q P g a b i i - ((d : ℝ)-2) * A P g a b - A P g i i * V P g a b := by let H := fun t => eval (C t) (pderiv (tangent a) (pderiv (tangent b) P)) have hH : AnalyticAt ℝ H 0 := (analyticAt_eval_real (pderiv (tangent a) (pderiv (tangent b) P)) (C 0)).comp hC have hH0 : H 0 = hessian P base (tangent a) (tangent b) := by simp only [H, hC0, hessian] have hH1 : deriv H 0 = third P base (tangent i) (tangent a) (tangent b) := Source29PolynomialCurveCoordinateJets.coordinate_velocity_first (pderiv (tangent a) (pderiv (tangent b) P)) (fun c t => C t c) base (tangent i) (analyticAt_pi_iff.mp hC) (fun c => congrFun hC0 c) hC1 have hH2 : deriv (deriv H) 0 = eval base (pderiv (tangent i) (pderiv (tangent i) (pderiv (tangent a) (pderiv (tangent b) P)))) - ((d : ℝ)-2) * hessian P base (tangent a) (tangent b) - A P g i i * third P base none (tangent a) (tangent b) := by have he := Source29PolynomialCurveCoordinateJets.coordinate_velocity_second (pderiv (tangent a) (pderiv (tangent b) P)) (fun c t => C t c) base (tangent i) (analyticAt_pi_iff.mp hC) (fun c => congrFun hC0 c) hC1 change deriv (deriv H) 0 = _ at he rw [he] have hr := (Source29HomogeneousHigherRadialJets.radial_coordinate_higher_jets P d hP hd (some none) (tangent a) (tangent b)).1 change eval base (pderiv (some none) (pderiv (tangent a) (pderiv (tangent b) P))) = ((d : ℝ)-2) * hessian P base (tangent a) (tangent b) at hr have hb : ∀ c, (base : Ambient ι) c = if c = some none then 1 else 0 := by intro c simp [base, Pi.single_apply] change _ + (∑ c, eval base (pderiv c (pderiv (tangent a) (pderiv (tangent b) P))) * acceleration C c) = _ simp only [hC2, hb, Pi.single_apply, mul_sub, mul_neg, mul_ite, mul_one, mul_zero, Finset.sum_sub_distrib, Finset.sum_neg_distrib, Finset.sum_ite_eq', Finset.sum_ite_eq, Finset.mem_univ, if_true, hr, third] ring have hφ := (jacobiProfile_analyticAt P (C 0) (regular_at_curve_zero P g hg hgn hgt C hC0)).comp hC change deriv (deriv (fun t => jacobiProfile P (C t) * H t)) 0 = _ rw [Source29AnalyticInverseNorm.second_deriv_product (fun t => jacobiProfile P (C t)) H hφ hH, hH0, hH1, hH2, Source29PolynomialProfileFirst.jacobiProfile_tangent_deriv P g hg hgn hgt C hC hC0 i hC1, hC0, jacobiProfile_at_base P g hg hgn hgt] simp only [A, S, V, Q, hessian, third, second_partial_comm] field_simp ring end end Source29NormalizedHessianCurve /- Component: NormalizedHessianBlocks.inc -/ namespace Source29NormalizedHessianBlocks open MvPolynomial Source29PolynomialLinkChart Source29NormalizedLinkJets open Source29NormalizedHessianCurve Source29PolynomialTangentialDerivative open Source29QuarticReuse.QuarticPolynomialBasics (second_partial_comm) open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] variable (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (g : ℝ) (hg : 0 < g) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) include hg hgn hgt hC0 in theorem zero_tangent (a b : ι) : normalizedHessian P C (tangent a) (tangent b) 0 = A P g a b := normalizedHessian_zero P g hg hgn hgt C hC0 _ _ include hg hgn hgt hC0 in theorem zero_normal_tangent (a : ι) : normalizedHessian P C none (tangent a) 0 = w P g a := normalizedHessian_zero P g hg hgn hgt C hC0 _ _ include hg hgn hgt hC0 in theorem zero_normal : normalizedHessian P C none none 0 = z P g := normalizedHessian_zero P g hg hgn hgt C hC0 _ _ include hP hd hg hgn hgt hC0 in theorem zero_radial_some (a : Option ι) : normalizedHessian P C (some none) (some a) 0 = 0 := by rw [normalizedHessian_zero P g hg hgn hgt C hC0] have he := (Source29HomogeneousRadialJets.radial_coordinate_jets P d hP (by omega) (some none) (some a)).1 change hessian P base (some none) (some a) = ((d : ℝ)-1)*eval base (pderiv (some a) P) at he rw [he, hgt, mul_zero, zero_div] include hP hd hg hgn hgt hC0 in theorem zero_radial_normal : normalizedHessian P C (some none) none 0 = (d : ℝ)-1 := by rw [normalizedHessian_zero P g hg hgn hgt C hC0] have he := (Source29HomogeneousRadialJets.radial_coordinate_jets P d hP (by omega) (some none) none).1 change hessian P base (some none) none = ((d : ℝ)-1)*eval base (pderiv none P) at he rw [he, hgn, mul_div_cancel_right₀ _ hg.ne'] include hg hgn hgt hC hC0 in theorem first_normal_tangent (i a : ι) (hC1 : ∀ c, deriv (fun t => C t c) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 c) : deriv (normalizedHessian P C none (tangent a)) 0 = V P g i a - w P g i * w P g a := by rw [normalizedHessian_first P g hg hgn hgt C hC hC0 i hC1] simp only [V, w, third, hessian, second_partial_comm] ring include hP hd hg hgn hgt hC hC0 in theorem first_radial_tangent (i a : ι) (hC1 : ∀ c, deriv (fun t => C t c) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 c) : deriv (normalizedHessian P C (some none) (tangent a)) 0 = ((d : ℝ)-2) * A P g i a := by rw [normalizedHessian_first P g hg hgn hgt C hC hC0 i hC1] have hH := Source29NormalizedLinkTraces.radial_hessian_zero P d hP hd hgt (some a) change hessian P base (some none) (tangent a) = 0 at hH rw [hH, mul_zero, sub_zero] have he := (Source29HomogeneousHigherRadialJets.radial_coordinate_higher_jets P d hP hd (some none) (tangent i) (tangent a)).1 change third P base (some none) (tangent i) (tangent a) = ((d : ℝ)-2)*hessian P base (tangent i) (tangent a) at he rw [third_swap12, he] unfold A ring end end Source29NormalizedHessianBlocks /- Component: NormalizedHessianTrace.inc -/ namespace Source29NormalizedHessianTrace open Filter MvPolynomial Source29PolynomialLinkChart Source29NormalizedLinkJets open Source29NormalizedHessianCurve Source29PolynomialJacobiCurves Source29AnalyticDotSecond open Source29SimonsJetCorrection open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] variable (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (g : ℝ) (hg : 0 < g) (hL : Source29FactorInheritance.cubicOperator P = 0) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ι → ℝ → Ambient ι) (hC : ∀ i, AnalyticAt ℝ (C i) 0) (hC0 : ∀ i, C i 0 = base) (hC1 : ∀ i a, deriv (fun t => C i t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (hC2 : ∀ i a, acceleration (C i) a = -base a - A P g i i * Pi.single (M := fun _ => ℝ) none 1 a) (K lam : ℝ) (hJac : (∑ i, deriv (deriv (fun t => jacobiProfile P (C i t))) 0) + (K+lam)*g⁻¹ = 0) include hP hd hg hL hgn hgt hC hC0 hC1 hC2 hJac theorem normalizedHessian_second_trace (a b : ι) : (∑ i, deriv (deriv (normalizedHessian P (C i) (tangent a) (tangent b))) 0) = (∑ i, Q P g a b i i) - 2 * (∑ i, w P g i * S P g i a b) - (K+lam+(Fintype.card ι : ℝ)*((d : ℝ)-2)) * A P g a b := by simp_rw [normalizedHessian_second_tangent P g hg hgn hgt (C _) (hC _) (hC0 _) d hP hd _ (hC1 _) (hC2 _)] simp only [mul_assoc, Finset.sum_sub_distrib, Finset.sum_add_distrib, ← Finset.mul_sum, ← Finset.sum_mul, Finset.sum_const, Finset.card_univ, nsmul_eq_mul, Source29NormalizedLinkTraces.A_trace P d hP hd g hg.ne' hL hgn hgt, zero_mul, sub_zero] have hj : (∑ i, deriv (deriv (fun t => jacobiProfile P (C i t))) 0) = -(K+lam)*g⁻¹ := by linarith rw [hj] field_simp ring theorem normalizedHessian_second_trace_reduced (a b : ι) : (∑ i, deriv (deriv (normalizedHessian P (C i) (tangent a) (tangent b))) 0) = 2 * matrixCube (A P g) b a - 2 * z P g * matrixSquare (A P g) a b + 2 * (∑ i, (A P g i a * V P g i b + A P g i b * V P g i a)) - 2 * w P g a * (∑ i, A P g b i * w P g i) - 2 * w P g b * (∑ i, A P g a i * w P g i) + ((d : ℝ)*((d : ℝ)-1)-2-K-lam-(Fintype.card ι : ℝ)*((d : ℝ)-2)) * A P g a b := by rw [normalizedHessian_second_trace P d hP hd g hg hL hgn hgt C hC hC0 hC1 hC2 K lam hJac, Source29NormalizedLinkTraces.Q_trace_natural P d hP hd g hg.ne' hL hgn hgt, Source29PolynomialSimonsTensor.cubic_contraction (A P g) (A_symm P g), Source29PolynomialSimonsTensor.square_contraction (A P g) (A_symm P g)] have hS : ∀ i, S P g a b i = S P g i a b := by intro i rw [S_swap23, S_swap12] simp only [Finset.sum_add_distrib, hS, A_symm P g, V_symm P g] have hm : (∑ i, S P g i a b * w P g i) = ∑ i, w P g i * S P g i a b := by apply Finset.sum_congr rfl intro i _ ring rw [hm] ring end end Source29NormalizedHessianTrace /- Component: BilinearFrameJet.inc -/ namespace Source29BilinearFrameJet open Source29AnalyticDotSecond open scoped BigOperators noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] /-- Product differentiation with two-axis frame velocities, keeping the actual accelerations explicit. No frame second derivatives are assumed. -/ theorem second_deriv_two_axis (u v : ℝ → κ → ℝ) (Z : ℝ → κ → κ → ℝ) (hu : ∀ a, AnalyticAt ℝ (fun t => u t a) 0) (hv : ∀ a, AnalyticAt ℝ (fun t => v t a) 0) (hZ : ∀ a b, AnalyticAt ℝ (fun t => Z t a b) 0) (r n a b : κ) (p q s c : ℝ) (hu0 : u 0 = Pi.single a 1) (hv0 : v 0 = Pi.single b 1) (hu1 : ∀ k, deriv (fun t => u t k) 0 = -p * Pi.single (M := fun _ => ℝ) r 1 k - q * Pi.single (M := fun _ => ℝ) n 1 k) (hv1 : ∀ k, deriv (fun t => v t k) 0 = -s * Pi.single (M := fun _ => ℝ) r 1 k - c * Pi.single (M := fun _ => ℝ) n 1 k) : deriv (deriv (fun t => ∑ y, ∑ x, u t x * Z t x y * v t y)) 0 = deriv (deriv (fun t => Z t a b)) 0 + (∑ k, acceleration u k * Z 0 k b) + (∑ k, Z 0 a k * acceleration v k) + 2 * (p*s*Z 0 r r + p*c*Z 0 r n + q*s*Z 0 n r + q*c*Z 0 n n) - 2 * (p*deriv (fun t => Z t r b) 0 + q*deriv (fun t => Z t n b) 0 + s*deriv (fun t => Z t a r) 0 + c*deriv (fun t => Z t a n) 0) := by rw [Source29AnalyticBilinearDerivative.second_deriv_bilinear u v Z hu hv hZ] simp only [hu0, hv0, hu1, hv1, Pi.single_apply, mul_sub, sub_mul, mul_ite, ite_mul, mul_one, one_mul, mul_zero, zero_mul, Finset.sum_add_distrib, Finset.sum_sub_distrib, Finset.sum_ite_irrel, Finset.sum_ite_eq', Finset.sum_ite_eq, Finset.sum_const_zero, Finset.mem_univ, if_true, acceleration] ring end end Source29BilinearFrameJet /- Component: MovingSecondFormJets.inc -/ namespace Source29MovingSecondFormJets open Filter MvPolynomial Source29PolynomialLinkChart Source29NormalizedLinkJets open Source29PolynomialTangentFrame Source29PolynomialTangentFrameJets open Source29PolynomialMovingCurvature Source29NormalizedHessianCurve Source29NormalizedHessianBlocks open Source29AnalyticDotSecond open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Second derivatives of the actual moving second form, with the unknown tangential frame accelerations still explicit. -/ theorem secondForm_second_deriv (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (g : ℝ) (hg : 0 < g) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (hmem : ∀ᶠ t in 𝓝 (0 : ℝ), eval (C t) P = 0 ∧ (∑ a, (C t a)^2) = 1) (i j k : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) : deriv (deriv (tangentSecondForm P C j k)) 0 = deriv (deriv (normalizedHessian P C (tangent j) (tangent k))) 0 + acceleration (tangentFrame P C j) none * w P g k + acceleration (tangentFrame P C k) none * w P g j + (∑ l, acceleration (tangentFrame P C j) (tangent l) * A P g l k) + (∑ l, acceleration (tangentFrame P C k) (tangent l) * A P g l j) + 2 * (if i = j then 1 else 0) * A P g i k + 2 * (if i = k then 1 else 0) * A P g i j + 2 * z P g * A P g i j * A P g i k - 2 * A P g i j * V P g i k - 2 * A P g i k * V P g i j + 2 * w P g i * (A P g i j * w P g k + A P g i k * w P g j) := by obtain ⟨E, rfl, hE, hE0, horth, htan⟩ := exists_analytic_tangent_frame P d hP g hg hgn hgt C hC hC0 hmem have hN := normalizedHessian_analyticAt P g hg hgn hgt C hC hC0 have hj := Source29BilinearFrameJet.second_deriv_two_axis (tangentFrame P C j) (tangentFrame P C k) (fun t a b => normalizedHessian P C a b t) (analyticAt_pi_iff.mp (hE j)) (analyticAt_pi_iff.mp (hE k)) hN (some none) none (tangent j) (tangent k) (if i=j then 1 else 0) (A P g i j) (if i=k then 1 else 0) (A P g i k) (hE0 j) (hE0 k) (tangentFrame_first_deriv P g hg hgn hgt C hC hC0 i j hC1) (tangentFrame_first_deriv P g hg hgn hgt C hC hC0 i k hC1) have hacc : ∀ a b, (∑ l, acceleration (tangentFrame P C a) l * normalizedHessian P C l (tangent b) 0) = acceleration (tangentFrame P C a) none * w P g b + ∑ l, acceleration (tangentFrame P C a) (tangent l) * A P g l b := by intro a b rw [Fintype.sum_option, Fintype.sum_option] have hr : normalizedHessian P C (some none) (tangent b) 0 = 0 := zero_radial_some P d hP hd g hg hgn hgt C hC0 (some b) simp only [zero_normal_tangent P g hg hgn hgt C hC0, hr, mul_zero, zero_add] change _ + (∑ l, acceleration (tangentFrame P C a) (tangent l) * normalizedHessian P C (tangent l) (tangent b) 0) = _ simp only [zero_tangent P g hg hgn hgt C hC0] have haccR : (∑ l, normalizedHessian P C (tangent j) l 0 * acceleration (tangentFrame P C k) l) = acceleration (tangentFrame P C k) none * w P g j + ∑ l, acceleration (tangentFrame P C k) (tangent l) * A P g l j := by rw [← hacc k j] apply Finset.sum_congr rfl intro l _ rw [normalizedHessian_symm P C (tangent j) l] ring have hnr : normalizedHessian P C none (some none) 0 = (d : ℝ)-1 := by rw [normalizedHessian_symm, zero_radial_normal P d hP hd g hg hgn hgt C hC0] have hjr : deriv (normalizedHessian P C (tangent j) (some none)) 0 = ((d : ℝ)-2)*A P g i j := by rw [normalizedHessian_symm, first_radial_tangent P d hP hd g hg hgn hgt C hC hC0 i j hC1] have hjn : deriv (normalizedHessian P C (tangent j) none) 0 = V P g i j - w P g i * w P g j := by rw [normalizedHessian_symm, first_normal_tangent P g hg hgn hgt C hC hC0 i j hC1] rw [secondForm_eq_normalized_bilinear, hj, hacc, haccR, zero_radial_some P d hP hd g hg hgn hgt C hC0 none, zero_radial_normal P d hP hd g hg hgn hgt C hC0, hnr, zero_normal P g hg hgn hgt C hC0, first_radial_tangent P d hP hd g hg hgn hgt C hC hC0 i k hC1, first_normal_tangent P g hg hgn hgt C hC hC0 i k hC1, hjr, hjn] ring end end Source29MovingSecondFormJets /- Component: FrameLaplacian.inc -/ namespace Source29FrameLaplacian open Filter MvPolynomial Source29PolynomialLinkChart Source29NormalizedLinkJets open Source29PolynomialTangentFrame Source29AnalyticDotSecond Source29SimonsJetCorrection open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def frameLaplacian (P : MvPolynomial (Option (Option ι)) ℝ) (C : ι → ℝ → Ambient ι) (a b : ι) : ℝ := ∑ i, acceleration (tangentFrame P (C i) a) (tangent b) theorem frameLaplacian_symmetric_part (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (g : ℝ) (hg : 0 < g) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ι → ℝ → Ambient ι) (hC : ∀ i, AnalyticAt ℝ (C i) 0) (hC0 : ∀ i, C i 0 = base) (hmem : ∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), eval (C i t) P = 0 ∧ (∑ a, (C i t a)^2) = 1) (hC1 : ∀ i a, deriv (fun t => C i t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (a b : ι) : frameLaplacian P C a b + frameLaplacian P C b a = -2 * ((if a=b then 1 else 0) + matrixSquare (A P g) a b) := by unfold frameLaplacian rw [← Finset.sum_add_distrib] simp_rw [Source29PolynomialTangentFrameSecond.tangentFrame_second_symmetric P d hP g hg hgn hgt (C _) (hC _) (hC0 _) (hmem _) _ a b (hC1 _)] rw [← Finset.mul_sum, Finset.sum_add_distrib] congr 1 congr 1 · simp only [ite_mul, one_mul, zero_mul, Finset.sum_ite_eq', Finset.mem_univ, if_true] · unfold matrixSquare apply Finset.sum_congr rfl intro i _ rw [A_symm P g i a] end end Source29FrameLaplacian /- Component: MovingSecondFormTrace.inc -/ namespace Source29MovingSecondFormTrace open Filter MvPolynomial Source29PolynomialLinkChart Source29NormalizedLinkJets open Source29PolynomialTangentFrame Source29PolynomialMovingCurvature Source29PolynomialJacobiCurves open Source29AnalyticDotSecond Source29SimonsJetCorrection Source29NormalizedHessianCurve open Source29FrameLaplacian open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem secondForm_trace_with_frameLaplacian (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (g : ℝ) (hg : 0 < g) (hL : Source29FactorInheritance.cubicOperator P = 0) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ι → ℝ → Ambient ι) (hC : ∀ i, AnalyticAt ℝ (C i) 0) (hC0 : ∀ i, C i 0 = base) (hmem : ∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), eval (C i t) P = 0 ∧ (∑ a, (C i t a)^2) = 1) (hC1 : ∀ i a, deriv (fun t => C i t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (hC2 : ∀ i a, acceleration (C i) a = -base a - A P g i i * Pi.single (M := fun _ => ℝ) none 1 a) (K : ℝ) (hJac : (∑ i, deriv (deriv (fun t => jacobiProfile P (C i t))) 0) + (K+((d : ℝ)-1)*((d : ℝ)-(Fintype.card ι : ℝ)))*g⁻¹ = 0) (a b : ι) : (∑ i, deriv (deriv (tangentSecondForm P (C i) a b)) 0) = ((Fintype.card ι : ℝ)+2-K)*A P g a b + 2*matrixCube (A P g) b a + (∑ l, frameLaplacian P C a l * A P g l b) + (∑ l, frameLaplacian P C b l * A P g l a) := by have hG : ∀ j k, (∑ i, ∑ l, acceleration (tangentFrame P (C i) j) (tangent l) * A P g l k) = ∑ l, frameLaplacian P C j l * A P g l k := by intro j k rw [Finset.sum_comm] simp only [frameLaplacian, Finset.sum_mul] have hN : ∀ j, (∑ i, acceleration (tangentFrame P (C i) j) none) = 0 := fun j => Source29PolynomialFrameNormalAcceleration.tangentFrame_normal_acceleration_trace P d hP hd g hg hL hgn hgt C hC hC0 hmem hC1 hC2 j have hsq : (∑ i, A P g i a * A P g i b) = matrixSquare (A P g) a b := by unfold matrixSquare apply Finset.sum_congr rfl intro i _ rw [A_symm P g i a] have hab := A_symm P g b a have hwa : (∑ i, w P g i * A P g i a) = ∑ i, A P g a i * w P g i := by apply Finset.sum_congr rfl intro i _ rw [A_symm P g i a] ring have hwb : (∑ i, w P g i * A P g i b) = ∑ i, A P g b i * w P g i := by apply Finset.sum_congr rfl intro i _ rw [A_symm P g i b] ring simp_rw [Source29MovingSecondFormJets.secondForm_second_deriv P d hP hd g hg hgn hgt (C _) (hC _) (hC0 _) (hmem _) _ a b (hC1 _)] simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib, hG, ← Finset.sum_mul, hN, zero_mul, add_zero] rw [Source29NormalizedHessianTrace.normalizedHessian_second_trace_reduced P d hP hd g hg hL hgn hgt C hC hC0 hC1 hC2 K (((d : ℝ)-1)*((d : ℝ)-(Fintype.card ι : ℝ))) hJac] simp only [mul_add, mul_assoc, Finset.sum_add_distrib, ← Finset.mul_sum, ← Finset.sum_mul, ite_mul, one_mul, zero_mul, mul_ite, mul_one, Finset.sum_ite_eq', Finset.sum_ite_eq, Finset.mem_univ, if_true, hsq, hwa, hwb, hab] ring_nf simp only [Finset.sum_ite_eq', Finset.mem_univ, if_true, mul_assoc, ← Finset.mul_sum, hwa, hwb, hab] ring end end Source29MovingSecondFormTrace /- Component: FrameContractionAlgebra.inc -/ namespace Source29FrameContractionAlgebra open Source29SimonsJetCorrection Source29GaussSimonsAlgebra open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem left_contraction (A G : ι → ι → ℝ) (hA : ∀ a b, A a b = A b a) : (∑ a, ∑ b, A a b * (∑ l, G a l * A l b)) = ∑ a, ∑ l, matrixSquare A a l * G a l := by simp only [matrixSquare, Finset.mul_sum, Finset.sum_mul] apply Finset.sum_congr rfl intro a _ rw [Finset.sum_comm] apply Finset.sum_congr rfl intro l _ apply Finset.sum_congr rfl intro b _ rw [hA l b] ring theorem right_contraction (A G : ι → ι → ℝ) (hA : ∀ a b, A a b = A b a) : (∑ a, ∑ b, A a b * (∑ l, G b l * A l a)) = ∑ a, ∑ l, matrixSquare A a l * G a l := by rw [← left_contraction A G hA, Finset.sum_comm] apply Finset.sum_congr rfl intro a _ apply Finset.sum_congr rfl intro b _ rw [hA b a] theorem cube_contraction (A : ι → ι → ℝ) (hA : ∀ a b, A a b = A b a) : (∑ a, ∑ b, A a b * matrixCube A b a) = ∑ a, ∑ b, (matrixSquare A a b)^2 := by have hs : ∀ b l, (∑ a, A a b * A l a) = matrixSquare A b l := by intro b l unfold matrixSquare apply Finset.sum_congr rfl intro a _ rw [hA a b, hA l a] calc _ = ∑ b, ∑ l, matrixSquare A b l * (∑ a, A a b * A l a) := by simp only [matrixCube, Finset.mul_sum] rw [Finset.sum_comm] apply Finset.sum_congr rfl intro b _ rw [Finset.sum_comm] apply Finset.sum_congr rfl intro l _ apply Finset.sum_congr rfl intro a _ ring _ = _ := by simp only [hs, pow_two] theorem trace_square (A : ι → ι → ℝ) (hA : ∀ a b, A a b = A b a) : (∑ a, matrixSquare A a a) = normSq A := by simp only [matrixSquare, normSq] apply Finset.sum_congr rfl intro a _ apply Finset.sum_congr rfl intro b _ rw [hA b a, pow_two] theorem frame_contraction (A G : ι → ι → ℝ) (hA : ∀ a b, A a b = A b a) (hG : ∀ a b, G a b + G b a = -2*((if a=b then 1 else 0) + matrixSquare A a b)) : (∑ a, ∑ b, matrixSquare A a b * G a b) = -normSq A - (∑ a, ∑ b, (matrixSquare A a b)^2) := by have he := Source29SymmetricFrameContraction.contract_of_symmetric_part (matrixSquare A) G (fun a b => (if a=b then 1 else 0) + matrixSquare A a b) (matrixSquare_symm A hA) hG rw [he] simp only [mul_add, Finset.sum_add_distrib, mul_ite, mul_one, mul_zero, Finset.sum_ite_eq, Finset.mem_univ, if_true, ← pow_two, trace_square A hA] ring /-- The unknown skew part of the actual frame Laplacian cancels from the second-form contraction, leaving the scalar Simons right-hand side. -/ theorem contracted_trace (A G T : ι → ι → ℝ) (m K : ℝ) (hA : ∀ a b, A a b = A b a) (hG : ∀ a b, G a b + G b a = -2*((if a=b then 1 else 0) + matrixSquare A a b)) (hT : ∀ a b, T a b = (m+2-K)*A a b + 2*matrixCube A b a + (∑ l, G a l * A l b) + (∑ l, G b l * A l a)) : (∑ a, ∑ b, A a b * T a b) = (m-K)*normSq A := by have hscale : (∑ a, ∑ b, A a b * ((m+2-K)*A a b)) = (m+2-K)*normSq A := by simp only [normSq, Finset.mul_sum] apply Finset.sum_congr rfl intro a _ apply Finset.sum_congr rfl intro b _ ring have hcube : (∑ a, ∑ b, A a b * (2*matrixCube A b a)) = 2 * (∑ a, ∑ b, (matrixSquare A a b)^2) := by rw [← cube_contraction A hA] simp only [Finset.mul_sum] apply Finset.sum_congr rfl intro a _ apply Finset.sum_congr rfl intro b _ ring simp_rw [hT] simp only [mul_add, Finset.sum_add_distrib] rw [hscale, hcube, left_contraction A G hA, right_contraction A G hA, frame_contraction A G hA hG] ring end end Source29FrameContractionAlgebra /- Component: MovingSecondFormContraction.inc -/ namespace Source29MovingSecondFormContraction open Filter MvPolynomial Source29PolynomialLinkChart Source29NormalizedLinkJets open Source29PolynomialTangentFrame Source29PolynomialMovingCurvature Source29PolynomialJacobiCurves open Source29AnalyticDotSecond Source29GaussSimonsAlgebra Source29FrameLaplacian open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem actual_second_derivative_contraction (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (g : ℝ) (hg : 0 < g) (hL : Source29FactorInheritance.cubicOperator P = 0) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ι → ℝ → Ambient ι) (hC : ∀ i, AnalyticAt ℝ (C i) 0) (hC0 : ∀ i, C i 0 = base) (hmem : ∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), eval (C i t) P = 0 ∧ (∑ a, (C i t a)^2) = 1) (hC1 : ∀ i a, deriv (fun t => C i t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (hC2 : ∀ i a, acceleration (C i) a = -base a - A P g i i * Pi.single (M := fun _ => ℝ) none 1 a) (hJac : (∑ i, deriv (deriv (fun t => jacobiProfile P (C i t))) 0) + (normSq (A P g)+((d : ℝ)-1)*((d : ℝ)-(Fintype.card ι : ℝ)))*g⁻¹ = 0) : (∑ i, ∑ a, ∑ b, A P g a b * deriv (deriv (tangentSecondForm P (C i) a b)) 0) = ((Fintype.card ι : ℝ)-normSq (A P g))*normSq (A P g) := by calc _ = ∑ a, ∑ b, A P g a b * (∑ i, deriv (deriv (tangentSecondForm P (C i) a b)) 0) := by rw [Finset.sum_comm] apply Finset.sum_congr rfl intro a _ rw [Finset.sum_comm] simp only [Finset.mul_sum] _ = _ := Source29FrameContractionAlgebra.contracted_trace (A P g) (frameLaplacian P C) (fun a b => ∑ i, deriv (deriv (tangentSecondForm P (C i) a b)) 0) (Fintype.card ι : ℝ) (normSq (A P g)) (A_symm P g) (frameLaplacian_symmetric_part P d hP g hg hgn hgt C hC hC0 hmem hC1) (Source29MovingSecondFormTrace.secondForm_trace_with_frameLaplacian P d hP hd g hg hL hgn hgt C hC hC0 hmem hC1 hC2 (normSq (A P g)) hJac) end end Source29MovingSecondFormContraction /- Component: NormalizedScalarSimons.inc -/ namespace Source29NormalizedScalarSimons open Filter MvPolynomial Source29PolynomialLinkChart Source29NormalizedLinkJets open Source29PolynomialMovingCurvature Source29PolynomialJacobiCurves Source29PolynomialCurvaturePotential open Source29AnalyticDotSecond Source29GaussSimonsAlgebra open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Scalar Simons along actual analytic link curves. All geometric derivative identities are derived from the polynomial and the constructed frame. -/ theorem scalar_simons_for_link_curves (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (g : ℝ) (hg : 0 < g) (hL : Source29FactorInheritance.cubicOperator P = 0) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ι → ℝ → Ambient ι) (hC : ∀ i, AnalyticAt ℝ (C i) 0) (hC0 : ∀ i, C i 0 = base) (hmem : ∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), eval (C i t) P = 0 ∧ (∑ a, (C i t a)^2) = 1) (hC1 : ∀ i a, deriv (fun t => C i t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (hC2 : ∀ i a, acceleration (C i) a = -base a - A P g i i * Pi.single (M := fun _ => ℝ) none 1 a) (hJac : (∑ i, deriv (deriv (fun t => jacobiProfile P (C i t))) 0) + (normSq (A P g)+((d : ℝ)-1)*((d : ℝ)-(Fintype.card ι : ℝ)))*g⁻¹ = 0) (hpos : 0 < curvaturePotential P base) : ((Fintype.card ι : ℝ)-curvaturePotential P base) * curvatureNorm P base ≤ ∑ i, deriv (deriv (fun t => curvatureNorm P (C i t))) 0 := by have hK := Source29PolynomialSimonsTensor.normSq_A_eq_curvaturePotential P d hP hd g hg.ne' hL hgn hgt have hsq : (curvatureNorm P base)^2 = normSq (A P g) := by rw [hK] exact Real.sq_sqrt hpos.le have hp : 0 < curvatureNorm P base := Real.sqrt_pos.mpr hpos have hreg : gradientAt P base ≠ 0 := by intro he have hn := congrFun he none exact hg.ne' (by simpa only [gradientAt, hgn, Pi.zero_apply] using hn) have hcurv : AnalyticAt ℝ (curvatureNorm P) base := Source29PolynomialCurvatureRegularity.curvatureNorm_analyticAt P base hreg hpos have hh : ∀ i, AnalyticAt ℝ (fun t => curvatureNorm P (C i t)) 0 := by intro i have ha : AnalyticAt ℝ (curvatureNorm P) (C i 0) := by simpa only [hC0] using hcurv exact ha.comp (hC i) have hA : ∀ i (j : ι × ι), AnalyticAt ℝ (tangentSecondForm P (C i) j.1 j.2) 0 := by intro i j exact tangentSecondForm_analyticAt P d hP g hg hgn hgt (C i) (hC i) (hC0 i) (hmem i) j.1 j.2 have hzero : (curvatureNorm P base)^2 = ∑ j : ι × ι, (A P g j.1 j.2)^2 := by simpa only [normSq, Fintype.sum_prod_type] using hsq have hnorm : ∀ i, (fun t => (curvatureNorm P (C i t))^2) =ᶠ[𝓝 (0 : ℝ)] (fun t => ∑ j : ι × ι, (tangentSecondForm P (C i) j.1 j.2 t)^2) := by intro i simpa only [Fintype.sum_prod_type] using tangentSecondForm_local_norm P d hP g hg hgn hgt (C i) (hC i) (hC0 i) (hmem i) (by omega) have hcontract := Source29MovingSecondFormContraction.actual_second_derivative_contraction P d hP hd g hg hL hgn hgt C hC hC0 hmem hC1 hC2 hJac have he := Source29ContractedSimonsNorm.scalar_simons_for_analytic_components (fun i (j : ι × ι) => tangentSecondForm P (C i) j.1 j.2) (fun i t => curvatureNorm P (C i t)) (fun j : ι × ι => A P g j.1 j.2) (curvatureNorm P base) (Fintype.card ι : ℝ) hh hA (fun i => congrArg (curvatureNorm P) (hC0 i)) (fun i j => tangentSecondForm_zero P g hg hgn hgt (C i) (hC0 i) j.1 j.2) hp hzero hnorm (by simpa only [Fintype.sum_prod_type, hsq] using hcontract) simpa only [hsq, hK] using he end end Source29NormalizedScalarSimons /- Component: PolynomialSimonsCurves.inc -/ namespace Source29PolynomialSimonsCurves open Filter MvPolynomial Source29PolynomialLinkChart Source29NormalizedLinkJets open Source29PolynomialJacobiCurves Source29PolynomialCurvaturePotential Source29GaussSimonsAlgebra open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Actual local link curves satisfy both Jacobi and scalar Simons. The Jacobi identity and all moving-frame identities are derived, not assumed. -/ theorem exists_simons_jacobi_curves (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (g : ℝ) (hg : 0 < g) (hL : Source29FactorInheritance.cubicOperator P = 0) (hzero : eval base P = 0) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (hpos : 0 < curvaturePotential P base) : ∃ C : ι → ℝ → Ambient ι, (∀ i, AnalyticAt ℝ (C i) 0) ∧ (∀ i, C i 0 = base) ∧ (∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), eval (C i t) P = 0 ∧ (∑ a, (C i t a)^2) = 1) ∧ (∀ i, AnalyticAt ℝ (fun t => jacobiProfile P (C i t)) 0) ∧ (∀ i, AnalyticAt ℝ (fun t => curvatureNorm P (C i t)) 0) ∧ ((∑ i, deriv (deriv (fun t => jacobiProfile P (C i t))) 0) + (curvaturePotential P base + ((d : ℝ)-1)*((d : ℝ)-(Fintype.card ι : ℝ))) * jacobiProfile P base = 0) ∧ (((Fintype.card ι : ℝ)-curvaturePotential P base)*curvatureNorm P base ≤ ∑ i, deriv (deriv (fun t => curvatureNorm P (C i t))) 0) := by obtain ⟨γ, hγ, hγ0, hγ1, hγ2, hmem, hprofile, hJac⟩ := exists_jacobi_curves P d hP (by omega) g hg hL hzero hgn hgt let C : ι → ℝ → Ambient ι := fun i t a => γ i a t have hC : ∀ i, AnalyticAt ℝ (C i) 0 := fun i => AnalyticAt.pi (hγ i) have hC0 : ∀ i, C i 0 = base := fun i => funext (hγ0 i) have hC2 : ∀ i a, Source29AnalyticDotSecond.acceleration (C i) a = -base a - A P g i i * Pi.single (M := fun _ => ℝ) none 1 a := by intro i a exact hγ2 i a rw [← curvaturePotential_at_base P d hP (by omega) g hg.ne' hgn hgt] at hJac have hJ : (∑ i, deriv (deriv (fun t => jacobiProfile P (C i t))) 0) + (normSq (A P g)+((d : ℝ)-1)*((d : ℝ)-(Fintype.card ι : ℝ)))*g⁻¹ = 0 := by rw [Source29PolynomialSimonsTensor.normSq_A_eq_curvaturePotential P d hP hd g hg.ne' hL hgn hgt] simpa only [C, jacobiProfile_at_base P g hg hgn hgt] using hJac have hreg : gradientAt P base ≠ 0 := by intro he have hn := congrFun he none exact hg.ne' (by simpa only [gradientAt, hgn, Pi.zero_apply] using hn) have hc : ∀ i, AnalyticAt ℝ (fun t => curvatureNorm P (C i t)) 0 := by intro i have he : AnalyticAt ℝ (curvatureNorm P) (C i 0) := by rw [hC0] exact Source29PolynomialCurvatureRegularity.curvatureNorm_analyticAt P base hreg hpos exact he.comp (hC i) refine ⟨C, hC, hC0, hmem, hprofile, hc, hJac, ?_⟩ exact Source29NormalizedScalarSimons.scalar_simons_for_link_curves P d hP hd g hg hL hgn hgt C hC hC0 hmem hγ1 hC2 hJ hpos end end Source29PolynomialSimonsCurves /- Component: RegularLinkSimons.inc -/ namespace Source29RegularLinkSimons open Filter MvPolynomial Source29PolynomialLinkChart Source29PolynomialJacobiCurves open Source29PolynomialCurvaturePotential Source29PolynomialJacobiTransport open Source29QuarticReuse.QuarticMinimal open scoped Topology BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Jacobi and scalar Simons at every regular link point with positive curvature, transported from the normalized polynomial to its original coordinates. -/ theorem exists_regular_link_simons_curves (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (hL : Source29FactorInheritance.cubicOperator P = 0) (x : Ambient ι) (hx : (∑ a, (x a)^2) = 1) (hzero : eval x P = 0) (hreg : gradientAt P x ≠ 0) (hpos : 0 < curvaturePotential P x) : ∃ C : ι → ℝ → Ambient ι, (∀ i, AnalyticAt ℝ (C i) 0) ∧ (∀ i, C i 0 = x) ∧ (∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), eval (C i t) P = 0 ∧ (∑ a, (C i t a)^2) = 1) ∧ (∀ i, AnalyticAt ℝ (fun t => jacobiProfile P (C i t)) 0) ∧ (∀ i, AnalyticAt ℝ (fun t => curvatureNorm P (C i t)) 0) ∧ ((∑ i, deriv (deriv (fun t => jacobiProfile P (C i t))) 0) + (curvaturePotential P x + ((d : ℝ)-1)*((d : ℝ)-(Fintype.card ι : ℝ))) * jacobiProfile P x = 0) ∧ (((Fintype.card ι : ℝ)-curvaturePotential P x)*curvatureNorm P x ≤ ∑ i, deriv (deriv (fun t => curvatureNorm P (C i t))) 0) := by obtain ⟨g, U, hg, hUt, hU, hbase, hQ, hLQ, hQzero, hgn, hgt⟩ := Source29PolynomialNormalFrame.exists_normalized_polynomial P d hP hL x hx hzero hreg have hp : 0 < curvaturePotential (changeVariables U P) base := by rwa [curvaturePotential_changeVariables U hU, hbase] obtain ⟨γ, hγ, hγ0, hγmem, hγφ, hγh, hJ, hS⟩ := Source29PolynomialSimonsCurves.exists_simons_jacobi_curves (changeVariables U P) d hQ hd g hg hLQ hQzero hgn hgt hp let C : ι → ℝ → Ambient ι := fun i t => U *ᵥ γ i t have hC : ∀ i, AnalyticAt ℝ (C i) 0 := fun i => Source29LinearCurveTransport.analytic_mulVec U (fun a t => γ i t a) (analyticAt_pi_iff.mp (hγ i)) have hC0 : ∀ i, C i 0 = x := by intro i change U *ᵥ γ i 0 = x rw [hγ0, hbase] refine ⟨C, hC, hC0, ?_, ?_, ?_, ?_, ?_⟩ · intro i filter_upwards [hγmem i] with t ht constructor · change eval (U *ᵥ γ i t) P = 0 rw [← eval_changeVariables] exact ht.1 · change (∑ a, (U *ᵥ γ i t) a ^ 2) = 1 rw [norm_square_mulVec U hUt] exact ht.2 · simpa only [jacobiProfile_changeVariables U hU] using hγφ · simpa only [curvatureNorm_changeVariables U hU] using hγh · simpa only [jacobiProfile_changeVariables U hU, curvaturePotential_changeVariables U hU, hbase] using hJ · simpa only [curvatureNorm_changeVariables U hU, curvaturePotential_changeVariables U hU, hbase] using hS end end Source29RegularLinkSimons /- Component: CompactLinkDegreeBound.inc -/ namespace Source29CompactLinkDegreeBound open Filter MvPolynomial Source29PolynomialLinkChart Source29PolynomialCurvaturePotential open Source29PolynomialJacobiCurves Source29PolynomialCurvatureRegularity open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Compact comparison with the now-derived Jacobi and scalar Simons inequalities. Global regularity and nonflatness are the remaining inputs. -/ theorem homogeneous_degree_eigenvalue_bound (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (hL : Source29FactorInheritance.cubicOperator P = 0) (hregular : ∀ x : Ambient ι, eval x P = 0 ∧ (∑ a, (x a)^2) = 1 → gradientAt P x ≠ 0) (hnonflat : ∃ x : Ambient ι, (eval x P = 0 ∧ (∑ a, (x a)^2) = 1) ∧ 0 < curvaturePotential P x) : ((d : ℝ)-1)*((d : ℝ)-(Fintype.card ι : ℝ)) ≤ -(Fintype.card ι : ℝ) := by let s : Set (Ambient ι) := {x | eval x P = 0 ∧ (∑ a, (x a)^2) = 1} have hs : IsCompact s := Source29CompactPolynomialLink.isCompact_link P have hr : ∀ x ∈ s, gradientAt P x ≠ 0 := hregular have hc : ContinuousOn (curvatureNorm P) s := curvatureNorm_continuousOn P s hr have hφ : ContinuousOn (jacobiProfile P) s := fun x hx => (jacobiProfile_analyticAt P x (hr x hx)).continuousAt.continuousWithinAt have hφpos : ∀ x ∈ s, 0 < jacobiProfile P x := fun x hx => jacobiProfile_positive P x (hr x hx) obtain ⟨b, hb, hpb⟩ := hnonflat have hhb : 0 < curvatureNorm P b := Real.sqrt_pos.mpr hpb have hrc : ContinuousOn (fun x => curvatureNorm P x / jacobiProfile P x) s := hc.div hφ (fun x hx => (hφpos x hx).ne') obtain ⟨a, ha, hmax⟩ := hs.exists_isMaxOn ⟨b, hb⟩ hrc have hratio : 0 < curvatureNorm P a / jacobiProfile P a := (div_pos hhb (hφpos b hb)).trans_le (hmax hb) have hha : 0 < curvatureNorm P a := by have he := (lt_div_iff₀ (hφpos a ha)).mp hratio simpa only [zero_mul] using he have hpa : 0 < curvaturePotential P a := Real.sqrt_pos.mp hha obtain ⟨C, hC, hC0, hmem, hCφ, hCh, hJac, hSimons⟩ := Source29RegularLinkSimons.exists_regular_link_simons_curves P d hP hd hL a ha.2 ha.1 (hr a ha) hpa apply Source29LocalEigenvalueComparison.eigenvalue_bound_at_ratio_maximum (fun i t => curvatureNorm P (C i t)) (fun i t => jacobiProfile P (C i t)) (curvatureNorm P a) (jacobiProfile P a) (curvaturePotential P a) (Fintype.card ι : ℝ) (((d : ℝ)-1)*((d : ℝ)-(Fintype.card ι : ℝ))) hCh hCφ (fun i => congrArg (curvatureNorm P) (hC0 i)) (fun i => congrArg (jacobiProfile P) (hC0 i)) hha (hφpos a ha) _ hSimons hJac intro i change ∀ᶠ t in 𝓝 (0 : ℝ), curvatureNorm P (C i t) / jacobiProfile P (C i t) ≤ curvatureNorm P (C i 0) / jacobiProfile P (C i 0) filter_upwards [hmem i] with t ht simpa only [hC0, Set.mem_setOf_eq] using hmax ht /-- In ambient dimension eight, a homogeneous solution of Lp=0 with degree at least three and a globally regular nonflat unit zero link has degree at most four. -/ theorem degree_interval_ambient_eight (P : MvPolynomial (Option (Option (Fin 6))) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (hL : Source29FactorInheritance.cubicOperator P = 0) (hregular : ∀ x : Ambient (Fin 6), eval x P = 0 ∧ (∑ a, (x a)^2) = 1 → gradientAt P x ≠ 0) (hnonflat : ∃ x : Ambient (Fin 6), (eval x P = 0 ∧ (∑ a, (x a)^2) = 1) ∧ 0 < curvaturePotential P x) : 3 ≤ d ∧ d ≤ 4 := by have he := homogeneous_degree_eigenvalue_bound P d hP hd hL hregular hnonflat have hb : ((d : ℝ)-1)*((d : ℝ)-6) ≤ -(6 : ℝ) := by simpa using he have hi := Source29LocalEigenvalueComparison.degree_interval_eight (d : ℝ) (((d : ℝ)-1)*((d : ℝ)-6)) (by ring) hb exact ⟨hd, by exact_mod_cast hi.2⟩ end end Source29CompactLinkDegreeBound /- Component: PolynomialReindex.inc -/ namespace Source29PolynomialReindex open MvPolynomial Source29FactorInheritance Source29PolynomialCurvaturePotential open Source29QuarticReuse.QuarticMinimal.AmbientQuartic open scoped BigOperators Matrix noncomputable section variable {κ η : Type*} [Fintype κ] [Fintype η] [DecidableEq κ] [DecidableEq η] theorem cubicOperator_rename (e : κ ≃ η) (P : MvPolynomial κ ℝ) : cubicOperator (rename e P) = rename e (cubicOperator P) := by unfold cubicOperator rw [← e.sum_comp (fun i => (pderiv i (rename e P))^2), ← e.sum_comp (fun i => pderiv i (pderiv i (rename e P))), ← Source29MetricReindex.sum_two_reindex e (fun i j => pderiv i (rename e P) * pderiv j (rename e P) * pderiv i (pderiv j (rename e P)))] simp only [pderiv_rename e.injective, map_sub, map_mul, map_pow, map_sum] theorem gradientAt_rename (e : κ ≃ η) (P : MvPolynomial κ ℝ) (x : η → ℝ) (a : κ) : gradientAt (rename e P) x (e a) = gradientAt P (x ∘ e) a := by simp only [gradientAt, pderiv_rename e.injective, eval_rename] theorem realHessian_rename (e : κ ≃ η) (P : MvPolynomial κ ℝ) (x : η → ℝ) (a b : κ) : realHessian (rename e P) x (e a) (e b) = realHessian P (x ∘ e) a b := by simp only [realHessian_apply, pderiv_rename e.injective, eval_rename] theorem gradientAt_rename_ne_zero (e : κ ≃ η) (P : MvPolynomial κ ℝ) (x : η → ℝ) (hr : gradientAt P (x ∘ e) ≠ 0) : gradientAt (rename e P) x ≠ 0 := by intro he apply hr funext a have hz := congrFun he (e a) simpa only [gradientAt_rename, Pi.zero_apply] using hz end end Source29PolynomialReindex /- Component: CurvatureReindex.inc -/ namespace Source29CurvatureReindex open MvPolynomial Source29CurvaturePotentialAlgebra Source29PolynomialCurvaturePotential open Source29QuarticReuse.QuarticMinimal.AmbientQuartic open scoped BigOperators Matrix noncomputable section variable {κ η : Type*} [Fintype κ] [Fintype η] [DecidableEq κ] [DecidableEq η] theorem dot_reindex (e : κ ≃ η) (v w : η → ℝ) : (fun a => v (e a)) ⬝ᵥ (fun a => w (e a)) = v ⬝ᵥ w := e.sum_comp (fun a => v a * w a) theorem potential_reindex (e : κ ≃ η) (v : η → ℝ) (H : Matrix η η ℝ) : potential (fun a => v (e a)) (fun a b => H (e a) (e b)) = potential v H := by have hH : matrixSq (fun a b => H (e a) (e b)) = matrixSq H := Source29MetricReindex.sum_two_reindex e (fun a b => (H a b)^2) have hm : (fun a b => H (e a) (e b)) *ᵥ (fun a => v (e a)) = fun a => (H *ᵥ v) (e a) := by funext a exact e.sum_comp (fun b => H (e a) b * v b) simp only [potential, hm, hH, vectorSq, dot_reindex] theorem curvaturePotential_rename (e : κ ≃ η) (P : MvPolynomial κ ℝ) (x : η → ℝ) : curvaturePotential (rename e P) x = curvaturePotential P (x ∘ e) := by have he := potential_reindex e (gradientAt (rename e P) x) (realHessian (rename e P) x) have hg : (fun a => gradientAt (rename e P) x (e a)) = gradientAt P (x ∘ e) := by funext a exact Source29PolynomialReindex.gradientAt_rename e P x a have hH : (fun a b => realHessian (rename e P) x (e a) (e b)) = realHessian P (x ∘ e) := by funext a b exact Source29PolynomialReindex.realHessian_rename e P x a b rw [hg, hH] at he exact he.symm end end Source29CurvatureReindex /- Component: FinEightDegreeBound.inc -/ namespace Source29FinEightDegreeBound open MvPolynomial Source29PolynomialCurvaturePotential Source29FactorInheritance open scoped BigOperators noncomputable section def eightLinkEquiv : Fin 8 ≃ Option (Option (Fin 6)) := Fintype.equivOfCardEq (by simp) /-- The checked compact-link degree bound in the original Fin 8 coordinates. -/ theorem regular_nonflat_degree_le_four (P : MvPolynomial (Fin 8) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (hL : cubicOperator P = 0) (hregular : ∀ x, eval x P = 0 ∧ (∑ a, (x a)^2) = 1 → gradientAt P x ≠ 0) (hnonflat : ∃ x, (eval x P = 0 ∧ (∑ a, (x a)^2) = 1) ∧ 0 < curvaturePotential P x) : d ≤ 4 := by let e := eightLinkEquiv let Q := rename e P have hQ : Q.IsHomogeneous d := hP.rename_isHomogeneous have hQL : cubicOperator Q = 0 := by change cubicOperator (rename e P) = 0 rw [Source29PolynomialReindex.cubicOperator_rename, hL, map_zero] have hqr : ∀ x, eval x Q = 0 ∧ (∑ a, (x a)^2) = 1 → gradientAt Q x ≠ 0 := by intro x hx apply Source29PolynomialReindex.gradientAt_rename_ne_zero e P x apply hregular constructor · simpa only [Q, eval_rename] using hx.1 · change (∑ a, (x (e a))^2) = 1 rw [e.sum_comp (fun a => (x a)^2)] exact hx.2 obtain ⟨x, hx, hp⟩ := hnonflat have hqn : ∃ y, (eval y Q = 0 ∧ (∑ a, (y a)^2) = 1) ∧ 0 < curvaturePotential Q y := by refine ⟨x ∘ e.symm, ⟨?_, ?_⟩, ?_⟩ · simpa only [Q, eval_rename, Function.comp_assoc, e.symm_comp_self, Function.comp_id] using hx.1 · change (∑ a, (x (e.symm a))^2) = 1 rw [e.symm.sum_comp (fun a => (x a)^2)] exact hx.2 · simpa only [Q, Source29CurvatureReindex.curvaturePotential_rename, Function.comp_assoc, e.symm_comp_self, Function.comp_id] using hp exact (Source29CompactLinkDegreeBound.degree_interval_ambient_eight Q d hQ hd hQL hqr hqn).2 end end Source29FinEightDegreeBound /- Component: QuadraticSignObstruction.inc -/ namespace Source29QuadraticSignObstruction open MvPolynomial Source29FactorInheritance open Source29QuarticReuse.QuarticMinimal Source29QuarticReuse.QuarticNormalization open Source29QuarticReuse.QuarticPolynomialBasics (gradient_at_homogeneous_sphere_extremum) open scoped BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def hessianTrace (P : MvPolynomial ι ℝ) : ℝ := ∑ i, hessianCoeff P i i theorem quadratic_trace_at_critical (P : MvPolynomial ι ℝ) (hP : P.IsHomogeneous 2) (hL : cubicOperator P = 0) (x : ι → ℝ) (hx : (∑ i, (x i)^2) = 1) (c : ℝ) (hc : c ≠ 0) (hgrad : ∀ i, eval x (pderiv i P) = c*x i) : hessianTrace P = c := by have hH : ∀ i j, eval x (pderiv i (pderiv j P)) = hessianCoeff P i j := by intro i j rw [second_partial_eq_C_of_totalDegree_le_two P hP.totalDegree_le, eval_C] have hMx : ∀ i, (∑ j, hessianCoeff P i j * x j) = c*x i := by intro i have he := eval_quadratic_gradient P hP.totalDegree_le x i have hz : (pderiv i P).coeff 0 = 0 := (Source29QuarticReuse.QuarticCompatibility.homogeneous_pderiv (i := i) hP).coeff_eq_zero (by simp) rw [hz, add_zero, hgrad] at he exact he.symm have hfirst : (∑ i, (c*x i)^2) = c^2 := by simp only [mul_pow, ← Finset.mul_sum, hx, mul_one] have hsecond : (∑ i, ∑ j, (c*x i)*(c*x j)*hessianCoeff P i j) = c^3 := by calc _ = c^2 * (∑ i, x i * (∑ j, hessianCoeff P i j * x j)) := by simp only [Finset.mul_sum] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ ring _ = c^3 := by simp only [hMx] have hs : (∑ i, x i * (c*x i)) = c := by calc _ = c * (∑ i, (x i)^2) := by rw [Finset.mul_sum] apply Finset.sum_congr rfl intro i _ ring _ = c := by rw [hx, mul_one] rw [hs] ring have he := congrArg (eval x) hL simp only [cubicOperator, map_sub, map_mul, map_pow, map_sum, map_zero, hgrad, hH, hfirst, hsecond] at he have hz : c^2 * (hessianTrace P-c) = 0 := by change c^2 * (∑ i, hessianCoeff P i i) - c^3 = 0 at he dsimp [hessianTrace] nlinarith [he] exact sub_eq_zero.mp ((mul_eq_zero.mp hz).resolve_left (pow_ne_zero 2 hc)) theorem positive_trace_of_positive_value (P : MvPolynomial ι ℝ) (hP : P.IsHomogeneous 2) (hL : cubicOperator P = 0) (hpos : ∃ x, 0 < eval x P) : 0 < hessianTrace P := by obtain ⟨x, hx⟩ := hpos obtain ⟨y, hy, hpy⟩ := exists_positive_sphere_value P 1 hP x hx obtain ⟨a, ha, hpa, hmax⟩ := exists_positive_sphere_maximum P y hy hpy have hgrad := gradient_at_homogeneous_sphere_extremum P 2 hP a ha hmax have he := quadratic_trace_at_critical P hP hL a ha (2*eval a P) (by positivity) (by simpa using hgrad) rw [he] positivity theorem cubicOperator_neg (P : MvPolynomial ι ℝ) : cubicOperator (-P) = -cubicOperator P := by simp only [cubicOperator, map_neg, neg_sq, neg_mul_neg, mul_neg, Finset.sum_neg_distrib] ring theorem no_sign_changing_quadratic (P : MvPolynomial ι ℝ) (hP : P.IsHomogeneous 2) (hL : cubicOperator P = 0) (hpos : ∃ x, 0 < eval x P) (hneg : ∃ x, eval x P < 0) : False := by have hp := positive_trace_of_positive_value P hP hL hpos have hn := positive_trace_of_positive_value (-P) hP.neg (by rw [cubicOperator_neg, hL, neg_zero]) (by obtain ⟨x, hx⟩ := hneg exact ⟨x, by simpa only [map_neg, neg_pos] using hx⟩) have he : hessianTrace (-P) = -hessianTrace P := by simp [hessianTrace, hessianCoeff] rw [he] at hn linarith end end Source29QuadraticSignObstruction /- Component: RegularFactorObstruction.inc -/ namespace Source29RegularFactorObstruction open MvPolynomial Source29FactorInheritance Source29PolynomialCurvaturePotential open Source29CurvaturePotentialAlgebra Source29QuarticReuse.QuarticMinimal.AmbientQuartic open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem curvaturePotential_zero_of_affine (P : MvPolynomial ι ℝ) (hP : P.totalDegree ≤ 1) (x : ι → ℝ) : curvaturePotential P x = 0 := by have hH : realHessian P x = 0 := by ext i j simp only [realHessian_apply, Source29QuarticReuse.QuarticPolynomialBasics.second_partials_zero_of_totalDegree_le_one P hP i j, map_zero, Matrix.zero_apply] simp [curvaturePotential, hH, potential, matrixSq, vectorSq, Matrix.mulVec, dotProduct] /-- All degrees are excluded for an irreducible sign-changing factor once its whole link is regular and has positive curvature somewhere. -/ theorem no_regular_nonflat_sign_changing_factor (P : MvPolynomial (Fin 8) ℝ) (hirr : Irreducible P) (hP : P.IsHomogeneous P.totalDegree) (hL : cubicOperator P = 0) (hpos : ∃ x, 0 < eval x P) (hneg : ∃ x, eval x P < 0) (hregular : ∀ x, eval x P = 0 ∧ (∑ a, (x a)^2) = 1 → gradientAt P x ≠ 0) (hnonflat : ∃ x, (eval x P = 0 ∧ (∑ a, (x a)^2) = 1) ∧ 0 < curvaturePotential P x) : False := by have hd2 : 2 ≤ P.totalDegree := by by_contra hh have hd : P.totalDegree ≤ 1 := by omega obtain ⟨x, hx, hp⟩ := hnonflat rw [curvaturePotential_zero_of_affine P hd x] at hp exact (lt_irrefl 0) hp have hd3 : 3 ≤ P.totalDegree := by by_contra hh have hd : P.totalDegree = 2 := by omega exact Source29QuadraticSignObstruction.no_sign_changing_quadratic P (hd ▸ hP) hL hpos hneg have hd4 := Source29FinEightDegreeBound.regular_nonflat_degree_le_four P P.totalDegree hP hd3 hL hregular hnonflat exact Source29LowDegreeEndpoints.no_irreducible_sign_changing_degree_three_or_four P hirr hP hL hd3 hd4 hpos hneg end end Source29RegularFactorObstruction /- Component: RegularStructureReduction.inc -/ namespace Source29RegularStructureReduction open MvPolynomial Source29Closing Source29PolynomialCurvaturePotential open scoped BigOperators noncomputable section /-- Remaining structural input from the full minimal equation. The degree estimate and all local differential identities are consequences, not inputs. -/ def RegularLeadingFactorData8 (P : Polynomial8) : Prop := ∃ (p Q : Polynomial8) (k : ℕ), 1 ≤ k ∧ Irreducible p ∧ p.IsHomogeneous p.totalDegree ∧ Q.IsHomogeneous Q.totalDegree ∧ homogeneousComponent P.totalDegree P = p^k*Q ∧ PositiveAwayFromZero Q ∧ (∃ x, 0 < eval x p) ∧ (∃ x, eval x p < 0) ∧ (∀ x, eval x p = 0 ∧ (∑ a, (x a)^2) = 1 → gradientAt p x ≠ 0) ∧ (∃ x, (eval x p = 0 ∧ (∑ a, (x a)^2) = 1) ∧ 0 < curvaturePotential p x) /-- Exact Problem29 follows once the explicitly listed structural data are derived from the full equation. This is a conditional reduction, not target. -/ theorem problem29_of_regular_leading_factor (hstructure : ∀ P : Polynomial8, Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → RegularLeadingFactorData8 P) : Math30.Problem29 := by intro P hminimal change P.totalDegree ≤ 1 by_contra hnonaffine have hdegree : 2 ≤ P.totalDegree := by omega obtain ⟨p, Q, k, hk, hp, hphom, hQhom, hfactor, hQpos, hpos, hneg, hregular, hnonflat⟩ := hstructure P hminimal hdegree obtain ⟨hne, hhom, hL⟩ := QuarticPolynomialBasics.leading_component_data P hminimal hdegree have hQdiv : Q ∣ homogeneousComponent P.totalDegree P := ⟨p^k, hfactor.trans (mul_comm _ _)⟩ have hQdegree := Source29ComplexObstruction.positive_divisor_obstruction (homogeneousComponent P.totalDegree P) Q P.totalDegree hne hhom hL hQhom hQpos hQdiv have hQconst : Q = C (Q.coeff 0) := totalDegree_eq_zero_iff_eq_C.mp hQdegree have hQne : Q ≠ 0 := by intro hQzero apply hne rw [hfactor, hQzero, mul_zero] have ha : Q.coeff 0 ≠ 0 := by intro hz apply hQne exact hQconst.trans (by simp only [hz, map_zero]) have hpL : Source29FactorInheritance.cubicOperator p = 0 := by apply Source29PowerOperator.cubicOperator_pow_mul_C_zero_imp p hp.ne_zero k (by omega) (Q.coeff 0) ha change QuarticPolynomialBasics.cubicOperator (p^k*C (Q.coeff 0)) = 0 rw [← hQconst, ← hfactor] exact hL exact Source29RegularFactorObstruction.no_regular_nonflat_sign_changing_factor p hp hphom hpL hpos hneg hregular hnonflat end end Source29RegularStructureReduction /- Component: CurvatureProjection.inc -/ namespace Source29CurvatureProjection open Source29CurvaturePotentialAlgebra open scoped BigOperators Matrix noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] def pair (A B : Matrix κ κ ℝ) : ℝ := ∑ i, ∑ j, A i j * B i j def outer (u v : κ → ℝ) : Matrix κ κ ℝ := fun i j => u i * v j theorem pair_comm (A B : Matrix κ κ ℝ) : pair A B = pair B A := by simp only [pair, mul_comm] theorem pair_add_left (A B C : Matrix κ κ ℝ) : pair (A + B) C = pair A C + pair B C := by simp [pair, add_mul, Finset.sum_add_distrib] theorem pair_sub_left (A B C : Matrix κ κ ℝ) : pair (A - B) C = pair A C - pair B C := by simp [pair, sub_mul, Finset.sum_sub_distrib] theorem pair_smul_left (a : ℝ) (A B : Matrix κ κ ℝ) : pair (a • A) B = a * pair A B := by simp [pair, mul_assoc, Finset.mul_sum] theorem pair_add_right (A B C : Matrix κ κ ℝ) : pair A (B + C) = pair A B + pair A C := by rw [pair_comm, pair_add_left, pair_comm B A, pair_comm C A] theorem pair_sub_right (A B C : Matrix κ κ ℝ) : pair A (B - C) = pair A B - pair A C := by rw [pair_comm, pair_sub_left, pair_comm B A, pair_comm C A] theorem pair_smul_right (a : ℝ) (A B : Matrix κ κ ℝ) : pair A (a • B) = a * pair A B := by rw [pair_comm, pair_smul_left, pair_comm B A] theorem pair_outer (A : Matrix κ κ ℝ) (u v : κ → ℝ) : pair A (outer u v) = u ⬝ᵥ (A *ᵥ v) := by simp only [pair, outer, dotProduct, Matrix.mulVec, Finset.mul_sum] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ ring theorem pair_outer_outer (u v w z : κ → ℝ) : pair (outer u v) (outer w z) = (u ⬝ᵥ w) * (v ⬝ᵥ z) := by simp only [pair, outer, dotProduct, Finset.sum_mul, Finset.mul_sum] rw [Finset.sum_comm] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ ring theorem dot_mulVec_symm (H : Matrix κ κ ℝ) (hH : ∀ i j, H i j = H j i) (u v : κ → ℝ) : u ⬝ᵥ (H *ᵥ v) = v ⬝ᵥ (H *ᵥ u) := by simp only [dotProduct, Matrix.mulVec, Finset.mul_sum] rw [Finset.sum_comm] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ rw [hH j i] ring def tangentHessian (v : κ → ℝ) (H : Matrix κ κ ℝ) : Matrix κ κ ℝ := H - (vectorSq v)⁻¹ • outer v (H *ᵥ v) - (vectorSq v)⁻¹ • outer (H *ᵥ v) v + ((v ⬝ᵥ (H *ᵥ v)) / (vectorSq v)^2) • outer v v theorem matrixSq_tangentHessian (v : κ → ℝ) (H : Matrix κ κ ℝ) (hH : ∀ i j, H i j = H j i) (hv : vectorSq v ≠ 0) : matrixSq (tangentHessian v H) = vectorSq v * potential v H := by have hsq (A : Matrix κ κ ℝ) : matrixSq A = pair A A := by simp only [matrixSq, pair, pow_two] rw [hsq] unfold tangentHessian simp only [pair_add_left, pair_sub_left, pair_smul_left, pair_add_right, pair_sub_right, pair_smul_right] simp only [pair_outer_outer] simp only [pair_comm (outer _ _) H, pair_outer] rw [dot_mulVec_symm H hH v (H *ᵥ v)] rw [dotProduct_comm (H *ᵥ v) v] rw [← hsq] unfold potential vectorSq at * field_simp <;> ring theorem tangentHessian_zero_of_potential_zero (v : κ → ℝ) (H : Matrix κ κ ℝ) (hH : ∀ i j, H i j = H j i) (hv : vectorSq v ≠ 0) (hzero : potential v H = 0) : tangentHessian v H = 0 := by have hs := matrixSq_tangentHessian v H hH hv rw [hzero, mul_zero] at hs have hi (i : κ) : ∑ j, (tangentHessian v H i j)^2 = 0 := (Finset.sum_eq_zero_iff_of_nonneg (fun i _ => Finset.sum_nonneg (fun j _ => sq_nonneg _))).mp hs i (Finset.mem_univ _) ext i j have hij := (Finset.sum_eq_zero_iff_of_nonneg (fun j _ => sq_nonneg (tangentHessian v H i j))).mp (hi i) j (Finset.mem_univ _) exact (sq_eq_zero_iff).mp hij theorem vectorSq_pos (v : κ → ℝ) (hv : v ≠ 0) : 0 < vectorSq v := by have hn : 0 ≤ vectorSq v := by exact Finset.sum_nonneg (fun i _ => mul_self_nonneg (v i)) exact lt_of_le_of_ne hn (Ne.symm (fun h => hv (dotProduct_self_eq_zero.mp h))) theorem potential_nonneg (v : κ → ℝ) (H : Matrix κ κ ℝ) (hH : ∀ i j, H i j = H j i) (hv : v ≠ 0) : 0 ≤ potential v H := by have hs := vectorSq_pos v hv have he := matrixSq_tangentHessian v H hH hs.ne' have hn : 0 ≤ matrixSq (tangentHessian v H) := Finset.sum_nonneg (fun i _ => Finset.sum_nonneg (fun j _ => sq_nonneg _)) rw [he] at hn exact nonneg_of_mul_nonneg_right hn hs theorem tangent_contraction (v u w : κ → ℝ) (H : Matrix κ κ ℝ) (hu : u ⬝ᵥ v = 0) (hw : v ⬝ᵥ w = 0) : u ⬝ᵥ (tangentHessian v H *ᵥ w) = u ⬝ᵥ (H *ᵥ w) := by rw [← pair_outer, ← pair_outer] unfold tangentHessian simp only [pair_add_left, pair_sub_left, pair_smul_left, pair_outer_outer] rw [dotProduct_comm v u, hu, hw] simp theorem tangent_contraction_zero (v u w : κ → ℝ) (H : Matrix κ κ ℝ) (hH : ∀ i j, H i j = H j i) (hv : v ≠ 0) (hzero : potential v H = 0) (hu : u ⬝ᵥ v = 0) (hw : v ⬝ᵥ w = 0) : u ⬝ᵥ (H *ᵥ w) = 0 := by rw [← tangent_contraction v u w H hu hw, tangentHessian_zero_of_potential_zero v H hH (vectorSq_pos v hv).ne' hzero] simp theorem tangent_mulVec_parallel (v w : κ → ℝ) (H : Matrix κ κ ℝ) (hH : ∀ i j, H i j = H j i) (hv : v ≠ 0) (hzero : potential v H = 0) (hw : v ⬝ᵥ w = 0) : H *ᵥ w = fun i => (v ⬝ᵥ (H *ᵥ w)) / vectorSq v * v i := by have hs := (vectorSq_pos v hv).ne' funext i let u : κ → ℝ := Pi.single i 1 - (v i / vectorSq v) • v have hu : u ⬝ᵥ v = 0 := by simp only [u, sub_dotProduct, smul_dotProduct, single_dotProduct, one_mul, smul_eq_mul] change v i - (v i / vectorSq v) * vectorSq v = 0 field_simp <;> ring have he := tangent_contraction_zero v u w H hH hv hzero hu hw simp only [u, sub_dotProduct, smul_dotProduct, single_dotProduct, one_mul, smul_eq_mul] at he calc _ = v i / vectorSq v * (v ⬝ᵥ (H *ᵥ w)) := sub_eq_zero.mp he _ = _ := by ring end end Source29CurvatureProjection /- Component: LocalHyperplaneDivisor.inc -/ namespace Source29LocalHyperplaneDivisor open MvPolynomial Filter open scoped Topology noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] theorem polynomial_eq_zero_of_locally_zero (P : MvPolynomial κ ℝ) (a : κ → ℝ) (hzero : ∀ᶠ y in 𝓝 a, eval y P = 0) : P = 0 := by have ha : AnalyticOnNhd ℝ (fun y => eval y P) Set.univ := fun x _ => Source29PolynomialLinkChart.analyticAt_eval_real P x have hb : AnalyticOnNhd ℝ (fun _ : κ → ℝ => (0 : ℝ)) Set.univ := fun _ _ => analyticAt_const have he := ha.eq_of_eventuallyEq hb hzero apply Source29QuarticReuse.QuarticCompatibility.polynomial_funext intro x simpa using congrFun he x theorem X_dvd_of_locally_zero_on_hyperplane (P : MvPolynomial (Option κ) ℝ) (a : κ → ℝ) (hzero : ∀ᶠ y in 𝓝 a, eval (fun j => j.elim 0 y) P = 0) : X none ∣ P := by let e := optionEquivLeft ℝ κ have heval (y : κ → ℝ) : eval (fun j => j.elim 0 y) P = eval y ((e P).coeff 0) := by rw [optionEquivLeft_elim_eval] simp [e, ← Polynomial.coeff_zero_eq_eval_zero] have hc : (e P).coeff 0 = 0 := polynomial_eq_zero_of_locally_zero _ a (hzero.mono (fun y hy => by rwa [heval] at hy)) obtain ⟨Q, hQ⟩ := Polynomial.X_dvd_iff.mpr hc refine ⟨e.symm Q, ?_⟩ apply e.injective simpa [e] using hQ theorem degree_le_one_of_irreducible_locally_zero_on_hyperplane (P : MvPolynomial (Option κ) ℝ) (hP : Irreducible P) (a : κ → ℝ) (hzero : ∀ᶠ y in 𝓝 a, eval (fun j => j.elim 0 y) P = 0) : P.totalDegree ≤ 1 := by have hd := X_dvd_of_locally_zero_on_hyperplane P a hzero have hpX : P ∣ X (none : Option κ) := ((X_prime (R := ℝ) (i := (none : Option κ))).irreducible.associated_of_dvd hP hd).symm.dvd have hle := totalDegree_le_of_dvd_of_isDomain hpX (X_ne_zero (s := (none : Option κ))) simpa using hle end end Source29LocalHyperplaneDivisor /- Component: FlatPolynomialCurve.inc -/ namespace Source29FlatPolynomialCurve open MvPolynomial Filter open Source29RealPolynomialCurveJets Source29PolynomialCurvaturePotential open Source29QuarticReuse.QuarticMinimal.AmbientQuartic open Source29CurvatureProjection open scoped Topology BigOperators Matrix noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] theorem second_deriv_eval_curve_at (P : MvPolynomial κ ℝ) (γ : κ → ℝ → ℝ) (s : ℝ) (hγ : ∀ j, AnalyticAt ℝ (γ j) s) : deriv (deriv (fun t => eval (fun j => γ j t) P)) s = (∑ j, ∑ k, eval (fun a => γ a s) (pderiv k (pderiv j P)) * deriv (γ k) s * deriv (γ j) s) + ∑ j, eval (fun a => γ a s) (pderiv j P) * deriv (deriv (γ j)) s := by have he : deriv (fun t => eval (fun j => γ j t) P) =ᶠ[𝓝 s] (fun t => ∑ j, eval (fun k => γ k t) (pderiv j P) * deriv (γ j) t) := by have hn := Filter.eventually_all.mpr (fun j => (hγ j).eventually_analyticAt) filter_upwards [hn] with t ht exact first_deriv_eval_curve P γ t ht rw [he.deriv_eq] have hd := (HasDerivAt.fun_sum (fun j (_ : j ∈ Finset.univ) => ((analytic_eval_curve (pderiv j P) γ s hγ).differentiableAt.hasDerivAt.mul (hγ j).deriv.differentiableAt.hasDerivAt))).deriv simp only [Pi.mul_apply] at hd rw [hd] simp only [first_deriv_eval_curve _ γ s hγ, Finset.sum_add_distrib, Finset.sum_mul] theorem gradient_dot_acceleration_zero (P : MvPolynomial κ ℝ) (γ : κ → ℝ → ℝ) (s : ℝ) (hγ : ∀ j, AnalyticAt ℝ (γ j) s) (hzero : ∀ᶠ t in 𝓝 s, eval (fun j => γ j t) P = 0) (hreg : gradientAt P (fun j => γ j s) ≠ 0) (hflat : curvaturePotential P (fun j => γ j s) = 0) : ∑ j, eval (fun a => γ a s) (pderiv j P) * deriv (deriv (γ j)) s = 0 := by change (fun t => eval (fun j => γ j t) P) =ᶠ[𝓝 s] (fun _ => 0) at hzero let x : κ → ℝ := fun j => γ j s let v : κ → ℝ := fun j => deriv (γ j) s have hfirst : gradientAt P x ⬝ᵥ v = 0 := by have he := first_deriv_eval_curve P γ s hγ rw [hzero.deriv_eq, deriv_const] at he exact he.symm have hH : ∀ i j, realHessian P x i j = realHessian P x j i := by intro i j simp only [realHessian_apply] rw [Source29QuarticReuse.QuarticPolynomialBasics.second_partial_comm] have ht := tangent_contraction_zero (gradientAt P x) v v (realHessian P x) hH hreg hflat (by rwa [dotProduct_comm]) hfirst have hquadratic : (∑ j, ∑ k, eval x (pderiv k (pderiv j P)) * v k * v j) = 0 := by convert ht using 1 simp only [dotProduct, Matrix.mulVec, Finset.mul_sum, realHessian_apply] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ rw [Source29QuarticReuse.QuarticPolynomialBasics.second_partial_comm P i j] ring have he := second_deriv_eval_curve_at P γ s hγ rw [hzero.deriv.deriv_eq] at he simp only [deriv_const'] at he change 0 = (∑ j, ∑ k, eval x (pderiv k (pderiv j P)) * v k * v j) + _ at he rw [hquadratic, zero_add] at he exact he.symm theorem graph_normal_acceleration_zero (P : MvPolynomial (Option κ) ℝ) (γ : Option κ → ℝ → ℝ) (s : ℝ) (hγ : ∀ j, AnalyticAt ℝ (γ j) s) (hzero : ∀ᶠ t in 𝓝 s, eval (fun j => γ j t) P = 0) (hreg : eval (fun j => γ j s) (pderiv none P) ≠ 0) (hflat : curvaturePotential P (fun j => γ j s) = 0) (hlinear : ∀ i, deriv (deriv (γ (some i))) s = 0) : deriv (deriv (γ none)) s = 0 := by have hg : gradientAt P (fun j => γ j s) ≠ 0 := by intro hz exact hreg (congrFun hz none) have he := gradient_dot_acceleration_zero P γ s hγ hzero hg hflat simp only [Fintype.sum_option, hlinear, mul_zero, Finset.sum_const_zero, add_zero] at he exact (mul_eq_zero.mp he).resolve_left hreg end end Source29FlatPolynomialCurve /- Component: PolynomialHypersurfaceChart.inc -/ namespace Source29PolynomialHypersurfaceChart open MvPolynomial Filter Source29PolynomialLinkChart open Source29QuarticReuse.QuarticPolynomialBasics open scoped Topology BigOperators noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] def coordinatePolynomial (P : MvPolynomial (Option κ) ℝ) : Option κ → MvPolynomial (Option κ) ℝ | none => P | some i => X (some i) def coordinateMap (P : MvPolynomial (Option κ) ℝ) (x : Option κ → ℝ) : Option κ → ℝ := fun j => eval x (coordinatePolynomial P j) def zeroEmbed (y : κ → ℝ) : Option κ → ℝ := fun j => j.elim 0 y theorem zeroEmbed_analytic (y : κ → ℝ) : AnalyticAt ℝ zeroEmbed y := by apply AnalyticAt.pi intro j cases j with | none => exact analyticAt_const | some j => exact (ContinuousLinearMap.proj j : (κ → ℝ) →L[ℝ] ℝ).analyticAt y theorem exists_hypersurface_chart (P : MvPolynomial (Option κ) ℝ) (a : Option κ → ℝ) (g : ℝ) (hg : g ≠ 0) (hP : eval a P = 0) (hgn : eval a (pderiv none P) = g) (hgt : ∀ j, eval a (pderiv (some j) P) = 0) : ∃ φ : (κ → ℝ) → (Option κ → ℝ), AnalyticAt ℝ φ (fun j => a (some j)) ∧ φ (fun j => a (some j)) = a ∧ ∀ᶠ y in 𝓝 (fun j => a (some j)), eval (φ y) P = 0 ∧ ∀ j, φ y (some j) = y j := by let scale : Option κ → ℝ := fun j => j.elim g (fun _ => 1) have hscale : ∀ j, scale j ≠ 0 := by intro j cases j with | none => exact hg | some j => exact one_ne_zero let e := diagonalEquiv scale hscale have ha : AnalyticAt ℝ (coordinateMap P) a := AnalyticAt.pi (fun j => analyticAt_eval_real (coordinatePolynomial P j) a) have hd : HasStrictFDerivAt (coordinateMap P) (e : _ →L[ℝ] _) a := by apply hasStrictFDerivAt_pi'.mpr intro j change HasStrictFDerivAt (fun z => eval z (coordinatePolynomial P j)) _ _ convert hasStrictFDerivAt_eval (coordinatePolynomial P j) a using 1 ext v change e v j = evalFDeriv (coordinatePolynomial P j) a v rw [diagonalEquiv_apply] cases j with | none => simp [coordinatePolynomial, evalFDeriv_apply, Fintype.sum_option, hgn, hgt, scale] | some j => simp [coordinatePolynomial, evalFDeriv_X, scale] obtain ⟨u, hu, hua, hnear⟩ := Source29RealAnalyticInverse.exists_analytic_local_inverse (coordinateMap P) a e ha hd have hbase : coordinateMap P a = zeroEmbed (fun j => a (some j)) := by ext j cases j with | none => exact hP | some j => simp [coordinateMap, coordinatePolynomial, zeroEmbed] rw [hbase] at hu hua hnear refine ⟨fun y => u (zeroEmbed y), hu.comp (zeroEmbed_analytic _), hua, ?_⟩ have hn := (zeroEmbed_analytic (fun j => a (some j))).continuousAt.tendsto.eventually hnear filter_upwards [hn] with y hy refine ⟨congrFun hy none, ?_⟩ intro j simpa [coordinateMap, coordinatePolynomial, zeroEmbed] using congrFun hy (some j) end end Source29PolynomialHypersurfaceChart /- Component: AnalyticLocalConstancy.inc -/ namespace Source29AnalyticLocalConstancy open Filter open scoped Topology noncomputable section theorem eventually_eq_of_deriv_zero (f : ℝ → ℝ) (a : ℝ) (hf : AnalyticAt ℝ f a) (hd : ∀ᶠ t in 𝓝 a, deriv f t = 0) : f =ᶠ[𝓝 a] (fun _ => f a) := by obtain ⟨r, hr, hball⟩ := Metric.mem_nhds_iff.mp (hf.eventually_analyticAt.and hd) have ha : a ∈ Metric.ball a r := Metric.mem_ball_self hr filter_upwards [Metric.ball_mem_nhds a hr] with t ht exact Metric.isOpen_ball.is_const_of_deriv_eq_zero (convex_ball a r).isPreconnected (fun z hz => (hball hz).1.differentiableAt.differentiableWithinAt) (fun z hz => (hball hz).2) ht ha theorem eventually_eq_of_second_deriv_zero (f : ℝ → ℝ) (a : ℝ) (hf : AnalyticAt ℝ f a) (hd : deriv f a = 0) (hdd : ∀ᶠ t in 𝓝 a, deriv (deriv f) t = 0) : f =ᶠ[𝓝 a] (fun _ => f a) := by have hfirst := eventually_eq_of_deriv_zero (deriv f) a hf.deriv hdd simp only [hd] at hfirst exact eventually_eq_of_deriv_zero f a hf hfirst end end Source29AnalyticLocalConstancy /- Component: LocalFlatPolynomial.inc -/ namespace Source29LocalFlatPolynomial open MvPolynomial Filter Source29PolynomialCurvaturePotential open Source29PolynomialHypersurfaceChart open scoped Topology BigOperators noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] theorem degree_le_one_of_flat_near_normalized_zero (P : MvPolynomial (Option κ) ℝ) (hP : Irreducible P) (a : Option κ → ℝ) (ha : a none = 0) (hzero : eval a P = 0) (g : ℝ) (hg : g ≠ 0) (hgn : eval a (pderiv none P) = g) (hgt : ∀ j, eval a (pderiv (some j) P) = 0) (hflat : ∀ᶠ x in 𝓝 a, eval x P = 0 → curvaturePotential P x = 0) : P.totalDegree ≤ 1 := by obtain ⟨φ, hφ, hφ0, hchart⟩ := exists_hypersurface_chart P a g hg hzero hgn hgt have hhyper : ∀ y : κ → ℝ, eval (zeroEmbed y) P = 0 := by intro y let b : κ → ℝ := fun j => a (some j) let line : ℝ → (κ → ℝ) := fun t j => b j + t * (y j - b j) have hline (t : ℝ) : AnalyticAt ℝ line t := by apply AnalyticAt.pi intro j exact analyticAt_const.add (analyticAt_id.mul analyticAt_const) let Γ : ℝ → (Option κ → ℝ) := fun t => φ (line t) let γ : Option κ → ℝ → ℝ := fun j t => Γ t j have hΓ : AnalyticAt ℝ Γ 0 := by have hp : AnalyticAt ℝ φ (line 0) := by simpa [line, b] using hφ exact hp.comp (hline 0) have hΓ0 : Γ 0 = a := by simpa [Γ, line, b] using hφ0 have hγ : ∀ j, AnalyticAt ℝ (γ j) 0 := by intro j exact (ContinuousLinearMap.proj j : (Option κ → ℝ) →L[ℝ] ℝ).analyticAt _ |>.comp hΓ have hc : ∀ᶠ t in 𝓝 (0 : ℝ), eval (Γ t) P = 0 ∧ ∀ j, Γ t (some j) = line t j := by have hl : Tendsto line (𝓝 0) (𝓝 b) := by simpa [line] using (hline 0).continuousAt.tendsto exact hl.eventually hchart have hz : (fun t => eval (Γ t) P) =ᶠ[𝓝 (0 : ℝ)] (fun _ => 0) := hc.mono (fun _ h => h.1) have hflatΓ : ∀ᶠ t in 𝓝 (0 : ℝ), curvaturePotential P (Γ t) = 0 := by have hlim : Tendsto Γ (𝓝 0) (𝓝 a) := by simpa only [hΓ0] using hΓ.continuousAt.tendsto filter_upwards [hlim.eventually hflat, hc] with t ht he exact ht he.1 have hregΓ : ∀ᶠ t in 𝓝 (0 : ℝ), eval (Γ t) (pderiv none P) ≠ 0 := by have hp := (Source29PolynomialLinkChart.analyticAt_eval_real (pderiv none P) (Γ 0)).comp hΓ apply hp.continuousAt.eventually_ne simpa only [Function.comp_def, hΓ0, hgn] using hg have hlin : ∀ᶠ t in 𝓝 (0 : ℝ), ∀ j, deriv (deriv (γ (some j))) t = 0 := by apply Filter.eventually_all.mpr intro j have he : γ (some j) =ᶠ[𝓝 (0 : ℝ)] (fun t => line t j) := hc.mono (fun t ht => ht.2 j) have hd : deriv (fun t => line t j) = fun _ => y j - b j := by funext t simpa only [line, id_eq, one_mul] using (((hasDerivAt_id t).mul_const (y j - b j)).const_add (b j)).deriv filter_upwards [he.deriv.deriv] with t ht rw [ht, hd] simp have hsecond : ∀ᶠ t in 𝓝 (0 : ℝ), deriv (deriv (γ none)) t = 0 := by filter_upwards [Filter.eventually_all.mpr (fun j => (hγ j).eventually_analyticAt), hz.eventually_nhds, hflatΓ, hregΓ, hlin] with t ht hz' hf hr hl exact Source29FlatPolynomialCurve.graph_normal_acceleration_zero P γ t ht hz' hr hf hl have hfirst : deriv (γ none) 0 = 0 := by have he := Source29RealPolynomialCurveJets.first_deriv_eval_curve P γ 0 hγ have hpoint : (fun j => γ j 0) = a := hΓ0 change deriv (fun t => eval (Γ t) P) 0 = _ at he rw [hz.deriv_eq, deriv_const, hpoint] at he simp only [Fintype.sum_option, hgn, hgt, zero_mul, Finset.sum_const_zero, add_zero] at he exact (mul_eq_zero.mp he.symm).resolve_left hg have hnormal := Source29AnalyticLocalConstancy.eventually_eq_of_second_deriv_zero (γ none) 0 (hγ none) hfirst hsecond have hn0 : γ none 0 = 0 := (congrFun hΓ0 none).trans ha have heq : Γ =ᶠ[𝓝 (0 : ℝ)] (fun t => zeroEmbed (line t)) := by filter_upwards [hnormal, hc] with t ht hc' funext j cases j with | none => exact ht.trans hn0 | some j => exact hc'.2 j have hzline : (fun t => eval (zeroEmbed (line t)) P) =ᶠ[𝓝 (0 : ℝ)] (fun _ => 0) := by filter_upwards [heq, hz] with t ht hz' rw [← ht] exact hz' have han : AnalyticOnNhd ℝ (fun t => eval (zeroEmbed (line t)) P) Set.univ := by intro t _ exact (Source29PolynomialLinkChart.analyticAt_eval_real P _).comp ((zeroEmbed_analytic _).comp (hline t)) have hevery := han.eq_of_eventuallyEq (fun _ _ => analyticAt_const) hzline simpa [line] using congrFun hevery 1 exact Source29LocalHyperplaneDivisor.degree_le_one_of_irreducible_locally_zero_on_hyperplane P hP (fun j => a (some j)) (Filter.Eventually.of_forall hhyper) theorem exists_positive_curvature_in_nhds (P : MvPolynomial (Option κ) ℝ) (hP : Irreducible P) (hdeg : 2 ≤ P.totalDegree) (a : Option κ → ℝ) (ha : a none = 0) (hzero : eval a P = 0) (g : ℝ) (hg : g ≠ 0) (hgn : eval a (pderiv none P) = g) (hgt : ∀ j, eval a (pderiv (some j) P) = 0) (S : Set (Option κ → ℝ)) (hS : S ∈ 𝓝 a) : ∃ x ∈ S, eval x P = 0 ∧ gradientAt P x ≠ 0 ∧ 0 < curvaturePotential P x := by by_contra h push_neg at h have hreg : ∀ᶠ x in 𝓝 a, eval x (pderiv none P) ≠ 0 := (Source29PolynomialLinkChart.analyticAt_eval_real (pderiv none P) a).continuousAt.eventually_ne (by rwa [hgn]) have hflat : ∀ᶠ x in 𝓝 a, eval x P = 0 → curvaturePotential P x = 0 := by filter_upwards [hS, hreg] with x hx hr intro hz have hr' : gradientAt P x ≠ 0 := by intro he exact hr (congrFun he none) have hn : 0 ≤ curvaturePotential P x := by apply Source29CurvatureProjection.potential_nonneg _ _ _ hr' intro i j simp only [Source29QuarticReuse.QuarticMinimal.AmbientQuartic.realHessian_apply] rw [Source29QuarticReuse.QuarticPolynomialBasics.second_partial_comm] exact le_antisymm (h x hx hz hr') hn have hle := degree_le_one_of_flat_near_normalized_zero P hP a ha hzero g hg hgn hgt hflat omega end end Source29LocalFlatPolynomial /- Component: CurvatureScaling.inc -/ namespace Source29CurvatureScaling open MvPolynomial Source29CurvaturePotentialAlgebra Source29PolynomialCurvaturePotential open Source29QuarticReuse.QuarticCompatibility (homogeneous_pderiv) open Source29QuarticReuse.QuarticNormalization (eval_scale_of_isHomogeneous) open Source29QuarticReuse.QuarticMinimal.AmbientQuartic open scoped BigOperators Matrix noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] theorem vectorSq_smul (a : ℝ) (v : κ → ℝ) : vectorSq (a • v) = a^2 * vectorSq v := by simp only [vectorSq, smul_dotProduct, dotProduct_smul, smul_eq_mul] ring theorem potential_smul (a b : ℝ) (v : κ → ℝ) (H : Matrix κ κ ℝ) (ha : a ≠ 0) (hv : vectorSq v ≠ 0) : potential (a • v) (b • H) = (b/a)^2 * potential v H := by have hsq : matrixSq (b • H) = b^2 * matrixSq H := by simp only [matrixSq, Matrix.smul_apply, smul_eq_mul, mul_pow, Finset.mul_sum] have hmv : (b • H) *ᵥ (a • v) = (a*b) • (H *ᵥ v) := by simp only [Matrix.smul_mulVec, Matrix.mulVec_smul, smul_smul, mul_comm a b] have hdot : (a • v) ⬝ᵥ ((a*b) • (H *ᵥ v)) = a^2*b*(v ⬝ᵥ (H *ᵥ v)) := by simp only [smul_dotProduct, dotProduct_smul, smul_eq_mul] ring unfold potential rw [hsq, hmv, hdot, vectorSq_smul, vectorSq_smul] field_simp <;> ring theorem gradientAt_scale (P : MvPolynomial κ ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (x : κ → ℝ) (r : ℝ) : gradientAt P (r • x) = r^(d-1) • gradientAt P x := by ext i exact eval_scale_of_isHomogeneous (pderiv i P) (d-1) (homogeneous_pderiv hP) x r theorem realHessian_scale (P : MvPolynomial κ ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (x : κ → ℝ) (r : ℝ) : realHessian P (r • x) = r^(d-2) • realHessian P x := by ext i j have hh := homogeneous_pderiv (i := i) (homogeneous_pderiv (i := j) hP) have he := eval_scale_of_isHomogeneous (pderiv i (pderiv j P)) (d-2) (by simpa only [Nat.sub_sub] using hh) x r exact he theorem curvaturePotential_scale (P : MvPolynomial κ ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 2 ≤ d) (x : κ → ℝ) (hx : gradientAt P x ≠ 0) (r : ℝ) (hr : r ≠ 0) : curvaturePotential P (r • x) = curvaturePotential P x / r^2 := by unfold curvaturePotential rw [gradientAt_scale P d hP, realHessian_scale P d hP, potential_smul _ _ _ _ (pow_ne_zero _ hr) (Source29CurvatureProjection.vectorSq_pos _ hx).ne'] have he : r^(d-1) = r^(d-2)*r := by rw [← pow_succ] congr 1 omega rw [he] field_simp end end Source29CurvatureScaling /- Component: PolynomialLinkNonflatness.inc -/ namespace Source29PolynomialLinkNonflatness open MvPolynomial Source29PolynomialCurvaturePotential Source29PolynomialLinkChart open Source29QuarticReuse.QuarticMinimal open Source29QuarticReuse.QuarticNormalization (eval_scale_of_isHomogeneous) open scoped Topology BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def orthogonalPolynomialEquiv {κ : Type*} [Fintype κ] [DecidableEq κ] (U : Matrix κ κ ℝ) (hU : U * U.transpose = 1) (hUt : U.transpose * U = 1) : MvPolynomial κ ℝ ≃ₐ[ℝ] MvPolynomial κ ℝ := AlgEquiv.ofBijective (changeVariables U) ⟨changeVariables_injective U hU, by intro P refine ⟨changeVariables U.transpose P, ?_⟩ rw [changeVariables_comp, hUt, changeVariables_one]⟩ theorem exists_positive_curvature_on_link (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hirr : Irreducible P) (hd : 2 ≤ d) (hL : Source29FactorInheritance.cubicOperator P = 0) (x : Ambient ι) (hx : (∑ a, (x a)^2) = 1) (hz : eval x P = 0) (hreg : gradientAt P x ≠ 0) : ∃ y : Ambient ι, (eval y P = 0 ∧ (∑ a, (y a)^2) = 1) ∧ 0 < curvaturePotential P y := by obtain ⟨g, U, hg, hUt, hU, hbase, hQ, hLQ, hQzero, hgn, hgt⟩ := Source29PolynomialNormalFrame.exists_normalized_polynomial P d hP hL x hx hz hreg let Q := changeVariables U P have hiQ : Irreducible Q := (MulEquiv.irreducible_iff (orthogonalPolynomialEquiv U hU hUt)).mpr hirr have hdQ : 2 ≤ Q.totalDegree := by rw [hQ.totalDegree hiQ.ne_zero] exact hd have hS : {z : Ambient ι | z (some none) ≠ 0} ∈ 𝓝 (base : Ambient ι) := (continuous_apply (some none)).continuousAt.eventually_ne (by simp [base]) obtain ⟨z, hzcoord, hzQ, hzreg, hzK⟩ := Source29LocalFlatPolynomial.exists_positive_curvature_in_nhds Q hiQ hdQ base (by simp [base]) hQzero g hg.ne' hgn hgt _ hS have hzne : z ≠ 0 := by intro he exact hzcoord (congrFun he (some none)) let r := Source29AnalyticTensorNorm.tensorNorm z have hr : 0 < r := Source29AnalyticTensorNorm.tensorNorm_pos hzne have hrsq : r^2 = ∑ a, (z a)^2 := Source29AnalyticTensorNorm.tensorNorm_sq z let w := r⁻¹ • z have hwunit : (∑ a, (w a)^2) = 1 := by simp only [w, Pi.smul_apply, smul_eq_mul, mul_pow, ← Finset.mul_sum] rw [← hrsq] field_simp have hwzero : eval w Q = 0 := by change eval (fun i => r⁻¹ * z i) Q = 0 rw [eval_scale_of_isHomogeneous Q d hQ z r⁻¹, hzQ, mul_zero] have hwK : 0 < curvaturePotential Q w := by rw [Source29CurvatureScaling.curvaturePotential_scale Q d hQ hd z hzreg r⁻¹ (inv_ne_zero hr.ne')] exact div_pos hzK (sq_pos_of_pos (inv_pos.mpr hr)) refine ⟨U *ᵥ w, ⟨?_, ?_⟩, ?_⟩ · rwa [← eval_changeVariables] · have he := MatrixAlgebra.dot_transpose_mulVec U.transpose hUt w w have hww : w ⬝ᵥ w = 1 := by simpa only [dotProduct, pow_two] using hwunit simpa only [Matrix.transpose_transpose, dotProduct, ← pow_two] using he.trans hww · rwa [← curvaturePotential_changeVariables U hU] theorem exists_positive_curvature_on_link_fin8 (P : MvPolynomial (Fin 8) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hirr : Irreducible P) (hd : 2 ≤ d) (hL : Source29FactorInheritance.cubicOperator P = 0) (x : Fin 8 → ℝ) (hx : (∑ a, (x a)^2) = 1) (hz : eval x P = 0) (hreg : gradientAt P x ≠ 0) : ∃ y : Fin 8 → ℝ, (eval y P = 0 ∧ (∑ a, (y a)^2) = 1) ∧ 0 < curvaturePotential P y := by let e := Source29FinEightDegreeBound.eightLinkEquiv let Q := rename e P have hQ : Q.IsHomogeneous d := hP.rename_isHomogeneous have hiQ : Irreducible Q := (MulEquiv.irreducible_iff (renameEquiv ℝ e)).mpr hirr have hQL : Source29FactorInheritance.cubicOperator Q = 0 := by change Source29FactorInheritance.cubicOperator (rename e P) = 0 rw [Source29PolynomialReindex.cubicOperator_rename, hL, map_zero] have hx' : (∑ a, ((x ∘ e.symm) a)^2) = 1 := by change (∑ a, (x (e.symm a))^2) = 1 rw [e.symm.sum_comp (fun a => (x a)^2)] exact hx have hz' : eval (x ∘ e.symm) Q = 0 := by simpa only [Q, eval_rename, Function.comp_assoc, e.symm_comp_self, Function.comp_id] using hz have hr' : gradientAt Q (x ∘ e.symm) ≠ 0 := by apply Source29PolynomialReindex.gradientAt_rename_ne_zero e P (x ∘ e.symm) simpa only [Function.comp_assoc, e.symm_comp_self, Function.comp_id] using hreg obtain ⟨y, hy, hK⟩ := exists_positive_curvature_on_link Q d hQ hiQ hd hQL (x ∘ e.symm) hx' hz' hr' refine ⟨y ∘ e, ⟨?_, ?_⟩, ?_⟩ · simpa only [Q, eval_rename] using hy.1 · change (∑ a, (y (e a))^2) = 1 rw [e.sum_comp (fun a => (y a)^2)] exact hy.2 · simpa only [Q, Source29CurvatureReindex.curvaturePotential_rename] using hK end end Source29PolynomialLinkNonflatness /- Component: PuncturedIntermediateValue.inc -/ namespace Source29PuncturedIntermediateValue open scoped Topology noncomputable section theorem segment_ne_zero_of_unit_not_antipodal {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] (a b : E) (ha : ‖a‖ = 1) (hb : ‖b‖ = 1) (hab : b ≠ -a) (t : ℝ) (ht : t ∈ Set.Icc 0 1) : (1-t) • a + t • b ≠ 0 := by intro hz have he : (1-t) • a = -(t • b) := eq_neg_of_add_eq_zero_left hz have hn := congrArg norm he simp only [norm_smul, norm_neg, Real.norm_eq_abs, ha, hb, mul_one, abs_of_nonneg ht.1, abs_of_nonneg (sub_nonneg.mpr ht.2)] at hn have ht' : t = 1/2 := by linarith have hs : (1/2 : ℝ) • (a+b) = 0 := by rw [smul_add] simpa only [ht', show (1 : ℝ)-1/2 = 1/2 by norm_num] using hz have hab0 : a+b = 0 := (smul_eq_zero.mp hs).resolve_left (by norm_num) exact hab (eq_neg_of_add_eq_zero_right hab0) theorem exists_nonzero_zero_between_unit_points {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] (f : E → ℝ) (hf : Continuous f) (a b : E) (ha : ‖a‖ = 1) (hb : ‖b‖ = 1) (hab : b ≠ -a) (hfa : 0 < f a) (hfb : f b < 0) : ∃ x : E, x ≠ 0 ∧ f x = 0 := by let line : ℝ → E := fun t => (1-t) • a + t • b have hl : Continuous line := ((continuous_const.sub continuous_id).smul continuous_const).add (continuous_id.smul continuous_const) have hrange := intermediate_value_Icc' (by norm_num : (0 : ℝ) ≤ 1) (hf.comp hl).continuousOn have hm : (0 : ℝ) ∈ Set.Icc (f (line 1)) (f (line 0)) := by simpa only [line, sub_self, zero_smul, one_smul, zero_add, sub_zero, add_zero] using (show (0 : ℝ) ∈ Set.Icc (f b) (f a) from ⟨hfb.le, hfa.le⟩) obtain ⟨t, ht, hft⟩ := hrange hm exact ⟨line t, segment_ne_zero_of_unit_not_antipodal a b ha hb hab t ht, hft⟩ theorem unit_orthogonal_not_antipodal {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℝ E] (a b : E) (ha : ‖a‖ = 1) (hab : inner ℝ a b = 0) : b ≠ -a := by intro he rw [he, inner_neg_right, real_inner_self_eq_norm_sq, ha] at hab norm_num at hab theorem exists_perpendicular_unit (a : EuclideanSpace ℝ (Fin 8)) (ha : ‖a‖ = 1) : ∃ c : EuclideanSpace ℝ (Fin 8), ‖c‖ = 1 ∧ inner ℝ a c = 0 := by let u := Source29OrthogonalFrame.coordinateUnit (0 : Fin 8) let v := Source29OrthogonalFrame.coordinateUnit (1 : Fin 8) let R := (ℝ ∙ (u-a))ᗮ.reflection have hRu : R u = a := Submodule.reflection_sub ((Source29OrthogonalFrame.coordinateUnit_norm (0 : Fin 8)).trans ha.symm) refine ⟨R v, ?_, ?_⟩ · rw [R.norm_map] exact Source29OrthogonalFrame.coordinateUnit_norm (1 : Fin 8) · rw [← hRu, R.inner_map_map] norm_num [u, v, Source29OrthogonalFrame.coordinateUnit_inner] theorem exists_nonzero_zero_of_unit_sign_change (f : EuclideanSpace ℝ (Fin 8) → ℝ) (hf : Continuous f) (a b : EuclideanSpace ℝ (Fin 8)) (ha : ‖a‖ = 1) (hb : ‖b‖ = 1) (hfa : 0 < f a) (hfb : f b < 0) : ∃ x : EuclideanSpace ℝ (Fin 8), x ≠ 0 ∧ f x = 0 := by by_cases hab : b = -a · obtain ⟨c, hc, hac⟩ := exists_perpendicular_unit a ha rcases lt_trichotomy (f c) 0 with hneg | hzero | hpos · exact exists_nonzero_zero_between_unit_points f hf a c ha hc (unit_orthogonal_not_antipodal a c ha hac) hfa hneg · exact ⟨c, by intro he; simp [he] at hc, hzero⟩ · have hcb : inner ℝ c b = 0 := by rw [hab, inner_neg_right, real_inner_comm, hac, neg_zero] exact exists_nonzero_zero_between_unit_points f hf c b hc hb (unit_orthogonal_not_antipodal c b hc hcb) hpos hfb · exact exists_nonzero_zero_between_unit_points f hf a b ha hb hab hfa hfb end end Source29PuncturedIntermediateValue /- Component: HomogeneousRealZero.inc -/ namespace Source29HomogeneousRealZero open MvPolynomial Source29QuarticReuse.QuarticNormalization open scoped BigOperators noncomputable section theorem exists_unit_zero_of_sign_change (P : MvPolynomial (Fin 8) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 1 ≤ d) (hpos : ∃ x, 0 < eval x P) (hneg : ∃ x, eval x P < 0) : ∃ x, eval x P = 0 ∧ (∑ a, (x a)^2) = 1 := by obtain ⟨xp, hxp⟩ := hpos obtain ⟨xn, hxn⟩ := hneg have hPs : P.IsHomogeneous ((d-1)+1) := by convert hP using 1 omega obtain ⟨a, ha, hpa⟩ := exists_positive_sphere_value P (d-1) hPs xp hxp obtain ⟨b, hb, hnb⟩ := exists_positive_sphere_value (-P) (d-1) hPs.neg xn (by simpa only [map_neg] using neg_pos.mpr hxn) have hpb : eval b P < 0 := by simpa only [map_neg, neg_pos] using hnb let f : EuclideanSpace ℝ (Fin 8) → ℝ := fun x => eval (fun i => x i) P have hf : Continuous f := (Source29CompactPolynomialLink.continuous_eval P).comp (show Continuous (fun x : EuclideanSpace ℝ (Fin 8) => fun i => x i) by fun_prop) have hnorm (v : Fin 8 → ℝ) (hv : (∑ i, (v i)^2) = 1) : ‖(WithLp.toLp 2 v : EuclideanSpace ℝ (Fin 8))‖ = 1 := by have he : ‖(WithLp.toLp 2 v : EuclideanSpace ℝ (Fin 8))‖^2 = 1 := by simpa only [EuclideanSpace.real_norm_sq_eq] using hv nlinarith [norm_nonneg (WithLp.toLp 2 v : EuclideanSpace ℝ (Fin 8))] obtain ⟨z, hz, hpz⟩ := Source29PuncturedIntermediateValue.exists_nonzero_zero_of_unit_sign_change f hf (WithLp.toLp 2 a) (WithLp.toLp 2 b) (hnorm a ha) (hnorm b hb) hpa hpb let v : Fin 8 → ℝ := fun i => z i have hv : v ≠ 0 := by intro he apply hz ext i exact congrFun he i let r := Source29AnalyticTensorNorm.tensorNorm v have hr : 0 < r := Source29AnalyticTensorNorm.tensorNorm_pos hv have hrsq : r^2 = ∑ i, (v i)^2 := Source29AnalyticTensorNorm.tensorNorm_sq v refine ⟨fun i => r⁻¹ * v i, ?_, ?_⟩ · rw [eval_scale_of_isHomogeneous P d hP v r⁻¹] change r⁻¹ ^ d * f z = 0 rw [hpz, mul_zero] · simp only [mul_pow, ← Finset.mul_sum, ← hrsq] field_simp end end Source29HomogeneousRealZero /- Component: RealLeadingFactor.inc -/ namespace Source29RealLeadingFactor open MvPolynomial Source29FactorInheritance noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] theorem exists_irreducible_sign_changing_divisor (F : MvPolynomial κ ℝ) (a b : κ → ℝ) (hF : eval a F * eval b F < 0) : ∃ p : MvPolynomial κ ℝ, Irreducible p ∧ p ∣ F ∧ eval a p * eval b p < 0 := by induction F using WfDvdMonoid.induction_on_irreducible with | zero => simp at hF | unit u hu => have hd : u.totalDegree = 0 := by have he := totalDegree_le_of_dvd_of_isDomain (hu.dvd : u ∣ (1 : MvPolynomial κ ℝ)) (one_ne_zero : (1 : MvPolynomial κ ℝ) ≠ 0) simpa using he have hc := totalDegree_eq_zero_iff_eq_C.mp hd rw [hc, eval_C, eval_C] at hF exact (not_lt_of_ge (mul_self_nonneg (u.coeff 0)) hF).elim | mul q p hq hp ih => by_cases hps : eval a p * eval b p < 0 · exact ⟨p, hp, dvd_mul_right p q, hps⟩ · have hqs : eval a q * eval b q < 0 := by by_contra hqs have hn := mul_nonneg (le_of_not_gt hps) (le_of_not_gt hqs) have he : eval a (p*q) * eval b (p*q) = (eval a p * eval b p) * (eval a q * eval b q) := by simp only [map_mul] ring rw [he] at hF exact (not_lt_of_ge hn hF) obtain ⟨r, hr, hrd, hrs⟩ := ih hqs exact ⟨r, hr, dvd_mul_of_dvd_right hrd p, hrs⟩ theorem real_factor_inheritance (p Q : MvPolynomial κ ℝ) (k : ℕ) (hk : 1 ≤ k) (hp : Irreducible p) (hQ : ¬p ∣ Q) (hF : cubicOperator (p^k*Q) = 0) : p ∣ cubicOperator p := by obtain ⟨r, hr⟩ := scaled_cubicOperator_pow_mul p Q k have hz : (p^k)^3*p*((k : MvPolynomial κ ℝ)^3*Q^3*cubicOperator p+p*r) = 0 := by rw [← hr, hF, mul_zero] have hnz : (p^k)^3*p ≠ 0 := mul_ne_zero (pow_ne_zero _ (pow_ne_zero _ hp.ne_zero)) hp.ne_zero have hb := (mul_eq_zero.mp hz).resolve_left hnz have hd : p ∣ (k : MvPolynomial κ ℝ)^3*Q^3*cubicOperator p := by refine ⟨-r, ?_⟩ linear_combination hb have hu : IsUnit (k : MvPolynomial κ ℝ) := by have hu' : IsUnit (k : ℝ) := isUnit_iff_ne_zero.mpr (Nat.cast_ne_zero.mpr (by omega)) simpa using hu'.map (C : ℝ →+* MvPolynomial κ ℝ) rcases hp.prime.dvd_or_dvd hd with hleft | hright · rcases hp.prime.dvd_or_dvd hleft with hnat | hpow · exact (hp.not_dvd_isUnit (hu.pow 3) hnat).elim · exact (hQ (hp.prime.dvd_of_dvd_pow hpow)).elim · exact hright theorem exists_sign_changing_homogeneous_factor (F : MvPolynomial κ ℝ) (d : ℕ) (hhom : F.IsHomogeneous d) (hL : cubicOperator F = 0) (hpos : ∃ a, 0 < eval a F) (hneg : ∃ b, eval b F < 0) : ∃ (p Q : MvPolynomial κ ℝ) (k : ℕ), 1 ≤ k ∧ Irreducible p ∧ p.IsHomogeneous p.totalDegree ∧ Q.IsHomogeneous Q.totalDegree ∧ F = p^k*Q ∧ ¬p ∣ Q ∧ (∃ a, 0 < eval a p) ∧ (∃ b, eval b p < 0) ∧ p ∣ cubicOperator p := by obtain ⟨a, ha⟩ := hpos obtain ⟨b, hb⟩ := hneg have hF : F ≠ 0 := by intro hz; simp [hz] at ha obtain ⟨p, hp, hpF, hab⟩ := exists_irreducible_sign_changing_divisor F a b (mul_neg_of_pos_of_neg ha hb) have hf : FiniteMultiplicity p F := FiniteMultiplicity.of_not_isUnit hp.not_isUnit hF obtain ⟨Q, hfactor, hnot⟩ := hf.exists_eq_pow_mul_and_not_dvd have hk : 1 ≤ multiplicity p F := by have hne := (multiplicity_ne_zero hf).mpr hpF omega have hpH := Source29HomogeneousFactor.divisor_isHomogeneous F p hF hhom hpF have hQH := Source29HomogeneousFactor.divisor_isHomogeneous F Q hF hhom (show Q ∣ F from ⟨p^(multiplicity p F), hfactor.trans (mul_comm _ _)⟩) have hpL := real_factor_inheritance p Q (multiplicity p F) hk hp hnot (by rwa [← hfactor]) have hsign : (∃ a, 0 < eval a p) ∧ (∃ b, eval b p < 0) := by rcases mul_neg_iff.mp hab with h | h · exact ⟨⟨a, h.1⟩, ⟨b, h.2⟩⟩ · exact ⟨⟨b, h.2⟩, ⟨a, h.1⟩⟩ exact ⟨p, Q, multiplicity p F, hk, hp, hpH, hQH, hfactor, hnot, hsign.1, hsign.2, hpL⟩ theorem minimal_graph_leading_factor (P : MvPolynomial (Fin 8) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) : ∃ (p Q : MvPolynomial (Fin 8) ℝ) (k : ℕ), 1 ≤ k ∧ Irreducible p ∧ p.IsHomogeneous p.totalDegree ∧ Q.IsHomogeneous Q.totalDegree ∧ homogeneousComponent P.totalDegree P = p^k*Q ∧ ¬p ∣ Q ∧ (∃ a, 0 < eval a p) ∧ (∃ b, eval b p < 0) ∧ p ∣ cubicOperator p := by obtain ⟨hne, hhom, hL⟩ := QuarticPolynomialBasics.leading_component_data P hmin hdeg obtain ⟨hneg, hpos⟩ := Source29QuarticReuse.FluxPolynomial.top_changes_sign P hmin hdeg exact exists_sign_changing_homogeneous_factor _ P.totalDegree hhom hL hpos hneg end end Source29RealLeadingFactor /- Component: PositiveResidualSign.inc -/ namespace Source29PositiveResidualSign open MvPolynomial Source29QuarticReuse.QuarticNormalization noncomputable section variable {κ : Type*} [Fintype κ] [DecidableEq κ] theorem factor_changes_sign_of_positive_residual (F p Q : MvPolynomial κ ℝ) (d k : ℕ) (hhom : F.IsHomogeneous d) (hd : 1 ≤ d) (hfactor : F = p^k*Q) (hQ : ∀ x : κ → ℝ, x ≠ 0 → 0 < eval x Q) (hpos : ∃ x, 0 < eval x F) (hneg : ∃ x, eval x F < 0) : Odd k ∧ (∃ x, 0 < eval x p) ∧ (∃ x, eval x p < 0) := by have hF0 : eval (0 : κ → ℝ) F = 0 := by have he := eval_scale_of_isHomogeneous F d hhom (0 : κ → ℝ) 0 simpa only [zero_mul, zero_pow (by omega : d ≠ 0), Pi.zero_def] using he obtain ⟨a, ha⟩ := hpos obtain ⟨b, hb⟩ := hneg have ha0 : a ≠ 0 := by intro he; rw [he, hF0] at ha; exact (lt_irrefl _ ha) have hb0 : b ≠ 0 := by intro he; rw [he, hF0] at hb; exact (lt_irrefl _ hb) have hap : 0 < (eval a p)^k := by rw [hfactor, map_mul, map_pow] at ha exact (mul_pos_iff_of_pos_right (hQ a ha0)).mp ha have hbp : (eval b p)^k < 0 := by rw [hfactor, map_mul, map_pow] at hb by_contra h exact (not_lt_of_ge (mul_nonneg (le_of_not_gt h) (hQ b hb0).le) hb) have hk : Odd k := by rcases Nat.even_or_odd k with he | ho · exact (not_lt_of_ge (he.pow_nonneg (eval b p)) hbp).elim · exact ho exact ⟨hk, ⟨a, hk.pow_pos_iff.mp hap⟩, ⟨b, hk.pow_neg_iff.mp hbp⟩⟩ theorem minimal_graph_factor_changes_sign (P p Q : MvPolynomial (Fin 8) ℝ) (k : ℕ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (hfactor : homogeneousComponent P.totalDegree P = p^k*Q) (hQ : Source29Closing.PositiveAwayFromZero Q) : Odd k ∧ (∃ x, 0 < eval x p) ∧ (∃ x, eval x p < 0) := by obtain ⟨hneg, hpos⟩ := Source29QuarticReuse.FluxPolynomial.top_changes_sign P hmin hdeg exact factor_changes_sign_of_positive_residual _ p Q P.totalDegree k (homogeneousComponent_isHomogeneous _ _) (by omega) hfactor hQ hpos hneg end end Source29PositiveResidualSign /- Component: NonlinearStructureReduction.inc -/ namespace Source29NonlinearStructureReduction open MvPolynomial Source29Closing Source29PolynomialCurvaturePotential open Source29RegularStructureReduction open scoped BigOperators noncomputable section /-- The remaining structural data. Sign change, a real unit zero, and nonflatness are derived from these hypotheses and the full equation. -/ def NonlinearRegularLeadingFactorData8 (P : Polynomial8) : Prop := ∃ (p Q : Polynomial8) (k : ℕ), 1 ≤ k ∧ Irreducible p ∧ p.IsHomogeneous p.totalDegree ∧ Q.IsHomogeneous Q.totalDegree ∧ homogeneousComponent P.totalDegree P = p^k*Q ∧ PositiveAwayFromZero Q ∧ (∀ x, eval x p = 0 ∧ (∑ a, (x a)^2) = 1 → gradientAt p x ≠ 0) ∧ 2 ≤ p.totalDegree theorem regular_data_of_nonlinear_data (P : Polynomial8) (hminimal : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdegree : 2 ≤ P.totalDegree) (hdata : NonlinearRegularLeadingFactorData8 P) : RegularLeadingFactorData8 P := by obtain ⟨p, Q, k, hk, hp, hphom, hQhom, hfactor, hQpos, hregular, hpdegree⟩ := hdata obtain ⟨hkodd, hpos, hneg⟩ := Source29PositiveResidualSign.minimal_graph_factor_changes_sign P p Q k hminimal hdegree hfactor hQpos obtain ⟨x, hx⟩ := Source29HomogeneousRealZero.exists_unit_zero_of_sign_change p p.totalDegree hphom (by omega) hpos hneg obtain ⟨hne, hhom, hL⟩ := QuarticPolynomialBasics.leading_component_data P hminimal hdegree have hQdiv : Q ∣ homogeneousComponent P.totalDegree P := ⟨p^k, hfactor.trans (mul_comm _ _)⟩ have hQdegree := Source29ComplexObstruction.positive_divisor_obstruction (homogeneousComponent P.totalDegree P) Q P.totalDegree hne hhom hL hQhom hQpos hQdiv have hQconst : Q = C (Q.coeff 0) := totalDegree_eq_zero_iff_eq_C.mp hQdegree have ha : Q.coeff 0 ≠ 0 := by intro hz apply hne rw [hfactor, hQconst, hz, map_zero, mul_zero] have hpL : Source29FactorInheritance.cubicOperator p = 0 := by apply Source29PowerOperator.cubicOperator_pow_mul_C_zero_imp p hp.ne_zero k (by omega) (Q.coeff 0) ha change QuarticPolynomialBasics.cubicOperator (p^k*C (Q.coeff 0)) = 0 rw [← hQconst, ← hfactor] exact hL have hnonflat := Source29PolynomialLinkNonflatness.exists_positive_curvature_on_link_fin8 p p.totalDegree hphom hp hpdegree hpL x hx.2 hx.1 (hregular x hx) exact ⟨p, Q, k, hk, hp, hphom, hQhom, hfactor, hQpos, hpos, hneg, hregular, hnonflat⟩ theorem problem29_of_nonlinear_regular_leading_factor (hstructure : ∀ P : Polynomial8, Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → NonlinearRegularLeadingFactorData8 P) : Math30.Problem29 := by apply problem29_of_regular_leading_factor intro P hminimal hdegree exact regular_data_of_nonlinear_data P hminimal hdegree (hstructure P hminimal hdegree) end end Source29NonlinearStructureReduction /- Component: WeakCalibrationLimits.inc -/ namespace Source29WeakCalibrationLimits open MeasureTheory MeasureTheory.Measure Filter MvPolynomial open Source29QuarticReuse Source29QuarticReuse.FluxObstruction open Source29QuarticReuse.FluxPolynomial open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- A bounded field whose pairing with every test gradient vanishes. -/ def WeakCalibration (F : (Fin n → ℝ) → Fin n → ℝ) : Prop := (∀ x i, ‖F x i‖ ≤ 1) ∧ ∀ φ : (Fin n → ℝ) → ℝ, ContDiff ℝ 1 φ → HasCompactSupport φ → Integrable (testFlux (fun i ↦ Pi.single i 1) φ F) ∧ (∫ x, testFlux (fun i ↦ Pi.single i 1) φ F x) = 0 /-- The weak identity is closed under almost-everywhere limits with the same bound. -/ theorem weakCalibration_limit {F : ℕ → (Fin n → ℝ) → Fin n → ℝ} {G : (Fin n → ℝ) → Fin n → ℝ} (hF : ∀ k, WeakCalibration (F k)) (hG : ∀ x i, ‖G x i‖ ≤ 1) (hlim : ∀ᵐ x, ∀ i, Tendsto (fun k ↦ F k x i) atTop (𝓝 (G x i))) : WeakCalibration G := by refine ⟨hG, ?_⟩ intro φ hφ hcφ let v : Fin n → Fin n → ℝ := fun i ↦ Pi.single i 1 have hl : ∀ᵐ x, Tendsto (fun k ↦ testFlux v φ (F k) x) atTop (𝓝 (testFlux v φ G x)) := by filter_upwards [hlim] with x hx exact testFlux_tendsto v φ hx have hm : ∀ k, AEStronglyMeasurable (testFlux v φ (F k)) := fun k ↦ ((hF k).2 φ hφ hcφ).1.aestronglyMeasurable have hi : Integrable (testFlux v φ G) := by apply (testBound_integrable v hφ hcφ).mono' (aestronglyMeasurable_of_tendsto_ae atTop hm hl) exact Filter.Eventually.of_forall fun x ↦ norm_testFlux_le_testBound v φ G x (hG x) refine ⟨hi, ?_⟩ have ht : Tendsto (fun k ↦ ∫ x, testFlux v φ (F k) x) atTop (𝓝 (∫ x, testFlux v φ G x)) := by apply tendsto_integral_of_dominated_convergence (testBound v φ) hm (testBound_integrable v hφ hcφ) · exact fun k ↦ Filter.Eventually.of_forall fun x ↦ norm_testFlux_le_testBound v φ (F k) x ((hF k).1 x) · exact hl have hz : (fun k ↦ ∫ x, testFlux v φ (F k) x) = fun _ ↦ 0 := by funext k exact ((hF k).2 φ hφ hcφ).2 rw [hz] at ht exact tendsto_nhds_unique ht tendsto_const_nhds theorem leadingNormalizedField_bound (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) (i : Fin n) : ‖leadingNormalizedField P x i‖ ≤ 1 := by unfold leadingNormalizedField rw [norm_div, Real.norm_eq_abs, Real.norm_eq_abs, abs_of_nonneg (Real.sqrt_nonneg _)] by_cases hg : evaluatedGradient P x = 0 · simp [hg, radiusSq] · have hs := radiusSq_pos_of_ne_zero hg apply (div_le_one (Real.sqrt_pos.mpr hs)).2 have hi : (evaluatedGradient P x i)^2 ≤ radiusSq (evaluatedGradient P x) := Finset.single_le_sum (fun j _ ↦ sq_nonneg (evaluatedGradient P x j)) (Finset.mem_univ i) exact Real.abs_le_sqrt hi /-- Translations and scalar dilations preserve the classical divergence equation. -/ theorem divergence_affine {F : (Fin n → ℝ) → Fin n → ℝ} (hF : ∀ i, ContDiff ℝ 1 (fun x ↦ F x i)) (a : Fin n → ℝ) (r : ℝ) (x : Fin n → ℝ) : divergence (fun i ↦ Pi.single i 1) (fun y ↦ F (a + r • y)) x = r * divergence (fun i ↦ Pi.single i 1) F (a + r • x) := by unfold divergence rw [Finset.mul_sum] apply Finset.sum_congr rfl intro i _ have hd := (((hF i).differentiable (by norm_num) (a + r • x)).hasFDerivAt).comp x (((hasFDerivAt_id x).const_smul r).const_add a) have he := congrArg (fun L : (Fin n → ℝ) →L[ℝ] ℝ ↦ L (Pi.single i 1)) hd.fderiv simpa only [Function.comp_def, ContinuousLinearMap.comp_apply, _root_.smul_apply, ContinuousLinearMap.id_apply, map_smul, smul_eq_mul, Pi.smul_apply, id_eq] using he /-- Every affine rescaling of the leading normalized gradient retains its weak identity. -/ theorem top_affine_weakCalibration (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (a : Fin n → ℝ) (r : ℝ) (hr : r ≠ 0) : WeakCalibration (fun x ↦ leadingNormalizedField (homogeneousComponent P.totalDegree P) (a + r • x)) := by refine ⟨fun x i ↦ leadingNormalizedField_bound _ _ _, ?_⟩ intro φ hφ hcφ have hg : ∀ i, ContDiff ℝ 1 (fun x ↦ evaluatedGradient P x i) := fun i ↦ contDiff_eval (pderiv i P) have hn := normalizedField_contDiff hg let F : ℕ → (Fin n → ℝ) → Fin n → ℝ := fun k x ↦ normalizedField (evaluatedGradient P) (dilationRadius k • (a + r • x)) have hF : ∀ k i, ContDiff ℝ 1 (fun x ↦ F k x i) := by intro k i exact (hn i).comp (by fun_prop) have hdiv : ∀ k x, divergence (fun i ↦ Pi.single i 1) (F k) x = 0 := by intro k x have hd : ∀ i, ContDiff ℝ 1 (fun y ↦ normalizedField (evaluatedGradient P) (dilationRadius k • y) i) := by intro i exact (hn i).comp (by fun_prop) change divergence (fun i ↦ Pi.single i 1) (fun y ↦ (fun z ↦ normalizedField (evaluatedGradient P) (dilationRadius k • z)) (a + r • y)) x = 0 rw [divergence_affine hd, divergence_dilate _ hn, Source29GraphCalibration.polynomial_normalizedGradient_divergence_zero P hmin] ring have hb : ∀ k x i, ‖F k x i‖ ≤ 1 := fun k x i ↦ normalizedField_norm_le_one _ _ _ have hq : QuasiMeasurePreserving (fun x : Fin n → ℝ ↦ a + r • x) volume volume := (quasiMeasurePreserving_add_left volume a).comp (quasiMeasurePreserving_smul volume hr) have hl := hq.ae (Source29TopWeakCalibration.normalizedGradient_dilates_tendsto_ae P hdeg) exact ⟨testFlux_limit_integrable _ hφ hcφ (fun k i ↦ (hF k i).continuous) hb hl, integral_testFlux_limit_eq_zero _ hφ hcφ hF hdiv hb hl⟩ end end Source29WeakCalibrationLimits /- Component: RealLowestRescale.inc -/ /- A polynomial rescaling at its first homogeneous component. The rescaled family is defined without division, so it is continuous even at parameter zero. -/ namespace Source29RealLowestRescale open MvPolynomial Finset open scoped Topology noncomputable section def rescale {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (s : ℕ) (t : ℝ) : MvPolynomial (Fin n) ℝ := ∑ k ∈ range (P.totalDegree + 1), C (t ^ (k - s)) * homogeneousComponent k P theorem totalDegree_rescale_le {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (s : ℕ) (t : ℝ) : (rescale P s t).totalDegree ≤ P.totalDegree := by apply totalDegree_finsetSum_le intro k hk have hcomp := (homogeneousComponent_isHomogeneous k P).totalDegree_le calc (C (t ^ (k - s)) * homogeneousComponent k P).totalDegree ≤ (C (t ^ (k - s)) : MvPolynomial (Fin n) ℝ).totalDegree + (homogeneousComponent k P).totalDegree := totalDegree_mul _ _ _ ≤ P.totalDegree := by rw [totalDegree_C, zero_add] exact le_trans hcomp (Nat.le_of_lt_succ (mem_range.mp hk)) theorem rescale_zero {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (s : ℕ) (hlow : ∀ k < s, homogeneousComponent k P = 0) : rescale P s 0 = homogeneousComponent s P := by unfold rescale rw [Finset.sum_eq_single s] · simp · intro k hk hks by_cases hlt : k < s · simp [hlow k hlt] · have hpos : 0 < k - s := by omega simp [zero_pow hpos.ne'] · intro hnot have hs : P.totalDegree < s := by simp only [mem_range, not_lt] at hnot omega simp [homogeneousComponent_eq_zero s P hs] /-- Evaluating the rescaled family recovers the original polynomial under a scalar dilation, with the lowest power removed. The equality holds at zero too. -/ theorem eval_rescale_mul {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (s : ℕ) (hlow : ∀ k < s, homogeneousComponent k P = 0) (t : ℝ) (y : Fin n → ℝ) : t ^ s * eval y (rescale P s t) = eval (fun i => t * y i) P := by calc t ^ s * eval y (rescale P s t) = ∑ k ∈ range (P.totalDegree + 1), t ^ s * (t ^ (k - s) * eval y (homogeneousComponent k P)) := by simp only [rescale, map_sum, map_mul, eval_C, Finset.mul_sum] _ = ∑ k ∈ range (P.totalDegree + 1), t ^ k * eval y (homogeneousComponent k P) := by apply Finset.sum_congr rfl intro k hk by_cases hlt : k < s · simp [hlow k hlt] · rw [← mul_assoc, ← pow_add, Nat.add_sub_of_le (Nat.le_of_not_gt hlt)] _ = eval (fun i => t * y i) P := by conv_rhs => rw [← sum_homogeneousComponent P] simp only [map_sum] apply Finset.sum_congr rfl intro k hk exact (Source29QuarticReuse.QuarticNormalization.eval_scale_of_isHomogeneous _ k (homogeneousComponent_isHomogeneous k P) y t).symm theorem continuous_eval_rescale {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (s : ℕ) (y : Fin n → ℝ) : Continuous (fun t : ℝ => eval y (rescale P s t)) := by simp only [rescale, map_sum, map_mul, eval_C] apply continuous_finsetSum intro k hk exact (continuous_id.pow (k - s)).mul continuous_const end end Source29RealLowestRescale /- Component: InitialGradientLimit.inc -/ namespace Source29InitialGradientLimit open MeasureTheory Filter MvPolynomial open Source29QuarticReuse Source29QuarticReuse.FluxObstruction open Source29QuarticReuse.QuarticPolynomialBasics open Source29RealLowestRescale open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem pderiv_lowest_components (P : MvPolynomial (Fin n) ℝ) (s : ℕ) (hlow : ∀ k < s + 1, homogeneousComponent k P = 0) (i : Fin n) : ∀ k < s, homogeneousComponent k (pderiv i P) = 0 := by intro k hk rw [← pderiv_homogeneousComponent, hlow (k + 1) (by omega), map_zero] /-- Dividing a gradient by its lowest dilation power leaves a family continuous at zero. -/ theorem rescaled_gradient_tendsto (P : MvPolynomial (Fin n) ℝ) (s : ℕ) (hlow : ∀ k < s + 1, homogeneousComponent k P = 0) (x : Fin n → ℝ) (i : Fin n) : Tendsto (fun t : ℝ ↦ eval x (rescale (pderiv i P) s t)) (𝓝 0) (𝓝 (evaluatedGradient (homogeneousComponent (s + 1) P) x i)) := by have hc := (continuous_eval_rescale (pderiv i P) s x).tendsto 0 rw [rescale_zero _ _ (pderiv_lowest_components P s hlow i)] at hc simpa only [evaluatedGradient, pderiv_homogeneousComponent] using hc theorem normalized_ratio_pos_scale (v : Fin n → ℝ) {a : ℝ} (ha : 0 < a) (i : Fin n) : (a * v i) / Real.sqrt (radiusSq (a • v)) = v i / Real.sqrt (radiusSq v) := by have he : radiusSq (a • v) = a ^ 2 * radiusSq v := by simp only [radiusSq, Pi.smul_apply, smul_eq_mul, mul_pow, Finset.mul_sum] rw [he, Real.sqrt_mul (sq_nonneg a), Real.sqrt_sq_eq_abs, abs_of_pos ha] exact mul_div_mul_left _ _ ha.ne' /-- Normalized gradients converge to that of the first homogeneous component, where the latter gradient is nonzero. -/ theorem normalized_gradient_initial_limit (P : MvPolynomial (Fin n) ℝ) (s : ℕ) (hlow : ∀ k < s + 1, homogeneousComponent k P = 0) {t : ℕ → ℝ} (ht : ∀ k, 0 < t k) (ht0 : Tendsto t atTop (𝓝 0)) (x : Fin n → ℝ) (hx : evaluatedGradient (homogeneousComponent (s + 1) P) x ≠ 0) (i : Fin n) : Tendsto (fun k ↦ leadingNormalizedField P (t k • x) i) atTop (𝓝 (leadingNormalizedField (homogeneousComponent (s + 1) P) x i)) := by let g : ℕ → Fin n → ℝ := fun k j ↦ eval x (rescale (pderiv j P) s (t k)) have hg : ∀ j, Tendsto (fun k ↦ g k j) atTop (𝓝 (evaluatedGradient (homogeneousComponent (s + 1) P) x j)) := fun j ↦ (rescaled_gradient_tendsto P s hlow x j).comp ht0 have hs : Tendsto (fun k ↦ radiusSq (g k)) atTop (𝓝 (radiusSq (evaluatedGradient (homogeneousComponent (s + 1) P) x))) := by exact tendsto_finsetSum _ (fun j _ ↦ (hg j).pow 2) have hd := hs.sqrt have hdn : Real.sqrt (radiusSq (evaluatedGradient (homogeneousComponent (s + 1) P) x)) ≠ 0 := (Real.sqrt_pos.mpr (radiusSq_pos_of_ne_zero hx)).ne' have hl := (hg i).div hd hdn have he : ∀ k, leadingNormalizedField P (t k • x) i = g k i / Real.sqrt (radiusSq (g k)) := by intro k have hgrad : evaluatedGradient P (t k • x) = t k ^ s • g k := by funext j exact (eval_rescale_mul (pderiv j P) s (pderiv_lowest_components P s hlow j) (t k) x).symm simp only [leadingNormalizedField, hgrad, Pi.smul_apply, smul_eq_mul] exact normalized_ratio_pos_scale (g k) (pow_pos (ht k) s) i have hf : (fun k ↦ leadingNormalizedField P (t k • x) i) = (fun k ↦ g k i / Real.sqrt (radiusSq (g k))) := funext he rw [hf] exact hl theorem normalized_gradient_initial_limit_ae (P : MvPolynomial (Fin n) ℝ) (s : ℕ) (hlow : ∀ k < s + 1, homogeneousComponent k P = 0) (hne : homogeneousComponent (s + 1) P ≠ 0) {t : ℕ → ℝ} (ht : ∀ k, 0 < t k) (ht0 : Tendsto t atTop (𝓝 0)) : ∀ᵐ x, ∀ i, Tendsto (fun k ↦ leadingNormalizedField P (t k • x) i) atTop (𝓝 (leadingNormalizedField (homogeneousComponent (s + 1) P) x i)) := by filter_upwards [mvPolynomial_eval_ne_zero_ae n _ hne] with x hx apply normalized_gradient_initial_limit P s hlow ht ht0 x exact Source29TopWeakCalibration.evaluatedGradient_ne_zero_of_eval_ne_zero _ (homogeneousComponent_isHomogeneous _ _) (by omega) hx end end Source29InitialGradientLimit /- Component: WeakHomogeneousSign.inc -/ namespace Source29WeakHomogeneousSign open MeasureTheory Filter MvPolynomial open Source29QuarticReuse Source29QuarticReuse.FluxObstruction open Source29WeakCalibrationLimits open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem homogeneous_not_nonnegative (p : MvPolynomial (Fin n) ℝ) {d : ℕ} (hp : p.IsHomogeneous d) (hd : 0 < d) (hne : p ≠ 0) (hW : WeakCalibration (leadingNormalizedField p)) : ¬ ∀ x, 0 ≤ eval x p := by intro hnonneg have hflux_nonneg : ∀ᵐ x, 0 ≤ testFlux (fun i ↦ Pi.single i 1) radialTest (leadingNormalizedField p) x := by apply Filter.Eventually.of_forall intro x rw [radial_flux_leadingNormalizedField p hp x] exact mul_nonneg (radialWeight_nonneg x) (div_nonneg (mul_nonneg (Nat.cast_nonneg d) (hnonneg x)) (Real.sqrt_nonneg _)) have hpositive : ∀ᵐ x : Fin n → ℝ, 0 < MvPolynomial.eval x p := by filter_upwards [mvPolynomial_eval_ne_zero_ae n p hne] with x hx exact lt_of_le_of_ne (hnonneg x) hx.symm have hsupport : {x : Fin n → ℝ | radiusSq x < 1} ≤ᵐ[volume] Function.support (testFlux (fun i ↦ Pi.single i 1) radialTest (leadingNormalizedField p)) := by filter_upwards [hpositive] with x hx intro hr change testFlux (fun i ↦ Pi.single i 1) radialTest (leadingNormalizedField p) x ≠ 0 rw [radial_flux_leadingNormalizedField p hp x] have hgradient := evaluatedGradient_ne_zero_of_pos p hp hd hx have hden : 0 < Real.sqrt (radiusSq (evaluatedGradient p x)) := Real.sqrt_pos.mpr (radiusSq_pos_of_ne_zero hgradient) exact (mul_pos (radialWeight_pos x hr) (div_pos (mul_pos (by exact_mod_cast hd) hx) hden)).ne' have hopen : IsOpen {x : Fin n → ℝ | radiusSq x < 1} := isOpen_lt radiusSq_contDiff.continuous continuous_const have hball : 0 < volume {x : Fin n → ℝ | radiusSq x < 1} := by exact hopen.measure_pos volume ⟨0, by simp [radiusSq]⟩ have hi := (hW.2 radialTest radialTest_contDiff radialTest_hasCompactSupport).1 have hz := (hW.2 radialTest radialTest_contDiff radialTest_hasCompactSupport).2 have hp := (integral_pos_iff_support_of_nonneg_ae hflux_nonneg hi).2 (hball.trans_le (measure_mono_ae hsupport)) rw [hz] at hp exact lt_irrefl _ hp theorem weakCalibration_neg {F : (Fin n → ℝ) → Fin n → ℝ} (hF : WeakCalibration F) : WeakCalibration (fun x i ↦ -F x i) := by refine ⟨?_, ?_⟩ · intro x i simpa only [norm_neg] using hF.1 x i · intro φ hφ hcφ have he : testFlux (fun i ↦ Pi.single i 1) φ (fun x i ↦ -F x i) = fun x ↦ -testFlux (fun i ↦ Pi.single i 1) φ F x := by funext x simp only [testFlux, mul_neg, Finset.sum_neg_distrib] rw [he] exact ⟨(hF.2 φ hφ hcφ).1.neg, by rw [integral_neg, (hF.2 φ hφ hcφ).2, neg_zero]⟩ theorem leadingNormalizedField_neg (p : MvPolynomial (Fin n) ℝ) : leadingNormalizedField (-p) = fun x i ↦ -leadingNormalizedField p x i := by funext x i simp only [leadingNormalizedField, evaluatedGradient, map_neg, radiusSq, neg_sq, neg_div] theorem homogeneous_changes_sign (p : MvPolynomial (Fin n) ℝ) {d : ℕ} (hp : p.IsHomogeneous d) (hd : 0 < d) (hne : p ≠ 0) (hW : WeakCalibration (leadingNormalizedField p)) : (∃ x, eval x p < 0) ∧ (∃ x, 0 < eval x p) := by constructor · obtain ⟨x, hx⟩ := not_forall.mp (homogeneous_not_nonnegative p hp hd hne hW) exact ⟨x, lt_of_not_ge hx⟩ · have hn : WeakCalibration (leadingNormalizedField (-p)) := by rw [leadingNormalizedField_neg] exact weakCalibration_neg hW obtain ⟨x, hx⟩ := not_forall.mp (homogeneous_not_nonnegative (-p) hp.neg hd (neg_ne_zero.mpr hne) hn) refine ⟨x, ?_⟩ simpa only [map_neg, neg_lt_zero] using lt_of_not_ge hx end end Source29WeakHomogeneousSign /- Component: TopLocalInitial.inc -/ namespace Source29TopLocalInitial open MeasureTheory Filter MvPolynomial open Source29QuarticReuse Source29QuarticReuse.FluxObstruction open Source29QuarticReuse.FluxPolynomial open Source29PolynomialTranslation Source29WeakCalibrationLimits open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem leadingNormalizedField_translate (P : MvPolynomial (Fin n) ℝ) (a x : Fin n → ℝ) : leadingNormalizedField (translate P a) x = leadingNormalizedField P (a + x) := by have hg : evaluatedGradient (translate P a) x = evaluatedGradient P (a + x) := by funext i change eval x (pderiv i (translate P a)) = eval (a + x) (pderiv i P) rw [pderiv_translate, eval_translate] rfl funext i simp only [leadingNormalizedField, hg] /-- At any point, the lowest positive-degree term of the leading polynomial inherits its weak gradient calibration. -/ theorem top_initial_weakCalibration (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (a : Fin n → ℝ) (s : ℕ) (hlow : ∀ k < s + 1, homogeneousComponent k (translate (homogeneousComponent P.totalDegree P) a) = 0) (hne : homogeneousComponent (s + 1) (translate (homogeneousComponent P.totalDegree P) a) ≠ 0) : WeakCalibration (leadingNormalizedField (homogeneousComponent (s + 1) (translate (homogeneousComponent P.totalDegree P) a))) := by let t : ℕ → ℝ := fun k ↦ (dilationRadius k)⁻¹ have ht : ∀ k, 0 < t k := fun k ↦ inv_pos.mpr (dilationRadius_pos k) have ht0 : Tendsto t atTop (𝓝 0) := tendsto_inv_atTop_zero.comp dilationRadius_tendsto apply weakCalibration_limit (F := fun k x ↦ leadingNormalizedField (homogeneousComponent P.totalDegree P) (a + t k • x)) · intro k exact top_affine_weakCalibration P hmin hdeg a (t k) (ht k).ne' · exact leadingNormalizedField_bound _ · have hl := Source29InitialGradientLimit.normalized_gradient_initial_limit_ae (translate (homogeneousComponent P.totalDegree P) a) s hlow hne ht ht0 simpa only [leadingNormalizedField_translate] using hl end end Source29TopLocalInitial /- Component: TopLocalSign.inc -/ namespace Source29TopLocalSign open MeasureTheory Filter MvPolynomial open Source29QuarticReuse Source29QuarticReuse.FluxObstruction open Source29QuarticReuse.FluxPolynomial Source29QuarticReuse.QuarticPolynomialBasics open Source29PolynomialTranslation Source29RealLowestRescale open Source29WeakHomogeneousSign Source29TopLocalInitial open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- A strict sign of the initial term occurs arbitrarily close to its center. -/ theorem initial_sign_in_nhds (F : MvPolynomial (Fin n) ℝ) (a : Fin n → ℝ) (s : ℕ) (hlow : ∀ k < s, homogeneousComponent k (translate F a) = 0) (z : Fin n → ℝ) (c : ℝ) (hcz : 0 < c * eval z (homogeneousComponent s (translate F a))) (U : Set (Fin n → ℝ)) (hU : U ∈ 𝓝 a) : ∃ x ∈ U, 0 < c * eval x F := by let t : ℕ → ℝ := fun k ↦ (dilationRadius k)⁻¹ have ht : ∀ k, 0 < t k := fun k ↦ inv_pos.mpr (dilationRadius_pos k) have ht0 : Tendsto t atTop (𝓝 0) := tendsto_inv_atTop_zero.comp dilationRadius_tendsto have hc := (continuous_eval_rescale (translate F a) s z).tendsto 0 rw [rescale_zero _ _ hlow] at hc have hc' : Tendsto (fun k ↦ c * eval z (rescale (translate F a) s (t k))) atTop (𝓝 (c * eval z (homogeneousComponent s (translate F a)))) := tendsto_const_nhds.mul (hc.comp ht0) have hpos : ∀ᶠ k in atTop, 0 < c * eval z (rescale (translate F a) s (t k)) := (tendsto_order.1 hc').1 0 hcz have hp : Tendsto (fun k ↦ a + t k • z) atTop (𝓝 a) := by simpa only [zero_smul, add_zero] using ((tendsto_const_nhds (x := a)).add (ht0.smul (tendsto_const_nhds (x := z)))) obtain ⟨k, hkU, hkpos⟩ := ((hp.eventually hU).and hpos).exists refine ⟨a + t k • z, hkU, ?_⟩ have he := eval_rescale_mul (translate F a) s hlow (t k) z rw [eval_translate] at he have he' : t k ^ s * eval z (rescale (translate F a) s (t k)) = eval (a + t k • z) F := he rw [← he'] have hprod := mul_pos (pow_pos (ht k) s) hkpos nlinarith [hprod] /-- Every zero of the leading polynomial is approached by values of both signs. -/ theorem top_changes_sign_in_every_nhds (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (a : Fin n → ℝ) (ha : eval a (homogeneousComponent P.totalDegree P) = 0) (U : Set (Fin n → ℝ)) (hU : U ∈ 𝓝 a) : (∃ x ∈ U, eval x (homogeneousComponent P.totalDegree P) < 0) ∧ (∃ x ∈ U, 0 < eval x (homogeneousComponent P.totalDegree P)) := by have hne : homogeneousComponent P.totalDegree P ≠ 0 := top_homogeneousComponent_ne_zero P (by omega) obtain ⟨s, hs, hsdeg, hsne, hslow⟩ := exists_lowest_component_at_root _ hne a ha have he : s - 1 + 1 = s := by omega have hw := top_initial_weakCalibration P hmin hdeg a (s - 1) (by simpa only [he] using hslow) (by simpa only [he] using hsne) rw [he] at hw obtain ⟨⟨zneg, hzneg⟩, ⟨zpos, hzpos⟩⟩ := homogeneous_changes_sign _ (homogeneousComponent_isHomogeneous _ _) hs hsne hw constructor · obtain ⟨x, hxU, hx⟩ := initial_sign_in_nhds _ a s hslow zneg (-1) (by simpa using hzneg) U hU exact ⟨x, hxU, by simpa using hx⟩ · obtain ⟨x, hxU, hx⟩ := initial_sign_in_nhds _ a s hslow zpos 1 (by simpa using hzpos) U hU exact ⟨x, hxU, by simpa using hx⟩ /-- A nonnegative factor cannot vanish where its cofactor is nonzero. -/ theorem nonnegative_factor_zero_subset_cofactor_zero (P A Q : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (hfactor : homogeneousComponent P.totalDegree P = A * Q) (hQnonneg : ∀ x, 0 ≤ eval x Q) (a : Fin n → ℝ) (hQzero : eval a Q = 0) : eval a A = 0 := by by_contra hA have hzero : eval a (homogeneousComponent P.totalDegree P) = 0 := by rw [hfactor, map_mul, hQzero, mul_zero] rcases lt_or_gt_of_ne hA with hneg | hpos · let U : Set (Fin n → ℝ) := {x | eval x A < 0} have hU : U ∈ 𝓝 a := (isOpen_lt (contDiff_eval A).continuous continuous_const).mem_nhds hneg obtain ⟨x, hxU, hx⟩ := (top_changes_sign_in_every_nhds P hmin hdeg a hzero U hU).2 rw [hfactor, map_mul] at hx exact (not_lt_of_ge (mul_nonpos_of_nonpos_of_nonneg (le_of_lt hxU) (hQnonneg x))) hx · let U : Set (Fin n → ℝ) := {x | 0 < eval x A} have hU : U ∈ 𝓝 a := (isOpen_lt continuous_const (contDiff_eval A).continuous).mem_nhds hpos obtain ⟨x, hxU, hx⟩ := (top_changes_sign_in_every_nhds P hmin hdeg a hzero U hU).1 rw [hfactor, map_mul] at hx exact (not_lt_of_ge (mul_nonneg (le_of_lt hxU) (hQnonneg x))) hx /-- A factor visible at a real zero of the leading polynomial has odd multiplicity. -/ theorem odd_multiplicity_at_real_zero (P p Q : MvPolynomial (Fin n) ℝ) (k : ℕ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (hk : 1 ≤ k) (hfactor : homogeneousComponent P.totalDegree P = p ^ k * Q) (a : Fin n → ℝ) (hp : eval a p = 0) (hQ : eval a Q ≠ 0) : Odd k := by rcases Nat.even_or_odd k with heven | hodd · exfalso apply hQ apply nonnegative_factor_zero_subset_cofactor_zero P Q (p ^ k) hmin hdeg · simpa only [mul_comm] using hfactor · intro x rw [map_pow] exact heven.pow_nonneg _ · rw [map_pow, hp, zero_pow (by omega)] · exact hodd end end Source29TopLocalSign /- Component: RealAffineChart.inc -/ namespace Source29RealAffineChart open MvPolynomial open scoped BigOperators noncomputable section abbrev Vec (n : ℕ) := Fin n → ℝ abbrev Poly (n : ℕ) := MvPolynomial (Fin n) ℝ /-- Finite-variable polynomial extensionality over the real numbers. This is the finite-variable induction underlying mathlib's MvPolynomial.Funext, whose general theorem is outside the permitted import closure. -/ theorem eq_of_eval_eq {n : ℕ} (P Q : Poly n) (h : ∀ x : Vec n, eval x P = eval x Q) : P = Q := by induction n with | zero => apply (MvPolynomial.isEmptyRingEquiv ℝ (Fin 0)).injective simpa only [isEmptyRingEquiv_eq_coeff_zero, eval_zero, constantCoeff_eq] using h 0 | succ n ih => apply (finSuccEquiv ℝ n).injective apply Polynomial.ext intro k apply ih intro x have hx : Polynomial.map (eval x) (finSuccEquiv ℝ n P) = Polynomial.map (eval x) (finSuccEquiv ℝ n Q) := by apply Polynomial.funext intro t rw [← eval_eq_eval_mv_eval', ← eval_eq_eval_mv_eval'] exact h (Fin.cons t x) simpa only [Polynomial.coeff_map] using congrArg (fun p : Polynomial ℝ => p.coeff k) hx /-- Polynomial for one coordinate of a linear transformation. -/ def linearCoordinate {n : ℕ} (A : Vec n →ₗ[ℝ] Vec n) (i : Fin n) : Poly n := ∑ j, C (A (Pi.single j 1) i) * X j theorem eval_linearCoordinate {n : ℕ} (A : Vec n →ₗ[ℝ] Vec n) (i : Fin n) (x : Vec n) : eval x (linearCoordinate A i) = A x i := by simp only [linearCoordinate, map_sum, map_mul, eval_C, eval_X] conv_rhs => rw [pi_eq_sum_univ' x] simp only [map_sum, map_smul, Finset.sum_apply, Pi.smul_apply, smul_eq_mul] apply Finset.sum_congr rfl intro j _ ring /-- Pull a polynomial back by the affine map x ↦ z+A x. -/ def affinePullback {n : ℕ} (A : Vec n →ₗ[ℝ] Vec n) (z : Vec n) : Poly n →ₐ[ℝ] Poly n := aeval (fun i => C (z i) + linearCoordinate A i) lemma affinePullback_X {n : ℕ} (A : Vec n →ₗ[ℝ] Vec n) (z : Vec n) (i : Fin n) : affinePullback A z (X i) = C (z i) + linearCoordinate A i := by simp [affinePullback] theorem eval_affinePullback {n : ℕ} (A : Vec n →ₗ[ℝ] Vec n) (z x : Vec n) (P : Poly n) : eval x (affinePullback A z P) = eval (z+A x) P := by induction P using MvPolynomial.induction_on with | C c => simp [affinePullback] | add p q hp hq => simp only [map_add, hp, hq] | mul_X p i hp => simp only [map_mul, affinePullback_X, map_add, eval_C, eval_linearCoordinate, eval_X, Pi.add_apply, hp] theorem affinePullback_inverse_left {n : ℕ} (A : Vec n ≃ₗ[ℝ] Vec n) (z : Vec n) (P : Poly n) : affinePullback A.symm.toLinearMap (-A.symm z) (affinePullback A.toLinearMap z P) = P := by apply eq_of_eval_eq intro x rw [eval_affinePullback, eval_affinePullback] simp theorem affinePullback_inverse_right {n : ℕ} (A : Vec n ≃ₗ[ℝ] Vec n) (z : Vec n) (P : Poly n) : affinePullback A.toLinearMap z (affinePullback A.symm.toLinearMap (-A.symm z) P) = P := by apply eq_of_eval_eq intro x rw [eval_affinePullback, eval_affinePullback] simp /-- Invertible affine changes of variables act by algebra equivalences. -/ def affineEquiv {n : ℕ} (A : Vec n ≃ₗ[ℝ] Vec n) (z : Vec n) : Poly n ≃ₐ[ℝ] Poly n := AlgEquiv.ofAlgHom (affinePullback A.toLinearMap z) (affinePullback A.symm.toLinearMap (-A.symm z)) (by apply DFunLike.ext; intro P; exact affinePullback_inverse_right A z P) (by apply DFunLike.ext; intro P; exact affinePullback_inverse_left A z P) lemma affineEquiv_apply {n : ℕ} (A : Vec n ≃ₗ[ℝ] Vec n) (z : Vec n) (P : Poly n) : affineEquiv A z P = affinePullback A.toLinearMap z P := rfl lemma affineEquiv_symm_apply {n : ℕ} (A : Vec n ≃ₗ[ℝ] Vec n) (z : Vec n) (P : Poly n) : (affineEquiv A z).symm P = affinePullback A.symm.toLinearMap (-A.symm z) P := rfl theorem affine_irreducible {n : ℕ} (A : Vec n ≃ₗ[ℝ] Vec n) (z : Vec n) (P : Poly n) (hP : Irreducible P) : Irreducible (affineEquiv A z P) := (MulEquiv.irreducible_iff (affineEquiv A z)).mpr hP /-- First change coordinates, then distinguish the zeroth coordinate as the univariate polynomial variable. There remain n parameter variables. -/ def curriedChart {n : ℕ} (A : Vec (n+1) ≃ₗ[ℝ] Vec (n+1)) (z : Vec (n+1)) : Poly (n+1) ≃ₐ[ℝ] Polynomial (Poly n) := (affineEquiv A z).trans (finSuccEquiv ℝ n) lemma curriedChart_apply {n : ℕ} (A : Vec (n+1) ≃ₗ[ℝ] Vec (n+1)) (z : Vec (n+1)) (P : Poly (n+1)) : curriedChart A z P = finSuccEquiv ℝ n (affinePullback A.toLinearMap z P) := rfl theorem curried_irreducible {n : ℕ} (A : Vec (n+1) ≃ₗ[ℝ] Vec (n+1)) (z : Vec (n+1)) (P : Poly (n+1)) (hP : Irreducible P) : Irreducible (curriedChart A z P) := (MulEquiv.irreducible_iff (curriedChart A z)).mpr hP theorem eval_curriedChart {n : ℕ} (A : Vec (n+1) ≃ₗ[ℝ] Vec (n+1)) (z : Vec (n+1)) (P : Poly (n+1)) (ζ : Vec n) (w : ℝ) : Polynomial.eval w (Polynomial.map (eval ζ) (curriedChart A z P)) = eval (z+A (Fin.cons w ζ)) P := by rw [curriedChart_apply, ← eval_eq_eval_mv_eval', eval_affinePullback] rfl /-- A positive-order root in a specialization ensures positive degree in the distinguished variable before specialization. -/ theorem natDegree_ne_zero_of_specialization_factor {R F : Type*} [Semiring R] [Semiring F] [Nontrivial F] (p : Polynomial R) (f : R →+* F) (s : ℕ) (hs : 0 < s) (g : Polynomial F) (hg : g.coeff 0 ≠ 0) (hp : p.map f = Polynomial.X^s*g) : p.natDegree ≠ 0 := by have hc : (p.map f).coeff s ≠ 0 := by rw [hp] have hcs : (Polynomial.X^s*g).coeff s = g.coeff 0 := by simpa only [zero_add] using Polynomial.coeff_X_pow_mul g s 0 rw [hcs] exact hg have hle := (Polynomial.le_natDegree_of_ne_zero hc).trans Polynomial.natDegree_map_le omega end end Source29RealAffineChart /- Component: RealSliceBezout.inc -/ namespace Source29RealSliceBezout open Polynomial MvPolynomial noncomputable section /-- A coprime cofactor has a nonzero parameter certificate, after clearing fractions. -/ theorem exists_coprime_certificate {R : Type*} [CommRing R] [IsDomain R] [IsGCDMonoid R] (K : Type*) [Field K] [Algebra R K] [IsFractionRing R K] (p q : Polynomial R) (hp : Irreducible p) (hdegree : p.natDegree ≠ 0) (hpq : ¬ p ∣ q) : ∃ (D : R) (A B : Polynomial R), D ≠ 0 ∧ A*p+B*q = Polynomial.C D := by have hpprim := hp.isPrimitive hdegree have hpK : Irreducible (p.map (algebraMap R K)) := hpprim.irreducible_iff_irreducible_map_fraction_map.mp hp have hnd : ¬ p.map (algebraMap R K) ∣ q.map (algebraMap R K) := by intro h exact hpq (hpprim.dvd_of_fraction_map_dvd_fraction_map h) apply Source29WholeSliceBezout.exists_nonzero_bezout_of_fraction_coprime K p q exact (hpK.isCoprime_or_dvd _).resolve_right hnd /-- A specialized Bezout identity prevents simultaneous vanishing. -/ theorem cofactor_ne_zero_of_certificate {R : Type*} [CommRing R] (p q : Polynomial R) (D : R) (A B : Polynomial R) (hcert : A*p+B*q = Polynomial.C D) (f : R →+* ℝ) (hD : f D ≠ 0) (t : ℝ) (hp : (p.map f).eval t = 0) : (q.map f).eval t ≠ 0 := by intro hq have h := congrArg (fun u : Polynomial R ↦ (u.map f).eval t) hcert simp only [Polynomial.map_add, Polynomial.map_mul, Polynomial.map_C, Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_C, hp, hq, mul_zero, add_zero] at h exact hD h.symm end end Source29RealSliceBezout /- Component: RealSliceRegularZero.inc -/ namespace Source29RealSliceRegularZero open MeasureTheory Filter MvPolynomial open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29RealSliceBezout open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem slice_eval_eq (p : Polynomial (MvPolynomial (Fin n) ℝ)) (z : Fin n → ℝ) (t : ℝ) : (p.map (eval z)).eval t = eval (Fin.cons t z) ((finSuccEquiv ℝ n).symm p) := by rw [eval_eq_eval_mv_eval'] simp theorem continuous_slice_parameter (p : Polynomial (MvPolynomial (Fin n) ℝ)) (t : ℝ) : Continuous (fun z : Fin n → ℝ ↦ (p.map (eval z)).eval t) := by simp_rw [slice_eval_eq] exact (contDiff_eval _).continuous.comp (by fun_prop) /-- A real sign-changing slice can be perturbed to a simple zero away from a coprime cofactor. -/ theorem exists_regular_root_away_cofactor (p q : Polynomial (MvPolynomial (Fin n) ℝ)) (hp : Irreducible p) (hpq : ¬ p ∣ q) (y : Fin n → ℝ) (r s : ℝ) (hrs : r ≤ s) (hneg : (p.map (eval y)).eval r < 0) (hpos : 0 < (p.map (eval y)).eval s) : ∃ (z : Fin n → ℝ) (t : ℝ), (p.map (eval z)).eval t = 0 ∧ (p.map (eval z)).derivative.eval t ≠ 0 ∧ (q.map (eval z)).eval t ≠ 0 := by have hd : p.natDegree ≠ 0 := by intro hd have he := Polynomial.eq_C_of_natDegree_eq_zero hd rw [he] at hneg hpos simp only [Polynomial.map_C, Polynomial.eval_C] at hneg hpos linarith obtain ⟨D, A, B, hD, hcertD⟩ := Source29WholeSliceBezout.exists_nonzero_bezout_of_irreducible (FractionRing (MvPolynomial (Fin n) ℝ)) p hp hd obtain ⟨E, C, F, hE, hcertE⟩ := exists_coprime_certificate (FractionRing (MvPolynomial (Fin n) ℝ)) p q hp hd hpq let U : Set (Fin n → ℝ) := {z | (p.map (eval z)).eval r < 0 ∧ 0 < (p.map (eval z)).eval s} have hU : IsOpen U := (isOpen_lt (continuous_slice_parameter p r) continuous_const).inter (isOpen_lt continuous_const (continuous_slice_parameter p s)) have hUpos : 0 < volume U := hU.measure_pos volume ⟨y, hneg, hpos⟩ obtain ⟨z, hzU, hz⟩ := Measure.exists_mem_of_measure_ne_zero_of_ae hUpos.ne' (ae_restrict_of_ae (mvPolynomial_eval_ne_zero_ae n (D * E) (mul_ne_zero hD hE))) have hzD : eval z D ≠ 0 := by rw [map_mul] at hz exact (mul_ne_zero_iff.mp hz).1 have hzE : eval z E ≠ 0 := by rw [map_mul] at hz exact (mul_ne_zero_iff.mp hz).2 have hrange := intermediate_value_Icc hrs (p.map (eval z)).continuous.continuousOn obtain ⟨t, ht, hroot⟩ := hrange ⟨hzU.1.le, hzU.2.le⟩ refine ⟨z, t, hroot, ?_, ?_⟩ · have he := cofactor_ne_zero_of_certificate p p.derivative D A B hcertD (eval z) hzD t hroot simpa only [Polynomial.derivative_map] using he · exact cofactor_ne_zero_of_certificate p q E C F hcertE (eval z) hzE t hroot end end Source29RealSliceRegularZero /- Component: RealLineCoordinates.inc -/ namespace Source29RealLineCoordinates open MvPolynomial open Source29QuarticReuse.FluxObstruction open Source29QuarticReuse.QuarticNormalization open scoped BigOperators Matrix noncomputable section /-- An orthogonal coordinate change puts any nonzero displacement on the first axis. -/ theorem exists_axis_coordinates {n : ℕ} (v : Fin (n + 1) → ℝ) (hv : v ≠ 0) : ∃ (A : (Fin (n + 1) → ℝ) ≃ₗ[ℝ] (Fin (n + 1) → ℝ)) (r : ℝ), 0 < r ∧ A (Fin.cons r (0 : Fin n → ℝ)) = v := by let r := Real.sqrt (radiusSq v) have hr : 0 < r := Real.sqrt_pos.mpr (radiusSq_pos_of_ne_zero hv) let e : Fin (n + 1) → ℝ := fun i ↦ v i / r have he : ∑ i, (e i)^2 = 1 := by simp only [e, div_pow, ← Finset.sum_div] change radiusSq v / r ^ 2 = 1 rw [show r ^ 2 = radiusSq v from Real.sq_sqrt (le_of_lt (radiusSq_pos_of_ne_zero hv))] exact div_self (radiusSq_pos_of_ne_zero hv).ne' obtain ⟨U, hUt, hU, hcol⟩ := exists_orthogonal_with_column (0 : Fin (n + 1)) e he refine ⟨Matrix.toLin'OfInv hUt hU, r, hr, ?_⟩ funext i change (∑ j, U i j * (Fin.cons r (0 : Fin n → ℝ) : Fin (n + 1) → ℝ) j) = v i rw [Fin.sum_univ_succ] simp only [Fin.cons_zero, Fin.cons_succ, Pi.zero_apply, mul_zero, Finset.sum_const_zero, add_zero, hcol] exact div_mul_cancel₀ (v i) hr.ne' end end Source29RealLineCoordinates /- Component: RealRegularZero.inc -/ namespace Source29RealRegularZero open MvPolynomial open Source29RealAffineChart Source29RealSliceRegularZero Source29RealLineCoordinates open Source29QuarticReuse.QuarticPolynomialBasics open Source29QuarticReuse.FluxObstruction open scoped BigOperators noncomputable section /-- A sign-changing real irreducible polynomial has a regular real zero outside the zero set of any cofactor not divisible by it. -/ theorem exists_regular_zero_away_cofactor {n : ℕ} (P Q : MvPolynomial (Fin (n + 1)) ℝ) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (a b : Fin (n + 1) → ℝ) (ha : eval a P < 0) (hb : 0 < eval b P) : ∃ x, eval x P = 0 ∧ evaluatedGradient P x ≠ 0 ∧ eval x Q ≠ 0 := by have hv : b - a ≠ 0 := by intro h have hba : b = a := sub_eq_zero.mp h rw [hba] at hb linarith obtain ⟨A, r, hr, hAr⟩ := exists_axis_coordinates (b - a) hv let p := curriedChart A a P let q := curriedChart A a Q have hp : Irreducible p := curried_irreducible A a P hP have hpq : ¬ p ∣ q := by intro h apply hPQ exact (map_dvd_iff (curriedChart A a).toRingEquiv).mp h have hcons0 : (Fin.cons (0 : ℝ) (0 : Fin n → ℝ) : Fin (n + 1) → ℝ) = 0 := by funext i exact Fin.cases rfl (fun _ ↦ rfl) i have hneg : (p.map (eval (0 : Fin n → ℝ))).eval 0 < 0 := by simpa only [p, eval_curriedChart, hcons0, map_zero, add_zero] using ha have hpos : 0 < (p.map (eval (0 : Fin n → ℝ))).eval r := by simpa only [p, eval_curriedChart, hAr, add_sub_cancel] using hb obtain ⟨z, t, hroot, hder, hcofactor⟩ := exists_regular_root_away_cofactor p q hp hpq 0 0 r hr.le hneg hpos let x := a + A (Fin.cons t z) refine ⟨x, ?_, ?_, ?_⟩ · simpa only [p, eval_curriedChart] using hroot · intro hgrad have hzero : evalFDeriv P x = 0 := by ext v rw [evalFDeriv_apply] have hi : ∀ i, eval x (pderiv i P) = 0 := fun i ↦ congrFun hgrad i simp only [hi, zero_mul, Finset.sum_const_zero, zero_apply] have hline : Differentiable ℝ (fun u : ℝ ↦ (Fin.cons u z : Fin (n + 1) → ℝ)) := by apply differentiable_pi.mpr intro i exact Fin.cases differentiable_id (fun _ ↦ differentiable_const _) i have hcurve : Differentiable ℝ (fun u : ℝ ↦ a + A (Fin.cons u z)) := (differentiable_const a).add (A.toContinuousLinearEquiv.differentiable.comp hline) have hc := (hasFDerivAt_eval P x).comp_hasDerivAt t ((hcurve t).hasDerivAt) rw [hzero] at hc have hd : HasDerivAt (fun u : ℝ ↦ eval (a + A (Fin.cons u z)) P) ((p.map (eval z)).derivative.eval t) t := by simpa only [p, eval_curriedChart] using (p.map (eval z)).hasDerivAt t exact hder (hd.unique hc) · simpa only [q, eval_curriedChart] using hcofactor /-- Vanishing on the regular real locus of an irreducible sign-changing polynomial already implies algebraic divisibility. -/ theorem dvd_of_vanishing_on_regular_real_zeros {n : ℕ} (P Q : MvPolynomial (Fin (n + 1)) ℝ) (hP : Irreducible P) (a b : Fin (n + 1) → ℝ) (ha : eval a P < 0) (hb : 0 < eval b P) (hQ : ∀ x, eval x P = 0 → evaluatedGradient P x ≠ 0 → eval x Q = 0) : P ∣ Q := by by_contra hnd obtain ⟨x, hx, hreg, hne⟩ := exists_regular_zero_away_cofactor P Q hP hnd a b ha hb exact hne (hQ x hx hreg) end end Source29RealRegularZero /- Component: OddLeadingFactor.inc -/ namespace Source29OddLeadingFactor open MvPolynomial Source29FactorInheritance open Source29QuarticReuse.FluxObstruction noncomputable section /-- Every sign-changing irreducible factor of a minimal graph's leading term occurs with odd multiplicity once the cofactor is relatively prime to it. -/ theorem sign_changing_factor_has_odd_multiplicity (P p Q : MvPolynomial (Fin 8) ℝ) (k : ℕ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (hk : 1 ≤ k) (hp : Irreducible p) (hQ : ¬p ∣ Q) (hfactor : homogeneousComponent P.totalDegree P = p ^ k * Q) (hpos : ∃ b, 0 < eval b p) (hneg : ∃ a, eval a p < 0) : Odd k ∧ ∃ x, eval x p = 0 ∧ evaluatedGradient p x ≠ 0 ∧ eval x Q ≠ 0 := by obtain ⟨a, ha⟩ := hneg obtain ⟨b, hb⟩ := hpos obtain ⟨x, hx, hreg, hne⟩ := Source29RealRegularZero.exists_regular_zero_away_cofactor p Q hp hQ a b ha hb exact ⟨Source29TopLocalSign.odd_multiplicity_at_real_zero P p Q k hmin hdeg hk hfactor x hx hne, x, hx, hreg, hne⟩ /-- The proved real leading factorization has odd multiplicity and an actual regular real zero away from its cofactor. -/ theorem minimal_graph_leading_factor_odd (P : MvPolynomial (Fin 8) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) : ∃ (p Q : MvPolynomial (Fin 8) ℝ) (k : ℕ), 1 ≤ k ∧ Irreducible p ∧ p.IsHomogeneous p.totalDegree ∧ Q.IsHomogeneous Q.totalDegree ∧ homogeneousComponent P.totalDegree P = p^k*Q ∧ ¬p ∣ Q ∧ (∃ a, 0 < eval a p) ∧ (∃ b, eval b p < 0) ∧ p ∣ cubicOperator p ∧ Odd k ∧ ∃ x, eval x p = 0 ∧ evaluatedGradient p x ≠ 0 ∧ eval x Q ≠ 0 := by obtain ⟨p, Q, k, hk, hp, hphom, hQhom, hfactor, hQ, hpos, hneg, hL⟩ := Source29RealLeadingFactor.minimal_graph_leading_factor P hmin hdeg obtain ⟨hodd, hreal⟩ := sign_changing_factor_has_odd_multiplicity P p Q k hmin hdeg hk hp hQ hfactor hpos hneg exact ⟨p, Q, k, hk, hp, hphom, hQhom, hfactor, hQ, hpos, hneg, hL, hodd, hreal⟩ end end Source29OddLeadingFactor /- Component: ConnectedResidualSign.inc -/ namespace Source29ConnectedResidualSign open MvPolynomial MeasureTheory open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open scoped Topology noncomputable section theorem constant_sign_on_preconnected {X : Type*} [TopologicalSpace X] {S : Set X} (hS : IsPreconnected S) {f : X → ℝ} (hf : ContinuousOn f S) (hn : ∀ x ∈ S, f x ≠ 0) : (∀ x ∈ S, 0 < f x) ∨ (∀ x ∈ S, f x < 0) := by by_cases hpos : ∀ x ∈ S, 0 < f x · exact Or.inl hpos · right push Not at hpos obtain ⟨a, ha, hfa⟩ := hpos have han : f a < 0 := lt_of_le_of_ne hfa (hn a ha) intro b hb by_contra hbn have hbp : 0 < f b := lt_of_le_of_ne (le_of_not_gt hbn) (hn b hb).symm obtain ⟨c, hc, hfc⟩ := hS.intermediate_value ha hb hf ⟨han.le, hbp.le⟩ exact hn c hc hfc variable {n : ℕ} theorem nonneg_of_nonneg_on_polynomial_nonzero (F G : MvPolynomial (Fin n) ℝ) (hF : F ≠ 0) (hG : ∀ x, eval x F ≠ 0 → 0 ≤ eval x G) : ∀ x, 0 ≤ eval x G := by have hd : Dense {x : Fin n → ℝ | eval x F ≠ 0} := Measure.dense_of_ae (μ := volume) (mvPolynomial_eval_ne_zero_ae n F hF) exact hd.induction hG (isClosed_le continuous_const (contDiff_eval G).continuous) theorem nonpos_of_nonpos_on_polynomial_nonzero (F G : MvPolynomial (Fin n) ℝ) (hF : F ≠ 0) (hG : ∀ x, eval x F ≠ 0 → eval x G ≤ 0) : ∀ x, eval x G ≤ 0 := by have hd : Dense {x : Fin n → ℝ | eval x F ≠ 0} := Measure.dense_of_ae (μ := volume) (mvPolynomial_eval_ne_zero_ae n F hF) exact hd.induction hG (isClosed_le (contDiff_eval G).continuous continuous_const) /-- Connected positive and negative regions force the residual of an odd sign-changing factor to have one weak sign throughout the space. -/ theorem residual_one_sign_of_preconnected (F p Q : MvPolynomial (Fin n) ℝ) (k : ℕ) (hk : Odd k) (hF : F ≠ 0) (hfactor : F = p^k*Q) (hp_pos : ∃ x, 0 < eval x p) (hp_neg : ∃ x, eval x p < 0) (hpos : IsPreconnected {x : Fin n → ℝ | 0 < eval x F}) (hneg : IsPreconnected {x : Fin n → ℝ | eval x F < 0}) : (∀ x, 0 ≤ eval x Q) ∨ (∀ x, eval x Q ≤ 0) := by have hpne : ∀ x, eval x F ≠ 0 → eval x p ≠ 0 := by intro x hx hpz apply hx rw [hfactor, map_mul, map_pow, hpz, zero_pow (by obtain ⟨j, hj⟩ := hk; omega : k ≠ 0), zero_mul] have hsp := constant_sign_on_preconnected hpos (contDiff_eval p).continuous.continuousOn (fun x hx ↦ hpne x hx.ne') have hsn := constant_sign_on_preconnected hneg (contDiff_eval p).continuous.continuousOn (fun x hx ↦ hpne x hx.ne) rcases hsp with hpp | hpn <;> rcases hsn with hnp | hnn · have hglobal : ∀ x, 0 ≤ eval x p := nonneg_of_nonneg_on_polynomial_nonzero F p hF (by intro x hx rcases lt_or_gt_of_ne hx with hlt | hgt · exact (hnp x hlt).le · exact (hpp x hgt).le) obtain ⟨x, hx⟩ := hp_neg exact (not_lt_of_ge (hglobal x) hx).elim · left apply nonneg_of_nonneg_on_polynomial_nonzero F Q hF intro x hx have he : eval x F = (eval x p)^k * eval x Q := by rw [hfactor, map_mul, map_pow] rcases lt_or_gt_of_ne hx with hlt | hgt · have hpk : (eval x p)^k < 0 := hk.pow_neg_iff.mpr (hnn x hlt) rw [he] at hlt rcases mul_neg_iff.mp hlt with h | h <;> linarith [h.1, h.2] · have hpk : 0 < (eval x p)^k := hk.pow_pos_iff.mpr (hpp x hgt) rw [he] at hgt exact ((mul_pos_iff_of_pos_left hpk).mp hgt).le · right apply nonpos_of_nonpos_on_polynomial_nonzero F Q hF intro x hx have he : eval x F = (eval x p)^k * eval x Q := by rw [hfactor, map_mul, map_pow] rcases lt_or_gt_of_ne hx with hlt | hgt · have hpk : 0 < (eval x p)^k := hk.pow_pos_iff.mpr (hnp x hlt) rw [he] at hlt rcases mul_neg_iff.mp hlt with h | h <;> linarith [h.1, h.2] · have hpk : (eval x p)^k < 0 := hk.pow_neg_iff.mpr (hpn x hgt) rw [he] at hgt rcases mul_pos_iff.mp hgt with h | h <;> linarith [h.1, h.2] · have hglobal : ∀ x, eval x p ≤ 0 := nonpos_of_nonpos_on_polynomial_nonzero F p hF (by intro x hx rcases lt_or_gt_of_ne hx with hlt | hgt · exact (hnn x hlt).le · exact (hpn x hgt).le) obtain ⟨x, hx⟩ := hp_pos exact (not_lt_of_ge (hglobal x) hx).elim end end Source29ConnectedResidualSign /- Component: ConnectedFactorStructure.inc -/ namespace Source29ConnectedFactorStructure open MvPolynomial Source29FactorInheritance open Source29QuarticReuse.FluxObstruction noncomputable section variable {n : ℕ} theorem irreducible_neg_of_irreducible (p : MvPolynomial (Fin n) ℝ) (hp : Irreducible p) : Irreducible (-p) := by have hunit : IsUnit (-1 : MvPolynomial (Fin n) ℝ) := by simp simpa only [neg_one_mul] using (irreducible_isUnit_mul hunit).mpr hp /-- Once residual zeros lie on the factor, the factor and full polynomial have exactly the same positive and negative regions. -/ theorem sign_regions_eq_of_nonnegative_residual (F p Q : MvPolynomial (Fin n) ℝ) (k : ℕ) (hk : Odd k) (hfactor : F = p^k*Q) (hQ : ∀ x, 0 ≤ eval x Q) (hzero : ∀ x, eval x Q = 0 → eval x p = 0) : {x | 0 < eval x F} = {x | 0 < eval x p} ∧ {x | eval x F < 0} = {x | eval x p < 0} := by have he (x) : eval x F = (eval x p)^k * eval x Q := by rw [hfactor, map_mul, map_pow] have hQp (x) (hp : eval x p ≠ 0) : 0 < eval x Q := lt_of_le_of_ne (hQ x) (Ne.symm (fun h ↦ hp (hzero x h))) have hQF (x) (hF : eval x F ≠ 0) : 0 < eval x Q := by apply lt_of_le_of_ne (hQ x) intro hz apply hF rw [he, ← hz, mul_zero] constructor · ext x change (0 < eval x F) ↔ (0 < eval x p) constructor · intro hx have hq := hQF x hx.ne' rw [he] at hx exact hk.pow_pos_iff.mp ((mul_pos_iff_of_pos_right hq).mp hx) · intro hx rw [he] exact mul_pos (hk.pow_pos_iff.mpr hx) (hQp x hx.ne') · ext x change (eval x F < 0) ↔ (eval x p < 0) constructor · intro hx have hq := hQF x hx.ne rw [he] at hx apply hk.pow_neg_iff.mp rcases mul_neg_iff.mp hx with h | h <;> linarith [h.1, h.2] · intro hx rw [he] exact mul_neg_of_neg_of_pos (hk.pow_neg_iff.mpr hx) (hQp x hx.ne) /-- With connected sign regions, the leading factorization can be oriented so that its residual is nonnegative and every residual zero is a factor zero. -/ theorem minimal_graph_nonnegative_leading_factor (P : MvPolynomial (Fin 8) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (hpos : IsPreconnected {x : Fin 8 → ℝ | 0 < eval x (homogeneousComponent P.totalDegree P)}) (hneg : IsPreconnected {x : Fin 8 → ℝ | eval x (homogeneousComponent P.totalDegree P) < 0}) : ∃ (p Q : MvPolynomial (Fin 8) ℝ) (k : ℕ), 1 ≤ k ∧ Odd k ∧ Irreducible p ∧ p.IsHomogeneous p.totalDegree ∧ Q.IsHomogeneous Q.totalDegree ∧ homogeneousComponent P.totalDegree P = p^k*Q ∧ ¬p ∣ Q ∧ (∃ a, 0 < eval a p) ∧ (∃ b, eval b p < 0) ∧ (∀ x, 0 ≤ eval x Q) ∧ (∀ x, eval x Q = 0 → eval x p = 0) ∧ p ∣ cubicOperator p ∧ ∃ x, eval x p = 0 ∧ evaluatedGradient p x ≠ 0 ∧ eval x Q ≠ 0 := by obtain ⟨p, Q, k, hk, hp, hphom, hQhom, hfactor, hnot, hppos, hpneg, hpL, hodd, hreg⟩ := Source29OddLeadingFactor.minimal_graph_leading_factor_odd P hmin hdeg obtain ⟨hFne, hFhom, hFL⟩ := QuarticPolynomialBasics.leading_component_data P hmin hdeg have hone := Source29ConnectedResidualSign.residual_one_sign_of_preconnected (homogeneousComponent P.totalDegree P) p Q k hodd hFne hfactor hppos hpneg hpos hneg have hnorm : ∃ p' Q' : MvPolynomial (Fin 8) ℝ, Irreducible p' ∧ p'.IsHomogeneous p'.totalDegree ∧ Q'.IsHomogeneous Q'.totalDegree ∧ homogeneousComponent P.totalDegree P = p'^k*Q' ∧ ¬p' ∣ Q' ∧ (∃ x, 0 < eval x p') ∧ (∃ x, eval x p' < 0) ∧ (∀ x, 0 ≤ eval x Q') := by rcases hone with hnonneg | hnonpos · exact ⟨p, Q, hp, hphom, hQhom, hfactor, hnot, hppos, hpneg, hnonneg⟩ · refine ⟨-p, -Q, irreducible_neg_of_irreducible p hp, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ · simpa only [totalDegree_neg] using hphom.neg · simpa only [totalDegree_neg] using hQhom.neg · rw [hodd.neg_pow, neg_mul_neg] exact hfactor · simpa using hnot · obtain ⟨x, hx⟩ := hpneg exact ⟨x, by simpa only [map_neg, neg_pos] using hx⟩ · obtain ⟨x, hx⟩ := hppos exact ⟨x, by simpa only [map_neg, neg_lt_zero] using hx⟩ · intro x simpa only [map_neg, neg_nonneg] using hnonpos x obtain ⟨p', Q', hp', hp'hom, hQ'hom, hfactor', hnot', hpos', hneg', hQnonneg⟩ := hnorm have hzero : ∀ x, eval x Q' = 0 → eval x p' = 0 := by intro x hx have hz := Source29TopLocalSign.nonnegative_factor_zero_subset_cofactor_zero P (p'^k) Q' hmin hdeg hfactor' hQnonneg x hx by_contra hpn exact pow_ne_zero k hpn (by simpa only [map_pow] using hz) have hL' : p' ∣ cubicOperator p' := Source29RealLeadingFactor.real_factor_inheritance p' Q' k hk hp' hnot' (by rwa [← hfactor']) obtain ⟨a, ha⟩ := hneg' obtain ⟨b, hb⟩ := hpos' have hreal := Source29RealRegularZero.exists_regular_zero_away_cofactor p' Q' hp' hnot' a b ha hb exact ⟨p', Q', k, hk, hodd, hp', hp'hom, hQ'hom, hfactor', hnot', ⟨b, hb⟩, ⟨a, ha⟩, hQnonneg, hzero, hL', hreal⟩ end end Source29ConnectedFactorStructure /- Component: TopPhaseBoundary.inc -/ namespace Source29TopPhaseBoundary open MvPolynomial Set open Source29QuarticReuse.FluxPolynomial open scoped Topology noncomputable section section Topology variable {X : Type*} [TopologicalSpace X] {f : X → ℝ} theorem positive_closure (hf : Continuous f) (hz : ∀ x, f x = 0 → ∀ U ∈ 𝓝 x, ∃ y ∈ U, 0 < f y) : closure {x | 0 < f x} = {x | 0 ≤ f x} := by apply Set.Subset.antisymm (closure_lt_subset_le continuous_const hf) intro x hx by_cases h0 : f x = 0 · apply mem_closure_iff.mpr intro U hU hxU obtain ⟨y, hyU, hy⟩ := hz x h0 U (hU.mem_nhds hxU) exact ⟨y, hyU, hy⟩ · exact subset_closure (lt_of_le_of_ne hx (Ne.symm h0)) theorem negative_closure (hf : Continuous f) (hz : ∀ x, f x = 0 → ∀ U ∈ 𝓝 x, ∃ y ∈ U, f y < 0) : closure {x | f x < 0} = {x | f x ≤ 0} := by have h := positive_closure hf.neg (by intro x hx U hU obtain ⟨y, hyU, hy⟩ := hz x (neg_eq_zero.mp hx) U hU exact ⟨y, hyU, neg_pos.mpr hy⟩) simpa only [Pi.neg_apply, neg_pos, neg_nonneg] using h theorem positive_frontier (hf : Continuous f) (hc : closure {x | 0 < f x} = {x | 0 ≤ f x}) : frontier {x | 0 < f x} = {x | f x = 0} := by rw [frontier, hc, (isOpen_lt continuous_const hf).interior_eq] ext x simp only [Set.mem_sdiff, Set.mem_ofPred_eq, not_lt] exact ⟨fun h ↦ le_antisymm h.2 h.1, fun h ↦ by simp [h]⟩ theorem negative_frontier (hf : Continuous f) (hc : closure {x | f x < 0} = {x | f x ≤ 0}) : frontier {x | f x < 0} = {x | f x = 0} := by rw [frontier, hc, (isOpen_lt hf continuous_const).interior_eq] ext x simp only [Set.mem_sdiff, Set.mem_ofPred_eq, not_lt] exact ⟨fun h ↦ le_antisymm h.1 h.2, fun h ↦ by simp [h]⟩ theorem positive_regular_open (hf : Continuous f) (hc : closure {x | 0 < f x} = {x | 0 ≤ f x}) (hz : ∀ x, f x = 0 → ∀ U ∈ 𝓝 x, ∃ y ∈ U, f y < 0) : interior (closure {x | 0 < f x}) = {x | 0 < f x} := by apply Set.Subset.antisymm · intro x hx have hnonneg : 0 ≤ f x := by have h := interior_subset hx rwa [hc] at h by_contra hn have hzero : f x = 0 := le_antisymm (le_of_not_gt hn) hnonneg obtain ⟨y, hy, hyneg⟩ := hz x hzero _ (isOpen_interior.mem_nhds hx) have hy' := interior_subset hy rw [hc] at hy' exact not_lt_of_ge hy' hyneg · exact (isOpen_lt continuous_const hf).subset_interior_closure theorem negative_regular_open (hf : Continuous f) (hc : closure {x | f x < 0} = {x | f x ≤ 0}) (hz : ∀ x, f x = 0 → ∀ U ∈ 𝓝 x, ∃ y ∈ U, 0 < f y) : interior (closure {x | f x < 0}) = {x | f x < 0} := by have h := positive_regular_open hf.neg (by simpa only [Pi.neg_apply, neg_pos, neg_nonneg] using hc) (by intro x hx U hU obtain ⟨y, hyU, hy⟩ := hz x (neg_eq_zero.mp hx) U hU exact ⟨y, hyU, neg_lt_zero.mpr hy⟩) simpa only [Pi.neg_apply, neg_pos] using h end Topology /-- The two leading sign regions are regular open sets with their common boundary exactly the polynomial zero set. -/ theorem top_phase_boundaries {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) : let F := homogeneousComponent P.totalDegree P closure {x | 0 < eval x F} = {x | 0 ≤ eval x F} ∧ closure {x | eval x F < 0} = {x | eval x F ≤ 0} ∧ frontier {x | 0 < eval x F} = {x | eval x F = 0} ∧ frontier {x | eval x F < 0} = {x | eval x F = 0} ∧ interior (closure {x | 0 < eval x F}) = {x | 0 < eval x F} ∧ interior (closure {x | eval x F < 0}) = {x | eval x F < 0} := by let F := homogeneousComponent P.totalDegree P have hf : Continuous (fun x ↦ eval x F) := (contDiff_eval F).continuous have hpos : ∀ x, eval x F = 0 → ∀ U ∈ 𝓝 x, ∃ y ∈ U, 0 < eval y F := by intro x hx U hU exact (Source29TopLocalSign.top_changes_sign_in_every_nhds P hmin hdeg x hx U hU).2 have hneg : ∀ x, eval x F = 0 → ∀ U ∈ 𝓝 x, ∃ y ∈ U, eval y F < 0 := by intro x hx U hU exact (Source29TopLocalSign.top_changes_sign_in_every_nhds P hmin hdeg x hx U hU).1 have hcp := positive_closure hf hpos have hcn := negative_closure hf hneg exact ⟨hcp, hcn, positive_frontier hf hcp, negative_frontier hf hcn, positive_regular_open hf hcp hneg, negative_regular_open hf hcn hpos⟩ end end Source29TopPhaseBoundary /- Component: NonlinearCalibration.inc -/ namespace Source29NonlinearCalibration open MvPolynomial MeasureTheory Filter open Source29QuarticReuse Source29QuarticReuse.FluxObstruction open Source29QuarticReuse.QuarticPolynomialBasics Source29QuarticReuse.FluxPolynomial open Source29WeakCalibrationLimits Source29VariationConvexity open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem gradient_pair_normalized (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) : (∑ i, evaluatedGradient P x i * leadingNormalizedField P x i) = variationDensity (evaluatedGradient P x) := by simp only [leadingNormalizedField, ← mul_div_assoc, ← pow_two, ← Finset.sum_div] exact Real.div_sqrt theorem composed_product_fderiv (P : MvPolynomial (Fin n) ℝ) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) (x : Fin n → ℝ) (i : Fin n) : fderiv ℝ (fun y ↦ ρ y * h (eval y P)) x (Pi.single i 1) = h (eval x P) * fderiv ℝ ρ x (Pi.single i 1) + ρ x * deriv h (eval x P) * evaluatedGradient P x i := by have hd := ((hh.differentiable (by norm_num) (eval x P)).hasDerivAt).comp_hasFDerivAt x (hasFDerivAt_eval P x) have hp := ((hρ.differentiable (by norm_num) x).hasFDerivAt).fun_mul hd have he := congrArg (fun L : (Fin n → ℝ) →L[ℝ] ℝ ↦ L (Pi.single i 1)) hp.fderiv simpa only [ContinuousLinearMap.add_apply, _root_.smul_apply, smul_eq_mul, evalFDeriv_basis, evaluatedGradient, mul_assoc, add_comm, Function.comp_def] using he theorem composed_product_flux (P : MvPolynomial (Fin n) ℝ) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) (x : Fin n → ℝ) : testFlux (fun i ↦ Pi.single i 1) (fun y ↦ ρ y * h (eval y P)) (leadingNormalizedField P) x = h (eval x P) * testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField P) x + ρ x * deriv h (eval x P) * variationDensity (evaluatedGradient P x) := by simp only [testFlux, composed_product_fderiv P hρ hh, add_mul, Finset.sum_add_distrib] simp_rw [mul_assoc, ← Finset.mul_sum] rw [gradient_pair_normalized] theorem weighted_flux_integrable (P : MvPolynomial (Fin n) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) (hb : ∀ t, ‖h t‖ ≤ 1) : Integrable (fun x ↦ h (eval x P) * testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField P) x) := by apply (testBound_integrable (fun i ↦ Pi.single i 1) hρ hcρ).mono' · exact (hh.continuous.comp (contDiff_eval P).continuous).aestronglyMeasurable.mul ((hcal.2 ρ hρ hcρ).1.aestronglyMeasurable) · exact Filter.Eventually.of_forall fun x ↦ (by rw [norm_mul] calc ‖h (eval x P)‖ * ‖testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField P) x‖ ≤ 1 * ‖testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField P) x‖ := mul_le_mul_of_nonneg_right (hb _) (norm_nonneg _) _ ≤ testBound (fun i ↦ Pi.single i 1) ρ x := by simpa only [one_mul] using norm_testFlux_le_testBound _ ρ _ x (hcal.1 x)) /-- A nonlinear test of the weak calibration converts a local gradient mass into a flux through the cutoff. -/ theorem localized_gradient_mass_identity (P : MvPolynomial (Fin n) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) (hb : ∀ t, ‖h t‖ ≤ 1) : Integrable (fun x ↦ ρ x * deriv h (eval x P) * variationDensity (evaluatedGradient P x)) ∧ (∫ x, ρ x * deriv h (eval x P) * variationDensity (evaluatedGradient P x)) = -(∫ x, h (eval x P) * testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField P) x) := by have hi : Integrable (fun x ↦ ρ x * deriv h (eval x P) * variationDensity (evaluatedGradient P x)) := by apply Continuous.integrable_of_hasCompactSupport · exact (hρ.continuous.mul (hh.continuous_deriv_one.comp (contDiff_eval P).continuous)).mul (variationDensity_continuous _ (fun i ↦ (contDiff_eval (pderiv i P)).continuous)) · exact hcρ.mul_right.mul_right refine ⟨hi, ?_⟩ have htest : ContDiff ℝ 1 (fun x ↦ ρ x * h (eval x P)) := hρ.mul (hh.comp (contDiff_eval P)) have hz := (hcal.2 _ htest hcρ.mul_right).2 have he : (∫ x, testFlux (fun i ↦ Pi.single i 1) (fun y ↦ ρ y * h (eval y P)) (leadingNormalizedField P) x) = (∫ x, h (eval x P) * testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField P) x) + (∫ x, ρ x * deriv h (eval x P) * variationDensity (evaluatedGradient P x)) := by simp_rw [composed_product_flux P hρ hh] exact integral_add (weighted_flux_integrable P hcal hρ hcρ hh hb) hi linarith /-- The localized mass bound is independent of the steepness of a bounded monotone transition function. -/ theorem localized_gradient_mass_bound (P : MvPolynomial (Fin n) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) (hb : ∀ t, ‖h t‖ ≤ 1) (hder : ∀ t, 0 ≤ deriv h t) : Integrable (fun x ↦ ρ x * deriv h (eval x P) * variationDensity (evaluatedGradient P x)) ∧ 0 ≤ (∫ x, ρ x * deriv h (eval x P) * variationDensity (evaluatedGradient P x)) ∧ (∫ x, ρ x * deriv h (eval x P) * variationDensity (evaluatedGradient P x)) ≤ ∫ x, testBound (fun i ↦ Pi.single i 1) ρ x := by obtain ⟨hi, he⟩ := localized_gradient_mass_identity P hcal hρ hcρ hh hb refine ⟨hi, integral_nonneg (fun x ↦ mul_nonneg (mul_nonneg (hρpos x) (hder _)) (Real.sqrt_nonneg _)), ?_⟩ rw [he, ← integral_neg] apply integral_mono (weighted_flux_integrable P hcal hρ hcρ hh hb).neg (testBound_integrable (fun i ↦ Pi.single i 1) hρ hcρ) intro x calc -(h (eval x P) * testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField P) x) ≤ ‖h (eval x P) * testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField P) x‖ := by simpa only [Real.norm_eq_abs] using neg_le_abs _ _ ≤ testBound (fun i ↦ Pi.single i 1) ρ x := by rw [norm_mul] exact (mul_le_mul_of_nonneg_right (hb _) (norm_nonneg _)).trans (by simpa only [one_mul] using norm_testFlux_le_testBound _ ρ _ x (hcal.1 x)) end end Source29NonlinearCalibration /- Component: SmoothPhaseTransition.inc -/ namespace Source29SmoothPhaseTransition open MvPolynomial MeasureTheory Filter open Source29QuarticReuse Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open scoped Topology BigOperators noncomputable section def scalarField (t : ℝ) : ℝ := normalizedField (fun s (_ : Fin 1) ↦ s) t 0 def baseTransition (t : ℝ) : ℝ := (1 + scalarField t) / 2 def transition (k : ℕ) (t : ℝ) : ℝ := baseTransition (dilationRadius k * t) theorem scalarField_contDiff : ContDiff ℝ 1 scalarField := normalizedField_contDiff (fun _ ↦ contDiff_id) 0 theorem scalarField_eq (t : ℝ) : scalarField t = t / Real.sqrt (1 + t^2) := by simp [scalarField, normalizedField, radiusSq] theorem scalarField_deriv (t : ℝ) : deriv scalarField t = 1 / (Real.sqrt (1 + t^2))^3 := by rw [← fderiv_apply_one_eq_deriv] have hd := normalizedField_fderiv (g := fun s : ℝ ↦ fun _ : Fin 1 ↦ s) (fun _ ↦ contDiff_id) t 1 0 change fderiv ℝ scalarField t 1 = _ have hid : fderiv ℝ (fun y : ℝ ↦ y) t 1 = 1 := by exact congrArg (fun L : ℝ →L[ℝ] ℝ ↦ L 1) (hasFDerivAt_id t).fderiv simp only [radiusSq, Fin.sum_univ_one, hid] at hd change fderiv ℝ scalarField t 1 = _ at hd rw [hd] ring theorem baseTransition_contDiff : ContDiff ℝ 1 baseTransition := (contDiff_const.add scalarField_contDiff).div_const 2 theorem baseTransition_bounds (t : ℝ) : 0 ≤ baseTransition t ∧ baseTransition t ≤ 1 := by have h := normalizedField_norm_le_one (fun s : ℝ ↦ fun _ : Fin 1 ↦ s) t 0 change ‖scalarField t‖ ≤ 1 at h rw [Real.norm_eq_abs, abs_le] at h dsimp [baseTransition] constructor <;> linarith [h.1, h.2] theorem baseTransition_deriv_nonneg (t : ℝ) : 0 ≤ deriv baseTransition t := by have hd := (((scalarField_contDiff.differentiable (by norm_num) t).hasDerivAt).const_add 1).div_const 2 change HasDerivAt baseTransition (deriv scalarField t / 2) t at hd rw [hd.deriv, scalarField_deriv] positivity theorem transition_contDiff (k : ℕ) : ContDiff ℝ 1 (transition k) := baseTransition_contDiff.comp (contDiff_const.mul contDiff_id) theorem transition_bounds (k : ℕ) (t : ℝ) : 0 ≤ transition k t ∧ transition k t ≤ 1 := baseTransition_bounds _ theorem transition_norm_le_one (k : ℕ) (t : ℝ) : ‖transition k t‖ ≤ 1 := by rw [Real.norm_eq_abs, abs_of_nonneg (transition_bounds k t).1] exact (transition_bounds k t).2 theorem transition_deriv_nonneg (k : ℕ) (t : ℝ) : 0 ≤ deriv (transition k) t := by have hd := ((baseTransition_contDiff.differentiable (by norm_num) (dilationRadius k * t)).hasDerivAt).comp t ((hasDerivAt_id t).const_mul (dilationRadius k)) change HasDerivAt (transition k) (deriv baseTransition (dilationRadius k * t) * (dilationRadius k * 1)) t at hd rw [hd.deriv] exact mul_nonneg (baseTransition_deriv_nonneg _) (mul_nonneg (dilationRadius_pos k).le zero_le_one) theorem transition_tendsto {t : ℝ} (ht : t ≠ 0) : Tendsto (fun k ↦ transition k t) atTop (𝓝 (if 0 < t then 1 else 0)) := by have hz : (fun _ : Fin 1 ↦ t) ≠ 0 := by intro he exact ht (congrFun he 0) have hs := normalized_ratio_tendsto (g := fun k (_ : Fin 1) ↦ dilationRadius k * t) (r := fun k ↦ (dilationRadius k)⁻¹) (z := fun _ : Fin 1 ↦ t) (fun k ↦ inv_pos.mpr (dilationRadius_pos k)) (tendsto_inv_atTop_zero.comp dilationRadius_tendsto) (by intro i; simpa only [← mul_assoc, inv_mul_cancel₀ (dilationRadius_pos _).ne', one_mul] using (tendsto_const_nhds : Tendsto (fun _ : ℕ ↦ t) atTop (𝓝 t))) hz 0 have hs' : Tendsto (fun k ↦ scalarField (dilationRadius k * t)) atTop (𝓝 (t / |t|)) := by simpa only [scalarField, normalizedField, radiusSq, Fin.sum_univ_one, Real.sqrt_sq_eq_abs] using hs have hb := ((tendsto_const_nhds (x := (1 : ℝ))).add hs').div_const 2 change Tendsto (fun k ↦ transition k t) atTop (𝓝 ((1 + t / |t|) / 2)) at hb convert hb using 1 rcases lt_or_gt_of_ne ht with hn | hp · simp [not_lt_of_ge hn.le, abs_of_neg hn, div_neg, div_self ht] · simp [hp, abs_of_pos hp, div_self ht] theorem polynomial_transition_tendsto_ae {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) : ∀ᵐ x, Tendsto (fun k ↦ transition k (eval x P)) atTop (𝓝 (if 0 < eval x P then 1 else 0)) := by filter_upwards [mvPolynomial_eval_ne_zero_ae n P hP] with x hx exact transition_tendsto hx end end Source29SmoothPhaseTransition /- Component: PhaseApproximation.inc -/ namespace Source29PhaseApproximation open MvPolynomial MeasureTheory Filter open Source29QuarticReuse Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29SmoothPhaseTransition Source29NonlinearCalibration Source29VariationConvexity open Source29WeakCalibrationLimits open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- Smooth sign transitions converge locally in L1, and more generally after multiplication by any integrable scalar weight. -/ theorem transition_weighted_L1 (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (w : (Fin n → ℝ) → ℝ) (hw : Integrable w) : Tendsto (fun k ↦ ∫ x, ‖w x * (transition k (eval x P) - if 0 < eval x P then 1 else 0)‖) atTop (𝓝 0) := by let I : (Fin n → ℝ) → ℝ := fun x ↦ if 0 < eval x P then 1 else 0 have hc (k : ℕ) : Continuous (fun x ↦ transition k (eval x P)) := (transition_contDiff k).continuous.comp (contDiff_eval P).continuous have hl := polynomial_transition_tendsto_ae P hP have hI : AEStronglyMeasurable I := aestronglyMeasurable_of_tendsto_ae atTop (fun k ↦ (hc k).aestronglyMeasurable) hl have hib (x) : ‖I x‖ ≤ 1 := by dsimp [I] split_ifs <;> norm_num have ht : Tendsto (fun k ↦ ∫ x, ‖w x * (transition k (eval x P) - I x)‖) atTop (𝓝 (∫ _x : Fin n → ℝ, (0 : ℝ))) := by apply tendsto_integral_of_dominated_convergence (fun x ↦ 2 * ‖w x‖) · intro k exact (hw.aestronglyMeasurable.mul ((hc k).aestronglyMeasurable.sub hI)).norm · exact hw.norm.const_mul 2 · intro k exact Filter.Eventually.of_forall fun x ↦ (by rw [norm_norm, norm_mul] calc ‖w x‖ * ‖transition k (eval x P) - I x‖ ≤ ‖w x‖ * (‖transition k (eval x P)‖ + ‖I x‖) := mul_le_mul_of_nonneg_left (norm_sub_le _ _) (norm_nonneg _) _ ≤ 2 * ‖w x‖ := by have ha := transition_norm_le_one k (eval x P) have hb := hib x nlinarith [norm_nonneg (w x)]) · filter_upwards [hl] with x hx have h := ((tendsto_const_nhds (x := w x)).mul (hx.sub (tendsto_const_nhds (x := I x)))).norm simpa only [I, sub_self, mul_zero, norm_zero] using h simpa only [integral_zero] using ht theorem transition_weighted_integral (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (w : (Fin n → ℝ) → ℝ) (hw : Integrable w) : Tendsto (fun k ↦ ∫ x, w x * transition k (eval x P)) atTop (𝓝 (∫ x, w x * (if 0 < eval x P then 1 else 0))) := by apply tendsto_integral_of_dominated_convergence (fun x ↦ ‖w x‖) · intro k exact hw.aestronglyMeasurable.mul ((transition_contDiff k).continuous.comp (contDiff_eval P).continuous).aestronglyMeasurable · exact hw.norm · intro k exact Filter.Eventually.of_forall fun x ↦ (by rw [norm_mul] exact mul_le_of_le_one_right (norm_nonneg _) (transition_norm_le_one k _)) · filter_upwards [polynomial_transition_tendsto_ae P hP] with x hx exact (tendsto_const_nhds (x := w x)).mul hx theorem phase_weight_integrable (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (w : (Fin n → ℝ) → ℝ) (hw : Integrable w) : Integrable (fun x ↦ w x * (if 0 < eval x P then 1 else 0)) := by apply hw.mul_bdd · exact aestronglyMeasurable_of_tendsto_ae atTop (fun k ↦ ((transition_contDiff k).continuous.comp (contDiff_eval P).continuous).aestronglyMeasurable) (polynomial_transition_tendsto_ae P hP) · exact Filter.Eventually.of_forall fun x ↦ (show ‖(if 0 < eval x P then 1 else 0 : ℝ)‖ ≤ 1 by split_ifs <;> norm_num) /-- Each smooth transition of the leading polynomial has a local gradient mass bounded only by the cutoff, not by the transition parameter. -/ theorem top_transition_mass_bound (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) (k : ℕ) : let F := homogeneousComponent P.totalDegree P Integrable (fun x ↦ ρ x * deriv (transition k) (eval x F) * variationDensity (evaluatedGradient F x)) ∧ 0 ≤ (∫ x, ρ x * deriv (transition k) (eval x F) * variationDensity (evaluatedGradient F x)) ∧ (∫ x, ρ x * deriv (transition k) (eval x F) * variationDensity (evaluatedGradient F x)) ≤ ∫ x, testBound (fun i ↦ Pi.single i 1) ρ x := by let F := homogeneousComponent P.totalDegree P have hcal : WeakCalibration (leadingNormalizedField F) := by refine ⟨leadingNormalizedField_bound F, ?_⟩ intro φ hφ hcφ exact Source29TopWeakCalibration.top_weak_calibration P hmin hdeg hφ hcφ exact localized_gradient_mass_bound F hcal hρ hcρ hρpos (transition_contDiff k) (transition_norm_le_one k) (transition_deriv_nonneg k) end end Source29PhaseApproximation /- Component: PhaseDivergence.inc -/ namespace Source29PhaseDivergence open MvPolynomial MeasureTheory Filter open Source29QuarticReuse Source29QuarticReuse.FluxObstruction open Source29QuarticReuse.QuarticPolynomialBasics Source29QuarticReuse.FluxPolynomial open Source29SmoothPhaseTransition Source29NonlinearCalibration Source29VariationConvexity open Source29WeakCalibrationLimits Source29PhaseApproximation open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem abs_pairing_le (a b : Fin n → ℝ) : |∑ i, a i * b i| ≤ variationDensity a * variationDensity b := by have hu := Real.sum_mul_le_sqrt_mul_sqrt Finset.univ a b have hl := Real.sum_mul_le_sqrt_mul_sqrt Finset.univ (fun i ↦ -a i) b simp only [neg_mul, Finset.sum_neg_distrib, neg_sq] at hl exact abs_le.mpr ⟨by dsimp [variationDensity]; linarith, hu⟩ theorem composed_fderiv (P : MvPolynomial (Fin n) ℝ) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) (x : Fin n → ℝ) (i : Fin n) : fderiv ℝ (fun y ↦ h (eval y P)) x (Pi.single i 1) = deriv h (eval x P) * evaluatedGradient P x i := by have hd := ((hh.differentiable (by norm_num) (eval x P)).hasDerivAt).comp_hasFDerivAt x (hasFDerivAt_eval P x) simpa only [Function.comp_def, _root_.smul_apply, smul_eq_mul, evalFDeriv_basis, evaluatedGradient] using congrArg (fun L : (Fin n → ℝ) →L[ℝ] ℝ ↦ L (Pi.single i 1)) hd.fderiv theorem divergence_integrable (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ i, ContDiff ℝ 1 (fun x ↦ X x i)) (hcX : ∀ i, HasCompactSupport (fun x ↦ X x i)) : Integrable (divergence (fun i ↦ Pi.single i 1) X) := by apply integrable_finsetSum intro i _ exact (((hX i).continuous_fderiv (by norm_num)).clm_apply continuous_const).integrable_of_hasCompactSupport ((hcX i).fderiv_apply ℝ (Pi.single i 1)) theorem composed_pairing_integrable (P : MvPolynomial (Fin n) ℝ) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ i, ContDiff ℝ 1 (fun x ↦ X x i)) (hcX : ∀ i, HasCompactSupport (fun x ↦ X x i)) : Integrable (fun x ↦ deriv h (eval x P) * ∑ i, evaluatedGradient P x i * X x i) := by simp_rw [Finset.mul_sum] apply integrable_finsetSum intro i _ exact ((hh.continuous_deriv_one.comp (contDiff_eval P).continuous).mul (((contDiff_eval (pderiv i P)).continuous).mul (hX i).continuous)).integrable_of_hasCompactSupport (((hcX i).mul_left).mul_left) /-- Integration by parts for a smooth phase against a compactly supported vector field. -/ theorem composed_divergence_identity (P : MvPolynomial (Fin n) ℝ) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ i, ContDiff ℝ 1 (fun x ↦ X x i)) (hcX : ∀ i, HasCompactSupport (fun x ↦ X x i)) : (∫ x, h (eval x P) * divergence (fun i ↦ Pi.single i 1) X x) = -(∫ x, deriv h (eval x P) * ∑ i, evaluatedGradient P x i * X x i) := by have hi i : Integrable (fun x ↦ h (eval x P) * fderiv ℝ (fun y ↦ X y i) x (Pi.single i 1)) := ((hh.continuous.comp (contDiff_eval P).continuous).mul (((hX i).continuous_fderiv (by norm_num)).clm_apply continuous_const)).integrable_of_hasCompactSupport ((hcX i).fderiv_apply ℝ (Pi.single i 1)).mul_left have hj i : Integrable (fun x ↦ deriv h (eval x P) * (evaluatedGradient P x i * X x i)) := ((hh.continuous_deriv_one.comp (contDiff_eval P).continuous).mul (((contDiff_eval (pderiv i P)).continuous).mul (hX i).continuous)).integrable_of_hasCompactSupport (((hcX i).mul_left).mul_left) have he i : (∫ x, h (eval x P) * fderiv ℝ (fun y ↦ X y i) x (Pi.single i 1)) = -(∫ x, deriv h (eval x P) * (evaluatedGradient P x i * X x i)) := by have hb := integral_mul_fderiv_eq_neg_of_compactSupport (μ := volume) (hX i) (hcX i) (hh.comp (contDiff_eval P)) (Pi.single i 1) change (∫ x, X x i * fderiv ℝ (fun y ↦ h (eval y P)) x (Pi.single i 1)) = -(∫ x, fderiv ℝ (fun y ↦ X y i) x (Pi.single i 1) * h (eval x P)) at hb simp_rw [composed_fderiv P hh] at hb have ha : (∫ x, X x i * (deriv h (eval x P) * evaluatedGradient P x i)) = (∫ x, deriv h (eval x P) * (evaluatedGradient P x i * X x i)) := by apply integral_congr_ae exact Filter.Eventually.of_forall (fun x ↦ by ring) have hc : (∫ x, fderiv ℝ (fun y ↦ X y i) x (Pi.single i 1) * h (eval x P)) = (∫ x, h (eval x P) * fderiv ℝ (fun y ↦ X y i) x (Pi.single i 1)) := by apply integral_congr_ae exact Filter.Eventually.of_forall (fun x ↦ mul_comm _ _) rw [ha, hc] at hb linarith simp only [divergence, Finset.mul_sum] rw [integral_finsetSum _ (fun i _ ↦ hi i), integral_finsetSum _ (fun i _ ↦ hj i)] simp_rw [he] simp /-- The divergence pairing of each smooth phase is bounded independently of its steepness. -/ theorem transition_divergence_bound (P : MvPolynomial (Fin n) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ i, ContDiff ℝ 1 (fun x ↦ X x i)) (hcX : ∀ i, HasCompactSupport (fun x ↦ X x i)) (hbound : ∀ x, variationDensity (X x) ≤ ρ x) (k : ℕ) : |∫ x, transition k (eval x P) * divergence (fun i ↦ Pi.single i 1) X x| ≤ ∫ x, testBound (fun i ↦ Pi.single i 1) ρ x := by obtain ⟨hm, _, hb⟩ := localized_gradient_mass_bound P hcal hρ hcρ hρpos (transition_contDiff k) (transition_norm_le_one k) (transition_deriv_nonneg k) rw [composed_divergence_identity P (transition_contDiff k) X hX hcX, abs_neg] have hi := composed_pairing_integrable P (transition_contDiff k) X hX hcX have hp (x) : |deriv (transition k) (eval x P) * ∑ i, evaluatedGradient P x i * X x i| ≤ ρ x * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x) := by rw [abs_mul, abs_of_nonneg (transition_deriv_nonneg k _)] calc _ ≤ deriv (transition k) (eval x P) * (variationDensity (evaluatedGradient P x) * variationDensity (X x)) := mul_le_mul_of_nonneg_left (abs_pairing_le _ _) (transition_deriv_nonneg k _) _ ≤ deriv (transition k) (eval x P) * (variationDensity (evaluatedGradient P x) * ρ x) := mul_le_mul_of_nonneg_left (mul_le_mul_of_nonneg_left (hbound x) (Real.sqrt_nonneg _)) (transition_deriv_nonneg k _) _ = _ := by ring calc _ ≤ ∫ x, |deriv (transition k) (eval x P) * ∑ i, evaluatedGradient P x i * X x i| := abs_integral_le_integral_abs _ ≤ ∫ x, ρ x * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x) := integral_mono hi.abs hm hp _ ≤ _ := hb /-- A local bound on the distributional derivative of the strict positive phase. The cutoff controls all compactly supported C1 vector fields with norm below it. -/ theorem phase_divergence_bound (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ i, ContDiff ℝ 1 (fun x ↦ X x i)) (hcX : ∀ i, HasCompactSupport (fun x ↦ X x i)) (hbound : ∀ x, variationDensity (X x) ≤ ρ x) : |∫ x, (if 0 < eval x P then 1 else 0) * divergence (fun i ↦ Pi.single i 1) X x| ≤ ∫ x, testBound (fun i ↦ Pi.single i 1) ρ x := by have hl := transition_weighted_integral P hP (divergence (fun i ↦ Pi.single i 1) X) (divergence_integrable X hX hcX) simp_rw [mul_comm (divergence _ X _)] at hl exact le_of_tendsto hl.abs (Filter.Eventually.of_forall (transition_divergence_bound P hcal hρ hcρ hρpos X hX hcX hbound)) end end Source29PhaseDivergence /- Component: PhaseLocalVariation.inc -/ namespace Source29PhaseLocalVariation open MvPolynomial MeasureTheory Filter open Source29QuarticReuse Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29VariationConvexity Source29WeakCalibrationLimits Source29PhaseDivergence open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- On every compact set, the positive phase has a uniformly bounded distributional variation. The bound is uniform over all C1 vector tests of pointwise norm at most one. -/ theorem locally_bounded_phase_variation (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (K : Set (Fin n → ℝ)) (hK : IsCompact K) : ∃ C : ℝ, 0 ≤ C ∧ ∀ X : (Fin n → ℝ) → Fin n → ℝ, (∀ i, ContDiff ℝ 1 (fun x ↦ X x i)) → (∀ i, Function.support (fun x ↦ X x i) ⊆ K) → (∀ x, variationDensity (X x) ≤ 1) → |∫ x, (if 0 < eval x P then 1 else 0) * divergence (fun i ↦ Pi.single i 1) X x| ≤ C := by obtain ⟨R, hR, hKR⟩ := hK.isBounded.subset_closedBall_lt 0 (0 : Fin n → ℝ) let b : ContDiffBump (0 : Fin n → ℝ) := { rIn := R, rOut := R + 1, rIn_pos := hR, rIn_lt_rOut := lt_add_one R } refine ⟨∫ x, testBound (fun i ↦ Pi.single i 1) b x, ?_, ?_⟩ · exact integral_nonneg (fun x ↦ Finset.sum_nonneg (fun i _ ↦ norm_nonneg _)) · intro X hX hsX hXb have hcX (i : Fin n) : HasCompactSupport (fun x ↦ X x i) := HasCompactSupport.of_support_subset_isCompact hK (hsX i) apply phase_divergence_bound P hP hcal b.contDiff b.hasCompactSupport b.nonneg' X hX hcX intro x by_cases hx : x ∈ K · have hb : b x = 1 := b.one_of_mem_closedBall (hKR hx) rw [hb] exact hXb x · have hz : X x = 0 := by ext i by_contra hn exact hx (hsX i hn) rw [hz] simpa only [variationDensity, Pi.zero_apply, zero_pow (by norm_num : 2 ≠ 0), Finset.sum_const_zero, Real.sqrt_zero] using b.nonneg' x /-- The actual leading positive phase of a polynomial minimal graph has the local variation bound, without any regularity assumption on its zero set. -/ theorem top_locally_bounded_phase_variation (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (K : Set (Fin n → ℝ)) (hK : IsCompact K) : ∃ C : ℝ, 0 ≤ C ∧ ∀ X : (Fin n → ℝ) → Fin n → ℝ, (∀ i, ContDiff ℝ 1 (fun x ↦ X x i)) → (∀ i, Function.support (fun x ↦ X x i) ⊆ K) → (∀ x, variationDensity (X x) ≤ 1) → |∫ x, (if 0 < eval x (homogeneousComponent P.totalDegree P) then 1 else 0) * divergence (fun i ↦ Pi.single i 1) X x| ≤ C := by apply locally_bounded_phase_variation _ (Source29QuarticReuse.QuarticPolynomialBasics.top_homogeneousComponent_ne_zero P (by omega)) _ K hK refine ⟨leadingNormalizedField_bound _, ?_⟩ intro φ hφ hcφ exact Source29TopWeakCalibration.top_weak_calibration P hmin hdeg hφ hcφ theorem top_negative_phase_locally_bounded_variation (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (K : Set (Fin n → ℝ)) (hK : IsCompact K) : ∃ C : ℝ, 0 ≤ C ∧ ∀ X : (Fin n → ℝ) → Fin n → ℝ, (∀ i, ContDiff ℝ 1 (fun x ↦ X x i)) → (∀ i, Function.support (fun x ↦ X x i) ⊆ K) → (∀ x, variationDensity (X x) ≤ 1) → |∫ x, (if eval x (homogeneousComponent P.totalDegree P) < 0 then 1 else 0) * divergence (fun i ↦ Pi.single i 1) X x| ≤ C := by have hm : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation (-P) := by change Source29QuarticReuse.QuarticPolynomialBasics.minimalGraphOperator (-P) = 0 rw [minimalGraphOperator_neg] exact neg_eq_zero.mpr hmin have hd : 2 ≤ (-P).totalDegree := by simpa only [totalDegree_neg] using hdeg simpa only [totalDegree_neg, map_neg, neg_pos] using top_locally_bounded_phase_variation (-P) hm hd K hK end end Source29PhaseLocalVariation /- Component: PhaseMassLimit.inc -/ namespace Source29PhaseMassLimit open MvPolynomial MeasureTheory Filter open Source29QuarticReuse Source29QuarticReuse.FluxObstruction open Source29VariationConvexity Source29WeakCalibrationLimits open Source29SmoothPhaseTransition Source29NonlinearCalibration Source29PhaseApproximation open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- The calibrated limiting mass, tested against a scalar cutoff. -/ def phaseMass (P : MvPolynomial (Fin n) ℝ) (ρ : (Fin n → ℝ) → ℝ) : ℝ := -(∫ x, testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField P) x * (if 0 < eval x P then 1 else 0)) theorem phaseMass_tendsto (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) : Tendsto (fun k ↦ ∫ x, ρ x * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x)) atTop (𝓝 (phaseMass P ρ)) := by have ht := (transition_weighted_integral P hP (testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField P)) (hcal.2 ρ hρ hcρ).1).neg convert ht using 1 funext k rw [(localized_gradient_mass_identity P hcal hρ hcρ (transition_contDiff k) (transition_norm_le_one k)).2] congr 1 apply integral_congr_ae exact Filter.Eventually.of_forall fun x ↦ mul_comm _ _ rfl theorem phaseMass_bounds (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) : 0 ≤ phaseMass P ρ ∧ phaseMass P ρ ≤ ∫ x, testBound (fun i ↦ Pi.single i 1) ρ x := by have ht := phaseMass_tendsto P hP hcal hρ hcρ have hb k := (localized_gradient_mass_bound P hcal hρ hcρ hρpos (transition_contDiff k) (transition_norm_le_one k) (transition_deriv_nonneg k)).2 exact ⟨ge_of_tendsto ht (Filter.Eventually.of_forall fun k ↦ (hb k).1), le_of_tendsto ht (Filter.Eventually.of_forall fun k ↦ (hb k).2)⟩ /-- The limiting scalar mass bounds every compact vector test dominated by the cutoff. -/ theorem phase_divergence_le_mass (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ i, ContDiff ℝ 1 (fun x ↦ X x i)) (hcX : ∀ i, HasCompactSupport (fun x ↦ X x i)) (hbound : ∀ x, variationDensity (X x) ≤ ρ x) : |∫ x, (if 0 < eval x P then 1 else 0) * divergence (fun i ↦ Pi.single i 1) X x| ≤ phaseMass P ρ := by have hl := transition_weighted_integral P hP (divergence (fun i ↦ Pi.single i 1) X) (Source29PhaseDivergence.divergence_integrable X hX hcX) simp_rw [mul_comm (divergence _ X _)] at hl apply le_of_tendsto_of_tendsto hl.abs (phaseMass_tendsto P hP hcal hρ hcρ) apply Filter.Eventually.of_forall intro k dsimp only rw [Source29PhaseDivergence.composed_divergence_identity P (transition_contDiff k) X hX hcX, abs_neg] have hi := Source29PhaseDivergence.composed_pairing_integrable P (transition_contDiff k) X hX hcX have hm := (localized_gradient_mass_identity P hcal hρ hcρ (transition_contDiff k) (transition_norm_le_one k)).1 apply (abs_integral_le_integral_abs).trans (integral_mono hi.abs hm ?_) intro x dsimp only rw [abs_mul, abs_of_nonneg (transition_deriv_nonneg k _)] calc _ ≤ deriv (transition k) (eval x P) * (variationDensity (evaluatedGradient P x) * variationDensity (X x)) := mul_le_mul_of_nonneg_left (Source29PhaseDivergence.abs_pairing_le _ _) (transition_deriv_nonneg k _) _ ≤ deriv (transition k) (eval x P) * (variationDensity (evaluatedGradient P x) * ρ x) := mul_le_mul_of_nonneg_left (mul_le_mul_of_nonneg_left (hbound x) (Real.sqrt_nonneg _)) (transition_deriv_nonneg k _) _ = _ := by ring end end Source29PhaseMassLimit /- Component: SmoothCalibrationRecovery.inc -/ namespace Source29SmoothCalibrationRecovery open MvPolynomial MeasureTheory Filter open Source29QuarticReuse Source29QuarticReuse.FluxObstruction open Source29QuarticReuse.QuarticPolynomialBasics Source29QuarticReuse.FluxPolynomial open Source29VariationConvexity open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem variationDensity_const_mul (c : ℝ) (a : Fin n → ℝ) : variationDensity (fun i ↦ c * a i) = |c| * variationDensity a := by simp only [variationDensity, mul_pow, ← Finset.mul_sum] rw [Real.sqrt_mul (sq_nonneg c), Real.sqrt_sq_eq_abs] theorem coordinate_norm_le_variationDensity (a : Fin n → ℝ) (i : Fin n) : ‖a i‖ ≤ variationDensity a := by rw [Real.norm_eq_abs] exact Real.abs_le_sqrt (Finset.single_le_sum (fun j _ ↦ sq_nonneg (a j)) (Finset.mem_univ i)) theorem normalizedField_variationDensity_le_one {E : Type*} (g : E → Fin n → ℝ) (x : E) : variationDensity (normalizedField g x) ≤ 1 := by have hr : 0 ≤ radiusSq (g x) := Finset.sum_nonneg (fun i _ ↦ sq_nonneg (g x i)) apply Real.sqrt_le_one.mpr simp only [normalizedField, div_pow, ← Finset.sum_div] rw [Real.sq_sqrt (by exact add_nonneg zero_le_one hr)] exact (div_le_one (by linarith)).mpr (by dsimp [radiusSq] linarith) /-- Smooth divergence-free vector fields approximating a unit calibration. -/ structure Approximation (A : ℕ → (Fin n → ℝ) → Fin n → ℝ) (G : (Fin n → ℝ) → Fin n → ℝ) : Prop where smooth : ∀ k i, ContDiff ℝ 1 (fun x ↦ A k x i) div_zero : ∀ k x, divergence (fun i ↦ Pi.single i 1) (A k) x = 0 norm_bound : ∀ k x, variationDensity (A k x) ≤ 1 tendsto_ae : ∀ᵐ x, ∀ i, Tendsto (fun k ↦ A k x i) atTop (𝓝 (G x i)) def graphField (P : MvPolynomial (Fin n) ℝ) (k : ℕ) (x : Fin n → ℝ) : Fin n → ℝ := normalizedField (evaluatedGradient P) (dilationRadius k • x) theorem graphField_approximation (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) : Approximation (graphField P) (leadingNormalizedField (homogeneousComponent P.totalDegree P)) := by have hg : ∀ i, ContDiff ℝ 1 (fun x ↦ normalizedField (evaluatedGradient P) x i) := normalizedField_contDiff (fun i ↦ contDiff_eval (pderiv i P)) refine ⟨?_, ?_, ?_, Source29TopWeakCalibration.normalizedGradient_dilates_tendsto_ae P hdeg⟩ · intro k i exact (hg i).comp (by fun_prop) · intro k x change divergence (fun i ↦ Pi.single i 1) (fun y ↦ normalizedField (evaluatedGradient P) (dilationRadius k • y)) x = 0 rw [divergence_dilate _ hg, Source29GraphCalibration.polynomial_normalizedGradient_divergence_zero P hmin, mul_zero] · intro k x exact normalizedField_variationDensity_le_one _ _ def cutoffField (ρ : (Fin n → ℝ) → ℝ) (A : (Fin n → ℝ) → Fin n → ℝ) (x : Fin n → ℝ) (i : Fin n) : ℝ := ρ x * A x i theorem divergence_cutoffField {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) {A : (Fin n → ℝ) → Fin n → ℝ} (hA : ∀ i, ContDiff ℝ 1 (fun x ↦ A x i)) (x : Fin n → ℝ) : divergence (fun i ↦ Pi.single i 1) (cutoffField ρ A) x = testFlux (fun i ↦ Pi.single i 1) ρ A x + ρ x * divergence (fun i ↦ Pi.single i 1) A x := by have hd i : fderiv ℝ (fun y ↦ ρ y * A y i) x (Pi.single i 1) = A x i * fderiv ℝ ρ x (Pi.single i 1) + ρ x * fderiv ℝ (fun y ↦ A y i) x (Pi.single i 1) := by have hh := ((hρ.differentiable (by norm_num) x).hasFDerivAt).fun_mul ((hA i).differentiable (by norm_num) x).hasFDerivAt simpa only [add_apply, _root_.smul_apply, smul_eq_mul, add_comm] using congrArg (fun L : (Fin n → ℝ) →L[ℝ] ℝ ↦ L (Pi.single i 1)) hh.fderiv simp only [divergence, cutoffField, hd, testFlux, Finset.sum_add_distrib, Finset.mul_sum] congr 1 apply Finset.sum_congr rfl intro i _ exact mul_comm _ _ /-- The divergence pairing of cutoff calibration fields converges by dominated convergence. -/ theorem cutoff_pairings_tendsto {A : ℕ → (Fin n → ℝ) → Fin n → ℝ} {G : (Fin n → ℝ) → Fin n → ℝ} (ha : Approximation A G) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) {u : (Fin n → ℝ) → ℝ} (hu : AEStronglyMeasurable u) (hub : ∀ x, ‖u x‖ ≤ 1) : Tendsto (fun k ↦ ∫ x, u x * divergence (fun i ↦ Pi.single i 1) (cutoffField ρ (A k)) x) atTop (𝓝 (∫ x, u x * testFlux (fun i ↦ Pi.single i 1) ρ G x)) := by simp_rw [divergence_cutoffField hρ (ha.smooth _), ha.div_zero, mul_zero, add_zero] apply tendsto_integral_of_dominated_convergence (testBound (fun i ↦ Pi.single i 1) ρ) · intro k exact hu.mul (testFlux_continuous _ hρ (fun i ↦ (ha.smooth k i).continuous)).aestronglyMeasurable · exact testBound_integrable _ hρ hcρ · intro k exact Filter.Eventually.of_forall fun x ↦ (by rw [norm_mul] apply (mul_le_mul_of_nonneg_right (hub x) (norm_nonneg _)).trans simpa only [one_mul] using norm_testFlux_le_testBound _ ρ (A k) x (fun i ↦ (coordinate_norm_le_variationDensity (A k x) i).trans (ha.norm_bound k x))) · filter_upwards [ha.tendsto_ae] with x hx exact (tendsto_const_nhds (x := u x)).mul (testFlux_tendsto _ ρ hx) end end Source29SmoothCalibrationRecovery /- Component: WeightedPhaseVariation.inc -/ namespace Source29WeightedPhaseVariation open MvPolynomial MeasureTheory Filter open Source29QuarticReuse Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29VariationConvexity Source29WeakCalibrationLimits Source29PhaseMassLimit open Source29SmoothCalibrationRecovery open scoped Topology BigOperators ENNReal noncomputable section variable {n : ℕ} /-- Compact C1 vector tests for weighted distributional variation. -/ structure VariationTest (ρ : (Fin n → ℝ) → ℝ) (X : (Fin n → ℝ) → Fin n → ℝ) : Prop where smooth : ∀ i, ContDiff ℝ 1 (fun x ↦ X x i) compact : ∀ i, HasCompactSupport (fun x ↦ X x i) norm_bound : ∀ x, variationDensity (X x) ≤ ρ x /-- Weighted distributional variation, defined by the usual divergence-test supremum. For measurable set indicators this is the dual definition of weighted perimeter. -/ def weightedVariation (u ρ : (Fin n → ℝ) → ℝ) : ℝ≥0∞ := ⨆ (X : (Fin n → ℝ) → Fin n → ℝ) (_ : VariationTest ρ X), ENNReal.ofReal |∫ x, u x * divergence (fun i ↦ Pi.single i 1) X x| def positivePhase (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) : ℝ := if 0 < eval x P then 1 else 0 theorem positivePhase_bound (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) : ‖positivePhase P x‖ ≤ 1 := by dsimp [positivePhase] split_ifs <;> norm_num theorem positivePhase_aestronglyMeasurable (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) : AEStronglyMeasurable (positivePhase P) := aestronglyMeasurable_of_tendsto_ae atTop (fun k ↦ ((Source29SmoothPhaseTransition.transition_contDiff k).continuous.comp (contDiff_eval P).continuous).aestronglyMeasurable) (Source29SmoothPhaseTransition.polynomial_transition_tendsto_ae P hP) theorem test_le_weightedVariation (u ρ : (Fin n → ℝ) → ℝ) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : VariationTest ρ X) : ENNReal.ofReal |∫ x, u x * divergence (fun i ↦ Pi.single i 1) X x| ≤ weightedVariation u ρ := le_iSup_of_le X (le_iSup_of_le hX le_rfl) theorem cutoff_variationTest {A : ℕ → (Fin n → ℝ) → Fin n → ℝ} {G : (Fin n → ℝ) → Fin n → ℝ} (ha : Approximation A G) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) (k : ℕ) : VariationTest ρ (cutoffField ρ (A k)) := by refine ⟨fun i ↦ hρ.mul (ha.smooth k i), fun i ↦ hcρ.mul_right, ?_⟩ intro x change variationDensity (fun i ↦ ρ x * A k x i) ≤ ρ x rw [variationDensity_const_mul, abs_of_nonneg (hρpos x)] exact mul_le_of_le_one_right (hρpos x) (ha.norm_bound k x) theorem phase_variation_le_mass (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) : weightedVariation (positivePhase P) ρ ≤ ENNReal.ofReal (phaseMass P ρ) := by apply iSup_le intro X apply iSup_le intro hX exact ENNReal.ofReal_le_ofReal (phase_divergence_le_mass P hP hcal hρ hcρ X hX.smooth hX.compact hX.norm_bound) theorem cutoff_phase_pairings_tendsto_mass (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) {A : ℕ → (Fin n → ℝ) → Fin n → ℝ} (ha : Approximation A (leadingNormalizedField P)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) : Tendsto (fun k ↦ ∫ x, positivePhase P x * divergence (fun i ↦ Pi.single i 1) (cutoffField ρ (A k)) x) atTop (𝓝 (-phaseMass P ρ)) := by have ht := cutoff_pairings_tendsto ha hρ hcρ (positivePhase_aestronglyMeasurable P hP) (positivePhase_bound P) have he : (∫ x, positivePhase P x * testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField P) x) = -phaseMass P ρ := by simp only [phaseMass, neg_neg, positivePhase] apply integral_congr_ae exact Filter.Eventually.of_forall fun x ↦ mul_comm _ _ rwa [he] at ht /-- Smooth divergence-free approximants attain the full dual variation in the limit. -/ theorem phase_variation_eq_mass (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {A : ℕ → (Fin n → ℝ) → Fin n → ℝ} (ha : Approximation A (leadingNormalizedField P)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) : weightedVariation (positivePhase P) ρ = ENNReal.ofReal (phaseMass P ρ) := by apply le_antisymm (phase_variation_le_mass P hP hcal hρ hcρ) have ht := ENNReal.tendsto_ofReal (cutoff_phase_pairings_tendsto_mass P hP ha hρ hcρ).abs rw [abs_neg, abs_of_nonneg (phaseMass_bounds P hP hcal hρ hcρ hρpos).1] at ht apply le_of_tendsto ht exact Filter.Eventually.of_forall fun k ↦ test_le_weightedVariation _ _ _ (cutoff_variationTest ha hρ hcρ hρpos k) /-- A perturbation where the cutoff is locally constant leaves every recovering calibration pairing unchanged, and therefore cannot decrease the dual variation. -/ theorem phase_variation_minimizing (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {A : ℕ → (Fin n → ℝ) → Fin n → ℝ} (ha : Approximation A (leadingNormalizedField P)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) (v : (Fin n → ℝ) → ℝ) (hagree : ∀ᵐ x, v x = positivePhase P x ∨ fderiv ℝ ρ x = 0) : weightedVariation (positivePhase P) ρ ≤ weightedVariation v ρ := by rw [phase_variation_eq_mass P hP hcal ha hρ hcρ hρpos] have ht := ENNReal.tendsto_ofReal (cutoff_phase_pairings_tendsto_mass P hP ha hρ hcρ).abs rw [abs_neg, abs_of_nonneg (phaseMass_bounds P hP hcal hρ hcρ hρpos).1] at ht apply le_of_tendsto ht apply Filter.Eventually.of_forall intro k have he : (∫ x, positivePhase P x * divergence (fun i ↦ Pi.single i 1) (cutoffField ρ (A k)) x) = ∫ x, v x * divergence (fun i ↦ Pi.single i 1) (cutoffField ρ (A k)) x := by apply integral_congr_ae filter_upwards [hagree] with x hx rcases hx with he | hd · rw [he] · simp only [divergence_cutoffField hρ (ha.smooth k), ha.div_zero, mul_zero, add_zero] simp [testFlux, hd] rw [he] exact test_le_weightedVariation _ _ _ (cutoff_variationTest ha hρ hcρ hρpos k) end end Source29WeightedPhaseVariation /- Component: TopPhasePerimeter.inc -/ namespace Source29TopPhasePerimeter open MvPolynomial MeasureTheory Filter open Source29QuarticReuse Source29QuarticReuse.FluxObstruction open Source29QuarticReuse.QuarticPolynomialBasics open Source29WeakCalibrationLimits Source29PhaseMassLimit open Source29SmoothCalibrationRecovery Source29WeightedPhaseVariation open scoped Topology BigOperators ENNReal noncomputable section variable {n : ℕ} /-- Weighted perimeter in the divergence-test definition. -/ def weightedPerimeter (S : Set (Fin n → ℝ)) (ρ : (Fin n → ℝ) → ℝ) : ℝ≥0∞ := by classical exact weightedVariation (fun x ↦ if x ∈ S then 1 else 0) ρ theorem top_weakCalibration (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) : WeakCalibration (leadingNormalizedField (homogeneousComponent P.totalDegree P)) := by refine ⟨leadingNormalizedField_bound _, ?_⟩ intro φ hφ hcφ exact Source29TopWeakCalibration.top_weak_calibration P hmin hdeg hφ hcφ /-- The leading positive phase's dual perimeter equals the calibrated limiting mass. -/ theorem top_phase_perimeter_eq_mass (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) : weightedPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} ρ = ENNReal.ofReal (phaseMass (homogeneousComponent P.totalDegree P) ρ) := by exact phase_variation_eq_mass _ (top_homogeneousComponent_ne_zero P (by omega)) (top_weakCalibration P hmin hdeg) (graphField_approximation P hmin hdeg) hρ hcρ hρpos /-- Perimeter comparison with a set that differs from the leading phase only where the cutoff has zero derivative. No smoothness of either boundary is assumed. -/ theorem top_phase_perimeter_comparison (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) (K V : Set (Fin n → ℝ)) (hflat : ∀ x ∈ K, fderiv ℝ ρ x = 0) (hV : ∀ x ∉ K, (x ∈ V ↔ 0 < eval x (homogeneousComponent P.totalDegree P))) : weightedPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} ρ ≤ weightedPerimeter V ρ := by classical apply phase_variation_minimizing _ (top_homogeneousComponent_ne_zero P (by omega)) (top_weakCalibration P hmin hdeg) (graphField_approximation P hmin hdeg) hρ hcρ hρpos apply Filter.Eventually.of_forall intro x by_cases hx : x ∈ K · exact Or.inr (hflat x hx) · left change (if x ∈ V then (1 : ℝ) else 0) = if 0 < eval x (homogeneousComponent P.totalDegree P) then 1 else 0 rw [hV x hx] /-- Every compact perturbation admits a common smooth cutoff, identically one on its support, for which the leading phase minimizes dual perimeter. -/ theorem top_phase_compact_perimeter_comparison (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (K : Set (Fin n → ℝ)) (hK : IsCompact K) : ∃ ρ : (Fin n → ℝ) → ℝ, ContDiff ℝ 1 ρ ∧ HasCompactSupport ρ ∧ (∀ x, 0 ≤ ρ x) ∧ (∀ x ∈ K, ρ x = 1) ∧ ∀ V : Set (Fin n → ℝ), (∀ x ∉ K, (x ∈ V ↔ 0 < eval x (homogeneousComponent P.totalDegree P))) → weightedPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} ρ ≤ weightedPerimeter V ρ := by obtain ⟨R, hR, hKR⟩ := hK.isBounded.subset_closedBall_lt 0 (0 : Fin n → ℝ) let b : ContDiffBump (0 : Fin n → ℝ) := { rIn := R + 1, rOut := R + 2, rIn_pos := by linarith, rIn_lt_rOut := by linarith } have hball (x) (hx : x ∈ K) : x ∈ Metric.ball (0 : Fin n → ℝ) b.rIn := Metric.closedBall_subset_ball (by dsimp [b]; linarith) (hKR hx) have hflat (x) (hx : x ∈ K) : fderiv ℝ b x = 0 := by have he := b.eventuallyEq_one_of_mem_ball (hball x hx) have hd := he.fderiv_eq (𝕜 := ℝ) simpa using hd refine ⟨b, b.contDiff, b.hasCompactSupport, b.nonneg', ?_, ?_⟩ · intro x hx exact b.one_of_mem_closedBall (Metric.ball_subset_closedBall (hball x hx)) · intro V hV exact top_phase_perimeter_comparison P hmin hdeg b.contDiff b.hasCompactSupport b.nonneg' K V hflat hV end end Source29TopPhasePerimeter /- Component: LocalPhasePerimeter.inc -/ namespace Source29LocalPhasePerimeter open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction open Source29VariationConvexity Source29SmoothCalibrationRecovery open Source29WeightedPhaseVariation Source29TopPhasePerimeter open scoped Topology BigOperators ENNReal noncomputable section variable {n : ℕ} /-- A smooth compact cutoff inside an open region, equal to one near a prescribed compact set. -/ theorem exists_local_cutoff (K U : Set (Fin n → ℝ)) (hK : IsCompact K) (hU : IsOpen U) (hKU : K ⊆ U) : ∃ ρ : (Fin n → ℝ) → ℝ, ContDiff ℝ 1 ρ ∧ HasCompactSupport ρ ∧ tsupport ρ ⊆ U ∧ (∀ x, 0 ≤ ρ x ∧ ρ x ≤ 1) ∧ (∀ x ∈ K, ρ x = 1) ∧ (∀ x ∈ K, fderiv ℝ ρ x = 0) := by obtain ⟨W, hW, hKW, hWU, hcW⟩ := exists_open_between_and_isCompact_closure hK hU hKU obtain ⟨V, hV, hWV, hVU, hcV⟩ := exists_open_between_and_isCompact_closure hcW hU hWU obtain ⟨ρ, hρ, hrange, hsupp, hone⟩ := exists_contDiff_support_eq_eq_one_iff (n := 1) hV isClosed_closure hWV have hts : tsupport ρ = closure V := by simp only [tsupport, hsupp] refine ⟨ρ, hρ, ?_, hts ▸ hVU, ?_, ?_, ?_⟩ · change IsCompact (tsupport ρ) rwa [hts] · intro x exact hrange (Set.mem_range_self x) · intro x hx exact (hone x).mp (subset_closure (hKW hx)) · intro x hx have he : ρ =ᶠ[𝓝 x] (fun _ ↦ (1 : ℝ)) := Filter.eventually_of_mem (hW.mem_nhds (hKW hx)) (fun y hy ↦ (hone y).mp (subset_closure hy)) simpa using he.fderiv_eq (𝕜 := ℝ) structure LocalVariationTest (U : Set (Fin n → ℝ)) (X : (Fin n → ℝ) → Fin n → ℝ) : Prop where test : VariationTest (fun _ ↦ 1) X within : ∀ i, tsupport (fun x ↦ X x i) ⊆ U /-- Variation in an open region via compactly supported unit vector tests. -/ def localVariation (u : (Fin n → ℝ) → ℝ) (U : Set (Fin n → ℝ)) : ℝ≥0∞ := ⨆ (X : (Fin n → ℝ) → Fin n → ℝ) (_ : LocalVariationTest U X), ENNReal.ofReal |∫ x, u x * divergence (fun i ↦ Pi.single i 1) X x| def localPerimeter (S U : Set (Fin n → ℝ)) : ℝ≥0∞ := by classical exact localVariation (fun x ↦ if x ∈ S then 1 else 0) U theorem weightedVariation_le_local (u ρ : (Fin n → ℝ) → ℝ) (U : Set (Fin n → ℝ)) (hρU : tsupport ρ ⊆ U) (hρle : ∀ x, ρ x ≤ 1) : weightedVariation u ρ ≤ localVariation u U := by apply iSup_le intro X apply iSup_le intro hX have hloc : LocalVariationTest U X := by refine ⟨⟨hX.smooth, hX.compact, fun x ↦ (hX.norm_bound x).trans (hρle x)⟩, ?_⟩ intro i apply Set.Subset.trans _ hρU apply closure_mono intro x hx change ρ x ≠ 0 intro hz have hb := (coordinate_norm_le_variationDensity (X x) i).trans (hX.norm_bound x) rw [hz] at hb exact hx (norm_le_zero_iff.mp hb) exact le_iSup_of_le X (le_iSup_of_le hloc le_rfl) theorem local_test_weighted (K : Set (Fin n → ℝ)) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : VariationTest (fun _ ↦ 1) X) (hsX : ∀ i, tsupport (fun x ↦ X x i) ⊆ K) (ρ : (Fin n → ℝ) → ℝ) (hρpos : ∀ x, 0 ≤ ρ x) (hρone : ∀ x ∈ K, ρ x = 1) : VariationTest ρ X := by refine ⟨hX.smooth, hX.compact, ?_⟩ intro x by_cases hx : x ∈ K · rw [hρone x hx] exact hX.norm_bound x · have hz : X x = 0 := by ext i by_contra hne exact hx (hsX i (subset_tsupport _ hne)) rw [hz] simpa [variationDensity] using hρpos x /-- The leading phase minimizes local dual perimeter under every compact set change inside an open region. The comparison permits nonsmooth competitor boundaries. -/ theorem top_phase_local_perimeter_minimizing (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (U K V : Set (Fin n → ℝ)) (hU : IsOpen U) (hK : IsCompact K) (hKU : K ⊆ U) (hV : ∀ x ∉ K, (x ∈ V ↔ 0 < eval x (homogeneousComponent P.totalDegree P))) : localPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} U ≤ localPerimeter V U := by classical apply iSup_le intro X apply iSup_le intro hX let L := K ∪ ⋃ i, tsupport (fun x ↦ X x i) have hcL : IsCompact L := hK.union (isCompact_iUnion (fun i ↦ hX.test.compact i)) have hLU : L ⊆ U := Set.union_subset hKU (Set.iUnion_subset hX.within) obtain ⟨ρ, hρ, hcρ, hρU, hρb, hρone, hρflat⟩ := exists_local_cutoff L U hcL hU hLU have hXρ : VariationTest ρ X := local_test_weighted L X hX.test (fun i x hx ↦ Or.inr (Set.mem_iUnion.mpr ⟨i, hx⟩)) ρ (fun x ↦ (hρb x).1) hρone calc _ ≤ weightedPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} ρ := test_le_weightedVariation _ _ _ hXρ _ ≤ weightedPerimeter V ρ := top_phase_perimeter_comparison P hmin hdeg hρ hcρ (fun x ↦ (hρb x).1) K V (fun x hx ↦ hρflat x (Or.inl hx)) hV _ ≤ localPerimeter V U := weightedVariation_le_local _ _ _ hρU (fun x ↦ (hρb x).2) theorem top_phase_local_perimeter_finite (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (U : Set (Fin n → ℝ)) (hU : IsCompact (closure U)) : localPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} U < ⊤ := by obtain ⟨C, _, hC⟩ := Source29PhaseLocalVariation.top_locally_bounded_phase_variation P hmin hdeg (closure U) hU have hb : localPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} U ≤ ENNReal.ofReal C := by apply iSup_le intro X apply iSup_le intro hX exact ENNReal.ofReal_le_ofReal (hC X hX.test.smooth (fun i ↦ (subset_tsupport _).trans ((hX.within i).trans subset_closure)) hX.test.norm_bound) exact hb.trans_lt ENNReal.ofReal_lt_top /-- Local finiteness and comparison under compact perturbations, expressed entirely in the divergence-test definition of perimeter. -/ def LocallyPerimeterMinimizing (S : Set (Fin n → ℝ)) : Prop := (∀ U : Set (Fin n → ℝ), IsCompact (closure U) → localPerimeter S U < ⊤) ∧ ∀ U K V : Set (Fin n → ℝ), IsOpen U → IsCompact K → K ⊆ U → (∀ x ∉ K, (x ∈ V ↔ x ∈ S)) → localPerimeter S U ≤ localPerimeter V U theorem top_positive_phase_minimizing (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) : LocallyPerimeterMinimizing {x | 0 < eval x (homogeneousComponent P.totalDegree P)} := by exact ⟨top_phase_local_perimeter_finite P hmin hdeg, top_phase_local_perimeter_minimizing P hmin hdeg⟩ theorem top_phases_locally_perimeter_minimizing (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) : LocallyPerimeterMinimizing {x | 0 < eval x (homogeneousComponent P.totalDegree P)} ∧ LocallyPerimeterMinimizing {x | eval x (homogeneousComponent P.totalDegree P) < 0} := by refine ⟨top_positive_phase_minimizing P hmin hdeg, ?_⟩ have hm : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation (-P) := by change Source29QuarticReuse.QuarticPolynomialBasics.minimalGraphOperator (-P) = 0 rw [Source29QuarticReuse.FluxPolynomial.minimalGraphOperator_neg] exact neg_eq_zero.mpr hmin have hd : 2 ≤ (-P).totalDegree := by simpa only [totalDegree_neg] using hdeg simpa only [totalDegree_neg, map_neg, neg_pos] using top_positive_phase_minimizing (-P) hm hd end end Source29LocalPhasePerimeter /- Component: LocalPerimeterCalculus.inc -/ namespace Source29LocalPerimeterCalculus open MeasureTheory Filter open Source29QuarticReuse.FluxObstruction open Source29PhaseDivergence Source29WeightedPhaseVariation Source29LocalPhasePerimeter open scoped Topology BigOperators ENNReal noncomputable section variable {n : ℕ} theorem bounded_pairing_integrable {u : (Fin n → ℝ) → ℝ} (hu : AEStronglyMeasurable u) {B : ℝ} (hb : ∀ x, ‖u x‖ ≤ B) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ i, ContDiff ℝ 1 (fun x ↦ X x i)) (hcX : ∀ i, HasCompactSupport (fun x ↦ X x i)) : Integrable (fun x ↦ u x * divergence (fun i ↦ Pi.single i 1) X x) := (divergence_integrable X hX hcX).bdd_mul hu (Filter.Eventually.of_forall hb) theorem integral_divergence_zero (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ i, ContDiff ℝ 1 (fun x ↦ X x i)) (hcX : ∀ i, HasCompactSupport (fun x ↦ X x i)) : (∫ x, divergence (fun i ↦ Pi.single i 1) X x) = 0 := by have hi i : Integrable (fun x ↦ fderiv ℝ (fun y ↦ X y i) x (Pi.single i 1)) := (((hX i).continuous_fderiv (by norm_num)).clm_apply continuous_const).integrable_of_hasCompactSupport ((hcX i).fderiv_apply ℝ (Pi.single i 1)) have hz i : (∫ x, fderiv ℝ (fun y ↦ X y i) x (Pi.single i 1)) = 0 := by have h := integral_mul_fderiv_eq_neg_of_compactSupport (μ := volume) (g := fun _ : Fin n → ℝ ↦ (1 : ℝ)) (hX i) (hcX i) contDiff_const (Pi.single i 1) simpa using h.symm simp only [divergence, integral_finsetSum _ (fun i _ ↦ hi i), hz, Finset.sum_const_zero] theorem divergence_zero_outside {U : Set (Fin n → ℝ)} {X : (Fin n → ℝ) → Fin n → ℝ} (hX : LocalVariationTest U X) {x : Fin n → ℝ} (hx : x ∉ U) : divergence (fun i ↦ Pi.single i 1) X x = 0 := by apply Finset.sum_eq_zero intro i _ have hd : fderiv ℝ (fun y ↦ X y i) x = 0 := fderiv_of_notMem_tsupport ℝ (fun h ↦ hx (hX.within i h)) rw [hd, zero_apply] theorem localVariation_congr_ae_on {u v : (Fin n → ℝ) → ℝ} (U : Set (Fin n → ℝ)) (huv : ∀ᵐ x, x ∈ U → u x = v x) : localVariation u U = localVariation v U := by apply iSup_congr intro X apply iSup_congr intro hX congr 2 apply integral_congr_ae filter_upwards [huv] with x hx by_cases hxu : x ∈ U · rw [hx hxu] · rw [divergence_zero_outside hX hxu, mul_zero, mul_zero] theorem localVariation_mono (u : (Fin n → ℝ) → ℝ) {U V : Set (Fin n → ℝ)} (hUV : U ⊆ V) : localVariation u U ≤ localVariation u V := by apply iSup_le intro X apply iSup_le intro hX exact le_iSup_of_le X (le_iSup_of_le ⟨hX.test, fun i ↦ (hX.within i).trans hUV⟩ le_rfl) theorem localVariation_neg (u : (Fin n → ℝ) → ℝ) (U : Set (Fin n → ℝ)) : localVariation (fun x ↦ -u x) U = localVariation u U := by unfold localVariation simp only [neg_mul, integral_neg, abs_neg] theorem localVariation_add_const (u : (Fin n → ℝ) → ℝ) (c : ℝ) (U : Set (Fin n → ℝ)) : localVariation (fun x ↦ u x + c) U = localVariation u U := by apply iSup_congr intro X apply iSup_congr intro hX have hd := divergence_integrable X hX.test.smooth hX.test.compact have he : (∫ x, (u x + c) * divergence (fun i ↦ Pi.single i 1) X x) = ∫ x, u x * divergence (fun i ↦ Pi.single i 1) X x := by by_cases hi : Integrable (fun x ↦ u x * divergence (fun i ↦ Pi.single i 1) X x) · simp only [add_mul, integral_add hi (hd.const_mul c), integral_const_mul, integral_divergence_zero X hX.test.smooth hX.test.compact, mul_zero, add_zero] · have hn : ¬ Integrable (fun x ↦ (u x + c) * divergence (fun i ↦ Pi.single i 1) X x) := by intro hj apply hi convert hj.sub (hd.const_mul c) using 1 ext x simp only [Pi.sub_apply] ring rw [integral_undef hn, integral_undef hi] rw [he] theorem localVariation_add_le {u v : (Fin n → ℝ) → ℝ} (hu : AEStronglyMeasurable u) (hv : AEStronglyMeasurable v) {B C : ℝ} (hb : ∀ x, ‖u x‖ ≤ B) (hc : ∀ x, ‖v x‖ ≤ C) (U : Set (Fin n → ℝ)) : localVariation (fun x ↦ u x + v x) U ≤ localVariation u U + localVariation v U := by apply iSup_le intro X apply iSup_le intro hX have hi := bounded_pairing_integrable hu hb X hX.test.smooth hX.test.compact have hj := bounded_pairing_integrable hv hc X hX.test.smooth hX.test.compact simp only [add_mul, integral_add hi hj] calc _ ≤ ENNReal.ofReal (|∫ x, u x * divergence (fun i ↦ Pi.single i 1) X x| + |∫ x, v x * divergence (fun i ↦ Pi.single i 1) X x|) := ENNReal.ofReal_le_ofReal (abs_add_le _ _) _ = ENNReal.ofReal |∫ x, u x * divergence (fun i ↦ Pi.single i 1) X x| + ENNReal.ofReal |∫ x, v x * divergence (fun i ↦ Pi.single i 1) X x| := ENNReal.ofReal_add (abs_nonneg _) (abs_nonneg _) _ ≤ _ := by apply add_le_add · exact le_iSup_of_le X (le_iSup_of_le hX le_rfl) · exact le_iSup_of_le X (le_iSup_of_le hX le_rfl) def setIndicator (S : Set (Fin n → ℝ)) : (Fin n → ℝ) → ℝ := by classical exact fun x ↦ if x ∈ S then 1 else 0 theorem localPerimeter_eq (S U : Set (Fin n → ℝ)) : localPerimeter S U = localVariation (setIndicator S) U := rfl theorem set_indicator_measurable (S : Set (Fin n → ℝ)) (hS : MeasurableSet S) : AEStronglyMeasurable (setIndicator S) := by classical exact (measurable_const.ite hS measurable_const).aestronglyMeasurable theorem set_indicator_bound (S : Set (Fin n → ℝ)) (x : Fin n → ℝ) : ‖setIndicator S x‖ ≤ 1 := by classical unfold setIndicator split_ifs <;> norm_num theorem localPerimeter_compl (S U : Set (Fin n → ℝ)) : localPerimeter Sᶜ U = localPerimeter S U := by classical have he : setIndicator Sᶜ = fun x ↦ -setIndicator S x + 1 := by funext x by_cases hx : x ∈ S <;> simp [setIndicator, hx] rw [localPerimeter_eq, localPerimeter_eq] rw [he] have ha := localVariation_add_const (fun x ↦ -setIndicator S x) 1 U exact ha.trans (localVariation_neg (setIndicator S) U) theorem localPerimeter_disjoint_union_le (S T U : Set (Fin n → ℝ)) (hS : MeasurableSet S) (hT : MeasurableSet T) (hST : Disjoint S T) : localPerimeter (S ∪ T) U ≤ localPerimeter S U + localPerimeter T U := by classical have he : setIndicator (S ∪ T) = fun x ↦ setIndicator S x + setIndicator T x := by funext x by_cases hs : x ∈ S · have ht : x ∉ T := fun ht ↦ Set.disjoint_left.mp hST hs ht simp [setIndicator, hs, ht] · by_cases ht : x ∈ T <;> simp [setIndicator, hs, ht] rw [localPerimeter_eq, localPerimeter_eq, localPerimeter_eq] rw [he] exact localVariation_add_le (set_indicator_measurable S hS) (set_indicator_measurable T hT) (set_indicator_bound S) (set_indicator_bound T) U end end Source29LocalPerimeterCalculus /- Component: LocalPerimeterLimits.inc -/ namespace Source29LocalPerimeterLimits open MeasureTheory Filter open Source29QuarticReuse.FluxObstruction open Source29PhaseDivergence Source29LocalPhasePerimeter Source29LocalPerimeterCalculus open scoped Topology BigOperators ENNReal noncomputable section variable {n : ℕ} theorem pairing_tendsto_of_bounded_ae {u : ℕ → (Fin n → ℝ) → ℝ} {v : (Fin n → ℝ) → ℝ} (hu : ∀ k, AEStronglyMeasurable (u k)) {B : ℝ} (hb : ∀ k x, ‖u k x‖ ≤ B) (hl : ∀ᵐ x, Tendsto (fun k ↦ u k x) atTop (𝓝 (v x))) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ i, ContDiff ℝ 1 (fun x ↦ X x i)) (hcX : ∀ i, HasCompactSupport (fun x ↦ X x i)) : Tendsto (fun k ↦ ∫ x, u k x * divergence (fun i ↦ Pi.single i 1) X x) atTop (𝓝 (∫ x, v x * divergence (fun i ↦ Pi.single i 1) X x)) := by have hd := divergence_integrable X hX hcX apply tendsto_integral_of_dominated_convergence (fun x ↦ B * ‖divergence (fun i ↦ Pi.single i 1) X x‖) · intro k exact (hu k).mul hd.aestronglyMeasurable · exact hd.norm.const_mul B · intro k exact Filter.Eventually.of_forall fun x ↦ (by rw [norm_mul] exact mul_le_mul_of_nonneg_right (hb k x) (norm_nonneg _)) · filter_upwards [hl] with x hx exact hx.mul (tendsto_const_nhds (x := divergence (fun i ↦ Pi.single i 1) X x)) /-- Lower semicontinuity follows directly from convergence against compact vector tests. -/ theorem localVariation_le_liminf_of_pairings (u : ℕ → (Fin n → ℝ) → ℝ) (v : (Fin n → ℝ) → ℝ) (U : Set (Fin n → ℝ)) (hl : ∀ X : (Fin n → ℝ) → Fin n → ℝ, LocalVariationTest U X → Tendsto (fun k ↦ ∫ x, u k x * divergence (fun i ↦ Pi.single i 1) X x) atTop (𝓝 (∫ x, v x * divergence (fun i ↦ Pi.single i 1) X x))) : localVariation v U ≤ liminf (fun k ↦ localVariation (u k) U) atTop := by apply iSup_le intro X apply iSup_le intro hX have ht := ENNReal.tendsto_ofReal (hl X hX).abs rw [← ht.liminf_eq] exact liminf_le_liminf (Filter.Eventually.of_forall fun k ↦ le_iSup_of_le X (le_iSup_of_le hX le_rfl)) /-- Perimeter bounds survive uniformly bounded almost-everywhere limits. -/ theorem localVariation_le_liminf_of_bounded_ae {u : ℕ → (Fin n → ℝ) → ℝ} {v : (Fin n → ℝ) → ℝ} (hu : ∀ k, AEStronglyMeasurable (u k)) {B : ℝ} (hb : ∀ k x, ‖u k x‖ ≤ B) (hl : ∀ᵐ x, Tendsto (fun k ↦ u k x) atTop (𝓝 (v x))) (U : Set (Fin n → ℝ)) : localVariation v U ≤ liminf (fun k ↦ localVariation (u k) U) atTop := by apply localVariation_le_liminf_of_pairings intro X hX exact pairing_tendsto_of_bounded_ae hu hb hl X hX.test.smooth hX.test.compact theorem localPerimeter_le_liminf (S : ℕ → Set (Fin n → ℝ)) (T U : Set (Fin n → ℝ)) (hS : ∀ k, MeasurableSet (S k)) (hl : ∀ᵐ x, Tendsto (fun k ↦ setIndicator (S k) x) atTop (𝓝 (setIndicator T x))) : localPerimeter T U ≤ liminf (fun k ↦ localPerimeter (S k) U) atTop := by simpa only [localPerimeter_eq] using localVariation_le_liminf_of_bounded_ae (fun k ↦ set_indicator_measurable (S k) (hS k)) (fun k ↦ set_indicator_bound (S k)) hl U /-- Compactly supported tests exhaust a directed union of open regions. -/ theorem localVariation_directed_iUnion {ι : Type*} [Nonempty ι] (u : (Fin n → ℝ) → ℝ) (U : ι → Set (Fin n → ℝ)) (hU : ∀ i, IsOpen (U i)) (hdir : Directed (· ⊆ ·) U) : localVariation u (⋃ i, U i) = ⨆ i, localVariation u (U i) := by apply le_antisymm · apply iSup_le intro X apply iSup_le intro hX let K := ⋃ i, tsupport (fun x ↦ X x i) have hK : IsCompact K := isCompact_iUnion (fun i ↦ hX.test.compact i) have hKU : K ⊆ ⋃ i, U i := Set.iUnion_subset hX.within obtain ⟨j, hj⟩ := hK.elim_directed_cover U hU hKU hdir have ht : LocalVariationTest (U j) X := ⟨hX.test, fun i x hx ↦ hj (Set.mem_iUnion.mpr ⟨i, hx⟩)⟩ calc _ ≤ localVariation u (U j) := le_iSup_of_le X (le_iSup_of_le ht le_rfl) _ ≤ _ := le_iSup (fun i ↦ localVariation u (U i)) j · apply iSup_le intro i exact localVariation_mono u (Set.subset_iUnion U i) theorem localPerimeter_directed_iUnion {ι : Type*} [Nonempty ι] (S : Set (Fin n → ℝ)) (U : ι → Set (Fin n → ℝ)) (hU : ∀ i, IsOpen (U i)) (hdir : Directed (· ⊆ ·) U) : localPerimeter S (⋃ i, U i) = ⨆ i, localPerimeter S (U i) := localVariation_directed_iUnion (setIndicator S) U hU hdir end end Source29LocalPerimeterLimits /- Component: PerimeterRepresentatives.inc -/ namespace Source29PerimeterRepresentatives open MeasureTheory Filter open Source29LocalPhasePerimeter Source29LocalPerimeterCalculus open scoped Topology noncomputable section variable {n : ℕ} theorem localPerimeter_congr_ae (S T U : Set (Fin n → ℝ)) (he : ∀ᵐ x, x ∈ S ↔ x ∈ T) : localPerimeter S U = localPerimeter T U := by classical rw [localPerimeter_eq, localPerimeter_eq] apply localVariation_congr_ae_on filter_upwards [he] with x hx intro _ simp only [setIndicator, hx] /-- Complementing a locally perimeter-minimizing set preserves minimality. -/ theorem locallyPerimeterMinimizing_compl {S : Set (Fin n → ℝ)} (hS : LocallyPerimeterMinimizing S) : LocallyPerimeterMinimizing Sᶜ := by refine ⟨?_, ?_⟩ · intro U hU rw [localPerimeter_compl] exact hS.1 U hU · intro U K V hU hK hKU hV rw [localPerimeter_compl] have he : ∀ x ∉ K, (x ∈ Vᶜ ↔ x ∈ S) := by intro x hx simpa only [Set.mem_compl_iff, not_not] using not_congr (hV x hx) have h := hS.2 U K Vᶜ hU hK hKU he rwa [localPerimeter_compl] at h /-- Local minimality depends on the almost-everywhere representative only. -/ theorem locallyPerimeterMinimizing_congr_ae {S T : Set (Fin n → ℝ)} (he : ∀ᵐ x, x ∈ S ↔ x ∈ T) (hS : LocallyPerimeterMinimizing S) : LocallyPerimeterMinimizing T := by classical refine ⟨?_, ?_⟩ · intro U hU rw [← localPerimeter_congr_ae S T U he] exact hS.1 U hU · intro U K V hU hK hKU hV let W := (V ∩ K) ∪ (S \ K) have hW : ∀ x ∉ K, (x ∈ W ↔ x ∈ S) := by intro x hx simp [W, hx] have hWV : ∀ᵐ x, x ∈ W ↔ x ∈ V := by filter_upwards [he] with x hx by_cases hk : x ∈ K · simp [W, hk] · simp [W, hk, hx, hV x hk] rw [← localPerimeter_congr_ae S T U he, ← localPerimeter_congr_ae W V U hWV] exact hS.2 U K W hU hK hKU hW end end Source29PerimeterRepresentatives /- Component: LocalPerimeterMass.inc -/ namespace Source29LocalPerimeterMass open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.QuarticPolynomialBasics open Source29WeightedPhaseVariation Source29TopPhasePerimeter Source29LocalPhasePerimeter open Source29PhaseMassLimit open scoped Topology BigOperators ENNReal noncomputable section variable {n : ℕ} structure LocalWeight (U : Set (Fin n → ℝ)) (ρ : (Fin n → ℝ) → ℝ) : Prop where smooth : ContDiff ℝ 1 ρ compact : HasCompactSupport ρ within : tsupport ρ ⊆ U bound : ∀ x, 0 ≤ ρ x ∧ ρ x ≤ 1 /-- Smooth scalar cutoffs recover the entire local variation, not merely a bound. -/ theorem localVariation_eq_iSup_weighted (u : (Fin n → ℝ) → ℝ) (U : Set (Fin n → ℝ)) (hU : IsOpen U) : localVariation u U = ⨆ (ρ : (Fin n → ℝ) → ℝ) (_ : LocalWeight U ρ), weightedVariation u ρ := by apply le_antisymm · apply iSup_le intro X apply iSup_le intro hX let K := ⋃ i, tsupport (fun x ↦ X x i) have hK : IsCompact K := isCompact_iUnion (fun i ↦ hX.test.compact i) have hKU : K ⊆ U := Set.iUnion_subset hX.within obtain ⟨ρ, hρ, hcρ, hρU, hρb, hρone, _⟩ := exists_local_cutoff K U hK hU hKU have ht : VariationTest ρ X := local_test_weighted K X hX.test (fun i ↦ Set.subset_iUnion (fun i ↦ tsupport (fun x ↦ X x i)) i) ρ (fun x ↦ (hρb x).1) hρone calc _ ≤ weightedVariation u ρ := test_le_weightedVariation u ρ X ht _ ≤ _ := by apply le_iSup_of_le ρ exact le_iSup (fun _ : LocalWeight U ρ ↦ weightedVariation u ρ) ⟨hρ, hcρ, hρU, hρb⟩ · apply iSup_le intro ρ apply iSup_le intro hρ exact weightedVariation_le_local u ρ U hρ.within (fun x ↦ (hρ.bound x).2) /-- The leading phase's local perimeter is exactly its positive calibrated mass tested against all compact smooth weights between zero and one in the region. -/ theorem top_localPerimeter_eq_iSup_mass (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (U : Set (Fin n → ℝ)) (hU : IsOpen U) : localPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} U = ⨆ (ρ : (Fin n → ℝ) → ℝ) (_ : LocalWeight U ρ), ENNReal.ofReal (phaseMass (homogeneousComponent P.totalDegree P) ρ) := by classical rw [localPerimeter, localVariation_eq_iSup_weighted _ U hU] apply iSup_congr intro ρ apply iSup_congr intro hρ exact top_phase_perimeter_eq_mass P hmin hdeg hρ.smooth hρ.compact (fun x ↦ (hρ.bound x).1) end end Source29LocalPerimeterMass /- Component: PhaseMassFunctional.inc -/ namespace Source29PhaseMassFunctional open MvPolynomial MeasureTheory Filter open Source29QuarticReuse Source29QuarticReuse.FluxObstruction open Source29VariationConvexity Source29WeakCalibrationLimits open Source29NonlinearCalibration Source29SmoothPhaseTransition Source29PhaseMassLimit open Source29LocalPhasePerimeter open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem phaseMass_add (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ σ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hσ : ContDiff ℝ 1 σ) (hcσ : HasCompactSupport σ) : phaseMass P (fun x ↦ ρ x + σ x) = phaseMass P ρ + phaseMass P σ := by apply tendsto_nhds_unique (phaseMass_tendsto P hP hcal (hρ.add hσ) (hcρ.add hcσ)) convert (phaseMass_tendsto P hP hcal hρ hcρ).add (phaseMass_tendsto P hP hcal hσ hcσ) using 1 funext k simp only [add_mul] exact integral_add (localized_gradient_mass_identity P hcal hρ hcρ (transition_contDiff k) (transition_norm_le_one k)).1 (localized_gradient_mass_identity P hcal hσ hcσ (transition_contDiff k) (transition_norm_le_one k)).1 theorem phaseMass_const_mul (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (c : ℝ) : phaseMass P (fun x ↦ c * ρ x) = c * phaseMass P ρ := by apply tendsto_nhds_unique (phaseMass_tendsto P hP hcal (contDiff_const.mul hρ) hcρ.mul_left) convert (phaseMass_tendsto P hP hcal hρ hcρ).const_mul c using 1 funext k simp only [mul_assoc, integral_const_mul] /-- Positivity also gives order preservation for signed smooth weights. -/ theorem phaseMass_mono (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ σ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hσ : ContDiff ℝ 1 σ) (hcσ : HasCompactSupport σ) (hle : ∀ x, ρ x ≤ σ x) : phaseMass P ρ ≤ phaseMass P σ := by apply le_of_tendsto_of_tendsto (phaseMass_tendsto P hP hcal hρ hcρ) (phaseMass_tendsto P hP hcal hσ hcσ) apply Filter.Eventually.of_forall intro k apply integral_mono (localized_gradient_mass_identity P hcal hρ hcρ (transition_contDiff k) (transition_norm_le_one k)).1 (localized_gradient_mass_identity P hcal hσ hcσ (transition_contDiff k) (transition_norm_le_one k)).1 intro x exact mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_right (hle x) (transition_deriv_nonneg k _)) (Real.sqrt_nonneg _) theorem phaseMass_abs_le (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ σ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hσ : ContDiff ℝ 1 σ) (hcσ : HasCompactSupport σ) (C : ℝ) (hb : ∀ x, |σ x| ≤ C * ρ x) : |phaseMass P σ| ≤ C * phaseMass P ρ := by apply abs_le.mpr constructor · have h := phaseMass_mono P hP hcal (contDiff_const.mul hρ) hcρ.mul_left hσ hcσ (fun x ↦ (show -C * ρ x ≤ σ x by nlinarith [abs_le.mp (hb x)])) rw [phaseMass_const_mul P hP hcal hρ hcρ] at h linarith · have h := phaseMass_mono P hP hcal hσ hcσ (contDiff_const.mul hρ) hcρ.mul_left (fun x ↦ (abs_le.mp (hb x)).2) rwa [phaseMass_const_mul P hP hcal hρ hcρ] at h /-- On each compact support the mass functional is bounded in the uniform norm. The same cutoff and constant work for all smooth weights supported there. -/ theorem phaseMass_bounded_on_compact (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (K : Set (Fin n → ℝ)) (hK : IsCompact K) : ∃ M : ℝ, 0 ≤ M ∧ ∀ σ : (Fin n → ℝ) → ℝ, ContDiff ℝ 1 σ → HasCompactSupport σ → tsupport σ ⊆ K → ∀ C : ℝ, 0 ≤ C → (∀ x, |σ x| ≤ C) → |phaseMass P σ| ≤ C * M := by obtain ⟨ρ, hρ, hcρ, _, hρb, hρone, _⟩ := exists_local_cutoff K Set.univ hK isOpen_univ (Set.subset_univ K) refine ⟨phaseMass P ρ, (phaseMass_bounds P hP hcal hρ hcρ (fun x ↦ (hρb x).1)).1, ?_⟩ intro σ hσ hcσ hsσ C hC hb apply phaseMass_abs_le P hP hcal hρ hcρ hσ hcσ C intro x by_cases hx : x ∈ K · simpa only [hρone x hx, mul_one] using hb x · have hz : σ x = 0 := image_eq_zero_of_notMem_tsupport (fun ht ↦ hx (hsσ ht)) rw [hz, abs_zero] exact mul_nonneg hC (hρb x).1 end end Source29PhaseMassFunctional /- Component: SmoothCompactApprox.inc -/ namespace Source29SmoothCompactApprox open Source29LocalPhasePerimeter open MeasureTheory Metric open scoped Topology Convolution noncomputable section variable {n : ℕ} theorem uniform_smooth_approximation {f : (Fin n → ℝ) → ℝ} (hf : UniformContinuous f) {ε : ℝ} (hε : 0 < ε) : ∃ g : (Fin n → ℝ) → ℝ, ContDiff ℝ 1 g ∧ ∀ x, dist (g x) (f x) < ε := by obtain ⟨δ, hδ, hfδ⟩ := Metric.uniformContinuous_iff.mp hf (ε / 2) (half_pos hε) let φ : ContDiffBump (0 : Fin n → ℝ) := ⟨δ / 2, δ, half_pos hδ, half_lt_self hδ⟩ have hi : Integrable φ := φ.continuous.integrable_of_hasCompactSupport φ.hasCompactSupport have hp : 0 < ∫ x, φ x := by apply (integral_pos_iff_support_of_nonneg φ.nonneg' hi).mpr rw [φ.support_eq] exact measure_ball_pos volume 0 φ.rOut_pos let ψ : (Fin n → ℝ) → ℝ := fun x ↦ φ x / ∫ y, φ y have hs : HasCompactSupport ψ := by dsimp [ψ] simp only [div_eq_mul_inv] exact φ.hasCompactSupport.mul_right have hc : ContDiff ℝ 1 ψ := φ.contDiff.div_const _ have hψ : ∫ x, ψ x = 1 := by dsimp [ψ] rw [integral_div] exact div_self hp.ne' have hψs : Function.support ψ ⊆ ball 0 δ := by intro x hx apply φ.support_eq.subset change φ x ≠ 0 intro hz exact hx (by simp [ψ, hz]) refine ⟨convolution ψ f (ContinuousLinearMap.lsmul ℝ ℝ) volume, hs.contDiff_convolution_left _ hc hf.continuous.locallyIntegrable, ?_⟩ intro x apply lt_of_le_of_lt _ (half_lt_self hε) exact dist_convolution_le (half_pos hε).le hψs (fun y ↦ div_nonneg φ.nonneg hp.le) hψ hf.continuous.aestronglyMeasurable (fun y hy ↦ (hfδ hy).le) /-- A continuous compactly supported weight admits uniform smooth approximations whose supports all lie in one fixed compact set. -/ theorem exists_uniform_approximation (f : (Fin n → ℝ) → ℝ) (hf : Continuous f) (hcf : HasCompactSupport f) : ∃ K : Set (Fin n → ℝ), IsCompact K ∧ ∀ ε : ℝ, 0 < ε → ∃ g : (Fin n → ℝ) → ℝ, ContDiff ℝ 1 g ∧ HasCompactSupport g ∧ tsupport g ⊆ K ∧ ∀ x, |g x - f x| < ε := by obtain ⟨ρ, hρ, hcρ, _, hρb, hρone, _⟩ := exists_local_cutoff (tsupport f) Set.univ hcf isOpen_univ (Set.subset_univ _) have hu : UniformContinuous f := hf.uniformContinuous_of_tendsto_cocompact hcf.is_zero_at_infty refine ⟨tsupport ρ, hcρ, ?_⟩ intro ε hε obtain ⟨g, hg, hgf⟩ := uniform_smooth_approximation hu hε refine ⟨fun x ↦ ρ x * g x, hρ.mul hg, hcρ.mul_right, tsupport_mul_subset_left, ?_⟩ intro x have he : ρ x * f x = f x := by by_cases hx : x ∈ tsupport f · rw [hρone x hx, one_mul] · rw [image_eq_zero_of_notMem_tsupport hx, mul_zero] calc |ρ x * g x - f x| = |ρ x| * |g x - f x| := by rw [← abs_mul]; congr 1; nlinarith [he] _ ≤ 1 * |g x - f x| := mul_le_mul_of_nonneg_right (by rw [abs_of_nonneg (hρb x).1]; exact (hρb x).2) (abs_nonneg _) _ < ε := by simpa only [one_mul, Real.dist_eq] using hgf x end end Source29SmoothCompactApprox /- Component: SmoothMassLimits.inc -/ namespace Source29SmoothMassLimits open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29PhaseMassLimit Source29PhaseMassFunctional open scoped Topology noncomputable section variable {n : ℕ} theorem phaseMass_sub (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ σ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hσ : ContDiff ℝ 1 σ) (hcσ : HasCompactSupport σ) : phaseMass P (fun x ↦ ρ x - σ x) = phaseMass P ρ - phaseMass P σ := by have he : (fun x ↦ ρ x - σ x) = (fun x ↦ ρ x + (-1 : ℝ) * σ x) := by funext x ring rw [he, phaseMass_add P hP hcal hρ hcρ (contDiff_const.mul hσ) hcσ.mul_left, phaseMass_const_mul P hP hcal hσ hcσ] ring /-- Uniformly converging smooth approximations supported in a common compact set give a Cauchy sequence of masses. The limiting function need not be smooth. -/ theorem phaseMass_cauchy_of_uniform_error (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (K : Set (Fin n → ℝ)) (hK : IsCompact K) (g : ℕ → (Fin n → ℝ) → ℝ) (f : (Fin n → ℝ) → ℝ) (hg : ∀ k, ContDiff ℝ 1 (g k)) (hcg : ∀ k, HasCompactSupport (g k)) (hsg : ∀ k, tsupport (g k) ⊆ K) (η : ℕ → ℝ) (hη : ∀ k, 0 ≤ η k) (htη : Tendsto η atTop (𝓝 0)) (herr : ∀ k x, |g k x - f x| ≤ η k) : CauchySeq (fun k ↦ phaseMass P (g k)) := by obtain ⟨M, hM, hbound⟩ := phaseMass_bounded_on_compact P hP hcal K hK apply Metric.cauchySeq_iff.mpr intro ε hε have hd : 0 < ε / (2 * (M + 1)) := div_pos hε (by positivity) obtain ⟨N, hN⟩ := eventually_atTop.mp (htη.eventually (gt_mem_nhds hd)) refine ⟨N, ?_⟩ intro j hj k hk have he x : |g j x - g k x| ≤ η j + η k := by calc _ ≤ |g j x - f x| + |f x - g k x| := abs_sub_le _ _ _ _ = |g j x - f x| + |g k x - f x| := by rw [abs_sub_comm (f x)] _ ≤ _ := add_le_add (herr j x) (herr k x) have hs : tsupport (fun x ↦ g j x - g k x) ⊆ K := by apply closure_minimal _ hK.isClosed intro x hx by_contra hn have hjz := image_eq_zero_of_notMem_tsupport (fun ht ↦ hn (hsg j ht)) have hkz := image_eq_zero_of_notMem_tsupport (fun ht ↦ hn (hsg k ht)) exact hx (by simp [hjz, hkz]) have hb := hbound (fun x ↦ g j x - g k x) ((hg j).sub (hg k)) ((hcg j).sub (hcg k)) hs (η j + η k) (add_nonneg (hη j) (hη k)) he rw [phaseMass_sub P hP hcal (hg j) (hcg j) (hg k) (hcg k)] at hb rw [Real.dist_eq] apply hb.trans_lt have hsum : η j + η k < ε / (M + 1) := by have hnj := hN j hj have hnk := hN k hk have heq : ε / (2 * (M + 1)) + ε / (2 * (M + 1)) = ε / (M + 1) := by rw [mul_comm 2 (M + 1), div_mul_eq_div_div] ring linarith have hmul : (η j + η k) * (M + 1) < ε := (lt_div_iff₀ (by positivity)).mp hsum nlinarith [add_nonneg (hη j) (hη k)] theorem exists_phaseMass_limit_of_uniform_error (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (K : Set (Fin n → ℝ)) (hK : IsCompact K) (g : ℕ → (Fin n → ℝ) → ℝ) (f : (Fin n → ℝ) → ℝ) (hg : ∀ k, ContDiff ℝ 1 (g k)) (hcg : ∀ k, HasCompactSupport (g k)) (hsg : ∀ k, tsupport (g k) ⊆ K) (η : ℕ → ℝ) (hη : ∀ k, 0 ≤ η k) (htη : Tendsto η atTop (𝓝 0)) (herr : ∀ k x, |g k x - f x| ≤ η k) : ∃ m : ℝ, Tendsto (fun k ↦ phaseMass P (g k)) atTop (𝓝 m) := cauchySeq_tendsto_of_complete (phaseMass_cauchy_of_uniform_error P hP hcal K hK g f hg hcg hsg η hη htη herr) /-- Changing a smooth approximation by a uniformly vanishing error does not change its limiting mass, provided the supports remain in a common compact set. -/ theorem phaseMass_sub_tendsto_zero (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (K : Set (Fin n → ℝ)) (hK : IsCompact K) (g h : ℕ → (Fin n → ℝ) → ℝ) (hg : ∀ k, ContDiff ℝ 1 (g k)) (hcg : ∀ k, HasCompactSupport (g k)) (hsg : ∀ k, tsupport (g k) ⊆ K) (hh : ∀ k, ContDiff ℝ 1 (h k)) (hch : ∀ k, HasCompactSupport (h k)) (hsh : ∀ k, tsupport (h k) ⊆ K) (η : ℕ → ℝ) (hη : ∀ k, 0 ≤ η k) (htη : Tendsto η atTop (𝓝 0)) (herr : ∀ k x, |g k x - h k x| ≤ η k) : Tendsto (fun k ↦ phaseMass P (g k) - phaseMass P (h k)) atTop (𝓝 0) := by obtain ⟨M, _, hbound⟩ := phaseMass_bounded_on_compact P hP hcal K hK have hb k : |phaseMass P (g k) - phaseMass P (h k)| ≤ η k * M := by have hs : tsupport (fun x ↦ g k x - h k x) ⊆ K := (tsupport_binop_subset (fun a b : ℝ ↦ a - b) (sub_self 0) (g k) (h k)).trans (Set.union_subset (hsg k) (hsh k)) rw [← phaseMass_sub P hP hcal (hg k) (hcg k) (hh k) (hch k)] exact hbound _ ((hg k).sub (hh k)) ((hcg k).sub (hch k)) hs (η k) (hη k) (herr k) apply squeeze_zero_norm (fun k ↦ by simpa only [Real.norm_eq_abs] using hb k) simpa only [zero_mul] using htη.mul_const M theorem phaseMass_limit_unique_of_uniform_error (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (K : Set (Fin n → ℝ)) (hK : IsCompact K) (g h : ℕ → (Fin n → ℝ) → ℝ) (hg : ∀ k, ContDiff ℝ 1 (g k)) (hcg : ∀ k, HasCompactSupport (g k)) (hsg : ∀ k, tsupport (g k) ⊆ K) (hh : ∀ k, ContDiff ℝ 1 (h k)) (hch : ∀ k, HasCompactSupport (h k)) (hsh : ∀ k, tsupport (h k) ⊆ K) (η : ℕ → ℝ) (hη : ∀ k, 0 ≤ η k) (htη : Tendsto η atTop (𝓝 0)) (herr : ∀ k x, |g k x - h k x| ≤ η k) {a b : ℝ} (ha : Tendsto (fun k ↦ phaseMass P (g k)) atTop (𝓝 a)) (hb : Tendsto (fun k ↦ phaseMass P (h k)) atTop (𝓝 b)) : a = b := by exact sub_eq_zero.mp (tendsto_nhds_unique (ha.sub hb) (phaseMass_sub_tendsto_zero P hP hcal K hK g h hg hcg hsg hh hch hsh η hη htη herr)) end end Source29SmoothMassLimits /- Component: SmoothMassExtension.inc -/ namespace Source29SmoothMassExtension open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29PhaseMassLimit Source29PhaseMassFunctional Source29SmoothMassLimits open Source29SmoothCompactApprox open scoped Topology noncomputable section variable {n : ℕ} /-- Smooth approximations with one compact support bound and a vanishing uniform error. -/ structure Approximation (f : (Fin n → ℝ) → ℝ) where carrier : Set (Fin n → ℝ) compact_carrier : IsCompact carrier fn : ℕ → (Fin n → ℝ) → ℝ smooth : ∀ k, ContDiff ℝ 1 (fn k) compact : ∀ k, HasCompactSupport (fn k) within : ∀ k, tsupport (fn k) ⊆ carrier error : ℕ → ℝ nonneg : ∀ k, 0 ≤ error k tends : Tendsto error atTop (𝓝 0) bound : ∀ k x, |fn k x - f x| ≤ error k theorem exists_approximation (f : (Fin n → ℝ) → ℝ) (hf : Continuous f) (hcf : HasCompactSupport f) : Nonempty (Approximation f) := by classical obtain ⟨K, hK, ha⟩ := exists_uniform_approximation f hf hcf have he (k : ℕ) : 0 < (1 : ℝ) / (k + 1) := by positivity choose g hg hcg hsg hbg using fun k : ℕ ↦ ha (1 / (k + 1)) (he k) exact ⟨⟨K, hK, g, hg, hcg, hsg, (fun k ↦ 1 / (k + 1)), (fun k ↦ (he k).le), tendsto_one_div_add_atTop_nhds_zero_nat, (fun k x ↦ (hbg k x).le)⟩⟩ def constantApproximation (f : (Fin n → ℝ) → ℝ) (hf : ContDiff ℝ 1 f) (hcf : HasCompactSupport f) : Approximation f where carrier := tsupport f compact_carrier := hcf fn := fun _ ↦ f smooth := fun _ ↦ hf compact := fun _ ↦ hcf within := fun _ ↦ Set.Subset.rfl error := fun _ ↦ 0 nonneg := fun _ ↦ le_rfl tends := tendsto_const_nhds bound := fun _ _ ↦ by simp theorem approximation_has_mass (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {f : (Fin n → ℝ) → ℝ} (a : Approximation f) : ∃ m : ℝ, Tendsto (fun k ↦ phaseMass P (a.fn k)) atTop (𝓝 m) := exists_phaseMass_limit_of_uniform_error P hP hcal a.carrier a.compact_carrier a.fn f a.smooth a.compact a.within a.error a.nonneg a.tends a.bound theorem approximation_mass_unique (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {f : (Fin n → ℝ) → ℝ} (a b : Approximation f) {s t : ℝ} (hs : Tendsto (fun k ↦ phaseMass P (a.fn k)) atTop (𝓝 s)) (ht : Tendsto (fun k ↦ phaseMass P (b.fn k)) atTop (𝓝 t)) : s = t := by apply phaseMass_limit_unique_of_uniform_error P hP hcal (a.carrier ∪ b.carrier) (a.compact_carrier.union b.compact_carrier) a.fn b.fn a.smooth a.compact (fun k ↦ (a.within k).trans Set.subset_union_left) b.smooth b.compact (fun k ↦ (b.within k).trans Set.subset_union_right) (fun k ↦ a.error k + b.error k) (fun k ↦ add_nonneg (a.nonneg k) (b.nonneg k)) (by simpa using a.tends.add b.tends) ?_ hs ht intro k x calc _ ≤ |a.fn k x - f x| + |f x - b.fn k x| := abs_sub_le _ _ _ _ = |a.fn k x - f x| + |b.fn k x - f x| := by rw [abs_sub_comm (f x)] _ ≤ _ := add_le_add (a.bound k x) (b.bound k x) /-- The uniquely determined mass on functions admitting smooth compact approximations. -/ def continuousMass (P : MvPolynomial (Fin n) ℝ) (f : (Fin n → ℝ) → ℝ) : ℝ := by classical exact if h : ∃ m : ℝ, ∃ a : Approximation f, Tendsto (fun k ↦ phaseMass P (a.fn k)) atTop (𝓝 m) then Classical.choose h else 0 theorem continuousMass_tendsto (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {f : (Fin n → ℝ) → ℝ} (a : Approximation f) : Tendsto (fun k ↦ phaseMass P (a.fn k)) atTop (𝓝 (continuousMass P f)) := by classical obtain ⟨m, hm⟩ := approximation_has_mass P hP hcal a have he : ∃ m : ℝ, ∃ a : Approximation f, Tendsto (fun k ↦ phaseMass P (a.fn k)) atTop (𝓝 m) := ⟨m, a, hm⟩ unfold continuousMass rw [dite_eq_left he] obtain ⟨b, hb⟩ := Classical.choose_spec he have hmt := approximation_mass_unique P hP hcal a b hm hb rwa [← hmt] theorem continuousMass_eq_phaseMass (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {f : (Fin n → ℝ) → ℝ} (hf : ContDiff ℝ 1 f) (hcf : HasCompactSupport f) : continuousMass P f = phaseMass P f := by exact tendsto_nhds_unique (continuousMass_tendsto P hP hcal (constantApproximation f hf hcf)) tendsto_const_nhds end end Source29SmoothMassExtension /- Component: ContinuousMassAlgebra.inc -/ namespace Source29ContinuousMassAlgebra open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29PhaseMassLimit Source29PhaseMassFunctional Source29SmoothMassExtension open Source29LocalPhasePerimeter open scoped Topology noncomputable section variable {n : ℕ} def addApproximation {f g : (Fin n → ℝ) → ℝ} (a : Approximation f) (b : Approximation g) : Approximation (fun x ↦ f x + g x) where carrier := a.carrier ∪ b.carrier compact_carrier := a.compact_carrier.union b.compact_carrier fn := fun k x ↦ a.fn k x + b.fn k x smooth := fun k ↦ (a.smooth k).add (b.smooth k) compact := fun k ↦ (a.compact k).add (b.compact k) within := fun k ↦ (tsupport_binop_subset (fun a b : ℝ ↦ a + b) (zero_add 0) _ _).trans (Set.union_subset_union (a.within k) (b.within k)) error := fun k ↦ a.error k + b.error k nonneg := fun k ↦ add_nonneg (a.nonneg k) (b.nonneg k) tends := by simpa using a.tends.add b.tends bound := by intro k x calc _ = |(a.fn k x - f x) + (b.fn k x - g x)| := by congr 1; ring _ ≤ |a.fn k x - f x| + |b.fn k x - g x| := abs_add_le _ _ _ ≤ _ := add_le_add (a.bound k x) (b.bound k x) def mulApproximation {f : (Fin n → ℝ) → ℝ} (a : Approximation f) (c : ℝ) : Approximation (fun x ↦ c * f x) where carrier := a.carrier compact_carrier := a.compact_carrier fn := fun k x ↦ c * a.fn k x smooth := fun k ↦ contDiff_const.mul (a.smooth k) compact := fun k ↦ (a.compact k).mul_left within := fun k ↦ tsupport_mul_subset_right.trans (a.within k) error := fun k ↦ |c| * a.error k nonneg := fun k ↦ mul_nonneg (abs_nonneg c) (a.nonneg k) tends := by simpa using a.tends.const_mul |c| bound := by intro k x rw [← mul_sub, abs_mul] exact mul_le_mul_of_nonneg_left (a.bound k x) (abs_nonneg c) theorem continuousMass_add (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {f g : (Fin n → ℝ) → ℝ} (hf : Continuous f) (hcf : HasCompactSupport f) (hg : Continuous g) (hcg : HasCompactSupport g) : continuousMass P (fun x ↦ f x + g x) = continuousMass P f + continuousMass P g := by obtain ⟨a⟩ := exists_approximation f hf hcf obtain ⟨b⟩ := exists_approximation g hg hcg have ht := continuousMass_tendsto P hP hcal (addApproximation a b) change Tendsto (fun k ↦ phaseMass P (fun x ↦ a.fn k x + b.fn k x)) _ _ at ht simp_rw [phaseMass_add P hP hcal (a.smooth _) (a.compact _) (b.smooth _) (b.compact _)] at ht exact tendsto_nhds_unique ht ((continuousMass_tendsto P hP hcal a).add (continuousMass_tendsto P hP hcal b)) theorem continuousMass_const_mul (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {f : (Fin n → ℝ) → ℝ} (hf : Continuous f) (hcf : HasCompactSupport f) (c : ℝ) : continuousMass P (fun x ↦ c * f x) = c * continuousMass P f := by obtain ⟨a⟩ := exists_approximation f hf hcf have ht := continuousMass_tendsto P hP hcal (mulApproximation a c) change Tendsto (fun k ↦ phaseMass P (fun x ↦ c * a.fn k x)) _ _ at ht simp_rw [phaseMass_const_mul P hP hcal (a.smooth _) (a.compact _) c] at ht exact tendsto_nhds_unique ht ((continuousMass_tendsto P hP hcal a).const_mul c) theorem continuousMass_nonneg (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {f : (Fin n → ℝ) → ℝ} (hf : Continuous f) (hcf : HasCompactSupport f) (hpos : ∀ x, 0 ≤ f x) : 0 ≤ continuousMass P f := by obtain ⟨a⟩ := exists_approximation f hf hcf obtain ⟨ρ, hρ, hcρ, _, hbρ, honeρ, _⟩ := exists_local_cutoff a.carrier Set.univ a.compact_carrier isOpen_univ (Set.subset_univ _) have hb k : 0 ≤ phaseMass P (a.fn k) + a.error k * phaseMass P ρ := by have hpoint x : 0 ≤ a.fn k x + a.error k * ρ x := by by_cases hx : x ∈ a.carrier · rw [honeρ x hx, mul_one] have ha := (abs_le.mp (a.bound k x)).1 linarith [hpos x] · have hz := image_eq_zero_of_notMem_tsupport (fun ht ↦ hx (a.within k ht)) rw [hz, zero_add] exact mul_nonneg (a.nonneg k) (hbρ x).1 have hm := (phaseMass_bounds P hP hcal ((a.smooth k).add (contDiff_const.mul hρ)) ((a.compact k).add hcρ.mul_left) hpoint).1 rwa [phaseMass_add P hP hcal (a.smooth k) (a.compact k) (contDiff_const.mul hρ) hcρ.mul_left, phaseMass_const_mul P hP hcal hρ hcρ] at hm have ht := (continuousMass_tendsto P hP hcal a).add (a.tends.mul_const (phaseMass P ρ)) have hn := ge_of_tendsto ht (Filter.Eventually.of_forall hb) simpa only [zero_mul, add_zero] using hn theorem continuousMass_sub (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {f g : (Fin n → ℝ) → ℝ} (hf : Continuous f) (hcf : HasCompactSupport f) (hg : Continuous g) (hcg : HasCompactSupport g) : continuousMass P (fun x ↦ f x - g x) = continuousMass P f - continuousMass P g := by have he : (fun x ↦ f x - g x) = (fun x ↦ f x + (-1 : ℝ) * g x) := by funext x ring have hneg : Continuous (fun x ↦ (-1 : ℝ) * g x) := continuous_const.mul hg have hcneg : HasCompactSupport (fun x ↦ (-1 : ℝ) * g x) := hcg.mul_left rw [he, continuousMass_add P hP hcal hf hcf hneg hcneg, continuousMass_const_mul P hP hcal hg hcg] ring theorem continuousMass_mono (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {f g : (Fin n → ℝ) → ℝ} (hf : Continuous f) (hcf : HasCompactSupport f) (hg : Continuous g) (hcg : HasCompactSupport g) (hle : ∀ x, f x ≤ g x) : continuousMass P f ≤ continuousMass P g := by have hn := continuousMass_nonneg P hP hcal (hg.sub hf) (hcg.sub hcf) (fun x ↦ sub_nonneg.mpr (hle x)) change 0 ≤ continuousMass P (fun x ↦ g x - f x) at hn rw [continuousMass_sub P hP hcal hg hcg hf hcf] at hn exact sub_nonneg.mp hn end end Source29ContinuousMassAlgebra /- Component: ContinuousMassContent.inc -/ namespace Source29ContinuousMassContent open MvPolynomial MeasureTheory Filter TopologicalSpace open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29SmoothMassExtension Source29ContinuousMassAlgebra Source29LocalPhasePerimeter open scoped Topology NNReal ENNReal noncomputable section variable {n : ℕ} structure Majorant (K : Set (Fin n → ℝ)) (f : (Fin n → ℝ) → ℝ) : Prop where continuous : Continuous f compact : HasCompactSupport f nonneg : ∀ x, 0 ≤ f x one_le : ∀ x ∈ K, 1 ≤ f x def compactMass (P : MvPolynomial (Fin n) ℝ) (K : Compacts (Fin n → ℝ)) : ℝ≥0 := sInf ((fun f : (Fin n → ℝ) → ℝ ↦ (continuousMass P f).toNNReal) '' {f | Majorant (K : Set (Fin n → ℝ)) f}) theorem majorant_image_nonempty (P : MvPolynomial (Fin n) ℝ) (K : Compacts (Fin n → ℝ)) : ((fun f : (Fin n → ℝ) → ℝ ↦ (continuousMass P f).toNNReal) '' {f | Majorant (K : Set (Fin n → ℝ)) f}).Nonempty := by obtain ⟨ρ, hρ, hcρ, _, hb, hone, _⟩ := exists_local_cutoff (K : Set (Fin n → ℝ)) Set.univ K.isCompact isOpen_univ (Set.subset_univ _) exact ⟨_, ρ, ⟨hρ.continuous, hcρ, fun x ↦ (hb x).1, fun x hx ↦ (hone x hx).ge⟩, rfl⟩ theorem compactMass_le (P : MvPolynomial (Fin n) ℝ) {K : Compacts (Fin n → ℝ)} {f : (Fin n → ℝ) → ℝ} (hf : Majorant K f) : compactMass P K ≤ (continuousMass P f).toNNReal := csInf_le (OrderBot.bddBelow _) ⟨f, hf, rfl⟩ theorem compactMass_mono (P : MvPolynomial (Fin n) ℝ) {K L : Compacts (Fin n → ℝ)} (hKL : (K : Set (Fin n → ℝ)) ⊆ L) : compactMass P K ≤ compactMass P L := by apply le_csInf (majorant_image_nonempty P L) rintro _ ⟨f, hf, rfl⟩ exact compactMass_le P ⟨hf.continuous, hf.compact, hf.nonneg, fun x hx ↦ hf.one_le x (hKL hx)⟩ theorem exists_majorant_lt (P : MvPolynomial (Fin n) ℝ) (K : Compacts (Fin n → ℝ)) {ε : ℝ≥0} (hε : 0 < ε) : ∃ f : (Fin n → ℝ) → ℝ, Majorant K f ∧ (continuousMass P f).toNNReal < compactMass P K + ε := by obtain ⟨a, ⟨f, hf, rfl⟩, ha⟩ := exists_lt_of_csInf_lt (majorant_image_nonempty P K) (lt_add_of_pos_right (compactMass P K) hε) exact ⟨f, hf, ha⟩ theorem compactMass_sup_le (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (K L : Compacts (Fin n → ℝ)) : compactMass P (K ⊔ L) ≤ compactMass P K + compactMass P L := by apply _root_.le_of_forall_pos_le_add intro ε hε obtain ⟨f, hf, hfm⟩ := exists_majorant_lt P K (half_pos hε) obtain ⟨g, hg, hgm⟩ := exists_majorant_lt P L (half_pos hε) have hfg : Majorant (K ⊔ L : Compacts (Fin n → ℝ)) (fun x ↦ f x + g x) := by refine ⟨hf.continuous.add hg.continuous, hf.compact.add hg.compact, fun x ↦ add_nonneg (hf.nonneg x) (hg.nonneg x), ?_⟩ intro x hx rcases hx with hx | hx · linarith [hf.one_le x hx, hg.nonneg x] · linarith [hg.one_le x hx, hf.nonneg x] have he : (continuousMass P (fun x ↦ f x + g x)).toNNReal = (continuousMass P f).toNNReal + (continuousMass P g).toNNReal := by rw [continuousMass_add P hP hcal hf.continuous hf.compact hg.continuous hg.compact] exact Real.toNNReal_add (continuousMass_nonneg P hP hcal hf.continuous hf.compact hf.nonneg) (continuousMass_nonneg P hP hcal hg.continuous hg.compact hg.nonneg) calc _ ≤ (continuousMass P (fun x ↦ f x + g x)).toNNReal := compactMass_le P hfg _ = (continuousMass P f).toNNReal + (continuousMass P g).toNNReal := he _ ≤ _ := by linarith theorem compactMass_sup_disjoint (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (K L : Compacts (Fin n → ℝ)) (hKL : Disjoint (K : Set (Fin n → ℝ)) L) : compactMass P (K ⊔ L) = compactMass P K + compactMass P L := by apply le_antisymm (compactMass_sup_le P hP hcal K L) apply le_csInf (majorant_image_nonempty P (K ⊔ L)) rintro _ ⟨f, hf, rfl⟩ obtain ⟨ρ, hρ, hcρ, hρL, hbρ, honeρ, _⟩ := exists_local_cutoff (K : Set (Fin n → ℝ)) (L : Set (Fin n → ℝ))ᶜ K.isCompact L.isCompact.isClosed.isOpen_compl (Set.disjoint_left.mp hKL) have hzρ x (hx : x ∈ L) : ρ x = 0 := image_eq_zero_of_notMem_tsupport (fun ht ↦ hρL ht hx) have ha : Majorant K (fun x ↦ ρ x * f x) := by refine ⟨hρ.continuous.mul hf.continuous, hf.compact.mul_left, fun x ↦ mul_nonneg (hbρ x).1 (hf.nonneg x), ?_⟩ intro x hx rw [honeρ x hx, one_mul] exact hf.one_le x (Or.inl hx) have hb : Majorant L (fun x ↦ (1 - ρ x) * f x) := by refine ⟨(continuous_const.sub hρ.continuous).mul hf.continuous, hf.compact.mul_left, fun x ↦ mul_nonneg (sub_nonneg.mpr (hbρ x).2) (hf.nonneg x), ?_⟩ intro x hx rw [hzρ x hx, sub_zero, one_mul] exact hf.one_le x (Or.inr hx) have he : (fun x ↦ ρ x * f x + (1 - ρ x) * f x) = f := by funext x ring have hm : continuousMass P (fun x ↦ ρ x * f x) + continuousMass P (fun x ↦ (1 - ρ x) * f x) = continuousMass P f := by rw [← continuousMass_add P hP hcal ha.continuous ha.compact hb.continuous hb.compact, he] calc _ ≤ (continuousMass P (fun x ↦ ρ x * f x)).toNNReal + (continuousMass P (fun x ↦ (1 - ρ x) * f x)).toNNReal := add_le_add (compactMass_le P ha) (compactMass_le P hb) _ = _ := by rw [← Real.toNNReal_add (continuousMass_nonneg P hP hcal ha.continuous ha.compact ha.nonneg) (continuousMass_nonneg P hP hcal hb.continuous hb.compact hb.nonneg), hm] def massContent (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) : Content (Fin n → ℝ) where toFun := compactMass P mono' := fun _ _ h ↦ compactMass_mono P h sup_le' := compactMass_sup_le P hP hcal sup_disjoint' := fun K L h _ _ ↦ compactMass_sup_disjoint P hP hcal K L h end end Source29ContinuousMassContent /- Component: PhasePerimeterMeasure.inc -/ namespace Source29PhasePerimeterMeasure open MvPolynomial MeasureTheory Filter TopologicalSpace open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.QuarticPolynomialBasics open Source29WeakCalibrationLimits Source29PhaseMassLimit open Source29SmoothMassExtension Source29ContinuousMassAlgebra Source29ContinuousMassContent open Source29LocalPhasePerimeter Source29LocalPerimeterMass Source29TopPhasePerimeter open scoped Topology NNReal ENNReal noncomputable section variable {n : ℕ} def massMeasure (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) : Measure (Fin n → ℝ) := (massContent P hP hcal).measure theorem massMeasure_regular (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) : (massMeasure P hP hcal).Regular := by unfold massMeasure infer_instance theorem continuousMass_le_compactMass (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {f : (Fin n → ℝ) → ℝ} (hf : Continuous f) (hcf : HasCompactSupport f) (hle : ∀ x, f x ≤ 1) : (continuousMass P f).toNNReal ≤ compactMass P ⟨tsupport f, hcf⟩ := by apply le_csInf (majorant_image_nonempty P ⟨tsupport f, hcf⟩) rintro _ ⟨g, hg, rfl⟩ apply Real.toNNReal_mono apply continuousMass_mono P hP hcal hf hcf hg.continuous hg.compact intro x by_cases hx : x ∈ tsupport f · exact (hle x).trans (hg.one_le x hx) · rw [image_eq_zero_of_notMem_tsupport hx] exact hg.nonneg x /-- This regular measure has the calibrated scalar mass as its open-set supremum. -/ theorem massMeasure_eq_iSup_mass (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (U : Set (Fin n → ℝ)) (hU : IsOpen U) : massMeasure P hP hcal U = ⨆ (ρ : (Fin n → ℝ) → ℝ) (_ : LocalWeight U ρ), ENNReal.ofReal (phaseMass P ρ) := by rw [massMeasure, Content.measure_apply _ hU.measurableSet, Content.outerMeasure_of_isOpen _ U hU, Content.innerContent] apply le_antisymm · apply iSup_le intro K apply iSup_le intro hKU obtain ⟨ρ, hρ, hcρ, hρU, hbρ, honeρ, _⟩ := exists_local_cutoff (K : Set (Fin n → ℝ)) U K.isCompact hU hKU have hm := compactMass_le P (K := K) (show Majorant K ρ from ⟨hρ.continuous, hcρ, fun x ↦ (hbρ x).1, fun x hx ↦ (honeρ x hx).ge⟩) change (compactMass P K : ℝ≥0∞) ≤ _ calc _ ≤ ((continuousMass P ρ).toNNReal : ℝ≥0∞) := ENNReal.coe_le_coe.mpr hm _ = ENNReal.ofReal (phaseMass P ρ) := by rw [continuousMass_eq_phaseMass P hP hcal hρ hcρ] rfl _ ≤ _ := by apply le_iSup_of_le ρ exact le_iSup (fun _ : LocalWeight U ρ ↦ ENNReal.ofReal (phaseMass P ρ)) ⟨hρ, hcρ, hρU, hbρ⟩ · apply iSup_le intro ρ apply iSup_le intro hρ have hm := continuousMass_le_compactMass P hP hcal hρ.smooth.continuous hρ.compact (fun x ↦ (hρ.bound x).2) calc _ = ((continuousMass P ρ).toNNReal : ℝ≥0∞) := by rw [continuousMass_eq_phaseMass P hP hcal hρ.smooth hρ.compact] rfl _ ≤ (compactMass P ⟨tsupport ρ, hρ.compact⟩ : ℝ≥0∞) := ENNReal.coe_le_coe.mpr hm _ ≤ _ := by apply le_iSup_of_le (⟨tsupport ρ, hρ.compact⟩ : Compacts (Fin n → ℝ)) exact le_iSup (fun _ : tsupport ρ ⊆ U ↦ (massContent P hP hcal) ⟨tsupport ρ, hρ.compact⟩) hρ.within /-- The actual leading positive phase has a regular perimeter measure, whose value on every open region is its full divergence-test perimeter. -/ theorem top_phase_has_perimeter_measure (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) : ∃ μ : Measure (Fin n → ℝ), μ.Regular ∧ ∀ U : Set (Fin n → ℝ), IsOpen U → μ U = localPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} U := by let F := homogeneousComponent P.totalDegree P have hF : F ≠ 0 := top_homogeneousComponent_ne_zero P (by omega) have hcal := top_weakCalibration P hmin hdeg refine ⟨massMeasure F hF hcal, massMeasure_regular F hF hcal, ?_⟩ intro U hU rw [massMeasure_eq_iSup_mass F hF hcal U hU, top_localPerimeter_eq_iSup_mass P hmin hdeg U hU] end end Source29PhasePerimeterMeasure /- Component: PhasePerimeterSupport.inc -/ namespace Source29PhasePerimeterSupport open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxPolynomial open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.QuarticPolynomialBasics open Source29LocalPhasePerimeter Source29LocalPerimeterCalculus open Source29PerimeterRepresentatives Source29PhasePerimeterMeasure open scoped Topology ENNReal noncomputable section variable {n : ℕ} theorem localVariation_zero (U : Set (Fin n → ℝ)) : localVariation (fun _ ↦ 0) U = 0 := by unfold localVariation simp theorem localVariation_const (c : ℝ) (U : Set (Fin n → ℝ)) : localVariation (fun _ ↦ c) U = 0 := by simpa only [zero_add] using (localVariation_add_const (fun _ ↦ 0) c U).trans (localVariation_zero U) theorem localPerimeter_self (S : Set (Fin n → ℝ)) : localPerimeter S S = 0 := by classical rw [localPerimeter_eq] calc _ = localVariation (fun _ ↦ 1) S := by apply localVariation_congr_ae_on exact Filter.Eventually.of_forall fun x hx ↦ by simp [setIndicator, hx] _ = 0 := localVariation_const 1 S theorem polynomial_phases_perimeter_eq (F : MvPolynomial (Fin n) ℝ) (hF : F ≠ 0) (U : Set (Fin n → ℝ)) : localPerimeter {x | eval x F < 0} U = localPerimeter {x | 0 < eval x F} U := by have he : ∀ᵐ x, x ∈ {x | eval x F < 0} ↔ x ∈ {x | 0 < eval x F}ᶜ := by filter_upwards [mvPolynomial_eval_ne_zero_ae n F hF] with x hx simp only [Set.mem_ofPred_eq, Set.mem_compl_iff, not_lt] exact ⟨le_of_lt, fun h ↦ lt_of_le_of_ne h hx⟩ rw [localPerimeter_congr_ae _ _ U he, localPerimeter_compl] /-- The two leading phases have one common regular perimeter measure, concentrated on the leading polynomial's real zero locus. -/ theorem top_phases_common_perimeter_measure (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) : ∃ μ : Measure (Fin n → ℝ), μ.Regular ∧ (∀ U : Set (Fin n → ℝ), IsOpen U → μ U = localPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} U ∧ μ U = localPerimeter {x | eval x (homogeneousComponent P.totalDegree P) < 0} U) ∧ μ {x | eval x (homogeneousComponent P.totalDegree P) ≠ 0} = 0 := by obtain ⟨μ, hμ, hpos⟩ := top_phase_has_perimeter_measure P hmin hdeg let F := homogeneousComponent P.totalDegree P have hF : F ≠ 0 := top_homogeneousComponent_ne_zero P (by omega) have hneg (U : Set (Fin n → ℝ)) (hU : IsOpen U) : μ U = localPerimeter {x | eval x F < 0} U := by rw [polynomial_phases_perimeter_eq F hF U] exact hpos U hU refine ⟨μ, hμ, fun U hU ↦ ⟨hpos U hU, hneg U hU⟩, ?_⟩ have hpopen : IsOpen {x | 0 < eval x F} := isOpen_lt continuous_const (contDiff_eval F).continuous have hnopen : IsOpen {x | eval x F < 0} := isOpen_lt (contDiff_eval F).continuous continuous_const have hpzero : μ {x | 0 < eval x F} = 0 := by rw [hpos _ hpopen] exact localPerimeter_self _ have hnzero : μ {x | eval x F < 0} = 0 := by rw [hneg _ hnopen, localPerimeter_self] have he : {x | eval x F ≠ 0} = {x | 0 < eval x F} ∪ {x | eval x F < 0} := by ext x simp only [Set.mem_ofPred_eq, Set.mem_union] exact ne_iff_lt_or_gt.trans or_comm change μ {x | eval x F ≠ 0} = 0 rw [he] apply le_antisymm _ bot_le calc _ ≤ μ {x | 0 < eval x F} + μ {x | eval x F < 0} := measure_union_le _ _ _ = 0 := by rw [hpzero, hnzero, add_zero] end end Source29PhasePerimeterSupport /- Component: ZeroVariationTests.inc -/ namespace Source29ZeroVariationTests open MeasureTheory Filter open Source29QuarticReuse.FluxObstruction open Source29VariationConvexity Source29WeightedPhaseVariation Source29LocalPhasePerimeter open scoped Topology BigOperators ENNReal noncomputable section variable {n : ℕ} def coordinateField (ψ : (Fin n → ℝ) → ℝ) (j : Fin n) (x : Fin n → ℝ) (i : Fin n) : ℝ := if i = j then ψ x else 0 theorem coordinateField_norm (ψ : (Fin n → ℝ) → ℝ) (j : Fin n) (x : Fin n → ℝ) : variationDensity (coordinateField ψ j x) = |ψ x| := by simp [variationDensity, coordinateField, Real.sqrt_sq_eq_abs] theorem coordinateField_divergence (ψ : (Fin n → ℝ) → ℝ) (j : Fin n) (x : Fin n → ℝ) : divergence (fun i ↦ Pi.single i 1) (coordinateField ψ j) x = fderiv ℝ ψ x (Pi.single j 1) := by have he i : fderiv ℝ (fun y ↦ coordinateField ψ j y i) x (Pi.single i 1) = if i = j then fderiv ℝ ψ x (Pi.single i 1) else 0 := by by_cases h : i = j <;> simp [coordinateField, h] simp only [divergence, he] simp theorem coordinateField_test {U : Set (Fin n → ℝ)} {ψ : (Fin n → ℝ) → ℝ} (hψ : ContDiff ℝ 1 ψ) (hcψ : HasCompactSupport ψ) (hsψ : tsupport ψ ⊆ U) (hbψ : ∀ x, |ψ x| ≤ 1) (j : Fin n) : LocalVariationTest U (coordinateField ψ j) := by refine ⟨⟨?_, ?_, ?_⟩, ?_⟩ · intro i by_cases h : i = j <;> simp only [coordinateField, h, ↓reduceIte] · exact hψ · exact contDiff_const · intro i by_cases h : i = j <;> simp only [coordinateField, h, ↓reduceIte] · exact hcψ · simp [HasCompactSupport] · intro x simpa only [coordinateField_norm] using hbψ x · intro i by_cases h : i = j · simpa only [coordinateField, h, ↓reduceIte] using hsψ · simp [coordinateField, h] /-- Zero local variation annihilates the derivative of every bounded scalar test. -/ theorem scalar_pairing_zero {u : (Fin n → ℝ) → ℝ} {U : Set (Fin n → ℝ)} (hu : localVariation u U = 0) {ψ : (Fin n → ℝ) → ℝ} (hψ : ContDiff ℝ 1 ψ) (hcψ : HasCompactSupport ψ) (hsψ : tsupport ψ ⊆ U) (hbψ : ∀ x, |ψ x| ≤ 1) (j : Fin n) : (∫ x, u x * fderiv ℝ ψ x (Pi.single j 1)) = 0 := by have htest := coordinateField_test hψ hcψ hsψ hbψ j have hl : ENNReal.ofReal |∫ x, u x * divergence (fun i ↦ Pi.single i 1) (coordinateField ψ j) x| ≤ localVariation u U := le_iSup_of_le _ (le_iSup_of_le htest le_rfl) simp_rw [coordinateField_divergence] at hl rw [hu] at hl exact abs_eq_zero.mp (le_antisymm (ENNReal.ofReal_eq_zero.mp (le_antisymm hl bot_le)) (abs_nonneg _)) end end Source29ZeroVariationTests /- Component: MollifiedZeroVariation.inc -/ namespace Source29MollifiedZeroVariation open MeasureTheory Filter ContinuousLinearMap open Source29LocalPhasePerimeter Source29ZeroVariationTests open scoped Topology BigOperators Convolution noncomputable section variable {n : ℕ} theorem reflection_fderiv {φ : (Fin n → ℝ) → ℝ} (hφ : ContDiff ℝ 1 φ) (y x v : Fin n → ℝ) : fderiv ℝ (fun z ↦ φ (y - z)) x v = -fderiv ℝ φ (y - x) v := by have hd := ((hφ.differentiable (by norm_num) (y - x)).hasFDerivAt).comp x ((hasFDerivAt_const y x).sub (hasFDerivAt_id x)) have he := congrArg (fun L : (Fin n → ℝ) →L[ℝ] ℝ ↦ L v) hd.fderiv simpa [Function.comp_def] using he theorem convolution_coordinate_zero {u φ : (Fin n → ℝ) → ℝ} (hu : LocallyIntegrable u) {U : Set (Fin n → ℝ)} (hzero : localVariation u U = 0) (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) (hbφ : ∀ x, |φ x| ≤ 1) (y : Fin n → ℝ) (hs : tsupport (fun x ↦ φ (y - x)) ⊆ U) (j : Fin n) : fderiv ℝ (u ⋆[lsmul ℝ ℝ, volume] φ) y (Pi.single j 1) = 0 := by have hψ : ContDiff ℝ 1 (fun x ↦ φ (y - x)) := hφ.comp (contDiff_const.sub contDiff_id) have hcψ : HasCompactSupport (fun x ↦ φ (y - x)) := hcφ.comp_homeomorph (Homeomorph.subLeft y) have hz := scalar_pairing_zero hzero hψ hcψ hs (fun x ↦ hbφ (y - x)) j simp_rw [reflection_fderiv hφ y, mul_neg, integral_neg, neg_eq_zero] at hz have hd := hcφ.hasFDerivAt_convolution_right (lsmul ℝ ℝ) hu hφ y rw [hd.fderiv, convolution_precompR_apply (lsmul ℝ ℝ) hu (hcφ.fderiv ℝ) (hφ.continuous_fderiv (by norm_num))] simpa only [convolution_def, lsmul_apply, smul_eq_mul] using hz theorem convolution_fderiv_zero {u φ : (Fin n → ℝ) → ℝ} (hu : LocallyIntegrable u) {U : Set (Fin n → ℝ)} (hzero : localVariation u U = 0) (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) (hbφ : ∀ x, |φ x| ≤ 1) (y : Fin n → ℝ) (hs : tsupport (fun x ↦ φ (y - x)) ⊆ U) : fderiv ℝ (u ⋆[lsmul ℝ ℝ, volume] φ) y = 0 := by apply ContinuousLinearMap.ext intro v have hv : v = ∑ j : Fin n, v j • Pi.single j (1 : ℝ) := by ext i simp [Pi.single_apply] rw [hv, map_sum] simp only [map_smul, convolution_coordinate_zero hu hzero hφ hcφ hbφ y hs, smul_zero, Finset.sum_const_zero, zero_apply] theorem convolution_const_on_open {u φ : (Fin n → ℝ) → ℝ} (hu : LocallyIntegrable u) {U V : Set (Fin n → ℝ)} (hzero : localVariation u U = 0) (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) (hbφ : ∀ x, |φ x| ≤ 1) (hV : IsOpen V) (hVc : IsPreconnected V) (hs : ∀ y ∈ V, tsupport (fun x ↦ φ (y - x)) ⊆ U) {a b : Fin n → ℝ} (ha : a ∈ V) (hb : b ∈ V) : (u ⋆[lsmul ℝ ℝ, volume] φ) a = (u ⋆[lsmul ℝ ℝ, volume] φ) b := by apply hV.is_const_of_fderiv_eq_zero (𝕜 := ℝ) hVc · intro x _ exact (hcφ.hasFDerivAt_convolution_right (lsmul ℝ ℝ) hu hφ x).differentiableAt.differentiableWithinAt · intro x hx exact convolution_fderiv_zero hu hzero hφ hcφ hbφ x (hs x hx) · exact ha · exact hb end end Source29MollifiedZeroVariation /- Component: PositivePerimeterBalls.inc -/ namespace Source29PositivePerimeterBalls open MeasureTheory Filter Metric ContinuousLinearMap open Source29LocalPhasePerimeter Source29LocalPerimeterCalculus open Source29MollifiedZeroVariation open scoped Topology BigOperators Convolution ENNReal noncomputable section variable {n : ℕ} theorem indicator_locallyIntegrable (S : Set (Fin n → ℝ)) (hS : MeasurableSet S) : LocallyIntegrable (setIndicator S) := by apply (locallyIntegrable_const (1 : ℝ)).mono (set_indicator_measurable S hS) exact Filter.Eventually.of_forall fun x ↦ by simpa using set_indicator_bound S x theorem reflected_bump_support (c y : Fin n → ℝ) {R : ℝ} (hR : 0 < R) (hy : y ∈ ball c (R / 2)) (φ : ContDiffBump (0 : Fin n → ℝ)) (hφ : φ.rOut ≤ R / 2) : tsupport (fun x ↦ φ (y - x)) ⊆ ball c R := by intro x hx have hxy := tsupport_comp_subset_preimage (φ : (Fin n → ℝ) → ℝ) (continuous_const.sub continuous_id) hx change y - x ∈ tsupport φ at hxy rw [φ.tsupport_eq] at hxy have hd : dist x y ≤ φ.rOut := by simpa only [mem_closedBall, dist_zero_right, ← dist_eq_norm, dist_comm y x] using hxy change dist x c < R have hdy : dist y c < R / 2 := hy calc dist x c ≤ dist x y + dist y c := dist_triangle _ _ _ _ < R := by linarith /-- If a ball contains interior points of both a set and its complement, its perimeter is positive. The proof uses only compact scalar tests and convolution. -/ theorem localPerimeter_ball_pos (S : Set (Fin n → ℝ)) (hS : MeasurableSet S) (c : Fin n → ℝ) {R : ℝ} (hR : 0 < R) {a b : Fin n → ℝ} (ha : a ∈ ball c (R / 2)) (hb : b ∈ ball c (R / 2)) {ra rb : ℝ} (hra : 0 < ra) (hrb : 0 < rb) (hapos : ball a ra ⊆ S) (hbneg : ball b rb ⊆ Sᶜ) : 0 < localPerimeter S (ball c R) := by classical by_contra hn have hz : localPerimeter S (ball c R) = 0 := le_antisymm (not_lt.mp hn) bot_le let r : ℝ := min (R / 2) (min ra rb) have hr : 0 < r := lt_min (half_pos hR) (lt_min hra hrb) let φ : ContDiffBump (0 : Fin n → ℝ) := ⟨r / 2, r, half_pos hr, half_lt_self hr⟩ have hφR : φ.rOut ≤ R / 2 := min_le_left _ _ have hφa : φ.rOut ≤ ra := (min_le_right _ _).trans (min_le_left _ _) have hφb : φ.rOut ≤ rb := (min_le_right _ _).trans (min_le_right _ _) have hi : Integrable φ := φ.continuous.integrable_of_hasCompactSupport φ.hasCompactSupport have hip : 0 < ∫ x, φ x := by apply (integral_pos_iff_support_of_nonneg φ.nonneg' hi).mpr rw [φ.support_eq] exact measure_ball_pos volume 0 φ.rOut_pos have he := convolution_const_on_open (indicator_locallyIntegrable S hS) hz φ.contDiff φ.hasCompactSupport (fun x ↦ by rw [abs_of_nonneg φ.nonneg]; exact φ.le_one) isOpen_ball (convex_ball c (R / 2)).isPreconnected (fun y hy ↦ reflected_bump_support c y hR hy φ hφR) ha hb have hca : (φ ⋆[lsmul ℝ ℝ, volume] setIndicator S) a = ∫ x, φ x := by rw [convolution_eq_right' (lsmul ℝ ℝ) φ.support_eq.subset] · have has : a ∈ S := hapos (mem_ball_self hra) simp [setIndicator, has, lsmul_apply] · intro x hx have hxs : x ∈ S := hapos (ball_subset_ball hφa hx) have has : a ∈ S := hapos (mem_ball_self hra) simp [setIndicator, hxs, has] have hcb : (φ ⋆[lsmul ℝ ℝ, volume] setIndicator S) b = 0 := by rw [convolution_eq_right' (lsmul ℝ ℝ) φ.support_eq.subset] · have hbs : b ∉ S := hbneg (mem_ball_self hrb) simp [setIndicator, hbs, lsmul_apply] · intro x hx have hxs : x ∉ S := hbneg (ball_subset_ball hφb hx) have hbs : b ∉ S := hbneg (mem_ball_self hrb) simp [setIndicator, hxs, hbs] have hcomm (x : Fin n → ℝ) : (setIndicator S ⋆[lsmul ℝ ℝ, volume] φ) x = (φ ⋆[lsmul ℝ ℝ, volume] setIndicator S) x := by rw [← convolution_flip] congr 2 ext s t simp [lsmul_apply, mul_comm] rw [hcomm a, hcomm b, hca, hcb] at he exact (ne_of_gt hip) he end end Source29PositivePerimeterBalls /- Component: TopPerimeterExactSupport.inc -/ namespace Source29TopPerimeterExactSupport open MvPolynomial MeasureTheory Filter Metric open Source29QuarticReuse.FluxPolynomial open Source29LocalPhasePerimeter Source29PhasePerimeterSupport open Source29TopLocalSign Source29PositivePerimeterBalls open scoped Topology ENNReal noncomputable section variable {n : ℕ} theorem top_localPerimeter_ball_pos (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (a : Fin n → ℝ) (ha : eval a (homogeneousComponent P.totalDegree P) = 0) (R : ℝ) (hR : 0 < R) : 0 < localPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} (ball a R) := by let F := homogeneousComponent P.totalDegree P have hop : IsOpen {x | 0 < eval x F} := isOpen_lt continuous_const (contDiff_eval F).continuous have hon : IsOpen {x | eval x F < 0} := isOpen_lt (contDiff_eval F).continuous continuous_const obtain ⟨⟨b, hb, hbn⟩, ⟨c, hc, hcp⟩⟩ := top_changes_sign_in_every_nhds P hmin hdeg a ha (ball a (R / 2)) (ball_mem_nhds a (half_pos hR)) obtain ⟨rc, hrc, hrcS⟩ := Metric.mem_nhds_iff.mp (hop.mem_nhds hcp) obtain ⟨rb, hrb, hrbS⟩ := Metric.mem_nhds_iff.mp (hon.mem_nhds hbn) apply localPerimeter_ball_pos {x | 0 < eval x F} hop.measurableSet a hR hc hb hrc hrb hrcS intro x hx exact not_lt_of_ge (show eval x F < 0 from hrbS hx).le theorem top_perimeter_positive_in_nhds (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (μ : Measure (Fin n → ℝ)) (hμ : ∀ U : Set (Fin n → ℝ), IsOpen U → μ U = localPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} U) (a : Fin n → ℝ) (ha : eval a (homogeneousComponent P.totalDegree P) = 0) (U : Set (Fin n → ℝ)) (hU : U ∈ 𝓝 a) : 0 < μ U := by obtain ⟨R, hR, hRU⟩ := Metric.mem_nhds_iff.mp hU have hp : 0 < μ (ball a R) := by rw [hμ _ isOpen_ball] exact top_localPerimeter_ball_pos P hmin hdeg a ha R hR exact hp.trans_le (measure_mono hRU) /-- The topological support of a measure, expressed by its positive neighborhoods. The challenge imports do not include the library's bundled support API. -/ def measureSupport (μ : Measure (Fin n → ℝ)) : Set (Fin n → ℝ) := {x | ∀ U : Set (Fin n → ℝ), U ∈ 𝓝 x → 0 < μ U} /-- Every leading zero lies in the actual support, not merely in a set on which the perimeter measure is concentrated. -/ theorem top_phases_exact_support (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) : ∃ μ : Measure (Fin n → ℝ), μ.Regular ∧ (∀ U : Set (Fin n → ℝ), IsOpen U → μ U = localPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} U ∧ μ U = localPerimeter {x | eval x (homogeneousComponent P.totalDegree P) < 0} U) ∧ μ {x | eval x (homogeneousComponent P.totalDegree P) ≠ 0} = 0 ∧ measureSupport μ = {x | eval x (homogeneousComponent P.totalDegree P) = 0} := by obtain ⟨μ, hreg, hμ, hz⟩ := top_phases_common_perimeter_measure P hmin hdeg refine ⟨μ, hreg, hμ, hz, ?_⟩ ext a constructor · intro ha by_contra hn have hopen : IsOpen {x | eval x (homogeneousComponent P.totalDegree P) ≠ 0} := (isClosed_eq (contDiff_eval _).continuous continuous_const).isOpen_compl have hp := ha _ (hopen.mem_nhds hn) rw [hz] at hp exact (lt_irrefl 0) hp · intro ha exact fun U hU ↦ top_perimeter_positive_in_nhds P hmin hdeg μ (fun U hU ↦ (hμ U hU).1) a ha U hU end end Source29TopPerimeterExactSupport /- Component: TransitionGradientBounds.inc -/ namespace Source29TransitionGradientBounds open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29VariationConvexity Source29SmoothCalibrationRecovery open Source29SmoothPhaseTransition Source29NonlinearCalibration Source29WeakCalibrationLimits open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem norm_linear_le_coordinate_sum (L : (Fin n → ℝ) →L[ℝ] ℝ) : ‖L‖ ≤ ∑ i : Fin n, ‖L (Pi.single i 1)‖ := by apply L.opNorm_le_bound (Finset.sum_nonneg fun _ _ ↦ norm_nonneg _) intro v have hv : v = ∑ i : Fin n, v i • Pi.single i (1 : ℝ) := by ext j simp [Pi.single_apply] calc ‖L v‖ = ‖∑ i : Fin n, v i • L (Pi.single i 1)‖ := by simpa only [map_sum, map_smul] using congrArg (fun w ↦ ‖L w‖) hv _ ≤ ∑ i : Fin n, ‖v i • L (Pi.single i 1)‖ := norm_sum_le _ _ _ ≤ ∑ i : Fin n, ‖L (Pi.single i 1)‖ * ‖v‖ := by apply Finset.sum_le_sum intro i _ rw [norm_smul, mul_comm] exact mul_le_mul_of_nonneg_left (norm_le_pi_norm v i) (norm_nonneg _) _ = _ := by rw [Finset.sum_mul] theorem transition_product_gradient_bound (P : MvPolynomial (Fin n) ℝ) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hρpos : ∀ x, 0 ≤ ρ x) (k : ℕ) (x : Fin n → ℝ) : ‖fderiv ℝ (fun y ↦ ρ y * transition k (eval y P)) x‖ ≤ transition k (eval x P) * testBound (fun i ↦ Pi.single i 1) ρ x + n * (ρ x * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x)) := by apply (norm_linear_le_coordinate_sum _).trans calc _ ≤ ∑ i : Fin n, (transition k (eval x P) * ‖fderiv ℝ ρ x (Pi.single i 1)‖ + ρ x * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x)) := by apply Finset.sum_le_sum intro i _ rw [composed_product_fderiv P hρ (transition_contDiff k)] apply (norm_add_le _ _).trans rw [norm_mul, Real.norm_eq_abs (transition k _), abs_of_nonneg (transition_bounds k _).1, norm_mul, Real.norm_eq_abs (ρ x * _), abs_of_nonneg (mul_nonneg (hρpos x) (transition_deriv_nonneg k _))] exact add_le_add le_rfl (mul_le_mul_of_nonneg_left (coordinate_norm_le_variationDensity (evaluatedGradient P x) i) (mul_nonneg (hρpos x) (transition_deriv_nonneg k _))) _ = _ := by simp [testBound, Finset.sum_add_distrib, ← Finset.mul_sum] theorem transition_product_gradient_integral_bound (P : MvPolynomial (Fin n) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) (k : ℕ) : (∫ x, ‖fderiv ℝ (fun y ↦ ρ y * transition k (eval y P)) x‖) ≤ (∫ x, testBound (fun i ↦ Pi.single i 1) ρ x * transition k (eval x P)) + n * (∫ x, ρ x * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x)) := by have hs : ContDiff ℝ 1 (fun y ↦ ρ y * transition k (eval y P)) := hρ.mul ((transition_contDiff k).comp (contDiff_eval P)) have hi : Integrable (fun x ↦ ‖fderiv ℝ (fun y ↦ ρ y * transition k (eval y P)) x‖) := (hs.continuous_fderiv (by norm_num)).norm.integrable_of_hasCompactSupport ((hcρ.mul_right).fderiv ℝ).norm have ht : Integrable (fun x ↦ testBound (fun i ↦ Pi.single i 1) ρ x * transition k (eval x P)) := by apply (testBound_integrable _ hρ hcρ).mul_bdd · exact ((transition_contDiff k).continuous.comp (contDiff_eval P).continuous).aestronglyMeasurable · exact Filter.Eventually.of_forall fun x ↦ transition_norm_le_one k (eval x P) have hm := (localized_gradient_mass_identity P hcal hρ hcρ (transition_contDiff k) (transition_norm_le_one k)).1 rw [← integral_const_mul, ← integral_add ht (hm.const_mul (n : ℝ))] apply integral_mono hi (ht.add (hm.const_mul (n : ℝ))) intro x simpa only [Pi.add_apply, mul_comm (testBound _ _ x) (transition k _)] using transition_product_gradient_bound P hρ hρpos k x end end Source29TransitionGradientBounds /- Component: SobolevLimit.inc -/ namespace Source29SobolevLimit open MeasureTheory Filter open scoped Topology NNReal ENNReal noncomputable section variable {n : ℕ} /-- A Sobolev bound survives almost-everywhere convergence when the smooth approximants have a convergent bound on their total gradient. -/ theorem sobolev_of_smooth_approximation (p : ℝ≥0) (hp : NNReal.HolderConjugate (Module.finrank ℝ (Fin n → ℝ)) p) (u : ℕ → (Fin n → ℝ) → ℝ) (hu : ∀ k, ContDiff ℝ 1 (u k)) (hcu : ∀ k, HasCompactSupport (u k)) (v : (Fin n → ℝ) → ℝ) (hv : AEStronglyMeasurable v) (hl : ∀ᵐ x, Tendsto (fun k ↦ u k x) atTop (𝓝 (v x))) (B : ℕ → ℝ) (b : ℝ) (hB : Tendsto B atTop (𝓝 b)) (hbound : ∀ k, (∫ x, ‖fderiv ℝ (u k) x‖) ≤ B k) : eLpNorm v (p : ℝ≥0∞) volume ≤ ENNReal.ofReal ((eLpNormLESNormFDerivOneConst (volume : Measure (Fin n → ℝ)) (p : ℝ) : ℝ) * b) := by let C := eLpNormLESNormFDerivOneConst (volume : Measure (Fin n → ℝ)) (p : ℝ) have hk (k : ℕ) : eLpNorm (u k) (p : ℝ≥0∞) volume ≤ ENNReal.ofReal ((C : ℝ) * B k) := by have hd : Integrable (fderiv ℝ (u k)) := ((hu k).continuous_fderiv (by norm_num)).integrable_of_hasCompactSupport ((hcu k).fderiv ℝ) calc eLpNorm (u k) (p : ℝ≥0∞) volume ≤ (C : ℝ≥0∞) * eLpNorm (fderiv ℝ (u k)) 1 volume := eLpNorm_le_eLpNorm_fderiv_one volume (hu k) (hcu k) hp _ = (C : ℝ≥0∞) * ENNReal.ofReal (∫ x, ‖fderiv ℝ (u k) x‖) := by rw [eLpNorm_one_eq_lintegral_enorm hd.aestronglyMeasurable, ofReal_integral_norm_eq_lintegral_enorm hd] _ ≤ (C : ℝ≥0∞) * ENNReal.ofReal (B k) := by gcongr; exact hbound k _ = ENNReal.ofReal ((C : ℝ) * B k) := by rw [ENNReal.ofReal_mul C.coe_nonneg, ENNReal.ofReal_coe_nnreal] have ht : Tendsto (fun k ↦ ENNReal.ofReal ((C : ℝ) * B k)) atTop (𝓝 (ENNReal.ofReal ((C : ℝ) * b))) := ENNReal.tendsto_ofReal (hB.const_mul (C : ℝ)) calc eLpNorm v (p : ℝ≥0∞) volume ≤ atTop.liminf (fun k ↦ eLpNorm (u k) (p : ℝ≥0∞) volume) := Lp.eLpNorm_lim_le_liminf_eLpNorm (fun k ↦ (hu k).continuous.aestronglyMeasurable) v hv hl _ ≤ atTop.liminf (fun k ↦ ENNReal.ofReal ((C : ℝ) * B k)) := liminf_le_liminf (Filter.Eventually.of_forall hk) _ = ENNReal.ofReal ((C : ℝ) * b) := ht.liminf_eq end end Source29SobolevLimit /- Component: PhaseSobolev.inc -/ namespace Source29PhaseSobolev open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29VariationConvexity Source29WeakCalibrationLimits open Source29SmoothPhaseTransition Source29NonlinearCalibration Source29PhaseApproximation open Source29PhaseMassLimit Source29TransitionGradientBounds Source29SobolevLimit open scoped Topology NNReal ENNReal BigOperators noncomputable section variable {n : ℕ} /-- Sobolev inequality for the positive phase of a weakly calibrated polynomial, with a compact nonnegative cutoff. -/ theorem phase_sobolev (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (p : ℝ≥0) (hp : NNReal.HolderConjugate (Module.finrank ℝ (Fin n → ℝ)) p) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) : eLpNorm (fun x ↦ ρ x * (if 0 < eval x P then 1 else 0)) (p : ℝ≥0∞) volume ≤ ENNReal.ofReal ((eLpNormLESNormFDerivOneConst (volume : Measure (Fin n → ℝ)) (p : ℝ) : ℝ) * ((∫ x, testBound (fun i ↦ Pi.single i 1) ρ x * (if 0 < eval x P then 1 else 0)) + n * phaseMass P ρ)) := by let u : ℕ → (Fin n → ℝ) → ℝ := fun k x ↦ ρ x * transition k (eval x P) have hu (k) : ContDiff ℝ 1 (u k) := hρ.mul ((transition_contDiff k).comp (contDiff_eval P)) have hcu (k) : HasCompactSupport (u k) := hcρ.mul_right have hv := (phase_weight_integrable P hP ρ (hρ.continuous.integrable_of_hasCompactSupport hcρ)).aestronglyMeasurable have hl : ∀ᵐ x, Tendsto (fun k ↦ u k x) atTop (𝓝 (ρ x * (if 0 < eval x P then 1 else 0))) := by filter_upwards [polynomial_transition_tendsto_ae P hP] with x hx exact (tendsto_const_nhds (x := ρ x)).mul hx have hB := (transition_weighted_integral P hP (testBound (fun i ↦ Pi.single i 1) ρ) (testBound_integrable _ hρ hcρ)).add ((phaseMass_tendsto P hP hcal hρ hcρ).const_mul (n : ℝ)) exact sobolev_of_smooth_approximation p hp u hu hcu _ hv hl _ _ hB (transition_product_gradient_integral_bound P hcal hρ hcρ hρpos) /-- The full polynomial minimal graph equation supplies the calibration needed for the leading phase Sobolev estimate. -/ theorem top_phase_sobolev (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (p : ℝ≥0) (hp : NNReal.HolderConjugate (Module.finrank ℝ (Fin n → ℝ)) p) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) : let F := homogeneousComponent P.totalDegree P eLpNorm (fun x ↦ ρ x * (if 0 < eval x F then 1 else 0)) (p : ℝ≥0∞) volume ≤ ENNReal.ofReal ((eLpNormLESNormFDerivOneConst (volume : Measure (Fin n → ℝ)) (p : ℝ) : ℝ) * ((∫ x, testBound (fun i ↦ Pi.single i 1) ρ x * (if 0 < eval x F then 1 else 0)) + n * phaseMass F ρ)) := by exact phase_sobolev _ (Source29QuarticReuse.QuarticPolynomialBasics.top_homogeneousComponent_ne_zero P (by omega)) (Source29TopPhasePerimeter.top_weakCalibration P hmin hdeg) p hp hρ hcρ hρpos end end Source29PhaseSobolev /- Component: PhaseVolumeBound.inc -/ namespace Source29PhaseVolumeBound open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29PhaseMassLimit Source29PhaseSobolev open scoped Topology NNReal ENNReal noncomputable section variable {n : ℕ} /-- The volume of a set on which a scalar function has norm at least one is bounded by that function's Lp norm. -/ theorem measure_rpow_le_eLpNorm (A : Set (Fin n → ℝ)) (hA : MeasurableSet A) (f : (Fin n → ℝ) → ℝ) (hf : ∀ x ∈ A, 1 ≤ ‖f x‖) (p : ℝ≥0) (hp : p ≠ 0) : volume A ^ (1 / (p : ℝ)) ≤ eLpNorm f (p : ℝ≥0∞) volume := by classical have hI : AEStronglyMeasurable (A.indicator (fun _ ↦ (1 : ℝ))) := aestronglyMeasurable_const.indicator hA have hle : eLpNorm (A.indicator (fun _ ↦ (1 : ℝ))) (p : ℝ≥0∞) volume ≤ eLpNorm f (p : ℝ≥0∞) volume := by apply eLpNorm_mono hI intro x by_cases hx : x ∈ A · simpa only [Set.indicator_of_mem hx, norm_one] using hf x hx · simp only [Set.indicator_of_notMem hx, norm_zero, norm_nonneg] simpa only [eLpNorm_indicator_const hA.nullMeasurableSet (ENNReal.coe_ne_zero.mpr hp) ENNReal.coe_ne_top, enorm_one, one_mul, ENNReal.coe_toReal] using hle /-- A cutoff equal to at least one on a measurable part of the positive phase turns the phase Sobolev estimate into a quantitative volume estimate. -/ theorem phase_volume_bound (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (p : ℝ≥0) (hp : NNReal.HolderConjugate (Module.finrank ℝ (Fin n → ℝ)) p) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) (A : Set (Fin n → ℝ)) (hA : MeasurableSet A) (hAP : ∀ x ∈ A, 0 < eval x P) (hAρ : ∀ x ∈ A, 1 ≤ ρ x) : volume A ^ (1 / (p : ℝ)) ≤ ENNReal.ofReal ((eLpNormLESNormFDerivOneConst (volume : Measure (Fin n → ℝ)) (p : ℝ) : ℝ) * ((∫ x, testBound (fun i ↦ Pi.single i 1) ρ x * (if 0 < eval x P then 1 else 0)) + n * phaseMass P ρ)) := by refine (measure_rpow_le_eLpNorm A hA _ ?_ p hp.symm.ne_zero).trans (phase_sobolev P hP hcal p hp hρ hcρ hρpos) intro x hx simp only [ite_eq_left (hAP x hx), mul_one, Real.norm_eq_abs, abs_of_nonneg (hρpos x)] exact hAρ x hx end end Source29PhaseVolumeBound /- Component: LocalPhaseSobolev.inc -/ namespace Source29LocalPhaseSobolev open MvPolynomial MeasureTheory Filter open Source29QuarticReuse Source29QuarticReuse.FluxObstruction open Source29QuarticReuse.QuarticPolynomialBasics open Source29PhaseMassLimit Source29PhaseSobolev Source29PhaseVolumeBound open Source29TopPhasePerimeter Source29LocalPhasePerimeter Source29LocalPerimeterMass open scoped Topology NNReal ENNReal BigOperators noncomputable section variable {n : ℕ} /-- A phase-volume estimate in terms of local perimeter and a cutoff-gradient integral. The weight is supported inside the region where perimeter is measured. -/ theorem top_phase_volume_le_local_perimeter (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (p : ℝ≥0) (hp : NNReal.HolderConjugate (Module.finrank ℝ (Fin n → ℝ)) p) (U A : Set (Fin n → ℝ)) (hA : MeasurableSet A) {ρ : (Fin n → ℝ) → ℝ} (hρ : LocalWeight U ρ) (hAP : ∀ x ∈ A, 0 < eval x (homogeneousComponent P.totalDegree P)) (hAρ : ∀ x ∈ A, 1 ≤ ρ x) : let F := homogeneousComponent P.totalDegree P volume A ^ (1 / (p : ℝ)) ≤ (eLpNormLESNormFDerivOneConst (volume : Measure (Fin n → ℝ)) (p : ℝ) : ℝ≥0∞) * (ENNReal.ofReal (∫ x, testBound (fun i ↦ Pi.single i 1) ρ x * (if 0 < eval x F then 1 else 0)) + (n : ℝ≥0∞) * localPerimeter {x | 0 < eval x F} U) := by let F := homogeneousComponent P.totalDegree P have hF : F ≠ 0 := top_homogeneousComponent_ne_zero P (by omega) have hcal := top_weakCalibration P hmin hdeg have hm : 0 ≤ phaseMass F ρ := (phaseMass_bounds F hF hcal hρ.smooth hρ.compact (fun x ↦ (hρ.bound x).1)).1 have hg : 0 ≤ (∫ x, testBound (fun i ↦ Pi.single i 1) ρ x * (if 0 < eval x F then 1 else 0)) := by apply integral_nonneg intro x apply mul_nonneg · exact Finset.sum_nonneg (fun _ _ ↦ norm_nonneg _) · split_ifs <;> norm_num have hmass : ENNReal.ofReal (phaseMass F ρ) ≤ localPerimeter {x | 0 < eval x F} U := by rw [← top_phase_perimeter_eq_mass P hmin hdeg hρ.smooth hρ.compact (fun x ↦ (hρ.bound x).1)] exact weightedVariation_le_local _ ρ U hρ.within (fun x ↦ (hρ.bound x).2) have hvol := phase_volume_bound F hF hcal p hp hρ.smooth hρ.compact (fun x ↦ (hρ.bound x).1) A hA hAP hAρ refine hvol.trans ?_ rw [ENNReal.ofReal_mul (NNReal.coe_nonneg _), ENNReal.ofReal_coe_nnreal, ENNReal.ofReal_add hg (mul_nonneg (Nat.cast_nonneg n) hm), ENNReal.ofReal_mul (Nat.cast_nonneg n), ENNReal.ofReal_natCast] gcongr /-- The exponent required for the eight-dimensional source29 problem. -/ theorem holder_eight : NNReal.HolderConjugate (Module.finrank ℝ (Fin 8 → ℝ)) (8 / 7) := by norm_num [Module.finrank_pi, NNReal.holderConjugate_iff_eq_conjExponent] apply NNReal.coe_injective norm_num [NNReal.coe_sub (show (1 : ℝ≥0) ≤ 8 by norm_num)] end end Source29LocalPhaseSobolev /- Component: PhaseCutoffInequality.inc -/ namespace Source29PhaseCutoffInequality open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction open Source29WeakCalibrationLimits Source29PhaseMassLimit Source29PhaseApproximation open Source29PhaseSobolev Source29PhaseVolumeBound open scoped Topology NNReal ENNReal noncomputable section variable {n : ℕ} /-- Calibration bounds the phase mass by the cutoff gradient inside the phase, so the estimate retains information about small phase volume. -/ theorem phaseMass_le_phase_gradient (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) : phaseMass P ρ ≤ ∫ x, testBound (fun i ↦ Pi.single i 1) ρ x * (if 0 < eval x P then 1 else 0) := by rw [phaseMass, ← integral_neg] apply integral_mono (phase_weight_integrable P hP _ (hcal.2 ρ hρ hcρ).1).neg (phase_weight_integrable P hP _ (testBound_integrable _ hρ hcρ)) intro x simp only [Pi.neg_apply] by_cases hx : 0 < eval x P · simp only [hx, ite_true, mul_one] exact (show -testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField P) x ≤ ‖testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField P) x‖ by simpa only [Real.norm_eq_abs] using neg_le_abs _).trans (norm_testFlux_le_testBound _ ρ _ x (hcal.1 x)) · simp only [hx, ite_false, mul_zero, neg_zero, le_refl] /-- A calibrated phase satisfies an Lp cutoff inequality with no perimeter term. -/ theorem phase_cutoff_sobolev (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (p : ℝ≥0) (hp : NNReal.HolderConjugate (Module.finrank ℝ (Fin n → ℝ)) p) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) : eLpNorm (fun x ↦ ρ x * (if 0 < eval x P then 1 else 0)) (p : ℝ≥0∞) volume ≤ ENNReal.ofReal (((n : ℝ) + 1) * (eLpNormLESNormFDerivOneConst (volume : Measure (Fin n → ℝ)) (p : ℝ) : ℝ) * (∫ x, testBound (fun i ↦ Pi.single i 1) ρ x * (if 0 < eval x P then 1 else 0))) := by refine (phase_sobolev P hP hcal p hp hρ hcρ hρpos).trans (ENNReal.ofReal_le_ofReal ?_) have hm := phaseMass_le_phase_gradient P hP hcal hρ hcρ have hc := NNReal.coe_nonneg (eLpNormLESNormFDerivOneConst (volume : Measure (Fin n → ℝ)) (p : ℝ)) nlinarith [mul_nonneg (Nat.cast_nonneg (α := ℝ) n) (sub_nonneg.mpr hm), mul_nonneg hc (mul_nonneg (Nat.cast_nonneg (α := ℝ) n) (sub_nonneg.mpr hm))] /-- The corresponding cutoff inequality for the volume of a measurable part of the calibrated phase. -/ theorem phase_cutoff_volume (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (p : ℝ≥0) (hp : NNReal.HolderConjugate (Module.finrank ℝ (Fin n → ℝ)) p) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) (A : Set (Fin n → ℝ)) (hA : MeasurableSet A) (hAP : ∀ x ∈ A, 0 < eval x P) (hAρ : ∀ x ∈ A, 1 ≤ ρ x) : volume A ^ (1 / (p : ℝ)) ≤ ENNReal.ofReal (((n : ℝ) + 1) * (eLpNormLESNormFDerivOneConst (volume : Measure (Fin n → ℝ)) (p : ℝ) : ℝ) * (∫ x, testBound (fun i ↦ Pi.single i 1) ρ x * (if 0 < eval x P then 1 else 0))) := by refine (measure_rpow_le_eLpNorm A hA _ ?_ p hp.symm.ne_zero).trans (phase_cutoff_sobolev P hP hcal p hp hρ hcρ hρpos) intro x hx simp only [ite_eq_left (hAP x hx), mul_one, Real.norm_eq_abs, abs_of_nonneg (hρpos x)] exact hAρ x hx end end Source29PhaseCutoffInequality /- Component: ScaledBallCutoff.inc -/ namespace Source29ScaledBallCutoff open MeasureTheory Filter open Source29QuarticReuse.FluxObstruction open scoped Topology BigOperators noncomputable section /-- Uniform smooth cutoffs for concentric balls. Their coordinate derivative sum is bounded by a dimension-dependent constant divided by the radius. -/ theorem exists_ball_cutoffs (n : ℕ) : ∃ C : ℝ, 0 < C ∧ ∀ (c : Fin n → ℝ) (r : ℝ), 0 < r → ∃ ρ : (Fin n → ℝ) → ℝ, ContDiff ℝ 1 ρ ∧ HasCompactSupport ρ ∧ (∀ x, 0 ≤ ρ x ∧ ρ x ≤ 1) ∧ (∀ x ∈ Metric.closedBall c r, ρ x = 1) ∧ tsupport ρ ⊆ Metric.closedBall c (2 * r) ∧ (∀ x, testBound (fun i ↦ Pi.single i 1) ρ x ≤ C / r) := by let b : ContDiffBump (0 : Fin n → ℝ) := { rIn := 1, rOut := 2, rIn_pos := by norm_num, rIn_lt_rOut := by norm_num } have hb : ContDiff ℝ 1 (b : (Fin n → ℝ) → ℝ) := b.contDiff obtain ⟨D, hD⟩ := (b.hasCompactSupport.fderiv ℝ).exists_bound_of_continuous (hb.continuous_fderiv (by norm_num)) have hD0 : 0 ≤ D := (norm_nonneg _).trans (hD 0) refine ⟨n * D + 1, by positivity, ?_⟩ intro c r hr let ρ : (Fin n → ℝ) → ℝ := fun x ↦ b (r⁻¹ • (x - c)) have hρ : ContDiff ℝ 1 ρ := hb.comp ((contDiff_id.sub contDiff_const).const_smul (r⁻¹)) have hdist (x : Fin n → ℝ) : dist (r⁻¹ • (x - c)) 0 = dist x c / r := by rw [dist_zero_right, norm_smul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr hr), ← dist_eq_norm, div_eq_mul_inv, mul_comm] have hout (x : Fin n → ℝ) (hx : x ∉ Metric.closedBall c (2 * r)) : ρ x = 0 := by apply b.zero_of_le_dist rw [hdist] dsimp [b] apply (le_div_iff₀ hr).2 exact (not_le.mp hx).le have ht : tsupport ρ ⊆ Metric.closedBall c (2 * r) := by apply closure_minimal _ Metric.isClosed_closedBall intro x hx by_contra hn exact hx (hout x hn) have hcρ : HasCompactSupport ρ := (isCompact_closedBall c (2 * r)).of_isClosed_subset isClosed_closure ht refine ⟨ρ, hρ, hcρ, (fun x ↦ ⟨b.nonneg, b.le_one⟩), ?_, ht, ?_⟩ · intro x hx apply b.one_of_mem_closedBall change dist (r⁻¹ • (x - c)) 0 ≤ 1 rw [hdist] exact (div_le_one hr).2 hx · intro x have he : fderiv ℝ ρ x = r⁻¹ • fderiv ℝ (b : (Fin n → ℝ) → ℝ) (r⁻¹ • (x - c)) := by change fderiv ℝ (fun y ↦ b (r⁻¹ • (y - c))) x = _ rw [fderiv_comp_sub c (f := fun y ↦ b (r⁻¹ • y)), fderiv_comp_smul] have hi (i : Fin n) : ‖fderiv ℝ ρ x (Pi.single i 1)‖ ≤ r⁻¹ * D := by rw [he, ContinuousLinearMap.smul_apply, norm_smul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr hr)] apply mul_le_mul_of_nonneg_left _ (inv_pos.mpr hr).le calc _ ≤ ‖fderiv ℝ (b : (Fin n → ℝ) → ℝ) (r⁻¹ • (x - c))‖ * ‖(Pi.single i (1 : ℝ) : Fin n → ℝ)‖ := ContinuousLinearMap.le_opNorm _ _ _ ≤ ‖fderiv ℝ (b : (Fin n → ℝ) → ℝ) (r⁻¹ • (x - c))‖ := by apply mul_le_of_le_one_right (norm_nonneg _) exact (pi_norm_le_iff_of_nonneg (by norm_num)).2 (fun j ↦ by by_cases h : j = i · subst j; simp · simp [Pi.single_apply, h, Ne.symm h]) _ ≤ D := hD _ calc testBound (fun i ↦ Pi.single i 1) ρ x ≤ ∑ _i : Fin n, r⁻¹ * D := Finset.sum_le_sum (fun i _ ↦ hi i) _ = (n : ℝ) * D / r := by simp [div_eq_mul_inv]; ring _ ≤ (n * D + 1) / r := (div_le_div_iff_of_pos_right hr).2 (by linarith) end end Source29ScaledBallCutoff /- Component: PhaseBallGrowth.inc -/ namespace Source29PhaseBallGrowth open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29WeakCalibrationLimits Source29PhaseApproximation Source29PhaseCutoffInequality open Source29ScaledBallCutoff open scoped Topology NNReal ENNReal noncomputable section variable {n : ℕ} theorem phase_gradient_integral_le_volume (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (B : Set (Fin n → ℝ)) (hB : MeasurableSet B) (hBfin : volume B ≠ ∞) (hs : tsupport ρ ⊆ B) (C : ℝ) (hC : ∀ x, testBound (fun i ↦ Pi.single i 1) ρ x ≤ C) : (∫ x, testBound (fun i ↦ Pi.single i 1) ρ x * (if 0 < eval x P then 1 else 0)) ≤ C * (volume (B ∩ {x | 0 < eval x P})).toReal := by classical let A := B ∩ {x | 0 < eval x P} have hA : MeasurableSet A := hB.inter (isOpen_lt continuous_const (contDiff_eval P).continuous).measurableSet have hAfin : volume A ≠ ∞ := ne_top_of_le_ne_top hBfin (measure_mono Set.inter_subset_left) have hI : Integrable (A.indicator (fun _ ↦ C)) := (integrable_indicator_iff hA).2 (integrableOn_const hAfin) have hle : (∫ x, testBound (fun i ↦ Pi.single i 1) ρ x * (if 0 < eval x P then 1 else 0)) ≤ ∫ x, A.indicator (fun _ ↦ C) x := by apply integral_mono (phase_weight_integrable P hP _ (testBound_integrable _ hρ hcρ)) hI intro x by_cases hx : x ∈ A · simp only [Set.indicator_of_mem hx, ite_eq_left (show 0 < eval x P from hx.2), mul_one] exact hC x · rw [Set.indicator_of_notMem hx] by_cases hp : 0 < eval x P · have hxb : x ∉ B := fun hb ↦ hx ⟨hb, hp⟩ have hd : fderiv ℝ ρ x = 0 := fderiv_of_notMem_tsupport ℝ (fun h ↦ hxb (hs h)) simp [testBound, hd] · simp [hp] simpa only [integral_indicator_const C hA, smul_eq_mul, measureReal_def, mul_comm] using hle /-- A scale-independent volume-growth inequality for every calibrated polynomial phase. This is the quantitative input for the density iteration. -/ theorem exists_phase_ball_growth_constant (n : ℕ) (p : ℝ≥0) (hp : NNReal.HolderConjugate (Module.finrank ℝ (Fin n → ℝ)) p) : ∃ K : ℝ, 0 < K ∧ ∀ (P : MvPolynomial (Fin n) ℝ), P ≠ 0 → WeakCalibration (leadingNormalizedField P) → ∀ (c : Fin n → ℝ) (r : ℝ), 0 < r → volume (Metric.closedBall c r ∩ {x | 0 < eval x P}) ^ (1 / (p : ℝ)) ≤ ENNReal.ofReal (K / r * (volume (Metric.closedBall c (2 * r) ∩ {x | 0 < eval x P})).toReal) := by obtain ⟨C, hCpos, hC⟩ := exists_ball_cutoffs n let S : ℝ := eLpNormLESNormFDerivOneConst (volume : Measure (Fin n → ℝ)) (p : ℝ) have hS : 0 ≤ S := NNReal.coe_nonneg _ refine ⟨((n : ℝ) + 1) * (S + 1) * C, by positivity, ?_⟩ intro P hP hcal c r hr obtain ⟨ρ, hρ, hcρ, hρb, hρone, hρs, hρC⟩ := hC c r hr have hphase : MeasurableSet {x | 0 < eval x P} := (isOpen_lt continuous_const (contDiff_eval P).continuous).measurableSet have hv := phase_cutoff_volume P hP hcal p hp hρ hcρ (fun x ↦ (hρb x).1) (Metric.closedBall c r ∩ {x | 0 < eval x P}) (Metric.isClosed_closedBall.measurableSet.inter hphase) (fun x hx ↦ hx.2) (fun x hx ↦ (hρone x hx.1).ge) have hg := phase_gradient_integral_le_volume P hP hρ hcρ (Metric.closedBall c (2 * r)) Metric.isClosed_closedBall.measurableSet (isCompact_closedBall c (2 * r)).measure_ne_top hρs (C / r) hρC refine hv.trans (ENNReal.ofReal_le_ofReal ?_) change ((n : ℝ) + 1) * S * _ ≤ _ calc _ ≤ ((n : ℝ) + 1) * S * (C / r * (volume (Metric.closedBall c (2 * r) ∩ {x | 0 < eval x P})).toReal) := mul_le_mul_of_nonneg_left hg (mul_nonneg (by positivity) hS) _ ≤ ((n : ℝ) + 1) * (S + 1) * (C / r * (volume (Metric.closedBall c (2 * r) ∩ {x | 0 < eval x P})).toReal) := by gcongr linarith _ = _ := by ring /-- The volume-growth estimate specialized to the exact dimension in source29. -/ theorem top_phase_ball_growth_eight : ∃ K : ℝ, 0 < K ∧ ∀ (P : MvPolynomial (Fin 8) ℝ), Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → ∀ (c : Fin 8 → ℝ) (r : ℝ), 0 < r → let F := homogeneousComponent P.totalDegree P volume (Metric.closedBall c r ∩ {x | 0 < eval x F}) ^ (7 / 8 : ℝ) ≤ ENNReal.ofReal (K / r * (volume (Metric.closedBall c (2 * r) ∩ {x | 0 < eval x F})).toReal) := by obtain ⟨K, hK, h⟩ := exists_phase_ball_growth_constant 8 (8 / 7) Source29LocalPhaseSobolev.holder_eight refine ⟨K, hK, ?_⟩ intro P hmin hdeg c r hr simpa only [NNReal.coe_div, NNReal.coe_ofNat, one_div_div] using h (homogeneousComponent P.totalDegree P) (Source29QuarticReuse.QuarticPolynomialBasics.top_homogeneousComponent_ne_zero P (by omega)) (Source29TopPhasePerimeter.top_weakCalibration P hmin hdeg) c r hr end end Source29PhaseBallGrowth /- Component: DyadicDensity.inc -/ namespace Source29DyadicDensity open Filter open scoped Topology noncomputable section theorem eighth_power_rpow (x : ℝ) (hx : 0 ≤ x) : (x ^ 8) ^ (7 / 8 : ℝ) = x ^ 7 := by rw [← Real.rpow_natCast_mul hx 8] norm_num /-- The density barrier propagates from a ball to its doubled ball. -/ theorem density_step {K t r v w : ℝ} (hK : 0 < K) (ht : 0 < t) (hr : 0 < r) (hsmall : 256 * K * t ≤ 1) (hv : (t * r) ^ 8 ≤ v) (hg : v ^ (7 / 8 : ℝ) ≤ K / r * w) : (t * (2 * r)) ^ 8 ≤ w := by have hp : (t * r) ^ 7 ≤ K / r * w := by rw [← eighth_power_rpow (t * r) (by positivity)] exact (Real.rpow_le_rpow (by positivity) hv (by norm_num)).trans hg have hp' : (t * r) ^ 7 * r ≤ K * w := by calc _ ≤ (K / r * w) * r := mul_le_mul_of_nonneg_right hp hr.le _ = K * w := by field_simp have hb : K * (t * (2 * r)) ^ 8 ≤ (t * r) ^ 7 * r := by have h := mul_le_mul_of_nonneg_right hsmall (mul_nonneg (pow_nonneg ht.le 7) (pow_nonneg hr.le 8)) convert h using 1 <;> ring exact (mul_le_mul_iff_right₀ hK).mp (hb.trans hp') /-- A suitable positive barrier parameter exists for every positive growth constant. -/ theorem exists_density_parameter {K : ℝ} (hK : 0 < K) : ∃ t : ℝ, 0 < t ∧ t ≤ 1 ∧ 256 * K * t ≤ 1 := by refine ⟨min 1 (1 / (256 * K)), lt_min (by norm_num) (by positivity), min_le_left _ _, ?_⟩ have h := mul_le_mul_of_nonneg_left (min_le_right (1 : ℝ) (1 / (256 * K))) (show 0 ≤ 256 * K by positivity) calc 256 * K * min 1 (1 / (256 * K)) ≤ 256 * K * (1 / (256 * K)) := h _ = 1 := by field_simp /-- A lower bound valid at sufficiently small radii extends to every radius by finitely many applications of the doubling inequality. -/ theorem density_all_radii {K t : ℝ} (hK : 0 < K) (ht : 0 < t) (hsmall : 256 * K * t ≤ 1) (v : ℝ → ℝ) (hg : ∀ r, 0 < r → v r ^ (7 / 8 : ℝ) ≤ K / r * v (2 * r)) (hbase : ∃ ε : ℝ, 0 < ε ∧ ∀ r, 0 < r → r < ε → (t * r) ^ 8 ≤ v r) : ∀ R : ℝ, 0 < R → (t * R) ^ 8 ≤ v R := by obtain ⟨ε, hε, hbase⟩ := hbase intro R hR have hlim : Tendsto (fun k : ℕ ↦ R * ((1 / 2 : ℝ) ^ k)) atTop (𝓝 0) := by simpa using (tendsto_pow_atTop_nhds_zero_of_lt_one (by norm_num : (0 : ℝ) ≤ 1 / 2) (by norm_num : (1 / 2 : ℝ) < 1)).const_mul R obtain ⟨m, hm⟩ := (hlim.eventually (gt_mem_nhds hε)).exists have hpositive : 0 < R * ((1 / 2 : ℝ) ^ m) := by positivity have hs := hbase _ hpositive hm have hd (r : ℝ) (hr : 0 < r) (hrb : (t * r) ^ 8 ≤ v r) (j : ℕ) : (t * ((2 : ℝ) ^ j * r)) ^ 8 ≤ v ((2 : ℝ) ^ j * r) := by induction j with | zero => simpa using hrb | succ j ih => have hz : 0 < (2 : ℝ) ^ j * r := by positivity have hh := density_step hK ht hz hsmall ih (hg _ hz) have he : (2 : ℝ) ^ (j + 1) * r = 2 * ((2 : ℝ) ^ j * r) := by rw [pow_succ] ring rw [he] exact hh have he : (2 : ℝ) ^ m * (R * ((1 / 2 : ℝ) ^ m)) = R := by rw [one_div, inv_pow] field_simp simpa only [he] using hd _ hpositive hs m end end Source29DyadicDensity /- Component: PhaseVolumeDensity.inc -/ namespace Source29PhaseVolumeDensity open MvPolynomial MeasureTheory Filter open Source29DyadicDensity open scoped Topology ENNReal noncomputable section /-- Real volume in a closed coordinate ball. The intersection has finite measure. -/ def ballVolume (S : Set (Fin 8 → ℝ)) (c : Fin 8 → ℝ) (r : ℝ) : ℝ := (volume (Metric.closedBall c r ∩ S)).toReal theorem ballVolume_nonneg (S : Set (Fin 8 → ℝ)) (c : Fin 8 → ℝ) (r : ℝ) : 0 ≤ ballVolume S c r := ENNReal.toReal_nonneg theorem ballVolume_mono {S T : Set (Fin 8 → ℝ)} {c d : Fin 8 → ℝ} {r s : ℝ} (h : Metric.closedBall c r ∩ S ⊆ Metric.closedBall d s ∩ T) : ballVolume S c r ≤ ballVolume T d s := by apply ENNReal.toReal_mono _ (measure_mono h) exact ne_top_of_le_ne_top (isCompact_closedBall d s).measure_ne_top (measure_mono Set.inter_subset_left) theorem ballVolume_of_subset {S : Set (Fin 8 → ℝ)} {c : Fin 8 → ℝ} {r : ℝ} (hr : 0 ≤ r) (h : Metric.closedBall c r ⊆ S) : ballVolume S c r = (2 * r) ^ 8 := by rw [ballVolume, Set.inter_eq_left.mpr h, Real.volume_pi_closedBall c hr] simp only [Fintype.card_fin, ENNReal.toReal_ofReal (by positivity : 0 ≤ (2 * r) ^ 8)] /-- Disjoint pieces of a ball have total real volume at most the ball volume. -/ theorem disjoint_ballVolumes_le {S T : Set (Fin 8 → ℝ)} (hT : MeasurableSet T) (hST : Disjoint S T) (c : Fin 8 → ℝ) (r : ℝ) (hr : 0 ≤ r) : ballVolume S c r + ballVolume T c r ≤ (2 * r) ^ 8 := by have hf (U : Set (Fin 8 → ℝ)) : volume (Metric.closedBall c r ∩ U) ≠ ∞ := ne_top_of_le_ne_top (isCompact_closedBall c r).measure_ne_top (measure_mono Set.inter_subset_left) have hd : Disjoint (Metric.closedBall c r ∩ S) (Metric.closedBall c r ∩ T) := hST.mono Set.inter_subset_right Set.inter_subset_right have hm : volume (Metric.closedBall c r ∩ S) + volume (Metric.closedBall c r ∩ T) ≤ volume (Metric.closedBall c r) := by rw [← measure_union hd (Metric.isClosed_closedBall.measurableSet.inter hT)] exact measure_mono (Set.union_subset Set.inter_subset_left Set.inter_subset_left) have h := ENNReal.toReal_mono (isCompact_closedBall c r).measure_ne_top hm rw [ENNReal.toReal_add (hf S) (hf T), Real.volume_pi_closedBall c hr] at h simpa only [ballVolume, Fintype.card_fin, ENNReal.toReal_ofReal (by positivity : 0 ≤ (2 * r) ^ 8)] using h theorem ballVolume_growth_real {S : Set (Fin 8 → ℝ)} {K : ℝ} (hK : 0 ≤ K) (hg : ∀ (c : Fin 8 → ℝ) (r : ℝ), 0 < r → volume (Metric.closedBall c r ∩ S) ^ (7 / 8 : ℝ) ≤ ENNReal.ofReal (K / r * (volume (Metric.closedBall c (2 * r) ∩ S)).toReal)) (c : Fin 8 → ℝ) (r : ℝ) (hr : 0 < r) : ballVolume S c r ^ (7 / 8 : ℝ) ≤ K / r * ballVolume S c (2 * r) := by have h := ENNReal.toReal_mono ENNReal.ofReal_ne_top (hg c r hr) rw [← ENNReal.toReal_rpow, ENNReal.toReal_ofReal (by positivity)] at h exact h /-- Every interior point of an open set with the uniform ball-growth estimate has a uniform positive volume density at every radius. -/ theorem open_set_density {K t : ℝ} (hK : 0 < K) (ht : 0 < t) (ht1 : t ≤ 1) (hsmall : 256 * K * t ≤ 1) (S : Set (Fin 8 → ℝ)) (hS : IsOpen S) (hg : ∀ (c : Fin 8 → ℝ) (r : ℝ), 0 < r → ballVolume S c r ^ (7 / 8 : ℝ) ≤ K / r * ballVolume S c (2 * r)) : ∀ c ∈ S, ∀ R : ℝ, 0 < R → (t * R) ^ 8 ≤ ballVolume S c R := by intro c hc apply density_all_radii hK ht hsmall (ballVolume S c) (hg c) obtain ⟨ε, hε, hball⟩ := Metric.isOpen_iff.mp hS c hc refine ⟨ε, hε, ?_⟩ intro r hr hrε have hsub : Metric.closedBall c r ⊆ S := (Metric.closedBall_subset_ball hrε).trans hball rw [ballVolume_of_subset hr.le hsub] gcongr linarith /-- The same estimate at closure points, with the radius halved. -/ theorem closure_density {t : ℝ} (ht : 0 < t) (S : Set (Fin 8 → ℝ)) (hinterior : ∀ c ∈ S, ∀ R : ℝ, 0 < R → (t * R) ^ 8 ≤ ballVolume S c R) : ∀ a ∈ closure S, ∀ R : ℝ, 0 < R → (t * (R / 2)) ^ 8 ≤ ballVolume S a R := by intro a ha R hR obtain ⟨c, hc, hca⟩ := Metric.mem_closure_iff.mp ha (R / 2) (by positivity) have hsub : Metric.closedBall c (R / 2) ∩ S ⊆ Metric.closedBall a R ∩ S := by intro x hx refine ⟨?_, hx.2⟩ have hx' : dist x c ≤ R / 2 := hx.1 have hc' : dist c a < R / 2 := by simpa only [dist_comm] using hca change dist x a ≤ R calc dist x a ≤ dist x c + dist c a := dist_triangle _ _ _ _ ≤ R := by linarith exact (hinterior c hc (R / 2) (by positivity)).trans (ballVolume_mono hsub) end end Source29PhaseVolumeDensity /- Component: TopPhaseDensity.inc -/ namespace Source29TopPhaseDensity open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxPolynomial Source29DyadicDensity Source29PhaseVolumeDensity open Source29PhaseBallGrowth open scoped Topology ENNReal noncomputable section /-- Every point in the closure of a leading positive phase has uniformly positive volume density, with one constant for all nonaffine solutions. -/ theorem top_positive_phase_density : ∃ d : ℝ, 0 < d ∧ ∀ (P : MvPolynomial (Fin 8) ℝ), Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → ∀ (c : Fin 8 → ℝ), 0 ≤ eval c (homogeneousComponent P.totalDegree P) → ∀ (R : ℝ), 0 < R → d * R ^ 8 ≤ ballVolume {x | 0 < eval x (homogeneousComponent P.totalDegree P)} c R := by obtain ⟨K, hK, hg⟩ := top_phase_ball_growth_eight obtain ⟨t, ht, ht1, hsmall⟩ := exists_density_parameter hK refine ⟨(t / 2) ^ 8, by positivity, ?_⟩ intro P hmin hdeg c hc R hR let S : Set (Fin 8 → ℝ) := {x | 0 < eval x (homogeneousComponent P.totalDegree P)} have hS : IsOpen S := isOpen_lt continuous_const (contDiff_eval _).continuous have hgr : ∀ (a : Fin 8 → ℝ) (r : ℝ), 0 < r → ballVolume S a r ^ (7 / 8 : ℝ) ≤ K / r * ballVolume S a (2 * r) := ballVolume_growth_real hK.le (hg P hmin hdeg) have hd := open_set_density hK ht ht1 hsmall S hS hgr have hcl : c ∈ closure S := by rw [(Source29TopPhaseBoundary.top_phase_boundaries P hmin hdeg).1] exact hc calc (t / 2) ^ 8 * R ^ 8 = (t * (R / 2)) ^ 8 := by ring _ ≤ ballVolume S c R := closure_density ht S hd c hcl R hR /-- Uniform two-sided density for the leading polynomial zero set. -/ theorem top_two_sided_density : ∃ d : ℝ, 0 < d ∧ ∀ (P : MvPolynomial (Fin 8) ℝ), Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → ∀ (c : Fin 8 → ℝ), eval c (homogeneousComponent P.totalDegree P) = 0 → ∀ (R : ℝ), 0 < R → d * R ^ 8 ≤ ballVolume {x | 0 < eval x (homogeneousComponent P.totalDegree P)} c R ∧ d * R ^ 8 ≤ ballVolume {x | eval x (homogeneousComponent P.totalDegree P) < 0} c R := by obtain ⟨d, hd, h⟩ := top_positive_phase_density refine ⟨d, hd, ?_⟩ intro P hmin hdeg c hc R hR refine ⟨h P hmin hdeg c hc.ge R hR, ?_⟩ have hm : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation (-P) := by change Source29QuarticReuse.QuarticPolynomialBasics.minimalGraphOperator (-P) = 0 rw [minimalGraphOperator_neg] exact neg_eq_zero.mpr hmin have hdeg' : 2 ≤ (-P).totalDegree := by simpa only [totalDegree_neg] using hdeg have hc' : 0 ≤ eval c (homogeneousComponent (-P).totalDegree (-P)) := by simp only [totalDegree_neg, map_neg, hc, neg_zero, le_refl] simpa only [totalDegree_neg, map_neg, neg_pos] using h (-P) hm hdeg' c hc' R hR /-- At every leading zero both phase fractions stay uniformly away from zero and from the full ball volume. -/ theorem top_two_sided_volume_bounds : ∃ d : ℝ, 0 < d ∧ ∀ (P : MvPolynomial (Fin 8) ℝ), Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → ∀ (c : Fin 8 → ℝ), eval c (homogeneousComponent P.totalDegree P) = 0 → ∀ (R : ℝ), 0 < R → d * R ^ 8 ≤ ballVolume {x | 0 < eval x (homogeneousComponent P.totalDegree P)} c R ∧ ballVolume {x | 0 < eval x (homogeneousComponent P.totalDegree P)} c R ≤ (256 - d) * R ^ 8 ∧ d * R ^ 8 ≤ ballVolume {x | eval x (homogeneousComponent P.totalDegree P) < 0} c R ∧ ballVolume {x | eval x (homogeneousComponent P.totalDegree P) < 0} c R ≤ (256 - d) * R ^ 8 := by obtain ⟨d, hd, h⟩ := top_two_sided_density refine ⟨d, hd, ?_⟩ intro P hmin hdeg c hc R hR obtain ⟨hpos, hneg⟩ := h P hmin hdeg c hc R hR have hdisj : Disjoint {x | 0 < eval x (homogeneousComponent P.totalDegree P)} {x | eval x (homogeneousComponent P.totalDegree P) < 0} := by apply Set.disjoint_left.mpr intro x hx hy exact (not_lt_of_ge (show 0 < eval x (homogeneousComponent P.totalDegree P) from hx).le) hy have hsum := disjoint_ballVolumes_le (isOpen_lt (contDiff_eval _).continuous continuous_const).measurableSet hdisj c R hR.le have hpow : (2 * R) ^ 8 = 256 * R ^ 8 := by ring rw [hpow] at hsum exact ⟨hpos, by nlinarith, hneg, by nlinarith⟩ end end Source29TopPhaseDensity /- Component: PerimeterBallUpper.inc -/ namespace Source29PerimeterBallUpper open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.QuarticPolynomialBasics Source29QuarticReuse.FluxPolynomial open Source29PhaseMassLimit Source29PhaseMassFunctional Source29PhaseCutoffInequality open Source29LocalPhasePerimeter Source29LocalPerimeterMass Source29TopPhasePerimeter open Source29ScaledBallCutoff Source29PhaseBallGrowth Source29PhaseVolumeDensity open scoped Topology ENNReal noncomputable section /-- Uniform upper growth of the leading phase perimeter on every ball. -/ theorem top_positive_perimeter_ball_upper : ∃ A : ℝ, 0 < A ∧ ∀ (P : MvPolynomial (Fin 8) ℝ), Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → ∀ (c : Fin 8 → ℝ) (r : ℝ), 0 < r → localPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} (Metric.ball c r) ≤ ENNReal.ofReal (A * r ^ 7) := by obtain ⟨C, hCpos, hC⟩ := exists_ball_cutoffs 8 refine ⟨(4 : ℝ) ^ 8 * C, by positivity, ?_⟩ intro P hmin hdeg c r hr let F := homogeneousComponent P.totalDegree P have hF : F ≠ 0 := top_homogeneousComponent_ne_zero P (by omega) have hcal := top_weakCalibration P hmin hdeg obtain ⟨η, hη, hcη, hηb, hηone, hηs, hηC⟩ := hC c r hr have hmass : phaseMass F η ≤ (4 : ℝ) ^ 8 * C * r ^ 7 := by have hi := phase_gradient_integral_le_volume F hF hη hcη (Metric.closedBall c (2 * r)) Metric.isClosed_closedBall.measurableSet (isCompact_closedBall c (2 * r)).measure_ne_top hηs (C / r) hηC have hv : ballVolume {x | 0 < eval x F} c (2 * r) ≤ (4 * r) ^ 8 := by have hm : ballVolume {x | 0 < eval x F} c (2 * r) ≤ ballVolume Set.univ c (2 * r) := ballVolume_mono (fun _ hx ↦ ⟨hx.1, Set.mem_univ _⟩) rw [ballVolume_of_subset (by positivity) (Set.subset_univ _)] at hm convert hm using 1 <;> ring calc phaseMass F η ≤ _ := phaseMass_le_phase_gradient F hF hcal hη hcη _ ≤ C / r * ballVolume {x | 0 < eval x F} c (2 * r) := hi _ ≤ C / r * (4 * r) ^ 8 := mul_le_mul_of_nonneg_left hv (by positivity) _ = (4 : ℝ) ^ 8 * C * r ^ 7 := by field_simp rw [top_localPerimeter_eq_iSup_mass P hmin hdeg _ Metric.isOpen_ball] apply iSup_le intro ρ apply iSup_le intro hρ apply ENNReal.ofReal_le_ofReal refine (phaseMass_mono F hF hcal hρ.smooth hρ.compact hη hcη ?_).trans hmass intro x by_cases hx : x ∈ Metric.ball c r · rw [hηone x (Metric.ball_subset_closedBall hx)] exact (hρ.bound x).2 · have hz : ρ x = 0 := image_eq_zero_of_notMem_tsupport (fun h ↦ hx (hρ.within h)) rw [hz] exact (hηb x).1 /-- The same growth constant works for both strict leading phases. -/ theorem top_both_perimeters_ball_upper : ∃ A : ℝ, 0 < A ∧ ∀ (P : MvPolynomial (Fin 8) ℝ), Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → ∀ (c : Fin 8 → ℝ) (r : ℝ), 0 < r → localPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} (Metric.ball c r) ≤ ENNReal.ofReal (A * r ^ 7) ∧ localPerimeter {x | eval x (homogeneousComponent P.totalDegree P) < 0} (Metric.ball c r) ≤ ENNReal.ofReal (A * r ^ 7) := by obtain ⟨A, hA, h⟩ := top_positive_perimeter_ball_upper refine ⟨A, hA, ?_⟩ intro P hmin hdeg c r hr refine ⟨h P hmin hdeg c r hr, ?_⟩ have hm : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation (-P) := by change minimalGraphOperator (-P) = 0 rw [minimalGraphOperator_neg] exact neg_eq_zero.mpr hmin have hd : 2 ≤ (-P).totalDegree := by simpa only [totalDegree_neg] using hdeg simpa only [totalDegree_neg, map_neg, neg_pos] using h (-P) hm hd c r hr end end Source29PerimeterBallUpper /- Component: IntervalOscillation.inc -/ namespace Source29IntervalOscillation open MeasureTheory Set open scoped Topology noncomputable section theorem ordered_oscillation_le_derivative_integral {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {a b x y : ℝ} (hax : a ≤ x) (hxy : x ≤ y) (hyb : y ≤ b) : ‖f y - f x‖ ≤ ∫ t in Icc a b, ‖deriv f t‖ := by have hd : Continuous (deriv f) := hf.continuous_deriv_one rw [← intervalIntegral.integral_deriv_eq_sub (fun z _ ↦ hf.differentiable (by norm_num) z) (hd.intervalIntegrable x y)] calc ‖∫ t in x..y, deriv f t‖ ≤ ∫ t in x..y, ‖deriv f t‖ := intervalIntegral.norm_integral_le_integral_norm hxy _ = ∫ t in Icc x y, ‖deriv f t‖ := by rw [intervalIntegral.integral_of_le hxy, restrict_Ioc_eq_restrict_Icc] _ ≤ ∫ t in Icc a b, ‖deriv f t‖ := by apply setIntegral_mono_set (hd.norm.integrableOn_Icc) (Filter.Eventually.of_forall fun _ ↦ norm_nonneg _) exact Filter.Eventually.of_forall fun z hz ↦ ⟨hax.trans hz.1, hz.2.trans hyb⟩ /-- Any two values on an interval differ by at most the integral of the absolute derivative over that interval. -/ theorem oscillation_le_derivative_integral {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {a b x y : ℝ} (hx : x ∈ Icc a b) (hy : y ∈ Icc a b) : ‖f x - f y‖ ≤ ∫ t in Icc a b, ‖deriv f t‖ := by rcases le_total x y with h | h · rw [norm_sub_rev] exact ordered_oscillation_le_derivative_integral hf hx.1 h hy.2 · exact ordered_oscillation_le_derivative_integral hf hy.1 h hx.2 end end Source29IntervalOscillation /- Component: CoordinateOscillation.inc -/ namespace Source29CoordinateOscillation open MeasureTheory Set open Source29IntervalOscillation open scoped Topology BigOperators noncomputable section variable {n : ℕ} def bridge (x y : Fin n → ℝ) (k : ℕ) (i : Fin n) : ℝ := if (i : ℕ) < k then y i else x i theorem bridge_zero (x y : Fin n → ℝ) : bridge x y 0 = x := by ext i simp [bridge] theorem bridge_end (x y : Fin n → ℝ) : bridge x y n = y := by ext i simp [bridge, i.isLt] theorem bridge_step (x y : Fin n → ℝ) (i : Fin n) : bridge x y ((i : ℕ) + 1) = Function.update (bridge x y i) i (y i) := by ext j by_cases h : j = i · subst j simp [bridge] · have hne : (j : ℕ) ≠ (i : ℕ) := fun he ↦ h (Fin.ext he) simp only [bridge, Function.update_of_ne h] by_cases hj : (j : ℕ) < (i : ℕ) · simp [hj, show (j : ℕ) < (i : ℕ) + 1 by omega] · simp [hj, show ¬ (j : ℕ) < (i : ℕ) + 1 by omega] theorem bridge_current (x y : Fin n → ℝ) (i : Fin n) : bridge x y i i = x i := by simp [bridge] theorem deriv_update_comp (f : (Fin n → ℝ) → ℝ) (hf : ContDiff ℝ 1 f) (x : Fin n → ℝ) (i : Fin n) (t : ℝ) : deriv (fun s ↦ f (Function.update x i s)) t = fderiv ℝ f (Function.update x i t) (Pi.single i 1) := by exact (((hf.differentiable (by norm_num) (Function.update x i t)).hasFDerivAt).comp_hasDerivAt t (hasDerivAt_update x i t)).deriv /-- Change coordinates one at a time and apply the interval derivative bound. -/ theorem box_pointwise_oscillation (f : (Fin n → ℝ) → ℝ) (hf : ContDiff ℝ 1 f) (a b x y : Fin n → ℝ) (hx : ∀ i, x i ∈ Icc (a i) (b i)) (hy : ∀ i, y i ∈ Icc (a i) (b i)) : ‖f x - f y‖ ≤ ∑ i : Fin n, ∫ t in Icc (a i) (b i), ‖fderiv ℝ f (Function.update (bridge x y i) i t) (Pi.single i 1)‖ := by have htri := dist_le_range_sum_dist (fun k ↦ f (bridge x y k)) n rw [bridge_zero, bridge_end, ← Fin.sum_univ_eq_sum_range] at htri simp only [dist_eq_norm] at htri refine htri.trans (Finset.sum_le_sum ?_) intro i _ have hs : ContDiff ℝ 1 (fun t ↦ f (Function.update (bridge x y i) i t)) := hf.comp (contDiff_update 1 (bridge x y i) i) have h := oscillation_le_derivative_integral hs (hx i) (hy i) have hstart : Function.update (bridge x y i) i (x i) = bridge x y i := by rw [← bridge_current x y i, Function.update_eq_self] rw [hstart, ← bridge_step] at h simpa only [deriv_update_comp f hf] using h end end Source29CoordinateOscillation /- Component: CoordinateRecombination.inc -/ namespace Source29CoordinateRecombination open MeasureTheory open Source29CoordinateOscillation open scoped Topology noncomputable section variable {n : ℕ} def prefixSwap (k : ℕ) : ((Fin n → ℝ) × (Fin n → ℝ)) ≃ᵐ ((Fin n → ℝ) × (Fin n → ℝ)) where toFun p := (bridge p.1 p.2 k, bridge p.2 p.1 k) invFun p := (bridge p.1 p.2 k, bridge p.2 p.1 k) left_inv p := by ext i <;> simp only [bridge] <;> split_ifs <;> rfl right_inv p := by ext i <;> simp only [bridge] <;> split_ifs <;> rfl measurable_toFun := by apply Measurable.prodMk all_goals apply measurable_pi_lambda intro i dsimp [bridge] split_ifs <;> fun_prop measurable_invFun := by apply Measurable.prodMk all_goals apply measurable_pi_lambda intro i dsimp [bridge] split_ifs <;> fun_prop /-- Exchanging the same selected coordinates between two independent vectors preserves their joint product measure. -/ theorem prefixSwap_measurePreserving (μ : Fin n → Measure ℝ) [∀ i, SigmaFinite (μ i)] (k : ℕ) : MeasurePreserving (prefixSwap (n := n) k) ((Measure.pi μ).prod (Measure.pi μ)) ((Measure.pi μ).prod (Measure.pi μ)) := by let e := MeasurableEquiv.arrowProdEquivProdArrow ℝ ℝ (Fin n) have he := measurePreserving_arrowProdEquivProdArrow ℝ ℝ (Fin n) μ μ let s : Fin n → ℝ × ℝ → ℝ × ℝ := fun i p ↦ if (i : ℕ) < k then p.swap else p have hs (i : Fin n) : MeasurePreserving (s i) ((μ i).prod (μ i)) ((μ i).prod (μ i)) := by dsimp [s] split_ifs · exact Measure.measurePreserving_swap · exact MeasurePreserving.id _ have h := he.comp ((measurePreserving_pi _ _ hs).comp he.symm) have hh : e ∘ (fun p i ↦ s i (p i)) ∘ e.symm = prefixSwap (n := n) k := by funext p apply Prod.ext all_goals funext i simp only [Function.comp_def, e, s, prefixSwap, bridge, MeasurableEquiv.arrowProdEquivProdArrow, MeasurableEquiv.coe_mk, MeasurableEquiv.symm, Equiv.arrowProdEquivProdArrow, Equiv.coe_fn_mk, Equiv.coe_fn_symm_mk] split_ifs <;> rfl rw [hh] at h exact h /-- A mixed coordinate vector has the same distribution as the original first vector, with the unused vector contributing its total mass. -/ theorem integral_bridge (μ : Fin n → Measure ℝ) [∀ i, SigmaFinite (μ i)] (k : ℕ) (f : (Fin n → ℝ) → ℝ) : (∫ p, f (bridge p.1 p.2 k) ∂((Measure.pi μ).prod (Measure.pi μ))) = (Measure.pi μ).real Set.univ * ∫ x, f x ∂Measure.pi μ := by have h := (prefixSwap_measurePreserving μ k).integral_comp' (fun p ↦ f p.1) change (∫ p, f (bridge p.1 p.2 k) ∂((Measure.pi μ).prod (Measure.pi μ))) = _ at h rw [h, integral_fun_fst, smul_eq_mul] end end Source29CoordinateRecombination /- Component: CoordinateAveraging.inc -/ namespace Source29CoordinateAveraging open MeasureTheory open scoped Topology noncomputable section /-- Integrating a coordinate resampling over both the original vector and the new coordinate multiplies the original integral by the coordinate's mass. -/ theorem integral_update_average {n : ℕ} (μ : Fin (n + 1) → Measure ℝ) [∀ i, SigmaFinite (μ i)] (i : Fin (n + 1)) (f : (Fin (n + 1) → ℝ) → ℝ) (hf : Integrable f (Measure.pi μ)) : (∫ x, ∫ t, f (Function.update x i t) ∂μ i ∂Measure.pi μ) = (μ i).real Set.univ * ∫ x, f x ∂Measure.pi μ := by let e := MeasurableEquiv.piFinSuccAbove (fun _ : Fin (n + 1) ↦ ℝ) i let ν := Measure.pi (fun j : Fin n ↦ μ (i.succAbove j)) have he := measurePreserving_piFinSuccAbove μ i let g : ℝ × (Fin n → ℝ) → ℝ := fun p ↦ f (e.symm p) have hg : Integrable g ((μ i).prod ν) := he.symm.integrable_comp_of_integrable hf have hupdate (p : ℝ × (Fin n → ℝ)) (t : ℝ) : f (Function.update (e.symm p) i t) = g (t, p.2) := by simp only [g, e, MeasurableEquiv.piFinSuccAbove_symm_apply, Fin.insertNthEquiv, Equiv.coe_fn_mk, Fin.update_insertNth] calc (∫ x, ∫ t, f (Function.update x i t) ∂μ i ∂Measure.pi μ) = ∫ p, ∫ t, f (Function.update (e.symm p) i t) ∂μ i ∂(μ i).prod ν := (he.symm.integral_comp' _).symm _ = ∫ p : ℝ × (Fin n → ℝ), ∫ t, g (t, p.2) ∂μ i ∂(μ i).prod ν := by apply integral_congr_ae exact Filter.Eventually.of_forall fun p ↦ integral_congr_ae (Filter.Eventually.of_forall (hupdate p)) _ = (μ i).real Set.univ * (∫ z, ∫ t, g (t, z) ∂μ i ∂ν) := by simpa only [smul_eq_mul] using (integral_fun_snd (μ := μ i) (ν := ν) (fun z ↦ ∫ t, g (t, z) ∂μ i)) _ = (μ i).real Set.univ * (∫ p, g p ∂(μ i).prod ν) := by rw [integral_prod_symm g hg] _ = (μ i).real Set.univ * ∫ x, f x ∂Measure.pi μ := by rw [he.symm.integral_comp' f] /-- The coordinate-averaged function remains integrable for finite coordinate measures. -/ theorem integrable_update_average {n : ℕ} (μ : Fin (n + 1) → Measure ℝ) [∀ i, IsFiniteMeasure (μ i)] (i : Fin (n + 1)) (f : (Fin (n + 1) → ℝ) → ℝ) (hf : Integrable f (Measure.pi μ)) : Integrable (fun x ↦ ∫ t, f (Function.update x i t) ∂μ i) (Measure.pi μ) := by let e := MeasurableEquiv.piFinSuccAbove (fun _ : Fin (n + 1) ↦ ℝ) i let ν := Measure.pi (fun j : Fin n ↦ μ (i.succAbove j)) have he := measurePreserving_piFinSuccAbove μ i let g : ℝ × (Fin n → ℝ) → ℝ := fun p ↦ f (e.symm p) have hg : Integrable g ((μ i).prod ν) := he.symm.integrable_comp_of_integrable hf have hG := hg.integral_prod_right.comp_snd (μ i) have hcomp : Integrable ((fun x ↦ ∫ t, f (Function.update x i t) ∂μ i) ∘ e.symm) ((μ i).prod ν) := by convert hG using 1 funext p apply integral_congr_ae exact Filter.Eventually.of_forall fun t ↦ (by simp only [Function.comp_def, g, e, MeasurableEquiv.piFinSuccAbove_symm_apply, Fin.insertNthEquiv, Equiv.coe_fn_mk, Fin.update_insertNth]) exact (he.symm.integrable_comp_emb e.symm.measurableEmbedding).mp hcomp end end Source29CoordinateAveraging /- Component: CubePoincare.inc -/ namespace Source29CubePoincare open MeasureTheory Set open Source29CoordinateOscillation Source29CoordinateRecombination Source29CoordinateAveraging open scoped Topology BigOperators noncomputable section /-- An L1 Poincare estimate on a cube, expressed as mean pairwise oscillation. -/ theorem box_poincare {n : ℕ} (f : (Fin (n + 1) → ℝ) → ℝ) (hf : ContDiff ℝ 1 f) (a b : Fin (n + 1) → ℝ) (hab : a ≤ b) : let Q := Icc a b (∫ p, ‖f p.1 - f p.2‖ ∂((volume.restrict Q).prod (volume.restrict Q))) ≤ (∏ i, (b i - a i)) * ∑ i : Fin (n + 1), (b i - a i) * ∫ x in Q, ‖fderiv ℝ f x (Pi.single i 1)‖ := by let Q := Icc a b let μ : Fin (n + 1) → Measure ℝ := fun i ↦ volume.restrict (Icc (a i) (b i)) let ν := Measure.pi μ have hν : ν = volume.restrict Q := by simpa only [ν, μ, Q, pi_univ_Icc, ← volume_pi] using (Measure.restrict_pi_pi (fun _ : Fin (n + 1) ↦ (volume : Measure ℝ)) (fun i ↦ Icc (a i) (b i))).symm have hνmass : ν.real univ = ∏ i, (b i - a i) := by simp [hν, Q, measureReal_def, Real.volume_Icc_pi, ENNReal.toReal_ofReal (sub_nonneg.mpr (hab _))] have hμmass (i : Fin (n + 1)) : (μ i).real univ = b i - a i := by simp [μ, measureReal_def, Real.volume_Icc, ENNReal.toReal_ofReal (sub_nonneg.mpr (hab _))] let g : Fin (n + 1) → (Fin (n + 1) → ℝ) → ℝ := fun i x ↦ ‖fderiv ℝ f x (Pi.single i 1)‖ have hg (i) : Integrable (g i) ν := by rw [hν] exact ((hf.continuous_fderiv (by norm_num)).clm_apply continuous_const).norm.integrableOn_Icc let G : Fin (n + 1) → (Fin (n + 1) → ℝ) → ℝ := fun i x ↦ ∫ t, g i (Function.update x i t) ∂μ i have hG (i) : Integrable (G i) ν := integrable_update_average μ i (g i) (hg i) have hGb (i : Fin (n + 1)) : Integrable (fun p ↦ G i (bridge p.1 p.2 i)) (ν.prod ν) := by have h := (prefixSwap_measurePreserving μ i).integrable_comp_of_integrable ((hG i).comp_fst ν) exact h have hfI : Integrable f ν := by rw [hν]; exact hf.continuous.integrableOn_Icc have hpair : Integrable (fun p ↦ ‖f p.1 - f p.2‖) (ν.prod ν) := ((hfI.comp_fst ν).sub (hfI.comp_snd ν)).norm have hmem : ∀ᵐ p ∂ν.prod ν, p.1 ∈ Q ∧ p.2 ∈ Q := by rw [hν, Measure.prod_restrict] exact ae_restrict_mem (measurableSet_Icc.prod measurableSet_Icc) have hosc : (∫ p, ‖f p.1 - f p.2‖ ∂ν.prod ν) ≤ ∫ p, ∑ i : Fin (n + 1), G i (bridge p.1 p.2 i) ∂ν.prod ν := by apply integral_mono_ae hpair (integrable_finset_sum _ (fun i _ ↦ hGb i)) filter_upwards [hmem] with p hp exact box_pointwise_oscillation f hf a b p.1 p.2 (fun i ↦ ⟨hp.1.1 i, hp.1.2 i⟩) (fun i ↦ ⟨hp.2.1 i, hp.2.2 i⟩) have he : (∫ p, ∑ i : Fin (n + 1), G i (bridge p.1 p.2 i) ∂ν.prod ν) = (∏ i, (b i - a i)) * ∑ i : Fin (n + 1), (b i - a i) * ∫ x, g i x ∂ν := by rw [integral_finset_sum _ (fun i _ ↦ hGb i)] have hi (i : Fin (n + 1)) : (∫ p, G i (bridge p.1 p.2 i) ∂ν.prod ν) = ν.real univ * ((μ i).real univ * ∫ x, g i x ∂ν) := by calc _ = ν.real univ * ∫ x, G i x ∂ν := integral_bridge μ i (G i) _ = _ := by congr 1 exact integral_update_average μ i (g i) (hg i) simp_rw [hi, hμmass, hνmass] rw [← Finset.mul_sum] change (∫ p, ‖f p.1 - f p.2‖ ∂((volume.restrict Q).prod (volume.restrict Q))) ≤ _ rw [← hν] exact hosc.trans_eq he /-- The coordinate-ball version, with side length twice the radius. -/ theorem cube_poincare {n : ℕ} (f : (Fin (n + 1) → ℝ) → ℝ) (hf : ContDiff ℝ 1 f) (c : Fin (n + 1) → ℝ) (r : ℝ) (hr : 0 ≤ r) : (∫ p, ‖f p.1 - f p.2‖ ∂((volume.restrict (Metric.closedBall c r)).prod (volume.restrict (Metric.closedBall c r)))) ≤ (2 * r) ^ (n + 2) * ∑ i : Fin (n + 1), ∫ x in Metric.closedBall c r, ‖fderiv ℝ f x (Pi.single i 1)‖ := by have hQ : Metric.closedBall c r = Icc (fun i ↦ c i - r) (fun i ↦ c i + r) := by rw [closedBall_pi c hr] simp_rw [Real.closedBall_eq_Icc] rw [pi_univ_Icc] have h := box_poincare f hf (fun i ↦ c i - r) (fun i ↦ c i + r) (fun i ↦ by linarith) dsimp only at h simp_rw [show ∀ i, c i + r - (c i - r) = 2 * r from fun i ↦ by ring] at h rw [← hQ] at h simp only [Finset.prod_const, Finset.card_univ, Fintype.card_fin] at h rw [← Finset.mul_sum] at h refine h.trans_eq ?_ rw [← mul_assoc, ← pow_succ] end end Source29CubePoincare /- Component: PairOscillation.inc -/ namespace Source29PairOscillation open MeasureTheory Filter open scoped Topology noncomputable section variable {α : Type*} [MeasurableSpace α] (μ : Measure α) [IsFiniteMeasure μ] /-- Pairwise oscillation integrals converge under bounded ae convergence. -/ theorem oscillation_tendsto (u : ℕ → α → ℝ) (v : α → ℝ) (hu : ∀ k, AEStronglyMeasurable (u k) μ) (hb : ∀ k x, ‖u k x‖ ≤ 1) (hl : ∀ᵐ x ∂μ, Tendsto (fun k ↦ u k x) atTop (𝓝 (v x))) : Tendsto (fun k ↦ ∫ p, ‖u k p.1 - u k p.2‖ ∂μ.prod μ) atTop (𝓝 (∫ p, ‖v p.1 - v p.2‖ ∂μ.prod μ)) := by apply tendsto_integral_of_dominated_convergence (fun _ ↦ (2 : ℝ)) · intro k exact ((hu k).comp_fst.sub (hu k).comp_snd).norm · exact integrable_const 2 · intro k exact Filter.Eventually.of_forall fun p ↦ (by rw [norm_norm] exact (norm_sub_le _ _).trans (by linarith [hb k p.1, hb k p.2])) · have hleft : ∀ᵐ p ∂μ.prod μ, Tendsto (fun k ↦ u k p.1) atTop (𝓝 (v p.1)) := Measure.quasiMeasurePreserving_fst.tendsto_ae.eventually hl have hright : ∀ᵐ p ∂μ.prod μ, Tendsto (fun k ↦ u k p.2) atTop (𝓝 (v p.2)) := Measure.quasiMeasurePreserving_snd.tendsto_ae.eventually hl filter_upwards [hleft, hright] with p hp hq exact (hp.sub hq).norm /-- For an indicator, pairwise oscillation is twice the product of the two complementary volumes. -/ theorem indicator_oscillation (A : Set α) (hA : MeasurableSet A) : (∫ p, ‖(A.indicator (fun _ ↦ (1 : ℝ))) p.1 - (A.indicator (fun _ ↦ (1 : ℝ))) p.2‖ ∂μ.prod μ) = 2 * μ.real A * μ.real Aᶜ := by classical let f := A.indicator (fun _ ↦ (1 : ℝ)) let g := Aᶜ.indicator (fun _ ↦ (1 : ℝ)) have hf : Integrable f μ := (integrable_const 1).indicator hA have hg : Integrable g μ := (integrable_const 1).indicator hA.compl have he (p : α × α) : ‖f p.1 - f p.2‖ = f p.1 * g p.2 + g p.1 * f p.2 := by dsimp [f, g] by_cases hx : p.1 ∈ A <;> by_cases hy : p.2 ∈ A <;> simp [hx, hy] change (∫ p, ‖f p.1 - f p.2‖ ∂μ.prod μ) = _ simp_rw [he] rw [integral_add (hf.mul_prod hg) (hg.mul_prod hf), integral_prod_mul, integral_prod_mul] have hfi : (∫ x, f x ∂μ) = μ.real A := by simp [f, integral_indicator_const, hA] have hgi : (∫ x, g x ∂μ) = μ.real Aᶜ := by simp [g, integral_indicator_const, hA.compl] rw [hfi, hgi] ring end end Source29PairOscillation /- Component: PhasePoincare.inc -/ namespace Source29PhasePoincare open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxPolynomial Source29QuarticReuse.FluxObstruction open Source29VariationConvexity Source29WeakCalibrationLimits Source29NonlinearCalibration open Source29SmoothPhaseTransition Source29SmoothCalibrationRecovery Source29PhaseMassLimit open Source29CubePoincare Source29PairOscillation open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem transition_fderiv (P : MvPolynomial (Fin n) ℝ) (k : ℕ) (x : Fin n → ℝ) (i : Fin n) : fderiv ℝ (fun y ↦ transition k (eval y P)) x (Pi.single i 1) = deriv (transition k) (eval x P) * evaluatedGradient P x i := by simpa using composed_product_fderiv P (ρ := fun _ ↦ 1) contDiff_const (transition_contDiff k) x i /-- The total coordinate gradient on a compact set is bounded by the smooth calibrated mass against a cutoff equal to one there. -/ theorem transition_gradient_sum_le_mass (P : MvPolynomial (Fin n) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) (Q : Set (Fin n → ℝ)) (hQ : IsCompact Q) {η : (Fin n → ℝ) → ℝ} (hη : ContDiff ℝ 1 η) (hcη : HasCompactSupport η) (hηpos : ∀ x, 0 ≤ η x) (hηone : ∀ x ∈ Q, η x = 1) (k : ℕ) : (∑ i : Fin n, ∫ x in Q, ‖fderiv ℝ (fun y ↦ transition k (eval y P)) x (Pi.single i 1)‖) ≤ n * (∫ x, η x * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x)) := by have hu : ContDiff ℝ 1 (fun y ↦ transition k (eval y P)) := (transition_contDiff k).comp (contDiff_eval P) have hm := (localized_gradient_mass_identity P hcal hη hcη (transition_contDiff k) (transition_norm_le_one k)).1 have hn (x : Fin n → ℝ) : 0 ≤ η x * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x) := mul_nonneg (mul_nonneg (hηpos x) (transition_deriv_nonneg k _)) (Real.sqrt_nonneg _) have hi (i : Fin n) : (∫ x in Q, ‖fderiv ℝ (fun y ↦ transition k (eval y P)) x (Pi.single i 1)‖) ≤ ∫ x, η x * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x) := by calc _ ≤ ∫ x in Q, η x * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x) := by apply setIntegral_mono_on (((hu.continuous_fderiv (by norm_num)).clm_apply continuous_const).norm.continuousOn.integrableOn_compact hQ) hm.integrableOn hQ.measurableSet intro x hx rw [transition_fderiv, hηone x hx, one_mul, norm_mul, Real.norm_eq_abs, abs_of_nonneg (transition_deriv_nonneg k _)] exact mul_le_mul_of_nonneg_left (coordinate_norm_le_variationDensity (evaluatedGradient P x) i) (transition_deriv_nonneg k _) _ ≤ _ := setIntegral_le_integral hm (Filter.Eventually.of_forall hn) calc _ ≤ ∑ _i : Fin n, ∫ x, η x * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x) := Finset.sum_le_sum (fun i _ ↦ hi i) _ = _ := by simp /-- Pairwise phase oscillation is controlled by calibrated mass on a larger cutoff. This is the relative estimate needed for a lower perimeter bound. -/ theorem phase_pair_volume_le_mass (P : MvPolynomial (Fin 8) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (c : Fin 8 → ℝ) (r : ℝ) (hr : 0 ≤ r) {η : (Fin 8 → ℝ) → ℝ} (hη : ContDiff ℝ 1 η) (hcη : HasCompactSupport η) (hηpos : ∀ x, 0 ≤ η x) (hηone : ∀ x ∈ Metric.closedBall c r, η x = 1) : let μ := volume.restrict (Metric.closedBall c r) let A := {x | 0 < eval x P} 2 * μ.real A * μ.real Aᶜ ≤ (2 * r) ^ 9 * 8 * phaseMass P η := by classical let μ := volume.restrict (Metric.closedBall c r) let A := {x | 0 < eval x P} letI : IsFiniteMeasure μ := ⟨by dsimp [μ] rw [Measure.restrict_apply_univ] exact (isCompact_closedBall c r).measure_lt_top⟩ have hA : MeasurableSet A := (isOpen_lt continuous_const (contDiff_eval P).continuous).measurableSet have hl := oscillation_tendsto μ (fun k x ↦ transition k (eval x P)) (A.indicator (fun _ ↦ (1 : ℝ))) (fun k ↦ ((transition_contDiff k).continuous.comp (contDiff_eval P).continuous).aestronglyMeasurable) (fun k x ↦ transition_norm_le_one k _) (by simpa only [A, Set.indicator, Set.mem_setOf_eq] using (ae_restrict_of_ae (polynomial_transition_tendsto_ae P hP) : ∀ᵐ x ∂μ, Tendsto (fun k ↦ transition k (eval x P)) atTop (𝓝 (if 0 < eval x P then 1 else 0)))) rw [indicator_oscillation μ A hA] at hl apply le_of_tendsto_of_tendsto hl ((phaseMass_tendsto P hP hcal hη hcη).const_mul ((2 * r) ^ 9 * 8)) apply Filter.Eventually.of_forall intro k have hp := cube_poincare (n := 7) (fun x ↦ transition k (eval x P)) ((transition_contDiff k).comp (contDiff_eval P)) c r hr have hg := transition_gradient_sum_le_mass P hcal (Metric.closedBall c r) (isCompact_closedBall c r) hη hcη hηpos hηone k calc _ ≤ (2 * r) ^ 9 * _ := hp _ ≤ (2 * r) ^ 9 * (8 * (∫ x, η x * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x))) := mul_le_mul_of_nonneg_left hg (by positivity) _ = _ := by ring end end Source29PhasePoincare /- Component: PerimeterBallLower.inc -/ namespace Source29PerimeterBallLower open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.QuarticPolynomialBasics Source29QuarticReuse.FluxPolynomial open Source29QuarticReuse.FluxObstruction open Source29WeakCalibrationLimits Source29PhaseMassLimit Source29PhasePoincare open Source29LocalPhasePerimeter Source29LocalPerimeterMass Source29TopPhasePerimeter open Source29TopPhaseDensity Source29PhaseVolumeDensity open scoped Topology ENNReal noncomputable section /-- The relative oscillation estimate in terms of the two strict phase volumes. -/ theorem phase_volume_product_le_mass (P : MvPolynomial (Fin 8) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (c : Fin 8 → ℝ) (r : ℝ) (hr : 0 ≤ r) {η : (Fin 8 → ℝ) → ℝ} (hη : ContDiff ℝ 1 η) (hcη : HasCompactSupport η) (hηpos : ∀ x, 0 ≤ η x) (hηone : ∀ x ∈ Metric.closedBall c r, η x = 1) : 2 * ballVolume {x | 0 < eval x P} c r * ballVolume {x | eval x P < 0} c r ≤ (2 * r) ^ 9 * 8 * phaseMass P η := by have h := phase_pair_volume_le_mass P hP hcal c r hr hη hcη hηpos hηone have hA : MeasurableSet {x | 0 < eval x P} := (isOpen_lt continuous_const (contDiff_eval P).continuous).measurableSet dsimp only at h rw [measureReal_restrict_apply hA, measureReal_restrict_apply hA.compl] at h have hneg : ballVolume {x | eval x P < 0} c r ≤ ballVolume {x | 0 < eval x P}ᶜ c r := by apply ballVolume_mono intro x hx refine ⟨hx.1, ?_⟩ exact not_lt_of_ge (show eval x P < 0 from hx.2).le rw [Set.inter_comm {x | 0 < eval x P}, Set.inter_comm {x | 0 < eval x P}ᶜ] at h change 2 * ballVolume _ c r * ballVolume _ c r ≤ _ at h exact (mul_le_mul_of_nonneg_left hneg (mul_nonneg (by norm_num) (ballVolume_nonneg _ c r))).trans h /-- A numerical cancellation for the eight-dimensional relative estimate. -/ theorem mass_lower_of_density {d r v w m : ℝ} (hd : 0 < d) (hr : 0 < r) (hv : d * r ^ 8 ≤ v) (hw : d * r ^ 8 ≤ w) (hm : 2 * v * w ≤ (2 * r) ^ 9 * 8 * m) : d ^ 2 / 2048 * r ^ 7 ≤ m := by have hp : 0 ≤ d * r ^ 8 := by positivity have hh : (d * r ^ 8) * (d * r ^ 8) ≤ v * w := mul_le_mul hv hw hp (hp.trans hv) have h : (4096 * r ^ 9) * (d ^ 2 / 2048 * r ^ 7) ≤ (4096 * r ^ 9) * m := by calc _ = 2 * ((d * r ^ 8) * (d * r ^ 8)) := by ring _ ≤ 2 * (v * w) := mul_le_mul_of_nonneg_left hh (by norm_num) _ ≤ _ := by nlinarith [hm] exact (mul_le_mul_iff_right₀ (by positivity : 0 < 4096 * r ^ 9)).mp h /-- Uniform lower growth of the leading phase perimeter, at every leading zero. -/ theorem top_positive_perimeter_ball_lower : ∃ a : ℝ, 0 < a ∧ ∀ (P : MvPolynomial (Fin 8) ℝ), Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → ∀ (c : Fin 8 → ℝ), eval c (homogeneousComponent P.totalDegree P) = 0 → ∀ (R : ℝ), 0 < R → ENNReal.ofReal (a * R ^ 7) ≤ localPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} (Metric.ball c R) := by obtain ⟨d, hd, hdensity⟩ := top_two_sided_density refine ⟨d ^ 2 / 262144, by positivity, ?_⟩ intro P hmin hdeg c hc R hR let F := homogeneousComponent P.totalDegree P have hF : F ≠ 0 := top_homogeneousComponent_ne_zero P (by omega) have hcal := top_weakCalibration P hmin hdeg obtain ⟨η, hη, hcη, hηs, hηb, hηone, _⟩ := exists_local_cutoff (Metric.closedBall c (R / 2)) (Metric.ball c R) (isCompact_closedBall c (R / 2)) Metric.isOpen_ball (Metric.closedBall_subset_ball (by linarith)) obtain ⟨hv, hw⟩ := hdensity P hmin hdeg c hc (R / 2) (by positivity) have hm := phase_volume_product_le_mass F hF hcal c (R / 2) (by positivity) hη hcη (fun x ↦ (hηb x).1) hηone have hl := mass_lower_of_density hd (show 0 < R / 2 by positivity) hv hw hm have hl' : d ^ 2 / 262144 * R ^ 7 ≤ phaseMass F η := by convert hl using 1 <;> ring rw [top_localPerimeter_eq_iSup_mass P hmin hdeg _ Metric.isOpen_ball] exact (ENNReal.ofReal_le_ofReal hl').trans (le_iSup_of_le η (le_iSup_of_le (show LocalWeight (Metric.ball c R) η from ⟨hη, hcη, hηs, hηb⟩) le_rfl)) /-- The same positive lower constant works for both strict leading phases. -/ theorem top_both_perimeters_ball_lower : ∃ a : ℝ, 0 < a ∧ ∀ (P : MvPolynomial (Fin 8) ℝ), Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → ∀ (c : Fin 8 → ℝ), eval c (homogeneousComponent P.totalDegree P) = 0 → ∀ (R : ℝ), 0 < R → ENNReal.ofReal (a * R ^ 7) ≤ localPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} (Metric.ball c R) ∧ ENNReal.ofReal (a * R ^ 7) ≤ localPerimeter {x | eval x (homogeneousComponent P.totalDegree P) < 0} (Metric.ball c R) := by obtain ⟨a, ha, h⟩ := top_positive_perimeter_ball_lower refine ⟨a, ha, ?_⟩ intro P hmin hdeg c hc R hR refine ⟨h P hmin hdeg c hc R hR, ?_⟩ have hm : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation (-P) := by change minimalGraphOperator (-P) = 0 rw [minimalGraphOperator_neg] exact neg_eq_zero.mpr hmin have hd : 2 ≤ (-P).totalDegree := by simpa only [totalDegree_neg] using hdeg have hc' : eval c (homogeneousComponent (-P).totalDegree (-P)) = 0 := by simp only [totalDegree_neg, map_neg, hc, neg_zero] simpa only [totalDegree_neg, map_neg, neg_pos] using h (-P) hm hd c hc' R hR end end Source29PerimeterBallLower /- Component: PerimeterMeasureGrowth.inc -/ namespace Source29PerimeterMeasureGrowth open MvPolynomial MeasureTheory Filter Metric open Source29LocalPhasePerimeter Source29TopPerimeterExactSupport open Source29PerimeterBallLower Source29PerimeterBallUpper open scoped Topology ENNReal noncomputable section /-- Positive power upper growth rules out atoms, without any boundary regularity assumption. -/ theorem singleton_eq_zero_of_ball_upper (μ : Measure (Fin 8 → ℝ)) (A : ℝ) (h : ∀ (c : Fin 8 → ℝ) (r : ℝ), 0 < r → μ (ball c r) ≤ ENNReal.ofReal (A * r ^ 7)) (c : Fin 8 → ℝ) : μ {c} = 0 := by have ht : Tendsto (fun r : ℝ ↦ ENNReal.ofReal (A * r ^ 7)) (𝓝[>] 0) (𝓝 0) := by have ht' : Tendsto (fun r : ℝ ↦ A * r ^ 7) (𝓝[>] 0) (𝓝 (A * (0 : ℝ) ^ 7)) := ((continuous_const.mul (continuous_id.pow 7)).tendsto 0).mono_left nhdsWithin_le_nhds simpa [Function.comp_def] using ENNReal.continuous_ofReal.continuousAt.tendsto.comp ht' apply le_antisymm _ bot_le apply ge_of_tendsto ht filter_upwards [self_mem_nhdsWithin] with r hr exact (measure_mono (Set.singleton_subset_iff.mpr (mem_ball_self hr))).trans (h c r hr) /-- The common perimeter measure has uniform order-seven growth, with a positive lower bound at every point of its support. The constants work for all nonaffine solutions of the full eight-variable minimal graph equation. -/ theorem top_perimeter_measure_growth : ∃ a A : ℝ, 0 < a ∧ 0 < A ∧ ∀ (P : MvPolynomial (Fin 8) ℝ), Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → ∃ μ : Measure (Fin 8 → ℝ), μ.Regular ∧ (∀ U : Set (Fin 8 → ℝ), IsOpen U → μ U = localPerimeter {x | 0 < eval x (homogeneousComponent P.totalDegree P)} U ∧ μ U = localPerimeter {x | eval x (homogeneousComponent P.totalDegree P) < 0} U) ∧ μ {x | eval x (homogeneousComponent P.totalDegree P) ≠ 0} = 0 ∧ measureSupport μ = {x | eval x (homogeneousComponent P.totalDegree P) = 0} ∧ (∀ (c : Fin 8 → ℝ) (r : ℝ), 0 < r → μ (ball c r) ≤ ENNReal.ofReal (A * r ^ 7)) ∧ (∀ c ∈ measureSupport μ, ∀ r : ℝ, 0 < r → ENNReal.ofReal (a * r ^ 7) ≤ μ (ball c r)) ∧ (∀ c : Fin 8 → ℝ, μ {c} = 0) := by obtain ⟨a, ha, hl⟩ := top_positive_perimeter_ball_lower obtain ⟨A, hA, hu⟩ := top_positive_perimeter_ball_upper refine ⟨a, A, ha, hA, ?_⟩ intro P hmin hdeg obtain ⟨μ, hreg, hμ, hz, hs⟩ := top_phases_exact_support P hmin hdeg have hupper : ∀ (c : Fin 8 → ℝ) (r : ℝ), 0 < r → μ (ball c r) ≤ ENNReal.ofReal (A * r ^ 7) := by intro c r hr rw [(hμ _ isOpen_ball).1] exact hu P hmin hdeg c r hr refine ⟨μ, hreg, hμ, hz, hs, hupper, ?_, singleton_eq_zero_of_ball_upper μ A hupper⟩ intro c hc r hr rw [(hμ _ isOpen_ball).1] apply hl P hmin hdeg c _ r hr rwa [hs] at hc end end Source29PerimeterMeasureGrowth /- Component: RegularizedGradientNorm.inc -/ namespace Source29RegularizedGradientNorm open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxPolynomial open Source29QuarticReuse.FluxObstruction Source29VariationConvexity open scoped Topology BigOperators noncomputable section variable {n : ℕ} def density (ε : ℝ) (a : Fin n → ℝ) : ℝ := Real.sqrt (ε ^ 2 + ∑ i, a i ^ 2) def field (ε : ℝ) (a : Fin n → ℝ) (i : Fin n) : ℝ := a i / density ε a theorem density_pos (ε : ℝ) (hε : 0 < ε) (a : Fin n → ℝ) : 0 < density ε a := by apply Real.sqrt_pos.mpr exact add_pos_of_pos_of_nonneg (sq_pos_of_pos hε) (Finset.sum_nonneg (fun i _ ↦ sq_nonneg _)) theorem density_bounds (ε : ℝ) (hε : 0 ≤ ε) (a : Fin n → ℝ) : variationDensity a ≤ density ε a ∧ density ε a ≤ ε + variationDensity a := by have hnon : 0 ≤ ∑ i, a i ^ 2 := Finset.sum_nonneg (fun i _ ↦ sq_nonneg _) have hs := Real.sq_sqrt (add_nonneg (sq_nonneg ε) hnon) have hv := variationDensity_sq a have hdn : 0 ≤ density ε a := Real.sqrt_nonneg _ have hvn : 0 ≤ variationDensity a := Real.sqrt_nonneg _ change density ε a ^ 2 = _ at hs constructor <;> nlinarith theorem field_bound (ε : ℝ) (hε : 0 < ε) (a : Fin n → ℝ) (i : Fin n) : ‖field ε a i‖ ≤ 1 := by rw [field, norm_div, Real.norm_eq_abs, Real.norm_eq_abs, abs_of_pos (density_pos ε hε a)] apply (div_le_one (density_pos ε hε a)).mpr exact (Source29SmoothCalibrationRecovery.coordinate_norm_le_variationDensity a i).trans (density_bounds ε hε.le a).1 theorem density_contDiff (ε : ℝ) (hε : 0 < ε) (g : (Fin n → ℝ) → Fin n → ℝ) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) : ContDiff ℝ 1 (fun x ↦ density ε (g x)) := by apply (contDiff_const.add (ContDiff.sum (fun i _ ↦ (hg i).pow 2))).sqrt intro x exact (add_pos_of_pos_of_nonneg (sq_pos_of_pos hε) (Finset.sum_nonneg (fun i _ ↦ sq_nonneg (g x i)))).ne' theorem field_contDiff (ε : ℝ) (hε : 0 < ε) (g : (Fin n → ℝ) → Fin n → ℝ) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (i : Fin n) : ContDiff ℝ 1 (fun x ↦ field ε (g x) i) := (hg i).div (density_contDiff ε hε g hg) (fun x ↦ (density_pos ε hε (g x)).ne') theorem density_fderiv (ε : ℝ) (hε : 0 < ε) (g : (Fin n → ℝ) → Fin n → ℝ) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (x v : Fin n → ℝ) : fderiv ℝ (fun y ↦ density ε (g y)) x v = ∑ i, field ε (g x) i * fderiv ℝ (fun y ↦ g y i) x v := by have hn : 0 < ε ^ 2 + ∑ i, g x i ^ 2 := add_pos_of_pos_of_nonneg (sq_pos_of_pos hε) (Finset.sum_nonneg (fun i _ ↦ sq_nonneg _)) have hd : HasFDerivAt (fun y ↦ ε ^ 2 + ∑ i, g y i ^ 2) (∑ i, (2 * g x i) • fderiv ℝ (fun y ↦ g y i) x) x := by have hs : HasFDerivAt (fun y ↦ ∑ i, g y i ^ 2) (∑ i, (2 * g x i) • fderiv ℝ (fun y ↦ g y i) x) x := by apply HasFDerivAt.fun_sum intro i _ convert ((hg i).differentiable (by norm_num) x).hasFDerivAt.pow 2 using 1 <;> simp exact hs.const_add (ε ^ 2) have he := congrArg (fun L : (Fin n → ℝ) →L[ℝ] ℝ ↦ L v) ((Real.hasDerivAt_sqrt hn.ne').comp_hasFDerivAt x hd).fderiv change _ = _ at he rw [show fderiv ℝ (fun y ↦ density ε (g y)) x v = (1 / (2 * density ε (g x))) * ∑ i, (2 * g x i) * fderiv ℝ (fun y ↦ g y i) x v by simpa only [density, Function.comp_def, _root_.smul_apply, smul_eq_mul, ContinuousLinearMap.sum_apply] using he] rw [Finset.mul_sum] apply Finset.sum_congr rfl intro i _ dsimp only [field] ring def parameter (k : ℕ) : ℝ := (dilationRadius k)⁻¹ theorem parameter_pos (k : ℕ) : 0 < parameter k := inv_pos.mpr (dilationRadius_pos k) theorem parameter_le_one (k : ℕ) : parameter k ≤ 1 := by apply inv_le_one_of_one_le₀ simp only [dilationRadius, Nat.cast_add, Nat.cast_one] linarith [Nat.cast_nonneg (α := ℝ) k] theorem parameter_tendsto : Tendsto parameter atTop (𝓝 0) := tendsto_inv_atTop_zero.comp dilationRadius_tendsto theorem density_tendsto (a : Fin n → ℝ) : Tendsto (fun k ↦ density (parameter k) a) atTop (𝓝 (variationDensity a)) := by have h := (parameter_tendsto.pow 2).add_const (∑ i, a i ^ 2) simpa only [zero_pow (by decide : 2 ≠ 0), zero_add, density, variationDensity, Function.comp_def] using Real.continuous_sqrt.continuousAt.tendsto.comp h theorem field_tendsto (a : Fin n → ℝ) (i : Fin n) : Tendsto (fun k ↦ field (parameter k) a i) atTop (𝓝 (a i / variationDensity a)) := by by_cases ha : a = 0 · subst a simpa only [field, Pi.zero_apply, zero_div] using (tendsto_const_nhds : Tendsto (fun _ : ℕ ↦ (0 : ℝ)) atTop (𝓝 0)) · exact tendsto_const_nhds.div (density_tendsto a) (variationDensity_pos ha).ne' end end Source29RegularizedGradientNorm /- Component: GradientNormWeakDerivative.inc -/ namespace Source29GradientNormWeakDerivative open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29VariationConvexity open Source29RegularizedGradientNorm open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem norm_pair_le (a b : Fin n → ℝ) (ha : ∀ i, ‖a i‖ ≤ 1) : ‖∑ i, a i * b i‖ ≤ ∑ i, ‖b i‖ := by apply (norm_sum_le _ _).trans apply Finset.sum_le_sum intro i _ rw [norm_mul] exact mul_le_of_le_one_left (norm_nonneg _) (ha i) theorem weighted_density_tendsto (g : (Fin n → ℝ) → Fin n → ℝ) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) {ψ : (Fin n → ℝ) → ℝ} (hψ : Continuous ψ) (hcψ : HasCompactSupport ψ) : Tendsto (fun k ↦ ∫ x, ψ x * density (parameter k) (g x)) atTop (𝓝 (∫ x, ψ x * variationDensity (g x))) := by have hv := variationDensity_continuous g (fun i ↦ (hg i).continuous) apply tendsto_integral_of_dominated_convergence (fun x ↦ ‖ψ x‖ * (1 + variationDensity (g x))) · intro k exact (hψ.mul (density_contDiff _ (parameter_pos k) g hg).continuous).aestronglyMeasurable · exact (hψ.norm.mul (continuous_const.add hv)).integrable_of_hasCompactSupport hcψ.norm.mul_right · intro k apply Filter.Eventually.of_forall intro x rw [norm_mul, Real.norm_eq_abs (density _ _), abs_of_pos (density_pos _ (parameter_pos k) _)] exact mul_le_mul_of_nonneg_left ((density_bounds _ (parameter_pos k).le _).2.trans (add_le_add (parameter_le_one k) le_rfl)) (norm_nonneg _) · exact Filter.Eventually.of_forall fun x ↦ tendsto_const_nhds.mul (density_tendsto (g x)) /-- Bounded regularized normal fields may be passed through compact weighted integrals, even where the limiting gradient vanishes. -/ theorem weighted_pair_tendsto (g : (Fin n → ℝ) → Fin n → ℝ) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (b : (Fin n → ℝ) → Fin n → ℝ) (hb : ∀ i, Continuous (fun x ↦ b x i)) {ψ : (Fin n → ℝ) → ℝ} (hψ : Continuous ψ) (hcψ : HasCompactSupport ψ) : Integrable (fun x ↦ ψ x * ∑ i, (g x i / variationDensity (g x)) * b x i) ∧ Tendsto (fun k ↦ ∫ x, ψ x * ∑ i, field (parameter k) (g x) i * b x i) atTop (𝓝 (∫ x, ψ x * ∑ i, (g x i / variationDensity (g x)) * b x i)) := by let f : ℕ → (Fin n → ℝ) → ℝ := fun k x ↦ ψ x * ∑ i, field (parameter k) (g x) i * b x i let f0 : (Fin n → ℝ) → ℝ := fun x ↦ ψ x * ∑ i, (g x i / variationDensity (g x)) * b x i let B : (Fin n → ℝ) → ℝ := fun x ↦ ‖ψ x‖ * ∑ i, ‖b x i‖ have hm (k : ℕ) : AEStronglyMeasurable (f k) := (hψ.mul (continuous_finsetSum _ (fun i _ ↦ ((field_contDiff _ (parameter_pos k) g hg i).continuous).mul (hb i)))).aestronglyMeasurable have hB : Integrable B := (hψ.norm.mul (continuous_finsetSum _ (fun i _ ↦ (hb i).norm))).integrable_of_hasCompactSupport hcψ.norm.mul_right have hf (k : ℕ) (x : Fin n → ℝ) : ‖f k x‖ ≤ B x := by dsimp only [f, B] rw [norm_mul] exact mul_le_mul_of_nonneg_left (norm_pair_le _ _ (field_bound _ (parameter_pos k) _)) (norm_nonneg _) have ht (x : Fin n → ℝ) : Tendsto (fun k ↦ f k x) atTop (𝓝 (f0 x)) := by apply tendsto_const_nhds.mul apply tendsto_finsetSum intro i _ exact (field_tendsto (g x) i).mul_const (b x i) have hi : Integrable f0 := hB.mono' (aestronglyMeasurable_of_tendsto_ae atTop hm (Filter.Eventually.of_forall ht)) (Filter.Eventually.of_forall fun x ↦ le_of_tendsto (ht x).norm (Filter.Eventually.of_forall fun k ↦ hf k x)) refine ⟨hi, ?_⟩ exact tendsto_integral_of_dominated_convergence B hm hB (fun k ↦ Filter.Eventually.of_forall (hf k)) (Filter.Eventually.of_forall ht) /-- Weak differentiation of the Euclidean norm of a C1 vector field. The normal vector is assigned zero at zeros of the field. -/ theorem norm_integration_by_parts (g : (Fin n → ℝ) → Fin n → ℝ) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) {φ : (Fin n → ℝ) → ℝ} (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) (v : Fin n → ℝ) : Integrable (fun x ↦ φ x * ∑ i, (g x i / variationDensity (g x)) * fderiv ℝ (fun y ↦ g y i) x v) ∧ (∫ x, φ x * ∑ i, (g x i / variationDensity (g x)) * fderiv ℝ (fun y ↦ g y i) x v) = -(∫ x, fderiv ℝ φ x v * variationDensity (g x)) := by have hd (i : Fin n) : Continuous (fun x ↦ fderiv ℝ (fun y ↦ g y i) x v) := ((hg i).continuous_fderiv (by norm_num)).clm_apply continuous_const obtain ⟨hi, ht⟩ := weighted_pair_tendsto g hg (fun x i ↦ fderiv ℝ (fun y ↦ g y i) x v) hd hφ.continuous hcφ refine ⟨hi, ?_⟩ have ht' := weighted_density_tendsto g hg ((hφ.continuous_fderiv (by norm_num)).clm_apply continuous_const) (hcφ.fderiv_apply ℝ v) have he (k : ℕ) : (∫ x, φ x * ∑ i, field (parameter k) (g x) i * fderiv ℝ (fun y ↦ g y i) x v) = -(∫ x, fderiv ℝ φ x v * density (parameter k) (g x)) := by simp_rw [← density_fderiv _ (parameter_pos k) g hg] exact integral_mul_fderiv_eq_neg_of_compactSupport hφ hcφ (density_contDiff _ (parameter_pos k) g hg) v have he' : (fun k ↦ ∫ x, φ x * ∑ i, field (parameter k) (g x) i * fderiv ℝ (fun y ↦ g y i) x v) = (fun k ↦ -(∫ x, fderiv ℝ φ x v * density (parameter k) (g x))) := funext he rw [he'] at ht exact tendsto_nhds_unique ht ht'.neg end end Source29GradientNormWeakDerivative /- Component: PolynomialStress.inc -/ namespace Source29PolynomialStress open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29QuarticReuse.QuarticPolynomialBasics open Source29VariationConvexity Source29WeakCalibrationLimits Source29GradientNormWeakDerivative open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem gradient_fderiv_symm (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) (i j : Fin n) : fderiv ℝ (fun y ↦ evaluatedGradient P y i) x (Pi.single j 1) = fderiv ℝ (fun y ↦ evaluatedGradient P y j) x (Pi.single i 1) := by simp only [evaluatedGradient, fderiv_eval, evalFDeriv_basis] rw [second_partial_comm] /-- The product test isolates one column of the stress tensor. -/ theorem gradient_product_flux (P : MvPolynomial (Fin n) ℝ) {φ : (Fin n → ℝ) → ℝ} (hφ : ContDiff ℝ 1 φ) (j : Fin n) (x : Fin n → ℝ) : testFlux (fun i ↦ Pi.single i 1) (fun y ↦ φ y * evaluatedGradient P y j) (leadingNormalizedField P) x = evaluatedGradient P x j * testFlux (fun i ↦ Pi.single i 1) φ (leadingNormalizedField P) x + φ x * ∑ i, leadingNormalizedField P x i * fderiv ℝ (fun y ↦ evaluatedGradient P y i) x (Pi.single j 1) := by have hg : ContDiff ℝ 1 (fun y ↦ evaluatedGradient P y j) := contDiff_eval (pderiv j P) have hd (i : Fin n) : fderiv ℝ (fun y ↦ φ y * evaluatedGradient P y j) x (Pi.single i 1) = evaluatedGradient P x j * fderiv ℝ φ x (Pi.single i 1) + φ x * fderiv ℝ (fun y ↦ evaluatedGradient P y j) x (Pi.single i 1) := by have hh := ((hφ.differentiable (by norm_num) x).hasFDerivAt).fun_mul ((hg.differentiable (by norm_num) x).hasFDerivAt) simpa only [add_apply, _root_.smul_apply, smul_eq_mul, add_comm] using congrArg (fun L : (Fin n → ℝ) →L[ℝ] ℝ ↦ L (Pi.single i 1)) hh.fderiv simp only [testFlux, hd, add_mul, Finset.sum_add_distrib, Finset.mul_sum] congr 1 · apply Finset.sum_congr rfl intro i _ ring · apply Finset.sum_congr rfl intro i _ rw [gradient_fderiv_symm P x j i] ring def stressColumn (P : MvPolynomial (Fin n) ℝ) (φ : (Fin n → ℝ) → ℝ) (j : Fin n) (x : Fin n → ℝ) : ℝ := variationDensity (evaluatedGradient P x) * fderiv ℝ φ x (Pi.single j 1) - evaluatedGradient P x j * testFlux (fun i ↦ Pi.single i 1) φ (leadingNormalizedField P) x /-- A weak unit-gradient calibration forces the polynomial stress tensor to have zero distributional divergence, including across its critical set. -/ theorem stress_column_integral_zero (P : MvPolynomial (Fin n) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) {φ : (Fin n → ℝ) → ℝ} (hφ : ContDiff ℝ 1 φ) (hcφ : HasCompactSupport φ) (j : Fin n) : Integrable (stressColumn P φ j) ∧ (∫ x, stressColumn P φ j x) = 0 := by have hg (i : Fin n) : ContDiff ℝ 1 (fun x ↦ evaluatedGradient P x i) := contDiff_eval (pderiv i P) obtain ⟨hi, he⟩ := norm_integration_by_parts (evaluatedGradient P) hg hφ hcφ (Pi.single j 1) change Integrable (fun x ↦ φ x * ∑ i, leadingNormalizedField P x i * fderiv ℝ (fun y ↦ evaluatedGradient P y i) x (Pi.single j 1)) at hi change (∫ x, φ x * ∑ i, leadingNormalizedField P x i * fderiv ℝ (fun y ↦ evaluatedGradient P y i) x (Pi.single j 1)) = _ at he obtain ⟨hp, hz⟩ := hcal.2 (fun y ↦ φ y * evaluatedGradient P y j) (hφ.mul (hg j)) hcφ.mul_right change Integrable (fun x ↦ testFlux (fun i ↦ Pi.single i 1) (fun y ↦ φ y * evaluatedGradient P y j) (leadingNormalizedField P) x) at hp simp_rw [gradient_product_flux P hφ j] at hp hz have hq : Integrable (fun x ↦ evaluatedGradient P x j * testFlux (fun i ↦ Pi.single i 1) φ (leadingNormalizedField P) x) := by simpa only [Pi.sub_def, add_sub_cancel_right] using hp.sub hi have hl : Integrable (fun x ↦ variationDensity (evaluatedGradient P x) * fderiv ℝ φ x (Pi.single j 1)) := ((variationDensity_continuous _ (fun i ↦ (hg i).continuous)).mul ((hφ.continuous_fderiv (by norm_num)).clm_apply continuous_const)).integrable_of_hasCompactSupport (hcφ.fderiv_apply ℝ (Pi.single j 1)).mul_left refine ⟨hl.sub hq, ?_⟩ rw [integral_add hq hi] at hz change (∫ x, variationDensity (evaluatedGradient P x) * fderiv ℝ φ x (Pi.single j 1) - evaluatedGradient P x j * testFlux (fun i ↦ Pi.single i 1) φ (leadingNormalizedField P) x) = 0 rw [integral_sub hl hq] have he' : (∫ x, fderiv ℝ φ x (Pi.single j 1) * variationDensity (evaluatedGradient P x)) = (∫ x, variationDensity (evaluatedGradient P x) * fderiv ℝ φ x (Pi.single j 1)) := by apply integral_congr_ae exact Filter.Eventually.of_forall fun x ↦ mul_comm _ _ rw [he'] at he linarith /-- The first-variation integrand for the diffuse level-set area measure. -/ def stressPair (P : MvPolynomial (Fin n) ℝ) (X : (Fin n → ℝ) → Fin n → ℝ) (x : Fin n → ℝ) : ℝ := ∑ j, stressColumn P (fun y ↦ X y j) j x theorem stress_integral_zero (P : MvPolynomial (Fin n) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ j, ContDiff ℝ 1 (fun x ↦ X x j)) (hcX : ∀ j, HasCompactSupport (fun x ↦ X x j)) : Integrable (stressPair P X) ∧ (∫ x, stressPair P X x) = 0 := by have h (j : Fin n) := stress_column_integral_zero P hcal (hX j) (hcX j) j refine ⟨integrable_finsetSum _ (fun j _ ↦ (h j).1), ?_⟩ change (∫ x, ∑ j, stressColumn P (fun y ↦ X y j) j x) = 0 rw [integral_finsetSum _ (fun j _ ↦ (h j).1)] simp only [(h _).2, Finset.sum_const_zero] /-- Tangential divergence along the normalized polynomial gradient. -/ def tangentialDivergence (P : MvPolynomial (Fin n) ℝ) (X : (Fin n → ℝ) → Fin n → ℝ) (x : Fin n → ℝ) : ℝ := divergence (fun i ↦ Pi.single i 1) X x - ∑ j, ∑ i, leadingNormalizedField P x i * leadingNormalizedField P x j * fderiv ℝ (fun y ↦ X y j) x (Pi.single i 1) theorem norm_mul_normal (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) (i : Fin n) : variationDensity (evaluatedGradient P x) * leadingNormalizedField P x i = evaluatedGradient P x i := by by_cases hz : evaluatedGradient P x = 0 · simp only [leadingNormalizedField, hz, Pi.zero_apply, zero_div, mul_zero] · have hn := (variationDensity_pos hz).ne' change variationDensity (evaluatedGradient P x) * (evaluatedGradient P x i / variationDensity (evaluatedGradient P x)) = _ field_simp theorem stressPair_eq_tangentialDivergence (P : MvPolynomial (Fin n) ℝ) (X : (Fin n → ℝ) → Fin n → ℝ) (x : Fin n → ℝ) : stressPair P X x = variationDensity (evaluatedGradient P x) * tangentialDivergence P X x := by have he (i j : Fin n) : variationDensity (evaluatedGradient P x) * (leadingNormalizedField P x i * leadingNormalizedField P x j * fderiv ℝ (fun y ↦ X y j) x (Pi.single i 1)) = evaluatedGradient P x j * (fderiv ℝ (fun y ↦ X y j) x (Pi.single i 1) * leadingNormalizedField P x i) := by calc _ = (variationDensity (evaluatedGradient P x) * leadingNormalizedField P x j) * (fderiv ℝ (fun y ↦ X y j) x (Pi.single i 1) * leadingNormalizedField P x i) := by ring _ = _ := by rw [norm_mul_normal] simp only [stressPair, stressColumn, tangentialDivergence, divergence, testFlux, Finset.sum_sub_distrib, mul_sub, Finset.mul_sum, he] end end Source29PolynomialStress /- Component: LevelStressStationarity.inc -/ namespace Source29LevelStressStationarity open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29VariationConvexity Source29WeakCalibrationLimits Source29PolynomialStress open Source29NonlinearCalibration Source29SmoothPhaseTransition Source29TopPhasePerimeter open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- Multiplication by a function of the level leaves the stress pairing unchanged apart from that scalar weight. The normal derivative cancels. -/ theorem stressColumn_level_mul (P : MvPolynomial (Fin n) ℝ) {φ : (Fin n → ℝ) → ℝ} (hφ : ContDiff ℝ 1 φ) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) (j : Fin n) (x : Fin n → ℝ) : stressColumn P (fun y ↦ φ y * h (eval y P)) j x = h (eval x P) * stressColumn P φ j x := by simp only [stressColumn, composed_product_fderiv P hφ hh, composed_product_flux P hφ hh] ring theorem stressPair_level_mul (P : MvPolynomial (Fin n) ℝ) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ j, ContDiff ℝ 1 (fun x ↦ X x j)) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) (x : Fin n → ℝ) : stressPair P (fun y j ↦ X y j * h (eval y P)) x = h (eval x P) * stressPair P X x := by simp only [stressPair, stressColumn_level_mul P (hX _) hh, Finset.mul_sum] /-- Each smooth level weight of a weakly calibrated polynomial is stationary against compactly supported C1 vector fields. -/ theorem weighted_stress_integral_zero (P : MvPolynomial (Fin n) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ j, ContDiff ℝ 1 (fun x ↦ X x j)) (hcX : ∀ j, HasCompactSupport (fun x ↦ X x j)) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) : Integrable (fun x ↦ h (eval x P) * stressPair P X x) ∧ (∫ x, h (eval x P) * stressPair P X x) = 0 := by have he : stressPair P (fun y j ↦ X y j * h (eval y P)) = (fun x ↦ h (eval x P) * stressPair P X x) := funext (stressPair_level_mul P X hX hh) rw [← he] exact stress_integral_zero P hcal _ (fun j ↦ (hX j).mul (hh.comp (contDiff_eval P))) (fun j ↦ (hcX j).mul_right) theorem transition_deriv_contDiff (k : ℕ) : ContDiff ℝ 1 (deriv (transition k)) := by have hs : ContDiff ℝ 2 scalarField := by have he : scalarField = (fun t : ℝ ↦ t / Real.sqrt (1 + t ^ 2)) := funext scalarField_eq rw [he] apply contDiff_id.div ((contDiff_const.add (contDiff_id.pow 2)).sqrt _) · intro t positivity · intro t positivity have ht : ContDiff ℝ (1 + 1) (transition k) := (contDiff_const.add (hs.comp (contDiff_const.mul contDiff_id))).div_const 2 exact ht.deriv' /-- The measures defined by smooth phase transitions satisfy the full ambient first-variation identity, before any limit is taken. -/ theorem top_transition_stress_integral_zero (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ j, ContDiff ℝ 1 (fun x ↦ X x j)) (hcX : ∀ j, HasCompactSupport (fun x ↦ X x j)) (k : ℕ) : Integrable (fun x ↦ deriv (transition k) (eval x (homogeneousComponent P.totalDegree P)) * stressPair (homogeneousComponent P.totalDegree P) X x) ∧ (∫ x, deriv (transition k) (eval x (homogeneousComponent P.totalDegree P)) * stressPair (homogeneousComponent P.totalDegree P) X x) = 0 := weighted_stress_integral_zero _ (top_weakCalibration P hmin hdeg) X hX hcX (transition_deriv_contDiff k) /-- Stationarity written as the integral of tangential divergence against the phase-transition measures whose masses converge to the leading phase perimeter. -/ theorem top_transition_tangential_integral_zero (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ j, ContDiff ℝ 1 (fun x ↦ X x j)) (hcX : ∀ j, HasCompactSupport (fun x ↦ X x j)) (k : ℕ) : let F := homogeneousComponent P.totalDegree P Integrable (fun x ↦ deriv (transition k) (eval x F) * variationDensity (evaluatedGradient F x) * tangentialDivergence F X x) ∧ (∫ x, deriv (transition k) (eval x F) * variationDensity (evaluatedGradient F x) * tangentialDivergence F X x) = 0 := by let F := homogeneousComponent P.totalDegree P have he : (fun x ↦ deriv (transition k) (eval x F) * variationDensity (evaluatedGradient F x) * tangentialDivergence F X x) = (fun x ↦ deriv (transition k) (eval x F) * stressPair F X x) := by funext x rw [stressPair_eq_tangentialDivergence] ring dsimp only change Integrable (fun x ↦ deriv (transition k) (eval x F) * variationDensity (evaluatedGradient F x) * tangentialDivergence F X x) ∧ _ rw [he] exact top_transition_stress_integral_zero P hmin hdeg X hX hcX k end end Source29LevelStressStationarity /- Component: StressBarrier.inc -/ namespace Source29StressBarrier open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.QuarticPolynomialBasics open Source29VariationConvexity Source29WeakCalibrationLimits Source29PolynomialStress open Source29NonlinearCalibration Source29SmoothPhaseTransition Source29LevelStressStationarity open Source29PhaseMassLimit Source29TopPhasePerimeter Source29TopPhaseDensity open Source29PerimeterBallLower open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- A pointwise lower bound on tangential divergence forces the corresponding phase mass to be nonpositive. This is a barrier-obstruction interface; it does not assert the existence of any geometric barrier. -/ theorem phaseMass_nonpos_of_tangential_lower (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ j, ContDiff ℝ 1 (fun x ↦ X x j)) (hcX : ∀ j, HasCompactSupport (fun x ↦ X x j)) {η : (Fin n → ℝ) → ℝ} (hη : ContDiff ℝ 1 η) (hcη : HasCompactSupport η) (hlower : ∀ x, η x ≤ tangentialDivergence P X x) : phaseMass P η ≤ 0 := by apply le_of_tendsto (phaseMass_tendsto P hP hcal hη hcη) apply Filter.Eventually.of_forall intro k obtain ⟨hi, hz⟩ := weighted_stress_integral_zero P hcal X hX hcX (transition_deriv_contDiff k) have hm := (localized_gradient_mass_identity P hcal hη hcη (transition_contDiff k) (transition_norm_le_one k)).1 calc _ ≤ ∫ x, deriv (transition k) (eval x P) * stressPair P X x := by apply integral_mono hm hi intro x dsimp only rw [stressPair_eq_tangentialDivergence] calc _ = (deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x)) * η x := by ring _ ≤ (deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x)) * tangentialDivergence P X x := mul_le_mul_of_nonneg_left (hlower x) (mul_nonneg (transition_deriv_nonneg k _) (Real.sqrt_nonneg _)) _ = _ := by ring _ = 0 := hz /-- A nonnegative test equal to one on a ball about a leading zero has strictly positive phase mass. This uses the proved uniform density and relative estimate. -/ theorem top_phaseMass_pos_at_zero (P : MvPolynomial (Fin 8) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (c : Fin 8 → ℝ) (hc : eval c (homogeneousComponent P.totalDegree P) = 0) (r : ℝ) (hr : 0 < r) {η : (Fin 8 → ℝ) → ℝ} (hη : ContDiff ℝ 1 η) (hcη : HasCompactSupport η) (hηpos : ∀ x, 0 ≤ η x) (hηone : ∀ x ∈ Metric.closedBall c r, η x = 1) : 0 < phaseMass (homogeneousComponent P.totalDegree P) η := by obtain ⟨d, hd, hdensity⟩ := top_two_sided_density obtain ⟨hv, hw⟩ := hdensity P hmin hdeg c hc r hr have hF : homogeneousComponent P.totalDegree P ≠ 0 := top_homogeneousComponent_ne_zero P (by omega) have hpair := phase_volume_product_le_mass _ hF (top_weakCalibration P hmin hdeg) c r hr.le hη hcη hηpos hηone exact (show 0 < d ^ 2 / 2048 * r ^ 7 by positivity).trans_le (mass_lower_of_density hd hr hv hw hpair) /-- No compactly supported vector field can have nonnegative tangential divergence everywhere and dominate a positive cutoff about a leading zero. -/ theorem top_no_positive_tangential_barrier (P : MvPolynomial (Fin 8) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (c : Fin 8 → ℝ) (hc : eval c (homogeneousComponent P.totalDegree P) = 0) (r : ℝ) (hr : 0 < r) (X : (Fin 8 → ℝ) → Fin 8 → ℝ) (hX : ∀ j, ContDiff ℝ 1 (fun x ↦ X x j)) (hcX : ∀ j, HasCompactSupport (fun x ↦ X x j)) {η : (Fin 8 → ℝ) → ℝ} (hη : ContDiff ℝ 1 η) (hcη : HasCompactSupport η) (hηpos : ∀ x, 0 ≤ η x) (hηone : ∀ x ∈ Metric.closedBall c r, η x = 1) (hlower : ∀ x, η x ≤ tangentialDivergence (homogeneousComponent P.totalDegree P) X x) : False := by have hp := top_phaseMass_pos_at_zero P hmin hdeg c hc r hr hη hcη hηpos hηone have hn := phaseMass_nonpos_of_tangential_lower _ (top_homogeneousComponent_ne_zero P (by omega)) (top_weakCalibration P hmin hdeg) X hX hcX hη hcη hlower exact (not_lt_of_ge hn) hp end end Source29StressBarrier /- Component: TransitionDerivativeDecay.inc -/ namespace Source29TransitionDerivativeDecay open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxPolynomial Source29SmoothPhaseTransition open scoped Topology BigOperators noncomputable section theorem baseTransition_deriv_eq (t : ℝ) : deriv baseTransition t = 1 / (2 * (Real.sqrt (1 + t ^ 2)) ^ 3) := by have hd := (((scalarField_contDiff.differentiable (by norm_num) t).hasDerivAt).const_add 1).div_const 2 change HasDerivAt baseTransition (deriv scalarField t / 2) t at hd rw [hd.deriv, scalarField_deriv] ring theorem transition_deriv_eq (k : ℕ) (t : ℝ) : deriv (transition k) t = dilationRadius k / (2 * (Real.sqrt (1 + (dilationRadius k * t) ^ 2)) ^ 3) := by have hd := ((baseTransition_contDiff.differentiable (by norm_num) (dilationRadius k * t)).hasDerivAt).comp t ((hasDerivAt_id t).const_mul (dilationRadius k)) change HasDerivAt (transition k) (deriv baseTransition (dilationRadius k * t) * (dilationRadius k * 1)) t at hd rw [hd.deriv, baseTransition_deriv_eq] ring /-- The factor that kills errors proportional to distance in polynomial value is bounded by a decaying rational kernel. -/ theorem abs_mul_transition_deriv_le (k : ℕ) (t : ℝ) : |t| * deriv (transition k) t ≤ 1 / (2 * (1 + (dilationRadius k * t) ^ 2)) := by let u := dilationRadius k * t let w := Real.sqrt (1 + u ^ 2) have hw : 0 < w := Real.sqrt_pos.mpr (by positivity) have hs : w ^ 2 = 1 + u ^ 2 := Real.sq_sqrt (by positivity) have ha : |u| ≤ w := Real.abs_le_sqrt (by linarith [sq_nonneg u]) have he : |t| * deriv (transition k) t = (|u| / w) * (1 / (2 * w ^ 2)) := by rw [transition_deriv_eq] dsimp only [u, w] rw [abs_mul, abs_of_pos (dilationRadius_pos k)] field_simp rw [he] calc _ ≤ 1 * (1 / (2 * w ^ 2)) := mul_le_mul_of_nonneg_right ((div_le_one hw).mpr ha) (by positivity) _ = _ := by rw [one_mul, hs] theorem abs_mul_transition_deriv_bound (k : ℕ) (t : ℝ) : 0 ≤ |t| * deriv (transition k) t ∧ |t| * deriv (transition k) t ≤ 1 / 2 := by refine ⟨mul_nonneg (abs_nonneg _) (transition_deriv_nonneg _ _), (abs_mul_transition_deriv_le k t).trans ?_⟩ apply one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 2) nlinarith [sq_nonneg (dilationRadius k * t)] theorem abs_mul_transition_deriv_le_inverse (k : ℕ) {t : ℝ} (ht : t ≠ 0) : |t| * deriv (transition k) t ≤ (dilationRadius k)⁻¹ ^ 2 / (2 * t ^ 2) := by have hr := dilationRadius_pos k have ht2 : 0 < t ^ 2 := sq_pos_of_ne_zero ht calc _ ≤ 1 / (2 * (1 + (dilationRadius k * t) ^ 2)) := abs_mul_transition_deriv_le k t _ ≤ 1 / (2 * (dilationRadius k * t) ^ 2) := by apply one_div_le_one_div_of_le (by positivity) linarith _ = _ := by field_simp theorem abs_mul_transition_deriv_tendsto (t : ℝ) : Tendsto (fun k ↦ |t| * deriv (transition k) t) atTop (𝓝 0) := by by_cases ht : t = 0 · subst t simpa only [abs_zero, zero_mul] using (tendsto_const_nhds : Tendsto (fun _ : ℕ ↦ (0 : ℝ)) atTop (𝓝 0)) · apply squeeze_zero (fun k ↦ (abs_mul_transition_deriv_bound k t).1) (fun k ↦ abs_mul_transition_deriv_le_inverse k ht) simpa using ((tendsto_inv_atTop_zero.comp dilationRadius_tendsto).pow 2).div_const (2 * t ^ 2) end end Source29TransitionDerivativeDecay /- Component: TransitionLevelError.inc -/ namespace Source29TransitionLevelError open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxPolynomial Source29QuarticReuse.FluxObstruction open Source29VariationConvexity Source29SmoothPhaseTransition Source29LevelStressStationarity open Source29TransitionDerivativeDecay open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem level_error_integrable (P : MvPolynomial (Fin n) ℝ) {b : (Fin n → ℝ) → ℝ} (hb : Continuous b) (hcb : HasCompactSupport b) (k : ℕ) : Integrable (fun x ↦ b x * |eval x P| * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x)) := by apply Continuous.integrable_of_hasCompactSupport · exact ((hb.mul (contDiff_eval P).continuous.abs).mul ((transition_deriv_contDiff k).continuous.comp (contDiff_eval P).continuous)).mul (variationDensity_continuous _ (fun i ↦ (contDiff_eval (pderiv i P)).continuous)) · exact hcb.mul_right.mul_right.mul_right /-- Compactly weighted errors proportional to the polynomial value disappear in the phase-boundary limit, including at critical points. -/ theorem level_error_tendsto_zero (P : MvPolynomial (Fin n) ℝ) {b : (Fin n → ℝ) → ℝ} (hb : Continuous b) (hcb : HasCompactSupport b) : Tendsto (fun k ↦ ∫ x, b x * |eval x P| * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x)) atTop (𝓝 0) := by have hv := variationDensity_continuous (evaluatedGradient P) (fun i ↦ (contDiff_eval (pderiv i P)).continuous) have h : Tendsto (fun k ↦ ∫ x, b x * |eval x P| * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x)) atTop (𝓝 (∫ _x : Fin n → ℝ, (0 : ℝ))) := by apply tendsto_integral_of_dominated_convergence (fun x ↦ ‖b x‖ * (1 / 2) * variationDensity (evaluatedGradient P x)) · intro k exact (level_error_integrable P hb hcb k).aestronglyMeasurable · exact ((hb.norm.mul continuous_const).mul hv).integrable_of_hasCompactSupport hcb.norm.mul_right.mul_right · intro k apply Filter.Eventually.of_forall intro x calc _ = ‖b x‖ * (|eval x P| * deriv (transition k) (eval x P)) * variationDensity (evaluatedGradient P x) := by simp only [norm_mul, Real.norm_eq_abs, abs_abs, abs_of_nonneg (transition_deriv_nonneg k _), abs_of_nonneg (show 0 ≤ variationDensity (evaluatedGradient P x) from Real.sqrt_nonneg _)] ring _ ≤ _ := mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left (abs_mul_transition_deriv_bound k _).2 (norm_nonneg _)) (Real.sqrt_nonneg _) · apply Filter.Eventually.of_forall intro x simpa only [mul_zero, zero_mul, mul_assoc] using (tendsto_const_nhds.mul (abs_mul_transition_deriv_tendsto (eval x P))).mul_const (variationDensity (evaluatedGradient P x)) simpa only [integral_zero] using h end end Source29TransitionLevelError /- Component: TangentialDivergenceBound.inc -/ namespace Source29TangentialDivergenceBound open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29VariationConvexity open Source29WeakCalibrationLimits Source29PolynomialStress Source29GradientNormWeakDerivative open scoped Topology BigOperators noncomputable section variable {n : ℕ} def tangentialBound (X : (Fin n → ℝ) → Fin n → ℝ) (x : Fin n → ℝ) : ℝ := (∑ j, ‖fderiv ℝ (fun y ↦ X y j) x (Pi.single j 1)‖) + ∑ j, ∑ i, ‖fderiv ℝ (fun y ↦ X y j) x (Pi.single i 1)‖ theorem tangentialBound_nonneg (X : (Fin n → ℝ) → Fin n → ℝ) (x : Fin n → ℝ) : 0 ≤ tangentialBound X x := by unfold tangentialBound positivity theorem tangentialBound_continuous (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ j, ContDiff ℝ 1 (fun x ↦ X x j)) : Continuous (tangentialBound X) := by have hc (i j : Fin n) : Continuous (fun x ↦ ‖fderiv ℝ (fun y ↦ X y j) x (Pi.single i 1)‖) := (((hX j).continuous_fderiv (by norm_num)).clm_apply continuous_const).norm exact (continuous_finsetSum _ (fun j _ ↦ hc j j)).add (continuous_finsetSum _ (fun j _ ↦ continuous_finsetSum _ (fun i _ ↦ hc i j))) theorem tangentialBound_compact (X : (Fin n → ℝ) → Fin n → ℝ) (hcX : ∀ j, HasCompactSupport (fun x ↦ X x j)) : HasCompactSupport (tangentialBound X) := by have hc (i j : Fin n) : HasCompactSupport (fun x ↦ ‖fderiv ℝ (fun y ↦ X y j) x (Pi.single i 1)‖) := ((hcX j).fderiv_apply ℝ (Pi.single i 1)).norm have h1 : HasCompactSupport (fun x ↦ ∑ j, ‖fderiv ℝ (fun y ↦ X y j) x (Pi.single j 1)‖) := by convert (HasCompactSupport.finset_sum (s := Finset.univ) (fun j _ ↦ hc j j)) using 1 ext x simp only [Finset.sum_apply] have h2 (j : Fin n) : HasCompactSupport (fun x ↦ ∑ i, ‖fderiv ℝ (fun y ↦ X y j) x (Pi.single i 1)‖) := by convert (HasCompactSupport.finset_sum (s := Finset.univ) (fun i _ ↦ hc i j)) using 1 ext x simp only [Finset.sum_apply] have h3 : HasCompactSupport (fun x ↦ ∑ j, ∑ i, ‖fderiv ℝ (fun y ↦ X y j) x (Pi.single i 1)‖) := by convert (HasCompactSupport.finset_sum (s := Finset.univ) (fun j _ ↦ h2 j)) using 1 ext x simp only [Finset.sum_apply] exact h1.add h3 /-- A continuous compact envelope controls tangential divergence even where the normalized polynomial gradient is discontinuous. -/ theorem norm_tangentialDivergence_le (P : MvPolynomial (Fin n) ℝ) (X : (Fin n → ℝ) → Fin n → ℝ) (x : Fin n → ℝ) : ‖tangentialDivergence P X x‖ ≤ tangentialBound X x := by unfold tangentialDivergence tangentialBound apply (norm_sub_le _ _).trans apply add_le_add · exact norm_sum_le _ _ · apply (norm_sum_le _ _).trans apply Finset.sum_le_sum intro j _ apply norm_pair_le intro i rw [norm_mul] simpa only [one_mul] using mul_le_mul (leadingNormalizedField_bound P x i) (leadingNormalizedField_bound P x j) (norm_nonneg _) zero_le_one /-- A tangential-divergence inequality in a fixed polynomial strip extends to a global inequality with a compact error proportional to the polynomial value. -/ theorem exists_level_error_of_strip (P : MvPolynomial (Fin n) ℝ) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ j, ContDiff ℝ 1 (fun x ↦ X x j)) (hcX : ∀ j, HasCompactSupport (fun x ↦ X x j)) {η : (Fin n → ℝ) → ℝ} (hη : Continuous η) (hcη : HasCompactSupport η) {δ : ℝ} (hδ : 0 < δ) (hlower : ∀ x, |eval x P| < δ → η x ≤ tangentialDivergence P X x) : ∃ b : (Fin n → ℝ) → ℝ, Continuous b ∧ HasCompactSupport b ∧ (∀ x, 0 ≤ b x) ∧ (∀ x, η x ≤ tangentialDivergence P X x + |eval x P| * b x) := by let E := fun x ↦ |η x| + tangentialBound X x let b := fun x ↦ E x / δ have hE (x : Fin n → ℝ) : 0 ≤ E x := add_nonneg (abs_nonneg _) (tangentialBound_nonneg X x) have hb (x : Fin n → ℝ) : 0 ≤ b x := div_nonneg (hE x) hδ.le have hcE : HasCompactSupport E := hcη.abs.add (tangentialBound_compact X hcX) have hcb : HasCompactSupport b := by simpa only [b, div_eq_mul_inv, Pi.mul_def] using (hcE.mul_right (f' := fun _ ↦ δ⁻¹)) refine ⟨b, (hη.abs.add (tangentialBound_continuous X hX)).div_const δ, hcb, hb, ?_⟩ intro x by_cases hx : |eval x P| < δ · exact (hlower x hx).trans (le_add_of_nonneg_right (mul_nonneg (abs_nonneg _) (hb x))) · have hδx : δ ≤ |eval x P| := le_of_not_gt hx have he : E x ≤ |eval x P| * b x := by calc E x = δ * b x := by dsimp only [b]; field_simp _ ≤ _ := mul_le_mul_of_nonneg_right hδx (hb x) have hd := norm_tangentialDivergence_le P X x rw [Real.norm_eq_abs] at hd have hη' := le_abs_self (η x) have ht := neg_le_abs (tangentialDivergence P X x) dsimp only [E] at he linarith end end Source29TangentialDivergenceBound /- Component: LocalizedStressBarrier.inc -/ namespace Source29LocalizedStressBarrier open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.QuarticPolynomialBasics open Source29VariationConvexity Source29WeakCalibrationLimits Source29PolynomialStress open Source29NonlinearCalibration Source29SmoothPhaseTransition Source29LevelStressStationarity open Source29PhaseMassLimit Source29TopPhasePerimeter Source29StressBarrier open Source29TransitionLevelError Source29TangentialDivergenceBound open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem phaseMass_nonpos_of_level_error (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ j, ContDiff ℝ 1 (fun x ↦ X x j)) (hcX : ∀ j, HasCompactSupport (fun x ↦ X x j)) {η : (Fin n → ℝ) → ℝ} (hη : ContDiff ℝ 1 η) (hcη : HasCompactSupport η) {b : (Fin n → ℝ) → ℝ} (hb : Continuous b) (hcb : HasCompactSupport b) (hlower : ∀ x, η x ≤ tangentialDivergence P X x + |eval x P| * b x) : phaseMass P η ≤ 0 := by apply le_of_tendsto_of_tendsto (phaseMass_tendsto P hP hcal hη hcη) (level_error_tendsto_zero P hb hcb) apply Filter.Eventually.of_forall intro k obtain ⟨hi, hz⟩ := weighted_stress_integral_zero P hcal X hX hcX (transition_deriv_contDiff k) have hm := (localized_gradient_mass_identity P hcal hη hcη (transition_contDiff k) (transition_norm_le_one k)).1 have he := level_error_integrable P hb hcb k calc _ ≤ ∫ x, deriv (transition k) (eval x P) * stressPair P X x + b x * |eval x P| * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x) := by apply integral_mono hm (hi.add he) intro x have h := mul_le_mul_of_nonneg_right (hlower x) (mul_nonneg (transition_deriv_nonneg k (eval x P)) (show 0 ≤ variationDensity (evaluatedGradient P x) from Real.sqrt_nonneg _)) dsimp only [Pi.add_apply] rw [stressPair_eq_tangentialDivergence] convert h using 1 <;> ring _ = _ := by rw [integral_add hi he, hz, zero_add] /-- The barrier inequality is needed only in an arbitrary fixed strip around the zero level. Compactness controls its failure outside the strip. -/ theorem phaseMass_nonpos_of_strip (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (X : (Fin n → ℝ) → Fin n → ℝ) (hX : ∀ j, ContDiff ℝ 1 (fun x ↦ X x j)) (hcX : ∀ j, HasCompactSupport (fun x ↦ X x j)) {η : (Fin n → ℝ) → ℝ} (hη : ContDiff ℝ 1 η) (hcη : HasCompactSupport η) {δ : ℝ} (hδ : 0 < δ) (hlower : ∀ x, |eval x P| < δ → η x ≤ tangentialDivergence P X x) : phaseMass P η ≤ 0 := by obtain ⟨b, hb, hcb, _, hl⟩ := exists_level_error_of_strip P X hX hcX hη.continuous hcη hδ hlower exact phaseMass_nonpos_of_level_error P hP hcal X hX hcX hη hcη hb hcb hl /-- A leading zero cannot admit a positive tangential-divergence barrier even when its inequality is only assumed near the zero level. -/ theorem top_no_positive_strip_barrier (P : MvPolynomial (Fin 8) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (c : Fin 8 → ℝ) (hc : eval c (homogeneousComponent P.totalDegree P) = 0) (r : ℝ) (hr : 0 < r) (X : (Fin 8 → ℝ) → Fin 8 → ℝ) (hX : ∀ j, ContDiff ℝ 1 (fun x ↦ X x j)) (hcX : ∀ j, HasCompactSupport (fun x ↦ X x j)) {η : (Fin 8 → ℝ) → ℝ} (hη : ContDiff ℝ 1 η) (hcη : HasCompactSupport η) (hηpos : ∀ x, 0 ≤ η x) (hηone : ∀ x ∈ Metric.closedBall c r, η x = 1) {δ : ℝ} (hδ : 0 < δ) (hlower : ∀ x, |eval x (homogeneousComponent P.totalDegree P)| < δ → η x ≤ tangentialDivergence (homogeneousComponent P.totalDegree P) X x) : False := by have hp := top_phaseMass_pos_at_zero P hmin hdeg c hc r hr hη hcη hηpos hηone have hn := phaseMass_nonpos_of_strip _ (top_homogeneousComponent_ne_zero P (by omega)) (top_weakCalibration P hmin hdeg) X hX hcX hη hcη hδ hlower exact (not_lt_of_ge hn) hp end end Source29LocalizedStressBarrier /- Component: CompactPenalty.inc -/ namespace Source29CompactPenalty open Set open scoped Topology noncomputable section /-- If a continuous quantity is positive where a nonnegative penalty vanishes, then one finite penalty coefficient makes it uniformly positive on a compact set. -/ theorem exists_uniform_positive_penalty {E : Type*} [TopologicalSpace E] (K : Set E) (hK : IsCompact K) (a b : E → ℝ) (ha : Continuous a) (hb : Continuous b) (hbnonneg : ∀ x ∈ K, 0 ≤ b x) (hzero : ∀ x ∈ K, b x = 0 → 0 < a x) : ∃ L ε : ℝ, 0 ≤ L ∧ 0 < ε ∧ ∀ x ∈ K, ε ≤ a x + L * b x := by classical let U : ℕ → Set E := fun k ↦ {x | 0 < a x + (k : ℝ) * b x} have hop (k : ℕ) : IsOpen (U k) := isOpen_lt continuous_const (ha.add (continuous_const.mul hb)) have hcover : K ⊆ ⋃ k, U k := by intro x hx apply Set.mem_iUnion.mpr by_cases hz : b x = 0 · exact ⟨0, by simpa only [U, Set.mem_ofPred_eq, Nat.cast_zero, zero_mul, add_zero] using hzero x hx hz⟩ · have hp : 0 < b x := lt_of_le_of_ne (hbnonneg x hx) (Ne.symm hz) obtain ⟨k, hk⟩ := exists_nat_gt (-a x / b x) refine ⟨k, ?_⟩ have hm := (div_lt_iff₀ hp).mp hk change 0 < a x + (k : ℝ) * b x linarith obtain ⟨s, hs⟩ := hK.elim_finite_subcover U hop hcover let M : ℕ := s.sup id have hpos : ∀ x ∈ K, 0 < a x + (M : ℝ) * b x := by intro x hx obtain ⟨k, hk⟩ := Set.mem_iUnion.mp (hs hx) obtain ⟨hks, hku⟩ := Set.mem_iUnion.mp hk have hle : k ≤ M := Finset.le_sup (f := id) hks have hle' : (k : ℝ) ≤ (M : ℝ) := by exact_mod_cast hle exact (show 0 < a x + (k : ℝ) * b x from hku).trans_le (add_le_add le_rfl (mul_le_mul_of_nonneg_right hle' (hbnonneg x hx))) obtain ⟨ε, hε, he⟩ := hK.exists_forall_le' (ha.add (continuous_const.mul hb)).continuousOn hpos exact ⟨M, ε, Nat.cast_nonneg _, hε, he⟩ end end Source29CompactPenalty /- Component: NormalBall.inc -/ namespace Source29NormalBall open MvPolynomial MeasureTheory open Source29QuarticReuse.FluxObstruction Source29VariationConvexity open scoped BigOperators noncomputable section variable {n : ℕ} def sqNorm (v : Fin n → ℝ) : ℝ := ∑ i, v i ^ 2 def normalBall (n : ℕ) : Set (Fin n → ℝ) := {v | sqNorm v ≤ 1} theorem sqNorm_nonneg (v : Fin n → ℝ) : 0 ≤ sqNorm v := Finset.sum_nonneg (fun i _ ↦ sq_nonneg _) theorem sqNorm_pos {v : Fin n → ℝ} (hv : v ≠ 0) : 0 < sqNorm v := by have h := variationDensity_pos hv have hs := variationDensity_sq v change variationDensity v ^ 2 = sqNorm v at hs nlinarith theorem sqNorm_continuous : Continuous (sqNorm : (Fin n → ℝ) → ℝ) := continuous_finsetSum _ (fun i _ ↦ (continuous_apply i).pow 2) theorem normalBall_compact (n : ℕ) : IsCompact (normalBall n) := by have hc : IsClosed (normalBall n) := isClosed_le sqNorm_continuous continuous_const apply (isCompact_Icc : IsCompact (Set.Icc (fun _ : Fin n ↦ (-1 : ℝ)) (fun _ ↦ (1 : ℝ)))).of_isClosed_subset hc intro v hv have hvi (i : Fin n) : v i ^ 2 ≤ 1 := (Finset.single_le_sum (fun j _ ↦ sq_nonneg (v j)) (Finset.mem_univ i)).trans hv constructor <;> intro i <;> nlinarith [hvi i] /-- The actual normalized polynomial gradient belongs to the Euclidean closed unit ball, including at its critical points. -/ theorem leadingNormalizedField_mem (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) : leadingNormalizedField P x ∈ normalBall n := by by_cases hz : evaluatedGradient P x = 0 · simp only [normalBall, Set.mem_ofPred_eq, sqNorm, leadingNormalizedField, hz, Pi.zero_apply, zero_div, zero_pow (by decide : 2 ≠ 0), Finset.sum_const_zero] norm_num · have hp := sqNorm_pos hz have hs := Real.sq_sqrt hp.le change sqNorm (leadingNormalizedField P x) ≤ 1 simp only [sqNorm, leadingNormalizedField, div_pow, ← Finset.sum_div] change sqNorm (evaluatedGradient P x) / (Real.sqrt (sqNorm (evaluatedGradient P x))) ^ 2 ≤ 1 rw [hs, div_self hp.ne'] end end Source29NormalBall /- Component: NormalPenalty.inc -/ namespace Source29NormalPenalty open Source29NormalBall open scoped BigOperators noncomputable section variable {n : ℕ} def dot (v w : Fin n → ℝ) : ℝ := ∑ i, v i * w i def quad (H : Fin n → Fin n → ℝ) (v : Fin n → ℝ) : ℝ := ∑ i, ∑ j, H i j * v i * v j def trace (H : Fin n → Fin n → ℝ) : ℝ := ∑ i, H i i def projectedTrace (H : Fin n → Fin n → ℝ) (N : Fin n → ℝ) : ℝ := trace H - quad H N def penalty (v N : Fin n → ℝ) : ℝ := sqNorm v - (dot N v) ^ 2 theorem penalty_nonneg (v : Fin n → ℝ) {N : Fin n → ℝ} (hN : N ∈ normalBall n) : 0 ≤ penalty v N := by have hcs := Finset.sum_mul_sq_le_sq_mul_sq Finset.univ N v change (dot N v) ^ 2 ≤ sqNorm N * sqNorm v at hcs have hm := mul_le_mul_of_nonneg_right (show sqNorm N ≤ 1 from hN) (sqNorm_nonneg v) dsimp only [penalty] nlinarith theorem residual_sq (v N : Fin n → ℝ) (c : ℝ) : (∑ i, (v i - c * N i) ^ 2) = sqNorm v - 2 * c * dot N v + c ^ 2 * sqNorm N := by calc _ = ∑ i, (v i ^ 2 - (2 * c) * (N i * v i) + c ^ 2 * N i ^ 2) := by apply Finset.sum_congr rfl intro i _ ring _ = _ := by simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib, ← Finset.mul_sum, sqNorm, dot] theorem coordinates_of_penalty_zero (v : Fin n → ℝ) {N : Fin n → ℝ} (hN : N ∈ normalBall n) (hz : penalty v N = 0) : ∀ i, v i = dot N v * N i := by let c := dot N v have he : c ^ 2 = sqNorm v := by dsimp [penalty] at hz; dsimp [c]; linarith have hr := residual_sq v N c have hm := mul_le_mul_of_nonneg_left (show sqNorm N ≤ 1 from hN) (sq_nonneg c) have hn : (∑ i, (v i - c * N i) ^ 2) ≤ 0 := by change _ = sqNorm v - 2 * c * c + c ^ 2 * sqNorm N at hr nlinarith intro i have hi := Finset.single_le_sum (fun j _ ↦ sq_nonneg (v j - c * N j)) (Finset.mem_univ i) have hs : (v i - c * N i) ^ 2 = 0 := le_antisymm (hi.trans hn) (sq_nonneg _) exact sub_eq_zero.mp (sq_eq_zero_iff.mp hs) theorem quad_smul (H : Fin n → Fin n → ℝ) (v : Fin n → ℝ) (c : ℝ) : quad H (fun i ↦ c * v i) = c ^ 2 * quad H v := by simp only [quad, Finset.mul_sum] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ ring /-- Vanishing penalty identifies the trace with the trace on the hyperplane orthogonal to the nonzero vector v. No sign choice for N is needed. -/ theorem projectedTrace_of_penalty_zero (H : Fin n → Fin n → ℝ) (v : Fin n → ℝ) (hv : v ≠ 0) {N : Fin n → ℝ} (hN : N ∈ normalBall n) (hz : penalty v N = 0) : projectedTrace H N = trace H - quad H v / sqNorm v := by have hpos := sqNorm_pos hv have hc : (dot N v) ^ 2 = sqNorm v := by dsimp only [penalty] at hz; linarith have he : v = (fun i ↦ dot N v * N i) := funext (coordinates_of_penalty_zero v hN hz) have hq : quad H v = (dot N v) ^ 2 * quad H N := by calc quad H v = quad H (fun i ↦ dot N v * N i) := congrArg (quad H) he _ = _ := quad_smul H N _ rw [hq, hc] unfold projectedTrace field_simp theorem quad_continuous (H : Fin n → Fin n → ℝ) : Continuous (quad H) := by apply continuous_finsetSum intro i _ apply continuous_finsetSum intro j _ exact (continuous_const.mul (continuous_apply i)).mul (continuous_apply j) theorem projectedTrace_continuous (H : Fin n → Fin n → ℝ) : Continuous (projectedTrace H) := continuous_const.sub (quad_continuous H) theorem penalty_continuous (v : Fin n → ℝ) : Continuous (penalty v) := continuous_const.sub ((continuous_finsetSum _ (fun i _ ↦ (continuous_apply i).mul continuous_const)).pow 2) end end Source29NormalPenalty /- Component: CurvaturePenalty.inc -/ namespace Source29CurvaturePenalty open Filter Source29NormalBall Source29NormalPenalty Source29CompactPenalty open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- Positive curvature in the hyperplane normal to v gives a uniform corrected trace estimate over every candidate unit normal. -/ theorem exists_normal_penalty (H : Fin n → Fin n → ℝ) (v : Fin n → ℝ) (hv : v ≠ 0) (hcurv : 0 < trace H - quad H v / sqNorm v) : ∃ L ε : ℝ, 0 ≤ L ∧ 0 < ε ∧ ∀ N ∈ normalBall n, ε ≤ projectedTrace H N + L * penalty v N := by apply exists_uniform_positive_penalty (normalBall n) (normalBall_compact n) (projectedTrace H) (penalty v) (projectedTrace_continuous H) (penalty_continuous v) (fun _ hN ↦ penalty_nonneg v hN) intro N hN hz rw [projectedTrace_of_penalty_zero H v hv hN hz] exact hcurv theorem projectedTrace_joint_continuous {E : Type*} [TopologicalSpace E] (H : E → Fin n → Fin n → ℝ) (hH : ∀ i j, Continuous (fun x ↦ H x i j)) : Continuous (fun z : E × (Fin n → ℝ) ↦ projectedTrace (H z.1) z.2) := by apply Continuous.sub · exact continuous_finsetSum _ (fun i _ ↦ (hH i i).comp continuous_fst) · apply continuous_finsetSum intro i _ apply continuous_finsetSum intro j _ exact (((hH i j).comp continuous_fst).mul ((continuous_apply i).comp continuous_snd)).mul ((continuous_apply j).comp continuous_snd) theorem penalty_joint_continuous {E : Type*} [TopologicalSpace E] (v : E → Fin n → ℝ) (hv : ∀ i, Continuous (fun x ↦ v x i)) : Continuous (fun z : E × (Fin n → ℝ) ↦ penalty (v z.1) z.2) := by apply Continuous.sub · exact continuous_finsetSum _ (fun i _ ↦ ((hv i).comp continuous_fst).pow 2) · apply Continuous.pow apply continuous_finsetSum intro i _ exact ((continuous_apply i).comp continuous_snd).mul ((hv i).comp continuous_fst) /-- The corrected trace remains uniformly positive near the contact point, with the same correction coefficient for all candidate normals. -/ theorem exists_local_normal_penalty {E : Type*} [TopologicalSpace E] (H : E → Fin n → Fin n → ℝ) (v : E → Fin n → ℝ) (hH : ∀ i j, Continuous (fun x ↦ H x i j)) (hv : ∀ i, Continuous (fun x ↦ v x i)) (c : E) (hne : v c ≠ 0) (hcurv : 0 < trace (H c) - quad (H c) (v c) / sqNorm (v c)) : ∃ L ε : ℝ, 0 ≤ L ∧ 0 < ε ∧ ∀ᶠ x in 𝓝 c, ∀ N ∈ normalBall n, ε ≤ projectedTrace (H x) N + L * penalty (v x) N := by obtain ⟨L, ε, hL, hε, hpos⟩ := exists_normal_penalty (H c) (v c) hne hcurv have hf : Continuous (fun z : E × (Fin n → ℝ) ↦ projectedTrace (H z.1) z.2 + L * penalty (v z.1) z.2) := (projectedTrace_joint_continuous H hH).add (continuous_const.mul (penalty_joint_continuous v hv)) have he : ∀ᶠ x in 𝓝 c, ∀ N ∈ normalBall n, ε / 2 < projectedTrace (H x) N + L * penalty (v x) N := by apply (normalBall_compact n).eventually_forall_of_forall_eventually intro N hN exact (isOpen_lt continuous_const hf).mem_nhds (by have hp := hpos N hN change ε / 2 < projectedTrace (H c) N + L * penalty (v c) N linarith) exact ⟨L, ε / 2, hL, by positivity, he.mono fun x hx N hN ↦ (hx N hN).le⟩ end end Source29CurvaturePenalty /- Component: ProjectedTraceAlgebra.inc -/ namespace Source29ProjectedTraceAlgebra open Source29NormalBall Source29NormalPenalty open scoped BigOperators noncomputable section variable {n : ℕ} theorem projectedTrace_add (A B : Fin n → Fin n → ℝ) (N : Fin n → ℝ) : projectedTrace (fun i j ↦ A i j + B i j) N = projectedTrace A N + projectedTrace B N := by simp only [projectedTrace, trace, quad, add_mul, Finset.sum_add_distrib] ring theorem projectedTrace_smul (a : ℝ) (H : Fin n → Fin n → ℝ) (N : Fin n → ℝ) : projectedTrace (fun i j ↦ a * H i j) N = a * projectedTrace H N := by simp only [projectedTrace, trace, quad, mul_assoc, ← Finset.mul_sum] ring theorem projectedTrace_rank_one (v w N : Fin n → ℝ) : projectedTrace (fun i j ↦ v i * w j) N = dot v w - dot N v * dot N w := by have hq : quad (fun i j ↦ v i * w j) N = dot N v * dot N w := by calc _ = ∑ i, (N i * v i) * (∑ j, N j * w j) := by apply Finset.sum_congr rfl intro i _ rw [Finset.mul_sum] apply Finset.sum_congr rfl intro j _ ring _ = _ := by rw [← Finset.sum_mul]; rfl rw [projectedTrace, hq] rfl theorem projectedTrace_square (v N : Fin n → ℝ) : projectedTrace (fun i j ↦ v i * v j) N = penalty v N := by rw [projectedTrace_rank_one] simp only [penalty, dot, sqNorm, pow_two] end end Source29ProjectedTraceAlgebra /- Component: GradientBarrierCalculus.inc -/ namespace Source29GradientBarrierCalculus open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29PolynomialStress open Source29NormalBall Source29NormalPenalty Source29CurvaturePenalty Source29ProjectedTraceAlgebra open scoped Topology BigOperators noncomputable section variable {n : ℕ} def coordinateGradient (u : (Fin n → ℝ) → ℝ) (x : Fin n → ℝ) (i : Fin n) : ℝ := fderiv ℝ u x (Pi.single i 1) def coordinateJacobian (X : (Fin n → ℝ) → Fin n → ℝ) (x : Fin n → ℝ) (i j : Fin n) : ℝ := fderiv ℝ (fun y ↦ X y j) x (Pi.single i 1) def coordinateHessian (u : (Fin n → ℝ) → ℝ) := coordinateJacobian (coordinateGradient u) theorem gradient_contDiff {u : (Fin n → ℝ) → ℝ} (hu : ContDiff ℝ 2 u) (i : Fin n) : ContDiff ℝ 1 (fun x ↦ coordinateGradient u x i) := by have hd : ContDiff ℝ 1 (fderiv ℝ u) := hu.fderiv_right (by norm_num) exact hd.clm_apply contDiff_const theorem hessian_continuous {u : (Fin n → ℝ) → ℝ} (hu : ContDiff ℝ 2 u) (i j : Fin n) : Continuous (fun x ↦ coordinateHessian u x i j) := ((gradient_contDiff hu j).continuous_fderiv (by norm_num)).clm_apply continuous_const theorem tangentialDivergence_eq_projectedTrace (P : MvPolynomial (Fin n) ℝ) (X : (Fin n → ℝ) → Fin n → ℝ) (x : Fin n → ℝ) : tangentialDivergence P X x = projectedTrace (coordinateJacobian X x) (leadingNormalizedField P x) := by unfold tangentialDivergence projectedTrace trace quad divergence coordinateJacobian congr 1 rw [Finset.sum_comm] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ ring /-- The local uniform normal estimate, applied to an actual C2 scalar test. -/ theorem test_local_normal_penalty {u : (Fin n → ℝ) → ℝ} (hu : ContDiff ℝ 2 u) (c : Fin n → ℝ) (hne : coordinateGradient u c ≠ 0) (hcurv : 0 < trace (coordinateHessian u c) - quad (coordinateHessian u c) (coordinateGradient u c) / sqNorm (coordinateGradient u c)) : ∃ L ε : ℝ, 0 ≤ L ∧ 0 < ε ∧ ∀ᶠ x in 𝓝 c, ∀ N ∈ normalBall n, ε ≤ projectedTrace (coordinateHessian u x) N + L * penalty (coordinateGradient u x) N := exists_local_normal_penalty _ _ (hessian_continuous hu) (fun i ↦ (gradient_contDiff hu i).continuous) c hne hcurv def barrierField (u χ : (Fin n → ℝ) → ℝ) (h : ℝ → ℝ) (x : Fin n → ℝ) (j : Fin n) : ℝ := χ x * h (u x) * coordinateGradient u x j theorem barrierField_contDiff {u χ : (Fin n → ℝ) → ℝ} {h : ℝ → ℝ} (hu : ContDiff ℝ 2 u) (hχ : ContDiff ℝ 1 χ) (hh : ContDiff ℝ 1 h) (j : Fin n) : ContDiff ℝ 1 (fun x ↦ barrierField u χ h x j) := (hχ.mul (hh.comp (hu.of_le (by norm_num)))).mul (gradient_contDiff hu j) theorem barrierField_compact {u χ : (Fin n → ℝ) → ℝ} {h : ℝ → ℝ} (hcχ : HasCompactSupport χ) (j : Fin n) : HasCompactSupport (fun x ↦ barrierField u χ h x j) := hcχ.mul_right.mul_right theorem barrierField_jacobian {u χ : (Fin n → ℝ) → ℝ} {h : ℝ → ℝ} (hu : ContDiff ℝ 2 u) (hχ : ContDiff ℝ 1 χ) (hh : ContDiff ℝ 1 h) (x : Fin n → ℝ) (i j : Fin n) : coordinateJacobian (barrierField u χ h) x i j = (χ x * h (u x)) * coordinateHessian u x i j + (χ x * deriv h (u x)) * (coordinateGradient u x i * coordinateGradient u x j) + h (u x) * (coordinateGradient χ x i * coordinateGradient u x j) := by have hu1 : ContDiff ℝ 1 u := hu.of_le (by norm_num) have dh := ((hh.differentiable (by norm_num) (u x)).hasDerivAt).comp_hasFDerivAt x ((hu1.differentiable (by norm_num) x).hasFDerivAt) have dp := ((hχ.differentiable (by norm_num) x).hasFDerivAt).fun_mul dh have dt := dp.fun_mul (((gradient_contDiff hu j).differentiable (by norm_num) x).hasFDerivAt) have he := congrArg (fun L : (Fin n → ℝ) →L[ℝ] ℝ ↦ L (Pi.single i 1)) dt.fderiv have he' : coordinateJacobian (barrierField u χ h) x i j = coordinateGradient u x j * (h (u x) * coordinateGradient χ x i + χ x * (deriv h (u x) * coordinateGradient u x i)) + (χ x * h (u x)) * coordinateHessian u x i j := by simpa only [coordinateJacobian, barrierField, coordinateGradient, coordinateHessian, ContinuousLinearMap.add_apply, _root_.smul_apply, smul_eq_mul, Function.comp_def, add_comm] using he rw [he'] ring /-- Exact tangential-divergence formula for the cutoff gradient field used in geometric touching barriers. -/ theorem barrierField_tangentialDivergence (P : MvPolynomial (Fin n) ℝ) {u χ : (Fin n → ℝ) → ℝ} {h : ℝ → ℝ} (hu : ContDiff ℝ 2 u) (hχ : ContDiff ℝ 1 χ) (hh : ContDiff ℝ 1 h) (x : Fin n → ℝ) : let N := leadingNormalizedField P x tangentialDivergence P (barrierField u χ h) x = (χ x * h (u x)) * projectedTrace (coordinateHessian u x) N + (χ x * deriv h (u x)) * penalty (coordinateGradient u x) N + h (u x) * (dot (coordinateGradient χ x) (coordinateGradient u x) - dot N (coordinateGradient χ x) * dot N (coordinateGradient u x)) := by have hj : coordinateJacobian (barrierField u χ h) x = (fun i j ↦ (χ x * h (u x)) * coordinateHessian u x i j + (χ x * deriv h (u x)) * (coordinateGradient u x i * coordinateGradient u x j) + h (u x) * (coordinateGradient χ x i * coordinateGradient u x j)) := funext fun i ↦ funext fun j ↦ barrierField_jacobian hu hχ hh x i j rw [tangentialDivergence_eq_projectedTrace, hj] simp only [projectedTrace_add, projectedTrace_smul, projectedTrace_square, projectedTrace_rank_one] /-- Where the spatial cutoff is constant, the normal penalty and profile slope turn the curvature estimate into a quantitative positive divergence. -/ theorem barrierField_lower_at_flat_cutoff (P : MvPolynomial (Fin n) ℝ) {u χ : (Fin n → ℝ) → ℝ} {h : ℝ → ℝ} (hu : ContDiff ℝ 2 u) (hχ : ContDiff ℝ 1 χ) (hh : ContDiff ℝ 1 h) (x : Fin n → ℝ) (hχpos : 0 ≤ χ x) (hflat : coordinateGradient χ x = 0) (hhpos : 0 ≤ h (u x)) (L ε : ℝ) (hslope : L * h (u x) ≤ deriv h (u x)) (htrace : ε ≤ projectedTrace (coordinateHessian u x) (leadingNormalizedField P x) + L * penalty (coordinateGradient u x) (leadingNormalizedField P x)) : χ x * h (u x) * ε ≤ tangentialDivergence P (barrierField u χ h) x := by have hp := penalty_nonneg (coordinateGradient u x) (leadingNormalizedField_mem P x) have h1 := mul_le_mul_of_nonneg_left htrace (mul_nonneg hχpos hhpos) have h2 := mul_nonneg (mul_nonneg hχpos (sub_nonneg.mpr hslope)) hp rw [barrierField_tangentialDivergence P hu hχ hh] simp only [hflat, dot, Pi.zero_apply, zero_mul, mul_zero, Finset.sum_const_zero, sub_self, mul_zero, add_zero] nlinarith end end Source29GradientBarrierCalculus /- Component: RisingBarrierProfile.inc -/ namespace Source29RisingBarrierProfile open Source29QuarticReuse.FluxObstruction open scoped Topology noncomputable section def profile (δ t : ℝ) : ℝ := expNegInvGlue (t + δ) theorem profile_contDiff (δ : ℝ) : ContDiff ℝ 1 (profile δ) := expNegInvGlue.contDiff.comp (contDiff_id.add contDiff_const) theorem profile_nonneg (δ t : ℝ) : 0 ≤ profile δ t := expNegInvGlue.nonneg _ theorem profile_zero (δ t : ℝ) (ht : t ≤ -δ) : profile δ t = 0 := expNegInvGlue.zero_of_nonpos (by linarith) theorem profile_pos (δ t : ℝ) (ht : -δ < t) : 0 < profile δ t := expNegInvGlue.pos_of_pos (by linarith) theorem profile_deriv (δ t : ℝ) : deriv (profile δ) t = (t + δ)⁻¹ ^ 2 * profile δ t := by have h := (expNegInvGlue_hasDerivAt (t + δ)).comp t ((hasDerivAt_id t).add_const δ) change deriv (fun s ↦ expNegInvGlue (s + δ)) t = (t + δ)⁻¹ ^ 2 * expNegInvGlue (t + δ) simpa only [Function.comp_def, mul_one, id_eq] using h.deriv theorem profile_deriv_zero (δ t : ℝ) (ht : t ≤ -δ) : deriv (profile δ) t = 0 := by rw [profile_deriv, profile_zero δ t ht, mul_zero] /-- The profile is flat on one side and has arbitrarily large relative slope on a sufficiently short interval about zero. -/ theorem profile_deriv_lower {L δ : ℝ} (hL : 0 ≤ L) (hδ : 0 < δ) (hsmall : L * (2 * δ) ^ 2 ≤ 1) (t : ℝ) (ht : t ≤ δ) : L * profile δ t ≤ deriv (profile δ) t := by rw [profile_deriv] by_cases hs : 0 < t + δ · have hsq : (t + δ) ^ 2 ≤ (2 * δ) ^ 2 := by nlinarith have hmul : L * (t + δ) ^ 2 ≤ 1 := (mul_le_mul_of_nonneg_left hsq hL).trans hsmall have hi : L ≤ (t + δ)⁻¹ ^ 2 := by have h := (le_div_iff₀ (sq_pos_of_pos hs)).mpr hmul simpa only [one_div, inv_pow] using h exact mul_le_mul_of_nonneg_right hi (profile_nonneg δ t) · have hz := profile_zero δ t (by linarith) rw [hz, mul_zero, mul_zero] /-- The width may be chosen below any prescribed positive geometric margin. -/ theorem exists_small_profile (L : ℝ) (hL : 0 ≤ L) (r : ℝ) (hr : 0 < r) : ∃ δ : ℝ, 0 < δ ∧ δ < r ∧ (∀ t, 0 ≤ profile δ t) ∧ (∀ t, t ≤ -δ → profile δ t = 0) ∧ 0 < profile δ 0 ∧ (∀ t, t ≤ δ → L * profile δ t ≤ deriv (profile δ) t) := by let δ := min (r / 2) (1 / (2 * (L + 1))) have hδ : 0 < δ := lt_min (by positivity) (by positivity) have hd1 : δ ≤ r / 2 := min_le_left _ _ have hd2 : δ ≤ 1 / (2 * (L + 1)) := min_le_right _ _ have hm : 2 * (L + 1) * δ ≤ 1 := by have h := (le_div_iff₀ (by positivity : 0 < 2 * (L + 1))).mp hd2 nlinarith have hLd : 0 ≤ L * δ := mul_nonneg hL hδ.le have ht : 2 * δ ≤ 1 := by nlinarith have hs : (2 * δ) ^ 2 ≤ 2 * δ := by nlinarith have hsmall : L * (2 * δ) ^ 2 ≤ 1 := by have h := mul_le_mul_of_nonneg_left hs hL nlinarith refine ⟨δ, hδ, by linarith, profile_nonneg δ, profile_zero δ, profile_pos δ 0 (by linarith), ?_⟩ exact profile_deriv_lower hL hδ hsmall end end Source29RisingBarrierProfile /- Component: CompactZeroSeparation.inc -/ namespace Source29CompactZeroSeparation open Set open scoped Topology noncomputable section /-- A strict inequality on the zero set extends to a uniform level strip inside a compact set. -/ theorem strip_of_zero_inequality {E : Type*} [TopologicalSpace E] (K : Set E) (hK : IsCompact K) (F u : E → ℝ) (hF : Continuous F) (hu : Continuous u) (a : ℝ) (hzero : ∀ x ∈ K, F x = 0 → u x < a) : ∃ δ : ℝ, 0 < δ ∧ ∀ x ∈ K, |F x| < δ → u x < a := by let B := K ∩ {x | a ≤ u x} have hB : IsCompact B := hK.inter_right (isClosed_le continuous_const hu) have hpos : ∀ x ∈ B, 0 < |F x| := by intro x hx apply abs_pos.mpr intro hz exact (not_lt_of_ge hx.2) (hzero x hx.1 hz) obtain ⟨δ, hδ, hb⟩ := hB.exists_forall_le' hF.abs.continuousOn hpos refine ⟨δ, hδ, ?_⟩ intro x hx hfx by_contra hux exact (not_lt_of_ge (hb x ⟨hx, le_of_not_gt hux⟩)) hfx /-- Strict negativity on the compact zero locus supplies both a uniform negative margin and a uniform strip on which it persists. -/ theorem negative_margin_strip {E : Type*} [TopologicalSpace E] (K : Set E) (hK : IsCompact K) (F u : E → ℝ) (hF : Continuous F) (hu : Continuous u) (hzero : ∀ x ∈ K, F x = 0 → u x < 0) : ∃ a δ : ℝ, 0 < a ∧ 0 < δ ∧ ∀ x ∈ K, |F x| < δ → u x ≤ -a := by let Z := K ∩ {x | F x = 0} have hZ : IsCompact Z := hK.inter_right (isClosed_eq hF continuous_const) have hp : ∀ x ∈ Z, 0 < -u x := by intro x hx exact neg_pos.mpr (hzero x hx.1 hx.2) obtain ⟨a, ha, hbound⟩ := hZ.exists_forall_le' hu.neg.continuousOn hp have hs : ∀ x ∈ K, F x = 0 → u x < -(a / 2) := by intro x hx hz have h := hbound x ⟨hx, hz⟩ change a ≤ -u x at h linarith obtain ⟨δ, hδ, he⟩ := strip_of_zero_inequality K hK F u hF hu (-(a / 2)) hs exact ⟨a / 2, δ, by positivity, hδ, fun x hx hfx ↦ (he x hx hfx).le⟩ end end Source29CompactZeroSeparation /- Component: StrictTouchingField.inc -/ namespace Source29StrictTouchingField open MvPolynomial Filter Set open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial Source29PolynomialStress open Source29NormalBall Source29NormalPenalty Source29GradientBarrierCalculus open Source29RisingBarrierProfile Source29CompactZeroSeparation Source29LocalPhasePerimeter open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- A strict contact and a uniform corrected curvature estimate produce a compact vector field whose tangential divergence is nonnegative near the polynomial zero level and uniformly positive near the contact point. -/ theorem exists_strict_touching_field (F : MvPolynomial (Fin n) ℝ) {u : (Fin n → ℝ) → ℝ} (hu : ContDiff ℝ 2 u) (c : Fin n → ℝ) (huc : u c = 0) (R : ℝ) (hR : 0 < R) (hcontact : ∀ x ∈ Metric.closedBall c R, eval x F = 0 → x ≠ c → u x < 0) (L ε : ℝ) (hL : 0 ≤ L) (hε : 0 < ε) (htrace : ∀ x ∈ Metric.closedBall c R, ∀ N ∈ normalBall n, ε ≤ projectedTrace (coordinateHessian u x) N + L * penalty (coordinateGradient u x) N) : ∃ (X : (Fin n → ℝ) → Fin n → ℝ) (δ s C : ℝ), (∀ j, ContDiff ℝ 1 (fun x ↦ X x j)) ∧ (∀ j, HasCompactSupport (fun x ↦ X x j)) ∧ 0 < δ ∧ 0 < s ∧ 0 < C ∧ (∀ x, |eval x F| < δ → 0 ≤ tangentialDivergence F X x) ∧ (∀ x ∈ Metric.closedBall c s, |eval x F| < δ → C ≤ tangentialDivergence F X x) := by have hhalf : 0 < R / 2 := by positivity have hhalfR : R / 2 < R := by linarith obtain ⟨χ, hχ, hcχ, hsχ, hbχ, honeχ, hflatχ⟩ := exists_local_cutoff (Metric.closedBall c (R / 2)) (Metric.ball c R) (isCompact_closedBall _ _) Metric.isOpen_ball (Metric.closedBall_subset_ball hhalfR) let A := Metric.closedBall c R \ Metric.ball c (R / 2) have hA : IsCompact A := (isCompact_closedBall c R).diff Metric.isOpen_ball have hzeroA : ∀ x ∈ A, eval x F = 0 → u x < 0 := by intro x hx hz apply hcontact x hx.1 hz intro he subst x exact hx.2 (Metric.mem_ball_self hhalf) obtain ⟨a, δa, ha, hδa, hmargin⟩ := negative_margin_strip A hA (fun x ↦ eval x F) u (contDiff_eval F).continuous hu.continuous hzeroA obtain ⟨d, hd, hda, hnonneg, _, hpos, hslope⟩ := exists_small_profile L hL a ha have hzeroB : ∀ x ∈ Metric.closedBall c R, eval x F = 0 → u x < d := by intro x hx hz by_cases he : x = c · simpa only [he, huc] using hd · exact (hcontact x hx hz he).trans hd obtain ⟨δb, hδb, hsmall⟩ := strip_of_zero_inequality (Metric.closedBall c R) (isCompact_closedBall _ _) (fun x ↦ eval x F) u (contDiff_eval F).continuous hu.continuous d hzeroB let δ := min δa δb have hδ : 0 < δ := lt_min hδa hδb let X := barrierField u χ (profile d) have hinner : ∀ x ∈ Metric.closedBall c (R / 2), |eval x F| < δ → profile d (u x) * ε ≤ tangentialDivergence F X x := by intro x hx hfx have hxR : x ∈ Metric.closedBall c R := Metric.closedBall_subset_closedBall hhalfR.le hx have hux := hsmall x hxR (hfx.trans_le (min_le_right _ _)) have hflat : coordinateGradient χ x = 0 := by ext i simp only [coordinateGradient, hflatχ x hx, ContinuousLinearMap.zero_apply, Pi.zero_apply] have h := barrierField_lower_at_flat_cutoff F hu hχ (profile_contDiff d) x (hbχ x).1 hflat (hnonneg _) L ε (hslope _ hux.le) (htrace x hxR _ (leadingNormalizedField_mem F x)) simpa only [honeχ x hx, one_mul] using h have hnonnegative : ∀ x, |eval x F| < δ → 0 ≤ tangentialDivergence F X x := by intro x hfx by_cases hx : x ∈ Metric.closedBall c (R / 2) · exact (mul_nonneg (hnonneg _) hε.le).trans (hinner x hx hfx) · by_cases hxR : x ∈ Metric.closedBall c R · have hxA : x ∈ A := ⟨hxR, fun hb ↦ hx (Metric.ball_subset_closedBall hb)⟩ have hux : u x ≤ -d := by have hm := hmargin x hxA (hfx.trans_le (min_le_left _ _)) linarith change 0 ≤ tangentialDivergence F (barrierField u χ (profile d)) x rw [barrierField_tangentialDivergence F hu hχ (profile_contDiff d)] simp only [profile_zero d (u x) hux, profile_deriv_zero d (u x) hux, mul_zero, zero_mul, add_zero, le_refl] · have hxt : x ∉ tsupport χ := fun ht ↦ hxR (Metric.ball_subset_closedBall (hsχ ht)) have hχzero := image_eq_zero_of_notMem_tsupport hxt have hflat : coordinateGradient χ x = 0 := by ext i simp only [coordinateGradient, fderiv_of_notMem_tsupport ℝ hxt, ContinuousLinearMap.zero_apply, Pi.zero_apply] change 0 ≤ tangentialDivergence F (barrierField u χ (profile d)) x rw [barrierField_tangentialDivergence F hu hχ (profile_contDiff d)] simp only [hχzero, hflat, dot, Pi.zero_apply, mul_zero, zero_mul, Finset.sum_const_zero, sub_self, add_zero, le_refl] have hnear : ∀ᶠ x in 𝓝 c, profile d 0 / 2 < profile d (u x) := by have hc : ContinuousAt (fun x ↦ profile d (u x)) c := ((profile_contDiff d).continuous.comp hu.continuous).continuousAt apply hc.eventually change ∀ᶠ y in 𝓝 (profile d (u c)), profile d 0 / 2 < y rw [huc] exact Ioi_mem_nhds (by linarith) obtain ⟨t, ht, htb⟩ := Metric.mem_nhds_iff.mp hnear let s := min (R / 2) (t / 2) have hs : 0 < s := lt_min hhalf (by positivity) let C := profile d 0 / 2 * ε have hC : 0 < C := mul_pos (by linarith) hε refine ⟨X, δ, s, C, barrierField_contDiff hu hχ (profile_contDiff d), barrierField_compact hcχ, hδ, hs, hC, hnonnegative, ?_⟩ intro x hx hfx have hxi : x ∈ Metric.closedBall c (R / 2) := Metric.closedBall_subset_closedBall (min_le_left _ _) hx have hxt : x ∈ Metric.ball c t := Metric.closedBall_subset_ball (lt_of_le_of_lt (min_le_right _ _) (by linarith)) hx exact (mul_le_mul_of_nonneg_right (htb hxt).le hε.le).trans (hinner x hxi hfx) end end Source29StrictTouchingField /- Component: StrictTouchingObstruction.inc -/ namespace Source29StrictTouchingObstruction open MvPolynomial Filter Set open Source29QuarticReuse.QuarticPolynomialBasics Source29QuarticReuse.FluxObstruction open Source29PolynomialStress Source29NormalBall Source29NormalPenalty open Source29GradientBarrierCalculus Source29StrictTouchingField open Source29LocalPhasePerimeter Source29LocalizedStressBarrier Source29StressBarrier open Source29TopPhasePerimeter Source29PhaseMassFunctional Source29PhaseMassLimit open scoped Topology BigOperators noncomputable section /-- A leading zero admits no compact field with nonnegative tangential divergence on a level strip and strictly positive divergence near that zero. -/ theorem top_no_positive_local_field (P : MvPolynomial (Fin 8) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (c : Fin 8 → ℝ) (hc : eval c (homogeneousComponent P.totalDegree P) = 0) (X : (Fin 8 → ℝ) → Fin 8 → ℝ) (hX : ∀ j, ContDiff ℝ 1 (fun x ↦ X x j)) (hcX : ∀ j, HasCompactSupport (fun x ↦ X x j)) (δ s C : ℝ) (hδ : 0 < δ) (hs : 0 < s) (hC : 0 < C) (hnonneg : ∀ x, |eval x (homogeneousComponent P.totalDegree P)| < δ → 0 ≤ tangentialDivergence (homogeneousComponent P.totalDegree P) X x) (hpositive : ∀ x ∈ Metric.closedBall c s, |eval x (homogeneousComponent P.totalDegree P)| < δ → C ≤ tangentialDivergence (homogeneousComponent P.totalDegree P) X x) : False := by let F := homogeneousComponent P.totalDegree P have hF : F ≠ 0 := top_homogeneousComponent_ne_zero P (by omega) have hcal := top_weakCalibration P hmin hdeg obtain ⟨η, hη, hcη, hsη, hbη, honeη, _⟩ := exists_local_cutoff (Metric.closedBall c (s / 2)) (Metric.ball c s) (isCompact_closedBall _ _) Metric.isOpen_ball (Metric.closedBall_subset_ball (by linarith)) have hweight : ∀ x, |eval x F| < δ → C * η x ≤ tangentialDivergence F X x := by intro x hfx by_cases hx : x ∈ Metric.closedBall c s · exact (mul_le_of_le_one_right hC.le (hbη x).2).trans (hpositive x hx hfx) · have hzero : η x = 0 := image_eq_zero_of_notMem_tsupport (fun ht ↦ hx (Metric.ball_subset_closedBall (hsη ht))) simpa only [hzero, mul_zero] using hnonneg x hfx have hn := phaseMass_nonpos_of_strip F hF hcal X hX hcX (contDiff_const.mul hη) hcη.mul_left hδ hweight rw [phaseMass_const_mul F hF hcal hη hcη C] at hn have hp := top_phaseMass_pos_at_zero P hmin hdeg c hc (s / 2) (by positivity) hη hcη (fun x ↦ (hbη x).1) honeη exact (not_lt_of_ge hn) (mul_pos hC hp) /-- The leading zero set cannot be touched strictly from above by a C2 test whose level hypersurface has strictly positive tangential Hessian trace. -/ theorem top_no_strict_touching (P : MvPolynomial (Fin 8) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) {u : (Fin 8 → ℝ) → ℝ} (hu : ContDiff ℝ 2 u) (c : Fin 8 → ℝ) (hc : eval c (homogeneousComponent P.totalDegree P) = 0) (huc : u c = 0) (hgrad : coordinateGradient u c ≠ 0) (r : ℝ) (hr : 0 < r) (hcontact : ∀ x ∈ Metric.closedBall c r, eval x (homogeneousComponent P.totalDegree P) = 0 → x ≠ c → u x < 0) (hcurv : 0 < trace (coordinateHessian u c) - quad (coordinateHessian u c) (coordinateGradient u c) / sqNorm (coordinateGradient u c)) : False := by obtain ⟨L, ε, hL, hε, hnear⟩ := test_local_normal_penalty hu c hgrad hcurv obtain ⟨t, ht, htb⟩ := Metric.mem_nhds_iff.mp hnear let R := min r (t / 2) have hR : 0 < R := lt_min hr (by positivity) have hRr : Metric.closedBall c R ⊆ Metric.closedBall c r := Metric.closedBall_subset_closedBall (min_le_left _ _) have hRt : Metric.closedBall c R ⊆ Metric.ball c t := Metric.closedBall_subset_ball (lt_of_le_of_lt (min_le_right _ _) (by linarith)) obtain ⟨X, δ, s, C, hX, hcX, hδ, hs, hC, hnonneg, hpositive⟩ := exists_strict_touching_field (homogeneousComponent P.totalDegree P) hu c huc R hR (fun x hx ↦ hcontact x (hRr hx)) L ε hL hε (fun x hx ↦ htb (hRt hx)) exact top_no_positive_local_field P hmin hdeg c hc X hX hcX δ s C hδ hs hC hnonneg hpositive end end Source29StrictTouchingObstruction /- Component: QuadraticStrictification.inc -/ namespace Source29QuadraticStrictification open Source29QuarticReuse.FluxObstruction Source29NormalBall Source29NormalPenalty open Source29GradientBarrierCalculus open scoped Topology BigOperators noncomputable section variable {n : ℕ} def distanceSq (c x : Fin n → ℝ) : ℝ := ∑ i, (x i - c i) ^ 2 theorem distanceSq_contDiff (c : Fin n → ℝ) : ContDiff ℝ 2 (distanceSq c) := by unfold distanceSq fun_prop theorem distanceSq_self (c : Fin n → ℝ) : distanceSq c c = 0 := by simp only [distanceSq, sub_self, zero_pow (by norm_num : 2 ≠ 0), Finset.sum_const_zero] theorem distanceSq_pos (c x : Fin n → ℝ) (hx : x ≠ c) : 0 < distanceSq c x := by apply sqNorm_pos (v := x - c) exact sub_ne_zero.mpr hx theorem distanceSq_hasFDerivAt (c x : Fin n → ℝ) : HasFDerivAt (distanceSq c) (∑ i, (2 * (x i - c i)) • (ContinuousLinearMap.proj i : (Fin n → ℝ) →L[ℝ] ℝ)) x := by unfold distanceSq apply HasFDerivAt.fun_sum intro i _ convert ((hasFDerivAt_apply (𝕜 := ℝ) (F' := fun _ : Fin n ↦ ℝ) i x).sub_const (c i)).pow 2 using 1 <;> simp theorem gradient_distanceSq (c x : Fin n → ℝ) (i : Fin n) : coordinateGradient (distanceSq c) x i = 2 * (x i - c i) := by unfold coordinateGradient rw [(distanceSq_hasFDerivAt c x).fderiv] simp [Pi.single_apply] def strictify (u : (Fin n → ℝ) → ℝ) (c : Fin n → ℝ) (γ : ℝ) (x : Fin n → ℝ) : ℝ := u x - γ * distanceSq c x theorem strictify_contDiff {u : (Fin n → ℝ) → ℝ} (hu : ContDiff ℝ 2 u) (c : Fin n → ℝ) (γ : ℝ) : ContDiff ℝ 2 (strictify u c γ) := hu.sub (contDiff_const.mul (distanceSq_contDiff c)) theorem strictify_self (u : (Fin n → ℝ) → ℝ) (c : Fin n → ℝ) (γ : ℝ) : strictify u c γ c = u c := by simp only [strictify, distanceSq_self, mul_zero, sub_zero] theorem gradient_strictify {u : (Fin n → ℝ) → ℝ} (hu : ContDiff ℝ 2 u) (c x : Fin n → ℝ) (γ : ℝ) (i : Fin n) : coordinateGradient (strictify u c γ) x i = coordinateGradient u x i - (2 * γ) * (x i - c i) := by have hu1 : ContDiff ℝ 1 u := hu.of_le (by norm_num) have hd := ((hu1.differentiable (by norm_num) x).hasFDerivAt).sub ((distanceSq_hasFDerivAt c x).const_mul γ) have he := congrArg (fun D : (Fin n → ℝ) →L[ℝ] ℝ ↦ D (Pi.single i 1)) hd.fderiv change fderiv ℝ (strictify u c γ) x (Pi.single i 1) = _ at he unfold coordinateGradient simp [Pi.single_apply] at he rw [he] ring theorem gradient_strictify_self {u : (Fin n → ℝ) → ℝ} (hu : ContDiff ℝ 2 u) (c : Fin n → ℝ) (γ : ℝ) : coordinateGradient (strictify u c γ) c = coordinateGradient u c := by ext i simp only [gradient_strictify hu, sub_self, mul_zero, sub_zero] theorem hessian_strictify {u : (Fin n → ℝ) → ℝ} (hu : ContDiff ℝ 2 u) (c x : Fin n → ℝ) (γ : ℝ) (i j : Fin n) : coordinateHessian (strictify u c γ) x i j = coordinateHessian u x i j - (if i = j then 2 * γ else 0) := by change fderiv ℝ (fun y ↦ coordinateGradient (strictify u c γ) y j) x (Pi.single i 1) = _ simp_rw [gradient_strictify hu] have hd := (((gradient_contDiff hu j).differentiable (by norm_num) x).hasFDerivAt).sub (((hasFDerivAt_apply (𝕜 := ℝ) (F' := fun _ : Fin n ↦ ℝ) j x).sub_const (c j)).const_mul (2 * γ)) change HasFDerivAt (fun y ↦ coordinateGradient u y j - (2 * γ) * (y j - c j)) _ x at hd rw [hd.fderiv] simp [coordinateHessian, coordinateJacobian, Pi.single_apply, eq_comm] /-- The tangential Hessian trace loses exactly twice the perturbation size for each tangent dimension. -/ theorem curvature_strictify {u : (Fin n → ℝ) → ℝ} (hu : ContDiff ℝ 2 u) (c : Fin n → ℝ) (γ : ℝ) (hv : coordinateGradient u c ≠ 0) : trace (coordinateHessian (strictify u c γ) c) - quad (coordinateHessian (strictify u c γ) c) (coordinateGradient (strictify u c γ) c) / sqNorm (coordinateGradient (strictify u c γ) c) = trace (coordinateHessian u c) - quad (coordinateHessian u c) (coordinateGradient u c) / sqNorm (coordinateGradient u c) - 2 * γ * ((n : ℝ) - 1) := by have htr : trace (coordinateHessian (strictify u c γ) c) = trace (coordinateHessian u c) - (n : ℝ) * (2 * γ) := by unfold trace simp only [hessian_strictify hu, ite_true, Finset.sum_sub_distrib, Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul] have hq (v : Fin n → ℝ) : quad (coordinateHessian (strictify u c γ) c) v = quad (coordinateHessian u c) v - (2 * γ) * sqNorm v := by unfold quad sqNorm simp_rw [hessian_strictify hu, sub_mul, Finset.sum_sub_distrib] congr 1 simp [Finset.mul_sum, Pi.single_apply, pow_two, mul_assoc] rw [gradient_strictify_self hu, htr, hq] have hs := ne_of_gt (sqNorm_pos hv) field_simp <;> ring end end Source29QuadraticStrictification /- Component: TouchingMaximumPrinciple.inc -/ namespace Source29TouchingMaximumPrinciple open MvPolynomial open Source29NormalBall Source29NormalPenalty Source29GradientBarrierCalculus open Source29StrictTouchingObstruction Source29QuadraticStrictification open scoped Topology BigOperators noncomputable section /-- A smooth test attaining a local maximum on the leading zero set has nonpositive tangential Hessian trace whenever its gradient is nonzero. No regularity of the polynomial zero set at the contact point is assumed. -/ theorem top_touching_trace_nonpos (P : MvPolynomial (Fin 8) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) {u : (Fin 8 → ℝ) → ℝ} (hu : ContDiff ℝ 2 u) (c : Fin 8 → ℝ) (hc : eval c (homogeneousComponent P.totalDegree P) = 0) (huc : u c = 0) (hgrad : coordinateGradient u c ≠ 0) (r : ℝ) (hr : 0 < r) (hcontact : ∀ x ∈ Metric.closedBall c r, eval x (homogeneousComponent P.totalDegree P) = 0 → u x ≤ 0) : trace (coordinateHessian u c) - quad (coordinateHessian u c) (coordinateGradient u c) / sqNorm (coordinateGradient u c) ≤ 0 := by by_contra hn have hk : 0 < trace (coordinateHessian u c) - quad (coordinateHessian u c) (coordinateGradient u c) / sqNorm (coordinateGradient u c) := lt_of_not_ge hn let κ := trace (coordinateHessian u c) - quad (coordinateHessian u c) (coordinateGradient u c) / sqNorm (coordinateGradient u c) let γ := κ / 28 have hγ : 0 < γ := div_pos hk (by norm_num) have hcurv : 0 < trace (coordinateHessian (strictify u c γ) c) - quad (coordinateHessian (strictify u c γ) c) (coordinateGradient (strictify u c γ) c) / sqNorm (coordinateGradient (strictify u c γ) c) := by rw [curvature_strictify hu c γ hgrad] change 0 < κ - 2 * (κ / 28) * ((8 : ℝ) - 1) change 0 < κ at hk linarith apply top_no_strict_touching P hmin hdeg (strictify_contDiff hu c γ) c hc (by rw [strictify_self, huc]) (by rwa [gradient_strictify_self hu]) r hr _ hcurv intro x hx hz hxc have hux := hcontact x hx hz have hq := mul_pos hγ (distanceSq_pos c x hxc) change u x - γ * distanceSq c x < 0 linarith end end Source29TouchingMaximumPrinciple /- Component: TouchingExtrema.inc -/ namespace Source29TouchingExtrema open MvPolynomial open Source29NormalBall Source29NormalPenalty Source29GradientBarrierCalculus open Source29TouchingMaximumPrinciple open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem gradient_sub_const (u : (Fin n → ℝ) → ℝ) (a : ℝ) (x : Fin n → ℝ) : coordinateGradient (fun y ↦ u y - a) x = coordinateGradient u x := by ext i simp only [coordinateGradient, fderiv_sub_const] theorem hessian_sub_const (u : (Fin n → ℝ) → ℝ) (a : ℝ) (x : Fin n → ℝ) : coordinateHessian (fun y ↦ u y - a) x = coordinateHessian u x := by unfold coordinateHessian coordinateJacobian simp only [gradient_sub_const] theorem gradient_neg (u : (Fin n → ℝ) → ℝ) (x : Fin n → ℝ) (i : Fin n) : coordinateGradient (fun y ↦ -u y) x i = -coordinateGradient u x i := by simp only [coordinateGradient, fderiv_fun_neg, ContinuousLinearMap.neg_apply] theorem hessian_neg (u : (Fin n → ℝ) → ℝ) (x : Fin n → ℝ) (i j : Fin n) : coordinateHessian (fun y ↦ -u y) x i j = -coordinateHessian u x i j := by unfold coordinateHessian coordinateJacobian simp only [gradient_neg, fderiv_fun_neg, ContinuousLinearMap.neg_apply] theorem curvature_neg (u : (Fin n → ℝ) → ℝ) (x : Fin n → ℝ) : trace (coordinateHessian (fun y ↦ -u y) x) - quad (coordinateHessian (fun y ↦ -u y) x) (coordinateGradient (fun y ↦ -u y) x) / sqNorm (coordinateGradient (fun y ↦ -u y) x) = -(trace (coordinateHessian u x) - quad (coordinateHessian u x) (coordinateGradient u x) / sqNorm (coordinateGradient u x)) := by simp only [trace, quad, sqNorm, hessian_neg, gradient_neg, neg_sq, neg_mul, mul_neg, neg_neg, Finset.sum_neg_distrib, neg_div] ring /-- The local maximum principle without a normalization on the test value. -/ theorem top_local_maximum_trace_nonpos (P : MvPolynomial (Fin 8) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) {u : (Fin 8 → ℝ) → ℝ} (hu : ContDiff ℝ 2 u) (c : Fin 8 → ℝ) (hc : eval c (homogeneousComponent P.totalDegree P) = 0) (hgrad : coordinateGradient u c ≠ 0) (r : ℝ) (hr : 0 < r) (hcontact : ∀ x ∈ Metric.closedBall c r, eval x (homogeneousComponent P.totalDegree P) = 0 → u x ≤ u c) : trace (coordinateHessian u c) - quad (coordinateHessian u c) (coordinateGradient u c) / sqNorm (coordinateGradient u c) ≤ 0 := by have h := top_touching_trace_nonpos P hmin hdeg (hu.sub contDiff_const) c hc (sub_self (u c)) (by rwa [gradient_sub_const]) r hr (fun x hx hz ↦ sub_nonpos.mpr (hcontact x hx hz)) simpa only [gradient_sub_const, hessian_sub_const] using h /-- The dual local minimum principle on the same, possibly singular, zero set. -/ theorem top_local_minimum_trace_nonneg (P : MvPolynomial (Fin 8) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) {u : (Fin 8 → ℝ) → ℝ} (hu : ContDiff ℝ 2 u) (c : Fin 8 → ℝ) (hc : eval c (homogeneousComponent P.totalDegree P) = 0) (hgrad : coordinateGradient u c ≠ 0) (r : ℝ) (hr : 0 < r) (hcontact : ∀ x ∈ Metric.closedBall c r, eval x (homogeneousComponent P.totalDegree P) = 0 → u c ≤ u x) : 0 ≤ trace (coordinateHessian u c) - quad (coordinateHessian u c) (coordinateGradient u c) / sqNorm (coordinateGradient u c) := by have hneg : coordinateGradient (fun y ↦ -u y) c ≠ 0 := by intro hz apply hgrad ext i have hi := congrFun hz i simpa only [gradient_neg, Pi.zero_apply, neg_eq_zero] using hi have h := top_local_maximum_trace_nonpos P hmin hdeg hu.neg c hc hneg r hr (fun x hx hz ↦ neg_le_neg (hcontact x hx hz)) rw [curvature_neg] at h linarith end end Source29TouchingExtrema /- Component: SquarePerturbation.inc -/ namespace Source29SquarePerturbation open Source29NormalBall Source29NormalPenalty Source29GradientBarrierCalculus open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem gradient_square {g : (Fin n → ℝ) → ℝ} (hg : ContDiff ℝ 2 g) (x : Fin n → ℝ) (i : Fin n) : coordinateGradient (fun y ↦ (g y) ^ 2) x i = 2 * g x * coordinateGradient g x i := by have hg1 : ContDiff ℝ 1 g := hg.of_le (by norm_num) have hd := ((hg1.differentiable (by norm_num) x).hasFDerivAt).pow 2 have he := congrArg (fun D : (Fin n → ℝ) →L[ℝ] ℝ ↦ D (Pi.single i 1)) hd.fderiv simpa [coordinateGradient] using he theorem hessian_square {g : (Fin n → ℝ) → ℝ} (hg : ContDiff ℝ 2 g) (x : Fin n → ℝ) (i j : Fin n) : coordinateHessian (fun y ↦ (g y) ^ 2) x i j = 2 * coordinateGradient g x i * coordinateGradient g x j + 2 * g x * coordinateHessian g x i j := by change fderiv ℝ (fun y ↦ coordinateGradient (fun z ↦ (g z) ^ 2) y j) x (Pi.single i 1) = _ simp_rw [gradient_square hg] have hg1 : ContDiff ℝ 1 g := hg.of_le (by norm_num) have hd := (((hg1.differentiable (by norm_num) x).hasFDerivAt).const_mul 2).fun_mul (((gradient_contDiff hg j).differentiable (by norm_num) x).hasFDerivAt) rw [hd.fderiv] simp only [ContinuousLinearMap.add_apply, _root_.smul_apply, smul_eq_mul] change (2 * g x) * coordinateHessian g x i j + coordinateGradient g x j * (2 * coordinateGradient g x i) = _ ring theorem gradient_add {f g : (Fin n → ℝ) → ℝ} (hf : ContDiff ℝ 2 f) (hg : ContDiff ℝ 2 g) (x : Fin n → ℝ) (i : Fin n) : coordinateGradient (fun y ↦ f y + g y) x i = coordinateGradient f x i + coordinateGradient g x i := by have hf1 : ContDiff ℝ 1 f := hf.of_le (by norm_num) have hg1 : ContDiff ℝ 1 g := hg.of_le (by norm_num) unfold coordinateGradient rw [fderiv_fun_add (hf1.differentiable (by norm_num) x) (hg1.differentiable (by norm_num) x)] rfl theorem hessian_add {f g : (Fin n → ℝ) → ℝ} (hf : ContDiff ℝ 2 f) (hg : ContDiff ℝ 2 g) (x : Fin n → ℝ) (i j : Fin n) : coordinateHessian (fun y ↦ f y + g y) x i j = coordinateHessian f x i j + coordinateHessian g x i j := by change fderiv ℝ (fun y ↦ coordinateGradient (fun z ↦ f z + g z) y j) x (Pi.single i 1) = _ simp_rw [gradient_add hf hg] rw [fderiv_fun_add ((gradient_contDiff hf j).differentiable (by norm_num) x) ((gradient_contDiff hg j).differentiable (by norm_num) x)] rfl theorem gradient_add_square_at_zero {f g : (Fin n → ℝ) → ℝ} (hf : ContDiff ℝ 2 f) (hg : ContDiff ℝ 2 g) (c : Fin n → ℝ) (hgc : g c = 0) : coordinateGradient (fun x ↦ f x + (g x) ^ 2) c = coordinateGradient f c := by ext i simp only [gradient_add hf (hg.pow 2), gradient_square hg, hgc, mul_zero, zero_mul, add_zero] theorem curvature_add_square_at_zero {f g : (Fin n → ℝ) → ℝ} (hf : ContDiff ℝ 2 f) (hg : ContDiff ℝ 2 g) (c : Fin n → ℝ) (hgc : g c = 0) : trace (coordinateHessian (fun x ↦ f x + (g x) ^ 2) c) - quad (coordinateHessian (fun x ↦ f x + (g x) ^ 2) c) (coordinateGradient (fun x ↦ f x + (g x) ^ 2) c) / sqNorm (coordinateGradient (fun x ↦ f x + (g x) ^ 2) c) = (trace (coordinateHessian f c) - quad (coordinateHessian f c) (coordinateGradient f c) / sqNorm (coordinateGradient f c)) + 2 * (sqNorm (coordinateGradient g c) - (dot (coordinateGradient f c) (coordinateGradient g c)) ^ 2 / sqNorm (coordinateGradient f c)) := by let v := coordinateGradient f c let w := coordinateGradient g c have hj (i j : Fin n) : coordinateHessian (fun x ↦ f x + (g x) ^ 2) c i j = coordinateHessian f c i j + 2 * w i * w j := by simp only [hessian_add hf (hg.pow 2), hessian_square hg, hgc, mul_zero, zero_mul, add_zero] rfl have htr : trace (coordinateHessian (fun x ↦ f x + (g x) ^ 2) c) = trace (coordinateHessian f c) + 2 * sqNorm w := by unfold trace simp_rw [hj] simp only [Finset.sum_add_distrib, sqNorm, pow_two, Finset.mul_sum, mul_assoc] have hq : quad (coordinateHessian (fun x ↦ f x + (g x) ^ 2) c) v = quad (coordinateHessian f c) v + 2 * (dot v w) ^ 2 := by have hr : (∑ i, ∑ j, (2 * w i * w j) * v i * v j) = 2 * (dot v w) ^ 2 := by calc _ = ∑ i, (2 * (v i * w i)) * (∑ j, v j * w j) := by apply Finset.sum_congr rfl intro i _ rw [Finset.mul_sum] apply Finset.sum_congr rfl intro j _ ring _ = _ := by rw [← Finset.sum_mul, ← Finset.mul_sum]; unfold dot; ring simpa only [quad, hj, add_mul, Finset.sum_add_distrib, hr] rw [gradient_add_square_at_zero hf hg c hgc, htr] change trace (coordinateHessian f c) + 2 * sqNorm w - quad (coordinateHessian (fun x ↦ f x + (g x) ^ 2) c) v / sqNorm v = _ rw [hq] dsimp only [v, w] ring end end Source29SquarePerturbation /- Component: VanishingGradientRigidity.inc -/ namespace Source29VanishingGradientRigidity open MvPolynomial open Source29NormalBall Source29NormalPenalty Source29GradientBarrierCalculus open Source29TouchingExtrema Source29SquarePerturbation open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- The transverse squared norm is positive unless the second vector is a scalar multiple of the first. This is the strict Cauchy equality case. -/ theorem transverse_part_pos (v w : Fin n → ℝ) (hv : v ≠ 0) (hn : ¬∃ a : ℝ, w = fun i ↦ a * v i) : 0 < sqNorm w - (dot v w) ^ 2 / sqNorm v := by let a := dot v w / sqNorm v have hr : (fun i ↦ w i - a * v i) ≠ 0 := by intro he apply hn refine ⟨a, funext fun i ↦ ?_⟩ have hi := congrFun he i exact sub_eq_zero.mp hi have hs := ne_of_gt (sqNorm_pos hv) have he : sqNorm (fun i ↦ w i - a * v i) = sqNorm w - (dot v w) ^ 2 / sqNorm v := by change (∑ i, (w i - a * v i) ^ 2) = _ rw [residual_sq] dsimp only [a] field_simp <;> ring rw [← he] exact sqNorm_pos hr /-- Two C2 functions vanishing on the leading zero set near a point cannot have independent gradients there. In particular, that zero set cannot lie locally in a regular codimension-two intersection. -/ theorem vanishing_gradients_parallel (P : MvPolynomial (Fin 8) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) {f g : (Fin 8 → ℝ) → ℝ} (hf : ContDiff ℝ 2 f) (hg : ContDiff ℝ 2 g) (c : Fin 8 → ℝ) (hc : eval c (homogeneousComponent P.totalDegree P) = 0) (hv : coordinateGradient f c ≠ 0) (r : ℝ) (hr : 0 < r) (hfzero : ∀ x ∈ Metric.closedBall c r, eval x (homogeneousComponent P.totalDegree P) = 0 → f x = 0) (hgzero : ∀ x ∈ Metric.closedBall c r, eval x (homogeneousComponent P.totalDegree P) = 0 → g x = 0) : ∃ a : ℝ, coordinateGradient g c = fun i ↦ a * coordinateGradient f c i := by by_contra hn have hp := transverse_part_pos (coordinateGradient f c) (coordinateGradient g c) hv hn have hfc := hfzero c (Metric.mem_closedBall_self hr.le) hc have hgc := hgzero c (Metric.mem_closedBall_self hr.le) hc have hupper := top_local_maximum_trace_nonpos P hmin hdeg hf c hc hv r hr (by intro x hx hz rw [hfzero x hx hz, hfc]) have hlower := top_local_minimum_trace_nonneg P hmin hdeg hf c hc hv r hr (by intro x hx hz rw [hfzero x hx hz, hfc]) have hgrad : coordinateGradient (fun x ↦ f x + (g x) ^ 2) c ≠ 0 := by rwa [gradient_add_square_at_zero hf hg c hgc] have hpert := top_local_maximum_trace_nonpos P hmin hdeg (hf.add (hg.pow 2)) c hc hgrad r hr (by intro x hx hz simp only [hfzero x hx hz, hgzero x hx hz, hfc, hgc, zero_pow (by norm_num : 2 ≠ 0), add_zero] exact le_rfl) rw [curvature_add_square_at_zero hf hg c hgc] at hpert linarith end end Source29VanishingGradientRigidity /- Component: CriticalHessian.inc -/ namespace Source29CriticalHessian open MvPolynomial Source29FactorInheritance Source29PolynomialCurvaturePotential open Source29QuarticReuse.QuarticMinimal.AmbientQuartic open Source29QuarticReuse.QuarticPolynomialBasics (second_partial_comm) open scoped BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- At a critical point of a polynomial solving the homogeneous minimal operator, the quadratic Hessian terms satisfy the polarized cubic relation. -/ theorem critical_second_trace (P : MvPolynomial ι ℝ) (x : ι → ℝ) (hL : cubicOperator P = 0) (hg : gradientAt P x = 0) (a b : ι) : (∑ i, realHessian P x a i * realHessian P x b i) * (∑ j, realHessian P x j j) = ∑ i, ∑ j, realHessian P x a i * realHessian P x b j * realHessian P x i j := by have hz (i : ι) : eval x (pderiv i P) = 0 := congrFun hg i have htwo : pderiv a (2 : MvPolynomial ι ℝ) = 0 := by simpa only [map_ofNat] using (pderiv_C (i := a) (a := (2 : ℝ))) have he := congrArg (eval x) (congrArg (pderiv a) (congrArg (pderiv b) hL)) simp [cubicOperator, pderiv_mul, pderiv_pow, hz, htwo] at he have hswap : (∑ i, ∑ j, realHessian P x b i * realHessian P x a j * realHessian P x i j) = ∑ i, ∑ j, realHessian P x a i * realHessian P x b j * realHessian P x i j := by rw [Finset.sum_comm] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ have hs := realHessian_symmetric P x have hij : realHessian P x j i = realHessian P x i j := congrFun (congrFun hs i) j rw [hij] ring simp only [← realHessian_apply, mul_add, add_mul, Finset.sum_add_distrib, ← Finset.mul_sum, ← Finset.sum_mul] at he simp only [mul_comm, mul_left_comm, mul_assoc] at he hswap ⊢ rw [hswap] at he linarith /-- The critical Hessian satisfies H cubed = trace(H) times H squared. -/ theorem critical_hessian_cubic (P : MvPolynomial ι ℝ) (x : ι → ℝ) (hL : cubicOperator P = 0) (hg : gradientAt P x = 0) : let H := realHessian P x H * (H * H) = Matrix.trace H • (H * H) := by let H := realHessian P x change H * (H * H) = Matrix.trace H • (H * H) have hs (i j : ι) : H i j = H j i := ((realHessian_symmetric P x).apply i j).symm ext a b calc (H * (H * H)) a b = ∑ i, ∑ j, H a i * H b j * H i j := by simp only [Matrix.mul_apply, Finset.mul_sum] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ rw [hs j b] ring _ = (∑ i, H a i * H b i) * Matrix.trace H := (critical_second_trace P x hL hg a b).symm _ = (Matrix.trace H • (H * H)) a b := by change _ = Matrix.trace H * ∑ i, H a i * H i b rw [mul_comm] congr 1 apply Finset.sum_congr rfl intro i _ rw [hs b i] /-- Symmetry removes a factor from the critical cubic matrix identity. -/ theorem symmetric_square_of_cubic (H : Matrix ι ι ℝ) (hH : H.IsSymm) (hc : H * (H * H) = Matrix.trace H • (H * H)) : H * H = Matrix.trace H • H := by have hh : H.conjTranspose = H := by rw [Matrix.conjTranspose_eq_transpose_of_trivial] exact hH have hz : (H.conjTranspose * H) * (H - Matrix.trace H • 1) = 0 := by rw [hh, Matrix.mul_sub, Matrix.mul_smul, Matrix.mul_one, Matrix.mul_assoc, hc, sub_self] have hn := (Matrix.conjTranspose_mul_self_mul_eq_zero H (H - Matrix.trace H • 1)).mp hz simpa only [Matrix.mul_sub, Matrix.mul_smul, Matrix.mul_one, sub_eq_zero] using hn theorem critical_hessian_square (P : MvPolynomial ι ℝ) (x : ι → ℝ) (hL : cubicOperator P = 0) (hg : gradientAt P x = 0) : let H := realHessian P x H * H = Matrix.trace H • H := symmetric_square_of_cubic _ (realHessian_symmetric P x) (critical_hessian_cubic P x hL hg) end end Source29CriticalHessian /- Component: CriticalCurvatureAlgebra.inc -/ namespace Source29CriticalCurvatureAlgebra open Source29CurvaturePotentialAlgebra Source29CurvatureScaling open Source29QuarticReuse.CubicMatrix open scoped BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def normalCurvatureSq (H : Matrix ι ι ℝ) (N : ι → ℝ) : ℝ := matrixSq H - 2 * vectorSq (H *ᵥ N) + (N ⬝ᵥ (H *ᵥ N)) ^ 2 def normalTrace (H : Matrix ι ι ℝ) (N : ι → ℝ) : ℝ := Matrix.trace H - N ⬝ᵥ (H *ᵥ N) theorem matrixSq_eq_trace_square (H : Matrix ι ι ℝ) (hH : H.IsSymm) : matrixSq H = Matrix.trace (H * H) := by simp only [matrixSq, Matrix.trace, Matrix.diag, Matrix.mul_apply] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ rw [hH.apply i j] ring /-- A critical Hessian's normal curvature expression is exactly the square of its normal trace, uniformly over all normal vectors. -/ theorem normalCurvatureSq_eq_trace_sq (H : Matrix ι ι ℝ) (hH : H.IsSymm) (hs : H * H = Matrix.trace H • H) (N : ι → ℝ) : normalCurvatureSq H N = (normalTrace H N) ^ 2 := by have hm : matrixSq H = (Matrix.trace H) ^ 2 := by rw [matrixSq_eq_trace_square H hH, hs, Matrix.trace_smul] simp only [smul_eq_mul, pow_two] have hv : vectorSq (H *ᵥ N) = Matrix.trace H * (N ⬝ᵥ (H *ᵥ N)) := by unfold vectorSq rw [dot_move H hH, Matrix.mulVec_mulVec, hs, Matrix.smul_mulVec, dotProduct_smul] rfl unfold normalCurvatureSq normalTrace rw [hm, hv] ring theorem normalCurvatureSq_normalize (H : Matrix ι ι ℝ) (v : ι → ℝ) (t : ℝ) (ht : t ≠ 0) (hs : t ^ 2 = vectorSq v) : normalCurvatureSq H (t⁻¹ • v) = vectorSq v * potential v H := by have hv : vectorSq v ≠ 0 := by rw [← hs]; exact pow_ne_zero _ ht unfold normalCurvatureSq potential rw [Matrix.mulVec_smul, vectorSq_smul, smul_dotProduct, dotProduct_smul] simp only [smul_eq_mul] rw [← hs] field_simp <;> ring theorem normalTrace_normalize (H : Matrix ι ι ℝ) (v : ι → ℝ) (t : ℝ) (ht : t ≠ 0) (hs : t ^ 2 = vectorSq v) : normalTrace H (t⁻¹ • v) = Matrix.trace H - (v ⬝ᵥ (H *ᵥ v)) / vectorSq v := by unfold normalTrace rw [Matrix.mulVec_smul, smul_dotProduct, dotProduct_smul] simp only [smul_eq_mul] rw [← hs] field_simp <;> ring end end Source29CriticalCurvatureAlgebra /- Component: WeightedCurvatureContinuity.inc -/ namespace Source29WeightedCurvatureContinuity open MvPolynomial Filter open Source29PolynomialCurvaturePotential Source29CurvaturePotentialAlgebra open Source29CriticalHessian Source29CriticalCurvatureAlgebra Source29AnalyticTensorNorm open Source29QuarticReuse.QuarticMinimal.AmbientQuartic Source29QuarticReuse.FluxPolynomial open scoped BigOperators Matrix Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def normalized (v : ι → ℝ) : ι → ℝ := (tensorNorm v)⁻¹ • v theorem tensorNorm_sq_eq (v : ι → ℝ) : (tensorNorm v) ^ 2 = vectorSq v := by simpa only [vectorSq, dotProduct, pow_two] using tensorNorm_sq v theorem normalized_mem_cube (v : ι → ℝ) : normalized v ∈ Set.Icc (fun _ ↦ (-1 : ℝ)) (fun _ ↦ (1 : ℝ)) := by by_cases hv : v = 0 · subst v simp only [normalized, smul_zero, Set.mem_Icc] exact ⟨fun _ ↦ by norm_num, fun _ ↦ by norm_num⟩ have ht := tensorNorm_pos hv have hb (i : ι) : |normalized v i| ≤ 1 := by have hi : |v i| ≤ tensorNorm v := Real.abs_le_sqrt (Finset.single_le_sum (fun j _ ↦ sq_nonneg (v j)) (Finset.mem_univ i)) change |(tensorNorm v)⁻¹ * v i| ≤ 1 rw [abs_mul, abs_inv, abs_of_pos ht, ← div_eq_inv_mul] exact (div_le_one ht).mpr hi exact ⟨fun i ↦ (abs_le.mp (hb i)).1, fun i ↦ (abs_le.mp (hb i)).2⟩ def weightedCurvatureSq (P : MvPolynomial ι ℝ) (x : ι → ℝ) : ℝ := vectorSq (gradientAt P x) * curvaturePotential P x theorem weightedCurvatureSq_zero (P : MvPolynomial ι ℝ) (x : ι → ℝ) (hg : gradientAt P x = 0) : weightedCurvatureSq P x = 0 := by simp only [weightedCurvatureSq, hg, vectorSq, dotProduct_zero, zero_mul] theorem weightedCurvatureSq_normal (P : MvPolynomial ι ℝ) (x : ι → ℝ) (hg : gradientAt P x ≠ 0) : weightedCurvatureSq P x = normalCurvatureSq (realHessian P x) (normalized (gradientAt P x)) := (normalCurvatureSq_normalize _ _ _ (tensorNorm_pos hg).ne' (tensorNorm_sq_eq _)).symm theorem normalTrace_zero (P : MvPolynomial ι ℝ) (x : ι → ℝ) (hL : Source29FactorInheritance.cubicOperator P = 0) (hg : gradientAt P x ≠ 0) : normalTrace (realHessian P x) (normalized (gradientAt P x)) = 0 := by rw [normalized, normalTrace_normalize _ _ _ (tensorNorm_pos hg).ne' (tensorNorm_sq_eq _)] have hv : vectorSq (gradientAt P x) ≠ 0 := by rw [← tensorNorm_sq_eq] exact pow_ne_zero _ (tensorNorm_pos hg).ne' have he := congrArg (eval x) hL simp only [Source29FactorInheritance.cubicOperator, map_sub, map_mul, map_sum, map_pow, map_zero] at he have hq : (gradientAt P x) ⬝ᵥ (realHessian P x *ᵥ gradientAt P x) = ∑ i, ∑ j, eval x (pderiv i P) * eval x (pderiv j P) * eval x (pderiv i (pderiv j P)) := by simp only [dotProduct, Matrix.mulVec, Finset.mul_sum, gradientAt, realHessian_apply] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ ring rw [hq] unfold vectorSq gradientAt Matrix.trace Matrix.diag simp only [dotProduct, ← pow_two, realHessian_apply] apply sub_eq_zero.mpr have hv' : (∑ i, (eval x (pderiv i P)) ^ 2) ≠ 0 := by simpa only [vectorSq, gradientAt, dotProduct, pow_two] using hv apply (eq_div_iff hv').mpr nlinarith [he] /-- Compactness of the normal cube makes the critical Hessian identity uniform in the possibly discontinuous choice of normalized gradient. -/ theorem residual_eventually_small {E : Type*} [TopologicalSpace E] (H : E → Matrix ι ι ℝ) (hH : ∀ i j, Continuous (fun x ↦ H x i j)) (c : E) (hsym : (H c).IsSymm) (hs : H c * H c = Matrix.trace (H c) • H c) (ε : ℝ) (hε : 0 < ε) : ∀ᶠ x in 𝓝 c, ∀ N ∈ Set.Icc (fun _ : ι ↦ (-1 : ℝ)) (fun _ ↦ (1 : ℝ)), |normalCurvatureSq (H x) N - (normalTrace (H x) N) ^ 2| < ε := by have hf : Continuous (fun z : E × (ι → ℝ) ↦ |normalCurvatureSq (H z.1) z.2 - (normalTrace (H z.1) z.2) ^ 2|) := by unfold normalCurvatureSq normalTrace matrixSq vectorSq Matrix.trace Matrix.diag dotProduct Matrix.mulVec fun_prop apply (isCompact_Icc : IsCompact (Set.Icc (fun _ : ι ↦ (-1 : ℝ)) (fun _ ↦ (1 : ℝ)))).eventually_forall_of_forall_eventually intro N hN apply (isOpen_lt hf continuous_const).mem_nhds change |normalCurvatureSq (H c) N - (normalTrace (H c) N) ^ 2| < ε rw [normalCurvatureSq_eq_trace_sq _ hsym hs, sub_self, abs_zero] exact hε /-- Multiplying curvature squared by gradient squared removes its apparent singularity at every critical point of a polynomial satisfying L(P)=0. -/ theorem weightedCurvatureSq_continuousAt_critical (P : MvPolynomial ι ℝ) (hL : Source29FactorInheritance.cubicOperator P = 0) (c : ι → ℝ) (hc : gradientAt P c = 0) : ContinuousAt (weightedCurvatureSq P) c := by rw [ContinuousAt, weightedCurvatureSq_zero P c hc] apply Metric.tendsto_nhds.mpr intro ε hε have hh (i j : ι) : Continuous (fun x ↦ realHessian P x i j) := (contDiff_eval (pderiv i (pderiv j P))).continuous filter_upwards [residual_eventually_small (realHessian P) hh c (realHessian_symmetric P c) (critical_hessian_square P c hL hc) ε hε] with x hx rw [Real.dist_eq, sub_zero] by_cases hg : gradientAt P x = 0 · simpa only [weightedCurvatureSq_zero P x hg, abs_zero] using hε · have hn := hx (normalized (gradientAt P x)) (normalized_mem_cube _) rwa [normalTrace_zero P x hL hg, zero_pow (by norm_num : 2 ≠ 0), sub_zero, ← weightedCurvatureSq_normal P x hg] at hn theorem weightedCurvatureSq_continuous (P : MvPolynomial ι ℝ) (hL : Source29FactorInheritance.cubicOperator P = 0) : Continuous (weightedCurvatureSq P) := by apply continuous_iff_continuousAt.mpr intro c by_cases hc : gradientAt P c = 0 · exact weightedCurvatureSq_continuousAt_critical P hL c hc · apply ContinuousAt.mul · exact (continuous_finsetSum _ (fun i _ ↦ (contDiff_eval (pderiv i P)).continuous.mul (contDiff_eval (pderiv i P)).continuous)).continuousAt · exact (Source29PolynomialCurvatureRegularity.curvaturePotential_analyticAt P c hc).continuousAt end end Source29WeightedCurvatureContinuity /- Component: SingularLinkDegreeBound.inc -/ namespace Source29SingularLinkDegreeBound open Filter MvPolynomial Source29PolynomialLinkChart Source29PolynomialCurvaturePotential open Source29PolynomialJacobiCurves Source29PolynomialCurvatureRegularity open Source29WeightedCurvatureContinuity Source29CurvaturePotentialAlgebra Source29AnalyticTensorNorm open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem ratio_eq_sqrt_weighted (P : MvPolynomial (Option (Option ι)) ℝ) (x : Ambient ι) : curvatureNorm P x / jacobiProfile P x = Real.sqrt (weightedCurvatureSq P x) := by have hv : 0 ≤ vectorSq (gradientAt P x) := by rw [← tensorNorm_sq_eq] exact sq_nonneg _ rw [weightedCurvatureSq, Real.sqrt_mul hv] unfold curvatureNorm jacobiProfile tensorNorm gradientAt vectorSq simp only [div_inv_eq_mul, dotProduct, ← pow_two] ring theorem ratio_continuous (P : MvPolynomial (Option (Option ι)) ℝ) (hL : Source29FactorInheritance.cubicOperator P = 0) : Continuous (fun x : Ambient ι => curvatureNorm P x / jacobiProfile P x) := by have he : (fun x : Ambient ι => curvatureNorm P x / jacobiProfile P x) = (fun x => Real.sqrt (weightedCurvatureSq P x)) := funext (ratio_eq_sqrt_weighted P) rw [he] exact Real.continuous_sqrt.comp (weightedCurvatureSq_continuous P hL) /-- The weighted curvature is continuous across critical points, so compact comparison needs no global regularity assumption. -/ theorem homogeneous_degree_eigenvalue_bound (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (hL : Source29FactorInheritance.cubicOperator P = 0) (hnonflat : ∃ x : Ambient ι, (eval x P = 0 ∧ (∑ a, (x a)^2) = 1) ∧ 0 < curvaturePotential P x) : ((d : ℝ)-1)*((d : ℝ)-(Fintype.card ι : ℝ)) ≤ -(Fintype.card ι : ℝ) := by let s : Set (Ambient ι) := {x | eval x P = 0 ∧ (∑ a, (x a)^2) = 1} have hs : IsCompact s := Source29CompactPolynomialLink.isCompact_link P obtain ⟨b, hb, hpb⟩ := hnonflat have hbr : gradientAt P b ≠ 0 := by intro hz have hp : curvaturePotential P b = 0 := by simp [curvaturePotential, potential, hz, vectorSq] rw [hp] at hpb exact (lt_irrefl 0) hpb have hhb : 0 < curvatureNorm P b := Real.sqrt_pos.mpr hpb have hφb : 0 < jacobiProfile P b := jacobiProfile_positive P b hbr have hrc : ContinuousOn (fun x => curvatureNorm P x / jacobiProfile P x) s := (ratio_continuous P hL).continuousOn obtain ⟨a, ha, hmax⟩ := hs.exists_isMaxOn ⟨b, hb⟩ hrc have hratio : 0 < curvatureNorm P a / jacobiProfile P a := (div_pos hhb hφb).trans_le (hmax hb) have har : gradientAt P a ≠ 0 := by intro hz have hzφ : jacobiProfile P a = 0 := by change (tensorNorm (gradientAt P a))⁻¹ = 0 simp [hz, tensorNorm] rw [hzφ, div_zero] at hratio exact (lt_irrefl 0) hratio have hφa : 0 < jacobiProfile P a := jacobiProfile_positive P a har have hha : 0 < curvatureNorm P a := by have he := (lt_div_iff₀ hφa).mp hratio simpa only [zero_mul] using he have hpa : 0 < curvaturePotential P a := Real.sqrt_pos.mp hha obtain ⟨C, hC, hC0, hmem, hCφ, hCh, hJac, hSimons⟩ := Source29RegularLinkSimons.exists_regular_link_simons_curves P d hP hd hL a ha.2 ha.1 har hpa apply Source29LocalEigenvalueComparison.eigenvalue_bound_at_ratio_maximum (fun i t => curvatureNorm P (C i t)) (fun i t => jacobiProfile P (C i t)) (curvatureNorm P a) (jacobiProfile P a) (curvaturePotential P a) (Fintype.card ι : ℝ) (((d : ℝ)-1)*((d : ℝ)-(Fintype.card ι : ℝ))) hCh hCφ (fun i => congrArg (curvatureNorm P) (hC0 i)) (fun i => congrArg (jacobiProfile P) (hC0 i)) hha hφa _ hSimons hJac intro i change ∀ᶠ t in 𝓝 (0 : ℝ), curvatureNorm P (C i t) / jacobiProfile P (C i t) ≤ curvatureNorm P (C i 0) / jacobiProfile P (C i 0) filter_upwards [hmem i] with t ht simpa only [hC0, Set.mem_setOf_eq] using hmax ht /-- In ambient dimension eight, a homogeneous solution of Lp=0 with degree at least three and a nonflat unit zero link, allowing singular points, has degree at most four. -/ theorem degree_interval_ambient_eight (P : MvPolynomial (Option (Option (Fin 6))) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (hL : Source29FactorInheritance.cubicOperator P = 0) (hnonflat : ∃ x : Ambient (Fin 6), (eval x P = 0 ∧ (∑ a, (x a)^2) = 1) ∧ 0 < curvaturePotential P x) : 3 ≤ d ∧ d ≤ 4 := by have he := homogeneous_degree_eigenvalue_bound P d hP hd hL hnonflat have hb : ((d : ℝ)-1)*((d : ℝ)-6) ≤ -(6 : ℝ) := by simpa using he have hi := Source29LocalEigenvalueComparison.degree_interval_eight (d : ℝ) (((d : ℝ)-1)*((d : ℝ)-6)) (by ring) hb exact ⟨hd, by exact_mod_cast hi.2⟩ end end Source29SingularLinkDegreeBound /- Component: SingularFinEightDegreeBound.inc -/ namespace Source29SingularFinEightDegreeBound open MvPolynomial Source29PolynomialCurvaturePotential Source29FactorInheritance open scoped BigOperators noncomputable section open Source29FinEightDegreeBound (eightLinkEquiv) /-- The checked compact-link degree bound in the original Fin 8 coordinates. -/ theorem nonflat_degree_le_four (P : MvPolynomial (Fin 8) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 3 ≤ d) (hL : cubicOperator P = 0) (hnonflat : ∃ x, (eval x P = 0 ∧ (∑ a, (x a)^2) = 1) ∧ 0 < curvaturePotential P x) : d ≤ 4 := by let e := eightLinkEquiv let Q := rename e P have hQ : Q.IsHomogeneous d := hP.rename_isHomogeneous have hQL : cubicOperator Q = 0 := by change cubicOperator (rename e P) = 0 rw [Source29PolynomialReindex.cubicOperator_rename, hL, map_zero] obtain ⟨x, hx, hp⟩ := hnonflat have hqn : ∃ y, (eval y Q = 0 ∧ (∑ a, (y a)^2) = 1) ∧ 0 < curvaturePotential Q y := by refine ⟨x ∘ e.symm, ⟨?_, ?_⟩, ?_⟩ · simpa only [Q, eval_rename, Function.comp_assoc, e.symm_comp_self, Function.comp_id] using hx.1 · change (∑ a, (x (e.symm a))^2) = 1 rw [e.symm.sum_comp (fun a => (x a)^2)] exact hx.2 · simpa only [Q, Source29CurvatureReindex.curvaturePotential_rename, Function.comp_assoc, e.symm_comp_self, Function.comp_id] using hp exact (Source29SingularLinkDegreeBound.degree_interval_ambient_eight Q d hQ hd hQL hqn).2 end end Source29SingularFinEightDegreeBound /- Component: IrreducibleHomogeneousRigidity.inc -/ namespace Source29IrreducibleHomogeneousRigidity open MvPolynomial Source29FactorInheritance Source29PolynomialCurvaturePotential open Source29RegularFactorObstruction Source29CurvatureScaling Source29AnalyticTensorNorm open Source29QuarticReuse.QuarticNormalization open Source29QuarticReuse.QuarticMinimal.AmbientQuartic open Source29QuarticReuse.QuarticCompatibility (homogeneous_pderiv) open scoped BigOperators noncomputable section /-- All degrees are excluded for an irreducible sign-changing factor once its link has positive curvature somewhere, allowing singular points. -/ theorem no_nonflat_sign_changing_factor (P : MvPolynomial (Fin 8) ℝ) (hirr : Irreducible P) (hP : P.IsHomogeneous P.totalDegree) (hL : cubicOperator P = 0) (hpos : ∃ x, 0 < eval x P) (hneg : ∃ x, eval x P < 0) (hnonflat : ∃ x, (eval x P = 0 ∧ (∑ a, (x a)^2) = 1) ∧ 0 < curvaturePotential P x) : False := by have hd2 : 2 ≤ P.totalDegree := by by_contra hh have hd : P.totalDegree ≤ 1 := by omega obtain ⟨x, hx, hp⟩ := hnonflat rw [curvaturePotential_zero_of_affine P hd x] at hp exact (lt_irrefl 0) hp have hd3 : 3 ≤ P.totalDegree := by by_contra hh have hd : P.totalDegree = 2 := by omega exact Source29QuadraticSignObstruction.no_sign_changing_quadratic P (hd ▸ hP) hL hpos hneg have hd4 := Source29SingularFinEightDegreeBound.nonflat_degree_le_four P P.totalDegree hP hd3 hL hnonflat exact Source29LowDegreeEndpoints.no_irreducible_sign_changing_degree_three_or_four P hirr hP hL hd3 hd4 hpos hneg /-- An irreducible sign-changing homogeneous solution of L(P)=0 in eight variables is linear; no smoothness hypothesis on its zero set is needed. -/ theorem degree_le_one (P : MvPolynomial (Fin 8) ℝ) (hirr : Irreducible P) (hP : P.IsHomogeneous P.totalDegree) (hL : cubicOperator P = 0) (hpos : ∃ x, 0 < eval x P) (hneg : ∃ x, eval x P < 0) : P.totalDegree ≤ 1 := by by_contra hn have hd : 2 ≤ P.totalDegree := by omega obtain ⟨a, ha⟩ := hneg obtain ⟨b, hb⟩ := hpos have hunit : ¬P ∣ 1 := fun h ↦ hirr.not_isUnit (isUnit_of_dvd_one h) obtain ⟨x, hx, hreg, _⟩ := Source29RealRegularZero.exists_regular_zero_away_cofactor P 1 hirr hunit a b ha hb have hxne : x ≠ 0 := by intro hzero apply hreg ext i change eval x (pderiv i P) = 0 rw [hzero] exact eval_zero_of_homogeneous (pderiv i P) (homogeneous_pderiv hP) (by omega) let r := tensorNorm x have hr : 0 < r := tensorNorm_pos hxne let y := r⁻¹ • x have hyunit : (∑ i, (y i) ^ 2) = 1 := by simp only [y, Pi.smul_apply, smul_eq_mul, mul_pow, ← Finset.mul_sum] rw [← tensorNorm_sq x] change r⁻¹ ^ 2 * r ^ 2 = 1 field_simp have hyzero : eval y P = 0 := by change eval (fun i ↦ r⁻¹ * x i) P = 0 rw [eval_scale_of_isHomogeneous P P.totalDegree hP x r⁻¹, hx, mul_zero] have hyreg : gradientAt P y ≠ 0 := by rw [show y = r⁻¹ • x from rfl, gradientAt_scale P P.totalDegree hP] exact smul_ne_zero (pow_ne_zero _ (inv_ne_zero hr.ne')) hreg have hnf := Source29PolynomialLinkNonflatness.exists_positive_curvature_on_link_fin8 P P.totalDegree hP hirr hd hL y hyunit hyzero hyreg exact no_nonflat_sign_changing_factor P hirr hP hL ⟨b, hb⟩ ⟨a, ha⟩ hnf end end Source29IrreducibleHomogeneousRigidity /- Component: NonlinearPositiveStructureReduction.inc -/ namespace Source29NonlinearPositiveStructureReduction open MvPolynomial Source29Closing noncomputable section /-- Sufficient factor data with no regularity assumption on the real zero set. -/ def NonlinearPositiveLeadingFactorData8 (P : Polynomial8) : Prop := ∃ (p Q : Polynomial8) (k : ℕ), 1 ≤ k ∧ Irreducible p ∧ p.IsHomogeneous p.totalDegree ∧ Q.IsHomogeneous Q.totalDegree ∧ homogeneousComponent P.totalDegree P = p ^ k * Q ∧ PositiveAwayFromZero Q ∧ 2 ≤ p.totalDegree /-- Weighted curvature continuity removes the former global regularity hypothesis from the exact source29 closing reduction. -/ theorem problem29_of_nonlinear_positive_leading_factor (hstructure : ∀ P : Polynomial8, Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → NonlinearPositiveLeadingFactorData8 P) : Math30.Problem29 := by intro P hminimal change P.totalDegree ≤ 1 by_contra hn have hd : 2 ≤ P.totalDegree := by omega obtain ⟨p, Q, k, hk, hp, hphom, hQhom, hfactor, hQpos, hpdegree⟩ := hstructure P hminimal hd obtain ⟨_, hpos, hneg⟩ := Source29PositiveResidualSign.minimal_graph_factor_changes_sign P p Q k hminimal hd hfactor hQpos obtain ⟨hne, hhom, hL⟩ := QuarticPolynomialBasics.leading_component_data P hminimal hd have hQdiv : Q ∣ homogeneousComponent P.totalDegree P := ⟨p ^ k, hfactor.trans (mul_comm _ _)⟩ have hQdegree := Source29ComplexObstruction.positive_divisor_obstruction (homogeneousComponent P.totalDegree P) Q P.totalDegree hne hhom hL hQhom hQpos hQdiv have hQconst : Q = C (Q.coeff 0) := totalDegree_eq_zero_iff_eq_C.mp hQdegree have ha : Q.coeff 0 ≠ 0 := by intro hz apply hne rw [hfactor, hQconst, hz, map_zero, mul_zero] have hpL : Source29FactorInheritance.cubicOperator p = 0 := by apply Source29PowerOperator.cubicOperator_pow_mul_C_zero_imp p hp.ne_zero k (by omega) (Q.coeff 0) ha change QuarticPolynomialBasics.cubicOperator (p ^ k * C (Q.coeff 0)) = 0 rw [← hQconst, ← hfactor] exact hL have hpd := Source29IrreducibleHomogeneousRigidity.degree_le_one p hp hphom hpL hpos hneg omega end end Source29NonlinearPositiveStructureReduction /- Component: GraphMassIdentity.inc -/ namespace Source29GraphMassIdentity open MeasureTheory open Source29QuarticReuse.FluxObstruction Source29GraphAreaConvexity open scoped BigOperators noncomputable section variable {n : ℕ} theorem gradient_pair_normalized (g : (Fin n → ℝ) → Fin n → ℝ) (x : Fin n → ℝ) : (∑ i, g x i * normalizedField g x i) = areaDensity (g x) - 1 / areaDensity (g x) := by have hw := areaDensity_pos (g x) have hs := areaDensity_sq (g x) change (∑ i, g x i * (g x i / areaDensity (g x))) = _ simp only [← mul_div_assoc, ← pow_two, ← Finset.sum_div] apply (eq_sub_iff_add_eq).mpr rw [← add_div] apply (div_eq_iff hw.ne').mpr nlinarith theorem composed_product_fderiv {u ρ : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} {h : ℝ → ℝ} (hu : ContDiff ℝ 1 u) (hρ : ContDiff ℝ 1 ρ) (hh : ContDiff ℝ 1 h) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (x : Fin n → ℝ) (i : Fin n) : fderiv ℝ (fun y ↦ ρ y * h (u y)) x (Pi.single i 1) = h (u x) * fderiv ℝ ρ x (Pi.single i 1) + ρ x * deriv h (u x) * g x i := by have hd := ((hh.differentiable (by norm_num) (u x)).hasDerivAt).comp_hasFDerivAt x ((hu.differentiable (by norm_num) x).hasFDerivAt) have hp := ((hρ.differentiable (by norm_num) x).hasFDerivAt).fun_mul hd have he := congrArg (fun D : (Fin n → ℝ) →L[ℝ] ℝ ↦ D (Pi.single i 1)) hp.fderiv simpa only [add_apply, _root_.smul_apply, smul_eq_mul, hdu, mul_assoc, add_comm, Function.comp_def] using he theorem composed_product_flux {u ρ : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} {h : ℝ → ℝ} (hu : ContDiff ℝ 1 u) (hρ : ContDiff ℝ 1 ρ) (hh : ContDiff ℝ 1 h) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (x : Fin n → ℝ) : testFlux (fun i ↦ Pi.single i 1) (fun y ↦ ρ y * h (u y)) (normalizedField g) x = h (u x) * testFlux (fun i ↦ Pi.single i 1) ρ (normalizedField g) x + ρ x * deriv h (u x) * (areaDensity (g x) - 1 / areaDensity (g x)) := by simp only [testFlux, composed_product_fderiv hu hρ hh hdu, add_mul, Finset.sum_add_distrib] simp_rw [mul_assoc, ← Finset.mul_sum] rw [gradient_pair_normalized] /-- Separable graph-area weights can be integrated using only the normal field and a primitive in the height variable. This is exact for every smooth graph whose normalized gradient is divergence-free. -/ theorem separable_mass_identity {u ρ : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} {h : ℝ → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (hdiv : ∀ x, divergence (fun i ↦ Pi.single i 1) (normalizedField g) x = 0) (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hh : ContDiff ℝ 1 h) : (∫ x, ρ x * deriv h (u x) * areaDensity (g x)) = (∫ x, ρ x * deriv h (u x) / areaDensity (g x)) - (∫ x, h (u x) * testFlux (fun i ↦ Pi.single i 1) ρ (normalizedField g) x) := by have hw : Continuous (fun x ↦ areaDensity (g x)) := areaDensity_continuous g (fun i ↦ (hg i).continuous) have hf := normalizedField_contDiff hg have hd : Continuous (fun x ↦ deriv h (u x)) := hh.continuous_deriv_one.comp hu.continuous have hi : Integrable (fun x ↦ ρ x * deriv h (u x) * areaDensity (g x)) := ((hρ.continuous.mul hd).mul hw).integrable_of_hasCompactSupport hcρ.mul_right.mul_right have he : Integrable (fun x ↦ ρ x * deriv h (u x) / areaDensity (g x)) := ((hρ.continuous.mul hd).div hw (fun x ↦ (areaDensity_pos (g x)).ne')).integrable_of_hasCompactSupport (by have hs : HasCompactSupport (fun x ↦ ρ x * (deriv h (u x) / areaDensity (g x))) := hcρ.mul_right have heq : (fun x ↦ ρ x * deriv h (u x) / areaDensity (g x)) = (fun x ↦ ρ x * (deriv h (u x) / areaDensity (g x))) := by funext x ring change HasCompactSupport (fun x ↦ ρ x * deriv h (u x) / areaDensity (g x)) rw [heq] exact hs) have ht : ContDiff ℝ 1 (fun x ↦ ρ x * h (u x)) := hρ.mul (hh.comp hu) have hz := integral_testFlux_eq_zero (μ := volume) (fun i ↦ Pi.single i 1) ht hcρ.mul_right hf hdiv have hflux : Integrable (fun x ↦ h (u x) * testFlux (fun i ↦ Pi.single i 1) ρ (normalizedField g) x) := by apply Continuous.integrable_of_hasCompactSupport · exact (hh.continuous.comp hu.continuous).mul (testFlux_continuous _ hρ (fun i ↦ (hf i).continuous)) · exact (testFlux_hasCompactSupport _ hcρ).mul_left have hid : (fun x ↦ testFlux (fun i ↦ Pi.single i 1) (fun y ↦ ρ y * h (u y)) (normalizedField g) x) = (fun x ↦ h (u x) * testFlux (fun i ↦ Pi.single i 1) ρ (normalizedField g) x + (ρ x * deriv h (u x) * areaDensity (g x) - ρ x * deriv h (u x) / areaDensity (g x))) := by funext x rw [composed_product_flux hu hρ hh hdu] ring have ha := integral_add hflux (hi.sub he) have hs := integral_sub hi he simp only [Pi.sub_apply] at ha hs rw [hid, ha, hs] at hz linarith end end Source29GraphMassIdentity /- Component: GraphDilationFields.inc -/ namespace Source29GraphDilationFields open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29QuarticReuse.QuarticPolynomialBasics Source29GraphCalibration Source29GraphMassIdentity open scoped BigOperators Topology noncomputable section variable {n : ℕ} def height (P : MvPolynomial (Fin n) ℝ) (r : ℝ) (x : Fin n → ℝ) : ℝ := eval (r • x) P / r def gradient (P : MvPolynomial (Fin n) ℝ) (r : ℝ) (x : Fin n → ℝ) := evaluatedGradient P (r • x) theorem height_contDiff (P : MvPolynomial (Fin n) ℝ) (r : ℝ) : ContDiff ℝ 1 (height P r) := by unfold height exact ((contDiff_eval P).comp (by fun_prop)).div_const r theorem gradient_contDiff (P : MvPolynomial (Fin n) ℝ) (r : ℝ) (i : Fin n) : ContDiff ℝ 1 (fun x ↦ gradient P r x i) := by unfold gradient evaluatedGradient exact (contDiff_eval (pderiv i P)).comp (by fun_prop) theorem height_fderiv (P : MvPolynomial (Fin n) ℝ) (r : ℝ) (hr : r ≠ 0) (x : Fin n → ℝ) (i : Fin n) : fderiv ℝ (height P r) x (Pi.single i 1) = gradient P r x i := by have hd := ((hasFDerivAt_eval P (r • x)).comp x ((hasFDerivAt_id x).const_smul r)).const_smul r⁻¹ have he := congrArg (fun D : (Fin n → ℝ) →L[ℝ] ℝ ↦ D (Pi.single i 1)) hd.fderiv have heq : (r⁻¹ • ((fun y : Fin n → ℝ ↦ eval y P) ∘ HSMul.hSMul r)) = height P r := by funext y simp only [height, Pi.smul_apply, Function.comp_apply, smul_eq_mul, div_eq_mul_inv, mul_comm] rw [heq] at he simpa only [ContinuousLinearMap.comp_apply, _root_.smul_apply, ContinuousLinearMap.id_apply, map_smul, smul_eq_mul, evalFDeriv_basis, gradient, evaluatedGradient, inv_mul_cancel_left₀ hr] using he theorem normalized_gradient_eq (P : MvPolynomial (Fin n) ℝ) (r : ℝ) (x : Fin n → ℝ) : normalizedField (gradient P r) x = normalizedField (evaluatedGradient P) (r • x) := rfl theorem normalized_gradient_divergence (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (r : ℝ) (x : Fin n → ℝ) : divergence (fun i ↦ Pi.single i 1) (normalizedField (gradient P r)) x = 0 := by change divergence (fun i ↦ Pi.single i 1) (fun y ↦ normalizedField (evaluatedGradient P) (r • y)) x = 0 have hg : ∀ i, ContDiff ℝ 1 (fun x ↦ evaluatedGradient P x i) := fun i ↦ contDiff_eval (pderiv i P) rw [divergence_dilate _ (normalizedField_contDiff hg), polynomial_normalizedGradient_divergence_zero P hmin, mul_zero] theorem dilated_graph_mass_identity (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (r : ℝ) (hr : r ≠ 0) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) : (∫ x, ρ x * deriv h (height P r x) * Source29GraphAreaConvexity.areaDensity (gradient P r x)) = (∫ x, ρ x * deriv h (height P r x) / Source29GraphAreaConvexity.areaDensity (gradient P r x)) - (∫ x, h (height P r x) * testFlux (fun i ↦ Pi.single i 1) ρ (normalizedField (gradient P r)) x) := separable_mass_identity (height_contDiff P r) (gradient_contDiff P r) (height_fderiv P r hr) (normalized_gradient_divergence P hmin r) hρ hcρ hh end end Source29GraphDilationFields /- Component: GraphHeightLimits.inc -/ namespace Source29GraphHeightLimits open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29GraphDilationFields open scoped Topology noncomputable section variable {n : ℕ} theorem height_eq_scaled (P : MvPolynomial (Fin n) ℝ) (hdeg : 1 ≤ P.totalDegree) (r : ℝ) (hr : r ≠ 0) (x : Fin n → ℝ) : height P r x = (eval (r • x) P / r ^ P.totalDegree) * r ^ (P.totalDegree - 1) := by have he : P.totalDegree = (P.totalDegree - 1) + 1 := by omega unfold height have hpow : r ^ P.totalDegree = r ^ (P.totalDegree - 1) * r := by conv_lhs => rw [he] exact pow_succ r (P.totalDegree - 1) rw [hpow] have hp : r ^ (P.totalDegree - 1) ≠ 0 := pow_ne_zero _ hr field_simp theorem height_tendsto_atTop (P : MvPolynomial (Fin n) ℝ) (hdeg : 2 ≤ P.totalDegree) (x : Fin n → ℝ) (hx : 0 < eval x (homogeneousComponent P.totalDegree P)) : Tendsto (fun k ↦ height P (dilationRadius k) x) atTop atTop := by have hf := (eval_dilate_div_pow_tendsto P (by omega : 0 < P.totalDegree) le_rfl x).comp dilationRadius_tendsto have hg := (tendsto_pow_atTop (by omega : P.totalDegree - 1 ≠ 0)).comp dilationRadius_tendsto have ht := hf.pos_mul_atTop hx hg convert ht using 1 funext k exact height_eq_scaled P (by omega) _ (dilationRadius_pos k).ne' x theorem height_tendsto_atBot (P : MvPolynomial (Fin n) ℝ) (hdeg : 2 ≤ P.totalDegree) (x : Fin n → ℝ) (hx : eval x (homogeneousComponent P.totalDegree P) < 0) : Tendsto (fun k ↦ height P (dilationRadius k) x) atTop atBot := by have hf := (eval_dilate_div_pow_tendsto P (by omega : 0 < P.totalDegree) le_rfl x).comp dilationRadius_tendsto have hg := (tendsto_pow_atTop (by omega : P.totalDegree - 1 ≠ 0)).comp dilationRadius_tendsto have ht := hf.neg_mul_atTop hx hg convert ht using 1 funext k exact height_eq_scaled P (by omega) _ (dilationRadius_pos k).ne' x theorem height_profile_tendsto_ae (P : MvPolynomial (Fin n) ℝ) (hdeg : 2 ≤ P.totalDegree) {h : ℝ → ℝ} {a b : ℝ} (hp : Tendsto h atTop (𝓝 a)) (hm : Tendsto h atBot (𝓝 b)) : ∀ᵐ x : Fin n → ℝ, Tendsto (fun k ↦ h (height P (dilationRadius k) x)) atTop (𝓝 (if 0 < eval x (homogeneousComponent P.totalDegree P) then a else b)) := by have hne := Source29QuarticReuse.QuarticPolynomialBasics.top_homogeneousComponent_ne_zero P (by omega : 0 < P.totalDegree) filter_upwards [mvPolynomial_eval_ne_zero_ae n _ hne] with x hx by_cases hs : 0 < eval x (homogeneousComponent P.totalDegree P) · simp only [ite_eq_left hs] exact hp.comp (height_tendsto_atTop P hdeg x hs) · simp only [ite_eq_right hs] exact hm.comp (height_tendsto_atBot P hdeg x (lt_of_le_of_ne (le_of_not_gt hs) hx)) end end Source29GraphHeightLimits /- Component: GraphMassLimits.inc -/ namespace Source29GraphMassLimits open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29GraphDilationFields Source29GraphHeightLimits Source29GraphAreaConvexity open scoped BigOperators Topology noncomputable section variable {n : ℕ} theorem areaDensity_ge_one (v : Fin n → ℝ) : 1 ≤ areaDensity v := by have hs := areaDensity_sq v have hp := areaDensity_pos v have hn : 0 ≤ ∑ i, v i ^ 2 := Finset.sum_nonneg (fun i _ ↦ sq_nonneg _) nlinarith theorem norm_div_areaDensity_le (a : ℝ) (v : Fin n → ℝ) : ‖a / areaDensity v‖ ≤ ‖a‖ := by rw [norm_div, Real.norm_eq_abs (areaDensity v), abs_of_pos (areaDensity_pos v)] exact div_le_self (norm_nonneg _) (areaDensity_ge_one v) theorem height_error_integral_tendsto_zero (P : MvPolynomial (Fin n) ℝ) (hdeg : 2 ≤ P.totalDegree) {ρ : (Fin n → ℝ) → ℝ} (hρ : Continuous ρ) (hcρ : HasCompactSupport ρ) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) {M : ℝ} (hb : ∀ t, ‖deriv h t‖ ≤ M) (hp : Tendsto (deriv h) atTop (𝓝 0)) (hm : Tendsto (deriv h) atBot (𝓝 0)) : Tendsto (fun k ↦ ∫ x, ρ x * deriv h (height P (dilationRadius k) x) / areaDensity (gradient P (dilationRadius k) x)) atTop (𝓝 0) := by have hl : ∀ᵐ x : Fin n → ℝ, Tendsto (fun k ↦ deriv h (height P (dilationRadius k) x)) atTop (𝓝 0) := by simpa only [ite_self] using height_profile_tendsto_ae P hdeg hp hm have hc : ∀ k, Continuous (fun x ↦ ρ x * deriv h (height P (dilationRadius k) x) / areaDensity (gradient P (dilationRadius k) x)) := by intro k exact (hρ.mul (hh.continuous_deriv_one.comp (height_contDiff P _).continuous)).div (areaDensity_continuous _ (fun i ↦ (gradient_contDiff P _ i).continuous)) (fun x ↦ (areaDensity_pos _).ne') have ht : Tendsto (fun k ↦ ∫ x, ρ x * deriv h (height P (dilationRadius k) x) / areaDensity (gradient P (dilationRadius k) x)) atTop (𝓝 (∫ _x : Fin n → ℝ, (0 : ℝ))) := by apply tendsto_integral_of_dominated_convergence (fun x ↦ ‖ρ x‖ * M) · exact fun k ↦ (hc k).aestronglyMeasurable · exact (hρ.integrable_of_hasCompactSupport hcρ).norm.mul_const M · intro k exact Filter.Eventually.of_forall fun x ↦ (norm_div_areaDensity_le _ _).trans (by rw [norm_mul]; exact mul_le_mul_of_nonneg_left (hb _) (norm_nonneg _)) · filter_upwards [hl] with x hx apply squeeze_zero_norm (fun k ↦ norm_div_areaDensity_le _ _) simpa only [mul_zero, norm_zero] using (tendsto_const_nhds.mul hx).norm simpa only [integral_zero] using ht theorem height_flux_integral_tendsto (P : MvPolynomial (Fin n) ℝ) (hdeg : 2 ≤ P.totalDegree) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) {h : ℝ → ℝ} (hh : Continuous h) (hb : ∀ t, ‖h t‖ ≤ 1) (hp : Tendsto h atTop (𝓝 1)) (hm : Tendsto h atBot (𝓝 0)) : Tendsto (fun k ↦ ∫ x, h (height P (dilationRadius k) x) * testFlux (fun i ↦ Pi.single i 1) ρ (normalizedField (gradient P (dilationRadius k))) x) atTop (𝓝 (-Source29PhaseMassLimit.phaseMass (homogeneousComponent P.totalDegree P) ρ)) := by have hn := Source29TopWeakCalibration.normalizedGradient_dilates_tendsto_ae P hdeg have hl := height_profile_tendsto_ae P hdeg hp hm have ht : Tendsto (fun k ↦ ∫ x, h (height P (dilationRadius k) x) * testFlux (fun i ↦ Pi.single i 1) ρ (normalizedField (gradient P (dilationRadius k))) x) atTop (𝓝 (∫ x, (if 0 < eval x (homogeneousComponent P.totalDegree P) then 1 else 0) * testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField (homogeneousComponent P.totalDegree P)) x)) := by apply tendsto_integral_of_dominated_convergence (testBound (fun i ↦ Pi.single i 1) ρ) · intro k exact ((hh.comp (height_contDiff P _).continuous).mul (testFlux_continuous _ hρ (fun i ↦ (normalizedField_contDiff (gradient_contDiff P _) i).continuous))).aestronglyMeasurable · exact testBound_integrable _ hρ hcρ · intro k apply Filter.Eventually.of_forall intro x rw [norm_mul] exact (mul_le_mul_of_nonneg_right (hb _) (norm_nonneg _)).trans (by simpa only [one_mul] using norm_testFlux_le_testBound (fun i ↦ Pi.single i 1) ρ (normalizedField (gradient P (dilationRadius k))) x (fun i ↦ normalizedField_norm_le_one _ _ _)) · filter_upwards [hl, hn] with x hx hnx apply hx.mul apply testFlux_tendsto exact hnx convert ht using 1 simp only [Source29PhaseMassLimit.phaseMass, neg_neg] congr 1 apply integral_congr_ae exact Filter.Eventually.of_forall fun x ↦ mul_comm _ _ theorem graph_mass_tendsto_phaseMass (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) (hb : ∀ t, ‖h t‖ ≤ 1) (hp : Tendsto h atTop (𝓝 1)) (hm : Tendsto h atBot (𝓝 0)) {M : ℝ} (hdb : ∀ t, ‖deriv h t‖ ≤ M) (hdp : Tendsto (deriv h) atTop (𝓝 0)) (hdm : Tendsto (deriv h) atBot (𝓝 0)) : Tendsto (fun k ↦ ∫ x, ρ x * deriv h (height P (dilationRadius k) x) * areaDensity (gradient P (dilationRadius k) x)) atTop (𝓝 (Source29PhaseMassLimit.phaseMass (homogeneousComponent P.totalDegree P) ρ)) := by have he := height_error_integral_tendsto_zero P hdeg hρ.continuous hcρ hh hdb hdp hdm have hf := height_flux_integral_tendsto P hdeg hρ hcρ hh.continuous hb hp hm have ht := he.sub hf simp only [zero_sub, neg_neg] at ht convert ht using 1 funext k exact dilated_graph_mass_identity P hmin _ (dilationRadius_pos k).ne' hρ hcρ hh end end Source29GraphMassLimits /- Component: GraphHeightProfile.inc -/ namespace Source29GraphHeightProfile open MvPolynomial MeasureTheory Filter Set open Source29GraphDilationFields Source29GraphAreaConvexity open Source29QuarticReuse.FluxPolynomial open scoped Topology noncomputable section theorem profile_norm_le_one (t : ℝ) : ‖Real.smoothTransition t‖ ≤ 1 := by rw [Real.norm_eq_abs, abs_of_nonneg (Real.smoothTransition.nonneg t)] exact Real.smoothTransition.le_one t theorem profile_tendsto_atTop : Tendsto Real.smoothTransition atTop (𝓝 1) := by apply (tendsto_const_nhds : Tendsto (fun _ : ℝ ↦ (1 : ℝ)) atTop (𝓝 1)).congr' filter_upwards [eventually_ge_atTop (1 : ℝ)] with t ht exact (Real.smoothTransition.one_of_one_le ht).symm theorem profile_tendsto_atBot : Tendsto Real.smoothTransition atBot (𝓝 0) := by apply (tendsto_const_nhds : Tendsto (fun _ : ℝ ↦ (0 : ℝ)) atBot (𝓝 0)).congr' filter_upwards [eventually_le_atBot (0 : ℝ)] with t ht exact (Real.smoothTransition.zero_of_nonpos ht).symm theorem profile_deriv_zero_left {t : ℝ} (ht : t < 0) : deriv Real.smoothTransition t = 0 := by have he : Real.smoothTransition =ᶠ[𝓝 t] fun _ ↦ 0 := by filter_upwards [gt_mem_nhds ht] with s hs exact Real.smoothTransition.zero_of_nonpos hs.le rw [he.deriv_eq, deriv_const] theorem profile_deriv_zero_right {t : ℝ} (ht : 1 < t) : deriv Real.smoothTransition t = 0 := by have he : Real.smoothTransition =ᶠ[𝓝 t] fun _ ↦ 1 := by filter_upwards [lt_mem_nhds ht] with s hs exact Real.smoothTransition.one_of_one_le hs.le rw [he.deriv_eq, deriv_const] theorem profile_deriv_hasCompactSupport : HasCompactSupport (deriv Real.smoothTransition) := by apply HasCompactSupport.of_support_subset_isCompact (K := Icc (0 : ℝ) 1) isCompact_Icc intro t ht by_contra hn simp only [mem_Icc, not_and_or, not_le] at hn rcases hn with hleft | hright · exact ht (profile_deriv_zero_left hleft) · exact ht (profile_deriv_zero_right hright) theorem profile_deriv_bounded : ∃ M : ℝ, ∀ t, ‖deriv Real.smoothTransition t‖ ≤ M := profile_deriv_hasCompactSupport.exists_bound_of_continuous (Real.smoothTransition.contDiff (n := 1)).continuous_deriv_one theorem profile_deriv_tendsto_atTop : Tendsto (deriv Real.smoothTransition) atTop (𝓝 0) := by apply (tendsto_const_nhds : Tendsto (fun _ : ℝ ↦ (0 : ℝ)) atTop (𝓝 0)).congr' filter_upwards [eventually_gt_atTop (1 : ℝ)] with t ht exact (profile_deriv_zero_right ht).symm theorem profile_deriv_tendsto_atBot : Tendsto (deriv Real.smoothTransition) atBot (𝓝 0) := by apply (tendsto_const_nhds : Tendsto (fun _ : ℝ ↦ (0 : ℝ)) atBot (𝓝 0)).congr' filter_upwards [eventually_lt_atBot (0 : ℝ)] with t ht exact (profile_deriv_zero_left ht).symm /-- An explicit nonnegative, compactly supported height weight gives the leading phase perimeter as the limit of rescaled graph area. -/ theorem smooth_weight_graph_mass_tendsto {n : ℕ} (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) : Tendsto (fun k ↦ ∫ x, ρ x * deriv Real.smoothTransition (height P (dilationRadius k) x) * areaDensity (gradient P (dilationRadius k) x)) atTop (𝓝 (Source29PhaseMassLimit.phaseMass (homogeneousComponent P.totalDegree P) ρ)) := by obtain ⟨M, hM⟩ := profile_deriv_bounded exact Source29GraphMassLimits.graph_mass_tendsto_phaseMass P hmin hdeg hρ hcρ Real.smoothTransition.contDiff profile_norm_le_one profile_tendsto_atTop profile_tendsto_atBot hM profile_deriv_tendsto_atTop profile_deriv_tendsto_atBot end end Source29GraphHeightProfile /- Component: GraphRadialCurrent.inc -/ namespace Source29GraphRadialCurrent open MvPolynomial MeasureTheory open Source29QuarticReuse.FluxObstruction Source29GraphAreaConvexity open scoped BigOperators noncomputable section variable {n : ℕ} def defect (u : (Fin n → ℝ) → ℝ) (g : (Fin n → ℝ) → Fin n → ℝ) (x : Fin n → ℝ) : ℝ := u x - ∑ i, x i * g x i def current (u : (Fin n → ℝ) → ℝ) (g : (Fin n → ℝ) → Fin n → ℝ) (x : Fin n → ℝ) (i : Fin n) : ℝ := areaDensity (g x) * x i + defect u g x * normalizedField g x i theorem areaDensity_contDiff {g : (Fin n → ℝ) → Fin n → ℝ} (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) : ContDiff ℝ 1 (fun x ↦ areaDensity (g x)) := by simpa only [Source29RegularizedGradientNorm.density, one_pow, areaDensity] using Source29RegularizedGradientNorm.density_contDiff 1 (by norm_num) g hg theorem areaDensity_fderiv {g : (Fin n → ℝ) → Fin n → ℝ} (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (x v : Fin n → ℝ) : fderiv ℝ (fun y ↦ areaDensity (g y)) x v = ∑ i, normalizedField g x i * fderiv ℝ (fun y ↦ g y i) x v := by simpa only [Source29RegularizedGradientNorm.density, Source29RegularizedGradientNorm.field, one_pow, areaDensity, normalizedField, radiusSq] using Source29RegularizedGradientNorm.density_fderiv 1 (by norm_num) g hg x v theorem defect_contDiff {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) : ContDiff ℝ 1 (defect u g) := by exact hu.sub (ContDiff.sum (fun i _ ↦ (contDiff_apply ℝ ℝ i).mul (hg i))) theorem defect_fderiv {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (x : Fin n → ℝ) (i : Fin n) : fderiv ℝ (defect u g) x (Pi.single i 1) = -(∑ j, x j * fderiv ℝ (fun y ↦ g y j) x (Pi.single i 1)) := by have hs : HasFDerivAt (fun y ↦ ∑ j, y j * g y j) (∑ j, (x j • fderiv ℝ (fun y ↦ g y j) x + g x j • (ContinuousLinearMap.proj j : (Fin n → ℝ) →L[ℝ] ℝ))) x := by apply HasFDerivAt.fun_sum intro j _ exact (hasFDerivAt_apply (𝕜 := ℝ) (F' := fun _ : Fin n ↦ ℝ) j x).fun_mul ((hg j).differentiable (by norm_num) x).hasFDerivAt have hd := ((hu.differentiable (by norm_num) x).hasFDerivAt).sub hs have he := congrArg (fun D : (Fin n → ℝ) →L[ℝ] ℝ ↦ D (Pi.single i 1)) hd.fderiv change fderiv ℝ (defect u g) x (Pi.single i 1) = _ at he simp [Finset.sum_add_distrib, Pi.single_apply, hdu, eq_comm] at he exact he theorem current_contDiff {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (i : Fin n) : ContDiff ℝ 1 (fun x ↦ current u g x i) := ((areaDensity_contDiff hg).mul (contDiff_apply ℝ ℝ i)).add ((defect_contDiff hu hg).mul (normalizedField_contDiff hg i)) theorem current_diagonal_fderiv {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (x : Fin n → ℝ) (i : Fin n) : fderiv ℝ (fun y ↦ current u g y i) x (Pi.single i 1) = areaDensity (g x) + x i * (∑ j, normalizedField g x j * fderiv ℝ (fun y ↦ g y j) x (Pi.single i 1)) - (∑ j, x j * fderiv ℝ (fun y ↦ g y j) x (Pi.single i 1)) * normalizedField g x i + defect u g x * fderiv ℝ (fun y ↦ normalizedField g y i) x (Pi.single i 1) := by have ha := ((areaDensity_contDiff hg).differentiable (by norm_num) x).hasFDerivAt.fun_mul (hasFDerivAt_apply (𝕜 := ℝ) (F' := fun _ : Fin n ↦ ℝ) i x) have hb := ((defect_contDiff hu hg).differentiable (by norm_num) x).hasFDerivAt.fun_mul ((normalizedField_contDiff hg i).differentiable (by norm_num) x).hasFDerivAt have he := congrArg (fun D : (Fin n → ℝ) →L[ℝ] ℝ ↦ D (Pi.single i 1)) (ha.add hb).fderiv change fderiv ℝ (fun y ↦ current u g y i) x (Pi.single i 1) = _ at he simp only [add_apply, _root_.smul_apply, smul_eq_mul, ContinuousLinearMap.proj_apply, Pi.single_eq_same, mul_one, areaDensity_fderiv hg, defect_fderiv hu hg hdu] at he rw [he] ring /-- The tangential radial current has divergence equal to dimension times graph area density. This is the local identity underlying monotonicity. -/ theorem current_divergence {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (hsym : ∀ x i j, fderiv ℝ (fun y ↦ g y j) x (Pi.single i 1) = fderiv ℝ (fun y ↦ g y i) x (Pi.single j 1)) (hdiv : ∀ x, divergence (fun i ↦ Pi.single i 1) (normalizedField g) x = 0) (x : Fin n → ℝ) : divergence (fun i ↦ Pi.single i 1) (current u g) x = (n : ℝ) * areaDensity (g x) := by have hcancel : (∑ i, x i * (∑ j, normalizedField g x j * fderiv ℝ (fun y ↦ g y j) x (Pi.single i 1))) = ∑ i, (∑ j, x j * fderiv ℝ (fun y ↦ g y j) x (Pi.single i 1)) * normalizedField g x i := by simp_rw [Finset.mul_sum, Finset.sum_mul] rw [Finset.sum_comm] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ rw [hsym x j i] ring simp only [divergence, current_diagonal_fderiv hu hg hdu, Finset.sum_add_distrib, Finset.sum_sub_distrib] rw [hcancel] have hz := hdiv x unfold divergence at hz simp only [add_sub_cancel_right, ← Finset.mul_sum, hz, mul_zero, add_zero, Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul] theorem weighted_current_identity {u ρ : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (hsym : ∀ x i j, fderiv ℝ (fun y ↦ g y j) x (Pi.single i 1) = fderiv ℝ (fun y ↦ g y i) x (Pi.single j 1)) (hdiv : ∀ x, divergence (fun i ↦ Pi.single i 1) (normalizedField g) x = 0) (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) : (∫ x, ρ x * ((n : ℝ) * areaDensity (g x))) = -(∫ x, testFlux (fun i ↦ Pi.single i 1) ρ (current u g) x) := by have he := integral_mul_divergence_eq_neg_testFlux (μ := volume) (fun i ↦ Pi.single i 1) hρ hcρ (current_contDiff hu hg) simpa only [current_divergence hu hg hdu hsym hdiv] using he theorem polynomial_current_divergence (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (x : Fin n → ℝ) : divergence (fun i ↦ Pi.single i 1) (current (fun y ↦ eval y P) (evaluatedGradient P)) x = (n : ℝ) * areaDensity (evaluatedGradient P x) := by apply current_divergence (Source29QuarticReuse.FluxPolynomial.contDiff_eval P) (fun i ↦ Source29QuarticReuse.FluxPolynomial.contDiff_eval (pderiv i P)) · intro y i exact congrArg (fun D : (Fin n → ℝ) →L[ℝ] ℝ ↦ D (Pi.single i 1)) (Source29QuarticReuse.QuarticPolynomialBasics.fderiv_eval P y) |>.trans (Source29QuarticReuse.QuarticPolynomialBasics.evalFDeriv_basis P y i) · intro y i j change fderiv ℝ (fun z ↦ eval z (pderiv j P)) y (Pi.single i 1) = fderiv ℝ (fun z ↦ eval z (pderiv i P)) y (Pi.single j 1) rw [Source29QuarticReuse.QuarticPolynomialBasics.fderiv_eval, Source29QuarticReuse.QuarticPolynomialBasics.fderiv_eval, Source29QuarticReuse.QuarticPolynomialBasics.evalFDeriv_basis, Source29QuarticReuse.QuarticPolynomialBasics.evalFDeriv_basis, Source29QuarticReuse.QuarticPolynomialBasics.second_partial_comm] · exact Source29GraphCalibration.polynomial_normalizedGradient_divergence_zero P hmin end end Source29GraphRadialCurrent /- Component: GraphRadialGeometry.inc -/ namespace Source29GraphRadialGeometry open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29GraphAreaConvexity Source29GraphRadialCurrent open scoped BigOperators noncomputable section variable {n : ℕ} def graphRadiusSq (u : (Fin n → ℝ) → ℝ) (x : Fin n → ℝ) : ℝ := (∑ i, x i ^ 2) + u x ^ 2 theorem graphRadiusSq_contDiff {u : (Fin n → ℝ) → ℝ} (hu : ContDiff ℝ 1 u) : ContDiff ℝ 1 (graphRadiusSq u) := (ContDiff.sum (fun i _ ↦ (contDiff_apply ℝ ℝ i).pow 2)).add (hu.pow 2) theorem graphRadiusSq_fderiv {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (x : Fin n → ℝ) (i : Fin n) : fderiv ℝ (graphRadiusSq u) x (Pi.single i 1) = 2 * (x i + u x * g x i) := by have hs : HasFDerivAt (fun y : Fin n → ℝ ↦ ∑ j, y j ^ 2) (∑ j, (2 * x j) • (ContinuousLinearMap.proj j : (Fin n → ℝ) →L[ℝ] ℝ)) x := by apply HasFDerivAt.fun_sum intro j _ convert (hasFDerivAt_apply (𝕜 := ℝ) (F' := fun _ : Fin n ↦ ℝ) j x).pow 2 using 1 <;> simp have he := congrArg (fun D : (Fin n → ℝ) →L[ℝ] ℝ ↦ D (Pi.single i 1)) (hs.add (((hu.differentiable (by norm_num) x).hasFDerivAt).pow 2)).fderiv change fderiv ℝ (graphRadiusSq u) x (Pi.single i 1) = _ at he simp [Pi.single_apply, hdu, eq_comm] at he linarith theorem radial_pairing_algebra (x v : Fin n → ℝ) (z : ℝ) : (∑ i, (x i + z * v i) * (areaDensity v * x i + (z - ∑ j, x j * v j) * (v i / areaDensity v))) = areaDensity v * ((∑ i, x i ^ 2) + z ^ 2) - (z - ∑ j, x j * v j) ^ 2 / areaDensity v := by let b := ∑ j, x j * v j have he i : (x i + z * v i) * (areaDensity v * x i + (z - b) * (v i / areaDensity v)) = areaDensity v * x i ^ 2 + (z * areaDensity v + (z - b) / areaDensity v) * (x i * v i) + (z * (z - b) / areaDensity v) * v i ^ 2 := by ring change (∑ i, (x i + z * v i) * (areaDensity v * x i + (z - b) * (v i / areaDensity v))) = _ simp_rw [he] rw [Finset.sum_add_distrib, Finset.sum_add_distrib, ← Finset.mul_sum, ← Finset.mul_sum, ← Finset.mul_sum] change areaDensity v * (∑ i, x i ^ 2) + (z * areaDensity v + (z - b) / areaDensity v) * b + z * (z - b) / areaDensity v * (∑ i, v i ^ 2) = areaDensity v * ((∑ i, x i ^ 2) + z ^ 2) - (z - b) ^ 2 / areaDensity v have hw := (areaDensity_pos v).ne' have hs := areaDensity_sq v field_simp linear_combination -z * (z - b) * hs theorem graphRadiusSq_current_pairing {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (x : Fin n → ℝ) : testFlux (fun i ↦ Pi.single i 1) (graphRadiusSq u) (current u g) x = 2 * (graphRadiusSq u x * areaDensity (g x) - defect u g x ^ 2 / areaDensity (g x)) := by simp only [testFlux, graphRadiusSq_fderiv hu hdu, current, normalizedField] change (∑ i, (2 * (x i + u x * g x i)) * (areaDensity (g x) * x i + defect u g x * (g x i / areaDensity (g x)))) = _ simp_rw [mul_assoc, ← Finset.mul_sum] rw [defect, radial_pairing_algebra] unfold graphRadiusSq ring theorem radial_cutoff_pairing {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (x : Fin n → ℝ) : testFlux (fun i ↦ Pi.single i 1) (fun y ↦ f (graphRadiusSq u y)) (current u g) x = 2 * deriv f (graphRadiusSq u x) * (graphRadiusSq u x * areaDensity (g x) - defect u g x ^ 2 / areaDensity (g x)) := by have hd := ((hf.differentiable (by norm_num) (graphRadiusSq u x)).hasDerivAt).comp_hasFDerivAt x (((graphRadiusSq_contDiff hu).differentiable (by norm_num) x).hasFDerivAt) have he i := congrArg (fun D : (Fin n → ℝ) →L[ℝ] ℝ ↦ D (Pi.single i 1)) hd.fderiv simp only [_root_.smul_apply, smul_eq_mul] at he unfold testFlux simp_rw [show (fun y ↦ f (graphRadiusSq u y)) = f ∘ graphRadiusSq u from rfl, he, mul_assoc, ← Finset.mul_sum] change deriv f (graphRadiusSq u x) * testFlux (fun i ↦ Pi.single i 1) (graphRadiusSq u) (current u g) x = _ rw [graphRadiusSq_current_pairing hu hdu] ring /-- Exact integrated radial first variation, with the nonnegative normal radial defect term kept explicit. Compact support is required only after pulling the scalar radial test back to the graph. -/ theorem radial_first_variation {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (hsym : ∀ x i j, fderiv ℝ (fun y ↦ g y j) x (Pi.single i 1) = fderiv ℝ (fun y ↦ g y i) x (Pi.single j 1)) (hdiv : ∀ x, divergence (fun i ↦ Pi.single i 1) (normalizedField g) x = 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hcf : HasCompactSupport (fun x ↦ f (graphRadiusSq u x))) : (∫ x, f (graphRadiusSq u x) * ((n : ℝ) * areaDensity (g x))) = -(∫ x, 2 * deriv f (graphRadiusSq u x) * (graphRadiusSq u x * areaDensity (g x) - defect u g x ^ 2 / areaDensity (g x))) := by have he := weighted_current_identity hu hg hdu hsym hdiv (hf.comp (graphRadiusSq_contDiff hu)) hcf change (∫ x, f (graphRadiusSq u x) * ((n : ℝ) * areaDensity (g x))) = -(∫ x, testFlux (fun i ↦ Pi.single i 1) (fun y ↦ f (graphRadiusSq u y)) (current u g) x) at he simpa only [radial_cutoff_pairing hu hdu hf] using he end end Source29GraphRadialGeometry /- Component: CompactParameterIntegral.inc -/ namespace Source29CompactParameterIntegral open MeasureTheory Filter Set open scoped Topology noncomputable section variable {n : ℕ} /-- Differentiation under the integral when a compact parameter interval has a common compact spatial support and a jointly continuous derivative. -/ theorem hasDerivAt_integral {F F' : ℝ → (Fin n → ℝ) → ℝ} {a b r : ℝ} (har : a < r) (hrb : r < b) {K : Set (Fin n → ℝ)} (hK : IsCompact K) (hF : ∀ t ∈ Icc a b, Continuous (F t)) (hF' : ∀ t ∈ Icc a b, Continuous (F' t)) (hjoint : ContinuousOn (fun p : ℝ × (Fin n → ℝ) ↦ F' p.1 p.2) (Icc a b ×ˢ K)) (hz : ∀ t ∈ Icc a b, ∀ x ∉ K, F t x = 0) (hz' : ∀ t ∈ Icc a b, ∀ x ∉ K, F' t x = 0) (hd : ∀ x t, t ∈ Icc a b → HasDerivAt (fun s ↦ F s x) (F' t x) t) : Integrable (F' r) ∧ HasDerivAt (fun t ↦ ∫ x, F t x) (∫ x, F' r x) r := by classical have hr : r ∈ Icc a b := ⟨har.le, hrb.le⟩ have hs : Icc a b ∈ 𝓝 r := Icc_mem_nhds har hrb obtain ⟨M, hM⟩ := (isCompact_Icc.prod hK).exists_bound_of_continuousOn hjoint have hcompact : HasCompactSupport (F r) := by apply HasCompactSupport.of_support_subset_isCompact hK intro x hx by_contra hn exact hx (hz r hr x hn) apply hasDerivAt_integral_of_dominated_loc_of_deriv_le (s := Icc a b) (bound := K.indicator (fun _ ↦ M)) hs · filter_upwards [hs] with t ht exact (hF t ht).aestronglyMeasurable · exact (hF r hr).integrable_of_hasCompactSupport hcompact · exact (hF' r hr).aestronglyMeasurable · apply Filter.Eventually.of_forall intro x t ht by_cases hx : x ∈ K · rw [Set.indicator_of_mem hx] exact hM (t,x) ⟨ht,hx⟩ · rw [Set.indicator_of_notMem hx, hz' t ht x hx, norm_zero] · exact (integrable_indicator_iff hK.measurableSet).2 (integrableOn_const hK.measure_lt_top.ne) · exact Filter.Eventually.of_forall hd end end Source29CompactParameterIntegral /- Component: GraphRadialSupport.inc -/ namespace Source29GraphRadialSupport open Set open Source29GraphRadialGeometry open scoped BigOperators noncomputable section variable {n : ℕ} def supportBox (n : ℕ) (B : ℝ) : Set (Fin n → ℝ) := Icc (fun _ ↦ -(B+1)) (fun _ ↦ B+1) theorem supportBox_compact (n : ℕ) (B : ℝ) : IsCompact (supportBox n B) := isCompact_Icc theorem graphRadiusSq_nonneg (u : (Fin n → ℝ) → ℝ) (x : Fin n → ℝ) : 0 ≤ graphRadiusSq u x := add_nonneg (Finset.sum_nonneg fun i _ ↦ sq_nonneg _) (sq_nonneg _) theorem mem_supportBox_of_radius_le (u : (Fin n → ℝ) → ℝ) (x : Fin n → ℝ) {B : ℝ} (hB : 0 ≤ B) (hx : graphRadiusSq u x ≤ B) : x ∈ supportBox n B := by have hs (i : Fin n) : x i ^ 2 ≤ B := by have hi : x i ^ 2 ≤ ∑ j, x j ^ 2 := Finset.single_le_sum (fun j _ ↦ sq_nonneg _) (Finset.mem_univ i) unfold graphRadiusSq at hx nlinarith [sq_nonneg (u x)] constructor <;> intro i <;> dsimp only <;> nlinarith [hs i, sq_nonneg (x i - 1), sq_nonneg (x i + 1)] theorem scaled_radius_large_outside_box (u : (Fin n → ℝ) → ℝ) {R b r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hrb : r ≤ b) (x : Fin n → ℝ) (hx : x ∉ supportBox n (R*b^2)) : R ≤ graphRadiusSq u x / r^2 := by have hb : 0 < b := hr.trans_le hrb have hrl : R*b^2 < graphRadiusSq u x := lt_of_not_ge fun hle ↦ hx (mem_supportBox_of_radius_le u x (mul_nonneg hR (sq_nonneg b)) hle) apply (le_div_iff₀ (sq_pos_of_pos hr)).2 have hr2 : r^2 ≤ b^2 := by nlinarith exact (mul_le_mul_of_nonneg_left hr2 hR).trans hrl.le theorem scaled_cutoff_zero_outside_box (u : (Fin n → ℝ) → ℝ) {f : ℝ → ℝ} {R b r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hrb : r ≤ b) (hf : ∀ t, R ≤ t → f t = 0) (x : Fin n → ℝ) (hx : x ∉ supportBox n (R*b^2)) : f (graphRadiusSq u x / r^2) = 0 := hf _ (scaled_radius_large_outside_box u hR hr hrb x hx) theorem scaled_cutoff_compact (u : (Fin n → ℝ) → ℝ) {f : ℝ → ℝ} {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hf : ∀ t, R ≤ t → f t = 0) : HasCompactSupport (fun x ↦ f (graphRadiusSq u x / r^2)) := by apply HasCompactSupport.of_support_subset_isCompact (supportBox_compact n (R*r^2)) intro x hx by_contra hn exact hx (scaled_cutoff_zero_outside_box u hR hr le_rfl hf x hn) end end Source29GraphRadialSupport /- Component: GraphMassDerivative.inc -/ namespace Source29GraphMassDerivative open MeasureTheory Set open Source29GraphRadialGeometry Source29GraphRadialSupport Source29GraphAreaConvexity open scoped Topology noncomputable section variable {n : ℕ} def massDensity (u : (Fin n → ℝ) → ℝ) (g : (Fin n → ℝ) → Fin n → ℝ) (f : ℝ → ℝ) (r : ℝ) (x : Fin n → ℝ) : ℝ := f (graphRadiusSq u x / r^2) * areaDensity (g x) def massDensityDeriv (u : (Fin n → ℝ) → ℝ) (g : (Fin n → ℝ) → Fin n → ℝ) (f : ℝ → ℝ) (r : ℝ) (x : Fin n → ℝ) : ℝ := (-2 * graphRadiusSq u x / r^3) * deriv f (graphRadiusSq u x / r^2) * areaDensity (g x) def mass (u : (Fin n → ℝ) → ℝ) (g : (Fin n → ℝ) → Fin n → ℝ) (f : ℝ → ℝ) (r : ℝ) : ℝ := ∫ x, massDensity u g f r x theorem massDensity_hasDerivAt (u : (Fin n → ℝ) → ℝ) (g : (Fin n → ℝ) → Fin n → ℝ) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {r : ℝ} (hr : r ≠ 0) (x : Fin n → ℝ) : HasDerivAt (fun t ↦ massDensity u g f t x) (massDensityDeriv u g f r x) r := by have ha : HasDerivAt (fun t : ℝ ↦ graphRadiusSq u x / t^2) (-2 * graphRadiusSq u x / r^3) r := by convert (hasDerivAt_const r (graphRadiusSq u x)).div ((hasDerivAt_id r).pow 2) (pow_ne_zero 2 hr) using 1 · funext t rfl · simp only [Pi.pow_apply, id_eq] field_simp <;> ring have hd := ((hf.differentiable (by norm_num) (graphRadiusSq u x / r^2)).hasDerivAt.comp r ha).mul_const (areaDensity (g x)) convert hd using 1 · funext t rfl · unfold massDensityDeriv ring theorem massDensity_continuous {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, Continuous (fun x ↦ g x i)) {f : ℝ → ℝ} (hf : Continuous f) (r : ℝ) : Continuous (massDensity u g f r) := (hf.comp ((graphRadiusSq_contDiff hu).continuous.div_const _)).mul (areaDensity_continuous g hg) theorem massDensityDeriv_continuous {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, Continuous (fun x ↦ g x i)) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (r : ℝ) : Continuous (massDensityDeriv u g f r) := ((((graphRadiusSq_contDiff hu).continuous.const_mul (-2)).div_const _).mul (hf.continuous_deriv_one.comp ((graphRadiusSq_contDiff hu).continuous.div_const _))).mul (areaDensity_continuous g hg) theorem massDensityDeriv_continuousAt {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, Continuous (fun x ↦ g x i)) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (p : ℝ × (Fin n → ℝ)) (hp : p.1 ≠ 0) : ContinuousAt (fun q : ℝ × (Fin n → ℝ) ↦ massDensityDeriv u g f q.1 q.2) p := by have hs := ((graphRadiusSq_contDiff hu).continuous.comp continuous_snd).continuousAt (x := p) have harg := hs.div ((continuous_fst.pow 2).continuousAt) (pow_ne_zero 2 hp) exact ((((hs.const_mul (-2)).div ((continuous_fst.pow 3).continuousAt) (pow_ne_zero 3 hp)).mul (hf.continuous_deriv_one.continuousAt.comp harg)).mul ((areaDensity_continuous g hg).comp continuous_snd).continuousAt) theorem massDensity_integrable {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, Continuous (fun x ↦ g x i)) {f : ℝ → ℝ} (hf : Continuous f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ t, R ≤ t → f t = 0) : Integrable (massDensity u g f r) := (massDensity_continuous hu hg hf r).integrable_of_hasCompactSupport (scaled_cutoff_compact u hR hr hz).mul_right theorem mass_hasDerivAt {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, Continuous (fun x ↦ g x i)) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) : Integrable (massDensityDeriv u g f r) ∧ HasDerivAt (mass u g f) (∫ x, massDensityDeriv u g f r x) r := by apply Source29CompactParameterIntegral.hasDerivAt_integral (a := r/2) (b := 2*r) (K := supportBox n (R*(2*r)^2)) (by linarith) (by linarith) (supportBox_compact _ _) · intro t ht exact massDensity_continuous hu hg hf.continuous t · intro t ht exact massDensityDeriv_continuous hu hg hf t · intro p hp exact (massDensityDeriv_continuousAt hu hg hf p (by linarith [hp.1.1])).continuousWithinAt · intro t ht x hx unfold massDensity rw [scaled_cutoff_zero_outside_box u hR (by linarith [ht.1]) ht.2 hz x hx, zero_mul] · intro t ht x hx unfold massDensityDeriv rw [scaled_cutoff_zero_outside_box u hR (by linarith [ht.1]) ht.2 hdz x hx, mul_zero, zero_mul] · intro x t ht exact massDensity_hasDerivAt u g hf (by linarith [ht.1]) x end end Source29GraphMassDerivative /- Component: GraphScaledStationarity.inc -/ namespace Source29GraphScaledStationarity open MeasureTheory Filter open Source29QuarticReuse.FluxObstruction open Source29GraphRadialGeometry Source29GraphRadialSupport Source29GraphAreaConvexity open Source29GraphRadialCurrent Source29GraphMassDerivative open scoped Topology noncomputable section variable {n : ℕ} def defectDensity (u : (Fin n → ℝ) → ℝ) (g : (Fin n → ℝ) → Fin n → ℝ) (f : ℝ → ℝ) (r : ℝ) (x : Fin n → ℝ) : ℝ := deriv f (graphRadiusSq u x / r^2) * defect u g x ^ 2 / areaDensity (g x) theorem defectDensity_integrable {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hdz : ∀ t, R ≤ t → deriv f t = 0) : Integrable (defectDensity u g f r) := by have hc : Continuous (defectDensity u g f r) := ((hf.continuous_deriv_one.comp ((graphRadiusSq_contDiff hu).continuous.div_const _)).mul ((defect_contDiff hu hg).continuous.pow 2)).div (areaDensity_continuous g (fun i ↦ (hg i).continuous)) (fun x ↦ (areaDensity_pos _).ne') apply hc.integrable_of_hasCompactSupport apply HasCompactSupport.of_support_subset_isCompact (supportBox_compact n (R*r^2)) intro x hx by_contra hn apply hx unfold defectDensity rw [scaled_cutoff_zero_outside_box u hR hr le_rfl hdz x hn, zero_mul, zero_div] theorem scaled_profile_deriv {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (r s : ℝ) : deriv (fun t ↦ f (t/r^2)) s = deriv f (s/r^2) / r^2 := by have hd := ((hf.differentiable (by norm_num) (s/r^2)).hasDerivAt).comp s ((hasDerivAt_id s).div_const (r^2)) simpa only [Function.comp_def, one_div, mul_one, div_eq_mul_inv, id_eq, one_mul] using hd.deriv /-- Radial stationarity in the form needed to differentiate the normalized mass. The defect integral is nonpositive for a decreasing radial cutoff. -/ theorem mass_stationarity {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (hsym : ∀ x i j, fderiv ℝ (fun y ↦ g y j) x (Pi.single i 1) = fderiv ℝ (fun y ↦ g y i) x (Pi.single j 1)) (hdiv : ∀ x, divergence (fun i ↦ Pi.single i 1) (normalizedField g) x = 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) : (n : ℝ) * mass u g f r = r * (∫ x, massDensityDeriv u g f r x) + (2/r^2) * (∫ x, defectDensity u g f r x) := by have hfs : ContDiff ℝ 1 (fun t : ℝ ↦ f (t/r^2)) := hf.comp (contDiff_id.div_const _) have he := radial_first_variation hu hg hdu hsym hdiv hfs (scaled_cutoff_compact u hR hr hz) have hi := (mass_hasDerivAt hu (fun i ↦ (hg i).continuous) hf hR hr hz hdz).1 have hj := defectDensity_integrable hu hg hf hR hr hdz have hl : (∫ x, f (graphRadiusSq u x / r^2) * ((n : ℝ) * areaDensity (g x))) = (n : ℝ) * mass u g f r := by calc _ = ∫ x, (n : ℝ) * massDensity u g f r x := by apply integral_congr_ae exact Filter.Eventually.of_forall fun x ↦ by unfold massDensity; ring _ = _ := integral_const_mul _ _ have hp x : 2 * deriv (fun t ↦ f (t/r^2)) (graphRadiusSq u x) * (graphRadiusSq u x * areaDensity (g x) - defect u g x ^ 2 / areaDensity (g x)) = (-r) * massDensityDeriv u g f r x - (2/r^2) * defectDensity u g f r x := by rw [scaled_profile_deriv hf] unfold massDensityDeriv defectDensity have hnr := hr.ne' have hnw := (areaDensity_pos (g x)).ne' field_simp <;> ring have hri : (∫ x, 2 * deriv (fun t ↦ f (t/r^2)) (graphRadiusSq u x) * (graphRadiusSq u x * areaDensity (g x) - defect u g x ^ 2 / areaDensity (g x))) = (-r) * (∫ x, massDensityDeriv u g f r x) - (2/r^2) * (∫ x, defectDensity u g f r x) := by simp_rw [hp] calc _ = (∫ x, (-r) * massDensityDeriv u g f r x) - (∫ x, (2/r^2) * defectDensity u g f r x) := integral_sub (hi.const_mul (-r)) (hj.const_mul (2/r^2)) _ = _ := by rw [integral_const_mul, integral_const_mul] change (∫ x, f (graphRadiusSq u x / r^2) * ((n : ℝ) * areaDensity (g x))) = -(∫ x, 2 * deriv (fun t ↦ f (t/r^2)) (graphRadiusSq u x) * (graphRadiusSq u x * areaDensity (g x) - defect u g x ^ 2 / areaDensity (g x))) at he rw [hl, hri] at he linarith end end Source29GraphScaledStationarity /- Component: GraphMassMonotonicity.inc -/ namespace Source29GraphMassMonotonicity open MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction open Source29GraphRadialGeometry Source29GraphRadialCurrent Source29GraphMassDerivative open Source29GraphScaledStationarity Source29GraphAreaConvexity open scoped Topology noncomputable section variable {n : ℕ} def normalizedMass (u : (Fin n → ℝ) → ℝ) (g : (Fin n → ℝ) → Fin n → ℝ) (f : ℝ → ℝ) (r : ℝ) : ℝ := mass u g f r / r^n theorem normalized_hasDerivAt {I : ℝ → ℝ} {I' r : ℝ} (hI : HasDerivAt I I' r) (hr : r ≠ 0) (n : ℕ) : HasDerivAt (fun t ↦ I t / t^n) ((r*I' - (n : ℝ)*I r)/r^(n+1)) r := by have hd := hI.div ((hasDerivAt_id r).pow n) (pow_ne_zero n hr) convert hd using 1 · funext t rfl · cases n with | zero => simp [id_eq, hr] | succ m => simp only [Pi.pow_apply, id_eq, Nat.succ_eq_add_one, Nat.add_sub_cancel, mul_one] simp only [pow_succ] have hp : r^m ≠ 0 := pow_ne_zero m hr field_simp <;> ring /-- Exact derivative of smoothed normalized graph area. -/ theorem normalizedMass_hasDerivAt {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (hsym : ∀ x i j, fderiv ℝ (fun y ↦ g y j) x (Pi.single i 1) = fderiv ℝ (fun y ↦ g y i) x (Pi.single j 1)) (hdiv : ∀ x, divergence (fun i ↦ Pi.single i 1) (normalizedField g) x = 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) : HasDerivAt (normalizedMass u g f) ((-2/r^(n+3)) * (∫ x, defectDensity u g f r x)) r := by have hd := normalized_hasDerivAt (mass_hasDerivAt hu (fun i ↦ (hg i).continuous) hf hR hr hz hdz).2 hr.ne' n have hs := mass_stationarity hu hg hdu hsym hdiv hf hR hr hz hdz convert hd using 1 · rfl · rw [hs] have hn := hr.ne' have hp := pow_ne_zero n hn simp only [pow_add, pow_one] field_simp <;> ring /-- Smoothed normalized graph area is nondecreasing in the positive radius. -/ theorem normalizedMass_monotoneOn {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (hsym : ∀ x i j, fderiv ℝ (fun y ↦ g y j) x (Pi.single i 1) = fderiv ℝ (fun y ↦ g y i) x (Pi.single j 1)) (hdiv : ∀ x, divergence (fun i ↦ Pi.single i 1) (normalizedField g) x = 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) (hdec : ∀ t, deriv f t ≤ 0) : MonotoneOn (normalizedMass u g f) (Ioi 0) := by have hd (r : ℝ) (hr : 0 < r) := normalizedMass_hasDerivAt hu hg hdu hsym hdiv hf hR hr hz hdz apply monotoneOn_of_deriv_nonneg (convex_Ioi (0 : ℝ)) · intro r hr exact (hd r hr).continuousAt.continuousWithinAt · intro r hr exact (hd r (by simpa only [interior_Ioi, mem_Ioi] using hr)).differentiableAt.differentiableWithinAt · intro r hr have hr' : 0 < r := by simpa only [interior_Ioi, mem_Ioi] using hr rw [(hd r hr').deriv] have hj : (∫ x, defectDensity u g f r x) ≤ 0 := by apply integral_nonpos intro x exact div_nonpos_of_nonpos_of_nonneg (mul_nonpos_of_nonpos_of_nonneg (hdec _) (sq_nonneg _)) (areaDensity_pos _).le exact mul_nonneg_of_nonpos_of_nonpos (div_nonpos_of_nonpos_of_nonneg (by norm_num) (pow_pos hr' _).le) hj end end Source29GraphMassMonotonicity /- Component: PolynomialGraphMonotonicity.inc -/ namespace Source29PolynomialGraphMonotonicity open MvPolynomial MeasureTheory Set open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29QuarticReuse.QuarticPolynomialBasics open Source29GraphMassMonotonicity noncomputable section variable {n : ℕ} def radialCutoff (s : ℝ) : ℝ := 1 - Real.smoothTransition s theorem radialCutoff_contDiff : ContDiff ℝ 1 radialCutoff := contDiff_const.sub Real.smoothTransition.contDiff theorem radialCutoff_deriv (s : ℝ) : deriv radialCutoff s = -deriv Real.smoothTransition s := by exact (((Real.smoothTransition.contDiff (n := 1)).differentiable (by norm_num) s).hasDerivAt.const_sub 1).deriv theorem radialCutoff_bounds (s : ℝ) : 0 ≤ radialCutoff s ∧ radialCutoff s ≤ 1 := by have hl := Real.smoothTransition.nonneg s have hu := Real.smoothTransition.le_one s unfold radialCutoff constructor <;> linarith theorem radialCutoff_deriv_nonpos (s : ℝ) : deriv radialCutoff s ≤ 0 := by rw [radialCutoff_deriv] exact neg_nonpos.mpr Real.smoothTransition.monotone.deriv_nonneg theorem radialCutoff_zero (s : ℝ) (hs : 2 ≤ s) : radialCutoff s = 0 := by unfold radialCutoff rw [Real.smoothTransition.one_of_one_le (by linarith), sub_self] theorem radialCutoff_deriv_zero (s : ℝ) (hs : 2 ≤ s) : deriv radialCutoff s = 0 := by rw [radialCutoff_deriv, Source29GraphHeightProfile.profile_deriv_zero_right (by linarith), neg_zero] theorem polynomial_gradient_fderiv (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) (i : Fin n) : fderiv ℝ (fun y ↦ eval y P) x (Pi.single i 1) = evaluatedGradient P x i := by rw [fderiv_eval, evalFDeriv_basis] rfl theorem polynomial_gradient_symmetric (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) (i j : Fin n) : fderiv ℝ (fun y ↦ evaluatedGradient P y j) x (Pi.single i 1) = fderiv ℝ (fun y ↦ evaluatedGradient P y i) x (Pi.single j 1) := by change fderiv ℝ (fun y ↦ eval y (pderiv j P)) x (Pi.single i 1) = fderiv ℝ (fun y ↦ eval y (pderiv i P)) x (Pi.single j 1) rw [fderiv_eval, fderiv_eval, evalFDeriv_basis, evalFDeriv_basis, second_partial_comm] /-- Smoothed area monotonicity for every full polynomial minimal graph. -/ theorem polynomial_normalizedMass_monotoneOn (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) (hdec : ∀ t, deriv f t ≤ 0) : MonotoneOn (normalizedMass (fun x ↦ eval x P) (evaluatedGradient P) f) (Ioi 0) := normalizedMass_monotoneOn (contDiff_eval P) (fun i ↦ contDiff_eval (pderiv i P)) (polynomial_gradient_fderiv P) (polynomial_gradient_symmetric P) (Source29GraphCalibration.polynomial_normalizedGradient_divergence_zero P hmin) hf hR hz hdz hdec theorem polynomial_radialMass_monotoneOn (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) : MonotoneOn (normalizedMass (fun x ↦ eval x P) (evaluatedGradient P) radialCutoff) (Ioi 0) := polynomial_normalizedMass_monotoneOn P hmin radialCutoff_contDiff (R := 2) (by norm_num) radialCutoff_zero radialCutoff_deriv_zero radialCutoff_deriv_nonpos end end Source29PolynomialGraphMonotonicity /- Component: GraphMassRigidity.inc -/ namespace Source29GraphMassRigidity open MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction open Source29GraphRadialGeometry Source29GraphRadialCurrent Source29GraphRadialSupport open Source29GraphMassMonotonicity Source29GraphScaledStationarity Source29GraphAreaConvexity open Source29PolynomialGraphMonotonicity open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem radialCutoff_deriv_half : deriv radialCutoff (1/2) = -2 := by let A := expNegInvGlue (1/2) have hA : 0 < A := expNegInvGlue.pos_of_pos (by norm_num) have ha : HasDerivAt expNegInvGlue (4*A) (1/2) := by convert expNegInvGlue_hasDerivAt (1/2) using 1 <;> norm_num [A] have hb : HasDerivAt (fun t : ℝ ↦ expNegInvGlue (1-t)) (-4*A) (1/2) := by have h := (expNegInvGlue_hasDerivAt (1-(1/2))).comp (1/2) ((hasDerivAt_id (1/2)).const_sub 1) convert h using 1 · rfl · norm_num [A] have hden : expNegInvGlue (1/2) + expNegInvGlue (1-(1/2)) ≠ 0 := (Real.smoothTransition.pos_denom _).ne' have hd := (ha.fun_div (ha.add hb) hden).deriv change deriv Real.smoothTransition (1/2) = _ at hd rw [radialCutoff_deriv, hd] norm_num [show (1 : ℝ) - 1/2 = 1/2 by norm_num] change 4*A*(A+A)/(A+A)^2 = 2 have hdenA : A+A ≠ 0 := (add_pos hA hA).ne' field_simp <;> ring theorem defectDensity_continuous {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (r : ℝ) : Continuous (defectDensity u g f r) := ((hf.continuous_deriv_one.comp ((graphRadiusSq_contDiff hu).continuous.div_const _)).mul ((defect_contDiff hu hg).continuous.pow 2)).div (areaDensity_continuous g (fun i ↦ (hg i).continuous)) (fun x ↦ (areaDensity_pos _).ne') theorem radius_pos_of_defect_ne_zero (u : (Fin n → ℝ) → ℝ) (g : (Fin n → ℝ) → Fin n → ℝ) (x : Fin n → ℝ) (hne : defect u g x ≠ 0) : 0 < graphRadiusSq u x := by by_contra hn have hsum : 0 ≤ ∑ i, x i ^ 2 := Finset.sum_nonneg fun i _ ↦ sq_nonneg _ have hzero : graphRadiusSq u x ≤ 0 := le_of_not_gt hn unfold graphRadiusSq at hzero have hu : u x = 0 := by nlinarith [sq_nonneg (u x)] have hx (i : Fin n) : x i = 0 := by have hi : x i ^ 2 ≤ ∑ j, x j ^ 2 := Finset.single_le_sum (fun j _ ↦ sq_nonneg _) (Finset.mem_univ i) nlinarith [sq_nonneg (x i)] apply hne simp only [defect, hu, hx, zero_mul, Finset.sum_const_zero, sub_self] /-- Constancy of the explicit smoothed normalized area forces the radial normal defect to vanish everywhere. -/ theorem defect_zero_of_normalizedMass_constant {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (hsym : ∀ x i j, fderiv ℝ (fun y ↦ g y j) x (Pi.single i 1) = fderiv ℝ (fun y ↦ g y i) x (Pi.single j 1)) (hdiv : ∀ x, divergence (fun i ↦ Pi.single i 1) (normalizedField g) x = 0) {C : ℝ} (hc : ∀ r, 0 < r → normalizedMass u g radialCutoff r = C) : ∀ x, defect u g x = 0 := by intro x by_contra hne have hs := radius_pos_of_defect_ne_zero u g x hne let r := Real.sqrt (2*graphRadiusSq u x) have hr : 0 < r := Real.sqrt_pos.mpr (by positivity) have hr2 : r^2 = 2*graphRadiusSq u x := Real.sq_sqrt (by positivity) have harg : graphRadiusSq u x / r^2 = 1/2 := by rw [hr2]; field_simp have hd := normalizedMass_hasDerivAt hu hg hdu hsym hdiv radialCutoff_contDiff (R := 2) (by norm_num) hr radialCutoff_zero radialCutoff_deriv_zero have he : normalizedMass u g radialCutoff =ᶠ[𝓝 r] fun _ ↦ C := by filter_upwards [lt_mem_nhds hr] with t ht exact hc t ht have hzder : deriv (normalizedMass u g radialCutoff) r = 0 := by rw [he.deriv_eq, deriv_const] rw [hd.deriv] at hzder have hcoef : (-2 : ℝ)/r^(n+3) ≠ 0 := div_ne_zero (by norm_num) (pow_ne_zero _ hr.ne') have hjzero : (∫ y, defectDensity u g radialCutoff r y) = 0 := (mul_eq_zero.mp hzder).resolve_left hcoef have hj := defectDensity_integrable hu hg radialCutoff_contDiff (R := 2) (by norm_num) hr radialCutoff_deriv_zero have hneg : 0 < ∫ y, -defectDensity u g radialCutoff r y := by apply integral_pos_of_integrable_nonneg_nonzero (x := x) (defectDensity_continuous hu hg radialCutoff_contDiff r).neg hj.neg · intro y apply neg_nonneg.mpr exact div_nonpos_of_nonpos_of_nonneg (mul_nonpos_of_nonpos_of_nonneg (radialCutoff_deriv_nonpos _) (sq_nonneg _)) (areaDensity_pos _).le · apply ne_of_gt change 0 < -(defectDensity u g radialCutoff r x) unfold defectDensity rw [harg, radialCutoff_deriv_half] have hsq : 0 < defect u g x ^ 2 := sq_pos_of_ne_zero hne have hw := areaDensity_pos (g x) exact neg_pos.mpr (div_neg_of_neg_of_pos (by nlinarith) hw) rw [integral_neg, hjzero, neg_zero] at hneg exact lt_irrefl _ hneg end end Source29GraphMassRigidity /- Component: PolynomialEulerRigidity.inc -/ namespace Source29PolynomialEulerRigidity open MvPolynomial open Source29QuarticReuse.FluxObstruction Source29GraphRadialCurrent open scoped BigOperators noncomputable section variable {n : ℕ} theorem coeff_X_pderiv (P : MvPolynomial (Fin n) ℝ) (i : Fin n) (m : Fin n →₀ ℕ) : (X i * pderiv i P).coeff m = (m i : ℝ) * P.coeff m := by classical induction P using MvPolynomial.induction_on' with | add P Q hP hQ => simp only [map_add, mul_add, AddMonoidAlgebra.coeff_add, Finsupp.add_apply, hP, hQ] | monomial d a => rw [X_mul_pderiv_monomial, AddMonoidAlgebra.coeff_smul_apply] simp only [nsmul_eq_mul, coeff_monomial] by_cases hm : d = m · subst d simp · simp [hm] theorem degree_le_one_of_euler_identity (P : MvPolynomial (Fin n) ℝ) (hP : P = ∑ i, X i * pderiv i P) : P.totalDegree ≤ 1 := by classical apply Finset.sup_le intro m hm have hn : P.coeff m ≠ 0 := mem_support_iff.mp hm have he := congrArg (fun Q : MvPolynomial (Fin n) ℝ ↦ Q.coeff m) hP simp only [coeff_sum, coeff_X_pderiv, ← Finset.sum_mul, ← Nat.cast_sum] at he have hs : (∑ i, m i : ℝ) = 1 := by apply (mul_right_cancel₀ hn) simpa only [one_mul, Nat.cast_sum] using he.symm have hnat : ∑ i, m i = 1 := by exact_mod_cast hs change (m.sum fun _ e ↦ e) ≤ 1 rw [Finsupp.sum_fintype _ _ (by simp)] exact hnat.le theorem degree_le_one_of_defect_zero (P : MvPolynomial (Fin n) ℝ) (hz : ∀ x, defect (fun y ↦ eval y P) (evaluatedGradient P) x = 0) : P.totalDegree ≤ 1 := by apply degree_le_one_of_euler_identity apply Source29QuarticReuse.QuarticCompatibility.polynomial_funext intro x have he := hz x unfold defect evaluatedGradient at he simpa only [map_sum, map_mul, eval_X] using sub_eq_zero.mp he end end Source29PolynomialEulerRigidity /- Component: PolynomialRadialRigidity.inc -/ namespace Source29PolynomialRadialRigidity open MvPolynomial MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29PolynomialGraphMonotonicity Source29GraphMassMonotonicity open scoped Topology noncomputable section variable {n : ℕ} theorem affine_of_constant_normalizedMass (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) {C : ℝ} (hc : ∀ r, 0 < r → normalizedMass (fun x ↦ eval x P) (evaluatedGradient P) radialCutoff r = C) : Math30.MinimalGraphs.IsAffine P := by apply Source29PolynomialEulerRigidity.degree_le_one_of_defect_zero exact Source29GraphMassRigidity.defect_zero_of_normalizedMass_constant (contDiff_eval P) (fun i ↦ contDiff_eval (pderiv i P)) (polynomial_gradient_fderiv P) (polynomial_gradient_symmetric P) (Source29GraphCalibration.polynomial_normalizedGradient_divergence_zero P hmin) hc theorem constant_of_monotone_equal_limits {f : ℝ → ℝ} {C : ℝ} (hm : MonotoneOn f (Ioi 0)) (hz : Tendsto f (𝓝[>] 0) (𝓝 C)) (hi : Tendsto f atTop (𝓝 C)) : ∀ r, 0 < r → f r = C := by intro r hr apply le_antisymm · apply ge_of_tendsto hi filter_upwards [eventually_ge_atTop r] with t ht exact hm hr (hr.trans_le ht) ht · apply le_of_tendsto hz filter_upwards [self_mem_nhdsWithin, mem_nhdsWithin_of_mem_nhds (gt_mem_nhds hr)] with t ht htr exact hm ht hr htr.le /-- Matching finite density limits at the origin and infinity force an actual polynomial minimal graph to be affine. Establishing those limits in the linear-leading-factor case remains a separate obligation. -/ theorem affine_of_equal_radial_limits (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) {C : ℝ} (hz : Tendsto (normalizedMass (fun x ↦ eval x P) (evaluatedGradient P) radialCutoff) (𝓝[>] 0) (𝓝 C)) (hi : Tendsto (normalizedMass (fun x ↦ eval x P) (evaluatedGradient P) radialCutoff) atTop (𝓝 C)) : Math30.MinimalGraphs.IsAffine P := by exact affine_of_constant_normalizedMass P hmin (constant_of_monotone_equal_limits (polynomial_radialMass_monotoneOn P hmin) hz hi) end end Source29PolynomialRadialRigidity /- Component: GraphMassDilation.inc -/ namespace Source29GraphMassDilation open MvPolynomial MeasureTheory open Source29QuarticReuse.FluxObstruction open Source29GraphDilationFields Source29GraphRadialGeometry Source29GraphAreaConvexity open Source29GraphMassDerivative Source29GraphMassMonotonicity open scoped BigOperators noncomputable section variable {n : ℕ} theorem graphRadiusSq_dilate (P : MvPolynomial (Fin n) ℝ) {r : ℝ} (hr : r ≠ 0) (x : Fin n → ℝ) : graphRadiusSq (fun y ↦ eval y P) (r • x) / r^2 = graphRadiusSq (height P r) x := by simp only [graphRadiusSq, height, Pi.smul_apply, smul_eq_mul, mul_pow, ← Finset.mul_sum] field_simp theorem massDensity_dilate (P : MvPolynomial (Fin n) ℝ) (f : ℝ → ℝ) {r : ℝ} (hr : r ≠ 0) (x : Fin n → ℝ) : massDensity (fun y ↦ eval y P) (evaluatedGradient P) f r (r • x) = f (graphRadiusSq (height P r) x) * areaDensity (gradient P r x) := by unfold massDensity rw [graphRadiusSq_dilate P hr] rfl /-- Normalized graph mass equals the unnormalized weighted mass of the geometrically rescaled graph. -/ theorem normalizedMass_eq_rescaled (P : MvPolynomial (Fin n) ℝ) (f : ℝ → ℝ) {r : ℝ} (hr : 0 < r) : normalizedMass (fun y ↦ eval y P) (evaluatedGradient P) f r = ∫ x, f (graphRadiusSq (height P r) x) * areaDensity (gradient P r x) := by have he := Measure.integral_comp_smul_of_nonneg volume (massDensity (fun y ↦ eval y P) (evaluatedGradient P) f r) r (hR := hr.le) simp_rw [massDensity_dilate P f hr.ne'] at he simpa [normalizedMass, mass, Module.finrank_pi, smul_eq_mul, div_eq_mul_inv, mul_comm] using he.symm end end Source29GraphMassDilation /- Component: GraphTangentLimit.inc -/ namespace Source29GraphTangentLimit open MvPolynomial Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29QuarticReuse.QuarticPolynomialBasics Source29GraphDilationFields open Source29GraphRadialGeometry Source29GraphAreaConvexity open scoped Topology BigOperators noncomputable section variable {n : ℕ} def tangentHeight (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) : ℝ := evalFDeriv P 0 x theorem height_tendsto_tangent (P : MvPolynomial (Fin n) ℝ) (hP : eval 0 P = 0) (x : Fin n → ℝ) : Tendsto (fun r ↦ height P r x) (𝓝[>] 0) (𝓝 (tangentHeight P x)) := by have hc : HasDerivAt (fun t : ℝ ↦ t • x) x 0 := by simpa only [one_smul, id_eq] using (hasDerivAt_id (0 : ℝ)).smul_const x have hd := (hasFDerivAt_eval P ((0 : ℝ) • x)).comp_hasDerivAt (0 : ℝ) hc have ht := hd.tendsto_slope_zero_right simpa only [Function.comp_def, zero_add, zero_smul, hP, sub_zero, smul_eq_mul, height, tangentHeight, div_eq_mul_inv, mul_comm] using ht theorem gradient_tendsto (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) (i : Fin n) : Tendsto (fun r ↦ gradient P r x i) (𝓝[>] 0) (𝓝 (evaluatedGradient P 0 i)) := by have ht : Tendsto (fun r : ℝ ↦ r • x) (𝓝[>] 0) (𝓝 0) := by have hc : Continuous (fun r : ℝ ↦ r • x) := continuous_id.smul continuous_const simpa only [zero_smul] using (hc.continuousAt (x := 0)).tendsto.mono_left (show 𝓝[>] (0 : ℝ) ≤ 𝓝 0 from nhdsWithin_le_nhds) exact (contDiff_eval (pderiv i P)).continuous.continuousAt.tendsto.comp ht theorem density_tendsto (P : MvPolynomial (Fin n) ℝ) (hP : eval 0 P = 0) {f : ℝ → ℝ} (hf : Continuous f) (x : Fin n → ℝ) : Tendsto (fun r ↦ f (graphRadiusSq (height P r) x) * areaDensity (gradient P r x)) (𝓝[>] 0) (𝓝 (f (graphRadiusSq (tangentHeight P) x) * areaDensity (evaluatedGradient P 0))) := by have hh := height_tendsto_tangent P hP x have hs : Tendsto (fun r ↦ graphRadiusSq (height P r) x) (𝓝[>] 0) (𝓝 (graphRadiusSq (tangentHeight P) x)) := tendsto_const_nhds.add (hh.pow 2) have hw : Tendsto (fun r ↦ areaDensity (gradient P r x)) (𝓝[>] 0) (𝓝 (areaDensity (evaluatedGradient P 0))) := by apply Tendsto.sqrt exact tendsto_const_nhds.add (tendsto_finsetSum _ (fun i _ ↦ (gradient_tendsto P x i).pow 2)) exact (hf.continuousAt.tendsto.comp hs).mul hw end end Source29GraphTangentLimit /- Component: GraphSmallDensity.inc -/ namespace Source29GraphSmallDensity open MvPolynomial MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29GraphDilationFields Source29GraphRadialGeometry Source29GraphRadialSupport open Source29GraphAreaConvexity Source29GraphTangentLimit Source29GraphMassMonotonicity open scoped Topology noncomputable section variable {n : ℕ} theorem rescaled_weight_continuous (P : MvPolynomial (Fin n) ℝ) : Continuous (fun p : ℝ × (Fin n → ℝ) ↦ areaDensity (gradient P p.1 p.2)) := by apply areaDensity_continuous intro i exact (contDiff_eval (pderiv i P)).continuous.comp (continuous_fst.smul continuous_snd) theorem cutoff_zero_outside_box (u : (Fin n → ℝ) → ℝ) {f : ℝ → ℝ} {R : ℝ} (hR : 0 ≤ R) (hz : ∀ t, R ≤ t → f t = 0) (x : Fin n → ℝ) (hx : x ∉ supportBox n R) : f (graphRadiusSq u x) = 0 := by apply hz exact (lt_of_not_ge fun hle ↦ hx (mem_supportBox_of_radius_le u x hR hle)).le /-- Dominated convergence on a fixed compact base box gives the actual small-radius graph density as the tangent-plane integral. -/ theorem small_radius_limit (P : MvPolynomial (Fin n) ℝ) (hP : eval 0 P = 0) {f : ℝ → ℝ} (hf : Continuous f) (hb : ∀ t, ‖f t‖ ≤ 1) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ t, R ≤ t → f t = 0) : Tendsto (normalizedMass (fun y ↦ eval y P) (evaluatedGradient P) f) (𝓝[>] 0) (𝓝 (∫ x, f (graphRadiusSq (tangentHeight P) x) * areaDensity (evaluatedGradient P 0))) := by classical let K := supportBox n R have hK : IsCompact K := supportBox_compact n R obtain ⟨M, hM⟩ := ((isCompact_Icc : IsCompact (Icc (0 : ℝ) 1)).prod hK).exists_bound_of_continuousOn (rescaled_weight_continuous P).continuousOn have hc (r : ℝ) : Continuous (fun x ↦ f (graphRadiusSq (height P r) x) * areaDensity (gradient P r x)) := (hf.comp (graphRadiusSq_contDiff (height_contDiff P r)).continuous).mul (areaDensity_continuous _ (fun i ↦ (gradient_contDiff P r i).continuous)) have ht : Tendsto (fun r ↦ ∫ x, f (graphRadiusSq (height P r) x) * areaDensity (gradient P r x)) (𝓝[>] 0) (𝓝 (∫ x, f (graphRadiusSq (tangentHeight P) x) * areaDensity (evaluatedGradient P 0))) := by apply tendsto_integral_filter_of_dominated_convergence (K.indicator (fun _ ↦ M)) · exact Filter.Eventually.of_forall fun r ↦ (hc r).aestronglyMeasurable · filter_upwards [self_mem_nhdsWithin, mem_nhdsWithin_of_mem_nhds (gt_mem_nhds (show (0 : ℝ) < 1 by norm_num))] with r hr hr1 apply Filter.Eventually.of_forall intro x by_cases hx : x ∈ K · rw [Set.indicator_of_mem hx, norm_mul] exact (mul_le_mul_of_nonneg_right (hb _) (norm_nonneg _)).trans (by simpa only [one_mul] using hM (r,x) ⟨⟨hr.le,hr1.le⟩,hx⟩) · rw [Set.indicator_of_notMem hx, cutoff_zero_outside_box (height P r) hR hz x hx, zero_mul, norm_zero] · exact (integrable_indicator_iff hK.measurableSet).2 (integrableOn_const hK.measure_lt_top.ne) · exact Filter.Eventually.of_forall (density_tendsto P hP hf) apply ht.congr' filter_upwards [self_mem_nhdsWithin] with r hr exact (Source29GraphMassDilation.normalizedMass_eq_rescaled P f hr).symm end end Source29GraphSmallDensity /- Component: PlaneFlattening.inc -/ namespace Source29PlaneFlattening open Matrix open Source29GraphAreaConvexity open scoped BigOperators noncomputable section variable {n : ℕ} def flattening (a : Fin n → ℝ) : Matrix (Fin n) (Fin n) ℝ := 1 + vecMulVec (fun i ↦ a i / (areaDensity a + 1)) a theorem flattening_apply (a x : Fin n → ℝ) (i : Fin n) : (flattening a *ᵥ x) i = x i + (a ⬝ᵥ x) * (a i / (areaDensity a + 1)) := by simp only [flattening, add_mulVec, one_mulVec, vecMulVec_mulVec, Pi.add_apply, Pi.smul_apply] change x i + (a i / (areaDensity a + 1)) * (a ⬝ᵥ x) = _ rw [mul_comm (a i / (areaDensity a + 1))] theorem flattening_det (a : Fin n → ℝ) : (flattening a).det = areaDensity a := by rw [flattening, vecMulVec_eq Unit, det_one_add_replicateCol_mul_replicateRow] have he : (a ⬝ᵥ (fun i ↦ a i / (areaDensity a + 1))) = (∑ i, a i ^ 2) / (areaDensity a + 1) := by simp only [dotProduct, ← mul_div_assoc, ← pow_two, ← Finset.sum_div] rw [he] have hp := areaDensity_pos a have hs := areaDensity_sq a have hn : areaDensity a + 1 ≠ 0 := by linarith field_simp nlinarith theorem flattening_sqNorm (a x : Fin n → ℝ) : (∑ i, (flattening a *ᵥ x) i ^ 2) = (∑ i, x i ^ 2) + (a ⬝ᵥ x)^2 := by let c := (areaDensity a + 1)⁻¹ let b := a ⬝ᵥ x have hp := areaDensity_pos a have hs := areaDensity_sq a have hcoef : 2*c + c^2*(∑ i, a i ^ 2) = 1 := by dsimp [c] have hn : areaDensity a + 1 ≠ 0 := by linarith field_simp nlinarith have he i : (flattening a *ᵥ x) i ^ 2 = x i ^ 2 + (2*c*b)*(a i*x i) + (c^2*b^2)*(a i^2) := by rw [flattening_apply] dsimp [c,b] ring simp_rw [he] rw [Finset.sum_add_distrib, Finset.sum_add_distrib, ← Finset.mul_sum, ← Finset.mul_sum] change (∑ i, x i ^ 2) + (2*c*b)*b + (c^2*b^2)*(∑ i, a i^2) = (∑ i, x i ^ 2) + b^2 have hm := congrArg (fun t : ℝ ↦ t * b^2) hcoef nlinarith [hm] end end Source29PlaneFlattening /- Component: PlaneRadialIntegral.inc -/ namespace Source29PlaneRadialIntegral open Matrix MeasureTheory open Source29GraphAreaConvexity Source29PlaneFlattening open scoped BigOperators noncomputable section variable {n : ℕ} /-- The radial mass of a plane does not depend on its slope. -/ theorem tilted_integral (a : Fin n → ℝ) {f : ℝ → ℝ} (hf : Continuous f) : (∫ x : Fin n → ℝ, f ((∑ i, x i ^ 2) + (a ⬝ᵥ x)^2) * areaDensity a) = ∫ x : Fin n → ℝ, f (∑ i, x i ^ 2) := by let T := flattening a let G := fun x : Fin n → ℝ ↦ f (∑ i, x i ^ 2) have hG : Continuous G := hf.comp (continuous_finsetSum _ fun i _ ↦ (continuous_apply i).pow 2) have hT : Continuous (Matrix.toLin' T) := (Matrix.toLin' T).continuous_on_pi have hd : T.det = areaDensity a := flattening_det a have hp := areaDensity_pos a have hm := Real.map_matrix_volume_pi_eq_smul_volume_pi (M := T) (by rw [hd]; exact ne_of_gt hp) have hi := integral_map (μ := (volume : Measure (Fin n → ℝ))) hT.aemeasurable hG.aestronglyMeasurable rw [hm, integral_smul_measure, hd, abs_of_pos (inv_pos.mpr hp), ENNReal.toReal_ofReal (inv_nonneg.mpr hp.le), smul_eq_mul] at hi have he : (∫ x : Fin n → ℝ, f ((∑ i, x i ^ 2) + (a ⬝ᵥ x)^2)) = (areaDensity a)⁻¹ * ∫ x : Fin n → ℝ, f (∑ i, x i ^ 2) := by rw [hi] apply integral_congr_ae exact Filter.Eventually.of_forall fun x ↦ by change f ((∑ i, x i ^ 2) + (a ⬝ᵥ x)^2) = f (∑ i, (flattening a *ᵥ x) i ^ 2) rw [flattening_sqNorm] rw [integral_mul_const, he] field_simp end end Source29PlaneRadialIntegral /- Component: PolynomialSmallDensity.inc -/ namespace Source29PolynomialSmallDensity open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.QuarticPolynomialBasics open Source29GraphTangentLimit Source29GraphRadialGeometry Source29GraphMassMonotonicity open Source29GraphAreaConvexity Source29PolynomialGraphMonotonicity open scoped Topology BigOperators noncomputable section variable {n : ℕ} def planeMass (n : ℕ) (f : ℝ → ℝ) : ℝ := ∫ x : Fin n → ℝ, f (∑ i, x i ^ 2) theorem tangentHeight_eq (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) : tangentHeight P x = evaluatedGradient P 0 ⬝ᵥ x := by rw [tangentHeight, evalFDeriv_apply] rfl theorem tangent_integral (P : MvPolynomial (Fin n) ℝ) {f : ℝ → ℝ} (hf : Continuous f) : (∫ x, f (graphRadiusSq (tangentHeight P) x) * areaDensity (evaluatedGradient P 0)) = planeMass n f := by simp_rw [graphRadiusSq, tangentHeight_eq] exact Source29PlaneRadialIntegral.tilted_integral _ hf /-- Every centered polynomial graph has the same small-radius density as a plane. -/ theorem small_radius_limit (P : MvPolynomial (Fin n) ℝ) (hP : eval 0 P = 0) {f : ℝ → ℝ} (hf : Continuous f) (hb : ∀ t, ‖f t‖ ≤ 1) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ t, R ≤ t → f t = 0) : Tendsto (normalizedMass (fun y ↦ eval y P) (evaluatedGradient P) f) (𝓝[>] 0) (𝓝 (planeMass n f)) := by have ht := Source29GraphSmallDensity.small_radius_limit P hP hf hb hR hz rwa [tangent_integral P hf] at ht theorem radial_small_radius_limit (P : MvPolynomial (Fin n) ℝ) (hP : eval 0 P = 0) : Tendsto (normalizedMass (fun y ↦ eval y P) (evaluatedGradient P) radialCutoff) (𝓝[>] 0) (𝓝 (planeMass n radialCutoff)) := by apply small_radius_limit P hP radialCutoff_contDiff.continuous _ (R := 2) (by norm_num) radialCutoff_zero intro t rw [Real.norm_eq_abs, abs_of_nonneg (radialCutoff_bounds t).1] exact (radialCutoff_bounds t).2 /-- Only the density at infinity remains to be supplied in this rigidity criterion. -/ theorem affine_of_radial_limit_atTop (P : MvPolynomial (Fin n) ℝ) (hP : eval 0 P = 0) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hi : Tendsto (normalizedMass (fun y ↦ eval y P) (evaluatedGradient P) radialCutoff) atTop (𝓝 (planeMass n radialCutoff))) : Math30.MinimalGraphs.IsAffine P := Source29PolynomialRadialRigidity.affine_of_equal_radial_limits P hmin (radial_small_radius_limit P hP) hi end end Source29PolynomialSmallDensity /- Component: PolynomialCentering.inc -/ namespace Source29PolynomialCentering open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction open Source29GraphMassMonotonicity Source29PolynomialGraphMonotonicity open Source29PolynomialSmallDensity open scoped Topology noncomputable section variable {n : ℕ} def centered (P : MvPolynomial (Fin n) ℝ) : MvPolynomial (Fin n) ℝ := P - C (eval 0 P) theorem centered_eval_zero (P : MvPolynomial (Fin n) ℝ) : eval 0 (centered P) = 0 := by simp [centered] theorem centered_gradient (P : MvPolynomial (Fin n) ℝ) : evaluatedGradient (centered P) = evaluatedGradient P := by funext x i simp [evaluatedGradient, centered] theorem centered_minimal_iff (P : MvPolynomial (Fin n) ℝ) : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation (centered P) ↔ Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P := by simp [Math30.MinimalGraphs.SatisfiesMinimalGraphEquation, Math30.MinimalGraphs.minimalGraphOperator, centered] theorem centered_affine_iff (P : MvPolynomial (Fin n) ℝ) : Math30.MinimalGraphs.IsAffine (centered P) ↔ Math30.MinimalGraphs.IsAffine P := by change (P - C (eval 0 P)).totalDegree ≤ 1 ↔ P.totalDegree ≤ 1 constructor · intro h have he : P = (P - C (eval 0 P)) + C (eval 0 P) := by ring calc P.totalDegree = ((P - C (eval 0 P)) + C (eval 0 P)).totalDegree := congrArg _ he _ ≤ max (P - C (eval 0 P)).totalDegree (C (eval 0 P) : MvPolynomial (Fin n) ℝ).totalDegree := totalDegree_add _ _ _ ≤ 1 := by simp only [totalDegree_C, max_le_iff]; exact ⟨h, by omega⟩ · exact fun h ↦ (totalDegree_sub_C_le P (eval 0 P)).trans h /-- Centering reduces rigidity for any polynomial solution to its radial mass limit at infinity. No limit at infinity is assumed to hold automatically. -/ theorem affine_of_centered_radial_limit (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hi : Tendsto (normalizedMass (fun y ↦ eval y (centered P)) (evaluatedGradient P) radialCutoff) atTop (𝓝 (planeMass n radialCutoff))) : Math30.MinimalGraphs.IsAffine P := by apply (centered_affine_iff P).mp apply affine_of_radial_limit_atTop (centered P) (centered_eval_zero P) ((centered_minimal_iff P).mpr hmin) rwa [centered_gradient] end end Source29PolynomialCentering /- Component: PolynomialSequentialRigidity.inc -/ namespace Source29PolynomialSequentialRigidity open MvPolynomial MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction open Source29GraphMassMonotonicity Source29PolynomialGraphMonotonicity open Source29PolynomialSmallDensity Source29PolynomialCentering open scoped Topology noncomputable section variable {n : ℕ} /-- For a monotone radial mass, convergence along any unbounded sequence suffices for the upper bound needed by rigidity. -/ theorem affine_of_radial_sequence_limit (P : MvPolynomial (Fin n) ℝ) (hP : eval 0 P = 0) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) {r : ℕ → ℝ} (hr : Tendsto r atTop atTop) (hi : Tendsto (fun k ↦ normalizedMass (fun y ↦ eval y P) (evaluatedGradient P) radialCutoff (r k)) atTop (𝓝 (planeMass n radialCutoff))) : Math30.MinimalGraphs.IsAffine P := by have hmono := polynomial_radialMass_monotoneOn P hmin have hz := radial_small_radius_limit P hP apply Source29PolynomialRadialRigidity.affine_of_constant_normalizedMass P hmin (C := planeMass n radialCutoff) intro s hs apply le_antisymm · apply ge_of_tendsto hi filter_upwards [hr.eventually (eventually_ge_atTop s)] with k hk exact hmono hs (hs.trans_le hk) hk · apply le_of_tendsto hz filter_upwards [self_mem_nhdsWithin, mem_nhdsWithin_of_mem_nhds (gt_mem_nhds hs)] with t ht hts exact hmono ht hs hts.le theorem affine_of_centered_radial_sequence_limit (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) {r : ℕ → ℝ} (hr : Tendsto r atTop atTop) (hi : Tendsto (fun k ↦ normalizedMass (fun y ↦ eval y (centered P)) (evaluatedGradient P) radialCutoff (r k)) atTop (𝓝 (planeMass n radialCutoff))) : Math30.MinimalGraphs.IsAffine P := by apply (centered_affine_iff P).mp apply affine_of_radial_sequence_limit (centered P) (centered_eval_zero P) ((centered_minimal_iff P).mpr hmin) hr simpa only [centered_gradient] using hi end end Source29PolynomialSequentialRigidity /- Component: AmbientGraphCalculus.inc -/ namespace Source29AmbientGraphCalculus open MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction Source29GraphAreaConvexity open scoped BigOperators Topology noncomputable section variable {n : ℕ} def verticalDerivative (H : (Fin n → ℝ) × ℝ → ℝ) (x : Fin n → ℝ) (z : ℝ) : ℝ := fderiv ℝ H (x,z) (0,1) def baseDerivative (H : (Fin n → ℝ) × ℝ → ℝ) (x : Fin n → ℝ) (z : ℝ) (i : Fin n) : ℝ := fderiv ℝ H (x,z) (Pi.single i 1,0) theorem graph_composition_fderiv {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} {H : (Fin n → ℝ) × ℝ → ℝ} (hu : ContDiff ℝ 1 u) (hH : ContDiff ℝ 1 H) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (x : Fin n → ℝ) (i : Fin n) : fderiv ℝ (fun y ↦ H (y,u y)) x (Pi.single i 1) = baseDerivative H x (u x) i + verticalDerivative H x (u x) * g x i := by have hc := (hasFDerivAt_id x).prodMk ((hu.differentiable (by norm_num) x).hasFDerivAt) have hd := ((hH.differentiable (by norm_num) (x,u x)).hasFDerivAt).comp x hc simp only [Function.comp_def, id_eq] at hd rw [hd.fderiv] change fderiv ℝ H (x,u x) (Pi.single i 1, fderiv ℝ u x (Pi.single i 1)) = _ rw [hdu] have he : (Pi.single i 1, g x i) = (Pi.single i 1, (0 : ℝ)) + g x i • ((0 : Fin n → ℝ), (1 : ℝ)) := by simp rw [he, map_add, map_smul] change baseDerivative H x (u x) i + g x i * verticalDerivative H x (u x) = _ ring theorem graph_composition_flux {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} {H : (Fin n → ℝ) × ℝ → ℝ} (hu : ContDiff ℝ 1 u) (hH : ContDiff ℝ 1 H) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (x : Fin n → ℝ) : testFlux (fun i ↦ Pi.single i 1) (fun y ↦ H (y,u y)) (normalizedField g) x = (∑ i, baseDerivative H x (u x) i * normalizedField g x i) + verticalDerivative H x (u x) * (areaDensity (g x) - 1 / areaDensity (g x)) := by simp only [testFlux, graph_composition_fderiv hu hH hdu, add_mul, Finset.sum_add_distrib] simp_rw [mul_assoc, ← Finset.mul_sum] rw [Source29GraphMassIdentity.gradient_pair_normalized] theorem fderiv_zero_outside_base {H : (Fin n → ℝ) × ℝ → ℝ} {K : Set (Fin n → ℝ)} (hK : IsClosed K) (hz : ∀ x, x ∉ K → ∀ z, H (x,z) = 0) {x : Fin n → ℝ} (hx : x ∉ K) (z : ℝ) : fderiv ℝ H (x,z) = 0 := by have he : H =ᶠ[𝓝 (x,z)] (fun _ ↦ (0 : ℝ)) := by have hn : {p : (Fin n → ℝ) × ℝ | p.1 ∉ K} ∈ 𝓝 (x,z) := (hK.isOpen_compl.preimage continuous_fst).mem_nhds hx filter_upwards [hn] with p hp exact hz p.1 hp p.2 rw [he.fderiv_eq] simp theorem graph_composition_compact {H : (Fin n → ℝ) × ℝ → ℝ} {K : Set (Fin n → ℝ)} (hK : IsCompact K) (hz : ∀ x, x ∉ K → ∀ z, H (x,z) = 0) (u : (Fin n → ℝ) → ℝ) : HasCompactSupport (fun x ↦ H (x,u x)) := by apply HasCompactSupport.of_support_subset_isCompact (K := K) hK intro x hx by_contra hnot exact hx (hz x hnot (u x)) theorem graph_derivative_compact {H : (Fin n → ℝ) × ℝ → ℝ} {K : Set (Fin n → ℝ)} (hK : IsCompact K) (hz : ∀ x, x ∉ K → ∀ z, H (x,z) = 0) (u : (Fin n → ℝ) → ℝ) (v : (Fin n → ℝ) × ℝ) : HasCompactSupport (fun x ↦ fderiv ℝ H (x,u x) v) := by apply HasCompactSupport.of_support_subset_isCompact (K := K) hK intro x hx by_contra hnot apply hx change fderiv ℝ H (x,u x) v = 0 rw [fderiv_zero_outside_base hK.isClosed hz hnot, zero_apply] end end Source29AmbientGraphCalculus /- Component: AmbientGraphMass.inc -/ namespace Source29AmbientGraphMass open MeasureTheory Set open Source29QuarticReuse.FluxObstruction Source29GraphAreaConvexity Source29AmbientGraphCalculus open scoped BigOperators noncomputable section variable {n : ℕ} def baseFlux (H : (Fin n → ℝ) × ℝ → ℝ) (u : (Fin n → ℝ) → ℝ) (g : (Fin n → ℝ) → Fin n → ℝ) (x : Fin n → ℝ) : ℝ := ∑ i, baseDerivative H x (u x) i * normalizedField g x i theorem graph_derivative_continuous {u : (Fin n → ℝ) → ℝ} {H : (Fin n → ℝ) × ℝ → ℝ} (hu : Continuous u) (hH : ContDiff ℝ 1 H) (v : (Fin n → ℝ) × ℝ) : Continuous (fun x ↦ fderiv ℝ H (x,u x) v) := ((hH.continuous_fderiv (by norm_num)).comp (continuous_id.prodMk hu)).clm_apply continuous_const theorem baseFlux_continuous {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} {H : (Fin n → ℝ) × ℝ → ℝ} (hu : Continuous u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hH : ContDiff ℝ 1 H) : Continuous (baseFlux H u g) := by apply continuous_finsetSum intro i hi exact (graph_derivative_continuous hu hH _).mul ((normalizedField_contDiff hg i).continuous) theorem baseFlux_compact {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} {H : (Fin n → ℝ) × ℝ → ℝ} {K : Set (Fin n → ℝ)} (hK : IsCompact K) (hz : ∀ x, x ∉ K → ∀ z, H (x,z) = 0) : HasCompactSupport (baseFlux H u g) := by apply HasCompactSupport.of_support_subset_isCompact (K := K) hK intro x hx by_contra hnot apply hx unfold baseFlux baseDerivative simp only [fderiv_zero_outside_base hK.isClosed hz hnot, zero_apply, zero_mul, Finset.sum_const_zero] /-- An arbitrary ambient height primitive gives an exact graph-area identity. Its base support is compact; no compactness in the height variable is needed. -/ theorem ambient_mass_identity {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} {H : (Fin n → ℝ) × ℝ → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (hdiv : ∀ x, divergence (fun i ↦ Pi.single i 1) (normalizedField g) x = 0) (hH : ContDiff ℝ 1 H) {K : Set (Fin n → ℝ)} (hK : IsCompact K) (hz : ∀ x, x ∉ K → ∀ z, H (x,z) = 0) : (∫ x, verticalDerivative H x (u x) * areaDensity (g x)) = (∫ x, verticalDerivative H x (u x) / areaDensity (g x)) - ∫ x, baseFlux H u g x := by have hw : Continuous (fun x ↦ areaDensity (g x)) := areaDensity_continuous g (fun i ↦ (hg i).continuous) have hv : Continuous (fun x ↦ verticalDerivative H x (u x)) := graph_derivative_continuous hu.continuous hH _ have hcv : HasCompactSupport (fun x ↦ verticalDerivative H x (u x)) := graph_derivative_compact hK hz u _ have hi : Integrable (fun x ↦ verticalDerivative H x (u x) * areaDensity (g x)) := (hv.mul hw).integrable_of_hasCompactSupport hcv.mul_right have he : Integrable (fun x ↦ verticalDerivative H x (u x) / areaDensity (g x)) := by apply (hv.div hw (fun x ↦ (areaDensity_pos (g x)).ne')).integrable_of_hasCompactSupport have hc : HasCompactSupport (fun x ↦ verticalDerivative H x (u x) * (areaDensity (g x))⁻¹) := hcv.mul_right change HasCompactSupport (fun x ↦ verticalDerivative H x (u x) / areaDensity (g x)) simpa only [div_eq_mul_inv] using hc have hb : Integrable (baseFlux H u g) := (baseFlux_continuous hu.continuous hg hH).integrable_of_hasCompactSupport (baseFlux_compact hK hz) have ht : ContDiff ℝ 1 (fun x ↦ H (x,u x)) := hH.comp (contDiff_id.prodMk hu) have hzero := integral_testFlux_eq_zero (μ := volume) (fun i ↦ Pi.single i 1) ht (graph_composition_compact hK hz u) (normalizedField_contDiff hg) hdiv have hid : (fun x ↦ testFlux (fun i ↦ Pi.single i 1) (fun y ↦ H (y,u y)) (normalizedField g) x) = (fun x ↦ baseFlux H u g x + (verticalDerivative H x (u x) * areaDensity (g x) - verticalDerivative H x (u x) / areaDensity (g x))) := by funext x rw [graph_composition_flux hu hH hdu] unfold baseFlux ring have ha := integral_add hb (hi.sub he) have hs := integral_sub hi he simp only [Pi.sub_apply] at ha hs rw [hid, ha, hs] at hzero linarith end end Source29AmbientGraphMass /- Component: GraphHeightFamilyLimits.inc -/ namespace Source29GraphHeightFamilyLimits open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29GraphDilationFields Source29GraphHeightLimits open scoped Topology noncomputable section variable {n : ℕ} /-- Height-profile convergence also holds for a different profile at each base point. -/ theorem height_family_tendsto_ae (P : MvPolynomial (Fin n) ℝ) (hdeg : 2 ≤ P.totalDegree) {h : (Fin n → ℝ) → ℝ → ℝ} {a b : (Fin n → ℝ) → ℝ} (hp : ∀ x, Tendsto (h x) atTop (𝓝 (a x))) (hm : ∀ x, Tendsto (h x) atBot (𝓝 (b x))) : ∀ᵐ x : Fin n → ℝ, Tendsto (fun k ↦ h x (height P (dilationRadius k) x)) atTop (𝓝 (if 0 < eval x (homogeneousComponent P.totalDegree P) then a x else b x)) := by have hne := Source29QuarticReuse.QuarticPolynomialBasics.top_homogeneousComponent_ne_zero P (by omega : 0 < P.totalDegree) filter_upwards [mvPolynomial_eval_ne_zero_ae n _ hne] with x hx by_cases hs : 0 < eval x (homogeneousComponent P.totalDegree P) · simp only [ite_eq_left hs] exact (hp x).comp (height_tendsto_atTop P hdeg x hs) · simp only [ite_eq_right hs] exact (hm x).comp (height_tendsto_atBot P hdeg x (lt_of_le_of_ne (le_of_not_gt hs) hx)) end end Source29GraphHeightFamilyLimits /- Component: AmbientGraphLimits.inc -/ namespace Source29AmbientGraphLimits open MvPolynomial MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29GraphDilationFields Source29GraphAreaConvexity Source29GraphMassLimits open Source29AmbientGraphCalculus Source29AmbientGraphMass Source29GraphHeightFamilyLimits open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem ambient_error_tendsto_zero (P : MvPolynomial (Fin n) ℝ) (hdeg : 2 ≤ P.totalDegree) {H : (Fin n → ℝ) × ℝ → ℝ} (hH : ContDiff ℝ 1 H) {K : Set (Fin n → ℝ)} (hK : IsCompact K) (hz : ∀ x, x ∉ K → ∀ z, H (x,z) = 0) {M : ℝ} (hb : ∀ x z, ‖verticalDerivative H x z‖ ≤ M) (hp : ∀ x, Tendsto (verticalDerivative H x) atTop (𝓝 0)) (hm : ∀ x, Tendsto (verticalDerivative H x) atBot (𝓝 0)) : Tendsto (fun k ↦ ∫ x, verticalDerivative H x (height P (dilationRadius k) x) / areaDensity (gradient P (dilationRadius k) x)) atTop (𝓝 0) := by have hl : ∀ᵐ x, Tendsto (fun k ↦ verticalDerivative H x (height P (dilationRadius k) x)) atTop (𝓝 0) := by simpa only [ite_self] using height_family_tendsto_ae P hdeg hp hm have ht : Tendsto (fun k ↦ ∫ x, verticalDerivative H x (height P (dilationRadius k) x) / areaDensity (gradient P (dilationRadius k) x)) atTop (𝓝 (∫ _x : Fin n → ℝ, (0 : ℝ))) := by apply tendsto_integral_of_dominated_convergence (K.indicator (fun _ ↦ M)) · intro k exact ((graph_derivative_continuous (height_contDiff P _).continuous hH _).div (areaDensity_continuous _ (fun i ↦ (gradient_contDiff P _ i).continuous)) (fun x ↦ (areaDensity_pos _).ne')).aestronglyMeasurable · exact (integrable_indicator_iff hK.measurableSet).2 (integrableOn_const hK.measure_lt_top.ne) · intro k apply Filter.Eventually.of_forall intro x by_cases hx : x ∈ K · rw [Set.indicator_of_mem hx] exact (norm_div_areaDensity_le _ _).trans (hb _ _) · rw [Set.indicator_of_notMem hx] simp only [verticalDerivative, fderiv_zero_outside_base hK.isClosed hz hx, zero_apply, zero_div, norm_zero, le_refl] · filter_upwards [hl] with x hx exact squeeze_zero_norm (fun k ↦ norm_div_areaDensity_le _ _) (by simpa only [norm_zero] using hx.norm) simpa only [integral_zero] using ht theorem ambient_flux_tendsto (P : MvPolynomial (Fin n) ℝ) (hdeg : 2 ≤ P.totalDegree) {H : (Fin n → ℝ) × ℝ → ℝ} (hH : ContDiff ℝ 1 H) {K : Set (Fin n → ℝ)} (hK : IsCompact K) (hz : ∀ x, x ∉ K → ∀ z, H (x,z) = 0) {M : ℝ} (hb : ∀ x z i, ‖baseDerivative H x z i‖ ≤ M) {a b : (Fin n → ℝ) → Fin n → ℝ} (hp : ∀ x i, Tendsto (fun z ↦ baseDerivative H x z i) atTop (𝓝 (a x i))) (hm : ∀ x i, Tendsto (fun z ↦ baseDerivative H x z i) atBot (𝓝 (b x i))) : Tendsto (fun k ↦ ∫ x, baseFlux H (height P (dilationRadius k)) (gradient P (dilationRadius k)) x) atTop (𝓝 (∫ x, ∑ i, (if 0 < eval x (homogeneousComponent P.totalDegree P) then a x i else b x i) * leadingNormalizedField (homogeneousComponent P.totalDegree P) x i)) := by have hl i := height_family_tendsto_ae P hdeg (fun x ↦ hp x i) (fun x ↦ hm x i) have hn := Source29TopWeakCalibration.normalizedGradient_dilates_tendsto_ae P hdeg apply tendsto_integral_of_dominated_convergence (K.indicator (fun _ ↦ (n : ℝ)*M)) · intro k exact (baseFlux_continuous (height_contDiff P _).continuous (gradient_contDiff P _) hH).aestronglyMeasurable · exact (integrable_indicator_iff hK.measurableSet).2 (integrableOn_const hK.measure_lt_top.ne) · intro k apply Filter.Eventually.of_forall intro x by_cases hx : x ∈ K · rw [Set.indicator_of_mem hx] unfold baseFlux calc ‖∑ i, baseDerivative H x (height P (dilationRadius k) x) i * normalizedField (gradient P (dilationRadius k)) x i‖ ≤ ∑ i, ‖baseDerivative H x (height P (dilationRadius k) x) i * normalizedField (gradient P (dilationRadius k)) x i‖ := norm_sum_le _ _ _ ≤ ∑ _i : Fin n, M := by apply Finset.sum_le_sum intro i hi rw [norm_mul] exact (mul_le_mul_of_nonneg_left (normalizedField_norm_le_one _ _ _) (norm_nonneg _)).trans (by simpa only [mul_one] using hb x (height P (dilationRadius k) x) i) _ = (n : ℝ)*M := by simp · rw [Set.indicator_of_notMem hx] simp only [baseFlux, baseDerivative, fderiv_zero_outside_base hK.isClosed hz hx, zero_apply, zero_mul, Finset.sum_const_zero, norm_zero, le_refl] · filter_upwards [ae_all_iff.mpr hl, hn] with x hx hnx exact tendsto_finsetSum _ (fun i _ ↦ (hx i).mul (hnx i)) /-- The ambient weighted graph mass converges to a flux determined by the leading phase and the two endpoint values of the primitive's base derivatives. -/ theorem ambient_mass_tendsto (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) {H : (Fin n → ℝ) × ℝ → ℝ} (hH : ContDiff ℝ 1 H) {K : Set (Fin n → ℝ)} (hK : IsCompact K) (hz : ∀ x, x ∉ K → ∀ z, H (x,z) = 0) {M N : ℝ} (hv : ∀ x z, ‖verticalDerivative H x z‖ ≤ M) (hvp : ∀ x, Tendsto (verticalDerivative H x) atTop (𝓝 0)) (hvm : ∀ x, Tendsto (verticalDerivative H x) atBot (𝓝 0)) (hb : ∀ x z i, ‖baseDerivative H x z i‖ ≤ N) {a b : (Fin n → ℝ) → Fin n → ℝ} (hp : ∀ x i, Tendsto (fun z ↦ baseDerivative H x z i) atTop (𝓝 (a x i))) (hm : ∀ x i, Tendsto (fun z ↦ baseDerivative H x z i) atBot (𝓝 (b x i))) : Tendsto (fun k ↦ ∫ x, verticalDerivative H x (height P (dilationRadius k) x) * areaDensity (gradient P (dilationRadius k) x)) atTop (𝓝 (-(∫ x, ∑ i, (if 0 < eval x (homogeneousComponent P.totalDegree P) then a x i else b x i) * leadingNormalizedField (homogeneousComponent P.totalDegree P) x i))) := by have he := ambient_error_tendsto_zero P hdeg hH hK hz hv hvp hvm have hf := ambient_flux_tendsto P hdeg hH hK hz hb hp hm have ht := he.sub hf simp only [zero_sub] at ht convert ht using 1 funext k exact ambient_mass_identity (height_contDiff P _) (gradient_contDiff P _) (height_fderiv P _ (dilationRadius_pos k).ne') (normalized_gradient_divergence P hmin _) hH hK hz end end Source29AmbientGraphLimits /- Component: CompactIntervalParameter.inc -/ namespace Source29CompactIntervalParameter open MeasureTheory Filter Set Metric open scoped Topology Interval noncomputable section variable {E G : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [ProperSpace E] [NormedAddCommGroup G] [NormedSpace ℝ G] [CompleteSpace G] theorem continuous_intervalIntegral {F : E × ℝ → G} (hF : Continuous F) (a b : ℝ) : Continuous (fun x ↦ ∫ t in a..b, F (x,t)) := by rw [continuous_iff_continuousAt] intro x obtain ⟨M,hM⟩ := ((isCompact_closedBall x 1).prod (isCompact_uIcc : IsCompact (uIcc a b))).exists_bound_of_continuousOn hF.continuousOn apply intervalIntegral.continuousAt_of_dominated_interval (bound := fun _ ↦ M) · exact Eventually.of_forall fun y ↦ (hF.comp (continuous_const.prodMk continuous_id)).aestronglyMeasurable · filter_upwards [closedBall_mem_nhds x (by norm_num : (0 : ℝ) < 1)] with y hy exact Eventually.of_forall fun t ht ↦ hM (y,t) ⟨hy, uIoc_subset_uIcc ht⟩ · exact intervalIntegrable_const · exact Eventually.of_forall fun t _ ↦ (hF.comp (continuous_id.prodMk continuous_const)).continuousAt theorem hasFDerivAt_intervalIntegral {F : E × ℝ → G} {D : E × ℝ → E →L[ℝ] G} (hF : Continuous F) (hD : Continuous D) (hd : ∀ x t, HasFDerivAt (fun y ↦ F (y,t)) (D (x,t)) x) (a b : ℝ) (x : E) : HasFDerivAt (fun y ↦ ∫ t in a..b, F (y,t)) (∫ t in a..b, D (x,t)) x := by obtain ⟨M,hM⟩ := ((isCompact_closedBall x 1).prod (isCompact_uIcc : IsCompact (uIcc a b))).exists_bound_of_continuousOn hD.continuousOn apply hasFDerivAt_integral_of_dominated_of_fderiv_le'' (s := closedBall x 1) (bound := fun _ ↦ M) (closedBall_mem_nhds x (by norm_num)) · exact Eventually.of_forall fun y ↦ (hF.comp (continuous_const.prodMk continuous_id)).aestronglyMeasurable · exact (hF.comp (continuous_const.prodMk continuous_id)).intervalIntegrable _ _ · exact (hD.comp (continuous_const.prodMk continuous_id)).aestronglyMeasurable · filter_upwards [ae_restrict_mem measurableSet_uIoc] with t ht intro y hy exact hM (y,t) ⟨hy,uIoc_subset_uIcc ht⟩ · exact intervalIntegrable_const · exact Eventually.of_forall fun t y _ ↦ hd y t def parameterDerivative (F : E × ℝ → G) (p : E × ℝ) : E →L[ℝ] G := (fderiv ℝ F p).comp (ContinuousLinearMap.inl ℝ E ℝ) theorem parameterDerivative_continuous {F : E × ℝ → G} (hF : ContDiff ℝ 1 F) : Continuous (parameterDerivative F) := (hF.continuous_fderiv (by norm_num)).clm_comp continuous_const theorem parameterDerivative_hasFDerivAt {F : E × ℝ → G} (hF : ContDiff ℝ 1 F) (x : E) (t : ℝ) : HasFDerivAt (fun y ↦ F (y,t)) (parameterDerivative F (x,t)) x := by exact ((hF.differentiable (by norm_num) (x,t)).hasFDerivAt).comp x (hasFDerivAt_prodMk_left x t) /-- Integrating a jointly C1 function over a fixed compact interval preserves C1. -/ theorem contDiff_intervalIntegral {F : E × ℝ → G} (hF : ContDiff ℝ 1 F) (a b : ℝ) : ContDiff ℝ 1 (fun x ↦ ∫ t in a..b, F (x,t)) := by apply contDiff_one_iff_hasFDerivAt.mpr refine ⟨fun x ↦ ∫ t in a..b, parameterDerivative F (x,t), continuous_intervalIntegral (parameterDerivative_continuous hF) a b, ?_⟩ intro x exact hasFDerivAt_intervalIntegral hF.continuous (parameterDerivative_continuous hF) (parameterDerivative_hasFDerivAt hF) a b x end end Source29CompactIntervalParameter /- Component: RadialPrimitiveCalculus.inc -/ namespace Source29RadialPrimitiveCalculus open MeasureTheory Filter Set open Source29CompactIntervalParameter Source29AmbientGraphCalculus Source29GraphRadialGeometry open scoped Topology BigOperators noncomputable section variable {n : ℕ} def radialTest (f : ℝ → ℝ) (p : (Fin n → ℝ) × ℝ) : ℝ := f ((∑ i, p.1 i ^ 2) + p.2 ^ 2) def primitive (f : ℝ → ℝ) (p : (Fin n → ℝ) × ℝ) : ℝ := ∫ t in 0..p.2, radialTest f (p.1,t) theorem radialTest_contDiff {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) : ContDiff ℝ 1 (radialTest (n := n) f) := by apply hf.comp exact (ContDiff.sum (fun i _ ↦ ((contDiff_apply ℝ ℝ i).comp contDiff_fst).pow 2)).add (contDiff_snd.pow 2) theorem primitive_eq_unit_interval (f : ℝ → ℝ) (x : Fin n → ℝ) (z : ℝ) : primitive f (x,z) = z * ∫ t in (0 : ℝ)..1, radialTest f (x,z*t) := by simpa only [primitive, smul_eq_mul, mul_zero, mul_one] using (intervalIntegral.smul_integral_comp_mul_left (fun t ↦ radialTest f (x,t)) (a := 0) (b := 1) z).symm theorem primitive_contDiff {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) : ContDiff ℝ 1 (primitive (n := n) f) := by have hc : ContDiff ℝ 1 (fun p : ((Fin n → ℝ) × ℝ) × ℝ ↦ radialTest f (p.1.1,p.1.2*p.2)) := (radialTest_contDiff hf).comp ((contDiff_fst.comp contDiff_fst).prodMk ((contDiff_snd.comp contDiff_fst).mul contDiff_snd)) have hi := contDiff_intervalIntegral hc 0 1 have he : primitive (n := n) f = fun p ↦ p.2 * ∫ t in (0 : ℝ)..1, radialTest f (p.1,p.2*t) := by funext p exact primitive_eq_unit_interval f p.1 p.2 rw [he] exact contDiff_snd.mul hi theorem primitive_verticalDerivative {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (x : Fin n → ℝ) (z : ℝ) : verticalDerivative (primitive f) x z = radialTest f (x,z) := by have ht : Continuous (fun t ↦ radialTest f (x,t)) := (radialTest_contDiff hf).continuous.comp (continuous_const.prodMk continuous_id) have hi := intervalIntegral.integral_hasDerivAt_right (ht.intervalIntegrable 0 z) ht.stronglyMeasurable.stronglyMeasurableAtFilter ht.continuousAt have hc : HasDerivAt (fun t : ℝ ↦ (x,t)) (0,1) z := (hasDerivAt_const z x).prodMk (hasDerivAt_id z) have hd := ((primitive_contDiff hf).differentiable (by norm_num) (x,z)).hasFDerivAt.comp_hasDerivAt z hc exact hd.unique hi theorem radialTest_parameter_basis {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (x : Fin n → ℝ) (t : ℝ) (i : Fin n) : parameterDerivative (radialTest f) (x,t) (Pi.single i 1) = 2*x i*deriv f ((∑ j, x j ^ 2) + t^2) := by have hs : ContDiff ℝ 1 (graphRadiusSq (fun _ : Fin n → ℝ ↦ t)) := graphRadiusSq_contDiff contDiff_const have hd := ((hf.differentiable (by norm_num) (graphRadiusSq (fun _ : Fin n → ℝ ↦ t) x)).hasDerivAt).comp_hasFDerivAt x ((hs.differentiable (by norm_num) x).hasFDerivAt) have hp := parameterDerivative_hasFDerivAt (radialTest_contDiff hf) x t have he := congrArg (fun D : (Fin n → ℝ) →L[ℝ] ℝ ↦ D (Pi.single i 1)) (hp.unique hd) have hzero (y : Fin n → ℝ) (j : Fin n) : fderiv ℝ (fun _ : Fin n → ℝ ↦ t) y (Pi.single j 1) = (0 : Fin n → ℝ) j := by simp simpa only [smul_apply, smul_eq_mul, graphRadiusSq_fderiv contDiff_const hzero, Pi.zero_apply, mul_zero, add_zero, graphRadiusSq, mul_comm, mul_left_comm, mul_assoc] using he theorem primitive_baseDerivative {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (x : Fin n → ℝ) (z : ℝ) (i : Fin n) : baseDerivative (primitive f) x z i = ∫ t in 0..z, 2*x i*deriv f ((∑ j, x j ^ 2) + t^2) := by have hi := hasFDerivAt_intervalIntegral (radialTest_contDiff hf).continuous (parameterDerivative_continuous (radialTest_contDiff hf)) (parameterDerivative_hasFDerivAt (radialTest_contDiff hf)) 0 z x have hp : HasFDerivAt (primitive (n := n) f) (fderiv ℝ (primitive f) (x,z)) (x,z) := ((primitive_contDiff hf).differentiable (by norm_num) (x,z)).hasFDerivAt have hcp : HasFDerivAt (fun y : Fin n → ℝ ↦ (y,z)) (ContinuousLinearMap.inl ℝ (Fin n → ℝ) ℝ) x := hasFDerivAt_prodMk_left x z have hc := hp.comp x hcp have he := congrArg (fun D : (Fin n → ℝ) →L[ℝ] ℝ ↦ D (Pi.single i 1)) (hc.unique hi) change baseDerivative (primitive f) x z i = (∫ t in 0..z, parameterDerivative (radialTest f) (x,t)) (Pi.single i 1) at he have hint : IntervalIntegrable (fun t ↦ parameterDerivative (radialTest f) (x,t)) volume 0 z := ((parameterDerivative_continuous (radialTest_contDiff hf)).comp (continuous_const.prodMk continuous_id)).intervalIntegrable 0 z rw [ContinuousLinearMap.intervalIntegral_apply hint] at he simpa only [radialTest_parameter_basis hf] using he end end Source29RadialPrimitiveCalculus /- Component: EvenCompactPrimitive.inc -/ namespace Source29EvenCompactPrimitive open MeasureTheory Set open scoped Interval noncomputable section theorem integral_neg {h : ℝ → ℝ} (he : ∀ t, h (-t) = h t) (z : ℝ) : (∫ t in 0..(-z), h t) = -(∫ t in 0..z, h t) := by have hi := intervalIntegral.integral_comp_neg h (a := 0) (b := z) simp only [he, neg_zero] at hi rw [intervalIntegral.integral_symm, ← hi] theorem integral_eq_at_two {h : ℝ → ℝ} (hh : Continuous h) (hz : ∀ t, 2 ≤ t → h t = 0) {z : ℝ} (hzbig : 2 ≤ z) : (∫ t in 0..z, h t) = ∫ t in (0 : ℝ)..2, h t := by have hi : (∫ t in (2 : ℝ)..z, h t) = 0 := by calc (∫ t in (2 : ℝ)..z, h t) = ∫ _t in (2 : ℝ)..z, (0 : ℝ) := by apply intervalIntegral.integral_congr intro t ht exact hz t ((uIcc_of_le hzbig ▸ ht).1) _ = 0 := by simp have ha := intervalIntegral.integral_add_adjacent_intervals (μ := volume) (hh.intervalIntegrable 0 2) (hh.intervalIntegrable 2 z) rw [hi, add_zero] at ha exact ha.symm theorem integral_eq_at_neg_two {h : ℝ → ℝ} (hh : Continuous h) (he : ∀ t, h (-t) = h t) (hz : ∀ t, 2 ≤ t → h t = 0) {z : ℝ} (hzneg : z ≤ -2) : (∫ t in 0..z, h t) = -(∫ t in (0 : ℝ)..2, h t) := by have hi := integral_neg he (-z) simp only [neg_neg] at hi rw [hi, integral_eq_at_two hh hz (by linarith)] theorem integral_norm_le {h : ℝ → ℝ} (hh : Continuous h) (he : ∀ t, h (-t) = h t) (hz : ∀ t, 2 ≤ t → h t = 0) {M : ℝ} (hb : ∀ t, ‖h t‖ ≤ M) (z : ℝ) : ‖∫ t in 0..z, h t‖ ≤ 2*M := by have hM : 0 ≤ M := (norm_nonneg (h 0)).trans (hb 0) have hbound (t : ℝ) (ht : |t| ≤ 2) : ‖∫ s in 0..t, h s‖ ≤ 2*M := by have hi := intervalIntegral.norm_integral_le_of_norm_le_const (a := 0) (b := t) (fun x _ ↦ hb x) simp only [sub_zero] at hi exact hi.trans (by nlinarith) by_cases hp : 2 ≤ z · rw [integral_eq_at_two hh hz hp] exact hbound 2 (by norm_num) by_cases hm : z ≤ -2 · rw [integral_eq_at_neg_two hh he hz hm, norm_neg] exact hbound 2 (by norm_num) exact hbound z (abs_le.mpr ⟨by linarith, by linarith⟩) end end Source29EvenCompactPrimitive /- Component: RadialPrimitiveBounds.inc -/ namespace Source29RadialPrimitiveBounds open MeasureTheory Set open Source29RadialPrimitiveCalculus Source29AmbientGraphCalculus Source29GraphRadialSupport open Source29EvenCompactPrimitive open scoped BigOperators noncomputable section variable {n : ℕ} def baseIntegrand (f : ℝ → ℝ) (x : Fin n → ℝ) (t : ℝ) (i : Fin n) : ℝ := 2*x i*deriv f ((∑ j, x j ^ 2) + t^2) def baseEndpoint (f : ℝ → ℝ) (x : Fin n → ℝ) (i : Fin n) : ℝ := ∫ t in (0 : ℝ)..2, baseIntegrand f x t i theorem radius_nonneg (x : Fin n → ℝ) (t : ℝ) : 0 ≤ (∑ j, x j ^ 2) + t^2 := add_nonneg (Finset.sum_nonneg (fun j _ ↦ sq_nonneg _)) (sq_nonneg _) theorem radialTest_zero_large {f : ℝ → ℝ} (hz : ∀ s, 2 ≤ s → f s = 0) (x : Fin n → ℝ) {t : ℝ} (ht : 2 ≤ |t|) : radialTest f (x,t) = 0 := by apply hz have hs : 0 ≤ ∑ j, x j ^ 2 := Finset.sum_nonneg (fun j _ ↦ sq_nonneg _) have he := sq_abs t nlinarith [sq_nonneg (|t|-2)] theorem primitive_zero_outside {f : ℝ → ℝ} (hz : ∀ s, 2 ≤ s → f s = 0) (x : Fin n → ℝ) (hx : x ∉ supportBox n 2) (z : ℝ) : primitive f (x,z) = 0 := by have hzero (t : ℝ) : radialTest f (x,t) = 0 := Source29GraphSmallDensity.cutoff_zero_outside_box (fun _ ↦ t) (by norm_num) hz x hx unfold primitive simp_rw [hzero] simp theorem baseIntegrand_continuous {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (x : Fin n → ℝ) (i : Fin n) : Continuous (fun t ↦ baseIntegrand f x t i) := continuous_const.mul (hf.continuous_deriv_one.comp (continuous_const.add (continuous_id.pow 2))) theorem baseIntegrand_even (f : ℝ → ℝ) (x : Fin n → ℝ) (i : Fin n) (t : ℝ) : baseIntegrand f x (-t) i = baseIntegrand f x t i := by simp only [baseIntegrand, neg_sq] theorem baseIntegrand_zero_large {f : ℝ → ℝ} (hz : ∀ s, 2 ≤ s → deriv f s = 0) (x : Fin n → ℝ) (i : Fin n) {t : ℝ} (ht : 2 ≤ t) : baseIntegrand f x t i = 0 := by have hR : 2 ≤ (∑ j, x j ^ 2) + t^2 := by nlinarith [Finset.sum_nonneg (s := Finset.univ) (fun j _ ↦ sq_nonneg (x j))] simp only [baseIntegrand, hz _ hR, mul_zero] theorem exists_baseIntegrand_bound {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hz : ∀ s, 2 ≤ s → deriv f s = 0) : ∃ M : ℝ, ∀ (x : Fin n → ℝ) t i, ‖baseIntegrand f x t i‖ ≤ M := by obtain ⟨M,hM⟩ := (isCompact_Icc : IsCompact (Icc (0 : ℝ) 2)).exists_bound_of_continuousOn hf.continuous_deriv_one.continuousOn refine ⟨4 * max M 0, ?_⟩ intro x t i by_cases hR : 2 ≤ (∑ j, x j ^ 2) + t^2 · simp only [baseIntegrand, hz _ hR, mul_zero, norm_zero] positivity have hR0 := radius_nonneg x t have hbound := hM _ ⟨hR0, (lt_of_not_ge hR).le⟩ have hxi2 : x i ^ 2 ≤ 2 := by have hi := Finset.single_le_sum (s := Finset.univ) (f := fun j ↦ x j ^ 2) (fun j _ ↦ sq_nonneg _) (Finset.mem_univ i) nlinarith [sq_nonneg t] have hxi : ‖x i‖ ≤ 2 := by rw [Real.norm_eq_abs, abs_le] constructor <;> nlinarith calc ‖baseIntegrand f x t i‖ = 2 * ‖x i‖ * ‖deriv f ((∑ j, x j ^ 2) + t^2)‖ := by unfold baseIntegrand rw [norm_mul, norm_mul] norm_num _ ≤ 2 * 2 * max M 0 := by gcongr exact hbound.trans (le_max_left _ _) _ = 4 * max M 0 := by ring theorem exists_baseDerivative_bound {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hz : ∀ s, 2 ≤ s → deriv f s = 0) : ∃ M : ℝ, ∀ (x : Fin n → ℝ) z i, ‖baseDerivative (primitive f) x z i‖ ≤ M := by obtain ⟨M,hM⟩ := exists_baseIntegrand_bound (n := n) hf hz refine ⟨2*M, ?_⟩ intro x z i rw [primitive_baseDerivative hf] exact integral_norm_le (baseIntegrand_continuous hf x i) (baseIntegrand_even f x i) (fun t ht ↦ baseIntegrand_zero_large hz x i ht) (fun t ↦ hM x t i) z end end Source29RadialPrimitiveBounds /- Component: RadialPrimitiveLimits.inc -/ namespace Source29RadialPrimitiveLimits open MeasureTheory Filter Set open Source29RadialPrimitiveCalculus Source29RadialPrimitiveBounds Source29EvenCompactPrimitive open Source29AmbientGraphCalculus open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem vertical_tendsto_atTop {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hz : ∀ s, 2 ≤ s → f s = 0) (x : Fin n → ℝ) : Tendsto (verticalDerivative (primitive f) x) atTop (𝓝 0) := by have he : verticalDerivative (primitive f) x =ᶠ[atTop] (fun _ ↦ (0 : ℝ)) := by filter_upwards [eventually_ge_atTop (2 : ℝ)] with z hz2 rw [primitive_verticalDerivative hf] exact radialTest_zero_large hz x (hz2.trans (le_abs_self z)) exact tendsto_const_nhds.congr' he.symm theorem vertical_tendsto_atBot {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hz : ∀ s, 2 ≤ s → f s = 0) (x : Fin n → ℝ) : Tendsto (verticalDerivative (primitive f) x) atBot (𝓝 0) := by have he : verticalDerivative (primitive f) x =ᶠ[atBot] (fun _ ↦ (0 : ℝ)) := by filter_upwards [eventually_le_atBot (-2 : ℝ)] with z hz2 rw [primitive_verticalDerivative hf] apply radialTest_zero_large hz x exact (by linarith : 2 ≤ -z).trans (neg_le_abs z) exact tendsto_const_nhds.congr' he.symm theorem base_eq_atTop {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hz : ∀ s, 2 ≤ s → deriv f s = 0) (x : Fin n → ℝ) (i : Fin n) {z : ℝ} (hz2 : 2 ≤ z) : baseDerivative (primitive f) x z i = baseEndpoint f x i := by rw [primitive_baseDerivative hf] exact integral_eq_at_two (baseIntegrand_continuous hf x i) (fun t ht ↦ baseIntegrand_zero_large hz x i ht) hz2 theorem base_eq_atBot {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hz : ∀ s, 2 ≤ s → deriv f s = 0) (x : Fin n → ℝ) (i : Fin n) {z : ℝ} (hz2 : z ≤ -2) : baseDerivative (primitive f) x z i = -baseEndpoint f x i := by rw [primitive_baseDerivative hf] exact integral_eq_at_neg_two (baseIntegrand_continuous hf x i) (baseIntegrand_even f x i) (fun t ht ↦ baseIntegrand_zero_large hz x i ht) hz2 theorem base_tendsto_atTop {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hz : ∀ s, 2 ≤ s → deriv f s = 0) (x : Fin n → ℝ) (i : Fin n) : Tendsto (fun z ↦ baseDerivative (primitive f) x z i) atTop (𝓝 (baseEndpoint f x i)) := by apply tendsto_const_nhds.congr' filter_upwards [eventually_ge_atTop (2 : ℝ)] with z hz2 exact (base_eq_atTop hf hz x i hz2).symm theorem base_tendsto_atBot {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hz : ∀ s, 2 ≤ s → deriv f s = 0) (x : Fin n → ℝ) (i : Fin n) : Tendsto (fun z ↦ baseDerivative (primitive f) x z i) atBot (𝓝 (-baseEndpoint f x i)) := by apply tendsto_const_nhds.congr' filter_upwards [eventually_le_atBot (-2 : ℝ)] with z hz2 exact (base_eq_atBot hf hz x i hz2).symm end end Source29RadialPrimitiveLimits /- Component: PolynomialRadialLimit.inc -/ namespace Source29PolynomialRadialLimit open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29GraphDilationFields Source29GraphMassMonotonicity Source29GraphAreaConvexity open Source29RadialPrimitiveCalculus Source29RadialPrimitiveBounds Source29RadialPrimitiveLimits open Source29AmbientGraphCalculus Source29GraphRadialSupport open Source29PolynomialGraphMonotonicity open scoped Topology BigOperators noncomputable section variable {n : ℕ} def radialPhaseFlux (Q : MvPolynomial (Fin n) ℝ) (f : ℝ → ℝ) : ℝ := -(∫ x, ∑ i, (if 0 < eval x Q then baseEndpoint f x i else -baseEndpoint f x i) * leadingNormalizedField Q x i) /-- The actual radial mass at large integer radii converges to a flux of the leading phase. -/ theorem radial_mass_tendsto (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {M : ℝ} (hb : ∀ s, ‖f s‖ ≤ M) (hz : ∀ s, 2 ≤ s → f s = 0) (hdz : ∀ s, 2 ≤ s → deriv f s = 0) : Tendsto (fun k ↦ normalizedMass (fun y ↦ eval y P) (evaluatedGradient P) f (dilationRadius k)) atTop (𝓝 (radialPhaseFlux (homogeneousComponent P.totalDegree P) f)) := by obtain ⟨N,hN⟩ := exists_baseDerivative_bound (n := n) hf hdz have hv : ∀ x z, ‖verticalDerivative (primitive (n := n) f) x z‖ ≤ M := by intro x z rw [primitive_verticalDerivative hf] exact hb _ have ht := Source29AmbientGraphLimits.ambient_mass_tendsto P hmin hdeg (primitive_contDiff hf) (supportBox_compact n 2) (primitive_zero_outside hz) hv (vertical_tendsto_atTop hf hz) (vertical_tendsto_atBot hf hz) hN (base_tendsto_atTop hf hdz) (base_tendsto_atBot hf hdz) change Tendsto _ atTop (𝓝 (radialPhaseFlux (homogeneousComponent P.totalDegree P) f)) at ht apply ht.congr' apply Filter.Eventually.of_forall intro k dsimp only rw [Source29GraphMassDilation.normalizedMass_eq_rescaled P f (dilationRadius_pos k)] apply integral_congr_ae apply Filter.Eventually.of_forall intro x change verticalDerivative (primitive f) x (height P (dilationRadius k) x) * areaDensity (gradient P (dilationRadius k) x) = _ rw [primitive_verticalDerivative hf] rfl theorem radialCutoff_mass_tendsto (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) : Tendsto (fun k ↦ normalizedMass (fun y ↦ eval y P) (evaluatedGradient P) radialCutoff (dilationRadius k)) atTop (𝓝 (radialPhaseFlux (homogeneousComponent P.totalDegree P) radialCutoff)) := by apply radial_mass_tendsto P hmin hdeg radialCutoff_contDiff (M := 1) _ radialCutoff_zero radialCutoff_deriv_zero intro s rw [Real.norm_eq_abs, abs_of_nonneg (radialCutoff_bounds s).1] exact (radialCutoff_bounds s).2 end end Source29PolynomialRadialLimit /- Component: RadialEndpointFlux.inc -/ namespace Source29RadialEndpointFlux open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29RadialPrimitiveCalculus Source29RadialPrimitiveBounds open Source29AmbientGraphCalculus Source29GraphRadialSupport Source29PolynomialRadialLimit open Source29PhaseMassLimit open scoped Topology BigOperators noncomputable section variable {n : ℕ} def endpoint (f : ℝ → ℝ) (x : Fin n → ℝ) : ℝ := primitive f (x,2) theorem endpoint_contDiff {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) : ContDiff ℝ 1 (endpoint (n := n) f) := (primitive_contDiff hf).comp (contDiff_id.prodMk contDiff_const) theorem endpoint_compact {f : ℝ → ℝ} (hz : ∀ s, 2 ≤ s → f s = 0) : HasCompactSupport (endpoint (n := n) f) := graph_composition_compact (supportBox_compact n 2) (primitive_zero_outside hz) (fun _ ↦ 2) theorem endpoint_fderiv {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (x : Fin n → ℝ) (i : Fin n) : fderiv ℝ (endpoint f) x (Pi.single i 1) = baseEndpoint f x i := by have hp := Source29CompactIntervalParameter.parameterDerivative_hasFDerivAt (primitive_contDiff hf) x 2 change HasFDerivAt (endpoint f) _ x at hp rw [hp.fderiv] change baseDerivative (primitive f) x 2 i = baseEndpoint f x i exact primitive_baseDerivative hf x 2 i theorem radialPhaseFlux_eq_twice_phaseMass (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hz : ∀ s, 2 ≤ s → f s = 0) : radialPhaseFlux (homogeneousComponent P.totalDegree P) f = 2 * phaseMass (homogeneousComponent P.totalDegree P) (endpoint f) := by let Q := homogeneousComponent P.totalDegree P have hQ : Q ≠ 0 := Source29QuarticReuse.QuarticPolynomialBasics.top_homogeneousComponent_ne_zero P (by omega) have hc := Source29TopWeakCalibration.top_weak_calibration P hmin hdeg (endpoint_contDiff hf) (endpoint_compact hz) let W := testFlux (fun i ↦ Pi.single i 1) (endpoint f) (leadingNormalizedField Q) have hw : Integrable W := hc.1 have hweighted := Source29PhaseApproximation.phase_weight_integrable Q hQ W hw have he (x : Fin n → ℝ) : (∑ i, (if 0 < eval x Q then baseEndpoint f x i else -baseEndpoint f x i) * leadingNormalizedField Q x i) = 2 * (W x * (if 0 < eval x Q then 1 else 0)) - W x := by unfold W testFlux simp only [endpoint_fderiv hf] by_cases hp : 0 < eval x Q · simp only [ite_eq_left hp, mul_one] ring · simp only [ite_eq_right hp, neg_mul, Finset.sum_neg_distrib, mul_zero] ring have hs : (∫ x, 2 * (W x * (if 0 < eval x Q then 1 else 0)) - W x) = (∫ x, 2 * (W x * (if 0 < eval x Q then 1 else 0))) - ∫ x, W x := integral_sub (hweighted.const_mul 2) hw change -(∫ x, ∑ i, (if 0 < eval x Q then baseEndpoint f x i else -baseEndpoint f x i) * leadingNormalizedField Q x i) = _ simp_rw [he] rw [hs, integral_const_mul] have hzero : (∫ x, W x) = 0 := hc.2 rw [hzero] change -(2 * (∫ x, W x * (if 0 < eval x Q then 1 else 0)) - 0) = 2 * (-(∫ x, W x * (if 0 < eval x Q then 1 else 0))) ring theorem radial_mass_tendsto_phaseMass (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {M : ℝ} (hb : ∀ s, ‖f s‖ ≤ M) (hz : ∀ s, 2 ≤ s → f s = 0) (hdz : ∀ s, 2 ≤ s → deriv f s = 0) : Tendsto (fun k ↦ Source29GraphMassMonotonicity.normalizedMass (fun y ↦ eval y P) (evaluatedGradient P) f (dilationRadius k)) atTop (𝓝 (2 * phaseMass (homogeneousComponent P.totalDegree P) (endpoint f))) := by have ht := radial_mass_tendsto P hmin hdeg hf hb hz hdz rwa [radialPhaseFlux_eq_twice_phaseMass P hmin hdeg hf hz] at ht end end Source29RadialEndpointFlux /- Component: CoordinateProductIntegral.inc -/ namespace Source29CoordinateProductIntegral open MeasureTheory noncomputable section variable {n : ℕ} def splitEquiv : (Fin (n+1) → ℝ) ≃ᵐ ℝ × (Fin n → ℝ) := MeasurableEquiv.piFinSuccAbove (fun _ ↦ ℝ) 0 theorem splitEquiv_symm (p : ℝ × (Fin n → ℝ)) : splitEquiv.symm p = Fin.cons p.1 p.2 := by change @Fin.insertNth n (fun _ ↦ ℝ) 0 p.1 p.2 = _ exact Fin.insertNth_zero' _ _ theorem splitEquiv_preserving : MeasurePreserving (splitEquiv (n := n)) := volume_preserving_piFinSuccAbove (fun _ ↦ ℝ) 0 theorem cons_integrable {f : (Fin (n+1) → ℝ) → ℝ} (hf : Integrable f) : Integrable (fun p : ℝ × (Fin n → ℝ) ↦ f (Fin.cons p.1 p.2)) := by have h := splitEquiv_preserving.symm.integrable_comp_of_integrable hf simpa only [Function.comp_def, splitEquiv_symm] using h theorem integral_cons {f : (Fin (n+1) → ℝ) → ℝ} (hf : Integrable f) : (∫ x, f x) = ∫ y : Fin n → ℝ, ∫ t : ℝ, f (Fin.cons t y) := by have h := splitEquiv_preserving.symm.integral_comp' f simp only [splitEquiv_symm] at h rw [← h] exact integral_prod_symm _ (cons_integrable hf) end end Source29CoordinateProductIntegral /- Component: CoordinateHalfspaceFlux.inc -/ namespace Source29CoordinateHalfspaceFlux open MeasureTheory MvPolynomial Set open Source29CoordinateProductIntegral open scoped BigOperators noncomputable section variable {n : ℕ} theorem cons_hasDerivAt (y : Fin n → ℝ) (t : ℝ) : HasDerivAt (fun s : ℝ ↦ (Fin.cons s y : Fin (n+1) → ℝ)) (Pi.single 0 1) t := by have he : Function.update (Fin.cons (0 : ℝ) y : Fin (n+1) → ℝ) 0 = (fun s : ℝ ↦ (Fin.cons s y : Fin (n+1) → ℝ)) := by funext s; exact Fin.update_cons_zero _ _ _ simpa only [he] using hasDerivAt_update (Fin.cons (0 : ℝ) y : Fin (n+1) → ℝ) 0 t theorem cons_contDiff (y : Fin n → ℝ) : ContDiff ℝ 1 (fun s : ℝ ↦ (Fin.cons s y : Fin (n+1) → ℝ)) := by have he : Function.update (Fin.cons (0 : ℝ) y : Fin (n+1) → ℝ) 0 = (fun s : ℝ ↦ (Fin.cons s y : Fin (n+1) → ℝ)) := by funext s; exact Fin.update_cons_zero _ _ _ simpa only [he] using (contDiff_update (𝕜 := ℝ) 1 (Fin.cons (0 : ℝ) y : Fin (n+1) → ℝ) 0) theorem slice_compact {ρ : (Fin (n+1) → ℝ) → ℝ} (hc : HasCompactSupport ρ) (y : Fin n → ℝ) : HasCompactSupport (fun t ↦ ρ (Fin.cons t y)) := by simpa only [Function.comp_def, Fin.update_cons_zero] using hc.comp_isClosedEmbedding (isClosedEmbedding_update (Fin.cons (0 : ℝ) y : Fin (n+1) → ℝ) 0) theorem slice_deriv {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (y : Fin n → ℝ) (t : ℝ) : deriv (fun s ↦ ρ (Fin.cons s y)) t = fderiv ℝ ρ (Fin.cons t y) (Pi.single 0 1) := by exact (((hρ.differentiable (by norm_num) (Fin.cons t y)).hasFDerivAt).comp_hasDerivAt t (cons_hasDerivAt y t)).deriv theorem slice_halfline_integral {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hc : HasCompactSupport ρ) (y : Fin n → ℝ) : (∫ t : ℝ, fderiv ℝ ρ (Fin.cons t y) (Pi.single 0 1) * (if 0 < t then 1 else 0)) = -ρ (Fin.cons 0 y) := by have he : (fun t : ℝ ↦ fderiv ℝ ρ (Fin.cons t y) (Pi.single 0 1) * (if 0 < t then 1 else 0)) = (Ioi 0).indicator (deriv (fun s ↦ ρ (Fin.cons s y))) := by funext t rw [← slice_deriv hρ] by_cases ht : 0 < t <;> simp [ht] rw [he, integral_indicator measurableSet_Ioi] exact HasCompactSupport.integral_Ioi_deriv_eq (hρ.comp (cons_contDiff y)) (slice_compact hc y) 0 /-- The outward derivative flux through a halfspace is exactly its boundary mass. -/ theorem coordinate_halfspace_flux {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hc : HasCompactSupport ρ) : -(∫ x, fderiv ℝ ρ x (Pi.single 0 1) * (if 0 < x 0 then 1 else 0)) = ∫ y : Fin n → ℝ, ρ (Fin.cons 0 y) := by have hi : Integrable (fun x ↦ fderiv ℝ ρ x (Pi.single 0 1)) := ((hρ.continuous_fderiv (by norm_num)).clm_apply continuous_const).integrable_of_hasCompactSupport (hc.fderiv_apply ℝ (Pi.single 0 1)) have hJ : Integrable (fun x ↦ fderiv ℝ ρ x (Pi.single 0 1) * (if 0 < x 0 then 1 else 0)) := by simpa only [eval_X] using Source29PhaseApproximation.phase_weight_integrable (X (0 : Fin (n+1)) : MvPolynomial (Fin (n+1)) ℝ) (X_ne_zero 0) _ hi rw [integral_cons hJ] simp only [Fin.cons_zero, slice_halfline_integral hρ hc, integral_neg, neg_neg] end end Source29CoordinateHalfspaceFlux /- Component: EvenRadialIntegral.inc -/ namespace Source29EvenRadialIntegral open MeasureTheory Set open Source29EvenCompactPrimitive Source29CoordinateProductIntegral open Source29RadialPrimitiveCalculus Source29RadialPrimitiveBounds open Source29RadialEndpointFlux Source29PolynomialSmallDensity open scoped BigOperators noncomputable section variable {n : ℕ} theorem integral_even_compact {h : ℝ → ℝ} (hh : Continuous h) (he : ∀ t, h (-t) = h t) (hz : ∀ t, 2 ≤ |t| → h t = 0) : (∫ t : ℝ, h t) = 2 * ∫ t in (0 : ℝ)..2, h t := by have hzero : ∀ t : ℝ, t ∉ Icc (-2) 2 → h t = 0 := by intro t ht apply hz by_contra hlt exact ht (abs_le.mp (le_of_lt (lt_of_not_ge hlt))) have hr := setIntegral_eq_integral_of_forall_compl_eq_zero (μ := volume) hzero have hm : (∫ t in (-2 : ℝ)..0, h t) = ∫ t in (0 : ℝ)..2, h t := by rw [intervalIntegral.integral_symm, integral_neg he 2, neg_neg] calc (∫ t : ℝ, h t) = ∫ t in Icc (-2 : ℝ) 2, h t := hr.symm _ = ∫ t in (-2 : ℝ)..2, h t := by rw [intervalIntegral.integral_of_le (by norm_num), integral_Icc_eq_integral_Ioc] _ = (∫ t in (-2 : ℝ)..0, h t) + ∫ t in (0 : ℝ)..2, h t := (intervalIntegral.integral_add_adjacent_intervals (hh.intervalIntegrable (-2) 0) (hh.intervalIntegrable 0 2)).symm _ = 2 * ∫ t in (0 : ℝ)..2, h t := by rw [hm]; ring theorem plane_weight_integrable {f : ℝ → ℝ} (hf : Continuous f) (hz : ∀ s, 2 ≤ s → f s = 0) : Integrable (fun x : Fin n → ℝ ↦ f (∑ i, x i^2)) := by have hc : Continuous (fun x : Fin n → ℝ ↦ f (∑ i, x i^2)) := hf.comp (continuous_finsetSum _ (fun i _ ↦ (continuous_apply i).pow 2)) apply hc.integrable_of_hasCompactSupport have hs := Source29GraphRadialSupport.scaled_cutoff_compact (fun _ : Fin n → ℝ ↦ (0 : ℝ)) (r := 1) (by norm_num : (0 : ℝ) ≤ 2) (by norm_num) hz simpa only [Source29GraphRadialGeometry.graphRadiusSq, zero_pow (by decide : 2 ≠ 0), add_zero, one_pow, div_one] using hs /-- Integrating the radial endpoint over a coordinate hyperplane gives half of the mass of a plane of the original dimension. -/ theorem planeMass_eq_endpoint_integral {f : ℝ → ℝ} (hf : Continuous f) (hz : ∀ s, 2 ≤ s → f s = 0) : planeMass (n+1) f = 2 * ∫ y : Fin n → ℝ, endpoint f (Fin.cons 0 y) := by unfold planeMass rw [integral_cons (plane_weight_integrable hf hz)] have he (y : Fin n → ℝ) : (∫ t : ℝ, f (∑ i : Fin (n+1), (Fin.cons t y : Fin (n+1) → ℝ) i ^ 2)) = 2 * endpoint f (Fin.cons 0 y) := by simp only [Fin.sum_univ_succ, Fin.cons_zero, Fin.cons_succ] have hi := integral_even_compact (hf.comp (continuous_const.add (continuous_id.pow 2)) : Continuous (fun t : ℝ ↦ f ((∑ i, y i^2)+t^2))) (fun t ↦ by simp only [Function.comp_def, neg_sq]) (fun t ht ↦ radialTest_zero_large hz y ht) simpa only [endpoint, primitive, radialTest, Fin.sum_univ_succ, Fin.cons_zero, Fin.cons_succ, zero_pow (by decide : 2 ≠ 0), zero_add, add_comm, Function.comp_def] using hi simp_rw [he] exact integral_const_mul _ _ end end Source29EvenRadialIntegral /- Component: CoordinatePhaseMass.inc -/ namespace Source29CoordinatePhaseMass open MeasureTheory MvPolynomial open Source29QuarticReuse.FluxObstruction open Source29PhaseMassLimit Source29CoordinateHalfspaceFlux open Source29RadialEndpointFlux Source29PolynomialSmallDensity open scoped BigOperators noncomputable section variable {n : ℕ} theorem normalizedField_X (x : Fin (n+1) → ℝ) : leadingNormalizedField (X (0 : Fin (n+1)) : MvPolynomial (Fin (n+1)) ℝ) x = Pi.single 0 1 := by have hg : evaluatedGradient (X (0 : Fin (n+1)) : MvPolynomial (Fin (n+1)) ℝ) x = Pi.single 0 1 := by funext i simp [evaluatedGradient, pderiv_X, Pi.single_apply, eq_comm] funext i simp [leadingNormalizedField, hg, radiusSq, Pi.single_apply] theorem testFlux_X (ρ : (Fin (n+1) → ℝ) → ℝ) (x : Fin (n+1) → ℝ) : testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField (X (0 : Fin (n+1)) : MvPolynomial (Fin (n+1)) ℝ)) x = fderiv ℝ ρ x (Pi.single 0 1) := by simp [testFlux, normalizedField_X, Pi.single_apply] theorem phaseMass_X {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hc : HasCompactSupport ρ) : phaseMass (X (0 : Fin (n+1)) : MvPolynomial (Fin (n+1)) ℝ) ρ = ∫ y : Fin n → ℝ, ρ (Fin.cons 0 y) := by simp only [phaseMass, testFlux_X, eval_X] exact coordinate_halfspace_flux hρ hc theorem twice_coordinate_phaseMass {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hz : ∀ s, 2 ≤ s → f s = 0) : 2 * phaseMass (X (0 : Fin (n+1)) : MvPolynomial (Fin (n+1)) ℝ) (endpoint f) = planeMass (n+1) f := by rw [phaseMass_X (endpoint_contDiff hf) (endpoint_compact hz)] exact (Source29EvenRadialIntegral.planeMass_eq_endpoint_integral hf.continuous hz).symm end end Source29CoordinatePhaseMass /- Component: OddPowerNormalizedField.inc -/ namespace Source29OddPowerNormalizedField open MvPolynomial open Source29QuarticReuse.FluxObstruction open scoped BigOperators noncomputable section variable {n : ℕ} theorem normalized_mul_pos (v : Fin n → ℝ) {c : ℝ} (hc : 0 < c) (i : Fin n) : (c*v i) / Real.sqrt (radiusSq (fun j ↦ c*v j)) = v i / Real.sqrt (radiusSq v) := by have hs : radiusSq (fun j ↦ c*v j) = c^2 * radiusSq v := by simp only [radiusSq, mul_pow, Finset.mul_sum] rw [hs, Real.sqrt_mul (sq_nonneg c), Real.sqrt_sq_eq_abs, abs_of_pos hc] exact mul_div_mul_left _ _ hc.ne' theorem normalized_neg (v : Fin n → ℝ) (i : Fin n) : (-v i) / Real.sqrt (radiusSq (fun j ↦ -v j)) = -(v i / Real.sqrt (radiusSq v)) := by simp only [radiusSq, neg_sq, neg_div] theorem normalized_mul_neg (v : Fin n → ℝ) {c : ℝ} (hc : c < 0) (i : Fin n) : (c*v i) / Real.sqrt (radiusSq (fun j ↦ c*v j)) = -(v i / Real.sqrt (radiusSq v)) := by have he : (fun j ↦ c*v j) = fun j ↦ (-c)*(-v j) := by funext j; ring rw [show c*v i = (-c)*(-v i) by ring, he] rw [normalized_mul_pos (fun j ↦ -v j) (by linarith), normalized_neg] theorem evaluatedGradient_C_pow (P : MvPolynomial (Fin n) ℝ) (c : ℝ) (k : ℕ) (x : Fin n → ℝ) (i : Fin n) : evaluatedGradient (C c * P^k) x i = (c*(k:ℝ)*(eval x P)^(k-1))*evaluatedGradient P x i := by simp [evaluatedGradient, pderiv_C_mul, pderiv_pow, mul_assoc] theorem odd_gradient_factor_pos {k : ℕ} (hk : Odd k) {a : ℝ} (ha : a ≠ 0) : 0 < (k:ℝ)*a^(k-1) := by have hkp : 0 < k := by obtain ⟨m,hm⟩ := hk; omega have he : Even (k-1) := by obtain ⟨m,hm⟩ := hk; exact ⟨m, by omega⟩ exact mul_pos (by exact_mod_cast hkp) (he.pow_pos ha) theorem normalizedField_C_pow_pos (P : MvPolynomial (Fin n) ℝ) {c : ℝ} (hc : 0 < c) {k : ℕ} (hk : Odd k) (x : Fin n → ℝ) (hx : eval x P ≠ 0) (i : Fin n) : leadingNormalizedField (C c * P^k) x i = leadingNormalizedField P x i := by have hs : 0 < c*(k:ℝ)*(eval x P)^(k-1) := by simpa only [mul_assoc] using mul_pos hc (odd_gradient_factor_pos hk hx) have hg : evaluatedGradient (C c * P^k) x = fun j ↦ (c*(k:ℝ)*(eval x P)^(k-1))*evaluatedGradient P x j := by funext j exact evaluatedGradient_C_pow P c k x j unfold leadingNormalizedField rw [hg] exact normalized_mul_pos _ hs i theorem normalizedField_C_pow_neg (P : MvPolynomial (Fin n) ℝ) {c : ℝ} (hc : c < 0) {k : ℕ} (hk : Odd k) (x : Fin n → ℝ) (hx : eval x P ≠ 0) (i : Fin n) : leadingNormalizedField (C c * P^k) x i = -leadingNormalizedField P x i := by have hs : c*(k:ℝ)*(eval x P)^(k-1) < 0 := by simpa only [mul_assoc] using mul_neg_of_neg_of_pos hc (odd_gradient_factor_pos hk hx) have hg : evaluatedGradient (C c * P^k) x = fun j ↦ (c*(k:ℝ)*(eval x P)^(k-1))*evaluatedGradient P x j := by funext j exact evaluatedGradient_C_pow P c k x j unfold leadingNormalizedField rw [hg] exact normalized_mul_neg _ hs i end end Source29OddPowerNormalizedField /- Component: OddPowerRadialFlux.inc -/ namespace Source29OddPowerRadialFlux open MvPolynomial MeasureTheory open Source29QuarticReuse.FluxObstruction Source29OddPowerNormalizedField open Source29PolynomialRadialLimit Source29RadialPrimitiveBounds open scoped BigOperators noncomputable section variable {n : ℕ} /-- Odd powers and a nonzero scalar do not change the unoriented radial phase flux. -/ theorem radialPhaseFlux_C_pow (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) {c : ℝ} (hc : c ≠ 0) {k : ℕ} (hk : Odd k) (f : ℝ → ℝ) : radialPhaseFlux (C c * P^k) f = radialPhaseFlux P f := by unfold radialPhaseFlux congr 1 apply integral_congr_ae filter_upwards [mvPolynomial_eval_ne_zero_ae n P hP] with x hx apply Finset.sum_congr rfl intro i hi have hev : eval x (C c * P^k) = c*(eval x P)^k := by simp rcases hc.lt_or_gt with hc | hc · rw [normalizedField_C_pow_neg P hc hk x hx i, hev] by_cases hp : 0 < eval x P · have hq : c*(eval x P)^k < 0 := mul_neg_of_neg_of_pos hc (hk.pow_pos_iff.mpr hp) simp only [ite_eq_right (not_lt_of_ge hq.le), ite_eq_left hp, neg_mul_neg] · have hpneg : eval x P < 0 := lt_of_le_of_ne (le_of_not_gt hp) hx have hq : 0 < c*(eval x P)^k := mul_pos_of_neg_of_neg hc (hk.pow_neg hpneg) simp only [ite_eq_left hq, ite_eq_right hp, mul_neg, neg_mul] · rw [normalizedField_C_pow_pos P hc hk x hx i, hev] by_cases hp : 0 < eval x P · have hq : 0 < c*(eval x P)^k := mul_pos hc (hk.pow_pos_iff.mpr hp) simp only [ite_eq_left hq, ite_eq_left hp] · have hpneg : eval x P < 0 := lt_of_le_of_ne (le_of_not_gt hp) hx have hq : c*(eval x P)^k < 0 := mul_neg_of_pos_of_neg hc (hk.pow_neg hpneg) simp only [ite_eq_right (not_lt_of_ge hq.le), ite_eq_right hp] end end Source29OddPowerRadialFlux /- Component: LinearNormalRotation.inc -/ namespace Source29LinearNormalRotation open Matrix MeasureTheory open Source29QuarticReuse.FluxObstruction Source29OrthogonalFrame open scoped BigOperators noncomputable section variable {n : ℕ} def unitVector (a : Fin (n+1) → ℝ) (i : Fin (n+1)) : ℝ := a i / Real.sqrt (radiusSq a) theorem exists_rotation (a : Fin (n+1) → ℝ) (ha : a ≠ 0) : ∃ U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ, U.transpose * U = 1 ∧ U * U.transpose = 1 ∧ (∀ i, U i 0 = unitVector a i) := by let v : EuclideanSpace ℝ (Fin (n+1)) := WithLp.toLp 2 (unitVector a) have hR := radiusSq_pos_of_ne_zero ha have hv : ‖v‖ = 1 := by have hs : ‖v‖^2 = 1 := by rw [EuclideanSpace.real_norm_sq_eq] change (∑ i, (a i / Real.sqrt (radiusSq a))^2) = 1 simp only [div_pow, ← Finset.sum_div] rw [Real.sq_sqrt hR.le] exact div_self hR.ne' nlinarith [norm_nonneg v] obtain ⟨T,hT,_⟩ := exists_isometry_of_orthogonal_pairs (coordinateUnit (0 : Fin (n+1))) 0 v 0 ((coordinateUnit_norm 0).trans hv.symm) (by simp) (by simp) (by simp) let U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ := fun i j ↦ T (coordinateUnit j) i have hU : U.transpose * U = 1 := by ext i j change (∑ k, T (coordinateUnit i) k * T (coordinateUnit j) k) = if i = j then 1 else 0 have he := T.inner_map_map (coordinateUnit i) (coordinateUnit j) rw [coordinateUnit_inner] at he simpa only [PiLp.inner_apply, RCLike.inner_apply, conj_trivial, mul_comm] using he exact ⟨U,hU,mul_eq_one_comm.mp hU,fun i ↦ congrArg (fun z : EuclideanSpace ℝ (Fin (n+1)) ↦ z i) hT⟩ theorem radiusSq_mulVec (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U.transpose * U = 1) (x : Fin (n+1) → ℝ) : radiusSq (U *ᵥ x) = radiusSq x := by have he := Source29QuarticReuse.QuarticMinimal.MatrixAlgebra.dot_transpose_mulVec U.transpose (by simpa only [Matrix.transpose_transpose] using hU) x x simpa only [Matrix.transpose_transpose, dotProduct, ← pow_two, radiusSq] using he theorem abs_det_rotation (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U.transpose * U = 1) : |U.det| = 1 := by have hd := congrArg Matrix.det hU rw [Matrix.det_mul, Matrix.det_transpose, Matrix.det_one] at hd have hs : |U.det|^2 = 1 := by rw [sq_abs, pow_two, hd] nlinarith [abs_nonneg U.det] theorem integral_comp_rotation (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U.transpose * U = 1) {f : (Fin (n+1) → ℝ) → ℝ} (hf : AEStronglyMeasurable f volume) : (∫ x, f (U *ᵥ x)) = ∫ x, f x := by have hd := abs_det_rotation U hU have hn : U.det ≠ 0 := by intro h; simpa [h] using hd have hm := Real.map_matrix_volume_pi_eq_smul_volume_pi (M := U) hn rw [abs_inv, hd, inv_one, ENNReal.ofReal_one, one_smul] at hm have hc : Continuous (Matrix.toLin' U) := (Matrix.toLin' U).continuous_on_pi have hi := integral_map (μ := (volume : Measure (Fin (n+1) → ℝ))) hc.aemeasurable (show AEStronglyMeasurable f (Measure.map (Matrix.toLin' U) volume) from hm.symm ▸ hf) rw [hm] at hi exact hi.symm end end Source29LinearNormalRotation /- Component: LinearEndpointRotation.inc -/ namespace Source29LinearEndpointRotation open Matrix MvPolynomial MeasureTheory open Source29QuarticReuse.FluxObstruction Source29LinearForm Source29LinearNormalRotation open Source29RadialEndpointFlux Source29RadialPrimitiveCalculus open scoped BigOperators noncomputable section variable {n : ℕ} theorem evaluatedGradient_linearForm (a x : Fin (n+1) → ℝ) : evaluatedGradient (linearForm a) x = a := by funext i simp [evaluatedGradient, linearForm, pderiv_X, Pi.single_apply, eq_comm] theorem normalizedField_linearForm (a x : Fin (n+1) → ℝ) : leadingNormalizedField (linearForm a) x = unitVector a := by funext i simp only [leadingNormalizedField, evaluatedGradient_linearForm, unitVector] theorem column_mulVec (a : Fin (n+1) → ℝ) (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hcol : ∀ i, U i 0 = unitVector a i) : U *ᵥ Pi.single 0 1 = unitVector a := by funext i simp [Matrix.mulVec, dotProduct, Pi.single_apply, hcol] theorem linearForm_eval_rotation (a : Fin (n+1) → ℝ) (ha : a ≠ 0) (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U.transpose * U = 1) (hcol : ∀ i, U i 0 = unitVector a i) (x : Fin (n+1) → ℝ) : eval (U *ᵥ x) (linearForm a) = Real.sqrt (radiusSq a) * x 0 := by have hR := (Real.sqrt_pos.mpr (radiusSq_pos_of_ne_zero ha)).ne' have he := Source29QuarticReuse.QuarticMinimal.MatrixAlgebra.dot_transpose_mulVec U.transpose (by simpa only [Matrix.transpose_transpose] using hU) (Pi.single 0 1) x simp only [Matrix.transpose_transpose, column_mulVec a U hcol] at he have he' : unitVector a ⬝ᵥ (U *ᵥ x) = x 0 := by simpa [dotProduct, Pi.single_apply] using he rw [eval_linearForm] calc (∑ i, a i * (U *ᵥ x) i) = Real.sqrt (radiusSq a) * (unitVector a ⬝ᵥ (U *ᵥ x)) := by rw [dotProduct, Finset.mul_sum] apply Finset.sum_congr rfl intro i hi unfold unitVector field_simp _ = Real.sqrt (radiusSq a) * x 0 := by rw [he'] theorem endpoint_rotation (f : ℝ → ℝ) (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U.transpose * U = 1) (x : Fin (n+1) → ℝ) : endpoint f (U *ᵥ x) = endpoint f x := by unfold endpoint primitive Source29RadialPrimitiveCalculus.radialTest have he := radiusSq_mulVec U hU x change (∫ t in (0 : ℝ)..2, f (radiusSq (U *ᵥ x) + t^2)) = ∫ t in (0 : ℝ)..2, f (radiusSq x + t^2) rw [he] theorem testFlux_const (ρ : (Fin (n+1) → ℝ) → ℝ) (v x : Fin (n+1) → ℝ) : testFlux (fun i ↦ Pi.single i 1) ρ (fun _ ↦ v) x = fderiv ℝ ρ x v := by have hv : v = ∑ i, v i • Pi.single i 1 := by funext j simp [Pi.single_apply] conv_rhs => rw [hv, map_sum] simp only [testFlux, map_smul, smul_eq_mul, mul_comm] theorem endpoint_testFlux_rotation {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (a : Fin (n+1) → ℝ) (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U.transpose * U = 1) (hcol : ∀ i, U i 0 = unitVector a i) (x : Fin (n+1) → ℝ) : testFlux (fun i ↦ Pi.single i 1) (endpoint f) (leadingNormalizedField (linearForm a)) (U *ᵥ x) = fderiv ℝ (endpoint f) x (Pi.single 0 1) := by have hn : leadingNormalizedField (linearForm a) = fun _ ↦ unitVector a := by funext y exact normalizedField_linearForm a y rw [hn, testFlux_const] let L : (Fin (n+1) → ℝ) →L[ℝ] (Fin (n+1) → ℝ) := (Matrix.toLin' U).toContinuousLinearMap have hp := ((endpoint_contDiff hf).differentiable (by norm_num) (U *ᵥ x)).hasFDerivAt.comp x L.hasFDerivAt have he : (fun y ↦ endpoint f (L y)) = endpoint f := by funext y exact endpoint_rotation f U hU y change HasFDerivAt (fun y ↦ endpoint f (L y)) _ x at hp rw [he] at hp have hb := congrArg (fun D : (Fin (n+1) → ℝ) →L[ℝ] ℝ ↦ D (Pi.single 0 1)) hp.fderiv change fderiv ℝ (endpoint f) x (Pi.single 0 1) = fderiv ℝ (endpoint f) (U *ᵥ x) (U *ᵥ Pi.single 0 1) at hb rw [column_mulVec a U hcol] at hb exact hb.symm end end Source29LinearEndpointRotation /- Component: LinearPhaseMass.inc -/ namespace Source29LinearPhaseMass open Matrix MvPolynomial MeasureTheory open Source29QuarticReuse.FluxObstruction Source29LinearForm open Source29LinearNormalRotation Source29LinearEndpointRotation Source29CoordinatePhaseMass open Source29RadialEndpointFlux Source29PhaseMassLimit Source29PolynomialSmallDensity open scoped BigOperators noncomputable section variable {n : ℕ} theorem linearForm_ne_zero_of_vector (a : Fin (n+1) → ℝ) (ha : a ≠ 0) : linearForm a ≠ 0 := by apply linearForm_ne_zero by_contra hn apply ha funext i exact not_ne_iff.mp (fun hi ↦ hn ⟨i,hi⟩) theorem linear_flux_integrable (a : Fin (n+1) → ℝ) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hc : HasCompactSupport ρ) : Integrable (testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField (linearForm a))) := by apply Continuous.integrable_of_hasCompactSupport · apply testFlux_continuous _ hρ intro i have he : (fun x ↦ leadingNormalizedField (linearForm a) x i) = fun _ ↦ unitVector a i := by funext x rw [normalizedField_linearForm] rw [he] exact continuous_const · exact testFlux_hasCompactSupport _ hc /-- Radial endpoint cutoffs have the same phase mass for every nonzero linear form. -/ theorem phaseMass_linearForm_eq_coordinate (a : Fin (n+1) → ℝ) (ha : a ≠ 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hz : ∀ s, 2 ≤ s → f s = 0) : phaseMass (linearForm a) (endpoint f) = phaseMass (X (0 : Fin (n+1))) (endpoint f) := by obtain ⟨U,hU,hUt,hcol⟩ := exists_rotation a ha let W := testFlux (fun i ↦ Pi.single i 1) (endpoint f) (leadingNormalizedField (linearForm a)) let J := fun x ↦ W x * (if 0 < eval x (linearForm a) then 1 else 0) have hW : Integrable W := linear_flux_integrable a (endpoint_contDiff hf) (endpoint_compact hz) have hJ : Integrable J := Source29PhaseApproximation.phase_weight_integrable (linearForm a) (linearForm_ne_zero_of_vector a ha) W hW have hr : 0 < Real.sqrt (radiusSq a) := Real.sqrt_pos.mpr (radiusSq_pos_of_ne_zero ha) have he (x : Fin (n+1) → ℝ) : J (U *ᵥ x) = fderiv ℝ (endpoint f) x (Pi.single 0 1) * (if 0 < x 0 then 1 else 0) := by dsimp only [J,W] rw [endpoint_testFlux_rotation hf a U hU hcol x, linearForm_eval_rotation a ha U hU hcol x] simp only [mul_pos_iff_of_pos_left hr] have hi := integral_comp_rotation U hU hJ.aestronglyMeasurable change -(∫ x, J x) = _ rw [← hi] simp_rw [he] simp only [phaseMass, testFlux_X, eval_X] theorem twice_linear_phaseMass (a : Fin (n+1) → ℝ) (ha : a ≠ 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hz : ∀ s, 2 ≤ s → f s = 0) : 2 * phaseMass (linearForm a) (endpoint f) = planeMass (n+1) f := by rw [phaseMass_linearForm_eq_coordinate a ha hf hz] exact twice_coordinate_phaseMass hf hz end end Source29LinearPhaseMass /- Component: LinearRadialPhaseFlux.inc -/ namespace Source29LinearRadialPhaseFlux open MvPolynomial MeasureTheory open Source29QuarticReuse.FluxObstruction Source29LinearForm open Source29LinearNormalRotation Source29LinearEndpointRotation Source29LinearPhaseMass open Source29RadialEndpointFlux Source29RadialPrimitiveBounds Source29PolynomialRadialLimit open Source29PhaseMassLimit Source29PolynomialSmallDensity open scoped BigOperators noncomputable section variable {n : ℕ} theorem radialPhaseFlux_eq_twice_of_zeroFlux (Q : MvPolynomial (Fin (n+1)) ℝ) (hQ : Q ≠ 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hi : Integrable (testFlux (fun i ↦ Pi.single i 1) (endpoint f) (leadingNormalizedField Q))) (hz : (∫ x, testFlux (fun i ↦ Pi.single i 1) (endpoint f) (leadingNormalizedField Q) x) = 0) : radialPhaseFlux Q f = 2 * phaseMass Q (endpoint f) := by let W := testFlux (fun i ↦ Pi.single i 1) (endpoint f) (leadingNormalizedField Q) have hw : Integrable W := hi have hweighted := Source29PhaseApproximation.phase_weight_integrable Q hQ W hw have he (x : Fin (n+1) → ℝ) : (∑ i, (if 0 < eval x Q then baseEndpoint f x i else -baseEndpoint f x i) * leadingNormalizedField Q x i) = 2 * (W x * (if 0 < eval x Q then 1 else 0)) - W x := by unfold W testFlux simp only [endpoint_fderiv hf] by_cases hp : 0 < eval x Q · simp only [ite_eq_left hp, mul_one] ring · simp only [ite_eq_right hp, neg_mul, Finset.sum_neg_distrib, mul_zero] ring have hs : (∫ x, 2 * (W x * (if 0 < eval x Q then 1 else 0)) - W x) = (∫ x, 2 * (W x * (if 0 < eval x Q then 1 else 0))) - ∫ x, W x := integral_sub (hweighted.const_mul 2) hw unfold radialPhaseFlux simp_rw [he] rw [hs, integral_const_mul] have hzero : (∫ x, W x) = 0 := hz rw [hzero] change -(2 * (∫ x, W x * (if 0 < eval x Q then 1 else 0)) - 0) = 2 * (-(∫ x, W x * (if 0 < eval x Q then 1 else 0))) ring theorem linear_flux_zero (a : Fin (n+1) → ℝ) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hc : HasCompactSupport ρ) : (∫ x, testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField (linearForm a)) x) = 0 := by have hn : leadingNormalizedField (linearForm a) = fun _ ↦ unitVector a := by funext x exact normalizedField_linearForm a x rw [hn] apply integral_testFlux_eq_zero (μ := volume) (fun i ↦ Pi.single i 1) hρ hc · intro i exact contDiff_const · intro x simp [divergence] theorem radialPhaseFlux_linearForm (a : Fin (n+1) → ℝ) (ha : a ≠ 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hz : ∀ s, 2 ≤ s → f s = 0) : radialPhaseFlux (linearForm a) f = planeMass (n+1) f := by rw [radialPhaseFlux_eq_twice_of_zeroFlux (linearForm a) (linearForm_ne_zero_of_vector a ha) hf (linear_flux_integrable a (endpoint_contDiff hf) (endpoint_compact hz)) (linear_flux_zero a (endpoint_contDiff hf) (endpoint_compact hz))] exact twice_linear_phaseMass a ha hf hz theorem radialPhaseFlux_odd_linear_power (a : Fin (n+1) → ℝ) (ha : a ≠ 0) {c : ℝ} (hc : c ≠ 0) {k : ℕ} (hk : Odd k) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hz : ∀ s, 2 ≤ s → f s = 0) : radialPhaseFlux (C c * (linearForm a)^k) f = planeMass (n+1) f := by rw [Source29OddPowerRadialFlux.radialPhaseFlux_C_pow (linearForm a) (linearForm_ne_zero_of_vector a ha) hc hk] exact radialPhaseFlux_linearForm a ha hf hz end end Source29LinearRadialPhaseFlux /- Component: PolynomialLinearLeadingRigidity.inc -/ namespace Source29PolynomialLinearLeadingRigidity open MvPolynomial Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29PolynomialCentering Source29PolynomialSequentialRigidity open Source29PolynomialGraphMonotonicity Source29PolynomialRadialLimit open Source29LinearRadialPhaseFlux Source29LinearForm noncomputable section variable {n : ℕ} theorem centered_totalDegree (P : MvPolynomial (Fin n) ℝ) : (centered P).totalDegree = P.totalDegree := by apply le_antisymm (totalDegree_sub_C_le P (eval 0 P)) have h := totalDegree_add (P - C (eval 0 P)) (C (eval 0 P)) simpa only [sub_add_cancel, totalDegree_C, max_zero] using h theorem centered_top_eq (P : MvPolynomial (Fin n) ℝ) (hd : 0 < P.totalDegree) : homogeneousComponent (centered P).totalDegree (centered P) = homogeneousComponent P.totalDegree P := by rw [centered_totalDegree, centered, map_sub] have hc : homogeneousComponent P.totalDegree (C (eval 0 P) : MvPolynomial (Fin n) ℝ) = 0 := homogeneousComponent_eq_zero P.totalDegree (C (eval 0 P)) (by simpa only [totalDegree_C] using hd) rw [hc, sub_zero] /-- A polynomial minimal graph with an odd power of a linear leading form is affine. -/ theorem affine_of_odd_linear_leading (P : MvPolynomial (Fin (n+1)) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (a : Fin (n+1) → ℝ) (ha : a ≠ 0) {c : ℝ} (hc : c ≠ 0) {k : ℕ} (hk : Odd k) (htop : homogeneousComponent P.totalDegree P = C c * (linearForm a)^k) : Math30.MinimalGraphs.IsAffine P := by by_cases hd : P.totalDegree ≤ 1 · exact hd have hdeg : 2 ≤ P.totalDegree := by omega have hminQ := (centered_minimal_iff P).mpr hmin have hdegQ : 2 ≤ (centered P).totalDegree := by rwa [centered_totalDegree] apply (centered_affine_iff P).mp apply affine_of_radial_sequence_limit (centered P) (centered_eval_zero P) hminQ dilationRadius_tendsto have ht := radialCutoff_mass_tendsto (centered P) hminQ hdegQ rw [centered_top_eq P (by omega), htop, radialPhaseFlux_odd_linear_power a ha hc hk radialCutoff_contDiff radialCutoff_zero] at ht exact ht theorem affine_of_odd_homogeneous_linear_leading (P : MvPolynomial (Fin (n+1)) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (p : MvPolynomial (Fin (n+1)) ℝ) (hp : p ≠ 0) (hphom : p.IsHomogeneous 1) {c : ℝ} (hc : c ≠ 0) {k : ℕ} (hk : Odd k) (htop : homogeneousComponent P.totalDegree P = C c * p^k) : Math30.MinimalGraphs.IsAffine P := by classical let a : Fin (n+1) → ℝ := fun i ↦ (pderiv i p).coeff 0 have he : p = linearForm a := Source29QuarticReuse.QuarticMinimal.homogeneous_linear_expansion p hphom have ha : a ≠ 0 := by intro hz apply hp rw [he, hz] simp [linearForm] apply affine_of_odd_linear_leading P hmin a ha hc hk rwa [← he] end end Source29PolynomialLinearLeadingRigidity /- Component: PositiveLeadingStructureReduction.inc -/ namespace Source29PositiveLeadingStructureReduction open MvPolynomial Source29Closing noncomputable section /-- Positive residual factor data, allowing either a linear or nonlinear irreducible factor. -/ def PositiveLeadingFactorData8 (P : Polynomial8) : Prop := ∃ (p Q : Polynomial8) (k : ℕ), 1 ≤ k ∧ Irreducible p ∧ p.IsHomogeneous p.totalDegree ∧ Q.IsHomogeneous Q.totalDegree ∧ homogeneousComponent P.totalDegree P = p ^ k * Q ∧ PositiveAwayFromZero Q /-- Both the linear and nonlinear factors are handled; only the positive residual factorization is assumed. -/ theorem problem29_of_positive_leading_factor (hstructure : ∀ P : Polynomial8, Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → PositiveLeadingFactorData8 P) : Math30.Problem29 := by intro P hminimal change P.totalDegree ≤ 1 by_contra hn have hd : 2 ≤ P.totalDegree := by omega obtain ⟨p, Q, k, hk, hp, hphom, hQhom, hfactor, hQpos⟩ := hstructure P hminimal hd obtain ⟨hodd, hpos, hneg⟩ := Source29PositiveResidualSign.minimal_graph_factor_changes_sign P p Q k hminimal hd hfactor hQpos obtain ⟨hne, hhom, hL⟩ := QuarticPolynomialBasics.leading_component_data P hminimal hd have hQdiv : Q ∣ homogeneousComponent P.totalDegree P := ⟨p ^ k, hfactor.trans (mul_comm _ _)⟩ have hQdegree := Source29ComplexObstruction.positive_divisor_obstruction (homogeneousComponent P.totalDegree P) Q P.totalDegree hne hhom hL hQhom hQpos hQdiv have hQconst : Q = C (Q.coeff 0) := totalDegree_eq_zero_iff_eq_C.mp hQdegree have ha : Q.coeff 0 ≠ 0 := by intro hz apply hne rw [hfactor, hQconst, hz, map_zero, mul_zero] have hpL : Source29FactorInheritance.cubicOperator p = 0 := by apply Source29PowerOperator.cubicOperator_pow_mul_C_zero_imp p hp.ne_zero k (by omega) (Q.coeff 0) ha change QuarticPolynomialBasics.cubicOperator (p ^ k * C (Q.coeff 0)) = 0 rw [← hQconst, ← hfactor] exact hL have hpd := Source29IrreducibleHomogeneousRigidity.degree_le_one p hp hphom hpL hpos hneg have hpdegree : p.totalDegree = 1 := by have hz : p.totalDegree ≠ 0 := by intro he have hc : p = C (p.coeff 0) := totalDegree_eq_zero_iff_eq_C.mp he obtain ⟨x, hx⟩ := hpos obtain ⟨y, hy⟩ := hneg rw [hc, eval_C] at hx hy linarith omega have hlinear : p.IsHomogeneous 1 := hpdegree ▸ hphom apply hn apply Source29PolynomialLinearLeadingRigidity.affine_of_odd_homogeneous_linear_leading P hminimal p hp.ne_zero hlinear ha hodd exact hfactor.trans ((congrArg (fun q ↦ p ^ k * q) hQconst).trans (mul_comm _ _)) end end Source29PositiveLeadingStructureReduction /- Component: CalibratedPhaseLocalPerimeter.inc -/ namespace Source29CalibratedPhaseLocalPerimeter open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction open Source29WeakCalibrationLimits Source29SmoothCalibrationRecovery open Source29WeightedPhaseVariation Source29TopPhasePerimeter Source29LocalPhasePerimeter open scoped Topology BigOperators ENNReal noncomputable section variable {n : ℕ} theorem phase_perimeter_comparison (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {A : ℕ → (Fin n → ℝ) → Fin n → ℝ} (ha : Approximation A (leadingNormalizedField P)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) (K V : Set (Fin n → ℝ)) (hflat : ∀ x ∈ K, fderiv ℝ ρ x = 0) (hV : ∀ x ∉ K, (x ∈ V ↔ 0 < eval x P)) : weightedPerimeter {x | 0 < eval x P} ρ ≤ weightedPerimeter V ρ := by classical apply phase_variation_minimizing P hP hcal ha hρ hcρ hρpos apply Filter.Eventually.of_forall intro x by_cases hx : x ∈ K · exact Or.inr (hflat x hx) · left change (if x ∈ V then (1 : ℝ) else 0) = if 0 < eval x P then 1 else 0 rw [hV x hx] theorem phase_local_perimeter_comparison (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {A : ℕ → (Fin n → ℝ) → Fin n → ℝ} (ha : Approximation A (leadingNormalizedField P)) (U K V : Set (Fin n → ℝ)) (hU : IsOpen U) (hK : IsCompact K) (hKU : K ⊆ U) (hV : ∀ x ∉ K, (x ∈ V ↔ 0 < eval x P)) : localPerimeter {x | 0 < eval x P} U ≤ localPerimeter V U := by classical apply iSup_le intro X apply iSup_le intro hX let L := K ∪ ⋃ i, tsupport (fun x ↦ X x i) have hcL : IsCompact L := hK.union (isCompact_iUnion (fun i ↦ hX.test.compact i)) have hLU : L ⊆ U := Set.union_subset hKU (Set.iUnion_subset hX.within) obtain ⟨ρ, hρ, hcρ, hρU, hρb, hρone, hρflat⟩ := exists_local_cutoff L U hcL hU hLU have hXρ : VariationTest ρ X := local_test_weighted L X hX.test (fun i x hx ↦ Or.inr (Set.mem_iUnion.mpr ⟨i, hx⟩)) ρ (fun x ↦ (hρb x).1) hρone calc _ ≤ weightedPerimeter {x | 0 < eval x P} ρ := test_le_weightedVariation _ _ _ hXρ _ ≤ weightedPerimeter V ρ := phase_perimeter_comparison P hP hcal ha hρ hcρ (fun x ↦ (hρb x).1) K V (fun x hx ↦ hρflat x (Or.inl hx)) hV _ ≤ localPerimeter V U := weightedVariation_le_local _ _ _ hρU (fun x ↦ (hρb x).2) theorem phase_local_perimeter_finite (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (U : Set (Fin n → ℝ)) (hU : IsCompact (closure U)) : localPerimeter {x | 0 < eval x P} U < ⊤ := by obtain ⟨ρ, hρ, hcρ, _, hρb, hρone, _⟩ := exists_local_cutoff (closure U) Set.univ hU isOpen_univ (Set.subset_univ _) have hb : localPerimeter {x | 0 < eval x P} U ≤ ENNReal.ofReal (Source29PhaseMassLimit.phaseMass P ρ) := by apply iSup_le intro X apply iSup_le intro hX have hXρ := local_test_weighted (closure U) X hX.test (fun i ↦ (hX.within i).trans subset_closure) ρ (fun x ↦ (hρb x).1) hρone exact (test_le_weightedVariation _ _ _ hXρ).trans (phase_variation_le_mass P hP hcal hρ hcρ) exact hb.trans_lt ENNReal.ofReal_lt_top theorem phase_locally_perimeter_minimizing (P : MvPolynomial (Fin n) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {A : ℕ → (Fin n → ℝ) → Fin n → ℝ} (ha : Approximation A (leadingNormalizedField P)) : LocallyPerimeterMinimizing {x | 0 < eval x P} := by exact ⟨phase_local_perimeter_finite P hP hcal, phase_local_perimeter_comparison P hP hcal ha⟩ end end Source29CalibratedPhaseLocalPerimeter /- Component: LeadingLevelPerimeter.inc -/ namespace Source29LeadingLevelPerimeter open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.QuarticPolynomialBasics open Source29WeakCalibrationLimits Source29SmoothCalibrationRecovery open Source29WeightedPhaseVariation Source29TopPhasePerimeter Source29LocalPhasePerimeter open Source29CalibratedPhaseLocalPerimeter Source29PerimeterRepresentatives open Source29PhaseMassLimit open scoped Topology ENNReal noncomputable section variable {n : ℕ} def levelPolynomial (P : MvPolynomial (Fin n) ℝ) (t : ℝ) : MvPolynomial (Fin n) ℝ := homogeneousComponent P.totalDegree P - C t theorem levelPolynomial_ne_zero (P : MvPolynomial (Fin n) ℝ) (hd : 2 ≤ P.totalDegree) (t : ℝ) : levelPolynomial P t ≠ 0 := by intro hz have he : homogeneousComponent P.totalDegree P = C t := sub_eq_zero.mp hz have hdegree := (homogeneousComponent_isHomogeneous P.totalDegree P).totalDegree (top_homogeneousComponent_ne_zero P (by omega)) rw [he, totalDegree_C] at hdegree omega theorem levelPolynomial_gradient (P : MvPolynomial (Fin n) ℝ) (t : ℝ) : evaluatedGradient (levelPolynomial P t) = evaluatedGradient (homogeneousComponent P.totalDegree P) := by funext x i simp [levelPolynomial, evaluatedGradient] theorem levelPolynomial_normalizedField (P : MvPolynomial (Fin n) ℝ) (t : ℝ) : leadingNormalizedField (levelPolynomial P t) = leadingNormalizedField (homogeneousComponent P.totalDegree P) := by funext x i simp only [leadingNormalizedField, levelPolynomial_gradient] theorem levelPolynomial_weakCalibration (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hd : 2 ≤ P.totalDegree) (t : ℝ) : WeakCalibration (leadingNormalizedField (levelPolynomial P t)) := by rw [levelPolynomial_normalizedField] exact top_weakCalibration P hmin hd theorem levelPolynomial_approximation (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hd : 2 ≤ P.totalDegree) (t : ℝ) : Approximation (graphField P) (leadingNormalizedField (levelPolynomial P t)) := by rw [levelPolynomial_normalizedField] exact graphField_approximation P hmin hd /-- Every strict superlevel, including nonzero levels, minimizes local perimeter. -/ theorem top_superlevel_minimizing (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hd : 2 ≤ P.totalDegree) (t : ℝ) : LocallyPerimeterMinimizing {x | t < eval x (homogeneousComponent P.totalDegree P)} := by simpa only [levelPolynomial, map_sub, eval_C, sub_pos] using phase_locally_perimeter_minimizing (levelPolynomial P t) (levelPolynomial_ne_zero P hd t) (levelPolynomial_weakCalibration P hmin hd t) (levelPolynomial_approximation P hmin hd t) theorem top_sublevel_minimizing (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hd : 2 ≤ P.totalDegree) (t : ℝ) : LocallyPerimeterMinimizing {x | eval x (homogeneousComponent P.totalDegree P) < t} := by apply locallyPerimeterMinimizing_congr_ae _ (locallyPerimeterMinimizing_compl (top_superlevel_minimizing P hmin hd t)) filter_upwards [mvPolynomial_eval_ne_zero_ae n (levelPolynomial P t) (levelPolynomial_ne_zero P hd t)] with x hx have hne : eval x (homogeneousComponent P.totalDegree P) ≠ t := by apply sub_ne_zero.mp simpa only [levelPolynomial, map_sub, eval_C] using hx change (¬ t < eval x (homogeneousComponent P.totalDegree P)) ↔ eval x (homogeneousComponent P.totalDegree P) < t exact ⟨fun h ↦ lt_of_le_of_ne (le_of_not_gt h) hne, fun h ↦ not_lt_of_ge h.le⟩ theorem top_superlevel_perimeter_eq_mass (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hd : 2 ≤ P.totalDegree) (t : ℝ) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) : weightedPerimeter {x | t < eval x (homogeneousComponent P.totalDegree P)} ρ = ENNReal.ofReal (phaseMass (levelPolynomial P t) ρ) := by have he : Source29WeightedPhaseVariation.positivePhase (levelPolynomial P t) = fun x ↦ if t < eval x (homogeneousComponent P.totalDegree P) then (1 : ℝ) else 0 := by funext x simp [Source29WeightedPhaseVariation.positivePhase, levelPolynomial] change weightedVariation (fun x ↦ if t < eval x (homogeneousComponent P.totalDegree P) then (1 : ℝ) else 0) ρ = _ rw [← he] exact phase_variation_eq_mass (levelPolynomial P t) (levelPolynomial_ne_zero P hd t) (levelPolynomial_weakCalibration P hmin hd t) (levelPolynomial_approximation P hmin hd t) hρ hcρ hρpos /-- Euler's identity makes every nonzero leading level regular. -/ theorem top_nonzero_level_gradient (P : MvPolynomial (Fin n) ℝ) (hd : 2 ≤ P.totalDegree) {t : ℝ} (ht : t ≠ 0) {x : Fin n → ℝ} (hx : eval x (homogeneousComponent P.totalDegree P) = t) : evaluatedGradient (homogeneousComponent P.totalDegree P) x ≠ 0 := by exact Source29TopWeakCalibration.evaluatedGradient_ne_zero_of_eval_ne_zero _ (homogeneousComponent_isHomogeneous _ _) (by omega) (hx ▸ ht) end end Source29LeadingLevelPerimeter /- Component: LeadingLevelMassContinuity.inc -/ namespace Source29LeadingLevelMassContinuity open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29LeadingLevelPerimeter Source29PhaseMassLimit Source29TopPhasePerimeter open scoped Topology noncomputable section variable {n : ℕ} /-- A moving polynomial threshold has continuous weighted volume because every level is null. -/ theorem integral_superlevel_continuous (F : MvPolynomial (Fin n) ℝ) (hF : ∀ t : ℝ, F - C t ≠ 0) {w : (Fin n → ℝ) → ℝ} (hw : Integrable w) : Continuous (fun t : ℝ ↦ ∫ x, w x * (if t < eval x F then 1 else 0)) := by apply continuous_iff_continuousAt.mpr intro t₀ apply continuousAt_of_dominated (bound := fun x ↦ ‖w x‖) · apply Filter.Eventually.of_forall intro t have hs : MeasurableSet {x : Fin n → ℝ | t < eval x F} := (isOpen_lt continuous_const (contDiff_eval F).continuous).measurableSet convert (hw.indicator hs).aestronglyMeasurable using 1 funext x by_cases hx : t < eval x F <;> simp [Set.indicator, hx] · apply Filter.Eventually.of_forall intro t apply Filter.Eventually.of_forall intro x split_ifs <;> simp · exact hw.norm · filter_upwards [mvPolynomial_eval_ne_zero_ae n (F - C t₀) (hF t₀)] with x hx have hne : eval x F ≠ t₀ := sub_ne_zero.mp (by simpa only [map_sub, eval_C] using hx) have he : (fun t : ℝ ↦ w x * (if t < eval x F then 1 else 0)) =ᶠ[𝓝 t₀] (fun _ ↦ w x * (if t₀ < eval x F then 1 else 0)) := by rcases lt_or_gt_of_ne hne with hlt | hgt · filter_upwards [lt_mem_nhds hlt] with t ht simp only [not_lt_of_ge hlt.le, not_lt_of_ge ht.le, ite_false, mul_zero] · filter_upwards [gt_mem_nhds hgt] with t ht simp only [hgt, ht, ite_true, mul_one] exact continuousAt_const.congr_of_eventuallyEq he theorem level_phaseMass_eq (P : MvPolynomial (Fin n) ℝ) (t : ℝ) (ρ : (Fin n → ℝ) → ℝ) : phaseMass (levelPolynomial P t) ρ = -(∫ x, testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField (homogeneousComponent P.totalDegree P)) x * (if t < eval x (homogeneousComponent P.totalDegree P) then 1 else 0)) := by unfold phaseMass rw [levelPolynomial_normalizedField] simp only [levelPolynomial, map_sub, eval_C, sub_pos] /-- The calibrated perimeter masses vary continuously with the level, including at zero. -/ theorem level_phaseMass_continuous (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hd : 2 ≤ P.totalDegree) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) : Continuous (fun t : ℝ ↦ phaseMass (levelPolynomial P t) ρ) := by simp_rw [level_phaseMass_eq] apply Continuous.neg apply integral_superlevel_continuous _ (fun t ↦ levelPolynomial_ne_zero P hd t) exact (top_weakCalibration P hmin hd).2 ρ hρ hcρ |>.1 theorem level_weightedPerimeter_continuous (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hd : 2 ≤ P.totalDegree) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) : Continuous (fun t : ℝ ↦ weightedPerimeter {x | t < eval x (homogeneousComponent P.totalDegree P)} ρ) := by simp_rw [top_superlevel_perimeter_eq_mass P hmin hd _ hρ hcρ hρpos] exact ENNReal.continuous_ofReal.comp (level_phaseMass_continuous P hmin hd hρ hcρ) end end Source29LeadingLevelMassContinuity /- Component: LeadingLevelContinuousMass.inc -/ namespace Source29LeadingLevelContinuousMass open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29LeadingLevelPerimeter open Source29PhaseMassLimit Source29PhaseMassFunctional Source29SmoothMassLimits open Source29SmoothMassExtension Source29LocalPhasePerimeter Source29LeadingLevelMassContinuity open scoped Topology noncomputable section variable {n : ℕ} /-- One compact-support bound works for all levels, including through singular levels. -/ theorem level_phaseMass_bounded_on_compact (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hd : 2 ≤ P.totalDegree) (K : Set (Fin n → ℝ)) (hK : IsCompact K) : ∃ M : ℝ, 0 ≤ M ∧ ∀ t : ℝ, ∀ σ : (Fin n → ℝ) → ℝ, ContDiff ℝ 1 σ → HasCompactSupport σ → tsupport σ ⊆ K → ∀ C : ℝ, 0 ≤ C → (∀ x, |σ x| ≤ C) → |phaseMass (levelPolynomial P t) σ| ≤ C * M := by obtain ⟨ρ, hρ, hcρ, _, hρb, hρone, _⟩ := exists_local_cutoff K Set.univ hK isOpen_univ (Set.subset_univ K) let M := ∫ x, testBound (fun i ↦ Pi.single i 1) ρ x refine ⟨M, integral_nonneg (fun x ↦ Finset.sum_nonneg (fun i _ ↦ norm_nonneg _)), ?_⟩ intro t σ hσ hcσ hsσ C hC hb have hcal := levelPolynomial_weakCalibration P hmin hd t have hne := levelPolynomial_ne_zero P hd t have hbound : |phaseMass (levelPolynomial P t) σ| ≤ C * phaseMass (levelPolynomial P t) ρ := by apply phaseMass_abs_le _ hne hcal hρ hcρ hσ hcσ C intro x by_cases hx : x ∈ K · simpa only [hρone x hx, mul_one] using hb x · have hz : σ x = 0 := image_eq_zero_of_notMem_tsupport (fun ht ↦ hx (hsσ ht)) rw [hz, abs_zero] exact mul_nonneg hC (hρb x).1 exact hbound.trans (mul_le_mul_of_nonneg_left (phaseMass_bounds _ hne hcal hρ hcρ (fun x ↦ (hρb x).1)).2 hC) theorem level_approximation_error (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hd : 2 ≤ P.totalDegree) {f : (Fin n → ℝ) → ℝ} (a : Approximation f) : ∃ M : ℝ, 0 ≤ M ∧ ∀ k t, |phaseMass (levelPolynomial P t) (a.fn k) - continuousMass (levelPolynomial P t) f| ≤ a.error k * M := by obtain ⟨M, hM, hbound⟩ := level_phaseMass_bounded_on_compact P hmin hd a.carrier a.compact_carrier refine ⟨M, hM, ?_⟩ intro k t have ht := (tendsto_const_nhds (x := phaseMass (levelPolynomial P t) (a.fn k))).sub (continuousMass_tendsto _ (levelPolynomial_ne_zero P hd t) (levelPolynomial_weakCalibration P hmin hd t) a) have he : Tendsto (fun j ↦ (a.error k + a.error j) * M) atTop (𝓝 (a.error k * M)) := by simpa only [add_zero] using (a.tends.const_add (a.error k)).mul_const M apply le_of_tendsto_of_tendsto ht.abs he apply Filter.Eventually.of_forall intro j have hs : tsupport (fun x ↦ a.fn k x - a.fn j x) ⊆ a.carrier := (tsupport_binop_subset (fun b c : ℝ ↦ b - c) (sub_self 0) _ _).trans (Set.union_subset (a.within k) (a.within j)) have hb : ∀ x, |a.fn k x - a.fn j x| ≤ a.error k + a.error j := by intro x calc _ ≤ |a.fn k x - f x| + |f x - a.fn j x| := abs_sub_le _ _ _ _ = |a.fn k x - f x| + |a.fn j x - f x| := by rw [abs_sub_comm (f x)] _ ≤ _ := add_le_add (a.bound k x) (a.bound j x) have h := hbound t (fun x ↦ a.fn k x - a.fn j x) ((a.smooth k).sub (a.smooth j)) ((a.compact k).sub (a.compact j)) hs (a.error k + a.error j) (add_nonneg (a.nonneg k) (a.nonneg j)) hb rwa [phaseMass_sub _ (levelPolynomial_ne_zero P hd t) (levelPolynomial_weakCalibration P hmin hd t) (a.smooth k) (a.compact k) (a.smooth j) (a.compact j)] at h /-- Smooth approximation is uniform in the level parameter. -/ theorem level_mass_tendstoUniformly (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hd : 2 ≤ P.totalDegree) {f : (Fin n → ℝ) → ℝ} (a : Approximation f) : TendstoUniformly (fun (k : ℕ) (t : ℝ) ↦ phaseMass (levelPolynomial P t) (a.fn k)) (fun t ↦ continuousMass (levelPolynomial P t) f) atTop := by obtain ⟨M, _, hb⟩ := level_approximation_error P hmin hd a apply Metric.tendstoUniformly_iff.mpr intro ε hε have he : Tendsto (fun k ↦ a.error k * M) atTop (𝓝 0) := by simpa using a.tends.mul_const M filter_upwards [he.eventually (gt_mem_nhds hε)] with k hk intro t rw [Real.dist_eq, abs_sub_comm] exact (hb k t).trans_lt hk /-- Level perimeter mass is continuous against every compact continuous weight. -/ theorem level_continuousMass_continuous (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hd : 2 ≤ P.totalDegree) {f : (Fin n → ℝ) → ℝ} (hf : Continuous f) (hcf : HasCompactSupport f) : Continuous (fun t : ℝ ↦ continuousMass (levelPolynomial P t) f) := by obtain ⟨a⟩ := exists_approximation f hf hcf apply (level_mass_tendstoUniformly P hmin hd a).continuous exact (Filter.Eventually.of_forall fun k ↦ level_phaseMass_continuous P hmin hd (a.smooth k) (a.compact k)).frequently end end Source29LeadingLevelContinuousMass /- Component: LevelRadialStress.inc -/ namespace Source29LevelRadialStress open MvPolynomial MeasureTheory open Source29QuarticReuse.FluxObstruction Source29PolynomialStress open Source29NormalBall Source29NormalPenalty Source29ProjectedTraceAlgebra open Source29GradientBarrierCalculus Source29VariationConvexity open scoped BigOperators noncomputable section variable {n : ℕ} def radialWeight (f : ℝ → ℝ) (r : ℝ) (x : Fin n → ℝ) : ℝ := f (radiusSq x / r^2) def radialField (f : ℝ → ℝ) (r : ℝ) (x : Fin n → ℝ) (j : Fin n) : ℝ := radialWeight f r x * x j theorem radialWeight_contDiff {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (r : ℝ) : ContDiff ℝ 1 (radialWeight (n := n) f r) := hf.comp (radiusSq_contDiff.div_const _) theorem radialWeight_compact {f : ℝ → ℝ} {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ s, R ≤ s → f s = 0) : HasCompactSupport (radialWeight (n := n) f r) := by change HasCompactSupport (fun x : Fin n → ℝ ↦ f (radiusSq x/r^2)) simpa only [Source29GraphRadialGeometry.graphRadiusSq, Pi.zero_apply, zero_pow (by decide : 2 ≠ 0), add_zero, radiusSq] using Source29GraphRadialSupport.scaled_cutoff_compact (0 : (Fin n → ℝ) → ℝ) hR hr hz theorem radialWeight_fderiv {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (r : ℝ) (x : Fin n → ℝ) (i : Fin n) : fderiv ℝ (radialWeight f r) x (Pi.single i 1) = (2 / r^2) * deriv f (radiusSq x / r^2) * x i := by have hzero : Source29GraphRadialGeometry.graphRadiusSq (0 : (Fin n → ℝ) → ℝ) = radiusSq := by funext y simp [Source29GraphRadialGeometry.graphRadiusSq, radiusSq] have hs : fderiv ℝ (radiusSq : (Fin n → ℝ) → ℝ) x (Pi.single i 1) = 2 * x i := by have h := Source29GraphRadialGeometry.graphRadiusSq_fderiv (u := (0 : (Fin n → ℝ) → ℝ)) (g := (0 : (Fin n → ℝ) → Fin n → ℝ)) contDiff_const (by intro y j; simp) x i rw [hzero] at h simpa using h have hq : HasFDerivAt (fun y : Fin n → ℝ ↦ radiusSq y / r^2) ((r^2)⁻¹ • fderiv ℝ radiusSq x) x := by simpa only [Function.comp_def, id_eq, one_div] using (((hasDerivAt_id (radiusSq x)).div_const (r^2)).comp_hasFDerivAt x ((radiusSq_contDiff.differentiable (by norm_num) x).hasFDerivAt)) have hd := ((hf.differentiable (by norm_num) (radiusSq x / r^2)).hasDerivAt).comp_hasFDerivAt x hq have he := congrArg (fun D : (Fin n → ℝ) →L[ℝ] ℝ ↦ D (Pi.single i 1)) hd.fderiv change fderiv ℝ (radialWeight f r) x (Pi.single i 1) = _ at he simp only [_root_.smul_apply, smul_eq_mul, hs] at he rw [he] ring theorem radialField_contDiff {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (r : ℝ) (j : Fin n) : ContDiff ℝ 1 (fun x ↦ radialField f r x j) := (radialWeight_contDiff hf r).mul (contDiff_apply ℝ ℝ j) theorem radialField_compact {f : ℝ → ℝ} {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ s, R ≤ s → f s = 0) (j : Fin n) : HasCompactSupport (fun x ↦ radialField f r x j) := (radialWeight_compact hR hr hz).mul_right theorem radialField_jacobian {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (r : ℝ) (x : Fin n → ℝ) (i j : Fin n) : coordinateJacobian (radialField f r) x i j = radialWeight f r x * (if i = j then 1 else 0) + ((2 / r^2) * deriv f (radiusSq x / r^2)) * (x i * x j) := by have hd := (((radialWeight_contDiff hf r).differentiable (by norm_num) x).hasFDerivAt).fun_mul (hasFDerivAt_apply (𝕜 := ℝ) (F' := fun _ : Fin n ↦ ℝ) j x) have he := congrArg (fun D : (Fin n → ℝ) →L[ℝ] ℝ ↦ D (Pi.single i 1)) hd.fderiv change coordinateJacobian (radialField f r) x i j = _ at he simp only [ContinuousLinearMap.add_apply, _root_.smul_apply, smul_eq_mul, ContinuousLinearMap.proj_apply, Pi.single_apply, radialWeight_fderiv hf] at he rw [he] simp only [eq_comm] ring theorem projectedTrace_identity (N : Fin n → ℝ) : projectedTrace (fun i j : Fin n ↦ if i = j then (1 : ℝ) else 0) N = (n : ℝ) - sqNorm N := by simp [projectedTrace, trace, quad, sqNorm, ite_mul, pow_two] theorem normalizedField_sqNorm (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) (hg : evaluatedGradient P x ≠ 0) : sqNorm (leadingNormalizedField P x) = 1 := by have hp := Source29NormalBall.sqNorm_pos hg simp only [sqNorm, leadingNormalizedField, div_pow, ← Finset.sum_div] change sqNorm (evaluatedGradient P x) / (Real.sqrt (sqNorm (evaluatedGradient P x)))^2 = 1 rw [Real.sq_sqrt hp.le, div_self hp.ne'] /-- Radial first variation, including the critical set where its density is zero. -/ theorem stressPair_radial (P : MvPolynomial (Fin (n+1)) ℝ) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (r : ℝ) (x : Fin (n+1) → ℝ) : stressPair P (radialField f r) x = variationDensity (evaluatedGradient P x) * ((n : ℝ) * radialWeight f r x + (2/r^2) * deriv f (radiusSq x/r^2) * (radiusSq x - (dot (leadingNormalizedField P x) x)^2)) := by rw [stressPair_eq_tangentialDivergence] by_cases hg : evaluatedGradient P x = 0 · simp [hg, variationDensity] · rw [tangentialDivergence_eq_projectedTrace] have hj : coordinateJacobian (radialField f r) x = fun i j ↦ radialWeight f r x * (if i = j then 1 else 0) + ((2/r^2) * deriv f (radiusSq x/r^2)) * (x i * x j) := by funext i j exact radialField_jacobian hf r x i j rw [hj, projectedTrace_add, projectedTrace_smul, projectedTrace_smul, projectedTrace_identity, projectedTrace_square, normalizedField_sqNorm P x hg] simp only [Nat.cast_add, Nat.cast_one, add_sub_cancel_right, penalty, sqNorm, radiusSq] ring end end Source29LevelRadialStress /- Component: WeightedRadialDerivative.inc -/ namespace Source29WeightedRadialDerivative open MeasureTheory Set open Source29QuarticReuse.FluxObstruction Source29LevelRadialStress Source29GraphRadialSupport open scoped Topology noncomputable section variable {n : ℕ} def density (w : (Fin n → ℝ) → ℝ) (f : ℝ → ℝ) (r : ℝ) (x : Fin n → ℝ) : ℝ := radialWeight f r x * w x def densityDeriv (w : (Fin n → ℝ) → ℝ) (f : ℝ → ℝ) (r : ℝ) (x : Fin n → ℝ) : ℝ := (-2 * radiusSq x / r^3) * deriv f (radiusSq x / r^2) * w x def mass (w : (Fin n → ℝ) → ℝ) (f : ℝ → ℝ) (r : ℝ) : ℝ := ∫ x, density w f r x theorem density_hasDerivAt (w : (Fin n → ℝ) → ℝ) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {r : ℝ} (hr : r ≠ 0) (x : Fin n → ℝ) : HasDerivAt (fun t ↦ density w f t x) (densityDeriv w f r x) r := by have ha : HasDerivAt (fun t : ℝ ↦ radiusSq x / t^2) (-2 * radiusSq x / r^3) r := by convert (hasDerivAt_const r (radiusSq x)).div ((hasDerivAt_id r).pow 2) (pow_ne_zero 2 hr) using 1 · funext t rfl · simp only [Pi.pow_apply, id_eq] field_simp <;> ring have hd := ((hf.differentiable (by norm_num) (radiusSq x/r^2)).hasDerivAt.comp r ha).mul_const (w x) convert hd using 1 · funext t rfl · unfold densityDeriv ring theorem density_continuous {w : (Fin n → ℝ) → ℝ} (hw : Continuous w) {f : ℝ → ℝ} (hf : Continuous f) (r : ℝ) : Continuous (density w f r) := (hf.comp (radiusSq_contDiff.continuous.div_const _)).mul hw theorem densityDeriv_continuous {w : (Fin n → ℝ) → ℝ} (hw : Continuous w) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (r : ℝ) : Continuous (densityDeriv w f r) := (((radiusSq_contDiff.continuous.const_mul (-2)).div_const _).mul (hf.continuous_deriv_one.comp (radiusSq_contDiff.continuous.div_const _))).mul hw theorem densityDeriv_continuousAt {w : (Fin n → ℝ) → ℝ} (hw : Continuous w) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (p : ℝ × (Fin n → ℝ)) (hp : p.1 ≠ 0) : ContinuousAt (fun q : ℝ × (Fin n → ℝ) ↦ densityDeriv w f q.1 q.2) p := by have hs := (radiusSq_contDiff.continuous.comp continuous_snd).continuousAt (x := p) have harg := hs.div ((continuous_fst.pow 2).continuousAt) (pow_ne_zero 2 hp) exact ((((hs.const_mul (-2)).div ((continuous_fst.pow 3).continuousAt) (pow_ne_zero 3 hp)).mul (hf.continuous_deriv_one.continuousAt.comp harg)).mul (hw.comp continuous_snd).continuousAt) theorem radialWeight_zero_outside_box {f : ℝ → ℝ} {R b r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hrb : r ≤ b) (hz : ∀ s, R ≤ s → f s = 0) (x : Fin n → ℝ) (hx : x ∉ supportBox n (R*b^2)) : radialWeight f r x = 0 := by change f (radiusSq x / r^2) = 0 simpa only [Source29GraphRadialGeometry.graphRadiusSq, Pi.zero_apply, zero_pow (by decide : 2 ≠ 0), add_zero, radiusSq] using scaled_cutoff_zero_outside_box (0 : (Fin n → ℝ) → ℝ) hR hr hrb hz x hx theorem density_integrable {w : (Fin n → ℝ) → ℝ} (hw : Continuous w) {f : ℝ → ℝ} (hf : Continuous f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ s, R ≤ s → f s = 0) : Integrable (density w f r) := (density_continuous hw hf r).integrable_of_hasCompactSupport (radialWeight_compact hR hr hz).mul_right theorem mass_hasDerivAt {w : (Fin n → ℝ) → ℝ} (hw : Continuous w) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ s, R ≤ s → f s = 0) (hdz : ∀ s, R ≤ s → deriv f s = 0) : Integrable (densityDeriv w f r) ∧ HasDerivAt (mass w f) (∫ x, densityDeriv w f r x) r := by apply Source29CompactParameterIntegral.hasDerivAt_integral (a := r/2) (b := 2*r) (K := supportBox n (R*(2*r)^2)) (by linarith) (by linarith) (supportBox_compact _ _) · intro t ht exact density_continuous hw hf.continuous t · intro t ht exact densityDeriv_continuous hw hf t · intro p hp exact (densityDeriv_continuousAt hw hf p (by linarith [hp.1.1])).continuousWithinAt · intro t ht x hx unfold density rw [radialWeight_zero_outside_box hR (by linarith [ht.1]) ht.2 hz x hx, zero_mul] · intro t ht x hx have hzero := radialWeight_zero_outside_box hR (by linarith [ht.1]) ht.2 hdz x hx change deriv f (radiusSq x/t^2) = 0 at hzero unfold densityDeriv rw [hzero, mul_zero, zero_mul] · intro x t ht exact density_hasDerivAt w hf (by linarith [ht.1]) x end end Source29WeightedRadialDerivative /- Component: LevelRadialMonotonicity.inc -/ namespace Source29LevelRadialMonotonicity open MvPolynomial MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29VariationConvexity Source29WeakCalibrationLimits open Source29PolynomialStress Source29LevelStressStationarity Source29LevelRadialStress open Source29WeightedRadialDerivative Source29PhaseMassLimit Source29SmoothPhaseTransition open scoped Topology noncomputable section variable {n : ℕ} def diffuseWeight (P : MvPolynomial (Fin n) ℝ) (h : ℝ → ℝ) (x : Fin n → ℝ) : ℝ := h (eval x P) * variationDensity (evaluatedGradient P x) theorem diffuseWeight_continuous (P : MvPolynomial (Fin n) ℝ) {h : ℝ → ℝ} (hh : Continuous h) : Continuous (diffuseWeight P h) := (hh.comp (contDiff_eval P).continuous).mul (variationDensity_continuous _ (fun i ↦ (contDiff_eval (pderiv i P)).continuous)) def normalizedDiffuseMass (P : MvPolynomial (Fin (n+1)) ℝ) (h f : ℝ → ℝ) (r : ℝ) : ℝ := mass (diffuseWeight P h) f r / r^n /-- Radial stationarity makes the derivative numerator of normalized mass nonnegative. -/ theorem diffuse_radius_inequality (P : MvPolynomial (Fin (n+1)) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) (hhpos : ∀ t, 0 ≤ h t) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) (hdec : ∀ t, deriv f t ≤ 0) : 0 ≤ r * (∫ x, densityDeriv (diffuseWeight P h) f r x) - (n : ℝ) * mass (diffuseWeight P h) f r := by have hw := diffuseWeight_continuous P hh.continuous have hd := mass_hasDerivAt hw hf hR hr hz hdz have hi := density_integrable hw hf.continuous hR hr hz have hs := weighted_stress_integral_zero P hcal (radialField f r) (radialField_contDiff hf r) (radialField_compact hR hr hz) hh have hpt (x : Fin (n+1) → ℝ) : -(h (eval x P) * stressPair P (radialField f r) x) ≤ r * densityDeriv (diffuseWeight P h) f r x - (n : ℝ) * density (diffuseWeight P h) f r x := by have he : r * densityDeriv (diffuseWeight P h) f r x - (n : ℝ) * density (diffuseWeight P h) f r x + h (eval x P) * stressPair P (radialField f r) x = (-2/r^2) * deriv f (radiusSq x/r^2) * (Source29NormalPenalty.dot (leadingNormalizedField P x) x)^2 * diffuseWeight P h x := by rw [stressPair_radial P hf] unfold densityDeriv density diffuseWeight Source29LevelRadialStress.radialWeight have hn := hr.ne' field_simp <;> ring have hwp : 0 ≤ diffuseWeight P h x := mul_nonneg (hhpos _) (Real.sqrt_nonneg _) have hp : 0 ≤ (-2/r^2) * deriv f (radiusSq x/r^2) * (Source29NormalPenalty.dot (leadingNormalizedField P x) x)^2 * diffuseWeight P h x := mul_nonneg (mul_nonneg (mul_nonneg_of_nonpos_of_nonpos (div_nonpos_of_nonpos_of_nonneg (by norm_num) (sq_nonneg r)) (hdec _)) (sq_nonneg _)) hwp linarith have hm := integral_mono hs.1.neg ((hd.1.const_mul r).sub (hi.const_mul (n : ℝ))) hpt simp only [Pi.neg_apply, Pi.sub_apply] at hm rw [integral_neg, hs.2, neg_zero, integral_sub (hd.1.const_mul r) (hi.const_mul (n : ℝ)), integral_const_mul, integral_const_mul] at hm exact hm theorem normalizedDiffuseMass_monotoneOn (P : MvPolynomial (Fin (n+1)) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) (hhpos : ∀ t, 0 ≤ h t) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) (hdec : ∀ t, deriv f t ≤ 0) : MonotoneOn (normalizedDiffuseMass P h f) (Ioi 0) := by have hd (r : ℝ) (hr : 0 < r) := Source29GraphMassMonotonicity.normalized_hasDerivAt (mass_hasDerivAt (diffuseWeight_continuous P hh.continuous) hf hR hr hz hdz).2 hr.ne' n apply monotoneOn_of_deriv_nonneg (convex_Ioi (0 : ℝ)) · intro r hr exact (hd r hr).continuousAt.continuousWithinAt · intro r hr exact (hd r (by simpa only [interior_Ioi, mem_Ioi] using hr)).differentiableAt.differentiableWithinAt · intro r hr have hr' : 0 < r := by simpa only [interior_Ioi, mem_Ioi] using hr change 0 ≤ deriv (fun t ↦ mass (diffuseWeight P h) f t / t^n) r rw [(hd r hr').deriv] exact div_nonneg (diffuse_radius_inequality P hcal hh hhpos hf hR hr' hz hdz hdec) (pow_pos hr' _).le def normalizedPhaseMass (P : MvPolynomial (Fin (n+1)) ℝ) (f : ℝ → ℝ) (r : ℝ) : ℝ := phaseMass P (radialWeight f r) / r^n theorem normalizedDiffuseMass_tendsto (P : MvPolynomial (Fin (n+1)) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ t, R ≤ t → f t = 0) : Tendsto (fun k ↦ normalizedDiffuseMass P (deriv (transition k)) f r) atTop (𝓝 (normalizedPhaseMass P f r)) := by have ht := phaseMass_tendsto P hP hcal (radialWeight_contDiff hf r) (radialWeight_compact hR hr hz) unfold normalizedPhaseMass convert ht.div_const (r^n) using 1 funext k unfold normalizedDiffuseMass mass congr 1 apply integral_congr_ae exact Filter.Eventually.of_forall fun x ↦ by unfold density diffuseWeight; ring /-- Smoothed perimeter divided by radius to the hypersurface dimension is monotone. -/ theorem normalizedPhaseMass_monotoneOn (P : MvPolynomial (Fin (n+1)) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) (hdec : ∀ t, deriv f t ≤ 0) : MonotoneOn (normalizedPhaseMass P f) (Ioi 0) := by intro r hr s hs hrs apply le_of_tendsto_of_tendsto (normalizedDiffuseMass_tendsto P hP hcal hf hR hr hz) (normalizedDiffuseMass_tendsto P hP hcal hf hR hs hz) exact Filter.Eventually.of_forall fun k ↦ normalizedDiffuseMass_monotoneOn P hcal (transition_deriv_contDiff k) (transition_deriv_nonneg k) hf hR hz hdz hdec hr hs hrs end end Source29LevelRadialMonotonicity /- Component: LeadingLevelRadialMonotonicity.inc -/ namespace Source29LeadingLevelRadialMonotonicity open MvPolynomial Set open Source29QuarticReuse.FluxObstruction open Source29PolynomialTranslation Source29WeakCalibrationLimits Source29TopLocalInitial open Source29LeadingLevelPerimeter Source29LevelRadialMonotonicity open Source29PolynomialGraphMonotonicity noncomputable section variable {n : ℕ} theorem translated_level_ne_zero (P : MvPolynomial (Fin n) ℝ) (hd : 2 ≤ P.totalDegree) (t : ℝ) (c : Fin n → ℝ) : translate (levelPolynomial P t) c ≠ 0 := translate_ne_zero (levelPolynomial P t) c (levelPolynomial_ne_zero P hd t) /-- Translation and subtraction of a level leave exactly the translated normalized gradient of the leading homogeneous polynomial. -/ theorem translated_level_normalizedField (P : MvPolynomial (Fin n) ℝ) (t : ℝ) (c : Fin n → ℝ) : leadingNormalizedField (translate (levelPolynomial P t) c) = fun x => leadingNormalizedField (homogeneousComponent P.totalDegree P) (c + x) := by funext x rw [leadingNormalizedField_translate, levelPolynomial_normalizedField] theorem translated_level_weakCalibration (P : MvPolynomial (Fin n) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hd : 2 ≤ P.totalDegree) (t : ℝ) (c : Fin n → ℝ) : WeakCalibration (leadingNormalizedField (translate (levelPolynomial P t) c)) := by rw [translated_level_normalizedField] simpa only [one_smul] using top_affine_weakCalibration P hmin hd c 1 one_ne_zero /-- Every leading level of a full polynomial minimal graph has monotone normalized smoothed phase mass about every center. The level may be singular. -/ theorem translated_level_normalizedPhaseMass_monotoneOn (P : MvPolynomial (Fin (n + 1)) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hd : 2 ≤ P.totalDegree) (t : ℝ) (c : Fin (n + 1) → ℝ) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ s, R ≤ s → f s = 0) (hdz : ∀ s, R ≤ s → deriv f s = 0) (hdec : ∀ s, deriv f s ≤ 0) : MonotoneOn (normalizedPhaseMass (translate (levelPolynomial P t) c) f) (Ioi 0) := normalizedPhaseMass_monotoneOn (translate (levelPolynomial P t) c) (translated_level_ne_zero P hd t c) (translated_level_weakCalibration P hmin hd t c) hf hR hz hdz hdec theorem translated_level_radialMass_monotoneOn (P : MvPolynomial (Fin (n + 1)) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hd : 2 ≤ P.totalDegree) (t : ℝ) (c : Fin (n + 1) → ℝ) : MonotoneOn (normalizedPhaseMass (translate (levelPolynomial P t) c) radialCutoff) (Ioi 0) := translated_level_normalizedPhaseMass_monotoneOn P hmin hd t c radialCutoff_contDiff (R := 2) (by norm_num) radialCutoff_zero radialCutoff_deriv_zero radialCutoff_deriv_nonpos end end Source29LeadingLevelRadialMonotonicity /- Component: PhaseMassDilation.inc -/ namespace Source29PhaseMassDilation open MvPolynomial MeasureTheory open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29LevelRadialStress Source29LevelRadialMonotonicity Source29PhaseMassLimit open scoped BigOperators noncomputable section variable {n : ℕ} /-- The phase flux on the unit radial scale after dilating its field and phase. -/ def rescaledPhaseMass (P : MvPolynomial (Fin (n+1)) ℝ) (f : ℝ → ℝ) (r : ℝ) : ℝ := -(∫ x, testFlux (fun i ↦ Pi.single i 1) (radialWeight f 1) (fun y ↦ leadingNormalizedField P (r • y)) x * (if 0 < eval (r • x) P then 1 else 0)) lemma radiusSq_dilate {r : ℝ} (hr : r ≠ 0) (x : Fin n → ℝ) : radiusSq (r • x) / r^2 = radiusSq x := by simp only [radiusSq, Pi.smul_apply, smul_eq_mul, mul_pow, ← Finset.mul_sum] field_simp lemma testFlux_radial_dilate {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (F : (Fin n → ℝ) → Fin n → ℝ) {r : ℝ} (hr : r ≠ 0) (x : Fin n → ℝ) : r * testFlux (fun i ↦ Pi.single i 1) (radialWeight f r) F (r • x) = testFlux (fun i ↦ Pi.single i 1) (radialWeight f 1) (fun y ↦ F (r • y)) x := by simp only [testFlux, radialWeight_fderiv hf, radiusSq_dilate hr, one_pow, div_one, Pi.smul_apply, smul_eq_mul, Finset.mul_sum] apply Finset.sum_congr rfl intro i _ field_simp <;> ring /-- The ambient Jacobian contributes r^(n+1), while the radial differential contributes r⁻¹. Thus the normalized phase mass is a fixed-scale flux integral. -/ theorem normalizedPhaseMass_eq_rescaled (P : MvPolynomial (Fin (n+1)) ℝ) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {r : ℝ} (hr : 0 < r) : normalizedPhaseMass P f r = rescaledPhaseMass P f r := by let g : (Fin (n+1) → ℝ) → ℝ := fun x ↦ testFlux (fun i ↦ Pi.single i 1) (radialWeight f r) (leadingNormalizedField P) x * (if 0 < eval x P then 1 else 0) have he := Measure.integral_comp_smul_of_nonneg volume g r (hR := hr.le) simp only [Module.finrank_pi, Module.finrank_self, Fintype.card_fin, mul_one, smul_eq_mul] at he have halgebra (a : ℝ) : -a / r^n = -(r * ((r^(n+1))⁻¹ * a)) := by rw [pow_succ] field_simp <;> ring change -(∫ x, g x) / r^n = _ rw [halgebra, ← he, ← integral_const_mul] unfold rescaledPhaseMass congr 1 apply integral_congr_ae exact Filter.Eventually.of_forall fun x ↦ by dsimp only [g] rw [← mul_assoc, testFlux_radial_dilate hf _ hr.ne'] end end Source29PhaseMassDilation /- Component: InitialPhaseFluxLimit.inc -/ namespace Source29InitialPhaseFluxLimit open MvPolynomial MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29WeakCalibrationLimits Source29InitialGradientLimit Source29RealLowestRescale open Source29PhaseMassLimit open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem normalizedField_smul_measurable (P : MvPolynomial (Fin n) ℝ) (r : ℝ) (i : Fin n) : Measurable (fun x : Fin n → ℝ ↦ leadingNormalizedField P (r • x) i) := by have hg (j : Fin n) : Continuous (fun x : Fin n → ℝ ↦ evaluatedGradient P (r • x) j) := (contDiff_eval (pderiv j P)).continuous.comp (by fun_prop) have hs : Continuous (fun x : Fin n → ℝ ↦ radiusSq (evaluatedGradient P (r • x))) := by exact continuous_finsetSum _ (fun j _ ↦ (hg j).pow 2) exact (hg i).measurable.div hs.sqrt.measurable theorem scaled_phase_measurable (P : MvPolynomial (Fin n) ℝ) (r : ℝ) : Measurable (fun x : Fin n → ℝ ↦ if 0 < eval (r • x) P then (1 : ℝ) else 0) := by have hc : Continuous (fun x : Fin n → ℝ ↦ eval (r • x) P) := (contDiff_eval P).continuous.comp (by fun_prop) exact Measurable.ite (isOpen_lt continuous_const hc).measurableSet measurable_const measurable_const theorem scaled_flux_measurable (P : MvPolynomial (Fin n) ℝ) (r : ℝ) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) : Measurable (testFlux (fun i ↦ Pi.single i 1) ρ (fun x ↦ leadingNormalizedField P (r • x))) := by apply Finset.measurable_sum intro i hi exact ((hρ.continuous_fderiv (by norm_num)).clm_apply continuous_const).measurable.mul (normalizedField_smul_measurable P r i) theorem scaled_phase_initial_limit (P : MvPolynomial (Fin n) ℝ) (s : ℕ) (hlow : ∀ k < s+1, homogeneousComponent k P = 0) {t : ℕ → ℝ} (ht : ∀ k, 0 < t k) (ht0 : Tendsto t atTop (𝓝 0)) (x : Fin n → ℝ) (hx : eval x (homogeneousComponent (s+1) P) ≠ 0) : Tendsto (fun k ↦ if 0 < eval (t k • x) P then (1 : ℝ) else 0) atTop (𝓝 (if 0 < eval x (homogeneousComponent (s+1) P) then (1 : ℝ) else 0)) := by have hl := ((continuous_eval_rescale P (s+1) x).tendsto 0).comp ht0 rw [rescale_zero P (s+1) hlow] at hl have he (k : ℕ) : (0 < eval (t k • x) P) ↔ 0 < eval x (rescale P (s+1) (t k)) := by change (0 < eval (fun i ↦ t k * x i) P) ↔ _ rw [← eval_rescale_mul P (s+1) hlow] exact mul_pos_iff_of_pos_left (pow_pos (ht k) _) by_cases hp : 0 < eval x (homogeneousComponent (s+1) P) · have hpos := hl.eventually (eventually_gt_nhds hp) apply tendsto_const_nhds.congr' filter_upwards [hpos] with k hk simp only [ite_eq_left hp, ite_eq_left ((he k).mpr hk)] · have hn : eval x (homogeneousComponent (s+1) P) < 0 := lt_of_le_of_ne (le_of_not_gt hp) hx have hneg := hl.eventually (eventually_lt_nhds hn) apply tendsto_const_nhds.congr' filter_upwards [hneg] with k hk simp only [ite_eq_right hp, ite_eq_right (fun h ↦ (not_lt_of_ge hk.le) ((he k).mp h))] /-- Every polynomial's phase flux converges under shrinking dilations to the flux of its first nonzero positive-degree homogeneous component. -/ theorem phaseFlux_initial_limit (P : MvPolynomial (Fin n) ℝ) (s : ℕ) (hlow : ∀ k < s+1, homogeneousComponent k P = 0) (hne : homogeneousComponent (s+1) P ≠ 0) {t : ℕ → ℝ} (ht : ∀ k, 0 < t k) (ht0 : Tendsto t atTop (𝓝 0)) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) : Tendsto (fun k ↦ -(∫ x, testFlux (fun i ↦ Pi.single i 1) ρ (fun y ↦ leadingNormalizedField P (t k • y)) x * (if 0 < eval (t k • x) P then 1 else 0))) atTop (𝓝 (phaseMass (homogeneousComponent (s+1) P) ρ)) := by apply Tendsto.neg apply tendsto_integral_of_dominated_convergence (testBound (fun i ↦ Pi.single i 1) ρ) · intro k exact ((scaled_flux_measurable P (t k) hρ).mul (scaled_phase_measurable P (t k))).aestronglyMeasurable · exact testBound_integrable _ hρ hcρ · intro k exact Filter.Eventually.of_forall fun x ↦ by rw [norm_mul] have hb := norm_testFlux_le_testBound (fun i ↦ Pi.single i 1) ρ (fun y ↦ leadingNormalizedField P (t k • y)) x (leadingNormalizedField_bound P _) split_ifs · simpa using hb · simpa using (norm_nonneg _).trans hb · filter_upwards [normalized_gradient_initial_limit_ae P s hlow hne ht ht0, mvPolynomial_eval_ne_zero_ae n _ hne] with x hx hpx exact (testFlux_tendsto (fun i ↦ Pi.single i 1) ρ hx).mul (scaled_phase_initial_limit P s hlow ht ht0 x hpx) end end Source29InitialPhaseFluxLimit /- Component: InitialRadialMassLimit.inc -/ namespace Source29InitialRadialMassLimit open MvPolynomial MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29LevelRadialStress Source29LevelRadialMonotonicity Source29PhaseMassDilation open Source29InitialPhaseFluxLimit Source29PhaseMassLimit open scoped Topology noncomputable section variable {n : ℕ} /-- The normalized radial phase mass tends to the mass of the first nonzero homogeneous term under any sequence of positive dilations approaching zero. -/ theorem normalizedPhaseMass_initial_limit (P : MvPolynomial (Fin (n+1)) ℝ) (s : ℕ) (hlow : ∀ k < s+1, homogeneousComponent k P = 0) (hne : homogeneousComponent (s+1) P ≠ 0) {t : ℕ → ℝ} (ht : ∀ k, 0 < t k) (ht0 : Tendsto t atTop (𝓝 0)) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ a, R ≤ a → f a = 0) : Tendsto (fun k ↦ normalizedPhaseMass P f (t k)) atTop (𝓝 (phaseMass (homogeneousComponent (s+1) P) (radialWeight f 1))) := by have hl := phaseFlux_initial_limit P s hlow hne ht ht0 (radialWeight_contDiff hf 1) (radialWeight_compact hR zero_lt_one hz) have he : (fun k ↦ normalizedPhaseMass P f (t k)) = fun k ↦ rescaledPhaseMass P f (t k) := by funext k exact normalizedPhaseMass_eq_rescaled P hf (ht k) rw [he] exact hl /-- At every scale, monotonicity bounds the mass of the tangent polynomial by the normalized phase mass of the calibrated polynomial. -/ theorem initial_phaseMass_le_normalized (P : MvPolynomial (Fin (n+1)) ℝ) (s : ℕ) (hlow : ∀ k < s+1, homogeneousComponent k P = 0) (hne : homogeneousComponent (s+1) P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ a, R ≤ a → f a = 0) (hdz : ∀ a, R ≤ a → deriv f a = 0) (hdec : ∀ a, deriv f a ≤ 0) {r : ℝ} (hr : 0 < r) : phaseMass (homogeneousComponent (s+1) P) (radialWeight f 1) ≤ normalizedPhaseMass P f r := by have hP : P ≠ 0 := by intro hp apply hne simp [hp] let t : ℕ → ℝ := fun k ↦ (Source29QuarticReuse.FluxPolynomial.dilationRadius k)⁻¹ have ht (k : ℕ) : 0 < t k := inv_pos.mpr (Source29QuarticReuse.FluxPolynomial.dilationRadius_pos k) have ht0 : Tendsto t atTop (𝓝 0) := tendsto_inv_atTop_zero.comp Source29QuarticReuse.FluxPolynomial.dilationRadius_tendsto apply le_of_tendsto (normalizedPhaseMass_initial_limit P s hlow hne ht ht0 hf hR hz) filter_upwards [ht0.eventually (eventually_lt_nhds hr)] with k hk exact normalizedPhaseMass_monotoneOn P hP hcal hf hR hz hdz hdec (ht k) hr hk.le end end Source29InitialRadialMassLimit /- Component: LinearRadialMass.inc -/ namespace Source29LinearRadialMass open Matrix MvPolynomial MeasureTheory open Source29QuarticReuse.FluxObstruction Source29LinearForm open Source29LinearNormalRotation Source29LinearEndpointRotation Source29LinearPhaseMass open Source29CoordinatePhaseMass Source29PhaseMassLimit Source29PolynomialSmallDensity open Source29LevelRadialStress open scoped BigOperators noncomputable section variable {n : ℕ} lemma radialWeight_rotation (f : ℝ → ℝ) (r : ℝ) (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U.transpose * U = 1) (x : Fin (n+1) → ℝ) : radialWeight f r (U *ᵥ x) = radialWeight f r x := by unfold Source29LevelRadialStress.radialWeight rw [radiusSq_mulVec U hU x] lemma radialWeight_testFlux_rotation {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (r : ℝ) (a : Fin (n+1) → ℝ) (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U.transpose * U = 1) (hcol : ∀ i, U i 0 = unitVector a i) (x : Fin (n+1) → ℝ) : testFlux (fun i ↦ Pi.single i 1) (radialWeight f r) (leadingNormalizedField (linearForm a)) (U *ᵥ x) = fderiv ℝ (radialWeight f r) x (Pi.single 0 1) := by have hn : leadingNormalizedField (linearForm a) = fun _ ↦ unitVector a := by funext y exact normalizedField_linearForm a y rw [hn, testFlux_const] let L : (Fin (n+1) → ℝ) →L[ℝ] (Fin (n+1) → ℝ) := (Matrix.toLin' U).toContinuousLinearMap have hp := ((radialWeight_contDiff hf r).differentiable (by norm_num) (U *ᵥ x)).hasFDerivAt.comp x L.hasFDerivAt have he : (fun y ↦ radialWeight f r (L y)) = radialWeight f r := by funext y exact radialWeight_rotation f r U hU y change HasFDerivAt (fun y ↦ radialWeight f r (L y)) _ x at hp rw [he] at hp have hb := congrArg (fun D : (Fin (n+1) → ℝ) →L[ℝ] ℝ ↦ D (Pi.single 0 1)) hp.fderiv change fderiv ℝ (radialWeight f r) x (Pi.single 0 1) = fderiv ℝ (radialWeight f r) (U *ᵥ x) (U *ᵥ Pi.single 0 1) at hb rw [column_mulVec a U hcol] at hb exact hb.symm /-- Rotation identifies the unit-scale radial phase mass of any nonzero linear form with that of the first coordinate. -/ theorem phaseMass_linearForm_eq_coordinate (a : Fin (n+1) → ℝ) (ha : a ≠ 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ s, R ≤ s → f s = 0) : phaseMass (linearForm a) (radialWeight f 1) = phaseMass (X (0 : Fin (n+1))) (radialWeight f 1) := by obtain ⟨U,hU,hUt,hcol⟩ := exists_rotation a ha let W := testFlux (fun i ↦ Pi.single i 1) (radialWeight f 1) (leadingNormalizedField (linearForm a)) let J := fun x ↦ W x * (if 0 < eval x (linearForm a) then 1 else 0) have hW : Integrable W := linear_flux_integrable a (radialWeight_contDiff hf 1) (radialWeight_compact hR zero_lt_one hz) have hJ : Integrable J := Source29PhaseApproximation.phase_weight_integrable (linearForm a) (linearForm_ne_zero_of_vector a ha) W hW have hr : 0 < Real.sqrt (radiusSq a) := Real.sqrt_pos.mpr (radiusSq_pos_of_ne_zero ha) have he (x : Fin (n+1) → ℝ) : J (U *ᵥ x) = fderiv ℝ (radialWeight f 1) x (Pi.single 0 1) * (if 0 < x 0 then 1 else 0) := by dsimp only [J,W] rw [radialWeight_testFlux_rotation hf 1 a U hU hcol x, linearForm_eval_rotation a ha U hU hcol x] simp only [mul_pos_iff_of_pos_left hr] have hi := integral_comp_rotation U hU hJ.aestronglyMeasurable change -(∫ x, J x) = _ rw [← hi] simp_rw [he] simp only [phaseMass, testFlux_X, eval_X] /-- A nonzero linear form has exactly the radial mass of an n-dimensional plane, for an arbitrary compactly supported C1 radial cutoff. -/ theorem phaseMass_linearForm (a : Fin (n+1) → ℝ) (ha : a ≠ 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ s, R ≤ s → f s = 0) : phaseMass (linearForm a) (radialWeight f 1) = planeMass n f := by rw [phaseMass_linearForm_eq_coordinate a ha hf hR hz, phaseMass_X (radialWeight_contDiff hf 1) (radialWeight_compact hR zero_lt_one hz)] unfold planeMass apply integral_congr_ae exact Filter.Eventually.of_forall fun x ↦ by simp [Source29LevelRadialStress.radialWeight, radiusSq, Fin.sum_univ_succ] end end Source29LinearRadialMass /- Component: RegularPhaseDensity.inc -/ namespace Source29RegularPhaseDensity open MvPolynomial MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.QuarticPolynomialBasics open Source29LinearForm Source29LinearPhaseMass Source29LinearRadialMass open Source29WeakCalibrationLimits Source29LevelRadialStress Source29LevelRadialMonotonicity open Source29InitialRadialMassLimit Source29PolynomialSmallDensity Source29PolynomialGraphMonotonicity open Source29PolynomialTranslation Source29LeadingLevelPerimeter Source29LeadingLevelRadialMonotonicity open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- The linear Taylor term is the linear form given by the gradient at zero. -/ theorem homogeneousComponent_one_eq_linearForm (P : MvPolynomial (Fin n) ℝ) : homogeneousComponent 1 P = linearForm (evaluatedGradient P 0) := by rw [Source29QuarticReuse.QuarticMinimal.homogeneous_linear_expansion _ (homogeneousComponent_isHomogeneous 1 P)] unfold linearForm apply Finset.sum_congr rfl intro i _ rw [pderiv_homogeneousComponent P i 0, homogeneousComponent_zero] simp [evaluatedGradient, eval_zero, constantCoeff_eq] theorem homogeneousComponent_zero_eq_zero (P : MvPolynomial (Fin n) ℝ) (hP : eval 0 P = 0) : homogeneousComponent 0 P = 0 := by rw [homogeneousComponent_zero] have hc : P.coeff 0 = 0 := by simpa only [eval_zero, constantCoeff_eq] using hP rw [hc, map_zero] theorem homogeneousComponent_one_ne_zero (P : MvPolynomial (Fin (n + 1)) ℝ) (hreg : evaluatedGradient P 0 ≠ 0) : homogeneousComponent 1 P ≠ 0 := by rw [homogeneousComponent_one_eq_linearForm] exact linearForm_ne_zero_of_vector _ hreg /-- At a regular zero, every sequence of positive radii approaching zero has the plane mass as its normalized radial phase-mass limit. No calibration hypothesis is needed for this local density calculation. -/ theorem normalizedPhaseMass_regular_limit (P : MvPolynomial (Fin (n + 1)) ℝ) (hP : eval 0 P = 0) (hreg : evaluatedGradient P 0 ≠ 0) {t : ℕ → ℝ} (ht : ∀ k, 0 < t k) (ht0 : Tendsto t atTop (𝓝 0)) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ a, R ≤ a → f a = 0) : Tendsto (fun k => normalizedPhaseMass P f (t k)) atTop (𝓝 (planeMass n f)) := by have hlow : ∀ k < 0 + 1, homogeneousComponent k P = 0 := by intro k hk have hk0 : k = 0 := by omega subst k exact homogeneousComponent_zero_eq_zero P hP have hl := normalizedPhaseMass_initial_limit P 0 hlow (homogeneousComponent_one_ne_zero P hreg) ht ht0 hf hR hz simpa only [Nat.zero_add, homogeneousComponent_one_eq_linearForm, phaseMass_linearForm (evaluatedGradient P 0) hreg hf hR hz] using hl /-- For a calibrated polynomial, the density of its regular zero gives a plane-mass lower bound at every positive radius. -/ theorem planeMass_le_normalizedPhaseMass (P : MvPolynomial (Fin (n + 1)) ℝ) (hP : eval 0 P = 0) (hreg : evaluatedGradient P 0 ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ a, R ≤ a → f a = 0) (hdz : ∀ a, R ≤ a → deriv f a = 0) (hdec : ∀ a, deriv f a ≤ 0) {r : ℝ} (hr : 0 < r) : planeMass n f ≤ normalizedPhaseMass P f r := by have hlow : ∀ k < 0 + 1, homogeneousComponent k P = 0 := by intro k hk have hk0 : k = 0 := by omega subst k exact homogeneousComponent_zero_eq_zero P hP have hl := initial_phaseMass_le_normalized P 0 hlow (homogeneousComponent_one_ne_zero P hreg) hcal hf hR hz hdz hdec hr simpa only [Nat.zero_add, homogeneousComponent_one_eq_linearForm, phaseMass_linearForm (evaluatedGradient P 0) hreg hf hR hz] using hl theorem radialCutoff_regular_limit (P : MvPolynomial (Fin (n + 1)) ℝ) (hP : eval 0 P = 0) (hreg : evaluatedGradient P 0 ≠ 0) {t : ℕ → ℝ} (ht : ∀ k, 0 < t k) (ht0 : Tendsto t atTop (𝓝 0)) : Tendsto (fun k => normalizedPhaseMass P radialCutoff (t k)) atTop (𝓝 (planeMass n radialCutoff)) := normalizedPhaseMass_regular_limit P hP hreg ht ht0 radialCutoff_contDiff (R := 2) (by norm_num) radialCutoff_zero theorem planeMass_le_radialCutoff (P : MvPolynomial (Fin (n + 1)) ℝ) (hP : eval 0 P = 0) (hreg : evaluatedGradient P 0 ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {r : ℝ} (hr : 0 < r) : planeMass n radialCutoff ≤ normalizedPhaseMass P radialCutoff r := planeMass_le_normalizedPhaseMass P hP hreg hcal radialCutoff_contDiff (R := 2) (by norm_num) radialCutoff_zero radialCutoff_deriv_zero radialCutoff_deriv_nonpos hr theorem translated_level_eval_zero (P : MvPolynomial (Fin n) ℝ) (t : ℝ) (c : Fin n → ℝ) (hc : eval c (homogeneousComponent P.totalDegree P) = t) : eval 0 (translate (levelPolynomial P t) c) = 0 := by rw [eval_zero_translate] simp only [levelPolynomial, map_sub, eval_C, hc, sub_self] theorem translated_level_gradient_zero (P : MvPolynomial (Fin n) ℝ) (t : ℝ) (c : Fin n → ℝ) : evaluatedGradient (translate (levelPolynomial P t) c) 0 = evaluatedGradient (homogeneousComponent P.totalDegree P) c := by rw [← levelPolynomial_gradient P t] funext i change eval 0 (pderiv i (translate (levelPolynomial P t) c)) = eval c (pderiv i (levelPolynomial P t)) rw [pderiv_translate, eval_zero_translate] /-- Every point on a nonzero leading level has plane density. This local statement uses homogeneity and regularity, without a minimality hypothesis. -/ theorem translated_nonzero_level_regular_limit (P : MvPolynomial (Fin (n + 1)) ℝ) (hd : 2 ≤ P.totalDegree) {t : ℝ} (ht : t ≠ 0) (c : Fin (n + 1) → ℝ) (hc : eval c (homogeneousComponent P.totalDegree P) = t) {a : ℕ → ℝ} (ha : ∀ k, 0 < a k) (ha0 : Tendsto a atTop (𝓝 0)) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ b, R ≤ b → f b = 0) : Tendsto (fun k => normalizedPhaseMass (translate (levelPolynomial P t) c) f (a k)) atTop (𝓝 (planeMass n f)) := by apply normalizedPhaseMass_regular_limit _ (translated_level_eval_zero P t c hc) _ ha ha0 hf hR hz rw [translated_level_gradient_zero] exact top_nonzero_level_gradient P hd ht hc /-- Every nonzero leading level of a polynomial minimal graph has at least plane mass at every positive radius about each point of the level. -/ theorem planeMass_le_translated_nonzero_level (P : MvPolynomial (Fin (n + 1)) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hd : 2 ≤ P.totalDegree) {t : ℝ} (ht : t ≠ 0) (c : Fin (n + 1) → ℝ) (hc : eval c (homogeneousComponent P.totalDegree P) = t) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ b, R ≤ b → f b = 0) (hdz : ∀ b, R ≤ b → deriv f b = 0) (hdec : ∀ b, deriv f b ≤ 0) {r : ℝ} (hr : 0 < r) : planeMass n f ≤ normalizedPhaseMass (translate (levelPolynomial P t) c) f r := by apply planeMass_le_normalizedPhaseMass _ (translated_level_eval_zero P t c hc) _ (translated_level_weakCalibration P hmin hd t c) hf hR hz hdz hdec hr rw [translated_level_gradient_zero] exact top_nonzero_level_gradient P hd ht hc theorem planeMass_le_translated_nonzero_level_radialCutoff (P : MvPolynomial (Fin (n + 1)) ℝ) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hd : 2 ≤ P.totalDegree) {t : ℝ} (ht : t ≠ 0) (c : Fin (n + 1) → ℝ) (hc : eval c (homogeneousComponent P.totalDegree P) = t) {r : ℝ} (hr : 0 < r) : planeMass n radialCutoff ≤ normalizedPhaseMass (translate (levelPolynomial P t) c) radialCutoff r := planeMass_le_translated_nonzero_level P hmin hd ht c hc radialCutoff_contDiff (R := 2) (by norm_num) radialCutoff_zero radialCutoff_deriv_zero radialCutoff_deriv_nonpos hr end end Source29RegularPhaseDensity /- Component: PolynomialOdeNonvanishing.inc -/ namespace Source29PolynomialOdeNonvanishing open Polynomial /-- A nonzero polynomial solution of A g' = B g cannot vanish at a point where A is nonzero. Root multiplicity drops under differentiation in characteristic zero, whereas multiplication by A preserves it at that point. -/ theorem eval_ne_zero_of_derivative_mul_eq {K : Type*} [Field K] [CharZero K] (A B g : Polynomial K) (a : K) (hg : g ≠ 0) (hA : A.eval a ≠ 0) (hode : A * g.derivative = B * g) : g.eval a ≠ 0 := by intro hga apply hA have hdiv : g ∣ g.derivative * A := by refine ⟨B, ?_⟩ rw [mul_comm g.derivative A, hode, mul_comm B g] exact Polynomial.isRoot_of_isRoot_of_dvd_derivative_mul hg hdiv hga end Source29PolynomialOdeNonvanishing /- Component: NewtonNormalDerivative.inc -/ namespace Source29NewtonNormalDerivative open MvPolynomial open Source29QuarticReuse Source29QuarticReuse.QuarticMinimal.DistinguishedVariable open Source29PolynomialOdeNonvanishing open scoped BigOperators noncomputable section variable {n : ℕ} /-- Fix the tangential variables and retain the normal variable, indexed by zero. -/ def sliceHom (y : Fin n → ℝ) : MvPolynomial (Fin (n + 1)) ℝ →+* Polynomial ℝ := (Polynomial.mapRingHom (eval y)).comp (finSuccEquiv ℝ n).toRingHom lemma eval_sliceHom (N : MvPolynomial (Fin (n + 1)) ℝ) (y : Fin n → ℝ) (x : ℝ) : (sliceHom y N).eval x = eval (Fin.cons x y) N := by change ((finSuccEquiv ℝ n N).map (eval y)).eval x = _ calc _ = eval y ((finSuccEquiv ℝ n N).eval (C x)) := by simpa only [eval_C] using (Polynomial.eval_map_apply (f := eval y) (p := finSuccEquiv ℝ n N) (C x)) _ = _ := by rw [Source29QuarticReuse.QuarticCompatibility.eval_polynomial_eval_finSuccEquiv] simp only [eval_C] apply congrArg (fun v : Fin (n + 1) → ℝ => eval v N) funext i exact Fin.cases rfl (fun j => rfl) i lemma sliceHom_pderiv_zero (N : MvPolynomial (Fin (n + 1)) ℝ) (y : Fin n → ℝ) : sliceHom y (pderiv 0 N) = (sliceHom y N).derivative := by change (finSuccEquiv ℝ n (pderiv 0 N)).map (eval y) = ((finSuccEquiv ℝ n N).map (eval y)).derivative rw [finSuccEquiv_pderiv_zero, Polynomial.derivative_map] def tangentialEnergy (N : MvPolynomial (Fin (n + 1)) ℝ) : MvPolynomial (Fin (n + 1)) ℝ := ∑ i : Fin n, (pderiv i.succ N) ^ 2 def tangentialLaplacian (N : MvPolynomial (Fin (n + 1)) ℝ) : MvPolynomial (Fin (n + 1)) ℝ := ∑ i : Fin n, pderiv i.succ (pderiv i.succ N) def tangentialMixed (N : MvPolynomial (Fin (n + 1)) ℝ) : MvPolynomial (Fin (n + 1)) ℝ := ∑ i : Fin n, pderiv i.succ N * pderiv i.succ (pderiv 0 N) /-- The Newton-face equation appearing after the normal/tangential scaling. -/ def newtonResidual (N : MvPolynomial (Fin (n + 1)) ℝ) : MvPolynomial (Fin (n + 1)) ℝ := (pderiv 0 N)^2 * tangentialLaplacian N - 2 * pderiv 0 N * tangentialMixed N + pderiv 0 (pderiv 0 N) * tangentialEnergy N def normalDrift (N : MvPolynomial (Fin (n + 1)) ℝ) : MvPolynomial (Fin (n + 1)) ℝ := 2 * tangentialMixed N - pderiv 0 N * tangentialLaplacian N lemma newtonResidual_eq (N : MvPolynomial (Fin (n + 1)) ℝ) : newtonResidual N = tangentialEnergy N * pderiv 0 (pderiv 0 N) - normalDrift N * pderiv 0 N := by unfold newtonResidual normalDrift ring /-- On a fixed tangential slice, the Newton equation is the exact polynomial ODE A*g'=B*g, where A is tangential gradient energy and g is the normal derivative. -/ theorem slice_derivative_ode (N : MvPolynomial (Fin (n + 1)) ℝ) (hE : newtonResidual N = 0) (y : Fin n → ℝ) : sliceHom y (tangentialEnergy N) * (sliceHom y (pderiv 0 N)).derivative = sliceHom y (normalDrift N) * sliceHom y (pderiv 0 N) := by have h := congrArg (sliceHom y) hE rw [newtonResidual_eq, map_sub, map_mul, map_mul, map_zero, sliceHom_pderiv_zero] at h exact sub_eq_zero.mp h def WeightedEuler (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) : Prop := C α * X 0 * pderiv 0 N + (∑ i : Fin n, X i.succ * pderiv i.succ N) = C D * N /-- At a nonzero value with zero normal derivative, weighted Euler forces strictly positive tangential gradient energy. -/ theorem tangentialEnergy_pos_of_normal_zero (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hD : D ≠ 0) (hEuler : WeightedEuler N α D) (z : Fin (n + 1) → ℝ) (hN : eval z N ≠ 0) (hg : eval z (pderiv 0 N) = 0) : 0 < eval z (tangentialEnergy N) := by have hex : ∃ i : Fin n, eval z (pderiv i.succ N) ≠ 0 := by by_contra hn have hz : ∀ i : Fin n, eval z (pderiv i.succ N) = 0 := by intro i exact not_ne_iff.mp (fun hi => hn ⟨i, hi⟩) have he := congrArg (eval z) hEuler change eval z (C α * X 0 * pderiv 0 N + (∑ i : Fin n, X i.succ * pderiv i.succ N)) = eval z (C D * N) at he simp only [map_add, map_mul, map_sum, eval_C, eval_X, hg, hz, mul_zero, Finset.sum_const_zero, add_zero] at he exact (mul_ne_zero hD hN) he.symm obtain ⟨i, hi⟩ := hex simp only [tangentialEnergy, map_sum, map_pow] exact Finset.sum_pos' (fun j _ => sq_nonneg _) ⟨i, Finset.mem_univ i, sq_pos_of_ne_zero hi⟩ /-- The normal derivative cannot vanish at a nonzero value of a real Newton polynomial. The slice nonvanishing hypothesis is a polynomial statement, not an assumption about pointwise derivatives. -/ theorem normal_derivative_ne_zero (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (hslice : ∀ y : Fin n → ℝ, sliceHom y (pderiv 0 N) ≠ 0) (z : Fin (n + 1) → ℝ) (hN : eval z N ≠ 0) : eval z (pderiv 0 N) ≠ 0 := by intro hg let y : Fin n → ℝ := fun i => z i.succ have hz : Fin.cons (z 0) y = z := by funext i exact Fin.cases rfl (fun j => rfl) i have hA : (sliceHom y (tangentialEnergy N)).eval (z 0) ≠ 0 := by rw [eval_sliceHom, hz] exact ne_of_gt (tangentialEnergy_pos_of_normal_zero N α D hD.ne' hEuler z hN hg) have hno := eval_ne_zero_of_derivative_mul_eq (sliceHom y (tangentialEnergy N)) (sliceHom y (normalDrift N)) (sliceHom y (pderiv 0 N)) (z 0) (hslice y) hA (slice_derivative_ode N hE y) apply hno rwa [eval_sliceHom, hz] /-- A fixed nonzero coefficient of positive normal degree already guarantees that every normal derivative slice is a nonzero polynomial. In particular, this applies to a constant nonzero leading normal coefficient. -/ theorem slice_derivative_ne_zero_of_constant_coefficient (N : MvPolynomial (Fin (n + 1)) ℝ) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (y : Fin n → ℝ) : sliceHom y (pderiv 0 N) ≠ 0 := by cases d with | zero => omega | succ k => rw [sliceHom_pderiv_zero] intro hz have he := congrArg (fun Q : Polynomial ℝ => Q.coeff k) hz change ((finSuccEquiv ℝ n N).map (eval y)).derivative.coeff k = (0 : Polynomial ℝ).coeff k at he simp only [Polynomial.coeff_derivative, Polynomial.coeff_map, hcoeff, eval_C, Polynomial.coeff_zero] at he have hk : (k : ℝ) + 1 ≠ 0 := by positivity exact (mul_ne_zero hc hk) he theorem normal_derivative_ne_zero_of_constant_coefficient (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (z : Fin (n + 1) → ℝ) (hN : eval z N ≠ 0) : eval z (pderiv 0 N) ≠ 0 := normal_derivative_ne_zero N α D hD hEuler hE (slice_derivative_ne_zero_of_constant_coefficient N d hd c hc hcoeff) z hN end end Source29NewtonNormalDerivative /- Component: PolynomialPhaseRoot.inc -/ namespace Source29PolynomialPhaseRoot open Polynomial Set Filter open scoped Topology noncomputable section theorem exists_eval_ne_zero_in_interval (p : ℝ[X]) (hp : p ≠ 0) {a b : ℝ} (hab : a < b) : ∃ x ∈ Ioo a b, p.eval x ≠ 0 := by by_contra hn push Not at hn apply hp apply p.eq_zero_of_infinite_isRoot apply (Set.Ioo_infinite hab).mono intro x hx exact hn x hx /-- A nonzero polynomial nonnegative on the positive half-line, vanishing at zero, cannot have a further positive zero if all its nonzero values are regular. -/ theorem eval_pos_of_pos (p : ℝ[X]) (hp : p ≠ 0) (hzero : p.eval 0 = 0) (hpos : ∀ x, 0 < x → 0 ≤ p.eval x) (hreg : ∀ x, p.eval x ≠ 0 → p.derivative.eval x ≠ 0) {a : ℝ} (ha : 0 < a) : 0 < p.eval a := by apply lt_of_le_of_ne (hpos a ha) intro he have hza : p.eval a = 0 := he.symm obtain ⟨b,hb,hbn⟩ := exists_eval_ne_zero_in_interval p hp ha have hbp : 0 < p.eval b := lt_of_le_of_ne (hpos b hb.1) (Ne.symm hbn) obtain ⟨c,hc,hmax⟩ := (isCompact_Icc : IsCompact (Icc 0 a)).exists_isMaxOn ⟨0, by simp [ha.le]⟩ p.continuous.continuousOn have hbc : p.eval b ≤ p.eval c := hmax ⟨hb.1.le,hb.2.le⟩ have hcp : 0 < p.eval c := lt_of_lt_of_le hbp hbc have hc0 : 0 < c := lt_of_le_of_ne hc.1 (by intro h; subst c; simpa [hzero] using hcp) have hca : c < a := lt_of_le_of_ne hc.2 (by intro h; subst c; simpa [hza] using hcp) have hder : deriv (fun x ↦ p.eval x) c = 0 := (hmax.isLocalMax (Icc_mem_nhds hc0 hca)).deriv_eq_zero have hd : p.derivative.eval c = 0 := by simpa only [p.deriv] using hder exact hreg c hcp.ne' hd theorem eval_injOn_nonnegative (p : ℝ[X]) (hp : p ≠ 0) (hzero : p.eval 0 = 0) (hpos : ∀ x, 0 < x → 0 ≤ p.eval x) (hreg : ∀ x, p.eval x ≠ 0 → p.derivative.eval x ≠ 0) : InjOn p.eval (Ici 0) := by have hcontra {a b : ℝ} (ha : 0 ≤ a) (hab : a < b) (he : p.eval a = p.eval b) : False := by obtain ⟨c,hc,hcder⟩ := exists_deriv_eq_zero hab p.continuous.continuousOn he have hcpos : 0 < c := lt_of_le_of_lt ha hc.1 apply hreg c (eval_pos_of_pos p hp hzero hpos hreg hcpos).ne' simpa only [p.deriv] using hcder intro a ha b hb he rcases lt_trichotomy a b with hab | hab | hab · exact (hcontra ha hab he).elim · exact hab · exact (hcontra hb hab he.symm).elim theorem eval_strictMonoOn_nonnegative (p : ℝ[X]) (hp : p ≠ 0) (hzero : p.eval 0 = 0) (hpos : ∀ x, 0 < x → 0 ≤ p.eval x) (hreg : ∀ x, p.eval x ≠ 0 → p.derivative.eval x ≠ 0) : StrictMonoOn p.eval (Ici 0) := by have hinj := eval_injOn_nonnegative p hp hzero hpos hreg intro a ha b hb hab have hpb : 0 < p.eval b := eval_pos_of_pos p hp hzero hpos hreg (lt_of_le_of_lt ha hab) have hm := p.continuous.continuousOn.strictMonoOn_of_injOn_Icc hb (show p.eval 0 ≤ p.eval b by rw [hzero]; exact hpb.le) (hinj.mono (fun x hx ↦ hx.1)) exact hm ⟨ha,hab.le⟩ ⟨hb,le_rfl⟩ hab theorem eval_zero_of_sign (p : ℝ[X]) (hpos : ∀ x, 0 < x → 0 ≤ p.eval x) (hneg : ∀ x, x < 0 → p.eval x ≤ 0) : p.eval 0 = 0 := by have hp : Tendsto p.eval (𝓝[>] 0) (𝓝 (p.eval 0)) := p.continuous.continuousAt.mono_left nhdsWithin_le_nhds have hn : Tendsto p.eval (𝓝[<] 0) (𝓝 (p.eval 0)) := p.continuous.continuousAt.mono_left nhdsWithin_le_nhds apply le_antisymm · exact le_of_tendsto hn (eventually_nhdsWithin_of_forall hneg) · exact ge_of_tendsto hp (eventually_nhdsWithin_of_forall hpos) /-- Every positive value has a unique positive preimage. -/ theorem existsUnique_positive_root (p : ℝ[X]) (hp : p ≠ 0) (hzero : p.eval 0 = 0) (hpos : ∀ x, 0 < x → 0 ≤ p.eval x) (hreg : ∀ x, p.eval x ≠ 0 → p.derivative.eval x ≠ 0) (hdeg : 0 < p.degree) {t : ℝ} (ht : 0 < t) : ∃! x : ℝ, 0 < x ∧ p.eval x = t := by have hnorm : Tendsto (fun x : ℝ ↦ ‖x‖) atTop atTop := by apply tendsto_id.congr' filter_upwards [eventually_ge_atTop (0 : ℝ)] with x hx exact (Real.norm_of_nonneg hx).symm have htop : Tendsto p.eval atTop atTop := by apply (p.tendsto_norm_atTop hdeg hnorm).congr' filter_upwards [eventually_gt_atTop (0 : ℝ)] with x hx exact Real.norm_of_nonneg (hpos x hx) obtain ⟨x,hx,hxt⟩ := intermediate_value_Ici p.continuous.continuousOn htop (show t ∈ Ici (p.eval 0) by simpa only [hzero,mem_Ici] using ht.le) have hxpos : 0 < x := lt_of_le_of_ne hx (by intro he subst x change p.eval 0 = t at hxt rw [hzero] at hxt exact ht.ne hxt) refine ⟨x,⟨hxpos,hxt⟩,?_⟩ intro y hy exact eval_injOn_nonnegative p hp hzero hpos hreg hy.1.le hx (hy.2.trans hxt.symm) end end Source29PolynomialPhaseRoot /- Component: NewtonPositiveRoot.inc -/ namespace Source29NewtonPositiveRoot open MvPolynomial Polynomial open Source29NewtonNormalDerivative Source29PolynomialPhaseRoot noncomputable section variable {n : ℕ} lemma slice_coefficient (N : MvPolynomial (Fin (n + 1)) ℝ) (d : ℕ) (c : ℝ) (hcoeff : (finSuccEquiv ℝ n N).coeff d = MvPolynomial.C c) (y : Fin n → ℝ) : (sliceHom y N).coeff d = c := by change ((finSuccEquiv ℝ n N).map (MvPolynomial.eval y)).coeff d = c simp only [Polynomial.coeff_map, hcoeff, MvPolynomial.eval_C] lemma slice_degree_pos (N : MvPolynomial (Fin (n + 1)) ℝ) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = MvPolynomial.C c) (y : Fin n → ℝ) : 0 < (sliceHom y N).degree := by have hnonzero : (sliceHom y N).coeff d ≠ 0 := by rwa [slice_coefficient N d c hcoeff y] have hdle := Polynomial.le_degree_of_ne_zero hnonzero exact lt_of_lt_of_le (by exact_mod_cast hd) hdle lemma slice_ne_zero (N : MvPolynomial (Fin (n + 1)) ℝ) (d : ℕ) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = MvPolynomial.C c) (y : Fin n → ℝ) : sliceHom y N ≠ 0 := by intro hz have he := congrArg (fun p : Polynomial ℝ => p.coeff d) hz rw [slice_coefficient N d c hcoeff y, Polynomial.coeff_zero] at he exact hc he /-- Every positive level of a Newton polynomial has exactly one positive normal root above each tangential point. Only a fixed nonzero coefficient of positive normal degree is required; it need not be the leading coefficient. -/ theorem existsUnique_positive_normal_root (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (hpos : ∀ z : Fin (n + 1) → ℝ, 0 < z 0 → 0 ≤ MvPolynomial.eval z N) (hneg : ∀ z : Fin (n + 1) → ℝ, z 0 < 0 → MvPolynomial.eval z N ≤ 0) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = MvPolynomial.C c) (t : ℝ) (ht : 0 < t) (y : Fin n → ℝ) : ∃! x : ℝ, 0 < x ∧ MvPolynomial.eval (Fin.cons x y) N = t := by have hp : ∀ x, 0 < x → 0 ≤ (sliceHom y N).eval x := by intro x hx rw [eval_sliceHom] exact hpos (Fin.cons x y) hx have hn : ∀ x, x < 0 → (sliceHom y N).eval x ≤ 0 := by intro x hx rw [eval_sliceHom] exact hneg (Fin.cons x y) hx have hz := eval_zero_of_sign (sliceHom y N) hp hn have hreg : ∀ x, (sliceHom y N).eval x ≠ 0 → (sliceHom y N).derivative.eval x ≠ 0 := by intro x hx rw [← sliceHom_pderiv_zero, eval_sliceHom] apply normal_derivative_ne_zero_of_constant_coefficient N α D hD hEuler hE d hd c hc hcoeff rwa [eval_sliceHom] at hx simpa only [eval_sliceHom] using existsUnique_positive_root (sliceHom y N) (slice_ne_zero N d c hc hcoeff y) hz hp hreg (slice_degree_pos N d hd c hc hcoeff y) ht /-- The positive normal root, with a zero fallback outside the existence domain. Theorems below prove existence and all properties on positive levels. -/ def positiveRoot (N : MvPolynomial (Fin (n + 1)) ℝ) (t : ℝ) (y : Fin n → ℝ) : ℝ := by classical exact if hex : ∃ x : ℝ, 0 < x ∧ MvPolynomial.eval (Fin.cons x y) N = t then Classical.choose hex else 0 theorem positiveRoot_spec (N : MvPolynomial (Fin (n + 1)) ℝ) (t : ℝ) (y : Fin n → ℝ) (hex : ∃ x : ℝ, 0 < x ∧ MvPolynomial.eval (Fin.cons x y) N = t) : 0 < positiveRoot N t y ∧ MvPolynomial.eval (Fin.cons (positiveRoot N t y) y) N = t := by simpa only [positiveRoot, dite_eq_left hex] using Classical.choose_spec hex theorem positiveRoot_eq_of_root (N : MvPolynomial (Fin (n + 1)) ℝ) (t : ℝ) (y : Fin n → ℝ) (hex : ∃! x : ℝ, 0 < x ∧ MvPolynomial.eval (Fin.cons x y) N = t) {x : ℝ} (hx : 0 < x) (hroot : MvPolynomial.eval (Fin.cons x y) N = t) : positiveRoot N t y = x := by obtain ⟨r, hr, huniq⟩ := hex have hs := positiveRoot_spec N t y ⟨r, hr⟩ exact (huniq _ hs).trans (huniq x ⟨hx, hroot⟩).symm /-- The global root choice is positive, solves the level equation, and has nonzero normal derivative. These are the inputs for local implicit-function regularity; no analytic or harmonic claim is assumed here. -/ theorem positiveRoot_properties (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (hpos : ∀ z : Fin (n + 1) → ℝ, 0 < z 0 → 0 ≤ MvPolynomial.eval z N) (hneg : ∀ z : Fin (n + 1) → ℝ, z 0 < 0 → MvPolynomial.eval z N ≤ 0) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = MvPolynomial.C c) (t : ℝ) (ht : 0 < t) (y : Fin n → ℝ) : 0 < positiveRoot N t y ∧ MvPolynomial.eval (Fin.cons (positiveRoot N t y) y) N = t ∧ MvPolynomial.eval (Fin.cons (positiveRoot N t y) y) (pderiv 0 N) ≠ 0 := by have he := existsUnique_positive_normal_root N α D hD hEuler hE hpos hneg d hd c hc hcoeff t ht y have hs := positiveRoot_spec N t y he.exists refine ⟨hs.1, hs.2, ?_⟩ apply normal_derivative_ne_zero_of_constant_coefficient N α D hD hEuler hE d hd c hc hcoeff rw [hs.2] exact ht.ne' end end Source29NewtonPositiveRoot /- Component: RealImplicitPolynomialRoot.inc -/ namespace Source29RealImplicitPolynomialRoot open MvPolynomial Filter open Source29PolynomialLinkChart Source29QuarticReuse.QuarticPolynomialBasics open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- The derivative of (N(x,y),y) is triangular. Its first row may have arbitrary tangential entries; only the normal entry must be nonzero. -/ def triangularEquiv (a : Fin (n + 1) → ℝ) (ha : a 0 ≠ 0) : (Fin (n + 1) → ℝ) ≃L[ℝ] (Fin (n + 1) → ℝ) := LinearEquiv.toContinuousLinearEquiv { toFun := fun v => Fin.cons (∑ i, a i * v i) (fun j => v j.succ) invFun := fun w => Fin.cons ((w 0 - ∑ j : Fin n, a j.succ * w j.succ) / a 0) (fun j => w j.succ) left_inv := by intro v funext i refine Fin.cases ?_ (fun j => ?_) i · simp only [Fin.cons_zero, Fin.cons_succ, Fin.sum_univ_succ] field_simp ring · rfl right_inv := by intro w funext i refine Fin.cases ?_ (fun j => ?_) i · simp only [Fin.cons_zero, Fin.cons_succ, Fin.sum_univ_succ] field_simp ring · rfl map_add' := by intro v w funext i refine Fin.cases ?_ (fun j => ?_) i · simp [mul_add, Finset.sum_add_distrib] · rfl map_smul' := by intro c v funext i refine Fin.cases ?_ (fun j => ?_) i · simp only [Fin.cons_zero, Pi.smul_apply, smul_eq_mul, RingHom.id_apply, Finset.mul_sum] apply Finset.sum_congr rfl intro j _ ring · rfl } lemma triangularEquiv_zero (a : Fin (n + 1) → ℝ) (ha : a 0 ≠ 0) (v : Fin (n + 1) → ℝ) : triangularEquiv a ha v 0 = ∑ i, a i * v i := rfl lemma triangularEquiv_succ (a : Fin (n + 1) → ℝ) (ha : a 0 ≠ 0) (v : Fin (n + 1) → ℝ) (i : Fin n) : triangularEquiv a ha v i.succ = v i.succ := rfl def coordinatePolynomial (N : MvPolynomial (Fin (n + 1)) ℝ) : Fin (n + 1) → MvPolynomial (Fin (n + 1)) ℝ := Fin.cons N (fun i => X i.succ) def coordinateMap (N : MvPolynomial (Fin (n + 1)) ℝ) (z : Fin (n + 1) → ℝ) : Fin (n + 1) → ℝ := fun i => eval z (coordinatePolynomial N i) lemma analyticAt_levelEmbed (t : ℝ) (y : Fin n → ℝ) : AnalyticAt ℝ (fun v : Fin n → ℝ => (Fin.cons t v : Fin (n + 1) → ℝ)) y := by apply AnalyticAt.pi intro i refine Fin.cases ?_ (fun j => ?_) i · exact analyticAt_const · exact (ContinuousLinearMap.proj j : (Fin n → ℝ) →L[ℝ] ℝ).analyticAt y /-- A polynomial level is an analytic normal graph near every point with nonzero normal derivative. Tangential derivatives are unrestricted. -/ theorem exists_local_level_graph (N : MvPolynomial (Fin (n + 1)) ℝ) (z : Fin (n + 1) → ℝ) (hz : eval z (pderiv 0 N) ≠ 0) : ∃ g : (Fin n → ℝ) → ℝ, AnalyticAt ℝ g (fun i => z i.succ) ∧ g (fun i => z i.succ) = z 0 ∧ ∀ᶠ y in 𝓝 (fun i => z i.succ), eval (Fin.cons (g y) y) N = eval z N := by let a : Fin (n + 1) → ℝ := fun i => eval z (pderiv i N) let e := triangularEquiv a hz have ha : AnalyticAt ℝ (coordinateMap N) z := AnalyticAt.pi (fun i => analyticAt_eval_real (coordinatePolynomial N i) z) have hd : HasStrictFDerivAt (coordinateMap N) (e : _ →L[ℝ] _) z := by apply hasStrictFDerivAt_pi'.mpr intro i change HasStrictFDerivAt (fun v => eval v (coordinatePolynomial N i)) _ _ convert hasStrictFDerivAt_eval (coordinatePolynomial N i) z using 1 ext v change e v i = evalFDeriv (coordinatePolynomial N i) z v refine Fin.cases ?_ (fun j => ?_) i · rw [triangularEquiv_zero] simp [coordinatePolynomial, evalFDeriv_apply, a] · rw [triangularEquiv_succ] simp [coordinatePolynomial, evalFDeriv_X] obtain ⟨u, hu, huz, hnear⟩ := Source29RealAnalyticInverse.exists_analytic_local_inverse (coordinateMap N) z e ha hd have hbase : coordinateMap N z = Fin.cons (eval z N) (fun i => z i.succ) := by funext i refine Fin.cases ?_ (fun j => ?_) i · rfl · simp [coordinateMap, coordinatePolynomial] rw [hbase] at hu huz hnear let g : (Fin n → ℝ) → ℝ := fun y => u (Fin.cons (eval z N) y) 0 have hcomp : AnalyticAt ℝ (fun y : Fin n → ℝ => u (Fin.cons (eval z N) y)) (fun i => z i.succ) := AnalyticAt.comp (g := u) (f := fun y => Fin.cons (eval z N) y) hu (analyticAt_levelEmbed _ _) refine ⟨g, ?_, ?_, ?_⟩ · exact AnalyticAt.comp (g := fun v : Fin (n + 1) → ℝ => v 0) ((ContinuousLinearMap.proj 0 : (Fin (n + 1) → ℝ) →L[ℝ] ℝ).analyticAt _) hcomp · exact congrFun huz 0 · have hn := (analyticAt_levelEmbed (eval z N) (fun i => z i.succ)).continuousAt.tendsto.eventually hnear filter_upwards [hn] with y hy have he : u (Fin.cons (eval z N) y) = Fin.cons (g y) y := by funext i refine Fin.cases ?_ (fun j => ?_) i · rfl · have hj := congrFun hy j.succ simpa [coordinateMap, coordinatePolynomial] using hj have hval := congrFun hy 0 change eval (u (Fin.cons (eval z N) y)) N = eval z N at hval rwa [he] at hval end end Source29RealImplicitPolynomialRoot /- Component: NewtonRootAnalytic.inc -/ namespace Source29NewtonRootAnalytic open MvPolynomial Filter open Source29NewtonNormalDerivative Source29NewtonPositiveRoot Source29RealImplicitPolynomialRoot open scoped Topology noncomputable section variable {n : ℕ} /-- The unique positive normal root is analytic in every tangential variable. Local inverse branches agree with the global choice by positivity and uniqueness. -/ theorem analyticAt_positiveRoot (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (hpos : ∀ z : Fin (n + 1) → ℝ, 0 < z 0 → 0 ≤ eval z N) (hneg : ∀ z : Fin (n + 1) → ℝ, z 0 < 0 → eval z N ≤ 0) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (t : ℝ) (ht : 0 < t) (y : Fin n → ℝ) : AnalyticAt ℝ (positiveRoot N t) y := by have hs := positiveRoot_properties N α D hD hEuler hE hpos hneg d hd c hc hcoeff t ht y obtain ⟨g, hg, hgy, hroot⟩ := exists_local_level_graph N (Fin.cons (positiveRoot N t y) y) hs.2.2 simp only [Fin.cons_succ, Fin.cons_zero] at hg hgy hroot rw [hs.2.1] at hroot have hgypos : 0 < g y := by rw [hgy]; exact hs.1 have hgpos : ∀ᶠ v in 𝓝 y, 0 < g v := hg.continuousAt.tendsto.eventually (eventually_gt_nhds hgypos) apply hg.congr filter_upwards [hroot, hgpos] with v hv hpv exact (positiveRoot_eq_of_root N t v (existsUnique_positive_normal_root N α D hD hEuler hE hpos hneg d hd c hc hcoeff t ht v) hpv hv).symm theorem analyticOnNhd_positiveRoot (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (hpos : ∀ z : Fin (n + 1) → ℝ, 0 < z 0 → 0 ≤ eval z N) (hneg : ∀ z : Fin (n + 1) → ℝ, z 0 < 0 → eval z N ≤ 0) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (t : ℝ) (ht : 0 < t) : AnalyticOnNhd ℝ (positiveRoot N t) Set.univ := by intro y _ exact analyticAt_positiveRoot N α D hD hEuler hE hpos hneg d hd c hc hcoeff t ht y end end Source29NewtonRootAnalytic /- Component: NewtonRootHarmonic.inc -/ namespace Source29NewtonRootHarmonic open Filter MvPolynomial open Source29RealPolynomialCurveJets Source29NewtonNormalDerivative open Source29QuarticReuse.QuarticPolynomialBasics open scoped Topology BigOperators noncomputable section variable {n : ℕ} def coordinateGradient (f : (Fin n → ℝ) → ℝ) (y : Fin n → ℝ) (i : Fin n) : ℝ := fderiv ℝ f y (Pi.single i 1) def coordinateLaplacian (f : (Fin n → ℝ) → ℝ) (y : Fin n → ℝ) : ℝ := ∑ i, fderiv ℝ (fun z => coordinateGradient f z i) y (Pi.single i 1) lemma divergence_coordinateGradient (f : (Fin n → ℝ) → ℝ) (y : Fin n → ℝ) : Source29QuarticReuse.FluxObstruction.divergence (fun i => Pi.single i 1) (coordinateGradient f) y = coordinateLaplacian f y := rfl section Lines variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] lemma line_hasDerivAt (y v : E) (s : ℝ) : HasDerivAt (fun t : ℝ => y + t • v) v s := by simpa using ((hasDerivAt_id s).smul_const v).const_add y lemma deriv_line (f : E → ℝ) (y v : E) (s : ℝ) (hf : DifferentiableAt ℝ f (y + s • v)) : deriv (fun t : ℝ => f (y + t • v)) s = fderiv ℝ f (y + s • v) v := (hf.hasFDerivAt.comp_hasDerivAt s (line_hasDerivAt y v s)).deriv lemma analyticAt_directional (f : E → ℝ) (y v : E) (hf : AnalyticAt ℝ f y) : AnalyticAt ℝ (fun z => fderiv ℝ f z v) y := AnalyticAt.comp (f := fderiv ℝ f) (g := fun L : E →L[ℝ] ℝ => L v) ((ContinuousLinearMap.apply ℝ ℝ v).analyticAt _) hf.fderiv lemma line_tendsto (y v : E) : Tendsto (fun t : ℝ => y + t • v) (𝓝 0) (𝓝 y) := by simpa using (line_hasDerivAt y v 0).continuousAt.tendsto lemma second_deriv_line (f : E → ℝ) (y v : E) (hf : AnalyticAt ℝ f y) : deriv (deriv (fun t : ℝ => f (y + t • v))) 0 = fderiv ℝ (fun z => fderiv ℝ f z v) y v := by have hn := (line_tendsto y v).eventually hf.eventually_analyticAt have he : deriv (fun t : ℝ => f (y + t • v)) =ᶠ[𝓝 0] (fun t : ℝ => fderiv ℝ f (y + t • v) v) := by filter_upwards [hn] with t ht exact deriv_line f y v t ht.differentiableAt rw [he.deriv_eq] simpa using deriv_line (fun z => fderiv ℝ f z v) y v 0 (by simpa using (analyticAt_directional f y v hf).differentiableAt) end Lines def graphCurve (φ : ℝ → ℝ) (y : Fin n → ℝ) (i : Fin n) : Fin (n+1) → ℝ → ℝ := Fin.cons φ (fun j s => y j + s * (if j = i then 1 else 0)) lemma graphCurve_analytic (φ : ℝ → ℝ) (y : Fin n → ℝ) (i : Fin n) (hφ : AnalyticAt ℝ φ 0) (j : Fin (n+1)) : AnalyticAt ℝ (graphCurve φ y i j) 0 := by refine Fin.cases hφ (fun k => ?_) j exact analyticAt_const.add (analyticAt_id.mul analyticAt_const) lemma deriv_affine (c d s : ℝ) : deriv (fun t : ℝ => c + t*d) s = d := by simpa using (((hasDerivAt_id s).mul_const d).const_add c).deriv lemma second_deriv_affine (c d : ℝ) : deriv (deriv (fun t : ℝ => c + t*d)) 0 = 0 := by have he : deriv (fun t : ℝ => c+t*d) = fun _ => d := funext (deriv_affine c d) rw [he] simp lemma graphCurve_value (φ : ℝ → ℝ) (y : Fin n → ℝ) (i : Fin n) : (fun j => graphCurve φ y i j 0) = Fin.cons (φ 0) y := by funext j refine Fin.cases rfl (fun k => ?_) j simp [graphCurve] lemma first_deriv_graphCurve (N : MvPolynomial (Fin (n+1)) ℝ) (φ : ℝ → ℝ) (y : Fin n → ℝ) (i : Fin n) (hφ : AnalyticAt ℝ φ 0) : deriv (fun s => eval (fun j => graphCurve φ y i j s) N) 0 = eval (Fin.cons (φ 0) y) (pderiv 0 N) * deriv φ 0 + eval (Fin.cons (φ 0) y) (pderiv i.succ N) := by rw [first_deriv_eval_curve N _ 0 (graphCurve_analytic φ y i hφ), graphCurve_value] simp only [Fin.sum_univ_succ, graphCurve, Fin.cons_zero, Fin.cons_succ, deriv_affine] simp lemma second_deriv_graphCurve (N : MvPolynomial (Fin (n+1)) ℝ) (φ : ℝ → ℝ) (y : Fin n → ℝ) (i : Fin n) (hφ : AnalyticAt ℝ φ 0) : deriv (deriv (fun s => eval (fun j => graphCurve φ y i j s) N)) 0 = eval (Fin.cons (φ 0) y) (pderiv 0 (pderiv 0 N)) * (deriv φ 0)^2 + 2 * eval (Fin.cons (φ 0) y) (pderiv i.succ (pderiv 0 N)) * deriv φ 0 + eval (Fin.cons (φ 0) y) (pderiv i.succ (pderiv i.succ N)) + eval (Fin.cons (φ 0) y) (pderiv 0 N) * deriv (deriv φ) 0 := by rw [second_deriv_eval_curve N _ (graphCurve_analytic φ y i hφ), graphCurve_value] simp only [Fin.sum_univ_succ, graphCurve, Fin.cons_zero, Fin.cons_succ, deriv_affine, second_deriv_affine] simp only [mul_ite, ite_mul, mul_one, mul_zero, Finset.sum_add_distrib] simp only [Finset.sum_ite_eq', Finset.mem_univ, ite_true, Finset.sum_const_zero, add_zero] simp rw [second_partial_comm N (0 : Fin (n+1)) i.succ] ring lemma analyticAt_line {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] (f : E → ℝ) (y v : E) (hf : AnalyticAt ℝ f y) : AnalyticAt ℝ (fun s : ℝ => f (y + s • v)) 0 := by have hl : AnalyticAt ℝ (fun s : ℝ => y + s • v) 0 := analyticAt_const.add (analyticAt_id.smul analyticAt_const) exact AnalyticAt.comp (f := fun s : ℝ => y + s • v) (g := f) (x := (0 : ℝ)) (by simpa using hf) hl lemma graphCurve_line (f : (Fin n → ℝ) → ℝ) (y : Fin n → ℝ) (i : Fin n) (s : ℝ) : (fun j => graphCurve (fun t => f (y + t • Pi.single i 1)) y i j s) = Fin.cons (f (y + s • Pi.single i 1)) (y + s • Pi.single i 1) := by funext j refine Fin.cases rfl (fun k => ?_) j simp [graphCurve, Pi.single_apply, eq_comm] lemma root_coordinate_identities (N : MvPolynomial (Fin (n+1)) ℝ) (f : (Fin n → ℝ) → ℝ) (y : Fin n → ℝ) (t : ℝ) (hf : AnalyticAt ℝ f y) (hlevel : ∀ᶠ z in 𝓝 y, eval (Fin.cons (f z) z) N = t) (i : Fin n) : eval (Fin.cons (f y) y) (pderiv 0 N) * coordinateGradient f y i + eval (Fin.cons (f y) y) (pderiv i.succ N) = 0 ∧ eval (Fin.cons (f y) y) (pderiv 0 (pderiv 0 N)) * (coordinateGradient f y i)^2 + 2 * eval (Fin.cons (f y) y) (pderiv i.succ (pderiv 0 N)) * coordinateGradient f y i + eval (Fin.cons (f y) y) (pderiv i.succ (pderiv i.succ N)) + eval (Fin.cons (f y) y) (pderiv 0 N) * fderiv ℝ (fun z => coordinateGradient f z i) y (Pi.single i 1) = 0 := by let φ : ℝ → ℝ := fun s => f (y + s • Pi.single i 1) have hφ : AnalyticAt ℝ φ 0 := analyticAt_line f y _ hf have hφ0 : φ 0 = f y := by simp [φ] have hd : deriv φ 0 = coordinateGradient f y i := by simpa [φ, coordinateGradient] using deriv_line f y (Pi.single i 1) 0 (by simpa using hf.differentiableAt) have hdd : deriv (deriv φ) 0 = fderiv ℝ (fun z => coordinateGradient f z i) y (Pi.single i 1) := second_deriv_line f y (Pi.single i 1) hf have he : (fun s => eval (fun j => graphCurve φ y i j s) N) =ᶠ[𝓝 0] (fun _ => t) := by filter_upwards [(line_tendsto y (Pi.single i 1)).eventually hlevel] with s hs change eval (fun j => graphCurve (fun r => f (y + r • Pi.single i 1)) y i j s) N = t rw [graphCurve_line] exact hs have hfirst : deriv (fun s => eval (fun j => graphCurve φ y i j s) N) 0 = 0 := by rw [he.deriv_eq] simp have hsecond : deriv (deriv (fun s => eval (fun j => graphCurve φ y i j s) N)) 0 = 0 := by rw [he.deriv.deriv_eq] simp rw [first_deriv_graphCurve N φ y i hφ, hφ0, hd] at hfirst rw [second_deriv_graphCurve N φ y i hφ, hφ0, hd, hdd] at hsecond exact ⟨hfirst, hsecond⟩ lemma coordinate_second_mul (N : MvPolynomial (Fin (n+1)) ℝ) (f : (Fin n → ℝ) → ℝ) (y : Fin n → ℝ) (t : ℝ) (hf : AnalyticAt ℝ f y) (hlevel : ∀ᶠ z in 𝓝 y, eval (Fin.cons (f z) z) N = t) (i : Fin n) : (eval (Fin.cons (f y) y) (pderiv 0 N))^3 * fderiv ℝ (fun z => coordinateGradient f z i) y (Pi.single i 1) = -((eval (Fin.cons (f y) y) (pderiv 0 N))^2 * eval (Fin.cons (f y) y) (pderiv i.succ (pderiv i.succ N)) - 2 * eval (Fin.cons (f y) y) (pderiv 0 N) * eval (Fin.cons (f y) y) (pderiv i.succ N) * eval (Fin.cons (f y) y) (pderiv i.succ (pderiv 0 N)) + eval (Fin.cons (f y) y) (pderiv 0 (pderiv 0 N)) * (eval (Fin.cons (f y) y) (pderiv i.succ N))^2) := by obtain ⟨hfirst, hsecond⟩ := root_coordinate_identities N f y t hf hlevel i let a := eval (Fin.cons (f y) y) (pderiv 0 N) let b := eval (Fin.cons (f y) y) (pderiv i.succ N) let c := eval (Fin.cons (f y) y) (pderiv i.succ (pderiv i.succ N)) let d := eval (Fin.cons (f y) y) (pderiv 0 (pderiv 0 N)) let m := eval (Fin.cons (f y) y) (pderiv i.succ (pderiv 0 N)) let p := coordinateGradient f y i let q := fderiv ℝ (fun z => coordinateGradient f z i) y (Pi.single i 1) change a*p+b = 0 at hfirst change d*p^2+2*m*p+c+a*q = 0 at hsecond change a^3*q = -(a^2*c-2*a*b*m+d*b^2) linear_combination a^2*hsecond - (d*(a*p-b)+2*a*m)*hfirst /-- Differentiating the polynomial level equation twice gives the Newton residual as the normal derivative cubed times the negative root Laplacian. -/ theorem coordinateLaplacian_mul (N : MvPolynomial (Fin (n+1)) ℝ) (f : (Fin n → ℝ) → ℝ) (y : Fin n → ℝ) (t : ℝ) (hf : AnalyticAt ℝ f y) (hlevel : ∀ᶠ z in 𝓝 y, eval (Fin.cons (f z) z) N = t) : (eval (Fin.cons (f y) y) (pderiv 0 N))^3 * coordinateLaplacian f y = -eval (Fin.cons (f y) y) (newtonResidual N) := by unfold coordinateLaplacian rw [Finset.mul_sum] simp_rw [coordinate_second_mul N f y t hf hlevel] simp only [newtonResidual, tangentialEnergy, tangentialLaplacian, tangentialMixed, map_add, map_sub, map_mul, map_pow, map_ofNat, map_sum, Finset.sum_neg_distrib, Finset.sum_add_distrib, Finset.sum_sub_distrib, Finset.mul_sum] ring /-- The implicit polynomial root has Laplacian -E(N)/(N_x)^3. -/ theorem coordinateLaplacian_eq (N : MvPolynomial (Fin (n+1)) ℝ) (f : (Fin n → ℝ) → ℝ) (y : Fin n → ℝ) (t : ℝ) (hf : AnalyticAt ℝ f y) (hlevel : ∀ᶠ z in 𝓝 y, eval (Fin.cons (f z) z) N = t) (hnormal : eval (Fin.cons (f y) y) (pderiv 0 N) ≠ 0) : coordinateLaplacian f y = -eval (Fin.cons (f y) y) (newtonResidual N) / (eval (Fin.cons (f y) y) (pderiv 0 N))^3 := by apply (eq_div_iff (pow_ne_zero 3 hnormal)).mpr simpa only [mul_comm] using coordinateLaplacian_mul N f y t hf hlevel /-- Vanishing Newton residual makes every regular analytic level root harmonic. -/ theorem coordinateLaplacian_eq_zero (N : MvPolynomial (Fin (n+1)) ℝ) (hE : newtonResidual N = 0) (f : (Fin n → ℝ) → ℝ) (y : Fin n → ℝ) (t : ℝ) (hf : AnalyticAt ℝ f y) (hlevel : ∀ᶠ z in 𝓝 y, eval (Fin.cons (f z) z) N = t) (hnormal : eval (Fin.cons (f y) y) (pderiv 0 N) ≠ 0) : coordinateLaplacian f y = 0 := by rw [coordinateLaplacian_eq N f y t hf hlevel hnormal, hE, map_zero, neg_zero, zero_div] lemma coordinateGradient_contDiff (f : (Fin n → ℝ) → ℝ) (hf : ∀ y, AnalyticAt ℝ f y) (i : Fin n) : ContDiff ℝ 1 (fun y => coordinateGradient f y i) := by rw [contDiff_iff_contDiffAt] intro y exact (analyticAt_directional f y (Pi.single i 1) (hf y)).contDiffAt /-- The coordinate gradient of a global regular level root is divergence-free. -/ theorem coordinateGradient_divergence_eq_zero (N : MvPolynomial (Fin (n+1)) ℝ) (hE : newtonResidual N = 0) (f : (Fin n → ℝ) → ℝ) (t : ℝ) (hf : ∀ y, AnalyticAt ℝ f y) (hlevel : ∀ y, eval (Fin.cons (f y) y) N = t) (hnormal : ∀ y, eval (Fin.cons (f y) y) (pderiv 0 N) ≠ 0) (y : Fin n → ℝ) : Source29QuarticReuse.FluxObstruction.divergence (fun i => Pi.single i 1) (coordinateGradient f) y = 0 := by rw [divergence_coordinateGradient] exact coordinateLaplacian_eq_zero N hE f y t (hf y) (Filter.Eventually.of_forall hlevel) (hnormal y) end end Source29NewtonRootHarmonic /- Component: HarmonicRadialPrimitive.inc -/ namespace Source29HarmonicRadialPrimitive open MeasureTheory Set open Source29QuarticReuse.FluxObstruction Source29LevelRadialStress open scoped Topology BigOperators noncomputable section variable {n : ℕ} def primitive (f : ℝ → ℝ) (R s : ℝ) : ℝ := ∫ t in R..s, f t theorem primitive_hasDerivAt {f : ℝ → ℝ} (hf : Continuous f) (R s : ℝ) : HasDerivAt (primitive f R) (f s) s := intervalIntegral.integral_hasDerivAt_right (hf.intervalIntegrable R s) hf.stronglyMeasurable.stronglyMeasurableAtFilter hf.continuousAt theorem primitive_deriv {f : ℝ → ℝ} (hf : Continuous f) (R s : ℝ) : deriv (primitive f R) s = f s := (primitive_hasDerivAt hf R s).deriv theorem primitive_contDiff {f : ℝ → ℝ} (hf : Continuous f) (R : ℝ) : ContDiff ℝ 1 (primitive f R) := by apply contDiff_one_iff_deriv.mpr refine ⟨fun s ↦ (primitive_hasDerivAt hf R s).differentiableAt, ?_⟩ have he : deriv (primitive f R) = f := funext (primitive_deriv hf R) rw [he] exact hf theorem primitive_zero {f : ℝ → ℝ} {R s : ℝ} (hz : ∀ t, R ≤ t → f t = 0) (hs : R ≤ s) : primitive f R s = 0 := by unfold primitive calc (∫ t in R..s, f t) = ∫ _t in R..s, (0 : ℝ) := by apply intervalIntegral.integral_congr intro t ht rw [uIcc_of_le hs] at ht exact hz t ht.1 _ = 0 := intervalIntegral.integral_zero /-- A compact radial primitive tests a divergence-free field against the radially weighted position vector without introducing sphere integrals. -/ theorem radial_moment_zero {g : (Fin n → ℝ) → Fin n → ℝ} (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdiv : ∀ x, divergence (fun i ↦ Pi.single i 1) g x = 0) {f : ℝ → ℝ} (hf : Continuous f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ t, R ≤ t → f t = 0) : (∫ x, radialWeight f r x * (∑ i, x i * g x i)) = 0 := by have hφ := radialWeight_contDiff (n := n) (primitive_contDiff hf R) r have hcφ := radialWeight_compact (n := n) hR hr (fun s hs ↦ primitive_zero hz hs) have he := integral_testFlux_eq_zero (μ := volume) (fun i ↦ Pi.single i 1) hφ hcφ hg hdiv have hpt (x : Fin n → ℝ) : testFlux (fun i ↦ Pi.single i 1) (radialWeight (primitive f R) r) g x = (2/r^2) * (radialWeight f r x * (∑ i, x i * g x i)) := by simp only [testFlux, radialWeight_fderiv (primitive_contDiff hf R), primitive_deriv hf] unfold Source29LevelRadialStress.radialWeight rw [Finset.mul_sum, Finset.mul_sum] apply Finset.sum_congr rfl intro i _ ring simp_rw [hpt] at he rw [integral_const_mul] at he exact (mul_eq_zero.mp he).resolve_left (div_ne_zero (by norm_num) (pow_ne_zero 2 hr.ne')) end end Source29HarmonicRadialPrimitive /- Component: HarmonicRadialStationarity.inc -/ namespace Source29HarmonicRadialStationarity open MeasureTheory Set open Source29QuarticReuse.FluxObstruction Source29LevelRadialStress open Source29WeightedRadialDerivative Source29HarmonicRadialPrimitive open scoped Topology BigOperators noncomputable section variable {n : ℕ} def dilationField (u : (Fin n → ℝ) → ℝ) (x : Fin n → ℝ) (i : Fin n) : ℝ := u x * x i theorem dilationField_contDiff {u : (Fin n → ℝ) → ℝ} (hu : ContDiff ℝ 1 u) (i : Fin n) : ContDiff ℝ 1 (fun x ↦ dilationField u x i) := hu.mul (contDiff_apply ℝ ℝ i) theorem dilationField_deriv {u : (Fin n → ℝ) → ℝ} (hu : ContDiff ℝ 1 u) (x : Fin n → ℝ) (i : Fin n) : fderiv ℝ (fun y ↦ dilationField u y i) x (Pi.single i 1) = fderiv ℝ u x (Pi.single i 1) * x i + u x := by have hd := ((hu.differentiable (by norm_num) x).hasFDerivAt).fun_mul (hasFDerivAt_apply (𝕜 := ℝ) (F' := fun _ : Fin n ↦ ℝ) i x) have he := congrArg (fun D : (Fin n → ℝ) →L[ℝ] ℝ ↦ D (Pi.single i 1)) hd.fderiv change fderiv ℝ (fun y ↦ dilationField u y i) x (Pi.single i 1) = _ at he simpa only [add_apply, _root_.smul_apply, smul_eq_mul, ContinuousLinearMap.proj_apply, Pi.single_apply, ite_true, mul_one, mul_comm, add_comm] using he theorem dilationField_divergence {u : (Fin n → ℝ) → ℝ} (hu : ContDiff ℝ 1 u) {g : (Fin n → ℝ) → Fin n → ℝ} (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (x : Fin n → ℝ) : divergence (fun i ↦ Pi.single i 1) (dilationField u) x = (n : ℝ) * u x + ∑ i, x i * g x i := by simp only [divergence, dilationField_deriv hu, hdu, Finset.sum_add_distrib, Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul] simp only [mul_comm, add_comm] def normalizedMass (u : (Fin n → ℝ) → ℝ) (f : ℝ → ℝ) (r : ℝ) : ℝ := mass u f r / r^n /-- Harmonicity kills the radial first moment, making the ordinary volume normalization of every smooth compact radial average stationary. -/ theorem mass_stationarity {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (hdiv : ∀ x, divergence (fun i ↦ Pi.single i 1) g x = 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) : (n : ℝ) * mass u f r = r * ∫ x, densityDeriv u f r x := by have hρ := radialWeight_contDiff (n := n) hf r have hcρ := radialWeight_compact (n := n) hR hr hz have hm : Integrable (fun x ↦ radialWeight f r x * (∑ i, x i * g x i)) := by apply (hρ.continuous.mul _).integrable_of_hasCompactSupport hcρ.mul_right exact continuous_finsetSum _ (fun i _ ↦ (continuous_apply i).mul (hg i).continuous) have hi := density_integrable hu.continuous hf.continuous hR hr hz have hd := (mass_hasDerivAt hu.continuous hf hR hr hz hdz).1 have he := integral_mul_divergence_eq_neg_testFlux (μ := volume) (fun i ↦ Pi.single i 1) hρ hcρ (dilationField_contDiff hu) have hl (x : Fin n → ℝ) : radialWeight f r x * divergence (fun i ↦ Pi.single i 1) (dilationField u) x = (n : ℝ) * density u f r x + radialWeight f r x * (∑ i, x i * g x i) := by rw [dilationField_divergence hu hdu] unfold density ring have hright (x : Fin n → ℝ) : testFlux (fun i ↦ Pi.single i 1) (radialWeight f r) (dilationField u) x = (-r) * densityDeriv u f r x := by have hsum : testFlux (fun i ↦ Pi.single i 1) (radialWeight f r) (dilationField u) x = (2/r^2) * deriv f (radiusSq x/r^2) * u x * radiusSq x := by simp only [testFlux, radialWeight_fderiv hf, dilationField] unfold radiusSq rw [Finset.mul_sum] apply Finset.sum_congr rfl intro i _ ring rw [hsum] unfold densityDeriv have hnr := hr.ne' field_simp simp_rw [hl, hright] at he rw [integral_add (hi.const_mul (n : ℝ)) hm, integral_const_mul, radial_moment_zero hg hdiv hf.continuous hR hr hz, add_zero, integral_const_mul] at he change (n : ℝ) * mass u f r = -((-r) * ∫ x, densityDeriv u f r x) at he linarith theorem normalizedMass_hasDerivAt_zero {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (hdiv : ∀ x, divergence (fun i ↦ Pi.single i 1) g x = 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) : HasDerivAt (normalizedMass u f) 0 r := by change HasDerivAt (fun t : ℝ ↦ mass u f t / t^n) 0 r have hd := Source29GraphMassMonotonicity.normalized_hasDerivAt (mass_hasDerivAt hu.continuous hf hR hr hz hdz).2 hr.ne' n have hs := mass_stationarity hu hg hdu hdiv hf hR hr hz hdz have he : r * (∫ x, densityDeriv u f r x) - (n : ℝ) * mass u f r = 0 := by linarith simpa only [he, zero_div, Source29HarmonicRadialStationarity.normalizedMass] using hd theorem normalizedMass_eq {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (hdiv : ∀ x, divergence (fun i ↦ Pi.single i 1) g x = 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R r s : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hs : 0 < s) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) : normalizedMass u f r = normalizedMass u f s := by have hd (t : ℝ) (ht : 0 < t) := normalizedMass_hasDerivAt_zero hu hg hdu hdiv hf hR ht hz hdz exact isOpen_Ioi.is_const_of_deriv_eq_zero (convex_Ioi (0 : ℝ)).isPreconnected (fun t ht ↦ (hd t ht).differentiableAt.differentiableWithinAt) (fun {t} ht ↦ (hd t ht).deriv) hr hs end end Source29HarmonicRadialStationarity /- Component: HarmonicRadialSmallLimit.inc -/ namespace Source29HarmonicRadialSmallLimit open MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction Source29LevelRadialStress open Source29WeightedRadialDerivative Source29GraphRadialSupport Source29PhaseMassDilation open scoped Topology noncomputable section variable {n : ℕ} /-- Ordinary volume normalization removes exactly the ambient-dimensional Jacobian of the dilation. This identity requires no regularity assumptions. -/ theorem normalizedMass_eq_rescaled (u : (Fin n → ℝ) → ℝ) (f : ℝ → ℝ) {r : ℝ} (hr : 0 < r) : mass u f r / r ^ n = ∫ x : Fin n → ℝ, f (radiusSq x) * u (r • x) := by have he := Measure.integral_comp_smul_of_nonneg volume (density u f r) r (hR := hr.le) simp only [Module.finrank_pi, Fintype.card_fin, smul_eq_mul] at he calc mass u f r / r ^ n = ∫ x : Fin n → ℝ, density u f r (r • x) := by simpa only [mass, div_eq_mul_inv, mul_comm] using he.symm _ = _ := by apply integral_congr_ae exact Filter.Eventually.of_forall fun x => by simp only [density, Source29LevelRadialStress.radialWeight, radiusSq_dilate hr.ne'] lemma rescaled_integrand_continuous {u : (Fin n → ℝ) → ℝ} (hu : Continuous u) {f : ℝ → ℝ} (hf : Continuous f) : Continuous (fun p : ℝ × (Fin n → ℝ) => f (radiusSq p.2) * u (p.1 • p.2)) := (hf.comp (radiusSq_contDiff.continuous.comp continuous_snd)).mul (hu.comp (continuous_fst.smul continuous_snd)) lemma radial_cutoff_zero_outside_box {f : ℝ → ℝ} {R : ℝ} (hR : 0 ≤ R) (hz : ∀ t, R ≤ t → f t = 0) (x : Fin n → ℝ) (hx : x ∉ supportBox n R) : f (radiusSq x) = 0 := by simpa only [Source29GraphRadialGeometry.graphRadiusSq, Pi.zero_apply, zero_pow (by decide : 2 ≠ 0), add_zero, radiusSq] using Source29GraphSmallDensity.cutoff_zero_outside_box (0 : (Fin n → ℝ) → ℝ) hR hz x hx /-- Compact support of the radial cutoff gives a common integrable bound. Only continuity of u is needed; no global bound on u is assumed. -/ theorem normalizedMass_small_radius_limit {u : (Fin n → ℝ) → ℝ} (hu : Continuous u) {f : ℝ → ℝ} (hf : Continuous f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ t, R ≤ t → f t = 0) : Tendsto (fun r : ℝ => mass u f r / r ^ n) (𝓝[>] 0) (𝓝 (u 0 * ∫ x : Fin n → ℝ, f (radiusSq x))) := by classical let K := supportBox n R have hK : IsCompact K := supportBox_compact n R obtain ⟨M, hM⟩ := ((isCompact_Icc : IsCompact (Icc (0 : ℝ) 1)).prod hK).exists_bound_of_continuousOn (rescaled_integrand_continuous hu hf).continuousOn have hc (r : ℝ) : Continuous (fun x : Fin n → ℝ => f (radiusSq x) * u (r • x)) := (hf.comp radiusSq_contDiff.continuous).mul (hu.comp (continuous_const_smul r)) have ht : Tendsto (fun r : ℝ => ∫ x : Fin n → ℝ, f (radiusSq x) * u (r • x)) (𝓝[>] 0) (𝓝 (∫ x : Fin n → ℝ, f (radiusSq x) * u 0)) := by apply tendsto_integral_filter_of_dominated_convergence (K.indicator (fun _ => M)) · exact Filter.Eventually.of_forall fun r => (hc r).aestronglyMeasurable · filter_upwards [self_mem_nhdsWithin, mem_nhdsWithin_of_mem_nhds (gt_mem_nhds (show (0 : ℝ) < 1 by norm_num))] with r hr hr1 apply Filter.Eventually.of_forall intro x by_cases hx : x ∈ K · rw [Set.indicator_of_mem hx] exact hM (r, x) ⟨⟨hr.le, hr1.le⟩, hx⟩ · rw [Set.indicator_of_notMem hx, radial_cutoff_zero_outside_box hR hz x hx, zero_mul, norm_zero] · exact (integrable_indicator_iff hK.measurableSet).2 (integrableOn_const hK.measure_lt_top.ne) · apply Filter.Eventually.of_forall intro x have hx : Continuous (fun r : ℝ => f (radiusSq x) * u (r • x)) := continuous_const.mul (hu.comp (continuous_id.smul continuous_const)) simpa only [zero_smul] using (hx.tendsto 0).mono_left nhdsWithin_le_nhds rw [integral_mul_const, mul_comm] at ht apply ht.congr' filter_upwards [self_mem_nhdsWithin] with r hr exact (normalizedMass_eq_rescaled u f hr).symm /-- The same limit along any sequence of positive radii tending to zero. -/ theorem normalizedMass_small_radius_sequence {u : (Fin n → ℝ) → ℝ} (hu : Continuous u) {f : ℝ → ℝ} (hf : Continuous f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ t, R ≤ t → f t = 0) {r : ℕ → ℝ} (hr : ∀ k, 0 < r k) (hr0 : Tendsto r atTop (𝓝 0)) : Tendsto (fun k => mass u f (r k) / r k ^ n) atTop (𝓝 (u 0 * ∫ x : Fin n → ℝ, f (radiusSq x))) := by apply (normalizedMass_small_radius_limit hu hf hR hz).comp exact tendsto_nhdsWithin_iff.mpr ⟨hr0, Filter.Eventually.of_forall hr⟩ end end Source29HarmonicRadialSmallLimit /- Component: HarmonicRadialMeanValue.inc -/ namespace Source29HarmonicRadialMeanValue open MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction Source29LevelRadialStress open Source29HarmonicRadialStationarity Source29HarmonicRadialSmallLimit open scoped Topology noncomputable section variable {n : ℕ} /-- Stationarity and the small-radius limit identify every radial average. -/ theorem normalizedMass_mean_value {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (hdiv : ∀ x, divergence (fun i ↦ Pi.single i 1) g x = 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) : normalizedMass u f r = u 0 * ∫ x : Fin n → ℝ, f (radiusSq x) := by have ht := normalizedMass_small_radius_limit hu.continuous hf.continuous hR hz have hc : Tendsto (fun _s : ℝ => normalizedMass u f r) (𝓝[>] 0) (𝓝 (u 0 * ∫ x : Fin n → ℝ, f (radiusSq x))) := by apply ht.congr' filter_upwards [self_mem_nhdsWithin] with s hs exact (normalizedMass_eq hu hg hdu hdiv hf hR hr hs hz hdz).symm exact tendsto_nhds_unique tendsto_const_nhds hc /-- The radial mean-value identity holds about every center. -/ theorem radial_mean_value {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (hdiv : ∀ x, divergence (fun i ↦ Pi.single i 1) g x = 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) (a : Fin n → ℝ) : (∫ x : Fin n → ℝ, f (radiusSq x) * u (a + r • x)) = u a * ∫ x : Fin n → ℝ, f (radiusSq x) := by have hu' : ContDiff ℝ 1 (fun x ↦ u (a + x)) := hu.comp (contDiff_const.add contDiff_id) have hg' (i : Fin n) : ContDiff ℝ 1 (fun x ↦ g (a + x) i) := (hg i).comp (contDiff_const.add contDiff_id) have hdu' (x : Fin n → ℝ) (i : Fin n) : fderiv ℝ (fun y ↦ u (a + y)) x (Pi.single i 1) = g (a + x) i := by rw [fderiv_comp_add_left] exact hdu (a + x) i have hdiv' (x : Fin n → ℝ) : divergence (fun i ↦ Pi.single i 1) (fun y ↦ g (a + y)) x = 0 := by have he (i : Fin n) : fderiv ℝ (fun y ↦ g (a + y) i) x = fderiv ℝ (fun y ↦ g y i) (a + x) := fderiv_comp_add_left (f := fun y ↦ g y i) a simpa only [divergence, he] using hdiv (a + x) have he := normalizedMass_mean_value hu' hg' hdu' hdiv' hf hR hr hz hdz rw [normalizedMass, normalizedMass_eq_rescaled _ _ hr] at he simpa only [add_zero] using he end end Source29HarmonicRadialMeanValue /- Component: HarmonicRadialKernels.inc -/ namespace Source29HarmonicRadialKernels open MeasureTheory open Source29PolynomialGraphMonotonicity open Source29QuarticReuse.FluxObstruction noncomputable section /-- A wider cutoff which equals one on the support of the first cutoff's derivative. -/ def outerCutoff (s : ℝ) : ℝ := radialCutoff (s - 2) theorem outerCutoff_contDiff : ContDiff ℝ 1 outerCutoff := radialCutoff_contDiff.comp (contDiff_id.sub contDiff_const) theorem outerCutoff_nonneg (s : ℝ) : 0 ≤ outerCutoff s := (radialCutoff_bounds (s - 2)).1 theorem outerCutoff_le_one (s : ℝ) : outerCutoff s ≤ 1 := (radialCutoff_bounds (s - 2)).2 theorem outerCutoff_deriv (s : ℝ) : deriv outerCutoff s = deriv radialCutoff (s - 2) := by have h := ((radialCutoff_contDiff.differentiable (by norm_num) (s - 2)).hasDerivAt).comp s ((hasDerivAt_id s).sub_const 2) change deriv (fun t : ℝ ↦ radialCutoff (t - 2)) s = _ simpa only [Function.comp_def, id_eq, mul_one] using h.deriv theorem outerCutoff_zero (s : ℝ) (hs : 4 ≤ s) : outerCutoff s = 0 := radialCutoff_zero (s - 2) (by linarith) theorem outerCutoff_deriv_zero (s : ℝ) (hs : 4 ≤ s) : deriv outerCutoff s = 0 := by rw [outerCutoff_deriv] exact radialCutoff_deriv_zero (s - 2) (by linarith) theorem radialCutoff_one_of_nonpos (s : ℝ) (hs : s ≤ 0) : radialCutoff s = 1 := by rw [radialCutoff, Real.smoothTransition.zero_of_nonpos hs, sub_zero] theorem outerCutoff_one_of_le_two (s : ℝ) (hs : s ≤ 2) : outerCutoff s = 1 := radialCutoff_one_of_nonpos (s - 2) (by linarith) theorem radialCutoff_compact (n : ℕ) : HasCompactSupport (fun x : Fin n → ℝ ↦ radialCutoff (radiusSq x)) := by have h := Source29LevelRadialStress.radialWeight_compact (n := n) (R := 2) (r := 1) (by norm_num) (by norm_num) radialCutoff_zero change HasCompactSupport (fun x : Fin n → ℝ ↦ radialCutoff (radiusSq x / 1^2)) at h simpa only [one_pow, div_one] using h theorem outerCutoff_compact (n : ℕ) : HasCompactSupport (fun x : Fin n → ℝ ↦ outerCutoff (radiusSq x)) := by have h := Source29LevelRadialStress.radialWeight_compact (n := n) (R := 4) (r := 1) (by norm_num) (by norm_num) outerCutoff_zero change HasCompactSupport (fun x : Fin n → ℝ ↦ outerCutoff (radiusSq x / 1^2)) at h simpa only [one_pow, div_one] using h theorem radialCutoff_integrable (n : ℕ) : Integrable (fun x : Fin n → ℝ ↦ radialCutoff (radiusSq x)) := (radialCutoff_contDiff.continuous.comp radiusSq_contDiff.continuous).integrable_of_hasCompactSupport (radialCutoff_compact n) theorem outerCutoff_integrable (n : ℕ) : Integrable (fun x : Fin n → ℝ ↦ outerCutoff (radiusSq x)) := (outerCutoff_contDiff.continuous.comp radiusSq_contDiff.continuous).integrable_of_hasCompactSupport (outerCutoff_compact n) /-- The normalization mass is positive, including in dimension zero. -/ theorem radialCutoff_mass_pos (n : ℕ) : 0 < ∫ x : Fin n → ℝ, radialCutoff (radiusSq x) := by apply integral_pos_of_integrable_nonneg_nonzero (x := (0 : Fin n → ℝ)) (radialCutoff_contDiff.continuous.comp radiusSq_contDiff.continuous) (radialCutoff_integrable n) · exact fun x ↦ (radialCutoff_bounds (radiusSq x)).1 · have h0 : radiusSq (0 : Fin n → ℝ) = 0 := by simp [radiusSq] change radialCutoff (radiusSq (0 : Fin n → ℝ)) ≠ 0 rw [h0, radialCutoff_one_of_nonpos 0 le_rfl] norm_num theorem outerCutoff_mass_pos (n : ℕ) : 0 < ∫ x : Fin n → ℝ, outerCutoff (radiusSq x) := by apply integral_pos_of_integrable_nonneg_nonzero (x := (0 : Fin n → ℝ)) (outerCutoff_contDiff.continuous.comp radiusSq_contDiff.continuous) (outerCutoff_integrable n) · exact fun x ↦ outerCutoff_nonneg (radiusSq x) · have h0 : radiusSq (0 : Fin n → ℝ) = 0 := by simp [radiusSq] change outerCutoff (radiusSq (0 : Fin n → ℝ)) ≠ 0 rw [h0, outerCutoff_one_of_le_two 0 (by norm_num)] norm_num /-- A single constant bounds every coordinate derivative in every dimension by the wider kernel. -/ theorem exists_uniform_fderiv_bound : ∃ B : ℝ, 0 ≤ B ∧ ∀ (n : ℕ) (i : Fin n) (x : Fin n → ℝ), |fderiv ℝ (Source29LevelRadialStress.radialWeight radialCutoff 1) x (Pi.single i 1)| ≤ B * outerCutoff (radiusSq x) := by obtain ⟨M, hM⟩ := Source29GraphHeightProfile.profile_deriv_bounded have hM0 : 0 ≤ M := le_trans (norm_nonneg _) (hM 0) refine ⟨4 * M, by positivity, ?_⟩ intro n i x rw [Source29LevelRadialStress.radialWeight_fderiv radialCutoff_contDiff] norm_num only [one_pow, div_one] by_cases hx : radiusSq x ≤ 2 · rw [outerCutoff_one_of_le_two _ hx, mul_one] have hxi : |x i| ≤ 2 := by have hi : (x i)^2 ≤ radiusSq x := by exact Finset.single_le_sum (fun j _ ↦ sq_nonneg (x j)) (Finset.mem_univ i) nlinarith [sq_abs (x i), abs_nonneg (x i)] have hd : |deriv radialCutoff (radiusSq x)| ≤ M := by simpa [radialCutoff_deriv, Real.norm_eq_abs] using hM (radiusSq x) rw [abs_mul, abs_mul, abs_of_nonneg (by norm_num : (0 : ℝ) ≤ 2)] nlinarith [abs_nonneg (deriv radialCutoff (radiusSq x)), abs_nonneg (x i), mul_le_mul hd hxi (abs_nonneg (x i)) hM0] · rw [radialCutoff_deriv_zero _ (by linarith), mul_zero, zero_mul, abs_zero] exact mul_nonneg (by positivity) (outerCutoff_nonneg _) end end Source29HarmonicRadialKernels /- Component: CompactConvolutionDerivative.inc -/ namespace Source29CompactConvolutionDerivative open MeasureTheory Set open Source29QuarticReuse.FluxObstruction Source29CompactParameterIntegral open scoped Topology noncomputable section variable {n : ℕ} /-- Translate the centre of a compact convolution along an arbitrary vector. The differentiated function need only be C1, with no global growth bound. -/ theorem integral_hasDerivAt {ρ u : (Fin n → ℝ) → ℝ} (hρ : Continuous ρ) (hcρ : HasCompactSupport ρ) (hu : ContDiff ℝ 1 u) (a v : Fin n → ℝ) (r t : ℝ) : Integrable (fun x ↦ ρ x * fderiv ℝ u (a + t • v + r • x) v) ∧ HasDerivAt (fun s : ℝ ↦ ∫ x, ρ x * u (a + s • v + r • x)) (∫ x, ρ x * fderiv ℝ u (a + t • v + r • x) v) t := by have hdv : Continuous (fun x ↦ fderiv ℝ u x v) := (hu.continuous_fderiv (by norm_num)).clm_apply continuous_const apply hasDerivAt_integral (F := fun s x ↦ ρ x * u (a + s • v + r • x)) (F' := fun s x ↦ ρ x * fderiv ℝ u (a + s • v + r • x) v) (r := t) (a := t-1) (b := t+1) (K := tsupport ρ) (by linarith) (by linarith) hcρ · intro s hs exact hρ.mul (hu.continuous.comp (by fun_prop)) · intro s hs exact hρ.mul (hdv.comp (by fun_prop)) · exact ((hρ.comp continuous_snd).mul (hdv.comp (by fun_prop))).continuousOn · intro s hs x hx rw [image_eq_zero_of_notMem_tsupport hx, zero_mul] · intro s hs x hx rw [image_eq_zero_of_notMem_tsupport hx, zero_mul] · intro x s hs have ha : HasDerivAt (fun b : ℝ ↦ a + b • v + r • x) v s := by simpa only [one_smul, id_eq] using (((hasDerivAt_id s).smul_const v).const_add a).add_const (r • x) exact (((hu.differentiable (by norm_num) _).hasFDerivAt).comp_hasDerivAt s ha).const_mul (ρ x) /-- Differentiating a function after an affine scalar dilation multiplies its directional derivative by the dilation radius. -/ theorem affine_fderiv {u : (Fin n → ℝ) → ℝ} (hu : ContDiff ℝ 1 u) (a v x : Fin n → ℝ) (r : ℝ) : fderiv ℝ (fun y ↦ u (a + r • y)) x v = r * fderiv ℝ u (a + r • x) v := by have hd := ((hu.differentiable (by norm_num) _).hasFDerivAt).comp x (((hasFDerivAt_id x).const_smul r).const_add a) have he := congrArg (fun D : (Fin n → ℝ) →L[ℝ] ℝ ↦ D v) hd.fderiv simpa only [Function.comp_def, ContinuousLinearMap.comp_apply, _root_.smul_apply, ContinuousLinearMap.id_apply, map_smul, smul_eq_mul, id_eq, Pi.smul_apply] using he /-- Integration by parts moves a directional derivative onto the compact kernel, recording the scalar dilation exactly. -/ theorem scaled_integral_derivative {ρ u : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hu : ContDiff ℝ 1 u) (a v : Fin n → ℝ) (r : ℝ) : r * (∫ x, ρ x * fderiv ℝ u (a + r • x) v) = -(∫ x, fderiv ℝ ρ x v * u (a + r • x)) := by have he := integral_mul_fderiv_eq_neg_of_compactSupport (μ := volume) hρ hcρ (hu.comp (by fun_prop : ContDiff ℝ 1 (fun x : Fin n → ℝ ↦ a + r • x))) v change (∫ x, ρ x * fderiv ℝ (fun y ↦ u (a + r • y)) x v) = -(∫ x, fderiv ℝ ρ x v * u (a + r • x)) at he simp_rw [affine_fderiv hu a v] at he have hp : (fun x ↦ ρ x * (r * fderiv ℝ u (a + r • x) v)) = fun x ↦ r * (ρ x * fderiv ℝ u (a + r • x) v) := by funext x ring rw [hp, integral_const_mul] at he exact he /-- A mean-value identity for every centre also holds after differentiation in the centre. This uses C1 regularity, not harmonicity of the derivative. -/ theorem derivative_mean_value {ρ u : (Fin n → ℝ) → ℝ} (hρ : Continuous ρ) (hcρ : HasCompactSupport ρ) (hu : ContDiff ℝ 1 u) (r C : ℝ) (hmean : ∀ a : Fin n → ℝ, (∫ x, ρ x * u (a + r • x)) = C * u a) (a v : Fin n → ℝ) : (∫ x, ρ x * fderiv ℝ u (a + r • x) v) = C * fderiv ℝ u a v := by have hd := (integral_hasDerivAt hρ hcρ hu a v r 0).2 have he : (fun s : ℝ ↦ ∫ x, ρ x * u (a + s • v + r • x)) = fun s : ℝ ↦ C * u (a + s • v) := by funext s exact hmean (a + s • v) rw [he] at hd have ha : HasDerivAt (fun s : ℝ ↦ a + s • v) v 0 := by simpa only [one_smul, id_eq] using ((hasDerivAt_id (0 : ℝ)).smul_const v).const_add a have hu' := (((hu.differentiable (by norm_num) _).hasFDerivAt).comp_hasDerivAt 0 ha).const_mul C simpa only [zero_smul, add_zero] using hd.unique hu' end end Source29CompactConvolutionDerivative /- Component: MeanValueGradientBound.inc -/ namespace Source29MeanValueGradientBound open MeasureTheory Set open Source29CompactConvolutionDerivative open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem directional_bound {u ρ σ : (Fin n → ℝ) → ℝ} (hu : ContDiff ℝ 1 u) (hupos : ∀ x, 0 ≤ u x) (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hσ : Continuous σ) (hcσ : HasCompactSupport σ) (C S B r : ℝ) (hC : 0 < C) (hr : 0 < r) (hmeanρ : ∀ a : Fin n → ℝ, (∫ x, ρ x * u (a + r • x)) = C * u a) (hmeanσ : ∀ a : Fin n → ℝ, (∫ x, σ x * u (a + r • x)) = S * u a) (v : Fin n → ℝ) (hbound : ∀ x, |fderiv ℝ ρ x v| ≤ B * σ x) (a : Fin n → ℝ) : r * C * |fderiv ℝ u a v| ≤ B * S * u a := by have huc : Continuous (fun x : Fin n → ℝ ↦ u (a + r • x)) := hu.continuous.comp (by fun_prop) have hdc : Continuous (fun x ↦ fderiv ℝ ρ x v) := (hρ.continuous_fderiv (by norm_num)).clm_apply continuous_const have hJ : Integrable (fun x ↦ fderiv ℝ ρ x v * u (a + r • x)) := (hdc.mul huc).integrable_of_hasCompactSupport (hcρ.fderiv_apply ℝ v).mul_right have hK : Integrable (fun x ↦ σ x * u (a + r • x)) := (hσ.mul huc).integrable_of_hasCompactSupport hcσ.mul_right have hi : |∫ x, fderiv ℝ ρ x v * u (a + r • x)| ≤ B * S * u a := by calc _ ≤ ∫ x, |fderiv ℝ ρ x v * u (a + r • x)| := abs_integral_le_integral_abs _ ≤ ∫ x, B * (σ x * u (a + r • x)) := by apply integral_mono hJ.abs (hK.const_mul B) intro x change |fderiv ℝ ρ x v * u (a + r • x)| ≤ B * (σ x * u (a + r • x)) rw [abs_mul, abs_of_nonneg (hupos _)] calc _ ≤ (B * σ x) * u (a + r • x) := mul_le_mul_of_nonneg_right (hbound x) (hupos _) _ = _ := by ring _ = B * S * u a := by rw [integral_const_mul, hmeanσ a]; ring have he := scaled_integral_derivative hρ hcρ hu a v r rw [derivative_mean_value hρ.continuous hcρ hu r C hmeanρ a v] at he have ha := congrArg abs he simp only [abs_mul, abs_of_pos hr, abs_of_pos hC, abs_neg] at ha calc _ = |∫ x, fderiv ℝ ρ x v * u (a + r • x)| := by nlinarith [ha] _ ≤ _ := hi /-- Two compact mean-value kernels, one controlling the first derivatives of the other, force every nonnegative C1 function with those mean values to be constant. -/ theorem constant_of_mean_value_kernels {u ρ σ : (Fin n → ℝ) → ℝ} (hu : ContDiff ℝ 1 u) (hupos : ∀ x, 0 ≤ u x) (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hσ : Continuous σ) (hcσ : HasCompactSupport σ) (C S : ℝ) (hC : 0 < C) (hmeanρ : ∀ r : ℝ, 0 < r → ∀ a : Fin n → ℝ, (∫ x, ρ x * u (a + r • x)) = C * u a) (hmeanσ : ∀ r : ℝ, 0 < r → ∀ a : Fin n → ℝ, (∫ x, σ x * u (a + r • x)) = S * u a) (hbound : ∀ i : Fin n, ∃ B : ℝ, ∀ x, |fderiv ℝ ρ x (Pi.single i 1)| ≤ B * σ x) (a b : Fin n → ℝ) : u a = u b := by have hz (x : Fin n → ℝ) (i : Fin n) : fderiv ℝ u x (Pi.single i 1) = 0 := by obtain ⟨B,hB⟩ := hbound i by_contra hn have hD : 0 < C * |fderiv ℝ u x (Pi.single i 1)| := mul_pos hC (abs_pos.mpr hn) let M := B * S * u x let r := (|M|+1) / (C * |fderiv ℝ u x (Pi.single i 1)|) have hr : 0 < r := div_pos (by positivity) hD have hbnd := directional_bound hu hupos hρ hcρ hσ hcσ C S B r hC hr (hmeanρ r hr) (hmeanσ r hr) (Pi.single i 1) hB x have he : r * C * |fderiv ℝ u x (Pi.single i 1)| = |M|+1 := by dsimp only [r] field_simp rw [he] at hbnd change |M|+1 ≤ M at hbnd linarith [le_abs_self M] have hzero (x : Fin n → ℝ) : fderiv ℝ u x = 0 := by ext v have hv : v = ∑ i, v i • Pi.single i 1 := by funext j simp [Pi.single_apply] rw [hv, map_sum] simp only [map_smul, smul_eq_mul, hz, mul_zero, Finset.sum_const_zero, zero_apply] exact is_const_of_fderiv_eq_zero (hu.differentiable (by norm_num)) hzero a b end end Source29MeanValueGradientBound /- Component: PositiveHarmonicLiouville.inc -/ namespace Source29PositiveHarmonicLiouville open MeasureTheory open Source29QuarticReuse.FluxObstruction open Source29PolynomialGraphMonotonicity Source29HarmonicRadialKernels noncomputable section variable {n : ℕ} /-- A nonnegative entire real harmonic function is constant, in any finite dimension. -/ theorem eq_of_nonnegative_harmonic {u : (Fin n → ℝ) → ℝ} {g : (Fin n → ℝ) → Fin n → ℝ} (hu : ContDiff ℝ 1 u) (hg : ∀ i, ContDiff ℝ 1 (fun x ↦ g x i)) (hdu : ∀ x i, fderiv ℝ u x (Pi.single i 1) = g x i) (hdiv : ∀ x, divergence (fun i ↦ Pi.single i 1) g x = 0) (hupos : ∀ x, 0 ≤ u x) (a b : Fin n → ℝ) : u a = u b := by let ρ : (Fin n → ℝ) → ℝ := fun x ↦ radialCutoff (radiusSq x) let σ : (Fin n → ℝ) → ℝ := fun x ↦ outerCutoff (radiusSq x) have hρ : ContDiff ℝ 1 ρ := radialCutoff_contDiff.comp radiusSq_contDiff have hσ : Continuous σ := outerCutoff_contDiff.continuous.comp radiusSq_contDiff.continuous have hmρ (r : ℝ) (hr : 0 < r) (a : Fin n → ℝ) : (∫ x, ρ x * u (a + r • x)) = (∫ x, ρ x) * u a := by simpa only [ρ, mul_comm] using Source29HarmonicRadialMeanValue.radial_mean_value hu hg hdu hdiv radialCutoff_contDiff (by norm_num : (0 : ℝ) ≤ 2) hr radialCutoff_zero radialCutoff_deriv_zero a have hmσ (r : ℝ) (hr : 0 < r) (a : Fin n → ℝ) : (∫ x, σ x * u (a + r • x)) = (∫ x, σ x) * u a := by simpa only [σ, mul_comm] using Source29HarmonicRadialMeanValue.radial_mean_value hu hg hdu hdiv outerCutoff_contDiff (by norm_num : (0 : ℝ) ≤ 4) hr outerCutoff_zero outerCutoff_deriv_zero a have hb (i : Fin n) : ∃ B : ℝ, ∀ x, |fderiv ℝ ρ x (Pi.single i 1)| ≤ B * σ x := by obtain ⟨B, _, hB⟩ := exists_uniform_fderiv_bound refine ⟨B, ?_⟩ intro x have he : Source29LevelRadialStress.radialWeight radialCutoff 1 = ρ := by funext y simp [Source29LevelRadialStress.radialWeight, ρ] simpa only [he] using hB n i x exact Source29MeanValueGradientBound.constant_of_mean_value_kernels hu hupos hρ (radialCutoff_compact n) hσ (outerCutoff_compact n) (∫ x, ρ x) (∫ x, σ x) (radialCutoff_mass_pos n) hmρ hmσ hb a b end end Source29PositiveHarmonicLiouville /- Component: NewtonRootConstant.inc -/ namespace Source29NewtonRootConstant open MvPolynomial open Source29NewtonNormalDerivative Source29NewtonPositiveRoot open Source29NewtonRootAnalytic Source29NewtonRootHarmonic open Source29QuarticReuse.QuarticMinimal.DistinguishedVariable noncomputable section variable {n : ℕ} /-- The positive normal root is an entire nonnegative harmonic function, and hence is constant in the tangential variables. -/ theorem positiveRoot_constant (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (hpos : ∀ z : Fin (n + 1) → ℝ, 0 < z 0 → 0 ≤ eval z N) (hneg : ∀ z : Fin (n + 1) → ℝ, z 0 < 0 → eval z N ≤ 0) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (t : ℝ) (ht : 0 < t) (a b : Fin n → ℝ) : positiveRoot N t a = positiveRoot N t b := by have ha := analyticAt_positiveRoot N α D hD hEuler hE hpos hneg d hd c hc hcoeff t ht have hp := positiveRoot_properties N α D hD hEuler hE hpos hneg d hd c hc hcoeff t ht have hu : ContDiff ℝ 1 (positiveRoot N t) := by rw [contDiff_iff_contDiffAt] exact fun y => (ha y).contDiffAt exact Source29PositiveHarmonicLiouville.eq_of_nonnegative_harmonic hu (coordinateGradient_contDiff (positiveRoot N t) ha) (fun _ _ => rfl) (coordinateGradient_divergence_eq_zero N hE (positiveRoot N t) t ha (fun y => (hp y).2.1) (fun y => (hp y).2.2)) (fun y => (hp y).1.le) a b /-- Weak sign and the Newton equation imply strict positivity throughout the positive normal half-space. -/ theorem eval_pos_of_normal_pos (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (hpos : ∀ z : Fin (n + 1) → ℝ, 0 < z 0 → 0 ≤ eval z N) (hneg : ∀ z : Fin (n + 1) → ℝ, z 0 < 0 → eval z N ≤ 0) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (y : Fin n → ℝ) {x : ℝ} (hx : 0 < x) : 0 < eval (Fin.cons x y) N := by have hp : ∀ s, 0 < s → 0 ≤ (sliceHom y N).eval s := by intro s hs rw [eval_sliceHom] exact hpos (Fin.cons s y) hs have hn : ∀ s, s < 0 → (sliceHom y N).eval s ≤ 0 := by intro s hs rw [eval_sliceHom] exact hneg (Fin.cons s y) hs have hr : ∀ s, (sliceHom y N).eval s ≠ 0 → (sliceHom y N).derivative.eval s ≠ 0 := by intro s hs rw [← sliceHom_pderiv_zero, eval_sliceHom] apply normal_derivative_ne_zero_of_constant_coefficient N α D hD hEuler hE d hd c hc hcoeff rwa [eval_sliceHom] at hs simpa only [eval_sliceHom] using Source29PolynomialPhaseRoot.eval_pos_of_pos (sliceHom y N) (slice_ne_zero N d c hc hcoeff y) (Source29PolynomialPhaseRoot.eval_zero_of_sign (sliceHom y N) hp hn) hp hr hx /-- All normal slices coincide as polynomials, since their positive level roots coincide and their values are strictly positive on the positive axis. -/ theorem sliceHom_independent (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (hpos : ∀ z : Fin (n + 1) → ℝ, 0 < z 0 → 0 ≤ eval z N) (hneg : ∀ z : Fin (n + 1) → ℝ, z 0 < 0 → eval z N ≤ 0) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (y : Fin n → ℝ) : sliceHom y N = sliceHom 0 N := by apply Polynomial.eq_of_infinite_eval_eq apply (Set.Ioi_infinite (0 : ℝ)).mono intro x hx let t := eval (Fin.cons x (0 : Fin n → ℝ)) N have ht : 0 < t := eval_pos_of_normal_pos N α D hD hEuler hE hpos hneg d hd c hc hcoeff 0 hx have he : positiveRoot N t 0 = x := positiveRoot_eq_of_root N t 0 (existsUnique_positive_normal_root N α D hD hEuler hE hpos hneg d hd c hc hcoeff t ht 0) hx rfl have hy : positiveRoot N t y = x := (positiveRoot_constant N α D hD hEuler hE hpos hneg d hd c hc hcoeff t ht y 0).trans he have hv := (positiveRoot_properties N α D hD hEuler hE hpos hneg d hd c hc hcoeff t ht y).2.1 rw [hy] at hv change (sliceHom y N).eval x = (sliceHom 0 N).eval x simpa only [eval_sliceHom] using hv /-- Evaluation of N is independent of all tangential variables, including at negative normal coordinates. Polynomial identity extends the positive-axis result. -/ theorem eval_independent_of_tangential (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (hpos : ∀ z : Fin (n + 1) → ℝ, 0 < z 0 → 0 ≤ eval z N) (hneg : ∀ z : Fin (n + 1) → ℝ, z 0 < 0 → eval z N ≤ 0) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (x : ℝ) (y : Fin n → ℝ) : eval (Fin.cons x y) N = eval (Fin.cons x (0 : Fin n → ℝ)) N := by simpa only [eval_sliceHom] using congrArg (fun p : Polynomial ℝ => p.eval x) (sliceHom_independent N α D hD hEuler hE hpos hneg d hd c hc hcoeff y) /-- The polynomial in the distinguished variable has scalar coefficients. -/ theorem finSuccEquiv_eq_map (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (hpos : ∀ z : Fin (n + 1) → ℝ, 0 < z 0 → 0 ≤ eval z N) (hneg : ∀ z : Fin (n + 1) → ℝ, z 0 < 0 → eval z N ≤ 0) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) : finSuccEquiv ℝ n N = (sliceHom 0 N).map (C : ℝ →+* MvPolynomial (Fin n) ℝ) := by apply Polynomial.ext intro k apply Source29QuarticReuse.QuarticCompatibility.polynomial_funext intro y rw [Polynomial.coeff_map, eval_C] have he := congrArg (fun p : Polynomial ℝ => p.coeff k) (sliceHom_independent N α D hD hEuler hE hpos hneg d hd c hc hcoeff y) change (((finSuccEquiv ℝ n N).map (eval y)).coeff k) = _ at he simpa only [Polynomial.coeff_map] using he /-- Every tangential partial derivative of N vanishes. -/ theorem tangential_pderiv_eq_zero (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (hpos : ∀ z : Fin (n + 1) → ℝ, 0 < z 0 → 0 ≤ eval z N) (hneg : ∀ z : Fin (n + 1) → ℝ, z 0 < 0 → eval z N ≤ 0) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (i : Fin n) : pderiv i.succ N = 0 := by apply (finSuccEquiv ℝ n).injective apply Polynomial.ext intro k rw [map_zero, Polynomial.coeff_zero, coeff_finSuccEquiv_pderiv_succ, finSuccEquiv_eq_map N α D hD hEuler hE hpos hneg d hd c hc hcoeff, Polynomial.coeff_map, pderiv_C] end end Source29NewtonRootConstant /- Component: NewtonPureNormalPower.inc -/ namespace Source29NewtonPureNormalPower open MvPolynomial open Source29NewtonNormalDerivative open Source29QuarticReuse.QuarticMinimal.DistinguishedVariable noncomputable section lemma coeff_X_mul_derivative {R : Type*} [CommSemiring R] (P : Polynomial R) (k : ℕ) : (Polynomial.X * P.derivative).coeff k = P.coeff k * (k : R) := by cases k with | zero => simp | succ k => simp only [Polynomial.coeff_X_mul, Polynomial.coeff_derivative, Nat.cast_succ] lemma weighted_derivative_coefficient {R : Type*} [CommRing R] (P : Polynomial R) (a b : R) (he : Polynomial.C a * Polynomial.X * P.derivative = Polynomial.C b * P) (k : ℕ) : a * (k : R) * P.coeff k = b * P.coeff k := by have hk := congrArg (fun Q : Polynomial R ↦ Q.coeff k) he rw [mul_assoc, Polynomial.coeff_C_mul, coeff_X_mul_derivative, Polynomial.coeff_C_mul] at hk calc a * (k : R) * P.coeff k = a * (P.coeff k * (k : R)) := by ring _ = b * P.coeff k := hk /-- A nonzero coefficient of a polynomial satisfying a weighted Euler equation fixes its unique possible degree. -/ theorem eq_monomial_of_weighted_derivative {R : Type*} [CommRing R] [IsDomain R] [CharZero R] (P : Polynomial R) (a b : R) (ha : a ≠ 0) (he : Polynomial.C a * Polynomial.X * P.derivative = Polynomial.C b * P) (d : ℕ) (hd : P.coeff d ≠ 0) : P = Polynomial.C (P.coeff d) * Polynomial.X ^ d := by have hdegree : a * (d : R) = b := mul_right_cancel₀ hd (weighted_derivative_coefficient P a b he d) apply Polynomial.ext intro k rw [Polynomial.coeff_C_mul_X_pow] by_cases hkd : k = d · simp [hkd] · rw [ite_eq_right hkd] by_contra hk have hkdegree : a * (k : R) = b := mul_right_cancel₀ hk (weighted_derivative_coefficient P a b he k) exact hkd (Nat.cast_injective (mul_left_cancel₀ ha (hkdegree.trans hdegree.symm))) variable {n : ℕ} lemma finSuccEquiv_C_scalar (c : ℝ) : finSuccEquiv ℝ n (C c) = Polynomial.C (C c) := by rw [finSuccEquiv_apply] simp only [eval₂Hom_C, RingHom.comp_apply] lemma normal_euler (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hEuler : WeightedEuler N α D) (htangent : ∀ i : Fin n, pderiv i.succ N = 0) : Polynomial.C (C α) * Polynomial.X * (finSuccEquiv ℝ n N).derivative = Polynomial.C (C D) * finSuccEquiv ℝ n N := by have hsource : C α * X 0 * pderiv 0 N = C D * N := by simpa only [WeightedEuler, htangent, mul_zero, Finset.sum_const_zero, add_zero] using hEuler have h := congrArg (finSuccEquiv ℝ n) hsource simpa only [map_mul, finSuccEquiv_pderiv_zero, finSuccEquiv_X_zero, finSuccEquiv_C_scalar] using h /-- After tangential independence, any nonzero constant normal coefficient and nonzero normal weight determine the whole polynomial. -/ theorem eq_pure_normal_power (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hα : α ≠ 0) (hEuler : WeightedEuler N α D) (htangent : ∀ i : Fin n, pderiv i.succ N = 0) (d : ℕ) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) : N = C c * (X 0)^d := by have hαC : (C α : MvPolynomial (Fin n) ℝ) ≠ 0 := by simpa using hα have hd : (finSuccEquiv ℝ n N).coeff d ≠ 0 := by rw [hcoeff]; simpa using hc have h := eq_monomial_of_weighted_derivative (finSuccEquiv ℝ n N) (C α) (C D) hαC (normal_euler N α D hEuler htangent) d hd apply (finSuccEquiv ℝ n).injective rw [h, hcoeff] simp only [map_mul, map_pow, finSuccEquiv_X_zero, finSuccEquiv_C_scalar] /-- The nonzero total weighted degree already forces the normal weight to be nonzero, so no additional weight hypothesis is needed after independence. -/ theorem eq_pure_normal_power_of_degree_ne_zero (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hD : D ≠ 0) (hEuler : WeightedEuler N α D) (htangent : ∀ i : Fin n, pderiv i.succ N = 0) (d : ℕ) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) : N = C c * (X 0)^d := by have hα : α ≠ 0 := by intro hz have he := weighted_derivative_coefficient (finSuccEquiv ℝ n N) (C α) (C D) (normal_euler N α D hEuler htangent) d rw [hz, map_zero, zero_mul, zero_mul, hcoeff] at he have hDc : (C D : MvPolynomial (Fin n) ℝ) * C c ≠ 0 := mul_ne_zero (by simpa using hD) (by simpa using hc) exact hDc he.symm exact eq_pure_normal_power N α D hα hEuler htangent d c hc hcoeff /-- The surviving normal degree also determines the total weighted degree. -/ theorem weighted_degree_eq (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hEuler : WeightedEuler N α D) (htangent : ∀ i : Fin n, pderiv i.succ N = 0) (d : ℕ) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) : D = α * (d : ℝ) := by have hd : (finSuccEquiv ℝ n N).coeff d ≠ 0 := by rw [hcoeff]; simpa using hc have he := mul_right_cancel₀ hd (weighted_derivative_coefficient (finSuccEquiv ℝ n N) (C α) (C D) (normal_euler N α D hEuler htangent) d) have hv := congrArg (eval (0 : Fin n → ℝ)) he simpa only [map_mul, eval_C, map_natCast] using hv.symm /-- The two half-space signs make a nonzero pure normal power positive and odd. -/ theorem coefficient_pos_and_degree_odd (N : MvPolynomial (Fin (n + 1)) ℝ) (d : ℕ) (c : ℝ) (hc : c ≠ 0) (hN : N = C c * (X 0)^d) (hpos : ∀ z : Fin (n + 1) → ℝ, 0 < z 0 → 0 ≤ eval z N) (hneg : ∀ z : Fin (n + 1) → ℝ, z 0 < 0 → eval z N ≤ 0) : 0 < c ∧ Odd d := by have hp := hpos (fun _ ↦ 1) (by norm_num) have hm := hneg (fun _ ↦ -1) (by norm_num) rw [hN] at hp hm simp only [map_mul, map_pow, eval_C, eval_X, one_pow, mul_one] at hp hm have hcpos : 0 < c := lt_of_le_of_ne hp hc.symm refine ⟨hcpos, ?_⟩ rcases Nat.even_or_odd d with hd | hd · rw [hd.neg_one_pow, mul_one] at hm linarith · exact hd end end Source29NewtonPureNormalPower /- Component: NewtonPolynomialRigidity.inc -/ namespace Source29NewtonPolynomialRigidity open MvPolynomial open Source29NewtonNormalDerivative open Source29NewtonRootConstant Source29NewtonPureNormalPower noncomputable section variable {n : ℕ} /-- A Newton polynomial with the prescribed half-space sign and a fixed nonzero positive-degree normal coefficient is a pure normal power. -/ theorem eq_pure_normal_power (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (hpos : ∀ z : Fin (n + 1) → ℝ, 0 < z 0 → 0 ≤ eval z N) (hneg : ∀ z : Fin (n + 1) → ℝ, z 0 < 0 → eval z N ≤ 0) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) : N = C c * (X 0)^d := eq_pure_normal_power_of_degree_ne_zero N α D hD.ne' hEuler (tangential_pderiv_eq_zero N α D hD hEuler hE hpos hneg d hd c hc hcoeff) d c hc hcoeff /-- The same hypotheses determine all signs, parity, and the weighted degree: the surviving normal power is positive and odd, with D = α d and α > 0. -/ theorem classification (N : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (hpos : ∀ z : Fin (n + 1) → ℝ, 0 < z 0 → 0 ≤ eval z N) (hneg : ∀ z : Fin (n + 1) → ℝ, z 0 < 0 → eval z N ≤ 0) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) : N = C c * (X 0)^d ∧ 0 < c ∧ Odd d ∧ D = α * (d : ℝ) ∧ 0 < α := by have hN := eq_pure_normal_power N α D hD hEuler hE hpos hneg d hd c hc hcoeff obtain ⟨hcpos, hodd⟩ := coefficient_pos_and_degree_odd N d c hc hN hpos hneg have hw := weighted_degree_eq N α D hEuler (tangential_pderiv_eq_zero N α D hD hEuler hE hpos hneg d hd c hc hcoeff) d c hc hcoeff have hdpos : 0 < (d : ℝ) := by exact_mod_cast hd refine ⟨hN, hcpos, hodd, hw, ?_⟩ nlinarith end end Source29NewtonPolynomialRigidity /- Component: LocalRegularPatchDensity.inc -/ namespace Source29LocalRegularPatchDensity open MvPolynomial MeasureTheory Filter Set open Source29NewtonNormalDerivative open Source29QuarticReuse.FluxPolynomial Source29QuarticReuse.FluxObstruction open scoped Topology noncomputable section variable {n : ℕ} /-- An irreducible polynomial sharing a root with a cofactor on an open parameter germ must divide that cofactor. No regularity of the root choice is needed. -/ theorem dvd_of_common_root_germ (p q : Polynomial (MvPolynomial (Fin n) ℝ)) (hp : Irreducible p) (hdeg : p.natDegree ≠ 0) (a : Fin n → ℝ) (g : (Fin n → ℝ) → ℝ) (hroot : ∀ᶠ y in 𝓝 a, (p.map (eval y)).eval (g y) = 0 ∧ (q.map (eval y)).eval (g y) = 0) : p ∣ q := by by_contra hnd obtain ⟨D, A, B, hD, hcert⟩ := Source29RealSliceBezout.exists_coprime_certificate (FractionRing (MvPolynomial (Fin n) ℝ)) p q hp hdeg hnd obtain ⟨U, hUsub, hUopen, haU⟩ := mem_nhds_iff.mp hroot have hUpos : 0 < volume U := hUopen.measure_pos volume ⟨a, haU⟩ obtain ⟨y, hyU, hyD⟩ := Measure.exists_mem_of_measure_ne_zero_of_ae hUpos.ne' (ae_restrict_of_ae (mvPolynomial_eval_ne_zero_ae n D hD)) have hy := hUsub hyU exact (Source29RealSliceBezout.cofactor_ne_zero_of_certificate p q D A B hcert (eval y) hyD (g y) hy.1) hy.2 /-- A nonzero normal derivative forces positive degree in the normal variable. -/ theorem normal_natDegree_ne_zero (P : MvPolynomial (Fin (n + 1)) ℝ) (z : Fin (n + 1) → ℝ) (hn : eval z (pderiv 0 P) ≠ 0) : (finSuccEquiv ℝ n P).natDegree ≠ 0 := by intro hd let a : Fin n → ℝ := fun i ↦ z i.succ have hzcons : (Fin.cons (z 0) a : Fin (n + 1) → ℝ) = z := by funext i exact Fin.cases rfl (fun _ ↦ rfl) i have hslice : sliceHom a P = Polynomial.C (eval a ((finSuccEquiv ℝ n P).coeff 0)) := by change Polynomial.map (eval a) (finSuccEquiv ℝ n P) = _ rw [Polynomial.eq_C_of_natDegree_eq_zero hd, Polynomial.map_C] simp apply hn rw [← hzcons, ← eval_sliceHom, sliceHom_pderiv_zero, hslice] simp /-- Common vanishing on a local graph forces divisibility. -/ theorem dvd_of_common_graph_germ (P Q : MvPolynomial (Fin (n + 1)) ℝ) (hP : Irreducible P) (z : Fin (n + 1) → ℝ) (hn : eval z (pderiv 0 P) ≠ 0) (a : Fin n → ℝ) (g : (Fin n → ℝ) → ℝ) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0 ∧ eval (Fin.cons (g y) y) Q = 0) : P ∣ Q := by have hdvd : finSuccEquiv ℝ n P ∣ finSuccEquiv ℝ n Q := by apply dvd_of_common_root_germ _ _ ((MulEquiv.irreducible_iff (finSuccEquiv ℝ n)).mpr hP) (normal_natDegree_ne_zero P z hn) a g filter_upwards [hroot] with y hy exact ⟨(eval_sliceHom P y (g y)).trans hy.1, (eval_sliceHom Q y (g y)).trans hy.2⟩ exact (map_dvd_iff (finSuccEquiv ℝ n).toRingEquiv).mp hdvd /-- The restriction of a nondivisible cofactor to a local regular graph cannot vanish as a germ. This supplies a nonzero coefficient for Newton extraction. -/ theorem restriction_not_eventually_zero (P Q : MvPolynomial (Fin (n + 1)) ℝ) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (z : Fin (n + 1) → ℝ) (hn : eval z (pderiv 0 P) ≠ 0) (a : Fin n → ℝ) (g : (Fin n → ℝ) → ℝ) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0) : ¬ ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) Q = 0 := by intro hQ exact hPQ (dvd_of_common_graph_germ P Q hP z hn a g (hroot.and hQ)) /-- A cofactor vanishing on a neighborhood of one regular real point of an irreducible hypersurface is divisible by its defining polynomial. -/ theorem dvd_of_vanishing_on_regular_patch (P Q : MvPolynomial (Fin (n + 1)) ℝ) (hP : Irreducible P) (z : Fin (n + 1) → ℝ) (hz : eval z P = 0) (hn : eval z (pderiv 0 P) ≠ 0) (hQ : ∀ᶠ x in 𝓝 z, eval x P = 0 → eval x Q = 0) : P ∣ Q := by let a : Fin n → ℝ := fun i ↦ z i.succ obtain ⟨g, hg, hg0, hglevel⟩ := Source29RealImplicitPolynomialRoot.exists_local_level_graph P z hn have hzcons : (Fin.cons (z 0) a : Fin (n + 1) → ℝ) = z := by funext i exact Fin.cases rfl (fun _ ↦ rfl) i have hcont : ContinuousAt (fun y : Fin n → ℝ ↦ (Fin.cons (g y) y : Fin (n + 1) → ℝ)) a := by apply continuousAt_pi.mpr intro i exact Fin.cases hg.continuousAt (fun j ↦ (continuous_apply j).continuousAt) i have hnear : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0 → eval (Fin.cons (g y) y) Q = 0 := by have he : (Fin.cons (g a) a : Fin (n + 1) → ℝ) = z := by rw [hg0]; exact hzcons have ht : Tendsto (fun y : Fin n → ℝ ↦ (Fin.cons (g y) y : Fin (n + 1) → ℝ)) (𝓝 a) (𝓝 z) := by simpa only [he] using hcont.tendsto exact ht.eventually hQ apply dvd_of_common_graph_germ P Q hP z hn a g filter_upwards [hglevel, hnear] with y hy hqy have hp : eval (Fin.cons (g y) y) P = 0 := hy.trans hz exact ⟨hp, hqy hp⟩ /-- A nondivisible cofactor is nonzero arbitrarily close to every regular real point along the irreducible hypersurface. -/ theorem frequently_nonzero_on_regular_patch (P Q : MvPolynomial (Fin (n + 1)) ℝ) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (z : Fin (n + 1) → ℝ) (hz : eval z P = 0) (hn : eval z (pderiv 0 P) ≠ 0) : ∃ᶠ x in 𝓝 z, eval x P = 0 ∧ eval x Q ≠ 0 := by by_contra h have he : ∀ᶠ x in 𝓝 z, eval x P = 0 → eval x Q = 0 := by simpa only [Filter.not_frequently, not_and, not_not] using h exact hPQ (dvd_of_vanishing_on_regular_patch P Q hP z hz hn he) end end Source29LocalRegularPatchDensity /- Component: LevelRadialDefect.inc -/ namespace Source29LevelRadialDefect open MvPolynomial MeasureTheory open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29VariationConvexity Source29WeakCalibrationLimits open Source29PolynomialStress Source29LevelStressStationarity Source29LevelRadialStress open Source29WeightedRadialDerivative Source29LevelRadialMonotonicity noncomputable section variable {n : ℕ} /-- The exact radial defect for a smooth level weight. -/ def radialDefect (P : MvPolynomial (Fin n) ℝ) (h f : ℝ → ℝ) (r : ℝ) (x : Fin n → ℝ) : ℝ := (-2/r^2) * deriv f (radiusSq x/r^2) * (Source29NormalPenalty.dot (leadingNormalizedField P x) x)^2 * diffuseWeight P h x /-- This identity holds at critical points too; no regularity of the normalized field there is needed. -/ theorem radialDefect_identity (P : MvPolynomial (Fin (n+1)) ℝ) (h : ℝ → ℝ) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {r : ℝ} (hr : r ≠ 0) (x : Fin (n+1) → ℝ) : r * densityDeriv (diffuseWeight P h) f r x - (n : ℝ) * density (diffuseWeight P h) f r x + h (eval x P) * stressPair P (radialField f r) x = radialDefect P h f r x := by rw [stressPair_radial P hf] unfold radialDefect densityDeriv density diffuseWeight Source29LevelRadialStress.radialWeight field_simp ring /-- Integrability follows from the exact identity and compactly supported stress, without asserting continuity of the normalized field on the critical set. -/ theorem radialDefect_integrable (P : MvPolynomial (Fin (n+1)) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) : Integrable (radialDefect P h f r) := by have hw := diffuseWeight_continuous P hh.continuous have hd := (mass_hasDerivAt hw hf hR hr hz hdz).1 have hi := density_integrable hw hf.continuous hR hr hz have hs := weighted_stress_integral_zero P hcal (radialField f r) (radialField_contDiff hf r) (radialField_compact hR hr hz) hh have he : radialDefect P h f r = (fun x ↦ r * densityDeriv (diffuseWeight P h) f r x - (n : ℝ) * density (diffuseWeight P h) f r x + h (eval x P) * stressPair P (radialField f r) x) := funext (fun x ↦ (radialDefect_identity P h hf hr.ne' x).symm) rw [he] exact ((hd.const_mul r).sub (hi.const_mul (n : ℝ))).add hs.1 /-- Radial stationarity identifies the entire radius numerator with the defect. -/ theorem radius_numerator_eq_integral (P : MvPolynomial (Fin (n+1)) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) : r * (∫ x, densityDeriv (diffuseWeight P h) f r x) - (n : ℝ) * mass (diffuseWeight P h) f r = ∫ x, radialDefect P h f r x := by have hw := diffuseWeight_continuous P hh.continuous have hd := (mass_hasDerivAt hw hf hR hr hz hdz).1 have hi := density_integrable hw hf.continuous hR hr hz have hs := weighted_stress_integral_zero P hcal (radialField f r) (radialField_contDiff hf r) (radialField_compact hR hr hz) hh have he : (∫ x, r * densityDeriv (diffuseWeight P h) f r x - (n : ℝ) * density (diffuseWeight P h) f r x + h (eval x P) * stressPair P (radialField f r) x) = ∫ x, radialDefect P h f r x := by apply integral_congr_ae exact Filter.Eventually.of_forall (radialDefect_identity P h hf hr.ne') have hadd := integral_add ((hd.const_mul r).sub (hi.const_mul (n : ℝ))) hs.1 simp only [Pi.sub_apply] at hadd rw [hadd, integral_sub (hd.const_mul r) (hi.const_mul (n : ℝ)), integral_const_mul, integral_const_mul, hs.2, add_zero] at he exact he /-- The exact derivative of normalized diffuse mass retains the radial defect. -/ theorem normalizedDiffuseMass_hasDerivAt (P : MvPolynomial (Fin (n+1)) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R r : ℝ} (hR : 0 ≤ R) (hr : 0 < r) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) : HasDerivAt (normalizedDiffuseMass P h f) ((∫ x, radialDefect P h f r x) / r^(n+1)) r := by have hd := Source29GraphMassMonotonicity.normalized_hasDerivAt (mass_hasDerivAt (diffuseWeight_continuous P hh.continuous) hf hR hr hz hdz).2 hr.ne' n rw [radius_numerator_eq_integral P hcal hh hf hR hr hz hdz] at hd exact hd theorem radialDefect_nonneg (P : MvPolynomial (Fin n) ℝ) (h f : ℝ → ℝ) (hhpos : ∀ t, 0 ≤ h t) (hdec : ∀ t, deriv f t ≤ 0) (r : ℝ) (x : Fin n → ℝ) : 0 ≤ radialDefect P h f r x := by have hwp : 0 ≤ diffuseWeight P h x := mul_nonneg (hhpos _) (Real.sqrt_nonneg _) exact mul_nonneg (mul_nonneg (mul_nonneg_of_nonpos_of_nonpos (div_nonpos_of_nonpos_of_nonneg (by norm_num) (sq_nonneg r)) (hdec _)) (sq_nonneg _)) hwp theorem integral_radialDefect_nonneg (P : MvPolynomial (Fin n) ℝ) (h f : ℝ → ℝ) (hhpos : ∀ t, 0 ≤ h t) (hdec : ∀ t, deriv f t ≤ 0) (r : ℝ) : 0 ≤ ∫ x, radialDefect P h f r x := integral_nonneg (radialDefect_nonneg P h f hhpos hdec r) end end Source29LevelRadialDefect /- Component: NewtonShiftedFactorCoefficient.inc -/ namespace Source29NewtonShiftedFactorCoefficient open MvPolynomial Filter open scoped Topology noncomputable section /-- The first possible coefficient of a power of a polynomial with zero constant term, multiplied by a cofactor. -/ theorem coeff_pow_mul_of_coeff_zero {R : Type*} [CommSemiring R] (p q : Polynomial R) (k : ℕ) (hp : p.coeff 0 = 0) : (p^k*q).coeff k = (p.coeff 1)^k * q.coeff 0 := by obtain ⟨r, rfl⟩ := Polynomial.X_dvd_iff.mpr hp rw [mul_pow, mul_assoc] have he := Polynomial.coeff_X_pow_mul (r^k*q) k 0 simpa only [zero_add, Polynomial.coeff_X_mul, Polynomial.coeff_zero_eq_eval_zero, Polynomial.eval_mul, Polynomial.eval_pow] using he /-- Every lower coefficient vanishes in the same factorization. -/ theorem coeff_pow_mul_eq_zero_of_lt {R : Type*} [CommSemiring R] (p q : Polynomial R) (k : ℕ) (hp : p.coeff 0 = 0) (j : ℕ) (hj : j < k) : (p^k*q).coeff j = 0 := by obtain ⟨r, rfl⟩ := Polynomial.X_dvd_iff.mpr hp rw [mul_pow, mul_assoc, Polynomial.coeff_X_pow_mul', ite_eq_right (not_le_of_gt hj)] open Source29NewtonNormalDerivative variable {n : ℕ} /-- Translate the normal variable after fixing all tangential coordinates. -/ def shiftedSlice (F : MvPolynomial (Fin (n + 1)) ℝ) (s : ℝ) (y : Fin n → ℝ) : Polynomial ℝ := Polynomial.taylor s (sliceHom y F) theorem eval_shiftedSlice (F : MvPolynomial (Fin (n + 1)) ℝ) (s x : ℝ) (y : Fin n → ℝ) : (shiftedSlice F s y).eval x = eval (Fin.cons (s + x) y) F := by rw [shiftedSlice, Polynomial.taylor_eval, eval_sliceHom, add_comm x s] theorem shiftedSlice_coeff_zero (F : MvPolynomial (Fin (n + 1)) ℝ) (s : ℝ) (y : Fin n → ℝ) : (shiftedSlice F s y).coeff 0 = eval (Fin.cons s y) F := by rw [shiftedSlice, Polynomial.taylor_coeff_zero, eval_sliceHom] theorem shiftedSlice_coeff_one (F : MvPolynomial (Fin (n + 1)) ℝ) (s : ℝ) (y : Fin n → ℝ) : (shiftedSlice F s y).coeff 1 = eval (Fin.cons s y) (pderiv 0 F) := by rw [shiftedSlice, Polynomial.taylor_coeff_one, ← sliceHom_pderiv_zero, eval_sliceHom] theorem shiftedSlice_factor (F P Q : MvPolynomial (Fin (n + 1)) ℝ) (k : ℕ) (hF : F = P^k*Q) (s : ℝ) (y : Fin n → ℝ) : shiftedSlice F s y = (shiftedSlice P s y)^k * shiftedSlice Q s y := by simp only [shiftedSlice, hF, map_mul, map_pow, Polynomial.taylor_mul, Polynomial.taylor_pow] /-- The coefficient at the factor multiplicity is the normal derivative to that power times the restricted cofactor. Simplicity is not needed for the identity. -/ theorem coeff_shifted_factor (F P Q : MvPolynomial (Fin (n + 1)) ℝ) (k : ℕ) (hF : F = P^k*Q) (s : ℝ) (y : Fin n → ℝ) (hP : eval (Fin.cons s y) P = 0) : (shiftedSlice F s y).coeff k = (eval (Fin.cons s y) (pderiv 0 P))^k * eval (Fin.cons s y) Q := by rw [shiftedSlice_factor F P Q k hF s y, coeff_pow_mul_of_coeff_zero _ _ k (by rw [shiftedSlice_coeff_zero, hP]), shiftedSlice_coeff_one, shiftedSlice_coeff_zero] theorem coeff_shifted_factor_eq_zero_of_lt (F P Q : MvPolynomial (Fin (n + 1)) ℝ) (k : ℕ) (hF : F = P^k*Q) (s : ℝ) (y : Fin n → ℝ) (hP : eval (Fin.cons s y) P = 0) (j : ℕ) (hj : j < k) : (shiftedSlice F s y).coeff j = 0 := by rw [shiftedSlice_factor F P Q k hF s y] exact coeff_pow_mul_eq_zero_of_lt _ _ k (by rw [shiftedSlice_coeff_zero, hP]) j hj theorem eventually_coeff_shifted_factor (F P Q : MvPolynomial (Fin (n + 1)) ℝ) (k : ℕ) (hF : F = P^k*Q) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0) : ∀ᶠ y in 𝓝 a, (shiftedSlice F (g y) y).coeff k = (eval (Fin.cons (g y) y) (pderiv 0 P))^k * eval (Fin.cons (g y) y) Q := hroot.mono fun y hy => coeff_shifted_factor F P Q k hF (g y) y hy theorem eventually_lower_coefficients_zero (F P Q : MvPolynomial (Fin (n + 1)) ℝ) (k : ℕ) (hF : F = P^k*Q) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0) : ∀ᶠ y in 𝓝 a, ∀ j < k, (shiftedSlice F (g y) y).coeff j = 0 := hroot.mono fun y hy j hj => coeff_shifted_factor_eq_zero_of_lt F P Q k hF (g y) y hy j hj /-- The first possible coefficient is a nonzero germ on a regular branch of an irreducible factor. The cofactor may vanish at the base point. -/ theorem coefficient_not_eventually_zero (F P Q : MvPolynomial (Fin (n + 1)) ℝ) (k : ℕ) (hF : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : ContinuousAt g a) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0) (hn : eval (Fin.cons (g a) a) (pderiv 0 P) ≠ 0) : ¬ ∀ᶠ y in 𝓝 a, (shiftedSlice F (g y) y).coeff k = 0 := by have hgraph : ContinuousAt (fun y : Fin n → ℝ => (Fin.cons (g y) y : Fin (n + 1) → ℝ)) a := by apply continuousAt_pi.mpr intro i exact Fin.cases hg (fun j => (continuous_apply j).continuousAt) i have hreg : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) (pderiv 0 P) ≠ 0 := ((Source29PolynomialLinkChart.analyticAt_eval_real (pderiv 0 P) _).continuousAt.comp hgraph).eventually_ne hn intro hz apply Source29LocalRegularPatchDensity.restriction_not_eventually_zero P Q hP hPQ (Fin.cons (g a) a) hn a g hroot filter_upwards [hz, eventually_coeff_shifted_factor F P Q k hF g a hroot, hreg] with y hy he hn' rw [he] at hy exact (mul_eq_zero.mp hy).resolve_left (pow_ne_zero k hn') /-- On an analytic branch the first possible coefficient is analytic, as needed to extract a finite Taylor order from its nonzero germ. -/ theorem analyticAt_shifted_coefficient (F P Q : MvPolynomial (Fin (n + 1)) ℝ) (k : ℕ) (hF : F = P^k*Q) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0) : AnalyticAt ℝ (fun y => (shiftedSlice F (g y) y).coeff k) a := by have hgraph : AnalyticAt ℝ (fun y : Fin n → ℝ => (Fin.cons (g y) y : Fin (n + 1) → ℝ)) a := by apply AnalyticAt.pi intro i exact Fin.cases hg (fun j => (ContinuousLinearMap.proj j : (Fin n → ℝ) →L[ℝ] ℝ).analyticAt a) i have hp := (Source29PolynomialLinkChart.analyticAt_eval_real (pderiv 0 P) _).comp hgraph have hq := (Source29PolynomialLinkChart.analyticAt_eval_real Q _).comp hgraph apply ((hp.pow k).mul hq).congr filter_upwards [eventually_coeff_shifted_factor F P Q k hF g a hroot] with y hy exact hy.symm end end Source29NewtonShiftedFactorCoefficient /- Component: NormalShiftAlgebra.inc -/ namespace Source29NormalShiftAlgebra open scoped BigOperators noncomputable section variable {ι R : Type*} [Fintype ι] [CommRing R] def dot (v w : ι → R) : R := ∑ i, v i * w i def trace (H : ι → ι → R) : R := ∑ i, H i i def bilinear (H : ι → ι → R) (v w : ι → R) : R := ∑ i, ∑ j, H i j * v i * w j def traceComplement (H : ι → ι → R) (v w : ι → R) : R := dot v w * trace H - bilinear H v w lemma dot_comm (v w : ι → R) : dot v w = dot w v := by unfold dot apply Finset.sum_congr rfl intro i _ ring lemma dot_sub_left (v w u : ι → R) : dot (fun i ↦ v i - w i) u = dot v u - dot w u := by simp only [dot, sub_mul, Finset.sum_sub_distrib] lemma dot_sub_right (v w u : ι → R) : dot u (fun i ↦ v i - w i) = dot u v - dot u w := by simp only [dot, mul_sub, Finset.sum_sub_distrib] lemma dot_mul_left (c : R) (v w : ι → R) : dot (fun i ↦ c * v i) w = c * dot v w := by simp only [dot, mul_assoc, Finset.mul_sum] lemma dot_mul_right (c : R) (v w : ι → R) : dot v (fun i ↦ c * w i) = c * dot v w := by rw [dot_comm, dot_mul_left, dot_comm w v] lemma trace_sub (H K : ι → ι → R) : trace (fun i j ↦ H i j - K i j) = trace H - trace K := by simp only [trace, Finset.sum_sub_distrib] lemma trace_add (H K : ι → ι → R) : trace (fun i j ↦ H i j + K i j) = trace H + trace K := by simp only [trace, Finset.sum_add_distrib] lemma trace_mul (c : R) (H : ι → ι → R) : trace (fun i j ↦ c * H i j) = c * trace H := by simp only [trace, Finset.mul_sum] lemma trace_rank_one (v w : ι → R) : trace (fun i j ↦ v i * w j) = dot v w := rfl lemma bilinear_sub_matrix (H K : ι → ι → R) (v w : ι → R) : bilinear (fun i j ↦ H i j - K i j) v w = bilinear H v w - bilinear K v w := by simp only [bilinear, sub_mul, Finset.sum_sub_distrib] lemma bilinear_add_matrix (H K : ι → ι → R) (v w : ι → R) : bilinear (fun i j ↦ H i j + K i j) v w = bilinear H v w + bilinear K v w := by simp only [bilinear, add_mul, Finset.sum_add_distrib] lemma bilinear_mul_matrix (c : R) (H : ι → ι → R) (v w : ι → R) : bilinear (fun i j ↦ c * H i j) v w = c * bilinear H v w := by simp only [bilinear, mul_assoc, Finset.mul_sum] lemma bilinear_sub_left (H : ι → ι → R) (v w u : ι → R) : bilinear H (fun i ↦ v i - w i) u = bilinear H v u - bilinear H w u := by simp only [bilinear, mul_sub, sub_mul, Finset.sum_sub_distrib] lemma bilinear_sub_right (H : ι → ι → R) (v w u : ι → R) : bilinear H u (fun i ↦ v i - w i) = bilinear H u v - bilinear H u w := by simp only [bilinear, mul_sub, Finset.sum_sub_distrib] lemma bilinear_mul_left (H : ι → ι → R) (c : R) (v w : ι → R) : bilinear H (fun i ↦ c * v i) w = c * bilinear H v w := by simp only [bilinear, Finset.mul_sum] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ ring lemma bilinear_mul_right (H : ι → ι → R) (c : R) (v w : ι → R) : bilinear H v (fun i ↦ c * w i) = c * bilinear H v w := by simp only [bilinear, Finset.mul_sum] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ ring lemma bilinear_rank_one (a b v w : ι → R) : bilinear (fun i j ↦ a i * b j) v w = dot a v * dot b w := by calc _ = ∑ i, (a i * v i) * (∑ j, b j * w j) := by apply Finset.sum_congr rfl intro i _ rw [Finset.mul_sum] apply Finset.sum_congr rfl intro j _ ring _ = _ := by rw [← Finset.sum_mul]; rfl /-- Tangential Hessian block after the coordinate change z=x+g(y). -/ def shiftedHessian (A S : R) (T a : ι → R) (U G : ι → ι → R) (i j : ι) : R := U i j - T i * a j - a i * T j + S * (a i * a j) - A * G i j lemma trace_shiftedHessian (A S : R) (T a : ι → R) (U G : ι → ι → R) : trace (shiftedHessian A S T a U G) = trace U - 2 * dot a T + S * dot a a - A * trace G := by change trace (fun i j ↦ U i j - T i * a j - a i * T j + S * (a i * a j) - A * G i j) = _ rw [trace_sub, trace_add, trace_sub, trace_sub, trace_mul, trace_mul, trace_rank_one, trace_rank_one, trace_rank_one] rw [dot_comm T a] ring lemma bilinear_shiftedHessian (A S : R) (T a : ι → R) (U G : ι → ι → R) (v : ι → R) : bilinear (shiftedHessian A S T a U G) v v = bilinear U v v - 2 * dot T v * dot a v + S * (dot a v)^2 - A * bilinear G v v := by change bilinear (fun i j ↦ U i j - T i * a j - a i * T j + S * (a i * a j) - A * G i j) v v = _ rw [bilinear_sub_matrix, bilinear_add_matrix, bilinear_sub_matrix, bilinear_sub_matrix, bilinear_mul_matrix, bilinear_mul_matrix, bilinear_rank_one, bilinear_rank_one, bilinear_rank_one] ring /-- Cubic level operator, written in its normal and tangential blocks. -/ def shiftedLevelOperator (A S : R) (B T a : ι → R) (U G : ι → ι → R) : R := let C := fun i ↦ B i - A * a i let H := shiftedHessian A S T a U G (A^2 + dot C C) * (S + trace H) - (A^2 * S + 2 * A * dot C (fun i ↦ T i - S * a i) + bilinear H C C) def newtonResidual (A S : R) (B T : ι → R) (U : ι → ι → R) : R := A^2 * trace U - 2 * A * dot B T + S * dot B B def backgroundGraphOperator (a : ι → R) (G : ι → ι → R) : R := (1 + dot a a) * trace G - bilinear G a a /-- Every correction term is displayed explicitly; no symmetry hypotheses on U or G and no analytic scaling assertion are used. -/ def correction (A S : R) (B T a : ι → R) (U G : ι → ι → R) : R := traceComplement U B B - A * (traceComplement U B a + traceComplement U a B) + A^2 * traceComplement U a a + S * (dot a a * dot B B - (dot a B)^2) + 2 * (dot a B * dot B T - dot B B * dot a T) - 2 * A * (dot a a * dot B T - dot a B * dot a T) - A * traceComplement G B B + A^2 * (traceComplement G B a + traceComplement G a B) /-- Exact nonlinear normal-shift formula. The background term has the negative sign dictated by z=x+g(y); the remaining terms are the Newton residual plus explicit corrections. -/ theorem normal_shift_identity (A S : R) (B T a : ι → R) (U G : ι → ι → R) : shiftedLevelOperator A S B T a U G = newtonResidual A S B T U - A^3 * backgroundGraphOperator a G + correction A S B T a U G := by dsimp only [shiftedLevelOperator] rw [trace_shiftedHessian, bilinear_shiftedHessian] simp only [dot_sub_left, dot_sub_right, dot_mul_left, dot_mul_right, bilinear_sub_left, bilinear_sub_right, bilinear_mul_left, bilinear_mul_right] unfold newtonResidual backgroundGraphOperator correction traceComplement rw [dot_comm B a, dot_comm T a, dot_comm T B] ring /-- The cubic level operator |v|² tr(H)−H(v,v), with its finite sums exposed. -/ def cubicLevel (v : ι → R) (H : ι → ι → R) : R := dot v v * trace H - bilinear H v v def blockHessian {n : ℕ} (S : R) (D : Fin n → R) (H : Fin n → Fin n → R) : Fin (n+1) → Fin (n+1) → R := Fin.cons (Fin.cons S D) (fun i ↦ Fin.cons (D i) (H i)) lemma cubicLevel_blocks {n : ℕ} (A S : R) (C D : Fin n → R) (H : Fin n → Fin n → R) : cubicLevel (Fin.cons A C) (blockHessian S D H) = (A^2 + dot C C) * (S + trace H) - (A^2 * S + 2 * A * dot C D + bilinear H C C) := by have hv : dot (Fin.cons A C) (Fin.cons A C) = A^2 + dot C C := by simp only [dot, Fin.sum_univ_succ, Fin.cons_zero, Fin.cons_succ, pow_two] have ht : trace (blockHessian S D H) = S + trace H := by simp only [trace, blockHessian, Fin.sum_univ_succ, Fin.cons_zero, Fin.cons_succ] have hleft : (∑ i, D i * A * C i) = A * dot C D := by rw [dot, Finset.mul_sum] apply Finset.sum_congr rfl intro i _ ring have hright : (∑ i, D i * C i * A) = A * dot C D := by rw [dot, Finset.mul_sum] apply Finset.sum_congr rfl intro i _ ring have hq : bilinear (blockHessian S D H) (Fin.cons A C) (Fin.cons A C) = A^2 * S + 2 * A * dot C D + bilinear H C C := by simp only [bilinear, blockHessian, Fin.sum_univ_succ, Fin.cons_zero, Fin.cons_succ, Finset.sum_add_distrib] rw [hleft, hright] ring rw [cubicLevel, hv, ht, hq] /-- The full ambient gradient after z=x+g(y). -/ def ambientGradient {n : ℕ} (A : R) (B a : Fin n → R) : Fin (n+1) → R := Fin.cons A (fun i ↦ B i - A * a i) /-- The full ambient Hessian after z=x+g(y). -/ def ambientHessian {n : ℕ} (A S : R) (T a : Fin n → R) (U G : Fin n → Fin n → R) : Fin (n+1) → Fin (n+1) → R := blockHessian S (fun i ↦ T i - S * a i) (shiftedHessian A S T a U G) /-- The exact identity for the full finite-dimensional gradient/Hessian arrays. -/ theorem cubicLevel_normal_shift {n : ℕ} (A S : R) (B T a : Fin n → R) (U G : Fin n → Fin n → R) : cubicLevel (ambientGradient A B a) (ambientHessian A S T a U G) = newtonResidual A S B T U - A^3 * backgroundGraphOperator a G + correction A S B T a U G := by change cubicLevel (Fin.cons A (fun i ↦ B i - A * a i)) (blockHessian S (fun i ↦ T i - S * a i) (shiftedHessian A S T a U G)) = _ rw [cubicLevel_blocks] exact normal_shift_identity A S B T a U G end end Source29NormalShiftAlgebra /- Component: AnalyticInitialOrder.inc -/ namespace Source29AnalyticInitialOrder open Filter open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] /-- If every diagonal term of a convergent power series vanishes, its represented function vanishes in a neighborhood of its center. -/ theorem eventually_zero_of_diagonal_zero {f : E → ℝ} {p : FormalMultilinearSeries ℝ E ℝ} {a : E} (hp : HasFPowerSeriesAt f p a) (hz : ∀ k (y : E), p k (fun _ ↦ y) = 0) : ∀ᶠ x in 𝓝 a, f x = 0 := by filter_upwards [hp.eventually_hasSum_sub] with x hx have hs : HasSum (fun _k : ℕ ↦ (0 : ℝ)) (f x) := by simpa only [hz] using hx exact hs.unique hasSum_zero /-- Every nonzero real analytic germ has a finite first nonzero diagonal homogeneous term. Lower diagonal terms vanish identically, not just on one ray. -/ theorem exists_first_nonzero_diagonal {f : E → ℝ} {a : E} (hf : AnalyticAt ℝ f a) (hne : ¬ ∀ᶠ x in 𝓝 a, f x = 0) : ∃ (p : FormalMultilinearSeries ℝ E ℝ) (d : ℕ), HasFPowerSeriesAt f p a ∧ (∃ y : E, p d (fun _ ↦ y) ≠ 0) ∧ (∀ k < d, ∀ y : E, p k (fun _ ↦ y) = 0) := by classical obtain ⟨p, hp⟩ := hf have hex : ∃ d : ℕ, ∃ y : E, p d (fun _ ↦ y) ≠ 0 := by by_contra h push Not at h exact hne (eventually_zero_of_diagonal_zero hp h) refine ⟨p, Nat.find hex, hp, Nat.find_spec hex, ?_⟩ intro k hk y by_contra hy exact (Nat.find_min hex hk) ⟨y, hy⟩ /-- At a zero of a nonzero analytic germ, its first nonzero diagonal term has strictly positive degree. -/ theorem exists_positive_first_nonzero_diagonal {f : E → ℝ} {a : E} (hf : AnalyticAt ℝ f a) (hne : ¬ ∀ᶠ x in 𝓝 a, f x = 0) (hz : f a = 0) : ∃ (p : FormalMultilinearSeries ℝ E ℝ) (d : ℕ), HasFPowerSeriesAt f p a ∧ 0 < d ∧ (∃ y : E, p d (fun _ ↦ y) ≠ 0) ∧ (∀ k < d, ∀ y : E, p k (fun _ ↦ y) = 0) := by obtain ⟨p, d, hp, hd, hlow⟩ := exists_first_nonzero_diagonal hf hne refine ⟨p, d, hp, ?_, hd, hlow⟩ by_contra h have hd0 : d = 0 := Nat.eq_zero_of_not_pos h obtain ⟨y, hy⟩ := hd subst d exact hy ((hp.coeff_zero (fun _ ↦ y)).trans hz) end end Source29AnalyticInitialOrder /- Component: MultilinearDiagonalPolynomial.inc -/ namespace Source29MultilinearDiagonalPolynomial open MvPolynomial open scoped BigOperators noncomputable section variable {m n : ℕ} /-- The coordinate polynomial representing the diagonal of a multilinear form. -/ def diagonalPolynomial (L : ContinuousMultilinearMap ℝ (fun _ : Fin m => Fin n → ℝ) ℝ) : MvPolynomial (Fin n) ℝ := ∑ s : Fin m → Fin n, C (L (fun j => Pi.single (s j) 1)) * ∏ j : Fin m, X (s j) /-- Expand each argument in the standard coordinate basis. No symmetry of L is required to represent its diagonal. -/ theorem diagonal_expansion (L : ContinuousMultilinearMap ℝ (fun _ : Fin m => Fin n → ℝ) ℝ) (x : Fin n → ℝ) : L (fun _ => x) = ∑ s : Fin m → Fin n, L (fun j => Pi.single (s j) 1) * ∏ j : Fin m, x (s j) := by classical calc L (fun _ => x) = L (fun _ : Fin m => ∑ i : Fin n, x i • Pi.single i 1) := by congr 1 funext j exact pi_eq_sum_univ' x _ = ∑ s : Fin m → Fin n, L (fun j => x (s j) • Pi.single (s j) 1) := L.map_sum (fun (_ : Fin m) (i : Fin n) => x i • Pi.single i 1) _ = _ := by apply Finset.sum_congr rfl intro s _ rw [L.map_smul_univ] exact mul_comm _ _ theorem eval_diagonalPolynomial (L : ContinuousMultilinearMap ℝ (fun _ : Fin m => Fin n → ℝ) ℝ) (x : Fin n → ℝ) : eval x (diagonalPolynomial L) = L (fun _ => x) := by classical simp only [diagonalPolynomial, map_sum, map_mul, map_prod, eval_C, eval_X] exact (diagonal_expansion L x).symm theorem diagonalPolynomial_isHomogeneous (L : ContinuousMultilinearMap ℝ (fun _ : Fin m => Fin n → ℝ) ℝ) : (diagonalPolynomial L).IsHomogeneous m := by classical unfold diagonalPolynomial apply IsHomogeneous.sum intro s _ have hprod : (∏ j : Fin m, (X (s j) : MvPolynomial (Fin n) ℝ)).IsHomogeneous m := by simpa using IsHomogeneous.prod Finset.univ (fun j : Fin m => (X (s j) : MvPolynomial (Fin n) ℝ)) (fun _ => 1) (fun j _ => isHomogeneous_X ℝ (s j)) exact hprod.C_mul _ theorem diagonalPolynomial_ne_zero (L : ContinuousMultilinearMap ℝ (fun _ : Fin m => Fin n → ℝ) ℝ) (x : Fin n → ℝ) (hx : L (fun _ => x) ≠ 0) : diagonalPolynomial L ≠ 0 := by intro hz have he := eval_diagonalPolynomial L x rw [hz, map_zero] at he exact hx he.symm /-- A nonzero diagonal value supplies a nonzero homogeneous polynomial representative of the full diagonal function. -/ theorem exists_diagonalPolynomial (L : ContinuousMultilinearMap ℝ (fun _ : Fin m => Fin n → ℝ) ℝ) (hx : ∃ x : Fin n → ℝ, L (fun _ => x) ≠ 0) : ∃ P : MvPolynomial (Fin n) ℝ, P ≠ 0 ∧ P.IsHomogeneous m ∧ ∀ x, eval x P = L (fun _ => x) := by obtain ⟨x, hx⟩ := hx exact ⟨diagonalPolynomial L, diagonalPolynomial_ne_zero L x hx, diagonalPolynomial_isHomogeneous L, eval_diagonalPolynomial L⟩ end end Source29MultilinearDiagonalPolynomial /- Component: AnalyticInitialPolynomial.inc -/ namespace Source29AnalyticInitialPolynomial open MvPolynomial Filter open scoped Topology noncomputable section variable {n : ℕ} /-- A nonzero analytic germ has a nonzero homogeneous polynomial as its first Taylor term, with all lower diagonal terms identically zero. -/ theorem exists_homogeneous_initial_term {f : (Fin n → ℝ) → ℝ} {a : Fin n → ℝ} (hf : AnalyticAt ℝ f a) (hne : ¬ ∀ᶠ x in 𝓝 a, f x = 0) : ∃ (p : FormalMultilinearSeries ℝ (Fin n → ℝ) ℝ) (d : ℕ) (H : MvPolynomial (Fin n) ℝ), HasFPowerSeriesAt f p a ∧ H ≠ 0 ∧ H.IsHomogeneous d ∧ (∀ x, eval x H = p d (fun _ ↦ x)) ∧ (∀ k < d, ∀ x, p k (fun _ ↦ x) = 0) := by obtain ⟨p,d,hp,hd,hlow⟩ := Source29AnalyticInitialOrder.exists_first_nonzero_diagonal hf hne obtain ⟨H,hH,hhom,heval⟩ := Source29MultilinearDiagonalPolynomial.exists_diagonalPolynomial (p d) hd exact ⟨p,d,H,hp,hH,hhom,heval,hlow⟩ /-- If the germ vanishes at the center, the first homogeneous polynomial has positive degree. -/ theorem exists_positive_homogeneous_initial_term {f : (Fin n → ℝ) → ℝ} {a : Fin n → ℝ} (hf : AnalyticAt ℝ f a) (hne : ¬ ∀ᶠ x in 𝓝 a, f x = 0) (hz : f a = 0) : ∃ (p : FormalMultilinearSeries ℝ (Fin n → ℝ) ℝ) (d : ℕ) (H : MvPolynomial (Fin n) ℝ), HasFPowerSeriesAt f p a ∧ 0 < d ∧ H ≠ 0 ∧ H.IsHomogeneous d ∧ (∀ x, eval x H = p d (fun _ ↦ x)) ∧ (∀ k < d, ∀ x, p k (fun _ ↦ x) = 0) := by obtain ⟨p,d,hp,hpos,hd,hlow⟩ := Source29AnalyticInitialOrder.exists_positive_first_nonzero_diagonal hf hne hz obtain ⟨H,hH,hhom,heval⟩ := Source29MultilinearDiagonalPolynomial.exists_diagonalPolynomial (p d) hd exact ⟨p,d,H,hp,hpos,hH,hhom,heval,hlow⟩ /-- At a regular branch of a full-multiplicity factor, the first normal coefficient has a finite nonzero homogeneous tangential Taylor term. -/ theorem exists_shifted_factor_initial_term (F P Q : MvPolynomial (Fin (n + 1)) ℝ) (k : ℕ) (hF : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0) (hn : eval (Fin.cons (g a) a) (pderiv 0 P) ≠ 0) : ∃ (p : FormalMultilinearSeries ℝ (Fin n → ℝ) ℝ) (d : ℕ) (H : MvPolynomial (Fin n) ℝ), HasFPowerSeriesAt (fun y ↦ (Source29NewtonShiftedFactorCoefficient.shiftedSlice F (g y) y).coeff k) p a ∧ H ≠ 0 ∧ H.IsHomogeneous d ∧ (∀ x, eval x H = p d (fun _ ↦ x)) ∧ (∀ j < d, ∀ x, p j (fun _ ↦ x) = 0) := by exact exists_homogeneous_initial_term (Source29NewtonShiftedFactorCoefficient.analyticAt_shifted_coefficient F P Q k hF g a hg hroot) (Source29NewtonShiftedFactorCoefficient.coefficient_not_eventually_zero F P Q k hF hP hPQ g a hg.continuousAt hroot hn) end end Source29AnalyticInitialPolynomial /- Component: AnalyticInitialRemainder.inc -/ namespace Source29AnalyticInitialRemainder open Filter Asymptotics open scoped Topology noncomputable section variable {E V : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [NormedAddCommGroup V] [NormedSpace ℝ V] lemma partialSum_eq_initial (p : FormalMultilinearSeries ℝ E V) (d : ℕ) (hlow : ∀ k < d, ∀ x, p k (fun _ ↦ x) = 0) (y : E) : p.partialSum (d+1) y = p d (fun _ ↦ y) := by rw [FormalMultilinearSeries.partialSum, Finset.sum_range_succ] have hz : (∑ k ∈ Finset.range d, p k (fun _ ↦ y)) = 0 := by apply Finset.sum_eq_zero intro k hk exact hlow k (Finset.mem_range.mp hk) y rw [hz, zero_add] /-- The remainder after the first nonzero diagonal term has one higher order, on a full neighborhood of the origin. -/ theorem remainder_isBigO {f : E → V} {a : E} {p : FormalMultilinearSeries ℝ E V} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hlow : ∀ k < d, ∀ x, p k (fun _ ↦ x) = 0) : (fun y ↦ f (a+y) - p d (fun _ ↦ y)) =O[𝓝 0] (fun y : E ↦ ‖y‖^(d+1)) := by simpa only [partialSum_eq_initial p d hlow] using hp.isBigO_sub_partialSum_pow (d+1) theorem remainder_isLittleO {f : E → V} {a : E} {p : FormalMultilinearSeries ℝ E V} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hlow : ∀ k < d, ∀ x, p k (fun _ ↦ x) = 0) : (fun y ↦ f (a+y) - p d (fun _ ↦ y)) =o[𝓝 0] (fun y : E ↦ ‖y‖^d) := (remainder_isBigO hp d hlow).trans_isLittleO (isLittleO_norm_pow_norm_pow (Nat.lt_succ_self d)) lemma diagonal_smul (p : FormalMultilinearSeries ℝ E V) (d : ℕ) (t : ℝ) (x : E) : p d (fun _ ↦ t • x) = t^d • p d (fun _ ↦ x) := by rw [ContinuousMultilinearMap.map_smul_univ] simp only [Finset.prod_const, Finset.card_univ, Fintype.card_fin] end end Source29AnalyticInitialRemainder /- Component: HomogeneousRescalingLimit.inc -/ namespace Source29HomogeneousRescalingLimit open Filter Asymptotics Set open scoped Topology noncomputable section variable {E V : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [NormedAddCommGroup V] [NormedSpace ℝ V] /-- A norm estimate for a higher-order remainder gives an explicit uniform estimate for the normalized function on bounded sets of directions. -/ theorem exists_uniform_scaled_bound {f q : E → V} {a : E} (d : ℕ) (hrem : (fun y ↦ f (a+y) - q y) =O[𝓝 0] (fun y : E ↦ ‖y‖^(d+1))) (hq : ∀ (t : ℝ), 0 < t → ∀ x, q (t•x) = t^d • q x) : ∃ C δ : ℝ, 0 < C ∧ 0 < δ ∧ ∀ (M t : ℝ) (x : E), 0 ≤ M → 0 < t → ‖x‖ ≤ M → t*M < δ → ‖(t^d)⁻¹ • f (a+t•x) - q x‖ ≤ C*t*M^(d+1) := by obtain ⟨K, hK⟩ := hrem.bound obtain ⟨δ, hδ, hball⟩ := Metric.mem_nhds_iff.mp hK refine ⟨|K|+1, δ, by positivity, hδ, ?_⟩ intro M t x hM ht hx hsmall have htx : ‖t • x‖ ≤ t*M := by rw [norm_smul, Real.norm_eq_abs, abs_of_pos ht] exact mul_le_mul_of_nonneg_left hx ht.le have hb := hball (show t•x ∈ Metric.ball (0 : E) δ from by simpa only [Metric.mem_ball, dist_zero_right] using lt_of_le_of_lt htx hsmall) change ‖f (a+t•x) - q (t•x)‖ ≤ K * ‖‖t•x‖^(d+1)‖ at hb have hpow : ‖t•x‖^(d+1) ≤ (t*M)^(d+1) := pow_le_pow_left₀ (norm_nonneg _) htx _ have hbnd : ‖f (a+t•x) - q (t•x)‖ ≤ (|K|+1)*(t*M)^(d+1) := by rw [Real.norm_of_nonneg (pow_nonneg (norm_nonneg _) _)] at hb calc _ ≤ K * ‖t•x‖^(d+1) := hb _ ≤ (|K|+1) * ‖t•x‖^(d+1) := mul_le_mul_of_nonneg_right (by linarith [le_abs_self K]) (by positivity) _ ≤ _ := mul_le_mul_of_nonneg_left hpow (by positivity) have htd : 0 < t^d := pow_pos ht d have he : (t^d)⁻¹ • f (a+t•x) - q x = (t^d)⁻¹ • (f (a+t•x) - q (t•x)) := by rw [smul_sub, hq t ht x, smul_smul, inv_mul_cancel₀ htd.ne', one_smul] rw [he, norm_smul, Real.norm_eq_abs, abs_inv, abs_of_pos htd] calc _ ≤ (t^d)⁻¹ * ((|K|+1)*(t*M)^(d+1)) := mul_le_mul_of_nonneg_left hbnd (inv_nonneg.mpr htd.le) _ = _ := by rw [mul_pow, pow_succ] field_simp /-- The normalized function converges uniformly on every norm-bounded set. -/ theorem tendstoUniformlyOn_of_norm_bound {f q : E → V} {a : E} (d : ℕ) (hrem : (fun y ↦ f (a+y) - q y) =O[𝓝 0] (fun y : E ↦ ‖y‖^(d+1))) (hq : ∀ (t : ℝ), 0 < t → ∀ x, q (t•x) = t^d • q x) (S : Set E) (M : ℝ) (hM : 0 < M) (hS : ∀ x ∈ S, ‖x‖ ≤ M) : TendstoUniformlyOn (fun t : ℝ ↦ fun x ↦ (t^d)⁻¹ • f (a+t•x)) q (𝓝[>] 0) S := by obtain ⟨C,δ,hC,hδ,hbound⟩ := exists_uniform_scaled_bound d hrem hq rw [Metric.tendstoUniformlyOn_iff] intro ε hε have hCM : 0 < C*M^(d+1) := mul_pos hC (pow_pos hM _) filter_upwards [self_mem_nhdsWithin, (eventually_lt_nhds (div_pos hδ hM)).filter_mono nhdsWithin_le_nhds, (eventually_lt_nhds (div_pos hε hCM)).filter_mono nhdsWithin_le_nhds] with t ht htδ htε intro x hx have hs : t*M < δ := (lt_div_iff₀ hM).mp htδ have hb := hbound M t x hM.le ht (hS x hx) hs have hc : C*t*M^(d+1) < ε := by have h := (lt_div_iff₀ hCM).mp htε nlinarith simpa only [dist_eq_norm, norm_sub_rev] using lt_of_le_of_lt hb hc theorem tendstoUniformlyOn_of_isBounded {f q : E → V} {a : E} (d : ℕ) (hrem : (fun y ↦ f (a+y) - q y) =O[𝓝 0] (fun y : E ↦ ‖y‖^(d+1))) (hq : ∀ (t : ℝ), 0 < t → ∀ x, q (t•x) = t^d • q x) (S : Set E) (hS : Bornology.IsBounded S) : TendstoUniformlyOn (fun t : ℝ ↦ fun x ↦ (t^d)⁻¹ • f (a+t•x)) q (𝓝[>] 0) S := by obtain ⟨M,hM,hSM⟩ := hS.exists_pos_norm_le exact tendstoUniformlyOn_of_norm_bound d hrem hq S M hM hSM theorem tendstoUniformlyOn_of_isCompact {f q : E → V} {a : E} (d : ℕ) (hrem : (fun y ↦ f (a+y) - q y) =O[𝓝 0] (fun y : E ↦ ‖y‖^(d+1))) (hq : ∀ (t : ℝ), 0 < t → ∀ x, q (t•x) = t^d • q x) (S : Set E) (hS : IsCompact S) : TendstoUniformlyOn (fun t : ℝ ↦ fun x ↦ (t^d)⁻¹ • f (a+t•x)) q (𝓝[>] 0) S := tendstoUniformlyOn_of_isBounded d hrem hq S hS.isBounded end end Source29HomogeneousRescalingLimit /- Component: AnalyticInitialScaling.inc -/ namespace Source29AnalyticInitialScaling open Filter Set Asymptotics open scoped Topology noncomputable section variable {E V : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [NormedAddCommGroup V] [NormedSpace ℝ V] /-- An analytic initial term is the uniform limit of normalized dilations on every bounded set. This statement applies to operator-valued functions too. -/ theorem initial_tendstoUniformlyOn {f : E → V} {a : E} {p : FormalMultilinearSeries ℝ E V} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hlow : ∀ k < d, ∀ x, p k (fun _ ↦ x) = 0) (S : Set E) (hS : Bornology.IsBounded S) : TendstoUniformlyOn (fun t : ℝ ↦ fun x ↦ (t^d)⁻¹ • f (a+t•x)) (fun x ↦ p d (fun _ ↦ x)) (𝓝[>] 0) S := Source29HomogeneousRescalingLimit.tendstoUniformlyOn_of_isBounded d (Source29AnalyticInitialRemainder.remainder_isBigO hp d hlow) (fun t _ x ↦ Source29AnalyticInitialRemainder.diagonal_smul p d t x) S hS /-- The scalar version is written with division for later weighted-face sums. -/ theorem initial_polynomial_tendstoUniformlyOn {n : ℕ} {f : (Fin n → ℝ) → ℝ} {a : Fin n → ℝ} {p : FormalMultilinearSeries ℝ (Fin n → ℝ) ℝ} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (H : MvPolynomial (Fin n) ℝ) (hH : ∀ x, MvPolynomial.eval x H = p d (fun _ ↦ x)) (hlow : ∀ k < d, ∀ x, p k (fun _ ↦ x) = 0) (S : Set (Fin n → ℝ)) (hS : Bornology.IsBounded S) : TendstoUniformlyOn (fun t : ℝ ↦ fun x ↦ f (a+t•x)/t^d) (fun x ↦ MvPolynomial.eval x H) (𝓝[>] 0) S := by have ht := initial_tendstoUniformlyOn hp d hlow S hS simpa only [smul_eq_mul, div_eq_mul_inv, mul_comm, ← hH] using ht end end Source29AnalyticInitialScaling /- Component: WeightedInitialScaling.inc -/ namespace Source29WeightedInitialScaling open Filter Set Asymptotics open scoped Topology noncomputable section variable {E V : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [NormedAddCommGroup V] [NormedSpace ℝ V] /-- A scalar tending to zero kills a uniformly convergent, uniformly bounded family. Only a bound for the limiting function is needed. -/ theorem scalar_smul_tendstoUniformlyOn_zero {ι : Type*} {l : Filter ι} {F : ι → E → V} {q : E → V} {g : ι → ℝ} {S : Set E} (hF : TendstoUniformlyOn F q l S) (hg : Tendsto g l (𝓝 0)) (B : ℝ) (hB : ∀ x ∈ S, ‖q x‖ ≤ B) : TendstoUniformlyOn (fun t x ↦ g t • F t x) (fun _ ↦ 0) l S := by rw [Metric.tendstoUniformlyOn_iff] at hF ⊢ intro ε hε have hgc : Tendsto (fun t ↦ ‖g t‖*(|B|+1)) l (𝓝 0) := by simpa using hg.norm.mul_const (|B|+1) filter_upwards [hF 1 zero_lt_one, hgc.eventually_lt_const hε] with t ht hgt intro x hx have he : ‖F t x-q x‖ < 1 := by simpa only [dist_eq_norm, norm_sub_rev] using ht x hx have hb : ‖F t x‖ ≤ |B|+1 := by calc _ = ‖(F t x-q x)+q x‖ := by rw [sub_add_cancel] _ ≤ ‖F t x-q x‖+‖q x‖ := norm_add_le _ _ _ ≤ _ := by linarith [hB x hx, le_abs_self B] rw [dist_zero_left, norm_smul] exact lt_of_le_of_lt (mul_le_mul_of_nonneg_left hb (norm_nonneg _)) hgt lemma diagonal_norm_bound (p : FormalMultilinearSeries ℝ E V) (d : ℕ) (M : ℝ) (_hM : 0 ≤ M) (x : E) (hx : ‖x‖ ≤ M) : ‖p d (fun _ ↦ x)‖ ≤ ‖p d‖*M^d := by calc _ ≤ ‖p d‖*‖x‖^d := by simpa only [Finset.prod_const, Finset.card_univ, Fintype.card_fin] using (p d).le_opNorm (fun _ ↦ x) _ ≤ _ := mul_le_mul_of_nonneg_left (pow_le_pow_left₀ (norm_nonneg _) hx d) (norm_nonneg _) lemma weighted_factor (t β : ℝ) (d : ℕ) (ht : 0 < t) (z : V) : t^((d : ℝ)-β) • ((t^d)⁻¹ • z) = t^(-β) • z := by rw [smul_smul, Real.rpow_sub ht, Real.rpow_natCast, Real.rpow_neg ht.le] congr 1 field_simp /-- A weight strictly below the first Taylor order has zero normalized limit, uniformly on every bounded set of directions. -/ theorem below_order_tendstoUniformlyOn_zero {f : E → V} {a : E} {p : FormalMultilinearSeries ℝ E V} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hlow : ∀ k < d, ∀ x, p k (fun _ ↦ x) = 0) (β : ℝ) (hβ : β < (d : ℝ)) (S : Set E) (hS : Bornology.IsBounded S) : TendstoUniformlyOn (fun t : ℝ ↦ fun x ↦ t^(-β) • f (a+t•x)) (fun _ ↦ 0) (𝓝[>] 0) S := by have hF := Source29AnalyticInitialScaling.initial_tendstoUniformlyOn hp d hlow S hS obtain ⟨M,hM,hSM⟩ := hS.exists_pos_norm_le have hg : Tendsto (fun t : ℝ ↦ t^((d : ℝ)-β)) (𝓝[>] 0) (𝓝 0) := by have hc := (Real.continuousAt_rpow_const 0 ((d : ℝ)-β) (Or.inr (by linarith))).tendsto have hz : (0 : ℝ)^((d : ℝ)-β) = 0 := Real.zero_rpow (by linarith) rw [hz] at hc exact hc.mono_left nhdsWithin_le_nhds have ht := scalar_smul_tendstoUniformlyOn_zero hF hg (‖p d‖*M^d) (fun x hx ↦ diagonal_norm_bound p d M hM.le x (hSM x hx)) apply ht.congr filter_upwards [self_mem_nhdsWithin] with t ht intro x _ exact weighted_factor t β d ht (f (a+t•x)) /-- At the first Taylor order, the weighted limit is exactly the initial term. -/ theorem at_order_tendstoUniformlyOn {f : E → V} {a : E} {p : FormalMultilinearSeries ℝ E V} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hlow : ∀ k < d, ∀ x, p k (fun _ ↦ x) = 0) (S : Set E) (hS : Bornology.IsBounded S) : TendstoUniformlyOn (fun t : ℝ ↦ fun x ↦ t^(-(d : ℝ)) • f (a+t•x)) (fun x ↦ p d (fun _ ↦ x)) (𝓝[>] 0) S := by apply (Source29AnalyticInitialScaling.initial_tendstoUniformlyOn hp d hlow S hS).congr filter_upwards [self_mem_nhdsWithin] with t ht intro x _ rw [Real.rpow_neg (le_of_lt ht), Real.rpow_natCast] /-- A zero germ stays zero uniformly after small dilations on any bounded set. -/ theorem eventually_uniform_zero_of_germ {f : E → V} {a : E} (hz : ∀ᶠ y in 𝓝 a, f y = 0) (S : Set E) (hS : Bornology.IsBounded S) : ∀ᶠ t : ℝ in 𝓝 0, ∀ x ∈ S, f (a+t•x) = 0 := by obtain ⟨δ,hδ,hball⟩ := Metric.mem_nhds_iff.mp hz obtain ⟨M,hM,hSM⟩ := hS.exists_pos_norm_le filter_upwards [Metric.ball_mem_nhds (0 : ℝ) (div_pos hδ hM)] with t ht intro x hx apply hball rw [Metric.mem_ball, dist_eq_norm, add_sub_cancel_left, norm_smul] have ht' : ‖t‖ < δ/M := by simpa only [Metric.mem_ball, dist_zero_right] using ht exact lt_of_le_of_lt (mul_le_mul_of_nonneg_left (hSM x hx) (norm_nonneg _)) ((lt_div_iff₀ hM).mp ht') /-- Even an unbounded scalar normalization preserves the uniform zero limit of a germ which vanishes on a neighborhood. -/ theorem zero_germ_tendstoUniformlyOn {f : E → V} {a : E} (hz : ∀ᶠ y in 𝓝 a, f y = 0) (S : Set E) (hS : Bornology.IsBounded S) (w : ℝ → ℝ) : TendstoUniformlyOn (fun t : ℝ ↦ fun x ↦ w t • f (a+t•x)) (fun _ ↦ 0) (𝓝[>] 0) S := by rw [Metric.tendstoUniformlyOn_iff] intro ε hε filter_upwards [(eventually_uniform_zero_of_germ hz S hS).filter_mono nhdsWithin_le_nhds] with t ht intro x hx rw [ht x hx, smul_zero, dist_self] exact hε /-- The face coefficient survives precisely when its order equals the weight. -/ theorem at_or_below_order_tendstoUniformlyOn {f : E → V} {a : E} {p : FormalMultilinearSeries ℝ E V} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hlow : ∀ k < d, ∀ x, p k (fun _ ↦ x) = 0) (β : ℝ) (hβ : β ≤ (d : ℝ)) (S : Set E) (hS : Bornology.IsBounded S) : TendstoUniformlyOn (fun t : ℝ ↦ fun x ↦ t^(-β) • f (a+t•x)) (fun x ↦ if β = (d : ℝ) then p d (fun _ ↦ x) else 0) (𝓝[>] 0) S := by classical rcases lt_or_eq_of_le hβ with hlt | heq · simpa only [ne_of_lt hlt, ite_false] using below_order_tendstoUniformlyOn_zero hp d hlow β hlt S hS · subst β simpa only [ite_true] using at_order_tendstoUniformlyOn hp d hlow S hS end end Source29WeightedInitialScaling /- Component: LocalWeightedSignLimit.inc -/ namespace Source29LocalWeightedSignLimit open Filter open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] def scaledPoint (α t : ℝ) (z : ℝ × E) : ℝ × E := (t^α*z.1, t•z.2) theorem scaledPoint_tendsto (α : ℝ) (hα : 0 < α) (z : ℝ × E) : Tendsto (fun t : ℝ ↦ scaledPoint α t z) (𝓝[>] 0) (𝓝 0) := by have ha : Tendsto (fun t : ℝ ↦ t^α) (𝓝 0) (𝓝 0) := by simpa only [Real.zero_rpow hα.ne'] using (Real.continuousAt_rpow_const 0 α (Or.inr hα.le)).tendsto have hb : Tendsto (fun t : ℝ ↦ t•z.2) (𝓝 0) (𝓝 (0 : E)) := by simpa only [zero_smul, id_eq] using (tendsto_id.smul (tendsto_const_nhds : Tendsto (fun _ : ℝ ↦ z.2) (𝓝 0) (𝓝 z.2))) have hc := (ha.mul_const z.1).prodMk_nhds hb change Tendsto (fun t : ℝ ↦ scaledPoint α t z) (𝓝[>] 0) (𝓝 ((0 : ℝ), (0 : E))) simpa only [zero_mul, scaledPoint] using hc.mono_left nhdsWithin_le_nhds /-- Local half-space signs pass to a weighted blow-up limit because the normalizing power and the normal-coordinate dilation are positive. -/ theorem sign_inherited (f N : ℝ × E → ℝ) (α D : ℝ) (hα : 0 < α) (hpos : ∀ᶠ z in 𝓝 (0 : ℝ × E), 0 < z.1 → 0 ≤ f z) (hneg : ∀ᶠ z in 𝓝 (0 : ℝ × E), z.1 < 0 → f z ≤ 0) (hlim : ∀ z, Tendsto (fun t : ℝ ↦ f (scaledPoint α t z)/t^D) (𝓝[>] 0) (𝓝 (N z))) : (∀ z, 0 < z.1 → 0 ≤ N z) ∧ (∀ z, z.1 < 0 → N z ≤ 0) := by constructor · intro z hz apply ge_of_tendsto (hlim z) filter_upwards [self_mem_nhdsWithin, (scaledPoint_tendsto α hα z).eventually hpos] with t ht hs apply div_nonneg · apply hs exact mul_pos (Real.rpow_pos_of_pos ht α) hz · exact (Real.rpow_pos_of_pos ht D).le · intro z hz apply le_of_tendsto (hlim z) filter_upwards [self_mem_nhdsWithin, (scaledPoint_tendsto α hα z).eventually hneg] with t ht hs apply div_nonpos_of_nonpos_of_nonneg · apply hs exact mul_neg_of_pos_of_neg (Real.rpow_pos_of_pos ht α) hz · exact (Real.rpow_pos_of_pos ht D).le end end Source29LocalWeightedSignLimit /- Component: NormalShiftDerivatives.inc -/ namespace Source29NormalShiftDerivatives open Filter open Source29NewtonRootHarmonic open scoped Topology noncomputable section section RankOne variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] def shift (h : E → ℝ) (e x : E) : E := x - h x • e def second (f : E → ℝ) (x u v : E) : ℝ := fderiv ℝ (fun y ↦ fderiv ℝ f y v) x u lemma analyticAt_shift (h : E → ℝ) (e x : E) (hh : AnalyticAt ℝ h x) : AnalyticAt ℝ (shift h e) x := analyticAt_id.sub (hh.smul analyticAt_const) lemma first_shift (f h : E → ℝ) (e x v : E) (hf : DifferentiableAt ℝ f (shift h e x)) (hh : DifferentiableAt ℝ h x) : fderiv ℝ (fun y ↦ f (shift h e y)) x v = fderiv ℝ f (shift h e x) v - fderiv ℝ h x v * fderiv ℝ f (shift h e x) e := by have hs : HasFDerivAt (shift h e) (ContinuousLinearMap.id ℝ E - (fderiv ℝ h x).smulRight e) x := (hasFDerivAt_id x).sub (hh.hasFDerivAt.smul_const e) have he := congrArg (fun L : E →L[ℝ] ℝ ↦ L v) (hf.hasFDerivAt.comp x hs).fderiv simpa only [Function.comp_def, ContinuousLinearMap.comp_apply, _root_.sub_apply, ContinuousLinearMap.id_apply, ContinuousLinearMap.smulRight_apply, map_sub, map_smul, smul_eq_mul] using he /-- The second derivative of a nonlinear rank-one shift, with its two mixed orders kept separate. This needs no symmetry theorem. -/ theorem second_shift (f h : E → ℝ) (e x u v : E) (hf : AnalyticAt ℝ f (shift h e x)) (hh : AnalyticAt ℝ h x) : second (fun y ↦ f (shift h e y)) x u v = second f (shift h e x) u v - fderiv ℝ h x u * second f (shift h e x) e v - fderiv ℝ h x v * second f (shift h e x) u e + fderiv ℝ h x u * fderiv ℝ h x v * second f (shift h e x) e e - fderiv ℝ f (shift h e x) e * second h x u v := by have hs := analyticAt_shift h e x hh have heq : (fun y ↦ fderiv ℝ (fun z ↦ f (shift h e z)) y v) =ᶠ[𝓝 x] (fun y ↦ fderiv ℝ f (shift h e y) v - fderiv ℝ h y v * fderiv ℝ f (shift h e y) e) := by filter_upwards [hh.eventually_analyticAt, hs.continuousAt.tendsto.eventually hf.eventually_analyticAt] with y hyh hyf exact first_shift f h e y v hyf.differentiableAt hyh.differentiableAt have hfv := analyticAt_directional f (shift h e x) v hf have hfe := analyticAt_directional f (shift h e x) e hf have hhv := analyticAt_directional h x v hh have hcv : AnalyticAt ℝ (fun y ↦ fderiv ℝ f (shift h e y) v) x := AnalyticAt.comp (f := shift h e) (g := fun y ↦ fderiv ℝ f y v) hfv hs have hce : AnalyticAt ℝ (fun y ↦ fderiv ℝ f (shift h e y) e) x := AnalyticAt.comp (f := shift h e) (g := fun y ↦ fderiv ℝ f y e) hfe hs change fderiv ℝ (fun y ↦ fderiv ℝ (fun z ↦ f (shift h e z)) y v) x u = _ rw [heq.fderiv_eq, fderiv_fun_sub (f := fun y ↦ fderiv ℝ f (shift h e y) v) (g := fun y ↦ fderiv ℝ h y v * fderiv ℝ f (shift h e y) e) hcv.differentiableAt (hhv.mul hce).differentiableAt] simp only [_root_.sub_apply] rw [fderiv_fun_mul hhv.differentiableAt hce.differentiableAt] simp only [_root_.add_apply, _root_.smul_apply, smul_eq_mul] rw [first_shift (fun y ↦ fderiv ℝ f y v) h e x u hfv.differentiableAt hh.differentiableAt, first_shift (fun y ↦ fderiv ℝ f y e) h e x u hfe.differentiableAt hh.differentiableAt] unfold second ring lemma second_eq_fderiv_fderiv (f : E → ℝ) (x u v : E) (hf : AnalyticAt ℝ f x) : second f x u v = fderiv ℝ (fderiv ℝ f) x u v := by have h := (ContinuousLinearMap.apply ℝ ℝ v).hasFDerivAt.comp x hf.fderiv.differentiableAt.hasFDerivAt exact congrArg (fun L : E →L[ℝ] ℝ ↦ L u) h.fderiv lemma second_neg (h : E → ℝ) (x u v : E) : second (fun y ↦ -h y) x u v = -second h x u v := by simp only [second, fderiv_fun_neg, neg_apply] end RankOne section Linear variable {E F : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [NormedAddCommGroup F] [NormedSpace ℝ F] lemma first_linear (f : F → ℝ) (L : E →L[ℝ] F) (x v : E) (hf : DifferentiableAt ℝ f (L x)) : fderiv ℝ (fun y ↦ f (L y)) x v = fderiv ℝ f (L x) (L v) := by have hd := congrArg (fun D : E →L[ℝ] ℝ ↦ D v) (hf.hasFDerivAt.comp x L.hasFDerivAt).fderiv simpa only [Function.comp_def, ContinuousLinearMap.comp_apply] using hd lemma second_linear (f : F → ℝ) (L : E →L[ℝ] F) (x u v : E) (hf : AnalyticAt ℝ f (L x)) : second (fun y ↦ f (L y)) x u v = second f (L x) (L u) (L v) := by have he : (fun y ↦ fderiv ℝ (fun z ↦ f (L z)) y v) =ᶠ[𝓝 x] (fun y ↦ fderiv ℝ f (L y) (L v)) := by filter_upwards [L.continuous.continuousAt.tendsto.eventually hf.eventually_analyticAt] with y hy exact first_linear f L y v hy.differentiableAt unfold second rw [he.fderiv_eq] exact first_linear (fun y ↦ fderiv ℝ f y (L v)) L x u (analyticAt_directional f (L x) (L v) hf).differentiableAt end Linear section Coordinates variable {n : ℕ} def tail : (Fin (n+1) → ℝ) →L[ℝ] (Fin n → ℝ) := ContinuousLinearMap.pi (fun i ↦ ContinuousLinearMap.proj i.succ) def lift (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) : ℝ := g (tail x) def basis (i : Fin n) : Fin n → ℝ := Pi.single i 1 lemma tail_basis_zero : tail (basis (0 : Fin (n+1))) = 0 := by funext i simp [tail, basis] lemma tail_basis_succ (i : Fin n) : tail (basis i.succ) = basis i := by funext j simp [tail, basis, Pi.single_apply] lemma analyticAt_lift (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) : AnalyticAt ℝ (lift g) x := AnalyticAt.comp (f := tail) (g := g) hg (tail.analyticAt x) lemma first_lift_zero (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) : fderiv ℝ (lift g) x (basis 0) = 0 := by change fderiv ℝ (fun y ↦ g (tail y)) x (basis 0) = 0 rw [first_linear g tail x (basis 0) hg.differentiableAt, tail_basis_zero, map_zero] lemma first_lift_succ (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) (i : Fin n) : fderiv ℝ (lift g) x (basis i.succ) = fderiv ℝ g (tail x) (basis i) := by change fderiv ℝ (fun y ↦ g (tail y)) x (basis i.succ) = _ rw [first_linear g tail x (basis i.succ) hg.differentiableAt, tail_basis_succ] lemma second_lift (g : (Fin n → ℝ) → ℝ) (x u v : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) : second (lift g) x u v = second g (tail x) (tail u) (tail v) := second_linear g tail x u v hg lemma second_zero_left {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] (g : E → ℝ) (x v : E) : second g x 0 v = 0 := by simp [second] lemma second_zero_right {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] (g : E → ℝ) (x u : E) : second g x u 0 = 0 := by simp [second] def gradient (f : (Fin n → ℝ) → ℝ) (x : Fin n → ℝ) (i : Fin n) : ℝ := fderiv ℝ f x (basis i) def hessian (f : (Fin n → ℝ) → ℝ) (x : Fin n → ℝ) (i j : Fin n) : ℝ := second f x (basis i) (basis j) /-- The actual forward normal chart (x,y) ↦ (x+g(y),y). -/ def chart (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) : Fin (n+1) → ℝ := shift (fun y ↦ -lift g y) (basis 0) x lemma chart_eq (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) : chart g x = Fin.cons (x 0 + g (tail x)) (tail x) := by funext i refine Fin.cases ?_ (fun j ↦ ?_) i · simp [chart, shift, lift, basis] · simp [chart, shift, basis, tail] def pullback (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) : ℝ := MvPolynomial.eval (chart g x) P lemma analyticAt_pullback (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) : AnalyticAt ℝ (pullback P g) x := AnalyticAt.comp (f := chart g) (g := fun y ↦ MvPolynomial.eval y P) (Source29PolynomialLinkChart.analyticAt_eval_real P (chart g x)) (analyticAt_shift (fun y ↦ -lift g y) (basis 0) x (analyticAt_lift g x hg).neg) lemma gradient_eval (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) (i : Fin n) : gradient (fun y ↦ MvPolynomial.eval y P) x i = MvPolynomial.eval x (MvPolynomial.pderiv i P) := by unfold gradient basis rw [Source29QuarticReuse.QuarticPolynomialBasics.fderiv_eval, Source29QuarticReuse.QuarticPolynomialBasics.evalFDeriv_basis] lemma hessian_eval (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) (i j : Fin n) : hessian (fun y ↦ MvPolynomial.eval y P) x i j = MvPolynomial.eval x (MvPolynomial.pderiv i (MvPolynomial.pderiv j P)) := by have he : (fun y ↦ fderiv ℝ (fun z ↦ MvPolynomial.eval z P) y (basis j)) = (fun y ↦ MvPolynomial.eval y (MvPolynomial.pderiv j P)) := funext (fun y ↦ gradient_eval P y j) unfold hessian second rw [he] exact gradient_eval (MvPolynomial.pderiv j P) x i lemma hessian_eval_symm (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) (i j : Fin n) : hessian (fun y ↦ MvPolynomial.eval y P) x i j = hessian (fun y ↦ MvPolynomial.eval y P) x j i := by rw [hessian_eval, hessian_eval, Source29QuarticReuse.QuarticPolynomialBasics.second_partial_comm P i j] lemma gradient_pullback (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) (i : Fin (n+1)) : gradient (pullback P g) x i = gradient (fun y ↦ MvPolynomial.eval y P) (chart g x) i + gradient (lift g) x i * gradient (fun y ↦ MvPolynomial.eval y P) (chart g x) 0 := by have hp := Source29PolynomialLinkChart.analyticAt_eval_real P (chart g x) have hh := (analyticAt_lift g x hg).neg unfold gradient change fderiv ℝ (fun y ↦ MvPolynomial.eval (shift (fun z ↦ -lift g z) (basis 0) y) P) x (basis i) = _ rw [first_shift _ _ _ _ _ hp.differentiableAt hh.differentiableAt] simp only [fderiv_fun_neg, neg_apply] unfold chart ring lemma hessian_pullback (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) (i j : Fin (n+1)) : hessian (pullback P g) x i j = hessian (fun y ↦ MvPolynomial.eval y P) (chart g x) i j + gradient (lift g) x i * hessian (fun y ↦ MvPolynomial.eval y P) (chart g x) 0 j + gradient (lift g) x j * hessian (fun y ↦ MvPolynomial.eval y P) (chart g x) i 0 + gradient (lift g) x i * gradient (lift g) x j * hessian (fun y ↦ MvPolynomial.eval y P) (chart g x) 0 0 + gradient (fun y ↦ MvPolynomial.eval y P) (chart g x) 0 * hessian (lift g) x i j := by have hp := Source29PolynomialLinkChart.analyticAt_eval_real P (chart g x) have hh := (analyticAt_lift g x hg).neg unfold hessian change second (fun y ↦ MvPolynomial.eval (shift (fun z ↦ -lift g z) (basis 0) y) P) x (basis i) (basis j) = _ rw [second_shift _ _ _ _ _ _ hp hh] simp only [fderiv_fun_neg, neg_apply, second_neg] unfold gradient chart ring lemma gradient_lift_zero (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) : gradient (lift g) x 0 = 0 := first_lift_zero g x hg lemma gradient_lift_succ (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) (i : Fin n) : gradient (lift g) x i.succ = gradient g (tail x) i := first_lift_succ g x hg i lemma hessian_lift_zero_left (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) (i : Fin (n+1)) : hessian (lift g) x 0 i = 0 := by rw [hessian, second_lift g x _ _ hg, tail_basis_zero, second_zero_left] lemma hessian_lift_zero_right (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) (i : Fin (n+1)) : hessian (lift g) x i 0 = 0 := by rw [hessian, second_lift g x _ _ hg, tail_basis_zero, second_zero_right] lemma hessian_lift_succ_succ (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) (i j : Fin n) : hessian (lift g) x i.succ j.succ = hessian g (tail x) i j := by rw [hessian, second_lift g x _ _ hg, tail_basis_succ, tail_basis_succ] rfl lemma gradient_pullback_zero (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) : gradient (pullback P g) x 0 = gradient (fun y ↦ MvPolynomial.eval y P) (chart g x) 0 := by rw [gradient_pullback P g x hg, gradient_lift_zero g x hg, zero_mul, add_zero] lemma gradient_pullback_succ (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) (i : Fin n) : gradient (pullback P g) x i.succ = gradient (fun y ↦ MvPolynomial.eval y P) (chart g x) i.succ + gradient g (tail x) i * gradient (fun y ↦ MvPolynomial.eval y P) (chart g x) 0 := by rw [gradient_pullback P g x hg, gradient_lift_succ g x hg] lemma hessian_pullback_zero_zero (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) : hessian (pullback P g) x 0 0 = hessian (fun y ↦ MvPolynomial.eval y P) (chart g x) 0 0 := by rw [hessian_pullback P g x hg] simp only [gradient_lift_zero g x hg, hessian_lift_zero_left g x hg, zero_mul, mul_zero, add_zero] lemma hessian_pullback_succ_zero (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) (i : Fin n) : hessian (pullback P g) x i.succ 0 = hessian (fun y ↦ MvPolynomial.eval y P) (chart g x) i.succ 0 + gradient g (tail x) i * hessian (fun y ↦ MvPolynomial.eval y P) (chart g x) 0 0 := by rw [hessian_pullback P g x hg] simp only [gradient_lift_zero g x hg, gradient_lift_succ g x hg, hessian_lift_zero_right g x hg, zero_mul, mul_zero, add_zero] lemma hessian_pullback_succ_succ (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) (i j : Fin n) : hessian (pullback P g) x i.succ j.succ = hessian (fun y ↦ MvPolynomial.eval y P) (chart g x) i.succ j.succ + gradient g (tail x) i * hessian (fun y ↦ MvPolynomial.eval y P) (chart g x) 0 j.succ + gradient g (tail x) j * hessian (fun y ↦ MvPolynomial.eval y P) (chart g x) i.succ 0 + gradient g (tail x) i * gradient g (tail x) j * hessian (fun y ↦ MvPolynomial.eval y P) (chart g x) 0 0 + gradient (fun y ↦ MvPolynomial.eval y P) (chart g x) 0 * hessian g (tail x) i j := by rw [hessian_pullback P g x hg] simp only [gradient_lift_succ g x hg, hessian_lift_succ_succ g x hg] /-- The ambient gradient reconstructed from the actual derivatives of the polynomial pulled back along the nonlinear normal chart. -/ theorem polynomial_gradient_transform (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) : gradient (fun y ↦ MvPolynomial.eval y P) (chart g x) = Source29NormalShiftAlgebra.ambientGradient (gradient (pullback P g) x 0) (fun i ↦ gradient (pullback P g) x i.succ) (gradient g (tail x)) := by funext i refine Fin.cases ?_ (fun j ↦ ?_) i · change gradient (fun y ↦ MvPolynomial.eval y P) (chart g x) 0 = gradient (pullback P g) x 0 exact (gradient_pullback_zero P g x hg).symm · change gradient (fun y ↦ MvPolynomial.eval y P) (chart g x) j.succ = gradient (pullback P g) x j.succ - gradient (pullback P g) x 0 * gradient g (tail x) j rw [gradient_pullback_succ P g x hg, gradient_pullback_zero P g x hg] ring /-- The full ambient Hessian reconstructed from actual derivatives. Polynomial mixed-partial commutation discharges the normal mixed symmetry internally. -/ theorem polynomial_hessian_transform (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) : hessian (fun y ↦ MvPolynomial.eval y P) (chart g x) = Source29NormalShiftAlgebra.ambientHessian (gradient (pullback P g) x 0) (hessian (pullback P g) x 0 0) (fun i ↦ hessian (pullback P g) x i.succ 0) (gradient g (tail x)) (fun i j ↦ hessian (pullback P g) x i.succ j.succ) (hessian g (tail x)) := by funext i j refine Fin.cases ?_ (fun i' ↦ ?_) i · refine Fin.cases ?_ (fun j' ↦ ?_) j · change hessian (fun y ↦ MvPolynomial.eval y P) (chart g x) 0 0 = hessian (pullback P g) x 0 0 exact (hessian_pullback_zero_zero P g x hg).symm · change hessian (fun y ↦ MvPolynomial.eval y P) (chart g x) 0 j'.succ = hessian (pullback P g) x j'.succ 0 - hessian (pullback P g) x 0 0 * gradient g (tail x) j' rw [hessian_pullback_succ_zero P g x hg, hessian_pullback_zero_zero P g x hg, hessian_eval_symm P (chart g x) 0 j'.succ] ring · refine Fin.cases ?_ (fun j' ↦ ?_) j · change hessian (fun y ↦ MvPolynomial.eval y P) (chart g x) i'.succ 0 = hessian (pullback P g) x i'.succ 0 - hessian (pullback P g) x 0 0 * gradient g (tail x) i' rw [hessian_pullback_succ_zero P g x hg, hessian_pullback_zero_zero P g x hg] ring · change hessian (fun y ↦ MvPolynomial.eval y P) (chart g x) i'.succ j'.succ = hessian (pullback P g) x i'.succ j'.succ - hessian (pullback P g) x i'.succ 0 * gradient g (tail x) j' - gradient g (tail x) i' * hessian (pullback P g) x j'.succ 0 + hessian (pullback P g) x 0 0 * (gradient g (tail x) i' * gradient g (tail x) j') - gradient (pullback P g) x 0 * hessian g (tail x) i' j' rw [hessian_pullback_succ_succ P g x hg, hessian_pullback_succ_zero P g x hg, hessian_pullback_succ_zero P g x hg, hessian_pullback_zero_zero P g x hg, gradient_pullback_zero P g x hg, hessian_eval_symm P (chart g x) 0 j'.succ] ring /-- The finite-sum normal-shift identity applies to the actual derivative arrays of a polynomial and its analytic normal pullback. -/ theorem polynomial_cubicLevel_transform (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) : let A := gradient (pullback P g) x 0 let S := hessian (pullback P g) x 0 0 let B := fun i : Fin n ↦ gradient (pullback P g) x i.succ let T := fun i : Fin n ↦ hessian (pullback P g) x i.succ 0 let U := fun i j : Fin n ↦ hessian (pullback P g) x i.succ j.succ let a := gradient g (tail x) let G := hessian g (tail x) Source29NormalShiftAlgebra.cubicLevel (gradient (fun y ↦ MvPolynomial.eval y P) (chart g x)) (hessian (fun y ↦ MvPolynomial.eval y P) (chart g x)) = Source29NormalShiftAlgebra.newtonResidual A S B T U - A^3 * Source29NormalShiftAlgebra.backgroundGraphOperator a G + Source29NormalShiftAlgebra.correction A S B T a U G := by dsimp only rw [polynomial_gradient_transform P g x hg, polynomial_hessian_transform P g x hg, Source29NormalShiftAlgebra.cubicLevel_normal_shift] /-- The actual coordinate derivative arrays recover the polynomial cubic leading operator, with the same sign convention as the normal-shift formula. -/ theorem cubicLevel_eval (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) : Source29NormalShiftAlgebra.cubicLevel (gradient (fun y ↦ MvPolynomial.eval y P) x) (hessian (fun y ↦ MvPolynomial.eval y P) x) = MvPolynomial.eval x (Source29QuarticReuse.QuarticMinimal.leadingOperator P) := by simp only [Source29NormalShiftAlgebra.cubicLevel, Source29NormalShiftAlgebra.dot, Source29NormalShiftAlgebra.trace, Source29NormalShiftAlgebra.bilinear, Source29QuarticReuse.QuarticMinimal.leadingOperator, Source29QuarticReuse.QuarticMinimal.laplacian, gradient_eval, hessian_eval, map_sub, map_mul, map_sum, pow_two] congr 1 apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ ring /-- A zero leading operator and a minimal background leave precisely the Newton residual plus the explicitly displayed correction terms. -/ theorem newton_plus_correction_eq_zero (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (tail x)) (hP : MvPolynomial.eval (chart g x) (Source29QuarticReuse.QuarticMinimal.leadingOperator P) = 0) (hgmin : Source29NormalShiftAlgebra.backgroundGraphOperator (gradient g (tail x)) (hessian g (tail x)) = 0) : let A := gradient (pullback P g) x 0 let S := hessian (pullback P g) x 0 0 let B := fun i : Fin n ↦ gradient (pullback P g) x i.succ let T := fun i : Fin n ↦ hessian (pullback P g) x i.succ 0 let U := fun i j : Fin n ↦ hessian (pullback P g) x i.succ j.succ Source29NormalShiftAlgebra.newtonResidual A S B T U + Source29NormalShiftAlgebra.correction A S B T (gradient g (tail x)) U (hessian g (tail x)) = 0 := by have he := polynomial_cubicLevel_transform P g x hg dsimp only at he ⊢ rw [cubicLevel_eval, hP, hgmin, mul_zero, sub_zero] at he exact he.symm end Coordinates end end Source29NormalShiftDerivatives /- Component: NormalShiftScaling.inc -/ namespace Source29NormalShiftScaling open Source29NormalShiftAlgebra noncomputable section variable {ι K : Type*} [Fintype ι] [Field K] /-- The tangential cubic correction. -/ def rhoCorrection (B : ι → K) (U : ι → ι → K) : K := traceComplement U B B /-- The correction with mixed normal/tangential scaling. -/ def mixedCorrection (A : K) (B T a : ι → K) (U G : ι → ι → K) : K := -A * (traceComplement U B a + traceComplement U a B) + 2 * (dot a B * dot B T - dot B B * dot a T) - A * traceComplement G B B /-- The correction with quadratic background-gradient scaling. -/ def epsilonCorrection (A S : K) (B T a : ι → K) (U G : ι → ι → K) : K := A^2 * traceComplement U a a + S * (dot a a * dot B B - (dot a B)^2) - 2 * A * (dot a a * dot B T - dot a B * dot a T) + A^2 * (traceComplement G B a + traceComplement G a B) lemma correction_grouping (A S : K) (B T a : ι → K) (U G : ι → ι → K) : correction A S B T a U G = rhoCorrection B U + mixedCorrection A B T a U G + epsilonCorrection A S B T a U G := by unfold correction rhoCorrection mixedCorrection epsilonCorrection ring lemma newtonResidual_scaling (κ ε ρ A S : K) (B T : ι → K) (U : ι → ι → K) (hε : ε ≠ 0) (hρ : ρ ≠ 0) : newtonResidual (κ*A) (κ/(ε*ρ)*S) (fun i ↦ κ*ρ*B i) (fun i ↦ κ/ε*T i) (fun i j ↦ κ*ρ/ε*U i j) = (κ^3*ρ/ε) * newtonResidual A S B T U := by unfold newtonResidual rw [trace_mul, dot_mul_left, dot_mul_right, dot_mul_left, dot_mul_right] field_simp /-- Exact algebraic separation of the three vanishing correction factors. -/ theorem correction_scaling (κ ε ρ A S : K) (B T a : ι → K) (U G : ι → ι → K) (hε : ε ≠ 0) (hρ : ρ ≠ 0) : correction (κ*A) (κ/(ε*ρ)*S) (fun i ↦ κ*ρ*B i) (fun i ↦ κ/ε*T i) (fun i ↦ ε*a i) (fun i j ↦ κ*ρ/ε*U i j) G = (κ^3*ρ/ε) * (ρ^2*rhoCorrection B U + ε*ρ*mixedCorrection A B T a U G + ε^2*epsilonCorrection A S B T a U G) := by unfold correction rhoCorrection mixedCorrection epsilonCorrection traceComplement simp only [dot_mul_left, dot_mul_right, trace_mul, bilinear_mul_matrix, bilinear_mul_left, bilinear_mul_right] field_simp ring /-- The scaled full level operator, with the background minimal-graph term retained rather than assumed to vanish under a nonlinear coordinate change. -/ theorem normal_shift_scaling (κ ε ρ A S : K) (B T a : ι → K) (U G : ι → ι → K) (hε : ε ≠ 0) (hρ : ρ ≠ 0) : shiftedLevelOperator (κ*A) (κ/(ε*ρ)*S) (fun i ↦ κ*ρ*B i) (fun i ↦ κ/ε*T i) (fun i ↦ ε*a i) (fun i j ↦ κ*ρ/ε*U i j) G = (κ^3*ρ/ε) * (newtonResidual A S B T U - (ε/ρ)*A^3*backgroundGraphOperator (fun i ↦ ε*a i) G + ρ^2*rhoCorrection B U + ε*ρ*mixedCorrection A B T a U G + ε^2*epsilonCorrection A S B T a U G) := by rw [normal_shift_identity, newtonResidual_scaling κ ε ρ A S B T U hε hρ, correction_scaling κ ε ρ A S B T a U G hε hρ] field_simp ring /-- Once the actual background graph equation is zero, the scaled level equation reduces to the Newton residual and the three explicit corrections. -/ theorem scaled_equation (κ ε ρ A S : K) (B T a : ι → K) (U G : ι → ι → K) (hκ : κ ≠ 0) (hε : ε ≠ 0) (hρ : ρ ≠ 0) (hlevel : shiftedLevelOperator (κ*A) (κ/(ε*ρ)*S) (fun i ↦ κ*ρ*B i) (fun i ↦ κ/ε*T i) (fun i ↦ ε*a i) (fun i j ↦ κ*ρ/ε*U i j) G = 0) (hbackground : backgroundGraphOperator (fun i ↦ ε*a i) G = 0) : newtonResidual A S B T U + ρ^2*rhoCorrection B U + ε*ρ*mixedCorrection A B T a U G + ε^2*epsilonCorrection A S B T a U G = 0 := by rw [normal_shift_scaling κ ε ρ A S B T a U G hε hρ, hbackground, mul_zero, sub_zero] at hlevel exact (mul_eq_zero.mp hlevel).resolve_left (div_ne_zero (mul_ne_zero (pow_ne_zero 3 hκ) hρ) hε) end end Source29NormalShiftScaling /- Component: NormalShiftScalingLimit.inc -/ namespace Source29NormalShiftScalingLimit open Filter Source29NormalShiftAlgebra Source29NormalShiftScaling open scoped Topology noncomputable section variable {ι : Type*} [Fintype ι] /-- A tuple of normalized scalar, vector, and matrix jets. -/ abbrev Jet (ι : Type*) := (ℝ × ℝ) × ((ι → ℝ) × (ι → ℝ) × (ι → ℝ)) × ((ι → ι → ℝ) × (ι → ι → ℝ)) def residual (j : Jet ι) : ℝ := newtonResidual j.1.1 j.1.2 j.2.1.1 j.2.1.2.1 j.2.2.1 def rhoTerm (j : Jet ι) : ℝ := rhoCorrection j.2.1.1 j.2.2.1 def mixedTerm (j : Jet ι) : ℝ := mixedCorrection j.1.1 j.2.1.1 j.2.1.2.1 j.2.1.2.2 j.2.2.1 j.2.2.2 def epsilonTerm (j : Jet ι) : ℝ := epsilonCorrection j.1.1 j.1.2 j.2.1.1 j.2.1.2.1 j.2.1.2.2 j.2.2.1 j.2.2.2 lemma residual_continuous : Continuous (residual : Jet ι → ℝ) := by unfold residual newtonResidual dot trace fun_prop lemma rhoTerm_continuous : Continuous (rhoTerm : Jet ι → ℝ) := by unfold rhoTerm rhoCorrection traceComplement dot trace bilinear fun_prop lemma mixedTerm_continuous : Continuous (mixedTerm : Jet ι → ℝ) := by unfold mixedTerm mixedCorrection traceComplement dot trace bilinear fun_prop lemma epsilonTerm_continuous : Continuous (epsilonTerm : Jet ι → ℝ) := by unfold epsilonTerm epsilonCorrection traceComplement dot trace bilinear fun_prop /-- The grouped corrections vanish when both scale parameters tend to zero and the normalized jets converge. This assumes jet convergence explicitly. -/ theorem residual_eq_zero_of_tendsto {α : Type*} {l : Filter α} [NeBot l] (ε ρ : α → ℝ) (j : α → Jet ι) (j₀ : Jet ι) (hε : Tendsto ε l (𝓝 0)) (hρ : Tendsto ρ l (𝓝 0)) (hj : Tendsto j l (𝓝 j₀)) (heq : ∀ᶠ t in l, residual (j t) + (ρ t)^2 * rhoTerm (j t) + ε t * ρ t * mixedTerm (j t) + (ε t)^2 * epsilonTerm (j t) = 0) : residual j₀ = 0 := by have hE := residual_continuous.continuousAt.tendsto.comp hj have hR := rhoTerm_continuous.continuousAt.tendsto.comp hj have hM := mixedTerm_continuous.continuousAt.tendsto.comp hj have hS := epsilonTerm_continuous.continuousAt.tendsto.comp hj have htotal : Tendsto (fun t ↦ residual (j t) + (ρ t)^2 * rhoTerm (j t) + ε t * ρ t * mixedTerm (j t) + (ε t)^2 * epsilonTerm (j t)) l (𝓝 (residual j₀)) := by simpa using ((hE.add ((hρ.pow 2).mul hR)).add ((hε.mul hρ).mul hM)).add ((hε.pow 2).mul hS) have hzero : Tendsto (fun t ↦ residual (j t) + (ρ t)^2 * rhoTerm (j t) + ε t * ρ t * mixedTerm (j t) + (ε t)^2 * epsilonTerm (j t)) l (𝓝 0) := tendsto_const_nhds.congr' (Filter.Eventually.mono heq (fun _ ht ↦ ht.symm)) exact tendsto_nhds_unique htotal hzero /-- Coordinate-wise inputs to the normalized-jet limit theorem. No special values for the limiting background gradient or Hessian are assumed. -/ theorem newtonResidual_eq_zero_of_tendsto {α : Type*} {l : Filter α} [NeBot l] (ε ρ A S : α → ℝ) (B T a : α → ι → ℝ) (U G : α → ι → ι → ℝ) (A₀ S₀ : ℝ) (B₀ T₀ a₀ : ι → ℝ) (U₀ G₀ : ι → ι → ℝ) (hε : Tendsto ε l (𝓝 0)) (hρ : Tendsto ρ l (𝓝 0)) (hA : Tendsto A l (𝓝 A₀)) (hS : Tendsto S l (𝓝 S₀)) (hB : Tendsto B l (𝓝 B₀)) (hT : Tendsto T l (𝓝 T₀)) (ha : Tendsto a l (𝓝 a₀)) (hU : Tendsto U l (𝓝 U₀)) (hG : Tendsto G l (𝓝 G₀)) (heq : ∀ᶠ t in l, newtonResidual (A t) (S t) (B t) (T t) (U t) + (ρ t)^2 * rhoCorrection (B t) (U t) + ε t * ρ t * mixedCorrection (A t) (B t) (T t) (a t) (U t) (G t) + (ε t)^2 * epsilonCorrection (A t) (S t) (B t) (T t) (a t) (U t) (G t) = 0) : newtonResidual A₀ S₀ B₀ T₀ U₀ = 0 := by exact residual_eq_zero_of_tendsto ε ρ (fun t ↦ ((A t, S t), (B t, T t, a t), (U t, G t))) ((A₀, S₀), (B₀, T₀, a₀), (U₀, G₀)) hε hρ ((hA.prodMk_nhds hS).prodMk_nhds ((hB.prodMk_nhds (hT.prodMk_nhds ha)).prodMk_nhds (hU.prodMk_nhds hG))) heq end end Source29NormalShiftScalingLimit /- Component: AnalyticDerivativeRemainder.inc -/ namespace Source29AnalyticDerivativeRemainder open Filter Asymptotics open scoped Topology noncomputable section variable {E F : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [NormedAddCommGroup F] [NormedSpace ℝ F] /-- A finite truncation retaining the original multilinear coefficients. -/ def truncateSeries (p : FormalMultilinearSeries ℝ E F) (N : ℕ) : FormalMultilinearSeries ℝ E F := fun k => if k < N then p k else 0 theorem partialSum_hasFiniteFPowerSeries (p : FormalMultilinearSeries ℝ E F) (N : ℕ) : HasFiniteFPowerSeriesOnBall (p.partialSum N) (truncateSeries p N) 0 N ⊤ := by apply HasFiniteFPowerSeriesOnBall.mk' · intro k hk simp only [truncateSeries, ite_eq_right (not_lt.mpr hk)] · simp · intro y _ simp only [zero_add, FormalMultilinearSeries.partialSum] apply Finset.sum_congr rfl intro k hk simp only [truncateSeries, ite_eq_left (Finset.mem_range.mp hk)] /-- A coefficient of the differentiated series depends only on the next coefficient of the original series. -/ theorem derivSeries_congr_coeff (p q : FormalMultilinearSeries ℝ E F) (k : ℕ) (h : p (k + 1) = q (k + 1)) : p.derivSeries k = q.derivSeries k := by have h' : p (1 + k) = q (1 + k) := by rw [Nat.add_comm 1 k] exact h simp only [FormalMultilinearSeries.derivSeries, ContinuousLinearMap.compFormalMultilinearSeries_apply, FormalMultilinearSeries.changeOriginSeries, FormalMultilinearSeries.changeOriginSeriesTerm, h'] /-- Differentiation of a finite Taylor polynomial is exact. -/ theorem fderiv_partialSum (p : FormalMultilinearSeries ℝ E F) (N : ℕ) (x : E) : fderiv ℝ (p.partialSum (N + 1)) x = p.derivSeries.partialSum N x := by have h := (partialSum_hasFiniteFPowerSeries p (N + 1)).fderiv have he := h.eq_partialSum x (by simp) N le_rfl simp only [zero_add] at he rw [he] unfold FormalMultilinearSeries.partialSum apply Finset.sum_congr rfl intro k hk have hklt : k < N := Finset.mem_range.mp hk rw [derivSeries_congr_coeff (truncateSeries p (N + 1)) p k] simp only [truncateSeries, ite_eq_left (by omega : k + 1 < N + 1)] /-- The second derivative of a finite Taylor polynomial is also exact. -/ theorem fderiv_fderiv_partialSum (p : FormalMultilinearSeries ℝ E F) (N : ℕ) (x : E) : fderiv ℝ (fderiv ℝ (p.partialSum (N + 2))) x = p.derivSeries.derivSeries.partialSum N x := by have he : fderiv ℝ (p.partialSum (N + 2)) = p.derivSeries.partialSum (N + 1) := funext (fderiv_partialSum p (N + 1)) rw [he, fderiv_partialSum] section Complete variable [CompleteSpace F] /-- Taylor remainder for the first derivative, proved from the differentiated convergent series rather than from convergence of function values. -/ theorem fderiv_remainder_isBigO {f : E → F} {p : FormalMultilinearSeries ℝ E F} {a : E} (hp : HasFPowerSeriesAt f p a) (N : ℕ) : (fun y => fderiv ℝ f (a + y) - fderiv ℝ (p.partialSum (N + 1)) y) =O[𝓝 0] (fun y : E => ‖y‖^N) := by obtain ⟨r, hr⟩ := hp have hd : HasFPowerSeriesAt (fderiv ℝ f) p.derivSeries a := ⟨r, hr.fderiv⟩ simpa only [fderiv_partialSum] using hd.isBigO_sub_partialSum_pow N /-- Taylor remainder for the second derivative in the full operator norm. -/ theorem fderiv_fderiv_remainder_isBigO {f : E → F} {p : FormalMultilinearSeries ℝ E F} {a : E} (hp : HasFPowerSeriesAt f p a) (N : ℕ) : (fun y => fderiv ℝ (fderiv ℝ f) (a + y) - fderiv ℝ (fderiv ℝ (p.partialSum (N + 2))) y) =O[𝓝 0] (fun y : E => ‖y‖^N) := by obtain ⟨r, hr⟩ := hp have hd : HasFPowerSeriesAt (fderiv ℝ (fderiv ℝ f)) p.derivSeries.derivSeries a := ⟨r, by convert! hr.fderiv.fderiv⟩ simpa only [fderiv_fderiv_partialSum] using hd.isBigO_sub_partialSum_pow N /-- An exact identification of the initial Taylor polynomial gives its first derivative as the leading term, with one higher order of remainder. -/ theorem fderiv_initial_remainder_isBigO {f H : E → F} {p : FormalMultilinearSeries ℝ E F} {a : E} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hpoly : ∀ y, p.partialSum (d + 1) y = H y) : (fun y => fderiv ℝ f (a + y) - fderiv ℝ H y) =O[𝓝 0] (fun y : E => ‖y‖^d) := by have he : p.partialSum (d + 1) = H := funext hpoly simpa only [he] using fderiv_remainder_isBigO hp d /-- For an initial term of positive degree d, the second derivative remainder has order d-1. The degree-one case is included. -/ theorem fderiv_fderiv_initial_remainder_isBigO {f H : E → F} {p : FormalMultilinearSeries ℝ E F} {a : E} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hd : 0 < d) (hpoly : ∀ y, p.partialSum (d + 1) y = H y) : (fun y => fderiv ℝ (fderiv ℝ f) (a + y) - fderiv ℝ (fderiv ℝ H) y) =O[𝓝 0] (fun y : E => ‖y‖^(d - 1)) := by have he : p.partialSum ((d - 1) + 2) = H := by rw [show d - 1 + 2 = d + 1 by omega] exact funext hpoly simpa only [he] using fderiv_fderiv_remainder_isBigO hp (d - 1) end Complete end end Source29AnalyticDerivativeRemainder /- Component: HomogeneousDerivativeScaling.inc -/ namespace Source29HomogeneousDerivativeScaling open Filter open scoped Topology noncomputable section variable {E F : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [NormedAddCommGroup F] [NormedSpace ℝ F] /-- The exact chain rule for an affine dilation, including the canonical zero derivative at points where differentiability fails. -/ theorem fderiv_affine_input (f : E → F) (a : E) (t : ℝ) (x : E) : fderiv ℝ (fun y => f (a + t • y)) x = t • fderiv ℝ f (a + t • x) := by have he := fderiv_comp_smul (𝕜 := ℝ) (f := fun z => f (a + z)) (x := x) t rw [fderiv_comp_add_left] at he convert! he theorem fderiv_rescaled (f : E → F) (a : E) (d : ℕ) (t : ℝ) (x : E) : fderiv ℝ (fun y => (t^d)⁻¹ • f (a + t • y)) x = ((t^d)⁻¹ * t) • fderiv ℝ f (a + t • x) := by change fderiv ℝ ((t^d)⁻¹ • (fun y => f (a + t • y))) x = _ rw [fderiv_const_smul_field] change (t^d)⁻¹ • fderiv ℝ (fun y => f (a + t • y)) x = _ rw [fderiv_affine_input, smul_smul] theorem fderiv_fderiv_rescaled (f : E → F) (a : E) (d : ℕ) (t : ℝ) (x : E) : fderiv ℝ (fderiv ℝ (fun y => (t^d)⁻¹ • f (a + t • y))) x = ((t^d)⁻¹ * t^2) • fderiv ℝ (fderiv ℝ f) (a + t • x) := by have he : fderiv ℝ (fun y => (t^d)⁻¹ • f (a + t • y)) = fun y => ((t^d)⁻¹ * t) • fderiv ℝ f (a + t • y) := funext (fderiv_rescaled f a d t) rw [he] change fderiv ℝ (((t^d)⁻¹ * t) • (fun y => fderiv ℝ f (a + t • y))) x = _ have hs := congrFun (fderiv_const_smul_field (𝕜 := ℝ) (f := fun y => fderiv ℝ f (a + t • y)) ((t^d)⁻¹ * t)) x calc _ = ((t^d)⁻¹ * t) • fderiv ℝ (fun y => fderiv ℝ f (a + t • y)) x := by convert! hs _ = _ := by rw [fderiv_affine_input (fderiv ℝ f) a t x, smul_smul] congr 1 ring /-- Homogeneity lowers by one under the first derivative. This follows from exact equivariance of the Fréchet derivative under invertible dilations. -/ theorem fderiv_homogeneous {H : E → F} (d : ℕ) (hH : ∀ (t : ℝ), 0 < t → ∀ x, H (t • x) = t^(d+1) • H x) : ∀ (t : ℝ), 0 < t → ∀ x, fderiv ℝ H (t • x) = t^d • fderiv ℝ H x := by intro t ht x have hf : (fun y => H (t • y)) = t^(d+1) • H := funext (hH t ht) have he := congrArg (fun f : E → F => fderiv ℝ f x) hf rw [fderiv_comp_smul, fderiv_const_smul_field] at he change t • fderiv ℝ H (t • x) = t^(d+1) • fderiv ℝ H x at he have hm := congrArg (fun L : E →L[ℝ] F => t⁻¹ • L) he simpa only [smul_smul, inv_mul_cancel₀ ht.ne', one_smul, pow_succ', ← mul_assoc, inv_mul_cancel₀ ht.ne', one_mul] using hm /-- Homogeneity lowers by two under the second derivative. -/ theorem fderiv_fderiv_homogeneous {H : E → F} (d : ℕ) (hH : ∀ (t : ℝ), 0 < t → ∀ x, H (t • x) = t^(d+2) • H x) : ∀ (t : ℝ), 0 < t → ∀ x, fderiv ℝ (fderiv ℝ H) (t • x) = t^d • fderiv ℝ (fderiv ℝ H) x := fderiv_homogeneous d (fderiv_homogeneous (d+1) hH) omit [NormedSpace ℝ F] in /-- A degree-zero homogeneous function continuous at the origin is constant. -/ theorem eq_origin_of_homogeneous_zero {H : E → F} (hcont : ContinuousAt H 0) (hH : ∀ (t : ℝ), 0 < t → ∀ x, H (t • x) = H x) (x : E) : H x = H 0 := by have hx : Tendsto (fun t : ℝ => t • x) (𝓝 0) (𝓝 (0 : E)) := by have hc : Continuous (fun t : ℝ => t • x) := by fun_prop have ht := hc.tendsto (0 : ℝ) simpa only [zero_smul] using ht have hc : Tendsto (fun t : ℝ => H (t • x)) (𝓝 0) (𝓝 (H 0)) := hcont.tendsto.comp hx have ht : Tendsto (fun _t : ℝ => H x) (𝓝[>] 0) (𝓝 (H 0)) := by apply (hc.mono_left nhdsWithin_le_nhds).congr' filter_upwards [self_mem_nhdsWithin] with t ht exact hH t ht x exact tendsto_nhds_unique tendsto_const_nhds ht theorem fderiv_eq_zero_of_homogeneous_zero {H : E → F} (hcont : ContinuousAt H 0) (hH : ∀ (t : ℝ), 0 < t → ∀ x, H (t • x) = H x) : fderiv ℝ H = 0 := by have he : H = fun _ => H 0 := funext (eq_origin_of_homogeneous_zero hcont hH) rw [he] funext x exact fderiv_const_apply (H 0) /-- In degree one the second derivative vanishes, using continuity of the first derivative at the origin. -/ theorem fderiv_fderiv_eq_zero_of_homogeneous_one {H : E → F} (hcont : ContinuousAt (fderiv ℝ H) 0) (hH : ∀ (t : ℝ), 0 < t → ∀ x, H (t • x) = t • H x) : fderiv ℝ (fderiv ℝ H) = 0 := by apply fderiv_eq_zero_of_homogeneous_zero hcont have he := fderiv_homogeneous 0 (H := H) (by simpa only [zero_add, pow_one] using hH) simpa only [pow_zero, one_smul] using he end end Source29HomogeneousDerivativeScaling /- Component: AnalyticDerivativeScaling.inc -/ namespace Source29AnalyticDerivativeScaling open Filter open Source29AnalyticDerivativeRemainder Source29HomogeneousDerivativeScaling open scoped Topology noncomputable section variable {E F : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [NormedAddCommGroup F] [NormedSpace ℝ F] [CompleteSpace F] omit [CompleteSpace F] in lemma analyticAt_of_partialSum_eq (p : FormalMultilinearSeries ℝ E F) (N : ℕ) {H : E → F} (hpoly : ∀ y, p.partialSum N y = H y) : AnalyticAt ℝ H 0 := by have he : p.partialSum N = H := funext hpoly rw [← he] exact (partialSum_hasFiniteFPowerSeries p N).toHasFPowerSeriesOnBall.analyticAt /-- First derivatives of normalized analytic dilations converge uniformly on bounded sets to the derivative of the initial homogeneous term. -/ theorem fderiv_tendstoUniformlyOn {f H : E → F} {a : E} {p : FormalMultilinearSeries ℝ E F} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hpoly : ∀ y, p.partialSum (d+1) y = H y) (hH : ∀ (t : ℝ), 0 < t → ∀ x, H (t • x) = t^d • H x) (S : Set E) (hS : Bornology.IsBounded S) : TendstoUniformlyOn (fun t : ℝ => fun x => fderiv ℝ (fun y => (t^d)⁻¹ • f (a + t • y)) x) (fderiv ℝ H) (𝓝[>] 0) S := by cases d with | zero => obtain ⟨r, hr⟩ := hp have hpd : HasFPowerSeriesAt (fderiv ℝ f) p.derivSeries a := ⟨r, hr.fderiv⟩ have ht := Source29WeightedInitialScaling.below_order_tendstoUniformlyOn_zero hpd 0 (by intro k hk; omega) (-1) (by norm_num) S hS have hz : fderiv ℝ H = 0 := fderiv_eq_zero_of_homogeneous_zero (analyticAt_of_partialSum_eq p 1 hpoly).continuousAt (by simpa only [pow_zero, one_smul] using hH) rw [hz] apply ht.congr filter_upwards [self_mem_nhdsWithin] with t _ intro x _ dsimp only rw [fderiv_rescaled] simp only [neg_neg, Real.rpow_one, pow_zero, inv_one, one_mul] | succ d => have ht := Source29HomogeneousRescalingLimit.tendstoUniformlyOn_of_isBounded d (fderiv_initial_remainder_isBigO hp (d+1) hpoly) (fderiv_homogeneous d hH) S hS apply ht.congr filter_upwards [self_mem_nhdsWithin] with t ht intro x _ dsimp only rw [fderiv_rescaled] congr 1 rw [pow_succ] field_simp [(show 0 < t from ht).ne'] /-- Second derivatives of normalized analytic dilations converge uniformly on bounded sets. Degrees zero and one are included explicitly. -/ theorem fderiv_fderiv_tendstoUniformlyOn {f H : E → F} {a : E} {p : FormalMultilinearSeries ℝ E F} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hpoly : ∀ y, p.partialSum (d+1) y = H y) (hH : ∀ (t : ℝ), 0 < t → ∀ x, H (t • x) = t^d • H x) (S : Set E) (hS : Bornology.IsBounded S) : TendstoUniformlyOn (fun t : ℝ => fun x => fderiv ℝ (fderiv ℝ (fun y => (t^d)⁻¹ • f (a + t • y))) x) (fderiv ℝ (fderiv ℝ H)) (𝓝[>] 0) S := by obtain ⟨r, hr⟩ := hp have hp : HasFPowerSeriesAt f p a := ⟨r, hr⟩ have hpd : HasFPowerSeriesAt (fderiv ℝ (fderiv ℝ f)) p.derivSeries.derivSeries a := ⟨r, by convert! hr.fderiv.fderiv⟩ cases d with | zero => have ht := Source29WeightedInitialScaling.below_order_tendstoUniformlyOn_zero hpd 0 (by intro k hk; omega) (-2) (by norm_num) S hS have hz : fderiv ℝ H = 0 := fderiv_eq_zero_of_homogeneous_zero (analyticAt_of_partialSum_eq p 1 hpoly).continuousAt (by simpa only [pow_zero, one_smul] using hH) have hzz : fderiv ℝ (fderiv ℝ H) = 0 := by rw [hz] funext x exact fderiv_const_apply 0 rw [hzz] apply ht.congr filter_upwards [self_mem_nhdsWithin] with t _ intro x _ dsimp only rw [fderiv_fderiv_rescaled] simp only [neg_neg, Real.rpow_two, pow_zero, inv_one, one_mul] | succ d => cases d with | zero => have ht := Source29WeightedInitialScaling.below_order_tendstoUniformlyOn_zero hpd 0 (by intro k hk; omega) (-1) (by norm_num) S hS have hz : fderiv ℝ (fderiv ℝ H) = 0 := fderiv_fderiv_eq_zero_of_homogeneous_one (analyticAt_of_partialSum_eq p 2 hpoly).fderiv.continuousAt (by simpa only [Nat.zero_add, pow_one] using hH) rw [hz] apply ht.congr filter_upwards [self_mem_nhdsWithin] with t ht intro x _ dsimp only rw [fderiv_fderiv_rescaled] simp only [neg_neg, Real.rpow_one, Nat.zero_add, pow_one] congr 1 field_simp [(show 0 < t from ht).ne'] | succ d => have hrem := fderiv_fderiv_initial_remainder_isBigO hp (d+2) (by omega) hpoly have ht := Source29HomogeneousRescalingLimit.tendstoUniformlyOn_of_isBounded (f := fderiv ℝ (fderiv ℝ f)) (q := fderiv ℝ (fderiv ℝ H)) (a := a) d (by simpa only [show d + 2 - 1 = d + 1 by omega] using hrem) (fderiv_fderiv_homogeneous d hH) S hS apply ht.congr filter_upwards [self_mem_nhdsWithin] with t ht intro x _ dsimp only rw [fderiv_fderiv_rescaled] congr 1 rw [pow_add] field_simp [(show 0 < t from ht).ne'] ring /-- Initial-series form of the first derivative limit. Only diagonal vanishing is required of the lower Taylor coefficients. -/ theorem initial_fderiv_tendstoUniformlyOn {f : E → F} {a : E} {p : FormalMultilinearSeries ℝ E F} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hlow : ∀ k < d, ∀ x, p k (fun _ => x) = 0) (S : Set E) (hS : Bornology.IsBounded S) : TendstoUniformlyOn (fun t : ℝ => fun x => fderiv ℝ (fun y => (t^d)⁻¹ • f (a + t • y)) x) (fderiv ℝ (fun x => p d (fun _ => x))) (𝓝[>] 0) S := fderiv_tendstoUniformlyOn hp d (Source29AnalyticInitialRemainder.partialSum_eq_initial p d hlow) (fun t _ x => Source29AnalyticInitialRemainder.diagonal_smul p d t x) S hS /-- Initial-series form of the second derivative limit, including degrees zero and one. -/ theorem initial_fderiv_fderiv_tendstoUniformlyOn {f : E → F} {a : E} {p : FormalMultilinearSeries ℝ E F} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hlow : ∀ k < d, ∀ x, p k (fun _ => x) = 0) (S : Set E) (hS : Bornology.IsBounded S) : TendstoUniformlyOn (fun t : ℝ => fun x => fderiv ℝ (fderiv ℝ (fun y => (t^d)⁻¹ • f (a + t • y))) x) (fderiv ℝ (fderiv ℝ (fun x => p d (fun _ => x)))) (𝓝[>] 0) S := fderiv_fderiv_tendstoUniformlyOn hp d (Source29AnalyticInitialRemainder.partialSum_eq_initial p d hlow) (fun t _ x => Source29AnalyticInitialRemainder.diagonal_smul p d t x) S hS end end Source29AnalyticDerivativeScaling /- Component: WeightedAnalyticDerivativeScaling.inc -/ namespace Source29WeightedAnalyticDerivativeScaling open Filter open Source29AnalyticDerivativeRemainder Source29AnalyticDerivativeScaling open scoped Topology noncomputable section variable {E F : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [NormedAddCommGroup F] [NormedSpace ℝ F] [CompleteSpace F] lemma analyticAt_of_partialSum_eq_all (p : FormalMultilinearSeries ℝ E F) (N : ℕ) {H : E → F} (hpoly : ∀ y, p.partialSum N y = H y) (x : E) : AnalyticAt ℝ H x := by have he : p.partialSum N = H := funext hpoly rw [← he] exact (partialSum_hasFiniteFPowerSeries p N).toHasFPowerSeriesOnBall.analyticAt_of_mem (by simp) omit [CompleteSpace F] in lemma weighted_fderiv_factor (f : E → F) (a : E) (d : ℕ) (β t : ℝ) (ht : 0 < t) (x : E) : t^((d : ℝ)-β) • fderiv ℝ (fun y => (t^d)⁻¹ • f (a+t•y)) x = fderiv ℝ (fun y => t^(-β) • f (a+t•y)) x := by have he : (fun y => t^(-β) • f (a+t•y)) = t^((d : ℝ)-β) • (fun y => (t^d)⁻¹ • f (a+t•y)) := funext (fun y => (Source29WeightedInitialScaling.weighted_factor t β d ht (f (a+t•y))).symm) rw [he, fderiv_const_smul_field] rfl omit [CompleteSpace F] in lemma weighted_fderiv_fderiv_factor (f : E → F) (a : E) (d : ℕ) (β t : ℝ) (ht : 0 < t) (x : E) : t^((d : ℝ)-β) • fderiv ℝ (fderiv ℝ (fun y => (t^d)⁻¹ • f (a+t•y))) x = fderiv ℝ (fderiv ℝ (fun y => t^(-β) • f (a+t•y))) x := by have he : (fun y => t^(-β) • f (a+t•y)) = t^((d : ℝ)-β) • (fun y => (t^d)⁻¹ • f (a+t•y)) := funext (fun y => (Source29WeightedInitialScaling.weighted_factor t β d ht (f (a+t•y))).symm) rw [he, fderiv_const_smul_field] have hs := congrFun (fderiv_const_smul_field (𝕜 := ℝ) (f := fderiv ℝ (fun y => (t^d)⁻¹ • f (a+t•y))) (t^((d : ℝ)-β))) x convert! hs.symm lemma positive_power_tendsto_zero (d : ℕ) (β : ℝ) (hβ : β < (d : ℝ)) : Tendsto (fun t : ℝ => t^((d : ℝ)-β)) (𝓝[>] 0) (𝓝 0) := by have hc := (Real.continuousAt_rpow_const 0 ((d : ℝ)-β) (Or.inr (by linarith))).tendsto have hz : (0 : ℝ)^((d : ℝ)-β) = 0 := Real.zero_rpow (by linarith) rw [hz] at hc exact hc.mono_left nhdsWithin_le_nhds /-- A weight strictly below the Taylor order kills the first derivative uniformly on compact sets. The bound for the limiting derivative is derived from the finite Taylor polynomial. -/ theorem below_order_fderiv_tendstoUniformlyOn_zero {f H : E → F} {a : E} {p : FormalMultilinearSeries ℝ E F} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hpoly : ∀ y, p.partialSum (d+1) y = H y) (hH : ∀ (t : ℝ), 0 < t → ∀ x, H (t • x) = t^d • H x) (β : ℝ) (hβ : β < (d : ℝ)) (S : Set E) (hS : IsCompact S) : TendstoUniformlyOn (fun t : ℝ => fun x => fderiv ℝ (fun y => t^(-β) • f (a+t•y)) x) (fun _ => 0) (𝓝[>] 0) S := by have hF := fderiv_tendstoUniformlyOn hp d hpoly hH S hS.isBounded have hc : Continuous (fderiv ℝ H) := continuous_iff_continuousAt.mpr (fun x => (analyticAt_of_partialSum_eq_all p (d+1) hpoly x).fderiv.continuousAt) obtain ⟨B,hB⟩ := (hS.image hc).isBounded.exists_norm_le have ht := Source29WeightedInitialScaling.scalar_smul_tendstoUniformlyOn_zero hF (positive_power_tendsto_zero d β hβ) B (fun x hx => hB _ ⟨x,hx,rfl⟩) apply ht.congr filter_upwards [self_mem_nhdsWithin] with t ht intro x _ exact weighted_fderiv_factor f a d β t ht x /-- The second derivative also vanishes under every strict lower weight, including Taylor orders zero and one. -/ theorem below_order_fderiv_fderiv_tendstoUniformlyOn_zero {f H : E → F} {a : E} {p : FormalMultilinearSeries ℝ E F} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hpoly : ∀ y, p.partialSum (d+1) y = H y) (hH : ∀ (t : ℝ), 0 < t → ∀ x, H (t • x) = t^d • H x) (β : ℝ) (hβ : β < (d : ℝ)) (S : Set E) (hS : IsCompact S) : TendstoUniformlyOn (fun t : ℝ => fun x => fderiv ℝ (fderiv ℝ (fun y => t^(-β) • f (a+t•y))) x) (fun _ => 0) (𝓝[>] 0) S := by have hF := fderiv_fderiv_tendstoUniformlyOn hp d hpoly hH S hS.isBounded have hc : Continuous (fderiv ℝ (fderiv ℝ H)) := continuous_iff_continuousAt.mpr (fun x => (analyticAt_of_partialSum_eq_all p (d+1) hpoly x).fderiv.fderiv.continuousAt) have hbounded : Bornology.IsBounded ((fderiv ℝ (fderiv ℝ H)) '' S) := by apply IsCompact.isBounded convert! hS.image hc obtain ⟨B,hB⟩ := hbounded.exists_norm_le have ht := Source29WeightedInitialScaling.scalar_smul_tendstoUniformlyOn_zero (V := E →L[ℝ] (E →L[ℝ] F)) (q := fderiv ℝ (fderiv ℝ H)) (F := fun t : ℝ => fun x => fderiv ℝ (fderiv ℝ (fun y => (t^d)⁻¹ • f (a+t•y))) x) (by convert! hF) (positive_power_tendsto_zero d β hβ) B (fun x hx => by convert! hB _ ⟨x,hx,rfl⟩) apply ht.congr filter_upwards [self_mem_nhdsWithin] with t ht intro x _ exact weighted_fderiv_fderiv_factor f a d β t ht x /-- The first derivative of a weighted dilation retains the initial polynomial precisely at its Taylor weight. -/ theorem at_or_below_order_fderiv_tendstoUniformlyOn {f H : E → F} {a : E} {p : FormalMultilinearSeries ℝ E F} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hpoly : ∀ y, p.partialSum (d+1) y = H y) (hH : ∀ (t : ℝ), 0 < t → ∀ x, H (t • x) = t^d • H x) (β : ℝ) (hβ : β ≤ (d : ℝ)) (S : Set E) (hS : IsCompact S) : TendstoUniformlyOn (fun t : ℝ => fun x => fderiv ℝ (fun y => t^(-β) • f (a+t•y)) x) (fun x => if β = (d : ℝ) then fderiv ℝ H x else 0) (𝓝[>] 0) S := by classical rcases lt_or_eq_of_le hβ with hlt | heq · simpa only [ne_of_lt hlt, ite_false] using below_order_fderiv_tendstoUniformlyOn_zero hp d hpoly hH β hlt S hS · subst β simp only [ite_true] apply (fderiv_tendstoUniformlyOn hp d hpoly hH S hS.isBounded).congr filter_upwards [self_mem_nhdsWithin] with t ht intro x _ simp only [Real.rpow_neg (le_of_lt ht), Real.rpow_natCast] /-- The same weight selection holds for the second derivative. -/ theorem at_or_below_order_fderiv_fderiv_tendstoUniformlyOn {f H : E → F} {a : E} {p : FormalMultilinearSeries ℝ E F} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hpoly : ∀ y, p.partialSum (d+1) y = H y) (hH : ∀ (t : ℝ), 0 < t → ∀ x, H (t • x) = t^d • H x) (β : ℝ) (hβ : β ≤ (d : ℝ)) (S : Set E) (hS : IsCompact S) : TendstoUniformlyOn (fun t : ℝ => fun x => fderiv ℝ (fderiv ℝ (fun y => t^(-β) • f (a+t•y))) x) (fun x => if β = (d : ℝ) then fderiv ℝ (fderiv ℝ H) x else 0) (𝓝[>] 0) S := by classical rcases lt_or_eq_of_le hβ with hlt | heq · simpa only [ne_of_lt hlt, ite_false] using below_order_fderiv_fderiv_tendstoUniformlyOn_zero hp d hpoly hH β hlt S hS · subst β simp only [ite_true] apply (fderiv_fderiv_tendstoUniformlyOn hp d hpoly hH S hS.isBounded).congr filter_upwards [self_mem_nhdsWithin] with t ht intro x _ simp only [Real.rpow_neg (le_of_lt ht), Real.rpow_natCast] /-- Initial-series version of weighted first-derivative convergence. -/ theorem initial_fderiv_tendstoUniformlyOn {f : E → F} {a : E} {p : FormalMultilinearSeries ℝ E F} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hlow : ∀ k < d, ∀ x, p k (fun _ => x) = 0) (β : ℝ) (hβ : β ≤ (d : ℝ)) (S : Set E) (hS : IsCompact S) : TendstoUniformlyOn (fun t : ℝ => fun x => fderiv ℝ (fun y => t^(-β) • f (a+t•y)) x) (fun x => if β = (d : ℝ) then fderiv ℝ (fun y => p d (fun _ => y)) x else 0) (𝓝[>] 0) S := at_or_below_order_fderiv_tendstoUniformlyOn hp d (Source29AnalyticInitialRemainder.partialSum_eq_initial p d hlow) (fun t _ x => Source29AnalyticInitialRemainder.diagonal_smul p d t x) β hβ S hS /-- Initial-series version of weighted second-derivative convergence. -/ theorem initial_fderiv_fderiv_tendstoUniformlyOn {f : E → F} {a : E} {p : FormalMultilinearSeries ℝ E F} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hlow : ∀ k < d, ∀ x, p k (fun _ => x) = 0) (β : ℝ) (hβ : β ≤ (d : ℝ)) (S : Set E) (hS : IsCompact S) : TendstoUniformlyOn (fun t : ℝ => fun x => fderiv ℝ (fderiv ℝ (fun y => t^(-β) • f (a+t•y))) x) (fun x => if β = (d : ℝ) then fderiv ℝ (fderiv ℝ (fun y => p d (fun _ => y))) x else 0) (𝓝[>] 0) S := at_or_below_order_fderiv_fderiv_tendstoUniformlyOn hp d (Source29AnalyticInitialRemainder.partialSum_eq_initial p d hlow) (fun t _ x => Source29AnalyticInitialRemainder.diagonal_smul p d t x) β hβ S hS end end Source29WeightedAnalyticDerivativeScaling /- Component: NewtonWeightedFace.inc -/ namespace Source29NewtonWeightedFace open MvPolynomial open Source29NewtonNormalDerivative Source29NewtonPureNormalPower open Source29QuarticReuse open scoped BigOperators noncomputable section variable {n d : ℕ} /-- A finite Newton face with a fixed scalar top normal coefficient. -/ def face (c : ℝ) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) : MvPolynomial (Fin (n + 1)) ℝ := C c * (X 0)^d + ∑ j ∈ S, rename Fin.succ (P j) * (X 0)^(j : ℕ) lemma eval_face (c : ℝ) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) (x : ℝ) (y : Fin n → ℝ) : eval (Fin.cons x y) (face c S P) = c * x^d + ∑ j ∈ S, eval y (P j) * x^(j : ℕ) := by simp only [face, map_add, map_sum, map_mul, map_pow, eval_C, eval_X, Fin.cons_zero, eval_rename, Function.comp_def, Fin.cons_succ] lemma finSuccEquiv_rename_succ (P : MvPolynomial (Fin n) ℝ) : finSuccEquiv ℝ n (rename Fin.succ P) = Polynomial.C P := by induction P using MvPolynomial.induction_on with | C c => simp only [rename_C, finSuccEquiv_C_scalar] | add P Q hP hQ => simp only [map_add, hP, hQ] | mul_X P i hP => simp only [map_mul, rename_X, finSuccEquiv_X_succ, hP] lemma finSuccEquiv_face (c : ℝ) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) : finSuccEquiv ℝ n (face c S P) = Polynomial.C (C c) * Polynomial.X^d + ∑ j ∈ S, Polynomial.C (P j) * Polynomial.X^(j : ℕ) := by simp only [face, map_add, map_sum, map_mul, map_pow, finSuccEquiv_rename_succ, finSuccEquiv_C_scalar, finSuccEquiv_X_zero] lemma top_coefficient (c : ℝ) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) : (finSuccEquiv ℝ n (face c S P)).coeff d = C c := by rw [finSuccEquiv_face, Polynomial.coeff_add, Polynomial.finsetSum_coeff] simp only [Polynomial.coeff_C_mul_X_pow, ↓reduceIte] have hz : ∑ j ∈ S, (if d = (j : ℕ) then P j else 0) = 0 := by apply Finset.sum_eq_zero intro j hj exact ite_eq_right (ne_of_gt j.isLt) rw [hz, add_zero] lemma coefficient_above (c : ℝ) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) (k : ℕ) (hk : d < k) : (finSuccEquiv ℝ n (face c S P)).coeff k = 0 := by rw [finSuccEquiv_face, Polynomial.coeff_add, Polynomial.finsetSum_coeff] simp only [Polynomial.coeff_C_mul_X_pow, ne_of_gt hk, ↓reduceIte, zero_add] apply Finset.sum_eq_zero intro j hj exact ite_eq_right (ne_of_gt (lt_trans j.isLt hk)) lemma normal_degree_le (c : ℝ) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) : (finSuccEquiv ℝ n (face c S P)).natDegree ≤ d := Polynomial.natDegree_le_iff_coeff_eq_zero.mpr (coefficient_above c S P) lemma normal_degree_eq (c : ℝ) (hc : c ≠ 0) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) : (finSuccEquiv ℝ n (face c S P)).natDegree = d := by apply le_antisymm (normal_degree_le c S P) apply Polynomial.le_natDegree_of_ne_zero rw [top_coefficient] simpa only [ne_eq, C_eq_zero] using hc lemma lower_coefficient (c : ℝ) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) (j : Fin d) : (finSuccEquiv ℝ n (face c S P)).coeff (j : ℕ) = if j ∈ S then P j else 0 := by rw [finSuccEquiv_face, Polynomial.coeff_add, Polynomial.finsetSum_coeff] simp only [Polynomial.coeff_C_mul_X_pow, ne_of_lt j.isLt, ↓reduceIte, zero_add] convert Finset.sum_ite_eq S j P using 1 apply Finset.sum_congr rfl intro k hk simp only [Fin.ext_iff] lemma ne_pure_normal_power (c : ℝ) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) (j : Fin d) (hj : j ∈ S) (hP : P j ≠ 0) : face c S P ≠ C c * (X 0)^d := by intro he have hc := congrArg (fun N : MvPolynomial (Fin (n + 1)) ℝ ↦ (finSuccEquiv ℝ n N).coeff (j : ℕ)) he rw [lower_coefficient, ite_eq_left hj] at hc simp only [map_mul, map_pow, finSuccEquiv_C_scalar, finSuccEquiv_X_zero, Polynomial.coeff_C_mul_X_pow, ne_of_lt j.isLt, ↓reduceIte] at hc exact hP hc lemma pderiv_zero_rename_succ (P : MvPolynomial (Fin n) ℝ) : pderiv 0 (rename Fin.succ P) = 0 := by induction P using MvPolynomial.induction_on with | C c => simp | add P Q hP hQ => simp only [map_add, hP, hQ, add_zero] | mul_X P i hP => simp only [map_mul, rename_X, pderiv_mul, hP, zero_mul, pderiv_X_of_ne (Fin.succ_ne_zero i), mul_zero, add_zero] lemma normal_term_euler (P : MvPolynomial (Fin n) ℝ) (j : ℕ) : X 0 * pderiv 0 (rename Fin.succ P * (X 0)^j) = C (j : ℝ) * (rename Fin.succ P * (X 0)^j) := by rw [pderiv_mul, pderiv_zero_rename_succ, zero_mul, zero_add, pderiv_pow, pderiv_X_self, mul_one] cases j with | zero => simp | succ j => simp only [Nat.add_sub_cancel, map_natCast, pow_succ]; ring lemma tangential_term_euler (P : MvPolynomial (Fin n) ℝ) (j v : ℕ) (hP : P.IsHomogeneous v) : (∑ i : Fin n, X i.succ * pderiv i.succ (rename Fin.succ P * (X 0)^j)) = C (v : ℝ) * (rename Fin.succ P * (X 0)^j) := by have he := congrArg (rename Fin.succ) (QuarticCompatibility.sum_X_mul_pderiv hP) simp only [map_sum, map_mul, rename_X, nsmul_eq_mul] at he simp only [pderiv_mul, pderiv_pow, pderiv_X_of_ne (Fin.succ_ne_zero _).symm, mul_zero, add_zero, pderiv_rename (Fin.succ_injective n)] calc _ = (∑ i : Fin n, X i.succ * rename Fin.succ (pderiv i P)) * (X 0)^j := by rw [Finset.sum_mul] apply Finset.sum_congr rfl intro i hi ring _ = _ := by rw [he]; simp only [map_natCast]; ring lemma term_weightedEuler (P : MvPolynomial (Fin n) ℝ) (j v : ℕ) (hP : P.IsHomogeneous v) (α D : ℝ) (hw : α * j + v = D) : WeightedEuler (rename Fin.succ P * (X 0)^j) α D := by unfold WeightedEuler rw [mul_assoc, normal_term_euler, tangential_term_euler P j v hP] rw [← mul_assoc, ← map_mul, ← add_mul, ← map_add, hw] lemma WeightedEuler_add (P Q : MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hP : WeightedEuler P α D) (hQ : WeightedEuler Q α D) : WeightedEuler (P + Q) α D := by unfold WeightedEuler at * simp only [map_add, mul_add, Finset.sum_add_distrib] linear_combination hP + hQ lemma WeightedEuler_sum {ι : Type*} (S : Finset ι) (P : ι → MvPolynomial (Fin (n + 1)) ℝ) (α D : ℝ) (hP : ∀ j ∈ S, WeightedEuler (P j) α D) : WeightedEuler (∑ j ∈ S, P j) α D := by classical induction S using Finset.induction_on with | empty => simp only [Finset.sum_empty, WeightedEuler, map_zero, mul_zero, Finset.sum_const_zero, add_zero] | @insert j S hj ih => rw [Finset.sum_insert hj] apply WeightedEuler_add _ _ α D (hP j (Finset.mem_insert_self j S)) exact ih (fun k hk ↦ hP k (Finset.mem_insert_of_mem hk)) /-- Weighted Euler is inherited from each selected tangential homogeneous coefficient. -/ theorem weightedEuler (c : ℝ) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) (v : Fin d → ℕ) (α : ℝ) (hP : ∀ j ∈ S, (P j).IsHomogeneous (v j)) (hw : ∀ j ∈ S, (v j : ℝ) = α * ((d : ℝ) - (j : ℕ))) : WeightedEuler (face c S P) α (α * d) := by unfold face apply WeightedEuler_add · have hc : (C c : MvPolynomial (Fin n) ℝ).IsHomogeneous 0 := isHomogeneous_C _ _ simpa only [rename_C] using term_weightedEuler (C c) d 0 hc α (α * d) (by ring) · apply WeightedEuler_sum intro j hj apply term_weightedEuler (P j) (j : ℕ) (v j) (hP j hj) rw [hw j hj] ring end end Source29NewtonWeightedFace /- Component: NewtonFaceSelection.inc -/ namespace Source29NewtonFaceSelection open MvPolynomial open Source29NewtonNormalDerivative Source29NewtonWeightedFace open scoped BigOperators noncomputable section variable {n d : ℕ} /-- The first nontrivial Newton slope is attained in a finite coefficient family. -/ theorem exists_minimum_ratio (S : Finset (Fin d)) (hS : S.Nonempty) (v : Fin d → ℕ) (hv : ∀ j ∈ S, d - (j : ℕ) < v j) : ∃ α : ℝ, 1 < α ∧ (∀ j ∈ S, α * ((d : ℝ) - (j : ℕ)) ≤ v j) ∧ ∃ j ∈ S, (v j : ℝ) = α * ((d : ℝ) - (j : ℕ)) := by let q : Fin d → ℝ := fun j ↦ (v j : ℝ) / ((d : ℝ) - (j : ℕ)) obtain ⟨j, hj, hmin⟩ := S.exists_min_image q hS have hden : ∀ k : Fin d, 0 < (d : ℝ) - (k : ℕ) := by intro k exact sub_pos.mpr (by exact_mod_cast k.isLt) have hlarge : (d : ℝ) - (j : ℕ) < (v j : ℝ) := by have hc : ((d - (j : ℕ) : ℕ) : ℝ) < (v j : ℝ) := by exact_mod_cast hv j hj simpa only [Nat.cast_sub j.isLt.le] using hc refine ⟨q j, ?_, ?_, j, hj, ?_⟩ · exact (one_lt_div (hden j)).2 hlarge · intro k hk exact (le_div_iff₀ (hden k)).1 (hmin k hk) · exact (div_mul_cancel₀ (v j : ℝ) (hden j).ne').symm /-- Select precisely the nonzero initial coefficients lying on the first face. The other nonzero coefficient orders lie on or above it. -/ theorem exists_selected_face (P : Fin d → MvPolynomial (Fin n) ℝ) (v : Fin d → ℕ) (hne : ∃ j, P j ≠ 0) (hv : ∀ j, P j ≠ 0 → d - (j : ℕ) < v j) : ∃ (α : ℝ) (S : Finset (Fin d)), 1 < α ∧ (∀ j, P j ≠ 0 → α * ((d : ℝ) - (j : ℕ)) ≤ v j) ∧ (∀ j, j ∈ S ↔ P j ≠ 0 ∧ (v j : ℝ) = α * ((d : ℝ) - (j : ℕ))) ∧ S.Nonempty := by classical let T : Finset (Fin d) := Finset.univ.filter fun j ↦ P j ≠ 0 have hT : T.Nonempty := by obtain ⟨j, hj⟩ := hne exact ⟨j, by simp only [T, Finset.mem_filter, Finset.mem_univ, true_and]; exact hj⟩ obtain ⟨α, hα, hlow, j, hj, heq⟩ := exists_minimum_ratio T hT v (by intro k hk exact hv k (Finset.mem_filter.mp hk).2) let S : Finset (Fin d) := T.filter fun j ↦ (v j : ℝ) = α * ((d : ℝ) - (j : ℕ)) refine ⟨α, S, hα, ?_, ?_, j, ?_⟩ · intro k hk exact hlow k (by simp only [T, Finset.mem_filter, Finset.mem_univ, true_and]; exact hk) · intro k simp only [S, T, Finset.mem_filter, Finset.mem_univ, true_and] · exact Finset.mem_filter.mpr ⟨hj, heq⟩ /-- A selected nonzero coefficient contradicts the Newton equation and the two normal half-space signs, by the proved polynomial rigidity theorem. -/ theorem selected_face_contradiction (c : ℝ) (hc : c ≠ 0) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) (v : Fin d → ℕ) (α : ℝ) (hα : 0 < α) (hP : ∀ j ∈ S, (P j).IsHomogeneous (v j)) (hw : ∀ j ∈ S, (v j : ℝ) = α * ((d : ℝ) - (j : ℕ))) (j : Fin d) (hj : j ∈ S) (hne : P j ≠ 0) (hE : newtonResidual (face c S P) = 0) (hpos : ∀ z : Fin (n + 1) → ℝ, 0 < z 0 → 0 ≤ eval z (face c S P)) (hneg : ∀ z : Fin (n + 1) → ℝ, z 0 < 0 → eval z (face c S P) ≤ 0) : False := by have hd : 0 < d := lt_of_le_of_lt (Nat.zero_le (j : ℕ)) j.isLt have hD : 0 < α * (d : ℝ) := mul_pos hα (by exact_mod_cast hd) apply ne_pure_normal_power c S P j hj hne exact Source29NewtonPolynomialRigidity.eq_pure_normal_power (face c S P) α (α * d) hD (weightedEuler c S P v α hP hw) hE hpos hneg d hd c hc (top_coefficient c S P) end end Source29NewtonFaceSelection /- Component: NewtonFiniteRescaling.inc -/ namespace Source29NewtonFiniteRescaling open Filter open scoped BigOperators Topology noncomputable section /-- A fixed bounded multiplier preserves real uniform convergence. No bound on the limiting function is required. -/ lemma uniform_mul_bounded {ι A : Type*} {l : Filter ι} {K : Set A} {F : ι → A → ℝ} {f g : A → ℝ} (hF : TendstoUniformlyOn F f l K) (B : ℝ) (hB : 0 ≤ B) (hg : ∀ x ∈ K, |g x| ≤ B) : TendstoUniformlyOn (fun t x ↦ F t x * g x) (fun x ↦ f x * g x) l K := by rw [Metric.tendstoUniformlyOn_iff] at hF ⊢ intro ε hε have hBp : 0 < B + 1 := by linarith filter_upwards [hF (ε / (B + 1)) (div_pos hε hBp)] with t ht x hx calc dist (f x * g x) (F t x * g x) = dist (f x) (F t x) * |g x| := by simp only [Real.dist_eq, ← sub_mul, abs_mul] _ ≤ dist (f x) (F t x) * (B + 1) := mul_le_mul_of_nonneg_left (le_trans (hg x hx) (by linarith)) dist_nonneg _ < (ε / (B + 1)) * (B + 1) := mul_lt_mul_of_pos_right (ht x hx) hBp _ = ε := div_mul_cancel₀ ε hBp.ne' lemma uniform_finite_sum {ι J A : Type*} {l : Filter ι} {K : Set A} (S : Finset J) (F : J → ι → A → ℝ) (f : J → A → ℝ) (hF : ∀ j ∈ S, TendstoUniformlyOn (F j) (f j) l K) : TendstoUniformlyOn (fun t x ↦ ∑ j ∈ S, F j t x) (fun x ↦ ∑ j ∈ S, f j x) l K := by classical induction S using Finset.induction_on with | empty => rw [Metric.tendstoUniformlyOn_iff] intro ε hε filter_upwards [] with t x hx simpa only [Finset.sum_empty, dist_self] using hε | @insert j S hj ih => have h1 := hF j (Finset.mem_insert_self j S) have h2 := ih (fun k hk ↦ hF k (Finset.mem_insert_of_mem hk)) have h := h1.add h2 change TendstoUniformlyOn (fun t x ↦ F j t x + ∑ k ∈ S, F k t x) (fun x ↦ f j x + ∑ k ∈ S, f k x) l K at h simpa only [Finset.sum_insert hj] using h /-- A finite expansion in the normal variable, with arbitrary tangential coefficients. -/ def expansion {J : Type*} {A : Type*} (S : Finset J) (degree : J → ℕ) (a : J → A → ℝ) (x : ℝ) (y : A) : ℝ := ∑ j ∈ S, a j y * x^(degree j) lemma scaled_term (a x ε α D : ℝ) (j : ℕ) (hε : 0 < ε) : (a * (ε ^ α * x)^j) / ε ^ D = (ε ^ (α * (j : ℝ) - D) * a) * x^j := by rw [mul_pow, ← Real.rpow_mul_natCast hε.le, Real.rpow_sub hε] ring /-- Exact algebra behind the coefficient-by-coefficient Newton scaling. -/ lemma scaled_expansion {J A : Type*} (S : Finset J) (degree : J → ℕ) (a : J → A → ℝ) (x ε α D : ℝ) (y : A) (hε : 0 < ε) : expansion S degree a (ε ^ α * x) y / ε ^ D = ∑ j ∈ S, (ε ^ (α * (degree j : ℝ) - D) * a j y) * x^(degree j) := by unfold expansion rw [Finset.sum_div] apply Finset.sum_congr rfl intro j hj exact scaled_term _ _ _ _ _ _ hε /-- Uniform limits of the scaled coefficient functions assemble into the uniform Newton limit on every bounded set of normal coordinates. The index set may contain arbitrary higher normal degrees, whose limiting coefficient can be set to zero. -/ theorem expansion_uniform_limit {J : Type*} {n : ℕ} (S : Finset J) (degree : J → ℕ) (a b : J → (Fin n → ℝ) → ℝ) (α D R : ℝ) (hR : 0 ≤ R) (K : Set (Fin n → ℝ)) (ha : ∀ j ∈ S, TendstoUniformlyOn (fun ε y ↦ ε ^ (α * (degree j : ℝ) - D) * a j (ε • y)) (b j) (𝓝[>] (0 : ℝ)) K) : TendstoUniformlyOn (fun (ε : ℝ) (z : ℝ × (Fin n → ℝ)) ↦ expansion S degree a (ε ^ α * z.1) (ε • z.2) / ε ^ D) (fun z ↦ expansion S degree b z.1 z.2) (𝓝[>] (0 : ℝ)) ({x : ℝ | |x| ≤ R} ×ˢ K) := by have hterm : ∀ j ∈ S, TendstoUniformlyOn (fun (ε : ℝ) (z : ℝ × (Fin n → ℝ)) ↦ (ε ^ (α * (degree j : ℝ) - D) * a j (ε • z.2)) * z.1^(degree j)) (fun z ↦ b j z.2 * z.1^(degree j)) (𝓝[>] (0 : ℝ)) ({x : ℝ | |x| ≤ R} ×ˢ K) := by intro j hj have hcomp := ((ha j hj).comp (fun z : ℝ × (Fin n → ℝ) ↦ z.2)).mono (show ({x : ℝ | |x| ≤ R} ×ˢ K) ⊆ (fun z : ℝ × (Fin n → ℝ) ↦ z.2) ⁻¹' K from fun z hz ↦ hz.2) apply uniform_mul_bounded hcomp (R^(degree j)) (pow_nonneg hR _) intro z hz rw [abs_pow] exact pow_le_pow_left₀ (abs_nonneg _) hz.1 _ have hsum := uniform_finite_sum S _ _ hterm apply hsum.congr filter_upwards [self_mem_nhdsWithin] with ε hε z hz exact (scaled_expansion S degree a z.1 ε α D (ε • z.2) hε).symm /-- Identify the source and limit of a finite normal expansion with named functions. -/ theorem function_uniform_limit {J : Type*} {n : ℕ} (S : Finset J) (degree : J → ℕ) (a b : J → (Fin n → ℝ) → ℝ) (f g : ℝ → (Fin n → ℝ) → ℝ) (hf : ∀ x y, f x y = expansion S degree a x y) (hg : ∀ x y, g x y = expansion S degree b x y) (α D R : ℝ) (hR : 0 ≤ R) (K : Set (Fin n → ℝ)) (ha : ∀ j ∈ S, TendstoUniformlyOn (fun ε y ↦ ε ^ (α * (degree j : ℝ) - D) * a j (ε • y)) (b j) (𝓝[>] (0 : ℝ)) K) : TendstoUniformlyOn (fun (ε : ℝ) (z : ℝ × (Fin n → ℝ)) ↦ f (ε ^ α * z.1) (ε • z.2) / ε ^ D) (fun z ↦ g z.1 z.2) (𝓝[>] (0 : ℝ)) ({x : ℝ | |x| ≤ R} ×ˢ K) := by have h := expansion_uniform_limit S degree a b α D R hR K ha have hf' : f = fun x y ↦ expansion S degree a x y := by funext x y exact hf x y have hg' : g = fun x y ↦ expansion S degree b x y := by funext x y exact hg x y rw [hf', hg'] exact h end end Source29NewtonFiniteRescaling /- Component: NewtonShiftedExpansion.inc -/ namespace Source29NewtonShiftedExpansion open MvPolynomial Filter open Source29NewtonNormalDerivative Source29NewtonShiftedFactorCoefficient open Source29NewtonFiniteRescaling open scoped BigOperators Topology noncomputable section variable {n : ℕ} lemma shiftedSlice_natDegree_le (F : MvPolynomial (Fin (n + 1)) ℝ) (s : ℝ) (y : Fin n → ℝ) : (shiftedSlice F s y).natDegree ≤ (finSuccEquiv ℝ n F).natDegree := by rw [shiftedSlice, Polynomial.natDegree_taylor] change ((finSuccEquiv ℝ n F).map (eval y)).natDegree ≤ _ exact Polynomial.natDegree_map_le /-- The normal expansion remains finite after any tangentially dependent normal shift; no regularity of the shift is needed for this identity. -/ theorem shifted_finite_expansion (F : MvPolynomial (Fin (n + 1)) ℝ) (g : (Fin n → ℝ) → ℝ) (m : ℕ) (hm : (finSuccEquiv ℝ n F).natDegree < m) (x : ℝ) (y : Fin n → ℝ) : eval (Fin.cons (g y + x) y) F = expansion (Finset.range m) id (fun j y ↦ (shiftedSlice F (g y) y).coeff j) x y := by rw [← eval_shiftedSlice] exact Polynomial.eval_eq_sum_range' (lt_of_le_of_lt (shiftedSlice_natDegree_le F (g y) y) hm) x lemma slice_coefficient (F : MvPolynomial (Fin (n + 1)) ℝ) (y : Fin n → ℝ) (j : ℕ) : (sliceHom y F).coeff j = eval y ((finSuccEquiv ℝ n F).coeff j) := by change ((finSuccEquiv ℝ n F).map (eval y)).coeff j = _ exact Polynomial.coeff_map (eval y) j /-- An ordinary polynomial target has the same finite expansion with its normal coefficients evaluated in the tangential variables. -/ theorem polynomial_finite_expansion (N : MvPolynomial (Fin (n + 1)) ℝ) (m : ℕ) (hm : (finSuccEquiv ℝ n N).natDegree < m) (x : ℝ) (y : Fin n → ℝ) : eval (Fin.cons x y) N = expansion (Finset.range m) id (fun j y ↦ eval y ((finSuccEquiv ℝ n N).coeff j)) x y := by rw [← eval_sliceHom] have hdeg : (sliceHom y N).natDegree < m := by apply lt_of_le_of_lt _ hm change ((finSuccEquiv ℝ n N).map (eval y)).natDegree ≤ _ exact Polynomial.natDegree_map_le rw [Polynomial.eval_eq_sum_range' hdeg] simp only [expansion, id_eq, slice_coefficient] /-- Once every scaled normal coefficient has its stated uniform limit, the actual shifted polynomial converges to the claimed Newton polynomial. The finite range includes all normal degrees of both polynomials. -/ theorem shifted_polynomial_uniform_limit (F N : MvPolynomial (Fin (n + 1)) ℝ) (g : (Fin n → ℝ) → ℝ) (m : ℕ) (hF : (finSuccEquiv ℝ n F).natDegree < m) (hN : (finSuccEquiv ℝ n N).natDegree < m) (α D R : ℝ) (hR : 0 ≤ R) (K : Set (Fin n → ℝ)) (ha : ∀ j < m, TendstoUniformlyOn (fun ε y ↦ ε ^ (α * (j : ℝ) - D) * (shiftedSlice F (g (ε • y)) (ε • y)).coeff j) (fun y ↦ eval y ((finSuccEquiv ℝ n N).coeff j)) (𝓝[>] (0 : ℝ)) K) : TendstoUniformlyOn (fun (ε : ℝ) (z : ℝ × (Fin n → ℝ)) ↦ eval (Fin.cons (g (ε • z.2) + ε ^ α * z.1) (ε • z.2)) F / ε ^ D) (fun z ↦ eval (Fin.cons z.1 z.2) N) (𝓝[>] (0 : ℝ)) ({x : ℝ | |x| ≤ R} ×ˢ K) := by apply function_uniform_limit (Finset.range m) id (fun j y ↦ (shiftedSlice F (g y) y).coeff j) (fun j y ↦ eval y ((finSuccEquiv ℝ n N).coeff j)) (fun x y ↦ eval (Fin.cons (g y + x) y) F) (fun x y ↦ eval (Fin.cons x y) N) (shifted_finite_expansion F g m hF) (polynomial_finite_expansion N m hN) α D R hR K intro j hj exact ha j (Finset.mem_range.mp hj) end end Source29NewtonShiftedExpansion /- Component: NewtonCoefficientAnalytic.inc -/ namespace Source29NewtonCoefficientAnalytic open MvPolynomial Filter open Source29NewtonNormalDerivative Source29NewtonShiftedFactorCoefficient open scoped Topology noncomputable section variable {n : ℕ} /-- The normal Hasse derivative is again a multivariate polynomial. -/ def normalHasse (F : MvPolynomial (Fin (n + 1)) ℝ) (j : ℕ) : MvPolynomial (Fin (n + 1)) ℝ := (finSuccEquiv ℝ n).symm (Polynomial.hasseDeriv j (finSuccEquiv ℝ n F)) lemma slice_normalHasse (F : MvPolynomial (Fin (n + 1)) ℝ) (j : ℕ) (y : Fin n → ℝ) : sliceHom y (normalHasse F j) = Polynomial.hasseDeriv j (sliceHom y F) := by change (finSuccEquiv ℝ n ((finSuccEquiv ℝ n).symm _)).map (eval y) = Polynomial.hasseDeriv j ((finSuccEquiv ℝ n F).map (eval y)) rw [AlgEquiv.apply_symm_apply, Polynomial.hasseDeriv_map] /-- Every shifted normal coefficient is evaluation of a fixed polynomial along the shifted graph. -/ theorem shifted_coefficient_eq (F : MvPolynomial (Fin (n + 1)) ℝ) (j : ℕ) (s : ℝ) (y : Fin n → ℝ) : (shiftedSlice F s y).coeff j = eval (Fin.cons s y) (normalHasse F j) := by rw [shiftedSlice, Polynomial.taylor_coeff, ← slice_normalHasse, eval_sliceHom] /-- All normal coefficients are analytic whenever the normal shift is analytic. -/ theorem analyticAt_shifted_coefficient (F : MvPolynomial (Fin (n + 1)) ℝ) (j : ℕ) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) : AnalyticAt ℝ (fun y ↦ (shiftedSlice F (g y) y).coeff j) a := by have hgraph : AnalyticAt ℝ (fun y : Fin n → ℝ ↦ (Fin.cons (g y) y : Fin (n + 1) → ℝ)) a := by apply AnalyticAt.pi intro i exact Fin.cases hg (fun k ↦ (ContinuousLinearMap.proj k : (Fin n → ℝ) →L[ℝ] ℝ).analyticAt a) i have h := (Source29PolynomialLinkChart.analyticAt_eval_real (normalHasse F j) _).comp hgraph simpa only [shifted_coefficient_eq, Function.comp_def] using h /-- Every nonzero shifted coefficient germ has a nonzero homogeneous initial polynomial, without a factorization or a designated multiplicity index. -/ theorem exists_shifted_coefficient_initial_term (F : MvPolynomial (Fin (n + 1)) ℝ) (j : ℕ) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) (hne : ¬ ∀ᶠ y in 𝓝 a, (shiftedSlice F (g y) y).coeff j = 0) : ∃ (p : FormalMultilinearSeries ℝ (Fin n → ℝ) ℝ) (d : ℕ) (H : MvPolynomial (Fin n) ℝ), HasFPowerSeriesAt (fun y ↦ (shiftedSlice F (g y) y).coeff j) p a ∧ H ≠ 0 ∧ H.IsHomogeneous d ∧ (∀ x, eval x H = p d (fun _ ↦ x)) ∧ (∀ k < d, ∀ x, p k (fun _ ↦ x) = 0) := Source29AnalyticInitialPolynomial.exists_homogeneous_initial_term (analyticAt_shifted_coefficient F j g a hg) hne end end Source29NewtonCoefficientAnalytic /- Component: NewtonInitialDataLimit.inc -/ namespace Source29NewtonInitialDataLimit open MvPolynomial Filter open Source29NewtonShiftedFactorCoefficient Source29NewtonShiftedExpansion open scoped Topology noncomputable section variable {n : ℕ} /-- Explicit Taylor data sufficient for a prescribed coefficient limit. A zero germ permits arbitrary weights; otherwise the target is the initial polynomial exactly at its order, and zero below that order. -/ def CoefficientData (f : (Fin n → ℝ) → ℝ) (β : ℝ) (Q : MvPolynomial (Fin n) ℝ) : Prop := ((∀ᶠ y in 𝓝 0, f y = 0) ∧ Q = 0) ∨ ∃ (p : FormalMultilinearSeries ℝ (Fin n → ℝ) ℝ) (v : ℕ) (H : MvPolynomial (Fin n) ℝ), HasFPowerSeriesAt f p 0 ∧ (∀ y, eval y H = p v (fun _ ↦ y)) ∧ (∀ k < v, ∀ y, p k (fun _ ↦ y) = 0) ∧ β ≤ (v : ℝ) ∧ Q = if β = (v : ℝ) then H else 0 /-- Every analytic coefficient disappears at a strictly negative weight. -/ theorem data_of_negative_weight {f : (Fin n → ℝ) → ℝ} (hf : AnalyticAt ℝ f 0) (β : ℝ) (hβ : β < 0) : CoefficientData f β 0 := by obtain ⟨p, hp⟩ := hf refine Or.inr ⟨p, 0, Source29MultilinearDiagonalPolynomial.diagonalPolynomial (p 0), hp, Source29MultilinearDiagonalPolynomial.eval_diagonalPolynomial (p 0), ?_, ?_, ?_⟩ · intro k hk omega · simpa only [Nat.cast_zero] using hβ.le · simp only [Nat.cast_zero, ne_of_lt hβ, ite_false] /-- At weight zero, an analytic coefficient limits to its value at the center. -/ theorem data_at_zero_weight {f : (Fin n → ℝ) → ℝ} (hf : AnalyticAt ℝ f 0) : CoefficientData f 0 (C (f 0)) := by obtain ⟨p, hp⟩ := hf refine Or.inr ⟨p, 0, C (f 0), hp, ?_, ?_, by simp, by simp⟩ · intro y rw [eval_C] exact (hp.coeff_zero _).symm · intro k hk omega /-- Taylor data give the required weighted coefficient limit on every bounded tangential set. -/ theorem coefficient_uniform_limit {f : (Fin n → ℝ) → ℝ} (β : ℝ) (Q : MvPolynomial (Fin n) ℝ) (hdata : CoefficientData f β Q) (K : Set (Fin n → ℝ)) (hK : Bornology.IsBounded K) : TendstoUniformlyOn (fun (ε : ℝ) y ↦ ε ^ (-β) * f (ε • y)) (fun y ↦ eval y Q) (𝓝[>] (0 : ℝ)) K := by rcases hdata with ⟨hz, hQ⟩ | ⟨p, v, H, hp, hH, hlow, hβ, hQ⟩ · have ht := Source29WeightedInitialScaling.zero_germ_tendstoUniformlyOn hz K hK (fun ε : ℝ ↦ ε^(-β)) simpa only [zero_add, smul_eq_mul, hQ, map_zero] using ht · have ht := Source29WeightedInitialScaling.at_or_below_order_tendstoUniformlyOn hp v hlow β hβ K hK simpa only [zero_add, smul_eq_mul, hQ, apply_ite, hH, map_zero] using ht /-- The finite shifted-polynomial limit follows directly from its initial Taylor data, including coefficients with zero germs and higher normal degree. -/ theorem shifted_uniform_limit_of_initial_data (F N : MvPolynomial (Fin (n + 1)) ℝ) (g : (Fin n → ℝ) → ℝ) (m : ℕ) (hF : (finSuccEquiv ℝ n F).natDegree < m) (hN : (finSuccEquiv ℝ n N).natDegree < m) (α D R : ℝ) (hR : 0 ≤ R) (K : Set (Fin n → ℝ)) (hK : Bornology.IsBounded K) (hdata : ∀ j < m, CoefficientData (fun y ↦ (shiftedSlice F (g y) y).coeff j) (D - α * (j : ℝ)) ((finSuccEquiv ℝ n N).coeff j)) : TendstoUniformlyOn (fun (ε : ℝ) (z : ℝ × (Fin n → ℝ)) ↦ eval (Fin.cons (g (ε • z.2) + ε ^ α * z.1) (ε • z.2)) F / ε ^ D) (fun z ↦ eval (Fin.cons z.1 z.2) N) (𝓝[>] (0 : ℝ)) ({x : ℝ | |x| ≤ R} ×ˢ K) := by apply shifted_polynomial_uniform_limit F N g m hF hN α D R hR K intro j hj have ht := coefficient_uniform_limit (D - α * (j : ℝ)) ((finSuccEquiv ℝ n N).coeff j) (hdata j hj) K hK have he : -(D - α * (j : ℝ)) = α * (j : ℝ) - D := by ring simpa only [he] using ht end end Source29NewtonInitialDataLimit /- Component: NewtonFaceCoefficientData.inc -/ namespace Source29NewtonFaceCoefficientData open MvPolynomial Filter open Source29NewtonWeightedFace Source29NewtonShiftedFactorCoefficient open Source29NewtonInitialDataLimit open scoped Topology noncomputable section variable {n d : ℕ} /-- Higher normal coefficients have negative weights and vanish automatically. -/ theorem data_above_face (F : MvPolynomial (Fin (n + 1)) ℝ) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (c : ℝ) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) (α : ℝ) (hα : 0 < α) (j : ℕ) (hj : d < j) : CoefficientData (fun y ↦ (shiftedSlice F (g y) y).coeff j) (α * (d : ℝ) - α * j) ((finSuccEquiv ℝ n (face c S P)).coeff j) := by rw [coefficient_above c S P j hj] apply data_of_negative_weight (Source29NewtonCoefficientAnalytic.analyticAt_shifted_coefficient F j g 0 hg) have hcast : (d : ℝ) < (j : ℝ) := by exact_mod_cast hj nlinarith /-- The top face coefficient is the center value of the corresponding analytic shifted coefficient. -/ theorem data_at_face_top (F : MvPolynomial (Fin (n + 1)) ℝ) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (c : ℝ) (hc : (shiftedSlice F (g 0) 0).coeff d = c) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) (α : ℝ) : CoefficientData (fun y ↦ (shiftedSlice F (g y) y).coeff d) (α * (d : ℝ) - α * d) ((finSuccEquiv ℝ n (face c S P)).coeff d) := by rw [sub_self, top_coefficient] have ht := data_at_zero_weight (Source29NewtonCoefficientAnalytic.analyticAt_shifted_coefficient F d g 0 hg) simpa only [hc] using ht /-- Only the lower normal coefficients require nontrivial initial-order information: analyticity handles the top and all higher coefficients. -/ theorem shifted_face_uniform_limit (F : MvPolynomial (Fin (n + 1)) ℝ) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (c : ℝ) (hc : (shiftedSlice F (g 0) 0).coeff d = c) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) (α : ℝ) (hα : 0 < α) (m : ℕ) (hm : d < m) (hF : (finSuccEquiv ℝ n F).natDegree < m) (hdata : ∀ j : Fin d, CoefficientData (fun y ↦ (shiftedSlice F (g y) y).coeff (j : ℕ)) (α * (d : ℝ) - α * (j : ℕ)) (if j ∈ S then P j else 0)) (R : ℝ) (hR : 0 ≤ R) (K : Set (Fin n → ℝ)) (hK : Bornology.IsBounded K) : TendstoUniformlyOn (fun (ε : ℝ) (z : ℝ × (Fin n → ℝ)) ↦ eval (Fin.cons (g (ε • z.2) + ε ^ α * z.1) (ε • z.2)) F / ε ^ (α * d)) (fun z ↦ eval (Fin.cons z.1 z.2) (face c S P)) (𝓝[>] (0 : ℝ)) ({x : ℝ | |x| ≤ R} ×ˢ K) := by apply shifted_uniform_limit_of_initial_data F (face c S P) g m hF (lt_of_le_of_lt (normal_degree_le c S P) hm) α (α * d) R hR K hK intro j hj rcases lt_trichotomy j d with hlt | heq | hgt · have hd := hdata ⟨j, hlt⟩ rw [lower_coefficient c S P ⟨j, hlt⟩] exact hd · subst j exact data_at_face_top F g hg c hc S P α · exact data_above_face F g hg c S P α hα j hgt end end Source29NewtonFaceCoefficientData /- Component: NewtonShiftedLocalSigns.inc -/ namespace Source29NewtonShiftedLocalSigns open MvPolynomial Filter open Source29NewtonNormalDerivative Source29NewtonShiftedFactorCoefficient open Source29NewtonShiftedExpansion Source29NewtonCoefficientAnalytic open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- Remove the constant normal coefficient and divide by the normal variable. -/ def quotient (P : MvPolynomial (Fin (n + 1)) ℝ) (g : (Fin n → ℝ) → ℝ) (z : ℝ × (Fin n → ℝ)) : ℝ := ((shiftedSlice P (g z.2) z.2).divX).eval z.1 lemma shifted_eval_eq (P : MvPolynomial (Fin (n + 1)) ℝ) (g : (Fin n → ℝ) → ℝ) (z : ℝ × (Fin n → ℝ)) : eval (Fin.cons (g z.2 + z.1) z.2) P = z.1 * quotient P g z + eval (Fin.cons (g z.2) z.2) P := by have h := congrArg (fun q : Polynomial ℝ ↦ q.eval z.1) (Polynomial.X_mul_divX_add (shiftedSlice P (g z.2) z.2)) simpa only [Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_X, Polynomial.eval_C, shiftedSlice_coeff_zero, eval_shiftedSlice, quotient] using h.symm lemma quotient_at_zero (P : MvPolynomial (Fin (n + 1)) ℝ) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) : quotient P g (0,a) = eval (Fin.cons (g a) a) (pderiv 0 P) := by change ((shiftedSlice P (g a) a).divX).eval 0 = _ rw [← Polynomial.coeff_zero_eq_eval_zero, Polynomial.coeff_divX, Nat.zero_add, shiftedSlice_coeff_one] /-- The divided polynomial has analytic joint evaluation near every point where the shift is analytic. -/ theorem analyticAt_quotient (P : MvPolynomial (Fin (n + 1)) ℝ) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) (x : ℝ) : AnalyticAt ℝ (quotient P g) (x,a) := by let m := (finSuccEquiv ℝ n P).natDegree + 1 have heq : quotient P g = fun z : ℝ × (Fin n → ℝ) ↦ ∑ j ∈ Finset.range m, (shiftedSlice P (g z.2) z.2).coeff (j+1) * z.1^j := by funext z have hdeg : (shiftedSlice P (g z.2) z.2).divX.natDegree < m := lt_of_le_of_lt (Polynomial.natDegree_divX_le.trans (shiftedSlice_natDegree_le P (g z.2) z.2)) (Nat.lt_succ_self _) simp only [quotient, Polynomial.eval_eq_sum_range' hdeg, Polynomial.coeff_divX] rw [heq] apply Finset.analyticAt_fun_sum intro j hj have hc := (Source29NewtonCoefficientAnalytic.analyticAt_shifted_coefficient P (j+1) g a hg).comp (analyticAt_snd : AnalyticAt ℝ Prod.snd (x,a)) have hx : AnalyticAt ℝ (fun z : ℝ × (Fin n → ℝ) ↦ z.1^j) (x,a) := analyticAt_fst.pow j have h := hc.mul hx change AnalyticAt ℝ (fun z : ℝ × (Fin n → ℝ) ↦ (shiftedSlice P (g z.2) z.2).coeff (j+1) * z.1^j) (x,a) at h exact h /-- A simple positive normal derivative supplies a positive local quotient. -/ theorem eventually_quotient_pos (P : MvPolynomial (Fin (n + 1)) ℝ) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) (hderiv : 0 < eval (Fin.cons (g a) a) (pderiv 0 P)) : ∀ᶠ z in 𝓝 ((0 : ℝ), a), 0 < quotient P g z := by have hq : 0 < quotient P g (0,a) := by rwa [quotient_at_zero] exact (analyticAt_quotient P g a hg 0).continuousAt.tendsto.eventually (isOpen_Ioi.mem_nhds hq) /-- Near a regular branch with positive normal derivative, the polynomial has the strict sign of the shifted normal coordinate. -/ theorem eventually_polynomial_signs (P : MvPolynomial (Fin (n + 1)) ℝ) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0) (hderiv : 0 < eval (Fin.cons (g a) a) (pderiv 0 P)) : ∀ᶠ z in 𝓝 ((0 : ℝ), a), (0 < z.1 → 0 < eval (Fin.cons (g z.2 + z.1) z.2) P) ∧ (z.1 < 0 → eval (Fin.cons (g z.2 + z.1) z.2) P < 0) := by have hr : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 (0,a), eval (Fin.cons (g z.2) z.2) P = 0 := (continuous_snd.tendsto (0,a)).eventually hroot filter_upwards [eventually_quotient_pos P g a hg hderiv, hr] with z hq hz rw [shifted_eval_eq, hz, add_zero] exact ⟨fun hx ↦ mul_pos hx hq, fun hx ↦ mul_neg_of_neg_of_pos hx hq⟩ /-- An odd factor with a nonnegative cofactor gives the weak normal half-space signs required by the weighted-limit argument. -/ theorem factor_halfspace_signs (F P Q : MvPolynomial (Fin (n + 1)) ℝ) (k : ℕ) (hk : Odd k) (hF : F = P^k*Q) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0) (hderiv : 0 < eval (Fin.cons (g a) a) (pderiv 0 P)) (hQ : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 (0,a), 0 ≤ eval (Fin.cons (g z.2 + z.1) z.2) Q) : (∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 (0,a), 0 < z.1 → 0 ≤ eval (Fin.cons (g z.2 + z.1) z.2) F) ∧ (∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 (0,a), z.1 < 0 → eval (Fin.cons (g z.2 + z.1) z.2) F ≤ 0) := by have hs := eventually_polynomial_signs P g a hg hroot hderiv constructor · filter_upwards [hs, hQ] with z hz hq hx rw [hF, map_mul, map_pow] exact mul_nonneg (pow_nonneg (hz.1 hx).le k) hq · filter_upwards [hs, hQ] with z hz hq hx rw [hF, map_mul, map_pow] exact mul_nonpos_of_nonpos_of_nonneg (hk.pow_nonpos (hz.2 hx).le) hq end end Source29NewtonShiftedLocalSigns /- Component: InitialOrderFromScaling.inc -/ namespace Source29InitialOrderFromScaling open Filter open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] /-- If a weighted dilation vanishes and the first Taylor term is nonzero, its Taylor order is strictly greater than that weight. -/ theorem order_gt_of_weighted_limit_zero {f : E → ℝ} {a : E} {p : FormalMultilinearSeries ℝ E ℝ} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hlow : ∀ k < d, ∀ x, p k (fun _ ↦ x) = 0) (hne : ∃ x, p d (fun _ ↦ x) ≠ 0) (β : ℝ) (hzero : ∀ x, Tendsto (fun t : ℝ ↦ t^(-β) * f (a+t•x)) (𝓝[>] 0) (𝓝 0)) : β < (d : ℝ) := by by_contra h have hle : (d : ℝ) ≤ β := le_of_not_gt h obtain ⟨x,hx⟩ := hne have hi := (Source29WeightedInitialScaling.at_order_tendstoUniformlyOn hp d hlow {x} Bornology.isBounded_singleton).tendsto_at (Set.mem_singleton x) have hr : Tendsto (fun t : ℝ ↦ t^(β-(d:ℝ))) (𝓝[>] 0) (𝓝 ((0:ℝ)^(β-(d:ℝ)))) := (Real.continuousAt_rpow_const 0 (β-(d:ℝ)) (Or.inr (sub_nonneg.mpr hle))).tendsto.mono_left nhdsWithin_le_nhds have ht : Tendsto (fun t : ℝ ↦ t^(-(d:ℝ)) * f (a+t•x)) (𝓝[>] 0) (𝓝 0) := by have hh := hr.mul (hzero x) simp only [mul_zero] at hh apply hh.congr' filter_upwards [self_mem_nhdsWithin] with t ht change 0 < t at ht rw [← mul_assoc, ← Real.rpow_add ht] congr 2 ring have he := tendsto_nhds_unique hi ht exact hx he end end Source29InitialOrderFromScaling /- Component: PolynomialCoefficientLimit.inc -/ namespace Source29PolynomialCoefficientLimit open Filter open scoped Topology BigOperators Matrix noncomputable section /-- For a common finite degree bound, convergence at distinct evaluation points implies convergence of every coefficient. -/ theorem tendsto_coefficients_of_evaluations {ι : Type*} {l : Filter ι} {m : ℕ} (v : Fin m → ℝ) (hv : Function.Injective v) (a : ι → Fin m → ℝ) (b : Fin m → ℝ) (h : ∀ i, Tendsto (fun t ↦ ∑ j : Fin m, v i ^ (j:ℕ) * a t j) l (𝓝 (∑ j : Fin m, v i ^ (j:ℕ) * b j))) : Tendsto a l (𝓝 b) := by let M : Matrix (Fin m) (Fin m) ℝ := Matrix.vandermonde v have hd : IsUnit M.det := isUnit_iff_ne_zero.mpr (Matrix.det_vandermonde_ne_zero_iff.mpr hv) have hi : M⁻¹ * M = 1 := Matrix.nonsing_inv_mul M hd have ht : Tendsto (fun t ↦ M⁻¹ *ᵥ (M *ᵥ a t)) l (𝓝 (M⁻¹ *ᵥ (M *ᵥ b))) := by apply tendsto_pi_nhds.mpr intro i change Tendsto (fun t ↦ ∑ j : Fin m, M⁻¹ i j * (∑ k : Fin m, v j ^ (k:ℕ) * a t k)) l (𝓝 (∑ j : Fin m, M⁻¹ i j * (∑ k : Fin m, v j ^ (k:ℕ) * b k))) apply tendsto_finsetSum intro j _ exact (h j).const_mul (M⁻¹ i j) simpa only [Matrix.mulVec_mulVec, hi, Matrix.one_mulVec] using ht /-- Natural-number evaluation points always suffice for a finite coefficient family over the reals. -/ theorem tendsto_coefficients_of_nat_evaluations {ι : Type*} {l : Filter ι} {m : ℕ} (a : ι → Fin m → ℝ) (b : Fin m → ℝ) (h : ∀ i : Fin m, Tendsto (fun t ↦ ∑ j : Fin m, (i:ℝ) ^ (j:ℕ) * a t j) l (𝓝 (∑ j : Fin m, (i:ℝ) ^ (j:ℕ) * b j))) : Tendsto a l (𝓝 b) := by apply tendsto_coefficients_of_evaluations (fun i : Fin m ↦ (i:ℝ)) _ a b h intro i j hij apply Fin.ext change (i.val : ℝ) = (j.val : ℝ) at hij exact Nat.cast_injective hij end end Source29PolynomialCoefficientLimit /- Component: NewtonCoefficientLimitExtraction.inc -/ namespace Source29NewtonCoefficientLimitExtraction open MvPolynomial Filter open Source29NewtonShiftedFactorCoefficient Source29NewtonShiftedExpansion open scoped BigOperators Topology noncomputable section variable {n : ℕ} /-- Pointwise convergence of a finite normal polynomial forces convergence of each rescaled normal coefficient. No regularity of the shift is assumed. -/ theorem coefficient_limit_of_shifted_limit (F N : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (m : ℕ) (hF : (finSuccEquiv ℝ n F).natDegree < m) (hN : (finSuccEquiv ℝ n N).natDegree < m) (D : ℝ) (hlim : ∀ x y, Tendsto (fun t : ℝ ↦ eval (Fin.cons (g (t•y)+t*x) (t•y)) F / t^D) (𝓝[>] 0) (𝓝 (eval (Fin.cons x y) N))) (j : Fin m) (y : Fin n → ℝ) : Tendsto (fun t : ℝ ↦ t^((j:ℕ)-D) * (shiftedSlice F (g (t•y)) (t•y)).coeff j) (𝓝[>] 0) (𝓝 (eval y ((finSuccEquiv ℝ n N).coeff j))) := by let a : ℝ → Fin m → ℝ := fun t j ↦ t^((j:ℕ)-D) * (shiftedSlice F (g (t•y)) (t•y)).coeff j let b : Fin m → ℝ := fun j ↦ eval y ((finSuccEquiv ℝ n N).coeff j) have hs (t x : ℝ) (ht : 0 < t) : (∑ j : Fin m, x^(j:ℕ) * a t j) = eval (Fin.cons (g (t•y)+t*x) (t•y)) F / t^D := by rw [shifted_finite_expansion F g m hF] have he := Source29NewtonFiniteRescaling.scaled_expansion (Finset.range m) id (fun j y ↦ (shiftedSlice F (g y) y).coeff j) x t 1 D (t•y) ht simp only [Real.rpow_one, one_mul, id_eq] at he rw [he, ← Fin.sum_univ_eq_sum_range] apply Finset.sum_congr rfl intro k _ exact mul_comm _ _ have hb (x : ℝ) : (∑ j : Fin m, x^(j:ℕ) * b j) = eval (Fin.cons x y) N := by rw [polynomial_finite_expansion N m hN, Source29NewtonFiniteRescaling.expansion, ← Fin.sum_univ_eq_sum_range] apply Finset.sum_congr rfl intro k _ exact mul_comm _ _ have ht : Tendsto a (𝓝[>] (0:ℝ)) (𝓝 b) := by apply Source29PolynomialCoefficientLimit.tendsto_coefficients_of_nat_evaluations intro i rw [hb] apply (hlim (i:ℝ) y).congr' filter_upwards [self_mem_nhdsWithin] with t ht exact (hs t (i:ℝ) ht).symm exact (tendsto_pi_nhds.mp ht) j /-- A pure ordinary initial limit forces every lower normal coefficient of the shifted polynomial to vanish at its corresponding ordinary weight. -/ theorem lower_coefficient_limit_zero_of_pure_initial (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (d : ℕ) (c : ℝ) (hlim : ∀ x y, Tendsto (fun t : ℝ ↦ eval (Fin.cons (g (t•y)+t*x) (t•y)) F / t^d) (𝓝[>] 0) (𝓝 (c*x^d))) (j : Fin d) (y : Fin n → ℝ) : Tendsto (fun t : ℝ ↦ t^(-((d:ℝ)-(j:ℕ))) * (shiftedSlice F (g (t•y)) (t•y)).coeff (j:ℕ)) (𝓝[>] 0) (𝓝 0) := by classical let N := Source29NewtonWeightedFace.face c (∅ : Finset (Fin d)) (fun _ ↦ (0 : MvPolynomial (Fin n) ℝ)) let m := max (finSuccEquiv ℝ n F).natDegree d + 1 have hF : (finSuccEquiv ℝ n F).natDegree < m := Nat.lt_succ_of_le (le_max_left _ _) have hd : d < m := Nat.lt_succ_of_le (le_max_right _ _) have hN : (finSuccEquiv ℝ n N).natDegree < m := lt_of_le_of_lt (Source29NewtonWeightedFace.normal_degree_le _ _ _) hd have hNval (x : ℝ) (y : Fin n → ℝ) : eval (Fin.cons x y) N = c*x^d := by simp [N, Source29NewtonWeightedFace.face] have ht := coefficient_limit_of_shifted_limit F N g m hF hN d (by intro x y simpa only [Real.rpow_natCast, hNval] using hlim x y) ⟨j, lt_trans j.isLt hd⟩ y have hcoeff : (finSuccEquiv ℝ n N).coeff (j:ℕ) = 0 := by simpa only [N, ite_self] using Source29NewtonWeightedFace.lower_coefficient c (∅ : Finset (Fin d)) (fun _ ↦ (0 : MvPolynomial (Fin n) ℝ)) j have he : -((d:ℝ)-(j:ℕ)) = (j:ℕ)-(d:ℝ) := by ring simpa only [he, hcoeff, map_zero] using ht end end Source29NewtonCoefficientLimitExtraction /- Component: NewtonInitialCenterCoefficient.inc -/ namespace Source29NewtonInitialCenterCoefficient open MvPolynomial Filter open Source29NewtonShiftedFactorCoefficient Source29NewtonWeightedFace open Source29NewtonCoefficientLimitExtraction open scoped Topology noncomputable section variable {n : ℕ} /-- A pure ordinary initial limit fixes the top normal coefficient at the center. This is a finite polynomial consequence and needs no regularity of the tangentially dependent shift. -/ theorem center_coefficient_of_pure_initial (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (d : ℕ) (c : ℝ) (hlim : ∀ x y, Tendsto (fun t : ℝ ↦ eval (Fin.cons (g (t•y)+t*x) (t•y)) F / t^d) (𝓝[>] 0) (𝓝 (c*x^d))) : (shiftedSlice F (g 0) 0).coeff d = c := by let N := face c (∅ : Finset (Fin d)) (fun _ ↦ (0 : MvPolynomial (Fin n) ℝ)) let m := max (finSuccEquiv ℝ n F).natDegree d + 1 have hF : (finSuccEquiv ℝ n F).natDegree < m := Nat.lt_succ_of_le (le_max_left _ _) have hd : d < m := Nat.lt_succ_of_le (le_max_right _ _) have hN : (finSuccEquiv ℝ n N).natDegree < m := lt_of_le_of_lt (normal_degree_le _ _ _) hd have hNval (x : ℝ) (y : Fin n → ℝ) : eval (Fin.cons x y) N = c*x^d := by simp only [N, face, Finset.sum_empty, add_zero, map_mul, map_pow, eval_C, eval_X, Fin.cons_zero] have ht := coefficient_limit_of_shifted_limit F N g m hF hN d (by intro x y simpa only [Real.rpow_natCast, hNval] using hlim x y) ⟨d,hd⟩ 0 have hcoeff : (finSuccEquiv ℝ n N).coeff d = C c := top_coefficient _ _ _ have ht' : Tendsto (fun _t : ℝ ↦ (shiftedSlice F (g 0) 0).coeff d) (𝓝[>] (0 : ℝ)) (𝓝 c) := by simpa only [sub_self, Real.rpow_zero, smul_zero, one_mul, hcoeff, eval_C] using ht exact tendsto_nhds_unique tendsto_const_nhds ht' end end Source29NewtonInitialCenterCoefficient /- Component: NewtonInitialDerivativeLimit.inc -/ namespace Source29NewtonInitialDerivativeLimit open MvPolynomial Filter open Source29NewtonInitialDataLimit open scoped Topology noncomputable section variable {n : ℕ} lemma dilation_tendsto_zero (y : Fin n → ℝ) : Tendsto (fun ε : ℝ => ε • y) (𝓝[>] 0) (𝓝 0) := by have hc : Continuous (fun ε : ℝ => ε • y) := by fun_prop have ht : Tendsto (fun ε : ℝ => ε • y) (𝓝 0) (𝓝 0) := by simpa only [zero_smul] using hc.tendsto (0 : ℝ) exact ht.mono_left nhdsWithin_le_nhds /-- A zero germ remains a zero germ at each fixed rescaled point, even for an arbitrary scalar normalization. -/ lemma eventually_zero_dilation_germ {f : (Fin n → ℝ) → ℝ} (hz : ∀ᶠ z in 𝓝 0, f z = 0) (w : ℝ → ℝ) (y : Fin n → ℝ) : ∀ᶠ ε : ℝ in 𝓝[>] 0, (fun z => w ε * f (ε • z)) =ᶠ[𝓝 y] (fun _ => 0) := by filter_upwards [(dilation_tendsto_zero y).eventually hz.eventually_nhds] with ε hε have hc : Continuous (fun z : Fin n → ℝ => ε • z) := by fun_prop filter_upwards [(hc.tendsto y).eventually hε] with z hz simp only [hz, mul_zero] /-- The weighted coefficient is analytic near each fixed rescaled point for every sufficiently small positive scale. -/ theorem eventually_analyticAt_dilation {f : (Fin n → ℝ) → ℝ} (hf : AnalyticAt ℝ f 0) (β : ℝ) (y : Fin n → ℝ) : ∀ᶠ ε : ℝ in 𝓝[>] 0, AnalyticAt ℝ (fun z => ε^(-β) * f (ε • z)) y := by filter_upwards [(dilation_tendsto_zero y).eventually hf.eventually_analyticAt] with ε hε have hin : AnalyticAt ℝ (fun z : Fin n → ℝ => ε • z) y := by convert! ((analyticAt_id : AnalyticAt ℝ (fun z : Fin n → ℝ => z) y).const_smul (c := ε)) exact analyticAt_const.mul (hε.comp hin) /-- Taylor coefficient data give convergence of the first derivative of the weighted dilation, with no nonzero-germ assumption. -/ theorem coefficient_fderiv_limit {f : (Fin n → ℝ) → ℝ} (β : ℝ) (Q : MvPolynomial (Fin n) ℝ) (hdata : CoefficientData f β Q) (y : Fin n → ℝ) : Tendsto (fun ε : ℝ => fderiv ℝ (fun z => ε^(-β) * f (ε • z)) y) (𝓝[>] 0) (𝓝 (fderiv ℝ (fun z => eval z Q) y)) := by rcases hdata with ⟨hz,hQ⟩ | ⟨p,v,H,hp,hH,hlow,hβ,hQ⟩ · subst Q simp only [map_zero, fderiv_const_apply] apply tendsto_const_nhds.congr' filter_upwards [eventually_zero_dilation_germ hz (fun ε => ε^(-β)) y] with ε hε simpa only [fderiv_const_apply] using hε.fderiv_eq.symm · have hpoly : ∀ z, p.partialSum (v+1) z = eval z H := fun z => (Source29AnalyticInitialRemainder.partialSum_eq_initial p v hlow z).trans (hH z).symm have hhom : ∀ t : ℝ, 0 < t → ∀ z, eval (t • z) H = t^v • eval z H := by intro t _ z rw [hH, hH, Source29AnalyticInitialRemainder.diagonal_smul] have ht := (Source29WeightedAnalyticDerivativeScaling.at_or_below_order_fderiv_tendstoUniformlyOn hp v hpoly hhom β hβ {y} isCompact_singleton).tendsto_at (Set.mem_singleton y) by_cases he : β = (v : ℝ) · have hQ' : Q = H := by simpa only [he, ite_true] using hQ simpa only [hQ', he, ite_true, zero_add, smul_eq_mul] using ht · have hQ' : Q = 0 := by simpa only [he, ite_false] using hQ simpa only [hQ', he, ite_false, zero_add, smul_eq_mul, map_zero, fderiv_const_apply] using ht /-- The corresponding second-derivative limit follows from the second Taylor series and exact chain rule, also for zero germs. -/ theorem coefficient_fderiv_fderiv_limit {f : (Fin n → ℝ) → ℝ} (β : ℝ) (Q : MvPolynomial (Fin n) ℝ) (hdata : CoefficientData f β Q) (y : Fin n → ℝ) : Tendsto (fun ε : ℝ => fderiv ℝ (fderiv ℝ (fun z => ε^(-β) * f (ε • z))) y) (𝓝[>] 0) (𝓝 (fderiv ℝ (fderiv ℝ (fun z => eval z Q)) y)) := by rcases hdata with ⟨hz,hQ⟩ | ⟨p,v,H,hp,hH,hlow,hβ,hQ⟩ · subst Q simp only [map_zero] apply tendsto_const_nhds.congr' filter_upwards [eventually_zero_dilation_germ hz (fun ε => ε^(-β)) y] with ε hε simpa only [fderiv_const, fderiv_const_apply] using hε.fderiv.fderiv_eq.symm · have hpoly : ∀ z, p.partialSum (v+1) z = eval z H := fun z => (Source29AnalyticInitialRemainder.partialSum_eq_initial p v hlow z).trans (hH z).symm have hhom : ∀ t : ℝ, 0 < t → ∀ z, eval (t • z) H = t^v • eval z H := by intro t _ z rw [hH, hH, Source29AnalyticInitialRemainder.diagonal_smul] have ht := (Source29WeightedAnalyticDerivativeScaling.at_or_below_order_fderiv_fderiv_tendstoUniformlyOn hp v hpoly hhom β hβ {y} isCompact_singleton).tendsto_at (Set.mem_singleton y) by_cases he : β = (v : ℝ) · have hQ' : Q = H := by simpa only [he, ite_true] using hQ simpa only [hQ', he, ite_true, zero_add, smul_eq_mul] using ht · have hQ' : Q = 0 := by simpa only [he, ite_false] using hQ have hz2 : fderiv ℝ (fderiv ℝ (fun _z : Fin n → ℝ => (0 : ℝ))) y = 0 := by have hz1 : fderiv ℝ (fun _z : Fin n → ℝ => (0 : ℝ)) = fun _ => 0 := by funext z exact fderiv_const_apply 0 rw [hz1] exact fderiv_const_apply 0 simp only [hQ', map_zero] rw [hz2] simpa only [he, ite_false, zero_add, smul_eq_mul] using ht end end Source29NewtonInitialDerivativeLimit /- Component: NewtonCoefficientSelection.inc -/ namespace Source29NewtonCoefficientSelection open MvPolynomial Filter open Source29NewtonInitialDataLimit open scoped Topology noncomputable section variable {n d : ℕ} /-- A coefficient with a vanishing weighted limit either has a zero germ or has a nonzero homogeneous initial term of strictly larger order. -/ lemma exists_initial_data_of_limit_zero {f : (Fin n → ℝ) → ℝ} (hf : AnalyticAt ℝ f 0) (β : ℝ) (hzero : ∀ y, Tendsto (fun t : ℝ => t^(-β) * f (t • y)) (𝓝[>] 0) (𝓝 0)) : ∃ (v : ℕ) (P : MvPolynomial (Fin n) ℝ), P.IsHomogeneous v ∧ ((P = 0 ∧ ∀ᶠ y in 𝓝 0, f y = 0) ∨ ∃ p : FormalMultilinearSeries ℝ (Fin n → ℝ) ℝ, HasFPowerSeriesAt f p 0 ∧ P ≠ 0 ∧ (∀ y, eval y P = p v (fun _ => y)) ∧ (∀ k < v, ∀ y, p k (fun _ => y) = 0) ∧ β < (v : ℝ)) := by classical by_cases hz : ∀ᶠ y in 𝓝 0, f y = 0 · exact ⟨0, 0, isHomogeneous_zero _ _ _, Or.inl ⟨rfl,hz⟩⟩ · obtain ⟨p,v,hp,hne,hlow⟩ := Source29AnalyticInitialOrder.exists_first_nonzero_diagonal hf hz obtain ⟨P,hP,hhom,heval⟩ := Source29MultilinearDiagonalPolynomial.exists_diagonalPolynomial (p v) hne refine ⟨v,P,hhom,Or.inr ⟨p,hp,hP,heval,hlow,?_⟩⟩ apply Source29InitialOrderFromScaling.order_gt_of_weighted_limit_zero hp v hlow hne β simpa only [zero_add] using hzero /-- Analytic lower coefficients whose ordinary weighted limits vanish select a nonempty Newton face of slope strictly greater than one. Each coefficient comes with the actual Taylor data needed for its weighted limit. -/ theorem exists_selected_coefficient_data (f : Fin d → (Fin n → ℝ) → ℝ) (hf : ∀ j, AnalyticAt ℝ (f j) 0) (hne : ∃ j, ¬ ∀ᶠ y in 𝓝 0, f j y = 0) (hzero : ∀ (j : Fin d) y, Tendsto (fun t : ℝ => t^(-((d : ℝ) - (j : ℕ))) * f j (t • y)) (𝓝[>] 0) (𝓝 0)) : ∃ (α : ℝ) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) (v : Fin d → ℕ), 1 < α ∧ S.Nonempty ∧ (∀ j, (P j).IsHomogeneous (v j)) ∧ (∀ j, P j ≠ 0 → d - (j : ℕ) < v j) ∧ (∀ j, j ∈ S ↔ P j ≠ 0 ∧ (v j : ℝ) = α * ((d : ℝ) - (j : ℕ))) ∧ (∀ j, CoefficientData (f j) (α * ((d : ℝ) - (j : ℕ))) (if j ∈ S then P j else 0)) := by classical choose v P hhom hdata using fun j => exists_initial_data_of_limit_zero (hf j) ((d : ℝ) - (j : ℕ)) (hzero j) have hPne : ∃ j, P j ≠ 0 := by obtain ⟨j,hj⟩ := hne refine ⟨j,?_⟩ rcases hdata j with ⟨_,hz⟩ | ⟨p,hp,hP,rest⟩ · exact False.elim (hj hz) · exact hP have horder : ∀ j, P j ≠ 0 → d - (j : ℕ) < v j := by intro j hj rcases hdata j with ⟨hP,_⟩ | ⟨p,hp,hP,heval,hlow,hv⟩ · exact False.elim (hj hP) · have hv' : ((d - (j : ℕ) : ℕ) : ℝ) < (v j : ℝ) := by simpa only [Nat.cast_sub j.isLt.le] using hv exact_mod_cast hv' obtain ⟨α,S,hα,hle,hS,hSpos⟩ := Source29NewtonFaceSelection.exists_selected_face P v hPne horder refine ⟨α,S,P,v,hα,hSpos,hhom,horder,hS,?_⟩ intro j rcases hdata j with ⟨hP,hz⟩ | ⟨p,hp,hP,heval,hlow,hv⟩ · left refine ⟨hz,?_⟩ simp only [hP, ite_self] · right refine ⟨p,v j,P j,hp,heval,hlow,hle j hP,?_⟩ by_cases hj : j ∈ S · have he := (hS j).mp hj simp only [hj, ite_true, he.2.symm] · have he : α * ((d : ℝ) - (j : ℕ)) ≠ (v j : ℝ) := by intro heq exact hj ((hS j).mpr ⟨hP,heq.symm⟩) simp only [hj, he, ite_false] end end Source29NewtonCoefficientSelection /- Component: NormalizedShiftJets.inc -/ namespace Source29NormalizedShiftJets open Source29NormalShiftDerivatives open scoped Topology noncomputable section variable {n : ℕ} def dilationWeight (q ε : ℝ) : Fin (n+1) → ℝ := Fin.cons q (fun _ ↦ ε) def dilation (q ε : ℝ) : (Fin (n+1) → ℝ) →L[ℝ] (Fin (n+1) → ℝ) := ContinuousLinearMap.pi (fun i ↦ dilationWeight q ε i • ContinuousLinearMap.proj i) lemma dilation_apply (q ε : ℝ) (x : Fin (n+1) → ℝ) (i : Fin (n+1)) : dilation q ε x i = dilationWeight q ε i * x i := rfl lemma dilation_basis (q ε : ℝ) (i : Fin (n+1)) : dilation q ε (basis i) = dilationWeight q ε i • basis i := by funext j simp only [dilation_apply, basis, Pi.single_apply, Pi.smul_apply, smul_eq_mul] by_cases hij : j = i · subst j simp · simp [hij] lemma tail_dilation (q ε : ℝ) (x : Fin (n+1) → ℝ) : tail (dilation q ε x) = ε • tail x := rfl lemma second_smul_left {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] (f : E → ℝ) (x u v : E) (c : ℝ) : second f x (c • u) v = c * second f x u v := by simp only [second, map_smul, smul_eq_mul] lemma second_smul_right {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] (f : E → ℝ) (x u v : E) (c : ℝ) : second f x u (c • v) = c * second f x u v := by unfold second simp only [map_smul, smul_eq_mul] have he := congrFun (fderiv_const_smul_field (𝕜 := ℝ) (f := fun y ↦ fderiv ℝ f y v) c) x exact congrArg (fun L : E →L[ℝ] ℝ ↦ L u) he lemma first_const_mul {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] (f : E → ℝ) (x v : E) (c : ℝ) : fderiv ℝ (fun y ↦ c * f y) x v = c * fderiv ℝ f x v := by have he := congrFun (fderiv_const_smul_field (𝕜 := ℝ) (f := f) c) x exact congrArg (fun L : E →L[ℝ] ℝ ↦ L v) he lemma second_const_mul {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] (f : E → ℝ) (x u v : E) (c : ℝ) : second (fun y ↦ c * f y) x u v = c * second f x u v := by unfold second simp_rw [first_const_mul] def scaledFunction (f : (Fin (n+1) → ℝ) → ℝ) (κ ε ρ : ℝ) (x : Fin (n+1) → ℝ) : ℝ := (κ*ε*ρ)⁻¹ * f (dilation (ε*ρ) ε x) lemma gradient_scaled (f : (Fin (n+1) → ℝ) → ℝ) (κ ε ρ : ℝ) (x : Fin (n+1) → ℝ) (hf : AnalyticAt ℝ f (dilation (ε*ρ) ε x)) (i : Fin (n+1)) : gradient (scaledFunction f κ ε ρ) x i = (κ*ε*ρ)⁻¹ * dilationWeight (ε*ρ) ε i * gradient f (dilation (ε*ρ) ε x) i := by unfold Source29NormalShiftDerivatives.gradient scaledFunction rw [first_const_mul] rw [first_linear f (dilation (ε*ρ) ε) x (basis i) hf.differentiableAt, dilation_basis, map_smul, smul_eq_mul] ring lemma hessian_scaled (f : (Fin (n+1) → ℝ) → ℝ) (κ ε ρ : ℝ) (x : Fin (n+1) → ℝ) (hf : AnalyticAt ℝ f (dilation (ε*ρ) ε x)) (i j : Fin (n+1)) : hessian (scaledFunction f κ ε ρ) x i j = (κ*ε*ρ)⁻¹ * dilationWeight (ε*ρ) ε i * dilationWeight (ε*ρ) ε j * hessian f (dilation (ε*ρ) ε x) i j := by unfold hessian scaledFunction rw [second_const_mul, second_linear f (dilation (ε*ρ) ε) x (basis i) (basis j) hf, dilation_basis, dilation_basis, second_smul_left, second_smul_right] ring /-- The five unscaled jets expressed through the normalized function. -/ theorem original_jets (f : (Fin (n+1) → ℝ) → ℝ) (κ ε ρ : ℝ) (hκ : κ ≠ 0) (hε : ε ≠ 0) (hρ : ρ ≠ 0) (x : Fin (n+1) → ℝ) (hf : AnalyticAt ℝ f (dilation (ε*ρ) ε x)) : gradient f (dilation (ε*ρ) ε x) 0 = κ * gradient (scaledFunction f κ ε ρ) x 0 ∧ (∀ i : Fin n, gradient f (dilation (ε*ρ) ε x) i.succ = κ*ρ*gradient (scaledFunction f κ ε ρ) x i.succ) ∧ hessian f (dilation (ε*ρ) ε x) 0 0 = κ/(ε*ρ)*hessian (scaledFunction f κ ε ρ) x 0 0 ∧ (∀ i : Fin n, hessian f (dilation (ε*ρ) ε x) i.succ 0 = κ/ε*hessian (scaledFunction f κ ε ρ) x i.succ 0) ∧ (∀ i j : Fin n, hessian f (dilation (ε*ρ) ε x) i.succ j.succ = κ*ρ/ε*hessian (scaledFunction f κ ε ρ) x i.succ j.succ) := by simp only [gradient_scaled f κ ε ρ x hf, hessian_scaled f κ ε ρ x hf, dilationWeight, Fin.cons_zero, Fin.cons_succ] constructor · field_simp constructor · intro i field_simp constructor · field_simp constructor · intro i field_simp · intro i j field_simp def scaleMap (α ε : ℝ) : (Fin (n+1) → ℝ) →L[ℝ] (Fin (n+1) → ℝ) := dilation (ε^α) ε def family (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (α D ε : ℝ) (x : Fin (n+1) → ℝ) : ℝ := ε^(-D) * pullback P g (scaleMap α ε x) lemma family_eq (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (α D ε : ℝ) (x : Fin (n+1) → ℝ) : family P g α D ε x = ε^(-D) * MvPolynomial.eval (Fin.cons (g (ε • tail x) + ε^α * x 0) (ε • tail x)) P := by unfold family pullback rw [chart_eq] simp only [scaleMap, tail_dilation, dilation_apply, dilationWeight, Fin.cons_zero] rw [add_comm (ε^α * x 0) (g (ε • tail x))] lemma epsilon_rho (α ε : ℝ) (hε : 0 < ε) : ε * ε^(α-1) = ε^α := by calc _ = ε^(1 : ℝ) * ε^(α-1) := by rw [Real.rpow_one] _ = ε^((1 : ℝ)+(α-1)) := (Real.rpow_add hε _ _).symm _ = ε^α := by congr 1; ring lemma kappa_epsilon_rho (α D ε : ℝ) (hε : 0 < ε) : ε^(D-α) * ε * ε^(α-1) = ε^D := by rw [mul_assoc, epsilon_rho α ε hε, ← Real.rpow_add hε] congr 1 ring lemma family_eq_scaledFunction (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (α D ε : ℝ) (hε : 0 < ε) : family P g α D ε = scaledFunction (pullback P g) (ε^(D-α)) ε (ε^(α-1)) := by funext x unfold family scaledFunction scaleMap rw [epsilon_rho α ε hε, kappa_epsilon_rho α D ε hε, Real.rpow_neg hε.le] end end Source29NormalizedShiftJets /- Component: NormalizedShiftBackground.inc -/ namespace Source29NormalizedShiftBackground open Filter Source29NormalShiftDerivatives Source29NewtonRootHarmonic open scoped Topology noncomputable section variable {n : ℕ} lemma dilation_tendsto (y : Fin n → ℝ) : Tendsto (fun ε : ℝ ↦ ε • y) (𝓝[>] 0) (𝓝 0) := by simpa using (line_tendsto (0 : Fin n → ℝ) y).mono_left nhdsWithin_le_nhds /-- The rescaled background gradient has a finite limit given by its derivative at the origin. The zero-gradient hypothesis is used explicitly. -/ theorem gradient_div_tendsto (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (hg0 : gradient g 0 = 0) (y : Fin n → ℝ) : Tendsto (fun ε : ℝ ↦ fun i ↦ gradient g (ε • y) i / ε) (𝓝[>] 0) (𝓝 (fun i ↦ second g 0 y (basis i))) := by apply tendsto_pi_nhds.mpr intro i have hdi := analyticAt_directional g (0 : Fin n → ℝ) (basis i) hg have hd : HasDerivAt (fun ε : ℝ ↦ gradient g (ε • y) i) (second g 0 y (basis i)) 0 := by have hdif : HasFDerivAt (fun z ↦ fderiv ℝ g z (basis i)) (fderiv ℝ (fun z ↦ fderiv ℝ g z (basis i)) 0) ((0 : ℝ) • y) := by simpa only [zero_smul] using hdi.differentiableAt.hasFDerivAt have h := hdif.comp_hasDerivAt (0 : ℝ) ((hasDerivAt_id (0 : ℝ)).smul_const y) simpa only [zero_smul, Source29NormalShiftDerivatives.gradient, second, Function.comp_def, id_eq, one_smul] using h have hi : gradient g 0 i = 0 := congrFun hg0 i have hlim := hd.tendsto_slope_zero_right simpa only [zero_add, zero_smul, hi, sub_zero, smul_eq_mul, div_eq_mul_inv, mul_comm] using hlim /-- Continuity of the actual second derivatives supplies the background Hessian limit; no value or vanishing hypothesis on that Hessian is needed. -/ theorem hessian_tendsto (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (y : Fin n → ℝ) : Tendsto (fun ε : ℝ ↦ hessian g (ε • y)) (𝓝[>] 0) (𝓝 (hessian g 0)) := by apply tendsto_pi_nhds.mpr intro i apply tendsto_pi_nhds.mpr intro j have h1 := analyticAt_directional g (0 : Fin n → ℝ) (basis j) hg have h2 := analyticAt_directional (fun z ↦ fderiv ℝ g z (basis j)) (0 : Fin n → ℝ) (basis i) h1 exact h2.continuousAt.tendsto.comp (dilation_tendsto y) lemma scaled_gradient (g : (Fin n → ℝ) → ℝ) (y : Fin n → ℝ) (ε : ℝ) (hε : ε ≠ 0) : (fun i ↦ ε * (gradient g (ε • y) i / ε)) = gradient g (ε • y) := by funext i exact mul_div_cancel₀ _ hε end end Source29NormalizedShiftBackground /- Component: NormalizedShiftResidual.inc -/ namespace Source29NormalizedShiftResidual open Filter Source29NormalShiftDerivatives Source29NormalShiftAlgebra Source29NormalShiftScaling Source29NormalizedShiftJets Source29NormalizedShiftBackground open scoped Topology noncomputable section variable {n : ℕ} /-- The actual scaled polynomial pullback satisfies the normalized equation, with the minimal graph equation for the background used explicitly. -/ theorem scaled_pullback_equation (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (κ ε ρ : ℝ) (hκ : κ ≠ 0) (hε : ε ≠ 0) (hρ : ρ ≠ 0) (v : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (ε • tail v)) (hP : MvPolynomial.eval (chart g (dilation (ε*ρ) ε v)) (Source29QuarticReuse.QuarticMinimal.leadingOperator P) = 0) (hbg : backgroundGraphOperator (gradient g (ε • tail v)) (hessian g (ε • tail v)) = 0) : let H := scaledFunction (pullback P g) κ ε ρ let A := gradient H v 0 let S := hessian H v 0 0 let B := fun i : Fin n ↦ gradient H v i.succ let T := fun i : Fin n ↦ hessian H v i.succ 0 let U := fun i j : Fin n ↦ hessian H v i.succ j.succ let a := fun i ↦ gradient g (ε • tail v) i / ε let G := hessian g (ε • tail v) newtonResidual A S B T U + ρ^2*rhoCorrection B U + ε*ρ*mixedCorrection A B T a U G + ε^2*epsilonCorrection A S B T a U G = 0 := by dsimp only have hga : AnalyticAt ℝ g (tail (dilation (ε*ρ) ε v)) := hg have hf := analyticAt_pullback P g (dilation (ε*ρ) ε v) hga obtain ⟨hA, hB, hS, hT, hU⟩ := original_jets (pullback P g) κ ε ρ hκ hε hρ v hf have he := newton_plus_correction_eq_zero P g (dilation (ε*ρ) ε v) hga hP hbg dsimp only at he have hl : shiftedLevelOperator (gradient (pullback P g) (dilation (ε*ρ) ε v) 0) (hessian (pullback P g) (dilation (ε*ρ) ε v) 0 0) (fun i : Fin n ↦ gradient (pullback P g) (dilation (ε*ρ) ε v) i.succ) (fun i : Fin n ↦ hessian (pullback P g) (dilation (ε*ρ) ε v) i.succ 0) (gradient g (ε • tail v)) (fun i j : Fin n ↦ hessian (pullback P g) (dilation (ε*ρ) ε v) i.succ j.succ) (hessian g (ε • tail v)) = 0 := by rw [normal_shift_identity, hbg, mul_zero, sub_zero] exact he simp_rw [hA, hB, hS, hT, hU] at hl rw [← scaled_gradient g (tail v) ε hε] at hl exact scaled_equation κ ε ρ _ _ _ _ _ _ _ hκ hε hρ hl (by simpa only [scaled_gradient g (tail v) ε hε] using hbg) /-- The rpow-normalized family inherits the equation at every positive scale. -/ theorem family_equation (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (α D ε : ℝ) (hε : 0 < ε) (v : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (ε • tail v)) (hP : Source29QuarticReuse.QuarticMinimal.leadingOperator P = 0) (hbg : backgroundGraphOperator (gradient g (ε • tail v)) (hessian g (ε • tail v)) = 0) : let H := family P g α D ε let A := gradient H v 0 let S := hessian H v 0 0 let B := fun i : Fin n ↦ gradient H v i.succ let T := fun i : Fin n ↦ hessian H v i.succ 0 let U := fun i j : Fin n ↦ hessian H v i.succ j.succ let a := fun i ↦ gradient g (ε • tail v) i / ε let G := hessian g (ε • tail v) newtonResidual A S B T U + (ε^(α-1))^2*rhoCorrection B U + ε*ε^(α-1)*mixedCorrection A B T a U G + ε^2*epsilonCorrection A S B T a U G = 0 := by rw [family_eq_scaledFunction P g α D ε hε] exact scaled_pullback_equation P g (ε^(D-α)) ε (ε^(α-1)) (ne_of_gt (Real.rpow_pos_of_pos hε _)) (ne_of_gt hε) (ne_of_gt (Real.rpow_pos_of_pos hε _)) v hg (by rw [hP, map_zero]) hbg /-- Agreement of the finite-sum residual of evaluated jets with the polynomial residual. -/ lemma newtonResidual_eval (N : MvPolynomial (Fin (n+1)) ℝ) (v : Fin (n+1) → ℝ) : newtonResidual (gradient (fun x ↦ MvPolynomial.eval x N) v 0) (hessian (fun x ↦ MvPolynomial.eval x N) v 0 0) (fun i : Fin n ↦ gradient (fun x ↦ MvPolynomial.eval x N) v i.succ) (fun i : Fin n ↦ hessian (fun x ↦ MvPolynomial.eval x N) v i.succ 0) (fun i j : Fin n ↦ hessian (fun x ↦ MvPolynomial.eval x N) v i.succ j.succ) = MvPolynomial.eval v (Source29NewtonNormalDerivative.newtonResidual N) := by simp only [newtonResidual, dot, trace, gradient_eval, hessian_eval, Source29NewtonNormalDerivative.newtonResidual, Source29NewtonNormalDerivative.tangentialLaplacian, Source29NewtonNormalDerivative.tangentialMixed, Source29NewtonNormalDerivative.tangentialEnergy, map_add, map_sub, map_mul, map_sum, map_ofNat, pow_two] end end Source29NormalizedShiftResidual /- Component: NormalizedShiftLimit.inc -/ namespace Source29NormalizedShiftLimit open Filter Source29NormalShiftDerivatives Source29NormalShiftAlgebra Source29NormalShiftScaling Source29NormalizedShiftJets Source29NormalizedShiftBackground Source29NormalizedShiftResidual open scoped Topology noncomputable section variable {n : ℕ} /-- A polynomial limit of the actual first and second normalized jets satisfies the Newton residual equation. Function convergence alone is not an input. -/ theorem eval_newtonResidual_eq_zero (P N : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (α D : ℝ) (hα : 1 < α) (hg : AnalyticAt ℝ g 0) (hg0 : gradient g 0 = 0) (hP : Source29QuarticReuse.QuarticMinimal.leadingOperator P = 0) (hbg : ∀ᶠ y in 𝓝 0, backgroundGraphOperator (gradient g y) (hessian g y) = 0) (v : Fin (n+1) → ℝ) (hfirst : ∀ i, Tendsto (fun ε : ℝ ↦ gradient (family P g α D ε) v i) (𝓝[>] 0) (𝓝 (MvPolynomial.eval v (MvPolynomial.pderiv i N)))) (hsecond : ∀ i j, Tendsto (fun ε : ℝ ↦ hessian (family P g α D ε) v i j) (𝓝[>] 0) (𝓝 (MvPolynomial.eval v (MvPolynomial.pderiv i (MvPolynomial.pderiv j N))))) : MvPolynomial.eval v (Source29NewtonNormalDerivative.newtonResidual N) = 0 := by have hε : Tendsto (fun ε : ℝ ↦ ε) (𝓝[>] 0) (𝓝 0) := tendsto_id.mono_left nhdsWithin_le_nhds have hρ : Tendsto (fun ε : ℝ ↦ ε^(α-1)) (𝓝[>] 0) (𝓝 0) := by have hp : Tendsto (fun ε : ℝ ↦ ε^(α-1)) (𝓝[>] 0) (𝓝 ((0 : ℝ)^(α-1))) := (Real.continuousAt_rpow_const (0 : ℝ) (α-1) (Or.inr (le_of_lt (sub_pos.mpr hα)))).tendsto.mono_left nhdsWithin_le_nhds simpa only [Real.zero_rpow (ne_of_gt (sub_pos.mpr hα))] using hp have heq := fun ε (hp : 0 < ε) (ha : AnalyticAt ℝ g (ε • tail v)) (hb : backgroundGraphOperator (gradient g (ε • tail v)) (hessian g (ε • tail v)) = 0) ↦ family_equation P g α D ε hp v ha hP hb have hevent : ∀ᶠ ε : ℝ in 𝓝[>] 0, let H := family P g α D ε let A := gradient H v 0 let S := hessian H v 0 0 let B := fun i : Fin n ↦ gradient H v i.succ let T := fun i : Fin n ↦ hessian H v i.succ 0 let U := fun i j : Fin n ↦ hessian H v i.succ j.succ let a := fun i ↦ gradient g (ε • tail v) i / ε let G := hessian g (ε • tail v) newtonResidual A S B T U + (ε^(α-1))^2*rhoCorrection B U + ε*ε^(α-1)*mixedCorrection A B T a U G + ε^2*epsilonCorrection A S B T a U G = 0 := by filter_upwards [self_mem_nhdsWithin, (dilation_tendsto (tail v)).eventually hg.eventually_analyticAt, (dilation_tendsto (tail v)).eventually hbg] with ε hp ha hb exact heq ε hp ha hb have hE := Source29NormalShiftScalingLimit.newtonResidual_eq_zero_of_tendsto (fun ε : ℝ ↦ ε) (fun ε : ℝ ↦ ε^(α-1)) (fun ε ↦ gradient (family P g α D ε) v 0) (fun ε ↦ hessian (family P g α D ε) v 0 0) (fun ε (i : Fin n) ↦ gradient (family P g α D ε) v i.succ) (fun ε (i : Fin n) ↦ hessian (family P g α D ε) v i.succ 0) (fun ε (i : Fin n) ↦ gradient g (ε • tail v) i / ε) (fun ε (i j : Fin n) ↦ hessian (family P g α D ε) v i.succ j.succ) (fun ε ↦ hessian g (ε • tail v)) (MvPolynomial.eval v (MvPolynomial.pderiv 0 N)) (MvPolynomial.eval v (MvPolynomial.pderiv 0 (MvPolynomial.pderiv 0 N))) (fun i : Fin n ↦ MvPolynomial.eval v (MvPolynomial.pderiv i.succ N)) (fun i : Fin n ↦ MvPolynomial.eval v (MvPolynomial.pderiv i.succ (MvPolynomial.pderiv 0 N))) (fun i ↦ second g 0 (tail v) (basis i)) (fun i j : Fin n ↦ MvPolynomial.eval v (MvPolynomial.pderiv i.succ (MvPolynomial.pderiv j.succ N))) (hessian g 0) hε hρ (hfirst 0) (hsecond 0 0) (tendsto_pi_nhds.mpr (fun i ↦ hfirst i.succ)) (tendsto_pi_nhds.mpr (fun i ↦ hsecond i.succ 0)) (gradient_div_tendsto g hg hg0 (tail v)) (tendsto_pi_nhds.mpr (fun i ↦ tendsto_pi_nhds.mpr (fun j ↦ hsecond i.succ j.succ))) (hessian_tendsto g hg (tail v)) hevent rw [← newtonResidual_eval N v] simpa only [gradient_eval, hessian_eval] using hE /-- Pointwise convergence of every actual first and second jet gives the polynomial identity, with no residual equation assumed for the limit. -/ theorem newtonResidual_eq_zero (P N : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (α D : ℝ) (hα : 1 < α) (hg : AnalyticAt ℝ g 0) (hg0 : gradient g 0 = 0) (hP : Source29QuarticReuse.QuarticMinimal.leadingOperator P = 0) (hbg : ∀ᶠ y in 𝓝 0, backgroundGraphOperator (gradient g y) (hessian g y) = 0) (hfirst : ∀ v i, Tendsto (fun ε : ℝ ↦ gradient (family P g α D ε) v i) (𝓝[>] 0) (𝓝 (MvPolynomial.eval v (MvPolynomial.pderiv i N)))) (hsecond : ∀ v i j, Tendsto (fun ε : ℝ ↦ hessian (family P g α D ε) v i j) (𝓝[>] 0) (𝓝 (MvPolynomial.eval v (MvPolynomial.pderiv i (MvPolynomial.pderiv j N))))) : Source29NewtonNormalDerivative.newtonResidual N = 0 := by apply Source29QuarticReuse.QuarticCompatibility.polynomial_funext intro v simpa only [map_zero] using eval_newtonResidual_eq_zero P N g α D hα hg hg0 hP hbg v (hfirst v) (hsecond v) end end Source29NormalizedShiftLimit /- Component: FiniteJetConvergence.inc -/ namespace Source29FiniteJetConvergence open Filter open Source29NormalShiftDerivatives Source29NewtonRootHarmonic open scoped Topology BigOperators noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] lemma first_mul (f g : E → ℝ) (x v : E) (hf : AnalyticAt ℝ f x) (hg : AnalyticAt ℝ g x) : fderiv ℝ (fun y ↦ f y * g y) x v = f x * fderiv ℝ g x v + g x * fderiv ℝ f x v := by rw [fderiv_fun_mul hf.differentiableAt hg.differentiableAt] rfl lemma second_mul (f g : E → ℝ) (x u v : E) (hf : AnalyticAt ℝ f x) (hg : AnalyticAt ℝ g x) : second (fun y ↦ f y * g y) x u v = f x * second g x u v + g x * second f x u v + fderiv ℝ f x u * fderiv ℝ g x v + fderiv ℝ g x u * fderiv ℝ f x v := by have he : (fun y ↦ fderiv ℝ (fun z ↦ f z * g z) y v) =ᶠ[𝓝 x] (fun y ↦ f y * fderiv ℝ g y v + g y * fderiv ℝ f y v) := by filter_upwards [hf.eventually_analyticAt, hg.eventually_analyticAt] with y hyf hyg exact first_mul f g y v hyf hyg have hdf := analyticAt_directional f x v hf have hdg := analyticAt_directional g x v hg unfold second rw [he.fderiv_eq, fderiv_fun_add (f := fun y ↦ f y * fderiv ℝ g y v) (g := fun y ↦ g y * fderiv ℝ f y v) (hf.mul hdg).differentiableAt (hg.mul hdf).differentiableAt] simp only [add_apply] rw [first_mul f _ x u hf hdg, first_mul g _ x u hg hdf] ring lemma first_sum {J : Type*} (S : Finset J) (f : J → E → ℝ) (x v : E) (hf : ∀ j ∈ S, AnalyticAt ℝ (f j) x) : fderiv ℝ (fun y ↦ ∑ j ∈ S, f j y) x v = ∑ j ∈ S, fderiv ℝ (f j) x v := by rw [fderiv_fun_sum (fun j hj ↦ (hf j hj).differentiableAt)] exact sum_apply _ _ _ lemma second_sum {J : Type*} (S : Finset J) (f : J → E → ℝ) (x u v : E) (hf : ∀ j ∈ S, AnalyticAt ℝ (f j) x) : second (fun y ↦ ∑ j ∈ S, f j y) x u v = ∑ j ∈ S, second (f j) x u v := by have hnear : ∀ᶠ y in 𝓝 x, ∀ j ∈ S, AnalyticAt ℝ (f j) y := (eventually_all_finset S).2 (fun j hj ↦ (hf j hj).eventually_analyticAt) have he : (fun y ↦ fderiv ℝ (fun z ↦ ∑ j ∈ S, f j z) y v) =ᶠ[𝓝 x] (fun y ↦ ∑ j ∈ S, fderiv ℝ (f j) y v) := hnear.mono (fun y hy ↦ first_sum S f y v hy) unfold second rw [he.fderiv_eq] exact first_sum S (fun j y ↦ fderiv ℝ (f j) y v) x u (fun j hj ↦ analyticAt_directional (f j) x v (hf j hj)) lemma second_eq_fderiv (f : E → ℝ) (x u v : E) (hf : AnalyticAt ℝ f x) : second f x u v = fderiv ℝ (fderiv ℝ f) x u v := by have h := (ContinuousLinearMap.apply ℝ ℝ v).hasFDerivAt.comp x hf.fderiv.differentiableAt.hasFDerivAt exact congrArg (fun L : E →L[ℝ] ℝ ↦ L u) h.fderiv /-- Pointwise convergence of a scalar function and every ordered first and second directional derivative at one point. -/ def JetConverges {ι : Type*} (l : Filter ι) (F : ι → E → ℝ) (f : E → ℝ) (x : E) : Prop := Tendsto (fun t ↦ F t x) l (𝓝 (f x)) ∧ (∀ v, Tendsto (fun t ↦ fderiv ℝ (F t) x v) l (𝓝 (fderiv ℝ f x v))) ∧ (∀ u v, Tendsto (fun t ↦ second (F t) x u v) l (𝓝 (second f x u v))) namespace JetConverges variable {ι : Type*} {l : Filter ι} {F G : ι → E → ℝ} {f g : E → ℝ} {x : E} lemma const (f : E → ℝ) (x : E) : JetConverges l (fun _ ↦ f) f x := ⟨tendsto_const_nhds, fun _ ↦ tendsto_const_nhds, fun _ _ ↦ tendsto_const_nhds⟩ lemma congr (hF : JetConverges l F f x) (hFG : F =ᶠ[l] G) (hfg : f = g) : JetConverges l G g x := by subst g refine ⟨hF.1.congr' ?_, fun v ↦ (hF.2.1 v).congr' ?_, fun u v ↦ (hF.2.2 u v).congr' ?_⟩ · exact hFG.mono (fun _ ht ↦ congrFun ht x) · exact hFG.mono (fun _ ht ↦ congrArg (fun h ↦ fderiv ℝ h x v) ht) · exact hFG.mono (fun _ ht ↦ congrArg (fun h ↦ second h x u v) ht) lemma mul (hF : JetConverges l F f x) (hG : JetConverges l G g x) (hFa : ∀ᶠ t in l, AnalyticAt ℝ (F t) x) (hGa : ∀ᶠ t in l, AnalyticAt ℝ (G t) x) (hf : AnalyticAt ℝ f x) (hg : AnalyticAt ℝ g x) : JetConverges l (fun t y ↦ F t y * G t y) (fun y ↦ f y * g y) x := by refine ⟨hF.1.mul hG.1, ?_, ?_⟩ · intro v rw [first_mul f g x v hf hg] apply ((hF.1.mul (hG.2.1 v)).add (hG.1.mul (hF.2.1 v))).congr' filter_upwards [hFa, hGa] with t htF htG exact (first_mul (F t) (G t) x v htF htG).symm · intro u v rw [second_mul f g x u v hf hg] apply ((((hF.1.mul (hG.2.2 u v)).add (hG.1.mul (hF.2.2 u v))).add ((hF.2.1 u).mul (hG.2.1 v))).add ((hG.2.1 u).mul (hF.2.1 v))).congr' filter_upwards [hFa, hGa] with t htF htG exact (second_mul (F t) (G t) x u v htF htG).symm lemma comp_linear {V : Type*} [NormedAddCommGroup V] [NormedSpace ℝ V] (L : V →L[ℝ] E) (z : V) (hF : JetConverges l F f (L z)) (hFa : ∀ᶠ t in l, AnalyticAt ℝ (F t) (L z)) (hf : AnalyticAt ℝ f (L z)) : JetConverges l (fun t y ↦ F t (L y)) (fun y ↦ f (L y)) z := by refine ⟨hF.1, ?_, ?_⟩ · intro v rw [first_linear f L z v hf.differentiableAt] apply (hF.2.1 (L v)).congr' filter_upwards [hFa] with t ht exact (first_linear (F t) L z v ht.differentiableAt).symm · intro u v rw [second_linear f L z u v hf] apply (hF.2.2 (L u) (L v)).congr' filter_upwards [hFa] with t ht exact (second_linear (F t) L z u v ht).symm lemma sum {J : Type*} (S : Finset J) (F : J → ι → E → ℝ) (f : J → E → ℝ) (hF : ∀ j ∈ S, JetConverges l (F j) (f j) x) (hFa : ∀ j ∈ S, ∀ᶠ t in l, AnalyticAt ℝ (F j t) x) (hf : ∀ j ∈ S, AnalyticAt ℝ (f j) x) : JetConverges l (fun t y ↦ ∑ j ∈ S, F j t y) (fun y ↦ ∑ j ∈ S, f j y) x := by have hnear := (eventually_all_finset S).2 hFa refine ⟨tendsto_finsetSum S (fun j hj ↦ (hF j hj).1), ?_, ?_⟩ · intro v rw [first_sum S f x v hf] apply (tendsto_finsetSum S (fun j hj ↦ (hF j hj).2.1 v)).congr' filter_upwards [hnear] with t ht exact (first_sum S (fun j ↦ F j t) x v ht).symm · intro u v rw [second_sum S f x u v hf] apply (tendsto_finsetSum S (fun j hj ↦ (hF j hj).2.2 u v)).congr' filter_upwards [hnear] with t ht exact (second_sum S (fun j ↦ F j t) x u v ht).symm end JetConverges end end Source29FiniteJetConvergence /- Component: NewtonFiniteJetAssembly.inc -/ namespace Source29NewtonFiniteJetAssembly open Filter open Source29NormalShiftDerivatives Source29FiniteJetConvergence open scoped Topology BigOperators noncomputable section variable {n : ℕ} def normalExpansion {J : Type*} (S : Finset J) (degree : J → ℕ) (a : J → (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) : ℝ := ∑ j ∈ S, a j (tail x) * (x 0)^(degree j) /-- Finite normal powers preserve convergence of all first and ordered second jets of the tangential coefficient functions. -/ theorem normalExpansion_jet_limit {J ι : Type*} (l : Filter ι) (S : Finset J) (degree : J → ℕ) (a : J → ι → (Fin n → ℝ) → ℝ) (b : J → (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) (ha : ∀ j ∈ S, JetConverges l (a j) (b j) (tail x)) (haa : ∀ j ∈ S, ∀ᶠ t in l, AnalyticAt ℝ (a j t) (tail x)) (hb : ∀ j ∈ S, AnalyticAt ℝ (b j) (tail x)) : JetConverges l (fun t ↦ normalExpansion S degree (fun j ↦ a j t)) (normalExpansion S degree b) x := by unfold normalExpansion apply JetConverges.sum · intro j hj have hq : AnalyticAt ℝ (fun z : Fin (n+1) → ℝ ↦ (z 0)^(degree j)) x := ((ContinuousLinearMap.proj 0 : (Fin (n+1) → ℝ) →L[ℝ] ℝ).analyticAt x).pow _ apply ((ha j hj).comp_linear tail x (haa j hj) (hb j hj)).mul (JetConverges.const _ x) · filter_upwards [haa j hj] with t ht exact ht.comp (tail.analyticAt x) · exact Eventually.of_forall (fun _ ↦ hq) · exact (hb j hj).comp (tail.analyticAt x) · exact hq · intro j hj filter_upwards [haa j hj] with t ht exact (ht.comp (tail.analyticAt x)).mul (((ContinuousLinearMap.proj 0 : (Fin (n+1) → ℝ) →L[ℝ] ℝ).analyticAt x).pow _) · intro j hj exact ((hb j hj).comp (tail.analyticAt x)).mul (((ContinuousLinearMap.proj 0 : (Fin (n+1) → ℝ) →L[ℝ] ℝ).analyticAt x).pow _) end end Source29NewtonFiniteJetAssembly /- Component: NewtonCoefficientJetLimit.inc -/ namespace Source29NewtonCoefficientJetLimit open MvPolynomial Filter open Source29NormalShiftDerivatives Source29FiniteJetConvergence open Source29NewtonInitialDataLimit Source29NewtonInitialDerivativeLimit open scoped Topology noncomputable section variable {n : ℕ} /-- Initial coefficient data determine the value and all first and second directional limits of its normalized dilation. -/ theorem coefficient_jet_limit {f : (Fin n → ℝ) → ℝ} (hf : AnalyticAt ℝ f 0) (β : ℝ) (Q : MvPolynomial (Fin n) ℝ) (hdata : CoefficientData f β Q) (y : Fin n → ℝ) : JetConverges (𝓝[>] (0 : ℝ)) (fun ε z ↦ ε^(-β) * f (ε • z)) (fun z ↦ eval z Q) y := by have hval := (coefficient_uniform_limit β Q hdata {y} (isCompact_singleton.isBounded)).tendsto_at (Set.mem_singleton y) have hfirst := coefficient_fderiv_limit β Q hdata y have hsecond := coefficient_fderiv_fderiv_limit β Q hdata y have hQa := Source29PolynomialLinkChart.analyticAt_eval_real Q y refine ⟨hval, ?_, ?_⟩ · intro v exact ((ContinuousLinearMap.apply ℝ ℝ v).continuous.tendsto _).comp hfirst · intro u v have hu := ((ContinuousLinearMap.apply ℝ ((Fin n → ℝ) →L[ℝ] ℝ) u).continuous.tendsto _).comp hsecond have huv := ((ContinuousLinearMap.apply ℝ ℝ v).continuous.tendsto _).comp hu rw [second_eq_fderiv (fun z ↦ eval z Q) y u v hQa] apply huv.congr' filter_upwards [eventually_analyticAt_dilation hf β y] with ε hε exact (second_eq_fderiv (fun z ↦ ε^(-β) * f (ε • z)) y u v hε).symm end end Source29NewtonCoefficientJetLimit /- Component: NewtonNormalizedJetLimit.inc -/ namespace Source29NewtonNormalizedJetLimit open MvPolynomial Filter open Source29NormalShiftDerivatives Source29NormalizedShiftJets open Source29FiniteJetConvergence Source29NewtonFiniteJetAssembly open Source29NewtonShiftedFactorCoefficient Source29NewtonShiftedExpansion open Source29NewtonFiniteRescaling Source29NewtonInitialDataLimit open Source29NewtonInitialDerivativeLimit Source29NewtonCoefficientJetLimit open scoped Topology BigOperators noncomputable section variable {n : ℕ} lemma family_eq_normalExpansion (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (m : ℕ) (hm : (finSuccEquiv ℝ n F).natDegree < m) (α D ε : ℝ) (hε : 0 < ε) : family F g α D ε = normalExpansion (Finset.range m) id (fun j y ↦ ε^(α*(j : ℝ)-D) * (shiftedSlice F (g (ε • y)) (ε • y)).coeff j) := by funext x calc family F g α D ε x = eval (Fin.cons (g (ε • tail x) + ε^α*x 0) (ε • tail x)) F / ε^D := by rw [family_eq, Real.rpow_neg hε.le] ring _ = expansion (Finset.range m) id (fun j y ↦ (shiftedSlice F (g y) y).coeff j) (ε^α*x 0) (ε • tail x) / ε^D := by rw [shifted_finite_expansion F g m hm] _ = _ := scaled_expansion (Finset.range m) id (fun j y ↦ (shiftedSlice F (g y) y).coeff j) (x 0) ε α D (ε • tail x) hε lemma eval_eq_normalExpansion (N : MvPolynomial (Fin (n+1)) ℝ) (m : ℕ) (hm : (finSuccEquiv ℝ n N).natDegree < m) : (fun x ↦ eval x N) = normalExpansion (Finset.range m) id (fun j y ↦ eval y ((finSuccEquiv ℝ n N).coeff j)) := by funext x have hc : Fin.cons (x 0) (tail x) = x := by funext i exact Fin.cases rfl (fun j ↦ rfl) i have he := polynomial_finite_expansion N m hm (x 0) (tail x) rw [hc] at he exact he /-- Explicit initial data for the finitely many shifted normal coefficients imply convergence of the actual normalized polynomial through two derivatives. -/ theorem family_jet_limit (F N : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (m : ℕ) (hF : (finSuccEquiv ℝ n F).natDegree < m) (hN : (finSuccEquiv ℝ n N).natDegree < m) (α D : ℝ) (hdata : ∀ j < m, CoefficientData (fun y ↦ (shiftedSlice F (g y) y).coeff j) (D-α*(j : ℝ)) ((finSuccEquiv ℝ n N).coeff j)) (x : Fin (n+1) → ℝ) : JetConverges (𝓝[>] (0 : ℝ)) (family F g α D) (fun z ↦ eval z N) x := by have hcoeff : ∀ j, AnalyticAt ℝ (fun y ↦ (shiftedSlice F (g y) y).coeff j) 0 := fun j ↦ Source29NewtonCoefficientAnalytic.analyticAt_shifted_coefficient F j g 0 hg have he : ∀ j : ℕ, -(D-α*(j : ℝ)) = α*(j : ℝ)-D := by intro j; ring have hj := normalExpansion_jet_limit (𝓝[>] (0 : ℝ)) (Finset.range m) id (fun j ε y ↦ ε^(α*(j : ℝ)-D) * (shiftedSlice F (g (ε • y)) (ε • y)).coeff j) (fun j y ↦ eval y ((finSuccEquiv ℝ n N).coeff j)) x (fun j hj ↦ by simpa only [he j] using coefficient_jet_limit (hcoeff j) (D-α*(j : ℝ)) ((finSuccEquiv ℝ n N).coeff j) (hdata j (Finset.mem_range.mp hj)) (tail x)) (fun j _ ↦ by simpa only [he j] using eventually_analyticAt_dilation (hcoeff j) (D-α*(j : ℝ)) (tail x)) (fun j _ ↦ Source29PolynomialLinkChart.analyticAt_eval_real _ (tail x)) apply hj.congr · filter_upwards [self_mem_nhdsWithin] with ε hε exact (family_eq_normalExpansion F g m hF α D ε hε).symm · exact (eval_eq_normalExpansion N m hN).symm /-- The coordinate form consumed by the scaled minimal-graph equation. -/ theorem coordinate_jets_tendsto (F N : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (m : ℕ) (hF : (finSuccEquiv ℝ n F).natDegree < m) (hN : (finSuccEquiv ℝ n N).natDegree < m) (α D : ℝ) (hdata : ∀ j < m, CoefficientData (fun y ↦ (shiftedSlice F (g y) y).coeff j) (D-α*(j : ℝ)) ((finSuccEquiv ℝ n N).coeff j)) (x : Fin (n+1) → ℝ) : (∀ i, Tendsto (fun ε ↦ gradient (family F g α D ε) x i) (𝓝[>] (0 : ℝ)) (𝓝 (eval x (pderiv i N)))) ∧ (∀ i j, Tendsto (fun ε ↦ hessian (family F g α D ε) x i j) (𝓝[>] (0 : ℝ)) (𝓝 (eval x (pderiv i (pderiv j N))))) := by have ht := family_jet_limit F N g hg m hF hN α D hdata x constructor · intro i rw [← gradient_eval N x i] exact ht.2.1 (basis i) · intro i j rw [← hessian_eval N x i j] exact ht.2.2 (basis i) (basis j) end end Source29NewtonNormalizedJetLimit /- Component: NewtonFaceJetLimit.inc -/ namespace Source29NewtonFaceJetLimit open MvPolynomial Filter open Source29NormalShiftDerivatives Source29NormalizedShiftJets open Source29FiniteJetConvergence Source29NewtonNormalizedJetLimit open Source29NewtonWeightedFace Source29NewtonShiftedFactorCoefficient open Source29NewtonInitialDataLimit Source29NewtonFaceCoefficientData open scoped Topology noncomputable section variable {n d : ℕ} /-- Initial data below the selected face, its top coefficient, and analyticity supply every coefficient needed for the finite jet limit. -/ lemma all_coefficient_data (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (c : ℝ) (hc : (shiftedSlice F (g 0) 0).coeff d = c) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) (α : ℝ) (hα : 0 < α) (hdata : ∀ j : Fin d, CoefficientData (fun y ↦ (shiftedSlice F (g y) y).coeff (j : ℕ)) (α*(d : ℝ)-α*(j : ℕ)) (if j ∈ S then P j else 0)) : ∀ j : ℕ, CoefficientData (fun y ↦ (shiftedSlice F (g y) y).coeff j) (α*(d : ℝ)-α*j) ((finSuccEquiv ℝ n (face c S P)).coeff j) := by intro j rcases lt_trichotomy j d with hlt | heq | hgt · rw [lower_coefficient c S P ⟨j,hlt⟩] exact hdata ⟨j,hlt⟩ · subst j exact data_at_face_top F g hg c hc S P α · exact data_above_face F g hg c S P α hα j hgt /-- The actual normalized shifted polynomial converges through order two to its selected Newton face at every fixed point. -/ theorem face_jet_limit (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (c : ℝ) (hc : (shiftedSlice F (g 0) 0).coeff d = c) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) (α : ℝ) (hα : 0 < α) (m : ℕ) (hm : d < m) (hF : (finSuccEquiv ℝ n F).natDegree < m) (hdata : ∀ j : Fin d, CoefficientData (fun y ↦ (shiftedSlice F (g y) y).coeff (j : ℕ)) (α*(d : ℝ)-α*(j : ℕ)) (if j ∈ S then P j else 0)) (x : Fin (n+1) → ℝ) : JetConverges (𝓝[>] (0 : ℝ)) (family F g α (α*d)) (fun z ↦ eval z (face c S P)) x := family_jet_limit F (face c S P) g hg m hF (lt_of_le_of_lt (normal_degree_le c S P) hm) α (α*d) (fun j _ ↦ all_coefficient_data F g hg c hc S P α hα hdata j) x /-- Coordinate first and second derivatives of the normalized family have the exact polynomial-derivative limits used by the Newton residual. -/ theorem face_coordinate_jets_tendsto (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (c : ℝ) (hc : (shiftedSlice F (g 0) 0).coeff d = c) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) (α : ℝ) (hα : 0 < α) (m : ℕ) (hm : d < m) (hF : (finSuccEquiv ℝ n F).natDegree < m) (hdata : ∀ j : Fin d, CoefficientData (fun y ↦ (shiftedSlice F (g y) y).coeff (j : ℕ)) (α*(d : ℝ)-α*(j : ℕ)) (if j ∈ S then P j else 0)) (x : Fin (n+1) → ℝ) : (∀ i, Tendsto (fun ε ↦ gradient (family F g α (α*d) ε) x i) (𝓝[>] (0 : ℝ)) (𝓝 (eval x (pderiv i (face c S P))))) ∧ (∀ i j, Tendsto (fun ε ↦ hessian (family F g α (α*d) ε) x i j) (𝓝[>] (0 : ℝ)) (𝓝 (eval x (pderiv i (pderiv j (face c S P)))))) := coordinate_jets_tendsto F (face c S P) g hg m hF (lt_of_le_of_lt (normal_degree_le c S P) hm) α (α*d) (fun j _ ↦ all_coefficient_data F g hg c hc S P α hα hdata j) x end end Source29NewtonFaceJetLimit /- Component: NewtonRegularObstruction.inc -/ namespace Source29NewtonRegularObstruction open MvPolynomial Filter open Source29NewtonShiftedFactorCoefficient Source29NewtonWeightedFace open Source29NormalShiftDerivatives Source29NormalShiftAlgebra open scoped Topology noncomputable section variable {n : ℕ} /-- The exact shifted leading equation and a pure ordinary initial limit exclude all lower normal coefficient germs. The Newton residual and the strict Newton slope are derived, rather than imposed on a proposed face. -/ theorem lower_coefficient_germs_zero (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (hg0 : gradient g 0 = 0) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (hbg : ∀ᶠ y in 𝓝 0, backgroundGraphOperator (gradient g y) (hessian g y) = 0) (d : ℕ) (c : ℝ) (hc : c ≠ 0) (hinitial : ∀ x y, Tendsto (fun t : ℝ ↦ eval (Fin.cons (g (t•y)+t*x) (t•y)) F / t^d) (𝓝[>] 0) (𝓝 (c*x^d))) (hpos : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, 0 < z.1 → 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) F) (hneg : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, z.1 < 0 → eval (Fin.cons (g z.2+z.1) z.2) F ≤ 0) : ∀ j : Fin d, ∀ᶠ y in 𝓝 0, (shiftedSlice F (g y) y).coeff (j:ℕ) = 0 := by classical by_contra h have hne := not_forall.mp h obtain ⟨α,S,P,v,hα,hS,hP,horder,hselected,hdata⟩ := Source29NewtonCoefficientSelection.exists_selected_coefficient_data (fun (j : Fin d) y ↦ (shiftedSlice F (g y) y).coeff (j:ℕ)) (fun j ↦ Source29NewtonCoefficientAnalytic.analyticAt_shifted_coefficient F j g 0 hg) hne (Source29NewtonCoefficientLimitExtraction.lower_coefficient_limit_zero_of_pure_initial F g d c hinitial) have hαpos : 0 < α := lt_trans zero_lt_one hα have htop := Source29NewtonInitialCenterCoefficient.center_coefficient_of_pure_initial F g d c hinitial have hdata' : ∀ j : Fin d, Source29NewtonInitialDataLimit.CoefficientData (fun y ↦ (shiftedSlice F (g y) y).coeff (j:ℕ)) (α*(d:ℝ)-α*(j:ℕ)) (if j ∈ S then P j else 0) := by intro j simpa only [mul_sub] using hdata j let m := max (finSuccEquiv ℝ n F).natDegree d + 1 have hFm : (finSuccEquiv ℝ n F).natDegree < m := Nat.lt_succ_of_le (le_max_left _ _) have hdm : d < m := Nat.lt_succ_of_le (le_max_right _ _) have hjets := Source29NewtonFaceJetLimit.face_coordinate_jets_tendsto F g hg c htop S P α hαpos m hdm hFm hdata' have hE : Source29NewtonNormalDerivative.newtonResidual (face c S P) = 0 := Source29NormalizedShiftLimit.newtonResidual_eq_zero F (face c S P) g α (α*d) hα hg hg0 hF hbg (fun x ↦ (hjets x).1) (fun x ↦ (hjets x).2) have hlimit : ∀ z : ℝ × (Fin n → ℝ), Tendsto (fun t : ℝ ↦ eval (Fin.cons (g (t•z.2)+t^α*z.1) (t•z.2)) F / t^(α*d)) (𝓝[>] 0) (𝓝 (eval (Fin.cons z.1 z.2) (face c S P))) := by intro z have ht := Source29NewtonFaceCoefficientData.shifted_face_uniform_limit F g hg c htop S P α hαpos m hdm hFm hdata' |z.1| (abs_nonneg _) {z.2} Bornology.isBounded_singleton exact ht.tendsto_at (show z ∈ ({x : ℝ | |x| ≤ |z.1|} ×ˢ {z.2}) from ⟨by change |z.1| ≤ |z.1|; exact le_rfl, Set.mem_singleton _⟩) obtain ⟨hspos,hsneg⟩ := Source29LocalWeightedSignLimit.sign_inherited (fun z : ℝ × (Fin n → ℝ) ↦ eval (Fin.cons (g z.2+z.1) z.2) F) (fun z ↦ eval (Fin.cons z.1 z.2) (face c S P)) α (α*d) hαpos hpos hneg hlimit obtain ⟨j,hj⟩ := hS apply Source29NewtonFaceSelection.selected_face_contradiction c hc S P v α hαpos (fun j _ ↦ hP j) (fun j hj ↦ ((hselected j).mp hj).2) j hj ((hselected j).mp hj).1 hE · intro z hz have ht := hspos (z 0, Fin.tail z) hz simpa only [Fin.cons_self_tail] using ht · intro z hz have ht := hsneg (z 0, Fin.tail z) hz simpa only [Fin.cons_self_tail] using ht end end Source29NewtonRegularObstruction /- Component: PureInitialFlatShift.inc -/ namespace Source29PureInitialFlatShift open Filter MvPolynomial open scoped Topology noncomputable section /-- Uniform initial scaling permits directions that converge with the scale. -/ theorem initial_tendsto_moving_argument {E V : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [NormedAddCommGroup V] [NormedSpace ℝ V] {f : E → V} {a : E} {p : FormalMultilinearSeries ℝ E V} (hp : HasFPowerSeriesAt f p a) (d : ℕ) (hlow : ∀ k < d, ∀ x, p k (fun _ => x) = 0) (z : ℝ → E) (z₀ : E) (hz : Tendsto z (𝓝[>] 0) (𝓝 z₀)) : Tendsto (fun t : ℝ => (t^d)⁻¹ • f (a+t•z t)) (𝓝[>] 0) (𝓝 (p d (fun _ => z₀))) := by have hU := Source29AnalyticInitialScaling.initial_tendstoUniformlyOn hp d hlow (Metric.closedBall z₀ 1) (Metric.isBounded_closedBall) have hc : Continuous (fun x : E => p d (fun _ => x)) := (p d).cont.comp (continuous_pi (fun _ => continuous_id)) have hz' : Tendsto z (𝓝[>] 0) (𝓝[Metric.closedBall z₀ 1] z₀) := by apply tendsto_nhdsWithin_iff.mpr exact ⟨hz, hz.eventually (Metric.closedBall_mem_nhds z₀ zero_lt_one)⟩ exact hU.tendsto_comp hc.continuousAt.continuousWithinAt hz' /-- A differentiable function with zero value and derivative at the origin is negligible along each line after division by its scale. -/ theorem flat_shift_div_tendsto_zero {n : ℕ} {g : (Fin n → ℝ) → ℝ} (hg : DifferentiableAt ℝ g 0) (hg0 : g 0 = 0) (hD : fderiv ℝ g 0 = 0) (y : Fin n → ℝ) : Tendsto (fun t : ℝ => g (t • y) / t) (𝓝[>] 0) (𝓝 0) := by have hgf : HasFDerivAt g (0 : (Fin n → ℝ) →L[ℝ] ℝ) 0 := by simpa only [hD] using hg.hasFDerivAt have ht : HasDerivAt (fun t : ℝ => t • y) y 0 := by convert! (hasDerivAt_id (0 : ℝ)).smul_const y using 1 simp only [one_smul] have hgf' : HasFDerivAt g (0 : (Fin n → ℝ) →L[ℝ] ℝ) ((fun t : ℝ => t • y) 0) := by simpa only [zero_smul] using hgf have hline : HasDerivAt (fun t : ℝ => g (t • y)) 0 0 := by convert! hgf'.comp_hasDerivAt 0 ht using 1 simpa only [zero_add, zero_smul, hg0, sub_zero, smul_eq_mul, div_eq_mul_inv, mul_comm] using hline.tendsto_slope_zero_right /-- A flat differentiable normal shift preserves a pure normal homogeneous initial term of the ambient polynomial under ordinary scaling. -/ theorem normal_shift_pure_initial_limit {n : ℕ} (F : MvPolynomial (Fin (n+1)) ℝ) {p : FormalMultilinearSeries ℝ (Fin (n+1) → ℝ) ℝ} (hp : HasFPowerSeriesAt (fun z => eval z F) p 0) (d : ℕ) (c : ℝ) (hlow : ∀ k < d, ∀ z, p k (fun _ => z) = 0) (hpure : ∀ z, p d (fun _ => z) = c * (z 0)^d) {g : (Fin n → ℝ) → ℝ} (hg : DifferentiableAt ℝ g 0) (hg0 : g 0 = 0) (hD : fderiv ℝ g 0 = 0) (x : ℝ) (y : Fin n → ℝ) : Tendsto (fun t : ℝ => eval (Fin.cons (g (t • y) + t*x) (t • y)) F / t^d) (𝓝[>] 0) (𝓝 (c*x^d)) := by let z : ℝ → (Fin (n+1) → ℝ) := fun t => Fin.cons (x + g (t • y)/t) y have hratio := flat_shift_div_tendsto_zero hg hg0 hD y have hz : Tendsto z (𝓝[>] 0) (𝓝 (Fin.cons x y)) := by apply tendsto_pi_nhds.mpr intro i refine Fin.cases ?_ (fun j => ?_) i · simpa only [z, Fin.cons_zero, add_zero] using (tendsto_const_nhds.add hratio : Tendsto (fun t => x + g (t • y)/t) (𝓝[>] 0) (𝓝 (x+0))) · exact tendsto_const_nhds have hlim := initial_tendsto_moving_argument hp d hlow z (Fin.cons x y) hz simp only [hpure, Fin.cons_zero] at hlim apply hlim.congr' filter_upwards [self_mem_nhdsWithin] with t ht have he : t • z t = Fin.cons (g (t • y) + t*x) (t • y) := by funext i refine Fin.cases ?_ (fun j => ?_) i · simp only [z, Pi.smul_apply, Fin.cons_zero, smul_eq_mul] field_simp [(show 0 < t from ht).ne'] ring · rfl simp only [zero_add, he, smul_eq_mul, div_eq_mul_inv, mul_comm] /-- Analytic form of the flat-shift preservation theorem. -/ theorem analytic_normal_shift_pure_initial_limit {n : ℕ} (F : MvPolynomial (Fin (n+1)) ℝ) {p : FormalMultilinearSeries ℝ (Fin (n+1) → ℝ) ℝ} (hp : HasFPowerSeriesAt (fun z => eval z F) p 0) (d : ℕ) (c : ℝ) (hlow : ∀ k < d, ∀ z, p k (fun _ => z) = 0) (hpure : ∀ z, p d (fun _ => z) = c * (z 0)^d) {g : (Fin n → ℝ) → ℝ} (hg : AnalyticAt ℝ g 0) (hg0 : g 0 = 0) (hD : fderiv ℝ g 0 = 0) (x : ℝ) (y : Fin n → ℝ) : Tendsto (fun t : ℝ => eval (Fin.cons (g (t • y) + t*x) (t • y)) F / t^d) (𝓝[>] 0) (𝓝 (c*x^d)) := normal_shift_pure_initial_limit F hp d c hlow hpure hg.differentiableAt hg0 hD x y end end Source29PureInitialFlatShift /- Component: RealInitialRescaling.inc -/ namespace Source29RealInitialRescaling open MvPolynomial Filter open Source29RealLowestRescale open scoped Topology noncomputable section /-- Real polynomial initial rescaling is jointly continuous in scale and direction. -/ theorem continuous_eval_rescale_joint {n : ℕ} (F : MvPolynomial (Fin n) ℝ) (d : ℕ) : Continuous (fun z : ℝ × (Fin n → ℝ) => eval z.2 (rescale F d z.1)) := by simp only [rescale, map_sum, map_mul, eval_C] apply continuous_finsetSum intro k hk exact (continuous_fst.pow (k-d)).mul ((Source29CompactPolynomialLink.continuous_eval _).comp continuous_snd) /-- Vanishing lower homogeneous components give the initial polynomial as the normalized limit along every convergent family of directions. No degree bound or chosen analytic power series is required. -/ theorem eval_dilate_div_pow_tendsto_moving {n : ℕ} (F : MvPolynomial (Fin n) ℝ) (d : ℕ) (hlow : ∀ k < d, homogeneousComponent k F = 0) (z : ℝ → (Fin n → ℝ)) (z₀ : Fin n → ℝ) (hz : Tendsto z (𝓝[>] 0) (𝓝 z₀)) : Tendsto (fun t : ℝ => eval (t • z t) F / t^d) (𝓝[>] 0) (𝓝 (eval z₀ (homogeneousComponent d F))) := by have ht0 : Tendsto (fun t : ℝ => t) (𝓝[>] 0) (𝓝 0) := tendsto_id.mono_left nhdsWithin_le_nhds have hpair := ht0.prodMk_nhds hz have ht := ((continuous_eval_rescale_joint F d).tendsto (0,z₀)).comp hpair simp only [rescale_zero F d hlow] at ht apply ht.congr' filter_upwards [self_mem_nhdsWithin] with t ht have he := eval_rescale_mul F d hlow t (z t) change t^d * eval (z t) (rescale F d t) = eval (t • z t) F at he exact (eq_div_iff (pow_ne_zero d (show 0 < t from ht).ne')).mpr (by simpa only [Function.comp_apply, mul_comm] using he) end end Source29RealInitialRescaling /- Component: PolynomialPureInitialShift.inc -/ namespace Source29PolynomialPureInitialShift open MvPolynomial Filter open scoped Topology noncomputable section /-- A pure normal homogeneous component survives an ordinary dilation after any flat differentiable normal shift. All hypotheses are stated directly for the polynomial and the shift. -/ theorem normal_shift_pure_initial_limit {n : ℕ} (F : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (c : ℝ) (hlow : ∀ k < d, homogeneousComponent k F = 0) (hpure : homogeneousComponent d F = C c * (X 0)^d) {g : (Fin n → ℝ) → ℝ} (hg : DifferentiableAt ℝ g 0) (hg0 : g 0 = 0) (hD : fderiv ℝ g 0 = 0) (x : ℝ) (y : Fin n → ℝ) : Tendsto (fun t : ℝ => eval (Fin.cons (g (t • y) + t*x) (t • y)) F / t^d) (𝓝[>] 0) (𝓝 (c*x^d)) := by let z : ℝ → (Fin (n+1) → ℝ) := fun t => Fin.cons (x + g (t • y)/t) y have hratio := Source29PureInitialFlatShift.flat_shift_div_tendsto_zero hg hg0 hD y have hz : Tendsto z (𝓝[>] 0) (𝓝 (Fin.cons x y)) := by apply tendsto_pi_nhds.mpr intro i refine Fin.cases ?_ (fun j => ?_) i · simpa only [z, Fin.cons_zero, add_zero] using (tendsto_const_nhds.add hratio : Tendsto (fun t => x + g (t • y)/t) (𝓝[>] 0) (𝓝 (x+0))) · exact tendsto_const_nhds have hlim := Source29RealInitialRescaling.eval_dilate_div_pow_tendsto_moving F d hlow z (Fin.cons x y) hz simp only [hpure, map_mul, map_pow, eval_C, eval_X, Fin.cons_zero] at hlim apply hlim.congr' filter_upwards [self_mem_nhdsWithin] with t ht have he : t • z t = Fin.cons (g (t • y) + t*x) (t • y) := by funext i refine Fin.cases ?_ (fun j => ?_) i · simp only [z, Pi.smul_apply, Fin.cons_zero, smul_eq_mul] field_simp [(show 0 < t from ht).ne'] ring · rfl rw [he] /-- Analytic specialization of polynomial initial-form preservation. -/ theorem analytic_normal_shift_pure_initial_limit {n : ℕ} (F : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (c : ℝ) (hlow : ∀ k < d, homogeneousComponent k F = 0) (hpure : homogeneousComponent d F = C c * (X 0)^d) {g : (Fin n → ℝ) → ℝ} (hg : AnalyticAt ℝ g 0) (hg0 : g 0 = 0) (hD : fderiv ℝ g 0 = 0) (x : ℝ) (y : Fin n → ℝ) : Tendsto (fun t : ℝ => eval (Fin.cons (g (t • y) + t*x) (t • y)) F / t^d) (𝓝[>] 0) (𝓝 (c*x^d)) := normal_shift_pure_initial_limit F d c hlow hpure hg.differentiableAt hg0 hD x y end end Source29PolynomialPureInitialShift /- Component: NewtonRegularFactorPositivity.inc -/ namespace Source29NewtonRegularFactorPositivity open MvPolynomial Filter open Source29NewtonShiftedFactorCoefficient Source29NormalShiftDerivatives open Source29NormalShiftAlgebra open scoped Topology noncomputable section variable {n : ℕ} /-- The first nonzero normal degree equals the multiplicity of a full irreducible factor once all lower normal coefficient germs vanish. -/ theorem multiplicity_eq_initial_degree (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k d : ℕ) (hF : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (g : (Fin n → ℝ) → ℝ) (hg : ContinuousAt g 0) (hroot : ∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) P = 0) (hn : eval (Fin.cons (g 0) 0) (pderiv 0 P) ≠ 0) (htop : (shiftedSlice F (g 0) 0).coeff d ≠ 0) (hlower : ∀ j : Fin d, ∀ᶠ y in 𝓝 0, (shiftedSlice F (g y) y).coeff (j:ℕ) = 0) : d = k := by have hroot0 : eval (Fin.cons (g 0) 0) P = 0 := hroot.self_of_nhds have hk : k ≤ d := by by_contra h exact htop (coeff_shifted_factor_eq_zero_of_lt F P Q k hF (g 0) 0 hroot0 d (Nat.lt_of_not_ge h)) have hd : d ≤ k := by by_contra h have hkd : k < d := Nat.lt_of_not_ge h exact (coefficient_not_eventually_zero F P Q k hF hP hPQ g 0 hg hroot hn) (hlower ⟨k,hkd⟩) exact le_antisymm hd hk /-- At a regular full-multiplicity factor point, a pure ordinary shifted initial form and the leading/background equations force strict cofactor positivity. They also identify the initial degree and scalar coefficient. -/ theorem cofactor_pos_and_degree (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : Odd k) (hfac : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (hg0 : gradient g 0 = 0) (hroot : ∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) P = 0) (hn : 0 < eval (Fin.cons (g 0) 0) (pderiv 0 P)) (hQ : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) Q) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (hbg : ∀ᶠ y in 𝓝 0, backgroundGraphOperator (gradient g y) (hessian g y) = 0) (d : ℕ) (c : ℝ) (hc : c ≠ 0) (hinitial : ∀ x y, Tendsto (fun t : ℝ ↦ eval (Fin.cons (g (t•y)+t*x) (t•y)) F / t^d) (𝓝[>] 0) (𝓝 (c*x^d))) : 0 < eval (Fin.cons (g 0) 0) Q ∧ d = k ∧ c = (eval (Fin.cons (g 0) 0) (pderiv 0 P))^k * eval (Fin.cons (g 0) 0) Q := by obtain ⟨hpos,hneg⟩ := Source29NewtonShiftedLocalSigns.factor_halfspace_signs F P Q k hk hfac g 0 hg hroot hn hQ have hlower := Source29NewtonRegularObstruction.lower_coefficient_germs_zero F g hg hg0 hF hbg d c hc hinitial hpos hneg have htop := Source29NewtonInitialCenterCoefficient.center_coefficient_of_pure_initial F g d c hinitial have hdk := multiplicity_eq_initial_degree F P Q k d hfac hP hPQ g hg.continuousAt hroot hn.ne' (by rwa [htop]) hlower have hformula : c = (eval (Fin.cons (g 0) 0) (pderiv 0 P))^k * eval (Fin.cons (g 0) 0) Q := by rw [← htop, hdk] exact coeff_shifted_factor F P Q k hfac (g 0) 0 hroot.self_of_nhds have hQnonneg : 0 ≤ eval (Fin.cons (g 0) 0) Q := by simpa only [Prod.fst_zero, Prod.snd_zero, add_zero] using hQ.self_of_nhds have hQne : eval (Fin.cons (g 0) 0) Q ≠ 0 := by intro hz apply hc rw [hformula, hz, mul_zero] exact ⟨lt_of_le_of_ne hQnonneg hQne.symm, hdk, hformula⟩ end end Source29NewtonRegularFactorPositivity /- Component: RegularBranchBackgroundEquation.inc -/ namespace Source29RegularBranchBackgroundEquation open MvPolynomial Filter open Source29NormalShiftDerivatives Source29NormalShiftAlgebra open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- Embed tangential coordinates into the zero normal hyperplane. -/ def zeroNormal : (Fin n → ℝ) →L[ℝ] (Fin (n+1) → ℝ) := ContinuousLinearMap.pi (fun i ↦ Fin.cases 0 (fun j ↦ ContinuousLinearMap.proj j) i) lemma zeroNormal_eq (y : Fin n → ℝ) : zeroNormal y = Fin.cons 0 y := by funext i exact Fin.cases rfl (fun j ↦ rfl) i lemma tail_zeroNormal (y : Fin n → ℝ) : tail (zeroNormal y) = y := rfl lemma zeroNormal_basis (i : Fin n) : zeroNormal (basis i) = basis i.succ := by funext j refine Fin.cases ?_ (fun k ↦ ?_) j · simp [zeroNormal, basis] · simp [zeroNormal, basis, Pi.single_apply] lemma chart_zeroNormal (g : (Fin n → ℝ) → ℝ) (y : Fin n → ℝ) : chart g (zeroNormal y) = Fin.cons (g y) y := by rw [chart_eq, tail_zeroNormal] simp only [zeroNormal, ContinuousLinearMap.pi_apply, Fin.cases_zero, zero_apply, zero_add] lemma first_zero_germ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] (f : E → ℝ) (x v : E) (hz : f =ᶠ[𝓝 x] fun _ ↦ 0) : fderiv ℝ f x v = 0 := by rw [hz.fderiv_eq] simp only [fderiv_const_apply, zero_apply] lemma second_zero_germ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] (f : E → ℝ) (x u v : E) (hz : f =ᶠ[𝓝 x] fun _ ↦ 0) : second f x u v = 0 := by have he : (fun y ↦ fderiv ℝ f y v) =ᶠ[𝓝 x] fun _ ↦ 0 := by filter_upwards [hz.fderiv (𝕜 := ℝ)] with y hy simpa only [fderiv_const_apply, zero_apply] using congrArg (fun L ↦ L v) hy exact first_zero_germ (fun y ↦ fderiv ℝ f y v) x u he /-- The restriction to a root branch has zero tangential first and second jets. -/ theorem tangential_jets_zero (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0) : (∀ i : Fin n, gradient (pullback P g) (zeroNormal a) i.succ = 0) ∧ (∀ i j : Fin n, hessian (pullback P g) (zeroNormal a) i.succ j.succ = 0) := by have ha : AnalyticAt ℝ (pullback P g) (zeroNormal a) := analyticAt_pullback P g _ hg have hz : (fun y ↦ pullback P g (zeroNormal y)) =ᶠ[𝓝 a] fun _ ↦ 0 := by filter_upwards [hroot] with y hy simpa only [pullback, chart_zeroNormal] using hy constructor · intro i have he := first_linear (pullback P g) zeroNormal a (basis i) ha.differentiableAt rw [zeroNormal_basis] at he exact he.symm.trans (first_zero_germ _ a (basis i) hz) · intro i j have he := second_linear (pullback P g) zeroNormal a (basis i) (basis j) ha rw [zeroNormal_basis, zeroNormal_basis] at he exact he.symm.trans (second_zero_germ _ a (basis i) (basis j) hz) /-- Divisibility of the cubic level operator makes every regular analytic root branch a solution of the minimal-graph equation. -/ theorem background_at_of_dvd (P : MvPolynomial (Fin (n+1)) ℝ) (hdiv : P ∣ Source29QuarticReuse.QuarticMinimal.leadingOperator P) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0) (hn : eval (Fin.cons (g a) a) (pderiv 0 P) ≠ 0) : backgroundGraphOperator (gradient g a) (hessian g a) = 0 := by have heval : eval (chart g (zeroNormal a)) (Source29QuarticReuse.QuarticMinimal.leadingOperator P) = 0 := by obtain ⟨R,hR⟩ := hdiv rw [hR, map_mul, chart_zeroNormal, hroot.self_of_nhds, zero_mul] obtain ⟨hB,hU⟩ := tangential_jets_zero P g a hg hroot have hA : gradient (pullback P g) (zeroNormal a) 0 = eval (Fin.cons (g a) a) (pderiv 0 P) := by rw [gradient_pullback_zero P g (zeroNormal a) hg, gradient_eval, chart_zeroNormal] have he := polynomial_cubicLevel_transform P g (zeroNormal a) hg dsimp only at he rw [cubicLevel_eval, heval] at he simp only [hB, hU, tail_zeroNormal, newtonResidual, correction, traceComplement, dot, trace, bilinear, mul_zero, zero_mul, Finset.sum_const_zero, zero_sub, sub_zero, add_zero, zero_pow (by decide : (2 : ℕ) ≠ 0)] at he have hprod : (gradient (pullback P g) (zeroNormal a) 0)^3 * backgroundGraphOperator (gradient g a) (hessian g a) = 0 := by linarith exact (mul_eq_zero.mp hprod).resolve_left (pow_ne_zero 3 (by rwa [hA])) /-- Local analyticity, regularity, and the branch equation yield the background PDE throughout a neighborhood of the base tangential point. -/ theorem eventually_background_of_dvd (P : MvPolynomial (Fin (n+1)) ℝ) (hdiv : P ∣ Source29QuarticReuse.QuarticMinimal.leadingOperator P) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0) (hn : eval (Fin.cons (g a) a) (pderiv 0 P) ≠ 0) : ∀ᶠ y in 𝓝 a, backgroundGraphOperator (gradient g y) (hessian g y) = 0 := by have hgraph : ContinuousAt (fun y : Fin n → ℝ ↦ (Fin.cons (g y) y : Fin (n+1) → ℝ)) a := by apply continuousAt_pi.mpr intro i exact Fin.cases hg.continuousAt (fun j ↦ (continuous_apply j).continuousAt) i have hnormal : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) (pderiv 0 P) ≠ 0 := ((Source29PolynomialLinkChart.analyticAt_eval_real (pderiv 0 P) _).continuousAt.comp hgraph).eventually_ne hn filter_upwards [hg.eventually_analyticAt, hroot.eventually_nhds, hnormal] with y hgy hry hny exact background_at_of_dvd P hdiv g y hgy hry hny end end Source29RegularBranchBackgroundEquation /- Component: NewtonRegularFactorCriterion.inc -/ namespace Source29NewtonRegularFactorCriterion open MvPolynomial Filter open Source29NormalShiftDerivatives Source29NormalShiftAlgebra open scoped Topology noncomputable section variable {n : ℕ} /-- Cubic factor inheritance supplies the background graph equation of every regular analytic branch of a full-multiplicity irreducible factor. -/ theorem background_of_full_factor (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : 1 ≤ k) (hfac : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0) (hn : eval (Fin.cons (g a) a) (pderiv 0 P) ≠ 0) : ∀ᶠ y in 𝓝 a, backgroundGraphOperator (gradient g y) (hessian g y) = 0 := by have hcub : Source29FactorInheritance.cubicOperator (P^k*Q) = 0 := by change Source29QuarticReuse.QuarticMinimal.leadingOperator (P^k*Q) = 0 rwa [← hfac] have hdiv : P ∣ Source29QuarticReuse.QuarticMinimal.leadingOperator P := Source29RealLeadingFactor.real_factor_inheritance P Q k hk hP hPQ hcub exact Source29RegularBranchBackgroundEquation.eventually_background_of_dvd P hdiv g a hg hroot hn /-- A pure ordinary shifted initial form forces positive residual cofactor at a regular factor point. The background PDE is derived from the leading polynomial equation and full multiplicity, rather than assumed. -/ theorem cofactor_pos_of_pure_initial (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : Odd k) (hfac : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (hg0 : gradient g 0 = 0) (hroot : ∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) P = 0) (hn : 0 < eval (Fin.cons (g 0) 0) (pderiv 0 P)) (hQ : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) Q) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (d : ℕ) (c : ℝ) (hc : c ≠ 0) (hinitial : ∀ x y, Tendsto (fun t : ℝ ↦ eval (Fin.cons (g (t•y)+t*x) (t•y)) F / t^d) (𝓝[>] 0) (𝓝 (c*x^d))) : 0 < eval (Fin.cons (g 0) 0) Q ∧ d = k ∧ c = (eval (Fin.cons (g 0) 0) (pderiv 0 P))^k * eval (Fin.cons (g 0) 0) Q := by have hbg := background_of_full_factor F P Q k hk.pos hfac hP hPQ hF g 0 hg hroot hn.ne' exact Source29NewtonRegularFactorPositivity.cofactor_pos_and_degree F P Q k hk hfac hP hPQ g hg hg0 hroot hn hQ hF hbg d c hc hinitial end end Source29NewtonRegularFactorCriterion /- Component: NewtonRegularInitialFormPositivity.inc -/ namespace Source29NewtonRegularInitialFormPositivity open MvPolynomial Filter open Source29NormalShiftDerivatives open scoped Topology noncomputable section variable {n : ℕ} /-- The regular-factor positivity criterion stated entirely in terms of actual polynomial homogeneous components and a flat analytic root branch. The background equation and the shifted initial limit are both derived. -/ theorem cofactor_pos_of_pure_homogeneous_initial (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : Odd k) (hfac : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (hg0 : g 0 = 0) (hD : fderiv ℝ g 0 = 0) (hroot : ∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) P = 0) (hn : 0 < eval (0 : Fin (n+1) → ℝ) (pderiv 0 P)) (hQ : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) Q) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (d : ℕ) (c : ℝ) (hc : c ≠ 0) (hlow : ∀ j < d, homogeneousComponent j F = 0) (hpure : homogeneousComponent d F = C c * (X 0)^d) : 0 < eval (0 : Fin (n+1) → ℝ) Q ∧ d = k ∧ c = (eval (0 : Fin (n+1) → ℝ) (pderiv 0 P))^k * eval (0 : Fin (n+1) → ℝ) Q := by have hgrad : gradient g 0 = 0 := by funext i change fderiv ℝ g 0 (basis i) = 0 rw [hD] rfl have hbase : (Fin.cons (g 0) 0 : Fin (n+1) → ℝ) = 0 := by rw [hg0] funext i exact Fin.cases rfl (fun j ↦ rfl) i have hn' : 0 < eval (Fin.cons (g 0) 0) (pderiv 0 P) := by rwa [hbase] have ht := Source29NewtonRegularFactorCriterion.cofactor_pos_of_pure_initial F P Q k hk hfac hP hPQ g hg hgrad hroot hn' hQ hF d c hc (Source29PolynomialPureInitialShift.analytic_normal_shift_pure_initial_limit F d c hlow hpure hg hg0 hD) simpa only [hbase] using ht /-- Local ambient nonnegativity of the cofactor suffices for the same criterion; the needed shifted sign condition follows by continuity. -/ theorem cofactor_pos_of_ambient_nonneg (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : Odd k) (hfac : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (hg0 : g 0 = 0) (hD : fderiv ℝ g 0 = 0) (hroot : ∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) P = 0) (hn : 0 < eval (0 : Fin (n+1) → ℝ) (pderiv 0 P)) (hQ : ∀ᶠ z : Fin (n+1) → ℝ in 𝓝 0, 0 ≤ eval z Q) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (d : ℕ) (c : ℝ) (hc : c ≠ 0) (hlow : ∀ j < d, homogeneousComponent j F = 0) (hpure : homogeneousComponent d F = C c * (X 0)^d) : 0 < eval (0 : Fin (n+1) → ℝ) Q ∧ d = k ∧ c = (eval (0 : Fin (n+1) → ℝ) (pderiv 0 P))^k * eval (0 : Fin (n+1) → ℝ) Q := by have hchart : Tendsto (fun z : ℝ × (Fin n → ℝ) ↦ (Fin.cons (g z.2+z.1) z.2 : Fin (n+1) → ℝ)) (𝓝 0) (𝓝 0) := by apply tendsto_pi_nhds.mpr intro i refine Fin.cases ?_ (fun j ↦ ?_) i · have hsnd : Tendsto (Prod.snd : ℝ × (Fin n → ℝ) → (Fin n → ℝ)) (𝓝 0) (𝓝 0) := continuous_snd.tendsto 0 have hfst : Tendsto (Prod.fst : ℝ × (Fin n → ℝ) → ℝ) (𝓝 0) (𝓝 0) := continuous_fst.tendsto 0 have ht := (hg.continuousAt.tendsto.comp hsnd).add hfst simpa only [hg0, zero_add, Pi.zero_apply, Fin.cons_zero, Function.comp_apply] using ht · exact ((continuous_apply j).comp continuous_snd).continuousAt.tendsto exact cofactor_pos_of_pure_homogeneous_initial F P Q k hk hfac hP hPQ g hg hg0 hD hroot hn (hchart.eventually hQ) hF d c hc hlow hpure end end Source29NewtonRegularInitialFormPositivity /- Component: FlatRegularGraph.inc -/ namespace Source29FlatRegularGraph open MvPolynomial Filter open Source29NormalShiftDerivatives Source29RegularBranchBackgroundEquation open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- Coordinate vanishing of the derivative is equivalent to vanishing of the whole continuous linear map on the finite coordinate space. -/ lemma fderiv_eq_zero_of_gradient_eq_zero (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (h : gradient g a = 0) : fderiv ℝ g a = 0 := by ext v have hv : v = ∑ i : Fin n, v i • Pi.single i (1 : ℝ) := by funext j simp [Pi.single_apply] have hi (i : Fin n) : fderiv ℝ g a (Pi.single i 1) = 0 := congrFun h i rw [hv, map_sum] simp only [map_smul, smul_eq_mul, hi, mul_zero, Finset.sum_const_zero, zero_apply] /-- A regular root branch has horizontal tangent when the polynomial's normal derivative is nonzero and all its tangential derivatives vanish. -/ theorem gradient_zero_of_regular_branch (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (hg0 : g 0 = 0) (hroot : ∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) P = 0) (hn : eval 0 (pderiv 0 P) ≠ 0) (ht : ∀ i : Fin n, eval 0 (pderiv i.succ P) = 0) : gradient g 0 = 0 := by have hbase : chart g (zeroNormal (0 : Fin n → ℝ)) = 0 := by rw [chart_zeroNormal, hg0] funext i exact Fin.cases rfl (fun j ↦ rfl) i funext i have he := (tangential_jets_zero P g 0 hg hroot).1 i rw [gradient_pullback_succ P g (zeroNormal 0) hg i, hbase, tail_zeroNormal, gradient_eval, gradient_eval, ht i, zero_add] at he exact (mul_eq_zero.mp he).resolve_right hn /-- Normal regularity and horizontal tangency produce an analytic root graph whose value and full first derivative vanish at the origin. -/ theorem exists_flat_local_graph (P : MvPolynomial (Fin (n+1)) ℝ) (hP : eval 0 P = 0) (hn : eval 0 (pderiv 0 P) ≠ 0) (ht : ∀ i : Fin n, eval 0 (pderiv i.succ P) = 0) : ∃ g : (Fin n → ℝ) → ℝ, AnalyticAt ℝ g 0 ∧ g 0 = 0 ∧ gradient g 0 = 0 ∧ fderiv ℝ g 0 = 0 ∧ (∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) P = 0) := by obtain ⟨g, hg, hg0, hroot⟩ := Source29RealImplicitPolynomialRoot.exists_local_level_graph P 0 hn change AnalyticAt ℝ g 0 at hg change g 0 = 0 at hg0 change ∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) P = eval 0 P at hroot rw [hP] at hroot have hgrad := gradient_zero_of_regular_branch P g hg hg0 hroot hn ht exact ⟨g, hg, hg0, hgrad, fderiv_eq_zero_of_gradient_eq_zero g 0 hgrad, hroot⟩ /-- Divisibility of the leading operator also gives the local minimal-graph background equation for the produced flat analytic graph. -/ theorem exists_flat_local_minimal_graph (P : MvPolynomial (Fin (n+1)) ℝ) (hP : eval 0 P = 0) (hn : eval 0 (pderiv 0 P) ≠ 0) (ht : ∀ i : Fin n, eval 0 (pderiv i.succ P) = 0) (hdiv : P ∣ Source29QuarticReuse.QuarticMinimal.leadingOperator P) : ∃ g : (Fin n → ℝ) → ℝ, AnalyticAt ℝ g 0 ∧ g 0 = 0 ∧ gradient g 0 = 0 ∧ fderiv ℝ g 0 = 0 ∧ (∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) P = 0) ∧ (∀ᶠ y in 𝓝 0, Source29NormalShiftAlgebra.backgroundGraphOperator (gradient g y) (hessian g y) = 0) := by obtain ⟨g,hg,hg0,hgrad,hD,hroot⟩ := exists_flat_local_graph P hP hn ht refine ⟨g,hg,hg0,hgrad,hD,hroot,?_⟩ apply eventually_background_of_dvd P hdiv g 0 hg hroot have he : (Fin.cons (g 0) (0 : Fin n → ℝ) : Fin (n+1) → ℝ) = 0 := by rw [hg0] funext i exact Fin.cases rfl (fun j ↦ rfl) i rwa [he] end end Source29FlatRegularGraph /- Component: RegularFactorPureInitialCriterion.inc -/ namespace Source29RegularFactorPureInitialCriterion open MvPolynomial Filter open scoped Topology noncomputable section variable {n : ℕ} /-- At a regular factor point in normal coordinates, a pure ordinary initial form forces strict residual positivity. The analytic branch, its flatness, its minimal equation, the weighted face, and the limiting Newton equation are all derived inside the proof. -/ theorem cofactor_pos_of_pure_initial (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : Odd k) (hfac : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (hP0 : eval (0 : Fin (n+1) → ℝ) P = 0) (hn : 0 < eval (0 : Fin (n+1) → ℝ) (pderiv 0 P)) (ht : ∀ i : Fin n, eval (0 : Fin (n+1) → ℝ) (pderiv i.succ P) = 0) (hQ : ∀ᶠ z : Fin (n+1) → ℝ in 𝓝 0, 0 ≤ eval z Q) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (d : ℕ) (c : ℝ) (hc : c ≠ 0) (hlow : ∀ j < d, homogeneousComponent j F = 0) (hpure : homogeneousComponent d F = C c * (X 0)^d) : 0 < eval (0 : Fin (n+1) → ℝ) Q ∧ d = k ∧ c = (eval (0 : Fin (n+1) → ℝ) (pderiv 0 P))^k * eval (0 : Fin (n+1) → ℝ) Q := by obtain ⟨g,hg,hg0,_,hD,hroot⟩ := Source29FlatRegularGraph.exists_flat_local_graph P hP0 hn.ne' ht exact Source29NewtonRegularInitialFormPositivity.cofactor_pos_of_ambient_nonneg F P Q k hk hfac hP hPQ g hg hg0 hD hroot hn hQ hF d c hc hlow hpure end end Source29RegularFactorPureInitialCriterion /- Component: HalfspacePhaseMass.inc -/ namespace Source29HalfspacePhaseMass open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29WeakCalibrationLimits Source29NonlinearCalibration Source29PhaseMassLimit open Source29PhaseApproximation Source29SmoothPhaseTransition Source29CoordinatePhaseMass open Source29CoordinateHalfspaceFlux Source29VariationConvexity Source29SmoothCalibrationRecovery open scoped Topology BigOperators noncomputable section variable {n : ℕ} lemma coordinate_weakCalibration : WeakCalibration (leadingNormalizedField (X (0 : Fin (n+1)) : MvPolynomial (Fin (n+1)) ℝ)) := by have hn : leadingNormalizedField (X (0 : Fin (n+1)) : MvPolynomial (Fin (n+1)) ℝ) = (fun _ ↦ Pi.single 0 1) := funext normalizedField_X rw [hn] refine ⟨?_, ?_⟩ · intro x i simp only [Pi.single_apply] split_ifs <;> norm_num · intro ρ hρ hcρ refine ⟨testFlux_integrable _ hρ hcρ (fun _ ↦ continuous_const), ?_⟩ exact integral_testFlux_eq_zero _ hρ hcρ (fun _ ↦ contDiff_const) (fun x ↦ by simp [divergence]) lemma coordinate_gradient_density (x : Fin (n+1) → ℝ) : variationDensity (evaluatedGradient (X (0 : Fin (n+1)) : MvPolynomial (Fin (n+1)) ℝ) x) = 1 := by simp [variationDensity, evaluatedGradient, pderiv_X, Pi.single_apply, eq_comm] /-- Product rule with a transition in the normal coordinate and an arbitrary field. -/ lemma coordinate_product_flux (Z : (Fin (n+1) → ℝ) → Fin (n+1) → ℝ) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) (x : Fin (n+1) → ℝ) : testFlux (fun i ↦ Pi.single i 1) (fun y ↦ ρ y * h (y 0)) Z x = h (x 0) * testFlux (fun i ↦ Pi.single i 1) ρ Z x + ρ x * deriv h (x 0) * Z x 0 := by have he := fun i ↦ composed_product_fderiv (X (0 : Fin (n+1)) : MvPolynomial (Fin (n+1)) ℝ) hρ hh x i simp only [eval_X, evaluatedGradient, pderiv_X] at he simp only [Pi.single_apply, apply_ite (eval x), map_one, map_zero] at he simp only [testFlux, he, add_mul, Finset.sum_add_distrib, mul_assoc] rw [← Finset.mul_sum] simp /-- Testing the weak calibration with a coordinate transition gives an exact cross-flux identity, without a trace assumption on the field. -/ theorem coordinate_cross_flux_identity (Z : (Fin (n+1) → ℝ) → Fin (n+1) → ℝ) (hZ : WeakCalibration Z) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) {h : ℝ → ℝ} (hh : ContDiff ℝ 1 h) (hb : ∀ t, ‖h t‖ ≤ 1) : Integrable (fun x ↦ ρ x * deriv h (x 0) * Z x 0) ∧ (∫ x, ρ x * deriv h (x 0) * Z x 0) = -(∫ x, testFlux (fun i ↦ Pi.single i 1) ρ Z x * h (x 0)) := by have hw : Integrable (fun x ↦ testFlux (fun i ↦ Pi.single i 1) ρ Z x * h (x 0)) := ((hZ.2 ρ hρ hcρ).1).mul_bdd (hh.continuous.comp (continuous_apply 0)).aestronglyMeasurable (Filter.Eventually.of_forall (fun x ↦ hb (x 0))) have ht : ContDiff ℝ 1 (fun x : Fin (n+1) → ℝ ↦ ρ x * h (x 0)) := hρ.mul (hh.comp (by simpa only [eval_X] using (contDiff_eval (X (0 : Fin (n+1)) : MvPolynomial (Fin (n+1)) ℝ)))) have hp := hZ.2 _ ht hcρ.mul_right have he : (fun x ↦ ρ x * deriv h (x 0) * Z x 0) = (fun x ↦ testFlux (fun i ↦ Pi.single i 1) (fun y ↦ ρ y * h (y 0)) Z x - testFlux (fun i ↦ Pi.single i 1) ρ Z x * h (x 0)) := by funext x rw [coordinate_product_flux Z hρ hh] ring refine ⟨he ▸ hp.1.sub hw, ?_⟩ rw [he, integral_sub hp.1 hw, hp.2, zero_sub] /-- A bounded divergence-free field has at most plane flux through a halfspace. -/ theorem coordinate_flux_le_plane (Z : (Fin (n+1) → ℝ) → Fin (n+1) → ℝ) (hZ : WeakCalibration Z) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) : -(∫ x, testFlux (fun i ↦ Pi.single i 1) ρ Z x * (if 0 < x 0 then 1 else 0)) ≤ ∫ y : Fin n → ℝ, ρ (Fin.cons 0 y) := by have hleft := (transition_weighted_integral (X (0 : Fin (n+1)) : MvPolynomial (Fin (n+1)) ℝ) (X_ne_zero 0) (testFlux (fun i ↦ Pi.single i 1) ρ Z) (hZ.2 ρ hρ hcρ).1).neg simp only [eval_X] at hleft have hright := phaseMass_tendsto (X (0 : Fin (n+1)) : MvPolynomial (Fin (n+1)) ℝ) (X_ne_zero 0) coordinate_weakCalibration hρ hcρ simp only [eval_X, coordinate_gradient_density, mul_one, phaseMass_X hρ hcρ] at hright apply le_of_tendsto_of_tendsto hleft hright apply Filter.Eventually.of_forall intro k have hc := coordinate_cross_flux_identity Z hZ hρ hcρ (transition_contDiff k) (transition_norm_le_one k) dsimp only rw [← hc.2] apply integral_mono hc.1 ((hρ.continuous.mul ((transition_contDiff k).continuous_deriv_one.comp (continuous_apply 0))).integrable_of_hasCompactSupport hcρ.mul_right) intro x exact mul_le_of_le_one_right (mul_nonneg (hρpos x) (transition_deriv_nonneg k _)) ((le_abs_self (Z x 0)).trans (by simpa only [Real.norm_eq_abs] using hZ.1 x 0)) lemma positive_phase_eq_halfspace_ae (P : MvPolynomial (Fin (n+1)) ℝ) (hP : P ≠ 0) (hpos : ∀ x : Fin (n+1) → ℝ, 0 < x 0 → 0 ≤ eval x P) (hneg : ∀ x : Fin (n+1) → ℝ, x 0 < 0 → eval x P ≤ 0) : (fun x ↦ if 0 < eval x P then (1 : ℝ) else 0) =ᵐ[volume] (fun x ↦ if 0 < x 0 then (1 : ℝ) else 0) := by filter_upwards [mvPolynomial_eval_ne_zero_ae (n+1) P hP, mvPolynomial_eval_ne_zero_ae (n+1) (X (0 : Fin (n+1)) : MvPolynomial (Fin (n+1)) ℝ) (X_ne_zero 0)] with x hp hx simp only [eval_X] at hx rcases lt_or_gt_of_ne hx with hn | hp0 · simp only [not_lt_of_ge (hneg x hn), not_lt_of_ge hn.le, ite_false] · simp only [lt_of_le_of_ne (hpos x hp0) (Ne.symm hp), hp0, ite_true] /-- A calibrated polynomial whose strict positive phase agrees almost everywhere with the coordinate halfspace has exactly the plane mass. -/ theorem phaseMass_eq_plane_of_phase_ae (P : MvPolynomial (Fin (n+1)) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (hphase : (fun x ↦ if 0 < eval x P then (1 : ℝ) else 0) =ᵐ[volume] (fun x ↦ if 0 < x 0 then (1 : ℝ) else 0)) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) : phaseMass P ρ = ∫ y : Fin n → ℝ, ρ (Fin.cons 0 y) := by apply le_antisymm · have he : phaseMass P ρ = -(∫ x, testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField P) x * (if 0 < x 0 then 1 else 0)) := by unfold phaseMass congr 1 apply integral_congr_ae filter_upwards [hphase] with x hx rw [hx] rw [he] exact coordinate_flux_le_plane _ hcal hρ hcρ hρpos · let V : (Fin (n+1) → ℝ) → Fin (n+1) → ℝ := cutoffField ρ (fun _ ↦ Pi.single 0 1) have hV i : ContDiff ℝ 1 (fun x ↦ V x i) := hρ.mul contDiff_const have hcV i : HasCompactSupport (fun x ↦ V x i) := hcρ.mul_right have hbV x : variationDensity (V x) ≤ ρ x := by simp [V, cutoffField, variationDensity, Pi.single_apply, Real.sqrt_sq_eq_abs, abs_of_nonneg (hρpos x)] have hdV x : divergence (fun i ↦ Pi.single i 1) V x = fderiv ℝ ρ x (Pi.single 0 1) := by change divergence (fun i ↦ Pi.single i 1) (cutoffField ρ (fun _ ↦ Pi.single 0 1)) x = _ rw [divergence_cutoffField (A := fun _ : Fin (n+1) → ℝ ↦ Pi.single 0 1) hρ (fun _ ↦ contDiff_const) x] simp [testFlux, divergence, Pi.single_apply] have hb := phase_divergence_le_mass P hP hcal hρ hcρ V hV hcV hbV have he : (∫ x, (if 0 < eval x P then (1 : ℝ) else 0) * divergence (fun i ↦ Pi.single i 1) V x) = ∫ x, fderiv ℝ ρ x (Pi.single 0 1) * (if 0 < x 0 then 1 else 0) := by apply integral_congr_ae filter_upwards [hphase] with x hx rw [hx, hdV, mul_comm] rw [he] at hb have hplane := coordinate_halfspace_flux hρ hcρ rw [← hplane] exact (neg_le_abs _).trans hb /-- Weak halfspace signs suffice: additional polynomial zeros have measure zero. Homogeneity and a pointwise trace of the normalized field are not required. -/ theorem phaseMass_eq_plane (P : MvPolynomial (Fin (n+1)) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (hpos : ∀ x : Fin (n+1) → ℝ, 0 < x 0 → 0 ≤ eval x P) (hneg : ∀ x : Fin (n+1) → ℝ, x 0 < 0 → eval x P ≤ 0) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) : phaseMass P ρ = ∫ y : Fin n → ℝ, ρ (Fin.cons 0 y) := phaseMass_eq_plane_of_phase_ae P hP hcal (positive_phase_eq_halfspace_ae P hP hpos hneg) hρ hcρ hρpos /-- At unit scale every nonnegative radial cutoff gives exactly the mass of an n-dimensional plane. -/ theorem phaseMass_radial_eq_planeMass (P : MvPolynomial (Fin (n+1)) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) (hpos : ∀ x : Fin (n+1) → ℝ, 0 < x 0 → 0 ≤ eval x P) (hneg : ∀ x : Fin (n+1) → ℝ, x 0 < 0 → eval x P ≤ 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hfpos : ∀ s, 0 ≤ f s) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ s, R ≤ s → f s = 0) : phaseMass P (Source29LevelRadialStress.radialWeight f 1) = Source29PolynomialSmallDensity.planeMass n f := by rw [phaseMass_eq_plane P hP hcal hpos hneg (Source29LevelRadialStress.radialWeight_contDiff hf 1) (Source29LevelRadialStress.radialWeight_compact hR zero_lt_one hz) (fun x ↦ hfpos _)] unfold Source29PolynomialSmallDensity.planeMass apply integral_congr_ae exact Filter.Eventually.of_forall fun x ↦ by simp [Source29LevelRadialStress.radialWeight, radiusSq, Fin.sum_univ_succ] end end Source29HalfspacePhaseMass /- Component: HomogeneousLevelInfinity.inc -/ namespace Source29HomogeneousLevelInfinity open MvPolynomial MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29QuarticReuse.QuarticPolynomialBasics open Source29PolynomialTranslation Source29TopLocalInitial Source29WeakCalibrationLimits open Source29InitialGradientLimit Source29InitialPhaseFluxLimit open Source29PhaseMassLimit Source29PhaseMassDilation open Source29LevelRadialStress Source29LevelRadialMonotonicity open scoped Topology BigOperators noncomputable section variable {n : ℕ} lemma center_add_dilate (c x : Fin n → ℝ) {r : ℝ} (hr : r ≠ 0) : c + r • x = r • (x + r⁻¹ • c) := by rw [smul_add, smul_smul, mul_inv_cancel₀ hr, one_smul, add_comm] lemma shifted_direction_tendsto (c x : Fin n → ℝ) : Tendsto (fun r : ℝ => x + r⁻¹ • c) atTop (𝓝 x) := by have hc : Tendsto (fun r : ℝ => r⁻¹ • c) atTop (𝓝 (0 : Fin n → ℝ)) := by simpa only [zero_smul] using (tendsto_inv_atTop_zero : Tendsto (fun r : ℝ => r⁻¹) atTop (𝓝 0)).smul_const c simpa only [add_zero] using tendsto_const_nhds.add hc lemma normalizedField_sub_C (H : MvPolynomial (Fin n) ℝ) (t : ℝ) : leadingNormalizedField (H-C t) = leadingNormalizedField H := by have hg : evaluatedGradient (H-C t) = evaluatedGradient H := by funext x i simp [evaluatedGradient] funext x i simp only [leadingNormalizedField, hg] lemma normalizedField_homogeneous (H : MvPolynomial (Fin n) ℝ) (s : ℕ) (hH : H.IsHomogeneous (s+1)) {r : ℝ} (hr : 0 < r) (x : Fin n → ℝ) : leadingNormalizedField H (r • x) = leadingNormalizedField H x := by have hg : evaluatedGradient H (r • x) = r^s • evaluatedGradient H x := by funext i exact eval_dilate_homogeneous (pderiv i H) (isHomogeneous_pderiv_succ H i s hH) x r funext i simp only [leadingNormalizedField, hg, Pi.smul_apply, smul_eq_mul] exact normalized_ratio_pos_scale (evaluatedGradient H x) (pow_pos hr s) i lemma normalizedField_translated_level_scale (H : MvPolynomial (Fin n) ℝ) (s : ℕ) (hH : H.IsHomogeneous (s+1)) (t : ℝ) (c x : Fin n → ℝ) {r : ℝ} (hr : 0 < r) : leadingNormalizedField (translate (H-C t) c) (r • x) = leadingNormalizedField H (x + r⁻¹ • c) := by rw [leadingNormalizedField_translate, normalizedField_sub_C, center_add_dilate c x hr.ne', normalizedField_homogeneous H s hH hr] lemma normalizedField_continuousAt (H : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) (hx : evaluatedGradient H x ≠ 0) (i : Fin n) : ContinuousAt (fun y => leadingNormalizedField H y i) x := by have hg (j : Fin n) : Continuous (fun y => evaluatedGradient H y j) := (contDiff_eval (pderiv j H)).continuous have hs : Continuous (fun y => radiusSq (evaluatedGradient H y)) := continuous_finsetSum _ (fun j _ => (hg j).pow 2) exact (hg i).continuousAt.div hs.sqrt.continuousAt (Real.sqrt_pos.mpr (radiusSq_pos_of_ne_zero hx)).ne' lemma translated_level_normalizedField_atTop (H : MvPolynomial (Fin n) ℝ) (s : ℕ) (hH : H.IsHomogeneous (s+1)) (t : ℝ) (c x : Fin n → ℝ) (hx : evaluatedGradient H x ≠ 0) (i : Fin n) : Tendsto (fun r : ℝ => leadingNormalizedField (translate (H-C t) c) (r • x) i) atTop (𝓝 (leadingNormalizedField H x i)) := by have ht := (normalizedField_continuousAt H x hx i).tendsto.comp (shifted_direction_tendsto c x) apply ht.congr' filter_upwards [eventually_gt_atTop (0 : ℝ)] with r hr exact congrFun (normalizedField_translated_level_scale H s hH t c x hr).symm i lemma translated_level_eval_div (H : MvPolynomial (Fin n) ℝ) (d : ℕ) (hH : H.IsHomogeneous d) (t : ℝ) (c x : Fin n → ℝ) {r : ℝ} (hr : 0 < r) : eval (r • x) (translate (H-C t) c) / r^d = eval (x + r⁻¹ • c) H - t/r^d := by rw [eval_translate, map_sub, eval_C] change (eval (c + r • x) H-t)/r^d = _ rw [center_add_dilate c x hr.ne', eval_dilate_homogeneous H hH, sub_div, mul_div_cancel_left₀ _ (pow_ne_zero d hr.ne')] lemma translated_level_eval_div_atTop (H : MvPolynomial (Fin n) ℝ) (s : ℕ) (hH : H.IsHomogeneous (s+1)) (t : ℝ) (c x : Fin n → ℝ) : Tendsto (fun r : ℝ => eval (r • x) (translate (H-C t) c) / r^(s+1)) atTop (𝓝 (eval x H)) := by have hc := (contDiff_eval H).continuous.continuousAt.tendsto.comp (shifted_direction_tendsto c x) have ht : Tendsto (fun r : ℝ => t/r^(s+1)) atTop (𝓝 0) := by simpa only [div_eq_mul_inv, ← inv_pow, zero_pow (by omega : s+1 ≠ 0), mul_zero] using ((tendsto_inv_atTop_zero : Tendsto (fun r : ℝ => r⁻¹) atTop (𝓝 0)).pow (s+1)).const_mul t have hh := hc.sub ht simp only [sub_zero] at hh apply hh.congr' filter_upwards [eventually_gt_atTop (0 : ℝ)] with r hr exact (translated_level_eval_div H (s+1) hH t c x hr).symm lemma translated_level_phase_atTop (H : MvPolynomial (Fin n) ℝ) (s : ℕ) (hH : H.IsHomogeneous (s+1)) (t : ℝ) (c x : Fin n → ℝ) (hx : eval x H ≠ 0) : Tendsto (fun r : ℝ => if 0 < eval (r • x) (translate (H-C t) c) then (1 : ℝ) else 0) atTop (𝓝 (if 0 < eval x H then (1 : ℝ) else 0)) := by have hl := translated_level_eval_div_atTop H s hH t c x by_cases hp : 0 < eval x H · apply tendsto_const_nhds.congr' filter_upwards [hl.eventually (eventually_gt_nhds hp), eventually_gt_atTop (0 : ℝ)] with r hr hpos have hval : 0 < eval (r • x) (translate (H-C t) c) := (div_pos_iff_of_pos_right (pow_pos hpos (s+1))).mp hr simp only [hp, hval, ite_true] · have hn : eval x H < 0 := lt_of_le_of_ne (le_of_not_gt hp) hx apply tendsto_const_nhds.congr' filter_upwards [hl.eventually (eventually_lt_nhds hn), eventually_gt_atTop (0 : ℝ)] with r hr hpos have hval : ¬ 0 < eval (r • x) (translate (H-C t) c) := by intro hv exact (not_lt_of_ge hr.le) ((div_pos_iff_of_pos_right (pow_pos hpos (s+1))).mpr hv) simp only [hp, hval, ite_false] /-- The fixed-scale phase flux of every translated homogeneous level tends to the phase flux of the original homogeneous polynomial at large radius. -/ theorem phaseFlux_translated_level_atTop (H : MvPolynomial (Fin n) ℝ) (s : ℕ) (hH : H.IsHomogeneous (s+1)) (hHne : H ≠ 0) (t : ℝ) (c : Fin n → ℝ) {ρ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) : Tendsto (fun r : ℝ => -(∫ x, testFlux (fun i => Pi.single i 1) ρ (fun y => leadingNormalizedField (translate (H-C t) c) (r • y)) x * (if 0 < eval (r • x) (translate (H-C t) c) then 1 else 0))) atTop (𝓝 (phaseMass H ρ)) := by apply Tendsto.neg apply tendsto_integral_filter_of_dominated_convergence (testBound (fun i => Pi.single i 1) ρ) · exact Eventually.of_forall fun r => ((scaled_flux_measurable (translate (H-C t) c) r hρ).mul (scaled_phase_measurable (translate (H-C t) c) r)).aestronglyMeasurable · exact Eventually.of_forall fun r => Eventually.of_forall fun x => by rw [norm_mul] have hb := norm_testFlux_le_testBound (fun i => Pi.single i 1) ρ (fun y => leadingNormalizedField (translate (H-C t) c) (r • y)) x (leadingNormalizedField_bound (translate (H-C t) c) _) split_ifs · simpa using hb · simpa using (norm_nonneg _).trans hb · exact testBound_integrable _ hρ hcρ · filter_upwards [mvPolynomial_eval_ne_zero_ae n H hHne] with x hx have hgrad := Source29TopWeakCalibration.evaluatedGradient_ne_zero_of_eval_ne_zero H hH (by omega) hx have hf : Tendsto (fun r : ℝ => testFlux (fun i => Pi.single i 1) ρ (fun y => leadingNormalizedField (translate (H-C t) c) (r • y)) x) atTop (𝓝 (testFlux (fun i => Pi.single i 1) ρ (leadingNormalizedField H) x)) := by apply tendsto_finsetSum intro i hi exact tendsto_const_nhds.mul (translated_level_normalizedField_atTop H s hH t c x hgrad i) exact hf.mul (translated_level_phase_atTop H s hH t c x hx) /-- Large-radius normalized phase mass of a translated nonconstant homogeneous level is exactly the unit-scale phase mass of the homogeneous polynomial. -/ theorem normalizedPhaseMass_translated_level_atTop (H : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hH : H.IsHomogeneous d) (hd : 0 < d) (hHne : H ≠ 0) (t : ℝ) (c : Fin (n+1) → ℝ) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ a, R ≤ a → f a = 0) : Tendsto (fun r : ℝ => normalizedPhaseMass (translate (H-C t) c) f r) atTop (𝓝 (phaseMass H (radialWeight f 1))) := by obtain ⟨s,rfl⟩ := Nat.exists_eq_succ_of_ne_zero hd.ne' have ht := phaseFlux_translated_level_atTop H s hH hHne t c (radialWeight_contDiff hf 1) (radialWeight_compact hR zero_lt_one hz) apply ht.congr' filter_upwards [eventually_gt_atTop (0 : ℝ)] with r hr exact (normalizedPhaseMass_eq_rescaled (translate (H-C t) c) hf hr).symm end end Source29HomogeneousLevelInfinity /- Component: TranslatedCalibration.inc -/ namespace Source29TranslatedCalibration open MvPolynomial MeasureTheory open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29PolynomialTranslation Source29TopLocalInitial noncomputable section variable {n : ℕ} /-- Translation preserves the weak calibration identity by translating its compactly supported test functions. -/ theorem weakCalibration_translate (Z : (Fin n → ℝ) → Fin n → ℝ) (hZ : WeakCalibration Z) (c : Fin n → ℝ) : WeakCalibration (fun x => Z (c+x)) := by refine ⟨fun x i => hZ.1 (c+x) i, ?_⟩ intro φ hφ hcφ let ψ : (Fin n → ℝ) → ℝ := fun y => φ (-c+y) have hψ : ContDiff ℝ 1 ψ := hφ.comp (contDiff_const.add contDiff_id) have hcψ : HasCompactSupport ψ := hcφ.comp_homeomorph (Homeomorph.addLeft (-c)) have hbase := hZ.2 ψ hψ hcψ have he : (fun x => testFlux (fun i => Pi.single i 1) φ (fun y => Z (c+y)) x) = (fun x => testFlux (fun i => Pi.single i 1) ψ Z (c+x)) := by funext x have hd : fderiv ℝ ψ (c+x) = fderiv ℝ φ x := by dsimp only [ψ] rw [fderiv_comp_add_left] simp only [neg_add_cancel_left] simp only [testFlux, hd] constructor · change Integrable (fun x => testFlux (fun i => Pi.single i 1) φ (fun y => Z (c+y)) x) rw [he] exact (measurePreserving_add_left (volume : Measure (Fin n → ℝ)) c).integrable_comp_of_integrable hbase.1 · rw [he, integral_add_left_eq_self] exact hbase.2 /-- Subtracting a level and translating its polynomial preserves the normalized field calibration. -/ theorem polynomial_translated_level_weakCalibration (H : MvPolynomial (Fin n) ℝ) (hcal : WeakCalibration (leadingNormalizedField H)) (t : ℝ) (c : Fin n → ℝ) : WeakCalibration (leadingNormalizedField (translate (H-C t) c)) := by have he : leadingNormalizedField (H-C t) = leadingNormalizedField H := by have hg : evaluatedGradient (H-C t) = evaluatedGradient H := by funext x i simp [evaluatedGradient] funext x i simp only [leadingNormalizedField, hg] have ht : leadingNormalizedField (translate (H-C t) c) = fun x => leadingNormalizedField H (c+x) := by funext x rw [leadingNormalizedField_translate, he] rw [ht] exact weakCalibration_translate _ hcal c end end Source29TranslatedCalibration /- Component: HomogeneousLevelPlaneMass.inc -/ namespace Source29HomogeneousLevelPlaneMass open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29PolynomialTranslation Source29LevelRadialMonotonicity open Source29TranslatedCalibration Source29HomogeneousLevelInfinity open Source29HalfspacePhaseMass Source29RegularPhaseDensity open Source29PolynomialSmallDensity open scoped Topology noncomputable section variable {n : ℕ} lemma translated_level_eval_zero (H : MvPolynomial (Fin n) ℝ) (t : ℝ) (c : Fin n → ℝ) (hc : eval c H = t) : eval 0 (translate (H-C t) c) = 0 := by rw [eval_zero_translate] simp only [map_sub, eval_C, hc, sub_self] lemma translated_level_gradient (H : MvPolynomial (Fin n) ℝ) (t : ℝ) (c : Fin n → ℝ) : evaluatedGradient (translate (H-C t) c) 0 = evaluatedGradient H c := by funext i change eval 0 (pderiv i (translate (H-C t) c)) = eval c (pderiv i H) rw [pderiv_translate, eval_zero_translate] simp /-- Monotonicity and the equal plane densities at zero and infinity force exact plane mass at every positive radius about every regular level point. -/ theorem normalizedPhaseMass_eq_planeMass_of_regular (H : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hH : H.IsHomogeneous d) (hd : 0 < d) (hHne : H ≠ 0) (hcal : WeakCalibration (leadingNormalizedField H)) (hpos : ∀ x : Fin (n+1) → ℝ, 0 < x 0 → 0 ≤ eval x H) (hneg : ∀ x : Fin (n+1) → ℝ, x 0 < 0 → eval x H ≤ 0) (t : ℝ) (c : Fin (n+1) → ℝ) (hc : eval c H = t) (hreg : evaluatedGradient H c ≠ 0) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hfpos : ∀ s, 0 ≤ f s) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ s, R ≤ s → f s = 0) (hdz : ∀ s, R ≤ s → deriv f s = 0) (hdec : ∀ s, deriv f s ≤ 0) {r : ℝ} (hr : 0 < r) : normalizedPhaseMass (translate (H-C t) c) f r = planeMass n f := by have hQcal := polynomial_translated_level_weakCalibration H hcal t c have hQzero := translated_level_eval_zero H t c hc have hQreg : evaluatedGradient (translate (H-C t) c) 0 ≠ 0 := by rwa [translated_level_gradient] have hQne : translate (H-C t) c ≠ 0 := by intro hzero apply hQreg rw [hzero] funext i simp [evaluatedGradient] have hlim := normalizedPhaseMass_translated_level_atTop H d hH hd hHne t c hf hR hz rw [phaseMass_radial_eq_planeMass H hHne hcal hpos hneg hf hfpos hR hz] at hlim apply le_antisymm · apply ge_of_tendsto hlim filter_upwards [eventually_ge_atTop r] with s hrs exact normalizedPhaseMass_monotoneOn (translate (H-C t) c) hQne hQcal hf hR hz hdz hdec hr (lt_of_lt_of_le hr hrs) hrs · exact planeMass_le_normalizedPhaseMass (translate (H-C t) c) hQzero hQreg hQcal hf hR hz hdz hdec hr /-- Every point on a nonzero level of a positive-degree homogeneous calibrated polynomial with weak coordinate-halfspace signs has exactly plane mass at every positive radius. Regularity is derived from Euler's identity. -/ theorem normalizedPhaseMass_eq_planeMass_of_nonzero_level (H : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hH : H.IsHomogeneous d) (hd : 0 < d) (hcal : WeakCalibration (leadingNormalizedField H)) (hpos : ∀ x : Fin (n+1) → ℝ, 0 < x 0 → 0 ≤ eval x H) (hneg : ∀ x : Fin (n+1) → ℝ, x 0 < 0 → eval x H ≤ 0) {t : ℝ} (ht : t ≠ 0) (c : Fin (n+1) → ℝ) (hc : eval c H = t) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hfpos : ∀ s, 0 ≤ f s) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ s, R ≤ s → f s = 0) (hdz : ∀ s, R ≤ s → deriv f s = 0) (hdec : ∀ s, deriv f s ≤ 0) {r : ℝ} (hr : 0 < r) : normalizedPhaseMass (translate (H-C t) c) f r = planeMass n f := by have hHne : H ≠ 0 := by intro hzero apply ht rw [← hc, hzero, map_zero] have hev : eval c H ≠ 0 := by rwa [hc] exact normalizedPhaseMass_eq_planeMass_of_regular H d hH hd hHne hcal hpos hneg t c hc (Source29TopWeakCalibration.evaluatedGradient_ne_zero_of_eval_ne_zero H hH hd hev) hf hfpos hR hz hdz hdec hr end end Source29HomogeneousLevelPlaneMass /- Component: PhaseDefectIncrement.inc -/ namespace Source29PhaseDefectIncrement open MvPolynomial MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29WeakCalibrationLimits Source29VariationConvexity Source29NonlinearCalibration open Source29LevelRadialMonotonicity Source29LevelRadialDefect Source29LevelStressStationarity open Source29PhaseMassLimit Source29SmoothPhaseTransition open scoped Topology noncomputable section variable {n : ℕ} /-- The coefficient of the diffuse level weight in the derivative of normalized radial mass. -/ def defectCoefficient (P : MvPolynomial (Fin (n+1)) ℝ) (f : ℝ → ℝ) (r : ℝ) (x : Fin (n+1) → ℝ) : ℝ := ((-2/r^2) * deriv f (radiusSq x/r^2) * (Source29NormalPenalty.dot (leadingNormalizedField P x) x)^2) / r^(n+1) lemma defectCoefficient_mul (P : MvPolynomial (Fin (n+1)) ℝ) (h f : ℝ → ℝ) (r : ℝ) (x : Fin (n+1) → ℝ) : defectCoefficient P f r x * diffuseWeight P h x = radialDefect P h f r x / r^(n+1) := by unfold defectCoefficient radialDefect ring lemma slope_lower_bound {F D : ℝ → ℝ} {a b C : ℝ} (hab : a ≤ b) (hF : ∀ r ∈ Icc a b, HasDerivAt F (D r) r) (hD : ∀ r ∈ Icc a b, C ≤ D r) : C * (b-a) ≤ F b - F a := by have hd (r : ℝ) (hr : r ∈ Icc a b) : HasDerivAt (fun t ↦ F t - C*t) (D r - C) r := by convert (hF r hr).sub ((hasDerivAt_id r).const_mul C) using 1 <;> simp only [mul_one, id_eq] rfl have hm : MonotoneOn (fun t ↦ F t - C*t) (Icc a b) := by apply monotoneOn_of_deriv_nonneg (convex_Icc a b) · intro r hr exact (hd r hr).continuousAt.continuousWithinAt · intro r hr exact (hd r (interior_subset hr)).differentiableAt.differentiableWithinAt · intro r hr rw [(hd r (interior_subset hr)).deriv] exact sub_nonneg.mpr (hD r (interior_subset hr)) have h := hm (left_mem_Icc.mpr hab) (right_mem_Icc.mpr hab) hab linarith /-- A uniform localized coefficient bound survives the diffuse approximation and gives a quantitative increment of the actual phase mass. -/ theorem phaseMass_increment (P : MvPolynomial (Fin (n+1)) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) {η : (Fin (n+1) → ℝ) → ℝ} (hη : ContDiff ℝ 1 η) (hcη : HasCompactSupport η) {a b δ : ℝ} (ha : 0 < a) (hab : a ≤ b) (hlower : ∀ r ∈ Icc a b, ∀ x, δ * η x ≤ defectCoefficient P f r x) : δ * phaseMass P η * (b-a) ≤ normalizedPhaseMass P f b - normalizedPhaseMass P f a := by have hb : 0 < b := ha.trans_le hab have hm := phaseMass_tendsto P hP hcal hη hcη have hla := normalizedDiffuseMass_tendsto P hP hcal hf hR ha hz have hlb := normalizedDiffuseMass_tendsto P hP hcal hf hR hb hz apply le_of_tendsto_of_tendsto ((hm.const_mul δ).mul_const (b-a)) (hlb.sub hla) apply Filter.Eventually.of_forall intro k dsimp only apply slope_lower_bound hab (fun r hr ↦ normalizedDiffuseMass_hasDerivAt P hcal (transition_deriv_contDiff k) hf hR (ha.trans_le hr.1) hz hdz) intro r hr have hrpos : 0 < r := ha.trans_le hr.1 have hi := (localized_gradient_mass_identity P hcal hη hcη (transition_contDiff k) (transition_norm_le_one k)).1 have hd := (radialDefect_integrable P hcal (transition_deriv_contDiff k) hf hR hrpos hz hdz).div_const (r^(n+1)) rw [← integral_const_mul, ← integral_div] apply integral_mono (hi.const_mul δ) hd intro x have hw : 0 ≤ diffuseWeight P (deriv (transition k)) x := mul_nonneg (transition_deriv_nonneg k _) (Real.sqrt_nonneg _) have h := mul_le_mul_of_nonneg_right (hlower r hr x) hw rw [defectCoefficient_mul] at h simpa only [diffuseWeight, mul_assoc] using h /-- A positive phase mass in the localization turns the quantitative estimate into a strict increment. -/ theorem phaseMass_strict_increment (P : MvPolynomial (Fin (n+1)) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) {η : (Fin (n+1) → ℝ) → ℝ} (hη : ContDiff ℝ 1 η) (hcη : HasCompactSupport η) (hm : 0 < phaseMass P η) {a b δ : ℝ} (ha : 0 < a) (hab : a < b) (hδ : 0 < δ) (hlower : ∀ r ∈ Icc a b, ∀ x, δ * η x ≤ defectCoefficient P f r x) : normalizedPhaseMass P f a < normalizedPhaseMass P f b := by have h := phaseMass_increment P hP hcal hf hR hz hdz hη hcη ha hab.le hlower have hp := mul_pos (mul_pos hδ hm) (sub_pos.mpr hab) linarith end end Source29PhaseDefectIncrement /- Component: RegularLocalPhaseMass.inc -/ namespace Source29RegularLocalPhaseMass open MvPolynomial MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29PolynomialTranslation Source29TopLocalInitial Source29PhaseMassLimit open Source29LevelRadialStress Source29LevelRadialMonotonicity open Source29PolynomialGraphMonotonicity Source29RegularPhaseDensity open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- Translate the polynomial or translate its test weight in the opposite direction. -/ theorem phaseMass_translate (P : MvPolynomial (Fin n) ℝ) (c : Fin n → ℝ) (ρ : (Fin n → ℝ) → ℝ) : phaseMass (translate P c) ρ = phaseMass P (fun x ↦ ρ (-c+x)) := by have he (x : Fin n → ℝ) : testFlux (fun i ↦ Pi.single i 1) (fun y ↦ ρ (-c+y)) (leadingNormalizedField P) (c+x) = testFlux (fun i ↦ Pi.single i 1) ρ (leadingNormalizedField (translate P c)) x := by simp only [testFlux, fderiv_comp_add_left, neg_add_cancel_left, leadingNormalizedField_translate] unfold phaseMass conv_rhs => rw [← integral_add_left_eq_self _ c] congr 1 apply integral_congr_ae exact Filter.Eventually.of_forall fun x ↦ by dsimp only rw [he, eval_translate] rfl lemma translated_gradient_origin (P : MvPolynomial (Fin n) ℝ) (c : Fin n → ℝ) : evaluatedGradient (translate P c) 0 = evaluatedGradient P c := by funext i simp only [evaluatedGradient, pderiv_translate, eval_zero_translate] /-- At any regular zero, arbitrarily small centered radial test weights have strictly positive phase mass. Calibration is not needed for this density fact. -/ theorem exists_small_positive_radial_mass (P : MvPolynomial (Fin (n+1)) ℝ) (c : Fin (n+1) → ℝ) (hc : eval c P = 0) (hreg : evaluatedGradient P c ≠ 0) (ε : ℝ) (hε : 0 < ε) : ∃ r : ℝ, 0 < r ∧ r < ε ∧ 0 < phaseMass P (fun x ↦ radialWeight radialCutoff r (-c+x)) := by let t : ℕ → ℝ := fun k ↦ (dilationRadius k)⁻¹ have ht : ∀ k, 0 < t k := fun k ↦ inv_pos.mpr (dilationRadius_pos k) have ht0 : Tendsto t atTop (𝓝 0) := tendsto_inv_atTop_zero.comp dilationRadius_tendsto have hzero : eval 0 (translate P c) = 0 := by rw [eval_zero_translate, hc] have hgrad : evaluatedGradient (translate P c) 0 ≠ 0 := by rwa [translated_gradient_origin] have hl := radialCutoff_regular_limit (translate P c) hzero hgrad ht ht0 have hplane : 0 < Source29PolynomialSmallDensity.planeMass n radialCutoff := Source29HarmonicRadialKernels.radialCutoff_mass_pos n have hevent : ∀ᶠ k in atTop, 0 < normalizedPhaseMass (translate P c) radialCutoff (t k) ∧ t k < ε := (hl.eventually (lt_mem_nhds hplane)).and (ht0.eventually (gt_mem_nhds hε)) obtain ⟨k,hk,hke⟩ := hevent.exists refine ⟨t k,ht k,hke,?_⟩ rw [← phaseMass_translate] exact (div_pos_iff_of_pos_right (pow_pos (ht k) n)).mp hk /-- The centered radial test has support in a ball proportional to its radius. -/ lemma centered_radial_support (c : Fin (n+1) → ℝ) (r : ℝ) (hr : 0 < r) : tsupport (fun x ↦ radialWeight radialCutoff r (-c+x)) ⊆ Metric.closedBall c (2*r) := by apply closure_minimal ?_ Metric.isClosed_closedBall intro x hx have hne : radialCutoff (radiusSq (-c+x) / r^2) ≠ 0 := hx have hs : radiusSq (-c+x) < 2*r^2 := by apply (div_lt_iff₀ (sq_pos_of_pos hr)).mp exact lt_of_not_ge (fun h ↦ hne (radialCutoff_zero _ h)) have hnorm : ‖-c+x‖ ≤ 2*r := by apply (pi_norm_le_iff_of_nonneg (by positivity)).mpr intro i have hi : ((-c+x) i)^2 ≤ radiusSq (-c+x) := Finset.single_le_sum (fun j _ ↦ sq_nonneg ((-c+x) j)) (Finset.mem_univ i) apply (sq_le_sq₀ (norm_nonneg _) (by positivity)).mp rw [Real.norm_eq_abs, sq_abs] nlinarith simpa only [Metric.mem_closedBall, dist_eq_norm, sub_eq_add_neg, add_comm x (-c)] using hnorm /-- Every neighborhood of a regular zero contains a nonnegative compact C1 test, bounded by one, with strictly positive phase mass. -/ theorem exists_positive_local_test (P : MvPolynomial (Fin (n+1)) ℝ) (c : Fin (n+1) → ℝ) (hc : eval c P = 0) (hreg : evaluatedGradient P c ≠ 0) (U : Set (Fin (n+1) → ℝ)) (hU : U ∈ 𝓝 c) : ∃ η : (Fin (n+1) → ℝ) → ℝ, ContDiff ℝ 1 η ∧ HasCompactSupport η ∧ tsupport η ⊆ U ∧ (∀ x, 0 ≤ η x ∧ η x ≤ 1) ∧ 0 < phaseMass P η := by obtain ⟨ε,hε,hball⟩ := Metric.mem_nhds_iff.mp hU obtain ⟨r,hr,hre,hm⟩ := exists_small_positive_radial_mass P c hc hreg (ε/3) (by positivity) refine ⟨(fun x ↦ radialWeight radialCutoff r (-c+x)),?_,?_,?_,?_,hm⟩ · exact (radialWeight_contDiff radialCutoff_contDiff r).comp (contDiff_const.add contDiff_id) · exact (radialWeight_compact (by norm_num : (0:ℝ) ≤ 2) hr radialCutoff_zero).comp_homeomorph (Homeomorph.addLeft (-c)) · intro x hx have hd := centered_radial_support c r hr hx apply hball change dist x c < ε have : dist x c ≤ 2*r := hd linarith · intro x exact radialCutoff_bounds _ end end Source29RegularLocalPhaseMass /- Component: PhaseDefectLocalization.inc -/ namespace Source29PhaseDefectLocalization open MvPolynomial Filter Set open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29QuarticReuse.QuarticPolynomialBasics Source29PhaseDefectIncrement open scoped Topology BigOperators noncomputable section variable {n : ℕ} lemma defectCoefficient_nonneg (P : MvPolynomial (Fin (n+1)) ℝ) {f : ℝ → ℝ} (hf : ∀ t, deriv f t ≤ 0) {r : ℝ} (hr : 0 < r) (x : Fin (n+1) → ℝ) : 0 ≤ defectCoefficient P f r x := by apply div_nonneg _ (pow_nonneg hr.le _) apply mul_nonneg _ (sq_nonneg _) exact mul_nonneg_of_nonpos_of_nonpos (div_nonpos_of_nonpos_of_nonneg (by norm_num) (sq_nonneg r)) (hf _) lemma defectCoefficient_pos (P : MvPolynomial (Fin (n+1)) ℝ) {f : ℝ → ℝ} (a : Fin (n+1) → ℝ) {r : ℝ} (hr : 0 < r) (hf : deriv f (radiusSq a/r^2) < 0) (ha : Source29NormalPenalty.dot (leadingNormalizedField P a) a ≠ 0) : 0 < defectCoefficient P f r a := by exact div_pos (mul_pos (mul_pos_of_neg_of_neg (div_neg_of_neg_of_pos (by norm_num) (sq_pos_of_pos hr)) hf) (sq_pos_of_ne_zero ha)) (pow_pos hr _) lemma defectCoefficient_continuousAt (P : MvPolynomial (Fin (n+1)) ℝ) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (a : Fin (n+1) → ℝ) (ha : evaluatedGradient P a ≠ 0) {r : ℝ} (hr : r ≠ 0) : ContinuousAt (fun z : ℝ × (Fin (n+1) → ℝ) ↦ defectCoefficient P f z.1 z.2) (r,a) := by have hg (i : Fin (n+1)) : Continuous (fun y ↦ evaluatedGradient P y i) := (contDiff_eval (pderiv i P)).continuous have hs : Continuous (fun y ↦ radiusSq (evaluatedGradient P y)) := continuous_finsetSum _ (fun i _ ↦ (hg i).pow 2) have hn (i : Fin (n+1)) : ContinuousAt (fun y ↦ leadingNormalizedField P y i) a := (hg i).continuousAt.div hs.sqrt.continuousAt (Real.sqrt_pos.mpr (radiusSq_pos_of_ne_zero ha)).ne' have hdot : ContinuousAt (fun y ↦ Source29NormalPenalty.dot (leadingNormalizedField P y) y) a := by apply tendsto_finsetSum intro i hi exact (hn i).mul (continuous_apply i).continuousAt have hdot' := hdot.comp (continuous_snd.continuousAt (x := (r,a))) have hsq := (radiusSq_contDiff.continuous.comp continuous_snd).continuousAt (x := (r,a)) have harg := hsq.div ((continuous_fst.pow 2).continuousAt) (pow_ne_zero 2 hr) exact (((continuousAt_const.div ((continuous_fst.pow 2).continuousAt) (pow_ne_zero 2 hr)).mul (hf.continuous_deriv_one.continuousAt.comp harg)).mul (hdot'.pow 2)).div ((continuous_fst.pow (n+1)).continuousAt) (pow_ne_zero _ hr) /-- Strict positivity of the actual defect at a regular point gives a uniform positive interval-and-neighborhood lower bound. -/ theorem exists_localized_lower_bound (P : MvPolynomial (Fin (n+1)) ℝ) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hdec : ∀ t, deriv f t ≤ 0) (a : Fin (n+1) → ℝ) (ha : evaluatedGradient P a ≠ 0) (r₀ : ℝ) (hr₀ : 0 < r₀) (hderiv : deriv f (radiusSq a/r₀^2) < 0) (hradial : Source29NormalPenalty.dot (leadingNormalizedField P a) a ≠ 0) : ∃ lo hi δ : ℝ, 0 < lo ∧ lo < hi ∧ 0 < δ ∧ ∃ U : Set (Fin (n+1) → ℝ), U ∈ 𝓝 a ∧ ∀ η : (Fin (n+1) → ℝ) → ℝ, (∀ x, 0 ≤ η x) → (∀ x, η x ≤ 1) → tsupport η ⊆ U → ∀ r ∈ Icc lo hi, ∀ x, δ * η x ≤ defectCoefficient P f r x := by let δ := defectCoefficient P f r₀ a / 2 have hp := defectCoefficient_pos P a hr₀ hderiv hradial have hδ : 0 < δ := half_pos hp have hb : δ < defectCoefficient P f r₀ a := by dsimp [δ]; linarith have he : {z : ℝ × (Fin (n+1) → ℝ) | δ < defectCoefficient P f z.1 z.2} ∈ 𝓝 (r₀,a) := (defectCoefficient_continuousAt P hf a ha hr₀.ne').eventually (isOpen_Ioi.mem_nhds hb) obtain ⟨V,hV,U,hU,hVU⟩ := mem_nhds_prod_iff.mp he obtain ⟨ε,hε,hεV⟩ := Metric.mem_nhds_iff.mp hV let w := min (r₀/2) (ε/2) have hw : 0 < w := lt_min (half_pos hr₀) (half_pos hε) have hwr : w ≤ r₀/2 := min_le_left _ _ have hwε : w ≤ ε/2 := min_le_right _ _ have hlo : 0 < r₀-w := by linarith have hlh : r₀-w < r₀+w := by linarith refine ⟨r₀-w,r₀+w,δ,hlo,hlh,hδ,U,hU,?_⟩ intro η _hη hη1 hηU r hr x have hrpos : 0 < r := hlo.trans_le hr.1 have hrV : r ∈ V := by apply hεV change dist r r₀ < ε rw [Real.dist_eq, abs_lt] constructor <;> linarith [hr.1, hr.2] by_cases hx : x ∈ U · have hlocal : δ < defectCoefficient P f r x := hVU (show (r,x) ∈ V ×ˢ U from ⟨hrV,hx⟩) exact (mul_le_of_le_one_right hδ.le (hη1 x)).trans hlocal.le · have hzero : η x = 0 := image_eq_zero_of_notMem_tsupport (fun h ↦ hx (hηU h)) rw [hzero, mul_zero] exact defectCoefficient_nonneg P hdec hrpos x end end Source29PhaseDefectLocalization /- Component: RegularRadialStrictIncrement.inc -/ namespace Source29RegularRadialStrictIncrement open MvPolynomial MeasureTheory Filter Set open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29WeakCalibrationLimits Source29PhaseDefectIncrement open Source29PhaseDefectLocalization Source29RegularLocalPhaseMass open Source29LevelRadialMonotonicity Source29PolynomialGraphMonotonicity open scoped Topology noncomputable section variable {n : ℕ} /-- A negative radial cutoff derivative and a nonzero radial normal component at a regular zero force a strict increment of normalized phase mass. -/ theorem exists_strict_increment (P : MvPolynomial (Fin (n+1)) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) {f : ℝ → ℝ} (hf : ContDiff ℝ 1 f) (hdec : ∀ t, deriv f t ≤ 0) {R : ℝ} (hR : 0 ≤ R) (hz : ∀ t, R ≤ t → f t = 0) (hdz : ∀ t, R ≤ t → deriv f t = 0) (a : Fin (n+1) → ℝ) (ha : eval a P = 0) (hreg : evaluatedGradient P a ≠ 0) (r₀ : ℝ) (hr₀ : 0 < r₀) (hderiv : deriv f (radiusSq a / r₀^2) < 0) (hradial : Source29NormalPenalty.dot (leadingNormalizedField P a) a ≠ 0) : ∃ r s : ℝ, 0 < r ∧ r < s ∧ normalizedPhaseMass P f r < normalizedPhaseMass P f s := by have hP : P ≠ 0 := by intro he apply hreg subst P funext i simp [evaluatedGradient] obtain ⟨r,s,δ,hr,hrs,hδ,U,hU,hbound⟩ := exists_localized_lower_bound P hf hdec a hreg r₀ hr₀ hderiv hradial obtain ⟨η,hη,hcη,hηU,hηb,hm⟩ := exists_positive_local_test P a ha hreg U hU exact ⟨r,s,hr,hrs,phaseMass_strict_increment P hP hcal hf hR hz hdz hη hcη hm hr hrs hδ (hbound η (fun x ↦ (hηb x).1) (fun x ↦ (hηb x).2) hηU)⟩ /-- The fixed smooth radial cutoff detects every nonzero radial normal defect at a regular zero. -/ theorem exists_strict_increment_of_regular_defect (P : MvPolynomial (Fin (n+1)) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) (a : Fin (n+1) → ℝ) (ha : eval a P = 0) (hreg : evaluatedGradient P a ≠ 0) (hradial : Source29NormalPenalty.dot (leadingNormalizedField P a) a ≠ 0) : ∃ r s : ℝ, 0 < r ∧ r < s ∧ normalizedPhaseMass P radialCutoff r < normalizedPhaseMass P radialCutoff s := by have hane : a ≠ 0 := by intro he apply hradial rw [he] simp [Source29NormalPenalty.dot] have hsq := radiusSq_pos_of_ne_zero hane let r₀ := Real.sqrt (2*radiusSq a) have hr₀ : 0 < r₀ := Real.sqrt_pos.mpr (by positivity) have hr₂ : r₀^2 = 2*radiusSq a := Real.sq_sqrt (by positivity) have harg : radiusSq a/r₀^2 = 1/2 := by rw [hr₂] field_simp apply exists_strict_increment P hcal radialCutoff_contDiff radialCutoff_deriv_nonpos (by norm_num : (0:ℝ) ≤ 2) radialCutoff_zero radialCutoff_deriv_zero a ha hreg r₀ hr₀ ?_ hradial rw [harg, Source29GraphMassRigidity.radialCutoff_deriv_half] norm_num /-- Constancy of normalized phase mass forces radial tangency at every regular zero, using only the diffuse defect identity and local density. -/ theorem radial_tangency_of_constant_mass (P : MvPolynomial (Fin (n+1)) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) (C : ℝ) (hconstant : ∀ r : ℝ, 0 < r → normalizedPhaseMass P radialCutoff r = C) (a : Fin (n+1) → ℝ) (ha : eval a P = 0) (hreg : evaluatedGradient P a ≠ 0) : Source29NormalPenalty.dot (leadingNormalizedField P a) a = 0 := by by_contra hne obtain ⟨r,s,hr,hrs,hinc⟩ := exists_strict_increment_of_regular_defect P hcal a ha hreg hne rw [hconstant r hr, hconstant s (hr.trans hrs)] at hinc exact lt_irrefl _ hinc end end Source29RegularRadialStrictIncrement /- Component: HomogeneousLevelTangencyRigidity.inc -/ namespace Source29HomogeneousLevelTangencyRigidity open MvPolynomial Filter open Source29QuarticReuse.FluxObstruction Source29NormalPenalty Source29LinearForm open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- Tangency to one positive homogeneous level determines the whole polynomial. -/ theorem eq_linearForm_pow_of_level_tangency (H : MvPolynomial (Fin n) ℝ) (d : ℕ) (hH : H.IsHomogeneous d) (hd : 0 < d) (x : Fin n → ℝ) (hx : 0 < eval x H) (htan : ∀ y, eval y H = eval x H → dot (evaluatedGradient H x) (x - y) = 0) : ∃ k : ℝ, k ≠ 0 ∧ H = C k * (linearForm (evaluatedGradient H x)) ^ d := by let a := evaluatedGradient H x let b := dot a x have hb : b = (d : ℝ) * eval x H := by simpa [b, dot, a, mul_comm] using euler_evaluatedGradient H hH x have hbpos : 0 < b := by rw [hb]; exact mul_pos (by exact_mod_cast hd) hx have hlocal (y : Fin n → ℝ) (hy : 0 < eval y H) : b ^ d * eval y H = eval x H * (eval y (linearForm a)) ^ d := by let r : ℝ := (eval x H / eval y H) ^ ((d : ℝ)⁻¹) have hrpow : r ^ d = eval x H / eval y H := Real.rpow_inv_natCast_pow (le_of_lt (div_pos hx hy)) (Nat.ne_of_gt hd) have hrlevel : eval (r • y) H = eval x H := by rw [eval_dilate_homogeneous H hH, hrpow, div_mul_cancel₀ _ hy.ne'] have hdot := htan (r • y) hrlevel have hbr : b = r * eval y (linearForm a) := by rw [eval_linearForm] change (∑ i, a i * x i) = r * ∑ i, a i * y i change (∑ i, a i * (x i - r * y i)) = 0 at hdot simp only [mul_sub, Finset.sum_sub_distrib] at hdot rw [sub_eq_zero] at hdot rw [hdot, Finset.mul_sum] apply Finset.sum_congr rfl intro i _ ring rw [hbr, mul_pow, hrpow] field_simp have hzero : C (b ^ d) * H - C (eval x H) * (linearForm a) ^ d = 0 := by apply Source29LocalHyperplaneDivisor.polynomial_eq_zero_of_locally_zero _ x have hc := (Source29PolynomialLinkChart.analyticAt_eval_real H x).continuousAt filter_upwards [hc.eventually (eventually_gt_nhds hx)] with y hy simpa only [map_sub, map_mul, map_pow, eval_C, sub_eq_zero] using hlocal y hy refine ⟨eval x H / b ^ d, div_ne_zero hx.ne' (pow_ne_zero _ hbpos.ne'), ?_⟩ apply Source29QuarticReuse.QuarticCompatibility.polynomial_funext intro y have he := congrArg (eval y) hzero simp only [map_sub, map_mul, map_pow, eval_C, map_zero, sub_eq_zero] at he simp only [map_mul, eval_C, map_pow] rw [div_mul_eq_mul_div] apply (eq_div_iff (pow_ne_zero d hbpos.ne')).mpr simpa only [mul_comm] using he /-- A nonzero polynomial with the weak positive half-space sign has a positive value. -/ theorem exists_positive_eval_of_halfspace_sign (H : MvPolynomial (Fin (n + 1)) ℝ) (hH : H ≠ 0) (hpos : ∀ x : Fin (n + 1) → ℝ, 0 < x 0 → 0 ≤ eval x H) : ∃ x, 0 < eval x H := by by_contra hn push Not at hn apply hH apply Source29LocalHyperplaneDivisor.polynomial_eq_zero_of_locally_zero H (fun _ => 1) have hx : ∀ᶠ x : Fin (n + 1) → ℝ in 𝓝 (fun _ => 1), 0 < x 0 := (continuous_apply 0).continuousAt.eventually (eventually_gt_nhds (by norm_num)) filter_upwards [hx] with x hx exact le_antisymm (hn x) (hpos x hx) /-- Half-space signs force the linear form in a nonzero pure power to be normal. -/ theorem linearForm_pow_halfspace_rigidity (a : Fin (n + 1) → ℝ) (k : ℝ) (hk : k ≠ 0) (d : ℕ) (hpos : ∀ x : Fin (n + 1) → ℝ, 0 < x 0 → 0 ≤ eval x (C k * (linearForm a) ^ d)) (hneg : ∀ x : Fin (n + 1) → ℝ, x 0 < 0 → eval x (C k * (linearForm a) ^ d) ≤ 0) : ∀ j : Fin n, a j.succ = 0 := by intro j by_contra hj have hv (t : ℝ) : eval (Fin.cons t (Pi.single j ((1 - a 0 * t) / a j.succ))) (linearForm a) = 1 := by rw [eval_linearForm, Fin.sum_univ_succ] simp only [Fin.cons_zero, Fin.cons_succ, Pi.single_apply] simp only [mul_ite, mul_zero, Finset.sum_ite_eq', Finset.mem_univ, ite_true] field_simp ring have hp := hpos (Fin.cons 1 (Pi.single j ((1 - a 0 * 1) / a j.succ))) (by simp) have hm := hneg (Fin.cons (-1) (Pi.single j ((1 - a 0 * (-1)) / a j.succ))) (by simp) simp only [map_mul, eval_C, map_pow] at hp hm rw [hv] at hp hm simp only [one_pow, mul_one] at hp hm exact hk (le_antisymm hm hp) /-- Homogeneous level tangency and the weak half-space signs force an odd normal power. -/ theorem eq_positive_odd_normal_power (H : MvPolynomial (Fin (n + 1)) ℝ) (d : ℕ) (hH : H.IsHomogeneous d) (hd : 0 < d) (hHne : H ≠ 0) (hpos : ∀ x : Fin (n + 1) → ℝ, 0 < x 0 → 0 ≤ eval x H) (hneg : ∀ x : Fin (n + 1) → ℝ, x 0 < 0 → eval x H ≤ 0) (htan : ∀ c x, eval c H = eval x H → eval x H ≠ 0 → dot (evaluatedGradient H x) (x - c) = 0) : ∃ k : ℝ, 0 < k ∧ Odd d ∧ H = C k * (X 0) ^ d := by obtain ⟨x, hx⟩ := exists_positive_eval_of_halfspace_sign H hHne hpos obtain ⟨k, hk, he⟩ := eq_linearForm_pow_of_level_tangency H d hH hd x hx (fun y hy => htan y x hy hx.ne') have ha := linearForm_pow_halfspace_rigidity (evaluatedGradient H x) k hk d (by simpa only [← he] using hpos) (by simpa only [← he] using hneg) have hform : linearForm (evaluatedGradient H x) = C (evaluatedGradient H x 0) * X 0 := by unfold linearForm rw [Fin.sum_univ_succ] simp [ha] have hN : H = C (k * (evaluatedGradient H x 0) ^ d) * (X 0) ^ d := by nth_rewrite 1 [he] rw [hform, mul_pow, ← mul_assoc, ← map_pow, ← map_mul] have hc : k * (evaluatedGradient H x 0) ^ d ≠ 0 := by intro hc apply hHne simp [hc] at hN exact hN obtain ⟨hcpos, hodd⟩ := Source29NewtonPureNormalPower.coefficient_pos_and_degree_odd H d _ hc hN hpos hneg exact ⟨_, hcpos, hodd, hN⟩ /-- The two half-space signs exclude a nonzero homogeneous polynomial of degree zero. -/ theorem degree_pos_of_halfspace_sign (H : MvPolynomial (Fin (n + 1)) ℝ) (d : ℕ) (hH : H.IsHomogeneous d) (hHne : H ≠ 0) (hpos : ∀ x : Fin (n + 1) → ℝ, 0 < x 0 → 0 ≤ eval x H) (hneg : ∀ x : Fin (n + 1) → ℝ, x 0 < 0 → eval x H ≤ 0) : 0 < d := by by_contra hd have hd0 : d = 0 := by omega have hv (x : Fin (n + 1) → ℝ) : eval x H = eval 0 H := by simpa [hd0] using (eval_dilate_homogeneous H hH x 0).symm have hp := hpos (fun _ => 1) (by norm_num) have hm := hneg (fun _ => -1) (by norm_num) rw [hv] at hp hm have hz : eval 0 H = 0 := le_antisymm hm hp apply hHne apply Source29QuarticReuse.QuarticCompatibility.polynomial_funext intro x simpa only [map_zero, hv x] using hz /-- No separate positive-degree assumption is needed for the classification. -/ theorem eq_positive_odd_normal_power_of_level_tangency (H : MvPolynomial (Fin (n + 1)) ℝ) (d : ℕ) (hH : H.IsHomogeneous d) (hHne : H ≠ 0) (hpos : ∀ x : Fin (n + 1) → ℝ, 0 < x 0 → 0 ≤ eval x H) (hneg : ∀ x : Fin (n + 1) → ℝ, x 0 < 0 → eval x H ≤ 0) (htan : ∀ c x, eval c H = eval x H → eval x H ≠ 0 → dot (evaluatedGradient H x) (x - c) = 0) : ∃ k : ℝ, 0 < k ∧ Odd d ∧ H = C k * (X 0) ^ d := by exact eq_positive_odd_normal_power H d hH (degree_pos_of_halfspace_sign H d hH hHne hpos hneg) hHne hpos hneg htan end end Source29HomogeneousLevelTangencyRigidity /- Component: HomogeneousLevelRadialTangency.inc -/ namespace Source29HomogeneousLevelRadialTangency open MvPolynomial Filter open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29PolynomialTranslation Source29PolynomialSmallDensity open Source29PolynomialGraphMonotonicity Source29LevelRadialMonotonicity open Source29NormalPenalty open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- Every nonzero level of a homogeneous calibrated polynomial with weak halfspace signs is tangent to every radius drawn from another point on that level. This follows from the proved equality of its radial masses. -/ theorem level_radial_tangency (H : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hH : H.IsHomogeneous d) (hd : 0 < d) (hcal : WeakCalibration (leadingNormalizedField H)) (hpos : ∀ x : Fin (n+1) → ℝ, 0 < x 0 → 0 ≤ eval x H) (hneg : ∀ x : Fin (n+1) → ℝ, x 0 < 0 → eval x H ≤ 0) (c x : Fin (n+1) → ℝ) (hc : eval c H = eval x H) (hx : eval x H ≠ 0) : dot (evaluatedGradient H x) (x-c) = 0 := by let P := translate (H-C (eval x H)) c have hcx : c+(x-c) = x := by abel have hzero : eval (x-c) P = 0 := by change eval (x-c) (translate (H-C (eval x H)) c) = 0 rw [eval_translate] change eval (c+(x-c)) (H-C (eval x H)) = 0 rw [hcx, map_sub, eval_C, sub_self] have hgrad : evaluatedGradient P (x-c) = evaluatedGradient H x := by funext i change eval (x-c) (pderiv i (translate (H-C (eval x H)) c)) = eval x (pderiv i H) rw [pderiv_translate, eval_translate] change eval (c+(x-c)) (pderiv i (H-C (eval x H))) = eval x (pderiv i H) rw [hcx] simp have hregH := Source29TopWeakCalibration.evaluatedGradient_ne_zero_of_eval_ne_zero H hH hd hx have hreg : evaluatedGradient P (x-c) ≠ 0 := by rwa [hgrad] have hPcal := Source29TranslatedCalibration.polynomial_translated_level_weakCalibration H hcal (eval x H) c have hconstant : ∀ r, 0 < r → normalizedPhaseMass P radialCutoff r = planeMass n radialCutoff := by intro r hr exact Source29HomogeneousLevelPlaneMass.normalizedPhaseMass_eq_planeMass_of_nonzero_level H d hH hd hcal hpos hneg hx c hc radialCutoff_contDiff (fun s ↦ (radialCutoff_bounds s).1) (by norm_num : (0:ℝ) ≤ 2) radialCutoff_zero radialCutoff_deriv_zero radialCutoff_deriv_nonpos hr have ht := Source29RegularRadialStrictIncrement.radial_tangency_of_constant_mass P hPcal (planeMass n radialCutoff) hconstant (x-c) hzero hreg have hn : leadingNormalizedField P (x-c) = leadingNormalizedField H x := by funext i simp only [leadingNormalizedField, hgrad] rw [hn] at ht have he : dot (leadingNormalizedField H x) (x-c) = dot (evaluatedGradient H x) (x-c) / Real.sqrt (radiusSq (evaluatedGradient H x)) := by unfold dot leadingNormalizedField simp only [div_mul_eq_mul_div, Finset.sum_div] rw [he] at ht have hs : Real.sqrt (radiusSq (evaluatedGradient H x)) ≠ 0 := (Real.sqrt_pos.mpr (radiusSq_pos_of_ne_zero hregH)).ne' exact (div_eq_zero_iff.mp ht).resolve_right hs end end Source29HomogeneousLevelRadialTangency /- Component: CalibratedHalfspaceRigidity.inc -/ namespace Source29CalibratedHalfspaceRigidity open MvPolynomial open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits noncomputable section variable {n : ℕ} /-- A nonzero homogeneous polynomial whose normalized gradient is a weak calibration and whose signs agree weakly with the two normal halfspaces is a positive scalar times an odd power of the normal coordinate. -/ theorem eq_positive_odd_normal_power (H : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hH : H.IsHomogeneous d) (hHne : H ≠ 0) (hcal : WeakCalibration (leadingNormalizedField H)) (hpos : ∀ x : Fin (n+1) → ℝ, 0 < x 0 → 0 ≤ eval x H) (hneg : ∀ x : Fin (n+1) → ℝ, x 0 < 0 → eval x H ≤ 0) : ∃ c : ℝ, 0 < c ∧ Odd d ∧ H = C c * (X 0)^d := by have hd := Source29HomogeneousLevelTangencyRigidity.degree_pos_of_halfspace_sign H d hH hHne hpos hneg apply Source29HomogeneousLevelTangencyRigidity.eq_positive_odd_normal_power_of_level_tangency H d hH hHne hpos hneg exact Source29HomogeneousLevelRadialTangency.level_radial_tangency H d hH hd hcal hpos hneg end end Source29CalibratedHalfspaceRigidity /- Component: PolynomialInitialShift.inc -/ namespace Source29PolynomialInitialShift open MvPolynomial Filter open scoped Topology noncomputable section /-- The first possible nonzero homogeneous component survives an ordinary dilation after any flat differentiable normal shift. All hypotheses are stated directly for the polynomial and the shift. -/ theorem normal_shift_initial_limit {n : ℕ} (F : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hlow : ∀ k < d, homogeneousComponent k F = 0) {g : (Fin n → ℝ) → ℝ} (hg : DifferentiableAt ℝ g 0) (hg0 : g 0 = 0) (hD : fderiv ℝ g 0 = 0) (x : ℝ) (y : Fin n → ℝ) : Tendsto (fun t : ℝ => eval (Fin.cons (g (t • y) + t*x) (t • y)) F / t^d) (𝓝[>] 0) (𝓝 (eval (Fin.cons x y) (homogeneousComponent d F))) := by let z : ℝ → (Fin (n+1) → ℝ) := fun t => Fin.cons (x + g (t • y)/t) y have hratio := Source29PureInitialFlatShift.flat_shift_div_tendsto_zero hg hg0 hD y have hz : Tendsto z (𝓝[>] 0) (𝓝 (Fin.cons x y)) := by apply tendsto_pi_nhds.mpr intro i refine Fin.cases ?_ (fun j => ?_) i · simpa only [z, Fin.cons_zero, add_zero] using (tendsto_const_nhds.add hratio : Tendsto (fun t => x + g (t • y)/t) (𝓝[>] 0) (𝓝 (x+0))) · exact tendsto_const_nhds have hlim := Source29RealInitialRescaling.eval_dilate_div_pow_tendsto_moving F d hlow z (Fin.cons x y) hz apply hlim.congr' filter_upwards [self_mem_nhdsWithin] with t ht have he : t • z t = Fin.cons (g (t • y) + t*x) (t • y) := by funext i refine Fin.cases ?_ (fun j => ?_) i · simp only [z, Pi.smul_apply, Fin.cons_zero, smul_eq_mul] field_simp [(show 0 < t from ht).ne'] ring · rfl rw [he] end end Source29PolynomialInitialShift /- Component: RegularInitialHalfspaceSigns.inc -/ namespace Source29RegularInitialHalfspaceSigns open MvPolynomial Filter open scoped Topology noncomputable section variable {n : ℕ} /-- A flat regular odd factor with locally nonnegative cofactor gives the first possible homogeneous component the global weak signs of its normal variable. -/ theorem halfspace_signs_of_flat_graph (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : Odd k) (hfac : F = P^k*Q) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (hg0 : g 0 = 0) (hD : fderiv ℝ g 0 = 0) (hroot : ∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) P = 0) (hn : 0 < eval (0 : Fin (n+1) → ℝ) (pderiv 0 P)) (hQ : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) Q) (d : ℕ) (hlow : ∀ j < d, homogeneousComponent j F = 0) : (∀ z : Fin (n+1) → ℝ, 0 < z 0 → 0 ≤ eval z (homogeneousComponent d F)) ∧ (∀ z : Fin (n+1) → ℝ, z 0 < 0 → eval z (homogeneousComponent d F) ≤ 0) := by have hbase : (Fin.cons (g 0) 0 : Fin (n+1) → ℝ) = 0 := by rw [hg0] funext i exact Fin.cases rfl (fun j ↦ rfl) i have hn' : 0 < eval (Fin.cons (g 0) 0) (pderiv 0 P) := by rwa [hbase] obtain ⟨hpos,hneg⟩ := Source29NewtonShiftedLocalSigns.factor_halfspace_signs F P Q k hk hfac g 0 hg hroot hn' hQ have hlim : ∀ z : ℝ × (Fin n → ℝ), Tendsto (fun t : ℝ ↦ eval (Fin.cons (g (t•z.2)+t*z.1) (t•z.2)) F / t^d) (𝓝[>] 0) (𝓝 (eval (Fin.cons z.1 z.2) (homogeneousComponent d F))) := by intro z exact Source29PolynomialInitialShift.normal_shift_initial_limit F d hlow hg.differentiableAt hg0 hD z.1 z.2 obtain ⟨hspos,hsneg⟩ := Source29LocalWeightedSignLimit.sign_inherited (fun z : ℝ × (Fin n → ℝ) ↦ eval (Fin.cons (g z.2+z.1) z.2) F) (fun z ↦ eval (Fin.cons z.1 z.2) (homogeneousComponent d F)) 1 d zero_lt_one hpos hneg (fun z ↦ by simpa only [Source29LocalWeightedSignLimit.scaledPoint, Real.rpow_one, Real.rpow_natCast] using hlim z) constructor · intro z hz have ht := hspos (z 0, Fin.tail z) hz simpa only [Fin.cons_self_tail] using ht · intro z hz have ht := hsneg (z 0, Fin.tail z) hz simpa only [Fin.cons_self_tail] using ht /-- At an oriented regular factor point, the local cofactor sign forces the ordinary homogeneous initial component to have the global normal halfspace signs. No leading equation, irreducibility, degree bound or nonzero initial form is needed. -/ theorem halfspace_signs (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : Odd k) (hfac : F = P^k*Q) (hP : eval 0 P = 0) (hn : 0 < eval (0 : Fin (n+1) → ℝ) (pderiv 0 P)) (ht : ∀ i : Fin n, eval 0 (pderiv i.succ P) = 0) (hQ : ∀ᶠ z : Fin (n+1) → ℝ in 𝓝 0, 0 ≤ eval z Q) (d : ℕ) (hlow : ∀ j < d, homogeneousComponent j F = 0) : (∀ z : Fin (n+1) → ℝ, 0 < z 0 → 0 ≤ eval z (homogeneousComponent d F)) ∧ (∀ z : Fin (n+1) → ℝ, z 0 < 0 → eval z (homogeneousComponent d F) ≤ 0) := by obtain ⟨g,hg,hg0,_,hD,hroot⟩ := Source29FlatRegularGraph.exists_flat_local_graph P hP hn.ne' ht have hchart : Tendsto (fun z : ℝ × (Fin n → ℝ) ↦ (Fin.cons (g z.2+z.1) z.2 : Fin (n+1) → ℝ)) (𝓝 0) (𝓝 0) := by apply tendsto_pi_nhds.mpr intro i refine Fin.cases ?_ (fun j ↦ ?_) i · have hsnd : Tendsto (Prod.snd : ℝ × (Fin n → ℝ) → (Fin n → ℝ)) (𝓝 0) (𝓝 0) := continuous_snd.tendsto 0 have hfst : Tendsto (Prod.fst : ℝ × (Fin n → ℝ) → ℝ) (𝓝 0) (𝓝 0) := continuous_fst.tendsto 0 have hs := (hg.continuousAt.tendsto.comp hsnd).add hfst simpa only [hg0, zero_add, Pi.zero_apply, Fin.cons_zero, Function.comp_apply] using hs · exact ((continuous_apply j).comp continuous_snd).continuousAt.tendsto exact halfspace_signs_of_flat_graph F P Q k hk hfac g hg hg0 hD hroot hn (hchart.eventually hQ) d hlow end end Source29RegularInitialHalfspaceSigns /- Component: RegularFactorCalibratedInitial.inc -/ namespace Source29RegularFactorCalibratedInitial open MvPolynomial Filter open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open scoped Topology noncomputable section variable {n : ℕ} /-- A calibrated first homogeneous term supplies the previously missing flat-tangent input to the regular-factor Newton argument. -/ theorem cofactor_pos_of_calibrated_initial (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : Odd k) (hfac : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (hP0 : eval (0 : Fin (n+1) → ℝ) P = 0) (hn : 0 < eval (0 : Fin (n+1) → ℝ) (pderiv 0 P)) (ht : ∀ i : Fin n, eval (0 : Fin (n+1) → ℝ) (pderiv i.succ P) = 0) (hQ : ∀ᶠ z : Fin (n+1) → ℝ in 𝓝 0, 0 ≤ eval z Q) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (d : ℕ) (hlow : ∀ j < d, homogeneousComponent j F = 0) (hne : homogeneousComponent d F ≠ 0) (hcal : WeakCalibration (leadingNormalizedField (homogeneousComponent d F))) : 0 < eval (0 : Fin (n+1) → ℝ) Q ∧ d = k ∧ homogeneousComponent d F = C ((eval (0 : Fin (n+1) → ℝ) (pderiv 0 P))^k * eval (0 : Fin (n+1) → ℝ) Q) * (X 0)^d := by obtain ⟨hpos,hneg⟩ := Source29RegularInitialHalfspaceSigns.halfspace_signs F P Q k hk hfac hP0 hn ht hQ d hlow obtain ⟨c,hc,_,hpure⟩ := Source29CalibratedHalfspaceRigidity.eq_positive_odd_normal_power (homogeneousComponent d F) d (homogeneousComponent_isHomogeneous d F) hne hcal hpos hneg obtain ⟨hQpos,hdk,hformula⟩ := Source29RegularFactorPureInitialCriterion.cofactor_pos_of_pure_initial F P Q k hk hfac hP hPQ hP0 hn ht hQ hF d c hc.ne' hlow hpure exact ⟨hQpos,hdk,by rwa [hformula] at hpure⟩ end end Source29RegularFactorCalibratedInitial /- Component: AffinePolynomialTransport.inc -/ namespace Source29AffinePolynomialTransport open MvPolynomial Source29PolynomialTranslation open Source29QuarticReuse.QuarticMinimal open scoped BigOperators Matrix open Filter open scoped Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def translationEquiv (a : ι → ℝ) : MvPolynomial ι ℝ ≃ₐ[ℝ] MvPolynomial ι ℝ := AlgEquiv.ofBijective (aeval (fun i => X i + C (a i))) ⟨translate_injective a, fun P => ⟨translate P (-a), by change translate (translate P (-a)) a = P simpa using translate_inverse P (-a)⟩⟩ omit [Fintype ι] [DecidableEq ι] in theorem translationEquiv_apply (a : ι → ℝ) (P : MvPolynomial ι ℝ) : translationEquiv a P = translate P a := rfl def orthogonalEquiv (U : Matrix ι ι ℝ) (hU : U * U.transpose = 1) : MvPolynomial ι ℝ ≃ₐ[ℝ] MvPolynomial ι ℝ := AlgEquiv.ofBijective (changeVariables U) ⟨changeVariables_injective U hU, fun P => ⟨changeVariables U.transpose P, by rw [changeVariables_comp, mul_eq_one_comm.mp hU, changeVariables_one]⟩⟩ theorem orthogonalEquiv_apply (U : Matrix ι ι ℝ) (hU : U * U.transpose = 1) (P : MvPolynomial ι ℝ) : orthogonalEquiv U hU P = changeVariables U P := rfl /-- Pullback by the affine orthogonal map x ↦ a + Ux. -/ def affineEquiv (a : ι → ℝ) (U : Matrix ι ι ℝ) (hU : U * U.transpose = 1) : MvPolynomial ι ℝ ≃ₐ[ℝ] MvPolynomial ι ℝ := (translationEquiv a).trans (orthogonalEquiv U hU) theorem affineEquiv_apply (a : ι → ℝ) (U : Matrix ι ι ℝ) (hU : U * U.transpose = 1) (P : MvPolynomial ι ℝ) : affineEquiv a U hU P = changeVariables U (translate P a) := rfl theorem eval_affineEquiv (a : ι → ℝ) (U : Matrix ι ι ℝ) (hU : U * U.transpose = 1) (P : MvPolynomial ι ℝ) (x : ι → ℝ) : eval x (affineEquiv a U hU P) = eval (a + U *ᵥ x) P := by rw [affineEquiv_apply, eval_changeVariables, eval_translate] rfl theorem eval_zero_affineEquiv (a : ι → ℝ) (U : Matrix ι ι ℝ) (hU : U * U.transpose = 1) (P : MvPolynomial ι ℝ) : eval (0 : ι → ℝ) (affineEquiv a U hU P) = eval a P := by rw [eval_affineEquiv, Matrix.mulVec_zero, add_zero] omit [DecidableEq ι] in theorem leadingOperator_translate (P : MvPolynomial ι ℝ) (a : ι → ℝ) : leadingOperator (translate P a) = translate (leadingOperator P) a := by simp only [leadingOperator, laplacian, pderiv_translate] change (∑ i, translationEquiv a (pderiv i P) ^ 2) * (∑ i, translationEquiv a (pderiv i (pderiv i P))) - (∑ i, ∑ j, translationEquiv a (pderiv i P) * translationEquiv a (pderiv j P) * translationEquiv a (pderiv i (pderiv j P))) = translationEquiv a _ simp only [map_sub, map_mul, map_sum, map_pow] theorem leadingOperator_affineEquiv (a : ι → ℝ) (U : Matrix ι ι ℝ) (hU : U * U.transpose = 1) (P : MvPolynomial ι ℝ) : leadingOperator (affineEquiv a U hU P) = affineEquiv a U hU (leadingOperator P) := by rw [affineEquiv_apply, leadingOperator_changeVariables U hU, leadingOperator_translate, affineEquiv_apply] theorem eventually_nonneg_affineEquiv (a : ι → ℝ) (U : Matrix ι ι ℝ) (hU : U * U.transpose = 1) (Q : MvPolynomial ι ℝ) (hQ : ∀ᶠ x in 𝓝 a, 0 ≤ eval x Q) : ∀ᶠ x in 𝓝 (0 : ι → ℝ), 0 ≤ eval x (affineEquiv a U hU Q) := by have hc : Continuous (fun x : ι → ℝ => a + U *ᵥ x) := by unfold Matrix.mulVec dotProduct fun_prop have ht : Tendsto (fun x : ι → ℝ => a + U *ᵥ x) (𝓝 0) (𝓝 a) := by simpa only [ContinuousAt, Matrix.mulVec_zero, add_zero] using hc.continuousAt (x := 0) filter_upwards [ht.eventually hQ] with x hx rwa [eval_affineEquiv] end end Source29AffinePolynomialTransport /- Component: RegularNormalCoordinates.inc -/ namespace Source29RegularNormalCoordinates open MvPolynomial Source29PolynomialTranslation Source29AffinePolynomialTransport open Source29QuarticReuse.QuarticMinimal Source29OrthogonalFrame open Source29QuarticReuse.FluxObstruction open scoped BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem exists_orthogonal_matrix_column (i : ι) (v : EuclideanSpace ℝ ι) (hv : ‖v‖ = 1) : ∃ U : Matrix ι ι ℝ, U.transpose * U = 1 ∧ U * U.transpose = 1 ∧ ∀ j, U j i = v j := by let T := (ℝ ∙ (coordinateUnit i - v))ᗮ.reflection have hT : T (coordinateUnit i) = v := Submodule.reflection_sub ((coordinateUnit_norm i).trans hv.symm) let U : Matrix ι ι ℝ := fun a b => T (coordinateUnit b) a have hU : U.transpose * U = 1 := by ext a b have he := T.inner_map_map (coordinateUnit a) (coordinateUnit b) rw [coordinateUnit_inner] at he simpa only [PiLp.inner_apply, RCLike.inner_apply, conj_trivial, mul_comm, Matrix.mul_apply, Matrix.transpose_apply, Matrix.one_apply] using he exact ⟨U, hU, mul_eq_one_comm.mp hU, fun j => congrArg (fun z : EuclideanSpace ℝ ι => z j) hT⟩ /-- Every regular zero has affine orthogonal coordinates with positive first normal derivative and all tangential derivatives zero. -/ theorem exists_regular_normal_coordinates {n : ℕ} (P : MvPolynomial (Fin (n+1)) ℝ) (a : Fin (n+1) → ℝ) (ha : eval a P = 0) (hreg : evaluatedGradient P a ≠ 0) : ∃ (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U * U.transpose = 1), eval (0 : Fin (n+1) → ℝ) (affineEquiv a U hU P) = 0 ∧ 0 < eval (0 : Fin (n+1) → ℝ) (pderiv 0 (affineEquiv a U hU P)) ∧ ∀ j : Fin n, eval (0 : Fin (n+1) → ℝ) (pderiv j.succ (affineEquiv a U hU P)) = 0 := by let G : EuclideanSpace ℝ (Fin (n+1)) := WithLp.toLp 2 (evaluatedGradient P a) have hG : G ≠ 0 := by intro hz apply hreg funext j exact congrArg (fun z : EuclideanSpace ℝ (Fin (n+1)) => z j) hz let g : ℝ := ‖G‖ have hg : 0 < g := norm_pos_iff.mpr hG have hv : ‖g⁻¹ • G‖ = 1 := by rw [norm_smul, norm_inv, Real.norm_eq_abs, abs_of_pos hg] exact inv_mul_cancel₀ hg.ne' obtain ⟨U, hUt, hU, hcol⟩ := exists_orthogonal_matrix_column 0 (g⁻¹ • G) hv have hgrad : ∀ j, eval a (pderiv j P) = g * U j 0 := by intro j rw [hcol] change eval a (pderiv j P) = g * (g⁻¹ * eval a (pderiv j P)) rw [← mul_assoc, mul_inv_cancel₀ hg.ne', one_mul] have hdot : ∀ j, (∑ i, U i 0 * U i j) = if 0 = j then 1 else 0 := by intro j have he := congrArg (fun M : Matrix (Fin (n+1)) (Fin (n+1)) ℝ => M 0 j) hUt simpa only [Matrix.mul_apply, Matrix.transpose_apply, Matrix.one_apply] using he have hpartial : ∀ j, eval (0 : Fin (n+1) → ℝ) (pderiv j (affineEquiv a U hU P)) = g * (if 0 = j then 1 else 0) := by intro j rw [affineEquiv_apply, pderiv_changeVariables, map_sum] simp only [map_mul, eval_C, eval_changeVariables, Matrix.mulVec_zero, pderiv_translate, eval_zero_translate] simp_rw [hgrad, mul_assoc] rw [← Finset.mul_sum, hdot] refine ⟨U, hU, ?_, ?_, ?_⟩ · rwa [eval_zero_affineEquiv] · simpa only [hpartial, ite_true, mul_one] using hg · intro j rw [hpartial, ite_eq_right (Ne.symm (Fin.succ_ne_zero j)), mul_zero] end end Source29RegularNormalCoordinates /- Component: DilatedCalibration.inc -/ namespace Source29DilatedCalibration open MvPolynomial MeasureTheory open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open scoped BigOperators noncomputable section variable {n : ℕ} /-- Positive scalar changes of input preserve the weak calibration identity. The inverse change of variables transports the compact test function. -/ theorem weakCalibration_dilate (Z : (Fin n → ℝ) → Fin n → ℝ) (hZ : WeakCalibration Z) (r : ℝ) (hr : 0 < r) : WeakCalibration (fun x ↦ Z (r • x)) := by refine ⟨fun x i ↦ hZ.1 (r • x) i, ?_⟩ intro φ hφ hcφ let ψ : (Fin n → ℝ) → ℝ := fun y ↦ φ (r⁻¹ • y) have hψ : ContDiff ℝ 1 ψ := hφ.comp (contDiff_id.const_smul r⁻¹) have hcψ : HasCompactSupport ψ := hcφ.comp_homeomorph (Homeomorph.smulOfNeZero r⁻¹ (inv_ne_zero hr.ne')) have hbase := hZ.2 ψ hψ hcψ have he : (fun x ↦ testFlux (fun i ↦ Pi.single i 1) φ (fun y ↦ Z (r • y)) x) = (fun x ↦ r * testFlux (fun i ↦ Pi.single i 1) ψ Z (r • x)) := by funext x have hd : fderiv ℝ ψ (r • x) = r⁻¹ • fderiv ℝ φ x := by dsimp only [ψ] rw [fderiv_comp_smul, smul_smul, inv_mul_cancel₀ hr.ne', one_smul] simp only [testFlux, hd, _root_.smul_apply, smul_eq_mul, Finset.mul_sum] apply Finset.sum_congr rfl intro i hi field_simp constructor · change Integrable (fun x ↦ testFlux (fun i ↦ Pi.single i 1) φ (fun y ↦ Z (r • y)) x) rw [he] exact (hbase.1.comp_smul hr.ne').const_mul r · rw [he, integral_const_mul, Measure.integral_comp_smul_of_nonneg volume (testFlux (fun i ↦ Pi.single i 1) ψ Z) r (hR := hr.le), hbase.2, smul_zero, mul_zero] end end Source29DilatedCalibration /- Component: InitialWeakCalibration.inc -/ namespace Source29InitialWeakCalibration open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29WeakCalibrationLimits open scoped Topology noncomputable section variable {n : ℕ} /-- The first nonzero positive-degree homogeneous component of a calibrated polynomial inherits the normalized-gradient weak calibration. -/ theorem initial_weakCalibration (F : MvPolynomial (Fin n) ℝ) (hcal : WeakCalibration (leadingNormalizedField F)) (s : ℕ) (hlow : ∀ k < s+1, homogeneousComponent k F = 0) (hne : homogeneousComponent (s+1) F ≠ 0) : WeakCalibration (leadingNormalizedField (homogeneousComponent (s+1) F)) := by let t : ℕ → ℝ := fun k ↦ (dilationRadius k)⁻¹ have ht : ∀ k, 0 < t k := fun k ↦ inv_pos.mpr (dilationRadius_pos k) have ht0 : Tendsto t atTop (𝓝 0) := tendsto_inv_atTop_zero.comp dilationRadius_tendsto apply weakCalibration_limit (F := fun k x ↦ leadingNormalizedField F (t k • x)) · intro k exact Source29DilatedCalibration.weakCalibration_dilate _ hcal (t k) (ht k) · exact leadingNormalizedField_bound _ · exact Source29InitialGradientLimit.normalized_gradient_initial_limit_ae F s hlow hne ht ht0 end end Source29InitialWeakCalibration /- Component: RegularCalibratedFactorPositivity.inc -/ namespace Source29RegularCalibratedFactorPositivity open MvPolynomial Filter open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open scoped Topology noncomputable section variable {n : ℕ} /-- Calibration of the full polynomial determines its first homogeneous term at a regular point of an odd irreducible factor, and makes the cofactor positive. -/ theorem cofactor_pos_and_initial (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : Odd k) (hfac : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (hP0 : eval (0 : Fin (n+1) → ℝ) P = 0) (hn : 0 < eval (0 : Fin (n+1) → ℝ) (pderiv 0 P)) (ht : ∀ i : Fin n, eval (0 : Fin (n+1) → ℝ) (pderiv i.succ P) = 0) (hQ : ∀ᶠ z : Fin (n+1) → ℝ in 𝓝 0, 0 ≤ eval z Q) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (hcal : WeakCalibration (leadingNormalizedField F)) : 0 < eval (0 : Fin (n+1) → ℝ) Q ∧ (∀ j < k, homogeneousComponent j F = 0) ∧ homogeneousComponent k F = C ((eval (0 : Fin (n+1) → ℝ) (pderiv 0 P))^k * eval (0 : Fin (n+1) → ℝ) Q) * (X 0)^k := by have hQne : Q ≠ 0 := by intro hz apply hPQ rw [hz] exact dvd_zero P have hFne : F ≠ 0 := by rw [hfac] exact mul_ne_zero (pow_ne_zero k hP.ne_zero) hQne have hk0 : k ≠ 0 := by obtain ⟨j, hj⟩ := hk omega have hF0 : eval (0 : Fin (n+1) → ℝ) F = 0 := by rw [hfac, map_mul, map_pow, hP0, zero_pow hk0, zero_mul] obtain ⟨d, hd, _, hne, hlow⟩ := Source29PolynomialTranslation.exists_lowest_nonzero_component F hFne hF0 cases d with | zero => omega | succ s => have hical := Source29InitialWeakCalibration.initial_weakCalibration F hcal s hlow hne obtain ⟨hqpos, hsk, hformula⟩ := Source29RegularFactorCalibratedInitial.cofactor_pos_of_calibrated_initial F P Q k hk hfac hP hPQ hP0 hn ht hQ hF (s+1) hlow hne hical refine ⟨hqpos, ?_, ?_⟩ · simpa only [hsk] using hlow · simpa only [hsk] using hformula /-- The regular cofactor-positivity conclusion needs no separately supplied initial form or initial calibration. -/ theorem cofactor_pos (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : Odd k) (hfac : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (hP0 : eval (0 : Fin (n+1) → ℝ) P = 0) (hn : 0 < eval (0 : Fin (n+1) → ℝ) (pderiv 0 P)) (ht : ∀ i : Fin n, eval (0 : Fin (n+1) → ℝ) (pderiv i.succ P) = 0) (hQ : ∀ᶠ z : Fin (n+1) → ℝ in 𝓝 0, 0 ≤ eval z Q) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (hcal : WeakCalibration (leadingNormalizedField F)) : 0 < eval (0 : Fin (n+1) → ℝ) Q := (cofactor_pos_and_initial F P Q k hk hfac hP hPQ hP0 hn ht hQ hF hcal).1 end end Source29RegularCalibratedFactorPositivity /- Component: OrthogonalCalibration.inc -/ namespace Source29OrthogonalCalibration open Matrix MvPolynomial MeasureTheory open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.QuarticMinimal open Source29WeakCalibrationLimits open scoped BigOperators noncomputable section variable {n : ℕ} /-- Orthogonal coordinate change on the usual finite coordinate space. -/ def rotationHomeomorph (U : Matrix (Fin n) (Fin n) ℝ) (hU : U * U.transpose = 1) : (Fin n → ℝ) ≃ₜ (Fin n → ℝ) where toFun := fun x ↦ U *ᵥ x invFun := fun x ↦ U.transpose *ᵥ x left_inv x := by change U.transpose *ᵥ (U *ᵥ x) = x rw [Matrix.mulVec_mulVec, mul_eq_one_comm.mp hU, Matrix.one_mulVec] right_inv x := by change U *ᵥ (U.transpose *ᵥ x) = x rw [Matrix.mulVec_mulVec, hU, Matrix.one_mulVec] continuous_toFun := (Matrix.toLin' U).continuous_on_pi continuous_invFun := (Matrix.toLin' U.transpose).continuous_on_pi lemma rotation_measurePreserving (U : Matrix (Fin n) (Fin n) ℝ) (hU : U * U.transpose = 1) : MeasurePreserving (fun x : Fin n → ℝ ↦ U *ᵥ x) volume volume := by have hdet := congrArg Matrix.det hU rw [Matrix.det_mul, Matrix.det_transpose, Matrix.det_one] at hdet have hd : |U.det| = 1 := by have hs : |U.det|^2 = 1 := by rw [sq_abs, pow_two, hdet] nlinarith [abs_nonneg U.det] have hn : U.det ≠ 0 := by intro h rw [h, abs_zero] at hd exact zero_ne_one hd have hm := Real.map_matrix_volume_pi_eq_smul_volume_pi (M := U) hn rw [abs_inv, hd, inv_one, ENNReal.ofReal_one, one_smul] at hm exact ⟨(Matrix.toLin' U).continuous_on_pi.measurable, hm⟩ lemma normalizedField_changeVariables (U : Matrix (Fin n) (Fin n) ℝ) (hU : U * U.transpose = 1) (F : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) : leadingNormalizedField (changeVariables U F) x = U.transpose *ᵥ leadingNormalizedField F (U *ᵥ x) := by have hg : evaluatedGradient (changeVariables U F) x = U.transpose *ᵥ evaluatedGradient F (U *ᵥ x) := by funext j simp only [evaluatedGradient, pderiv_changeVariables, map_sum, map_mul, eval_C, eval_changeVariables, Matrix.mulVec, dotProduct, Matrix.transpose_apply] apply Finset.sum_congr rfl intro i hi ring have hs : radiusSq (evaluatedGradient (changeVariables U F) x) = radiusSq (evaluatedGradient F (U *ᵥ x)) := by rw [hg] have he := MatrixAlgebra.dot_transpose_mulVec U hU (evaluatedGradient F (U *ᵥ x)) (evaluatedGradient F (U *ᵥ x)) simpa only [radiusSq, dotProduct, ← pow_two] using he rw [hg] at hs funext i simp only [leadingNormalizedField, hg, hs, Matrix.mulVec, dotProduct, mul_div_assoc, Finset.sum_div] lemma testFlux_eq_fderiv (φ : (Fin n → ℝ) → ℝ) (Z : (Fin n → ℝ) → Fin n → ℝ) (x : Fin n → ℝ) : testFlux (fun i ↦ Pi.single i 1) φ Z x = fderiv ℝ φ x (Z x) := by have hz : Z x = ∑ i, Z x i • Pi.single i 1 := by funext j simp [Pi.single_apply] conv_rhs => rw [hz, map_sum] simp only [testFlux, map_smul, smul_eq_mul, mul_comm] /-- Orthogonal changes of variables preserve a polynomial's weak normalized calibration. The bound follows from the transformed polynomial itself. -/ theorem weakCalibration_changeVariables (U : Matrix (Fin n) (Fin n) ℝ) (hU : U * U.transpose = 1) (F : MvPolynomial (Fin n) ℝ) (hcal : WeakCalibration (leadingNormalizedField F)) : WeakCalibration (leadingNormalizedField (changeVariables U F)) := by refine ⟨leadingNormalizedField_bound _, ?_⟩ intro φ hφ hcφ let ψ : (Fin n → ℝ) → ℝ := fun y ↦ φ (U.transpose *ᵥ y) let L : (Fin n → ℝ) →L[ℝ] (Fin n → ℝ) := (Matrix.toLin' U.transpose).toContinuousLinearMap have hψ : ContDiff ℝ 1 ψ := hφ.comp L.contDiff have hcψ : HasCompactSupport ψ := hcφ.comp_homeomorph (rotationHomeomorph U hU).symm have hbase := hcal.2 ψ hψ hcψ have he : (fun x ↦ testFlux (fun i ↦ Pi.single i 1) φ (leadingNormalizedField (changeVariables U F)) x) = (fun x ↦ testFlux (fun i ↦ Pi.single i 1) ψ (leadingNormalizedField F) (U *ᵥ x)) := by funext x have hcancel : U.transpose *ᵥ (U *ᵥ x) = x := by rw [Matrix.mulVec_mulVec, mul_eq_one_comm.mp hU, Matrix.one_mulVec] have hd := (hφ.differentiable (by norm_num) (L (U *ᵥ x))).hasFDerivAt.comp (U *ᵥ x) L.hasFDerivAt have hde : fderiv ℝ ψ (U *ᵥ x) = (fderiv ℝ φ x).comp L := by have hd' := hd.fderiv change fderiv ℝ ψ (U *ᵥ x) = (fderiv ℝ φ (L (U *ᵥ x))).comp L at hd' simpa only [show L (U *ᵥ x) = x from hcancel] using hd' rw [testFlux_eq_fderiv, testFlux_eq_fderiv, hde, normalizedField_changeVariables U hU] rfl have hmp := rotation_measurePreserving U hU constructor · change Integrable (fun x ↦ testFlux (fun i ↦ Pi.single i 1) φ (leadingNormalizedField (changeVariables U F)) x) rw [he] exact hmp.integrable_comp_of_integrable hbase.1 · rw [he] have hi := hmp.integral_comp (rotationHomeomorph U hU).toMeasurableEquiv.measurableEmbedding (testFlux (fun i ↦ Pi.single i 1) ψ (leadingNormalizedField F)) exact hi.trans hbase.2 end end Source29OrthogonalCalibration /- Component: RegularCofactorAtPoint.inc -/ namespace Source29RegularCofactorAtPoint open MvPolynomial Filter open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29AffinePolynomialTransport Source29PolynomialTranslation open scoped Topology Matrix noncomputable section variable {n : ℕ} /-- Orthogonal affine coordinates preserve the normalized-gradient calibration. -/ theorem weakCalibration_affineEquiv (F : MvPolynomial (Fin n) ℝ) (hcal : WeakCalibration (leadingNormalizedField F)) (a : Fin n → ℝ) (U : Matrix (Fin n) (Fin n) ℝ) (hU : U * U.transpose = 1) : WeakCalibration (leadingNormalizedField (affineEquiv a U hU F)) := by rw [affineEquiv_apply] apply Source29OrthogonalCalibration.weakCalibration_changeVariables U hU simpa only [map_zero, sub_zero] using Source29TranslatedCalibration.polynomial_translated_level_weakCalibration F hcal 0 a /-- A locally nonnegative cofactor of an odd irreducible factor is strictly positive at every regular zero of that factor, independently of coordinates. -/ theorem cofactor_pos_at_regular_zero_succ (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : Odd k) (hfac : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (hcal : WeakCalibration (leadingNormalizedField F)) (a : Fin (n+1) → ℝ) (ha : eval a P = 0) (hreg : evaluatedGradient P a ≠ 0) (hQ : ∀ᶠ z : Fin (n+1) → ℝ in 𝓝 a, 0 ≤ eval z Q) : 0 < eval a Q := by obtain ⟨U, hU, hP0, hn, ht⟩ := Source29RegularNormalCoordinates.exists_regular_normal_coordinates P a ha hreg let E := affineEquiv a U hU have hEP : Irreducible (E P) := (MulEquiv.irreducible_iff E).mpr hP have hEPQ : ¬ E P ∣ E Q := by intro hd exact hPQ ((map_dvd_iff E.toRingEquiv).mp hd) have hEfac : E F = (E P)^k * E Q := by rw [hfac, map_mul, map_pow] have hEF : Source29QuarticReuse.QuarticMinimal.leadingOperator (E F) = 0 := by change Source29QuarticReuse.QuarticMinimal.leadingOperator (affineEquiv a U hU F) = 0 rw [leadingOperator_affineEquiv, hF, map_zero] have hEcal : WeakCalibration (leadingNormalizedField (E F)) := weakCalibration_affineEquiv F hcal a U hU have hEQ : ∀ᶠ z : Fin (n+1) → ℝ in 𝓝 0, 0 ≤ eval z (E Q) := eventually_nonneg_affineEquiv a U hU Q hQ have hpos := Source29RegularCalibratedFactorPositivity.cofactor_pos (E F) (E P) (E Q) k hk hEfac hEP hEPQ hP0 hn ht hEQ hEF hEcal simpa only [E, eval_zero_affineEquiv] using hpos /-- The coordinate-free regular-cofactor result in every ambient dimension. The zero-dimensional case has no regular zero. -/ theorem cofactor_pos_at_regular_zero (F P Q : MvPolynomial (Fin n) ℝ) (k : ℕ) (hk : Odd k) (hfac : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (hcal : WeakCalibration (leadingNormalizedField F)) (a : Fin n → ℝ) (ha : eval a P = 0) (hreg : evaluatedGradient P a ≠ 0) (hQ : ∀ᶠ z : Fin n → ℝ in 𝓝 a, 0 ≤ eval z Q) : 0 < eval a Q := by cases n with | zero => exact (hreg (Subsingleton.elim _ _)).elim | succ n => exact cofactor_pos_at_regular_zero_succ F P Q k hk hfac hP hPQ hF hcal a ha hreg hQ end end Source29RegularCofactorAtPoint /- Component: FlatGraphInitialSigns.inc -/ namespace Source29FlatGraphInitialSigns open MvPolynomial Filter open scoped Topology noncomputable section variable {n : ℕ} /-- Signs on the two sides of a flat differentiable graph pass to the first homogeneous term without assuming regularity of a polynomial factor. -/ theorem halfspace_signs (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (hg : DifferentiableAt ℝ g 0) (hg0 : g 0 = 0) (hD : fderiv ℝ g 0 = 0) (hpos : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, 0 < z.1 → 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) F) (hneg : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, z.1 < 0 → eval (Fin.cons (g z.2+z.1) z.2) F ≤ 0) (d : ℕ) (hlow : ∀ j < d, homogeneousComponent j F = 0) : (∀ z : Fin (n+1) → ℝ, 0 < z 0 → 0 ≤ eval z (homogeneousComponent d F)) ∧ (∀ z : Fin (n+1) → ℝ, z 0 < 0 → eval z (homogeneousComponent d F) ≤ 0) := by have hlim : ∀ z : ℝ × (Fin n → ℝ), Tendsto (fun t : ℝ => eval (Fin.cons (g (t•z.2)+t*z.1) (t•z.2)) F / t^d) (𝓝[>] 0) (𝓝 (eval (Fin.cons z.1 z.2) (homogeneousComponent d F))) := by intro z exact Source29PolynomialInitialShift.normal_shift_initial_limit F d hlow hg hg0 hD z.1 z.2 obtain ⟨hspos, hsneg⟩ := Source29LocalWeightedSignLimit.sign_inherited (fun z : ℝ × (Fin n → ℝ) => eval (Fin.cons (g z.2+z.1) z.2) F) (fun z => eval (Fin.cons z.1 z.2) (homogeneousComponent d F)) 1 d zero_lt_one hpos hneg (fun z => by simpa only [Source29LocalWeightedSignLimit.scaledPoint, Real.rpow_one, Real.rpow_natCast] using hlim z) constructor · intro z hz simpa only [Fin.cons_self_tail] using hspos (z 0, Fin.tail z) hz · intro z hz simpa only [Fin.cons_self_tail] using hsneg (z 0, Fin.tail z) hz end end Source29FlatGraphInitialSigns /- Component: CalibratedFlatGraphInitial.inc -/ namespace Source29CalibratedFlatGraphInitial open MvPolynomial Filter open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open scoped Topology noncomputable section variable {n : ℕ} /-- A calibrated polynomial whose signs agree with a flat differentiable graph has a positive odd normal power as its first nonzero homogeneous term. -/ theorem exists_pure_initial (F : MvPolynomial (Fin (n+1)) ℝ) (hF : F ≠ 0) (hF0 : eval 0 F = 0) (hcal : WeakCalibration (leadingNormalizedField F)) (g : (Fin n → ℝ) → ℝ) (hg : DifferentiableAt ℝ g 0) (hg0 : g 0 = 0) (hD : fderiv ℝ g 0 = 0) (hpos : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, 0 < z.1 → 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) F) (hneg : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, z.1 < 0 → eval (Fin.cons (g z.2+z.1) z.2) F ≤ 0) : ∃ (d : ℕ) (c : ℝ), 0 < c ∧ Odd d ∧ (∀ j < d, homogeneousComponent j F = 0) ∧ homogeneousComponent d F = C c * (X 0)^d := by obtain ⟨d, hd, _, hne, hlow⟩ := Source29PolynomialTranslation.exists_lowest_nonzero_component F hF hF0 have hds : d-1+1 = d := by omega have hcal' : WeakCalibration (leadingNormalizedField (homogeneousComponent d F)) := by have hc := Source29InitialWeakCalibration.initial_weakCalibration F hcal (d-1) (by simpa only [hds] using hlow) (by simpa only [hds] using hne) simpa only [hds] using hc obtain ⟨hspos, hsneg⟩ := Source29FlatGraphInitialSigns.halfspace_signs F g hg hg0 hD hpos hneg d hlow obtain ⟨c, hc, hodd, hpure⟩ := Source29CalibratedHalfspaceRigidity.eq_positive_odd_normal_power (homogeneousComponent d F) d (homogeneousComponent_isHomogeneous d F) hne hcal' hspos hsneg exact ⟨d, c, hc, hodd, hlow, hpure⟩ end end Source29CalibratedFlatGraphInitial /- Component: GraphRootMultiplicity.inc -/ namespace Source29GraphRootMultiplicity open MvPolynomial Filter open Source29NewtonNormalDerivative Source29NewtonShiftedFactorCoefficient open Source29QuarticReuse.QuarticMinimal.DistinguishedVariable open scoped Topology noncomputable section variable {n : ℕ} /-- A nonzero polynomial vanishing on a graph over an open parameter germ must depend on the normal variable. No regularity of the graph is needed. -/ theorem normal_natDegree_ne_zero_of_graph_root (P : MvPolynomial (Fin (n+1)) ℝ) (hP : P ≠ 0) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0) : (finSuccEquiv ℝ n P).natDegree ≠ 0 := by intro hd have he := Polynomial.eq_C_of_natDegree_eq_zero hd have hz : (finSuccEquiv ℝ n P).coeff 0 = 0 := by apply Source29LocalHyperplaneDivisor.polynomial_eq_zero_of_locally_zero _ a filter_upwards [hroot] with y hy rw [← eval_sliceHom] at hy change ((finSuccEquiv ℝ n P).map (eval y)).eval (g y) = 0 at hy rw [he, Polynomial.map_C, Polynomial.eval_C] at hy exact hy apply hP apply (finSuccEquiv ℝ n).injective rw [map_zero, he, hz, Polynomial.C_0] /-- Common vanishing on a graph germ forces divisibility by an irreducible polynomial, even when its gradient vanishes at the base point. -/ theorem dvd_of_common_graph_germ (P Q : MvPolynomial (Fin (n+1)) ℝ) (hP : Irreducible P) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0 ∧ eval (Fin.cons (g y) y) Q = 0) : P ∣ Q := by have hdvd : finSuccEquiv ℝ n P ∣ finSuccEquiv ℝ n Q := by apply Source29LocalRegularPatchDensity.dvd_of_common_root_germ _ _ ((MulEquiv.irreducible_iff (finSuccEquiv ℝ n)).mpr hP) (normal_natDegree_ne_zero_of_graph_root P hP.ne_zero g a (hroot.mono fun _ h => h.1)) a g filter_upwards [hroot] with y hy exact ⟨(eval_sliceHom P y (g y)).trans hy.1, (eval_sliceHom Q y (g y)).trans hy.2⟩ exact (map_dvd_iff (finSuccEquiv ℝ n).toRingEquiv).mp hdvd /-- In characteristic zero, normal dependence prevents a polynomial from dividing its own normal derivative. -/ theorem not_dvd_normal_derivative (P : MvPolynomial (Fin (n+1)) ℝ) (hdegree : (finSuccEquiv ℝ n P).natDegree ≠ 0) : ¬ P ∣ pderiv 0 P := by intro h have hdvd := (map_dvd_iff (finSuccEquiv ℝ n).toRingEquiv).mpr h change finSuccEquiv ℝ n P ∣ finSuccEquiv ℝ n (pderiv 0 P) at hdvd rw [finSuccEquiv_pderiv_zero] at hdvd exact hdegree (Polynomial.derivative_eq_zero.mp (Polynomial.dvd_derivative_iff.mp hdvd)) /-- The first possible normal coefficient is a nonzero germ on every graph of a full irreducible factor. Base-point simplicity is a conclusion later. -/ theorem coefficient_not_eventually_zero_of_graph_root (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hF : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0) : ¬ ∀ᶠ y in 𝓝 a, (shiftedSlice F (g y) y).coeff k = 0 := by intro hz have hdvd : P ∣ (pderiv 0 P)^k*Q := by apply dvd_of_common_graph_germ P _ hP g a filter_upwards [hroot, hz] with y hy hzero refine ⟨hy, ?_⟩ simpa only [map_mul, map_pow, coeff_shifted_factor F P Q k hF (g y) y hy] using hzero rcases hP.prime.dvd_mul.mp hdvd with hderiv | hQ · exact not_dvd_normal_derivative P (normal_natDegree_ne_zero_of_graph_root P hP.ne_zero g a hroot) (hP.prime.dvd_of_dvd_pow hderiv) · exact hPQ hQ /-- If all lower normal coefficient germs vanish and the next coefficient is nonzero at the base, its degree is exactly the factor multiplicity. -/ theorem multiplicity_eq_initial_degree (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k d : ℕ) (hF : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0) (htop : (shiftedSlice F (g a) a).coeff d ≠ 0) (hlower : ∀ j : Fin d, ∀ᶠ y in 𝓝 a, (shiftedSlice F (g y) y).coeff (j:ℕ) = 0) : d = k := by apply le_antisymm · by_contra h exact (coefficient_not_eventually_zero_of_graph_root F P Q k hF hP hPQ g a hroot) (hlower ⟨k,Nat.lt_of_not_ge h⟩) · by_contra h exact htop (coeff_shifted_factor_eq_zero_of_lt F P Q k hF (g a) a hroot.self_of_nhds d (Nat.lt_of_not_ge h)) /-- Constant normal multiplicity forces both simplicity of the irreducible factor and nonvanishing of the cofactor at the base point. -/ theorem regularity_and_cofactor_nonzero (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k d : ℕ) (hk : 0 < k) (hF : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) P = 0) (htop : (shiftedSlice F (g a) a).coeff d ≠ 0) (hlower : ∀ j : Fin d, ∀ᶠ y in 𝓝 a, (shiftedSlice F (g y) y).coeff (j:ℕ) = 0) : d = k ∧ eval (Fin.cons (g a) a) (pderiv 0 P) ≠ 0 ∧ eval (Fin.cons (g a) a) Q ≠ 0 := by have hdk := multiplicity_eq_initial_degree F P Q k d hF hP hPQ g a hroot htop hlower have hprod : (eval (Fin.cons (g a) a) (pderiv 0 P))^k * eval (Fin.cons (g a) a) Q ≠ 0 := by rwa [hdk, coeff_shifted_factor F P Q k hF (g a) a hroot.self_of_nhds] at htop refine ⟨hdk, ?_, ?_⟩ · intro hz apply hprod rw [hz, zero_pow hk.ne', zero_mul] · intro hz exact hprod (by rw [hz, mul_zero]) end end Source29GraphRootMultiplicity /- Component: GeometricRegularFactorPositivity.inc -/ namespace Source29GeometricRegularFactorPositivity open MvPolynomial Filter open Source29NewtonShiftedFactorCoefficient Source29NormalShiftDerivatives open Source29NormalShiftAlgebra open scoped Topology noncomputable section variable {n : ℕ} /-- An analytic minimal graph carrying a full irreducible factor becomes an algebraically regular graph when the shifted polynomial has its prescribed halfspace signs and a pure ordinary initial limit. Neither normal simplicity of the factor nor nonvanishing of the cofactor is assumed. -/ theorem regularity_and_cofactor_pos_of_pure_initial (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : 0 < k) (hfac : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (hg0 : gradient g 0 = 0) (hroot : ∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) P = 0) (hQ : 0 ≤ eval (Fin.cons (g 0) 0) Q) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (hbg : ∀ᶠ y in 𝓝 0, backgroundGraphOperator (gradient g y) (hessian g y) = 0) (d : ℕ) (c : ℝ) (hc : c ≠ 0) (hinitial : ∀ x y, Tendsto (fun t : ℝ ↦ eval (Fin.cons (g (t•y)+t*x) (t•y)) F / t^d) (𝓝[>] 0) (𝓝 (c*x^d))) (hpos : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, 0 < z.1 → 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) F) (hneg : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, z.1 < 0 → eval (Fin.cons (g z.2+z.1) z.2) F ≤ 0) : d = k ∧ eval (Fin.cons (g 0) 0) (pderiv 0 P) ≠ 0 ∧ 0 < eval (Fin.cons (g 0) 0) Q ∧ c = (eval (Fin.cons (g 0) 0) (pderiv 0 P))^k * eval (Fin.cons (g 0) 0) Q := by have hlower := Source29NewtonRegularObstruction.lower_coefficient_germs_zero F g hg hg0 hF hbg d c hc hinitial hpos hneg have htop := Source29NewtonInitialCenterCoefficient.center_coefficient_of_pure_initial F g d c hinitial have htopne : (shiftedSlice F (g 0) 0).coeff d ≠ 0 := by rwa [htop] obtain ⟨hdk, hn, hQne⟩ := Source29GraphRootMultiplicity.regularity_and_cofactor_nonzero F P Q k d hk hfac hP hPQ g 0 hroot htopne hlower refine ⟨hdk, hn, lt_of_le_of_ne hQ hQne.symm, ?_⟩ rw [← htop, hdk] exact coeff_shifted_factor F P Q k hfac (g 0) 0 hroot.self_of_nhds end end Source29GeometricRegularFactorPositivity /- Component: CalibratedGeometricRegularity.inc -/ namespace Source29CalibratedGeometricRegularity open MvPolynomial Filter open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29NormalShiftDerivatives Source29NormalShiftAlgebra open scoped Topology noncomputable section variable {n : ℕ} /-- Along an analytic minimal graph, calibration and the two side signs force an irreducible defining factor to be regular and its full cofactor to be positive. No algebraic regularity or prescribed initial form is assumed. -/ theorem regularity_and_cofactor_pos (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : 0 < k) (hfac : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (hg0 : g 0 = 0) (hgrad : gradient g 0 = 0) (hroot : ∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) P = 0) (hQ : 0 ≤ eval (0 : Fin (n+1) → ℝ) Q) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (hcal : WeakCalibration (leadingNormalizedField F)) (hbg : ∀ᶠ y in 𝓝 0, backgroundGraphOperator (gradient g y) (hessian g y) = 0) (hpos : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, 0 < z.1 → 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) F) (hneg : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, z.1 < 0 → eval (Fin.cons (g z.2+z.1) z.2) F ≤ 0) : eval (0 : Fin (n+1) → ℝ) (pderiv 0 P) ≠ 0 ∧ 0 < eval (0 : Fin (n+1) → ℝ) Q ∧ Odd k ∧ (∀ j < k, homogeneousComponent j F = 0) ∧ homogeneousComponent k F = C ((eval (0 : Fin (n+1) → ℝ) (pderiv 0 P))^k * eval (0 : Fin (n+1) → ℝ) Q) * (X 0)^k := by have hbase : (Fin.cons (g 0) 0 : Fin (n+1) → ℝ) = 0 := by rw [hg0] funext i exact Fin.cases rfl (fun j => rfl) i have hP0 : eval (0 : Fin (n+1) → ℝ) P = 0 := by simpa only [hbase] using hroot.self_of_nhds have hQne : Q ≠ 0 := by intro he exact hPQ (he ▸ dvd_zero P) have hFne : F ≠ 0 := by rw [hfac] exact mul_ne_zero (pow_ne_zero k hP.ne_zero) hQne have hF0 : eval (0 : Fin (n+1) → ℝ) F = 0 := by rw [hfac, map_mul, map_pow, hP0, zero_pow hk.ne', zero_mul] have hD := Source29FlatRegularGraph.fderiv_eq_zero_of_gradient_eq_zero g 0 hgrad obtain ⟨d, c, hc, hodd, hlow, hpure⟩ := Source29CalibratedFlatGraphInitial.exists_pure_initial F hFne hF0 hcal g hg.differentiableAt hg0 hD hpos hneg have hinitial := Source29PolynomialPureInitialShift.analytic_normal_shift_pure_initial_limit F d c hlow hpure hg hg0 hD obtain ⟨hdk, hn, hQpos, hformula⟩ := Source29GeometricRegularFactorPositivity.regularity_and_cofactor_pos_of_pure_initial F P Q k hk hfac hP hPQ g hg hgrad hroot (by simpa only [hbase] using hQ) hF hbg d c hc.ne' hinitial hpos hneg rw [hbase] at hn hQpos hformula refine ⟨hn, hQpos, hdk ▸ hodd, ?_, ?_⟩ · simpa only [hdk] using hlow · simpa only [hdk, hformula] using hpure end end Source29CalibratedGeometricRegularity /- Component: GeometricPhaseChart.inc -/ namespace Source29GeometricPhaseChart open MvPolynomial Filter open Source29AffinePolynomialTransport Source29NormalShiftDerivatives Source29NormalShiftAlgebra open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open scoped Topology Matrix noncomputable section variable {n : ℕ} /-- An oriented analytic minimal graph chart of the zero phase boundary, stated for the polynomial itself, independently of its factorization. -/ def HasFlatMinimalPhaseChart (F : MvPolynomial (Fin (n+1)) ℝ) (a : Fin (n+1) → ℝ) : Prop := ∃ (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U * U.transpose = 1) (g : (Fin n → ℝ) → ℝ), AnalyticAt ℝ g 0 ∧ g 0 = 0 ∧ gradient g 0 = 0 ∧ (∀ᶠ y in 𝓝 0, backgroundGraphOperator (gradient g y) (hessian g y) = 0) ∧ (∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) (affineEquiv a U hU F) = 0) ∧ (∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, 0 < z.1 → 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) (affineEquiv a U hU F)) ∧ (∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, z.1 < 0 → eval (Fin.cons (g z.2+z.1) z.2) (affineEquiv a U hU F) ≤ 0) theorem affine_weakCalibration (F : MvPolynomial (Fin (n+1)) ℝ) (hcal : WeakCalibration (leadingNormalizedField F)) (a : Fin (n+1) → ℝ) (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U * U.transpose = 1) : WeakCalibration (leadingNormalizedField (affineEquiv a U hU F)) := by have ht : WeakCalibration (leadingNormalizedField (Source29PolynomialTranslation.translate F a)) := by simpa only [map_zero, sub_zero] using Source29TranslatedCalibration.polynomial_translated_level_weakCalibration F hcal 0 a exact Source29OrthogonalCalibration.weakCalibration_changeVariables U hU _ ht /-- A chart of the actual phase boundary suffices for strict residual positivity; no polynomial-gradient regularity is part of the chart data. -/ theorem cofactor_pos_of_phase_chart (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : 0 < k) (hfac : F = P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (hQ : ∀ x, 0 ≤ eval x Q) (hzero : ∀ x, eval x Q = 0 → eval x P = 0) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (hcal : WeakCalibration (leadingNormalizedField F)) (a : Fin (n+1) → ℝ) (hchart : HasFlatMinimalPhaseChart F a) : 0 < eval a Q := by obtain ⟨U, hU, g, hg, hg0, hgrad, hbg, hrootF, hpos, hneg⟩ := hchart let E := affineEquiv a U hU have hfac' : E F = (E P)^k * E Q := by rw [hfac, map_mul, map_pow] have hP' : Irreducible (E P) := (MulEquiv.irreducible_iff E).mpr hP have hPQ' : ¬ E P ∣ E Q := fun h => hPQ ((map_dvd_iff E).mp h) have hF' : Source29QuarticReuse.QuarticMinimal.leadingOperator (E F) = 0 := by dsimp only [E] rw [leadingOperator_affineEquiv, hF, map_zero] have hroot : ∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) (E P) = 0 := by filter_upwards [hrootF] with y hy change eval (Fin.cons (g y) y) (E F) = 0 at hy rw [hfac', map_mul, map_pow] at hy rcases mul_eq_zero.mp hy with hp | hq · by_contra h exact pow_ne_zero k h hp · dsimp only [E] at hq ⊢ rw [eval_affineEquiv] at hq ⊢ exact hzero _ hq have hQ0 : 0 ≤ eval (0 : Fin (n+1) → ℝ) (E Q) := by dsimp only [E] rw [eval_zero_affineEquiv] exact hQ a have result := Source29CalibratedGeometricRegularity.regularity_and_cofactor_pos (E F) (E P) (E Q) k hk hfac' hP' hPQ' g hg hg0 hgrad hroot hQ0 hF' (affine_weakCalibration F hcal a U hU) hbg hpos hneg simpa only [E, eval_zero_affineEquiv] using result.2.1 end end Source29GeometricPhaseChart /- Component: ZeroSetFactorGraph.inc -/ namespace Source29ZeroSetFactorGraph open MvPolynomial Filter Set open Source29AffinePolynomialTransport open scoped Topology Matrix noncomputable section /-- If every real zero of the cofactor is already a zero of the factor, the factor and the full polynomial have the same real zero set. -/ theorem eval_zero_iff {ι : Type*} (F P Q : MvPolynomial ι ℝ) (k : ℕ) (hk : 0 < k) (hfac : F = P^k*Q) (hzero : ∀ x : ι → ℝ, eval x Q = 0 → eval x P = 0) (x : ι → ℝ) : eval x F = 0 ↔ eval x P = 0 := by rw [hfac, map_mul, map_pow, mul_eq_zero] constructor · rintro (hp | hq) · exact eq_zero_of_pow_eq_zero hp · exact hzero x hq · intro hp exact Or.inl (by rw [hp, zero_pow hk.ne']) /-- The zero-set equivalence is unchanged in orthogonal affine coordinates. -/ theorem eval_affine_zero_iff {ι : Type*} [Fintype ι] [DecidableEq ι] (F P Q : MvPolynomial ι ℝ) (k : ℕ) (hk : 0 < k) (hfac : F = P^k*Q) (hzero : ∀ x : ι → ℝ, eval x Q = 0 → eval x P = 0) (a : ι → ℝ) (U : Matrix ι ι ℝ) (hU : U * U.transpose = 1) (x : ι → ℝ) : eval x (affineEquiv a U hU F) = 0 ↔ eval x (affineEquiv a U hU P) = 0 := by simp only [eval_affineEquiv] exact eval_zero_iff F P Q k hk hfac hzero _ theorem graph_root_of_full_root {n : ℕ} (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : 0 < k) (hfac : F = P^k*Q) (hzero : ∀ x : Fin (n+1) → ℝ, eval x Q = 0 → eval x P = 0) (g : (Fin n → ℝ) → ℝ) (b : Fin n → ℝ) (hroot : ∀ᶠ y in 𝓝 b, eval (Fin.cons (g y) y) F = 0) : ∀ᶠ y in 𝓝 b, eval (Fin.cons (g y) y) P = 0 := by filter_upwards [hroot] with y hy exact (eval_zero_iff F P Q k hk hfac hzero _).mp hy theorem affine_graph_root_of_full_root {n : ℕ} (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : 0 < k) (hfac : F = P^k*Q) (hzero : ∀ x : Fin (n+1) → ℝ, eval x Q = 0 → eval x P = 0) (a : Fin (n+1) → ℝ) (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U * U.transpose = 1) (g : (Fin n → ℝ) → ℝ) (b : Fin n → ℝ) (hroot : ∀ᶠ y in 𝓝 b, eval (Fin.cons (g y) y) (affineEquiv a U hU F) = 0) : ∀ᶠ y in 𝓝 b, eval (Fin.cons (g y) y) (affineEquiv a U hU P) = 0 := by filter_upwards [hroot] with y hy exact (eval_affine_zero_iff F P Q k hk hfac hzero a U hU _).mp hy lemma zero_of_local_side_signs {f : ℝ → ℝ} (hf : ContinuousAt f 0) (hpos : ∀ᶠ x in 𝓝 0, 0 < x → 0 ≤ f x) (hneg : ∀ᶠ x in 𝓝 0, x < 0 → f x ≤ 0) : f 0 = 0 := by have hn : Tendsto f (𝓝[<] 0) (𝓝 (f 0)) := hf.mono_left nhdsWithin_le_nhds have hp : Tendsto f (𝓝[>] 0) (𝓝 (f 0)) := hf.mono_left nhdsWithin_le_nhds apply le_antisymm · apply le_of_tendsto hn filter_upwards [hneg.filter_mono nhdsWithin_le_nhds, self_mem_nhdsWithin] with x hx hlt exact hx hlt · apply ge_of_tendsto hp filter_upwards [hpos.filter_mono nhdsWithin_le_nhds, self_mem_nhdsWithin] with x hx hlt exact hx hlt /-- Weak opposite signs near the zero normal slice force that slice to vanish on an open tangential neighborhood. Only normal-slice continuity is required. -/ theorem exists_open_zero_slice {Y : Type*} [TopologicalSpace Y] (f : ℝ × Y → ℝ) (b : Y) (hf : ∀ y, ContinuousAt (fun x : ℝ ↦ f (x,y)) 0) (hpos : ∀ᶠ z in 𝓝 ((0 : ℝ),b), 0 < z.1 → 0 ≤ f z) (hneg : ∀ᶠ z in 𝓝 ((0 : ℝ),b), z.1 < 0 → f z ≤ 0) : ∃ W : Set Y, IsOpen W ∧ b ∈ W ∧ ∀ y ∈ W, f (0,y) = 0 := by obtain ⟨V,W,hV,hV0,hW,hWb,hsub⟩ := mem_nhds_prod_iff'.mp (hpos.and hneg) refine ⟨W,hW,hWb,?_⟩ intro y hy apply zero_of_local_side_signs (hf y) · filter_upwards [hV.mem_nhds hV0] with x hx exact (hsub (show (x,y) ∈ V ×ˢ W from ⟨hx,hy⟩)).1 · filter_upwards [hV.mem_nhds hV0] with x hx exact (hsub (show (x,y) ∈ V ×ˢ W from ⟨hx,hy⟩)).2 /-- Polynomial shifted side signs imply an actual graph of zeros. No regularity of the chosen graph function is needed for this implication. -/ theorem graph_root_of_side_signs {n : ℕ} (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (b : Fin n → ℝ) (hpos : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 (0,b), 0 < z.1 → 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) F) (hneg : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 (0,b), z.1 < 0 → eval (Fin.cons (g z.2+z.1) z.2) F ≤ 0) : ∃ W : Set (Fin n → ℝ), IsOpen W ∧ b ∈ W ∧ ∀ y ∈ W, eval (Fin.cons (g y) y) F = 0 := by have hc (y : Fin n → ℝ) : ContinuousAt (fun x : ℝ ↦ eval (Fin.cons (g y+x) y) F) 0 := by apply Continuous.continuousAt apply (Source29CompactPolynomialLink.continuous_eval F).comp apply continuous_pi intro i refine Fin.cases ?_ (fun j ↦ ?_) i · exact continuous_const.add continuous_id · exact continuous_const obtain ⟨W,hW,hWb,hr⟩ := exists_open_zero_slice (fun z : ℝ × (Fin n → ℝ) ↦ eval (Fin.cons (g z.2+z.1) z.2) F) b hc hpos hneg exact ⟨W,hW,hWb,fun y hy ↦ by simpa only [add_zero] using hr y hy⟩ /-- Explicit open-neighborhood version of the shifted sign-to-root implication. -/ theorem graph_root_of_open_side_signs {n : ℕ} (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (b : Fin n → ℝ) (V : Set (ℝ × (Fin n → ℝ))) (hV : IsOpen V) (hVb : (0,b) ∈ V) (hpos : ∀ z ∈ V, 0 < z.1 → 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) F) (hneg : ∀ z ∈ V, z.1 < 0 → eval (Fin.cons (g z.2+z.1) z.2) F ≤ 0) : ∃ W : Set (Fin n → ℝ), IsOpen W ∧ b ∈ W ∧ ∀ y ∈ W, eval (Fin.cons (g y) y) F = 0 := by apply graph_root_of_side_signs F g b · filter_upwards [hV.mem_nhds hVb] with z hz exact hpos z hz · filter_upwards [hV.mem_nhds hVb] with z hz exact hneg z hz /-- A sign chart for the full polynomial is a zero graph for its selected factor in the same affine coordinates. -/ theorem affine_factor_graph_of_side_signs {n : ℕ} (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : 0 < k) (hfac : F = P^k*Q) (hzero : ∀ x : Fin (n+1) → ℝ, eval x Q = 0 → eval x P = 0) (a : Fin (n+1) → ℝ) (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U * U.transpose = 1) (g : (Fin n → ℝ) → ℝ) (b : Fin n → ℝ) (hpos : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 (0,b), 0 < z.1 → 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) (affineEquiv a U hU F)) (hneg : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 (0,b), z.1 < 0 → eval (Fin.cons (g z.2+z.1) z.2) (affineEquiv a U hU F) ≤ 0) : ∃ W : Set (Fin n → ℝ), IsOpen W ∧ b ∈ W ∧ ∀ y ∈ W, eval (Fin.cons (g y) y) (affineEquiv a U hU P) = 0 := by obtain ⟨W,hW,hWb,hr⟩ := graph_root_of_side_signs (affineEquiv a U hU F) g b hpos hneg exact ⟨W,hW,hWb,fun y hy ↦ (eval_affine_zero_iff F P Q k hk hfac hzero a U hU _).mp (hr y hy)⟩ end end Source29ZeroSetFactorGraph /- Component: GeometricStructureReduction.inc -/ namespace Source29GeometricStructureReduction open MvPolynomial Source29Closing Source29LengthNullCoverings open Source29GeometricPhaseChart Source29PositiveLeadingStructureReduction open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits noncomputable section /-- The zero phase admits oriented flat analytic minimal-graph charts away from a set with arbitrarily short countable ball coverings. -/ def GeometricChartRegularity {n : ℕ} (F : MvPolynomial (Fin (n+1)) ℝ) : Prop := ∃ S : Set (Fin (n+1) → ℝ), HasZeroLengthCoverings S ∧ ∀ a, eval a F = 0 → a ∉ S → HasFlatMinimalPhaseChart F a /-- Every residual zero belongs to the geometric exceptional set; no regularity of the polynomial gradient is assumed. -/ theorem cofactor_zero_length_coverings {n : ℕ} (F p Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : 0 < k) (hfac : F = p^k*Q) (hp : Irreducible p) (hpQ : ¬ p ∣ Q) (hQ : ∀ x, 0 ≤ eval x Q) (hzero : ∀ x, eval x Q = 0 → eval x p = 0) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (hcal : WeakCalibration (leadingNormalizedField F)) (hcharts : GeometricChartRegularity F) : HasZeroLengthCoverings {x : Fin (n+1) → ℝ | eval x Q = 0} := by obtain ⟨S, hS, hchart⟩ := hcharts apply hS.mono intro a ha by_contra haS have hFa : eval a F = 0 := by rw [hfac, map_mul, map_pow, ha, mul_zero] have hpositive := cofactor_pos_of_phase_chart F p Q k hk hfac hp hpQ hQ hzero hF hcal a (hchart a hFa haS) exact hpositive.ne' ha /-- Connected leading sign regions and geometric phase charts imply the positive homogeneous residual factor data used by the closing theorem. -/ theorem positive_leading_factor_of_connectedness_and_phase_charts (P : Polynomial8) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (hpos : IsPreconnected {x : Fin 8 → ℝ | 0 < eval x (homogeneousComponent P.totalDegree P)}) (hneg : IsPreconnected {x : Fin 8 → ℝ | eval x (homogeneousComponent P.totalDegree P) < 0}) (hcharts : GeometricChartRegularity (homogeneousComponent P.totalDegree P)) : PositiveLeadingFactorData8 P := by obtain ⟨p, Q, k, hk, _, hp, hphom, hQhom, hfac, hpQ, _, _, hQ, hzero, _, _⟩ := Source29ConnectedFactorStructure.minimal_graph_nonnegative_leading_factor P hmin hdeg hpos hneg obtain ⟨_, _, hL⟩ := QuarticPolynomialBasics.leading_component_data P hmin hdeg have hcal := Source29TopPhasePerimeter.top_weakCalibration P hmin hdeg have hsmall := cofactor_zero_length_coverings (homogeneousComponent P.totalDegree P) p Q k (by omega) hfac hp hpQ hQ hzero hL hcal hcharts refine ⟨p, Q, k, hk, hp, hphom, hQhom, hfac, ?_⟩ exact Source29HomogeneousZeroCoverings.positive_away_of_zero_length_coverings Q hQhom hQ hsmall /-- Conditional geometric closing reduction. The only remaining inputs here are preconnected leading sign regions and geometric phase-chart regularity. -/ theorem problem29_of_connectedness_and_phase_charts (hconnected : ∀ P : Polynomial8, Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → IsPreconnected {x : Fin 8 → ℝ | 0 < eval x (homogeneousComponent P.totalDegree P)} ∧ IsPreconnected {x : Fin 8 → ℝ | eval x (homogeneousComponent P.totalDegree P) < 0}) (hcharts : ∀ P : Polynomial8, Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → GeometricChartRegularity (homogeneousComponent P.totalDegree P)) : Math30.Problem29 := by apply problem29_of_positive_leading_factor intro P hmin hdeg obtain ⟨hpos, hneg⟩ := hconnected P hmin hdeg exact positive_leading_factor_of_connectedness_and_phase_charts P hmin hdeg hpos hneg (hcharts P hmin hdeg) end end Source29GeometricStructureReduction /- Component: CoordinateTiltExcess.inc -/ namespace Source29CoordinateTiltExcess open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29WeakCalibrationLimits Source29VariationConvexity Source29PolynomialStress open Source29SmoothPhaseTransition Source29PhaseApproximation Source29PhaseMassLimit open Source29NonlinearCalibration open scoped Topology BigOperators noncomputable section variable {n : ℕ} def normalDeviation (P : MvPolynomial (Fin (n+1)) ℝ) (x : Fin (n+1) → ℝ) : ℝ := ∑ i, (leadingNormalizedField P x i - (Pi.single 0 1 : Fin (n+1) → ℝ) i)^2 def normalFlux (P : MvPolynomial (Fin (n+1)) ℝ) (ρ : (Fin (n+1) → ℝ) → ℝ) : ℝ := -(∫ x, fderiv ℝ ρ x (Pi.single 0 1) * (if 0 < eval x P then 1 else 0)) def excess (P : MvPolynomial (Fin (n+1)) ℝ) (ρ : (Fin (n+1) → ℝ) → ℝ) : ℝ := phaseMass P ρ - normalFlux P ρ def diffuseTilt (P : MvPolynomial (Fin (n+1)) ℝ) (ρ : (Fin (n+1) → ℝ) → ℝ) (k : ℕ) (x : Fin (n+1) → ℝ) : ℝ := (1/2 : ℝ) * ρ x * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x) * normalDeviation P x /-- The Euclidean normal identity remains valid at critical points after multiplication by the gradient length. -/ theorem weighted_normalDeviation (P : MvPolynomial (Fin (n+1)) ℝ) (x : Fin (n+1) → ℝ) : (1/2 : ℝ) * variationDensity (evaluatedGradient P x) * normalDeviation P x = variationDensity (evaluatedGradient P x) - evaluatedGradient P x 0 := by by_cases hz : evaluatedGradient P x = 0 · simp [hz, variationDensity] have hp := radiusSq_pos_of_ne_zero hz have hunit : (∑ i, leadingNormalizedField P x i ^ 2) = 1 := by simp only [leadingNormalizedField, div_pow, ← Finset.sum_div] change radiusSq (evaluatedGradient P x) / (Real.sqrt (radiusSq (evaluatedGradient P x)))^2 = 1 rw [Real.sq_sqrt hp.le, div_self hp.ne'] have he : normalDeviation P x = (∑ i, leadingNormalizedField P x i ^ 2) - 2 * leadingNormalizedField P x 0 + 1 := by simp only [normalDeviation, Fin.sum_univ_succ, Pi.single_eq_same, sub_zero, Pi.single_eq_of_ne (Fin.succ_ne_zero _)] ring rw [he, hunit] nlinarith [norm_mul_normal P x 0] theorem diffuseTilt_eq (P : MvPolynomial (Fin (n+1)) ℝ) (ρ : (Fin (n+1) → ℝ) → ℝ) (k : ℕ) (x : Fin (n+1) → ℝ) : diffuseTilt P ρ k x = ρ x * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x) - ρ x * deriv (transition k) (eval x P) * evaluatedGradient P x 0 := by calc _ = ρ x * deriv (transition k) (eval x P) * ((1/2 : ℝ) * variationDensity (evaluatedGradient P x) * normalDeviation P x) := by unfold diffuseTilt ring _ = _ := by rw [weighted_normalDeviation]; ring lemma normal_pairing_integrable (P : MvPolynomial (Fin (n+1)) ℝ) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (k : ℕ) : Integrable (fun x => ρ x * deriv (transition k) (eval x P) * evaluatedGradient P x 0) := by exact ((hρ.continuous.mul ((transition_contDiff k).continuous_deriv_one.comp (contDiff_eval P).continuous)).mul (contDiff_eval (pderiv 0 P)).continuous).integrable_of_hasCompactSupport hcρ.mul_right.mul_right lemma normal_pairing_eq (P : MvPolynomial (Fin (n+1)) ℝ) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (k : ℕ) : (∫ x, ρ x * deriv (transition k) (eval x P) * evaluatedGradient P x 0) = -(∫ x, fderiv ℝ ρ x (Pi.single 0 1) * transition k (eval x P)) := by have hb := integral_mul_fderiv_eq_neg_of_compactSupport (μ := volume) hρ hcρ ((transition_contDiff k).comp (contDiff_eval P)) (Pi.single 0 1) change (∫ x, ρ x * fderiv ℝ (fun y => transition k (eval y P)) x (Pi.single 0 1)) = _ at hb simp_rw [Source29PhaseDivergence.composed_fderiv P (transition_contDiff k)] at hb simpa only [mul_assoc, Function.comp_apply] using hb theorem normal_pairing_tendsto (P : MvPolynomial (Fin (n+1)) ℝ) (hP : P ≠ 0) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) : Tendsto (fun k => ∫ x, ρ x * deriv (transition k) (eval x P) * evaluatedGradient P x 0) atTop (𝓝 (normalFlux P ρ)) := by have hi : Integrable (fun x => fderiv ℝ ρ x (Pi.single 0 1)) := ((hρ.continuous_fderiv (by norm_num)).clm_apply continuous_const).integrable_of_hasCompactSupport (hcρ.fderiv_apply ℝ (Pi.single 0 1)) have ht := (transition_weighted_integral P hP _ hi).neg simpa only [normal_pairing_eq P hρ hcρ, normalFlux] using ht theorem diffuseTilt_integrable (P : MvPolynomial (Fin (n+1)) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (k : ℕ) : Integrable (diffuseTilt P ρ k) := by have hm := (localized_gradient_mass_identity P hcal hρ hcρ (transition_contDiff k) (transition_norm_le_one k)).1 change Integrable (fun x => diffuseTilt P ρ k x) simp_rw [diffuseTilt_eq] exact hm.sub (normal_pairing_integrable P hρ hcρ k) /-- The excess is an actual limit of nonnegative, squared-normal tilt integrals. This does not assign a normal trace at singular zeroes. -/ theorem diffuseTilt_tendsto (P : MvPolynomial (Fin (n+1)) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) : Tendsto (fun k => ∫ x, diffuseTilt P ρ k x) atTop (𝓝 (excess P ρ)) := by have ht := (phaseMass_tendsto P hP hcal hρ hcρ).sub (normal_pairing_tendsto P hP hρ hcρ) have he (k : ℕ) : (∫ x, diffuseTilt P ρ k x) = (∫ x, ρ x * deriv (transition k) (eval x P) * variationDensity (evaluatedGradient P x)) - (∫ x, ρ x * deriv (transition k) (eval x P) * evaluatedGradient P x 0) := by simp_rw [diffuseTilt_eq] exact integral_sub (localized_gradient_mass_identity P hcal hρ hcρ (transition_contDiff k) (transition_norm_le_one k)).1 (normal_pairing_integrable P hρ hcρ k) simpa only [he, excess] using ht theorem excess_nonneg (P : MvPolynomial (Fin (n+1)) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) : 0 ≤ excess P ρ := by apply ge_of_tendsto (diffuseTilt_tendsto P hP hcal hρ hcρ) apply Eventually.of_forall intro k apply integral_nonneg intro x exact mul_nonneg (mul_nonneg (mul_nonneg (mul_nonneg (by norm_num) (hρpos x)) (transition_deriv_nonneg k _)) (Real.sqrt_nonneg _)) (Finset.sum_nonneg fun _ _ => sq_nonneg _) end end Source29CoordinateTiltExcess /- Component: CoordinateTiltBlowup.inc -/ namespace Source29CoordinateTiltBlowup open MvPolynomial MeasureTheory Filter open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29CoordinateTiltExcess Source29WeakCalibrationLimits open Source29InitialPhaseFluxLimit Source29PhaseMassLimit open scoped Topology BigOperators noncomputable section variable {n : ℕ} def scaledWeight (ρ : (Fin (n+1) → ℝ) → ℝ) (r : ℝ) (x : Fin (n+1) → ℝ) : ℝ := ρ (r⁻¹ • x) def rescaledExcess (P : MvPolynomial (Fin (n+1)) ℝ) (ρ : (Fin (n+1) → ℝ) → ℝ) (r : ℝ) : ℝ := -(∫ x, testFlux (fun i => Pi.single i 1) ρ (fun y => leadingNormalizedField P (r • y)) x * (if 0 < eval (r • x) P then 1 else 0)) + ∫ x, fderiv ℝ ρ x (Pi.single 0 1) * (if 0 < eval (r • x) P then 1 else 0) lemma testFlux_scaledWeight (ρ : (Fin (n+1) → ℝ) → ℝ) (Z : (Fin (n+1) → ℝ) → Fin (n+1) → ℝ) {r : ℝ} (hr : r ≠ 0) (x : Fin (n+1) → ℝ) : r * testFlux (fun i => Pi.single i 1) (scaledWeight ρ r) Z (r • x) = testFlux (fun i => Pi.single i 1) ρ (fun y => Z (r • y)) x := by have hd : fderiv ℝ (scaledWeight ρ r) (r • x) = r⁻¹ • fderiv ℝ ρ x := by unfold scaledWeight rw [fderiv_comp_smul, smul_smul, inv_mul_cancel₀ hr, one_smul] simp only [testFlux, hd, _root_.smul_apply, smul_eq_mul, Finset.mul_sum] apply Finset.sum_congr rfl intro i _ field_simp /-- Exact scaling of a flux pairing, valid without continuity assumptions on the paired field or scalar function. -/ lemma flux_integral_dilate (ρ : (Fin (n+1) → ℝ) → ℝ) (Z : (Fin (n+1) → ℝ) → Fin (n+1) → ℝ) (b : (Fin (n+1) → ℝ) → ℝ) {r : ℝ} (hr : 0 < r) : (∫ x, testFlux (fun i => Pi.single i 1) (scaledWeight ρ r) Z x * b x) / r^n = ∫ x, testFlux (fun i => Pi.single i 1) ρ (fun y => Z (r • y)) x * b (r • x) := by let f : (Fin (n+1) → ℝ) → ℝ := fun x => testFlux (fun i => Pi.single i 1) (scaledWeight ρ r) Z x * b x have he := Measure.integral_comp_smul_of_nonneg volume f r (hR := hr.le) simp only [Module.finrank_pi, Fintype.card_fin, smul_eq_mul] at he have halgebra (a : ℝ) : a / r^n = r * ((r^(n+1))⁻¹ * a) := by rw [pow_succ] field_simp change (∫ x, f x) / r^n = _ rw [halgebra, ← he, ← integral_const_mul] apply integral_congr_ae exact Eventually.of_forall fun x => by dsimp only [f] rw [← mul_assoc, testFlux_scaledWeight ρ Z hr.ne'] lemma testFlux_coordinate (ρ : (Fin (n+1) → ℝ) → ℝ) (x : Fin (n+1) → ℝ) : testFlux (fun i => Pi.single i 1) ρ (fun _ => Pi.single 0 1) x = fderiv ℝ ρ x (Pi.single 0 1) := by simp [testFlux, Pi.single_apply] /-- The blow-up excess is precisely the original excess with a dilated cutoff, divided by the hypersurface scaling factor. -/ theorem excess_scaledWeight (P : MvPolynomial (Fin (n+1)) ℝ) (ρ : (Fin (n+1) → ℝ) → ℝ) {r : ℝ} (hr : 0 < r) : excess P (scaledWeight ρ r) / r^n = rescaledExcess P ρ r := by have hA := flux_integral_dilate ρ (leadingNormalizedField P) (fun x => if 0 < eval x P then (1 : ℝ) else 0) hr have hB := flux_integral_dilate ρ (fun _ => Pi.single 0 1) (fun x => if 0 < eval x P then (1 : ℝ) else 0) hr simp only [testFlux_coordinate] at hB unfold excess phaseMass normalFlux rescaledExcess rw [sub_neg_eq_add, add_div, neg_div, hA, hB] theorem scaledWeight_contDiff {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (r : ℝ) : ContDiff ℝ 1 (scaledWeight ρ r) := hρ.comp (contDiff_id.const_smul r⁻¹) theorem scaledWeight_compact {ρ : (Fin (n+1) → ℝ) → ℝ} (hcρ : HasCompactSupport ρ) {r : ℝ} (hr : r ≠ 0) : HasCompactSupport (scaledWeight ρ r) := hcρ.comp_homeomorph (Homeomorph.smulOfNeZero r⁻¹ (inv_ne_zero hr)) /-- At every positive scale the rescaled excess is the limit of actual normalized diffuse squared-normal tilt integrals. -/ theorem normalized_diffuseTilt_tendsto (P : MvPolynomial (Fin (n+1)) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) {r : ℝ} (hr : 0 < r) : Tendsto (fun k => (∫ x, diffuseTilt P (scaledWeight ρ r) k x) / r^n) atTop (𝓝 (rescaledExcess P ρ r)) := by have ht := (diffuseTilt_tendsto P hP hcal (scaledWeight_contDiff hρ r) (scaledWeight_compact hcρ hr.ne')).div_const (r^n) rwa [excess_scaledWeight P ρ hr] at ht theorem rescaledExcess_nonneg (P : MvPolynomial (Fin (n+1)) ℝ) (hP : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) {r : ℝ} (hr : 0 < r) : 0 ≤ rescaledExcess P ρ r := by rw [← excess_scaledWeight P ρ hr] exact div_nonneg (excess_nonneg P hP hcal (scaledWeight_contDiff hρ r) (scaledWeight_compact hcρ hr.ne') (fun x => hρpos _)) (pow_pos hr n).le lemma normal_integral_initial_limit (P : MvPolynomial (Fin (n+1)) ℝ) (s : ℕ) (hlow : ∀ j < s+1, homogeneousComponent j P = 0) (hne : homogeneousComponent (s+1) P ≠ 0) {t : ℕ → ℝ} (ht : ∀ k, 0 < t k) (ht0 : Tendsto t atTop (𝓝 0)) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) : Tendsto (fun k => ∫ x, fderiv ℝ ρ x (Pi.single 0 1) * (if 0 < eval (t k • x) P then 1 else 0)) atTop (𝓝 (∫ x, fderiv ℝ ρ x (Pi.single 0 1) * (if 0 < eval x (homogeneousComponent (s+1) P) then 1 else 0))) := by have hi : Integrable (fun x => fderiv ℝ ρ x (Pi.single 0 1)) := ((hρ.continuous_fderiv (by norm_num)).clm_apply continuous_const).integrable_of_hasCompactSupport (hcρ.fderiv_apply ℝ (Pi.single 0 1)) apply tendsto_integral_of_dominated_convergence (fun x => ‖fderiv ℝ ρ x (Pi.single 0 1)‖) · intro k exact hi.aestronglyMeasurable.mul (scaled_phase_measurable P (t k)).aestronglyMeasurable · exact hi.norm · intro k exact Eventually.of_forall fun x => by rw [norm_mul] split_ifs <;> simp · filter_upwards [mvPolynomial_eval_ne_zero_ae (n+1) _ hne] with x hx exact tendsto_const_nhds.mul (scaled_phase_initial_limit P s hlow ht ht0 x hx) /-- Polynomial blow-ups carry the excess to that of their first homogeneous term. The proof uses actual phase and normalized-gradient convergence. -/ theorem rescaledExcess_initial_limit (P : MvPolynomial (Fin (n+1)) ℝ) (s : ℕ) (hlow : ∀ j < s+1, homogeneousComponent j P = 0) (hne : homogeneousComponent (s+1) P ≠ 0) {t : ℕ → ℝ} (ht : ∀ k, 0 < t k) (ht0 : Tendsto t atTop (𝓝 0)) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) : Tendsto (fun k => rescaledExcess P ρ (t k)) atTop (𝓝 (excess (homogeneousComponent (s+1) P) ρ)) := by have hA := phaseFlux_initial_limit P s hlow hne ht ht0 hρ hcρ have hB := normal_integral_initial_limit P s hlow hne ht ht0 hρ hcρ simpa only [rescaledExcess, excess, normalFlux, sub_neg_eq_add] using hA.add hB theorem excess_positive_odd_normal_power (c : ℝ) (hc : 0 < c) (d : ℕ) (hd : Odd d) (ρ : (Fin (n+1) → ℝ) → ℝ) : excess (C c * (X 0 : MvPolynomial (Fin (n+1)) ℝ)^d) ρ = 0 := by unfold excess phaseMass normalFlux have he : (∫ x, testFlux (fun i => Pi.single i 1) ρ (leadingNormalizedField (C c * (X 0 : MvPolynomial (Fin (n+1)) ℝ)^d)) x * (if 0 < eval x (C c * (X 0 : MvPolynomial (Fin (n+1)) ℝ)^d) then 1 else 0)) = ∫ x, fderiv ℝ ρ x (Pi.single 0 1) * (if 0 < eval x (C c * (X 0 : MvPolynomial (Fin (n+1)) ℝ)^d) then 1 else 0) := by apply integral_congr_ae filter_upwards [mvPolynomial_eval_ne_zero_ae (n+1) (X (0 : Fin (n+1)) : MvPolynomial (Fin (n+1)) ℝ) (X_ne_zero 0)] with x hx have hn : leadingNormalizedField (C c * (X 0 : MvPolynomial (Fin (n+1)) ℝ)^d) x = Pi.single 0 1 := by funext i rw [Source29OddPowerNormalizedField.normalizedField_C_pow_pos _ hc hd x hx, Source29CoordinatePhaseMass.normalizedField_X] simp only [testFlux, hn] simp [Pi.single_apply] rw [he, sub_self] /-- A positive odd normal-power initial form has vanishing averaged tilt under every sequence of positive blow-up scales tending to zero. -/ theorem rescaledExcess_tendsto_zero (P : MvPolynomial (Fin (n+1)) ℝ) (s : ℕ) (hlow : ∀ j < s+1, homogeneousComponent j P = 0) (c : ℝ) (hc : 0 < c) (hd : Odd (s+1)) (hinit : homogeneousComponent (s+1) P = C c * (X 0)^ (s+1)) {t : ℕ → ℝ} (ht : ∀ k, 0 < t k) (ht0 : Tendsto t atTop (𝓝 0)) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) : Tendsto (fun k => rescaledExcess P ρ (t k)) atTop (𝓝 0) := by have hne : homogeneousComponent (s+1) P ≠ 0 := by rw [hinit] exact mul_ne_zero (C_ne_zero.mpr hc.ne') (pow_ne_zero _ (X_ne_zero 0)) have ht' := rescaledExcess_initial_limit P s hlow hne ht ht0 hρ hcρ rwa [hinit, excess_positive_odd_normal_power c hc (s+1) hd ρ] at ht' /-- The sequential blow-up statement gives the full one-sided small-radius limit, so no prescribed sequence of scales is required. -/ theorem rescaledExcess_tendsto_zero_right (P : MvPolynomial (Fin (n+1)) ℝ) (s : ℕ) (hlow : ∀ j < s+1, homogeneousComponent j P = 0) (c : ℝ) (hc : 0 < c) (hd : Odd (s+1)) (hinit : homogeneousComponent (s+1) P = C c * (X 0)^ (s+1)) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) : Tendsto (rescaledExcess P ρ) (𝓝[>] (0 : ℝ)) (𝓝 0) := by apply Filter.tendsto_of_seq_tendsto intro t ht have ht0 : Tendsto t atTop (𝓝 (0 : ℝ)) := ht.mono_right inf_le_left have htpos : ∀ᶠ k in atTop, 0 < t k := ht.eventually self_mem_nhdsWithin let u : ℕ → ℝ := fun k => if 0 < t k then t k else 1 have hu (k : ℕ) : 0 < u k := by dsimp only [u] split_ifs with h · exact h · norm_num have he : u =ᶠ[atTop] t := htpos.mono fun k hk => by simp only [u, ite_eq_left hk] have hu0 : Tendsto u atTop (𝓝 (0 : ℝ)) := (tendsto_congr' he).mpr ht0 have hl := rescaledExcess_tendsto_zero P s hlow c hc hd hinit hu hu0 hρ hcρ apply hl.congr' filter_upwards [he] with k hk simp only [Function.comp_apply, hk] /-- Flat initial data give arbitrarily small averaged squared tilt: first choose a sufficiently small spatial scale, then take a sufficiently sharp phase transition. No smoothness of the zero set is used. -/ theorem eventually_small_normalized_diffuseTilt (P : MvPolynomial (Fin (n+1)) ℝ) (hcal : WeakCalibration (leadingNormalizedField P)) (s : ℕ) (hlow : ∀ j < s+1, homogeneousComponent j P = 0) (c : ℝ) (hc : 0 < c) (hd : Odd (s+1)) (hinit : homogeneousComponent (s+1) P = C c * (X 0)^ (s+1)) {ρ : (Fin (n+1) → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hcρ : HasCompactSupport ρ) (hρpos : ∀ x, 0 ≤ ρ x) {ε : ℝ} (hε : 0 < ε) : ∀ᶠ r in 𝓝[>] (0 : ℝ), ∀ᶠ k in atTop, 0 ≤ (∫ x, diffuseTilt P (scaledWeight ρ r) k x) / r^n ∧ (∫ x, diffuseTilt P (scaledWeight ρ r) k x) / r^n < ε := by have hne : P ≠ 0 := by intro hp have hcz : C c * (X 0 : MvPolynomial (Fin (n+1)) ℝ)^(s+1) = 0 := by rw [← hinit, hp, map_zero] exact (mul_ne_zero (C_ne_zero.mpr hc.ne') (pow_ne_zero _ (X_ne_zero 0))) hcz have hl := rescaledExcess_tendsto_zero_right P s hlow c hc hd hinit hρ hcρ filter_upwards [self_mem_nhdsWithin, hl.eventually (eventually_lt_nhds hε)] with r hr hsmall have hrd : 0 < r := hr have ht := normalized_diffuseTilt_tendsto P hne hcal hρ hcρ hrd filter_upwards [ht.eventually (eventually_lt_nhds hsmall)] with k hk refine ⟨div_nonneg ?_ (pow_pos hrd n).le, hk⟩ apply integral_nonneg intro x unfold diffuseTilt scaledWeight normalDeviation exact mul_nonneg (mul_nonneg (mul_nonneg (mul_nonneg (by norm_num) (hρpos _)) (Source29SmoothPhaseTransition.transition_deriv_nonneg k _)) (Real.sqrt_nonneg _)) (Finset.sum_nonneg fun _ _ => sq_nonneg _) end end Source29CoordinateTiltBlowup /- Component: ConicalPhaseComponents.inc -/ namespace Source29ConicalPhaseComponents open Set Filter MvPolynomial open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] /-- Invariance under positive dilations, with no convexity assumption. -/ def IsPositiveCone (S : Set E) : Prop := ∀ t : ℝ, 0 < t → ∀ x ∈ S, t • x ∈ S /-- The full positive ray stays in the same connected component. -/ theorem positive_smul_mem_component {S : Set E} (hcone : IsPositiveCone S) {x : E} (hx : x ∈ S) {t : ℝ} (ht : 0 < t) : t • x ∈ connectedComponentIn S x := by have hp : IsPreconnected ((fun r : ℝ => r • x) '' Ioi 0) := isPreconnected_Ioi.image _ (by fun_prop) have hxray : x ∈ (fun r : ℝ => r • x) '' Ioi 0 := ⟨1, by norm_num, one_smul ℝ x⟩ apply hp.subset_connectedComponentIn hxray ?_ ⟨t, ht, rfl⟩ rintro _ ⟨r, hr, rfl⟩ exact hcone r hr x hx /-- Every connected component of a cone is itself a cone. -/ theorem component_isPositiveCone {S : Set E} (hcone : IsPositiveCone S) (x : E) : IsPositiveCone (connectedComponentIn S x) := by intro t ht y hy have hys : y ∈ S := connectedComponentIn_subset S x hy have hr := positive_smul_mem_component hcone hys ht rwa [← connectedComponentIn_eq hy] at hr /-- Positive dilation maps each component onto itself. -/ theorem image_smul_component {S : Set E} (hcone : IsPositiveCone S) (x : E) {t : ℝ} (ht : 0 < t) : (fun y => t • y) '' connectedComponentIn S x = connectedComponentIn S x := by have hc := component_isPositiveCone hcone x apply Set.Subset.antisymm · rintro _ ⟨y, hy, rfl⟩ exact hc t ht y hy · intro y hy refine ⟨t⁻¹ • y, hc t⁻¹ (inv_pos.mpr ht) y hy, ?_⟩ change t • (t⁻¹ • y) = y rw [smul_smul, mul_inv_cancel₀ ht.ne', one_smul] /-- Every nonempty cone component accumulates at the vertex. -/ theorem zero_mem_closure_component {S : Set E} (hcone : IsPositiveCone S) {x : E} (hx : x ∈ S) : 0 ∈ closure (connectedComponentIn S x) := by let r : ℕ → ℝ := fun k => (Source29QuarticReuse.FluxPolynomial.dilationRadius k)⁻¹ have hr : Tendsto r atTop (𝓝 0) := tendsto_inv_atTop_zero.comp Source29QuarticReuse.FluxPolynomial.dilationRadius_tendsto have hl : Tendsto (fun k => r k • x) atTop (𝓝 (0 : E)) := by have hxlim : Tendsto (fun _ : ℕ => x) atTop (𝓝 x) := tendsto_const_nhds simpa only [zero_smul] using hr.smul hxlim apply mem_closure_of_tendsto hl apply Filter.Eventually.of_forall intro k exact positive_smul_mem_component hcone hx (inv_pos.mpr (Source29QuarticReuse.FluxPolynomial.dilationRadius_pos k)) /-- There are no bounded nonempty components of a cone that omits its vertex. -/ theorem component_not_bounded {S : Set E} (hcone : IsPositiveCone S) (hzero : (0 : E) ∉ S) {x : E} (hx : x ∈ S) : ¬ Bornology.IsBounded (connectedComponentIn S x) := by intro hb obtain ⟨M, hM⟩ := hb.exists_norm_le have hxne : x ≠ 0 := fun h => hzero (h ▸ hx) have hnx : 0 < ‖x‖ := norm_pos_iff.mpr hxne let t : ℝ := (|M| + 1) / ‖x‖ have ht : 0 < t := div_pos (by positivity) hnx have hbound := hM (t • x) (positive_smul_mem_component hcone hx ht) rw [norm_smul, Real.norm_eq_abs, abs_of_pos ht, show t * ‖x‖ = |M| + 1 by exact div_mul_cancel₀ _ hnx.ne'] at hbound linarith [le_abs_self M] /-- Radial normalization realizes the unit link as a continuous image. -/ theorem normalized_image_eq_link {S : Set E} (hcone : IsPositiveCone S) (hzero : (0 : E) ∉ S) : (fun x => ‖x‖⁻¹ • x) '' S = S ∩ {x | ‖x‖ = 1} := by ext y constructor · rintro ⟨x, hx, rfl⟩ have hn : 0 < ‖x‖ := norm_pos_iff.mpr (fun h => hzero (h ▸ hx)) refine ⟨hcone _ (inv_pos.mpr hn) x hx, ?_⟩ change ‖‖x‖⁻¹ • x‖ = 1 rw [norm_smul, norm_inv, Real.norm_eq_abs, abs_of_pos hn, inv_mul_cancel₀ hn.ne'] · rintro ⟨hy, hn⟩ refine ⟨y, hy, ?_⟩ change ‖y‖ = 1 at hn change ‖y‖⁻¹ • y = y rw [hn, inv_one, one_smul] /-- Cone connectedness is exactly connectedness of its unit link. -/ theorem isPreconnected_iff_link {S : Set E} (hcone : IsPositiveCone S) (hzero : (0 : E) ∉ S) : IsPreconnected S ↔ IsPreconnected (S ∩ {x | ‖x‖ = 1}) := by constructor · intro hS rw [← normalized_image_eq_link hcone hzero] apply hS.image intro x hx have hn : ‖x‖ ≠ 0 := norm_ne_zero_iff.mpr (fun h => hzero (h ▸ hx)) exact ((continuous_norm.continuousAt.inv₀ hn).smul continuousAt_id).continuousWithinAt · intro hlink have hp : IsPreconnected ((Ioi 0 : Set ℝ) ×ˢ (S ∩ {x | ‖x‖ = 1})) := isPreconnected_Ioi.prod hlink have himage : (fun p : ℝ × E => p.1 • p.2) '' ((Ioi 0 : Set ℝ) ×ˢ (S ∩ {x | ‖x‖ = 1})) = S := by apply Set.Subset.antisymm · rintro _ ⟨⟨t, x⟩, ⟨ht, hx, _⟩, rfl⟩ exact hcone t ht x hx · intro x hx have hn : 0 < ‖x‖ := norm_pos_iff.mpr (fun h => hzero (h ▸ hx)) refine ⟨(‖x‖, ‖x‖⁻¹ • x), ⟨hn, ?_⟩, ?_⟩ · rw [← normalized_image_eq_link hcone hzero] exact ⟨x, hx, rfl⟩ · change ‖x‖ • (‖x‖⁻¹ • x) = x rw [smul_smul, mul_inv_cancel₀ hn.ne', one_smul] rw [← himage] exact hp.image _ (by fun_prop) /-- In particular, every connected cone component has a connected unit link. -/ theorem component_link_isPreconnected {S : Set E} (hcone : IsPositiveCone S) (hzero : (0 : E) ∉ S) (x : E) : IsPreconnected (connectedComponentIn S x ∩ {y | ‖y‖ = 1}) := by apply (isPreconnected_iff_link (component_isPositiveCone hcone x) ?_).mp isPreconnected_connectedComponentIn intro hz exact hzero (connectedComponentIn_subset S x hz) /-- Both strict sign regions of a homogeneous polynomial are positive cones. -/ theorem homogeneous_sign_regions_are_cones {n d : ℕ} (H : MvPolynomial (Fin n) ℝ) (hH : H.IsHomogeneous d) : IsPositiveCone {x | 0 < eval x H} ∧ IsPositiveCone {x | eval x H < 0} := by constructor · intro t ht x hx change 0 < eval (t • x) H rw [Source29QuarticReuse.FluxObstruction.eval_dilate_homogeneous H hH] exact mul_pos (pow_pos ht d) hx · intro t ht x hx change eval (t • x) H < 0 rw [Source29QuarticReuse.FluxObstruction.eval_dilate_homogeneous H hH] exact mul_neg_of_pos_of_neg (pow_pos ht d) hx end end Source29ConicalPhaseComponents /- Component: NormalHasseCentering.inc -/ namespace Source29NormalHasseCentering open MvPolynomial Filter open Source29NewtonNormalDerivative Source29NewtonShiftedFactorCoefficient open scoped Topology noncomputable section variable {n : ℕ} /-- The normal Hasse derivative is the normal iterated derivative divided by its factorial. -/ def normalHasse (j : ℕ) (F : MvPolynomial (Fin (n+1)) ℝ) : MvPolynomial (Fin (n+1)) ℝ := (finSuccEquiv ℝ n).symm (Polynomial.hasseDeriv j (finSuccEquiv ℝ n F)) lemma sliceHom_normalHasse (j : ℕ) (F : MvPolynomial (Fin (n+1)) ℝ) (y : Fin n → ℝ) : sliceHom y (normalHasse j F) = Polynomial.hasseDeriv j (sliceHom y F) := by change ((finSuccEquiv ℝ n) ((finSuccEquiv ℝ n).symm _)).map (eval y) = _ rw [AlgEquiv.apply_symm_apply] exact (Polynomial.hasseDeriv_map (eval y) j (finSuccEquiv ℝ n F)).symm /-- The translated normal coefficient is evaluation of a fixed polynomial. -/ theorem shiftedSlice_coeff_eq_eval_normalHasse (F : MvPolynomial (Fin (n+1)) ℝ) (j : ℕ) (s : ℝ) (y : Fin n → ℝ) : (shiftedSlice F s y).coeff j = eval (Fin.cons s y) (normalHasse j F) := by rw [shiftedSlice, Polynomial.taylor_coeff, ← sliceHom_normalHasse, eval_sliceHom] lemma coeff_normalHasse_cons (F : MvPolynomial (Fin (n+1)) ℝ) (j k : ℕ) (m : Fin n →₀ ℕ) : (normalHasse j F).coeff (m.cons k) = ((k+j).choose j : ℝ) * F.coeff (m.cons (k+j)) := by rw [← finSuccEquiv_coeff_coeff, normalHasse, AlgEquiv.apply_symm_apply, Polynomial.hasseDeriv_coeff] have hc : ((k+j).choose j : MvPolynomial (Fin n) ℝ) = C ((k+j).choose j : ℝ) := by simp rw [hc, coeff_C_mul, finSuccEquiv_coeff_coeff] lemma eval_zero_pderiv (F : MvPolynomial (Fin (n+1)) ℝ) (i : Fin (n+1)) : eval (0 : Fin (n+1) → ℝ) (pderiv i F) = F.coeff (Finsupp.single i 1) := by simp [eval_zero, constantCoeff_eq, coeff_pderiv] lemma coeff_eq_zero_of_lower_component (F : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hlow : ∀ j < d, homogeneousComponent j F = 0) (m : Fin (n+1) →₀ ℕ) (hm : m.degree < d) : F.coeff m = 0 := by have he := congrArg (fun Q : MvPolynomial (Fin (n+1)) ℝ => Q.coeff m) (hlow m.degree hm) simpa [coeff_homogeneousComponent] using he lemma coeff_eq_of_initial (F : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (c : ℝ) (hpure : homogeneousComponent d F = C c * (X 0)^d) (m : Fin (n+1) →₀ ℕ) (hm : m.degree = d) : F.coeff m = c * (if Finsupp.single 0 d = m then 1 else 0) := by have he := congrArg (fun Q : MvPolynomial (Fin (n+1)) ℝ => Q.coeff m) hpure simpa only [coeff_homogeneousComponent, hm, eq_self_iff_true, ite_true, coeff_C_mul, coeff_X_pow] using he lemma normalHasse_initial_jets (F : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hd : 0 < d) (c : ℝ) (hlow : ∀ j < d, homogeneousComponent j F = 0) (hpure : homogeneousComponent d F = C c * (X 0)^d) : eval (0 : Fin (n+1) → ℝ) (normalHasse (d-1) F) = 0 ∧ eval (0 : Fin (n+1) → ℝ) (pderiv 0 (normalHasse (d-1) F)) = (d : ℝ)*c ∧ ∀ i : Fin n, eval (0 : Fin (n+1) → ℝ) (pderiv i.succ (normalHasse (d-1) F)) = 0 := by have hd1 : 1+(d-1) = d := by omega constructor · rw [eval_zero, constantCoeff_eq, ← Finsupp.cons_zero_zero (n := n), coeff_normalHasse_cons] have hz : F.coeff ((0 : Fin n →₀ ℕ).cons (0+(d-1))) = 0 := by apply coeff_eq_zero_of_lower_component F d hlow simp only [Finsupp.cons_zero_eq_single_zero, Finsupp.degree_single] omega rw [hz, mul_zero] constructor · rw [eval_zero_pderiv, ← Finsupp.cons_zero_eq_single_zero (y := 1), coeff_normalHasse_cons, hd1] have hm : ((0 : Fin n →₀ ℕ).cons d).degree = d := by simp only [Finsupp.cons_zero_eq_single_zero, Finsupp.degree_single] rw [coeff_eq_of_initial F d c hpure _ hm] simp only [Finsupp.cons_zero_eq_single_zero, ite_true, mul_one] rw [Nat.choose_symm (by omega : 1 ≤ d), Nat.choose_one_right] · intro i rw [eval_zero_pderiv, ← Finsupp.cons_zero_single_eq_single_succ, coeff_normalHasse_cons] have hm : ((Finsupp.single i 1).cons (0+(d-1))).degree = d := by have he : (Finsupp.single i 1).cons (0+(d-1)) = Finsupp.single 0 (d-1) + Finsupp.single i.succ 1 := by ext j cases j using Fin.cases <;> simp [Finsupp.single_apply] rw [he, map_add, Finsupp.degree_single, Finsupp.degree_single] omega have hne : Finsupp.single 0 d ≠ (Finsupp.single i 1).cons (0+(d-1)) := by intro he have h := congrArg (fun m : Fin (n+1) →₀ ℕ => m i.succ) he simp [Fin.succ_ne_zero] at h rw [coeff_eq_of_initial F d c hpure _ hm, ite_eq_right hne, mul_zero, mul_zero] /-- A pure nonzero normal initial term admits an analytic flat centering that kills the penultimate normal coefficient. No minimality of the center is assumed. -/ theorem exists_flat_centering (F : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (hlow : ∀ j < d, homogeneousComponent j F = 0) (hpure : homogeneousComponent d F = C c * (X 0)^d) : ∃ g : (Fin n → ℝ) → ℝ, AnalyticAt ℝ g 0 ∧ g 0 = 0 ∧ Source29NormalShiftDerivatives.gradient g 0 = 0 ∧ fderiv ℝ g 0 = 0 ∧ (∀ᶠ y in 𝓝 0, (shiftedSlice F (g y) y).coeff (d-1) = 0) := by obtain ⟨hA0, hAn, hAt⟩ := normalHasse_initial_jets F d hd c hlow hpure have hAn0 : eval (0 : Fin (n+1) → ℝ) (pderiv 0 (normalHasse (d-1) F)) ≠ 0 := by rw [hAn] exact mul_ne_zero (by exact_mod_cast (Nat.ne_of_gt hd)) hc obtain ⟨g, hg, hg0, hggrad, hgD, hroot⟩ := Source29FlatRegularGraph.exists_flat_local_graph (normalHasse (d-1) F) hA0 hAn0 hAt refine ⟨g, hg, hg0, hggrad, hgD, ?_⟩ filter_upwards [hroot] with y hy rwa [shiftedSlice_coeff_eq_eval_normalHasse] end end Source29NormalHasseCentering /- Component: OddCriticalPolynomial.inc -/ namespace Source29OddCriticalPolynomial open Polynomial Filter Set Asymptotics open scoped Topology noncomputable section private lemma no_positive_between_roots (p : ℝ[X]) (hreg : ∀ x, p.eval x ≠ 0 → p.derivative.eval x ≠ 0) {a b z : ℝ} (ha : p.eval a = 0) (hb : p.eval b = 0) (hz : z ∈ Ioo a b) (hpz : 0 < p.eval z) : False := by obtain ⟨c,hc,hmax⟩ := (isCompact_Icc : IsCompact (Icc a b)).exists_isMaxOn ⟨a, by exact ⟨le_rfl,(lt_trans hz.1 hz.2).le⟩⟩ p.continuous.continuousOn have hpc : 0 < p.eval c := hpz.trans_le (hmax ⟨hz.1.le,hz.2.le⟩) have hac : a < c := lt_of_le_of_ne hc.1 (by intro h; subst c; simp [ha] at hpc) have hcb : c < b := lt_of_le_of_ne hc.2 (by intro h; subst c; simp [hb] at hpc) have hder : deriv (fun x => p.eval x) c = 0 := (hmax.isLocalMax (Icc_mem_nhds hac hcb)).deriv_eq_zero exact hreg c hpc.ne' (by simpa only [p.deriv] using hder) /-- A nonzero real polynomial whose critical values are all zero has at most one real zero. This statement does not require an odd degree. -/ theorem root_unique (p : ℝ[X]) (hp : p ≠ 0) (hreg : ∀ x, p.eval x ≠ 0 → p.derivative.eval x ≠ 0) {a b : ℝ} (ha : p.eval a = 0) (hb : p.eval b = 0) : a = b := by have hcontra {a b : ℝ} (hab : a < b) (ha : p.eval a = 0) (hb : p.eval b = 0) : False := by obtain ⟨z,hz,hpz⟩ := Source29PolynomialPhaseRoot.exists_eval_ne_zero_in_interval p hp hab rcases lt_or_gt_of_ne hpz with hn | hpz · apply no_positive_between_roots (-p) ?_ (by simpa using ha) (by simpa using hb) hz (by simpa using neg_pos.mpr hn) intro x hx hder apply hreg x (by simpa using hx) simpa using hder · exact no_positive_between_roots p hreg ha hb hz hpz rcases lt_trichotomy a b with hab | hab | hab · exact (hcontra hab ha hb).elim · exact hab · exact (hcontra hab hb ha).elim private lemma signs_at_unique_root (p : ℝ[X]) (hp : p ≠ 0) (hreg : ∀ x, p.eval x ≠ 0 → p.derivative.eval x ≠ 0) (htop : Tendsto p.eval atTop atTop) (hbot : Tendsto p.eval atBot atBot) {a : ℝ} (ha : p.eval a = 0) : (∀ x, x < a → p.eval x < 0) ∧ (∀ x, a < x → 0 < p.eval x) := by constructor · intro x hx have hne : p.eval x ≠ 0 := fun hz => hx.ne (root_unique p hp hreg hz ha) apply lt_of_le_of_ne ?_ hne by_contra! hpos obtain ⟨b,hbx,hpb⟩ := ((eventually_lt_atBot x).and (hbot.eventually (eventually_lt_atBot (0 : ℝ)))).exists obtain ⟨z,hz,hpz⟩ := intermediate_value_Icc hbx.le p.continuous.continuousOn (show 0 ∈ Icc (p.eval b) (p.eval x) from ⟨hpb.le,hpos.le⟩) have hza : z = a := root_unique p hp hreg hpz ha rw [hza] at hz exact (not_le_of_gt hx) hz.2 · intro x hx have hne : p.eval x ≠ 0 := fun hz => hx.ne' (root_unique p hp hreg hz ha) apply lt_of_le_of_ne ?_ hne.symm by_contra! hneg obtain ⟨b,hxb,hpb⟩ := ((eventually_gt_atTop x).and (htop.eventually (eventually_gt_atTop (0 : ℝ)))).exists obtain ⟨z,hz,hpz⟩ := intermediate_value_Icc hxb.le p.continuous.continuousOn (show 0 ∈ Icc (p.eval x) (p.eval b) from ⟨hneg.le,hpb.le⟩) have hza : z = a := root_unique p hp hreg hpz ha rw [hza] at hz exact (not_le_of_gt hx) hz.1 /-- With opposite infinite ends, the restriction on critical values forces global injectivity, including at the possibly multiple zero. -/ theorem injective_of_opposite_ends (p : ℝ[X]) (hp : p ≠ 0) (hreg : ∀ x, p.eval x ≠ 0 → p.derivative.eval x ≠ 0) (htop : Tendsto p.eval atTop atTop) (hbot : Tendsto p.eval atBot atBot) : Function.Injective p.eval := by have hcontra {a b : ℝ} (hab : a < b) (he : p.eval a = p.eval b) : False := by obtain ⟨c,hc,hder⟩ := exists_deriv_eq_zero hab p.continuous.continuousOn he have hpc : p.eval c = 0 := by by_contra hn exact hreg c hn (by simpa only [p.deriv] using hder) obtain ⟨hleft,hright⟩ := signs_at_unique_root p hp hreg htop hbot hpc have hl := hleft a hc.1 have hr := hright b hc.2 rw [he] at hl exact (not_lt_of_ge hr.le) hl intro a b he rcases lt_trichotomy a b with hab | hab | hab · exact (hcontra hab he).elim · exact hab · exact (hcontra hab he.symm).elim theorem strictMono_of_opposite_ends (p : ℝ[X]) (hp : p ≠ 0) (hreg : ∀ x, p.eval x ≠ 0 → p.derivative.eval x ≠ 0) (htop : Tendsto p.eval atTop atTop) (hbot : Tendsto p.eval atBot atBot) : StrictMono p.eval := by rcases p.continuous.strictMono_of_inj (injective_of_opposite_ends p hp hreg htop hbot) with hm | hm · exact hm · obtain ⟨b,hb,hpb⟩ := ((eventually_gt_atTop (0 : ℝ)).and (htop.eventually (eventually_gt_atTop (p.eval 0)))).exists exact ((not_lt_of_ge hpb.le) (hm hb)).elim private lemma pow_littleO_pow {i d : ℕ} (hid : i < d) : (fun x : ℝ => x^i) =o[atTop] (fun x : ℝ => x^d) := by have hz : ∀ᶠ x : ℝ in atTop, x^d = 0 → x^i = 0 := by filter_upwards [eventually_gt_atTop (0 : ℝ)] with x hx exact fun h => (pow_ne_zero d hx.ne' h).elim apply (isLittleO_iff_tendsto' hz).mpr have ht := (tendsto_inv_atTop_zero : Tendsto (fun x : ℝ => x⁻¹) atTop (𝓝 0)).pow (d-i) rw [zero_pow (by omega : d-i ≠ 0)] at ht apply ht.congr' filter_upwards [eventually_gt_atTop (0 : ℝ)] with x hx have hpow : x^d = x^i * x^(d-i) := by rw [← pow_add, Nat.add_sub_of_le hid.le] rw [hpow, inv_pow] field_simp private lemma eval_equivalent_leading (p : ℝ[X]) : p.eval ~[atTop] (fun x => p.leadingCoeff * x^p.natDegree) := by by_cases hp : p = 0 · simp [hp, IsEquivalent.refl] · simp only [Polynomial.eval_eq_sum_range, Finset.sum_range_succ] exact IsLittleO.add_isEquivalent (IsLittleO.fun_sum fun i hi => ((pow_littleO_pow (Finset.mem_range.mp hi)).const_mul_right (leadingCoeff_ne_zero.mpr hp)).const_mul_left (p.coeff i)) IsEquivalent.refl theorem eval_tendsto_atTop (p : ℝ[X]) (hd : 0 < p.natDegree) (hc : 0 < p.leadingCoeff) : Tendsto p.eval atTop atTop := (eval_equivalent_leading p).symm.tendsto_atTop (tendsto_const_mul_pow_atTop hd.ne' hc) theorem eval_tendsto_atBot_of_odd (p : ℝ[X]) (hd : Odd p.natDegree) (hc : 0 < p.leadingCoeff) : Tendsto p.eval atBot atBot := by let q : ℝ[X] := -(p.comp (-X)) have hqd : q.natDegree = p.natDegree := by simp [q, Polynomial.natDegree_comp] have hqc : q.leadingCoeff = p.leadingCoeff := by simp only [q, Polynomial.leadingCoeff_neg] rw [Polynomial.leadingCoeff_comp (by simp), Polynomial.leadingCoeff_neg, Polynomial.leadingCoeff_X, hd.neg_one_pow] ring have ht := eval_tendsto_atTop q (by rw [hqd]; exact hd.pos) (by rw [hqc]; exact hc) have hb := (tendsto_neg_atTop_atBot.comp ht).comp tendsto_neg_atBot_atTop simpa only [q, Function.comp_def, Polynomial.eval_neg, Polynomial.eval_comp, Polynomial.eval_X, neg_neg] using hb /-- An odd-degree polynomial with positive leading coefficient is strictly increasing when every nonzero value is regular. -/ theorem strictMono_of_odd (p : ℝ[X]) (hd : Odd p.natDegree) (hc : 0 < p.leadingCoeff) (hreg : ∀ x, p.eval x ≠ 0 → p.derivative.eval x ≠ 0) : StrictMono p.eval := by exact strictMono_of_opposite_ends p (leadingCoeff_ne_zero.mp hc.ne') hreg (eval_tendsto_atTop p hd.pos hc) (eval_tendsto_atBot_of_odd p hd hc) /-- Every real level has exactly one real preimage. Its derivative is nonzero on every nonzero level. No phase-sign assumptions are required. -/ theorem existsUnique_level_root (p : ℝ[X]) (hd : Odd p.natDegree) (hc : 0 < p.leadingCoeff) (hreg : ∀ x, p.eval x ≠ 0 → p.derivative.eval x ≠ 0) (t : ℝ) : ∃! x : ℝ, p.eval x = t := by obtain ⟨x,hx⟩ := p.continuous.surjective (eval_tendsto_atTop p hd.pos hc) (eval_tendsto_atBot_of_odd p hd hc) t exact ⟨x,hx,fun y hy => (strictMono_of_odd p hd hc hreg).injective (hy.trans hx.symm)⟩ end end Source29OddCriticalPolynomial /- Component: NewtonOrderedRoot.inc -/ namespace Source29NewtonOrderedRoot open MvPolynomial Filter open Source29NewtonNormalDerivative Source29NewtonPositiveRoot Source29NewtonRootHarmonic open Source29QuarticReuse.FluxObstruction open scoped Topology noncomputable section variable {n : ℕ} lemma slice_natDegree (N : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (c : ℝ) (hc : c ≠ 0) (hdegree : (finSuccEquiv ℝ n N).natDegree ≤ d) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (y : Fin n → ℝ) : (sliceHom y N).natDegree = d := by apply le_antisymm · exact (Polynomial.natDegree_map_le).trans hdegree · apply Polynomial.le_natDegree_of_ne_zero rw [slice_coefficient N d c hcoeff y] exact hc lemma slice_leadingCoeff (N : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (c : ℝ) (hc : c ≠ 0) (hdegree : (finSuccEquiv ℝ n N).natDegree ≤ d) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (y : Fin n → ℝ) : (sliceHom y N).leadingCoeff = c := by change (sliceHom y N).coeff (sliceHom y N).natDegree = c rw [slice_natDegree N d c hc hdegree hcoeff y, slice_coefficient N d c hcoeff y] /-- Every normal slice is strictly increasing, without any prescribed phase signs. -/ theorem strictMono_slice (N : MvPolynomial (Fin (n+1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (d : ℕ) (hd : Odd d) (c : ℝ) (hc : 0 < c) (hdegree : (finSuccEquiv ℝ n N).natDegree ≤ d) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (y : Fin n → ℝ) : StrictMono (fun x => eval (Fin.cons x y) N) := by have hr : ∀ x, (sliceHom y N).eval x ≠ 0 → (sliceHom y N).derivative.eval x ≠ 0 := by intro x hx rw [← sliceHom_pderiv_zero, eval_sliceHom] apply normal_derivative_ne_zero_of_constant_coefficient N α D hD hEuler hE d hd.pos c hc.ne' hcoeff rwa [eval_sliceHom] at hx simpa only [eval_sliceHom] using Source29OddCriticalPolynomial.strictMono_of_odd (sliceHom y N) (by rw [slice_natDegree N d c hc.ne' hdegree hcoeff y]; exact hd) (by rw [slice_leadingCoeff N d c hc.ne' hdegree hcoeff y]; exact hc) hr theorem surjective_slice (N : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hd : Odd d) (c : ℝ) (hc : 0 < c) (hdegree : (finSuccEquiv ℝ n N).natDegree ≤ d) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (y : Fin n → ℝ) : Function.Surjective (fun x => eval (Fin.cons x y) N) := by have hdeg : Odd (sliceHom y N).natDegree := by rw [slice_natDegree N d c hc.ne' hdegree hcoeff y]; exact hd have hlead : 0 < (sliceHom y N).leadingCoeff := by rw [slice_leadingCoeff N d c hc.ne' hdegree hcoeff y]; exact hc simpa only [eval_sliceHom] using (sliceHom y N).continuous.surjective (Source29OddCriticalPolynomial.eval_tendsto_atTop _ hdeg.pos hlead) (Source29OddCriticalPolynomial.eval_tendsto_atBot_of_odd _ hdeg hlead) /-- Unrestricted real inverse level, with a harmless fallback when no root exists. -/ def levelRoot (N : MvPolynomial (Fin (n+1)) ℝ) (t : ℝ) (y : Fin n → ℝ) : ℝ := by classical exact if h : ∃ x, eval (Fin.cons x y) N = t then Classical.choose h else 0 lemma levelRoot_spec (N : MvPolynomial (Fin (n+1)) ℝ) (t : ℝ) (y : Fin n → ℝ) (hsurj : Function.Surjective (fun x => eval (Fin.cons x y) N)) : eval (Fin.cons (levelRoot N t y) y) N = t := by simpa only [levelRoot, dite_eq_left (hsurj t)] using Classical.choose_spec (hsurj t) lemma levelRoot_eq_of_root (N : MvPolynomial (Fin (n+1)) ℝ) (t : ℝ) (y : Fin n → ℝ) (hmono : StrictMono (fun x => eval (Fin.cons x y) N)) (hsurj : Function.Surjective (fun x => eval (Fin.cons x y) N)) {x : ℝ} (hx : eval (Fin.cons x y) N = t) : levelRoot N t y = x := hmono.injective ((levelRoot_spec N t y hsurj).trans hx.symm) lemma levelRoot_lt (N : MvPolynomial (Fin (n+1)) ℝ) (s t : ℝ) (y : Fin n → ℝ) (hmono : StrictMono (fun x => eval (Fin.cons x y) N)) (hsurj : Function.Surjective (fun x => eval (Fin.cons x y) N)) (hst : s < t) : levelRoot N s y < levelRoot N t y := by apply hmono.lt_iff_lt.mp rwa [levelRoot_spec N s y hsurj, levelRoot_spec N t y hsurj] /-- Off the zero level, local implicit branches agree with the globally unique root. -/ theorem analyticAt_levelRoot (N : MvPolynomial (Fin (n+1)) ℝ) (hmono : ∀ y, StrictMono (fun x => eval (Fin.cons x y) N)) (hsurj : ∀ y, Function.Surjective (fun x => eval (Fin.cons x y) N)) (hreg : ∀ z, eval z N ≠ 0 → eval z (pderiv 0 N) ≠ 0) (t : ℝ) (ht : t ≠ 0) (y : Fin n → ℝ) : AnalyticAt ℝ (levelRoot N t) y := by have hs := levelRoot_spec N t y (hsurj y) have hn := hreg (Fin.cons (levelRoot N t y) y) (by rwa [hs]) obtain ⟨g,hg,hgy,hroot⟩ := Source29RealImplicitPolynomialRoot.exists_local_level_graph N (Fin.cons (levelRoot N t y) y) hn simp only [Fin.cons_succ, Fin.cons_zero] at hg hgy hroot rw [hs] at hroot apply hg.congr filter_upwards [hroot] with v hv exact (levelRoot_eq_of_root N t v (hmono v) (hsurj v) hv).symm /-- Each nonzero inverse level is an entire real harmonic graph. -/ theorem levelRoot_divergence_eq_zero (N : MvPolynomial (Fin (n+1)) ℝ) (hE : newtonResidual N = 0) (hmono : ∀ y, StrictMono (fun x => eval (Fin.cons x y) N)) (hsurj : ∀ y, Function.Surjective (fun x => eval (Fin.cons x y) N)) (hreg : ∀ z, eval z N ≠ 0 → eval z (pderiv 0 N) ≠ 0) (t : ℝ) (ht : t ≠ 0) (y : Fin n → ℝ) : divergence (fun i => Pi.single i 1) (coordinateGradient (levelRoot N t)) y = 0 := by apply coordinateGradient_divergence_eq_zero N hE (levelRoot N t) t (analyticAt_levelRoot N hmono hsurj hreg t ht) (fun z => levelRoot_spec N t z (hsurj z)) intro z apply hreg rw [levelRoot_spec N t z (hsurj z)] exact ht /-- Ordered entire harmonic functions have a constant difference. -/ theorem harmonic_difference_constant (f g : (Fin n → ℝ) → ℝ) (hf : ∀ y, AnalyticAt ℝ f y) (hg : ∀ y, AnalyticAt ℝ g y) (hdf : ∀ y, divergence (fun i => Pi.single i 1) (coordinateGradient f) y = 0) (hdg : ∀ y, divergence (fun i => Pi.single i 1) (coordinateGradient g) y = 0) (horder : ∀ y, g y ≤ f y) (a b : Fin n → ℝ) : f a - g a = f b - g b := by have hfc : ContDiff ℝ 1 f := by rw [contDiff_iff_contDiffAt]; exact fun y => (hf y).contDiffAt have hgc : ContDiff ℝ 1 g := by rw [contDiff_iff_contDiffAt]; exact fun y => (hg y).contDiffAt apply Source29PositiveHarmonicLiouville.eq_of_nonnegative_harmonic (u := fun y => f y - g y) (g := fun y i => coordinateGradient f y i - coordinateGradient g y i) (hfc.sub hgc) (fun i => (coordinateGradient_contDiff f hf i).sub (coordinateGradient_contDiff g hg i)) ?_ ?_ (fun y => sub_nonneg.mpr (horder y)) a b · intro y i change fderiv ℝ (f-g) y (Pi.single i 1) = _ rw [fderiv_sub (hf y).differentiableAt (hg y).differentiableAt] rfl · intro y have he : divergence (fun i => Pi.single i 1) (fun z i => coordinateGradient f z i - coordinateGradient g z i) y = divergence (fun i => Pi.single i 1) (coordinateGradient f) y - divergence (fun i => Pi.single i 1) (coordinateGradient g) y := by unfold divergence rw [← Finset.sum_sub_distrib] apply Finset.sum_congr rfl intro i _ change fderiv ℝ ((fun z => coordinateGradient f z i) - (fun z => coordinateGradient g z i)) y (Pi.single i 1) = _ have hfi : DifferentiableAt ℝ (fun z => coordinateGradient f z i) y := (analyticAt_directional f y (Pi.single i 1) (hf y)).differentiableAt have hgi : DifferentiableAt ℝ (fun z => coordinateGradient g z i) y := (analyticAt_directional g y (Pi.single i 1) (hg y)).differentiableAt rw [fderiv_sub hfi hgi] rfl rw [he, hdf, hdg, sub_self] /-- The displacement between two distinct nonzero inverse levels is constant in every tangential variable. -/ theorem levelRoot_difference_constant (N : MvPolynomial (Fin (n+1)) ℝ) (hE : newtonResidual N = 0) (hmono : ∀ y, StrictMono (fun x => eval (Fin.cons x y) N)) (hsurj : ∀ y, Function.Surjective (fun x => eval (Fin.cons x y) N)) (hreg : ∀ z, eval z N ≠ 0 → eval z (pderiv 0 N) ≠ 0) (s t : ℝ) (hs : s ≠ 0) (ht : t ≠ 0) (hst : s < t) (a b : Fin n → ℝ) : levelRoot N t a - levelRoot N s a = levelRoot N t b - levelRoot N s b := by exact harmonic_difference_constant (levelRoot N t) (levelRoot N s) (analyticAt_levelRoot N hmono hsurj hreg t ht) (analyticAt_levelRoot N hmono hsurj hreg s hs) (levelRoot_divergence_eq_zero N hE hmono hsurj hreg t ht) (levelRoot_divergence_eq_zero N hE hmono hsurj hreg s hs) (fun y => (levelRoot_lt N s t y (hmono y) (hsurj y) hst).le) a b /-- All normal slice polynomials are translates of the slice at the origin. -/ theorem slice_translation (N : MvPolynomial (Fin (n+1)) ℝ) (hE : newtonResidual N = 0) (hmono : ∀ y, StrictMono (fun x => eval (Fin.cons x y) N)) (hsurj : ∀ y, Function.Surjective (fun x => eval (Fin.cons x y) N)) (hreg : ∀ z, eval z N ≠ 0 → eval z (pderiv 0 N) ≠ 0) (y : Fin n → ℝ) : (sliceHom y N).comp (Polynomial.X + Polynomial.C (levelRoot N 1 y - levelRoot N 1 0)) = sliceHom 0 N := by apply Polynomial.eq_of_infinite_eval_eq apply (Set.Ioi_infinite (levelRoot N 1 0)).mono intro x hx let t := eval (Fin.cons x (0 : Fin n → ℝ)) N have ht : 1 < t := by have hm := hmono 0 hx change eval (Fin.cons (levelRoot N 1 0) (0 : Fin n → ℝ)) N < t at hm rwa [levelRoot_spec N 1 0 (hsurj 0)] at hm have he : levelRoot N t 0 = x := levelRoot_eq_of_root N t 0 (hmono 0) (hsurj 0) rfl have hy : levelRoot N t y = x + (levelRoot N 1 y - levelRoot N 1 0) := by have hd := levelRoot_difference_constant N hE hmono hsurj hreg 1 t one_ne_zero (ne_of_gt (lt_trans zero_lt_one ht)) ht y 0 rw [he] at hd linarith have hv := levelRoot_spec N t y (hsurj y) rw [hy] at hv change ((sliceHom y N).comp (Polynomial.X + Polynomial.C (levelRoot N 1 y - levelRoot N 1 0))).eval x = (sliceHom 0 N).eval x simpa only [Polynomial.eval_comp, Polynomial.eval_add, Polynomial.eval_X, Polynomial.eval_C, eval_sliceHom] using hv end end Source29NewtonOrderedRoot /- Component: DepressedPolynomialTranslation.inc -/ namespace Source29DepressedPolynomialTranslation open Polynomial noncomputable section theorem hasse_penultimate_eq (p : Polynomial ℝ) (d : ℕ) (hd : 0 < d) (hdegree : p.natDegree ≤ d) : hasseDeriv (d-1) p = C (p.coeff (d-1)) + C ((d : ℝ)*p.coeff d)*X := by ext j rw [hasseDeriv_coeff] by_cases hj0 : j = 0 · subst j simp by_cases hj1 : j = 1 · subst j have he : 1+(d-1) = d := by omega simp only [he, coeff_add, coeff_C, one_ne_zero, ite_false, coeff_mul_X, ite_true, zero_add] rw [Nat.choose_symm (by omega : 1 ≤ d), Nat.choose_one_right] · have hj : 2 ≤ j := by omega have hzero : p.coeff (j+(d-1)) = 0 := coeff_eq_zero_of_natDegree_lt (by omega) rw [hzero, mul_zero] simp only [coeff_add, coeff_C, coeff_C_mul, coeff_X, hj0, Ne.symm hj1, ite_false, mul_zero, add_zero] theorem penultimate_taylor_coefficient (p : Polynomial ℝ) (d : ℕ) (hd : 0 < d) (hdegree : p.natDegree ≤ d) (a : ℝ) : (p.comp (X+C a)).coeff (d-1) = p.coeff (d-1)+(d:ℝ)*p.coeff d*a := by rw [← taylor_apply, taylor_coeff, hasse_penultimate_eq p d hd hdegree] simp only [eval_add, eval_C, eval_mul, eval_X] /-- A nonzero leading coefficient makes the translation between two polynomials with vanishing penultimate coefficient equal to zero. -/ theorem translation_eq_zero (p q : Polynomial ℝ) (d : ℕ) (hd : 0 < d) (hdegree : p.natDegree ≤ d) (hcoeff : p.coeff d ≠ 0) (hp : p.coeff (d-1) = 0) (hq : q.coeff (d-1) = 0) (a : ℝ) (htranslate : p.comp (X+C a) = q) : a = 0 := by have he := penultimate_taylor_coefficient p d hd hdegree a rw [htranslate, hp, hq, zero_add] at he have hd' : (d : ℝ) ≠ 0 := by exact_mod_cast (Nat.ne_of_gt hd) exact (mul_eq_zero.mp he.symm).resolve_left (mul_ne_zero hd' hcoeff) end end Source29DepressedPolynomialTranslation /- Component: DepressedNewtonRigidity.inc -/ namespace Source29DepressedNewtonRigidity open MvPolynomial open Source29NewtonNormalDerivative Source29NewtonPositiveRoot Source29NewtonOrderedRoot open Source29QuarticReuse.QuarticMinimal.DistinguishedVariable noncomputable section variable {n : ℕ} /-- Depression removes the common translation of the inverse level graphs. -/ theorem sliceHom_independent (N : MvPolynomial (Fin (n+1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (d : ℕ) (hd : Odd d) (c : ℝ) (hc : 0 < c) (hdegree : (finSuccEquiv ℝ n N).natDegree ≤ d) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (hdepressed : (finSuccEquiv ℝ n N).coeff (d-1) = 0) (y : Fin n → ℝ) : sliceHom y N = sliceHom 0 N := by have hm := strictMono_slice N α D hD hEuler hE d hd c hc hdegree hcoeff have hs := surjective_slice N d hd c hc hdegree hcoeff have hr : ∀ z, eval z N ≠ 0 → eval z (pderiv 0 N) ≠ 0 := by intro z hz exact normal_derivative_ne_zero_of_constant_coefficient N α D hD hEuler hE d hd.pos c hc.ne' hcoeff z hz have ht := slice_translation N hE hm hs hr y have hzero (v : Fin n → ℝ) : (sliceHom v N).coeff (d-1) = 0 := by change ((finSuccEquiv ℝ n N).map (eval v)).coeff (d-1) = 0 rw [Polynomial.coeff_map, hdepressed, map_zero] have ha := Source29DepressedPolynomialTranslation.translation_eq_zero (sliceHom y N) (sliceHom 0 N) d hd.pos (le_of_eq (slice_natDegree N d c hc.ne' hdegree hcoeff y)) (by rw [slice_coefficient N d c hcoeff y]; exact hc.ne') (hzero y) (hzero 0) (levelRoot N 1 y - levelRoot N 1 0) ht simpa only [ha, Polynomial.C_0, add_zero, Polynomial.comp_X] using ht /-- A depressed odd-degree Newton polynomial has no tangential dependence. -/ theorem tangential_pderiv_eq_zero (N : MvPolynomial (Fin (n+1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (d : ℕ) (hd : Odd d) (c : ℝ) (hc : 0 < c) (hdegree : (finSuccEquiv ℝ n N).natDegree ≤ d) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (hdepressed : (finSuccEquiv ℝ n N).coeff (d-1) = 0) (i : Fin n) : pderiv i.succ N = 0 := by have he : finSuccEquiv ℝ n N = (sliceHom 0 N).map (C : ℝ →+* MvPolynomial (Fin n) ℝ) := by apply Polynomial.ext intro k apply Source29QuarticReuse.QuarticCompatibility.polynomial_funext intro y rw [Polynomial.coeff_map, eval_C] have hk := congrArg (fun p : Polynomial ℝ => p.coeff k) (sliceHom_independent N α D hD hEuler hE d hd c hc hdegree hcoeff hdepressed y) change (((finSuccEquiv ℝ n N).map (eval y)).coeff k) = _ at hk simpa only [Polynomial.coeff_map] using hk apply (finSuccEquiv ℝ n).injective apply Polynomial.ext intro k rw [map_zero, Polynomial.coeff_zero, coeff_finSuccEquiv_pderiv_succ, he, Polynomial.coeff_map, pderiv_C] /-- Sign-free Newton classification: an odd normal degree, constant positive leading coefficient, and vanishing penultimate coefficient force a pure normal power. -/ theorem eq_pure_normal_power (N : MvPolynomial (Fin (n+1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (d : ℕ) (hd : Odd d) (c : ℝ) (hc : 0 < c) (hdegree : (finSuccEquiv ℝ n N).natDegree ≤ d) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (hdepressed : (finSuccEquiv ℝ n N).coeff (d-1) = 0) : N = C c * (X 0)^d := by exact Source29NewtonPureNormalPower.eq_pure_normal_power_of_degree_ne_zero N α D hD.ne' hEuler (tangential_pderiv_eq_zero N α D hD hEuler hE d hd c hc hdegree hcoeff hdepressed) d c hc.ne' hcoeff theorem classification (N : MvPolynomial (Fin (n+1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (d : ℕ) (hd : Odd d) (c : ℝ) (hc : 0 < c) (hdegree : (finSuccEquiv ℝ n N).natDegree ≤ d) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (hdepressed : (finSuccEquiv ℝ n N).coeff (d-1) = 0) : N = C c * (X 0)^d ∧ D = α * (d : ℝ) ∧ 0 < α := by have htan := tangential_pderiv_eq_zero N α D hD hEuler hE d hd c hc hdegree hcoeff hdepressed have hweight := Source29NewtonPureNormalPower.weighted_degree_eq N α D hEuler htan d c hc.ne' hcoeff refine ⟨eq_pure_normal_power N α D hD hEuler hE d hd c hc hdegree hcoeff hdepressed, hweight, ?_⟩ have hdreal : (0 : ℝ) < d := by exact_mod_cast hd.pos rw [hweight] at hD exact (mul_pos_iff_of_pos_right hdreal).mp hD lemma weightedEuler_neg (N : MvPolynomial (Fin (n+1)) ℝ) (α D : ℝ) (hEuler : WeightedEuler N α D) : WeightedEuler (-N) α D := by unfold WeightedEuler at * simpa only [map_neg, mul_neg, Finset.sum_neg_distrib, ← neg_add] using congrArg Neg.neg hEuler lemma newtonResidual_neg (N : MvPolynomial (Fin (n+1)) ℝ) : newtonResidual (-N) = -newtonResidual N := by simp only [newtonResidual, tangentialLaplacian, tangentialMixed, tangentialEnergy, map_neg, neg_mul_neg, neg_sq, Finset.sum_neg_distrib] ring /-- The classification is independent of the sign chosen for the defining polynomial. -/ theorem eq_pure_normal_power_of_ne_zero (N : MvPolynomial (Fin (n+1)) ℝ) (α D : ℝ) (hD : 0 < D) (hEuler : WeightedEuler N α D) (hE : newtonResidual N = 0) (d : ℕ) (hd : Odd d) (c : ℝ) (hc : c ≠ 0) (hdegree : (finSuccEquiv ℝ n N).natDegree ≤ d) (hcoeff : (finSuccEquiv ℝ n N).coeff d = C c) (hdepressed : (finSuccEquiv ℝ n N).coeff (d-1) = 0) : N = C c * (X 0)^d := by rcases lt_or_gt_of_ne hc with hc | hc · have h := eq_pure_normal_power (-N) α D hD (weightedEuler_neg N α D hEuler) (by rw [newtonResidual_neg, hE, neg_zero]) d hd (-c) (neg_pos.mpr hc) (by simpa only [map_neg, Polynomial.natDegree_neg] using hdegree) (by simpa only [map_neg, Polynomial.coeff_neg] using congrArg Neg.neg hcoeff) (by simp only [map_neg, Polynomial.coeff_neg, hdepressed, neg_zero]) apply neg_injective simpa only [map_neg, neg_mul] using h · exact eq_pure_normal_power N α D hD hEuler hE d hd c hc hdegree hcoeff hdepressed end end Source29DepressedNewtonRigidity /- Component: DepressedNewtonDegree.inc -/ namespace Source29DepressedNewtonDegree open MvPolynomial open Source29NewtonNormalDerivative open Source29QuarticReuse.QuarticMinimal.DistinguishedVariable open scoped BigOperators noncomputable section variable {n : ℕ} lemma normal_degree_succ_le (N : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hN : (finSuccEquiv ℝ n N).natDegree ≤ d) (i : Fin n) : (finSuccEquiv ℝ n (pderiv i.succ N)).natDegree ≤ d := by apply Polynomial.natDegree_le_iff_coeff_eq_zero.mpr intro k hk rw [coeff_finSuccEquiv_pderiv_succ, Polynomial.coeff_eq_zero_of_natDegree_lt (hN.trans_lt hk), map_zero] lemma normal_degree_zero_le (N : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hN : (finSuccEquiv ℝ n N).natDegree ≤ d) : (finSuccEquiv ℝ n (pderiv 0 N)).natDegree ≤ d-1 := by rw [finSuccEquiv_pderiv_zero] exact (Polynomial.natDegree_derivative_le _).trans (Nat.sub_le_sub_right hN 1) lemma tangent_coeff_high_zero (N : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hd : 0 < d) (hN : (finSuccEquiv ℝ n N).natDegree ≤ d) (c : ℝ) (htop : (finSuccEquiv ℝ n N).coeff d = C c) (hpen : (finSuccEquiv ℝ n N).coeff (d-1) = 0) (i : Fin n) (k : ℕ) (hk : d-1 ≤ k) : (finSuccEquiv ℝ n (pderiv i.succ N)).coeff k = 0 := by rw [coeff_finSuccEquiv_pderiv_succ] by_cases hk1 : k = d-1 · rw [hk1,hpen,map_zero] by_cases hkd : k = d · rw [hkd,htop,pderiv_C] rw [Polynomial.coeff_eq_zero_of_natDegree_lt (hN.trans_lt (by omega)),map_zero] lemma normal_degree_tangent_le (N : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hd : 2 ≤ d) (hN : (finSuccEquiv ℝ n N).natDegree ≤ d) (c : ℝ) (htop : (finSuccEquiv ℝ n N).coeff d = C c) (hpen : (finSuccEquiv ℝ n N).coeff (d-1) = 0) (i : Fin n) : (finSuccEquiv ℝ n (pderiv i.succ N)).natDegree ≤ d-2 := by apply Polynomial.natDegree_le_iff_coeff_eq_zero.mpr intro k hk exact tangent_coeff_high_zero N d (by omega) hN c htop hpen i k (by omega) /-- Removing the penultimate normal coefficient strictly lowers the normal degree of the Newton residual relative to the cube of the normal derivative. -/ theorem residual_normal_degree_le (N : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hd : 2 ≤ d) (hN : (finSuccEquiv ℝ n N).natDegree ≤ d) (c : ℝ) (htop : (finSuccEquiv ℝ n N).coeff d = C c) (hpen : (finSuccEquiv ℝ n N).coeff (d-1) = 0) : (finSuccEquiv ℝ n (newtonResidual N)).natDegree ≤ 3*d-4 := by have hA := normal_degree_zero_le N d hN have hS : (finSuccEquiv ℝ n (pderiv 0 (pderiv 0 N))).natDegree ≤ d-1 := (normal_degree_zero_le (pderiv 0 N) (d-1) hA).trans (Nat.sub_le _ _) have hB := normal_degree_tangent_le N d hd hN c htop hpen have hT (i : Fin n) : (finSuccEquiv ℝ n (pderiv i.succ (pderiv 0 N))).natDegree ≤ d-1 := normal_degree_succ_le (pderiv 0 N) (d-1) hA i have hL : (finSuccEquiv ℝ n (tangentialLaplacian N)).natDegree ≤ d-2 := by simp only [tangentialLaplacian,map_sum] apply Polynomial.natDegree_sum_le_of_forall_le intro i hi exact normal_degree_succ_le (pderiv i.succ N) (d-2) (hB i) i have hM : (finSuccEquiv ℝ n (tangentialMixed N)).natDegree ≤ 2*d-3 := by simp only [tangentialMixed,map_sum,map_mul] apply Polynomial.natDegree_sum_le_of_forall_le intro i hi exact (Polynomial.natDegree_mul_le).trans (by have := hB i; have := hT i; omega) have hE : (finSuccEquiv ℝ n (tangentialEnergy N)).natDegree ≤ 2*d-4 := by simp only [tangentialEnergy,map_sum,map_pow] apply Polynomial.natDegree_sum_le_of_forall_le intro i hi exact Polynomial.natDegree_pow_le.trans (by have := hB i; omega) simp only [newtonResidual,map_add,map_sub,map_mul,map_pow,map_ofNat] apply Polynomial.natDegree_add_le_of_degree_le · apply (Polynomial.natDegree_sub_le _ _).trans apply max_le · exact Polynomial.natDegree_mul_le.trans (by have hp := Polynomial.natDegree_pow_le (p := finSuccEquiv ℝ n (pderiv 0 N)) (n := 2) omega) · exact Polynomial.natDegree_mul_le.trans (by have hp := Polynomial.natDegree_mul_le (p := (2 : Polynomial (MvPolynomial (Fin n) ℝ))) (q := finSuccEquiv ℝ n (pderiv 0 N)) have hz : (2 : Polynomial (MvPolynomial (Fin n) ℝ)).natDegree = 0 := by simp omega) · exact Polynomial.natDegree_mul_le.trans (by omega) lemma residual_top_coefficient_zero (N : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hd : 0 < d) (hN : (finSuccEquiv ℝ n N).natDegree ≤ d) (c : ℝ) (htop : (finSuccEquiv ℝ n N).coeff d = C c) (hpen : (finSuccEquiv ℝ n N).coeff (d-1) = 0) : (finSuccEquiv ℝ n (newtonResidual N)).coeff (3*(d-1)) = 0 := by by_cases hd2 : 2 ≤ d · exact Polynomial.coeff_eq_zero_of_natDegree_lt ((residual_normal_degree_le N d hd2 hN c htop hpen).trans_lt (by omega)) · have hd1 : d = 1 := by omega have hz (i : Fin n) : pderiv i.succ N = 0 := by apply (finSuccEquiv ℝ n).injective apply Polynomial.ext intro k simp only [map_zero,Polynomial.coeff_zero] exact tangent_coeff_high_zero N d hd hN c htop hpen i k (by omega) simp only [newtonResidual,tangentialLaplacian,tangentialMixed,tangentialEnergy, hz,map_zero,zero_mul,mul_zero,zero_pow (by decide : 2 ≠ 0), Finset.sum_const_zero,sub_zero,add_zero,Polynomial.coeff_zero] /-- A residual proportional to the normal derivative cube must vanish when the leading normal coefficient is constant and the penultimate one is zero. -/ theorem residual_eq_zero_of_background_factor (N : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hd : 0 < d) (hN : (finSuccEquiv ℝ n N).natDegree ≤ d) (c : ℝ) (hc : c ≠ 0) (htop : (finSuccEquiv ℝ n N).coeff d = C c) (hpen : (finSuccEquiv ℝ n N).coeff (d-1) = 0) (b : (Fin n → ℝ) → ℝ) (he : ∀ x y, eval (Fin.cons x y) (newtonResidual N) = (eval (Fin.cons x y) (pderiv 0 N))^3 * b y) : (∀ y, b y = 0) ∧ newtonResidual N = 0 := by have hb (y : Fin n → ℝ) : b y = 0 := by have hp : sliceHom y (newtonResidual N) = (sliceHom y (pderiv 0 N))^3 * Polynomial.C (b y) := by apply Polynomial.funext intro x simpa only [Polynomial.eval_mul,Polynomial.eval_pow,Polynomial.eval_C,eval_sliceHom] using he x y have hdegree : (sliceHom y (pderiv 0 N)).natDegree ≤ d-1 := Polynomial.natDegree_map_le.trans (normal_degree_zero_le N d hN) have hcoeff : (sliceHom y (pderiv 0 N)).coeff (d-1) = c*(d:ℝ) := by rw [sliceHom_pderiv_zero,Polynomial.coeff_derivative] have hpred : d-1+1 = d := by omega simp only [hpred] have hcast : ((d-1:ℕ):ℝ)+1 = (d:ℝ) := by exact_mod_cast hpred rw [hcast] change (((finSuccEquiv ℝ n N).map (eval y)).coeff d) * (d:ℝ) = _ rw [Polynomial.coeff_map,htop,eval_C] have hleft : (sliceHom y (newtonResidual N)).coeff (3*(d-1)) = 0 := by change (((finSuccEquiv ℝ n (newtonResidual N)).map (eval y)).coeff (3*(d-1))) = 0 rw [Polynomial.coeff_map,residual_top_coefficient_zero N d hd hN c htop hpen,map_zero] have hv := congrArg (fun p : Polynomial ℝ ↦ p.coeff (3*(d-1))) hp rw [hleft,Polynomial.coeff_mul_C,Polynomial.coeff_pow_of_natDegree_le hdegree,hcoeff] at hv exact (mul_eq_zero.mp hv.symm).resolve_left (pow_ne_zero 3 (mul_ne_zero hc (by exact_mod_cast hd.ne'))) refine ⟨hb,?_⟩ apply Source29QuarticReuse.QuarticCompatibility.polynomial_funext intro z have hz := he (z 0) (Fin.tail z) simpa only [hb,mul_zero,Fin.cons_self_tail,map_zero] using hz end end Source29DepressedNewtonDegree /- Component: BackgroundFreeScaledResidual.inc -/ namespace Source29BackgroundFreeScaledResidual open Filter Source29NormalShiftDerivatives Source29NormalShiftAlgebra Source29NormalShiftScaling Source29NormalizedShiftJets Source29NormalizedShiftBackground Source29NormalShiftScalingLimit open scoped Topology noncomputable section variable {n : ℕ} /-- The exact normalized equation retains the background term. No equation for the centering graph is assumed. -/ theorem scaled_pullback_equation (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (κ ε ρ : ℝ) (hκ : κ ≠ 0) (hε : ε ≠ 0) (hρ : ρ ≠ 0) (v : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (ε • tail v)) (hP : MvPolynomial.eval (chart g (dilation (ε*ρ) ε v)) (Source29QuarticReuse.QuarticMinimal.leadingOperator P) = 0) : let H := scaledFunction (pullback P g) κ ε ρ let A := gradient H v 0 let S := hessian H v 0 0 let B := fun i : Fin n ↦ gradient H v i.succ let T := fun i : Fin n ↦ hessian H v i.succ 0 let U := fun i j : Fin n ↦ hessian H v i.succ j.succ let a := fun i ↦ gradient g (ε • tail v) i / ε let G := hessian g (ε • tail v) newtonResidual A S B T U + ρ^2*rhoCorrection B U + ε*ρ*mixedCorrection A B T a U G + ε^2*epsilonCorrection A S B T a U G = A^3 * ((ε/ρ)*backgroundGraphOperator (gradient g (ε • tail v)) G) := by dsimp only have hga : AnalyticAt ℝ g (tail (dilation (ε*ρ) ε v)) := hg have hf := analyticAt_pullback P g (dilation (ε*ρ) ε v) hga obtain ⟨hA,hB,hS,hT,hU⟩ := original_jets (pullback P g) κ ε ρ hκ hε hρ v hf have he := polynomial_cubicLevel_transform P g (dilation (ε*ρ) ε v) hga dsimp only at he rw [cubicLevel_eval,hP] at he have hl : shiftedLevelOperator (gradient (pullback P g) (dilation (ε*ρ) ε v) 0) (hessian (pullback P g) (dilation (ε*ρ) ε v) 0 0) (fun i : Fin n ↦ gradient (pullback P g) (dilation (ε*ρ) ε v) i.succ) (fun i : Fin n ↦ hessian (pullback P g) (dilation (ε*ρ) ε v) i.succ 0) (gradient g (ε • tail v)) (fun i j : Fin n ↦ hessian (pullback P g) (dilation (ε*ρ) ε v) i.succ j.succ) (hessian g (ε • tail v)) = 0 := by rw [normal_shift_identity] exact he.symm simp_rw [hA,hB,hS,hT,hU] at hl rw [← scaled_gradient g (tail v) ε hε] at hl rw [normal_shift_scaling κ ε ρ _ _ _ _ _ _ _ hε hρ] at hl have hz := (mul_eq_zero.mp hl).resolve_left (div_ne_zero (mul_ne_zero (pow_ne_zero 3 hκ) hρ) hε) rw [scaled_gradient g (tail v) ε hε] at hz linear_combination hz /-- The tuple of actual normalized jets, including the bounded background jets. -/ def jets (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (α D ε : ℝ) (v : Fin (n+1) → ℝ) : Jet (Fin n) := ((gradient (family P g α D ε) v 0,hessian (family P g α D ε) v 0 0), (fun i ↦ gradient (family P g α D ε) v i.succ, fun i ↦ hessian (family P g α D ε) v i.succ 0, fun i ↦ gradient g (ε • tail v) i / ε), (fun i j ↦ hessian (family P g α D ε) v i.succ j.succ,hessian g (ε • tail v))) def total (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (α D ε : ℝ) (v : Fin (n+1) → ℝ) : ℝ := Source29NormalShiftScalingLimit.residual (jets P g α D ε v) + (ε^(α-1))^2*rhoTerm (jets P g α D ε v) + ε*ε^(α-1)*mixedTerm (jets P g α D ε v) + ε^2*epsilonTerm (jets P g α D ε v) def background (g : (Fin n → ℝ) → ℝ) (α ε : ℝ) (y : Fin n → ℝ) : ℝ := (ε/ε^(α-1))*backgroundGraphOperator (gradient g (ε • y)) (hessian g (ε • y)) /-- At every positive scale the background depends only on the tangential point, even though the normalized residual also depends on the normal point. -/ theorem family_equation (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (α D ε : ℝ) (hε : 0 < ε) (v : Fin (n+1) → ℝ) (hg : AnalyticAt ℝ g (ε • tail v)) (hP : Source29QuarticReuse.QuarticMinimal.leadingOperator P = 0) : total P g α D ε v = (gradient (family P g α D ε) v 0)^3 * background g α ε (tail v) := by unfold total jets Source29NormalShiftScalingLimit.residual rhoTerm mixedTerm epsilonTerm background dsimp only rw [family_eq_scaledFunction P g α D ε hε] exact scaled_pullback_equation P g (ε^(D-α)) ε (ε^(α-1)) (ne_of_gt (Real.rpow_pos_of_pos hε _)) (ne_of_gt hε) (ne_of_gt (Real.rpow_pos_of_pos hε _)) v hg (by rw [hP,map_zero]) /-- Vanishing scale factors kill all correction terms for any analytic flat centering graph. The graph need not satisfy a minimal surface equation. -/ theorem total_tendsto (P N : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (α D : ℝ) (hα : 1 < α) (hg : AnalyticAt ℝ g 0) (hg0 : gradient g 0 = 0) (v : Fin (n+1) → ℝ) (hfirst : ∀ i, Tendsto (fun ε : ℝ ↦ gradient (family P g α D ε) v i) (𝓝[>] 0) (𝓝 (MvPolynomial.eval v (MvPolynomial.pderiv i N)))) (hsecond : ∀ i j, Tendsto (fun ε : ℝ ↦ hessian (family P g α D ε) v i j) (𝓝[>] 0) (𝓝 (MvPolynomial.eval v (MvPolynomial.pderiv i (MvPolynomial.pderiv j N))))) : Tendsto (fun ε : ℝ ↦ total P g α D ε v) (𝓝[>] 0) (𝓝 (MvPolynomial.eval v (Source29NewtonNormalDerivative.newtonResidual N))) := by let j₀ : Jet (Fin n) := ((MvPolynomial.eval v (MvPolynomial.pderiv 0 N), MvPolynomial.eval v (MvPolynomial.pderiv 0 (MvPolynomial.pderiv 0 N))), (fun i ↦ MvPolynomial.eval v (MvPolynomial.pderiv i.succ N), fun i ↦ MvPolynomial.eval v (MvPolynomial.pderiv i.succ (MvPolynomial.pderiv 0 N)), fun i ↦ second g 0 (tail v) (basis i)), (fun i j ↦ MvPolynomial.eval v (MvPolynomial.pderiv i.succ (MvPolynomial.pderiv j.succ N)), hessian g 0)) have hj : Tendsto (fun ε : ℝ ↦ jets P g α D ε v) (𝓝[>] 0) (𝓝 j₀) := ((hfirst 0).prodMk_nhds (hsecond 0 0)).prodMk_nhds (((tendsto_pi_nhds.mpr (fun i : Fin n ↦ hfirst i.succ)).prodMk_nhds ((tendsto_pi_nhds.mpr (fun i : Fin n ↦ hsecond i.succ 0)).prodMk_nhds (gradient_div_tendsto g hg hg0 (tail v)))).prodMk_nhds ((tendsto_pi_nhds.mpr (fun i : Fin n ↦ tendsto_pi_nhds.mpr (fun j : Fin n ↦ hsecond i.succ j.succ))).prodMk_nhds (hessian_tendsto g hg (tail v)))) have hε : Tendsto (fun ε : ℝ ↦ ε) (𝓝[>] 0) (𝓝 0) := tendsto_id.mono_left nhdsWithin_le_nhds have hρ : Tendsto (fun ε : ℝ ↦ ε^(α-1)) (𝓝[>] 0) (𝓝 0) := by have hp : Tendsto (fun ε : ℝ ↦ ε^(α-1)) (𝓝[>] 0) (𝓝 ((0 : ℝ)^(α-1))) := (Real.continuousAt_rpow_const (0 : ℝ) (α-1) (Or.inr (le_of_lt (sub_pos.mpr hα)))).tendsto.mono_left nhdsWithin_le_nhds simpa only [Real.zero_rpow (ne_of_gt (sub_pos.mpr hα))] using hp have hE := residual_continuous.continuousAt.tendsto.comp hj have hR := rhoTerm_continuous.continuousAt.tendsto.comp hj have hM := mixedTerm_continuous.continuousAt.tendsto.comp hj have hS := epsilonTerm_continuous.continuousAt.tendsto.comp hj have htotal : Tendsto (fun ε : ℝ ↦ total P g α D ε v) (𝓝[>] 0) (𝓝 (Source29NormalShiftScalingLimit.residual j₀)) := by simpa only [zero_pow (by decide : 2 ≠ 0),zero_mul,add_zero,total,Function.comp_def] using ((hE.add ((hρ.pow 2).mul hR)).add ((hε.mul hρ).mul hM)).add ((hε.pow 2).mul hS) convert htotal using 1 congr 1 rw [← Source29NormalizedShiftResidual.newtonResidual_eval N v] simp only [Source29NormalShiftScalingLimit.residual,j₀,gradient_eval,hessian_eval] end end Source29BackgroundFreeScaledResidual /- Component: BackgroundFactorLimit.inc -/ namespace Source29BackgroundFactorLimit open Filter open scoped Topology /-- A common scalar factor has a limit once one limiting multiplier is nonzero; this determines every other limiting product. -/ theorem exists_limit_of_products {T X : Type*} {l : Filter T} [NeBot l] (A R : T → X → ℝ) (B : T → ℝ) (a r : X → ℝ) (hA : ∀ x, Tendsto (fun t ↦ A t x) l (𝓝 (a x))) (hR : ∀ x, Tendsto (fun t ↦ R t x) l (𝓝 (r x))) (he : ∀ x, ∀ᶠ t in l, R t x = A t x * B t) (ha : ∃ x, a x ≠ 0) : ∃ b : ℝ, Tendsto B l (𝓝 b) ∧ ∀ x, r x = a x * b := by obtain ⟨x₀,hx₀⟩ := ha have hb : Tendsto B l (𝓝 (r x₀ / a x₀)) := by apply ((hR x₀).div (hA x₀) hx₀).congr' filter_upwards [he x₀,(hA x₀).eventually (eventually_ne_nhds hx₀)] with t ht hn change R t x₀ / A t x₀ = B t rw [ht,mul_div_cancel_left₀ _ hn] refine ⟨r x₀ / a x₀,hb,fun x ↦ ?_⟩ have hp : Tendsto (fun t ↦ R t x) l (𝓝 (a x * (r x₀/a x₀))) := by apply ((hA x).mul hb).congr' filter_upwards [he x] with t ht exact ht.symm exact tendsto_nhds_unique (hR x) hp end Source29BackgroundFactorLimit /- Component: BackgroundFreeNewtonLimit.inc -/ namespace Source29BackgroundFreeNewtonLimit open Filter MvPolynomial Source29NormalShiftDerivatives Source29NormalizedShiftJets Source29NormalizedShiftBackground Source29BackgroundFreeScaledResidual Source29QuarticReuse.QuarticMinimal.DistinguishedVariable open scoped Topology noncomputable section variable {n : ℕ} /-- Every fixed tangential slice admits a limiting scalar background factor. A nonzero constant normal coefficient supplies the required nonzero limiting normal derivative somewhere on that slice. -/ theorem exists_background_factor (P N : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (α D : ℝ) (hα : 1 < α) (hg : AnalyticAt ℝ g 0) (hg0 : gradient g 0 = 0) (hP : Source29QuarticReuse.QuarticMinimal.leadingOperator P = 0) (d : ℕ) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (htop : (finSuccEquiv ℝ n N).coeff d = C c) (hfirst : ∀ v i, Tendsto (fun ε : ℝ ↦ gradient (family P g α D ε) v i) (𝓝[>] 0) (𝓝 (eval v (pderiv i N)))) (hsecond : ∀ v i j, Tendsto (fun ε : ℝ ↦ hessian (family P g α D ε) v i j) (𝓝[>] 0) (𝓝 (eval v (pderiv i (pderiv j N))))) : ∃ b : (Fin n → ℝ) → ℝ, ∀ x y, eval (Fin.cons x y) (Source29NewtonNormalDerivative.newtonResidual N) = (eval (Fin.cons x y) (pderiv 0 N))^3 * b y := by classical have hb (y : Fin n → ℝ) : ∃ b : ℝ, ∀ x, eval (Fin.cons x y) (Source29NewtonNormalDerivative.newtonResidual N) = (eval (Fin.cons x y) (pderiv 0 N))^3 * b := by have hex : ∃ x : ℝ, eval (Fin.cons x y) (pderiv 0 N) ≠ 0 := by by_contra! hz have hn := Source29NewtonNormalDerivative.slice_derivative_ne_zero_of_constant_coefficient N d hd c hc htop y apply hn apply Polynomial.funext intro x simpa only [Source29NewtonNormalDerivative.eval_sliceHom,Polynomial.eval_zero] using hz x have he (x : ℝ) : ∀ᶠ ε : ℝ in 𝓝[>] 0, total P g α D ε (Fin.cons x y) = (gradient (family P g α D ε) (Fin.cons x y) 0)^3 * background g α ε y := by filter_upwards [self_mem_nhdsWithin,(dilation_tendsto y).eventually hg.eventually_analyticAt] with ε hε hge have ht : tail (Fin.cons x y) = y := by ext i; rfl simpa only [ht] using family_equation P g α D ε hε (Fin.cons x y) hge hP obtain ⟨b,hbl,hb⟩ := Source29BackgroundFactorLimit.exists_limit_of_products (fun ε x ↦ (gradient (family P g α D ε) (Fin.cons x y) 0)^3) (fun ε x ↦ total P g α D ε (Fin.cons x y)) (fun ε ↦ background g α ε y) (fun x ↦ (eval (Fin.cons x y) (pderiv 0 N))^3) (fun x ↦ eval (Fin.cons x y) (Source29NewtonNormalDerivative.newtonResidual N)) (fun x ↦ (hfirst (Fin.cons x y) 0).pow 3) (fun x ↦ total_tendsto P N g α D hα hg hg0 (Fin.cons x y) (hfirst (Fin.cons x y)) (hsecond (Fin.cons x y))) he (by obtain ⟨x,hx⟩ := hex; exact ⟨x,pow_ne_zero 3 hx⟩) exact ⟨b,hb⟩ choose b hb using hb exact ⟨b,fun x y ↦ hb y x⟩ /-- A depressed Newton face obtained from actual normalized first and second jets satisfies the Newton residual equation. No background graph equation or sign assumption is required. -/ theorem newtonResidual_eq_zero (P N : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (α D : ℝ) (hα : 1 < α) (hg : AnalyticAt ℝ g 0) (hg0 : gradient g 0 = 0) (hP : Source29QuarticReuse.QuarticMinimal.leadingOperator P = 0) (d : ℕ) (hd : 0 < d) (hN : (finSuccEquiv ℝ n N).natDegree ≤ d) (c : ℝ) (hc : c ≠ 0) (htop : (finSuccEquiv ℝ n N).coeff d = C c) (hpen : (finSuccEquiv ℝ n N).coeff (d-1) = 0) (hfirst : ∀ v i, Tendsto (fun ε : ℝ ↦ gradient (family P g α D ε) v i) (𝓝[>] 0) (𝓝 (eval v (pderiv i N)))) (hsecond : ∀ v i j, Tendsto (fun ε : ℝ ↦ hessian (family P g α D ε) v i j) (𝓝[>] 0) (𝓝 (eval v (pderiv i (pderiv j N))))) : Source29NewtonNormalDerivative.newtonResidual N = 0 := by obtain ⟨b,hb⟩ := exists_background_factor P N g α D hα hg hg0 hP d hd c hc htop hfirst hsecond exact (Source29DepressedNewtonDegree.residual_eq_zero_of_background_factor N d hd hN c hc htop hpen b hb).2 end end Source29BackgroundFreeNewtonLimit /- Component: DepressedNewtonFaceLimit.inc -/ namespace Source29DepressedNewtonFaceLimit open Filter MvPolynomial Source29NewtonWeightedFace Source29NewtonInitialDataLimit Source29NewtonShiftedFactorCoefficient Source29NormalShiftDerivatives open scoped Topology noncomputable section variable {n d : ℕ} /-- A weighted initial coefficient of a zero analytic germ is zero. -/ theorem polynomial_eq_zero_of_zero_germ {f : (Fin n → ℝ) → ℝ} (β : ℝ) (Q : MvPolynomial (Fin n) ℝ) (hdata : CoefficientData f β Q) (hz : ∀ᶠ y in 𝓝 0, f y = 0) : Q = 0 := by apply Source29QuarticReuse.QuarticCompatibility.polynomial_funext intro y have ht := (coefficient_uniform_limit β Q hdata {y} isCompact_singleton.isBounded).tendsto_at (Set.mem_singleton y) have hzlim : Tendsto (fun ε : ℝ ↦ ε^(-β)*f (ε • y)) (𝓝[>] 0) (𝓝 0) := by apply tendsto_const_nhds.congr' filter_upwards [(Source29NormalizedShiftBackground.dilation_tendsto y).eventually hz] with ε hε simp only [hε,mul_zero] simpa only [map_zero] using tendsto_nhds_unique ht hzlim /-- Centering the original shifted polynomial removes the same coefficient from every selected weighted face. -/ theorem penultimate_coefficient_zero (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (hd : 0 < d) (c : ℝ) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) (α : ℝ) (hpen : ∀ᶠ y in 𝓝 0, (shiftedSlice F (g y) y).coeff (d-1) = 0) (hdata : ∀ j : Fin d, CoefficientData (fun y ↦ (shiftedSlice F (g y) y).coeff (j : ℕ)) (α*(d : ℝ)-α*(j : ℕ)) (if j ∈ S then P j else 0)) : (finSuccEquiv ℝ n (face c S P)).coeff (d-1) = 0 := by let j : Fin d := ⟨d-1,by omega⟩ have he := polynomial_eq_zero_of_zero_germ (α*(d : ℝ)-α*(j : ℕ)) (if j ∈ S then P j else 0) (hdata j) hpen exact (lower_coefficient c S P j).trans he /-- Actual coefficient data for a centered analytic shift directly yield the selected face equation, without a background graph equation. -/ theorem face_residual_eq_zero (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (hg0 : gradient g 0 = 0) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (hd : 0 < d) (c : ℝ) (hc : c ≠ 0) (htop : (shiftedSlice F (g 0) 0).coeff d = c) (S : Finset (Fin d)) (P : Fin d → MvPolynomial (Fin n) ℝ) (α : ℝ) (hα : 1 < α) (hpen : ∀ᶠ y in 𝓝 0, (shiftedSlice F (g y) y).coeff (d-1) = 0) (hdata : ∀ j : Fin d, CoefficientData (fun y ↦ (shiftedSlice F (g y) y).coeff (j : ℕ)) (α*(d : ℝ)-α*(j : ℕ)) (if j ∈ S then P j else 0)) : Source29NewtonNormalDerivative.newtonResidual (face c S P) = 0 := by let m := max (finSuccEquiv ℝ n F).natDegree d + 1 have hFm : (finSuccEquiv ℝ n F).natDegree < m := Nat.lt_succ_of_le (le_max_left _ _) have hdm : d < m := Nat.lt_succ_of_le (le_max_right _ _) have hjets := Source29NewtonFaceJetLimit.face_coordinate_jets_tendsto F g hg c htop S P α (lt_trans zero_lt_one hα) m hdm hFm hdata exact Source29BackgroundFreeNewtonLimit.newtonResidual_eq_zero F (face c S P) g α (α*d) hα hg hg0 hF d hd (normal_degree_le c S P) c hc (top_coefficient c S P) (penultimate_coefficient_zero F g hd c S P α hpen hdata) (fun x ↦ (hjets x).1) (fun x ↦ (hjets x).2) end end Source29DepressedNewtonFaceLimit /- Component: CenteredNewtonObstruction.inc -/ namespace Source29CenteredNewtonObstruction open MvPolynomial Filter open Source29NewtonShiftedFactorCoefficient Source29NewtonWeightedFace open Source29NormalShiftDerivatives open scoped Topology noncomputable section variable {n : ℕ} /-- An odd pure ordinary initial limit and analytic centering exclude every lower normal coefficient germ. The Newton residual follows from actual jets; no root, sign, or background graph equation is an assumption. -/ theorem lower_coefficient_germs_zero (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (hg0 : gradient g 0 = 0) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (d : ℕ) (hd : Odd d) (c : ℝ) (hc : c ≠ 0) (hinitial : ∀ x y, Tendsto (fun t : ℝ ↦ eval (Fin.cons (g (t•y)+t*x) (t•y)) F / t^d) (𝓝[>] 0) (𝓝 (c*x^d))) (hpen : ∀ᶠ y in 𝓝 0, (shiftedSlice F (g y) y).coeff (d-1) = 0) : ∀ j : Fin d, ∀ᶠ y in 𝓝 0, (shiftedSlice F (g y) y).coeff (j:ℕ) = 0 := by classical by_contra h have hne := not_forall.mp h obtain ⟨α,S,P,v,hα,hS,hP,horder,hselected,hdata⟩ := Source29NewtonCoefficientSelection.exists_selected_coefficient_data (fun (j : Fin d) y ↦ (shiftedSlice F (g y) y).coeff (j:ℕ)) (fun j ↦ Source29NewtonCoefficientAnalytic.analyticAt_shifted_coefficient F j g 0 hg) hne (Source29NewtonCoefficientLimitExtraction.lower_coefficient_limit_zero_of_pure_initial F g d c hinitial) have hαpos : 0 < α := lt_trans zero_lt_one hα have htop := Source29NewtonInitialCenterCoefficient.center_coefficient_of_pure_initial F g d c hinitial have hdata' : ∀ j : Fin d, Source29NewtonInitialDataLimit.CoefficientData (fun y ↦ (shiftedSlice F (g y) y).coeff (j:ℕ)) (α*(d:ℝ)-α*(j:ℕ)) (if j ∈ S then P j else 0) := by intro j simpa only [mul_sub] using hdata j have hE := Source29DepressedNewtonFaceLimit.face_residual_eq_zero F g hg hg0 hF hd.pos c hc htop S P α hα hpen hdata' have hdepressed := Source29DepressedNewtonFaceLimit.penultimate_coefficient_zero F g hd.pos c S P α hpen hdata' have heq := Source29DepressedNewtonRigidity.eq_pure_normal_power_of_ne_zero (face c S P) α (α*d) (mul_pos hαpos (by exact_mod_cast hd.pos)) (weightedEuler c S P v α (fun j _ ↦ hP j) (fun j hj ↦ ((hselected j).mp hj).2)) hE d hd c hc (normal_degree_le c S P) (top_coefficient c S P) hdepressed obtain ⟨j,hj⟩ := hS exact ne_pure_normal_power c S P j hj ((hselected j).mp hj).1 heq end end Source29CenteredNewtonObstruction /- Component: ShiftedAnalyticUnit.inc -/ namespace Source29ShiftedAnalyticUnit open MvPolynomial Filter open Source29NewtonShiftedFactorCoefficient Source29NewtonShiftedExpansion open scoped Topology BigOperators noncomputable section def dropCoefficients {R : Type*} [Semiring R] : ℕ → Polynomial R → Polynomial R | 0, p => p | d+1, p => dropCoefficients d p.divX theorem coeff_dropCoefficients {R : Type*} [Semiring R] (p : Polynomial R) (d j : ℕ) : (dropCoefficients d p).coeff j = p.coeff (j+d) := by induction d generalizing p with | zero => simp [dropCoefficients] | succ d ih => simp only [dropCoefficients, ih, Polynomial.coeff_divX, Nat.add_assoc] theorem natDegree_dropCoefficients_le {R : Type*} [Semiring R] (p : Polynomial R) (d : ℕ) : (dropCoefficients d p).natDegree ≤ p.natDegree := by induction d generalizing p with | zero => exact le_rfl | succ d ih => exact (ih p.divX).trans Polynomial.natDegree_divX_le theorem eq_X_pow_mul_dropCoefficients {R : Type*} [Semiring R] (p : Polynomial R) (d : ℕ) (hlow : ∀ j < d, p.coeff j = 0) : p = Polynomial.X^d * dropCoefficients d p := by ext j rw [Polynomial.coeff_X_pow_mul'] split_ifs with h · rw [coeff_dropCoefficients, Nat.sub_add_cancel h] · exact hlow j (Nat.lt_of_not_ge h) variable {n : ℕ} def unitFunction (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (d : ℕ) (z : ℝ × (Fin n → ℝ)) : ℝ := (dropCoefficients d (shiftedSlice F (g z.2) z.2)).eval z.1 theorem unitFunction_zero (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (d : ℕ) (y : Fin n → ℝ) : unitFunction F g d (0,y) = (shiftedSlice F (g y) y).coeff d := by simp only [unitFunction, ← Polynomial.coeff_zero_eq_eval_zero, coeff_dropCoefficients, zero_add] theorem unitFunction_analyticAt (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (d : ℕ) (z : ℝ × (Fin n → ℝ)) (hg : AnalyticAt ℝ g z.2) : AnalyticAt ℝ (unitFunction F g d) z := by let m := (finSuccEquiv ℝ n F).natDegree+1 have he : unitFunction F g d = fun w : ℝ × (Fin n → ℝ) => ∑ j ∈ Finset.range m, (shiftedSlice F (g w.2) w.2).coeff (j+d) * w.1^j := by funext w have hm : (dropCoefficients d (shiftedSlice F (g w.2) w.2)).natDegree < m := lt_of_le_of_lt ((natDegree_dropCoefficients_le _ _).trans (shiftedSlice_natDegree_le F _ _)) (Nat.lt_succ_self _) simp only [unitFunction, Polynomial.eval_eq_sum_range' hm, coeff_dropCoefficients] rw [he] apply Finset.analyticAt_fun_sum intro j hj have hc := Source29NewtonCoefficientAnalytic.analyticAt_shifted_coefficient F (j+d) g z.2 hg exact (hc.comp ((ContinuousLinearMap.snd ℝ ℝ (Fin n → ℝ)).analyticAt z)).mul (((ContinuousLinearMap.fst ℝ ℝ (Fin n → ℝ)).analyticAt z).pow j) theorem eval_eq_pow_mul_unit (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (d : ℕ) (x : ℝ) (y : Fin n → ℝ) (hlow : ∀ j < d, (shiftedSlice F (g y) y).coeff j = 0) : eval (Fin.cons (g y+x) y) F = x^d * unitFunction F g d (x,y) := by rw [← eval_shiftedSlice, eq_X_pow_mul_dropCoefficients _ d hlow] simp only [Polynomial.eval_mul, Polynomial.eval_pow, Polynomial.eval_X, unitFunction] theorem eventually_factor (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (d : ℕ) (a : Fin n → ℝ) (hlow : ∀ j : Fin d, ∀ᶠ y in 𝓝 a, (shiftedSlice F (g y) y).coeff (j:ℕ) = 0) : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 (0,a), eval (Fin.cons (g z.2+z.1) z.2) F = z.1^d * unitFunction F g d z := by have hy : ∀ᶠ y in 𝓝 a, ∀ j : Fin d, (shiftedSlice F (g y) y).coeff (j:ℕ) = 0 := Filter.eventually_all.mpr hlow filter_upwards [(continuous_snd.tendsto (0,a)).eventually hy] with z hz exact eval_eq_pow_mul_unit F g d z.1 z.2 (fun j hj => hz ⟨j,hj⟩) /-- If all lower normal coefficient germs vanish and the next coefficient does not, the local zero set is exactly the analytic center graph. -/ theorem eventually_zero_iff_normal_zero (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (d : ℕ) (hd : 0 < d) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) (hlow : ∀ j : Fin d, ∀ᶠ y in 𝓝 a, (shiftedSlice F (g y) y).coeff (j:ℕ) = 0) (htop : (shiftedSlice F (g a) a).coeff d ≠ 0) : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 (0,a), (eval (Fin.cons (g z.2+z.1) z.2) F = 0 ↔ z.1 = 0) := by have hunit : unitFunction F g d (0,a) ≠ 0 := by rwa [unitFunction_zero] have hn := (unitFunction_analyticAt F g d (0,a) hg).continuousAt.eventually_ne hunit filter_upwards [eventually_factor F g d a hlow, hn] with z he hne rw [he, mul_eq_zero, or_iff_left hne, pow_eq_zero_iff hd.ne'] /-- Positive odd leading coefficient gives the exact two phase signs near the center graph once all lower coefficient germs vanish. -/ theorem eventually_phase_equivalences (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (d : ℕ) (hd : Odd d) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) (hlow : ∀ j : Fin d, ∀ᶠ y in 𝓝 a, (shiftedSlice F (g y) y).coeff (j:ℕ) = 0) (htop : 0 < (shiftedSlice F (g a) a).coeff d) : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 (0,a), (0 < eval (Fin.cons (g z.2+z.1) z.2) F ↔ 0 < z.1) ∧ (eval (Fin.cons (g z.2+z.1) z.2) F < 0 ↔ z.1 < 0) := by have hunit : 0 < unitFunction F g d (0,a) := by rwa [unitFunction_zero] have hn := (unitFunction_analyticAt F g d (0,a) hg).continuousAt.eventually (lt_mem_nhds hunit) filter_upwards [eventually_factor F g d a hlow, hn] with z he hpos rw [he] exact ⟨(mul_pos_iff_of_pos_right hpos).trans hd.pow_pos_iff, (show z.1^d * unitFunction F g d z < 0 ↔ z.1^d < 0 by constructor · intro h by_contra hn exact (not_lt_of_ge (mul_nonneg (le_of_not_gt hn) hpos.le)) h · exact fun h => mul_neg_of_neg_of_pos h hpos).trans hd.pow_neg_iff⟩ end end Source29ShiftedAnalyticUnit /- Component: AnalyticGraphFactor.inc -/ namespace Source29AnalyticGraphFactor open MvPolynomial Filter Set open scoped Topology noncomputable section /-- Real analytic germs in any real normed space have no zero divisors. -/ theorem zero_germ_of_mul_zero {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] (f g : E → ℝ) (a : E) (hf : AnalyticAt ℝ f a) (hg : AnalyticAt ℝ g a) (hfg : ∀ᶠ y in 𝓝 a, f y * g y = 0) : (∀ᶠ y in 𝓝 a, f y = 0) ∨ (∀ᶠ y in 𝓝 a, g y = 0) := by by_cases hfzero : ∀ᶠ y in 𝓝 a, f y = 0 · exact Or.inl hfzero right have hevent : ∀ᶠ y in 𝓝 a, AnalyticAt ℝ f y ∧ AnalyticAt ℝ g y ∧ f y * g y = 0 := by filter_upwards [hf.eventually_analyticAt, hg.eventually_analyticAt, hfg] with y hyf hyg hy exact ⟨hyf, hyg, hy⟩ obtain ⟨r, hr, hball⟩ := Metric.eventually_nhds_iff_ball.mp hevent obtain ⟨b, hb, hfb⟩ : ∃ b ∈ Metric.ball a r, f b ≠ 0 := by by_contra hn apply hfzero filter_upwards [Metric.ball_mem_nhds a hr] with y hy by_contra hyne exact hn ⟨y, hy, hyne⟩ have hgn : ∀ᶠ y in 𝓝 b, g y = 0 := by have hfn := (hball b hb).1.continuousAt.eventually_ne hfb filter_upwards [Metric.isOpen_ball.mem_nhds hb, hfn] with y hy hyn exact (mul_eq_zero.mp (hball y hy).2.2).resolve_left hyn have hgon : AnalyticOnNhd ℝ g (Metric.ball a r) := fun y hy => (hball y hy).2.1 have heq := hgon.eqOn_zero_of_preconnected_of_eventuallyEq_zero (convex_ball a r).isPreconnected hb hgn filter_upwards [Metric.ball_mem_nhds a hr] with y hy exact heq hy variable {n : ℕ} lemma analyticAt_graph_eval (P : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) : AnalyticAt ℝ (fun y => eval (Fin.cons (g y) y) P) a := by apply (Source29PolynomialLinkChart.analyticAt_eval_real P _).comp apply AnalyticAt.pi intro i exact Fin.cases hg (fun j => (ContinuousLinearMap.proj j : (Fin n → ℝ) →L[ℝ] ℝ).analyticAt a) i /-- Some irreducible divisor vanishes on any analytic graph germ carried by a nonzero polynomial. The polynomial need not be regular on that graph. -/ theorem exists_irreducible_graph_factor (F : MvPolynomial (Fin (n+1)) ℝ) (hF : F ≠ 0) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) F = 0) : ∃ p : MvPolynomial (Fin (n+1)) ℝ, Irreducible p ∧ p ∣ F ∧ ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) p = 0 := by induction F using WfDvdMonoid.induction_on_irreducible with | zero => exact (hF rfl).elim | unit u hu => have hn : eval (Fin.cons (g a) a) u ≠ 0 := isUnit_iff_ne_zero.mp (hu.map (eval (Fin.cons (g a) a))) exact (hn hroot.self_of_nhds).elim | mul q p hq hp ih => have he : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) p * eval (Fin.cons (g y) y) q = 0 := by simpa only [map_mul] using hroot rcases zero_germ_of_mul_zero _ _ a (analyticAt_graph_eval p g a hg) (analyticAt_graph_eval q g a hg) he with hpzero | hqzero · exact ⟨p, hp, dvd_mul_right p q, hpzero⟩ · obtain ⟨r, hr, hrq, hrzero⟩ := ih hq hqzero exact ⟨r, hr, dvd_mul_of_dvd_right hrq p, hrzero⟩ /-- Choose the full multiplicity of a graph-vanishing irreducible factor. -/ theorem exists_full_graph_factor (F : MvPolynomial (Fin (n+1)) ℝ) (hF : F ≠ 0) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) (hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) F = 0) : ∃ (p Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ), 0 < k ∧ Irreducible p ∧ F = p^k*Q ∧ ¬ p ∣ Q ∧ ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) p = 0 := by obtain ⟨p, hp, hpF, hproot⟩ := exists_irreducible_graph_factor F hF g a hg hroot have hfinite : FiniteMultiplicity p F := FiniteMultiplicity.of_not_isUnit hp.not_isUnit hF obtain ⟨Q, hfac, hnot⟩ := hfinite.exists_eq_pow_mul_and_not_dvd have hk : 0 < multiplicity p F := Nat.pos_of_ne_zero ((multiplicity_ne_zero hfinite).mpr hpF) exact ⟨p, Q, multiplicity p F, hk, hp, hfac, hnot, hproot⟩ end end Source29AnalyticGraphFactor /- Component: BackgroundFromNormalMultiplicity.inc -/ namespace Source29BackgroundFromNormalMultiplicity open MvPolynomial Filter open Source29NewtonShiftedFactorCoefficient Source29NormalShiftDerivatives open Source29NormalShiftAlgebra open scoped Topology noncomputable section variable {n : ℕ} /-- Constant positive normal multiplicity and the cubic polynomial equation force the analytic graph to satisfy the minimal-graph equation. -/ theorem eventually_background_eq_zero (F : MvPolynomial (Fin (n+1)) ℝ) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (g : (Fin n → ℝ) → ℝ) (a : Fin n → ℝ) (hg : AnalyticAt ℝ g a) (d : ℕ) (hd : 0 < d) (hlower : ∀ j : Fin d, ∀ᶠ y in 𝓝 a, (shiftedSlice F (g y) y).coeff (j : ℕ) = 0) (htop : (shiftedSlice F (g a) a).coeff d ≠ 0) : ∀ᶠ y in 𝓝 a, backgroundGraphOperator (gradient g y) (hessian g y) = 0 := by have hFne : F ≠ 0 := by intro hz apply htop simp [hz, shiftedSlice] have hroot : ∀ᶠ y in 𝓝 a, eval (Fin.cons (g y) y) F = 0 := by simpa only [shiftedSlice_coeff_zero] using hlower ⟨0, hd⟩ obtain ⟨p, Q, k, hk, hp, hfac, hpQ, hproot⟩ := Source29AnalyticGraphFactor.exists_full_graph_factor F hFne g a hg hroot obtain ⟨_, hnormal, _⟩ := Source29GraphRootMultiplicity.regularity_and_cofactor_nonzero F p Q k d hk hfac hp hpQ g a hproot htop hlower have hprod : Source29FactorInheritance.cubicOperator (p^k*Q) = 0 := by rw [← hfac] exact hF have hdiv : p ∣ Source29QuarticReuse.QuarticMinimal.leadingOperator p := Source29RealLeadingFactor.real_factor_inheritance p Q k (by omega) hp hpQ hprod exact Source29RegularBranchBackgroundEquation.eventually_background_of_dvd p hdiv g a hg hproot hnormal end end Source29BackgroundFromNormalMultiplicity /- Component: FlatInitialPhaseChart.inc -/ namespace Source29FlatInitialPhaseChart open MvPolynomial Filter open Source29NormalShiftDerivatives Source29NormalShiftAlgebra open Source29NewtonShiftedFactorCoefficient Source29GeometricPhaseChart open Source29AffinePolynomialTransport open scoped Topology Matrix noncomputable section variable {n : ℕ} /-- Vanishing lower normal coefficients with a positive odd first coefficient provide the actual minimal phase chart, including both oriented phase signs. -/ theorem phase_chart_of_centered_coefficients (F : MvPolynomial (Fin (n+1)) ℝ) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (hg0 : g 0 = 0) (hgrad : gradient g 0 = 0) (d : ℕ) (hd : Odd d) (hlower : ∀ j : Fin d, ∀ᶠ y in 𝓝 0, (shiftedSlice F (g y) y).coeff (j : ℕ) = 0) (htop : 0 < (shiftedSlice F (g 0) 0).coeff d) : HasFlatMinimalPhaseChart F 0 := by have hbg := Source29BackgroundFromNormalMultiplicity.eventually_background_eq_zero F hF g 0 hg d hd.pos hlower htop.ne' have hroot : ∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) F = 0 := by simpa only [shiftedSlice_coeff_zero] using hlower ⟨0, hd.pos⟩ have hphase := Source29ShiftedAnalyticUnit.eventually_phase_equivalences F g d hd 0 hg hlower htop have hI : (1 : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) * (1 : Matrix (Fin (n+1)) (Fin (n+1)) ℝ).transpose = 1 := by simp have he : affineEquiv (0 : Fin (n+1) → ℝ) 1 hI F = F := by rw [affineEquiv_apply, Source29PolynomialTranslation.translate_zero_vector, Source29QuarticReuse.QuarticMinimal.changeVariables_one] refine ⟨1, hI, g, hg, hg0, hgrad, hbg, ?_, ?_, ?_⟩ · rwa [he] · filter_upwards [hphase] with z hz intro hx rw [he] exact ((hz.1).mpr hx).le · filter_upwards [hphase] with z hz intro hx rw [he] exact ((hz.2).mpr hx).le /-- A positive pure odd initial form of a cubic-equation solution produces a flat analytic minimal phase chart; the graph and its phase signs are conclusions. -/ theorem phase_chart_of_positive_odd_initial (F : MvPolynomial (Fin (n+1)) ℝ) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (d : ℕ) (hd : Odd d) (c : ℝ) (hc : 0 < c) (hlow : ∀ j < d, homogeneousComponent j F = 0) (hpure : homogeneousComponent d F = C c * (X 0)^d) : HasFlatMinimalPhaseChart F 0 := by obtain ⟨g, hg, hg0, hgrad, hD, hpen⟩ := Source29NormalHasseCentering.exists_flat_centering F d hd.pos c hc.ne' hlow hpure have hinitial := Source29PolynomialPureInitialShift.analytic_normal_shift_pure_initial_limit F d c hlow hpure hg hg0 hD have hlower := Source29CenteredNewtonObstruction.lower_coefficient_germs_zero F g hg hgrad hF d hd c hc.ne' hinitial hpen have htop := Source29NewtonInitialCenterCoefficient.center_coefficient_of_pure_initial F g d c hinitial apply phase_chart_of_centered_coefficients F hF g hg hg0 hgrad d hd hlower rwa [htop] /-- A chart in affine orthogonal coordinates transports to the original point. -/ theorem phase_chart_of_affine_phase_chart (F : MvPolynomial (Fin (n+1)) ℝ) (a : Fin (n+1) → ℝ) (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U * U.transpose = 1) (hchart : HasFlatMinimalPhaseChart (affineEquiv a U hU F) 0) : HasFlatMinimalPhaseChart F a := by obtain ⟨V, hV, g, hg, hg0, hgrad, hbg, hroot, hpos, hneg⟩ := hchart have hUV : (U * V) * (U * V).transpose = 1 := by calc _ = U * (V * V.transpose) * U.transpose := by rw [Matrix.transpose_mul] simp only [mul_assoc] _ = 1 := by rw [hV, mul_one, hU] have he : affineEquiv 0 V hV (affineEquiv a U hU F) = affineEquiv a (U * V) hUV F := by simp only [affineEquiv_apply, Source29PolynomialTranslation.translate_zero_vector, Source29QuarticReuse.QuarticMinimal.changeVariables_comp] refine ⟨U * V, hUV, g, hg, hg0, hgrad, hbg, ?_, ?_, ?_⟩ · rwa [he] at hroot · rwa [he] at hpos · rwa [he] at hneg /-- Pure positive odd initial data after a translated orthogonal change of coordinates gives a minimal phase chart at the original point. -/ theorem phase_chart_of_affine_positive_odd_initial (F : MvPolynomial (Fin (n+1)) ℝ) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (a : Fin (n+1) → ℝ) (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U * U.transpose = 1) (d : ℕ) (hd : Odd d) (c : ℝ) (hc : 0 < c) (hlow : ∀ j < d, homogeneousComponent j (affineEquiv a U hU F) = 0) (hpure : homogeneousComponent d (affineEquiv a U hU F) = C c * (X 0)^d) : HasFlatMinimalPhaseChart F a := by apply phase_chart_of_affine_phase_chart F a U hU apply phase_chart_of_positive_odd_initial _ _ d hd c hc hlow hpure rw [leadingOperator_affineEquiv, hF, map_zero] end end Source29FlatInitialPhaseChart /- Component: DifferentiablePhaseRegularity.inc -/ namespace Source29DifferentiablePhaseRegularity open MvPolynomial Filter open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29GeometricPhaseChart Source29AffinePolynomialTransport open scoped Topology Matrix noncomputable section variable {n : ℕ} /-- A flat differentiable description of the two phases upgrades to an analytic minimal phase chart through the polynomial equation and calibration. -/ theorem phase_chart_of_differentiable_phase (F : MvPolynomial (Fin (n+1)) ℝ) (hne : F ≠ 0) (hzero : eval 0 F = 0) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (hcal : WeakCalibration (leadingNormalizedField F)) (g : (Fin n → ℝ) → ℝ) (hg : DifferentiableAt ℝ g 0) (hg0 : g 0 = 0) (hD : fderiv ℝ g 0 = 0) (hpos : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, 0 < z.1 → 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) F) (hneg : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, z.1 < 0 → eval (Fin.cons (g z.2+z.1) z.2) F ≤ 0) : HasFlatMinimalPhaseChart F 0 := by obtain ⟨d,c,hc,hd,hlow,hpure⟩ := Source29CalibratedFlatGraphInitial.exists_pure_initial F hne hzero hcal g hg hg0 hD hpos hneg exact Source29FlatInitialPhaseChart.phase_chart_of_positive_odd_initial F hF d hd c hc hlow hpure /-- The original differentiable phase graph itself is analytic near the base point, since the polynomial has only the constructed analytic zero graph. -/ theorem analyticAt_of_differentiable_phase (F : MvPolynomial (Fin (n+1)) ℝ) (hne : F ≠ 0) (hzero : eval 0 F = 0) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (hcal : WeakCalibration (leadingNormalizedField F)) (g : (Fin n → ℝ) → ℝ) (hg : DifferentiableAt ℝ g 0) (hg0 : g 0 = 0) (hD : fderiv ℝ g 0 = 0) (hpos : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, 0 < z.1 → 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) F) (hneg : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, z.1 < 0 → eval (Fin.cons (g z.2+z.1) z.2) F ≤ 0) : AnalyticAt ℝ g 0 := by obtain ⟨d,c,hc,hd,hlow,hpure⟩ := Source29CalibratedFlatGraphInitial.exists_pure_initial F hne hzero hcal g hg hg0 hD hpos hneg obtain ⟨f,hf,hf0,hgrad,hDf,hpen⟩ := Source29NormalHasseCentering.exists_flat_centering F d hd.pos c hc.ne' hlow hpure have hinitial := Source29PolynomialPureInitialShift.analytic_normal_shift_pure_initial_limit F d c hlow hpure hf hf0 hDf have hlower := Source29CenteredNewtonObstruction.lower_coefficient_germs_zero F f hf hgrad hF d hd c hc.ne' hinitial hpen have htop := Source29NewtonInitialCenterCoefficient.center_coefficient_of_pure_initial F f d c hinitial have hunit := Source29ShiftedAnalyticUnit.eventually_zero_iff_normal_zero F f d hd.pos 0 hf hlower (by rw [htop]; exact hc.ne') obtain ⟨W,hW,hW0,hroot⟩ := Source29ZeroSetFactorGraph.graph_root_of_side_signs F g 0 hpos hneg have hlim : Tendsto (fun y : Fin n → ℝ => (g y-f y,y)) (𝓝 0) (𝓝 (0,0)) := by have h := (hg.continuousAt.sub hf.continuousAt).prodMk continuousAt_id simpa only [ContinuousAt, Pi.sub_apply, id_eq, hg0,hf0,sub_zero] using h apply hf.congr filter_upwards [hlim.eventually hunit, hW.mem_nhds hW0] with y hy hyW have hz : g y-f y = 0 := hy.mp (by simpa only [add_sub_cancel] using hroot y hyW) exact (sub_eq_zero.mp hz).symm /-- The differentiable-to-analytic upgrade is invariant under orthogonal coordinates centered at any zero of the polynomial. -/ theorem phase_chart_of_affine_differentiable_phase (F : MvPolynomial (Fin (n+1)) ℝ) (hne : F ≠ 0) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (hcal : WeakCalibration (leadingNormalizedField F)) (a : Fin (n+1) → ℝ) (ha : eval a F = 0) (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U * U.transpose = 1) (g : (Fin n → ℝ) → ℝ) (hg : DifferentiableAt ℝ g 0) (hg0 : g 0 = 0) (hD : fderiv ℝ g 0 = 0) (hpos : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, 0 < z.1 → 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) (affineEquiv a U hU F)) (hneg : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, z.1 < 0 → eval (Fin.cons (g z.2+z.1) z.2) (affineEquiv a U hU F) ≤ 0) : HasFlatMinimalPhaseChart F a := by apply Source29FlatInitialPhaseChart.phase_chart_of_affine_phase_chart F a U hU apply phase_chart_of_differentiable_phase (affineEquiv a U hU F) (fun h => hne ((map_eq_zero_iff (affineEquiv a U hU) (affineEquiv a U hU).injective).mp h)) (by rwa [eval_zero_affineEquiv]) (by rw [leadingOperator_affineEquiv,hF,map_zero]) (affine_weakCalibration F hcal a U hU) g hg hg0 hD hpos hneg end end Source29DifferentiablePhaseRegularity /- Component: FlatInitialExactGraph.inc -/ namespace Source29FlatInitialExactGraph open MvPolynomial Filter open Source29NormalShiftDerivatives Source29NormalShiftAlgebra open Source29NewtonShiftedFactorCoefficient open scoped Topology noncomputable section variable {n : ℕ} /-- Lower coefficient vanishing identifies both phases and the entire zero set with the center graph in the original, unshifted normal coordinate. -/ theorem eventually_exact_graph_of_centered_coefficients (F : MvPolynomial (Fin (n+1)) ℝ) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (hg0 : g 0 = 0) (d : ℕ) (hd : Odd d) (hlower : ∀ j : Fin d, ∀ᶠ y in 𝓝 0, (shiftedSlice F (g y) y).coeff (j : ℕ) = 0) (htop : 0 < (shiftedSlice F (g 0) 0).coeff d) : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, (eval (Fin.cons z.1 z.2) F = 0 ↔ z.1 = g z.2) ∧ (0 < eval (Fin.cons z.1 z.2) F ↔ g z.2 < z.1) ∧ (eval (Fin.cons z.1 z.2) F < 0 ↔ z.1 < g z.2) := by have hzero := Source29ShiftedAnalyticUnit.eventually_zero_iff_normal_zero F g d hd.pos 0 hg hlower htop.ne' have hphase := Source29ShiftedAnalyticUnit.eventually_phase_equivalences F g d hd 0 hg hlower htop have hgs : ContinuousAt (fun z : ℝ × (Fin n → ℝ) => g z.2) 0 := ContinuousAt.comp (f := fun z : ℝ × (Fin n → ℝ) => z.2) (x := 0) hg.continuousAt continuousAt_snd have hcont : ContinuousAt (fun z : ℝ × (Fin n → ℝ) => (z.1 - g z.2, z.2)) 0 := (continuousAt_fst.sub hgs).prodMk continuousAt_snd have ht : Tendsto (fun z : ℝ × (Fin n → ℝ) => (z.1 - g z.2, z.2)) (𝓝 0) (𝓝 (0, (0 : Fin n → ℝ))) := by simpa only [Prod.fst_zero, Prod.snd_zero, hg0, sub_self] using hcont.tendsto filter_upwards [ht.eventually hzero, ht.eventually hphase] with z hz hp have he : g z.2 + (z.1 - g z.2) = z.1 := by ring simpa only [he, sub_eq_zero, sub_pos, sub_neg] using And.intro hz hp /-- The pure positive odd initial term yields an actual analytic minimal graph and exact local descriptions of its zero set and both phases. -/ theorem exists_exact_minimal_graph_of_positive_odd_initial (F : MvPolynomial (Fin (n+1)) ℝ) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F = 0) (d : ℕ) (hd : Odd d) (c : ℝ) (hc : 0 < c) (hlow : ∀ j < d, homogeneousComponent j F = 0) (hpure : homogeneousComponent d F = C c * (X 0)^d) : ∃ g : (Fin n → ℝ) → ℝ, AnalyticAt ℝ g 0 ∧ g 0 = 0 ∧ gradient g 0 = 0 ∧ (∀ᶠ y in 𝓝 0, backgroundGraphOperator (gradient g y) (hessian g y) = 0) ∧ (∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, (eval (Fin.cons z.1 z.2) F = 0 ↔ z.1 = g z.2) ∧ (0 < eval (Fin.cons z.1 z.2) F ↔ g z.2 < z.1) ∧ (eval (Fin.cons z.1 z.2) F < 0 ↔ z.1 < g z.2)) := by obtain ⟨g, hg, hg0, hgrad, hD, hpen⟩ := Source29NormalHasseCentering.exists_flat_centering F d hd.pos c hc.ne' hlow hpure have hinitial := Source29PolynomialPureInitialShift.analytic_normal_shift_pure_initial_limit F d c hlow hpure hg hg0 hD have hlower := Source29CenteredNewtonObstruction.lower_coefficient_germs_zero F g hg hgrad hF d hd c hc.ne' hinitial hpen have htop : 0 < (shiftedSlice F (g 0) 0).coeff d := by rw [Source29NewtonInitialCenterCoefficient.center_coefficient_of_pure_initial F g d c hinitial] exact hc exact ⟨g, hg, hg0, hgrad, Source29BackgroundFromNormalMultiplicity.eventually_background_eq_zero F hF g 0 hg d hd.pos hlower htop.ne', eventually_exact_graph_of_centered_coefficients F g hg hg0 d hd hlower htop⟩ end end Source29FlatInitialExactGraph /- Component: RadialInitialSplitting.inc -/ namespace Source29RadialInitialSplitting open MvPolynomial open Source29PolynomialTranslation Source29QuarticReuse open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] /-- The Euler operator acts diagonally on the homogeneous decomposition. -/ lemma euler_eq_sum_homogeneous (P : MvPolynomial ι ℝ) : (∑ i, X i * pderiv i P) = ∑ k ∈ Finset.range (P.totalDegree+1), k • homogeneousComponent k P := by classical calc (∑ i, X i * pderiv i P) = ∑ i, ∑ k ∈ Finset.range (P.totalDegree+1), X i * pderiv i (homogeneousComponent k P) := by conv_lhs => rw [← sum_homogeneousComponent P] simp only [map_sum, Finset.mul_sum] _ = ∑ k ∈ Finset.range (P.totalDegree+1), ∑ i, X i * pderiv i (homogeneousComponent k P) := Finset.sum_comm _ = _ := by apply Finset.sum_congr rfl intro k _ exact QuarticCompatibility.sum_X_mul_pderiv (homogeneousComponent_isHomogeneous k P) lemma homogeneousComponent_euler_zero (P : MvPolynomial ι ℝ) (s : ℕ) (hzero : homogeneousComponent s P = 0) : homogeneousComponent s (∑ i, X i * pderiv i P) = 0 := by classical rw [euler_eq_sum_homogeneous, map_sum] apply Finset.sum_eq_zero intro k _ rw [map_nsmul] by_cases hsk : s = k · subst k rw [homogeneousComponent_eq_self (homogeneousComponent_isHomogeneous s P), hzero, nsmul_zero] · rw [homogeneousComponent_of_mem (homogeneousComponent_mem k P), ite_eq_right hsk, nsmul_zero] /-- The translated Euler identity separates the radial and centered directions. -/ theorem translated_euler (H : MvPolynomial ι ℝ) (d : ℕ) (hH : H.IsHomogeneous d) (a : ι → ℝ) : (∑ i, X i * pderiv i (translate H a)) + (∑ i, C (a i) * pderiv i (translate H a)) = d • translate H a := by classical have he := congrArg (fun P : MvPolynomial ι ℝ => translate P a) (QuarticCompatibility.sum_X_mul_pderiv hH) simpa only [translate_sum, translate_mul, translate_X, ← pderiv_translate, add_mul, Finset.sum_add_distrib, nsmul_eq_mul, translate_C, show (d : MvPolynomial ι ℝ) = C (d : ℝ) by simp] using he /-- If the preceding Taylor degree is absent, the next homogeneous term has zero derivative in the radial direction through the expansion point. -/ theorem radial_derivative_eq_zero (H : MvPolynomial ι ℝ) (d : ℕ) (hH : H.IsHomogeneous d) (a : ι → ℝ) (s : ℕ) (hprevious : homogeneousComponent s (translate H a) = 0) : (∑ i, C (a i) * pderiv i (homogeneousComponent (s+1) (translate H a))) = 0 := by classical have he := congrArg (homogeneousComponent s) (translated_euler H d hH a) rw [map_add, homogeneousComponent_euler_zero _ s hprevious, zero_add, map_sum, map_nsmul, hprevious, nsmul_zero] at he simpa only [homogeneousComponent_C_mul, ← QuarticPolynomialBasics.pderiv_homogeneousComponent] using he /-- A polynomial with a vanishing constant directional derivative is constant on every affine line in that direction. -/ theorem eval_add_smul_eq_of_directional_derivative_zero (P : MvPolynomial ι ℝ) (a : ι → ℝ) (hdir : (∑ i, C (a i) * pderiv i P) = 0) (y : ι → ℝ) (t : ℝ) : eval (fun i => y i + t*a i) P = eval y P := by classical let γ : ι → ℝ → ℝ := fun i s => y i + s*a i have hγ (s : ℝ) (i : ι) : AnalyticAt ℝ (γ i) s := analyticAt_const.add (analyticAt_id.mul analyticAt_const) have hf : Differentiable ℝ (fun s => eval (fun i => γ i s) P) := fun s => (Source29RealPolynomialCurveJets.analytic_eval_curve P γ s (hγ s)).differentiableAt have hd (s : ℝ) : deriv (fun r => eval (fun i => γ i r) P) s = 0 := by rw [Source29RealPolynomialCurveJets.first_deriv_eval_curve P γ s (hγ s)] have he := congrArg (eval (fun i => γ i s)) hdir simpa only [γ, Source29NewtonRootHarmonic.deriv_affine, map_sum, map_mul, eval_C, map_zero, mul_comm] using he have he := is_const_of_deriv_eq_zero hf hd t 0 simpa only [γ, zero_mul, add_zero] using he theorem translate_eq_of_directional_derivative_zero (P : MvPolynomial ι ℝ) (a : ι → ℝ) (hdir : (∑ i, C (a i) * pderiv i P) = 0) (t : ℝ) : translate P (fun i => t*a i) = P := by classical apply QuarticCompatibility.polynomial_funext intro y rw [eval_translate] simpa only [add_comm] using eval_add_smul_eq_of_directional_derivative_zero P a hdir y t /-- Every first nonzero Taylor form of a homogeneous polynomial is invariant under all translations along the radial direction of its base point. -/ theorem initial_translate_eq (H : MvPolynomial ι ℝ) (d : ℕ) (hH : H.IsHomogeneous d) (a : ι → ℝ) (s : ℕ) (hprevious : homogeneousComponent s (translate H a) = 0) (t : ℝ) : translate (homogeneousComponent (s+1) (translate H a)) (fun i => t*a i) = homogeneousComponent (s+1) (translate H a) := translate_eq_of_directional_derivative_zero _ a (radial_derivative_eq_zero H d hH a s hprevious) t /-- At a nonzero zero, there is a nonzero positive-degree initial polynomial with an actual nontrivial translation-invariance direction. -/ theorem exists_nonzero_radial_initial (H : MvPolynomial ι ℝ) (d : ℕ) (hH : H.IsHomogeneous d) (hne : H ≠ 0) (a : ι → ℝ) (ha : a ≠ 0) (hzero : eval a H = 0) : ∃ s : ℕ, 0 < s ∧ s ≤ (translate H a).totalDegree ∧ homogeneousComponent s (translate H a) ≠ 0 ∧ (homogeneousComponent s (translate H a)).IsHomogeneous s ∧ a ≠ 0 ∧ (∀ k < s, homogeneousComponent k (translate H a) = 0) ∧ (∀ t : ℝ, translate (homogeneousComponent s (translate H a)) (fun i => t*a i) = homogeneousComponent s (translate H a)) := by classical obtain ⟨s,hs,hdegree,hne',hlow⟩ := exists_lowest_component_at_root H hne a hzero refine ⟨s,hs,hdegree,hne',homogeneousComponent_isHomogeneous s _,ha,hlow,?_⟩ obtain ⟨j,rfl⟩ := Nat.exists_eq_succ_of_ne_zero hs.ne' intro t exact initial_translate_eq H d hH a j (hlow j (by omega)) t end end Source29RadialInitialSplitting /- Component: RadialCoordinateReduction.inc -/ namespace Source29RadialCoordinateReduction open MvPolynomial Matrix open Source29QuarticReuse.QuarticMinimal open Source29QuarticReuse.QuarticMinimal.DistinguishedVariable open Source29LinearNormalRotation Source29QuarticReuse.FluxObstruction open scoped BigOperators noncomputable section variable {n : ℕ} lemma finSuccEquiv_rename_succ (R : MvPolynomial (Fin n) ℝ) : finSuccEquiv ℝ n (rename Fin.succ R) = Polynomial.C R := by induction R using MvPolynomial.induction_on with | C c => simp only [rename_C, finSuccEquiv_apply, eval₂Hom_C, RingHom.comp_apply] | add P Q hP hQ => simp only [map_add, hP, hQ] | mul_X P i hP => simp only [map_mul, rename_X, finSuccEquiv_X_succ, hP] /-- A vanishing first partial derivative removes that coordinate algebraically. -/ theorem exists_rename_succ_of_pderiv_zero (P : MvPolynomial (Fin (n+1)) ℝ) (hP : pderiv 0 P = 0) : ∃ R : MvPolynomial (Fin n) ℝ, P = rename Fin.succ R := by have hd : (finSuccEquiv ℝ n P).derivative = 0 := by rw [← finSuccEquiv_pderiv_zero, hP, map_zero] refine ⟨(finSuccEquiv ℝ n P).coeff 0, ?_⟩ apply (finSuccEquiv ℝ n).injective rw [finSuccEquiv_rename_succ] exact Polynomial.eq_C_of_derivative_eq_zero hd lemma changeVariables_C_scalar (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (c : ℝ) : changeVariables U (C c) = C c := by simp [changeVariables] /-- A rotation whose first column is the radial unit vector kills the first partial of a polynomial constant in that radial direction. -/ theorem pderiv_zero_of_radial_column (P : MvPolynomial (Fin (n+1)) ℝ) (a : Fin (n+1) → ℝ) (hdir : (∑ i, C (a i) * pderiv i P) = 0) (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hcol : ∀ i, U i 0 = unitVector a i) : pderiv 0 (changeVariables U P) = 0 := by rw [pderiv_changeVariables] have he := congrArg (changeVariables U) hdir have hr : (∑ i, changeVariables U (pderiv i P) * C (U i 0)) = C ((Real.sqrt (radiusSq a))⁻¹) * changeVariables U (∑ i, C (a i) * pderiv i P) := by rw [map_sum, Finset.mul_sum] apply Finset.sum_congr rfl intro i _ rw [hcol, unitVector, div_eq_mul_inv, map_mul, map_mul, changeVariables_C_scalar] ring rw [hr, he, map_zero, mul_zero] /-- Adding an unused coordinate preserves the cubic level-set operator. -/ theorem leadingOperator_rename_succ (R : MvPolynomial (Fin n) ℝ) : leadingOperator (rename Fin.succ R) = rename Fin.succ (leadingOperator R) := by simp only [leadingOperator, laplacian, Fin.sum_univ_succ, Source29NewtonWeightedFace.pderiv_zero_rename_succ, pderiv_rename (Fin.succ_injective n), map_sub, map_mul, map_pow, map_sum, map_zero, zero_pow (by decide : 2 ≠ 0), zero_mul, mul_zero, zero_add, Finset.sum_const_zero] /-- A homogeneous polynomial with a nontrivial constant invariance direction is the orthogonal lift of a nonzero polynomial in one fewer variables. -/ theorem exists_orthogonal_reduction (P : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hne : P ≠ 0) (a : Fin (n+1) → ℝ) (ha : a ≠ 0) (hdir : (∑ i, C (a i) * pderiv i P) = 0) : ∃ (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (R : MvPolynomial (Fin n) ℝ), U.transpose * U = 1 ∧ U * U.transpose = 1 ∧ (∀ i, U i 0 = unitVector a i) ∧ changeVariables U P = rename Fin.succ R ∧ R ≠ 0 ∧ R.IsHomogeneous d ∧ (leadingOperator P = 0 → leadingOperator R = 0) ∧ (∀ x : Fin (n+1) → ℝ, eval (U *ᵥ x) P = eval (fun i => x i.succ) R) := by obtain ⟨U,hUt,hU,hcol⟩ := exists_rotation a ha obtain ⟨R,hR⟩ := exists_rename_succ_of_pderiv_zero (changeVariables U P) (pderiv_zero_of_radial_column P a hdir U hcol) have hRne : R ≠ 0 := by intro hz apply hne apply changeVariables_injective U hU simp only [hR, hz, map_zero] have hRhom : R.IsHomogeneous d := by have hh := isHomogeneous_changeVariables U P d hP rw [hR] at hh exact (IsHomogeneous.rename_isHomogeneous_iff (Fin.succ_injective n)).mp hh refine ⟨U,R,hUt,hU,hcol,hR,hRne,hRhom,?_,?_⟩ · intro hL have he := leadingOperator_changeVariables_eq_zero U hU P hL rw [hR, leadingOperator_rename_succ] at he apply rename_injective Fin.succ (Fin.succ_injective n) simpa only [map_zero] using he · intro x rw [← eval_changeVariables, hR, eval_rename] rfl /-- Radial invariance of the first Taylor form gives an actual reduction from n+1 coordinates to n coordinates. -/ theorem initial_orthogonal_reduction (H : MvPolynomial (Fin (n+1)) ℝ) (d : ℕ) (hH : H.IsHomogeneous d) (a : Fin (n+1) → ℝ) (ha : a ≠ 0) (s : ℕ) (hprevious : homogeneousComponent s (Source29PolynomialTranslation.translate H a) = 0) (hne : homogeneousComponent (s+1) (Source29PolynomialTranslation.translate H a) ≠ 0) : ∃ (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (R : MvPolynomial (Fin n) ℝ), U.transpose * U = 1 ∧ U * U.transpose = 1 ∧ changeVariables U (homogeneousComponent (s+1) (Source29PolynomialTranslation.translate H a)) = rename Fin.succ R ∧ R ≠ 0 ∧ R.IsHomogeneous (s+1) ∧ (leadingOperator (homogeneousComponent (s+1) (Source29PolynomialTranslation.translate H a)) = 0 → leadingOperator R = 0) := by obtain ⟨U,R,hUt,hU,_,hR,hRn,hRh,hL,_⟩ := exists_orthogonal_reduction (homogeneousComponent (s+1) (Source29PolynomialTranslation.translate H a)) (s+1) (homogeneousComponent_isHomogeneous _ _) hne a ha (Source29RadialInitialSplitting.radial_derivative_eq_zero H d hH a s hprevious) exact ⟨U,R,hUt,hU,hR,hRn,hRh,hL⟩ end end Source29RadialCoordinateReduction /- Component: InitialLeadingOperator.inc -/ namespace Source29InitialLeadingOperator open MvPolynomial Filter open Source29QuarticReuse.QuarticMinimal Source29QuarticReuse.QuarticPolynomialBasics open Source29QuarticReuse.FluxObstruction Source29QuarticReuse.FluxPolynomial open Source29RealLowestRescale Source29InitialGradientLimit open scoped Topology BigOperators noncomputable section variable {n : ℕ} def cubic (g : Fin n → ℝ) (h : Fin n → Fin n → ℝ) : ℝ := (∑ i, (g i)^2) * (∑ i, h i i) - ∑ i, ∑ j, g i*g j*h i j lemma cubic_scale (g : Fin n → ℝ) (h : Fin n → Fin n → ℝ) (a b : ℝ) : cubic (fun i => a*g i) (fun i j => b*h i j) = a^2*b*cubic g h := by have h1 : (∑ i, (a*g i)^2) = a^2*(∑ i, (g i)^2) := by simp only [mul_pow, Finset.mul_sum] have h2 : (∑ i, b*h i i) = b*(∑ i, h i i) := (Finset.mul_sum ..).symm have h3 : (∑ i, ∑ j, (a*g i)*(a*g j)*(b*h i j)) = a^2*b*(∑ i, ∑ j, g i*g j*h i j) := by simp only [Finset.mul_sum] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ ring unfold cubic rw [h1,h2,h3] ring lemma eval_leadingOperator (P : MvPolynomial (Fin n) ℝ) (x : Fin n → ℝ) : eval x (leadingOperator P) = cubic (fun i => eval x (pderiv i P)) (fun i j => eval x (pderiv i (pderiv j P))) := by simp only [leadingOperator, laplacian, cubic, map_sub, map_mul, map_sum, map_pow] lemma cubic_tendsto {β : Type*} {l : Filter β} {g : β → Fin n → ℝ} {h : β → Fin n → Fin n → ℝ} {g0 : Fin n → ℝ} {h0 : Fin n → Fin n → ℝ} (hg : ∀ i, Tendsto (fun t => g t i) l (𝓝 (g0 i))) (hh : ∀ i j, Tendsto (fun t => h t i j) l (𝓝 (h0 i j))) : Tendsto (fun t => cubic (g t) (h t)) l (𝓝 (cubic g0 h0)) := by exact ((tendsto_finsetSum _ (fun i _ => (hg i).pow 2)).mul (tendsto_finsetSum _ (fun i _ => hh i i))).sub (tendsto_finsetSum _ (fun i _ => tendsto_finsetSum _ (fun j _ => ((hg i).mul (hg j)).mul (hh i j)))) lemma second_pderiv_lowest_components (P : MvPolynomial (Fin n) ℝ) (s : ℕ) (hlow : ∀ k < s+2, homogeneousComponent k P = 0) (i j : Fin n) : ∀ k < s, homogeneousComponent k (pderiv i (pderiv j P)) = 0 := pderiv_lowest_components (pderiv j P) s (pderiv_lowest_components P (s+1) hlow j) i lemma rescaled_hessian_tendsto (P : MvPolynomial (Fin n) ℝ) (s : ℕ) (hlow : ∀ k < s+2, homogeneousComponent k P = 0) (x : Fin n → ℝ) (i j : Fin n) : Tendsto (fun t : ℝ => eval x (rescale (pderiv i (pderiv j P)) s t)) (𝓝 0) (𝓝 (eval x (pderiv i (pderiv j (homogeneousComponent (s+2) P))))) := by have hh := rescaled_gradient_tendsto (pderiv j P) s (pderiv_lowest_components P (s+1) hlow j) x i simpa only [evaluatedGradient, ← pderiv_homogeneousComponent] using hh /-- Exact scaling of the cubic equation in the rescaled first and second jets. -/ theorem scaled_leadingOperator (P : MvPolynomial (Fin n) ℝ) (s : ℕ) (hlow : ∀ k < s+2, homogeneousComponent k P = 0) (x : Fin n → ℝ) (t : ℝ) : eval (fun i => t*x i) (leadingOperator P) = (t^(s+1))^2*t^s * cubic (fun i => eval x (rescale (pderiv i P) (s+1) t)) (fun i j => eval x (rescale (pderiv i (pderiv j P)) s t)) := by have hg (i : Fin n) : eval (fun i => t*x i) (pderiv i P) = t^(s+1)*eval x (rescale (pderiv i P) (s+1) t) := (eval_rescale_mul (pderiv i P) (s+1) (pderiv_lowest_components P (s+1) hlow i) t x).symm have hh (i j : Fin n) : eval (fun i => t*x i) (pderiv i (pderiv j P)) = t^s*eval x (rescale (pderiv i (pderiv j P)) s t) := (eval_rescale_mul _ s (second_pderiv_lowest_components P s hlow i j) t x).symm rw [eval_leadingOperator] simp only [hg,hh] exact cubic_scale _ _ _ _ /-- The first possible homogeneous term of degree at least two inherits L=0. -/ theorem leadingOperator_initial_succ_succ (P : MvPolynomial (Fin n) ℝ) (hL : leadingOperator P = 0) (s : ℕ) (hlow : ∀ k < s+2, homogeneousComponent k P = 0) : leadingOperator (homogeneousComponent (s+2) P) = 0 := by apply Source29QuarticReuse.QuarticCompatibility.polynomial_funext intro x rw [map_zero, eval_leadingOperator] let t : ℕ → ℝ := fun k => (dilationRadius k)⁻¹ have ht (k : ℕ) : 0 < t k := inv_pos.mpr (dilationRadius_pos k) have ht0 : Tendsto t atTop (𝓝 0) := tendsto_inv_atTop_zero.comp dilationRadius_tendsto have hzero (k : ℕ) : cubic (fun i => eval x (rescale (pderiv i P) (s+1) (t k))) (fun i j => eval x (rescale (pderiv i (pderiv j P)) s (t k))) = 0 := by have he := scaled_leadingOperator P s hlow x (t k) rw [hL, map_zero] at he exact (mul_eq_zero.mp he.symm).resolve_left (mul_ne_zero (pow_ne_zero 2 (pow_ne_zero (s+1) (ht k).ne')) (pow_ne_zero s (ht k).ne')) have hlim := cubic_tendsto (fun i => (rescaled_gradient_tendsto P (s+1) hlow x i).comp ht0) (fun i j => (rescaled_hessian_tendsto P s hlow x i j).comp ht0) exact tendsto_nhds_unique hlim (by simpa only [Function.comp_def, hzero] using (tendsto_const_nhds : Tendsto (fun _ : ℕ => (0 : ℝ)) atTop (𝓝 0))) /-- Vanishing lower homogeneous components suffices; nonvanishing of the selected component is not required. This includes degrees zero and one. -/ theorem leadingOperator_initial (P : MvPolynomial (Fin n) ℝ) (hL : leadingOperator P = 0) (d : ℕ) (hlow : ∀ k < d, homogeneousComponent k P = 0) : leadingOperator (homogeneousComponent d P) = 0 := by by_cases hd : d ≤ 1 · have hdegree : (homogeneousComponent d P).totalDegree ≤ 1 := (homogeneousComponent_isHomogeneous d P).totalDegree_le.trans hd have hh := second_partials_zero_of_totalDegree_le_one _ hdegree simp only [leadingOperator, laplacian, hh, Finset.sum_const_zero, mul_zero, sub_zero] · obtain ⟨s,hs⟩ : ∃ s, d = s+2 := ⟨d-2, by omega⟩ subst d exact leadingOperator_initial_succ_succ P hL s hlow /-- The initial equation is available at every expansion center, before any regularity or nonvanishing-gradient conclusion. -/ theorem leadingOperator_initial_at (P : MvPolynomial (Fin n) ℝ) (hL : leadingOperator P = 0) (a : Fin n → ℝ) (d : ℕ) (hlow : ∀ k < d, homogeneousComponent k (Source29PolynomialTranslation.translate P a) = 0) : leadingOperator (homogeneousComponent d (Source29PolynomialTranslation.translate P a)) = 0 := by apply leadingOperator_initial _ ?_ d hlow rw [Source29AffinePolynomialTransport.leadingOperator_translate, hL, Source29PolynomialTranslation.translate_zero_polynomial] end end Source29InitialLeadingOperator /- Component: SynchronizedCurveFrankel.inc -/ namespace Source29SynchronizedCurveFrankel open Filter open Source29AnalyticNormDerivatives Source29RealAnalyticMaximum open scoped Topology BigOperators noncomputable section variable {κ ι : Type*} [Fintype κ] [Fintype ι] /-- Squared Euclidean distance in coordinates; this does not use the supremum norm instance on a finite function space. -/ def squaredDistance (x y : κ → ℝ) : ℝ := ∑ a, (x a-y a)^2 lemma squaredDistance_pos {x y : κ → ℝ} (hne : x ≠ y) : 0 < squaredDistance x y := by classical obtain ⟨a,ha⟩ : ∃ a, x a ≠ y a := Function.ne_iff.mp hne exact Finset.sum_pos' (fun a _ ↦ sq_nonneg _) ⟨a,Finset.mem_univ a, sq_pos_of_ne_zero (sub_ne_zero.mpr ha)⟩ lemma second_deriv_nonneg (f : ℝ → ℝ) (hf : AnalyticAt ℝ f 0) (hmin : IsLocalMin f 0) : 0 ≤ deriv (deriv f) 0 := by have hmax : IsLocalMax (fun t ↦ -f t) 0 := by filter_upwards [hmin] with t ht exact neg_le_neg ht have hn := second_deriv_nonpos (fun t ↦ -f t) hf.neg hmax have hd : deriv (deriv (fun t ↦ -f t)) 0 = -deriv (deriv f) 0 := by simpa only [zero_mul,one_mul,zero_sub] using second_deriv_linear_combination (fun _ : ℝ ↦ (0 : ℝ)) f analyticAt_const hf 0 1 rw [hd] at hn linarith /-- Equal first velocities cancel the velocity-square term in the second variation of the actual squared Euclidean distance. -/ theorem second_deriv_squaredDistance (u v : ℝ → κ → ℝ) (hu : ∀ a, AnalyticAt ℝ (fun t ↦ u t a) 0) (hv : ∀ a, AnalyticAt ℝ (fun t ↦ v t a) 0) (hvelocity : ∀ a, deriv (fun t ↦ u t a) 0 = deriv (fun t ↦ v t a) 0) : deriv (deriv (fun t ↦ squaredDistance (u t) (v t))) 0 = 2 * ∑ a, (u 0 a-v 0 a) * (deriv (deriv (fun t ↦ u t a)) 0-deriv (deriv (fun t ↦ v t a)) 0) := by unfold squaredDistance rw [second_deriv_sum (fun a t ↦ (u t a-v t a)^2) (fun a ↦ ((hu a).sub (hv a)).pow 2),Finset.mul_sum] apply Finset.sum_congr rfl intro a _ rw [second_deriv_square (fun t ↦ u t a-v t a) ((hu a).sub (hv a))] have hfirst : deriv (fun t ↦ u t a-v t a) 0 = 0 := by change deriv ((fun t ↦ u t a)-(fun t ↦ v t a)) 0 = 0 rw [deriv_sub (hu a).differentiableAt (hv a).differentiableAt,hvelocity,sub_self] have hsecond : deriv (deriv (fun t ↦ u t a-v t a)) 0 = deriv (deriv (fun t ↦ u t a)) 0-deriv (deriv (fun t ↦ v t a)) 0 := by simpa only [one_mul] using second_deriv_linear_combination (fun t ↦ u t a) (fun t ↦ v t a) (hu a) (hv a) 1 1 rw [hfirst,hsecond] ring /-- The mean acceleration identities of minimal spherical links make the sum of synchronized distance second variations strictly negative. -/ theorem sum_second_deriv_squaredDistance (u v : ι → ℝ → κ → ℝ) (x y : κ → ℝ) (m : ℝ) (hu : ∀ i a, AnalyticAt ℝ (fun t ↦ u i t a) 0) (hv : ∀ i a, AnalyticAt ℝ (fun t ↦ v i t a) 0) (hu0 : ∀ i, u i 0 = x) (hv0 : ∀ i, v i 0 = y) (hvelocity : ∀ i a, deriv (fun t ↦ u i t a) 0 = deriv (fun t ↦ v i t a) 0) (huacc : ∀ a, (∑ i, deriv (deriv (fun t ↦ u i t a)) 0) = -m*x a) (hvacc : ∀ a, (∑ i, deriv (deriv (fun t ↦ v i t a)) 0) = -m*y a) : (∑ i, deriv (deriv (fun t ↦ squaredDistance (u i t) (v i t))) 0) = -2*m*squaredDistance x y := by simp_rw [second_deriv_squaredDistance _ _ (hu _) (hv _) (hvelocity _),hu0,hv0] rw [← Finset.mul_sum,Finset.sum_comm] have hs : (∑ a, ∑ i, (x a-y a)* (deriv (deriv (fun t ↦ u i t a)) 0-deriv (deriv (fun t ↦ v i t a)) 0)) = ∑ a, -m*(x a-y a)^2 := by apply Finset.sum_congr rfl intro a _ rw [← Finset.mul_sum,Finset.sum_sub_distrib,huacc,hvacc] ring rw [hs,← Finset.mul_sum] unfold squaredDistance ring /-- The local spherical Frankel contradiction, expressed through actual analytic curves. Matching velocities and minimal-link mean accelerations exclude a distinct closest pair. -/ theorem eq_of_synchronized_local_minima (u v : ι → ℝ → κ → ℝ) (x y : κ → ℝ) (m : ℝ) (hm : 0 < m) (hu : ∀ i a, AnalyticAt ℝ (fun t ↦ u i t a) 0) (hv : ∀ i a, AnalyticAt ℝ (fun t ↦ v i t a) 0) (hu0 : ∀ i, u i 0 = x) (hv0 : ∀ i, v i 0 = y) (hvelocity : ∀ i a, deriv (fun t ↦ u i t a) 0 = deriv (fun t ↦ v i t a) 0) (huacc : ∀ a, (∑ i, deriv (deriv (fun t ↦ u i t a)) 0) = -m*x a) (hvacc : ∀ a, (∑ i, deriv (deriv (fun t ↦ v i t a)) 0) = -m*y a) (hmin : ∀ i, IsLocalMin (fun t ↦ squaredDistance (u i t) (v i t)) 0) : x = y := by by_contra hne have hnonneg : 0 ≤ ∑ i, deriv (deriv (fun t ↦ squaredDistance (u i t) (v i t))) 0 := by apply Finset.sum_nonneg intro i _ apply second_deriv_nonneg _ _ (hmin i) exact Finset.univ.analyticAt_fun_sum (f := fun a t ↦ (u i t a-v i t a)^2) (fun a _ ↦ ((hu i a).sub (hv i a)).pow 2) rw [sum_second_deriv_squaredDistance u v x y m hu hv hu0 hv0 hvelocity huacc hvacc] at hnonneg have hp := mul_pos hm (squaredDistance_pos hne) nlinarith /-- Set-level use at a closest pair: local curve membership supplies every required local minimum of squared Euclidean distance. -/ theorem eq_of_closest_pair (S T : Set (κ → ℝ)) (x y : κ → ℝ) (hclosest : ∀ z ∈ S, ∀ w ∈ T, squaredDistance x y ≤ squaredDistance z w) (u v : ι → ℝ → κ → ℝ) (m : ℝ) (hm : 0 < m) (hu : ∀ i a, AnalyticAt ℝ (fun t ↦ u i t a) 0) (hv : ∀ i a, AnalyticAt ℝ (fun t ↦ v i t a) 0) (hu0 : ∀ i, u i 0 = x) (hv0 : ∀ i, v i 0 = y) (hvelocity : ∀ i a, deriv (fun t ↦ u i t a) 0 = deriv (fun t ↦ v i t a) 0) (huacc : ∀ a, (∑ i, deriv (deriv (fun t ↦ u i t a)) 0) = -m*x a) (hvacc : ∀ a, (∑ i, deriv (deriv (fun t ↦ v i t a)) 0) = -m*y a) (huS : ∀ i, ∀ᶠ t in 𝓝 0, u i t ∈ S) (hvT : ∀ i, ∀ᶠ t in 𝓝 0, v i t ∈ T) : x = y := by apply eq_of_synchronized_local_minima u v x y m hm hu hv hu0 hv0 hvelocity huacc hvacc intro i change ∀ᶠ t in 𝓝 0, squaredDistance (u i 0) (v i 0) ≤ squaredDistance (u i t) (v i t) filter_upwards [huS i,hvT i] with t ht hs rw [hu0,hv0] exact hclosest _ ht _ hs end end Source29SynchronizedCurveFrankel /- Component: RegularLinkMeanAcceleration.inc -/ namespace Source29RegularLinkMeanAcceleration open Filter MvPolynomial Source29FactorInheritance Source29PolynomialLinkChart open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Pointwise minimality suffices for the tangential Hessian trace identity. -/ lemma tangential_trace_zero_at {κ : Type*} [Fintype κ] (P : MvPolynomial (Option κ) ℝ) (x : Option κ → ℝ) (g : ℝ) (hg : g ≠ 0) (hL : eval x (cubicOperator P) = 0) (hgn : eval x (pderiv none P) = g) (hgt : ∀ j, eval x (pderiv (some j) P) = 0) : (∑ j, eval x (pderiv (some j) (pderiv (some j) P))) = 0 := by have he := hL simp [cubicOperator,Fintype.sum_option,hgn,hgt] at he have hh : g^2 * (∑ j, eval x (pderiv (some j) (pderiv (some j) P))) = 0 := by nlinarith [he] exact (mul_eq_zero.mp hh).resolve_left (pow_ne_zero 2 hg) /-- The actual regular-link curves have the mean acceleration of a minimal sphere hypersurface. Pointwise vanishing of the cubic operator is sufficient. -/ theorem exists_regular_link_curves (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hd : 1 ≤ d) (hhom : P.IsHomogeneous d) (g : ℝ) (hg : g ≠ 0) (hP : eval base P = 0) (hgn : eval base (pderiv none P) = g) (hgt : ∀ j, eval base (pderiv (some j) P) = 0) (hL : eval base (cubicOperator P) = 0) : ∃ γ : ι → ℝ → Option (Option ι) → ℝ, (∀ i a, AnalyticAt ℝ (fun t ↦ γ i t a) 0) ∧ (∀ i, γ i 0 = base) ∧ (∀ i, ∀ᶠ t in 𝓝 0, eval (γ i t) P = 0) ∧ (∀ i, ∀ᶠ t in 𝓝 0, (∑ a, (γ i t a)^2) = 1) ∧ (∀ i a, deriv (fun t ↦ γ i t a) 0 = Pi.single (M := fun _ ↦ ℝ) (some (some i)) 1 a) ∧ (∀ a, (∑ i, deriv (deriv (fun t ↦ γ i t a)) 0) = -(Fintype.card ι : ℝ)*base a) := by have hrad : eval base (pderiv (some none) (pderiv (some none) P)) = 0 := by have hr := Source29HomogeneousRadialJets.radial_hessian P d hhom hd base (some none) simp only [base,Pi.single_apply,ite_mul,one_mul,zero_mul,Finset.sum_ite_eq', Finset.mem_univ,ite_true] at hr rw [show eval (Pi.single (some none) 1) (pderiv (some none) P) = 0 from hgt none] at hr simpa only [base,mul_zero] using hr have htrace : (∑ i : ι, eval base (pderiv (some (some i)) (pderiv (some (some i)) P))) = 0 := by have ht := tangential_trace_zero_at P base g hg hL hgn hgt simpa only [Fintype.sum_option,hrad,zero_add] using ht obtain ⟨γ,hγ,hγ0,hzero,hsphere,htangent⟩ := Source29PolynomialLinkCurves.exists_link_curves P g hg hP hgn hgt have hjets (i : ι) := Source29PolynomialLinkCurveJets.link_curve_jets P g hg hgn hgt (γ i) i (hγ i) (hγ0 i) (hzero i) (hsphere i) (htangent i) refine ⟨fun i t a ↦ γ i a t,hγ,fun i ↦ funext (hγ0 i),hzero,hsphere, fun i a ↦ (hjets i).1 a,fun a ↦ ?_⟩ simp_rw [(hjets _).2] rw [Finset.sum_sub_distrib] simp only [Finset.sum_neg_distrib,Finset.sum_const,nsmul_eq_mul, ← Finset.sum_mul,← Finset.sum_div,htrace,zero_div,zero_mul,sub_zero] simp only [Finset.card_univ,base,neg_mul] end end Source29RegularLinkMeanAcceleration /- Component: AntipodalLinkExclusion.inc -/ namespace Source29AntipodalLinkExclusion open Filter Source29SynchronizedCurveFrankel open scoped Topology BigOperators noncomputable section variable {κ : Type*} [Fintype κ] theorem squaredDistance_add_antipode (x y : κ → ℝ) : squaredDistance y x + squaredDistance y (-x) = 2 * (∑ a, (y a)^2) + 2 * (∑ a, (x a)^2) := by simp only [squaredDistance, Pi.neg_apply, ← Finset.sum_add_distrib, Finset.mul_sum] apply Finset.sum_congr rfl intro a _ ring /-- A curve with nonzero velocity on the unit sphere cannot have a closest point at the antipode of its initial point. -/ theorem not_local_min_at_antipode (C : ℝ → κ → ℝ) (x : κ → ℝ) (hC : C 0 = x) (hx : ∑ a, (x a)^2 = 1) (hunit : ∀ᶠ t in 𝓝 0, ∑ a, (C t a)^2 = 1) (hvelocity : ∃ a, deriv (fun t => C t a) 0 ≠ 0) : ¬ IsLocalMin (fun t => squaredDistance (C t) (-x)) 0 := by intro hmin have hxx : squaredDistance x x = 0 := by simp [squaredDistance] have hanti : squaredDistance x (-x) = 4 := by have h := squaredDistance_add_antipode x x rw [hxx, hx] at h linarith have heq : C =ᶠ[𝓝 0] (fun _ => x) := by filter_upwards [hunit, hmin] with t ht hm rw [hC, hanti] at hm have h := squaredDistance_add_antipode x (C t) rw [ht, hx] at h by_contra hn have hp := squaredDistance_pos hn linarith obtain ⟨a, ha⟩ := hvelocity have heqa : (fun t => C t a) =ᶠ[𝓝 0] (fun _ => x a) := heq.fun_comp (fun y => y a) apply ha rw [heqa.deriv_eq, deriv_const] /-- In a closest pair of spherical subsets, a nonconstant local curve in the first subset rules out the antipodal case. -/ theorem closest_pair_not_antipodal (S T : Set (κ → ℝ)) (x y : κ → ℝ) (hy : y ∈ T) (hclosest : ∀ z ∈ S, ∀ w ∈ T, squaredDistance x y ≤ squaredDistance z w) (C : ℝ → κ → ℝ) (hC : C 0 = x) (hx : ∑ a, (x a)^2 = 1) (hunit : ∀ᶠ t in 𝓝 0, ∑ a, (C t a)^2 = 1) (hmem : ∀ᶠ t in 𝓝 0, C t ∈ S) (hvelocity : ∃ a, deriv (fun t => C t a) 0 ≠ 0) : y ≠ -x := by intro hanti apply not_local_min_at_antipode C x hC hx hunit hvelocity change ∀ᶠ t in 𝓝 0, squaredDistance (C 0) (-x) ≤ squaredDistance (C t) (-x) filter_upwards [hmem] with t ht simpa only [hC,hanti] using hclosest (C t) ht y hy end end Source29AntipodalLinkExclusion /- Component: CalibrationCoordinateDescent.inc -/ namespace Source29CalibrationCoordinateDescent open MvPolynomial MeasureTheory open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29NormalShiftDerivatives Source29CoordinateProductIntegral open scoped BigOperators noncomputable section variable {n : ℕ} lemma tail_cons (t : ℝ) (y : Fin n → ℝ) : tail (Fin.cons t y) = y := by ext i rfl def liftedField (Z : (Fin n → ℝ) → Fin n → ℝ) (x : Fin (n+1) → ℝ) : Fin (n+1) → ℝ := Fin.cons 0 (Z (tail x)) def productTest (ρ : ℝ → ℝ) (ψ : (Fin n → ℝ) → ℝ) (x : Fin (n+1) → ℝ) : ℝ := ρ (x 0) * ψ (tail x) lemma productTest_contDiff {ρ : ℝ → ℝ} {ψ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hψ : ContDiff ℝ 1 ψ) : ContDiff ℝ 1 (productTest ρ ψ) := by let L : (Fin (n+1) → ℝ) →L[ℝ] ℝ := ContinuousLinearMap.proj 0 change ContDiff ℝ 1 (fun x ↦ ρ (L x) * ψ (tail x)) simpa only [Function.comp_def] using (hρ.comp L.contDiff).mul (hψ.comp tail.contDiff) lemma productTest_compact {ρ : ℝ → ℝ} {ψ : (Fin n → ℝ) → ℝ} (hcρ : HasCompactSupport ρ) (hcψ : HasCompactSupport ψ) : HasCompactSupport (productTest ρ ψ) := by have hc : Continuous (fun p : ℝ × (Fin n → ℝ) ↦ (Fin.cons p.1 p.2 : Fin (n+1) → ℝ)) := by apply continuous_pi intro i exact Fin.cases continuous_fst (fun j ↦ (continuous_apply j).comp continuous_snd) i apply HasCompactSupport.of_support_subset_isCompact ((hcρ.prod hcψ).image hc) intro x hx have hne : ρ (x 0) ≠ 0 ∧ ψ (tail x) ≠ 0 := mul_ne_zero_iff.mp hx refine ⟨(x 0,tail x),⟨subset_tsupport _ hne.1,subset_tsupport _ hne.2⟩,?_⟩ exact Fin.cons_self_tail x /-- The product test has no contribution from the missing field coordinate. -/ lemma productTest_flux {ρ : ℝ → ℝ} {ψ : (Fin n → ℝ) → ℝ} (hρ : ContDiff ℝ 1 ρ) (hψ : ContDiff ℝ 1 ψ) (Z : (Fin n → ℝ) → Fin n → ℝ) (x : Fin (n+1) → ℝ) : testFlux (fun i ↦ Pi.single i 1) (productTest ρ ψ) (liftedField Z) x = ρ (x 0) * testFlux (fun i ↦ Pi.single i 1) ψ Z (tail x) := by let L : (Fin (n+1) → ℝ) →L[ℝ] ℝ := ContinuousLinearMap.proj 0 have hr := ((hρ.differentiable (by norm_num) (x 0)).hasDerivAt).comp_hasFDerivAt x L.hasFDerivAt have hs := ((hψ.differentiable (by norm_num) (tail x)).hasFDerivAt).comp x tail.hasFDerivAt have hp := hr.fun_mul hs rw [Source29OrthogonalCalibration.testFlux_eq_fderiv, Source29OrthogonalCalibration.testFlux_eq_fderiv] change fderiv ℝ (fun z ↦ ρ (L z) * ψ (tail z)) x (liftedField Z x) = _ have hpf := hp.fderiv change fderiv ℝ (fun z ↦ ρ (L z) * ψ (tail z)) x = _ at hpf rw [hpf] simp only [_root_.add_apply,_root_.smul_apply,smul_eq_mul,Function.comp_def, ContinuousLinearMap.comp_apply,liftedField,tail_cons,L, ContinuousLinearMap.proj_apply,Fin.cons_zero,mul_zero,add_zero] /-- Calibration descends from a product field. Fubini also supplies the integrability of every lower-dimensional test flux, with no extra measurability assumption. -/ theorem weakCalibration_of_liftedField (Z : (Fin n → ℝ) → Fin n → ℝ) (hZ : WeakCalibration (liftedField Z)) : WeakCalibration Z := by refine ⟨?_,?_⟩ · intro x i simpa only [liftedField,tail_cons,Fin.cons_succ] using hZ.1 (Fin.cons 0 x) i.succ · intro ψ hψ hcψ let b : ContDiffBump (0 : ℝ) := { rIn := 1, rOut := 2, rIn_pos := by norm_num, rIn_lt_rOut := by norm_num } let ρ : ℝ → ℝ := b have hρ : ContDiff ℝ 1 ρ := b.contDiff have hcρ : HasCompactSupport ρ := b.hasCompactSupport have hρint : (∫ t, ρ t) ≠ 0 := ne_of_gt (b.continuous.integral_pos_of_hasCompactSupport_nonneg_nonzero b.hasCompactSupport b.nonneg' (show b 0 ≠ 0 from (b.pos_of_mem_ball (by simpa only [Metric.mem_ball,dist_self] using b.rOut_pos)).ne')) have hbase := hZ.2 (productTest ρ ψ) (productTest_contDiff hρ hψ) (productTest_compact hcρ hcψ) have he (t : ℝ) (y : Fin n → ℝ) : testFlux (fun i ↦ Pi.single i 1) (productTest ρ ψ) (liftedField Z) (Fin.cons t y) = ρ t * testFlux (fun i ↦ Pi.single i 1) ψ Z y := by simpa only [tail_cons,Fin.cons_zero] using productTest_flux hρ hψ Z (Fin.cons t y) have hi := (cons_integrable hbase.1).integral_prod_right have hz := hbase.2 rw [integral_cons hbase.1] at hz simp_rw [he,integral_mul_const] at hi hz have hi' := hi.const_mul (∫ t, ρ t)⁻¹ have hflux : Integrable (testFlux (fun i ↦ Pi.single i 1) ψ Z) := by simpa only [← mul_assoc,inv_mul_cancel₀ hρint,one_mul] using hi' rw [integral_const_mul] at hz exact ⟨hflux,(mul_eq_zero.mp hz).resolve_left hρint⟩ lemma normalizedField_rename_succ (R : MvPolynomial (Fin n) ℝ) : leadingNormalizedField (rename Fin.succ R) = liftedField (leadingNormalizedField R) := by funext x have hg : evaluatedGradient (rename Fin.succ R) x = Fin.cons 0 (evaluatedGradient R (tail x)) := by funext i refine Fin.cases ?_ (fun j ↦ ?_) i · simp only [evaluatedGradient,Source29NewtonWeightedFace.pderiv_zero_rename_succ, map_zero,Fin.cons_zero] · simp only [evaluatedGradient,pderiv_rename (Fin.succ_injective n),eval_rename,Fin.cons_succ] rfl funext i have hd : radiusSq (evaluatedGradient (rename Fin.succ R) x) = radiusSq (evaluatedGradient R (tail x)) := by rw [hg] simp only [radiusSq,Fin.sum_univ_succ,Fin.cons_zero,Fin.cons_succ, zero_pow (by decide : 2 ≠ 0),zero_add] refine Fin.cases ?_ (fun j ↦ ?_) i · simp only [leadingNormalizedField,hg,liftedField,Fin.cons_zero,zero_div] · simp only [leadingNormalizedField,liftedField,Fin.cons_succ] rw [hd,hg] rfl /-- A polynomial independent of the first coordinate passes its normalized weak calibration to the polynomial in the remaining coordinates. -/ theorem weakCalibration_rename_succ (R : MvPolynomial (Fin n) ℝ) (hcal : WeakCalibration (leadingNormalizedField (rename Fin.succ R))) : WeakCalibration (leadingNormalizedField R) := by rw [normalizedField_rename_succ] at hcal exact weakCalibration_of_liftedField _ hcal end end Source29CalibrationCoordinateDescent /- Component: PositiveCofactorRoot.inc -/ namespace Source29PositiveCofactorRoot open MvPolynomial Filter open Source29NormalShiftDerivatives Source29AnalyticTensorNorm open scoped Topology noncomputable section /-- The positive real kth root is analytic on the positive axis. -/ theorem positive_root_analyticAt (k : ℕ) (hk : 0 < k) {a : ℝ} (ha : 0 < a) : AnalyticAt ℝ (fun t : ℝ => t ^ ((k : ℝ)⁻¹)) a := by let b := a ^ ((k : ℝ)⁻¹) have hb : 0 < b := Real.rpow_pos_of_pos ha _ have hbpow : b ^ k = a := Real.rpow_inv_natCast_pow ha.le hk.ne' have hpow : AnalyticAt ℝ (fun t : ℝ => t^k) b := analyticAt_id.pow k have hd : deriv (fun t : ℝ => t^k) b ≠ 0 := by have he : deriv (fun t : ℝ => t^k) b = (k:ℝ) * b^(k-1) := by simp rw [he] exact mul_ne_zero (Nat.cast_ne_zero.mpr hk.ne') (pow_ne_zero _ hb.ne') have heq : (id : ℝ → ℝ) =ᶠ[𝓝 b] ((fun t : ℝ => t ^ ((k : ℝ)⁻¹)) ∘ fun t : ℝ => t^k) := by filter_upwards [eventually_gt_nhds hb] with t ht exact (Real.pow_rpow_inv_natCast ht.le hk.ne').symm have han := (Source29RealAnalyticSqrt.analytic_comp_iff hpow hd).mp (analyticAt_id.congr heq) rwa [hbpow] at han variable {n : ℕ} def rootUnit (Q : MvPolynomial (Fin n) ℝ) (k : ℕ) (x : Fin n → ℝ) : ℝ := (eval x Q) ^ ((k : ℝ)⁻¹) def definingRoot (P Q : MvPolynomial (Fin n) ℝ) (k : ℕ) (x : Fin n → ℝ) : ℝ := eval x P * rootUnit Q k x theorem rootUnit_pos (Q : MvPolynomial (Fin n) ℝ) (k : ℕ) (x : Fin n → ℝ) (hQ : 0 < eval x Q) : 0 < rootUnit Q k x := Real.rpow_pos_of_pos hQ _ theorem rootUnit_analyticAt (Q : MvPolynomial (Fin n) ℝ) (k : ℕ) (hk : 0 < k) (x : Fin n → ℝ) (hQ : 0 < eval x Q) : AnalyticAt ℝ (rootUnit Q k) x := AnalyticAt.comp (f := fun y => eval y Q) (positive_root_analyticAt k hk hQ) (Source29PolynomialLinkChart.analyticAt_eval_real Q x) theorem definingRoot_analyticAt (P Q : MvPolynomial (Fin n) ℝ) (k : ℕ) (hk : 0 < k) (x : Fin n → ℝ) (hQ : 0 < eval x Q) : AnalyticAt ℝ (definingRoot P Q k) x := (Source29PolynomialLinkChart.analyticAt_eval_real P x).mul (rootUnit_analyticAt Q k hk x hQ) theorem definingRoot_pow (P Q : MvPolynomial (Fin n) ℝ) (k : ℕ) (hk : 0 < k) (x : Fin n → ℝ) (hQ : 0 < eval x Q) : definingRoot P Q k x ^ k = eval x (P^k * Q) := by simp only [definingRoot, rootUnit, mul_pow, map_mul, map_pow, Real.rpow_inv_natCast_pow hQ.le hk.ne'] theorem eventually_definingRoot_pow (P Q : MvPolynomial (Fin n) ℝ) (k : ℕ) (hk : 0 < k) (x : Fin n → ℝ) (hQ : 0 < eval x Q) : ∀ᶠ y in 𝓝 x, definingRoot P Q k y ^ k = eval y (P^k * Q) := by filter_upwards [(Source29PolynomialLinkChart.analyticAt_eval_real Q x).continuousAt.eventually (lt_mem_nhds hQ)] with y hy exact definingRoot_pow P Q k hk y hy /-- On the regular zero hypersurface the new gradient is the old gradient multiplied by the positive kth root of the cofactor. -/ theorem definingRoot_gradient (P Q : MvPolynomial (Fin n) ℝ) (k : ℕ) (hk : 0 < k) (x : Fin n → ℝ) (hP : eval x P = 0) (hQ : 0 < eval x Q) : gradient (definingRoot P Q k) x = fun i => rootUnit Q k x * eval x (pderiv i P) := by funext i unfold Source29NormalShiftDerivatives.gradient definingRoot rw [fderiv_fun_mul (Source29PolynomialLinkChart.analyticAt_eval_real P x).differentiableAt (rootUnit_analyticAt Q k hk x hQ).differentiableAt] simp only [hP, zero_smul, zero_add, _root_.smul_apply, smul_eq_mul] change rootUnit Q k x * gradient (fun y => eval y P) x i = _ rw [gradient_eval] theorem definingRoot_gradient_ne_zero (P Q : MvPolynomial (Fin n) ℝ) (k : ℕ) (hk : 0 < k) (x : Fin n → ℝ) (hP : eval x P = 0) (hQ : 0 < eval x Q) (hreg : (fun i => eval x (pderiv i P)) ≠ 0) : gradient (definingRoot P Q k) x ≠ 0 := by rw [definingRoot_gradient P Q k hk x hP hQ] intro hz apply hreg funext i have hi := congrFun hz i exact (mul_eq_zero.mp hi).resolve_left (rootUnit_pos Q k x hQ).ne' /-- This positive inverse-gradient profile is the candidate for the Jacobi identity; this lemma establishes its regularity and positivity only. -/ theorem inverse_gradient_profile_analytic_positive (P Q : MvPolynomial (Fin n) ℝ) (k : ℕ) (hk : 0 < k) (x : Fin n → ℝ) (hP : eval x P = 0) (hQ : 0 < eval x Q) (hreg : (fun i => eval x (pderiv i P)) ≠ 0) : AnalyticAt ℝ (fun y => (tensorNorm (gradient (definingRoot P Q k) y))⁻¹) x ∧ 0 < (tensorNorm (gradient (definingRoot P Q k) x))⁻¹ := by have hg := definingRoot_analyticAt P Q k hk x hQ have hn := definingRoot_gradient_ne_zero P Q k hk x hP hQ hreg have ha : ∀ i, AnalyticAt ℝ (fun y => gradient (definingRoot P Q k) y i) x := by intro i exact Source29NewtonRootHarmonic.analyticAt_directional _ x _ hg have hnorm := tensorNorm_analyticAt (gradient (definingRoot P Q k)) x ha hn exact ⟨hnorm.inv (tensorNorm_pos hn).ne', inv_pos.mpr (tensorNorm_pos hn)⟩ lemma tensorNorm_scale_pos {ι : Type*} [Fintype ι] (v : ι → ℝ) (b : ℝ) (hb : 0 < b) : tensorNorm (fun i => b * v i) = b * tensorNorm v := by simp only [tensorNorm, mul_pow, ← Finset.mul_sum, Real.sqrt_mul (sq_nonneg b), Real.sqrt_sq hb.le] /-- The inverse gradient norm agrees with the inverse kth root of the leading coefficient measured in the positive unit-normal direction. -/ theorem inverse_gradient_profile_eq (P Q : MvPolynomial (Fin n) ℝ) (k : ℕ) (hk : 0 < k) (x : Fin n → ℝ) (hP : eval x P = 0) (hQ : 0 < eval x Q) (hreg : (fun i => eval x (pderiv i P)) ≠ 0) : (tensorNorm (gradient (definingRoot P Q k) x))⁻¹ = (tensorNorm (fun i => eval x (pderiv i P)) ^ k * eval x Q) ^ (-((k : ℝ)⁻¹)) := by have hn := tensorNorm_pos hreg rw [definingRoot_gradient P Q k hk x hP hQ, tensorNorm_scale_pos _ _ (rootUnit_pos Q k x hQ), Real.rpow_neg (mul_nonneg (pow_nonneg hn.le k) hQ.le), Real.mul_rpow (pow_nonneg hn.le k) hQ.le, Real.pow_rpow_inv_natCast hn.le hk.ne'] unfold rootUnit rw [mul_comm] end end Source29PositiveCofactorRoot /- Component: AnalyticScalarLevelOperator.inc -/ namespace Source29AnalyticScalarLevelOperator open Filter Source29NormalShiftDerivatives Source29NormalShiftAlgebra open scoped Topology BigOperators noncomputable section section ChainRules variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] lemma first_comp (φ : ℝ → ℝ) (f : E → ℝ) (x v : E) (hφ : AnalyticAt ℝ φ (f x)) (hf : AnalyticAt ℝ f x) : fderiv ℝ (fun y => φ (f y)) x v = deriv φ (f x) * fderiv ℝ f x v := by have hd := hφ.differentiableAt.hasDerivAt.comp_hasFDerivAt x hf.differentiableAt.hasFDerivAt simpa only [Function.comp_def, _root_.smul_apply, smul_eq_mul] using congrArg (fun D : E →L[ℝ] ℝ => D v) hd.fderiv lemma second_comp (φ : ℝ → ℝ) (f : E → ℝ) (x u v : E) (hφ : AnalyticAt ℝ φ (f x)) (hf : AnalyticAt ℝ f x) : second (fun y => φ (f y)) x u v = deriv φ (f x) * second f x u v + deriv (deriv φ) (f x) * (fderiv ℝ f x u * fderiv ℝ f x v) := by have he : (fun y => fderiv ℝ (fun z => φ (f z)) y v) =ᶠ[𝓝 x] (fun y => deriv φ (f y) * fderiv ℝ f y v) := by filter_upwards [hf.eventually_analyticAt, hf.continuousAt.tendsto.eventually hφ.eventually_analyticAt] with y hy hpy exact first_comp φ f y v hpy hy have ha : AnalyticAt ℝ (fun y => deriv φ (f y)) x := AnalyticAt.comp (f := f) hφ.deriv hf have hb := Source29NewtonRootHarmonic.analyticAt_directional f x v hf unfold second rw [he.fderiv_eq, fderiv_fun_mul ha.differentiableAt hb.differentiableAt] simp only [_root_.add_apply, _root_.smul_apply, smul_eq_mul] rw [first_comp (deriv φ) f x u hφ.deriv hf] ring end ChainRules lemma cubicLevel_rank_one {ι : Type*} [Fintype ι] (g : ι → ℝ) (H : ι → ι → ℝ) (a b : ℝ) : cubicLevel (fun i => a * g i) (fun i j => a * H i j + b * (g i * g j)) = a^3 * cubicLevel g H := by simp only [cubicLevel, dot_mul_left, dot_mul_right, trace_add, trace_mul, trace_rank_one, bilinear_add_matrix, bilinear_mul_matrix, bilinear_mul_left, bilinear_mul_right, bilinear_rank_one] ring variable {n : ℕ} def levelOperator (f : (Fin n → ℝ) → ℝ) (x : Fin n → ℝ) : ℝ := cubicLevel (gradient f x) (hessian f x) /-- Reparametrizing the values of an analytic defining function multiplies its cubic level-set operator by the cube of the scalar derivative. -/ theorem levelOperator_comp (φ : ℝ → ℝ) (f : (Fin n → ℝ) → ℝ) (x : Fin n → ℝ) (hφ : AnalyticAt ℝ φ (f x)) (hf : AnalyticAt ℝ f x) : levelOperator (fun y => φ (f y)) x = (deriv φ (f x))^3 * levelOperator f x := by unfold levelOperator have hg : gradient (fun y => φ (f y)) x = fun i => deriv φ (f x) * gradient f x i := by funext i exact first_comp φ f x _ hφ hf have hh : hessian (fun y => φ (f y)) x = fun i j => deriv φ (f x) * hessian f x i j + deriv (deriv φ) (f x) * (gradient f x i * gradient f x j) := by funext i j exact second_comp φ f x _ _ hφ hf rw [hg, hh, cubicLevel_rank_one] theorem levelOperator_pow (f : (Fin n → ℝ) → ℝ) (x : Fin n → ℝ) (hf : AnalyticAt ℝ f x) (k : ℕ) : levelOperator (fun y => f y ^ k) x = ((k:ℝ) * f x^(k-1))^3 * levelOperator f x := by have hd : deriv (fun t : ℝ => t^k) (f x) = (k:ℝ) * f x^(k-1) := by simp rw [levelOperator_comp (fun t : ℝ => t^k) f x (analyticAt_id.pow k) hf, hd] theorem levelOperator_analyticAt (f : (Fin n → ℝ) → ℝ) (x : Fin n → ℝ) (hf : AnalyticAt ℝ f x) : AnalyticAt ℝ (levelOperator f) x := by have hg : ∀ i, AnalyticAt ℝ (fun y => gradient f y i) x := fun i => Source29NewtonRootHarmonic.analyticAt_directional f x _ hf have hH : ∀ i j, AnalyticAt ℝ (fun y => hessian f y i j) x := by intro i j exact Source29NewtonRootHarmonic.analyticAt_directional _ x _ (hg j) unfold levelOperator cubicLevel dot trace bilinear exact ((Finset.analyticAt_fun_sum _ (fun i _ => (hg i).mul (hg i))).mul (Finset.analyticAt_fun_sum _ (fun i _ => hH i i))).sub (Finset.analyticAt_fun_sum _ (fun i _ => Finset.analyticAt_fun_sum _ (fun j _ => ((hH i j).mul (hg i)).mul (hg j)))) theorem levelOperator_congr {f g : (Fin n → ℝ) → ℝ} {x : Fin n → ℝ} (he : f =ᶠ[𝓝 x] g) : levelOperator f x = levelOperator g x := by have hg : gradient f x = gradient g x := by unfold Source29NormalShiftDerivatives.gradient rw [he.fderiv_eq] have hH : hessian f x = hessian g x := by funext i j unfold hessian second have hfirst : (fun y => fderiv ℝ f y (basis j)) =ᶠ[𝓝 x] (fun y => fderiv ℝ g y (basis j)) := (he.fderiv (𝕜 := ℝ)).mono (fun y hy => congrArg (fun D : (Fin n → ℝ) →L[ℝ] ℝ => D (basis j)) hy) rw [hfirst.fderiv_eq] unfold levelOperator rw [hg, hH] end end Source29AnalyticScalarLevelOperator /- Component: AnalyticPowerInheritance.inc -/ namespace Source29AnalyticPowerInheritance open MvPolynomial Filter open Source29NormalShiftDerivatives Source29AnalyticScalarLevelOperator open scoped Topology noncomputable section variable {n : ℕ} /-- A noncritical analytic defining function inherits the cubic equation from any positive integral power, as an identity on a full neighborhood. -/ theorem levelOperator_zero_of_power (f : (Fin n → ℝ) → ℝ) (x : Fin n → ℝ) (hf : AnalyticAt ℝ f x) (hreg : gradient f x ≠ 0) (k : ℕ) (hk : 0 < k) (hpow : ∀ᶠ y in 𝓝 x, levelOperator (fun z => f z ^ k) y = 0) : ∀ᶠ y in 𝓝 x, levelOperator f y = 0 := by let A : (Fin n → ℝ) → ℝ := fun y => ((k:ℝ) * f y^(k-1))^3 have hA : AnalyticAt ℝ A x := (analyticAt_const.mul (hf.pow (k-1))).pow 3 have hprod : ∀ᶠ y in 𝓝 x, A y * levelOperator f y = 0 := by filter_upwards [hpow, hf.eventually_analyticAt] with y hy hay rwa [levelOperator_pow f y hay k] at hy rcases Source29AnalyticGraphFactor.zero_germ_of_mul_zero A (levelOperator f) x hA (levelOperator_analyticAt f x hf) hprod with hzero | hzero · have hflat : f =ᶠ[𝓝 x] (fun _ => 0) := by filter_upwards [hzero] with y hy have hm : (k:ℝ) * f y^(k-1) = 0 := eq_zero_of_pow_eq_zero hy exact eq_zero_of_pow_eq_zero ((mul_eq_zero.mp hm).resolve_left (Nat.cast_ne_zero.mpr hk.ne')) apply (hreg ?_).elim unfold Source29NormalShiftDerivatives.gradient rw [hflat.fderiv_eq] funext i simp · exact hzero /-- The actual analytic kth root of p^k Q satisfies the cubic equation near each regular zero of p where Q is positive. -/ theorem definingRoot_levelOperator_zero (P Q : MvPolynomial (Fin n) ℝ) (k : ℕ) (hk : 0 < k) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator (P^k * Q) = 0) (x : Fin n → ℝ) (hP : eval x P = 0) (hQ : 0 < eval x Q) (hreg : (fun i => eval x (pderiv i P)) ≠ 0) : ∀ᶠ y in 𝓝 x, levelOperator (Source29PositiveCofactorRoot.definingRoot P Q k) y = 0 := by let G := Source29PositiveCofactorRoot.definingRoot P Q k have he : (fun y => G y ^ k) =ᶠ[𝓝 x] (fun y => eval y (P^k * Q)) := Source29PositiveCofactorRoot.eventually_definingRoot_pow P Q k hk x hQ apply levelOperator_zero_of_power G x (Source29PositiveCofactorRoot.definingRoot_analyticAt P Q k hk x hQ) (Source29PositiveCofactorRoot.definingRoot_gradient_ne_zero P Q k hk x hP hQ hreg) k hk filter_upwards [he.eventuallyEq_nhds] with y hy rw [levelOperator_congr hy] change Source29NormalShiftAlgebra.cubicLevel _ _ = 0 rw [cubicLevel_eval, hF, map_zero] end end Source29AnalyticPowerInheritance /- Component: PositiveRootHomogeneity.inc -/ namespace Source29PositiveRootHomogeneity open MvPolynomial open Source29PositiveCofactorRoot noncomputable section variable {n : ℕ} /-- Positive dilation preserves the region where the cofactor is positive. -/ theorem eval_smul_pos (Q : MvPolynomial (Fin n) ℝ) (q : ℕ) (hQ : Q.IsHomogeneous q) (x : Fin n → ℝ) (hx : 0 < eval x Q) (t : ℝ) (ht : 0 < t) : 0 < eval (t • x) Q := by rw [show t • x = fun i => t * x i from rfl, Source29QuarticReuse.QuarticNormalization.eval_scale_of_isHomogeneous Q q hQ x t] exact mul_pos (pow_pos ht q) hx /-- The analytic positive defining root has a real, possibly nonintegral, homogeneous degree. -/ theorem definingRoot_smul (P Q : MvPolynomial (Fin n) ℝ) (p q k : ℕ) (hP : P.IsHomogeneous p) (hQ : Q.IsHomogeneous q) (x : Fin n → ℝ) (hx : 0 < eval x Q) (t : ℝ) (ht : 0 < t) : definingRoot P Q k (t • x) = t ^ ((p : ℝ) + (q : ℝ) / (k : ℝ)) * definingRoot P Q k x := by simp only [definingRoot, rootUnit] rw [show t • x = fun i => t * x i from rfl, Source29QuarticReuse.QuarticNormalization.eval_scale_of_isHomogeneous P p hP x t, Source29QuarticReuse.QuarticNormalization.eval_scale_of_isHomogeneous Q q hQ x t, Real.mul_rpow (pow_nonneg ht.le q) hx.le, Real.rpow_add ht, Real.rpow_natCast, div_eq_mul_inv, Real.rpow_natCast_mul ht.le] ring /-- The degree of the product determines the real degree of its defining root. -/ theorem product_degree (P Q : MvPolynomial (Fin n) ℝ) (p q k d : ℕ) (hP : P.IsHomogeneous p) (hQ : Q.IsHomogeneous q) (hF : (P^k * Q).IsHomogeneous d) (hne : P^k * Q ≠ 0) : d = p*k+q := by exact (hF.totalDegree hne).symm.trans (((hP.pow k).mul hQ).totalDegree hne) theorem definingRoot_smul_product_degree (P Q : MvPolynomial (Fin n) ℝ) (p q k d : ℕ) (hk : 0 < k) (hP : P.IsHomogeneous p) (hQ : Q.IsHomogeneous q) (hF : (P^k * Q).IsHomogeneous d) (hne : P^k * Q ≠ 0) (x : Fin n → ℝ) (hx : 0 < eval x Q) (t : ℝ) (ht : 0 < t) : definingRoot P Q k (t • x) = t ^ ((d : ℝ) / (k : ℝ)) * definingRoot P Q k x := by rw [definingRoot_smul P Q p q k hP hQ x hx t ht, product_degree P Q p q k d hP hQ hF hne] have hk' : (k : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr hk.ne' congr 2 push_cast field_simp end end Source29PositiveRootHomogeneity /- Component: AnalyticHomogeneousRadialJets.inc -/ namespace Source29AnalyticHomogeneousRadialJets open Filter open scoped Topology noncomputable section variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] /-- Euler's identity needs only positive dilation near the base point. -/ theorem euler (f : E → ℝ) (D : ℝ) (x : E) (hf : AnalyticAt ℝ f x) (hhom : ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) : fderiv ℝ f x x = D * f x := by have hcurve : HasDerivAt (fun t : ℝ => f (t • x)) (fderiv ℝ f x x) 1 := by have hf' : HasFDerivAt f (fderiv ℝ f x) ((1 : ℝ) • x) := by simpa using hf.differentiableAt.hasFDerivAt simpa only [Function.comp_def, id_eq, one_smul] using hf'.comp_hasDerivAt 1 ((hasDerivAt_id (1 : ℝ)).smul_const x) have hpow : HasDerivAt (fun t : ℝ => t^D * f x) (D * f x) 1 := by simpa using (Real.hasDerivAt_rpow_const (p := D) (Or.inl one_ne_zero)).mul_const (f x) have heq : (fun t : ℝ => f (t • x)) =ᶠ[𝓝 1] (fun t : ℝ => t^D * f x) := by filter_upwards [eventually_gt_nhds (show (0 : ℝ) < 1 by norm_num)] with t ht exact hhom t ht exact hcurve.unique (hpow.congr_of_eventuallyEq heq) /-- Spatial differentiation lowers real homogeneous degree by one. -/ theorem directional_smul (f : E → ℝ) (D : ℝ) (U : Set E) (hU : IsOpen U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (x : E) (hx : x ∈ U) (v : E) (t : ℝ) (ht : 0 < t) : fderiv ℝ f (t • x) v = t^(D-1) * fderiv ℝ f x v := by let A : E →L[ℝ] E := t • ContinuousLinearMap.id ℝ E have heq : (fun y => f (t • y)) =ᶠ[𝓝 x] (fun y => t^D * f y) := by filter_upwards [hU.mem_nhds hx] with y hy exact hhom y hy t ht have hl := (hf (t • x) (hcone x hx t ht)).differentiableAt.hasFDerivAt.comp x A.hasFDerivAt change HasFDerivAt (fun y => f (t • y)) ((fderiv ℝ f (t • x)).comp A) x at hl have hr := (hf x hx).differentiableAt.hasFDerivAt.const_mul (t^D) have he := congrArg (fun L : E →L[ℝ] ℝ => L v) heq.fderiv_eq rw [hl.fderiv, hr.fderiv] at he simp only [ContinuousLinearMap.comp_apply, A, smul_apply, ContinuousLinearMap.id_apply, map_smul, smul_eq_mul] at he apply mul_left_cancel₀ ht.ne' calc t * fderiv ℝ f (t • x) v = t^D * fderiv ℝ f x v := he _ = t * (t^(D-1) * fderiv ℝ f x v) := by rw [Real.rpow_sub ht, Real.rpow_one] field_simp /-- Euler's identity for the first directional derivative. -/ theorem radial_hessian (f : E → ℝ) (D : ℝ) (U : Set E) (hU : IsOpen U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (x : E) (hx : x ∈ U) (v : E) : fderiv ℝ (fun y => fderiv ℝ f y v) x x = (D-1) * fderiv ℝ f x v := euler _ (D-1) x (Source29NewtonRootHarmonic.analyticAt_directional f x v (hf x hx)) (fun t ht => directional_smul f D U hU hcone hf hhom x hx v t ht) /-- A second spatial derivative lowers homogeneous degree by two. -/ theorem second_directional_smul (f : E → ℝ) (D : ℝ) (U : Set E) (hU : IsOpen U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (x : E) (hx : x ∈ U) (u v : E) (t : ℝ) (ht : 0 < t) : fderiv ℝ (fun y => fderiv ℝ f y v) (t • x) u = t^(D-2) * fderiv ℝ (fun y => fderiv ℝ f y v) x u := by have he := directional_smul (fun y => fderiv ℝ f y v) (D-1) U hU hcone (fun y hy => Source29NewtonRootHarmonic.analyticAt_directional f y v (hf y hy)) (fun y hy t ht => directional_smul f D U hU hcone hf hhom y hy v t ht) x hx u t ht have heq : D-1-1 = D-2 := by ring rw [heq] at he exact he /-- Euler's identity for the second directional derivative. -/ theorem radial_third_derivative (f : E → ℝ) (D : ℝ) (U : Set E) (hU : IsOpen U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (x : E) (hx : x ∈ U) (u v : E) : fderiv ℝ (fun z => fderiv ℝ (fun y => fderiv ℝ f y v) z u) x x = (D-2) * fderiv ℝ (fun y => fderiv ℝ f y v) x u := euler _ (D-2) x (Source29NewtonRootHarmonic.analyticAt_directional _ x u (Source29NewtonRootHarmonic.analyticAt_directional f x v (hf x hx))) (fun t ht => second_directional_smul f D U hU hcone hf hhom x hx u v t ht) /-- Two radial entries in the third derivative, valid for every real degree. -/ theorem radial_radial_third (f : E → ℝ) (D : ℝ) (U : Set E) (hU : IsOpen U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (x : E) (hx : x ∈ U) (v : E) : fderiv ℝ (fun z => fderiv ℝ (fun y => fderiv ℝ f y v) z x) x x = (D-2)*(D-1) * fderiv ℝ f x v := by rw [radial_third_derivative f D U hU hcone hf hhom x hx x v, radial_hessian f D U hU hcone hf hhom x hx v] ring end end Source29AnalyticHomogeneousRadialJets /- Component: PositiveRootRadialJets.inc -/ namespace Source29PositiveRootRadialJets open MvPolynomial Filter open Source29PositiveCofactorRoot Source29PositiveRootHomogeneity open Source29AnalyticHomogeneousRadialJets open scoped Topology noncomputable section variable {n : ℕ} /-- Actual radial Hessian and third derivatives of the positive defining root. No integrality assumption is imposed on its homogeneous degree. -/ theorem definingRoot_radial_jets (P Q : MvPolynomial (Fin n) ℝ) (p q k : ℕ) (hk : 0 < k) (hP : P.IsHomogeneous p) (hQ : Q.IsHomogeneous q) (x : Fin n → ℝ) (hx : 0 < eval x Q) (v : Fin n → ℝ) : let f := definingRoot P Q k let D := (p : ℝ) + (q : ℝ) / (k : ℝ) fderiv ℝ f x x = D * f x ∧ fderiv ℝ (fun y => fderiv ℝ f y v) x x = (D-1) * fderiv ℝ f x v ∧ fderiv ℝ (fun z => fderiv ℝ (fun y => fderiv ℝ f y v) z x) x x = (D-2)*(D-1) * fderiv ℝ f x v := by let U : Set (Fin n → ℝ) := {y | 0 < eval y Q} have hU : IsOpen U := isOpen_lt continuous_const (show Continuous (fun y => eval y Q) from continuous_iff_continuousAt.mpr (fun y => (Source29PolynomialLinkChart.analyticAt_eval_real Q y).continuousAt)) have hcone : ∀ y ∈ U, ∀ t : ℝ, 0 < t → t • y ∈ U := fun y hy t ht => eval_smul_pos Q q hQ y hy t ht have hf : ∀ y ∈ U, AnalyticAt ℝ (definingRoot P Q k) y := fun y hy => definingRoot_analyticAt P Q k hk y hy have hhom : ∀ y ∈ U, ∀ t : ℝ, 0 < t → definingRoot P Q k (t • y) = t ^ ((p : ℝ) + (q : ℝ) / (k : ℝ)) * definingRoot P Q k y := fun y hy t ht => definingRoot_smul P Q p q k hP hQ y hy t ht exact ⟨euler _ _ x (hf x hx) (hhom x hx), radial_hessian _ _ U hU hcone hf hhom x hx v, radial_radial_third _ _ U hU hcone hf hhom x hx v⟩ /-- Normalized radial coordinates give the entries used by the Jacobi trace. -/ theorem definingRoot_coordinate_jets (P Q : MvPolynomial (Fin n) ℝ) (p q k : ℕ) (hk : 0 < k) (hP : P.IsHomogeneous p) (hQ : Q.IsHomogeneous q) (r j : Fin n) (hx : 0 < eval (Pi.single r 1) Q) : let f := definingRoot P Q k let x : Fin n → ℝ := Pi.single r 1 let v : Fin n → ℝ := Pi.single j 1 let D := (p : ℝ) + (q : ℝ) / (k : ℝ) fderiv ℝ (fun y => fderiv ℝ f y v) x (Pi.single r 1) = (D-1) * fderiv ℝ f x v ∧ fderiv ℝ (fun z => fderiv ℝ (fun y => fderiv ℝ f y v) z (Pi.single r 1)) x (Pi.single r 1) = (D-2)*(D-1) * fderiv ℝ f x v := (definingRoot_radial_jets P Q p q k hk hP hQ (Pi.single r 1) hx (Pi.single j 1)).2 end end Source29PositiveRootRadialJets /- Component: AnalyticSecondSymmetry.inc -/ namespace Source29AnalyticSecondSymmetry open Filter open scoped Topology noncomputable section variable {E F : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [NormedAddCommGroup F] [NormedSpace ℝ F] lemma derivSeries_one_apply (p : FormalMultilinearSeries ℝ E F) (u v : E) : p.derivSeries 1 (fun _ => u) v = p 2 ![u,v] + p 2 ![v,u] := by classical have hu : (Finset.univ : Finset {s : Finset (Fin 2) // s.card = 1}) = {⟨{0}, by simp⟩, ⟨{1}, by simp⟩} := by decide simp only [FormalMultilinearSeries.derivSeries, ContinuousLinearMap.compFormalMultilinearSeries_apply, FormalMultilinearSeries.changeOriginSeries, ContinuousLinearMap.compContinuousMultilinearMap_coe, ContinuousLinearEquiv.coe_coe, LinearIsometryEquiv.coe_coe, Function.comp_apply, map_sum, _root_.sum_apply, continuousMultilinearCurryFin1_apply, Fin.snoc_zero, FormalMultilinearSeries.changeOriginSeriesTerm_apply] rw [hu] simp only [Finset.sum_insert, Finset.sum_singleton, Finset.mem_singleton, Subtype.mk.injEq, Finset.singleton_inj, Fin.zero_ne_one, not_false_eq_true, Finset.mem_singleton, Subtype.coe_mk] congr 1 <;> congr 1 <;> funext i <;> fin_cases i <;> simp variable [CompleteSpace F] /-- Symmetry of the second derivative, proved directly from the analytic power series so that no additional differentiability import is needed. -/ theorem second_symmetric (f : E → F) (x u v : E) (hf : AnalyticAt ℝ f x) : fderiv ℝ (fderiv ℝ f) x u v = fderiv ℝ (fderiv ℝ f) x v u := by obtain ⟨p, r, hp⟩ := hf rw [hp.fderiv.hasFPowerSeriesAt.fderiv_eq] simp only [continuousMultilinearCurryFin1_apply, Fin.snoc_zero, derivSeries_one_apply, add_comm] end end Source29AnalyticSecondSymmetry /- Component: AnalyticNormalTrace.inc -/ namespace Source29AnalyticNormalTrace open Filter Source29NormalShiftAlgebra open Source29FiniteJetConvergence (first_mul first_sum) open scoped Topology BigOperators noncomputable section section ArrayCalculus variable {E I : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [Fintype I] lemma analyticAt_dot (V W : E → I → ℝ) (x : E) (hV : ∀ i, AnalyticAt ℝ (fun y => V y i) x) (hW : ∀ i, AnalyticAt ℝ (fun y => W y i) x) : AnalyticAt ℝ (fun y => dot (V y) (W y)) x := Finset.analyticAt_fun_sum _ (fun i _ => (hV i).mul (hW i)) lemma analyticAt_trace (H : E → I → I → ℝ) (x : E) (hH : ∀ i j, AnalyticAt ℝ (fun y => H y i j) x) : AnalyticAt ℝ (fun y => trace (H y)) x := Finset.analyticAt_fun_sum _ (fun i _ => hH i i) lemma analyticAt_bilinear (H : E → I → I → ℝ) (V W : E → I → ℝ) (x : E) (hH : ∀ i j, AnalyticAt ℝ (fun y => H y i j) x) (hV : ∀ i, AnalyticAt ℝ (fun y => V y i) x) (hW : ∀ i, AnalyticAt ℝ (fun y => W y i) x) : AnalyticAt ℝ (fun y => bilinear (H y) (V y) (W y)) x := Finset.analyticAt_fun_sum _ (fun i _ => Finset.analyticAt_fun_sum _ (fun j _ => ((hH i j).mul (hV i)).mul (hW j))) lemma first_dot (V W : E → I → ℝ) (x v : E) (hV : ∀ i, AnalyticAt ℝ (fun y => V y i) x) (hW : ∀ i, AnalyticAt ℝ (fun y => W y i) x) : fderiv ℝ (fun y => dot (V y) (W y)) x v = dot (fun i => fderiv ℝ (fun y => V y i) x v) (W x) + dot (V x) (fun i => fderiv ℝ (fun y => W y i) x v) := by unfold dot rw [first_sum Finset.univ (fun i y => V y i * W y i) x v (fun i _ => (hV i).mul (hW i))] simp_rw [first_mul (fun y => V y _) (fun y => W y _) x v (hV _) (hW _)] rw [← Finset.sum_add_distrib] apply Finset.sum_congr rfl intro i _ ring lemma first_trace (H : E → I → I → ℝ) (x v : E) (hH : ∀ i j, AnalyticAt ℝ (fun y => H y i j) x) : fderiv ℝ (fun y => trace (H y)) x v = trace (fun i j => fderiv ℝ (fun y => H y i j) x v) := first_sum _ _ x v (fun i _ => hH i i) lemma first_bilinear (H : E → I → I → ℝ) (V W : E → I → ℝ) (x v : E) (hH : ∀ i j, AnalyticAt ℝ (fun y => H y i j) x) (hV : ∀ i, AnalyticAt ℝ (fun y => V y i) x) (hW : ∀ i, AnalyticAt ℝ (fun y => W y i) x) : fderiv ℝ (fun y => bilinear (H y) (V y) (W y)) x v = bilinear (fun i j => fderiv ℝ (fun y => H y i j) x v) (V x) (W x) + bilinear (H x) (fun i => fderiv ℝ (fun y => V y i) x v) (W x) + bilinear (H x) (V x) (fun j => fderiv ℝ (fun y => W y j) x v) := by have hi (i : I) : fderiv ℝ (fun y => ∑ j : I, H y i j * V y i * W y j) x v = ∑ j : I, fderiv ℝ (fun y => H y i j * V y i * W y j) x v := first_sum Finset.univ (fun j y => H y i j * V y i * W y j) x v (fun j _ => ((hH i j).mul (hV i)).mul (hW j)) have hij (i j : I) : fderiv ℝ (fun y => H y i j * V y i * W y j) x v = fderiv ℝ (fun y => H y i j) x v * V x i * W x j + H x i j * fderiv ℝ (fun y => V y i) x v * W x j + H x i j * V x i * fderiv ℝ (fun y => W y j) x v := by rw [first_mul (fun y => H y i j * V y i) (fun y => W y j) x v ((hH i j).mul (hV i)) (hW j), first_mul (fun y => H y i j) (fun y => V y i) x v (hH i j) (hV i)] ring unfold bilinear rw [first_sum Finset.univ (fun i y => ∑ j : I, H y i j * V y i * W y j) x v (fun i _ => Finset.analyticAt_fun_sum _ (fun j _ => ((hH i j).mul (hV i)).mul (hW j)))] simp only [hi, hij, Finset.sum_add_distrib] /-- Differentiating the cubic expression in actual analytic arrays. -/ theorem first_cubicLevel (V : E → I → ℝ) (H : E → I → I → ℝ) (x v : E) (hV : ∀ i, AnalyticAt ℝ (fun y => V y i) x) (hH : ∀ i j, AnalyticAt ℝ (fun y => H y i j) x) : fderiv ℝ (fun y => cubicLevel (V y) (H y)) x v = (dot (fun i => fderiv ℝ (fun y => V y i) x v) (V x) + dot (V x) (fun i => fderiv ℝ (fun y => V y i) x v)) * trace (H x) + dot (V x) (V x) * trace (fun i j => fderiv ℝ (fun y => H y i j) x v) - (bilinear (fun i j => fderiv ℝ (fun y => H y i j) x v) (V x) (V x) + bilinear (H x) (fun i => fderiv ℝ (fun y => V y i) x v) (V x) + bilinear (H x) (V x) (fun i => fderiv ℝ (fun y => V y i) x v)) := by unfold cubicLevel rw [fderiv_fun_sub (f := fun y => dot (V y) (V y) * trace (H y)) (g := fun y => bilinear (H y) (V y) (V y)) ((analyticAt_dot V V x hV hV).mul (analyticAt_trace H x hH)).differentiableAt (analyticAt_bilinear H V V x hH hV hV).differentiableAt] simp only [_root_.sub_apply] rw [first_mul (fun y => dot (V y) (V y)) (fun y => trace (H y)) x v (analyticAt_dot V V x hV hV) (analyticAt_trace H x hH), first_dot V V x v hV hV, first_trace H x v hH, first_bilinear H V V x v hH hV hV] ring end ArrayCalculus section Coordinates variable {I : Type*} [Fintype I] [DecidableEq I] def coordPartial (f : (I → ℝ) → ℝ) (i : I) (x : I → ℝ) : ℝ := fderiv ℝ f x (Pi.single i 1) def grad (f : (I → ℝ) → ℝ) (x : I → ℝ) (i : I) : ℝ := coordPartial f i x def hess (f : (I → ℝ) → ℝ) (x : I → ℝ) (i j : I) : ℝ := coordPartial (coordPartial f j) i x def third (f : (I → ℝ) → ℝ) (x : I → ℝ) (i j k : I) : ℝ := coordPartial (coordPartial (coordPartial f k) j) i x def levelOperator (f : (I → ℝ) → ℝ) (x : I → ℝ) : ℝ := cubicLevel (grad f x) (hess f x) lemma partial_analyticAt (f : (I → ℝ) → ℝ) (x : I → ℝ) (hf : AnalyticAt ℝ f x) (i : I) : AnalyticAt ℝ (coordPartial f i) x := Source29NewtonRootHarmonic.analyticAt_directional f x _ hf lemma hess_analyticAt (f : (I → ℝ) → ℝ) (x : I → ℝ) (hf : AnalyticAt ℝ f x) (i j : I) : AnalyticAt ℝ (fun y => hess f y i j) x := partial_analyticAt _ x (partial_analyticAt f x hf j) i lemma hess_eq_fderiv (f : (I → ℝ) → ℝ) (x : I → ℝ) (hf : AnalyticAt ℝ f x) (i j : I) : hess f x i j = fderiv ℝ (fderiv ℝ f) x (Pi.single i 1) (Pi.single j 1) := Source29NormalShiftDerivatives.second_eq_fderiv_fderiv f x _ _ hf lemma hess_symm (f : (I → ℝ) → ℝ) (x : I → ℝ) (hf : AnalyticAt ℝ f x) (i j : I) : hess f x i j = hess f x j i := by rw [hess_eq_fderiv f x hf i j, hess_eq_fderiv f x hf j i] exact Source29AnalyticSecondSymmetry.second_symmetric f x _ _ hf lemma third_swap12 (f : (I → ℝ) → ℝ) (x : I → ℝ) (hf : AnalyticAt ℝ f x) (i j k : I) : third f x i j k = third f x j i k := hess_symm (coordPartial f k) x (partial_analyticAt f x hf k) i j lemma third_swap23 (f : (I → ℝ) → ℝ) (x : I → ℝ) (hf : AnalyticAt ℝ f x) (i j k : I) : third f x i j k = third f x i k j := by have he : (fun y => hess f y j k) =ᶠ[𝓝 x] (fun y => hess f y k j) := hf.eventually_analyticAt.mono (fun y hy => hess_symm f y hy j k) exact congrArg (fun D : (I → ℝ) →L[ℝ] ℝ => D (Pi.single i 1)) he.fderiv_eq end Coordinates section NormalTrace variable {I : Type*} [Fintype I] [DecidableEq I] /-- Tangential Hessian trace vanishes at a regular point whose gradient is in the distinguished normal direction. -/ theorem tangential_trace_zero (f : (Option I → ℝ) → ℝ) (x : Option I → ℝ) (g : ℝ) (hg : g ≠ 0) (hL : levelOperator f x = 0) (hgn : grad f x none = g) (hgt : ∀ i, grad f x (some i) = 0) : (∑ i, hess f x (some i) (some i)) = 0 := by have he := hL simp only [levelOperator, cubicLevel, dot, trace, bilinear, Fintype.sum_option, hgn, hgt, zero_mul, mul_zero, Finset.sum_const_zero, add_zero] at he have hh : g^2 * (∑ i, hess f x (some i) (some i)) = 0 := by nlinarith [he] exact (mul_eq_zero.mp hh).resolve_left (pow_ne_zero _ hg) /-- The differentiated cubic equation yields the normal trace identity for actual third coordinate derivatives of an analytic defining function. -/ theorem derivative_trace (f : (Option I → ℝ) → ℝ) (x : Option I → ℝ) (g : ℝ) (hg : g ≠ 0) (hf : AnalyticAt ℝ f x) (hL : ∀ᶠ y in 𝓝 x, levelOperator f y = 0) (hgn : grad f x none = g) (hgt : ∀ i, grad f x (some i) = 0) (a : Option I) : g * (∑ i, third f x a (some i) (some i)) = 2 * (∑ i, hess f x a (some i) * hess f x none (some i)) := by have ht := tangential_trace_zero f x g hg hL.self_of_nhds hgn hgt have he : fderiv ℝ (levelOperator f) x (Pi.single a 1) = 0 := by have heq : levelOperator f =ᶠ[𝓝 x] (fun _ => 0) := hL rw [heq.fderiv_eq] simp rw [show levelOperator f = (fun y => cubicLevel (grad f y) (hess f y)) from rfl, first_cubicLevel (grad f) (hess f) x (Pi.single a 1) (fun i => partial_analyticAt f x hf i) (hess_analyticAt f x hf)] at he change (dot (hess f x a) (grad f x) + dot (grad f x) (hess f x a)) * trace (hess f x) + dot (grad f x) (grad f x) * trace (third f x a) - (bilinear (third f x a) (grad f x) (grad f x) + bilinear (hess f x) (hess f x a) (grad f x) + bilinear (hess f x) (grad f x) (hess f x a)) = 0 at he have hs : ∀ i, hess f x (some i) none = hess f x none (some i) := fun i => hess_symm f x hf _ _ simp only [dot, trace, bilinear, Fintype.sum_option, hgn, hgt, zero_mul, mul_zero, Finset.sum_const_zero, add_zero, ht, hs] at he have heq : ∀ i, hess f x none (some i) * hess f x a (some i) * g = g * (hess f x a (some i) * hess f x none (some i)) := by intro i; ring have heq' : ∀ i, hess f x none (some i) * g * hess f x a (some i) = g * (hess f x a (some i) * hess f x none (some i)) := by intro i; ring simp_rw [heq, heq', ← Finset.mul_sum] at he have hh : g * (g * (∑ i, third f x a (some i) (some i)) - 2 * (∑ i, hess f x a (some i) * hess f x none (some i))) = 0 := by nlinarith [he] exact sub_eq_zero.mp ((mul_eq_zero.mp hh).resolve_left hg) theorem normal_derivative_trace (f : (Option I → ℝ) → ℝ) (x : Option I → ℝ) (g : ℝ) (hg : g ≠ 0) (hf : AnalyticAt ℝ f x) (hL : ∀ᶠ y in 𝓝 x, levelOperator f y = 0) (hgn : grad f x none = g) (hgt : ∀ i, grad f x (some i) = 0) : g * (∑ i, third f x none (some i) (some i)) = 2 * (∑ i, (hess f x none (some i))^2) := by simpa only [pow_two] using derivative_trace f x g hg hf hL hgn hgt none end NormalTrace lemma levelOperator_fin_eq {n : ℕ} (f : (Fin n → ℝ) → ℝ) (x : Fin n → ℝ) : levelOperator f x = Source29AnalyticScalarLevelOperator.levelOperator f x := rfl end end Source29AnalyticNormalTrace /- Component: AnalyticCurveCoordinateJets.inc -/ namespace Source29AnalyticCurveCoordinateJets open Filter Source29NormalShiftDerivatives open scoped Topology BigOperators noncomputable section section GeneralCurve variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] theorem first_deriv_comp (f : E → ℝ) (C : ℝ → E) (t : ℝ) (hf : AnalyticAt ℝ f (C t)) (hC : AnalyticAt ℝ C t) : deriv (fun s => f (C s)) t = fderiv ℝ f (C t) (deriv C t) := (hf.differentiableAt.hasFDerivAt.comp_hasDerivAt t hC.differentiableAt.hasDerivAt).deriv variable [CompleteSpace E] /-- The second curve derivative uses the actual velocity and acceleration, and the actual second Frechet derivative of the analytic function. -/ theorem second_deriv_comp (f : E → ℝ) (C : ℝ → E) (hf : AnalyticAt ℝ f (C 0)) (hC : AnalyticAt ℝ C 0) : deriv (deriv (fun t => f (C t))) 0 = second f (C 0) (deriv C 0) (deriv C 0) + fderiv ℝ f (C 0) (deriv (deriv C) 0) := by have he : deriv (fun t => f (C t)) =ᶠ[𝓝 0] (fun t => fderiv ℝ f (C t) (deriv C t)) := by filter_upwards [hC.eventually_analyticAt, hC.continuousAt.tendsto.eventually hf.eventually_analyticAt] with t ht hft exact first_deriv_comp f C t hft ht rw [he.deriv_eq, second_eq_fderiv_fderiv f (C 0) _ _ hf] exact ((hf.fderiv.differentiableAt.hasFDerivAt.comp_hasDerivAt 0 hC.differentiableAt.hasDerivAt).clm_apply hC.deriv.differentiableAt.hasDerivAt).deriv end GeneralCurve variable {κ : Type*} [Fintype κ] [DecidableEq κ] theorem linear_apply_eq_sum (L : (κ → ℝ) →L[ℝ] ℝ) (v : κ → ℝ) : L v = ∑ j, L (Pi.single j 1) * v j := by conv_lhs => rw [← Finset.univ_sum_single v, map_sum] apply Finset.sum_congr rfl intro j _ have he : Pi.single j (v j) = v j • (Pi.single j 1 : κ → ℝ) := by ext i simp only [Pi.single_apply, Pi.smul_apply, smul_eq_mul] split_ifs <;> simp rw [he, map_smul] simp only [smul_eq_mul, mul_comm] theorem first_deriv_curve (f : (κ → ℝ) → ℝ) (γ : κ → ℝ → ℝ) (t : ℝ) (hf : AnalyticAt ℝ f (fun j => γ j t)) (hγ : ∀ j, AnalyticAt ℝ (γ j) t) : deriv (fun s => f (fun j => γ j s)) t = ∑ j, fderiv ℝ f (fun a => γ a t) (Pi.single j 1) * deriv (γ j) t := by rw [first_deriv_comp f _ t hf (AnalyticAt.pi hγ), deriv_pi (fun j => (hγ j).differentiableAt), linear_apply_eq_sum] theorem coordinate_velocity_first (f : (κ → ℝ) → ℝ) (γ : κ → ℝ → ℝ) (x : κ → ℝ) (v : κ) (hf : AnalyticAt ℝ f x) (hγ : ∀ j, AnalyticAt ℝ (γ j) 0) (hγ0 : ∀ j, γ j 0 = x j) (hγ1 : ∀ j, deriv (γ j) 0 = Pi.single (M := fun _ => ℝ) v 1 j) : deriv (fun t => f (fun j => γ j t)) 0 = fderiv ℝ f x (Pi.single v 1) := by have h0 : (fun j => γ j 0) = x := funext hγ0 have hfa : AnalyticAt ℝ f (fun j => γ j 0) := h0.symm ▸ hf rw [first_deriv_curve f γ 0 hfa hγ] simp [h0,hγ1,Pi.single_apply] /-- Coordinate velocity along an arbitrary analytic curve, with its actual second derivatives supplying the acceleration term. -/ theorem coordinate_velocity_second (f : (κ → ℝ) → ℝ) (γ : κ → ℝ → ℝ) (x : κ → ℝ) (v : κ) (hf : AnalyticAt ℝ f x) (hγ : ∀ j, AnalyticAt ℝ (γ j) 0) (hγ0 : ∀ j, γ j 0 = x j) (hγ1 : ∀ j, deriv (γ j) 0 = Pi.single (M := fun _ => ℝ) v 1 j) : deriv (deriv (fun t => f (fun j => γ j t))) 0 = second f x (Pi.single v 1) (Pi.single v 1) + ∑ j, fderiv ℝ f x (Pi.single j 1) * deriv (deriv (γ j)) 0 := by let C : ℝ → κ → ℝ := fun t j => γ j t have h0 : C 0 = x := funext hγ0 have hC : AnalyticAt ℝ C 0 := AnalyticAt.pi hγ have hfirst : deriv C =ᶠ[𝓝 0] (fun t j => deriv (γ j) t) := by filter_upwards [Filter.eventually_all.mpr (fun j => (hγ j).eventually_analyticAt)] with t ht exact deriv_pi (fun j => (ht j).differentiableAt) have h1 : deriv C 0 = Pi.single v 1 := by rw [deriv_pi (fun j => (hγ j).differentiableAt)] exact funext hγ1 have h2 : deriv (deriv C) 0 = fun j => deriv (deriv (γ j)) 0 := by rw [hfirst.deriv_eq] exact deriv_pi (fun j => (hγ j).deriv.differentiableAt) change deriv (deriv (fun t => f (C t))) 0 = _ rw [second_deriv_comp f C (h0.symm ▸ hf) hC, h0, h1, h2, linear_apply_eq_sum] end end Source29AnalyticCurveCoordinateJets /- Component: AnalyticLinkChart.inc -/ namespace Source29AnalyticLinkChart open Filter MvPolynomial open Source29PolynomialLinkChart (Ambient base radialScale diagonalEquiv diagonalEquiv_apply parameterEmbed analytic_parameterEmbed analyticAt_eval_real) open Source29QuarticReuse.QuarticPolynomialBasics open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def constraintMap (f : Ambient ι → ℝ) (x : Ambient ι) : Ambient ι | none => f x | some none => ∑ j, (x j)^2 | some (some j) => x (some (some j)) theorem constraintMap_base (f : Ambient ι → ℝ) (hf : f base = 0) : constraintMap f base = parameterEmbed 0 := by ext j cases j with | none => exact hf | some j => cases j <;> simp [constraintMap, base, parameterEmbed, Pi.single_apply] /-- The regular spherical link of an analytic defining function has an actual analytic chart, without requiring a polynomial defining equation. -/ theorem exists_link_chart (f : Ambient ι → ℝ) (hf : AnalyticAt ℝ f base) (g : ℝ) (hg : g ≠ 0) (hzero : f base = 0) (hgn : fderiv ℝ f base (Pi.single none 1) = g) (hgt : ∀ j, fderiv ℝ f base (Pi.single (some j) 1) = 0) : ∃ φ : (ι → ℝ) → Ambient ι, AnalyticAt ℝ φ 0 ∧ φ 0 = base ∧ ∀ᶠ y in 𝓝 (0 : ι → ℝ), constraintMap f (φ y) = parameterEmbed y := by have hscale : ∀ j : Option (Option ι), radialScale g j ≠ 0 := by intro j cases j with | none => exact hg | some j => cases j <;> norm_num [radialScale] let e : Ambient ι ≃L[ℝ] Ambient ι := diagonalEquiv (radialScale g) hscale have ha : AnalyticAt ℝ (constraintMap f) base := by apply AnalyticAt.pi intro j cases j with | none => exact hf | some j => cases j with | none => change AnalyticAt ℝ (fun x : Ambient ι => ∑ j, (x j)^2) base simpa only [eval_spherePolynomial] using analyticAt_eval_real (spherePolynomial : MvPolynomial (Option (Option ι)) ℝ) base | some j => exact (ContinuousLinearMap.proj (some (some j)) : Ambient ι →L[ℝ] ℝ).analyticAt base have hd : HasStrictFDerivAt (constraintMap f) (e : Ambient ι →L[ℝ] Ambient ι) base := by apply hasStrictFDerivAt_pi'.mpr intro j cases j with | none => have hj := (hf.contDiffAt : ContDiffAt ℝ 1 f base).hasStrictFDerivAt one_ne_zero change HasStrictFDerivAt f _ base convert hj using 1 ext v change e v none = fderiv ℝ f base v rw [diagonalEquiv_apply, Source29AnalyticCurveCoordinateJets.linear_apply_eq_sum] simp [Fintype.sum_option,hgn,hgt,radialScale] | some j => cases j with | none => have hj := hasStrictFDerivAt_eval (spherePolynomial : MvPolynomial (Option (Option ι)) ℝ) base simp only [eval_spherePolynomial] at hj change HasStrictFDerivAt (fun x : Ambient ι => ∑ j, (x j)^2) _ base convert hj using 1 ext v change e v (some none) = evalFDeriv spherePolynomial base v rw [diagonalEquiv_apply] simp [evalFDeriv_spherePolynomial,base,Pi.single_apply,radialScale] | some j => have hj := (ContinuousLinearMap.proj (some (some j)) : Ambient ι →L[ℝ] ℝ).hasStrictFDerivAt (x := base) change HasStrictFDerivAt (fun x : Ambient ι => x (some (some j))) _ base convert hj using 1 <;> ext v <;> simp [e,diagonalEquiv_apply,radialScale] obtain ⟨u,hu,hu0,hnear⟩ := Source29RealAnalyticInverse.exists_analytic_local_inverse (constraintMap f) base e ha hd rw [constraintMap_base f hzero] at hu hu0 hnear exact ⟨fun y => u (parameterEmbed y),hu.comp (analytic_parameterEmbed 0),hu0, (analytic_parameterEmbed 0).continuousAt.tendsto.eventually hnear⟩ /-- Analytic link curves with prescribed linear tangential coordinates. -/ theorem exists_link_curves (f : Ambient ι → ℝ) (hf : AnalyticAt ℝ f base) (g : ℝ) (hg : g ≠ 0) (hzero : f base = 0) (hgn : fderiv ℝ f base (Pi.single none 1) = g) (hgt : ∀ j, fderiv ℝ f base (Pi.single (some j) 1) = 0) : ∃ γ : ι → Option (Option ι) → ℝ → ℝ, (∀ i j, AnalyticAt ℝ (γ i j) 0) ∧ (∀ i j, γ i j 0 = base j) ∧ (∀ i, (fun t => f (fun j => γ i j t)) =ᶠ[𝓝 (0 : ℝ)] (fun _ => 0)) ∧ (∀ i, (fun t => ∑ j, (γ i j t)^2) =ᶠ[𝓝 (0 : ℝ)] (fun _ => 1)) ∧ (∀ i j, γ i (some (some j)) =ᶠ[𝓝 (0 : ℝ)] (fun t => t * (Pi.single (M := fun _ => ℝ) i 1 j))) := by obtain ⟨φ,hφ,hφ0,hnear⟩ := exists_link_chart f hf g hg hzero hgn hgt let line : ι → ℝ → (ι → ℝ) := fun i t => t • Pi.single i 1 have hline0 : ∀ i, line i 0 = 0 := by intro i; simp [line] have hline : ∀ i, AnalyticAt ℝ (line i) 0 := fun _ => analyticAt_id.smul analyticAt_const have hc : ∀ i, AnalyticAt ℝ (fun t => φ (line i t)) 0 := by intro i apply AnalyticAt.comp _ (hline i) simpa only [hline0] using hφ let γ : ι → Option (Option ι) → ℝ → ℝ := fun i j t => φ (line i t) j have hconstraints : ∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), constraintMap f (φ (line i t)) = parameterEmbed (line i t) := by intro i have ht := (hline i).continuousAt.tendsto rw [hline0] at ht exact ht.eventually hnear refine ⟨γ,?_,?_,?_,?_,?_⟩ · intro i j exact ((ContinuousLinearMap.proj j : Ambient ι →L[ℝ] ℝ).analyticAt _).comp (hc i) · intro i j dsimp [γ] rw [hline0,hφ0] · intro i filter_upwards [hconstraints i] with t ht exact congrFun ht none · intro i filter_upwards [hconstraints i] with t ht exact congrFun ht (some none) · intro i j filter_upwards [hconstraints i] with t ht exact congrFun ht (some (some j)) end end Source29AnalyticLinkChart /- Component: AnalyticLinkCurveJets.inc -/ namespace Source29AnalyticLinkCurveJets open Filter MvPolynomial Source29PolynomialLinkChart open Source29RealPolynomialCurveJets Source29PolynomialCurveCoordinateJets open Source29QuarticReuse.QuarticPolynomialBasics open Source29PolynomialLinkCurveJets (linear_deriv linear_second_deriv) open Source29NormalShiftDerivatives (second) open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Differentiating the actual two link constraints fixes the first and second normal/radial derivatives of each coordinate curve. -/ theorem link_curve_jets (f : Ambient ι → ℝ) (hf : AnalyticAt ℝ f base) (g : ℝ) (hg : g ≠ 0) (hgn : fderiv ℝ f base (Pi.single none 1) = g) (hgt : ∀ j, fderiv ℝ f base (Pi.single (some j) 1) = 0) (γ : Option (Option ι) → ℝ → ℝ) (i : ι) (hγ : ∀ j, AnalyticAt ℝ (γ j) 0) (hγ0 : ∀ j, γ j 0 = base j) (hzero : (fun t => f (fun j => γ j t)) =ᶠ[𝓝 (0 : ℝ)] (fun _ => 0)) (hsphere : (fun t => ∑ j, (γ j t)^2) =ᶠ[𝓝 (0 : ℝ)] (fun _ => 1)) (htangent : ∀ j, γ (some (some j)) =ᶠ[𝓝 (0 : ℝ)] (fun t => t * (Pi.single (M := fun _ => ℝ) i 1 j))) : (∀ j, deriv (γ j) 0 = Pi.single (M := fun _ => ℝ) (some (some i)) 1 j) ∧ (∀ j, deriv (deriv (γ j)) 0 = -Pi.single (M := fun _ => ℝ) (some none) 1 j - (second f base (Pi.single (some (some i)) 1) (Pi.single (some (some i)) 1)/g) * Pi.single (M := fun _ => ℝ) none 1 j) := by have h0 : (fun j => γ j 0) = base := funext hγ0 have hn1 := hzero.deriv_eq rw [Source29AnalyticCurveCoordinateJets.first_deriv_curve f γ 0 (h0.symm ▸ hf) hγ, deriv_const, h0] at hn1 simp only [Fintype.sum_option, hgn, hgt, zero_mul, Finset.sum_const_zero, add_zero] at hn1 have hn : deriv (γ none) 0 = 0 := (mul_eq_zero.mp hn1).resolve_left hg have hS : (fun t => eval (fun j => γ j t) (spherePolynomial : MvPolynomial (Option (Option ι)) ℝ)) =ᶠ[𝓝 (0 : ℝ)] (fun _ => 1) := by simpa only [eval_spherePolynomial] using hsphere have hr1 := hS.deriv_eq rw [first_deriv_eval_curve spherePolynomial γ 0 hγ, deriv_const, h0, ← evalFDeriv_apply, evalFDeriv_spherePolynomial] at hr1 simp only [base, Pi.single_apply, ite_mul, one_mul, zero_mul, Finset.sum_ite_eq', Finset.mem_univ, ite_true] at hr1 have hr : deriv (γ (some none)) 0 = 0 := by linarith have ht1 : ∀ j, deriv (γ (some (some j))) 0 = Pi.single (M := fun _ => ℝ) i 1 j := by intro j rw [(htangent j).deriv_eq, linear_deriv] have hv : ∀ j, deriv (γ j) 0 = Pi.single (M := fun _ => ℝ) (some (some i)) 1 j := by intro j cases j with | none => simp [hn] | some j => cases j with | none => simp [hr] | some j => simpa only [Pi.single_apply, Option.some.injEq] using ht1 j have hn2 := hzero.deriv.deriv_eq rw [Source29AnalyticCurveCoordinateJets.coordinate_velocity_second f γ base (some (some i)) hf hγ hγ0 hv, deriv_const', deriv_const] at hn2 simp only [Fintype.sum_option, hgn, hgt, zero_mul, Finset.sum_const_zero, add_zero] at hn2 have hnsecond : deriv (deriv (γ none)) 0 = -second f base (Pi.single (some (some i)) 1) (Pi.single (some (some i)) 1)/g := by apply (eq_div_iff hg).mpr nlinarith [hn2] have hr2 := hS.deriv.deriv_eq rw [coordinate_velocity_second spherePolynomial γ base (some (some i)) hγ hγ0 hv, deriv_const', deriv_const] at hr2 have hdiag : eval base (pderiv (some (some i)) (pderiv (some (some i)) (spherePolynomial : MvPolynomial (Option (Option ι)) ℝ))) = 2 := by simp [pderiv_spherePolynomial, base] rw [hdiag, ← evalFDeriv_apply, evalFDeriv_spherePolynomial] at hr2 simp only [base, Pi.single_apply, ite_mul, one_mul, zero_mul, Finset.sum_ite_eq', Finset.mem_univ, ite_true] at hr2 have hrsecond : deriv (deriv (γ (some none))) 0 = -1 := by linarith have ht2 : ∀ j, deriv (deriv (γ (some (some j)))) 0 = 0 := by intro j rw [(htangent j).deriv.deriv_eq, linear_second_deriv] refine ⟨hv, ?_⟩ intro j cases j with | none => simpa [Pi.single_apply, neg_div] using hnsecond | some j => cases j with | none => simpa [Pi.single_apply] using hrsecond | some j => simpa [Pi.single_apply] using ht2 j /-- The analytic implicit chart supplies actual spherical-link curves with all first and second coordinate jets fixed by the two constraints. -/ theorem exists_link_curves_with_jets (f : Ambient ι → ℝ) (hf : AnalyticAt ℝ f base) (g : ℝ) (hg : g ≠ 0) (hzero : f base = 0) (hgn : fderiv ℝ f base (Pi.single none 1) = g) (hgt : ∀ j, fderiv ℝ f base (Pi.single (some j) 1) = 0) : ∃ γ : ι → Option (Option ι) → ℝ → ℝ, (∀ i j, AnalyticAt ℝ (γ i j) 0) ∧ (∀ i j, γ i j 0 = base j) ∧ (∀ i j, deriv (γ i j) 0 = Pi.single (M := fun _ => ℝ) (some (some i)) 1 j) ∧ (∀ i j, deriv (deriv (γ i j)) 0 = -Pi.single (M := fun _ => ℝ) (some none) 1 j - (second f base (Pi.single (some (some i)) 1) (Pi.single (some (some i)) 1)/g) * Pi.single (M := fun _ => ℝ) none 1 j) ∧ (∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), f (fun j => γ i j t) = 0 ∧ (∑ j, (γ i j t)^2) = 1) := by obtain ⟨γ,hγ,hγ0,hγzero,hγsphere,hγtangent⟩ := Source29AnalyticLinkChart.exists_link_curves f hf g hg hzero hgn hgt have hjets := fun i => link_curve_jets f hf g hg hgn hgt (γ i) i (hγ i) (hγ0 i) (hγzero i) (hγsphere i) (hγtangent i) refine ⟨γ,hγ,hγ0,(fun i => (hjets i).1),(fun i => (hjets i).2),?_⟩ intro i filter_upwards [hγzero i,hγsphere i] with t ht hs exact ⟨ht,hs⟩ end end Source29AnalyticLinkCurveJets /- Component: AnalyticLinkJacobi.inc -/ namespace Source29AnalyticLinkJacobi open Filter Source29AnalyticNormalTrace open Source29AnalyticCurveCoordinateJets open Source29PolynomialLinkChart (base) open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- The differentiated level equation and real-degree radial identities give the normal third-derivative trace along the spherical link. -/ theorem link_third_trace (f : (Option (Option ι) → ℝ) → ℝ) (D g : ℝ) (hg : g ≠ 0) (hf : AnalyticAt ℝ f base) (hL : ∀ᶠ y in 𝓝 base, levelOperator f y = 0) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (hrad : hess f base (some none) none = (D-1)*g) (hrr : third f base (some none) (some none) none = (D-2)*(D-1)*g) : g * (∑ i, third f base none (some (some i)) (some (some i))) = 2 * (∑ i, (hess f base none (some (some i)))^2) + D*(D-1)*g^2 := by have he := derivative_trace f base g hg hf hL hgn hgt none have hH : hess f base none (some none) = (D-1)*g := by rw [hess_symm f base hf] exact hrad have hT : third f base none (some none) (some none) = (D-2)*(D-1)*g := by rw [third_swap12 f base hf, third_swap23 f base hf] exact hrr rw [Fintype.sum_option, Fintype.sum_option, hH, hT] at he simp only [← pow_two] at he nlinarith [he] /-- The actual inverse-gradient profile satisfies the Jacobi equation along analytic curves with the spherical-link velocity and acceleration. -/ theorem jacobi_of_link_curve_jets (f : (Option (Option ι) → ℝ) → ℝ) (D g : ℝ) (hg : 0 < g) (hf : AnalyticAt ℝ f base) (hL : ∀ᶠ y in 𝓝 base, levelOperator f y = 0) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (hrad : ∀ j, hess f base (some none) j = (D-1)*grad f base j) (hrr : third f base (some none) (some none) none = (D-2)*(D-1)*g) (γ : ι → Option (Option ι) → ℝ → ℝ) (hγ : ∀ i j, AnalyticAt ℝ (γ i j) 0) (hγ0 : ∀ i j, γ i j 0 = base j) (hγ1 : ∀ i j, deriv (γ i j) 0 = Pi.single (M := fun _ => ℝ) (some (some i)) 1 j) (hγ2 : ∀ i j, deriv (deriv (γ i j)) 0 = -Pi.single (M := fun _ => ℝ) (some none) 1 j - (hess f base (some (some i)) (some (some i))/g) * Pi.single (M := fun _ => ℝ) none 1 j) : (∑ i, deriv (deriv (fun t => (Source29AnalyticTensorNorm.tensorNorm (grad f (fun a => γ i a t)))⁻¹)) 0) + ((∑ i, ∑ j, (hess f base (some (some j)) (some (some i)))^2)/g^2 + (D-1)*(D-(Fintype.card ι : ℝ))) * g⁻¹ = 0 := by let H : ι → ι → ℝ := fun j i => hess f base (some (some j)) (some (some i)) let G : ι → Option (Option ι) → ℝ → ℝ := fun i j t => grad f (fun a => γ i a t) j let v : ι → ℝ := fun i => hess f base none (some (some i)) let T : ι → ℝ := fun i => third f base none (some (some i)) (some (some i)) let b : ℝ := hess f base none none have hx : ∀ i, (fun j => γ i j 0) = (base : Option (Option ι) → ℝ) := fun i => funext (hγ0 i) have hr : hess f base (some none) none = (D-1)*g := by rw [hrad, hgn] have hrzero : ∀ j, hess f base (some none) (some j) = 0 := by intro j rw [hrad, hgt, mul_zero] have hfirst : ∀ i j, deriv (G i j) 0 = hess f base (some (some i)) j := by intro i j exact coordinate_velocity_first (coordPartial f j) (γ i) base (some (some i)) (partial_analyticAt f base hf j) (hγ i) (hγ0 i) (hγ1 i) have hsecond : ∀ i, deriv (deriv (G i none)) 0 = T i - (D-1)*g - b*H i i/g := by intro i have he := coordinate_velocity_second (coordPartial f none) (γ i) base (some (some i)) (partial_analyticAt f base hf none) (hγ i) (hγ0 i) (hγ1 i) change deriv (deriv (G i none)) 0 = third f base (some (some i)) (some (some i)) none + ∑ j, hess f base j none * deriv (deriv (γ i j)) 0 at he have ht : third f base (some (some i)) (some (some i)) none = T i := by dsimp [T] rw [third_swap23 f base hf, third_swap12 f base hf] rw [he, ht] simp only [hγ2, mul_sub, mul_neg, Finset.sum_sub_distrib, Finset.sum_neg_distrib, Pi.single_apply, mul_ite, mul_one, mul_zero, Finset.sum_ite_eq', Finset.mem_univ, ite_true] rw [hr] dsimp [b, H] ring have htrace : (∑ i, H i i) = 0 := by have he := tangential_trace_zero f base g hg.ne' hL.self_of_nhds hgn hgt rw [Fintype.sum_option, hrzero none, zero_add] at he exact he apply Source29JacobiProfileJets.jacobi_for_gradient_curves G g D b v T H hg · intro i j have hp : AnalyticAt ℝ (coordPartial f j) (fun a => γ i a 0) := (hx i).symm ▸ partial_analyticAt f base hf j exact AnalyticAt.comp (f := fun t a => γ i a t) hp (AnalyticAt.pi (hγ i)) · intro i change grad f (fun a => γ i a 0) none = g rw [hx] exact hgn · intro i j change grad f (fun a => γ i a 0) (some j) = 0 rw [hx] exact hgt j · intro i rw [hfirst, hess_symm f base hf] · intro i rw [hfirst, hess_symm f base hf] exact hrzero (some i) · intro i j rw [hfirst, hess_symm f base hf] · exact hsecond · exact htrace · exact link_third_trace f D g hg.ne' hf hL hgn hgt hr hrr /-- Positive real-degree homogeneity supplies the radial identities in the analytic Jacobi equation. -/ theorem jacobi_of_homogeneous_link_curve_jets (f : (Option (Option ι) → ℝ) → ℝ) (D g : ℝ) (hg : 0 < g) (U : Set (Option (Option ι) → ℝ)) (hU : IsOpen U) (hx : base ∈ U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (hL : ∀ᶠ y in 𝓝 base, levelOperator f y = 0) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (γ : ι → Option (Option ι) → ℝ → ℝ) (hγ : ∀ i j, AnalyticAt ℝ (γ i j) 0) (hγ0 : ∀ i j, γ i j 0 = base j) (hγ1 : ∀ i j, deriv (γ i j) 0 = Pi.single (M := fun _ => ℝ) (some (some i)) 1 j) (hγ2 : ∀ i j, deriv (deriv (γ i j)) 0 = -Pi.single (M := fun _ => ℝ) (some none) 1 j - (hess f base (some (some i)) (some (some i))/g) * Pi.single (M := fun _ => ℝ) none 1 j) : (∑ i, deriv (deriv (fun t => (Source29AnalyticTensorNorm.tensorNorm (grad f (fun a => γ i a t)))⁻¹)) 0) + ((∑ i, ∑ j, (hess f base (some (some j)) (some (some i)))^2)/g^2 + (D-1)*(D-(Fintype.card ι : ℝ))) * g⁻¹ = 0 := by have hr : ∀ j, hess f base (some none) j = (D-1)*grad f base j := by intro j exact Source29AnalyticHomogeneousRadialJets.radial_hessian f D U hU hcone hf hhom base hx (Pi.single j 1) have hrr : third f base (some none) (some none) none = (D-2)*(D-1)*g := by rw [← hgn] exact Source29AnalyticHomogeneousRadialJets.radial_radial_third f D U hU hcone hf hhom base hx (Pi.single none 1) exact jacobi_of_link_curve_jets f D g hg (hf base hx) hL hgn hgt hr hrr γ hγ hγ0 hγ1 hγ2 end end Source29AnalyticLinkJacobi /- Component: FinitePositiveCofactorRoot.inc -/ namespace Source29FinitePositiveCofactorRoot open MvPolynomial Filter open Source29AnalyticNormalTrace Source29NormalShiftAlgebra open Source29AnalyticTensorNorm open scoped Topology BigOperators noncomputable section variable {I : Type*} [Fintype I] [DecidableEq I] /-- The positive defining root, with an arbitrary finite coordinate index. -/ def definingRoot (P Q : MvPolynomial I ℝ) (k : ℕ) (x : I → ℝ) : ℝ := eval x P * (eval x Q)^((k : ℝ)⁻¹) lemma partial_eval (P : MvPolynomial I ℝ) (x : I → ℝ) (i : I) : coordPartial (fun y => eval y P) i x = eval x (pderiv i P) := by unfold coordPartial rw [Source29QuarticReuse.QuarticPolynomialBasics.fderiv_eval, Source29QuarticReuse.QuarticPolynomialBasics.evalFDeriv_basis] lemma hess_eval (P : MvPolynomial I ℝ) (x : I → ℝ) (i j : I) : hess (fun y => eval y P) x i j = eval x (pderiv i (pderiv j P)) := by have he : coordPartial (fun y => eval y P) j = (fun y => eval y (pderiv j P)) := funext (fun y => partial_eval P y j) change coordPartial (coordPartial (fun y => eval y P) j) i x = _ rw [he, partial_eval] lemma levelOperator_eval (P : MvPolynomial I ℝ) (x : I → ℝ) : levelOperator (fun y => eval y P) x = eval x (Source29QuarticReuse.QuarticMinimal.leadingOperator P) := by simp only [levelOperator, cubicLevel, dot, trace, bilinear, grad, partial_eval, hess_eval, Source29QuarticReuse.QuarticMinimal.leadingOperator, Source29QuarticReuse.QuarticMinimal.laplacian, map_sub, map_mul, map_sum, pow_two] congr 1 apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ ring lemma levelOperator_analyticAt (f : (I → ℝ) → ℝ) (x : I → ℝ) (hf : AnalyticAt ℝ f x) : AnalyticAt ℝ (levelOperator f) x := ((analyticAt_dot (grad f) (grad f) x (fun i => partial_analyticAt f x hf i) (fun i => partial_analyticAt f x hf i)).mul (analyticAt_trace (hess f) x (hess_analyticAt f x hf))).sub (analyticAt_bilinear (hess f) (grad f) (grad f) x (hess_analyticAt f x hf) (fun i => partial_analyticAt f x hf i) (fun i => partial_analyticAt f x hf i)) lemma levelOperator_congr {f g : (I → ℝ) → ℝ} {x : I → ℝ} (he : f =ᶠ[𝓝 x] g) : levelOperator f x = levelOperator g x := by have hg : grad f x = grad g x := by unfold grad coordPartial rw [he.fderiv_eq] have hH : hess f x = hess g x := by funext i j have hfirst : coordPartial f j =ᶠ[𝓝 x] coordPartial g j := (he.fderiv (𝕜 := ℝ)).mono (fun y hy => congrArg (fun D : (I → ℝ) →L[ℝ] ℝ => D (Pi.single j 1)) hy) change fderiv ℝ (coordPartial f j) x (Pi.single i 1) = fderiv ℝ (coordPartial g j) x (Pi.single i 1) exact congrArg (fun D : (I → ℝ) →L[ℝ] ℝ => D (Pi.single i 1)) hfirst.fderiv_eq unfold levelOperator rw [hg, hH] lemma levelOperator_pow (f : (I → ℝ) → ℝ) (x : I → ℝ) (hf : AnalyticAt ℝ f x) (k : ℕ) : levelOperator (fun y => f y^k) x = ((k : ℝ)*f x^(k-1))^3 * levelOperator f x := by let φ : ℝ → ℝ := fun t => t^k have hφ : AnalyticAt ℝ φ (f x) := analyticAt_id.pow k have hg : grad (fun y => φ (f y)) x = fun i => deriv φ (f x) * grad f x i := by funext i exact Source29AnalyticScalarLevelOperator.first_comp φ f x _ hφ hf have hH : hess (fun y => φ (f y)) x = fun i j => deriv φ (f x) * hess f x i j + deriv (deriv φ) (f x) * (grad f x i * grad f x j) := by funext i j exact Source29AnalyticScalarLevelOperator.second_comp φ f x _ _ hφ hf change cubicLevel (grad (fun y => φ (f y)) x) (hess (fun y => φ (f y)) x) = _ rw [hg, hH, Source29AnalyticScalarLevelOperator.cubicLevel_rank_one] have hd : deriv φ (f x) = (k : ℝ)*f x^(k-1) := by simp [φ] rw [hd] rfl lemma levelOperator_zero_of_power (f : (I → ℝ) → ℝ) (x : I → ℝ) (hf : AnalyticAt ℝ f x) (hreg : grad f x ≠ 0) (k : ℕ) (hk : 0 < k) (hpow : ∀ᶠ y in 𝓝 x, levelOperator (fun z => f z^k) y = 0) : ∀ᶠ y in 𝓝 x, levelOperator f y = 0 := by let A : (I → ℝ) → ℝ := fun y => ((k : ℝ)*f y^(k-1))^3 have hA : AnalyticAt ℝ A x := (analyticAt_const.mul (hf.pow (k-1))).pow 3 have hprod : ∀ᶠ y in 𝓝 x, A y * levelOperator f y = 0 := by filter_upwards [hpow, hf.eventually_analyticAt] with y hy hay rwa [levelOperator_pow f y hay k] at hy rcases Source29AnalyticGraphFactor.zero_germ_of_mul_zero A (levelOperator f) x hA (levelOperator_analyticAt f x hf) hprod with hz | hz · have hflat : f =ᶠ[𝓝 x] (fun _ => 0) := by filter_upwards [hz] with y hy have hm : (k : ℝ)*f y^(k-1) = 0 := eq_zero_of_pow_eq_zero hy exact eq_zero_of_pow_eq_zero ((mul_eq_zero.mp hm).resolve_left (Nat.cast_ne_zero.mpr hk.ne')) apply (hreg ?_).elim unfold grad coordPartial rw [hflat.fderiv_eq] funext i simp · exact hz omit [DecidableEq I] in lemma rootUnit_analyticAt (Q : MvPolynomial I ℝ) (k : ℕ) (hk : 0 < k) (x : I → ℝ) (hQ : 0 < eval x Q) : AnalyticAt ℝ (fun y => (eval y Q)^((k : ℝ)⁻¹)) x := AnalyticAt.comp (f := fun y => eval y Q) (Source29PositiveCofactorRoot.positive_root_analyticAt k hk hQ) (Source29PolynomialLinkChart.analyticAt_eval_real Q x) omit [DecidableEq I] in lemma definingRoot_analyticAt (P Q : MvPolynomial I ℝ) (k : ℕ) (hk : 0 < k) (x : I → ℝ) (hQ : 0 < eval x Q) : AnalyticAt ℝ (definingRoot P Q k) x := (Source29PolynomialLinkChart.analyticAt_eval_real P x).mul (rootUnit_analyticAt Q k hk x hQ) omit [Fintype I] [DecidableEq I] in lemma definingRoot_pow (P Q : MvPolynomial I ℝ) (k : ℕ) (hk : 0 < k) (x : I → ℝ) (hQ : 0 < eval x Q) : definingRoot P Q k x ^ k = eval x (P^k*Q) := by simp only [definingRoot, mul_pow, map_mul, map_pow, Real.rpow_inv_natCast_pow hQ.le hk.ne'] lemma definingRoot_gradient (P Q : MvPolynomial I ℝ) (k : ℕ) (hk : 0 < k) (x : I → ℝ) (hP : eval x P = 0) (hQ : 0 < eval x Q) : grad (definingRoot P Q k) x = fun i => (eval x Q)^((k : ℝ)⁻¹) * eval x (pderiv i P) := by funext i unfold grad coordPartial definingRoot rw [fderiv_fun_mul (Source29PolynomialLinkChart.analyticAt_eval_real P x).differentiableAt (rootUnit_analyticAt Q k hk x hQ).differentiableAt] simp only [hP, zero_smul, zero_add, smul_apply, smul_eq_mul] rw [Source29QuarticReuse.QuarticPolynomialBasics.fderiv_eval, Source29QuarticReuse.QuarticPolynomialBasics.evalFDeriv_basis] /-- A finite-index version of the positive-root PDE inheritance. -/ theorem definingRoot_levelOperator_zero (P Q : MvPolynomial I ℝ) (k : ℕ) (hk : 0 < k) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator (P^k*Q) = 0) (x : I → ℝ) (hP : eval x P = 0) (hQ : 0 < eval x Q) (hreg : (fun i => eval x (pderiv i P)) ≠ 0) : ∀ᶠ y in 𝓝 x, levelOperator (definingRoot P Q k) y = 0 := by have hn : grad (definingRoot P Q k) x ≠ 0 := by rw [definingRoot_gradient P Q k hk x hP hQ] intro hz apply hreg funext i exact (mul_eq_zero.mp (congrFun hz i)).resolve_left (Real.rpow_pos_of_pos hQ _).ne' have he : (fun y => definingRoot P Q k y ^ k) =ᶠ[𝓝 x] (fun y => eval y (P^k*Q)) := by filter_upwards [(Source29PolynomialLinkChart.analyticAt_eval_real Q x).continuousAt.eventually (lt_mem_nhds hQ)] with y hy exact definingRoot_pow P Q k hk y hy apply levelOperator_zero_of_power _ x (definingRoot_analyticAt P Q k hk x hQ) hn k hk filter_upwards [he.eventuallyEq_nhds] with y hy rw [levelOperator_congr hy, levelOperator_eval, hF, map_zero] omit [Fintype I] [DecidableEq I] in lemma eval_smul_pos (Q : MvPolynomial I ℝ) (q : ℕ) (hQ : Q.IsHomogeneous q) (x : I → ℝ) (hx : 0 < eval x Q) (t : ℝ) (ht : 0 < t) : 0 < eval (t • x) Q := by rw [show t • x = fun i => t*x i from rfl, Source29QuarticReuse.QuarticNormalization.eval_scale_of_isHomogeneous Q q hQ x t] exact mul_pos (pow_pos ht q) hx omit [Fintype I] [DecidableEq I] in lemma definingRoot_smul (P Q : MvPolynomial I ℝ) (p q k : ℕ) (hP : P.IsHomogeneous p) (hQ : Q.IsHomogeneous q) (x : I → ℝ) (hx : 0 < eval x Q) (t : ℝ) (ht : 0 < t) : definingRoot P Q k (t • x) = t^((p : ℝ)+(q : ℝ)/(k : ℝ)) * definingRoot P Q k x := by simp only [definingRoot] rw [show t • x = fun i => t*x i from rfl, Source29QuarticReuse.QuarticNormalization.eval_scale_of_isHomogeneous P p hP x t, Source29QuarticReuse.QuarticNormalization.eval_scale_of_isHomogeneous Q q hQ x t, Real.mul_rpow (pow_nonneg ht.le q) hx.le, Real.rpow_add ht, Real.rpow_natCast, div_eq_mul_inv, Real.rpow_natCast_mul ht.le] ring /-- The profile is the inverse kth root of the leading normal coefficient. -/ theorem inverse_gradient_profile_eq (P Q : MvPolynomial I ℝ) (k : ℕ) (hk : 0 < k) (x : I → ℝ) (hP : eval x P = 0) (hQ : 0 < eval x Q) (hreg : (fun i => eval x (pderiv i P)) ≠ 0) : (tensorNorm (grad (definingRoot P Q k) x))⁻¹ = (tensorNorm (fun i => eval x (pderiv i P))^k * eval x Q)^(-((k : ℝ)⁻¹)) := by have hn := tensorNorm_pos hreg rw [definingRoot_gradient P Q k hk x hP hQ, Source29PositiveCofactorRoot.tensorNorm_scale_pos _ _ (Real.rpow_pos_of_pos hQ _), Real.rpow_neg (mul_nonneg (pow_nonneg hn.le k) hQ.le), Real.mul_rpow (pow_nonneg hn.le k) hQ.le, Real.pow_rpow_inv_natCast hn.le hk.ne'] rw [mul_comm] end end Source29FinitePositiveCofactorRoot /- Component: AnalyticPositiveRootJacobi.inc -/ namespace Source29AnalyticPositiveRootJacobi open Filter MvPolynomial Source29AnalyticNormalTrace open Source29PolynomialLinkChart (base) open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Actual analytic link curves and the Jacobi equation for their positive inverse-gradient profile. The acceleration is that of the spherical link. -/ structure LinkJacobiData (f : (Option (Option ι) → ℝ) → ℝ) (D g : ℝ) where curve : ι → Option (Option ι) → ℝ → ℝ analytic : ∀ i j, AnalyticAt ℝ (curve i j) 0 initial : ∀ i j, curve i j 0 = base j velocity : ∀ i j, deriv (curve i j) 0 = Pi.single (M := fun _ => ℝ) (some (some i)) 1 j acceleration : ∀ i j, deriv (deriv (curve i j)) 0 = -Pi.single (M := fun _ => ℝ) (some none) 1 j - (hess f base (some (some i)) (some (some i))/g) * Pi.single (M := fun _ => ℝ) none 1 j level_sphere : ∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), f (fun j => curve i j t) = 0 ∧ (∑ j, (curve i j t)^2) = 1 profile_analytic : ∀ i, AnalyticAt ℝ (fun t => (Source29AnalyticTensorNorm.tensorNorm (grad f (fun j => curve i j t)))⁻¹) 0 profile_positive : ∀ i, 0 < (Source29AnalyticTensorNorm.tensorNorm (grad f (fun j => curve i j 0)))⁻¹ jacobi : (∑ i, deriv (deriv (fun t => (Source29AnalyticTensorNorm.tensorNorm (grad f (fun j => curve i j t)))⁻¹)) 0) + ((∑ i, ∑ j, (hess f base (some (some j)) (some (some i)))^2)/g^2 + (D-1)*(D-(Fintype.card ι : ℝ))) * g⁻¹ = 0 /-- An analytic homogeneous minimal level function produces the actual positive Jacobi profile, without assumptions about the existence of curves. -/ theorem exists_link_jacobi_data (f : (Option (Option ι) → ℝ) → ℝ) (D g : ℝ) (hg : 0 < g) (U : Set (Option (Option ι) → ℝ)) (hU : IsOpen U) (hx : base ∈ U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (hzero : f base = 0) (hL : ∀ᶠ y in 𝓝 base, levelOperator f y = 0) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) : Nonempty (LinkJacobiData f D g) := by obtain ⟨γ,hγ,hγ0,hγ1,hγ2,hγlevel⟩ := Source29AnalyticLinkCurveJets.exists_link_curves_with_jets f (hf base hx) g hg.ne' hzero hgn hgt have hn : grad f base ≠ 0 := by intro he have he' := congrFun he none rw [hgn] at he' exact hg.ne' he' have ha : AnalyticAt ℝ (fun y => (Source29AnalyticTensorNorm.tensorNorm (grad f y))⁻¹) base := (Source29AnalyticTensorNorm.tensorNorm_analyticAt (grad f) base (fun j => partial_analyticAt f base (hf base hx) j) hn).inv (Source29AnalyticTensorNorm.tensorNorm_pos hn).ne' refine ⟨⟨γ, hγ, hγ0, hγ1, hγ2, hγlevel, ?_, ?_, ?_⟩⟩ · intro i have he : (fun j => γ i j 0) = (base : Option (Option ι) → ℝ) := funext (hγ0 i) exact AnalyticAt.comp (f := fun t j => γ i j t) (he.symm ▸ ha) (AnalyticAt.pi (hγ i)) · intro i have he : (fun j => γ i j 0) = (base : Option (Option ι) → ℝ) := funext (hγ0 i) rw [he] exact inv_pos.mpr (Source29AnalyticTensorNorm.tensorNorm_pos hn) · exact Source29AnalyticLinkJacobi.jacobi_of_homogeneous_link_curve_jets f D g hg U hU hx hcone hf hhom hL hgn hgt γ hγ hγ0 hγ1 hγ2 /-- Applying the analytic Jacobi theorem to the positive kth root of P^kQ. The cubic equation is required for P^kQ itself, and no equation for P is assumed. -/ theorem definingRoot_link_jacobi (P Q : MvPolynomial (Option (Option ι)) ℝ) (p q k : ℕ) (hk : 0 < k) (hP : P.IsHomogeneous p) (hQ : Q.IsHomogeneous q) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator (P^k*Q) = 0) (hzero : eval base P = 0) (hpos : 0 < eval base Q) (a : ℝ) (ha : 0 < a) (hpn : eval base (pderiv none P) = a) (hpt : ∀ j, eval base (pderiv (some j) P) = 0) : Nonempty (LinkJacobiData (Source29FinitePositiveCofactorRoot.definingRoot P Q k) ((p : ℝ)+(q : ℝ)/(k : ℝ)) ((eval base Q)^((k : ℝ)⁻¹)*a)) := by let f := Source29FinitePositiveCofactorRoot.definingRoot P Q k let U : Set (Option (Option ι) → ℝ) := {x | 0 < eval x Q} have hU : IsOpen U := isOpen_lt continuous_const (show Continuous (fun x => eval x Q) from continuous_iff_continuousAt.mpr (fun x => (Source29PolynomialLinkChart.analyticAt_eval_real Q x).continuousAt)) have hreg : (fun i => eval base (pderiv i P)) ≠ 0 := by intro he have he' := congrFun he none rw [hpn] at he' exact ha.ne' he' have hg : 0 < (eval base Q)^((k : ℝ)⁻¹)*a := mul_pos (Real.rpow_pos_of_pos hpos _) ha have hgn : grad f base none = (eval base Q)^((k : ℝ)⁻¹)*a := by rw [Source29FinitePositiveCofactorRoot.definingRoot_gradient P Q k hk base hzero hpos] simp only [hpn] have hgt : ∀ j, grad f base (some j) = 0 := by intro j rw [Source29FinitePositiveCofactorRoot.definingRoot_gradient P Q k hk base hzero hpos] simp only [hpt, mul_zero] apply exists_link_jacobi_data f _ _ hg U hU hpos (fun x hx t ht => Source29FinitePositiveCofactorRoot.eval_smul_pos Q q hQ x hx t ht) (fun x hx => Source29FinitePositiveCofactorRoot.definingRoot_analyticAt P Q k hk x hx) (fun x hx t ht => Source29FinitePositiveCofactorRoot.definingRoot_smul P Q p q k hP hQ x hx t ht) _ (Source29FinitePositiveCofactorRoot.definingRoot_levelOperator_zero P Q k hk hF base hzero hpos hreg) hgn hgt change eval base P * _ = 0 rw [hzero, zero_mul] end end Source29AnalyticPositiveRootJacobi /- Component: AnalyticSecondTrace.inc -/ namespace Source29AnalyticSecondTrace open Filter Source29NormalShiftAlgebra Source29AnalyticNormalTrace open Source29NormalShiftDerivatives (second) open Source29FiniteJetConvergence (first_mul first_sum second_mul second_sum) open scoped Topology BigOperators noncomputable section section ArrayCalculus variable {E I : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [Fintype I] lemma second_sub (f g : E → ℝ) (x u v : E) (hf : AnalyticAt ℝ f x) (hg : AnalyticAt ℝ g x) : second (fun y => f y - g y) x u v = second f x u v - second g x u v := by have he : (fun y => fderiv ℝ (fun z => f z - g z) y v) =ᶠ[𝓝 x] (fun y => fderiv ℝ f y v - fderiv ℝ g y v) := by filter_upwards [hf.eventually_analyticAt, hg.eventually_analyticAt] with y hyf hyg rw [fderiv_fun_sub hyf.differentiableAt hyg.differentiableAt] rfl unfold second rw [he.fderiv_eq, fderiv_fun_sub (Source29NewtonRootHarmonic.analyticAt_directional f x v hf).differentiableAt (Source29NewtonRootHarmonic.analyticAt_directional g x v hg).differentiableAt] rfl lemma second_dot (V W : E → I → ℝ) (x u v : E) (hV : ∀ i, AnalyticAt ℝ (fun y => V y i) x) (hW : ∀ i, AnalyticAt ℝ (fun y => W y i) x) : second (fun y => dot (V y) (W y)) x u v = dot (fun i => second (fun y => V y i) x u v) (W x) + dot (V x) (fun i => second (fun y => W y i) x u v) + dot (fun i => fderiv ℝ (fun y => V y i) x u) (fun i => fderiv ℝ (fun y => W y i) x v) + dot (fun i => fderiv ℝ (fun y => V y i) x v) (fun i => fderiv ℝ (fun y => W y i) x u) := by unfold dot rw [second_sum Finset.univ (fun i y => V y i * W y i) x u v (fun i _ => (hV i).mul (hW i))] simp_rw [second_mul (fun y => V y _) (fun y => W y _) x u v (hV _) (hW _)] simp only [← Finset.sum_add_distrib] apply Finset.sum_congr rfl intro i _ ring lemma second_trace (H : E → I → I → ℝ) (x u v : E) (hH : ∀ i j, AnalyticAt ℝ (fun y => H y i j) x) : second (fun y => trace (H y)) x u v = trace (fun i j => second (fun y => H y i j) x u v) := second_sum Finset.univ (fun i y => H y i i) x u v (fun i _ => hH i i) lemma second_bilinear (H : E → I → I → ℝ) (V W : E → I → ℝ) (x u v : E) (hH : ∀ i j, AnalyticAt ℝ (fun y => H y i j) x) (hV : ∀ i, AnalyticAt ℝ (fun y => V y i) x) (hW : ∀ i, AnalyticAt ℝ (fun y => W y i) x) : second (fun y => bilinear (H y) (V y) (W y)) x u v = bilinear (fun i j => second (fun y => H y i j) x u v) (V x) (W x) + bilinear (H x) (fun i => second (fun y => V y i) x u v) (W x) + bilinear (H x) (V x) (fun i => second (fun y => W y i) x u v) + bilinear (fun i j => fderiv ℝ (fun y => H y i j) x u) (fun i => fderiv ℝ (fun y => V y i) x v) (W x) + bilinear (fun i j => fderiv ℝ (fun y => H y i j) x v) (fun i => fderiv ℝ (fun y => V y i) x u) (W x) + bilinear (fun i j => fderiv ℝ (fun y => H y i j) x u) (V x) (fun i => fderiv ℝ (fun y => W y i) x v) + bilinear (fun i j => fderiv ℝ (fun y => H y i j) x v) (V x) (fun i => fderiv ℝ (fun y => W y i) x u) + bilinear (H x) (fun i => fderiv ℝ (fun y => V y i) x u) (fun i => fderiv ℝ (fun y => W y i) x v) + bilinear (H x) (fun i => fderiv ℝ (fun y => V y i) x v) (fun i => fderiv ℝ (fun y => W y i) x u) := by have hi (i : I) : second (fun y => ∑ j : I, H y i j * V y i * W y j) x u v = ∑ j : I, second (fun y => H y i j * V y i * W y j) x u v := second_sum Finset.univ (fun j y => H y i j * V y i * W y j) x u v (fun j _ => ((hH i j).mul (hV i)).mul (hW j)) unfold bilinear rw [second_sum Finset.univ (fun i y => ∑ j : I, H y i j * V y i * W y j) x u v (fun i _ => Finset.analyticAt_fun_sum _ (fun j _ => ((hH i j).mul (hV i)).mul (hW j)))] simp only [hi, ← Finset.sum_add_distrib] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ rw [second_mul (fun y => H y i j * V y i) (fun y => W y j) x u v ((hH i j).mul (hV i)) (hW j), second_mul (fun y => H y i j) (fun y => V y i) x u v (hH i j) (hV i), first_mul (fun y => H y i j) (fun y => V y i) x u (hH i j) (hV i), first_mul (fun y => H y i j) (fun y => V y i) x v (hH i j) (hV i)] ring end ArrayCalculus section Coordinates variable {I : Type*} [Fintype I] [DecidableEq I] def fourth (f : (I → ℝ) → ℝ) (x : I → ℝ) (a b c d : I) : ℝ := coordPartial (coordPartial (coordPartial (coordPartial f d) c) b) a x lemma fourth_swap12 (f : (I → ℝ) → ℝ) (x : I → ℝ) (hf : AnalyticAt ℝ f x) (a b c d : I) : fourth f x a b c d = fourth f x b a c d := hess_symm _ x (hess_analyticAt f x hf c d) a b lemma fourth_swap23 (f : (I → ℝ) → ℝ) (x : I → ℝ) (hf : AnalyticAt ℝ f x) (a b c d : I) : fourth f x a b c d = fourth f x a c b d := third_swap23 (coordPartial f d) x (partial_analyticAt f x hf d) a b c lemma fourth_swap34 (f : (I → ℝ) → ℝ) (x : I → ℝ) (hf : AnalyticAt ℝ f x) (a b c d : I) : fourth f x a b c d = fourth f x a b d c := by have he : (fun y => third f y b c d) =ᶠ[𝓝 x] (fun y => third f y b d c) := hf.eventually_analyticAt.mono (fun y hy => third_swap23 f y hy b c d) exact congrArg (fun D : (I → ℝ) →L[ℝ] ℝ => D (Pi.single a 1)) he.fderiv_eq end Coordinates section NormalTrace variable {I : Type*} [Fintype I] [DecidableEq I] /-- Twice differentiating the local analytic cubic equation yields the fourth-order trace needed by the normalized Simons tensor. -/ theorem second_derivative_trace (f : (Option I → ℝ) → ℝ) (x : Option I → ℝ) (g : ℝ) (hg : g ≠ 0) (hf : AnalyticAt ℝ f x) (hL : ∀ᶠ y in 𝓝 x, levelOperator f y = 0) (hgn : grad f x none = g) (hgt : ∀ i, grad f x (some i) = 0) (a b : Option I) : g^2 * (∑ i, fourth f x a b (some i) (some i)) = 2 * (∑ i, ∑ j, hess f x a (some i) * hess f x b (some j) * hess f x (some i) (some j)) - 2 * hess f x none none * (∑ i, hess f x a (some i) * hess f x b (some i)) + 2 * g * (∑ i, (third f x a b (some i) * hess f x none (some i) + hess f x a (some i) * third f x b none (some i) + hess f x b (some i) * third f x a none (some i))) - 2 * hess f x a none * (∑ i, hess f x b (some i) * hess f x none (some i)) - 2 * hess f x b none * (∑ i, hess f x a (some i) * hess f x none (some i)) := by have hV : ∀ i, AnalyticAt ℝ (fun y => grad f y i) x := fun i => partial_analyticAt f x hf i have hH : ∀ i j, AnalyticAt ℝ (fun y => hess f y i j) x := hess_analyticAt f x hf have ht := tangential_trace_zero f x g hg hL.self_of_nhds hgn hgt have ha := derivative_trace f x g hg hf hL hgn hgt a have hb := derivative_trace f x g hg hf hL hgn hgt b have he : second (levelOperator f) x (Pi.single a 1) (Pi.single b 1) = 0 := by have heq : levelOperator f =ᶠ[𝓝 x] (fun _ => 0) := hL have hd : (fun y => fderiv ℝ (levelOperator f) y (Pi.single b 1)) =ᶠ[𝓝 x] (fun _ => 0) := by filter_upwards [heq.fderiv (𝕜 := ℝ)] with y hy rw [hy] simp unfold second rw [hd.fderiv_eq] simp unfold levelOperator cubicLevel at he rw [second_sub (fun y => dot (grad f y) (grad f y) * trace (hess f y)) (fun y => bilinear (hess f y) (grad f y) (grad f y)) x (Pi.single a 1) (Pi.single b 1) ((analyticAt_dot _ _ _ hV hV).mul (analyticAt_trace _ _ hH)) (analyticAt_bilinear _ _ _ _ hH hV hV)] at he rw [second_mul (fun y => dot (grad f y) (grad f y)) (fun y => trace (hess f y)) x (Pi.single a 1) (Pi.single b 1) (analyticAt_dot _ _ _ hV hV) (analyticAt_trace _ _ hH), second_dot _ _ _ _ _ hV hV, second_trace _ _ _ _ hH, first_dot _ _ _ _ hV hV, first_trace _ _ _ hH, first_dot _ _ _ _ hV hV, first_trace _ _ _ hH, second_bilinear _ _ _ _ _ _ hH hV hV] at he change dot (grad f x) (grad f x) * trace (fourth f x a b) + trace (hess f x) * (dot (third f x a b) (grad f x) + dot (grad f x) (third f x a b) + dot (hess f x a) (hess f x b) + dot (hess f x b) (hess f x a)) + (dot (hess f x a) (grad f x) + dot (grad f x) (hess f x a)) * trace (third f x b) + trace (third f x a) * (dot (hess f x b) (grad f x) + dot (grad f x) (hess f x b)) - (bilinear (fourth f x a b) (grad f x) (grad f x) + bilinear (hess f x) (third f x a b) (grad f x) + bilinear (hess f x) (grad f x) (third f x a b) + bilinear (third f x a) (hess f x b) (grad f x) + bilinear (third f x b) (hess f x a) (grad f x) + bilinear (third f x a) (grad f x) (hess f x b) + bilinear (third f x b) (grad f x) (hess f x a) + bilinear (hess f x) (hess f x a) (hess f x b) + bilinear (hess f x) (hess f x b) (hess f x a)) = 0 at he have hs : ∀ i, hess f x (some i) none = hess f x none (some i) := fun i => hess_symm f x hf _ _ have hta : ∀ i, third f x a (some i) none = third f x a none (some i) := fun i => third_swap23 f x hf _ _ _ have htb : ∀ i, third f x b (some i) none = third f x b none (some i) := fun i => third_swap23 f x hf _ _ _ simp only [dot, trace, bilinear, Fintype.sum_option, hgn, hgt, hs, hta, htb, ht, zero_mul, mul_zero, Finset.sum_const_zero, add_zero] at he simp only [mul_add, add_mul, Finset.sum_add_distrib, ← Finset.sum_mul] at he ring_nf at he simp only [mul_assoc, ← Finset.mul_sum] at he have hcross : (∑ i, ∑ j, hess f x (some i) (some j) * (hess f x b (some i) * hess f x a (some j))) = ∑ i, ∑ j, hess f x (some i) (some j) * (hess f x b (some j) * hess f x a (some i)) := by rw [Finset.sum_comm] apply Finset.sum_congr rfl intro i _ apply Finset.sum_congr rfl intro j _ rw [hess_symm f x hf (some j) (some i)] simp only [mul_comm, mul_left_comm, mul_assoc] at he ha hb hcross ⊢ rw [hcross] at he simp only [Finset.sum_add_distrib] linear_combination he - 2 * hess f x a none * hb - 2 * hess f x b none * ha end NormalTrace end end Source29AnalyticSecondTrace /- Component: AnalyticNormalizedHessianCurve.inc -/ namespace Source29AnalyticNormalizedHessianCurve open Filter Source29AnalyticNormalTrace Source29AnalyticTensorNorm open Source29AnalyticCurveCoordinateJets open Source29PolynomialLinkChart (Ambient base) open Source29NormalizedLinkJets (tangent) open scoped Topology BigOperators noncomputable section section Coordinates variable {I : Type*} [Fintype I] [DecidableEq I] def profile (f : (I → ℝ) → ℝ) (x : I → ℝ) : ℝ := (tensorNorm (grad f x))⁻¹ def normalizedHessian (f : (I → ℝ) → ℝ) (C : ℝ → I → ℝ) (a b : I) (t : ℝ) : ℝ := profile f (C t) * hess f (C t) a b theorem profile_pos (f : (I → ℝ) → ℝ) (x : I → ℝ) (hreg : grad f x ≠ 0) : 0 < profile f x := inv_pos.mpr (tensorNorm_pos hreg) theorem profile_analyticAt (f : (I → ℝ) → ℝ) (x : I → ℝ) (hf : AnalyticAt ℝ f x) (hreg : grad f x ≠ 0) : AnalyticAt ℝ (profile f) x := (tensorNorm_analyticAt (grad f) x (partial_analyticAt f x hf) hreg).inv (tensorNorm_pos hreg).ne' theorem normalizedHessian_analyticAt (f : (I → ℝ) → ℝ) (C : ℝ → I → ℝ) (hf : AnalyticAt ℝ f (C 0)) (hC : AnalyticAt ℝ C 0) (hreg : grad f (C 0) ≠ 0) (a b : I) : AnalyticAt ℝ (normalizedHessian f C a b) 0 := ((profile_analyticAt f (C 0) hf hreg).comp hC).mul ((hess_analyticAt f (C 0) hf a b).comp hC) end Coordinates variable {ι : Type*} [Fintype ι] [DecidableEq ι] omit [Fintype ι] in theorem regular_at_base (f : Ambient ι → ℝ) (g : ℝ) (hg : g ≠ 0) (hgn : grad f base none = g) : grad f base ≠ 0 := by intro he have hn := congrFun he none exact hg (by simpa only [hgn, Pi.zero_apply] using hn) theorem profile_at_base (f : Ambient ι → ℝ) (g : ℝ) (hg : 0 < g) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) : profile f base = g⁻¹ := by simp [profile, tensorNorm, Fintype.sum_option, hgn, hgt, Real.sqrt_sq hg.le] theorem profile_tangent_deriv (f : Ambient ι → ℝ) (g : ℝ) (hg : 0 < g) (hf : AnalyticAt ℝ f base) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (i : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) : deriv (fun t => profile f (C t)) 0 = -hess f base (tangent i) none / g^2 := by let G := fun a t => grad f (C t) a let q := fun t => tensorNorm (fun a => G a t) have hG : ∀ a, AnalyticAt ℝ (G a) 0 := fun a => ((hC0.symm ▸ partial_analyticAt f base hf a).comp hC) have hq0 : q 0 = g := by simp [q, G, hC0, tensorNorm, Fintype.sum_option, hgn, hgt, Real.sqrt_sq hg.le] have hreg : (fun a => G a 0) ≠ 0 := by simpa only [G, hC0] using regular_at_base f g hg.ne' hgn have hq : AnalyticAt ℝ q 0 := tensorNorm_analyticAt _ _ hG hreg have hnorm := (Source29AnalyticNormDerivatives.norm_first_second q G hq hG (Eventually.of_forall (fun t => tensorNorm_sq (fun a => G a t)))).1 have hgrad : ∀ a, G a 0 = grad f base a := by intro a; simp only [G, hC0] simp only [hq0, hgrad, Fintype.sum_option, hgn, hgt, zero_mul, Finset.sum_const_zero, add_zero] at hnorm have hq1 : deriv q 0 = hess f base (tangent i) none := by rw [mul_left_cancel₀ hg.ne' hnorm] exact coordinate_velocity_first (coordPartial f none) (fun a t => C t a) base (tangent i) (partial_analyticAt f base hf none) (analyticAt_pi_iff.mp hC) (fun a => congrFun hC0 a) hC1 change deriv (fun t => (q t)⁻¹) 0 = _ have he := (hq.differentiableAt.hasDerivAt.inv (by simpa only [hq0] using hg.ne')).deriv simp only [Pi.inv_def] at he rw [he, hq0, hq1] theorem normalizedHessian_zero (f : Ambient ι → ℝ) (g : ℝ) (hg : 0 < g) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ℝ → Ambient ι) (hC0 : C 0 = base) (a b : Option (Option ι)) : normalizedHessian f C a b 0 = hess f base a b / g := by rw [normalizedHessian, hC0, profile_at_base f g hg hgn hgt] ring theorem normalizedHessian_first (f : Ambient ι → ℝ) (g : ℝ) (hg : 0 < g) (hf : AnalyticAt ℝ f base) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (i : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (a b : Option (Option ι)) : deriv (normalizedHessian f C a b) 0 = (third f base (tangent i) a b - hess f base (tangent i) none * hess f base a b / g) / g := by have hφ := ((hC0.symm ▸ profile_analyticAt f base hf (regular_at_base f g hg.ne' hgn)).comp hC) have hH := ((hC0.symm ▸ hess_analyticAt f base hf a b).comp hC) have he := (hφ.differentiableAt.hasDerivAt.mul hH.differentiableAt.hasDerivAt).deriv simp only [Pi.mul_def, Function.comp_def] at he unfold normalizedHessian rw [he, profile_tangent_deriv f g hg hf hgn hgt C hC hC0 i hC1, coordinate_velocity_first (fun x => hess f x a b) (fun c t => C t c) base (tangent i) (hess_analyticAt f base hf a b) (analyticAt_pi_iff.mp hC) (fun c => congrFun hC0 c) hC1, hC0, profile_at_base f g hg hgn hgt] change -hess f base (tangent i) none / g^2 * hess f base a b + g⁻¹ * third f base (tangent i) a b = _ field_simp ring /-- The second derivative of the actual normalized Hessian along a link curve; the radial third jet is supplied directly by real homogeneity. -/ theorem normalizedHessian_second (f : Ambient ι → ℝ) (D g : ℝ) (hg : 0 < g) (hf : AnalyticAt ℝ f base) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (i : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (hC2 : ∀ a, deriv (deriv (fun t => C t a)) 0 = -base a - (hess f base (tangent i) (tangent i) / g) * Pi.single (M := fun _ => ℝ) none 1 a) (a b : Option (Option ι)) (hrad : third f base (some none) a b = (D-2)*hess f base a b) : deriv (deriv (normalizedHessian f C a b)) 0 = hess f base a b * deriv (deriv (fun t => profile f (C t))) 0 - 2 * hess f base (tangent i) none * third f base (tangent i) a b / g^2 + (coordPartial (fun x => third f x (tangent i) a b) (tangent i) base - (D-2)*hess f base a b - (hess f base (tangent i) (tangent i)/g)*third f base none a b) / g := by let H := fun t => hess f (C t) a b have hH : AnalyticAt ℝ H 0 := (hC0.symm ▸ hess_analyticAt f base hf a b).comp hC have hH0 : H 0 = hess f base a b := by simp only [H, hC0] have hH1 : deriv H 0 = third f base (tangent i) a b := coordinate_velocity_first (fun x => hess f x a b) (fun c t => C t c) base (tangent i) (hess_analyticAt f base hf a b) (analyticAt_pi_iff.mp hC) (fun c => congrFun hC0 c) hC1 have hH2 : deriv (deriv H) 0 = coordPartial (fun x => third f x (tangent i) a b) (tangent i) base - (D-2)*hess f base a b - (hess f base (tangent i) (tangent i)/g)*third f base none a b := by have he := coordinate_velocity_second (fun x => hess f x a b) (fun c t => C t c) base (tangent i) (hess_analyticAt f base hf a b) (analyticAt_pi_iff.mp hC) (fun c => congrFun hC0 c) hC1 change deriv (deriv H) 0 = coordPartial (fun x => third f x (tangent i) a b) (tangent i) base + ∑ c, third f base c a b * deriv (deriv (fun t => C t c)) 0 at he rw [he] have hb : ∀ c, (base : Ambient ι) c = if c = some none then 1 else 0 := by intro c simp [base, Pi.single_apply] simp only [hC2, hb, Pi.single_apply, mul_sub, mul_neg, mul_ite, mul_one, mul_zero, Finset.sum_sub_distrib, Finset.sum_neg_distrib, Finset.sum_ite_eq', Finset.mem_univ, ite_true] rw [hrad] ring have hφ := (hC0.symm ▸ profile_analyticAt f base hf (regular_at_base f g hg.ne' hgn)).comp hC change deriv (deriv (fun t => profile f (C t) * H t)) 0 = _ rw [Source29AnalyticInverseNorm.second_deriv_product (fun t => profile f (C t)) H hφ hH, hH0, hH1, hH2, profile_tangent_deriv f g hg hf hgn hgt C hC hC0 i hC1, hC0, profile_at_base f g hg hgn hgt] ring end end Source29AnalyticNormalizedHessianCurve /- Component: ClosestPairStationarity.inc -/ namespace Source29ClosestPairStationarity open Filter Source29SynchronizedCurveFrankel Source29AnalyticNormDerivatives open scoped Topology BigOperators Matrix noncomputable section variable {κ : Type*} [Fintype κ] /-- Differentiating the actual local sphere constraint makes every curve velocity perpendicular to its base point. -/ theorem velocity_orthogonal_base (C : ℝ → κ → ℝ) (x : κ → ℝ) (hC : ∀ a, AnalyticAt ℝ (fun t ↦ C t a) 0) (hC0 : C 0 = x) (hunit : ∀ᶠ t in 𝓝 0, ∑ a, (C t a)^2 = 1) : x ⬝ᵥ (fun a ↦ deriv (fun t ↦ C t a) 0) = 0 := by have heq : (fun t ↦ ∑ a, (C t a)^2) =ᶠ[𝓝 0] (fun _ ↦ (1 : ℝ)) := hunit have hd := heq.deriv_eq rw [first_deriv_sum (fun a t ↦ (C t a)^2) (fun a ↦ (hC a).pow 2), deriv_const] at hd simp_rw [first_deriv_square _ (hC _),hC0] at hd have he : (∑ a, 2*x a*deriv (fun t ↦ C t a) 0) = 2*(x ⬝ᵥ (fun a ↦ deriv (fun t ↦ C t a) 0)) := by simp only [dotProduct,Finset.mul_sum,mul_assoc] rw [he] at hd linarith /-- The first variation of distance at a closest pair makes the velocity perpendicular to the opposite endpoint as well. -/ theorem velocity_orthogonal_opposite (C : ℝ → κ → ℝ) (x y : κ → ℝ) (hC : ∀ a, AnalyticAt ℝ (fun t ↦ C t a) 0) (hC0 : C 0 = x) (hunit : ∀ᶠ t in 𝓝 0, ∑ a, (C t a)^2 = 1) (hmin : IsLocalMin (fun t ↦ squaredDistance (C t) y) 0) : y ⬝ᵥ (fun a ↦ deriv (fun t ↦ C t a) 0) = 0 := by have hd := hmin.deriv_eq_zero change deriv (fun t ↦ ∑ a, (C t a-y a)^2) 0 = 0 at hd rw [first_deriv_sum (fun a t ↦ (C t a-y a)^2) (fun a ↦ ((hC a).sub analyticAt_const).pow 2)] at hd have hder (a : κ) : deriv (fun t ↦ C t a-y a) 0 = deriv (fun t ↦ C t a) 0 := by simpa only [sub_zero] using ((hC a).differentiableAt.hasDerivAt.sub_const (y a)).deriv have hdj (a : κ) : deriv (fun t ↦ (C t a-y a)^2) 0 = 2*(x a-y a)*deriv (fun t ↦ C t a) 0 := by rw [first_deriv_square (fun t ↦ C t a-y a) ((hC a).sub analyticAt_const),hder,hC0] simp_rw [hdj] at hd have he : (∑ a, 2*(x a-y a)*deriv (fun t ↦ C t a) 0) = 2*((x ⬝ᵥ (fun a ↦ deriv (fun t ↦ C t a) 0))- (y ⬝ᵥ (fun a ↦ deriv (fun t ↦ C t a) 0))) := by simp only [dotProduct,← Finset.sum_sub_distrib,Finset.mul_sum] apply Finset.sum_congr rfl intro a _ ring rw [he,velocity_orthogonal_base C x hC hC0 hunit] at hd linarith /-- Set-level stationarity uses only actual local curve membership. -/ theorem closest_pair_velocity (S T : Set (κ → ℝ)) (x y : κ → ℝ) (hy : y ∈ T) (hclosest : ∀ z ∈ S, ∀ w ∈ T, squaredDistance x y ≤ squaredDistance z w) (C : ℝ → κ → ℝ) (hC : ∀ a, AnalyticAt ℝ (fun t ↦ C t a) 0) (hC0 : C 0 = x) (hunit : ∀ᶠ t in 𝓝 0, ∑ a, (C t a)^2 = 1) (hmem : ∀ᶠ t in 𝓝 0, C t ∈ S) : x ⬝ᵥ (fun a ↦ deriv (fun t ↦ C t a) 0) = 0 ∧ y ⬝ᵥ (fun a ↦ deriv (fun t ↦ C t a) 0) = 0 := by refine ⟨velocity_orthogonal_base C x hC hC0 hunit, velocity_orthogonal_opposite C x y hC hC0 hunit ?_⟩ change ∀ᶠ t in 𝓝 0, squaredDistance (C 0) y ≤ squaredDistance (C t) y filter_upwards [hmem] with t ht simpa only [hC0] using hclosest (C t) ht y hy variable [DecidableEq κ] def column (U : Matrix κ κ ℝ) (i : κ) : κ → ℝ := fun a ↦ U a i lemma column_dot (U : Matrix κ κ ℝ) (hU : U.transpose*U = 1) (i j : κ) : column U i ⬝ᵥ column U j = if i=j then 1 else 0 := by have h := congrArg (fun M : Matrix κ κ ℝ ↦ M i j) hU simpa only [column,dotProduct,Matrix.mul_apply,Matrix.transpose_apply,Matrix.one_apply] using h variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Vanishing tangent coordinates in an orthogonal frame puts the opposite endpoint in the radial-normal plane, with explicit coefficients. -/ theorem radial_normal_decomposition (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (hU : U*U.transpose = 1) (y : Option (Option ι) → ℝ) (hy : ∀ i, column U (some (some i)) ⬝ᵥ y = 0) : y = (column U (some none) ⬝ᵥ y) • column U (some none) + (column U none ⬝ᵥ y) • column U none := by have h := congrArg (fun M ↦ M *ᵥ y) hU rw [← Matrix.mulVec_mulVec,Matrix.one_mulVec] at h ext a have ha := congrFun h a change (∑ b, U a b*(column U b ⬝ᵥ y)) = y a at ha simp only [Fintype.sum_option,hy,mul_zero,Finset.sum_const_zero,add_zero] at ha change y a=(column U (some none) ⬝ᵥ y)*U a (some none)+(column U none ⬝ᵥ y)*U a none rw [← ha] ring omit [DecidableEq κ] in /-- At nonidentical, nonantipodal unit endpoints, the normal coefficient of that decomposition is nonzero. -/ theorem normal_coefficient_ne_zero (x y n : κ → ℝ) (hx : x ⬝ᵥ x = 1) (hy : y ⬝ᵥ y = 1) (hdecomp : y = (x ⬝ᵥ y) • x + (n ⬝ᵥ y) • n) (hne : y ≠ x) (hanti : y ≠ -x) : n ⬝ᵥ y ≠ 0 := by intro hzero have he : y = (x ⬝ᵥ y) • x := by simpa only [hzero,zero_smul,add_zero] using hdecomp have hs : (x ⬝ᵥ y)^2 = 1 := by conv_lhs at hy => rw [he] simpa only [dotProduct_smul,smul_dotProduct,smul_eq_mul,hx,mul_one,pow_two] using hy have hp : x ⬝ᵥ y = 1 ∨ x ⬝ᵥ y = -1 := by have hh : (x ⬝ᵥ y-1)*(x ⬝ᵥ y+1) = 0 := by nlinarith rcases mul_eq_zero.mp hh with hh | hh · left; linarith · right; linarith rcases hp with hp | hp · exact hne (by simpa only [hp,one_smul] using he) · exact hanti (by simpa only [hp,neg_one_smul] using he) end end Source29ClosestPairStationarity /- Component: ClosestPairCommonFrame.inc -/ namespace Source29ClosestPairCommonFrame open Filter Source29ClosestPairStationarity Source29AnalyticPairRotation open Source29SynchronizedCurveFrankel open scoped Topology BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Stationarity identifies the tangent hyperplanes at a nonidentical, nonantipodal closest pair. An orthogonal matrix at the second endpoint can therefore retain every tangent column of the first matrix. -/ theorem common_frame (U V : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (hU : U.transpose*U=1) (hV : V.transpose*V=1) (x y : (Option (Option ι)) → ℝ) (hUx : column U (some none)=x) (hVy : column V (some none)=y) (hne : y ≠ x) (hanti : y ≠ -x) (hstatU : ∀ i, column U (some (some i)) ⬝ᵥ y=0) (hstatV : ∀ i, column V (some (some i)) ⬝ᵥ x=0) : ∃ W : Matrix (Option (Option ι)) (Option (Option ι)) ℝ, W.transpose*W=1 ∧ W*W.transpose=1 ∧ column W (some none)=y ∧ (∀ i, column W (some (some i))=column U (some (some i))) ∧ (column W none=column V none ∨ column W none= -column V none) := by have hx : x ⬝ᵥ x=1 := by simpa only [hUx,ite_true] using column_dot U hU (some none) (some none) have hy : y ⬝ᵥ y=1 := by simpa only [hVy,ite_true] using column_dot V hV (some none) (some none) have hxt (i : ι) : x ⬝ᵥ column U (some (some i))=0 := by simpa only [hUx,Option.some.injEq,reduceCtorEq,ite_false] using column_dot U hU (some none) (some (some i)) have hyt (i : ι) : y ⬝ᵥ column U (some (some i))=0 := by rw [dotProduct_comm]; exact hstatU i have hdecomp : x=(y ⬝ᵥ x) • y + (column V none ⬝ᵥ x) • column V none := by simpa only [hVy] using radial_normal_decomposition V (mul_eq_one_comm.mp hV) x hstatV have hb : column V none ⬝ᵥ x ≠ 0 := by apply normal_coefficient_ne_zero y x (column V none) hy hx hdecomp (Ne.symm hne) intro he apply hanti simp only [he,neg_neg] have hnt (i : ι) : column V none ⬝ᵥ column U (some (some i))=0 := by have he := congrArg (fun z ↦ z ⬝ᵥ column U (some (some i))) hdecomp rw [hxt,add_dotProduct,smul_dotProduct,smul_dotProduct,hyt,smul_eq_mul, smul_eq_mul,mul_zero,zero_add] at he exact (mul_eq_zero.mp he.symm).resolve_left hb let W : Matrix (Option (Option ι)) (Option (Option ι)) ℝ := fun a b ↦ rotation x y (column U b) a have hcol (b : (Option (Option ι))) : column W b=rotation x y (column U b) := rfl have hW : W.transpose*W=1 := by ext i j change column W i ⬝ᵥ column W j = (1 : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) i j rw [hcol,hcol,rotation_dot,column_dot U hU,Matrix.one_apply] have hWr : column W (some none)=y := by rw [hcol,hUx,rotation_move x y (hx.trans hy.symm)] have hWt (i : ι) : column W (some (some i))=column U (some (some i)) := by rw [hcol,rotation_fix x y _ (hxt i) (hyt i)] have hnrad : column W (some none) ⬝ᵥ column V none=0 := by rw [hWr,← hVy] simpa only [reduceCtorEq,ite_false] using column_dot V hV (some none) none have hntan (i : ι) : column W (some (some i)) ⬝ᵥ column V none=0 := by rw [hWt,dotProduct_comm] exact hnt i have hline : column V none = (column W none ⬝ᵥ column V none) • column W none := by simpa only [hnrad,zero_smul,zero_add] using radial_normal_decomposition W (mul_eq_one_comm.mp hW) (column V none) hntan have hnV : column V none ⬝ᵥ column V none=1 := by simpa only [ite_true] using column_dot V hV none none have hnW : column W none ⬝ᵥ column W none=1 := by simpa only [ite_true] using column_dot W hW none none have hs : (column W none ⬝ᵥ column V none)^2=1 := by conv_lhs at hnV => rw [hline] simpa only [dotProduct_smul,smul_dotProduct,smul_eq_mul,hnW,mul_one,pow_two] using hnV have hp : column W none ⬝ᵥ column V none=1 ∨ column W none ⬝ᵥ column V none= -1 := by have hz : (column W none ⬝ᵥ column V none-1)* (column W none ⬝ᵥ column V none+1)=0 := by nlinarith rcases mul_eq_zero.mp hz with hz | hz · left; linarith · right; linarith refine ⟨W,hW,mul_eq_one_comm.mp hW,hWr,hWt,?_⟩ rcases hp with hp | hp · left simpa only [hp,one_smul] using hline.symm · right have he : column V none= -column W none := by simpa only [hp,neg_one_smul] using hline rw [he,neg_neg] /-- The common frame follows from actual local spherical curves at a closest pair. A nonzero tangent direction also excludes the antipodal case. -/ theorem common_frame_of_closest_pair (S T : Set ((Option (Option ι)) → ℝ)) (x y : (Option (Option ι)) → ℝ) (hx : x ∈ S) (hy : y ∈ T) (hclosest : ∀ z ∈ S, ∀ w ∈ T, squaredDistance x y ≤ squaredDistance z w) (U V : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (hU : U.transpose*U=1) (hV : V.transpose*V=1) (hUx : column U (some none)=x) (hVy : column V (some none)=y) (hne : y ≠ x) (i0 : ι) (C D : ι → ℝ → (Option (Option ι)) → ℝ) (hC : ∀ i a, AnalyticAt ℝ (fun t ↦ C i t a) 0) (hD : ∀ i a, AnalyticAt ℝ (fun t ↦ D i t a) 0) (hC0 : ∀ i, C i 0=x) (hD0 : ∀ i, D i 0=y) (hCunit : ∀ i, ∀ᶠ t in 𝓝 0, ∑ a, (C i t a)^2=1) (hDunit : ∀ i, ∀ᶠ t in 𝓝 0, ∑ a, (D i t a)^2=1) (hCmem : ∀ i, ∀ᶠ t in 𝓝 0, C i t ∈ S) (hDmem : ∀ i, ∀ᶠ t in 𝓝 0, D i t ∈ T) (hCv : ∀ i a, deriv (fun t ↦ C i t a) 0=U a (some (some i))) (hDv : ∀ i a, deriv (fun t ↦ D i t a) 0=V a (some (some i))) : ∃ W : Matrix (Option (Option ι)) (Option (Option ι)) ℝ, W.transpose*W=1 ∧ W*W.transpose=1 ∧ column W (some none)=y ∧ (∀ i, column W (some (some i))=column U (some (some i))) ∧ (column W none=column V none ∨ column W none= -column V none) := by have hswap (a b : (Option (Option ι)) → ℝ) : squaredDistance a b=squaredDistance b a := by apply Finset.sum_congr rfl intro j _ ring have hclosest' : ∀ z ∈ T, ∀ w ∈ S, squaredDistance y x ≤ squaredDistance z w := by intro z hz w hw rw [hswap y x,hswap z w] exact hclosest w hw z hz have hstatU (i : ι) : column U (some (some i)) ⬝ᵥ y=0 := by have hs := (closest_pair_velocity S T x y hy hclosest (C i) (hC i) (hC0 i) (hCunit i) (hCmem i)).2 simp only [hCv] at hs rw [dotProduct_comm] exact hs have hstatV (i : ι) : column V (some (some i)) ⬝ᵥ x=0 := by have hs := (closest_pair_velocity T S y x hx hclosest' (D i) (hD i) (hD0 i) (hDunit i) (hDmem i)).2 simp only [hDv] at hs rw [dotProduct_comm] exact hs have hxunit : ∑ a, (x a)^2=1 := by have hh := column_dot U hU (some none) (some none) simpa only [hUx,ite_true,dotProduct,pow_two] using hh have hvelocity : ∃ a, deriv (fun t ↦ C i0 t a) 0 ≠ 0 := by by_contra hh push Not at hh have hz : column U (some (some i0))=0 := by ext a change U a (some (some i0))=0 simpa only [hCv] using hh a have hn := column_dot U hU (some (some i0)) (some (some i0)) simp only [hz,dotProduct_zero,ite_true] at hn norm_num at hn have hanti := Source29AntipodalLinkExclusion.closest_pair_not_antipodal S T x y hy hclosest (C i0) (hC0 i0) hxunit (hCunit i0) (hCmem i0) hvelocity exact common_frame U V hU hV x y hUx hVy hne hanti hstatU hstatV end end Source29ClosestPairCommonFrame /- Component: RegularLinkCurvesInFrame.inc -/ namespace Source29RegularLinkCurvesInFrame open Filter MvPolynomial Source29PolynomialLinkChart Source29ClosestPairStationarity open Source29QuarticReuse.QuarticMinimal open scoped Topology BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Actual minimal spherical-link curves in any prescribed radial-normal orthogonal frame. Only pointwise vanishing of the cubic operator is used. -/ theorem exists_curves (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hd : 1 ≤ d) (hP : P.IsHomogeneous d) (x : (Option (Option ι)) → ℝ) (hzero : eval x P=0) (hL : eval x (Source29FactorInheritance.cubicOperator P)=0) (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (hU : U.transpose*U=1) (hUx : column U (some none)=x) (g : ℝ) (hg : g ≠ 0) (hgrad : ∀ a, eval x (pderiv a P)=g*U a none) : ∃ C : ι → ℝ → (Option (Option ι)) → ℝ, (∀ i a, AnalyticAt ℝ (fun t ↦ C i t a) 0) ∧ (∀ i, C i 0=x) ∧ (∀ i, ∀ᶠ t in 𝓝 0, eval (C i t) P=0) ∧ (∀ i, ∀ᶠ t in 𝓝 0, ∑ a, (C i t a)^2=1) ∧ (∀ i a, deriv (fun t ↦ C i t a) 0=U a (some (some i))) ∧ (∀ a, (∑ i, deriv (deriv (fun t ↦ C i t a)) 0)= -(Fintype.card ι : ℝ)*x a) := by have hbase : U *ᵥ base=x := by funext a have he := congrFun hUx a simpa only [Matrix.mulVec,dotProduct,base,Pi.single_apply,mul_ite,mul_one,mul_zero, Finset.sum_ite_eq',Finset.mem_univ,ite_true,column] using he have hpartial (j : (Option (Option ι))) : eval base (pderiv j (changeVariables U P))= g*(if none=j then 1 else 0) := by rw [pderiv_changeVariables,map_sum] simp only [map_mul,eval_C,eval_changeVariables,hbase] simp_rw [hgrad,mul_assoc] rw [← Finset.mul_sum] exact congrArg (fun q : ℝ ↦ g*q) (column_dot U hU none j) have hQzero : eval base (changeVariables U P)=0 := by rw [eval_changeVariables,hbase,hzero] have hQL : eval base (Source29FactorInheritance.cubicOperator (changeVariables U P))=0 := by change eval base (leadingOperator (changeVariables U P))=0 rw [leadingOperator_changeVariables U (mul_eq_one_comm.mp hU),eval_changeVariables,hbase] exact hL obtain ⟨γ,hγ,hγ0,hγzero,hγunit,hγv,hγacc⟩ := Source29RegularLinkMeanAcceleration.exists_regular_link_curves (changeVariables U P) d hd (isHomogeneous_changeVariables U P d hP) g hg hQzero (by simpa using hpartial none) (fun j ↦ by simpa using hpartial (some j)) hQL let C : ι → ℝ → (Option (Option ι)) → ℝ := fun i t ↦ U *ᵥ γ i t have hC (i : ι) : AnalyticAt ℝ (C i) 0 := Source29LinearCurveTransport.analytic_mulVec U (fun a t ↦ γ i t a) (hγ i) refine ⟨C,fun i ↦ analyticAt_pi_iff.mp (hC i),?_,?_,?_,?_,?_⟩ · intro i change U *ᵥ γ i 0=x rw [hγ0,hbase] · intro i filter_upwards [hγzero i] with t ht change eval (U *ᵥ γ i t) P=0 rw [← eval_changeVariables] exact ht · intro i filter_upwards [hγunit i] with t ht change (∑ a, (U *ᵥ γ i t) a ^ 2)=1 rw [Source29PolynomialJacobiTransport.norm_square_mulVec U hU] exact ht · intro i a change deriv (fun t ↦ (U *ᵥ γ i t) a) 0=U a (some (some i)) rw [Source29LinearCurveTransport.first_mulVec U (fun b t ↦ γ i t b) (hγ i) a] simp only [hγv,Pi.single_apply,mul_ite,mul_one,mul_zero,Finset.sum_ite_eq', Finset.mem_univ,ite_true] · intro a change (∑ i, deriv (deriv (fun t ↦ (U *ᵥ γ i t) a)) 0)= _ simp_rw [Source29LinearCurveTransport.second_mulVec U (fun b t ↦ γ _ t b) (hγ _) a] rw [Finset.sum_comm] simp_rw [← Finset.mul_sum,hγacc] calc (∑ b, U a b * (-(Fintype.card ι : ℝ)*base b)) = -(Fintype.card ι : ℝ)*(U *ᵥ base) a := by change (∑ b, U a b * (-(Fintype.card ι : ℝ)*base b)) = -(Fintype.card ι : ℝ)*(∑ b, U a b*base b) rw [Finset.mul_sum] apply Finset.sum_congr rfl intro b _ ring _ = _ := by rw [hbase] end end Source29RegularLinkCurvesInFrame /- Component: RegularPolynomialLinkFrankel.inc -/ namespace Source29RegularPolynomialLinkFrankel open Filter MvPolynomial Source29ClosestPairStationarity Source29SynchronizedCurveFrankel open scoped Topology BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] omit [DecidableEq ι] in /-- A local inclusion of the polynomial link gives set membership for every actual analytic link curve, including curves in a newly chosen frame. -/ lemma curve_eventually_mem (P : MvPolynomial (Option (Option ι)) ℝ) (S : Set ((Option (Option ι)) → ℝ)) (x : (Option (Option ι)) → ℝ) (hlocal : ∀ᶠ z in 𝓝 x, eval z P=0 → (∑ a, (z a)^2)=1 → z ∈ S) (C : ℝ → (Option (Option ι)) → ℝ) (hC : ∀ a, AnalyticAt ℝ (fun t ↦ C t a) 0) (hC0 : C 0=x) (hzero : ∀ᶠ t in 𝓝 0, eval (C t) P=0) (hunit : ∀ᶠ t in 𝓝 0, ∑ a, (C t a)^2=1) : ∀ᶠ t in 𝓝 0, C t ∈ S := by have hCa : AnalyticAt ℝ C 0 := analyticAt_pi_iff.mpr hC have ht : Tendsto C (𝓝 0) (𝓝 x) := by simpa only [hC0] using hCa.continuousAt.tendsto filter_upwards [ht.eventually hlocal,hzero,hunit] with t hlocalt hzt hut exact hlocalt hzt hut /-- Distinct regular homogeneous minimal links cannot be locally contained in two sets at a closest pair. Minimality is used only at the endpoints; all curves and their synchronized velocities are constructed explicitly. -/ theorem eq_of_closest_pair (P Q : MvPolynomial (Option (Option ι)) ℝ) (d e : ℕ) (hd : 1 ≤ d) (he : 1 ≤ e) (hP : P.IsHomogeneous d) (hQ : Q.IsHomogeneous e) (S T : Set ((Option (Option ι)) → ℝ)) (x y : (Option (Option ι)) → ℝ) (hx : x ∈ S) (hy : y ∈ T) (hclosest : ∀ z ∈ S, ∀ w ∈ T, squaredDistance x y ≤ squaredDistance z w) (hPzero : eval x P=0) (hQzero : eval y Q=0) (hPL : eval x (Source29FactorInheritance.cubicOperator P)=0) (hQL : eval y (Source29FactorInheritance.cubicOperator Q)=0) (hS : ∀ᶠ z in 𝓝 x, eval z P=0 → (∑ a, (z a)^2)=1 → z ∈ S) (hT : ∀ᶠ z in 𝓝 y, eval z Q=0 → (∑ a, (z a)^2)=1 → z ∈ T) (U V : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (hU : U.transpose*U=1) (hV : V.transpose*V=1) (hUx : column U (some none)=x) (hVy : column V (some none)=y) (g h : ℝ) (hg : g ≠ 0) (hh : h ≠ 0) (hgradP : ∀ a, eval x (pderiv a P)=g*U a none) (hgradQ : ∀ a, eval y (pderiv a Q)=h*V a none) (i0 : ι) : x=y := by by_contra hne obtain ⟨C,hC,hC0,hCzero,hCunit,hCv,hCacc⟩ := Source29RegularLinkCurvesInFrame.exists_curves P d hd hP x hPzero hPL U hU hUx g hg hgradP obtain ⟨D,hD,hD0,hDzero,hDunit,hDv,hDacc⟩ := Source29RegularLinkCurvesInFrame.exists_curves Q e he hQ y hQzero hQL V hV hVy h hh hgradQ have hCmem (i : ι) := curve_eventually_mem P S x hS (C i) (hC i) (hC0 i) (hCzero i) (hCunit i) have hDmem (i : ι) := curve_eventually_mem Q T y hT (D i) (hD i) (hD0 i) (hDzero i) (hDunit i) obtain ⟨W,hW,hWW,hWy,hWt,hWn⟩ := Source29ClosestPairCommonFrame.common_frame_of_closest_pair S T x y hx hy hclosest U V hU hV hUx hVy (Ne.symm hne) i0 C D hC hD hC0 hD0 hCunit hDunit hCmem hDmem hCv hDv obtain ⟨k,hk,hgradW⟩ : ∃ k : ℝ, k ≠ 0 ∧ ∀ a, eval y (pderiv a Q)=k*W a none := by rcases hWn with hn | hn · refine ⟨h,hh,fun a ↦ ?_⟩ have hna : W a none=V a none := congrFun hn a rw [hna,hgradQ] · refine ⟨-h,neg_ne_zero.mpr hh,fun a ↦ ?_⟩ have hna : W a none= -(V a none) := congrFun hn a rw [hna,hgradQ] ring obtain ⟨E,hE,hE0,hEzero,hEunit,hEv,hEacc⟩ := Source29RegularLinkCurvesInFrame.exists_curves Q e he hQ y hQzero hQL W hW hWy k hk hgradW have hEmem (i : ι) := curve_eventually_mem Q T y hT (E i) (hE i) (hE0 i) (hEzero i) (hEunit i) have hvelocity (i : ι) (a : (Option (Option ι))) : deriv (fun t ↦ C i t a) 0=deriv (fun t ↦ E i t a) 0 := by rw [hCv,hEv] exact (congrFun (hWt i) a).symm have hm : (0 : ℝ) < Fintype.card ι := by exact_mod_cast Fintype.card_pos_iff.mpr ⟨i0⟩ exact hne (Source29SynchronizedCurveFrankel.eq_of_closest_pair S T x y hclosest C E (Fintype.card ι : ℝ) hm hC hE hC0 hE0 hvelocity hCacc hEacc hCmem hEmem) /-- A regular point on a homogeneous polynomial's unit link admits the radial-normal frame, without any global differential-equation assumption. -/ theorem exists_radial_normal_frame (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (x : (Option (Option ι)) → ℝ) (hx : (∑ a, (x a)^2)=1) (hzero : eval x P=0) (hregular : (fun a ↦ eval x (pderiv a P)) ≠ 0) : ∃ (g : ℝ) (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ), 0 < g ∧ U.transpose*U=1 ∧ column U (some none)=x ∧ (∀ a, eval x (pderiv a P)=g*U a none) := by let X : EuclideanSpace ℝ (Option (Option ι)) := WithLp.toLp 2 x let G : EuclideanSpace ℝ (Option (Option ι)) := WithLp.toLp 2 (fun a ↦ eval x (pderiv a P)) have hG : G ≠ 0 := by intro he apply hregular funext a exact congrArg (fun z : EuclideanSpace ℝ (Option (Option ι)) ↦ z a) he let g : ℝ := ‖G‖ have hg : 0 < g := norm_pos_iff.mpr hG have hX : ‖X‖=1 := by have he : ‖X‖^2=1 := by simpa only [X,EuclideanSpace.real_norm_sq_eq] using hx nlinarith [norm_nonneg X] have horth : inner ℝ X G=0 := by have he := Source29QuarticReuse.QuarticPolynomialBasics.evalFDeriv_self_of_isHomogeneous P d hP x rw [hzero,mul_zero] at he simpa only [Source29QuarticReuse.QuarticPolynomialBasics.evalFDeriv_apply,X,G, PiLp.inner_apply,RCLike.inner_apply,conj_trivial,mul_comm] using he have hY : ‖g⁻¹ • G‖=1 := by rw [norm_smul,norm_inv,Real.norm_eq_abs,abs_of_pos hg] exact inv_mul_cancel₀ hg.ne' have hXY : inner ℝ X (g⁻¹ • G)=0 := by simp [inner_smul_right,horth] obtain ⟨U,hUt,hU,hUr,hUn⟩ := Source29OrthogonalFrame.exists_orthogonal_matrix_pair (some none) none (by simp) X (g⁻¹ • G) hX hY hXY refine ⟨g,U,hg,hUt,funext hUr,fun a ↦ ?_⟩ rw [hUn] change eval x (pderiv a P)=g*(g⁻¹*eval x (pderiv a P)) rw [← mul_assoc,mul_inv_cancel₀ hg.ne',one_mul] /-- The frame-free local Frankel theorem for regular homogeneous polynomial links. The local-inclusion hypotheses isolate the remaining component topology; no connectedness or global cubic equation is assumed. -/ theorem eq_of_regular_closest_pair (P Q : MvPolynomial (Option (Option ι)) ℝ) (d e : ℕ) (hd : 1 ≤ d) (he : 1 ≤ e) (hP : P.IsHomogeneous d) (hQ : Q.IsHomogeneous e) (S T : Set ((Option (Option ι)) → ℝ)) (x y : (Option (Option ι)) → ℝ) (hx : x ∈ S) (hy : y ∈ T) (hclosest : ∀ z ∈ S, ∀ w ∈ T, squaredDistance x y ≤ squaredDistance z w) (hxunit : (∑ a, (x a)^2)=1) (hyunit : (∑ a, (y a)^2)=1) (hPzero : eval x P=0) (hQzero : eval y Q=0) (hPreg : (fun a ↦ eval x (pderiv a P)) ≠ 0) (hQreg : (fun a ↦ eval y (pderiv a Q)) ≠ 0) (hPL : eval x (Source29FactorInheritance.cubicOperator P)=0) (hQL : eval y (Source29FactorInheritance.cubicOperator Q)=0) (hS : ∀ᶠ z in 𝓝 x, eval z P=0 → (∑ a, (z a)^2)=1 → z ∈ S) (hT : ∀ᶠ z in 𝓝 y, eval z Q=0 → (∑ a, (z a)^2)=1 → z ∈ T) (i0 : ι) : x=y := by obtain ⟨g,U,hg,hU,hUx,hgradP⟩ := exists_radial_normal_frame P d hP x hxunit hPzero hPreg obtain ⟨h,V,hh,hV,hVy,hgradQ⟩ := exists_radial_normal_frame Q e hQ y hyunit hQzero hQreg exact eq_of_closest_pair P Q d e hd he hP hQ S T x y hx hy hclosest hPzero hQzero hPL hQL hS hT U V hU hV hUx hVy g h hg.ne' hh.ne' hgradP hgradQ i0 end end Source29RegularPolynomialLinkFrankel /- Component: AnalyticFourthRadialJets.inc -/ namespace Source29AnalyticFourthRadialJets open Source29AnalyticHomogeneousRadialJets noncomputable section section General variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] /-- One radial entry in the fourth derivative of a real-degree homogeneous function. -/ theorem radial_fourth_derivative (f : E → ℝ) (D : ℝ) (U : Set E) (hU : IsOpen U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (x : E) (hx : x ∈ U) (u v w : E) : fderiv ℝ (fun z => fderiv ℝ (fun y => fderiv ℝ (fun q => fderiv ℝ f q w) y v) z u) x x = (D-3) * fderiv ℝ (fun y => fderiv ℝ (fun q => fderiv ℝ f q w) y v) x u := by have he := radial_third_derivative (fun y => fderiv ℝ f y w) (D-1) U hU hcone (fun y hy => Source29NewtonRootHarmonic.analyticAt_directional f y w (hf y hy)) (fun y hy t ht => directional_smul f D U hU hcone hf hhom y hy w t ht) x hx u v have h3 : D-1-2 = D-3 := by ring simpa only [h3] using he /-- Two radial entries in the fourth derivative; the real degree is unrestricted. -/ theorem radial_radial_fourth (f : E → ℝ) (D : ℝ) (U : Set E) (hU : IsOpen U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (x : E) (hx : x ∈ U) (u v : E) : fderiv ℝ (fun z => fderiv ℝ (fun y => fderiv ℝ (fun q => fderiv ℝ f q v) y u) z x) x x = (D-3)*(D-2) * fderiv ℝ (fun y => fderiv ℝ f y v) x u := by have he := radial_radial_third (fun y => fderiv ℝ f y v) (D-1) U hU hcone (fun y hy => Source29NewtonRootHarmonic.analyticAt_directional f y v (hf y hy)) (fun y hy t ht => directional_smul f D U hU hcone hf hhom y hy v t ht) x hx u have h3 : D-1-2 = D-3 := by ring have h2 : D-1-1 = D-2 := by ring simpa only [h3, h2] using he end General open Source29AnalyticNormalTrace Source29AnalyticSecondTrace /-- The last two coordinate slots can be radial, using analytic fourth-order symmetry. -/ theorem fourth_radial_coordinates {I : Type*} [Fintype I] [DecidableEq I] (f : (I → ℝ) → ℝ) (D : ℝ) (U : Set (I → ℝ)) (hU : IsOpen U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (r a b : I) (hx : Pi.single r 1 ∈ U) : fourth f (Pi.single r 1) a b r r = (D-3)*(D-2) * hess f (Pi.single r 1) a b := by rw [fourth_swap23 f _ (hf _ hx) a b r r, fourth_swap12 f _ (hf _ hx) a r b r, fourth_swap34 f _ (hf _ hx) r a b r, fourth_swap23 f _ (hf _ hx) r a r b] exact radial_radial_fourth f D U hU hcone hf hhom (Pi.single r 1) hx (Pi.single a 1) (Pi.single b 1) end end Source29AnalyticFourthRadialJets /- Component: CompactRegularLinkConnectedness.inc -/ namespace Source29CompactRegularLinkConnectedness open Filter Set MvPolynomial Source29SynchronizedCurveFrankel open scoped Topology BigOperators noncomputable section variable {κ : Type*} [Fintype κ] /-- Squared Euclidean coordinate distance attains its minimum on two nonempty compact sets. This does not use the default function-space norm. -/ theorem exists_closest_pair (S T : Set (κ → ℝ)) (hS : IsCompact S) (hT : IsCompact T) (hSne : S.Nonempty) (hTne : T.Nonempty) : ∃ x ∈ S, ∃ y ∈ T, ∀ z ∈ S, ∀ w ∈ T, squaredDistance x y ≤ squaredDistance z w := by have hc : Continuous (fun p : (κ → ℝ) × (κ → ℝ) ↦ squaredDistance p.1 p.2) := by unfold squaredDistance fun_prop obtain ⟨p,hp,hmin⟩ := (hS.prod hT).exists_isMinOn (hSne.prod hTne) hc.continuousOn exact ⟨p.1,hp.1,p.2,hp.2,fun z hz w hw ↦ hmin (show (z,w) ∈ S ×ˢ T from ⟨hz,hw⟩)⟩ variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- The full regular spherical zero link of a homogeneous polynomial is preconnected when its cubic operator vanishes pointwise on the link. Compact open separation, rather than an assumption on its components, provides the local link inclusions required by the Frankel argument. -/ theorem isPreconnected_link (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hd : 1 ≤ d) (hP : P.IsHomogeneous d) (hregular : ∀ x : (Option (Option ι)) → ℝ, eval x P=0 → (∑ a, (x a)^2)=1 → (fun a ↦ eval x (pderiv a P)) ≠ 0) (hminimal : ∀ x : (Option (Option ι)) → ℝ, eval x P=0 → (∑ a, (x a)^2)=1 → eval x (Source29FactorInheritance.cubicOperator P)=0) (i0 : ι) : IsPreconnected {x : (Option (Option ι)) → ℝ | eval x P=0 ∧ (∑ a, (x a)^2)=1} := by let L : Set ((Option (Option ι)) → ℝ) := {x | eval x P=0 ∧ (∑ a, (x a)^2)=1} have hcompact : IsCompact L := Source29CompactPolynomialLink.isCompact_link P change IsPreconnected L intro U V hU hV hcover hUne hVne by_contra hdisj have hno (x : (Option (Option ι)) → ℝ) (hx : x ∈ L) (hu : x ∈ U) (hv : x ∈ V) : False := hdisj ⟨x,hx,hu,hv⟩ have hSU : L ∩ U=L \ V := by ext x constructor · rintro ⟨hx,hu⟩ exact ⟨hx,fun hv ↦ hno x hx hu hv⟩ · rintro ⟨hx,hv⟩ exact ⟨hx,(hcover hx).resolve_right hv⟩ have hTV : L ∩ V=L \ U := by ext x constructor · rintro ⟨hx,hv⟩ exact ⟨hx,fun hu ↦ hno x hx hu hv⟩ · rintro ⟨hx,hu⟩ exact ⟨hx,(hcover hx).resolve_left hu⟩ have hScompact : IsCompact (L ∩ U) := hSU.symm ▸ hcompact.diff hV have hTcompact : IsCompact (L ∩ V) := hTV.symm ▸ hcompact.diff hU obtain ⟨x,hx,y,hy,hclosest⟩ := exists_closest_pair (L ∩ U) (L ∩ V) hScompact hTcompact hUne hVne have hS : ∀ᶠ z in 𝓝 x, eval z P=0 → (∑ a, (z a)^2)=1 → z ∈ L ∩ U := by filter_upwards [hU.mem_nhds hx.2] with z hz hp hs exact ⟨⟨hp,hs⟩,hz⟩ have hT : ∀ᶠ z in 𝓝 y, eval z P=0 → (∑ a, (z a)^2)=1 → z ∈ L ∩ V := by filter_upwards [hV.mem_nhds hy.2] with z hz hp hs exact ⟨⟨hp,hs⟩,hz⟩ have hxy := Source29RegularPolynomialLinkFrankel.eq_of_regular_closest_pair P P d d hd hd hP hP (L ∩ U) (L ∩ V) x y hx hy hclosest hx.1.2 hy.1.2 hx.1.1 hy.1.1 (hregular x hx.1.1 hx.1.2) (hregular y hy.1.1 hy.1.2) (hminimal x hx.1.1 hx.1.2) (hminimal y hy.1.1 hy.1.2) hS hT i0 exact hno y hy.1 (hxy ▸ hx.2) hy.2 /-- A nonempty regular minimal polynomial link is connected. -/ theorem isConnected_link (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hd : 1 ≤ d) (hP : P.IsHomogeneous d) (hregular : ∀ x : (Option (Option ι)) → ℝ, eval x P=0 → (∑ a, (x a)^2)=1 → (fun a ↦ eval x (pderiv a P)) ≠ 0) (hminimal : ∀ x : (Option (Option ι)) → ℝ, eval x P=0 → (∑ a, (x a)^2)=1 → eval x (Source29FactorInheritance.cubicOperator P)=0) (hne : ∃ x : (Option (Option ι)) → ℝ, eval x P=0 ∧ (∑ a, (x a)^2)=1) (i0 : ι) : IsConnected {x : (Option (Option ι)) → ℝ | eval x P=0 ∧ (∑ a, (x a)^2)=1} := ⟨hne,isPreconnected_link P d hd hP hregular hminimal i0⟩ /-- Polynomial divisibility of the cubic operator suffices: only its restriction to the zero link enters the geometric proof. -/ theorem isPreconnected_link_of_dvd (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hd : 1 ≤ d) (hP : P.IsHomogeneous d) (hregular : ∀ x : (Option (Option ι)) → ℝ, eval x P=0 → (∑ a, (x a)^2)=1 → (fun a ↦ eval x (pderiv a P)) ≠ 0) (hdiv : P ∣ Source29FactorInheritance.cubicOperator P) (i0 : ι) : IsPreconnected {x : (Option (Option ι)) → ℝ | eval x P=0 ∧ (∑ a, (x a)^2)=1} := by apply isPreconnected_link P d hd hP hregular _ i0 intro x hx _ obtain ⟨Q,hQ⟩ := hdiv rw [hQ,map_mul,hx,zero_mul] end end Source29CompactRegularLinkConnectedness /- Component: AnalyticLinkFourthTrace.inc -/ namespace Source29AnalyticLinkFourthTrace open Filter Source29AnalyticNormalTrace Source29AnalyticSecondTrace open Source29PolynomialLinkChart (base) open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Remove the radial direction from the twice differentiated analytic level equation. The radial jets are explicit; no integrality or lower bound on the real degree is used. -/ theorem link_fourth_trace (f : (Option (Option ι) → ℝ) → ℝ) (D g : ℝ) (hg : g ≠ 0) (hf : AnalyticAt ℝ f base) (hL : ∀ᶠ y in 𝓝 base, levelOperator f y = 0) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (hrad : ∀ j, hess f base (some none) j = (D-1)*grad f base j) (hthird : ∀ a b, third f base (some none) a b = (D-2)*hess f base a b) (hfourth : ∀ a b, fourth f base a b (some none) (some none) = (D-3)*(D-2)*hess f base a b) (a b : ι) : g^2 * (∑ i, fourth f base (some (some a)) (some (some b)) (some (some i)) (some (some i))) = 2 * (∑ i, ∑ j, hess f base (some (some a)) (some (some i)) * hess f base (some (some b)) (some (some j)) * hess f base (some (some i)) (some (some j))) - 2 * hess f base none none * (∑ i, hess f base (some (some a)) (some (some i)) * hess f base (some (some b)) (some (some i))) + 2 * g * (∑ i, (third f base (some (some a)) (some (some b)) (some (some i)) * hess f base none (some (some i)) + hess f base (some (some a)) (some (some i)) * third f base (some (some b)) none (some (some i)) + hess f base (some (some b)) (some (some i)) * third f base (some (some a)) none (some (some i)))) - 2 * hess f base (some (some a)) none * (∑ i, hess f base (some (some b)) (some (some i)) * hess f base none (some (some i))) - 2 * hess f base (some (some b)) none * (∑ i, hess f base (some (some a)) (some (some i)) * hess f base none (some (some i))) + (D*(D-1)-2) * g^2 * hess f base (some (some a)) (some (some b)) := by have hR : ∀ j, hess f base (some none) (some j) = 0 := by intro j rw [hrad, hgt, mul_zero] have hR' : ∀ j, hess f base (some j) (some none) = 0 := by intro j rw [hess_symm f base hf, hR] have hNR : hess f base none (some none) = (D-1)*g := by rw [hess_symm f base hf, hrad, hgn] have hTR : third f base (some (some a)) (some (some b)) (some none) = (D-2)*hess f base (some (some a)) (some (some b)) := by rw [third_swap23 f base hf, third_swap12 f base hf, hthird] have he := second_derivative_trace f base g hg hf hL hgn hgt (some (some a)) (some (some b)) simp only [Fintype.sum_option, hR, hR', hNR, hTR, hfourth, mul_zero, zero_mul, zero_add, add_zero, Finset.sum_const_zero] at he linear_combination he end end Source29AnalyticLinkFourthTrace /- Component: AnalyticNormalizedLinkJets.inc -/ namespace Source29AnalyticNormalizedLinkJets open Source29AnalyticNormalTrace Source29AnalyticSecondTrace open Source29PolynomialLinkChart (base) open scoped BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def tangent (a : ι) : Option (Option ι) := some (some a) def A (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (a b : ι) : ℝ := hess f base (tangent a) (tangent b) / g def w (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (a : ι) : ℝ := hess f base none (tangent a) / g def z (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) : ℝ := hess f base none none / g def S (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (a b c : ι) : ℝ := third f base (tangent a) (tangent b) (tangent c) / g def V (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (a b : ι) : ℝ := third f base none (tangent a) (tangent b) / g def Q (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (a b c d : ι) : ℝ := fourth f base (tangent a) (tangent b) (tangent c) (tangent d) / g def B (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (a b c : ι) : ℝ := S f g a b c - w f g a * A f g b c - w f g b * A f g a c - w f g c * A f g a b theorem A_symm (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (hf : AnalyticAt ℝ f base) (a b : ι) : A f g a b = A f g b a := by unfold A rw [hess_symm f base hf] theorem V_symm (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (hf : AnalyticAt ℝ f base) (a b : ι) : V f g a b = V f g b a := by unfold V rw [third_swap23 f base hf] theorem S_swap12 (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (hf : AnalyticAt ℝ f base) (a b c : ι) : S f g a b c = S f g b a c := by unfold S rw [third_swap12 f base hf] theorem S_swap23 (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (hf : AnalyticAt ℝ f base) (a b c : ι) : S f g a b c = S f g a c b := by unfold S rw [third_swap23 f base hf] theorem Q_swap12 (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (hf : AnalyticAt ℝ f base) (a b c d : ι) : Q f g a b c d = Q f g b a c d := by unfold Q rw [fourth_swap12 f base hf] theorem Q_swap23 (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (hf : AnalyticAt ℝ f base) (a b c d : ι) : Q f g a b c d = Q f g a c b d := by unfold Q rw [fourth_swap23 f base hf] theorem Q_swap13 (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (hf : AnalyticAt ℝ f base) (a b c d : ι) : Q f g a b c d = Q f g c b a d := by rw [Q_swap12 f g hf a b c d, Q_swap23 f g hf b a c d, Q_swap12 f g hf b c a d] theorem Q_swap34 (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (hf : AnalyticAt ℝ f base) (a b c d : ι) : Q f g a b c d = Q f g a b d c := by unfold Q rw [fourth_swap34 f base hf] theorem B_swap12 (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (hf : AnalyticAt ℝ f base) (a b c : ι) : B f g a b c = B f g b a c := by unfold B rw [S_swap12 f g hf a b c, A_symm f g hf a b] ring theorem B_swap23 (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (hf : AnalyticAt ℝ f base) (a b c : ι) : B f g a b c = B f g a c b := by unfold B rw [S_swap23 f g hf a b c, A_symm f g hf b c] ring theorem B_swap13 (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (hf : AnalyticAt ℝ f base) (a b c : ι) : B f g a b c = B f g c b a := by rw [B_swap12 f g hf a b c, B_swap23 f g hf b a c, B_swap12 f g hf b c a] end end Source29AnalyticNormalizedLinkJets /- Component: AnalyticNormalizedLinkTraces.inc -/ namespace Source29AnalyticNormalizedLinkTraces open Filter Source29AnalyticNormalTrace Source29AnalyticSecondTrace open Source29AnalyticNormalizedLinkJets open Source29PolynomialLinkChart (base) open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] variable (f : (Option (Option ι) → ℝ) → ℝ) (D g : ℝ) (hg : g ≠ 0) (hf : AnalyticAt ℝ f base) (hL : ∀ᶠ y in 𝓝 base, levelOperator f y = 0) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (hrad : ∀ j, hess f base (some none) j = (D-1)*grad f base j) (hthird : ∀ a b, third f base (some none) a b = (D-2)*hess f base a b) (hfourth : ∀ a b, fourth f base a b (some none) (some none) = (D-3)*(D-2)*hess f base a b) omit [Fintype ι] in include hgt hrad in theorem radial_hessian_zero (j : Option ι) : hess f base (some none) (some j) = 0 := by rw [hrad, hgt, mul_zero] include hg hL hgn hgt hrad in theorem A_trace : (∑ i, A f g i i) = 0 := by have ht := tangential_trace_zero f base g hg hL.self_of_nhds hgn hgt rw [Fintype.sum_option, radial_hessian_zero f D hgt hrad none, zero_add] at ht simp only [A, tangent, ← Finset.sum_div, ht, zero_div] include hg hf hL hgn hgt hrad hthird in theorem B_trace (c : ι) : (∑ i, B f g i i c) = 0 := by have hR := radial_hessian_zero f D hgt hrad have hR' : ∀ j, hess f base (some j) (some none) = 0 := by intro j rw [hess_symm f base hf, hR] have hT : third f base (tangent c) (some none) (some none) = 0 := by rw [third_swap12 f base hf, hthird] simp only [tangent, hR', mul_zero] have ht := derivative_trace f base g hg hf hL hgn hgt (tangent c) change g * (∑ i, third f base (tangent c) (some i) (some i)) = 2 * (∑ i, hess f base (tangent c) (some i) * hess f base none (some i)) at ht rw [Fintype.sum_option, Fintype.sum_option, hT] at ht simp only [tangent, hR', zero_mul, zero_add] at ht have hS : (∑ i, S f g c i i) = 2 * (∑ i, w f g i * A f g c i) := by simp only [S, w, A, tangent, div_mul_div_comm, ← Finset.sum_div] have hcomm : (∑ i, hess f base none (some (some i)) * hess f base (some (some c)) (some (some i))) = ∑ i, hess f base (some (some c)) (some (some i)) * hess f base none (some (some i)) := by apply Finset.sum_congr rfl intro i _ ring rw [hcomm] field_simp [hg] linear_combination ht calc (∑ i, B f g i i c) = ∑ i, B f g c i i := by apply Finset.sum_congr rfl intro i _ exact B_swap13 f g hf i i c _ = (∑ i, S f g c i i) - w f g c * (∑ i, A f g i i) - 2 * (∑ i, w f g i * A f g c i) := by simp only [B, Finset.sum_sub_distrib, ← Finset.mul_sum] ring _ = 0 := by rw [hS, A_trace f D g hg hL hgn hgt hrad]; ring include hg hf hL hgn hgt hrad hthird in theorem V_trace : (∑ i, V f g i i) = 2 * (∑ i, (w f g i)^2) + D*(D-1) := by have ht := normal_derivative_trace f base g hg hf hL hgn hgt have hH : hess f base none (some none) = (D-1)*g := by rw [hess_symm f base hf, hrad, hgn] have hT : third f base none (some none) (some none) = (D-2)*(D-1)*g := by rw [third_swap12 f base hf, hthird, hH] ring rw [Fintype.sum_option, Fintype.sum_option, hH, hT] at ht simp only [V, w, tangent, div_pow, ← Finset.sum_div] field_simp [hg] nlinarith [ht] include hg hf hL hgn hgt hrad hthird hfourth in theorem Q_trace_natural (a b : ι) : (∑ i, Q f g a b i i) = 2 * (∑ i, ∑ j, A f g a i * A f g b j * A f g i j) - 2 * z f g * (∑ i, A f g a i * A f g b i) + 2 * (∑ i, (S f g a b i * w f g i + A f g a i * V f g b i + A f g b i * V f g a i)) - 2 * w f g a * (∑ i, A f g b i * w f g i) - 2 * w f g b * (∑ i, A f g a i * w f g i) + (D*(D-1)-2) * A f g a b := by have he := Source29AnalyticLinkFourthTrace.link_fourth_trace f D g hg hf hL hgn hgt hrad hthird hfourth a b have hHN : ∀ c, hess f base (some (some c)) none = hess f base none (some (some c)) := by intro c exact hess_symm f base hf (some (some c)) none have hTN : ∀ c i, third f base (some (some c)) none (some (some i)) = third f base none (some (some c)) (some (some i)) := by intro c i exact third_swap12 f base hf (some (some c)) none (some (some i)) simp only [hHN, hTN] at he simp only [Q, A, z, S, w, V, tangent, div_mul_div_comm, ← add_div, ← Finset.sum_div] field_simp [hg] linear_combination he end end Source29AnalyticNormalizedLinkTraces /- Component: AnalyticSimonsTensor.inc -/ namespace Source29AnalyticSimonsTensor open Filter Source29AnalyticNormalTrace Source29AnalyticSecondTrace open Source29PolynomialLinkChart (base) open Source29AnalyticNormalizedLinkJets Source29SimonsJetCorrection Source29SimonsFourthTensor open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] open Source29PolynomialSimonsTensor (cubic_contraction square_contraction) def F (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) : ι → ι → ι → ι → ℝ := fourthTensor (A f g) (V f g) (B f g) (Q f g) (w f g) (z f g) /-- Explicit analytic candidate for the second covariant derivative. Identification with derivatives of an actual moving frame is still separate. -/ def D (f : (Option (Option ι) → ℝ) → ℝ) (g : ℝ) (a b c d : ι) : ℝ := F f g a b c d + correction (A f g) a b c d variable (f : (Option (Option ι) → ℝ) → ℝ) (degree g : ℝ) (hg : g ≠ 0) (hf : AnalyticAt ℝ f base) (hL : ∀ᶠ y in 𝓝 base, levelOperator f y = 0) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (hrad : ∀ j, hess f base (some none) j = (degree-1)*grad f base j) (hthird : ∀ a b, third f base (some none) a b = (degree-2)*hess f base a b) (hfourth : ∀ a b, fourth f base a b (some none) (some none) = (degree-3)*(degree-2)*hess f base a b) include hg hf hL hgn hgt hrad hthird hfourth theorem Q_trace (c d : ι) : (∑ k, Q f g k k c d) = 2 * matrixCube (A f g) d c - 2 * z f g * matrixSquare (A f g) c d + 2 * (∑ k, (S f g k c d * w f g k + A f g k c * V f g k d + A f g k d * V f g k c)) - 2 * w f g c * (∑ k, A f g k d * w f g k) - 2 * w f g d * (∑ k, A f g k c * w f g k) + ((degree : ℝ)*((degree : ℝ)-1)-2) * A f g c d := by have hrot : (∑ k, Q f g k k c d) = ∑ k, Q f g c d k k := by apply Finset.sum_congr rfl intro k _ rw [Q_swap23 f g hf k k c d, Q_swap12 f g hf k c k d, Q_swap34 f g hf c k k d, Q_swap23 f g hf c k d k] rw [hrot, Source29AnalyticNormalizedLinkTraces.Q_trace_natural f degree g hg hf hL hgn hgt hrad hthird hfourth, cubic_contraction (A f g) (A_symm f g hf), square_contraction (A f g) (A_symm f g hf)] have hS : ∀ k, S f g c d k = S f g k c d := by intro k rw [S_swap23 f g hf c d k, S_swap12 f g hf c k d] simp only [hS, A_symm f g hf, V_symm f g hf] theorem F_trace (c d : ι) : (∑ k, F f g k k c d) = 2 * matrixCube (A f g) d c - 2 * A f g c d := by apply fourthTensor_trace (A f g) (V f g) (B f g) (S f g) (Q f g) (w f g) (z f g) ((degree : ℝ)*((degree : ℝ)-1)) (A_symm f g hf) (Source29AnalyticNormalizedLinkTraces.A_trace f degree g hg hL hgn hgt hrad) (fun a b c => rfl) (Source29AnalyticNormalizedLinkTraces.B_trace f degree g hg hf hL hgn hgt hrad hthird) (Source29AnalyticNormalizedLinkTraces.V_trace f degree g hg hf hL hgn hgt hrad hthird) (Q_trace f degree g hg hf hL hgn hgt hrad hthird hfourth) /-- Tensor Simons for explicit normalized analytic jets with any real homogeneous degree. No Gauss, Codazzi, or commutator assumptions are needed. Geometric realization of D remains. -/ theorem tensor_simons (i j : ι) : (∑ k, D f g i j k k) = ((Fintype.card ι : ℝ) - Source29GaussSimonsAlgebra.normSq (A f g)) * A f g i j := by apply simons_of_symmetric_fourth (A f g) (F f g) (A_symm f g hf) (Source29AnalyticNormalizedLinkTraces.A_trace f degree g hg hL hgn hgt hrad) · exact fourthTensor_swap12 (A f g) (V f g) (B f g) (Q f g) (w f g) (z f g) (A_symm f g hf) (V_symm f g hf) (B_swap12 f g hf) (Q_swap12 f g hf) · exact fourthTensor_swap13 (A f g) (V f g) (B f g) (Q f g) (w f g) (z f g) (A_symm f g hf) (V_symm f g hf) (B_swap12 f g hf) (B_swap13 f g hf) (Q_swap13 f g hf) · exact fourthTensor_swap34 (A f g) (V f g) (B f g) (Q f g) (w f g) (z f g) (A_symm f g hf) (V_symm f g hf) (B_swap23 f g hf) (Q_swap34 f g hf) · exact F_trace f degree g hg hf hL hgn hgt hrad hthird hfourth end end Source29AnalyticSimonsTensor /- Component: AnalyticHomogeneousSimonsTensor.inc -/ namespace Source29AnalyticHomogeneousSimonsTensor open Filter Source29AnalyticNormalTrace Source29AnalyticSecondTrace open Source29AnalyticNormalizedLinkJets open Source29PolynomialLinkChart (base) open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Positive real homogeneity supplies every radial jet used in the analytic link tensor calculation, with no restriction on the degree. -/ theorem radial_coordinate_jets (f : (Option (Option ι) → ℝ) → ℝ) (degree : ℝ) (U : Set (Option (Option ι) → ℝ)) (hU : IsOpen U) (hx : base ∈ U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^degree * f x) : (∀ j, hess f base (some none) j = (degree-1)*grad f base j) ∧ (∀ a b, third f base (some none) a b = (degree-2)*hess f base a b) ∧ (∀ a b, fourth f base a b (some none) (some none) = (degree-3)*(degree-2)*hess f base a b) := by refine ⟨?_, ?_, ?_⟩ · intro j exact Source29AnalyticHomogeneousRadialJets.radial_hessian f degree U hU hcone hf hhom base hx (Pi.single j 1) · intro a b exact Source29AnalyticHomogeneousRadialJets.radial_third_derivative f degree U hU hcone hf hhom base hx (Pi.single a 1) (Pi.single b 1) · intro a b exact Source29AnalyticFourthRadialJets.fourth_radial_coordinates f degree U hU hcone hf hhom (some none) a b hx /-- Tensor Simons for actual derivatives of an analytic homogeneous solution of the local cubic level equation. Geometric realization of the tensor is separate. -/ theorem tensor_simons (f : (Option (Option ι) → ℝ) → ℝ) (degree g : ℝ) (hg : g ≠ 0) (U : Set (Option (Option ι) → ℝ)) (hU : IsOpen U) (hx : base ∈ U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^degree * f x) (hL : ∀ᶠ y in 𝓝 base, levelOperator f y = 0) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (i j : ι) : (∑ k, Source29AnalyticSimonsTensor.D f g i j k k) = ((Fintype.card ι : ℝ) - Source29GaussSimonsAlgebra.normSq (A f g)) * A f g i j := by obtain ⟨hr, ht, hq⟩ := radial_coordinate_jets f degree U hU hx hcone hf hhom exact Source29AnalyticSimonsTensor.tensor_simons f degree g hg (hf base hx) hL hgn hgt hr ht hq i j end end Source29AnalyticHomogeneousSimonsTensor /- Component: AnalyticPositiveRootSimons.inc -/ namespace Source29AnalyticPositiveRootSimons open Filter MvPolynomial Source29AnalyticNormalTrace open Source29PolynomialLinkChart (base) open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- The real-degree tensor Simons identity for the positive defining root of P^kQ. The PDE is assumed only for P^kQ, and not for P. -/ theorem definingRoot_tensor_simons (P Q : MvPolynomial (Option (Option ι)) ℝ) (p q k : ℕ) (hk : 0 < k) (hP : P.IsHomogeneous p) (hQ : Q.IsHomogeneous q) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator (P^k*Q) = 0) (hzero : eval base P = 0) (hpos : 0 < eval base Q) (a : ℝ) (ha : 0 < a) (hpn : eval base (pderiv none P) = a) (hpt : ∀ j, eval base (pderiv (some j) P) = 0) : ∀ i j : ι, let f := Source29FinitePositiveCofactorRoot.definingRoot P Q k let g := (eval base Q)^((k : ℝ)⁻¹)*a (∑ v, Source29AnalyticSimonsTensor.D f g i j v v) = ((Fintype.card ι : ℝ) - Source29GaussSimonsAlgebra.normSq (Source29AnalyticNormalizedLinkJets.A f g)) * Source29AnalyticNormalizedLinkJets.A f g i j := by intro i j let f := Source29FinitePositiveCofactorRoot.definingRoot P Q k let U : Set (Option (Option ι) → ℝ) := {x | 0 < eval x Q} have hU : IsOpen U := isOpen_lt continuous_const (show Continuous (fun x => eval x Q) from continuous_iff_continuousAt.mpr (fun x => (Source29PolynomialLinkChart.analyticAt_eval_real Q x).continuousAt)) have hreg : (fun i => eval base (pderiv i P)) ≠ 0 := by intro he have he' := congrFun he none rw [hpn] at he' exact ha.ne' he' have hg : 0 < (eval base Q)^((k : ℝ)⁻¹)*a := mul_pos (Real.rpow_pos_of_pos hpos _) ha have hgn : grad f base none = (eval base Q)^((k : ℝ)⁻¹)*a := by rw [Source29FinitePositiveCofactorRoot.definingRoot_gradient P Q k hk base hzero hpos] simp only [hpn] have hgt : ∀ j, grad f base (some j) = 0 := by intro j rw [Source29FinitePositiveCofactorRoot.definingRoot_gradient P Q k hk base hzero hpos] simp only [hpt, mul_zero] exact Source29AnalyticHomogeneousSimonsTensor.tensor_simons f ((p : ℝ)+(q : ℝ)/(k : ℝ)) _ hg.ne' U hU hpos (fun x hx t ht => Source29FinitePositiveCofactorRoot.eval_smul_pos Q q hQ x hx t ht) (fun x hx => Source29FinitePositiveCofactorRoot.definingRoot_analyticAt P Q k hk x hx) (fun x hx t ht => Source29FinitePositiveCofactorRoot.definingRoot_smul P Q p q k hP hQ x hx t ht) (Source29FinitePositiveCofactorRoot.definingRoot_levelOperator_zero P Q k hk hF base hzero hpos hreg) hgn hgt i j end end Source29AnalyticPositiveRootSimons /- Component: AnalyticPositiveRootCurvature.inc -/ namespace Source29AnalyticPositiveRootCurvature open MvPolynomial Source29AnalyticNormalTrace open Source29FinitePositiveCofactorRoot open Source29PolynomialLinkChart (base) open Source29AnalyticNormalizedLinkJets (A tangent) open scoped Topology BigOperators Matrix noncomputable section variable {I : Type*} [Fintype I] [DecidableEq I] /-- Tangential Hessian entries of the positive defining root scale by the positive unit; derivatives of that unit vanish from this restriction. -/ theorem definingRoot_hess_of_tangent (P Q : MvPolynomial I ℝ) (k : ℕ) (hk : 0 < k) (x : I → ℝ) (hP : eval x P = 0) (hQ : 0 < eval x Q) (i j : I) (hi : eval x (pderiv i P) = 0) (hj : eval x (pderiv j P) = 0) : hess (definingRoot P Q k) x i j = (eval x Q)^((k : ℝ)⁻¹) * eval x (pderiv i (pderiv j P)) := by have he := Source29FiniteJetConvergence.second_mul (fun y => eval y P) (fun y => (eval y Q)^((k : ℝ)⁻¹)) x (Pi.single i 1) (Pi.single j 1) (Source29PolynomialLinkChart.analyticAt_eval_real P x) (rootUnit_analyticAt Q k hk x hQ) change hess (definingRoot P Q k) x i j = eval x P * hess (fun y => (eval y Q)^((k : ℝ)⁻¹)) x i j + (eval x Q)^((k : ℝ)⁻¹) * hess (fun y => eval y P) x i j + coordPartial (fun y => eval y P) i x * coordPartial (fun y => (eval y Q)^((k : ℝ)⁻¹)) j x + coordPartial (fun y => (eval y Q)^((k : ℝ)⁻¹)) i x * coordPartial (fun y => eval y P) j x at he simpa only [hP, partial_eval, hi, hj, hess_eval, zero_mul, mul_zero, zero_add, add_zero] using he variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- The positive unit cancels from the normalized tangential Hessian. -/ theorem normalized_hessian_eq (P Q : MvPolynomial (Option (Option ι)) ℝ) (k : ℕ) (hk : 0 < k) (hP : eval base P = 0) (hQ : 0 < eval base Q) (a : ℝ) (hpt : ∀ j, eval base (pderiv (some j) P) = 0) (i j : ι) : A (definingRoot P Q k) ((eval base Q)^((k : ℝ)⁻¹)*a) i j = eval base (pderiv (tangent i) (pderiv (tangent j) P)) / a := by unfold A rw [definingRoot_hess_of_tangent P Q k hk base hP hQ (tangent i) (tangent j) (hpt (some i)) (hpt (some j))] exact mul_div_mul_left _ _ (Real.rpow_pos_of_pos hQ _).ne' /-- The base curvature formula also holds in degrees zero and one. -/ theorem curvaturePotential_at_base (P : MvPolynomial (Option (Option ι)) ℝ) (p : ℕ) (hP : P.IsHomogeneous p) (a : ℝ) (ha : a ≠ 0) (hpn : eval base (pderiv none P) = a) (hpt : ∀ j, eval base (pderiv (some j) P) = 0) : Source29PolynomialCurvaturePotential.curvaturePotential P base = (∑ i, ∑ j, (eval base (pderiv (tangent i) (pderiv (tangent j) P)))^2) / a^2 := by have hg : Source29PolynomialCurvaturePotential.gradientAt P base = Source29CurvaturePotentialAxis.axis a := by funext j cases j with | none => exact hpn | some j => exact hpt j have hs : ∀ i j, Source29QuarticReuse.QuarticMinimal.AmbientQuartic.realHessian P base i j = Source29QuarticReuse.QuarticMinimal.AmbientQuartic.realHessian P base j i := by intro i j simp only [Source29QuarticReuse.QuarticMinimal.AmbientQuartic.realHessian_apply] rw [Source29QuarticReuse.QuarticPolynomialBasics.second_partial_comm] have hr : ∀ j, Source29QuarticReuse.QuarticMinimal.AmbientQuartic.realHessian P base (some none) (some j) = 0 := by intro j have he := Source29AnalyticHomogeneousRadialJets.radial_hessian (fun y => eval y P) (p : ℝ) Set.univ isOpen_univ (fun _ _ _ _ => Set.mem_univ _) (fun y _ => Source29PolynomialLinkChart.analyticAt_eval_real P y) (fun y _ t ht => by rw [Real.rpow_natCast] exact Source29QuarticReuse.QuarticNormalization.eval_scale_of_isHomogeneous P p hP y t) base (Set.mem_univ _) (Pi.single (some j) 1) change hess (fun y => eval y P) base (some none) (some j) = ((p : ℝ)-1)*coordPartial (fun y => eval y P) (some j) base at he rw [hess_eval, partial_eval, hpt, mul_zero] at he exact he unfold Source29PolynomialCurvaturePotential.curvaturePotential rw [hg, Source29CurvaturePotentialAxis.potential_axis_link _ a ha hs hr] rfl /-- The analytic defining root and the original polynomial have the same base curvature potential, with no equation assumed for the original factor. -/ theorem normSq_normalized_hessian_eq_curvaturePotential (P Q : MvPolynomial (Option (Option ι)) ℝ) (p k : ℕ) (hk : 0 < k) (hPhom : P.IsHomogeneous p) (hP : eval base P = 0) (hQ : 0 < eval base Q) (a : ℝ) (ha : a ≠ 0) (hpn : eval base (pderiv none P) = a) (hpt : ∀ j, eval base (pderiv (some j) P) = 0) : Source29GaussSimonsAlgebra.normSq (A (definingRoot P Q k) ((eval base Q)^((k : ℝ)⁻¹)*a)) = Source29PolynomialCurvaturePotential.curvaturePotential P base := by rw [curvaturePotential_at_base P p hPhom a ha hpn hpt] simp only [Source29GaussSimonsAlgebra.normSq, normalized_hessian_eq P Q k hk hP hQ a hpt, div_pow, ← Finset.sum_div] end end Source29AnalyticPositiveRootCurvature /- Component: AnalyticNormalizedHessianBlocks.inc -/ namespace Source29AnalyticNormalizedHessianBlocks open Filter Source29AnalyticNormalTrace Source29AnalyticNormalizedLinkJets open Source29AnalyticNormalizedHessianCurve open Source29PolynomialLinkChart (Ambient base) open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] variable (f : Ambient ι → ℝ) (D g : ℝ) (hg : 0 < g) (hf : AnalyticAt ℝ f base) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (hrad : ∀ j, hess f base (some none) j = (D-1)*grad f base j) (hthird : ∀ a b, third f base (some none) a b = (D-2)*hess f base a b) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) include hf hC hC0 in theorem normalizedHessian_symm_germ (a b : Option (Option ι)) : normalizedHessian f C a b =ᶠ[𝓝 (0 : ℝ)] normalizedHessian f C b a := by have he : ∀ᶠ t in 𝓝 (0 : ℝ), AnalyticAt ℝ f (C t) := hC.continuousAt.tendsto.eventually (hC0.symm ▸ hf.eventually_analyticAt) filter_upwards [he] with t ht unfold normalizedHessian rw [hess_symm f (C t) ht a b] include hg hgn hgt hC0 in theorem zero_tangent (a b : ι) : normalizedHessian f C (tangent a) (tangent b) 0 = A f g a b := normalizedHessian_zero f g hg hgn hgt C hC0 _ _ include hg hgn hgt hC0 in theorem zero_normal_tangent (a : ι) : normalizedHessian f C none (tangent a) 0 = w f g a := normalizedHessian_zero f g hg hgn hgt C hC0 _ _ include hg hgn hgt hC0 in theorem zero_normal : normalizedHessian f C none none 0 = z f g := normalizedHessian_zero f g hg hgn hgt C hC0 _ _ include hg hgn hgt hrad hC0 in theorem zero_radial_some (a : Option ι) : normalizedHessian f C (some none) (some a) 0 = 0 := by rw [normalizedHessian_zero f g hg hgn hgt C hC0] rw [hrad, hgt, mul_zero, zero_div] include hg hgn hgt hrad hC0 in theorem zero_radial_normal : normalizedHessian f C (some none) none 0 = D-1 := by rw [normalizedHessian_zero f g hg hgn hgt C hC0] rw [hrad, hgn, mul_div_cancel_right₀ _ hg.ne'] include hg hf hgn hgt hC hC0 in theorem first_normal_tangent (i a : ι) (hC1 : ∀ c, deriv (fun t => C t c) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 c) : deriv (normalizedHessian f C none (tangent a)) 0 = V f g i a - w f g i * w f g a := by rw [normalizedHessian_first f g hg hf hgn hgt C hC hC0 i hC1] have ht : ∀ j : ι, Source29NormalizedLinkJets.tangent j = tangent j := fun _ => rfl simp only [ht] rw [hess_symm f base hf (tangent i) none, third_swap12 f base hf (tangent i) none (tangent a)] simp only [V, w] ring include hg hf hgn hgt hrad hthird hC hC0 in theorem first_radial_tangent (i a : ι) (hC1 : ∀ c, deriv (fun t => C t c) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 c) : deriv (normalizedHessian f C (some none) (tangent a)) 0 = (D-2) * A f g i a := by rw [normalizedHessian_first f g hg hf hgn hgt C hC hC0 i hC1] have ht : ∀ j : ι, Source29NormalizedLinkJets.tangent j = tangent j := fun _ => rfl simp only [ht] have hH : hess f base (some none) (tangent a) = 0 := by rw [hrad] change (D-1)*grad f base (some (some a)) = 0 rw [hgt, mul_zero] rw [hH, mul_zero, zero_div, sub_zero, third_swap12 f base hf (tangent i) (some none) (tangent a), hthird] unfold A ring end end Source29AnalyticNormalizedHessianBlocks /- Component: AnalyticNormalizedHessianTrace.inc -/ namespace Source29AnalyticNormalizedHessianTrace open Filter Source29AnalyticNormalTrace Source29AnalyticSecondTrace open Source29AnalyticNormalizedLinkJets Source29AnalyticNormalizedHessianCurve open Source29PolynomialLinkChart (Ambient base) open Source29SimonsJetCorrection open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] variable (f : Ambient ι → ℝ) (D g : ℝ) (hg : 0 < g) (hf : AnalyticAt ℝ f base) (hL : ∀ᶠ y in 𝓝 base, levelOperator f y = 0) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (hrad : ∀ j, hess f base (some none) j = (D-1)*grad f base j) (hthird : ∀ a b, third f base (some none) a b = (D-2)*hess f base a b) (hfourth : ∀ a b, fourth f base a b (some none) (some none) = (D-3)*(D-2)*hess f base a b) include hg hf hgn hgt hthird in theorem normalizedHessian_second_tangent (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (i : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (hC2 : ∀ a, deriv (deriv (fun t => C t a)) 0 = -base a - A f g i i * Pi.single (M := fun _ => ℝ) none 1 a) (a b : ι) : deriv (deriv (normalizedHessian f C (tangent a) (tangent b))) 0 = g * A f g a b * deriv (deriv (fun t => profile f (C t))) 0 - 2 * w f g i * S f g i a b + Q f g a b i i - (D-2) * A f g a b - A f g i i * V f g a b := by rw [normalizedHessian_second f D g hg hf hgn hgt C hC hC0 i hC1 hC2 (tangent a) (tangent b) (hthird _ _)] have ht : ∀ j : ι, Source29NormalizedLinkJets.tangent j = tangent j := fun _ => rfl simp only [ht] have h4 : coordPartial (fun x => third f x (tangent i) (tangent a) (tangent b)) (tangent i) base = fourth f base (tangent a) (tangent b) (tangent i) (tangent i) := by change fourth f base (tangent i) (tangent i) (tangent a) (tangent b) = _ rw [fourth_swap23 f base hf (tangent i) (tangent i) (tangent a) (tangent b), fourth_swap12 f base hf (tangent i) (tangent a) (tangent i) (tangent b), fourth_swap34 f base hf (tangent a) (tangent i) (tangent i) (tangent b), fourth_swap23 f base hf (tangent a) (tangent i) (tangent b) (tangent i)] rw [h4, hess_symm f base hf (tangent i) none] simp only [A, w, S, Q, V] field_simp ring variable (C : ι → ℝ → Ambient ι) (hC : ∀ i, AnalyticAt ℝ (C i) 0) (hC0 : ∀ i, C i 0 = base) (hC1 : ∀ i a, deriv (fun t => C i t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (hC2 : ∀ i a, deriv (deriv (fun t => C i t a)) 0 = -base a - A f g i i * Pi.single (M := fun _ => ℝ) none 1 a) (K lam : ℝ) (hJac : (∑ i, deriv (deriv (fun t => profile f (C i t))) 0) + (K+lam)*g⁻¹ = 0) include hg hf hL hgn hgt hrad hthird hC hC0 hC1 hC2 hJac in theorem normalizedHessian_second_trace (a b : ι) : (∑ i, deriv (deriv (normalizedHessian f (C i) (tangent a) (tangent b))) 0) = (∑ i, Q f g a b i i) - 2 * (∑ i, w f g i * S f g i a b) - (K+lam+(Fintype.card ι : ℝ)*(D-2)) * A f g a b := by simp_rw [normalizedHessian_second_tangent f D g hg hf hgn hgt hthird (C _) (hC _) (hC0 _) _ (hC1 _) (hC2 _)] simp only [mul_assoc, Finset.sum_sub_distrib, Finset.sum_add_distrib, ← Finset.mul_sum, ← Finset.sum_mul, Finset.sum_const, Finset.card_univ, nsmul_eq_mul, Source29AnalyticNormalizedLinkTraces.A_trace f D g hg.ne' hL hgn hgt hrad, zero_mul, sub_zero] have hj : (∑ i, deriv (deriv (fun t => profile f (C i t))) 0) = -(K+lam)*g⁻¹ := by linarith rw [hj] field_simp ring include hg hf hL hgn hgt hrad hthird hfourth hC hC0 hC1 hC2 hJac in theorem normalizedHessian_second_trace_reduced (a b : ι) : (∑ i, deriv (deriv (normalizedHessian f (C i) (tangent a) (tangent b))) 0) = 2 * matrixCube (A f g) b a - 2 * z f g * matrixSquare (A f g) a b + 2 * (∑ i, (A f g i a * V f g i b + A f g i b * V f g i a)) - 2 * w f g a * (∑ i, A f g b i * w f g i) - 2 * w f g b * (∑ i, A f g a i * w f g i) + (D*(D-1)-2-K-lam-(Fintype.card ι : ℝ)*(D-2)) * A f g a b := by rw [normalizedHessian_second_trace f D g hg hf hL hgn hgt hrad hthird C hC hC0 hC1 hC2 K lam hJac, Source29AnalyticNormalizedLinkTraces.Q_trace_natural f D g hg.ne' hf hL hgn hgt hrad hthird hfourth, Source29PolynomialSimonsTensor.cubic_contraction (A f g) (A_symm f g hf), Source29PolynomialSimonsTensor.square_contraction (A f g) (A_symm f g hf)] have hS : ∀ i, S f g a b i = S f g i a b := by intro i rw [S_swap23 f g hf, S_swap12 f g hf] simp only [Finset.sum_add_distrib, hS, A_symm f g hf, V_symm f g hf] have hm : (∑ i, S f g i a b * w f g i) = ∑ i, w f g i * S f g i a b := by apply Finset.sum_congr rfl intro i _ ring rw [hm] ring end end Source29AnalyticNormalizedHessianTrace /- Component: AnalyticTangentFrame.inc -/ namespace Source29AnalyticTangentFrame open Filter Source29AnalyticNormalTrace Source29AnalyticNormalizedHessianCurve open Source29AnalyticTensorNorm Source29AnalyticPairFrame Source29NormalizedLinkJets open Source29PolynomialLinkChart (Ambient base) open Source29PolynomialTangentFrame (single_dot_single) open Source29PairFrameDerivative open scoped BigOperators Matrix Topology noncomputable section section Normal variable {I : Type*} [Fintype I] [DecidableEq I] def unitNormal (f : (I → ℝ) → ℝ) (x : I → ℝ) : I → ℝ := fun a => profile f x * grad f x a theorem unitNormal_analyticAt (f : (I → ℝ) → ℝ) (x : I → ℝ) (hf : AnalyticAt ℝ f x) (hreg : grad f x ≠ 0) : AnalyticAt ℝ (unitNormal f) x := by apply AnalyticAt.pi intro a exact (profile_analyticAt f x hf hreg).mul (partial_analyticAt f x hf a) theorem unitNormal_dot_self (f : (I → ℝ) → ℝ) (x : I → ℝ) (hreg : grad f x ≠ 0) : unitNormal f x ⬝ᵥ unitNormal f x = 1 := by let v := grad f x let q := tensorNorm v have hq : q ≠ 0 := (tensorNorm_pos hreg).ne' have hs : q^2 = ∑ a, (v a)^2 := tensorNorm_sq v change (∑ a, (q⁻¹ * v a) * (q⁻¹ * v a)) = 1 calc _ = q⁻¹^2 * (∑ a, (v a)^2) := by rw [Finset.mul_sum] apply Finset.sum_congr rfl intro a _ ring _ = 1 := by rw [← hs]; field_simp /-- Positive real-degree homogeneity makes the unit normal orthogonal to the radial vector along the zero level. -/ theorem radial_dot_unitNormal (f : (I → ℝ) → ℝ) (D : ℝ) (x : I → ℝ) (hf : AnalyticAt ℝ f x) (hhom : ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (hzero : f x = 0) : x ⬝ᵥ unitNormal f x = 0 := by have he := Source29AnalyticHomogeneousRadialJets.euler f D x hf hhom rw [Source29AnalyticCurveCoordinateJets.linear_apply_eq_sum, hzero, mul_zero] at he have ht : (∑ a, x a * grad f x a) = 0 := by simpa only [grad, coordPartial, mul_comm] using he calc _ = profile f x * (∑ a, x a * grad f x a) := by simp only [unitNormal, dotProduct, Finset.mul_sum] apply Finset.sum_congr rfl intro a _ ring _ = 0 := by rw [ht, mul_zero] end Normal variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem unitNormal_at_base (f : Ambient ι → ℝ) (g : ℝ) (hg : 0 < g) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) : unitNormal f base = Pi.single none 1 := by funext a cases a with | none => simp [unitNormal, profile_at_base f g hg hgn hgt, hgn, hg.ne'] | some a => simp [unitNormal, hgt] def tangentFrame (f : Ambient ι → ℝ) (C : ℝ → Ambient ι) (j : ι) (t : ℝ) : Ambient ι := frame base (Pi.single none 1) (C t) (unitNormal f (C t)) (Pi.single (tangent j) 1) /-- The analytic pair-frame construction gives actual orthonormal frames along a homogeneous analytic zero link. -/ theorem exists_analytic_tangent_frame (f : Ambient ι → ℝ) (D g : ℝ) (hg : 0 < g) (U : Set (Ambient ι)) (hU : IsOpen U) (hx : base ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (hmem : ∀ᶠ t in 𝓝 (0 : ℝ), f (C t) = 0 ∧ (∑ a, (C t a)^2) = 1) : ∃ E : ι → ℝ → Ambient ι, E = tangentFrame f C ∧ (∀ j, AnalyticAt ℝ (E j) 0) ∧ (∀ j, E j 0 = Pi.single (tangent j) 1) ∧ (∀ t j k, E j t ⬝ᵥ E k t = if j = k then 1 else 0) ∧ (∀ᶠ t in 𝓝 (0 : ℝ), ∀ j, E j t ⬝ᵥ C t = 0 ∧ E j t ⬝ᵥ unitNormal f (C t) = 0) := by let n : Ambient ι := Pi.single none 1 let e : ι → Ambient ι := fun j => Pi.single (tangent j) 1 let E : ι → ℝ → Ambient ι := tangentFrame f C have hreg : grad f base ≠ 0 := regular_at_base f g hg.ne' hgn have hN0 : unitNormal f (C 0) = n := by rw [hC0] exact unitNormal_at_base f g hg hgn hgt have hN : AnalyticAt ℝ (fun t => unitNormal f (C t)) 0 := by have hr : grad f (C 0) ≠ 0 := by simpa only [hC0] using hreg exact (unitNormal_analyticAt f (C 0) (hC0.symm ▸ hf base hx) hr).comp hC have hu : (base : Ambient ι) ≠ 0 := by simp [base] have hn : n ≠ 0 := by simp [n] have hE : ∀ j, AnalyticAt ℝ (E j) 0 := by intro j exact frame_analyticAt base n C (fun t => unitNormal f (C t)) (fun _ => e j) 0 hu hn hC0 hN0 (analyticAt_pi_iff.mp hC) (analyticAt_pi_iff.mp hN) (fun _ => analyticAt_const) have hE0 : ∀ j, E j 0 = e j := by intro j simp only [E, tangentFrame, hC0, unitNormal_at_base f g hg hgn hgt, e, frame_self] have hca : AnalyticAt ℝ (fun t => grad f (C t) none) 0 := (partial_analyticAt f (C 0) (hC0.symm ▸ hf base hx) none).comp hC have hcp : 0 < grad f (C 0) none := by simpa only [hC0, hgn] using hg have hnear : ∀ᶠ t in 𝓝 (0 : ℝ), grad f (C t) ≠ 0 := by filter_upwards [hca.continuousAt.eventually (eventually_gt_nhds hcp)] with t ht intro he have hz := congrFun he none exact ht.ne' hz have hwithin : ∀ᶠ t in 𝓝 (0 : ℝ), C t ∈ U := by apply hC.continuousAt.eventually change U ∈ 𝓝 (C 0) rw [hC0] exact hU.mem_nhds hx refine ⟨E, rfl, hE, hE0, ?_, ?_⟩ · intro t j k change frame base n (C t) (unitNormal f (C t)) (e j) ⬝ᵥ frame base n (C t) (unitNormal f (C t)) (e k) = _ rw [frame_dot] simp only [e, single_dot_single, tangent, Option.some.injEq] · filter_upwards [hmem, hnear, hwithin] with t ht hr htu have hxx : (base : Ambient ι) ⬝ᵥ base = C t ⬝ᵥ C t := by have hb : (base : Ambient ι) ⬝ᵥ base = 1 := by simp [base] rw [hb] simpa only [dotProduct, pow_two] using ht.2.symm have hyy : n ⬝ᵥ n = unitNormal f (C t) ⬝ᵥ unitNormal f (C t) := by rw [unitNormal_dot_self f (C t) hr] simp [n] have huv : (base : Ambient ι) ⬝ᵥ n = 0 := by simp [base, n] have hxy : C t ⬝ᵥ unitNormal f (C t) = 0 := radial_dot_unitNormal f D (C t) (hf _ htu) (hhom _ htu) ht.1 have hp := frame_pair base n (C t) (unitNormal f (C t)) hxx hyy huv hxy intro j constructor · calc E j t ⬝ᵥ C t = E j t ⬝ᵥ frame base n (C t) (unitNormal f (C t)) base := congrArg (fun z => E j t ⬝ᵥ z) hp.1.symm _ = e j ⬝ᵥ base := frame_dot base n (C t) (unitNormal f (C t)) (e j) base _ = 0 := by simp [e, base, tangent] · calc E j t ⬝ᵥ unitNormal f (C t) = E j t ⬝ᵥ frame base n (C t) (unitNormal f (C t)) n := congrArg (fun z => E j t ⬝ᵥ z) hp.2.symm _ = e j ⬝ᵥ n := frame_dot base n (C t) (unitNormal f (C t)) (e j) n _ = 0 := by simp [e, n, tangent] theorem unitNormal_tangent_deriv (f : Ambient ι → ℝ) (g : ℝ) (hg : 0 < g) (hf : AnalyticAt ℝ f base) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (i j : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) : deriv (fun t => unitNormal f (C t) (tangent j)) 0 = hess f base (tangent i) (tangent j)/g := by have hr : grad f (C 0) ≠ 0 := by rw [hC0] exact regular_at_base f g hg.ne' hgn have hφ := (profile_analyticAt f (C 0) (hC0.symm ▸ hf) hr).comp hC have hv := (partial_analyticAt f (C 0) (hC0.symm ▸ hf) (tangent j)).comp hC have hd := Source29AnalyticCurveCoordinateJets.coordinate_velocity_first (coordPartial f (tangent j)) (fun a t => C t a) base (tangent i) (partial_analyticAt f base hf (tangent j)) (analyticAt_pi_iff.mp hC) (fun a => congrFun hC0 a) hC1 have he := (hφ.differentiableAt.hasDerivAt.mul hv.differentiableAt.hasDerivAt).deriv simp only [Pi.mul_def, Function.comp_def] at he change deriv (fun t => profile f (C t) * coordPartial f (tangent j) (C t)) 0 = _ change deriv (fun t => coordPartial f (tangent j) (C t)) 0 = _ at hd rw [he, hC0, profile_at_base f g hg hgn hgt, hd] have hj : coordPartial f (tangent j) base = 0 := hgt (some j) rw [hj] change _ = coordPartial (coordPartial f (tangent j)) (tangent i) base / g dsimp only [coordPartial] rw [div_eq_mul_inv] ring /-- The frame has zero tangential connection at the base, with the required radial and normal first derivatives. -/ theorem tangentFrame_first_deriv (f : Ambient ι → ℝ) (g : ℝ) (hg : 0 < g) (hf : AnalyticAt ℝ f base) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (i j : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (a : Option (Option ι)) : deriv (fun t => tangentFrame f C j t a) 0 = -(if i = j then 1 else 0) * base a - (hess f base (tangent i) (tangent j)/g) * Pi.single (M := fun _ => ℝ) none 1 a := by let n : Ambient ι := Pi.single none 1 let e : Ambient ι := Pi.single (tangent j) 1 let N := fun t => unitNormal f (C t) have hr : grad f (C 0) ≠ 0 := by rw [hC0] exact regular_at_base f g hg.ne' hgn have hN := (unitNormal_analyticAt f (C 0) (hC0.symm ▸ hf) hr).comp hC have hN0 : N 0 = n := by change unitNormal f (C 0) = n rw [hC0] exact unitNormal_at_base f g hg hgn hgt have he := frame_deriv base n e C N (by simp [base]) (by simp [n]) (by simp [base, n]) (by simp [base, e, tangent]) (by simp [n, e, tangent]) hC0 hN0 (analyticAt_pi_iff.mp hC) (analyticAt_pi_iff.mp hN) a have hdx : velocity C ⬝ᵥ e = if i = j then 1 else 0 := by simp [velocity, e, dotProduct, Pi.single_apply, hC1, tangent, eq_comm] have hdy : velocity N ⬝ᵥ e = hess f base (tangent i) (tangent j)/g := by simpa only [velocity, e, N, dotProduct, Pi.single_apply, mul_ite, mul_one, mul_zero, Finset.sum_ite_eq, Finset.sum_ite_eq', Finset.mem_univ, ite_true] using unitNormal_tangent_deriv f g hg hf hgn hgt C hC hC0 i j hC1 rw [hdx, hdy] at he exact he end end Source29AnalyticTangentFrame /- Component: PhaseChartNormalMultiplicity.inc -/ namespace Source29PhaseChartNormalMultiplicity open MvPolynomial Filter Source29NormalShiftDerivatives Source29NormalShiftAlgebra open Source29NewtonShiftedFactorCoefficient open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open scoped Topology noncomputable section variable {n : ℕ} /-- A flat analytic minimal phase chart has constant positive odd normal multiplicity. No polynomial factor is selected in this statement. -/ theorem exists_normal_multiplicity (F : MvPolynomial (Fin (n+1)) ℝ) (hFne : F ≠ 0) (hF0 : eval 0 F=0) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F=0) (hcal : WeakCalibration (leadingNormalizedField F)) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (hg0 : g 0=0) (hgrad : gradient g 0=0) (hbg : ∀ᶠ y in 𝓝 0, backgroundGraphOperator (gradient g y) (hessian g y)=0) (hpos : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, 0 < z.1 → 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) F) (hneg : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, z.1 < 0 → eval (Fin.cons (g z.2+z.1) z.2) F ≤ 0) : ∃ d : ℕ, Odd d ∧ 0 < (shiftedSlice F (g 0) 0).coeff d ∧ ∀ j : Fin d, ∀ᶠ y in 𝓝 0, (shiftedSlice F (g y) y).coeff (j:ℕ)=0 := by have hD := Source29FlatRegularGraph.fderiv_eq_zero_of_gradient_eq_zero g 0 hgrad obtain ⟨d,c,hc,hodd,hlow,hpure⟩ := Source29CalibratedFlatGraphInitial.exists_pure_initial F hFne hF0 hcal g hg.differentiableAt hg0 hD hpos hneg have hinitial := Source29PolynomialPureInitialShift.analytic_normal_shift_pure_initial_limit F d c hlow hpure hg hg0 hD have htop := Source29NewtonInitialCenterCoefficient.center_coefficient_of_pure_initial F g d c hinitial exact ⟨d,hodd,by rwa [htop],Source29NewtonRegularObstruction.lower_coefficient_germs_zero F g hg hgrad hF hbg d c hc.ne' hinitial hpos hneg⟩ /-- At a point where a selected full factor has nonzero residual, every vanishing irreducible divisor divides that selected factor. -/ theorem divides_selected_factor {κ : Type*} (F P R S : MvPolynomial κ ℝ) (k : ℕ) (hfac : F=R^k*S) (hP : Irreducible P) (hPF : P ∣ F) (a : κ → ℝ) (hPa : eval a P=0) (hSa : eval a S ≠ 0) : P ∣ R := by rw [hfac] at hPF rcases hP.prime.dvd_mul.mp hPF with hp | hp · exact hP.prime.dvd_of_dvd_pow hp · obtain ⟨T,hT⟩ := hp apply False.elim apply hSa rw [hT,map_mul,hPa,zero_mul] /-- Every vanishing full irreducible factor in the phase chart is simple there, and its residual is nonzero. No sign of that residual is assumed. -/ theorem factor_regularity_at_zero (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : 0 < k) (hfac : F=P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (hP0 : eval (0 : Fin (n+1) → ℝ) P=0) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator F=0) (hcal : WeakCalibration (leadingNormalizedField F)) (g : (Fin n → ℝ) → ℝ) (hg : AnalyticAt ℝ g 0) (hg0 : g 0=0) (hgrad : gradient g 0=0) (hbg : ∀ᶠ y in 𝓝 0, backgroundGraphOperator (gradient g y) (hessian g y)=0) (hrootF : ∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) F=0) (hpos : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, 0 < z.1 → 0 ≤ eval (Fin.cons (g z.2+z.1) z.2) F) (hneg : ∀ᶠ z : ℝ × (Fin n → ℝ) in 𝓝 0, z.1 < 0 → eval (Fin.cons (g z.2+z.1) z.2) F ≤ 0) : eval (0 : Fin (n+1) → ℝ) (pderiv 0 P) ≠ 0 ∧ eval (0 : Fin (n+1) → ℝ) Q ≠ 0 ∧ Odd k := by have hQne : Q ≠ 0 := fun h ↦ hPQ (h ▸ dvd_zero P) have hFne : F ≠ 0 := by rw [hfac]; exact mul_ne_zero (pow_ne_zero k hP.ne_zero) hQne have hF0 : eval (0 : Fin (n+1) → ℝ) F=0 := by rw [hfac,map_mul,map_pow,hP0,zero_pow hk.ne',zero_mul] have hbase : (Fin.cons (g 0) 0 : Fin (n+1) → ℝ)=0 := by rw [hg0] ext i exact Fin.cases rfl (fun j ↦ rfl) i obtain ⟨d,hd,htop,hlower⟩ := exists_normal_multiplicity F hFne hF0 hF hcal g hg hg0 hgrad hbg hpos hneg obtain ⟨R,S,l,hl,hR,hFR,hRS,hrootR⟩ := Source29AnalyticGraphFactor.exists_full_graph_factor F hFne g 0 hg hrootF obtain ⟨hld,hRn,hSne⟩ := Source29GraphRootMultiplicity.regularity_and_cofactor_nonzero F R S l d hl hFR hR hRS g 0 hrootR htop.ne' hlower rw [hbase] at hSne have hPF : P ∣ F := (dvd_pow_self P hk.ne').trans ⟨Q,hfac⟩ have hPR : P ∣ R := divides_selected_factor F P R S l hFR hP hPF 0 hP0 hSne obtain ⟨A,hPA⟩ := hP.dvd_symm hR hPR have hrootP : ∀ᶠ y in 𝓝 0, eval (Fin.cons (g y) y) P=0 := by filter_upwards [hrootR] with y hy rw [hPA,map_mul,hy,zero_mul] obtain ⟨hdk,hPn,hQ0⟩ := Source29GraphRootMultiplicity.regularity_and_cofactor_nonzero F P Q k d hk hfac hP hPQ g 0 hrootP htop.ne' hlower rw [hbase] at hPn hQ0 exact ⟨hPn,hQ0,hdk ▸ hd⟩ end end Source29PhaseChartNormalMultiplicity /- Component: PhaseChartFactorRegularity.inc -/ namespace Source29PhaseChartFactorRegularity open MvPolynomial Filter Source29AffinePolynomialTransport Source29GeometricPhaseChart open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29QuarticReuse.QuarticMinimal Source29PolynomialTranslation open scoped Topology Matrix noncomputable section variable {n : ℕ} /-- A full irreducible factor through a flat minimal phase chart is regular there and has nonvanishing cofactor. Neither conclusion is assumed in the chart, and no global or local sign of the cofactor is required. -/ theorem regularity_and_cofactor_nonzero (F P Q : MvPolynomial (Fin (n+1)) ℝ) (k : ℕ) (hk : 0 < k) (hfac : F=P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (hF : leadingOperator F=0) (hcal : WeakCalibration (leadingNormalizedField F)) (a : Fin (n+1) → ℝ) (ha : eval a P=0) (hchart : HasFlatMinimalPhaseChart F a) : evaluatedGradient P a ≠ 0 ∧ eval a Q ≠ 0 ∧ Odd k := by obtain ⟨U,hU,g,hg,hg0,hgrad,hbg,hroot,hpos,hneg⟩ := hchart let E := affineEquiv a U hU have hfac' : E F=(E P)^k*E Q := by rw [hfac,map_mul,map_pow] have hP' : Irreducible (E P) := (MulEquiv.irreducible_iff E).mpr hP have hPQ' : ¬ E P ∣ E Q := fun h ↦ hPQ ((map_dvd_iff E).mp h) have hP0 : eval (0 : Fin (n+1) → ℝ) (E P)=0 := by dsimp only [E] rwa [eval_zero_affineEquiv] have hF' : leadingOperator (E F)=0 := by dsimp only [E] rw [leadingOperator_affineEquiv,hF,map_zero] obtain ⟨hn,hQne,hodd⟩ := Source29PhaseChartNormalMultiplicity.factor_regularity_at_zero (E F) (E P) (E Q) k hk hfac' hP' hPQ' hP0 hF' (affine_weakCalibration F hcal a U hU) g hg hg0 hgrad hbg hroot hpos hneg refine ⟨?_,?_,hodd⟩ · intro hzero have hi (i : Fin (n+1)) : eval a (pderiv i P)=0 := congrFun hzero i apply hn dsimp only [E] rw [affineEquiv_apply,pderiv_changeVariables,map_sum] simp only [map_mul,eval_C,eval_changeVariables,Matrix.mulVec_zero, pderiv_translate,eval_zero_translate,hi,zero_mul,Finset.sum_const_zero] · simpa only [E,eval_zero_affineEquiv] using hQne /-- In particular every irreducible divisor through such a chart is regular, without first choosing a full factorization in the statement. -/ theorem irreducible_factor_regular (F P : MvPolynomial (Fin (n+1)) ℝ) (hFne : F ≠ 0) (hP : Irreducible P) (hPF : P ∣ F) (hF : leadingOperator F=0) (hcal : WeakCalibration (leadingNormalizedField F)) (a : Fin (n+1) → ℝ) (ha : eval a P=0) (hchart : HasFlatMinimalPhaseChart F a) : evaluatedGradient P a ≠ 0 := by have hf : FiniteMultiplicity P F := FiniteMultiplicity.of_not_isUnit hP.not_isUnit hFne obtain ⟨Q,hfac,hPQ⟩ := hf.exists_eq_pow_mul_and_not_dvd have hk : 0 < multiplicity P F := Nat.pos_of_ne_zero ((multiplicity_ne_zero hf).mpr hPF) exact (regularity_and_cofactor_nonzero F P Q (multiplicity P F) hk hfac hP hPQ hF hcal a ha hchart).1 /-- Two irreducible factors meeting at a chart point must divide one another. Consequently distinct irreducible factor components cannot cross there. -/ theorem mutual_divisibility_of_common_zero (F P R : MvPolynomial (Fin (n+1)) ℝ) (hFne : F ≠ 0) (hP : Irreducible P) (hR : Irreducible R) (hPF : P ∣ F) (hRF : R ∣ F) (hF : leadingOperator F=0) (hcal : WeakCalibration (leadingNormalizedField F)) (a : Fin (n+1) → ℝ) (hPa : eval a P=0) (hRa : eval a R=0) (hchart : HasFlatMinimalPhaseChart F a) : P ∣ R ∧ R ∣ P := by have hf : FiniteMultiplicity P F := FiniteMultiplicity.of_not_isUnit hP.not_isUnit hFne obtain ⟨Q,hfac,hPQ⟩ := hf.exists_eq_pow_mul_and_not_dvd have hk : 0 < multiplicity P F := Nat.pos_of_ne_zero ((multiplicity_ne_zero hf).mpr hPF) have hQ := (regularity_and_cofactor_nonzero F P Q (multiplicity P F) hk hfac hP hPQ hF hcal a hPa hchart).2.1 have hRP : R ∣ P := Source29PhaseChartNormalMultiplicity.divides_selected_factor F R P Q (multiplicity P F) hfac hR hRF a hRa hQ exact ⟨hR.dvd_symm hP hRP,hRP⟩ /-- Charts away from the vertex derive regularity on every factor's full nonvertex zero set; this is not an assumption on the chosen factor. -/ theorem irreducible_factor_regular_away_zero (F P : MvPolynomial (Fin (n+1)) ℝ) (hFne : F ≠ 0) (hP : Irreducible P) (hPF : P ∣ F) (hF : leadingOperator F=0) (hcal : WeakCalibration (leadingNormalizedField F)) (hcharts : ∀ a : Fin (n+1) → ℝ, a ≠ 0 → eval a F=0 → HasFlatMinimalPhaseChart F a) : ∀ a : Fin (n+1) → ℝ, a ≠ 0 → eval a P=0 → evaluatedGradient P a ≠ 0 := by intro a hane ha have hFa : eval a F=0 := by obtain ⟨Q,hQ⟩ := hPF rw [hQ,map_mul,ha,zero_mul] exact irreducible_factor_regular F P hFne hP hPF hF hcal a ha (hcharts a hane hFa) end end Source29PhaseChartFactorRegularity /- Component: RegularLinkIntersection.inc -/ namespace Source29RegularLinkIntersection open MvPolynomial Filter Source29FactorInheritance open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Two nonempty regular homogeneous minimal unit links intersect. Their closest points exist by compactness and coincide by the local Frankel theorem. -/ theorem exists_common_unit_zero (P Q : MvPolynomial (Option (Option ι)) ℝ) (d e : ℕ) (hd : 1 ≤ d) (he : 1 ≤ e) (hP : P.IsHomogeneous d) (hQ : Q.IsHomogeneous e) (hPreg : ∀ x : (Option (Option ι)) → ℝ, eval x P=0 → (∑ a, (x a)^2)=1 → (fun a ↦ eval x (pderiv a P)) ≠ 0) (hQreg : ∀ x : (Option (Option ι)) → ℝ, eval x Q=0 → (∑ a, (x a)^2)=1 → (fun a ↦ eval x (pderiv a Q)) ≠ 0) (hPL : ∀ x : (Option (Option ι)) → ℝ, eval x P=0 → (∑ a, (x a)^2)=1 → eval x (cubicOperator P)=0) (hQL : ∀ x : (Option (Option ι)) → ℝ, eval x Q=0 → (∑ a, (x a)^2)=1 → eval x (cubicOperator Q)=0) (hPne : ∃ x : (Option (Option ι)) → ℝ, eval x P=0 ∧ (∑ a, (x a)^2)=1) (hQne : ∃ x : (Option (Option ι)) → ℝ, eval x Q=0 ∧ (∑ a, (x a)^2)=1) (i0 : ι) : ∃ x : (Option (Option ι)) → ℝ, eval x P=0 ∧ eval x Q=0 ∧ (∑ a, (x a)^2)=1 := by let S : Set ((Option (Option ι)) → ℝ) := {x | eval x P=0 ∧ (∑ a, (x a)^2)=1} let T : Set ((Option (Option ι)) → ℝ) := {x | eval x Q=0 ∧ (∑ a, (x a)^2)=1} obtain ⟨x,hx,y,hy,hclosest⟩ := Source29CompactRegularLinkConnectedness.exists_closest_pair S T (Source29CompactPolynomialLink.isCompact_link P) (Source29CompactPolynomialLink.isCompact_link Q) hPne hQne have hxy := Source29RegularPolynomialLinkFrankel.eq_of_regular_closest_pair P Q d e hd he hP hQ S T x y hx hy hclosest hx.2 hy.2 hx.1 hy.1 (hPreg x hx.1 hx.2) (hQreg y hy.1 hy.2) (hPL x hx.1 hx.2) (hQL y hy.1 hy.2) (Filter.Eventually.of_forall (fun z hp hs ↦ ⟨hp,hs⟩)) (Filter.Eventually.of_forall (fun z hp hs ↦ ⟨hp,hs⟩)) i0 exact ⟨x,hx.1,hxy.symm ▸ hy.1,hx.2⟩ /-- The intersection theorem in the original eight polynomial coordinates. -/ theorem exists_common_unit_zero_fin8 (P Q : MvPolynomial (Fin 8) ℝ) (d e : ℕ) (hd : 1 ≤ d) (he : 1 ≤ e) (hP : P.IsHomogeneous d) (hQ : Q.IsHomogeneous e) (hPreg : ∀ x : Fin 8 → ℝ, eval x P=0 → (∑ a, (x a)^2)=1 → (fun a ↦ eval x (pderiv a P)) ≠ 0) (hQreg : ∀ x : Fin 8 → ℝ, eval x Q=0 → (∑ a, (x a)^2)=1 → (fun a ↦ eval x (pderiv a Q)) ≠ 0) (hPL : P ∣ cubicOperator P) (hQL : Q ∣ cubicOperator Q) (hPne : ∃ x : Fin 8 → ℝ, eval x P=0 ∧ (∑ a, (x a)^2)=1) (hQne : ∃ x : Fin 8 → ℝ, eval x Q=0 ∧ (∑ a, (x a)^2)=1) : ∃ x : Fin 8 → ℝ, eval x P=0 ∧ eval x Q=0 ∧ (∑ a, (x a)^2)=1 := by let E := Source29FinEightDegreeBound.eightLinkEquiv have hunit (x : Option (Option (Fin 6)) → ℝ) (hx : (∑ a, (x a)^2)=1) : (∑ a, ((x ∘ E) a)^2)=1 := by change (∑ a, (x (E a))^2)=1 rwa [E.sum_comp (fun a ↦ (x a)^2)] have hreg (R : MvPolynomial (Fin 8) ℝ) (hr : ∀ x : Fin 8 → ℝ, eval x R=0 → (∑ a, (x a)^2)=1 → (fun a ↦ eval x (pderiv a R)) ≠ 0) (x : Option (Option (Fin 6)) → ℝ) (hx : eval x (rename E R)=0) (hu : (∑ a, (x a)^2)=1) : (fun a ↦ eval x (pderiv a (rename E R))) ≠ 0 := by apply Source29PolynomialReindex.gradientAt_rename_ne_zero E R x exact hr (x ∘ E) (by simpa only [eval_rename] using hx) (hunit x hu) have hmin (R : MvPolynomial (Fin 8) ℝ) (hr : R ∣ cubicOperator R) (x : Option (Option (Fin 6)) → ℝ) (hx : eval x (rename E R)=0) (_hu : (∑ a, (x a)^2)=1) : eval x (cubicOperator (rename E R))=0 := by obtain ⟨A,hA⟩ := hr rw [Source29PolynomialReindex.cubicOperator_rename,hA,map_mul,map_mul,hx,zero_mul] have hnonempty (R : MvPolynomial (Fin 8) ℝ) (hr : ∃ x : Fin 8 → ℝ, eval x R=0 ∧ (∑ a, (x a)^2)=1) : ∃ x : Option (Option (Fin 6)) → ℝ, eval x (rename E R)=0 ∧ (∑ a, (x a)^2)=1 := by obtain ⟨x,hx,hu⟩ := hr refine ⟨x ∘ E.symm,?_,?_⟩ · simpa only [eval_rename,Function.comp_assoc,E.symm_comp_self,Function.comp_id] using hx · change (∑ a, (x (E.symm a))^2)=1 rwa [E.symm.sum_comp (fun a ↦ (x a)^2)] obtain ⟨x,hxP,hxQ,hxu⟩ := exists_common_unit_zero (rename E P) (rename E Q) d e hd he hP.rename_isHomogeneous hQ.rename_isHomogeneous (hreg P hPreg) (hreg Q hQreg) (hmin P hPL) (hmin Q hQL) (hnonempty P hPne) (hnonempty Q hQne) (0 : Fin 6) exact ⟨x ∘ E,by simpa only [eval_rename] using hxP, by simpa only [eval_rename] using hxQ,hunit x hxu⟩ end end Source29RegularLinkIntersection /- Component: GlobalPhaseFactor.inc -/ namespace Source29GlobalPhaseFactor open MvPolynomial Source29FactorInheritance Source29GeometricPhaseChart open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open scoped BigOperators noncomputable section /-- A nonzero polynomial's zero is a zero of an irreducible divisor. -/ theorem exists_irreducible_zero {κ : Type*} (F : MvPolynomial κ ℝ) (hF : F ≠ 0) (a : κ → ℝ) (ha : eval a F=0) : ∃ R : MvPolynomial κ ℝ, Irreducible R ∧ R ∣ F ∧ eval a R=0 := by induction F using WfDvdMonoid.induction_on_irreducible with | zero => exact (hF rfl).elim | unit u hu => exact (isUnit_iff_ne_zero.mp (hu.map (eval a)) ha).elim | mul q p hq hp ih => rw [map_mul] at ha rcases mul_eq_zero.mp ha with hz | hz · exact ⟨p,hp,dvd_mul_right p q,hz⟩ · obtain ⟨R,hR,hRq,hRa⟩ := ih hq hz exact ⟨R,hR,dvd_mul_of_dvd_right hRq p,hRa⟩ /-- Full multiplicity extracts the pointwise minimality of any irreducible divisor. -/ theorem irreducible_divisor_cubic_dvd {κ : Type*} [Fintype κ] [DecidableEq κ] (F R : MvPolynomial κ ℝ) (hFne : F ≠ 0) (hR : Irreducible R) (hRF : R ∣ F) (hF : cubicOperator F=0) : R ∣ cubicOperator R := by have hf : FiniteMultiplicity R F := FiniteMultiplicity.of_not_isUnit hR.not_isUnit hFne obtain ⟨Q,hfac,hRQ⟩ := hf.exists_eq_pow_mul_and_not_dvd have hk : 1 ≤ multiplicity R F := Nat.pos_of_ne_zero ((multiplicity_ne_zero hf).mpr hRF) exact Source29RealLeadingFactor.real_factor_inheritance R Q (multiplicity R F) hk hR hRQ (by rwa [← hfac]) /-- A nonzero real zero of a homogeneous polynomial normalizes to a unit zero. -/ theorem exists_unit_zero {κ : Type*} [Fintype κ] (P : MvPolynomial κ ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (a : κ → ℝ) (ha : a ≠ 0) (hzero : eval a P=0) : ∃ x : κ → ℝ, eval x P=0 ∧ (∑ j, (x j)^2)=1 := by let r := Source29AnalyticTensorNorm.tensorNorm a have hr : 0 < r := Source29AnalyticTensorNorm.tensorNorm_pos ha have hrsq : r^2=∑ j, (a j)^2 := Source29AnalyticTensorNorm.tensorNorm_sq a refine ⟨fun j ↦ r⁻¹*a j,?_,?_⟩ · rw [Source29QuarticReuse.QuarticNormalization.eval_scale_of_isHomogeneous P d hP a r⁻¹, hzero,mul_zero] · simp only [mul_pow,← Finset.mul_sum,← hrsq] field_simp /-- A nonzero polynomial having a zero has positive total degree. -/ lemma totalDegree_pos_of_zero {κ : Type*} (P : MvPolynomial κ ℝ) (hP : P ≠ 0) (a : κ → ℝ) (ha : eval a P=0) : 1 ≤ P.totalDegree := by by_contra hn have hd : P.totalDegree=0 := by omega have he := totalDegree_eq_zero_iff_eq_C.mp hd have hc : P.coeff 0=0 := by rw [he,eval_C] at ha exact ha exact hP (by rw [he,hc,map_zero]) /-- Flat minimal phase charts away from the vertex force the full residual of every real irreducible factor to have no nonvertex zero. Global regularity of all factors is derived from the charts before applying spherical Frankel. -/ theorem cofactor_ne_zero_away_zero (F P Q : MvPolynomial (Fin 8) ℝ) (D k : ℕ) (hk : 0 < k) (hfac : F=P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (hhom : F.IsHomogeneous D) (hF : cubicOperator F=0) (hcal : WeakCalibration (leadingNormalizedField F)) (hcharts : ∀ a : Fin 8 → ℝ, a ≠ 0 → eval a F=0 → HasFlatMinimalPhaseChart F a) (hPunit : ∃ x : Fin 8 → ℝ, eval x P=0 ∧ (∑ j, (x j)^2)=1) : ∀ a : Fin 8 → ℝ, a ≠ 0 → eval a Q ≠ 0 := by have hQne : Q ≠ 0 := fun h ↦ hPQ (h ▸ dvd_zero P) have hFne : F ≠ 0 := by rw [hfac]; exact mul_ne_zero (pow_ne_zero k hP.ne_zero) hQne have hPF : P ∣ F := (dvd_pow_self P hk.ne').trans ⟨Q,hfac⟩ have hPhom := Source29HomogeneousFactor.divisor_isHomogeneous F P hFne hhom hPF have hPL := irreducible_divisor_cubic_dvd F P hFne hP hPF hF have hPreg := Source29PhaseChartFactorRegularity.irreducible_factor_regular_away_zero F P hFne hP hPF hF hcal hcharts have hunit_ne_zero (x : Fin 8 → ℝ) (hx : (∑ j, (x j)^2)=1) : x ≠ 0 := by intro he simp only [he,Pi.zero_apply,zero_pow (by decide : 2 ≠ 0),Finset.sum_const_zero] at hx norm_num at hx have hdP : 1 ≤ P.totalDegree := by obtain ⟨x,hx,_⟩ := hPunit exact totalDegree_pos_of_zero P hP.ne_zero x hx intro a hane hQa obtain ⟨R,hR,hRQ,hRa⟩ := exists_irreducible_zero Q hQne a hQa have hRF : R ∣ F := hRQ.trans ⟨P^k,hfac.trans (mul_comm _ _)⟩ have hRhom := Source29HomogeneousFactor.divisor_isHomogeneous F R hFne hhom hRF have hRL := irreducible_divisor_cubic_dvd F R hFne hR hRF hF have hRreg := Source29PhaseChartFactorRegularity.irreducible_factor_regular_away_zero F R hFne hR hRF hF hcal hcharts have hRunit := exists_unit_zero R R.totalDegree hRhom a hane hRa obtain ⟨x,hxP,hxR,hxu⟩ := Source29RegularLinkIntersection.exists_common_unit_zero_fin8 P R P.totalDegree R.totalDegree hdP (totalDegree_pos_of_zero R hR.ne_zero a hRa) hPhom hRhom (fun x hx hu ↦ hPreg x (hunit_ne_zero x hu) hx) (fun x hx hu ↦ hRreg x (hunit_ne_zero x hu) hx) hPL hRL hPunit hRunit have hxF : eval x F=0 := by rw [hfac,map_mul,map_pow,hxP,zero_pow hk.ne',zero_mul] have hxQ := (Source29PhaseChartFactorRegularity.regularity_and_cofactor_nonzero F P Q k hk hfac hP hPQ hF hcal x hxP (hcharts x (hunit_ne_zero x hxu) hxF)).2.1 apply hxQ obtain ⟨A,hA⟩ := hRQ rw [hA,map_mul,hxR,zero_mul] end end Source29GlobalPhaseFactor /- Component: PhaseChartsPositiveStructure.inc -/ namespace Source29PhaseChartsPositiveStructure open MvPolynomial Source29GeometricPhaseChart Source29Closing open Source29QuarticReuse.FluxObstruction Source29PositiveLeadingStructureReduction noncomputable section /-- A homogeneous polynomial without a nonvertex zero has one strict sign. Opposite signs would give a unit zero by the proved real IVT argument. -/ theorem constant_sign_away_zero (Q : MvPolynomial (Fin 8) ℝ) (hhom : Q.IsHomogeneous Q.totalDegree) (hQ : ∀ x : Fin 8 → ℝ, x ≠ 0 → eval x Q ≠ 0) : (∀ x : Fin 8 → ℝ, x ≠ 0 → 0 < eval x Q) ∨ (∀ x : Fin 8 → ℝ, x ≠ 0 → eval x Q < 0) := by by_cases hpos : ∀ x : Fin 8 → ℝ, x ≠ 0 → 0 < eval x Q · exact Or.inl hpos right push Not at hpos obtain ⟨a,ha,hale⟩ := hpos have hneg : eval a Q < 0 := lt_of_le_of_ne hale (hQ a ha) intro b hb by_contra hnb have hposb : 0 < eval b Q := lt_of_le_of_ne (le_of_not_gt hnb) (hQ b hb).symm by_cases hd : Q.totalDegree=0 · have hc := totalDegree_eq_zero_iff_eq_C.mp hd rw [hc,eval_C] at hneg hposb linarith · obtain ⟨x,hx,hu⟩ := Source29HomogeneousRealZero.exists_unit_zero_of_sign_change Q Q.totalDegree hhom (Nat.pos_of_ne_zero hd) ⟨b,hposb⟩ ⟨a,hneg⟩ have hxne : x ≠ 0 := by intro he simp only [he,Pi.zero_apply,zero_pow (by decide : 2 ≠ 0),Finset.sum_const_zero] at hu norm_num at hu exact hQ x hxne hx /-- Once the leading polynomial has phase charts at every nonvertex zero, its sign-changing irreducible factor has a positive homogeneous residual after orientation. No connectedness of either strict phase is assumed. -/ theorem positive_leading_factor_of_phase_charts (P : Polynomial8) (hmin : Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P) (hdeg : 2 ≤ P.totalDegree) (hcharts : ∀ a : Fin 8 → ℝ, a ≠ 0 → eval a (homogeneousComponent P.totalDegree P)=0 → HasFlatMinimalPhaseChart (homogeneousComponent P.totalDegree P) a) : PositiveLeadingFactorData8 P := by obtain ⟨p,Q,k,hk,hp,hphom,hQhom,hfac,hpQ,hpos,hneg,hpL,hodd,hreal⟩ := Source29OddLeadingFactor.minimal_graph_leading_factor_odd P hmin hdeg have hdp : 1 ≤ p.totalDegree := by by_contra hn have he : p.totalDegree=0 := by omega have hc := totalDegree_eq_zero_iff_eq_C.mp he obtain ⟨x,hx⟩ := hpos obtain ⟨y,hy⟩ := hneg rw [hc,eval_C] at hx hy linarith have hunit := Source29HomogeneousRealZero.exists_unit_zero_of_sign_change p p.totalDegree hphom hdp hpos hneg obtain ⟨hFne,hFhom,hFL⟩ := QuarticPolynomialBasics.leading_component_data P hmin hdeg have hcal := Source29TopPhasePerimeter.top_weakCalibration P hmin hdeg have hQnonzero := Source29GlobalPhaseFactor.cofactor_ne_zero_away_zero (homogeneousComponent P.totalDegree P) p Q P.totalDegree k (by omega) hfac hp hpQ hFhom hFL hcal hcharts hunit rcases constant_sign_away_zero Q hQhom hQnonzero with hpositive | hnegative · exact ⟨p,Q,k,hk,hp,hphom,hQhom,hfac,hpositive⟩ · refine ⟨-p,-Q,k,hk,Source29ConnectedFactorStructure.irreducible_neg_of_irreducible p hp, ?_,?_,?_,?_⟩ · simpa only [totalDegree_neg] using hphom.neg · simpa only [totalDegree_neg] using hQhom.neg · rw [hodd.neg_pow,neg_mul_neg] exact hfac · intro x hx simpa only [map_neg,neg_pos] using hnegative x hx /-- The global remaining hypothesis is now only phase charts away from the vertex. The former separate strict-phase connectedness hypothesis is removed. -/ theorem problem29_of_phase_charts_away_zero (hcharts : ∀ P : Polynomial8, Math30.MinimalGraphs.SatisfiesMinimalGraphEquation P → 2 ≤ P.totalDegree → ∀ a : Fin 8 → ℝ, a ≠ 0 → eval a (homogeneousComponent P.totalDegree P)=0 → HasFlatMinimalPhaseChart (homogeneousComponent P.totalDegree P) a) : Math30.Problem29 := by apply problem29_of_positive_leading_factor intro P hmin hdeg exact positive_leading_factor_of_phase_charts P hmin hdeg (hcharts P hmin hdeg) end end Source29PhaseChartsPositiveStructure /- Component: AnalyticTangentFrameSecond.inc -/ namespace Source29AnalyticTangentFrameSecond open Filter Source29AnalyticNormalTrace Source29AnalyticNormalizedLinkJets open Source29PolynomialLinkChart (Ambient base) open Source29AnalyticTangentFrame Source29PairFrameDerivative Source29AnalyticDotSecond open scoped BigOperators Matrix Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Orthonormality fixes the symmetric tangential frame acceleration. -/ theorem tangentFrame_second_symmetric (f : Ambient ι → ℝ) (D g : ℝ) (hg : 0 < g) (U : Set (Ambient ι)) (hU : IsOpen U) (hx : base ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (hmem : ∀ᶠ t in 𝓝 (0 : ℝ), f (C t) = 0 ∧ (∑ a, (C t a)^2) = 1) (i j k : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) : acceleration (tangentFrame f C j) (tangent k) + acceleration (tangentFrame f C k) (tangent j) = -2 * ((if i = j then 1 else 0) * (if i = k then 1 else 0) + A f g i j * A f g i k) := by obtain ⟨E, rfl, hE, hE0, horth, htan⟩ := exists_analytic_tangent_frame f D g hg U hU hx hf hhom hgn hgt C hC hC0 hmem have he : (fun t => tangentFrame f C j t ⬝ᵥ tangentFrame f C k t) = (fun _ : ℝ => if j = k then (1 : ℝ) else 0) := funext (fun t => horth t j k) have hz : deriv (deriv (fun t => tangentFrame f C j t ⬝ᵥ tangentFrame f C k t)) 0 = 0 := by rw [he] simp only [deriv_const', deriv_const] rw [second_deriv_dot _ _ (analyticAt_pi_iff.mp (hE j)) (analyticAt_pi_iff.mp (hE k)), hE0, hE0, dotProduct_single_one, single_one_dotProduct] at hz have hd : ∀ l a, velocity (tangentFrame f C l) a = -(if i = l then 1 else 0) * base a - A f g i l * Pi.single (M := fun _ => ℝ) none 1 a := by intro l a exact tangentFrame_first_deriv f g hg (hf base hx) hgn hgt C hC hC0 i l hC1 a have hv : velocity (tangentFrame f C j) ⬝ᵥ velocity (tangentFrame f C k) = (if i = j then 1 else 0) * (if i = k then 1 else 0) + A f g i j * A f g i k := by simp only [dotProduct, hd, Fintype.sum_option, base, Pi.single_apply] simp only [Option.some.injEq, reduceCtorEq, ite_true, ite_false, mul_one, mul_zero, sub_zero, zero_sub, neg_mul_neg, Finset.sum_const_zero, add_zero] ring rw [hv] at hz simp only [Source29NormalizedLinkJets.tangent, tangent] at hz ⊢ linarith end end Source29AnalyticTangentFrameSecond /- Component: AnalyticNormalSecond.inc -/ namespace Source29AnalyticNormalSecond open Filter Source29AnalyticNormalTrace Source29AnalyticNormalizedLinkJets open Source29PolynomialLinkChart (Ambient base) open Source29AnalyticTangentFrame Source29AnalyticNormalizedHessianCurve open Source29PairFrameDerivative Source29AnalyticDotSecond open scoped BigOperators Matrix Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] variable (f : Ambient ι → ℝ) (D g : ℝ) (hg : 0 < g) (hf : AnalyticAt ℝ f base) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (hrad : ∀ j, hess f base (some none) j = (D-1)*grad f base j) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (i : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) include hg hf hgn hgt hC hC0 hC1 in theorem unitNormal_first_coordinate (a : Option (Option ι)) : velocity (fun t => unitNormal f (C t)) a = -w f g i / g * grad f base a + g⁻¹ * hess f base (tangent i) a := by have hr : grad f (C 0) ≠ 0 := hC0.symm ▸ regular_at_base f g hg.ne' hgn have hφ := (profile_analyticAt f (C 0) (hC0.symm ▸ hf) hr).comp hC have hG := (partial_analyticAt f (C 0) (hC0.symm ▸ hf) a).comp hC have he := (hφ.differentiableAt.hasDerivAt.mul hG.differentiableAt.hasDerivAt).deriv simp only [Pi.mul_def, Function.comp_def] at he have hd := Source29AnalyticCurveCoordinateJets.coordinate_velocity_first (coordPartial f a) (fun b t => C t b) base (tangent i) (partial_analyticAt f base hf a) (analyticAt_pi_iff.mp hC) (fun b => congrFun hC0 b) hC1 change deriv (fun t => coordPartial f a (C t)) 0 = _ at hd change deriv (fun t => profile f (C t) * coordPartial f a (C t)) 0 = _ rw [he, profile_tangent_deriv f g hg hf hgn hgt C hC hC0 i hC1, hd, hC0, profile_at_base f g hg hgn hgt] change -hess f base (tangent i) none / g^2 * grad f base a + g⁻¹ * hess f base (tangent i) a = _ rw [hess_symm f base hf (tangent i) none] simp only [w] field_simp include hg hf hgn hgt hrad hC hC0 hC1 in theorem unitNormal_first_radial_normal : velocity (fun t => unitNormal f (C t)) (some none) = 0 ∧ velocity (fun t => unitNormal f (C t)) none = 0 := by have hr : hess f base (some none) (tangent i) = 0 := by rw [hrad, show grad f base (tangent i) = 0 from hgt (some i), mul_zero] constructor · rw [unitNormal_first_coordinate f g hg hf hgn hgt C hC hC0 i hC1, hgt none, mul_zero, zero_add, hess_symm f base hf, hr, mul_zero] · rw [unitNormal_first_coordinate f g hg hf hgn hgt C hC hC0 i hC1, hgn] rw [hess_symm f base hf (tangent i) none] simp only [w] field_simp ring include hg hf hgn hgt hrad hC hC0 hC1 in theorem unitNormal_second_tangent (hC2 : ∀ a, acceleration C a = -base a - A f g i i * Pi.single (M := fun _ => ℝ) none 1 a) (j : ι) : acceleration (fun t => unitNormal f (C t)) (tangent j) = S f g i i j - A f g i i * w f g j - 2 * w f g i * A f g i j := by let G := fun t => coordPartial f (tangent j) (C t) have hG : AnalyticAt ℝ G 0 := (partial_analyticAt f (C 0) (hC0.symm ▸ hf) (tangent j)).comp hC have hG0 : G 0 = 0 := by change coordPartial f (tangent j) (C 0) = 0 rw [hC0] exact hgt (some j) have hG1 : deriv G 0 = hess f base (tangent i) (tangent j) := Source29AnalyticCurveCoordinateJets.coordinate_velocity_first (coordPartial f (tangent j)) (fun a t => C t a) base (tangent i) (partial_analyticAt f base hf (tangent j)) (analyticAt_pi_iff.mp hC) (fun a => congrFun hC0 a) hC1 have hG2 : deriv (deriv G) 0 = third f base (tangent i) (tangent i) (tangent j) - A f g i i * hess f base none (tangent j) := by have he := Source29AnalyticCurveCoordinateJets.coordinate_velocity_second (coordPartial f (tangent j)) (fun a t => C t a) base (tangent i) (partial_analyticAt f base hf (tangent j)) (analyticAt_pi_iff.mp hC) (fun a => congrFun hC0 a) hC1 change deriv (deriv G) 0 = third f base (tangent i) (tangent i) (tangent j) + (∑ a, hess f base a (tangent j) * acceleration C a) at he rw [he] have hr : hess f base (some none) (tangent j) = 0 := by rw [hrad, show grad f base (tangent j) = 0 from hgt (some j), mul_zero] have hb : ∀ a, (base : Ambient ι) a = if a = some none then 1 else 0 := by intro a simp [base, Pi.single_apply] simp only [hC2, hb, Pi.single_apply, mul_sub, mul_neg, mul_ite, mul_one, mul_zero, Finset.sum_sub_distrib, Finset.sum_neg_distrib, Finset.sum_ite_eq', Finset.mem_univ, ite_true, hr] ring have hr : grad f (C 0) ≠ 0 := hC0.symm ▸ regular_at_base f g hg.ne' hgn have hφ := (profile_analyticAt f (C 0) (hC0.symm ▸ hf) hr).comp hC change deriv (deriv (fun t => profile f (C t) * G t)) 0 = _ rw [Source29AnalyticInverseNorm.second_deriv_product (fun t => profile f (C t)) G hφ hG, hG0, mul_zero, zero_add, profile_tangent_deriv f g hg hf hgn hgt C hC hC0 i hC1, hG1, hG2, hC0, profile_at_base f g hg hgn hgt] rw [show Source29NormalizedLinkJets.tangent i = tangent i from rfl, hess_symm f base hf (tangent i) none] simp only [S, w, A] field_simp ring end end Source29AnalyticNormalSecond /- Component: AnalyticFrameNormalAcceleration.inc -/ namespace Source29AnalyticFrameNormalAcceleration open Filter Source29AnalyticNormalTrace Source29AnalyticNormalizedLinkJets open Source29PolynomialLinkChart (Ambient base) open Source29AnalyticTangentFrame Source29AnalyticNormalSecond open Source29AnalyticNormalizedHessianCurve open Source29PairFrameDerivative Source29AnalyticDotSecond open scoped BigOperators Matrix Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- The normal frame acceleration is the negative covariant derivative of its second fundamental form, obtained by differentiating actual tangency. -/ theorem tangentFrame_second_normal_eq_neg_B (f : Ambient ι → ℝ) (D g : ℝ) (hg : 0 < g) (U : Set (Ambient ι)) (hU : IsOpen U) (hx : base ∈ U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (hmem : ∀ᶠ t in 𝓝 (0 : ℝ), f (C t) = 0 ∧ (∑ a, (C t a)^2) = 1) (i j : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (hC2 : ∀ a, acceleration C a = -base a - A f g i i * Pi.single (M := fun _ => ℝ) none 1 a) : acceleration (tangentFrame f C j) none = -B f g i i j := by have hrad : ∀ j, hess f base (some none) j = (D-1)*grad f base j := by intro j exact Source29AnalyticHomogeneousRadialJets.radial_hessian f D U hU hcone hf hhom base hx (Pi.single j 1) obtain ⟨E, rfl, hE, hE0, horth, htan⟩ := exists_analytic_tangent_frame f D g hg U hU hx hf hhom hgn hgt C hC hC0 hmem change ∀ j, tangentFrame f C j 0 = Pi.single (tangent j) 1 at hE0 have hr : grad f (C 0) ≠ 0 := hC0.symm ▸ regular_at_base f g hg.ne' hgn have hN : AnalyticAt ℝ (fun t => unitNormal f (C t)) 0 := (unitNormal_analyticAt f (C 0) (hC0.symm ▸ hf base hx) hr).comp hC have hN0 : unitNormal f (C 0) = Pi.single none 1 := by rw [hC0, unitNormal_at_base f g hg hgn hgt] have hz : (fun t => tangentFrame f C j t ⬝ᵥ unitNormal f (C t)) =ᶠ[𝓝 (0 : ℝ)] (fun _ => (0 : ℝ)) := by filter_upwards [htan] with t ht exact (ht j).2 have he := hz.deriv.deriv_eq simp only [deriv_const', deriv_const] at he rw [second_deriv_dot _ _ (analyticAt_pi_iff.mp (hE j)) (analyticAt_pi_iff.mp hN), hE0, hN0, dotProduct_single_one, single_one_dotProduct] at he have hdE : ∀ a, velocity (tangentFrame f C j) a = -(if i = j then 1 else 0) * base a - A f g i j * Pi.single (M := fun _ => ℝ) none 1 a := by intro a exact tangentFrame_first_deriv f g hg (hf base hx) hgn hgt C hC hC0 i j hC1 a have hN1 := unitNormal_first_radial_normal f D g hg (hf base hx) hgn hgt hrad C hC hC0 i hC1 have hv : velocity (tangentFrame f C j) ⬝ᵥ velocity (fun t => unitNormal f (C t)) = 0 := by simp only [dotProduct, hdE, Fintype.sum_option, base, Pi.single_apply] simp only [Option.some.injEq, reduceCtorEq, ite_true, ite_false, mul_one, mul_zero, sub_zero, zero_sub, zero_mul, Finset.sum_const_zero, add_zero, hN1.1, hN1.2] rw [hv, mul_zero, add_zero, unitNormal_second_tangent f D g hg (hf base hx) hgn hgt hrad C hC hC0 i hC1 hC2 j] at he unfold B nlinarith [he] /-- The normal acceleration vanishes after summing over link directions. -/ theorem tangentFrame_normal_acceleration_trace (f : Ambient ι → ℝ) (D g : ℝ) (hg : 0 < g) (U : Set (Ambient ι)) (hU : IsOpen U) (hx : base ∈ U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (hL : ∀ᶠ y in 𝓝 base, levelOperator f y = 0) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ι → ℝ → Ambient ι) (hC : ∀ i, AnalyticAt ℝ (C i) 0) (hC0 : ∀ i, C i 0 = base) (hmem : ∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), f (C i t) = 0 ∧ (∑ a, (C i t a)^2) = 1) (hC1 : ∀ i a, deriv (fun t => C i t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (hC2 : ∀ i a, acceleration (C i) a = -base a - A f g i i * Pi.single (M := fun _ => ℝ) none 1 a) (j : ι) : (∑ i, acceleration (tangentFrame f (C i) j) none) = 0 := by have hrad : ∀ j, hess f base (some none) j = (D-1)*grad f base j := by intro j exact Source29AnalyticHomogeneousRadialJets.radial_hessian f D U hU hcone hf hhom base hx (Pi.single j 1) have hthird : ∀ a b, third f base (some none) a b = (D-2)*hess f base a b := by intro a b exact Source29AnalyticHomogeneousRadialJets.radial_third_derivative f D U hU hcone hf hhom base hx (Pi.single a 1) (Pi.single b 1) simp_rw [tangentFrame_second_normal_eq_neg_B f D g hg U hU hx hcone hf hhom hgn hgt (C _) (hC _) (hC0 _) (hmem _) _ j (hC1 _) (hC2 _)] rw [Finset.sum_neg_distrib, Source29AnalyticNormalizedLinkTraces.B_trace f D g hg.ne' (hf base hx) hL hgn hgt hrad hthird, neg_zero] end end Source29AnalyticFrameNormalAcceleration /- Component: AnalyticFrameLaplacian.inc -/ namespace Source29AnalyticFrameLaplacian open Filter Source29AnalyticNormalTrace Source29AnalyticNormalizedLinkJets open Source29PolynomialLinkChart (Ambient base) open Source29AnalyticTangentFrame Source29AnalyticDotSecond Source29SimonsJetCorrection open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def frameLaplacian (f : Ambient ι → ℝ) (C : ι → ℝ → Ambient ι) (a b : ι) : ℝ := ∑ i, acceleration (tangentFrame f (C i) a) (tangent b) /-- Summing the frame acceleration determines its symmetric matrix part. -/ theorem frameLaplacian_symmetric_part (f : Ambient ι → ℝ) (D g : ℝ) (hg : 0 < g) (U : Set (Ambient ι)) (hU : IsOpen U) (hx : base ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ι → ℝ → Ambient ι) (hC : ∀ i, AnalyticAt ℝ (C i) 0) (hC0 : ∀ i, C i 0 = base) (hmem : ∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), f (C i t) = 0 ∧ (∑ a, (C i t a)^2) = 1) (hC1 : ∀ i a, deriv (fun t => C i t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (a b : ι) : frameLaplacian f C a b + frameLaplacian f C b a = -2 * ((if a=b then 1 else 0) + matrixSquare (A f g) a b) := by unfold frameLaplacian rw [← Finset.sum_add_distrib] simp_rw [Source29AnalyticTangentFrameSecond.tangentFrame_second_symmetric f D g hg U hU hx hf hhom hgn hgt (C _) (hC _) (hC0 _) (hmem _) _ a b (hC1 _)] rw [← Finset.mul_sum, Finset.sum_add_distrib] congr 1 congr 1 · simp only [ite_mul, one_mul, zero_mul, Finset.sum_ite_eq', Finset.mem_univ, ite_true] · unfold matrixSquare apply Finset.sum_congr rfl intro i _ rw [A_symm f g (hf base hx) i a] end end Source29AnalyticFrameLaplacian /- Component: AnalyticMovingSecondForm.inc -/ namespace Source29AnalyticMovingSecondForm open Filter Source29AnalyticNormalTrace Source29AnalyticNormalizedLinkJets open Source29AnalyticTangentFrame Source29AnalyticNormalizedHessianCurve open Source29AnalyticNormalizedHessianBlocks Source29AnalyticDotSecond open Source29PolynomialLinkChart (Ambient base) open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def tangentSecondForm (f : Ambient ι → ℝ) (C : ℝ → Ambient ι) (j k : ι) (t : ℝ) : ℝ := ∑ b, ∑ a, tangentFrame f C j t a * normalizedHessian f C a b t * tangentFrame f C k t b theorem tangentSecondForm_analyticAt (f : Ambient ι → ℝ) (D g : ℝ) (hg : 0 < g) (U : Set (Ambient ι)) (hU : IsOpen U) (hx : base ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (hmem : ∀ᶠ t in 𝓝 (0 : ℝ), f (C t) = 0 ∧ (∑ a, (C t a)^2) = 1) (j k : ι) : AnalyticAt ℝ (tangentSecondForm f C j k) 0 := by obtain ⟨E, rfl, hE, _, _, _⟩ := exists_analytic_tangent_frame f D g hg U hU hx hf hhom hgn hgt C hC hC0 hmem have hreg : grad f (C 0) ≠ 0 := hC0.symm ▸ regular_at_base f g hg.ne' hgn have hN := normalizedHessian_analyticAt f C (hC0.symm ▸ hf base hx) hC hreg exact Finset.analyticAt_fun_sum _ (fun b _ => Finset.analyticAt_fun_sum _ (fun a _ => (((analyticAt_pi_iff.mp (hE j)) a).mul (hN a b)).mul ((analyticAt_pi_iff.mp (hE k)) b))) theorem tangentSecondForm_zero (f : Ambient ι → ℝ) (g : ℝ) (hg : 0 < g) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ℝ → Ambient ι) (hC0 : C 0 = base) (j k : ι) : tangentSecondForm f C j k 0 = A f g j k := by have hE0 : ∀ j, tangentFrame f C j 0 = Pi.single (tangent j) 1 := by intro j simp only [tangentFrame, hC0, unitNormal_at_base f g hg hgn hgt, Source29AnalyticPairFrame.frame_self] rfl simp only [tangentSecondForm, hE0, Pi.single_apply, ite_mul, one_mul, zero_mul, mul_ite, mul_one, mul_zero, Finset.sum_ite_irrel, Finset.sum_const_zero, Finset.sum_ite_eq', Finset.mem_univ, ite_true] exact normalizedHessian_zero f g hg hgn hgt C hC0 (tangent j) (tangent k) /-- Second derivatives of the actual moving second form, with the unknown tangential frame accelerations still explicit. -/ theorem secondForm_second_deriv (f : Ambient ι → ℝ) (D g : ℝ) (hg : 0 < g) (U : Set (Ambient ι)) (hU : IsOpen U) (hx : base ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (hrad : ∀ j, hess f base (some none) j = (D-1)*grad f base j) (hthird : ∀ a b, third f base (some none) a b = (D-2)*hess f base a b) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (hmem : ∀ᶠ t in 𝓝 (0 : ℝ), f (C t) = 0 ∧ (∑ a, (C t a)^2) = 1) (i j k : ι) (hC1 : ∀ a, deriv (fun t => C t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) : deriv (deriv (tangentSecondForm f C j k)) 0 = deriv (deriv (normalizedHessian f C (tangent j) (tangent k))) 0 + acceleration (tangentFrame f C j) none * w f g k + acceleration (tangentFrame f C k) none * w f g j + (∑ l, acceleration (tangentFrame f C j) (tangent l) * A f g l k) + (∑ l, acceleration (tangentFrame f C k) (tangent l) * A f g l j) + 2 * (if i = j then 1 else 0) * A f g i k + 2 * (if i = k then 1 else 0) * A f g i j + 2 * z f g * A f g i j * A f g i k - 2 * A f g i j * V f g i k - 2 * A f g i k * V f g i j + 2 * w f g i * (A f g i j * w f g k + A f g i k * w f g j) := by obtain ⟨E, rfl, hE, hE0, horth, htan⟩ := exists_analytic_tangent_frame f D g hg U hU hx hf hhom hgn hgt C hC hC0 hmem have hfa := hf base hx have hreg : grad f (C 0) ≠ 0 := hC0.symm ▸ regular_at_base f g hg.ne' hgn have hN := normalizedHessian_analyticAt f C (hC0.symm ▸ hfa) hC hreg have hj := Source29BilinearFrameJet.second_deriv_two_axis (tangentFrame f C j) (tangentFrame f C k) (fun t a b => normalizedHessian f C a b t) (analyticAt_pi_iff.mp (hE j)) (analyticAt_pi_iff.mp (hE k)) hN (some none) none (tangent j) (tangent k) (if i=j then 1 else 0) (A f g i j) (if i=k then 1 else 0) (A f g i k) (hE0 j) (hE0 k) (tangentFrame_first_deriv f g hg hfa hgn hgt C hC hC0 i j hC1) (tangentFrame_first_deriv f g hg hfa hgn hgt C hC hC0 i k hC1) have hacc : ∀ a b, (∑ l, acceleration (tangentFrame f C a) l * normalizedHessian f C l (tangent b) 0) = acceleration (tangentFrame f C a) none * w f g b + ∑ l, acceleration (tangentFrame f C a) (tangent l) * A f g l b := by intro a b rw [Fintype.sum_option, Fintype.sum_option] have hr : normalizedHessian f C (some none) (tangent b) 0 = 0 := zero_radial_some f D g hg hgn hgt hrad C hC0 (some b) simp only [zero_normal_tangent f g hg hgn hgt C hC0, hr, mul_zero, zero_add] change _ + (∑ l, acceleration (tangentFrame f C a) (tangent l) * normalizedHessian f C (tangent l) (tangent b) 0) = _ simp only [zero_tangent f g hg hgn hgt C hC0] have haccR : (∑ l, normalizedHessian f C (tangent j) l 0 * acceleration (tangentFrame f C k) l) = acceleration (tangentFrame f C k) none * w f g j + ∑ l, acceleration (tangentFrame f C k) (tangent l) * A f g l j := by rw [← hacc k j] apply Finset.sum_congr rfl intro l _ rw [(normalizedHessian_symm_germ f hfa C hC hC0 (tangent j) l).self_of_nhds] ring have hnr : normalizedHessian f C none (some none) 0 = D-1 := by rw [(normalizedHessian_symm_germ f hfa C hC hC0 none (some none)).self_of_nhds, zero_radial_normal f D g hg hgn hgt hrad C hC0] have hjr : deriv (normalizedHessian f C (tangent j) (some none)) 0 = (D-2)*A f g i j := by rw [(normalizedHessian_symm_germ f hfa C hC hC0 (tangent j) (some none)).deriv_eq, first_radial_tangent f D g hg hfa hgn hgt hrad hthird C hC hC0 i j hC1] have hjn : deriv (normalizedHessian f C (tangent j) none) 0 = V f g i j - w f g i * w f g j := by rw [(normalizedHessian_symm_germ f hfa C hC hC0 (tangent j) none).deriv_eq, first_normal_tangent f g hg hfa hgn hgt C hC hC0 i j hC1] change deriv (deriv (fun t => ∑ b, ∑ a, tangentFrame f C j t a * normalizedHessian f C a b t * tangentFrame f C k t b)) 0 = _ rw [hj, hacc, haccR, zero_radial_some f D g hg hgn hgt hrad C hC0 none, zero_radial_normal f D g hg hgn hgt hrad C hC0, hnr, zero_normal f g hg hgn hgt C hC0, first_radial_tangent f D g hg hfa hgn hgt hrad hthird C hC hC0 i k hC1, first_normal_tangent f g hg hfa hgn hgt C hC hC0 i k hC1, hjr, hjn] ring end end Source29AnalyticMovingSecondForm /- Component: PositiveRootTangentTransport.inc -/ namespace Source29PositiveRootTangentTransport open MvPolynomial Source29AnalyticNormalTrace Source29FinitePositiveCofactorRoot open Source29AnalyticNormalizedHessianCurve Source29AnalyticTensorNorm open scoped Topology BigOperators Matrix noncomputable section variable {I : Type*} [Fintype I] [DecidableEq I] /-- Full Hessian product rule on the zero set, before restricting to tangent vectors. -/ theorem definingRoot_hess (P Q : MvPolynomial I ℝ) (k : ℕ) (hk : 0 < k) (x : I → ℝ) (hP : eval x P = 0) (hQ : 0 < eval x Q) (i j : I) : hess (definingRoot P Q k) x i j = (eval x Q)^((k : ℝ)⁻¹) * eval x (pderiv i (pderiv j P)) + eval x (pderiv i P) * coordPartial (fun y => (eval y Q)^((k : ℝ)⁻¹)) j x + coordPartial (fun y => (eval y Q)^((k : ℝ)⁻¹)) i x * eval x (pderiv j P) := by have he := Source29FiniteJetConvergence.second_mul (fun y => eval y P) (fun y => (eval y Q)^((k : ℝ)⁻¹)) x (Pi.single i 1) (Pi.single j 1) (Source29PolynomialLinkChart.analyticAt_eval_real P x) (rootUnit_analyticAt Q k hk x hQ) change hess (definingRoot P Q k) x i j = eval x P * hess (fun y => (eval y Q)^((k : ℝ)⁻¹)) x i j + (eval x Q)^((k : ℝ)⁻¹) * hess (fun y => eval y P) x i j + coordPartial (fun y => eval y P) i x * coordPartial (fun y => (eval y Q)^((k : ℝ)⁻¹)) j x + coordPartial (fun y => (eval y Q)^((k : ℝ)⁻¹)) i x * coordPartial (fun y => eval y P) j x at he simpa only [hP, partial_eval, hess_eval, zero_mul, zero_add] using he /-- Derivatives of the positive unit cancel after restriction to two tangent vectors. -/ theorem hess_contraction (P Q : MvPolynomial I ℝ) (k : ℕ) (hk : 0 < k) (x : I → ℝ) (hP : eval x P = 0) (hQ : 0 < eval x Q) (v w : I → ℝ) (hv : (∑ a, v a * eval x (pderiv a P)) = 0) (hw : (∑ a, w a * eval x (pderiv a P)) = 0) : (∑ b, ∑ a, v a * hess (definingRoot P Q k) x a b * w b) = (eval x Q)^((k : ℝ)⁻¹) * (∑ b, ∑ a, v a * eval x (pderiv a (pderiv b P)) * w b) := by have hb (b : I) : (∑ a, v a * hess (definingRoot P Q k) x a b * w b) = (eval x Q)^((k : ℝ)⁻¹) * (∑ a, v a * eval x (pderiv a (pderiv b P)) * w b) + (coordPartial (fun y => (eval y Q)^((k : ℝ)⁻¹)) b x * w b) * (∑ a, v a * eval x (pderiv a P)) + (eval x (pderiv b P) * w b) * (∑ a, v a * coordPartial (fun y => (eval y Q)^((k : ℝ)⁻¹)) a x) := by simp only [Finset.mul_sum, ← Finset.sum_add_distrib] apply Finset.sum_congr rfl intro a _ rw [definingRoot_hess P Q k hk x hP hQ a b] ring have hw' : (∑ b, eval x (pderiv b P) * w b) = 0 := by simpa only [mul_comm] using hw simp_rw [hb, hv, mul_zero, add_zero] rw [Finset.sum_add_distrib, ← Finset.mul_sum, ← Finset.sum_mul, hw', zero_mul, add_zero] theorem profile_mul_unit (P Q : MvPolynomial I ℝ) (k : ℕ) (hk : 0 < k) (x : I → ℝ) (hP : eval x P = 0) (hQ : 0 < eval x Q) : profile (definingRoot P Q k) x * (eval x Q)^((k : ℝ)⁻¹) = (tensorNorm (fun i => eval x (pderiv i P)))⁻¹ := by unfold profile rw [definingRoot_gradient P Q k hk x hP hQ, Source29PositiveCofactorRoot.tensorNorm_scale_pos _ _ (Real.rpow_pos_of_pos hQ _)] rw [mul_inv_rev, mul_assoc, inv_mul_cancel₀ (Real.rpow_pos_of_pos hQ _).ne', mul_one] variable {ι : Type*} [Fintype ι] [DecidableEq ι] open Source29PolynomialLinkChart (Ambient base) /-- The positive defining root has the same oriented unit normal on the zero set. -/ theorem unitNormal_eq (P Q : MvPolynomial (Option (Option ι)) ℝ) (k : ℕ) (hk : 0 < k) (x : Ambient ι) (hP : eval x P = 0) (hQ : 0 < eval x Q) : Source29AnalyticTangentFrame.unitNormal (definingRoot P Q k) x = Source29PolynomialUnitNormal.unitNormal P x := by funext a unfold Source29AnalyticTangentFrame.unitNormal rw [definingRoot_gradient P Q k hk x hP hQ, ← mul_assoc, profile_mul_unit P Q k hk x hP hQ] rfl theorem tangentFrame_eq (P Q : MvPolynomial (Option (Option ι)) ℝ) (k : ℕ) (hk : 0 < k) (C : ℝ → Ambient ι) (t : ℝ) (hP : eval (C t) P = 0) (hQ : 0 < eval (C t) Q) (j : ι) : Source29AnalyticTangentFrame.tangentFrame (definingRoot P Q k) C j t = Source29PolynomialTangentFrame.tangentFrame P C j t := by unfold Source29AnalyticTangentFrame.tangentFrame Source29PolynomialTangentFrame.tangentFrame rw [unitNormal_eq P Q k hk (C t) hP hQ] omit [DecidableEq ι] in /-- An arbitrary tangent vector to the polynomial normal annihilates its gradient. -/ theorem gradient_contraction_zero (P : MvPolynomial (Option (Option ι)) ℝ) (x v : Ambient ι) (hreg : Source29PolynomialCurvaturePotential.gradientAt P x ≠ 0) (hv : v ⬝ᵥ Source29PolynomialUnitNormal.unitNormal P x = 0) : (∑ a, v a * eval x (pderiv a P)) = 0 := by have hn : (tensorNorm (fun a => eval x (pderiv a P)))⁻¹ ≠ 0 := inv_ne_zero (tensorNorm_pos hreg).ne' have he : (tensorNorm (fun a => eval x (pderiv a P)))⁻¹ * (∑ a, v a * eval x (pderiv a P)) = 0 := by calc _ = v ⬝ᵥ Source29PolynomialUnitNormal.unitNormal P x := by simp only [Source29PolynomialUnitNormal.unitNormal, Source29PolynomialJacobiCurves.jacobiProfile, dotProduct, Finset.mul_sum] apply Finset.sum_congr rfl intro a _ ring _ = 0 := hv exact (mul_eq_zero.mp he).resolve_left hn end end Source29PositiveRootTangentTransport /- Component: AnalyticPositiveRootMovingCurvature.inc -/ namespace Source29AnalyticPositiveRootMovingCurvature open Filter MvPolynomial Source29PolynomialLinkChart open Source29PolynomialCurvaturePotential Source29PolynomialJacobiCurves open Source29PolynomialFramedCurvature Source29PolynomialMovingCurvature open Source29QuarticReuse.QuarticMinimal Source29QuarticReuse.QuarticMinimal.AmbientQuartic open Source29PositiveRootTangentTransport Source29FinitePositiveCofactorRoot open Source29AnalyticNormalizedHessianCurve open scoped Topology BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- The frame norm formula needs no lower bound on the homogeneous degree. -/ theorem framedSecondForm_norm_sq_all_degrees (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (x : Ambient ι) (hreg : gradientAt P x ≠ 0) (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (hUt : U.transpose * U = 1) (hbase : U *ᵥ base = x) (hUn : ∀ a, U a none = Source29PolynomialUnitNormal.unitNormal P x a) : (∑ i, ∑ j, (framedSecondForm P x U i j)^2) = curvaturePotential P x := by let g := Source29AnalyticTensorNorm.tensorNorm (gradientAt P x) have hg : g ≠ 0 := (Source29AnalyticTensorNorm.tensorNorm_pos hreg).ne' obtain ⟨hgn, hgt⟩ := frame_normalizes_gradient P x hreg U hUt hbase hUn have hU : U * U.transpose = 1 := mul_eq_one_comm.mp hUt have he := curvaturePotential_changeVariables U hU P base rw [hbase, Source29AnalyticPositiveRootCurvature.curvaturePotential_at_base _ d (isHomogeneous_changeVariables U P d hP) g hg hgn hgt] at he rw [← he] have hH := realHessian_changeVariables U P base rw [hbase] at hH change (∑ i, ∑ j, (g⁻¹ * (U.transpose * realHessian P x * U) (Source29NormalizedLinkJets.tangent i) (Source29NormalizedLinkJets.tangent j))^2) = _ rw [← hH] simp only [realHessian_apply, mul_pow, ← Finset.mul_sum, inv_pow, div_eq_mul_inv, mul_comm, Source29NormalizedLinkJets.tangent, Source29AnalyticNormalizedLinkJets.tangent] /-- Along the zero link the polynomial moving form has the invariant curvature norm, including when its homogeneous degree is zero or one. -/ theorem polynomial_tangentSecondForm_norm_sq_at (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (C : ℝ → Ambient ι) (t : ℝ) (hx : (∑ a, (C t a)^2) = 1) (hz : eval (C t) P = 0) (hr : gradientAt P (C t) ≠ 0) : (∑ i, ∑ j, (Source29PolynomialMovingCurvature.tangentSecondForm P C i j t)^2) = curvaturePotential P (C t) := by simp_rw [Source29PolynomialMovingCurvature.tangentSecondForm_eq_framed] obtain ⟨hbase, hnormal⟩ := linkFrameMatrix_pair P d hP (C t) hx hz hr exact framedSecondForm_norm_sq_all_degrees P d hP (C t) hr (linkFrameMatrix P (C t)) (Source29PairFrameMatrix.frameMatrix_transpose_mul _ _ _ _) hbase hnormal /-- The two moving forms agree at every regular zero where the positive root exists. -/ theorem tangentSecondForm_eq_at (P Q : MvPolynomial (Option (Option ι)) ℝ) (k : ℕ) (hk : 0 < k) (C : ℝ → Ambient ι) (t : ℝ) (hP : eval (C t) P = 0) (hQ : 0 < eval (C t) Q) (hreg : gradientAt P (C t) ≠ 0) (htan : ∀ j, Source29PolynomialTangentFrame.tangentFrame P C j t ⬝ᵥ Source29PolynomialUnitNormal.unitNormal P (C t) = 0) (i j : ι) : Source29AnalyticMovingSecondForm.tangentSecondForm (definingRoot P Q k) C i j t = Source29PolynomialMovingCurvature.tangentSecondForm P C i j t := by have hv := gradient_contraction_zero P (C t) (Source29PolynomialTangentFrame.tangentFrame P C i t) hreg (htan i) have hw := gradient_contraction_zero P (C t) (Source29PolynomialTangentFrame.tangentFrame P C j t) hreg (htan j) have he := hess_contraction P Q k hk (C t) hP hQ _ _ hv hw unfold Source29AnalyticMovingSecondForm.tangentSecondForm normalizedHessian simp only [tangentFrame_eq P Q k hk C t hP hQ] calc _ = profile (definingRoot P Q k) (C t) * (∑ b, ∑ a, Source29PolynomialTangentFrame.tangentFrame P C i t a * Source29AnalyticNormalTrace.hess (definingRoot P Q k) (C t) a b * Source29PolynomialTangentFrame.tangentFrame P C j t b) := by simp only [Finset.mul_sum] apply Finset.sum_congr rfl intro b _ apply Finset.sum_congr rfl intro a _ ring _ = _ := by rw [he, ← mul_assoc, profile_mul_unit P Q k hk (C t) hP hQ] rfl /-- The moving analytic root form has the polynomial curvature potential along any actual analytic zero-link curve through a normalized regular point. -/ theorem tangentSecondForm_local_norm_sq (P Q : MvPolynomial (Option (Option ι)) ℝ) (d k : ℕ) (hP : P.IsHomogeneous d) (hk : 0 < k) (hQ : 0 < eval base Q) (a : ℝ) (ha : 0 < a) (hpn : eval base (pderiv none P) = a) (hpt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (hmem : ∀ᶠ t in 𝓝 (0 : ℝ), definingRoot P Q k (C t) = 0 ∧ (∑ a, (C t a)^2) = 1) : (fun t => ∑ i, ∑ j, (Source29AnalyticMovingSecondForm.tangentSecondForm (definingRoot P Q k) C i j t)^2) =ᶠ[𝓝 (0 : ℝ)] (fun t => curvaturePotential P (C t)) := by have hQ0 : 0 < eval (C 0) Q := by simpa only [hC0] using hQ have hQnear : ∀ᶠ t in 𝓝 (0 : ℝ), 0 < eval (C t) Q := ((analyticAt_eval_real Q (C 0)).comp hC).continuousAt.eventually (eventually_gt_nhds hQ0) have hPmem : ∀ᶠ t in 𝓝 (0 : ℝ), eval (C t) P = 0 ∧ (∑ a, (C t a)^2) = 1 := by filter_upwards [hmem, hQnear] with t ht hqt exact ⟨(mul_eq_zero.mp ht.1).resolve_right (Real.rpow_pos_of_pos hqt _).ne', ht.2⟩ obtain ⟨E, rfl, _, _, _, htan⟩ := Source29PolynomialTangentFrame.exists_analytic_tangent_frame P d hP a ha hpn hpt C hC hC0 hPmem have hgrad : AnalyticAt ℝ (fun t => gradientAt P (C t)) 0 := by apply AnalyticAt.pi intro b exact (analyticAt_eval_real (pderiv b P) (C 0)).comp hC have hreg0 : gradientAt P (C 0) ≠ 0 := by rw [hC0] intro hz have he := congrFun hz none exact ha.ne' (by simpa only [gradientAt, hpn, Pi.zero_apply] using he) have hnear := hgrad.continuousAt.eventually_ne hreg0 filter_upwards [hPmem, hQnear, htan, hnear] with t ht hqt htan hr simp_rw [tangentSecondForm_eq_at P Q k hk C t ht.1 hqt hr (fun j => (htan j).2)] exact polynomial_tangentSecondForm_norm_sq_at P d hP C t ht.2 ht.1 hr /-- The squared polynomial curvature is the sum of squared moving form entries. -/ theorem curvatureNorm_sq_local (P Q : MvPolynomial (Option (Option ι)) ℝ) (d k : ℕ) (hP : P.IsHomogeneous d) (hk : 0 < k) (hQ : 0 < eval base Q) (a : ℝ) (ha : 0 < a) (hpn : eval base (pderiv none P) = a) (hpt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (hmem : ∀ᶠ t in 𝓝 (0 : ℝ), definingRoot P Q k (C t) = 0 ∧ (∑ a, (C t a)^2) = 1) : (fun t => (curvatureNorm P (C t))^2) =ᶠ[𝓝 (0 : ℝ)] (fun t => ∑ i, ∑ j, (Source29AnalyticMovingSecondForm.tangentSecondForm (definingRoot P Q k) C i j t)^2) := by filter_upwards [tangentSecondForm_local_norm_sq P Q d k hP hk hQ a ha hpn hpt C hC hC0 hmem] with t ht have hn : 0 ≤ curvaturePotential P (C t) := by rw [← ht] exact Finset.sum_nonneg (fun _ _ => Finset.sum_nonneg (fun _ _ => sq_nonneg _)) exact (Real.sq_sqrt hn).trans ht.symm /-- Equality of the nonnegative curvature norms, rather than only their squares. -/ theorem tangentSecondForm_local_norm (P Q : MvPolynomial (Option (Option ι)) ℝ) (d k : ℕ) (hP : P.IsHomogeneous d) (hk : 0 < k) (hQ : 0 < eval base Q) (a : ℝ) (ha : 0 < a) (hpn : eval base (pderiv none P) = a) (hpt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (hmem : ∀ᶠ t in 𝓝 (0 : ℝ), definingRoot P Q k (C t) = 0 ∧ (∑ a, (C t a)^2) = 1) : (fun t => Real.sqrt (∑ i, ∑ j, (Source29AnalyticMovingSecondForm.tangentSecondForm (definingRoot P Q k) C i j t)^2)) =ᶠ[𝓝 (0 : ℝ)] (fun t => curvatureNorm P (C t)) := by filter_upwards [tangentSecondForm_local_norm_sq P Q d k hP hk hQ a ha hpn hpt C hC hC0 hmem] with t ht exact congrArg Real.sqrt ht end end Source29AnalyticPositiveRootMovingCurvature /- Component: AnalyticMovingSecondFormTrace.inc -/ namespace Source29AnalyticMovingSecondFormTrace open Filter Source29AnalyticNormalTrace Source29AnalyticNormalizedLinkJets open Source29PolynomialLinkChart (Ambient base) open Source29AnalyticTangentFrame Source29AnalyticMovingSecondForm open Source29AnalyticNormalizedHessianCurve Source29AnalyticFrameLaplacian open Source29AnalyticDotSecond Source29SimonsJetCorrection Source29GaussSimonsAlgebra open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem secondForm_trace_with_frameLaplacian (f : Ambient ι → ℝ) (D g : ℝ) (hg : 0 < g) (U : Set (Ambient ι)) (hU : IsOpen U) (hx : base ∈ U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (hL : ∀ᶠ y in 𝓝 base, levelOperator f y = 0) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ι → ℝ → Ambient ι) (hC : ∀ i, AnalyticAt ℝ (C i) 0) (hC0 : ∀ i, C i 0 = base) (hmem : ∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), f (C i t) = 0 ∧ (∑ a, (C i t a)^2) = 1) (hC1 : ∀ i a, deriv (fun t => C i t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (hC2 : ∀ i a, acceleration (C i) a = -base a - A f g i i * Pi.single (M := fun _ => ℝ) none 1 a) (K : ℝ) (hJac : (∑ i, deriv (deriv (fun t => profile f (C i t))) 0) + (K+(D-1)*(D-(Fintype.card ι : ℝ)))*g⁻¹ = 0) (a b : ι) : (∑ i, deriv (deriv (tangentSecondForm f (C i) a b)) 0) = ((Fintype.card ι : ℝ)+2-K)*A f g a b + 2*matrixCube (A f g) b a + (∑ l, frameLaplacian f C a l * A f g l b) + (∑ l, frameLaplacian f C b l * A f g l a) := by obtain ⟨hrad,hthird,hfourth⟩ := Source29AnalyticHomogeneousSimonsTensor.radial_coordinate_jets f D U hU hx hcone hf hhom have hG : ∀ j k, (∑ i, ∑ l, acceleration (tangentFrame f (C i) j) (tangent l) * A f g l k) = ∑ l, frameLaplacian f C j l * A f g l k := by intro j k rw [Finset.sum_comm] simp only [frameLaplacian, Finset.sum_mul] have hN : ∀ j, (∑ i, acceleration (tangentFrame f (C i) j) none) = 0 := fun j => Source29AnalyticFrameNormalAcceleration.tangentFrame_normal_acceleration_trace f D g hg U hU hx hcone hf hhom hL hgn hgt C hC hC0 hmem hC1 hC2 j have hsq : (∑ i, A f g i a * A f g i b) = matrixSquare (A f g) a b := by unfold matrixSquare apply Finset.sum_congr rfl intro i _ rw [A_symm f g (hf base hx) i a] have hab := A_symm f g (hf base hx) b a have hwa : (∑ i, w f g i * A f g i a) = ∑ i, A f g a i * w f g i := by apply Finset.sum_congr rfl intro i _ rw [A_symm f g (hf base hx) i a] ring have hwb : (∑ i, w f g i * A f g i b) = ∑ i, A f g b i * w f g i := by apply Finset.sum_congr rfl intro i _ rw [A_symm f g (hf base hx) i b] ring simp_rw [Source29AnalyticMovingSecondForm.secondForm_second_deriv f D g hg U hU hx hf hhom hrad hthird hgn hgt (C _) (hC _) (hC0 _) (hmem _) _ a b (hC1 _)] simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib, hG, ← Finset.sum_mul, hN, zero_mul, add_zero] rw [Source29AnalyticNormalizedHessianTrace.normalizedHessian_second_trace_reduced f D g hg (hf base hx) hL hgn hgt hrad hthird hfourth C hC hC0 hC1 hC2 K ((D-1)*(D-(Fintype.card ι : ℝ))) hJac] simp only [mul_add, mul_assoc, Finset.sum_add_distrib, ← Finset.mul_sum, ite_mul, zero_mul, mul_ite, mul_one, hsq] ring_nf simp only [Finset.sum_ite_eq', Finset.mem_univ, ite_true, mul_assoc, ← Finset.mul_sum, hwa, hwb, hab] ring end end Source29AnalyticMovingSecondFormTrace /- Component: AnalyticMovingSecondFormContraction.inc -/ namespace Source29AnalyticMovingSecondFormContraction open Filter Source29AnalyticNormalTrace Source29AnalyticNormalizedLinkJets open Source29PolynomialLinkChart (Ambient base) open Source29AnalyticTangentFrame Source29AnalyticMovingSecondForm open Source29AnalyticNormalizedHessianCurve Source29AnalyticFrameLaplacian open Source29AnalyticDotSecond Source29SimonsJetCorrection Source29GaussSimonsAlgebra open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] theorem actual_second_derivative_contraction (f : Ambient ι → ℝ) (D g : ℝ) (hg : 0 < g) (U : Set (Ambient ι)) (hU : IsOpen U) (hx : base ∈ U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (hL : ∀ᶠ y in 𝓝 base, levelOperator f y = 0) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ι → ℝ → Ambient ι) (hC : ∀ i, AnalyticAt ℝ (C i) 0) (hC0 : ∀ i, C i 0 = base) (hmem : ∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), f (C i t) = 0 ∧ (∑ a, (C i t a)^2) = 1) (hC1 : ∀ i a, deriv (fun t => C i t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (hC2 : ∀ i a, acceleration (C i) a = -base a - A f g i i * Pi.single (M := fun _ => ℝ) none 1 a) (hJac : (∑ i, deriv (deriv (fun t => profile f (C i t))) 0) + (normSq (A f g)+(D-1)*(D-(Fintype.card ι : ℝ)))*g⁻¹ = 0) : (∑ i, ∑ a, ∑ b, A f g a b * deriv (deriv (tangentSecondForm f (C i) a b)) 0) = ((Fintype.card ι : ℝ)-normSq (A f g))*normSq (A f g) := by calc _ = ∑ a, ∑ b, A f g a b * (∑ i, deriv (deriv (tangentSecondForm f (C i) a b)) 0) := by rw [Finset.sum_comm] apply Finset.sum_congr rfl intro a _ rw [Finset.sum_comm] simp only [Finset.mul_sum] _ = _ := Source29FrameContractionAlgebra.contracted_trace (A f g) (frameLaplacian f C) (fun a b => ∑ i, deriv (deriv (tangentSecondForm f (C i) a b)) 0) (Fintype.card ι : ℝ) (normSq (A f g)) (A_symm f g (hf base hx)) (frameLaplacian_symmetric_part f D g hg U hU hx hf hhom hgn hgt C hC hC0 hmem hC1) (Source29AnalyticMovingSecondFormTrace.secondForm_trace_with_frameLaplacian f D g hg U hU hx hcone hf hhom hL hgn hgt C hC hC0 hmem hC1 hC2 (normSq (A f g)) hJac) end end Source29AnalyticMovingSecondFormContraction /- Component: AnalyticScalarSimons.inc -/ namespace Source29AnalyticScalarSimons open Filter Source29AnalyticNormalTrace Source29AnalyticNormalizedLinkJets open Source29AnalyticNormalizedHessianCurve Source29AnalyticMovingSecondForm open Source29AnalyticTensorNorm Source29GaussSimonsAlgebra open Source29PolynomialLinkChart (Ambient base) open Source29AnalyticDotSecond open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] def movingCurvatureNorm (f : Ambient ι → ℝ) (C : ℝ → Ambient ι) (t : ℝ) : ℝ := tensorNorm (fun j : ι × ι => tangentSecondForm f C j.1 j.2 t) /-- The scalar Simons inequality for the actual norm of the moving second fundamental form. Both Jacobi and all frame derivatives are derived. -/ theorem scalar_simons_for_link_curves (f : Ambient ι → ℝ) (D g : ℝ) (hg : 0 < g) (U : Set (Ambient ι)) (hU : IsOpen U) (hx : base ∈ U) (hcone : ∀ x ∈ U, ∀ t : ℝ, 0 < t → t • x ∈ U) (hf : ∀ x ∈ U, AnalyticAt ℝ f x) (hhom : ∀ x ∈ U, ∀ t : ℝ, 0 < t → f (t • x) = t^D * f x) (hL : ∀ᶠ y in 𝓝 base, levelOperator f y = 0) (hgn : grad f base none = g) (hgt : ∀ j, grad f base (some j) = 0) (C : ι → ℝ → Ambient ι) (hC : ∀ i, AnalyticAt ℝ (C i) 0) (hC0 : ∀ i, C i 0 = base) (hmem : ∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), f (C i t) = 0 ∧ (∑ a, (C i t a)^2) = 1) (hC1 : ∀ i a, deriv (fun t => C i t a) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 a) (hC2 : ∀ i a, acceleration (C i) a = -base a - A f g i i * Pi.single (M := fun _ => ℝ) none 1 a) (hpos : 0 < normSq (A f g)) : ((Fintype.card ι : ℝ)-normSq (A f g)) * Real.sqrt (normSq (A f g)) ≤ ∑ i, deriv (deriv (movingCurvatureNorm f (C i))) 0 := by have hJac := Source29AnalyticLinkJacobi.jacobi_of_homogeneous_link_curve_jets f D g hg U hU hx hcone hf hhom hL hgn hgt (fun i a t => C i t a) (fun i => analyticAt_pi_iff.mp (hC i)) (fun i a => congrFun (hC0 i) a) hC1 hC2 have hK : (∑ i, ∑ j, (hess f base (some (some j)) (some (some i)))^2)/g^2 = normSq (A f g) := by simp only [normSq, A, tangent, div_pow, Finset.sum_div] rw [Finset.sum_comm] rw [hK] at hJac change (∑ i, deriv (deriv (fun t => profile f (C i t))) 0) + (normSq (A f g)+(D-1)*(D-(Fintype.card ι : ℝ)))*g⁻¹ = 0 at hJac let AA : ι → ι × ι → ℝ → ℝ := fun i j => tangentSecondForm f (C i) j.1 j.2 let A0 : ι × ι → ℝ := fun j => A f g j.1 j.2 have hAA : ∀ i j, AnalyticAt ℝ (AA i j) 0 := by intro i j exact tangentSecondForm_analyticAt f D g hg U hU hx hf hhom hgn hgt (C i) (hC i) (hC0 i) (hmem i) j.1 j.2 have hAA0 : ∀ i j, AA i j 0 = A0 j := by intro i j exact tangentSecondForm_zero f g hg hgn hgt (C i) (hC0 i) j.1 j.2 have hnorm : tensorNorm A0 = Real.sqrt (normSq (A f g)) := by simp only [tensorNorm, A0, normSq, Fintype.sum_prod_type] have hs : (tensorNorm A0)^2 = normSq (A f g) := by rw [hnorm, Real.sq_sqrt hpos.le] have hp : 0 < tensorNorm A0 := by rw [hnorm]; exact Real.sqrt_pos.mpr hpos have hne : A0 ≠ 0 := by intro he simp only [he, tensorNorm, Pi.zero_apply, zero_pow (by decide : 2 ≠ 0), Finset.sum_const_zero, Real.sqrt_zero] at hp exact lt_irrefl _ hp have hh : ∀ i, AnalyticAt ℝ (movingCurvatureNorm f (C i)) 0 := by intro i apply tensorNorm_analyticAt (fun t j => AA i j t) 0 (hAA i) simpa only [hAA0] using hne have hcontract := Source29AnalyticMovingSecondFormContraction.actual_second_derivative_contraction f D g hg U hU hx hcone hf hhom hL hgn hgt C hC hC0 hmem hC1 hC2 hJac have he := Source29ContractedSimonsNorm.scalar_simons_for_analytic_components AA (fun i => movingCurvatureNorm f (C i)) A0 (tensorNorm A0) (Fintype.card ι : ℝ) hh hAA (fun i => congrArg tensorNorm (funext (hAA0 i))) hAA0 hp (tensorNorm_sq A0) (fun i => Eventually.of_forall (fun t => tensorNorm_sq (fun j => AA i j t))) (by simpa only [AA, A0, Fintype.sum_prod_type, hs] using hcontract) simpa only [hs, hnorm, Real.sq_sqrt hpos.le] using he end end Source29AnalyticScalarSimons /- Component: PositiveRootNormalization.inc -/ namespace Source29PositiveRootNormalization open MvPolynomial Source29PolynomialLinkChart open Source29QuarticReuse.QuarticMinimal open scoped BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- One orthogonal change normalizes the factor and cofactor together while preserving the equation only assumed for their product. -/ theorem exists_normalized_factors (P Q : MvPolynomial (Option (Option ι)) ℝ) (p q k : ℕ) (hP : P.IsHomogeneous p) (hQ : Q.IsHomogeneous q) (hF : leadingOperator (P^k*Q) = 0) (x : Ambient ι) (hx : (∑ a, (x a)^2) = 1) (hzero : eval x P = 0) (hpos : 0 < eval x Q) (hreg : (fun a => eval x (pderiv a P)) ≠ 0) : ∃ (a : ℝ) (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ), 0 < a ∧ U.transpose * U = 1 ∧ U * U.transpose = 1 ∧ U *ᵥ base = x ∧ (changeVariables U P).IsHomogeneous p ∧ (changeVariables U Q).IsHomogeneous q ∧ leadingOperator ((changeVariables U P)^k * changeVariables U Q) = 0 ∧ eval base (changeVariables U P) = 0 ∧ 0 < eval base (changeVariables U Q) ∧ eval base (pderiv none (changeVariables U P)) = a ∧ (∀ j, eval base (pderiv (some j) (changeVariables U P)) = 0) := by obtain ⟨a,U,ha,hUt,hcol,hgrad⟩ := Source29RegularPolynomialLinkFrankel.exists_radial_normal_frame P p hP x hx hzero hreg have hU : U*U.transpose = 1 := mul_eq_one_comm.mp hUt have hbase : U *ᵥ base = x := by funext j have he := congrFun hcol j simpa [Matrix.mulVec, dotProduct, base, Pi.single_apply, Source29ClosestPairStationarity.column] using he have horth : ∀ j, (∑ b, U b none * U b j) = if none = j then 1 else 0 := by intro j have he := congrArg (fun M : Matrix (Option (Option ι)) (Option (Option ι)) ℝ => M none j) hUt simpa only [Matrix.mul_apply, Matrix.transpose_apply, Matrix.one_apply] using he have hpartial : ∀ j, eval base (pderiv j (changeVariables U P)) = a * (if none = j then 1 else 0) := by intro j rw [pderiv_changeVariables, map_sum] simp only [map_mul, eval_C, eval_changeVariables, hbase] simp_rw [hgrad, mul_assoc] rw [← Finset.mul_sum, horth] refine ⟨a,U,ha,hUt,hU,hbase,isHomogeneous_changeVariables U P p hP, isHomogeneous_changeVariables U Q q hQ,?_,?_,?_,?_,?_⟩ · simpa only [map_mul, map_pow] using leadingOperator_changeVariables_eq_zero U hU (P^k*Q) hF · rw [eval_changeVariables, hbase, hzero] · rwa [eval_changeVariables, hbase] · simpa using hpartial none · intro j simpa using hpartial (some j) end end Source29PositiveRootNormalization /- Component: WeightedJacobiTransport.inc -/ namespace Source29WeightedJacobiTransport open Filter MvPolynomial Source29PolynomialLinkChart open Source29PolynomialJacobiCurves Source29PolynomialJacobiTransport open Source29QuarticReuse.QuarticMinimal open Source29AnalyticNormalTrace Source29AnalyticTensorNorm open scoped Topology BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- The weighted inverse-gradient profile, defined on a neighborhood of every regular zero where the cofactor is positive. -/ def weightedProfile (P Q : MvPolynomial (Option (Option ι)) ℝ) (k : ℕ) (x : Ambient ι) : ℝ := ((eval x Q)^((k : ℝ)⁻¹))⁻¹ * jacobiProfile P x theorem weightedProfile_positive (P Q : MvPolynomial (Option (Option ι)) ℝ) (k : ℕ) (x : Ambient ι) (hQ : 0 < eval x Q) (hreg : (fun a => eval x (pderiv a P)) ≠ 0) : 0 < weightedProfile P Q k x := mul_pos (inv_pos.mpr (Real.rpow_pos_of_pos hQ _)) (jacobiProfile_positive P x hreg) theorem weightedProfile_analyticAt (P Q : MvPolynomial (Option (Option ι)) ℝ) (k : ℕ) (hk : 0 < k) (x : Ambient ι) (hQ : 0 < eval x Q) (hreg : (fun a => eval x (pderiv a P)) ≠ 0) : AnalyticAt ℝ (weightedProfile P Q k) x := ((Source29FinitePositiveCofactorRoot.rootUnit_analyticAt Q k hk x hQ).inv (Real.rpow_pos_of_pos hQ _).ne').mul (jacobiProfile_analyticAt P x hreg) theorem weightedProfile_changeVariables (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (hU : U*U.transpose = 1) (P Q : MvPolynomial (Option (Option ι)) ℝ) (k : ℕ) (x : Ambient ι) : weightedProfile (changeVariables U P) (changeVariables U Q) k x = weightedProfile P Q k (U *ᵥ x) := by simp only [weightedProfile, eval_changeVariables, jacobiProfile_changeVariables U hU] omit [DecidableEq ι] in theorem definingRoot_changeVariables (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (P Q : MvPolynomial (Option (Option ι)) ℝ) (k : ℕ) (x : Ambient ι) : Source29FinitePositiveCofactorRoot.definingRoot (changeVariables U P) (changeVariables U Q) k x = Source29FinitePositiveCofactorRoot.definingRoot P Q k (U *ᵥ x) := by simp only [Source29FinitePositiveCofactorRoot.definingRoot, eval_changeVariables] /-- On the zero hypersurface the weighted profile is the actual inverse norm of the analytic defining root's gradient. -/ theorem rootProfile_eq_weightedProfile (P Q : MvPolynomial (Option (Option ι)) ℝ) (k : ℕ) (hk : 0 < k) (x : Ambient ι) (hP : eval x P = 0) (hQ : 0 < eval x Q) : (tensorNorm (grad (Source29FinitePositiveCofactorRoot.definingRoot P Q k) x))⁻¹ = weightedProfile P Q k x := by rw [Source29FinitePositiveCofactorRoot.definingRoot_gradient P Q k hk x hP hQ, Source29PositiveCofactorRoot.tensorNorm_scale_pos _ _ (Real.rpow_pos_of_pos hQ _)] simp only [weightedProfile, jacobiProfile, mul_inv_rev] ring /-- Along an actual root-zero curve the profile equality holds as a germ, so its first and second derivatives can be transported. -/ theorem rootProfile_curve_eq (P Q : MvPolynomial (Option (Option ι)) ℝ) (k : ℕ) (hk : 0 < k) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hQ : 0 < eval (C 0) Q) (hzero : ∀ᶠ t in 𝓝 (0 : ℝ), Source29FinitePositiveCofactorRoot.definingRoot P Q k (C t) = 0) : (fun t => (tensorNorm (grad (Source29FinitePositiveCofactorRoot.definingRoot P Q k) (C t)))⁻¹) =ᶠ[𝓝 (0 : ℝ)] (fun t => weightedProfile P Q k (C t)) := by have hnear := ((analyticAt_eval_real Q (C 0)).comp hC).continuousAt.eventually (eventually_gt_nhds hQ) filter_upwards [hzero,hnear] with t ht hqt have hp : eval (C t) P = 0 := (mul_eq_zero.mp ht).resolve_right (Real.rpow_pos_of_pos hqt _).ne' exact rootProfile_eq_weightedProfile P Q k hk (C t) hp hqt end end Source29WeightedJacobiTransport /- Final component: AnalyticPositiveRootScalarSimons -/ namespace Source29AnalyticPositiveRootScalarSimons open Filter MvPolynomial Source29AnalyticNormalTrace open Source29PolynomialLinkChart (Ambient base analyticAt_eval_real) open Source29PolynomialCurvaturePotential Source29FinitePositiveCofactorRoot open Source29AnalyticNormalizedHessianCurve Source29AnalyticNormalizedLinkJets open Source29AnalyticScalarSimons Source29AnalyticTensorNorm Source29GaussSimonsAlgebra open scoped Topology BigOperators noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- The norm used by scalar Simons is locally the original polynomial's invariant curvature norm, including its derivatives along the curve. -/ theorem movingCurvatureNorm_eventuallyEq (P Q : MvPolynomial (Option (Option ι)) ℝ) (d k : ℕ) (hP : P.IsHomogeneous d) (hk : 0 < k) (hQ : 0 < eval base Q) (a : ℝ) (ha : 0 < a) (hpn : eval base (pderiv none P) = a) (hpt : ∀ j, eval base (pderiv (some j) P) = 0) (C : ℝ → Ambient ι) (hC : AnalyticAt ℝ C 0) (hC0 : C 0 = base) (hmem : ∀ᶠ t in 𝓝 (0 : ℝ), definingRoot P Q k (C t) = 0 ∧ (∑ a, (C t a)^2) = 1) : movingCurvatureNorm (definingRoot P Q k) C =ᶠ[𝓝 (0 : ℝ)] (fun t => curvatureNorm P (C t)) := by filter_upwards [Source29AnalyticPositiveRootMovingCurvature.tangentSecondForm_local_norm P Q d k hP hk hQ a ha hpn hpt C hC hC0 hmem] with t ht simpa only [movingCurvatureNorm, tensorNorm, Fintype.sum_prod_type] using ht /-- Actual analytic curves on the polynomial link satisfy weighted Jacobi and scalar Simons. Only the full product P^kQ is required to solve the cubic equation; the effective homogeneous degree is the real number p+q/k. -/ theorem exists_simons_jacobi_curves (P Q : MvPolynomial (Option (Option ι)) ℝ) (p q k : ℕ) (hk : 0 < k) (hP : P.IsHomogeneous p) (hQ : Q.IsHomogeneous q) (hF : Source29QuarticReuse.QuarticMinimal.leadingOperator (P^k*Q) = 0) (hzero : eval base P = 0) (hpos : 0 < eval base Q) (a : ℝ) (ha : 0 < a) (hpn : eval base (pderiv none P) = a) (hpt : ∀ j, eval base (pderiv (some j) P) = 0) (hcurv : 0 < curvaturePotential P base) : ∃ C : ι → ℝ → Ambient ι, (∀ i, AnalyticAt ℝ (C i) 0) ∧ (∀ i, C i 0 = base) ∧ (∀ i b, deriv (fun t => C i t b) 0 = Pi.single (M := fun _ => ℝ) (tangent i) 1 b) ∧ (∀ i b, deriv (deriv (fun t => C i t b)) 0 = -base b - (eval base (pderiv (tangent i) (pderiv (tangent i) P))/a) * Pi.single (M := fun _ => ℝ) none 1 b) ∧ (∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), eval (C i t) P = 0 ∧ (∑ a, (C i t a)^2) = 1) ∧ (∀ i, AnalyticAt ℝ (fun t => profile (definingRoot P Q k) (C i t)) 0) ∧ (∀ i, AnalyticAt ℝ (fun t => curvatureNorm P (C i t)) 0) ∧ ((∑ i, deriv (deriv (fun t => profile (definingRoot P Q k) (C i t))) 0) + (curvaturePotential P base + (((p : ℝ)+(q : ℝ)/(k : ℝ))-1)* (((p : ℝ)+(q : ℝ)/(k : ℝ))-(Fintype.card ι : ℝ))) * profile (definingRoot P Q k) base = 0) ∧ (((Fintype.card ι : ℝ)-curvaturePotential P base)*curvatureNorm P base ≤ ∑ i, deriv (deriv (fun t => curvatureNorm P (C i t))) 0) := by obtain ⟨J⟩ := Source29AnalyticPositiveRootJacobi.definingRoot_link_jacobi P Q p q k hk hP hQ hF hzero hpos a ha hpn hpt let f := definingRoot P Q k let D : ℝ := (p : ℝ)+(q : ℝ)/(k : ℝ) let g : ℝ := (eval base Q)^((k : ℝ)⁻¹)*a let C : ι → ℝ → Ambient ι := fun i t b => J.curve i b t have hC : ∀ i, AnalyticAt ℝ (C i) 0 := fun i => AnalyticAt.pi (J.analytic i) have hC0 : ∀ i, C i 0 = base := fun i => funext (J.initial i) have hmem : ∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), f (C i t) = 0 ∧ (∑ b, (C i t b)^2) = 1 := J.level_sphere have hPmem : ∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), eval (C i t) P = 0 ∧ (∑ b, (C i t b)^2) = 1 := by intro i have hQ0 : 0 < eval (C i 0) Q := by simpa only [hC0] using hpos have hQnear := ((analyticAt_eval_real Q (C i 0)).comp (hC i)).continuousAt.eventually (eventually_gt_nhds hQ0) filter_upwards [hmem i, hQnear] with t ht hqt exact ⟨(mul_eq_zero.mp ht.1).resolve_right (Real.rpow_pos_of_pos hqt _).ne', ht.2⟩ have hg : 0 < g := mul_pos (Real.rpow_pos_of_pos hpos _) ha have hreg : gradientAt P base ≠ 0 := by intro he have hn := congrFun he none exact ha.ne' (by simpa only [gradientAt, hpn, Pi.zero_apply] using hn) have hgn : grad f base none = g := by rw [definingRoot_gradient P Q k hk base hzero hpos] simp only [g, hpn] have hgt : ∀ j, grad f base (some j) = 0 := by intro j rw [definingRoot_gradient P Q k hk base hzero hpos] simp only [hpt, mul_zero] have hK : normSq (A f g) = curvaturePotential P base := Source29AnalyticPositiveRootCurvature.normSq_normalized_hessian_eq_curvaturePotential P Q p k hk hP hzero hpos a ha.ne' hpn hpt have hprofile : ∀ i, AnalyticAt ℝ (fun t => profile f (C i t)) 0 := J.profile_analytic have hc : ∀ i, AnalyticAt ℝ (fun t => curvatureNorm P (C i t)) 0 := by intro i have he : AnalyticAt ℝ (curvatureNorm P) (C i 0) := by rw [hC0] exact Source29PolynomialCurvatureRegularity.curvatureNorm_analyticAt P base hreg hcurv exact he.comp (hC i) have hJac := J.jacobi have hKn : (∑ i, ∑ j, (hess f base (some (some j)) (some (some i)))^2)/g^2 = curvaturePotential P base := by rw [← hK] simp only [normSq, A, tangent, div_pow, Finset.sum_div] rw [Finset.sum_comm] change (∑ i, deriv (deriv (fun t => profile f (C i t))) 0) + ((∑ i, ∑ j, (hess f base (some (some j)) (some (some i)))^2)/g^2 + (D-1)*(D-(Fintype.card ι : ℝ)))*g⁻¹ = 0 at hJac rw [hKn, ← profile_at_base f g hg hgn hgt] at hJac have hC2 : ∀ i b, Source29AnalyticDotSecond.acceleration (C i) b = -base b - A f g i i * Pi.single (M := fun _ => ℝ) none 1 b := J.acceleration have hC2P : ∀ i b, deriv (deriv (fun t => C i t b)) 0 = -base b - (eval base (pderiv (tangent i) (pderiv (tangent i) P))/a) * Pi.single (M := fun _ => ℝ) none 1 b := by intro i b have he := hC2 i b change deriv (deriv (fun t => C i t b)) 0 = -base b - A (definingRoot P Q k) ((eval base Q)^((k : ℝ)⁻¹)*a) i i * Pi.single (M := fun _ => ℝ) none 1 b at he rwa [Source29AnalyticPositiveRootCurvature.normalized_hessian_eq P Q k hk hzero hpos a hpt] at he refine ⟨C, hC, hC0, J.velocity, hC2P, hPmem, hprofile, hc, hJac, ?_⟩ let U : Set (Ambient ι) := {x | 0 < eval x Q} have hU : IsOpen U := isOpen_lt continuous_const (show Continuous (fun x => eval x Q) from continuous_iff_continuousAt.mpr (fun x => (analyticAt_eval_real Q x).continuousAt)) have hS := scalar_simons_for_link_curves f D g hg U hU hpos (fun x hx t ht => eval_smul_pos Q q hQ x hx t ht) (fun x hx => definingRoot_analyticAt P Q k hk x hx) (fun x hx t ht => definingRoot_smul P Q p q k hP hQ x hx t ht) (definingRoot_levelOperator_zero P Q k hk hF base hzero hpos hreg) hgn hgt C hC hC0 hmem J.velocity hC2 (hK.symm ▸ hcurv) have he : ∀ i, movingCurvatureNorm f (C i) =ᶠ[𝓝 (0 : ℝ)] (fun t => curvatureNorm P (C i t)) := by intro i exact movingCurvatureNorm_eventuallyEq P Q p k hP hk hpos a ha hpn hpt (C i) (hC i) (hC0 i) (hmem i) have hd : ∀ i, deriv (deriv (movingCurvatureNorm f (C i))) 0 = deriv (deriv (fun t => curvatureNorm P (C i t))) 0 := fun i => (he i).deriv.deriv_eq simpa only [hK, hd, curvatureNorm] using hS end end Source29AnalyticPositiveRootScalarSimons /- Final component: RegularPositiveRootJacobi -/ namespace Source29RegularPositiveRootJacobi open Filter MvPolynomial Source29PolynomialLinkChart open Source29PolynomialCurvaturePotential Source29PolynomialJacobiTransport open Source29WeightedJacobiTransport Source29AnalyticNormalTrace open Source29FinitePositiveCofactorRoot Source29AnalyticTensorNorm open Source29QuarticReuse.QuarticMinimal open scoped Topology BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- The positive-root Jacobi identity at any regular point of the original polynomial link. Only the product P^k Q is assumed to satisfy the cubic level equation. The curves and their first two jets are constructed. -/ theorem exists_regular_link_jacobi_curves (P Q : MvPolynomial (Option (Option ι)) ℝ) (p q k : ℕ) (hk : 0 < k) (hP : P.IsHomogeneous p) (hQ : Q.IsHomogeneous q) (hF : leadingOperator (P^k*Q) = 0) (x : Ambient ι) (hx : (∑ a, (x a)^2) = 1) (hzero : eval x P = 0) (hpos : 0 < eval x Q) (hreg : gradientAt P x ≠ 0) : ∃ (a : ℝ) (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (C : ι → ℝ → Ambient ι), 0 < a ∧ U.transpose * U = 1 ∧ U * U.transpose = 1 ∧ U *ᵥ base = x ∧ eval base (pderiv none (changeVariables U P)) = a ∧ (∀ j, eval base (pderiv (some j) (changeVariables U P)) = 0) ∧ (∀ i, AnalyticAt ℝ (C i) 0) ∧ (∀ i, C i 0 = x) ∧ (∀ i b, deriv (fun t => C i t b) 0 = U b (some (some i))) ∧ (∀ i b, deriv (deriv (fun t => C i t b)) 0 = -x b - (eval base (pderiv (some (some i)) (pderiv (some (some i)) (changeVariables U P)))/a) * U b none) ∧ (∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), eval (C i t) P = 0 ∧ (∑ b, (C i t b)^2) = 1) ∧ (∀ i, AnalyticAt ℝ (fun t => weightedProfile P Q k (C i t)) 0) ∧ 0 < weightedProfile P Q k x ∧ ((∑ i, deriv (deriv (fun t => weightedProfile P Q k (C i t))) 0) + (curvaturePotential P x + (((p : ℝ)+(q : ℝ)/(k : ℝ))-1)*(((p : ℝ)+(q : ℝ)/(k : ℝ))-(Fintype.card ι : ℝ))) * weightedProfile P Q k x = 0) := by obtain ⟨a,U,ha,hUt,hU,hbase,hPhom,hQhom,hF',hPzero,hQpos,hpn,hpt⟩ := Source29PositiveRootNormalization.exists_normalized_factors P Q p q k hP hQ hF x hx hzero hpos hreg obtain ⟨J⟩ := Source29AnalyticPositiveRootJacobi.definingRoot_link_jacobi (changeVariables U P) (changeVariables U Q) p q k hk hPhom hQhom hF' hPzero hQpos a ha hpn hpt let C : ι → ℝ → Ambient ι := fun i t => U *ᵥ (fun b => J.curve i b t) have hC : ∀ i, AnalyticAt ℝ (C i) 0 := fun i => Source29LinearCurveTransport.analytic_mulVec U (J.curve i) (J.analytic i) have hC0 : ∀ i, C i 0 = x := by intro i change U *ᵥ (fun b => J.curve i b 0) = x rw [show (fun b => J.curve i b 0) = base from funext (J.initial i), hbase] have hrad : ∀ b, U b (some none) = x b := by intro b have he := congrFun hbase b simpa [Matrix.mulVec, dotProduct, base, Pi.single_apply] using he have hH (i j : ι) : hess (definingRoot (changeVariables U P) (changeVariables U Q) k) base (some (some i)) (some (some j)) / ((eval base (changeVariables U Q))^((k : ℝ)⁻¹)*a) = eval base (pderiv (some (some i)) (pderiv (some (some j)) (changeVariables U P))) / a := Source29AnalyticPositiveRootCurvature.normalized_hessian_eq (changeVariables U P) (changeVariables U Q) k hk hPzero hQpos a hpt i j have hnearQ (i : ι) : ∀ᶠ t in 𝓝 (0 : ℝ), 0 < eval (fun b => J.curve i b t) (changeVariables U Q) := by have he : (fun b => J.curve i b 0) = base := funext (J.initial i) have hq0 : 0 < eval (fun b => J.curve i b 0) (changeVariables U Q) := by rw [he] exact hQpos have ht := ((analyticAt_eval_real (changeVariables U Q) (fun b => J.curve i b 0)).comp (AnalyticAt.pi (J.analytic i))).continuousAt exact ht.eventually (eventually_gt_nhds hq0) have hzeroCurve (i : ι) : ∀ᶠ t in 𝓝 (0 : ℝ), eval (fun b => J.curve i b t) (changeVariables U P) = 0 := by filter_upwards [J.level_sphere i, hnearQ i] with t ht hqt exact (mul_eq_zero.mp ht.1).resolve_right (Real.rpow_pos_of_pos hqt _).ne' have hprofile (i : ι) : (fun t => (tensorNorm (grad (definingRoot (changeVariables U P) (changeVariables U Q) k) (fun b => J.curve i b t)))⁻¹) =ᶠ[𝓝 (0 : ℝ)] (fun t => weightedProfile P Q k (C i t)) := by filter_upwards [hzeroCurve i, hnearQ i] with t ht hqt rw [rootProfile_eq_weightedProfile _ _ k hk _ ht hqt, weightedProfile_changeVariables U hU] have hprofile0 : ((eval base (changeVariables U Q))^((k : ℝ)⁻¹)*a)⁻¹ = weightedProfile P Q k x := by rw [← hbase, ← weightedProfile_changeVariables U hU] simp only [weightedProfile, Source29PolynomialJacobiCurves.jacobiProfile_at_base _ a ha hpn hpt, mul_inv_rev] ring have hpotential : (∑ i, ∑ j, (hess (definingRoot (changeVariables U P) (changeVariables U Q) k) base (some (some j)) (some (some i)))^2) / ((eval base (changeVariables U Q))^((k : ℝ)⁻¹)*a)^2 = curvaturePotential P x := by rw [← hbase, ← curvaturePotential_changeVariables U hU P base, Source29AnalyticPositiveRootCurvature.curvaturePotential_at_base (changeVariables U P) p hPhom a ha.ne' hpn hpt] simp only [Finset.sum_div, ← div_pow, hH] exact Finset.sum_comm refine ⟨a,U,C,ha,hUt,hU,hbase,hpn,hpt,hC,hC0,?_,?_,?_,?_, weightedProfile_positive P Q k x hpos hreg,?_⟩ · intro i b change deriv (fun t => (U *ᵥ (fun j => J.curve i j t)) b) 0 = _ rw [Source29LinearCurveTransport.first_mulVec U (J.curve i) (J.analytic i) b] simp [J.velocity, Pi.single_apply] · intro i b change deriv (deriv (fun t => (U *ᵥ (fun j => J.curve i j t)) b)) 0 = _ rw [Source29LinearCurveTransport.second_mulVec U (J.curve i) (J.analytic i) b] simp only [J.acceleration, hH, mul_sub, mul_neg, Finset.sum_sub_distrib, Finset.sum_neg_distrib, Pi.single_apply, mul_ite, mul_one, mul_zero, Finset.sum_ite_eq', Finset.mem_univ, ite_true] rw [hrad] ring · intro i filter_upwards [hzeroCurve i, J.level_sphere i] with t ht hs constructor · change eval (U *ᵥ (fun b => J.curve i b t)) P = 0 rw [← eval_changeVariables] exact ht · change (∑ b, (U *ᵥ (fun j => J.curve i j t)) b ^ 2) = 1 rw [norm_square_mulVec U hUt] exact hs.2 · intro i have he := (weightedProfile_analyticAt P Q k hk x hpos hreg) rw [← hC0 i] at he exact he.comp (hC i) · have hJ := J.jacobi rw [hpotential, hprofile0] at hJ convert hJ using 1 congr 1 apply Finset.sum_congr rfl intro i _ exact (hprofile i).deriv.deriv_eq.symm end end Source29RegularPositiveRootJacobi /- Final component: RegularPositiveRootSimons -/ namespace Source29RegularPositiveRootSimons open Filter MvPolynomial Source29PolynomialLinkChart open Source29PolynomialCurvaturePotential Source29PolynomialJacobiTransport open Source29WeightedJacobiTransport Source29AnalyticNormalTrace open Source29FinitePositiveCofactorRoot Source29AnalyticTensorNorm open Source29AnalyticNormalizedHessianCurve open Source29QuarticReuse.QuarticMinimal open scoped Topology BigOperators Matrix noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- At any regular unit zero with positive cofactor and positive curvature, one family of actual link curves satisfies both weighted Jacobi and scalar Simons. The only cubic equation is that of the product P^k Q. -/ theorem exists_regular_simons_jacobi_curves (P Q : MvPolynomial (Option (Option ι)) ℝ) (p q k : ℕ) (hk : 0 < k) (hP : P.IsHomogeneous p) (hQ : Q.IsHomogeneous q) (hF : leadingOperator (P^k*Q) = 0) (x : Ambient ι) (hx : (∑ a, (x a)^2) = 1) (hzero : eval x P = 0) (hpos : 0 < eval x Q) (hreg : gradientAt P x ≠ 0) (hcurv : 0 < curvaturePotential P x) : ∃ (a : ℝ) (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ) (C : ι → ℝ → Ambient ι), 0 < a ∧ U.transpose * U = 1 ∧ U * U.transpose = 1 ∧ U *ᵥ base = x ∧ eval base (pderiv none (changeVariables U P)) = a ∧ (∀ j, eval base (pderiv (some j) (changeVariables U P)) = 0) ∧ (∀ i, AnalyticAt ℝ (C i) 0) ∧ (∀ i, C i 0 = x) ∧ (∀ i b, deriv (fun t => C i t b) 0 = U b (some (some i))) ∧ (∀ i b, deriv (deriv (fun t => C i t b)) 0 = -x b - (eval base (pderiv (some (some i)) (pderiv (some (some i)) (changeVariables U P)))/a) * U b none) ∧ (∀ i, ∀ᶠ t in 𝓝 (0 : ℝ), eval (C i t) P = 0 ∧ (∑ b, (C i t b)^2) = 1) ∧ (∀ i, AnalyticAt ℝ (fun t => weightedProfile P Q k (C i t)) 0) ∧ (∀ i, AnalyticAt ℝ (fun t => curvatureNorm P (C i t)) 0) ∧ 0 < weightedProfile P Q k x ∧ ((∑ i, deriv (deriv (fun t => weightedProfile P Q k (C i t))) 0) + (curvaturePotential P x + (((p : ℝ)+(q : ℝ)/(k : ℝ))-1)*(((p : ℝ)+(q : ℝ)/(k : ℝ))-(Fintype.card ι : ℝ))) * weightedProfile P Q k x = 0) ∧ (((Fintype.card ι : ℝ)-curvaturePotential P x)*curvatureNorm P x ≤ ∑ i, deriv (deriv (fun t => curvatureNorm P (C i t))) 0) := by obtain ⟨a,U,ha,hUt,hU,hbase,hPhom,hQhom,hF',hPzero,hQpos,hpn,hpt⟩ := Source29PositiveRootNormalization.exists_normalized_factors P Q p q k hP hQ hF x hx hzero hpos hreg have hK : curvaturePotential (changeVariables U P) base = curvaturePotential P x := by rw [curvaturePotential_changeVariables U hU, hbase] have hKpos : 0 < curvaturePotential (changeVariables U P) base := hK.symm ▸ hcurv obtain ⟨D,hD,hD0,hD1,hD2,hDmem,hDu,hDv,hJ,hS⟩ := Source29AnalyticPositiveRootScalarSimons.exists_simons_jacobi_curves (changeVariables U P) (changeVariables U Q) p q k hk hPhom hQhom hF' hPzero hQpos a ha hpn hpt hKpos let C : ι → ℝ → Ambient ι := fun i t => U *ᵥ D i t have hC : ∀ i, AnalyticAt ℝ (C i) 0 := by intro i exact Source29LinearCurveTransport.analytic_mulVec U (fun b t => D i t b) (fun b => (analyticAt_pi_iff.mp (hD i)) b) have hC0 : ∀ i, C i 0 = x := by intro i change U *ᵥ D i 0 = x rw [hD0, hbase] have hrad : ∀ b, U b (some none) = x b := by intro b have he := congrFun hbase b simpa [Matrix.mulVec, dotProduct, base, Pi.single_apply] using he have hprofile (i : ι) : (fun t => profile (definingRoot (changeVariables U P) (changeVariables U Q) k) (D i t)) =ᶠ[𝓝 (0 : ℝ)] (fun t => weightedProfile P Q k (C i t)) := by have hq0 : 0 < eval (D i 0) (changeVariables U Q) := by rw [hD0]; exact hQpos have hnearQ := ((analyticAt_eval_real (changeVariables U Q) (D i 0)).comp (hD i)).continuousAt.eventually (eventually_gt_nhds hq0) filter_upwards [hDmem i,hnearQ] with t ht hqt change (tensorNorm (grad (definingRoot (changeVariables U P) (changeVariables U Q) k) (D i t)))⁻¹ = _ rw [rootProfile_eq_weightedProfile _ _ k hk _ ht.1 hqt, weightedProfile_changeVariables U hU] have hprofile0 : profile (definingRoot (changeVariables U P) (changeVariables U Q) k) base = weightedProfile P Q k x := by change (tensorNorm (grad (definingRoot (changeVariables U P) (changeVariables U Q) k) base))⁻¹ = _ rw [rootProfile_eq_weightedProfile _ _ k hk _ hPzero hQpos, weightedProfile_changeVariables U hU, hbase] have hv (i : ι) : (fun t => curvatureNorm (changeVariables U P) (D i t)) = (fun t => curvatureNorm P (C i t)) := by funext t exact curvatureNorm_changeVariables U hU P (D i t) have hv0 : curvatureNorm (changeVariables U P) base = curvatureNorm P x := by rw [curvatureNorm_changeVariables U hU, hbase] refine ⟨a,U,C,ha,hUt,hU,hbase,hpn,hpt,hC,hC0,?_,?_,?_,?_,?_, weightedProfile_positive P Q k x hpos hreg,?_,?_⟩ · intro i b change deriv (fun t => (U *ᵥ D i t) b) 0 = _ rw [Source29LinearCurveTransport.first_mulVec U (fun j t => D i t j) (fun j => (analyticAt_pi_iff.mp (hD i)) j) b] simp [hD1, Pi.single_apply, Source29AnalyticNormalizedLinkJets.tangent] · intro i b change deriv (deriv (fun t => (U *ᵥ D i t) b)) 0 = _ rw [Source29LinearCurveTransport.second_mulVec U (fun j t => D i t j) (fun j => (analyticAt_pi_iff.mp (hD i)) j) b] simp only [hD2, Source29AnalyticNormalizedLinkJets.tangent, base, mul_sub, mul_neg, Finset.sum_sub_distrib, Finset.sum_neg_distrib, Pi.single_apply, mul_ite, mul_one, mul_zero, Finset.sum_ite_eq', Finset.mem_univ, ite_true] rw [hrad] ring · intro i filter_upwards [hDmem i] with t ht constructor · change eval (U *ᵥ D i t) P = 0 rw [← eval_changeVariables] exact ht.1 · change (∑ b, (U *ᵥ D i t) b ^ 2) = 1 rw [norm_square_mulVec U hUt] exact ht.2 · intro i have he := weightedProfile_analyticAt P Q k hk x hpos hreg rw [← hC0 i] at he exact he.comp (hC i) · intro i rw [← hv i] exact hDv i · rw [hK, hprofile0] at hJ convert hJ using 1 congr 1 apply Finset.sum_congr rfl intro i _ exact (hprofile i).deriv.deriv_eq.symm · simpa only [hK, hv0, hv] using hS end end Source29RegularPositiveRootSimons /- Final component: RegularHomogeneousNonflatness -/ namespace Source29RegularHomogeneousNonflatness open MvPolynomial Source29PolynomialLinkChart Source29PolynomialCurvaturePotential open Source29QuarticReuse.QuarticMinimal Source29PolynomialLinkNonflatness open Source29QuarticReuse.QuarticNormalization (eval_scale_of_isHomogeneous) open scoped BigOperators Matrix Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Normalization of a regular homogeneous zero needs no equation for P. -/ theorem exists_normalized_polynomial (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (x : Ambient ι) (hx : (∑ a, (x a)^2) = 1) (hzero : eval x P = 0) (hreg : (fun a => eval x (pderiv a P)) ≠ 0) : ∃ (a : ℝ) (U : Matrix (Option (Option ι)) (Option (Option ι)) ℝ), 0 < a ∧ U.transpose * U = 1 ∧ U * U.transpose = 1 ∧ U *ᵥ base = x ∧ (changeVariables U P).IsHomogeneous d ∧ eval base (changeVariables U P) = 0 ∧ eval base (pderiv none (changeVariables U P)) = a ∧ (∀ j, eval base (pderiv (some j) (changeVariables U P)) = 0) := by obtain ⟨a,U,ha,hUt,hcol,hgrad⟩ := Source29RegularPolynomialLinkFrankel.exists_radial_normal_frame P d hP x hx hzero hreg have hU : U*U.transpose = 1 := mul_eq_one_comm.mp hUt have hbase : U *ᵥ base = x := by funext j have he := congrFun hcol j simpa [Matrix.mulVec, dotProduct, base, Pi.single_apply, Source29ClosestPairStationarity.column] using he have horth : ∀ j, (∑ b, U b none * U b j) = if none = j then 1 else 0 := by intro j have he := congrArg (fun M : Matrix (Option (Option ι)) (Option (Option ι)) ℝ => M none j) hUt simpa only [Matrix.mul_apply, Matrix.transpose_apply, Matrix.one_apply] using he have hpartial : ∀ j, eval base (pderiv j (changeVariables U P)) = a * (if none = j then 1 else 0) := by intro j rw [pderiv_changeVariables, map_sum] simp only [map_mul, eval_C, eval_changeVariables, hbase] simp_rw [hgrad, mul_assoc] rw [← Finset.mul_sum, horth] refine ⟨a,U,ha,hUt,hU,hbase,isHomogeneous_changeVariables U P d hP,?_,?_,?_⟩ · rw [eval_changeVariables, hbase, hzero] · simpa using hpartial none · intro j simpa using hpartial (some j) theorem exists_positive_curvature_on_link (P : MvPolynomial (Option (Option ι)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hirr : Irreducible P) (hd : 2 ≤ d) (x : Ambient ι) (hx : (∑ a, (x a)^2) = 1) (hz : eval x P = 0) (hreg : gradientAt P x ≠ 0) : ∃ y : Ambient ι, (eval y P = 0 ∧ (∑ a, (y a)^2) = 1) ∧ 0 < curvaturePotential P y := by obtain ⟨g, U, hg, hUt, hU, hbase, hQ, hQzero, hgn, hgt⟩ := exists_normalized_polynomial P d hP x hx hz hreg let Q := changeVariables U P have hiQ : Irreducible Q := (MulEquiv.irreducible_iff (orthogonalPolynomialEquiv U hU hUt)).mpr hirr have hdQ : 2 ≤ Q.totalDegree := by rw [hQ.totalDegree hiQ.ne_zero] exact hd have hS : {z : Ambient ι | z (some none) ≠ 0} ∈ 𝓝 (base : Ambient ι) := (continuous_apply (some none)).continuousAt.eventually_ne (by simp [base]) obtain ⟨z, hzcoord, hzQ, hzreg, hzK⟩ := Source29LocalFlatPolynomial.exists_positive_curvature_in_nhds Q hiQ hdQ base (by simp [base]) hQzero g hg.ne' hgn hgt _ hS have hzne : z ≠ 0 := by intro he exact hzcoord (congrFun he (some none)) let r := Source29AnalyticTensorNorm.tensorNorm z have hr : 0 < r := Source29AnalyticTensorNorm.tensorNorm_pos hzne have hrsq : r^2 = ∑ a, (z a)^2 := Source29AnalyticTensorNorm.tensorNorm_sq z let w := r⁻¹ • z have hwunit : (∑ a, (w a)^2) = 1 := by simp only [w, Pi.smul_apply, smul_eq_mul, mul_pow, ← Finset.mul_sum] rw [← hrsq] field_simp have hwzero : eval w Q = 0 := by change eval (fun i => r⁻¹ * z i) Q = 0 rw [eval_scale_of_isHomogeneous Q d hQ z r⁻¹, hzQ, mul_zero] have hwK : 0 < curvaturePotential Q w := by rw [Source29CurvatureScaling.curvaturePotential_scale Q d hQ hd z hzreg r⁻¹ (inv_ne_zero hr.ne')] exact div_pos hzK (sq_pos_of_pos (inv_pos.mpr hr)) refine ⟨U *ᵥ w, ⟨?_, ?_⟩, ?_⟩ · rwa [← eval_changeVariables] · have he := MatrixAlgebra.dot_transpose_mulVec U.transpose hUt w w have hww : w ⬝ᵥ w = 1 := by simpa only [dotProduct, pow_two] using hwunit simpa only [Matrix.transpose_transpose, dotProduct, ← pow_two] using he.trans hww · rwa [← curvaturePotential_changeVariables U hU] end end Source29RegularHomogeneousNonflatness /- Final component: LowDimensionalEigenvalueGap -/ namespace Source29LowDimensionalEigenvalueGap /-- The real-degree Jacobi parameter stays strictly above the Simons bound for link dimensions one through five. -/ theorem gap (D m : ℝ) (hm : 1 ≤ m) (hm' : m ≤ 5) : 1 ≤ (D-1)*(D-m)+m := by have hp : 0 ≤ (m-1)*(5-m) := mul_nonneg (by linarith) (by linarith) nlinarith [sq_nonneg (2*D-m-1)] theorem no_eigenvalue_bound (D m : ℝ) (hm : 1 ≤ m) (hm' : m ≤ 5) (hbound : (D-1)*(D-m) ≤ -m) : False := by have hg := gap D m hm hm' linarith theorem no_eigenvalue_bound_nat (D : ℝ) (m : ℕ) (hm : 1 ≤ m) (hm' : m ≤ 5) (hbound : (D-1)*(D-(m : ℝ)) ≤ -(m : ℝ)) : False := no_eigenvalue_bound D m (by exact_mod_cast hm) (by exact_mod_cast hm') hbound end Source29LowDimensionalEigenvalueGap /- Final component: CompactPositiveRootRigidity -/ namespace Source29CompactPositiveRootRigidity open Filter MvPolynomial Source29PolynomialLinkChart Source29PolynomialCurvaturePotential open Source29PolynomialJacobiCurves Source29PolynomialCurvatureRegularity open Source29WeightedJacobiTransport Source29QuarticReuse.QuarticMinimal open scoped BigOperators Topology noncomputable section variable {ι : Type*} [Fintype ι] [DecidableEq ι] /-- Compact comparison with the now-derived Jacobi and scalar Simons inequalities. Global regularity and nonflatness are the remaining inputs. -/ theorem homogeneous_degree_eigenvalue_bound (P Q : MvPolynomial (Option (Option ι)) ℝ) (p q k : ℕ) (hk : 0 < k) (hP : P.IsHomogeneous p) (hQ : Q.IsHomogeneous q) (hF : leadingOperator (P^k*Q) = 0) (hpositive : ∀ x : Ambient ι, eval x P = 0 ∧ (∑ a, (x a)^2) = 1 → 0 < eval x Q) (hregular : ∀ x : Ambient ι, eval x P = 0 ∧ (∑ a, (x a)^2) = 1 → gradientAt P x ≠ 0) (hnonflat : ∃ x : Ambient ι, (eval x P = 0 ∧ (∑ a, (x a)^2) = 1) ∧ 0 < curvaturePotential P x) : (((p : ℝ)+(q : ℝ)/(k : ℝ))-1)*(((p : ℝ)+(q : ℝ)/(k : ℝ))-(Fintype.card ι : ℝ)) ≤ -(Fintype.card ι : ℝ) := by let s : Set (Ambient ι) := {x | eval x P = 0 ∧ (∑ a, (x a)^2) = 1} have hs : IsCompact s := Source29CompactPolynomialLink.isCompact_link P have hr : ∀ x ∈ s, gradientAt P x ≠ 0 := hregular have hc : ContinuousOn (curvatureNorm P) s := curvatureNorm_continuousOn P s hr have hφ : ContinuousOn (weightedProfile P Q k) s := fun x hx => (weightedProfile_analyticAt P Q k hk x (hpositive x hx) (hr x hx)).continuousAt.continuousWithinAt have hφpos : ∀ x ∈ s, 0 < weightedProfile P Q k x := fun x hx => weightedProfile_positive P Q k x (hpositive x hx) (hr x hx) obtain ⟨b, hb, hpb⟩ := hnonflat have hhb : 0 < curvatureNorm P b := Real.sqrt_pos.mpr hpb have hrc : ContinuousOn (fun x => curvatureNorm P x / weightedProfile P Q k x) s := hc.div hφ (fun x hx => (hφpos x hx).ne') obtain ⟨a, ha, hmax⟩ := hs.exists_isMaxOn ⟨b, hb⟩ hrc have hratio : 0 < curvatureNorm P a / weightedProfile P Q k a := (div_pos hhb (hφpos b hb)).trans_le (hmax hb) have hha : 0 < curvatureNorm P a := by have he := (lt_div_iff₀ (hφpos a ha)).mp hratio simpa only [zero_mul] using he have hpa : 0 < curvaturePotential P a := Real.sqrt_pos.mp hha obtain ⟨b,U,C,hb,hUt,hU,hbase,hpn,hpt,hC,hC0,hC1,hC2,hmem,hCφ,hCh,hφa,hJac,hSimons⟩ := Source29RegularPositiveRootSimons.exists_regular_simons_jacobi_curves P Q p q k hk hP hQ hF a ha.2 ha.1 (hpositive a ha) (hr a ha) hpa apply Source29LocalEigenvalueComparison.eigenvalue_bound_at_ratio_maximum (fun i t => curvatureNorm P (C i t)) (fun i t => weightedProfile P Q k (C i t)) (curvatureNorm P a) (weightedProfile P Q k a) (curvaturePotential P a) (Fintype.card ι : ℝ) ((((p : ℝ)+(q : ℝ)/(k : ℝ))-1)*(((p : ℝ)+(q : ℝ)/(k : ℝ))-(Fintype.card ι : ℝ))) hCh hCφ (fun i => congrArg (curvatureNorm P) (hC0 i)) (fun i => congrArg (weightedProfile P Q k) (hC0 i)) hha (hφpos a ha) _ hSimons hJac intro i change ∀ᶠ t in 𝓝 (0 : ℝ), curvatureNorm P (C i t) / weightedProfile P Q k (C i t) ≤ curvatureNorm P (C i 0) / weightedProfile P Q k (C i 0) filter_upwards [hmem i] with t ht simpa only [hC0, Set.mem_ofPred_eq] using hmax ht /-- A globally regular irreducible factor of a homogeneous product solving the cubic equation is linear in ambient dimensions three through seven, provided its residual is positive on the unit zero link. -/ theorem degree_le_one (P Q : MvPolynomial (Option (Option ι)) ℝ) (p q k : ℕ) (hk : 0 < k) (hP : P.IsHomogeneous p) (hQ : Q.IsHomogeneous q) (hirr : Irreducible P) (hF : leadingOperator (P^k*Q) = 0) (hm : 1 ≤ Fintype.card ι) (hm' : Fintype.card ι ≤ 5) (hpositive : ∀ x : Ambient ι, eval x P = 0 ∧ (∑ a, (x a)^2) = 1 → 0 < eval x Q) (hregular : ∀ x : Ambient ι, eval x P = 0 ∧ (∑ a, (x a)^2) = 1 → gradientAt P x ≠ 0) (hnonempty : ∃ x : Ambient ι, eval x P = 0 ∧ (∑ a, (x a)^2) = 1) : P.totalDegree ≤ 1 := by rw [hP.totalDegree hirr.ne_zero] by_contra hn have hd : 2 ≤ p := by omega obtain ⟨x,hx⟩ := hnonempty have hnonflat := Source29RegularHomogeneousNonflatness.exists_positive_curvature_on_link P p hP hirr hd x hx.2 hx.1 (hregular x hx) have he := homogeneous_degree_eigenvalue_bound P Q p q k hk hP hQ hF hpositive hregular hnonflat exact Source29LowDimensionalEigenvalueGap.no_eigenvalue_bound_nat ((p : ℝ)+(q : ℝ)/(k : ℝ)) (Fintype.card ι) hm hm' he end end Source29CompactPositiveRootRigidity /- Final component: HomogeneousOneDimension -/ namespace Source29HomogeneousOneDimension open MvPolynomial open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29LinearForm noncomputable section /-- In one variable, homogeneity determines the entire polynomial. -/ theorem eq_coordinate_power (P : MvPolynomial (Fin 1) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) : P = C (eval (fun _ => 1) P) * (X 0)^d := by apply Source29QuarticReuse.QuarticCompatibility.polynomial_funext intro x have hx : x = x 0 • (fun _ : Fin 1 => (1 : ℝ)) := by funext i have hi : i = 0 := Subsingleton.elim _ _ simp only [hi, Pi.smul_apply, smul_eq_mul, mul_one] rw [hx, eval_dilate_homogeneous P hP] simp only [map_mul, map_pow, eval_C, eval_X, Pi.smul_apply, smul_eq_mul, mul_one] ring /-- Weak calibration excludes even powers in the one-dimensional base case. -/ theorem odd_degree (P : MvPolynomial (Fin 1) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 0 < d) (hne : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) : Odd d := by obtain ⟨⟨x, hx⟩, ⟨y, hy⟩⟩ := Source29WeakHomogeneousSign.homogeneous_changes_sign P hP hd hne hcal have he := eq_coordinate_power P d hP rw [he] at hx hy simp only [map_mul, map_pow, eval_C, eval_X] at hx hy by_contra hn have hdEven : Even d := Nat.not_odd_iff_even.mp hn have hxpow : 0 ≤ (x 0)^d := hdEven.pow_nonneg _ have hypow : 0 ≤ (y 0)^d := hdEven.pow_nonneg _ rcases le_total 0 (eval (fun _ => 1) P) with hc | hc · exact (not_lt_of_ge (mul_nonneg hc hxpow)) hx · exact (not_lt_of_ge (mul_nonpos_of_nonpos_of_nonneg hc hypow)) hy /-- Every nonzero calibrated homogeneous polynomial of positive degree in one variable is a nonzero odd power of a nonzero linear form. -/ theorem exists_odd_linear_power (P : MvPolynomial (Fin 1) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 0 < d) (hne : P ≠ 0) (hcal : WeakCalibration (leadingNormalizedField P)) : ∃ (c : ℝ) (a : Fin 1 → ℝ), c ≠ 0 ∧ a ≠ 0 ∧ Odd d ∧ P = C c * (linearForm a)^d := by have he := eq_coordinate_power P d hP refine ⟨eval (fun _ => 1) P, fun _ => 1, ?_, ?_, odd_degree P d hP hd hne hcal, ?_⟩ · intro hz apply hne simpa only [hz, map_zero, zero_mul] using he · intro hz have h := congrFun hz 0 norm_num at h · simpa [linearForm, Fin.sum_univ_one] using he end end Source29HomogeneousOneDimension /- Final component: LinearInitialPhaseChart -/ namespace Source29LinearInitialPhaseChart open MvPolynomial Matrix open Source29LinearForm Source29QuarticReuse.QuarticMinimal open Source29QuarticReuse.FluxObstruction Source29AffinePolynomialTransport open Source29GeometricPhaseChart Source29PolynomialTranslation open scoped BigOperators noncomputable section variable {n : ℕ} /-- Linear coordinate changes preserve each homogeneous component. -/ theorem homogeneousComponent_changeVariables {ι κ : Type*} [Fintype ι] [Fintype κ] (U : Matrix ι κ ℝ) (P : MvPolynomial ι ℝ) (d : ℕ) : homogeneousComponent d (changeVariables U P) = changeVariables U (homogeneousComponent d P) := by classical have he (j : ℕ) : homogeneousComponent d (changeVariables U (homogeneousComponent j P)) = changeVariables U (homogeneousComponent d (homogeneousComponent j P)) := by rw [homogeneousComponent_of_mem (isHomogeneous_changeVariables U _ j (homogeneousComponent_isHomogeneous j P)), homogeneousComponent_of_mem (homogeneousComponent_isHomogeneous j P)] split_ifs <;> simp calc _ = homogeneousComponent d (changeVariables U (∑ j ∈ Finset.range (P.totalDegree+1), homogeneousComponent j P)) := by rw [sum_homogeneousComponent] _ = ∑ j ∈ Finset.range (P.totalDegree+1), homogeneousComponent d (changeVariables U (homogeneousComponent j P)) := by rw [map_sum, map_sum] _ = changeVariables U (homogeneousComponent d (∑ j ∈ Finset.range (P.totalDegree+1), homogeneousComponent j P)) := by simp only [he, map_sum] _ = _ := by rw [sum_homogeneousComponent] /-- Absorb the sign of an odd pure power into its linear form. -/ theorem positive_orientation (P : MvPolynomial (Fin (n+1)) ℝ) (a : Fin (n+1) → ℝ) (ha : a ≠ 0) (c : ℝ) (hc : c ≠ 0) (d : ℕ) (hd : Odd d) (he : P = C c * (linearForm a)^d) : ∃ (b : Fin (n+1) → ℝ) (k : ℝ), b ≠ 0 ∧ 0 < k ∧ P = C k * (linearForm b)^d := by rcases lt_or_gt_of_ne hc with hc | hc · refine ⟨-a, -c, neg_ne_zero.mpr ha, neg_pos.mpr hc, ?_⟩ have hn : linearForm (-a) = -linearForm a := by simp only [linearForm, Pi.neg_apply, map_neg, neg_mul, Finset.sum_neg_distrib] rw [hn, hd.neg_pow, map_neg, neg_mul_neg] exact he · exact ⟨a,c,ha,hc,he⟩ /-- Any nonzero odd linear initial power yields an oriented flat minimal phase chart, without prescribing its normal vector or its scalar sign. -/ theorem phase_chart_of_linear_initial (F : MvPolynomial (Fin (n+1)) ℝ) (hF : leadingOperator F = 0) (p a : Fin (n+1) → ℝ) (ha : a ≠ 0) (c : ℝ) (hc : c ≠ 0) (d : ℕ) (hd : Odd d) (hlow : ∀ j < d, homogeneousComponent j (translate F p) = 0) (hpure : homogeneousComponent d (translate F p) = C c * (linearForm a)^d) : HasFlatMinimalPhaseChart F p := by obtain ⟨b,k,hb,hk,hpure⟩ := positive_orientation _ a ha c hc d hd hpure obtain ⟨U,hUt,hU,hcol⟩ := Source29LinearNormalRotation.exists_rotation b hb have hnorm : 0 < Real.sqrt (radiusSq b) := Real.sqrt_pos.mpr (radiusSq_pos_of_ne_zero hb) have he : changeVariables U (linearForm b) = C (Real.sqrt (radiusSq b)) * X 0 := by apply Source29QuarticReuse.QuarticCompatibility.polynomial_funext intro x rw [eval_changeVariables] simpa only [map_mul, eval_C, eval_X] using Source29LinearEndpointRotation.linearForm_eval_rotation b hb U hUt hcol x apply Source29FlatInitialPhaseChart.phase_chart_of_affine_positive_odd_initial F hF p U hU d hd (k * Real.sqrt (radiusSq b)^d) (mul_pos hk (pow_pos hnorm d)) · intro j hj rw [affineEquiv_apply, homogeneousComponent_changeVariables, hlow j hj, map_zero] · rw [affineEquiv_apply, homogeneousComponent_changeVariables, hpure, map_mul, map_pow, he] simp only [changeVariables, aeval_C, algebraMap_eq, mul_pow, map_pow, map_mul, mul_assoc] end end Source29LinearInitialPhaseChart /- Final component: RadialPhaseChartInduction -/ namespace Source29RadialPhaseChartInduction open MvPolynomial Matrix open Source29LinearForm Source29QuarticReuse.QuarticMinimal open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29GeometricPhaseChart Source29PolynomialTranslation noncomputable section variable {n : ℕ} /-- The classification required at the preceding induction dimension. -/ def LinearRigidity (n : ℕ) : Prop := ∀ (R : MvPolynomial (Fin n) ℝ) (d : ℕ), R.IsHomogeneous d → 0 < d → R ≠ 0 → leadingOperator R = 0 → WeakCalibration (leadingNormalizedField R) → ∃ (c : ℝ) (b : Fin n → ℝ), c ≠ 0 ∧ b ≠ 0 ∧ Odd d ∧ R = C c * (linearForm b)^d /-- Reversing the radial rotation lifts a pure linear power to a pure linear power in the original ambient space. -/ theorem linear_power_of_reduction (P : MvPolynomial (Fin (n+1)) ℝ) (hP : P ≠ 0) (U : Matrix (Fin (n+1)) (Fin (n+1)) ℝ) (hU : U * U.transpose = 1) (R : MvPolynomial (Fin n) ℝ) (hrot : changeVariables U P = rename Fin.succ R) (b : Fin n → ℝ) (c : ℝ) (d : ℕ) (hd : 0 < d) (hR : R = C c * (linearForm b)^d) : ∃ a : Fin (n+1) → ℝ, a ≠ 0 ∧ P = C c * (linearForm a)^d := by let L := changeVariables U.transpose (rename Fin.succ (linearForm b)) have hL : L.IsHomogeneous 1 := isHomogeneous_changeVariables U.transpose _ 1 (linearForm_isHomogeneous b).rename_isHomogeneous have hback : P = C c * L^d := by have he := congrArg (changeVariables U.transpose) hrot rw [changeVariables_comp, hU, changeVariables_one, hR] at he simpa only [L, map_mul, map_pow, rename_C, changeVariables, aeval_C, algebraMap_eq] using he have hlin : L = linearForm (evaluatedGradient L 0) := by rw [← Source29RegularPhaseDensity.homogeneousComponent_one_eq_linearForm, homogeneousComponent_eq_self hL] refine ⟨evaluatedGradient L 0, ?_, ?_⟩ · intro hz have hLzero : L = 0 := by rw [hlin, hz]; simp [linearForm] apply hP rw [hback, hLzero, zero_pow (Nat.ne_of_gt hd), mul_zero] · rwa [hlin] at hback /-- Lower-dimensional calibrated homogeneous rigidity gives an actual flat minimal phase chart at every nonvertex zero in the next dimension. -/ theorem phase_chart_at_nonzero_zero (hIH : LinearRigidity n) (F : MvPolynomial (Fin (n+1)) ℝ) (D : ℕ) (hhom : F.IsHomogeneous D) (hne : F ≠ 0) (hF : leadingOperator F = 0) (hcal : WeakCalibration (leadingNormalizedField F)) (p : Fin (n+1) → ℝ) (hp : p ≠ 0) (hzero : eval p F = 0) : HasFlatMinimalPhaseChart F p := by obtain ⟨d,hd,_,hinit,hlow⟩ := exists_lowest_component_at_root F hne p hzero obtain ⟨s,rfl⟩ : ∃ s, d = s+1 := ⟨d-1, by omega⟩ obtain ⟨U,R,hUt,hU,hrot,hRne,hRhom,hRL⟩ := Source29RadialCoordinateReduction.initial_orthogonal_reduction F D hhom p hp s (hlow s (by omega)) hinit have hL := Source29InitialLeadingOperator.leadingOperator_initial_at F hF p (s+1) hlow have htranslate : WeakCalibration (leadingNormalizedField (translate F p)) := by simpa only [map_zero, sub_zero] using Source29TranslatedCalibration.polynomial_translated_level_weakCalibration F hcal 0 p have hcalinit := Source29InitialWeakCalibration.initial_weakCalibration (translate F p) htranslate s hlow hinit have hcalrot := Source29OrthogonalCalibration.weakCalibration_changeVariables U hU _ hcalinit rw [hrot] at hcalrot have hcalR := Source29CalibrationCoordinateDescent.weakCalibration_rename_succ R hcalrot obtain ⟨c,b,hc,_,hodd,hRform⟩ := hIH R (s+1) hRhom hd hRne (hRL hL) hcalR obtain ⟨a,ha,hform⟩ := linear_power_of_reduction _ hinit U hU R hrot b c (s+1) hd hRform exact Source29LinearInitialPhaseChart.phase_chart_of_linear_initial F hF p a ha c hc (s+1) hodd hlow hform /-- The induction has a proved one-dimensional starting point. -/ theorem linearRigidity_one : LinearRigidity 1 := by intro R d hR hd hne _ hcal exact Source29HomogeneousOneDimension.exists_odd_linear_power R d hR hd hne hcal /-- In ambient dimension two, every nonzero zero already has an analytic minimal phase chart; no separate geometric regularity hypothesis is needed. -/ theorem phase_chart_dimension_two (F : MvPolynomial (Fin 2) ℝ) (D : ℕ) (hhom : F.IsHomogeneous D) (hne : F ≠ 0) (hF : leadingOperator F = 0) (hcal : WeakCalibration (leadingNormalizedField F)) (p : Fin 2 → ℝ) (hp : p ≠ 0) (hzero : eval p F = 0) : HasFlatMinimalPhaseChart F p := phase_chart_at_nonzero_zero linearRigidity_one F D hhom hne hF hcal p hp hzero end end Source29RadialPhaseChartInduction /- Final component: HomogeneousTwoDimension -/ namespace Source29HomogeneousTwoDimension open MvPolynomial Matrix Filter open Source29QuarticReuse.QuarticMinimal Source29QuarticReuse.QuarticNormalization open Source29QuarticReuse.QuarticPolynomialBasics Source29QuarticReuse.FluxObstruction open Source29WeakCalibrationLimits Source29NewtonNormalDerivative open Source29LinearForm Source29RadialPhaseChartInduction Source29GeometricPhaseChart open scoped Topology BigOperators noncomputable section /-- In two variables the full cubic operator is exactly the Newton residual. -/ theorem leadingOperator_eq_newtonResidual (P : MvPolynomial (Fin 2) ℝ) : leadingOperator P = newtonResidual P := by simp only [leadingOperator, laplacian, newtonResidual, tangentialLaplacian, tangentialMixed, tangentialEnergy, Fin.sum_univ_two, Fin.sum_univ_one] simp only [show (0 : Fin 1).succ = (1 : Fin 2) from rfl] rw [second_partial_comm P (0 : Fin 2) 1] ring /-- The slice x₁=1 determines a homogeneous polynomial in two variables. -/ theorem eq_zero_of_slice_one (P : MvPolynomial (Fin 2) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hslice : sliceHom (fun _ : Fin 1 => 1) P = 0) : P = 0 := by apply Source29LocalHyperplaneDivisor.polynomial_eq_zero_of_locally_zero P (fun _ => 1) have hne : ∀ᶠ x : Fin 2 → ℝ in 𝓝 (fun _ => 1), x 1 ≠ 0 := (continuous_apply 1).continuousAt.eventually_ne (by norm_num) filter_upwards [hne] with x hx have hs : eval (Fin.cons (x 0 / x 1) (fun _ : Fin 1 => 1)) P = 0 := by rw [← eval_sliceHom, hslice, Polynomial.eval_zero] have he : x = x 1 • Fin.cons (x 0 / x 1) (fun _ : Fin 1 => 1) := by funext i fin_cases i · change x 0 = x 1 * (x 0 / x 1) field_simp · simp rw [he, eval_dilate_homogeneous P hP, hs, mul_zero] /-- The cubic equation forces a homogeneous polynomial to be independent of x₀ if its x₀ derivative vanishes, and its x₁ derivative does not, at (0,1). -/ theorem pderiv_zero_of_axis_critical (P : MvPolynomial (Fin 2) ℝ) (s : ℕ) (hP : P.IsHomogeneous (s+1)) (hL : leadingOperator P = 0) (hzero : eval (Pi.single (1 : Fin 2) 1) (pderiv 0 P) = 0) (htrans : eval (Pi.single (1 : Fin 2) 1) (pderiv 1 P) ≠ 0) : pderiv 0 P = 0 := by have haxis : (Fin.cons 0 (fun _ : Fin 1 => (1 : ℝ)) : Fin 2 → ℝ) = Pi.single (1 : Fin 2) 1 := by funext i fin_cases i <;> norm_num [Pi.single_apply] have hE : newtonResidual P = 0 := by rwa [← leadingOperator_eq_newtonResidual] have hA : (sliceHom (fun _ : Fin 1 => 1) (tangentialEnergy P)).eval 0 ≠ 0 := by rw [eval_sliceHom, haxis] simpa only [tangentialEnergy, Fin.sum_univ_one, map_pow, show (0 : Fin 1).succ = (1 : Fin 2) from rfl] using pow_ne_zero 2 htrans have hq : sliceHom (fun _ : Fin 1 => 1) (pderiv 0 P) = 0 := by by_contra hq have hno := Source29PolynomialOdeNonvanishing.eval_ne_zero_of_derivative_mul_eq (sliceHom (fun _ : Fin 1 => 1) (tangentialEnergy P)) (sliceHom (fun _ : Fin 1 => 1) (normalDrift P)) (sliceHom (fun _ : Fin 1 => 1) (pderiv 0 P)) 0 hq hA (slice_derivative_ode P hE (fun _ => 1)) apply hno rwa [eval_sliceHom, haxis] exact eq_zero_of_slice_one _ s (isHomogeneous_pderiv_succ P 0 s hP) hq /-- Every positive-degree calibrated homogeneous solution in two variables is an odd power of a nonzero linear form. The spherical maximum supplies the required regular nonzero level point. -/ theorem exists_odd_linear_power (P : MvPolynomial (Fin 2) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 0 < d) (hne : P ≠ 0) (hL : leadingOperator P = 0) (hcal : WeakCalibration (leadingNormalizedField P)) : ∃ (c : ℝ) (a : Fin 2 → ℝ), c ≠ 0 ∧ a ≠ 0 ∧ Odd d ∧ P = C c * (linearForm a)^d := by obtain ⟨s,rfl⟩ : ∃ s, d = s+1 := ⟨d-1, by omega⟩ obtain ⟨x,hx⟩ := (Source29WeakHomogeneousSign.homogeneous_changes_sign P hP hd hne hcal).2 obtain ⟨U,hUt,hU,hpos,hcritical⟩ := exists_normalized_positive_direction_of_value P s hP (1 : Fin 2) x hx let Q := changeVariables U P have hQ : Q.IsHomogeneous (s+1) := Source29QuarticReuse.QuarticMinimal.isHomogeneous_changeVariables U P (s+1) hP have hQne : Q ≠ 0 := by intro hz apply hne apply changeVariables_injective U hU simpa only [map_zero] using hz have hQcal := Source29OrthogonalCalibration.weakCalibration_changeVariables U hU P hcal have hQzero : eval (Pi.single (1 : Fin 2) 1) (pderiv 0 Q) = 0 := by rw [eval_pderiv_basis_of_isHomogeneous Q s hQ 1 0 (by decide)] exact hcritical 0 (by decide) have hQpos : 0 < eval (Pi.single (1 : Fin 2) 1) Q := by rwa [eval_basis_of_isHomogeneous Q (s+1) hQ 1] have hQtrans : eval (Pi.single (1 : Fin 2) 1) (pderiv 1 Q) ≠ 0 := by have he := euler_evaluatedGradient Q hQ (Pi.single (1 : Fin 2) 1) norm_num [Fin.sum_univ_two, Pi.single_apply, evaluatedGradient] at he rw [he] exact mul_ne_zero (by exact_mod_cast hd.ne') hQpos.ne' have hderiv : pderiv 0 Q = 0 := pderiv_zero_of_axis_critical Q s hQ (leadingOperator_changeVariables_eq_zero U hU P hL) hQzero hQtrans obtain ⟨R,hR⟩ := Source29RadialCoordinateReduction.exists_rename_succ_of_pderiv_zero Q hderiv have hRhom : R.IsHomogeneous (s+1) := (IsHomogeneous.rename_isHomogeneous_iff (Fin.succ_injective 1)).mp (hR ▸ hQ) have hRne : R ≠ 0 := by intro hz apply hQne rw [hR, hz, map_zero] have hRcal : WeakCalibration (leadingNormalizedField R) := by apply Source29CalibrationCoordinateDescent.weakCalibration_rename_succ rwa [← hR] obtain ⟨c,b,hc,_,hodd,hform⟩ := Source29HomogeneousOneDimension.exists_odd_linear_power R (s+1) hRhom hd hRne hRcal obtain ⟨a,ha,he⟩ := linear_power_of_reduction P hne U hU R hR b c (s+1) hd hform exact ⟨c,a,hc,ha,hodd,he⟩ /-- The second induction base, including every positive polynomial degree. -/ theorem linearRigidity_two : LinearRigidity 2 := by intro P d hP hd hne hL hcal exact exists_odd_linear_power P d hP hd hne hL hcal /-- The binary base supplies actual phase charts at every nonvertex zero of three-dimensional calibrated homogeneous solutions. -/ theorem phase_chart_dimension_three (F : MvPolynomial (Fin 3) ℝ) (D : ℕ) (hhom : F.IsHomogeneous D) (hne : F ≠ 0) (hF : leadingOperator F = 0) (hcal : WeakCalibration (leadingNormalizedField F)) (p : Fin 3 → ℝ) (hp : p ≠ 0) (hzero : eval p F = 0) : HasFlatMinimalPhaseChart F p := phase_chart_at_nonzero_zero linearRigidity_two F D hhom hne hF hcal p hp hzero end end Source29HomogeneousTwoDimension /- Final component: HigherDimensionalRealZero -/ namespace Source29HigherDimensionalRealZero open Source29PuncturedIntermediateValue open MvPolynomial Source29QuarticReuse.QuarticNormalization open scoped Topology BigOperators noncomputable section variable {n : ℕ} theorem exists_perpendicular_unit (a : EuclideanSpace ℝ (Fin (n+3))) (ha : ‖a‖ = 1) : ∃ c : EuclideanSpace ℝ (Fin (n+3)), ‖c‖ = 1 ∧ inner ℝ a c = 0 := by let u := Source29OrthogonalFrame.coordinateUnit (0 : Fin (n+3)) let v := Source29OrthogonalFrame.coordinateUnit (1 : Fin (n+3)) let R := (ℝ ∙ (u-a))ᗮ.reflection have hRu : R u = a := Submodule.reflection_sub ((Source29OrthogonalFrame.coordinateUnit_norm (0 : Fin (n+3))).trans ha.symm) refine ⟨R v, ?_, ?_⟩ · rw [R.norm_map] exact Source29OrthogonalFrame.coordinateUnit_norm (1 : Fin (n+3)) · rw [← hRu, R.inner_map_map] norm_num [u, v, Source29OrthogonalFrame.coordinateUnit_inner] theorem exists_nonzero_zero_of_unit_sign_change (f : EuclideanSpace ℝ (Fin (n+3)) → ℝ) (hf : Continuous f) (a b : EuclideanSpace ℝ (Fin (n+3))) (ha : ‖a‖ = 1) (hb : ‖b‖ = 1) (hfa : 0 < f a) (hfb : f b < 0) : ∃ x : EuclideanSpace ℝ (Fin (n+3)), x ≠ 0 ∧ f x = 0 := by by_cases hab : b = -a · obtain ⟨c, hc, hac⟩ := exists_perpendicular_unit a ha rcases lt_trichotomy (f c) 0 with hneg | hzero | hpos · exact exists_nonzero_zero_between_unit_points f hf a c ha hc (unit_orthogonal_not_antipodal a c ha hac) hfa hneg · exact ⟨c, by intro he; simp [he] at hc, hzero⟩ · have hcb : inner ℝ c b = 0 := by rw [hab, inner_neg_right, real_inner_comm, hac, neg_zero] exact exists_nonzero_zero_between_unit_points f hf c b hc hb (unit_orthogonal_not_antipodal c b hc hcb) hpos hfb · exact exists_nonzero_zero_between_unit_points f hf a b ha hb hab hfa hfb theorem exists_unit_zero_of_sign_change (P : MvPolynomial (Fin (n+3)) ℝ) (d : ℕ) (hP : P.IsHomogeneous d) (hd : 1 ≤ d) (hpos : ∃ x, 0 < eval x P) (hneg : ∃ x, eval x P < 0) : ∃ x, eval x P = 0 ∧ (∑ a, (x a)^2) = 1 := by obtain ⟨xp, hxp⟩ := hpos obtain ⟨xn, hxn⟩ := hneg have hPs : P.IsHomogeneous ((d-1)+1) := by convert hP using 1 omega obtain ⟨a, ha, hpa⟩ := exists_positive_sphere_value P (d-1) hPs xp hxp obtain ⟨b, hb, hnb⟩ := exists_positive_sphere_value (-P) (d-1) hPs.neg xn (by simpa only [map_neg] using neg_pos.mpr hxn) have hpb : eval b P < 0 := by simpa only [map_neg, neg_pos] using hnb let f : EuclideanSpace ℝ (Fin (n+3)) → ℝ := fun x => eval (fun i => x i) P have hf : Continuous f := (Source29CompactPolynomialLink.continuous_eval P).comp (show Continuous (fun x : EuclideanSpace ℝ (Fin (n+3)) => fun i => x i) by fun_prop) have hnorm (v : Fin (n+3) → ℝ) (hv : (∑ i, (v i)^2) = 1) : ‖(WithLp.toLp 2 v : EuclideanSpace ℝ (Fin (n+3)))‖ = 1 := by have he : ‖(WithLp.toLp 2 v : EuclideanSpace ℝ (Fin (n+3)))‖^2 = 1 := by simpa only [EuclideanSpace.real_norm_sq_eq] using hv nlinarith [norm_nonneg (WithLp.toLp 2 v : EuclideanSpace ℝ (Fin (n+3)))] obtain ⟨z, hz, hpz⟩ := exists_nonzero_zero_of_unit_sign_change f hf (WithLp.toLp 2 a) (WithLp.toLp 2 b) (hnorm a ha) (hnorm b hb) hpa hpb let v : Fin (n+3) → ℝ := fun i => z i have hv : v ≠ 0 := by intro he apply hz ext i exact congrFun he i let r := Source29AnalyticTensorNorm.tensorNorm v have hr : 0 < r := Source29AnalyticTensorNorm.tensorNorm_pos hv have hrsq : r^2 = ∑ i, (v i)^2 := Source29AnalyticTensorNorm.tensorNorm_sq v refine ⟨fun i => r⁻¹ * v i, ?_, ?_⟩ · rw [eval_scale_of_isHomogeneous P d hP v r⁻¹] change r⁻¹ ^ d * f z = 0 rw [hpz, mul_zero] · simp only [mul_pow, ← Finset.mul_sum, ← hrsq] field_simp end end Source29HigherDimensionalRealZero /- Final component: HigherDimensionalLinkIntersection -/ namespace Source29HigherDimensionalLinkIntersection open MvPolynomial Filter Source29FactorInheritance open scoped Topology BigOperators noncomputable section variable {n : ℕ} /-- Two regular minimal homogeneous links intersect in every ambient dimension at least three. -/ theorem exists_common_unit_zero (P Q : MvPolynomial (Fin (n+3)) ℝ) (d e : ℕ) (hd : 1 ≤ d) (he : 1 ≤ e) (hP : P.IsHomogeneous d) (hQ : Q.IsHomogeneous e) (hPreg : ∀ x : Fin (n+3) → ℝ, eval x P=0 → (∑ a, (x a)^2)=1 → (fun a ↦ eval x (pderiv a P)) ≠ 0) (hQreg : ∀ x : Fin (n+3) → ℝ, eval x Q=0 → (∑ a, (x a)^2)=1 → (fun a ↦ eval x (pderiv a Q)) ≠ 0) (hPL : P ∣ cubicOperator P) (hQL : Q ∣ cubicOperator Q) (hPne : ∃ x : Fin (n+3) → ℝ, eval x P=0 ∧ (∑ a, (x a)^2)=1) (hQne : ∃ x : Fin (n+3) → ℝ, eval x Q=0 ∧ (∑ a, (x a)^2)=1) : ∃ x : Fin (n+3) → ℝ, eval x P=0 ∧ eval x Q=0 ∧ (∑ a, (x a)^2)=1 := by let E : Fin (n+3) ≃ Option (Option (Fin (n+1))) := Fintype.equivOfCardEq (by simp) have hunit (x : Option (Option (Fin (n+1))) → ℝ) (hx : (∑ a, (x a)^2)=1) : (∑ a, ((x ∘ E) a)^2)=1 := by change (∑ a, (x (E a))^2)=1 rwa [E.sum_comp (fun a ↦ (x a)^2)] have hreg (R : MvPolynomial (Fin (n+3)) ℝ) (hr : ∀ x : Fin (n+3) → ℝ, eval x R=0 → (∑ a, (x a)^2)=1 → (fun a ↦ eval x (pderiv a R)) ≠ 0) (x : Option (Option (Fin (n+1))) → ℝ) (hx : eval x (rename E R)=0) (hu : (∑ a, (x a)^2)=1) : (fun a ↦ eval x (pderiv a (rename E R))) ≠ 0 := by apply Source29PolynomialReindex.gradientAt_rename_ne_zero E R x exact hr (x ∘ E) (by simpa only [eval_rename] using hx) (hunit x hu) have hmin (R : MvPolynomial (Fin (n+3)) ℝ) (hr : R ∣ cubicOperator R) (x : Option (Option (Fin (n+1))) → ℝ) (hx : eval x (rename E R)=0) (_hu : (∑ a, (x a)^2)=1) : eval x (cubicOperator (rename E R))=0 := by obtain ⟨A,hA⟩ := hr rw [Source29PolynomialReindex.cubicOperator_rename,hA,map_mul,map_mul,hx,zero_mul] have hnonempty (R : MvPolynomial (Fin (n+3)) ℝ) (hr : ∃ x : Fin (n+3) → ℝ, eval x R=0 ∧ (∑ a, (x a)^2)=1) : ∃ x : Option (Option (Fin (n+1))) → ℝ, eval x (rename E R)=0 ∧ (∑ a, (x a)^2)=1 := by obtain ⟨x,hx,hu⟩ := hr refine ⟨x ∘ E.symm,?_,?_⟩ · simpa only [eval_rename,Function.comp_assoc,E.symm_comp_self,Function.comp_id] using hx · change (∑ a, (x (E.symm a))^2)=1 rwa [E.symm.sum_comp (fun a ↦ (x a)^2)] obtain ⟨x,hxP,hxQ,hxu⟩ := Source29RegularLinkIntersection.exists_common_unit_zero (rename E P) (rename E Q) d e hd he hP.rename_isHomogeneous hQ.rename_isHomogeneous (hreg P hPreg) (hreg Q hQreg) (hmin P hPL) (hmin Q hQL) (hnonempty P hPne) (hnonempty Q hQne) (0 : Fin (n+1)) exact ⟨x ∘ E,by simpa only [eval_rename] using hxP, by simpa only [eval_rename] using hxQ,hunit x hxu⟩ end end Source29HigherDimensionalLinkIntersection /- Final component: HigherDimensionalPhaseStructure -/ namespace Source29HigherDimensionalPhaseStructure open MvPolynomial Source29FactorInheritance Source29GeometricPhaseChart open Source29QuarticReuse.FluxObstruction Source29WeakCalibrationLimits open Source29GlobalPhaseFactor open scoped BigOperators noncomputable section variable {n : ℕ} /-- Full residuals have no nonvertex zeros once every nonvertex zero admits a phase chart. -/ theorem cofactor_ne_zero_away_zero (F P Q : MvPolynomial (Fin (n+3)) ℝ) (D k : ℕ) (hk : 0 < k) (hfac : F=P^k*Q) (hP : Irreducible P) (hPQ : ¬ P ∣ Q) (hhom : F.IsHomogeneous D) (hF : cubicOperator F=0) (hcal : WeakCalibration (leadingNormalizedField F)) (hcharts : ∀ a : Fin (n+3) → ℝ, a ≠ 0 → eval a F=0 → HasFlatMinimalPhaseChart F a) (hPunit : ∃ x : Fin (n+3) → ℝ, eval x P=0 ∧ (∑ j, (x j)^2)=1) : ∀ a : Fin (n+3) → ℝ, a ≠ 0 → eval a Q ≠ 0 := by have hQne : Q ≠ 0 := fun h ↦ hPQ (h ▸ dvd_zero P) have hFne : F ≠ 0 := by rw [hfac]; exact mul_ne_zero (pow_ne_zero k hP.ne_zero) hQne have hPF : P ∣ F := (dvd_pow_self P hk.ne').trans ⟨Q,hfac⟩ have hPhom := Source29HomogeneousFactor.divisor_isHomogeneous F P hFne hhom hPF have hPL := irreducible_divisor_cubic_dvd F P hFne hP hPF hF have hPreg := Source29PhaseChartFactorRegularity.irreducible_factor_regular_away_zero F P hFne hP hPF hF hcal hcharts have hunit_ne_zero (x : Fin (n+3) → ℝ) (hx : (∑ j, (x j)^2)=1) : x ≠ 0 := by intro he simp only [he,Pi.zero_apply,zero_pow (by decide : 2 ≠ 0),Finset.sum_const_zero] at hx norm_num at hx have hdP : 1 ≤ P.totalDegree := by obtain ⟨x,hx,_⟩ := hPunit exact totalDegree_pos_of_zero P hP.ne_zero x hx intro a hane hQa obtain ⟨R,hR,hRQ,hRa⟩ := exists_irreducible_zero Q hQne a hQa have hRF : R ∣ F := hRQ.trans ⟨P^k,hfac.trans (mul_comm _ _)⟩ have hRhom := Source29HomogeneousFactor.divisor_isHomogeneous F R hFne hhom hRF have hRL := irreducible_divisor_cubic_dvd F R hFne hR hRF hF have hRreg := Source29PhaseChartFactorRegularity.irreducible_factor_regular_away_zero F R hFne hR hRF hF hcal hcharts have hRunit := exists_unit_zero R R.totalDegree hRhom a hane hRa obtain ⟨x,hxP,hxR,hxu⟩ := Source29HigherDimensionalLinkIntersection.exists_common_unit_zero P R P.totalDegree R.totalDegree hdP (totalDegree_pos_of_zero R hR.ne_zero a hRa) hPhom hRhom (fun x hx hu ↦ hPreg x (hunit_ne_zero x hu) hx) (fun x hx hu ↦ hRreg x (hunit_ne_zero x hu) hx) hPL hRL hPunit hRunit have hxF : eval x F=0 := by rw [hfac,map_mul,map_pow,hxP,zero_pow hk.ne',zero_mul] have hxQ := (Source29PhaseChartFactorRegularity.regularity_and_cofactor_nonzero F P Q k hk hfac hP hPQ hF hcal x hxP (hcharts x (hunit_ne_zero x hxu) hxF)).2.1 apply hxQ obtain ⟨A,hA⟩ := hRQ rw [hA,map_mul,hxR,zero_mul] theorem constant_sign_away_zero (Q : MvPolynomial (Fin (n+3)) ℝ) (hhom : Q.IsHomogeneous Q.totalDegree) (hQ : ∀ x : Fin (n+3) → ℝ, x ≠ 0 → eval x Q ≠ 0) : (∀ x : Fin (n+3) → ℝ, x ≠ 0 → 0 < eval x Q) ∨ (∀ x : Fin (n+3) → ℝ, x ≠ 0 → eval x Q < 0) := by by_cases hpos : ∀ x : Fin (n+3) → ℝ, x ≠ 0 → 0 < eval x Q · exact Or.inl hpos right push Not at hpos obtain ⟨a,ha,hale⟩ := hpos have hneg : eval a Q < 0 := lt_of_le_of_ne hale (hQ a ha) intro b hb by_contra hnb have hposb : 0 < eval b Q := lt_of_le_of_ne (le_of_not_gt hnb) (hQ b hb).symm by_cases hd : Q.totalDegree=0 · have hc := totalDegree_eq_zero_iff_eq_C.mp hd rw [hc,eval_C] at hneg hposb linarith · obtain ⟨x,hx,hu⟩ := Source29HigherDimensionalRealZero.exists_unit_zero_of_sign_change Q Q.totalDegree hhom (Nat.pos_of_ne_zero hd) ⟨b,hposb⟩ ⟨a,hneg⟩ have hxne : x ≠ 0 := by intro he simp only [he,Pi.zero_apply,zero_pow (by decide : 2 ≠ 0),Finset.sum_const_zero] at hu norm_num at hu exact hQ x hxne hx /-- A calibrated homogeneous polynomial of positive degree with phase charts away from the vertex has one regular real factor and a strictly positive residual. All regularity and multiplicity conclusions are derived from the charts. -/ theorem exists_positive_regular_factor (F : MvPolynomial (Fin (n+3)) ℝ) (d : ℕ) (hd : 0 < d) (hFne : F ≠ 0) (hhom : F.IsHomogeneous d) (hF : cubicOperator F = 0) (hcal : WeakCalibration (leadingNormalizedField F)) (hcharts : ∀ x : Fin (n+3) → ℝ, x ≠ 0 → eval x F = 0 → HasFlatMinimalPhaseChart F x) : ∃ (P Q : MvPolynomial (Fin (n+3)) ℝ) (k : ℕ), 0 < k ∧ Odd k ∧ Irreducible P ∧ P.IsHomogeneous P.totalDegree ∧ Q.IsHomogeneous Q.totalDegree ∧ F = P^k*Q ∧ ¬P ∣ Q ∧ (∃ x : Fin (n+3) → ℝ, eval x P = 0 ∧ (∑ j, (x j)^2) = 1) ∧ (∀ x : Fin (n+3) → ℝ, x ≠ 0 → eval x P = 0 → evaluatedGradient P x ≠ 0) ∧ (∀ x : Fin (n+3) → ℝ, x ≠ 0 → 0 < eval x Q) := by obtain ⟨hneg,hpos⟩ := Source29WeakHomogeneousSign.homogeneous_changes_sign F hhom hd hFne hcal obtain ⟨P,Q,k,hk,hP,hPhom,hQhom,hfac,hPQ,hPpos,hPneg,_⟩ := Source29RealLeadingFactor.exists_sign_changing_homogeneous_factor F d hhom hF hpos hneg have hdp : 1 ≤ P.totalDegree := by by_contra hn have he : P.totalDegree = 0 := by omega have hc := totalDegree_eq_zero_iff_eq_C.mp he obtain ⟨x,hx⟩ := hPpos obtain ⟨y,hy⟩ := hPneg rw [hc,eval_C] at hx hy linarith have hunit := Source29HigherDimensionalRealZero.exists_unit_zero_of_sign_change P P.totalDegree hPhom hdp hPpos hPneg have hQnonzero := cofactor_ne_zero_away_zero F P Q d k hk hfac hP hPQ hhom hF hcal hcharts hunit have hPF : P ∣ F := (dvd_pow_self P (by omega : k ≠ 0)).trans ⟨Q,hfac⟩ have hPreg := Source29PhaseChartFactorRegularity.irreducible_factor_regular_away_zero F P hFne hP hPF hF hcal hcharts have hodd : Odd k := by obtain ⟨x,hx,hxu⟩ := hunit have hxne : x ≠ 0 := by intro he simp only [he,Pi.zero_apply,zero_pow (by decide : 2 ≠ 0),Finset.sum_const_zero] at hxu norm_num at hxu have hxF : eval x F = 0 := by rw [hfac,map_mul,map_pow,hx,zero_pow (by omega : k ≠ 0),zero_mul] exact (Source29PhaseChartFactorRegularity.regularity_and_cofactor_nonzero F P Q k hk hfac hP hPQ hF hcal x hx (hcharts x hxne hxF)).2.2 rcases constant_sign_away_zero Q hQhom hQnonzero with hQpos | hQneg · exact ⟨P,Q,k,hk,hodd,hP,hPhom,hQhom,hfac,hPQ,hunit,hPreg,hQpos⟩ · refine ⟨-P,-Q,k,hk,hodd,Source29ConnectedFactorStructure.irreducible_neg_of_irreducible P hP, ?_,?_,?_,?_,?_,?_,?_⟩ · simpa only [totalDegree_neg] using hPhom.neg · simpa only [totalDegree_neg] using hQhom.neg · rw [hodd.neg_pow,neg_mul_neg] exact hfac · simpa only [neg_dvd,dvd_neg] using hPQ · obtain ⟨x,hx,hu⟩ := hunit exact ⟨x,by simpa only [map_neg,neg_eq_zero] using hx,hu⟩ · intro x hx hz hgrad have hpzero : eval x P = 0 := by simpa only [map_neg,neg_eq_zero] using hz apply hPreg x hx hpzero funext i have hi := congrFun hgrad i simpa only [evaluatedGradient,map_neg,Pi.zero_apply,neg_eq_zero] using hi · intro x hx simpa only [map_neg,neg_pos] using hQneg x hx end end Source29HigherDimensionalPhaseStructure /- Final component: LinearFactorPhaseRigidity -/ namespace Source29LinearFactorPhaseRigidity open MvPolynomial Matrix Source29LinearForm open Source29QuarticReuse.QuarticMinimal Source29QuarticReuse.FluxObstruction open Source29WeakCalibrationLimits open scoped BigOperators noncomputable section variable {n : ℕ} /-- A positive residual and an odd linear factor give the two halfspace signs. Calibrated halfspace rigidity then removes the residual completely. -/ theorem eq_odd_linear_power (F Q : MvPolynomial (Fin (n+1)) ℝ) (d k : ℕ) (hd : 0 < d) (b : Fin (n+1) → ℝ) (hb : b ≠ 0) (hk : Odd k) (hhom : F.IsHomogeneous d) (hFne : F ≠ 0) (hcal : WeakCalibration (leadingNormalizedField F)) (hfac : F = (linearForm b)^k * Q) (hQpos : ∀ x : Fin (n+1) → ℝ, x ≠ 0 → 0 < eval x Q) : ∃ (c : ℝ) (a : Fin (n+1) → ℝ), c ≠ 0 ∧ a ≠ 0 ∧ Odd d ∧ F = C c * (linearForm a)^d := by obtain ⟨U,hUt,hU,hcol⟩ := Source29LinearNormalRotation.exists_rotation b hb have hn : 0 < Real.sqrt (radiusSq b) := Real.sqrt_pos.mpr (radiusSq_pos_of_ne_zero hb) have hlin (x : Fin (n+1) → ℝ) : eval (U *ᵥ x) (linearForm b) = Real.sqrt (radiusSq b) * x 0 := Source29LinearEndpointRotation.linearForm_eval_rotation b hb U hUt hcol x have hune (x : Fin (n+1) → ℝ) (hx : x ≠ 0) : U *ᵥ x ≠ 0 := by intro he apply hx have hh := congrArg (fun y => U.transpose *ᵥ y) he simpa only [Matrix.mulVec_mulVec,hUt,Matrix.one_mulVec,Matrix.mulVec_zero] using hh have hpos : ∀ x : Fin (n+1) → ℝ, 0 < x 0 → 0 ≤ eval x (changeVariables U F) := by intro x hx have hxne : x ≠ 0 := fun he => hx.ne' (congrFun he 0) rw [eval_changeVariables,hfac,map_mul,map_pow,hlin] exact (mul_pos (hk.pow_pos_iff.mpr (mul_pos hn hx)) (hQpos _ (hune x hxne))).le have hneg : ∀ x : Fin (n+1) → ℝ, x 0 < 0 → eval x (changeVariables U F) ≤ 0 := by intro x hx have hxne : x ≠ 0 := fun he => hx.ne (congrFun he 0) rw [eval_changeVariables,hfac,map_mul,map_pow,hlin] exact (mul_neg_of_neg_of_pos (hk.pow_neg_iff.mpr (mul_neg_of_pos_of_neg hn hx)) (hQpos _ (hune x hxne))).le have hrotne : changeVariables U F ≠ 0 := by intro he have hh := congrArg (changeVariables U.transpose) he rw [changeVariables_comp,hU,changeVariables_one,map_zero] at hh exact hFne hh obtain ⟨c,hc,hodd,hpure⟩ := Source29CalibratedHalfspaceRigidity.eq_positive_odd_normal_power (changeVariables U F) d (isHomogeneous_changeVariables U F d hhom) hrotne (Source29OrthogonalCalibration.weakCalibration_changeVariables U hU F hcal) hpos hneg let L : MvPolynomial (Fin (n+1)) ℝ := changeVariables U.transpose (X 0) have hL : L.IsHomogeneous 1 := isHomogeneous_changeVariables U.transpose (X 0) 1 (isHomogeneous_X ℝ 0) have hback : F = C c * L^d := by have he := congrArg (changeVariables U.transpose) hpure rw [changeVariables_comp,hU,changeVariables_one] at he simpa only [L,map_mul,map_pow,changeVariables,aeval_C,algebraMap_eq] using he have hlinL : L = linearForm (evaluatedGradient L 0) := by rw [← Source29RegularPhaseDensity.homogeneousComponent_one_eq_linearForm, homogeneousComponent_eq_self hL] refine ⟨c,evaluatedGradient L 0,hc.ne',?_,hodd,?_⟩ · intro hz have hLzero : L = 0 := by rw [hlinL,hz]; simp [linearForm] exact hFne (by rw [hback,hLzero,zero_pow hd.ne',mul_zero]) · rwa [hlinL] at hback end end Source29LinearFactorPhaseRigidity /- Final component: LowDimensionalRigidityInduction -/ namespace Source29LowDimensionalRigidityInduction open MvPolynomial Source29LinearForm open Source29QuarticReuse.QuarticMinimal Source29QuarticReuse.FluxObstruction open Source29WeakCalibrationLimits Source29RadialPhaseChartInduction open scoped BigOperators noncomputable section /-- Reindex the low-dimensional factor into the radial/normal/link coordinates used by the compact curvature comparison. -/ theorem factor_degree_le_one (n : ℕ) (hn : n ≤ 4) (P Q : MvPolynomial (Fin (n+3)) ℝ) (k : ℕ) (hk : 0 < k) (hP : P.IsHomogeneous P.totalDegree) (hQ : Q.IsHomogeneous Q.totalDegree) (hirr : Irreducible P) (hF : leadingOperator (P^k*Q) = 0) (hQpos : ∀ x : Fin (n+3) → ℝ, x ≠ 0 → 0 < eval x Q) (hreg : ∀ x : Fin (n+3) → ℝ, x ≠ 0 → eval x P = 0 → evaluatedGradient P x ≠ 0) (hunit : ∃ x : Fin (n+3) → ℝ, eval x P = 0 ∧ (∑ j, (x j)^2) = 1) : P.totalDegree ≤ 1 := by let e : Fin (n+3) ≃ Option (Option (Fin (n+1))) := Fintype.equivOfCardEq (by simp) have hunit' (x : Option (Option (Fin (n+1))) → ℝ) (hx : (∑ j, (x j)^2) = 1) : (∑ j, ((x ∘ e) j)^2) = 1 := by change (∑ j, (x (e j))^2) = 1 rwa [e.sum_comp (fun j => (x j)^2)] have hne (x : Option (Option (Fin (n+1))) → ℝ) (hx : (∑ j, (x j)^2) = 1) : x ∘ e ≠ 0 := by intro hz have he := hunit' x hx simp only [hz,Pi.zero_apply,zero_pow (by decide : 2 ≠ 0),Finset.sum_const_zero] at he norm_num at he have hi : Irreducible (rename e P) := (MulEquiv.irreducible_iff (renameEquiv ℝ e)).mpr hirr have hL : leadingOperator ((rename e P)^k*rename e Q) = 0 := by change Source29FactorInheritance.cubicOperator ((rename e P)^k*rename e Q) = 0 rw [← map_pow, ← map_mul, Source29PolynomialReindex.cubicOperator_rename] exact congrArg (rename e) hF have hpositive : ∀ x : Option (Option (Fin (n+1))) → ℝ, eval x (rename e P) = 0 ∧ (∑ j, (x j)^2) = 1 → 0 < eval x (rename e Q) := by intro x hx simpa only [eval_rename] using hQpos (x ∘ e) (hne x hx.2) have hregular : ∀ x : Option (Option (Fin (n+1))) → ℝ, eval x (rename e P) = 0 ∧ (∑ j, (x j)^2) = 1 → Source29PolynomialCurvaturePotential.gradientAt (rename e P) x ≠ 0 := by intro x hx apply Source29PolynomialReindex.gradientAt_rename_ne_zero e P x exact hreg (x ∘ e) (hne x hx.2) (by simpa only [eval_rename] using hx.1) have hnonempty : ∃ x : Option (Option (Fin (n+1))) → ℝ, eval x (rename e P) = 0 ∧ (∑ j, (x j)^2) = 1 := by obtain ⟨x,hx,hu⟩ := hunit refine ⟨x ∘ e.symm,?_,?_⟩ · simpa only [eval_rename,Function.comp_assoc,e.symm_comp_self,Function.comp_id] using hx · change (∑ j, (x (e.symm j))^2) = 1 rwa [e.symm.sum_comp (fun j => (x j)^2)] have hsmall := Source29CompactPositiveRootRigidity.degree_le_one (rename e P) (rename e Q) P.totalDegree Q.totalDegree k hk hP.rename_isHomogeneous hQ.rename_isHomogeneous hi hL (by simp) (by simpa using Nat.add_le_add_right hn 1) hpositive hregular hnonempty calc P.totalDegree = (rename e P).totalDegree := (totalDegree_renameEquiv e P).symm _ ≤ 1 := hsmall /-- Rigidity in the preceding dimension supplies phase charts; the compact positive-root comparison makes the unique real factor linear, completing calibrated homogeneous rigidity in ambient dimensions three through seven. -/ theorem step (n : ℕ) (hn : n ≤ 4) (hIH : LinearRigidity (n+2)) : LinearRigidity (n+3) := by intro F d hhom hd hFne hF hcal have hcharts := fun x hx hzero => phase_chart_at_nonzero_zero hIH F d hhom hFne hF hcal x hx hzero obtain ⟨P,Q,k,hk,hodd,hirr,hP,hQ,hfac,hPQ,hunit,hreg,hQpos⟩ := Source29HigherDimensionalPhaseStructure.exists_positive_regular_factor F d hd hFne hhom hF hcal hcharts have hsmall := factor_degree_le_one n hn P Q k hk hP hQ hirr (by rwa [← hfac]) hQpos hreg hunit have hdegree : P.totalDegree = 1 := by obtain ⟨x,hx,_⟩ := hunit have hpos := Source29GlobalPhaseFactor.totalDegree_pos_of_zero P hirr.ne_zero x hx omega have hlinear : P = linearForm (evaluatedGradient P 0) := by rw [← Source29RegularPhaseDensity.homogeneousComponent_one_eq_linearForm, homogeneousComponent_eq_self (show P.IsHomogeneous 1 by simpa only [hdegree] using hP)] have hb : evaluatedGradient P 0 ≠ 0 := by intro hz apply hirr.ne_zero rw [hlinear,hz] simp [linearForm] exact Source29LinearFactorPhaseRigidity.eq_odd_linear_power F Q d k hd (evaluatedGradient P 0) hb hodd hhom hFne hcal (by rwa [← hlinear]) hQpos end end Source29LowDimensionalRigidityInduction /- Final component: FiniteDimensionalRigidity -/ namespace Source29FiniteDimensionalRigidity open MvPolynomial open Source29RadialPhaseChartInduction Source29GeometricPhaseChart open Source29QuarticReuse.QuarticMinimal Source29QuarticReuse.FluxObstruction open Source29WeakCalibrationLimits noncomputable section /-- Starting from the proved binary base, the regular-cone induction reaches ambient dimension seven. -/ theorem linearRigidity_seven : LinearRigidity 7 := by have h2 := Source29HomogeneousTwoDimension.linearRigidity_two have h3 := Source29LowDimensionalRigidityInduction.step 0 (by omega) h2 have h4 := Source29LowDimensionalRigidityInduction.step 1 (by omega) h3 have h5 := Source29LowDimensionalRigidityInduction.step 2 (by omega) h4 have h6 := Source29LowDimensionalRigidityInduction.step 3 (by omega) h5 exact Source29LowDimensionalRigidityInduction.step 4 (by omega) h6 /-- The seven-dimensional classification gives actual analytic minimal phase charts at every nonvertex zero in eight dimensions. -/ theorem phase_chart_dimension_eight (F : MvPolynomial (Fin 8) ℝ) (D : ℕ) (hhom : F.IsHomogeneous D) (hne : F ≠ 0) (hF : leadingOperator F = 0) (hcal : WeakCalibration (leadingNormalizedField F)) (p : Fin 8 → ℝ) (hp : p ≠ 0) (hzero : eval p F = 0) : HasFlatMinimalPhaseChart F p := phase_chart_at_nonzero_zero linearRigidity_seven F D hhom hne hF hcal p hp hzero /-- Apply the derived nonvertex charts to the leading form of every polynomial minimal graph in eight variables. -/ theorem problem29 : Math30.Problem29 := by apply Source29PhaseChartsPositiveStructure.problem29_of_phase_charts_away_zero intro P hmin hdeg p hp hzero obtain ⟨hne,hhom,hL⟩ := QuarticPolynomialBasics.leading_component_data P hmin hdeg exact phase_chart_dimension_eight (homogeneousComponent P.totalDegree P) P.totalDegree hhom hne hL (Source29TopPhasePerimeter.top_weakCalibration P hmin hdeg) p hp hzero end end Source29FiniteDimensionalRigidity theorem target : fcTypeOfName% "Math30Catalog.source29" := by exact Source29FiniteDimensionalRigidity.problem29