{ "schema": "theoremos.public-archive.v1", "repository": "https://github.com/LikC1606/theorem-os-site", "archiveRevision": "443b58d295ed789a0a6808f330dd65ca8e2e4f5a", "snapshotAt": "2026-10-15T18:47:55.278958+00:00", "records": [ { "id": "dimitrov", "title": "Dimitrov", "subtitle": "代数整数的 house 下界", "area": "数论", "summary": "证明非零且非单位根代数整数的 house 下界。档案保留最终提交包及官方验收记录。", "declaration": "theorem dimitrov", "en": { "subtitle": "A lower bound for the house of algebraic integers", "area": "Number theory", "summary": "Proves the lower bound for the house of an algebraic integer that is nonzero and not a root of unity. The archive keeps the final submission package and its official result." }, "status": "official_accepted", "model": "DeepScientist Math + GPT-6.1 (gpt-6.1-sol)", "updatedAt": "2026-10-16T12:04:03Z", "archiveUrl": "https://github.com/LikC1606/theorem-os-site/tree/main/accepted/dimitrov", "sources": [ { "name": "Submission.lean", "path": "accepted/dimitrov/Submission.lean", "url": "https://github.com/LikC1606/theorem-os-site/blob/main/accepted/dimitrov/Submission.lean", "sha256": "f00a658ba195e41c8b9f340cb6c21cbbfeb9e4cb68c0c0e85c1d8b3bdb25fe5d", "lines": 19, "code": "import Mathlib.NumberTheory.NumberField.House\nimport Lake.Toml\nimport Lake.Util.Message\nimport Lean\nimport Submission.Helpers\n\nnamespace Submission\n\ntheorem dimitrov {K : Type*} [Field K] [NumberField K]\n (α : K)\n (α_int : IsIntegral ℤ α)\n (α_ne_zero : α ≠ 0)\n (α_not_rootOfUnity : ¬ IsOfFinOrder α) :\n (2 : ℝ) ^ (1 / (4 * (Finset.univ.image fun σ : K →+* ℂ ↦ (σ α).arg).card) : ℝ) ≤\n NumberField.house α := by\n exact Helpers.rpow_from_nat_power (NumberField.house α) _\n (NumberField.house_nonneg α) (Helpers.argument_card_pos α)\n (Helpers.house_power_lower_bound α α_int α_ne_zero α_not_rootOfUnity)\nend Submission\n" }, { "name": "Submission/Helpers.lean", "path": "accepted/dimitrov/Submission/Helpers.lean", "url": "https://github.com/LikC1606/theorem-os-site/blob/main/accepted/dimitrov/Submission/Helpers.lean", "sha256": "4958987925b01fbfba67842ea4aa79e1452f1614e1c4ed82cba7bbc933affefd", "lines": 5960, "code": "import Mathlib.Algebra.Polynomial.Reverse\nimport Mathlib.FieldTheory.Tower\nimport Mathlib.FieldTheory.IntermediateField.Adjoin.Basic\nimport Mathlib.Analysis.Fourier.PoissonSummation\nimport Mathlib.Algebra.Polynomial.Expand\nimport Mathlib.Analysis.SpecialFunctions.Pow.Real\nimport Mathlib.Probability.ProbabilityMassFunction.Integrals\nimport Mathlib.Probability.Distributions.Uniform\nimport Mathlib.Logic.Equiv.Fin.Rotate\nimport Mathlib.Data.Fin.Tuple.Sort\nimport Mathlib.MeasureTheory.Integral.Prod\nimport Mathlib.MeasureTheory.Measure.FiniteMeasureProd\nimport Mathlib.Analysis.SpecialFunctions.Trigonometric.Inverse\nimport Mathlib.Analysis.SpecialFunctions.Complex.LogBounds\nimport Mathlib.Analysis.SpecialFunctions.Trigonometric.DerivHyp\nimport Mathlib.Analysis.Convex.Jensen\nimport Mathlib.Analysis.Convex.Deriv\nimport Mathlib.Tactic.LinearCombination\nimport Mathlib.RingTheory.PowerSeries.Inverse\nimport Mathlib.RingTheory.PowerSeries.Substitution\nimport Mathlib.RingTheory.PowerSeries.Catalan\nimport Mathlib.RingTheory.PowerSeries.Trunc\nimport Mathlib.Analysis.Calculus.BumpFunction.SmoothApprox\nimport Mathlib.MeasureTheory.Measure.Prokhorov\nimport Mathlib.Analysis.SpecialFunctions.ImproperIntegrals\nimport Mathlib.Analysis.Fourier.Inversion\nimport Mathlib.Analysis.Fourier.AddCircle\nimport Mathlib.RingTheory.PowerSeries.NoZeroDivisors\nimport Mathlib.RingTheory.PowerSeries.Binomial\nimport Mathlib.Analysis.Analytic.Binomial\nimport Mathlib.Analysis.Complex.CauchyIntegral\nimport Mathlib.MeasureTheory.Integral.CurveIntegral.Poincare\nimport Mathlib.LinearAlgebra.Matrix.NonsingularInverse\nimport Mathlib.Analysis.SpecificLimits.Normed\nimport Mathlib.LinearAlgebra.Matrix.Block\nimport Mathlib.LinearAlgebra.Matrix.Determinant.Basic\nimport Mathlib.Analysis.Complex.SqrtDeriv\nimport Mathlib.MeasureTheory.Integral.IntervalIntegral.Basic\nimport Mathlib.Topology.MetricSpace.Thickening\nimport Mathlib.RingTheory.Polynomial.IsIntegral\nimport Mathlib.FieldTheory.RatFunc.Basic\nimport Mathlib.Topology.Order.Compact\nimport Mathlib.Tactic.Linarith\nimport Mathlib.Algebra.Polynomial.Roots\nimport Mathlib.Algebra.Polynomial.BigOperators\nimport Mathlib.Algebra.Order.BigOperators.GroupWithZero.Finset\nimport Mathlib.Algebra.Order.BigOperators.Group.Finset\nimport Mathlib.Algebra.BigOperators.Group.Finset.Piecewise\nimport Mathlib.Analysis.SpecialFunctions.Complex.Arg\nimport Mathlib.NumberTheory.NumberField.InfinitePlace.Embeddings\nimport Mathlib.NumberTheory.NumberField.House\nnamespace Submission.Helpers\n\ntheorem house_gt_one {K : Type*} [Field K] [NumberField K] (α : K)\n (α_int : IsIntegral ℤ α) (α_ne_zero : α ≠ 0)\n (α_not_rootOfUnity : ¬ IsOfFinOrder α) : 1 < NumberField.house α := by\n by_contra h\n have hhouse : NumberField.house α ≤ 1 := le_of_not_gt h\n obtain ⟨n, hn, hpow⟩ :=\n NumberField.Embeddings.pow_eq_one_of_norm_le_one K ℂ α_ne_zero α_int\n (fun σ => (NumberField.norm_embedding_le_house α σ).trans hhouse)\n exact α_not_rootOfUnity (isOfFinOrder_iff_pow_eq_one.mpr ⟨n, hn, hpow⟩)\ntheorem argument_card_pos {K : Type*} [Field K] [NumberField K] (α : K) :\n 0 < (Finset.univ.image fun σ : K →+* ℂ ↦ (σ α).arg).card := by\n classical\n exact Finset.card_pos.mpr (Finset.univ_nonempty.image _)\ntheorem power_argument_card_le {K : Type*} [Field K] [NumberField K]\n (α : K) (k : ℕ) :\n (Finset.univ.image fun σ : K →+* ℂ ↦ (σ (α ^ k)).arg).card ≤\n (Finset.univ.image fun σ : K →+* ℂ ↦ (σ α).arg).card := by\n classical\n let f : ℝ → ℝ := fun θ => (k • (θ : Real.Angle)).toReal\n have harg (σ : K →+* ℂ) : (σ (α ^ k)).arg = f (σ α).arg := by\n rw [map_pow]\n exact Complex.arg_coe_angle_eq_iff_eq_toReal.mp\n (Complex.arg_pow_coe_angle (σ α) k)\n have himage : (Finset.univ.image fun σ : K →+* ℂ ↦ (σ (α ^ k)).arg) =\n (Finset.univ.image fun σ : K →+* ℂ ↦ (σ α).arg).image f := by\n rw [Finset.image_image]\n apply Finset.image_congr\n intro σ _\n exact harg σ\n rw [himage]\n exact Finset.card_image_le\ntheorem rpow_from_nat_power (x : ℝ) (n : ℕ) (hx : 0 ≤ x) (hn : 0 < n)\n (hpow : (2 : ℝ) ≤ x ^ (4 * n)) :\n (2 : ℝ) ^ (1 / (4 * (n : ℝ)) : ℝ) ≤ x := by\n have hpos : (0 : ℝ) < 4 * (n : ℝ) :=\n mul_pos (by norm_num) (Nat.cast_pos.mpr hn)\n have hcast : (4 : ℝ) * (n : ℝ) = ((4 * n : ℕ) : ℝ) := by simp\n rw [one_div, Real.rpow_inv_le_iff_of_pos (by norm_num) hx hpos,\n hcast, Real.rpow_natCast]\n exact hpow\nnoncomputable def radial_fekete_product {n : ℕ} (z : Fin n → ℂ) : ℝ :=\n ∏ i, ∏ j ∈ Finset.univ.erase i, ‖z i - z j‖\nnoncomputable def radial_fekete_fiber {n : ℕ} (z : Fin n → ℂ) (i : Fin n) : ℝ :=\n ∏ j ∈ Finset.univ.erase i, ‖z i - z j‖\nnoncomputable def radial_fekete_remainder {n : ℕ} (z : Fin n → ℂ) (i : Fin n) : ℝ :=\n ∏ k ∈ Finset.univ.erase i, ∏ j ∈ (Finset.univ.erase i).erase k, ‖z k - z j‖\ntheorem radial_fekete_product_factor {n : ℕ} (z : Fin n → ℂ) (i : Fin n) :\n radial_fekete_product z =\n radial_fekete_remainder z i * radial_fekete_fiber z i ^ 2 := by\n classical\n unfold radial_fekete_product radial_fekete_remainder radial_fekete_fiber\n have hrow : ∀ k ∈ (Finset.univ : Finset (Fin n)).erase i,\n (∏ j ∈ Finset.univ.erase k, ‖z k - z j‖) =\n (∏ j ∈ (Finset.univ.erase i).erase k, ‖z k - z j‖) * ‖z k - z i‖ := by\n intro k hk\n have hik : i ≠ k := ((Finset.mem_erase.mp hk).1).symm\n rw [← Finset.prod_erase_mul (Finset.univ.erase k)\n (fun j => ‖z k - z j‖) (a := i) (by simp [hik])]\n rw [Finset.erase_right_comm]\n rw [← Finset.prod_erase_mul Finset.univ\n (fun k => ∏ j ∈ Finset.univ.erase k, ‖z k - z j‖) (Finset.mem_univ i)]\n rw [Finset.prod_congr rfl hrow, Finset.prod_mul_distrib]\n have hrev : (∏ k ∈ Finset.univ.erase i, ‖z k - z i‖) =\n ∏ k ∈ Finset.univ.erase i, ‖z i - z k‖ := by\n apply Finset.prod_congr rfl\n intro k hk\n exact norm_sub_rev _ _\n rw [hrev, pow_two]\n ac_rfl\ntheorem radial_contracting_monic_of_fekete {n : ℕ} (hn : 1 < n)\n (E : Set ℂ) (z : Fin n → ℂ) (hz : ∀ i, z i ∈ E)\n (hmax : ∀ w : Fin n → ℂ, (∀ i, w i ∈ E) →\n radial_fekete_product w ≤ radial_fekete_product z)\n (hpos : 0 < radial_fekete_product z)\n (hlt : radial_fekete_product z < 1) :\n ∃ p : Polynomial ℂ, p.Monic ∧ 0 < p.natDegree ∧\n ∃ q : ℝ, 0 ≤ q ∧ q < 1 ∧ ∀ x ∈ E, ‖p.eval x‖ ≤ q := by\n classical\n have hex : ∃ i : Fin n, radial_fekete_fiber z i < 1 := by\n by_contra h\n have hge : ∀ i : Fin n, 1 ≤ radial_fekete_fiber z i :=\n fun i => le_of_not_gt (fun hi => h ⟨i, hi⟩)\n have hprod : 1 ≤ radial_fekete_product z :=\n Finset.one_le_prod₀ (fun i _ => hge i)\n exact hlt.not_ge hprod\n obtain ⟨i, hi⟩ := hex\n have hq : 0 ≤ radial_fekete_fiber z i :=\n Finset.prod_nonneg (fun j _ => norm_nonneg _)\n have hC : 0 ≤ radial_fekete_remainder z i :=\n Finset.prod_nonneg (fun k _ => Finset.prod_nonneg (fun j _ => norm_nonneg _))\n have hCne : radial_fekete_remainder z i ≠ 0 := by\n intro hzero\n rw [radial_fekete_product_factor z i, hzero, zero_mul] at hpos\n exact (lt_irrefl 0) hpos\n have hCpos : 0 < radial_fekete_remainder z i := lt_of_le_of_ne hC hCne.symm\n refine ⟨∏ j ∈ Finset.univ.erase i, (Polynomial.X - Polynomial.C (z j)),\n Polynomial.monic_prod_X_sub_C z _, ?_, radial_fekete_fiber z i, hq, hi, ?_⟩\n · rw [Polynomial.natDegree_finsetProd_X_sub_C_eq_card,\n Finset.card_erase_of_mem (Finset.mem_univ i), Finset.card_univ, Fintype.card_fin]\n exact Nat.sub_pos_of_lt hn\n · intro x hx\n have hmem : ∀ j : Fin n, Function.update z i x j ∈ E := by\n intro j\n by_cases hji : j = i\n · subst j\n simpa using hx\n · rw [Function.update_of_ne hji]\n exact hz j\n have hrem : radial_fekete_remainder (Function.update z i x) i =\n radial_fekete_remainder z i := by\n unfold radial_fekete_remainder\n apply Finset.prod_congr rfl\n intro k hk\n have hki : k ≠ i := (Finset.mem_erase.mp hk).1\n apply Finset.prod_congr rfl\n intro j hj\n have hji : j ≠ i := (Finset.mem_erase.mp (Finset.mem_erase.mp hj).2).1\n rw [Function.update_of_ne hki, Function.update_of_ne hji]\n have hfiber : radial_fekete_fiber (Function.update z i x) i =\n ∏ j ∈ Finset.univ.erase i, ‖x - z j‖ := by\n unfold radial_fekete_fiber\n apply Finset.prod_congr rfl\n intro j hj\n rw [Function.update_self, Function.update_of_ne (Finset.mem_erase.mp hj).1]\n have hcomp := hmax (Function.update z i x) hmem\n rw [radial_fekete_product_factor (Function.update z i x) i,\n radial_fekete_product_factor z i, hrem, hfiber] at hcomp\n have hsquare : (∏ j ∈ Finset.univ.erase i, ‖x - z j‖) ^ 2 ≤\n radial_fekete_fiber z i ^ 2 := le_of_mul_le_mul_left hcomp hCpos\n have hxprod : 0 ≤ ∏ j ∈ Finset.univ.erase i, ‖x - z j‖ :=\n Finset.prod_nonneg (fun j _ => norm_nonneg _)\n simp only [Polynomial.eval_prod, Polynomial.eval_sub, Polynomial.eval_X,\n Polynomial.eval_C, norm_prod]\n nlinarith\ntheorem radial_fekete_product_continuous (n : ℕ) :\n Continuous (radial_fekete_product (n := n)) := by\n classical\n unfold radial_fekete_product\n exact continuous_finsetProd Finset.univ (fun i _ =>\n continuous_finsetProd (Finset.univ.erase i) (fun j _ =>\n ((continuous_apply i).sub (continuous_apply j)).norm))\ntheorem radial_contracting_monic_of_compact_fekete_bound {n : ℕ} (hn : 1 < n)\n (E : Set ℂ) (hE : IsCompact E) (z₀ : Fin n → ℂ)\n (hz₀ : ∀ i, z₀ i ∈ E) (hpos₀ : 0 < radial_fekete_product z₀)\n (hbound : ∀ z : Fin n → ℂ, (∀ i, z i ∈ E) → radial_fekete_product z < 1) :\n ∃ p : Polynomial ℂ, p.Monic ∧ 0 < p.natDegree ∧\n ∃ q : ℝ, 0 ≤ q ∧ q < 1 ∧ ∀ x ∈ E, ‖p.eval x‖ ≤ q := by\n let S : Set (Fin n → ℂ) := Set.pi Set.univ (fun _ => E)\n have hS : IsCompact S := isCompact_univ_pi (fun _ => hE)\n have hz₀S : z₀ ∈ S := by simpa only [S, Set.mem_univ_pi] using hz₀\n obtain ⟨z, hz, hmax⟩ := hS.exists_isMaxOn ⟨z₀, hz₀S⟩\n (radial_fekete_product_continuous n).continuousOn\n have hzE : ∀ i, z i ∈ E := by simpa only [S, Set.mem_univ_pi] using hz\n have hmaxE : ∀ w : Fin n → ℂ, (∀ i, w i ∈ E) →\n radial_fekete_product w ≤ radial_fekete_product z := by\n intro w hw\n exact hmax (by simpa only [S, Set.mem_univ_pi] using hw)\n exact radial_contracting_monic_of_fekete hn E z hzE hmaxE\n (hpos₀.trans_le (hmax hz₀S)) (hbound z hzE)\nnoncomputable def radial_tree_set (A : Finset ℂ) (T : ℝ) : Set ℂ :=\n ⋃ a ∈ A, (fun t : ℝ => (t : ℂ) * a) '' Set.Icc 0 T\ntheorem radial_tree_set_compact (A : Finset ℂ) (T : ℝ) :\n IsCompact (radial_tree_set A T) := by\n exact A.isCompact_biUnion (fun a _ =>\n isCompact_Icc.image (Complex.continuous_ofReal.mul continuous_const))\ntheorem radial_tree_set_mem_iff (A : Finset ℂ) (T : ℝ) (z : ℂ) :\n z ∈ radial_tree_set A T ↔\n ∃ a ∈ A, ∃ t : ℝ, 0 ≤ t ∧ t ≤ T ∧ z = (t : ℂ) * a := by\n simp only [radial_tree_set, Set.mem_iUnion, Set.mem_image, Set.mem_Icc]\n constructor\n · rintro ⟨a, ha, t, ht, htz⟩\n exact ⟨a, ha, t, ht.1, ht.2, htz.symm⟩\n · rintro ⟨a, ha, t, ht₀, htT, hzt⟩\n exact ⟨a, ha, t, ⟨ht₀, htT⟩, hzt.symm⟩\ntheorem radial_tree_fekete_positive (A : Finset ℂ) (T : ℝ) (n : ℕ)\n (hA : A.Nonempty) (hunit : ∀ a ∈ A, ‖a‖ = 1) (hT : 0 < T) :\n ∃ z : Fin n → ℂ, (∀ i, z i ∈ radial_tree_set A T) ∧\n 0 < radial_fekete_product z := by\n classical\n obtain ⟨a, ha⟩ := hA\n have ha₀ : a ≠ 0 := by\n intro ha₀\n have := hunit a ha\n simp [ha₀] at this\n let r : Fin n → ℝ := fun i => T * (i.val : ℝ) / ((n : ℝ) + 1)\n let z : Fin n → ℂ := fun i => (r i : ℂ) * a\n have hden : 0 < (n : ℝ) + 1 := by\n have : 0 ≤ (n : ℝ) := Nat.cast_nonneg n\n linarith\n have hr : ∀ i, r i ∈ Set.Icc 0 T := by\n intro i\n have hi : (i.val : ℝ) < (n : ℝ) := by exact_mod_cast i.isLt\n constructor\n · exact div_nonneg (mul_nonneg hT.le (Nat.cast_nonneg _)) hden.le\n · apply (div_le_iff₀ hden).mpr\n nlinarith\n have hz : ∀ i, z i ∈ radial_tree_set A T := by\n intro i\n exact (radial_tree_set_mem_iff A T (z i)).mpr\n ⟨a, ha, r i, (hr i).1, (hr i).2, rfl⟩\n have hinj : Function.Injective z := by\n intro i j hij\n have hrij : r i = r j := Complex.ofReal_injective (mul_right_cancel₀ ha₀ hij)\n have hmul : T * (i.val : ℝ) = T * (j.val : ℝ) :=\n (div_left_inj' hden.ne').mp hrij\n have hval : (i.val : ℝ) = (j.val : ℝ) := mul_left_cancel₀ hT.ne' hmul\n exact Fin.ext (by exact_mod_cast hval)\n refine ⟨z, hz, ?_⟩\n unfold radial_fekete_product\n apply Finset.prod_pos\n intro i _\n apply Finset.prod_pos\n intro j hj\n exact norm_pos_iff.mpr (sub_ne_zero.mpr (fun hij =>\n (Finset.mem_erase.mp hj).1 (hinj hij).symm))\ntheorem radial_tree_contracting_monic_of_fekete_estimate (A : Finset ℂ) (T : ℝ)\n (hA : A.Nonempty) (hunit : ∀ a ∈ A, ‖a‖ = 1) (hT : 0 ≤ T)\n (hestimate : ∃ n : ℕ, 1 < n ∧\n ∀ z : Fin n → ℂ, (∀ i, z i ∈ radial_tree_set A T) →\n radial_fekete_product z < 1) :\n ∃ p : Polynomial ℂ, p.Monic ∧ 0 < p.natDegree ∧\n ∃ q : ℝ, 0 ≤ q ∧ q < 1 ∧\n ∀ a ∈ A, ∀ t : ℝ, 0 ≤ t → t ≤ T → ‖p.eval ((t : ℂ) * a)‖ ≤ q := by\n by_cases hT₀ : T = 0\n · refine ⟨Polynomial.X, Polynomial.monic_X, by simp, 0, le_rfl, zero_lt_one, ?_⟩\n intro a ha t ht₀ htT\n have ht : t = 0 := le_antisymm (hT₀ ▸ htT) ht₀\n simp [ht]\n · obtain ⟨n, hn, hbound⟩ := hestimate\n obtain ⟨z₀, hz₀, hpos₀⟩ := radial_tree_fekete_positive A T n hA hunit\n (lt_of_le_of_ne hT (Ne.symm hT₀))\n obtain ⟨p, hp, hdegree, q, hq₀, hq₁, hnorm⟩ :=\n radial_contracting_monic_of_compact_fekete_bound hn (radial_tree_set A T)\n (radial_tree_set_compact A T) z₀ hz₀ hpos₀ hbound\n refine ⟨p, hp, hdegree, q, hq₀, hq₁, ?_⟩\n intro a ha t ht₀ htT\n exact hnorm _ ((radial_tree_set_mem_iff A T _).mpr ⟨a, ha, t, ht₀, htT, rfl⟩)\ntheorem radial_fekete_product_scale {n : ℕ} (c : ℂ) (z : Fin n → ℂ) :\n radial_fekete_product (fun i => c * z i) =\n ‖c‖ ^ (n * (n - 1)) * radial_fekete_product z := by\n classical\n unfold radial_fekete_product\n simp_rw [← mul_sub, norm_mul, Finset.prod_mul_distrib, Finset.prod_const,\n Finset.card_erase_of_mem (Finset.mem_univ _), Finset.card_univ, Fintype.card_fin]\n simp only [Finset.prod_const, Finset.card_univ, Fintype.card_fin,\n ← pow_mul, Nat.mul_comm]\ntheorem radial_tree_set_scale_mem (A : Finset ℂ) (T : ℝ) (hT : 0 < T)\n (z : ℂ) (hz : z ∈ radial_tree_set A T) :\n z / (T : ℂ) ∈ radial_tree_set A 1 := by\n obtain ⟨a, ha, t, ht₀, htT, rfl⟩ := (radial_tree_set_mem_iff A T z).mp hz\n refine (radial_tree_set_mem_iff A 1 _).mpr\n ⟨a, ha, t / T, div_nonneg ht₀ hT.le, (div_le_one hT).mpr htT, ?_⟩\n rw [Complex.ofReal_div]\n exact mul_div_right_comm _ _ _\ntheorem radial_tree_fekete_estimate_of_unit_estimate (A : Finset ℂ) (T : ℝ)\n (hT : 0 < T) (n : ℕ)\n (hunit : ∀ z : Fin n → ℂ, (∀ i, z i ∈ radial_tree_set A 1) →\n T ^ (n * (n - 1)) * radial_fekete_product z < 1) :\n ∀ z : Fin n → ℂ, (∀ i, z i ∈ radial_tree_set A T) →\n radial_fekete_product z < 1 := by\n intro z hz\n let w : Fin n → ℂ := fun i => z i / (T : ℂ)\n have hw : ∀ i, w i ∈ radial_tree_set A 1 :=\n fun i => radial_tree_set_scale_mem A T hT (z i) (hz i)\n have hTw : (fun i => (T : ℂ) * w i) = z := by\n funext i\n exact mul_div_cancel₀ _ (Complex.ofReal_ne_zero.mpr hT.ne')\n have hscale := radial_fekete_product_scale (T : ℂ) w\n rw [hTw, Complex.norm_real, Real.norm_eq_abs, abs_of_pos hT] at hscale\n rw [hscale]\n exact hunit w hw\ntheorem radial_tree_contracting_monic_of_normalized_fekete_estimate\n (A : Finset ℂ) (T : ℝ) (hA : A.Nonempty)\n (hunit : ∀ a ∈ A, ‖a‖ = 1) (hT : 0 ≤ T) (hpower : T ^ A.card < 4)\n (hestimate : ∀ b : ℝ, (1 : ℝ) / 4 < b →\n ∃ n : ℕ, 1 < n ∧ ∀ z : Fin n → ℂ,\n (∀ i, z i ∈ radial_tree_set A 1) →\n radial_fekete_product z ^ A.card ≤ b ^ (n * (n - 1))) :\n ∃ p : Polynomial ℂ, p.Monic ∧ 0 < p.natDegree ∧\n ∃ q : ℝ, 0 ≤ q ∧ q < 1 ∧\n ∀ a ∈ A, ∀ t : ℝ, 0 ≤ t → t ≤ T → ‖p.eval ((t : ℂ) * a)‖ ≤ q := by\n by_cases hT₀ : T = 0\n · refine ⟨Polynomial.X, Polynomial.monic_X, by simp, 0, le_rfl, zero_lt_one, ?_⟩\n intro a ha t ht₀ htT\n have ht : t = 0 := le_antisymm (hT₀ ▸ htT) ht₀\n simp [ht]\n · have hTpos : 0 < T := lt_of_le_of_ne hT (Ne.symm hT₀)\n have hr : 0 < A.card := Finset.card_pos.mpr hA\n have hTp : 0 < T ^ A.card := pow_pos hTpos _\n have hquarter : (1 : ℝ) / 4 < 1 / T ^ A.card := by\n apply (lt_div_iff₀ hTp).mpr\n nlinarith\n obtain ⟨b, hb₁, hb₂⟩ := exists_between hquarter\n have hbpos : 0 < b := lt_trans (by norm_num : (0 : ℝ) < 1 / 4) hb₁\n have hTb : T ^ A.card * b < 1 := by\n have := (lt_div_iff₀ hTp).mp hb₂\n nlinarith\n obtain ⟨n, hn, hbound⟩ := hestimate b hb₁\n have hd : 0 < n * (n - 1) :=\n Nat.mul_pos (lt_trans Nat.zero_lt_one hn) (Nat.sub_pos_of_lt hn)\n have hunitbound : ∀ z : Fin n → ℂ, (∀ i, z i ∈ radial_tree_set A 1) →\n T ^ (n * (n - 1)) * radial_fekete_product z < 1 := by\n intro z hz\n have hnonneg : 0 ≤ radial_fekete_product z :=\n Finset.prod_nonneg (fun i _ => Finset.prod_nonneg (fun j _ => norm_nonneg _))\n have hcompare : (T ^ (n * (n - 1)) * radial_fekete_product z) ^ A.card ≤\n (T ^ A.card * b) ^ (n * (n - 1)) := by\n rw [mul_pow, mul_pow, ← pow_mul, ← pow_mul,\n Nat.mul_comm (n * (n - 1)) A.card]\n exact mul_le_mul_of_nonneg_left (hbound z hz) (pow_nonneg hT _)\n exact (pow_lt_one_iff_of_nonneg\n (mul_nonneg (pow_nonneg hT _) hnonneg) hr.ne').mp\n (hcompare.trans_lt (pow_lt_one₀ (mul_nonneg hTp.le hbpos.le) hTb hd.ne'))\n exact radial_tree_contracting_monic_of_fekete_estimate A T hA hunit hT\n ⟨n, hn, radial_tree_fekete_estimate_of_unit_estimate A T hTpos n hunitbound⟩\ntheorem radial_tree_contracting_monic_of_normalized_fekete_estimate_expanded\n (A : Finset ℂ) (T : ℝ) (hA : A.Nonempty)\n (hunit : ∀ a ∈ A, ‖a‖ = 1) (hT : 0 ≤ T) (hpower : T ^ A.card < 4)\n (hestimate : ∀ b : ℝ, (1 : ℝ) / 4 < b →\n ∃ n : ℕ, 1 < n ∧ ∀ z : Fin n → ℂ,\n (∀ i, z i ∈ (⋃ a ∈ A,\n (fun t : ℝ => (t : ℂ) * a) '' Set.Icc 0 (1 : ℝ))) →\n (∏ i : Fin n, ∏ j ∈ (Finset.univ : Finset (Fin n)).erase i,\n ‖z i - z j‖) ^ A.card ≤ b ^ (n * (n - 1))) :\n ∃ p : Polynomial ℂ, p.Monic ∧ 0 < p.natDegree ∧\n ∃ q : ℝ, 0 ≤ q ∧ q < 1 ∧\n ∀ a ∈ A, ∀ t : ℝ, 0 ≤ t → t ≤ T → ‖p.eval ((t : ℂ) * a)‖ ≤ q := by\n exact radial_tree_contracting_monic_of_normalized_fekete_estimate\n A T hA hunit hT hpower hestimate\ntheorem ratFunc_square_root_is_polynomial {F : Type*} [Field F]\n (r : RatFunc F) (P : Polynomial F)\n (h : r ^ 2 = algebraMap (Polynomial F) (RatFunc F) P) :\n ∃ Q : Polynomial F, Q ^ 2 = P := by\n have hr : IsIntegral (Polynomial F) (r ^ 2) := by\n rw [h]\n exact isIntegral_algebraMap\n obtain ⟨Q, hQ⟩ := IsIntegrallyClosed.exists_algebraMap_eq_of_isIntegral_pow\n (by norm_num : 0 < (2 : ℕ)) hr\n refine ⟨Q, RatFunc.algebraMap_injective F ?_⟩\n rw [map_pow, hQ, h]\ntheorem rational_power_series_square_root_is_polynomial\n (S : PowerSeries ℚ) (F : Polynomial ℚ)\n (hS : S ^ 2 = (F : PowerSeries ℚ))\n (hrational : ∃ P Q : Polynomial ℚ, Q ≠ 0 ∧\n (Q : PowerSeries ℚ) * S = (P : PowerSeries ℚ)) :\n ∃ G : Polynomial ℚ, G ^ 2 = F := by\n obtain ⟨P, Q, hQ, hPQ⟩ := hrational\n have hpoly : P ^ 2 = F * Q ^ 2 := by\n apply Polynomial.coe_injective ℚ\n simp only [Polynomial.coe_pow, Polynomial.coe_mul]\n rw [← hPQ, mul_pow, hS]\n ring\n let A := algebraMap (Polynomial ℚ) (RatFunc ℚ)\n apply ratFunc_square_root_is_polynomial (A P / A Q) F\n rw [div_pow, div_eq_iff (pow_ne_zero 2 (RatFunc.algebraMap_ne_zero hQ))]\n simpa only [map_pow, map_mul] using congrArg A hpoly\ntheorem radial_tree_isCompact (A : Finset ℂ) (T : ℝ) :\n IsCompact (⋃ a ∈ A, (fun t : ℝ => (t : ℂ) * a) '' Set.Icc 0 T) := by\n exact A.isCompact_biUnion fun a _ =>\n isCompact_Icc.image (Complex.continuous_ofReal.mul continuous_const)\ntheorem polynomial_contracts_on_cthickening (E : Set ℂ) (hE : IsCompact E)\n (p : Polynomial ℂ) (q : ℝ) (hq : q < 1)\n (hp : ∀ z ∈ E, ‖p.eval z‖ ≤ q) :\n ∃ δ : ℝ, 0 < δ ∧ ∃ q' : ℝ, q < q' ∧ q' < 1 ∧\n ∀ z ∈ Metric.cthickening δ E, ‖p.eval z‖ ≤ q' := by\n let q' := (q + 1) / 2\n have hqq' : q < q' := by dsimp [q']; linarith\n have hq' : q' < 1 := by dsimp [q']; linarith\n have hopen : IsOpen {z : ℂ | ‖p.eval z‖ < q'} :=\n isOpen_lt p.continuous.norm continuous_const\n obtain ⟨δ, hδ, hsub⟩ := hE.exists_cthickening_subset_open hopen\n (fun z hz => lt_of_le_of_lt (hp z hz) hqq')\n exact ⟨δ, hδ, q', hqq', hq', fun z hz => (hsub hz).le⟩\nnoncomputable def parametric_polynomial_moment (a b : ℝ) (γ g : ℝ → ℂ)\n (hγ : ContinuousOn γ (Set.uIcc a b)) (hg : ContinuousOn g (Set.uIcc a b)) :\n Polynomial ℂ →ₗ[ℂ] ℂ where\n toFun P := ∫ t in a..b, g t * P.eval (γ t)\n map_add' P Q := by\n simp only [Polynomial.eval_add, mul_add]\n exact intervalIntegral.integral_add\n (hg.mul (P.continuous.comp_continuousOn hγ)).intervalIntegrable\n (hg.mul (Q.continuous.comp_continuousOn hγ)).intervalIntegrable\n map_smul' c P := by\n simp only [Polynomial.eval_smul, smul_eq_mul, RingHom.id_apply]\n simp_rw [mul_left_comm (g _) c]\n exact intervalIntegral.integral_const_mul c _\ntheorem norm_parametric_polynomial_moment_le (a b : ℝ) (γ g : ℝ → ℂ)\n (hγ : ContinuousOn γ (Set.uIcc a b)) (hg : ContinuousOn g (Set.uIcc a b))\n (P : Polynomial ℂ) (C B : ℝ) (hC : 0 ≤ C)\n (hgC : ∀ t ∈ Set.uIcc a b, ‖g t‖ ≤ C)\n (hPB : ∀ t ∈ Set.uIcc a b, ‖P.eval (γ t)‖ ≤ B) :\n ‖parametric_polynomial_moment a b γ g hγ hg P‖ ≤ C * B * |b - a| := by\n apply intervalIntegral.norm_integral_le_of_norm_le_const\n intro t ht\n rw [norm_mul]\n exact mul_le_mul (hgC t (Set.uIoc_subset_uIcc ht))\n (hPB t (Set.uIoc_subset_uIcc ht)) (norm_nonneg _) hC\ntheorem one_sub_div_mem_slitPlane (b z : ℂ) (hz : z ≠ 0)\n (hseg : z ∉ (fun t : ℝ => (t : ℂ) * b) '' Set.Icc 0 1) :\n 1 - b / z ∈ Complex.slitPlane := by\n by_contra h\n have hbad : (1 - b / z).re ≤ 0 ∧ (1 - b / z).im = 0 := by\n simpa only [Complex.mem_slitPlane_iff, not_or, not_lt, not_not] using h\n let w := b / z\n have hwre : 1 ≤ w.re := by\n dsimp [w]\n simpa only [Complex.sub_re, Complex.one_re, sub_nonpos] using hbad.1\n have hwpos : 0 < w.re := lt_of_lt_of_le zero_lt_one hwre\n have hwim : w.im = 0 := by\n simpa only [Complex.sub_im, Complex.one_im, zero_sub, neg_eq_zero] using hbad.2\n have hw : w = (w.re : ℂ) := by\n apply Complex.ext <;> simp [hwim]\n have hb : b = (w.re : ℂ) * z := by\n calc\n b = w * z := (div_mul_cancel₀ b hz).symm\n _ = (w.re : ℂ) * z := congrArg (fun v : ℂ => v * z) hw\n apply hseg\n refine ⟨w.re⁻¹, ⟨inv_nonneg.mpr hwpos.le, (inv_le_one₀ hwpos).mpr hwre⟩, ?_⟩\n change ((w.re⁻¹ : ℝ) : ℂ) * b = z\n rw [hb, Complex.ofReal_inv, ← mul_assoc,\n inv_mul_cancel₀ (Complex.ofReal_ne_zero.mpr hwpos.ne'), one_mul]\ntheorem differentiableAt_radial_sqrt (b z : ℂ) (hz : z ≠ 0)\n (hseg : z ∉ (fun t : ℝ => (t : ℂ) * b) '' Set.Icc 0 1) :\n DifferentiableAt ℂ (fun w : ℂ => Complex.sqrt (1 - b / w)) z := by\n have hg : DifferentiableAt ℂ (fun w : ℂ => 1 - b / w) z :=\n (differentiableAt_const 1).sub ((differentiableAt_const b).div differentiableAt_id hz)\n exact (Complex.differentiableAt_sqrt (one_sub_div_mem_slitPlane b z hz hseg)).comp z hg\ntheorem differentiableAt_radial_sqrt_product {ι : Type*} (B : Finset ι) (b : ι → ℂ)\n (n : ℕ) (z : ℂ)\n (hz : z ≠ 0)\n (hseg : z ∉ ⋃ i ∈ B, (fun t : ℝ => (t : ℂ) * b i) '' Set.Icc 0 1) :\n DifferentiableAt ℂ\n (fun w : ℂ => w ^ n * ∏ i ∈ B, Complex.sqrt (1 - b i / w)) z := by\n refine (differentiableAt_id.pow n).mul (DifferentiableAt.fun_finsetProd ?_)\n intro i hi\n apply differentiableAt_radial_sqrt (b i) z hz\n intro h\n exact hseg (Set.mem_iUnion₂.mpr ⟨i, hi, h⟩)\ntheorem radial_sqrt_product_sq {ι : Type*} (B : Finset ι) (b : ι → ℂ) (n : ℕ) (z : ℂ) :\n (z ^ n * ∏ i ∈ B, Complex.sqrt (1 - b i / z)) ^ 2 =\n z ^ (2 * n) * ∏ i ∈ B, (1 - b i / z) := by\n simp only [mul_pow, ← Finset.prod_pow, Complex.sqrt, Complex.cpow_ofNat_inv_pow]\n rw [← pow_mul, Nat.mul_comm n 2]\ntheorem norm_det_le_factorial_mul_products {n : ℕ} (M : Matrix (Fin n) (Fin n) ℂ)\n (u v : Fin n → ℝ)\n (hM : ∀ i j, ‖M i j‖ ≤ u i * v j) :\n ‖M.det‖ ≤ (n.factorial : ℝ) * (∏ i, u i) * ∏ i, v i := by\n classical\n rw [Matrix.det_apply']\n calc\n ‖∑ σ : Equiv.Perm (Fin n), (↑(Equiv.Perm.sign σ) : ℂ) * ∏ i, M (σ i) i‖ ≤\n ∑ σ : Equiv.Perm (Fin n),\n ‖(↑(Equiv.Perm.sign σ) : ℂ) * ∏ i, M (σ i) i‖ := norm_sum_le _ _\n _ ≤ ∑ _σ : Equiv.Perm (Fin n), (∏ i, u i) * ∏ i, v i := by\n apply Finset.sum_le_sum\n intro σ _\n have hsign : ‖(↑(Equiv.Perm.sign σ) : ℂ)‖ = 1 := by\n rcases Int.units_eq_one_or (Equiv.Perm.sign σ) with hs | hs <;> simp [hs]\n rw [norm_mul, hsign, one_mul, norm_prod]\n calc\n (∏ i, ‖M (σ i) i‖) ≤ ∏ i, u (σ i) * v i :=\n Finset.prod_le_prod₀ (fun i _ => norm_nonneg _) (fun i _ => hM (σ i) i)\n _ = (∏ i, u i) * ∏ i, v i := by\n rw [Finset.prod_mul_distrib, Equiv.prod_comp σ]\n _ = (n.factorial : ℝ) * (∏ i, u i) * ∏ i, v i := by\n simp [Fintype.card_perm, mul_assoc]\ntheorem norm_det_le_factorial_mul_weight_sq {n : ℕ} (M : Matrix (Fin n) (Fin n) ℂ)\n (C : ℝ) (u : Fin n → ℝ)\n (hM : ∀ i j, ‖M i j‖ ≤ C * u i * u j) :\n ‖M.det‖ ≤ (n.factorial : ℝ) * C ^ n * (∏ i, u i) ^ 2 := by\n have h := norm_det_le_factorial_mul_products M (fun i => C * u i) u\n hM\n simpa [Finset.prod_mul_distrib, sq, mul_assoc] using h\ntheorem polynomial_moment_det_monic_basis {n : ℕ}\n (L : Polynomial ℂ →ₗ[ℂ] ℂ) (p : Fin n → Polynomial ℂ)\n (hdeg : ∀ i, (p i).natDegree = i.val) (hmonic : ∀ i, (p i).Monic) :\n Matrix.det (fun i j : Fin n => L (p i * p j)) =\n Matrix.det (fun i j : Fin n => L (Polynomial.X ^ (i.val + j.val))) := by\n classical\n let C : Matrix (Fin n) (Fin n) ℂ := fun i j => (p j).coeff i.val\n let H : Matrix (Fin n) (Fin n) ℂ := fun i j => L (Polynomial.X ^ (i.val + j.val))\n have hC : C.det = 1 := Matrix.det_matrixOfPolynomials p hdeg hmonic\n have hexp (i : Fin n) : p i =\n ∑ k : Fin n, (p i).coeff k.val • (Polynomial.X : Polynomial ℂ) ^ k.val := by\n rw [Fin.sum_univ_eq_sum_range\n (fun k : ℕ => (p i).coeff k • (Polynomial.X : Polynomial ℂ) ^ k)]\n simpa only [Polynomial.smul_eq_C_mul] using\n (p i).as_sum_range_C_mul_X_pow' (hdeg i ▸ i.isLt)\n have hmat : (fun i j : Fin n => L (p i * p j)) = C.transpose * H * C := by\n ext i j\n calc\n L (p i * p j) =\n ∑ k : Fin n, ∑ l : Fin n,\n (p i).coeff k.val * (p j).coeff l.val *\n L (Polynomial.X ^ (k.val + l.val)) := by\n conv_lhs => rw [hexp i, hexp j]\n simp only [Finset.sum_mul, Finset.mul_sum, smul_mul_assoc, mul_smul_comm,\n map_sum, map_smul, smul_eq_mul, ← pow_add]\n rw [Finset.sum_comm]\n apply Finset.sum_congr rfl\n intro k _\n apply Finset.sum_congr rfl\n intro l _\n ring\n _ = (C.transpose * H * C) i j := by\n change _ = ∑ l : Fin n, (∑ k : Fin n,\n (p i).coeff k.val * L (Polynomial.X ^ (k.val + l.val))) * (p j).coeff l.val\n simp_rw [Finset.sum_mul]\n rw [Finset.sum_comm]\n apply Finset.sum_congr rfl\n intro k _\n apply Finset.sum_congr rfl\n intro l _\n ring\n rw [hmat, Matrix.det_mul, Matrix.det_mul, Matrix.det_transpose, hC, one_mul, mul_one]\ntheorem quotient_polynomial_basis_monic (p : Polynomial ℂ) (hp : p.Monic) (i : ℕ) :\n (Polynomial.X ^ (i % p.natDegree) * p ^ (i / p.natDegree)).Monic :=\n (Polynomial.monic_X.pow _).mul (hp.pow _)\ntheorem quotient_polynomial_basis_natDegree (p : Polynomial ℂ) (hp : p.Monic) (i : ℕ) :\n (Polynomial.X ^ (i % p.natDegree) * p ^ (i / p.natDegree)).natDegree = i := by\n rw [(Polynomial.monic_X.pow _).natDegree_mul (hp.pow _), Polynomial.natDegree_X_pow,\n hp.natDegree_pow]\n simpa only [Nat.mul_comm] using Nat.mod_add_div i p.natDegree\ntheorem norm_eval_quotient_polynomial_basis_le (p : Polynomial ℂ) (i : ℕ) (z : ℂ)\n (R q : ℝ) (hR : 0 ≤ R) (hz : ‖z‖ ≤ R) (hp : ‖p.eval z‖ ≤ q) :\n ‖(Polynomial.X ^ (i % p.natDegree) * p ^ (i / p.natDegree)).eval z‖ ≤\n R ^ (i % p.natDegree) * q ^ (i / p.natDegree) := by\n simp only [Polynomial.eval_mul, Polynomial.eval_pow, Polynomial.eval_X, norm_mul, norm_pow]\n exact mul_le_mul (pow_le_pow_left₀ (norm_nonneg _) hz _)\n (pow_le_pow_left₀ (norm_nonneg _) hp _) (pow_nonneg (norm_nonneg _) _) (pow_nonneg hR _)\ntheorem norm_moment_hankel_det_le (L : Polynomial ℂ →ₗ[ℂ] ℂ) (Γ : Set ℂ)\n (p : Polynomial ℂ) (hp : p.Monic) (M R q : ℝ)\n (hR : 0 ≤ R) (hq : 0 ≤ q)\n (hz : ∀ z ∈ Γ, ‖z‖ ≤ R) (hpΓ : ∀ z ∈ Γ, ‖p.eval z‖ ≤ q)\n (hL : ∀ (A : Polynomial ℂ) (B : ℝ), 0 ≤ B →\n (∀ z ∈ Γ, ‖A.eval z‖ ≤ B) → ‖L A‖ ≤ M * B) (n : ℕ) :\n ‖Matrix.det (fun i j : Fin n => L (Polynomial.X ^ (i.val + j.val)))‖ ≤\n (n.factorial : ℝ) * M ^ n *\n R ^ (2 * ∑ i : Fin n, i.val % p.natDegree) *\n q ^ (2 * ∑ i : Fin n, i.val / p.natDegree) := by\n classical\n let b (i : Fin n) : Polynomial ℂ :=\n Polynomial.X ^ (i.val % p.natDegree) * p ^ (i.val / p.natDegree)\n let u (i : Fin n) : ℝ := R ^ (i.val % p.natDegree) * q ^ (i.val / p.natDegree)\n have hu : ∀ i, 0 ≤ u i := fun i => mul_nonneg (pow_nonneg hR _) (pow_nonneg hq _)\n have hentry (i j : Fin n) : ‖L (b i * b j)‖ ≤ M * u i * u j := by\n calc\n ‖L (b i * b j)‖ ≤ M * (u i * u j) := by\n apply hL _ _ (mul_nonneg (hu i) (hu j))\n intro z hzΓ\n rw [Polynomial.eval_mul, norm_mul]\n exact mul_le_mul\n (norm_eval_quotient_polynomial_basis_le p i.val z R q hR (hz z hzΓ) (hpΓ z hzΓ))\n (norm_eval_quotient_polynomial_basis_le p j.val z R q hR (hz z hzΓ) (hpΓ z hzΓ))\n (norm_nonneg _) (hu i)\n _ = M * u i * u j := (mul_assoc _ _ _).symm\n have hdet := norm_det_le_factorial_mul_weight_sq\n (fun i j : Fin n => L (b i * b j)) M u hentry\n rw [polynomial_moment_det_monic_basis L b\n (fun i => quotient_polynomial_basis_natDegree p hp i.val)\n (fun i => quotient_polynomial_basis_monic p hp i.val)] at hdet\n simpa only [u, Finset.prod_mul_distrib, Finset.prod_pow_eq_pow_sum, mul_pow,\n ← pow_mul, Nat.mul_comm, mul_assoc] using hdet\ntheorem int_eq_zero_of_complex_norm_lt_one (a : ℤ) (h : ‖(a : ℂ)‖ < 1) : a = 0 := by\n rw [Complex.norm_intCast, abs_lt] at h\n have hlo : (-1 : ℤ) < a := by exact_mod_cast h.1\n have hhi : a < (1 : ℤ) := by exact_mod_cast h.2\n omega\ntheorem int_hankel_det_eq_zero_of_complex_norm_lt_one (a : ℕ → ℤ) (n : ℕ)\n (h : ‖Matrix.det (fun i j : Fin n => (a (i.val + j.val) : ℂ))‖ < 1) :\n Matrix.det (fun i j : Fin n => a (i.val + j.val)) = 0 := by\n apply int_eq_zero_of_complex_norm_lt_one\n have hc := Int.cast_det (R := ℂ)\n (show Matrix (Fin n) (Fin n) ℤ from fun i j => a (i.val + j.val))\n exact (congrArg norm hc).trans_lt h\ntheorem factorial_geometric_quotient_sum_tendsto_zero (d : ℕ) (hd : 0 < d)\n (C q : ℝ) (hC : 0 ≤ C) (hq : 0 ≤ q) (hq1 : q < 1) :\n Filter.Tendsto\n (fun n : ℕ => (n.factorial : ℝ) * C ^ n *\n q ^ (2 * ∑ i ∈ Finset.range n, i / d)) Filter.atTop (nhds 0) := by\n let r := q ^ 2\n have hr0 : 0 ≤ r := pow_nonneg hq _\n have hr1 : r < 1 := by\n dsimp [r]\n nlinarith [mul_nonneg hq (sub_nonneg.mpr hq1.le)]\n have hlim : Filter.Tendsto (fun k : ℕ => C * (d : ℝ) * ((k : ℝ) + 1) * r ^ k)\n Filter.atTop (nhds 0) := by\n have h := (tendsto_pow_const_mul_const_pow_of_lt_one 1 hr0 hr1).add\n (tendsto_pow_atTop_nhds_zero_of_lt_one hr0 hr1)\n convert h.const_mul (C * (d : ℝ)) using 1 <;> simp only [pow_one, mul_zero, add_zero]\n ext k\n ring\n obtain ⟨K, hK⟩ := Filter.eventually_atTop.mp\n (hlim.eventually (gt_mem_nhds (by norm_num : (0 : ℝ) < 1 / 2)))\n let f (n : ℕ) : ℝ := (n.factorial : ℝ) * C ^ n *\n q ^ (2 * ∑ i ∈ Finset.range n, i / d)\n have hf0 (n : ℕ) : 0 ≤ f n := by dsimp [f]; positivity\n have hrec (n : ℕ) : f (n + 1) = ((n : ℝ) + 1) * C * q ^ (2 * (n / d)) * f n := by\n dsimp [f]\n rw [Nat.factorial_succ, Nat.cast_mul, Nat.cast_add, Nat.cast_one,\n pow_succ, Finset.sum_range_succ, Nat.mul_add, pow_add]\n ring\n have hs : Summable f := by\n apply summable_of_ratio_norm_eventually_le (by norm_num : (1 / 2 : ℝ) < 1)\n apply Filter.eventually_atTop.mpr\n refine ⟨K * d, fun n hn => ?_⟩\n have hkn : K ≤ n / d := (Nat.le_div_iff_mul_le hd).mpr hn\n have hnlt : n + 1 ≤ d * (n / d + 1) := by\n have hmod := Nat.mod_lt n hd\n have hdiv := Nat.div_add_mod n d\n nlinarith\n have hnR : (n : ℝ) + 1 ≤ (d : ℝ) * ((n / d : ℕ) + 1 : ℝ) := by exact_mod_cast hnlt\n have hratio : ((n : ℝ) + 1) * C * q ^ (2 * (n / d)) ≤ 1 / 2 := by\n calc\n ((n : ℝ) + 1) * C * q ^ (2 * (n / d)) ≤\n ((d : ℝ) * ((n / d : ℕ) + 1 : ℝ)) * C * q ^ (2 * (n / d)) := by\n gcongr\n _ = C * (d : ℝ) * ((n / d : ℕ) + 1 : ℝ) * r ^ (n / d) := by\n rw [pow_mul]\n ring\n _ ≤ 1 / 2 := (hK _ hkn).le\n rw [Real.norm_eq_abs, Real.norm_eq_abs, abs_of_nonneg (hf0 _), abs_of_nonneg (hf0 _), hrec]\n exact mul_le_mul_of_nonneg_right hratio (hf0 n)\n exact hs.tendsto_atTop_zero\ntheorem integer_moment_hankel_eventually_zero (a : ℕ → ℤ)\n (L : Polynomial ℂ →ₗ[ℂ] ℂ) (Γ : Set ℂ)\n (p : Polynomial ℂ) (hp : p.Monic) (hd : 0 < p.natDegree)\n (M R q : ℝ) (hM : 0 ≤ M) (hR : 1 ≤ R) (hq : 0 ≤ q) (hq1 : q < 1)\n (hz : ∀ z ∈ Γ, ‖z‖ ≤ R) (hpΓ : ∀ z ∈ Γ, ‖p.eval z‖ ≤ q)\n (hmoment : ∀ k : ℕ, L (Polynomial.X ^ k) = (a k : ℂ))\n (hL : ∀ (A : Polynomial ℂ) (B : ℝ), 0 ≤ B →\n (∀ z ∈ Γ, ‖A.eval z‖ ≤ B) → ‖L A‖ ≤ M * B) :\n ∃ N : ℕ, ∀ n : ℕ, N ≤ n →\n Matrix.det (fun i j : Fin n => a (i.val + j.val)) = 0 := by\n have hR0 : 0 ≤ R := zero_le_one.trans hR\n -- Absorb the bounded basis remainders into the exponential factor C ^ n.\n let C := M * R ^ (2 * p.natDegree)\n have hC : 0 ≤ C := mul_nonneg hM (pow_nonneg hR0 _)\n obtain ⟨N, hN⟩ := Filter.eventually_atTop.mp\n ((factorial_geometric_quotient_sum_tendsto_zero p.natDegree hd C q hC hq hq1).eventually\n (gt_mem_nhds (by norm_num : (0 : ℝ) < 1)))\n -- An integer determinant with complex norm below one must vanish.\n refine ⟨N, fun n hn => int_hankel_det_eq_zero_of_complex_norm_lt_one a n ?_⟩\n have hdet := norm_moment_hankel_det_le L Γ p hp M R q hR0 hq hz hpΓ hL n\n simp only [hmoment] at hdet\n have hsum : (∑ i : Fin n, i.val % p.natDegree) ≤ p.natDegree * n := by\n calc\n (∑ i : Fin n, i.val % p.natDegree) ≤ ∑ _i : Fin n, p.natDegree :=\n Finset.sum_le_sum fun i _ => (Nat.mod_lt i.val hd).le\n _ = p.natDegree * n := by simp [Nat.mul_comm]\n have hrem : R ^ (2 * ∑ i : Fin n, i.val % p.natDegree) ≤\n R ^ ((2 * p.natDegree) * n) := by\n apply pow_le_pow_right₀ hR\n nlinarith\n calc\n ‖Matrix.det (fun i j : Fin n => (a (i.val + j.val) : ℂ))‖ ≤\n (n.factorial : ℝ) * M ^ n * R ^ (2 * ∑ i : Fin n, i.val % p.natDegree) *\n q ^ (2 * ∑ i : Fin n, i.val / p.natDegree) := hdet\n _ ≤ (n.factorial : ℝ) * M ^ n * R ^ ((2 * p.natDegree) * n) *\n q ^ (2 * ∑ i : Fin n, i.val / p.natDegree) := by\n gcongr\n _ = (n.factorial : ℝ) * C ^ n *\n q ^ (2 * ∑ i ∈ Finset.range n, i / p.natDegree) := by\n rw [Fin.sum_univ_eq_sum_range (fun i : ℕ => i / p.natDegree)]\n simp only [C, mul_pow, pow_mul, mul_assoc]\n _ < 1 := hN n hn\ntheorem hankel_mulVec_column_operation {ι : Type*} [Fintype ι] [DecidableEq ι]\n {r : ℕ} (M : Matrix ι ι ℚ) (j : ι) (u : Fin r → ι) (c : Fin r → ℚ) :\n M.mulVec (Pi.single j 1 - ∑ l, c l • Pi.single (u l) 1) =\n fun i => M i j - ∑ l, c l * M i (u l) := by\n classical\n ext i\n simp [Matrix.mulVec_sub, Matrix.mulVec_sum, Matrix.mulVec_smul,\n Matrix.mulVec_single, Matrix.col, Finset.sum_apply]\ntheorem hankel_residual_nonzero (a : ℕ → ℚ) (r s : ℕ) (c : Fin r → ℚ)\n (hrs : r ≤ s)\n (hdet : Matrix.det (fun i j : Fin r => a (i.val + j.val)) ≠ 0)\n (hrec : ∀ k : ℕ, k < s → a (k + r) = ∑ l : Fin r, c l * a (k + l.val))\n (hfail : a (s + r) ≠ ∑ l : Fin r, c l * a (s + l.val)) :\n Matrix.det (fun i j : Fin (s + 1) => a (i.val + j.val)) ≠ 0 := by\n classical\n let t := s - r + 1\n have htotal : r + t = s + 1 := by dsimp [t]; omega\n let e : Fin r ⊕ Fin t ≃ Fin (r + t) := finSumFinEquiv\n let idx : Fin r ⊕ Fin t → ℕ := fun i => (e i).val\n have hleft (i : Fin r) : idx (Sum.inl i) = i.val := rfl\n have hright (j : Fin t) : idx (Sum.inr j) = r + j.val := rfl\n let u : Fin r → Fin t → Fin r ⊕ Fin t :=\n fun l j => e.symm ⟨l.val + j.val, by omega⟩\n have hu (l : Fin r) (j : Fin t) : idx (u l j) = l.val + j.val := by\n simp [idx, u]\n let M : Matrix (Fin r ⊕ Fin t) (Fin r ⊕ Fin t) ℚ :=\n fun i j => a (idx i + idx j)\n let C : Matrix (Fin r ⊕ Fin t) (Fin r ⊕ Fin t) ℚ :=\n fun i j => (show (Fin r ⊕ Fin t) → ℚ from match j with\n | Sum.inl l => Pi.single (Sum.inl l) 1\n | Sum.inr j => Pi.single (Sum.inr j) 1 - ∑ l, c l • Pi.single (u l j) 1) i\n have hmul_left (i : Fin r ⊕ Fin t) (j : Fin r) :\n (M * C) i (Sum.inl j) = a (idx i + j.val) := by\n change (M.mulVec (Pi.single (Sum.inl j) 1)) i = _\n rw [Matrix.mulVec_single]\n simp only [MulOpposite.op_one, one_smul]\n rfl\n have hmul_right (i : Fin r ⊕ Fin t) (j : Fin t) :\n (M * C) i (Sum.inr j) =\n a (idx i + (r + j.val)) - ∑ l, c l * a (idx i + (l.val + j.val)) := by\n change (M.mulVec (Pi.single (Sum.inr j) 1 -\n ∑ l, c l • Pi.single (u l j) 1)) i = _\n rw [hankel_mulVec_column_operation]\n simp only [M, hright, hu]\n let b : ℕ → ℚ := fun k => a (k + r) - ∑ l, c l * a (k + l.val)\n have hbzero (k : ℕ) (hk : k < s) : b k = 0 := sub_eq_zero.mpr (hrec k hk)\n have hbne : b s ≠ 0 := sub_ne_zero.mpr hfail\n have hmul_residual (i : Fin r ⊕ Fin t) (j : Fin t) :\n (M * C) i (Sum.inr j) = b (idx i + j.val) := by\n rw [hmul_right]\n simp only [b, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm]\n let D : Matrix (Fin t) (Fin t) ℚ := fun i j => b (r + i.val + j.val)\n -- Reversing columns makes the residual block triangular with diagonal b s.\n let Drev : Matrix (Fin t) (Fin t) ℚ := D.submatrix id Fin.revPerm\n have htri : Drev.IsLowerTriangular := by\n intro i j hij\n change b (r + i.val + (Fin.rev j).val) = 0\n apply hbzero\n have hji : i.val < j.val := hij\n rw [Fin.val_rev]\n dsimp [t] at *\n omega\n have hdiag (i : Fin t) : Drev i i = b s := by\n change b (r + i.val + (Fin.rev i).val) = b s\n congr 1\n rw [Fin.val_rev]\n dsimp [t] at *\n omega\n have hdetrev : Matrix.det Drev ≠ 0 := by\n rw [Matrix.det_of_isLowerTriangular Drev htri]\n exact Finset.prod_ne_zero_iff.mpr (fun i _ => hdiag i ▸ hbne)\n have hdetD : Matrix.det D ≠ 0 := by\n intro hzero\n apply hdetrev\n change Matrix.det (D.submatrix id Fin.revPerm) = 0\n rw [Matrix.det_permute', hzero, mul_zero]\n let Hsmall : Matrix (Fin r) (Fin r) ℚ := fun i j => a (i.val + j.val)\n let L : Matrix (Fin t) (Fin r) ℚ := fun i j => a (r + i.val + j.val)\n have hblocks : M * C = Matrix.fromBlocks Hsmall 0 L D := by\n ext i j\n cases i with\n | inl i =>\n cases j with\n | inl j => exact hmul_left _ _\n | inr j =>\n rw [hmul_residual, hleft]\n apply hbzero\n have hi := i.isLt\n have hj := j.isLt\n dsimp [t] at hj\n omega\n | inr i =>\n cases j with\n | inl j => exact hmul_left _ _\n | inr j => exact hmul_residual _ _\n have hdetMC : Matrix.det (M * C) ≠ 0 := by\n rw [hblocks, Matrix.det_fromBlocks_zero₁₂ Hsmall L D]\n exact mul_ne_zero hdet hdetD\n have hdetM : Matrix.det M ≠ 0 := by\n intro hzero\n apply hdetMC\n rw [Matrix.det_mul, hzero, zero_mul]\n let H : Matrix (Fin (s + 1)) (Fin (s + 1)) ℚ := fun i j => a (i.val + j.val)\n let f : Fin r ⊕ Fin t ≃ Fin (s + 1) := e.trans (finCongr htotal)\n rwa [show M = H.submatrix f f\n from rfl, Matrix.det_submatrix_equiv_self] at hdetM\ntheorem radial_powerSeries_square_root_unique (U V : PowerSeries ℂ)\n (hU : PowerSeries.constantCoeff U = 1)\n (hV : PowerSeries.constantCoeff V = 1) (hsq : U ^ 2 = V ^ 2) : U = V := by\n rcases sq_eq_sq_iff_eq_or_eq_neg.mp hsq with h | h\n · exact h\n · have hc := congrArg PowerSeries.constantCoeff h\n simp only [map_neg, hU, hV] at hc\n norm_num at hc\nnoncomputable def radial_binomial_root {ι : Type*} (B : Finset ι) (b : ι → ℂ) :\n PowerSeries ℂ :=\n ∏ i ∈ B, PowerSeries.rescale (-b i) (PowerSeries.binomialSeries ℂ (1 / 2 : ℂ))\ntheorem radial_binomial_root_constantCoeff {ι : Type*} (B : Finset ι) (b : ι → ℂ) :\n PowerSeries.constantCoeff (radial_binomial_root B b) = 1 := by\n classical\n simp [radial_binomial_root, ← PowerSeries.coeff_zero_eq_constantCoeff_apply]\ntheorem radial_binomial_factor_sq (b : ℂ) :\n (PowerSeries.rescale (-b) (PowerSeries.binomialSeries ℂ (1 / 2 : ℂ))) ^ 2 =\n 1 - PowerSeries.C b * PowerSeries.X := by\n have hhalf : (PowerSeries.binomialSeries ℂ (1 / 2 : ℂ)) ^ 2 =\n 1 + PowerSeries.X := by\n rw [pow_two, ← PowerSeries.binomialSeries_add]\n have hh : (1 / 2 : ℂ) + 1 / 2 = (1 : ℕ) := by norm_num\n rw [hh, PowerSeries.binomialSeries_nat, pow_one]\n rw [← map_pow, hhalf, map_add, map_one, PowerSeries.rescale_X, map_neg]\n ring\ntheorem radial_binomial_root_sq {ι : Type*} (B : Finset ι) (b : ι → ℂ) :\n (radial_binomial_root B b) ^ 2 =\n ∏ i ∈ B, (1 - PowerSeries.C (b i) * PowerSeries.X) := by\n classical\n simp only [radial_binomial_root, ← Finset.prod_pow, radial_binomial_factor_sq]\ntheorem radial_formal_square_root_eq_binomial {ι : Type*} (B : Finset ι) (b : ι → ℂ)\n (S : PowerSeries ℤ) (hS₀ : PowerSeries.constantCoeff S = 1)\n (hS : (PowerSeries.map (Int.castRingHom ℂ) S) ^ 2 =\n ∏ i ∈ B, (1 - PowerSeries.C (b i) * PowerSeries.X)) :\n PowerSeries.map (Int.castRingHom ℂ) S = radial_binomial_root B b := by\n apply radial_powerSeries_square_root_unique\n · rw [← PowerSeries.coeff_zero_eq_constantCoeff_apply, PowerSeries.coeff_map,\n PowerSeries.coeff_zero_eq_constantCoeff_apply, hS₀, map_one]\n · exact radial_binomial_root_constantCoeff B b\n · exact hS.trans (radial_binomial_root_sq B b).symm\ntheorem radial_powerSeries_mul_hasSum (U V : PowerSeries ℂ) (z u v : ℂ)\n (hU : Summable (fun k : ℕ => ‖PowerSeries.coeff k U * z ^ k‖))\n (hV : Summable (fun k : ℕ => ‖PowerSeries.coeff k V * z ^ k‖))\n (hUs : HasSum (fun k : ℕ => PowerSeries.coeff k U * z ^ k) u)\n (hVs : HasSum (fun k : ℕ => PowerSeries.coeff k V * z ^ k) v) :\n Summable (fun k : ℕ => ‖PowerSeries.coeff k (U * V) * z ^ k‖) ∧\n HasSum (fun k : ℕ => PowerSeries.coeff k (U * V) * z ^ k) (u * v) := by\n have hcoeff (k : ℕ) : PowerSeries.coeff k (U * V) * z ^ k =\n ∑ ij ∈ Finset.antidiagonal k,\n (PowerSeries.coeff ij.1 U * z ^ ij.1) *\n (PowerSeries.coeff ij.2 V * z ^ ij.2) := by\n rw [PowerSeries.coeff_mul, Finset.sum_mul]\n apply Finset.sum_congr rfl\n intro ij hij\n rw [← Finset.mem_antidiagonal.mp hij, pow_add]\n ring\n have hnorm := summable_norm_sum_mul_antidiagonal_of_summable_norm hU hV\n simp_rw [← hcoeff] at hnorm\n refine ⟨hnorm, ?_⟩\n have htsum := tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm hU hV\n rw [hUs.tsum_eq, hVs.tsum_eq] at htsum\n simp_rw [← hcoeff] at htsum\n exact htsum.symm ▸ hnorm.of_norm.hasSum\ntheorem radial_binomial_factor_hasSum (b z : ℂ) (hz : ‖b‖ * ‖z‖ < 1) :\n Summable (fun k : ℕ =>\n ‖PowerSeries.coeff k\n (PowerSeries.rescale (-b) (PowerSeries.binomialSeries ℂ (1 / 2 : ℂ))) * z ^ k‖) ∧\n HasSum (fun k : ℕ => PowerSeries.coeff k\n (PowerSeries.rescale (-b) (PowerSeries.binomialSeries ℂ (1 / 2 : ℂ))) * z ^ k)\n (Complex.sqrt (1 - b * z)) := by\n have hx : -b * z ∈ Metric.eball (0 : ℂ) 1 := by\n rw [← ENNReal.ofReal_one, Metric.eball_ofReal]\n simpa [norm_mul] using hz\n have hterm (k : ℕ) :\n PowerSeries.coeff k\n (PowerSeries.rescale (-b) (PowerSeries.binomialSeries ℂ (1 / 2 : ℂ))) * z ^ k =\n binomialSeries ℂ (1 / 2 : ℂ) k (fun _ => -b * z) := by\n rw [binomialSeries, FormalMultilinearSeries.ofScalars_apply_eq]\n simp only [PowerSeries.coeff_rescale, PowerSeries.binomialSeries_coeff,\n smul_eq_mul, mul_one, mul_pow]\n ring\n have hnorm := (binomialSeries ℂ (1 / 2 : ℂ)).summable_norm_apply\n (Metric.eball_subset_eball binomialSeries_radius_ge_one hx)\n have hsum := (Complex.one_add_cpow_hasFPowerSeriesOnBall_zero (a := (1 / 2 : ℂ))).hasSum hx\n simp_rw [← hterm] at hnorm hsum\n refine ⟨hnorm, ?_⟩\n simpa [Complex.sqrt, div_eq_mul_inv, sub_eq_add_neg] using hsum\ntheorem radial_binomial_root_hasSum {ι : Type*} (B : Finset ι) (b : ι → ℂ)\n (z : ℂ) (hz : ∀ i ∈ B, ‖b i‖ * ‖z‖ < 1) :\n Summable (fun k : ℕ => ‖PowerSeries.coeff k (radial_binomial_root B b) * z ^ k‖) ∧\n HasSum (fun k : ℕ => PowerSeries.coeff k (radial_binomial_root B b) * z ^ k)\n (∏ i ∈ B, Complex.sqrt (1 - b i * z)) := by\n classical\n induction B using Finset.induction_on with\n | empty =>\n simp only [radial_binomial_root, Finset.prod_empty]\n have hzero (k : ℕ) (hk : k ≠ 0) :\n PowerSeries.coeff k (1 : PowerSeries ℂ) * z ^ k = 0 := by\n rw [PowerSeries.coeff_one, if_neg hk, zero_mul]\n have h := hasSum_single (f := fun k : ℕ =>\n PowerSeries.coeff k (1 : PowerSeries ℂ) * z ^ k) 0 hzero\n have hnorm := hasSum_single (f := fun k : ℕ =>\n ‖PowerSeries.coeff k (1 : PowerSeries ℂ) * z ^ k‖) 0\n (fun k hk => by rw [hzero k hk, norm_zero])\n exact ⟨hnorm.summable, by simpa only [PowerSeries.coeff_zero_one, pow_zero, mul_one] using h⟩\n | @insert i B hi ih =>\n have hfactor := radial_binomial_factor_hasSum (b i) z (hz i (Finset.mem_insert_self _ _))\n have hB := ih (fun j hj => hz j (Finset.mem_insert_of_mem hj))\n simpa only [radial_binomial_root, Finset.prod_insert hi] using\n radial_powerSeries_mul_hasSum\n (PowerSeries.rescale (-b i) (PowerSeries.binomialSeries ℂ (1 / 2 : ℂ)))\n (radial_binomial_root B b) z _ _ hfactor.1 hB.1 hfactor.2 hB.2\ntheorem radial_formal_square_root_hasSum {ι : Type*} (B : Finset ι) (b : ι → ℂ)\n (S : PowerSeries ℤ) (hS₀ : PowerSeries.constantCoeff S = 1)\n (hS : (PowerSeries.map (Int.castRingHom ℂ) S) ^ 2 =\n ∏ i ∈ B, (1 - PowerSeries.C (b i) * PowerSeries.X))\n (z : ℂ) (hz : ∀ i ∈ B, ‖b i‖ * ‖z‖ < 1) :\n Summable (fun k : ℕ => ‖((PowerSeries.coeff k S : ℤ) : ℂ) * z ^ k‖) ∧\n HasSum (fun k : ℕ => ((PowerSeries.coeff k S : ℤ) : ℂ) * z ^ k)\n (∏ i ∈ B, Complex.sqrt (1 - b i * z)) := by\n have h := radial_binomial_root_hasSum B b z hz\n rw [← radial_formal_square_root_eq_binomial B b S hS₀ hS] at h\n simpa only [PowerSeries.coeff_map, Int.coe_castRingHom] using h\ntheorem radial_formal_square_root_laurent_hasSum (n : ℕ) (b : Fin (2 * n) → ℂ)\n (S : PowerSeries ℤ) (hS₀ : PowerSeries.constantCoeff S = 1)\n (hS : (PowerSeries.map (Int.castRingHom ℂ) S) ^ 2 =\n ∏ i : Fin (2 * n), (1 - PowerSeries.C (b i) * PowerSeries.X))\n (z : ℂ) (hz : ∀ i, ‖b i‖ * ‖z⁻¹‖ < 1) :\n HasSum (fun k : ℕ => z ^ n * ((PowerSeries.coeff k S : ℤ) : ℂ) * (z⁻¹) ^ k)\n (z ^ n * ∏ i : Fin (2 * n), Complex.sqrt (1 - b i / z)) := by\n have h := (radial_formal_square_root_hasSum Finset.univ b S hS₀ hS z⁻¹\n (fun i _ => hz i)).2.mul_left (z ^ n)\n simpa only [mul_assoc, div_eq_mul_inv] using h\ntheorem radial_formal_square_root_hasFPowerSeriesOnBall {ι : Type*}\n (B : Finset ι) (b : ι → ℂ) (S : PowerSeries ℤ)\n (hS₀ : PowerSeries.constantCoeff S = 1)\n (hS : (PowerSeries.map (Int.castRingHom ℂ) S) ^ 2 =\n ∏ i ∈ B, (1 - PowerSeries.C (b i) * PowerSeries.X))\n (r : NNReal) (hr : 0 < r) (hb : ∀ i ∈ B, ‖b i‖ * (r : ℝ) < 1) :\n HasFPowerSeriesOnBall (fun z : ℂ => ∏ i ∈ B, Complex.sqrt (1 - b i * z))\n (FormalMultilinearSeries.ofScalars ℂ\n (fun k => ((PowerSeries.coeff k S : ℤ) : ℂ))) 0 r := by\n have hnormr : ‖((r : ℝ) : ℂ)‖ = (r : ℝ) := by\n exact_mod_cast r.norm_eq\n have hsumr := (radial_formal_square_root_hasSum B b S hS₀ hS ((r : ℝ) : ℂ)\n (fun i hi => by rw [hnormr]; exact hb i hi)).1\n simp only [norm_mul, norm_pow, hnormr] at hsumr\n refine ⟨?_, ENNReal.coe_pos.mpr hr, ?_⟩\n · exact (FormalMultilinearSeries.ofScalars ℂ\n (fun k => ((PowerSeries.coeff k S : ℤ) : ℂ))).le_radius_of_summable_norm\n (by simpa only [FormalMultilinearSeries.ofScalars_norm] using hsumr)\n · intro z hz\n have hzr : ‖z‖ < (r : ℝ) := by\n rw [← ENNReal.ofReal_coe_nnreal, Metric.eball_ofReal] at hz\n simpa only [Metric.mem_ball, dist_zero_right] using hz\n have hsumz := (radial_formal_square_root_hasSum B b S hS₀ hS z (fun i hi =>\n (mul_le_mul_of_nonneg_left hzr.le (norm_nonneg _)).trans_lt (hb i hi))).2\n simpa only [FormalMultilinearSeries.ofScalars_apply_eq, smul_eq_mul, zero_add] using hsumz\ntheorem radial_formal_square_root_circle_coeff {ι : Type*}\n (B : Finset ι) (b : ι → ℂ) (S : PowerSeries ℤ)\n (hS₀ : PowerSeries.constantCoeff S = 1)\n (hS : (PowerSeries.map (Int.castRingHom ℂ) S) ^ 2 =\n ∏ i ∈ B, (1 - PowerSeries.C (b i) * PowerSeries.X))\n (r R : NNReal) (hR : 0 < R) (hRr : R < r)\n (hb : ∀ i ∈ B, ‖b i‖ * (r : ℝ) < 1) (k : ℕ) :\n ((PowerSeries.coeff k S : ℤ) : ℂ) =\n (2 * Real.pi * Complex.I : ℂ)⁻¹ *\n circleIntegral (fun z : ℂ => z⁻¹ ^ k * z⁻¹ *\n ∏ i ∈ B, Complex.sqrt (1 - b i * z)) 0 R := by\n have hf := radial_formal_square_root_hasFPowerSeriesOnBall B b S hS₀ hS r\n (hR.trans hRr) hb\n have hsub : Metric.closedBall (0 : ℂ) (R : ℝ) ⊆ Metric.eball 0 (r : ENNReal) := by\n rw [← ENNReal.ofReal_coe_nnreal, Metric.eball_ofReal]\n exact Metric.closedBall_subset_ball (by exact_mod_cast hRr)\n have hc := (hf.differentiableOn.mono hsub).hasFPowerSeriesOnBall hR\n have heq := hf.hasFPowerSeriesAt.eq_formalMultilinearSeries hc.hasFPowerSeriesAt\n have hk := congrArg (fun p : FormalMultilinearSeries ℂ ℂ ℂ => p k (fun _ => 1)) heq\n simpa only [FormalMultilinearSeries.ofScalars_apply_eq, one_pow, smul_eq_mul,\n mul_one, cauchyPowerSeries_apply, sub_zero, one_div, mul_assoc] using hk\ntheorem radial_formal_square_root_hasFPowerSeriesAt {ι : Type*}\n (B : Finset ι) (b : ι → ℂ) (S : PowerSeries ℤ)\n (hS₀ : PowerSeries.constantCoeff S = 1)\n (hS : (PowerSeries.map (Int.castRingHom ℂ) S) ^ 2 =\n ∏ i ∈ B, (1 - PowerSeries.C (b i) * PowerSeries.X)) :\n HasFPowerSeriesAt (fun z : ℂ => ∏ i ∈ B, Complex.sqrt (1 - b i * z))\n (FormalMultilinearSeries.ofScalars ℂ\n (fun k => ((PowerSeries.coeff k S : ℤ) : ℂ))) 0 := by\n classical\n let C : ℝ := 1 + ∑ i ∈ B, ‖b i‖\n have hC : 0 < C := by\n have hsum : 0 ≤ ∑ i ∈ B, ‖b i‖ := Finset.sum_nonneg (fun i _ => norm_nonneg _)\n dsimp [C]\n linarith\n let r : NNReal := ⟨C⁻¹, inv_nonneg.mpr hC.le⟩\n have hr : 0 < r := inv_pos.mpr hC\n apply (radial_formal_square_root_hasFPowerSeriesOnBall B b S hS₀ hS r hr ?_).hasFPowerSeriesAt\n intro i hi\n change ‖b i‖ * C⁻¹ < 1\n apply (mul_inv_lt_iff₀ hC).mpr\n have hle : ‖b i‖ ≤ ∑ j ∈ B, ‖b j‖ := Finset.single_le_sum (fun j _ => norm_nonneg _) hi\n dsimp [C]\n linarith\ntheorem radial_formal_square_root_laurent_converges (n : ℕ) (b : Fin (2 * n) → ℂ)\n (S : PowerSeries ℤ) (hS₀ : PowerSeries.constantCoeff S = 1)\n (hS : (PowerSeries.map (Int.castRingHom ℂ) S) ^ 2 =\n ∏ i : Fin (2 * n), (1 - PowerSeries.C (b i) * PowerSeries.X)) :\n ∃ R : ℝ, 0 < R ∧ ∀ z : ℂ, R < ‖z‖ →\n HasSum (fun k : ℕ => z ^ n * ((PowerSeries.coeff k S : ℤ) : ℂ) * (z⁻¹) ^ k)\n (z ^ n * ∏ i : Fin (2 * n), Complex.sqrt (1 - b i / z)) := by\n classical\n let R : ℝ := 1 + ∑ i : Fin (2 * n), ‖b i‖\n have hR : 0 < R := by\n have hsum : 0 ≤ ∑ i : Fin (2 * n), ‖b i‖ := Finset.sum_nonneg (fun i _ => norm_nonneg _)\n dsimp [R]\n linarith\n refine ⟨R, hR, fun z hz => radial_formal_square_root_laurent_hasSum n b S hS₀ hS z ?_⟩\n intro i\n rw [norm_inv]\n apply (mul_inv_lt_iff₀ (hR.trans hz)).mpr\n have hle : ‖b i‖ ≤ ∑ j : Fin (2 * n), ‖b j‖ :=\n Finset.single_le_sum (fun j _ => norm_nonneg _) (Finset.mem_univ i)\n have hi : ‖b i‖ < R := by dsimp [R]; linarith\n simpa only [one_mul] using hi.trans hz\ntheorem radial_circleMap_inv (R θ : ℝ) :\n (circleMap 0 R θ)⁻¹ = circleMap 0 R⁻¹ (-θ) := by\n simp only [circleMap, zero_add, mul_inv_rev, Complex.ofReal_inv,\n Complex.ofReal_neg, neg_mul, Complex.exp_neg]\n ring\ntheorem radial_circleIntegral_inv (f : ℂ → ℂ) (R : ℝ) (hR : R ≠ 0) :\n circleIntegral (fun z : ℂ => z⁻¹ ^ 2 * f z⁻¹) 0 R⁻¹ =\n circleIntegral f 0 R := by\n let g : ℝ → ℂ := fun θ => circleMap 0 R θ * Complex.I * f (circleMap 0 R θ)\n have hpoint (θ : ℝ) :\n circleMap 0 R⁻¹ θ * Complex.I *\n ((circleMap 0 R⁻¹ θ)⁻¹ ^ 2 * f (circleMap 0 R⁻¹ θ)⁻¹) = g (-θ) := by\n have hinv : (circleMap 0 R⁻¹ θ)⁻¹ = circleMap 0 R (-θ) := by\n simpa only [inv_inv] using radial_circleMap_inv R⁻¹ θ\n have hne : circleMap 0 R⁻¹ θ ≠ 0 := circleMap_ne_center (inv_ne_zero hR)\n dsimp [g]\n rw [← hinv]\n field_simp\n have hg : Function.Periodic g (2 * Real.pi) := by\n intro θ\n simp only [g, periodic_circleMap 0 R θ]\n calc\n circleIntegral (fun z : ℂ => z⁻¹ ^ 2 * f z⁻¹) 0 R⁻¹ =\n ∫ θ in 0..2 * Real.pi, g (-θ) := by\n unfold circleIntegral\n simp only [deriv_circleMap, smul_eq_mul]\n exact intervalIntegral.integral_congr (fun θ _ => hpoint θ)\n _ = ∫ θ in -(2 * Real.pi)..0, g θ := by\n simpa only [neg_zero] using (intervalIntegral.integral_comp_neg (f := g)\n (a := 0) (b := 2 * Real.pi))\n _ = ∫ θ in 0..2 * Real.pi, g θ := by\n simpa only [neg_add_cancel, zero_add] using hg.intervalIntegral_add_eq (-(2 * Real.pi)) 0\n _ = circleIntegral f 0 R := by\n unfold circleIntegral\n simp only [deriv_circleMap, smul_eq_mul, g]\ntheorem radial_formal_square_root_laurent_circle_coeff (n : ℕ) (b : Fin (2 * n) → ℂ)\n (S : PowerSeries ℤ) (hS₀ : PowerSeries.constantCoeff S = 1)\n (hS : (PowerSeries.map (Int.castRingHom ℂ) S) ^ 2 =\n ∏ i : Fin (2 * n), (1 - PowerSeries.C (b i) * PowerSeries.X))\n (r R : NNReal) (hR : 0 < R) (hRr : R < r)\n (hb : ∀ i, ‖b i‖ * (r : ℝ) < 1) (k : ℕ) :\n ((PowerSeries.coeff (n + 1 + k) S : ℤ) : ℂ) =\n (2 * Real.pi * Complex.I : ℂ)⁻¹ *\n circleIntegral (fun z : ℂ =>\n (z ^ n * ∏ i : Fin (2 * n), Complex.sqrt (1 - b i / z)) * z ^ k) 0\n (R : ℝ)⁻¹ := by\n have hsmall := radial_formal_square_root_circle_coeff Finset.univ b S hS₀ hS r R hR hRr\n (fun i _ => hb i) (n + 1 + k)\n have hpoint (z : ℂ) : z⁻¹ ^ (n + 1 + k) * z⁻¹ *\n (∏ i : Fin (2 * n), Complex.sqrt (1 - b i * z)) =\n z⁻¹ ^ 2 * (((z⁻¹) ^ n *\n ∏ i : Fin (2 * n), Complex.sqrt (1 - b i / z⁻¹)) * (z⁻¹) ^ k) := by\n simp only [div_eq_mul_inv, inv_inv, pow_add, pow_one, pow_two]\n ring\n simp_rw [hpoint] at hsmall\n have hRi : (R : ℝ)⁻¹ ≠ 0 := inv_ne_zero (by exact_mod_cast hR.ne')\n have hchange := radial_circleIntegral_inv\n (fun z : ℂ =>\n (z ^ n * ∏ i : Fin (2 * n), Complex.sqrt (1 - b i / z)) * z ^ k) (R : ℝ)⁻¹ hRi\n simp only [inv_inv] at hchange\n exact hsmall.trans (congrArg (fun w : ℂ => (2 * Real.pi * Complex.I : ℂ)⁻¹ * w) hchange)\nnoncomputable def radial_holomorphic_form (f : ℂ → ℂ) (z : ℂ) : ℂ →L[ℂ] ℂ :=\n f z • ContinuousLinearMap.id ℂ ℂ\nnoncomputable def radial_holomorphic_form_deriv (f : ℂ → ℂ) (z : ℂ) :\n ℂ →L[ℝ] (ℂ →L[ℂ] ℂ) :=\n (((ContinuousLinearMap.id ℂ ℂ).smulRight (deriv f z)).smulRight\n (ContinuousLinearMap.id ℂ ℂ)).restrictScalars ℝ\ntheorem radial_holomorphic_form_hasFDerivAt (f : ℂ → ℂ) (z : ℂ)\n (hf : DifferentiableAt ℂ f z) :\n HasFDerivAt (radial_holomorphic_form f) (radial_holomorphic_form_deriv f z) z := by\n exact (hf.hasDerivAt.hasFDerivAt.smul_const (ContinuousLinearMap.id ℂ ℂ)).restrictScalars ℝ\ntheorem radial_holomorphic_form_deriv_symmetric (f : ℂ → ℂ) (z u v : ℂ) :\n radial_holomorphic_form_deriv f z u v = radial_holomorphic_form_deriv f z v u := by\n change (u • deriv f z) • v = (v • deriv f z) • u\n simp only [smul_eq_mul]\n ring\ntheorem radial_holomorphic_curveIntegral_homotopy {a b : ℂ}\n {γ₁ : Path a a} {γ₂ : Path b b}\n (φ : (γ₁ : ContinuousMap unitInterval ℂ).Homotopy γ₂)\n (U : Set ℂ) (hU : IsOpen U) (f : ℂ → ℂ)\n (hf : DifferentiableOn ℂ f U) (hfc : ContinuousOn f (closure U))\n (hφ : ∀ s ∈ Set.Ioo 0 1, ∀ t ∈ Set.Ioo 0 1, φ (s, t) ∈ U)\n (hclosed : (φ.evalAt 1).cast (by simp) (by simp) = φ.evalAt 0)\n (hsm : ContDiffOn ℝ 2\n (fun xy : ℝ × ℝ => Set.IccExtend zero_le_one (φ.extend xy.1) xy.2)\n (Set.Icc 0 1)) :\n curveIntegral (radial_holomorphic_form f) γ₁ =\n curveIntegral (radial_holomorphic_form f) γ₂ := by\n have h := φ.curveIntegral_add_curveIntegral_eq_of_hasFDerivWithinAt\n (ω := radial_holomorphic_form f) (dω := radial_holomorphic_form_deriv f) hφ\n (fun z hz => (radial_holomorphic_form_hasFDerivAt f z\n ((hf z hz).differentiableAt (hU.mem_nhds hz))).hasFDerivWithinAt)\n (hfc.smul continuousOn_const)\n (fun z _ u _ v _ => radial_holomorphic_form_deriv_symmetric f z u v) hsm\n have heq : curveIntegral (radial_holomorphic_form f) (φ.evalAt 1) =\n curveIntegral (radial_holomorphic_form f) (φ.evalAt 0) := by\n rw [← curveIntegral_cast (c := γ₁ 0) (d := γ₂ 0)\n (radial_holomorphic_form f) (φ.evalAt 1) (by simp) (by simp), hclosed]\n rw [heq] at h\n exact add_right_cancel h\ntheorem radial_holomorphic_curveIntegral_homotopy_of_differentiableAt {a b : ℂ}\n {γ₁ : Path a a} {γ₂ : Path b b}\n (φ : (γ₁ : ContinuousMap unitInterval ℂ).Homotopy γ₂) (f : ℂ → ℂ)\n (hf : ∀ x : unitInterval × unitInterval, DifferentiableAt ℂ f (φ x))\n (hclosed : (φ.evalAt 1).cast (by simp) (by simp) = φ.evalAt 0)\n (hsm : ContDiffOn ℝ 2\n (fun xy : ℝ × ℝ => Set.IccExtend zero_le_one (φ.extend xy.1) xy.2)\n (Set.Icc 0 1)) :\n curveIntegral (radial_holomorphic_form f) γ₁ =\n curveIntegral (radial_holomorphic_form f) γ₂ := by\n have hc : IsCompact (Set.range φ) := isCompact_range (map_continuous φ)\n have hcont : ContinuousOn (radial_holomorphic_form f) (closure (Set.range φ)) := by\n rw [hc.isClosed.closure_eq]\n rintro z ⟨x, rfl⟩\n exact (radial_holomorphic_form_hasFDerivAt f (φ x) (hf x)).continuousAt.continuousWithinAt\n have h := φ.curveIntegral_add_curveIntegral_eq_of_hasFDerivWithinAt\n (t := Set.range φ) (ω := radial_holomorphic_form f)\n (dω := radial_holomorphic_form_deriv f)\n (fun _ _ _ _ => Set.mem_range_self _)\n (fun z hz => by\n obtain ⟨x, rfl⟩ := hz\n exact (radial_holomorphic_form_hasFDerivAt f (φ x) (hf x)).hasFDerivWithinAt)\n hcont (fun z _ u _ v _ => radial_holomorphic_form_deriv_symmetric f z u v) hsm\n have heq : curveIntegral (radial_holomorphic_form f) (φ.evalAt 1) =\n curveIntegral (radial_holomorphic_form f) (φ.evalAt 0) := by\n rw [← curveIntegral_cast (c := γ₁ 0) (d := γ₂ 0)\n (radial_holomorphic_form f) (φ.evalAt 1) (by simp) (by simp), hclosed]\n rw [heq] at h\n exact add_right_cancel h\ntheorem radial_formal_square_root_hankel_eventually_zero_of_n_eq_zero\n (n : ℕ) (hn : n = 0) (b : Fin (2 * n) → ℂ) (S : PowerSeries ℤ)\n (hS₀ : PowerSeries.constantCoeff S = 1)\n (hS : (PowerSeries.map (Int.castRingHom ℂ) S) ^ 2 =\n ∏ i : Fin (2 * n), (1 - PowerSeries.C (b i) * PowerSeries.X)) :\n ∃ N : ℕ, ∀ m : ℕ, N ≤ m → Matrix.det\n (fun i j : Fin m => PowerSeries.coeff (n + 1 + i.val + j.val) S) = 0 := by\n subst n\n have hU : PowerSeries.map (Int.castRingHom ℂ) S = 1 := by\n apply radial_powerSeries_square_root_unique\n · rw [← PowerSeries.coeff_zero_eq_constantCoeff_apply, PowerSeries.coeff_map,\n PowerSeries.coeff_zero_eq_constantCoeff_apply, hS₀, map_one]\n · exact map_one _\n · simpa only [Nat.mul_zero, Finset.prod_empty, pow_one, one_pow,\n Finset.univ_eq_empty] using hS\n have hcoeff (k : ℕ) (hk : 0 < k) : PowerSeries.coeff k S = 0 := by\n have h := congrArg (PowerSeries.coeff k) hU\n simp only [PowerSeries.coeff_map, Int.coe_castRingHom, PowerSeries.coeff_one,\n if_neg hk.ne'] at h\n exact_mod_cast h\n refine ⟨1, fun m hm => ?_⟩\n have : NeZero m := ⟨by omega⟩\n have hM : (fun i j : Fin m => PowerSeries.coeff (0 + 1 + i.val + j.val) S) =\n (0 : Matrix (Fin m) (Fin m) ℤ) := by\n ext i j\n exact hcoeff _ (by omega)\n rw [hM]\n exact Matrix.det_zero\ntheorem radial_exp_abs_integrable (k ω : ℝ) (hk : 0 < k) :\n MeasureTheory.Integrable (fun x : ℝ =>\n Complex.exp ((-k * |x| : ℝ) + (ω * x : ℝ) * Complex.I)) := by\n let f : ℝ → ℂ := fun x =>\n Complex.exp ((-k * |x| : ℝ) + (ω * x : ℝ) * Complex.I)\n have hneg : ∀ x ∈ Set.Iic (0 : ℝ),\n Complex.exp (((k : ℂ) + (ω : ℂ) * Complex.I) * x) = f x := by\n intro x hx\n dsimp only [f]\n congr 1\n simp only [abs_of_nonpos (Set.mem_Iic.mp hx), Complex.ofReal_mul, Complex.ofReal_neg]\n ring\n have hpos : ∀ x ∈ Set.Ioi (0 : ℝ),\n Complex.exp (((-k : ℂ) + (ω : ℂ) * Complex.I) * x) = f x := by\n intro x hx\n dsimp only [f]\n congr 1\n simp only [abs_of_pos (Set.mem_Ioi.mp hx), Complex.ofReal_mul, Complex.ofReal_neg]\n ring\n have hi : MeasureTheory.IntegrableOn f (Set.Iic (0 : ℝ)) :=\n (integrableOn_exp_mul_complex_Iic (a := (k : ℂ) + (ω : ℂ) * Complex.I)\n (by simpa using hk) 0).congr_fun hneg measurableSet_Iic\n have ho : MeasureTheory.IntegrableOn f (Set.Ioi (0 : ℝ)) :=\n (integrableOn_exp_mul_complex_Ioi (a := (-k : ℂ) + (ω : ℂ) * Complex.I)\n (by simpa using neg_neg_of_pos hk) 0).congr_fun hpos measurableSet_Ioi\n have hu := MeasureTheory.integrableOn_union.mpr ⟨hi, ho⟩\n simpa only [Set.Iic_union_Ioi, MeasureTheory.integrableOn_univ] using hu\ntheorem radial_exp_abs_integral (k ω : ℝ) (hk : 0 < k) :\n (∫ x : ℝ, Complex.exp ((-k * |x| : ℝ) + (ω * x : ℝ) * Complex.I)) =\n (2 * k : ℂ) / ((k ^ 2 + ω ^ 2 : ℝ) : ℂ) := by\n let f : ℝ → ℂ := fun x =>\n Complex.exp ((-k * |x| : ℝ) + (ω * x : ℝ) * Complex.I)\n have hi : (∫ x : ℝ in Set.Iic 0, f x) =\n 1 / ((k : ℂ) + (ω : ℂ) * Complex.I) := by\n calc\n _ = ∫ x : ℝ in Set.Iic 0,\n Complex.exp (((k : ℂ) + (ω : ℂ) * Complex.I) * x) := by\n apply MeasureTheory.setIntegral_congr_fun measurableSet_Iic\n intro x hx\n dsimp only [f]\n congr 1\n simp only [abs_of_nonpos (Set.mem_Iic.mp hx), Complex.ofReal_mul, Complex.ofReal_neg]\n ring\n _ = _ := by rw [integral_exp_mul_complex_Iic (by simpa using hk)]; simp\n have ho : (∫ x : ℝ in Set.Ioi 0, f x) =\n -1 / ((-k : ℂ) + (ω : ℂ) * Complex.I) := by\n calc\n _ = ∫ x : ℝ in Set.Ioi 0,\n Complex.exp (((-k : ℂ) + (ω : ℂ) * Complex.I) * x) := by\n apply MeasureTheory.setIntegral_congr_fun measurableSet_Ioi\n intro x hx\n dsimp only [f]\n congr 1\n simp only [abs_of_pos (Set.mem_Ioi.mp hx), Complex.ofReal_mul, Complex.ofReal_neg]\n ring\n _ = _ := by\n rw [integral_exp_mul_complex_Ioi (by simpa using neg_neg_of_pos hk)]; simp\n have hsplit : (∫ x : ℝ in Set.Iic 0, f x) + (∫ x : ℝ in Set.Ioi 0, f x) =\n ∫ x : ℝ, f x := by\n simpa only [Set.compl_Iic] using\n MeasureTheory.integral_add_compl (s := Set.Iic (0 : ℝ)) measurableSet_Iic\n (radial_exp_abs_integrable k ω hk)\n change (∫ x : ℝ, f x) = _\n rw [← hsplit, hi, ho]\n have hp : (k : ℂ) + (ω : ℂ) * Complex.I ≠ 0 := by\n intro h\n have := congrArg Complex.re h\n simp at this\n exact hk.ne' this\n have hm : (-k : ℂ) + (ω : ℂ) * Complex.I ≠ 0 := by\n intro h\n have := congrArg Complex.re h\n simp at this\n exact hk.ne' this\n have hd : ((k ^ 2 + ω ^ 2 : ℝ) : ℂ) ≠ 0 :=\n Complex.ofReal_ne_zero.mpr (ne_of_gt (by positivity))\n have hd' : (k : ℂ) ^ 2 + (ω : ℂ) ^ 2 ≠ 0 := by\n simpa only [Complex.ofReal_add, Complex.ofReal_pow] using hd\n simp only [Complex.ofReal_add, Complex.ofReal_pow]\n field_simp [hp, hm, hd']\n ring_nf\n simp [Complex.I_sq]\ntheorem radial_exp_abs_fourier (k : ℝ) (hk : 0 < k) (v : ℝ) :\n FourierTransform.fourier (fun x : ℝ => Complex.exp (-k * |x| : ℝ)) v =\n (2 * k : ℂ) / ((k ^ 2 + (2 * Real.pi * v) ^ 2 : ℝ) : ℂ) := by\n rw [Real.fourier_real_eq_integral_exp_smul]\n simp only [smul_eq_mul, ← Complex.exp_add]\n convert radial_exp_abs_integral k (-2 * Real.pi * v) hk using 1\n · congr 1\n ext x\n congr 1\n push_cast\n ring\n · congr 2\n ring\ntheorem radial_cauchy_kernel_integrable (k : ℝ) (hk : 0 < k) :\n MeasureTheory.Integrable (fun v : ℝ =>\n (2 * k : ℂ) / ((k ^ 2 + (2 * Real.pi * v) ^ 2 : ℝ) : ℂ)) := by\n have hc : 2 * Real.pi / k ≠ 0 := by positivity\n have hbase := (MeasureTheory.integrable_comp_mul_left_iff\n (fun x : ℝ => (1 + x ^ 2)⁻¹) hc).mpr integrable_inv_one_add_sq\n have hcomplex := (hbase.ofReal (𝕜 := ℂ)).const_mul ((2 / k : ℝ) : ℂ)\n convert hcomplex using 1\n ext v\n push_cast\n have hk' : (k : ℂ) ≠ 0 := Complex.ofReal_ne_zero.mpr hk.ne'\n have hd : (k : ℂ) ^ 2 + (2 * (Real.pi : ℂ) * (v : ℂ)) ^ 2 ≠ 0 := by\n exact_mod_cast (ne_of_gt (show 0 < k ^ 2 + (2 * Real.pi * v) ^ 2 by positivity))\n have hden : 1 + (2 * (Real.pi : ℂ) / (k : ℂ) * (v : ℂ)) ^ 2 ≠ 0 := by\n exact_mod_cast (ne_of_gt (show 0 < 1 + (2 * Real.pi / k * v) ^ 2 by positivity))\n field_simp [hk', hd, hden]\n ring_nf\n rfl\ntheorem radial_exp_abs_fourier_inverse (k : ℝ) (hk : 0 < k) (x : ℝ) :\n (∫ v : ℝ, Complex.exp ((2 * Real.pi * v * x : ℝ) * Complex.I) *\n ((2 * k : ℂ) / ((k ^ 2 + (2 * Real.pi * v) ^ 2 : ℝ) : ℂ))) =\n Complex.exp (-k * |x| : ℝ) := by\n let f : ℝ → ℂ := fun t => Complex.exp (-k * |t| : ℝ)\n have hcont : Continuous f := by fun_prop\n have hf : MeasureTheory.Integrable f := by\n simpa only [mul_zero, Complex.ofReal_zero, zero_mul, add_zero] using\n radial_exp_abs_integrable k 0 hk\n have hFT : FourierTransform.fourier f = fun v : ℝ =>\n (2 * k : ℂ) / ((k ^ 2 + (2 * Real.pi * v) ^ 2 : ℝ) : ℂ) := by\n funext v\n exact radial_exp_abs_fourier k hk v\n have hinv := congrFun\n (hcont.fourierInv_fourier_eq hf (hFT ▸ radial_cauchy_kernel_integrable k hk)) x\n rw [hFT, Real.fourierInv_eq_fourier_neg, Real.fourier_real_eq_integral_exp_smul] at hinv\n simpa only [f, mul_neg, neg_mul, neg_neg, smul_eq_mul] using hinv\ntheorem radial_cauchy_kernel_inverse (k : ℝ) (hk : 0 < k) (x : ℝ) :\n (∫ v : ℝ, Complex.exp ((v * x : ℝ) * Complex.I) /\n ((k ^ 2 + v ^ 2 : ℝ) : ℂ)) =\n ((Real.pi / k : ℝ) : ℂ) * Complex.exp (-k * |x| : ℝ) := by\n let g : ℝ → ℂ := fun v =>\n Complex.exp ((v * x : ℝ) * Complex.I) / ((k ^ 2 + v ^ 2 : ℝ) : ℂ)\n have hinv := radial_exp_abs_fourier_inverse k hk x\n have hscaled : (∫ v : ℝ, Complex.exp ((2 * Real.pi * v * x : ℝ) * Complex.I) *\n ((2 * k : ℂ) / ((k ^ 2 + (2 * Real.pi * v) ^ 2 : ℝ) : ℂ))) =\n (2 * k : ℂ) * ∫ v : ℝ, g (2 * Real.pi * v) := by\n rw [← MeasureTheory.integral_const_mul]\n congr 1\n ext v\n dsimp only [g]\n ring\n rw [hscaled, MeasureTheory.Measure.integral_comp_mul_left,\n abs_of_pos (inv_pos.mpr (mul_pos (by norm_num) Real.pi_pos)),\n Complex.real_smul] at hinv\n change (∫ v : ℝ, g v) = _\n have hk' : (k : ℂ) ≠ 0 := Complex.ofReal_ne_zero.mpr hk.ne'\n have hπ : (Real.pi : ℂ) ≠ 0 := Complex.ofReal_ne_zero.mpr Real.pi_ne_zero\n have hc : (2 * k : ℂ) * ((2 * Real.pi : ℝ)⁻¹ : ℝ) =\n ((Real.pi / k : ℝ) : ℂ)⁻¹ := by\n push_cast\n field_simp\n rw [← mul_assoc, hc] at hinv\n calc\n _ = ((Real.pi / k : ℝ) : ℂ) *\n (((Real.pi / k : ℝ) : ℂ)⁻¹ * ∫ v : ℝ, g v) := by\n rw [← mul_assoc, mul_inv_cancel₀ (by exact_mod_cast (div_ne_zero Real.pi_ne_zero hk.ne')),\n one_mul]\n _ = _ := by rw [hinv]\ntheorem radial_cauchy_kernel_integrable_unscaled (k : ℝ) (hk : 0 < k) :\n MeasureTheory.Integrable (fun v : ℝ => (1 : ℂ) / ((k ^ 2 + v ^ 2 : ℝ) : ℂ)) := by\n have hc : (2 * Real.pi)⁻¹ ≠ 0 := by positivity\n have h := (MeasureTheory.integrable_comp_mul_left_iff\n (fun v : ℝ => (2 * k : ℂ) / ((k ^ 2 + (2 * Real.pi * v) ^ 2 : ℝ) : ℂ))\n hc).mpr (radial_cauchy_kernel_integrable k hk)\n have hmul : ∀ v : ℝ, 2 * Real.pi * ((2 * Real.pi)⁻¹ * v) = v := by\n intro v\n rw [← mul_assoc, mul_inv_cancel₀ (by positivity : 2 * Real.pi ≠ 0), one_mul]\n have hi : MeasureTheory.Integrable (fun v : ℝ =>\n (2 * k : ℂ) / ((k ^ 2 + v ^ 2 : ℝ) : ℂ)) := by\n simpa only [hmul] using h\n convert hi.const_mul ((2 * k : ℂ)⁻¹) using 1\n ext v\n rw [div_eq_mul_inv, div_eq_mul_inv, ← mul_assoc,\n inv_mul_cancel₀ (by exact_mod_cast (ne_of_gt (show 0 < 2 * k by positivity))), one_mul]\ntheorem radial_cauchy_kernel_phase_integrable (k x : ℝ) (hk : 0 < k) :\n MeasureTheory.Integrable (fun v : ℝ =>\n Complex.exp ((v * x : ℝ) * Complex.I) / ((k ^ 2 + v ^ 2 : ℝ) : ℂ)) := by\n have hp : Continuous (fun v : ℝ => Complex.exp ((v * x : ℝ) * Complex.I)) := by\n fun_prop\n have h := (radial_cauchy_kernel_integrable_unscaled k hk).bdd_mul\n hp.aestronglyMeasurable (c := 1) (by\n filter_upwards with v\n simp [Complex.norm_exp])\n simpa only [div_eq_mul_inv, one_mul] using h\ntheorem radial_curveIntegral_ofLine (γ : ℝ → ℂ) (hγ : ContDiff ℝ 1 γ)\n (hloop : γ 1 = γ 0) (f : ℂ → ℂ) :\n curveIntegral (radial_holomorphic_form f)\n (Path.ofLine hγ.continuous.continuousOn rfl hloop) =\n ∫ t in (0 : ℝ)..1, f (γ t) * deriv γ t := by\n let γp : Path (γ 0) (γ 0) := Path.ofLine hγ.continuous.continuousOn rfl hloop\n have hext (t : ℝ) (ht : t ∈ Set.Icc (0 : ℝ) 1) : γp.extend t = γ t := by\n rw [Path.extend_apply γp ht]\n rfl\n rw [curveIntegral_def]\n apply intervalIntegral.integral_congr\n intro t ht\n have htI : t ∈ Set.Icc (0 : ℝ) 1 := by simpa only [Set.uIcc_of_le zero_le_one] using ht\n have hderiv : derivWithin γp.extend (Set.Icc (0 : ℝ) 1) t = deriv γ t := by\n apply HasDerivWithinAt.derivWithin\n (((hγ.differentiable (by norm_num) t).hasDerivAt.hasDerivWithinAt).congr_of_mem hext htI)\n exact (uniqueDiffOn_Icc zero_lt_one) t htI\n rw [curveIntegralFun_def]\n change radial_holomorphic_form f (γp.extend t)\n (derivWithin γp.extend (Set.Icc (0 : ℝ) 1) t) = _\n rw [hext t htI, hderiv]\n rfl\ntheorem radial_parametric_integral_homotopy (H : ℝ × ℝ → ℂ)\n (hH : ContDiff ℝ 2 H) (hloop : ∀ s : ℝ, H (s, 1) = H (s, 0))\n (f : ℂ → ℂ)\n (hf : ∀ x ∈ Set.Icc (0 : ℝ × ℝ) 1, DifferentiableAt ℂ f (H x)) :\n (∫ t in (0 : ℝ)..1, f (H (0, t)) * deriv (fun u : ℝ => H (0, u)) t) =\n ∫ t in (0 : ℝ)..1, f (H (1, t)) * deriv (fun u : ℝ => H (1, u)) t := by\n have hslice (s : ℝ) : ContDiff ℝ 1 (fun t : ℝ => H (s, t)) :=\n (hH.of_le (by norm_num)).comp (contDiff_const.prodMk contDiff_id)\n let γ₀ : Path (H (0, 0)) (H (0, 0)) :=\n Path.ofLine (hslice 0).continuous.continuousOn rfl (hloop 0)\n let γ₁ : Path (H (1, 0)) (H (1, 0)) :=\n Path.ofLine (hslice 1).continuous.continuousOn rfl (hloop 1)\n let φ : (γ₀ : ContinuousMap unitInterval ℂ).Homotopy γ₁ :=\n { toFun := fun x => H (x.1, x.2)\n continuous_toFun := hH.continuous.comp\n ((continuous_subtype_val.comp continuous_fst).prodMk\n (continuous_subtype_val.comp continuous_snd))\n map_zero_left := fun _ => rfl\n map_one_left := fun _ => rfl }\n have hext (x : ℝ × ℝ) (hx : x ∈ Set.Icc (0 : ℝ × ℝ) 1) :\n Set.IccExtend zero_le_one (φ.extend x.1) x.2 = H x := by\n have hx₁ : x.1 ∈ Set.Icc (0 : ℝ) 1 := ⟨hx.1.1, hx.2.1⟩\n have hx₂ : x.2 ∈ Set.Icc (0 : ℝ) 1 := ⟨hx.1.2, hx.2.2⟩\n rw [Set.IccExtend_of_mem zero_le_one _ hx₂,\n ContinuousMap.Homotopy.extend_apply_of_mem_I φ hx₁]\n rfl\n have hsm : ContDiffOn ℝ 2\n (fun x : ℝ × ℝ => Set.IccExtend zero_le_one (φ.extend x.1) x.2)\n (Set.Icc (0 : ℝ × ℝ) 1) :=\n hH.contDiffOn.congr hext\n have hclosed : (φ.evalAt 1).cast (by simp) (by simp) = φ.evalAt 0 := by\n ext s\n exact hloop s\n have hφ : ∀ x : unitInterval × unitInterval, DifferentiableAt ℂ f (φ x) := by\n intro x\n exact hf (x.1, x.2) ⟨⟨x.1.prop.1, x.2.prop.1⟩, ⟨x.1.prop.2, x.2.prop.2⟩⟩\n have h := radial_holomorphic_curveIntegral_homotopy_of_differentiableAt\n φ f hφ hclosed hsm\n rw [radial_curveIntegral_ofLine (fun t => H (0, t)) (hslice 0) (hloop 0),\n radial_curveIntegral_ofLine (fun t => H (1, t)) (hslice 1) (hloop 1)] at h\n exact h\nnoncomputable def radial_tent_radius (B : Finset ℂ) (hB : B.Nonempty) (C : ℝ)\n (u : ℂ) : ℝ :=\n B.sup' hB (fun a => max 0 (‖a‖ - C * dist u (a / (‖a‖ : ℂ))))\ntheorem radial_tent_radius_lipschitz (B : Finset ℂ) (hB : B.Nonempty) (C : ℝ)\n (hC : 0 ≤ C) : LipschitzWith ⟨C, hC⟩ (radial_tent_radius B hB C) := by\n let K : NNReal := ⟨C, hC⟩\n have hfactor (a : ℂ) : LipschitzWith K\n (fun u : ℂ => max 0 (‖a‖ - C * dist u (a / (‖a‖ : ℂ)))) := by\n apply LipschitzWith.iff_le_add_mul.mpr\n intro u v\n change max 0 (‖a‖ - C * dist u (a / (‖a‖ : ℂ))) ≤\n max 0 (‖a‖ - C * dist v (a / (‖a‖ : ℂ))) + C * dist u v\n apply max_le\n · exact add_nonneg (le_max_left _ _) (mul_nonneg hC dist_nonneg)\n · have ht := mul_le_mul_of_nonneg_left\n (dist_triangle v u (a / (‖a‖ : ℂ))) hC\n have hm := le_max_right 0 (‖a‖ - C * dist v (a / (‖a‖ : ℂ)))\n rw [dist_comm v u] at ht\n nlinarith\n have hsup : LipschitzWith K\n (B.sup' hB (fun a => fun u : ℂ => max 0 (‖a‖ - C * dist u (a / (‖a‖ : ℂ))))) := by\n apply Finset.sup'_induction\n · intro f hf g hg\n simpa only [Pi.sup_def, max_self] using hf.max hg\n · intro a _\n exact hfactor a\n have heq : (B.sup' hB (fun a => fun u : ℂ =>\n max 0 (‖a‖ - C * dist u (a / (‖a‖ : ℂ))))) = radial_tent_radius B hB C := by\n funext u\n exact Finset.sup'_apply hB _ u\n rw [heq] at hsup\n exact hsup\ntheorem radial_tent_radius_nonneg (B : Finset ℂ) (hB : B.Nonempty) (C : ℝ)\n (u : ℂ) : 0 ≤ radial_tent_radius B hB C u := by\n obtain ⟨a, ha⟩ := hB\n exact (le_max_left _ _).trans (Finset.le_sup' (f := fun a =>\n max 0 (‖a‖ - C * dist u (a / (‖a‖ : ℂ)))) ha)\ntheorem radial_smooth_radius_approx (B : Finset ℂ) (hB : B.Nonempty) (C : ℝ)\n (hC : 0 ≤ C) (δ : ℝ) (hδ : 0 < δ) :\n ∃ ρ : ℂ → ℝ, ContDiff ℝ 2 ρ ∧ ∀ u : ℂ,\n 0 < ρ u ∧ radial_tent_radius B hB C u + δ < ρ u ∧\n ρ u < radial_tent_radius B hB C u + 3 * δ := by\n obtain ⟨g, hg, hgf⟩ :=\n (radial_tent_radius_lipschitz B hB C hC).uniformContinuous.exists_contDiff_dist_le hδ\n refine ⟨fun u => g u + 2 * δ,\n (hg.of_le (WithTop.coe_le_coe.mpr (show (2 : ENat) ≤ ⊤ from le_top))).add contDiff_const,\n fun u => ?_⟩\n have h := hgf u\n rw [Real.dist_eq, abs_lt] at h\n have hnonneg := radial_tent_radius_nonneg B hB C u\n exact ⟨by linarith, by linarith, by linarith⟩\ntheorem radial_smooth_surrounding_radius (B : Finset ℂ) (hB : B.Nonempty)\n (ε : ℝ) (hε : 0 < ε) :\n ∃ ρ : ℂ → ℝ, ContDiff ℝ 2 ρ ∧ ∀ u : ℂ, ‖u‖ = 1 →\n 0 < ρ u ∧ (∀ a ∈ B, u = a / (‖a‖ : ℂ) → ‖a‖ < ρ u) ∧\n (ρ u : ℂ) * u ∈ Metric.cthickening ε (radial_tree_set B 1) := by\n classical\n let η : ℝ := ε / 5\n have hη : 0 < η := div_pos hε (by norm_num)\n let A : ℝ := 1 + ∑ a ∈ B, ‖a‖\n have hA : 0 < A := by\n have hs : 0 ≤ ∑ a ∈ B, ‖a‖ := Finset.sum_nonneg (fun _ _ => norm_nonneg _)\n dsimp [A]\n linarith\n have haA (a : ℂ) (ha : a ∈ B) : ‖a‖ ≤ A := by\n have hs := Finset.single_le_sum (fun a (_ : a ∈ B) => norm_nonneg a) ha\n dsimp [A]\n linarith\n let C : ℝ := A ^ 2 / η\n have hC : 0 < C := div_pos (sq_pos_of_pos hA) hη\n have hCη : C * η = A ^ 2 := div_mul_cancel₀ _ hη.ne'\n obtain ⟨ρ, hρ, happrox⟩ := radial_smooth_radius_approx B hB C hC.le η hη\n refine ⟨ρ, hρ, fun u hu => ⟨(happrox u).1, ?_, ?_⟩⟩\n · intro a ha hua\n have hle : ‖a‖ ≤ radial_tent_radius B hB C u := by\n have h := Finset.le_sup' (f := fun a =>\n max 0 (‖a‖ - C * dist u (a / (‖a‖ : ℂ)))) ha\n simpa only [radial_tent_radius, hua, dist_self, mul_zero, sub_zero,\n max_eq_right (norm_nonneg a)] using h\n exact lt_of_le_of_lt hle (by linarith [(happrox u).2.1])\n · obtain ⟨a, ha, hmax⟩ := B.exists_mem_eq_sup' hB\n (fun a => max 0 (‖a‖ - C * dist u (a / (‖a‖ : ℂ))))\n let w : ℝ := radial_tent_radius B hB C u\n have hw : w = max 0 (‖a‖ - C * dist u (a / (‖a‖ : ℂ))) := hmax\n have hw0 : 0 ≤ w := radial_tent_radius_nonneg B hB C u\n have hρw : |ρ u - w| ≤ 3 * η := by\n have h := happrox u\n change 0 < ρ u ∧ w + η < ρ u ∧ ρ u < w + 3 * η at h\n rw [abs_of_nonneg (by linarith : 0 ≤ ρ u - w)]\n linarith\n by_cases hwz : w = 0\n · obtain ⟨a₀, ha₀⟩ := hB\n have hzero : (0 : ℂ) ∈ radial_tree_set B 1 := by\n exact (radial_tree_set_mem_iff B 1 0).mpr\n ⟨a₀, ha₀, 0, le_rfl, zero_le_one, by simp⟩\n apply Metric.mem_cthickening_of_dist_le ((ρ u : ℂ) * u) 0 ε _ hzero\n rw [dist_zero_right, norm_mul, Complex.norm_real, Real.norm_eq_abs,\n abs_of_pos (happrox u).1, hu, mul_one]\n have := happrox u\n change 0 < ρ u ∧ w + η < ρ u ∧ ρ u < w + 3 * η at this\n dsimp [η] at this\n linarith\n · have hwpos : 0 < w := lt_of_le_of_ne hw0 (Ne.symm hwz)\n have hinside : 0 < ‖a‖ - C * dist u (a / (‖a‖ : ℂ)) := by\n rw [hw, lt_max_iff] at hwpos\n exact hwpos.resolve_left (lt_irrefl _)\n have hw_eq : w = ‖a‖ - C * dist u (a / (‖a‖ : ℂ)) := by\n rw [hw, max_eq_right hinside.le]\n have hdist0 : 0 ≤ C * dist u (a / (‖a‖ : ℂ)) := mul_nonneg hC.le dist_nonneg\n have hanorm : 0 < ‖a‖ := by linarith\n have hwlen : w ≤ ‖a‖ := by rw [hw_eq]; linarith\n have hwA : w ≤ A := hwlen.trans (haA a ha)\n have hCd : C * dist u (a / (‖a‖ : ℂ)) ≤ A := by linarith [haA a ha]\n have hwd : w * dist u (a / (‖a‖ : ℂ)) ≤ η := by\n apply (mul_le_mul_iff_right₀ hC).mp\n calc\n C * (w * dist u (a / (‖a‖ : ℂ))) =\n w * (C * dist u (a / (‖a‖ : ℂ))) := by ring\n _ ≤ A * A := mul_le_mul hwA hCd hdist0 hA.le\n _ = C * η := by rw [hCη]; ring\n have hy : (w : ℂ) * (a / (‖a‖ : ℂ)) ∈ radial_tree_set B 1 := by\n apply (radial_tree_set_mem_iff B 1 _).mpr\n refine ⟨a, ha, w / ‖a‖, div_nonneg hw0 hanorm.le,\n (div_le_one hanorm).mpr hwlen, ?_⟩\n rw [Complex.ofReal_div]\n ring\n apply Metric.mem_cthickening_of_dist_le ((ρ u : ℂ) * u)\n ((w : ℂ) * (a / (‖a‖ : ℂ))) ε _ hy\n rw [dist_eq_norm]\n calc\n ‖(ρ u : ℂ) * u - (w : ℂ) * (a / (‖a‖ : ℂ))‖ =\n ‖((ρ u - w : ℝ) : ℂ) * u +\n (w : ℂ) * (u - a / (‖a‖ : ℂ))‖ := by\n congr 1\n push_cast\n ring\n _ ≤ ‖((ρ u - w : ℝ) : ℂ) * u‖ +\n ‖(w : ℂ) * (u - a / (‖a‖ : ℂ))‖ := norm_add_le _ _\n _ = |ρ u - w| + w * dist u (a / (‖a‖ : ℂ)) := by\n simp only [norm_mul, Complex.norm_real, Real.norm_eq_abs, hu, mul_one,\n abs_of_nonneg hw0, dist_eq_norm]\n _ ≤ 3 * η + η := add_le_add hρw hwd\n _ ≤ ε := by dsimp [η]; linarith\ntheorem linear_recurrence_rational_series (a : ℕ → ℚ) (r : ℕ) (c : Fin r → ℚ)\n (hrec : ∀ k : ℕ, a (k + r) = ∑ l : Fin r, c l * a (k + l.val)) :\n ∃ P Q : Polynomial ℚ, Q ≠ 0 ∧\n (Q : PowerSeries ℚ) * PowerSeries.mk a = (P : PowerSeries ℚ) := by\n classical\n let Q : Polynomial ℚ := 1 - ∑ l : Fin r,\n Polynomial.C (c l) * Polynomial.X ^ (r - l.val)\n have hQ0 : Q.coeff 0 = 1 := by\n simp only [Q, Polynomial.coeff_sub, Polynomial.coeff_one, if_true,\n Polynomial.finsetSum_coeff]\n rw [sub_eq_self]\n apply Finset.sum_eq_zero\n intro l hl\n rw [Polynomial.coeff_C_mul_X_pow, if_neg]\n exact (Nat.sub_pos_of_lt l.isLt).ne\n have hQne : Q ≠ 0 := by\n intro hzero\n rw [hzero, Polynomial.coeff_zero] at hQ0\n exact zero_ne_one hQ0\n -- The recurrence cancels every coefficient from degree r onward.\n have htail : ∀ k : ℕ,\n PowerSeries.coeff (k + r) ((Q : PowerSeries ℚ) * PowerSeries.mk a) = 0 := by\n intro k\n have hQcoe : (Q : PowerSeries ℚ) = 1 - ∑ l : Fin r,\n PowerSeries.C (c l) * PowerSeries.X ^ (r - l.val) := by\n change (Polynomial.coeToPowerSeries.ringHom (R := ℚ)) Q = _\n simp only [Q, map_sub, map_one, map_sum, Polynomial.coeToPowerSeries.ringHom_apply,\n Polynomial.coe_mul, Polynomial.coe_C, Polynomial.coe_pow, Polynomial.coe_X]\n rw [hQcoe, sub_mul, one_mul, Finset.sum_mul, map_sub, map_sum,\n PowerSeries.coeff_mk, sub_eq_zero]\n rw [hrec]\n apply Finset.sum_congr rfl\n intro l hl\n rw [mul_assoc, PowerSeries.coeff_C_mul, PowerSeries.coeff_X_pow_mul',\n if_pos (by omega : r - l.val ≤ k + r), PowerSeries.coeff_mk]\n congr 2\n omega\n refine ⟨PowerSeries.trunc r ((Q : PowerSeries ℚ) * PowerSeries.mk a),\n Q, hQne, ?_⟩\n apply PowerSeries.ext\n intro k\n rw [Polynomial.coeff_coe, PowerSeries.coeff_trunc]\n split_ifs with hk\n · rfl\n · have hkr : r ≤ k := Nat.le_of_not_gt hk\n simpa [Nat.sub_add_cancel hkr] using htail (k - r)\ntheorem hankel_initial_recurrence_of_det_ne_zero (a : ℕ → ℚ) (r : ℕ)\n (hdet : Matrix.det (fun i j : Fin r => a (i.val + j.val)) ≠ 0) :\n ∃ c : Fin r → ℚ, ∀ k : ℕ, k < r →\n a (k + r) = ∑ l : Fin r, c l * a (k + l.val) := by\n classical\n let H : Matrix (Fin r) (Fin r) ℚ := fun i j => a (i.val + j.val)\n have hunit : IsUnit H :=\n (Matrix.isUnit_iff_isUnit_det H).mpr (isUnit_iff_ne_zero.mpr hdet)\n obtain ⟨c, hc⟩ := (Matrix.mulVec_surjective_iff_isUnit.mpr hunit)\n (fun i : Fin r => a (i.val + r))\n refine ⟨c, fun k hk => ?_⟩\n have hi := congrFun hc (⟨k, hk⟩ : Fin r)\n simpa only [Matrix.mulVec, dotProduct, H, mul_comm] using hi.symm\ntheorem hankel_maximal_nonzero_minor (a : ℕ → ℚ)\n (hzero : ∃ N : ℕ, ∀ n : ℕ, N ≤ n →\n Matrix.det (fun i j : Fin n => a (i.val + j.val)) = 0) :\n ∃ r : ℕ, Matrix.det (fun i j : Fin r => a (i.val + j.val)) ≠ 0 ∧\n ∀ s : ℕ, r < s → Matrix.det (fun i j : Fin s => a (i.val + j.val)) = 0 := by\n classical\n obtain ⟨N, hN⟩ := hzero\n let D := fun n : ℕ => Matrix.det (fun i j : Fin n => a (i.val + j.val))\n have hD0 : D 0 ≠ 0 := by\n have he : D 0 = 1 := Matrix.det_fin_zero\n rw [he]\n exact one_ne_zero\n have hNpos : 0 < N := by\n by_contra h\n exact hD0 (hN 0 (Nat.le_of_not_gt h))\n let B := (Finset.range N).filter (fun n => D n ≠ 0)\n have hB : B.Nonempty := ⟨0, by simp [B, hNpos, hD0]⟩\n let r := B.max' hB\n have hr : r ∈ B := B.max'_mem hB\n refine ⟨r, (Finset.mem_filter.mp hr).2, fun s hrs => ?_⟩\n by_cases hsN : N ≤ s\n · exact hN s hsN\n · by_contra hs\n have hsB : s ∈ B := Finset.mem_filter.mpr\n ⟨Finset.mem_range.mpr (Nat.lt_of_not_ge hsN), hs⟩\n exact (not_le_of_gt hrs) (B.le_max' s hsB)\ntheorem hankel_eventually_zero_rational (a : ℕ → ℚ)\n (hzero : ∃ N : ℕ, ∀ n : ℕ, N ≤ n →\n Matrix.det (fun i j : Fin n => a (i.val + j.val)) = 0) :\n ∃ P Q : Polynomial ℚ, Q ≠ 0 ∧\n (Q : PowerSeries ℚ) * PowerSeries.mk a = (P : PowerSeries ℚ) := by\n classical\n obtain ⟨r, hr, hmax⟩ := hankel_maximal_nonzero_minor a hzero\n obtain ⟨c, hc⟩ := hankel_initial_recurrence_of_det_ne_zero a r hr\n -- A first failed recurrence would force a larger nonzero leading minor.\n have hrec : ∀ k : ℕ, a (k + r) = ∑ l : Fin r, c l * a (k + l.val) := by\n by_contra h\n push Not at h\n let s := Nat.find h\n have hfail : a (s + r) ≠ ∑ l : Fin r, c l * a (s + l.val) := Nat.find_spec h\n have hrs : r ≤ s := by\n by_contra hsr\n exact hfail (hc s (Nat.lt_of_not_ge hsr))\n have hbefore : ∀ k : ℕ, k < s →\n a (k + r) = ∑ l : Fin r, c l * a (k + l.val) := by\n intro k hk\n exact not_ne_iff.mp (Nat.find_min h hk)\n have hlarge := hankel_residual_nonzero a r s c hrs hr hbefore hfail\n exact hlarge (hmax (s + 1) (by omega))\n exact linear_recurrence_rational_series a r c hrec\ntheorem shifted_hankel_eventually_zero_rational (S : PowerSeries ℚ) (d : ℕ)\n (hzero : ∃ N : ℕ, ∀ n : ℕ, N ≤ n →\n Matrix.det (fun i j : Fin n => PowerSeries.coeff (d + i.val + j.val) S) = 0) :\n ∃ P Q : Polynomial ℚ, Q ≠ 0 ∧\n (Q : PowerSeries ℚ) * S = (P : PowerSeries ℚ) := by\n classical\n let a : ℕ → ℚ := fun k => PowerSeries.coeff (k + d) S\n have hzero_a : ∃ N : ℕ, ∀ n : ℕ, N ≤ n →\n Matrix.det (fun i j : Fin n => a (i.val + j.val)) = 0 := by\n obtain ⟨N, hN⟩ := hzero\n refine ⟨N, fun n hn => ?_⟩\n simpa [a, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using hN n hn\n obtain ⟨P₀, Q, hQ, hQP⟩ := hankel_eventually_zero_rational a hzero_a\n let P : Polynomial ℚ := Polynomial.X ^ d * P₀ + Q * PowerSeries.trunc d S\n refine ⟨P, Q, hQ, ?_⟩\n calc\n (Q : PowerSeries ℚ) * S =\n (Q : PowerSeries ℚ) *\n (PowerSeries.X ^ d * PowerSeries.mk a +\n (PowerSeries.trunc d S : PowerSeries ℚ)) := by\n exact congrArg (fun T : PowerSeries ℚ => (Q : PowerSeries ℚ) * T)\n (PowerSeries.eq_X_pow_mul_shift_add_trunc d S)\n _ = PowerSeries.X ^ d * ((Q : PowerSeries ℚ) * PowerSeries.mk a) +\n (Q : PowerSeries ℚ) * (PowerSeries.trunc d S : PowerSeries ℚ) := by\n ring\n _ = PowerSeries.X ^ d * (P₀ : PowerSeries ℚ) +\n (Q : PowerSeries ℚ) * (PowerSeries.trunc d S : PowerSeries ℚ) := by\n rw [hQP]\n _ = (P : PowerSeries ℚ) := by\n simp only [P, Polynomial.coe_add, Polynomial.coe_mul, Polynomial.coe_pow,\n Polynomial.coe_X]\ntheorem integral_square_root_one_add_four (H : PowerSeries ℤ)\n (hH : PowerSeries.constantCoeff H = 0) :\n ∃ U : PowerSeries ℤ, PowerSeries.constantCoeff U = 1 ∧ U ^ 2 = 1 + 4 * H := by\n let C : PowerSeries ℤ := PowerSeries.catalanSeries.map (Nat.castRingHom ℤ)\n have hC : C ^ 2 * PowerSeries.X + 1 = C := by\n simpa only [map_add, map_mul, map_pow, map_one, PowerSeries.map_X] using\n congrArg (PowerSeries.map (Nat.castRingHom ℤ))\n PowerSeries.catalanSeries_sq_mul_X_add_one\n have hneg : PowerSeries.HasSubst (-H) :=\n PowerSeries.HasSubst.of_constantCoeff_zero' (by simp [hH])\n let D : PowerSeries ℤ := PowerSeries.substAlgHom hneg C\n have hD : D ^ 2 * (-H) + 1 = D := by\n simpa only [map_add, map_mul, map_pow, map_one, PowerSeries.substAlgHom_X] using\n congrArg (PowerSeries.substAlgHom hneg) hC\n refine ⟨1 + 2 * H * D, by simp [hH], ?_⟩\n linear_combination -4 * H * hD\ntheorem integral_square_root_mod_four (F Q : PowerSeries ℤ)\n (hF : PowerSeries.constantCoeff F = 1)\n (hQ : PowerSeries.constantCoeff Q = 0) :\n ∃ S : PowerSeries ℤ, PowerSeries.constantCoeff S = 1 ∧\n S ^ 2 = F * (F + 4 * Q) := by\n let J : PowerSeries ℤ := F.invOfUnit 1\n have hFJ : F * J = 1 := PowerSeries.mul_invOfUnit F 1 (by simpa using hF)\n have hH : PowerSeries.constantCoeff (Q * J) = 0 := by simp [hQ]\n obtain ⟨U, hU, hUsq⟩ := integral_square_root_one_add_four (Q * J) hH\n refine ⟨F * U, by simp [hF, hU], ?_⟩\n calc\n (F * U) ^ 2 = F ^ 2 * (1 + 4 * (Q * J)) := by rw [mul_pow, hUsq]\n _ = F ^ 2 + 4 * F * Q * (F * J) := by ring\n _ = F * (F + 4 * Q) := by rw [hFJ]; ring\ntheorem radial_positive_ray_avoids_tree (B : Finset ℂ) (u : ℂ) (hu : ‖u‖ = 1)\n (r : ℝ) (hr : 0 < r)\n (hout : ∀ a ∈ B, u = a / (‖a‖ : ℂ) → ‖a‖ < r) :\n (r : ℂ) * u ≠ 0 ∧ (r : ℂ) * u ∉ radial_tree_set B 1 := by\n have hnorm : ‖(r : ℂ) * u‖ = r := by\n rw [norm_mul, Complex.norm_real, Real.norm_eq_abs, abs_of_pos hr, hu, mul_one]\n refine ⟨by intro h; exact hr.ne' (by simpa [h] using hnorm.symm), ?_⟩\n intro hz\n obtain ⟨a, ha, t, ht, ht1, heq⟩ := (radial_tree_set_mem_iff B 1 _).mp hz\n have htr : t * ‖a‖ = r := by\n have h := congrArg norm heq\n simpa only [norm_mul, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg ht,\n hnorm] using h.symm\n have hna : 0 < ‖a‖ := by\n by_contra h\n have hzero : ‖a‖ = 0 := le_antisymm (le_of_not_gt h) (norm_nonneg _)\n rw [hzero, mul_zero] at htr\n exact hr.ne htr\n have hdir : u = a / (‖a‖ : ℂ) := by\n apply (mul_left_cancel₀ (Complex.ofReal_ne_zero.mpr hr.ne'))\n rw [heq, ← htr, Complex.ofReal_mul]\n field_simp [Complex.ofReal_ne_zero.mpr hna.ne']\n have hlt := hout a ha hdir\n have hle : r ≤ ‖a‖ := by nlinarith\n exact hlt.not_ge hle\nnoncomputable def radial_unit_loop (t : ℝ) : ℂ := circleMap 0 1 (2 * Real.pi * t)\ntheorem radial_unit_loop_norm (t : ℝ) : ‖radial_unit_loop t‖ = 1 := by\n simp [radial_unit_loop, norm_circleMap_zero]\ntheorem radial_unit_loop_closed : radial_unit_loop 1 = radial_unit_loop 0 := by\n simpa [radial_unit_loop] using periodic_circleMap 0 1 0\ntheorem radial_unit_loop_smooth : ContDiff ℝ 2 radial_unit_loop := by\n unfold radial_unit_loop circleMap\n have hc : ContDiff ℝ 2 (fun t : ℝ => (t : ℂ)) := Complex.ofRealCLM.contDiff\n fun_prop\nnoncomputable def radial_radius_homotopy (ρ : ℂ → ℝ) (R : ℝ) (x : ℝ × ℝ) : ℂ :=\n (((1 - x.1) * R + x.1 * ρ (radial_unit_loop x.2) : ℝ) : ℂ) *\n radial_unit_loop x.2\ntheorem radial_radius_homotopy_smooth (ρ : ℂ → ℝ) (hρ : ContDiff ℝ 2 ρ) (R : ℝ) :\n ContDiff ℝ 2 (radial_radius_homotopy ρ R) := by\n unfold radial_radius_homotopy\n have hu : ContDiff ℝ 2 (fun x : ℝ × ℝ => radial_unit_loop x.2) :=\n radial_unit_loop_smooth.comp contDiff_snd\n have hr : ContDiff ℝ 2 (fun x : ℝ × ℝ =>\n (1 - x.1) * R + x.1 * ρ (radial_unit_loop x.2)) :=\n ((contDiff_const.sub contDiff_fst).mul contDiff_const).add\n (contDiff_fst.mul (hρ.comp hu))\n exact (Complex.ofRealCLM.contDiff.comp hr).mul hu\ntheorem radial_radius_homotopy_closed (ρ : ℂ → ℝ) (R s : ℝ) :\n radial_radius_homotopy ρ R (s, 1) = radial_radius_homotopy ρ R (s, 0) := by\n simp only [radial_radius_homotopy, radial_unit_loop_closed]\ntheorem radial_radius_homotopy_avoids (B : Finset ℂ) (ρ : ℂ → ℝ) (R : ℝ)\n (hR : 0 < R) (hbR : ∀ a ∈ B, ‖a‖ < R)\n (hρ : ∀ u : ℂ, ‖u‖ = 1 → 0 < ρ u ∧\n ∀ a ∈ B, u = a / (‖a‖ : ℂ) → ‖a‖ < ρ u)\n (x : ℝ × ℝ) (hx : x ∈ Set.Icc (0 : ℝ × ℝ) 1) :\n radial_radius_homotopy ρ R x ≠ 0 ∧\n radial_radius_homotopy ρ R x ∉ radial_tree_set B 1 := by\n have hs : 0 ≤ x.1 ∧ x.1 ≤ 1 := ⟨hx.1.1, hx.2.1⟩\n have hu := radial_unit_loop_norm x.2\n have hp := hρ _ hu\n apply radial_positive_ray_avoids_tree B _ hu\n · by_cases h : x.1 = 0\n · simpa [h] using hR\n · have ha := mul_nonneg (sub_nonneg.mpr hs.2) hR.le\n have hb := mul_pos (lt_of_le_of_ne hs.1 (Ne.symm h)) hp.1\n linarith\n · intro a ha hdir\n have h₁ := hbR a ha\n have h₂ := hp.2 a ha hdir\n by_cases h : x.1 = 0\n · simpa [h] using h₁\n · have hstrict := mul_pos (lt_of_le_of_ne hs.1 (Ne.symm h)) (sub_pos.mpr h₂)\n have hweak := mul_nonneg (sub_nonneg.mpr hs.2) (sub_nonneg.mpr h₁.le)\n nlinarith\ntheorem radial_circle_integral_unit_parameter (R : ℝ) (f : ℂ → ℂ) :\n (∫ t in (0 : ℝ)..1, f ((R : ℂ) * radial_unit_loop t) *\n deriv (fun u : ℝ => (R : ℂ) * radial_unit_loop u) t) =\n circleIntegral f 0 R := by\n have heq : (fun u : ℝ => (R : ℂ) * radial_unit_loop u) =\n fun u : ℝ => circleMap 0 R (2 * Real.pi * u) := by\n ext u\n simp [radial_unit_loop, circleMap]\n have heqpoint (t : ℝ) := congrFun heq t\n rw [heq]\n have hd (t : ℝ) : deriv (fun u : ℝ => circleMap 0 R (2 * Real.pi * u)) t =\n (2 * Real.pi) • deriv (circleMap 0 R) (2 * Real.pi * t) := by\n have hinner : HasDerivAt (fun u : ℝ => 2 * Real.pi * u) (2 * Real.pi) t := by\n simpa only [mul_one, id_eq] using! (hasDerivAt_id t).const_mul (2 * Real.pi)\n simpa only [deriv_circleMap, Function.comp_def] using\n ((hasDerivAt_circleMap 0 R (2 * Real.pi * t)).scomp t\n hinner).deriv\n simp_rw [heqpoint, hd]\n calc\n _ = ∫ t in (0 : ℝ)..1, (2 * Real.pi) •\n (deriv (circleMap 0 R) (2 * Real.pi * t) *\n f (circleMap 0 R (2 * Real.pi * t))) := by\n apply intervalIntegral.integral_congr\n intro t ht\n simp only [Complex.real_smul]\n ring\n _ = _ := by\n rw [intervalIntegral.integral_smul]\n simpa only [mul_zero, mul_one, circleIntegral, smul_eq_mul] using!\n (intervalIntegral.smul_integral_comp_mul_left\n (f := fun θ : ℝ => deriv (circleMap 0 R) θ * f (circleMap 0 R θ))\n (a := 0) (b := 1) (2 * Real.pi))\nnoncomputable def radial_radius_loop (ρ : ℂ → ℝ) (t : ℝ) : ℂ :=\n (ρ (radial_unit_loop t) : ℂ) * radial_unit_loop t\ntheorem radial_radius_loop_smooth (ρ : ℂ → ℝ) (hρ : ContDiff ℝ 2 ρ) :\n ContDiff ℝ 2 (radial_radius_loop ρ) := by\n exact (Complex.ofRealCLM.contDiff.comp (hρ.comp radial_unit_loop_smooth)).mul\n radial_unit_loop_smooth\ntheorem radial_radius_loop_integral_eq_circle (B : Finset ℂ) (ρ : ℂ → ℝ)\n (hρsm : ContDiff ℝ 2 ρ)\n (hρ : ∀ u : ℂ, ‖u‖ = 1 → 0 < ρ u ∧\n ∀ a ∈ B, u = a / (‖a‖ : ℂ) → ‖a‖ < ρ u)\n (R : ℝ) (hR : 0 < R) (hbR : ∀ a ∈ B, ‖a‖ < R)\n (f : ℂ → ℂ)\n (hf : ∀ z : ℂ, z ≠ 0 → z ∉ radial_tree_set B 1 → DifferentiableAt ℂ f z) :\n (∫ t in (0 : ℝ)..1, f (radial_radius_loop ρ t) * deriv (radial_radius_loop ρ) t) =\n circleIntegral f 0 R := by\n have h := radial_parametric_integral_homotopy (radial_radius_homotopy ρ R)\n (radial_radius_homotopy_smooth ρ hρsm R) (radial_radius_homotopy_closed ρ R) f\n (fun x hx => by\n have havoid := radial_radius_homotopy_avoids B ρ R hR hbR hρ x hx\n exact hf _ havoid.1 havoid.2)\n have hzero : (fun t : ℝ => radial_radius_homotopy ρ R (0, t)) =\n fun t : ℝ => (R : ℂ) * radial_unit_loop t := by\n funext t\n simp [radial_radius_homotopy]\n have hone : (fun t : ℝ => radial_radius_homotopy ρ R (1, t)) =\n radial_radius_loop ρ := by\n funext t\n simp [radial_radius_homotopy, radial_radius_loop]\n simp_rw [hzero, hone] at h\n have hzero' (t : ℝ) := congrFun hzero t\n have hone' (t : ℝ) := congrFun hone t\n simp_rw [hzero', hone'] at h\n exact h.symm.trans (radial_circle_integral_unit_parameter R f)\ntheorem radial_formal_square_root_large_circle (n : ℕ) (b : Fin (2 * n) → ℂ)\n (S : PowerSeries ℤ) (hS₀ : PowerSeries.constantCoeff S = 1)\n (hS : (PowerSeries.map (Int.castRingHom ℂ) S) ^ 2 =\n ∏ i : Fin (2 * n), (1 - PowerSeries.C (b i) * PowerSeries.X)) :\n ∃ R : ℝ, 0 < R ∧ (∀ i, ‖b i‖ < R) ∧ ∀ k : ℕ,\n ((PowerSeries.coeff (n + 1 + k) S : ℤ) : ℂ) =\n (2 * Real.pi * Complex.I : ℂ)⁻¹ *\n circleIntegral (fun z : ℂ =>\n (z ^ n * ∏ i : Fin (2 * n), Complex.sqrt (1 - b i / z)) * z ^ k) 0 R := by\n classical\n let C : ℝ := 1 + ∑ i : Fin (2 * n), ‖b i‖\n have hC : 0 < C := by\n have hs : 0 ≤ ∑ i : Fin (2 * n), ‖b i‖ :=\n Finset.sum_nonneg (fun i _ => norm_nonneg _)\n dsimp [C]\n linarith\n let r : NNReal := ⟨C⁻¹, (inv_pos.mpr hC).le⟩\n have hr : 0 < r := inv_pos.mpr hC\n have hb (i : Fin (2 * n)) : ‖b i‖ * (r : ℝ) < 1 := by\n apply (mul_inv_lt_iff₀ hC).mpr\n have hs : ‖b i‖ ≤ ∑ j : Fin (2 * n), ‖b j‖ :=\n Finset.single_le_sum (fun j _ => norm_nonneg _) (Finset.mem_univ i)\n dsimp [C]\n linarith\n let s : NNReal := r / 2\n have hs : 0 < s := div_pos hr (by norm_num)\n have hsr : s < r := by dsimp [s]; exact half_lt_self hr\n have hsR : 0 < (s : ℝ) := by exact_mod_cast hs\n refine ⟨(s : ℝ)⁻¹, inv_pos.mpr hsR, ?_, ?_⟩\n · intro i\n rw [inv_eq_one_div]\n apply (lt_div_iff₀ hsR).mpr\n have hle : (s : ℝ) ≤ (r : ℝ) := by exact_mod_cast hsr.le\n exact (mul_le_mul_of_nonneg_left hle (norm_nonneg _)).trans_lt (hb i)\n · exact radial_formal_square_root_laurent_circle_coeff n b S hS₀ hS r s hs hsr hb\ntheorem radial_tree_image_univ {ι : Type*} [Fintype ι] (b : ι → ℂ) :\n radial_tree_set (Finset.univ.image b) 1 =\n ⋃ i ∈ (Finset.univ : Finset ι),\n (fun t : ℝ => (t : ℂ) * b i) '' Set.Icc 0 1 := by\n classical\n ext z\n simp only [radial_tree_set, Set.mem_iUnion, Finset.mem_image, Finset.mem_univ,\n true_and, exists_prop]\n constructor\n · rintro ⟨a, ⟨i, rfl⟩, h⟩\n exact ⟨i, h⟩\n · rintro ⟨i, h⟩\n exact ⟨b i, ⟨i, rfl⟩, h⟩\ntheorem radial_formal_square_root_contour_moments (n : ℕ) (b : Fin (2 * n) → ℂ)\n (S : PowerSeries ℤ) (hS₀ : PowerSeries.constantCoeff S = 1)\n (hS : (PowerSeries.map (Int.castRingHom ℂ) S) ^ 2 =\n ∏ i : Fin (2 * n), (1 - PowerSeries.C (b i) * PowerSeries.X))\n (ρ : ℂ → ℝ) (hρsm : ContDiff ℝ 2 ρ)\n (hρ : ∀ u : ℂ, ‖u‖ = 1 → 0 < ρ u ∧\n ∀ i : Fin (2 * n), u = b i / (‖b i‖ : ℂ) → ‖b i‖ < ρ u) :\n ∀ k : ℕ, ((PowerSeries.coeff (n + 1 + k) S : ℤ) : ℂ) =\n (2 * Real.pi * Complex.I : ℂ)⁻¹ *\n ∫ t in (0 : ℝ)..1,\n ((radial_radius_loop ρ t) ^ n *\n ∏ i : Fin (2 * n), Complex.sqrt (1 - b i / radial_radius_loop ρ t)) *\n (radial_radius_loop ρ t) ^ k * deriv (radial_radius_loop ρ) t := by\n classical\n let B := Finset.univ.image b\n obtain ⟨R, hR, hbR, hcoeff⟩ := radial_formal_square_root_large_circle n b S hS₀ hS\n have hρB : ∀ u : ℂ, ‖u‖ = 1 → 0 < ρ u ∧\n ∀ a ∈ B, u = a / (‖a‖ : ℂ) → ‖a‖ < ρ u := by\n intro u hu\n refine ⟨(hρ u hu).1, ?_⟩\n intro a ha hdir\n obtain ⟨i, hi, rfl⟩ := Finset.mem_image.mp ha\n exact (hρ u hu).2 i hdir\n intro k\n have heq := radial_radius_loop_integral_eq_circle B ρ hρsm hρB R hR\n (by intro a ha; obtain ⟨i, hi, rfl⟩ := Finset.mem_image.mp ha; exact hbR i)\n (fun z : ℂ => (z ^ n * ∏ i : Fin (2 * n), Complex.sqrt (1 - b i / z)) * z ^ k)\n (by\n intro z hz hseg\n apply DifferentiableAt.mul\n · apply differentiableAt_radial_sqrt_product Finset.univ b n z hz\n simpa only [← radial_tree_image_univ b] using hseg\n · exact differentiableAt_id.pow k)\n exact (hcoeff k).trans (congrArg (fun z : ℂ => (2 * Real.pi * Complex.I : ℂ)⁻¹ * z)\n heq.symm)\ntheorem radial_formal_square_root_hankel_eventually_zero\n (n : ℕ) (b : Fin (2 * n) → ℂ) (S : PowerSeries ℤ)\n (hS₀ : PowerSeries.constantCoeff S = 1)\n (hS : (PowerSeries.map (Int.castRingHom ℂ) S) ^ 2 =\n ∏ i : Fin (2 * n), (1 - PowerSeries.C (b i) * PowerSeries.X))\n (hcontract : ∃ p : Polynomial ℂ, p.Monic ∧ 0 < p.natDegree ∧\n ∃ q : ℝ, 0 ≤ q ∧ q < 1 ∧ ∀ i : Fin (2 * n), ∀ t : ℝ,\n 0 ≤ t → t ≤ 1 → ‖p.eval ((t : ℂ) * b i)‖ ≤ q) :\n ∃ N : ℕ, ∀ m : ℕ, N ≤ m → Matrix.det\n (fun i j : Fin m => PowerSeries.coeff (n + 1 + i.val + j.val) S) = 0 := by\n classical\n by_cases hn : n = 0\n · exact radial_formal_square_root_hankel_eventually_zero_of_n_eq_zero n hn b S hS₀ hS\n have hnpos : 0 < 2 * n := by omega\n have : NeZero (2 * n) := ⟨hnpos.ne'⟩\n let B : Finset ℂ := Finset.univ.image b\n have hB : B.Nonempty := Finset.univ_nonempty.image b\n obtain ⟨p, hp, hd, q, hq, hq1, hpseg⟩ := hcontract\n have hpB : ∀ z ∈ radial_tree_set B 1, ‖p.eval z‖ ≤ q := by\n intro z hz\n obtain ⟨a, ha, t, ht, ht1, rfl⟩ := (radial_tree_set_mem_iff B 1 z).mp hz\n obtain ⟨i, hi, rfl⟩ := Finset.mem_image.mp ha\n exact hpseg i t ht ht1\n obtain ⟨δ, hδ, q', hqq', hq'1, hpδ⟩ :=\n polynomial_contracts_on_cthickening _ (radial_tree_set_compact B 1) p q hq1 hpB\n have hq' : 0 ≤ q' := hq.trans hqq'.le\n obtain ⟨ρ, hρsm, hρ⟩ := radial_smooth_surrounding_radius B hB δ hδ\n have hρout : ∀ u : ℂ, ‖u‖ = 1 → 0 < ρ u ∧\n ∀ a ∈ B, u = a / (‖a‖ : ℂ) → ‖a‖ < ρ u :=\n fun u hu => ⟨(hρ u hu).1, (hρ u hu).2.1⟩\n let γ : ℝ → ℂ := radial_radius_loop ρ\n have hγsm : ContDiff ℝ 2 γ := radial_radius_loop_smooth ρ hρsm\n have hγavoid (t : ℝ) : γ t ≠ 0 ∧ γ t ∉ radial_tree_set B 1 :=\n radial_positive_ray_avoids_tree B _ (radial_unit_loop_norm t) _\n (hρout _ (radial_unit_loop_norm t)).1 (hρout _ (radial_unit_loop_norm t)).2\n let f : ℂ → ℂ := fun z => z ^ n *\n ∏ i : Fin (2 * n), Complex.sqrt (1 - b i / z)\n have hf : ∀ z : ℂ, z ≠ 0 → z ∉ radial_tree_set B 1 → DifferentiableAt ℂ f z := by\n intro z hz hseg\n apply differentiableAt_radial_sqrt_product Finset.univ b n z hz\n simpa only [← radial_tree_image_univ b] using hseg\n have hfγ : Continuous (fun t : ℝ => f (γ t)) := by\n apply continuous_iff_continuousAt.mpr\n intro t\n exact (hf _ (hγavoid t).1 (hγavoid t).2).continuousAt.comp hγsm.continuous.continuousAt\n let c : ℂ := (2 * Real.pi * Complex.I : ℂ)⁻¹\n let g : ℝ → ℂ := fun t => c * f (γ t) * deriv γ t\n have hg : Continuous g :=\n (continuous_const.mul hfγ).mul (hγsm.continuous_deriv (by norm_num))\n have hγI : ContinuousOn γ (Set.uIcc (0 : ℝ) 1) := hγsm.continuous.continuousOn\n have hgI : ContinuousOn g (Set.uIcc (0 : ℝ) 1) := hg.continuousOn\n let L : Polynomial ℂ →ₗ[ℂ] ℂ := parametric_polynomial_moment 0 1 γ g hγI hgI\n have hmom (k : ℕ) : L (Polynomial.X ^ k) =\n ((PowerSeries.coeff (n + 1 + k) S : ℤ) : ℂ) := by\n have hcoeff := radial_formal_square_root_contour_moments n b S hS₀ hS ρ hρsm\n (fun u hu => ⟨(hρout u hu).1,\n fun i hdir => (hρout u hu).2 (b i) (Finset.mem_image.mpr ⟨i, Finset.mem_univ i, rfl⟩) hdir⟩) k\n rw [hcoeff, ← intervalIntegral.integral_const_mul]\n apply intervalIntegral.integral_congr\n intro t ht\n simp only [Polynomial.eval_pow, Polynomial.eval_X]\n dsimp [g, γ, f, c]\n ring\n obtain ⟨M₀, hM₀⟩ := isCompact_Icc.exists_bound_of_continuousOn hg.continuousOn\n let M : ℝ := max 0 M₀\n have hM : 0 ≤ M := le_max_left _ _\n have hgM : ∀ t ∈ Set.uIcc (0 : ℝ) 1, ‖g t‖ ≤ M := by\n intro t ht\n exact (hM₀ t (by simpa using ht)).trans (le_max_right _ _)\n obtain ⟨R₀, hR₀⟩ := isCompact_Icc.exists_bound_of_continuousOn hγsm.continuous.continuousOn\n let R : ℝ := max 1 R₀\n let Γ : Set ℂ := γ '' Set.Icc 0 1\n have hzR : ∀ z ∈ Γ, ‖z‖ ≤ R := by\n rintro z ⟨t, ht, rfl⟩\n exact (hR₀ t ht).trans (le_max_right _ _)\n have hpΓ : ∀ z ∈ Γ, ‖p.eval z‖ ≤ q' := by\n rintro z ⟨t, ht, rfl⟩\n exact hpδ _ (hρ _ (radial_unit_loop_norm t)).2.2\n have hL : ∀ (A : Polynomial ℂ) (T : ℝ), 0 ≤ T →\n (∀ z ∈ Γ, ‖A.eval z‖ ≤ T) → ‖L A‖ ≤ M * T := by\n intro A T hT hAT\n have h := norm_parametric_polynomial_moment_le 0 1 γ g hγI hgI A M T hM hgM\n (fun t ht => hAT _ ⟨t, by simpa using ht, rfl⟩)\n simpa only [sub_zero, abs_one, mul_one] using h\n obtain ⟨N, hN⟩ := integer_moment_hankel_eventually_zero\n (fun k => PowerSeries.coeff (n + 1 + k) S) L Γ p hp hd M R q' hM\n (le_max_left _ _) hq' hq'1 hzR hpΓ hmom hL\n refine ⟨N, fun m hm => ?_⟩\n simpa only [Nat.add_assoc] using hN m hm\ntheorem radial_weighted_complex_sum_norm_sq_le {ι : Type*} (s : Finset ι)\n (τ : ι → ℝ) (hτ : ∀ i ∈ s, 0 ≤ τ i) (v : ι → ℂ) :\n ‖∑ i ∈ s, (τ i : ℂ) * v i‖ ^ 2 ≤\n (∑ i ∈ s, τ i) * ∑ i ∈ s, τ i * ‖v i‖ ^ 2 := by\n have hnorm : ‖∑ i ∈ s, (τ i : ℂ) * v i‖ ≤ ∑ i ∈ s, τ i * ‖v i‖ := by\n calc\n _ ≤ ∑ i ∈ s, ‖(τ i : ℂ) * v i‖ := norm_sum_le _ _\n _ = _ := Finset.sum_congr rfl (fun i hi => by\n rw [norm_mul, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg (hτ i hi)])\n have hCS := Finset.sum_sq_le_sum_mul_sum_of_sq_le_mul s\n hτ (fun i hi => mul_nonneg (hτ i hi) (sq_nonneg ‖v i‖))\n (r := fun i => τ i * ‖v i‖) (fun i hi => by nlinarith)\n exact (pow_le_pow_left₀ (norm_nonneg _) hnorm 2).trans hCS\ntheorem radial_boundary_energy_bound {ι : Type*} (s : Finset ι)\n (τ : ι → ℝ) (hτ : ∀ i ∈ s, 0 < τ i) (p d : ι → ℂ)\n (ξ : ℝ) (hξ : 0 ≤ ξ) :\n ‖(ξ : ℂ) * ∑ i ∈ s, (τ i : ℂ) * p i‖ ^ 2 ≤\n (2 * ξ * ∑ i ∈ s, τ i) *\n (ξ / 2 * ∑ i ∈ s, (τ i * ‖p i‖ ^ 2 + (τ i)⁻¹ * ‖d i‖ ^ 2)) := by\n have hCS := radial_weighted_complex_sum_norm_sq_le s τ\n (fun i hi => (hτ i hi).le) p\n have hS : 0 ≤ ∑ i ∈ s, τ i := Finset.sum_nonneg (fun i hi => (hτ i hi).le)\n have hextra : (∑ i ∈ s, τ i * ‖p i‖ ^ 2) ≤\n ∑ i ∈ s, (τ i * ‖p i‖ ^ 2 + (τ i)⁻¹ * ‖d i‖ ^ 2) := by\n apply Finset.sum_le_sum\n intro i hi\n exact le_add_of_nonneg_right (mul_nonneg (inv_nonneg.mpr (hτ i hi).le) (sq_nonneg _))\n rw [norm_mul, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg hξ, mul_pow]\n calc\n ξ ^ 2 * ‖∑ i ∈ s, (τ i : ℂ) * p i‖ ^ 2 ≤\n ξ ^ 2 * ((∑ i ∈ s, τ i) * ∑ i ∈ s, τ i * ‖p i‖ ^ 2) :=\n mul_le_mul_of_nonneg_left hCS (sq_nonneg ξ)\n _ ≤ ξ ^ 2 * ((∑ i ∈ s, τ i) *\n ∑ i ∈ s, (τ i * ‖p i‖ ^ 2 + (τ i)⁻¹ * ‖d i‖ ^ 2)) :=\n mul_le_mul_of_nonneg_left (mul_le_mul_of_nonneg_left hextra hS) (sq_nonneg ξ)\n _ = _ := by ring_nf\ntheorem radial_hasDerivAt_tanh (x : ℝ) :\n HasDerivAt Real.tanh (1 / Real.cosh x ^ 2) x := by\n have h := (Real.hasDerivAt_sinh x).div (Real.hasDerivAt_cosh x) (Real.cosh_pos x).ne'\n have hfun : (Real.sinh / Real.cosh) = Real.tanh := by\n funext y\n exact (Real.tanh_eq_sinh_div_cosh y).symm\n rw [hfun] at h\n simpa only [← pow_two, Real.cosh_sq_sub_sinh_sq] using h\ntheorem radial_tanh_concave_nonneg : ConcaveOn ℝ (Set.Ici 0) Real.tanh := by\n have hanti : AntitoneOn (deriv Real.tanh) (interior (Set.Ici 0)) := by\n intro x hx y hy hxy\n rw [(radial_hasDerivAt_tanh x).deriv, (radial_hasDerivAt_tanh y).deriv]\n apply one_div_le_one_div_of_le (sq_pos_of_pos (Real.cosh_pos x))\n apply pow_le_pow_left₀ (Real.cosh_pos x).le\n apply Real.cosh_le_cosh.mpr\n rw [abs_of_nonneg (interior_subset hx), abs_of_nonneg (interior_subset hy)]\n exact hxy\n apply hanti.concaveOn_of_deriv (convex_Ici 0)\n · exact (continuous_iff_continuousAt.mpr\n (fun x => (radial_hasDerivAt_tanh x).continuousAt)).continuousOn\n · exact fun x _ => (radial_hasDerivAt_tanh x).differentiableAt.differentiableWithinAt\ntheorem radial_tanh_sum_le {ι : Type*} (s : Finset ι) (hs : s.Nonempty)\n (x : ι → ℝ) (hx : ∀ i ∈ s, 0 ≤ x i) :\n (∑ i ∈ s, Real.tanh (x i)) ≤\n (s.card : ℝ) * Real.tanh ((∑ i ∈ s, x i) / s.card) := by\n have hn : 0 < (s.card : ℝ) := by exact_mod_cast Finset.card_pos.mpr hs\n have hJ := radial_tanh_concave_nonneg.le_map_sum\n (t := s) (w := fun _ => (1 : ℝ) / s.card) (p := x)\n (fun i _ => (div_pos zero_lt_one hn).le)\n (by simp [hn.ne']) hx\n simp only [smul_eq_mul, one_div_mul_eq_div, ← Finset.sum_div] at hJ\n exact (div_le_iff₀ hn).mp hJ |>.trans_eq (mul_comm _ _)\ntheorem radial_cyclic_gap_energy_bound {ι : Type*} (s : Finset ι) (hs : s.Nonempty)\n (δ : ι → ℝ) (hδ : ∀ i ∈ s, 0 < δ i)\n (hδsum : ∑ i ∈ s, δ i = 2 * Real.pi)\n (v : ι → ℂ) (next : ι → ι) (ξ : ℝ) (hξ : 0 < ξ) :\n ‖(ξ : ℂ) * ∑ i ∈ s, (Real.tanh (ξ * δ i / 2) : ℂ) * (v i + v (next i))‖ ^ 2 ≤\n (2 * ξ * s.card * Real.tanh (Real.pi * ξ / s.card)) *\n (ξ / 2 * ∑ i ∈ s,\n (Real.tanh (ξ * δ i / 2) * ‖v i + v (next i)‖ ^ 2 +\n (Real.tanh (ξ * δ i / 2))⁻¹ * ‖v i - v (next i)‖ ^ 2)) := by\n let τ : ι → ℝ := fun i => Real.tanh (ξ * δ i / 2)\n have hτ (i : ι) (hi : i ∈ s) : 0 < τ i := by\n dsimp only [τ]\n rw [Real.tanh_eq_sinh_div_cosh]\n exact div_pos (Real.sinh_pos_iff.mpr\n (div_pos (mul_pos hξ (hδ i hi)) (by norm_num))) (Real.cosh_pos _)\n have hsum : (∑ i ∈ s, τ i) ≤ s.card * Real.tanh (Real.pi * ξ / s.card) := by\n have hJ := radial_tanh_sum_le s hs (fun i => ξ * δ i / 2)\n (fun i hi => (div_pos (mul_pos hξ (hδ i hi)) (by norm_num)).le)\n have hmean : (∑ i ∈ s, ξ * δ i / 2) = Real.pi * ξ := by\n rw [← Finset.sum_div, ← Finset.mul_sum, hδsum]\n ring_nf\n simpa only [hmean, τ] using hJ\n have hQ : 0 ≤ ξ / 2 * ∑ i ∈ s,\n (τ i * ‖v i + v (next i)‖ ^ 2 + (τ i)⁻¹ * ‖v i - v (next i)‖ ^ 2) := by\n apply mul_nonneg (by positivity)\n apply Finset.sum_nonneg\n intro i hi\n exact add_nonneg (mul_nonneg (hτ i hi).le (sq_nonneg _))\n (mul_nonneg (inv_nonneg.mpr (hτ i hi).le) (sq_nonneg _))\n have h := radial_boundary_energy_bound s τ hτ\n (fun i => v i + v (next i)) (fun i => v i - v (next i)) ξ hξ.le\n apply h.trans\n apply mul_le_mul_of_nonneg_right _ hQ\n calc\n 2 * ξ * (∑ i ∈ s, τ i) ≤\n 2 * ξ * (s.card * Real.tanh (Real.pi * ξ / s.card)) :=\n mul_le_mul_of_nonneg_left hsum (by positivity)\n _ = _ := by ring_nf\ntheorem radial_fourier_square_expand {ι : Type*} (s : Finset ι)\n (x : ι → ℝ) (w : ι → ℂ) (v : ℝ) :\n (∑ i ∈ s, ∑ j ∈ s, star (w i) * w j *\n Complex.exp ((v * (x j - x i) : ℝ) * Complex.I)) =\n (Complex.normSq (∑ i ∈ s, w i *\n Complex.exp ((v * x i : ℝ) * Complex.I)) : ℂ) := by\n classical\n rw [Complex.normSq_eq_conj_mul_self]\n simp only [map_sum, Finset.sum_mul, Finset.mul_sum]\n conv_rhs => rw [Finset.sum_comm]\n apply Finset.sum_congr rfl\n intro i hi\n apply Finset.sum_congr rfl\n intro j hj\n simp only [map_mul, ← Complex.exp_conj, Complex.conj_ofReal,\n Complex.conj_I]\n have hphase : Complex.exp ((v * (x j - x i) : ℝ) * Complex.I) =\n Complex.exp (-((v * x i : ℝ) : ℂ) * Complex.I) *\n Complex.exp ((v * x j : ℝ) * Complex.I) := by\n rw [← Complex.exp_add]\n congr 1\n push_cast\n ring_nf\n rw [hphase]\n simp only [starRingEnd_apply]\n ring_nf\ntheorem radial_exp_kernel_energy_nonneg {ι : Type*} (s : Finset ι)\n (x : ι → ℝ) (w : ι → ℂ) (k : ℝ) (hk : 0 < k) :\n 0 ≤ (∑ i ∈ s, ∑ j ∈ s, star (w i) * w j *\n Complex.exp (-k * |x j - x i| : ℝ)).re := by\n classical\n let f : ℝ → ℂ := fun v => ∑ i ∈ s, ∑ j ∈ s,\n (star (w i) * w j) *\n (Complex.exp ((v * (x j - x i) : ℝ) * Complex.I) /\n ((k ^ 2 + v ^ 2 : ℝ) : ℂ))\n have hi (i j : ι) : MeasureTheory.Integrable (fun v : ℝ =>\n (star (w i) * w j) *\n (Complex.exp ((v * (x j - x i) : ℝ) * Complex.I) /\n ((k ^ 2 + v ^ 2 : ℝ) : ℂ))) :=\n (radial_cauchy_kernel_phase_integrable k (x j - x i) hk).const_mul _\n have hf : MeasureTheory.Integrable f :=\n MeasureTheory.integrable_finsetSum s (fun i _ =>\n MeasureTheory.integrable_finsetSum s (fun j _ => hi i j))\n have hfi : (∫ v : ℝ, f v) = ((Real.pi / k : ℝ) : ℂ) *\n (∑ i ∈ s, ∑ j ∈ s, star (w i) * w j *\n Complex.exp (-k * |x j - x i| : ℝ)) := by\n dsimp only [f]\n rw [MeasureTheory.integral_finsetSum s (fun i _ =>\n MeasureTheory.integrable_finsetSum s (fun j _ => hi i j))]\n simp_rw [MeasureTheory.integral_finsetSum s (fun j _ => hi _ j),\n MeasureTheory.integral_const_mul,\n radial_cauchy_kernel_inverse k hk]\n simp only [Finset.mul_sum]\n apply Finset.sum_congr rfl\n intro i hi\n apply Finset.sum_congr rfl\n intro j hj\n ring_nf\n have hpos (v : ℝ) : 0 ≤ (f v).re := by\n have heq : f v =\n (Complex.normSq (∑ i ∈ s, w i *\n Complex.exp ((v * x i : ℝ) * Complex.I)) : ℂ) /\n ((k ^ 2 + v ^ 2 : ℝ) : ℂ) := by\n dsimp only [f]\n simp only [← mul_div_assoc, ← Finset.sum_div]\n rw [radial_fourier_square_expand]\n rw [heq, ← Complex.ofReal_div, Complex.ofReal_re]\n exact div_nonneg (Complex.normSq_nonneg _) (by positivity)\n have hnonneg : 0 ≤ (∫ v : ℝ, f v).re := by\n rw [← RCLike.re_eq_complex_re]\n rw [← integral_re hf]\n exact MeasureTheory.integral_nonneg hpos\n rw [hfi, Complex.mul_re, Complex.ofReal_re, Complex.ofReal_im,\n zero_mul, sub_zero] at hnonneg\n exact (mul_nonneg_iff_of_pos_left (div_pos Real.pi_pos hk)).mp hnonneg\ntheorem radial_interval_phase_norm_sq (r θ : ℝ) :\n ‖1 - (r : ℂ) * Complex.exp ((θ : ℂ) * Complex.I)‖ ^ 2 =\n 1 + r ^ 2 - 2 * r * Real.cos θ := by\n rw [← Complex.normSq_eq_norm_sq, Complex.normSq_apply]\n simp [Complex.exp_re, Complex.exp_im]\n nlinarith [Real.sin_sq_add_cos_sq θ]\ntheorem radial_interval_phase_norm_lower (r θ : ℝ) (hr : 0 ≤ r) :\n 1 - r ≤ ‖1 - (r : ℂ) * Complex.exp ((θ : ℂ) * Complex.I)‖ := by\n have h := norm_sub_norm_le (1 : ℂ)\n ((r : ℂ) * Complex.exp ((θ : ℂ) * Complex.I))\n simpa [norm_mul, Complex.norm_of_nonneg hr, Complex.norm_exp_ofReal_mul_I,\n abs_of_nonneg hr] using h\ntheorem radial_interval_chord_product_lower (r θ φ : ℝ) (hr : 0 ≤ r) :\n 2 * r * |Real.cos θ - Real.cos φ| ≤\n ‖1 - (r : ℂ) * Complex.exp (((θ - φ : ℝ) : ℂ) * Complex.I)‖ *\n ‖1 - (r : ℂ) * Complex.exp (((θ + φ : ℝ) : ℂ) * Complex.I)‖ := by\n let a := ‖1 - (r : ℂ) * Complex.exp (((θ - φ : ℝ) : ℂ) * Complex.I)‖\n let b := ‖1 - (r : ℂ) * Complex.exp (((θ + φ : ℝ) : ℂ) * Complex.I)‖\n have ha := radial_interval_phase_norm_sq r (θ - φ)\n have hb := radial_interval_phase_norm_sq r (θ + φ)\n change a ^ 2 = _ at ha\n change b ^ 2 = _ at hb\n have hsinθ : Real.sin θ ^ 2 = 1 - Real.cos θ ^ 2 := by\n nlinarith [Real.sin_sq_add_cos_sq θ]\n have hsinφ : Real.sin φ ^ 2 = 1 - Real.cos φ ^ 2 := by\n nlinarith [Real.sin_sq_add_cos_sq φ]\n have hid : (a * b) ^ 2 = (2 * r * (Real.cos θ - Real.cos φ)) ^ 2 +\n (1 - r) ^ 2 * ((1 + r) ^ 2 - 4 * r * Real.cos θ * Real.cos φ) := by\n rw [mul_pow, ha, hb, Real.cos_sub, Real.cos_add]\n calc\n _ = (2 * r * (Real.cos θ - Real.cos φ)) ^ 2 +\n (1 - r) ^ 2 * ((1 + r) ^ 2 - 4 * r * Real.cos θ * Real.cos φ) +\n 4 * r ^ 2 * ((1 - Real.cos θ ^ 2) * (1 - Real.cos φ ^ 2) -\n Real.sin θ ^ 2 * Real.sin φ ^ 2) := by ring\n _ = _ := by rw [hsinθ, hsinφ]; ring\n have hc : Real.cos θ * Real.cos φ ≤ 1 := by\n have h := mul_le_mul (Real.abs_cos_le_one θ) (Real.abs_cos_le_one φ)\n (abs_nonneg (Real.cos φ)) (by norm_num : (0 : ℝ) ≤ 1)\n rw [← abs_mul, one_mul] at h\n exact (le_abs_self _).trans h\n have hbr : 0 ≤ (1 + r) ^ 2 - 4 * r * Real.cos θ * Real.cos φ := by\n nlinarith [mul_nonneg hr (sub_nonneg.mpr hc), sq_nonneg (1 - r)]\n have hpos := mul_nonneg (sq_nonneg (1 - r)) hbr\n have hab : 0 ≤ a * b := mul_nonneg (norm_nonneg _) (norm_nonneg _)\n have ht : 0 ≤ 2 * r * |Real.cos θ - Real.cos φ| := by positivity\n have hsq : (2 * r * |Real.cos θ - Real.cos φ|) ^ 2 =\n (2 * r * (Real.cos θ - Real.cos φ)) ^ 2 := by\n simp only [mul_pow, sq_abs]\n change _ ≤ a * b\n nlinarith\ntheorem radial_interval_phase_power_re (r θ : ℝ) (j : ℕ) :\n ((((r : ℂ) * Complex.exp ((θ : ℂ) * Complex.I)) ^ j) / (j : ℂ)).re =\n r ^ j / (j : ℝ) * Real.cos ((j : ℝ) * θ) := by\n rw [mul_pow, ← Complex.exp_nat_mul]\n have he : (j : ℂ) * ((θ : ℂ) * Complex.I) =\n (((j : ℝ) * θ : ℝ) : ℂ) * Complex.I := by push_cast; ring\n rw [he, ← Complex.ofReal_pow]\n change (((r ^ j : ℝ) : ℂ) *\n Complex.exp ((((j : ℝ) * θ : ℝ) : ℂ) * Complex.I) / ((j : ℝ) : ℂ)).re = _\n rw [Complex.div_ofReal_re, Complex.re_ofReal_mul, Complex.exp_re]\n simp only [Complex.mul_re, Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im,\n Complex.I_re, Complex.I_im, mul_zero, sub_zero, add_zero, mul_one,\n Real.exp_zero, one_mul]\n ring\ntheorem radial_interval_logTaylor_approx (r θ : ℝ) (hr : 0 ≤ r) (hr1 : r < 1)\n (n : ℕ) :\n |-Real.log ‖1 - (r : ℂ) * Complex.exp ((θ : ℂ) * Complex.I)‖ -\n ∑ j ∈ Finset.range (n + 1), r ^ j / (j : ℝ) * Real.cos ((j : ℝ) * θ)| ≤\n r ^ (n + 1) * (1 - r)⁻¹ := by\n let z : ℂ := (r : ℂ) * Complex.exp ((θ : ℂ) * Complex.I)\n have hz : ‖z‖ = r := by\n dsimp only [z]\n rw [norm_mul, Complex.norm_exp_ofReal_mul_I, mul_one, Complex.norm_of_nonneg hr]\n have h := Complex.norm_log_sub_logTaylor_le n (z := -z) (by simpa [hz] using hr1)\n have ht : Complex.logTaylor (n + 1) (-z) =\n -∑ j ∈ Finset.range (n + 1), z ^ j / (j : ℂ) := by\n simp only [Complex.logTaylor, ← Finset.sum_neg_distrib]\n apply Finset.sum_congr rfl\n intro j hj\n have hsign : (-1 : ℂ) ^ (j + 1) * (-z) ^ j = -z ^ j := by\n rw [neg_pow, pow_succ]\n calc\n _ = -(((-1 : ℂ) ^ j * (-1) ^ j) * z ^ j) := by ring\n _ = -z ^ j := by rw [← mul_pow]; norm_num\n rw [hsign, neg_div]\n have hre := (Complex.abs_re_le_norm\n (Complex.log (1 + -z) - Complex.logTaylor (n + 1) (-z))).trans h\n rw [ht] at hre\n have hsum : (∑ j ∈ Finset.range (n + 1), z ^ j / (j : ℂ)).re =\n ∑ j ∈ Finset.range (n + 1), r ^ j / (j : ℝ) * Real.cos ((j : ℝ) * θ) := by\n simp only [Complex.re_sum]\n exact Finset.sum_congr rfl (fun j hj => radial_interval_phase_power_re r θ j)\n simp only [Complex.add_re, Complex.log_re, hsum,\n norm_neg, hz, ← sub_eq_add_neg, sub_neg_eq_add] at hre\n have hden : (1 : ℝ) ≤ (n : ℝ) + 1 := by\n have hn : (0 : ℝ) ≤ n := Nat.cast_nonneg _\n linarith\n have hbound : r ^ (n + 1) * (1 - r)⁻¹ / (n + 1) ≤\n r ^ (n + 1) * (1 - r)⁻¹ := by\n exact div_le_self (by positivity) hden\n change |-Real.log ‖1 - z‖ -\n ∑ j ∈ Finset.range (n + 1), r ^ j / (j : ℝ) * Real.cos ((j : ℝ) * θ)| ≤ _\n rw [show -Real.log ‖1 - z‖ -\n (∑ j ∈ Finset.range (n + 1), r ^ j / (j : ℝ) * Real.cos ((j : ℝ) * θ)) =\n -(Real.log ‖1 - z‖ +\n ∑ j ∈ Finset.range (n + 1), r ^ j / (j : ℝ) * Real.cos ((j : ℝ) * θ)) by ring,\n abs_neg]\n exact hre.trans hbound\ntheorem radial_interval_two_phase_sum (r θ φ : ℝ) (n : ℕ) :\n (∑ j ∈ Finset.range (n + 1), r ^ j / (j : ℝ) * Real.cos ((j : ℝ) * (θ - φ))) +\n (∑ j ∈ Finset.range (n + 1), r ^ j / (j : ℝ) * Real.cos ((j : ℝ) * (θ + φ))) =\n ∑ j ∈ Finset.range (n + 1),\n 2 * (r ^ j / (j : ℝ)) * Real.cos ((j : ℝ) * θ) * Real.cos ((j : ℝ) * φ) := by\n rw [← Finset.sum_add_distrib]\n apply Finset.sum_congr rfl\n intro j hj\n rw [mul_sub, mul_add, Real.cos_sub, Real.cos_add]\n ring\ntheorem radial_interval_cos_moment_nonneg\n (μ : MeasureTheory.ProbabilityMeasure (Set.Icc (0 : ℝ) 1))\n (θ : Set.Icc (0 : ℝ) 1 → ℝ) (hθ : Continuous θ) (r : ℝ) (hr : 0 ≤ r) (n : ℕ) :\n 0 ≤ ∫ z : Set.Icc (0 : ℝ) 1 × Set.Icc (0 : ℝ) 1,\n (∑ j ∈ Finset.range (n + 1),\n 2 * (r ^ j / (j : ℝ)) * Real.cos ((j : ℝ) * θ z.1) *\n Real.cos ((j : ℝ) * θ z.2)) ∂(μ.prod μ) := by\n have hi (j : ℕ) : MeasureTheory.Integrable\n (fun z : Set.Icc (0 : ℝ) 1 × Set.Icc (0 : ℝ) 1 =>\n 2 * (r ^ j / (j : ℝ)) * Real.cos ((j : ℝ) * θ z.1) *\n Real.cos ((j : ℝ) * θ z.2)) (μ.prod μ) := by\n have hc : Continuous (fun z : Set.Icc (0 : ℝ) 1 × Set.Icc (0 : ℝ) 1 =>\n 2 * (r ^ j / (j : ℝ)) * Real.cos ((j : ℝ) * θ z.1) *\n Real.cos ((j : ℝ) * θ z.2)) := by fun_prop\n exact hc.integrable_of_hasCompactSupport (HasCompactSupport.of_compactSpace _)\n rw [MeasureTheory.integral_finsetSum _ (fun j hj => hi j)]\n apply Finset.sum_nonneg\n intro j hj\n have heq : (∫ z : Set.Icc (0 : ℝ) 1 × Set.Icc (0 : ℝ) 1,\n 2 * (r ^ j / (j : ℝ)) * Real.cos ((j : ℝ) * θ z.1) *\n Real.cos ((j : ℝ) * θ z.2) ∂(μ.prod μ)) =\n 2 * (r ^ j / (j : ℝ)) * (∫ x, Real.cos ((j : ℝ) * θ x) ∂μ) ^ 2 := by\n simp_rw [mul_assoc]\n rw [MeasureTheory.integral_const_mul, MeasureTheory.integral_const_mul,\n MeasureTheory.ProbabilityMeasure.toMeasure_prod,\n MeasureTheory.integral_prod_mul\n (fun x : Set.Icc (0 : ℝ) 1 => Real.cos ((j : ℝ) * θ x))\n (fun x : Set.Icc (0 : ℝ) 1 => Real.cos ((j : ℝ) * θ x))]\n ring\n rw [heq]\n positivity\ntheorem radial_interval_abel_trunc_le (r θ φ d : ℝ) (N : ℕ)\n (hr : 0 < r) (hr1 : r < 1)\n (hd : |Real.cos θ - Real.cos φ| = 2 * d)\n (hN : 4 * r * Real.exp (-(N : ℝ)) ≤ (1 - r) ^ 2) :\n Real.log 4 - Real.log ‖1 - (r : ℂ) * Complex.exp (((θ - φ : ℝ) : ℂ) * Complex.I)‖ -\n Real.log ‖1 - (r : ℂ) * Complex.exp (((θ + φ : ℝ) : ℂ) * Complex.I)‖ ≤\n -Real.log (max (Real.exp (-(N : ℝ))) d) - Real.log r := by\n let a := ‖1 - (r : ℂ) * Complex.exp (((θ - φ : ℝ) : ℂ) * Complex.I)‖\n let b := ‖1 - (r : ℂ) * Complex.exp (((θ + φ : ℝ) : ℂ) * Complex.I)‖\n have ha : 0 < a := (sub_pos.mpr hr1).trans_le\n (radial_interval_phase_norm_lower r (θ - φ) hr.le)\n have hb : 0 < b := (sub_pos.mpr hr1).trans_le\n (radial_interval_phase_norm_lower r (θ + φ) hr.le)\n have hsmall : (1 - r) ^ 2 ≤ a * b := by\n rw [pow_two]\n exact mul_le_mul (radial_interval_phase_norm_lower r (θ - φ) hr.le)\n (radial_interval_phase_norm_lower r (θ + φ) hr.le)\n (sub_nonneg.mpr hr1.le) (norm_nonneg _)\n have hlarge : 4 * r * d ≤ a * b := by\n have h := radial_interval_chord_product_lower r θ φ hr.le\n rw [hd] at h\n nlinarith\n have hm : 4 * r * max (Real.exp (-(N : ℝ))) d ≤ a * b := by\n by_cases h : d ≤ Real.exp (-(N : ℝ))\n · rw [max_eq_left h]\n exact hN.trans hsmall\n · rw [max_eq_right (le_of_not_ge h)]\n exact hlarge\n have hp : 0 < max (Real.exp (-(N : ℝ))) d :=\n (Real.exp_pos _).trans_le (le_max_left _ _)\n have hlog := Real.log_le_log (mul_pos (mul_pos (by norm_num) hr) hp) hm\n rw [Real.log_mul (mul_ne_zero (by norm_num) hr.ne') hp.ne',\n Real.log_mul (by norm_num : (4 : ℝ) ≠ 0) hr.ne',\n Real.log_mul ha.ne' hb.ne'] at hlog\n change Real.log 4 - Real.log a - Real.log b ≤ _\n linarith\ntheorem radial_interval_truncated_energy_bound (c : ℝ) (hc : c < Real.log 4)\n (μ : MeasureTheory.ProbabilityMeasure (Set.Icc (0 : ℝ) 1)) :\n ∃ N : ℕ, c < ∫ z : Set.Icc (0 : ℝ) 1 × Set.Icc (0 : ℝ) 1,\n -Real.log (max (Real.exp (-(N : ℝ))) (dist z.1 z.2)) ∂(μ.prod μ) := by\n let η : ℝ := (Real.log 4 - c) / 4\n have hη : 0 < η := by dsimp [η]; linarith\n let r : ℝ := Real.exp (-η)\n have hr : 0 < r := Real.exp_pos _\n have hr1 : r < 1 := by\n dsimp [r]\n rw [← Real.exp_zero]\n exact Real.exp_lt_exp.mpr (neg_neg_of_pos hη)\n have hlogr : Real.log r = -η := Real.log_exp _\n obtain ⟨n, hn⟩ := exists_pow_lt_of_lt_one (mul_pos hη (sub_pos.mpr hr1)) hr1\n let E : ℝ := r ^ (n + 1) * (1 - r)⁻¹\n have hE : E < η := by\n dsimp only [E]\n rw [← div_eq_mul_inv, div_lt_iff₀ (sub_pos.mpr hr1)]\n have hp : r ^ (n + 1) ≤ r ^ n := by\n rw [pow_succ]\n exact (mul_le_mul_of_nonneg_left hr1.le (pow_nonneg hr.le n)).trans_eq (mul_one _)\n exact hp.trans_lt hn\n have ht : 0 < (1 - r) ^ 2 / (4 * r) := by positivity\n obtain ⟨N, hN⟩ := exists_nat_ge (-Real.log ((1 - r) ^ 2 / (4 * r)))\n have hNexp : Real.exp (-(N : ℝ)) ≤ (1 - r) ^ 2 / (4 * r) := by\n rw [← Real.exp_log ht]\n exact Real.exp_le_exp.mpr (by linarith)\n have hN' : 4 * r * Real.exp (-(N : ℝ)) ≤ (1 - r) ^ 2 := by\n have h := (le_div_iff₀ (show 0 < 4 * r by positivity)).mp hNexp\n simpa only [mul_comm] using h\n let θ : Set.Icc (0 : ℝ) 1 → ℝ := fun x => Real.arccos (2 * (x : ℝ) - 1)\n have hθ : Continuous θ := by dsimp [θ]; fun_prop\n have hcos (x : Set.Icc (0 : ℝ) 1) : Real.cos (θ x) = 2 * (x : ℝ) - 1 := by\n exact Real.cos_arccos (by linarith [x.property.1]) (by linarith [x.property.2])\n let K : Set.Icc (0 : ℝ) 1 × Set.Icc (0 : ℝ) 1 → ℝ := fun z =>\n ∑ j ∈ Finset.range (n + 1),\n 2 * (r ^ j / (j : ℝ)) * Real.cos ((j : ℝ) * θ z.1) * Real.cos ((j : ℝ) * θ z.2)\n let F : Set.Icc (0 : ℝ) 1 × Set.Icc (0 : ℝ) 1 → ℝ := fun z =>\n -Real.log (max (Real.exp (-(N : ℝ))) (dist z.1 z.2))\n have hK : Continuous K := by dsimp [K]; fun_prop\n have hF : Continuous F := by\n apply Continuous.neg\n apply (continuous_const.max (continuous_fst.dist continuous_snd)).log\n intro z\n exact ((Real.exp_pos _).trans_le (le_max_left _ _)).ne'\n have hKi : MeasureTheory.Integrable K (μ.prod μ) :=\n hK.integrable_of_hasCompactSupport (HasCompactSupport.of_compactSpace _)\n have hFi : MeasureTheory.Integrable F (μ.prod μ) :=\n hF.integrable_of_hasCompactSupport (HasCompactSupport.of_compactSpace _)\n have hpoint (z : Set.Icc (0 : ℝ) 1 × Set.Icc (0 : ℝ) 1) :\n K z ≤ F z + (-Real.log r - Real.log 4 + 2 * E) := by\n have hd : |Real.cos (θ z.1) - Real.cos (θ z.2)| = 2 * dist z.1 z.2 := by\n rw [hcos, hcos, Subtype.dist_eq, Real.dist_eq]\n rw [show 2 * (z.1 : ℝ) - 1 - (2 * (z.2 : ℝ) - 1) =\n 2 * ((z.1 : ℝ) - (z.2 : ℝ)) by ring, abs_mul]\n norm_num\n have htr := radial_interval_abel_trunc_le r (θ z.1) (θ z.2)\n (dist z.1 z.2) N hr hr1 hd hN'\n have hminus := (abs_le.mp\n (radial_interval_logTaylor_approx r (θ z.1 - θ z.2) hr.le hr1 n)).1\n have hplus := (abs_le.mp\n (radial_interval_logTaylor_approx r (θ z.1 + θ z.2) hr.le hr1 n)).1\n dsimp only [K]\n rw [← radial_interval_two_phase_sum r (θ z.1) (θ z.2) n]\n dsimp only [F, E]\n linarith\n have hnonneg : 0 ≤ ∫ z, K z ∂(μ.prod μ) :=\n radial_interval_cos_moment_nonneg μ θ hθ r hr.le n\n have hmono := MeasureTheory.integral_mono hKi\n (hFi.add (MeasureTheory.integrable_const (-Real.log r - Real.log 4 + 2 * E))) hpoint\n simp only [Pi.add_apply] at hmono\n rw [MeasureTheory.integral_add hFi (MeasureTheory.integrable_const _)] at hmono\n simp only [MeasureTheory.integral_const, MeasureTheory.probReal_univ, one_smul] at hmono\n refine ⟨N, ?_⟩\n change c < ∫ z, F z ∂(μ.prod μ)\n have hηeq : 4 * η = Real.log 4 - c := by dsimp [η]; ring\n linarith\ntheorem radial_fekete_log_bound_of_truncated_energy {n : ℕ} (z : Fin n → ℂ)\n (hz : Function.Injective z) (M c : ℝ)\n (henergy : (n : ℝ) ^ 2 * c ≤ ∑ i : Fin n, ∑ j : Fin n,\n -Real.log (max (Real.exp (-M)) ‖z i - z j‖)) :\n Real.log (radial_fekete_product z) ≤ -(n : ℝ) ^ 2 * c + n * M := by\n classical\n let K : Fin n → Fin n → ℝ := fun i j =>\n -Real.log (max (Real.exp (-M)) ‖z i - z j‖)\n have hdiag (i : Fin n) : K i i = M := by\n simp [K, (Real.exp_pos (-M)).le, Real.log_exp]\n have hfull : (∑ i : Fin n, ∑ j : Fin n, K i j) =\n (∑ i : Fin n, ∑ j ∈ (Finset.univ : Finset (Fin n)).erase i, K i j) + n * M := by\n have hrow (i : Fin n) : (∑ j : Fin n, K i j) =\n (∑ j ∈ (Finset.univ : Finset (Fin n)).erase i, K i j) + M := by\n rw [← Finset.sum_erase_add _ _ (Finset.mem_univ i), hdiag]\n simp_rw [hrow, Finset.sum_add_distrib]\n simp\n have hne (i j : Fin n) (hij : j ≠ i) : ‖z i - z j‖ ≠ 0 := by\n rw [norm_ne_zero_iff, sub_ne_zero]\n exact fun h => hij (hz h).symm\n have hlog : Real.log (radial_fekete_product z) =\n ∑ i : Fin n, ∑ j ∈ (Finset.univ : Finset (Fin n)).erase i,\n Real.log ‖z i - z j‖ := by\n unfold radial_fekete_product\n rw [Real.log_prod (fun i _ => Finset.prod_ne_zero_iff.mpr\n (fun j hj => hne i j (Finset.mem_erase.mp hj).1))]\n apply Finset.sum_congr rfl\n intro i hi\n exact Real.log_prod (fun j hj => hne i j (Finset.mem_erase.mp hj).1)\n have hoff : Real.log (radial_fekete_product z) ≤\n -(∑ i : Fin n, ∑ j ∈ (Finset.univ : Finset (Fin n)).erase i, K i j) := by\n rw [hlog]\n simp only [← Finset.sum_neg_distrib]\n apply Finset.sum_le_sum\n intro i hi\n apply Finset.sum_le_sum\n intro j hj\n dsimp only [K]\n rw [neg_neg]\n exact Real.log_le_log (lt_of_le_of_ne (norm_nonneg _) (hne i j (Finset.mem_erase.mp hj).1).symm)\n (le_max_right _ _)\n change (n : ℝ) ^ 2 * c ≤ ∑ i : Fin n, ∑ j : Fin n, K i j at henergy\n rw [hfull] at henergy\n linarith\ntheorem radial_normalized_fekete_of_truncated_energy\n (A : Finset ℂ) (hA : A.Nonempty) (b : ℝ) (hb : 0 < b) (M c : ℝ)\n (hc : -Real.log b < (A.card : ℝ) * c)\n (henergy : ∀ (n : ℕ) (z : Fin n → ℂ),\n (∀ i, z i ∈ radial_tree_set A 1) →\n (n : ℝ) ^ 2 * c ≤ ∑ i : Fin n, ∑ j : Fin n,\n -Real.log (max (Real.exp (-M)) ‖z i - z j‖)) :\n ∃ n : ℕ, 1 < n ∧ ∀ z : Fin n → ℂ,\n (∀ i, z i ∈ radial_tree_set A 1) →\n radial_fekete_product z ^ A.card ≤ b ^ (n * (n - 1)) := by\n classical\n have hm : 0 < A.card := Finset.card_pos.mpr hA\n have hd : 0 < (A.card : ℝ) * c + Real.log b := by linarith\n obtain ⟨n, hn⟩ := exists_nat_gt\n (max (1 : ℝ) (((A.card : ℝ) * M + Real.log b) /\n ((A.card : ℝ) * c + Real.log b)))\n have hn1 : 1 < n := by exact_mod_cast (lt_of_le_of_lt (le_max_left _ _) hn)\n have hn0 : 0 < (n : ℝ) := by exact_mod_cast (by omega : 0 < n)\n have hlarge : (A.card : ℝ) * M + Real.log b <\n n * ((A.card : ℝ) * c + Real.log b) :=\n (div_lt_iff₀ hd).mp (lt_of_le_of_lt (le_max_right _ _) hn)\n refine ⟨n, hn1, fun z hz => ?_⟩\n by_cases hinj : Function.Injective z\n · have hprod : 0 < radial_fekete_product z := by\n apply Finset.prod_pos\n intro i hi\n apply Finset.prod_pos\n intro j hj\n apply norm_pos_iff.mpr\n apply sub_ne_zero.mpr\n exact fun heq => (Finset.mem_erase.mp hj).1 (hinj heq).symm\n apply (Real.log_le_log_iff (pow_pos hprod _) (pow_pos hb _)).mp\n rw [Real.log_pow, Real.log_pow]\n have hlog := radial_fekete_log_bound_of_truncated_energy z hinj M c (henergy n z hz)\n have hbound := mul_le_mul_of_nonneg_left hlog\n (show 0 ≤ (A.card : ℝ) from Nat.cast_nonneg _)\n have hlarge' := (mul_lt_mul_iff_right₀ hn0).mpr hlarge\n rw [Nat.cast_mul, Nat.cast_sub (by omega : 1 ≤ n), Nat.cast_one]\n nlinarith\n · have hzero : radial_fekete_product z = 0 := by\n unfold Function.Injective at hinj\n push Not at hinj\n obtain ⟨i, j, heq, hne⟩ := hinj\n apply Finset.prod_eq_zero (Finset.mem_univ i)\n apply Finset.prod_eq_zero (Finset.mem_erase.mpr ⟨hne.symm, Finset.mem_univ j⟩)\n simp [heq]\n rw [hzero, zero_pow hm.ne']\n exact (pow_pos hb _).le\ntheorem radial_exists_strictMono_reindex {m : ℕ} (θ : Fin m → ℝ)\n (hθ : Function.Injective θ) :\n ∃ e : Equiv.Perm (Fin m), StrictMono (θ ∘ e) := by\n exact ⟨Tuple.sort θ,\n (Tuple.monotone_sort θ).strictMono_iff_injective.mpr\n (hθ.comp (Tuple.sort θ).injective)⟩\nnoncomputable def radial_cyclic_gap {n : ℕ} (L : ℝ)\n (x : Fin (n + 1) → ℝ) (i : Fin (n + 1)) : ℝ :=\n x (finRotate (n + 1) i) - x i + if i = Fin.last n then L else 0\ntheorem radial_cyclic_gap_pos {n : ℕ} (L : ℝ) (x : Fin (n + 1) → ℝ)\n (hx : StrictMono x) (hbound : ∀ i, x i ∈ Set.Ico 0 L) (i : Fin (n + 1)) :\n 0 < radial_cyclic_gap L x i := by\n classical\n by_cases hi : i = Fin.last n\n · subst i\n simp only [radial_cyclic_gap, finRotate_last, ite_true]\n linarith [(hbound 0).1, (hbound (Fin.last n)).2]\n · have hlt : i < finRotate (n + 1) i := (lt_finRotate_iff_ne_last i).mpr hi\n simpa only [radial_cyclic_gap, if_neg hi, add_zero] using sub_pos.mpr (hx hlt)\ntheorem radial_cyclic_gap_sum {n : ℕ} (L : ℝ) (x : Fin (n + 1) → ℝ) :\n ∑ i, radial_cyclic_gap L x i = L := by\n classical\n simp only [radial_cyclic_gap, Finset.sum_add_distrib, Finset.sum_sub_distrib,\n Equiv.sum_comp, sub_self, zero_add]\n simp\nnoncomputable def radial_clockwise_distance (L x y : ℝ) : ℝ :=\n if y ≤ x then x - y else L + x - y\ntheorem radial_cyclic_gap_distance {n : ℕ} (L : ℝ) (x : Fin (n + 1) → ℝ)\n (hx : StrictMono x) (i j : Fin (n + 1)) :\n radial_cyclic_gap L x i + radial_clockwise_distance L (x i) (x j) =\n if j = finRotate (n + 1) i then L\n else radial_clockwise_distance L (x (finRotate (n + 1) i)) (x j) := by\n classical\n by_cases hi : i = Fin.last n\n · subst i\n simp only [radial_cyclic_gap, finRotate_last, ite_true]\n have hjlast : x j ≤ x (Fin.last n) := hx.monotone (Fin.le_last j)\n by_cases hj : j = 0\n · subst j\n simp only [radial_clockwise_distance, if_pos hjlast, ite_true]\n ring_nf\n · have h0j : x 0 < x j := hx (Fin.pos_iff_ne_zero.mpr hj)\n simp only [radial_clockwise_distance, if_pos hjlast, if_neg hj,\n if_neg (not_le.mpr h0j)]\n ring_nf\n · have hnext : i < finRotate (n + 1) i := (lt_finRotate_iff_ne_last i).mpr hi\n have hxn := hx hnext\n simp only [radial_cyclic_gap, if_neg hi, add_zero]\n by_cases hj : j = finRotate (n + 1) i\n · subst j\n simp only [radial_clockwise_distance, if_neg (not_le.mpr hxn), ite_true]\n ring_nf\n · by_cases hji : j ≤ i\n · have hxi := hx.monotone hji\n have hxx := hxi.trans hxn.le\n simp only [radial_clockwise_distance, if_pos hxi, if_pos hxx, if_neg hj]\n ring_nf\n · have hnj : finRotate (n + 1) i < j := by\n have hnval := coe_finRotate_of_ne_last hi\n omega\n have hxj := hx hnj\n have hxi := hxn.trans hxj\n simp only [radial_clockwise_distance, if_neg (not_le.mpr hxi),\n if_neg (not_le.mpr hxj), if_neg hj]\n ring_nf\ntheorem radial_cyclic_decay_step {n : ℕ} (L : ℝ) (x : Fin (n + 1) → ℝ)\n (hx : StrictMono x) (ξ : ℝ) (i j : Fin (n + 1)) :\n Real.exp (-ξ * radial_clockwise_distance L (x (finRotate (n + 1) i)) (x j)) =\n Real.exp (-ξ * radial_cyclic_gap L x i) *\n Real.exp (-ξ * radial_clockwise_distance L (x i) (x j)) +\n if j = finRotate (n + 1) i then 1 - Real.exp (-ξ * L) else 0 := by\n classical\n rw [← Real.exp_add, ← mul_add, radial_cyclic_gap_distance L x hx]\n by_cases hj : j = finRotate (n + 1) i\n · subst j\n simp only [ite_true, radial_clockwise_distance, le_refl, sub_self, mul_zero,\n Real.exp_zero]\n ring_nf\n · simp only [if_neg hj, add_zero]\ntheorem radial_cyclic_decay_sum_step {n : ℕ} (L : ℝ) (x : Fin (n + 1) → ℝ)\n (hx : StrictMono x) (ξ : ℝ) (w : Fin (n + 1) → ℂ) (i : Fin (n + 1)) :\n (∑ j, (Real.exp (-ξ * radial_clockwise_distance L\n (x (finRotate (n + 1) i)) (x j)) : ℂ) * w j) =\n (Real.exp (-ξ * radial_cyclic_gap L x i) : ℂ) *\n (∑ j, (Real.exp (-ξ * radial_clockwise_distance L (x i) (x j)) : ℂ) * w j) +\n ((1 - Real.exp (-ξ * L) : ℝ) : ℂ) * w (finRotate (n + 1) i) := by\n classical\n have hcast (j : Fin (n + 1)) :\n ((if j = finRotate (n + 1) i then 1 - Real.exp (-ξ * L) else 0 : ℝ) : ℂ) =\n if j = finRotate (n + 1) i then ((1 - Real.exp (-ξ * L) : ℝ) : ℂ) else 0 := by\n split_ifs <;> rfl\n simp_rw [radial_cyclic_decay_step L x hx ξ i, Complex.ofReal_add,\n Complex.ofReal_mul, hcast, add_mul, ite_mul, zero_mul]\n rw [Finset.sum_add_distrib]\n simp only [mul_assoc, ← Finset.mul_sum, Finset.sum_ite_eq', Finset.mem_univ, ite_true]\ntheorem radial_tanh_half_exp (t : ℝ) :\n Real.tanh (t / 2) = (1 - Real.exp (-t)) / (1 + Real.exp (-t)) := by\n have he : Real.exp (-t) = Real.exp (-(t / 2)) * Real.exp (-(t / 2)) := by\n rw [← Real.exp_add]\n congr 1\n ring_nf\n rw [Real.tanh_eq, he, Real.exp_neg]\n have hpos := Real.exp_pos (t / 2)\n field_simp\ntheorem radial_cosh_periodic_decay (a b : ℝ) (ha : 0 < a) :\n Real.cosh (a - b) / Real.sinh a =\n (Real.exp (-b) + Real.exp (-(2 * a) + b)) / (1 - Real.exp (-(2 * a))) := by\n have hden : 0 < 1 - Real.exp (-(2 * a)) := by\n have h := Real.exp_lt_one_iff.mpr (by linarith : -(2 * a) < 0)\n linarith\n have hsinh : 2 * Real.sinh a * Real.exp (-a) = 1 - Real.exp (-(2 * a)) := by\n calc\n _ = Real.exp a * Real.exp (-a) - Real.exp (-a) * Real.exp (-a) := by\n rw [Real.sinh_eq]\n ring_nf\n _ = _ := by\n rw [← Real.exp_add, ← Real.exp_add, add_neg_cancel, Real.exp_zero]\n congr 2\n ring_nf\n have hcosh : 2 * Real.cosh (a - b) * Real.exp (-a) =\n Real.exp (-b) + Real.exp (-(2 * a) + b) := by\n calc\n _ = Real.exp (a - b) * Real.exp (-a) +\n Real.exp (-(a - b)) * Real.exp (-a) := by\n rw [Real.cosh_eq]\n ring_nf\n _ = _ := by\n rw [← Real.exp_add, ← Real.exp_add]\n rw [show a - b + -a = -b by ring_nf,\n show -(a - b) + -a = -(2 * a) + b by ring_nf]\n apply (div_eq_div_iff (Real.sinh_pos_iff.mpr ha).ne' hden.ne').mpr\n rw [← hsinh, ← hcosh]\n ring_nf\ntheorem radial_decay_recurrence_energy {ι : Type*} [Fintype ι]\n (e : Equiv.Perm ι) (q : ι → ℝ) (c : ℝ) (a w : ι → ℂ)\n (hrec : ∀ i, a (e i) = (q i : ℂ) * a i + (c : ℂ) * w (e i)) :\n (∑ i, (1 - q i ^ 2) * ‖a i‖ ^ 2) =\n 2 * c * (∑ i, star (w i) * a i).re - c ^ 2 * ∑ i, ‖w i‖ ^ 2 := by\n have hlocal (i : ι) : ‖a (e i)‖ ^ 2 - q i ^ 2 * ‖a i‖ ^ 2 =\n 2 * c * (star (w (e i)) * a (e i)).re - c ^ 2 * ‖w (e i)‖ ^ 2 := by\n rw [hrec i]\n simp [Complex.sq_norm, Complex.normSq_apply, Complex.mul_re, Complex.mul_im]\n ring_nf\n calc\n _ = ∑ i, (‖a (e i)‖ ^ 2 - q i ^ 2 * ‖a i‖ ^ 2) := by\n simp only [sub_mul, one_mul, Finset.sum_sub_distrib]\n rw [Equiv.sum_comp e (fun i => ‖a i‖ ^ 2)]\n _ = ∑ i, (2 * c * (star (w (e i)) * a (e i)).re - c ^ 2 * ‖w (e i)‖ ^ 2) :=\n Finset.sum_congr rfl (fun i _ => hlocal i)\n _ = _ := by\n simp only [Finset.sum_sub_distrib, ← Finset.mul_sum, ← Complex.re_sum]\n rw [Equiv.sum_comp e (fun i => star (w i) * a i),\n Equiv.sum_comp e (fun i => ‖w i‖ ^ 2)]\ntheorem radial_symmetric_decay_sum {ι : Type*} [Fintype ι] [DecidableEq ι]\n (H M : ι → ι → ℝ) (hH : ∀ i j, H i j = H j i) (c : ℝ) :\n (∑ i, ∑ j, H i j * (M i j + M j i - if i = j then c else 0)) =\n 2 * (∑ i, ∑ j, H i j * M i j) - c * ∑ i, H i i := by\n classical\n have htranspose : (∑ i, ∑ j, H i j * M j i) = ∑ i, ∑ j, H i j * M i j := by\n rw [Finset.sum_comm]\n apply Finset.sum_congr rfl\n intro i _\n apply Finset.sum_congr rfl\n intro j _\n rw [hH j i]\n simp_rw [mul_sub, mul_add, Finset.sum_sub_distrib, Finset.sum_add_distrib]\n rw [htranspose]\n have hdiag : (∑ i, ∑ j, H i j * (if i = j then c else 0)) = c * ∑ i, H i i := by\n simp [mul_ite, ← Finset.mul_sum, mul_comm]\n rw [hdiag]\n ring_nf\ntheorem radial_green_decay_entry (L ξ x y : ℝ) (hL : 0 < L) (hξ : 0 < ξ) :\n (2 * ξ * (1 - Real.exp (-ξ * L))) *\n (Real.cosh (ξ * (L / 2 - |x - y|)) / (2 * ξ * Real.sinh (ξ * L / 2))) =\n Real.exp (-ξ * radial_clockwise_distance L x y) +\n Real.exp (-ξ * radial_clockwise_distance L y x) -\n if x = y then 1 - Real.exp (-ξ * L) else 0 := by\n have hhalf : 0 < ξ * L / 2 := by positivity\n have hs : Real.sinh (ξ * L / 2) ≠ 0 := (Real.sinh_pos_iff.mpr hhalf).ne'\n have hc : 1 - Real.exp (-ξ * L) ≠ 0 := by\n have h := Real.exp_lt_one_iff.mpr (neg_neg_of_pos (mul_pos hξ hL))\n simpa only [neg_mul] using (sub_pos.mpr h).ne'\n have hcosh := radial_cosh_periodic_decay (ξ * L / 2) (ξ * |x - y|) hhalf\n have he₁ : ξ * L / 2 - ξ * |x - y| = ξ * (L / 2 - |x - y|) := by ring_nf\n have he₂ : -(2 * (ξ * L / 2)) + ξ * |x - y| = -ξ * (L - |x - y|) := by ring_nf\n have he₃ : -(2 * (ξ * L / 2)) = -ξ * L := by ring_nf\n rw [he₁, he₂, he₃] at hcosh\n have hcross := (div_eq_div_iff hs hc).mp hcosh\n have hbase : (2 * ξ * (1 - Real.exp (-ξ * L))) *\n (Real.cosh (ξ * (L / 2 - |x - y|)) / (2 * ξ * Real.sinh (ξ * L / 2))) =\n Real.exp (-ξ * |x - y|) + Real.exp (-ξ * (L - |x - y|)) := by\n rw [← mul_div_assoc]\n apply (div_eq_iff (mul_ne_zero (by positivity : (2 : ℝ) * ξ ≠ 0) hs)).mpr\n calc\n _ = (2 * ξ) * (Real.cosh (ξ * (L / 2 - |x - y|)) *\n (1 - Real.exp (-ξ * L))) := by ring_nf\n _ = _ := by rw [hcross]; ring_nf\n rw [hbase]\n by_cases hxy : x = y\n · subst y\n simp only [sub_self, abs_zero, mul_zero, Real.exp_zero, sub_zero, ite_true,\n radial_clockwise_distance, le_refl]\n ring_nf\n · rcases lt_or_gt_of_ne hxy with hlt | hlt\n · simp only [radial_clockwise_distance, if_neg (not_le.mpr hlt), if_pos hlt.le,\n abs_of_neg (sub_neg.mpr hlt), if_neg hxy, sub_zero]\n have he : L - -(x - y) = L + x - y := by ring_nf\n rw [he, neg_sub]\n ring_nf\n · simp only [radial_clockwise_distance, if_pos hlt.le, if_neg (not_le.mpr hlt),\n abs_of_pos (sub_pos.mpr hlt), if_neg hxy, sub_zero]\n rw [show L - (x - y) = L + y - x by ring_nf]\ntheorem radial_decay_recurrence_cauchy {ι : Type*} [Fintype ι]\n (e : Equiv.Perm ι) (q : ι → ℝ) (hq : ∀ i, 0 ≤ q i ∧ q i < 1)\n (c : ℝ) (a w : ι → ℂ)\n (hrec : ∀ i, a (e i) = (q i : ℂ) * a i + (c : ℂ) * w (e i)) :\n c ^ 2 * ‖∑ i, w i‖ ^ 2 ≤\n (∑ i, (1 - q i) / (1 + q i)) * ∑ i, (1 - q i ^ 2) * ‖a i‖ ^ 2 := by\n let τ : ι → ℝ := fun i => (1 - q i) / (1 + q i)\n have hden (i : ι) : 0 < 1 + q i := by linarith [(hq i).1]\n have hτ (i : ι) : 0 ≤ τ i := (div_pos (sub_pos.mpr (hq i).2) (hden i)).le\n have hτmul (i : ι) : τ i * (1 + q i) = 1 - q i :=\n div_mul_cancel₀ _ (hden i).ne'\n have hs := congrArg (fun f : ι → ℂ => ∑ i, f i) (funext hrec)\n simp only [Finset.sum_add_distrib, ← Finset.mul_sum] at hs\n rw [Equiv.sum_comp e a, Equiv.sum_comp e w] at hs\n have hsum : (∑ i, (τ i : ℂ) * (((1 + q i : ℝ) : ℂ) * a i)) =\n (c : ℂ) * ∑ i, w i := by\n calc\n _ = ∑ i, ((1 - q i : ℝ) : ℂ) * a i := by\n apply Finset.sum_congr rfl\n intro i _\n rw [← mul_assoc, ← Complex.ofReal_mul, hτmul]\n _ = (∑ i, a i) - ∑ i, (q i : ℂ) * a i := by\n simp only [Complex.ofReal_sub, Complex.ofReal_one, sub_mul, one_mul,\n Finset.sum_sub_distrib]\n _ = _ := by rw [hs]; ring_nf\n have henergy : (∑ i, τ i * ‖((1 + q i : ℝ) : ℂ) * a i‖ ^ 2) =\n ∑ i, (1 - q i ^ 2) * ‖a i‖ ^ 2 := by\n apply Finset.sum_congr rfl\n intro i _\n rw [norm_mul, mul_pow, Complex.norm_real, Real.norm_eq_abs, abs_of_pos (hden i)]\n calc\n _ = (τ i * (1 + q i)) * ((1 + q i) * ‖a i‖ ^ 2) := by ring_nf\n _ = _ := by rw [hτmul]; ring_nf\n have h := radial_weighted_complex_sum_norm_sq_le Finset.univ τ\n (fun i _ => hτ i) (fun i => ((1 + q i : ℝ) : ℂ) * a i)\n rw [hsum, henergy] at h\n simpa only [norm_mul, mul_pow, Complex.norm_real, Real.norm_eq_abs, sq_abs] using h\nnoncomputable def radial_periodic_green_kernel (L ξ x y : ℝ) : ℝ :=\n Real.cosh (ξ * (L / 2 - |x - y|)) / (2 * ξ * Real.sinh (ξ * L / 2))\ntheorem radial_green_decay_quadratic {ι : Type*} [Fintype ι]\n (L ξ : ℝ) (hL : 0 < L) (hξ : 0 < ξ) (x : ι → ℝ)\n (hx : Function.Injective x) (w : ι → ℂ) :\n (2 * ξ * (1 - Real.exp (-ξ * L))) *\n (∑ i, ∑ j, star (w i) * w j * (radial_periodic_green_kernel L ξ (x i) (x j) : ℂ)).re =\n 2 * (∑ i, star (w i) *\n ∑ j, (Real.exp (-ξ * radial_clockwise_distance L (x i) (x j)) : ℂ) * w j).re -\n (1 - Real.exp (-ξ * L)) * ∑ i, ‖w i‖ ^ 2 := by\n classical\n let H : ι → ι → ℝ := fun i j => (star (w i) * w j).re\n let M : ι → ι → ℝ := fun i j => Real.exp (-ξ * radial_clockwise_distance L (x i) (x j))\n let c : ℝ := 1 - Real.exp (-ξ * L)\n have hH (i j : ι) : H i j = H j i := by\n simp [H, Complex.mul_re]\n ring_nf\n have hdiag (i : ι) : H i i = ‖w i‖ ^ 2 := by\n simp [H, Complex.sq_norm, Complex.normSq_apply, Complex.mul_re]\n have hentry (i j : ι) : (2 * ξ * c) * radial_periodic_green_kernel L ξ (x i) (x j) =\n M i j + M j i - if i = j then c else 0 := by\n simpa only [radial_periodic_green_kernel, M, c, hx.eq_iff] using\n radial_green_decay_entry L ξ (x i) (x j) hL hξ\n have hB : (∑ i, star (w i) * ∑ j, (M i j : ℂ) * w j).re =\n ∑ i, ∑ j, H i j * M i j := by\n simp only [Finset.mul_sum, Complex.re_sum]\n apply Finset.sum_congr rfl\n intro i _\n apply Finset.sum_congr rfl\n intro j _\n rw [mul_left_comm, Complex.mul_re]\n simp only [Complex.ofReal_re, Complex.ofReal_im, zero_mul, sub_zero]\n exact mul_comm _ _\n have hQterm (i j : ι) :\n (star (w i) * w j * (radial_periodic_green_kernel L ξ (x i) (x j) : ℂ)).re =\n H i j * radial_periodic_green_kernel L ξ (x i) (x j) := by\n rw [Complex.mul_re]\n simp only [Complex.ofReal_re, Complex.ofReal_im, mul_zero, sub_zero]\n rfl\n calc\n _ = ∑ i, ∑ j, H i j * ((2 * ξ * c) * radial_periodic_green_kernel L ξ (x i) (x j)) := by\n simp only [Complex.re_sum, hQterm]\n rw [Finset.mul_sum]\n apply Finset.sum_congr rfl\n intro i _\n rw [Finset.mul_sum]\n apply Finset.sum_congr rfl\n intro j _\n dsimp only [c]\n ring_nf\n _ = 2 * (∑ i, ∑ j, H i j * M i j) - c * ∑ i, H i i := by\n simp_rw [hentry]\n exact radial_symmetric_decay_sum H M hH c\n _ = _ := by\n rw [← hB]\n simp only [hdiag]\n rfl\ntheorem radial_angular_green_energy_bound_of_strictMono {n : ℕ}\n (x : Fin (n + 1) → ℝ) (hx : StrictMono x)\n (hbound : ∀ i, x i ∈ Set.Ico 0 (2 * Real.pi))\n (ξ : ℝ) (hξ : 0 < ξ) (w : Fin (n + 1) → ℂ) :\n ‖∑ i, w i‖ ^ 2 ≤\n (2 * ξ * (n + 1) * Real.tanh (Real.pi * ξ / (n + 1))) *\n (∑ i, ∑ j, star (w i) * w j *\n ((Real.cosh (ξ * (Real.pi - |x i - x j|)) /\n (2 * ξ * Real.sinh (Real.pi * ξ)) : ℝ) : ℂ)).re := by\n let L : ℝ := 2 * Real.pi\n let δ : Fin (n + 1) → ℝ := radial_cyclic_gap L x\n let e := finRotate (n + 1)\n let q : Fin (n + 1) → ℝ := fun i => Real.exp (-ξ * δ i)\n let c : ℝ := 1 - Real.exp (-ξ * L)\n let a : Fin (n + 1) → ℂ := fun i =>\n ∑ j, (Real.exp (-ξ * radial_clockwise_distance L (x i) (x j)) : ℂ) * w j\n let Q : ℝ := (∑ i, ∑ j, star (w i) * w j *\n ((Real.cosh (ξ * (Real.pi - |x i - x j|)) /\n (2 * ξ * Real.sinh (Real.pi * ξ)) : ℝ) : ℂ)).re\n let E : ℝ := ∑ i, (1 - q i ^ 2) * ‖a i‖ ^ 2\n have hL : 0 < L := mul_pos (by norm_num) Real.pi_pos\n have hc : 0 < c := sub_pos.mpr\n (Real.exp_lt_one_iff.mpr (mul_neg_of_neg_of_pos (neg_neg_of_pos hξ) hL))\n have hδ (i : Fin (n + 1)) : 0 < δ i := radial_cyclic_gap_pos L x hx hbound i\n have hq (i : Fin (n + 1)) : 0 ≤ q i ∧ q i < 1 :=\n ⟨(Real.exp_pos _).le,\n Real.exp_lt_one_iff.mpr (mul_neg_of_neg_of_pos (neg_neg_of_pos hξ) (hδ i))⟩\n have hrec (i : Fin (n + 1)) : a (e i) = (q i : ℂ) * a i + (c : ℂ) * w (e i) :=\n radial_cyclic_decay_sum_step L x hx ξ w i\n have hEpos : 0 ≤ E := by\n apply Finset.sum_nonneg\n intro i _\n apply mul_nonneg _ (sq_nonneg _)\n have h := mul_nonneg (hq i).1 (sub_nonneg.mpr (hq i).2.le)\n nlinarith [(hq i).2]\n have hker (i j : Fin (n + 1)) : radial_periodic_green_kernel L ξ (x i) (x j) =\n Real.cosh (ξ * (Real.pi - |x i - x j|)) / (2 * ξ * Real.sinh (Real.pi * ξ)) := by\n dsimp only [radial_periodic_green_kernel, L]\n rw [show (2 * Real.pi) / 2 = Real.pi by ring_nf,\n show ξ * (2 * Real.pi) / 2 = Real.pi * ξ by ring_nf]\n have hquadratic := radial_green_decay_quadratic L ξ hL hξ x hx.injective w\n simp_rw [hker] at hquadratic\n change (2 * ξ * c) * Q =\n 2 * (∑ i, star (w i) * a i).re - c * ∑ i, ‖w i‖ ^ 2 at hquadratic\n have hE : E = 2 * ξ * c ^ 2 * Q := by\n calc\n _ = 2 * c * (∑ i, star (w i) * a i).re - c ^ 2 * ∑ i, ‖w i‖ ^ 2 :=\n radial_decay_recurrence_energy e q c a w hrec\n _ = c * (2 * (∑ i, star (w i) * a i).re - c * ∑ i, ‖w i‖ ^ 2) := by ring_nf\n _ = c * ((2 * ξ * c) * Q) := by rw [hquadratic]\n _ = _ := by ring_nf\n have hτ (i : Fin (n + 1)) : (1 - q i) / (1 + q i) = Real.tanh (ξ * δ i / 2) := by\n simpa only [q, neg_mul] using (radial_tanh_half_exp (ξ * δ i)).symm\n have hmean : (∑ i, ξ * δ i / 2) = Real.pi * ξ := by\n rw [← Finset.sum_div, ← Finset.mul_sum]\n rw [radial_cyclic_gap_sum L x]\n dsimp only [L]\n ring_nf\n have hsum : (∑ i, (1 - q i) / (1 + q i)) ≤\n (n + 1) * Real.tanh (Real.pi * ξ / (n + 1)) := by\n simp_rw [hτ]\n have h := radial_tanh_sum_le (Finset.univ : Finset (Fin (n + 1)))\n Finset.univ_nonempty (fun i => ξ * δ i / 2)\n (fun i _ => (div_pos (mul_pos hξ (hδ i)) (by norm_num)).le)\n simpa only [Finset.card_univ, Fintype.card_fin, Nat.cast_add, Nat.cast_one, hmean] using h\n have hCS := radial_decay_recurrence_cauchy e q hq c a w hrec\n have hbound' := hCS.trans (mul_le_mul_of_nonneg_right hsum hEpos)\n change ‖∑ i, w i‖ ^ 2 ≤\n (2 * ξ * (n + 1) * Real.tanh (Real.pi * ξ / (n + 1))) * Q\n apply (mul_le_mul_iff_left₀ (sq_pos_of_pos hc)).mp\n calc\n ‖∑ i, w i‖ ^ 2 * c ^ 2 = c ^ 2 * ‖∑ i, w i‖ ^ 2 := mul_comm _ _\n _ ≤ ((n + 1) * Real.tanh (Real.pi * ξ / (n + 1))) * E := hbound'\n _ = ((n + 1) * Real.tanh (Real.pi * ξ / (n + 1))) * (2 * ξ * c ^ 2 * Q) :=\n congrArg (fun T : ℝ => ((n + 1) * Real.tanh (Real.pi * ξ / (n + 1))) * T) hE\n _ = ((2 * ξ * (n + 1) * Real.tanh (Real.pi * ξ / (n + 1))) * Q) * c ^ 2 := by ring_nf\ntheorem radial_angular_green_energy_bound (m : ℕ) (hm : 0 < m)\n (θ : Fin m → ℝ) (hθ : ∀ i, θ i ∈ Set.Ico 0 (2 * Real.pi))\n (hinj : Function.Injective θ) (ξ : ℝ) (hξ : 0 < ξ) (w : Fin m → ℂ) :\n ‖∑ i, w i‖ ^ 2 ≤\n (2 * ξ * m * Real.tanh (Real.pi * ξ / m)) *\n (∑ i, ∑ j, star (w i) * w j *\n ((Real.cosh (ξ * (Real.pi - |θ i - θ j|)) /\n (2 * ξ * Real.sinh (Real.pi * ξ)) : ℝ) : ℂ)).re := by\n obtain ⟨n, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hm.ne'\n obtain ⟨e, he⟩ := radial_exists_strictMono_reindex θ hinj\n have h := radial_angular_green_energy_bound_of_strictMono (θ ∘ e) he\n (fun i => hθ (e i)) ξ hξ (w ∘ e)\n simp only [Function.comp_apply] at h\n rw [Equiv.sum_comp e w] at h\n have hsum : (∑ i, ∑ j, star (w (e i)) * w (e j) *\n ((Real.cosh (ξ * (Real.pi - |θ (e i) - θ (e j)|)) /\n (2 * ξ * Real.sinh (Real.pi * ξ)) : ℝ) : ℂ)) =\n ∑ i, ∑ j, star (w i) * w j *\n ((Real.cosh (ξ * (Real.pi - |θ i - θ j|)) /\n (2 * ξ * Real.sinh (Real.pi * ξ)) : ℝ) : ℂ) := by\n calc\n _ = ∑ i, ∑ j, star (w (e i)) * w j *\n ((Real.cosh (ξ * (Real.pi - |θ (e i) - θ j|)) /\n (2 * ξ * Real.sinh (Real.pi * ξ)) : ℝ) : ℂ) := by\n apply Finset.sum_congr rfl\n intro i _\n exact Equiv.sum_comp e (fun j => star (w (e i)) * w j *\n ((Real.cosh (ξ * (Real.pi - |θ (e i) - θ j|)) /\n (2 * ξ * Real.sinh (Real.pi * ξ)) : ℝ) : ℂ))\n _ = _ := Equiv.sum_comp e (fun i => ∑ j, star (w i) * w j *\n ((Real.cosh (ξ * (Real.pi - |θ i - θ j|)) /\n (2 * ξ * Real.sinh (Real.pi * ξ)) : ℝ) : ℂ))\n rw [hsum] at h\n exact_mod_cast h\ntheorem radial_compact_uniform_strict_lower {X : Type*}\n [TopologicalSpace X] [CompactSpace X] (f : ℕ → X → ℝ)\n (hf : ∀ n, Continuous (f n)) (hmono : ∀ x, Monotone (fun n => f n x))\n (c : ℝ) (hpoint : ∀ x, ∃ n, c < f n x) :\n ∃ N : ℕ, ∀ x, c < f N x := by\n classical\n let U : ℕ → Set X := fun n => {x | c < f n x}\n have hopen : ∀ n, IsOpen (U n) := fun n => isOpen_lt continuous_const (hf n)\n have hcover : (Set.univ : Set X) ⊆ ⋃ n, U n := by\n intro x hx\n obtain ⟨n, hn⟩ := hpoint x\n exact Set.mem_iUnion.mpr ⟨n, hn⟩\n obtain ⟨s, hs⟩ := isCompact_univ.elim_finite_subcover U hopen hcover\n refine ⟨s.sup id, fun x => ?_⟩\n have hx := hs (Set.mem_univ x)\n simp only [Set.mem_iUnion, U, Set.mem_ofPred_eq] at hx\n obtain ⟨n, hn, hcx⟩ := hx\n exact hcx.trans_le (hmono x (Finset.le_sup (f := id) hn))\ntheorem radial_truncated_log_energy_continuous {E : Type*}\n [PseudoMetricSpace E] [MeasurableSpace E] [BorelSpace E]\n [CompactSpace E] [SecondCountableTopology E] (M : ℝ) :\n Continuous (fun μ : MeasureTheory.ProbabilityMeasure E =>\n ∫ z : E × E, -Real.log (max (Real.exp (-M)) (dist z.1 z.2)) ∂(μ.prod μ)) := by\n let K : C(E × E, ℝ) := ⟨fun z => -Real.log (max (Real.exp (-M)) (dist z.1 z.2)),\n ((continuous_const.max (continuous_fst.dist continuous_snd)).log\n (fun z => ne_of_gt ((Real.exp_pos (-M)).trans_le (le_max_left _ _)))).neg⟩\n have hprod : Continuous (fun μ : MeasureTheory.ProbabilityMeasure E => μ.prod μ) :=\n MeasureTheory.ProbabilityMeasure.continuous_prod.comp\n (continuous_id.prodMk continuous_id)\n exact (MeasureTheory.ProbabilityMeasure.continuous_integral_continuousMap K).comp hprod\ntheorem radial_probability_uniform_truncated_energy_of_pointwise {E : Type*}\n [MetricSpace E] [MeasurableSpace E] [BorelSpace E]\n [CompactSpace E] [SecondCountableTopology E] (c : ℝ)\n (hpoint : ∀ μ : MeasureTheory.ProbabilityMeasure E, ∃ N : ℕ,\n c < ∫ z : E × E,\n -Real.log (max (Real.exp (-(N : ℝ))) (dist z.1 z.2)) ∂(μ.prod μ)) :\n ∃ N : ℕ, ∀ μ : MeasureTheory.ProbabilityMeasure E,\n c < ∫ z : E × E,\n -Real.log (max (Real.exp (-(N : ℝ))) (dist z.1 z.2)) ∂(μ.prod μ) := by\n let K (n : ℕ) : C(E × E, ℝ) := ⟨fun z =>\n -Real.log (max (Real.exp (-(n : ℝ))) (dist z.1 z.2)),\n ((continuous_const.max (continuous_fst.dist continuous_snd)).log\n (fun z => ne_of_gt ((Real.exp_pos (-(n : ℝ))).trans_le\n (le_max_left _ _)))).neg⟩\n apply radial_compact_uniform_strict_lower\n (fun n (μ : MeasureTheory.ProbabilityMeasure E) => ∫ z : E × E, K n z ∂(μ.prod μ))\n (fun n => radial_truncated_log_energy_continuous (n : ℝ)) _ c hpoint\n intro μ n m hnm\n apply MeasureTheory.integral_mono\n ((ContinuousMap.equivBoundedOfCompact _ _ (K n)).integrable _)\n ((ContinuousMap.equivBoundedOfCompact _ _ (K m)).integrable _)\n intro z\n apply neg_le_neg\n apply Real.log_le_log ((Real.exp_pos (-(m : ℝ))).trans_le (le_max_left _ _))\n apply max_le_max_right\n apply Real.exp_le_exp.mpr\n exact neg_le_neg (by exact_mod_cast hnm)\ntheorem radial_empirical_product_integral {E : Type*}\n [MetricSpace E] [MeasurableSpace E] [BorelSpace E] [CompactSpace E]\n {n : ℕ} (hn : 0 < n) (z : Fin n → E) (K : C(E × E, ℝ)) :\n ∃ μ : MeasureTheory.ProbabilityMeasure E,\n (∫ p : E × E, K p ∂(μ.prod μ)) =\n ((n : ℝ)⁻¹) ^ 2 * ∑ i : Fin n, ∑ j : Fin n, K (z i, z j) := by\n classical\n let : NeZero n := ⟨hn.ne'⟩\n let u : PMF (Fin n) := PMF.uniformOfFintype (Fin n)\n let μ : MeasureTheory.ProbabilityMeasure E := ⟨(u.map z).toMeasure, inferInstance⟩\n have hmean (g : C(E, ℝ)) : (∫ x, g x ∂μ) =\n (n : ℝ)⁻¹ * ∑ i : Fin n, g (z i) := by\n change (∫ x, g x ∂(u.map z).toMeasure) = _\n rw [← PMF.toMeasure_map z u (measurable_of_finite z),\n MeasureTheory.integral_map (measurable_of_finite z).aemeasurable\n g.continuous.measurable.aestronglyMeasurable, PMF.integral_eq_sum]\n simp only [u, PMF.uniformOfFintype_apply, ENNReal.toReal_inv,\n ENNReal.toReal_natCast, Fintype.card_fin, smul_eq_mul, ← Finset.mul_sum]\n have hinner (x : E) : (∫ y, K (x, y) ∂μ) =\n (n : ℝ)⁻¹ * ∑ j : Fin n, K (x, z j) :=\n hmean ⟨fun y => K (x, y), K.continuous.comp (continuous_const.prodMk continuous_id)⟩\n have houter (j : Fin n) : (∫ x, K (x, z j) ∂μ) =\n (n : ℝ)⁻¹ * ∑ i : Fin n, K (z i, z j) :=\n hmean ⟨fun x => K (x, z j), K.continuous.comp (continuous_id.prodMk continuous_const)⟩\n refine ⟨μ, ?_⟩\n have hK : MeasureTheory.Integrable (fun p : E × E => K p)\n ((μ : MeasureTheory.Measure E).prod (μ : MeasureTheory.Measure E)) :=\n (ContinuousMap.equivBoundedOfCompact _ _ K).integrable _\n change (∫ p : E × E, K p ∂((μ : MeasureTheory.Measure E).prod\n (μ : MeasureTheory.Measure E))) = _\n rw [MeasureTheory.integral_prod _ hK]\n simp_rw [hinner]\n rw [MeasureTheory.integral_const_mul, MeasureTheory.integral_finsetSum]\n · simp_rw [houter]\n rw [← Finset.mul_sum, Finset.sum_comm]\n ring\n · intro j hj\n exact (ContinuousMap.equivBoundedOfCompact _ _\n (⟨fun x => K (x, z j),\n K.continuous.comp (continuous_id.prodMk continuous_const)⟩ : C(E, ℝ))).integrable _\ntheorem radial_finite_truncated_energy_of_probability_bound {E : Type*}\n [MetricSpace E] [MeasurableSpace E] [BorelSpace E] [CompactSpace E]\n (M c : ℝ)\n (hbound : ∀ μ : MeasureTheory.ProbabilityMeasure E,\n c < ∫ p : E × E, -Real.log (max (Real.exp (-M)) (dist p.1 p.2)) ∂(μ.prod μ)) :\n ∀ (n : ℕ) (z : Fin n → E),\n (n : ℝ) ^ 2 * c ≤ ∑ i : Fin n, ∑ j : Fin n,\n -Real.log (max (Real.exp (-M)) (dist (z i) (z j))) := by\n intro n z\n by_cases hn : n = 0\n · subst n\n simp\n have hnpos : 0 < n := Nat.pos_of_ne_zero hn\n have hnreal : 0 < (n : ℝ) := by exact_mod_cast hnpos\n let K : C(E × E, ℝ) := ⟨fun p =>\n -Real.log (max (Real.exp (-M)) (dist p.1 p.2)),\n ((continuous_const.max (continuous_fst.dist continuous_snd)).log\n (fun p => ne_of_gt ((Real.exp_pos (-M)).trans_le (le_max_left _ _)))).neg⟩\n obtain ⟨μ, hμ⟩ := radial_empirical_product_integral hnpos z K\n have h := hbound μ\n change c < ∫ p : E × E, K p ∂(μ.prod μ) at h\n rw [hμ] at h\n have hmul := mul_lt_mul_of_pos_left h (sq_pos_of_pos hnreal)\n have hcancel : (n : ℝ) ^ 2 * ((n : ℝ)⁻¹) ^ 2 = 1 := by\n rw [← mul_pow, mul_inv_cancel₀ hnreal.ne', one_pow]\n rw [← mul_assoc, hcancel, one_mul] at hmul\n exact hmul.le\ntheorem even_odd_polynomial_decomposition (F : Polynomial ℤ) :\n F = (Polynomial.contract 2 F).comp (Polynomial.X ^ 2) +\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX F)).comp (Polynomial.X ^ 2) := by\n change F = Polynomial.expand ℤ 2 (Polynomial.contract 2 F) +\n Polynomial.X * Polynomial.expand ℤ 2 (Polynomial.contract 2 (Polynomial.divX F))\n ext n\n rw [Polynomial.coeff_add]\n cases n with\n | zero =>\n simp [Polynomial.coeff_expand (by norm_num : 0 < (2 : ℕ)),\n Polynomial.coeff_contract (by norm_num : (2 : ℕ) ≠ 0)]\n | succ n =>\n rw [Polynomial.coeff_X_mul,\n Polynomial.coeff_expand (by norm_num : 0 < (2 : ℕ)),\n Polynomial.coeff_expand (by norm_num : 0 < (2 : ℕ))]\n by_cases hn : 2 ∣ n\n · have hs : ¬ 2 ∣ n + 1 := by omega\n simp only [if_neg hs, if_pos hn, zero_add,\n Polynomial.coeff_contract (by norm_num : (2 : ℕ) ≠ 0),\n Polynomial.coeff_divX]\n congr 1\n omega\n · have hs : 2 ∣ n + 1 := by omega\n simp only [if_pos hs, if_neg hn, add_zero,\n Polynomial.coeff_contract (by norm_num : (2 : ℕ) ≠ 0)]\n congr 1\n omega\ntheorem even_odd_power_transform_subst (F : Polynomial ℤ) :\n (((Polynomial.contract 2 F) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX F)) ^ 2).comp\n (Polynomial.X ^ 2)) = F * F.comp (-Polynomial.X) := by\n let A := Polynomial.contract 2 F\n let B := Polynomial.contract 2 (Polynomial.divX F)\n have hF : F = A.comp (Polynomial.X ^ 2) +\n Polynomial.X * B.comp (Polynomial.X ^ 2) := even_odd_polynomial_decomposition F\n have hneg : F.comp (-Polynomial.X) = A.comp (Polynomial.X ^ 2) -\n Polynomial.X * B.comp (Polynomial.X ^ 2) := by\n calc\n _ = (A.comp (Polynomial.X ^ 2) +\n Polynomial.X * B.comp (Polynomial.X ^ 2)).comp (-Polynomial.X) :=\n congrArg (fun P : Polynomial ℤ => P.comp (-Polynomial.X)) hF\n _ = _ := by\n simp only [Polynomial.add_comp, Polynomial.mul_comp,\n Polynomial.comp_assoc, Polynomial.pow_comp, Polynomial.X_comp, neg_sq]\n ring\n change (A ^ 2 - Polynomial.X * B ^ 2).comp (Polynomial.X ^ 2) = _\n calc\n _ = (A.comp (Polynomial.X ^ 2) + Polynomial.X * B.comp (Polynomial.X ^ 2)) *\n (A.comp (Polynomial.X ^ 2) - Polynomial.X * B.comp (Polynomial.X ^ 2)) := by\n simp only [Polynomial.sub_comp, Polynomial.pow_comp,\n Polynomial.mul_comp, Polynomial.X_comp]\n ring\n _ = F * F.comp (-Polynomial.X) := congrArg₂ (fun P Q : Polynomial ℤ => P * Q)\n hF.symm hneg.symm\ntheorem radial_resolvent_int_summable (ξ : ℝ) :\n Summable (fun n : ℤ => 1 / (ξ ^ 2 + (n : ℝ) ^ 2)) := by\n have h := Real.summable_one_div_int_pow.mpr (by norm_num : 1 < (2 : ℕ))\n apply h.of_norm_bounded_eventually\n filter_upwards [Filter.eventually_cofinite_ne (0 : ℤ)] with n hn\n rw [Real.norm_eq_abs, abs_of_nonneg (by positivity)]\n apply one_div_le_one_div_of_le\n · exact sq_pos_of_ne_zero (by exact_mod_cast hn)\n · exact le_add_of_nonneg_left (sq_nonneg ξ)\ntheorem radial_exp_int_summable (a : ℝ) (ha : 0 < a) :\n Summable (fun n : ℤ => Real.exp (-a * |(n : ℝ)|)) := by\n have h : Summable (fun n : ℕ => Real.exp (-a * (n : ℝ))) := by\n convert summable_geometric_of_lt_one (Real.exp_pos (-a)).le\n (Real.exp_lt_one_iff.mpr (by linarith : -a < 0)) using 1\n funext n\n rw [← Real.exp_nat_mul]\n congr 1\n ring\n apply Summable.of_nat_of_neg\n · exact h.congr (fun n => by simp)\n · exact h.congr (fun n => by simp)\ntheorem radial_exp_periodic_norm_summable (a : ℝ) (ha : 0 < a)\n (f : C(ℝ, ℂ)) (hf : ∀ x : ℝ, f x = Complex.exp (-a * |x| : ℝ))\n (K : TopologicalSpace.Compacts ℝ) :\n Summable (fun n : ℤ => ‖(f.comp (ContinuousMap.addRight (n : ℝ))).restrict K‖) := by\n obtain ⟨R, hR⟩ := K.isCompact.isBounded.subset_closedBall (0 : ℝ)\n apply ((radial_exp_int_summable a ha).mul_left (Real.exp (a * R))).of_nonneg_of_le\n (fun n => norm_nonneg _) (fun n => ?_)\n rw [ContinuousMap.norm_le _ (by positivity)]\n intro y\n change ‖f ((y : ℝ) + (n : ℝ))‖ ≤ _\n rw [hf, Complex.norm_exp, Complex.ofReal_re, ← Real.exp_add]\n apply Real.exp_le_exp.mpr\n have hy : |(y : ℝ)| ≤ R := by\n simpa only [Metric.mem_closedBall, Real.dist_eq, sub_zero] using hR y.property\n have hn : |(n : ℝ)| ≤ |(y : ℝ) + (n : ℝ)| + R := by\n calc\n _ = |((y : ℝ) + (n : ℝ)) - (y : ℝ)| := by congr 1; ring\n _ ≤ |(y : ℝ) + (n : ℝ)| + |(y : ℝ)| := by\n simpa using (abs_sub_le ((y : ℝ) + (n : ℝ)) 0 (y : ℝ))\n _ ≤ _ := add_le_add (le_refl _) hy\n nlinarith\ntheorem radial_exp_abs_fourier_scaled (ξ : ℝ) (hξ : 0 < ξ) (v : ℝ) :\n FourierTransform.fourier\n (fun x : ℝ => Complex.exp (- (2 * Real.pi * ξ) * |x| : ℝ)) v =\n ((ξ / Real.pi : ℝ) : ℂ) / ((ξ ^ 2 + v ^ 2 : ℝ) : ℂ) := by\n rw [radial_exp_abs_fourier (2 * Real.pi * ξ) (by positivity)]\n have hd : (ξ : ℂ) ^ 2 + (v : ℂ) ^ 2 ≠ 0 := by\n exact_mod_cast (ne_of_gt (show 0 < ξ ^ 2 + v ^ 2 by positivity))\n have hd' : (2 * (Real.pi : ℂ) * (ξ : ℂ)) ^ 2 +\n (2 * (Real.pi : ℂ) * (v : ℂ)) ^ 2 ≠ 0 := by\n exact_mod_cast (ne_of_gt (show 0 < (2 * Real.pi * ξ) ^ 2 +\n (2 * Real.pi * v) ^ 2 by positivity))\n push_cast\n field_simp [hd, hd', Complex.ofReal_ne_zero.mpr Real.pi_ne_zero]\ntheorem radial_exp_periodization (a x : ℝ) (ha : 0 < a)\n (hx : 0 ≤ x) (hx' : x ≤ 1) :\n (∑' n : ℤ, Real.exp (-a * |x + (n : ℝ)|)) =\n (Real.exp (-a * x) + Real.exp (-a + a * x)) / (1 - Real.exp (-a)) := by\n let q := Real.exp (-a)\n let g : ℤ → ℝ := fun n => Real.exp (-a * |x + (n : ℝ)|)\n have hq0 : 0 ≤ q := (Real.exp_pos _).le\n have hq1 : q < 1 := Real.exp_lt_one_iff.mpr (by linarith)\n have hq : Summable (fun n : ℕ => q ^ n) := summable_geometric_of_lt_one hq0 hq1\n have hnat (n : ℕ) : g n = Real.exp (-a * x) * q ^ n := by\n dsimp only [g, q]\n rw [Int.cast_natCast, abs_of_nonneg (by positivity),\n ← Real.exp_nat_mul, ← Real.exp_add]\n congr 1\n ring\n have hneg (n : ℕ) : g (-(n + 1)) = Real.exp (-a + a * x) * q ^ n := by\n dsimp only [g, q]\n push_cast\n rw [abs_of_nonpos (by linarith [show 0 ≤ (n : ℝ) by positivity]),\n ← Real.exp_nat_mul, ← Real.exp_add]\n congr 1\n ring\n have hn : Summable (fun n : ℕ => g n) :=\n (hq.mul_left (Real.exp (-a * x))).congr (fun n => (hnat n).symm)\n have hm : Summable (fun n : ℕ => g (-(n + 1))) :=\n (hq.mul_left (Real.exp (-a + a * x))).congr (fun n => (hneg n).symm)\n change (∑' n : ℤ, g n) = _\n rw [tsum_of_nat_of_neg_add_one hn hm]\n simp_rw [hnat, hneg]\n rw [tsum_mul_left, tsum_mul_left, tsum_geometric_of_lt_one hq0 hq1]\n dsimp only [q]\n ring\ntheorem radial_cos_resolvent_summable (ξ θ : ℝ) (hξ : 0 < ξ) :\n Summable (fun n : ℤ => Real.cos ((n : ℝ) * θ) / (ξ ^ 2 + (n : ℝ) ^ 2)) := by\n apply (radial_resolvent_int_summable ξ).of_norm_bounded\n intro n\n rw [Real.norm_eq_abs, abs_div,\n abs_of_pos (show 0 < ξ ^ 2 + (n : ℝ) ^ 2 by positivity)]\n exact div_le_div_of_nonneg_right (Real.abs_cos_le_one _) (by positivity)\ntheorem radial_resolvent_periodization (ξ x : ℝ) (hξ : 0 < ξ) :\n (ξ / Real.pi) *\n (∑' n : ℤ, Real.cos (2 * Real.pi * (n : ℝ) * x) / (ξ ^ 2 + (n : ℝ) ^ 2)) =\n ∑' n : ℤ, Real.exp (-(2 * Real.pi * ξ) * |x + (n : ℝ)|) := by\n let f : C(ℝ, ℂ) := ⟨fun t : ℝ =>\n Complex.exp (-(2 * Real.pi * ξ) * |t| : ℝ), by fun_prop⟩\n have hcoef (n : ℤ) : FourierTransform.fourier (f : ℝ → ℂ) (n : ℝ) =\n ((ξ / Real.pi : ℝ) : ℂ) / ((ξ ^ 2 + (n : ℝ) ^ 2 : ℝ) : ℂ) :=\n radial_exp_abs_fourier_scaled ξ hξ n\n have hc : Summable (fun n : ℤ => (ξ / Real.pi) / (ξ ^ 2 + (n : ℝ) ^ 2)) := by\n simpa only [div_eq_mul_inv, one_div, one_mul] using\n (radial_resolvent_int_summable ξ).mul_left (ξ / Real.pi)\n have hs : Summable (fun n : ℤ => FourierTransform.fourier (f : ℝ → ℂ) (n : ℝ)) := by\n apply hc.of_norm_bounded\n intro n\n rw [hcoef, ← Complex.ofReal_div, Complex.norm_real, Real.norm_eq_abs,\n abs_of_nonneg (by positivity)]\n have hsphase : Summable (fun n : ℤ =>\n FourierTransform.fourier (f : ℝ → ℂ) (n : ℝ) * fourier n (x : UnitAddCircle)) := by\n apply hc.of_norm_bounded\n intro n\n rw [hcoef, norm_mul, fourier_apply, Circle.norm_coe, mul_one,\n ← Complex.ofReal_div, Complex.norm_real, Real.norm_eq_abs,\n abs_of_nonneg (by positivity)]\n have hpoint (n : ℤ) :\n (FourierTransform.fourier (f : ℝ → ℂ) (n : ℝ) * fourier n (x : UnitAddCircle)).re =\n (ξ / Real.pi) * (Real.cos (2 * Real.pi * (n : ℝ) * x) /\n (ξ ^ 2 + (n : ℝ) ^ 2)) := by\n rw [hcoef, fourier_coe_apply]\n simp only [Complex.ofReal_one, div_one]\n have hangle : 2 * (Real.pi : ℂ) * Complex.I * (n : ℂ) * (x : ℂ) =\n ((2 * Real.pi * (n : ℝ) * x : ℝ) : ℂ) * Complex.I := by\n push_cast\n ring\n rw [hangle, ← Complex.ofReal_div]\n simp only [Complex.mul_re, Complex.ofReal_re, Complex.ofReal_im,\n zero_mul, sub_zero, Complex.exp_ofReal_mul_I_re]\n ring\n have hp := Real.tsum_eq_tsum_fourier (f := f)\n (fun K => radial_exp_periodic_norm_summable (2 * Real.pi * ξ) (by positivity)\n f (fun _ => rfl) K) hs x\n have hre := congrArg Complex.re hp\n have hleft : (∑' n : ℤ, f (x + (n : ℝ))).re =\n ∑' n : ℤ, Real.exp (-(2 * Real.pi * ξ) * |x + (n : ℝ)|) := by\n change (∑' n : ℤ, Complex.exp (-(2 * Real.pi * ξ) * |x + (n : ℝ)| : ℝ)).re = _\n simp_rw [← Complex.ofReal_exp]\n rw [← Complex.ofReal_tsum, Complex.ofReal_re]\n rw [hleft, Complex.re_tsum hsphase] at hre\n simp_rw [hpoint] at hre\n rw [tsum_mul_left] at hre\n exact hre.symm\ntheorem radial_green_fourier_series (ξ θ : ℝ) (hξ : 0 < ξ)\n (hθ : θ ∈ Set.Icc (-2 * Real.pi) (2 * Real.pi)) :\n Summable (fun n : ℤ => Real.cos ((n : ℝ) * θ) / (ξ ^ 2 + (n : ℝ) ^ 2)) ∧\n (∑' n : ℤ, Real.cos ((n : ℝ) * θ) / (ξ ^ 2 + (n : ℝ) ^ 2)) =\n Real.pi * Real.cosh (ξ * (Real.pi - |θ|)) / (ξ * Real.sinh (Real.pi * ξ)) := by\n refine ⟨radial_cos_resolvent_summable ξ θ hξ, ?_⟩\n let x := |θ| / (2 * Real.pi)\n have hx : 0 ≤ x := by positivity\n have hθabs : |θ| ≤ 2 * Real.pi := abs_le.mpr ⟨by nlinarith [hθ.1], hθ.2⟩\n have hx' : x ≤ 1 := (div_le_one (by positivity : 0 < 2 * Real.pi)).mpr hθabs\n have hm : (2 * Real.pi * ξ) * x = ξ * |θ| := by\n dsimp only [x]\n field_simp [Real.pi_ne_zero]\n have hrate : 2 * Real.pi * ξ = 2 * (Real.pi * ξ) := by ring\n have hcos (n : ℤ) : Real.cos (2 * Real.pi * (n : ℝ) * x) =\n Real.cos ((n : ℝ) * θ) := by\n have hn : 2 * Real.pi * (n : ℝ) * x = (n : ℝ) * |θ| := by\n dsimp only [x]\n field_simp [Real.pi_ne_zero]\n rw [hn]\n by_cases hθ0 : 0 ≤ θ\n · rw [abs_of_nonneg hθ0]\n · rw [abs_of_neg (lt_of_not_ge hθ0), mul_neg, Real.cos_neg]\n have hp := radial_resolvent_periodization ξ x hξ\n rw [radial_exp_periodization (2 * Real.pi * ξ) x (by positivity) hx hx'] at hp\n simp_rw [hcos] at hp\n have hhyper :\n (Real.exp (-(2 * Real.pi * ξ) * x) +\n Real.exp (-(2 * Real.pi * ξ) + (2 * Real.pi * ξ) * x)) /\n (1 - Real.exp (-(2 * Real.pi * ξ))) =\n Real.cosh (ξ * (Real.pi - |θ|)) / Real.sinh (Real.pi * ξ) := by\n rw [show ξ * (Real.pi - |θ|) = Real.pi * ξ - ξ * |θ| by ring,\n radial_cosh_periodic_decay (Real.pi * ξ) (ξ * |θ|) (by positivity)]\n rw [neg_mul, hm, hrate]\n have hscale := hp.trans hhyper\n have hsinh : Real.sinh (Real.pi * ξ) ≠ 0 :=\n (Real.sinh_pos_iff.mpr (by positivity : 0 < Real.pi * ξ)).ne'\n field_simp [hξ.ne', Real.pi_ne_zero, hsinh] at hscale ⊢\n simpa only [mul_comm, mul_left_comm, mul_assoc] using hscale\ntheorem adjoin_power_degree_le_two {K : Type*} [Field K] [NumberField K] (α : K) :\n Module.finrank ℚ (IntermediateField.adjoin ℚ {α}) ≤\n 2 * Module.finrank ℚ (IntermediateField.adjoin ℚ {α ^ 2}) := by\n let E : IntermediateField ℚ K := IntermediateField.adjoin ℚ {α}\n let F : IntermediateField ℚ K := IntermediateField.adjoin ℚ {α ^ 2}\n let : Algebra ℚ E := E.algebra'\n let : Algebra ℚ F := F.algebra'\n have hFE : F ≤ E := by\n apply IntermediateField.adjoin_simple_le_iff.mpr\n simpa only [pow_two] using E.mul_mem\n (IntermediateField.mem_adjoin_simple_self ℚ α)\n (IntermediateField.mem_adjoin_simple_self ℚ α)\n let : Algebra F E := (IntermediateField.inclusion hFE).toRingHom.toAlgebra\n let : IsScalarTower ℚ F E := IsScalarTower.of_algHom (IntermediateField.inclusion hFE)\n let : FiniteDimensional ℚ E := IntermediateField.finiteDimensional_left E\n let : FiniteDimensional ℚ F := IntermediateField.finiteDimensional_left F\n let : FiniteDimensional F E := FiniteDimensional.right ℚ F E\n let a : E := IntermediateField.AdjoinSimple.gen ℚ α\n let b : F := IntermediateField.AdjoinSimple.gen ℚ (α ^ 2)\n have hprim : IntermediateField.adjoin ℚ {a} = ⊤ := by\n apply IntermediateField.lift_injective E\n rw [IntermediateField.lift_adjoin_simple, IntermediateField.lift_top]\n rfl\n have hquad : Polynomial.aeval a (Polynomial.X ^ 2 - Polynomial.C b) = 0 := by\n simp only [map_sub, map_pow, Polynomial.aeval_X, Polynomial.aeval_C]\n apply Subtype.ext\n change α ^ 2 - α ^ 2 = 0\n exact sub_self _\n have hupper : Module.finrank F E ≤ 2 := by\n have hdegree := IntermediateField.adjoin.finrank (IsIntegral.of_finite F a)\n rw [IntermediateField.adjoin_eq_top_of_adjoin_eq_top ℚ hprim,\n IntermediateField.finrank_top'] at hdegree\n rw [hdegree]\n have hbound := Polynomial.natDegree_le_natDegree\n (minpoly.min F a (Polynomial.monic_X_pow_sub_C b (by decide : (2 : ℕ) ≠ 0)) hquad)\n simpa only [Polynomial.natDegree_X_pow_sub_C] using hbound\n change Module.finrank ℚ E ≤ 2 * Module.finrank ℚ F\n rw [← Module.finrank_mul_finrank ℚ F E]\n calc\n Module.finrank ℚ F * Module.finrank F E ≤ Module.finrank ℚ F * 2 :=\n Nat.mul_le_mul_left _ hupper\n _ = 2 * Module.finrank ℚ F := Nat.mul_comm _ _\ntheorem even_odd_power_transform_coeff_zero (F : Polynomial ℤ) :\n ((Polynomial.contract 2 F) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX F)) ^ 2).coeff 0 =\n F.coeff 0 ^ 2 := by\n simp [pow_two, Polynomial.mul_coeff_zero, Polynomial.coeff_contract]\ntheorem even_odd_power_transform_mod_two (F : Polynomial ℤ) :\n ∃ H : Polynomial ℤ,\n (Polynomial.contract 2 F) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX F)) ^ 2 = F + 2 * H := by\n let T : Polynomial ℤ → Polynomial ℤ := fun P =>\n (Polynomial.contract 2 P) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX P)) ^ 2\n let f := Int.castRingHom (ZMod 2)\n have hneg : -(Polynomial.X : Polynomial (ZMod 2)) = Polynomial.X := by\n ext n\n simp only [Polynomial.coeff_neg]\n exact ZMod.neg_eq_self_mod_two _\n have hsubst := congrArg (fun P : Polynomial ℤ => P.map f)\n (even_odd_power_transform_subst F)\n change ((T F).comp (Polynomial.X ^ 2)).map f = (F * F.comp (-Polynomial.X)).map f\n at hsubst\n simp only [Polynomial.map_comp, Polynomial.map_pow, Polynomial.map_X,\n Polynomial.map_mul, Polynomial.map_neg, hneg, Polynomial.comp_X] at hsubst\n have hmap : (T F).map f = F.map f := by\n apply Polynomial.expand_injective (by norm_num : 0 < (2 : ℕ))\n change ((T F).map f).comp (Polynomial.X ^ 2) =\n (F.map f).comp (Polynomial.X ^ 2)\n rw [hsubst, ← pow_two]\n simpa only [ZMod.frobenius_zmod, Polynomial.map_id,\n Polynomial.expand_eq_comp_X_pow] using\n (Polynomial.map_frobenius_expand 2 (F.map f)).symm\n have hzero : (T F - F).map f = 0 := by\n rw [Polynomial.map_sub, hmap, sub_self]\n have hdiv : Polynomial.C (2 : ℤ) ∣ T F - F := by\n apply (Polynomial.C_dvd_iff_dvd_coeff _ _).mpr\n intro n\n apply (ZMod.intCast_zmod_eq_zero_iff_dvd ((T F - F).coeff n) 2).mp\n have hc := congrArg (fun P : Polynomial (ZMod 2) => P.coeff n) hzero\n simpa only [Polynomial.coeff_map, f, Int.coe_castRingHom, Polynomial.coeff_zero] using hc\n obtain ⟨H, hH⟩ := hdiv\n refine ⟨H, ?_⟩\n change T F = F + 2 * H\n simpa only [Polynomial.C_ofNat, add_comm] using (sub_eq_iff_eq_add.mp hH)\ntheorem even_odd_power_transform_add_twice (F H : Polynomial ℤ) :\n let T : Polynomial ℤ → Polynomial ℤ := fun P =>\n (Polynomial.contract 2 P) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX P)) ^ 2\n let A := Polynomial.contract 2 F\n let B := Polynomial.contract 2 (Polynomial.divX F)\n let E := Polynomial.contract 2 H\n let D := Polynomial.contract 2 (Polynomial.divX H)\n T (F + 2 * H) = T F + 4 * (A * E + E ^ 2 - Polynomial.X * (B * D + D ^ 2)) := by\n dsimp only\n have hA : Polynomial.contract 2 (F + 2 * H) =\n Polynomial.contract 2 F + 2 * Polynomial.contract 2 H := by\n ext n\n simp [Polynomial.coeff_contract]\n have hB : Polynomial.contract 2 (Polynomial.divX (F + 2 * H)) =\n Polynomial.contract 2 (Polynomial.divX F) +\n 2 * Polynomial.contract 2 (Polynomial.divX H) := by\n ext n\n simp [Polynomial.coeff_contract, Polynomial.coeff_divX]\n rw [hA, hB]\n ring\ntheorem even_odd_power_transform_mod_four (F : Polynomial ℤ) (hF : F.coeff 0 = 1) :\n let T : Polynomial ℤ → Polynomial ℤ := fun P =>\n (Polynomial.contract 2 P) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX P)) ^ 2\n ∃ Q : Polynomial ℤ, T (T F) = T F + 4 * Q ∧ Q.coeff 0 = 0 := by\n let T : Polynomial ℤ → Polynomial ℤ := fun P =>\n (Polynomial.contract 2 P) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX P)) ^ 2\n change ∃ Q : Polynomial ℤ, T (T F) = T F + 4 * Q ∧ Q.coeff 0 = 0\n obtain ⟨H, hH⟩ := even_odd_power_transform_mod_two F\n change T F = F + 2 * H at hH\n have hH0 : H.coeff 0 = 0 := by\n have hc := congrArg (fun P : Polynomial ℤ => P.coeff 0) hH\n change (T F).coeff 0 = (F + 2 * H).coeff 0 at hc\n rw [even_odd_power_transform_coeff_zero, hF] at hc\n simp only [one_pow, Polynomial.coeff_add, Polynomial.coeff_ofNat_mul, hF] at hc\n omega\n let Q := Polynomial.contract 2 F * Polynomial.contract 2 H +\n (Polynomial.contract 2 H) ^ 2 - Polynomial.X *\n (Polynomial.contract 2 (Polynomial.divX F) *\n Polynomial.contract 2 (Polynomial.divX H) +\n (Polynomial.contract 2 (Polynomial.divX H)) ^ 2)\n refine ⟨Q, ?_, ?_⟩\n · calc\n T (T F) = T (F + 2 * H) := congrArg T hH\n _ = T F + 4 * Q := even_odd_power_transform_add_twice F H\n · simp [Q, pow_two, Polynomial.mul_coeff_zero, Polynomial.coeff_contract, hH0]\ntheorem minpoly_sq_degree_dichotomy {K : Type*} [Field K] [NumberField K] (α : K) :\n (minpoly ℚ α).natDegree = (minpoly ℚ (α ^ 2)).natDegree ∨\n (minpoly ℚ α).natDegree = 2 * (minpoly ℚ (α ^ 2)).natDegree := by\n have hFE : IntermediateField.adjoin ℚ {α ^ 2} ≤ IntermediateField.adjoin ℚ {α} := by\n apply IntermediateField.adjoin_simple_le_iff.mpr\n simpa only [pow_two] using (IntermediateField.adjoin ℚ {α}).mul_mem\n (IntermediateField.mem_adjoin_simple_self ℚ α)\n (IntermediateField.mem_adjoin_simple_self ℚ α)\n have hE := IntermediateField.adjoin.finrank (IsIntegral.of_finite ℚ α)\n have hF := IntermediateField.adjoin.finrank (IsIntegral.of_finite ℚ (α ^ 2))\n have hdvd := IntermediateField.finrank_dvd_of_le_right hFE\n have hbound := adjoin_power_degree_le_two α\n rw [hE, hF] at hdvd hbound\n have hpos := minpoly.natDegree_pos (IsIntegral.of_finite ℚ α)\n have hposSq := minpoly.natDegree_pos (IsIntegral.of_finite ℚ (α ^ 2))\n obtain ⟨r, hr⟩ := hdvd\n have hrpos : 0 < r := by\n by_contra h\n have hrzero : r = 0 := by omega\n rw [hr, hrzero, mul_zero] at hpos\n exact (lt_irrefl (0 : ℕ)) hpos\n have hrle : r ≤ 2 := by\n have hmul : (minpoly ℚ (α ^ 2)).natDegree * r ≤\n (minpoly ℚ (α ^ 2)).natDegree * 2 := by\n simpa only [hr, Nat.mul_comm] using hbound\n exact le_of_mul_le_mul_left hmul hposSq\n have hcases : r = 1 ∨ r = 2 := by omega\n rcases hcases with h | h\n · left\n simpa only [h, mul_one] using hr\n · right\n simpa only [h, Nat.mul_comm] using hr\ntheorem minpoly_sq_comp_of_degree_drop {K : Type*} [Field K] [NumberField K]\n (α : K) (hdrop : (minpoly ℚ (α ^ 2)).natDegree < (minpoly ℚ α).natDegree) :\n (minpoly ℚ (α ^ 2)).comp (Polynomial.X ^ 2) = minpoly ℚ α := by\n have hα := IsIntegral.of_finite ℚ α\n have hαsq := IsIntegral.of_finite ℚ (α ^ 2)\n have hdegree : (minpoly ℚ α).natDegree = 2 * (minpoly ℚ (α ^ 2)).natDegree := by\n rcases minpoly_sq_degree_dichotomy α with h | h\n · omega\n · exact h\n have hmonic : ((minpoly ℚ (α ^ 2)).comp (Polynomial.X ^ 2)).Monic :=\n (minpoly.monic hαsq).comp (Polynomial.monic_X_pow 2) (by simp)\n apply minpoly.unique_of_degree_le_degree_minpoly ℚ α hmonic\n · simpa only [Polynomial.aeval_comp, map_pow, Polynomial.aeval_X] using\n minpoly.aeval ℚ (α ^ 2)\n · rw [Polynomial.degree_eq_natDegree hmonic.ne_zero,\n Polynomial.degree_eq_natDegree (minpoly.ne_zero hα),\n Polynomial.natDegree_comp, Polynomial.natDegree_X_pow, hdegree]\n simp only [Nat.mul_comm, le_refl]\ntheorem exists_embedding_neg_of_degree_drop {K : Type*} [Field K] [NumberField K]\n (α : K) (hdrop : (minpoly ℚ (α ^ 2)).natDegree < (minpoly ℚ α).natDegree)\n (σ : K →+* ℂ) : ∃ τ : K →+* ℂ, τ α = -(σ α) := by\n have hcomp := minpoly_sq_comp_of_degree_drop α hdrop\n have hroot : Polynomial.aeval (-(σ α)) (minpoly ℚ α) = 0 := by\n have hσ := minpoly.aeval_algHom ℚ σ.toRatAlgHom α\n rw [← hcomp, Polynomial.aeval_comp] at hσ ⊢\n simpa only [map_pow, Polynomial.aeval_X, neg_sq, RingHom.toRatAlgHom_apply] using hσ\n have hmem : -(σ α) ∈ (minpoly ℚ α).rootSet ℂ :=\n Polynomial.mem_rootSet.mpr ⟨minpoly.ne_zero (IsIntegral.of_finite ℚ α), hroot⟩\n rw [← NumberField.Embeddings.range_eval_eq_rootSet_minpoly K ℂ α] at hmem\n exact hmem\ntheorem angle_card_double_of_antipodal (s : Finset Real.Angle)\n (hclosed : ∀ θ ∈ s, θ + (Real.pi : Real.Angle) ∈ s) :\n 2 * (@Finset.image Real.Angle Real.Angle (Classical.decEq _)\n (fun θ => (2 : ℕ) • θ) s).card = s.card := by\n classical\n have hfiber : ∀ β ∈ s.image (fun θ => (2 : ℕ) • θ),\n (s.filter fun θ => (2 : ℕ) • θ = β).card = 2 := by\n intro β hβ\n obtain ⟨θ, hθ, hθβ⟩ := Finset.mem_image.mp hβ\n have hpair : s.filter (fun ψ => (2 : ℕ) • ψ = β) =\n {θ, θ + (Real.pi : Real.Angle)} := by\n ext ψ\n simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton]\n constructor\n · rintro ⟨_, hψ⟩\n exact Real.Angle.two_nsmul_eq_iff.mp (hψ.trans hθβ.symm)\n · rintro (rfl | rfl)\n · exact ⟨hθ, hθβ⟩\n · refine ⟨hclosed θ hθ, ?_⟩\n simpa only [smul_add, Real.Angle.two_nsmul_coe_pi, add_zero] using hθβ\n rw [hpair]\n apply Finset.card_pair\n intro h\n apply Real.Angle.pi_ne_zero\n simpa using congrArg (fun ψ : Real.Angle => -θ + ψ) h.symm\n have hcount := Finset.card_eq_sum_card_image (fun θ : Real.Angle => (2 : ℕ) • θ) s\n rw [Finset.sum_const_nat hfiber] at hcount\n simpa only [Nat.mul_comm] using hcount.symm\ntheorem embedding_angle_card {K : Type*} [Field K] [NumberField K] (α : K) :\n (@Finset.image (K →+* ℂ) Real.Angle (Classical.decEq _)\n (fun σ => ((σ α).arg : Real.Angle)) Finset.univ).card =\n (Finset.univ.image fun σ : K →+* ℂ => (σ α).arg).card := by\n classical\n have h := Finset.card_image_of_injective\n (Finset.univ.image fun σ : K →+* ℂ => ((σ α).arg : Real.Angle))\n Real.Angle.toReal_injective\n rw [Finset.image_image] at h\n simpa only [Function.comp_def, Complex.arg_coe_angle_toReal_eq_arg] using h.symm\ntheorem argument_card_sq_of_degree_drop {K : Type*} [Field K] [NumberField K]\n (α : K) (hα : α ≠ 0)\n (hdrop : (minpoly ℚ (α ^ 2)).natDegree < (minpoly ℚ α).natDegree) :\n 2 * (Finset.univ.image fun σ : K →+* ℂ ↦ (σ (α ^ 2)).arg).card =\n (Finset.univ.image fun σ : K →+* ℂ ↦ (σ α).arg).card := by\n classical\n let s : Finset Real.Angle :=\n Finset.univ.image fun σ : K →+* ℂ => ((σ α).arg : Real.Angle)\n have hclosed : ∀ θ ∈ s, θ + (Real.pi : Real.Angle) ∈ s := by\n intro θ hθ\n obtain ⟨σ, _, rfl⟩ := Finset.mem_image.mp hθ\n obtain ⟨τ, hτ⟩ := exists_embedding_neg_of_degree_drop α hdrop σ\n apply Finset.mem_image.mpr\n refine ⟨τ, Finset.mem_univ τ, ?_⟩\n rw [hτ]\n exact Complex.arg_neg_coe_angle ((map_ne_zero σ).mpr hα)\n have himage :\n (Finset.univ.image fun σ : K →+* ℂ => ((σ (α ^ 2)).arg : Real.Angle)) =\n s.image (fun θ => (2 : ℕ) • θ) := by\n dsimp only [s]\n rw [Finset.image_image]\n apply Finset.image_congr\n intro σ _\n change ((σ (α ^ 2)).arg : Real.Angle) = (2 : ℕ) • ((σ α).arg : Real.Angle)\n rw [map_pow]\n exact Complex.arg_pow_coe_angle (σ α) 2\n have hcount := angle_card_double_of_antipodal s hclosed\n rw [← himage, embedding_angle_card (α ^ 2)] at hcount\n change 2 * (Finset.univ.image fun σ : K →+* ℂ => (σ (α ^ 2)).arg).card =\n (Finset.univ.image fun σ : K →+* ℂ => ((σ α).arg : Real.Angle)).card at hcount\n rw [embedding_angle_card α] at hcount\n exact hcount\ntheorem polynomial_eq_of_monic_irreducible_mul_eq_sq\n {k : Type*} [Field k] {P Q G : Polynomial k}\n (hP : P.Monic) (hPirr : Irreducible P) (hQ : Q.Monic)\n (hdegree : Q.natDegree = P.natDegree) (hsq : G ^ 2 = P * Q) : Q = P := by\n have hPG : P ∣ G := hPirr.prime.dvd_of_dvd_pow (by\n rw [hsq]\n exact dvd_mul_right P Q)\n have hP2 : P ^ 2 ∣ G ^ 2 := pow_dvd_pow_of_dvd hPG 2\n have hPQ : P ∣ Q := (mul_dvd_mul_iff_left hP.ne_zero).mp (by\n simpa only [pow_two, hsq] using hP2)\n exact Polynomial.eq_of_monic_of_dvd_of_natDegree_le hP hQ hPQ hdegree.le\ntheorem polynomial_reverse_eq_of_monic_irreducible_mul_eq_sq\n {k : Type*} [Field k] {P Q G : Polynomial k}\n (hP : P.reverse.Monic) (hPirr : Irreducible P.reverse)\n (hQ : Q.reverse.Monic)\n (hdegree : Q.reverse.natDegree = P.reverse.natDegree)\n (hsq : G ^ 2 = P * Q) : Q.reverse = P.reverse := by\n have hreverse : G.reverse ^ 2 = P.reverse * Q.reverse := by\n simpa only [pow_two, Polynomial.reverse_mul_of_domain] using\n congrArg Polynomial.reverse hsq\n exact polynomial_eq_of_monic_irreducible_mul_eq_sq hP hPirr hQ hdegree hreverse\ntheorem radial_integral_square_root_is_polynomial\n (n : ℕ) (b : Fin (2 * n) → ℂ) (F : Polynomial ℤ) (S : PowerSeries ℤ)\n (hS₀ : PowerSeries.constantCoeff S = 1)\n (hS : S ^ 2 = (F : PowerSeries ℤ))\n (hF : F.map (Int.castRingHom ℂ) =\n ∏ i : Fin (2 * n), (1 - Polynomial.C (b i) * Polynomial.X))\n (hcontract : ∃ p : Polynomial ℂ, p.Monic ∧ 0 < p.natDegree ∧\n ∃ q : ℝ, 0 ≤ q ∧ q < 1 ∧ ∀ i : Fin (2 * n), ∀ t : ℝ,\n 0 ≤ t → t ≤ 1 → ‖p.eval ((t : ℂ) * b i)‖ ≤ q) :\n ∃ G : Polynomial ℚ, G ^ 2 = F.map (Int.castRingHom ℚ) := by\n classical\n have hSC : (PowerSeries.map (Int.castRingHom ℂ) S) ^ 2 =\n ∏ i : Fin (2 * n), (1 - PowerSeries.C (b i) * PowerSeries.X) := by\n have hmap : (PowerSeries.map (Int.castRingHom ℂ) S) ^ 2 =\n (F.map (Int.castRingHom ℂ) : PowerSeries ℂ) := by\n simpa only [map_pow, ← Polynomial.polynomial_map_coe] using\n congrArg (PowerSeries.map (Int.castRingHom ℂ)) hS\n rw [hF] at hmap\n have hprod :\n ((∏ i : Fin (2 * n), (1 - Polynomial.C (b i) * Polynomial.X) :\n Polynomial ℂ) : PowerSeries ℂ) =\n ∏ i : Fin (2 * n), (1 - PowerSeries.C (b i) * PowerSeries.X) := by\n change Polynomial.coeToPowerSeries.ringHom (∏ i : Fin (2 * n),\n (1 - Polynomial.C (b i) * Polynomial.X)) = _\n rw [map_prod]\n simp only [Polynomial.coeToPowerSeries.ringHom_apply, Polynomial.coe_sub,\n Polynomial.coe_one, Polynomial.coe_mul, Polynomial.coe_C, Polynomial.coe_X]\n exact hmap.trans hprod\n obtain ⟨N, hN⟩ :=\n radial_formal_square_root_hankel_eventually_zero n b S hS₀ hSC hcontract\n have hzero : ∃ N : ℕ, ∀ m : ℕ, N ≤ m → Matrix.det\n (fun i j : Fin m => PowerSeries.coeff (n + 1 + i.val + j.val)\n (PowerSeries.map (Int.castRingHom ℚ) S)) = 0 := by\n refine ⟨N, fun m hm => ?_⟩\n have hdet := (Int.castRingHom ℚ).map_det\n (fun i j : Fin m => PowerSeries.coeff (n + 1 + i.val + j.val) S)\n rw [hN m hm, map_zero] at hdet\n have hmatrix : (Int.castRingHom ℚ).mapMatrix\n (fun i j : Fin m => PowerSeries.coeff (n + 1 + i.val + j.val) S) =\n (fun i j : Fin m => PowerSeries.coeff (n + 1 + i.val + j.val)\n (PowerSeries.map (Int.castRingHom ℚ) S)) := by\n ext i j\n exact (PowerSeries.coeff_map (Int.castRingHom ℚ) _ S).symm\n rw [hmatrix] at hdet\n exact hdet.symm\n apply rational_power_series_square_root_is_polynomial\n (PowerSeries.map (Int.castRingHom ℚ) S) (F.map (Int.castRingHom ℚ))\n · simpa only [map_pow, ← Polynomial.polynomial_map_coe] using\n congrArg (PowerSeries.map (Int.castRingHom ℚ)) hS\n · exact shifted_hankel_eventually_zero_rational\n (PowerSeries.map (Int.castRingHom ℚ) S) (n + 1) hzero\ntheorem radial_integral_factor_eq_of_contraction\n (n : ℕ) (b : Fin (2 * n) → ℂ) (F : Polynomial ℤ) (S : PowerSeries ℤ)\n (P Q : Polynomial ℚ)\n (hS₀ : PowerSeries.constantCoeff S = 1)\n (hS : S ^ 2 = (F : PowerSeries ℤ))\n (hF : F.map (Int.castRingHom ℂ) =\n ∏ i : Fin (2 * n), (1 - Polynomial.C (b i) * Polynomial.X))\n (hcontract : ∃ p : Polynomial ℂ, p.Monic ∧ 0 < p.natDegree ∧\n ∃ q : ℝ, 0 ≤ q ∧ q < 1 ∧ ∀ i : Fin (2 * n), ∀ t : ℝ,\n 0 ≤ t → t ≤ 1 → ‖p.eval ((t : ℂ) * b i)‖ ≤ q)\n (hP : P.Monic) (hPirr : Irreducible P) (hQ : Q.Monic)\n (hdegree : Q.natDegree = P.natDegree)\n (hfactor : F.map (Int.castRingHom ℚ) = P * Q) : Q = P := by\n obtain ⟨G, hG⟩ :=\n radial_integral_square_root_is_polynomial n b F S hS₀ hS hF hcontract\n exact polynomial_eq_of_monic_irreducible_mul_eq_sq\n hP hPirr hQ hdegree (hG.trans hfactor)\ntheorem radial_angular_resolvent_energy_bound (m : ℕ) (hm : 0 < m)\n (θ : Fin m → ℝ) (hθ : ∀ i, θ i ∈ Set.Ico 0 (2 * Real.pi))\n (hinj : Function.Injective θ) (ξ : ℝ) (hξ : 0 < ξ) (w : Fin m → ℂ) :\n Real.pi / ((m : ℝ) * ξ * Real.tanh (Real.pi * ξ / m)) * ‖∑ i, w i‖ ^ 2 ≤\n ∑ i, ∑ j, (star (w i) * w j).re *\n (∑' n : ℤ, Real.cos ((n : ℝ) * (θ i - θ j)) /\n (ξ ^ 2 + (n : ℝ) ^ 2)) := by\n classical\n have hmR : (0 : ℝ) < m := by exact_mod_cast hm\n have ht : 0 < Real.tanh (Real.pi * ξ / m) := by\n rw [Real.tanh_eq_sinh_div_cosh]\n exact div_pos (Real.sinh_pos_iff.mpr (by positivity)) (Real.cosh_pos _)\n have hsinh : Real.sinh (Real.pi * ξ) ≠ 0 :=\n (Real.sinh_pos_iff.mpr (by positivity : 0 < Real.pi * ξ)).ne'\n have hp (i j : Fin m) : θ i - θ j ∈ Set.Icc (-2 * Real.pi) (2 * Real.pi) :=\n ⟨by linarith [(hθ i).1, (hθ j).2], by linarith [(hθ i).2, (hθ j).1]⟩\n have h := radial_angular_green_energy_bound m hm θ hθ hinj ξ hξ w\n have hbound : ‖∑ i, w i‖ ^ 2 ≤\n (2 * ξ * m * Real.tanh (Real.pi * ξ / m)) *\n (∑ i, ∑ j, (star (w i) * w j).re *\n (Real.cosh (ξ * (Real.pi - |θ i - θ j|)) /\n (2 * ξ * Real.sinh (Real.pi * ξ)))) := by\n simpa only [Complex.re_sum, Complex.mul_re, Complex.ofReal_re, Complex.ofReal_im,\n mul_zero, sub_zero] using h\n have heq :\n (∑ i, ∑ j, (star (w i) * w j).re *\n (∑' n : ℤ, Real.cos ((n : ℝ) * (θ i - θ j)) /\n (ξ ^ 2 + (n : ℝ) ^ 2))) =\n (2 * Real.pi) * (∑ i, ∑ j, (star (w i) * w j).re *\n (Real.cosh (ξ * (Real.pi - |θ i - θ j|)) /\n (2 * ξ * Real.sinh (Real.pi * ξ)))) := by\n simp_rw [(radial_green_fourier_series ξ _ hξ (hp _ _)).2]\n simp only [Finset.mul_sum]\n apply Finset.sum_congr rfl\n intro i _\n apply Finset.sum_congr rfl\n intro j _\n field_simp\n rw [heq]\n have hnorm (x : ℝ) :\n Real.pi / ((m : ℝ) * ξ * Real.tanh (Real.pi * ξ / m)) *\n ((2 * ξ * m * Real.tanh (Real.pi * ξ / m)) * x) = (2 * Real.pi) * x := by\n field_simp\n exact (mul_le_mul_of_nonneg_left hbound (by positivity)).trans_eq (hnorm _)\ntheorem radial_resolvent_lattice_sum (m : ℕ) (hm : 0 < m) (ξ : ℝ) (hξ : 0 < ξ) :\n Summable (fun n : ℤ => 1 / (ξ ^ 2 + ((m : ℝ) * (n : ℝ)) ^ 2)) ∧\n (∑' n : ℤ, 1 / (ξ ^ 2 + ((m : ℝ) * (n : ℝ)) ^ 2)) =\n Real.pi / ((m : ℝ) * ξ * Real.tanh (Real.pi * ξ / m)) := by\n have hmR : (0 : ℝ) < m := by exact_mod_cast hm\n have ha : 0 < ξ / m := div_pos hξ hmR\n have h := radial_green_fourier_series (ξ / m) 0 ha\n ⟨by linarith [Real.pi_pos], by linarith [Real.pi_pos]⟩\n have heq (n : ℤ) :\n 1 / (ξ ^ 2 + ((m : ℝ) * (n : ℝ)) ^ 2) =\n (m : ℝ)⁻¹ ^ 2 * (Real.cos ((n : ℝ) * 0) / ((ξ / m) ^ 2 + (n : ℝ) ^ 2)) := by\n simp only [mul_zero, Real.cos_zero]\n field_simp\n refine ⟨(h.1.mul_left ((m : ℝ)⁻¹ ^ 2)).congr (fun n => (heq n).symm), ?_⟩\n simp_rw [heq]\n rw [tsum_mul_left, h.2, abs_zero, sub_zero, Real.tanh_eq_sinh_div_cosh]\n have hsinh : Real.sinh (Real.pi * ξ / m) ≠ 0 :=\n (Real.sinh_pos_iff.mpr (by positivity : 0 < Real.pi * ξ / m)).ne'\n rw [show Real.pi * (ξ / m) = Real.pi * ξ / m by ring]\n field_simp\ntheorem radial_fourier_cosine_square {ι : Type*} (s : Finset ι)\n (θ : ι → ℝ) (w : ι → ℂ) (v : ℝ) :\n (∑ i ∈ s, ∑ j ∈ s, (star (w i) * w j).re * Real.cos (v * (θ i - θ j))) =\n (‖∑ i ∈ s, w i * Complex.exp (((v * θ i : ℝ) : ℂ) * Complex.I)‖ ^ 2 +\n ‖∑ i ∈ s, w i * Complex.exp (((-v * θ i : ℝ) : ℂ) * Complex.I)‖ ^ 2) / 2 := by\n have hp := congrArg Complex.re (radial_fourier_square_expand s θ w v)\n have hn := congrArg Complex.re (radial_fourier_square_expand s θ w (-v))\n simp only [Complex.re_sum, Complex.ofReal_re, Complex.normSq_eq_norm_sq] at hp hn\n have heq (i j : ι) : (star (w i) * w j).re * Real.cos (v * (θ i - θ j)) =\n (((star (w i) * w j) * Complex.exp (((v * (θ j - θ i) : ℝ) : ℂ) * Complex.I)).re +\n ((star (w i) * w j) * Complex.exp (((-v * (θ j - θ i) : ℝ) : ℂ) * Complex.I)).re) / 2 := by\n simp only [Complex.mul_re, Complex.exp_ofReal_mul_I_re,\n Complex.exp_ofReal_mul_I_im, neg_mul, Real.cos_neg, Real.sin_neg]\n rw [show v * (θ i - θ j) = -(v * (θ j - θ i)) by ring, Real.cos_neg]\n ring\n simp_rw [heq]\n simpa only [Finset.sum_div, Finset.sum_add_distrib, add_div] using\n congrArg₂ (fun a b : ℝ => (a + b) / 2) hp hn\ntheorem radial_even_int_tsum_split (f : ℤ → ℝ) (hf : Summable f)\n (heven : ∀ n : ℤ, f (-n) = f n) :\n (∑' n : ℤ, f n) = f 0 + 2 * ∑' k : ℕ, f ((k : ℤ) + 1) := by\n have hp : Summable (fun k : ℕ => f (k : ℤ)) := hf.comp_injective Nat.cast_injective\n have hn : Summable (fun k : ℕ => f (-((k : ℤ) + 1))) :=\n hf.comp_injective (by\n intro a b h\n change -((a : ℤ) + 1) = -((b : ℤ) + 1) at h\n exact_mod_cast (by omega : (a : ℤ) = b))\n rw [tsum_of_nat_of_neg_add_one hp hn, hp.tsum_eq_zero_add]\n simp only [Nat.cast_add, Nat.cast_one, Nat.cast_zero]\n simp_rw [heven]\n ring\ntheorem radial_cosine_resolvent_tsum {ι : Type*} (s : Finset ι)\n (θ : ι → ℝ) (w : ι → ℂ) (ξ : ℝ) (hξ : 0 < ξ) :\n Summable (fun n : ℤ =>\n (∑ i ∈ s, ∑ j ∈ s, (star (w i) * w j).re *\n Real.cos ((n : ℝ) * (θ i - θ j))) / (ξ ^ 2 + (n : ℝ) ^ 2)) ∧\n (∑' n : ℤ,\n (∑ i ∈ s, ∑ j ∈ s, (star (w i) * w j).re *\n Real.cos ((n : ℝ) * (θ i - θ j))) / (ξ ^ 2 + (n : ℝ) ^ 2)) =\n ∑ i ∈ s, ∑ j ∈ s, (star (w i) * w j).re *\n (∑' n : ℤ, Real.cos ((n : ℝ) * (θ i - θ j)) / (ξ ^ 2 + (n : ℝ) ^ 2)) := by\n classical\n have hs (i j : ι) : Summable (fun n : ℤ => (star (w i) * w j).re *\n (Real.cos ((n : ℝ) * (θ i - θ j)) / (ξ ^ 2 + (n : ℝ) ^ 2))) :=\n (radial_cos_resolvent_summable ξ (θ i - θ j) hξ).mul_left _\n have hpoint (n : ℤ) :\n (∑ i ∈ s, ∑ j ∈ s, (star (w i) * w j).re *\n Real.cos ((n : ℝ) * (θ i - θ j))) / (ξ ^ 2 + (n : ℝ) ^ 2) =\n ∑ i ∈ s, ∑ j ∈ s, (star (w i) * w j).re *\n (Real.cos ((n : ℝ) * (θ i - θ j)) / (ξ ^ 2 + (n : ℝ) ^ 2)) := by\n simp only [Finset.sum_div, mul_div_assoc]\n refine ⟨(summable_sum (fun i _ => summable_sum (fun j _ => hs i j))).congr\n (fun n => (hpoint n).symm), ?_⟩\n simp_rw [hpoint]\n rw [Summable.tsum_finsetSum (fun i _ => summable_sum (fun j _ => hs i j))]\n apply Finset.sum_congr rfl\n intro i hi\n rw [Summable.tsum_finsetSum (fun j _ => hs i j)]\n simp_rw [tsum_mul_left]\ntheorem radial_positive_mode_resolvent_bound (m : ℕ) (hm : 0 < m)\n (θ : Fin m → ℝ) (hθ : ∀ i, θ i ∈ Set.Ico 0 (2 * Real.pi))\n (hinj : Function.Injective θ) (ξ : ℝ) (hξ : 0 < ξ) (w : Fin m → ℂ) :\n let P : ℝ → ℝ := fun v =>\n (‖∑ i, w i * Complex.exp (((v * θ i : ℝ) : ℂ) * Complex.I)‖ ^ 2 +\n ‖∑ i, w i * Complex.exp (((-v * θ i : ℝ) : ℂ) * Complex.I)‖ ^ 2) / 2\n Summable (fun n : ℕ => P ((n : ℝ) + 1) / (ξ ^ 2 + ((n : ℝ) + 1) ^ 2)) ∧\n ‖∑ i, w i‖ ^ 2 *\n (∑' k : ℕ, 1 / (ξ ^ 2 + ((m : ℝ) * ((k : ℝ) + 1)) ^ 2)) ≤\n ∑' n : ℕ, P ((n : ℝ) + 1) / (ξ ^ 2 + ((n : ℝ) + 1) ^ 2) := by\n classical\n dsimp only\n let Q : ℝ → ℝ := fun v =>\n ∑ i, ∑ j, (star (w i) * w j).re * Real.cos (v * (θ i - θ j))\n have hP (v : ℝ) : Q v =\n (‖∑ i, w i * Complex.exp (((v * θ i : ℝ) : ℂ) * Complex.I)‖ ^ 2 +\n ‖∑ i, w i * Complex.exp (((-v * θ i : ℝ) : ℂ) * Complex.I)‖ ^ 2) / 2 :=\n radial_fourier_cosine_square Finset.univ θ w v\n simp_rw [← hP]\n have hQ := radial_cosine_resolvent_tsum Finset.univ θ w ξ hξ\n have hQzero : Q 0 = ‖∑ i, w i‖ ^ 2 := by\n rw [hP]\n simp only [zero_mul, neg_zero, Complex.ofReal_zero, Complex.exp_zero, mul_one]\n ring\n have hQeven (v : ℝ) : Q (-v) = Q v := by\n simp only [Q, neg_mul, Real.cos_neg]\n have hsplitQ := radial_even_int_tsum_split\n (fun n : ℤ => Q (n : ℝ) / (ξ ^ 2 + (n : ℝ) ^ 2)) hQ.1\n (by intro n; simp only [Int.cast_neg, hQeven, neg_sq])\n obtain ⟨hL, hLval⟩ := radial_resolvent_lattice_sum m hm ξ hξ\n have hsplitL := radial_even_int_tsum_split\n (fun n : ℤ => 1 / (ξ ^ 2 + ((m : ℝ) * (n : ℝ)) ^ 2)) hL\n (by intro n; simp only [Int.cast_neg, mul_neg, neg_sq])\n have hpos : Summable (fun n : ℕ => Q ((n : ℝ) + 1) /\n (ξ ^ 2 + ((n : ℝ) + 1) ^ 2)) := by\n have h := hQ.1.comp_injective (i := fun n : ℕ => (n : ℤ) + 1) (by\n intro a b h\n change (a : ℤ) + 1 = (b : ℤ) + 1 at h\n exact_mod_cast (add_right_cancel h))\n change Summable (fun n : ℕ => Q (((n : ℤ) + 1 : ℤ) : ℝ) /\n (ξ ^ 2 + (((n : ℤ) + 1 : ℤ) : ℝ) ^ 2)) at h\n simpa only [Int.cast_add, Int.cast_natCast, Int.cast_one] using h\n refine ⟨hpos, ?_⟩\n have hbound := radial_angular_resolvent_energy_bound m hm θ hθ hinj ξ hξ w\n rw [← hQ.2, ← hLval, hsplitQ, hsplitL] at hbound\n simp only [Int.cast_zero, mul_zero, zero_pow (by decide : 2 ≠ 0), add_zero,\n hQzero, Int.cast_add, Int.cast_natCast, Int.cast_one] at hbound\n simp only [div_eq_mul_inv, one_mul] at hbound ⊢\n nlinarith only [hbound]\ntheorem radial_probability_truncated_energy_bound_of_atom {E : Type*}\n [MetricSpace E] [MeasurableSpace E] [BorelSpace E]\n [CompactSpace E] [SecondCountableTopology E]\n (μ : MeasureTheory.ProbabilityMeasure E) (a : E)\n (ha : (μ : MeasureTheory.Measure E) {a} ≠ 0)\n (hdiam : ∀ x y : E, dist x y ≤ 2) (c : ℝ) :\n ∃ N : ℕ, c < ∫ z : E × E,\n -Real.log (max (Real.exp (-(N : ℝ))) (dist z.1 z.2)) ∂(μ.prod μ) := by\n classical\n let ν : MeasureTheory.Measure (E × E) := μ.prod μ\n let S : Set (E × E) := {(a, a)}\n have hS : MeasurableSet S := measurableSet_singleton _\n have hSpos : ν S ≠ 0 := by\n change (μ : MeasureTheory.Measure E).prod (μ : MeasureTheory.Measure E) {(a, a)} ≠ 0\n rw [← Set.singleton_prod_singleton, MeasureTheory.Measure.prod_prod]\n exact mul_ne_zero ha ha\n have hp : 0 < ν.real S :=\n lt_of_le_of_ne MeasureTheory.measureReal_nonneg\n (Ne.symm ((MeasureTheory.measureReal_ne_zero_iff (μ := ν) (s := S)).mpr hSpos))\n obtain ⟨N, hN⟩ := exists_nat_gt ((c + Real.log 2) / ν.real S)\n have hc : c < ν.real S * (N : ℝ) - Real.log 2 := by\n have := (div_lt_iff₀ hp).mp hN\n nlinarith\n have hlog2 : 0 ≤ Real.log 2 := Real.log_nonneg (by norm_num)\n let K : C(E × E, ℝ) := ⟨fun z =>\n -Real.log (max (Real.exp (-(N : ℝ))) (dist z.1 z.2)),\n ((continuous_const.max (continuous_fst.dist continuous_snd)).log\n (fun z => ne_of_gt ((Real.exp_pos _).trans_le (le_max_left _ _)))).neg⟩\n have hK : MeasureTheory.Integrable K ν :=\n (ContinuousMap.equivBoundedOfCompact _ _ K).integrable _\n have hI : MeasureTheory.Integrable (S.indicator (fun _ : E × E =>\n (N : ℝ) + Real.log 2)) ν :=\n (MeasureTheory.integrable_const _).indicator hS\n have hmono : (fun z : E × E => -Real.log 2 +\n S.indicator (fun _ => (N : ℝ) + Real.log 2) z) ≤ K := by\n intro z\n change -Real.log 2 + S.indicator (fun _ => (N : ℝ) + Real.log 2) z ≤\n -Real.log (max (Real.exp (-(N : ℝ))) (dist z.1 z.2))\n by_cases hz : z ∈ S\n · have hz' : z = (a, a) := Set.mem_singleton_iff.mp hz\n rw [Set.indicator_of_mem hz, hz']\n change -Real.log 2 + ((N : ℝ) + Real.log 2) ≤\n -Real.log (max (Real.exp (-(N : ℝ))) (dist a a))\n rw [dist_self, max_eq_left (Real.exp_pos _).le, Real.log_exp]\n linarith\n · rw [Set.indicator_of_notMem hz, add_zero]\n apply neg_le_neg\n apply Real.log_le_log ((Real.exp_pos _).trans_le (le_max_left _ _))\n exact max_le ((Real.exp_le_one_iff.mpr (neg_nonpos.mpr (Nat.cast_nonneg N))).trans (by norm_num))\n (hdiam z.1 z.2)\n have hbound := MeasureTheory.integral_mono\n ((MeasureTheory.integrable_const _).add hI) hK hmono\n have hval : (∫ z : E × E, -Real.log 2 +\n S.indicator (fun _ => (N : ℝ) + Real.log 2) z ∂ν) =\n -Real.log 2 + ν.real S * ((N : ℝ) + Real.log 2) := by\n rw [MeasureTheory.integral_add (MeasureTheory.integrable_const _) hI,\n MeasureTheory.integral_indicator_const _ hS]\n simp only [MeasureTheory.integral_const, MeasureTheory.probReal_univ,\n smul_eq_mul, one_mul]\n change (∫ z : E × E, -Real.log 2 +\n S.indicator (fun _ => (N : ℝ) + Real.log 2) z ∂ν) ≤ ∫ z : E × E, K z ∂ν at hbound\n rw [hval] at hbound\n refine ⟨N, ?_⟩\n have hstep : ν.real S * (N : ℝ) - Real.log 2 ≤\n -Real.log 2 + ν.real S * ((N : ℝ) + Real.log 2) := by\n nlinarith [mul_nonneg hp.le hlog2]\n exact hc.trans_le (hstep.trans hbound)\ntheorem radial_tree_set_norm_le_one (A : Finset ℂ) (hA : ∀ a ∈ A, ‖a‖ = 1)\n (z : ℂ) (hz : z ∈ radial_tree_set A 1) : ‖z‖ ≤ 1 := by\n obtain ⟨a, ha, t, ht, ht1, rfl⟩ := (radial_tree_set_mem_iff A 1 z).mp hz\n simpa only [norm_mul, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg ht,\n hA a ha, mul_one] using ht1\ntheorem radial_tree_probability_truncated_energy_of_atom (A : Finset ℂ)\n (hA : ∀ a ∈ A, ‖a‖ = 1)\n (μ : MeasureTheory.ProbabilityMeasure (radial_tree_set A 1))\n (a : radial_tree_set A 1)\n (ha : (μ : MeasureTheory.Measure (radial_tree_set A 1)) {a} ≠ 0) (c : ℝ) :\n ∃ N : ℕ, c < ∫ z : (radial_tree_set A 1) × (radial_tree_set A 1),\n -Real.log (max (Real.exp (-(N : ℝ))) (dist z.1 z.2)) ∂(μ.prod μ) := by\n let : CompactSpace (radial_tree_set A 1) :=\n isCompact_iff_compactSpace.mp (radial_tree_set_compact A 1)\n apply radial_probability_truncated_energy_bound_of_atom μ a ha _ c\n intro x y\n change dist (x : ℂ) (y : ℂ) ≤ 2\n calc\n dist (x : ℂ) (y : ℂ) ≤ ‖(x : ℂ)‖ + ‖(y : ℂ)‖ := dist_le_norm_add_norm _ _\n _ ≤ 2 := by linarith [radial_tree_set_norm_le_one A hA x x.property,\n radial_tree_set_norm_le_one A hA y y.property]\ntheorem radial_interval_cutoff_le_abel (s t r : ℝ) (N : ℕ)\n (hs : 0 ≤ s) (hs1 : s ≤ 1) (ht : 0 ≤ t) (ht1 : t ≤ 1)\n (hmax : 0 < max s t) (hr : 0 < r) (hr1 : r < 1) :\n -Real.log (max (Real.exp (-(N : ℝ))) |s - t|) -\n Real.log (1 + (1 - r) * Real.exp (N : ℝ)) ≤\n -Real.log (max s t - r * min s t) := by\n have hmin : 0 ≤ min s t := le_min hs ht\n have hmin1 : min s t ≤ 1 := (min_le_left _ _).trans hs1\n have hdiff : max s t - min s t = |s - t| := by\n simpa only [abs_sub_comm] using max_sub_min_eq_abs s t\n have hpos : 0 < max s t - r * min s t := by\n have h := mul_pos (sub_pos.mpr hr1) hmax\n have h' := mul_nonneg hr.le (abs_nonneg (s - t))\n nlinarith\n have hcut : 0 < max (Real.exp (-(N : ℝ))) |s - t| :=\n (Real.exp_pos _).trans_le (le_max_left _ _)\n have hexp : Real.exp (N : ℝ) * Real.exp (-(N : ℝ)) = 1 := by\n rw [← Real.exp_add]\n simp\n have hscale : 1 ≤ Real.exp (N : ℝ) * max (Real.exp (-(N : ℝ))) |s - t| := by\n rw [← hexp]\n exact mul_le_mul_of_nonneg_left (le_max_left _ _) (Real.exp_pos _).le\n have hbound : max s t - r * min s t ≤\n (1 + (1 - r) * Real.exp (N : ℝ)) * max (Real.exp (-(N : ℝ))) |s - t| := by\n have h := mul_le_mul_of_nonneg_left hscale (sub_nonneg.mpr hr1.le)\n have h' := mul_le_mul_of_nonneg_left hmin1 (sub_nonneg.mpr hr1.le)\n nlinarith [le_max_right (Real.exp (-(N : ℝ))) |s - t|]\n have hfac : 0 < 1 + (1 - r) * Real.exp (N : ℝ) := by positivity\n have hlog := Real.log_le_log hpos hbound\n rw [Real.log_mul hfac.ne' hcut.ne'] at hlog\n linarith\ntheorem radial_annular_abel_le_cutoff (δ r : ℝ) (z w : ℂ) (N : ℕ)\n (hδ : 0 < δ) (hr : 0 < r) (hr1 : r < 1) (hz : δ ≤ ‖z‖)\n (hwz : ‖w‖ ≤ ‖z‖) (hN : Real.exp (-(N : ℝ)) ≤ (1 - r) * δ) :\n -Real.log ‖z - (r : ℂ) * w‖ ≤\n -Real.log (max (Real.exp (-(N : ℝ))) ‖z - w‖) - Real.log r / 2 := by\n have hrad : (1 - r) * δ ≤ ‖z - (r : ℂ) * w‖ := by\n have h := norm_sub_norm_le z ((r : ℂ) * w)\n simp only [norm_mul, Complex.norm_real, Real.norm_eq_abs, abs_of_pos hr] at h\n have h' := mul_le_mul_of_nonneg_left hwz hr.le\n have h'' := mul_le_mul_of_nonneg_left hz (sub_nonneg.mpr hr1.le)\n nlinarith\n have hnorm : 0 < ‖z - (r : ℂ) * w‖ := (mul_pos (sub_pos.mpr hr1) hδ).trans_le hrad\n have hid : ‖z - (r : ℂ) * w‖ ^ 2 - r * ‖z - w‖ ^ 2 =\n (1 - r) * (‖z‖ ^ 2 - r * ‖w‖ ^ 2) := by\n simp only [Complex.sq_norm, Complex.normSq_apply, Complex.sub_re, Complex.sub_im,\n Complex.mul_re, Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im]\n ring\n have hww : ‖w‖ ^ 2 ≤ ‖z‖ ^ 2 := (sq_le_sq₀ (norm_nonneg _) (norm_nonneg _)).mpr hwz\n have hdiff : 0 ≤ (1 - r) * (‖z‖ ^ 2 - r * ‖w‖ ^ 2) := by\n apply mul_nonneg (sub_nonneg.mpr hr1.le)\n nlinarith [mul_nonneg (sub_nonneg.mpr hr1.le) (sq_nonneg ‖w‖)]\n have hdist : r * ‖z - w‖ ^ 2 ≤ ‖z - (r : ℂ) * w‖ ^ 2 := by linarith\n have hcut : Real.exp (-(N : ℝ)) ≤ ‖z - (r : ℂ) * w‖ := hN.trans hrad\n have hmax : 0 < max (Real.exp (-(N : ℝ))) ‖z - w‖ :=\n (Real.exp_pos _).trans_le (le_max_left _ _)\n have hsq : r * (max (Real.exp (-(N : ℝ))) ‖z - w‖) ^ 2 ≤\n ‖z - (r : ℂ) * w‖ ^ 2 := by\n rcases le_total (Real.exp (-(N : ℝ))) ‖z - w‖ with h | h\n · simpa only [max_eq_right h] using hdist\n · rw [max_eq_left h]\n have h' := (sq_le_sq₀ (Real.exp_pos _).le (norm_nonneg _)).mpr hcut\n nlinarith [mul_nonneg (sub_nonneg.mpr hr1.le) (sq_nonneg (Real.exp (-(N : ℝ))))]\n have hlog := Real.log_le_log (mul_pos hr (sq_pos_of_pos hmax)) hsq\n rw [Real.log_mul hr.ne' (sq_pos_of_pos hmax).ne', Real.log_pow, Real.log_pow] at hlog\n norm_num only [Nat.cast_ofNat] at hlog\n linarith only [hlog]\ntheorem radial_probability_fourier_square {X : Type*} [MeasurableSpace X]\n (μ : MeasureTheory.ProbabilityMeasure X) (φ : X → ℝ) :\n (∫ z : X × X, Complex.exp (((φ z.2 - φ z.1 : ℝ) : ℂ) * Complex.I) ∂(μ.prod μ)) =\n (Complex.normSq (∫ z : X, Complex.exp (((φ z : ℝ) : ℂ) * Complex.I) ∂μ) : ℂ) := by\n have hpoint (z : X × X) :\n Complex.exp (((φ z.2 - φ z.1 : ℝ) : ℂ) * Complex.I) =\n (starRingEnd ℂ) (Complex.exp (((φ z.1 : ℝ) : ℂ) * Complex.I)) *\n Complex.exp (((φ z.2 : ℝ) : ℂ) * Complex.I) := by\n rw [← Complex.exp_conj, ← Complex.exp_add]\n congr 1\n simp only [map_mul, Complex.conj_ofReal, Complex.conj_I, Complex.ofReal_sub]\n ring\n simp_rw [hpoint]\n rw [MeasureTheory.ProbabilityMeasure.toMeasure_prod]\n calc\n _ = (∫ z : X, (starRingEnd ℂ) (Complex.exp (((φ z : ℝ) : ℂ) * Complex.I)) ∂μ) *\n (∫ z : X, Complex.exp (((φ z : ℝ) : ℂ) * Complex.I) ∂μ) :=\n MeasureTheory.integral_prod_mul _ _\n _ = _ := by rw [integral_conj, Complex.normSq_eq_conj_mul_self]\ntheorem radial_probability_cauchy_mode {X : Type*} [MeasurableSpace X]\n (μ : MeasureTheory.ProbabilityMeasure X) (x φ : X → ℝ)\n (hx : Measurable x) (hφ : Measurable φ) (k a : ℝ) (hk : 0 < k) :\n MeasureTheory.Integrable (fun ξ : ℝ =>\n (Complex.normSq (∫ z : X,\n Complex.exp (((ξ * x z + a * φ z : ℝ) : ℂ) * Complex.I) ∂μ) : ℂ) /\n ((k ^ 2 + ξ ^ 2 : ℝ) : ℂ)) ∧\n (∫ ξ : ℝ,\n (Complex.normSq (∫ z : X,\n Complex.exp (((ξ * x z + a * φ z : ℝ) : ℂ) * Complex.I) ∂μ) : ℂ) /\n ((k ^ 2 + ξ ^ 2 : ℝ) : ℂ)) =\n ((Real.pi / k : ℝ) : ℂ) *\n ∫ z : X × X, Complex.exp (-k * |x z.2 - x z.1| : ℝ) *\n Complex.exp (((a * (φ z.2 - φ z.1) : ℝ) : ℂ) * Complex.I) ∂(μ.prod μ) := by\n let ν : MeasureTheory.Measure (X × X) := μ.prod μ\n let F : ℝ × (X × X) → ℂ := fun p =>\n Complex.exp (((p.1 * (x p.2.2 - x p.2.1) + a * (φ p.2.2 - φ p.2.1) : ℝ) : ℂ) *\n Complex.I) / ((k ^ 2 + p.1 ^ 2 : ℝ) : ℂ)\n have hmF : Measurable F := by dsimp only [F]; fun_prop\n have hF : MeasureTheory.Integrable F (MeasureTheory.volume.prod ν) :=\n ((radial_cauchy_kernel_integrable_unscaled k hk).norm.comp_fst ν).mono'\n hmF.aestronglyMeasurable (by\n filter_upwards with p\n simp [F, Complex.norm_exp])\n have hinner (ξ : ℝ) : (∫ z : X × X, F (ξ, z) ∂ν) =\n (Complex.normSq (∫ z : X,\n Complex.exp (((ξ * x z + a * φ z : ℝ) : ℂ) * Complex.I) ∂μ) : ℂ) /\n ((k ^ 2 + ξ ^ 2 : ℝ) : ℂ) := by\n have hphase (z : X × X) :\n ξ * (x z.2 - x z.1) + a * (φ z.2 - φ z.1) =\n (ξ * x z.2 + a * φ z.2) - (ξ * x z.1 + a * φ z.1) := by ring\n dsimp only [F, ν]\n simp_rw [hphase]\n rw [MeasureTheory.integral_div,\n radial_probability_fourier_square μ (fun z => ξ * x z + a * φ z)]\n have houter (z : X × X) : (∫ ξ : ℝ, F (ξ, z)) =\n ((Real.pi / k : ℝ) : ℂ) * (Complex.exp (-k * |x z.2 - x z.1| : ℝ) *\n Complex.exp (((a * (φ z.2 - φ z.1) : ℝ) : ℂ) * Complex.I)) := by\n have hphase (ξ : ℝ) : F (ξ, z) =\n Complex.exp (((a * (φ z.2 - φ z.1) : ℝ) : ℂ) * Complex.I) *\n (Complex.exp (((ξ * (x z.2 - x z.1) : ℝ) : ℂ) * Complex.I) /\n ((k ^ 2 + ξ ^ 2 : ℝ) : ℂ)) := by\n dsimp only [F]\n rw [Complex.ofReal_add, add_mul, Complex.exp_add]\n ring\n simp_rw [hphase]\n rw [MeasureTheory.integral_const_mul, radial_cauchy_kernel_inverse k hk]\n ring\n refine ⟨?_, ?_⟩\n · simpa only [hinner] using hF.integral_prod_left\n · calc\n _ = ∫ ξ : ℝ, ∫ z : X × X, F (ξ, z) ∂ν := by simp_rw [hinner]\n _ = ∫ z : X × X, (∫ ξ : ℝ, F (ξ, z)) ∂ν :=\n MeasureTheory.integral_integral_swap hF\n _ = _ := by\n simp_rw [houter]\n rw [MeasureTheory.integral_const_mul]\ntheorem radial_probability_cauchy_cos_mode {X : Type*} [MeasurableSpace X]\n (μ : MeasureTheory.ProbabilityMeasure X) (x φ : X → ℝ)\n (hx : Measurable x) (hφ : Measurable φ) (k a : ℝ) (hk : 0 < k) :\n MeasureTheory.Integrable (fun ξ : ℝ =>\n ‖∫ z : X, Complex.exp (((ξ * x z + a * φ z : ℝ) : ℂ) * Complex.I) ∂μ‖ ^ 2 /\n (k ^ 2 + ξ ^ 2)) ∧\n (∫ z : X × X, Real.exp (-k * |x z.2 - x z.1|) *\n Real.cos (a * (φ z.2 - φ z.1)) ∂(μ.prod μ)) / k =\n (1 / Real.pi) * ∫ ξ : ℝ,\n ‖∫ z : X, Complex.exp (((ξ * x z + a * φ z : ℝ) : ℂ) * Complex.I) ∂μ‖ ^ 2 /\n (k ^ 2 + ξ ^ 2) := by\n have hC := radial_probability_cauchy_mode μ x φ hx hφ k a hk\n have hB : MeasureTheory.Integrable (fun z : X × X =>\n Complex.exp (-k * |x z.2 - x z.1| : ℝ) *\n Complex.exp (((a * (φ z.2 - φ z.1) : ℝ) : ℂ) * Complex.I)) (μ.prod μ) := by\n apply MeasureTheory.Integrable.of_bound (by fun_prop) 1\n filter_upwards with z\n simp only [norm_mul, Complex.norm_exp, Complex.ofReal_re, Complex.mul_re,\n Complex.ofReal_im, Complex.I_re, Complex.I_im, mul_zero, zero_mul, sub_zero,\n Real.exp_zero, mul_one]\n exact Real.exp_le_one_iff.mpr (by nlinarith [abs_nonneg (x z.2 - x z.1)])\n have hL : (∫ ξ : ℝ,\n ‖∫ z : X, Complex.exp (((ξ * x z + a * φ z : ℝ) : ℂ) * Complex.I) ∂μ‖ ^ 2 /\n (k ^ 2 + ξ ^ 2)) =\n (∫ ξ : ℝ, (Complex.normSq (∫ z : X,\n Complex.exp (((ξ * x z + a * φ z : ℝ) : ℂ) * Complex.I) ∂μ) : ℂ) /\n ((k ^ 2 + ξ ^ 2 : ℝ) : ℂ)).re := by\n simpa only [RCLike.re_eq_complex_re, Complex.div_ofReal_re, Complex.ofReal_re,\n Complex.normSq_eq_norm_sq] using integral_re hC.1\n have hR : (∫ z : X × X, Real.exp (-k * |x z.2 - x z.1|) *\n Real.cos (a * (φ z.2 - φ z.1)) ∂(μ.prod μ)) =\n (∫ z : X × X, Complex.exp (-k * |x z.2 - x z.1| : ℝ) *\n Complex.exp (((a * (φ z.2 - φ z.1) : ℝ) : ℂ) * Complex.I) ∂(μ.prod μ)).re := by\n simpa only [RCLike.re_eq_complex_re, Complex.mul_re, Complex.exp_ofReal_re,\n Complex.exp_ofReal_im, Complex.exp_ofReal_mul_I_re, zero_mul, sub_zero] using integral_re hB\n refine ⟨?_, ?_⟩\n · simpa only [RCLike.re_eq_complex_re, Complex.div_ofReal_re, Complex.ofReal_re,\n Complex.normSq_eq_norm_sq] using hC.1.re\n · rw [hC.2] at hL\n simp only [Complex.mul_re, Complex.ofReal_re, Complex.ofReal_im, zero_mul, sub_zero] at hL\n rw [hL, ← hR]\n field_simp\ntheorem radial_probability_cos_mode_nonneg {X : Type*} [MeasurableSpace X]\n (μ : MeasureTheory.ProbabilityMeasure X) (x φ : X → ℝ)\n (hx : Measurable x) (hφ : Measurable φ) (k a : ℝ) (hk : 0 < k) :\n 0 ≤ ∫ z : X × X, Real.exp (-k * |x z.2 - x z.1|) *\n Real.cos (a * (φ z.2 - φ z.1)) ∂(μ.prod μ) := by\n have h := (radial_probability_cauchy_cos_mode μ x φ hx hφ k a hk).2\n have hi : 0 ≤ ∫ ξ : ℝ,\n ‖∫ z : X, Complex.exp (((ξ * x z + a * φ z : ℝ) : ℂ) * Complex.I) ∂μ‖ ^ 2 /\n (k ^ 2 + ξ ^ 2) := by\n apply MeasureTheory.integral_nonneg\n intro ξ\n positivity\n have hdiv : 0 ≤ (∫ z : X × X, Real.exp (-k * |x z.2 - x z.1|) *\n Real.cos (a * (φ z.2 - φ z.1)) ∂(μ.prod μ)) / k := by\n rw [h]\n exact mul_nonneg (by positivity) hi\n have hmul := mul_nonneg hdiv hk.le\n rwa [div_mul_cancel₀ _ hk.ne'] at hmul\ntheorem radial_probability_ray_fourier_sum {X : Type*} [MeasurableSpace X]\n (m : ℕ) (μ : MeasureTheory.ProbabilityMeasure X) (x : X → ℝ)\n (label : X → Fin m) (θ : Fin m → ℝ) (hx : Measurable x)\n (hl : Measurable label) (ξ a : ℝ) :\n (∑ i : Fin m, (∫ z : X, {u | label u = i}.indicator\n (fun u => Complex.exp (((ξ * x u : ℝ) : ℂ) * Complex.I)) z ∂μ) *\n Complex.exp (((a * θ i : ℝ) : ℂ) * Complex.I)) =\n ∫ z : X, Complex.exp (((ξ * x z + a * θ (label z) : ℝ) : ℂ) * Complex.I) ∂μ := by\n classical\n have hp : MeasureTheory.Integrable (fun z : X =>\n Complex.exp (((ξ * x z : ℝ) : ℂ) * Complex.I)) μ :=\n MeasureTheory.Integrable.of_bound (by fun_prop) 1\n (by filter_upwards with z; simp [Complex.norm_exp])\n have hi (i : Fin m) : MeasureTheory.Integrable\n ({u | label u = i}.indicator\n (fun u => Complex.exp (((ξ * x u : ℝ) : ℂ) * Complex.I))) μ :=\n hp.indicator (hl (measurableSet_singleton i))\n calc\n _ = ∑ i : Fin m, ∫ z : X, {u | label u = i}.indicator\n (fun u => Complex.exp (((ξ * x u : ℝ) : ℂ) * Complex.I)) z *\n Complex.exp (((a * θ i : ℝ) : ℂ) * Complex.I) ∂μ := by\n simp_rw [MeasureTheory.integral_mul_const]\n _ = ∫ z : X, ∑ i : Fin m, {u | label u = i}.indicator\n (fun u => Complex.exp (((ξ * x u : ℝ) : ℂ) * Complex.I)) z *\n Complex.exp (((a * θ i : ℝ) : ℂ) * Complex.I) ∂μ :=\n (MeasureTheory.integral_finsetSum _ (fun i _ => (hi i).mul_const _)).symm\n _ = _ := by\n apply MeasureTheory.integral_congr_ae\n filter_upwards with z\n rw [Finset.sum_eq_single (label z)]\n · rw [Set.indicator_of_mem (show z ∈ {u | label u = label z} from rfl),\n ← Complex.exp_add]\n congr 1\n push_cast\n ring\n · intro j _ hj\n rw [Set.indicator_of_notMem (show z ∉ {u | label u = j} from Ne.symm hj), zero_mul]\n · simp\ntheorem radial_probability_ray_resolvent_bound {X : Type*} [MeasurableSpace X]\n (m : ℕ) (hm : 0 < m) (μ : MeasureTheory.ProbabilityMeasure X)\n (x : X → ℝ) (label : X → Fin m) (θ : Fin m → ℝ)\n (hx : Measurable x) (hl : Measurable label)\n (hθ : ∀ i, θ i ∈ Set.Ico 0 (2 * Real.pi)) (hinj : Function.Injective θ)\n (ξ : ℝ) (hξ : ξ ≠ 0) :\n let P : ℝ → ℝ := fun a =>\n (‖∫ z : X, Complex.exp (((ξ * x z + a * θ (label z) : ℝ) : ℂ) * Complex.I) ∂μ‖ ^ 2 +\n ‖∫ z : X, Complex.exp (((ξ * x z + (-a) * θ (label z) : ℝ) : ℂ) * Complex.I) ∂μ‖ ^ 2) / 2\n Summable (fun n : ℕ => P ((n : ℝ) + 1) / (ξ ^ 2 + ((n : ℝ) + 1) ^ 2)) ∧\n ‖∫ z : X, Complex.exp (((ξ * x z : ℝ) : ℂ) * Complex.I) ∂μ‖ ^ 2 *\n (∑' k : ℕ, 1 / (ξ ^ 2 + ((m : ℝ) * ((k : ℝ) + 1)) ^ 2)) ≤\n ∑' n : ℕ, P ((n : ℝ) + 1) / (ξ ^ 2 + ((n : ℝ) + 1) ^ 2) := by\n classical\n let w : Fin m → ℂ := fun i => ∫ z : X, {u | label u = i}.indicator\n (fun u => Complex.exp (((ξ * x u : ℝ) : ℂ) * Complex.I)) z ∂μ\n have hw (a : ℝ) : (∑ i, w i * Complex.exp (((a * θ i : ℝ) : ℂ) * Complex.I)) =\n ∫ z : X, Complex.exp (((ξ * x z + a * θ (label z) : ℝ) : ℂ) * Complex.I) ∂μ :=\n radial_probability_ray_fourier_sum m μ x label θ hx hl ξ a\n have hwzero : (∑ i, w i) =\n ∫ z : X, Complex.exp (((ξ * x z : ℝ) : ℂ) * Complex.I) ∂μ := by\n simpa only [zero_mul, Complex.ofReal_zero, zero_add, add_zero, Complex.exp_zero,\n mul_one] using hw 0\n have h := radial_positive_mode_resolvent_bound m hm θ hθ hinj |ξ| (abs_pos.mpr hξ) w\n dsimp only at h ⊢\n simpa only [sq_abs, hw, hwzero] using h\ntheorem radial_probability_cauchy_cos_mode_symm {X : Type*} [MeasurableSpace X]\n (μ : MeasureTheory.ProbabilityMeasure X) (x φ : X → ℝ)\n (hx : Measurable x) (hφ : Measurable φ) (k a : ℝ) (hk : 0 < k) :\n let P : ℝ → ℝ := fun ξ =>\n (‖∫ z : X, Complex.exp (((ξ * x z + a * φ z : ℝ) : ℂ) * Complex.I) ∂μ‖ ^ 2 +\n ‖∫ z : X, Complex.exp (((ξ * x z + (-a) * φ z : ℝ) : ℂ) * Complex.I) ∂μ‖ ^ 2) / 2\n MeasureTheory.Integrable (fun ξ : ℝ => P ξ / (k ^ 2 + ξ ^ 2)) ∧\n (∫ z : X × X, Real.exp (-k * |x z.2 - x z.1|) *\n Real.cos (a * (φ z.2 - φ z.1)) ∂(μ.prod μ)) / k =\n (1 / Real.pi) * ∫ ξ : ℝ, P ξ / (k ^ 2 + ξ ^ 2) := by\n have hp := radial_probability_cauchy_cos_mode μ x φ hx hφ k a hk\n have hn := radial_probability_cauchy_cos_mode μ x φ hx hφ k (-a) hk\n dsimp only\n have heq (ξ : ℝ) :\n ((‖∫ z : X, Complex.exp (((ξ * x z + a * φ z : ℝ) : ℂ) * Complex.I) ∂μ‖ ^ 2 +\n ‖∫ z : X, Complex.exp (((ξ * x z + (-a) * φ z : ℝ) : ℂ) * Complex.I) ∂μ‖ ^ 2) / 2) /\n (k ^ 2 + ξ ^ 2) =\n ((‖∫ z : X, Complex.exp (((ξ * x z + a * φ z : ℝ) : ℂ) * Complex.I) ∂μ‖ ^ 2 /\n (k ^ 2 + ξ ^ 2)) +\n (‖∫ z : X, Complex.exp (((ξ * x z + (-a) * φ z : ℝ) : ℂ) * Complex.I) ∂μ‖ ^ 2 /\n (k ^ 2 + ξ ^ 2))) / 2 := by ring\n simp_rw [heq]\n refine ⟨(hp.1.add hn.1).div_const 2, ?_⟩\n rw [MeasureTheory.integral_div, MeasureTheory.integral_add hp.1 hn.1]\n have hneg (z : X × X) : Real.cos ((-a) * (φ z.2 - φ z.1)) =\n Real.cos (a * (φ z.2 - φ z.1)) := by rw [neg_mul, Real.cos_neg]\n simp_rw [hneg] at hn\n linarith only [hp.2, hn.2]\ntheorem radial_nonnegative_mode_integral_comparison\n (L R : ℕ → ℝ → ℝ)\n (hL : ∀ n, MeasureTheory.Integrable (L n))\n (hR : ∀ n, MeasureTheory.Integrable (R n))\n (hLn : ∀ n ξ, 0 ≤ L n ξ) (hRn : ∀ n ξ, 0 ≤ R n ξ)\n (hLs : ∀ᵐ ξ : ℝ, Summable (fun n => L n ξ))\n (hRs : ∀ᵐ ξ : ℝ, Summable (fun n => R n ξ))\n (hbound : ∀ᵐ ξ : ℝ, (∑' n, L n ξ) ≤ ∑' n, R n ξ) :\n (∑' n, ENNReal.ofReal (∫ ξ : ℝ, L n ξ)) ≤\n ∑' n, ENNReal.ofReal (∫ ξ : ℝ, R n ξ) := by\n have hiL (n : ℕ) := MeasureTheory.ofReal_integral_eq_lintegral_ofReal\n (hL n) (Filter.Eventually.of_forall (hLn n))\n have hiR (n : ℕ) := MeasureTheory.ofReal_integral_eq_lintegral_ofReal\n (hR n) (Filter.Eventually.of_forall (hRn n))\n simp_rw [hiL, hiR]\n rw [← MeasureTheory.lintegral_tsum (fun n =>\n (hL n).aestronglyMeasurable.aemeasurable.ennreal_ofReal),\n ← MeasureTheory.lintegral_tsum (fun n =>\n (hR n).aestronglyMeasurable.aemeasurable.ennreal_ofReal)]\n apply MeasureTheory.lintegral_mono_ae\n filter_upwards [hLs, hRs, hbound] with ξ hls hrs hb\n rw [← ENNReal.ofReal_tsum_of_nonneg (fun n => hLn n ξ) hls,\n ← ENNReal.ofReal_tsum_of_nonneg (fun n => hRn n ξ) hrs]\n exact ENNReal.ofReal_le_ofReal hb\ntheorem radial_probability_ray_mode_sum_bound {X : Type*} [MeasurableSpace X]\n (m : ℕ) (hm : 0 < m) (μ : MeasureTheory.ProbabilityMeasure X)\n (x : X → ℝ) (label : X → Fin m) (θ : Fin m → ℝ)\n (hx : Measurable x) (hl : Measurable label)\n (hθ : ∀ i, θ i ∈ Set.Ico 0 (2 * Real.pi)) (hinj : Function.Injective θ) :\n let C : ℝ → ℝ := fun k => ∫ z : X × X,\n Real.exp (-k * |x z.2 - x z.1|) ∂(μ.prod μ)\n let B : ℝ → ℝ := fun k => ∫ z : X × X,\n Real.exp (-k * |x z.2 - x z.1|) *\n Real.cos (k * (θ (label z.2) - θ (label z.1))) ∂(μ.prod μ)\n (∑' k : ℕ, ENNReal.ofReal (C ((m : ℝ) * ((k : ℝ) + 1)) /\n ((m : ℝ) * ((k : ℝ) + 1)))) ≤\n ∑' n : ℕ, ENNReal.ofReal (B ((n : ℝ) + 1) / ((n : ℝ) + 1)) := by\n classical\n dsimp only\n let φ : X → ℝ := fun z => θ (label z)\n have hφ : Measurable φ := (measurable_of_countable θ).comp hl\n let p : ℝ → ℝ → ℝ := fun a ξ =>\n ‖∫ z : X, Complex.exp (((ξ * x z + a * φ z : ℝ) : ℂ) * Complex.I) ∂μ‖ ^ 2\n let L : ℕ → ℝ → ℝ := fun n ξ =>\n p 0 ξ / (((m : ℝ) * ((n : ℝ) + 1)) ^ 2 + ξ ^ 2)\n let R : ℕ → ℝ → ℝ := fun n ξ =>\n ((p ((n : ℝ) + 1) ξ + p (-((n : ℝ) + 1)) ξ) / 2) /\n (((n : ℝ) + 1) ^ 2 + ξ ^ 2)\n have hk (n : ℕ) : 0 < (n : ℝ) + 1 := by positivity\n have hmk (n : ℕ) : 0 < (m : ℝ) * ((n : ℝ) + 1) := by positivity\n have hL (n : ℕ) := radial_probability_cauchy_cos_mode μ x φ hx hφ\n ((m : ℝ) * ((n : ℝ) + 1)) 0 (hmk n)\n have hR (n : ℕ) := radial_probability_cauchy_cos_mode_symm μ x φ hx hφ\n ((n : ℝ) + 1) ((n : ℝ) + 1) (hk n)\n have hLn (n : ℕ) (ξ : ℝ) : 0 ≤ L n ξ := by dsimp only [L, p]; positivity\n have hRn (n : ℕ) (ξ : ℝ) : 0 ≤ R n ξ := by dsimp only [R, p]; positivity\n have hLs (ξ : ℝ) (hξ : ξ ≠ 0) : Summable (fun n => L n ξ) := by\n have hs := ((radial_resolvent_lattice_sum m hm |ξ| (abs_pos.mpr hξ)).1.comp_injective\n (i := fun n : ℕ => (n : ℤ) + 1) (by\n intro a b h\n change (a : ℤ) + 1 = (b : ℤ) + 1 at h\n exact_mod_cast (by omega : (a : ℤ) = b))).mul_left (p 0 ξ)\n simpa only [L, Function.comp_apply, sq_abs, Int.cast_add, Int.cast_natCast,\n Int.cast_one, mul_one_div, add_comm (ξ ^ 2)] using hs\n have hRs (ξ : ℝ) (hξ : ξ ≠ 0) : Summable (fun n => R n ξ) := by\n simpa only [R, p, φ, add_comm (ξ ^ 2)] using\n (radial_probability_ray_resolvent_bound m hm μ x label θ hx hl hθ hinj ξ hξ).1\n have hb (ξ : ℝ) (hξ : ξ ≠ 0) : (∑' n, L n ξ) ≤ ∑' n, R n ξ := by\n have h := (radial_probability_ray_resolvent_bound m hm μ x label θ hx hl hθ hinj ξ hξ).2\n have heq (n : ℕ) : L n ξ = p 0 ξ *\n (1 / (ξ ^ 2 + ((m : ℝ) * ((n : ℝ) + 1)) ^ 2)) := by\n dsimp only [L]\n rw [mul_one_div, add_comm]\n simp_rw [heq]\n rw [tsum_mul_left]\n simpa only [p, φ, zero_mul, add_zero, R, add_comm (ξ ^ 2)] using h\n have hext := radial_nonnegative_mode_integral_comparison L R\n (fun n => (hL n).1) (fun n => (hR n).1) hLn hRn\n ((MeasureTheory.volume.ae_ne 0).mono fun ξ hξ => hLs ξ hξ)\n ((MeasureTheory.volume.ae_ne 0).mono fun ξ hξ => hRs ξ hξ)\n ((MeasureTheory.volume.ae_ne 0).mono fun ξ hξ => hb ξ hξ)\n calc\n _ = ∑' n, ENNReal.ofReal (1 / Real.pi) * ENNReal.ofReal (∫ ξ : ℝ, L n ξ) := by\n apply tsum_congr\n intro n\n rw [← ENNReal.ofReal_mul (by positivity)]\n congr 1\n simpa only [L, p, φ, zero_mul, add_zero, Real.cos_zero, mul_one] using (hL n).2\n _ = ENNReal.ofReal (1 / Real.pi) * (∑' n, ENNReal.ofReal (∫ ξ : ℝ, L n ξ)) :=\n ENNReal.tsum_mul_left\n _ ≤ ENNReal.ofReal (1 / Real.pi) * (∑' n, ENNReal.ofReal (∫ ξ : ℝ, R n ξ)) :=\n mul_le_mul' le_rfl hext\n _ = ∑' n, ENNReal.ofReal (1 / Real.pi) * ENNReal.ofReal (∫ ξ : ℝ, R n ξ) :=\n ENNReal.tsum_mul_left.symm\n _ = _ := by\n apply tsum_congr\n intro n\n rw [← ENNReal.ofReal_mul (by positivity)]\n congr 1\n exact (hR n).2.symm\ntheorem radial_log_abel_hasSum (s θ : ℝ) (hs : 0 ≤ s) (hs1 : s < 1) :\n HasSum (fun n : ℕ => s ^ (n + 1) / ((n : ℝ) + 1) *\n Real.cos (((n : ℝ) + 1) * θ))\n (-Real.log ‖1 - (s : ℂ) * Complex.exp ((θ : ℂ) * Complex.I)‖) := by\n have hz : ‖(s : ℂ) * Complex.exp ((θ : ℂ) * Complex.I)‖ < 1 := by\n simpa only [norm_mul, Complex.norm_real, Real.norm_eq_abs,\n abs_of_nonneg hs, Complex.norm_exp_ofReal_mul_I, mul_one] using hs1\n have h := Complex.hasSum_re (Complex.hasSum_taylorSeries_neg_log' hz)\n have heq (n : ℕ) :\n ((((s : ℂ) * Complex.exp ((θ : ℂ) * Complex.I)) ^ (n + 1)) /\n ((n : ℂ) + 1)).re =\n s ^ (n + 1) / ((n : ℝ) + 1) * Real.cos (((n : ℝ) + 1) * θ) := by\n simpa only [Nat.cast_add, Nat.cast_one] using radial_interval_phase_power_re s θ (n + 1)\n simp_rw [heq] at h\n simpa only [Complex.neg_re, Complex.log_re] using h\ntheorem radial_probability_abel_log_expansion {X : Type*} [MeasurableSpace X]\n (μ : MeasureTheory.ProbabilityMeasure X) (q φ : X → ℝ)\n (hq : Measurable q) (hφ : Measurable φ)\n (hq0 : ∀ z, 0 ≤ q z) (hq1 : ∀ z, q z ≤ 1)\n (r : ℝ) (hr : 0 ≤ r) (hr1 : r < 1) :\n HasSum (fun n : ℕ => r ^ (n + 1) / ((n : ℝ) + 1) *\n ∫ z : X, (q z) ^ (n + 1) * Real.cos (((n : ℝ) + 1) * φ z) ∂μ)\n (∫ z : X, -Real.log ‖1 - ((r * q z : ℝ) : ℂ) *\n Complex.exp (((φ z : ℝ) : ℂ) * Complex.I)‖ ∂μ) := by\n let F : ℕ → X → ℝ := fun n z => (r * q z) ^ (n + 1) / ((n : ℝ) + 1) *\n Real.cos (((n : ℝ) + 1) * φ z)\n have hdom (n : ℕ) (z : X) : ‖F n z‖ ≤ r ^ (n + 1) := by\n have hp : (r * q z) ^ (n + 1) ≤ r ^ (n + 1) :=\n pow_le_pow_left₀ (mul_nonneg hr (hq0 z)) (by nlinarith [hq1 z]) _\n have hqr : 0 ≤ r * q z := mul_nonneg hr (hq0 z)\n have hd : 0 ≤ (r * q z) ^ (n + 1) / ((n : ℝ) + 1) :=\n div_nonneg (pow_nonneg hqr _) (by positivity)\n have hc := Real.abs_cos_le_one (((n : ℝ) + 1) * φ z)\n calc\n ‖F n z‖ = ((r * q z) ^ (n + 1) / ((n : ℝ) + 1)) *\n |Real.cos (((n : ℝ) + 1) * φ z)| := by\n rw [Real.norm_eq_abs, abs_mul, abs_of_nonneg hd]\n _ ≤ (r * q z) ^ (n + 1) / ((n : ℝ) + 1) := by nlinarith\n _ ≤ (r * q z) ^ (n + 1) := div_le_self (pow_nonneg hqr _)\n (by linarith [Nat.cast_nonneg (α := ℝ) n])\n _ ≤ _ := hp\n have hs : Summable (fun n : ℕ => r ^ (n + 1)) :=\n (summable_geometric_of_lt_one hr hr1).comp_injective (fun a b h => by omega)\n have hi := MeasureTheory.hasSum_integral_of_dominated_convergence\n (μ := (μ : MeasureTheory.Measure X)) (F := F)\n (fun n (_ : X) => r ^ (n + 1))\n (fun n => by dsimp only [F]; fun_prop)\n (fun n => Filter.Eventually.of_forall (hdom n))\n (Filter.Eventually.of_forall (fun _ => hs))\n (MeasureTheory.integrable_const _)\n (Filter.Eventually.of_forall (fun z => radial_log_abel_hasSum (r * q z) (φ z)\n (mul_nonneg hr (hq0 z)) ((by nlinarith [hq1 z] : r * q z ≤ r).trans_lt hr1)))\n convert hi using 1\n funext n\n have heq (z : X) : F n z = (r ^ (n + 1) / ((n : ℝ) + 1)) *\n ((q z) ^ (n + 1) * Real.cos (((n : ℝ) + 1) * φ z)) := by\n dsimp only [F]\n rw [mul_pow]\n ring\n simp_rw [heq]\n rw [MeasureTheory.integral_const_mul]\ntheorem radial_probability_log_coordinate_abel_expansion {X : Type*}\n [MeasurableSpace X] (μ : MeasureTheory.ProbabilityMeasure X)\n (x φ : X → ℝ) (hx : Measurable x) (hφ : Measurable φ)\n (r : ℝ) (hr : 0 ≤ r) (hr1 : r < 1) :\n HasSum (fun n : ℕ => r ^ (n + 1) / ((n : ℝ) + 1) *\n ∫ z : X × X, Real.exp (-((n : ℝ) + 1) * |x z.2 - x z.1|) *\n Real.cos (((n : ℝ) + 1) * (φ z.2 - φ z.1)) ∂(μ.prod μ))\n (∫ z : X × X, -Real.log ‖1 -\n ((r * Real.exp (-|x z.2 - x z.1|) : ℝ) : ℂ) *\n Complex.exp (((φ z.2 - φ z.1 : ℝ) : ℂ) * Complex.I)‖ ∂(μ.prod μ)) := by\n have h := radial_probability_abel_log_expansion (μ.prod μ)\n (fun z : X × X => Real.exp (-|x z.2 - x z.1|))\n (fun z : X × X => φ z.2 - φ z.1) (by fun_prop) (by fun_prop)\n (fun z => (Real.exp_pos _).le)\n (fun z => Real.exp_le_one_iff.mpr (neg_nonpos.mpr (abs_nonneg _))) r hr hr1\n have heq (n : ℕ) (z : X × X) :\n Real.exp (-|x z.2 - x z.1|) ^ (n + 1) =\n Real.exp (-((n : ℝ) + 1) * |x z.2 - x z.1|) := by\n rw [← Real.exp_nat_mul]\n congr 1\n push_cast\n ring\n simpa only [heq] using h\ntheorem radial_abel_weighted_sum_gt (b : ℕ → ℝ)\n (hb : ∀ n, 0 ≤ b n) (hb1 : ∀ n, b n ≤ 1) (c : ℝ)\n (hc : c < 0 ∨ ENNReal.ofReal c < ∑' n, ENNReal.ofReal (b n)) :\n ∃ r : ℝ, 0 < r ∧ r < 1 ∧ Summable (fun n => r ^ (n + 1) * b n) ∧\n c < (∑' n, r ^ (n + 1) * b n) + Real.log r / 2 := by\n classical\n obtain ⟨s, hs⟩ : ∃ s : Finset ℕ, c < ∑ n ∈ s, b n := by\n rcases hc with hc | hc\n · exact ⟨∅, by simpa using hc⟩\n · rw [ENNReal.tsum_eq_iSup_sum] at hc\n obtain ⟨s, hs⟩ := lt_iSup_iff.mp hc\n rw [← ENNReal.ofReal_sum_of_nonneg (fun n _ => hb n)] at hs\n exact ⟨s, (ENNReal.ofReal_lt_ofReal_iff'.mp hs).1⟩\n let f : ℝ → ℝ := fun r => (∑ n ∈ s, r ^ (n + 1) * b n) + Real.log r / 2\n have hf : ContinuousAt f 1 := by dsimp only [f]; fun_prop (disch := norm_num)\n have hf1 : c < f 1 := by simpa [f] using hs\n have hevent : ∀ᶠ r in nhds (1 : ℝ), c < f r :=\n continuousAt_const.eventually_lt hf hf1\n obtain ⟨l, u, hlu, hsub⟩ := hevent.exists_Ioo_subset\n let r : ℝ := (max l 0 + 1) / 2\n have hmax : max l 0 < 1 := max_lt hlu.1 (by norm_num)\n have hr : 0 < r := by dsimp [r]; linarith [le_max_right l 0]\n have hr1 : r < 1 := by dsimp [r]; linarith\n have hlr : l < r := by dsimp [r]; linarith [le_max_left l 0]\n have hfgt := hsub ⟨hlr, hr1.trans hlu.2⟩\n have hg : Summable (fun n : ℕ => r ^ (n + 1)) :=\n (summable_geometric_of_lt_one hr.le hr1).comp_injective (fun a b h => by omega)\n have hbnd (n : ℕ) : r ^ (n + 1) * b n ≤ r ^ (n + 1) :=\n mul_le_of_le_one_right (pow_nonneg hr.le _) (hb1 n)\n have hsumm : Summable (fun n : ℕ => r ^ (n + 1) * b n) :=\n hg.of_nonneg_of_le (fun n => mul_nonneg (pow_nonneg hr.le _) (hb n)) hbnd\n refine ⟨r, hr, hr1, hsumm, ?_⟩\n have hsum := hsumm.sum_le_tsum s (fun n _ => mul_nonneg (pow_nonneg hr.le _) (hb n))\n change c < (∑ n ∈ s, r ^ (n + 1) * b n) + Real.log r / 2 at hfgt\n linarith only [hfgt, hsum]\ntheorem radial_interval_truncated_energy_bound_map {X : Type*}\n [MeasurableSpace X] (μ : MeasureTheory.ProbabilityMeasure X)\n (s : X → Set.Icc (0 : ℝ) 1) (hs : Measurable s)\n (c : ℝ) (hc : c < Real.log 4) :\n ∃ N : ℕ, c < ∫ z : X × X,\n -Real.log (max (Real.exp (-(N : ℝ))) |(s z.1 : ℝ) - (s z.2 : ℝ)|) ∂(μ.prod μ) := by\n obtain ⟨N, hN⟩ := radial_interval_truncated_energy_bound c hc (μ.map s)\n refine ⟨N, ?_⟩\n have hcont : Continuous (fun z : Set.Icc (0 : ℝ) 1 × Set.Icc (0 : ℝ) 1 =>\n -Real.log (max (Real.exp (-(N : ℝ))) (dist z.1 z.2))) :=\n ((continuous_const.max (continuous_fst.dist continuous_snd)).log\n (fun z => ne_of_gt ((Real.exp_pos _).trans_le (le_max_left _ _)))).neg\n rw [MeasureTheory.ProbabilityMeasure.map_prod_map μ μ hs hs,\n MeasureTheory.ProbabilityMeasure.toMeasure_map,\n MeasureTheory.integral_map (hs.prodMap hs).aemeasurable\n hcont.stronglyMeasurable.aestronglyMeasurable] at hN\n simpa only [Prod.map_fst, Prod.map_snd, Subtype.dist_eq, Real.dist_eq] using hN\ntheorem radial_exp_interval_abel_factor (a b k r : ℝ) (hk : 0 ≤ k) :\n max (Real.exp (-k * a)) (Real.exp (-k * b)) -\n r * min (Real.exp (-k * a)) (Real.exp (-k * b)) =\n Real.exp (-k * min a b) * (1 - r * Real.exp (-k * |b - a|)) := by\n rcases le_total a b with hab | hba\n · have he : Real.exp (-k * b) ≤ Real.exp (-k * a) :=\n Real.exp_le_exp.mpr (by nlinarith)\n have hprod : Real.exp (-k * a) * Real.exp (-k * (b - a)) = Real.exp (-k * b) := by\n rw [← Real.exp_add]\n congr 1\n ring\n rw [max_eq_left he, min_eq_right he, min_eq_left hab,\n abs_of_nonneg (sub_nonneg.mpr hab)]\n calc\n _ = Real.exp (-k * a) - r * (Real.exp (-k * a) * Real.exp (-k * (b - a))) := by\n rw [hprod]\n _ = _ := by ring\n · have he : Real.exp (-k * a) ≤ Real.exp (-k * b) :=\n Real.exp_le_exp.mpr (by nlinarith)\n have hprod : Real.exp (-k * b) * Real.exp (-k * -(b - a)) = Real.exp (-k * a) := by\n rw [← Real.exp_add]\n congr 1\n ring\n rw [max_eq_right he, min_eq_left he, min_eq_right hba,\n abs_of_nonpos (sub_nonpos.mpr hba)]\n calc\n _ = Real.exp (-k * b) - r * (Real.exp (-k * b) * Real.exp (-k * -(b - a))) := by\n rw [hprod]\n _ = _ := by ring\ntheorem radial_exp_interval_log_abel_factor (a b k r : ℝ)\n (hk : 0 ≤ k) (hr : 0 ≤ r) (hr1 : r < 1) :\n -Real.log (max (Real.exp (-k * a)) (Real.exp (-k * b)) -\n r * min (Real.exp (-k * a)) (Real.exp (-k * b))) =\n k * min a b - Real.log (1 - r * Real.exp (-k * |b - a|)) := by\n have hq : Real.exp (-k * |b - a|) ≤ 1 :=\n Real.exp_le_one_iff.mpr (by nlinarith [abs_nonneg (b - a)])\n have hp : 0 < 1 - r * Real.exp (-k * |b - a|) := by\n nlinarith [mul_le_mul_of_nonneg_left hq hr]\n rw [radial_exp_interval_abel_factor a b k r hk,\n Real.log_mul (Real.exp_pos _).ne' hp.ne', Real.log_exp]\n ring\ntheorem radial_probability_real_abel_integrable {X : Type*} [MeasurableSpace X]\n (μ : MeasureTheory.ProbabilityMeasure X) (q : X → ℝ) (hq : Measurable q)\n (hq0 : ∀ z, 0 ≤ q z) (hq1 : ∀ z, q z ≤ 1)\n (r : ℝ) (hr : 0 ≤ r) (hr1 : r < 1) :\n MeasureTheory.Integrable (fun z => -Real.log (1 - r * q z)) μ := by\n have hp (z : X) : 0 < 1 - r * q z := by\n nlinarith [mul_le_mul_of_nonneg_left (hq1 z) hr]\n apply MeasureTheory.Integrable.of_bound\n ((measurable_const.sub (measurable_const.mul hq)).log.neg.aestronglyMeasurable)\n (-Real.log (1 - r))\n filter_upwards with z\n change ‖-Real.log (1 - r * q z)‖ ≤ -Real.log (1 - r)\n have hlog : Real.log (1 - r * q z) ≤ 0 :=\n Real.log_nonpos (hp z).le (by nlinarith [mul_nonneg hr (hq0 z)])\n rw [Real.norm_eq_abs, abs_of_nonneg (neg_nonneg.mpr hlog)]\n exact neg_le_neg (Real.log_le_log (by linarith) (by\n nlinarith [mul_le_mul_of_nonneg_left (hq1 z) hr]))\ntheorem radial_interval_log_coordinate_cutoff_le_abel_of_integrable {X : Type*}\n [MeasurableSpace X] (μ : MeasureTheory.ProbabilityMeasure X)\n (x : X → ℝ) (hx : Measurable x) (k r : ℝ)\n (hx0 : ∀ z, 0 ≤ x z)\n (hmin : MeasureTheory.Integrable (fun z : X × X =>\n min (x z.1) (x z.2)) (μ.prod μ))\n (hk : 0 ≤ k) (hr : 0 < r) (hr1 : r < 1) (N : ℕ) :\n (∫ z : X × X, -Real.log (max (Real.exp (-(N : ℝ)))\n |Real.exp (-k * x z.1) - Real.exp (-k * x z.2)|) ∂(μ.prod μ)) ≤\n k * (∫ z : X × X, min (x z.1) (x z.2) ∂(μ.prod μ)) +\n (∫ z : X × X, -Real.log (1 - r *\n Real.exp (-k * |x z.2 - x z.1|)) ∂(μ.prod μ)) +\n Real.log (1 + (1 - r) * Real.exp (N : ℝ)) := by\n let s : X → ℝ := fun z => Real.exp (-k * x z)\n have hs0 (z : X) : 0 < s z := Real.exp_pos _\n have hs1 (z : X) : s z ≤ 1 :=\n Real.exp_le_one_iff.mpr (by nlinarith [hx0 z])\n have hlog := radial_probability_real_abel_integrable (μ.prod μ)\n (fun z : X × X => Real.exp (-k * |x z.2 - x z.1|)) (by fun_prop)\n (fun z => (Real.exp_pos _).le)\n (fun z => Real.exp_le_one_iff.mpr (by nlinarith [abs_nonneg (x z.2 - x z.1)]))\n r hr.le hr1\n have hcut : MeasureTheory.Integrable (fun z : X × X =>\n -Real.log (max (Real.exp (-(N : ℝ))) |s z.1 - s z.2|)) (μ.prod μ) := by\n apply MeasureTheory.Integrable.of_bound\n ((show Measurable (fun z : X × X =>\n max (Real.exp (-(N : ℝ))) |s z.1 - s z.2|) by dsimp [s]; fun_prop).log.neg.aestronglyMeasurable)\n (N : ℝ)\n filter_upwards with z\n change ‖-Real.log (max (Real.exp (-(N : ℝ))) |s z.1 - s z.2|)‖ ≤ (N : ℝ)\n have hpos : 0 < max (Real.exp (-(N : ℝ))) |s z.1 - s z.2| :=\n (Real.exp_pos _).trans_le (le_max_left _ _)\n have hle : max (Real.exp (-(N : ℝ))) |s z.1 - s z.2| ≤ 1 := by\n apply max_le (Real.exp_le_one_iff.mpr (neg_nonpos.mpr (Nat.cast_nonneg N)))\n exact abs_le.mpr ⟨by linarith [hs0 z.1, hs1 z.2], by linarith [hs1 z.1, hs0 z.2]⟩\n rw [Real.norm_eq_abs, abs_of_nonneg (neg_nonneg.mpr (Real.log_nonpos hpos.le hle))]\n have h := Real.log_le_log (Real.exp_pos (-(N : ℝ)))\n (le_max_left (Real.exp (-(N : ℝ))) |s z.1 - s z.2|)\n rw [Real.log_exp] at h\n linarith\n have hi := MeasureTheory.integral_mono hcut\n (((hmin.const_mul k).add hlog).add (MeasureTheory.integrable_const\n (Real.log (1 + (1 - r) * Real.exp (N : ℝ))))) (fun z => ?_)\n · dsimp only [Pi.add_apply] at hi\n have houter := MeasureTheory.integral_add ((hmin.const_mul k).add hlog)\n (MeasureTheory.integrable_const (Real.log (1 + (1 - r) * Real.exp (N : ℝ))))\n have hinner := MeasureTheory.integral_add (hmin.const_mul k) hlog\n dsimp only [Pi.add_apply] at houter hinner\n rw [houter, hinner,\n MeasureTheory.integral_const_mul,\n MeasureTheory.integral_const, MeasureTheory.probReal_univ, one_smul]\n at hi\n exact hi\n · have h := radial_interval_cutoff_le_abel (s z.1) (s z.2) r N\n (hs0 _).le (hs1 _) (hs0 _).le (hs1 _)\n ((hs0 _).trans_le (le_max_left _ _)) hr hr1\n change -Real.log (max (Real.exp (-(N : ℝ))) |s z.1 - s z.2|) - _ ≤\n -Real.log (max (Real.exp (-k * x z.1)) (Real.exp (-k * x z.2)) -\n r * min (Real.exp (-k * x z.1)) (Real.exp (-k * x z.2))) at h\n rw [radial_exp_interval_log_abel_factor (x z.1) (x z.2) k r hk hr.le hr1] at h\n dsimp only [Pi.add_apply]\n linarith only [h]\ntheorem radial_interval_log_coordinate_cutoff_le_abel {X : Type*}\n [MeasurableSpace X] (μ : MeasureTheory.ProbabilityMeasure X)\n (x : X → ℝ) (hx : Measurable x) (L k r : ℝ)\n (hx0 : ∀ z, 0 ≤ x z) (hxL : ∀ z, x z ≤ L)\n (hk : 0 ≤ k) (hr : 0 < r) (hr1 : r < 1) (N : ℕ) :\n (∫ z : X × X, -Real.log (max (Real.exp (-(N : ℝ)))\n |Real.exp (-k * x z.1) - Real.exp (-k * x z.2)|) ∂(μ.prod μ)) ≤\n k * (∫ z : X × X, min (x z.1) (x z.2) ∂(μ.prod μ)) +\n (∫ z : X × X, -Real.log (1 - r *\n Real.exp (-k * |x z.2 - x z.1|)) ∂(μ.prod μ)) +\n Real.log (1 + (1 - r) * Real.exp (N : ℝ)) := by\n have hmin : MeasureTheory.Integrable (fun z : X × X =>\n min (x z.1) (x z.2)) (μ.prod μ) := by\n apply MeasureTheory.Integrable.of_bound (by fun_prop) L\n filter_upwards with z\n rw [Real.norm_eq_abs, abs_of_nonneg (le_min (hx0 _) (hx0 _))]\n exact (min_le_left _ _).trans (hxL _)\n exact radial_interval_log_coordinate_cutoff_le_abel_of_integrable μ x hx k r hx0 hmin hk hr hr1 N\ntheorem radial_probability_real_abel_expansion {X : Type*} [MeasurableSpace X]\n (μ : MeasureTheory.ProbabilityMeasure X) (q : X → ℝ) (hq : Measurable q)\n (hq0 : ∀ z, 0 ≤ q z) (hq1 : ∀ z, q z ≤ 1)\n (r : ℝ) (hr : 0 ≤ r) (hr1 : r < 1) :\n HasSum (fun n : ℕ => r ^ (n + 1) / ((n : ℝ) + 1) *\n ∫ z : X, (q z) ^ (n + 1) ∂μ)\n (∫ z : X, -Real.log (1 - r * q z) ∂μ) := by\n have h := radial_probability_abel_log_expansion μ q (fun _ => 0) hq measurable_const\n hq0 hq1 r hr hr1\n have hp (z : X) : 0 < 1 - r * q z := by\n nlinarith [mul_le_mul_of_nonneg_left (hq1 z) hr]\n have hnorm (z : X) : ‖(1 : ℂ) - ((r * q z : ℝ) : ℂ)‖ = 1 - r * q z := by\n rw [← Complex.ofReal_one, ← Complex.ofReal_sub, Complex.norm_real,\n Real.norm_eq_abs, abs_of_pos (hp z)]\n simpa only [mul_zero, Real.cos_zero, mul_one, Complex.ofReal_zero, zero_mul,\n Complex.exp_zero, hnorm] using h\ntheorem radial_interval_log_coordinate_series_bound_of_integrable {X : Type*} [MeasurableSpace X]\n (μ : MeasureTheory.ProbabilityMeasure X) (x : X → ℝ) (hx : Measurable x)\n (k : ℝ) (hx0 : ∀ z, 0 ≤ x z)\n (hmin : MeasureTheory.Integrable (fun z : X × X =>\n min (x z.1) (x z.2)) (μ.prod μ)) (hk : 0 < k)\n (hs : Summable (fun n : ℕ =>\n (∫ z : X × X, Real.exp (-(k * ((n : ℝ) + 1)) * |x z.2 - x z.1|) ∂(μ.prod μ)) /\n (k * ((n : ℝ) + 1)))) :\n Real.log 4 / k ≤\n (∫ z : X × X, min (x z.1) (x z.2) ∂(μ.prod μ)) +\n ∑' n : ℕ, (∫ z : X × X,\n Real.exp (-(k * ((n : ℝ) + 1)) * |x z.2 - x z.1|) ∂(μ.prod μ)) /\n (k * ((n : ℝ) + 1)) := by\n let I : ℝ := ∫ z : X × X, min (x z.1) (x z.2) ∂(μ.prod μ)\n let b : ℕ → ℝ := fun n =>\n (∫ z : X × X, Real.exp (-(k * ((n : ℝ) + 1)) * |x z.2 - x z.1|) ∂(μ.prod μ)) /\n (k * ((n : ℝ) + 1))\n have hb (n : ℕ) : 0 ≤ b n := by\n apply div_nonneg\n · exact MeasureTheory.integral_nonneg (fun _ => (Real.exp_pos _).le)\n · positivity\n have hs' : Summable b := hs\n have hsum : Real.log 4 ≤ k * (I + ∑' n, b n) := by\n apply le_of_forall_lt\n intro c hc\n let s : X → Set.Icc (0 : ℝ) 1 := fun z => ⟨Real.exp (-k * x z),\n (Real.exp_pos _).le, Real.exp_le_one_iff.mpr (by nlinarith [hx0 z])⟩\n have hsm : Measurable s := by\n apply Measurable.subtype_mk\n fun_prop\n obtain ⟨N, hN⟩ := radial_interval_truncated_energy_bound_map μ s hsm c hc\n have hbound (r : ℝ) (hr : 0 < r) (hr1 : r < 1) :\n (∫ z : X × X, -Real.log (max (Real.exp (-(N : ℝ)))\n |Real.exp (-k * x z.1) - Real.exp (-k * x z.2)|) ∂(μ.prod μ)) ≤\n k * (I + ∑' n, b n) + Real.log (1 + (1 - r) * Real.exp (N : ℝ)) := by\n have hAb := radial_probability_real_abel_expansion (μ.prod μ)\n (fun z : X × X => Real.exp (-k * |x z.2 - x z.1|)) (by fun_prop)\n (fun _ => (Real.exp_pos _).le)\n (fun z => Real.exp_le_one_iff.mpr (by nlinarith [abs_nonneg (x z.2 - x z.1)]))\n r hr.le hr1\n have heq (n : ℕ) :\n r ^ (n + 1) / ((n : ℝ) + 1) *\n (∫ z : X × X, Real.exp (-k * |x z.2 - x z.1|) ^ (n + 1) ∂(μ.prod μ)) =\n r ^ (n + 1) * (k * b n) := by\n have hpow (z : X × X) : Real.exp (-k * |x z.2 - x z.1|) ^ (n + 1) =\n Real.exp (-(k * ((n : ℝ) + 1)) * |x z.2 - x z.1|) := by\n rw [← Real.exp_nat_mul]\n congr 1\n push_cast\n ring\n simp_rw [hpow]\n dsimp only [b]\n field_simp\n simp_rw [heq] at hAb\n have hle := hAb.summable.tsum_le_tsum\n (fun n => mul_le_of_le_one_left (mul_nonneg hk.le (hb n))\n (pow_le_one₀ hr.le hr1.le)) (hs'.mul_left k)\n rw [tsum_mul_left, hAb.tsum_eq] at hle\n have h := radial_interval_log_coordinate_cutoff_le_abel_of_integrable μ x hx k r hx0 hmin\n hk.le hr hr1 N\n change _ ≤ k * I + _ + _ at h\n nlinarith only [h, hle]\n by_contra hbad\n have hbad' : k * (I + ∑' n, b n) ≤ c := le_of_not_gt hbad\n have hcont : ContinuousAt (fun r : ℝ =>\n k * (I + ∑' n, b n) + Real.log (1 + (1 - r) * Real.exp (N : ℝ))) 1 := by\n fun_prop (disch := norm_num)\n have hgap : k * (I + ∑' n, b n) <\n ∫ z : X × X, -Real.log (max (Real.exp (-(N : ℝ)))\n |Real.exp (-k * x z.1) - Real.exp (-k * x z.2)|) ∂(μ.prod μ) :=\n hbad'.trans_lt hN\n have hevent := hcont.eventually_lt continuousAt_const (by simpa only\n [sub_self, zero_mul, add_zero, Real.log_one] using hgap)\n obtain ⟨l, u, hlu, hsub⟩ := hevent.exists_Ioo_subset\n let r : ℝ := (max l 0 + 1) / 2\n have hmax : max l 0 < 1 := max_lt hlu.1 (by norm_num)\n have hr : 0 < r := by dsimp [r]; linarith [le_max_right l 0]\n have hr1 : r < 1 := by dsimp [r]; linarith\n have hlr : l < r := by dsimp [r]; linarith [le_max_left l 0]\n exact (not_lt_of_ge (hbound r hr hr1)) (hsub ⟨hlr, hr1.trans hlu.2⟩)\n exact (div_le_iff₀ hk).mpr (by nlinarith only [hsum])\ntheorem radial_interval_log_coordinate_series_bound {X : Type*} [MeasurableSpace X]\n (μ : MeasureTheory.ProbabilityMeasure X) (x : X → ℝ) (hx : Measurable x)\n (L k : ℝ) (hx0 : ∀ z, 0 ≤ x z) (hxL : ∀ z, x z ≤ L) (hk : 0 < k)\n (hs : Summable (fun n : ℕ =>\n (∫ z : X × X, Real.exp (-(k * ((n : ℝ) + 1)) * |x z.2 - x z.1|) ∂(μ.prod μ)) /\n (k * ((n : ℝ) + 1)))) :\n Real.log 4 / k ≤\n (∫ z : X × X, min (x z.1) (x z.2) ∂(μ.prod μ)) +\n ∑' n : ℕ, (∫ z : X × X,\n Real.exp (-(k * ((n : ℝ) + 1)) * |x z.2 - x z.1|) ∂(μ.prod μ)) /\n (k * ((n : ℝ) + 1)) := by\n have hmin : MeasureTheory.Integrable (fun z : X × X =>\n min (x z.1) (x z.2)) (μ.prod μ) := by\n apply MeasureTheory.Integrable.of_bound (by fun_prop) L\n filter_upwards with z\n rw [Real.norm_eq_abs, abs_of_nonneg (le_min (hx0 _) (hx0 _))]\n exact (min_le_left _ _).trans (hxL _)\n exact radial_interval_log_coordinate_series_bound_of_integrable μ x hx k hx0 hmin hk hs\ntheorem radial_interval_log_coordinate_mode_sum_bound_of_integrable {X : Type*} [MeasurableSpace X]\n (μ : MeasureTheory.ProbabilityMeasure X) (x : X → ℝ) (hx : Measurable x)\n (k : ℝ) (hx0 : ∀ z, 0 ≤ x z)\n (hmin : MeasureTheory.Integrable (fun z : X × X =>\n min (x z.1) (x z.2)) (μ.prod μ)) (hk : 0 < k) :\n ENNReal.ofReal (Real.log 4 / k) ≤\n ENNReal.ofReal (∫ z : X × X, min (x z.1) (x z.2) ∂(μ.prod μ)) +\n ∑' n : ℕ, ENNReal.ofReal ((∫ z : X × X,\n Real.exp (-(k * ((n : ℝ) + 1)) * |x z.2 - x z.1|) ∂(μ.prod μ)) /\n (k * ((n : ℝ) + 1))) := by\n let b : ℕ → ℝ := fun n => (∫ z : X × X,\n Real.exp (-(k * ((n : ℝ) + 1)) * |x z.2 - x z.1|) ∂(μ.prod μ)) /\n (k * ((n : ℝ) + 1))\n have hb (n : ℕ) : 0 ≤ b n := by\n exact div_nonneg (MeasureTheory.integral_nonneg (fun _ => (Real.exp_pos _).le))\n (by positivity)\n have hI : 0 ≤ ∫ z : X × X, min (x z.1) (x z.2) ∂(μ.prod μ) :=\n MeasureTheory.integral_nonneg (fun z => le_min (hx0 _) (hx0 _))\n by_cases htop : (∑' n, ENNReal.ofReal (b n)) = ⊤\n · change _ ≤ _ + ∑' n, ENNReal.ofReal (b n)\n simp only [htop, add_top, le_top]\n have hs : Summable b := by\n simpa only [ENNReal.toReal_ofReal (hb _)] using ENNReal.summable_toReal htop\n change _ ≤ _ + ∑' n, ENNReal.ofReal (b n)\n rw [← ENNReal.ofReal_tsum_of_nonneg hb hs,\n ← ENNReal.ofReal_add hI (tsum_nonneg hb)]\n exact ENNReal.ofReal_le_ofReal\n (radial_interval_log_coordinate_series_bound_of_integrable μ x hx k hx0 hmin hk hs)\ntheorem radial_interval_log_coordinate_mode_sum_bound {X : Type*} [MeasurableSpace X]\n (μ : MeasureTheory.ProbabilityMeasure X) (x : X → ℝ) (hx : Measurable x)\n (L k : ℝ) (hx0 : ∀ z, 0 ≤ x z) (hxL : ∀ z, x z ≤ L) (hk : 0 < k) :\n ENNReal.ofReal (Real.log 4 / k) ≤\n ENNReal.ofReal (∫ z : X × X, min (x z.1) (x z.2) ∂(μ.prod μ)) +\n ∑' n : ℕ, ENNReal.ofReal ((∫ z : X × X,\n Real.exp (-(k * ((n : ℝ) + 1)) * |x z.2 - x z.1|) ∂(μ.prod μ)) /\n (k * ((n : ℝ) + 1))) := by\n have hmin : MeasureTheory.Integrable (fun z : X × X =>\n min (x z.1) (x z.2)) (μ.prod μ) := by\n apply MeasureTheory.Integrable.of_bound (by fun_prop) L\n filter_upwards with z\n rw [Real.norm_eq_abs, abs_of_nonneg (le_min (hx0 _) (hx0 _))]\n exact (min_le_left _ _).trans (hxL _)\n exact radial_interval_log_coordinate_mode_sum_bound_of_integrable μ x hx k hx0 hmin hk\ntheorem radial_probability_ray_abel_energy_gap_of_integrable {X : Type*} [MeasurableSpace X]\n (m : ℕ) (hm : 0 < m) (μ : MeasureTheory.ProbabilityMeasure X)\n (x : X → ℝ) (label : X → Fin m) (θ : Fin m → ℝ)\n (hx : Measurable x) (hl : Measurable label)\n (hθ : ∀ i, θ i ∈ Set.Ico 0 (2 * Real.pi)) (hinj : Function.Injective θ)\n (hx0 : ∀ z, 0 ≤ x z)\n (hmin : MeasureTheory.Integrable (fun z : X × X =>\n min (x z.1) (x z.2)) (μ.prod μ))\n (c : ℝ) (hc : c < Real.log 4 / (m : ℝ)) :\n ∃ r : ℝ, 0 < r ∧ r < 1 ∧\n c < (∫ z : X × X, min (x z.1) (x z.2) ∂(μ.prod μ)) +\n (∫ z : X × X, -Real.log ‖1 -\n ((r * Real.exp (-|x z.2 - x z.1|) : ℝ) : ℂ) *\n Complex.exp (((θ (label z.2) - θ (label z.1) : ℝ) : ℂ) *\n Complex.I)‖ ∂(μ.prod μ)) + Real.log r / 2 := by\n let I : ℝ := ∫ z : X × X, min (x z.1) (x z.2) ∂(μ.prod μ)\n let b : ℕ → ℝ := fun n => (∫ z : X × X,\n Real.exp (-((n : ℝ) + 1) * |x z.2 - x z.1|) *\n Real.cos (((n : ℝ) + 1) * (θ (label z.2) - θ (label z.1))) ∂(μ.prod μ)) /\n ((n : ℝ) + 1)\n have hφ : Measurable (fun z => θ (label z)) := (measurable_of_countable θ).comp hl\n have hb (n : ℕ) : 0 ≤ b n :=\n div_nonneg (radial_probability_cos_mode_nonneg μ x _ hx hφ _ _ (by positivity))\n (by positivity)\n have hb1 (n : ℕ) : b n ≤ 1 := by\n have hpoint (z : X × X) :\n ‖Real.exp (-((n : ℝ) + 1) * |x z.2 - x z.1|) *\n Real.cos (((n : ℝ) + 1) * (θ (label z.2) - θ (label z.1)))‖ ≤ 1 := by\n have he : Real.exp (-((n : ℝ) + 1) * |x z.2 - x z.1|) ≤ 1 :=\n Real.exp_le_one_iff.mpr (by nlinarith [abs_nonneg (x z.2 - x z.1)])\n rw [Real.norm_eq_abs, abs_mul, abs_of_pos (Real.exp_pos _)]\n exact (mul_le_mul_of_nonneg_left (Real.abs_cos_le_one _) (Real.exp_pos _).le).trans\n (by simpa only [mul_one] using he)\n have hInt : (∫ z : X × X, Real.exp (-((n : ℝ) + 1) * |x z.2 - x z.1|) *\n Real.cos (((n : ℝ) + 1) * (θ (label z.2) - θ (label z.1))) ∂(μ.prod μ)) ≤ 1 :=\n (le_abs_self _).trans (by\n simpa only [Real.norm_eq_abs, MeasureTheory.probReal_univ, mul_one] using\n MeasureTheory.norm_integral_le_of_norm_le_const\n (μ := (μ.prod μ : MeasureTheory.Measure (X × X)))\n (Filter.Eventually.of_forall hpoint))\n exact (div_le_iff₀ (by positivity : 0 < (n : ℝ) + 1)).mpr\n (by simpa only [one_mul] using hInt.trans (by linarith [Nat.cast_nonneg (α := ℝ) n]))\n have hI : 0 ≤ I := MeasureTheory.integral_nonneg (fun _ => le_min (hx0 _) (hx0 _))\n have hbound : ENNReal.ofReal (Real.log 4 / (m : ℝ)) ≤\n ENNReal.ofReal I + ∑' n, ENNReal.ofReal (b n) :=\n (radial_interval_log_coordinate_mode_sum_bound_of_integrable μ x hx (m : ℝ) hx0 hmin\n (by positivity)).trans (add_le_add le_rfl\n (radial_probability_ray_mode_sum_bound m hm μ x label θ hx hl hθ hinj))\n have hc' : c - I < 0 ∨ ENNReal.ofReal (c - I) < ∑' n, ENNReal.ofReal (b n) := by\n by_cases htop : (∑' n, ENNReal.ofReal (b n)) = ⊤\n · exact Or.inr (by rw [htop]; exact ENNReal.ofReal_lt_top)\n have hs : Summable b := by\n simpa only [ENNReal.toReal_ofReal (hb _)] using ENNReal.summable_toReal htop\n rw [← ENNReal.ofReal_tsum_of_nonneg hb hs,\n ← ENNReal.ofReal_add hI (tsum_nonneg hb),\n ENNReal.ofReal_le_ofReal_iff (add_nonneg hI (tsum_nonneg hb))] at hbound\n have hlt : c - I < ∑' n, b n := by linarith only [hc, hbound]\n by_cases hneg : c - I < 0\n · exact Or.inl hneg\n · exact Or.inr (by\n rw [← ENNReal.ofReal_tsum_of_nonneg hb hs]\n exact ENNReal.ofReal_lt_ofReal_iff'.mpr ⟨hlt, lt_of_le_of_lt (le_of_not_gt hneg) hlt⟩)\n obtain ⟨r, hr, hr1, _, hgap⟩ := radial_abel_weighted_sum_gt b hb hb1 (c - I) hc'\n have hAb := radial_probability_log_coordinate_abel_expansion μ x (fun z => θ (label z))\n hx hφ r hr.le hr1\n have heq (n : ℕ) : r ^ (n + 1) / ((n : ℝ) + 1) *\n (∫ z : X × X, Real.exp (-((n : ℝ) + 1) * |x z.2 - x z.1|) *\n Real.cos (((n : ℝ) + 1) * (θ (label z.2) - θ (label z.1))) ∂(μ.prod μ)) =\n r ^ (n + 1) * b n := by dsimp only [b]; ring\n simp_rw [heq] at hAb\n rw [hAb.tsum_eq] at hgap\n exact ⟨r, hr, hr1, by linarith only [hgap]⟩\ntheorem radial_probability_ray_abel_energy_gap {X : Type*} [MeasurableSpace X]\n (m : ℕ) (hm : 0 < m) (μ : MeasureTheory.ProbabilityMeasure X)\n (x : X → ℝ) (label : X → Fin m) (θ : Fin m → ℝ)\n (hx : Measurable x) (hl : Measurable label)\n (hθ : ∀ i, θ i ∈ Set.Ico 0 (2 * Real.pi)) (hinj : Function.Injective θ)\n (L : ℝ) (hx0 : ∀ z, 0 ≤ x z) (hxL : ∀ z, x z ≤ L)\n (c : ℝ) (hc : c < Real.log 4 / (m : ℝ)) :\n ∃ r : ℝ, 0 < r ∧ r < 1 ∧\n c < (∫ z : X × X, min (x z.1) (x z.2) ∂(μ.prod μ)) +\n (∫ z : X × X, -Real.log ‖1 -\n ((r * Real.exp (-|x z.2 - x z.1|) : ℝ) : ℂ) *\n Complex.exp (((θ (label z.2) - θ (label z.1) : ℝ) : ℂ) *\n Complex.I)‖ ∂(μ.prod μ)) + Real.log r / 2 := by\n have hmin : MeasureTheory.Integrable (fun z : X × X =>\n min (x z.1) (x z.2)) (μ.prod μ) := by\n apply MeasureTheory.Integrable.of_bound (by fun_prop) L\n filter_upwards with z\n rw [Real.norm_eq_abs, abs_of_nonneg (le_min (hx0 _) (hx0 _))]\n exact (min_le_left _ _).trans (hxL _)\n exact radial_probability_ray_abel_energy_gap_of_integrable m hm μ x label θ hx hl hθ hinj hx0 hmin c hc\ntheorem radial_probability_complex_abel_integrable {X : Type*} [MeasurableSpace X]\n (μ : MeasureTheory.ProbabilityMeasure X) (q φ : X → ℝ)\n (hq : Measurable q) (hφ : Measurable φ)\n (hq0 : ∀ z, 0 ≤ q z) (hq1 : ∀ z, q z ≤ 1)\n (r : ℝ) (hr : 0 ≤ r) (hr1 : r < 1) :\n MeasureTheory.Integrable (fun z => -Real.log ‖1 - ((r * q z : ℝ) : ℂ) *\n Complex.exp (((φ z : ℝ) : ℂ) * Complex.I)‖) μ := by\n have hm : Measurable (fun z => ‖1 - ((r * q z : ℝ) : ℂ) *\n Complex.exp (((φ z : ℝ) : ℂ) * Complex.I)‖) := by fun_prop\n apply MeasureTheory.Integrable.of_bound hm.log.neg.aestronglyMeasurable\n (-Real.log (1 - r) + Real.log 2)\n filter_upwards with z\n change ‖-Real.log ‖1 - ((r * q z : ℝ) : ℂ) *\n Complex.exp (((φ z : ℝ) : ℂ) * Complex.I)‖‖ ≤ _\n have hq' : 0 ≤ r * q z := mul_nonneg hr (hq0 z)\n have hq'' : r * q z ≤ r := by nlinarith [hq1 z]\n have hlower := radial_interval_phase_norm_lower (r * q z) (φ z) hq'\n have hpos : 0 < ‖1 - ((r * q z : ℝ) : ℂ) *\n Complex.exp (((φ z : ℝ) : ℂ) * Complex.I)‖ := by linarith\n have hupper : ‖1 - ((r * q z : ℝ) : ℂ) *\n Complex.exp (((φ z : ℝ) : ℂ) * Complex.I)‖ ≤ 2 := by\n have h := norm_sub_le (1 : ℂ) (((r * q z : ℝ) : ℂ) *\n Complex.exp (((φ z : ℝ) : ℂ) * Complex.I))\n simp only [norm_one, norm_mul, Complex.norm_real, Real.norm_eq_abs,\n abs_of_nonneg hr, abs_of_nonneg (hq0 z),\n Complex.norm_exp_ofReal_mul_I, mul_one] at h\n linarith\n have hlogL := Real.log_le_log (by linarith : 0 < 1 - r)\n (show 1 - r ≤ ‖1 - ((r * q z : ℝ) : ℂ) *\n Complex.exp (((φ z : ℝ) : ℂ) * Complex.I)‖ by linarith only [hlower, hq''])\n have hlogU := Real.log_le_log hpos hupper\n have hrlog : Real.log (1 - r) ≤ 0 := Real.log_nonpos (by linarith) (by linarith)\n have htwo : 0 ≤ Real.log 2 := Real.log_nonneg (by norm_num)\n rw [Real.norm_eq_abs]\n exact abs_le.mpr ⟨by linarith, by linarith⟩\ntheorem radial_log_coordinate_abel_le_cutoff (u q θ r : ℝ)\n (hq : 0 ≤ q) (hq1 : q ≤ 1) (hr : 0 < r) (hr1 : r < 1) (N : ℕ) :\n u - Real.log ‖1 - ((r * q : ℝ) : ℂ) * Complex.exp ((θ : ℂ) * Complex.I)‖ ≤\n -Real.log (max (Real.exp (-(N : ℝ)))\n (Real.exp (-u) * ‖1 - (q : ℂ) * Complex.exp ((θ : ℂ) * Complex.I)‖)) -\n Real.log r / 2 + max 0 (u - Real.log (1 - r) - (N : ℝ)) := by\n let A : ℝ := ‖1 - ((r * q : ℝ) : ℂ) * Complex.exp ((θ : ℂ) * Complex.I)‖\n let D : ℝ := ‖1 - (q : ℂ) * Complex.exp ((θ : ℂ) * Complex.I)‖\n have hA : 0 < A := by\n have h := radial_interval_phase_norm_lower (r * q) θ (mul_nonneg hr.le hq)\n have hqr : r * q ≤ r := by nlinarith\n dsimp only [A]\n linarith\n have hD : 0 ≤ D := norm_nonneg _\n have hsq : r * D ^ 2 ≤ A ^ 2 := by\n have h := radial_interval_phase_norm_sq (r * q) θ\n have h' := radial_interval_phase_norm_sq q θ\n have hq2 : q ^ 2 ≤ 1 := by nlinarith\n have hdiff : 0 ≤ (1 - r) * (1 - r * q ^ 2) := by\n apply mul_nonneg (by linarith)\n nlinarith [mul_le_mul_of_nonneg_left hq2 hr.le]\n dsimp only [A, D]\n rw [h, h']\n nlinarith only [hdiff]\n have hrlog : Real.log r ≤ 0 := Real.log_nonpos hr.le hr1.le\n rcases le_total (Real.exp (-(N : ℝ))) (Real.exp (-u) * D) with hd | hd\n · rw [max_eq_right hd]\n have hdp : 0 < D := (mul_pos_iff_of_pos_left (Real.exp_pos (-u))).mp\n ((Real.exp_pos _).trans_le hd)\n have hlog := Real.log_le_log (mul_pos hr (sq_pos_of_pos hdp)) hsq\n rw [Real.log_mul hr.ne' (sq_pos_of_pos hdp).ne', Real.log_pow, Real.log_pow] at hlog\n norm_num only [Nat.cast_ofNat] at hlog\n rw [Real.log_mul (Real.exp_pos _).ne' hdp.ne', Real.log_exp]\n change u - Real.log A ≤ _\n nlinarith only [hlog, le_max_left 0 (u - Real.log (1 - r) - (N : ℝ))]\n · rw [max_eq_left hd, Real.log_exp]\n have hlow : 1 - r ≤ A := by\n have h := radial_interval_phase_norm_lower (r * q) θ (mul_nonneg hr.le hq)\n have hqr : r * q ≤ r := by nlinarith\n dsimp only [A]\n linarith\n have hlog := Real.log_le_log (by linarith : 0 < 1 - r) hlow\n change u - Real.log A ≤ _\n linarith [le_max_right 0 (u - Real.log (1 - r) - (N : ℝ))]\ntheorem radial_probability_abel_tail_tendsto_zero {X : Type*} [MeasurableSpace X]\n (μ : MeasureTheory.ProbabilityMeasure X) (u : X → ℝ)\n (hu : Measurable u) (hu0 : ∀ z, 0 ≤ u z) (hui : MeasureTheory.Integrable u μ)\n (C : ℝ) (hC : 0 ≤ C) :\n Filter.Tendsto (fun N : ℕ => ∫ z : X, max 0 (u z + C - (N : ℝ)) ∂μ)\n Filter.atTop (nhds 0) := by\n have h := MeasureTheory.tendsto_integral_of_dominated_convergence\n (μ := (μ : MeasureTheory.Measure X))\n (F := fun N : ℕ => fun z : X => max 0 (u z + C - (N : ℝ)))\n (f := fun _ => (0 : ℝ)) (fun z => u z + C)\n (fun N => ((measurable_const.max ((hu.add_const C).sub measurable_const))).aestronglyMeasurable)\n (hui.add (MeasureTheory.integrable_const C))\n (fun N => Filter.Eventually.of_forall (fun z => by\n rw [Real.norm_eq_abs, abs_of_nonneg (le_max_left _ _)]\n apply max_le (add_nonneg (hu0 z) hC)\n linarith [Nat.cast_nonneg (α := ℝ) N]))\n (Filter.Eventually.of_forall (fun z => by\n apply tendsto_const_nhds.congr'\n obtain ⟨M, hM⟩ := exists_nat_ge (u z + C)\n filter_upwards [Filter.eventually_ge_atTop M] with N hN\n have hMN : (M : ℝ) ≤ N := by exact_mod_cast hN\n rw [max_eq_left (by linarith : u z + C - (N : ℝ) ≤ 0)]))\n simpa only [MeasureTheory.integral_zero] using h\ntheorem radial_probability_cutoff_integrable {X : Type*} [MeasurableSpace X]\n (μ : MeasureTheory.ProbabilityMeasure X) (d : X → ℝ) (hd : Measurable d)\n (hd2 : ∀ z, d z ≤ 2) (N : ℕ) :\n MeasureTheory.Integrable (fun z => -Real.log (max (Real.exp (-(N : ℝ))) (d z))) μ := by\n apply MeasureTheory.Integrable.of_bound\n ((measurable_const.max hd).log.neg.aestronglyMeasurable) ((N : ℝ) + Real.log 2)\n filter_upwards with z\n change ‖-Real.log (max (Real.exp (-(N : ℝ))) (d z))‖ ≤ (N : ℝ) + Real.log 2\n have hp : 0 < max (Real.exp (-(N : ℝ))) (d z) :=\n (Real.exp_pos _).trans_le (le_max_left _ _)\n have hl := Real.log_le_log (Real.exp_pos (-(N : ℝ)))\n (le_max_left (Real.exp (-(N : ℝ))) (d z))\n rw [Real.log_exp] at hl\n have hu := Real.log_le_log hp (max_le\n ((Real.exp_le_one_iff.mpr (neg_nonpos.mpr (Nat.cast_nonneg N))).trans (by norm_num)) (hd2 z))\n have htwo : 0 ≤ Real.log 2 := Real.log_nonneg (by norm_num)\n rw [Real.norm_eq_abs]\n exact abs_le.mpr ⟨by linarith [Nat.cast_nonneg (α := ℝ) N], by linarith⟩\ntheorem radial_min_coordinate_le_cutoff (u d : ℝ) (hdu : d ≤ 2 * Real.exp (-u)) (N : ℕ) :\n min (N : ℝ) u - Real.log 2 ≤ -Real.log (max (Real.exp (-(N : ℝ))) d) := by\n have heN : Real.exp (-(N : ℝ)) ≤ Real.exp (-min (N : ℝ) u) :=\n Real.exp_le_exp.mpr (neg_le_neg (min_le_left _ _))\n have heu : Real.exp (-u) ≤ Real.exp (-min (N : ℝ) u) :=\n Real.exp_le_exp.mpr (neg_le_neg (min_le_right _ _))\n have hmax : max (Real.exp (-(N : ℝ))) d ≤ 2 * Real.exp (-min (N : ℝ) u) :=\n max_le (by linarith [Real.exp_pos (-min (N : ℝ) u)]) (by linarith only [hdu, heu])\n have hlog := Real.log_le_log\n ((Real.exp_pos (-(N : ℝ))).trans_le (le_max_left _ _)) hmax\n rw [Real.log_mul (by norm_num : (2 : ℝ) ≠ 0) (Real.exp_pos _).ne', Real.log_exp] at hlog\n linarith only [hlog]\ntheorem radial_probability_coordinate_integrable_of_cutoff_bound {X : Type*}\n [MeasurableSpace X] (μ : MeasureTheory.ProbabilityMeasure X)\n (u d : X → ℝ) (hu : Measurable u) (hd : Measurable d)\n (hu0 : ∀ z, 0 ≤ u z) (hd2 : ∀ z, d z ≤ 2)\n (hdu : ∀ᵐ z ∂(μ : MeasureTheory.Measure X), d z ≤ 2 * Real.exp (-u z))\n (c : ℝ) (hc : ∀ N : ℕ,\n (∫ z : X, -Real.log (max (Real.exp (-(N : ℝ))) (d z)) ∂μ) ≤ c) :\n MeasureTheory.Integrable u μ := by\n have hmin (N : ℕ) : MeasureTheory.Integrable (fun z => min (N : ℝ) (u z)) μ := by\n apply MeasureTheory.Integrable.of_bound (measurable_const.min hu).aestronglyMeasurable (N : ℝ)\n filter_upwards with z\n change ‖min (N : ℝ) (u z)‖ ≤ (N : ℝ)\n rw [Real.norm_eq_abs, abs_of_nonneg (le_min (Nat.cast_nonneg N) (hu0 z))]\n exact min_le_left _ _\n have hInt (N : ℕ) : (∫ z, min (N : ℝ) (u z) ∂μ) ≤ c + Real.log 2 := by\n have h := MeasureTheory.integral_mono_ae\n ((hmin N).sub (MeasureTheory.integrable_const (Real.log 2)))\n (radial_probability_cutoff_integrable μ d hd hd2 N)\n (hdu.mono (fun z hz => radial_min_coordinate_le_cutoff (u z) (d z) hz N))\n dsimp only [Pi.sub_apply] at h\n rw [MeasureTheory.integral_sub (hmin N) (MeasureTheory.integrable_const _),\n MeasureTheory.integral_const, MeasureTheory.probReal_univ, one_smul] at h\n linarith only [h, hc N]\n have hlim := MeasureTheory.lintegral_tendsto_of_tendsto_of_monotone\n (μ := (μ : MeasureTheory.Measure X))\n (f := fun N : ℕ => fun z => ENNReal.ofReal (min (N : ℝ) (u z)))\n (F := fun z => ENNReal.ofReal (u z))\n (fun N => (measurable_const.min hu).ennreal_ofReal.aemeasurable)\n (Filter.Eventually.of_forall (fun z a b hab =>\n ENNReal.ofReal_le_ofReal (min_le_min_right (u z) (by exact_mod_cast hab))))\n (Filter.Eventually.of_forall (fun z => by\n apply tendsto_const_nhds.congr'\n obtain ⟨M, hM⟩ := exists_nat_ge (u z)\n filter_upwards [Filter.eventually_ge_atTop M] with N hN\n have hMN : (M : ℝ) ≤ N := by exact_mod_cast hN\n rw [min_eq_right (hM.trans hMN)]))\n have hfinite : (∫⁻ z, ENNReal.ofReal (u z) ∂μ) ≤ ENNReal.ofReal (c + Real.log 2) := by\n apply le_of_tendsto' hlim\n intro N\n rw [← MeasureTheory.ofReal_integral_eq_lintegral_ofReal (hmin N)\n (Filter.Eventually.of_forall (fun z => le_min (Nat.cast_nonneg N) (hu0 z)))]\n exact ENNReal.ofReal_le_ofReal (hInt N)\n exact (MeasureTheory.lintegral_ofReal_ne_top_iff_integrable hu.aestronglyMeasurable\n (Filter.Eventually.of_forall hu0)).mp (ne_of_lt (hfinite.trans_lt ENNReal.ofReal_lt_top))\ntheorem radial_phase_norm_upper (q θ : ℝ) (hq : 0 ≤ q) (hq1 : q ≤ 1) :\n ‖1 - (q : ℂ) * Complex.exp ((θ : ℂ) * Complex.I)‖ ≤ 2 := by\n have h := norm_sub_le (1 : ℂ) ((q : ℂ) * Complex.exp ((θ : ℂ) * Complex.I))\n simp only [norm_one, norm_mul, Complex.norm_real, Real.norm_eq_abs,\n abs_of_nonneg hq, Complex.norm_exp_ofReal_mul_I, mul_one] at h\n linarith only [h, hq1]\ntheorem radial_probability_ray_truncated_energy_of_factor {X : Type*}\n [MeasurableSpace X] (m : ℕ) (hm : 0 < m)\n (μ : MeasureTheory.ProbabilityMeasure X) (x : X → ℝ)\n (label : X → Fin m) (θ : Fin m → ℝ)\n (hx : Measurable x) (hl : Measurable label)\n (hθ : ∀ i, θ i ∈ Set.Ico 0 (2 * Real.pi)) (hinj : Function.Injective θ)\n (hx0 : ∀ z, 0 ≤ x z) (d : X × X → ℝ) (hd : Measurable d)\n (hd2 : ∀ z, d z ≤ 2)\n (hfactor : ∀ᵐ z ∂(μ.prod μ : MeasureTheory.Measure (X × X)),\n d z = Real.exp (-min (x z.1) (x z.2)) *\n ‖1 - ((Real.exp (-|x z.2 - x z.1|) : ℝ) : ℂ) *\n Complex.exp (((θ (label z.2) - θ (label z.1) : ℝ) : ℂ) * Complex.I)‖)\n (c : ℝ) (hc : c < Real.log 4 / (m : ℝ)) :\n ∃ N : ℕ, c < ∫ z : X × X,\n -Real.log (max (Real.exp (-(N : ℝ))) (d z)) ∂(μ.prod μ) := by\n by_contra hbad\n push_neg at hbad\n let u : X × X → ℝ := fun z => min (x z.1) (x z.2)\n let q : X × X → ℝ := fun z => Real.exp (-|x z.2 - x z.1|)\n let φ : X × X → ℝ := fun z => θ (label z.2) - θ (label z.1)\n have hφ' : Measurable (fun z => θ (label z)) := (measurable_of_countable θ).comp hl\n have hu : Measurable u := by dsimp only [u]; fun_prop\n have hu0 (z : X × X) : 0 ≤ u z := le_min (hx0 _) (hx0 _)\n have hq : Measurable q := by dsimp only [q]; fun_prop\n have hφ : Measurable φ := by dsimp only [φ]; fun_prop\n have hq0 (z : X × X) : 0 ≤ q z := (Real.exp_pos _).le\n have hq1 (z : X × X) : q z ≤ 1 :=\n Real.exp_le_one_iff.mpr (neg_nonpos.mpr (abs_nonneg _))\n have hdu : ∀ᵐ z ∂(μ.prod μ : MeasureTheory.Measure (X × X)),\n d z ≤ 2 * Real.exp (-u z) := by\n filter_upwards [hfactor] with z hz\n rw [hz]\n have h := radial_phase_norm_upper (q z) (φ z) (hq0 z) (hq1 z)\n change Real.exp (-u z) * _ ≤ 2 * Real.exp (-u z)\n nlinarith only [h, Real.exp_pos (-u z)]\n have hui := radial_probability_coordinate_integrable_of_cutoff_bound\n (μ.prod μ) u d hu hd hu0 hd2 hdu c hbad\n obtain ⟨r, hr, hr1, hgap⟩ := radial_probability_ray_abel_energy_gap_of_integrable\n m hm μ x label θ hx hl hθ hinj hx0 hui c hc\n have hlog := radial_probability_complex_abel_integrable (μ.prod μ) q φ hq hφ hq0 hq1\n r hr.le hr1\n let J : ℝ := (∫ z : X × X, u z ∂(μ.prod μ)) +\n (∫ z : X × X, -Real.log ‖1 - ((r * q z : ℝ) : ℂ) *\n Complex.exp (((φ z : ℝ) : ℂ) * Complex.I)‖ ∂(μ.prod μ)) + Real.log r / 2\n have hJ : c < J := hgap\n have hC : 0 ≤ -Real.log (1 - r) := neg_nonneg.mpr\n (Real.log_nonpos (by linarith) (by linarith))\n have ht := radial_probability_abel_tail_tendsto_zero (μ.prod μ) u hu hu0 hui\n (-Real.log (1 - r)) hC\n have hevent : ∀ᶠ N : ℕ in Filter.atTop,\n (∫ z : X × X, max 0 (u z - Real.log (1 - r) - (N : ℝ)) ∂(μ.prod μ)) < J - c := by\n simpa only [sub_eq_add_neg] using ht.eventually (gt_mem_nhds (sub_pos.mpr hJ))\n obtain ⟨N, hN⟩ := hevent.exists\n have htail : MeasureTheory.Integrable\n (fun z : X × X => max 0 (u z - Real.log (1 - r) - (N : ℝ))) (μ.prod μ) := by\n apply (hui.sub (MeasureTheory.integrable_const (Real.log (1 - r)))).mono'\n (measurable_const.max ((hu.sub_const _).sub_const _)).aestronglyMeasurable\n filter_upwards with z\n change ‖max 0 (u z - Real.log (1 - r) - (N : ℝ))‖ ≤ u z - Real.log (1 - r)\n rw [Real.norm_eq_abs, abs_of_nonneg (le_max_left _ _)]\n apply max_le (by linarith [hu0 z])\n linarith [Nat.cast_nonneg (α := ℝ) N]\n have hcut := radial_probability_cutoff_integrable (μ.prod μ) d hd hd2 N\n have hmono := MeasureTheory.integral_mono_ae (hui.add hlog)\n ((hcut.sub (MeasureTheory.integrable_const (Real.log r / 2))).add htail) (by\n filter_upwards [hfactor] with z hz\n have h := radial_log_coordinate_abel_le_cutoff (u z) (q z) (φ z) r\n (hq0 z) (hq1 z) hr hr1 N\n change u z + -Real.log ‖1 - ((r * q z : ℝ) : ℂ) *\n Complex.exp (((φ z : ℝ) : ℂ) * Complex.I)‖ ≤ _\n change d z = Real.exp (-u z) * ‖1 - ((q z : ℝ) : ℂ) *\n Complex.exp (((φ z : ℝ) : ℂ) * Complex.I)‖ at hz\n rw [← hz] at h\n exact h)\n have hleft := MeasureTheory.integral_add hui hlog\n have hright := MeasureTheory.integral_add\n (hcut.sub (MeasureTheory.integrable_const (Real.log r / 2))) htail\n have hright' := MeasureTheory.integral_sub hcut\n (MeasureTheory.integrable_const (Real.log r / 2))\n dsimp only [Pi.add_apply, Pi.sub_apply] at hmono hleft hright hright'\n rw [hleft, hright, hright', MeasureTheory.integral_const,\n MeasureTheory.probReal_univ, one_smul] at hmono\n dsimp only [J] at hN\n linarith only [hmono, hN, hbad N]\ntheorem radial_phase_norm_neg (q θ : ℝ) :\n ‖1 - (q : ℂ) * Complex.exp (((-θ : ℝ) : ℂ) * Complex.I)‖ =\n ‖1 - (q : ℂ) * Complex.exp ((θ : ℂ) * Complex.I)‖ := by\n have h := radial_interval_phase_norm_sq q (-θ)\n have h' := radial_interval_phase_norm_sq q θ\n rw [Real.cos_neg] at h\n nlinarith [norm_nonneg (1 - (q : ℂ) * Complex.exp (((-θ : ℝ) : ℂ) * Complex.I)),\n norm_nonneg (1 - (q : ℂ) * Complex.exp ((θ : ℂ) * Complex.I))]\ntheorem radial_polar_distance_factor_of_le (a b φ ψ : ℝ) (hab : a ≤ b) :\n ‖(Real.exp (-a) : ℂ) * Complex.exp ((φ : ℂ) * Complex.I) -\n (Real.exp (-b) : ℂ) * Complex.exp ((ψ : ℂ) * Complex.I)‖ =\n Real.exp (-a) * ‖1 - (Real.exp (-(b - a)) : ℂ) *\n Complex.exp (((ψ - φ : ℝ) : ℂ) * Complex.I)‖ := by\n have hrad : (Real.exp (-a) : ℂ) * (Real.exp (-(b - a)) : ℂ) =\n (Real.exp (-b) : ℂ) := by\n rw [← Complex.ofReal_mul, ← Real.exp_add]\n congr 2\n ring\n have hphase : Complex.exp ((φ : ℂ) * Complex.I) *\n Complex.exp (((ψ - φ : ℝ) : ℂ) * Complex.I) =\n Complex.exp ((ψ : ℂ) * Complex.I) := by\n rw [← Complex.exp_add]\n congr 1\n push_cast\n ring\n have hprod : ((Real.exp (-a) : ℂ) * Complex.exp ((φ : ℂ) * Complex.I)) *\n ((Real.exp (-(b - a)) : ℂ) * Complex.exp (((ψ - φ : ℝ) : ℂ) * Complex.I)) =\n (Real.exp (-b) : ℂ) * Complex.exp ((ψ : ℂ) * Complex.I) := by\n calc\n _ = ((Real.exp (-a) : ℂ) * (Real.exp (-(b - a)) : ℂ)) *\n (Complex.exp ((φ : ℂ) * Complex.I) *\n Complex.exp (((ψ - φ : ℝ) : ℂ) * Complex.I)) := by ring\n _ = _ := by rw [hrad, hphase]\n calc\n _ = ‖((Real.exp (-a) : ℂ) * Complex.exp ((φ : ℂ) * Complex.I)) *\n (1 - (Real.exp (-(b - a)) : ℂ) *\n Complex.exp (((ψ - φ : ℝ) : ℂ) * Complex.I))‖ := by\n rw [mul_sub, mul_one, hprod]\n _ = _ := by\n rw [norm_mul, norm_mul, Complex.norm_real, Real.norm_eq_abs,\n abs_of_pos (Real.exp_pos _), Complex.norm_exp_ofReal_mul_I, mul_one]\ntheorem radial_polar_distance_factor (a b φ ψ : ℝ) :\n ‖(Real.exp (-a) : ℂ) * Complex.exp ((φ : ℂ) * Complex.I) -\n (Real.exp (-b) : ℂ) * Complex.exp ((ψ : ℂ) * Complex.I)‖ =\n Real.exp (-min a b) * ‖1 - (Real.exp (-|b - a|) : ℂ) *\n Complex.exp (((ψ - φ : ℝ) : ℂ) * Complex.I)‖ := by\n rcases le_total a b with hab | hba\n · rw [min_eq_left hab, abs_of_nonneg (sub_nonneg.mpr hab)]\n exact radial_polar_distance_factor_of_le a b φ ψ hab\n · rw [norm_sub_rev, radial_polar_distance_factor_of_le b a ψ φ hba,\n min_eq_right hba, abs_of_nonpos (sub_nonpos.mpr hba)]\n have hsub : a - b = -(b - a) := by ring\n have hphase : φ - ψ = -(ψ - φ) := by ring\n rw [hsub, hphase, radial_phase_norm_neg]\ntheorem radial_unit_phase_choice (a : ℂ) (ha : ‖a‖ = 1) :\n ∃ θ : ℝ, θ ∈ Set.Ico 0 (2 * Real.pi) ∧\n Complex.exp ((θ : ℂ) * Complex.I) = a := by\n have hexp : Complex.exp ((a.arg : ℂ) * Complex.I) = a := by\n simpa only [ha, Complex.ofReal_one, one_mul] using Complex.norm_mul_exp_arg_mul_I a\n by_cases harg : a.arg < 0\n · refine ⟨a.arg + 2 * Real.pi, ⟨?_, ?_⟩, ?_⟩\n · linarith [Complex.neg_pi_lt_arg a, Real.pi_pos]\n · linarith\n · rw [Complex.ofReal_add, add_mul, Complex.exp_add]\n have hperiod : Complex.exp (((2 * Real.pi : ℝ) : ℂ) * Complex.I) = 1 := by\n simpa only [Complex.ofReal_mul, Complex.ofReal_ofNat] using Complex.exp_two_pi_mul_I\n rw [hperiod, mul_one, hexp]\n · exact ⟨a.arg, ⟨le_of_not_gt harg, by linarith [Complex.arg_le_pi a, Real.pi_pos]⟩, hexp⟩\ntheorem radial_tree_direction_mem (A : Finset ℂ) (hA : ∀ a ∈ A, ‖a‖ = 1)\n (a₀ : ℂ) (ha₀ : a₀ ∈ A) (z : radial_tree_set A 1) :\n (if (z : ℂ) = 0 then a₀ else (z : ℂ) / (‖(z : ℂ)‖ : ℂ)) ∈ A := by\n classical\n by_cases hz : (z : ℂ) = 0\n · simpa only [if_pos hz] using ha₀\n · rw [if_neg hz]\n obtain ⟨a, ha, t, ht, ht1, hta⟩ := (radial_tree_set_mem_iff A 1 z).mp z.property\n have htn : ‖(z : ℂ)‖ = t := by\n rw [hta, norm_mul, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg ht, hA a ha, mul_one]\n have htne : t ≠ 0 := by\n intro h\n apply hz\n rw [hta, h, Complex.ofReal_zero, zero_mul]\n have htC : (t : ℂ) ≠ 0 := by exact_mod_cast htne\n rw [htn, hta, mul_div_cancel_left₀ a htC]\n exact ha\ntheorem radial_tree_measurable_polar_coordinates (A : Finset ℂ) (hA₀ : A.Nonempty)\n (hA : ∀ a ∈ A, ‖a‖ = 1) :\n ∃ (x : radial_tree_set A 1 → ℝ) (label : radial_tree_set A 1 → Fin A.card)\n (θ : Fin A.card → ℝ), Measurable x ∧ Measurable label ∧\n (∀ i, θ i ∈ Set.Ico 0 (2 * Real.pi)) ∧ Function.Injective θ ∧\n (∀ z, 0 ≤ x z) ∧ ∀ z : radial_tree_set A 1, (z : ℂ) ≠ 0 →\n (Real.exp (-x z) : ℂ) * Complex.exp (((θ (label z) : ℝ) : ℂ) * Complex.I) = z := by\n classical\n obtain ⟨a₀, ha₀⟩ := hA₀\n let e := A.equivFin\n have hunit (i : Fin A.card) : ‖((e.symm i : A) : ℂ)‖ = 1 := hA _ (e.symm i).property\n choose θ hθ hexp using fun i : Fin A.card => radial_unit_phase_choice (e.symm i) (hunit i)\n have hinj : Function.Injective θ := by\n intro i j hij\n have h := (hexp i).symm.trans ((congrArg (fun t : ℝ =>\n Complex.exp ((t : ℂ) * Complex.I)) hij).trans (hexp j))\n exact e.symm.injective (Subtype.ext h)\n let dir : radial_tree_set A 1 → A := fun z =>\n ⟨if (z : ℂ) = 0 then a₀ else (z : ℂ) / (‖(z : ℂ)‖ : ℂ),\n radial_tree_direction_mem A hA a₀ ha₀ z⟩\n have hdir : Measurable dir := by\n apply Measurable.subtype_mk\n apply Measurable.ite (measurable_subtype_coe (measurableSet_singleton 0)) measurable_const\n exact measurable_subtype_coe.div measurable_subtype_coe.norm.complex_ofReal\n let label : radial_tree_set A 1 → Fin A.card := fun z => e (dir z)\n have hl : Measurable label := (measurable_of_finite e).comp hdir\n let x : radial_tree_set A 1 → ℝ := fun z => -Real.log ‖(z : ℂ)‖\n have hx : Measurable x := measurable_subtype_coe.norm.log.neg\n have hx0 (z : radial_tree_set A 1) : 0 ≤ x z :=\n neg_nonneg.mpr (Real.log_nonpos (norm_nonneg _) (radial_tree_set_norm_le_one A hA z z.property))\n refine ⟨x, label, θ, hx, hl, hθ, hinj, hx0, ?_⟩\n intro z hz\n have hp : 0 < ‖(z : ℂ)‖ := norm_pos_iff.mpr hz\n have hrad : Real.exp (-x z) = ‖(z : ℂ)‖ := by\n dsimp only [x]\n rw [neg_neg, Real.exp_log hp]\n have hphase : Complex.exp (((θ (label z) : ℝ) : ℂ) * Complex.I) =\n (z : ℂ) / (‖(z : ℂ)‖ : ℂ) := by\n rw [hexp]\n change ((e.symm (e (dir z)) : A) : ℂ) = _\n rw [e.symm_apply_apply]\n exact if_neg hz\n rw [hrad, hphase]\n have hn : (‖(z : ℂ)‖ : ℂ) ≠ 0 := by exact_mod_cast hp.ne'\n field_simp\ntheorem radial_probability_truncated_energy_bound (A : Finset ℂ) (hA₀ : A.Nonempty)\n (hA : ∀ a ∈ A, ‖a‖ = 1) (c : ℝ) (hc : c < Real.log 4 / (A.card : ℝ))\n (μ : MeasureTheory.ProbabilityMeasure (radial_tree_set A 1)) :\n ∃ N : ℕ, c < ∫ z : (radial_tree_set A 1) × (radial_tree_set A 1),\n -Real.log (max (Real.exp (-(N : ℝ))) (dist z.1 z.2)) ∂(μ.prod μ) := by\n classical\n by_cases hatom : ∃ a : radial_tree_set A 1,\n (μ : MeasureTheory.Measure (radial_tree_set A 1)) {a} ≠ 0\n · obtain ⟨a, ha⟩ := hatom\n exact radial_tree_probability_truncated_energy_of_atom A hA μ a ha c\n push_neg at hatom\n obtain ⟨x, label, θ, hx, hl, hθ, hinj, hx0, hpolar⟩ :=\n radial_tree_measurable_polar_coordinates A hA₀ hA\n have hzero : (0 : ℂ) ∈ radial_tree_set A 1 := by\n obtain ⟨a, ha⟩ := hA₀\n apply (radial_tree_set_mem_iff A 1 0).mpr\n exact ⟨a, ha, 0, le_rfl, by norm_num, by simp⟩\n let o : radial_tree_set A 1 := ⟨0, hzero⟩\n have hne : ∀ᵐ (z : radial_tree_set A 1) ∂(μ : MeasureTheory.Measure (radial_tree_set A 1)),\n (z : ℂ) ≠ 0 := by\n have h : ∀ᵐ (z : radial_tree_set A 1)\n ∂(μ : MeasureTheory.Measure (radial_tree_set A 1)), z ≠ o := by\n rw [MeasureTheory.ae_iff]\n simpa using hatom o\n filter_upwards [h] with z hz\n intro hz0\n exact hz (Subtype.ext hz0)\n have hpairs : ∀ᵐ (z : (radial_tree_set A 1) × (radial_tree_set A 1)) ∂(μ.prod μ : MeasureTheory.Measure\n ((radial_tree_set A 1) × (radial_tree_set A 1))), (z.1 : ℂ) ≠ 0 ∧ (z.2 : ℂ) ≠ 0 := by\n change ∀ᵐ z ∂((μ : MeasureTheory.Measure (radial_tree_set A 1)).prod\n (μ : MeasureTheory.Measure (radial_tree_set A 1))), _\n apply (MeasureTheory.Measure.ae_prod_iff_ae_ae (by measurability)).mpr\n filter_upwards [hne] with a ha\n exact hne.mono (fun b hb => ⟨ha, hb⟩)\n apply radial_probability_ray_truncated_energy_of_factor A.card (Finset.card_pos.mpr hA₀)\n μ x label θ hx hl hθ hinj hx0 (fun z => dist z.1 z.2) (by fun_prop) _ _ c hc\n · intro z\n change dist (z.1 : ℂ) (z.2 : ℂ) ≤ 2\n exact (dist_le_norm_add_norm _ _).trans (by\n linarith [radial_tree_set_norm_le_one A hA z.1 z.1.property,\n radial_tree_set_norm_le_one A hA z.2 z.2.property])\n · filter_upwards [hpairs] with z hz\n rw [Subtype.dist_eq, dist_eq_norm]\n rw [← hpolar z.1 hz.1, ← hpolar z.2 hz.2]\n exact radial_polar_distance_factor _ _ _ _\ntheorem radial_uniform_truncated_energy (A : Finset ℂ) (hA₀ : A.Nonempty)\n (hA : ∀ a ∈ A, ‖a‖ = 1) (c : ℝ) (hc : c < Real.log 4 / (A.card : ℝ)) :\n ∃ M : ℝ, ∀ (n : ℕ) (z : Fin n → ℂ),\n (∀ i, z i ∈ radial_tree_set A 1) →\n (n : ℝ) ^ 2 * c ≤ ∑ i : Fin n, ∑ j : Fin n,\n -Real.log (max (Real.exp (-M)) ‖z i - z j‖) := by\n letI : CompactSpace (radial_tree_set A 1) :=\n isCompact_iff_compactSpace.mp (radial_tree_set_compact A 1)\n obtain ⟨N, hN⟩ := radial_probability_uniform_truncated_energy_of_pointwise c\n (radial_probability_truncated_energy_bound A hA₀ hA c hc)\n refine ⟨(N : ℝ), fun n z hz => ?_⟩\n have h := radial_finite_truncated_energy_of_probability_bound (N : ℝ) c hN\n n (fun i => (⟨z i, hz i⟩ : radial_tree_set A 1))\n simpa only [Subtype.dist_eq, dist_eq_norm] using h\ntheorem normalized_radial_fekete_estimate (A : Finset ℂ) (hA₀ : A.Nonempty)\n (hA : ∀ a ∈ A, ‖a‖ = 1) (b : ℝ) (hb : (1 : ℝ) / 4 < b) :\n ∃ n : ℕ, 1 < n ∧ ∀ z : Fin n → ℂ,\n (∀ i, z i ∈ (⋃ a ∈ A, (fun t : ℝ => (t : ℂ) * a) '' Set.Icc 0 (1 : ℝ))) →\n (∏ i : Fin n, ∏ j ∈ (Finset.univ : Finset (Fin n)).erase i, ‖z i - z j‖) ^\n A.card ≤ b ^ (n * (n - 1)) := by\n have hm : 0 < (A.card : ℝ) := by exact_mod_cast Finset.card_pos.mpr hA₀\n have hb₀ : 0 < b := by linarith\n have hlog : -Real.log b < Real.log 4 := by\n have h := Real.log_lt_log (by norm_num : (0 : ℝ) < 1 / 4) hb\n rw [Real.log_div (by norm_num) (by norm_num), Real.log_one, zero_sub] at h\n linarith\n obtain ⟨c, hc₀, hc₁⟩ := exists_between (div_lt_div_of_pos_right hlog hm)\n obtain ⟨M, hM⟩ := radial_uniform_truncated_energy A hA₀ hA c hc₁\n have hc : -Real.log b < (A.card : ℝ) * c := by\n have h := (div_lt_iff₀ hm).mp hc₀\n linarith\n simpa only [radial_tree_set, radial_fekete_product] using\n radial_normalized_fekete_of_truncated_energy A hA₀ b hb₀ M c hc hM\ntheorem radial_tree_contracting_monic (A : Finset ℂ) (T : ℝ)\n (hA₀ : A.Nonempty) (hA : ∀ a ∈ A, ‖a‖ = 1)\n (hT : 0 ≤ T) (hpower : T ^ A.card < 4) :\n ∃ p : Polynomial ℂ, p.Monic ∧ 0 < p.natDegree ∧\n ∃ q : ℝ, 0 ≤ q ∧ q < 1 ∧ ∀ a ∈ A, ∀ t : ℝ,\n 0 ≤ t → t ≤ T → ‖p.eval ((t : ℂ) * a)‖ ≤ q := by\n exact radial_tree_contracting_monic_of_normalized_fekete_estimate_expanded\n A T hA₀ hA hT hpower (normalized_radial_fekete_estimate A hA₀ hA)\ntheorem integration_reverse_square {P Q F G : Polynomial ℚ} (hP : P.Monic) (hirr : Irreducible P)\n (hQ : Q.Monic) (hd : Q.natDegree = P.natDegree)\n (hsq : G ^ 2 = F) (hf : F.reverse = P * Q) : Q = P := by\n have hs : G.reverse ^ 2 = F.reverse := by\n simpa only [pow_two, Polynomial.reverse_mul_of_domain] using\n congrArg Polynomial.reverse hsq\n exact Submission.Helpers.polynomial_eq_of_monic_irreducible_mul_eq_sq\n hP hirr hQ hd (hs.trans hf)\ntheorem integration_root_enumeration {K : Type*} [Field K] [NumberField K] (α : K) :\n Nonempty ((minpoly ℚ α).rootSet ℂ ≃ Fin (minpoly ℚ α).natDegree) := by\n classical\n have hsep := (minpoly.irreducible (IsIntegral.of_finite ℚ α)).separable\n have hcard := Polynomial.card_rootSet_eq_natDegree hsep\n (IsAlgClosed.splits ((minpoly ℚ α).map (algebraMap ℚ ℂ)))\n exact ⟨Fintype.equivFinOfCardEq hcard⟩\ntheorem integration_degree_drop_exponent {K : Type*} [Field K] [NumberField K] (α : K) (hα : α ≠ 0)\n (hdrop : (minpoly ℚ (α ^ 2)).natDegree < (minpoly ℚ α).natDegree)\n (hih : (2 : ℝ) ≤ NumberField.house (α ^ 2) ^\n (4 * (Finset.univ.image fun σ : K →+* ℂ => (σ (α ^ 2)).arg).card)) :\n (2 : ℝ) ≤ NumberField.house α ^\n (4 * (Finset.univ.image fun σ : K →+* ℂ => (σ α).arg).card) := by\n have hc := Submission.Helpers.argument_card_sq_of_degree_drop α hα hdrop\n rw [NumberField.house_pow, ← pow_mul] at hih\n have he : 2 * (4 * (Finset.univ.image fun σ : K →+* ℂ => (σ (α ^ 2)).arg).card) =\n 4 * (Finset.univ.image fun σ : K →+* ℂ => (σ α).arg).card := by omega\n rwa [he] at hih\ntheorem integration_radius_exponent (H : ℝ) (m a : ℕ) (hH : 1 ≤ H) (ha : a ≤ 2 * m)\n (hlt : H ^ (4 * m) < 2) : (H ^ 4) ^ a < 4 := by\n have hH4 : 1 ≤ H ^ 4 := one_le_pow₀ hH\n have hp : 0 ≤ H ^ (4 * m) := pow_nonneg (by linarith) _\n calc\n (H ^ 4) ^ a ≤ (H ^ 4) ^ (2 * m) := pow_le_pow_right₀ hH4 ha\n _ = (H ^ (4 * m)) ^ 2 := by\n rw [← pow_mul, ← pow_mul]\n congr 1\n omega\n _ < 4 := by nlinarith\ntheorem integration_second_drop {P R G : Polynomial ℚ} (hP : P.Monic) (hirr : Irreducible P)\n (hR : R.Monic) (hd : 2 * R.natDegree = P.natDegree)\n (hsq : G ^ 2 = P * R ^ 2) : False := by\n have heq : R ^ 2 = P :=\n Submission.Helpers.polynomial_eq_of_monic_irreducible_mul_eq_sq\n hP hirr (hR.pow 2) (by rw [Polynomial.natDegree_pow]; omega) hsq\n exact not_irreducible_pow (by decide : (2 : ℕ) ≠ 1) (heq.symm ▸ hirr)\ntheorem integration_distinct_root_product (P : Polynomial ℚ) (hM : P.Monic) (hS : P.Separable) :\n P.map (algebraMap ℚ ℂ) =\n ∏ z : P.rootSet ℂ, (Polynomial.X - Polynomial.C (z : ℂ)) := by\n classical\n let g := P.map (algebraMap ℚ ℂ)\n have hnd := Polynomial.nodup_roots (hS.map (f := algebraMap ℚ ℂ))\n change g = ∏ z : g.roots.toFinset, (Polynomial.X - Polynomial.C (z : ℂ))\n rw [Finset.prod_coe_sort g.roots.toFinset (fun z : ℂ => Polynomial.X - Polynomial.C z)]\n change g = (g.roots.toFinset.val.map (fun z => Polynomial.X - Polynomial.C z)).prod\n rw [Multiset.toFinset_val, Multiset.dedup_eq_self.mpr hnd]\n exact (IsAlgClosed.splits g).eq_prod_roots_of_monic (hM.map _)\ntheorem integration_reciprocal_unique {K : Type*} [Field K] [NumberField K]\n (β : K) (hβ : β ≠ 0) (A : Polynomial ℚ)\n (hA : A.coeff 0 = 1) (hd : A.natDegree ≤ (minpoly ℚ β).natDegree)\n (hr : Polynomial.aeval (β⁻¹) A = 0) : A = (minpoly ℚ β).reverse := by\n let d := (minpoly ℚ β).natDegree\n let R := Polynomial.reflect d A\n have hdeg : R.natDegree ≤ d := by\n exact Polynomial.natDegree_reflect_le.trans (max_le (le_refl _) hd)\n have hc : R.coeff d = 1 := by\n simpa only [R, Polynomial.coeff_reflect, Polynomial.revAt_le (le_refl d),\n Nat.sub_self] using hA\n have hM : R.Monic := Polynomial.monic_of_natDegree_le_of_coeff_eq_one d hdeg hc\n letI : Invertible (β⁻¹) := invertibleOfNonzero (inv_ne_zero hβ)\n have hroot : Polynomial.aeval β R = 0 := by\n simpa only [invOf_eq_inv, inv_inv, Polynomial.aeval_def, R] using\n (Polynomial.eval₂_reflect_eq_zero_iff (algebraMap ℚ K) (β⁻¹) d A hd).mpr hr\n have he : R = minpoly ℚ β := by\n apply minpoly.unique_of_degree_le_degree_minpoly ℚ β hM hroot\n rw [Polynomial.degree_eq_natDegree hM.ne_zero,\n Polynomial.degree_eq_natDegree (minpoly.ne_zero (IsIntegral.of_finite ℚ β))]\n exact_mod_cast hdeg\n simpa only [R, d, Polynomial.reflect_reflect, Polynomial.reverse] using\n congrArg (Polynomial.reflect d) he\ntheorem integration_transform_bound (F : Polynomial ℤ) :\n ((Polynomial.contract 2 F) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX F)) ^ 2).natDegree ≤\n F.natDegree := by\n have hs := congrArg Polynomial.natDegree\n (Submission.Helpers.even_odd_power_transform_subst F)\n have hm := Polynomial.natDegree_mul_le (p := F) (q := F.comp (-Polynomial.X))\n simp only [Polynomial.natDegree_comp, Polynomial.natDegree_X_pow,\n Polynomial.natDegree_neg, Polynomial.natDegree_X, mul_one] at hs hm\n omega\ntheorem integration_transform_preserved {K : Type*} [Field K] [NumberField K]\n (α : K) (hInt : IsIntegral ℤ α) (hα : α ≠ 0)\n (hdegree : (minpoly ℚ α).natDegree = (minpoly ℚ (α ^ 2)).natDegree) :\n let F := (minpoly ℤ α).reverse\n ((Polynomial.contract 2 F) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX F)) ^ 2).map\n (Int.castRingHom ℚ) = (minpoly ℚ (α ^ 2)).reverse := by\n let F := (minpoly ℤ α).reverse\n let A := (Polynomial.contract 2 F) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX F)) ^ 2\n change A.map (Int.castRingHom ℚ) = (minpoly ℚ (α ^ 2)).reverse\n apply integration_reciprocal_unique (α ^ 2) (pow_ne_zero 2 hα)\n · change (A.map (Int.castRingHom ℚ)).coeff 0 = 1\n rw [Polynomial.coeff_map]\n change (Int.castRingHom ℚ) (((Polynomial.contract 2 F) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX F)) ^ 2).coeff 0) = 1\n rw [Submission.Helpers.even_odd_power_transform_coeff_zero]\n simp [F, (minpoly.monic hInt).leadingCoeff]\n · have hn : (minpoly ℤ α).natDegree = (minpoly ℚ α).natDegree := by\n rw [minpoly.isIntegrallyClosed_eq_field_fractions' ℚ hInt]\n exact ((minpoly.monic hInt).natDegree_map _).symm\n calc\n (A.map (Int.castRingHom ℚ)).natDegree ≤ A.natDegree := Polynomial.natDegree_map_le\n _ ≤ F.natDegree := integration_transform_bound F\n _ ≤ (minpoly ℤ α).natDegree := Polynomial.reverse_natDegree_le _\n _ = (minpoly ℚ α).natDegree := hn\n _ = (minpoly ℚ (α ^ 2)).natDegree := hdegree\n · have hrF : Polynomial.aeval (α⁻¹) F = 0 := by\n letI : Invertible α := invertibleOfNonzero hα\n simpa only [F, Polynomial.aeval_def, invOf_eq_inv] using\n (Polynomial.eval₂_reverse_eq_zero_iff (algebraMap ℤ K) α (minpoly ℤ α)).mpr\n (minpoly.aeval ℤ α)\n have hrA : Polynomial.aeval ((α ^ 2)⁻¹) A = 0 := by\n have hs := congrArg (Polynomial.aeval (α⁻¹))\n (Submission.Helpers.even_odd_power_transform_subst F)\n change Polynomial.aeval (α⁻¹) (A.comp (Polynomial.X ^ 2)) = _ at hs\n rw [Polynomial.aeval_comp, map_mul, hrF, zero_mul] at hs\n simpa only [map_pow, Polynomial.aeval_X, inv_pow] using hs\n have hc : (algebraMap ℚ K).comp (Int.castRingHom ℚ) = algebraMap ℤ K := by\n ext n\n simp\n exact (Polynomial.aeval_eq_aeval_map hc A ((α ^ 2)⁻¹)).symm.trans hrA\ntheorem integration_power_ray_cover {K : Type*} [Field K] [NumberField K]\n (α : K) (hH : 1 ≤ NumberField.house α)\n (hlt : NumberField.house α ^\n (4 * (Finset.univ.image fun σ : K →+* ℂ => (σ α).arg).card) < 2) :\n ∃ A : Finset ℂ, A.Nonempty ∧ (∀ a ∈ A, ‖a‖ = 1) ∧\n (NumberField.house α ^ 4) ^ A.card < 4 ∧\n ∀ (σ : K →+* ℂ) (k : ℕ), k = 2 ∨ k = 4 →\n σ (α ^ k) ∈ Submission.Helpers.radial_tree_set A (NumberField.house α ^ 4) := by\n classical\n let s := Finset.univ.image fun σ : K →+* ℂ => (σ α).arg\n let e : ℝ → ℂ := fun θ => Complex.exp ((θ : ℂ) * Complex.I)\n let A := s.image (fun θ => e θ ^ 2) ∪ s.image (fun θ => e θ ^ 4)\n have hs : s.Nonempty := Finset.univ_nonempty.image _\n have hAn : A.Nonempty := (hs.image (fun θ => e θ ^ 2)).mono Finset.subset_union_left\n have hcard : A.card ≤ 2 * s.card := by\n calc\n A.card ≤ (s.image (fun θ => e θ ^ 2)).card +\n (s.image (fun θ => e θ ^ 4)).card := Finset.card_union_le _ _\n _ ≤ s.card + s.card := Nat.add_le_add Finset.card_image_le Finset.card_image_le\n _ = 2 * s.card := by omega\n refine ⟨A, hAn, ?_, integration_radius_exponent _ _ _ hH hcard hlt, ?_⟩\n · intro a ha\n rcases Finset.mem_union.mp ha with ha | ha\n · obtain ⟨θ, _, rfl⟩ := Finset.mem_image.mp ha\n simp [e, Complex.norm_exp_ofReal_mul_I]\n · obtain ⟨θ, _, rfl⟩ := Finset.mem_image.mp ha\n simp [e, Complex.norm_exp_ofReal_mul_I]\n · intro σ k hk\n have hm : e (σ α).arg ^ k ∈ A := by\n rcases hk with rfl | rfl\n · exact Finset.mem_union_left _ (Finset.mem_image.mpr\n ⟨(σ α).arg, Finset.mem_image.mpr ⟨σ, Finset.mem_univ _, rfl⟩, rfl⟩)\n · exact Finset.mem_union_right _ (Finset.mem_image.mpr\n ⟨(σ α).arg, Finset.mem_image.mpr ⟨σ, Finset.mem_univ _, rfl⟩, rfl⟩)\n apply (Submission.Helpers.radial_tree_set_mem_iff A (NumberField.house α ^ 4) _).mpr\n refine ⟨e (σ α).arg ^ k, hm, ‖σ α‖ ^ k, pow_nonneg (norm_nonneg _) _, ?_, ?_⟩\n · calc\n ‖σ α‖ ^ k ≤ NumberField.house α ^ k :=\n pow_le_pow_left₀ (norm_nonneg _) (NumberField.norm_embedding_le_house α σ) k\n _ ≤ NumberField.house α ^ 4 := pow_le_pow_right₀ hH (by omega)\n · simpa only [e, map_pow, Complex.ofReal_pow, mul_pow] using\n (congrArg (fun z : ℂ => z ^ k) (Complex.norm_mul_exp_arg_mul_I (σ α))).symm\ntheorem integration_reverse_comp_sq (F : Polynomial ℤ) :\n (F.comp (Polynomial.X ^ 2)).reverse = F.reverse.comp (Polynomial.X ^ 2) := by\n ext n\n simp only [Polynomial.coeff_reverse, ← Polynomial.expand_eq_comp_X_pow,\n Polynomial.natDegree_expand, Polynomial.coeff_expand (by norm_num : 0 < (2 : ℕ))]\n by_cases hn : n ≤ F.natDegree * 2\n · rw [Polynomial.revAt_le hn]\n by_cases hd : 2 ∣ n\n · have hd' : 2 ∣ F.natDegree * 2 - n := by omega\n simp only [ite_eq_left hd', ite_eq_left hd]\n rw [Polynomial.revAt_le (by omega : n / 2 ≤ F.natDegree)]\n congr 1\n omega\n · have hd' : ¬ 2 ∣ F.natDegree * 2 - n := by omega\n simp only [ite_eq_right hd', ite_eq_right hd]\n · rw [Polynomial.revAt_eq_self_of_lt (Nat.lt_of_not_ge hn)]\n by_cases hd : 2 ∣ n\n · simp only [ite_eq_left hd]\n rw [Polynomial.revAt_eq_self_of_lt (by omega : F.natDegree < n / 2)]\n · simp only [ite_eq_right hd]\ntheorem integration_integral_comp_drop {K : Type*} [Field K] [NumberField K]\n (α : K) (hInt : IsIntegral ℤ α)\n (hdrop : (minpoly ℚ (α ^ 2)).natDegree < (minpoly ℚ α).natDegree) :\n (minpoly ℤ (α ^ 2)).comp (Polynomial.X ^ 2) = minpoly ℤ α := by\n apply Polynomial.map_injective (Int.castRingHom ℚ) Int.cast_injective\n rw [Polynomial.map_comp, Polynomial.map_pow, Polynomial.map_X]\n have h0 := minpoly.isIntegrallyClosed_eq_field_fractions' ℚ hInt\n have h1 := minpoly.isIntegrallyClosed_eq_field_fractions' ℚ (hInt.pow 2)\n change ((minpoly ℤ (α ^ 2)).map (algebraMap ℤ ℚ)).comp (Polynomial.X ^ 2) =\n (minpoly ℤ α).map (algebraMap ℤ ℚ)\n rw [← h0, ← h1]\n exact Submission.Helpers.minpoly_sq_comp_of_degree_drop α hdrop\ntheorem integration_transform_even (F : Polynomial ℤ) :\n let E := F.comp (Polynomial.X ^ 2)\n (Polynomial.contract 2 E) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX E)) ^ 2 = F ^ 2 := by\n dsimp only\n apply Polynomial.expand_injective (by norm_num : 0 < (2 : ℕ))\n change (((Polynomial.contract 2 (F.comp (Polynomial.X ^ 2))) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX\n (F.comp (Polynomial.X ^ 2)))) ^ 2).comp (Polynomial.X ^ 2)) =\n (F ^ 2).comp (Polynomial.X ^ 2)\n rw [Submission.Helpers.even_odd_power_transform_subst]\n simp only [Polynomial.comp_assoc, Polynomial.pow_comp,\n Polynomial.X_comp, neg_sq]\n ring\ntheorem integration_transform_drop {K : Type*} [Field K] [NumberField K]\n (α : K) (hInt : IsIntegral ℤ α)\n (hdrop : (minpoly ℚ (α ^ 2)).natDegree < (minpoly ℚ α).natDegree) :\n let F := (minpoly ℤ α).reverse\n (Polynomial.contract 2 F) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX F)) ^ 2 =\n (minpoly ℤ (α ^ 2)).reverse ^ 2 := by\n dsimp only\n rw [← integration_integral_comp_drop α hInt hdrop, integration_reverse_comp_sq]\n exact integration_transform_even _\ntheorem integration_map_reverse {R S : Type*} [Semiring R] [Semiring S]\n (f : R →+* S) (hf : Function.Injective f) (P : Polynomial R) :\n P.reverse.map f = (P.map f).reverse := by\n unfold Polynomial.reverse\n rw [Polynomial.natDegree_map_eq_of_injective hf]\n exact (Polynomial.reflect_map f P _).symm\ntheorem integration_reverse_reverse {R : Type*} [Semiring R]\n (P : Polynomial R) (hP : P.coeff 0 ≠ 0) : P.reverse.reverse = P := by\n have ht : P.natTrailingDegree = 0 := Polynomial.natTrailingDegree_eq_zero.mpr (Or.inr hP)\n change Polynomial.reflect P.reverse.natDegree (Polynomial.reflect P.natDegree P) = P\n rw [Polynomial.reverse_natDegree, ht, Nat.sub_zero]\n exact Polynomial.reflect_reflect\ntheorem integration_house_eq_of_minpoly_eq {K : Type*} [Field K] [NumberField K]\n (α β : K) (h : minpoly ℚ α = minpoly ℚ β) : NumberField.house α = NumberField.house β := by\n classical\n have aux (x y : K) (hm : minpoly ℚ x = minpoly ℚ y) :\n Finset.univ.sup' Finset.univ_nonempty (fun σ : K →+* ℂ => ‖σ x‖₊) ≤\n Finset.univ.sup' Finset.univ_nonempty (fun σ : K →+* ℂ => ‖σ y‖₊) := by\n apply Finset.sup'_le\n intro σ _\n have hx : σ x ∈ (minpoly ℚ y).rootSet ℂ := by\n rw [← hm, ← NumberField.Embeddings.range_eval_eq_rootSet_minpoly K ℂ x]\n exact ⟨σ, rfl⟩\n rw [← NumberField.Embeddings.range_eval_eq_rootSet_minpoly K ℂ y] at hx\n obtain ⟨τ, hτ⟩ := hx\n rw [← hτ]\n exact Finset.le_sup' (fun φ : K →+* ℂ => ‖φ y‖₊) (Finset.mem_univ τ)\n rw [NumberField.house_eq_sup' α, NumberField.house_eq_sup' β]\n exact congrArg (fun x : NNReal => (x : ℝ)) (le_antisymm (aux α β h) (aux β α h.symm))\ntheorem integration_reverse_prod (n : ℕ) (b : Fin n → ℂ) :\n (∏ i : Fin n, (Polynomial.X - Polynomial.C (b i))).reverse =\n ∏ i : Fin n, (1 - Polynomial.C (b i) * Polynomial.X) := by\n classical\n have he (z : ℂ) : (Polynomial.X - Polynomial.C z).reverse =\n 1 - Polynomial.C z * Polynomial.X := by\n rw [sub_eq_add_neg, ← Polynomial.C_neg, Polynomial.reverse_add_C]\n simp [Polynomial.reverse, sub_eq_add_neg]\n let rev : Polynomial ℂ →* Polynomial ℂ :=\n { toFun := Polynomial.reverse\n map_one' := by simp [Polynomial.reverse]\n map_mul' := Polynomial.reverse_mul_of_domain }\n change rev (∏ i : Fin n, (Polynomial.X - Polynomial.C (b i))) = _\n rw [map_prod]\n exact Finset.prod_congr rfl (fun i _ => he (b i))\ntheorem integration_transform_product (n : ℕ) (b : Fin n → ℂ) (F : Polynomial ℤ)\n (hF : F.map (Int.castRingHom ℂ) =\n ∏ i : Fin n, (1 - Polynomial.C (b i) * Polynomial.X)) :\n ((Polynomial.contract 2 F) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX F)) ^ 2).map\n (Int.castRingHom ℂ) =\n ∏ i : Fin n, (1 - Polynomial.C (b i ^ 2) * Polynomial.X) := by\n classical\n have hs := congrArg (Polynomial.map (Int.castRingHom ℂ))\n (Submission.Helpers.even_odd_power_transform_subst F)\n simp only [Polynomial.map_comp, Polynomial.map_pow, Polynomial.map_X,\n Polynomial.map_mul, Polynomial.map_neg] at hs\n apply Polynomial.expand_injective (by norm_num : 0 < (2 : ℕ))\n change (((Polynomial.contract 2 F) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX F)) ^ 2).map\n (Int.castRingHom ℂ)).comp (Polynomial.X ^ 2) =\n (∏ i : Fin n, (1 - Polynomial.C (b i ^ 2) * Polynomial.X)).comp (Polynomial.X ^ 2)\n rw [hs]\n simp only [hF, Polynomial.prod_comp]\n rw [← Finset.prod_mul_distrib]\n apply Finset.prod_congr rfl\n intro i _\n simp only [Polynomial.sub_comp, Polynomial.mul_comp, Polynomial.one_comp,\n Polynomial.C_comp, Polynomial.X_comp, Polynomial.C_pow, Polynomial.pow_comp]\n ring\nnoncomputable def integration_power_transform (F : Polynomial ℤ) : Polynomial ℤ :=\n (Polynomial.contract 2 F) ^ 2 -\n Polynomial.X * (Polynomial.contract 2 (Polynomial.divX F)) ^ 2\ntheorem integration_minpoly_map (K : Type*) [Field K] [NumberField K]\n (α : K) (hInt : IsIntegral ℤ α) :\n (minpoly ℤ α).map (Int.castRingHom ℚ) = minpoly ℚ α := by\n exact (minpoly.isIntegrallyClosed_eq_field_fractions' ℚ hInt).symm\ntheorem integration_distinct_conjugates {K : Type*} [Field K] [NumberField K]\n (α : K) (hInt : IsIntegral ℤ α) :\n ∃ c : Fin (minpoly ℚ α).natDegree → ℂ,\n Function.Injective c ∧\n (∀ i, ∃ σ : K →+* ℂ, c i = σ α) ∧\n (minpoly ℤ α).reverse.map (Int.castRingHom ℂ) =\n ∏ i, (1 - Polynomial.C (c i) * Polynomial.X) := by\n classical\n obtain ⟨e⟩ := integration_root_enumeration α\n let c : Fin (minpoly ℚ α).natDegree → ℂ := fun i => e.symm i\n have hc : Function.Injective c := Subtype.val_injective.comp e.symm.injective\n refine ⟨c, hc, ?_, ?_⟩\n · intro i\n have hi : c i ∈ (minpoly ℚ α).rootSet ℂ := (e.symm i).property\n rw [← NumberField.Embeddings.range_eval_eq_rootSet_minpoly K ℂ α] at hi\n obtain ⟨σ, hσ⟩ := hi\n exact ⟨σ, hσ.symm⟩\n · have hprod := integration_distinct_root_product (minpoly ℚ α)\n (minpoly.monic (IsIntegral.of_finite ℚ α))\n (minpoly.irreducible (IsIntegral.of_finite ℚ α)).separable\n have he : (∏ i, (Polynomial.X - Polynomial.C (c i))) =\n ∏ z : (minpoly ℚ α).rootSet ℂ, (Polynomial.X - Polynomial.C (z : ℂ)) :=\n e.symm.prod_comp (fun z => Polynomial.X - Polynomial.C (z : ℂ))\n have hmap : (minpoly ℤ α).map (Int.castRingHom ℂ) =\n (minpoly ℚ α).map (algebraMap ℚ ℂ) := by\n rw [← integration_minpoly_map K α hInt, Polynomial.map_map]\n congr 1\n rw [integration_map_reverse _ Int.cast_injective, hmap, hprod, ← he]\n exact integration_reverse_prod _ c\ntheorem integration_join_products (n : ℕ) (u v : Fin n → ℂ) :\n ∃ b : Fin (2 * n) → ℂ,\n (∀ i, (∃ j, b i = u j) ∨ (∃ j, b i = v j)) ∧\n (∏ i, (1 - Polynomial.C (u i) * Polynomial.X)) *\n (∏ i, (1 - Polynomial.C (v i) * Polynomial.X)) =\n ∏ i, (1 - Polynomial.C (b i) * Polynomial.X) := by\n classical\n let e : Fin 2 × Fin n ≃ Fin (2 * n) := finProdFinEquiv\n let b : Fin (2 * n) → ℂ := fun i =>\n if (e.symm i).1 = 0 then u (e.symm i).2 else v (e.symm i).2\n refine ⟨b, ?_, ?_⟩\n · intro i\n by_cases hi : (e.symm i).1 = 0\n · exact Or.inl ⟨(e.symm i).2, if_pos hi⟩\n · exact Or.inr ⟨(e.symm i).2, if_neg hi⟩\n · have he := e.prod_comp (fun i => (1 - Polynomial.C (b i) * Polynomial.X))\n simp only [b, Equiv.symm_apply_apply] at he\n rw [Fintype.prod_prod_type, Fin.prod_univ_two] at he\n simpa using he\ntheorem integration_formal_square_root (F : Polynomial ℤ) (hF : F.coeff 0 = 1) :\n ∃ S : PowerSeries ℤ, PowerSeries.constantCoeff S = 1 ∧\n S ^ 2 = ((integration_power_transform F *\n integration_power_transform (integration_power_transform F) : Polynomial ℤ) :\n PowerSeries ℤ) := by\n obtain ⟨Q, hQ, hQ₀⟩ := even_odd_power_transform_mod_four F hF\n change integration_power_transform (integration_power_transform F) =\n integration_power_transform F + 4 * Q at hQ\n have hU : PowerSeries.constantCoeff\n (integration_power_transform F : PowerSeries ℤ) = 1 := by\n change (integration_power_transform F).coeff 0 = 1\n rw [integration_power_transform, even_odd_power_transform_coeff_zero, hF, one_pow]\n have hQ' : PowerSeries.constantCoeff (Q : PowerSeries ℤ) = 0 := hQ₀\n obtain ⟨S, hS₀, hS⟩ := integral_square_root_mod_four\n (integration_power_transform F : PowerSeries ℤ) Q hU hQ'\n refine ⟨S, hS₀, ?_⟩\n have h4 : ((4 : Polynomial ℤ) : PowerSeries ℤ) = 4 := by\n have h : (4 : Polynomial ℤ) = 1 + 1 + 1 + 1 := by norm_num\n rw [h, Polynomial.coe_add, Polynomial.coe_add, Polynomial.coe_add, Polynomial.coe_one]\n norm_num\n rw [hQ]\n simpa only [Polynomial.coe_mul, Polynomial.coe_add, h4] using hS\ntheorem integration_preserved_integral {K : Type*} [Field K] [NumberField K]\n (α : K) (hInt : IsIntegral ℤ α) (hα : α ≠ 0)\n (hdegree : (minpoly ℚ α).natDegree = (minpoly ℚ (α ^ 2)).natDegree) :\n integration_power_transform (minpoly ℤ α).reverse =\n (minpoly ℤ (α ^ 2)).reverse := by\n apply Polynomial.map_injective (Int.castRingHom ℚ) Int.cast_injective\n rw [integration_map_reverse _ Int.cast_injective, integration_minpoly_map K _ (hInt.pow 2)]\n exact integration_transform_preserved α hInt hα hdegree\ntheorem integration_square_obstruction {K : Type*} [Field K] [NumberField K]\n (α : K) (hInt : IsIntegral ℤ α) (hα : α ≠ 0) (hH : 1 < NumberField.house α)\n (hsquare : ∃ G : Polynomial ℚ, G ^ 2 =\n (integration_power_transform (minpoly ℤ α).reverse *\n integration_power_transform (integration_power_transform\n (minpoly ℤ α).reverse)).map (Int.castRingHom ℚ)) :\n (minpoly ℚ (α ^ 2)).natDegree < (minpoly ℚ α).natDegree := by\n by_contra hdrop\n have hdegree : (minpoly ℚ α).natDegree = (minpoly ℚ (α ^ 2)).natDegree := by\n rcases minpoly_sq_degree_dichotomy α with h | h\n · exact h\n · have hp := minpoly.natDegree_pos (IsIntegral.of_finite ℚ (α ^ 2))\n omega\n let β := α ^ 2\n have hβ : β ≠ 0 := pow_ne_zero 2 hα\n have hβInt : IsIntegral ℤ β := hInt.pow 2\n have hU := integration_preserved_integral α hInt hα hdegree\n obtain ⟨G, hG⟩ := hsquare\n rw [hU] at hG\n let P := minpoly ℚ β\n let R := minpoly ℚ (β ^ 2)\n have hP : P.Monic := minpoly.monic (IsIntegral.of_finite ℚ β)\n have hiP : Irreducible P := minpoly.irreducible (IsIntegral.of_finite ℚ β)\n have hR : R.Monic := minpoly.monic (IsIntegral.of_finite ℚ (β ^ 2))\n have hcP : P.coeff 0 ≠ 0 := minpoly.coeff_zero_ne_zero\n (IsIntegral.of_finite ℚ β) hβ\n have hcR : R.coeff 0 ≠ 0 := minpoly.coeff_zero_ne_zero\n (IsIntegral.of_finite ℚ (β ^ 2)) (pow_ne_zero 2 hβ)\n have hmapP : (minpoly ℤ β).reverse.map (Int.castRingHom ℚ) = P.reverse := by\n rw [integration_map_reverse _ Int.cast_injective, integration_minpoly_map K β hβInt]\n change G ^ 2 = ((minpoly ℤ β).reverse *\n integration_power_transform (minpoly ℤ β).reverse).map (Int.castRingHom ℚ) at hG\n rcases minpoly_sq_degree_dichotomy β with hd | hd\n · have hmapR : (integration_power_transform (minpoly ℤ β).reverse).map\n (Int.castRingHom ℚ) = R.reverse :=\n integration_transform_preserved β hβInt hβ hd\n have hsq : G.reverse ^ 2 = P * R := by\n rw [Polynomial.map_mul, hmapP, hmapR] at hG\n simpa only [pow_two, Polynomial.reverse_mul_of_domain,\n integration_reverse_reverse P hcP, integration_reverse_reverse R hcR] using\n congrArg Polynomial.reverse hG\n have heq : R = P := polynomial_eq_of_monic_irreducible_mul_eq_sq\n hP hiP hR hd.symm hsq\n have hhouse := integration_house_eq_of_minpoly_eq β (β ^ 2) heq.symm\n rw [NumberField.house_pow β 2] at hhouse\n have hβH : 1 < NumberField.house β := by\n dsimp [β]\n rw [NumberField.house_pow]\n nlinarith\n nlinarith\n · have hdropβ : (minpoly ℚ (β ^ 2)).natDegree < (minpoly ℚ β).natDegree := by\n have hp := minpoly.natDegree_pos (IsIntegral.of_finite ℚ (β ^ 2))\n omega\n have hV : integration_power_transform (minpoly ℤ β).reverse =\n (minpoly ℤ (β ^ 2)).reverse ^ 2 :=\n integration_transform_drop β hβInt hdropβ\n have hmapR : (minpoly ℤ (β ^ 2)).reverse.map (Int.castRingHom ℚ) = R.reverse := by\n rw [integration_map_reverse _ Int.cast_injective,\n integration_minpoly_map K _ (hβInt.pow 2)]\n have hsq : G.reverse ^ 2 = P * R ^ 2 := by\n rw [hV, Polynomial.map_mul, Polynomial.map_pow, hmapP, hmapR] at hG\n simpa only [pow_two, Polynomial.reverse_mul_of_domain,\n integration_reverse_reverse P hcP, integration_reverse_reverse R hcR] using\n congrArg Polynomial.reverse hG\n exact integration_second_drop hP hiP hR hd.symm hsq\ntheorem integration_square_from_contraction\n (hcontract : ∀ (A : Finset ℂ) (T : ℝ), A.Nonempty →\n (∀ a ∈ A, ‖a‖ = 1) → 0 ≤ T → T ^ A.card < 4 →\n ∃ p : Polynomial ℂ, p.Monic ∧ 0 < p.natDegree ∧\n ∃ q : ℝ, 0 ≤ q ∧ q < 1 ∧ ∀ a ∈ A, ∀ t : ℝ,\n 0 ≤ t → t ≤ T → ‖p.eval ((t : ℂ) * a)‖ ≤ q)\n {K : Type*} [Field K] [NumberField K] (α : K)\n (hInt : IsIntegral ℤ α) (hH : 1 ≤ NumberField.house α)\n (hlt : NumberField.house α ^\n (4 * (Finset.univ.image fun σ : K →+* ℂ => (σ α).arg).card) < 2) :\n ∃ G : Polynomial ℚ, G ^ 2 =\n (integration_power_transform (minpoly ℤ α).reverse *\n integration_power_transform (integration_power_transform\n (minpoly ℤ α).reverse)).map (Int.castRingHom ℚ) := by\n classical\n let F := (minpoly ℤ α).reverse\n let U := integration_power_transform F\n let V := integration_power_transform U\n obtain ⟨c, _, hc, hF⟩ := integration_distinct_conjugates α hInt\n have hU : U.map (Int.castRingHom ℂ) =\n ∏ i, (1 - Polynomial.C (c i ^ 2) * Polynomial.X) :=\n integration_transform_product _ c F hF\n have hV : V.map (Int.castRingHom ℂ) =\n ∏ i, (1 - Polynomial.C (c i ^ 4) * Polynomial.X) := by\n have hv := integration_transform_product _ (fun i => c i ^ 2) U hU\n change V.map (Int.castRingHom ℂ) =\n ∏ i, (1 - Polynomial.C ((c i ^ 2) ^ 2) * Polynomial.X) at hv\n rw [hv]\n simp only [← pow_mul, Nat.reduceMul]\n obtain ⟨b, hb, hprod⟩ := integration_join_products _\n (fun i => c i ^ 2) (fun i => c i ^ 4)\n have hUV : (U * V).map (Int.castRingHom ℂ) =\n ∏ i, (1 - Polynomial.C (b i) * Polynomial.X) := by\n rw [Polynomial.map_mul, hU, hV, hprod]\n obtain ⟨A, hA, hunit, hrad, hcover⟩ := integration_power_ray_cover α hH hlt\n have hpoint : ∀ i, b i ∈ radial_tree_set A (NumberField.house α ^ 4) := by\n intro i\n rcases hb i with ⟨j, hj⟩ | ⟨j, hj⟩\n · obtain ⟨σ, hσ⟩ := hc j\n rw [hj, hσ, ← map_pow]\n exact hcover σ 2 (Or.inl rfl)\n · obtain ⟨σ, hσ⟩ := hc j\n rw [hj, hσ, ← map_pow]\n exact hcover σ 4 (Or.inr rfl)\n have hF₀ : F.coeff 0 = 1 := by\n simp [F, (minpoly.monic hInt).leadingCoeff]\n obtain ⟨S, hS₀, hS⟩ := integration_formal_square_root F hF₀\n change S ^ 2 = ((U * V : Polynomial ℤ) : PowerSeries ℤ) at hS\n apply radial_integral_square_root_is_polynomial\n (minpoly ℚ α).natDegree b (U * V) S hS₀ hS hUV\n obtain ⟨p, hp, hpd, q, hq₀, hq₁, hpq⟩ := hcontract A (NumberField.house α ^ 4)\n hA hunit (pow_nonneg (by linarith) 4) hrad\n refine ⟨p, hp, hpd, q, hq₀, hq₁, ?_⟩\n intro i t ht ht₁\n obtain ⟨a, ha, r, hr, hrT, hbr⟩ :=\n (radial_tree_set_mem_iff A (NumberField.house α ^ 4) (b i)).mp (hpoint i)\n have htr : t * r ≤ NumberField.house α ^ 4 := by\n calc\n t * r ≤ 1 * r := mul_le_mul_of_nonneg_right ht₁ hr\n _ ≤ NumberField.house α ^ 4 := by simpa using hrT\n have he : (t : ℂ) * b i = ((t * r : ℝ) : ℂ) * a := by\n rw [hbr, Complex.ofReal_mul, mul_assoc]\n rw [he]\n exact hpq a ha (t * r) (mul_nonneg ht hr) htr\ntheorem house_power_lower_bound_of_radial_contraction\n (hcontract : ∀ (A : Finset ℂ) (T : ℝ), A.Nonempty →\n (∀ a ∈ A, ‖a‖ = 1) → 0 ≤ T → T ^ A.card < 4 →\n ∃ p : Polynomial ℂ, p.Monic ∧ 0 < p.natDegree ∧\n ∃ q : ℝ, 0 ≤ q ∧ q < 1 ∧ ∀ a ∈ A, ∀ t : ℝ,\n 0 ≤ t → t ≤ T → ‖p.eval ((t : ℂ) * a)‖ ≤ q) :\n ∀ {K : Type*} [Field K] [NumberField K] (α : K),\n IsIntegral ℤ α → α ≠ 0 → ¬ IsOfFinOrder α →\n (2 : ℝ) ≤ NumberField.house α ^\n (4 * (Finset.univ.image fun σ : K →+* ℂ => (σ α).arg).card) := by\n intro K _ _\n classical\n have main : ∀ n : ℕ, ∀ α : K, (minpoly ℚ α).natDegree = n →\n IsIntegral ℤ α → α ≠ 0 → ¬ IsOfFinOrder α →\n (2 : ℝ) ≤ NumberField.house α ^\n (4 * (Finset.univ.image fun σ : K →+* ℂ => (σ α).arg).card) := by\n intro n\n induction n using Nat.strong_induction_on with\n | h n ih =>\n intro α hn hInt hα hnot\n by_contra hlt\n have hH := house_gt_one α hInt hα hnot\n have hs := integration_square_from_contraction hcontract α hInt hH.le\n (lt_of_not_ge hlt)\n have hd := integration_square_obstruction α hInt hα hH hs\n have hnotSq : ¬ IsOfFinOrder (α ^ 2) := by\n intro h\n exact hnot ((isOfFinOrder_pow.mp h).resolve_right (by decide))\n have hind := ih (minpoly ℚ (α ^ 2)).natDegree (by omega)\n (α ^ 2) rfl (hInt.pow 2) (pow_ne_zero 2 hα) hnotSq\n exact hlt (integration_degree_drop_exponent α hα hd hind)\n intro α\n exact main _ α rfl\ntheorem house_power_lower_bound {K : Type*} [Field K] [NumberField K]\n (α : K) (α_int : IsIntegral ℤ α) (α_ne_zero : α ≠ 0)\n (α_not_rootOfUnity : ¬ IsOfFinOrder α) :\n (2 : ℝ) ≤ NumberField.house α ^\n (4 * (Finset.univ.image fun σ : K →+* ℂ => (σ α).arg).card) := by\n exact house_power_lower_bound_of_radial_contraction radial_tree_contracting_monic\n α α_int α_ne_zero α_not_rootOfUnity\nend Submission.Helpers\n" } ], "official": { "statementRevision": 1, "submissionUrl": "https://github.com/leanprover/lean-eval-submissions/issues/2143", "resultUrl": "https://github.com/leanprover/lean-eval-submissions/issues/2143#issuecomment-6215093969", "resultBody": "## Submission result\n\n✅ Newly-solved problems: dimitrov, hopf_rinow\n\nAttempted 2 / 2; succeeded on 2.\n\n### Per-problem\n- `dimitrov`: pass\n- `hopf_rinow`: pass", "sourceUrl": "https://github.com/LikC1606/deepscientist-math-proofs/tree/b6909c3211863eac52c040c8812da3df4ce3af4d", "sourceCommit": "b6909c3211863eac52c040c8812da3df4ce3af4d", "checksums": { "Submission.lean": "f00a658ba195e41c8b9f340cb6c21cbbfeb9e4cb68c0c0e85c1d8b3bdb25fe5d", "Submission/Helpers.lean": "4958987925b01fbfba67842ea4aa79e1452f1614e1c4ed82cba7bbc933affefd", "lake-manifest.json": "9aecfc7243ab33486842d04b39d0233997e62a1600dc049fde1552427dd605d1", "lakefile.toml": "46811a9ccc8462fd95c6182cd1480dc22d7b3375d0b23745bb631ede855a0492", "lean-toolchain": "bc84812c94489d1e3e191baa1dc10d5eb684382d7fe9d2a5ab085e72c1c67e47", "verification.json": "a1474a7a082fb842d9651358ca49c68ff26e2e31f361d688ff7a6ec611e303a5" } }, "local": { "status": "official_verified", "kernelVerified": true, "comparator": "official_verified", "receipt": "official-e24ceed48b27c14dc18ebf98", "sourceProofCommit": "4cbc7b9a41f58e54879f513f36c1bc9253bfa26b", "sourceBinding": "matches", "axioms": [], "url": "https://github.com/LikC1606/theorem-os-site/blob/main/accepted/dimitrov/verification.json" } }, { "id": "hopf_rinow", "title": "Hopf–Rinow", "subtitle": "测地完备与度量完备", "area": "微分几何", "summary": "在原题的黎曼流形条件下，证明测地完备与度量完备的等价性。档案保留最终提交包及官方验收记录。", "declaration": "theorem hopf_rinow", "en": { "subtitle": "Geodesic and metric completeness", "area": "Riemannian geometry", "summary": "Under the Riemannian manifold hypotheses of the statement, proves that geodesic completeness and metric completeness are equivalent. The archive keeps the final submission package and its official result." }, "status": "official_accepted", "model": "DeepScientist Math + GPT-6.1 (gpt-6.1-sol)", "updatedAt": "2026-10-16T12:04:03Z", "archiveUrl": "https://github.com/LikC1606/theorem-os-site/tree/main/accepted/hopf_rinow", "sources": [ { "name": "Submission.lean", "path": "accepted/hopf_rinow/Submission.lean", "url": "https://github.com/LikC1606/theorem-os-site/blob/main/accepted/hopf_rinow/Submission.lean", "sha256": "168812f88c0fa82777a53cb700e391f6deab564ad2b210900c7573e72d0c365a", "lines": 3158, "code": "import ChallengeDeps\nimport Submission.Helpers\n\nopen LeanEval.Geometry\nopen scoped Manifold ENNReal ContDiff\nopen Bundle\n\nnamespace Submission\n\ntheorem Helpers.hasDerivWithinAt_update_of_ode_limit\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {F : E → E} {X : ℝ → E} {p : E} {a b : ℝ}\n (hab : a < b) (hF : ContinuousAt F p)\n (hX : ∀ t ∈ Set.Ioo a b, HasDerivAt X (F (X t)) t)\n (hlim : Filter.Tendsto X (nhdsWithin b (Set.Ioo a b)) (nhds p)) :\n HasDerivWithinAt (Function.update X b p) (F p) (Set.Iic b) b := by\n classical\n let Y : ℝ → E := Function.update X b p\n have heq (t : ℝ) (ht : t < b) : Y =ᶠ[nhds t] X := by\n filter_upwards [isOpen_ne.mem_nhds ht.ne] with s hs\n exact Function.update_of_ne hs _ _\n have hd (t : ℝ) (ht : t ∈ Set.Ioo a b) : HasDerivAt Y (F (X t)) t :=\n (hX t ht).congr_of_eventuallyEq (heq t ht.2)\n have hc : ContinuousWithinAt Y (Set.Ioo a b) b := by\n apply continuousWithinAt_update_same.mpr\n simpa only [Set.sdiff_singleton_eq_self (show b ∉ Set.Ioo a b by simp)] using hlim\n have hlim' : Filter.Tendsto X (nhdsWithin b (Set.Iio b)) (nhds p) := by\n rwa [nhdsWithin_Ioo_eq_nhdsLT hab] at hlim\n apply hasDerivWithinAt_Iic_of_tendsto_deriv\n (fun t ht => (hd t ht).differentiableAt.differentiableWithinAt) hc\n (Ioo_mem_nhdsLT hab)\n apply (hF.tendsto.comp hlim').congr'\n filter_upwards [Ioo_mem_nhdsLT hab] with t ht\n exact (hd t ht).deriv.symm\ntheorem Helpers.exists_ode_continuation_of_tendsto\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {U : Set E} (hU : IsOpen U) {F : E → E}\n (hF : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) F U)\n {X : ℝ → E} {p : E} {a b : ℝ} (hab : a < b) (hp : p ∈ U)\n (hX : ∀ t ∈ Set.Ioo a b, HasDerivAt X (F (X t)) t)\n (hlim : Filter.Tendsto X (nhdsWithin b (Set.Ioo a b)) (nhds p)) :\n ∃ δ > (0 : ℝ), ∃ Y : ℝ → E,\n Y b = p ∧\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Y (Set.Ioo (b - δ) (b + δ)) ∧\n (∀ t ∈ Set.Ioo (b - δ) (b + δ), Y t ∈ U ∧ HasDerivAt Y (F (Y t)) t) ∧\n ∀ t ∈ Set.Ioo (b - δ) b, Y t = X t := by\n classical\n have hFat := hF.contDiffAt (hU.mem_nhds hp)\n obtain ⟨K, W, hW, hLip⟩ := (hFat.of_le (show (1 : WithTop ℕ∞) ≤ ↑(⊤ : ℕ∞) by simp)).exists_lipschitzOnWith\n obtain ⟨R, hR, hRsub⟩ := Metric.mem_nhds_iff.mp (Filter.inter_mem hW (hU.mem_nhds hp))\n have hRU : Metric.ball p R ⊆ U := fun z hz => (hRsub hz).2\n have hLK : LipschitzOnWith K F (Metric.ball p R) :=\n hLip.mono (fun z hz => (hRsub hz).1)\n obtain ⟨r, hr, ε, hε, Φ, hΦ, hΦ0, hΦode⟩ :=\n Helpers.exists_smooth_local_ode_flow (Metric.ball p R) Metric.isOpen_ball F\n (hF.mono hRU) p (Metric.mem_ball_self hR)\n let Y : ℝ → E := fun t => Φ (t - b, p)\n have hYb : Y b = p := by\n simpa only [Y, sub_self] using hΦ0 p (Metric.mem_ball_self hr)\n have hYode (t : ℝ) (ht : t ∈ Set.Ioo (b - ε) (b + ε)) :\n Y t ∈ Metric.ball p R ∧ HasDerivAt Y (F (Y t)) t := by\n have ht' : t - b ∈ Set.Ioo (-ε) ε := by constructor <;> linarith [ht.1, ht.2]\n have h := hΦode (t - b, p) ⟨ht', Metric.mem_ball_self hr⟩\n refine ⟨h.1, ?_⟩\n simpa only [Y, Function.comp_def, id_eq, one_smul] using\n h.2.scomp t ((hasDerivAt_id t).sub_const b)\n have hnear : ∀ᶠ t in nhdsWithin b (Set.Iio b), X t ∈ Metric.ball p R := by\n have h := hlim.eventually (Metric.ball_mem_nhds p hR)\n rwa [nhdsWithin_Ioo_eq_nhdsLT hab] at h\n obtain ⟨d, hdb, hd⟩ := mem_nhdsLT_iff_exists_Ioo_subset.mp hnear\n let δ : ℝ := min ε (b - max a d) / 2\n have hgap : 0 < b - max a d := sub_pos.mpr (max_lt hab hdb)\n have hδ : 0 < δ := half_pos (lt_min hε hgap)\n have hδε : δ < ε := by dsimp [δ]; linarith [min_le_left ε (b - max a d)]\n have hδgap : δ < b - max a d := by\n dsimp [δ]\n linarith [min_le_right ε (b - max a d)]\n have haδ : a < b - δ := by linarith [le_max_left a d]\n have hdδ : d < b - δ := by linarith [le_max_right a d]\n have hsub (t : ℝ) (ht : t ∈ Set.Icc (b - δ) b) (htb : t ≠ b) :\n t ∈ Set.Ioo a b := ⟨haδ.trans_le ht.1, lt_of_le_of_ne ht.2 htb⟩\n let Z : ℝ → E := Function.update X b p\n have hZb : Z b = p := by simp [Z]\n have hZd (t : ℝ) (ht : t ∈ Set.Ioo a b) : HasDerivAt Z (F (Z t)) t := by\n have heq : Z =ᶠ[nhds t] X := by\n filter_upwards [isOpen_ne.mem_nhds ht.2.ne] with s hs\n exact Function.update_of_ne hs _ _\n have hz : Z t = X t := Function.update_of_ne ht.2.ne _ _\n rw [hz]\n exact (hX t ht).congr_of_eventuallyEq heq\n have hZdb : HasDerivWithinAt Z (F p) (Set.Iic b) b :=\n Helpers.hasDerivWithinAt_update_of_ode_limit hab hFat.continuousAt hX hlim\n have hZcont : ContinuousOn Z (Set.Icc (b - δ) b) := by\n intro t ht\n by_cases htb : t = b\n · subst t\n exact hZdb.continuousWithinAt.mono (fun _ hz => hz.2)\n · exact (hZd t (hsub t ht htb)).continuousAt.continuousWithinAt\n have hZmem (t : ℝ) (ht : t ∈ Set.Icc (b - δ) b) : Z t ∈ Metric.ball p R := by\n by_cases htb : t = b\n · simpa only [htb, hZb] using Metric.mem_ball_self hR\n · rw [show Z t = X t from Function.update_of_ne htb _ _]\n exact hd ⟨hdδ.trans_le ht.1, lt_of_le_of_ne ht.2 htb⟩\n have hYtime (t : ℝ) (ht : t ∈ Set.Icc (b - δ) b) :\n t ∈ Set.Ioo (b - ε) (b + ε) := by constructor <;> linarith [ht.1, ht.2]\n have hEq : Set.EqOn Z Y (Set.Icc (b - δ) b) := by\n apply ODE_solution_unique_of_mem_Icc_left (v := fun _ => F)\n (s := fun _ => Metric.ball p R) (fun _ _ => hLK)\n hZcont ?_ (fun t ht => hZmem t ⟨ht.1.le, ht.2⟩)\n (fun t ht => (hYode t (hYtime t ht)).2.continuousAt.continuousWithinAt)\n (fun t ht => (hYode t (hYtime t ⟨ht.1.le, ht.2⟩)).2.hasDerivWithinAt)\n (fun t ht => (hYode t (hYtime t ⟨ht.1.le, ht.2⟩)).1)\n (hZb.trans hYb.symm)\n intro t ht\n by_cases htb : t = b\n · subst t\n simpa only [hZb] using hZdb\n · exact (hZd t (hsub t ⟨ht.1.le, ht.2⟩ htb)).hasDerivWithinAt\n refine ⟨δ, hδ, Y, hYb, ?_, ?_, ?_⟩\n · apply hΦ.comp (contDiffOn_id.sub contDiffOn_const |>.prodMk contDiffOn_const)\n intro t ht\n change (t - b, p) ∈ Set.Ioo (-ε) ε ×ˢ Metric.ball p r\n exact ⟨⟨by linarith [ht.1], by linarith [ht.2]⟩, Metric.mem_ball_self hr⟩\n · intro t ht\n have h := hYode t ⟨by linarith [ht.1], by linarith [ht.2]⟩\n exact ⟨hRU h.1, h.2⟩\n · intro t ht\n exact (hEq ⟨ht.1.le, ht.2.le⟩).symm.trans (Function.update_of_ne ht.2.ne _ _)\ntheorem Helpers.exists_spray_continuation_of_phase_limit\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {U : Set E} (hU : IsOpen U) {Γ : E → E →L[ℝ] E →L[ℝ] E}\n (hΓ : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Γ U)\n {x v : ℝ → E} {p w : E} {a b : ℝ} (hab : a < b) (hp : p ∈ U)\n (hphase : ∀ t ∈ Set.Ioo a b,\n HasDerivAt x (v t) t ∧ HasDerivAt v (-(Γ (x t) (v t) (v t))) t)\n (hx : Filter.Tendsto x (nhdsWithin b (Set.Ioo a b)) (nhds p))\n (hv : Filter.Tendsto v (nhdsWithin b (Set.Ioo a b)) (nhds w)) :\n ∃ δ > (0 : ℝ), ∃ X V : ℝ → E,\n X b = p ∧ V b = w ∧\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞)\n (fun t => (X t, V t)) (Set.Ioo (b - δ) (b + δ)) ∧\n (∀ t ∈ Set.Ioo (b - δ) (b + δ), X t ∈ U ∧\n HasDerivAt X (V t) t ∧ HasDerivAt V (-(Γ (X t) (V t) (V t))) t) ∧\n ∀ t ∈ Set.Ioo (b - δ) b, X t = x t ∧ V t = v t := by\n let F : E × E → E × E := fun z => (z.2, -(Γ z.1 z.2 z.2))\n have hF : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) F (U ×ˢ Set.univ) :=\n Helpers.contDiffOn_coordinate_spray hΓ\n have hd (t : ℝ) (ht : t ∈ Set.Ioo a b) :\n HasDerivAt (fun s => (x s, v s)) (F (x t, v t)) t :=\n (hphase t ht).1.prodMk (hphase t ht).2\n obtain ⟨δ, hδ, Y, hYb, hYs, hYode, hYeq⟩ :=\n Helpers.exists_ode_continuation_of_tendsto (hU.prod isOpen_univ) hF hab\n ⟨hp, Set.mem_univ w⟩ hd (hx.prodMk_nhds hv)\n refine ⟨δ, hδ, (fun t => (Y t).1), (fun t => (Y t).2),\n congrArg Prod.fst hYb, congrArg Prod.snd hYb, ?_, ?_, ?_⟩\n · simpa only [Prod.eta] using hYs\n · intro t ht\n have h := hYode t ht\n exact ⟨h.1.1, h.2.fst, h.2.snd⟩\n · intro t ht\n exact ⟨congrArg Prod.fst (hYeq t ht), congrArg Prod.snd (hYeq t ht)⟩\ntheorem Helpers.exists_spray_continuation_of_bounded_velocity\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {U : Set E} (hU : IsOpen U) {Γ : E → E →L[ℝ] E →L[ℝ] E}\n (hΓ : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Γ U)\n {x v : ℝ → E} {p : E} {a b : ℝ} (hab : a < b) (hp : p ∈ U)\n (hphase : ∀ t ∈ Set.Ioo a b,\n HasDerivAt x (v t) t ∧ HasDerivAt v (-(Γ (x t) (v t) (v t))) t)\n (hx : Filter.Tendsto x (nhdsWithin b (Set.Ioo a b)) (nhds p))\n (hv : ∃ K : ℝ, ∀ t ∈ Set.Ioo a b, ‖v t‖ ≤ K) :\n ∃ δ > (0 : ℝ), ∃ X V : ℝ → E,\n X b = p ∧\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞)\n (fun t => (X t, V t)) (Set.Ioo (b - δ) (b + δ)) ∧\n (∀ t ∈ Set.Ioo (b - δ) (b + δ), X t ∈ U ∧\n HasDerivAt X (V t) t ∧ HasDerivAt V (-(Γ (X t) (V t) (V t))) t) ∧\n ∀ t ∈ Set.Ioo (b - δ) b, X t = x t ∧ V t = v t := by\n obtain ⟨w, hw⟩ := Helpers.exists_velocity_limit_of_bounded_spray_curve hab\n (hΓ.contDiffAt (hU.mem_nhds hp)).continuousAt hx hv (fun t ht => (hphase t ht).2)\n obtain ⟨δ, hδ, X, V, hXb, hVb, hC, hODE, heq⟩ :=\n Helpers.exists_spray_continuation_of_phase_limit hU hΓ hab hp hphase hx hw\n exact ⟨δ, hδ, X, V, hXb, hC, hODE, heq⟩\ntheorem Helpers.exists_spray_continuation_of_energy_bound\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {U : Set E} (hU : IsOpen U)\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {Γ : E → E →L[ℝ] E →L[ℝ] E}\n (hg : ContinuousOn g U)\n (hΓ : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Γ U)\n {x v : ℝ → E} {p : E} {a b C : ℝ} (hab : a < b) (hp : p ∈ U)\n (hpos : ∀ w : E, w ≠ 0 → 0 < g p w w)\n (hphase : ∀ t ∈ Set.Ioo a b,\n HasDerivAt x (v t) t ∧ HasDerivAt v (-(Γ (x t) (v t) (v t))) t)\n (hx : Filter.Tendsto x (nhdsWithin b (Set.Ioo a b)) (nhds p))\n (henergy : ∀ t ∈ Set.Ioo a b, g (x t) (v t) (v t) ≤ C ^ 2) :\n ∃ δ > (0 : ℝ), ∃ X V : ℝ → E,\n X b = p ∧\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞)\n (fun t => (X t, V t)) (Set.Ioo (b - δ) (b + δ)) ∧\n (∀ t ∈ Set.Ioo (b - δ) (b + δ), X t ∈ U ∧\n HasDerivAt X (V t) t ∧ HasDerivAt V (-(Γ (X t) (V t) (V t))) t) ∧\n ∀ t ∈ Set.Ioo (b - δ) b, X t = x t ∧ V t = v t := by\n obtain ⟨w, hw⟩ := Helpers.velocity_limit_of_positive_metric_spray hab\n (hg.continuousAt (hU.mem_nhds hp)) (hΓ.contDiffAt (hU.mem_nhds hp)).continuousAt\n hpos hx (fun t ht => (hphase t ht).2) henergy\n obtain ⟨δ, hδ, X, V, hXb, hVb, hC, hODE, heq⟩ :=\n Helpers.exists_spray_continuation_of_phase_limit hU hΓ hab hp hphase hx hw\n exact ⟨δ, hδ, X, V, hXb, hC, hODE, heq⟩\ntheorem Helpers.exists_energy_preserving_spray_continuation\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {U : Set E} (hU : IsOpen U)\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {Γ : E → E →L[ℝ] E →L[ℝ] E}\n (hg : ContDiffOn ℝ 1 g U)\n (hΓ : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Γ U)\n (hsym : ∀ z u w, g z u w = g z w u)\n (hKoszul : ∀ z ∈ U, ∀ u v w,\n 2 * g z (Γ z u v) w = (fderiv ℝ g z u) v w +\n (fderiv ℝ g z v) u w - (fderiv ℝ g z w) u v)\n {x v : ℝ → E} {p : E} {a b C : ℝ} (hab : a < b) (hp : p ∈ U)\n (hpos : ∀ w : E, w ≠ 0 → 0 < g p w w)\n (hphase : ∀ t ∈ Set.Ioo a b,\n HasDerivAt x (v t) t ∧ HasDerivAt v (-(Γ (x t) (v t) (v t))) t)\n (hx : Filter.Tendsto x (nhdsWithin b (Set.Ioo a b)) (nhds p))\n (henergy : ∀ t ∈ Set.Ioo a b, g (x t) (v t) (v t) = C ^ 2) :\n ∃ δ > (0 : ℝ), ∃ X V : ℝ → E,\n X b = p ∧\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞)\n (fun t => (X t, V t)) (Set.Ioo (b - δ) (b + δ)) ∧\n (∀ t ∈ Set.Ioo (b - δ) (b + δ), X t ∈ U ∧\n HasDerivAt X (V t) t ∧ HasDerivAt V (-(Γ (X t) (V t) (V t))) t) ∧\n (∀ t ∈ Set.Ioo (b - δ) (b + δ), g (X t) (V t) (V t) = C ^ 2) ∧\n ∀ t ∈ Set.Ioo (b - δ) b, X t = x t ∧ V t = v t := by\n obtain ⟨δ, hδ, X, V, hXb, hC, hODE, heq⟩ :=\n Helpers.exists_spray_continuation_of_energy_bound hU hg.continuousOn hΓ hab hp\n hpos hphase hx (fun t ht => (henergy t ht).le)\n let θ : ℝ := min δ (b - a) / 2\n have hθ : 0 < θ := half_pos (lt_min hδ (sub_pos.mpr hab))\n have hθδ : θ < δ := by dsimp [θ]; linarith [min_le_left δ (b - a)]\n have hθab : θ < b - a := by dsimp [θ]; linarith [min_le_right δ (b - a)]\n have hleft : b - θ ∈ Set.Ioo (b - δ) b := ⟨by linarith, by linarith⟩\n have href : b - θ ∈ Set.Ioo (b - δ) (b + δ) :=\n ⟨hleft.1, by linarith⟩\n have hEref : g (X (b - θ)) (V (b - θ)) (V (b - θ)) = C ^ 2 := by\n rw [(heq _ hleft).1, (heq _ hleft).2]\n exact henergy _ ⟨by linarith, hleft.2⟩\n refine ⟨δ, hδ, X, V, hXb, hC, hODE, ?_, heq⟩\n intro t ht\n have hconst := Helpers.coordinate_geodesic_energy_eq\n (Γ := fun z u v => Γ z u v) (g := g) (x := X) (v := V) isOpen_Ioo\n (convex_Ioo (b - δ) (b + δ)).isPreconnected\n (fun s hs => (hg.contDiffAt (hU.mem_nhds (hODE s hs).1)).differentiableAt (by simp))\n hsym (fun s hs => hKoszul _ (hODE s hs).1)\n (fun s hs => (hODE s hs).2.1) (fun s hs => (hODE s hs).2.2) ht href\n exact hconst.trans hEref\ntheorem Helpers.exists_uniform_radius_control_of_joint_spray_inverse\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {U : Set E} (hU : IsOpen U)\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} (hg : ContDiffOn ℝ 1 g U)\n (hsym : ∀ x u v, g x u v = g x v u)\n (hpos : ∀ x ∈ U, ∀ v, v ≠ 0 → 0 < g x v v)\n {Γ : E → E →L[ℝ] E →L[ℝ] E}\n (hKoszul : ∀ x ∈ U, ∀ u v w,\n 2 * g x (Γ x u v) w = (fderiv ℝ g x u) v w +\n (fderiv ℝ g x v) u w - (fderiv ℝ g x w) u v)\n {p : E} {r ε R τ : ℝ} {K : NNReal} (hr : 0 < r) (hε : 0 < ε)\n (hτ : τ ∈ Set.Ioo (-ε) ε)\n (hLip : LipschitzOnWith K (fun z : E × E => (z.2, -Γ z.1 z.2 z.2))\n (Metric.ball (p, 0) R))\n (hdom : ∀ z ∈ Metric.ball (p, (0 : E)) R, z.1 ∈ U)\n {Φ : ℝ × (E × E) → E × E}\n (hΦ : ContDiffOn ℝ 2 Φ (Set.Ioo (-ε) ε ×ˢ Metric.ball (p, 0) r))\n (hΦ0 : ∀ z ∈ Metric.ball (p, 0) r, Φ (0, z) = z)\n (hΦF : ∀ z ∈ Set.Ioo (-ε) ε ×ˢ Metric.ball (p, 0) r,\n Φ z ∈ Metric.ball (p, 0) R ∧\n HasDerivAt (fun t : ℝ => Φ (t, z.2))\n ((Φ z).2, -Γ (Φ z).1 (Φ z).2 (Φ z).2) z.1)\n (hΦp : Φ (τ, (p, 0)) = (p, 0))\n (e : OpenPartialHomeomorph (E × E) (E × E))\n (he0 : (p, (0 : E)) ∈ e.source)\n (hef : ∀ z : E × E, e z = (z.1, (Φ (τ, z)).1))\n (hei : ContDiffAt ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) e.symm (p, p)) :\n ∃ ρ > (0 : ℝ), Metric.ball p ρ ⊆ U ∧\n ContDiffOn ℝ 1 (fun z : E × E => (e.symm z).2)\n (Metric.ball p ρ ×ˢ Metric.ball p ρ) ∧\n (∀ q ∈ Metric.ball p ρ, (q, (0 : E)) ∈ e.source ∧ e (q, 0) = (q, q)) ∧\n ∀ q ∈ Metric.ball p ρ,\n (∀ z ∈ Metric.ball p ρ, (q, z) ∈ e.target ∧\n e.symm (q, z) ∈ Metric.ball (p, 0) (r / 2)) ∧\n (∀ d > (0 : ℝ), ContDiffOn ℝ 1\n (fun z => Real.sqrt ((τ ^ 2 • g q) (e.symm (q, z)).2\n (e.symm (q, z)).2 + d)) (Metric.ball p ρ)) ∧\n (∀ d > (0 : ℝ), ∀ z ∈ Metric.ball p ρ, ∀ w : E,\n |fderiv ℝ (fun y => Real.sqrt ((τ ^ 2 • g q) (e.symm (q, y)).2\n (e.symm (q, y)).2 + d)) z w| ≤ Real.sqrt (g z w w)) := by\n have hzero : (0 : ℝ) ∈ Set.Ioo (-ε) ε := ⟨by linarith, hε⟩\n have hep : e (p, 0) = (p, p) := by rw [hef, hΦp]\n have hpt : (p, p) ∈ e.target := hep ▸ e.map_source he0\n have hback : e.symm (p, p) = (p, 0) := by rw [← hep]; exact e.left_inv he0\n obtain ⟨A, hAp, hInvA⟩ := hei.contDiffOn (m := 1) (by simp) (by simp)\n have hN : A ∩ (e.target ∩ e.symm ⁻¹' Metric.ball (p, (0 : E)) (r / 2)) ∈\n nhds (p, p) :=\n Filter.inter_mem hAp ((e.isOpen_inter_preimage_symm Metric.isOpen_ball).mem_nhds\n ⟨hpt, by\n change e.symm (p, p) ∈ Metric.ball (p, 0) (r / 2)\n rw [hback]; exact Metric.mem_ball_self (half_pos hr)⟩)\n obtain ⟨b, hb, hbsub⟩ := Metric.mem_nhds_iff.mp hN\n obtain ⟨a, ha, hasub⟩ := Metric.mem_nhds_iff.mp (e.open_source.mem_nhds he0)\n let ρ := min b (min a (r / 2))\n have hρ : 0 < ρ := lt_min hb (lt_min ha (half_pos hr))\n have hρb : ρ ≤ b := min_le_left _ _\n have hρa : ρ ≤ a := (min_le_right _ _).trans (min_le_left _ _)\n have hρr : ρ ≤ r / 2 := (min_le_right _ _).trans (min_le_right _ _)\n have hpairs {q z : E} (hq : q ∈ Metric.ball p ρ) (hz : z ∈ Metric.ball p ρ) :\n (q, z) ∈ Metric.ball (p, p) b := by\n simpa only [Metric.mem_ball, Prod.dist_eq, max_lt_iff] using\n And.intro ((Metric.mem_ball.mp hq).trans_le hρb)\n ((Metric.mem_ball.mp hz).trans_le hρb)\n have hbase {q : E} (hq : q ∈ Metric.ball p ρ) : dist q p < r / 2 :=\n (Metric.mem_ball.mp hq).trans_le hρr\n have hinitial {q u : E} (hq : q ∈ Metric.ball p ρ) (hu : ‖u‖ < r / 2) :\n (q, u) ∈ Metric.ball (p, 0) r := by\n rw [Metric.mem_ball, Prod.dist_eq, max_lt_iff, dist_zero_right]\n exact ⟨by linarith [hbase hq], by linarith⟩\n have hdiag {q : E} (hq : q ∈ Metric.ball p ρ) :\n (q, (0 : E)) ∈ e.source ∧ e (q, 0) = (q, q) := by\n have hq0 : (q, (0 : E)) ∈ Metric.ball (p, 0) r :=\n hinitial hq (by simpa using half_pos hr)\n have hqR : (q, (0 : E)) ∈ Metric.ball (p, 0) R := by\n simpa only [hΦ0 _ hq0] using (hΦF (0, (q, 0)) ⟨hzero, hq0⟩).1\n have hstationary := Helpers.eq_const_of_lipschitz_ode hLip hqR\n (show ((0 : E), -Γ q 0 0) = (0 : E × E) by simp) hzero\n (X := fun t => Φ (t, (q, 0)))\n (fun t ht => ⟨(hΦF (t, (q, 0)) ⟨ht, hq0⟩).2,\n (hΦF (t, (q, 0)) ⟨ht, hq0⟩).1⟩) (hΦ0 _ hq0)\n refine ⟨hasub ?_, ?_⟩\n · simpa [Metric.mem_ball, Prod.dist_eq, max_lt_iff, ha] using\n (Metric.mem_ball.mp hq).trans_le hρa\n · rw [hef, hstationary τ hτ]\n have hUρ : Metric.ball p ρ ⊆ U := by\n intro q hq\n have hq0 := hinitial hq (u := 0) (by simpa using half_pos hr)\n have hqR : (q, (0 : E)) ∈ Metric.ball (p, 0) R := by\n simpa only [hΦ0 _ hq0] using (hΦF (0, (q, 0)) ⟨hzero, hq0⟩).1\n exact hdom _ hqR\n refine ⟨ρ, hρ, hUρ, contDiff_snd.comp_contDiffOn\n (hInvA.mono (fun z hz => (hbsub (hpairs hz.1 hz.2)).1)),\n (fun q hq => hdiag hq), ?_⟩\n intro q hq\n let f : E → E := fun z => (e.symm (q, z)).2\n let F : E → E := fun u => (Φ (τ, (q, u))).1\n have hf : ContDiffOn ℝ 1 f (Metric.ball p ρ) :=\n contDiff_snd.comp_contDiffOn (hInvA.comp\n (contDiffOn_const.prodMk contDiffOn_id)\n (fun z hz => (hbsub (hpairs hq hz)).1))\n have hFinv {z : E} (hz : z ∈ Metric.ball p ρ) : F (f z) = z := by\n have hh := e.right_inv (hbsub (hpairs hq hz)).2.1\n have hfirst : (e.symm (q, z)).1 = q := by\n simpa only [hef] using congrArg Prod.fst hh\n have hrep : (q, f z) = e.symm (q, z) := Prod.ext hfirst.symm rfl\n change (Φ (τ, (q, f z))).1 = z\n rw [hrep]\n simpa only [hef] using congrArg Prod.snd hh\n have hfnorm {z : E} (hz : z ∈ Metric.ball p ρ) : ‖f z‖ < r / 2 := by\n have hh := (hbsub (hpairs hq hz)).2.2\n simpa only [f, dist_zero_right] using\n (max_lt_iff.mp (Metric.mem_ball.mp hh)).2\n have hshift : Metric.ball (q, (0 : E)) (r / 2) ⊆ Metric.ball (p, 0) r := by\n intro z hz\n have hdist : dist (q, (0 : E)) (p, (0 : E)) < r / 2 := by\n simpa [Prod.dist_eq] using hbase hq\n exact Metric.mem_ball.mpr ((dist_triangle z (q, 0) (p, 0)).trans_lt\n (by linarith [Metric.mem_ball.mp hz]))\n have hΦq : ContDiffOn ℝ 2 Φ\n (Set.Ioo (-ε) ε ×ˢ Metric.ball (q, 0) (r / 2)) :=\n hΦ.mono (Set.prod_mono_right hshift)\n have hODEq : ∀ z ∈ Set.Ioo (-ε) ε ×ˢ Metric.ball (q, 0) (r / 2),\n (Φ z).1 ∈ U ∧ HasDerivAt (fun t : ℝ => Φ (t, z.2))\n ((Φ z).2, -Γ (Φ z).1 (Φ z).2 (Φ z).2) z.1 :=\n fun z hz => ⟨hdom _ (hΦF z ⟨hz.1, hshift hz.2⟩).1,\n (hΦF z ⟨hz.1, hshift hz.2⟩).2⟩\n have hF : ContDiffOn ℝ 2 F (Metric.ball 0 (r / 2)) :=\n contDiff_fst.comp_contDiffOn (hΦ.comp\n (contDiffOn_const.prodMk (contDiffOn_const.prodMk contDiffOn_id))\n (fun u hu => ⟨hτ, hinitial hq (by simpa using hu)⟩))\n let B : E →L[ℝ] E →L[ℝ] ℝ := τ ^ 2 • g q\n have hBsym : ∀ u v, B u v = B v u := by\n intro u v\n change τ ^ 2 * g q u v = τ ^ 2 * g q v u\n rw [hsym]\n have hn : ∀ z ∈ U, ∀ u, 0 ≤ g z u u := by\n intro z hz u\n by_cases hu : u = 0\n · simp [hu]\n · exact (hpos z hz u hu).le\n refine ⟨(fun z hz => ⟨(hbsub (hpairs hq hz)).2.1,\n (hbsub (hpairs hq hz)).2.2⟩), ?_, ?_⟩\n · intro d hd\n exact ((((contDiffOn_const (c := B)).clm_apply hf).clm_apply hf).add\n contDiffOn_const).sqrt (fun z hz => ne_of_gt (by\n have hbnonneg : 0 ≤ B (f z) (f z) :=\n mul_nonneg (sq_nonneg τ) (hn q (hUρ hq) _)\n linarith))\n · intro d hd z hz w\n have hdf := (hf.contDiffAt (Metric.isOpen_ball.mem_nhds hz)).differentiableAt_one\n have hdz : f z ∈ Metric.ball 0 (r / 2) := by simpa using hfnorm hz\n have hdF := (hF.contDiffAt (Metric.isOpen_ball.mem_nhds hdz)).differentiableAt\n (by norm_num)\n have hcomp := hdF.hasFDerivAt.comp z hdf.hasFDerivAt\n have hEq : (fun y => F (f y)) =ᶠ[nhds z] id := by\n filter_upwards [Metric.isOpen_ball.mem_nhds hz] with y hy using hFinv hy\n have hid := hcomp.congr_of_eventuallyEq hEq.symm\n have hcancel : ∀ u, fderiv ℝ F (f z) (fderiv ℝ f z u) = u := by\n intro u\n exact congrArg (fun L : E →L[ℝ] E => L u) (hid.unique (hasFDerivAt_id z))\n apply Helpers.regularized_radius_fderiv_bound_of_gauss (g z) B (hsym z)\n (hn z (hUρ hz)) hBsym hdf (fderiv ℝ F (f z)) ?_ hcancel hd w\n have hv : (q, f z) ∈ Metric.ball (q, 0) (r / 2) := by\n simpa [Metric.mem_ball, Prod.dist_eq] using hfnorm hz\n have hscale : ∀ κ ∈ Set.Icc (0 : ℝ) 1,\n (Φ (τ, (q, κ • f z))).1 = (Φ (κ * τ, (q, f z))).1 := by\n intro κ hκ\n apply congrArg Prod.fst\n (Helpers.coordinate_spray_flow_rescale_in_common_ball Γ (fun t u => Φ (t, u)) p q\n hε hLip (fun u hu => hΦ0 _ (hinitial hq hu))\n (fun u hu t ht => ⟨(hΦF (t, (q, u)) ⟨abs_lt.mp ht, hinitial hq hu⟩).2,\n (hΦF (t, (q, u)) ⟨abs_lt.mp ht, hinitial hq hu⟩).1⟩)\n κ τ (f z) (by simpa [abs_of_nonneg hκ.1] using hκ.2)\n (abs_lt.mpr hτ) (hfnorm hz))\n have hgauss := Helpers.coordinate_spray_endpoint_gauss hU hg hsym hKoszul hε hΦq\n (fun u hu => hΦ0 u (hshift hu)) hODEq hv hτ hscale\n simpa only [F, f, B, hFinv hz, smul_apply, smul_eq_mul] using hgauss\ntheorem Helpers.exists_pairwise_radius_lower_bound_of_local_path_control : open scoped Bundle in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I 1 M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [ConnectedSpace M]\n (p : M) (A : Set M) (hA : IsOpen A) (hpA : p ∈ A)\n (ρ : M × M → ℝ) (hρ : ContinuousAt ρ (p, p))\n (hρzero : ∀ q ∈ A, ρ (q, q) = 0)\n (hρnonneg : ∀ q z, 0 ≤ ρ (q, z))\n (hbound : ∀ q ∈ A, ∀ (γ : ℝ → M) (a b : ℝ), a ≤ b →\n ContMDiffOn (modelWithCornersSelf ℝ ℝ) I 1 γ (Set.Icc a b) →\n Set.MapsTo γ (Set.Icc a b) A →\n enorm (ρ (q, γ b) - ρ (q, γ a)) ≤ Manifold.pathELength I γ a b),\n ∃ V : Set M, IsOpen V ∧ p ∈ V ∧ V ⊆ A ∧\n ∀ q ∈ V, ∀ z ∈ V, ENNReal.ofReal (ρ (q, z)) ≤ edist q z := by\n intro E _ _ H _ I M _ _ _ _ _ _ p A hA hpA ρ hρ hρzero hρnonneg hbound\n letI : MetricSpace M := EMetricSpace.toMetricSpace Helpers.edist_ne_top_of_preconnected\n letI : (x : M) → NormedAddCommGroup (TangentSpace I x) := fun x =>\n Bundle.instNormedAddCommGroupOfRiemannianBundleOfIsTopologicalAddGroupOfContinuousConstSMulReal\n (E := fun x : M => TangentSpace I x) x\n obtain ⟨R, hR, hRA⟩ := Metric.mem_nhds_iff.mp (hA.mem_nhds hpA)\n have hsmall : {z : M × M | ρ z < R / 2} ∈ nhds (p, p) :=\n hρ.preimage_mem_nhds (Iio_mem_nhds (by rw [hρzero p hpA]; exact half_pos hR))\n obtain ⟨η, hη, hηρ⟩ := Metric.mem_nhds_iff.mp hsmall\n let δ := min η (R / 4)\n have hδ : 0 < δ := lt_min hη (by positivity)\n have hnear {q : M} (hq : q ∈ Metric.ball p δ) : dist q p < R / 4 :=\n (Metric.mem_ball.mp hq).trans_le (min_le_right _ _)\n have hVA : Metric.ball p δ ⊆ A := fun q hq => hRA\n (Metric.mem_ball.mpr (by linarith [hnear hq]))\n refine ⟨Metric.ball p δ, Metric.isOpen_ball, Metric.mem_ball_self hδ, hVA, ?_⟩\n intro q hq z hz\n have hρsmall : ρ (q, z) < R / 2 := by\n apply hηρ\n simpa only [Metric.mem_ball, Prod.dist_eq, max_lt_iff] using\n And.intro ((Metric.mem_ball.mp hq).trans_le (min_le_left _ _))\n ((Metric.mem_ball.mp hz).trans_le (min_le_left _ _))\n rw [IsRiemannianManifold.out (I := I)]\n by_contra h\n obtain ⟨γ, hγ0, hγ1, hγ, hlen⟩ :=\n Manifold.exists_lt_of_riemannianEDist_lt (lt_of_not_ge h)\n by_cases hstay : Set.MapsTo γ (Set.Icc (0 : ℝ) 1) (Metric.ball p R)\n · have hb := hbound q (hVA hq) γ 0 1 zero_le_one hγ\n (fun t ht => hRA (hstay ht))\n have hb' : ENNReal.ofReal (ρ (q, z)) ≤ Manifold.pathELength I γ 0 1 := by\n simpa only [hγ0, hγ1, hρzero q (hVA hq), sub_zero,\n Real.enorm_eq_ofReal (hρnonneg q z)] using hb\n exact (not_lt_of_ge hb') hlen\n · obtain ⟨t, ht, htU⟩ : ∃ t ∈ Set.Icc (0 : ℝ) 1, γ t ∉ Metric.ball p R := by\n simpa only [Set.MapsTo, not_forall, exists_prop] using hstay\n have hRle : R ≤ dist (γ t) p := not_lt.mp (by simpa [Metric.mem_ball] using htU)\n have hpre : edist q (γ t) ≤ Manifold.pathELength I γ 0 1 := by\n rw [IsRiemannianManifold.out (I := I)]\n exact (Manifold.riemannianEDist_le_pathELength\n (hγ.mono (Set.Icc_subset_Icc le_rfl ht.2)) hγ0 rfl ht.1).trans\n (Manifold.pathELength_mono le_rfl ht.2)\n have hfinite := (hlen.trans ENNReal.ofReal_lt_top).ne\n have hpre' := ENNReal.toReal_mono hfinite hpre\n have hlen' := (ENNReal.toReal_lt_toReal hfinite ENNReal.ofReal_ne_top).mpr hlen\n simp only [edist_dist, ENNReal.toReal_ofReal dist_nonneg] at hpre'\n rw [ENNReal.toReal_ofReal (hρnonneg q z)] at hlen'\n have htri := dist_triangle (γ t) q p\n rw [dist_comm (γ t) q] at htri\n linarith [hnear hq]\ntheorem Helpers.exists_scaled_phase_endpoints_in_joint_spray_inverse\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {Γ : E → E →L[ℝ] E →L[ℝ] E} {p : E}\n {R r ε τ : ℝ} {K : NNReal} (hR : 0 < R) (hr : 0 < r)\n (hε : 0 < ε) (hτ : 0 < τ) (hτε : τ < ε)\n (hLip : LipschitzOnWith K (fun z : E × E => (z.2, -Γ z.1 z.2 z.2))\n (Metric.ball (p, 0) R))\n {Φ : ℝ × (E × E) → E × E}\n (hΦ0 : ∀ z ∈ Metric.ball (p, 0) r, Φ (0, z) = z)\n (hΦF : ∀ z ∈ Set.Ioo (-ε) ε ×ˢ Metric.ball (p, 0) r,\n Φ z ∈ Metric.ball (p, 0) R ∧\n HasDerivAt (fun t : ℝ => Φ (t, z.2))\n ((Φ z).2, -Γ (Φ z).1 (Φ z).2 (Φ z).2) z.1)\n (e : OpenPartialHomeomorph (E × E) (E × E))\n (he0 : (p, (0 : E)) ∈ e.source)\n (hef : ∀ z : E × E, e z = (z.1, (Φ (τ, z)).1))\n {x v : ℝ → E} {a : ℝ} (ha : 0 < a) (hx0 : x 0 = p)\n (hx : ContinuousAt x 0) (hv : ContinuousAt v 0)\n (hODE : ∀ t ∈ Set.Ioo (-a) a,\n HasDerivAt x (v t) t ∧ HasDerivAt v (-Γ (x t) (v t) (v t)) t) :\n ∃ δ > (0 : ℝ), δ ≤ a ∧\n ∀ s ∈ Set.Ioo (-δ) δ, ∀ t ∈ Set.Ioo (-δ) δ, s ≤ t →\n (x s, ((t - s) / τ) • v s) ∈ e.source ∧\n e (x s, ((t - s) / τ) • v s) = (x s, x t) := by\n let Z : ℝ × ℝ → E × E := fun z => (x z.1, z.2 • v z.1)\n have hZ : ContinuousAt Z (0, 0) := by\n have hx' : ContinuousAt (fun z : ℝ × ℝ => x z.1) (0, 0) :=\n hx.comp (f := fun z : ℝ × ℝ => z.1) (x := (0, 0)) continuousAt_fst\n have hv' : ContinuousAt (fun z : ℝ × ℝ => v z.1) (0, 0) :=\n hv.comp (f := fun z : ℝ × ℝ => z.1) (x := (0, 0)) continuousAt_fst\n exact hx'.prodMk (continuousAt_snd.smul hv')\n have hZ0 : Z (0, 0) = (p, 0) := by simp [Z, hx0]\n let S := e.source ∩ (Metric.ball (p, (0 : E)) r ∩ Metric.ball (p, 0) R)\n have hS : S ∈ nhds (p, 0) := Filter.inter_mem (e.open_source.mem_nhds he0)\n (Filter.inter_mem (Metric.ball_mem_nhds _ hr) (Metric.ball_mem_nhds _ hR))\n obtain ⟨η, hη, hηsub⟩ := Metric.mem_nhds_iff.mp\n (hZ.preimage_mem_nhds (hZ0.symm ▸ hS))\n let δ := min (a / 2) (min (η / 2) (τ * η / 4))\n have hδ : 0 < δ := lt_min (half_pos ha) (lt_min (half_pos hη) (by positivity))\n have hδa : δ ≤ a := (min_le_left _ _).trans (by linarith)\n have hδη : δ ≤ η / 2 := (min_le_right _ _).trans (min_le_left _ _)\n have hδτη : δ ≤ τ * η / 4 := (min_le_right _ _).trans (min_le_right _ _)\n refine ⟨δ, hδ, hδa, ?_⟩\n intro s hs t ht hst\n let κ := (t - s) / τ\n have hκnonneg : 0 ≤ κ := div_nonneg (sub_nonneg.mpr hst) hτ.le\n have hκτ : κ * τ = t - s := div_mul_cancel₀ _ hτ.ne'\n have hκsmall : |κ| < η := by\n rw [abs_of_nonneg hκnonneg]\n apply (div_lt_iff₀ hτ).mpr\n have := hs.1\n have := ht.2\n nlinarith\n have hscaled {u : ℝ} (hu : u ∈ Set.Ioo (-δ) δ) : (x u, κ • v u) ∈ S := by\n change Z (u, κ) ∈ S\n apply hηsub\n rw [Metric.mem_ball, Prod.dist_eq, max_lt_iff]\n exact ⟨by simpa only [Real.dist_eq, sub_zero] using\n (abs_lt.mpr hu).trans_le (hδη.trans (by linarith)), by\n simpa only [Real.dist_eq, sub_zero] using hκsmall⟩\n have hinterval {u : ℝ} (hu : u ∈ Set.Icc (0 : ℝ) τ) :\n s + κ * u ∈ Set.Ioo (-δ) δ := by\n have hlo : 0 ≤ κ * u := mul_nonneg hκnonneg hu.1\n have hhi : κ * u ≤ κ * τ := mul_le_mul_of_nonneg_left hu.2 hκnonneg\n constructor <;> linarith [hs.1, ht.2]\n have htime {u : ℝ} (hu : u ∈ Set.Icc (0 : ℝ) τ) : u ∈ Set.Ioo (-ε) ε :=\n ⟨by linarith [hu.1], hu.2.trans_lt hτε⟩\n have hD (u : ℝ) (hu : u ∈ Set.Icc (0 : ℝ) τ) :\n HasDerivAt (fun z => (x (s + κ * z), κ • v (s + κ * z)))\n (κ • v (s + κ * u), -Γ (x (s + κ * u))\n (κ • v (s + κ * u)) (κ • v (s + κ * u))) u := by\n have harg : s + κ * u ∈ Set.Ioo (-a) a :=\n ⟨(neg_le_neg hδa).trans_lt (hinterval hu).1, (hinterval hu).2.trans_le hδa⟩\n have hdu : HasDerivAt (fun z : ℝ => s + κ * z) κ u := by\n simpa using ((hasDerivAt_id u).const_mul κ).const_add s\n have hdx := (hODE _ harg).1.scomp u hdu\n have hdv := ((hODE _ harg).2.scomp u hdu).const_smul κ\n simpa only [Function.comp_def, Pi.smul_apply, map_smul, smul_apply, smul_neg] using hdx.prodMk hdv\n have hstart := hscaled hs\n have hFlowC : ContinuousOn (fun u => Φ (u, (x s, κ • v s))) (Set.Icc 0 τ) :=\n fun u hu => (hΦF (u, (x s, κ • v s)) ⟨htime hu, hstart.2.1⟩).2.continuousAt.continuousWithinAt\n have hOldC : ContinuousOn (fun u => (x (s + κ * u), κ • v (s + κ * u)))\n (Set.Icc 0 τ) := fun u hu => (hD u hu).continuousAt.continuousWithinAt\n have huniq := ODE_solution_unique_of_mem_Icc_right\n (v := fun _ (z : E × E) => (z.2, -Γ z.1 z.2 z.2))\n (s := fun _ => Metric.ball (p, 0) R)\n (fun _ _ => hLip) hFlowC\n (fun u hu => (hΦF (u, (x s, κ • v s)) ⟨htime ⟨hu.1, hu.2.le⟩,\n hstart.2.1⟩).2.hasDerivWithinAt)\n (fun u hu => (hΦF (u, (x s, κ • v s)) ⟨htime ⟨hu.1, hu.2.le⟩,\n hstart.2.1⟩).1) hOldC\n (fun u hu => (hD u ⟨hu.1, hu.2.le⟩).hasDerivWithinAt)\n (fun u hu => (hscaled (hinterval ⟨hu.1, hu.2.le⟩)).2.2)\n (by simpa only [mul_zero, add_zero] using hΦ0 _ hstart.2.1)\n have hend := huniq (show τ ∈ Set.Icc (0 : ℝ) τ from ⟨hτ.le, le_rfl⟩)\n change Φ (τ, (x s, κ • v s)) =\n (x (s + κ * τ), κ • v (s + κ * τ)) at hend\n refine ⟨hstart.1, ?_⟩\n change e (x s, κ • v s) = (x s, x t)\n rw [hef, hend]\n have heq : s + κ * τ = t := by linarith\n simp only [heq]\ntheorem Helpers.exists_chart_pairwise_radius_lower_bound\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I 1 M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [ConnectedSpace M]\n (p : M) (g : E → E →L[ℝ] E →L[ℝ] ℝ)\n (hg : ContinuousOn g (extChartAt I p).target)\n (hnorm : ∀ z ∈ (extChartAt I p).target, ∀ w : E,\n g z w w = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z w‖ ^ 2)\n (e : OpenPartialHomeomorph (E × E) (E × E)) (τ ρ : ℝ) (hρ : 0 < ρ)\n (hInv : ContDiffOn ℝ 1 (fun z : E × E => (e.symm z).2)\n (Metric.ball (extChartAt I p p) ρ ×ˢ Metric.ball (extChartAt I p p) ρ))\n (hdiag : ∀ q ∈ Metric.ball (extChartAt I p p) ρ,\n (q, (0 : E)) ∈ e.source ∧ e (q, 0) = (q, q))\n (hsmooth : ∀ q ∈ Metric.ball (extChartAt I p p) ρ, ∀ d > (0 : ℝ),\n ContDiffOn ℝ 1 (fun z => Real.sqrt ((τ ^ 2 • g q) (e.symm (q, z)).2\n (e.symm (q, z)).2 + d)) (Metric.ball (extChartAt I p p) ρ))\n (hbound : ∀ q ∈ Metric.ball (extChartAt I p p) ρ, ∀ d > (0 : ℝ),\n ∀ z ∈ Metric.ball (extChartAt I p p) ρ, ∀ w : E,\n |fderiv ℝ (fun y => Real.sqrt ((τ ^ 2 • g q) (e.symm (q, y)).2\n (e.symm (q, y)).2 + d)) z w| ≤ Real.sqrt (g z w w)) :\n ∃ V : Set M, IsOpen V ∧ p ∈ V ∧\n V ⊆ (extChartAt I p).source ∩ (extChartAt I p) ⁻¹' Metric.ball (extChartAt I p p) ρ ∧\n ∀ q ∈ V, ∀ z ∈ V,\n ENNReal.ofReal (Real.sqrt ((τ ^ 2 • g (extChartAt I p q))\n (e.symm (extChartAt I p q, extChartAt I p z)).2\n (e.symm (extChartAt I p q, extChartAt I p z)).2)) ≤ edist q z := by\n let A := (extChartAt I p).source ∩\n (extChartAt I p) ⁻¹' Metric.ball (extChartAt I p p) ρ\n have hA : IsOpen A := isOpen_extChartAt_preimage' p Metric.isOpen_ball\n have hpA : p ∈ A := ⟨mem_extChartAt_source p, Metric.mem_ball_self hρ⟩\n let F : E × E → ℝ := fun z =>\n (τ ^ 2 • g z.1) (e.symm z).2 (e.symm z).2\n let Q : M × M → ℝ := fun z => Real.sqrt (F (extChartAt I p z.1, extChartAt I p z.2))\n have hG : ContinuousAt (fun z : E × E => g z.1) (extChartAt I p p, extChartAt I p p) :=\n (hg.continuousAt ((isOpen_extChartAt_target p).mem_nhds\n (mem_extChartAt_target p))).comp (f := fun z : E × E => z.1)\n (x := (extChartAt I p p, extChartAt I p p)) continuousAt_fst\n have hV : ContinuousAt (fun z : E × E => (e.symm z).2)\n (extChartAt I p p, extChartAt I p p) :=\n (hInv.contDiffAt ((Metric.isOpen_ball.prod Metric.isOpen_ball).mem_nhds\n ⟨Metric.mem_ball_self hρ, Metric.mem_ball_self hρ⟩)).continuousAt\n have hB : ContinuousAt (fun z : E × E => τ ^ 2 • g z.1)\n (extChartAt I p p, extChartAt I p p) := hG.const_smul (τ ^ 2)\n have hF : ContinuousAt F (extChartAt I p p, extChartAt I p p) :=\n (hB.clm_apply hV).clm_apply hV\n have hC : ContinuousAt (fun z : M × M =>\n (extChartAt I p z.1, extChartAt I p z.2)) (p, p) :=\n ((continuousAt_extChartAt p).comp (f := fun z : M × M => z.1)\n (x := (p, p)) continuousAt_fst).prodMk\n ((continuousAt_extChartAt p).comp (f := fun z : M × M => z.2)\n (x := (p, p)) continuousAt_snd)\n have hQ : ContinuousAt Q (p, p) := hF.sqrt.comp\n (f := fun z : M × M => (extChartAt I p z.1, extChartAt I p z.2))\n (x := (p, p)) hC\n apply Helpers.exists_pairwise_radius_lower_bound_of_local_path_control I M p A hA hpA\n Q hQ ?_ (fun q z => Real.sqrt_nonneg _) ?_\n · intro q hq\n have hd := hdiag (extChartAt I p q) hq.2\n have hi : e.symm (extChartAt I p q, extChartAt I p q) = (extChartAt I p q, 0) := by\n rw [← hd.2]\n exact e.left_inv hd.1\n change Real.sqrt ((τ ^ 2 • g (extChartAt I p q))\n (e.symm (extChartAt I p q, extChartAt I p q)).2\n (e.symm (extChartAt I p q, extChartAt I p q)).2) = 0\n rw [hi]\n simp\n · intro q hq γ a b hab hγ hγA\n let P : E → ℝ := fun z => (τ ^ 2 • g (extChartAt I p q))\n (e.symm (extChartAt I p q, z)).2 (e.symm (extChartAt I p q, z)).2\n letI : (y : M) → NormedAddCommGroup (TangentSpace I y) := fun y =>\n Bundle.instNormedAddCommGroupOfRiemannianBundleOfIsTopologicalAddGroupOfContinuousConstSMulReal\n (E := fun x : M => TangentSpace I x) y\n have hlim (z : M) : Filter.Tendsto\n (fun d : ℝ => Real.sqrt (P (extChartAt I p z) + d))\n (nhdsWithin 0 (Set.Ioi 0)) (nhds (Real.sqrt (P (extChartAt I p z)))) := by\n have hc : Continuous (fun d : ℝ => Real.sqrt (P (extChartAt I p z) + d)) := by fun_prop\n simpa only [add_zero] using\n (hc.continuousAt (x := 0)).tendsto.mono_left nhdsWithin_le_nhds\n change enorm (Real.sqrt (P (extChartAt I p (γ b))) -\n Real.sqrt (P (extChartAt I p (γ a)))) ≤ _\n apply le_of_tendsto (continuous_enorm.continuousAt.tendsto.comp\n ((hlim (γ b)).sub (hlim (γ a))))\n filter_upwards [self_mem_nhdsWithin] with d hd\n apply Helpers.enorm_sub_le_pathELength_of_coordinate_bound I A hA\n (Metric.ball (extChartAt I p p) ρ) Metric.isOpen_ball (extChartAt I p)\n (contMDiffOn_extChartAt.mono (fun _ hx => by\n simpa only [extChartAt_source] using hx.1)) (fun _ hx => hx.2)\n (fun z => Real.sqrt (P z + d)) (hsmooth _ hq.2 d hd) ?_ γ a b hab hγ hγA\n intro z hz w\n rw [Real.enorm_eq_ofReal_abs, ← ofReal_norm]\n apply ENNReal.ofReal_le_ofReal\n exact (hbound _ hq.2 d hd _ hz.2 _).trans_eq\n (Helpers.sqrt_coordinate_metric_chart_derivative_eq_norm p g hnorm z hz.1 w)\ntheorem Helpers.coordinate_spray_locally_distance_linear\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M]\n (p : M) (g : E → E →L[ℝ] E →L[ℝ] ℝ) (Γ : E → E →L[ℝ] E →L[ℝ] E)\n (hg : ContDiffOn ℝ ∞ g (extChartAt I p).target)\n (hΓ : ContDiffOn ℝ ∞ Γ (extChartAt I p).target)\n (hsym : ∀ z u v, g z u v = g z v u)\n (hpos : ∀ z ∈ (extChartAt I p).target, ∀ v : E, v ≠ 0 → 0 < g z v v)\n (hnorm : ∀ z ∈ (extChartAt I p).target, ∀ v : E,\n g z v v = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z v‖ ^ 2)\n (hKoszul : ∀ z ∈ (extChartAt I p).target, ∀ u v w : E,\n 2 * g z (Γ z u v) w = (fderiv ℝ g z u) v w +\n (fderiv ℝ g z v) u w - (fderiv ℝ g z w) u v)\n {x v : ℝ → E} {ε : ℝ} {c : NNReal}\n (hε : 0 < ε) (hx0 : x 0 = extChartAt I p p)\n (hphase : ContDiffOn ℝ ∞ (fun t : ℝ => (x t, v t)) (Set.Ioo (-ε) ε))\n (hODE : ∀ t ∈ Set.Ioo (-ε) ε, x t ∈ (extChartAt I p).target ∧\n HasDerivAt x (v t) t ∧ HasDerivAt v (-(Γ (x t) (v t) (v t))) t)\n (hEnergy : ∀ t ∈ Set.Ioo (-ε) ε, g (x t) (v t) (v t) = (c : ℝ) ^ 2) :\n ∃ δ > (0 : ℝ), δ ≤ ε ∧\n ∀ s ∈ Set.Ioo (-δ) δ, ∀ t ∈ Set.Ioo (-δ) δ,\n edist ((extChartAt I p).symm (x s)) ((extChartAt I p).symm (x t)) =\n (c : ENNReal) * ENNReal.ofReal |t - s| := by\n let P := extChartAt I p p\n have hU := isOpen_extChartAt_target (I := I) p\n have hpU := mem_extChartAt_target (I := I) p\n obtain ⟨R, hR, K, hLip, hdom, r, hr, a, ha, Φ, hΦ, hΦ0, hΦF, hΦp⟩ :=\n Helpers.exists_coordinate_spray_flow_in_lipschitz_ball hU hΓ hpU\n let τ := a / 2\n have hτ : 0 < τ := half_pos ha\n have hτa : τ < a := by dsimp [τ]; linarith\n have hτtime : τ ∈ Set.Ioo (-a) a := ⟨by linarith, hτa⟩\n have hΦat : ContDiffAt ℝ ∞ Φ (τ, (P, 0)) :=\n hΦ.contDiffAt ((isOpen_Ioo.prod Metric.isOpen_ball).mem_nhds\n ⟨hτtime, Metric.mem_ball_self hr⟩)\n have hlin := Helpers.coordinate_spray_flow_linearization hU hpU\n ((hΓ.contDiffAt (hU.mem_nhds hpU)).differentiableAt (by simp)) hr ha\n (hΦ.of_le (by simp)) hΦ0 hΦp (fun z hz => (hΦF z hz).2)\n obtain ⟨e, he0, hept, hef, he, hei⟩ :=\n Helpers.exists_joint_inverse_of_spray_flow_linearization hτ.ne' hΦat (hΦp τ hτtime)\n (hlin τ hτtime)\n obtain ⟨ρ, hρ, hρU, hInv, hdiag, hcontrol⟩ :=\n Helpers.exists_uniform_radius_control_of_joint_spray_inverse hU\n (hg.of_le (by simp)) hsym hpos hKoszul hr ha hτtime hLip hdom\n (hΦ.of_le (by simp)) hΦ0 hΦF (hΦp τ hτtime) e he0 hef hei\n obtain ⟨V, hV, hpV, hVA, hLower⟩ :=\n Helpers.exists_chart_pairwise_radius_lower_bound I M p g hg.continuousOn hnorm e τ ρ hρ\n hInv hdiag (fun q hq => (hcontrol q hq).2.1)\n (fun q hq => (hcontrol q hq).2.2)\n have hzero : (0 : ℝ) ∈ Set.Ioo (-ε) ε := ⟨by linarith, hε⟩\n have hphase0 := (hphase.contDiffAt (isOpen_Ioo.mem_nhds hzero)).continuousAt\n obtain ⟨δ₀, hδ₀, hδ₀ε, hPair⟩ :=\n Helpers.exists_scaled_phase_endpoints_in_joint_spray_inverse hR hr ha hτ hτa hLip\n hΦ0 hΦF e he0 hef hε hx0 hphase0.fst hphase0.snd (fun t ht => (hODE t ht).2)\n let η : ℝ → M := fun t => (extChartAt I p).symm (x t)\n have hη0 : η 0 = p := by\n change (extChartAt I p).symm (x 0) = p\n rw [hx0]\n exact (extChartAt I p).left_inv (mem_extChartAt_source p)\n have hη : ContinuousAt η 0 :=\n ((continuousOn_extChartAt_symm p).continuousAt (hU.mem_nhds hpU)).comp_of_eq\n hphase0.fst hx0\n obtain ⟨b, hb, hbV⟩ := Metric.mem_nhds_iff.mp\n (hη.preimage_mem_nhds (hV.mem_nhds (hη0.symm ▸ hpV)))\n let δ := min δ₀ b\n have hδ : 0 < δ := lt_min hδ₀ hb\n have hsmall : Set.Ioo (-δ) δ ⊆ Set.Ioo (-δ₀) δ₀ := fun t ht =>\n ⟨(neg_le_neg (min_le_left _ _)).trans_lt ht.1, ht.2.trans_le (min_le_left _ _)⟩\n have hold : Set.Ioo (-δ) δ ⊆ Set.Ioo (-ε) ε := fun t ht =>\n ⟨(neg_le_neg hδ₀ε).trans_lt (hsmall ht).1, (hsmall ht).2.trans_le hδ₀ε⟩\n have hηV {t : ℝ} (ht : t ∈ Set.Ioo (-δ) δ) : η t ∈ V := by\n apply hbV\n simpa only [Metric.mem_ball, Real.dist_eq, sub_zero] using\n (abs_lt.mpr ht).trans_le (min_le_right δ₀ b)\n have hordered : ∀ s ∈ Set.Ioo (-δ) δ, ∀ t ∈ Set.Ioo (-δ) δ, s ≤ t →\n edist (η s) (η t) = (c : ENNReal) * ENNReal.ofReal |t - s| := by\n intro s hs t ht hst\n have hsε := hold hs\n have htε := hold ht\n have hpair := hPair s (hsmall hs) t (hsmall ht) hst\n have hi := e.left_inv hpair.1\n rw [hpair.2] at hi\n have hvel : (e.symm (x s, x t)).2 = ((t - s) / τ) • v s := congrArg Prod.snd hi\n have hcoordS : extChartAt I p (η s) = x s :=\n (extChartAt I p).right_inv (hODE s hsε).1\n have hcoordT : extChartAt I p (η t) = x t :=\n (extChartAt I p).right_inv (hODE t htε).1\n have hRadius : Real.sqrt ((τ ^ 2 • g (x s)) (e.symm (x s, x t)).2\n (e.symm (x s, x t)).2) = (c : ℝ) * (t - s) := by\n rw [hvel]\n have hsq : (τ ^ 2 • g (x s)) (((t - s) / τ) • v s)\n (((t - s) / τ) • v s) = ((c : ℝ) * (t - s)) ^ 2 := by\n simp only [smul_apply, map_smul, smul_eq_mul]\n rw [hEnergy s hsε]\n calc\n _ = ((c : ℝ) * (τ * ((t - s) / τ))) ^ 2 := by ring\n _ = ((c : ℝ) * (t - s)) ^ 2 := by\n rw [mul_comm τ ((t - s) / τ), div_mul_cancel₀ _ hτ.ne']\n rw [hsq, Real.sqrt_sq (mul_nonneg c.coe_nonneg (sub_nonneg.mpr hst))]\n have hlower : ENNReal.ofReal ((c : ℝ) * (t - s)) ≤ edist (η s) (η t) := by\n simpa only [hcoordS, hcoordT, hRadius] using\n hLower (η s) (hηV hs) (η t) (hηV ht)\n have hIcc : Set.Icc s t ⊆ Set.Ioo (-ε) ε := fun u hu =>\n ⟨hsε.1.trans_le hu.1, hu.2.trans_lt htε.2⟩\n have hxc : ContDiffOn ℝ 1 x (Set.Icc s t) :=\n ((contDiff_fst.comp_contDiffOn hphase).of_le (by simp)).mono hIcc\n have hupper := Helpers.riemannianEDist_inverse_chart_le_of_constant_energy I p g hnorm\n x v s t (c : ℝ) hst c.coe_nonneg\n (fun u hu => (hODE u (hIcc hu)).1) hxc\n (fun u hu => (hODE u (hIcc hu)).2.1.hasDerivWithinAt)\n (fun u hu => hEnergy u (hIcc hu))\n have htarget : (c : ENNReal) * ENNReal.ofReal |t - s| =\n ENNReal.ofReal ((c : ℝ) * (t - s)) := by\n rw [abs_of_nonneg (sub_nonneg.mpr hst), ENNReal.ofReal_mul c.coe_nonneg,\n ENNReal.ofReal_coe_nnreal]\n rw [htarget]\n apply le_antisymm ?_ hlower\n rw [IsRiemannianManifold.out (I := I)]\n simpa only [mul_comm (t - s) (c : ℝ)] using hupper\n refine ⟨δ, hδ, (min_le_left δ₀ b).trans hδ₀ε, ?_⟩\n intro s hs t ht\n rcases le_total s t with hst | hts\n · exact hordered s hs t ht hst\n · simpa only [edist_comm, abs_sub_comm] using hordered t ht s hs hts\ntheorem Helpers.eq_of_bilinear_norm_add_ge\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (B : E →L[ℝ] E →L[ℝ] ℝ) (hsym : ∀ u v, B u v = B v u)\n (hpos : ∀ v : E, v ≠ 0 → 0 < B v v)\n {u v : E} {c : ℝ} (hu : B u u = c ^ 2) (hv : B v v = c ^ 2)\n (hadd : (2 * c) ^ 2 ≤ B (u + v) (u + v)) : u = v := by\n by_contra hne\n have hp := hpos (u - v) (sub_ne_zero.mpr hne)\n simp only [map_sub, sub_apply, map_add, add_apply] at hp hadd\n rw [hsym v u] at hp hadd\n nlinarith\ntheorem Helpers.riemannianEDist_inverse_chart_le_of_speed_bound\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M] [IsManifold I 1 M]\n [Bundle.RiemannianBundle (fun z : M => TangentSpace I z)]\n (p : M) (g : E → E →L[ℝ] E →L[ℝ] ℝ)\n (hg : ∀ z ∈ (extChartAt I p).target, ∀ w : E,\n g z w w = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z w‖ ^ 2)\n (x v : ℝ → E) (a b k : ℝ) (hab : a ≤ b) (hk : 0 ≤ k)\n (hx : Set.MapsTo x (Set.Icc a b) (extChartAt I p).target)\n (hCx : ContDiffOn ℝ 1 x (Set.Icc a b))\n (hderiv : ∀ t ∈ Set.Icc a b, HasDerivWithinAt x (v t) (Set.Icc a b) t)\n (hspeed : ∀ t ∈ Set.Icc a b, Real.sqrt (g (x t) (v t) (v t)) ≤ k) :\n Manifold.riemannianEDist I ((extChartAt I p).symm (x a))\n ((extChartAt I p).symm (x b)) ≤ ENNReal.ofReal ((b - a) * k) := by\n rcases hab.eq_or_lt with rfl | hab'\n · simp [Manifold.riemannianEDist_self]\n have hpath : ContMDiffOn (modelWithCornersSelf ℝ ℝ) I 1\n ((extChartAt I p).symm ∘ x) (Set.Icc a b) :=\n (contMDiffOn_extChartAt_symm p).comp (contMDiffOn_iff_contDiffOn.mpr hCx) hx\n apply (Manifold.riemannianEDist_le_pathELength hpath rfl rfl hab).trans\n rw [Manifold.pathELength_eq_lintegral_mfderivWithin_Icc]\n calc\n (∫⁻ t in Set.Icc a b, ‖mfderivWithin (modelWithCornersSelf ℝ ℝ) I\n ((extChartAt I p).symm ∘ x) (Set.Icc a b) t 1‖ₑ) ≤\n ∫⁻ _t in Set.Icc a b, ENNReal.ofReal k := by\n apply MeasureTheory.setLIntegral_mono' measurableSet_Icc\n intro t ht\n rw [← ofReal_norm, Helpers.norm_mfderivWithin_inverse_chart_curve I p g hg x\n (Set.Icc a b) t (v t) hx ht (uniqueDiffOn_Icc hab' t ht) (hderiv t ht)]\n exact ENNReal.ofReal_le_ofReal (hspeed t ht)\n _ = ENNReal.ofReal ((b - a) * k) := by\n simp only [MeasureTheory.lintegral_const, MeasureTheory.Measure.restrict_apply_univ,\n Real.volume_Icc, ← ENNReal.ofReal_mul hk, mul_comm k]\ntheorem Helpers.exists_inverse_chart_chord_bound\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M] [IsManifold I 1 M]\n [Bundle.RiemannianBundle (fun z : M => TangentSpace I z)]\n (p : M) (g : E → E →L[ℝ] E →L[ℝ] ℝ)\n (hg : ContinuousOn g (extChartAt I p).target)\n (hnorm : ∀ z ∈ (extChartAt I p).target, ∀ w : E,\n g z w w = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z w‖ ^ 2)\n (w : E) (k : ℝ) (hk : Real.sqrt (g (extChartAt I p p) w w) < k) :\n ∃ r > (0 : ℝ), ∀ y z : E, ∀ h > (0 : ℝ),\n y ∈ Metric.ball (extChartAt I p p) r →\n z ∈ Metric.ball (extChartAt I p p) r →\n h⁻¹ • (z - y) ∈ Metric.ball w r →\n Manifold.riemannianEDist I ((extChartAt I p).symm y)\n ((extChartAt I p).symm z) ≤ ENNReal.ofReal (h * k) := by\n let q := extChartAt I p p\n have hgc : ContinuousAt g q := hg.continuousAt\n ((isOpen_extChartAt_target p).mem_nhds (mem_extChartAt_target p))\n have hgprod : ContinuousAt (fun z : E × E => g z.1) (q,w) :=\n ContinuousAt.comp (f := fun z : E × E => z.1) (x := (q,w)) hgc continuousAt_fst\n have hsc : ContinuousAt (fun z : E × E => Real.sqrt (g z.1 z.2 z.2)) (q,w) :=\n Real.continuous_sqrt.continuousAt.comp\n ((hgprod.clm_apply continuousAt_snd).clm_apply continuousAt_snd)\n have hN : {z : E × E | z.1 ∈ (extChartAt I p).target ∧\n Real.sqrt (g z.1 z.2 z.2) < k} ∈ nhds (q,w) :=\n Filter.inter_mem\n (continuousAt_fst.preimage_mem_nhds\n ((isOpen_extChartAt_target p).mem_nhds (mem_extChartAt_target p)))\n (hsc.preimage_mem_nhds (Iio_mem_nhds hk))\n obtain ⟨r,hr,hrN⟩ := Metric.mem_nhds_iff.mp hN\n refine ⟨r,hr,?_⟩\n intro y z h hh hy hz hd\n let d : E := h⁻¹ • (z - y)\n let l : ℝ → E := fun t => (1-t) • y + t • z\n have hld (t : ℝ) (ht : t ∈ Set.Icc (0 : ℝ) 1) :\n (l t,d) ∈ Metric.ball (q,w) r := by\n rw [Metric.mem_ball,Prod.dist_eq,max_lt_iff]\n refine ⟨?_,Metric.mem_ball.mp hd⟩\n exact Metric.mem_ball.mp ((convex_ball q r) hy hz (by linarith [ht.1,ht.2])\n ht.1 (by ring))\n have hmaps : Set.MapsTo l (Set.Icc 0 1) (extChartAt I p).target :=\n fun t ht => (hrN (hld t ht)).1\n have hdx (t : ℝ) : HasDerivAt l (z-y) t := by\n convert ((((hasDerivAt_const t (1 : ℝ)).sub (hasDerivAt_id t)).smul_const y).add\n ((hasDerivAt_id t).smul_const z)) using 1\n · ext s\n rfl\n · simp only [zero_sub, neg_one_smul, one_smul]\n abel\n have heq : z-y = h • d := by dsimp [d]; rw [smul_inv_smul₀ hh.ne']\n have hbound (t : ℝ) (ht : t ∈ Set.Icc (0 : ℝ) 1) :\n Real.sqrt (g (l t) (z-y) (z-y)) ≤ h*k := by\n rw [heq]\n have he : g (l t) (h • d) (h • d) = h^2 * g (l t) d d := by\n simp only [map_smul,smul_apply,smul_eq_mul]; ring\n rw [he,Real.sqrt_mul (sq_nonneg h),Real.sqrt_sq hh.le]\n exact mul_le_mul_of_nonneg_left (hrN (hld t ht)).2.le hh.le\n have H := Helpers.riemannianEDist_inverse_chart_le_of_speed_bound I p g hnorm\n l (fun _ => z-y) 0 1 (h*k) zero_le_one\n (mul_nonneg hh.le ((Real.sqrt_nonneg _).trans hk.le)) hmaps (by dsimp [l]; fun_prop)\n (fun t _ => (hdx t).hasDerivWithinAt) hbound\n simpa [l] using H\ntheorem Helpers.chart_velocity_sum_lower_bound\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n {M : Type*} [EMetricSpace M] [ChartedSpace H M] [IsManifold I 1 M]\n [Bundle.RiemannianBundle (fun z : M => TangentSpace I z)]\n [IsRiemannianManifold I M]\n {γ : ℝ → M} {c : NNReal} {A D t₀ : ℝ}\n (hlin : Helpers.MetricLocallyLinear γ c (Set.Ioo A D))\n (ht₀ : t₀ ∈ Set.Ioo A D)\n (g : E → E →L[ℝ] E →L[ℝ] ℝ)\n (hg : ContinuousOn g (extChartAt I (γ t₀)).target)\n (hnorm : ∀ z ∈ (extChartAt I (γ t₀)).target, ∀ w : E,\n g z w w = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I (γ t₀)).symm (Set.range I) z w‖ ^ 2)\n {u v : E}\n (hu : HasDerivWithinAt (fun t => extChartAt I (γ t₀) (γ t)) u (Set.Ici t₀) t₀)\n (hv : HasDerivWithinAt (fun t => extChartAt I (γ t₀) (γ t)) v (Set.Iic t₀) t₀) :\n 2 * (c : ℝ) ≤ Real.sqrt (g (extChartAt I (γ t₀) (γ t₀)) (u+v) (u+v)) := by\n let p := γ t₀\n let F : ℝ → E := fun t => extChartAt I p (γ t)\n have hγ : ContinuousAt γ t₀ :=\n hlin.continuousOn.continuousAt (isOpen_Ioo.mem_nhds ht₀)\n have hF : ContinuousAt F t₀ := (continuousAt_extChartAt p).comp hγ\n have hdu : HasDerivWithinAt (fun h : ℝ => F (t₀+h)) u (Set.Ici 0) 0 := by\n simpa [Function.comp_def, F, p] using hu.scomp_of_eq (s := Set.Ici 0) 0\n (((hasDerivAt_id (0 : ℝ)).const_add t₀).hasDerivWithinAt)\n (fun h (hh : 0 ≤ h) => show t₀ ≤ t₀+h by linarith) (by simp)\n have hdv : HasDerivWithinAt (fun h : ℝ => F (t₀-h)) (-v) (Set.Ici 0) 0 := by\n simpa [Function.comp_def, F, p] using hv.scomp_of_eq (s := Set.Ici 0) 0\n (((hasDerivAt_const (0 : ℝ) t₀).sub (hasDerivAt_id (0 : ℝ))).hasDerivWithinAt)\n (fun h (hh : 0 ≤ h) => show t₀-h ≤ t₀ by linarith) (by simp)\n have hX : HasDerivWithinAt (fun h : ℝ => F (t₀+h) - F (t₀-h)) (u+v)\n (Set.Ioi 0) 0 := by\n convert (hdu.sub hdv).Ioi_of_Ici using 1\n simp only [sub_neg_eq_add]\n have hrescale : Filter.Tendsto\n (fun h : ℝ => h⁻¹ • (F (t₀+h) - F (t₀-h))) (nhdsWithin 0 (Set.Ioi 0))\n (nhds (u+v)) := by\n have hh := (hasDerivWithinAt_iff_tendsto_slope' (show (0 : ℝ) ∉ Set.Ioi 0 by simp)).mp hX\n convert hh using 1\n ext h\n simp [slope_def_module]\n by_contra hnot\n have hlt := lt_of_not_ge hnot\n obtain ⟨k,hk,hkc⟩ := exists_between hlt\n obtain ⟨r,hr,hchord⟩ := Helpers.exists_inverse_chart_chord_bound I p g hg hnorm (u+v) k hk\n have hplus : Filter.Tendsto (fun h : ℝ => t₀+h) (nhds 0) (nhds t₀) := by\n simpa only [add_zero, Function.id_def] using\n (tendsto_const_nhds.add (Filter.tendsto_id : Filter.Tendsto id (nhds (0 : ℝ)) (nhds 0)))\n have hminus : Filter.Tendsto (fun h : ℝ => t₀-h) (nhds 0) (nhds t₀) := by\n simpa only [sub_zero, Function.id_def] using\n (tendsto_const_nhds.sub (Filter.tendsto_id : Filter.Tendsto id (nhds (0 : ℝ)) (nhds 0)))\n have hR : ∀ᶠ h : ℝ in nhdsWithin 0 (Set.Ioi 0),\n F (t₀+h) ∈ Metric.ball (extChartAt I p p) r := by\n have H := hF.tendsto.comp hplus\n exact (H.eventually (Metric.ball_mem_nhds _ hr)).filter_mono nhdsWithin_le_nhds\n have hL : ∀ᶠ h : ℝ in nhdsWithin 0 (Set.Ioi 0),\n F (t₀-h) ∈ Metric.ball (extChartAt I p p) r := by\n have H := hF.tendsto.comp hminus\n exact (H.eventually (Metric.ball_mem_nhds _ hr)).filter_mono nhdsWithin_le_nhds\n have hSource : ∀ᶠ h : ℝ in nhds 0,\n γ (t₀+h) ∈ (extChartAt I p).source ∧ γ (t₀-h) ∈ (extChartAt I p).source := by\n have hS : ∀ᶠ t in nhds t₀, γ t ∈ (extChartAt I p).source :=\n hγ.preimage_mem_nhds (extChartAt_source_mem_nhds (I := I) p)\n exact (hplus.eventually hS).and (hminus.eventually hS)\n obtain ⟨δ,hδ,hEq⟩ := hlin.on_open isOpen_Ioo ht₀\n have hsmall : ∀ᶠ h : ℝ in nhdsWithin 0 (Set.Ioi 0), h < δ :=\n (show ∀ᶠ h : ℝ in nhds 0, h < δ from Iio_mem_nhds hδ).filter_mono\n nhdsWithin_le_nhds\n have hImpossible : ∀ᶠ h : ℝ in nhdsWithin 0 (Set.Ioi 0), False := by\n filter_upwards [hR,hL,hrescale.eventually (Metric.ball_mem_nhds _ hr),\n hSource.filter_mono nhdsWithin_le_nhds,hsmall,self_mem_nhdsWithin] with h hR hL hd hS hs hh\n change 0 < h at hh\n have hb := hchord (F (t₀-h)) (F (t₀+h)) h hh hL hR hd\n rw [← IsRiemannianManifold.out (I := I)] at hb\n have hleft : (extChartAt I p).symm (F (t₀-h)) = γ (t₀-h) := (extChartAt I p).left_inv hS.2\n have hright : (extChartAt I p).symm (F (t₀+h)) = γ (t₀+h) := (extChartAt I p).left_inv hS.1\n rw [hleft,hright,hEq (t₀-h) (t₀+h) (by constructor <;> linarith)\n (by constructor <;> linarith)] at hb\n have habs : |t₀+h-(t₀-h)| = 2*h := by rw [abs_of_pos (by linarith)]; ring\n rw [habs,← ENNReal.ofReal_coe_nnreal,← ENNReal.ofReal_mul c.coe_nonneg] at hb\n have hb' := (ENNReal.ofReal_le_ofReal_iff\n (mul_nonneg hh.le ((Real.sqrt_nonneg _).trans hk.le))).mp hb\n have hc' : 2*(c : ℝ) ≤ k := by nlinarith\n exact (not_le_of_gt hkc) hc'\n obtain ⟨h, hh⟩ := hImpossible.exists\n exact hh\ntheorem Helpers.eq_chart_velocity_of_one_sided_energy\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n {M : Type*} [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M]\n {γ : ℝ → M} {c : NNReal} {A D t₀ : ℝ} {u v : E}\n (hlin : Helpers.MetricLocallyLinear γ c (Set.Ioo A D))\n (ht₀ : t₀ ∈ Set.Ioo A D)\n (hu : HasDerivWithinAt (fun t => extChartAt I (γ t₀) (γ t)) u (Set.Ici t₀) t₀)\n (hv : HasDerivWithinAt (fun t => extChartAt I (γ t₀) (γ t)) v (Set.Iic t₀) t₀)\n (hEu : ‖mfderivWithin (modelWithCornersSelf ℝ E) I (extChartAt I (γ t₀)).symm\n (Set.range I) (extChartAt I (γ t₀) (γ t₀)) u‖ ^ 2 = (c : ℝ) ^ 2)\n (hEv : ‖mfderivWithin (modelWithCornersSelf ℝ E) I (extChartAt I (γ t₀)).symm\n (Set.range I) (extChartAt I (γ t₀) (γ t₀)) v‖ ^ 2 = (c : ℝ) ^ 2) : u = v := by\n obtain ⟨g, hg, hsym, hpos, hnorm⟩ := Helpers.exists_smooth_coordinate_metric I (γ t₀)\n rw [← hnorm _ (mem_extChartAt_target (γ t₀))] at hEu hEv\n have hsum := Helpers.chart_velocity_sum_lower_bound I hlin ht₀ g hg.continuousOn hnorm hu hv\n have hnonneg : 0 ≤ g (extChartAt I (γ t₀) (γ t₀)) (u+v) (u+v) := by\n rw [hnorm _ (mem_extChartAt_target (γ t₀))]\n exact sq_nonneg _\n apply Helpers.eq_of_bilinear_norm_add_ge\n (g (extChartAt I (γ t₀) (γ t₀))) (hsym _) (hpos _ (mem_extChartAt_target (γ t₀))) hEu hEv\n nlinarith [Real.sq_sqrt hnonneg,\n Real.sqrt_nonneg (g (extChartAt I (γ t₀) (γ t₀)) (u+v) (u+v)), c.coe_nonneg]\ntheorem Helpers.matching_chart_velocity_of_one_sided_regularity\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n {M : Type*} [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M]\n {γ : ℝ → M} {c : NNReal} {A D t₀ : ℝ}\n (hlin : Helpers.MetricLocallyLinear γ c (Set.Ioo A D)) (ht₀ : t₀ ∈ Set.Ioo A D)\n (hR : ContDiffWithinAt ℝ ∞ (fun t => extChartAt I (γ t₀) (γ t)) (Set.Ici t₀) t₀)\n (hL : ContDiffWithinAt ℝ ∞ (fun t => extChartAt I (γ t₀) (γ t)) (Set.Iic t₀) t₀)\n (hER : ∀ v : E,\n HasDerivWithinAt (fun t => extChartAt I (γ t₀) (γ t)) v (Set.Ici t₀) t₀ →\n ‖mfderivWithin (modelWithCornersSelf ℝ E) I (extChartAt I (γ t₀)).symm\n (Set.range I) (extChartAt I (γ t₀) (γ t₀)) v‖ ^ 2 = (c : ℝ) ^ 2)\n (hEL : ∀ v : E,\n HasDerivWithinAt (fun t => extChartAt I (γ t₀) (γ t)) v (Set.Iic t₀) t₀ →\n ‖mfderivWithin (modelWithCornersSelf ℝ E) I (extChartAt I (γ t₀)).symm\n (Set.range I) (extChartAt I (γ t₀) (γ t₀)) v‖ ^ 2 = (c : ℝ) ^ 2) :\n ∃ v : E,\n HasDerivWithinAt (fun t => extChartAt I (γ t₀) (γ t)) v (Set.Ici t₀) t₀ ∧\n HasDerivWithinAt (fun t => extChartAt I (γ t₀) (γ t)) v (Set.Iic t₀) t₀ := by\n have hu := (hR.differentiableWithinAt (by simp)).hasDerivWithinAt\n have hv := (hL.differentiableWithinAt (by simp)).hasDerivWithinAt\n have heq := Helpers.eq_chart_velocity_of_one_sided_energy I hlin ht₀ hu hv (hER _ hu) (hEL _ hv)\n rw [← heq] at hv\n exact ⟨_, hu, hv⟩\ntheorem Helpers.bilinear_derivative_energy_eq_within\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (B : E →L[ℝ] E →L[ℝ] ℝ) {x : ℝ → E} {x' : E} {t₀ c : ℝ} {s : Set ℝ}\n [Filter.NeBot (nhdsWithin t₀ s)] (hs : t₀ ∉ s)\n (hx : HasDerivWithinAt x x' s t₀) (hx₀ : x t₀ = 0)\n (henergy : ∀ᶠ t in nhdsWithin t₀ s,\n B (x t) (x t) = c ^ 2 * (t - t₀) ^ 2) : B x' x' = c ^ 2 := by\n have hlim : Filter.Tendsto (fun t => B (slope x t₀ t) (slope x t₀ t))\n (nhdsWithin t₀ s) (nhds (B x' x')) :=\n (B.continuous.clm_apply continuous_id).continuousAt.tendsto.comp\n ((hasDerivWithinAt_iff_tendsto_slope' hs).mp hx)\n have heq : (fun t => B (slope x t₀ t) (slope x t₀ t)) =ᶠ[nhdsWithin t₀ s]\n (fun _ => c ^ 2) := by\n filter_upwards [henergy, self_mem_nhdsWithin] with t ht hts\n have hne : t ≠ t₀ := by rintro rfl; exact hs hts\n simp only [slope_def_module, hx₀, sub_zero, map_smul, smul_apply, smul_eq_mul]\n rw [ht]\n have hsub : t - t₀ ≠ 0 := sub_ne_zero.mpr hne\n field_simp\n exact tendsto_nhds_unique (hlim.congr' heq) tendsto_const_nhds\ntheorem Helpers.energy_eq_of_normal_radius_derivative_within\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (g B : E →L[ℝ] E →L[ℝ] ℝ) (e : OpenPartialHomeomorph E E)\n (he0 : (0 : E) ∈ e.source)\n (he : DifferentiableAt ℝ e 0) (hi : DifferentiableAt ℝ e.symm (e 0))\n (hmetric : ∀ v, g (fderiv ℝ e 0 v) (fderiv ℝ e 0 v) = B v v)\n {x : ℝ → E} {x' : E} {t₀ c : ℝ} {s : Set ℝ}\n [Filter.NeBot (nhdsWithin t₀ s)] (hs : t₀ ∉ s)\n (hx : HasDerivWithinAt x x' s t₀) (hx₀ : x t₀ = e 0)\n (henergy : ∀ᶠ t in nhdsWithin t₀ s,\n B (e.symm (x t)) (e.symm (x t)) = c ^ 2 * (t - t₀) ^ 2) :\n g x' x' = c ^ 2 := by\n have he' : HasFDerivAt e (fderiv ℝ e 0) (e.symm (e 0)) := by\n rw [e.left_inv he0]\n exact he.hasFDerivAt\n have hcomp := he'.comp (e 0) hi.hasFDerivAt\n have hEq : (fun y => e (e.symm y)) =ᶠ[nhds (e 0)] id :=\n e.eventually_right_inverse (e.map_source he0)\n have hid := hcomp.congr_of_eventuallyEq hEq.symm\n have hcancel : ∀ v, fderiv ℝ e 0 (fderiv ℝ e.symm (e 0) v) = v := by\n intro v\n have hh := congrArg (fun L : E →L[ℝ] E => L v) (hid.unique (hasFDerivAt_id (e 0)))\n simpa only [ContinuousLinearMap.comp_apply, ContinuousLinearMap.id_apply,\n e.left_inv he0] using hh\n have hi' : HasFDerivAt e.symm (fderiv ℝ e.symm (e 0)) (x t₀) := by\n rw [hx₀]\n exact hi.hasFDerivAt\n have hdx := hi'.comp_hasDerivWithinAt t₀ hx\n have hzero : e.symm (x t₀) = 0 := by rw [hx₀]; exact e.left_inv he0\n have h := Helpers.bilinear_derivative_energy_eq_within B hs hdx hzero henergy\n rw [← hmetric, hcancel] at h\n exact h\ntheorem Helpers.energy_eq_of_local_normal_distance_within\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {M : Type*} [EMetricSpace M] (F : M → E) (p : M)\n (g B : E →L[ℝ] E →L[ℝ] ℝ) (e : OpenPartialHomeomorph E E)\n (he0 : (0 : E) ∈ e.source) (hp : F p = e 0)\n (he : DifferentiableAt ℝ e 0) (hi : DifferentiableAt ℝ e.symm (e 0))\n (hmetric : ∀ v, g (fderiv ℝ e 0 v) (fderiv ℝ e 0 v) = B v v)\n (hB : ∀ v, 0 ≤ B v v)\n {V : Set M} (hV : V ∈ nhds p)\n (hdist : ∀ q ∈ V, edist p q = ENNReal.ofReal\n (Real.sqrt (B (e.symm (F q)) (e.symm (F q)))))\n {γ : ℝ → M} {v : E} {t₀ : ℝ} {c : NNReal} {s : Set ℝ}\n [Filter.NeBot (nhdsWithin t₀ s)] (hs : t₀ ∉ s)\n (hγ : ContinuousAt γ t₀) (hγ₀ : γ t₀ = p)\n (hx : HasDerivWithinAt (fun t => F (γ t)) v s t₀)\n (hlinear : ∀ᶠ t in nhdsWithin t₀ s,\n edist p (γ t) = (c : ENNReal) * ENNReal.ofReal |t - t₀|) :\n g v v = (c : ℝ) ^ 2 := by\n apply Helpers.energy_eq_of_normal_radius_derivative_within g B e he0 he hi hmetric hs hx\n (by rw [hγ₀, hp])\n have hγVn : ∀ᶠ t in nhds t₀, γ t ∈ V :=\n hγ.preimage_mem_nhds (by simpa only [hγ₀] using hV)\n have hγV : ∀ᶠ t in nhdsWithin t₀ s, γ t ∈ V :=\n hγVn.filter_mono nhdsWithin_le_nhds\n filter_upwards [hγV, hlinear] with t ht hlin\n have hh := (hdist (γ t) ht).symm.trans hlin\n have hh' : Real.sqrt (B (e.symm (F (γ t))) (e.symm (F (γ t)))) =\n (c : ℝ) * |t - t₀| := by\n apply (ENNReal.ofReal_eq_ofReal_iff (Real.sqrt_nonneg _)\n (mul_nonneg c.coe_nonneg (abs_nonneg _))).mp\n simpa only [ENNReal.ofReal_mul c.coe_nonneg, ENNReal.ofReal_coe_nnreal] using hh\n calc\n _ = (Real.sqrt (B (e.symm (F (γ t))) (e.symm (F (γ t))))) ^ 2 :=\n (Real.sq_sqrt (hB _)).symm\n _ = (c : ℝ) ^ 2 * (t - t₀) ^ 2 := by rw [hh', mul_pow, sq_abs]\ntheorem Helpers.bilinear_derivative_energy_eq\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (B : E →L[ℝ] E →L[ℝ] ℝ) {x : ℝ → E} {x' : E} {t₀ c : ℝ}\n (hx : HasDerivAt x x' t₀) (hx₀ : x t₀ = 0)\n (henergy : ∀ᶠ t in nhds t₀, B (x t) (x t) = c ^ 2 * (t - t₀) ^ 2) :\n B x' x' = c ^ 2 := by\n have hlim : Filter.Tendsto\n (fun t => B (slope x t₀ t) (slope x t₀ t))\n (nhdsWithin t₀ {t₀}ᶜ) (nhds (B x' x')) :=\n (B.continuous.clm_apply continuous_id).continuousAt.tendsto.comp hx.tendsto_slope\n have heq : (fun t => B (slope x t₀ t) (slope x t₀ t)) =ᶠ[\n nhdsWithin t₀ {t₀}ᶜ] (fun _ => c ^ 2) := by\n filter_upwards [henergy.filter_mono nhdsWithin_le_nhds, self_mem_nhdsWithin] with t ht hne\n simp only [slope_def_module, hx₀, sub_zero, map_smul, smul_apply, smul_eq_mul]\n rw [ht]\n have hsub : t - t₀ ≠ 0 := sub_ne_zero.mpr hne\n field_simp\n exact tendsto_nhds_unique (hlim.congr' heq) tendsto_const_nhds\ntheorem Helpers.hasDerivAt_center_chart_of_chart\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M] [IsManifold I 1 M]\n (p : M) {γ : ℝ → M} {t : ℝ} {v : E}\n (hγ : ContinuousAt γ t) (hp : γ t ∈ (extChartAt I p).source)\n (hx : HasDerivAt (fun s => extChartAt I p (γ s)) v t) :\n HasDerivAt (fun s => extChartAt I (γ t) (γ s))\n (mfderivWithin (modelWithCornersSelf ℝ E) I (extChartAt I p).symm\n (Set.range I) (extChartAt I p (γ t)) v) t := by\n have hInv := (mdifferentiableWithinAt_extChartAt_symm\n ((extChartAt I p).map_source hp)).hasMFDerivWithinAt\n have hInv' : HasMFDerivAt (modelWithCornersSelf ℝ E) I (extChartAt I p).symm\n (extChartAt I p (γ t))\n (mfderivWithin (modelWithCornersSelf ℝ E) I (extChartAt I p).symm\n (Set.range I) (extChartAt I p (γ t))) := by\n simpa only [I.range_eq_univ, hasMFDerivWithinAt_univ] using hInv\n have hcomp := hInv'.comp t hx.hasFDerivAt.hasMFDerivAt\n have heq : γ =ᶠ[nhds t] (fun s => (extChartAt I p).symm (extChartAt I p (γ s))) := by\n filter_upwards [hγ.preimage_mem_nhds (extChartAt_source_mem_nhds' hp)] with s hs\n exact ((extChartAt I p).left_inv hs).symm\n have hγ' := hcomp.congr_of_eventuallyEq_abuse heq\n have hcenter := (mdifferentiableAt_extChartAt\n (mem_chart_source H (γ t))).hasMFDerivAt.comp t hγ'\n set_option backward.isDefEq.respectTransparency false in\n rw [hasDerivAt_iff_hasFDerivAt, ← hasMFDerivAt_iff_hasFDerivAt]\n apply hcenter.congr_mfderiv\n ext\n dsimp only [TangentSpace, instModuleTangentSpace, instAddCommGroupTangentSpace,\n instTopologicalSpaceTangentSpace]\n simp only [ContinuousLinearMap.comp_apply, ContinuousLinearMap.toSpanSingleton_apply,\n one_smul]\n exact congrArg (fun A => A ((mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) (extChartAt I p (γ t))) v))\n (mfderiv_extChartAt_self (I := I) (x := γ t))\ntheorem Helpers.chart_speed_eq_of_center_chart_speed\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M] [IsManifold I 1 M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n (p : M) {γ : ℝ → M} {t₀ k : ℝ} {v : E}\n (hγ : ContinuousAt γ t₀) (hp : γ t₀ ∈ (extChartAt I p).source)\n (hx : HasDerivAt (fun t => extChartAt I p (γ t)) v t₀)\n (hSpeed : ∀ w : E,\n HasDerivAt (fun t => extChartAt I (γ t₀) (γ t)) w t₀ →\n ‖mfderivWithin (modelWithCornersSelf ℝ E) I (extChartAt I (γ t₀)).symm\n (Set.range I) (extChartAt I (γ t₀) (γ t₀)) w‖ ^ 2 = k) :\n ‖mfderivWithin (modelWithCornersSelf ℝ E) I (extChartAt I p).symm\n (Set.range I) (extChartAt I p (γ t₀)) v‖ ^ 2 = k := by\n have hx' := Helpers.hasDerivAt_center_chart_of_chart I p hγ hp hx\n have hs := hSpeed _ hx'\n rw [mfderivWithin_range_extChartAt_symm] at hs\n dsimp only [TangentSpace, instModuleTangentSpace, instAddCommGroupTangentSpace,\n instTopologicalSpaceTangentSpace] at hs\n set_option backward.isDefEq.respectTransparency false in\n simp only [ContinuousLinearMap.id_apply] at hs\n let N : M → E → ℝ := fun q w => @norm (TangentSpace I q) inferInstance w\n change N ((extChartAt I (γ t₀)).symm (extChartAt I (γ t₀) (γ t₀)))\n ((mfderivWithin (modelWithCornersSelf ℝ E) I (extChartAt I p).symm\n (Set.range I) (extChartAt I p (γ t₀))) v) ^ 2 = k at hs\n change N ((extChartAt I p).symm (extChartAt I p (γ t₀)))\n ((mfderivWithin (modelWithCornersSelf ℝ E) I (extChartAt I p).symm\n (Set.range I) (extChartAt I p (γ t₀))) v) ^ 2 = k\n simpa only [(extChartAt I p).left_inv hp,\n (extChartAt I (γ t₀)).left_inv (mem_extChartAt_source (γ t₀))] using hs\ntheorem Helpers.hasDerivAt_of_normal_coordinates\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (e : OpenPartialHomeomorph E E) {F : ℝ → E} {v : E} {t : ℝ}\n (hF : ContinuousAt F t) (ht : F t ∈ e.target)\n (he : DifferentiableAt ℝ e (e.symm (F t)))\n (hx : HasDerivAt (fun s => e.symm (F s)) v t) :\n HasDerivAt F (fderiv ℝ e (e.symm (F t)) v) t := by\n have hi : (fun y => e (e.symm y)) =ᶠ[nhds (F t)] id := e.eventually_right_inverse ht\n have hEq : F =ᶠ[nhds t] (fun s => e (e.symm (F s))) :=\n (hi.comp_tendsto hF.tendsto).symm\n exact (he.hasFDerivAt.comp_hasDerivAt t hx).congr_of_eventuallyEq hEq\ntheorem Helpers.injective_fderiv_of_partial_homeomorph\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (e : OpenPartialHomeomorph E E) {u : E} (hu : u ∈ e.source)\n (he : DifferentiableAt ℝ e u) (hi : DifferentiableAt ℝ e.symm (e u)) :\n Function.Injective (fderiv ℝ e u) := by\n have hcomp := hi.hasFDerivAt.comp u he.hasFDerivAt\n have hEq : (fun y => e.symm (e y)) =ᶠ[nhds u] id := e.eventually_left_inverse hu\n have hcancel := (hcomp.congr_of_eventuallyEq hEq.symm).unique (hasFDerivAt_id u)\n intro v w hvw\n have hh := congrArg (fun L : E →L[ℝ] E => L v) hcancel\n have hh' := congrArg (fun L : E →L[ℝ] E => L w) hcancel\n simp only [ContinuousLinearMap.comp_apply, ContinuousLinearMap.id_apply, hvw] at hh hh'\n exact hh.symm.trans hh'\ntheorem Helpers.radial_of_normal_coordinates_sharp_speed : open MeasureTheory in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n (e : OpenPartialHomeomorph E E) (g : E → E →L[ℝ] E →L[ℝ] ℝ)\n (B : E →L[ℝ] E →L[ℝ] ℝ) (F : ℝ → E)\n (K : NNReal) (r a b t₀ c : ℝ),\n (∀ u v, B u v = B v u) → 0 < c → t₀ < a → a ≤ b →\n ContDiffOn ℝ 1 e (Metric.ball 0 r) →\n (∀ t ∈ Set.Icc a b, F t ∈ e.target ∧ e.symm (F t) ∈ Metric.ball 0 r) →\n (∀ t ∈ Set.Icc a b, ContinuousAt F t) →\n (∀ t ∈ Set.Icc a b, DifferentiableAt ℝ e.symm (F t)) →\n LipschitzOnWith K (fun t => e.symm (F t)) (Set.Icc a b) →\n (∀ t ∈ Set.Icc a b, ∀ u v, g (F t) u v = g (F t) v u) →\n (∀ t ∈ Set.Icc a b, ∀ v, v ≠ 0 → 0 < g (F t) v v) →\n (∀ t ∈ Set.Icc a b, ∀ w,\n g (F t) (fderiv ℝ e (e.symm (F t)) (e.symm (F t)))\n (fderiv ℝ e (e.symm (F t)) w) = B (e.symm (F t)) w) →\n (∀ t ∈ Set.Icc a b, ∀ v, HasDerivAt F v t → g (F t) v v = c ^ 2) →\n (∀ t ∈ Set.Icc a b, Real.sqrt (B (e.symm (F t)) (e.symm (F t))) =\n c * (t - t₀)) →\n ∃ w : E, ∀ t ∈ Set.Icc a b, e.symm (F t) = (t - t₀) • w := by\n intro E _ _ _ e g B F K r a b t₀ c hB hc ht₀ hab he hMaps hF hi hLip\n hsym hpos hGauss hSharp hRadius\n have heDiff (t : ℝ) (ht : t ∈ Set.Icc a b) :\n DifferentiableAt ℝ e (e.symm (F t)) :=\n (he.contDiffAt (Metric.isOpen_ball.mem_nhds (hMaps t ht).2)).differentiableAt_one\n refine Helpers.radial_of_gauss_speed_bound B (fun t => g (F t))\n (fun t => fderiv ℝ e (e.symm (F t))) (fun t => e.symm (F t)) K a b t₀ c\n hB hc ht₀ hab hLip hsym hpos ?_ hGauss hRadius ?_\n · intro t ht\n exact Helpers.injective_fderiv_of_partial_homeomorph e\n (e.map_target (hMaps t ht).1) (heDiff t ht)\n (by simpa only [e.right_inv (hMaps t ht).1] using hi t ht)\n · filter_upwards [Helpers.ae_hasDerivAt_of_lipschitzOnWith_Icc hLip] with t hdt ht\n exact (hSharp t ht _ (Helpers.hasDerivAt_of_normal_coordinates e (hF t ht)\n (hMaps t ht).1 (heDiff t ht) (hdt ht))).le\ntheorem Helpers.MetricLocallyLinear.continuousAt\n {M : Type*} [EMetricSpace M] {γ : ℝ → M} {c : NNReal} {S : Set ℝ}\n (h : Helpers.MetricLocallyLinear γ c S) (hS : IsOpen S) {t : ℝ} (ht : t ∈ S) :\n ContinuousAt γ t :=\n h.continuousOn.continuousAt (hS.mem_nhds ht)\ntheorem Helpers.MetricLocallyLinear.eventually_edist_eq\n {M : Type*} [EMetricSpace M] {γ : ℝ → M} {c : NNReal} {S : Set ℝ}\n (h : Helpers.MetricLocallyLinear γ c S) (hS : IsOpen S) {t : ℝ} (ht : t ∈ S) :\n ∀ᶠ s in nhds t, edist (γ t) (γ s) = (c : ENNReal) * ENNReal.ofReal |s - t| := by\n obtain ⟨δ, hδ, H⟩ := h.on_open hS ht\n filter_upwards [Ioo_mem_nhds (by linarith : t - δ < t) (by linarith : t < t + δ)]\n with s hs\n exact H t s (by constructor <;> linarith) hs\ntheorem Helpers.right_radial_germ_of_compact_radial\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {M : Type*} (F : ℝ → E) (γ : ℝ → M) (G : E → M) (t₀ d : ℝ)\n (hd : 0 < d) (hF₀ : F t₀ = 0) (hγ₀ : γ t₀ = G 0)\n (hRig : ∀ a b : ℝ, t₀ < a → a ≤ b → b < t₀ + d →\n ∃ w : E, ∀ t ∈ Set.Icc a b,\n F t = (t - t₀) • w ∧ γ t = G ((t - t₀) • w)) :\n ∃ w : E, ∀ t ∈ Set.Icc t₀ (t₀ + d / 2),\n F t = (t - t₀) • w ∧ γ t = G ((t - t₀) • w) := by\n let m := t₀ + d / 4\n have hm : t₀ < m := by dsimp [m]; linarith\n let w := (m - t₀)⁻¹ • F m\n refine ⟨w, fun t ht => ?_⟩\n rcases eq_or_lt_of_le ht.1 with h | h\n · subst t\n simpa only [sub_self, zero_smul] using And.intro hF₀ hγ₀\n · obtain ⟨u, hu⟩ := hRig (min t m) (max t m) (lt_min h hm) min_le_max\n (max_lt (by linarith [ht.2]) (by dsimp [m]; linarith))\n have hmI : m ∈ Set.Icc (min t m) (max t m) :=\n ⟨min_le_right _ _, le_max_right _ _⟩\n have hw : w = u := by\n dsimp [w]\n rw [(hu m hmI).1, smul_smul, inv_mul_cancel₀ (sub_ne_zero.mpr hm.ne'), one_smul]\n simpa only [hw] using hu t ⟨min_le_left _ _, le_max_left _ _⟩\ntheorem Helpers.contDiffWithinAt_chart_of_right_radial_germ\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M] (p : M)\n {γ : ℝ → M} {t₀ ε : ℝ} {e : E → E} {w : E}\n (hε : 0 < ε) (hep : e 0 = extChartAt I p p) (he : ContDiffAt ℝ ∞ e 0)\n (hRep : ∀ t ∈ Set.Icc t₀ (t₀ + ε),\n γ t = (extChartAt I p).symm (e ((t - t₀) • w))) :\n ContDiffWithinAt ℝ ∞ (fun t => extChartAt I p (γ t)) (Set.Ici t₀) t₀ := by\n have hLine : ContDiff ℝ ∞ (fun t : ℝ => (t - t₀) • w) :=\n (contDiff_id.sub contDiff_const).smul contDiff_const\n have he' : ContDiffAt ℝ ∞ e ((t₀ - t₀) • w) := by\n simpa only [sub_self, zero_smul] using he\n have hSmooth : ContDiffAt ℝ ∞ (fun t : ℝ => e ((t - t₀) • w)) t₀ :=\n he'.comp t₀ hLine.contDiffAt\n have hTarget : ∀ᶠ t in nhds t₀, e ((t - t₀) • w) ∈ (extChartAt I p).target :=\n hSmooth.continuousAt.preimage_mem_nhds\n ((isOpen_extChartAt_target p).mem_nhds (by\n rw [sub_self, zero_smul, hep]\n exact mem_extChartAt_target p))\n have hlt : ∀ᶠ t in nhds t₀, t < t₀ + ε := Iio_mem_nhds (by linarith)\n apply hSmooth.contDiffWithinAt.congr_of_eventuallyEq_of_mem ?_ (show t₀ ∈ Set.Ici t₀ by simp)\n filter_upwards [self_mem_nhdsWithin,\n hlt.filter_mono nhdsWithin_le_nhds,\n hTarget.filter_mono nhdsWithin_le_nhds] with t ht hlt htarget\n rw [hRep t ⟨ht, hlt.le⟩]\n exact (extChartAt I p).right_inv htarget\ntheorem Helpers.radial_energy_eq_of_radial_identity\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {U : Set E} {r : ℝ} {g : E → E →L[ℝ] E →L[ℝ] ℝ}\n {e : E → E} (B : E →L[ℝ] E →L[ℝ] ℝ)\n (hg : ContinuousOn g U) (he : ContDiffOn ℝ 1 e (Metric.ball 0 r))\n (heU : Set.MapsTo e (Metric.ball 0 r) U)\n (hradial : ∀ u ∈ Metric.ball 0 r,\n g (e u) (fderiv ℝ e u u) (fderiv ℝ e u u) = B u u)\n {v : E} (hv : v ∈ Metric.ball 0 r) :\n ∀ t ∈ Set.Icc (0 : ℝ) 1,\n g (e (t • v)) (fderiv ℝ e (t • v) v) (fderiv ℝ e (t • v) v) = B v v := by\n have hmaps : Set.MapsTo (fun t : ℝ => t • v) (Set.Icc 0 1) (Metric.ball 0 r) := by\n intro t ht\n rw [Metric.mem_ball, dist_zero_right] at hv ⊢\n calc\n ‖t • v‖ = t * ‖v‖ := by rw [norm_smul, Real.norm_eq_abs, abs_of_nonneg ht.1]\n _ ≤ 1 * ‖v‖ := mul_le_mul_of_nonneg_right ht.2 (norm_nonneg _)\n _ < r := by simpa using hv\n have hsmul : Continuous (fun t : ℝ => t • v) := continuous_id.smul continuous_const\n have hD : ContinuousOn (fun t : ℝ => fderiv ℝ e (t • v) v) (Set.Icc 0 1) :=\n ((he.continuousOn_fderiv_of_isOpen Metric.isOpen_ball le_rfl).comp\n hsmul.continuousOn hmaps).clm_apply continuousOn_const\n have hG : ContinuousOn (fun t : ℝ => g (e (t • v))) (Set.Icc 0 1) :=\n hg.comp (he.continuousOn.comp hsmul.continuousOn hmaps) (heU.comp hmaps)\n have heq : Set.EqOn\n (fun t : ℝ => g (e (t • v)) (fderiv ℝ e (t • v) v)\n (fderiv ℝ e (t • v) v)) (fun _ => B v v) (Set.Ioc 0 1) := by\n intro t ht\n have h := hradial (t • v) (hmaps ⟨ht.1.le, ht.2⟩)\n simp only [map_smul, smul_apply, smul_eq_mul] at h\n exact mul_left_cancel₀ ht.1.ne' (mul_left_cancel₀ ht.1.ne' h)\n exact heq.of_subset_closure ((hG.clm_apply hD).clm_apply hD) continuousOn_const\n Set.Ioc_subset_Icc_self (by rw [closure_Ioc (show (0 : ℝ) ≠ 1 by norm_num)])\ntheorem Helpers.riemannianEDist_radial_le : open scoped Bundle in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M] [IsManifold I 1 M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n (p : M) (g : E → E →L[ℝ] E →L[ℝ] ℝ)\n (_hg : ContinuousOn g (extChartAt I p).target)\n (_hnorm : ∀ z ∈ (extChartAt I p).target, ∀ w : E,\n g z w w = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z w‖ ^ 2)\n (B : E →L[ℝ] E →L[ℝ] ℝ) (e : E → E) (r : ℝ)\n (_he : ContDiffOn ℝ 1 e (Metric.ball 0 r))\n (_htarget : Set.MapsTo e (Metric.ball 0 r) (extChartAt I p).target)\n (_hradial : ∀ u ∈ Metric.ball 0 r,\n g (e u) (fderiv ℝ e u u) (fderiv ℝ e u u) = B u u)\n (v : E) (_hv : v ∈ Metric.ball 0 r) (_hB : 0 ≤ B v v),\n Manifold.riemannianEDist I ((extChartAt I p).symm (e 0))\n ((extChartAt I p).symm (e v)) ≤ ENNReal.ofReal (Real.sqrt (B v v)) := by\n intro E _ _ H _ I M _ _ _ _ p g hg hnorm B e r he htarget hradial v hv hB\n have hmaps : Set.MapsTo (fun t : ℝ => t • v) (Set.Icc 0 1) (Metric.ball 0 r) := by\n intro t ht\n rw [Metric.mem_ball, dist_zero_right] at hv ⊢\n calc\n ‖t • v‖ = t * ‖v‖ := by rw [norm_smul, Real.norm_eq_abs, abs_of_nonneg ht.1]\n _ ≤ 1 * ‖v‖ := mul_le_mul_of_nonneg_right ht.2 (norm_nonneg _)\n _ < r := by simpa using hv\n have hcurve : ContDiffOn ℝ 1 (fun t : ℝ => e (t • v)) (Set.Icc 0 1) :=\n he.comp (contDiff_id.smul contDiff_const).contDiffOn hmaps\n have hderiv : ∀ t ∈ Set.Icc (0 : ℝ) 1,\n HasDerivWithinAt (fun s : ℝ => e (s • v)) (fderiv ℝ e (t • v) v)\n (Set.Icc 0 1) t := by\n intro t ht\n have hline : HasDerivAt (fun s : ℝ => s • v) v t := by\n simpa using (hasDerivAt_id t).smul_const v\n exact (((he.contDiffAt (Metric.isOpen_ball.mem_nhds (hmaps ht))).differentiableAt_one\n ).hasFDerivAt.comp_hasDerivAt t hline).hasDerivWithinAt\n have henergy := Helpers.radial_energy_eq_of_radial_identity B hg he htarget hradial hv\n have h := Helpers.riemannianEDist_inverse_chart_le_of_constant_energy I p g hnorm\n (fun t : ℝ => e (t • v)) (fun t : ℝ => fderiv ℝ e (t • v) v)\n 0 1 (Real.sqrt (B v v)) zero_le_one (Real.sqrt_nonneg _) (htarget.comp hmaps)\n hcurve hderiv (by intro t ht; rw [henergy t ht, Real.sq_sqrt hB])\n simpa only [zero_smul, one_smul, sub_zero, one_mul] using h\ntheorem Helpers.radial_metric_at_zero\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {U : Set E} {r : ℝ} (hr : 0 < r)\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {e : E → E}\n (B : E →L[ℝ] E →L[ℝ] ℝ)\n (hg : ContinuousOn g U) (he : ContDiffOn ℝ 1 e (Metric.ball 0 r))\n (heU : Set.MapsTo e (Metric.ball 0 r) U)\n (hradial : ∀ u ∈ Metric.ball 0 r,\n g (e u) (fderiv ℝ e u u) (fderiv ℝ e u u) = B u u) :\n ∀ v, g (e 0) (fderiv ℝ e 0 v) (fderiv ℝ e 0 v) = B v v := by\n intro v\n have hnear : ∀ᶠ t : ℝ in nhds (0 : ℝ), t • v ∈ Metric.ball 0 r :=\n (continuous_id.smul continuous_const).continuousAt.preimage_mem_nhds\n (Metric.isOpen_ball.mem_nhds (by simpa using Metric.mem_ball_self (x := (0 : E)) hr))\n obtain ⟨t, ht, hne⟩ :=\n ((hnear.filter_mono nhdsWithin_le_nhds).and self_mem_nhdsWithin :\n ∀ᶠ t : ℝ in nhdsWithin 0 {(0 : ℝ)}ᶜ,\n t • v ∈ Metric.ball 0 r ∧ t ≠ 0).exists\n have h := Helpers.radial_energy_eq_of_radial_identity B hg he heU hradial ht 0\n (show (0 : ℝ) ∈ Set.Icc 0 1 by simp)\n simp only [zero_smul, map_smul, smul_apply, smul_eq_mul] at h\n exact mul_left_cancel₀ hne (mul_left_cancel₀ hne h)\ntheorem Helpers.energy_eq_of_normal_radius_derivative\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (g B : E →L[ℝ] E →L[ℝ] ℝ) (e : OpenPartialHomeomorph E E)\n (he0 : (0 : E) ∈ e.source)\n (he : DifferentiableAt ℝ e 0) (hi : DifferentiableAt ℝ e.symm (e 0))\n (hmetric : ∀ v, g (fderiv ℝ e 0 v) (fderiv ℝ e 0 v) = B v v)\n {x : ℝ → E} {x' : E} {t₀ c : ℝ}\n (hx : HasDerivAt x x' t₀) (hx₀ : x t₀ = e 0)\n (henergy : ∀ᶠ t in nhds t₀,\n B (e.symm (x t)) (e.symm (x t)) = c ^ 2 * (t - t₀) ^ 2) :\n g x' x' = c ^ 2 := by\n have he' : HasFDerivAt e (fderiv ℝ e 0) (e.symm (e 0)) := by\n rw [e.left_inv he0]\n exact he.hasFDerivAt\n have hcomp := he'.comp (e 0) hi.hasFDerivAt\n have hEq : (fun y => e (e.symm y)) =ᶠ[nhds (e 0)] id :=\n e.eventually_right_inverse (e.map_source he0)\n have hid := hcomp.congr_of_eventuallyEq hEq.symm\n have hcancel : ∀ v, fderiv ℝ e 0 (fderiv ℝ e.symm (e 0) v) = v := by\n intro v\n have hh := congrArg (fun L : E →L[ℝ] E => L v) (hid.unique (hasFDerivAt_id (e 0)))\n simpa only [ContinuousLinearMap.comp_apply, ContinuousLinearMap.id_apply,\n e.left_inv he0] using hh\n have hdx : HasDerivAt (fun t => e.symm (x t))\n (fderiv ℝ e.symm (e 0) x') t₀ := by\n have hi' : HasFDerivAt e.symm (fderiv ℝ e.symm (e 0)) (x t₀) := by\n rw [hx₀]\n exact hi.hasFDerivAt\n exact hi'.comp_hasDerivAt t₀ hx\n have hzero : e.symm (x t₀) = 0 := by rw [hx₀]; exact e.left_inv he0\n have h := Helpers.bilinear_derivative_energy_eq B hdx hzero henergy\n rw [← hmetric, hcancel] at h\n exact h\ntheorem Helpers.energy_eq_of_local_normal_distance\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {M : Type*} [EMetricSpace M] (F : M → E) (p : M)\n (g B : E →L[ℝ] E →L[ℝ] ℝ) (e : OpenPartialHomeomorph E E)\n (he0 : (0 : E) ∈ e.source) (hp : F p = e 0)\n (he : DifferentiableAt ℝ e 0) (hi : DifferentiableAt ℝ e.symm (e 0))\n (hmetric : ∀ v, g (fderiv ℝ e 0 v) (fderiv ℝ e 0 v) = B v v)\n (hB : ∀ v, 0 ≤ B v v)\n {V : Set M} (hV : V ∈ nhds p)\n (hdist : ∀ q ∈ V, edist p q = ENNReal.ofReal (Real.sqrt (B (e.symm (F q)) (e.symm (F q)))))\n {γ : ℝ → M} {v : E} {t₀ : ℝ} {c : NNReal}\n (hγ : ContinuousAt γ t₀) (hγ₀ : γ t₀ = p)\n (hx : HasDerivAt (fun t => F (γ t)) v t₀)\n (hlinear : ∀ᶠ t in nhds t₀,\n edist p (γ t) = (c : ENNReal) * ENNReal.ofReal |t - t₀|) :\n g v v = (c : ℝ) ^ 2 := by\n apply Helpers.energy_eq_of_normal_radius_derivative g B e he0 he hi hmetric hx\n (by rw [hγ₀, hp])\n have hγV : ∀ᶠ t in nhds t₀, γ t ∈ V :=\n hγ.preimage_mem_nhds (by simpa only [hγ₀] using hV)\n filter_upwards [hγV, hlinear] with t ht hlin\n have hh := (hdist (γ t) ht).symm.trans hlin\n have hh' : Real.sqrt (B (e.symm (F (γ t))) (e.symm (F (γ t)))) =\n (c : ℝ) * |t - t₀| := by\n apply (ENNReal.ofReal_eq_ofReal_iff (Real.sqrt_nonneg _)\n (mul_nonneg c.coe_nonneg (abs_nonneg _))).mp\n simpa only [ENNReal.ofReal_mul c.coe_nonneg, ENNReal.ofReal_coe_nnreal] using hh\n calc\n _ = (Real.sqrt (B (e.symm (F (γ t))) (e.symm (F (γ t))))) ^ 2 :=\n (Real.sq_sqrt (hB _)).symm\n _ = (c : ℝ) ^ 2 * (t - t₀) ^ 2 := by rw [hh', mul_pow, sq_abs]\ntheorem Helpers.exists_coordinate_normal_radius_control\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {U : Set E} (hU : IsOpen U)\n {g : E → E →L[ℝ] E →L[ℝ] ℝ}\n (hg : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) g U)\n (hsym : ∀ x u v, g x u v = g x v u)\n (hpos : ∀ x ∈ U, ∀ v, v ≠ 0 → 0 < g x v v)\n {Γ : E → E →L[ℝ] E →L[ℝ] E}\n (hΓ : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Γ U)\n (hKoszul : ∀ x ∈ U, ∀ u v w,\n 2 * g x (Γ x u v) w = (fderiv ℝ g x u) v w +\n (fderiv ℝ g x v) u w - (fderiv ℝ g x w) u v)\n {p : E} (hp : p ∈ U) :\n ∃ τ > (0 : ℝ), ∃ r > (0 : ℝ), ∃ e : OpenPartialHomeomorph E E,\n (0 : E) ∈ e.source ∧ e 0 = p ∧\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) e (Metric.ball 0 r) ∧\n (∀ v ∈ Metric.ball 0 r, e v ∈ U ∧ ∀ w,\n g (e v) (fderiv ℝ e v v) (fderiv ℝ e v w) = τ ^ 2 * g p v w) ∧\n ∃ W : Set E, IsOpen W ∧ p ∈ W ∧ W ⊆ U ∩ e.target ∧\n (∀ z ∈ W, e.symm z ∈ Metric.ball 0 r) ∧\n ContDiffOn ℝ 1 e.symm W ∧\n (∀ δ > (0 : ℝ), ContDiffOn ℝ 1\n (fun z => Real.sqrt ((τ ^ 2 • g p) (e.symm z) (e.symm z) + δ)) W) ∧\n (∀ δ > (0 : ℝ), ∀ z ∈ W, ∀ w,\n |fderiv ℝ (fun y => Real.sqrt\n ((τ ^ 2 • g p) (e.symm y) (e.symm y) + δ)) z w| ≤\n Real.sqrt (g z w w)) := by\n obtain ⟨τ, hτ, r, hr, e, he0, hpt, hep, he, hei, hGauss⟩ :=\n Helpers.exists_coordinate_normal_chart hU (hg.of_le (by simp)) hsym hΓ hKoszul hp\n obtain ⟨A, hAp, hInvA⟩ := hei.contDiffOn (m := 1) (by simp) (by simp)\n obtain ⟨A', hA'A, hA', hpA'⟩ := mem_nhds_iff.mp hAp\n let W := (A' ∩ U) ∩ (e.target ∩ e.symm ⁻¹' Metric.ball 0 r)\n have hW : IsOpen W :=\n (hA'.inter hU).inter (e.isOpen_inter_preimage_symm Metric.isOpen_ball)\n have hInvp : e.symm p = 0 := by rw [← hep]; exact e.left_inv he0\n have hpW : p ∈ W :=\n ⟨⟨hpA', hp⟩, hpt, by\n change e.symm p ∈ Metric.ball 0 r\n rw [hInvp]\n exact Metric.mem_ball_self hr⟩\n have hInvW : ContDiffOn ℝ 1 e.symm W :=\n hInvA.mono (fun z hz => hA'A hz.1.1)\n let B : E →L[ℝ] E →L[ℝ] ℝ := τ ^ 2 • g p\n have hBsym : ∀ u v, B u v = B v u := by\n intro u v\n change τ ^ 2 * g p u v = τ ^ 2 * g p v u\n rw [hsym p u v]\n have hnonneg : ∀ z ∈ U, ∀ v, 0 ≤ g z v v := by\n intro z hz v\n by_cases hv : v = 0\n · simp [hv]\n · exact (hpos z hz v hv).le\n have hBn : ∀ v, 0 ≤ B v v := by\n intro v\n change 0 ≤ τ ^ 2 * g p v v\n exact mul_nonneg (sq_nonneg _) (hnonneg p hp v)\n refine ⟨τ, hτ, r, hr, e, he0, hep, he, hGauss, W, hW, hpW,\n (fun z hz => ⟨hz.1.2, hz.2.1⟩), (fun z hz => hz.2.2), hInvW, ?_, ?_⟩\n · intro δ hδ\n have hQ : ContDiffOn ℝ 1 (fun z => B (e.symm z) (e.symm z) + δ) W :=\n (((contDiffOn_const (c := B)).clm_apply hInvW).clm_apply hInvW).add\n contDiffOn_const\n exact hQ.sqrt (fun z _ => ne_of_gt (by linarith [hBn (e.symm z)]))\n · intro δ hδ z hz w\n have hF : DifferentiableAt ℝ e.symm z :=\n (hInvW.contDiffAt (hW.mem_nhds hz)).differentiableAt_one\n have hE : DifferentiableAt ℝ e (e.symm z) :=\n (he.contDiffAt (Metric.isOpen_ball.mem_nhds hz.2.2)).differentiableAt (by simp)\n have hcomp := hE.hasFDerivAt.comp z hF.hasFDerivAt\n have hEq : (fun y => e (e.symm y)) =ᶠ[nhds z] id :=\n e.eventually_right_inverse hz.2.1\n have hid := hcomp.congr_of_eventuallyEq hEq.symm\n have hcancel : ∀ u, fderiv ℝ e (e.symm z) (fderiv ℝ e.symm z u) = u := by\n intro u\n exact congrArg (fun L : E →L[ℝ] E => L u) (hid.unique (hasFDerivAt_id z))\n apply Helpers.regularized_radius_fderiv_bound_of_gauss (g z) B\n (hsym z) (hnonneg z hz.1.2) hBsym hF (fderiv ℝ e (e.symm z)) ?_ hcancel hδ w\n intro u\n simpa only [e.right_inv hz.2.1, B, smul_apply, smul_eq_mul] using\n (hGauss (e.symm z) hz.2.2).2 u\ntheorem Helpers.exists_riemannian_normal_distance_data_of_local_bounds\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M] (p : M)\n (hLower : ∀ (g : E → E →L[ℝ] E →L[ℝ] ℝ),\n (∀ z ∈ (extChartAt I p).target, ∀ w : E,\n g z w w = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z w‖ ^ 2) →\n ∀ (B : E →L[ℝ] E →L[ℝ] ℝ), (∀ v : E, v ≠ 0 → 0 < B v v) →\n ∀ (e : OpenPartialHomeomorph E E), (0 : E) ∈ e.source →\n e 0 = extChartAt I p p → ∀ (W : Set E), IsOpen W → extChartAt I p p ∈ W →\n (∀ δ > (0 : ℝ), ContDiffOn ℝ 1\n (fun z => Real.sqrt (B (e.symm z) (e.symm z) + δ)) W) →\n (∀ δ > (0 : ℝ), ∀ z ∈ W, ∀ w : E,\n |fderiv ℝ (fun y => Real.sqrt (B (e.symm y) (e.symm y) + δ)) z w| ≤\n Real.sqrt (g z w w)) →\n ∃ V : Set M, IsOpen V ∧ p ∈ V ∧\n V ⊆ (extChartAt I p).source ∩ (extChartAt I p) ⁻¹' W ∧\n V ⊆ (extChartAt I p) ⁻¹' e.target ∧ ∀ q ∈ V,\n ENNReal.ofReal (Real.sqrt\n (B (e.symm (extChartAt I p q)) (e.symm (extChartAt I p q)))) ≤\n Manifold.riemannianEDist I p q)\n (hLipComp : ∀ (f : E → E), ContDiffAt ℝ 1 f (extChartAt I p p) →\n ∃ V : Set M, IsOpen V ∧ p ∈ V ∧ V ⊆ (extChartAt I p).source ∧\n ∃ K : NNReal, LipschitzOnWith K (fun q => f (extChartAt I p q)) V) :\n ∃ r > (0 : ℝ), ∃ g : E → E →L[ℝ] E →L[ℝ] ℝ,\n ∃ B : E →L[ℝ] E →L[ℝ] ℝ, ∃ e : OpenPartialHomeomorph E E,\n ContinuousOn g (extChartAt I p).target ∧\n (∀ z u v, g z u v = g z v u) ∧\n (∀ z ∈ (extChartAt I p).target, ∀ v, v ≠ 0 → 0 < g z v v) ∧\n (∀ z ∈ (extChartAt I p).target, ∀ v,\n g z v v = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z v‖ ^ 2) ∧\n (∀ u v, B u v = B v u) ∧ (∀ v, v ≠ 0 → 0 < B v v) ∧\n Metric.ball 0 r ⊆ e.source ∧ e 0 = extChartAt I p p ∧\n ContDiffOn ℝ ∞ e (Metric.ball 0 r) ∧\n (∀ v ∈ Metric.ball 0 r, e v ∈ (extChartAt I p).target ∧ ∀ w,\n g (e v) (fderiv ℝ e v v) (fderiv ℝ e v w) = B v w) ∧\n ∃ W : Set E, IsOpen W ∧ extChartAt I p p ∈ W ∧ W ⊆ e.target ∧\n ContDiffOn ℝ 1 e.symm W ∧\n ∃ V : Set M, IsOpen V ∧ p ∈ V ∧ V ⊆ (extChartAt I p).source ∧\n (∀ q ∈ V, extChartAt I p q ∈ W ∧\n e.symm (extChartAt I p q) ∈ Metric.ball 0 r) ∧\n (∃ K : NNReal, LipschitzOnWith K (fun q => e.symm (extChartAt I p q)) V) ∧\n ∀ q ∈ V, edist p q = ENNReal.ofReal\n (Real.sqrt (B (e.symm (extChartAt I p q)) (e.symm (extChartAt I p q)))) := by\n obtain ⟨g, Γ, hg, hsym, hpos, hnorm, hΓ, hKoszul⟩ :=\n Helpers.exists_smooth_coordinate_metric_and_koszul I p\n obtain ⟨τ, hτ, r, hr, e, he0, hep, he, hGauss, W, hW, hpW,\n hWU, hWr, hInv, hsmooth, hbound⟩ :=\n Helpers.exists_coordinate_normal_radius_control (isOpen_extChartAt_target p)\n hg hsym hpos hΓ hKoszul (mem_extChartAt_target p)\n obtain ⟨s, hs, hsource⟩ := Metric.mem_nhds_iff.mp (e.open_source.mem_nhds he0)\n let r' : ℝ := min r s\n have hr' : 0 < r' := lt_min hr hs\n have hrr : Metric.ball (0 : E) r' ⊆ Metric.ball 0 r :=\n Metric.ball_subset_ball (min_le_left r s)\n have hrs : Metric.ball (0 : E) r' ⊆ e.source :=\n (Metric.ball_subset_ball (min_le_right r s)).trans hsource\n let W' := W ∩ (e.target ∩ e.symm ⁻¹' Metric.ball 0 r')\n have hW' : IsOpen W' :=\n hW.inter (e.isOpen_inter_preimage_symm Metric.isOpen_ball)\n have hInvp : e.symm (extChartAt I p p) = 0 := by\n rw [← hep]\n exact e.left_inv he0\n have hpW' : extChartAt I p p ∈ W' := by\n refine ⟨hpW, (hWU hpW).2, ?_⟩\n change e.symm (extChartAt I p p) ∈ Metric.ball 0 r'\n rw [hInvp]\n exact Metric.mem_ball_self hr'\n let B : E →L[ℝ] E →L[ℝ] ℝ := τ ^ 2 • g (extChartAt I p p)\n have hBpos : ∀ v : E, v ≠ 0 → 0 < B v v := by\n intro v hv\n exact mul_pos (sq_pos_of_pos hτ) (hpos _ (mem_extChartAt_target p) v hv)\n have hBsym : ∀ u v, B u v = B v u := by\n intro u v\n change τ ^ 2 * g _ u v = τ ^ 2 * g _ v u\n rw [hsym]\n have hradial : ∀ v ∈ Metric.ball 0 r', e v ∈ (extChartAt I p).target ∧ ∀ w,\n g (e v) (fderiv ℝ e v v) (fderiv ℝ e v w) = B v w := by\n intro v hv\n exact hGauss v (hrr hv)\n obtain ⟨V, hV, hpV, hVW', hVe, hdist⟩ :=\n hLower g hnorm B hBpos e he0 hep\n W' hW' hpW'\n (fun δ hδ => (hsmooth δ hδ).mono Set.inter_subset_left)\n (fun δ hδ z hz w => hbound δ hδ z hz.1 w)\n obtain ⟨A, hA, hpA, hAsource, K, hLip⟩ :=\n hLipComp e.symm\n (hInv.contDiffAt (hW.mem_nhds hpW))\n refine ⟨r', hr', g, B, e, hg.continuousOn, hsym, hpos, hnorm, hBsym, hBpos,\n hrs, hep, he.mono hrr, hradial, W, hW, hpW, (fun z hz => (hWU hz).2), hInv,\n V ∩ A, hV.inter hA, ⟨hpV, hpA⟩, (fun q hq => (hVW' hq.1).1), ?_,\n ⟨K, hLip.mono Set.inter_subset_right⟩, ?_⟩\n · intro q hq\n exact ⟨(hVW' hq.1).2.1, (hVW' hq.1).2.2.2⟩\n · intro q hq\n rw [IsRiemannianManifold.out (I := I)]\n apply le_antisymm ?_ (hdist q hq.1)\n have hu : e.symm (extChartAt I p q) ∈ Metric.ball 0 r' := (hVW' hq.1).2.2.2\n have hn : 0 ≤ B (e.symm (extChartAt I p q)) (e.symm (extChartAt I p q)) := by\n rw [← (hradial _ hu).2 _, hnorm _ (hradial _ hu).1]\n exact sq_nonneg _\n have hupper := Helpers.riemannianEDist_radial_le I p g hg.continuousOn hnorm B e r'\n ((he.mono hrr).of_le (by simp)) (fun v hv => (hradial v hv).1)\n (fun v hv => (hradial v hv).2 v) (e.symm (extChartAt I p q)) hu hn\n simpa only [hep, e.right_inv (hVe hq.1),\n (extChartAt I p).left_inv (mem_extChartAt_source p),\n (extChartAt I p).left_inv (hVW' hq.1).1] using hupper\ntheorem Helpers.edist_extChartAt_le_mul_pathELength\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M] [IsManifold I 1 M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n (p : M) (U : Set M) (hU : U ⊆ (extChartAt I p).source) (C : NNReal)\n (hC : ∀ x ∈ U, ∀ v : TangentSpace I x,\n @enorm E _ (mfderiv I (modelWithCornersSelf ℝ E) (extChartAt I p) x v) ≤ C * ‖v‖ₑ)\n (γ : ℝ → M) (a b : ℝ) (hab : a ≤ b)\n (hγ : ContMDiffOn (modelWithCornersSelf ℝ ℝ) I 1 γ (Set.Icc a b))\n (hγU : Set.MapsTo γ (Set.Icc a b) U) :\n edist (extChartAt I p (γ a)) (extChartAt I p (γ b)) ≤\n C * Manifold.pathELength I γ a b := by\n letI : (x : E) → NormedAddCommGroup (TangentSpace (modelWithCornersSelf ℝ E) x) :=\n fun x => normedAddCommGroupTangentSpaceVectorSpace x\n letI : (x : E) → NormedSpace ℝ (TangentSpace (modelWithCornersSelf ℝ E) x) :=\n fun x => normedSpaceTangentSpaceVectorSpace x\n rcases hab.eq_or_lt with rfl | hab\n · simp\n let f := extChartAt I p ∘ γ\n have hf : ContDiffOn ℝ 1 f (Set.Icc a b) :=\n contMDiffOn_iff_contDiffOn.mp\n (contMDiffOn_extChartAt.comp (I' := I) (t := (chartAt H p).source) hγ (fun t ht => by\n simpa only [Set.mem_preimage, extChartAt_source] using hU (hγU ht)))\n rw [edist_comm, edist_eq_enorm_sub]\n calc\n ‖f b - f a‖ₑ ≤ ∫⁻ t in Set.Icc a b, ‖derivWithin f (Set.Icc a b) t‖ₑ :=\n enorm_sub_le_lintegral_derivWithin_Icc_of_contDiffOn_Icc hf hab.le\n _ = ∫⁻ t in Set.Icc a b,\n ‖mfderivWithin (modelWithCornersSelf ℝ ℝ) (modelWithCornersSelf ℝ E)\n f (Set.Icc a b) t 1‖ₑ := by\n simp_rw [← fderivWithin_derivWithin, mfderivWithin_eq_fderivWithin]\n rfl\n _ ≤ ∫⁻ t in Set.Icc a b, C *\n ‖mfderivWithin (modelWithCornersSelf ℝ ℝ) I γ (Set.Icc a b) t 1‖ₑ := by\n apply MeasureTheory.setLIntegral_mono' measurableSet_Icc\n intro t ht\n have hd := mfderiv_comp_mfderivWithin t\n (mdifferentiableAt_extChartAt (by\n simpa only [Set.mem_preimage, extChartAt_source] using hU (hγU ht)))\n ((hγ t ht).mdifferentiableWithinAt one_ne_zero)\n (uniqueMDiffWithinAt_iff_uniqueDiffWithinAt.mpr (uniqueDiffOn_Icc hab t ht))\n change ‖mfderivWithin (modelWithCornersSelf ℝ ℝ) (modelWithCornersSelf ℝ E)\n (extChartAt I p ∘ γ) (Set.Icc a b) t 1‖ₑ ≤ _\n rw [hd, ContinuousLinearMap.comp_apply]\n exact hC _ (hγU ht) _\n _ = C * Manifold.pathELength I γ a b := by\n rw [MeasureTheory.lintegral_const_mul' _ _ ENNReal.coe_ne_top,\n Manifold.pathELength_eq_lintegral_mfderivWithin_Icc]\ntheorem Helpers.exists_lipschitzOnWith_extChartAt\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)\n [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M]\n [LocallyCompactSpace M] [ConnectedSpace M] (p : M) :\n ∃ V : Set M, IsOpen V ∧ p ∈ V ∧ V ⊆ (extChartAt I p).source ∧\n ∃ K : NNReal, LipschitzOnWith K (extChartAt I p) V := by\n letI : MetricSpace M := EMetricSpace.toMetricSpace Helpers.edist_ne_top_of_preconnected\n letI : (x : E) → NormedAddCommGroup (TangentSpace (modelWithCornersSelf ℝ E) x) :=\n fun x => normedAddCommGroupTangentSpaceVectorSpace x\n letI : (x : E) → NormedSpace ℝ (TangentSpace (modelWithCornersSelf ℝ E) x) :=\n fun x => normedSpaceTangentSpaceVectorSpace x\n obtain ⟨C, hCpos, hC⟩ := eventually_enorm_mfderiv_extChartAt_lt I p\n have hCpos' : (0 : ℝ) < C := hCpos\n obtain ⟨r, hr, hrU⟩ := Metric.mem_nhds_iff.mp\n (Filter.inter_mem hC (extChartAt_source_mem_nhds (I := I) p))\n have hbound : ∀ x ∈ Metric.ball p r, ∀ v : TangentSpace I x,\n @enorm E _ (mfderiv I (modelWithCornersSelf ℝ E) (extChartAt I p) x v) ≤\n C * ‖v‖ₑ := by\n intro x hx v\n apply (ContinuousLinearMap.le_opENorm _ _).trans\n gcongr\n exact (hrU hx).1.le\n have hsource : Metric.ball p r ⊆ (extChartAt I p).source := fun x hx => (hrU hx).2\n have hnb : Metric.ball p (r / 4) ∩\n (extChartAt I p) ⁻¹' Metric.ball (extChartAt I p p) ((C : ℝ) * r / 4) ∈ nhds p :=\n Filter.inter_mem (Metric.ball_mem_nhds p (by positivity))\n ((continuousAt_extChartAt p).preimage_mem_nhds\n (Metric.ball_mem_nhds _ (by positivity)))\n obtain ⟨ε, hε, hεV⟩ := Metric.mem_nhds_iff.mp hnb\n have hsmall : Metric.ball p ε ⊆ Metric.ball p r := by\n intro x hx\n have := Metric.mem_ball.mp (hεV hx).1\n exact Metric.mem_ball.mpr (by linarith)\n refine ⟨Metric.ball p ε, Metric.isOpen_ball, Metric.mem_ball_self hε,\n fun x hx => hsource (hsmall hx), C, ?_⟩\n apply LipschitzOnWith.of_dist_le_mul\n intro x hx y hy\n by_contra h\n have hlt : (C : ℝ) * dist x y < dist (extChartAt I p x) (extChartAt I p y) :=\n lt_of_not_ge h\n have hquot : dist x y < dist (extChartAt I p x) (extChartAt I p y) / C :=\n (lt_div_iff₀ hCpos').mpr (by simpa only [mul_comm] using hlt)\n have hpos : 0 < dist (extChartAt I p x) (extChartAt I p y) / C :=\n (dist_nonneg.trans_lt hquot)\n have hriem : Manifold.riemannianEDist I x y <\n ENNReal.ofReal (dist (extChartAt I p x) (extChartAt I p y) / C) := by\n rw [← IsRiemannianManifold.out (I := I), edist_dist]\n exact (ENNReal.ofReal_lt_ofReal_iff hpos).mpr hquot\n obtain ⟨γ, hγ0, hγ1, hγ, hlen⟩ := Manifold.exists_lt_of_riemannianEDist_lt hriem\n have hfinite : Manifold.pathELength I γ 0 1 ≠ ⊤ :=\n (hlen.trans ENNReal.ofReal_lt_top).ne\n have hlen' : (Manifold.pathELength I γ 0 1).toReal <\n dist (extChartAt I p x) (extChartAt I p y) / C := by\n have := (ENNReal.toReal_lt_toReal hfinite ENNReal.ofReal_ne_top).mpr hlen\n simpa only [ENNReal.toReal_ofReal hpos.le] using this\n by_cases hstay : Set.MapsTo γ (Set.Icc (0 : ℝ) 1) (Metric.ball p r)\n · have hb := Helpers.edist_extChartAt_le_mul_pathELength I p (Metric.ball p r)\n hsource C hbound γ 0 1 zero_le_one hγ hstay\n have hb' := ENNReal.toReal_mono\n (ENNReal.mul_ne_top ENNReal.coe_ne_top hfinite) hb\n simp only [hγ0, hγ1, edist_dist, ENNReal.toReal_ofReal dist_nonneg,\n ENNReal.toReal_mul, ENNReal.coe_toReal] at hb'\n have hlen'' := (lt_div_iff₀ hCpos').mp hlen'\n nlinarith\n · obtain ⟨t, ht, htU⟩ : ∃ t ∈ Set.Icc (0 : ℝ) 1, γ t ∉ Metric.ball p r := by\n simpa only [Set.MapsTo, not_forall, exists_prop] using hstay\n have hrle : r ≤ dist (γ t) p := not_lt.mp (by simpa only [Metric.mem_ball] using htU)\n have hpre : edist x (γ t) ≤ Manifold.pathELength I γ 0 1 := by\n rw [IsRiemannianManifold.out (I := I)]\n exact (Manifold.riemannianEDist_le_pathELength\n (hγ.mono (Set.Icc_subset_Icc le_rfl ht.2)) hγ0 rfl ht.1).trans\n (Manifold.pathELength_mono le_rfl ht.2)\n have hpre' := ENNReal.toReal_mono hfinite hpre\n simp only [edist_dist, ENNReal.toReal_ofReal dist_nonneg] at hpre'\n have hx' := Metric.mem_ball.mp (hεV hx).1\n have hfx := Metric.mem_ball.mp (hεV hx).2\n have hfy := Metric.mem_ball.mp (hεV hy).2\n have hdiam := dist_triangle (extChartAt I p x) (extChartAt I p p) (extChartAt I p y)\n rw [dist_comm (extChartAt I p p)] at hdiam\n have htri := dist_triangle (γ t) x p\n rw [dist_comm (γ t) x] at htri\n have hlen'' := (lt_div_iff₀ hCpos').mp hlen'\n nlinarith\ntheorem Helpers.exists_lipschitzOnWith_smooth_chart_comp\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M]\n (p : M) (f : E → E) (hf : ContDiffAt ℝ 1 f (extChartAt I p p)) :\n ∃ V : Set M, IsOpen V ∧ p ∈ V ∧ V ⊆ (extChartAt I p).source ∧\n ∃ K : NNReal, LipschitzOnWith K (fun q => f (extChartAt I p q)) V := by\n obtain ⟨U, hU, hpU, hUsource, K, hK⟩ := Helpers.exists_lipschitzOnWith_extChartAt I M p\n obtain ⟨L, A, hA, hL⟩ := hf.exists_lipschitzOnWith\n have hpre : (extChartAt I p) ⁻¹' A ∈ nhds p :=\n (continuousAt_extChartAt p).preimage_mem_nhds hA\n obtain ⟨V, hVU, hV, hpV⟩ := mem_nhds_iff.mp (Filter.inter_mem (hU.mem_nhds hpU) hpre)\n refine ⟨V, hV, hpV, (fun q hq => hUsource (hVU hq).1), L * K, ?_⟩\n exact hL.comp (hK.mono (fun q hq => (hVU hq).1)) (fun q hq => (hVU hq).2)\ntheorem Helpers.metric_segment_endpoint_of_isGeodesicallyComplete\n {M : Type*} [MetricSpace M] (hgc : IsGeodesicallyComplete M)\n (b : ℝ) (γ : ℝ → M) (hb : 0 < b)\n (hdist : ∀ s ∈ Set.Ioo 0 b, ∀ t ∈ Set.Ioo 0 b, dist (γ s) (γ t) = |t-s|) :\n ∃ p, Filter.Tendsto γ (nhdsWithin b (Set.Ioo 0 b)) (nhds p) := by\n obtain ⟨η,⟨c,hη⟩,heq⟩ := hgc 0 b γ hb (by\n refine ⟨1,?_⟩\n intro t₀ ht₀\n refine ⟨1,zero_lt_one,?_⟩\n intro s t hs ht\n have hs' : s ∈ Set.Ioo 0 b := ⟨lt_of_le_of_lt (le_max_left _ _) hs.1,\n lt_of_lt_of_le hs.2 (min_le_left _ _)⟩\n have ht' : t ∈ Set.Ioo 0 b := ⟨lt_of_le_of_lt (le_max_left _ _) ht.1,\n lt_of_lt_of_le ht.2 (min_le_left _ _)⟩\n simpa only [ENNReal.coe_one,one_mul,edist_dist] using\n congrArg ENNReal.ofReal (hdist s hs' t ht'))\n refine ⟨η b,Metric.tendsto_nhdsWithin_nhds.2 ?_⟩\n intro ε hε\n obtain ⟨δ,hδ,hηδ⟩ := hη b\n refine ⟨min δ (ε/((c:ℝ)+1)),lt_min hδ (div_pos hε (by positivity)),?_⟩\n intro t ht htd\n have htδ : |t-b| < δ := by\n exact lt_of_lt_of_le (by simpa only [Real.dist_eq] using htd) (min_le_left _ _)\n have htd' : |b-t| < ε/((c:ℝ)+1) := by\n exact lt_of_lt_of_le (by simpa only [Real.dist_eq,abs_sub_comm] using htd) (min_le_right _ _)\n have he := hηδ t b htδ (by simpa using hδ)\n have hde : dist (η t) (η b) = (c:ℝ)*|b-t| := by\n simpa [dist_edist,ENNReal.toReal_mul] using congrArg ENNReal.toReal he\n rw [heq t ht] at hde\n rw [hde]\n have hmul := (lt_div_iff₀ (by positivity : 0 < (c:ℝ)+1)).1 htd'\n nlinarith [abs_nonneg (b-t)]\ntheorem Helpers.completeSpace_of_isGeodesicallyComplete\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)\n [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M]\n [IsManifold I (↑(⊤ : ℕ∞) : WithTop ℕ∞) M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I (↑(⊤ : ℕ∞) : WithTop ℕ∞) E\n (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M]\n [LocallyCompactSpace M] [ConnectedSpace M] :\n IsGeodesicallyComplete M → CompleteSpace M := by\n intro hgc\n letI : MetricSpace M := EMetricSpace.toMetricSpace (Helpers.edist_ne_top_of_preconnected)\n apply Helpers.completeSpace_of_metric_segment_limits\n · exact (open scoped Bundle in by\n intro x y r ε hr hrd hε\n exact Helpers.riemannian_approximate_radial_split I\n (fun x y => IsRiemannianManifold.out (I := I) x y) x y r ε hr hrd hε)\n · exact Helpers.metric_segment_endpoint_of_isGeodesicallyComplete hgc\ntheorem Helpers.isGeodesicallyComplete_of_endpointGerm : open Bundle in\n ∀ (M : Type*) [EMetricSpace M] [CompleteSpace M],\n let L : (ℝ → M) → NNReal → Set ℝ → Prop := fun γ c S =>\n ∀ t₀ ∈ S, ∃ δ > (0 : ℝ), ∀ s t : ℝ,\n s ∈ S ∩ Set.Ioo (t₀ - δ) (t₀ + δ) →\n t ∈ S ∩ Set.Ioo (t₀ - δ) (t₀ + δ) →\n edist (γ s) (γ t) = (c : ENNReal) * ENNReal.ofReal |t - s|\n (∀ (a b : ℝ) (γ : ℝ → M) (c : NNReal) (p : M),\n a < b → L γ c (Set.Ioo a b) →\n Filter.Tendsto γ (nhdsWithin b (Set.Ioo a b)) (nhds p) →\n ∃ ε > (0 : ℝ), ∃ η : ℝ → M,\n L η c (Set.Ioo (b - ε) (b + ε)) ∧\n ∀ t ∈ Set.Ioo (max a (b - ε)) b, η t = γ t) →\n LeanEval.Geometry.IsGeodesicallyComplete M := by\n intro M _ _\n dsimp only\n intro hG a b γ hab hγ\n obtain ⟨c, hc⟩ := hγ\n have hlin : Helpers.MetricLocallyLinear γ c (Set.Ioo a b) := by\n intro t₀ ht₀\n obtain ⟨δ, hδ, H⟩ := hc t₀ ht₀\n refine ⟨δ, hδ, fun s t hs ht => H s t ?_ ?_⟩\n · exact ⟨max_lt hs.1.1 hs.2.1, lt_min hs.1.2 hs.2.2⟩\n · exact ⟨max_lt ht.1.1 ht.2.1, lt_min ht.1.2 ht.2.2⟩\n obtain ⟨η, hη, heq⟩ :=\n Helpers.exists_global_locallyLinear_extension_of_endpointGerm M hG a b γ c hab hlin\n refine ⟨η, ⟨c, ?_⟩, heq⟩\n intro t₀\n obtain ⟨δ, hδ, H⟩ := hη t₀ (Set.mem_univ _)\n refine ⟨δ, hδ, fun s t hs ht => H s t ⟨Set.mem_univ _, ?_⟩\n ⟨Set.mem_univ _, ?_⟩⟩\n · obtain ⟨hs₁, hs₂⟩ := abs_lt.mp hs\n exact ⟨by linarith, by linarith⟩\n · obtain ⟨ht₁, ht₂⟩ := abs_lt.mp ht\n exact ⟨by linarith, by linarith⟩\ntheorem Helpers.enorm_sqrt_sub_le_pathELength_of_chart_regularized_bound : open scoped Bundle in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M] [IsManifold I 1 M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n (p : M) (g : E → E →L[ℝ] E →L[ℝ] ℝ)\n (hg : ∀ z ∈ (extChartAt I p).target, ∀ w : E,\n g z w w = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z w‖ ^ 2)\n (W : Set E) (hW : IsOpen W) (q : E → ℝ)\n (hsmooth : ∀ δ > (0 : ℝ),\n ContDiffOn ℝ 1 (fun z => Real.sqrt (q z + δ)) W)\n (hbound : ∀ δ > (0 : ℝ), ∀ z ∈ W, ∀ w : E,\n |fderiv ℝ (fun y => Real.sqrt (q y + δ)) z w| ≤ Real.sqrt (g z w w))\n (γ : ℝ → M) (a b : ℝ) (hab : a ≤ b)\n (hγ : ContMDiffOn (modelWithCornersSelf ℝ ℝ) I 1 γ (Set.Icc a b))\n (hγW : Set.MapsTo γ (Set.Icc a b)\n ((extChartAt I p).source ∩ (extChartAt I p) ⁻¹' W)),\n enorm (Real.sqrt (q (extChartAt I p (γ b))) -\n Real.sqrt (q (extChartAt I p (γ a)))) ≤ Manifold.pathELength I γ a b := by\n intro E _ _ H _ I M _ _ _ _ p g hg W hW q hsmooth hbound γ a b hab hγ hγW\n exact (open scoped Bundle in by\n letI : (y : M) → NormedAddCommGroup (TangentSpace I y) := fun y =>\n Bundle.instNormedAddCommGroupOfRiemannianBundleOfIsTopologicalAddGroupOfContinuousConstSMulReal\n (E := fun x : M => TangentSpace I x) y\n have hlim (x : M) : Filter.Tendsto\n (fun δ : ℝ => Real.sqrt (q (extChartAt I p x) + δ))\n (nhdsWithin 0 (Set.Ioi 0)) (nhds (Real.sqrt (q (extChartAt I p x)))) := by\n have hc : Continuous (fun δ : ℝ => Real.sqrt (q (extChartAt I p x) + δ)) := by\n fun_prop\n simpa only [add_zero] using\n (hc.continuousAt (x := 0)).tendsto.mono_left nhdsWithin_le_nhds\n apply le_of_tendsto (continuous_enorm.continuousAt.tendsto.comp\n ((hlim (γ b)).sub (hlim (γ a))))\n filter_upwards [self_mem_nhdsWithin] with δ hδ\n apply Helpers.enorm_sub_le_pathELength_of_coordinate_bound I\n ((extChartAt I p).source ∩ (extChartAt I p) ⁻¹' W)\n (isOpen_extChartAt_preimage' p hW) W hW (extChartAt I p)\n (contMDiffOn_extChartAt.mono (fun _ hx => by\n simpa only [extChartAt_source] using hx.1)) (fun _ hx => hx.2)\n (fun z => Real.sqrt (q z + δ)) (hsmooth δ hδ) ?_ γ a b hab hγ hγW\n intro x hx v\n rw [Real.enorm_eq_ofReal_abs, ← ofReal_norm]\n apply ENNReal.ofReal_le_ofReal\n exact (hbound δ hδ _ hx.2 _).trans_eq\n (Helpers.sqrt_coordinate_metric_chart_derivative_eq_norm p g hg x hx.1 v))\ntheorem Helpers.exists_normal_radius_lower_bound : open scoped Bundle in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n {M : Type*} [TopologicalSpace M] [T2Space M] [ChartedSpace H M] [IsManifold I 1 M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n (p : M) (g : E → E →L[ℝ] E →L[ℝ] ℝ)\n (hg : ∀ z ∈ (extChartAt I p).target, ∀ w : E,\n g z w w = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z w‖ ^ 2)\n (B : E →L[ℝ] E →L[ℝ] ℝ) (hpos : ∀ v : E, v ≠ 0 → 0 < B v v)\n (e : OpenPartialHomeomorph E E) (he0 : (0 : E) ∈ e.source)\n (hep : e 0 = extChartAt I p p) (W : Set E) (hW : IsOpen W)\n (hpW : extChartAt I p p ∈ W)\n (hsmooth : ∀ δ > (0 : ℝ), ContDiffOn ℝ 1\n (fun z => Real.sqrt (B (e.symm z) (e.symm z) + δ)) W)\n (hbound : ∀ δ > (0 : ℝ), ∀ z ∈ W, ∀ w : E,\n |fderiv ℝ (fun y => Real.sqrt (B (e.symm y) (e.symm y) + δ)) z w| ≤\n Real.sqrt (g z w w)),\n ∃ V : Set M, IsOpen V ∧ p ∈ V ∧\n V ⊆ (extChartAt I p).source ∩ (extChartAt I p) ⁻¹' W ∧\n V ⊆ (extChartAt I p) ⁻¹' e.target ∧\n ∀ q ∈ V, ENNReal.ofReal\n (Real.sqrt (B (e.symm (extChartAt I p q)) (e.symm (extChartAt I p q)))) ≤\n Manifold.riemannianEDist I p q := by\n intro E _ _ _ H _ I _ M _ _ _ _ _ p g hg B hpos e he0 hep W hW hpW hsmooth hbound\n let c : OpenPartialHomeomorph M E := {\n toPartialEquiv := extChartAt I p\n open_source := isOpen_extChartAt_source p\n open_target := isOpen_extChartAt_target p\n continuousOn_toFun := continuousOn_extChartAt p\n continuousOn_invFun := continuousOn_extChartAt_symm p }\n let f : OpenPartialHomeomorph E M := e.trans c.symm\n have hf0 : (0 : E) ∈ f.source :=\n ⟨he0, by change e 0 ∈ (extChartAt I p).target; rw [hep]; exact mem_extChartAt_target p⟩\n have hfp : f 0 = p := by\n change (extChartAt I p).symm (e 0) = p\n rw [hep]\n exact (extChartAt I p).left_inv (mem_extChartAt_source p)\n let A := (extChartAt I p).source ∩ (extChartAt I p) ⁻¹' W\n have hA : IsOpen A := isOpen_extChartAt_preimage' p hW\n obtain ⟨k,hk,V,hV,hV0,hVA,hVf,hfront,hinside⟩ :=\n Helpers.exists_inner_bilinear_radius_neighborhood B hpos f hf0 A hA\n (by rw [hfp]; exact ⟨mem_extChartAt_source p,hpW⟩)\n have hpV : p ∈ V := hfp ▸ hV0\n have hsub (q : M) (hq : q ∈ V) : q ∈ f.target := hVf (subset_closure hq)\n refine ⟨V,hV,hpV,(fun q hq => hVA (subset_closure hq)),\n (fun q hq => (hsub q hq).2),?_⟩\n intro q hq\n letI : (x : M) → NormedAddCommGroup (TangentSpace I x) := fun x =>\n Bundle.instNormedAddCommGroupOfRiemannianBundleOfIsTopologicalAddGroupOfContinuousConstSMulReal\n (E := fun x : M => TangentSpace I x) x\n apply Helpers.ofReal_radius_le_riemannianEDist_of_first_exit I A V hV hVA\n (fun y => Real.sqrt (B (f.symm y) (f.symm y))) p q k hpV\n · have hzero : f.symm p = 0 := by rw [← hfp]; exact f.left_inv hf0\n simp only [hzero,map_zero,ContinuousLinearMap.zero_apply,Real.sqrt_zero]\n · exact Real.sqrt_nonneg _\n · exact (hinside q hq).le\n · exact hfront\n · intro γ a b hab hγ hγA\n exact Helpers.enorm_sqrt_sub_le_pathELength_of_chart_regularized_bound I p g hg W hW\n (fun z => B (e.symm z) (e.symm z)) hsmooth hbound γ a b hab hγ hγA\ntheorem Helpers.exists_riemannian_normal_distance_data\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M] (p : M) :\n ∃ r > (0 : ℝ), ∃ g : E → E →L[ℝ] E →L[ℝ] ℝ,\n ∃ B : E →L[ℝ] E →L[ℝ] ℝ, ∃ e : OpenPartialHomeomorph E E,\n ContinuousOn g (extChartAt I p).target ∧\n (∀ z u v, g z u v = g z v u) ∧\n (∀ z ∈ (extChartAt I p).target, ∀ v, v ≠ 0 → 0 < g z v v) ∧\n (∀ z ∈ (extChartAt I p).target, ∀ v,\n g z v v = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z v‖ ^ 2) ∧\n (∀ u v, B u v = B v u) ∧ (∀ v, v ≠ 0 → 0 < B v v) ∧\n Metric.ball 0 r ⊆ e.source ∧ e 0 = extChartAt I p p ∧\n ContDiffOn ℝ ∞ e (Metric.ball 0 r) ∧\n (∀ v ∈ Metric.ball 0 r, e v ∈ (extChartAt I p).target ∧ ∀ w,\n g (e v) (fderiv ℝ e v v) (fderiv ℝ e v w) = B v w) ∧\n ∃ W : Set E, IsOpen W ∧ extChartAt I p p ∈ W ∧ W ⊆ e.target ∧\n ContDiffOn ℝ 1 e.symm W ∧\n ∃ V : Set M, IsOpen V ∧ p ∈ V ∧ V ⊆ (extChartAt I p).source ∧\n (∀ q ∈ V, extChartAt I p q ∈ W ∧\n e.symm (extChartAt I p q) ∈ Metric.ball 0 r) ∧\n (∃ K : NNReal, LipschitzOnWith K (fun q => e.symm (extChartAt I p q)) V) ∧\n ∀ q ∈ V, edist p q = ENNReal.ofReal\n (Real.sqrt (B (e.symm (extChartAt I p q)) (e.symm (extChartAt I p q)))) := by\n exact Helpers.exists_riemannian_normal_distance_data_of_local_bounds I M p\n (Helpers.exists_normal_radius_lower_bound I p)\n (Helpers.exists_lipschitzOnWith_smooth_chart_comp I M p)\ntheorem Helpers.metric_speed_eq_of_hasDerivAt_center_chart\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M]\n (p : M) {γ : ℝ → M} {t₀ : ℝ} {c : NNReal} {v : E}\n (hγ : ContinuousAt γ t₀) (hγ₀ : γ t₀ = p)\n (hx : HasDerivAt (fun t => extChartAt I p (γ t)) v t₀)\n (hlinear : ∀ᶠ t in nhds t₀,\n edist p (γ t) = (c : ENNReal) * ENNReal.ofReal |t - t₀|) :\n ‖mfderivWithin (modelWithCornersSelf ℝ E) I (extChartAt I p).symm\n (Set.range I) (extChartAt I p p) v‖ ^ 2 = (c : ℝ) ^ 2 := by\n obtain ⟨r, hr, g, B, e, hg, hsym, hpos, hnorm, hBsym, hBpos, hsource,\n hep, he, hGauss, W, hW, hpW, hWt, hInv, V, hV, hpV, hVs, hVi, hLip, hdist⟩ :=\n Helpers.exists_riemannian_normal_distance_data I M p\n have hz : (0 : E) ∈ Metric.ball 0 r := Metric.mem_ball_self hr\n have hmetric : ∀ w, g (e 0) (fderiv ℝ e 0 w) (fderiv ℝ e 0 w) = B w w :=\n Helpers.radial_metric_at_zero hr B hg (he.of_le (by simp))\n (fun u hu => (hGauss u hu).1) (fun u hu => (hGauss u hu).2 u)\n have hB : ∀ w, 0 ≤ B w w := by\n intro w\n rw [← hmetric w, hnorm _ (hGauss 0 hz).1]\n exact sq_nonneg _\n have hEDiff : DifferentiableAt ℝ e 0 :=\n (he.contDiffAt (Metric.isOpen_ball.mem_nhds hz)).differentiableAt (by simp)\n have hIDiff : DifferentiableAt ℝ e.symm (e 0) := by\n rw [hep]\n exact (hInv.contDiffAt (hW.mem_nhds hpW)).differentiableAt_one\n have hs := Helpers.energy_eq_of_local_normal_distance (extChartAt I p) p (g (e 0)) B e\n (hsource hz) hep.symm hEDiff hIDiff hmetric hB (hV.mem_nhds hpV) hdist\n hγ hγ₀ hx hlinear\n rw [hep, hnorm _ (mem_extChartAt_target p)] at hs\n exact hs\ntheorem Helpers.metric_speed_eq_of_hasDerivAt_chart\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M]\n (p : M) {γ : ℝ → M} {t₀ : ℝ} {c : NNReal} {v : E}\n (hγ : ContinuousAt γ t₀) (hp : γ t₀ ∈ (extChartAt I p).source)\n (hx : HasDerivAt (fun t => extChartAt I p (γ t)) v t₀)\n (hlinear : ∀ᶠ t in nhds t₀,\n edist (γ t₀) (γ t) = (c : ENNReal) * ENNReal.ofReal |t - t₀|) :\n ‖mfderivWithin (modelWithCornersSelf ℝ E) I (extChartAt I p).symm\n (Set.range I) (extChartAt I p (γ t₀)) v‖ ^ 2 = (c : ℝ) ^ 2 := by\n exact Helpers.chart_speed_eq_of_center_chart_speed I p hγ hp hx\n (fun w hw => Helpers.metric_speed_eq_of_hasDerivAt_center_chart I M (γ t₀)\n hγ rfl hw hlinear)\ntheorem Helpers.exists_riemannian_radial_rigidity_chart\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M] (p : M) :\n ∃ r > (0 : ℝ), ∃ e : OpenPartialHomeomorph E E,\n Metric.ball 0 r ⊆ e.source ∧ e 0 = extChartAt I p p ∧\n ContDiffOn ℝ ∞ e (Metric.ball 0 r) ∧\n ∃ V : Set M, IsOpen V ∧ p ∈ V ∧ V ⊆ (extChartAt I p).source ∧\n ∀ (γ : ℝ → M) (c : NNReal) (A D a b t₀ : ℝ),\n 0 < c → A < a → a ≤ b → b < D → t₀ < a →\n Helpers.MetricLocallyLinear γ c (Set.Ioo A D) →\n Set.MapsTo γ (Set.Icc a b) V →\n (∀ t ∈ Set.Icc a b, edist p (γ t) =\n (c : ENNReal) * ENNReal.ofReal (t - t₀)) →\n ∃ w : E, ∀ t ∈ Set.Icc a b,\n e.symm (extChartAt I p (γ t)) = (t - t₀) • w ∧\n γ t = (extChartAt I p).symm (e ((t - t₀) • w)) := by\n obtain ⟨r, hr, g, B, e, hg, hsym, hpos, hnorm, hBsym, hBpos, hsource,\n hep, he, hGauss, W, hW, hpW, hWt, hInv, V, hV, hpV, hVs, hVi,\n ⟨K, hLip⟩, hdist⟩ := Helpers.exists_riemannian_normal_distance_data I M p\n refine ⟨r, hr, e, hsource, hep, he, V, hV, hpV, hVs, ?_⟩\n intro γ c A D a b t₀ hc hAa hab hbD ht₀ hlin hγV hAnchor\n have hSub : Set.Icc a b ⊆ Set.Ioo A D := by\n intro t ht\n exact ⟨hAa.trans_le ht.1, ht.2.trans_lt hbD⟩\n have hMaps (t : ℝ) (ht : t ∈ Set.Icc a b) :\n extChartAt I p (γ t) ∈ e.target ∧\n e.symm (extChartAt I p (γ t)) ∈ Metric.ball 0 r :=\n ⟨hWt (hVi (γ t) (hγV ht)).1, (hVi (γ t) (hγV ht)).2⟩\n have hSharp (t : ℝ) (ht : t ∈ Set.Icc a b) (v : E)\n (hv : HasDerivAt (fun s => extChartAt I p (γ s)) v t) :\n g (extChartAt I p (γ t)) v v = (c : ℝ) ^ 2 := by\n rw [hnorm _ ((extChartAt I p).map_source (hVs (hγV ht))) v]\n exact Helpers.metric_speed_eq_of_hasDerivAt_chart I M p\n (hlin.continuousAt isOpen_Ioo (hSub ht)) (hVs (hγV ht)) hv\n (hlin.eventually_edist_eq isOpen_Ioo (hSub ht))\n have hRadius (t : ℝ) (ht : t ∈ Set.Icc a b) :\n Real.sqrt (B (e.symm (extChartAt I p (γ t))) (e.symm (extChartAt I p (γ t)))) =\n (c : ℝ) * (t - t₀) := by\n apply (ENNReal.ofReal_eq_ofReal_iff (Real.sqrt_nonneg _)\n (mul_nonneg c.coe_nonneg (by linarith [ht.1]))).mp\n rw [ENNReal.ofReal_mul c.coe_nonneg, ENNReal.ofReal_coe_nnreal,\n ← hdist (γ t) (hγV ht)]\n exact hAnchor t ht\n obtain ⟨w, hw⟩ := Helpers.radial_of_normal_coordinates_sharp_speed e g B\n (fun t => extChartAt I p (γ t)) (K * c) r a b t₀ c hBsym hc ht₀ hab\n (he.of_le (by simp)) hMaps\n (fun t ht => (continuousAt_extChartAt' (hVs (hγV ht))).comp\n (hlin.continuousAt isOpen_Ioo (hSub ht)))\n (fun t ht => (hInv.contDiffAt (hW.mem_nhds (hVi (γ t) (hγV ht)).1)).differentiableAt_one)\n (hLip.comp ((hlin.lipschitzOn Set.ordConnected_Ioo).mono hSub) hγV)\n (fun t _ u v => hsym _ u v)\n (fun t ht v hv => hpos _ ((extChartAt I p).map_source (hVs (hγV ht))) v hv)\n (fun t ht w => by\n have hh := (hGauss _ (hMaps t ht).2).2 w\n simpa only [e.right_inv (hMaps t ht).1] using hh)\n hSharp hRadius\n refine ⟨w, fun t ht => ⟨hw t ht, ?_⟩⟩\n rw [← hw t ht, e.right_inv (hMaps t ht).1]\n exact ((extChartAt I p).left_inv (hVs (hγV ht))).symm\ntheorem Helpers.exists_riemannian_right_radial_germ\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M]\n {γ : ℝ → M} {c : NNReal} {A D t₀ : ℝ} (hc : 0 < c)\n (hlin : Helpers.MetricLocallyLinear γ c (Set.Ioo A D)) (ht₀ : t₀ ∈ Set.Ioo A D) :\n ∃ e : OpenPartialHomeomorph E E,\n (0 : E) ∈ e.source ∧ e 0 = extChartAt I (γ t₀) (γ t₀) ∧\n ContDiffAt ℝ ∞ e 0 ∧ ∃ ε > (0 : ℝ), ∃ w : E,\n ∀ t ∈ Set.Icc t₀ (t₀ + ε),\n γ t = (extChartAt I (γ t₀)).symm (e ((t - t₀) • w)) := by\n obtain ⟨r, hr, e, hsource, hep, he, V, hV, hpV, hVs, hRig⟩ :=\n Helpers.exists_riemannian_radial_rigidity_chart I M (γ t₀)\n obtain ⟨δ, hδ, hEq⟩ := hlin.on_open isOpen_Ioo ht₀\n have hN : Set.Ioo A D ∩\n (Set.Ioo (t₀ - δ) (t₀ + δ) ∩ γ ⁻¹' V) ∈ nhds t₀ := by\n exact Filter.inter_mem (isOpen_Ioo.mem_nhds ht₀)\n (Filter.inter_mem (Ioo_mem_nhds (by linarith) (by linarith))\n ((hlin.continuousAt isOpen_Ioo ht₀).preimage_mem_nhds (hV.mem_nhds hpV)))\n obtain ⟨d, hd, hball⟩ := Metric.mem_nhds_iff.mp hN\n have htime (t : ℝ) (ht : t ∈ Set.Ioo t₀ (t₀ + d)) :\n t ∈ Set.Ioo A D ∩ (Set.Ioo (t₀ - δ) (t₀ + δ) ∩ γ ⁻¹' V) := by\n apply hball\n rw [Metric.mem_ball, Real.dist_eq, abs_of_pos (sub_pos.mpr ht.1)]\n linarith [ht.2]\n have hCompact : ∀ a b : ℝ, t₀ < a → a ≤ b → b < t₀ + d →\n ∃ w : E, ∀ t ∈ Set.Icc a b,\n e.symm (extChartAt I (γ t₀) (γ t)) = (t - t₀) • w ∧\n γ t = (extChartAt I (γ t₀)).symm (e ((t - t₀) • w)) := by\n intro a b hta hab hbd\n have hI (t : ℝ) (ht : t ∈ Set.Icc a b) : t ∈ Set.Ioo t₀ (t₀ + d) :=\n ⟨hta.trans_le ht.1, ht.2.trans_lt hbd⟩\n apply hRig γ c A D a b t₀ hc\n (htime a ⟨hta, hab.trans_lt hbd⟩).1.1 hab\n (htime b ⟨hta.trans_le hab, hbd⟩).1.2 hta hlin\n (fun t ht => (htime t (hI t ht)).2.2)\n intro t ht\n have hh := hEq t₀ t (by constructor <;> linarith) (htime t (hI t ht)).2.1\n simpa only [abs_of_pos (sub_pos.mpr (hI t ht).1)] using hh\n have hzero : e.symm (extChartAt I (γ t₀) (γ t₀)) = 0 := by\n rw [← hep, e.left_inv (hsource (Metric.mem_ball_self hr))]\n have hγzero : γ t₀ = (extChartAt I (γ t₀)).symm (e 0) := by\n rw [hep]\n exact ((extChartAt I (γ t₀)).left_inv (mem_extChartAt_source (γ t₀))).symm\n obtain ⟨w, hw⟩ := Helpers.right_radial_germ_of_compact_radial\n (fun t => e.symm (extChartAt I (γ t₀) (γ t))) γ\n (fun v => (extChartAt I (γ t₀)).symm (e v)) t₀ d hd hzero hγzero hCompact\n exact ⟨e, hsource (Metric.mem_ball_self hr), hep,\n he.contDiffAt (Metric.isOpen_ball.mem_nhds (Metric.mem_ball_self hr)),\n d / 2, half_pos hd, w, fun t ht => (hw t ht).2⟩\ntheorem Helpers.contDiffWithinAt_right_chart_of_metricLocallyLinear\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M]\n {γ : ℝ → M} {c : NNReal} {A D t₀ : ℝ} (hc : 0 < c)\n (hlin : Helpers.MetricLocallyLinear γ c (Set.Ioo A D)) (ht₀ : t₀ ∈ Set.Ioo A D) :\n ContDiffWithinAt ℝ ∞ (fun t => extChartAt I (γ t₀) (γ t)) (Set.Ici t₀) t₀ := by\n obtain ⟨e, he0, hep, he, ε, hε, w, hw⟩ :=\n Helpers.exists_riemannian_right_radial_germ I M hc hlin ht₀\n exact Helpers.contDiffWithinAt_chart_of_right_radial_germ I (γ t₀) hε hep he hw\ntheorem Helpers.contDiffWithinAt_left_chart_of_metricLocallyLinear\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M]\n {γ : ℝ → M} {c : NNReal} {A D t₀ : ℝ} (hc : 0 < c)\n (hlin : Helpers.MetricLocallyLinear γ c (Set.Ioo A D)) (ht₀ : t₀ ∈ Set.Ioo A D) :\n ContDiffWithinAt ℝ ∞ (fun t => extChartAt I (γ t₀) (γ t)) (Set.Iic t₀) t₀ := by\n have hlin' : Helpers.MetricLocallyLinear (fun t => γ (-t)) c (Set.Ioo (-D) (-A)) := by\n apply hlin.reflect.mono\n intro t ht\n exact ⟨by linarith [ht.2], by linarith [ht.1]⟩\n have ht₀' : -t₀ ∈ Set.Ioo (-D) (-A) := ⟨neg_lt_neg ht₀.2, neg_lt_neg ht₀.1⟩\n have hh := Helpers.contDiffWithinAt_right_chart_of_metricLocallyLinear I M hc hlin' ht₀'\n have hneg : ContDiffWithinAt ℝ ∞ (fun t : ℝ => -t) (Set.Iic t₀) t₀ :=\n contDiff_neg.contDiffWithinAt\n have hcomp := hh.comp t₀ hneg (fun t (ht : t ≤ t₀) => neg_le_neg ht)\n simpa only [Function.comp_def, neg_neg] using hcomp\ntheorem Helpers.metric_speed_eq_of_hasDerivWithinAt_center_chart\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M]\n (p : M) {γ : ℝ → M} {t₀ : ℝ} {c : NNReal} {v : E} {s : Set ℝ}\n [Filter.NeBot (nhdsWithin t₀ s)] (hs : t₀ ∉ s)\n (hγ : ContinuousAt γ t₀) (hγ₀ : γ t₀ = p)\n (hx : HasDerivWithinAt (fun t => extChartAt I p (γ t)) v s t₀)\n (hlinear : ∀ᶠ t in nhdsWithin t₀ s,\n edist p (γ t) = (c : ENNReal) * ENNReal.ofReal |t - t₀|) :\n ‖mfderivWithin (modelWithCornersSelf ℝ E) I (extChartAt I p).symm\n (Set.range I) (extChartAt I p p) v‖ ^ 2 = (c : ℝ) ^ 2 := by\n obtain ⟨r, hr, g, B, e, hg, hsym, hpos, hnorm, hBsym, hBpos, hsource,\n hep, he, hGauss, W, hW, hpW, hWt, hInv, V, hV, hpV, hVs, hVi, hLip, hdist⟩ :=\n Helpers.exists_riemannian_normal_distance_data I M p\n have hz : (0 : E) ∈ Metric.ball 0 r := Metric.mem_ball_self hr\n have hmetric : ∀ w, g (e 0) (fderiv ℝ e 0 w) (fderiv ℝ e 0 w) = B w w :=\n Helpers.radial_metric_at_zero hr B hg (he.of_le (by simp))\n (fun u hu => (hGauss u hu).1) (fun u hu => (hGauss u hu).2 u)\n have hB : ∀ w, 0 ≤ B w w := by\n intro w\n rw [← hmetric w, hnorm _ (hGauss 0 hz).1]\n exact sq_nonneg _\n have hEDiff : DifferentiableAt ℝ e 0 :=\n (he.contDiffAt (Metric.isOpen_ball.mem_nhds hz)).differentiableAt (by simp)\n have hIDiff : DifferentiableAt ℝ e.symm (e 0) := by\n rw [hep]\n exact (hInv.contDiffAt (hW.mem_nhds hpW)).differentiableAt_one\n have hspeed := Helpers.energy_eq_of_local_normal_distance_within\n (extChartAt I p) p (g (e 0)) B e (hsource hz) hep.symm hEDiff hIDiff\n hmetric hB (hV.mem_nhds hpV) hdist hs hγ hγ₀ hx hlinear\n rw [hep, hnorm _ (mem_extChartAt_target p)] at hspeed\n exact hspeed\ntheorem Helpers.metricLocallyLinear_has_matching_chart_velocity\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M]\n {γ : ℝ → M} {c : NNReal} {A D t₀ : ℝ} (hc : 0 < c)\n (hlin : Helpers.MetricLocallyLinear γ c (Set.Ioo A D)) (ht₀ : t₀ ∈ Set.Ioo A D) :\n ∃ v : E,\n HasDerivWithinAt (fun t : ℝ => extChartAt I (γ t₀) (γ t)) v (Set.Ici t₀) t₀ ∧\n HasDerivWithinAt (fun t : ℝ => extChartAt I (γ t₀) (γ t)) v (Set.Iic t₀) t₀ := by\n apply Helpers.matching_chart_velocity_of_one_sided_regularity I hlin ht₀\n (Helpers.contDiffWithinAt_right_chart_of_metricLocallyLinear I M hc hlin ht₀)\n (Helpers.contDiffWithinAt_left_chart_of_metricLocallyLinear I M hc hlin ht₀)\n · intro v hv\n exact Helpers.metric_speed_eq_of_hasDerivWithinAt_center_chart I M (γ t₀)\n (s := Set.Ioi t₀) (by simp) (hlin.continuousAt isOpen_Ioo ht₀) rfl hv.Ioi_of_Ici\n ((hlin.eventually_edist_eq isOpen_Ioo ht₀).filter_mono nhdsWithin_le_nhds)\n · intro v hv\n exact Helpers.metric_speed_eq_of_hasDerivWithinAt_center_chart I M (γ t₀)\n (s := Set.Iio t₀) (by simp) (hlin.continuousAt isOpen_Ioo ht₀) rfl hv.Iio_of_Iic\n ((hlin.eventually_edist_eq isOpen_Ioo ht₀).filter_mono nhdsWithin_le_nhds)\ntheorem Helpers.exists_coordinate_normal_radius_control_with_radial_ode\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {U : Set E} (hU : IsOpen U)\n {g : E → E →L[ℝ] E →L[ℝ] ℝ}\n (hg : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) g U)\n (hsym : ∀ x u v, g x u v = g x v u)\n (hpos : ∀ x ∈ U, ∀ v, v ≠ 0 → 0 < g x v v)\n {Γ : E → E →L[ℝ] E →L[ℝ] E}\n (hΓ : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Γ U)\n (hKoszul : ∀ x ∈ U, ∀ u v w,\n 2 * g x (Γ x u v) w = (fderiv ℝ g x u) v w +\n (fderiv ℝ g x v) u w - (fderiv ℝ g x w) u v)\n {p : E} (hp : p ∈ U) :\n ∃ τ > (0 : ℝ), ∃ r > (0 : ℝ), ∃ e : OpenPartialHomeomorph E E,\n (0 : E) ∈ e.source ∧ e 0 = p ∧\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) e (Metric.ball 0 r) ∧\n (∀ v ∈ Metric.ball 0 r, e v ∈ U ∧ ∀ w,\n g (e v) (fderiv ℝ e v v) (fderiv ℝ e v w) = τ ^ 2 * g p v w) ∧\n (∀ v ∈ Metric.ball 0 r, ∀ t ∈ Set.Ioo (-1 : ℝ) 1,\n HasDerivAt (fun s : ℝ => e (s • v)) (fderiv ℝ e (t • v) v) t ∧\n HasDerivAt (fun s : ℝ => fderiv ℝ e (s • v) v)\n (-(Γ (e (t • v)) (fderiv ℝ e (t • v) v)\n (fderiv ℝ e (t • v) v))) t) ∧\n ∃ W : Set E, IsOpen W ∧ p ∈ W ∧ W ⊆ U ∩ e.target ∧\n (∀ z ∈ W, e.symm z ∈ Metric.ball 0 r) ∧\n ContDiffOn ℝ 1 e.symm W ∧\n (∀ δ > (0 : ℝ), ContDiffOn ℝ 1\n (fun z => Real.sqrt ((τ ^ 2 • g p) (e.symm z) (e.symm z) + δ)) W) ∧\n (∀ δ > (0 : ℝ), ∀ z ∈ W, ∀ w,\n |fderiv ℝ (fun y => Real.sqrt\n ((τ ^ 2 • g p) (e.symm y) (e.symm y) + δ)) z w| ≤\n Real.sqrt (g z w w)) := by\n obtain ⟨τ, hτ, r, hr, e, he0, hpt, hep, he, hei, hGauss, hODE⟩ :=\n Helpers.exists_coordinate_normal_chart_with_radial_ode hU (hg.of_le (by simp)) hsym hΓ hKoszul hp\n obtain ⟨A, hAp, hInvA⟩ := hei.contDiffOn (m := 1) (by simp) (by simp)\n obtain ⟨A', hA'A, hA', hpA'⟩ := mem_nhds_iff.mp hAp\n let W := (A' ∩ U) ∩ (e.target ∩ e.symm ⁻¹' Metric.ball 0 r)\n have hW : IsOpen W :=\n (hA'.inter hU).inter (e.isOpen_inter_preimage_symm Metric.isOpen_ball)\n have hInvp : e.symm p = 0 := by rw [← hep]; exact e.left_inv he0\n have hpW : p ∈ W :=\n ⟨⟨hpA', hp⟩, hpt, by\n change e.symm p ∈ Metric.ball 0 r\n rw [hInvp]\n exact Metric.mem_ball_self hr⟩\n have hInvW : ContDiffOn ℝ 1 e.symm W :=\n hInvA.mono (fun z hz => hA'A hz.1.1)\n let B : E →L[ℝ] E →L[ℝ] ℝ := τ ^ 2 • g p\n have hBsym : ∀ u v, B u v = B v u := by\n intro u v\n change τ ^ 2 * g p u v = τ ^ 2 * g p v u\n rw [hsym p u v]\n have hnonneg : ∀ z ∈ U, ∀ v, 0 ≤ g z v v := by\n intro z hz v\n by_cases hv : v = 0\n · simp [hv]\n · exact (hpos z hz v hv).le\n have hBn : ∀ v, 0 ≤ B v v := by\n intro v\n change 0 ≤ τ ^ 2 * g p v v\n exact mul_nonneg (sq_nonneg _) (hnonneg p hp v)\n refine ⟨τ, hτ, r, hr, e, he0, hep, he, hGauss, hODE, W, hW, hpW,\n (fun z hz => ⟨hz.1.2, hz.2.1⟩), (fun z hz => hz.2.2), hInvW, ?_, ?_⟩\n · intro δ hδ\n have hQ : ContDiffOn ℝ 1 (fun z => B (e.symm z) (e.symm z) + δ) W :=\n (((contDiffOn_const (c := B)).clm_apply hInvW).clm_apply hInvW).add\n contDiffOn_const\n exact hQ.sqrt (fun z _ => ne_of_gt (by linarith [hBn (e.symm z)]))\n · intro δ hδ z hz w\n have hF : DifferentiableAt ℝ e.symm z :=\n (hInvW.contDiffAt (hW.mem_nhds hz)).differentiableAt_one\n have hE : DifferentiableAt ℝ e (e.symm z) :=\n (he.contDiffAt (Metric.isOpen_ball.mem_nhds hz.2.2)).differentiableAt (by simp)\n have hcomp := hE.hasFDerivAt.comp z hF.hasFDerivAt\n have hEq : (fun y => e (e.symm y)) =ᶠ[nhds z] id :=\n e.eventually_right_inverse hz.2.1\n have hid := hcomp.congr_of_eventuallyEq hEq.symm\n have hcancel : ∀ u, fderiv ℝ e (e.symm z) (fderiv ℝ e.symm z u) = u := by\n intro u\n exact congrArg (fun L : E →L[ℝ] E => L u) (hid.unique (hasFDerivAt_id z))\n apply Helpers.regularized_radius_fderiv_bound_of_gauss (g z) B\n (hsym z) (hnonneg z hz.1.2) hBsym hF (fderiv ℝ e (e.symm z)) ?_ hcancel hδ w\n intro u\n simpa only [e.right_inv hz.2.1, B, smul_apply, smul_eq_mul] using\n (hGauss (e.symm z) hz.2.2).2 u\ntheorem Helpers.exists_normal_radius_lower_bound_in_fixed_chart : open scoped Bundle in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n {M : Type*} [TopologicalSpace M] [T2Space M] [ChartedSpace H M] [IsManifold I 1 M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n (p q₀ : M) (hq₀ : q₀ ∈ (extChartAt I p).source) (g : E → E →L[ℝ] E →L[ℝ] ℝ)\n (hg : ∀ z ∈ (extChartAt I p).target, ∀ w : E,\n g z w w = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z w‖ ^ 2)\n (B : E →L[ℝ] E →L[ℝ] ℝ) (hpos : ∀ v : E, v ≠ 0 → 0 < B v v)\n (e : OpenPartialHomeomorph E E) (he0 : (0 : E) ∈ e.source)\n (hep : e 0 = extChartAt I p q₀) (W : Set E) (hW : IsOpen W)\n (hpW : extChartAt I p q₀ ∈ W)\n (hsmooth : ∀ δ > (0 : ℝ), ContDiffOn ℝ 1\n (fun z => Real.sqrt (B (e.symm z) (e.symm z) + δ)) W)\n (hbound : ∀ δ > (0 : ℝ), ∀ z ∈ W, ∀ w : E,\n |fderiv ℝ (fun y => Real.sqrt (B (e.symm y) (e.symm y) + δ)) z w| ≤\n Real.sqrt (g z w w)),\n ∃ V : Set M, IsOpen V ∧ q₀ ∈ V ∧\n V ⊆ (extChartAt I p).source ∩ (extChartAt I p) ⁻¹' W ∧\n V ⊆ (extChartAt I p) ⁻¹' e.target ∧\n ∀ q ∈ V, ENNReal.ofReal\n (Real.sqrt (B (e.symm (extChartAt I p q)) (e.symm (extChartAt I p q)))) ≤\n Manifold.riemannianEDist I q₀ q := by\n intro E _ _ _ H _ I _ M _ _ _ _ _ p q₀ hq₀ g hg B hpos e he0 hep W hW hpW hsmooth hbound\n let c : OpenPartialHomeomorph M E := {\n toPartialEquiv := extChartAt I p\n open_source := isOpen_extChartAt_source p\n open_target := isOpen_extChartAt_target p\n continuousOn_toFun := continuousOn_extChartAt p\n continuousOn_invFun := continuousOn_extChartAt_symm p }\n let f : OpenPartialHomeomorph E M := e.trans c.symm\n have hf0 : (0 : E) ∈ f.source :=\n ⟨he0, by change e 0 ∈ (extChartAt I p).target; rw [hep]; exact (extChartAt I p).map_source hq₀⟩\n have hfp : f 0 = q₀ := by\n change (extChartAt I p).symm (e 0) = q₀\n rw [hep]\n exact (extChartAt I p).left_inv hq₀\n let A := (extChartAt I p).source ∩ (extChartAt I p) ⁻¹' W\n have hA : IsOpen A := isOpen_extChartAt_preimage' p hW\n obtain ⟨k,hk,V,hV,hV0,hVA,hVf,hfront,hinside⟩ :=\n Helpers.exists_inner_bilinear_radius_neighborhood B hpos f hf0 A hA\n (by rw [hfp]; exact ⟨hq₀,hpW⟩)\n have hpV : q₀ ∈ V := hfp ▸ hV0\n have hsub (q : M) (hq : q ∈ V) : q ∈ f.target := hVf (subset_closure hq)\n refine ⟨V,hV,hpV,(fun q hq => hVA (subset_closure hq)),\n (fun q hq => (hsub q hq).2),?_⟩\n intro q hq\n letI : (x : M) → NormedAddCommGroup (TangentSpace I x) := fun x =>\n Bundle.instNormedAddCommGroupOfRiemannianBundleOfIsTopologicalAddGroupOfContinuousConstSMulReal\n (E := fun x : M => TangentSpace I x) x\n apply Helpers.ofReal_radius_le_riemannianEDist_of_first_exit I A V hV hVA\n (fun y => Real.sqrt (B (f.symm y) (f.symm y))) q₀ q k hpV\n · have hzero : f.symm q₀ = 0 := by rw [← hfp]; exact f.left_inv hf0\n simp only [hzero,map_zero,ContinuousLinearMap.zero_apply,Real.sqrt_zero]\n · exact Real.sqrt_nonneg _\n · exact (hinside q hq).le\n · exact hfront\n · intro γ a b hab hγ hγA\n exact Helpers.enorm_sqrt_sub_le_pathELength_of_chart_regularized_bound I p g hg W hW\n (fun z => B (e.symm z) (e.symm z)) hsmooth hbound γ a b hab hγ hγA\ntheorem Helpers.exists_normal_distance_data_in_fixed_chart\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M] (p q₀ : M)\n (hq₀ : q₀ ∈ (extChartAt I p).source)\n (g : E → E →L[ℝ] E →L[ℝ] ℝ) (Γ : E → E →L[ℝ] E →L[ℝ] E)\n (hg : ContDiffOn ℝ ∞ g (extChartAt I p).target)\n (hsym : ∀ z u v, g z u v = g z v u)\n (hpos : ∀ z ∈ (extChartAt I p).target, ∀ v, v ≠ 0 → 0 < g z v v)\n (hnorm : ∀ z ∈ (extChartAt I p).target, ∀ v,\n g z v v = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z v‖ ^ 2)\n (hΓ : ContDiffOn ℝ ∞ Γ (extChartAt I p).target)\n (hKoszul : ∀ z ∈ (extChartAt I p).target, ∀ u v w,\n 2 * g z (Γ z u v) w = (fderiv ℝ g z u) v w +\n (fderiv ℝ g z v) u w - (fderiv ℝ g z w) u v)\n (hLipComp : ∀ f : E → E, ContDiffAt ℝ 1 f (extChartAt I p q₀) →\n ∃ V : Set M, IsOpen V ∧ q₀ ∈ V ∧ V ⊆ (extChartAt I p).source ∧\n ∃ K : NNReal, LipschitzOnWith K (fun q => f (extChartAt I p q)) V) :\n ∃ r > (0 : ℝ), ∃ B : E →L[ℝ] E →L[ℝ] ℝ,\n ∃ e : OpenPartialHomeomorph E E,\n (∀ u v, B u v = B v u) ∧ (∀ v, v ≠ 0 → 0 < B v v) ∧\n Metric.ball 0 r ⊆ e.source ∧ e 0 = extChartAt I p q₀ ∧\n ContDiffOn ℝ ∞ e (Metric.ball 0 r) ∧\n (∀ v ∈ Metric.ball 0 r, e v ∈ (extChartAt I p).target ∧ ∀ w,\n g (e v) (fderiv ℝ e v v) (fderiv ℝ e v w) = B v w) ∧\n (∀ v ∈ Metric.ball 0 r, ∀ t ∈ Set.Ioo (-1 : ℝ) 1,\n HasDerivAt (fun s : ℝ => e (s • v)) (fderiv ℝ e (t • v) v) t ∧\n HasDerivAt (fun s : ℝ => fderiv ℝ e (s • v) v)\n (-(Γ (e (t • v)) (fderiv ℝ e (t • v) v)\n (fderiv ℝ e (t • v) v))) t) ∧\n ∃ W : Set E, IsOpen W ∧ extChartAt I p q₀ ∈ W ∧ W ⊆ e.target ∧\n ContDiffOn ℝ 1 e.symm W ∧\n ∃ V : Set M, IsOpen V ∧ q₀ ∈ V ∧ V ⊆ (extChartAt I p).source ∧\n (∀ q ∈ V, extChartAt I p q ∈ W ∧\n e.symm (extChartAt I p q) ∈ Metric.ball 0 r) ∧\n (∃ K : NNReal, LipschitzOnWith K (fun q => e.symm (extChartAt I p q)) V) ∧\n ∀ q ∈ V, edist q₀ q = ENNReal.ofReal\n (Real.sqrt (B (e.symm (extChartAt I p q)) (e.symm (extChartAt I p q)))) := by\n obtain ⟨τ, hτ, r, hr, e, he0, hep, he, hGauss, hODE, W, hW, hpW,\n hWU, hWr, hInv, hsmooth, hbound⟩ :=\n Helpers.exists_coordinate_normal_radius_control_with_radial_ode (isOpen_extChartAt_target p)\n hg hsym hpos hΓ hKoszul ((extChartAt I p).map_source hq₀)\n obtain ⟨s, hs, hsource⟩ := Metric.mem_nhds_iff.mp (e.open_source.mem_nhds he0)\n let r' : ℝ := min r s\n have hr' : 0 < r' := lt_min hr hs\n have hrr : Metric.ball (0 : E) r' ⊆ Metric.ball 0 r :=\n Metric.ball_subset_ball (min_le_left r s)\n have hrs : Metric.ball (0 : E) r' ⊆ e.source :=\n (Metric.ball_subset_ball (min_le_right r s)).trans hsource\n let W' := W ∩ (e.target ∩ e.symm ⁻¹' Metric.ball 0 r')\n have hW' : IsOpen W' :=\n hW.inter (e.isOpen_inter_preimage_symm Metric.isOpen_ball)\n have hInvp : e.symm (extChartAt I p q₀) = 0 := by\n rw [← hep]\n exact e.left_inv he0\n have hpW' : extChartAt I p q₀ ∈ W' := by\n refine ⟨hpW, (hWU hpW).2, ?_⟩\n change e.symm (extChartAt I p q₀) ∈ Metric.ball 0 r'\n rw [hInvp]\n exact Metric.mem_ball_self hr'\n let B : E →L[ℝ] E →L[ℝ] ℝ := τ ^ 2 • g (extChartAt I p q₀)\n have hBpos : ∀ v : E, v ≠ 0 → 0 < B v v := by\n intro v hv\n exact mul_pos (sq_pos_of_pos hτ) (hpos _ ((extChartAt I p).map_source hq₀) v hv)\n have hBsym : ∀ u v, B u v = B v u := by\n intro u v\n change τ ^ 2 * g _ u v = τ ^ 2 * g _ v u\n rw [hsym]\n have hradial : ∀ v ∈ Metric.ball 0 r', e v ∈ (extChartAt I p).target ∧ ∀ w,\n g (e v) (fderiv ℝ e v v) (fderiv ℝ e v w) = B v w := by\n intro v hv\n exact hGauss v (hrr hv)\n obtain ⟨V, hV, hpV, hVW', hVe, hdist⟩ :=\n Helpers.exists_normal_radius_lower_bound_in_fixed_chart I p q₀ hq₀ g hnorm B hBpos e he0 hep\n W' hW' hpW'\n (fun δ hδ => (hsmooth δ hδ).mono Set.inter_subset_left)\n (fun δ hδ z hz w => hbound δ hδ z hz.1 w)\n obtain ⟨A, hA, hpA, hAsource, K, hLip⟩ :=\n hLipComp e.symm\n (hInv.contDiffAt (hW.mem_nhds hpW))\n refine ⟨r', hr', B, e, hBsym, hBpos,\n hrs, hep, he.mono hrr, hradial,\n (fun v hv => hODE v (hrr hv)), W, hW, hpW, (fun z hz => (hWU hz).2), hInv,\n V ∩ A, hV.inter hA, ⟨hpV, hpA⟩, (fun q hq => (hVW' hq.1).1), ?_,\n ⟨K, hLip.mono Set.inter_subset_right⟩, ?_⟩\n · intro q hq\n exact ⟨(hVW' hq.1).2.1, (hVW' hq.1).2.2.2⟩\n · intro q hq\n rw [IsRiemannianManifold.out (I := I)]\n apply le_antisymm ?_ (hdist q hq.1)\n have hu : e.symm (extChartAt I p q) ∈ Metric.ball 0 r' := (hVW' hq.1).2.2.2\n have hn : 0 ≤ B (e.symm (extChartAt I p q)) (e.symm (extChartAt I p q)) := by\n rw [← (hradial _ hu).2 _, hnorm _ (hradial _ hu).1]\n exact sq_nonneg _\n have hupper := Helpers.riemannianEDist_radial_le I p g hg.continuousOn hnorm B e r'\n ((he.mono hrr).of_le (by simp)) (fun v hv => (hradial v hv).1)\n (fun v hv => (hradial v hv).2 v) (e.symm (extChartAt I p q)) hu hn\n simpa only [hep, e.right_inv (hVe hq.1),\n (extChartAt I p).left_inv hq₀,\n (extChartAt I p).left_inv (hVW' hq.1).1] using hupper\ntheorem Helpers.exists_radial_rigidity_in_fixed_chart\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M] (p q₀ : M)\n (hq₀ : q₀ ∈ (extChartAt I p).source)\n (g : E → E →L[ℝ] E →L[ℝ] ℝ) (Γ : E → E →L[ℝ] E →L[ℝ] E)\n (hg : ContDiffOn ℝ ∞ g (extChartAt I p).target)\n (hsym : ∀ z u v, g z u v = g z v u)\n (hpos : ∀ z ∈ (extChartAt I p).target, ∀ v, v ≠ 0 → 0 < g z v v)\n (hnorm : ∀ z ∈ (extChartAt I p).target, ∀ v,\n g z v v = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z v‖ ^ 2)\n (hΓ : ContDiffOn ℝ ∞ Γ (extChartAt I p).target)\n (hKoszul : ∀ z ∈ (extChartAt I p).target, ∀ u v w,\n 2 * g z (Γ z u v) w = (fderiv ℝ g z u) v w +\n (fderiv ℝ g z v) u w - (fderiv ℝ g z w) u v)\n (hLipComp : ∀ f : E → E, ContDiffAt ℝ 1 f (extChartAt I p q₀) →\n ∃ V : Set M, IsOpen V ∧ q₀ ∈ V ∧ V ⊆ (extChartAt I p).source ∧\n ∃ K : NNReal, LipschitzOnWith K (fun q => f (extChartAt I p q)) V) :\n ∃ r > (0 : ℝ), ∃ e : OpenPartialHomeomorph E E,\n Metric.ball 0 r ⊆ e.source ∧ e 0 = extChartAt I p q₀ ∧\n ContDiffOn ℝ ∞ e (Metric.ball 0 r) ∧\n (∀ v ∈ Metric.ball 0 r, ∀ t ∈ Set.Ioo (-1 : ℝ) 1,\n HasDerivAt (fun s : ℝ => e (s • v)) (fderiv ℝ e (t • v) v) t ∧\n HasDerivAt (fun s : ℝ => fderiv ℝ e (s • v) v)\n (-(Γ (e (t • v)) (fderiv ℝ e (t • v) v)\n (fderiv ℝ e (t • v) v))) t) ∧\n ∃ V : Set M, IsOpen V ∧ q₀ ∈ V ∧ V ⊆ (extChartAt I p).source ∧\n ∀ (γ : ℝ → M) (c : NNReal) (A D a b t₀ : ℝ),\n 0 < c → A < a → a ≤ b → b < D → t₀ < a →\n Helpers.MetricLocallyLinear γ c (Set.Ioo A D) →\n Set.MapsTo γ (Set.Icc a b) V →\n (∀ t ∈ Set.Icc a b, edist q₀ (γ t) =\n (c : ENNReal) * ENNReal.ofReal (t - t₀)) →\n ∃ w : E, ∀ t ∈ Set.Icc a b,\n e.symm (extChartAt I p (γ t)) = (t - t₀) • w ∧\n γ t = (extChartAt I p).symm (e ((t - t₀) • w)) := by\n obtain ⟨r, hr, B, e, hBsym, hBpos, hsource,\n hep, he, hGauss, hODE, W, hW, hpW, hWt, hInv, V, hV, hpV, hVs, hVi,\n ⟨K, hLip⟩, hdist⟩ := Helpers.exists_normal_distance_data_in_fixed_chart I M p q₀ hq₀ g Γ\n hg hsym hpos hnorm hΓ hKoszul hLipComp\n refine ⟨r, hr, e, hsource, hep, he, hODE, V, hV, hpV, hVs, ?_⟩\n intro γ c A D a b t₀ hc hAa hab hbD ht₀ hlin hγV hAnchor\n have hSub : Set.Icc a b ⊆ Set.Ioo A D := by\n intro t ht\n exact ⟨hAa.trans_le ht.1, ht.2.trans_lt hbD⟩\n have hMaps (t : ℝ) (ht : t ∈ Set.Icc a b) :\n extChartAt I p (γ t) ∈ e.target ∧\n e.symm (extChartAt I p (γ t)) ∈ Metric.ball 0 r :=\n ⟨hWt (hVi (γ t) (hγV ht)).1, (hVi (γ t) (hγV ht)).2⟩\n have hSharp (t : ℝ) (ht : t ∈ Set.Icc a b) (v : E)\n (hv : HasDerivAt (fun s => extChartAt I p (γ s)) v t) :\n g (extChartAt I p (γ t)) v v = (c : ℝ) ^ 2 := by\n rw [hnorm _ ((extChartAt I p).map_source (hVs (hγV ht))) v]\n exact Helpers.metric_speed_eq_of_hasDerivAt_chart I M p\n (hlin.continuousAt isOpen_Ioo (hSub ht)) (hVs (hγV ht)) hv\n (hlin.eventually_edist_eq isOpen_Ioo (hSub ht))\n have hRadius (t : ℝ) (ht : t ∈ Set.Icc a b) :\n Real.sqrt (B (e.symm (extChartAt I p (γ t))) (e.symm (extChartAt I p (γ t)))) =\n (c : ℝ) * (t - t₀) := by\n apply (ENNReal.ofReal_eq_ofReal_iff (Real.sqrt_nonneg _)\n (mul_nonneg c.coe_nonneg (by linarith [ht.1]))).mp\n rw [ENNReal.ofReal_mul c.coe_nonneg, ENNReal.ofReal_coe_nnreal,\n ← hdist (γ t) (hγV ht)]\n exact hAnchor t ht\n obtain ⟨w, hw⟩ := Helpers.radial_of_normal_coordinates_sharp_speed e g B\n (fun t => extChartAt I p (γ t)) (K * c) r a b t₀ c hBsym hc ht₀ hab\n (he.of_le (by simp)) hMaps\n (fun t ht => (continuousAt_extChartAt' (hVs (hγV ht))).comp\n (hlin.continuousAt isOpen_Ioo (hSub ht)))\n (fun t ht => (hInv.contDiffAt (hW.mem_nhds (hVi (γ t) (hγV ht)).1)).differentiableAt_one)\n (hLip.comp ((hlin.lipschitzOn Set.ordConnected_Ioo).mono hSub) hγV)\n (fun t _ u v => hsym _ u v)\n (fun t ht v hv => hpos _ ((extChartAt I p).map_source (hVs (hγV ht))) v hv)\n (fun t ht w => by\n have hh := (hGauss _ (hMaps t ht).2).2 w\n simpa only [e.right_inv (hMaps t ht).1] using hh)\n hSharp hRadius\n refine ⟨w, fun t ht => ⟨hw t ht, ?_⟩⟩\n rw [← hw t ht, e.right_inv (hMaps t ht).1]\n exact ((extChartAt I p).left_inv (hVs (hγV ht))).symm\ntheorem Helpers.exists_right_radial_germ_in_fixed_chart\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M] (p q₀ : M)\n (hq₀ : q₀ ∈ (extChartAt I p).source)\n (g : E → E →L[ℝ] E →L[ℝ] ℝ) (Γ : E → E →L[ℝ] E →L[ℝ] E)\n (hg : ContDiffOn ℝ ∞ g (extChartAt I p).target)\n (hsym : ∀ z u v, g z u v = g z v u)\n (hpos : ∀ z ∈ (extChartAt I p).target, ∀ v, v ≠ 0 → 0 < g z v v)\n (hnorm : ∀ z ∈ (extChartAt I p).target, ∀ v,\n g z v v = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z v‖ ^ 2)\n (hΓ : ContDiffOn ℝ ∞ Γ (extChartAt I p).target)\n (hKoszul : ∀ z ∈ (extChartAt I p).target, ∀ u v w,\n 2 * g z (Γ z u v) w = (fderiv ℝ g z u) v w +\n (fderiv ℝ g z v) u w - (fderiv ℝ g z w) u v)\n (hLipComp : ∀ f : E → E, ContDiffAt ℝ 1 f (extChartAt I p q₀) →\n ∃ V : Set M, IsOpen V ∧ q₀ ∈ V ∧ V ⊆ (extChartAt I p).source ∧\n ∃ K : NNReal, LipschitzOnWith K (fun q => f (extChartAt I p q)) V)\n {γ : ℝ → M} {c : NNReal} {A D t₀ : ℝ} (hc : 0 < c)\n (hlin : Helpers.MetricLocallyLinear γ c (Set.Ioo A D)) (ht₀ : t₀ ∈ Set.Ioo A D)\n (hγ₀ : γ t₀ = q₀) :\n ∃ r > (0 : ℝ), ∃ e : OpenPartialHomeomorph E E,\n Metric.ball 0 r ⊆ e.source ∧ e 0 = extChartAt I p q₀ ∧\n ContDiffOn ℝ ∞ e (Metric.ball 0 r) ∧\n (∀ v ∈ Metric.ball 0 r, ∀ t ∈ Set.Ioo (-1 : ℝ) 1,\n HasDerivAt (fun s : ℝ => e (s • v)) (fderiv ℝ e (t • v) v) t ∧\n HasDerivAt (fun s : ℝ => fderiv ℝ e (s • v) v)\n (-(Γ (e (t • v)) (fderiv ℝ e (t • v) v)\n (fderiv ℝ e (t • v) v))) t) ∧\n ∃ ε > (0 : ℝ), ∃ w : E,\n ∀ t ∈ Set.Icc t₀ (t₀ + ε),\n γ t = (extChartAt I p).symm (e ((t - t₀) • w)) := by\n obtain ⟨r, hr, e, hsource, hep, he, hODE, V, hV, hpV, hVs, hRig⟩ :=\n Helpers.exists_radial_rigidity_in_fixed_chart I M p q₀ hq₀ g Γ\n hg hsym hpos hnorm hΓ hKoszul hLipComp\n obtain ⟨δ, hδ, hEq⟩ := hlin.on_open isOpen_Ioo ht₀\n have hN : Set.Ioo A D ∩\n (Set.Ioo (t₀ - δ) (t₀ + δ) ∩ γ ⁻¹' V) ∈ nhds t₀ := by\n exact Filter.inter_mem (isOpen_Ioo.mem_nhds ht₀)\n (Filter.inter_mem (Ioo_mem_nhds (by linarith) (by linarith))\n ((hlin.continuousAt isOpen_Ioo ht₀).preimage_mem_nhds (hV.mem_nhds (hγ₀.symm ▸ hpV))))\n obtain ⟨d, hd, hball⟩ := Metric.mem_nhds_iff.mp hN\n have htime (t : ℝ) (ht : t ∈ Set.Ioo t₀ (t₀ + d)) :\n t ∈ Set.Ioo A D ∩ (Set.Ioo (t₀ - δ) (t₀ + δ) ∩ γ ⁻¹' V) := by\n apply hball\n rw [Metric.mem_ball, Real.dist_eq, abs_of_pos (sub_pos.mpr ht.1)]\n linarith [ht.2]\n have hCompact : ∀ a b : ℝ, t₀ < a → a ≤ b → b < t₀ + d →\n ∃ w : E, ∀ t ∈ Set.Icc a b,\n e.symm (extChartAt I p (γ t)) = (t - t₀) • w ∧\n γ t = (extChartAt I p).symm (e ((t - t₀) • w)) := by\n intro a b hta hab hbd\n have hI (t : ℝ) (ht : t ∈ Set.Icc a b) : t ∈ Set.Ioo t₀ (t₀ + d) :=\n ⟨hta.trans_le ht.1, ht.2.trans_lt hbd⟩\n apply hRig γ c A D a b t₀ hc\n (htime a ⟨hta, hab.trans_lt hbd⟩).1.1 hab\n (htime b ⟨hta.trans_le hab, hbd⟩).1.2 hta hlin\n (fun t ht => (htime t (hI t ht)).2.2)\n intro t ht\n have hh := hEq t₀ t (by constructor <;> linarith) (htime t (hI t ht)).2.1\n simpa only [hγ₀, abs_of_pos (sub_pos.mpr (hI t ht).1)] using hh\n have hzero : e.symm (extChartAt I p (γ t₀)) = 0 := by\n rw [hγ₀, ← hep, e.left_inv (hsource (Metric.mem_ball_self hr))]\n have hγzero : γ t₀ = (extChartAt I p).symm (e 0) := by\n rw [hγ₀, hep]\n exact ((extChartAt I p).left_inv hq₀).symm\n obtain ⟨w, hw⟩ := Helpers.right_radial_germ_of_compact_radial\n (fun t => e.symm (extChartAt I p (γ t))) γ\n (fun v => (extChartAt I p).symm (e v)) t₀ d hd hzero hγzero hCompact\n exact ⟨r, hr, e, hsource, hep, he, hODE,\n d / 2, half_pos hd, w, fun t ht => (hw t ht).2⟩\ntheorem Helpers.exists_right_spray_germ_in_fixed_chart\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M] (p q₀ : M)\n (hq₀ : q₀ ∈ (extChartAt I p).source)\n (g : E → E →L[ℝ] E →L[ℝ] ℝ) (Γ : E → E →L[ℝ] E →L[ℝ] E)\n (hg : ContDiffOn ℝ ∞ g (extChartAt I p).target)\n (hsym : ∀ z u v, g z u v = g z v u)\n (hpos : ∀ z ∈ (extChartAt I p).target, ∀ v, v ≠ 0 → 0 < g z v v)\n (hnorm : ∀ z ∈ (extChartAt I p).target, ∀ v,\n g z v v = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z v‖ ^ 2)\n (hΓ : ContDiffOn ℝ ∞ Γ (extChartAt I p).target)\n (hKoszul : ∀ z ∈ (extChartAt I p).target, ∀ u v w,\n 2 * g z (Γ z u v) w = (fderiv ℝ g z u) v w +\n (fderiv ℝ g z v) u w - (fderiv ℝ g z w) u v)\n (hLipComp : ∀ f : E → E, ContDiffAt ℝ 1 f (extChartAt I p q₀) →\n ∃ V : Set M, IsOpen V ∧ q₀ ∈ V ∧ V ⊆ (extChartAt I p).source ∧\n ∃ K : NNReal, LipschitzOnWith K (fun q => f (extChartAt I p q)) V)\n {γ : ℝ → M} {c : NNReal} {A D t₀ : ℝ} (hc : 0 < c)\n (hlin : Helpers.MetricLocallyLinear γ c (Set.Ioo A D)) (ht₀ : t₀ ∈ Set.Ioo A D)\n (hγ₀ : γ t₀ = q₀) :\n ∃ ε > (0 : ℝ), ∃ x v : ℝ → E,\n (∀ t ∈ Set.Ioo (t₀ - ε) (t₀ + ε),\n x t ∈ (extChartAt I p).target ∧\n HasDerivAt x (v t) t ∧ HasDerivAt v (-(Γ (x t) (v t) (v t))) t) ∧\n ∀ t ∈ Set.Icc t₀ (t₀ + ε), extChartAt I p (γ t) = x t := by\n obtain ⟨r, hr, e, hsource, hep, he,\n hODE, θ, hθ, w, hw⟩ :=\n Helpers.exists_right_radial_germ_in_fixed_chart I M p q₀ hq₀ g Γ\n hg hsym hpos hnorm hΓ hKoszul hLipComp hc hlin ht₀ hγ₀\n obtain ⟨δ, hδ, hphase⟩ := Helpers.exists_deriv_radial_spray_of_normal_chart hr hODE w t₀\n let x : ℝ → E := fun t => e ((t - t₀) • w)\n let v : ℝ → E := fun t => fderiv ℝ e ((t - t₀) • w) w\n have htδ : t₀ ∈ Set.Ioo (t₀ - δ) (t₀ + δ) := by constructor <;> linarith\n have hxt : x t₀ ∈ (extChartAt I p).target := by\n simpa only [x, sub_self, zero_smul, hep] using (extChartAt I p).map_source hq₀\n have hx : ContinuousAt x t₀ := (hphase t₀ htδ).1.continuousAt\n obtain ⟨ρ, hρ, hρsub⟩ := Metric.mem_nhds_iff.mp\n (hx.preimage_mem_nhds ((isOpen_extChartAt_target (I := I) p).mem_nhds hxt))\n let ε := min θ (min δ ρ) / 2\n have hε : 0 < ε := half_pos (lt_min hθ (lt_min hδ hρ))\n have hεθ : ε ≤ θ := by dsimp [ε]; linarith [min_le_left θ (min δ ρ)]\n have hεδ : ε ≤ δ := by\n dsimp [ε]\n linarith [min_le_right θ (min δ ρ), min_le_left δ ρ]\n have hερ : ε < ρ := by\n dsimp [ε]\n linarith [min_le_right θ (min δ ρ), min_le_right δ ρ]\n refine ⟨ε, hε, x, v, ?_, ?_⟩\n · intro t ht\n have ht' : t ∈ Set.Ioo (t₀ - δ) (t₀ + δ) := by\n constructor <;> linarith [ht.1, ht.2]\n refine ⟨hρsub ?_, (hphase t ht').1, (hphase t ht').2⟩\n rw [Metric.mem_ball, Real.dist_eq]\n exact abs_lt.mpr ⟨by linarith [ht.1], by linarith [ht.2]⟩\n · intro t ht\n rw [hw t ⟨ht.1, ht.2.trans (by linarith)⟩]\n exact (extChartAt I p).right_inv (hρsub (by\n rw [Metric.mem_ball, Real.dist_eq, abs_of_nonneg (sub_nonneg.mpr ht.1)]\n linarith [ht.2]))\ntheorem Helpers.differentiableAt_fixed_chart_of_center_chart\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M] [IsManifold I 1 M]\n (p : M) {γ : ℝ → M} {t₀ : ℝ}\n (hγ : ContinuousAt γ t₀) (hp : γ t₀ ∈ (extChartAt I p).source)\n (hx : DifferentiableAt ℝ (fun t => extChartAt I (γ t₀) (γ t)) t₀) :\n DifferentiableAt ℝ (fun t => extChartAt I p (γ t)) t₀ := by\n have ht : extChartAt I (γ t₀) (γ t₀) ∈\n ((extChartAt I (γ t₀)).symm ≫ extChartAt I p).source := by\n refine ⟨mem_extChartAt_target (γ t₀), ?_⟩\n change (extChartAt I (γ t₀)).symm (extChartAt I (γ t₀) (γ t₀)) ∈\n (extChartAt I p).source\n rwa [(extChartAt I (γ t₀)).left_inv (mem_extChartAt_source (γ t₀))]\n have hchange : ContDiffWithinAt ℝ 1\n (extChartAt I p ∘ (extChartAt I (γ t₀)).symm) (Set.range I)\n (extChartAt I (γ t₀) (γ t₀)) := contDiffWithinAt_ext_coord_change p (γ t₀) ht\n have hchange' : ContDiffAt ℝ 1\n (extChartAt I p ∘ (extChartAt I (γ t₀)).symm)\n (extChartAt I (γ t₀) (γ t₀)) := by\n simpa only [I.range_eq_univ, contDiffWithinAt_univ] using hchange\n have heq : (fun t => extChartAt I p (γ t)) =ᶠ[nhds t₀]\n (fun t => (extChartAt I p ∘ (extChartAt I (γ t₀)).symm)\n (extChartAt I (γ t₀) (γ t))) := by\n filter_upwards [hγ.preimage_mem_nhds (extChartAt_source_mem_nhds (I := I) (γ t₀))]\n with t ht\n simp only [Function.comp_apply, (extChartAt I (γ t₀)).left_inv ht]\n exact (hchange'.differentiableAt_one.comp t₀ hx).congr_of_eventuallyEq heq\ntheorem Helpers.exists_lipschitzOnWith_fixed_chart_comp\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)\n {M : Type*} [EMetricSpace M] [ChartedSpace H M]\n (p q : M) (U : Set M) (hU : IsOpen U) (hq : q ∈ U)\n (hUsource : U ⊆ (extChartAt I p).source) (K : NNReal)\n (hLip : LipschitzOnWith K (extChartAt I p) U)\n (f : E → E) (hf : ContDiffAt ℝ 1 f (extChartAt I p q)) :\n ∃ V : Set M, IsOpen V ∧ q ∈ V ∧ V ⊆ (extChartAt I p).source ∧\n ∃ L : NNReal, LipschitzOnWith L (fun y => f (extChartAt I p y)) V := by\n obtain ⟨L, A, hA, hL⟩ := hf.exists_lipschitzOnWith\n have hpre : (extChartAt I p) ⁻¹' A ∈ nhds q :=\n (continuousAt_extChartAt' (hUsource hq)).preimage_mem_nhds hA\n obtain ⟨V, hVU, hV, hqV⟩ := mem_nhds_iff.mp (Filter.inter_mem (hU.mem_nhds hq) hpre)\n refine ⟨V, hV, hqV, (fun y hy => hUsource (hVU hy).1), L * K, ?_⟩\n exact hL.comp (hLip.mono (fun y hy => (hVU hy).1)) (fun y hy => (hVU hy).2)\ntheorem Helpers.metricLocallyLinear_fixed_endpoint_chart_phase\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M]\n (p : M) (g : E → E →L[ℝ] E →L[ℝ] ℝ) (Γ : E → E →L[ℝ] E →L[ℝ] E)\n (hg : ContDiffOn ℝ ∞ g (extChartAt I p).target)\n (hΓ : ContDiffOn ℝ ∞ Γ (extChartAt I p).target)\n (hsym : ∀ z u v, g z u v = g z v u)\n (hpos : ∀ z ∈ (extChartAt I p).target, ∀ v : E, v ≠ 0 → 0 < g z v v)\n (hnorm : ∀ z ∈ (extChartAt I p).target, ∀ v : E,\n g z v v = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z v‖ ^ 2)\n (hKoszul : ∀ z ∈ (extChartAt I p).target, ∀ u v w : E,\n 2 * g z (Γ z u v) w = (fderiv ℝ g z u) v w +\n (fderiv ℝ g z v) u w - (fderiv ℝ g z w) u v)\n {γ : ℝ → M} {c : NNReal} {a b : ℝ} (hc : 0 < c) (hab : a < b)\n (hlin : Helpers.MetricLocallyLinear γ c (Set.Ioo a b))\n (hγ : Filter.Tendsto γ (nhdsWithin b (Set.Ioo a b)) (nhds p)) :\n ∃ a' ∈ Set.Ioo a b, ∃ v : ℝ → E, ∀ t ∈ Set.Ioo a' b,\n γ t ∈ (extChartAt I p).source ∧\n extChartAt I p (γ t) ∈ (extChartAt I p).target ∧\n HasDerivAt (fun s : ℝ => extChartAt I p (γ s)) (v t) t ∧\n HasDerivAt v (-(Γ (extChartAt I p (γ t)) (v t) (v t))) t ∧\n g (extChartAt I p (γ t)) (v t) (v t) = (c : ℝ) ^ 2 := by\n obtain ⟨U, hU, hpU, hUsource, K, hLip⟩ := Helpers.exists_lipschitzOnWith_extChartAt I M p\n have hγU : ∀ᶠ t in nhdsWithin b (Set.Ioo a b), γ t ∈ U :=\n hγ.eventually (hU.mem_nhds hpU)\n rw [nhdsWithin_Ioo_eq_nhdsLT hab] at hγU\n obtain ⟨d, hd, hdU⟩ := (mem_nhdsLT_iff_exists_mem_Ico_Ioo_subset hab).mp hγU\n let a' : ℝ := (d + b) / 2\n have ha' : a' ∈ Set.Ioo a b := ⟨by dsimp [a']; linarith [hd.1, hd.2],\n by dsimp [a']; linarith [hd.2]⟩\n have hsub : Set.Ioo a' b ⊆ Set.Ioo a b := fun t ht => ⟨ha'.1.trans ht.1, ht.2⟩\n have hmaps : Set.MapsTo γ (Set.Ioo a' b) U := by\n intro t ht\n apply hdU\n exact ⟨by dsimp [a'] at ht; linarith [ht.1, hd.2], ht.2⟩\n let x : ℝ → E := fun s => extChartAt I p (γ s)\n have hdiff : ∀ t ∈ Set.Ioo a' b, DifferentiableAt ℝ x t := by\n intro t ht\n obtain ⟨w, hwR, hwL⟩ := Helpers.metricLocallyLinear_has_matching_chart_velocity I M hc hlin (hsub ht)\n have hw : HasDerivAt (fun s => extChartAt I (γ t) (γ s)) w t := by\n simpa only [Set.Iic_union_Ici, hasDerivWithinAt_univ] using hwL.union hwR\n exact Helpers.differentiableAt_fixed_chart_of_center_chart I p\n (hlin.continuousAt isOpen_Ioo (hsub ht)) (hUsource (hmaps ht)) hw.differentiableAt\n refine ⟨a', ha', deriv x, ?_⟩\n intro t ht\n have hsource : γ t ∈ (extChartAt I p).source := hUsource (hmaps ht)\n have htarget : x t ∈ (extChartAt I p).target := (extChartAt I p).map_source hsource\n have hLipComp : ∀ f : E → E, ContDiffAt ℝ 1 f (extChartAt I p (γ t)) →\n ∃ V : Set M, IsOpen V ∧ γ t ∈ V ∧ V ⊆ (extChartAt I p).source ∧\n ∃ L : NNReal, LipschitzOnWith L (fun q => f (extChartAt I p q)) V :=\n Helpers.exists_lipschitzOnWith_fixed_chart_comp I p (γ t) U hU (hmaps ht) hUsource K hLip\n obtain ⟨εR, hεR, XR, VR, hRphase, hRrep⟩ :=\n Helpers.exists_right_spray_germ_in_fixed_chart I M p (γ t) hsource g Γ\n hg hsym hpos hnorm hΓ hKoszul hLipComp hc hlin (hsub ht) rfl\n have hlinL : Helpers.MetricLocallyLinear (fun s => γ (-s)) c (Set.Ioo (-b) (-a)) := by\n apply hlin.reflect.mono\n intro s hs\n exact ⟨by linarith [hs.2], by linarith [hs.1]⟩\n obtain ⟨εL, hεL, XL₀, VL₀, hLphase, hLrep⟩ :=\n Helpers.exists_right_spray_germ_in_fixed_chart I M p (γ t) hsource g Γ\n hg hsym hpos hnorm hΓ hKoszul hLipComp\n (γ := fun s => γ (-s)) (t₀ := -t) hc hlinL\n ⟨neg_lt_neg (hsub ht).2, neg_lt_neg (hsub ht).1⟩ (by simp)\n have hdiffEv : ∀ᶠ s in nhds t, DifferentiableAt ℝ x s := by\n filter_upwards [isOpen_Ioo.mem_nhds ht] with s hs\n exact hdiff s hs\n have hRODE : ∀ᶠ s in nhds t,\n HasDerivAt XR (VR s) s ∧ HasDerivAt VR (-(Γ (XR s) (VR s) (VR s))) s := by\n filter_upwards [Ioo_mem_nhds (show t - εR < t by linarith)\n (show t < t + εR by linarith)] with s hs\n exact (hRphase s hs).2\n have hReq : x =ᶠ[nhdsWithin t (Set.Ici t)] XR := by\n have htime : ∀ᶠ s in nhds t, s < t + εR := Iio_mem_nhds (by linarith)\n filter_upwards [self_mem_nhdsWithin,\n htime.filter_mono nhdsWithin_le_nhds] with s hs hsR\n exact hRrep s ⟨hs, hsR.le⟩\n have hRacc := Helpers.hasDerivWithinAt_deriv_of_spray_germ (Γ := Γ)\n (show t ∈ Set.Ici t by simp) (uniqueDiffOn_Ici t) hdiffEv hRODE hReq\n let XL : ℝ → E := fun s => XL₀ (-s)\n let VL : ℝ → E := fun s => -(VL₀ (-s))\n have hLODE : ∀ᶠ s in nhds t,\n HasDerivAt XL (VL s) s ∧ HasDerivAt VL (-(Γ (XL s) (VL s) (VL s))) s := by\n filter_upwards [Ioo_mem_nhds (show t - εL < t by linarith)\n (show t < t + εL by linarith)] with s hs\n have hneg : -s ∈ Set.Ioo (-t - εL) (-t + εL) :=\n ⟨by linarith [hs.2], by linarith [hs.1]⟩\n have hxL := (hLphase (-s) hneg).2.1.scomp s (hasDerivAt_id s).neg\n have hvL := ((hLphase (-s) hneg).2.2.scomp s (hasDerivAt_id s).neg).neg\n change HasDerivAt (fun r => -(VL₀ (-r))) _ s at hvL\n constructor\n · simpa [XL, VL, Function.comp_def] using hxL\n · simpa only [XL, VL, Function.comp_def, Pi.neg_apply, neg_one_smul,\n map_neg, neg_apply, neg_neg] using hvL\n have hLeq : x =ᶠ[nhdsWithin t (Set.Iic t)] XL := by\n have htime : ∀ᶠ s in nhds t, t - εL < s := Ioi_mem_nhds (by linarith)\n filter_upwards [self_mem_nhdsWithin,\n htime.filter_mono nhdsWithin_le_nhds] with s hs hsL\n have hh := hLrep (-s) ⟨neg_le_neg (show s ≤ t from hs), by linarith [hsL]⟩\n simpa only [x, XL, neg_neg] using hh\n have hLacc := Helpers.hasDerivWithinAt_deriv_of_spray_germ (Γ := Γ)\n (show t ∈ Set.Iic t by simp) (uniqueDiffOn_Iic t) hdiffEv hLODE hLeq\n have hacc : HasDerivAt (deriv x) (-(Γ (x t) (deriv x t) (deriv x t))) t := by\n simpa only [Set.Iic_union_Ici, hasDerivWithinAt_univ] using hLacc.union hRacc\n refine ⟨hsource, htarget, (hdiff t ht).hasDerivAt, hacc, ?_⟩\n rw [hnorm _ htarget]\n exact Helpers.metric_speed_eq_of_hasDerivAt_chart I M p\n (hlin.continuousAt isOpen_Ioo (hsub ht)) hsource (hdiff t ht).hasDerivAt\n (hlin.eventually_edist_eq isOpen_Ioo (hsub ht))\ntheorem Helpers.exists_smooth_two_point_spray_family\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {U : Set E} (hU : IsOpen U) {Γ : E → E →L[ℝ] E →L[ℝ] E}\n (hΓ : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Γ U)\n {p : E} (hp : p ∈ U) :\n ∃ r > (0 : ℝ), ∃ ε > (0 : ℝ), ∃ τ ∈ Set.Ioo (0 : ℝ) ε,\n ∃ Φ : ℝ × (E × E) → E × E,\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Φ\n (Set.Ioo (-ε) ε ×ˢ Metric.ball (p, 0) r) ∧\n (∀ z ∈ Metric.ball (p, 0) r, Φ (0, z) = z) ∧\n (∀ z ∈ Set.Ioo (-ε) ε ×ˢ Metric.ball (p, 0) r,\n (Φ z).1 ∈ U ∧ HasDerivAt (fun t : ℝ => Φ (t, z.2))\n ((Φ z).2, -(Γ (Φ z).1 (Φ z).2 (Φ z).2)) z.1) ∧\n ∃ ρ > (0 : ℝ), ∃ v : E × E → E,\n ContDiffOn ℝ 1 v (Metric.ball p ρ ×ˢ Metric.ball p ρ) ∧\n v (p, p) = 0 ∧\n ∀ x ∈ Metric.ball p ρ, ∀ y ∈ Metric.ball p ρ,\n (x, v (x, y)) ∈ Metric.ball (p, 0) r ∧\n (Φ (τ, (x, v (x, y)))).1 = y := by\n obtain ⟨R, hR, K, hLip, hdom, r, hr, ε, hε, Φ, hΦ, hΦ0, hΦF, hΦp⟩ :=\n Helpers.exists_coordinate_spray_flow_in_lipschitz_ball hU hΓ hp\n let τ : ℝ := ε / 2\n have hτpos : 0 < τ := half_pos hε\n have hτε : τ < ε := by dsimp [τ]; linarith\n have hτ : τ ∈ Set.Ioo (-ε) ε := ⟨by linarith, hτε⟩\n have hΦat : ContDiffAt ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Φ (τ, (p, 0)) :=\n hΦ.contDiffAt ((isOpen_Ioo.prod Metric.isOpen_ball).mem_nhds\n ⟨hτ, Metric.mem_ball_self hr⟩)\n have hlin := Helpers.coordinate_spray_flow_linearization hU hp\n ((hΓ.contDiffAt (hU.mem_nhds hp)).differentiableAt (by simp)) hr hε\n (hΦ.of_le (by simp)) hΦ0 hΦp (fun z hz => (hΦF z hz).2)\n obtain ⟨e, he0, hept, hef, he, hei⟩ :=\n Helpers.exists_joint_inverse_of_spray_flow_linearization hτpos.ne' hΦat (hΦp τ hτ)\n (hlin τ hτ)\n have hep : e (p, 0) = (p, p) := by rw [hef, hΦp τ hτ]\n obtain ⟨ρ, hρ, v, hv, hv0, hpair⟩ :=\n Helpers.exists_pair_neighborhood_of_joint_endpoint_inverse e he0 hep hef hei\n Metric.isOpen_ball (Metric.mem_ball_self hr)\n refine ⟨r, hr, ε, hε, τ, ⟨hτpos, hτε⟩, Φ, hΦ, hΦ0, ?_, ρ, hρ, v, hv, hv0, ?_⟩\n · intro z hz\n exact ⟨hdom _ (hΦF z hz).1, (hΦF z hz).2⟩\n · intro x hx y hy\n exact ⟨(hpair x hx y hy).1, (hpair x hx y hy).2.2⟩\ntheorem Helpers.riemannian_endpointGerm_continuation\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M] :\n let L : (ℝ → M) → NNReal → Set ℝ → Prop := fun γ c S =>\n ∀ t₀ ∈ S, ∃ δ > (0 : ℝ), ∀ s t : ℝ,\n s ∈ S ∩ Set.Ioo (t₀ - δ) (t₀ + δ) →\n t ∈ S ∩ Set.Ioo (t₀ - δ) (t₀ + δ) →\n edist (γ s) (γ t) = (c : ENNReal) * ENNReal.ofReal |t - s|\n ∀ (a b : ℝ) (γ : ℝ → M) (c : NNReal) (p : M), a < b →\n L γ c (Set.Ioo a b) →\n Filter.Tendsto γ (nhdsWithin b (Set.Ioo a b)) (nhds p) →\n ∃ ε > (0 : ℝ), ∃ η : ℝ → M,\n L η c (Set.Ioo (b - ε) (b + ε)) ∧\n ∀ t ∈ Set.Ioo (max a (b - ε)) b, η t = γ t := by\n dsimp only\n intro a b γ c p hab hlin hγ\n change Helpers.MetricLocallyLinear γ c (Set.Ioo a b) at hlin\n change ∃ ε > (0 : ℝ), ∃ η : ℝ → M,\n Helpers.MetricLocallyLinear η c (Set.Ioo (b - ε) (b + ε)) ∧\n ∀ t ∈ Set.Ioo (max a (b - ε)) b, η t = γ t\n by_cases hc : c = 0\n · subst c\n exact Helpers.metricEndpointGerm_of_zero_speed hab hlin\n have hcpos : 0 < c := (show 0 ≤ c from zero_le).lt_of_ne (Ne.symm hc)\n obtain ⟨g, Γ, hg, hsym, hpos, hnorm, hΓ, hKoszul⟩ :=\n Helpers.exists_smooth_coordinate_metric_and_koszul I p\n obtain ⟨a', ha', v, hv⟩ := Helpers.metricLocallyLinear_fixed_endpoint_chart_phase\n I M p g Γ hg hΓ hsym hpos hnorm hKoszul hcpos hab hlin hγ\n have hU : IsOpen (extChartAt I p).target := isOpen_extChartAt_target p\n have hpU : extChartAt I p p ∈ (extChartAt I p).target := mem_extChartAt_target p\n have hxlim : Filter.Tendsto (fun t : ℝ => extChartAt I p (γ t))\n (nhdsWithin b (Set.Ioo a' b)) (nhds (extChartAt I p p)) := by\n have h := (continuousAt_extChartAt (I := I) p).tendsto.comp hγ\n simpa only [Function.comp_def, nhdsWithin_Ioo_eq_nhdsLT hab,\n nhdsWithin_Ioo_eq_nhdsLT ha'.2] using h\n obtain ⟨r, hr, X, V, hXb, hphase, hODE, hEnergy, heq⟩ :=\n Helpers.exists_energy_preserving_spray_continuation hU (hg.of_le (by simp)) hΓ\n hsym hKoszul ha'.2 hpU (hpos _ hpU)\n (fun t ht => ⟨(hv t ht).2.2.1, (hv t ht).2.2.2.1⟩) hxlim\n (fun t ht => (hv t ht).2.2.2.2)\n have hshift (t : ℝ) (ht : t ∈ Set.Ioo (-r) r) :\n t + b ∈ Set.Ioo (b - r) (b + r) := by\n constructor <;> linarith [ht.1, ht.2]\n have hphaseShift : ContDiffOn ℝ ∞ (fun t : ℝ => (X (t + b), V (t + b)))\n (Set.Ioo (-r) r) :=\n hphase.comp (contDiff_id.add contDiff_const).contDiffOn hshift\n have hODEShift : ∀ t ∈ Set.Ioo (-r) r,\n X (t + b) ∈ (extChartAt I p).target ∧\n HasDerivAt (fun s : ℝ => X (s + b)) (V (t + b)) t ∧\n HasDerivAt (fun s : ℝ => V (s + b))\n (-(Γ (X (t + b)) (V (t + b)) (V (t + b)))) t := by\n intro t ht\n have h := hODE (t + b) (hshift t ht)\n refine ⟨h.1, ?_, ?_⟩\n · simpa only [Function.comp_def, id_eq, one_smul] using\n h.2.1.scomp t ((hasDerivAt_id t).add_const b)\n · simpa only [Function.comp_def, id_eq, one_smul] using\n h.2.2.scomp t ((hasDerivAt_id t).add_const b)\n obtain ⟨δ, hδ, hδr, hdist⟩ := Helpers.coordinate_spray_locally_distance_linear\n I M p g Γ hg hΓ hsym hpos hnorm hKoszul hr (by simpa using hXb)\n hphaseShift hODEShift (fun t ht => hEnergy (t + b) (hshift t ht))\n let ε := min δ (b - a')\n have hε : 0 < ε := lt_min hδ (sub_pos.mpr ha'.2)\n have hεδ : ε ≤ δ := min_le_left _ _\n have hεa' : ε ≤ b - a' := min_le_right _ _\n let η : ℝ → M := fun t => (extChartAt I p).symm (X t)\n refine ⟨ε, hε, η, ?_, ?_⟩\n · intro t₀ ht₀\n refine ⟨1, zero_lt_one, ?_⟩\n intro s t hs ht\n have hs' : s - b ∈ Set.Ioo (-δ) δ := by\n constructor <;> linarith [hs.1.1, hs.1.2]\n have ht' : t - b ∈ Set.Ioo (-δ) δ := by\n constructor <;> linarith [ht.1.1, ht.1.2]\n have hdiff : (t - b) - (s - b) = t - s := by ring\n simpa only [η, sub_add_cancel, hdiff] using hdist (s - b) hs' (t - b) ht'\n · intro t ht\n have htbε : b - ε < t := (le_max_right a (b - ε)).trans_lt ht.1\n have hta' : a' < t := by linarith\n have htr : t ∈ Set.Ioo (b - r) b :=\n ⟨by linarith, ht.2⟩\n change (extChartAt I p).symm (X t) = γ t\n rw [(heq t htr).1]\n exact (extChartAt I p).left_inv (hv t ⟨hta', ht.2⟩).1\ntheorem hopf_rinow {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)\n [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M] [IsManifold I ∞ M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I ∞ E (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M]\n [LocallyCompactSpace M] [ConnectedSpace M] :\n IsGeodesicallyComplete M ↔ CompleteSpace M := by\n constructor\n · exact Helpers.completeSpace_of_isGeodesicallyComplete I M\n · intro hcomplete\n letI : CompleteSpace M := hcomplete\n exact Helpers.isGeodesicallyComplete_of_endpointGerm M\n (Helpers.riemannian_endpointGerm_continuation I M)\nend Submission\n" }, { "name": "Submission/Helpers.lean", "path": "accepted/hopf_rinow/Submission/Helpers.lean", "url": "https://github.com/LikC1606/theorem-os-site/blob/main/accepted/hopf_rinow/Submission/Helpers.lean", "sha256": "f62e16b14fff319f20788b03d94cf9de1262dcfa0cc6462b539faa5435573c40", "lines": 4275, "code": "import Mathlib.Analysis.Calculus.FDeriv.Extend\nimport Mathlib.MeasureTheory.Integral.IntervalIntegral.AbsolutelyContinuousFun\nimport Mathlib.Analysis.Calculus.Rademacher\nimport Mathlib.Analysis.Calculus.InverseFunctionTheorem.ContDiff\nimport Mathlib.Analysis.Calculus.FDeriv.Symmetric\nimport Mathlib.Analysis.Calculus.Deriv.Prod\nimport Mathlib.Analysis.ODE.ExistUnique\nimport Mathlib.Topology.Order.ProjIcc\nimport Mathlib.Analysis.Calculus.ImplicitContDiff\nimport Mathlib.Analysis.Distribution.AEEqOfIntegralContDiff\nimport Mathlib.Analysis.Calculus.BumpFunction.Normed\nimport Mathlib.MeasureTheory.Integral.IntervalIntegral.FundThmCalculus\nimport Mathlib.Analysis.Calculus.ContDiff.Deriv\nimport Mathlib.Analysis.SpecialFunctions.Sqrt\nimport Mathlib.Algebra.QuadraticDiscriminant\nimport Mathlib.Analysis.Calculus.MeanValue\nimport Mathlib.Analysis.Calculus.ContDiff.RCLike\nimport Mathlib.Topology.ContinuousMap.Compact\nimport Mathlib.Topology.Order.Compact\nimport Mathlib.Topology.Connected.Clopen\nimport Mathlib.Topology.MetricSpace.ProperSpace\nimport Mathlib.Topology.MetricSpace.Completion\nimport Mathlib.Order.Zorn\nimport Mathlib.Topology.Order.IntermediateValue\nimport Mathlib.Topology.UniformSpace.Cauchy\nimport Mathlib.Topology.EMetricSpace.Lipschitz\nimport Mathlib.Topology.Instances.ENNReal.Lemmas\nimport Mathlib.Tactic\nimport Mathlib.Tactic.Ring\nimport Mathlib.LinearAlgebra.Dual.Lemmas\nimport Mathlib.Analysis.Calculus.ContDiff.Operations\nimport Mathlib.Geometry.Manifold.ContMDiffMFDeriv\nimport Mathlib.Analysis.Calculus.ContDiff.FiniteDimension\nimport Mathlib.Geometry.Manifold.Riemannian.Basic\nimport Mathlib.Geometry.Manifold.VectorBundle.CovariantDerivative.LeviCivita\nnamespace Submission.Helpers\n\ntheorem exists_velocity_limit_of_bounded_spray_curve\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {a b : ℝ} {x v : ℝ → E} {p : E}\n {Γ : E → E →L[ℝ] E →L[ℝ] E}\n (hab : a < b) (hΓ : ContinuousAt Γ p)\n (hx : Filter.Tendsto x (nhdsWithin b (Set.Ioo a b)) (nhds p))\n (hv : ∃ K : ℝ, ∀ t ∈ Set.Ioo a b, ‖v t‖ ≤ K)\n (hODE : ∀ t ∈ Set.Ioo a b, HasDerivAt v (-(Γ (x t) (v t) (v t))) t) :\n ∃ w : E, Filter.Tendsto v (nhdsWithin b (Set.Ioo a b)) (nhds w) := by\n letI : NormedAddCommGroup (E →L[ℝ] E →L[ℝ] E) :=\n ContinuousLinearMap.toNormedAddCommGroup\n obtain ⟨K, hK⟩ := hv\n have hKnonneg : 0 ≤ K :=\n (norm_nonneg (v ((a + b) / 2))).trans (hK _ ⟨by linarith, by linarith⟩)\n have hΓx := hΓ.tendsto.comp hx\n have hnorm := Filter.Tendsto.norm (E := E →L[ℝ] E →L[ℝ] E) hΓx\n have hcoef : ∀ᶠ t in nhdsWithin b (Set.Ioo a b), ‖Γ (x t)‖ < ‖Γ p‖ + 1 :=\n hnorm.eventually_lt_const (lt_add_one _)\n rw [nhdsWithin_Ioo_eq_nhdsLT hab] at hcoef\n obtain ⟨d, hd, htail⟩ := (mem_nhdsLT_iff_exists_mem_Ico_Ioo_subset hab).mp hcoef\n have hsub : Set.Ioo d b ⊆ Set.Ioo a b :=\n fun t ht => ⟨hd.1.trans_lt ht.1, ht.2⟩\n let C : NNReal := ⟨(‖Γ p‖ + 1) * K ^ 2, by positivity⟩\n have hacc : ∀ t ∈ Set.Ioo d b, ‖-(Γ (x t) (v t) (v t))‖ ≤ (C : ℝ) := by\n intro t ht\n calc\n ‖-(Γ (x t) (v t) (v t))‖ = ‖Γ (x t) (v t) (v t)‖ := norm_neg _\n _ ≤ ‖Γ (x t)‖ * ‖v t‖ * ‖v t‖ := (Γ (x t)).le_opNorm₂ _ _\n _ ≤ (‖Γ p‖ + 1) * K * K := by\n gcongr\n · exact (htail ht).le\n · exact hK t (hsub ht)\n · exact hK t (hsub ht)\n _ = (C : ℝ) := by\n change (‖Γ p‖ + 1) * K * K = (‖Γ p‖ + 1) * K ^ 2\n ring\n have hlip : LipschitzOnWith C v (Set.Ioo d b) :=\n (convex_Ioo d b).lipschitzOnWith_of_nnnorm_hasDerivWithin_le\n (fun t ht => (hODE t (hsub ht)).hasDerivWithinAt)\n (fun t ht => NNReal.coe_le_coe.mp (hacc t ht))\n letI := right_nhdsWithin_Ioo_neBot hd.2\n obtain ⟨w, hw⟩ : ∃ w : E,\n Filter.Tendsto v (nhdsWithin b (Set.Ioo d b)) (nhds w) := by\n apply cauchy_map_iff_exists_tendsto.mp\n exact (cauchy_nhds.mono nhdsWithin_le_nhds).map_of_le\n hlip.uniformContinuousOn inf_le_right\n refine ⟨w, ?_⟩\n simpa only [nhdsWithin_Ioo_eq_nhdsLT hab, nhdsWithin_Ioo_eq_nhdsLT hd.2] using hw\ntheorem coordinate_spray_endpoint_radial_ode\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (Γ : E → E →L[ℝ] E →L[ℝ] E)\n (Φ : ℝ × (E × E) → E × E) (e : E → E) (τ : ℝ) (p v : E)\n (he : ∀ t ∈ Set.Ioo (-1 : ℝ) 1, DifferentiableAt ℝ e (t • v))\n (hscale : ∀ t ∈ Set.Ioo (-1 : ℝ) 1,\n e (t • v) = (Φ (τ * t, (p,v))).1)\n (hODE : ∀ t ∈ Set.Ioo (-1 : ℝ) 1,\n HasDerivAt (fun s : ℝ => Φ (s,(p,v)))\n ((Φ (τ * t,(p,v))).2,\n -(Γ (Φ (τ * t,(p,v))).1 (Φ (τ * t,(p,v))).2\n (Φ (τ * t,(p,v))).2)) (τ * t)) :\n ∀ t ∈ Set.Ioo (-1 : ℝ) 1,\n HasDerivAt (fun s : ℝ => e (s • v)) (fderiv ℝ e (t • v) v) t ∧\n HasDerivAt (fun s : ℝ => fderiv ℝ e (s • v) v)\n (-(Γ (e (t • v)) (fderiv ℝ e (t • v) v) (fderiv ℝ e (t • v) v))) t := by\n have hphase (t : ℝ) (ht : t ∈ Set.Ioo (-1 : ℝ) 1) :\n HasDerivAt (fun s : ℝ => ((Φ (τ * s,(p,v))).1, τ • (Φ (τ * s,(p,v))).2))\n (τ • (Φ (τ * t,(p,v))).2,\n -(Γ (Φ (τ * t,(p,v))).1 (τ • (Φ (τ * t,(p,v))).2)\n (τ • (Φ (τ * t,(p,v))).2))) t := by\n have htime : HasDerivAt (fun s : ℝ => τ * s) τ t := by\n simpa using (hasDerivAt_id t).const_mul τ\n have hd := (hODE t ht).scomp t htime\n have hx : HasDerivAt (fun s : ℝ => (Φ (τ * s,(p,v))).1)\n (τ • (Φ (τ * t,(p,v))).2) t := by\n simpa only [Function.comp_def, ContinuousLinearMap.coe_fst', Prod.smul_fst] using\n (ContinuousLinearMap.fst ℝ E E).hasFDerivAt.comp_hasDerivAt t hd\n have hv : HasDerivAt (fun s : ℝ => (Φ (τ * s,(p,v))).2)\n (τ • (-(Γ (Φ (τ * t,(p,v))).1 (Φ (τ * t,(p,v))).2\n (Φ (τ * t,(p,v))).2))) t := by\n simpa only [Function.comp_def, ContinuousLinearMap.coe_snd', Prod.smul_snd] using\n (ContinuousLinearMap.snd ℝ E E).hasFDerivAt.comp_hasDerivAt t hd\n convert hx.prodMk (hv.const_smul τ) using 1\n simp only [map_smul, smul_apply, smul_neg]\n have hchain (t : ℝ) (ht : t ∈ Set.Ioo (-1 : ℝ) 1) :\n HasDerivAt (fun s : ℝ => e (s • v)) (fderiv ℝ e (t • v) v) t := by\n simpa only [Function.comp_def, one_smul, id_eq] using\n (he t ht).hasFDerivAt.comp_hasDerivAt t ((hasDerivAt_id t).smul_const v)\n have hvel (t : ℝ) (ht : t ∈ Set.Ioo (-1 : ℝ) 1) :\n fderiv ℝ e (t • v) v = τ • (Φ (τ * t,(p,v))).2 := by\n have hx : HasDerivAt (fun s : ℝ => (Φ (τ * s,(p,v))).1)\n (τ • (Φ (τ * t,(p,v))).2) t := by\n simpa only [Function.comp_def, ContinuousLinearMap.coe_fst'] using\n (ContinuousLinearMap.fst ℝ E E).hasFDerivAt.comp_hasDerivAt t (hphase t ht)\n apply (hchain t ht).unique\n apply hx.congr_of_eventuallyEq\n filter_upwards [isOpen_Ioo.mem_nhds ht] with s hs\n exact hscale s hs\n intro t ht\n refine ⟨hchain t ht, ?_⟩\n have hv : HasDerivAt (fun s : ℝ => τ • (Φ (τ * s,(p,v))).2)\n (-(Γ (Φ (τ * t,(p,v))).1 (τ • (Φ (τ * t,(p,v))).2)\n (τ • (Φ (τ * t,(p,v))).2))) t := by\n simpa only [Function.comp_def, ContinuousLinearMap.coe_snd'] using\n (ContinuousLinearMap.snd ℝ E E).hasFDerivAt.comp_hasDerivAt t (hphase t ht)\n have hv' : HasDerivAt (fun s : ℝ => fderiv ℝ e (s • v) v)\n (-(Γ (Φ (τ * t,(p,v))).1 (τ • (Φ (τ * t,(p,v))).2)\n (τ • (Φ (τ * t,(p,v))).2))) t := by\n apply hv.congr_of_eventuallyEq\n filter_upwards [isOpen_Ioo.mem_nhds ht] with s hs\n exact hvel s hs\n simpa only [← hscale t ht, ← hvel t ht] using hv'\ntheorem ae_hasDerivAt_of_lipschitzOnWith_Icc : open MeasureTheory in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {x : ℝ → E} {K : NNReal} {a b : ℝ}, LipschitzOnWith K x (Set.Icc a b) →\n ∀ᵐ t : ℝ, t ∈ Set.Icc a b → HasDerivAt x (deriv x t) t := by\n intro E _ _ _ x K a b hLip\n have hLip' := hLip.mono Set.Ioo_subset_Icc_self\n filter_upwards [hLip'.ae_differentiableWithinAt_of_mem (μ := MeasureTheory.volume),\n MeasureTheory.volume.ae_ne a, MeasureTheory.volume.ae_ne b] with t ht hta htb htab\n have ht' : t ∈ Set.Ioo a b :=\n ⟨lt_of_le_of_ne htab.1 (Ne.symm hta), lt_of_le_of_ne htab.2 htb⟩\n exact ((ht ht').differentiableAt (isOpen_Ioo.mem_nhds ht')).hasDerivAt\ntheorem eq_smul_of_bilinear_radial_equality\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (B : E →L[ℝ] E →L[ℝ] ℝ)\n (hsym : ∀ u v : E, B u v = B v u)\n (hpos : ∀ u : E, u ≠ 0 → 0 < B u u)\n (u v : E) (c : ℝ) (hu : 0 < B u u)\n (hv : B v v ≤ c ^ 2)\n (huv : B u v = c * Real.sqrt (B u u)) :\n v = (c / Real.sqrt (B u u)) • u := by\n let r := Real.sqrt (B u u)\n have hr : 0 < r := Real.sqrt_pos.mpr hu\n have hrr : r ^ 2 = B u u := Real.sq_sqrt hu.le\n have hquad : B (r • v - c • u) (r • v - c • u) =\n r ^ 2 * B v v - 2 * r * c * B u v + c ^ 2 * B u u := by\n simp only [map_sub, map_smul, sub_apply, smul_apply, smul_eq_mul, hsym v u]\n ring\n have hnonpos : B (r • v - c • u) (r • v - c • u) ≤ 0 := by\n rw [hquad, huv]\n change r ^ 2 * B v v - 2 * r * c * (c * r) + c ^ 2 * B u u ≤ 0\n nlinarith [mul_nonneg (sq_nonneg r) (sub_nonneg.mpr hv)]\n have hz : r • v - c • u = 0 := by\n by_contra hne\n exact (not_lt_of_ge hnonpos) (hpos _ hne)\n have heq : r • v = c • u := sub_eq_zero.mp hz\n calc\n v = r⁻¹ • (r • v) := by rw [smul_smul, inv_mul_cancel₀ hr.ne', one_smul]\n _ = r⁻¹ • (c • u) := congrArg (fun w : E => r⁻¹ • w) heq\n _ = (c / Real.sqrt (B u u)) • u := by rw [smul_smul]; congr 1; dsimp [r]; ring\ntheorem radial_gauss_eq_of_speed_bound\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (B B₀ : E →L[ℝ] E →L[ℝ] ℝ)\n (hsym : ∀ u v : E, B u v = B v u)\n (hpos : ∀ u : E, u ≠ 0 → 0 < B u u)\n (L : E →L[ℝ] E) (hL : Function.Injective L) (u v : E) (c : ℝ)\n (hGauss : ∀ w : E, B (L u) (L w) = B₀ u w)\n (hu : 0 < B₀ u u) (hv : B (L v) (L v) ≤ c ^ 2)\n (huv : B₀ u v = c * Real.sqrt (B₀ u u)) :\n v = (c / Real.sqrt (B₀ u u)) • u := by\n apply hL\n rw [map_smul]\n have h := eq_smul_of_bilinear_radial_equality B hsym hpos (L u) (L v) c\n (by simpa only [hGauss] using hu) hv (by simpa only [hGauss] using huv)\n simpa only [hGauss] using h\ntheorem radial_of_lipschitzOnWith_ae_radial_deriv : open MeasureTheory in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {x : ℝ → E} {K : NNReal} {a b t₀ : ℝ},\n t₀ < a → a ≤ b → LipschitzOnWith K x (Set.Icc a b) →\n (∀ᵐ t : ℝ, t ∈ Set.Icc a b →\n HasDerivAt x ((t - t₀)⁻¹ • x t) t) →\n ∃ w : E, ∀ t ∈ Set.Icc a b, x t = (t - t₀) • w := by\n intro E _ _ x K a b t₀ ht₀ hab hLip hderiv\n have hne (t : ℝ) (ht : t ∈ Set.uIcc a b) : t - t₀ ≠ 0 := by\n rw [Set.uIcc_of_le hab] at ht\n exact ne_of_gt (by linarith [ht.1])\n have hscalar : ContDiffOn ℝ 1 (fun t : ℝ => (t - t₀)⁻¹) (Set.uIcc a b) :=\n (contDiffOn_id.sub contDiffOn_const).inv hne\n have hx : AbsolutelyContinuousOnInterval x a b :=\n (show LipschitzOnWith K x (Set.uIcc a b) by\n simpa only [Set.uIcc_of_le hab] using hLip).absolutelyContinuousOnInterval\n have hnorm : AbsolutelyContinuousOnInterval (fun t => (t - t₀)⁻¹ • x t) a b :=\n hscalar.absolutelyContinuousOnInterval.smul hx\n have hzero : ∀ᵐ t : ℝ, t ∈ Set.uIcc a b →\n HasDerivAt (fun s => (s - t₀)⁻¹ • x s) 0 t := by\n filter_upwards [hderiv] with t ht htab\n have hh := (((hasDerivAt_id t).sub_const t₀).inv (hne t htab)).smul\n (ht (by simpa only [Set.uIcc_of_le hab] using htab))\n have hcoef : (t - t₀)⁻¹ * (t - t₀)⁻¹ + -1 / (t - t₀) ^ 2 = 0 := by\n field_simp\n <;> ring\n convert hh using 1\n · ext s\n rfl\n · simp only [Pi.inv_apply, id_eq, smul_smul, ← add_smul, hcoef, zero_smul]\n obtain ⟨w, hw⟩ := hnorm.const_of_ae_hasDerivAt_zero hzero\n refine ⟨w, fun t ht => ?_⟩\n have ht' : t ∈ Set.uIcc a b := by simpa only [Set.uIcc_of_le hab] using ht\n rw [← hw t ht', smul_smul, mul_inv_cancel₀ (hne t ht'), one_smul]\ntheorem radial_of_gauss_speed_bound : open MeasureTheory in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n (B₀ : E →L[ℝ] E →L[ℝ] ℝ) (B : ℝ → E →L[ℝ] E →L[ℝ] ℝ)\n (L : ℝ → E →L[ℝ] E) (x : ℝ → E) (K : NNReal) (a b t₀ c : ℝ),\n (∀ u v, B₀ u v = B₀ v u) → 0 < c → t₀ < a → a ≤ b →\n LipschitzOnWith K x (Set.Icc a b) →\n (∀ t ∈ Set.Icc a b, ∀ u v, B t u v = B t v u) →\n (∀ t ∈ Set.Icc a b, ∀ u, u ≠ 0 → 0 < B t u u) →\n (∀ t ∈ Set.Icc a b, Function.Injective (L t)) →\n (∀ t ∈ Set.Icc a b, ∀ w,\n B t (L t (x t)) (L t w) = B₀ (x t) w) →\n (∀ t ∈ Set.Icc a b, Real.sqrt (B₀ (x t) (x t)) = c * (t - t₀)) →\n (∀ᵐ t : ℝ, t ∈ Set.Icc a b →\n B t (L t (deriv x t)) (L t (deriv x t)) ≤ c ^ 2) →\n ∃ w : E, ∀ t ∈ Set.Icc a b, x t = (t - t₀) • w := by\n intro E _ _ _ B₀ B L x K a b t₀ c hsym₀ hc ht₀ hab hLip hsym hpos hL\n hGauss hradius hspeed\n have htime (t : ℝ) (ht : t ∈ Set.Icc a b) : 0 < t - t₀ := by\n linarith [ht.1]\n have hquadpos (t : ℝ) (ht : t ∈ Set.Icc a b) : 0 < B₀ (x t) (x t) := by\n apply Real.sqrt_pos.mp\n rw [hradius t ht]\n exact mul_pos hc (htime t ht)\n have hsq (t : ℝ) (ht : t ∈ Set.Icc a b) :\n B₀ (x t) (x t) = (c * (t - t₀)) ^ 2 := by\n rw [← hradius t ht, Real.sq_sqrt (hquadpos t ht).le]\n apply radial_of_lipschitzOnWith_ae_radial_deriv ht₀ hab hLip\n filter_upwards [ae_hasDerivAt_of_lipschitzOnWith_Icc hLip, hspeed,\n MeasureTheory.volume.ae_ne a, MeasureTheory.volume.ae_ne b]\n with t hdt hspeedt hta htb ht\n have hti : t ∈ Set.Ioo a b :=\n ⟨lt_of_le_of_ne ht.1 (Ne.symm hta), lt_of_le_of_ne ht.2 htb⟩\n have hdx := hdt ht\n have hq := (B₀.hasFDerivAt.comp_hasDerivAt t hdx).clm_apply hdx\n have hq' : HasDerivAt (fun s => B₀ (x s) (x s))\n (2 * B₀ (x t) (deriv x t)) t := by\n convert hq using 1 <;> simp only [Function.comp_apply, hsym₀ (deriv x t) (x t)] <;> ring\n have hpoly : HasDerivAt (fun s : ℝ => (c * (s - t₀)) ^ 2)\n (2 * c ^ 2 * (t - t₀)) t := by\n have hlinear : HasDerivAt (fun s : ℝ => c * (s - t₀)) c t := by\n simpa only [id_eq, mul_one] using\n (((hasDerivAt_id t).sub_const t₀).const_mul c)\n convert hlinear.mul hlinear using 1\n · funext s\n simp only [Pi.mul_apply]\n ring\n · ring\n have heq : (fun s => B₀ (x s) (x s)) =ᶠ[nhds t]\n (fun s => (c * (s - t₀)) ^ 2) := by\n filter_upwards [isOpen_Ioo.mem_nhds hti] with s hs\n exact hsq s ⟨hs.1.le, hs.2.le⟩\n have hderiv_eq := hq'.unique (hpoly.congr_of_eventuallyEq heq)\n have hpair : B₀ (x t) (deriv x t) = c * Real.sqrt (B₀ (x t) (x t)) := by\n rw [hradius t ht]\n nlinarith [hderiv_eq]\n have hradial := radial_gauss_eq_of_speed_bound (B t) B₀ (hsym t ht)\n (hpos t ht) (L t) (hL t ht) (x t) (deriv x t) c\n (hGauss t ht) (hquadpos t ht) (hspeedt ht) hpair\n have hcoef : c / Real.sqrt (B₀ (x t) (x t)) = (t - t₀)⁻¹ := by\n rw [hradius t ht]\n field_simp [hc.ne', (htime t ht).ne']\n exact hdx.congr_deriv (by simpa only [hcoef] using hradial)\ntheorem hasFDerivAt_regularized_bilinear_radius\n {E F : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n [NormedAddCommGroup F] [NormedSpace ℝ F]\n (B : F →L[ℝ] F →L[ℝ] ℝ) (hsym : ∀ u v, B u v = B v u)\n {f : E → F} {f' : E →L[ℝ] F} {x : E}\n (hf : HasFDerivAt f f' x) {δ : ℝ}\n (hpos : 0 < B (f x) (f x) + δ) :\n HasFDerivAt (fun y => Real.sqrt (B (f y) (f y) + δ))\n ((Real.sqrt (B (f x) (f x) + δ))⁻¹ • ((B (f x)).comp f')) x := by\n have hq : HasFDerivAt (fun y => B (f y) (f y))\n ((2 : ℝ) • ((B (f x)).comp f')) x := by\n convert (B.hasFDerivAt.comp x hf).clm_apply hf using 1\n · rfl\n · ext w\n simp only [smul_apply, ContinuousLinearMap.comp_apply,\n add_apply, ContinuousLinearMap.flip_apply,\n Function.comp_apply, smul_eq_mul]\n rw [hsym (f' w) (f x)]\n ring\n convert (hq.add_const δ).sqrt hpos.ne' using 1\n ext w\n simp only [smul_apply, smul_eq_mul, one_div, mul_inv_rev]\n ring\ntheorem bilinear_radius_sub_le_integral_of_bound : open MeasureTheory in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (B₀ : E →L[ℝ] E →L[ℝ] ℝ),\n (∀ u v : E, B₀ u v = B₀ v u) → (∀ u : E, 0 ≤ B₀ u u) →\n ∀ (a b : ℝ), a ≤ b → ∀ (γ v : ℝ → E) (h : ℝ → ℝ),\n ContinuousOn v (Set.Icc a b) → ContinuousOn h (Set.Icc a b) →\n (∀ t ∈ Set.Icc a b, HasDerivAt γ (v t) t) →\n (∀ t ∈ Set.Icc a b, 0 ≤ h t) →\n (∀ t ∈ Set.Icc a b,\n |B₀ (γ t) (v t)| ≤ Real.sqrt (B₀ (γ t) (γ t)) * h t) →\n |Real.sqrt (B₀ (γ b) (γ b)) - Real.sqrt (B₀ (γ a) (γ a))| ≤\n ∫ t in a..b, h t := by\n intro E _ _ B₀ hsymm hnonneg a b hab γ v h hv hh hγ hhpos hbound\n have hγc : ContinuousOn γ (Set.Icc a b) :=\n fun t ht => (hγ t ht).continuousAt.continuousWithinAt\n have hBc : ContinuousOn (fun t => B₀ (γ t)) (Set.Icc a b) :=\n B₀.continuous.comp_continuousOn hγc\n have hqc : ContinuousOn (fun t => B₀ (γ t) (γ t)) (Set.Icc a b) :=\n hBc.clm_apply hγc\n have hregular (δ : ℝ) (hδ : 0 < δ) :\n |Real.sqrt (B₀ (γ b) (γ b) + δ) - Real.sqrt (B₀ (γ a) (γ a) + δ)| ≤\n ∫ t in a..b, h t := by\n let f : ℝ → ℝ := fun t => Real.sqrt (B₀ (γ t) (γ t) + δ)\n let D : ℝ → ℝ := fun t => B₀ (γ t) (v t) / Real.sqrt (B₀ (γ t) (γ t) + δ)\n have hsqrtpos (t : ℝ) : 0 < Real.sqrt (B₀ (γ t) (γ t) + δ) :=\n Real.sqrt_pos.mpr (add_pos_of_nonneg_of_pos (hnonneg _) hδ)\n have hD (t : ℝ) (ht : t ∈ Set.Icc a b) : HasDerivAt f (D t) t := by\n have hq := (B₀.hasFDerivAt.comp_hasDerivAt t (hγ t ht)).clm_apply (hγ t ht)\n have hq' : HasDerivAt (fun s => B₀ (γ s) (γ s)) (2 * B₀ (γ t) (v t)) t := by\n convert hq using 1 <;> simp only [Function.comp_apply, hsymm (v t) (γ t)] <;> ring\n dsimp only [f, D]\n convert (hq'.add_const δ).sqrt\n (ne_of_gt (add_pos_of_nonneg_of_pos (hnonneg _) hδ)) using 1 <;> field_simp\n have hDc : ContinuousOn D (Set.Icc a b) :=\n (hBc.clm_apply hv).div (hqc.add continuousOn_const).sqrt\n (fun t _ => ne_of_gt (hsqrtpos t))\n have hDbound (t : ℝ) (ht : t ∈ Set.Icc a b) : |D t| ≤ h t := by\n dsimp only [D]\n rw [abs_div, abs_of_pos (hsqrtpos t), div_le_iff₀ (hsqrtpos t)]\n calc\n |B₀ (γ t) (v t)| ≤ Real.sqrt (B₀ (γ t) (γ t)) * h t := hbound t ht\n _ ≤ Real.sqrt (B₀ (γ t) (γ t) + δ) * h t :=\n mul_le_mul_of_nonneg_right (Real.sqrt_le_sqrt (by linarith)) (hhpos t ht)\n _ = h t * Real.sqrt (B₀ (γ t) (γ t) + δ) := mul_comm _ _\n have hFTC : (∫ t in a..b, D t) = f b - f a :=\n intervalIntegral.integral_eq_sub_of_hasDerivAt\n (fun t ht => hD t (by simpa only [Set.uIcc_of_le hab] using ht))\n (ContinuousOn.intervalIntegrable_of_Icc hab hDc)\n change |f b - f a| ≤ ∫ t in a..b, h t\n rw [← hFTC]\n apply (show ‖∫ t in a..b, D t‖ ≤ ∫ t in a..b, h t from ?_)\n apply intervalIntegral.norm_integral_le_of_norm_le hab\n (Filter.Eventually.of_forall (fun t ht => ?_))\n (ContinuousOn.intervalIntegrable_of_Icc hab hh)\n simpa only [Real.norm_eq_abs] using hDbound t ⟨ht.1.le, ht.2⟩\n have hc : Continuous (fun δ : ℝ =>\n |Real.sqrt (B₀ (γ b) (γ b) + δ) - Real.sqrt (B₀ (γ a) (γ a) + δ)|) := by\n fun_prop\n have hlim : Filter.Tendsto (fun δ : ℝ =>\n |Real.sqrt (B₀ (γ b) (γ b) + δ) - Real.sqrt (B₀ (γ a) (γ a) + δ)|)\n (nhdsWithin 0 (Set.Ioi 0))\n (nhds |Real.sqrt (B₀ (γ b) (γ b)) - Real.sqrt (B₀ (γ a) (γ a))|) := by\n simpa only [add_zero] using\n (hc.continuousAt (x := 0)).tendsto.mono_left nhdsWithin_le_nhds\n apply le_of_tendsto hlim\n filter_upwards [self_mem_nhdsWithin] with δ hδ\n exact hregular δ hδ\ntheorem exists_smooth_test_integral_one : open MeasureTheory in\n ∀ (a b : ℝ), a < b → ∃ θ : ℝ → ℝ,\n ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) θ ∧ HasCompactSupport θ ∧\n tsupport θ ⊆ Set.Ioo a b ∧ (∫ t : ℝ, θ t) = 1 := by\n intro a b hab\n let f : ContDiffBump ((a + b) / 2) :=\n ⟨(b - a) / 8, (b - a) / 4, by linarith, by linarith⟩\n refine ⟨f.normed MeasureTheory.volume, f.contDiff_normed, f.hasCompactSupport_normed, ?_,\n f.integral_normed⟩\n rw [f.tsupport_normed_eq]\n intro t ht\n have ht' : |t - (a + b) / 2| ≤ (b - a) / 4 := by\n simpa only [Metric.mem_closedBall, Real.dist_eq, f] using ht\n obtain ⟨hl, hr⟩ := abs_le.mp ht'\n constructor <;> linarith\ntheorem integrable_test_smul_of_locallyIntegrableOn : open MeasureTheory in\n ∀ {F : Type*} [NormedAddCommGroup F] [NormedSpace ℝ F]\n {U : Set ℝ} {P : ℝ → F}, LocallyIntegrableOn P U →\n ∀ φ : ℝ → ℝ, Continuous φ → HasCompactSupport φ → tsupport φ ⊆ U →\n Integrable (fun t => φ t • P t) := by\n intro F _ _ U P hP φ hφ hc hs\n apply (MeasureTheory.integrableOn_iff_integrable_of_support_subset\n (show Function.support (fun t => φ t • P t) ⊆ tsupport φ from\n (Function.support_smul_subset_left φ P).trans (subset_tsupport φ))).mp\n exact (hP.integrableOn_compact_subset hs hc.isCompact).continuousOn_smul\n hφ.continuousOn hc.isCompact\ntheorem ae_eq_const_of_zero_mean_test_integral_zero : open MeasureTheory in\n ∀ {F : Type*} [NormedAddCommGroup F] [NormedSpace ℝ F] [CompleteSpace F]\n (a b : ℝ), a < b → ∀ P : ℝ → F, LocallyIntegrableOn P (Set.Ioo a b) →\n (∀ φ : ℝ → ℝ, ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) φ →\n HasCompactSupport φ → tsupport φ ⊆ Set.Ioo a b → (∫ t : ℝ, φ t) = 0 →\n (∫ t : ℝ, φ t • P t) = 0) →\n ∃ C : F, ∀ᵐ t : ℝ, t ∈ Set.Ioo a b → P t = C := by\n intro F _ _ _ a b hab P hP hzero\n obtain ⟨θ, hθ, hcθ, hsθ, hiθ⟩ := exists_smooth_test_integral_one a b hab\n let C : F := ∫ t : ℝ, θ t • P t\n have hconst : MeasureTheory.LocallyIntegrableOn (fun _ : ℝ => C) (Set.Ioo a b) :=\n MeasureTheory.locallyIntegrableOn_const C\n have hvanish : ∀ φ : ℝ → ℝ, ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) φ →\n HasCompactSupport φ → tsupport φ ⊆ Set.Ioo a b →\n (∫ t : ℝ, φ t • (P t - C)) = 0 := by\n intro φ hφ hcφ hsφ\n let k : ℝ := ∫ t : ℝ, φ t\n let η : ℝ → ℝ := fun t => φ t - k * θ t\n have hη : ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) η :=\n hφ.sub (contDiff_const.mul hθ)\n have hcη : HasCompactSupport η := hcφ.sub hcθ.mul_left\n have hsη : tsupport η ⊆ Set.Ioo a b :=\n (tsupport_sub φ (fun t => k * θ t)).trans\n (Set.union_subset hsφ (tsupport_mul_subset_right.trans hsθ))\n have hiφ : MeasureTheory.Integrable φ :=\n hφ.continuous.integrable_of_hasCompactSupport hcφ\n have hiθ' : MeasureTheory.Integrable θ :=\n hθ.continuous.integrable_of_hasCompactSupport hcθ\n have hiη : (∫ t : ℝ, η t) = 0 := by\n rw [MeasureTheory.integral_sub hiφ (hiθ'.const_mul k)]\n simp only [MeasureTheory.integral_const_mul, hiθ, mul_one, k, sub_self]\n have heq := hzero η hη hcη hsη hiη\n have hiφP := integrable_test_smul_of_locallyIntegrableOn hP φ hφ.continuous hcφ hsφ\n have hiθP := integrable_test_smul_of_locallyIntegrableOn hP θ hθ.continuous hcθ hsθ\n have hpair : (∫ t : ℝ, φ t • P t) = k • C := by\n have hfun : (fun t => η t • P t) =\n (fun t => φ t • P t - k • (θ t • P t)) := by\n funext t\n simp only [η, sub_smul, mul_smul]\n rw [hfun] at heq\n have hiθPk : MeasureTheory.Integrable (fun t => k • (θ t • P t)) := by\n exact hiθP.fun_smul k\n rw [MeasureTheory.integral_sub hiφP hiθPk,\n MeasureTheory.integral_smul] at heq\n exact sub_eq_zero.mp heq\n have hiφC := hiφ.smul_const C\n simp_rw [smul_sub]\n rw [MeasureTheory.integral_sub hiφP hiφC, integral_smul_const, hpair]\n exact sub_self _\n have hae := isOpen_Ioo.ae_eq_zero_of_integral_contDiff_smul_eq_zero\n (hP.sub hconst) hvanish\n refine ⟨C, ?_⟩\n filter_upwards [hae] with t ht\n intro htab\n exact sub_eq_zero.mp (ht htab)\ntheorem contMDiffAt_clm_of_apply\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] {I : ModelWithCorners ℝ E H}\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M]\n {F : Type*} [NormedAddCommGroup F] [NormedSpace ℝ F] [FiniteDimensional ℝ F]\n {G : Type*} [NormedAddCommGroup G] [NormedSpace ℝ G]\n {n : WithTop ℕ∞} {f : M → F →L[ℝ] G} {x : M}\n (hf : ∀ v, ContMDiffAt I (modelWithCornersSelf ℝ G) n (fun y => f y v) x) :\n ContMDiffAt I (modelWithCornersSelf ℝ (F →L[ℝ] G)) n f x := by\n apply contMDiffAt_iff.mpr\n refine ⟨continuousAt_clm_apply.mpr (fun v => (hf v).continuousAt), ?_⟩\n simpa only [extChartAt_self_apply, modelWithCornersSelf_coe, Function.comp_def,\n Function.id_def] using\n (contDiffWithinAt_clm_apply.mpr (fun v => (contMDiffAt_iff.mp (hf v)).2))\ntheorem exists_smooth_coordinate_metric : open scoped Bundle in open Bundle in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M]\n [IsManifold I (↑(⊤ : ℕ∞) : WithTop ℕ∞) M]\n [RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I (↑(⊤ : ℕ∞) : WithTop ℕ∞) E\n (fun x : M => TangentSpace I x)] (p : M),\n ∃ g : E → E →L[ℝ] E →L[ℝ] ℝ,\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) g (extChartAt I p).target ∧\n (∀ z u v, g z u v = g z v u) ∧\n (∀ z ∈ (extChartAt I p).target, ∀ v : E, v ≠ 0 → 0 < g z v v) ∧\n (∀ z ∈ (extChartAt I p).target, ∀ v : E,\n g z v v = ‖(mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z) v‖ ^ 2) := by\n intro E _ _ _ H _ I _ M _ _ _ _ _ p\n exact (open scoped Bundle in open Bundle ContinuousLinearMap in by\n letI : (y : M) → NormedAddCommGroup (TangentSpace I y) := fun y =>\n Bundle.instNormedAddCommGroupOfRiemannianBundleOfIsTopologicalAddGroupOfContinuousConstSMulReal\n (E := fun x : M => TangentSpace I x) y\n letI : (y : M) → InnerProductSpace ℝ (TangentSpace I y) := fun y =>\n Bundle.instInnerProductSpaceReal (E := fun x : M => TangentSpace I x) y\n let e := trivializationAt E (TangentSpace I : M → Type _) p\n let A (y : M) : E →L[ℝ] E →L[ℝ] ℝ :=\n ((compL ℝ E (TangentSpace I y) ℝ).flip (e.symmL ℝ y)).comp\n ((innerSL ℝ).comp (e.symmL ℝ y))\n have hA (y : M) (hy : y ∈ e.baseSet) :\n ContMDiffAt I (modelWithCornersSelf ℝ (E →L[ℝ] E →L[ℝ] ℝ))\n (↑(⊤ : ℕ∞) : WithTop ℕ∞) A y := by\n apply contMDiffAt_clm_of_apply\n intro u\n apply contMDiffAt_clm_of_apply\n intro v\n change ContMDiffAt I (modelWithCornersSelf ℝ ℝ) (↑(⊤ : ℕ∞) : WithTop ℕ∞)\n (fun q => inner ℝ (e.symmL ℝ q u) (e.symmL ℝ q v)) y\n have hZ (w : E) : ContMDiffAt I I.tangent (↑(⊤ : ℕ∞) : WithTop ℕ∞)\n (fun q => TotalSpace.mk' E q (e.symmL ℝ q w)) y :=\n (e.contMDiffAt_symmL hy).clm_bundle_apply\n (contMDiffAt_totalSpace.mpr ⟨contMDiffAt_id, contMDiffAt_const⟩)\n exact ContMDiffAt.inner_bundle (F := E) (E := fun q : M => TangentSpace I q)\n (hZ u) (hZ v)\n let g : E → E →L[ℝ] E →L[ℝ] ℝ := fun z => A ((extChartAt I p).symm z)\n have hbase {z : E} (hz : z ∈ (extChartAt I p).target) :\n (extChartAt I p).symm z ∈ e.baseSet := by\n simpa only [e, TangentBundle.trivializationAt_baseSet, extChartAt_source] using\n (extChartAt I p).map_target hz\n refine ⟨g, ?_, ?_, ?_, ?_⟩\n · intro z hz\n exact ((hA _ (hbase hz)).comp_contMDiffWithinAt z\n ((contMDiffOn_extChartAt_symm p) z hz)).contDiffWithinAt\n · intro z u v\n exact real_inner_comm (e.symmL ℝ ((extChartAt I p).symm z) u)\n (e.symmL ℝ ((extChartAt I p).symm z) v) |>.symm\n · intro z hz v hv\n change 0 < inner ℝ (e.symmL ℝ _ v) (e.symmL ℝ _ v)\n apply real_inner_self_pos.mpr\n intro heq\n have hh := congrArg (e.continuousLinearMapAt ℝ ((extChartAt I p).symm z)) heq\n exact hv (by simpa only [e.continuousLinearMapAt_symmL (hbase hz), map_zero] using hh)\n · intro z hz v\n have hsymm : e.symmL ℝ ((extChartAt I p).symm z) =\n mfderivWithin (modelWithCornersSelf ℝ E) I (extChartAt I p).symm\n (Set.range I) z := by\n rw [TangentBundle.symmL_trivializationAt (hbase hz)]\n rw [(extChartAt I p).right_inv hz]\n change inner ℝ (e.symmL ℝ _ v) (e.symmL ℝ _ v) = _\n rw [hsymm, real_inner_self_eq_norm_sq]\n rfl)\ntheorem contMDiffAt_tangent_of_inner : open Bundle in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] {I : ModelWithCorners ℝ E H}\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M]\n [IsManifold I (↑(⊤ : ℕ∞) : WithTop ℕ∞) M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I (↑(⊤ : ℕ∞) : WithTop ℕ∞) E\n (fun x : M => TangentSpace I x)]\n {s : (x : M) → TangentSpace I x} {p : M},\n (∀ Z : (x : M) → TangentSpace I x,\n ContMDiffAt I I.tangent 2 (fun x => TotalSpace.mk' E x (Z x)) p →\n ContMDiffAt I (modelWithCornersSelf ℝ ℝ) 1 (fun x => inner ℝ (s x) (Z x)) p) →\n ContMDiffAt I I.tangent 1 (fun x => TotalSpace.mk' E x (s x)) p :=\n by\n intros E _ _ _ H _ I M _ _ _ _ _ s p hs\n exact (open scoped Bundle in open Bundle ContinuousLinearMap in by\n letI : (y : M) → NormedAddCommGroup (TangentSpace I y) := fun y =>\n Bundle.instNormedAddCommGroupOfRiemannianBundleOfIsTopologicalAddGroupOfContinuousConstSMulReal\n (E := fun x : M => TangentSpace I x) y\n letI : (y : M) → InnerProductSpace ℝ (TangentSpace I y) := fun y =>\n Bundle.instInnerProductSpaceReal (E := fun x : M => TangentSpace I x) y\n let e := trivializationAt E (TangentSpace I : M → Type _) p\n have hp : p ∈ e.baseSet := mem_baseSet_trivializationAt E (TangentSpace I) p\n let Z (v : E) (y : M) : TangentSpace I y := e.symmL ℝ y v\n have hZ (v : E) : ContMDiffAt I I.tangent 2\n (fun y => TotalSpace.mk' E y (Z v y)) p := by\n exact (e.contMDiffAt_symmL (n := 2) hp).clm_bundle_apply\n (contMDiffAt_totalSpace.mpr ⟨contMDiffAt_id, contMDiffAt_const⟩)\n let A (y : M) : E →L[ℝ] E →L[ℝ] ℝ :=\n ((compL ℝ E (TangentSpace I y) ℝ).flip (e.symmL ℝ y)).comp\n ((innerSL ℝ).comp (e.symmL ℝ y))\n have hA : ContMDiffAt I (modelWithCornersSelf ℝ (E →L[ℝ] E →L[ℝ] ℝ)) 1 A p := by\n apply contMDiffAt_clm_of_apply\n intro u\n apply contMDiffAt_clm_of_apply\n intro v\n change ContMDiffAt I (modelWithCornersSelf ℝ ℝ) 1\n (fun y => inner ℝ (Z u y) (Z v y)) p\n exact ContMDiffAt.inner_bundle (F := E) (E := fun x : M => TangentSpace I x)\n ((hZ u).of_le (m := 1) (by norm_num)) ((hZ v).of_le (m := 1) (by norm_num))\n have hAi (y : M) (hy : y ∈ e.baseSet) : (A y).IsInvertible := by\n let a := (e.continuousLinearEquivAt ℝ y hy).symm\n let b := (a.trans (InnerProductSpace.toDual ℝ (TangentSpace I y)).toContinuousLinearEquiv).trans\n (a.symm.arrowCongr (ContinuousLinearEquiv.refl ℝ ℝ))\n refine ⟨b, ?_⟩\n ext u v\n simp [b, a, A, ContinuousLinearEquiv.arrowCongr_apply,\n e.symmL_apply hy]\n have hInv : ContMDiffAt I (modelWithCornersSelf ℝ ((E →L[ℝ] ℝ) →L[ℝ] E)) 1\n (fun y => (A y).inverse) p :=\n (hAi p hp).contDiffAt_map_inverse.comp_contMDiffAt hA\n let K (y : M) : E →L[ℝ] ℝ :=\n (innerSL ℝ (s y)).comp (e.symmL ℝ y)\n have hK : ContMDiffAt I (modelWithCornersSelf ℝ (E →L[ℝ] ℝ)) 1 K p := by\n apply contMDiffAt_clm_of_apply\n intro v\n exact hs (Z v) (hZ v)\n apply (contMDiffAt_section p).mpr\n apply (hInv.clm_apply hK).congr_of_eventuallyEq\n filter_upwards [e.open_baseSet.mem_nhds hp] with y hy\n change (e ⟨y, s y⟩).2 = (A y).inverse (K y)\n have heq : A y (e.continuousLinearMapAt ℝ y (s y)) = K y := by\n ext v\n change inner ℝ (e.symmL ℝ y (e.continuousLinearMapAt ℝ y (s y)))\n (e.symmL ℝ y v) = inner ℝ (s y) (e.symmL ℝ y v)\n rw [e.symmL_continuousLinearMapAt hy]\n rw [← heq, (hAi y hy).inverse_apply_self]\n exact (congrFun (e.coe_linearMapAt_of_mem (R := ℝ) hy) (s y)).symm)\ntheorem contMDiffAt_mvfderiv_apply : open Bundle in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] {I : ModelWithCorners ℝ E H}\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M]\n [IsManifold I (↑(⊤ : ℕ∞) : WithTop ℕ∞) M]\n {f : M → ℝ} {X : (x : M) → TangentSpace I x} {p : M},\n ContMDiffAt I (modelWithCornersSelf ℝ ℝ) 2 f p →\n ContMDiffAt I I.tangent 1 (fun x => TotalSpace.mk' E x (X x)) p →\n ContMDiffAt I (modelWithCornersSelf ℝ ℝ) 1\n (fun x => mvfderiv I f x (X x)) p := by\n intros E _ _ H _ I M _ _ _ f X p hf hX\n set_option backward.isDefEq.respectTransparency false in\n exact (open Bundle in by\n have hD := hf.mfderiv_const (m := 1) (by norm_num)\n have hT := hD.clm_apply_of_inCoordinates hX (hf.of_le (m := 1) (by norm_num))\n have h := (contMDiffAt_totalSpace.mp hT).2\n change ContMDiffAt I (modelWithCornersSelf ℝ ℝ) 1\n (fun x => mfderiv I (modelWithCornersSelf ℝ ℝ) f x (X x)) p\n simp only [trivializationAt_model_space_apply] at h\n convert! h using 1)\ntheorem leviCivita_apply_contMDiffAt_one : open Bundle in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] {I : ModelWithCorners ℝ E H}\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M]\n [IsManifold I (↑(⊤ : ℕ∞) : WithTop ℕ∞) M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I (↑(⊤ : ℕ∞) : WithTop ℕ∞) E\n (fun x : M => TangentSpace I x)]\n {X Y : (x : M) → TangentSpace I x} {p : M},\n ContMDiffAt I I.tangent 2 (fun x => TotalSpace.mk' E x (X x)) p →\n ContMDiffAt I I.tangent 2 (fun x => TotalSpace.mk' E x (Y x)) p →\n ContMDiffAt I I.tangent 1\n (fun x => TotalSpace.mk' E x (CovariantDerivative.leviCivitaConnection I M Y x (X x))) p := by\n intros E _ _ _ H _ I M _ _ _ _ _ X Y p hX hY\n exact (open Bundle in by\n letI : (y : M) → NormedAddCommGroup (TangentSpace I y) := fun y =>\n Bundle.instNormedAddCommGroupOfRiemannianBundleOfIsTopologicalAddGroupOfContinuousConstSMulReal\n (E := fun x : M => TangentSpace I x) y\n letI : (y : M) → InnerProductSpace ℝ (TangentSpace I y) := fun y =>\n Bundle.instInnerProductSpaceReal (E := fun x : M => TangentSpace I x) y\n letI : IsManifold I (minSmoothness ℝ 2) M :=\n IsManifold.of_le (n := (↑(⊤ : ℕ∞) : WithTop ℕ∞)) (by simp [minSmoothness])\n letI : IsManifold I ((2 : ℕ∞) + 1) M :=\n IsManifold.of_le (n := (↑(⊤ : ℕ∞) : WithTop ℕ∞)) (by simp)\n apply contMDiffAt_tangent_of_inner\n intro Z hZ\n have hX1 := hX.of_le (m := 1) (by norm_num)\n have hY1 := hY.of_le (m := 1) (by norm_num)\n have hZ1 := hZ.of_le (m := 1) (by norm_num)\n have hYZ := ContMDiffAt.inner_bundle (F := E) (E := fun x : M => TangentSpace I x) hY hZ\n have hZX := ContMDiffAt.inner_bundle (F := E) (E := fun x : M => TangentSpace I x) hZ hX\n have hXY := ContMDiffAt.inner_bundle (F := E) (E := fun x : M => TangentSpace I x) hX hY\n have hd1 := contMDiffAt_mvfderiv_apply hYZ hX1\n have hd2 := contMDiffAt_mvfderiv_apply hZX hY1\n have hd3 := contMDiffAt_mvfderiv_apply hXY hZ1\n have hb1 := hX.mlieBracket_vectorField hZ (m := 1) (by norm_num [minSmoothness])\n have hb2 := hY.mlieBracket_vectorField hX (m := 1) (by norm_num [minSmoothness])\n have hb3 := hZ.mlieBracket_vectorField hY (m := 1) (by norm_num [minSmoothness])\n have hi1 := ContMDiffAt.inner_bundle (F := E) (E := fun x : M => TangentSpace I x) hY1 hb1\n have hi2 := ContMDiffAt.inner_bundle (F := E) (E := fun x : M => TangentSpace I x) hZ1 hb2\n have hi3 := ContMDiffAt.inner_bundle (F := E) (E := fun x : M => TangentSpace I x) hX1 hb3\n have hsum := ((((hd1.add hd2).sub hd3).sub hi1).sub hi2).add hi3\n apply ((contDiff_id.div_const (2 : ℝ)).contDiffAt.comp_contMDiffAt hsum)\n |>.congr_of_eventuallyEq\n filter_upwards [(contMDiffAt_iff_contMDiffAt_nhds (by norm_num)).mp hX,\n (contMDiffAt_iff_contMDiffAt_nhds (by norm_num)).mp hY,\n (contMDiffAt_iff_contMDiffAt_nhds (by norm_num)).mp hZ] with x hx hy hz\n exact CovariantDerivative.leviCivitaConnection_apply_inner I\n (hx.mdifferentiableAt (by norm_num)) (hy.mdifferentiableAt (by norm_num))\n (hz.mdifferentiableAt (by norm_num)))\ntheorem leviCivita_contMDiff_one : open Bundle in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n (M : Type*) [EMetricSpace M] [ChartedSpace H M]\n [IsManifold I (↑(⊤ : ℕ∞) : WithTop ℕ∞) M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I (↑(⊤ : ℕ∞) : WithTop ℕ∞) E\n (fun x : M => TangentSpace I x)]\n [IsContinuousRiemannianBundle E (fun x : M => TangentSpace I x)]\n [IsRiemannianManifold I M] [LocallyCompactSpace M] [ConnectedSpace M],\n CovariantDerivative.ContMDiffCovariantDerivative\n (CovariantDerivative.leviCivitaConnection I M) 1 := by\n intros E _ _ _ H _ I _ M _ _ _ _ _ _ _ _ _\n exact (open Bundle ContinuousLinearMap in by\n constructor\n constructor\n intro Y hY\n rw [contMDiffOn_univ] at hY ⊢\n intro p\n apply (contMDiffAt_hom_bundle _).mpr\n refine ⟨contMDiffAt_id, ?_⟩\n apply contMDiffAt_clm_of_apply\n intro v\n let e := trivializationAt E (TangentSpace I : M → Type _) p\n have hp : p ∈ e.baseSet := mem_baseSet_trivializationAt E (TangentSpace I) p\n let X (y : M) : TangentSpace I y := e.symmL ℝ y v\n have hX : ContMDiffAt I I.tangent 2 (fun y => TotalSpace.mk' E y (X y)) p :=\n (e.contMDiffAt_symmL (n := 2) hp).clm_bundle_apply\n (contMDiffAt_totalSpace.mpr ⟨contMDiffAt_id, contMDiffAt_const⟩)\n have hV := leviCivita_apply_contMDiffAt_one hX (hY p)\n apply ((contMDiffAt_section p).mp hV).congr_of_eventuallyEq\n filter_upwards [e.open_baseSet.mem_nhds hp] with y hy\n change inCoordinates E (TangentSpace I) E (TangentSpace I) p y p y\n (CovariantDerivative.leviCivitaConnection I M Y y) v =\n (e ⟨y, CovariantDerivative.leviCivitaConnection I M Y y (X y)⟩).2\n simp only [inCoordinates, ContinuousLinearMap.comp_apply]\n exact congrFun (e.coe_linearMapAt_of_mem (R := ℝ) hy)\n (CovariantDerivative.leviCivitaConnection I M Y y (X y)))\ntheorem positive_metric_duality_isInvertible\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n [FiniteDimensional ℝ E] (g : E →L[ℝ] E →L[ℝ] ℝ)\n (hpos : ∀ v : E, v ≠ 0 → 0 < g v v) : g.IsInvertible := by\n classical\n have hinj : Function.Injective g := by\n intro v w hvw\n by_contra hne\n have hz : g (v - w) = 0 := by rw [map_sub, hvw, sub_self]\n have hp := hpos (v - w) (sub_ne_zero.mpr hne)\n simp [hz] at hp\n have hdim : Module.finrank ℝ E = Module.finrank ℝ (E →L[ℝ] ℝ) := by\n rw [← (LinearMap.toContinuousLinearMap :\n Module.Dual ℝ E ≃ₗ[ℝ] (E →L[ℝ] ℝ)).finrank_eq, Subspace.dual_finrank_eq]\n let e := (LinearEquiv.ofBijective g.toLinearMap\n ⟨hinj, (LinearMap.injective_iff_surjective_of_finrank_eq_finrank hdim).mp hinj⟩\n ).toContinuousLinearEquiv\n exact ⟨e, rfl⟩\ntheorem contDiffOn_inverse_positive_metric\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n [FiniteDimensional ℝ E] {U : Set E} {n : WithTop ℕ∞}\n (g : E → E →L[ℝ] E →L[ℝ] ℝ) (hg : ContDiffOn ℝ n g U)\n (hpos : ∀ x ∈ U, ∀ v : E, v ≠ 0 → 0 < g x v v) :\n ContDiffOn ℝ n (fun x => ContinuousLinearMap.inverse (g x)) U := by\n intro x hx\n exact (positive_metric_duality_isInvertible (g x) (hpos x hx)\n ).contDiffAt_map_inverse.comp_contDiffWithinAt x (hg x hx)\nnoncomputable def coordinateKoszulForm\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (D : E →L[ℝ] E →L[ℝ] E →L[ℝ] ℝ) : E →L[ℝ] E →L[ℝ] E →L[ℝ] ℝ :=\n by\n letI : NormedAddCommGroup (E →L[ℝ] E →L[ℝ] E →L[ℝ] ℝ) :=\n ContinuousLinearMap.toNormedAddCommGroup (𝕜 := ℝ) (𝕜₂ := ℝ)\n (E := E) (F := E →L[ℝ] E →L[ℝ] ℝ) (σ₁₂ := RingHom.id ℝ)\n exact D + D.flip -\n (ContinuousLinearMap.flipₗᵢ ℝ E E ℝ).toContinuousLinearEquiv.toContinuousLinearMap.comp\n D.flip\ntheorem coordinateKoszulForm_apply\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (D : E →L[ℝ] E →L[ℝ] E →L[ℝ] ℝ) (v w z : E) :\n coordinateKoszulForm D v w z = D v w z + D w v z - D z v w := rfl\ntheorem exists_smooth_coordinate_koszul\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n [FiniteDimensional ℝ E] (U : Set E) (hU : IsOpen U)\n (g : E → E →L[ℝ] E →L[ℝ] ℝ)\n (hg : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) g U)\n (_hsym : ∀ x ∈ U, ∀ v w : E, g x v w = g x w v)\n (hpos : ∀ x ∈ U, ∀ v : E, v ≠ 0 → 0 < g x v v) :\n ∃ Γ : E → E →L[ℝ] E →L[ℝ] E,\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Γ U ∧\n ∀ x ∈ U, ∀ v w z : E,\n 2 * g x (Γ x v w) z =\n (fderiv ℝ g x v) w z + (fderiv ℝ g x w) v z - (fderiv ℝ g x z) v w := by\n letI : NormedAddCommGroup (E →L[ℝ] E →L[ℝ] E →L[ℝ] ℝ) :=\n ContinuousLinearMap.toNormedAddCommGroup (𝕜 := ℝ) (𝕜₂ := ℝ)\n (E := E) (F := E →L[ℝ] E →L[ℝ] ℝ) (σ₁₂ := RingHom.id ℝ)\n letI : NormedSpace ℝ (E →L[ℝ] E →L[ℝ] E →L[ℝ] ℝ) :=\n ContinuousLinearMap.toNormedSpace (𝕜 := ℝ) (𝕜₂ := ℝ) (𝕜' := ℝ)\n (E := E) (F := E →L[ℝ] E →L[ℝ] ℝ) (σ₁₂ := RingHom.id ℝ)\n have hD : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) (fderiv ℝ g) U :=\n hg.fderiv_of_isOpen hU (by simp)\n have hK : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞)\n (fun x => coordinateKoszulForm (fderiv ℝ g x)) U := by\n apply (contDiffOn_clm_apply (𝕜 := ℝ) (D := E) (E := E)\n (F := E →L[ℝ] E →L[ℝ] ℝ)).mpr\n intro v\n apply contDiffOn_clm_apply.mpr\n intro w\n apply contDiffOn_clm_apply.mpr\n intro z\n change ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞)\n (fun x => (fderiv ℝ g x) v w z + (fderiv ℝ g x) w v z -\n (fderiv ℝ g x) z v w) U\n exact (((hD.clm_apply contDiffOn_const).clm_apply contDiffOn_const\n ).clm_apply contDiffOn_const).add\n (((hD.clm_apply contDiffOn_const).clm_apply contDiffOn_const).clm_apply\n contDiffOn_const) |>.sub\n (((hD.clm_apply contDiffOn_const).clm_apply contDiffOn_const).clm_apply\n contDiffOn_const)\n have hinv := contDiffOn_inverse_positive_metric g hg hpos\n let Γ : E → E →L[ℝ] E →L[ℝ] E := fun x =>\n (ContinuousLinearMap.compL ℝ E (E →L[ℝ] ℝ) E\n (ContinuousLinearMap.inverse (g x))).comp\n ((2 : ℝ)⁻¹ • coordinateKoszulForm (fderiv ℝ g x))\n refine ⟨Γ, ?_, ?_⟩\n · apply contDiffOn_clm_apply.mpr\n intro v\n apply contDiffOn_clm_apply.mpr\n intro w\n change ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞)\n (fun x => ContinuousLinearMap.inverse (g x)\n ((2 : ℝ)⁻¹ • coordinateKoszulForm (fderiv ℝ g x) v w)) U\n exact hinv.clm_apply ((contDiffOn_const (c := (2 : ℝ)⁻¹)).smul\n ((hK.clm_apply (g := fun _ : E => v) contDiffOn_const).clm_apply\n (g := fun _ : E => w) contDiffOn_const))\n · intro x hx v w z\n change 2 * (g x (ContinuousLinearMap.inverse (g x)\n ((2 : ℝ)⁻¹ • coordinateKoszulForm (fderiv ℝ g x) v w))) z = _\n rw [(positive_metric_duality_isInvertible (g x) (hpos x hx)).self_apply_inverse]\n change 2 * ((2 : ℝ)⁻¹ *\n ((fderiv ℝ g x v) w z + (fderiv ℝ g x w) v z - (fderiv ℝ g x z) v w)) = _\n ring\ntheorem exists_smooth_coordinate_metric_and_koszul : open scoped Bundle in open Bundle in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H) [I.Boundaryless]\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M]\n [IsManifold I (↑(⊤ : ℕ∞) : WithTop ℕ∞) M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n [IsContMDiffRiemannianBundle I (↑(⊤ : ℕ∞) : WithTop ℕ∞) E\n (fun x : M => TangentSpace I x)] (p : M),\n ∃ g : E → E →L[ℝ] E →L[ℝ] ℝ, ∃ Γ : E → E →L[ℝ] E →L[ℝ] E,\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) g (extChartAt I p).target ∧\n (∀ z u v, g z u v = g z v u) ∧\n (∀ z ∈ (extChartAt I p).target, ∀ v : E, v ≠ 0 → 0 < g z v v) ∧\n (∀ z ∈ (extChartAt I p).target, ∀ v : E,\n g z v v = ‖(mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z) v‖ ^ 2) ∧\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Γ (extChartAt I p).target ∧\n (∀ z ∈ (extChartAt I p).target, ∀ u v w : E,\n 2 * g z (Γ z u v) w =\n (fderiv ℝ g z u) v w + (fderiv ℝ g z v) u w - (fderiv ℝ g z w) u v) := by\n intro E _ _ _ H _ I _ M _ _ _ _ _ p\n obtain ⟨g, hg, hsym, hpos, hnorm⟩ := exists_smooth_coordinate_metric I p\n have hU : IsOpen (extChartAt I p).target := isOpen_extChartAt_target p\n obtain ⟨Γ, hΓ, hkoszul⟩ := exists_smooth_coordinate_koszul\n (extChartAt I p).target hU g hg (fun z _ u v => hsym z u v) hpos\n exact ⟨g, Γ, hg, hsym, hpos, hnorm, hΓ, hkoszul⟩\ndef MetricLocallyLinear {M : Type*} [EMetricSpace M]\n (γ : ℝ → M) (c : NNReal) (S : Set ℝ) : Prop :=\n ∀ t₀ ∈ S, ∃ δ > (0 : ℝ), ∀ s t : ℝ,\n s ∈ S ∩ Set.Ioo (t₀ - δ) (t₀ + δ) →\n t ∈ S ∩ Set.Ioo (t₀ - δ) (t₀ + δ) →\n edist (γ s) (γ t) = (c : ENNReal) * ENNReal.ofReal |t - s|\ntheorem MetricLocallyLinear.mono {M : Type*} [EMetricSpace M]\n {γ : ℝ → M} {c : NNReal} {S T : Set ℝ}\n (h : MetricLocallyLinear γ c S) (hTS : T ⊆ S) : MetricLocallyLinear γ c T := by\n intro x hx\n obtain ⟨δ, hδ, H⟩ := h x (hTS hx)\n exact ⟨δ, hδ, fun s t hs ht => H s t ⟨hTS hs.1, hs.2⟩ ⟨hTS ht.1, ht.2⟩⟩\ntheorem MetricLocallyLinear.congr {M : Type*} [EMetricSpace M]\n {γ η : ℝ → M} {c : NNReal} {S : Set ℝ}\n (h : MetricLocallyLinear γ c S) (heq : Set.EqOn η γ S) :\n MetricLocallyLinear η c S := by\n intro x hx\n obtain ⟨δ, hδ, H⟩ := h x hx\n refine ⟨δ, hδ, fun s t hs ht => ?_⟩\n rw [heq hs.1, heq ht.1]\n exact H s t hs ht\ntheorem MetricLocallyLinear.continuousOn {M : Type*} [EMetricSpace M]\n {γ : ℝ → M} {c : NNReal} {S : Set ℝ}\n (h : MetricLocallyLinear γ c S) : ContinuousOn γ S := by\n apply LocallyLipschitzOn.continuousOn\n intro x hx\n obtain ⟨δ, hδ, H⟩ := h x hx\n refine ⟨c, S ∩ Set.Ioo (x - δ) (x + δ),\n Filter.inter_mem self_mem_nhdsWithin\n (nhdsWithin_le_nhds (Ioo_mem_nhds (by linarith) (by linarith))), ?_⟩\n intro s hs t ht\n rw [H s t hs ht, edist_dist s t, Real.dist_eq, abs_sub_comm]\ntheorem MetricLocallyLinear.lipschitzOn {M : Type*} [EMetricSpace M]\n {γ : ℝ → M} {c : NNReal} {S : Set ℝ}\n (h : MetricLocallyLinear γ c S) (hS : S.OrdConnected) :\n LipschitzOnWith c γ S := by\n have hbound : ∀ x ∈ S, ∀ y ∈ S, x ≤ y →\n edist (γ x) (γ y) ≤ (c : ENNReal) * ENNReal.ofReal (y - x) := by\n intro x hx y hy hxy\n let A := {t : ℝ | edist (γ x) (γ t) ≤\n (c : ENNReal) * ENNReal.ofReal (t - x)}\n have hsub : Set.Icc x y ⊆ S := hS.out hx hy\n have hclosed : IsClosed (A ∩ Set.Icc x y) := by\n rw [Set.inter_comm]\n exact isClosed_Icc.isClosed_le\n (continuous_edist.comp_continuousOn\n (continuousOn_const.prodMk (h.continuousOn.mono hsub)))\n ((ENNReal.continuous_const_mul ENNReal.coe_ne_top).comp\n (ENNReal.continuous_ofReal.comp (continuous_id.sub continuous_const))).continuousOn\n apply hclosed.mem_of_ge_of_forall_exists_gt (by simp [A]) hxy\n intro t ht\n obtain ⟨δ, hδ, H⟩ := h t (hsub ⟨ht.2.1, ht.2.2.le⟩)\n obtain ⟨u, htu, hu⟩ := exists_between (lt_min ht.2.2 (by linarith : t < t + δ))\n have hut : u ∈ Set.Icc x y := ⟨ht.2.1.trans htu.le, (hu.trans_le (min_le_left _ _)).le⟩\n refine ⟨u, ?_, htu, hut.2⟩\n change edist (γ x) (γ u) ≤ _\n calc\n _ ≤ edist (γ x) (γ t) + edist (γ t) (γ u) := edist_triangle _ _ _\n _ ≤ (c : ENNReal) * ENNReal.ofReal (t - x) +\n (c : ENNReal) * ENNReal.ofReal (u - t) := by\n apply add_le_add ht.1\n rw [H t u ⟨hsub ⟨ht.2.1, ht.2.2.le⟩, by constructor <;> linarith⟩\n ⟨hsub hut, by constructor <;> linarith [min_le_right y (t + δ)]⟩,\n abs_of_pos (sub_pos.mpr htu)]\n _ = _ := by\n rw [← mul_add, ← ENNReal.ofReal_add (sub_nonneg.mpr ht.2.1)\n (sub_nonneg.mpr htu.le)]\n congr 2\n ring\n intro x hx y hy\n rw [edist_dist x y, Real.dist_eq, abs_sub_comm]\n rcases le_total x y with hxy | hyx\n · simpa only [abs_of_nonneg (sub_nonneg.mpr hxy)] using hbound x hx y hy hxy\n · rw [edist_comm, abs_sub_comm, abs_of_nonneg (sub_nonneg.mpr hyx)]\n exact hbound y hy x hx hyx\ntheorem MetricLocallyLinear.eqOn_const_of_zero\n {M : Type*} [EMetricSpace M] {γ : ℝ → M} {S : Set ℝ} {t₀ : ℝ}\n (h : MetricLocallyLinear γ 0 S) (hS : S.OrdConnected) (ht₀ : t₀ ∈ S) :\n Set.EqOn γ (fun _ => γ t₀) S := by\n intro t ht\n apply edist_eq_zero.mp\n have hh := h.lipschitzOn hS ht ht₀\n simpa using hh\ntheorem metricEndpointGerm_of_zero_speed\n {M : Type*} [EMetricSpace M] {γ : ℝ → M} {a b : ℝ}\n (hab : a < b) (h : MetricLocallyLinear γ 0 (Set.Ioo a b)) :\n ∃ ε > (0 : ℝ), ∃ η : ℝ → M,\n MetricLocallyLinear η 0 (Set.Ioo (b - ε) (b + ε)) ∧\n ∀ t ∈ Set.Ioo (max a (b - ε)) b, η t = γ t := by\n let t₀ := (a + b) / 2\n have ht₀ : t₀ ∈ Set.Ioo a b := by dsimp [t₀]; constructor <;> linarith\n have hconst := h.eqOn_const_of_zero Set.ordConnected_Ioo ht₀\n refine ⟨1, zero_lt_one, fun _ => γ t₀, ?_, ?_⟩\n · intro t ht\n exact ⟨1, zero_lt_one, fun s u hs hu => by simp⟩\n · intro t ht\n exact (hconst ⟨lt_of_le_of_lt (le_max_left _ _) ht.1, ht.2⟩).symm\ntheorem MetricLocallyLinear.endpoint_limit {M : Type*} [EMetricSpace M] [CompleteSpace M]\n {γ : ℝ → M} {c : NNReal} {a b : ℝ} (hab : a < b)\n (h : MetricLocallyLinear γ c (Set.Ioo a b)) :\n ∃ p : M, Filter.Tendsto γ (nhdsWithin b (Set.Ioo a b)) (nhds p) := by\n letI := right_nhdsWithin_Ioo_neBot hab\n apply cauchy_map_iff_exists_tendsto.mp\n exact (cauchy_nhds.mono nhdsWithin_le_nhds).map_of_le\n (h.lipschitzOn Set.ordConnected_Ioo).uniformContinuousOn inf_le_right\ntheorem MetricLocallyLinear.reflect {M : Type*} [EMetricSpace M]\n {γ : ℝ → M} {c : NNReal} {S : Set ℝ}\n (h : MetricLocallyLinear γ c S) :\n MetricLocallyLinear (fun t => γ (-t)) c ((fun t : ℝ => -t) ⁻¹' S) := by\n intro x hx\n obtain ⟨δ, hδ, H⟩ := h (-x) hx\n refine ⟨δ, hδ, fun s t hs ht => ?_⟩\n have heq := H (-s) (-t) ⟨hs.1, by constructor <;> linarith [hs.2.1, hs.2.2]⟩\n ⟨ht.1, by constructor <;> linarith [ht.2.1, ht.2.2]⟩\n simpa only [neg_sub_neg, abs_sub_comm] using heq\ntheorem MetricLocallyLinear.glue {M : Type*} [EMetricSpace M]\n {γ η : ℝ → M} {c : NNReal} {S T : Set ℝ}\n (hS : IsOpen S) (hT : IsOpen T)\n (hγ : MetricLocallyLinear γ c S) (hη : MetricLocallyLinear η c T)\n (heq : Set.EqOn η γ (S ∩ T)) :\n ∃ ζ : ℝ → M, MetricLocallyLinear ζ c (S ∪ T) ∧\n Set.EqOn ζ γ S ∧ Set.EqOn ζ η T := by\n classical\n let ζ : ℝ → M := fun t => if t ∈ S then γ t else η t\n have heqS : Set.EqOn ζ γ S := fun t ht => if_pos ht\n have heqT : Set.EqOn ζ η T := by\n intro t ht\n dsimp [ζ]\n split_ifs with hs\n · exact (heq ⟨hs, ht⟩).symm\n · rfl\n refine ⟨ζ, ?_, heqS, heqT⟩\n have hlocal : ∀ (U : Set ℝ) (f : ℝ → M), IsOpen U →\n MetricLocallyLinear f c U → Set.EqOn ζ f U →\n ∀ x ∈ U, ∃ δ > (0 : ℝ), ∀ s t : ℝ,\n s ∈ (S ∪ T) ∩ Set.Ioo (x - δ) (x + δ) →\n t ∈ (S ∪ T) ∩ Set.Ioo (x - δ) (x + δ) →\n edist (ζ s) (ζ t) = (c : ENNReal) * ENNReal.ofReal |t - s| := by\n intro U f hU hf hζ x hx\n obtain ⟨δ, hδ, H⟩ := hf x hx\n obtain ⟨ε, hε, hεU⟩ := Metric.mem_nhds_iff.mp (hU.mem_nhds hx)\n refine ⟨min δ ε, lt_min hδ hε, fun s t hs ht => ?_⟩\n have hmem : ∀ u ∈ Set.Ioo (x - min δ ε) (x + min δ ε),\n u ∈ U ∩ Set.Ioo (x - δ) (x + δ) := by\n intro u hu\n have huε : u ∈ Metric.ball x ε := by\n rw [Metric.mem_ball, Real.dist_eq, abs_lt]\n constructor <;> linarith [hu.1, hu.2, min_le_right δ ε]\n exact ⟨hεU huε, by constructor <;> linarith [hu.1, hu.2, min_le_left δ ε]⟩\n rw [hζ (hmem s hs.2).1, hζ (hmem t ht.2).1]\n exact H s t (hmem s hs.2) (hmem t ht.2)\n intro x hx\n rcases hx with hx | hx\n · exact hlocal S γ hS hγ heqS x hx\n · exact hlocal T η hT hη heqT x hx\ndef HasMetricEndpointGerms (M : Type*) [EMetricSpace M] : Prop :=\n ∀ (a b : ℝ) (γ : ℝ → M) (c : NNReal) (p : M), a < b →\n MetricLocallyLinear γ c (Set.Ioo a b) →\n Filter.Tendsto γ (nhdsWithin b (Set.Ioo a b)) (nhds p) →\n ∃ ε > (0 : ℝ), ∃ η : ℝ → M,\n MetricLocallyLinear η c (Set.Ioo (b - ε) (b + ε)) ∧\n ∀ t ∈ Set.Ioo (max a (b - ε)) b, η t = γ t\ntheorem metricLocallyLinear_extend_bddAbove {M : Type*}\n [EMetricSpace M] [CompleteSpace M] (hG : HasMetricEndpointGerms M)\n {γ : ℝ → M} {c : NNReal} {S : Set ℝ}\n (hS : IsOpen S) (hconn : S.OrdConnected) (hne : S.Nonempty)\n (hbdd : BddAbove S) (hγ : MetricLocallyLinear γ c S) :\n ∃ T : Set ℝ, ∃ η : ℝ → M, IsOpen T ∧ T.OrdConnected ∧\n S ⊆ T ∧ MetricLocallyLinear η c T ∧ Set.EqOn η γ S ∧\n ∃ t ∈ T, t ∉ S := by\n let b := sSup S\n have hlt : ∀ x ∈ S, x < b := by\n intro x hx\n obtain ⟨δ, hδ, hδS⟩ := Metric.mem_nhds_iff.mp (hS.mem_nhds hx)\n have hxδ : x + δ / 2 ∈ S := hδS (by\n rw [Metric.mem_ball, Real.dist_eq, abs_of_pos (by linarith : 0 < x + δ / 2 - x)]\n linarith)\n have := le_csSup hbdd hxδ\n dsimp [b]\n linarith\n obtain ⟨a, ha⟩ := hne\n have hab : a < b := hlt a ha\n have hi : Set.Ioo a b ⊆ S := by\n intro t ht\n obtain ⟨u, hu, htu⟩ := exists_lt_of_lt_csSup ⟨a, ha⟩ ht.2\n exact hconn.out ha hu ⟨ht.1.le, htu.le⟩\n obtain ⟨p, hp⟩ := (hγ.mono hi).endpoint_limit hab\n obtain ⟨ε, hε, η, hη, heq⟩ := hG a b γ c p hab (hγ.mono hi) hp\n let δ := min ε ((b - a) / 2)\n have hδ : 0 < δ := lt_min hε (by linarith)\n have hδε : δ ≤ ε := min_le_left _ _\n have hδa : a < b - δ := by\n have := min_le_right ε ((b - a) / 2)\n dsimp [δ]\n linarith\n let U := Set.Ioo (b - δ) (b + δ)\n have hUsub : U ⊆ Set.Ioo (b - ε) (b + ε) := by\n intro t ht\n exact ⟨by linarith [ht.1], by linarith [ht.2]⟩\n have heqU : Set.EqOn η γ (S ∩ U) := by\n intro t ht\n exact heq t ⟨max_lt (hδa.trans ht.2.1) (by linarith [ht.2.1]), hlt t ht.1⟩\n obtain ⟨ζ, hζ, hζγ, _⟩ := hγ.glue hS isOpen_Ioo (hη.mono hUsub) heqU\n have hinter : (S ∩ U).Nonempty := by\n obtain ⟨t, ht, htb⟩ := exists_between (by linarith : b - δ < b)\n exact ⟨t, hi ⟨hδa.trans ht, htb⟩, ht, by linarith⟩\n refine ⟨S ∪ U, ζ, hS.union isOpen_Ioo,\n (hconn.isPreconnected.union' hinter Set.ordConnected_Ioo.isPreconnected).ordConnected,\n Set.subset_union_left, hζ, hζγ, b, Or.inr ?_, ?_⟩\n · exact ⟨by linarith, by linarith⟩\n · exact fun hb => (hlt b hb).false\ntheorem metricLocallyLinear_extend_bddBelow {M : Type*}\n [EMetricSpace M] [CompleteSpace M] (hG : HasMetricEndpointGerms M)\n {γ : ℝ → M} {c : NNReal} {S : Set ℝ}\n (hS : IsOpen S) (hconn : S.OrdConnected) (hne : S.Nonempty)\n (hbdd : BddBelow S) (hγ : MetricLocallyLinear γ c S) :\n ∃ T : Set ℝ, ∃ η : ℝ → M, IsOpen T ∧ T.OrdConnected ∧\n S ⊆ T ∧ MetricLocallyLinear η c T ∧ Set.EqOn η γ S ∧\n ∃ t ∈ T, t ∉ S := by\n let R := (fun t : ℝ => -t) ⁻¹' S\n have hR : R.Nonempty := by\n obtain ⟨t, ht⟩ := hne\n exact ⟨-t, by simpa [R] using ht⟩\n have hbR : BddAbove R := by\n obtain ⟨l, hl⟩ := hbdd\n exact ⟨-l, fun t ht => by have := hl ht; dsimp [R] at ht; linarith⟩\n obtain ⟨T, η, hT, hTc, hRT, hη, heq, t, htT, htR⟩ :=\n metricLocallyLinear_extend_bddAbove hG (hS.preimage continuous_neg)\n (hconn.preimage_anti (fun _ _ h => neg_le_neg h)) hR hbR hγ.reflect\n refine ⟨(fun t : ℝ => -t) ⁻¹' T, fun t => η (-t),\n hT.preimage continuous_neg, hTc.preimage_anti (fun _ _ h => neg_le_neg h), ?_, hη.reflect, ?_,\n -t, by simpa using htT, ?_⟩\n · intro t ht\n exact hRT (by simpa [R] using ht)\n · intro t ht\n have hh := heq (show -t ∈ R by simpa [R] using ht)\n simpa only [neg_neg] using hh\n · exact htR\ntheorem MetricLocallyLinear.on_open {M : Type*} [EMetricSpace M]\n {γ : ℝ → M} {c : NNReal} {S : Set ℝ}\n (h : MetricLocallyLinear γ c S) (ho : IsOpen S) {x : ℝ} (hx : x ∈ S) :\n ∃ δ > (0 : ℝ), ∀ s t : ℝ,\n s ∈ Set.Ioo (x - δ) (x + δ) → t ∈ Set.Ioo (x - δ) (x + δ) →\n edist (γ s) (γ t) = (c : ENNReal) * ENNReal.ofReal |t - s| := by\n obtain ⟨δ, hδ, H⟩ := h x hx\n obtain ⟨ε, hε, hεS⟩ := Metric.mem_nhds_iff.mp (ho.mem_nhds hx)\n have hmem : ∀ u ∈ Set.Ioo (x - min δ ε) (x + min δ ε),\n u ∈ S ∩ Set.Ioo (x - δ) (x + δ) := by\n intro u hu\n have huε : u ∈ Metric.ball x ε := by\n rw [Metric.mem_ball, Real.dist_eq, abs_lt]\n constructor <;> linarith [hu.1, hu.2, min_le_right δ ε]\n exact ⟨hεS huε, by constructor <;> linarith [hu.1, hu.2, min_le_left δ ε]⟩\n exact ⟨min δ ε, lt_min hδ hε, fun s t hs ht => H s t (hmem s hs) (hmem t ht)⟩\ndef MetricLinearExtension {M : Type*} [EMetricSpace M]\n (γ₀ : ℝ → M) (c : NNReal) (S₀ : Set ℝ) :=\n {v : Set ℝ × (ℝ → M) // IsOpen v.1 ∧ v.1.OrdConnected ∧ S₀ ⊆ v.1 ∧\n MetricLocallyLinear v.2 c v.1 ∧ Set.EqOn v.2 γ₀ S₀}\ndef MetricLinearExtension.domain {M : Type*} [EMetricSpace M]\n {γ₀ : ℝ → M} {c : NNReal} {S₀ : Set ℝ}\n (u : MetricLinearExtension γ₀ c S₀) : Set ℝ := u.val.1\ndef MetricLinearExtension.curve {M : Type*} [EMetricSpace M]\n {γ₀ : ℝ → M} {c : NNReal} {S₀ : Set ℝ}\n (u : MetricLinearExtension γ₀ c S₀) : ℝ → M := u.val.2\ntheorem MetricLinearExtension.isOpen {M : Type*} [EMetricSpace M]\n {γ₀ : ℝ → M} {c : NNReal} {S₀ : Set ℝ}\n (u : MetricLinearExtension γ₀ c S₀) : IsOpen u.domain := u.property.1\ntheorem MetricLinearExtension.ordConnected {M : Type*} [EMetricSpace M]\n {γ₀ : ℝ → M} {c : NNReal} {S₀ : Set ℝ}\n (u : MetricLinearExtension γ₀ c S₀) : u.domain.OrdConnected := u.property.2.1\ntheorem MetricLinearExtension.contains {M : Type*} [EMetricSpace M]\n {γ₀ : ℝ → M} {c : NNReal} {S₀ : Set ℝ}\n (u : MetricLinearExtension γ₀ c S₀) : S₀ ⊆ u.domain := u.property.2.2.1\ntheorem MetricLinearExtension.linear {M : Type*} [EMetricSpace M]\n {γ₀ : ℝ → M} {c : NNReal} {S₀ : Set ℝ}\n (u : MetricLinearExtension γ₀ c S₀) : MetricLocallyLinear u.curve c u.domain :=\n u.property.2.2.2.1\ntheorem MetricLinearExtension.agrees {M : Type*} [EMetricSpace M]\n {γ₀ : ℝ → M} {c : NNReal} {S₀ : Set ℝ}\n (u : MetricLinearExtension γ₀ c S₀) : Set.EqOn u.curve γ₀ S₀ := u.property.2.2.2.2\ndef MetricLinearExtension.Extends {M : Type*} [EMetricSpace M]\n {γ₀ : ℝ → M} {c : NNReal} {S₀ : Set ℝ}\n (u v : MetricLinearExtension γ₀ c S₀) : Prop :=\n u.domain ⊆ v.domain ∧ Set.EqOn v.curve u.curve u.domain\ntheorem MetricLinearExtension.extends_trans {M : Type*} [EMetricSpace M]\n {γ₀ : ℝ → M} {c : NNReal} {S₀ : Set ℝ}\n {u v w : MetricLinearExtension γ₀ c S₀}\n (huv : u.Extends v) (hvw : v.Extends w) : u.Extends w := by\n refine ⟨huv.1.trans hvw.1, fun t ht => ?_⟩\n exact (hvw.2 (huv.1 ht)).trans (huv.2 ht)\ntheorem MetricLinearExtension.chain_bound {M : Type*} [EMetricSpace M]\n {γ₀ : ℝ → M} {c : NNReal} {S₀ : Set ℝ}\n (C : Set (MetricLinearExtension γ₀ c S₀))\n (hC : IsChain MetricLinearExtension.Extends C) (hne : C.Nonempty) :\n ∃ v : MetricLinearExtension γ₀ c S₀, ∀ u ∈ C, u.Extends v := by\n classical\n have htotal : ∀ u ∈ C, ∀ v ∈ C, u.Extends v ∨ v.Extends u := by\n intro u hu v hv\n by_cases heq : u = v\n · subst v\n exact Or.inl ⟨Set.Subset.rfl, fun _ _ => rfl⟩\n · exact hC hu hv heq\n let U := ⋃ u ∈ C, u.domain\n have hex : ∀ t ∈ U, ∃ u ∈ C, t ∈ u.domain := by\n simpa only [U, Set.mem_iUnion, exists_prop] using\n (show ∀ t ∈ U, t ∈ U from fun _ ht => ht)\n let η : ℝ → M := fun t => if ht : t ∈ U then\n (Classical.choose (hex t ht)).curve t else γ₀ t\n have hagree : ∀ u ∈ C, Set.EqOn η u.curve u.domain := by\n intro u hu t ht\n have htU : t ∈ U := Set.mem_iUnion.mpr ⟨u, Set.mem_iUnion.mpr ⟨hu, ht⟩⟩\n dsimp [η]\n rw [dif_pos htU]\n let v := Classical.choose (hex t htU)\n have hv : v ∈ C := (Classical.choose_spec (hex t htU)).1\n have htv : t ∈ v.domain := (Classical.choose_spec (hex t htU)).2\n rcases htotal u hu v hv with huv | hvu\n · exact huv.2 ht\n · exact (hvu.2 htv).symm\n have hUopen : IsOpen U := isOpen_iUnion fun u => isOpen_iUnion fun _ => u.isOpen\n have hUconn : U.OrdConnected := by\n constructor\n intro x hx y hy z hz\n obtain ⟨u, hu, hxu⟩ := hex x hx\n obtain ⟨v, hv, hyv⟩ := hex y hy\n rcases htotal u hu v hv with huv | hvu\n · exact Set.mem_iUnion.mpr ⟨v, Set.mem_iUnion.mpr ⟨hv,\n v.ordConnected.out (huv.1 hxu) hyv hz⟩⟩\n · exact Set.mem_iUnion.mpr ⟨u, Set.mem_iUnion.mpr ⟨hu,\n u.ordConnected.out hxu (hvu.1 hyv) hz⟩⟩\n obtain ⟨u₀, hu₀⟩ := hne\n have hcontains : S₀ ⊆ U := fun t ht =>\n Set.mem_iUnion.mpr ⟨u₀, Set.mem_iUnion.mpr ⟨hu₀, u₀.contains ht⟩⟩\n have hη : MetricLocallyLinear η c U := by\n intro x hx\n obtain ⟨u, hu, hxu⟩ := hex x hx\n obtain ⟨δ, hδ, H⟩ := (u.linear.congr (hagree u hu)).on_open u.isOpen hxu\n exact ⟨δ, hδ, fun s t hs ht => H s t hs.2 ht.2⟩\n refine ⟨⟨⟨U, η⟩, hUopen, hUconn, hcontains, hη, ?_⟩, ?_⟩\n · intro t ht\n exact (hagree u₀ hu₀ (u₀.contains ht)).trans (u₀.agrees ht)\n · intro u hu\n exact ⟨fun t ht => Set.mem_iUnion.mpr ⟨u, Set.mem_iUnion.mpr ⟨hu, ht⟩⟩,\n hagree u hu⟩\ntheorem exists_global_locallyLinear_extension_of_endpointGerm\n (M : Type*) [EMetricSpace M] [CompleteSpace M] :\n let L : (ℝ → M) → NNReal → Set ℝ → Prop := fun γ c S =>\n ∀ t₀ ∈ S, ∃ δ > (0 : ℝ), ∀ s t : ℝ,\n s ∈ S ∩ Set.Ioo (t₀ - δ) (t₀ + δ) →\n t ∈ S ∩ Set.Ioo (t₀ - δ) (t₀ + δ) →\n edist (γ s) (γ t) = (c : ENNReal) * ENNReal.ofReal |t - s|\n (∀ (a b : ℝ) (γ : ℝ → M) (c : NNReal) (p : M),\n a < b → L γ c (Set.Ioo a b) →\n Filter.Tendsto γ (nhdsWithin b (Set.Ioo a b)) (nhds p) →\n ∃ ε > (0 : ℝ), ∃ η : ℝ → M,\n L η c (Set.Ioo (b - ε) (b + ε)) ∧\n ∀ t ∈ Set.Ioo (max a (b - ε)) b, η t = γ t) →\n ∀ (a b : ℝ) (γ : ℝ → M) (c : NNReal), a < b → L γ c (Set.Ioo a b) →\n ∃ η : ℝ → M, L η c Set.univ ∧ ∀ t ∈ Set.Ioo a b, η t = γ t := by\n change HasMetricEndpointGerms M →\n ∀ (a b : ℝ) (γ : ℝ → M) (c : NNReal), a < b →\n MetricLocallyLinear γ c (Set.Ioo a b) →\n ∃ η : ℝ → M, MetricLocallyLinear η c Set.univ ∧ Set.EqOn η γ (Set.Ioo a b)\n intro hG a b γ c hab hγ\n let u₀ : MetricLinearExtension γ c (Set.Ioo a b) :=\n ⟨⟨Set.Ioo a b, γ⟩, isOpen_Ioo, Set.ordConnected_Ioo, Set.Subset.rfl,\n hγ, fun _ _ => rfl⟩\n letI : Nonempty (MetricLinearExtension γ c (Set.Ioo a b)) := ⟨u₀⟩\n have hex : ∃ u : MetricLinearExtension γ c (Set.Ioo a b),\n ∀ v, u.Extends v → v.Extends u := by\n apply exists_maximal_of_nonempty_chains_bounded\n · intro C hC hne\n exact MetricLinearExtension.chain_bound C hC hne\n · intro u v w huv hvw\n exact MetricLinearExtension.extends_trans huv hvw\n obtain ⟨u, hmax⟩ := hex\n have hne : u.domain.Nonempty :=\n ⟨(a + b) / 2, u.contains ⟨by linarith, by linarith⟩⟩\n have habove : ¬ BddAbove u.domain := by\n intro hbdd\n obtain ⟨T, η, hT, hTc, hST, hη, heq, t, htT, htS⟩ :=\n metricLocallyLinear_extend_bddAbove hG u.isOpen u.ordConnected hne hbdd u.linear\n let v : MetricLinearExtension γ c (Set.Ioo a b) :=\n ⟨⟨T, η⟩, hT, hTc, u.contains.trans hST, hη,\n fun s hs => (heq (u.contains hs)).trans (u.agrees hs)⟩\n have huv : u.Extends v := ⟨hST, heq⟩\n exact htS ((hmax v huv).1 htT)\n have hbelow : ¬ BddBelow u.domain := by\n intro hbdd\n obtain ⟨T, η, hT, hTc, hST, hη, heq, t, htT, htS⟩ :=\n metricLocallyLinear_extend_bddBelow hG u.isOpen u.ordConnected hne hbdd u.linear\n let v : MetricLinearExtension γ c (Set.Ioo a b) :=\n ⟨⟨T, η⟩, hT, hTc, u.contains.trans hST, hη,\n fun s hs => (heq (u.contains hs)).trans (u.agrees hs)⟩\n have huv : u.Extends v := ⟨hST, heq⟩\n exact htS ((hmax v huv).1 htT)\n have hfull : u.domain = Set.univ :=\n u.ordConnected.isPreconnected.eq_univ_of_unbounded hbelow habove\n refine ⟨u.curve, ?_, u.agrees⟩\n simpa only [← hfull] using u.linear\ntheorem riemannian_approximate_radial_split\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)\n {M : Type*} [MetricSpace M] [ChartedSpace H M]\n [(x : M) → ENorm (TangentSpace I x)]\n [∀ x : M, ENormSMulClass ℝ (TangentSpace I x)]\n (hmetric : ∀ x y : M, edist x y = Manifold.riemannianEDist I x y)\n (x y : M) (r ε : ℝ) (hr : 0 ≤ r) (hrd : r ≤ dist x y) (hε : 0 < ε) :\n ∃ z : M, dist x z = r ∧ dist z y < dist x y - r + ε := open Bundle in by\n have htotalpos : 0 < dist x y + ε := by positivity\n have hd : Manifold.riemannianEDist I x y < ENNReal.ofReal (dist x y + ε) := by\n rw [← hmetric, edist_dist]\n exact (ENNReal.ofReal_lt_ofReal_iff htotalpos).2 (by linarith)\n obtain ⟨γ, hγ0, hγ1, hγ, hlen⟩ := Manifold.exists_lt_of_riemannianEDist_lt hd\n have hf : ContinuousOn (fun t : ℝ => dist x (γ t)) (Set.Icc 0 1) :=\n continuous_dist.continuousOn.comp\n (continuousOn_const.prodMk hγ.continuousOn) (fun _ _ => Set.mem_univ _)\n have hrim : r ∈ Set.Icc (dist x (γ 0)) (dist x (γ 1)) := by\n simpa [hγ0, hγ1] using (show r ∈ Set.Icc 0 (dist x y) from ⟨hr, hrd⟩)\n obtain ⟨t, ht, htr⟩ := intermediate_value_Icc (by norm_num : (0 : ℝ) ≤ 1) hf hrim\n refine ⟨γ t, htr, ?_⟩\n have hpre : ENNReal.ofReal r ≤ Manifold.pathELength I γ 0 t := by\n rw [← htr, ← edist_dist, hmetric]\n exact Manifold.riemannianEDist_le_pathELength\n (hγ.mono (Set.Icc_subset_Icc le_rfl ht.2)) hγ0 rfl ht.1\n have hsuf : ENNReal.ofReal (dist (γ t) y) ≤ Manifold.pathELength I γ t 1 := by\n rw [← edist_dist, hmetric]\n exact Manifold.riemannianEDist_le_pathELength\n (hγ.mono (Set.Icc_subset_Icc ht.1 le_rfl)) rfl hγ1 ht.2\n have hsum : ENNReal.ofReal r + ENNReal.ofReal (dist (γ t) y) <\n ENNReal.ofReal (dist x y + ε) := by\n calc\n _ ≤ Manifold.pathELength I γ 0 t + Manifold.pathELength I γ t 1 := add_le_add hpre hsuf\n _ = Manifold.pathELength I γ 0 1 := Manifold.pathELength_add ht.1 ht.2\n _ < _ := hlen\n have hrest : 0 ≤ dist x y - r + ε := by linarith\n have heq : ENNReal.ofReal (dist x y + ε) =\n ENNReal.ofReal r + ENNReal.ofReal (dist x y - r + ε) := by\n rw [← ENNReal.ofReal_add hr hrest]\n congr 1\n ring\n rw [heq, ENNReal.add_lt_add_iff_left ENNReal.ofReal_ne_top] at hsum\n exact (ENNReal.ofReal_lt_ofReal_iff (by linarith : 0 < dist x y - r + ε)).1 hsum\ntheorem radial_split_inside_compact_ball\n {X : Type*} [MetricSpace X]\n (happrox : ∀ (x y : X) (r ε : ℝ), 0 ≤ r → r ≤ dist x y → 0 < ε →\n ∃ z : X, dist x z = r ∧ dist z y < dist x y - r + ε)\n (x y p : X) (R s t : ℝ)\n (hcompact : IsCompact (Metric.closedBall x R))\n (hxy : dist x y = R) (hxp : dist x p = s) (hpy : dist p y = R - s)\n (hst : s ≤ t) (htR : t ≤ R) :\n ∃ z : X, dist p z = t - s ∧ dist z y = R - t ∧ dist x z = t := by\n let K : Set X := Metric.closedBall x R ∩ {z | dist p z = t - s}\n have hK : IsCompact K := hcompact.inter_right (isClosed_eq (by fun_prop) continuous_const)\n have happroxK : ∀ ε > (0 : ℝ), ∃ z ∈ K, dist z y < R - t + ε := by\n intro ε hε\n obtain ⟨z, hpz, hzy⟩ := happrox p y (t-s) ε (by linarith) (by rw [hpy]; linarith) hε\n refine ⟨z, ⟨?_, hpz⟩, ?_⟩\n · rw [Metric.mem_closedBall, dist_comm]\n calc\n dist x z ≤ dist x p + dist p z := dist_triangle _ _ _\n _ = t := by rw [hxp, hpz]; ring\n _ ≤ R := htR\n · rw [hpy] at hzy\n linarith\n obtain ⟨z₀, hz₀, _⟩ := happroxK 1 (by norm_num)\n obtain ⟨z, hz, hmin⟩ := hK.exists_isMinOn ⟨z₀, hz₀⟩\n (continuous_id.dist continuous_const).continuousOn\n have hle : dist z y ≤ R - t := by\n apply le_of_forall_pos_lt_add\n intro ε hε\n obtain ⟨w, hw, hwy⟩ := happroxK ε hε\n exact (hmin hw).trans_lt hwy\n have hge : R-t ≤ dist z y := by\n have := dist_triangle p z y\n rw [hpy, hz.2] at this\n linarith\n have hzy : dist z y = R-t := le_antisymm hle hge\n refine ⟨z, hz.2, hzy, le_antisymm ?_ ?_⟩\n · have := dist_triangle x p z\n rw [hxp, hz.2] at this\n linarith\n · have := dist_triangle x z y\n rw [hxy, hzy] at this\n linarith\ntheorem metric_segment_of_compact_ball\n {X : Type*} [MetricSpace X]\n (happrox : ∀ (x y : X) (r ε : ℝ), 0 ≤ r → r ≤ dist x y → 0 < ε →\n ∃ z : X, dist x z = r ∧ dist z y < dist x y - r + ε)\n (x y : X) (R : ℝ) (hxy : dist x y = R)\n (hcompact : IsCompact (Metric.closedBall x R)) :\n ∃ γ : ℝ → X, γ 0 = x ∧ γ R = y ∧\n ∀ s ∈ Set.Icc 0 R, ∀ t ∈ Set.Icc 0 R, dist (γ s) (γ t) = |t-s| := by\n classical\n have hR : 0 ≤ R := hxy ▸ dist_nonneg\n let Good : Set (ℝ × X) → Prop := fun G =>\n G ⊆ Set.Icc 0 R ×ˢ Metric.closedBall x R ∧\n (0,x) ∈ G ∧ (R,y) ∈ G ∧\n ∀ p ∈ G, ∀ q ∈ G, dist p.2 q.2 = |q.1-p.1|\n have hbase : Good {(0,x), (R,y)} := by\n refine ⟨?_, by simp, by simp, ?_⟩\n · intro p hp\n simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hp\n rcases hp with rfl | rfl\n · exact ⟨⟨le_rfl, hR⟩, by simpa [Metric.mem_closedBall]⟩\n · exact ⟨⟨hR, le_rfl⟩, by simpa [Metric.mem_closedBall, dist_comm] using hxy.le⟩\n · intro p hp q hq\n simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hp hq\n rcases hp with rfl | rfl <;> rcases hq with rfl | rfl <;>\n simp [hxy, dist_comm y x, abs_of_nonneg hR]\n obtain ⟨G, hG, hmax⟩ := zorn_subset {G | Good G} (by\n intro C hC hchain\n by_cases hne : C.Nonempty\n · refine ⟨⋃₀ C, ?_, fun G hGC => Set.subset_sUnion_of_mem hGC⟩\n obtain ⟨G₀, hG₀⟩ := hne\n refine ⟨?_, Set.mem_sUnion_of_mem (hC hG₀).2.1 hG₀,\n Set.mem_sUnion_of_mem (hC hG₀).2.2.1 hG₀, ?_⟩\n · exact Set.sUnion_subset fun G hGC => (hC hGC).1\n · intro p hp q hq\n obtain ⟨A, hAC, hpA⟩ := Set.mem_sUnion.1 hp\n obtain ⟨B, hBC, hqB⟩ := Set.mem_sUnion.1 hq\n rcases hchain.total hAC hBC with hAB | hBA\n · exact (hC hBC).2.2.2 p (hAB hpA) q hqB\n · exact (hC hAC).2.2.2 p hpA q (hBA hqB)\n · exact ⟨{(0,x), (R,y)}, hbase, fun G hGC => (hne ⟨G, hGC⟩).elim⟩)\n change Good G at hG\n have hGcl : Good (closure G) := by\n refine ⟨closure_minimal hG.1 (isClosed_Icc.prod Metric.isClosed_closedBall),\n subset_closure hG.2.1, subset_closure hG.2.2.1, ?_⟩\n have hrel : IsClosed {p : (ℝ × X) × (ℝ × X) |\n dist p.1.2 p.2.2 = |p.2.1-p.1.1|} := isClosed_eq (by fun_prop) (by fun_prop)\n have hsub : G ×ˢ G ⊆ {p : (ℝ × X) × (ℝ × X) |\n dist p.1.2 p.2.2 = |p.2.1-p.1.1|} := fun p hp => hG.2.2.2 _ hp.1 _ hp.2\n intro p hp q hq\n exact closure_minimal hsub hrel (by simpa only [closure_prod_eq] using\n (show (p,q) ∈ closure G ×ˢ closure G from ⟨hp,hq⟩))\n have hclosed : IsClosed G := by\n exact closure_eq_iff_isClosed.mp (Set.Subset.antisymm (hmax hGcl subset_closure) subset_closure)\n have hcG : IsCompact G := (isCompact_Icc.prod hcompact).of_isClosed_subset hclosed hG.1\n let D : Set ℝ := Prod.fst '' G\n have hcD : IsCompact D := hcG.image continuous_fst\n have h0 : 0 ∈ D := ⟨(0,x), hG.2.1, rfl⟩\n have hRD : R ∈ D := ⟨(R,y), hG.2.2.1, rfl⟩\n have hD : ∀ t ∈ Set.Icc 0 R, t ∈ D := by\n intro t ht\n by_contra hnot\n obtain ⟨s, ⟨hsD, hst⟩, hsmax⟩ := (hcD.inter_right isClosed_Iic).exists_isGreatest\n ⟨0, h0, ht.1⟩\n obtain ⟨u, ⟨huD, htu⟩, humin⟩ := (hcD.inter_right isClosed_Ici).exists_isLeast\n ⟨R, hRD, ht.2⟩\n change s ≤ t at hst\n change t ≤ u at htu\n have hst' : s < t := lt_of_le_of_ne hst (by intro h; exact hnot (h ▸ hsD))\n have htu' : t < u := lt_of_le_of_ne htu (by intro h; exact hnot (h.symm ▸ huD))\n obtain ⟨⟨s',p⟩, hpG, hsp⟩ := hsD\n obtain ⟨⟨u',q⟩, hqG, huq⟩ := huD\n dsimp at hsp huq\n subst s'\n subst u'\n have hs0 : 0 ≤ s := (hG.1 hpG).1.1\n have huR : u ≤ R := (hG.1 hqG).1.2\n have hxp : dist x p = s := by\n simpa only [sub_zero, abs_of_nonneg hs0] using hG.2.2.2 (0,x) hG.2.1 (s,p) hpG\n have hxq : dist x q = u := by\n simpa only [sub_zero, abs_of_nonneg (hs0.trans (hst.trans htu))] using\n hG.2.2.2 (0,x) hG.2.1 (u,q) hqG\n have hpq : dist p q = u-s := by\n simpa only [abs_of_nonneg (sub_nonneg.2 (hst.trans htu))] using\n hG.2.2.2 (s,p) hpG (u,q) hqG\n have hcu : IsCompact (Metric.closedBall x u) := hcompact.of_isClosed_subset\n Metric.isClosed_closedBall (Metric.closedBall_subset_closedBall huR)\n obtain ⟨z, hpz, hzq, hxz⟩ := radial_split_inside_compact_ball happrox x q p u s t\n hcu hxq hxp hpq hst htu\n have hdist : ∀ v ∈ G, dist v.2 z = |t-v.1| := by\n intro v hv\n have hcase : v.1 ≤ s ∨ u ≤ v.1 := by\n by_cases hvt : v.1 ≤ t\n · exact Or.inl (hsmax ⟨⟨v,hv,rfl⟩,hvt⟩)\n · exact Or.inr (humin ⟨⟨v,hv,rfl⟩,(not_le.1 hvt).le⟩)\n rcases hcase with hvs | huv\n · have hvp : dist v.2 p = s-v.1 := by\n simpa only [abs_of_nonneg (sub_nonneg.2 hvs)] using hG.2.2.2 v hv (s,p) hpG\n have hvq : dist v.2 q = u-v.1 := by\n simpa only [abs_of_nonneg (sub_nonneg.2 (hvs.trans (hst.trans htu)))] using\n hG.2.2.2 v hv (u,q) hqG\n rw [abs_of_nonneg (sub_nonneg.2 (hvs.trans hst))]\n have hupper := dist_triangle v.2 p z\n have hlower := dist_triangle v.2 z q\n rw [hvp, hpz] at hupper\n rw [hvq, hzq] at hlower\n exact le_antisymm (by linarith) (by linarith)\n · have hvq : dist v.2 q = v.1-u := by\n simpa only [abs_of_nonpos (sub_nonpos.2 huv), neg_sub] using\n hG.2.2.2 v hv (u,q) hqG\n have hpv : dist p v.2 = v.1-s := by\n simpa only [abs_of_nonneg (sub_nonneg.2 ((hst.trans htu).trans huv))] using\n hG.2.2.2 (s,p) hpG v hv\n rw [abs_of_nonpos (sub_nonpos.2 (htu.trans huv)), neg_sub]\n have hupper := dist_triangle v.2 q z\n have hlower := dist_triangle p z v.2\n rw [hvq, dist_comm q z, hzq] at hupper\n rw [hpv, hpz, dist_comm z v.2] at hlower\n exact le_antisymm (by linarith) (by linarith)\n have hinsert : Good (insert (t,z) G) := by\n refine ⟨?_, Set.mem_insert_of_mem _ hG.2.1, Set.mem_insert_of_mem _ hG.2.2.1, ?_⟩\n · intro v hv\n rcases Set.mem_insert_iff.1 hv with rfl | hv\n · exact ⟨ht, by simpa [Metric.mem_closedBall, dist_comm, hxz] using ht.2⟩\n · exact hG.1 hv\n · intro v hv w hw\n rcases Set.mem_insert_iff.1 hv with rfl | hv <;>\n rcases Set.mem_insert_iff.1 hw with rfl | hw\n · simp\n · simpa only [dist_comm z w.2, abs_sub_comm] using hdist w hw\n · exact hdist v hv\n · exact hG.2.2.2 v hv w hw\n have : (t,z) ∈ G := hmax hinsert (Set.subset_insert _ _) (Set.mem_insert _ _)\n exact hnot ⟨(t,z), this, rfl⟩\n have hex : ∀ t ∈ Set.Icc 0 R, ∃ p : X, (t,p) ∈ G := by\n intro t ht\n obtain ⟨⟨s,p⟩, hp, hst⟩ := hD t ht\n exact ⟨p, by simpa only [← hst] using hp⟩\n let γ : ℝ → X := fun t => if ht : t ∈ Set.Icc 0 R then (hex t ht).choose else x\n have hγ : ∀ t ∈ Set.Icc 0 R, (t,γ t) ∈ G := by\n intro t ht\n simpa only [γ, dif_pos ht] using (hex t ht).choose_spec\n have hγdist : ∀ s ∈ Set.Icc 0 R, ∀ t ∈ Set.Icc 0 R, dist (γ s) (γ t) = |t-s| :=\n fun s hs t ht => hG.2.2.2 _ (hγ s hs) _ (hγ t ht)\n refine ⟨γ, ?_, ?_, hγdist⟩\n · apply dist_eq_zero.1\n simpa only [sub_self, abs_zero] using hG.2.2.2 _ (hγ 0 ⟨le_rfl,hR⟩) _ hG.2.1\n · apply dist_eq_zero.1\n simpa only [sub_self, abs_zero] using hG.2.2.2 _ (hγ R ⟨hR,le_rfl⟩) _ hG.2.2.1\ntheorem local_descent_segment\n {X : Type*} [MetricSpace X] [LocallyCompactSpace X]\n (happrox : ∀ (x y : X) (r ε : ℝ), 0 ≤ r → r ≤ dist x y → 0 < ε →\n ∃ z : X, dist x z = r ∧ dist z y < dist x y - r + ε)\n (f : X → ℝ) (hf : Continuous f)\n (hle : ∀ x y, f x ≤ dist x y + f y)\n (hdesc : ∀ x r ε, 0 ≤ r → r < f x → 0 < ε →\n ∃ y, dist x y = r ∧ f y < f x-r+ε)\n (x : X) (hfx : 0 < f x) :\n ∃ r > (0 : ℝ), r < f x ∧ ∃ γ : ℝ → X, γ 0 = x ∧\n (∀ s ∈ Set.Icc 0 r, ∀ t ∈ Set.Icc 0 r, dist (γ s) (γ t) = |t-s|) ∧\n ∀ t ∈ Set.Icc 0 r, f (γ t) = f x-t := by\n obtain ⟨ρ, hρ, hcρ⟩ := Metric.exists_isCompact_closedBall x\n let r := min ρ (f x / 2)\n have hr : 0 < r := lt_min hρ (by linarith)\n have hrfx : r < f x := lt_of_le_of_lt (min_le_right _ _) (by linarith)\n have hcr : IsCompact (Metric.closedBall x r) := hcρ.of_isClosed_subset\n Metric.isClosed_closedBall (Metric.closedBall_subset_closedBall (min_le_left _ _))\n let K : Set X := Metric.closedBall x r ∩ {y | dist x y = r}\n have hcK : IsCompact K := hcr.inter_right (isClosed_eq (by fun_prop) continuous_const)\n have happK : ∀ ε > (0 : ℝ), ∃ y ∈ K, f y < f x-r+ε := by\n intro ε hε\n obtain ⟨y, hxy, hfy⟩ := hdesc x r ε hr.le hrfx hε\n exact ⟨y, ⟨by simpa [Metric.mem_closedBall, dist_comm, hxy], hxy⟩, hfy⟩\n obtain ⟨y₀, hy₀, _⟩ := happK 1 (by norm_num)\n obtain ⟨y, hy, hmin⟩ := hcK.exists_isMinOn ⟨y₀,hy₀⟩ hf.continuousOn\n have hfy : f y = f x-r := by\n apply le_antisymm\n · apply le_of_forall_pos_lt_add\n intro ε hε\n obtain ⟨z, hz, hfz⟩ := happK ε hε\n exact (hmin hz).trans_lt hfz\n · have := hle x y\n rw [hy.2] at this\n linarith\n obtain ⟨γ, hγ0, hγr, hdist⟩ := metric_segment_of_compact_ball happrox x y r hy.2 hcr\n refine ⟨r, hr, hrfx, γ, hγ0, hdist, ?_⟩\n intro t ht\n have hxt : dist x (γ t) = t := by\n simpa [hγ0, abs_of_nonneg ht.1] using hdist 0 ⟨le_rfl,hr.le⟩ t ht\n have hty : dist (γ t) y = r-t := by\n simpa [hγr, abs_of_nonneg (sub_nonneg.2 ht.2)] using hdist t ht r ⟨hr.le,le_rfl⟩\n have hupper := hle (γ t) y\n have hlower := hle x (γ t)\n rw [hty, hfy] at hupper\n rw [hxt] at hlower\n exact le_antisymm (by linarith) (by linarith)\ntheorem metric_segment_limit\n {X : Type*} [MetricSpace X]\n (hend : ∀ (b : ℝ) (γ : ℝ → X), 0 < b →\n (∀ s ∈ Set.Ioo 0 b, ∀ t ∈ Set.Ioo 0 b, dist (γ s) (γ t) = |t-s|) →\n ∃ p, Filter.Tendsto γ (nhdsWithin b (Set.Ioo 0 b)) (nhds p))\n (f : X → ℝ) (hf : Continuous f)\n (b R : ℝ) (hb : 0 < b) (γ : ℝ → X)\n (hdist : ∀ s ∈ Set.Ico 0 b, ∀ t ∈ Set.Ico 0 b, dist (γ s) (γ t) = |t-s|)\n (hval : ∀ t ∈ Set.Ioo 0 b, f (γ t) = R-t) :\n ∃ p, f p = R-b ∧ ∀ t ∈ Set.Ico 0 b, dist (γ t) p = b-t := by\n haveI : (nhdsWithin b (Set.Ioo 0 b)).NeBot := right_nhdsWithin_Ioo_neBot hb\n obtain ⟨p, hp⟩ := hend b γ hb (fun s hs t ht => hdist s ⟨hs.1.le,hs.2⟩ t ⟨ht.1.le,ht.2⟩)\n refine ⟨p, ?_, ?_⟩\n · have h₁ := hf.continuousAt.tendsto.comp hp\n have h₂ : Filter.Tendsto (fun t : ℝ => R-t) (nhdsWithin b (Set.Ioo 0 b)) (nhds (R-b)) :=\n (continuous_const.sub continuous_id).continuousAt.tendsto.mono_left nhdsWithin_le_nhds\n apply tendsto_nhds_unique h₁\n apply h₂.congr'\n filter_upwards [self_mem_nhdsWithin] with t ht\n exact (hval t ht).symm\n · intro s hs\n have h₁ : Filter.Tendsto (fun t => dist (γ s) (γ t))\n (nhdsWithin b (Set.Ioo 0 b)) (nhds (dist (γ s) p)) :=\n Filter.Tendsto.dist tendsto_const_nhds hp\n have h₂ : Filter.Tendsto (fun t : ℝ => |t-s|) (nhdsWithin b (Set.Ioo 0 b))\n (nhds (b-s)) := by\n simpa only [Pi.sub_apply, id_eq, abs_of_pos (sub_pos.2 hs.2)] using\n ((continuous_id.sub continuous_const).abs.continuousAt.tendsto.mono_left\n nhdsWithin_le_nhds : Filter.Tendsto (fun t : ℝ => |t-s|)\n (nhdsWithin b (Set.Ioo 0 b)) (nhds |b-s|))\n apply tendsto_nhds_unique h₁\n apply h₂.congr'\n filter_upwards [self_mem_nhdsWithin] with t ht\n exact (hdist s hs t ⟨ht.1.le,ht.2⟩).symm\ntheorem false_of_positive_descent\n {X : Type*} [MetricSpace X] [LocallyCompactSpace X]\n (happrox : ∀ (x y : X) (r ε : ℝ), 0 ≤ r → r ≤ dist x y → 0 < ε →\n ∃ z : X, dist x z = r ∧ dist z y < dist x y - r + ε)\n (hend : ∀ (b : ℝ) (γ : ℝ → X), 0 < b →\n (∀ s ∈ Set.Ioo 0 b, ∀ t ∈ Set.Ioo 0 b, dist (γ s) (γ t) = |t-s|) →\n ∃ p, Filter.Tendsto γ (nhdsWithin b (Set.Ioo 0 b)) (nhds p))\n (f : X → ℝ) (hf : Continuous f)\n (hle : ∀ x y, f x ≤ dist x y + f y)\n (hpos : ∀ x, 0 < f x)\n (hdesc : ∀ x r ε, 0 ≤ r → r < f x → 0 < ε →\n ∃ y, dist x y = r ∧ f y < f x-r+ε)\n (x₀ : X) : False := by\n classical\n let R := f x₀\n have hR : 0 < R := hpos x₀\n let Good : Set (ℝ × X) → Prop := fun G =>\n ∃ r ∈ Set.Icc 0 R,\n (∀ t, (∃ p, (t,p) ∈ G) ↔ t ∈ Set.Icc 0 r) ∧\n (0,x₀) ∈ G ∧\n (∀ p ∈ G, f p.2 = R-p.1) ∧\n ∀ p ∈ G, ∀ q ∈ G, dist p.2 q.2 = |q.1-p.1|\n have hbase : Good {(0,x₀)} := by\n refine ⟨0, ⟨le_rfl,hR.le⟩, ?_, by simp, ?_, ?_⟩\n · intro t\n simp\n · intro p hp\n rcases Set.mem_singleton_iff.1 hp with rfl\n simp [R]\n · intro p hp q hq\n rcases Set.mem_singleton_iff.1 hp with rfl\n rcases Set.mem_singleton_iff.1 hq with rfl\n simp\n obtain ⟨G,hG,hmax⟩ := zorn_subset {G | Good G} (by\n intro C hC hchain\n by_cases hne : C.Nonempty\n · let U : Set (ℝ × X) := ⋃₀ C\n let D : Set ℝ := Prod.fst '' U\n obtain ⟨A,hAC⟩ := hne\n have h0U : (0,x₀) ∈ U := Set.mem_sUnion_of_mem (hC hAC).choose_spec.2.2.1 hAC\n have h0D : 0 ∈ D := ⟨(0,x₀),h0U,rfl⟩\n have htime : ∀ p ∈ U, p.1 ∈ Set.Icc 0 R := by\n intro p hp\n obtain ⟨A,hAC,hpA⟩ := Set.mem_sUnion.1 hp\n obtain ⟨r,hr,hdom,-⟩ := hC hAC\n exact ⟨(hdom p.1).1 ⟨p.2,hpA⟩ |>.1,\n le_trans ((hdom p.1).1 ⟨p.2,hpA⟩ |>.2) hr.2⟩\n have hdown : ∀ u ∈ D, ∀ t ∈ Set.Icc 0 u, t ∈ D := by\n intro u hu t ht\n obtain ⟨⟨u',p⟩,hp,hu'⟩ := hu\n dsimp at hu'\n subst u'\n obtain ⟨A,hAC,hpA⟩ := Set.mem_sUnion.1 hp\n obtain ⟨r,hr,hdom,-⟩ := hC hAC\n obtain ⟨q,hq⟩ := (hdom t).2 ⟨ht.1,ht.2.trans ((hdom u).1 ⟨p,hpA⟩).2⟩\n exact ⟨(t,q),Set.mem_sUnion_of_mem hq hAC,rfl⟩\n have hval : ∀ p ∈ U, f p.2 = R-p.1 := by\n intro p hp\n obtain ⟨A,hAC,hpA⟩ := Set.mem_sUnion.1 hp\n exact (hC hAC).choose_spec.2.2.2.1 p hpA\n have hdist : ∀ p ∈ U, ∀ q ∈ U, dist p.2 q.2 = |q.1-p.1| := by\n intro p hp q hq\n obtain ⟨A,hAC,hpA⟩ := Set.mem_sUnion.1 hp\n obtain ⟨B,hBC,hqB⟩ := Set.mem_sUnion.1 hq\n rcases hchain.total hAC hBC with hAB | hBA\n · exact (hC hBC).choose_spec.2.2.2.2 p (hAB hpA) q hqB\n · exact (hC hAC).choose_spec.2.2.2.2 p hpA q (hBA hqB)\n have hbdd : BddAbove D := ⟨R, fun t ⟨p,hp,hpt⟩ => hpt ▸ (htime p hp).2⟩\n let b := sSup D\n have htb : ∀ t ∈ D, t ≤ b := fun t ht => le_csSup hbdd ht\n have hb0 : 0 ≤ b := htb 0 h0D\n have hbR : b ≤ R := csSup_le ⟨0,h0D⟩ (fun t ⟨p,hp,hpt⟩ => hpt ▸ (htime p hp).2)\n have hbelow : ∀ t ∈ Set.Ico 0 b, t ∈ D := by\n intro t ht\n obtain ⟨u,hu,htu⟩ := exists_lt_of_lt_csSup ⟨0,h0D⟩ ht.2\n exact hdown u hu t ⟨ht.1,htu.le⟩\n by_cases hbD : b ∈ D\n · refine ⟨U, ⟨b,⟨hb0,hbR⟩,?_,h0U,hval,hdist⟩,\n fun A hAC => Set.subset_sUnion_of_mem hAC⟩\n intro t\n constructor\n · intro ⟨p,hp⟩\n exact ⟨(htime (t,p) hp).1,htb t ⟨(t,p),hp,rfl⟩⟩\n · intro ht\n obtain ⟨⟨s,p⟩,hp,hst⟩ := hdown b hbD t ht\n exact ⟨p,by simpa only [← hst] using hp⟩\n · have hbpos : 0 < b := lt_of_le_of_ne hb0 (by intro hb; exact hbD (hb ▸ h0D))\n have hstrict : ∀ p ∈ U, p.1 < b := by\n intro p hp\n exact lt_of_le_of_ne (htb p.1 ⟨p,hp,rfl⟩)\n (by intro he; exact hbD (he ▸ (show p.1 ∈ D from ⟨p,hp,rfl⟩)))\n have hex : ∀ t ∈ Set.Ico 0 b, ∃ p : X, (t,p) ∈ U := by\n intro t ht\n obtain ⟨⟨s,p⟩,hp,hst⟩ := hbelow t ht\n exact ⟨p,by simpa only [← hst] using hp⟩\n let γ : ℝ → X := fun t => if ht : t ∈ Set.Ico 0 b then (hex t ht).choose else x₀\n have hγ : ∀ t ∈ Set.Ico 0 b, (t,γ t) ∈ U := by\n intro t ht\n simpa only [γ,dite_eq_left ht] using (hex t ht).choose_spec\n obtain ⟨p,hfp,hdp⟩ := metric_segment_limit hend f hf b R hbpos γ\n (fun s hs t ht => hdist _ (hγ s hs) _ (hγ t ht))\n (fun t ht => hval _ (hγ t ⟨ht.1.le,ht.2⟩))\n have hUeq : ∀ z ∈ U, z.2 = γ z.1 := by\n intro z hz\n apply dist_eq_zero.1\n simpa only [sub_self,abs_zero] using\n hdist z hz _ (hγ z.1 ⟨(htime z hz).1,hstrict z hz⟩)\n have hzp : ∀ z ∈ U, dist z.2 p = b-z.1 := by\n intro z hz\n rw [hUeq z hz]\n exact hdp z.1 ⟨(htime z hz).1,hstrict z hz⟩\n refine ⟨insert (b,p) U, ?_, fun A hAC =>\n (Set.subset_sUnion_of_mem hAC).trans (Set.subset_insert _ _)⟩\n refine ⟨b,⟨hb0,hbR⟩,?_,Set.mem_insert_of_mem _ h0U,?_,?_⟩\n · intro t\n constructor\n · rintro ⟨z,hz⟩\n rcases Set.mem_insert_iff.1 hz with heq | hz\n · have : t = b := congrArg Prod.fst heq\n rw [this]\n exact ⟨hb0,le_rfl⟩\n · exact ⟨(htime (t,z) hz).1,(hstrict (t,z) hz).le⟩\n · intro ht\n rcases lt_or_eq_of_le ht.2 with hlt | rfl\n · obtain ⟨z,hz⟩ := hex t ⟨ht.1,hlt⟩\n exact ⟨z,Set.mem_insert_of_mem _ hz⟩\n · exact ⟨p,Set.mem_insert _ _⟩\n · intro z hz\n rcases Set.mem_insert_iff.1 hz with rfl | hz\n · exact hfp\n · exact hval z hz\n · intro z hz w hw\n rcases Set.mem_insert_iff.1 hz with rfl | hz <;>\n rcases Set.mem_insert_iff.1 hw with rfl | hw\n · simp\n · rw [dist_comm, hzp w hw, abs_of_nonpos (sub_nonpos.2 (hstrict w hw).le),neg_sub]\n · rw [hzp z hz, abs_of_nonneg (sub_nonneg.2 (hstrict z hz).le)]\n · exact hdist z hz w hw\n · exact ⟨{(0,x₀)},hbase,fun A hAC => (hne ⟨A,hAC⟩).elim⟩)\n obtain ⟨r,hr,hdom,h0,hval,hdist⟩ := hG\n obtain ⟨p,hp⟩ := (hdom r).2 ⟨hr.1,le_rfl⟩\n have hfp : f p = R-r := hval (r,p) hp\n obtain ⟨ℓ,hℓ,hℓf,γ,hγ0,hγdist,hγval⟩ :=\n local_descent_segment happrox f hf hle hdesc p (hpos p)\n have hrℓ : r+ℓ ≤ R := by rw [hfp] at hℓf; linarith\n let V : Set (ℝ × X) := (fun t : ℝ => (r+t,γ t)) '' Set.Icc 0 ℓ\n have hcross : ∀ z ∈ G, ∀ t ∈ Set.Icc 0 ℓ, dist z.2 (γ t) = r+t-z.1 := by\n intro z hz t ht\n have hzr : z.1 ≤ r := ((hdom z.1).1 ⟨z.2,hz⟩).2\n have hzp : dist z.2 p = r-z.1 := by\n simpa only [abs_of_nonneg (sub_nonneg.2 hzr)] using hdist z hz (r,p) hp\n have hpt : dist p (γ t) = t := by\n simpa [hγ0,abs_of_nonneg ht.1] using hγdist 0 ⟨le_rfl,hℓ.le⟩ t ht\n have hupper := dist_triangle z.2 p (γ t)\n rw [hzp,hpt] at hupper\n have hlower := hle z.2 (γ t)\n rw [hval z hz,hγval t ht,hfp] at hlower\n exact le_antisymm (by linarith) (by linarith)\n have hnew : Good (G ∪ V) := by\n refine ⟨r+ℓ,⟨by linarith [hr.1],hrℓ⟩,?_,Or.inl h0,?_,?_⟩\n · intro t\n constructor\n · rintro ⟨z,hz | hz⟩\n · have := (hdom t).1 ⟨z,hz⟩\n exact ⟨this.1,by linarith [this.2]⟩\n · obtain ⟨s,hs,he⟩ := hz\n have he' : r+s = t := congrArg Prod.fst he\n exact ⟨by linarith [hs.1,hr.1],by linarith [hs.2]⟩\n · intro ht\n by_cases htr : t ≤ r\n · obtain ⟨z,hz⟩ := (hdom t).2 ⟨ht.1,htr⟩\n exact ⟨z,Or.inl hz⟩\n · exact ⟨γ (t-r),Or.inr ⟨t-r,⟨by linarith,by linarith [ht.2]⟩,\n by simp⟩⟩\n · intro z hz\n rcases hz with hz | ⟨t,ht,rfl⟩\n · exact hval z hz\n · dsimp\n rw [hγval t ht,hfp]\n ring\n · intro z hz w hw\n rcases hz with hz | ⟨s,hs,rfl⟩ <;> rcases hw with hw | ⟨t,ht,rfl⟩\n · exact hdist z hz w hw\n · have hzr := ((hdom z.1).1 ⟨z.2,hz⟩).2\n simpa only [abs_of_nonneg (by linarith [ht.1] : 0 ≤ r+t-z.1)] using hcross z hz t ht\n · have hwr := ((hdom w.1).1 ⟨w.2,hw⟩).2\n rw [dist_comm, hcross w hw s hs]\n dsimp\n rw [abs_of_nonpos (by linarith [hs.1] : w.1-(r+s) ≤ 0)]\n ring\n · dsimp\n rw [hγdist s hs t ht]\n congr 1\n ring\n have hsub : G ∪ V ⊆ G := hmax hnew Set.subset_union_left\n have hendG : (r+ℓ,γ ℓ) ∈ G := hsub (Or.inr ⟨ℓ,⟨hℓ.le,le_rfl⟩,rfl⟩)\n have := ((hdom (r+ℓ)).1 ⟨γ ℓ,hendG⟩).2\n linarith\ntheorem completeSpace_of_metric_segment_limits\n {X : Type*} [MetricSpace X] [LocallyCompactSpace X]\n (happrox : ∀ (x y : X) (r ε : ℝ), 0 ≤ r → r ≤ dist x y → 0 < ε →\n ∃ z : X, dist x z = r ∧ dist z y < dist x y - r + ε)\n (hend : ∀ (b : ℝ) (γ : ℝ → X), 0 < b →\n (∀ s ∈ Set.Ioo 0 b, ∀ t ∈ Set.Ioo 0 b, dist (γ s) (γ t) = |t-s|) →\n ∃ p, Filter.Tendsto γ (nhdsWithin b (Set.Ioo 0 b)) (nhds p)) :\n CompleteSpace X := by\n classical\n have hsurj : Function.Surjective ((↑) : X → UniformSpace.Completion X) := by\n intro q\n by_contra hq\n let f : X → ℝ := fun x => dist (x : UniformSpace.Completion X) q\n have hf : Continuous f := (UniformSpace.Completion.continuous_coe X).dist continuous_const\n have hpos : ∀ x, 0 < f x := fun x => dist_pos.2 (by\n intro h\n exact hq ⟨x,h⟩)\n have hle : ∀ x y, f x ≤ dist x y + f y := by\n intro x y\n simpa only [f,UniformSpace.Completion.dist_eq] using\n dist_triangle (x : UniformSpace.Completion X) (y : UniformSpace.Completion X) q\n have hdesc : ∀ x r ε, 0 ≤ r → r < f x → 0 < ε →\n ∃ y, dist x y = r ∧ f y < f x-r+ε := by\n intro x r ε hr hrfx hε\n let δ := min ((f x-r)/2) (ε/4)\n have hδ : 0 < δ := lt_min (by linarith) (by linarith)\n obtain ⟨y,hy⟩ := UniformSpace.Completion.denseRange_coe.exists_dist_lt q hδ\n have hfy : f y < δ := by simpa only [f,dist_comm q] using hy\n have hfy₁ : f y < (f x-r)/2 := lt_of_lt_of_le hfy (min_le_left _ _)\n have hfy₂ : f y < ε/4 := lt_of_lt_of_le hfy (min_le_right _ _)\n have hrxy : r ≤ dist x y := by have := hle x y; linarith\n obtain ⟨z,hxz,hzy⟩ := happrox x y r (ε/2) hr hrxy (by linarith)\n have hxy : dist x y ≤ f x+f y := by\n simpa only [f,UniformSpace.Completion.dist_eq,dist_comm q] using\n dist_triangle (x : UniformSpace.Completion X) q (y : UniformSpace.Completion X)\n have hfz := hle z y\n exact ⟨z,hxz,by linarith⟩\n obtain ⟨x₀,-⟩ := UniformSpace.Completion.denseRange_coe.exists_dist_lt q zero_lt_one\n exact false_of_positive_descent happrox hend f hf hle hpos hdesc x₀\n exact (UniformSpace.Completion.isUniformInducing_coe X).completeSpace_congr hsurj |>.2 inferInstance\ntheorem edist_ne_top_of_preconnected\n {X : Type*} [PseudoEMetricSpace X] [PreconnectedSpace X] (x y : X) :\n edist x y ≠ ⊤ := by\n have huniv : Metric.eball x ⊤ = Set.univ :=\n IsClopen.eq_univ ⟨Metric.isClosed_eball_top,Metric.isOpen_eball⟩\n ⟨x,by simp [Metric.mem_eball]⟩\n have hy : y ∈ Metric.eball x ⊤ := by rw [huniv]; trivial\n exact (Metric.mem_eball'.1 hy).ne\ntheorem isOpen_superposition_domain\n {K : Type*} [TopologicalSpace K] [CompactSpace K]\n {E : Type*} [TopologicalSpace E] {U : Set E} (hU : IsOpen U) :\n IsOpen {g : ContinuousMap K E | Set.range (fun k => g k) ⊆ U} :=\n ContinuousMap.isOpen_setOfPred_range_subset hU\ntheorem continuousOn_superposition_compact\n {K : Type*} [TopologicalSpace K] [CompactSpace K] [T2Space K]\n {E : Type*} [TopologicalSpace E] {F : Type*} [TopologicalSpace F]\n (U : Set E) (f : E → F) (N : ContinuousMap K E → ContinuousMap K F)\n (hf : ContinuousOn f U)\n (hN : ∀ g : ContinuousMap K E, Set.range (fun k => g k) ⊆ U →\n ∀ k, N g k = f (g k)) :\n ContinuousOn N {g : ContinuousMap K E | Set.range (fun k => g k) ⊆ U} := by\n apply ContinuousMap.continuousOn_of_continuousOn_uncurry\n have h := hf.comp continuous_eval.continuousOn\n (show Set.MapsTo (fun p : ContinuousMap K E × K => p.1 p.2)\n ({g : ContinuousMap K E | Set.range (fun k => g k) ⊆ U} ×ˢ Set.univ) U from\n fun p hp => hp.1 ⟨p.2, rfl⟩)\n exact h.congr (fun p hp => hN p.1 hp.1 p.2)\nnoncomputable def superposition_compact\n {K : Type*} [TopologicalSpace K]\n {E : Type*} [TopologicalSpace E]\n {F : Type*} [TopologicalSpace F] [Zero F]\n (f : E → F) (g : ContinuousMap K E) : ContinuousMap K F :=\n ContinuousMap.mkD (fun k => f (g k)) 0\ntheorem superposition_compact_apply\n {K : Type*} [TopologicalSpace K]\n {E : Type*} [TopologicalSpace E]\n {F : Type*} [TopologicalSpace F] [Zero F]\n {U : Set E} {f : E → F} (hf : ContinuousOn f U)\n {g : ContinuousMap K E} (hg : Set.range (fun k => g k) ⊆ U) (k : K) :\n superposition_compact f g k = f (g k) :=\n ContinuousMap.mkD_apply_of_continuous\n (hf.comp_continuous g.continuous (fun k => hg ⟨k, rfl⟩))\ntheorem eq_affine_of_hasDerivAt_sq_zero\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (A : E →L[ℝ] E) (hA : A.comp A = 0) (S : Set ℝ)\n (hS : IsOpen S) (hconn : IsPreconnected S) (h0 : (0 : ℝ) ∈ S)\n (X : ℝ → E) (hX : ∀ t ∈ S, HasDerivAt X (A (X t)) t)\n (t : ℝ) (ht : t ∈ S) :\n X t = X 0 + t • A (X 0) := by\n have hAX : ∀ u ∈ S, HasDerivAt (fun s => A (X s)) 0 u := by\n intro u hu\n simpa only [Function.comp_def, ← ContinuousLinearMap.comp_apply, hA,\n zero_apply] using\n (A.hasFDerivAt.comp_hasDerivAt u (hX u hu))\n have hAX_const : ∀ u ∈ S, A (X u) = A (X 0) := by\n intro u hu\n exact hS.is_const_of_deriv_eq_zero hconn\n (fun s hs => (hAX s hs).differentiableAt.differentiableWithinAt)\n (fun s hs => (hAX s hs).deriv) hu h0\n have hline : ∀ u : ℝ,\n HasDerivAt (fun s => X 0 + s • A (X 0)) (A (X 0)) u := by\n intro u\n simpa only [id_eq, one_smul] using\n ((hasDerivAt_id u).smul_const (A (X 0))).const_add (X 0)\n apply hS.eqOn_of_deriv_eq hconn\n (fun s hs => (hX s hs).differentiableAt.differentiableWithinAt)\n (fun s _ => (hline s).differentiableAt.differentiableWithinAt) ?_ h0\n (by simp) ht\n intro s hs\n rw [(hX s hs).deriv, (hline s).deriv]\n exact hAX_const s hs\ntheorem radial_gauss_cauchy_schwarz\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (B B₀ : E →L[ℝ] E →L[ℝ] ℝ)\n (hsymm : ∀ v w : E, B v w = B w v)\n (hnonneg : ∀ v : E, 0 ≤ B v v)\n (L : E →L[ℝ] E) (u : E)\n (hGauss : ∀ w : E, B (L u) (L w) = B₀ u w) (w : E) :\n |B₀ u w| ≤ Real.sqrt (B₀ u u) * Real.sqrt (B (L w) (L w)) := by\n have hdisc := discrim_le_zero\n (a := B (L u) (L u)) (b := 2 * B (L u) (L w))\n (c := B (L w) (L w)) (fun t : ℝ => by\n have h := hnonneg (t • L u + L w)\n simp only [map_add, map_smul, add_apply, smul_apply, smul_eq_mul] at h\n rw [hsymm (L w) (L u)] at h\n nlinarith)\n have hsq : B (L u) (L w) ^ 2 ≤ B (L u) (L u) * B (L w) (L w) := by\n dsimp [discrim] at hdisc\n nlinarith\n have h := Real.abs_le_sqrt hsq\n rw [Real.sqrt_mul (hnonneg (L u))] at h\n simpa only [hGauss] using h\ntheorem regularized_radius_fderiv_bound_of_gauss\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (B B₀ : E →L[ℝ] E →L[ℝ] ℝ)\n (hsym : ∀ u v, B u v = B v u) (hnonneg : ∀ v, 0 ≤ B v v)\n (hsym₀ : ∀ u v, B₀ u v = B₀ v u)\n {f : E → E} {x : E} (hf : DifferentiableAt ℝ f x)\n (L : E →L[ℝ] E)\n (hGauss : ∀ v, B (L (f x)) (L v) = B₀ (f x) v)\n (hcancel : ∀ w, L (fderiv ℝ f x w) = w)\n {δ : ℝ} (hδ : 0 < δ) (w : E) :\n |fderiv ℝ (fun y => Real.sqrt (B₀ (f y) (f y) + δ)) x w| ≤\n Real.sqrt (B w w) := by\n have hq : 0 ≤ B₀ (f x) (f x) := by\n rw [← hGauss]\n exact hnonneg _\n have hpos : 0 < B₀ (f x) (f x) + δ := by linarith\n rw [(hasFDerivAt_regularized_bilinear_radius B₀ hsym₀ hf.hasFDerivAt hpos).fderiv]\n simp only [smul_apply, ContinuousLinearMap.comp_apply,\n smul_eq_mul, inv_mul_eq_div, abs_div,\n abs_of_nonneg (Real.sqrt_nonneg _)]\n apply (div_le_iff₀ (Real.sqrt_pos.mpr hpos)).mpr\n have hcs := radial_gauss_cauchy_schwarz B B₀ hsym hnonneg L (f x)\n hGauss (fderiv ℝ f x w)\n rw [hcancel] at hcs\n exact hcs.trans (by\n rw [mul_comm]\n exact mul_le_mul_of_nonneg_left\n (Real.sqrt_le_sqrt (by linarith)) (Real.sqrt_nonneg _))\ntheorem hasDerivAt_bilinear_radius\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (B₀ : E →L[ℝ] E →L[ℝ] ℝ)\n (hsymm : ∀ v w : E, B₀ v w = B₀ w v)\n {γ : ℝ → E} {v : E} {t : ℝ} (hγ : HasDerivAt γ v t)\n (hpos : 0 < B₀ (γ t) (γ t)) :\n HasDerivAt (fun s => Real.sqrt (B₀ (γ s) (γ s)))\n (B₀ (γ t) v / Real.sqrt (B₀ (γ t) (γ t))) t := by\n have h := (B₀.hasFDerivAt.comp_hasDerivAt t hγ).clm_apply hγ\n have hq : HasDerivAt (fun s => B₀ (γ s) (γ s)) (2 * B₀ (γ t) v) t := by\n convert h using 1 <;> simp only [Function.comp_apply, hsymm v (γ t)] <;> ring\n convert hq.sqrt (ne_of_gt hpos) using 1 <;> field_simp\ntheorem radial_gauss_radius_deriv_bound\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (B B₀ : E →L[ℝ] E →L[ℝ] ℝ)\n (hsymm : ∀ v w : E, B v w = B w v)\n (hnonneg : ∀ v : E, 0 ≤ B v v)\n (hsymm₀ : ∀ v w : E, B₀ v w = B₀ w v)\n (L : E →L[ℝ] E) {γ : ℝ → E} {v : E} {t : ℝ}\n (hγ : HasDerivAt γ v t) (hpos : 0 < B₀ (γ t) (γ t))\n (hGauss : ∀ w : E, B (L (γ t)) (L w) = B₀ (γ t) w) :\n HasDerivAt (fun s => Real.sqrt (B₀ (γ s) (γ s)))\n (B₀ (γ t) v / Real.sqrt (B₀ (γ t) (γ t))) t ∧\n |B₀ (γ t) v / Real.sqrt (B₀ (γ t) (γ t))| ≤\n Real.sqrt (B (L v) (L v)) := by\n refine ⟨hasDerivAt_bilinear_radius B₀ hsymm₀ hγ hpos, ?_⟩\n have hsqrt : 0 < Real.sqrt (B₀ (γ t) (γ t)) := Real.sqrt_pos.2 hpos\n rw [abs_div, abs_of_pos hsqrt, div_le_iff₀ hsqrt]\n simpa only [mul_comm] using\n radial_gauss_cauchy_schwarz B B₀ hsymm hnonneg L (γ t) hGauss v\ntheorem exists_smooth_compact_primitive_of_integral_zero : open MeasureTheory in\n ∀ (a b : ℝ) (hab : a < b) (φ : ℝ → ℝ)\n (hφ : ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) φ)\n (hcompact : HasCompactSupport φ) (hsub : tsupport φ ⊆ Set.Ioo a b)\n (hint : (∫ t : ℝ, φ t) = 0),\n ∃ ψ : ℝ → ℝ, ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) ψ ∧\n HasCompactSupport ψ ∧ tsupport ψ ⊆ Set.Ioo a b ∧\n ∀ t : ℝ, deriv ψ t = φ t := by\n intro a b hab φ hφ hcompact hsub hint\n classical\n let ψ : ℝ → ℝ := fun t => ∫ s in a..t, φ s\n have hderiv (t : ℝ) : HasDerivAt ψ (φ t) t :=\n (hφ.continuous.integral_hasStrictDerivAt a t).hasDerivAt\n have hderiv_eq : deriv ψ = φ := funext fun t => (hderiv t).deriv\n have hsmooth : ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) ψ :=\n contDiff_infty_iff_deriv.mpr\n ⟨fun t => (hderiv t).differentiableAt, hderiv_eq.symm ▸ hφ⟩\n by_cases hne : (tsupport φ).Nonempty\n · obtain ⟨c, hc⟩ := hcompact.isCompact.exists_isLeast hne\n obtain ⟨d, hd⟩ := hcompact.isCompact.exists_isGreatest hne\n have hac : a < c := (hsub hc.1).1\n have hdb : d < b := (hsub hd.1).2\n have hleft (t : ℝ) (ht : t < c) : ψ t = 0 := by\n change (∫ s in a..t, φ s) = 0\n calc\n (∫ s in a..t, φ s) = ∫ s in a..t, (0 : ℝ) := by\n apply intervalIntegral.integral_congr_uIoo\n intro s hs\n have hsc : s < c := lt_trans hs.2 (max_lt hac ht)\n by_contra hφs\n exact (not_le_of_gt hsc) (hc.2 (subset_tsupport φ hφs))\n _ = 0 := by simp\n have hright (t : ℝ) (ht : d < t) : ψ t = 0 := by\n change (∫ s in a..t, φ s) = 0\n refine (intervalIntegral.integral_eq_integral_of_support_subset ?_).trans hint\n intro s hs\n have hs' : s ∈ tsupport φ := subset_tsupport φ hs\n exact ⟨(hsub hs').1, (hd.2 hs').trans ht.le⟩\n have hsupport : Function.support ψ ⊆ Set.Icc c d := by\n intro t ht\n change ψ t ≠ 0 at ht\n constructor\n · by_contra hct\n exact ht (hleft t (lt_of_not_ge hct))\n · by_contra htd\n exact ht (hright t (lt_of_not_ge htd))\n have htsupport : tsupport ψ ⊆ Set.Icc c d :=\n closure_minimal hsupport isClosed_Icc\n refine ⟨ψ, hsmooth,\n HasCompactSupport.of_support_subset_isCompact isCompact_Icc hsupport, ?_,\n fun t => (hderiv t).deriv⟩\n intro t ht\n exact ⟨hac.trans_le (htsupport ht).1, lt_of_le_of_lt (htsupport ht).2 hdb⟩\n · have hφzero : φ = 0 := tsupport_eq_empty_iff.mp\n (Set.not_nonempty_iff_eq_empty.mp hne)\n refine ⟨0, contDiff_const, ?_, ?_, ?_⟩\n · exact HasCompactSupport.of_support_subset_isCompact (K := (∅ : Set ℝ))\n isCompact_empty (by simp)\n · simp\n · intro t\n simp [hφzero]\ntheorem ae_eq_const_of_test_deriv_integral_zero : open MeasureTheory in\n ∀ {F : Type*} [NormedAddCommGroup F] [NormedSpace ℝ F] [CompleteSpace F]\n (a b : ℝ), a < b → ∀ P : ℝ → F, LocallyIntegrableOn P (Set.Ioo a b) →\n (∀ φ : ℝ → ℝ, ContDiff ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) φ →\n HasCompactSupport φ → tsupport φ ⊆ Set.Ioo a b →\n (∫ t : ℝ, deriv φ t • P t) = 0) →\n ∃ C : F, ∀ᵐ t : ℝ, t ∈ Set.Ioo a b → P t = C := by\n intro F _ _ _ a b hab P hP hderiv\n apply ae_eq_const_of_zero_mean_test_integral_zero a b hab P hP\n intro φ hφ hcφ hsφ hiφ\n obtain ⟨ψ, hψ, hcψ, hsψ, hdψ⟩ :=\n exists_smooth_compact_primitive_of_integral_zero a b hab φ hφ hcφ hsφ hiφ\n simpa only [hdψ] using hderiv ψ hψ hcψ hsψ\ntheorem contDiffAt_fixedPoint_of_invertible\n {P : Type*} [NormedAddCommGroup P] [NormedSpace ℝ P] [CompleteSpace P]\n {X : Type*} [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n {n : WithTop ℕ∞} {T : P × X → X} {u : P → X} {p : P}\n (hT : ContDiffAt ℝ n T (p, u p)) (hn : n ≠ 0)\n (hInv : (fderiv ℝ (fun z : P × X => z.2 - T z) (p, u p) ∘L\n ContinuousLinearMap.inr ℝ P X).IsInvertible)\n (hu : ContinuousAt u p)\n (hfix : ∀ᶠ q in nhds p, T (q, u q) = u q) :\n ContDiffAt ℝ n u p := by\n let R : P × X → X := fun z => z.2 - T z\n have hR : ContDiffAt ℝ n R (p, u p) := contDiffAt_snd.sub hT\n let v : P → X := hR.implicitFunction hn hInv\n have hv : ContDiffAt ℝ n v p := hR.contDiffAt_implicitFunction hn hInv\n have hzero : R (p, u p) = 0 := by simp [R, hfix.self_of_nhds]\n have hpair : Filter.Tendsto (fun q => (q, u q)) (nhds p) (nhds (p, u p)) :=\n continuousAt_id.prodMk hu\n have heq : ∀ᶠ q in nhds p, u q = v q := by\n filter_upwards [hpair.eventually (hR.eventually_apply_eq_iff_implicitFunction hn hInv),\n hfix] with q hq hqfix\n exact (hq.mp (by simp [R, hqfix, hzero])).symm\n exact hv.congr_of_eventuallyEq heq\ntheorem exists_smooth_fixedPoint_family\n {P : Type*} [NormedAddCommGroup P] [NormedSpace ℝ P] [CompleteSpace P]\n {X : Type*} [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n {U : Set (P × X)} (hU : IsOpen U) {T : P × X → X}\n (hT : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) T U)\n {p : P} {x : X} (hz : (p, x) ∈ U) (hfix : T (p, x) = x)\n (hInv : (fderiv ℝ (fun z : P × X => z.2 - T z) (p, x) ∘L\n ContinuousLinearMap.inr ℝ P X).IsInvertible) :\n ∃ V : Set P, IsOpen V ∧ p ∈ V ∧ ∃ u : P → X, u p = x ∧\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) u V ∧\n ∀ q ∈ V, (q, u q) ∈ U ∧ T (q, u q) = u q := by\n let R : P × X → X := fun z => z.2 - T z\n have hRW : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) R U := contDiffOn_snd.sub hT\n have hR := hRW.contDiffAt (hU.mem_nhds hz)\n have hR1 : ContDiffAt ℝ 1 R (p, x) := hR.of_le (by simp)\n let u : P → X := hR1.implicitFunction one_ne_zero hInv\n have hu : ContDiffAt ℝ 1 u p := hR1.contDiffAt_implicitFunction one_ne_zero hInv\n have hup : u p = x := hR1.implicitFunction_apply_self one_ne_zero hInv\n have hpair : Filter.Tendsto (fun q => (q, u q)) (nhds p) (nhds (p, x)) := by\n simpa only [hup, id_eq] using (continuousAt_id.prodMk hu.continuousAt).tendsto\n have hD : ContinuousAt\n (fun z : P × X => fderiv ℝ R z ∘L ContinuousLinearMap.inr ℝ P X) (p, x) :=\n ((hRW.continuousOn_fderiv_of_isOpen hU (by simp)).continuousAt\n (hU.mem_nhds hz)).clm_comp continuousAt_const\n have hnear : ∀ᶠ q in nhds p,\n (q, u q) ∈ U ∧ T (q, u q) = u q ∧\n (fderiv ℝ R (q, u q) ∘L ContinuousLinearMap.inr ℝ P X).IsInvertible ∧\n ContinuousAt u q := by\n filter_upwards [hpair.eventually (hU.mem_nhds hz),\n hR1.eventually_apply_implicitFunction one_ne_zero hInv,\n (hD.tendsto.comp hpair).eventually hInv.eventually_nhds,\n hu.eventually (by norm_num)] with q hq hqfix hqInv hqu\n refine ⟨hq, ?_, hqInv, hqu.continuousAt⟩\n have hzero : R (p, x) = 0 := by simp [R, hfix]\n exact (sub_eq_zero.mp (hqfix.trans hzero)).symm\n obtain ⟨V, hVsub, hV, hpV⟩ := mem_nhds_iff.mp hnear\n refine ⟨V, hV, hpV, u, hup, ?_, fun q hq => ⟨(hVsub hq).1,\n (hVsub hq).2.1⟩⟩\n intro q hq\n have hqu := hVsub hq\n apply (contDiffAt_fixedPoint_of_invertible\n (hT.contDiffAt (hU.mem_nhds hqu.1)) (by simp) hqu.2.2.1 hqu.2.2.2 ?_).contDiffWithinAt\n filter_upwards [hV.mem_nhds hq] with r hr\n exact (hVsub hr).2.1\nnoncomputable def picardPrimitive\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n (f : ContinuousMap (Set.Icc (0 : ℝ) 1) E) :\n ContinuousMap (Set.Icc (0 : ℝ) 1) E :=\n let F : ℝ → E := fun s => f (Set.projIcc 0 1 zero_le_one s)\n have hF : Continuous F := f.continuous.comp continuous_projIcc\n ⟨fun t => ∫ s in (0 : ℝ)..(t : ℝ), F s,\n (intervalIntegral.differentiable_integral_of_continuous hF).continuous.comp\n continuous_subtype_val⟩\nnoncomputable def picardPrimitiveCLM\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E] :\n ContinuousMap (Set.Icc (0 : ℝ) 1) E →L[ℝ]\n ContinuousMap (Set.Icc (0 : ℝ) 1) E := by\n let L : ContinuousMap (Set.Icc (0 : ℝ) 1) E →ₗ[ℝ]\n ContinuousMap (Set.Icc (0 : ℝ) 1) E := {\n toFun := picardPrimitive\n map_add' := by\n intro f g\n ext t\n exact intervalIntegral.integral_add\n ((f.continuous.comp continuous_projIcc).intervalIntegrable _ _)\n ((g.continuous.comp continuous_projIcc).intervalIntegrable _ _)\n map_smul' := by\n intro c f\n ext t\n exact intervalIntegral.integral_smul c _ }\n apply L.mkContinuous 1\n intro f\n rw [one_mul]\n apply (ContinuousMap.norm_le (L f) (norm_nonneg f)).mpr\n intro t\n change ‖∫ s in (0 : ℝ)..(t : ℝ), f (Set.projIcc 0 1 zero_le_one s)‖ ≤ ‖f‖\n calc\n _ ≤ ‖f‖ * |(t : ℝ) - 0| :=\n intervalIntegral.norm_integral_le_of_norm_le_const\n (fun s _ => f.norm_coe_le_norm _)\n _ ≤ ‖f‖ := by\n rw [sub_zero, abs_of_nonneg t.2.1]\n exact mul_le_of_le_one_right (norm_nonneg f) t.2.2\ntheorem exists_smooth_rescaled_picard_family\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n (W : Set (ContinuousMap (Set.Icc (0 : ℝ) 1) E)) (hW : IsOpen W)\n (N : ContinuousMap (Set.Icc (0 : ℝ) 1) E → ContinuousMap (Set.Icc (0 : ℝ) 1) E)\n (hN : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) N W)\n (x : E) (hx : ContinuousMap.const (Set.Icc (0 : ℝ) 1) x ∈ W) :\n ∃ V : Set (ℝ × E), IsOpen V ∧ (0, x) ∈ V ∧\n ∃ A : ℝ × E → ContinuousMap (Set.Icc (0 : ℝ) 1) E,\n A (0, x) = ContinuousMap.const _ x ∧\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) A V ∧\n ∀ z ∈ V, A z ∈ W ∧\n A z = ContinuousMap.const _ z.2 + z.1 • picardPrimitiveCLM (N (A z)) := by\n let C := ContinuousMap (Set.Icc (0 : ℝ) 1) E\n let c : E →L[ℝ] C := ContinuousLinearMap.const ℝ _\n let J : C →L[ℝ] C := picardPrimitiveCLM\n let T : ((ℝ × E) × C) → C := fun z => c z.1.2 + z.1.1 • J (N z.2)\n let D : Set ((ℝ × E) × C) := Set.univ ×ˢ W\n have hD : IsOpen D := isOpen_univ.prod hW\n have hT : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) T D := by\n have hNc : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞)\n (fun z : (ℝ × E) × C => N z.2) D :=\n hN.comp contDiffOn_snd (fun _ hz => hz.2)\n exact (c.contDiff.comp_contDiffOn contDiffOn_fst.snd).add\n (contDiffOn_fst.fst.smul (J.contDiff.comp_contDiffOn hNc))\n let α₀ : C := ContinuousMap.const _ x\n have hz : (((0 : ℝ), x), α₀) ∈ D := ⟨Set.mem_univ _, hx⟩\n have hfix : T ((0, x), α₀) = α₀ := by\n change c x + (0 : ℝ) • _ = α₀\n simp only [zero_smul, add_zero]\n rfl\n let R : ((ℝ × E) × C) → C := fun z => z.2 - T z\n have hR : DifferentiableAt ℝ R ((0, x), α₀) :=\n ((contDiffOn_snd.sub hT).contDiffAt (hD.mem_nhds hz)).differentiableAt (by simp)\n have hi : HasFDerivAt (fun α : C => (((0 : ℝ), x), α))\n (ContinuousLinearMap.inr ℝ (ℝ × E) C) α₀ :=\n (hasFDerivAt_const ((0 : ℝ), x) α₀).prodMk (hasFDerivAt_id α₀)\n have hc : HasFDerivAt (fun α : C => R ((0, x), α))\n (ContinuousLinearMap.id ℝ C) α₀ := by\n simpa [R, T] using (hasFDerivAt_id α₀).sub_const (c x)\n have hpartial : fderiv ℝ R ((0, x), α₀) ∘L\n ContinuousLinearMap.inr ℝ (ℝ × E) C = ContinuousLinearMap.id ℝ C :=\n (hR.hasFDerivAt.comp α₀ hi).unique hc\n have hInv : (fderiv ℝ R ((0, x), α₀) ∘L\n ContinuousLinearMap.inr ℝ (ℝ × E) C).IsInvertible := by\n rw [hpartial]\n exact ⟨ContinuousLinearEquiv.refl ℝ C, rfl⟩\n obtain ⟨V, hV, hpV, A, hA₀, hA, hAT⟩ :=\n exists_smooth_fixedPoint_family hD hT hz hfix hInv\n refine ⟨V, hV, hpV, A, hA₀, hA, ?_⟩\n intro z hz\n exact ⟨(hAT z hz).1.2, (hAT z hz).2.symm⟩\nnoncomputable def continuousMap_applyLinear\n {K : Type*} [TopologicalSpace K] [CompactSpace K]\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {F : Type*} [NormedAddCommGroup F] [NormedSpace ℝ F] :\n ContinuousMap K (E →L[ℝ] F) →L[ℝ]\n ContinuousMap K E →L[ℝ] ContinuousMap K F := by\n letI : NormedAddCommGroup (E →L[ℝ] F) := ContinuousLinearMap.toNormedAddCommGroup\n letI : NormedSpace ℝ (E →L[ℝ] F) := ContinuousLinearMap.toNormedSpace\n let B : ContinuousMap K (E →L[ℝ] F) →ₗ[ℝ]\n ContinuousMap K E →ₗ[ℝ] ContinuousMap K F :=\n LinearMap.mk₂ ℝ\n (fun A h => ⟨fun k => A k (h k), A.continuous.clm_apply h.continuous⟩)\n (by intros; ext; simp)\n (by intros; ext; simp)\n (by intros; ext; simp)\n (by intros; ext; simp)\n refine B.mkContinuous₂ 1 ?_\n intro A h\n apply (ContinuousMap.norm_le (B A h) (by positivity : 0 ≤ 1 * ‖A‖ * ‖h‖)).mpr\n intro k\n change ‖A k (h k)‖ ≤ 1 * ‖A‖ * ‖h‖\n simpa only [one_mul] using (A k).le_opNorm (h k) |>.trans\n (mul_le_mul (A.norm_coe_le_norm k) (h.norm_coe_le_norm k)\n (norm_nonneg _) (norm_nonneg _))\ntheorem continuousMap_applyLinear_apply\n {K : Type*} [TopologicalSpace K] [CompactSpace K]\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {F : Type*} [NormedAddCommGroup F] [NormedSpace ℝ F]\n (A : ContinuousMap K (E →L[ℝ] F)) (h : ContinuousMap K E) (k : K) :\n continuousMap_applyLinear A h k = A k (h k) := rfl\ntheorem hasFDerivAt_continuousMap_of_pointwise\n {K : Type*} [TopologicalSpace K] [CompactSpace K]\n {P : Type*} [NormedAddCommGroup P] [NormedSpace ℝ P]\n {F : Type*} [NormedAddCommGroup F] [NormedSpace ℝ F]\n {S : Set P} (hS : IsOpen S)\n (N : P → ContinuousMap K F) (A : P → P →L[ℝ] ContinuousMap K F)\n (hA : ContinuousOn A S)\n (hN : ∀ x ∈ S, ∀ k : K,\n HasFDerivAt (fun y => N y k) ((ContinuousMap.evalCLM ℝ k).comp (A x)) x)\n {g : P} (hg : g ∈ S) : HasFDerivAt N (A g) g := by\n rw [hasFDerivAt_iff_isLittleO, Asymptotics.isLittleO_iff]\n intro ε hε\n obtain ⟨δ, hδ, hAδ⟩ := Metric.continuousAt_iff.mp\n ((hA g hg).continuousAt (hS.mem_nhds hg)) ε hε\n obtain ⟨r, hr, hrS⟩ := Metric.mem_nhds_iff.mp (hS.mem_nhds hg)\n have hrδ : 0 < min r δ := lt_min hr hδ\n filter_upwards [Metric.ball_mem_nhds g hrδ] with y hy\n apply (ContinuousMap.norm_le _ (mul_nonneg hε.le (norm_nonneg _))).mpr\n intro k\n have hsub : Metric.ball g (min r δ) ⊆ S :=\n fun z hz => hrS (Metric.mem_ball.mpr (lt_of_lt_of_le hz (min_le_left _ _)))\n have hd (z) (hz : z ∈ Metric.ball g (min r δ)) :\n HasFDerivWithinAt (fun h => N h k - A g h k)\n ((ContinuousMap.evalCLM ℝ k).comp (A z) -\n (ContinuousMap.evalCLM ℝ k).comp (A g)) (Metric.ball g (min r δ)) z :=\n ((hN z (hsub hz) k).sub\n (((ContinuousMap.evalCLM ℝ k).comp (A g)).hasFDerivAt)).hasFDerivWithinAt\n have hb (z) (hz : z ∈ Metric.ball g (min r δ)) :\n ‖(ContinuousMap.evalCLM ℝ k).comp (A z) -\n (ContinuousMap.evalCLM ℝ k).comp (A g)‖ ≤ ε := by\n apply ContinuousLinearMap.opNorm_le_bound _ hε.le\n intro v\n change ‖((A z - A g) v) k‖ ≤ ε * ‖v‖\n refine (((A z - A g) v).norm_coe_le_norm k).trans\n (((A z - A g).le_opNorm v).trans ?_)\n exact mul_le_mul_of_nonneg_right\n (le_of_lt (by\n simpa only [dist_eq_norm] using hAδ\n (lt_of_lt_of_le hz (min_le_right _ _)))) (norm_nonneg _)\n have hm := (convex_ball g (min r δ)).norm_image_sub_le_of_norm_hasFDerivWithin_le\n hd hb (Metric.mem_ball_self hrδ) hy\n have he : (N y k - A g y k) - (N g k - A g g k) =\n (N y - N g - A g (y - g)) k := by\n simp only [ContinuousMap.sub_apply, map_sub]\n abel\n rw [he] at hm\n exact hm\ntheorem hasFDerivAt_superposition_compact\n {K : Type*} [TopologicalSpace K] [CompactSpace K] [T2Space K]\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {F : Type*} [NormedAddCommGroup F] [NormedSpace ℝ F]\n (U : Set E) (f : E → F) (N : ContinuousMap K E → ContinuousMap K F)\n (hU : IsOpen U) (hf : ContDiffOn ℝ 1 f U)\n (hN : ∀ g : ContinuousMap K E, Set.range (fun k => g k) ⊆ U →\n ∀ k, N g k = f (g k))\n {g : ContinuousMap K E} (hg : Set.range (fun k => g k) ⊆ U) :\n HasFDerivAt N\n (continuousMap_applyLinear (superposition_compact (fderiv ℝ f) g)) g := by\n let : NormedAddCommGroup (E →L[ℝ] F) := ContinuousLinearMap.toNormedAddCommGroup\n let : NormedSpace ℝ (E →L[ℝ] F) := ContinuousLinearMap.toNormedSpace\n have hS := isOpen_superposition_domain (K := K) hU\n have hdf := hf.continuousOn_fderiv_of_isOpen hU le_rfl\n have hD := continuousOn_superposition_compact (K := K) U (fderiv ℝ f)\n (superposition_compact (K := K) (fderiv ℝ f)) hdf\n (fun g hg k => superposition_compact_apply hdf hg k)\n apply hasFDerivAt_continuousMap_of_pointwise hS N\n (fun g => continuousMap_applyLinear (superposition_compact (fderiv ℝ f) g))\n (continuousMap_applyLinear.continuous.comp_continuousOn hD) ?_ hg\n intro x hx k\n have hf' := ((hf.differentiableOn one_ne_zero (x k) (hx ⟨k, rfl⟩)\n ).differentiableAt (hU.mem_nhds (hx ⟨k, rfl⟩))).hasFDerivAt\n have hcomp := hf'.comp x ((ContinuousMap.evalCLM ℝ k).hasFDerivAt)\n have he : (fderiv ℝ f (x k)).comp (ContinuousMap.evalCLM ℝ k) =\n (ContinuousMap.evalCLM ℝ k).comp\n (continuousMap_applyLinear (superposition_compact (fderiv ℝ f) x)) := by\n ext v\n change (fderiv ℝ f (x k)) (v k) =\n superposition_compact (fderiv ℝ f) x k (v k)\n rw [superposition_compact_apply hdf hx]\n rw [he] at hcomp\n apply hcomp.congr_of_eventuallyEq\n filter_upwards [hS.mem_nhds hx] with y hy\n exact hN y hy k\ntheorem contDiffOn_superposition_compact_nat.{uK, uE, uF}\n {K : Type uK} [TopologicalSpace K] [CompactSpace K] [T2Space K]\n {E : Type uE} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (n : ℕ) :\n ∀ {F : Type (max uE uF)} [NormedAddCommGroup F] [NormedSpace ℝ F]\n (U : Set E) (f : E → F) (N : ContinuousMap K E → ContinuousMap K F),\n IsOpen U → ContDiffOn ℝ n f U →\n (∀ g : ContinuousMap K E, Set.range (fun k => g k) ⊆ U →\n ∀ k, N g k = f (g k)) →\n ContDiffOn ℝ n N {g : ContinuousMap K E | Set.range (fun k => g k) ⊆ U} := by\n induction n with\n | zero =>\n intro F _ _ U f N hU hf hN\n exact contDiffOn_zero.mpr\n (continuousOn_superposition_compact U f N hf.continuousOn hN)\n | succ n ih =>\n intro F _ _ U f N hU hf hN\n let : NormedAddCommGroup (E →L[ℝ] F) := ContinuousLinearMap.toNormedAddCommGroup\n let : NormedSpace ℝ (E →L[ℝ] F) := ContinuousLinearMap.toNormedSpace\n have hS := isOpen_superposition_domain (K := K) hU\n have hdf : ContDiffOn ℝ n (fderiv ℝ f) U :=\n hf.fderiv_of_isOpen hU (by simp)\n have hD := ih U (fderiv ℝ f) (superposition_compact (K := K) (fderiv ℝ f)) hU hdf\n (fun g hg k => superposition_compact_apply hdf.continuousOn hg k)\n have hder (g : ContinuousMap K E) (hg : Set.range (fun k => g k) ⊆ U) :=\n hasFDerivAt_superposition_compact U f N hU\n (hf.of_le (by exact_mod_cast Nat.succ_pos n)) hN hg\n rw [show ((n + 1 : ℕ) : WithTop ℕ∞) = (n : WithTop ℕ∞) + 1 by simp]\n apply (contDiffOn_succ_iff_fderiv_of_isOpen hS).mpr\n refine ⟨fun g hg => (hder g hg).differentiableAt.differentiableWithinAt,\n ?_, ?_⟩\n · intro h\n simp at h\n · apply (continuousMap_applyLinear.contDiff.comp_contDiffOn hD).congr\n intro g hg\n exact (hder g hg).fderiv\ntheorem contDiffOn_superposition_compact.{uK, uE, uF}\n {K : Type uK} [TopologicalSpace K] [CompactSpace K] [T2Space K]\n {E : Type uE} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {F : Type uF} [NormedAddCommGroup F] [NormedSpace ℝ F] [CompleteSpace F]\n (U : Set E) (f : E → F) (N : ContinuousMap K E → ContinuousMap K F)\n (hU : IsOpen U) (hf : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) f U)\n (hN : ∀ g : ContinuousMap K E, Set.range (fun k => g k) ⊆ U →\n ∀ k : K, N g k = f (g k)) :\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) N\n {g : ContinuousMap K E | Set.range (fun k => g k) ⊆ U} := by\n let e : ULift.{uE} F ≃L[ℝ] F := ContinuousLinearEquiv.ulift\n apply contDiffOn_infty.mpr\n intro n\n let Nu := fun g => (e.symm.toContinuousLinearMap.compLeftContinuous ℝ K) (N g)\n have hf' : ContDiffOn ℝ n (fun x => e.symm (f x)) U :=\n e.symm.contDiff.comp_contDiffOn (hf.of_le (by simp))\n have hNu := contDiffOn_superposition_compact_nat n U (fun x => e.symm (f x)) Nu\n hU hf' (by\n intro g hg k\n change e.symm (N g k) = e.symm (f (g k))\n rw [hN g hg k])\n have hdown := (e.toContinuousLinearMap.compLeftContinuous ℝ K).contDiff.comp_contDiffOn hNu\n convert hdown using 1\n ext g k\n rfl\ntheorem exists_smooth_rescaled_solution_family\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n (U : Set E) (hU : IsOpen U) (f : E → E)\n (hf : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) f U)\n (x : E) (hx : x ∈ U) :\n ∃ V : Set (ℝ × E), IsOpen V ∧ (0, x) ∈ V ∧\n ∃ A : ℝ × E → ContinuousMap (Set.Icc (0 : ℝ) 1) E,\n A (0, x) = ContinuousMap.const _ x ∧\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) A V ∧\n ∀ z ∈ V, (∀ s, A z s ∈ U) ∧ ∀ s : Set.Icc (0 : ℝ) 1,\n A z s = z.2 + z.1 • ∫ τ in (0 : ℝ)..(s : ℝ),\n f (A z (Set.projIcc 0 1 zero_le_one τ)) := by\n let W := {g : ContinuousMap (Set.Icc (0 : ℝ) 1) E |\n Set.range (fun s => g s) ⊆ U}\n let N := superposition_compact (K := Set.Icc (0 : ℝ) 1) f\n have hN : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) N W :=\n contDiffOn_superposition_compact U f N hU hf\n (fun g hg s => superposition_compact_apply hf.continuousOn hg s)\n have hx' : ContinuousMap.const (Set.Icc (0 : ℝ) 1) x ∈ W := by\n rintro _ ⟨s, rfl⟩\n exact hx\n obtain ⟨V, hV, hpV, A, hA₀, hA, hAT⟩ :=\n exists_smooth_rescaled_picard_family W (isOpen_superposition_domain hU) N hN x hx'\n refine ⟨V, hV, hpV, A, hA₀, hA, ?_⟩\n intro z hz\n have hAW := (hAT z hz).1\n refine ⟨fun s => hAW ⟨s, rfl⟩, ?_⟩\n intro s\n have heq := congrArg (fun g : ContinuousMap (Set.Icc (0 : ℝ) 1) E => g s)\n (hAT z hz).2\n change A z s = z.2 + z.1 • ∫ τ in (0 : ℝ)..(s : ℝ),\n N (A z) (Set.projIcc 0 1 zero_le_one τ) at heq\n simpa only [N, superposition_compact_apply hf.continuousOn hAW] using heq\ntheorem contDiffOn_coordinate_spray\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {U : Set E} {n : WithTop ℕ∞} {Γ : E → E →L[ℝ] E →L[ℝ] E}\n (hΓ : ContDiffOn ℝ n Γ U) :\n ContDiffOn ℝ n (fun z : E × E => (z.2, -(Γ z.1 z.2 z.2))) (U ×ˢ Set.univ) := by\n exact contDiffOn_snd.prodMk\n ((((hΓ.comp contDiffOn_fst (fun _ hz => hz.1)).clm_apply\n contDiffOn_snd).clm_apply contDiffOn_snd).neg)\ntheorem rescaled_picard_unique\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {S : Set E} {f : E → E} {K : NNReal} (hf : LipschitzOnWith K f S)\n {h : ℝ} (hh : ‖h‖ * K < 1) {y : E}\n {A B : ContinuousMap (Set.Icc (0 : ℝ) 1) E}\n (hAS : ∀ s, A s ∈ S) (hBS : ∀ s, B s ∈ S)\n (hA : ∀ s : Set.Icc (0 : ℝ) 1,\n A s = y + h • ∫ τ in (0 : ℝ)..(s : ℝ),\n f (A (Set.projIcc 0 1 zero_le_one τ)))\n (hB : ∀ s : Set.Icc (0 : ℝ) 1,\n B s = y + h • ∫ τ in (0 : ℝ)..(s : ℝ),\n f (B (Set.projIcc 0 1 zero_le_one τ))) : A = B := by\n have hAc : Continuous (fun τ : ℝ => f (A (Set.projIcc 0 1 zero_le_one τ))) :=\n hf.continuousOn.comp_continuous (A.continuous.comp continuous_projIcc)\n (fun τ => hAS _)\n have hBc : Continuous (fun τ : ℝ => f (B (Set.projIcc 0 1 zero_le_one τ))) :=\n hf.continuousOn.comp_continuous (B.continuous.comp continuous_projIcc)\n (fun τ => hBS _)\n have hn : ‖A - B‖ ≤ (‖h‖ * K) * ‖A - B‖ := by\n apply (ContinuousMap.norm_le _ (by positivity)).mpr\n intro s\n change ‖A s - B s‖ ≤ _\n rw [hA s, hB s, add_sub_add_left_eq_sub, ← smul_sub,\n ← intervalIntegral.integral_sub (hAc.intervalIntegrable _ _)\n (hBc.intervalIntegrable _ _), norm_smul]\n have hi : ‖∫ τ in (0 : ℝ)..(s : ℝ),\n (f (A (Set.projIcc 0 1 zero_le_one τ)) -\n f (B (Set.projIcc 0 1 zero_le_one τ)))‖ ≤ K * ‖A - B‖ := by\n calc\n _ ≤ (K * ‖A - B‖) * |(s : ℝ) - 0| :=\n intervalIntegral.norm_integral_le_of_norm_le_const (fun τ _ =>\n (hf.norm_sub_le (hAS _) (hBS _)).trans\n (mul_le_mul_of_nonneg_left ((A - B).norm_coe_le_norm _) K.2))\n _ ≤ K * ‖A - B‖ := by\n rw [sub_zero, abs_of_nonneg s.2.1]\n exact mul_le_of_le_one_right (by positivity) s.2.2\n calc\n _ ≤ ‖h‖ * (K * ‖A - B‖) := mul_le_mul_of_nonneg_left hi (norm_nonneg h)\n _ = _ := by ring\n have hz : ‖A - B‖ = 0 := by nlinarith [norm_nonneg (A - B)]\n exact sub_eq_zero.mp (norm_eq_zero.mp hz)\ntheorem mul_mem_time_interval {h δ s : ℝ} (hh : |h| < δ)\n (hs : s ∈ Set.Icc (0 : ℝ) 1) : h * s ∈ Set.Ioo (-δ) δ := by\n apply abs_lt.mp\n calc\n |h * s| = |h| * s := by rw [abs_mul, abs_of_nonneg hs.1]\n _ ≤ |h| := mul_le_of_le_one_right (abs_nonneg h) hs.2\n _ < δ := hh\ntheorem rescaled_solution_picard\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {f : E → E} {δ h : ℝ} (hh : |h| < δ) {β : ℝ → E}\n (hβ : ∀ t ∈ Set.Ioo (-δ) δ, HasDerivAt β (f (β t)) t)\n (B : ContinuousMap (Set.Icc (0 : ℝ) 1) E)\n (hB : ∀ s, B s = β (h * s))\n (hfc : Continuous (fun τ : ℝ => f (B (Set.projIcc 0 1 zero_le_one τ)))) :\n ∀ s : Set.Icc (0 : ℝ) 1,\n B s = β 0 + h • ∫ τ in (0 : ℝ)..(s : ℝ),\n f (B (Set.projIcc 0 1 zero_le_one τ)) := by\n intro s\n have hd (τ : ℝ) (hτ : τ ∈ Set.uIcc (0 : ℝ) (s : ℝ)) :\n HasDerivAt (fun τ => β (h * τ))\n (h • f (B (Set.projIcc 0 1 zero_le_one τ))) τ := by\n have hτ' : τ ∈ Set.Icc (0 : ℝ) 1 := by\n rw [Set.uIcc_of_le s.2.1] at hτ\n exact ⟨hτ.1, hτ.2.trans s.2.2⟩\n have he : B (Set.projIcc 0 1 zero_le_one τ) = β (h * τ) := by\n rw [hB, Set.projIcc_of_mem zero_le_one hτ']\n rw [he]\n simpa only [Function.comp_def, mul_one] using\n (hβ (h * τ) (mul_mem_time_interval hh hτ')).scomp τ\n ((hasDerivAt_id τ).const_mul h)\n have hi := intervalIntegral.integral_eq_sub_of_hasDerivAt hd\n ((hfc.const_smul h).intervalIntegrable 0 (s : ℝ))\n rw [intervalIntegral.integral_smul, mul_zero] at hi\n rw [hB, hi]\n abel\ntheorem exists_smooth_local_ode_flow\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n (U : Set E) (hU : IsOpen U) (f : E → E)\n (hf : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) f U)\n (x : E) (hx : x ∈ U) :\n ∃ r > (0 : ℝ), ∃ ε > (0 : ℝ), ∃ Φ : ℝ × E → E,\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Φ\n (Set.Ioo (-ε) ε ×ˢ Metric.ball x r) ∧\n (∀ y ∈ Metric.ball x r, Φ (0, y) = y) ∧\n ∀ z ∈ Set.Ioo (-ε) ε ×ˢ Metric.ball x r,\n Φ z ∈ U ∧ HasDerivAt (fun t : ℝ => Φ (t, z.2)) (f (Φ z)) z.1 := by\n obtain ⟨V, hV, h0V, A, hA0, hA, hApic⟩ :=\n exists_smooth_rescaled_solution_family U hU f hf x hx\n have hf1 : ContDiffAt ℝ 1 f x :=\n (hf.contDiffAt (hU.mem_nhds hx)).of_le (by simp)\n obtain ⟨K, S, hS, hLf⟩ := hf1.exists_lipschitzOnWith\n obtain ⟨T, hTS, hT, hxT⟩ := mem_nhds_iff.mp hS\n have hLT : LipschitzOnWith K f T := hLf.mono hTS\n obtain ⟨δ, hδ, a, ρ, L, Kβ, hρ, hpl⟩ := IsPicardLindelof.of_contDiffAt_one hf1\n obtain ⟨β, hβ, hβcont⟩ :=\n (hpl 0).exists_forall_mem_closedBall_eq_hasDerivWithinAt_continuousOn\n simp only [zero_sub, zero_add] at hβ hβcont\n have hβ0 : β (x, 0) = x := (hβ x (Metric.mem_closedBall_self (by positivity))).1\n have hβc : ContinuousAt β (x, (0 : ℝ)) :=\n hβcont.continuousAt (by\n rw [nhds_prod_eq]\n exact Filter.prod_mem_prod (Metric.closedBall_mem_nhds x\n (show 0 < (ρ : ℝ) from hρ)) (Icc_mem_nhds (by linarith) hδ))\n have hβswap : ContinuousAt (fun z : ℝ × E => β (z.2, z.1)) (0, x) :=\n hβc.comp (f := fun z : ℝ × E => (z.2, z.1))\n (continuousAt_snd.prodMk continuousAt_fst)\n have hβnear : ∀ᶠ z : ℝ × E in nhds (0, x), β (z.2, z.1) ∈ T := by\n apply hβswap.tendsto.eventually\n change T ∈ nhds (β (x, 0))\n rw [hβ0]\n exact hT.mem_nhds hxT\n have hAnear : ∀ᶠ z : ℝ × E in nhds (0, x), ∀ s, A z s ∈ T := by\n have hW := isOpen_superposition_domain (K := Set.Icc (0 : ℝ) 1) hT\n have hAx : Set.range (fun s => A (0, x) s) ⊆ T := by\n rw [hA0]\n rintro _ ⟨s, rfl⟩\n exact hxT\n filter_upwards [(hA.contDiffAt (hV.mem_nhds h0V)).continuousAt.tendsto.eventually\n (hW.mem_nhds hAx)] with z hz s\n exact hz ⟨s, rfl⟩\n have hsmall : ∀ᶠ z : ℝ × E in nhds (0, x), ‖z.1‖ * K < 1 := by\n have hc : ContinuousAt (fun z : ℝ × E => ‖z.1‖ * (K : ℝ)) (0, x) :=\n continuousAt_fst.norm.mul continuousAt_const\n exact hc.eventually (gt_mem_nhds (by simp))\n have hdom : (Metric.closedBall x (ρ : ℝ) ×ˢ Set.Ioo (-δ) δ) ∈ nhds (x, (0 : ℝ)) :=\n by\n rw [nhds_prod_eq]\n exact Filter.prod_mem_prod (Metric.closedBall_mem_nhds x\n (show 0 < (ρ : ℝ) from hρ)) (Ioo_mem_nhds (by linarith) hδ)\n have hdom' : ∀ᶠ z : ℝ × E in nhds (0, x),\n z.2 ∈ Metric.closedBall x (ρ : ℝ) ∧ z.1 ∈ Set.Ioo (-δ) δ := by\n have hc : ContinuousAt (fun z : ℝ × E => (z.2, z.1)) (0, x) :=\n continuousAt_snd.prodMk continuousAt_fst\n exact hc.tendsto.eventually hdom\n have hnear : ∀ᶠ z : ℝ × E in nhds (0, x),\n z ∈ V ∧ (∀ s, A z s ∈ T) ∧ β (z.2, z.1) ∈ T ∧\n ‖z.1‖ * K < 1 ∧ z.2 ∈ Metric.closedBall x (ρ : ℝ) ∧\n z.1 ∈ Set.Ioo (-δ) δ := by\n filter_upwards [hV.mem_nhds h0V, hAnear, hβnear, hsmall, hdom']\n with z hz hAz hβz hsz hdz\n exact ⟨hz, hAz, hβz, hsz, hdz⟩\n obtain ⟨ε, hε, hεsub⟩ := Metric.mem_nhds_iff.mp hnear\n have hrect (z : ℝ × E) (hz : z ∈ Set.Ioo (-ε) ε ×ˢ Metric.ball x ε) :\n z ∈ V ∧ (∀ s, A z s ∈ T) ∧ β (z.2, z.1) ∈ T ∧\n ‖z.1‖ * K < 1 ∧ z.2 ∈ Metric.closedBall x (ρ : ℝ) ∧\n z.1 ∈ Set.Ioo (-δ) δ := by\n apply hεsub\n rw [← ball_prod_same]\n exact ⟨by simpa only [Metric.mem_ball, Real.dist_eq, sub_zero] using abs_lt.mpr hz.1,\n hz.2⟩\n let e : Set.Icc (0 : ℝ) 1 := ⟨1, by simp⟩\n let Φ : ℝ × E → E := fun z => A z e\n have heq (z : ℝ × E) (hz : z ∈ Set.Ioo (-ε) ε ×ˢ Metric.ball x ε) :\n Φ z = β (z.2, z.1) := by\n have hz' := hrect z hz\n have hh : |z.1| < δ := abs_lt.mpr hz'.2.2.2.2.2\n have hβd : ∀ t ∈ Set.Ioo (-δ) δ,\n HasDerivAt (fun t => β (z.2, t)) (f (β (z.2, t))) t := by\n intro t ht\n exact ((hβ z.2 hz'.2.2.2.2.1).2 t (Set.Ioo_subset_Icc_self ht)).hasDerivAt\n (Icc_mem_nhds ht.1 ht.2)\n let B : ContinuousMap (Set.Icc (0 : ℝ) 1) E :=\n ⟨fun s => β (z.2, z.1 * s),\n (HasDerivAt.continuousOn hβd).comp_continuous\n (continuous_const.mul continuous_subtype_val)\n (fun s => mul_mem_time_interval hh s.2)⟩\n have hBS : ∀ s, B s ∈ T := by\n intro s\n exact (hrect (z.1 * s, z.2) ⟨mul_mem_time_interval (abs_lt.mpr hz.1) s.2,\n hz.2⟩).2.2.1\n have hfc : Continuous (fun τ : ℝ => f (B (Set.projIcc 0 1 zero_le_one τ))) :=\n hLT.continuousOn.comp_continuous (B.continuous.comp continuous_projIcc)\n (fun τ => hBS _)\n have hBpic := rescaled_solution_picard hh hβd B (fun _ => rfl) hfc\n have hAB : A z = B := rescaled_picard_unique hLT hz'.2.2.2.1\n hz'.2.1 hBS (hApic z hz'.1).2 (by\n simpa only [(hβ z.2 hz'.2.2.2.2.1).1] using hBpic)\n change A z e = _\n rw [hAB]\n change β (z.2, z.1 * 1) = _\n rw [mul_one]\n refine ⟨ε, hε, ε, hε, Φ, ?_, ?_, ?_⟩\n · exact ((ContinuousMap.evalCLM ℝ e).contDiff.comp_contDiffOn hA).mono\n (fun z hz => (hrect z hz).1)\n · intro y hy\n have hyV := (hrect (0, y) ⟨by simpa using hε, hy⟩).1\n simpa only [Φ, zero_smul, add_zero] using (hApic (0, y) hyV).2 e\n · intro z hz\n refine ⟨(hApic z (hrect z hz).1).1 e, ?_⟩\n have hz' := hrect z hz\n have hd := ((hβ z.2 hz'.2.2.2.2.1).2 z.1\n (Set.Ioo_subset_Icc_self hz'.2.2.2.2.2)).hasDerivAt\n (Icc_mem_nhds hz'.2.2.2.2.2.1 hz'.2.2.2.2.2.2)\n rw [← heq z hz] at hd\n apply hd.congr_of_eventuallyEq\n filter_upwards [Ioo_mem_nhds hz.1.1 hz.1.2] with t ht\n exact heq (t, z.2) ⟨ht, hz.2⟩\ntheorem exists_smooth_coordinate_spray_flow_checked :\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n (U : Set E), IsOpen U → ∀ (Γ : E → E →L[ℝ] E →L[ℝ] E),\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Γ U → ∀ x ∈ U,\n ∃ W : Set (E × E), IsOpen W ∧ (x, 0) ∈ W ∧ ∃ ε > (0 : ℝ),\n ∃ Φ : (E × E) × ℝ → E × E,\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Φ (W ×ˢ Set.Ioo (-ε) ε) ∧\n (∀ z ∈ W, Φ (z, 0) = z) ∧\n (∀ z ∈ W, ∀ t ∈ Set.Ioo (-ε) ε, (Φ (z, t)).1 ∈ U) ∧\n (∀ z ∈ W, ∀ t ∈ Set.Ioo (-ε) ε,\n HasDerivAt (fun s => Φ (z, s))\n ((Φ (z, t)).2, -(Γ (Φ (z, t)).1 (Φ (z, t)).2 (Φ (z, t)).2)) t) := by\n intro E _ _ _ U hU Γ hΓ x hx\n obtain ⟨r, hr, ε, hε, Ψ, hΨ, hΨ0, hΨode⟩ :=\n exists_smooth_local_ode_flow (U ×ˢ Set.univ) (hU.prod isOpen_univ)\n (fun z : E × E => (z.2, -(Γ z.1 z.2 z.2)))\n (contDiffOn_coordinate_spray hΓ) (x, 0) ⟨hx, Set.mem_univ _⟩\n refine ⟨Metric.ball (x, 0) r, Metric.isOpen_ball, Metric.mem_ball_self hr,\n ε, hε, (fun z => Ψ (z.2, z.1)), ?_, ?_, ?_, ?_⟩\n · exact hΨ.comp (contDiffOn_snd.prodMk contDiffOn_fst)\n (fun z hz => ⟨hz.2, hz.1⟩)\n · exact hΨ0\n · intro z hz t ht\n exact (hΨode (t, z) ⟨ht, hz⟩).1.1\n · intro z hz t ht\n exact (hΨode (t, z) ⟨ht, hz⟩).2\ntheorem norm_mfderivWithin_inverse_chart_curve : open scoped Bundle in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M] [IsManifold I 1 M]\n [Bundle.RiemannianBundle (fun z : M => TangentSpace I z)]\n (p : M) (g : E → E →L[ℝ] E →L[ℝ] ℝ),\n (∀ z ∈ (extChartAt I p).target, ∀ w : E,\n g z w w = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z w‖ ^ 2) →\n ∀ (x : ℝ → E) (S : Set ℝ) (t : ℝ) (v : E),\n Set.MapsTo x S (extChartAt I p).target → t ∈ S → UniqueDiffWithinAt ℝ S t →\n HasDerivWithinAt x v S t →\n ‖mfderivWithin (modelWithCornersSelf ℝ ℝ) I\n ((extChartAt I p).symm ∘ x) S t 1‖ = Real.sqrt (g (x t) v v) := by\n intro E _ _ H _ I M _ _ _ _ p g hg x S t v hx ht hS hderiv\n have hcomp : mfderivWithin (modelWithCornersSelf ℝ ℝ) I\n ((extChartAt I p).symm ∘ x) S t =\n (mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) (x t)).comp\n (mfderivWithin (modelWithCornersSelf ℝ ℝ) (modelWithCornersSelf ℝ E) x S t) := by\n apply mfderivWithin_comp\n · exact mdifferentiableWithinAt_extChartAt_symm (hx ht)\n · exact hderiv.differentiableWithinAt.mdifferentiableWithinAt\n · exact fun s hs => extChartAt_target_subset_range p (hx hs)\n · rwa [uniqueMDiffWithinAt_iff_uniqueDiffWithinAt]\n have hxv : mfderivWithin (modelWithCornersSelf ℝ ℝ) (modelWithCornersSelf ℝ E)\n x S t 1 = v := by\n rw [mfderivWithin_eq_fderivWithin]\n change fderivWithin ℝ x S t 1 = v\n rw [hderiv.hasFDerivWithinAt.fderivWithin hS]\n simp\n rw [hcomp, ContinuousLinearMap.comp_apply, hxv, hg (x t) (hx ht) v]\n exact (open scoped Bundle in\n (Real.sqrt_sq (norm_nonneg (mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) (x t) v))).symm)\ntheorem pathELength_inverse_chart_eq_of_constant_energy : open scoped Bundle in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M] [IsManifold I 1 M]\n [Bundle.RiemannianBundle (fun z : M => TangentSpace I z)]\n (p : M) (g : E → E →L[ℝ] E →L[ℝ] ℝ),\n (∀ z ∈ (extChartAt I p).target, ∀ w : E,\n g z w w = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z w‖ ^ 2) →\n ∀ (x v : ℝ → E) (a b k : ℝ), a ≤ b → 0 ≤ k →\n Set.MapsTo x (Set.Icc a b) (extChartAt I p).target →\n (∀ t ∈ Set.Icc a b, HasDerivWithinAt x (v t) (Set.Icc a b) t) →\n (∀ t ∈ Set.Icc a b, g (x t) (v t) (v t) = k ^ 2) →\n Manifold.pathELength I ((extChartAt I p).symm ∘ x) a b =\n ENNReal.ofReal ((b - a) * k) := by\n intro E _ _ H _ I M _ _ _ _ p g hg x v a b k hab hk hx hderiv henergy\n letI (z : M) : NormedAddCommGroup (TangentSpace I z) :=\n (open scoped Bundle in inferInstance)\n exact (open scoped Bundle in by\n rcases eq_or_lt_of_le hab with rfl | hab'\n · simp\n have hspeed (t : ℝ) (ht : t ∈ Set.Icc a b) :\n ‖mfderivWithin (modelWithCornersSelf ℝ ℝ) I\n ((extChartAt I p).symm ∘ x) (Set.Icc a b) t 1‖ = k := by\n rw [norm_mfderivWithin_inverse_chart_curve I p g hg x (Set.Icc a b) t (v t)\n hx ht (uniqueDiffOn_Icc hab' t ht) (hderiv t ht), henergy t ht,\n Real.sqrt_sq hk]\n rw [Manifold.pathELength_eq_lintegral_mfderivWithin_Icc]\n calc\n (∫⁻ t in Set.Icc a b, ‖mfderivWithin (modelWithCornersSelf ℝ ℝ) I\n ((extChartAt I p).symm ∘ x) (Set.Icc a b) t 1‖ₑ) =\n ∫⁻ _t in Set.Icc a b, ENNReal.ofReal k := by\n apply MeasureTheory.setLIntegral_congr_fun measurableSet_Icc\n intro t ht\n exact (ofReal_norm (mfderivWithin (modelWithCornersSelf ℝ ℝ) I\n ((extChartAt I p).symm ∘ x) (Set.Icc a b) t 1)).symm.trans\n (congrArg ENNReal.ofReal (hspeed t ht))\n _ = ENNReal.ofReal ((b - a) * k) := by\n simp only [MeasureTheory.lintegral_const, MeasureTheory.Measure.restrict_apply_univ,\n Real.volume_Icc, ← ENNReal.ofReal_mul hk, mul_comm k])\ntheorem riemannianEDist_inverse_chart_le_of_constant_energy : open scoped Bundle in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M] [IsManifold I 1 M]\n [Bundle.RiemannianBundle (fun z : M => TangentSpace I z)]\n (p : M) (g : E → E →L[ℝ] E →L[ℝ] ℝ),\n (∀ z ∈ (extChartAt I p).target, ∀ w : E,\n g z w w = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z w‖ ^ 2) →\n ∀ (x v : ℝ → E) (a b k : ℝ), a ≤ b → 0 ≤ k →\n Set.MapsTo x (Set.Icc a b) (extChartAt I p).target →\n ContDiffOn ℝ 1 x (Set.Icc a b) →\n (∀ t ∈ Set.Icc a b, HasDerivWithinAt x (v t) (Set.Icc a b) t) →\n (∀ t ∈ Set.Icc a b, g (x t) (v t) (v t) = k ^ 2) →\n Manifold.riemannianEDist I ((extChartAt I p).symm (x a))\n ((extChartAt I p).symm (x b)) ≤ ENNReal.ofReal ((b - a) * k) := by\n intro E _ _ H _ I M _ _ _ _ p g hg x v a b k hab hk hx hCx hderiv henergy\n letI (z : M) : NormedAddCommGroup (TangentSpace I z) :=\n (open scoped Bundle in inferInstance)\n have hpath : ContMDiffOn (modelWithCornersSelf ℝ ℝ) I 1\n ((extChartAt I p).symm ∘ x) (Set.Icc a b) :=\n (contMDiffOn_extChartAt_symm p).comp (contMDiffOn_iff_contDiffOn.mpr hCx) hx\n letI (z : M) : InnerProductSpace ℝ (TangentSpace I z) :=\n (open scoped Bundle in inferInstance)\n exact (Manifold.riemannianEDist_le_pathELength hpath rfl rfl hab).trans_eq\n (pathELength_inverse_chart_eq_of_constant_energy I p g hg x v a b k hab hk hx\n hderiv henergy)\ntheorem sqrt_coordinate_metric_chart_derivative_eq_norm : open scoped Bundle in\n ∀ {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] {I : ModelWithCorners ℝ E H}\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M] [IsManifold I 1 M]\n [Bundle.RiemannianBundle (fun x : M => TangentSpace I x)]\n (p : M) (g : E → E →L[ℝ] E →L[ℝ] ℝ),\n (∀ z ∈ (extChartAt I p).target, ∀ w : E,\n g z w w = ‖mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) z w‖ ^ 2) →\n ∀ (x : M), x ∈ (extChartAt I p).source → ∀ v : TangentSpace I x,\n Real.sqrt (g (extChartAt I p x)\n (mfderiv I (modelWithCornersSelf ℝ E) (extChartAt I p) x v)\n (mfderiv I (modelWithCornersSelf ℝ E) (extChartAt I p) x v)) = ‖v‖ := by\n intro E _ _ H _ I M _ _ _ _ p g hg x hx v\n exact (open scoped Bundle in by\n letI : (y : M) → NormedAddCommGroup (TangentSpace I y) := fun y =>\n Bundle.instNormedAddCommGroupOfRiemannianBundleOfIsTopologicalAddGroupOfContinuousConstSMulReal\n (E := fun x : M => TangentSpace I x) y\n have hquad := hg (extChartAt I p x) ((extChartAt I p).map_source hx)\n (mfderiv I (modelWithCornersSelf ℝ E) (extChartAt I p) x v)\n have hinv : mfderivWithin (modelWithCornersSelf ℝ E) I\n (extChartAt I p).symm (Set.range I) (extChartAt I p x)\n (mfderiv I (modelWithCornersSelf ℝ E) (extChartAt I p) x v) = v :=\n congrArg (fun A => A v)\n (mfderivWithin_extChartAt_symm_comp_mfderiv_extChartAt' (I := I) hx)\n rw [hinv, (extChartAt I p).left_inv hx] at hquad\n rw [hquad, Real.sqrt_sq (norm_nonneg v)])\ntheorem enorm_sub_le_pathELength_of_scalar_bound\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M]\n [∀ x : M, ENorm (TangentSpace I x)]\n (U : Set M) (hU : IsOpen U) (ρ : M → ℝ)\n (hρ : ContMDiffOn I (modelWithCornersSelf ℝ ℝ) 1 ρ U)\n (hbound : ∀ x ∈ U, ∀ v : TangentSpace I x,\n @enorm ℝ _ (mfderiv I (modelWithCornersSelf ℝ ℝ) ρ x v) ≤ enorm v)\n (γ : ℝ → M) (a b : ℝ) (hab : a ≤ b)\n (hγ : ContMDiffOn (modelWithCornersSelf ℝ ℝ) I 1 γ (Set.Icc a b))\n (hγU : Set.MapsTo γ (Set.Icc a b) U) :\n enorm (ρ (γ b) - ρ (γ a)) ≤ Manifold.pathELength I γ a b := by\n exact (open scoped ENNReal in by\n rcases hab.eq_or_lt with rfl | hab\n · simp\n have hcomp : ContDiffOn ℝ 1 (ρ ∘ γ) (Set.Icc a b) :=\n contMDiffOn_iff_contDiffOn.mp (hρ.comp hγ hγU)\n calc\n ‖ρ (γ b) - ρ (γ a)‖ₑ ≤\n ∫⁻ t in Set.Icc a b, ‖derivWithin (ρ ∘ γ) (Set.Icc a b) t‖ₑ :=\n enorm_sub_le_lintegral_derivWithin_Icc_of_contDiffOn_Icc hcomp hab.le\n _ = ∫⁻ t in Set.Icc a b,\n @enorm ℝ _ (mfderivWithin (modelWithCornersSelf ℝ ℝ) (modelWithCornersSelf ℝ ℝ)\n (ρ ∘ γ) (Set.Icc a b) t 1) := by\n simp_rw [← fderivWithin_derivWithin, mfderivWithin_eq_fderivWithin]\n rfl\n _ ≤ ∫⁻ t in Set.Icc a b,\n ‖mfderivWithin (modelWithCornersSelf ℝ ℝ) I γ (Set.Icc a b) t 1‖ₑ := by\n apply MeasureTheory.setLIntegral_mono' measurableSet_Icc\n intro t ht\n have hdρ : MDifferentiableAt I (modelWithCornersSelf ℝ ℝ) ρ (γ t) :=\n ((hρ (γ t) (hγU ht)).mdifferentiableWithinAt one_ne_zero).mdifferentiableAt\n (hU.mem_nhds (hγU ht))\n have heq := mfderiv_comp_mfderivWithin t\n hdρ ((hγ t ht).mdifferentiableWithinAt one_ne_zero)\n (show UniqueMDiffWithinAt (modelWithCornersSelf ℝ ℝ) (Set.Icc a b) t from\n uniqueMDiffWithinAt_iff_uniqueDiffWithinAt.mpr (uniqueDiffOn_Icc hab t ht))\n rw [heq, ContinuousLinearMap.comp_apply]\n exact hbound (γ t) (hγU ht) _\n _ = Manifold.pathELength I γ a b :=\n Manifold.pathELength_eq_lintegral_mfderivWithin_Icc.symm)\ntheorem enorm_sub_le_pathELength_of_coordinate_bound\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M]\n [∀ x : M, ENorm (TangentSpace I x)]\n {F : Type*} [NormedAddCommGroup F] [NormedSpace ℝ F]\n (U : Set M) (hU : IsOpen U) (V : Set F) (hV : IsOpen V)\n (c : M → F) (hc : ContMDiffOn I (modelWithCornersSelf ℝ F) 1 c U)\n (hcV : Set.MapsTo c U V) (f : F → ℝ) (hf : ContDiffOn ℝ 1 f V)\n (hbound : ∀ x ∈ U, ∀ v : TangentSpace I x,\n enorm (fderiv ℝ f (c x) (mfderiv I (modelWithCornersSelf ℝ F) c x v)) ≤ enorm v)\n (γ : ℝ → M) (a b : ℝ) (hab : a ≤ b)\n (hγ : ContMDiffOn (modelWithCornersSelf ℝ ℝ) I 1 γ (Set.Icc a b))\n (hγU : Set.MapsTo γ (Set.Icc a b) U) :\n enorm (f (c (γ b)) - f (c (γ a))) ≤ Manifold.pathELength I γ a b := by\n have hfM : ContMDiffOn (modelWithCornersSelf ℝ F) (modelWithCornersSelf ℝ ℝ) 1 f V :=\n contMDiffOn_iff_contDiffOn.mpr hf\n apply enorm_sub_le_pathELength_of_scalar_bound I U hU (f ∘ c)\n (hfM.comp hc hcV) ?_ γ a b hab hγ hγU\n intro x hx v\n have hc' := ((hc x hx).mdifferentiableWithinAt one_ne_zero).mdifferentiableAt\n (hU.mem_nhds hx)\n have hf' := ((hfM (c x) (hcV hx)).mdifferentiableWithinAt one_ne_zero).mdifferentiableAt\n (hV.mem_nhds (hcV hx))\n rw [mfderiv_comp x hf' hc', ContinuousLinearMap.comp_apply, mfderiv_eq_fderiv]\n exact hbound x hx v\ntheorem exists_first_exit_of_continuousOn\n {M : Type*} [TopologicalSpace M] (U : Set M) (hU : IsOpen U)\n (γ : ℝ → M) (a b : ℝ) (hab : a ≤ b)\n (hγ : ContinuousOn γ (Set.Icc a b)) (ha : γ a ∈ U) (hb : γ b ∉ U) :\n ∃ t ∈ Set.Ioc a b, γ t ∈ frontier U ∧ Set.MapsTo γ (Set.Ico a t) U := by\n let K : Set ℝ := Set.Icc a b ∩ γ ⁻¹' Uᶜ\n have hK : IsCompact K := isCompact_Icc.of_isClosed_subset\n (hγ.preimage_isClosed_of_isClosed isClosed_Icc hU.isClosed_compl)\n Set.inter_subset_left\n have hbK : b ∈ K := ⟨⟨hab, le_rfl⟩, hb⟩\n obtain ⟨t, ht, hmin⟩ := hK.exists_isLeast ⟨b, hbK⟩\n have hat : a < t := lt_of_le_of_ne ht.1.1 (by\n intro heq\n exact ht.2 (heq ▸ ha))\n have hpre : Set.MapsTo γ (Set.Ico a t) U := by\n intro s hs\n by_contra hsu\n have hsK : s ∈ K := ⟨⟨hs.1, hs.2.le.trans ht.1.2⟩, hsu⟩\n exact (not_le_of_gt hs.2) (hmin hsK)\n have hclosure : γ t ∈ closure U := by\n apply ((hγ t ht.1).mono (show Set.Ico a t ⊆ Set.Icc a b from\n fun s hs => ⟨hs.1, hs.2.le.trans ht.1.2⟩)).mem_closure ?_ hpre\n rw [closure_Ico hat.ne]\n exact ⟨hat.le, le_rfl⟩\n refine ⟨t, ⟨hat, ht.1.2⟩, ?_, hpre⟩\n rw [frontier, hU.interior_eq]\n exact ⟨hclosure, ht.2⟩\ntheorem exists_pos_mul_norm_sq_le_bilinear\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n (B : E →L[ℝ] E →L[ℝ] ℝ) (hpos : ∀ v : E, v ≠ 0 → 0 < B v v) :\n ∃ m : ℝ, 0 < m ∧ ∀ v : E, m * ‖v‖ ^ 2 ≤ B v v := by\n have hq : Continuous (fun v : E => B v v) := B.continuous.clm_apply continuous_id\n obtain ⟨m, hm, hmin⟩ := (isCompact_sphere (0 : E) 1).exists_forall_le'\n hq.continuousOn (a := 0) (by\n intro v hv\n apply hpos v\n intro hv₀\n simp [hv₀] at hv)\n refine ⟨m, hm, fun v => ?_⟩\n by_cases hv : v = 0\n · simp [hv]\n have hn : 0 < ‖v‖ := norm_pos_iff.mpr hv\n have hunit : ‖v‖⁻¹ • v ∈ Metric.sphere (0 : E) 1 := by\n simp only [Metric.mem_sphere, dist_zero_right, norm_smul, Real.norm_eq_abs,\n abs_of_pos (inv_pos.mpr hn), inv_mul_cancel₀ hn.ne']\n calc\n m * ‖v‖ ^ 2 = ‖v‖ ^ 2 * m := mul_comm _ _\n _ ≤ ‖v‖ ^ 2 * B (‖v‖⁻¹ • v) (‖v‖⁻¹ • v) :=\n mul_le_mul_of_nonneg_left (hmin _ hunit) (sq_nonneg _)\n _ = B v v := by\n simp only [map_smul, smul_apply, smul_eq_mul]\n field_simp\ntheorem isCompact_bilinear_radius_sublevel\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n (B : E →L[ℝ] E →L[ℝ] ℝ) (hpos : ∀ v : E, v ≠ 0 → 0 < B v v)\n (c : ℝ) : IsCompact {v : E | Real.sqrt (B v v) ≤ c} := by\n have hq : Continuous (fun v : E => B v v) := B.continuous.clm_apply continuous_id\n have hclosed : IsClosed {v : E | Real.sqrt (B v v) ≤ c} :=\n isClosed_le hq.sqrt continuous_const\n obtain ⟨m, hm, hbound⟩ := exists_pos_mul_norm_sq_le_bilinear B hpos\n apply (isCompact_closedBall (0 : E) (1 + c ^ 2 / m)).of_isClosed_subset hclosed\n intro v hv\n change Real.sqrt (B v v) ≤ c at hv\n have hqnonneg : 0 ≤ B v v := by\n by_cases hv₀ : v = 0\n · simp [hv₀]\n · exact (hpos v hv₀).le\n have hsqrt : 0 ≤ Real.sqrt (B v v) := Real.sqrt_nonneg _\n have hsq : B v v ≤ c ^ 2 := by\n nlinarith [Real.sq_sqrt hqnonneg, mul_self_le_mul_self hsqrt hv]\n have hnorm : ‖v‖ ^ 2 ≤ c ^ 2 / m := by\n apply (le_div_iff₀ hm).mpr\n nlinarith [hbound v]\n rw [Metric.mem_closedBall, dist_zero_right]\n nlinarith [sq_nonneg (‖v‖ - 1 / 2)]\ntheorem exists_inner_radius_neighborhood\n {X Y : Type*} [TopologicalSpace X] [TopologicalSpace Y] [T2Space Y]\n (e : OpenPartialHomeomorph X Y) (x₀ : X) (hx₀ : x₀ ∈ e.source)\n (r : X → ℝ) (hr : Continuous r) (hr₀ : r x₀ = 0)\n (hrpos : ∀ x, x ≠ x₀ → 0 < r x)\n (hrcompact : IsCompact {x | r x ≤ 1})\n (W : Set Y) (hW : IsOpen W) (hxW : e x₀ ∈ W) :\n ∃ c : ℝ, 0 < c ∧ ∃ V : Set Y, IsOpen V ∧ e x₀ ∈ V ∧\n closure V ⊆ W ∧ closure V ⊆ e.target ∧\n (∀ y ∈ frontier V, r (e.symm y) = c) ∧\n (∀ y ∈ V, r (e.symm y) < c) := by\n let U : Set X := e.source ∩ e ⁻¹' W\n have hU : IsOpen U := e.isOpen_inter_preimage hW\n have hxU : x₀ ∈ U := ⟨hx₀, hxW⟩\n have hK : IsCompact ({x | r x ≤ 1} ∩ Uᶜ) :=\n hrcompact.inter_right hU.isClosed_compl\n obtain ⟨d, hd, hdle⟩ := hK.exists_forall_le' hr.continuousOn\n (a := 0) (fun x hx => hrpos x (fun heq => hx.2 (heq ▸ hxU)))\n let c : ℝ := min 1 d / 2\n have hc : 0 < c := half_pos (lt_min zero_lt_one hd)\n have hc₁ : c < 1 := by dsimp [c]; linarith [min_le_left (1 : ℝ) d]\n have hcd : c < d := by dsimp [c]; linarith [min_le_right (1 : ℝ) d]\n have hsub : {x | r x ≤ c} ⊆ U := by\n intro x hx\n by_contra hxu\n have := hdle x ⟨hx.trans hc₁.le, hxu⟩\n exact (not_le_of_gt hcd) (this.trans hx)\n have hsource : {x | r x ≤ c} ⊆ e.source := fun x hx => (hsub hx).1\n have hcompact : IsCompact {x | r x ≤ c} :=\n hrcompact.of_isClosed_subset (isClosed_le hr continuous_const)\n (fun x hx => hx.trans hc₁.le)\n have himage : IsCompact (e '' {x | r x ≤ c}) :=\n hcompact.image_of_continuousOn (e.continuousOn.mono hsource)\n let V : Set Y := e '' {x | r x < c}\n have hV : IsOpen V := e.isOpen_image_of_subset_source\n (isOpen_lt hr continuous_const) (fun x (hx : r x < c) => hsource hx.le)\n have hclosure : closure V ⊆ e '' {x | r x ≤ c} :=\n closure_minimal (Set.image_mono (fun x (hx : r x < c) => hx.le)) himage.isClosed\n have hrad (y : Y) (hy : y ∈ V) : r (e.symm y) < c := by\n obtain ⟨x, hx, rfl⟩ := hy\n change r x < c at hx\n simpa only [e.left_inv (hsource hx.le)] using hx\n refine ⟨c, hc, V, hV, ⟨x₀, ?_, rfl⟩, ?_, ?_, ?_, hrad⟩\n · change r x₀ < c\n simpa only [hr₀] using hc\n · intro y hy\n obtain ⟨x, hx, rfl⟩ := hclosure hy\n exact (hsub hx).2\n · intro y hy\n obtain ⟨x, hx, rfl⟩ := hclosure hy\n exact e.map_source (hsource hx)\n · intro y hy\n obtain ⟨x, hx, hxy⟩ := hclosure hy.1\n have hle : r (e.symm y) ≤ c := by\n rw [← hxy, e.left_inv (hsource hx)]\n exact hx\n apply le_antisymm hle\n by_contra hge\n have hlt : r (e.symm y) < c := lt_of_not_ge hge\n have hyV : y ∈ V := ⟨e.symm y, hlt,\n e.right_inv (hxy ▸ e.map_source (hsource hx))⟩\n exact hy.2 (by simpa only [hV.interior_eq] using hyV)\ntheorem exists_inner_bilinear_radius_neighborhood\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {Y : Type*} [TopologicalSpace Y] [T2Space Y]\n (B : E →L[ℝ] E →L[ℝ] ℝ) (hpos : ∀ v : E, v ≠ 0 → 0 < B v v)\n (e : OpenPartialHomeomorph E Y) (h₀ : (0 : E) ∈ e.source)\n (W : Set Y) (hW : IsOpen W) (hW₀ : e 0 ∈ W) :\n ∃ c : ℝ, 0 < c ∧ ∃ V : Set Y, IsOpen V ∧ e 0 ∈ V ∧\n closure V ⊆ W ∧ closure V ⊆ e.target ∧\n (∀ y ∈ frontier V, Real.sqrt (B (e.symm y) (e.symm y)) = c) ∧\n (∀ y ∈ V, Real.sqrt (B (e.symm y) (e.symm y)) < c) := by\n exact exists_inner_radius_neighborhood e 0 h₀ (fun v => Real.sqrt (B v v))\n (B.continuous.clm_apply continuous_id).sqrt (by simp)\n (fun v hv => Real.sqrt_pos.mpr (hpos v hv))\n (isCompact_bilinear_radius_sublevel B hpos 1) W hW hW₀\ntheorem ofReal_radius_le_riemannianEDist_of_first_exit\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {H : Type*} [TopologicalSpace H] (I : ModelWithCorners ℝ E H)\n {M : Type*} [TopologicalSpace M] [ChartedSpace H M]\n [∀ x : M, ENorm (TangentSpace I x)]\n [∀ x : M, ENormSMulClass ℝ (TangentSpace I x)]\n (W V : Set M) (hV : IsOpen V) (hVW : closure V ⊆ W)\n (ρ : M → ℝ) (p q : M) (c : ℝ)\n (hp : p ∈ V) (hρp : ρ p = 0) (hρq : 0 ≤ ρ q) (hqc : ρ q ≤ c)\n (hfront : ∀ x ∈ frontier V, ρ x = c)\n (hbound : ∀ (γ : ℝ → M) (a b : ℝ), a ≤ b →\n ContMDiffOn (modelWithCornersSelf ℝ ℝ) I 1 γ (Set.Icc a b) →\n Set.MapsTo γ (Set.Icc a b) W →\n enorm (ρ (γ b) - ρ (γ a)) ≤ Manifold.pathELength I γ a b) :\n ENNReal.ofReal (ρ q) ≤ Manifold.riemannianEDist I p q := by\n by_contra h\n obtain ⟨γ,hγ0,hγ1,hγ,hlen⟩ :=\n Manifold.exists_lt_of_riemannianEDist_lt (lt_of_not_ge h)\n have hpath : ENNReal.ofReal (ρ q) ≤ Manifold.pathELength I γ 0 1 := by\n by_cases hstay : Set.MapsTo γ (Set.Icc (0:ℝ) 1) V\n · have hb := hbound γ 0 1 zero_le_one hγ\n (fun t ht => hVW (subset_closure (hstay ht)))\n simpa only [hγ0,hγ1,hρp,sub_zero,Real.enorm_eq_ofReal hρq] using hb\n · obtain ⟨t,ht,htV⟩ : ∃ t ∈ Set.Icc (0:ℝ) 1, γ t ∉ V := by\n simpa only [Set.MapsTo,not_forall,exists_prop] using hstay\n obtain ⟨s,hs,hsV,hpre⟩ := exists_first_exit_of_continuousOn V hV γ 0 t ht.1\n (hγ.continuousOn.mono (Set.Icc_subset_Icc le_rfl ht.2))\n (hγ0.symm ▸ hp) htV\n have hs1 : s ≤ 1 := hs.2.trans ht.2\n have hmap : Set.MapsTo γ (Set.Icc 0 s) W := by\n intro u hu\n apply hVW\n rcases hu.2.eq_or_lt with hus | hus\n · simpa only [hus] using frontier_subset_closure hsV\n · exact subset_closure (hpre ⟨hu.1,hus⟩)\n have hb := hbound γ 0 s hs.1.le\n (hγ.mono (Set.Icc_subset_Icc le_rfl hs1)) hmap\n have hc : 0 ≤ c := hρq.trans hqc\n have hb' : ENNReal.ofReal c ≤ Manifold.pathELength I γ 0 s := by\n simpa only [hfront _ hsV,hγ0,hρp,sub_zero,Real.enorm_eq_ofReal hc] using hb\n exact (ENNReal.ofReal_le_ofReal hqc).trans\n (hb'.trans (Manifold.pathELength_mono le_rfl hs1))\n exact (not_lt_of_ge hpath) hlen\ntheorem eq_const_of_lipschitz_ode\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {F : E → E} {T : Set E} {K : NNReal} {p : E} {a b : ℝ}\n (hF : LipschitzOnWith K F T) (hp : p ∈ T) (hFp : F p = 0)\n (h0 : (0 : ℝ) ∈ Set.Ioo a b) {X : ℝ → E}\n (hX : ∀ t ∈ Set.Ioo a b, HasDerivAt X (F (X t)) t ∧ X t ∈ T)\n (hX0 : X 0 = p) : ∀ t ∈ Set.Ioo a b, X t = p := by\n exact ODE_solution_unique_of_mem_Ioo (v := fun _ => F) (s := fun _ => T)\n (g := fun _ => p) (fun _ _ => hF) h0 hX\n (fun t _ => ⟨by simpa only [hFp] using hasDerivAt_const t p, hp⟩) hX0\ntheorem exists_coordinate_spray_flow_in_lipschitz_ball\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {U : Set E} (hU : IsOpen U) {Γ : E → E →L[ℝ] E →L[ℝ] E}\n (hΓ : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Γ U)\n {p : E} (hp : p ∈ U) :\n ∃ R > (0 : ℝ), ∃ K : NNReal,\n LipschitzOnWith K (fun z : E × E => (z.2, -(Γ z.1 z.2 z.2)))\n (Metric.ball (p,0) R) ∧\n (∀ z : E × E, z ∈ Metric.ball (p,0) R → z.1 ∈ U) ∧\n ∃ r > (0 : ℝ), ∃ ε > (0 : ℝ), ∃ Φ : ℝ × (E × E) → E × E,\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Φ\n (Set.Ioo (-ε) ε ×ˢ Metric.ball (p,0) r) ∧\n (∀ z ∈ Metric.ball (p,0) r, Φ (0,z) = z) ∧\n (∀ z ∈ Set.Ioo (-ε) ε ×ˢ Metric.ball (p,0) r,\n Φ z ∈ Metric.ball (p,0) R ∧\n HasDerivAt (fun t : ℝ => Φ (t,z.2))\n ((Φ z).2, -(Γ (Φ z).1 (Φ z).2 (Φ z).2)) z.1) ∧\n ∀ t ∈ Set.Ioo (-ε) ε, Φ (t,(p,0)) = (p,0) := by\n let F : E × E → E × E := fun z => (z.2, -(Γ z.1 z.2 z.2))\n have hF : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) F (U ×ˢ Set.univ) :=\n contDiffOn_coordinate_spray hΓ\n have hF1 : ContDiffAt ℝ 1 F (p,0) :=\n (hF.contDiffAt ((hU.prod isOpen_univ).mem_nhds ⟨hp,Set.mem_univ _⟩)).of_le\n (by simp)\n obtain ⟨K,W₀,hW₀,hKF⟩ := hF1.exists_lipschitzOnWith\n obtain ⟨R,hR,hsub⟩ := Metric.mem_nhds_iff.mp\n (Filter.inter_mem hW₀ ((hU.prod isOpen_univ).mem_nhds ⟨hp,Set.mem_univ _⟩))\n have hLip : LipschitzOnWith K F (Metric.ball (p,0) R) :=\n hKF.mono (fun z hz => (hsub hz).1)\n have hdom : Metric.ball (p,(0:E)) R ⊆ U ×ˢ (Set.univ : Set E) :=\n fun z hz => (hsub hz).2\n obtain ⟨W,hW,hpW,ε,hε,Ψ,hΨ,hΨ0,hΨU,hΨode⟩ :=\n exists_smooth_coordinate_spray_flow_checked U hU Γ hΓ p hp\n have hzero : (0 : ℝ) ∈ Set.Ioo (-ε) ε := ⟨by linarith,hε⟩\n have hΨc : ContinuousAt Ψ ((p,0),0) :=\n (hΨ.contDiffAt ((hW.prod isOpen_Ioo).mem_nhds ⟨hpW,hzero⟩)).continuousAt\n obtain ⟨δ,hδ,hδsub⟩ := Metric.mem_nhds_iff.mp\n (hΨc (Metric.isOpen_ball.mem_nhds (by rw [hΨ0 _ hpW]; exact Metric.mem_ball_self hR)))\n obtain ⟨r₀,hr₀,hr₀sub⟩ := Metric.mem_nhds_iff.mp (hW.mem_nhds hpW)\n let r := min r₀ δ\n let ε' := min ε δ\n have hr : 0 < r := lt_min hr₀ hδ\n have hε' : 0 < ε' := lt_min hε hδ\n have hrW : Metric.ball (p,(0:E)) r ⊆ W := by\n intro z hz\n exact hr₀sub (Metric.ball_subset_ball (min_le_left _ _) hz)\n have hεtime : Set.Ioo (-ε') ε' ⊆ Set.Ioo (-ε) ε := by\n intro t ht\n exact ⟨lt_of_le_of_lt (neg_le_neg (min_le_left ε δ)) ht.1,\n lt_of_lt_of_le ht.2 (min_le_left ε δ)⟩\n let Φ : ℝ × (E × E) → E × E := fun z => Ψ (z.2,z.1)\n have hΦ : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Φ\n (Set.Ioo (-ε') ε' ×ˢ Metric.ball (p,0) r) :=\n hΨ.comp (contDiffOn_snd.prodMk contDiffOn_fst)\n (fun z hz => ⟨hrW hz.2,hεtime hz.1⟩)\n have hΦ0 : ∀ z ∈ Metric.ball (p,0) r, Φ (0,z) = z :=\n fun z hz => hΨ0 z (hrW hz)\n have hΦF : ∀ z ∈ Set.Ioo (-ε') ε' ×ˢ Metric.ball (p,0) r,\n Φ z ∈ Metric.ball (p,0) R ∧\n HasDerivAt (fun t : ℝ => Φ (t,z.2))\n ((Φ z).2, -(Γ (Φ z).1 (Φ z).2 (Φ z).2)) z.1 := by\n intro z hz\n refine ⟨hδsub ?_,hΨode z.2 (hrW hz.2) z.1 (hεtime hz.1)⟩\n rw [Metric.mem_ball,Prod.dist_eq,max_lt_iff]\n exact ⟨lt_of_lt_of_le (Metric.mem_ball.mp hz.2) (min_le_right _ _),\n by simpa only [Real.dist_eq,sub_zero] using\n lt_of_lt_of_le (abs_lt.mpr hz.1) (min_le_right ε δ)⟩\n refine ⟨R,hR,K,hLip,(fun z hz => (hdom hz).1),r,hr,ε',hε',Φ,hΦ,hΦ0,hΦF,?_⟩\n apply eq_const_of_lipschitz_ode hLip (Metric.mem_ball_self hR)\n (show F (p,0) = 0 by simp [F])\n (show (0:ℝ) ∈ Set.Ioo (-ε') ε' from ⟨by linarith,hε'⟩)\n · intro t ht\n exact ⟨(hΦF (t,(p,0)) ⟨ht,Metric.mem_ball_self hr⟩).2,\n (hΦF (t,(p,0)) ⟨ht,Metric.mem_ball_self hr⟩).1⟩\n · exact hΦ0 (p,0) (Metric.mem_ball_self hr)\ntheorem coordinate_metric_compatibility\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (g : E →L[ℝ] E →L[ℝ] ℝ)\n (D : E →L[ℝ] E →L[ℝ] E →L[ℝ] ℝ)\n (Γ : E → E → E)\n (hsym : ∀ u v, g u v = g v u)\n (hDsym : ∀ u v w, D u v w = D u w v)\n (hΓ : ∀ u v w, 2 * g (Γ u v) w = D u v w + D v u w - D w u v)\n (u v w : E) :\n D u v w = g (Γ u v) w + g v (Γ u w) := by\n have h₁ := hΓ u v w\n have h₂ := hΓ u w v\n rw [hsym v (Γ u w)]\n rw [hDsym u w v] at h₂\n linarith\ntheorem fderiv_metric_symmetric\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {p : E}\n (hg : DifferentiableAt ℝ g p)\n (hsym : ∀ x u v, g x u v = g x v u) (w u v : E) :\n (fderiv ℝ g p w) u v = (fderiv ℝ g p w) v u := by\n have hu := (hg.hasFDerivAt.clm_apply (hasFDerivAt_const u p)).clm_apply\n (hasFDerivAt_const v p)\n have hv := (hg.hasFDerivAt.clm_apply (hasFDerivAt_const v p)).clm_apply\n (hasFDerivAt_const u p)\n have heq : (fun x => g x v u) =ᶠ[nhds p] (fun x => g x u v) :=\n Filter.Eventually.of_forall (fun x => hsym x v u)\n have he := (hu.congr_of_eventuallyEq heq).unique hv\n have hew := congrArg (fun A : E →L[ℝ] ℝ => A w) he\n simpa using hew\ntheorem hasDerivAt_coordinate_geodesic_pairing\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {Γ : E → E → E → E}\n {x v J : ℝ → E} {W : E} {t : ℝ}\n (hg : DifferentiableAt ℝ g (x t))\n (hsym : ∀ p u w, g p u w = g p w u)\n (hΓ : ∀ u w z, 2 * g (x t) (Γ (x t) u w) z =\n (fderiv ℝ g (x t) u) w z + (fderiv ℝ g (x t) w) u z -\n (fderiv ℝ g (x t) z) u w)\n (hx : HasDerivAt x (v t) t)\n (hv : HasDerivAt v (-Γ (x t) (v t) (v t)) t)\n (hJ : HasDerivAt J W t) :\n HasDerivAt (fun s => g (x s) (v s) (J s))\n (g (x t) (v t) (W + Γ (x t) (v t) (J t))) t := by\n have hcg : HasDerivAt (fun s => g (x s)) (fderiv ℝ g (x t) (v t)) t :=\n HasFDerivAt.comp_hasDerivAt (𝕜 := ℝ) (F := E)\n (E := E →L[ℝ] E →L[ℝ] ℝ) (l := g) (f := x) t hg.hasFDerivAt hx\n have hcgv : HasDerivAt (fun s => g (x s) (v s))\n ((fderiv ℝ g (x t) (v t)) (v t) + g (x t) (-Γ (x t) (v t) (v t))) t :=\n hcg.clm_apply hv\n have h : HasDerivAt (fun s => g (x s) (v s) (J s))\n (((fderiv ℝ g (x t) (v t)) (v t) + g (x t) (-Γ (x t) (v t) (v t))) (J t) +\n g (x t) (v t) W) t := hcgv.clm_apply hJ\n have hcompat := coordinate_metric_compatibility (g (x t)) (fderiv ℝ g (x t))\n (Γ (x t)) (hsym (x t)) (fderiv_metric_symmetric hg hsym) hΓ (v t) (v t) (J t)\n have heq :\n (((fderiv ℝ g (x t) (v t)) (v t) + g (x t) (-Γ (x t) (v t) (v t))) (J t) +\n g (x t) (v t) W) = g (x t) (v t) (W + Γ (x t) (v t) (J t)) := by\n simp only [add_apply, map_neg, map_add, neg_apply]\n linarith\n rw [heq] at h\n exact h\ntheorem hasDerivAt_coordinate_energy_variation\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {Γ : E → E → E → E}\n {x v : ℝ → E} {J W : E} {t : ℝ}\n (hg : DifferentiableAt ℝ g (x t))\n (hsym : ∀ p u w, g p u w = g p w u)\n (hΓ : ∀ u w z, 2 * g (x t) (Γ (x t) u w) z =\n (fderiv ℝ g (x t) u) w z + (fderiv ℝ g (x t) w) u z -\n (fderiv ℝ g (x t) z) u w)\n (hx : HasDerivAt x J t) (hv : HasDerivAt v W t) :\n HasDerivAt (fun s => g (x s) (v s) (v s))\n (2 * g (x t) (v t) (W + Γ (x t) (v t) J)) t := by\n have hcg : HasDerivAt (fun s => g (x s)) (fderiv ℝ g (x t) J) t :=\n HasFDerivAt.comp_hasDerivAt (𝕜 := ℝ) (F := E)\n (E := E →L[ℝ] E →L[ℝ] ℝ) (l := g) (f := x) t hg.hasFDerivAt hx\n have hcgv : HasDerivAt (fun s => g (x s) (v s))\n ((fderiv ℝ g (x t) J) (v t) + g (x t) W) t := hcg.clm_apply hv\n have h : HasDerivAt (fun s => g (x s) (v s) (v s))\n (((fderiv ℝ g (x t) J) (v t) + g (x t) W) (v t) +\n g (x t) (v t) W) t := hcgv.clm_apply hv\n have hkoszul := hΓ (v t) J (v t)\n rw [fderiv_metric_symmetric hg hsym (v t) J (v t),\n hsym (x t) (Γ (x t) (v t) J) (v t)] at hkoszul\n apply h.congr_deriv\n simp only [add_apply, map_add]\n rw [hsym (x t) W (v t)]\n linarith\ntheorem hasDerivAt_coordinate_geodesic_variation\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {Γ : E → E → E → E}\n {X V J : ℝ → ℝ → E} {W : E} {s t : ℝ}\n (hg : DifferentiableAt ℝ g (X s t))\n (hsym : ∀ p u w, g p u w = g p w u)\n (hΓ : ∀ u w z, 2 * g (X s t) (Γ (X s t) u w) z =\n (fderiv ℝ g (X s t) u) w z + (fderiv ℝ g (X s t) w) u z -\n (fderiv ℝ g (X s t) z) u w)\n (hXt : HasDerivAt (X s) (V s t) t)\n (hVt : HasDerivAt (V s) (-Γ (X s t) (V s t) (V s t)) t)\n (hJt : HasDerivAt (J s) W t)\n (hXs : HasDerivAt (fun r => X r t) (J s t) s)\n (hVs : HasDerivAt (fun r => V r t) W s) :\n HasDerivAt (fun r => g (X s r) (V s r) (J s r))\n ((1 / 2 : ℝ) * deriv (fun r => g (X r t) (V r t) (V r t)) s) t := by\n have hpair := hasDerivAt_coordinate_geodesic_pairing hg hsym hΓ hXt hVt hJt\n have henergy := hasDerivAt_coordinate_energy_variation\n (x := fun r => X r t) (v := fun r => V r t) (t := s) hg hsym hΓ hXs hVs\n rw [henergy.deriv]\n convert hpair using 1\n ring\ntheorem hasDerivAt_coordinate_mixed_fderiv\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {X : ℝ × ℝ → E} {s t : ℝ} (hX : ContDiffAt ℝ 2 X (s, t)) :\n HasDerivAt (fun r => fderiv ℝ X (s, r) (1, 0))\n (fderiv ℝ (fun p => fderiv ℝ X p (0, 1)) (s, t) (1, 0)) t := by\n have hD : DifferentiableAt ℝ (fderiv ℝ X) (s, t) :=\n (hX.fderiv_right (m := 1) (by norm_num)).differentiableAt one_ne_zero\n have ht : HasDerivAt (fun r : ℝ => (s, r)) (0, 1) t :=\n (hasDerivAt_const t s).prodMk (hasDerivAt_id t)\n have hDt : HasDerivAt (fun r => fderiv ℝ X (s, r))\n (fderiv ℝ (fderiv ℝ X) (s, t) (0, 1)) t :=\n HasFDerivAt.comp_hasDerivAt (𝕜 := ℝ) (F := ℝ × ℝ) (E := (ℝ × ℝ) →L[ℝ] E)\n (l := fderiv ℝ X) (f := fun r => (s, r)) t hD.hasFDerivAt ht\n have h := hDt.clm_apply (hasDerivAt_const t ((1, 0) : ℝ × ℝ))\n have hv := hD.hasFDerivAt.clm_apply (hasFDerivAt_const ((0, 1) : ℝ × ℝ) (s, t))\n have heq := congrArg (fun A : (ℝ × ℝ) →L[ℝ] E => A (1, 0)) hv.fderiv\n have heq' : fderiv ℝ (fun p => fderiv ℝ X p (0, 1)) (s, t) (1, 0) =\n fderiv ℝ (fderiv ℝ X) (s, t) (1, 0) (0, 1) := by simpa using heq\n apply h.congr_deriv\n simpa using ((hX.isSymmSndFDerivAt (by norm_num)).eq (0, 1) (1, 0)).trans heq'.symm\ntheorem coordinate_geodesic_variation_pairing_eq\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {Γ : E → E → E → E}\n {X V J W : ℝ → ℝ → E} {s : ℝ} {S : Set ℝ} {c : ℝ}\n (hS : IsOpen S) (hconn : IsPreconnected S) (h0 : 0 ∈ S)\n (hg : ∀ t ∈ S, DifferentiableAt ℝ g (X s t))\n (hsym : ∀ p u w, g p u w = g p w u)\n (hΓ : ∀ t ∈ S, ∀ u w z, 2 * g (X s t) (Γ (X s t) u w) z =\n (fderiv ℝ g (X s t) u) w z + (fderiv ℝ g (X s t) w) u z -\n (fderiv ℝ g (X s t) z) u w)\n (hXt : ∀ t ∈ S, HasDerivAt (X s) (V s t) t)\n (hVt : ∀ t ∈ S, HasDerivAt (V s) (-Γ (X s t) (V s t) (V s t)) t)\n (hJt : ∀ t ∈ S, HasDerivAt (J s) (W s t) t)\n (hXs : ∀ t ∈ S, HasDerivAt (fun r => X r t) (J s t) s)\n (hVs : ∀ t ∈ S, HasDerivAt (fun r => V r t) (W s t) s)\n (henergy : ∀ t ∈ S, deriv (fun r => g (X r t) (V r t) (V r t)) s = 2 * c)\n (hJ0 : J s 0 = 0) :\n ∀ t ∈ S, g (X s t) (V s t) (J s t) = t * c := by\n let f : ℝ → ℝ := fun t => g (X s t) (V s t) (J s t)\n have hf : ∀ t ∈ S, HasDerivAt f c t := by\n intro t ht\n have h := hasDerivAt_coordinate_geodesic_variation (hg t ht) hsym (hΓ t ht)\n (hXt t ht) (hVt t ht) (hJt t ht) (hXs t ht) (hVs t ht)\n rw [henergy t ht] at h\n convert h using 1\n ring\n have hlin (t : ℝ) : HasDerivAt (fun r : ℝ => r * c) c t := by\n simpa using (hasDerivAt_id t).mul_const c\n apply hS.eqOn_of_deriv_eq hconn\n (fun t ht => (hf t ht).differentiableAt.differentiableWithinAt)\n (fun t _ => (hlin t).differentiableAt.differentiableWithinAt)\n (fun t ht => (hf t ht).deriv.trans (hlin t).deriv.symm) h0\n simp [f, hJ0]\ntheorem hasDerivAt_coordinate_geodesic_energy\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {Γ : E → E → E → E}\n {x v : ℝ → E} {t : ℝ}\n (hg : DifferentiableAt ℝ g (x t))\n (hsym : ∀ p u w, g p u w = g p w u)\n (hΓ : ∀ u w z, 2 * g (x t) (Γ (x t) u w) z =\n (fderiv ℝ g (x t) u) w z + (fderiv ℝ g (x t) w) u z -\n (fderiv ℝ g (x t) z) u w)\n (hx : HasDerivAt x (v t) t)\n (hv : HasDerivAt v (-Γ (x t) (v t) (v t)) t) :\n HasDerivAt (fun r => g (x r) (v r) (v r)) 0 t := by\n simpa using hasDerivAt_coordinate_energy_variation hg hsym hΓ hx hv\ntheorem coordinate_geodesic_energy_eq\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {Γ : E → E → E → E}\n {x v : ℝ → E} {S : Set ℝ}\n (hS : IsOpen S) (hconn : IsPreconnected S)\n (hg : ∀ t ∈ S, DifferentiableAt ℝ g (x t))\n (hsym : ∀ p u w, g p u w = g p w u)\n (hΓ : ∀ t ∈ S, ∀ u w z, 2 * g (x t) (Γ (x t) u w) z =\n (fderiv ℝ g (x t) u) w z + (fderiv ℝ g (x t) w) u z -\n (fderiv ℝ g (x t) z) u w)\n (hx : ∀ t ∈ S, HasDerivAt x (v t) t)\n (hv : ∀ t ∈ S, HasDerivAt v (-Γ (x t) (v t) (v t)) t)\n {a b : ℝ} (ha : a ∈ S) (hb : b ∈ S) :\n g (x a) (v a) (v a) = g (x b) (v b) (v b) := by\n have hd (t : ℝ) (ht : t ∈ S) :=\n hasDerivAt_coordinate_geodesic_energy (hg t ht) hsym (hΓ t ht) (hx t ht) (hv t ht)\n exact hS.is_const_of_deriv_eq_zero hconn\n (fun t ht => (hd t ht).differentiableAt.differentiableWithinAt)\n (fun t ht => (hd t ht).deriv) ha hb\ntheorem hasDerivAt_coordinate_energy_of_stationary_base\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {x v : ℝ → E} {W : E} {t : ℝ}\n (hg : DifferentiableAt ℝ g (x t))\n (hsym : ∀ u w, g (x t) u w = g (x t) w u)\n (hx : HasDerivAt x 0 t) (hv : HasDerivAt v W t) :\n HasDerivAt (fun r => g (x r) (v r) (v r)) (2 * g (x t) (v t) W) t := by\n have hcg : HasDerivAt (fun r => g (x r)) (fderiv ℝ g (x t) 0) t :=\n HasFDerivAt.comp_hasDerivAt (𝕜 := ℝ) (F := E)\n (E := E →L[ℝ] E →L[ℝ] ℝ) (l := g) (f := x) t hg.hasFDerivAt hx\n have hcgv : HasDerivAt (fun r => g (x r) (v r))\n ((fderiv ℝ g (x t) 0) (v t) + g (x t) W) t := hcg.clm_apply hv\n have h := hcgv.clm_apply hv\n apply h.congr_deriv\n simp only [map_zero, zero_apply, zero_add]\n rw [hsym W (v t)]\n ring\ntheorem coordinate_gauss_radial_pairing\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {Γ : E → E → E → E}\n {X V J W : ℝ → ℝ → E} {s : ℝ} {R S : Set ℝ}\n (hR : IsOpen R) (hs : s ∈ R)\n (hS : IsOpen S) (hconn : IsPreconnected S) (h0 : 0 ∈ S)\n (hg : ∀ r ∈ R, ∀ t ∈ S, DifferentiableAt ℝ g (X r t))\n (hsym : ∀ p u w, g p u w = g p w u)\n (hΓ : ∀ r ∈ R, ∀ t ∈ S, ∀ u w z, 2 * g (X r t) (Γ (X r t) u w) z =\n (fderiv ℝ g (X r t) u) w z + (fderiv ℝ g (X r t) w) u z -\n (fderiv ℝ g (X r t) z) u w)\n (hXt : ∀ r ∈ R, ∀ t ∈ S, HasDerivAt (X r) (V r t) t)\n (hVt : ∀ r ∈ R, ∀ t ∈ S, HasDerivAt (V r) (-Γ (X r t) (V r t) (V r t)) t)\n (hJt : ∀ t ∈ S, HasDerivAt (J s) (W s t) t)\n (hXs : ∀ t ∈ S, HasDerivAt (fun r => X r t) (J s t) s)\n (hVs : ∀ t ∈ S, HasDerivAt (fun r => V r t) (W s t) s)\n (hJ0 : J s 0 = 0) :\n ∀ t ∈ S, g (X s t) (V s t) (J s t) =\n t * g (X s 0) (V s 0) (W s 0) := by\n have hE0 : HasDerivAt (fun r => g (X r 0) (V r 0) (V r 0))\n (2 * g (X s 0) (V s 0) (W s 0)) s :=\n hasDerivAt_coordinate_energy_of_stationary_base (hg s hs 0 h0) (hsym (X s 0))\n (by simpa only [hJ0] using hXs 0 h0) (hVs 0 h0)\n have henergy (t : ℝ) (ht : t ∈ S) :\n deriv (fun r => g (X r t) (V r t) (V r t)) s =\n 2 * g (X s 0) (V s 0) (W s 0) := by\n have heq : (fun r => g (X r t) (V r t) (V r t)) =ᶠ[nhds s]\n (fun r => g (X r 0) (V r 0) (V r 0)) := by\n filter_upwards [hR.mem_nhds hs] with r hr\n exact coordinate_geodesic_energy_eq hS hconn (hg r hr) hsym (hΓ r hr)\n (hXt r hr) (hVt r hr) ht h0\n exact heq.deriv_eq.trans hE0.deriv\n simpa only [mul_assoc] using coordinate_geodesic_variation_pairing_eq\n hS hconn h0 (hg s hs) hsym (hΓ s hs) (hXt s hs) (hVt s hs)\n hJt hXs hVs henergy hJ0\ntheorem hasDerivAt_coordinate_first_slice\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {f : ℝ × ℝ → E} {s t : ℝ} (hf : DifferentiableAt ℝ f (s, t)) :\n HasDerivAt (fun r => f (r, t)) (fderiv ℝ f (s, t) (1, 0)) s := by\n have hline : HasDerivAt (fun r : ℝ => (r, t)) (1, 0) s :=\n (hasDerivAt_id s).prodMk (hasDerivAt_const s t)\n simpa only [Function.comp_def] using hf.hasFDerivAt.comp_hasDerivAt s hline\ntheorem hasDerivAt_coordinate_second_slice\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {f : ℝ × ℝ → E} {s t : ℝ} (hf : DifferentiableAt ℝ f (s, t)) :\n HasDerivAt (fun r => f (s, r)) (fderiv ℝ f (s, t) (0, 1)) t := by\n have hline : HasDerivAt (fun r : ℝ => (s, r)) (0, 1) t :=\n (hasDerivAt_const t s).prodMk (hasDerivAt_id t)\n simpa only [Function.comp_def] using hf.hasFDerivAt.comp_hasDerivAt t hline\ntheorem coordinate_gauss_radial_pairing_of_contDiffOn\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {Γ : E → E → E → E}\n {X V : ℝ × ℝ → E} {R S : Set ℝ} {p v w : E}\n (hR : IsOpen R) (hS : IsOpen S) (hconn : IsPreconnected S) (h0 : 0 ∈ S)\n (hX : ContDiffOn ℝ 2 X (R ×ˢ S))\n (hV : ContDiffOn ℝ 1 V (R ×ˢ S))\n (hg : ∀ r ∈ R, ∀ t ∈ S, DifferentiableAt ℝ g (X (r, t)))\n (hsym : ∀ q u z, g q u z = g q z u)\n (hΓ : ∀ r ∈ R, ∀ t ∈ S, ∀ u z a,\n 2 * g (X (r, t)) (Γ (X (r, t)) u z) a =\n (fderiv ℝ g (X (r, t)) u) z a + (fderiv ℝ g (X (r, t)) z) u a -\n (fderiv ℝ g (X (r, t)) a) u z)\n (hXt : ∀ r ∈ R, ∀ t ∈ S, HasDerivAt (fun τ => X (r, τ)) (V (r, t)) t)\n (hVt : ∀ r ∈ R, ∀ t ∈ S,\n HasDerivAt (fun τ => V (r, τ)) (-Γ (X (r, t)) (V (r, t)) (V (r, t))) t)\n (hX0 : ∀ r ∈ R, X (r, 0) = p)\n (hV0 : ∀ r ∈ R, V (r, 0) = v + r • w)\n {s : ℝ} (hs : s ∈ R) :\n ∀ t ∈ S, g (X (s, t)) (V (s, t)) (fderiv ℝ X (s, t) (1, 0)) =\n t * g p (v + s • w) w := by\n have hopen : IsOpen (R ×ˢ S) := hR.prod hS\n have hXat (r : ℝ) (hr : r ∈ R) (t : ℝ) (ht : t ∈ S) :\n ContDiffAt ℝ 2 X (r, t) := hX.contDiffAt (hopen.mem_nhds ⟨hr, ht⟩)\n have hVat (r : ℝ) (hr : r ∈ R) (t : ℝ) (ht : t ∈ S) :\n DifferentiableAt ℝ V (r, t) :=\n (hV.contDiffAt (hopen.mem_nhds ⟨hr, ht⟩)).differentiableAt one_ne_zero\n let J (r t : ℝ) := fderiv ℝ X (r, t) (1, 0)\n let W (r t : ℝ) := fderiv ℝ V (r, t) (1, 0)\n have hXs (t : ℝ) (ht : t ∈ S) : HasDerivAt (fun r => X (r, t)) (J s t) s :=\n hasDerivAt_coordinate_first_slice ((hXat s hs t ht).differentiableAt (by norm_num))\n have hVs (t : ℝ) (ht : t ∈ S) : HasDerivAt (fun r => V (r, t)) (W s t) s :=\n hasDerivAt_coordinate_first_slice (hVat s hs t ht)\n have hpartial (q : ℝ × ℝ) (hq : q ∈ R ×ˢ S) :\n fderiv ℝ X q (0, 1) = V q :=\n (hasDerivAt_coordinate_second_slice\n ((hXat q.1 hq.1 q.2 hq.2).differentiableAt (by norm_num))).unique\n (hXt q.1 hq.1 q.2 hq.2)\n have hJt (t : ℝ) (ht : t ∈ S) : HasDerivAt (J s) (W s t) t := by\n have heq : (fun q => fderiv ℝ X q (0, 1)) =ᶠ[nhds (s, t)] V := by\n filter_upwards [hopen.mem_nhds ⟨hs, ht⟩] with q hq\n exact hpartial q hq\n have h := hasDerivAt_coordinate_mixed_fderiv (hXat s hs t ht)\n rw [heq.fderiv_eq] at h\n exact h\n have hJ0 : J s 0 = 0 := by\n have heq : (fun r => X (r, 0)) =ᶠ[nhds s] (fun _ => p) := by\n filter_upwards [hR.mem_nhds hs] with r hr\n exact hX0 r hr\n exact ((hXs 0 h0).congr_of_eventuallyEq heq.symm).unique (hasDerivAt_const s p)\n have hW0 : W s 0 = w := by\n have heq : (fun r => V (r, 0)) =ᶠ[nhds s] (fun r => v + r • w) := by\n filter_upwards [hR.mem_nhds hs] with r hr\n exact hV0 r hr\n have hlin : HasDerivAt (fun r : ℝ => v + r • w) w s := by\n simpa using ((hasDerivAt_id s).smul_const w).const_add v\n exact ((hVs 0 h0).congr_of_eventuallyEq heq.symm).unique hlin\n have h := coordinate_gauss_radial_pairing\n (X := fun r t => X (r, t)) (V := fun r t => V (r, t)) (J := J) (W := W)\n hR hs hS hconn h0 hg hsym hΓ hXt hVt hJt hXs hVs hJ0\n simpa only [hX0 s hs, hV0 s hs, hW0] using h\ntheorem hasDerivAt_flow_variation\n {P : Type*} [NormedAddCommGroup P] [NormedSpace ℝ P]\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {Φ : ℝ × P → E} {F : E → E} {z : ℝ × P} (v : P)\n (hΦ : ContDiffAt ℝ 2 Φ z) (hF : DifferentiableAt ℝ F (Φ z))\n (htime : ∀ᶠ w in nhds z,\n HasDerivAt (fun t : ℝ => Φ (t, w.2)) (F (Φ w)) w.1) :\n HasDerivAt (fun t : ℝ => fderiv ℝ Φ (t, z.2) (0, v))\n (fderiv ℝ F (Φ z) (fderiv ℝ Φ z (0, v))) z.1 := by\n have hΦ₁ : DifferentiableAt ℝ Φ z := hΦ.differentiableAt (by norm_num)\n have hD : DifferentiableAt ℝ (fderiv ℝ Φ) z :=\n (hΦ.fderiv_right (m := 1) (by norm_num)).differentiableAt one_ne_zero\n have hT : (fun w => fderiv ℝ Φ w (1, 0)) =ᶠ[nhds z] fun w => F (Φ w) := by\n filter_upwards [htime, hΦ.eventually (by norm_num)] with w hw hΦw\n have hi : HasDerivAt (fun t : ℝ => (t, w.2)) (1, 0) w.1 :=\n (hasDerivAt_id w.1).prodMk (hasDerivAt_const w.1 w.2)\n exact ((hΦw.differentiableAt (by norm_num)).hasFDerivAt.comp_hasDerivAt w.1 hi).unique hw\n have hleft : HasFDerivAt (fun w => fderiv ℝ Φ w (1, 0))\n ((fderiv ℝ (fderiv ℝ Φ) z).flip (1, 0)) z := by\n simpa only [ContinuousLinearMap.comp_zero, zero_add] using\n hD.hasFDerivAt.clm_apply (hasFDerivAt_const (1, (0 : P)) z)\n have hright : HasFDerivAt (fun w => F (Φ w))\n ((fderiv ℝ F (Φ z)).comp (fderiv ℝ Φ z)) z :=\n HasFDerivAt.comp (g := F) (f := Φ) z hF.hasFDerivAt hΦ₁.hasFDerivAt\n have heq := (hT.hasFDerivAt_iff.mp hleft).unique hright\n have heqv := congrArg (fun L : (ℝ × P) →L[ℝ] E => L (0, v)) heq\n have hi : HasDerivAt (fun t : ℝ => (t, z.2)) (1, 0) z.1 :=\n (hasDerivAt_id z.1).prodMk (hasDerivAt_const z.1 z.2)\n have hspace : HasFDerivAt (fun w => fderiv ℝ Φ w (0, v))\n ((fderiv ℝ (fderiv ℝ Φ) z).flip (0, v)) z := by\n simpa only [ContinuousLinearMap.comp_zero, zero_add] using\n hD.hasFDerivAt.clm_apply (hasFDerivAt_const (0, v) z)\n have hresult : HasDerivAt (fun t => fderiv ℝ Φ (t, z.2) (0, v))\n (((fderiv ℝ (fderiv ℝ Φ) z).flip (0, v)) (1, 0)) z.1 :=\n HasFDerivAt.comp_hasDerivAt (l := fun w : ℝ × P => fderiv ℝ Φ w (0, v))\n z.1 hspace hi\n have hsym := hΦ.isSymmSndFDerivAt (by norm_num) (1, 0) (0, v)\n simp only [ContinuousLinearMap.comp_apply, ContinuousLinearMap.flip_apply] at heqv hresult\n rw [hsym, heqv] at hresult\n exact hresult\ndef coordinateSprayLinearization\n (E : Type*) [NormedAddCommGroup E] [NormedSpace ℝ E] :\n (E × E) →L[ℝ] (E × E) :=\n (ContinuousLinearMap.snd ℝ E E).prod 0\ntheorem hasFDerivAt_coordinate_spray_zero\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {Γ : E → E →L[ℝ] E →L[ℝ] E} {p : E}\n (hΓ : DifferentiableAt ℝ Γ p) :\n HasFDerivAt (fun z : E × E => (z.2, -(Γ z.1 z.2 z.2)))\n (coordinateSprayLinearization E) (p, 0) := by\n have hfst : HasFDerivAt (fun z : E × E => z.1)\n (ContinuousLinearMap.fst ℝ E E) (p, (0 : E)) := hasFDerivAt_fst\n have hsnd : HasFDerivAt (fun z : E × E => z.2)\n (ContinuousLinearMap.snd ℝ E E) (p, (0 : E)) := hasFDerivAt_snd\n have hΓ' : HasFDerivAt (fun z : E × E => Γ z.1)\n ((fderiv ℝ Γ p).comp (ContinuousLinearMap.fst ℝ E E)) (p, (0 : E)) :=\n HasFDerivAt.comp (g := Γ) (p, (0 : E)) hΓ.hasFDerivAt hfst\n have hq := (hΓ'.clm_apply hsnd).clm_apply hsnd\n convert hsnd.prodMk\n hq.neg using 1 <;> simp [coordinateSprayLinearization]\ntheorem coordinateSprayLinearization_sq\n (E : Type*) [NormedAddCommGroup E] [NormedSpace ℝ E] :\n (coordinateSprayLinearization E).comp (coordinateSprayLinearization E) = 0 := by\n ext z <;> simp [coordinateSprayLinearization]\ntheorem fderiv_flow_initial\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {Φ : ℝ × E → E} {p : E}\n (hΦ : DifferentiableAt ℝ Φ (0, p))\n (hΦ0 : ∀ᶠ y in nhds p, Φ (0, y) = y) (v : E) :\n fderiv ℝ Φ (0, p) (0, v) = v := by\n have hi : HasFDerivAt (fun y : E => ((0 : ℝ), y))\n ((0 : E →L[ℝ] ℝ).prod (ContinuousLinearMap.id ℝ E)) p :=\n (hasFDerivAt_const (0 : ℝ) p).prodMk (hasFDerivAt_id p)\n have hc := HasFDerivAt.comp (g := Φ) (f := fun y : E => ((0 : ℝ), y))\n p hΦ.hasFDerivAt hi\n have heq := (hc.congr_of_eventuallyEq (Filter.EventuallyEq.symm hΦ0)).unique\n (hasFDerivAt_id p)\n have heqv := congrArg (fun L : E →L[ℝ] E => L v) heq\n simpa only [ContinuousLinearMap.comp_apply, ContinuousLinearMap.prod_apply,\n ContinuousLinearMap.zero_apply, ContinuousLinearMap.id_apply] using heqv\ntheorem fderiv_flow_eq_affine_of_sq_zero\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {F : E → E} {Φ : ℝ × E → E} {A : E →L[ℝ] E} {p : E}\n {S : Set ℝ} {U : Set E}\n (hS : IsOpen S) (hconn : IsPreconnected S) (h0 : (0 : ℝ) ∈ S)\n (hU : IsOpen U) (hp : p ∈ U)\n (hΦ : ContDiffOn ℝ 2 Φ (S ×ˢ U))\n (hΦ0 : ∀ y ∈ U, Φ (0, y) = y)\n (hstationary : ∀ t ∈ S, Φ (t, p) = p)\n (htime : ∀ z ∈ S ×ˢ U,\n HasDerivAt (fun t : ℝ => Φ (t, z.2)) (F (Φ z)) z.1)\n (hF : HasFDerivAt F A p) (hA : A.comp A = 0) :\n ∀ t ∈ S, ∀ v : E, fderiv ℝ Φ (t, p) (0, v) = v + t • A v := by\n intro t ht v\n let D : ℝ → E := fun t => fderiv ℝ Φ (t, p) (0, v)\n have hD (s : ℝ) (hs : s ∈ S) : HasDerivAt D (A (D s)) s := by\n have hΦs : ContDiffAt ℝ 2 Φ (s,p) :=\n hΦ.contDiffAt ((hS.prod hU).mem_nhds ⟨hs,hp⟩)\n have hFs : DifferentiableAt ℝ F (Φ (s,p)) := by\n rw [hstationary s hs]\n exact hF.differentiableAt\n have hnear : ∀ᶠ z in nhds (s,p),\n HasDerivAt (fun t : ℝ => Φ (t,z.2)) (F (Φ z)) z.1 := by\n filter_upwards [(hS.prod hU).mem_nhds ⟨hs,hp⟩] with z hz\n exact htime z hz\n have hd := Helpers.hasDerivAt_flow_variation v hΦs hFs hnear\n simpa only [hstationary s hs, hF.fderiv] using hd\n have hD0 : D 0 = v := by\n apply Helpers.fderiv_flow_initial\n ((hΦ.contDiffAt ((hS.prod hU).mem_nhds ⟨h0,hp⟩)).differentiableAt (by norm_num))\n filter_upwards [hU.mem_nhds hp] with y hy using hΦ0 y hy\n simpa only [hD0] using Helpers.eq_affine_of_hasDerivAt_sq_zero A hA S hS hconn h0 D hD t ht\ntheorem exists_local_inverse_of_spray_flow_linearization\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {Φ : ℝ × (E × E) → E × E} {τ : ℝ} {p : E} (hτ : τ ≠ 0)\n (hΦ : ContDiffAt ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Φ (τ, (p, 0)))\n (hΦp : Φ (τ, (p, 0)) = (p, 0))\n (hlin : ∀ v : E, fderiv ℝ Φ (τ, (p, 0)) (0, (0, v)) = (τ • v, v)) :\n ∃ e : OpenPartialHomeomorph E E,\n (0 : E) ∈ e.source ∧ p ∈ e.target ∧\n (∀ v : E, e v = (Φ (τ, (p, v))).1) ∧\n ContDiffAt ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) e 0 ∧\n ContDiffAt ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) e.symm p := by\n let f : E → E := fun v => (Φ (τ, (p, v))).1\n let J : E →L[ℝ] (ℝ × (E × E)) :=\n (0 : E →L[ℝ] ℝ).prod ((0 : E →L[ℝ] E).prod (ContinuousLinearMap.id ℝ E))\n have hι : HasFDerivAt (fun v : E => (τ, (p, v))) J 0 :=\n (hasFDerivAt_const τ 0).prodMk\n ((hasFDerivAt_const p 0).prodMk (hasFDerivAt_id 0))\n have hcomp : HasFDerivAt (fun v : E => Φ (τ, (p, v)))\n ((fderiv ℝ Φ (τ,(p,0))).comp J) 0 :=\n HasFDerivAt.comp (g := Φ) (f := fun v : E => (τ, (p, v))) 0\n (hΦ.differentiableAt (by simp)).hasFDerivAt hι\n let L : E ≃L[ℝ] E := (Units.mk0 τ hτ) • ContinuousLinearEquiv.refl ℝ E\n have hf' : HasFDerivAt f (L : E →L[ℝ] E) 0 := by\n have hd := HasFDerivAt.comp (g := fun z : E × E => z.1)\n (f := fun v : E => Φ (τ, (p, v))) 0 hasFDerivAt_fst hcomp\n convert hd using 1\n · rfl\n · ext v\n simp [J, L, ContinuousLinearMap.comp_apply, hlin]\n have hf : ContDiffAt ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) f 0 := by\n apply contDiffAt_fst.comp 0\n apply hΦ.comp 0\n exact contDiffAt_const.prodMk (contDiffAt_const.prodMk contDiffAt_id)\n let e : OpenPartialHomeomorph E E := hf.toOpenPartialHomeomorph f hf' (by simp)\n have hfp : f 0 = p := congrArg Prod.fst hΦp\n refine ⟨e, hf.mem_toOpenPartialHomeomorph_source hf' (by simp), ?_,\n fun _ => rfl, hf, ?_⟩\n · rw [← hfp]\n exact hf.image_mem_toOpenPartialHomeomorph_target hf' (by simp)\n · rw [← hfp]\n exact hf.to_localInverse hf' (by simp)\ntheorem coordinate_spray_flow_linearization\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {U : Set E} (hU : IsOpen U) {Γ : E → E →L[ℝ] E →L[ℝ] E}\n {p : E} (hp : p ∈ U) (hΓ : DifferentiableAt ℝ Γ p)\n {r ε : ℝ} (hr : 0 < r) (hε : 0 < ε)\n {Φ : ℝ × (E × E) → E × E}\n (hΦ : ContDiffOn ℝ 2 Φ (Set.Ioo (-ε) ε ×ˢ Metric.ball (p, 0) r))\n (hΦ0 : ∀ y ∈ Metric.ball (p, 0) r, Φ (0, y) = y)\n (hΦp : ∀ t ∈ Set.Ioo (-ε) ε, Φ (t, (p, 0)) = (p, 0))\n (hODE : ∀ z ∈ Set.Ioo (-ε) ε ×ˢ Metric.ball (p, 0) r,\n HasDerivAt (fun t : ℝ => Φ (t, z.2))\n ((Φ z).2, -(Γ (Φ z).1 (Φ z).2 (Φ z).2)) z.1) :\n ∀ t ∈ Set.Ioo (-ε) ε, ∀ u v : E,\n fderiv ℝ Φ (t, (p, 0)) (0, (u, v)) = (u + t • v, v) := by\n have hlinear := Helpers.fderiv_flow_eq_affine_of_sq_zero\n isOpen_Ioo (convex_Ioo (-ε) ε).isPreconnected\n (show (0 : ℝ) ∈ Set.Ioo (-ε) ε from ⟨by linarith, hε⟩)\n Metric.isOpen_ball (Metric.mem_ball_self hr) hΦ hΦ0 hΦp hODE\n (Helpers.hasFDerivAt_coordinate_spray_zero hΓ)\n (Helpers.coordinateSprayLinearization_sq E)\n intro t ht u v\n simpa [Helpers.coordinateSprayLinearization] using hlinear t ht (u,v)\ntheorem coordinate_spray_flow_gauss_pairing\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {Γ : E → E →L[ℝ] E →L[ℝ] E}\n {U : Set E} (hU : IsOpen U) (hg : ContDiffOn ℝ 1 g U)\n (hsym : ∀ x u v, g x u v = g x v u)\n (hKoszul : ∀ x ∈ U, ∀ u v w,\n 2 * g x (Γ x u v) w = (fderiv ℝ g x u) v w +\n (fderiv ℝ g x v) u w - (fderiv ℝ g x w) u v)\n {p : E} {r ε : ℝ} (hε : 0 < ε) {Φ : ℝ × (E × E) → E × E}\n (hΦ : ContDiffOn ℝ 2 Φ (Set.Ioo (-ε) ε ×ˢ Metric.ball (p,0) r))\n (hΦ0 : ∀ z ∈ Metric.ball (p,0) r, Φ (0,z) = z)\n (hODE : ∀ z ∈ Set.Ioo (-ε) ε ×ˢ Metric.ball (p,0) r,\n (Φ z).1 ∈ U ∧ HasDerivAt (fun t : ℝ => Φ (t,z.2))\n ((Φ z).2, -(Γ (Φ z).1 (Φ z).2 (Φ z).2)) z.1)\n (v w : E) (hv : (p,v) ∈ Metric.ball (p,0) r) :\n ∀ t ∈ Set.Ioo (-ε) ε,\n g (Φ (t,(p,v))).1 (Φ (t,(p,v))).2\n ((fderiv ℝ Φ (t,(p,v)) (0,(0,w))).1) = t * g p v w := by\n let R : Set ℝ := {s | (p,v+s•w) ∈ Metric.ball (p,0) r}\n let S : Set ℝ := Set.Ioo (-ε) ε\n let A : ℝ × ℝ → ℝ × (E × E) := fun z => (z.2,(p,v+z.1•w))\n let X : ℝ × ℝ → E := fun z => (Φ (A z)).1\n let V : ℝ × ℝ → E := fun z => (Φ (A z)).2\n have hR : IsOpen R := Metric.isOpen_ball.preimage (by fun_prop)\n have h0R : (0 : ℝ) ∈ R := by simpa [R] using hv\n have hZ : ContDiffOn ℝ 2 (fun z => Φ (A z)) (R ×ˢ S) :=\n hΦ.comp (by fun_prop) (fun z hz => ⟨hz.2,hz.1⟩)\n have hX : ContDiffOn ℝ 2 X (R ×ˢ S) := contDiff_fst.comp_contDiffOn hZ\n have hV : ContDiffOn ℝ 1 V (R ×ˢ S) :=\n (contDiff_snd.comp_contDiffOn hZ).of_le (by norm_num)\n have hXt (s : ℝ) (hs : s ∈ R) (t : ℝ) (ht : t ∈ S) :\n HasDerivAt (fun τ => X (s,τ)) (V (s,t)) t := by\n simpa [X,V,A,Function.comp_def] using\n HasFDerivAt.comp_hasDerivAt (l := fun z : E × E => z.1) t\n hasFDerivAt_fst (hODE (t,(p,v+s•w)) ⟨ht,hs⟩).2\n have hVt (s : ℝ) (hs : s ∈ R) (t : ℝ) (ht : t ∈ S) :\n HasDerivAt (fun τ => V (s,τ)) (-(Γ (X (s,t)) (V (s,t)) (V (s,t)))) t := by\n simpa [X,V,A,Function.comp_def] using\n HasFDerivAt.comp_hasDerivAt (l := fun z : E × E => z.2) t\n hasFDerivAt_snd (hODE (t,(p,v+s•w)) ⟨ht,hs⟩).2\n have hX0 (s : ℝ) (hs : s ∈ R) : X (s,0) = p := by\n simp [X,A,hΦ0 (p,v+s•w) hs]\n have hV0 (s : ℝ) (hs : s ∈ R) : V (s,0) = v+s•w := by\n simp [V,A,hΦ0 (p,v+s•w) hs]\n have hGauss := Helpers.coordinate_gauss_radial_pairing_of_contDiffOn\n (g := g) (Γ := fun x u v => Γ x u v) (X := X) (V := V)\n hR isOpen_Ioo (convex_Ioo (-ε) ε).isPreconnected\n (show (0 : ℝ) ∈ S from ⟨by linarith,hε⟩) hX hV\n (fun s hs t ht => (hg.contDiffAt (hU.mem_nhds\n (hODE (t,(p,v+s•w)) ⟨ht,hs⟩).1)).differentiableAt one_ne_zero)\n hsym (fun s hs t ht => hKoszul _ (hODE (t,(p,v+s•w)) ⟨ht,hs⟩).1)\n hXt hVt hX0 hV0 h0R\n intro t ht\n have hline : HasDerivAt (fun s : ℝ => (t,(p,v+s•w))) (0,(0,w)) 0 := by\n simpa using (hasDerivAt_const (0 : ℝ) t).prodMk\n ((hasDerivAt_const (0 : ℝ) p).prodMk\n (((hasDerivAt_id (0 : ℝ)).smul_const w).const_add v))\n have hΦat : DifferentiableAt ℝ Φ (t,(p,v)) :=\n (hΦ.contDiffAt ((isOpen_Ioo.prod Metric.isOpen_ball).mem_nhds\n ⟨ht,hv⟩)).differentiableAt (by norm_num)\n have hcomp : HasDerivAt (fun s : ℝ => Φ (t,(p,v+s•w)))\n (fderiv ℝ Φ (t,(p,v)) (0,(0,w))) 0 := by\n have hΦat' : HasFDerivAt Φ (fderiv ℝ Φ (t,(p,v))) (t,(p,v+(0:ℝ)•w)) := by\n simpa only [zero_smul,add_zero] using hΦat.hasFDerivAt\n exact HasFDerivAt.comp_hasDerivAt (l := Φ) (f := fun s : ℝ => (t,(p,v+s•w)))\n (0 : ℝ) hΦat' hline\n have hfirst : HasDerivAt (fun s => X (s,t))\n ((fderiv ℝ Φ (t,(p,v)) (0,(0,w))).1) 0 := by\n simpa [X,A,Function.comp_def] using\n HasFDerivAt.comp_hasDerivAt (l := fun z : E × E => z.1) (0 : ℝ)\n hasFDerivAt_fst hcomp\n have hJ := Helpers.hasDerivAt_coordinate_first_slice\n ((hX.contDiffAt ((hR.prod isOpen_Ioo).mem_nhds ⟨h0R,ht⟩)).differentiableAt\n (by norm_num))\n have hJeq := hJ.unique hfirst\n have h := hGauss t ht\n rw [hJeq] at h\n simpa [X,V,A] using h\ntheorem hasDerivAt_rescale_bilinear_spray\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (Γ : E → E →L[ℝ] E →L[ℝ] E) (γ : ℝ → E × E) (κ t : ℝ)\n (hγ : HasDerivAt γ\n ((γ (κ * t)).2, -Γ (γ (κ * t)).1 (γ (κ * t)).2 (γ (κ * t)).2) (κ * t)) :\n HasDerivAt (fun s => ((γ (κ * s)).1, κ • (γ (κ * s)).2))\n (κ • (γ (κ * t)).2,\n -Γ (γ (κ * t)).1 (κ • (γ (κ * t)).2) (κ • (γ (κ * t)).2)) t := by\n have htime : HasDerivAt (fun s : ℝ => κ * s) κ t := by\n simpa using (hasDerivAt_id t).const_mul κ\n have h : HasDerivAt (fun s => γ (κ * s))\n (κ • ((γ (κ * t)).2,\n -Γ (γ (κ * t)).1 (γ (κ * t)).2 (γ (κ * t)).2)) t :=\n hγ.scomp t htime\n have hf : HasDerivAt (fun s => (γ (κ * s)).1) (κ • (γ (κ * t)).2) t := by\n simpa only [Function.comp_def, ContinuousLinearMap.coe_fst', Prod.smul_fst] using\n (ContinuousLinearMap.fst ℝ E E).hasFDerivAt.comp_hasDerivAt t h\n have hs : HasDerivAt (fun s => (γ (κ * s)).2)\n (κ • (-Γ (γ (κ * t)).1 (γ (κ * t)).2 (γ (κ * t)).2)) t := by\n simpa only [Function.comp_def, ContinuousLinearMap.coe_snd', Prod.smul_snd] using\n (ContinuousLinearMap.snd ℝ E E).hasFDerivAt.comp_hasDerivAt t h\n convert hf.prodMk (hs.const_smul κ) using 1\n simp only [map_smul, smul_apply, smul_neg]\ntheorem rescale_velocity_mem_ball\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {p : E} {z : E × E} {R κ : ℝ} (hκ : |κ| ≤ 1)\n (hz : z ∈ Metric.ball (p, 0) R) :\n (z.1, κ • z.2) ∈ Metric.ball (p, 0) R := by\n rw [Metric.mem_ball, Prod.dist_eq, max_lt_iff] at hz ⊢\n refine ⟨hz.1, ?_⟩\n simp only [dist_zero_right, norm_smul, Real.norm_eq_abs] at hz ⊢\n exact lt_of_le_of_lt (by nlinarith [norm_nonneg z.2]) hz.2\ntheorem coordinate_spray_flow_rescale\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (Γ : E → E →L[ℝ] E →L[ℝ] E) (Φ : ℝ → E × E → E × E)\n (p : E) {ε r R : ℝ} {K : NNReal} (hε : 0 < ε)\n (hLip : LipschitzOnWith K (fun z : E × E => (z.2, -Γ z.1 z.2 z.2))\n (Metric.ball (p, 0) R))\n (hΦ0 : ∀ v : E, ‖v‖ < r → Φ 0 (p, v) = (p, v))\n (hΦ : ∀ v : E, ‖v‖ < r → ∀ t : ℝ, |t| < ε →\n HasDerivAt (fun s => Φ s (p, v))\n ((Φ t (p, v)).2, -Γ (Φ t (p, v)).1 (Φ t (p, v)).2 (Φ t (p, v)).2) t ∧\n Φ t (p, v) ∈ Metric.ball (p, 0) R)\n (κ t : ℝ) (v : E) (hκ : |κ| ≤ 1) (ht : |t| < ε) (hv : ‖v‖ < r) :\n Φ t (p, κ • v) = ((Φ (κ * t) (p, v)).1, κ • (Φ (κ * t) (p, v)).2) := by\n have hκv : ‖κ • v‖ < r := by\n rw [norm_smul, Real.norm_eq_abs]\n exact lt_of_le_of_lt (by nlinarith [norm_nonneg v]) hv\n have htime (s : ℝ) (hs : |s| < ε) : |κ * s| < ε := by\n rw [abs_mul]\n exact lt_of_le_of_lt (by nlinarith [abs_nonneg s]) hs\n have hzero : (0 : ℝ) ∈ Set.Ioo (-ε) ε := ⟨by linarith, hε⟩\n have heq := ODE_solution_unique_of_mem_Ioo\n (v := fun _ (z : E × E) => (z.2, -Γ z.1 z.2 z.2))\n (s := fun _ => Metric.ball (p, 0) R)\n (f := fun s => Φ s (p, κ • v))\n (g := fun s => ((Φ (κ * s) (p, v)).1, κ • (Φ (κ * s) (p, v)).2))\n (fun _ _ => hLip) hzero\n (fun s hs => hΦ (κ • v) hκv s (abs_lt.mpr hs))\n (fun s hs => ⟨hasDerivAt_rescale_bilinear_spray Γ (fun τ => Φ τ (p, v)) κ s\n (hΦ v hv (κ * s) (htime s (abs_lt.mpr hs))).1,\n rescale_velocity_mem_ball hκ\n (hΦ v hv (κ * s) (htime s (abs_lt.mpr hs))).2⟩)\n (by simp only [mul_zero, hΦ0 v hv, hΦ0 (κ • v) hκv])\n exact heq (abs_lt.mp ht)\ntheorem radial_fderiv_fst_of_scaling\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (Φ : ℝ × (E × E) → E × E) (t : ℝ) (p v V : E)\n (hΦ : DifferentiableAt ℝ Φ (t, (p, v)))\n (htime : HasDerivAt (fun s => (Φ (s, (p, v))).1) V t)\n (hscale : ∀ κ ∈ Set.Icc (0 : ℝ) 1,\n (Φ (t, (p, κ • v))).1 = (Φ (κ * t, (p, v))).1) :\n (fderiv ℝ Φ (t, (p, v)) (0, (0, v))).1 = t • V := by\n have hin : HasDerivAt (fun κ : ℝ => (t, (p, κ • v))) (0, (0, v)) 1 := by\n simpa using (hasDerivAt_const (1 : ℝ) t).prodMk\n ((hasDerivAt_const (1 : ℝ) p).prodMk ((hasDerivAt_id (1 : ℝ)).smul_const v))\n have hleft : HasDerivAt (fun κ : ℝ => (Φ (t, (p, κ • v))).1)\n (fderiv ℝ Φ (t, (p, v)) (0, (0, v))).1 1 := by\n simpa only [Function.comp_def, ContinuousLinearMap.comp_apply,\n ContinuousLinearMap.coe_fst'] using\n hΦ.hasFDerivAt.fst.comp_hasDerivAt_of_eq 1 hin (by simp)\n have hright : HasDerivAt (fun κ : ℝ => (Φ (κ * t, (p, v))).1) (t • V) 1 := by\n simpa only [Function.comp_def, one_mul, id_eq] using\n htime.scomp_of_eq 1 ((hasDerivAt_id (1 : ℝ)).mul_const t) (by simp)\n have hu : UniqueDiffWithinAt ℝ (Set.Icc (0 : ℝ) 1) 1 :=\n uniqueDiffOn_Icc_zero_one 1 (by norm_num)\n have heq : HasDerivWithinAt (fun κ : ℝ => (Φ (t, (p, κ • v))).1)\n (t • V) (Set.Icc (0 : ℝ) 1) 1 :=\n hright.hasDerivWithinAt.congr_of_mem hscale (by norm_num)\n exact (hleft.hasDerivWithinAt.derivWithin hu).symm.trans (heq.derivWithin hu)\ntheorem fderiv_coordinate_spray_endpoint_apply\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {Φ : ℝ × (E × E) → E × E} {t : ℝ} {p v : E}\n (hΦ : DifferentiableAt ℝ Φ (t,(p,v))) (w : E) :\n fderiv ℝ (fun u : E => (Φ (t,(p,u))).1) v w =\n (fderiv ℝ Φ (t,(p,v)) (0,(0,w))).1 := by\n let J : E →L[ℝ] (ℝ × (E × E)) :=\n (0 : E →L[ℝ] ℝ).prod ((0 : E →L[ℝ] E).prod (ContinuousLinearMap.id ℝ E))\n have hi : HasFDerivAt (fun u : E => (t,(p,u))) J v :=\n (hasFDerivAt_const t v).prodMk\n ((hasFDerivAt_const p v).prodMk (hasFDerivAt_id v))\n have hc := HasFDerivAt.comp (g := Φ) (f := fun u : E => (t,(p,u)))\n v hΦ.hasFDerivAt hi\n have hd := HasFDerivAt.comp (g := fun z : E × E => z.1)\n (f := fun u : E => Φ (t,(p,u))) v hasFDerivAt_fst hc\n simpa [Function.comp_def,J] using\n congrArg (fun L : E →L[ℝ] E => L w) hd.fderiv\ntheorem coordinate_spray_endpoint_gauss\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {Γ : E → E →L[ℝ] E →L[ℝ] E}\n {U : Set E} (hU : IsOpen U) (hg : ContDiffOn ℝ 1 g U)\n (hsym : ∀ x u v, g x u v = g x v u)\n (hKoszul : ∀ x ∈ U, ∀ u v w,\n 2 * g x (Γ x u v) w = (fderiv ℝ g x u) v w +\n (fderiv ℝ g x v) u w - (fderiv ℝ g x w) u v)\n {p : E} {r ε : ℝ} (hε : 0 < ε) {Φ : ℝ × (E × E) → E × E}\n (hΦ : ContDiffOn ℝ 2 Φ (Set.Ioo (-ε) ε ×ˢ Metric.ball (p,0) r))\n (hΦ0 : ∀ z ∈ Metric.ball (p,0) r, Φ (0,z) = z)\n (hODE : ∀ z ∈ Set.Ioo (-ε) ε ×ˢ Metric.ball (p,0) r,\n (Φ z).1 ∈ U ∧ HasDerivAt (fun t : ℝ => Φ (t,z.2))\n ((Φ z).2, -(Γ (Φ z).1 (Φ z).2 (Φ z).2)) z.1)\n {v : E} (hv : (p,v) ∈ Metric.ball (p,0) r)\n {t : ℝ} (ht : t ∈ Set.Ioo (-ε) ε)\n (hscale : ∀ κ ∈ Set.Icc (0:ℝ) 1,\n (Φ (t,(p,κ•v))).1 = (Φ (κ*t,(p,v))).1) :\n ∀ w : E,\n g (Φ (t,(p,v))).1\n (fderiv ℝ (fun u : E => (Φ (t,(p,u))).1) v v)\n (fderiv ℝ (fun u : E => (Φ (t,(p,u))).1) v w) =\n t^2 * g p v w := by\n have hΦat : DifferentiableAt ℝ Φ (t,(p,v)) :=\n (hΦ.contDiffAt ((isOpen_Ioo.prod Metric.isOpen_ball).mem_nhds\n ⟨ht,hv⟩)).differentiableAt (by norm_num)\n have htime : HasDerivAt (fun s => (Φ (s,(p,v))).1) (Φ (t,(p,v))).2 t := by\n simpa [Function.comp_def] using\n HasFDerivAt.comp_hasDerivAt (l := fun z : E × E => z.1) t\n hasFDerivAt_fst (hODE (t,(p,v)) ⟨ht,hv⟩).2\n have hradial := Helpers.radial_fderiv_fst_of_scaling Φ t p v _ hΦat htime hscale\n intro w\n rw [Helpers.fderiv_coordinate_spray_endpoint_apply hΦat,\n Helpers.fderiv_coordinate_spray_endpoint_apply hΦat,hradial]\n simp only [map_smul,smul_apply,smul_eq_mul]\n rw [Helpers.coordinate_spray_flow_gauss_pairing hU hg hsym hKoszul hε\n hΦ hΦ0 hODE v w hv t ht]\n ring\ntheorem exists_coordinate_normal_chart\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {U : Set E} (hU : IsOpen U)\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} (hg : ContDiffOn ℝ 1 g U)\n (hsym : ∀ x u v, g x u v = g x v u)\n {Γ : E → E →L[ℝ] E →L[ℝ] E}\n (hΓ : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Γ U)\n (hKoszul : ∀ x ∈ U, ∀ u v w,\n 2 * g x (Γ x u v) w = (fderiv ℝ g x u) v w +\n (fderiv ℝ g x v) u w - (fderiv ℝ g x w) u v)\n {p : E} (hp : p ∈ U) :\n ∃ τ > (0:ℝ), ∃ r > (0:ℝ), ∃ e : OpenPartialHomeomorph E E,\n (0:E) ∈ e.source ∧ p ∈ e.target ∧ e 0 = p ∧\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) e (Metric.ball 0 r) ∧\n ContDiffAt ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) e.symm p ∧\n ∀ v ∈ Metric.ball 0 r, e v ∈ U ∧ ∀ w : E,\n g (e v) (fderiv ℝ e v v) (fderiv ℝ e v w) = τ^2 * g p v w := by\n obtain ⟨R,hR,K,hLip,hdom,r,hr,ε,hε,Φ,hΦ,hΦ0,hΦF,hΦp⟩ :=\n Helpers.exists_coordinate_spray_flow_in_lipschitz_ball hU hΓ hp\n have hODE : ∀ z ∈ Set.Ioo (-ε) ε ×ˢ Metric.ball (p,0) r,\n (Φ z).1 ∈ U ∧ HasDerivAt (fun t : ℝ => Φ (t,z.2))\n ((Φ z).2, -(Γ (Φ z).1 (Φ z).2 (Φ z).2)) z.1 := by\n intro z hz\n exact ⟨hdom _ (hΦF z hz).1,(hΦF z hz).2⟩\n have hvball (v : E) (hv : ‖v‖ < r) : (p,v) ∈ Metric.ball (p,0) r := by\n simpa [Metric.mem_ball,Prod.dist_eq] using hv\n have hscale (κ t : ℝ) (v : E) (hκ : |κ| ≤ 1) (ht : |t| < ε) (hv : ‖v‖ < r) :\n Φ (t,(p,κ•v)) = ((Φ (κ*t,(p,v))).1,κ•(Φ (κ*t,(p,v))).2) := by\n apply Helpers.coordinate_spray_flow_rescale Γ (fun s z => Φ (s,z)) p hε hLip\n · intro u hu\n exact hΦ0 (p,u) (hvball u hu)\n · intro u hu s hs\n exact ⟨(hΦF (s,(p,u)) ⟨abs_lt.mp hs,hvball u hu⟩).2,\n (hΦF (s,(p,u)) ⟨abs_lt.mp hs,hvball u hu⟩).1⟩\n · exact hκ\n · exact ht\n · exact hv\n let τ : ℝ := ε/2\n have hτ : τ ∈ Set.Ioo (-ε) ε := ⟨by dsimp [τ]; linarith,by dsimp [τ]; linarith⟩\n have hτpos : 0 < τ := by dsimp [τ]; positivity\n have hΦat : ContDiffAt ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Φ (τ,(p,0)) :=\n hΦ.contDiffAt ((isOpen_Ioo.prod Metric.isOpen_ball).mem_nhds\n ⟨hτ,Metric.mem_ball_self hr⟩)\n have hlin := Helpers.coordinate_spray_flow_linearization hU hp\n ((hΓ.contDiffAt (hU.mem_nhds hp)).differentiableAt (by simp)) hr hε\n (hΦ.of_le (by simp)) hΦ0 hΦp (fun z hz => (hODE z hz).2)\n obtain ⟨e,he0,hep,hef,he,hei⟩ :=\n Helpers.exists_local_inverse_of_spray_flow_linearization hτpos.ne' hΦat\n (hΦp τ hτ) (fun v => by simpa only [zero_add] using hlin τ hτ 0 v)\n refine ⟨τ,hτpos,r,hr,e,he0,hep,?_,?_,hei,?_⟩\n · rw [hef]\n exact congrArg Prod.fst (hΦp τ hτ)\n · have hi : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞)\n (fun v : E => (τ,(p,v))) (Metric.ball 0 r) := by fun_prop\n have hc := hΦ.comp hi (fun v hv => ⟨hτ,hvball v (by simpa using hv)⟩)\n simpa only [Function.comp_def,← funext hef] using contDiff_fst.comp_contDiffOn hc\n · intro v hv\n have hvr : ‖v‖ < r := by simpa using hv\n have hv' := hvball v hvr\n refine ⟨by rw [hef]; exact (hODE (τ,(p,v)) ⟨hτ,hv'⟩).1,?_⟩\n intro w\n have h := Helpers.coordinate_spray_endpoint_gauss hU hg hsym hKoszul hε\n (hΦ.of_le (by simp)) hΦ0 hODE hv' hτ (fun κ hκ => by\n simpa only using congrArg (fun z : E × E => z.1)\n (hscale κ τ v (by simpa [abs_of_nonneg hκ.1] using hκ.2)\n (abs_lt.mpr hτ) hvr)) w\n simpa only [funext hef] using h\ntheorem exists_coordinate_normal_chart_with_radial_ode_source\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {U : Set E} (hU : IsOpen U)\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} (hg : ContDiffOn ℝ 1 g U)\n (hsym : ∀ x u v, g x u v = g x v u)\n {Γ : E → E →L[ℝ] E →L[ℝ] E}\n (hΓ : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Γ U)\n (hKoszul : ∀ x ∈ U, ∀ u v w,\n 2 * g x (Γ x u v) w = (fderiv ℝ g x u) v w +\n (fderiv ℝ g x v) u w - (fderiv ℝ g x w) u v)\n {p : E} (hp : p ∈ U) :\n ∃ τ > (0:ℝ), ∃ r > (0:ℝ), ∃ e : OpenPartialHomeomorph E E,\n (0:E) ∈ e.source ∧ p ∈ e.target ∧ e 0 = p ∧\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) e (Metric.ball 0 r) ∧\n ContDiffAt ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) e.symm p ∧\n Metric.ball 0 r ⊆ e.source ∧\n (∀ v ∈ Metric.ball 0 r, e v ∈ U ∧ ∀ w : E,\n g (e v) (fderiv ℝ e v v) (fderiv ℝ e v w) = τ^2 * g p v w) ∧\n ∀ v ∈ Metric.ball 0 r, ∀ t ∈ Set.Ioo (-1 : ℝ) 1,\n HasDerivAt (fun s : ℝ => e (s • v)) (fderiv ℝ e (t • v) v) t ∧\n HasDerivAt (fun s : ℝ => fderiv ℝ e (s • v) v)\n (-(Γ (e (t • v)) (fderiv ℝ e (t • v) v) (fderiv ℝ e (t • v) v))) t := by\n obtain ⟨R,hR,K,hLip,hdom,r,hr,ε,hε,Φ,hΦ,hΦ0,hΦF,hΦp⟩ :=\n Helpers.exists_coordinate_spray_flow_in_lipschitz_ball hU hΓ hp\n have hODE : ∀ z ∈ Set.Ioo (-ε) ε ×ˢ Metric.ball (p,0) r,\n (Φ z).1 ∈ U ∧ HasDerivAt (fun t : ℝ => Φ (t,z.2))\n ((Φ z).2, -(Γ (Φ z).1 (Φ z).2 (Φ z).2)) z.1 := by\n intro z hz\n exact ⟨hdom _ (hΦF z hz).1,(hΦF z hz).2⟩\n have hvball (v : E) (hv : ‖v‖ < r) : (p,v) ∈ Metric.ball (p,0) r := by\n simpa [Metric.mem_ball,Prod.dist_eq] using hv\n have hscale (κ t : ℝ) (v : E) (hκ : |κ| ≤ 1) (ht : |t| < ε) (hv : ‖v‖ < r) :\n Φ (t,(p,κ•v)) = ((Φ (κ*t,(p,v))).1,κ•(Φ (κ*t,(p,v))).2) := by\n apply Helpers.coordinate_spray_flow_rescale Γ (fun s z => Φ (s,z)) p hε hLip\n · intro u hu\n exact hΦ0 (p,u) (hvball u hu)\n · intro u hu s hs\n exact ⟨(hΦF (s,(p,u)) ⟨abs_lt.mp hs,hvball u hu⟩).2,\n (hΦF (s,(p,u)) ⟨abs_lt.mp hs,hvball u hu⟩).1⟩\n · exact hκ\n · exact ht\n · exact hv\n let τ : ℝ := ε/2\n have hτ : τ ∈ Set.Ioo (-ε) ε := ⟨by dsimp [τ]; linarith,by dsimp [τ]; linarith⟩\n have hτpos : 0 < τ := by dsimp [τ]; positivity\n have hΦat : ContDiffAt ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Φ (τ,(p,0)) :=\n hΦ.contDiffAt ((isOpen_Ioo.prod Metric.isOpen_ball).mem_nhds\n ⟨hτ,Metric.mem_ball_self hr⟩)\n have hlin := Helpers.coordinate_spray_flow_linearization hU hp\n ((hΓ.contDiffAt (hU.mem_nhds hp)).differentiableAt (by simp)) hr hε\n (hΦ.of_le (by simp)) hΦ0 hΦp (fun z hz => (hODE z hz).2)\n obtain ⟨e,he0,hep,hef,he,hei⟩ :=\n Helpers.exists_local_inverse_of_spray_flow_linearization hτpos.ne' hΦat\n (hΦp τ hτ) (fun v => by simpa only [zero_add] using hlin τ hτ 0 v)\n obtain ⟨ρ,hρ,hρsource⟩ := Metric.mem_nhds_iff.mp (e.open_source.mem_nhds he0)\n let r' : ℝ := min r ρ\n have hr' : 0 < r' := lt_min hr hρ\n have hsub : Metric.ball (0 : E) r' ⊆ Metric.ball 0 r :=\n Metric.ball_subset_ball (min_le_left r ρ)\n have hsource : Metric.ball (0 : E) r' ⊆ e.source :=\n fun v hv => hρsource (Metric.ball_subset_ball (min_le_right r ρ) hv)\n have hesmooth : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) e (Metric.ball 0 r') := by\n have hi : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞)\n (fun v : E => (τ,(p,v))) (Metric.ball 0 r') := by fun_prop\n have hc := hΦ.comp hi (fun v hv => ⟨hτ,hvball v (by simpa using hsub hv)⟩)\n simpa only [Function.comp_def,← funext hef] using contDiff_fst.comp_contDiffOn hc\n have hsmul (v : E) (hv : v ∈ Metric.ball 0 r')\n (t : ℝ) (ht : t ∈ Set.Ioo (-1 : ℝ) 1) : t • v ∈ Metric.ball 0 r' := by\n have hvr : ‖v‖ < r' := by simpa using hv\n have habs : |t| ≤ 1 := (abs_lt.mpr ht).le\n rw [Metric.mem_ball, dist_zero_right, norm_smul, Real.norm_eq_abs]\n exact lt_of_le_of_lt (by nlinarith [norm_nonneg v]) hvr\n refine ⟨τ,hτpos,r',hr',e,he0,hep,?_,hesmooth,hei,hsource,?_,?_⟩\n · rw [hef]\n exact congrArg Prod.fst (hΦp τ hτ)\n · intro v hv\n have hvr : ‖v‖ < r := by simpa using hsub hv\n have hv' := hvball v hvr\n refine ⟨by rw [hef]; exact (hODE (τ,(p,v)) ⟨hτ,hv'⟩).1,?_⟩\n intro w\n have h := Helpers.coordinate_spray_endpoint_gauss hU hg hsym hKoszul hε\n (hΦ.of_le (by simp)) hΦ0 hODE hv' hτ (fun κ hκ => by\n simpa only using congrArg (fun z : E × E => z.1)\n (hscale κ τ v (by simpa [abs_of_nonneg hκ.1] using hκ.2)\n (abs_lt.mpr hτ) hvr)) w\n simpa only [funext hef] using h\n · intro v hv\n have hvr : ‖v‖ < r := by simpa using hsub hv\n apply coordinate_spray_endpoint_radial_ode Γ Φ e τ p v\n · intro t ht\n exact (hesmooth.contDiffAt (Metric.isOpen_ball.mem_nhds (hsmul v hv t ht))).differentiableAt\n (by simp)\n · intro t ht\n rw [hef]\n simpa only [mul_comm τ t] using congrArg (fun z : E × E => z.1)\n (hscale t τ v (abs_lt.mpr ht).le (abs_lt.mpr hτ) hvr)\n · intro t ht\n have htime : τ * t ∈ Set.Ioo (-ε) ε := by\n apply abs_lt.mp\n rw [abs_mul, abs_of_pos hτpos]\n calc\n τ * |t| < τ * 1 := mul_lt_mul_of_pos_left (abs_lt.mpr ht) hτpos\n _ < ε := by simpa only [mul_one] using hτ.2\n exact (hODE (τ*t,(p,v)) ⟨htime,hvball v hvr⟩).2\ntheorem exists_coordinate_normal_chart_with_radial_ode\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {U : Set E} (hU : IsOpen U)\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} (hg : ContDiffOn ℝ 1 g U)\n (hsym : ∀ x u v, g x u v = g x v u)\n {Γ : E → E →L[ℝ] E →L[ℝ] E}\n (hΓ : ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Γ U)\n (hKoszul : ∀ x ∈ U, ∀ u v w,\n 2 * g x (Γ x u v) w = (fderiv ℝ g x u) v w +\n (fderiv ℝ g x v) u w - (fderiv ℝ g x w) u v)\n {p : E} (hp : p ∈ U) :\n ∃ τ > (0:ℝ), ∃ r > (0:ℝ), ∃ e : OpenPartialHomeomorph E E,\n (0:E) ∈ e.source ∧ p ∈ e.target ∧ e 0 = p ∧\n ContDiffOn ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) e (Metric.ball 0 r) ∧\n ContDiffAt ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) e.symm p ∧\n (∀ v ∈ Metric.ball 0 r, e v ∈ U ∧ ∀ w : E,\n g (e v) (fderiv ℝ e v v) (fderiv ℝ e v w) = τ^2 * g p v w) ∧\n ∀ v ∈ Metric.ball 0 r, ∀ t ∈ Set.Ioo (-1 : ℝ) 1,\n HasDerivAt (fun s : ℝ => e (s • v)) (fderiv ℝ e (t • v) v) t ∧\n HasDerivAt (fun s : ℝ => fderiv ℝ e (s • v) v)\n (-(Γ (e (t • v)) (fderiv ℝ e (t • v) v) (fderiv ℝ e (t • v) v))) t := by\n obtain ⟨τ,hτ,r,hr,e,he0,hep,he0p,he,hei,hsource,hGauss,hODE⟩ :=\n exists_coordinate_normal_chart_with_radial_ode_source hU hg hsym hΓ hKoszul hp\n exact ⟨τ,hτ,r,hr,e,he0,hep,he0p,he,hei,hGauss,hODE⟩\ntheorem velocity_limit_of_coercive_spray\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {Γ : E → E →L[ℝ] E →L[ℝ] E}\n {x v : ℝ → E} {a b : ℝ} {p : E} {m C : ℝ}\n (hab : a < b) (hm : 0 < m)\n (hg : ContinuousAt g p) (hΓ : ContinuousAt Γ p)\n (hcoercive : ∀ w : E, m * ‖w‖ ^ 2 ≤ g p w w)\n (hx : Filter.Tendsto x (nhdsWithin b (Set.Ioo a b)) (nhds p))\n (hODE : ∀ t ∈ Set.Ioo a b, HasDerivAt v (-(Γ (x t) (v t) (v t))) t)\n (henergy : ∀ t ∈ Set.Ioo a b, g (x t) (v t) (v t) ≤ C ^ 2) :\n ∃ w : E, Filter.Tendsto v (nhdsWithin b (Set.Ioo a b)) (nhds w) := by\n have hnear : ∀ᶠ t in nhdsWithin b (Set.Ioo a b),\n ‖g (x t) - g p‖ < m / 2 ∧ ‖Γ (x t)‖ < ‖Γ p‖ + 1 := by\n filter_upwards [((hg.tendsto.comp hx).eventually\n (Metric.ball_mem_nhds (g p) (half_pos hm))),\n ((hΓ.tendsto.comp hx).eventually (Metric.ball_mem_nhds (Γ p) zero_lt_one))]\n with t ht hgammat\n change dist (g (x t)) (g p) < m / 2 at ht\n rw [dist_eq_norm (g (x t)) (g p)] at ht\n refine ⟨ht, ?_⟩\n have hd : ‖Γ (x t) - Γ p‖ < 1 := by\n change dist (Γ (x t)) (Γ p) < 1 at hgammat\n rwa [dist_eq_norm (Γ (x t)) (Γ p)] at hgammat\n have hn := norm_sub_norm_le (Γ (x t)) (Γ p)\n linarith\n rw [nhdsWithin_Ioo_eq_nhdsLT hab] at hnear\n obtain ⟨d, hdb, hd⟩ := mem_nhdsLT_iff_exists_Ioo_subset.mp hnear\n let a' := max a d\n have ha'b : a' < b := max_lt hab hdb\n let V : NNReal := ⟨2 * C ^ 2 / m + 1, by positivity⟩\n have hsub : Set.Ioo a' b ⊆ Set.Ioo a b := by\n intro t ht\n exact ⟨lt_of_le_of_lt (le_max_left _ _) ht.1, ht.2⟩\n have htail (t : ℝ) (ht : t ∈ Set.Ioo a' b) :\n ‖g (x t) - g p‖ < m / 2 ∧ ‖Γ (x t)‖ < ‖Γ p‖ + 1 :=\n hd ⟨lt_of_le_of_lt (le_max_right _ _) ht.1, ht.2⟩\n have hvbound (t : ℝ) (ht : t ∈ Set.Ioo a' b) : ‖v t‖ ≤ (V : ℝ) := by\n have hdiff : (g p - g (x t)) (v t) (v t) ≤ m / 2 * ‖v t‖ ^ 2 := by\n calc\n _ ≤ ‖(g p - g (x t)) (v t) (v t)‖ := by\n simpa only [Real.norm_eq_abs] using le_abs_self ((g p - g (x t)) (v t) (v t))\n _ ≤ ‖g p - g (x t)‖ * ‖v t‖ * ‖v t‖ :=\n (g p - g (x t)).le_opNorm₂ _ _\n _ ≤ m / 2 * ‖v t‖ ^ 2 := by\n rw [norm_sub_rev (g p) (g (x t))]\n nlinarith [mul_le_mul_of_nonneg_right (htail t ht).1.le (sq_nonneg ‖v t‖)]\n simp only [sub_apply] at hdiff\n have hco := hcoercive (v t)\n have he := henergy t (hsub ht)\n have hsq : ‖v t‖ ^ 2 ≤ 2 * C ^ 2 / m := by\n apply (le_div_iff₀ hm).mpr\n nlinarith\n change ‖v t‖ ≤ 2 * C ^ 2 / m + 1\n have hnonneg : 0 ≤ 2 * C ^ 2 / m := by positivity\n nlinarith [sq_nonneg (‖v t‖ - 1)]\n have hx' : Filter.Tendsto x (nhdsWithin b (Set.Ioo a' b)) (nhds p) := by\n simpa only [nhdsWithin_Ioo_eq_nhdsLT ha'b, nhdsWithin_Ioo_eq_nhdsLT hab] using hx\n obtain ⟨w, hw⟩ := exists_velocity_limit_of_bounded_spray_curve ha'b hΓ hx'\n ⟨V, hvbound⟩ (fun t ht => hODE t (hsub ht))\n refine ⟨w, ?_⟩\n rwa [nhdsWithin_Ioo_eq_nhdsLT ha'b, ← nhdsWithin_Ioo_eq_nhdsLT hab] at hw\ntheorem velocity_limit_of_positive_metric_spray\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]\n {g : E → E →L[ℝ] E →L[ℝ] ℝ} {Γ : E → E →L[ℝ] E →L[ℝ] E}\n {x v : ℝ → E} {a b : ℝ} {p : E} {C : ℝ}\n (hab : a < b) (hg : ContinuousAt g p) (hΓ : ContinuousAt Γ p)\n (hpos : ∀ w : E, w ≠ 0 → 0 < g p w w)\n (hx : Filter.Tendsto x (nhdsWithin b (Set.Ioo a b)) (nhds p))\n (hODE : ∀ t ∈ Set.Ioo a b, HasDerivAt v (-(Γ (x t) (v t) (v t))) t)\n (henergy : ∀ t ∈ Set.Ioo a b, g (x t) (v t) (v t) ≤ C ^ 2) :\n ∃ w : E, Filter.Tendsto v (nhdsWithin b (Set.Ioo a b)) (nhds w) := by\n obtain ⟨m, hm, hco⟩ := exists_pos_mul_norm_sq_le_bilinear (g p) hpos\n exact velocity_limit_of_coercive_spray hab hm hg hΓ hco hx hODE henergy\ntheorem exists_deriv_radial_spray_of_normal_chart\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {e : E → E} {Γ : E → E →L[ℝ] E →L[ℝ] E} {r : ℝ} (hr : 0 < r)\n (hODE : ∀ v ∈ Metric.ball 0 r, ∀ t ∈ Set.Ioo (-1 : ℝ) 1,\n HasDerivAt (fun s : ℝ => e (s • v)) (fderiv ℝ e (t • v) v) t ∧\n HasDerivAt (fun s : ℝ => fderiv ℝ e (s • v) v)\n (-(Γ (e (t • v)) (fderiv ℝ e (t • v) v)\n (fderiv ℝ e (t • v) v))) t)\n (w : E) (t₀ : ℝ) :\n ∃ δ > (0 : ℝ), ∀ t ∈ Set.Ioo (t₀ - δ) (t₀ + δ),\n HasDerivAt (fun s : ℝ => e ((s - t₀) • w))\n (fderiv ℝ e ((t - t₀) • w) w) t ∧\n HasDerivAt (fun s : ℝ => fderiv ℝ e ((s - t₀) • w) w)\n (-(Γ (e ((t - t₀) • w)) (fderiv ℝ e ((t - t₀) • w) w)\n (fderiv ℝ e ((t - t₀) • w) w))) t := by\n have hc : ContinuousAt (fun s : ℝ => s • w) 0 := continuousAt_id.smul_const w\n obtain ⟨σ, hσ, hball⟩ := Metric.mem_nhds_iff.mp\n (hc.preimage_mem_nhds (Metric.isOpen_ball.mem_nhds (Metric.mem_ball_self hr)))\n simp only [zero_smul] at hball\n let δ := σ / 2\n have hδ : 0 < δ := half_pos hσ\n have hv : δ • w ∈ Metric.ball 0 r := by\n apply hball\n simpa only [Metric.mem_ball, Real.dist_eq, sub_zero, abs_of_pos hδ] using\n (show δ < σ by dsimp [δ]; linarith)\n refine ⟨δ, hδ, ?_⟩\n intro t ht\n have htime : (t - t₀) / δ ∈ Set.Ioo (-1 : ℝ) 1 := by\n constructor\n · apply (lt_div_iff₀ hδ).mpr\n linarith [ht.1]\n · apply (div_lt_iff₀ hδ).mpr\n linarith [ht.2]\n have harg (s : ℝ) : ((s - t₀) / δ) • (δ • w) = (s - t₀) • w := by\n rw [smul_smul, div_mul_cancel₀ _ hδ.ne']\n have htimeDeriv : HasDerivAt (fun s : ℝ => (s - t₀) / δ) δ⁻¹ t := by\n simpa using ((hasDerivAt_id t).sub_const t₀).div_const δ\n have hx := ((hODE _ hv _ htime).1).scomp t htimeDeriv\n have hv' := (((hODE _ hv _ htime).2).scomp t htimeDeriv).const_smul δ⁻¹\n constructor\n · simpa only [Function.comp_def, harg, map_smul, inv_smul_smul₀ hδ.ne'] using hx\n · have hcoef : δ⁻¹ * (δ⁻¹ * (δ * δ)) = 1 := by field_simp\n convert hv' using 1\n · ext s\n simp only [Function.comp_def, Pi.smul_apply, harg, map_smul,\n inv_smul_smul₀ hδ.ne']\n · simp only [harg, map_smul, smul_apply, smul_neg, smul_smul, hcoef, one_smul]\ntheorem hasDerivWithinAt_deriv_of_spray_germ\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {x X V : ℝ → E} {Γ : E → E →L[ℝ] E →L[ℝ] E}\n {s : Set ℝ} {t₀ : ℝ} (ht₀ : t₀ ∈ s) (hs : UniqueDiffOn ℝ s)\n (hdiff : ∀ᶠ t in nhds t₀, DifferentiableAt ℝ x t)\n (hODE : ∀ᶠ t in nhds t₀,\n HasDerivAt X (V t) t ∧ HasDerivAt V (-(Γ (X t) (V t) (V t))) t)\n (hEq : x =ᶠ[nhdsWithin t₀ s] X) :\n HasDerivWithinAt (deriv x) (-(Γ (x t₀) (deriv x t₀) (deriv x t₀))) s t₀ := by\n have hdEq : deriv x =ᶠ[nhdsWithin t₀ s] V := by\n filter_upwards [hEq.derivWithin, hdiff.filter_mono nhdsWithin_le_nhds,\n hODE.filter_mono nhdsWithin_le_nhds, self_mem_nhdsWithin] with t he hd hO ht\n rw [hd.derivWithin (hs t ht), hO.1.hasDerivWithinAt.derivWithin (hs t ht)] at he\n exact he\n have hx₀ : x t₀ = X t₀ := hEq.eq_of_nhdsWithin ht₀\n have hv₀ : deriv x t₀ = V t₀ := hdEq.eq_of_nhdsWithin ht₀\n have hacc := hODE.self_of_nhds.2.hasDerivWithinAt.congr_of_eventuallyEq_of_mem hdEq ht₀\n simpa only [← hx₀, ← hv₀] using hacc\ntheorem exists_joint_inverse_of_spray_flow_linearization\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]\n {Φ : ℝ × (E × E) → E × E} {τ : ℝ} {p : E} (hτ : τ ≠ 0)\n (hΦ : ContDiffAt ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) Φ (τ, (p, 0)))\n (hΦp : Φ (τ, (p, 0)) = (p, 0))\n (hlin : ∀ u v : E,\n fderiv ℝ Φ (τ, (p, 0)) (0, (u, v)) = (u + τ • v, v)) :\n ∃ e : OpenPartialHomeomorph (E × E) (E × E),\n (p, (0 : E)) ∈ e.source ∧ (p, p) ∈ e.target ∧\n (∀ z : E × E, e z = (z.1, (Φ (τ, z)).1)) ∧\n ContDiffAt ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) e (p, 0) ∧\n ContDiffAt ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) e.symm (p, p) := by\n let f : E × E → E × E := fun z => (z.1, (Φ (τ, z)).1)\n let J : (E × E) →L[ℝ] (ℝ × (E × E)) :=\n (0 : (E × E) →L[ℝ] ℝ).prod (ContinuousLinearMap.id ℝ (E × E))\n have hι : HasFDerivAt (fun z : E × E => (τ, z)) J (p, 0) :=\n (hasFDerivAt_const τ (p, 0)).prodMk (hasFDerivAt_id (p, 0))\n have hc := hΦ.differentiableAt (by simp) |>.hasFDerivAt |>.comp (p, 0) hι\n let L : (E × E) ≃L[ℝ] (E × E) :=\n (ContinuousLinearEquiv.refl ℝ E).skewProd\n ((Units.mk0 τ hτ) • ContinuousLinearEquiv.refl ℝ E)\n (ContinuousLinearMap.id ℝ E)\n have hf' : HasFDerivAt f (L : (E × E) →L[ℝ] (E × E)) (p, 0) := by\n have hd := hasFDerivAt_fst.prodMk (hasFDerivAt_fst.comp (p, 0) hc)\n convert hd using 1\n · rfl\n · ext z <;> simp [L, J, ContinuousLinearMap.comp_apply, hlin, add_comm]\n have hf : ContDiffAt ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) f (p, 0) :=\n contDiffAt_fst.prodMk\n (contDiffAt_fst.comp (p, 0) (hΦ.comp (p, 0)\n (contDiffAt_const.prodMk contDiffAt_id)))\n let e : OpenPartialHomeomorph (E × E) (E × E) :=\n hf.toOpenPartialHomeomorph f hf' (by simp)\n have hfp : f (p, 0) = (p, p) := by\n simp only [f, hΦp]\n refine ⟨e, hf.mem_toOpenPartialHomeomorph_source hf' (by simp), ?_,\n fun _ => rfl, hf, ?_⟩\n · rw [← hfp]\n exact hf.image_mem_toOpenPartialHomeomorph_target hf' (by simp)\n · rw [← hfp]\n exact hf.to_localInverse hf' (by simp)\ntheorem exists_pair_neighborhood_of_joint_endpoint_inverse\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n {Φ : ℝ × (E × E) → E × E} {τ : ℝ} {p : E}\n (e : OpenPartialHomeomorph (E × E) (E × E))\n (he0 : (p, (0 : E)) ∈ e.source)\n (hep : e (p, 0) = (p, p))\n (hef : ∀ z : E × E, e z = (z.1, (Φ (τ, z)).1))\n (hei : ContDiffAt ℝ (↑(⊤ : ℕ∞) : WithTop ℕ∞) e.symm (p, p))\n {W : Set (E × E)} (hW : IsOpen W) (hpW : (p, (0 : E)) ∈ W) :\n ∃ ρ > (0 : ℝ), ∃ v : E × E → E,\n ContDiffOn ℝ 1 v (Metric.ball p ρ ×ˢ Metric.ball p ρ) ∧\n v (p, p) = 0 ∧\n ∀ x ∈ Metric.ball p ρ, ∀ y ∈ Metric.ball p ρ,\n (x, v (x, y)) ∈ W ∧ (x, v (x, y)) ∈ e.source ∧\n (Φ (τ, (x, v (x, y)))).1 = y := by\n obtain ⟨A, hAp, hInvA⟩ := hei.contDiffOn (m := 1) (by simp) (by simp)\n have hpt : (p, p) ∈ e.target := hep ▸ e.map_source he0\n have hback : e.symm (p, p) = (p, 0) := by rw [← hep]; exact e.left_inv he0\n have hN : A ∩ (e.target ∩ e.symm ⁻¹' W) ∈ nhds (p, p) :=\n Filter.inter_mem hAp\n ((e.isOpen_inter_preimage_symm hW).mem_nhds ⟨hpt, by\n change e.symm (p, p) ∈ W\n rwa [hback]⟩)\n obtain ⟨ρ, hρ, hsub⟩ := Metric.mem_nhds_iff.mp hN\n have hpair {x y : E} (hx : x ∈ Metric.ball p ρ) (hy : y ∈ Metric.ball p ρ) :\n (x, y) ∈ Metric.ball (p, p) ρ := by\n simpa only [Metric.mem_ball, Prod.dist_eq, max_lt_iff] using And.intro hx hy\n let v : E × E → E := fun z => (e.symm z).2\n refine ⟨ρ, hρ, v, contDiff_snd.comp_contDiffOn\n (hInvA.mono (fun z hz => (hsub (hpair hz.1 hz.2)).1)), ?_, ?_⟩\n · simp only [v, hback]\n · intro x hx y hy\n have hz := hsub (hpair hx hy)\n have hright := e.right_inv hz.2.1\n have hfirst : (e.symm (x, y)).1 = x := by\n simpa only [hef] using congrArg Prod.fst hright\n have hrep : (x, v (x, y)) = e.symm (x, y) := by\n ext <;> simp only [v, hfirst]\n refine ⟨?_, ?_, ?_⟩\n · rw [hrep]\n exact hz.2.2\n · rw [hrep]\n exact e.map_target hz.2.1\n · rw [hrep]\n simpa only [hef] using congrArg Prod.snd hright\ntheorem coordinate_spray_flow_rescale_in_common_ball\n {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]\n (Γ : E → E →L[ℝ] E →L[ℝ] E) (Φ : ℝ → E × E → E × E)\n (p q : E) {ε r R : ℝ} {K : NNReal} (hε : 0 < ε)\n (hLip : LipschitzOnWith K (fun z : E × E => (z.2, -Γ z.1 z.2 z.2))\n (Metric.ball (p, 0) R))\n (hΦ0 : ∀ v : E, ‖v‖ < r → Φ 0 (q, v) = (q, v))\n (hΦ : ∀ v : E, ‖v‖ < r → ∀ t : ℝ, |t| < ε →\n HasDerivAt (fun s => Φ s (q, v))\n ((Φ t (q, v)).2, -Γ (Φ t (q, v)).1 (Φ t (q, v)).2 (Φ t (q, v)).2) t ∧\n Φ t (q, v) ∈ Metric.ball (p, 0) R)\n (κ t : ℝ) (v : E) (hκ : |κ| ≤ 1) (ht : |t| < ε) (hv : ‖v‖ < r) :\n Φ t (q, κ • v) = ((Φ (κ * t) (q, v)).1, κ • (Φ (κ * t) (q, v)).2) := by\n have hκv : ‖κ • v‖ < r := by\n rw [norm_smul, Real.norm_eq_abs]\n exact lt_of_le_of_lt (by nlinarith [norm_nonneg v]) hv\n have htime (s : ℝ) (hs : |s| < ε) : |κ * s| < ε := by\n rw [abs_mul]\n exact lt_of_le_of_lt (by nlinarith [abs_nonneg s]) hs\n have hzero : (0 : ℝ) ∈ Set.Ioo (-ε) ε := ⟨by linarith, hε⟩\n have heq := ODE_solution_unique_of_mem_Ioo\n (v := fun _ (z : E × E) => (z.2, -Γ z.1 z.2 z.2))\n (s := fun _ => Metric.ball (p, 0) R)\n (f := fun s => Φ s (q, κ • v))\n (g := fun s => ((Φ (κ * s) (q, v)).1, κ • (Φ (κ * s) (q, v)).2))\n (fun _ _ => hLip) hzero\n (fun s hs => hΦ (κ • v) hκv s (abs_lt.mpr hs))\n (fun s hs => ⟨hasDerivAt_rescale_bilinear_spray Γ (fun τ => Φ τ (q, v)) κ s\n (hΦ v hv (κ * s) (htime s (abs_lt.mpr hs))).1,\n rescale_velocity_mem_ball hκ\n (hΦ v hv (κ * s) (htime s (abs_lt.mpr hs))).2⟩)\n (by simp only [mul_zero, hΦ0 v hv, hΦ0 (κ • v) hκv])\n exact heq (abs_lt.mp ht)\nend Submission.Helpers\n" } ], "official": { "statementRevision": 1, "submissionUrl": "https://github.com/leanprover/lean-eval-submissions/issues/2143", "resultUrl": "https://github.com/leanprover/lean-eval-submissions/issues/2143#issuecomment-6215093969", "resultBody": "## Submission result\n\n✅ Newly-solved problems: dimitrov, hopf_rinow\n\nAttempted 2 / 2; succeeded on 2.\n\n### Per-problem\n- `dimitrov`: pass\n- `hopf_rinow`: pass", "sourceUrl": "https://github.com/LikC1606/deepscientist-math-proofs/tree/b6909c3211863eac52c040c8812da3df4ce3af4d", "sourceCommit": "b6909c3211863eac52c040c8812da3df4ce3af4d", "checksums": { "Submission.lean": "168812f88c0fa82777a53cb700e391f6deab564ad2b210900c7573e72d0c365a", "Submission/Helpers.lean": "f62e16b14fff319f20788b03d94cf9de1262dcfa0cc6462b539faa5435573c40", "lake-manifest.json": "c2ffad9c26904466069938f1f6c908f6a3202256c234a0328436724b4666f262", "lakefile.toml": "f8d06e68d8482247f0d18cad71c175fdcb03ca1a68a30a055bca2bde8485bdb2", "lean-toolchain": "bc84812c94489d1e3e191baa1dc10d5eb684382d7fe9d2a5ab085e72c1c67e47", "verification.json": "643a4d170f18ff873081d03b9547471f33961e7caaa6423b614d30babea14649" } }, "local": { "status": "official_verified", "kernelVerified": true, "comparator": "official_verified", "receipt": "official-27c7700c026006db16d251ef", "sourceProofCommit": "54aef14c8bf34ccce36c9a0918be9a39a8bfd1dc", "sourceBinding": "matches", "axioms": [], "url": "https://github.com/LikC1606/theorem-os-site/blob/main/accepted/hopf_rinow/verification.json" } }, { "id": "szemeredi", "title": "Szemerédi", "subtitle": "正上密度集合中的等差数列", "area": "组合数学", "summary": "正上密度的自然数集合包含任意长等差数列。当前档案记录研究过程，尚未获得官方验收。", "declaration": "theorem szemeredi", "en": { "subtitle": "Arithmetic progressions in sets of positive upper density", "area": "Combinatorics", "summary": "A set of natural numbers with positive upper density contains arbitrarily long arithmetic progressions. This archive records the research process; it has no official acceptance yet." }, "status": "in_progress_not_officially_accepted", "model": "gpt-6.1-sol", "updatedAt": "2026-10-15T18:47:55.276997+00:00", "archiveUrl": "https://github.com/LikC1606/theorem-os-site/tree/main/in-progress/szemeredi", "sources": [ { "name": "Submission.lean", "path": "in-progress/szemeredi/workers/solver/generated/szemeredi/Submission.lean", "url": "https://github.com/LikC1606/theorem-os-site/blob/main/in-progress/szemeredi/workers/solver/generated/szemeredi/Submission.lean", "sha256": "7cd1ea26c35efe9b5ba4ad554154a115b12cd5b0124e42b23492c624dfafa2e7", "lines": 288, "code": "import ChallengeDeps\nimport Submission.Helpers\n\nopen LeanEval.Combinatorics\nopen scoped BigOperators\n\nnamespace Submission\n\ntheorem dense_prefixes (A : Set ℕ) (h : 0 < upperDensity A) :\n ∃ epsilon : ℝ, 0 < epsilon ∧ ∀ N : ℕ, ∃ n : ℕ, N ≤ n ∧\n epsilon * ((n : ℝ) + 1) <\n (Finset.range (n + 1)).sum (A.indicator (fun _ => (1 : ℝ))) := by\n let d : ℕ → ℝ := fun n =>\n (Finset.range (n + 1)).sum (A.indicator (fun _ => (1 : ℝ))) /\n ((n : ℝ) + 1)\n have hd : ∀ n, 0 ≤ d n := by\n intro n\n exact div_nonneg\n (Finset.sum_nonneg fun k _ => Set.indicator_nonneg (by intros; norm_num) k)\n (by positivity)\n have hhalf : upperDensity A / 2 < Filter.limsup d Filter.atTop := by\n change upperDensity A / 2 < upperDensity A\n linarith\n have hfreq := Filter.frequently_lt_of_lt_limsup\n (Filter.isCoboundedUnder_le_of_le Filter.atTop hd) hhalf\n refine ⟨upperDensity A / 2, half_pos h, ?_⟩\n intro N\n obtain ⟨n, hn, hdense⟩ := Filter.frequently_atTop.mp hfreq N\n refine ⟨n, hn, ?_⟩\n exact (lt_div_iff₀ (by positivity : 0 < (n : ℝ) + 1)).mp hdense\ntheorem szemeredi_of_finite_density\n (hfinite : ∀ (k : ℕ) (epsilon : ℝ), 0 < epsilon → ∃ N : ℕ,\n ∀ n : ℕ, N ≤ n → ∀ s : Finset ℕ, s ⊆ Finset.range n →\n epsilon * (n : ℝ) ≤ (s.card : ℝ) →\n ∃ a b : ℕ, 1 ≤ b ∧ ∀ j : ℕ, j < k → a + b * j ∈ s) :\n ∀ (A : Set ℕ), 0 < upperDensity A → ContainsArbitraryAPs A := by\n classical\n intro A hA k\n obtain ⟨epsilon, hepsilon, hdense⟩ := dense_prefixes A hA\n obtain ⟨N, hN⟩ := hfinite k epsilon hepsilon\n obtain ⟨n, hn, hcard⟩ := hdense N\n let s := (Finset.range (n + 1)).filter (fun x => x ∈ A)\n have hsum : (Finset.range (n + 1)).sum (A.indicator (fun _ => (1 : ℝ))) =\n (s.card : ℝ) := by\n calc\n _ = ∑ x ∈ s, (1 : ℝ) := by\n simp only [s, Finset.sum_filter, Set.indicator_apply]\n _ = (s.card : ℝ) := by simp\n have hs : epsilon * ((n + 1 : ℕ) : ℝ) ≤ (s.card : ℝ) := by\n simpa only [Nat.cast_add, Nat.cast_one] using hcard.le.trans_eq hsum\n obtain ⟨a, b, hb, hap⟩ :=\n hN (n + 1) (by omega) s (Finset.filter_subset _ _) hs\n refine ⟨a, b, hb, ?_⟩\n intro j hj\n exact (Finset.mem_filter.mp (hap j hj)).2\n\ntheorem not_threeAPFree_of_positive_upperDensity (A : Set ℕ)\n (h : 0 < upperDensity A) : ¬ ThreeAPFree A := by\n classical\n obtain ⟨epsilon, hepsilon, hdense⟩ := dense_prefixes A h\n obtain ⟨N, hN⟩ := Helpers.finite_density_not_threeAPFree epsilon hepsilon\n obtain ⟨n, hn, hcard⟩ := hdense N\n let s := (Finset.range (n + 1)).filter (fun x => x ∈ A)\n have hsum : (Finset.range (n + 1)).sum (A.indicator (fun _ => (1 : ℝ))) =\n (s.card : ℝ) := by\n calc\n _ = ∑ x ∈ s, (1 : ℝ) := by\n simp only [s, Finset.sum_filter, Set.indicator_apply]\n _ = (s.card : ℝ) := by simp\n have hs : epsilon * ((n + 1 : ℕ) : ℝ) ≤ (s.card : ℝ) := by\n simpa only [Nat.cast_add, Nat.cast_one] using hcard.le.trans_eq hsum\n have hnot := hN (n + 1) (by omega) s (Finset.filter_subset _ _) hs\n intro hfree\n exact hnot (hfree.mono (by\n intro x hx\n exact (Finset.mem_filter.mp hx).2))\n\ntheorem progressions_of_length_le_three (A : Set ℕ) (h : 0 < upperDensity A)\n (k : ℕ) (hk : k ≤ 3) :\n ∃ a b : ℕ, 1 ≤ b ∧ ∀ j : ℕ, j < k → a + b * j ∈ A := by\n obtain ⟨a, b, hb, hap⟩ := Helpers.ap3_of_not_threeAPFree A\n (not_threeAPFree_of_positive_upperDensity A h)\n exact ⟨a, b, hb, fun j hj => hap j (lt_of_lt_of_le hj hk)⟩\n\ntheorem dense_prefixes_above (A : Set ℕ) (epsilon : ℝ)\n (hepsilon : epsilon < upperDensity A) :\n ∀ N : ℕ, ∃ n : ℕ, N ≤ n ∧\n epsilon * ((n : ℝ) + 1) <\n (Finset.range (n + 1)).sum (A.indicator (fun _ => (1 : ℝ))) := by\n let d : ℕ → ℝ := fun n =>\n (Finset.range (n + 1)).sum (A.indicator (fun _ => (1 : ℝ))) /\n ((n : ℝ) + 1)\n have hd : ∀ n, 0 ≤ d n := by\n intro n\n exact div_nonneg\n (Finset.sum_nonneg fun k _ => Set.indicator_nonneg (by intros; norm_num) k)\n (by positivity)\n have hfreq := Filter.frequently_lt_of_lt_limsup\n (Filter.isCoboundedUnder_le_of_le Filter.atTop hd)\n (show epsilon < Filter.limsup d Filter.atTop from hepsilon)\n intro N\n obtain ⟨n, hn, hdense⟩ := Filter.frequently_atTop.mp hfreq N\n exact ⟨n, hn, (lt_div_iff₀ (by positivity : 0 < (n : ℝ) + 1)).mp hdense⟩\n\ntheorem consecutive_of_upperDensity_gt (A : Set ℕ) (k : ℕ) (hk : 0 < k)\n (h : ((k - 1 : ℕ) : ℝ) < upperDensity A * (k : ℝ)) :\n ∃ a : ℕ, ∀ j : ℕ, j < k → a + j ∈ A := by\n classical\n have hkreal : (0 : ℝ) < k := Nat.cast_pos.mpr hk\n obtain ⟨epsilon, hepsilon, hlt⟩ :=\n exists_between ((div_lt_iff₀ hkreal).mpr h)\n obtain ⟨N, hN⟩ := Helpers.finite_density_consecutive k hk epsilon\n ((div_lt_iff₀ hkreal).mp hepsilon)\n obtain ⟨n, hn, hcard⟩ := dense_prefixes_above A epsilon hlt N\n let s := (Finset.range (n + 1)).filter (fun x => x ∈ A)\n have hsum : (Finset.range (n + 1)).sum (A.indicator (fun _ => (1 : ℝ))) =\n (s.card : ℝ) := by\n calc\n _ = ∑ x ∈ s, (1 : ℝ) := by\n simp only [s, Finset.sum_filter, Set.indicator_apply]\n _ = (s.card : ℝ) := by simp\n have hs : epsilon * ((n + 1 : ℕ) : ℝ) ≤ (s.card : ℝ) := by\n simpa only [Nat.cast_add, Nat.cast_one] using hcard.le.trans_eq hsum\n obtain ⟨a, ha⟩ := hN (n + 1) (by omega) s (Finset.filter_subset _ _) hs\n exact ⟨a, fun j hj => (Finset.mem_filter.mp (ha j hj)).2⟩\n\ntheorem szemeredi_of_upperDensity_eq_one (A : Set ℕ) (h : upperDensity A = 1) :\n ContainsArbitraryAPs A := by\n intro k\n by_cases hk : k = 0\n · exact ⟨0, 1, by omega, by simp [hk]⟩\n have hkpos : 0 < k := Nat.pos_of_ne_zero hk\n obtain ⟨a, ha⟩ := consecutive_of_upperDensity_gt A k hkpos (by\n rw [h, one_mul]\n exact_mod_cast Nat.sub_lt hkpos (by omega : 0 < 1))\n exact ⟨a, 1, by omega, by simpa using ha⟩\n\ntheorem upperDensity_le_one (A : Set ℕ) : upperDensity A ≤ 1 := by\n let d : ℕ → ℝ := fun n =>\n (Finset.range (n + 1)).sum (A.indicator (fun _ => (1 : ℝ))) /\n ((n : ℝ) + 1)\n have hd : ∀ n, 0 ≤ d n := by\n intro n\n exact div_nonneg\n (Finset.sum_nonneg fun k _ => Set.indicator_nonneg (by intros; norm_num) k)\n (by positivity)\n apply Filter.limsup_le_of_le\n (Filter.isCoboundedUnder_le_of_le Filter.atTop hd)\n apply Filter.Eventually.of_forall\n intro n\n change _ / ((n : ℝ) + 1) ≤ 1\n apply (div_le_iff₀ (by positivity : 0 < (n : ℝ) + 1)).mpr\n have hsum : (Finset.range (n + 1)).sum (A.indicator (fun _ => (1 : ℝ))) ≤\n ∑ _ ∈ Finset.range (n + 1), (1 : ℝ) := by\n apply Finset.sum_le_sum\n intro k hk\n by_cases hka : k ∈ A <;> simp [hka]\n simpa using hsum\n\ntheorem szemeredi_of_affine_density_increment\n (hincrement : ∀ (k : ℕ) (epsilon0 : ℝ), 0 < epsilon0 →\n ∃ delta : ℝ, 0 < delta ∧\n ∀ eta : ℝ, epsilon0 ≤ eta → eta ≤ 1 → ∀ M : ℕ,\n ∃ N : ℕ, ∀ n : ℕ, N ≤ n → ∀ s : Finset ℕ,\n s ⊆ Finset.range n → eta * (n : ℝ) ≤ (s.card : ℝ) →\n (∃ a b : ℕ, 1 ≤ b ∧ ∀ j : ℕ, j < k → a + b * j ∈ s) ∨\n ∃ m u v : ℕ, M ≤ m ∧ 1 ≤ v ∧\n (eta + delta) * (m : ℝ) ≤\n (((Finset.range m).filter (fun x => u + v * x ∈ s)).card : ℝ)) :\n ∀ (A : Set ℕ), 0 < upperDensity A → ContainsArbitraryAPs A := by\n classical\n apply szemeredi_of_finite_density\n intro k epsilon0 hepsilon0\n obtain ⟨delta, hdelta, hinc⟩ := hincrement k epsilon0 hepsilon0\n apply Helpers.finite_density_ap_of_increment k epsilon0 delta hdelta\n intro eta heta htop M\n obtain ⟨N, hN⟩ := hinc eta heta htop M\n refine ⟨N, ?_⟩\n intro n hn s hs hdense\n rcases hN n hn s hs hdense with hap | hnew\n · exact Or.inl hap\n · obtain ⟨m, u, v, hm, hv, hdense'⟩ := hnew\n let t := (Finset.range m).filter (fun x => u + v * x ∈ s)\n refine Or.inr ⟨m, hm, t, Finset.filter_subset _ _, hdense', ?_⟩\n apply Helpers.ap_of_affine_indices s t u v k hv\n intro x hx\n exact (Finset.mem_filter.mp hx).2\n\ntheorem progressions_of_square_density (A : Set ℕ) (k : ℕ) (hk : 3 ≤ k)\n (h : ((k * (k - 1) - 1 : ℕ) : ℝ) <\n upperDensity A * ((k * k : ℕ) : ℝ)) :\n ∃ a b : ℕ, 1 ≤ b ∧ ∀ j : ℕ, j < k → a + b * j ∈ A := by\n classical\n have hm : (0 : ℝ) < ((k * k : ℕ) : ℝ) :=\n Nat.cast_pos.mpr (Nat.mul_pos (by omega) (by omega))\n obtain ⟨epsilon, hepsilon, hlt⟩ := exists_between ((div_lt_iff₀ hm).mpr h)\n obtain ⟨N, hN⟩ := Helpers.finite_density_square k hk epsilon\n ((div_lt_iff₀ hm).mp hepsilon)\n obtain ⟨n, hn, hcard⟩ := dense_prefixes_above A epsilon hlt N\n let s := (Finset.range (n + 1)).filter (fun x => x ∈ A)\n have hsum : (Finset.range (n + 1)).sum (A.indicator (fun _ => (1 : ℝ))) =\n (s.card : ℝ) := by\n calc\n _ = ∑ x ∈ s, (1 : ℝ) := by\n simp only [s, Finset.sum_filter, Set.indicator_apply]\n _ = (s.card : ℝ) := by simp\n have hs : epsilon * ((n + 1 : ℕ) : ℝ) ≤ (s.card : ℝ) := by\n simpa only [Nat.cast_add, Nat.cast_one] using hcard.le.trans_eq hsum\n obtain ⟨a, b, hb, ha⟩ :=\n hN (n + 1) (by omega) s (Finset.filter_subset _ _) hs\n exact ⟨a, b, hb, fun j hj => (Finset.mem_filter.mp (ha j hj)).2⟩\n\ntheorem progressions_of_bounded_gaps (A : Set ℕ) (D : ℕ)\n (hgap : ∀ n : ℕ, ∃ t : ℕ, t < D ∧ n + t ∈ A) :\n ContainsArbitraryAPs A := by\n classical\n choose t ht hmem using hgap\n let C : ℕ → Fin D := fun n => ⟨t n, ht n⟩\n intro k\n obtain ⟨N, hN, hmono⟩ := Helpers.finite_van_der_waerden k D\n obtain ⟨a, b, hb, c, hap⟩ := hmono C\n refine ⟨a + c.val, b, hb, ?_⟩\n intro j hj\n have hc := congrArg Fin.val (hap j hj).2\n change t (a + b * j) = c.val at hc\n have hm := hmem (a + b * j)\n rw [hc] at hm\n simpa only [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hm\n\ntheorem progressions_of_piecewise_bounded_gaps (A : Set ℕ) (D : ℕ)\n (hblocks : ∀ L : ℕ, ∃ u : ℕ, ∀ i : ℕ, i < L →\n ∃ t : ℕ, t < D ∧ u + i + t ∈ A) :\n ContainsArbitraryAPs A := by\n classical\n have hD : 1 ≤ D := by\n obtain ⟨u, hu⟩ := hblocks 1\n obtain ⟨t, ht, _⟩ := hu 0 (by omega)\n omega\n intro k\n obtain ⟨N, hN, hmono⟩ := Helpers.finite_van_der_waerden_on_interval k D hD\n obtain ⟨u, hu⟩ := hblocks N\n have hchoose : ∀ i : Fin N, ∃ t : Fin D, u + i.val + t.val ∈ A := by\n intro i\n obtain ⟨t, ht, hmem⟩ := hu i.val i.isLt\n exact ⟨⟨t, ht⟩, hmem⟩\n choose C hC using hchoose\n obtain ⟨a, b, hb, c, hap⟩ := hmono C\n refine ⟨u + a + c.val, b, hb, ?_⟩\n intro j hj\n obtain ⟨hbound, hcolor⟩ := hap j hj\n have hm := hC ⟨a + b * j, hbound⟩\n have hc := congrArg Fin.val hcolor\n rw [hc] at hm\n simpa only [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hm\n\ntheorem szemeredi (A : Set ℕ) (h : 0 < upperDensity A) :\n ContainsArbitraryAPs A := by\n intro k\n by_cases hk : k ≤ 3\n · exact progressions_of_length_le_three A h k hk\n have hkpos : 0 < k := by omega\n by_cases hdense : ((k - 1 : ℕ) : ℝ) < upperDensity A * (k : ℝ)\n · obtain ⟨a, ha⟩ := consecutive_of_upperDensity_gt A k hkpos hdense\n exact ⟨a, 1, by omega, by simpa using ha⟩\n have hkfour : 4 ≤ k := by omega\n have hsmall : upperDensity A * (k : ℝ) ≤ ((k - 1 : ℕ) : ℝ) :=\n le_of_not_gt hdense\n by_cases hsquare : ((k * (k - 1) - 1 : ℕ) : ℝ) <\n upperDensity A * ((k * k : ℕ) : ℝ)\n · exact progressions_of_square_density A k (by omega) hsquare\n have hsquare_small : upperDensity A * ((k * k : ℕ) : ℝ) ≤\n ((k * (k - 1) - 1 : ℕ) : ℝ) := le_of_not_gt hsquare\n by_cases hbounded : ∃ D : ℕ, ∀ n : ℕ, ∃ t : ℕ, t < D ∧ n + t ∈ A\n · obtain ⟨D, hgap⟩ := hbounded\n exact progressions_of_bounded_gaps A D hgap k\n have hunbounded : ∀ D : ℕ, ∃ n : ℕ, ∀ t : ℕ, t < D → n + t ∉ A := by\n simpa only [not_exists, not_forall, not_and] using hbounded\n by_cases hpiece : ∃ D : ℕ, ∀ L : ℕ, ∃ u : ℕ, ∀ i : ℕ, i < L →\n ∃ t : ℕ, t < D ∧ u + i + t ∈ A\n · obtain ⟨D, hblocks⟩ := hpiece\n exact progressions_of_piecewise_bounded_gaps A D hblocks k\n have hnotpiece : ∀ D : ℕ, ∃ L : ℕ, ∀ u : ℕ, ∃ i : ℕ,\n i < L ∧ ∀ t : ℕ, t < D → u + i + t ∉ A := by\n push Not at hpiece\n exact hpiece\n sorry\n\nend Submission\n" }, { "name": "Challenge.lean", "path": "in-progress/szemeredi/workers/solver/generated/szemeredi/Challenge.lean", "url": "https://github.com/LikC1606/theorem-os-site/blob/main/in-progress/szemeredi/workers/solver/generated/szemeredi/Challenge.lean", "sha256": "de186e07ba9c4d04a23e2c68cc5084d4ff00c68219a1bff6c97a69118c7caf7c", "lines": 8, "code": "import ChallengeDeps\n\nopen LeanEval.Combinatorics\nopen scoped BigOperators\n\ntheorem szemeredi (A : Set ℕ) (h : 0 < upperDensity A) :\n ContainsArbitraryAPs A := by\n sorry\n" }, { "name": "Submission/Helpers.lean", "path": "in-progress/szemeredi/workers/solver/generated/szemeredi/Submission/Helpers.lean", "url": "https://github.com/LikC1606/theorem-os-site/blob/main/in-progress/szemeredi/workers/solver/generated/szemeredi/Submission/Helpers.lean", "sha256": "dbb1af63ef56f21a7e9e5ba5543a20c060d4220f95e24db54e8fbf3d8f3c9bd9", "lines": 1240, "code": "import Mathlib.Combinatorics.Additive.Corner.Roth\nimport Mathlib.Combinatorics.Additive.AP.Three.Behrend\nimport Mathlib.Combinatorics.Pigeonhole\nimport Mathlib.Combinatorics.HalesJewett\nimport Mathlib.Tactic\nimport Mathlib.Algebra.Order.BigOperators.Expect\n\nnamespace Submission.Helpers\n\ntheorem ternary_cube_threeAPFree (m : ℕ) :\n ThreeAPFree ((Behrend.map 3) ''\n {e : Fin m → ℕ | ∀ i, e i < 2}) := by\n have hfree : ThreeAPFree {e : Fin m → ℕ | ∀ i, e i < 2} := by\n intro x hx y hy z hz hsum\n funext i\n have hi := congrFun hsum i\n have hxi := hx i\n have hyi := hy i\n have hzi := hz i\n change x i + z i = y i + y i at hi\n omega\n apply ThreeAPFree.image' (Behrend.map 3) ?_ hfree\n apply Behrend.map_injOn.mono\n rw [Set.add_subset_iff]\n intro x hx y hy i\n change x i + y i < 3\n have hxi := hx i\n have hyi := hy i\n omega\n\ntheorem subset_sum_cubes_do_not_force_ap (m : ℕ) :\n ∃ s : Finset ℕ,\n (∀ t : Finset (Fin m), (∑ i ∈ t, 3 ^ (i : ℕ)) ∈ s) ∧\n ¬ (∃ a b : ℕ, 1 ≤ b ∧ ∀ j : ℕ, j < 3 → a + b * j ∈ s) := by\n classical\n let s := (Behrend.box m 2).image (Behrend.map 3)\n have hfree : ThreeAPFree (s : Set ℕ) := by\n have hbox : (Behrend.box m 2 : Set (Fin m → ℕ)) =\n {e : Fin m → ℕ | ∀ i, e i < 2} := by\n ext e\n exact Behrend.mem_box\n simpa only [s, Finset.coe_image, hbox] using ternary_cube_threeAPFree m\n refine ⟨s, ?_, ?_⟩\n · intro t\n refine Finset.mem_image.mpr ⟨(fun i => if i ∈ t then 1 else 0), ?_, ?_⟩\n · rw [Behrend.mem_box]\n intro i\n split_ifs <;> omega\n · simp [Behrend.map_apply]\n · rintro ⟨a, b, hb, hap⟩\n have h0 := hap 0 (by omega)\n have h1 := hap 1 (by omega)\n have h2 := hap 2 (by omega)\n have heq := hfree h0 h1 h2 (by omega)\n omega\n\ntheorem ap3_of_not_threeAPFree (A : Set Nat) (h : ¬ ThreeAPFree A) :\n ∃ a b : Nat, 1 ≤ b ∧ ∀ j : Nat, j < 3 → a + b * j ∈ A := by\n classical\n have ordered (x y z : Nat) (hx : x ∈ A) (hy : y ∈ A) (hz : z ∈ A)\n (hsum : x + z = y + y) (hxy : x < y) :\n ∃ a b : Nat, 1 ≤ b ∧ ∀ j : Nat, j < 3 → a + b * j ∈ A := by\n refine ⟨x, y - x, by omega, ?_⟩\n intro j hj\n have hj' : j = 0 ∨ j = 1 ∨ j = 2 := by omega\n rcases hj' with rfl | rfl | rfl\n · simpa using hx\n · have heq : x + (y - x) * 1 = y := by omega\n rwa [heq]\n · have heq : x + (y - x) * 2 = z := by omega\n rwa [heq]\n unfold ThreeAPFree at h\n push Not at h\n obtain ⟨x, hx, y, hy, z, hz, hsum, hne⟩ := h\n by_cases hxy : x < y\n · exact ordered x y z hx hy hz hsum hxy\n · exact ordered z y x hz hy hx (by omega) (by omega)\n\ntheorem finite_density_not_threeAPFree (epsilon : ℝ) (hepsilon : 0 < epsilon) :\n ∃ N : ℕ, ∀ n : ℕ, N ≤ n → ∀ s : Finset ℕ,\n s ⊆ Finset.range n → epsilon * (n : ℝ) ≤ (s.card : ℝ) →\n ¬ ThreeAPFree (s : Set ℕ) := by\n refine ⟨cornersTheoremBound (epsilon / 3), ?_⟩\n intro n hn s hs hd\n exact roth_3ap_theorem_nat epsilon hepsilon hn s hs hd\n\ntheorem finite_density_short_progressions (k : ℕ) (hk : k ≤ 3)\n (epsilon : ℝ) (hepsilon : 0 < epsilon) :\n ∃ N : ℕ, ∀ n : ℕ, N ≤ n → ∀ s : Finset ℕ,\n s ⊆ Finset.range n → epsilon * (n : ℝ) ≤ (s.card : ℝ) →\n ∃ a b : ℕ, 1 ≤ b ∧ ∀ j : ℕ, j < k → a + b * j ∈ s := by\n obtain ⟨N, hN⟩ := finite_density_not_threeAPFree epsilon hepsilon\n refine ⟨N, ?_⟩\n intro n hn s hs hd\n obtain ⟨a, b, hb, hap⟩ := ap3_of_not_threeAPFree (s : Set ℕ) (hN n hn s hs hd)\n exact ⟨a, b, hb, fun j hj => hap j (lt_of_lt_of_le hj hk)⟩\n\ntheorem consecutive_of_card_gt_blocks (k n : ℕ) (hk : 0 < k)\n (s : Finset ℕ) (hs : s ⊆ Finset.range n)\n (hcard : (n / k + 1) * (k - 1) < s.card) :\n ∃ a : ℕ, ∀ j : ℕ, j < k → a + j ∈ s := by\n have hmaps : ∀ x ∈ s, x / k ∈ Finset.range (n / k + 1) := by\n intro x hx\n apply Finset.mem_range.mpr\n exact Nat.lt_succ_of_le\n (Nat.div_le_div_right (Nat.le_of_lt (Finset.mem_range.mp (hs hx))))\n obtain ⟨a, ha, hlarge⟩ :=\n Finset.exists_lt_card_fiber_of_mul_lt_card_of_maps_to hmaps\n (by simpa only [Finset.card_range] using hcard)\n let block := (Finset.range k).image (fun j => k * a + j)\n have hsub : s.filter (fun x => x / k = a) ⊆ block := by\n intro x hx\n obtain ⟨_, hxa⟩ := Finset.mem_filter.mp hx\n refine Finset.mem_image.mpr ⟨x % k, Finset.mem_range.mpr (Nat.mod_lt x hk), ?_⟩\n rw [← hxa]\n exact Nat.div_add_mod x k\n have hblock : block.card = k := by\n rw [Finset.card_image_of_injective _ (fun x y hxy => Nat.add_left_cancel hxy)]\n exact Finset.card_range k\n have hfull : s.filter (fun x => x / k = a) = block := by\n apply Finset.eq_of_subset_of_card_le hsub\n rw [hblock]\n omega\n refine ⟨k * a, ?_⟩\n intro j hj\n have hmem : k * a + j ∈ block :=\n Finset.mem_image.mpr ⟨j, Finset.mem_range.mpr hj, rfl⟩\n rw [← hfull] at hmem\n exact (Finset.mem_filter.mp hmem).1\n\ntheorem finite_density_consecutive (k : ℕ) (hk : 0 < k) (epsilon : ℝ)\n (hepsilon : ((k - 1 : ℕ) : ℝ) < epsilon * (k : ℝ)) :\n ∃ N : ℕ, ∀ n : ℕ, N ≤ n → ∀ s : Finset ℕ,\n s ⊆ Finset.range n → epsilon * (n : ℝ) ≤ (s.card : ℝ) →\n ∃ a : ℕ, ∀ j : ℕ, j < k → a + j ∈ s := by\n have hkreal : (0 : ℝ) < k := Nat.cast_pos.mpr hk\n have hgap : 0 < epsilon * (k : ℝ) - ((k - 1 : ℕ) : ℝ) := sub_pos.mpr hepsilon\n obtain ⟨N, hN⟩ := exists_nat_gt\n ((k : ℝ) * ((k - 1 : ℕ) : ℝ) /\n (epsilon * (k : ℝ) - ((k - 1 : ℕ) : ℝ)))\n refine ⟨N, ?_⟩\n intro n hn s hs hd\n apply consecutive_of_card_gt_blocks k n hk s hs\n have hbound := (div_lt_iff₀ hgap).mp hN\n have hmon := mul_le_mul_of_nonneg_left (Nat.cast_le.mpr hn : (N : ℝ) ≤ n) hgap.le\n have hdiv : ((n / k : ℕ) : ℝ) * (k : ℝ) ≤ (n : ℝ) := by\n exact_mod_cast Nat.div_mul_le_self n k\n have hmul := mul_le_mul_of_nonneg_right hdiv\n (by positivity : (0 : ℝ) ≤ ((k - 1 : ℕ) : ℝ))\n have hd' := mul_le_mul_of_nonneg_left hd hkreal.le\n have hcard : ((((n / k + 1) * (k - 1) : ℕ) : ℝ)) < (s.card : ℝ) := by\n apply (mul_lt_mul_iff_right₀ hkreal).mp\n push_cast\n nlinarith\n exact_mod_cast hcard\n\ntheorem ap_of_aligned_grid (A : Set Nat) (a b c k r : Nat) (hk : 0 < k)\n (hc : c = b * k)\n (hgrid : ∀ i : Nat, i < r → ∀ j : Nat, j < k → a + c * i + b * j ∈ A) :\n ∀ m : Nat, m < r * k → a + b * m ∈ A := by\n intro m hm\n have hi : m / k < r := (Nat.div_lt_iff_lt_mul hk).mpr hm\n have h := hgrid (m / k) hi (m % k) (Nat.mod_lt m hk)\n have heq : a + c * (m / k) + b * (m % k) = a + b * m := by\n rw [hc]\n calc\n _ = a + b * (m % k + k * (m / k)) := by ring\n _ = a + b * m := by rw [Nat.mod_add_div]\n rwa [heq] at h\n\ntheorem finite_common_extension (s t u : Finset Nat) (hs : s ⊆ u) (ht : t ⊆ u)\n (hcard : u.card < s.card + t.card) : ∃ a : Nat, a ∈ s ∧ a ∈ t := by\n classical\n have hbound : (s ∪ t).card ≤ u.card :=\n Finset.card_le_card (Finset.union_subset hs ht)\n have hsum := Finset.card_union_add_card_inter s t\n have hnonempty : (s ∩ t).Nonempty := Finset.card_pos.mp (by omega)\n obtain ⟨a, ha⟩ := hnonempty\n exact ⟨a, Finset.mem_inter.mp ha⟩\n\ntheorem ap_succ_of_start_end_card (s : Finset Nat) (n k b : Nat) (hb : 1 ≤ b)\n (hcard : n <\n ((Finset.range n).filter (fun a => ∀ j : Nat, j < k → a + b * j ∈ s)).card +\n ((Finset.range n).filter (fun a => a + b * k ∈ s)).card) :\n ∃ a : Nat, 1 ≤ b ∧ ∀ j : Nat, j < k + 1 → a + b * j ∈ s := by\n classical\n obtain ⟨a, hstart, hend⟩ := finite_common_extension\n ((Finset.range n).filter (fun a => ∀ j : Nat, j < k → a + b * j ∈ s))\n ((Finset.range n).filter (fun a => a + b * k ∈ s))\n (Finset.range n) (Finset.filter_subset _ _) (Finset.filter_subset _ _)\n (by simpa only [Finset.card_range] using hcard)\n refine ⟨a, hb, ?_⟩\n intro j hj\n rcases Nat.lt_or_eq_of_le (Nat.le_of_lt_succ hj) with hjk | rfl\n · exact (Finset.mem_filter.mp hstart).2 j hjk\n · exact (Finset.mem_filter.mp hend).2\n\ntheorem ap_of_affine_indices (s t : Finset ℕ) (u v k : ℕ) (hv : 1 ≤ v)\n (ht : ∀ x ∈ t, u + v * x ∈ s)\n (hap : ∃ a b : ℕ, 1 ≤ b ∧ ∀ j : ℕ, j < k → a + b * j ∈ t) :\n ∃ a b : ℕ, 1 ≤ b ∧ ∀ j : ℕ, j < k → a + b * j ∈ s := by\n obtain ⟨a, b, hb, hab⟩ := hap\n refine ⟨u + v * a, v * b, by nlinarith, ?_⟩\n intro j hj\n convert ht (a + b * j) (hab j hj) using 1\n ring\n\ntheorem card_affine_indices (s : Finset ℕ) (u v m : ℕ) (hv : 1 ≤ v) :\n (((Finset.range m).filter (fun x => u + v * x ∈ s)).image\n (fun x => u + v * x)).card =\n ((Finset.range m).filter (fun x => u + v * x ∈ s)).card := by\n apply Finset.card_image_of_injective\n intro x y hxy\n have heq : v * x = v * y := Nat.add_left_cancel hxy\n exact Nat.eq_of_mul_eq_mul_left (by omega : 0 < v) heq\n\ntheorem density_above_one_impossible (eta : ℝ) (heta : 1 < eta)\n (n : Nat) (hn : 1 ≤ n) (s : Finset Nat) (hs : s ⊆ Finset.range n)\n (hdensity : eta * (n : ℝ) ≤ (s.card : ℝ)) : False := by\n have hcard : (s.card : ℝ) ≤ (n : ℝ) := by\n exact_mod_cast (Finset.card_le_card hs).trans_eq (Finset.card_range n)\n have hnpos : (0 : ℝ) < n := by exact_mod_cast (by omega : 0 < n)\n have hlt := mul_lt_mul_of_pos_right heta hnpos\n nlinarith\n\ntheorem finite_density_of_increment (P : Finset Nat → Prop) (epsilon0 delta : ℝ)\n (hdelta : 0 < delta)\n (hincrement : ∀ eta : ℝ, epsilon0 ≤ eta → eta ≤ 1 → ∀ M : Nat,\n ∃ N : Nat, ∀ n : Nat, N ≤ n → ∀ s : Finset Nat,\n s ⊆ Finset.range n → eta * (n : ℝ) ≤ (s.card : ℝ) →\n P s ∨ ∃ m : Nat, M ≤ m ∧ ∃ t : Finset Nat,\n t ⊆ Finset.range m ∧ (eta + delta) * (m : ℝ) ≤ (t.card : ℝ) ∧\n (P t → P s)) :\n ∃ N : Nat, 1 ≤ N ∧ ∀ n : Nat, N ≤ n → ∀ s : Finset Nat,\n s ⊆ Finset.range n → epsilon0 * (n : ℝ) ≤ (s.card : ℝ) → P s := by\n have terminate : ∀ r : Nat, ∀ eta : ℝ, epsilon0 ≤ eta →\n 1 < eta + (r : ℝ) * delta →\n ∃ N : Nat, 1 ≤ N ∧ ∀ n : Nat, N ≤ n → ∀ s : Finset Nat,\n s ⊆ Finset.range n → eta * (n : ℝ) ≤ (s.card : ℝ) → P s := by\n intro r\n induction r with\n | zero =>\n intro eta hepsilon heta\n refine ⟨1, le_refl 1, ?_⟩\n intro n hn s hs hdensity\n exact (density_above_one_impossible eta (by simpa using heta) n hn s hs hdensity).elim\n | succ r ih =>\n intro eta hepsilon heta\n by_cases htop : 1 < eta\n · refine ⟨1, le_refl 1, ?_⟩\n intro n hn s hs hdensity\n exact (density_above_one_impossible eta htop n hn s hs hdensity).elim\n · have hnext : 1 < eta + delta + (r : ℝ) * delta := by\n push_cast at heta\n nlinarith\n obtain ⟨M, hMpos, hM⟩ := ih (eta + delta) (by linarith) hnext\n obtain ⟨N, hN⟩ := hincrement eta hepsilon (le_of_not_gt htop) M\n refine ⟨max N 1, le_max_right _ _, ?_⟩\n intro n hn s hs hdensity\n rcases hN n (le_trans (le_max_left _ _) hn) s hs hdensity with hap | hinc\n · exact hap\n · obtain ⟨m, hm, t, ht, hdensity', hlift⟩ := hinc\n exact hlift (hM m hm t ht hdensity')\n obtain ⟨r, hr⟩ := exists_nat_gt ((1 - epsilon0) / delta)\n have htop : 1 < epsilon0 + (r : ℝ) * delta := by\n have hmul := (div_lt_iff₀ hdelta).mp hr\n linarith\n exact terminate r epsilon0 (le_refl _) htop\n\ntheorem finite_density_ap_of_increment (k : Nat) (epsilon0 delta : ℝ)\n (hdelta : 0 < delta)\n (hincrement : ∀ eta : ℝ, epsilon0 ≤ eta → eta ≤ 1 → ∀ M : Nat,\n ∃ N : Nat, ∀ n : Nat, N ≤ n → ∀ s : Finset Nat,\n s ⊆ Finset.range n → eta * (n : ℝ) ≤ (s.card : ℝ) →\n (∃ a b : Nat, 1 ≤ b ∧ ∀ j : Nat, j < k → a + b * j ∈ s) ∨\n ∃ m : Nat, M ≤ m ∧ ∃ t : Finset Nat,\n t ⊆ Finset.range m ∧ (eta + delta) * (m : ℝ) ≤ (t.card : ℝ) ∧\n ((∃ a b : Nat, 1 ≤ b ∧ ∀ j : Nat, j < k → a + b * j ∈ t) →\n ∃ a b : Nat, 1 ≤ b ∧ ∀ j : Nat, j < k → a + b * j ∈ s)) :\n ∃ N : Nat, ∀ n : Nat, N ≤ n → ∀ s : Finset Nat,\n s ⊆ Finset.range n → epsilon0 * (n : ℝ) ≤ (s.card : ℝ) →\n ∃ a b : Nat, 1 ≤ b ∧ ∀ j : Nat, j < k → a + b * j ∈ s := by\n obtain ⟨N, hNpos, hN⟩ := finite_density_of_increment\n (fun s => ∃ a b : Nat, 1 ≤ b ∧ ∀ j : Nat, j < k → a + b * j ∈ s)\n epsilon0 delta hdelta hincrement\n exact ⟨N, hN⟩\n\ntheorem sum_card_translate_inter {G : Type*} [AddCommGroup G] [Fintype G]\n [DecidableEq G] (s t : Finset G) :\n Finset.univ.sum (fun x : G => (s ∩ t.image (fun y => x + y)).card) =\n s.card * t.card := by\n have hfiber (x : G) :\n ((s ×ˢ t).filter (fun p : G × G => p.1 - p.2 = x)).card =\n (s ∩ t.image (fun y => x + y)).card := by\n apply Finset.card_nbij' (fun p : G × G => p.1) (fun z : G => (z, z - x))\n · intro p hp\n obtain ⟨hp, heq⟩ := Finset.mem_filter.mp hp\n obtain ⟨hps, hpt⟩ := Finset.mem_product.mp hp\n exact Finset.mem_inter.mpr ⟨hps,\n Finset.mem_image.mpr ⟨p.2, hpt, (sub_eq_iff_eq_add.mp heq).symm⟩⟩\n · intro z hz\n obtain ⟨hzs, hzt⟩ := Finset.mem_inter.mp hz\n obtain ⟨y, hyt, hy⟩ := Finset.mem_image.mp hzt\n change (z, z - x) ∈ (s ×ˢ t).filter (fun p : G × G => p.1 - p.2 = x)\n apply Finset.mem_filter.mpr\n refine ⟨Finset.mem_product.mpr ⟨hzs, ?_⟩, by simp⟩\n have heq : z - x = y := by rw [← hy]; abel\n rwa [heq]\n · intro p hp\n have heq := (Finset.mem_filter.mp hp).2\n change (p.1, p.1 - x) = p\n apply Prod.ext\n · rfl\n · change p.1 - x = p.2\n rw [sub_eq_iff_eq_add.mp heq]\n abel\n · intro z hz\n rfl\n calc\n _ = Finset.univ.sum (fun x : G =>\n ((s ×ˢ t).filter (fun p : G × G => p.1 - p.2 = x)).card) := by\n apply Finset.sum_congr rfl\n intro x hx\n exact (hfiber x).symm\n _ = (s ×ˢ t).card :=\n (Finset.card_eq_sum_card_fiberwise\n (f := fun p : G × G => p.1 - p.2) (by intro p hp; simp)).symm\n _ = _ := Finset.card_product s t\n\ntheorem exists_translate_inter_le_average {G : Type*} [AddCommGroup G] [Fintype G]\n [DecidableEq G] (s t : Finset G) :\n ∃ x : G, Fintype.card G * (s ∩ t.image (fun y => x + y)).card ≤\n s.card * t.card := by\n have hsum : Finset.univ.sum\n (fun x : G => Fintype.card G * (s ∩ t.image (fun y => x + y)).card) =\n Finset.univ.sum (fun _ : G => s.card * t.card) := by\n rw [← Finset.mul_sum, sum_card_translate_inter]\n simp\n obtain ⟨x, hx, hle⟩ := Finset.exists_le_of_sum_le\n (s := (Finset.univ : Finset G)) Finset.univ_nonempty hsum.le\n exact ⟨x, hle⟩\n\ntheorem exists_translate_union_growth {G : Type*} [AddCommGroup G] [Fintype G]\n [DecidableEq G] (s t : Finset G) :\n ∃ x : G, Fintype.card G * (s.card + t.card) ≤\n Fintype.card G * (s ∪ t.image (fun y => x + y)).card + s.card * t.card := by\n obtain ⟨x, hx⟩ := exists_translate_inter_le_average s t\n refine ⟨x, ?_⟩\n have hcard : (t.image (fun y => x + y)).card = t.card :=\n Finset.card_image_of_injective _ (add_right_injective x)\n have hsum := Finset.card_union_add_card_inter s (t.image (fun y => x + y))\n rw [hcard] at hsum\n nlinarith\n\ntheorem exists_translates_card_bound {G : Type*} [AddCommGroup G] [Fintype G]\n [DecidableEq G] (t : Finset G) (r : ℕ) :\n ∃ F : Finset G, F.card ≤ r ∧\n (Fintype.card G < 2 * (F.biUnion (fun x => t.image (fun y => x + y))).card ∨\n r * t.card ≤ 2 * (F.biUnion (fun x => t.image (fun y => x + y))).card) := by\n induction r with\n | zero => exact ⟨∅, by simp, Or.inr (by simp)⟩\n | succ r ih =>\n obtain ⟨F, hF, hU⟩ := ih\n let U := F.biUnion (fun x => t.image (fun y => x + y))\n by_cases hhalf : Fintype.card G < 2 * U.card\n · exact ⟨F, by omega, Or.inl hhalf⟩\n have hU' : r * t.card ≤ 2 * U.card := hU.resolve_left hhalf\n obtain ⟨x, hx⟩ := exists_translate_union_growth U t\n have hc : 0 < Fintype.card G := Fintype.card_pos\n have hscaled : Fintype.card G * (2 * U.card + t.card) ≤\n Fintype.card G * (2 * (U ∪ t.image (fun y => x + y)).card) := by\n have hbound := Nat.mul_le_mul_right t.card (Nat.le_of_not_gt hhalf)\n nlinarith\n have hstep : 2 * U.card + t.card ≤\n 2 * (U ∪ t.image (fun y => x + y)).card := by\n apply (mul_le_mul_iff_right₀ hc).mp\n simpa only [Nat.mul_comm] using hscaled\n refine ⟨insert x F, (Finset.card_insert_le x F).trans (by omega), Or.inr ?_⟩\n rw [Finset.biUnion_insert, Finset.union_comm]\n change (r + 1) * t.card ≤ 2 * (U ∪ t.image (fun y => x + y)).card\n nlinarith\n\ntheorem exists_translates_majority {G : Type*} [AddCommGroup G] [Fintype G]\n [DecidableEq G] (t : Finset G) (r : ℕ)\n (hr : Fintype.card G < r * t.card) :\n ∃ F : Finset G, F.card ≤ r ∧\n Fintype.card G < 2 * (F.biUnion (fun x => t.image (fun y => x + y))).card := by\n obtain ⟨F, hF, hU⟩ := exists_translates_card_bound t r\n refine ⟨F, hF, ?_⟩\n rcases hU with hU | hU\n · exact hU\n · exact hr.trans_le hU\n\ntheorem exists_translates_majority_of_density (epsilon : ℝ) (hepsilon : 0 < epsilon) :\n ∃ r : ℕ, ∀ (G : Type*) [AddCommGroup G] [Fintype G] [DecidableEq G]\n (t : Finset G), epsilon * (Fintype.card G : ℝ) ≤ (t.card : ℝ) →\n ∃ F : Finset G, F.card ≤ r ∧\n Fintype.card G < 2 * (F.biUnion (fun x => t.image (fun y => x + y))).card := by\n obtain ⟨r, hr⟩ := exists_nat_gt (1 / epsilon)\n refine ⟨r, ?_⟩\n intro G _ _ _ t ht\n apply exists_translates_majority t r\n have hc : (0 : ℝ) < Fintype.card G := Nat.cast_pos.mpr Fintype.card_pos\n have hboost := mul_lt_mul_of_pos_right ((div_lt_iff₀ hepsilon).mp hr) hc\n have hscaled := mul_le_mul_of_nonneg_left ht (Nat.cast_nonneg r : (0 : ℝ) ≤ r)\n have hcard : (Fintype.card G : ℝ) < (r : ℝ) * (t.card : ℝ) := by nlinarith\n exact_mod_cast hcard\n\ntheorem ap_of_cyclic_mod_membership (s : Set Nat) (k a b n : Nat)\n (hk : 1 ≤ k) (hb : 1 ≤ b) (ha : a < n)\n (hspan : b * (2 * k - 2) < n)\n (hmem : ∀ j : Nat, j < 2 * k - 1 → (a + b * j) % n ∈ s) :\n ∃ c d : Nat, 1 ≤ d ∧ ∀ j : Nat, j < k → c + d * j ∈ s := by\n by_cases hmid : a + b * (k - 1) < n\n · refine ⟨a, b, hb, ?_⟩\n intro j hj\n have hjle : j ≤ k - 1 := by omega\n have hmul := Nat.mul_le_mul_left b hjle\n have hterm : a + b * j < n := by omega\n simpa only [Nat.mod_eq_of_lt hterm] using hmem j (by omega)\n · have hcross : n ≤ a + b * (k - 1) := by omega\n refine ⟨a + b * (k - 1) - n, b, hb, ?_⟩\n intro j hj\n have hindex : k - 1 + j < 2 * k - 1 := by omega\n have hleft := Nat.mul_le_mul_left b (show k - 1 ≤ k - 1 + j by omega)\n have hright := Nat.mul_le_mul_left b (show k - 1 + j ≤ 2 * k - 2 by omega)\n have hlower : n ≤ a + b * (k - 1 + j) := by omega\n have hupper : a + b * (k - 1 + j) < n + n := by omega\n have hmod : (a + b * (k - 1 + j)) % n = a + b * (k - 1 + j) - n := by\n rw [Nat.mod_eq_sub_mod hlower]\n exact Nat.mod_eq_of_lt (by omega)\n have heq : a + b * (k - 1) - n + b * j = a + b * (k - 1 + j) - n := by\n rw [Nat.mul_add]\n omega\n have hm := hmem (k - 1 + j) hindex\n rwa [hmod, ← heq] at hm\n\ntheorem ap_of_shifted_mod_membership (s : Set Nat) (k a b shift n : Nat)\n (hk : 1 ≤ k) (hb : 1 ≤ b) (hspan : b * (2 * k - 2) < n)\n (hmem : ∀ j : Nat, j < 2 * k - 1 → (a + b * j + shift) % n ∈ s) :\n ∃ c d : Nat, 1 ≤ d ∧ ∀ j : Nat, j < k → c + d * j ∈ s := by\n refine ap_of_cyclic_mod_membership s k ((a + shift) % n) b n hk hb\n (Nat.mod_lt _ (by omega)) hspan ?_\n intro j hj\n simpa only [Nat.mod_add_mod, Nat.add_assoc, Nat.add_left_comm, Nat.add_comm]\n using hmem j hj\n\ntheorem line_sum_affine {ι : Type*} [Fintype ι] (k : ℕ)\n (l : Combinatorics.Line (Fin (k + 1)) ι) :\n ∃ a b : ℕ, 1 ≤ b ∧\n ∀ j : Fin (k + 1), (∑ i, (l j i).val) = a + b * j.val := by\n classical\n let V : Finset ι := Finset.univ.filter (fun i => l.idxFun i = none)\n let a : ℕ := ∑ i ∈ Vᶜ, ((l.idxFun i).map Fin.val).getD 0\n refine ⟨a, V.card, ?_, ?_⟩\n · apply Finset.card_pos.mpr\n obtain ⟨i, hi⟩ := l.proper\n exact ⟨i, Finset.mem_filter.mpr ⟨Finset.mem_univ _, hi⟩⟩\n · intro j\n have hvar : (∑ i ∈ V, (l j i).val) = V.card * j.val := by\n calc\n _ = ∑ _ ∈ V, j.val := by\n apply Finset.sum_congr rfl\n intro i hi\n rw [l.apply_none _ _ (Finset.mem_filter.mp hi).2]\n _ = _ := by simp\n have hconst : (∑ i ∈ Vᶜ, (l j i).val) = a := by\n apply Finset.sum_congr rfl\n intro i hi\n have hne : l.idxFun i ≠ none := by\n simpa only [V, Finset.mem_compl, Finset.mem_filter, Finset.mem_univ,\n true_and] using hi\n obtain ⟨x, hx⟩ := Option.ne_none_iff_exists.mp hne\n simp [Combinatorics.Line.coe_apply, ← hx]\n rw [← Finset.sum_add_sum_compl V, hvar, hconst, Nat.add_comm]\n\ntheorem finite_van_der_waerden (k r : ℕ) :\n ∃ N : ℕ, k ≤ N ∧ ∀ C : ℕ → Fin r,\n ∃ a b : ℕ, 1 ≤ b ∧ ∃ c : Fin r,\n ∀ j : ℕ, j < k → a + b * j < N ∧ C (a + b * j) = c := by\n classical\n obtain ⟨ι, hιfin, hι⟩ :=\n Combinatorics.Line.exists_mono_in_high_dimension (Fin (k + 1)) (Fin r)\n refine ⟨Fintype.card ι * k + k + 1, by omega, ?_⟩\n intro C\n obtain ⟨l, c, hcolor⟩ := hι (fun v => C (∑ i, (v i).val))\n obtain ⟨a, b, hb, hsum⟩ := line_sum_affine k l\n refine ⟨a, b, hb, c, ?_⟩\n intro j hj\n let x : Fin (k + 1) := ⟨j, by omega⟩\n have hbound : (∑ i, (l x i).val) ≤ Fintype.card ι * k := by\n calc\n _ ≤ ∑ _ : ι, k := by\n apply Finset.sum_le_sum\n intro i hi\n exact Nat.le_of_lt_succ (l x i).isLt\n _ = _ := by simp\n have heq : (∑ i, (l x i).val) = a + b * j := hsum x\n refine ⟨by omega, ?_⟩\n have hc := hcolor x\n change C (∑ i, (l x i).val) = c at hc\n simpa only [heq] using hc\n\ntheorem finite_van_der_waerden_on_interval (k r : ℕ) (hr : 1 ≤ r) :\n ∃ N : ℕ, k ≤ N ∧ ∀ C : Fin N → Fin r,\n ∃ a b : ℕ, 1 ≤ b ∧ ∃ c : Fin r,\n ∀ j : ℕ, j < k → ∃ hj : a + b * j < N,\n C ⟨a + b * j, hj⟩ = c := by\n classical\n obtain ⟨N, hN, hmono⟩ := finite_van_der_waerden k r\n refine ⟨N, hN, ?_⟩\n intro C\n let D : ℕ → Fin r := fun i => if hi : i < N then C ⟨i, hi⟩ else ⟨0, by omega⟩\n obtain ⟨a, b, hb, c, hap⟩ := hmono D\n refine ⟨a, b, hb, c, ?_⟩\n intro j hj\n obtain ⟨hbound, hcolor⟩ := hap j hj\n exact ⟨hbound, by simpa only [D, dite_eq_left hbound] using hcolor⟩\n\ntheorem missing_permutation_of_no_ap (k : ℕ) (hk : 2 ≤ k)\n (s : Finset ℕ) (hs : s ⊆ Finset.range (k * k))\n (hcard : k * (k - 1) ≤ s.card)\n (hno : ¬ ∃ a b : ℕ, 1 ≤ b ∧ ∀ j : ℕ, j < k → a + b * j ∈ s) :\n ∃ c : Fin k → Fin k, Function.Bijective c ∧\n ∀ x : ℕ, x < k * k →\n (x ∉ s ↔ ∃ i : Fin k, x = k * i.val + (c i).val) := by\n classical\n have hkpos : 0 < k := by omega\n have hmiss (a b : ℕ) (hb : 1 ≤ b) : ∃ j : ℕ, j < k ∧ a + b * j ∉ s := by\n by_contra! hn\n exact hno ⟨a, b, hb, hn⟩\n let t := Finset.range (k * k) \\ s\n have htc : t.card ≤ k := by\n have heq : s.card + t.card = k * k := by\n have h := Finset.card_sdiff_add_card_eq_card hs\n simpa only [t, Finset.card_range, Nat.add_comm] using h\n have hsub : k - 1 + 1 = k := by omega\n nlinarith\n have hrows : ∀ i : Fin k, ∃ j : Fin k, k * i.val + j.val ∈ t := by\n intro i\n obtain ⟨j, hj, hjs⟩ := hmiss (k * i.val) 1 (by omega)\n refine ⟨⟨j, hj⟩, Finset.mem_sdiff.mpr ⟨Finset.mem_range.mpr ?_, ?_⟩⟩\n · have hm := Nat.mul_le_mul_left k (Nat.succ_le_of_lt i.isLt)\n nlinarith\n · simpa only [one_mul] using hjs\n choose c hc using hrows\n let f : Fin k → ℕ := fun i => k * i.val + (c i).val\n have hfdiv (i : Fin k) : f i / k = i.val := by\n simp only [f, Nat.mul_add_div hkpos, Nat.div_eq_of_lt (c i).isLt, Nat.add_zero]\n have hfinj : Function.Injective f := by\n intro i j hij\n apply Fin.ext\n have heq := congrArg (fun x => x / k) hij\n simpa only [hfdiv] using heq\n have himage : Finset.univ.image f = t := by\n apply Finset.eq_of_subset_of_card_le\n · intro x hx\n obtain ⟨i, _, rfl⟩ := Finset.mem_image.mp hx\n exact hc i\n · rw [Finset.card_image_of_injective _ hfinj, Finset.card_univ, Fintype.card_fin]\n exact htc\n have hcsurj : Function.Surjective c := by\n intro z\n obtain ⟨j, hj, hjs⟩ := hmiss z.val k (by omega)\n have hxt : z.val + k * j ∈ t := by\n apply Finset.mem_sdiff.mpr\n refine ⟨Finset.mem_range.mpr ?_, hjs⟩\n have hm := Nat.mul_le_mul_left k (Nat.succ_le_of_lt hj)\n nlinarith [z.isLt]\n rw [← himage] at hxt\n obtain ⟨i, _, hi⟩ := Finset.mem_image.mp hxt\n refine ⟨i, Fin.ext ?_⟩\n have heq := congrArg (fun x => x % k) hi\n simpa [f, Nat.add_mod, Nat.mod_eq_of_lt (c i).isLt,\n Nat.mod_eq_of_lt z.isLt] using heq\n refine ⟨c, ⟨Finite.injective_iff_surjective.mpr hcsurj, hcsurj⟩, ?_⟩\n intro x hx\n have hxt : x ∉ s ↔ x ∈ t := by simp [t, hx]\n rw [hxt, ← himage]\n simp only [Finset.mem_image, Finset.mem_univ, true_and, f, eq_comm]\n\ntheorem ap_of_card_dense_square (k : ℕ) (hk : 3 ≤ k)\n (s : Finset ℕ) (hs : s ⊆ Finset.range (k * k))\n (hcard : k * (k - 1) ≤ s.card) :\n ∃ a b : ℕ, 1 ≤ b ∧ ∀ j : ℕ, j < k → a + b * j ∈ s := by\n classical\n by_contra hno\n obtain ⟨c, hc, hholes⟩ :=\n missing_permutation_of_no_ap k (by omega) s hs hcard hno\n have hcinj := hc.1\n have hnext (i : ℕ) (hi : i + 1 < k) :\n (c ⟨i + 1, hi⟩).val < (c ⟨i, by omega⟩).val := by\n let i0 : Fin k := ⟨i, by omega⟩\n let i1 : Fin k := ⟨i + 1, hi⟩\n have hle : (c i1).val ≤ (c i0).val := by\n by_contra! hbig\n have hap : ∀ j : ℕ, j < k → k * i + (c i0).val + 1 + j ∈ s := by\n intro j hj\n have hxlt : k * i + (c i0).val + 1 + j < k * k := by\n have hm := Nat.mul_le_mul_left k (show i + 2 ≤ k by omega)\n nlinarith [(c i0).isLt]\n by_contra hnot\n obtain ⟨r, hr⟩ := (hholes _ hxlt).mp hnot\n have hrlo : i ≤ r.val := by\n by_contra! hlow\n have hm := Nat.mul_le_mul_left k (Nat.succ_le_of_lt hlow)\n nlinarith [(c r).isLt]\n have hrhi : r.val ≤ i + 1 := by\n by_contra! hhigh\n have hm := Nat.mul_le_mul_left k (show i + 2 ≤ r.val by omega)\n nlinarith [(c i0).isLt]\n have hr' : r = i0 ∨ r = i1 := by\n have hvals : r.val = i ∨ r.val = i + 1 := by omega\n exact hvals.imp Fin.ext Fin.ext\n rcases hr' with rfl | rfl\n · change k * i + (c i0).val + 1 + j = k * i + (c i0).val at hr\n omega\n · change k * i + (c i0).val + 1 + j = k * (i + 1) + (c i1).val at hr\n nlinarith\n exact hno ⟨k * i + (c i0).val + 1, 1, by omega,\n by simpa only [one_mul] using hap⟩\n have hne : (c i1).val ≠ (c i0).val := by\n intro heq\n have heq' := congrArg Fin.val (hcinj (Fin.ext heq))\n change i + 1 = i at heq'\n omega\n change (c i1).val < (c i0).val\n omega\n have hub : ∀ i : ℕ, ∀ hi : i < k, (c ⟨i, hi⟩).val + i < k := by\n intro i\n induction i with\n | zero =>\n intro hi\n simpa only [Nat.add_zero] using (c ⟨0, hi⟩).isLt\n | succ i ih =>\n intro hi\n have hprev := ih (by omega)\n have hstep := hnext i hi\n omega\n have hdown : ∀ d : ℕ, ∀ hd : d < k,\n d ≤ (c ⟨k - 1 - d, by omega⟩).val := by\n intro d\n induction d with\n | zero => intro hd; omega\n | succ d ih =>\n intro hd\n have hprev := ih (by omega)\n have hstep := hnext (k - 1 - (d + 1)) (by omega)\n have heq : k - 1 - (d + 1) + 1 = k - 1 - d := by omega\n simp only [heq] at hstep\n omega\n have hform (i : Fin k) : k * i.val + (c i).val = (k - 1) * (i.val + 1) := by\n have hu := hub i.val i.isLt\n change (c i).val + i.val < k at hu\n have hd := hdown (k - 1 - i.val) (by omega)\n have heq : k - 1 - (k - 1 - i.val) = i.val := by omega\n simp only [heq] at hd\n change k - 1 - i.val ≤ (c i).val at hd\n have hc : (c i).val + i.val = k - 1 := by omega\n have hk' : k - 1 + 1 = k := by omega\n nlinarith\n apply hno\n refine ⟨1, k - 1, by omega, ?_⟩\n intro j hj\n have hxlt : 1 + (k - 1) * j < k * k := by\n have hm := Nat.mul_le_mul_left (k - 1) (show j ≤ k - 1 by omega)\n have hk' : k - 1 + 1 = k := by omega\n nlinarith\n by_contra hnot\n obtain ⟨i, hi⟩ := (hholes _ hxlt).mp hnot\n rw [hform] at hi\n have hmod := congrArg (fun x => x % (k - 1)) hi\n simp [Nat.add_mod, Nat.mod_eq_of_lt (by omega : 1 < k - 1)] at hmod\n\ntheorem ap_of_card_gt_square_blocks (k n : ℕ) (hk : 3 ≤ k)\n (s : Finset ℕ) (hs : s ⊆ Finset.range n)\n (hcard : (n / (k * k) + 1) * (k * (k - 1) - 1) < s.card) :\n ∃ a b : ℕ, 1 ≤ b ∧ ∀ j : ℕ, j < k → a + b * j ∈ s := by\n classical\n let q := k * k\n have hq : 0 < q := Nat.mul_pos (by omega) (by omega)\n have hp : 0 < k * (k - 1) := Nat.mul_pos (by omega) (by omega)\n have hmaps : ∀ x ∈ s, x / q ∈ Finset.range (n / q + 1) := by\n intro x hx\n apply Finset.mem_range.mpr\n exact Nat.lt_succ_of_le\n (Nat.div_le_div_right (Nat.le_of_lt (Finset.mem_range.mp (hs hx))))\n obtain ⟨a, ha, hlarge⟩ :=\n Finset.exists_lt_card_fiber_of_mul_lt_card_of_maps_to hmaps\n (by simpa only [Finset.card_range] using hcard)\n let u := s.filter (fun x => x / q = a)\n let t := u.image (fun x => x % q)\n have hmodinj : Set.InjOn (fun x => x % q) u := by\n intro x hx y hy heq\n change x % q = y % q at heq\n have hxq := (Finset.mem_filter.mp hx).2\n have hyq := (Finset.mem_filter.mp hy).2\n have hx' := Nat.div_add_mod x q\n have hy' := Nat.div_add_mod y q\n rw [hxq] at hx'\n rw [hyq, ← heq] at hy'\n omega\n have hct : t.card = u.card := Finset.card_image_of_injOn hmodinj\n have ht : t ⊆ Finset.range (k * k) := by\n intro x hx\n obtain ⟨y, _, rfl⟩ := Finset.mem_image.mp hx\n exact Finset.mem_range.mpr (Nat.mod_lt y hq)\n have hct' : k * (k - 1) ≤ t.card := by\n change k * (k - 1) - 1 < u.card at hlarge\n omega\n have hap := ap_of_card_dense_square k hk t ht hct'\n apply ap_of_affine_indices s t (q * a) 1 k (by omega) ?_ hap\n intro x hx\n obtain ⟨y, hy, heq⟩ := Finset.mem_image.mp hx\n change y % q = x at heq\n obtain ⟨hys, hyq⟩ := Finset.mem_filter.mp hy\n have hy' := Nat.div_add_mod y q\n rw [hyq, heq] at hy'\n simpa only [one_mul, hy'] using hys\n\ntheorem finite_density_square (k : ℕ) (hk : 3 ≤ k) (epsilon : ℝ)\n (hepsilon : ((k * (k - 1) - 1 : ℕ) : ℝ) <\n epsilon * ((k * k : ℕ) : ℝ)) :\n ∃ N : ℕ, ∀ n : ℕ, N ≤ n → ∀ s : Finset ℕ,\n s ⊆ Finset.range n → epsilon * (n : ℝ) ≤ (s.card : ℝ) →\n ∃ a b : ℕ, 1 ≤ b ∧ ∀ j : ℕ, j < k → a + b * j ∈ s := by\n let m := k * k\n let c := k * (k - 1) - 1\n have hm : (0 : ℝ) < m := Nat.cast_pos.mpr (Nat.mul_pos (by omega) (by omega))\n have hgap : 0 < epsilon * (m : ℝ) - (c : ℝ) := sub_pos.mpr hepsilon\n obtain ⟨N, hN⟩ := exists_nat_gt\n ((m : ℝ) * (c : ℝ) / (epsilon * (m : ℝ) - (c : ℝ)))\n refine ⟨N, ?_⟩\n intro n hn s hs hd\n apply ap_of_card_gt_square_blocks k n hk s hs\n have hbound := (div_lt_iff₀ hgap).mp hN\n have hmon := mul_le_mul_of_nonneg_left (Nat.cast_le.mpr hn : (N : ℝ) ≤ n) hgap.le\n have hdiv : ((n / m : ℕ) : ℝ) * (m : ℝ) ≤ (n : ℝ) := by\n exact_mod_cast Nat.div_mul_le_self n m\n have hmul := mul_le_mul_of_nonneg_right hdiv (Nat.cast_nonneg c : (0 : ℝ) ≤ c)\n have hd' := mul_le_mul_of_nonneg_left hd hm.le\n have hcard : ((((n / m + 1) * c : ℕ) : ℝ)) < (s.card : ℝ) := by\n apply (mul_lt_mul_iff_right₀ hm).mp\n push_cast\n nlinarith\n exact_mod_cast hcard\n\ntheorem block_support_ap_does_not_lift :\n ∃ s : Finset ℕ, s ⊆ Finset.range 40 ∧\n (∀ i : ℕ, i < 4 → ∃ x ∈ s, x / 10 = i) ∧\n ¬ (∃ a b : ℕ, 1 ≤ b ∧ ∀ j : ℕ, j < 4 → a + b * j ∈ s) := by\n let s : Finset ℕ := {0, 10, 20, 31}\n refine ⟨s, ?_, ?_, ?_⟩\n · intro x hx\n simp only [s, Finset.mem_insert, Finset.mem_singleton] at hx\n exact Finset.mem_range.mpr (by omega)\n · intro i hi\n have hicases : i = 0 ∨ i = 1 ∨ i = 2 ∨ i = 3 := by omega\n rcases hicases with rfl | rfl | rfl | rfl\n · exact ⟨0, by simp [s], by norm_num⟩\n · exact ⟨10, by simp [s], by norm_num⟩\n · exact ⟨20, by simp [s], by norm_num⟩\n · exact ⟨31, by simp [s], by norm_num⟩\n · rintro ⟨a, b, hb, hap⟩\n have h0 := hap 0 (by omega)\n have h1 := hap 1 (by omega)\n have h2 := hap 2 (by omega)\n have h3 := hap 3 (by omega)\n simp only [s, Finset.mem_insert, Finset.mem_singleton,\n Nat.mul_zero, Nat.add_zero, Nat.mul_one] at h0 h1 h2 h3\n omega\n\ntheorem roth_tensor_obstruction :\n rothNumberNat 3 = 2 ∧ 5 ≤ rothNumberNat 9 := by\n have hupper : rothNumberNat 3 ≤ 2 := by\n obtain ⟨s, hs, hcard, hfree⟩ := rothNumberNat_spec 3\n by_contra h\n have heq : s = Finset.range 3 := Finset.eq_of_subset_of_card_le hs (by\n rw [Finset.card_range, hcard]\n omega)\n rw [heq] at hfree\n have h01 := hfree (by simp : 0 ∈ (Finset.range 3 : Set ℕ))\n (by simp : 1 ∈ (Finset.range 3 : Set ℕ))\n (by simp : 2 ∈ (Finset.range 3 : Set ℕ)) (by omega)\n omega\n have hlower : 2 ≤ rothNumberNat 3 := by\n let s : Finset ℕ := {0, 1}\n have hfree : ThreeAPFree (s : Set ℕ) := by\n intro x hx y hy z hz hsum\n simp only [s, Finset.mem_coe, Finset.mem_insert, Finset.mem_singleton] at hx hy hz\n omega\n exact hfree.le_rothNumberNat s (by\n intro x hx\n simp only [s, Finset.mem_insert, Finset.mem_singleton] at hx\n omega) (by norm_num [s])\n refine ⟨by omega, ?_⟩\n let s : Finset ℕ := {0, 1, 3, 7, 8}\n have hfree : ThreeAPFree (s : Set ℕ) := by\n intro x hx y hy z hz hsum\n simp only [s, Finset.mem_coe, Finset.mem_insert, Finset.mem_singleton] at hx hy hz\n omega\n exact hfree.le_rothNumberNat s (by\n intro x hx\n simp only [s, Finset.mem_insert, Finset.mem_singleton] at hx\n omega) (by norm_num [s])\n\ntheorem rothNumberNat_not_submultiplicative :\n ¬ (∀ m n : ℕ, rothNumberNat (m * n) ≤ rothNumberNat m * rothNumberNat n) := by\n intro h\n obtain ⟨hthree, hnine⟩ := roth_tensor_obstruction\n have hbound := h 3 3\n norm_num [hthree] at hbound\n omega\n\ntheorem ap_face_sum_affine {R : Type*} [CommRing R] (k : ℕ)\n (x : Fin k → R) (i : Fin k) :\n Finset.univ.sum (fun j : Fin k => ((j.val : R) - (i.val : R)) * x j) =\n Finset.univ.sum (fun j : Fin k => (j.val : R) * x j) -\n (i.val : R) * Finset.univ.sum x := by\n simp only [sub_mul, Finset.sum_sub_distrib, Finset.mul_sum]\n\ntheorem ap_face_sum_independent {R : Type*} [CommRing R] (k : ℕ)\n (x y : Fin k → R) (i : Fin k)\n (hxy : ∀ j : Fin k, j ≠ i → x j = y j) :\n Finset.univ.sum (fun j : Fin k => ((j.val : R) - (i.val : R)) * x j) =\n Finset.univ.sum (fun j : Fin k => ((j.val : R) - (i.val : R)) * y j) := by\n apply Finset.sum_congr rfl\n intro j hj\n by_cases hji : j = i\n · subst j\n simp\n · rw [hxy j hji]\n\ntheorem card_ap_diagonal_fiber {R : Type*} [CommRing R] [Fintype R] [DecidableEq R]\n (m : ℕ) (a : R) :\n Fintype.card {x : Fin (m + 2) → R //\n Finset.univ.sum x = 0 ∧\n Finset.univ.sum (fun j : Fin (m + 2) => (j.val : R) * x j) = a} =\n Fintype.card R ^ m := by\n classical\n have hsum (x : Fin (m + 2) → R) :\n Finset.univ.sum x = x 0 + x 1 +\n Finset.univ.sum (fun j : Fin m => x j.succ.succ) := by\n simp [Fin.sum_univ_succ, add_assoc]\n have hmoment (x : Fin (m + 2) → R) :\n Finset.univ.sum (fun j : Fin (m + 2) => (j.val : R) * x j) =\n x 1 + Finset.univ.sum (fun j : Fin m => ((j.val : R) + 2) * x j.succ.succ) := by\n simp only [Fin.sum_univ_succ, Fin.val_zero, Fin.val_succ, Nat.cast_zero,\n Nat.cast_add, Nat.cast_one, zero_mul, zero_add, one_mul]\n congr 1\n apply Finset.sum_congr rfl\n intro j hj\n ring\n let f : {x : Fin (m + 2) → R // Finset.univ.sum x = 0 ∧\n Finset.univ.sum (fun j : Fin (m + 2) => (j.val : R) * x j) = a} →\n (Fin m → R) := fun x j => x.val j.succ.succ\n have hf : Function.Bijective f := by\n constructor\n · intro x y hxy\n have htail : (fun j : Fin m => x.val j.succ.succ) =\n (fun j : Fin m => y.val j.succ.succ) := hxy\n have hmx := x.property.2\n have hmy := y.property.2\n rw [hmoment] at hmx hmy\n have hweighted : Finset.univ.sum\n (fun j : Fin m => ((j.val : R) + 2) * x.val j.succ.succ) =\n Finset.univ.sum (fun j : Fin m => ((j.val : R) + 2) * y.val j.succ.succ) := by\n apply Finset.sum_congr rfl\n intro j hj\n rw [congrFun htail j]\n have h1 : x.val 1 = y.val 1 := by\n rw [hweighted] at hmx\n exact add_right_cancel (hmx.trans hmy.symm)\n have hsx := x.property.1\n have hsy := y.property.1\n rw [hsum] at hsx hsy\n have h0 : x.val 0 = y.val 0 := by\n rw [htail, h1] at hsx\n exact add_right_cancel (add_right_cancel (hsx.trans hsy.symm))\n apply Subtype.ext\n funext j\n refine Fin.cases h0 (fun i => ?_) j\n exact Fin.cases h1 (fun i => congrFun htail i) i\n · intro z\n let w := Finset.univ.sum (fun j : Fin m => ((j.val : R) + 2) * z j)\n let x : Fin (m + 2) → R :=\n Fin.cons (-(a - w) - Finset.univ.sum z) (Fin.cons (a - w) z)\n have hxsum : Finset.univ.sum x = 0 := by\n rw [hsum]\n change (-(a - w) - Finset.univ.sum z) + (a - w) + Finset.univ.sum z = 0\n ring\n have hxmoment : Finset.univ.sum\n (fun j : Fin (m + 2) => (j.val : R) * x j) = a := by\n rw [hmoment]\n change a - w + w = a\n ring\n refine ⟨⟨x, hxsum, hxmoment⟩, ?_⟩\n funext j\n simp [f, x]\n simpa using Fintype.card_congr (Equiv.ofBijective f hf)\n\ntheorem card_ap_diagonal_labels {R : Type*} [CommRing R] [Fintype R] [DecidableEq R]\n (m : ℕ) (s : Finset R) :\n Fintype.card {x : Fin (m + 2) → R //\n Finset.univ.sum x = 0 ∧\n Finset.univ.sum (fun j : Fin (m + 2) => (j.val : R) * x j) ∈ s} =\n s.card * Fintype.card R ^ m := by\n classical\n let e : (Σ a : {a : R // a ∈ s}, {x : Fin (m + 2) → R //\n Finset.univ.sum x = 0 ∧\n Finset.univ.sum (fun j : Fin (m + 2) => (j.val : R) * x j) = a.val}) ≃\n {x : Fin (m + 2) → R // Finset.univ.sum x = 0 ∧\n Finset.univ.sum (fun j : Fin (m + 2) => (j.val : R) * x j) ∈ s} :=\n { toFun := fun p => ⟨p.2.val, p.2.property.1, by\n rw [p.2.property.2]\n exact p.1.property⟩\n invFun := fun x => ⟨⟨Finset.univ.sum\n (fun j : Fin (m + 2) => (j.val : R) * x.val j), x.property.2⟩,\n ⟨x.val, x.property.1, rfl⟩⟩\n left_inv := by\n rintro ⟨⟨a, ha⟩, ⟨x, hx, hm⟩⟩\n dsimp\n dsimp only at hm\n subst a\n rfl\n right_inv := by\n rintro ⟨x, hx, hm⟩\n rfl }\n rw [← Fintype.card_congr e, Fintype.card_sigma]\n simp [card_ap_diagonal_fiber]\n\ntheorem ap_diagonal_eq_of_face_eq {G : Type*} [AddCommGroup G] (k : ℕ)\n (x y : Fin k → G) (i : Fin k)\n (hx : Finset.univ.sum x = 0) (hy : Finset.univ.sum y = 0)\n (hface : ∀ j : Fin k, j ≠ i → x j = y j) : x = y := by\n classical\n have hsub : Finset.univ.sum (fun j : Fin k => x j - y j) = x i - y i := by\n apply Finset.sum_eq_single i\n · intro j hj hji\n rw [hface j hji, sub_self]\n · simp\n rw [Finset.sum_sub_distrib, hx, hy, sub_self] at hsub\n have hi : x i = y i := sub_eq_zero.mp hsub.symm\n funext j\n by_cases hji : j = i\n · simpa only [hji] using hi\n · exact hface j hji\n\ntheorem ap_diagonal_deletion_bound {R : Type*} [CommRing R] [Fintype R] [DecidableEq R]\n (m : ℕ) (s : Finset R) (D : Fin (m + 2) → Finset (Fin (m + 2) → R))\n (hcover : ∀ x : Fin (m + 2) → R,\n Finset.univ.sum x = 0 →\n Finset.univ.sum (fun j : Fin (m + 2) => (j.val : R) * x j) ∈ s →\n ∃ i : Fin (m + 2), Function.update x i 0 ∈ D i) :\n s.card * Fintype.card R ^ m ≤ Finset.univ.sum (fun i => (D i).card) := by\n classical\n let T := {x : Fin (m + 2) → R // Finset.univ.sum x = 0 ∧\n Finset.univ.sum (fun j : Fin (m + 2) => (j.val : R) * x j) ∈ s}\n have hchoose : ∀ x : T, ∃ i : Fin (m + 2), Function.update x.val i 0 ∈ D i :=\n fun x => hcover x.val x.property.1 x.property.2\n choose c hc using hchoose\n let f : T → Σ i : Fin (m + 2), {y // y ∈ D i} :=\n fun x => ⟨c x, ⟨Function.update x.val (c x) 0, hc x⟩⟩\n have hf : Function.Injective f := by\n intro x y hxy\n have hi := congrArg Sigma.fst hxy\n have hv := congrArg\n (fun p : Σ i : Fin (m + 2), {z // z ∈ D i} => p.2.val) hxy\n change c x = c y at hi\n change Function.update x.val (c x) 0 = Function.update y.val (c y) 0 at hv\n rw [← hi] at hv\n apply Subtype.ext\n apply ap_diagonal_eq_of_face_eq (m + 2) x.val y.val (c x)\n x.property.1 y.property.1\n intro j hj\n have heq := congrFun hv j\n simpa only [Function.update_of_ne hj] using heq\n have hcard := Fintype.card_le_of_injective f hf\n change Fintype.card {x : Fin (m + 2) → R // Finset.univ.sum x = 0 ∧\n Finset.univ.sum (fun j : Fin (m + 2) => (j.val : R) * x j) ∈ s} ≤ _ at hcard\n rw [card_ap_diagonal_labels] at hcard\n simpa only [Fintype.card_sigma, Fintype.card_coe] using hcard\n\ntheorem expect_mul_sq_le_expect_sq {I : Type*} [Fintype I] [Nonempty I]\n (f g : I → ℝ) (hg : ∀ i, |g i| ≤ 1) :\n (Finset.univ.expect fun i => f i * g i) ^ 2 ≤\n Finset.univ.expect fun i => f i ^ 2 := by\n have hg2 : (Finset.univ.expect fun i => g i ^ 2) ≤ 1 := by\n apply Finset.expect_le Finset.univ_nonempty\n intro i hi\n obtain ⟨hlo, hhi⟩ := abs_le.mp (hg i)\n nlinarith [mul_nonneg (sub_nonneg.mpr hhi) (by linarith : 0 ≤ 1 + g i)]\n calc\n (Finset.univ.expect fun i => f i * g i) ^ 2 ≤\n (Finset.univ.expect fun i => f i ^ 2) * (Finset.univ.expect fun i => g i ^ 2) :=\n Finset.expect_mul_sq_le_sq_mul_sq Finset.univ f g\n _ ≤ (Finset.univ.expect fun i => f i ^ 2) * 1 :=\n mul_le_mul_of_nonneg_left hg2 (Finset.expect_nonneg fun i _ => sq_nonneg (f i))\n _ = _ := mul_one _\n\ntheorem expect_sq_eq_double {I : Type*} [Fintype I] (f : I → ℝ) :\n (Finset.univ.expect f) ^ 2 =\n Finset.univ.expect fun i => Finset.univ.expect fun j => f i * f j := by\n simpa only [pow_two] using Fintype.expect_mul_expect f f\n\ntheorem expect_pair_swap {I J : Type*} [Fintype I] [Fintype J]\n (f : I → J → ℝ) :\n (Finset.univ.expect fun i => Finset.univ.expect fun j => f i j) =\n Finset.univ.expect fun j => Finset.univ.expect fun i => f i j := by\n exact Finset.expect_comm Finset.univ Finset.univ f\n\n/-- Two applications of Cauchy--Schwarz bound correlation with bounded\none-coordinate tests by the rectangular box moment. -/\ntheorem box_two_correlation_bound {I J : Type*}\n [Fintype I] [Nonempty I] [Fintype J] [Nonempty J]\n (f : I → J → ℝ) (g : I → ℝ) (h : J → ℝ)\n (hg : ∀ i, |g i| ≤ 1) (hh : ∀ j, |h j| ≤ 1) :\n (Finset.univ.expect fun i => Finset.univ.expect fun j =>\n f i j * g i * h j) ^ 4 ≤\n Finset.univ.expect fun j => Finset.univ.expect fun j' =>\n (Finset.univ.expect fun i => f i j * f i j') ^ 2 := by\n let C := Finset.univ.expect fun i => Finset.univ.expect fun j => f i j * g i * h j\n let Q := Finset.univ.expect fun i =>\n (Finset.univ.expect fun j => f i j * h j) ^ 2\n have hC : C ^ 2 ≤ Q := by\n have hc : C = Finset.univ.expect fun i =>\n (Finset.univ.expect fun j => f i j * h j) * g i := by\n dsimp [C]\n apply Finset.expect_congr rfl\n intro i hi\n rw [Finset.expect_mul]\n apply Finset.expect_congr rfl\n intro j hj\n ring\n rw [hc]\n exact expect_mul_sq_le_expect_sq _ g hg\n have hQ : Q = Finset.univ.expect fun j => Finset.univ.expect fun j' =>\n (Finset.univ.expect fun i => f i j * f i j') * (h j * h j') := by\n dsimp [Q]\n simp_rw [expect_sq_eq_double]\n rw [expect_pair_swap]\n apply Finset.expect_congr rfl\n intro j hj\n rw [expect_pair_swap]\n apply Finset.expect_congr rfl\n intro j' hj'\n rw [Finset.expect_mul]\n apply Finset.expect_congr rfl\n intro i hi\n ring\n have hhprod : ∀ p : J × J, |h p.1 * h p.2| ≤ 1 := by\n intro p\n rw [abs_mul]\n exact (mul_le_mul (hh p.1) (hh p.2) (abs_nonneg _) (by positivity)).trans_eq (one_mul 1)\n have hQ2 := expect_mul_sq_le_expect_sq\n (fun p : J × J => Finset.univ.expect fun i => f i p.1 * f i p.2)\n (fun p : J × J => h p.1 * h p.2) hhprod\n have heq (u : J × J → ℝ) : Finset.univ.expect u =\n Finset.univ.expect fun j => Finset.univ.expect fun j' => u (j, j') := by\n simpa only [Finset.univ_product_univ] using\n Finset.expect_product (Finset.univ : Finset J) (Finset.univ : Finset J) u\n rw [heq, heq, ← hQ] at hQ2\n have hQnonneg : 0 ≤ Q := Finset.expect_nonneg fun i _ => sq_nonneg _\n have hsq : C ^ 2 * C ^ 2 ≤ Q * Q :=\n mul_le_mul hC hC (sq_nonneg C) hQnonneg\n change C ^ 4 ≤ _\n nlinarith\n\ntheorem expect_pair_eq {I J : Type*} [Fintype I] [Fintype J]\n (f : I × J → ℝ) : Finset.univ.expect f =\n Finset.univ.expect fun i => Finset.univ.expect fun j => f (i, j) := by\n simpa only [Finset.univ_product_univ] using\n Finset.expect_product (Finset.univ : Finset I) (Finset.univ : Finset J) f\n\ntheorem expect_pow_four_le {I : Type*} [Fintype I] [Nonempty I] (f : I → ℝ) :\n (Finset.univ.expect f) ^ 4 ≤ Finset.univ.expect fun i => f i ^ 4 := by\n have h1 : (Finset.univ.expect f) ^ 2 ≤ Finset.univ.expect fun i => f i ^ 2 := by\n simpa using expect_mul_sq_le_expect_sq f (fun _ => 1) (by simp)\n have h2 : (Finset.univ.expect fun i => f i ^ 2) ^ 2 ≤\n Finset.univ.expect fun i => f i ^ 4 := by\n calc\n _ ≤ Finset.univ.expect (fun i => (f i ^ 2) ^ 2) := by\n simpa only [mul_one] using\n expect_mul_sq_le_expect_sq (fun i => f i ^ 2) (fun _ => 1) (by simp)\n _ = _ := Finset.expect_congr rfl (by intro i hi; ring)\n have hnonneg : 0 ≤ Finset.univ.expect fun i => f i ^ 2 :=\n Finset.expect_nonneg fun i _ => sq_nonneg _\n have hmul := mul_le_mul h1 h1 (sq_nonneg (Finset.univ.expect f)) hnonneg\n nlinarith\n\ntheorem expect_four_rotate {I J K L : Type*}\n [Fintype I] [Fintype J] [Fintype K] [Fintype L]\n (f : I → J → K → L → ℝ) :\n (Finset.univ.expect fun i => Finset.univ.expect fun j =>\n Finset.univ.expect fun k => Finset.univ.expect fun l => f i j k l) =\n Finset.univ.expect fun k => Finset.univ.expect fun l =>\n Finset.univ.expect fun i => Finset.univ.expect fun j => f i j k l := by\n calc\n _ = Finset.univ.expect (fun p : I × J =>\n Finset.univ.expect fun q : K × L => f p.1 p.2 q.1 q.2) := by\n simp_rw [expect_pair_eq]\n _ = Finset.univ.expect (fun q : K × L =>\n Finset.univ.expect fun p : I × J => f p.1 p.2 q.1 q.2) := expect_pair_swap _\n _ = _ := by simp_rw [expect_pair_eq]\n\ntheorem abs_mul_le_one {a b : ℝ} (ha : |a| ≤ 1) (hb : |b| ≤ 1) : |a * b| ≤ 1 := by\n rw [abs_mul]\n exact (mul_le_mul ha hb (abs_nonneg _) (by positivity)).trans_eq (one_mul 1)\n\n/-- A three-variable function correlated with bounded tests omitting one\ncoordinate is controlled by its eight-corner box moment. The final square\nis the average over the last pair of corners. -/\ntheorem box_three_correlation_bound {I J K : Type*}\n [Fintype I] [Nonempty I] [Fintype J] [Nonempty J] [Fintype K] [Nonempty K]\n (f : I → J → K → ℝ) (g : J → K → ℝ)\n (h : I → K → ℝ) (l : I → J → ℝ)\n (hg : ∀ j k, |g j k| ≤ 1)\n (hh : ∀ i k, |h i k| ≤ 1) (hl : ∀ i j, |l i j| ≤ 1) :\n (Finset.univ.expect fun j => Finset.univ.expect fun k =>\n Finset.univ.expect fun i => f i j k * g j k * h i k * l i j) ^ 8 ≤\n Finset.univ.expect fun i => Finset.univ.expect fun i' =>\n Finset.univ.expect fun k => Finset.univ.expect fun k' =>\n (Finset.univ.expect fun j =>\n (f i j k * f i' j k) * (f i j k' * f i' j k')) ^ 2 := by\n let C := Finset.univ.expect fun j => Finset.univ.expect fun k =>\n Finset.univ.expect fun i => f i j k * g j k * h i k * l i j\n let Q := Finset.univ.expect fun j => Finset.univ.expect fun k =>\n (Finset.univ.expect fun i => f i j k * h i k * l i j) ^ 2\n have hC : C ^ 2 ≤ Q := by\n have hc : C = Finset.univ.expect (fun p : J × K =>\n (Finset.univ.expect fun i => f i p.1 p.2 * h i p.2 * l i p.1) * g p.1 p.2) := by\n rw [expect_pair_eq]\n dsimp [C]\n apply Finset.expect_congr rfl\n intro j hj\n apply Finset.expect_congr rfl\n intro k hk\n rw [Finset.expect_mul]\n apply Finset.expect_congr rfl\n intro i hi\n ring\n rw [hc]\n simpa only [expect_pair_eq] using expect_mul_sq_le_expect_sq\n (fun p : J × K => Finset.univ.expect fun i => f i p.1 p.2 * h i p.2 * l i p.1)\n (fun p : J × K => g p.1 p.2) (fun p => hg p.1 p.2)\n let T := fun i i' : I => Finset.univ.expect fun j => Finset.univ.expect fun k =>\n (f i j k * f i' j k) * (l i j * l i' j) * (h i k * h i' k)\n have hQ : Q = Finset.univ.expect fun i => Finset.univ.expect fun i' => T i i' := by\n dsimp [Q, T]\n simp_rw [expect_sq_eq_double]\n rw [expect_four_rotate]\n apply Finset.expect_congr rfl\n intro i hi\n apply Finset.expect_congr rfl\n intro i' hi'\n apply Finset.expect_congr rfl\n intro j hj\n apply Finset.expect_congr rfl\n intro k hk\n ring\n have hQ4 : Q ^ 4 ≤ Finset.univ.expect fun i => Finset.univ.expect fun i' =>\n Finset.univ.expect fun k => Finset.univ.expect fun k' =>\n (Finset.univ.expect fun j =>\n (f i j k * f i' j k) * (f i j k' * f i' j k')) ^ 2 := by\n calc\n Q ^ 4 = (Finset.univ.expect fun p : I × I => T p.1 p.2) ^ 4 := by\n rw [expect_pair_eq, hQ]\n _ ≤ Finset.univ.expect fun p : I × I => T p.1 p.2 ^ 4 := expect_pow_four_le _\n _ = Finset.univ.expect (fun i => Finset.univ.expect fun i' => T i i' ^ 4) :=\n expect_pair_eq _\n _ ≤ _ := by\n apply Finset.expect_le_expect\n intro i hi\n apply Finset.expect_le_expect\n intro i' hi'\n exact box_two_correlation_bound (fun j k => f i j k * f i' j k)\n (fun j => l i j * l i' j) (fun k => h i k * h i' k)\n (fun j => abs_mul_le_one (hl i j) (hl i' j))\n (fun k => abs_mul_le_one (hh i k) (hh i' k))\n have hQnonneg : 0 ≤ Q :=\n Finset.expect_nonneg fun j _ => Finset.expect_nonneg fun k _ => sq_nonneg _\n have hC4 : C ^ 4 ≤ Q ^ 2 := by\n have hm := mul_le_mul hC hC (sq_nonneg C) hQnonneg\n nlinarith\n have hC8 : C ^ 8 ≤ Q ^ 4 := by\n have hm := mul_le_mul hC4 hC4 (by positivity : 0 ≤ C ^ 4) (sq_nonneg Q)\n nlinarith\n exact hC8.trans hQ4\n\ntheorem expect_pow_eight_le {I : Type*} [Fintype I] [Nonempty I] (f : I → ℝ) :\n (Finset.univ.expect f) ^ 8 ≤ Finset.univ.expect fun i => f i ^ 8 := by\n have h4 := expect_pow_four_le f\n have hnonneg : 0 ≤ Finset.univ.expect fun i => f i ^ 4 :=\n Finset.expect_nonneg fun i _ => by positivity\n have hm := mul_le_mul h4 h4 (by positivity : 0 ≤ (Finset.univ.expect f) ^ 4) hnonneg\n have h8 : (Finset.univ.expect f) ^ 8 ≤\n (Finset.univ.expect fun i => f i ^ 4) ^ 2 := by nlinarith\n calc\n _ ≤ (Finset.univ.expect fun i => f i ^ 4) ^ 2 := h8\n _ ≤ Finset.univ.expect (fun i => (f i ^ 4) ^ 2) := by\n simpa only [mul_one] using\n expect_mul_sq_le_expect_sq (fun i => f i ^ 4) (fun _ => 1) (by simp)\n _ = _ := Finset.expect_congr rfl (by intro i hi; ring)\n\n/-- The tetrahedron correlation is controlled by one face's box moment,\nuniformly over the size of the four finite vertex classes. This supplies\ncounting control when that moment is small; it asserts no regularity or\nremoval theorem. -/\ntheorem tetrahedron_correlation_bound {I J K L : Type*}\n [Fintype I] [Nonempty I] [Fintype J] [Nonempty J]\n [Fintype K] [Nonempty K] [Fintype L] [Nonempty L]\n (f : I → J → K → ℝ) (g : J → K → L → ℝ)\n (h : I → K → L → ℝ) (l : I → J → L → ℝ)\n (hg : ∀ j k w, |g j k w| ≤ 1)\n (hh : ∀ i k w, |h i k w| ≤ 1) (hl : ∀ i j w, |l i j w| ≤ 1) :\n (Finset.univ.expect fun w => Finset.univ.expect fun j =>\n Finset.univ.expect fun k => Finset.univ.expect fun i =>\n f i j k * g j k w * h i k w * l i j w) ^ 8 ≤\n Finset.univ.expect fun i => Finset.univ.expect fun i' =>\n Finset.univ.expect fun k => Finset.univ.expect fun k' =>\n (Finset.univ.expect fun j =>\n (f i j k * f i' j k) * (f i j k' * f i' j k')) ^ 2 := by\n calc\n _ ≤ Finset.univ.expect (fun w =>\n (Finset.univ.expect fun j => Finset.univ.expect fun k =>\n Finset.univ.expect fun i => f i j k * g j k w * h i k w * l i j w) ^ 8) :=\n expect_pow_eight_le _\n _ ≤ Finset.univ.expect (fun _ : L =>\n Finset.univ.expect fun i => Finset.univ.expect fun i' =>\n Finset.univ.expect fun k => Finset.univ.expect fun k' =>\n (Finset.univ.expect fun j =>\n (f i j k * f i' j k) * (f i j k' * f i' j k')) ^ 2) := by\n apply Finset.expect_le_expect\n intro w hw\n exact box_three_correlation_bound f (fun j k => g j k w)\n (fun i k => h i k w) (fun i j => l i j w)\n (fun j k => hg j k w) (fun i k => hh i k w) (fun i j => hl i j w)\n _ = _ := Fintype.expect_const _\n\nend Submission.Helpers\n" } ], "snapshot": { "runId": "29ee6fba-bc82-414b-9adf-63de9c0febd4", "phase": "running", "turns": 59, "workers": 4, "taskStatuses": { "pending": 1, "blocked": 4, "completed": 9 } } }, { "id": "annals_fractional_expectation_thresholds", "title": "Fractional expectation thresholds", "subtitle": "分数期望阈值", "area": "概率组合", "summary": "证明上闭集合族的分数期望阈值界，包括通用常数 K 和原题 theorem_1_1。档案保留完整提交包及官方验收记录。", "declaration": "theorem theorem_1_1", "en": { "subtitle": "Threshold bounds for up-closed families", "area": "Probabilistic combinatorics", "summary": "Proves the fractional expectation threshold bound for up-closed families, including the universal constant K and theorem_1_1. The archive keeps the full submission package and its official result." }, "status": "official_accepted", "model": "DeepScientist Math + GPT-6.1 (gpt-6.1-sol)", "updatedAt": "2026-10-15T17:07:13Z", "archiveUrl": "https://github.com/LikC1606/theorem-os-site/tree/main/accepted/annals_fractional_expectation_thresholds", "sources": [ { "name": "Submission.lean", "path": "accepted/annals_fractional_expectation_thresholds/Submission.lean", "url": "https://github.com/LikC1606/theorem-os-site/blob/main/accepted/annals_fractional_expectation_thresholds/Submission.lean", "sha256": "028ce084c75d9015852e6912d05ebf50f40d05522b47267e52c3365c7f19d56e", "lines": 63, "code": "/-\nCopyright (c) 2026 David Ledvinka. All rights reserved.\nReleased under Apache 2.0 license as described in the file LICENSE.\nAuthors: David Ledvinka\n-/\n\nimport Mathlib.Probability.Distributions.SetBernoulli\nimport Submission.Helpers\nimport ChallengeDeps\n/-!\n# Main Statement from Thresholds versus fractional expectation-thresholds\n\nWe formalise the statement of the main result from K. Frankston, J. Kahn, B. Narayanan, and J. Park,\n`Thresholds versus fractional expectation-thresholds`, Annals of Math, 194 (2) 2021.\n-/\n\n\nnamespace Submission\n\nopen _root_.FractionalExpectationThresholds\nset_option autoImplicit false\n\nnamespace FractionalExpectationThresholds\n\nopen ProbabilityTheory unitInterval Set\n\nopen scoped NNReal\n\nsection Definitions\n\n\n\n\n\n\n\n\n\nend Definitions\n\n/-- The constant `K` in Theorem 1.1. -/\nnoncomputable def K : ℝ := Classical.choose Submission.Helpers.finite_threshold_bound_exists\n\n/--\nStatement of Theorem 1.1:\n\nThere exists a universal constant `K` such that for any finite set `X` and any increasing\ncollection of sets `𝓕` such that `l(𝓕)` is at least `2`,\n\n`p_c(𝓕) ≤ K * q_f(𝓕) * log l(𝓕)`.\n\nNote: The assumption that `l(𝓕)` is at least `2` is not explicitly in the paper but is needed\nbecause if `l(𝓕) = 1` then `Real.log (l 𝓕) = 0`, but `p_c 𝓕 ∈ (0,1)` (so the inequality clearly\ncannot hold).\n-/\ntheorem theorem_1_1 (X : Type*) [Fintype X] (𝓕 : Set (Set X)) (h𝓕 : IsUpperSet 𝓕)\n (hl𝓕 : 2 ≤ l 𝓕) : p_c 𝓕 ≤ K * q_f 𝓕 * Real.log (l 𝓕) := by\n exact Submission.Helpers.finite_bound_transfer K\n (Classical.choose_spec Submission.Helpers.finite_threshold_bound_exists) X 𝓕 h𝓕 hl𝓕\n\nend FractionalExpectationThresholds\n\nend Submission\n" }, { "name": "Submission/Helpers.lean", "path": "accepted/annals_fractional_expectation_thresholds/Submission/Helpers.lean", "url": "https://github.com/LikC1606/theorem-os-site/blob/main/accepted/annals_fractional_expectation_thresholds/Submission/Helpers.lean", "sha256": "e0ea3f43432ed60c497193a8bb900ca71bdbb4a16e0c256a6d1bac0b4f273fad", "lines": 1876, "code": "import Mathlib.Data.Nat.Log\nimport Mathlib.Analysis.SpecialFunctions.Log.Basic\nimport Mathlib.Probability.Distributions.SetBernoulli\nimport Mathlib.Data.Finset.Sum\nimport Mathlib.Algebra.BigOperators.Ring.Finset\nimport Mathlib.Tactic\nimport Mathlib.Algebra.BigOperators.Pi\nimport Mathlib.Analysis.LocallyConvex.Separation\nnamespace Submission.Helpers\n\ntheorem finite_cover_functional_eq_sum {m : ℕ} (f : (Fin m → ℝ) →L[ℝ] ℝ)\n (z : Fin m → ℝ) :\n f z = ∑ i, f (Pi.single i 1) * z i := by\n conv_lhs => rw [pi_eq_sum_univ' z]\n simp only [map_sum, map_smul, smul_eq_mul]\n exact Finset.sum_congr rfl (fun i _ => mul_comm _ _)\ntheorem finite_cover_functional_const {m : ℕ} (f : (Fin m → ℝ) →L[ℝ] ℝ)\n (t : ℝ) : f (fun _ => t) = t * f (fun _ => (1 : ℝ)) := by\n have heq : (fun _ : Fin m => t) = t • (fun _ : Fin m => (1 : ℝ)) := by\n ext i\n simp\n rw [heq, map_smul]\n rfl\ntheorem finite_cover_sum_mul_combination {n : ℕ} (c x y : Fin n → ℝ) (a b : ℝ) :\n (∑ j, c j * (a * x j + b * y j)) =\n a * (∑ j, c j * x j) + b * (∑ j, c j * y j) := by\n simp only [mul_add, Finset.sum_add_distrib, Finset.mul_sum]\n congr 1 <;> apply Finset.sum_congr rfl <;> intros <;> ring\ntheorem finite_cover_duality (m n : ℕ) (A : Fin m → Fin n → ℝ) (c : Fin n → ℝ)\n (hA : ∀ i j, 0 ≤ A i j) (hc : ∀ j, 0 < c j)\n (hno : ¬ ∃ x : Fin n → ℝ, (∀ j, 0 ≤ x j) ∧\n (∀ i, 1 ≤ ∑ j : Fin n, A i j * x j) ∧\n (∑ j : Fin n, c j * x j) ≤ (1 / 2 : ℝ)) :\n ∃ w : Fin m → ℝ, (∀ i, 0 ≤ w i) ∧ (∑ i : Fin m, w i) = 1 ∧\n ∀ j, (∑ i : Fin m, w i * A i j) ≤ 2 * c j := by\n classical\n let P : Set (Fin m → ℝ) := {z | ∃ x : Fin n → ℝ,\n (∀ j, 0 ≤ x j) ∧ (∑ j, c j * x j) ≤ (1 / 2 : ℝ) ∧\n z = fun i => ∑ j, A i j * x j}\n let T : Set (Fin m → ℝ) := {z | ∀ i, 1 < z i}\n have hP : Convex ℝ P := by\n rintro u ⟨x, hx, hcostx, rfl⟩ v ⟨y, hy, hcosty, rfl⟩ a b ha hb hab\n refine ⟨fun j => a * x j + b * y j, ?_, ?_, ?_⟩\n · intro j\n exact add_nonneg (mul_nonneg ha (hx j)) (mul_nonneg hb (hy j))\n · rw [finite_cover_sum_mul_combination]\n calc\n a * (∑ j, c j * x j) + b * (∑ j, c j * y j) ≤ a * (1 / 2) + b * (1 / 2) :=\n add_le_add (mul_le_mul_of_nonneg_left hcostx ha)\n (mul_le_mul_of_nonneg_left hcosty hb)\n _ = 1 / 2 := by linarith\n · ext i\n simp only [Pi.add_apply, Pi.smul_apply, smul_eq_mul]\n exact (finite_cover_sum_mul_combination (A i) x y a b).symm\n have hT : Convex ℝ T := by\n intro z hz y hy a b ha hb hab i\n exact (convex_Ioi (𝕜 := ℝ) (1 : ℝ)) (hz i) (hy i) ha hb hab\n have hTop : IsOpen T := by\n have heq : T = ⋂ i : Fin m, {z : Fin m → ℝ | 1 < z i} := by\n ext z\n simp [T]\n rw [heq]\n exact isOpen_iInter_of_finite (fun i => isOpen_lt continuous_const (continuous_apply i))\n have hdisj : Disjoint T P := by\n refine Set.disjoint_left.mpr ?_\n rintro z hz ⟨x, hx, hcost, rfl⟩\n exact hno ⟨x, hx, fun i => (hz i).le, hcost⟩\n obtain ⟨f, u, hfT, hfP⟩ := geometric_hahn_banach_open hT hTop hP hdisj\n let g := -f\n let d := -u\n have hgP : ∀ z ∈ P, g z ≤ d := by\n intro z hz\n exact neg_le_neg (hfP z hz)\n have hgT : ∀ z ∈ T, d < g z := by\n intro z hz\n exact neg_lt_neg (hfT z hz)\n have hzero : (0 : Fin m → ℝ) ∈ P := by\n refine ⟨0, by simp, by norm_num, ?_⟩\n ext i\n simp\n have hd : 0 ≤ d := by simpa using hgP 0 hzero\n let s := g (fun _ : Fin m => (1 : ℝ))\n have hs : 0 < s := by\n have hh := hgT (fun _ => (2 : ℝ)) (by intro i; norm_num)\n have heq : g (fun _ : Fin m => (2 : ℝ)) = 2 * s := by\n exact finite_cover_functional_const g 2\n rw [heq] at hh\n linarith\n let v : Fin m → ℝ := fun i => g (Pi.single i 1)\n have hsum : (∑ i, v i) = s := by\n simpa only [v, s, mul_one] using (finite_cover_functional_eq_sum g (fun _ => (1 : ℝ))).symm\n have hv : ∀ i, 0 ≤ v i := by\n intro i\n by_contra hi\n have hi' : v i < 0 := lt_of_not_ge hi\n let t := (2 * s + 1) / (-v i)\n have ht : 0 < t := div_pos (by linarith) (neg_pos.mpr hi')\n have hz : (fun _ => (2 : ℝ)) + t • Pi.single i 1 ∈ T := by\n intro k\n simp only [Pi.add_apply, Pi.smul_apply, smul_eq_mul, Pi.single_apply]\n split_ifs <;> nlinarith\n have hh := hgT _ hz\n have heq : g ((fun _ : Fin m => (2 : ℝ)) + t • Pi.single i 1) = 2 * s + t * v i := by\n rw [map_add, map_smul]\n have htwo : g (fun _ : Fin m => (2 : ℝ)) = 2 * s := by\n exact finite_cover_functional_const g 2\n exact congrArg (· + t * v i) htwo\n rw [heq] at hh\n have htval : t * v i = -(2 * s + 1) := by\n dsimp [t]\n field_simp [ne_of_lt hi']\n rw [htval] at hh\n linarith\n have hdle : d ≤ s := by\n apply le_of_forall_pos_le_add\n intro ε hε\n let t := 1 + ε / s\n have ht : 1 < t := by dsimp [t]; exact lt_add_of_pos_right _ (div_pos hε hs)\n have hh := hgT (fun _ => t) (by intro i; exact ht)\n have heq : g (fun _ : Fin m => t) = s + ε := by\n rw [finite_cover_functional_const]\n change t * s = s + ε\n dsimp [t]\n field_simp [ne_of_gt hs]\n exact (heq ▸ hh).le\n refine ⟨fun i => v i / s, fun i => div_nonneg (hv i) hs.le, ?_, ?_⟩\n · rw [← Finset.sum_div, hsum, div_self (ne_of_gt hs)]\n · intro j\n have hcj : 0 < c j := hc j\n let x : Fin n → ℝ := Pi.single j ((2 * c j)⁻¹)\n have hx : ∀ k, 0 ≤ x k := by\n intro k\n dsimp [x]\n simp only [Pi.single_apply]\n split_ifs\n · positivity\n · exact le_rfl\n have hcost : (∑ k, c k * x k) ≤ (1 / 2 : ℝ) := by\n dsimp [x]\n simp only [Pi.single_apply, mul_ite, mul_zero, Finset.sum_ite_eq', Finset.mem_univ,\n ite_true]\n rw [show c j * (2 * c j)⁻¹ = (1 / 2 : ℝ) by field_simp [ne_of_gt hcj]]\n have hcol := (hgP (fun i => ∑ k, A i k * x k) ⟨x, hx, hcost, rfl⟩).trans hdle\n rw [finite_cover_functional_eq_sum] at hcol\n have hcol' : (∑ i, v i * A i j) / (2 * c j) ≤ s := by\n calc\n (∑ i, v i * A i j) / (2 * c j) =\n ∑ i, v i * (∑ k, A i k * x k) := by\n rw [Finset.sum_div]\n apply Finset.sum_congr rfl\n intro i _\n simp [x, Pi.single_apply, div_eq_mul_inv, mul_assoc]\n _ ≤ s := hcol\n have hbound : (∑ i, v i * A i j) ≤ s * (2 * c j) :=\n (div_le_iff₀ (by positivity : 0 < 2 * c j)).mp hcol'\n rw [show (∑ i, v i / s * A i j) = (∑ i, v i * A i j) / s by\n simp [Finset.sum_div, div_mul_eq_mul_div]]\n exact (div_le_iff₀ hs).mpr (by nlinarith [hbound])\ntheorem bernoulli_finset_normalization (n : ℕ) (p : ℝ) :\n (∑ W : Finset (Fin n), p ^ W.card * (1 - p) ^ (n - W.card)) = 1 := by\n simpa using Fintype.sum_pow_mul_eq_add_pow (Fin n) p (1 - p)\ntheorem bernoulli_powerset_normalization {α : Type*} (A : Finset α) (p : ℝ) :\n (∑ B ∈ A.powerset, p ^ B.card * (1 - p) ^ (A.card - B.card)) = 1 := by\n simpa using Finset.sum_pow_mul_eq_add_pow p (1 - p) A\ntheorem sum_union_fiber {α : Type*} [Fintype α] [DecidableEq α]\n (A U : Finset α) (hAU : A ⊆ U) (f : Finset α → ℝ) :\n (∑ W : Finset α, if A ∪ W = U then f W else 0) =\n ∑ B ∈ A.powerset, f ((U \\ A) ∪ B) := by\n classical\n rw [← Finset.sum_filter]\n symm\n refine Finset.sum_bij' (fun B _ => (U \\ A) ∪ B) (fun W _ => W ∩ A)\n ?_ ?_ ?_ ?_ (fun _ _ => rfl)\n · intro B hB\n have hBA := Finset.mem_powerset.mp hB\n simp only [Finset.mem_filter, Finset.mem_univ, true_and]\n ext x\n simp only [Finset.mem_union, Finset.mem_sdiff]\n have hAx : x ∈ A → x ∈ U := fun hx => hAU hx\n have hBx : x ∈ B → x ∈ A := fun hx => hBA hx\n tauto\n · intro W _\n exact Finset.mem_powerset.mpr Finset.inter_subset_right\n · intro B hB\n have hBA := Finset.mem_powerset.mp hB\n ext x\n simp only [Finset.mem_inter, Finset.mem_union, Finset.mem_sdiff]\n have hBx : x ∈ B → x ∈ A := fun hx => hBA hx\n tauto\n · intro W hW\n have hW' := (Finset.mem_filter.mp hW).2\n rw [← hW']\n ext x\n simp only [Finset.mem_union, Finset.mem_inter, Finset.mem_sdiff]\n tauto\ntheorem bernoulli_union_fiber (n : ℕ) (p : ℝ) (A U : Finset (Fin n)) :\n (∑ W : Finset (Fin n),\n if A ∪ W = U then p ^ W.card * (1 - p) ^ (n - W.card) else 0) =\n if A ⊆ U then p ^ (U.card - A.card) * (1 - p) ^ (n - U.card) else 0 := by\n classical\n by_cases hAU : A ⊆ U\n · rw [ite_eq_left hAU, sum_union_fiber A U hAU]\n have hcardU : U.card ≤ n := by simpa using Finset.card_le_univ U\n have hcardA : A.card ≤ U.card := Finset.card_le_card hAU\n calc\n (∑ B ∈ A.powerset,\n p ^ ((U \\ A) ∪ B).card * (1 - p) ^ (n - ((U \\ A) ∪ B).card)) =\n (p ^ (U.card - A.card) * (1 - p) ^ (n - U.card)) *\n ∑ B ∈ A.powerset, p ^ B.card * (1 - p) ^ (A.card - B.card) := by\n rw [Finset.mul_sum]\n apply Finset.sum_congr rfl\n intro B hB\n have hBA := Finset.mem_powerset.mp hB\n have hcardB : B.card ≤ A.card := Finset.card_le_card hBA\n have hdisj : Disjoint (U \\ A) B := by\n apply Finset.disjoint_left.mpr\n intro x hx hxB\n exact (Finset.mem_sdiff.mp hx).2 (hBA hxB)\n rw [Finset.card_union_of_disjoint hdisj, Finset.card_sdiff_of_subset hAU]\n rw [show n - (U.card - A.card + B.card) =\n (n - U.card) + (A.card - B.card) by omega]\n simp only [pow_add]\n ring\n _ = p ^ (U.card - A.card) * (1 - p) ^ (n - U.card) := by\n rw [bernoulli_powerset_normalization, mul_one]\n · rw [ite_eq_right hAU]\n apply Finset.sum_eq_zero\n intro W _\n rw [ite_eq_right]\n intro hW\n exact hAU (hW ▸ Finset.subset_union_left)\ntheorem bernoulli_union_fiber_density (n : ℕ) (p : ℝ) (hp : p ≠ 0)\n (A U : Finset (Fin n)) :\n (∑ W : Finset (Fin n),\n if A ∪ W = U then p ^ W.card * (1 - p) ^ (n - W.card) else 0) =\n if A ⊆ U then (p ^ A.card)⁻¹ *\n (p ^ U.card * (1 - p) ^ (n - U.card)) else 0 := by\n classical\n rw [bernoulli_union_fiber]\n by_cases hAU : A ⊆ U\n · simp only [ite_eq_left hAU]\n have hpow : p ^ U.card = p ^ A.card * p ^ (U.card - A.card) := by\n rw [← pow_add, Nat.add_sub_of_le (Finset.card_le_card hAU)]\n rw [hpow]\n simp only [← mul_assoc, inv_mul_cancel₀ (pow_ne_zero _ hp), one_mul]\n · simp only [ite_eq_right hAU]\ntheorem sum_union_reindex {α : Type*} [Fintype α] [DecidableEq α]\n (A : Finset α) (f g : Finset α → ℝ) :\n (∑ W : Finset α, f W * g (A ∪ W)) =\n ∑ U : Finset α, (∑ W : Finset α, if A ∪ W = U then f W else 0) * g U := by\n classical\n simp only [Finset.sum_mul, ite_mul, zero_mul]\n rw [Finset.sum_comm]\n apply Finset.sum_congr rfl\n intro W _\n simp\ntheorem bernoulli_union_expectation (n : ℕ) (p : ℝ) (hp : p ≠ 0)\n (A : Finset (Fin n)) (g : Finset (Fin n) → ℝ) :\n (∑ W : Finset (Fin n),\n (p ^ W.card * (1 - p) ^ (n - W.card)) * g (A ∪ W)) =\n (p ^ A.card)⁻¹ * ∑ U : Finset (Fin n),\n (p ^ U.card * (1 - p) ^ (n - U.card)) * (if A ⊆ U then g U else 0) := by\n classical\n rw [sum_union_reindex, Finset.mul_sum]\n apply Finset.sum_congr rfl\n intro U _\n rw [bernoulli_union_fiber_density n p hp]\n by_cases hAU : A ⊆ U <;> simp [hAU, mul_assoc]\ntheorem planted_union_density (n r : ℕ) (ν : Finset (Fin n) → ℝ) (p : ℝ)\n (g : Finset (Fin n) → ℝ) (hp : 0 < p) (_hp1 : p ≤ 1)\n (hν : ∀ A, ν A ≠ 0 → A.card = r) :\n (∑ A : Finset (Fin n), ν A * ∑ W : Finset (Fin n),\n (p ^ W.card * (1 - p) ^ (n - W.card)) * g (A ∪ W)) =\n (p ^ r)⁻¹ * ∑ U : Finset (Fin n),\n (p ^ U.card * (1 - p) ^ (n - U.card)) *\n (∑ A : Finset (Fin n), if A ⊆ U then ν A else 0) * g U := by\n classical\n calc\n _ = ∑ A : Finset (Fin n), (p ^ r)⁻¹ * ∑ U : Finset (Fin n),\n (p ^ U.card * (1 - p) ^ (n - U.card)) *\n (if A ⊆ U then ν A else 0) * g U := by\n apply Finset.sum_congr rfl\n intro A _\n by_cases hzero : ν A = 0\n · simp [hzero]\n · rw [bernoulli_union_expectation n p (ne_of_gt hp) A g, hν A hzero]\n simp only [Finset.mul_sum]\n apply Finset.sum_congr rfl\n intro U _\n by_cases hAU : A ⊆ U\n · simp only [ite_eq_left hAU]\n ring\n · simp [hAU]\n _ = _ := by\n simp only [Finset.mul_sum, Finset.sum_mul, mul_assoc]\n rw [Finset.sum_comm]\ntheorem bernoulli_containment (n : ℕ) (p : ℝ) (B : Finset (Fin n)) :\n (∑ W : Finset (Fin n),\n if B ⊆ W then p ^ W.card * (1 - p) ^ (n - W.card) else 0) = p ^ B.card := by\n classical\n have hcond (W : Finset (Fin n)) : B ⊆ W ↔ Bᶜ ∪ W = Finset.univ := by\n constructor\n · intro h\n ext x\n simp only [Finset.mem_union, Finset.mem_compl, Finset.mem_univ, iff_true]\n by_cases hx : x ∈ B\n · exact Or.inr (h hx)\n · exact Or.inl hx\n · intro h x hx\n have hm : x ∈ Bᶜ ∪ W := by rw [h]; exact Finset.mem_univ x\n exact (Finset.mem_union.mp hm).resolve_left (by simpa using hx)\n have hcard : n - Bᶜ.card = B.card := by\n rw [Finset.card_compl]\n simp only [Fintype.card_fin]\n have hc : B.card ≤ n := by simpa using Finset.card_le_univ B\n omega\n calc\n _ = ∑ W : Finset (Fin n),\n if Bᶜ ∪ W = Finset.univ then p ^ W.card * (1 - p) ^ (n - W.card) else 0 := by\n simp only [hcond]\n _ = _ := by\n rw [bernoulli_union_fiber, ite_eq_left (Finset.subset_univ _),\n Finset.card_univ, Fintype.card_fin, hcard]\n simp\ntheorem bernoulli_planted_containment (n : ℕ) (p : ℝ) (A B : Finset (Fin n)) :\n (∑ W : Finset (Fin n),\n if B ⊆ A ∪ W then p ^ W.card * (1 - p) ^ (n - W.card) else 0) =\n p ^ (B \\ A).card := by\n classical\n have hcond (W : Finset (Fin n)) : B ⊆ A ∪ W ↔ B \\ A ⊆ W := by\n constructor\n · intro h x hx\n exact (Finset.mem_union.mp (h (Finset.mem_sdiff.mp hx).1)).resolve_left\n (Finset.mem_sdiff.mp hx).2\n · intro h x hx\n by_cases hxA : x ∈ A\n · exact Finset.mem_union_left W hxA\n · exact Finset.mem_union_right A (h (Finset.mem_sdiff.mpr ⟨hx, hxA⟩))\n simp only [hcond]\n exact bernoulli_containment n p (B \\ A)\nnoncomputable def paddingPush {ι β : Type*} [Fintype ι] [DecidableEq β]\n (μ : ι → ℝ) (f : ι → Finset β) (B : Finset β) : ℝ :=\n ∑ i, if f i = B then μ i else 0\ntheorem paddingPush_eval {ι β : Type*} [Fintype ι] [Fintype β] [DecidableEq β]\n (μ : ι → ℝ) (f : ι → Finset β) (g : Finset β → ℝ) :\n (∑ B, paddingPush μ f B * g B) = ∑ i, μ i * g (f i) := by\n classical\n simp only [paddingPush, Finset.sum_mul, ite_mul, zero_mul]\n rw [Finset.sum_comm]\n simp\ntheorem paddingPush_nonneg {ι β : Type*} [Fintype ι] [DecidableEq β]\n (μ : ι → ℝ) (f : ι → Finset β) (hμ : ∀ i, 0 ≤ μ i) (B : Finset β) :\n 0 ≤ paddingPush μ f B := by\n classical\n exact Finset.sum_nonneg (fun i _ => by split_ifs <;> simp_all)\ntheorem paddingPush_support {ι β : Type*} [Fintype ι] [DecidableEq β]\n (μ : ι → ℝ) (f : ι → Finset β) (P : Finset β → Prop)\n (hP : ∀ i, μ i ≠ 0 → P (f i)) (B : Finset β)\n (hB : paddingPush μ f B ≠ 0) : P B := by\n classical\n by_contra h\n apply hB\n apply Finset.sum_eq_zero\n intro i _\n split_ifs with hi\n · by_contra hμ\n exact h (hi ▸ hP i hμ)\n · rfl\ndef paddingStepEdge {α : Type*} [DecidableEq α] {M : ℕ}\n (r : ℕ) (A : Finset α) (j : Fin M) : Finset (α ⊕ Fin M) :=\n A.disjSum (if A.card < r then {j} else ∅)\ntheorem paddingStepEdge_left {α : Type*} [DecidableEq α] {M : ℕ}\n (r : ℕ) (A : Finset α) (j : Fin M) : (paddingStepEdge r A j).toLeft = A := by\n simp [paddingStepEdge]\ntheorem paddingStepEdge_card {α : Type*} [DecidableEq α] {M : ℕ}\n (r : ℕ) (A : Finset α) (j : Fin M) :\n (paddingStepEdge r A j).card = A.card + if A.card < r then 1 else 0 := by\n by_cases h : A.card < r <;> simp [paddingStepEdge, h]\nnoncomputable def paddingStepWeights {α : Type*} [Fintype α] [DecidableEq α]\n (ν : Finset α → ℝ) (r M : ℕ) : Finset (α ⊕ Fin M) → ℝ :=\n paddingPush (fun z : Finset α × Fin M => ν z.1 / M)\n (fun z => paddingStepEdge r z.1 z.2)\ntheorem paddingStepWeights_eval {α : Type*} [Fintype α] [DecidableEq α]\n (ν : Finset α → ℝ) (r M : ℕ) (g : Finset (α ⊕ Fin M) → ℝ) :\n (∑ B, paddingStepWeights ν r M B * g B) =\n ∑ A, ∑ j : Fin M, ν A / M * g (paddingStepEdge r A j) := by\n classical\n simpa only [paddingStepWeights, Fintype.sum_prod_type] using\n paddingPush_eval (fun z : Finset α × Fin M => ν z.1 / M)\n (fun z => paddingStepEdge r z.1 z.2) g\ntheorem paddingStepWeights_left {α : Type*} [Fintype α] [DecidableEq α]\n (ν : Finset α → ℝ) (r M : ℕ) (hM : 0 < M) (g : Finset α → ℝ) :\n (∑ B, paddingStepWeights ν r M B * g B.toLeft) = ∑ A, ν A * g A := by\n classical\n rw [paddingStepWeights_eval]\n apply Finset.sum_congr rfl\n intro A _\n simp only [paddingStepEdge_left, Finset.sum_const, Finset.card_univ, Fintype.card_fin,\n nsmul_eq_mul]\n field_simp\ntheorem paddingStepWeights_cone {α : Type*} [Fintype α] [DecidableEq α]\n (ν : Finset α → ℝ) (r M : ℕ) (S : Finset (α ⊕ Fin M)) :\n (∑ B, if S ⊆ B then paddingStepWeights ν r M B else 0) =\n ∑ A, ∑ j : Fin M, if S ⊆ paddingStepEdge r A j then ν A / M else 0 := by\n classical\n simpa only [mul_ite, mul_one, mul_zero] using\n paddingStepWeights_eval ν r M (fun B => if S ⊆ B then 1 else 0)\ntheorem paddingStepWeights_spread {α : Type*} [Fintype α] [DecidableEq α]\n (ν : Finset α → ℝ) (r M : ℕ) (b : ℝ) (hb : 0 ≤ b) (hM : 0 < M)\n (hMb : 1 / (M : ℝ) ≤ b) (hν : ∀ A, 0 ≤ ν A)\n (hs : ∀ S : Finset α, (∑ A, if S ⊆ A then ν A else 0) ≤ b ^ S.card)\n (S : Finset (α ⊕ Fin M)) :\n (∑ B, if S ⊆ B then paddingStepWeights ν r M B else 0) ≤ b ^ S.card := by\n classical\n rw [paddingStepWeights_cone]\n have hpoint (A : Finset α) :\n (∑ j : Fin M, if S ⊆ paddingStepEdge r A j then ν A / M else 0) ≤\n (if S.toLeft ⊆ A then ν A else 0) * b ^ S.toRight.card := by\n by_cases hleft : S.toLeft ⊆ A\n · rw [if_pos hleft]\n by_cases hzero : S.toRight = ∅\n · simp only [paddingStepEdge, Finset.subset_disjSum, hleft, true_and, hzero,\n Finset.empty_subset, ite_true, Finset.sum_const, Finset.card_univ,\n Fintype.card_fin, nsmul_eq_mul, Finset.card_empty, pow_zero, mul_one]\n have hM' : (M : ℝ) ≠ 0 := by exact_mod_cast hM.ne'\n exact le_of_eq (by field_simp)\n · by_cases hone : S.toRight.card = 1\n · obtain ⟨j₀, hj₀⟩ := Finset.card_eq_one.mp hone\n by_cases hAr : A.card < r\n · simp only [paddingStepEdge, hAr, ite_true, Finset.subset_disjSum, hleft,\n true_and, hj₀, Finset.singleton_subset_iff, Finset.mem_singleton]\n rw [Finset.sum_ite_eq, if_pos (Finset.mem_univ _)]\n simpa only [Finset.card_singleton, pow_one, div_eq_mul_inv, one_mul] using\n mul_le_mul_of_nonneg_left hMb (hν A)\n · have hnot (j : Fin M) : ¬ S ⊆ paddingStepEdge r A j := by\n intro h\n have hh : S.toRight ⊆ (if A.card < r then {j} else ∅) :=\n (Finset.subset_disjSum.mp h).2\n rw [if_neg hAr] at hh\n exact hzero (Finset.subset_empty.mp hh)\n simp only [hnot, ite_false, Finset.sum_const_zero]\n exact mul_nonneg (hν A) (pow_nonneg hb _)\n · have hnot (j : Fin M) : ¬ S ⊆ paddingStepEdge r A j := by\n intro h\n have hcard : S.toRight.card ≤ 1 := by\n have hh : S.toRight ⊆ (if A.card < r then {j} else ∅) :=\n (Finset.subset_disjSum.mp h).2\n have hh' := Finset.card_le_card hh\n by_cases hAr : A.card < r\n · simpa only [if_pos hAr, Finset.card_singleton] using hh'\n · have hh0 : S.toRight.card ≤ 0 := by\n simpa only [if_neg hAr, Finset.card_empty] using hh'\n omega\n have hnz : S.toRight.card ≠ 0 := by simpa using hzero\n omega\n simp only [hnot, ite_false, Finset.sum_const_zero]\n exact mul_nonneg (hν A) (pow_nonneg hb _)\n · have hnot (j : Fin M) : ¬ S ⊆ paddingStepEdge r A j := by\n intro h\n exact hleft (by simpa only [paddingStepEdge_left] using Finset.toLeft_subset_toLeft h)\n simp [hnot, hleft]\n calc\n _ ≤ ∑ A, (if S.toLeft ⊆ A then ν A else 0) * b ^ S.toRight.card :=\n Finset.sum_le_sum (fun A _ => hpoint A)\n _ = (∑ A, if S.toLeft ⊆ A then ν A else 0) * b ^ S.toRight.card :=\n (Finset.sum_mul ..).symm\n _ ≤ b ^ S.toLeft.card * b ^ S.toRight.card :=\n mul_le_mul_of_nonneg_right (hs S.toLeft) (pow_nonneg hb _)\n _ = b ^ S.card := by rw [← pow_add, Finset.card_toLeft_add_card_toRight]\ndef paddingPull {α β : Type*} [Fintype α] [DecidableEq α] [DecidableEq β]\n (e : α ↪ β) (B : Finset β) : Finset α :=\n Finset.univ.filter (fun x => e x ∈ B)\ntheorem paddingPull_mem {α β : Type*} [Fintype α] [DecidableEq α] [DecidableEq β]\n (e : α ↪ β) (B : Finset β) (x : α) : x ∈ paddingPull e B ↔ e x ∈ B := by\n simp [paddingPull]\ntheorem paddingPull_refl {α : Type*} [Fintype α] [DecidableEq α] (B : Finset α) :\n paddingPull (Function.Embedding.refl α) B = B := by\n ext x\n simp [paddingPull]\ntheorem paddingPull_step {α β γ : Type*} [Fintype α] [DecidableEq α]\n [DecidableEq β] [DecidableEq γ] {M : ℕ} (e : α ↪ β)\n (E : β ⊕ Fin M ≃ γ) (B : Finset (β ⊕ Fin M)) :\n paddingPull ((e.trans Function.Embedding.inl).trans E.toEmbedding)\n (B.map E.toEmbedding) = paddingPull e B.toLeft := by\n ext x\n simp [paddingPull, Function.Embedding.trans_apply]\ntheorem paddingRelabel_sum {α β : Type*} [Fintype α] [Fintype β]\n [DecidableEq α] [DecidableEq β] (E : α ≃ β)\n (w : Finset α → ℝ) (g : Finset β → ℝ) :\n (∑ B : Finset β, w (B.map E.symm.toEmbedding) * g B) =\n ∑ A : Finset α, w A * g (A.map E.toEmbedding) := by\n classical\n symm\n apply Fintype.sum_equiv E.finsetCongr\n intro A\n simp [Finset.map_map]\ntheorem paddingRelabel_spread {α β : Type*} [Fintype α] [Fintype β]\n [DecidableEq α] [DecidableEq β] (E : α ≃ β) (w : Finset α → ℝ) (b : ℝ)\n (hs : ∀ S : Finset α, (∑ A, if S ⊆ A then w A else 0) ≤ b ^ S.card)\n (S : Finset β) :\n (∑ B : Finset β, if S ⊆ B then w (B.map E.symm.toEmbedding) else 0) ≤\n b ^ S.card := by\n classical\n have heval := paddingRelabel_sum E w (fun B => if S ⊆ B then 1 else 0)\n simp only [mul_ite, mul_one, mul_zero] at heval\n rw [heval]\n have heq (A : Finset α) : S ⊆ A.map E.toEmbedding ↔ S.map E.symm.toEmbedding ⊆ A := by\n constructor\n · intro h\n have hh := (Finset.map_subset_map (f := E.symm.toEmbedding)).mpr h\n simpa [Finset.map_map] using hh\n · intro h\n have hh := (Finset.map_subset_map (f := E.toEmbedding)).mpr h\n simpa [Finset.map_map] using hh\n simp only [heq]\n simpa only [Finset.card_map] using hs (S.map E.symm.toEmbedding)\ntheorem padding_iterate (n r M : ℕ) (ν : Finset (Fin n) → ℝ) (b : ℝ)\n (hb : 0 ≤ b) (hM : 0 < M) (hMb : 1 / (M : ℝ) ≤ b)\n (hν : ∀ A, 0 ≤ ν A) (hr : ∀ A, ν A ≠ 0 → A.card ≤ r)\n (hs : ∀ S : Finset (Fin n), (∑ A, if S ⊆ A then ν A else 0) ≤ b ^ S.card)\n (k : ℕ) :\n ∃ (N : ℕ) (e : Fin n ↪ Fin N) (w : Finset (Fin N) → ℝ),\n (∀ B, 0 ≤ w B) ∧\n (∀ B, w B ≠ 0 → min k r ≤ B.card ∧ B.card ≤ r) ∧\n (∀ S : Finset (Fin N), (∑ B, if S ⊆ B then w B else 0) ≤ b ^ S.card) ∧\n ∀ g : Finset (Fin n) → ℝ,\n (∑ B, w B * g (paddingPull e B)) = ∑ A, ν A * g A := by\n classical\n induction k with\n | zero =>\n refine ⟨n, Function.Embedding.refl _, ν, hν, ?_, hs, ?_⟩\n · intro A hA\n exact ⟨by simp, hr A hA⟩\n · intro g\n simp only [paddingPull_refl]\n | succ k ih =>\n obtain ⟨N, e, w, hw, hcard, hspread, heval⟩ := ih\n let E : Fin N ⊕ Fin M ≃ Fin (N + M) := finSumFinEquiv\n let v := paddingStepWeights w r M\n let e' := (e.trans Function.Embedding.inl).trans E.toEmbedding\n let w' : Finset (Fin (N + M)) → ℝ := fun B => v (B.map E.symm.toEmbedding)\n have hv : ∀ B, 0 ≤ v B := by\n apply paddingPush_nonneg\n intro z\n exact div_nonneg (hw z.1) (Nat.cast_nonneg M)\n have hvcard : ∀ B, v B ≠ 0 → min (k + 1) r ≤ B.card ∧ B.card ≤ r := by\n apply paddingPush_support\n intro z hz\n have hz' : w z.1 ≠ 0 := by\n intro hz0\n exact hz (by simp [hz0])\n obtain ⟨hlo, hhi⟩ := hcard z.1 hz'\n rw [paddingStepEdge_card]\n split_ifs <;> omega\n refine ⟨N + M, e', w', ?_, ?_, ?_, ?_⟩\n · intro B\n exact hv _\n · intro B hB\n simpa only [Finset.card_map] using hvcard _ hB\n · exact paddingRelabel_spread E v b\n (paddingStepWeights_spread w r M b hb hM hMb hw hspread)\n · intro g\n change (∑ B, v (B.map E.symm.toEmbedding) * g (paddingPull e' B)) = _\n rw [paddingRelabel_sum]\n have hp (B : Finset (Fin N ⊕ Fin M)) :\n paddingPull e' (B.map E.toEmbedding) = paddingPull e B.toLeft :=\n paddingPull_step e E B\n simp only [hp]\n exact (paddingStepWeights_left w r M hM (fun A => g (paddingPull e A))).trans (heval g)\ntheorem spread_padding (n r : ℕ) (ν : Finset (Fin n) → ℝ) (b : ℝ)\n (hb : 0 < b) (hν : ∀ A, 0 ≤ ν A) (hmass : (∑ A : Finset (Fin n), ν A) ≤ 1)\n (hr : ∀ A, ν A ≠ 0 → A.card ≤ r)\n (hs : ∀ S : Finset (Fin n), (∑ A : Finset (Fin n), if S ⊆ A then ν A else 0) ≤ b ^ S.card) :\n ∃ (N : ℕ) (e : Fin n ↪ Fin N) (w : Finset (Fin N) → ℝ),\n (∀ B, 0 ≤ w B) ∧ (∀ B, w B ≠ 0 → B.card = r) ∧\n (∑ B : Finset (Fin N), w B) = (∑ A : Finset (Fin n), ν A) ∧\n (∀ S : Finset (Fin N), (∑ B : Finset (Fin N), if S ⊆ B then w B else 0) ≤ b ^ S.card) ∧\n ∀ A : Finset (Fin n),\n (∑ B : Finset (Fin N), if (∀ x : Fin n, e x ∈ B ↔ x ∈ A) then w B else 0) = ν A := by\n classical\n obtain ⟨m, hm⟩ := exists_nat_one_div_lt hb\n have hMb : 1 / ((m + 1 : ℕ) : ℝ) ≤ b := by\n have hm' : 1 / ((m + 1 : ℕ) : ℝ) < b := by\n simpa only [Nat.cast_add, Nat.cast_one] using hm\n exact hm'.le\n obtain ⟨N, e, w, hw, hcard, hspread, heval⟩ :=\n padding_iterate n r (m + 1) ν b hb.le (by omega) hMb hν hr hs r\n refine ⟨N, e, w, hw, ?_, ?_, hspread, ?_⟩\n · intro B hB\n have hh := hcard B hB\n simp only [min_self] at hh\n exact Nat.le_antisymm hh.2 hh.1\n · simpa only [mul_one] using heval (fun _ => 1)\n · intro A\n have hp (B : Finset (Fin N)) :\n (∀ x : Fin n, e x ∈ B ↔ x ∈ A) ↔ paddingPull e B = A := by\n simp only [Finset.ext_iff, paddingPull_mem]\n simp only [hp]\n simpa only [mul_ite, mul_one, mul_zero, Finset.sum_ite_eq',\n Finset.mem_univ, ite_true] using heval (fun A' => if A' = A then 1 else 0)\ntheorem fragmentation_ratio_pow (r s : ℕ) (b p : ℝ) (hb : 0 ≤ b) (hp : 0 < p)\n (hbp : (2 : ℝ) ^ 32 * b ≤ p) (hrs : r ≤ 2 * s) :\n (b / p) ^ s ≤ ((65536 : ℝ) ^ r)⁻¹ := by\n have hratio : b / p ≤ ((2 : ℝ) ^ 32)⁻¹ := by\n apply (div_le_iff₀ hp).mpr\n calc\n b = ((2 : ℝ) ^ 32)⁻¹ * ((2 : ℝ) ^ 32 * b) := by norm_num; ring\n _ ≤ ((2 : ℝ) ^ 32)⁻¹ * p :=\n mul_le_mul_of_nonneg_left hbp (by positivity)\n calc\n (b / p) ^ s ≤ (((2 : ℝ) ^ 32)⁻¹) ^ s :=\n pow_le_pow_left₀ (div_nonneg hb hp.le) hratio _\n _ = ((2 : ℝ) ^ (32 * s))⁻¹ := by rw [inv_pow, ← pow_mul]\n _ ≤ ((2 : ℝ) ^ (16 * r))⁻¹ := by\n apply inv_anti₀ (by positivity)\n exact pow_le_pow_right₀ (by norm_num) (by omega)\n _ = ((65536 : ℝ) ^ r)⁻¹ := by rw [pow_mul]; norm_num\ndef fragmentWeight (n : ℕ) (p : ℝ) (W : Finset (Fin n)) : ℝ :=\n p ^ W.card * (1 - p) ^ (n - W.card)\nnoncomputable def fragmentDensity {n : ℕ} (ν : Finset (Fin n) → ℝ)\n (U : Finset (Fin n)) : ℝ := ∑ B, if B ⊆ U then ν B else 0\nnoncomputable def fragmentHigh {n : ℕ} (ν : Finset (Fin n) → ℝ) (r : ℕ)\n (A U : Finset (Fin n)) : ℝ :=\n ∑ B, if r < 2 * (A ∩ B).card ∧ B ⊆ U then ν B else 0\ndef fragmentBad {n : ℕ} (ν : Finset (Fin n) → ℝ) (r : ℕ)\n (A W : Finset (Fin n)) : Prop :=\n ¬ ∃ B : Finset (Fin n), 0 < ν B ∧ B ⊆ A ∪ W ∧ (B \\ W).card ≤ r / 2\ntheorem fragmentWeight_nonneg (n : ℕ) (p : ℝ) (hp : 0 ≤ p) (hp1 : p ≤ 1)\n (W : Finset (Fin n)) : 0 ≤ fragmentWeight n p W := by\n exact mul_nonneg (pow_nonneg hp _) (pow_nonneg (sub_nonneg.mpr hp1) _)\ntheorem fragmentDensity_nonneg {n : ℕ} (ν : Finset (Fin n) → ℝ)\n (hν : ∀ B, 0 ≤ ν B) (U : Finset (Fin n)) : 0 ≤ fragmentDensity ν U := by\n classical\n apply Finset.sum_nonneg\n intro B _\n split_ifs\n · exact hν B\n · exact le_rfl\ntheorem fragmentHigh_nonneg {n : ℕ} (ν : Finset (Fin n) → ℝ)\n (hν : ∀ B, 0 ≤ ν B) (r : ℕ) (A U : Finset (Fin n)) :\n 0 ≤ fragmentHigh ν r A U := by\n classical\n apply Finset.sum_nonneg\n intro B _\n split_ifs\n · exact hν B\n · exact le_rfl\ntheorem fragmentation_high_moment_eq (n r : ℕ) (ν : Finset (Fin n) → ℝ)\n (p : ℝ) (A : Finset (Fin n)) :\n (∑ W, fragmentWeight n p W * fragmentHigh ν r A (A ∪ W)) =\n ∑ B : Finset (Fin n),\n if r < 2 * (A ∩ B).card then ν B * p ^ (B \\ A).card else 0 := by\n classical\n simp only [fragmentHigh, Finset.mul_sum]\n rw [Finset.sum_comm]\n apply Finset.sum_congr rfl\n intro B _\n by_cases hh : r < 2 * (A ∩ B).card\n · simp only [hh, true_and, ite_true]\n calc\n _ = (∑ W : Finset (Fin n),\n if B ⊆ A ∪ W then fragmentWeight n p W else 0) * ν B := by\n simp only [Finset.sum_mul, mul_ite, ite_mul, mul_zero, zero_mul]\n _ = _ := by\n simp only [fragmentWeight]\n rw [bernoulli_planted_containment]\n ring\n · simp [hh]\ntheorem fragmentation_inter_moment_le (n r : ℕ) (ν : Finset (Fin n) → ℝ)\n (p : ℝ) (hp : 0 ≤ p) (hν : ∀ B, 0 ≤ ν B)\n (huniform : ∀ B, ν B ≠ 0 → B.card = r) (A S : Finset (Fin n))\n (hh : r < 2 * S.card) :\n (∑ B ∈ Finset.univ.filter (fun B : Finset (Fin n) => A ∩ B = S),\n if r < 2 * (A ∩ B).card then ν B * p ^ (B \\ A).card else 0) ≤\n p ^ (r - S.card) * ∑ B : Finset (Fin n), if S ⊆ B then ν B else 0 := by\n classical\n rw [Finset.sum_filter, Finset.mul_sum]\n apply Finset.sum_le_sum\n intro B _\n by_cases heq : A ∩ B = S\n · have hSB : S ⊆ B := by rw [← heq]; exact Finset.inter_subset_right\n simp only [heq, ite_eq_left hh, ite_eq_left hSB]\n by_cases hz : ν B = 0\n · simp [hz]\n · have hc := Finset.card_sdiff_add_card_inter B A\n rw [Finset.inter_comm B A, heq, huniform B hz] at hc\n rw [show (B \\ A).card = r - S.card by omega]\n exact le_of_eq (mul_comm _ _)\n · rw [ite_eq_right heq]\n apply mul_nonneg (pow_nonneg hp _)\n split_ifs\n · exact hν B\n · exact le_rfl\ntheorem fragmentation_high_moment_le (n r : ℕ) (ν : Finset (Fin n) → ℝ)\n (b p : ℝ) (hν : ∀ B, 0 ≤ ν B)\n (huniform : ∀ B, ν B ≠ 0 → B.card = r) (hb : 0 ≤ b)\n (hspread : ∀ S : Finset (Fin n),\n (∑ B : Finset (Fin n), if S ⊆ B then ν B else 0) ≤ b ^ S.card)\n (hp : 0 < p) (hbp : (2 : ℝ) ^ 32 * b ≤ p)\n (A : Finset (Fin n)) (hA : A.card = r) :\n (∑ W, fragmentWeight n p W * fragmentHigh ν r A (A ∪ W)) ≤\n p ^ r * ((32768 : ℝ) ^ r)⁻¹ := by\n classical\n rw [fragmentation_high_moment_eq]\n have hmap : ∀ B ∈ (Finset.univ : Finset (Finset (Fin n))), A ∩ B ∈ A.powerset := by\n intro B _\n exact Finset.mem_powerset.mpr Finset.inter_subset_left\n rw [← Finset.sum_fiberwise_of_maps_to hmap]\n calc\n _ ≤ ∑ S ∈ A.powerset, p ^ r * ((65536 : ℝ) ^ r)⁻¹ := by\n apply Finset.sum_le_sum\n intro S hS\n have hSr : S.card ≤ r := by\n rw [← hA]\n exact Finset.card_le_card (Finset.mem_powerset.mp hS)\n by_cases hh : r < 2 * S.card\n · calc\n _ ≤ p ^ (r - S.card) * ∑ B : Finset (Fin n), if S ⊆ B then ν B else 0 :=\n fragmentation_inter_moment_le n r ν p hp.le hν huniform A S hh\n _ ≤ p ^ (r - S.card) * b ^ S.card :=\n mul_le_mul_of_nonneg_left (hspread S) (pow_nonneg hp.le _)\n _ = p ^ r * (b / p) ^ S.card := by\n rw [div_pow, ← mul_div_assoc]\n apply (eq_div_iff (pow_ne_zero _ (ne_of_gt hp))).mpr\n calc\n _ = (p ^ (r - S.card) * p ^ S.card) * b ^ S.card := by ring\n _ = _ := by rw [← pow_add, Nat.sub_add_cancel hSr]\n _ ≤ _ := mul_le_mul_of_nonneg_left\n (fragmentation_ratio_pow r S.card b p hb hp hbp (by omega)) (pow_nonneg hp.le _)\n · have hz : (∑ B ∈ Finset.univ.filter (fun B : Finset (Fin n) => A ∩ B = S),\n if r < 2 * (A ∩ B).card then ν B * p ^ (B \\ A).card else 0) = 0 := by\n apply Finset.sum_eq_zero\n intro B hB\n have heq := (Finset.mem_filter.mp hB).2\n simp [heq, hh]\n rw [hz]\n positivity\n _ = _ := by\n rw [Finset.sum_const, Finset.card_powerset, hA, nsmul_eq_mul, Nat.cast_pow,\n Nat.cast_ofNat]\n have heq : (2 : ℝ) ^ r * ((65536 : ℝ) ^ r)⁻¹ = ((32768 : ℝ) ^ r)⁻¹ := by\n rw [← div_eq_mul_inv, ← div_pow,\n show (2 : ℝ) / 65536 = (32768 : ℝ)⁻¹ by norm_num, inv_pow]\n calc\n _ = p ^ r * ((2 : ℝ) ^ r * ((65536 : ℝ) ^ r)⁻¹) := by ring\n _ = _ := by rw [heq]\ntheorem fragmentBad_density_eq_high {n : ℕ} (ν : Finset (Fin n) → ℝ)\n (hν : ∀ B, 0 ≤ ν B) (r : ℕ) (A W : Finset (Fin n))\n (hbad : fragmentBad ν r A W) :\n fragmentDensity ν (A ∪ W) = fragmentHigh ν r A (A ∪ W) := by\n classical\n apply Finset.sum_congr rfl\n intro B _\n by_cases hBU : B ⊆ A ∪ W\n · by_cases hz : ν B = 0\n · simp [hz]\n · have hv : 0 < ν B := lt_of_le_of_ne (hν B) (Ne.symm hz)\n have hlarge : ¬ (B \\ W).card ≤ r / 2 := fun hh => hbad ⟨B, hv, hBU, hh⟩\n have hsub : B \\ W ⊆ A ∩ B := by\n intro x hx\n have hxB := (Finset.mem_sdiff.mp hx).1\n have hxW := (Finset.mem_sdiff.mp hx).2\n exact Finset.mem_inter.mpr\n ⟨(Finset.mem_union.mp (hBU hxB)).resolve_right hxW, hxB⟩\n have hc := Finset.card_le_card hsub\n have hh : r < 2 * (A ∩ B).card := by omega\n simp [hBU, hh]\n · simp [hBU]\ntheorem fragmentation_low_density_le (n r : ℕ) (ν : Finset (Fin n) → ℝ)\n (p t : ℝ) (hν : ∀ A, 0 ≤ ν A)\n (huniform : ∀ A, ν A ≠ 0 → A.card = r)\n (hp : 0 < p) (hp1 : p ≤ 1) (ht : 0 ≤ t) :\n (∑ A, ν A * ∑ W, fragmentWeight n p W *\n (if fragmentDensity ν (A ∪ W) ≤ t then (1 : ℝ) else 0)) ≤\n (p ^ r)⁻¹ * t := by\n classical\n have hd := planted_union_density n r ν p\n (fun U => if fragmentDensity ν U ≤ t then (1 : ℝ) else 0) hp hp1 huniform\n change (∑ A, ν A * ∑ W, fragmentWeight n p W *\n (if fragmentDensity ν (A ∪ W) ≤ t then (1 : ℝ) else 0)) =\n (p ^ r)⁻¹ * ∑ U, fragmentWeight n p U * fragmentDensity ν U *\n (if fragmentDensity ν U ≤ t then (1 : ℝ) else 0) at hd\n rw [hd]\n apply mul_le_mul_of_nonneg_left _ (by positivity)\n calc\n _ ≤ ∑ U : Finset (Fin n), fragmentWeight n p U * t := by\n apply Finset.sum_le_sum\n intro U _\n have hw := fragmentWeight_nonneg n p hp.le hp1 U\n by_cases hU : fragmentDensity ν U ≤ t\n · simp only [ite_eq_left hU, mul_one]\n exact mul_le_mul_of_nonneg_left hU hw\n · simp only [ite_eq_right hU, mul_zero]\n exact mul_nonneg hw ht\n _ = t := by\n rw [← Finset.sum_mul]\n simp only [fragmentWeight]\n rw [bernoulli_finset_normalization, one_mul]\ntheorem fragmentation_bad_indicator_le {n : ℕ} (ν : Finset (Fin n) → ℝ)\n (hν : ∀ B, 0 ≤ ν B) (r : ℕ) (A W : Finset (Fin n))\n (t : ℝ) (ht : 0 < t) :\n (@ite ℝ (fragmentBad ν r A W) (Classical.propDecidable _) 1 0) ≤\n (if fragmentDensity ν (A ∪ W) ≤ t then (1 : ℝ) else 0) +\n fragmentHigh ν r A (A ∪ W) / t := by\n classical\n have hH := fragmentHigh_nonneg ν hν r A (A ∪ W)\n have hHt : 0 ≤ fragmentHigh ν r A (A ∪ W) / t := div_nonneg hH ht.le\n by_cases hbad : fragmentBad ν r A W\n · rw [ite_eq_left hbad]\n by_cases hlow : fragmentDensity ν (A ∪ W) ≤ t\n · rw [ite_eq_left hlow]\n linarith\n · rw [ite_eq_right hlow, zero_add, le_div_iff₀ ht, one_mul]\n rw [← fragmentBad_density_eq_high ν hν r A W hbad]\n exact (lt_of_not_ge hlow).le\n · rw [ite_eq_right hbad]\n split_ifs <;> linarith\ntheorem fragmentation_total_high_le (n r : ℕ) (ν : Finset (Fin n) → ℝ)\n (b p : ℝ) (hν : ∀ A, 0 ≤ ν A) (hmass : (∑ A, ν A) ≤ 1)\n (huniform : ∀ A, ν A ≠ 0 → A.card = r) (hb : 0 ≤ b)\n (hspread : ∀ S : Finset (Fin n),\n (∑ A : Finset (Fin n), if S ⊆ A then ν A else 0) ≤ b ^ S.card)\n (hp : 0 < p) (hbp : (2 : ℝ) ^ 32 * b ≤ p) :\n (∑ A, ν A * ∑ W, fragmentWeight n p W * fragmentHigh ν r A (A ∪ W)) ≤\n p ^ r * ((32768 : ℝ) ^ r)⁻¹ := by\n classical\n calc\n _ ≤ ∑ A : Finset (Fin n), ν A * (p ^ r * ((32768 : ℝ) ^ r)⁻¹) := by\n apply Finset.sum_le_sum\n intro A _\n by_cases hz : ν A = 0\n · simp [hz]\n · exact mul_le_mul_of_nonneg_left\n (fragmentation_high_moment_le n r ν b p hν huniform hb hspread hp hbp A\n (huniform A hz)) (hν A)\n _ = (∑ A, ν A) * (p ^ r * ((32768 : ℝ) ^ r)⁻¹) := by rw [Finset.sum_mul]\n _ ≤ 1 * (p ^ r * ((32768 : ℝ) ^ r)⁻¹) :=\n mul_le_mul_of_nonneg_right hmass (by positivity)\n _ = _ := one_mul _\ntheorem fragmentation_loss_le (n r : ℕ) (ν : Finset (Fin n) → ℝ)\n (b p t : ℝ) (hν : ∀ A, 0 ≤ ν A) (hmass : (∑ A, ν A) ≤ 1)\n (huniform : ∀ A, ν A ≠ 0 → A.card = r) (hb : 0 ≤ b)\n (hspread : ∀ S : Finset (Fin n),\n (∑ A : Finset (Fin n), if S ⊆ A then ν A else 0) ≤ b ^ S.card)\n (hp : 0 < p) (hp1 : p ≤ 1) (hbp : (2 : ℝ) ^ 32 * b ≤ p) (ht : 0 < t) :\n (∑ W, fragmentWeight n p W * ∑ A : Finset (Fin n),\n @ite ℝ (fragmentBad ν r A W) (Classical.propDecidable _) (ν A) 0) ≤\n (p ^ r)⁻¹ * t + (p ^ r * ((32768 : ℝ) ^ r)⁻¹) / t := by\n classical\n calc\n _ = ∑ A : Finset (Fin n), ν A * ∑ W : Finset (Fin n),\n fragmentWeight n p W * (if fragmentBad ν r A W then (1 : ℝ) else 0) := by\n simp only [Finset.mul_sum]\n rw [Finset.sum_comm]\n apply Finset.sum_congr rfl\n intro A _\n apply Finset.sum_congr rfl\n intro W _\n split_ifs <;> ring\n _ ≤ ∑ A : Finset (Fin n), ν A * ∑ W : Finset (Fin n),\n fragmentWeight n p W *\n ((if fragmentDensity ν (A ∪ W) ≤ t then (1 : ℝ) else 0) +\n fragmentHigh ν r A (A ∪ W) / t) := by\n apply Finset.sum_le_sum\n intro A _\n apply mul_le_mul_of_nonneg_left _ (hν A)\n apply Finset.sum_le_sum\n intro W _\n exact mul_le_mul_of_nonneg_left (fragmentation_bad_indicator_le ν hν r A W t ht)\n (fragmentWeight_nonneg n p hp.le hp1 W)\n _ = (∑ A, ν A * ∑ W, fragmentWeight n p W *\n (if fragmentDensity ν (A ∪ W) ≤ t then (1 : ℝ) else 0)) +\n (∑ A, ν A * ∑ W, fragmentWeight n p W * fragmentHigh ν r A (A ∪ W)) / t := by\n simp only [mul_add, Finset.sum_add_distrib, ← mul_div_assoc, ← Finset.sum_div]\n _ ≤ _ := add_le_add\n (fragmentation_low_density_le n r ν p t hν huniform hp hp1 ht.le)\n (div_le_div_of_nonneg_right\n (fragmentation_total_high_le n r ν b p hν hmass huniform hb hspread hp hbp) ht.le)\ntheorem fragmentation_error_sum_le (r : ℕ) (hr : 1 ≤ r) :\n ((128 : ℝ) ^ r)⁻¹ + ((256 : ℝ) ^ r)⁻¹ ≤ ((64 : ℝ) ^ r)⁻¹ := by\n have h2 : ((2 : ℝ) ^ r)⁻¹ ≤ 1 / 2 := by\n simpa only [one_div, pow_one] using\n (one_div_pow_le_one_div_pow_of_le (a := (2 : ℝ)) (by norm_num) hr)\n have h4 : ((4 : ℝ) ^ r)⁻¹ ≤ 1 / 4 := by\n simpa only [one_div, pow_one] using\n (one_div_pow_le_one_div_pow_of_le (a := (4 : ℝ)) (by norm_num) hr)\n have h128 : (128 : ℝ) ^ r = (64 : ℝ) ^ r * (2 : ℝ) ^ r := by\n rw [← mul_pow]; norm_num\n have h256 : (256 : ℝ) ^ r = (64 : ℝ) ^ r * (4 : ℝ) ^ r := by\n rw [← mul_pow]; norm_num\n calc\n _ = ((64 : ℝ) ^ r)⁻¹ * (((2 : ℝ) ^ r)⁻¹ + ((4 : ℝ) ^ r)⁻¹) := by\n rw [h128, h256, mul_inv_rev, mul_inv_rev]\n ring\n _ ≤ ((64 : ℝ) ^ r)⁻¹ * (1 / 2 + 1 / 4) :=\n mul_le_mul_of_nonneg_left (add_le_add h2 h4) (by positivity)\n _ ≤ _ := by nlinarith [show 0 ≤ ((64 : ℝ) ^ r)⁻¹ by positivity]\ntheorem fragmentation_step (n r : ℕ) (ν : Finset (Fin n) → ℝ) (b p : ℝ)\n (hr : 1 ≤ r) (hν : ∀ A, 0 ≤ ν A) (hmass : (∑ A : Finset (Fin n), ν A) ≤ 1)\n (huniform : ∀ A, ν A ≠ 0 → A.card = r) (hb : 0 ≤ b)\n (hspread : ∀ S : Finset (Fin n),\n (∑ A : Finset (Fin n), if S ⊆ A then ν A else 0) ≤ b ^ S.card)\n (hp : 0 < p) (hp1 : p ≤ 1) (hbp : (2 : ℝ) ^ 32 * b ≤ p) :\n (∑ W : Finset (Fin n), (p ^ W.card * (1 - p) ^ (n - W.card)) *\n ∑ A : Finset (Fin n),\n @ite ℝ (¬ ∃ B : Finset (Fin n),\n 0 < ν B ∧ B ⊆ A ∪ W ∧ (B \\ W).card ≤ r / 2)\n (Classical.propDecidable _) (ν A) 0) ≤ ((64 : ℝ) ^ r)⁻¹ := by\n classical\n have hpR : p ^ r ≠ 0 := pow_ne_zero _ (ne_of_gt hp)\n have h128 : (128 : ℝ) ^ r ≠ 0 := by positivity\n have h256 : (256 : ℝ) ^ r ≠ 0 := by positivity\n have hnum : (32768 : ℝ) ^ r = (128 : ℝ) ^ r * (256 : ℝ) ^ r := by\n rw [← mul_pow]; norm_num\n calc\n _ ≤ (p ^ r)⁻¹ * (p ^ r * ((128 : ℝ) ^ r)⁻¹) +\n (p ^ r * ((32768 : ℝ) ^ r)⁻¹) / (p ^ r * ((128 : ℝ) ^ r)⁻¹) :=\n fragmentation_loss_le n r ν b p (p ^ r * ((128 : ℝ) ^ r)⁻¹)\n hν hmass huniform hb hspread hp hp1 hbp (by positivity)\n _ = ((128 : ℝ) ^ r)⁻¹ + ((256 : ℝ) ^ r)⁻¹ := by\n rw [hnum]\n field_simp\n _ ≤ _ := fragmentation_error_sum_le r hr\ntheorem bernoulli_union_kernel (n : ℕ) (p q : ℝ) (W : Finset (Fin n)) :\n (∑ U : Finset (Fin n), (p ^ U.card * (1 - p) ^ (n - U.card)) *\n (if U ⊆ W then q ^ (W.card - U.card) * (1 - q) ^ (n - W.card) else 0)) =\n (p + q - p * q) ^ W.card *\n (1 - (p + q - p * q)) ^ (n - W.card) := by\n classical\n have hcW : W.card ≤ n := by simpa using Finset.card_le_univ W\n calc\n _ = ∑ U ∈ W.powerset, (p ^ U.card * (1 - p) ^ (n - U.card)) *\n (q ^ (W.card - U.card) * (1 - q) ^ (n - W.card)) := by\n simp only [mul_ite, mul_zero]\n rw [← Finset.sum_filter]\n congr 1\n ext U\n simp\n _ = ((1 - p) * (1 - q)) ^ (n - W.card) *\n ∑ U ∈ W.powerset, p ^ U.card * ((1 - p) * q) ^ (W.card - U.card) := by\n rw [Finset.mul_sum]\n apply Finset.sum_congr rfl\n intro U hU\n have hcU : U.card ≤ W.card := Finset.card_le_card (Finset.mem_powerset.mp hU)\n rw [show n - U.card = (n - W.card) + (W.card - U.card) by omega]\n simp only [pow_add, mul_pow]\n ring\n _ = _ := by\n rw [Finset.sum_pow_mul_eq_add_pow]\n rw [show (1 - p) * (1 - q) = 1 - (p + q - p * q) by ring,\n show p + (1 - p) * q = p + q - p * q by ring]\n ring\ntheorem bernoulli_union_convolution (n : ℕ) (p q : ℝ) (g : Finset (Fin n) → ℝ) :\n (∑ U : Finset (Fin n), (p ^ U.card * (1 - p) ^ (n - U.card)) *\n ∑ V : Finset (Fin n), (q ^ V.card * (1 - q) ^ (n - V.card)) * g (U ∪ V)) =\n ∑ W : Finset (Fin n), ((p + q - p * q) ^ W.card *\n (1 - (p + q - p * q)) ^ (n - W.card)) * g W := by\n classical\n calc\n _ = ∑ U : Finset (Fin n), (p ^ U.card * (1 - p) ^ (n - U.card)) *\n ∑ W : Finset (Fin n),\n (if U ⊆ W then q ^ (W.card - U.card) * (1 - q) ^ (n - W.card) else 0) * g W := by\n apply Finset.sum_congr rfl\n intro U _\n rw [sum_union_reindex]\n simp only [bernoulli_union_fiber]\n _ = ∑ W : Finset (Fin n),\n (∑ U : Finset (Fin n), (p ^ U.card * (1 - p) ^ (n - U.card)) *\n (if U ⊆ W then q ^ (W.card - U.card) * (1 - q) ^ (n - W.card) else 0)) * g W := by\n simp only [Finset.mul_sum, Finset.sum_mul, mul_assoc]\n rw [Finset.sum_comm]\n _ = _ := by\n apply Finset.sum_congr rfl\n intro W _\n rw [bernoulli_union_kernel]\ntheorem bernoulli_expectation_mono (n : ℕ) (p t : ℝ) (g : Finset (Fin n) → ℝ)\n (hp : 0 ≤ p) (hpt : p ≤ t) (ht : t ≤ 1)\n (hg : ∀ A B : Finset (Fin n), A ⊆ B → g A ≤ g B) :\n (∑ U : Finset (Fin n), (p ^ U.card * (1 - p) ^ (n - U.card)) * g U) ≤\n ∑ U : Finset (Fin n), (t ^ U.card * (1 - t) ^ (n - U.card)) * g U := by\n classical\n by_cases hpeq : p = 1\n · have hteq : t = 1 := by linarith\n simp only [hpeq, hteq, le_refl]\n have hp1 : p < 1 := lt_of_le_of_ne (hpt.trans ht) hpeq\n let q := (t - p) / (1 - p)\n have hq : 0 ≤ q := div_nonneg (sub_nonneg.mpr hpt) (by linarith)\n have hq1 : q ≤ 1 := by\n apply (div_le_one (by linarith : 0 < 1 - p)).mpr\n linarith\n have hparam : p + q - p * q = t := by\n dsimp [q]\n field_simp\n <;> ring\n calc\n _ = ∑ U : Finset (Fin n), (p ^ U.card * (1 - p) ^ (n - U.card)) *\n ∑ V : Finset (Fin n), (q ^ V.card * (1 - q) ^ (n - V.card)) * g U := by\n apply Finset.sum_congr rfl\n intro U _\n rw [← Finset.sum_mul, bernoulli_finset_normalization, one_mul]\n _ ≤ ∑ U : Finset (Fin n), (p ^ U.card * (1 - p) ^ (n - U.card)) *\n ∑ V : Finset (Fin n), (q ^ V.card * (1 - q) ^ (n - V.card)) * g (U ∪ V) := by\n apply Finset.sum_le_sum\n intro U _\n apply mul_le_mul_of_nonneg_left _ (fragmentWeight_nonneg n p hp hp1.le U)\n apply Finset.sum_le_sum\n intro V _\n exact mul_le_mul_of_nonneg_left (hg U (U ∪ V) Finset.subset_union_left)\n (fragmentWeight_nonneg n q hq hq1 V)\n _ = _ := by rw [bernoulli_union_convolution, hparam]\ntheorem fragment_update (n r : ℕ) (ν : Finset (Fin n) → ℝ) (b p : ℝ)\n (hr : 1 ≤ r) (hν : ∀ A, 0 ≤ ν A) (hmass : (∑ A : Finset (Fin n), ν A) ≤ 1)\n (huniform : ∀ A, ν A ≠ 0 → A.card = r) (hb : 0 ≤ b)\n (hspread : ∀ S : Finset (Fin n),\n (∑ A : Finset (Fin n), if S ⊆ A then ν A else 0) ≤ b ^ S.card)\n (hp : 0 < p) (hp1 : p ≤ 1) (hbp : (2 : ℝ) ^ 32 * b ≤ p) :\n ∃ μ : Finset (Fin n) → Finset (Fin n) → ℝ,\n (∀ W T, 0 ≤ μ W T) ∧\n (∀ W T, μ W T ≠ 0 → T.card ≤ r / 2) ∧\n (∀ W, (∑ T : Finset (Fin n), μ W T) ≤ (∑ A : Finset (Fin n), ν A)) ∧\n (∀ W S : Finset (Fin n),\n (∑ T : Finset (Fin n), if S ⊆ T then μ W T else 0) ≤ b ^ S.card) ∧\n (∀ W T, 0 < μ W T → ∃ B : Finset (Fin n), 0 < ν B ∧ B ⊆ T ∪ W) ∧\n (∑ W : Finset (Fin n), (p ^ W.card * (1 - p) ^ (n - W.card)) *\n ((∑ A : Finset (Fin n), ν A) - ∑ T : Finset (Fin n), μ W T)) ≤\n ((64 : ℝ) ^ r)⁻¹ := by\n classical\n let good (W A : Finset (Fin n)) : Prop :=\n ∃ B : Finset (Fin n), 0 < ν B ∧ B ⊆ A ∪ W ∧ (B \\ W).card ≤ r / 2\n let f (W A : Finset (Fin n)) : Finset (Fin n) :=\n if hg : good W A then (Classical.choose hg) \\ W else ∅\n have hf (W A : Finset (Fin n)) (hg : good W A) :\n f W A ⊆ A ∧ (f W A).card ≤ r / 2 ∧\n ∃ B : Finset (Fin n), 0 < ν B ∧ B ⊆ f W A ∪ W := by\n have hB := Classical.choose_spec hg\n dsimp only [f]\n rw [dite_eq_left hg]\n refine ⟨?_, hB.2.2, Classical.choose hg, hB.1, ?_⟩\n · intro x hx\n exact (Finset.mem_union.mp (hB.2.1 (Finset.mem_sdiff.mp hx).1)).resolve_right\n (Finset.mem_sdiff.mp hx).2\n · intro x hx\n by_cases hxW : x ∈ W\n · exact Finset.mem_union_right _ hxW\n · exact Finset.mem_union_left _ (Finset.mem_sdiff.mpr ⟨hx, hxW⟩)\n let v (W A : Finset (Fin n)) : ℝ := if good W A then ν A else 0\n let μ (W : Finset (Fin n)) := paddingPush (v W) (f W)\n have hv (W A : Finset (Fin n)) : 0 ≤ v W A := by\n dsimp [v]\n split_ifs\n · exact hν A\n · exact le_rfl\n have hvle (W A : Finset (Fin n)) : v W A ≤ ν A := by\n dsimp [v]\n split_ifs\n · exact le_rfl\n · exact hν A\n have hgood (W A : Finset (Fin n)) (h : v W A ≠ 0) : good W A := by\n by_contra hbad\n exact h (by simp [v, hbad])\n have hsum (W : Finset (Fin n)) : (∑ T, μ W T) = ∑ A, v W A := by\n simpa only [mul_one] using paddingPush_eval (v W) (f W) (fun _ => (1 : ℝ))\n have hcone (W S : Finset (Fin n)) :\n (∑ T, if S ⊆ T then μ W T else 0) =\n ∑ A, if S ⊆ f W A then v W A else 0 := by\n simpa only [mul_ite, mul_one, mul_zero] using\n paddingPush_eval (v W) (f W) (fun T => if S ⊆ T then (1 : ℝ) else 0)\n refine ⟨μ, ?_, ?_, ?_, ?_, ?_, ?_⟩\n · intro W T\n exact paddingPush_nonneg (v W) (f W) (hv W) T\n · intro W T hT\n exact paddingPush_support (v W) (f W) (fun T => T.card ≤ r / 2)\n (fun A hA => (hf W A (hgood W A hA)).2.1) T hT\n · intro W\n rw [hsum]\n exact Finset.sum_le_sum (fun A _ => hvle W A)\n · intro W S\n rw [hcone]\n apply le_trans _ (hspread S)\n apply Finset.sum_le_sum\n intro A _\n by_cases hSA : S ⊆ f W A\n · rw [ite_eq_left hSA]\n by_cases hz : v W A = 0\n · rw [hz]\n split_ifs\n · exact hν A\n · exact le_rfl\n · have hsub : S ⊆ A := hSA.trans (hf W A (hgood W A hz)).1\n rw [ite_eq_left hsub]\n exact hvle W A\n · rw [ite_eq_right hSA]\n split_ifs\n · exact hν A\n · exact le_rfl\n · intro W T hT\n exact paddingPush_support (v W) (f W)\n (fun T => ∃ B : Finset (Fin n), 0 < ν B ∧ B ⊆ T ∪ W)\n (fun A hA => (hf W A (hgood W A hA)).2.2) T (ne_of_gt hT)\n · have hloss (W : Finset (Fin n)) :\n (∑ A, ν A) - ∑ T, μ W T =\n ∑ A : Finset (Fin n),\n @ite ℝ (¬ good W A) (Classical.propDecidable _) (ν A) 0 := by\n rw [hsum, ← Finset.sum_sub_distrib]\n apply Finset.sum_congr rfl\n intro A _\n by_cases hg : good W A <;> simp [v, hg]\n simp_rw [hloss]\n exact fragmentation_step n r ν b p hr hν hmass huniform hb hspread hp hp1 hbp\ndef modelWeaklySmall {X : Type*} [Fintype X] (p : unitInterval) (𝓕 : Set (Set X)) : Prop := by\n classical\n exact ∃ g : Set X → NNReal, (∀ T ∈ 𝓕, ∑ S with S ⊆ T, g S ≥ 1) ∧ ∑ S, g S * (p : ℝ) ^ S.ncard ≤ 2⁻¹\nnoncomputable def modelPC {X : Type*} (𝓕 : Set (Set X)) : unitInterval := by\n classical\n exact if h : ∃ p, (ProbabilityTheory.setBernoulli Set.univ p).real (𝓕 : Set (Set X)) = 2⁻¹ then Classical.choose h else 0\nnoncomputable def modelQF {X : Type*} [Fintype X] (𝓕 : Set (Set X)) : unitInterval :=\n sSup {p | modelWeaklySmall p 𝓕}\nnoncomputable def modelRank {X : Type*} (𝓕 : Set (Set X)) : ℕ :=\n ⨆ (A : 𝓕) (_ : IsMin A), (A : Set X).ncard\ntheorem finite_cover_duality_fintype {ι κ : Type*} [Fintype ι] [Fintype κ]\n (A : ι → κ → ℝ) (c : κ → ℝ) (hA : ∀ i j, 0 ≤ A i j) (hc : ∀ j, 0 < c j)\n (hno : ¬ ∃ x : κ → ℝ, (∀ j, 0 ≤ x j) ∧\n (∀ i, 1 ≤ ∑ j, A i j * x j) ∧ (∑ j, c j * x j) ≤ (1 / 2 : ℝ)) :\n ∃ w : ι → ℝ, (∀ i, 0 ≤ w i) ∧ (∑ i, w i) = 1 ∧\n ∀ j, (∑ i, w i * A i j) ≤ 2 * c j := by\n classical\n let e := (Fintype.equivFin ι).symm\n let f := (Fintype.equivFin κ).symm\n have hn : ¬ ∃ x : Fin (Fintype.card κ) → ℝ, (∀ j, 0 ≤ x j) ∧\n (∀ i, 1 ≤ ∑ j, A (e i) (f j) * x j) ∧\n (∑ j, c (f j) * x j) ≤ (1 / 2 : ℝ) := by\n rintro ⟨x, hx, hcov, hcost⟩\n apply hno\n refine ⟨fun j => x (f.symm j), fun j => hx _, ?_, ?_⟩\n · intro i\n rw [← f.sum_comp (fun j => A i j * x (f.symm j))]\n simpa using hcov (e.symm i)\n · rw [← f.sum_comp (fun j => c j * x (f.symm j))]\n simpa using hcost\n obtain ⟨w, hw, hsum, hcone⟩ := finite_cover_duality _ _\n (fun i j => A (e i) (f j)) (fun j => c (f j))\n (fun i j => hA _ _) (fun j => hc _) hn\n refine ⟨fun i => w (e.symm i), fun i => hw _, ?_, ?_⟩\n · rw [← e.sum_comp (fun i => w (e.symm i))]\n simpa using hsum\n · intro j\n rw [← e.sum_comp (fun i => w (e.symm i) * A i j)]\n simpa using hcone (f.symm j)\ntheorem model_minimal_below {X : Type*} [Finite X] (𝓕 : Set (Set X))\n (T : 𝓕) : ∃ A : 𝓕, IsMin A ∧ (A : Set X) ⊆ T := by\n classical\n obtain ⟨A, hAT, hmin⟩ := Finite.exists_le_minimal (p := fun _ : 𝓕 => True)\n (a := T) trivial\n exact ⟨A, fun B hBA => hmin.2 trivial hBA, hAT⟩\ntheorem model_minimal_card_le {X : Type*} [Fintype X] (𝓕 : Set (Set X))\n (A : 𝓕) (hA : IsMin A) : (A : Set X).ncard ≤ modelRank 𝓕 := by\n classical\n have hbound : ∀ B : 𝓕, (B : Set X).ncard ≤ Fintype.card X := by\n intro B\n simpa [Set.ncard_univ, Nat.card_eq_fintype_card] using\n Set.ncard_le_ncard (Set.subset_univ (B : Set X))\n have hinner : ∀ B : 𝓕, (⨆ (_ : IsMin B), (B : Set X).ncard) ≤ Fintype.card X :=\n fun B => ciSup_le' (fun _ => hbound B)\n apply le_ciSup_of_le (f := fun B : 𝓕 => ⨆ (_ : IsMin B), (B : Set X).ncard)\n ⟨Fintype.card X, by rintro _ ⟨B, rfl⟩; exact hinner B⟩ A\n exact le_ciSup (f := fun _ : IsMin A => (A : Set X).ncard)\n ⟨(A : Set X).ncard, by rintro _ ⟨_, rfl⟩; exact le_rfl⟩ hA\ntheorem model_measure_sum (n : ℕ) (p : unitInterval) (𝓕 : Set (Set (Fin n))) :\n (ProbabilityTheory.setBernoulli Set.univ p).real 𝓕 =\n ∑ W : Finset (Fin n), @ite ℝ ((W : Set (Fin n)) ∈ 𝓕) (Classical.propDecidable _)\n ((p : ℝ) ^ W.card * (1 - (p : ℝ)) ^ (n - W.card)) 0 := by\n classical\n let e : Finset (Fin n) ≃ Set (Fin n) :=\n { toFun := fun W => (W : Set (Fin n))\n invFun := fun S => S.toFinset\n left_inv := by intro W; simp\n right_inv := by intro W; simp }\n have hs := MeasureTheory.sum_measureReal_singleton\n (μ := ProbabilityTheory.setBernoulli Set.univ p) 𝓕.toFinset\n have hs' : (∑ b ∈ 𝓕.toFinset, (ProbabilityTheory.setBernoulli Set.univ p).real {b}) =\n (ProbabilityTheory.setBernoulli Set.univ p).real 𝓕 := by simpa using hs\n rw [← hs', ← Fintype.sum_extend_by_zero]\n rw [← e.sum_comp (fun W => if W ∈ 𝓕.toFinset then\n (ProbabilityTheory.setBernoulli Set.univ p).real {W} else 0)]\n apply Finset.sum_congr rfl\n intro W _\n simp only [e, Equiv.coe_fn_mk, Set.mem_toFinset]\n congr 1\n rw [ProbabilityTheory.setBernoulli_real_singleton p (Set.subset_univ _) Set.finite_univ,\n Set.ncard_sdiff' (Set.subset_univ _), Set.ncard_univ, Set.ncard_coe_finset]\n simp\ntheorem model_not_small_one {X : Type*} [Fintype X] (𝓕 : Set (Set X))\n (h𝓕 : 𝓕.Nonempty) : ¬ modelWeaklySmall 1 𝓕 := by\n classical\n rintro ⟨g, hcov, hcost⟩\n obtain ⟨T, hT⟩ := h𝓕\n have hh := hcov T hT\n have hle : (∑ S with S ⊆ T, g S) ≤ ∑ S, g S :=\n Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _) (by simp)\n have hle' : (1 : ℝ) ≤ ∑ S, (g S : ℝ) := by\n exact_mod_cast hh.trans hle\n change (∑ S, (g S : ℝ) * (1 : ℝ) ^ S.ncard) ≤ _ at hcost\n simp only [one_pow, mul_one] at hcost\n norm_num at hcost\n linarith\ntheorem model_dual_spread (n : ℕ) (𝓕 : Set (Set (Fin n)))\n (hempty : ∅ ∉ 𝓕) (q : unitInterval) (hq : 0 < (q : ℝ))\n (hno : ¬ modelWeaklySmall q 𝓕) :\n ∃ ν : Finset (Fin n) → ℝ, (∀ A, 0 ≤ ν A) ∧ (∑ A, ν A) = 1 ∧\n (∀ A, ν A ≠ 0 → 1 ≤ A.card ∧ A.card ≤ modelRank 𝓕) ∧\n (∀ A, ν A ≠ 0 → (A : Set (Fin n)) ∈ 𝓕) ∧\n ∀ S : Finset (Fin n),\n (∑ A : Finset (Fin n), if S ⊆ A then ν A else 0) ≤\n (2 * (q : ℝ)) ^ S.card := by\n classical\n let M := {A : 𝓕 // IsMin A}\n let coeff : M → Set (Fin n) → ℝ := fun A S => if S ⊆ A.1.1 then 1 else 0\n have hn : ¬ ∃ x : Set (Fin n) → ℝ, (∀ S, 0 ≤ x S) ∧\n (∀ A, 1 ≤ ∑ S, coeff A S * x S) ∧\n (∑ S, (q : ℝ) ^ S.ncard * x S) ≤ (1 / 2 : ℝ) := by\n rintro ⟨x, hx, hcov, hcost⟩\n apply hno\n refine ⟨fun S => NNReal.mk (x S) (hx S), ?_, ?_⟩\n · intro T hT\n obtain ⟨A, hA, hAT⟩ := model_minimal_below 𝓕 ⟨T, hT⟩\n have hrow : 1 ≤ ∑ S with S ⊆ (A : Set (Fin n)), x S := by\n simpa [coeff, Finset.sum_filter] using hcov (⟨A, hA⟩ : M)\n have hsub : (Finset.univ.filter (fun S : Set (Fin n) => S ⊆ A)) ⊆\n Finset.univ.filter (fun S : Set (Fin n) => S ⊆ T) := by\n intro S hS\n simp only [Finset.mem_filter, Finset.mem_univ, true_and] at hS ⊢\n exact hS.trans hAT\n have hreal := hrow.trans (Finset.sum_le_sum_of_subset_of_nonneg hsub\n (fun S _ _ => hx S))\n apply NNReal.coe_le_coe.mp\n rw [NNReal.coe_one, NNReal.coe_sum]\n exact hreal\n · change (∑ S, x S * (q : ℝ) ^ S.ncard) ≤ 2⁻¹\n simpa [mul_comm, one_div] using hcost\n obtain ⟨w, hw, hmass, hcone⟩ := finite_cover_duality_fintype coeff\n (fun S => (q : ℝ) ^ S.ncard)\n (by intro A S; dsimp [coeff]; split_ifs <;> norm_num)\n (fun S => pow_pos hq _) hn\n let edge : M → Finset (Fin n) := fun A => A.1.1.toFinset\n let ν := paddingPush w edge\n have hν : ∀ A, 0 ≤ ν A := paddingPush_nonneg w edge hw\n have htotal : (∑ A, ν A) = 1 := by\n have hh : (∑ A, ν A) = ∑ A, w A := by\n simpa only [mul_one] using paddingPush_eval w edge (fun _ => 1)\n exact hh.trans hmass\n have hmem : ∀ A, ν A ≠ 0 → (A : Set (Fin n)) ∈ 𝓕 := by\n apply paddingPush_support w edge\n intro A _\n simpa [edge] using A.1.2\n have hsize : ∀ A, ν A ≠ 0 → 1 ≤ A.card ∧ A.card ≤ modelRank 𝓕 := by\n apply paddingPush_support w edge\n intro A _\n have hpos : 1 ≤ (edge A).card := by\n apply Finset.card_pos.mpr\n by_contra he\n have hz : edge A = ∅ := Finset.not_nonempty_iff_eq_empty.mp he\n have hset : A.1.1 = ∅ := by simpa [edge] using congrArg (fun S : Finset (Fin n) => (S : Set (Fin n))) hz\n exact hempty (hset ▸ A.1.2)\n refine ⟨hpos, ?_⟩\n rw [← Set.ncard_coe_finset]\n simpa only [edge, Set.coe_toFinset] using model_minimal_card_le 𝓕 A.1 A.2\n refine ⟨ν, hν, htotal, hsize, hmem, ?_⟩\n intro S\n by_cases hS : S = ∅\n · subst S\n simp [htotal]\n · have hSpos : 1 ≤ S.card := Finset.card_pos.mpr (Finset.nonempty_iff_ne_empty.mpr hS)\n have hconesum : (∑ A, if S ⊆ A then ν A else 0) =\n ∑ A : M, w A * coeff A (S : Set (Fin n)) := by\n have hh := paddingPush_eval w edge (fun A => if S ⊆ A then (1 : ℝ) else 0)\n simpa only [mul_ite, mul_one, mul_zero, coeff, edge,\n Set.subset_toFinset] using hh\n rw [hconesum]\n calc\n _ ≤ 2 * (q : ℝ) ^ (S : Set (Fin n)).ncard := hcone _\n _ = 2 * (q : ℝ) ^ S.card := by rw [Set.ncard_coe_finset]\n _ ≤ (2 * (q : ℝ)) ^ S.card := by\n rw [mul_pow]\n apply mul_le_mul_of_nonneg_right _ (pow_nonneg hq.le _)\n simpa using (pow_le_pow_right₀ (by norm_num : (1 : ℝ) ≤ 2) hSpos)\ntheorem threshold_reduction (C : ℝ) (hC : 0 < C)\n (hsampling : ∀ (n r : ℕ) (ν : Finset (Fin n) → ℝ) (b p : ℝ),\n 2 ≤ r → (∀ A, 0 ≤ ν A) → (∑ A : Finset (Fin n), ν A) = 1 →\n (∀ A, ν A ≠ 0 → 1 ≤ A.card ∧ A.card ≤ r) →\n 0 ≤ b → (∀ S : Finset (Fin n),\n (∑ A : Finset (Fin n), if S ⊆ A then ν A else 0) ≤ b ^ S.card) →\n 0 < p → p ≤ 1 → C * b * Real.log r ≤ p →\n (3 / 4 : ℝ) ≤ ∑ W : Finset (Fin n),\n @ite ℝ (∃ A : Finset (Fin n), ν A ≠ 0 ∧ A ⊆ W)\n (Classical.propDecidable _) (p ^ W.card * (1 - p) ^ (n - W.card)) 0)\n (n : ℕ) (𝓕 : Set (Set (Fin n))) (h𝓕 : IsUpperSet 𝓕)\n (hr : 2 ≤ modelRank 𝓕) :\n (modelPC 𝓕 : ℝ) ≤ (2 * C) * (modelQF 𝓕 : ℝ) * Real.log (modelRank 𝓕) := by\n classical\n by_contra hgoal\n have hlt := lt_of_not_ge hgoal\n have hlog : 0 < Real.log (modelRank 𝓕) :=\n Real.log_pos (by exact_mod_cast (show 1 < modelRank 𝓕 by omega))\n have hpc : 0 < (modelPC 𝓕 : ℝ) := lt_of_le_of_lt\n (mul_nonneg (mul_nonneg (by positivity : 0 ≤ 2 * C) (modelQF 𝓕).2.1) hlog.le) hlt\n have hex : ∃ p, (ProbabilityTheory.setBernoulli Set.univ p).real 𝓕 = (2 : ℝ)⁻¹ := by\n by_contra h\n have hz : modelPC 𝓕 = 0 := by simp only [modelPC, dif_neg h]\n rw [hz] at hpc\n norm_num at hpc\n have hroot : (ProbabilityTheory.setBernoulli Set.univ (modelPC 𝓕)).real 𝓕 = (2 : ℝ)⁻¹ := by\n simpa only [modelPC, dif_pos hex] using Classical.choose_spec hex\n have hnonempty : 𝓕.Nonempty := MeasureTheory.nonempty_of_measureReal_ne_zero\n (by rw [hroot]; norm_num)\n have hempty : ∅ ∉ 𝓕 := by\n intro he\n have heq : 𝓕 = Set.univ := Set.eq_univ_of_forall (fun T => h𝓕 (Set.empty_subset T) he)\n rw [heq, MeasureTheory.probReal_univ] at hroot\n norm_num at hroot\n let D := 2 * C * Real.log (modelRank 𝓕)\n have hD : 0 < D := by dsimp [D]; positivity\n have hltD : D * (modelQF 𝓕 : ℝ) < (modelPC 𝓕 : ℝ) := by\n dsimp [D]\n nlinarith only [hlt]\n have hq : ∃ q : unitInterval, 0 < (q : ℝ) ∧ ¬ modelWeaklySmall q 𝓕 ∧\n C * (2 * (q : ℝ)) * Real.log (modelRank 𝓕) ≤ (modelPC 𝓕 : ℝ) := by\n by_cases hq1 : modelQF 𝓕 = 1\n · refine ⟨1, by norm_num, model_not_small_one 𝓕 hnonempty, ?_⟩\n rw [hq1] at hltD\n change D * 1 < (modelPC 𝓕 : ℝ) at hltD\n dsimp [D] at hltD\n change C * (2 * (1 : ℝ)) * Real.log (modelRank 𝓕) ≤ (modelPC 𝓕 : ℝ)\n nlinarith only [hltD]\n · have hqf1 : (modelQF 𝓕 : ℝ) < 1 := by\n by_contra hh\n apply hq1\n apply Subtype.ext\n exact le_antisymm (modelQF 𝓕).2.2 (le_of_not_gt hh)\n have hratio : (modelQF 𝓕 : ℝ) < (modelPC 𝓕 : ℝ) / D :=\n (lt_div_iff₀ hD).mpr (by nlinarith only [hltD])\n obtain ⟨t, hqt, ht⟩ := exists_between (lt_min hqf1 hratio)\n have htpos : 0 < t := lt_of_le_of_lt (modelQF 𝓕).2.1 hqt\n let q : unitInterval := ⟨t, htpos.le, (lt_min_iff.mp ht).1.le⟩\n refine ⟨q, htpos, ?_, ?_⟩\n · intro hsmall\n have hle : q ≤ modelQF 𝓕 := le_sSup hsmall\n exact (not_le_of_gt hqt) hle\n · have hh := (lt_div_iff₀ hD).mp (lt_min_iff.mp ht).2\n change C * (2 * t) * Real.log (modelRank 𝓕) ≤ (modelPC 𝓕 : ℝ)\n dsimp [D] at hh\n nlinarith only [hh]\n obtain ⟨q, hqpos, hqno, hqcost⟩ := hq\n obtain ⟨ν, hν, hmass, hsize, hmem, hspread⟩ := model_dual_spread n 𝓕 hempty q hqpos hqno\n have hsample := hsampling n (modelRank 𝓕) ν (2 * (q : ℝ)) (modelPC 𝓕)\n hr hν hmass hsize (by positivity) hspread hpc (modelPC 𝓕).2.2 hqcost\n have hle : (∑ W : Finset (Fin n),\n @ite ℝ (∃ A : Finset (Fin n), ν A ≠ 0 ∧ A ⊆ W) (Classical.propDecidable _)\n ((modelPC 𝓕 : ℝ) ^ W.card * (1 - (modelPC 𝓕 : ℝ)) ^ (n - W.card)) 0) ≤\n (ProbabilityTheory.setBernoulli Set.univ (modelPC 𝓕)).real 𝓕 := by\n rw [model_measure_sum]\n apply Finset.sum_le_sum\n intro W _\n by_cases he : ∃ A : Finset (Fin n), ν A ≠ 0 ∧ A ⊆ W\n · obtain ⟨A, hA, hAW⟩ := he\n have hW : (W : Set (Fin n)) ∈ 𝓕 := h𝓕 (Finset.coe_subset.mpr hAW) (hmem A hA)\n have hE : ∃ A : Finset (Fin n), ν A ≠ 0 ∧ A ⊆ W := ⟨A, hA, hAW⟩\n simp only [if_pos hE, if_pos hW, le_refl]\n · simp only [if_neg he]\n split_ifs\n · exact mul_nonneg (pow_nonneg (modelPC 𝓕).2.1 _)\n (pow_nonneg (sub_nonneg.mpr (modelPC 𝓕).2.2) _)\n · exact le_rfl\n rw [hroot] at hle\n have hbad : (3 / 4 : ℝ) ≤ 2⁻¹ := hsample.trans hle\n norm_num at hbad\ntheorem bernoulli_projection_fiber (n N : ℕ) (e : Fin n ↪ Fin N) (p : ℝ)\n (A : Finset (Fin n)) :\n (∑ W : Finset (Fin N), if paddingPull e W = A then fragmentWeight N p W else 0) =\n fragmentWeight n p A := by\n classical\n let E : Finset (Fin N) := Finset.univ.map e\n have hmap : A.map e ⊆ E := Finset.map_subset_map.mpr (Finset.subset_univ A)\n have hcond (W : Finset (Fin N)) :\n paddingPull e W = A ↔ Eᶜ ∪ W = Eᶜ ∪ A.map e := by\n constructor\n · intro h\n ext y\n by_cases hy : y ∈ E\n · obtain ⟨x, _, rfl⟩ := Finset.mem_map.mp hy\n have hx : e x ∈ W ↔ x ∈ A := by\n rw [← paddingPull_mem e W x, h]\n simpa [E] using hx\n · simp [hy]\n · intro h\n ext x\n have hx := Finset.ext_iff.mp h (e x)\n simpa [E, paddingPull_mem] using hx\n have hcardE : E.card = n := by simp [E]\n have hcA : A.card ≤ n := by simpa using Finset.card_le_univ A\n have hcN : n ≤ N := by simpa using Fintype.card_le_of_injective e e.injective\n have hdisj : Disjoint Eᶜ (A.map e) := by\n apply Finset.disjoint_left.mpr\n intro x hx hxA\n exact (Finset.mem_compl.mp hx) (hmap hxA)\n have hcardU : (Eᶜ ∪ A.map e).card = N - n + A.card := by\n rw [Finset.card_union_of_disjoint hdisj, Finset.card_compl, hcardE,\n Finset.card_map, Fintype.card_fin]\n simp only [hcond, fragmentWeight]\n rw [bernoulli_union_fiber, ite_eq_left Finset.subset_union_left, hcardU,\n Finset.card_compl, Fintype.card_fin, hcardE]\n rw [show N - n + A.card - (N - n) = A.card by omega,\n show N - (N - n + A.card) = n - A.card by omega]\ntheorem bernoulli_projection_expectation (n N : ℕ) (e : Fin n ↪ Fin N) (p : ℝ)\n (g : Finset (Fin n) → ℝ) :\n (∑ W : Finset (Fin N), fragmentWeight N p W * g (paddingPull e W)) =\n ∑ A : Finset (Fin n), fragmentWeight n p A * g A := by\n classical\n calc\n _ = ∑ A : Finset (Fin n),\n (∑ W : Finset (Fin N), if paddingPull e W = A then fragmentWeight N p W else 0) * g A := by\n simp only [Finset.sum_mul, ite_mul, zero_mul]\n rw [Finset.sum_comm]\n apply Finset.sum_congr rfl\n intro W _\n simp\n _ = _ := by simp only [bernoulli_projection_fiber]\nnoncomputable def samplingHit {n : ℕ} (ν : Finset (Fin n) → ℝ)\n (W : Finset (Fin n)) : ℝ :=\n if ∃ A : Finset (Fin n), ν A ≠ 0 ∧ A ⊆ W then 1 else 0\nnoncomputable def samplingProb {n : ℕ} (ν : Finset (Fin n) → ℝ) (p : ℝ) : ℝ :=\n ∑ W : Finset (Fin n), fragmentWeight n p W * samplingHit ν W\ntheorem samplingHit_mono {n : ℕ} (ν : Finset (Fin n) → ℝ)\n (A B : Finset (Fin n)) (hAB : A ⊆ B) : samplingHit ν A ≤ samplingHit ν B := by\n classical\n by_cases hA : ∃ T : Finset (Fin n), ν T ≠ 0 ∧ T ⊆ A\n · obtain ⟨T, hT, hTA⟩ := hA\n have hB : ∃ T : Finset (Fin n), ν T ≠ 0 ∧ T ⊆ B := ⟨T, hT, hTA.trans hAB⟩\n simp [samplingHit, hB, show ∃ T, ν T ≠ 0 ∧ T ⊆ A from ⟨T, hT, hTA⟩]\n · simp only [samplingHit, ite_eq_right hA]\n split_ifs <;> norm_num\ntheorem samplingProb_mono {n : ℕ} (ν : Finset (Fin n) → ℝ)\n (p t : ℝ) (hp : 0 ≤ p) (hpt : p ≤ t) (ht : t ≤ 1) :\n samplingProb ν p ≤ samplingProb ν t :=\n bernoulli_expectation_mono n p t (samplingHit ν) hp hpt ht (samplingHit_mono ν)\ntheorem sampling_projection_le (n N : ℕ) (e : Fin n ↪ Fin N)\n (ν : Finset (Fin n) → ℝ) (w : Finset (Fin N) → ℝ)\n (hw : ∀ B, 0 ≤ w B)\n (hfiber : ∀ A : Finset (Fin n),\n (∑ B : Finset (Fin N), if (∀ x : Fin n, e x ∈ B ↔ x ∈ A) then w B else 0) = ν A)\n (p : ℝ) (hp : 0 ≤ p) (hp1 : p ≤ 1) :\n samplingProb w p ≤ samplingProb ν p := by\n classical\n have hsupport (B : Finset (Fin N)) (hB : w B ≠ 0) : ν (paddingPull e B) ≠ 0 := by\n have hcond (D : Finset (Fin N)) :\n (∀ x : Fin n, e x ∈ D ↔ x ∈ paddingPull e B) ↔ paddingPull e D = paddingPull e B := by\n simp only [Finset.ext_iff, paddingPull_mem]\n have hh := hfiber (paddingPull e B)\n simp only [hcond] at hh\n have hle : w B ≤ ν (paddingPull e B) := by\n rw [← hh]\n calc\n w B = (if paddingPull e B = paddingPull e B then w B else 0) := by simp\n _ ≤ ∑ D : Finset (Fin N), if paddingPull e D = paddingPull e B then w D else 0 :=\n Finset.single_le_sum\n (f := fun D : Finset (Fin N) => if paddingPull e D = paddingPull e B then w D else 0)\n (fun D _ => by split_ifs; exact hw D; exact le_rfl) (Finset.mem_univ B)\n exact ne_of_gt (lt_of_lt_of_le (lt_of_le_of_ne (hw B) (Ne.symm hB)) hle)\n have hhit (W : Finset (Fin N)) : samplingHit w W ≤ samplingHit ν (paddingPull e W) := by\n by_cases hW : ∃ B : Finset (Fin N), w B ≠ 0 ∧ B ⊆ W\n · obtain ⟨B, hB, hBW⟩ := hW\n have hW' : ∃ A : Finset (Fin n), ν A ≠ 0 ∧ A ⊆ paddingPull e W := by\n refine ⟨paddingPull e B, hsupport B hB, ?_⟩\n intro x hx\n exact (paddingPull_mem e W x).mpr (hBW ((paddingPull_mem e B x).mp hx))\n simp [samplingHit, hW', show ∃ B, w B ≠ 0 ∧ B ⊆ W from ⟨B, hB, hBW⟩]\n · simp only [samplingHit, ite_eq_right hW]\n split_ifs <;> norm_num\n calc\n samplingProb w p ≤ ∑ W : Finset (Fin N), fragmentWeight N p W *\n samplingHit ν (paddingPull e W) := by\n apply Finset.sum_le_sum\n intro W _\n exact mul_le_mul_of_nonneg_left (hhit W) (fragmentWeight_nonneg N p hp hp1 W)\n _ = samplingProb ν p := bernoulli_projection_expectation n N e p (samplingHit ν)\ndef samplingRound (p : ℝ) (k : ℕ) : ℝ := 1 - (1 - p) ^ k\nnoncomputable def samplingError (r : ℕ) : ℝ :=\n ∑ j ∈ Finset.range r, ((64 : ℝ) ^ (j + 1))⁻¹\ntheorem samplingError_mono {r s : ℕ} (hrs : r ≤ s) : samplingError r ≤ samplingError s := by\n apply Finset.sum_le_sum_of_subset_of_nonneg (Finset.range_mono hrs)\n intros\n positivity\ntheorem samplingError_step (r : ℕ) (hr : 1 ≤ r) :\n samplingError (r / 2) + ((64 : ℝ) ^ r)⁻¹ ≤ samplingError r := by\n have hh := samplingError_mono (show r / 2 ≤ r - 1 by omega)\n have heq : samplingError r = samplingError (r - 1) + ((64 : ℝ) ^ r)⁻¹ := by\n conv_lhs => rw [show r = (r - 1) + 1 by omega]\n simp only [samplingError, Finset.sum_range_succ]\n rw [Nat.sub_add_cancel hr]\n linarith\ntheorem samplingError_eq (r : ℕ) :\n samplingError r = (1 - ((64 : ℝ) ^ r)⁻¹) / 63 := by\n induction r with\n | zero => simp [samplingError]\n | succ r ih =>\n rw [samplingError, Finset.sum_range_succ]\n change samplingError r + ((64 : ℝ) ^ (r + 1))⁻¹ = _\n rw [ih, pow_succ]\n field_simp\n <;> ring\ntheorem samplingError_le (r : ℕ) : samplingError r ≤ 1 / 63 := by\n rw [samplingError_eq]\n have h : 0 ≤ ((64 : ℝ) ^ r)⁻¹ := by positivity\n linarith\ntheorem samplingRound_mem (p : ℝ) (hp : 0 ≤ p) (hp1 : p ≤ 1) (k : ℕ) :\n 0 ≤ samplingRound p k ∧ samplingRound p k ≤ 1 := by\n have h0 : 0 ≤ (1 - p) ^ k := pow_nonneg (by linarith) _\n have h1 : (1 - p) ^ k ≤ 1 := pow_le_one₀ (by linarith) (by linarith)\n constructor <;> dsimp [samplingRound] <;> linarith\ntheorem samplingRound_succ (p : ℝ) (k : ℕ) :\n p + samplingRound p k - p * samplingRound p k = samplingRound p (k + 1) := by\n simp only [samplingRound, pow_succ]\n ring\ntheorem samplingProb_nonneg {n : ℕ} (ν : Finset (Fin n) → ℝ)\n (p : ℝ) (hp : 0 ≤ p) (hp1 : p ≤ 1) : 0 ≤ samplingProb ν p := by\n classical\n apply Finset.sum_nonneg\n intro W _\n apply mul_nonneg (fragmentWeight_nonneg n p hp hp1 W)\n dsimp [samplingHit]\n split_ifs <;> norm_num\ntheorem sampling_zero_rank (n : ℕ) (ν : Finset (Fin n) → ℝ)\n (hmass : (∑ A : Finset (Fin n), ν A) ≤ 1)\n (hcard : ∀ A, ν A ≠ 0 → A.card ≤ 0)\n (p : ℝ) (hp : 0 ≤ p) (hp1 : p ≤ 1) :\n (∑ A : Finset (Fin n), ν A) ≤ samplingProb ν p := by\n classical\n have hsum : (∑ A : Finset (Fin n), ν A) = ν ∅ := by\n apply Finset.sum_eq_single ∅\n · intro A _ hA\n by_contra hνA\n exact hA (Finset.card_eq_zero.mp (Nat.eq_zero_of_le_zero (hcard A hνA)))\n · simp\n by_cases hz : ν ∅ = 0\n · rw [hsum, hz]\n exact samplingProb_nonneg ν p hp hp1\n · have hhit (W : Finset (Fin n)) : samplingHit ν W = 1 := by\n exact ite_eq_left ⟨∅, hz, Finset.empty_subset W⟩\n have hprob : samplingProb ν p = 1 := by\n simp only [samplingProb, hhit, mul_one, fragmentWeight]\n exact bernoulli_finset_normalization n p\n rw [hprob]\n exact hmass\ntheorem sampling_witness_le {n : ℕ} (ν μ : Finset (Fin n) → ℝ)\n (hμ : ∀ T, 0 ≤ μ T) (W V : Finset (Fin n))\n (hwit : ∀ T, 0 < μ T → ∃ B : Finset (Fin n), 0 < ν B ∧ B ⊆ T ∪ W) :\n samplingHit μ V ≤ samplingHit ν (W ∪ V) := by\n classical\n by_cases hV : ∃ T : Finset (Fin n), μ T ≠ 0 ∧ T ⊆ V\n · obtain ⟨T, hT, hTV⟩ := hV\n obtain ⟨B, hB, hBT⟩ := hwit T (lt_of_le_of_ne (hμ T) (Ne.symm hT))\n have hWV : ∃ B : Finset (Fin n), ν B ≠ 0 ∧ B ⊆ W ∪ V := by\n refine ⟨B, ne_of_gt hB, ?_⟩\n intro x hx\n rcases Finset.mem_union.mp (hBT hx) with hxT | hxW\n · exact Finset.mem_union_right W (hTV hxT)\n · exact Finset.mem_union_left V hxW\n simp [samplingHit, hWV, show ∃ T, μ T ≠ 0 ∧ T ⊆ V from ⟨T, hT, hTV⟩]\n · simp only [samplingHit, ite_eq_right hV]\n split_ifs <;> norm_num\ntheorem sampling_uniform_step (n r k : ℕ) (ν : Finset (Fin n) → ℝ) (b p : ℝ)\n (hr : 1 ≤ r) (hν : ∀ A, 0 ≤ ν A) (hmass : (∑ A : Finset (Fin n), ν A) ≤ 1)\n (huniform : ∀ A, ν A ≠ 0 → A.card = r) (hb : 0 ≤ b)\n (hspread : ∀ S : Finset (Fin n),\n (∑ A : Finset (Fin n), if S ⊆ A then ν A else 0) ≤ b ^ S.card)\n (hp : 0 < p) (hp1 : p ≤ 1) (hbp : (2 : ℝ) ^ 32 * b ≤ p)\n (hind : ∀ μ : Finset (Fin n) → ℝ, (∀ T, 0 ≤ μ T) →\n (∑ T : Finset (Fin n), μ T) ≤ 1 → (∀ T, μ T ≠ 0 → T.card ≤ r / 2) →\n (∀ S : Finset (Fin n), (∑ T : Finset (Fin n), if S ⊆ T then μ T else 0) ≤ b ^ S.card) →\n (∑ T : Finset (Fin n), μ T) - samplingError (r / 2) ≤ samplingProb μ (samplingRound p k)) :\n (∑ A : Finset (Fin n), ν A) - samplingError r ≤\n samplingProb ν (samplingRound p (k + 1)) := by\n classical\n obtain ⟨μ, hμ, hcard, hmassμ, hspreadμ, hwit, hloss⟩ :=\n fragment_update n r ν b p hr hν hmass huniform hb hspread hp hp1 hbp\n have hs := samplingRound_mem p hp.le hp1 k\n have hnorm : (∑ W : Finset (Fin n), fragmentWeight n p W) = 1 :=\n bernoulli_finset_normalization n p\n have hW (W : Finset (Fin n)) :\n (∑ T : Finset (Fin n), μ W T) - samplingError (r / 2) ≤\n ∑ V : Finset (Fin n), fragmentWeight n (samplingRound p k) V * samplingHit ν (W ∪ V) := by\n apply (hind (μ W) (hμ W) ((hmassμ W).trans hmass) (hcard W) (hspreadμ W)).trans\n apply Finset.sum_le_sum\n intro V _\n exact mul_le_mul_of_nonneg_left (sampling_witness_le ν (μ W) (hμ W) W V (hwit W))\n (fragmentWeight_nonneg n (samplingRound p k) hs.1 hs.2 V)\n have hsum := Finset.sum_le_sum (s := Finset.univ)\n (fun W _ => mul_le_mul_of_nonneg_left (hW W) (fragmentWeight_nonneg n p hp.le hp1 W))\n change (∑ W : Finset (Fin n), fragmentWeight n p W *\n ((∑ A : Finset (Fin n), ν A) - ∑ T : Finset (Fin n), μ W T)) ≤ _ at hloss\n simp only [mul_sub, Finset.sum_sub_distrib, ← Finset.sum_mul, hnorm, one_mul] at hsum hloss\n have herr := samplingError_step r hr\n calc\n (∑ A : Finset (Fin n), ν A) - samplingError r ≤\n ∑ W : Finset (Fin n), fragmentWeight n p W *\n ∑ V : Finset (Fin n), fragmentWeight n (samplingRound p k) V * samplingHit ν (W ∪ V) := by\n linarith\n _ = samplingProb ν (samplingRound p (k + 1)) := by\n simp only [fragmentWeight]\n rw [bernoulli_union_convolution, samplingRound_succ]\n rfl\ntheorem sampling_iterate (k : ℕ) :\n ∀ (n r : ℕ) (ν : Finset (Fin n) → ℝ) (b p : ℝ), r < 2 ^ k →\n (∀ A, 0 ≤ ν A) → (∑ A : Finset (Fin n), ν A) ≤ 1 →\n (∀ A, ν A ≠ 0 → A.card ≤ r) → 0 < b →\n (∀ S : Finset (Fin n), (∑ A : Finset (Fin n), if S ⊆ A then ν A else 0) ≤ b ^ S.card) →\n 0 < p → p ≤ 1 → (2 : ℝ) ^ 32 * b ≤ p →\n (∑ A : Finset (Fin n), ν A) - samplingError r ≤ samplingProb ν (samplingRound p k) := by\n classical\n induction k with\n | zero =>\n intro n r ν b p hr hν hmass hcard hb hspread hp hp1 hbp\n have hr0 : r = 0 := by norm_num at hr; omega\n subst r\n have hs := samplingRound_mem p hp.le hp1 0\n simpa [samplingError] using sampling_zero_rank n ν hmass hcard (samplingRound p 0) hs.1 hs.2\n | succ k ih =>\n intro n r ν b p hr hν hmass hcard hb hspread hp hp1 hbp\n have hs := samplingRound_mem p hp.le hp1 (k + 1)\n by_cases hr0 : r = 0\n · subst r\n simpa [samplingError] using sampling_zero_rank n ν hmass hcard (samplingRound p (k + 1)) hs.1 hs.2\n have hr1 : 1 ≤ r := by omega\n have hhalf : r / 2 < 2 ^ k := by\n rw [pow_succ] at hr\n omega\n obtain ⟨N, e, w, hw, hwcard, hwmass, hwspread, hwfiber⟩ :=\n spread_padding n r ν b hb hν hmass hcard hspread\n have hstep := sampling_uniform_step N r k w b p hr1 hw (hwmass.trans_le hmass)\n hwcard hb.le hwspread hp hp1 hbp\n (fun μ hμ hmassμ hcardμ hspreadμ =>\n ih N (r / 2) μ b p hhalf hμ hmassμ hcardμ hb hspreadμ hp hp1 hbp)\n calc\n (∑ A : Finset (Fin n), ν A) - samplingError r =\n (∑ B : Finset (Fin N), w B) - samplingError r := by rw [hwmass]\n _ ≤ samplingProb w (samplingRound p (k + 1)) := hstep\n _ ≤ samplingProb ν (samplingRound p (k + 1)) :=\n sampling_projection_le n N e ν w hw hwfiber _ hs.1 hs.2\ntheorem samplingRound_le (p : ℝ) (hp : 0 ≤ p) (hp1 : p ≤ 1) (k : ℕ) :\n samplingRound p k ≤ (k : ℝ) * p := by\n induction k with\n | zero => simp [samplingRound]\n | succ k ih =>\n have hs := samplingRound_mem p hp hp1 k\n rw [← samplingRound_succ]\n calc\n p + samplingRound p k - p * samplingRound p k ≤ p + samplingRound p k := by\n nlinarith [mul_nonneg hp hs.1]\n _ ≤ p + (k : ℝ) * p := by linarith\n _ = ((k + 1 : ℕ) : ℝ) * p := by push_cast; ring\ntheorem sampling_log_rounds (r : ℕ) (hr : 2 ≤ r) :\n ((Nat.log 2 r + 1 : ℕ) : ℝ) * Real.log 2 ≤ 2 * Real.log r := by\n have hrpos : 0 < (r : ℝ) := by exact_mod_cast (show 0 < r by omega)\n have hnat := Nat.pow_log_le_self 2 (show r ≠ 0 by omega)\n have hreal : (2 : ℝ) ^ Nat.log 2 r ≤ (r : ℝ) := by exact_mod_cast hnat\n have hlog := Real.log_le_log (by positivity : 0 < (2 : ℝ) ^ Nat.log 2 r) hreal\n rw [Real.log_pow] at hlog\n have hlog2 : Real.log 2 ≤ Real.log r :=\n Real.log_le_log (by norm_num) (by exact_mod_cast hr)\n push_cast\n nlinarith\ntheorem sampling_spread_pos (n : ℕ) (ν : Finset (Fin n) → ℝ) (b : ℝ)\n (hν : ∀ A, 0 ≤ ν A) (hmass : (∑ A : Finset (Fin n), ν A) = 1)\n (hcard : ∀ A, ν A ≠ 0 → 1 ≤ A.card)\n (hspread : ∀ S : Finset (Fin n),\n (∑ A : Finset (Fin n), if S ⊆ A then ν A else 0) ≤ b ^ S.card) : 0 < b := by\n classical\n obtain ⟨A, hA⟩ : ∃ A : Finset (Fin n), ν A ≠ 0 := by\n by_contra h\n push_neg at h\n simp [h] at hmass\n obtain ⟨x, hx⟩ := Finset.card_pos.mp (show 0 < A.card by have := hcard A hA; omega)\n have hcone : ν A ≤ ∑ B : Finset (Fin n), if {x} ⊆ B then ν B else 0 := by\n calc\n ν A = (if {x} ⊆ A then ν A else 0) := by simp [Finset.singleton_subset_iff, hx]\n _ ≤ ∑ B : Finset (Fin n), if {x} ⊆ B then ν B else 0 :=\n Finset.single_le_sum\n (f := fun B : Finset (Fin n) => if {x} ⊆ B then ν B else 0)\n (fun B _ => by split_ifs; exact hν B; exact le_rfl) (Finset.mem_univ A)\n have hh := hcone.trans (hspread {x})\n simp only [Finset.card_singleton, pow_one] at hh\n exact lt_of_lt_of_le (lt_of_le_of_ne (hν A) (Ne.symm hA)) hh\ntheorem spread_sampling :\n ∃ C : ℝ, 0 < C ∧ ∀ (n r : ℕ) (ν : Finset (Fin n) → ℝ) (b p : ℝ),\n 2 ≤ r → (∀ A, 0 ≤ ν A) → (∑ A : Finset (Fin n), ν A) = 1 →\n (∀ A, ν A ≠ 0 → 1 ≤ A.card ∧ A.card ≤ r) → 0 ≤ b →\n (∀ S : Finset (Fin n),\n (∑ A : Finset (Fin n), if S ⊆ A then ν A else 0) ≤ b ^ S.card) →\n 0 < p → p ≤ 1 → C * b * Real.log r ≤ p →\n (3 / 4 : ℝ) ≤ ∑ W : Finset (Fin n),\n @ite ℝ (∃ A : Finset (Fin n), ν A ≠ 0 ∧ A ⊆ W) (Classical.propDecidable _)\n (p ^ W.card * (1 - p) ^ (n - W.card)) 0 := by\n classical\n have hl2 : 0 < Real.log 2 := Real.log_pos (by norm_num)\n let C : ℝ := (2 : ℝ) ^ 33 / Real.log 2\n refine ⟨C, by dsimp [C]; positivity, ?_⟩\n intro n r ν b p hr hν hmass hcard hb hspread hp hp1 hbound\n have hbpos : 0 < b := sampling_spread_pos n ν b hν hmass\n (fun A hA => (hcard A hA).1) hspread\n let k : ℕ := Nat.log 2 r + 1\n let u : ℝ := (2 : ℝ) ^ 32 * b\n have hu : 0 < u := by dsimp [u]; positivity\n have hk : 1 ≤ k := by dsimp [k]; omega\n have hkreal : (1 : ℝ) ≤ (k : ℝ) := by exact_mod_cast hk\n have hklog : (k : ℝ) ≤ 2 * Real.log r / Real.log 2 :=\n (le_div_iff₀ hl2).mpr (sampling_log_rounds r hr)\n have hbudget : (k : ℝ) * u ≤ p := by\n calc\n (k : ℝ) * u ≤ (2 * Real.log r / Real.log 2) * u :=\n mul_le_mul_of_nonneg_right hklog hu.le\n _ = C * b * Real.log r := by dsimp [C, u]; norm_num; ring\n _ ≤ p := hbound\n have hu1 : u ≤ 1 := by\n have hule : u ≤ (k : ℝ) * u := by nlinarith\n exact hule.trans (hbudget.trans hp1)\n have hiter := sampling_iterate k n r ν b u\n (Nat.lt_pow_succ_log_self (by norm_num : 1 < 2) r) hν hmass.le\n (fun A hA => (hcard A hA).2) hbpos hspread hu hu1 le_rfl\n have herr := samplingError_le r\n have hround := samplingRound_mem u hu.le hu1 k\n have hroundle : samplingRound u k ≤ p := (samplingRound_le u hu.le hu1 k).trans hbudget\n have hmono := samplingProb_mono ν (samplingRound u k) p hround.1 hroundle hp1\n have hprob : (3 / 4 : ℝ) ≤ samplingProb ν p := by rw [hmass] at hiter; linarith\n convert hprob using 1\n unfold samplingProb\n apply Finset.sum_congr rfl\n intro W _\n by_cases hW : ∃ A : Finset (Fin n), ν A ≠ 0 ∧ A ⊆ W <;>\n simp [samplingHit, fragmentWeight, hW]\ntheorem finite_threshold_bound_exists :\n ∃ C : ℝ, ∀ (n : ℕ) (𝓕 : Set (Set (Fin n))), IsUpperSet 𝓕 →\n 2 ≤ modelRank 𝓕 →\n (modelPC 𝓕 : ℝ) ≤ C * (modelQF 𝓕 : ℝ) * Real.log (modelRank 𝓕) := by\n obtain ⟨C, hC, hsampling⟩ := spread_sampling\n exact ⟨2 * C, threshold_reduction C hC hsampling⟩\ntheorem model_set_ncard_equiv {X Y : Type*} (e : X ≃ Y) (S : Set X) :\n (e '' S).ncard = S.ncard :=\n Set.ncard_image_of_injective S e.injective\ntheorem model_relabel_small_of {X Y : Type*} [Fintype X] [Fintype Y]\n (e : X ≃ Y) (p : unitInterval) (𝓕 : Set (Set X))\n (h : modelWeaklySmall p (e.setCongr '' 𝓕)) : modelWeaklySmall p 𝓕 := by\n classical\n obtain ⟨g, hcov, hcost⟩ := h\n refine ⟨fun S => g (e '' S), ?_, ?_⟩\n · intro T hT\n have h := hcov (e '' T) ⟨T, hT, rfl⟩\n have hs : (∑ S with S ⊆ T, g (e '' S)) = ∑ S with S ⊆ e '' T, g S := by\n simp only [Finset.sum_filter]\n rw [← e.setCongr.sum_comp (fun S => if S ⊆ e '' T then g S else 0)]\n simp only [Equiv.setCongr_apply, e.image_subset]\n rw [hs]\n exact h\n · have hs : (∑ S : Set X, g (e '' S) * (p : ℝ) ^ S.ncard) =\n ∑ S : Set Y, g S * (p : ℝ) ^ S.ncard := by\n rw [← e.setCongr.sum_comp (fun S => g S * (p : ℝ) ^ S.ncard)]\n simp only [Equiv.setCongr_apply, model_set_ncard_equiv]\n rw [hs]\n exact hcost\ntheorem model_measure_set_sum {X : Type*} [Fintype X]\n (p : unitInterval) (𝓕 : Set (Set X)) :\n (ProbabilityTheory.setBernoulli Set.univ p).real 𝓕 =\n ∑ S : Set X, @ite ℝ (S ∈ 𝓕) (Classical.propDecidable _)\n ((p : ℝ) ^ S.ncard * (1 - (p : ℝ)) ^ (Fintype.card X - S.ncard)) 0 := by\n classical\n have hs := MeasureTheory.sum_measureReal_singleton\n (μ := ProbabilityTheory.setBernoulli Set.univ p) 𝓕.toFinset\n have hs' : (∑ S ∈ 𝓕.toFinset, (ProbabilityTheory.setBernoulli Set.univ p).real {S}) =\n (ProbabilityTheory.setBernoulli Set.univ p).real 𝓕 := by simpa using hs\n rw [← hs', ← Fintype.sum_extend_by_zero]\n apply Finset.sum_congr rfl\n intro S _\n simp only [Set.mem_toFinset]\n congr 1\n rw [ProbabilityTheory.setBernoulli_real_singleton p (Set.subset_univ _) Set.finite_univ,\n Set.ncard_sdiff' (Set.subset_univ _), Set.ncard_univ]\n simp\ntheorem model_relabel_cancel {X Y : Type*} (e : X ≃ Y) (𝓕 : Set (Set X)) :\n e.symm.setCongr '' (e.setCongr '' 𝓕) = 𝓕 := by\n change e.setCongr.symm '' (e.setCongr '' 𝓕) = 𝓕\n exact e.setCongr.symm_image_image 𝓕\ntheorem model_relabel_small_iff {X Y : Type*} [Fintype X] [Fintype Y]\n (e : X ≃ Y) (p : unitInterval) (𝓕 : Set (Set X)) :\n modelWeaklySmall p (e.setCongr '' 𝓕) ↔ modelWeaklySmall p 𝓕 := by\n constructor\n · exact model_relabel_small_of e p 𝓕\n · intro h\n apply model_relabel_small_of e.symm p (e.setCongr '' 𝓕)\n rwa [model_relabel_cancel]\ntheorem model_relabel_QF {X Y : Type*} [Fintype X] [Fintype Y]\n (e : X ≃ Y) (𝓕 : Set (Set X)) : modelQF (e.setCongr '' 𝓕) = modelQF 𝓕 := by\n unfold modelQF\n congr 1\n ext p\n exact model_relabel_small_iff e p 𝓕\ntheorem model_relabel_measure {X Y : Type*} [Fintype X] [Fintype Y]\n (e : X ≃ Y) (p : unitInterval) (𝓕 : Set (Set X)) :\n (ProbabilityTheory.setBernoulli Set.univ p).real (e.setCongr '' 𝓕) =\n (ProbabilityTheory.setBernoulli Set.univ p).real 𝓕 := by\n classical\n rw [model_measure_set_sum, model_measure_set_sum,\n ← e.setCongr.sum_comp (fun S =>\n @ite ℝ (S ∈ e.setCongr '' 𝓕) (Classical.propDecidable _)\n ((p : ℝ) ^ S.ncard * (1 - (p : ℝ)) ^ (Fintype.card Y - S.ncard)) 0)]\n apply Finset.sum_congr rfl\n intro S _\n have hm : e.setCongr S ∈ e.setCongr '' 𝓕 ↔ S ∈ 𝓕 := by\n constructor\n · rintro ⟨T, hT, heq⟩\n exact e.setCongr.injective heq ▸ hT\n · intro hS\n exact ⟨S, hS, rfl⟩\n have hc : (e.setCongr S).ncard = S.ncard := model_set_ncard_equiv e S\n simp only [hm, hc, Fintype.card_congr e]\ntheorem model_relabel_PC {X Y : Type*} [Fintype X] [Fintype Y]\n (e : X ≃ Y) (𝓕 : Set (Set X)) : modelPC (e.setCongr '' 𝓕) = modelPC 𝓕 := by\n classical\n unfold modelPC\n simp_rw [model_relabel_measure e]\ntheorem model_relabel_rank_le {X Y : Type*} [Fintype X] [Fintype Y]\n (e : X ≃ Y) (𝓕 : Set (Set X)) : modelRank (e.setCongr '' 𝓕) ≤ modelRank 𝓕 := by\n classical\n apply ciSup_le'\n intro A\n apply ciSup_le'\n intro hA\n obtain ⟨B, hB, heq⟩ := A.property\n change e '' B = (A : Set Y) at heq\n have hmin : IsMin (⟨B, hB⟩ : 𝓕) := by\n intro D hDB\n let D' : e.setCongr '' 𝓕 := ⟨e '' (D : Set X), ⟨D, D.property, rfl⟩⟩\n have hDA : D' ≤ A := by\n change e '' (D : Set X) ⊆ (A : Set Y)\n rw [← heq]\n exact Set.image_mono hDB\n have hAD : A ≤ D' := hA hDA\n change B ⊆ (D : Set X)\n apply (e.image_subset B D).mp\n change e '' B ⊆ e '' (D : Set X)\n rw [heq]\n exact hAD\n change (A : Set Y).ncard ≤ modelRank 𝓕\n rw [← heq, model_set_ncard_equiv]\n exact model_minimal_card_le 𝓕 ⟨B, hB⟩ hmin\ntheorem model_relabel_rank {X Y : Type*} [Fintype X] [Fintype Y]\n (e : X ≃ Y) (𝓕 : Set (Set X)) : modelRank (e.setCongr '' 𝓕) = modelRank 𝓕 := by\n apply le_antisymm (model_relabel_rank_le e 𝓕)\n have h := model_relabel_rank_le e.symm (e.setCongr '' 𝓕)\n rwa [model_relabel_cancel] at h\ntheorem model_relabel_upper {X Y : Type*} (e : X ≃ Y)\n (𝓕 : Set (Set X)) (h𝓕 : IsUpperSet 𝓕) : IsUpperSet (e.setCongr '' 𝓕) := by\n rintro S T hST ⟨A, hA, rfl⟩\n refine ⟨e.symm '' T, h𝓕 ?_ hA, ?_⟩\n · rw [← e.symm_image_image A]\n exact Set.image_mono hST\n · exact e.image_symm_image T\ntheorem finite_bound_transfer (C : ℝ)\n (hfinite : ∀ (n : ℕ) (𝓕 : Set (Set (Fin n))), IsUpperSet 𝓕 →\n 2 ≤ modelRank 𝓕 → (modelPC 𝓕 : ℝ) ≤ C * (modelQF 𝓕 : ℝ) * Real.log (modelRank 𝓕))\n (X : Type*) [Fintype X] (𝓕 : Set (Set X)) (h𝓕 : IsUpperSet 𝓕)\n (hr : 2 ≤ modelRank 𝓕) :\n (modelPC 𝓕 : ℝ) ≤ C * (modelQF 𝓕 : ℝ) * Real.log (modelRank 𝓕) := by\n classical\n let e := Fintype.equivFin X\n have hr' : 2 ≤ modelRank (e.setCongr '' 𝓕) := by rwa [model_relabel_rank]\n have h := hfinite (Fintype.card X) (e.setCongr '' 𝓕) (model_relabel_upper e 𝓕 h𝓕) hr'\n simpa only [model_relabel_PC, model_relabel_QF, model_relabel_rank] using h\nend Submission.Helpers\n" } ], "official": { "statementRevision": 1, "submissionUrl": "https://github.com/leanprover/lean-eval-submissions/issues/2141", "resultUrl": "https://github.com/leanprover/lean-eval-submissions/issues/2141#issuecomment-6197783762", "resultBody": "## Submission result\n\n✅ Newly-solved problems: annals_fractional_expectation_thresholds\n\nAttempted 1 / 1; succeeded on 1.\n\n### Per-problem\n- `annals_fractional_expectation_thresholds`: pass", "sourceUrl": "https://github.com/LikC1606/deepscientist-math-proofs/tree/003d58b9a333858bf878e5984348ee21bb0aed72", "sourceCommit": "003d58b9a333858bf878e5984348ee21bb0aed72", "checksums": { "README.md": "48b033edf91816eea3ae2f1c09d23e300393113c7390971a3879d4a8b1835d39", "Submission.lean": "028ce084c75d9015852e6912d05ebf50f40d05522b47267e52c3365c7f19d56e", "Submission/Helpers.lean": "e0ea3f43432ed60c497193a8bb900ca71bdbb4a16e0c256a6d1bac0b4f273fad", "lakefile.toml": "0331a667b991e555c474fbd05905e89f1402f826b70d851319e6ab60edea3c4a", "lean-toolchain": "bc84812c94489d1e3e191baa1dc10d5eb684382d7fe9d2a5ab085e72c1c67e47", "verification.json": "e313a7e004a8b48c41397c209e061481fa1d6468ef2da47532ec7787b66d2c90" } }, "local": { "status": "official_verified", "kernelVerified": true, "comparator": "official_verified", "sourceProofCommit": "06dd44031d8ef14eacd8bdc9f8a666998ece052d", "sourceBinding": "matches", "axioms": [], "url": "https://github.com/LikC1606/theorem-os-site/blob/main/accepted/annals_fractional_expectation_thresholds/verification.json" } }, { "id": "annals_equiangular_lines_fixed_angle", "title": "Equiangular lines", "subtitle": "固定夹角等角线", "area": "离散几何", "summary": "关于固定夹角下等角线数量与谱半径阶的渐近关系。档案保留原始提交包及其官方验收结果。", "declaration": "theorem theorem_1_2", "en": { "subtitle": "Equiangular lines with a fixed angle", "area": "Discrete geometry", "summary": "The asymptotic relation between the number of equiangular lines with a fixed angle and the order of the spectral radius. The archive keeps the original submission package and its official result." }, "status": "official_accepted", "model": "DeepScientist Math + GPT-6.1 (gpt-6.1-sol)", "updatedAt": "2026-10-15T06:53:59Z", "archiveUrl": "https://github.com/LikC1606/theorem-os-site/tree/main/accepted/annals_equiangular_lines_fixed_angle", "sources": [ { "name": "Submission.lean", "path": "accepted/annals_equiangular_lines_fixed_angle/Submission.lean", "url": "https://github.com/LikC1606/theorem-os-site/blob/main/accepted/annals_equiangular_lines_fixed_angle/Submission.lean", "sha256": "33bb5ef9ab4ba497af6218874580c54791358516812cd52b187e2091946903f1", "lines": 1905, "code": "import Mathlib.Analysis.Matrix.Spectrum\nimport Mathlib.Algebra.Order.Floor.Semifield\nimport Mathlib.LinearAlgebra.Eigenspace.Basic\nimport Mathlib.LinearAlgebra.Matrix.Rank\nimport Mathlib.Analysis.InnerProductSpace.GramMatrix\nimport Mathlib.Tactic.NormNum\nimport Mathlib.Tactic.Positivity\nimport Mathlib.Tactic.Ring\nimport Mathlib.Tactic.FieldSimp\nimport Mathlib.Data.ENat.Lattice\nimport ChallengeDeps\nimport Submission.Helpers\n\nopen EquiangularLinesFixedAngle\nopen Filter\nopen scoped RealInnerProductSpace\n\nset_option autoImplicit false\n\nnamespace Submission\n\ntheorem spectral_order_attained (lambda : ℝ) (hfinite : spectralRadiusOrder lambda < ⊤) :\n ∃ (n : ℕ) (G : SimpleGraph (Fin n)),\n (n : ℕ∞) = spectralRadiusOrder lambda ∧\n (show ENNReal from by\n classical\n exact spectralRadius ℝ (G.adjMatrix ℝ)) = ENNReal.ofReal lambda := by\n classical\n obtain ⟨n, hn⟩ := ENat.exists_eq_iInf (fun n : ℕ =>\n ⨅ (_ : ∃ G : SimpleGraph (Fin n),\n spectralRadius ℝ (G.adjMatrix ℝ) = ENNReal.ofReal lambda), (n : ℕ∞))\n have hn' :\n (⨅ (_ : ∃ G : SimpleGraph (Fin n),\n spectralRadius ℝ (G.adjMatrix ℝ) = ENNReal.ofReal lambda), (n : ℕ∞)) =\n spectralRadiusOrder lambda := hn\n by_cases hG : ∃ G : SimpleGraph (Fin n),\n spectralRadius ℝ (G.adjMatrix ℝ) = ENNReal.ofReal lambda\n · have horder : (n : ℕ∞) = spectralRadiusOrder lambda := by\n simpa only [iInf_pos hG] using hn'\n obtain ⟨G, hG⟩ := hG\n exact ⟨n, G, horder, hG⟩\n · have htop : spectralRadiusOrder lambda = ⊤ := by\n simpa only [iInf_neg hG] using hn'.symm\n exact False.elim ((ne_of_lt hfinite) htop)\ntheorem configuration_dist_separated (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n (d : ℕ) (E : EquiangularLines α d)\n {x y : EuclideanSpace ℝ (Fin d)} (hx : x ∈ E.carrier) (hy : y ∈ E.carrier)\n (hxy : x ≠ y) : 1 - α < dist x y := by\n have hi : ⟪x, y⟫ ≤ α := by\n calc\n ⟪x, y⟫ ≤ |⟪x, y⟫| := le_abs_self _\n _ = α := E.angle hx hy hxy\n have hs := norm_sub_sq_real x y\n rw [E.norm x hx, E.norm y hy, ← dist_eq_norm] at hs\n have hn := dist_nonneg (x := x) (y := y)\n have hsq : (1 - α) ^ 2 < 2 * (1 - α) := by\n have hp : 0 < (1 - α) * (1 + α) :=\n mul_pos (sub_pos.mpr hα.2) (by linarith only [hα.1])\n nlinarith only [hp]\n apply (sq_lt_sq₀ (sub_nonneg.mpr hα.2.le) hn).mp\n linarith only [hs, hi, hsq]\ntheorem configuration_cardinality_bounded :\n ∀ (α : ℝ), α ∈ Set.Ioo 0 1 → ∀ d : ℕ,\n ∃ B : ℕ, ∀ E : EquiangularLines α d, E.carrier.ncard ≤ B := by\n classical\n intro α hα d\n obtain ⟨t, _, ht, hcover⟩ :=\n (isCompact_sphere (0 : EuclideanSpace ℝ (Fin d)) 1).finite_cover_balls\n (show 0 < (1 - α) / 2 by linarith [hα.2])\n refine ⟨t.ncard, ?_⟩\n intro E\n have hball : ∀ x ∈ E.carrier, ∃ c ∈ t, dist x c < (1 - α) / 2 := by\n intro x hx\n have hs : x ∈ Metric.sphere (0 : EuclideanSpace ℝ (Fin d)) 1 := by\n simpa only [Metric.mem_sphere, dist_zero_right] using E.norm x hx\n rcases Set.mem_iUnion₂.mp (hcover hs) with ⟨c, hc, hxc⟩\n exact ⟨c, hc, hxc⟩\n let f : EuclideanSpace ℝ (Fin d) → EuclideanSpace ℝ (Fin d) := fun x =>\n if hx : x ∈ E.carrier then (hball x hx).choose else 0\n have hf : ∀ x ∈ E.carrier, f x ∈ t ∧ dist x (f x) < (1 - α) / 2 := by\n intro x hx\n dsimp only [f]\n rw [dif_pos hx]\n exact (hball x hx).choose_spec\n apply Set.ncard_le_ncard_of_injOn f (fun x hx => (hf x hx).1) ?_ ht\n intro x hx y hy hfxy\n by_contra hxy\n have hsep := configuration_dist_separated α hα d E hx hy hxy\n have htri := dist_triangle x (f x) y\n have hfx := (hf x hx).2\n have hfy := (hf y hy).2\n rw [← hfxy, dist_comm y (f x)] at hfy\n linarith only [hsep, htri, hfx, hfy]\ntheorem configuration_cardinality_le_N :\n ∀ (α : ℝ), α ∈ Set.Ioo 0 1 →\n ∀ (d : ℕ) (E : EquiangularLinesFixedAngle.EquiangularLines α d),\n E.carrier.ncard ≤ EquiangularLinesFixedAngle.N α d := by\n intro α hα d E\n obtain ⟨B, hB⟩ := configuration_cardinality_bounded α hα d\n have hbounded : BddAbove (Set.range\n (fun F : EquiangularLinesFixedAngle.EquiangularLines α d => F.carrier.ncard)) := by\n refine ⟨B, ?_⟩\n rintro _ ⟨F, rfl⟩\n exact hB F\n exact le_ciSup hbounded E\ntheorem euclidean_gram_rank_le {d n : ℕ}\n (v : Fin n → EuclideanSpace ℝ (Fin d)) : (Matrix.gram ℝ v).rank ≤ d := by\n classical\n let b := EuclideanSpace.basisFun (Fin d) ℝ\n let M : Matrix (Fin d) (Fin n) ℝ := Matrix.of (fun i j => b.repr (v j) i)\n have hg : Matrix.gram ℝ v = M.conjTranspose * M :=\n Matrix.gram_eq_conjTranspose_mul b v\n calc\n (Matrix.gram ℝ v).rank = (M.conjTranspose * M).rank := congrArg Matrix.rank hg\n _ ≤ M.rank := Matrix.rank_mul_le_right _ _\n _ ≤ d := by simpa only [Fintype.card_fin] using Matrix.rank_le_card_height M\ntheorem real_matrix_rank_smul_le {m n : ℕ} (a : ℝ)\n (A : Matrix (Fin m) (Fin n) ℝ) : (a • A).rank ≤ A.rank := by\n rw [Matrix.rank, Matrix.rank]\n apply Submodule.finrank_mono\n rintro x ⟨c, rfl⟩\n refine ⟨a • c, ?_⟩\n simp only [Matrix.mulVecLin_apply, Matrix.mulVec_smul, Matrix.smul_mulVec]\ntheorem upper_spectralRadius_relabel {ι κ : Type*} [Fintype ι] [Fintype κ]\n [DecidableEq ι] [DecidableEq κ] (A : Matrix ι ι ℝ) (e : κ ≃ ι) :\n spectralRadius ℝ (A.submatrix e e) = spectralRadius ℝ A := by\n have hs : spectrum ℝ (A.submatrix e e) = spectrum ℝ A :=\n AlgEquiv.spectrum_eq (Matrix.reindexAlgEquiv ℝ ℝ e.symm) A\n simp only [spectralRadius_eq_of_unital, hs]\ntheorem upper_spectral_order_le {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) [DecidableRel G.Adj] (lambda : ℝ)\n (hG : spectralRadius ℝ (G.adjMatrix ℝ) = ENNReal.ofReal lambda) :\n spectralRadiusOrder lambda ≤ (Fintype.card ι : ℕ∞) := by\n classical\n let e : Fin (Fintype.card ι) ≃ ι := (Fintype.equivFin ι).symm\n let H := G.comap e\n let : DecidableRel H.Adj := Classical.decRel H.Adj\n have hA : H.adjMatrix ℝ = (G.adjMatrix ℝ).submatrix e e := by\n ext i j\n simp [H, SimpleGraph.adjMatrix_apply]\n have hH : spectralRadius ℝ (H.adjMatrix ℝ) = ENNReal.ofReal lambda := by\n rw [hA, upper_spectralRadius_relabel]\n exact hG\n unfold spectralRadiusOrder\n exact iInf_le_of_le (Fintype.card ι) (iInf_le_of_le ⟨H, hH⟩ le_rfl)\ntheorem upper_eigenspace_add_rank {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (lambda : ℝ) :\n Module.finrank ℝ (Module.End.eigenspace A.mulVecLin lambda) +\n (lambda • (1 : Matrix ι ι ℝ) - A).rank = Fintype.card ι := by\n have hker : LinearMap.ker (lambda • (1 : Matrix ι ι ℝ) - A).mulVecLin =\n Module.End.eigenspace A.mulVecLin lambda := by\n ext x\n rw [LinearMap.mem_ker, Module.End.mem_eigenspace_iff]\n simp only [Matrix.mulVecLin_apply, Matrix.sub_mulVec, Matrix.smul_mulVec,\n Matrix.one_mulVec, sub_eq_zero]\n exact eq_comm\n have h := LinearMap.finrank_range_add_finrank_ker\n (lambda • (1 : Matrix ι ι ℝ) - A).mulVecLin\n rw [hker, ← Matrix.rank, Module.finrank_fintype_fun_eq_card] at h\n omega\ntheorem upper_eigenspace_relabel {ι κ : Type*} [Fintype ι] [Fintype κ]\n [DecidableEq ι] [DecidableEq κ] (A : Matrix ι ι ℝ) (e : κ ≃ ι) (lambda : ℝ) :\n Module.finrank ℝ (Module.End.eigenspace (A.submatrix e e).mulVecLin lambda) =\n Module.finrank ℝ (Module.End.eigenspace A.mulVecLin lambda) := by\n have h1 := upper_eigenspace_add_rank (A.submatrix e e) lambda\n have h2 := upper_eigenspace_add_rank A lambda\n have heq : lambda • (1 : Matrix κ κ ℝ) - A.submatrix e e =\n (lambda • (1 : Matrix ι ι ℝ) - A).submatrix e e := by\n ext i j\n simp [Matrix.one_apply, e.injective.eq_iff]\n rw [heq, Matrix.rank_submatrix, Fintype.card_congr e] at h1\n omega\ntheorem upper_gram_psd_rank (α : ℝ) (hα : α ∈ Set.Ioo 0 1) (d n : ℕ)\n (v : Fin n → EuclideanSpace ℝ (Fin d)) (A : Matrix (Fin n) (Fin n) ℝ)\n (hgram : Matrix.gram ℝ v = (1 - α) • (1 : Matrix (Fin n) (Fin n) ℝ) +\n α • Matrix.of (fun _ _ : Fin n => (1 : ℝ)) - (2 * α) • A) :\n let P := ((1 - α) / (2 * α)) • (1 : Matrix (Fin n) (Fin n) ℝ) - A +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ : Fin n => (1 : ℝ))\n P.PosSemidef ∧ P.rank ≤ d := by\n have hα0 : α ≠ 0 := ne_of_gt hα.1\n have heq : ((1 - α) / (2 * α)) • (1 : Matrix (Fin n) (Fin n) ℝ) - A +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ : Fin n => (1 : ℝ)) =\n (1 / (2 * α)) • Matrix.gram ℝ v := by\n rw [hgram]\n ext i j\n simp only [Matrix.add_apply, Matrix.sub_apply, Matrix.smul_apply, smul_eq_mul]\n field_simp [hα0]\n ring\n dsimp only\n rw [heq]\n exact ⟨(Matrix.posSemidef_gram ℝ v).smul (by\n have hp := hα.1\n positivity),\n (real_matrix_rank_smul_le _ _).trans (euclidean_gram_rank_le v)⟩\ntheorem upper_psd_eigenvalue_exception {ι : Type*} [Fintype ι] [DecidableEq ι]\n [Nonempty ι] (A : Matrix ι ι ℝ) (hA : A.IsHermitian) (lambda : ℝ)\n (hP : (lambda • (1 : Matrix ι ι ℝ) - A +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).PosSemidef) :\n ∃ j : ι, ∀ i : ι, i ≠ j → hA.eigenvalues i ≤ lambda := by\n classical\n have hone (i : ι) : dotProduct (hA.eigenvectorBasis i).ofLp\n (hA.eigenvectorBasis i).ofLp = 1 := by\n have h := (orthonormal_iff_ite.mp hA.eigenvectorBasis.orthonormal) i i\n simpa only [EuclideanSpace.inner_eq_star_dotProduct, star_trivial,\n if_pos rfl, ite_true] using h\n have hsum (i : ι) (hi : lambda < hA.eigenvalues i) :\n (∑ k, (hA.eigenvectorBasis i).ofLp k) ≠ 0 := by\n intro hz\n have h := hP.dotProduct_mulVec_nonneg (hA.eigenvectorBasis i).ofLp\n simp only [star_trivial] at h\n rw [Helpers.component_rank_one_quadratic, hz, zero_pow (by decide : 2 ≠ 0),\n mul_zero, add_zero, Matrix.sub_mulVec, Matrix.smul_mulVec, Matrix.one_mulVec,\n dotProduct_sub, dotProduct_smul, hA.mulVec_eigenvectorBasis, dotProduct_smul,\n hone, smul_eq_mul] at h\n simp only [smul_eq_mul, mul_one] at h\n linarith\n by_cases hex : ∃ j, lambda < hA.eigenvalues j\n · obtain ⟨j, hj⟩ := hex\n refine ⟨j, ?_⟩\n intro i hij\n by_contra hi\n have hi' : lambda < hA.eigenvalues i := lt_of_not_ge hi\n let x := (hA.eigenvectorBasis j).ofLp\n let y := (hA.eigenvectorBasis i).ofLp\n let a := ∑ k, x k\n let b := ∑ k, y k\n let z := b • x - a • y\n have hx : A.mulVec x = hA.eigenvalues j • x := hA.mulVec_eigenvectorBasis j\n have hy : A.mulVec y = hA.eigenvalues i • y := hA.mulVec_eigenvectorBasis i\n have hxy : dotProduct x y = 0 := by\n have h := hA.eigenvectorBasis.orthonormal.inner_eq_zero hij.symm\n simpa only [EuclideanSpace.inner_eq_star_dotProduct, star_trivial,\n dotProduct_comm] using h\n have hyx : dotProduct y x = 0 := by rw [dotProduct_comm, hxy]\n have hzsum : ∑ k, z k = 0 := by\n simp only [z, Pi.sub_apply, Pi.smul_apply, smul_eq_mul,\n Finset.sum_sub_distrib, ← Finset.mul_sum]\n change b * a - a * b = 0\n ring\n have hzn : dotProduct z z = b ^ 2 + a ^ 2 := by\n simp only [z, sub_dotProduct, dotProduct_sub, smul_dotProduct,\n dotProduct_smul, hxy, hyx, smul_eq_mul]\n rw [hone j, hone i]\n ring\n have hzq : dotProduct z (A.mulVec z) =\n b ^ 2 * hA.eigenvalues j + a ^ 2 * hA.eigenvalues i := by\n simp only [z, Matrix.mulVec_sub, Matrix.mulVec_smul,\n hx, hy, sub_dotProduct, dotProduct_sub, smul_dotProduct,\n dotProduct_smul, smul_eq_mul, hxy, hyx]\n rw [hone j, hone i]\n ring\n have h := hP.dotProduct_mulVec_nonneg z\n simp only [star_trivial] at h\n rw [Helpers.component_rank_one_quadratic, hzsum, zero_pow (by decide : 2 ≠ 0),\n mul_zero, add_zero, Matrix.sub_mulVec, Matrix.smul_mulVec, Matrix.one_mulVec,\n dotProduct_sub, dotProduct_smul, smul_eq_mul, hzn, hzq] at h\n have h1 := mul_pos (sq_pos_of_ne_zero (hsum i hi')) (sub_pos.mpr hj)\n have h2 := mul_nonneg (sq_nonneg a) (sub_nonneg.mpr hi'.le)\n change 0 < b ^ 2 * (hA.eigenvalues j - lambda) at h1\n nlinarith only [h, h1, h2]\n · exact ⟨Classical.choice ‹Nonempty ι›, fun i _ => le_of_not_gt (fun hi => hex ⟨i, hi⟩)⟩\ntheorem upper_rank_one_submatrix {ι κ : Type*} [DecidableEq ι] [DecidableEq κ]\n (A : Matrix ι ι ℝ) (lambda : ℝ) (e : κ → ι) (he : Function.Injective e) :\n (lambda • (1 : Matrix ι ι ℝ) - A +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).submatrix e e =\n lambda • (1 : Matrix κ κ ℝ) - A.submatrix e e +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ)) := by\n ext i j\n simp [Matrix.one_apply, he.eq_iff]\ntheorem upper_uniform_connected_multiplicity (Δ : ℕ) (ε : ℝ) (hε : 0 < ε) :\n ∃ M : ℕ, ∀ {ι : Type} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) [DecidableRel G.Adj] (lambda : ℝ),\n M ≤ Fintype.card ι → 0 < lambda → G.Connected →\n (∀ i, ({j | G.Adj i j} : Set ι).ncard ≤ Δ) →\n (lambda • (1 : Matrix ι ι ℝ) - G.adjMatrix ℝ +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).PosSemidef →\n (Module.finrank ℝ (Module.End.eigenspace (G.adjMatrix ℝ).mulVecLin lambda) : ℝ) ≤\n ε * (Fintype.card ι : ℝ) := by\n classical\n obtain ⟨M, hM⟩ := Helpers.uniform_second_eigenvalue_multiplicity Δ ε hε\n refine ⟨M, ?_⟩\n intro ι _ _ G _ lambda hsize hlam hG hdegree hP\n let e : Fin (Fintype.card ι) ≃ ι := (Fintype.equivFin ι).symm\n let H := G.comap e\n let : DecidableRel H.Adj := Classical.decRel H.Adj\n have hA : H.adjMatrix ℝ = (G.adjMatrix ℝ).submatrix e e := by\n ext i j\n simp [H, SimpleGraph.adjMatrix_apply]\n have hH : H.Connected := (SimpleGraph.Iso.comap e G).connected_iff.mpr hG\n let : Nonempty (Fin (Fintype.card ι)) := hH.nonempty\n have hdeg : ∀ i, ({j | H.Adj i j} : Set (Fin (Fintype.card ι))).ncard ≤ Δ := by\n intro i\n apply le_trans _ (hdegree (e i))\n exact Set.ncard_le_ncard_of_injOn e (fun j hj => hj)\n (fun _ _ _ _ he => e.injective he)\n have hPH : (lambda • (1 : Matrix (Fin (Fintype.card ι)) (Fin (Fintype.card ι)) ℝ) -\n H.adjMatrix ℝ + (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).PosSemidef := by\n rw [hA, ← upper_rank_one_submatrix _ _ e e.injective]\n exact hP.submatrix e\n have hHerm : (H.adjMatrix ℝ).IsHermitian := by\n change (H.adjMatrix ℝ).conjTranspose = H.adjMatrix ℝ\n rw [Matrix.conjTranspose_eq_transpose_of_trivial, H.transpose_adjMatrix]\n have hb := hM (Fintype.card ι) H lambda hsize hlam hH hdeg hHerm\n (upper_psd_eigenvalue_exception _ hHerm lambda hPH)\n rw [hA, upper_eigenspace_relabel] at hb\n exact hb\nnoncomputable def upperComponentRadius {n : ℕ} (G : SimpleGraph (Fin n))\n (C : G.ConnectedComponent) : ENNReal := by\n classical\n letI : Fintype C.supp := Fintype.ofFinite C.supp\n letI : DecidableEq C.supp := Classical.decEq C.supp\n letI : DecidableRel C.toSimpleGraph.Adj := Classical.decRel C.toSimpleGraph.Adj\n exact spectralRadius ℝ (C.toSimpleGraph.adjMatrix ℝ)\ntheorem upper_graph_bound_cases (Δ : ℕ) (ε : ℝ) (hε : 0 < ε) :\n ∃ M : ℕ, ∀ (n d : ℕ) (G : SimpleGraph (Fin n))\n (lambda : ℝ), 0 < lambda →\n (∀ i, ({j | G.Adj i j} : Set (Fin n)).ncard ≤ Δ) →\n let A : Matrix (Fin n) (Fin n) ℝ :=\n (letI : DecidableRel G.Adj := Classical.decRel G.Adj; G.adjMatrix ℝ)\n let P := lambda • (1 : Matrix (Fin n) (Fin n) ℝ) - A +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))\n P.PosSemidef → P.rank ≤ d →\n ((¬ ∃ C, ENNReal.ofReal lambda < upperComponentRadius G C) ∧\n P.rank = if ({C | upperComponentRadius G C = ENNReal.ofReal lambda} :\n Set G.ConnectedComponent).ncard = 0 then n else\n n + 1 - ({C | upperComponentRadius G C = ENNReal.ofReal lambda} :\n Set G.ConnectedComponent).ncard) ∨\n (n : ℝ) ≤ (d : ℝ) + 1 + M + ε * n := by\n classical\n obtain ⟨M, hM⟩ := upper_uniform_connected_multiplicity Δ ε hε\n refine ⟨M, ?_⟩\n intro n d G lambda hlam hdeg\n let : DecidableRel G.Adj := Classical.decRel G.Adj\n dsimp only\n let P := lambda • (1 : Matrix (Fin n) (Fin n) ℝ) - G.adjMatrix ℝ +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))\n intro hP hrank\n let : Fintype G.ConnectedComponent := Fintype.ofFinite _\n let (C : G.ConnectedComponent) : Fintype C.supp := Fintype.ofFinite _\n let (C : G.ConnectedComponent) : DecidableEq C.supp := Classical.decEq _\n let (C : G.ConnectedComponent) : DecidableRel C.toSimpleGraph.Adj := Classical.decRel _\n have hc := Helpers.component_rank_one_accounting n G lambda hlam hP\n change\n ((¬ ∃ C, ENNReal.ofReal lambda < upperComponentRadius G C) →\n P.rank = if ({C | upperComponentRadius G C = ENNReal.ofReal lambda} :\n Set G.ConnectedComponent).ncard = 0 then n else\n n + 1 - ({C | upperComponentRadius G C = ENNReal.ofReal lambda} :\n Set G.ConnectedComponent).ncard) ∧\n ((∃ C, ENNReal.ofReal lambda < upperComponentRadius G C) →\n ∃ C, ENNReal.ofReal lambda < upperComponentRadius G C ∧\n (∀ D, D ≠ C → upperComponentRadius G D < ENNReal.ofReal lambda) ∧\n Module.finrank ℝ (Module.End.eigenspace (G.adjMatrix ℝ).mulVecLin lambda) =\n Module.finrank ℝ (Module.End.eigenspace\n (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda) ∧\n n ≤ P.rank + 1 + Module.finrank ℝ (Module.End.eigenspace\n (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda)) at hc\n by_cases hex : ∃ C, ENNReal.ofReal lambda < upperComponentRadius G C\n · right\n obtain ⟨C, _, _, _, hn⟩ := hc.2 hex\n have hcard : Nat.card C = Nat.card C.supp := Nat.card_congr\n { toFun := fun i => ⟨i.val, i.property⟩\n invFun := fun i => ⟨i.val, i.property⟩\n left_inv := fun _ => rfl\n right_inv := fun _ => rfl }\n have hCn : Fintype.card C.supp ≤ n := by\n simpa only [Fintype.card_fin] using\n Fintype.card_le_of_injective (Subtype.val : C.supp → Fin n) Subtype.val_injective\n have hm : (Module.finrank ℝ (Module.End.eigenspace\n (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda) : ℝ) ≤ M + ε * n := by\n by_cases hsize : M ≤ Fintype.card C.supp\n · have hsub : (G.adjMatrix ℝ).submatrix (Subtype.val : C.supp → Fin n)\n Subtype.val = C.toSimpleGraph.adjMatrix ℝ := by\n ext i j\n change (G.adjMatrix ℝ) i.val j.val = (G.induce C.supp).adjMatrix ℝ i j\n simp only [SimpleGraph.adjMatrix_apply, SimpleGraph.induce_adj]\n have hPC : (lambda • (1 : Matrix C.supp C.supp ℝ) -\n C.toSimpleGraph.adjMatrix ℝ +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).PosSemidef := by\n have hh := hP.submatrix (Subtype.val : C.supp → Fin n)\n rw [upper_rank_one_submatrix _ _ _ Subtype.val_injective] at hh\n convert hh using 1\n ext i j\n simp only [Matrix.submatrix_apply, Matrix.add_apply, Matrix.sub_apply,\n Matrix.smul_apply, smul_eq_mul]\n congr 2\n have hh := hM C.toSimpleGraph lambda hsize hlam C.connected_toSimpleGraph\n (Helpers.induced_graph_degree_bound G C.supp Δ hdeg) hPC\n simp only [← Nat.card_eq_fintype_card] at hh\n rw [hcard] at hh\n have hcast : (Fintype.card C.supp : ℝ) ≤ n := by exact_mod_cast hCn\n simp only [← Nat.card_eq_fintype_card] at hcast\n have hmul := mul_le_mul_of_nonneg_left hcast hε.le\n have hMn : (0 : ℝ) ≤ M := Nat.cast_nonneg _\n linarith\n · have hsmall : Module.finrank ℝ (Module.End.eigenspace\n (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda) ≤ M := by\n have hh := Submodule.finrank_le (Module.End.eigenspace\n (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda)\n rw [Module.finrank_fintype_fun_eq_card] at hh\n simp only [← Nat.card_eq_fintype_card] at hh hsize\n rw [hcard] at hh\n omega\n have hh : (Module.finrank ℝ (Module.End.eigenspace\n (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda) : ℝ) ≤ M := by\n exact_mod_cast hsmall\n have hprod : 0 ≤ ε * (n : ℝ) := mul_nonneg hε.le (Nat.cast_nonneg _)\n linarith\n have hn' : (n : ℝ) ≤ (d : ℝ) + 1 + Module.finrank ℝ (Module.End.eigenspace\n (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda) := by\n exact_mod_cast hn.trans (Nat.add_le_add_right (Nat.add_le_add_right hrank 1) _)\n linarith\n · exact Or.inl ⟨hex, hc.1 hex⟩\ntheorem upper_critical_count_mul_le (n : ℕ) (G : SimpleGraph (Fin n)) (lambda : ℝ)\n (q : ℕ) (hq : (q : ℕ∞) ≤ spectralRadiusOrder lambda) :\n q * ({C | upperComponentRadius G C = ENNReal.ofReal lambda} :\n Set G.ConnectedComponent).ncard ≤ n := by\n classical\n let : Fintype G.ConnectedComponent := Fintype.ofFinite _\n let (C : G.ConnectedComponent) : Fintype C.supp := Fintype.ofFinite _\n let (C : G.ConnectedComponent) : DecidableEq C.supp := Classical.decEq _\n let (C : G.ConnectedComponent) : DecidableRel C.toSimpleGraph.Adj := Classical.decRel _\n let S := Finset.univ.filter (fun C => upperComponentRadius G C = ENNReal.ofReal lambda)\n have ht : ({C | upperComponentRadius G C = ENNReal.ofReal lambda} :\n Set G.ConnectedComponent).ncard = S.card := by\n simp only [Set.ncard_eq_toFinset_card', Set.toFinset_ofPred, S]\n have hsize (C : G.ConnectedComponent) (hC : C ∈ S) : q ≤ Fintype.card C.supp := by\n have hr : spectralRadius ℝ (C.toSimpleGraph.adjMatrix ℝ) = ENNReal.ofReal lambda := by\n exact (Finset.mem_filter.mp hC).2\n have hh := hq.trans (upper_spectral_order_le C.toSimpleGraph lambda hr)\n have hcard : Fintype.card C = Fintype.card C.supp := Fintype.card_congr\n { toFun := fun i => ⟨i.val, i.property⟩\n invFun := fun i => ⟨i.val, i.property⟩\n left_inv := fun _ => rfl\n right_inv := fun _ => rfl }\n rw [hcard] at hh\n exact_mod_cast hh\n have htotal : (∑ C : G.ConnectedComponent, Fintype.card C.supp) = n := by\n have hh := Helpers.component_sum_by_components G (fun _ => (1 : ℝ))\n simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul, mul_one,\n Fintype.card_fin] at hh\n exact_mod_cast hh\n rw [ht]\n calc\n q * S.card = ∑ C ∈ S, q := by simp [mul_comm]\n _ ≤ ∑ C ∈ S, Fintype.card C.supp := Finset.sum_le_sum hsize\n _ ≤ ∑ C : G.ConnectedComponent, Fintype.card C.supp :=\n Finset.sum_le_sum_of_subset (Finset.filter_subset _ _)\n _ = n := htotal\ntheorem upper_no_critical_of_infinite (n : ℕ) (G : SimpleGraph (Fin n)) (lambda : ℝ)\n (htop : spectralRadiusOrder lambda = ⊤) :\n ({C | upperComponentRadius G C = ENNReal.ofReal lambda} :\n Set G.ConnectedComponent).ncard = 0 := by\n classical\n have hempty : ({C | upperComponentRadius G C = ENNReal.ofReal lambda} :\n Set G.ConnectedComponent) = ∅ := by\n apply Set.eq_empty_iff_forall_notMem.mpr\n intro C hC\n let : Fintype C.supp := Fintype.ofFinite _\n let : DecidableEq C.supp := Classical.decEq _\n let : DecidableRel C.toSimpleGraph.Adj := Classical.decRel _\n have hr : spectralRadius ℝ (C.toSimpleGraph.adjMatrix ℝ) = ENNReal.ofReal lambda := hC\n have hh := upper_spectral_order_le C.toSimpleGraph lambda hr\n rw [htop] at hh\n exact (not_le_of_gt (ENat.natCast_lt_top (Fintype.card C))) hh\n rw [hempty, Set.ncard_empty]\ntheorem upper_rank_count_floor (n d q t r : ℕ) (hq : 2 ≤ q) (hd : q ≤ d)\n (ht : q * t ≤ n) (hr : r = if t = 0 then n else n + 1 - t) (hrd : r ≤ d) :\n n ≤ ⌊(q * (d - 1) : ℝ) / (q - 1 : ℝ)⌋₊ := by\n have hqR : (2 : ℝ) ≤ q := by exact_mod_cast hq\n have hdR : (q : ℝ) ≤ d := by exact_mod_cast hd\n have hden : 0 < (q : ℝ) - 1 := by linarith\n apply Nat.le_floor\n apply (le_div_iff₀ hden).mpr\n by_cases hz : t = 0\n · rw [hz, if_pos rfl] at hr\n have hnd : n ≤ d := by omega\n have hnR : (n : ℝ) ≤ d := by exact_mod_cast hnd\n nlinarith\n · rw [if_neg hz] at hr\n have htn : t ≤ n := by nlinarith\n have hn : n + 1 ≤ d + t := by omega\n have hnR : (n : ℝ) + 1 ≤ (d : ℝ) + t := by exact_mod_cast hn\n have htR : (q : ℝ) * t ≤ (n : ℝ) := by exact_mod_cast ht\n nlinarith\ntheorem upper_N_le_of_unit_bound (α : ℝ) (d B : ℕ)\n (hB : ∀ (n : ℕ) (v : Fin n → EuclideanSpace ℝ (Fin d)),\n (∀ i, ‖v i‖ = 1) →\n (∀ i j, i ≠ j → |inner ℝ (v i) (v j)| = α) → n ≤ B) : N α d ≤ B := by\n classical\n apply ciSup_le'\n intro E\n by_cases hz : E.carrier.ncard = 0\n · rw [hz]\n exact Nat.zero_le _\n · have hfin := Set.finite_of_ncard_ne_zero hz\n let : Fintype E.carrier := hfin.fintype\n let e : Fin (Fintype.card E.carrier) ≃ E.carrier := (Fintype.equivFin _).symm\n have hh := hB (Fintype.card E.carrier) (fun i => (e i).val)\n (fun i => E.norm (e i).val (e i).property)\n (fun i j hij => E.angle (e i).property (e j).property (by\n intro he\n exact hij (e.injective (Subtype.ext he))))\n rwa [Set.fintypeCard_eq_ncard] at hh\ntheorem upper_unit_vector_bound_cases (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n (ε : ℝ) (hε : 0 < ε) :\n ∃ M : ℕ, ∀ (d n : ℕ) (v : Fin n → EuclideanSpace ℝ (Fin d)),\n (∀ i, ‖v i‖ = 1) →\n (∀ i j, i ≠ j → |inner ℝ (v i) (v j)| = α) →\n (∃ G : SimpleGraph (Fin n),\n (if ({C | upperComponentRadius G C = ENNReal.ofReal ((1 - α) / (2 * α))} :\n Set G.ConnectedComponent).ncard = 0 then n else\n n + 1 - ({C | upperComponentRadius G C = ENNReal.ofReal ((1 - α) / (2 * α))} :\n Set G.ConnectedComponent).ncard) ≤ d) ∨\n (n : ℝ) ≤ (d : ℝ) + 1 + M + ε * n := by\n classical\n obtain ⟨Δ, hΔ⟩ := Helpers.uniform_switching_with_gram_data α hα\n obtain ⟨M, hM⟩ := upper_graph_bound_cases Δ ε hε\n refine ⟨M, ?_⟩\n intro d n v hnorm hangle\n obtain ⟨σ, G, _, _, _, _, _, _, hdegree, hgram⟩ := hΔ d n v hnorm hangle\n let : DecidableRel G.Adj := Classical.decRel G.Adj\n have hP := upper_gram_psd_rank α hα d n (fun i => σ i • v i) (G.adjMatrix ℝ) hgram\n have hlam : 0 < (1 - α) / (2 * α) :=\n div_pos (sub_pos.mpr hα.2) (mul_pos (by norm_num) hα.1)\n rcases hM n d G _ hlam hdegree hP.1 hP.2 with hc | hb\n · left\n refine ⟨G, ?_⟩\n rw [← hc.2]\n exact hP.2\n · exact Or.inr hb\ntheorem upper_absorb_finite (n d q M : ℕ) (hq : 2 ≤ q)\n (hd : 2 * q * (M + 2) ≤ d)\n (hb : (n : ℝ) ≤ (d : ℝ) + 1 + M + (1 / (2 * (q : ℝ))) * n) :\n n ≤ ⌊(q * (d - 1) : ℝ) / (q - 1 : ℝ)⌋₊ := by\n have hqR : (2 : ℝ) ≤ q := by exact_mod_cast hq\n have hqpos : 0 < (q : ℝ) := by linarith\n have hM : (0 : ℝ) ≤ M := Nat.cast_nonneg _\n have hdR : 2 * (q : ℝ) * ((M : ℝ) + 2) ≤ d := by exact_mod_cast hd\n have hcancel : (2 * (q : ℝ)) * ((1 / (2 * (q : ℝ))) * n) = n := by\n field_simp\n <;> ring\n have hbase : (n : ℝ) * (2 * (q : ℝ) - 1) ≤\n 2 * (q : ℝ) * ((d : ℝ) + (M : ℝ) + 1) := by\n have hh := mul_le_mul_of_nonneg_left hb (show 0 ≤ 2 * (q : ℝ) by positivity)\n simp only [mul_add, hcancel] at hh\n nlinarith only [hh]\n have hthreshold := mul_le_mul_of_nonneg_left hdR hqpos.le\n have hcompare : 2 * (q : ℝ) * ((d : ℝ) + (M : ℝ) + 1) * ((q : ℝ) - 1) ≤\n (q : ℝ) * ((d : ℝ) - 1) * (2 * (q : ℝ) - 1) := by\n nlinarith [mul_nonneg hqpos.le hM]\n apply Nat.le_floor\n apply (le_div_iff₀ (show 0 < (q : ℝ) - 1 by linarith)).mpr\n apply (mul_le_mul_iff_left₀ (show 0 < 2 * (q : ℝ) - 1 by linarith)).mp\n calc\n (n : ℝ) * ((q : ℝ) - 1) * (2 * (q : ℝ) - 1) =\n ((n : ℝ) * (2 * (q : ℝ) - 1)) * ((q : ℝ) - 1) := by ring\n _ ≤ (2 * (q : ℝ) * ((d : ℝ) + (M : ℝ) + 1)) * ((q : ℝ) - 1) :=\n mul_le_mul_of_nonneg_right hbase (by linarith)\n _ ≤ (q : ℝ) * ((d : ℝ) - 1) * (2 * (q : ℝ) - 1) := hcompare\ntheorem upper_absorb_infinite (n d M : ℕ) (ε : ℝ) (hε : 0 < ε)\n (hd : 2 * ((M : ℝ) + 1) / ε ≤ (d : ℝ))\n (hb : (n : ℝ) ≤ (d : ℝ) + 1 + M + (ε / (2 * (1 + ε))) * n) :\n (n : ℝ) ≤ (1 + ε) * d := by\n let δ := ε / (2 * (1 + ε))\n have hden : 0 < 2 * (1 + ε) := by positivity\n have hδ : δ < 1 := by\n apply (div_lt_one hden).mpr\n linarith\n have hcoef : (1 - δ) * (1 + ε) = 1 + ε / 2 := by\n dsimp [δ]\n field_simp\n <;> ring\n have hconst : (M : ℝ) + 1 ≤ ε * (d : ℝ) / 2 := by\n have hh := (div_le_iff₀ hε).mp hd\n linarith\n apply (mul_le_mul_iff_right₀ (sub_pos.mpr hδ)).mp\n calc\n (1 - δ) * (n : ℝ) ≤ (d : ℝ) + 1 + M := by\n change (n : ℝ) ≤ (d : ℝ) + 1 + M + δ * n at hb\n linarith\n _ ≤ (1 + ε / 2) * (d : ℝ) := by nlinarith only [hconst]\n _ = (1 - δ) * ((1 + ε) * (d : ℝ)) := by rw [← mul_assoc, hcoef]\ntheorem lower_gram_configuration (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n (n d : ℕ) (M : Matrix (Fin n) (Fin n) ℝ) (hM : M.PosSemidef)\n (hrank : M.rank ≤ d) (hdiag : ∀ i, M i i = 1)\n (hoff : ∀ i j, i ≠ j → |M i j| = α) : n ≤ N α d := by\n classical\n obtain ⟨v, hv⟩ := Helpers.positive_semidefinite_gram_realization n d M hM hrank\n have hinner : ∀ i j, ⟪v i, v j⟫ = M i j := by\n intro i j\n exact congrFun (congrFun hv i) j\n have hnorm : ∀ i, ‖v i‖ = 1 := by\n intro i\n have h := hinner i i\n rw [hdiag, inner_self_eq_norm_sq_to_K] at h\n change ‖v i‖ ^ 2 = 1 at h\n nlinarith [norm_nonneg (v i)]\n have hinj : Function.Injective v := by\n intro i j hij\n by_contra hne\n have h := hoff i j hne\n rw [← hinner, hij, inner_self_eq_norm_sq_to_K, hnorm] at h\n norm_num at h\n exact (ne_of_lt hα.2) h.symm\n let E : EquiangularLines α d :=\n { carrier := Set.range v\n norm := by rintro x ⟨i, rfl⟩; exact hnorm i\n angle := by\n rintro x ⟨i, rfl⟩ y ⟨j, rfl⟩ hxy\n rw [hinner]\n exact hoff i j (fun hij => hxy (congrArg v hij)) }\n have hc : E.carrier.ncard = n := by\n exact (Set.ncard_range_of_injective hinj).trans (by simp)\n rw [← hc]\n exact configuration_cardinality_le_N α hα d E\ntheorem lower_all_ones_posSemidef {ι : Type*} [Fintype ι] :\n (Matrix.of (fun _ _ : ι => (1 : ℝ))).PosSemidef := by\n classical\n simpa [Matrix.vecMulVec] using\n Matrix.posSemidef_vecMulVec_self_star (fun _ : ι => (1 : ℝ))\ntheorem configuration_dimension_lower_bound (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n (d : ℕ) : d ≤ N α d := by\n classical\n let M : Matrix (Fin d) (Fin d) ℝ :=\n (1 - α) • 1 + α • Matrix.of (fun _ _ => (1 : ℝ))\n apply lower_gram_configuration α hα d d M\n · exact (Matrix.PosSemidef.one.smul (sub_nonneg.mpr hα.2.le)).add\n (lower_all_ones_posSemidef.smul hα.1.le)\n · simpa using Matrix.rank_le_card_height M\n · intro i\n simp [M]\n · intro i j hij\n simp [M, Matrix.one_apply, hij, abs_of_pos hα.1]\ntheorem lower_perron_abs_quadratic_bound {n : ℕ} (G : SimpleGraph (Fin n))\n [DecidableRel G.Adj] (x : Fin n → ℝ) :\n |dotProduct x ((G.adjMatrix ℝ).mulVec x)| ≤\n dotProduct (fun i => |x i|) ((G.adjMatrix ℝ).mulVec (fun i => |x i|)) := by\n classical\n calc\n |dotProduct x ((G.adjMatrix ℝ).mulVec x)| =\n |∑ i, ∑ j, x i * (G.adjMatrix ℝ i j * x j)| := by\n simp only [dotProduct, Matrix.mulVec, Finset.mul_sum]\n _ ≤ ∑ i, ∑ j, |x i * (G.adjMatrix ℝ i j * x j)| := by\n apply (Finset.abs_sum_le_sum_abs _ _).trans\n exact Finset.sum_le_sum (fun i _ => Finset.abs_sum_le_sum_abs _ _)\n _ = dotProduct (fun i => |x i|)\n ((G.adjMatrix ℝ).mulVec (fun i => |x i|)) := by\n simp only [dotProduct, Matrix.mulVec, Finset.mul_sum]\n apply Finset.sum_congr rfl\n intro i _\n apply Finset.sum_congr rfl\n intro j _\n by_cases h : G.Adj i j <;> simp [G.adjMatrix_apply, h, abs_mul]\ntheorem lower_perron_nonnegative_top_eigenvector {n : ℕ} (G : SimpleGraph (Fin n))\n [DecidableRel G.Adj] [Nonempty (Fin n)] :\n ∃ (rho : ℝ) (p : Fin n → ℝ), 0 ≤ rho ∧ (∀ i, 0 ≤ p i) ∧ p ≠ 0 ∧\n (G.adjMatrix ℝ).mulVec p = rho • p ∧\n (∀ x : Fin n → ℝ,\n dotProduct x ((G.adjMatrix ℝ).mulVec x) ≤ rho * dotProduct x x) := by\n classical\n let A := G.adjMatrix ℝ\n have hA : A.IsHermitian := by\n ext i j\n simp [A, Matrix.conjTranspose_apply, G.adj_comm]\n let T := (Matrix.isSymmetric_toEuclideanLin_iff.mpr hA).toSelfAdjoint\n have hT : ∀ x : EuclideanSpace ℝ (Fin n),\n T.val.reApplyInnerSelf x = dotProduct x.ofLp (A.mulVec x.ofLp) := by\n intro x\n rw [ContinuousLinearMap.reApplyInnerSelf_apply]\n have heq : T.val x = Matrix.toEuclideanLin A x := by\n exact congrArg (fun f : EuclideanSpace ℝ (Fin n) →ₗ[ℝ] EuclideanSpace ℝ (Fin n) => f x)\n (Matrix.isSymmetric_toEuclideanLin_iff.mpr hA).coe_toSelfAdjoint\n rw [heq, EuclideanSpace.inner_eq_star_dotProduct]\n simp only [Matrix.toEuclideanLin, Matrix.toLpLin_apply, WithLp.ofLp_toLp,\n star_trivial, RCLike.re_to_real]\n let i : Fin n := Classical.choice inferInstance\n let u : EuclideanSpace ℝ (Fin n) := EuclideanSpace.basisFun (Fin n) ℝ i\n have hu : ‖u‖ = 1 := (EuclideanSpace.basisFun (Fin n) ℝ).norm_eq_one i\n obtain ⟨q, hq, hmax⟩ := (isCompact_sphere (0 : EuclideanSpace ℝ (Fin n)) 1).exists_isMaxOn\n ⟨u, by simpa using hu⟩ T.val.reApplyInnerSelf_continuous.continuousOn\n have hqn : ‖q‖ = 1 := by simpa using hq\n let p : EuclideanSpace ℝ (Fin n) := WithLp.toLp 2 (fun i => |q i|)\n have hpn : ‖p‖ = 1 := by\n rw [EuclideanSpace.norm_eq] at hqn ⊢\n simpa only [p, WithLp.ofLp_toLp, Real.norm_eq_abs, abs_abs] using hqn\n have hpq : T.val.reApplyInnerSelf q ≤ T.val.reApplyInnerSelf p := by\n rw [hT, hT]\n exact (le_abs_self _).trans (lower_perron_abs_quadratic_bound G q.ofLp)\n have hpmax : IsMaxOn T.val.reApplyInnerSelf (Metric.sphere 0 1) p := by\n intro x hx\n exact (hmax hx).trans hpq\n let rho := T.val.reApplyInnerSelf p\n have hp0 : p ≠ 0 := by\n intro h\n have := hpn\n rw [h, norm_zero] at this\n exact zero_ne_one this\n have heig : A.mulVec p.ofLp = rho • p.ofLp := by\n have h := T.prop.eq_smul_self_of_isLocalExtrOn\n (Or.inr (show IsMaxOn T.val.reApplyInnerSelf (Metric.sphere 0 ‖p‖) p by\n simpa only [hpn] using hpmax).localize)\n have heq : T.val p = Matrix.toEuclideanLin A p :=\n congrArg (fun f : EuclideanSpace ℝ (Fin n) →ₗ[ℝ] EuclideanSpace ℝ (Fin n) => f p)\n (Matrix.isSymmetric_toEuclideanLin_iff.mpr hA).coe_toSelfAdjoint\n rw [heq] at h\n have h' := congrArg (WithLp.ofLp) h\n simpa only [Matrix.toEuclideanLin, Matrix.toLpLin_apply, WithLp.ofLp_toLp,\n WithLp.ofLp_smul, ContinuousLinearMap.rayleighQuotient, hpn, one_pow, div_one,\n RCLike.ofReal_real_eq_id, id_eq, rho] using h'\n have hrho : 0 ≤ rho := by\n dsimp only [rho]\n rw [hT]\n change 0 ≤ ∑ i, |q i| * ∑ j, A i j * |q j|\n apply Finset.sum_nonneg\n intro i _\n apply mul_nonneg (abs_nonneg _)\n apply Finset.sum_nonneg\n intro j _\n apply mul_nonneg _ (abs_nonneg _)\n simp only [A, G.adjMatrix_apply]\n split_ifs <;> positivity\n refine ⟨rho, p.ofLp, hrho, fun i => abs_nonneg _, ?_, heig, ?_⟩\n · exact fun h => hp0 ((WithLp.ofLp_eq_zero _).mp h)\n · intro x\n let z : EuclideanSpace ℝ (Fin n) := WithLp.toLp 2 x\n by_cases hz : z = 0\n · have hx : x = 0 := by exact congrArg WithLp.ofLp hz\n simp [hx, dotProduct]\n · have hn : ‖z‖ ≠ 0 := norm_ne_zero_iff.mpr hz\n have hyn : ‖‖z‖⁻¹ • z‖ = 1 := by\n rw [norm_smul, Real.norm_eq_abs, abs_inv, abs_of_nonneg (norm_nonneg z), inv_mul_cancel₀ hn]\n have hy := hpmax (show ‖z‖⁻¹ • z ∈ Metric.sphere 0 1 by simpa using hyn)\n change T.val.reApplyInnerSelf (‖z‖⁻¹ • z) ≤ T.val.reApplyInnerSelf p at hy\n rw [ContinuousLinearMap.reApplyInnerSelf_smul] at hy\n simp only [Real.norm_eq_abs, abs_inv, abs_of_nonneg (norm_nonneg z)] at hy\n have hmul := mul_le_mul_of_nonneg_left hy (sq_nonneg ‖z‖)\n have hcancel : ‖z‖ ^ 2 * (‖z‖⁻¹ ^ 2 * T.val.reApplyInnerSelf z) = T.val.reApplyInnerSelf z := by\n field_simp\n rw [hcancel, hT] at hmul\n have hnorm : ‖z‖ ^ 2 = dotProduct x x := by\n rw [EuclideanSpace.real_norm_sq_eq]\n simp only [z, WithLp.ofLp_toLp, dotProduct, pow_two]\n simpa only [z, WithLp.ofLp_toLp, hnorm, rho, mul_comm] using hmul\ntheorem lower_perron_spectralRadius_eq {n : ℕ} (G : SimpleGraph (Fin n))\n [DecidableRel G.Adj] (rho : ℝ) (hrho : 0 ≤ rho) (p : Fin n → ℝ)\n (hp0 : p ≠ 0) (heig : (G.adjMatrix ℝ).mulVec p = rho • p)\n (hbound : ∀ x : Fin n → ℝ,\n dotProduct x ((G.adjMatrix ℝ).mulVec x) ≤ rho * dotProduct x x) :\n spectralRadius ℝ (G.adjMatrix ℝ) = ENNReal.ofReal rho := by\n classical\n let A := G.adjMatrix ℝ\n have hA : A.IsHermitian := by\n ext i j\n simp [A, Matrix.conjTranspose_apply, G.adj_comm]\n have heigs : ∀ i, |hA.eigenvalues i| ≤ rho := by\n intro i\n let q := hA.eigenvectorBasis i\n have hnorm : dotProduct (fun j => |q j|) (fun j => |q j|) = 1 := by\n calc\n dotProduct (fun j => |q j|) (fun j => |q j|) = ∑ j, (q j) ^ 2 := by\n simp only [dotProduct, ← pow_two, sq_abs]\n _ = ‖q‖ ^ 2 := (EuclideanSpace.real_norm_sq_eq q).symm\n _ = 1 := by rw [hA.eigenvectorBasis.norm_eq_one]; norm_num\n have hb := (lower_perron_abs_quadratic_bound G q.ofLp).trans (hbound (fun j => |q j|))\n rw [hnorm, mul_one] at hb\n simpa only [Matrix.IsHermitian.eigenvalues_eq, star_trivial, RCLike.re_to_real, q] using hb\n have hpv : Module.End.HasEigenvector (Matrix.toEuclideanLin A) rho (WithLp.toLp 2 p) := by\n constructor\n · rw [Module.End.mem_eigenspace_iff]\n change WithLp.toLp 2 (A.mulVec p) = rho • WithLp.toLp 2 p\n rw [heig, WithLp.toLp_smul]\n · intro h\n exact hp0 (congrArg WithLp.ofLp h)\n have hmem : rho ∈ spectrum ℝ A := by\n simpa only [Matrix.toEuclideanLin, Matrix.spectrum_toLpLin] using\n (Module.End.hasEigenvalue_of_hasEigenvector hpv).mem_spectrum\n apply le_antisymm\n · rw [spectralRadius_eq_of_unital]\n refine iSup₂_le fun t ht => ?_\n change t ∈ spectrum ℝ A at ht\n rw [hA.spectrum_real_eq_range_eigenvalues] at ht\n obtain ⟨i, rfl⟩ := ht\n have hnorm : ‖hA.eigenvalues i‖ ≤ rho := by\n simpa only [Real.norm_eq_abs] using heigs i\n calc\n (↑‖hA.eigenvalues i‖₊ : ENNReal) = ENNReal.ofReal ‖hA.eigenvalues i‖ :=\n ENNReal.coe_nnreal_eq ‖hA.eigenvalues i‖₊\n _ ≤ ENNReal.ofReal rho := ENNReal.ofReal_le_ofReal hnorm\n · calc\n ENNReal.ofReal rho = (↑‖rho‖₊ : ENNReal) := by\n calc\n ENNReal.ofReal rho = ENNReal.ofReal ‖rho‖ := by rw [Real.norm_of_nonneg hrho]\n _ = (↑‖rho‖₊ : ENNReal) := (ENNReal.coe_nnreal_eq ‖rho‖₊).symm\n _ ≤ spectralRadius ℝ A := by\n rw [spectralRadius_eq_of_unital]\n exact le_iSup_of_le rho (le_iSup_of_le hmem le_rfl)\ntheorem lower_graph_order_ge_two (lambda : ℝ) (hlambda : 0 < lambda)\n (n : ℕ) (G : SimpleGraph (Fin n)) [DecidableRel G.Adj]\n (hradius : spectralRadius ℝ (G.adjMatrix ℝ) = ENNReal.ofReal lambda) : 2 ≤ n := by\n classical\n by_contra hn\n have hsmall : n ≤ 1 := by omega\n letI : Subsingleton (Fin n) := Fin.subsingleton_iff_le_one.mpr hsmall\n have hzero : G.adjMatrix ℝ = 0 := by\n ext i j\n have hij : i = j := Subsingleton.elim _ _\n subst j\n simp\n rw [hzero, spectrum.spectralRadius_zero] at hradius\n exact (ne_of_gt (ENNReal.ofReal_pos.mpr hlambda)) hradius.symm\ntheorem lower_graph_shift_psd_rank (lambda : ℝ) (hlambda : 0 < lambda)\n (n : ℕ) (G : SimpleGraph (Fin n)) [DecidableRel G.Adj]\n (hradius : spectralRadius ℝ (G.adjMatrix ℝ) = ENNReal.ofReal lambda) :\n (lambda • (1 : Matrix (Fin n) (Fin n) ℝ) - G.adjMatrix ℝ).PosSemidef ∧\n (lambda • (1 : Matrix (Fin n) (Fin n) ℝ) - G.adjMatrix ℝ).rank ≤ n - 1 := by\n classical\n have hn := lower_graph_order_ge_two lambda hlambda n G hradius\n letI : Nonempty (Fin n) := ⟨⟨0, by omega⟩⟩\n obtain ⟨rho, p, hrho, _, hp0, heig, hbound⟩ := lower_perron_nonnegative_top_eigenvector G\n have hr := lower_perron_spectralRadius_eq G rho hrho p hp0 heig hbound\n have heq : rho = lambda := by\n have h := congrArg ENNReal.toReal (hr.symm.trans hradius)\n simpa only [ENNReal.toReal_ofReal hrho, ENNReal.toReal_ofReal hlambda.le] using h\n subst rho\n let B : Matrix (Fin n) (Fin n) ℝ := lambda • 1 - G.adjMatrix ℝ\n have hA : (G.adjMatrix ℝ).IsHermitian := by\n ext i j\n simp [Matrix.conjTranspose_apply, G.adj_comm]\n have hB : B.PosSemidef := by\n apply Matrix.PosSemidef.of_dotProduct_mulVec_nonneg\n ((Matrix.isHermitian_one.smul (show IsSelfAdjoint lambda from rfl)).sub hA)\n intro x\n simp only [B, star_trivial, Matrix.sub_mulVec, Matrix.smul_mulVec,\n Matrix.one_mulVec, dotProduct_sub, dotProduct_smul]\n exact sub_nonneg.mpr (hbound x)\n refine ⟨hB, ?_⟩\n have hpker : p ∈ LinearMap.ker B.mulVecLin := by\n rw [LinearMap.mem_ker]\n simp only [B, Matrix.mulVecLin_apply, Matrix.sub_mulVec, Matrix.smul_mulVec,\n Matrix.one_mulVec, heig, sub_self]\n have hk : 1 ≤ Module.finrank ℝ (LinearMap.ker B.mulVecLin) := by\n apply Submodule.one_le_finrank_iff.mpr\n intro hzero\n rw [hzero, Submodule.mem_bot] at hpker\n exact hp0 hpker\n have hdim := LinearMap.finrank_range_add_finrank_ker B.mulVecLin\n have hdim' : B.rank + Module.finrank ℝ (LinearMap.ker B.mulVecLin) = n := by\n simpa only [Matrix.rank, Module.finrank_fintype_fun_eq_card, Fintype.card_fin] using hdim\n change B.rank ≤ n - 1\n omega\ntheorem lower_graph_factor (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n (n : ℕ) (G : SimpleGraph (Fin n)) [DecidableRel G.Adj]\n (hradius : spectralRadius ℝ (G.adjMatrix ℝ) = ENNReal.ofReal ((1 - α) / (2 * α))) :\n ∃ B : Matrix (Fin (n - 1)) (Fin n) ℝ,\n B.conjTranspose * B = (1 - α) • 1 - (2 * α) • G.adjMatrix ℝ := by\n classical\n have hαpos : 0 < α := hα.1\n have hlambda : 0 < (1 - α) / (2 * α) :=\n div_pos (sub_pos.mpr hα.2) (by positivity)\n obtain ⟨hpsd, hrank⟩ := lower_graph_shift_psd_rank _ hlambda n G hradius\n have heq : (2 * α) • (((1 - α) / (2 * α)) • (1 : Matrix (Fin n) (Fin n) ℝ) -\n G.adjMatrix ℝ) = (1 - α) • 1 - (2 * α) • G.adjMatrix ℝ := by\n rw [smul_sub, smul_smul, mul_div_cancel₀ _ (show 2 * α ≠ 0 by positivity)]\n obtain ⟨v, hv⟩ := Helpers.positive_semidefinite_gram_realization n (n - 1)\n _ (hpsd.smul (show 0 ≤ 2 * α by positivity))\n ((real_matrix_rank_smul_le _ _).trans hrank)\n let b := EuclideanSpace.basisFun (Fin (n - 1)) ℝ\n refine ⟨Matrix.of (fun i j => b.repr (v j) i), ?_⟩\n exact (Matrix.gram_eq_conjTranspose_mul b v).symm.trans (hv.trans heq)\ntheorem lower_gram_configuration_fintype {ι : Type*} [Fintype ι]\n (α : ℝ) (hα : α ∈ Set.Ioo 0 1) (d : ℕ) (M : Matrix ι ι ℝ)\n (hM : M.PosSemidef) (hrank : M.rank ≤ d) (hdiag : ∀ i, M i i = 1)\n (hoff : ∀ i j, i ≠ j → |M i j| = α) : Fintype.card ι ≤ N α d := by\n classical\n let e : Fin (Fintype.card ι) ≃ ι := (Fintype.equivFin ι).symm\n apply lower_gram_configuration α hα _ d (M.submatrix e e) (hM.submatrix e)\n · simpa only [Matrix.rank_submatrix] using hrank\n · intro i; exact hdiag (e i)\n · intro i j hij; exact hoff (e i) (e j) (e.injective.ne hij)\ntheorem lower_matrix_rank_add_le {ι κ : Type*} [Fintype ι] [Fintype κ]\n (A B : Matrix ι κ ℝ) : (A + B).rank ≤ A.rank + B.rank := by\n classical\n rw [Matrix.rank, Matrix.rank, Matrix.rank, Matrix.mulVecLin_add]\n exact (Submodule.finrank_mono (LinearMap.range_add_le A.mulVecLin B.mulVecLin)).trans\n (Submodule.finrank_add_le_finrank_add_finrank _ _)\ntheorem lower_graph_copies_configuration (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n (n : ℕ) (G : SimpleGraph (Fin n)) [DecidableRel G.Adj]\n (hradius : spectralRadius ℝ (G.adjMatrix ℝ) = ENNReal.ofReal ((1 - α) / (2 * α)))\n (t r : ℕ) : n * t + r ≤ N α ((n - 1) * t + r + 1) := by\n classical\n obtain ⟨B, hB⟩ := lower_graph_factor α hα n G hradius\n let S : Matrix (Fin r) (Fin r) ℝ := Real.sqrt (1 - α) • 1\n have hS : S.conjTranspose * S = (1 - α) • 1 := by\n simp only [S, Matrix.conjTranspose_smul, star_trivial, Matrix.conjTranspose_one,\n Matrix.smul_mul, Matrix.mul_smul, Matrix.one_mul, smul_smul]\n rw [Real.mul_self_sqrt (sub_nonneg.mpr hα.2.le)]\n let C : Matrix ((Fin (n - 1) × Fin t) ⊕ Fin r) ((Fin n × Fin t) ⊕ Fin r) ℝ :=\n Matrix.fromBlocks (Matrix.blockDiagonal (fun _ : Fin t => B)) 0 0 S\n let D : Matrix ((Fin n × Fin t) ⊕ Fin r) ((Fin n × Fin t) ⊕ Fin r) ℝ :=\n Matrix.fromBlocks\n (Matrix.blockDiagonal (fun _ : Fin t => (1 - α) • 1 - (2 * α) • G.adjMatrix ℝ))\n 0 0 ((1 - α) • 1)\n have hC : C.conjTranspose * C = D := by\n dsimp only [C, D]\n rw [Matrix.fromBlocks_conjTranspose, Matrix.fromBlocks_multiply,\n Matrix.blockDiagonal_conjTranspose, ← Matrix.blockDiagonal_mul]\n simp only [Matrix.conjTranspose_zero, Matrix.zero_mul, Matrix.mul_zero,\n add_zero, zero_add, hB, hS]\n let J : Matrix ((Fin n × Fin t) ⊕ Fin r) ((Fin n × Fin t) ⊕ Fin r) ℝ :=\n Matrix.of (fun _ _ => 1)\n let M := C.conjTranspose * C + α • J\n have hM : M.PosSemidef :=\n (Matrix.posSemidef_conjTranspose_mul_self C).add\n (lower_all_ones_posSemidef.smul hα.1.le)\n have hrank : M.rank ≤ (n - 1) * t + r + 1 := by\n have hJ : (α • J).rank ≤ 1 := by\n have heq : α • J = Matrix.vecMulVec (fun _ => α) (fun _ => (1 : ℝ)) := by\n ext i j; simp [J, Matrix.vecMulVec]\n rw [heq]\n exact Matrix.rank_vecMulVec_le _ _\n calc\n M.rank ≤ (C.conjTranspose * C).rank + (α • J).rank := lower_matrix_rank_add_le _ _\n _ ≤ C.rank + 1 := Nat.add_le_add (Matrix.rank_mul_le_right _ _) hJ\n _ ≤ (n - 1) * t + r + 1 := by\n have hc := Matrix.rank_le_card_height C\n simp only [Fintype.card_sum, Fintype.card_prod, Fintype.card_fin] at hc\n omega\n have hdiag : ∀ i, M i i = 1 := by\n intro i\n rw [show M = D + α • J from congrArg (fun X => X + α • J) hC]\n rcases i with ⟨i, a⟩ | i <;>\n simp [D, J, Matrix.blockDiagonal_apply, Matrix.one_apply] <;> ring\n have hoff : ∀ i j, i ≠ j → |M i j| = α := by\n intro i j hij\n rw [show M = D + α • J from congrArg (fun X => X + α • J) hC]\n rcases i with ⟨i, a⟩ | i <;> rcases j with ⟨j, b⟩ | j\n · by_cases hab : a = b\n · have hne : i ≠ j := by intro h; subst j; subst b; exact hij rfl\n by_cases hadj : G.Adj i j\n · simp [D, J, Matrix.blockDiagonal_apply, hab, hne, hadj]\n simpa only [show -(2 * α) + α = -α by ring, abs_neg, abs_of_pos hα.1]\n · simp [D, J, Matrix.blockDiagonal_apply, hab, hne, hadj, abs_of_pos hα.1]\n · simp [D, J, Matrix.blockDiagonal_apply, hab, abs_of_pos hα.1]\n · simp [D, J, abs_of_pos hα.1]\n · simp [D, J, abs_of_pos hα.1]\n · have hne : i ≠ j := by intro h; subst j; exact hij rfl\n simp [D, J, hne, abs_of_pos hα.1]\n have h := lower_gram_configuration_fintype α hα _ M hM hrank hdiag hoff\n simpa only [Fintype.card_sum, Fintype.card_prod, Fintype.card_fin] using h\ntheorem lower_floor_count (q d : ℕ) (hq : 2 ≤ q) (hd : 1 ≤ d) :\n ⌊(q * (d - 1) : ℝ) / (q - 1 : ℝ)⌋₊ =\n q * ((d - 1) / (q - 1)) + (d - 1) % (q - 1) := by\n exact Helpers.lower_floor_count_real_subtraction q d hq hd\ntheorem configuration_lower_bounds :\n ∀ (α : ℝ), α ∈ Set.Ioo 0 1 →\n let k := spectralRadiusOrder ((1 - α) / (2 * α))\n (∀ d : ℕ, d ≤ N α d) ∧\n (k < ⊤ → ∀ᶠ (d : ℕ) in Filter.atTop,\n ⌊(k.toNat * (d - 1) : ℝ) / (k.toNat - 1 : ℝ)⌋₊ ≤ N α d) := by\n classical\n intro α hα\n refine ⟨configuration_dimension_lower_bound α hα, ?_⟩\n intro hfinite\n obtain ⟨q, G, hq, hradius⟩ := spectral_order_attained _ hfinite\n have hαpos : 0 < α := hα.1\n have hlambda : 0 < (1 - α) / (2 * α) :=\n div_pos (sub_pos.mpr hα.2) (by positivity)\n have hqge := lower_graph_order_ge_two _ hlambda q G hradius\n have hqn : (spectralRadiusOrder ((1 - α) / (2 * α))).toNat = q := by\n rw [← hq, ENat.toNat_natCast]\n apply Filter.eventually_atTop.mpr\n refine ⟨1, ?_⟩\n intro d hd\n rw [hqn, lower_floor_count q d hqge hd]\n have hc := lower_graph_copies_configuration α hα q G hradius\n ((d - 1) / (q - 1)) ((d - 1) % (q - 1))\n have hdim : (q - 1) * ((d - 1) / (q - 1)) + (d - 1) % (q - 1) + 1 = d := by\n rw [Nat.div_add_mod]\n omega\n rwa [hdim] at hc\ntheorem configuration_upper_bounds :\n ∀ (α : ℝ), α ∈ Set.Ioo 0 1 →\n let k := spectralRadiusOrder ((1 - α) / (2 * α))\n (k < ⊤ → ∀ᶠ (d : ℕ) in Filter.atTop,\n N α d ≤ ⌊(k.toNat * (d - 1) : ℝ) / (k.toNat - 1 : ℝ)⌋₊) ∧\n (k = ⊤ → ∀ ε : ℝ, 0 < ε → ∀ᶠ (d : ℕ) in Filter.atTop,\n (N α d : ℝ) ≤ (1 + ε) * (d : ℝ)) := by\n classical\n intro α hα\n have hlam : 0 < (1 - α) / (2 * α) :=\n div_pos (sub_pos.mpr hα.2) (mul_pos (by norm_num) hα.1)\n constructor\n · intro hfinite\n obtain ⟨q, H, hqorder, hradius⟩ := spectral_order_attained _ hfinite\n have hqge : 2 ≤ q := lower_graph_order_ge_two _ hlam q H hradius\n have hqpos : (0 : ℝ) < q := by exact_mod_cast (show 0 < q by omega)\n have hqnat : (spectralRadiusOrder ((1 - α) / (2 * α))).toNat = q := by\n rw [← hqorder, ENat.toNat_natCast]\n obtain ⟨M, hM⟩ := upper_unit_vector_bound_cases α hα\n (1 / (2 * (q : ℝ))) (by positivity)\n apply Filter.eventually_atTop.mpr\n refine ⟨max q (2 * q * (M + 2)), ?_⟩\n intro d hd\n have hdq : q ≤ d := (le_max_left _ _).trans hd\n have hdM : 2 * q * (M + 2) ≤ d := (le_max_right _ _).trans hd\n rw [hqnat]\n apply upper_N_le_of_unit_bound\n intro n v hnorm hangle\n rcases hM d n v hnorm hangle with ⟨G, hc⟩ | hb\n · let t := ({C | upperComponentRadius G C = ENNReal.ofReal ((1 - α) / (2 * α))} :\n Set G.ConnectedComponent).ncard\n have ht : q * t ≤ n := upper_critical_count_mul_le n G _ q hqorder.le\n exact upper_rank_count_floor n d q t (if t = 0 then n else n + 1 - t)\n hqge hdq ht rfl hc\n · exact upper_absorb_finite n d q M hqge hdM hb\n · intro htop ε hε\n have hδ : 0 < ε / (2 * (1 + ε)) := div_pos hε (by positivity)\n obtain ⟨M, hM⟩ := upper_unit_vector_bound_cases α hα _ hδ\n obtain ⟨L, hL⟩ := exists_nat_gt (2 * ((M : ℝ) + 1) / ε)\n apply Filter.eventually_atTop.mpr\n refine ⟨L, ?_⟩\n intro d hd\n have hdR : 2 * ((M : ℝ) + 1) / ε ≤ (d : ℝ) := by\n have hcast : (L : ℝ) ≤ d := by exact_mod_cast hd\n exact hL.le.trans hcast\n have hbound : N α d ≤ ⌊(1 + ε) * (d : ℝ)⌋₊ := by\n apply upper_N_le_of_unit_bound\n intro n v hnorm hangle\n apply Nat.le_floor\n rcases hM d n v hnorm hangle with ⟨G, hc⟩ | hb\n · rw [upper_no_critical_of_infinite n G _ htop, if_pos rfl] at hc\n have hnR : (n : ℝ) ≤ d := by exact_mod_cast hc\n have hprod : 0 ≤ ε * (d : ℝ) := mul_nonneg hε.le (Nat.cast_nonneg _)\n nlinarith\n · exact upper_absorb_infinite n d M ε hε hdR hb\n exact (show (N α d : ℝ) ≤ (⌊(1 + ε) * (d : ℝ)⌋₊ : ℝ) by\n exact_mod_cast hbound).trans (Nat.floor_le (by positivity))\ntheorem theorem_1_2 (α : ℝ) (hα : α ∈ Set.Ioo 0 1) :\n let k := spectralRadiusOrder ((1 - α) / (2 * α))\n (k < ⊤ → ∀ᶠ d in atTop, N α d = ⌊(k.toNat * (d - 1) : ℝ) / (k.toNat - 1 : ℝ)⌋₊) ∧\n (k = ⊤ → ∃ e : ℕ → ℝ, e =o[atTop] (Nat.cast : ℕ → ℝ) ∧ ∀ d, N α d = d + e d) := by\n have hlower := configuration_lower_bounds α hα\n have hupper := configuration_upper_bounds α hα\n dsimp only\n constructor\n · intro hk\n filter_upwards [hlower.2 hk, hupper.1 hk] with d hlow hupp\n exact Nat.le_antisymm hupp hlow\n · intro hk\n exact Helpers.error_term_of_bounds (N α) hlower.1 (hupper.2 hk)\ntheorem sign_reduction_inner_weighted_sum\n {ι H : Type*} [DecidableEq ι] [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (s : Finset ι) (v : ι → H) (a : ℝ) (c : ι → ℝ)\n (hdiag : ∀ i ∈ s, ⟪v i, v i⟫ = 1)\n (hoff : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → ⟪v i, v j⟫ = a) :\n ⟪∑ i ∈ s, c i • v i, ∑ i ∈ s, c i • v i⟫ =\n (1 - a) * (∑ i ∈ s, c i ^ 2) + a * (∑ i ∈ s, c i) ^ 2 := by\n have hrow : ∀ i ∈ s, ⟪v i, ∑ j ∈ s, c j • v j⟫ =\n (1 - a) * c i + a * ∑ j ∈ s, c j := by\n intro i hi\n rw [inner_sum]\n simp_rw [real_inner_smul_right]\n calc\n ∑ j ∈ s, c j * ⟪v i, v j⟫ =\n ∑ j ∈ s, (a * c j + if j = i then (1 - a) * c j else 0) := by\n apply Finset.sum_congr rfl\n intro j hj\n by_cases hij : j = i\n · subst j\n rw [hdiag i hi, if_pos rfl]\n ring\n · rw [hoff i hi j hj (Ne.symm hij), if_neg hij]\n ring\n _ = (1 - a) * c i + a * ∑ j ∈ s, c j := by\n rw [Finset.sum_add_distrib, Finset.sum_ite_eq', if_pos hi,\n ← Finset.mul_sum]\n ring\n rw [sum_inner]\n simp_rw [real_inner_smul_left]\n rw [Finset.sum_congr rfl (fun i hi => congrArg (fun x : ℝ => c i * x) (hrow i hi))]\n simp_rw [mul_add]\n rw [Finset.sum_add_distrib]\n have hfirst : (∑ i ∈ s, c i * ((1 - a) * c i)) =\n (1 - a) * ∑ i ∈ s, c i ^ 2 := by\n rw [Finset.mul_sum]\n apply Finset.sum_congr rfl\n intro i hi\n ring\n have hsecond : (∑ i ∈ s, c i * (a * ∑ j ∈ s, c j)) =\n a * (∑ i ∈ s, c i) ^ 2 := by\n rw [← Finset.sum_mul]\n ring\n rw [hfirst, hsecond]\ntheorem sign_reduction_negative_clique_bound\n {ι H : Type*} [DecidableEq ι] [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (s : Finset ι) (v : ι → H) (α : ℝ) (hα : 0 < α)\n (hdiag : ∀ i ∈ s, ⟪v i, v i⟫ = 1)\n (hoff : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → ⟪v i, v j⟫ = -α) :\n (s.card : ℝ) ≤ 1 + 1 / α := by\n have hs := sign_reduction_inner_weighted_sum s v (-α) (fun _ => 1) hdiag hoff\n simp only [one_smul, one_pow, Finset.sum_const, nsmul_eq_mul, mul_one] at hs\n have hn := real_inner_self_nonneg (x := ∑ i ∈ s, v i)\n have hc : 0 ≤ (s.card : ℝ) := Nat.cast_nonneg _\n by_cases hz : s.card = 0\n · rw [hz, Nat.cast_zero]\n positivity\n · have hcpos : 0 < (s.card : ℝ) := Nat.cast_pos.mpr (Nat.pos_of_ne_zero hz)\n have hb : α * (s.card : ℝ) ≤ 1 + α := by\n nlinarith [hs]\n calc\n (s.card : ℝ) ≤ (1 + α) / α := (le_div_iff₀ hα).mpr (by\n simpa only [mul_comm] using hb)\n _ = 1 + 1 / α := by field_simp; ring\ntheorem sign_reduction_residual_class_bound\n {ι H : Type*} [DecidableEq ι] [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (s : Finset ι) (v : ι → H) (z : H) (α a : ℝ) (hα : α ≤ 1) (ha : α < a)\n (hdiag : ∀ i ∈ s, ⟪v i, v i⟫ = 1)\n (hoff : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → ⟪v i, v j⟫ ≤ α)\n (hvz : ∀ i ∈ s, ⟪v i, z⟫ = a) (hzz : ⟪z, z⟫ = a) :\n (s.card : ℝ) ≤ (1 - α) / (a - α) := by\n have hsum : ⟪∑ i ∈ s, (v i - z), ∑ i ∈ s, (v i - z)⟫ ≤\n (1 - α) * (s.card : ℝ) - (a - α) * (s.card : ℝ) ^ 2 := by\n rw [sum_inner]\n simp_rw [inner_sum]\n calc\n ∑ i ∈ s, ∑ j ∈ s, ⟪v i - z, v j - z⟫ ≤\n ∑ i ∈ s, ∑ j ∈ s, ((α - a) + if j = i then 1 - α else 0) := by\n apply Finset.sum_le_sum\n intro i hi\n apply Finset.sum_le_sum\n intro j hj\n rw [inner_sub_left, inner_sub_right, inner_sub_right,\n hvz i hi, ← real_inner_comm z (v j), hvz j hj, hzz]\n by_cases hij : j = i\n · subst j\n rw [hdiag i hi, if_pos rfl]\n linarith\n · rw [if_neg hij]\n linarith [hoff i hi j hj (Ne.symm hij)]\n _ = (1 - α) * (s.card : ℝ) - (a - α) * (s.card : ℝ) ^ 2 := by\n simp only [Finset.sum_add_distrib, Finset.sum_const, nsmul_eq_mul,\n Finset.sum_ite_eq']\n have he : ∀ i ∈ s, (if i ∈ s then 1 - α else 0) = 1 - α := by\n intro i hi\n rw [if_pos hi]\n rw [Finset.sum_congr rfl he]\n simp only [Finset.sum_const, nsmul_eq_mul]\n ring\n have hn := real_inner_self_nonneg (x := ∑ i ∈ s, (v i - z))\n by_cases hz : s.card = 0\n · rw [hz, Nat.cast_zero]\n apply div_nonneg ?_ (sub_pos.mpr ha).le\n exact sub_nonneg.mpr hα\n · have hcpos : 0 < (s.card : ℝ) := Nat.cast_pos.mpr (Nat.pos_of_ne_zero hz)\n apply (le_div_iff₀ (sub_pos.mpr ha)).mpr\n nlinarith\ntheorem sign_reduction_mixed_sign_bound\n {ι H : Type*} [DecidableEq ι] [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (p q : Finset ι) (v : ι → H) (w : H) (α : ℝ)\n (hdis : Disjoint p q) (hp : p.Nonempty) (hq : q.Nonempty)\n (hw : ⟪w, w⟫ = 1)\n (hdiag : ∀ i ∈ p ∪ q, ⟪v i, v i⟫ = 1)\n (hoff : ∀ i ∈ p ∪ q, ∀ j ∈ p ∪ q, i ≠ j → ⟪v i, v j⟫ = α)\n (hneg : ∀ i ∈ p, ⟪w, v i⟫ = -α)\n (hpos : ∀ i ∈ q, ⟪w, v i⟫ = α) :\n 4 * α ^ 2 * (p.card : ℝ) * (q.card : ℝ) ≤\n (1 - α) * ((p.card : ℝ) + (q.card : ℝ)) := by\n let c : ι → ℝ := fun i => if i ∈ p then (q.card : ℝ) else -(p.card : ℝ)\n have hc_p : ∀ i ∈ p, c i = (q.card : ℝ) := by\n intro i hi\n simp only [c, if_pos hi]\n have hc_q : ∀ i ∈ q, c i = -(p.card : ℝ) := by\n intro i hi\n have hn : i ∉ p := fun h => Finset.disjoint_left.mp hdis h hi\n simp only [c, if_neg hn]\n have hsum : (∑ i ∈ p ∪ q, c i) = 0 := by\n rw [Finset.sum_union hdis, Finset.sum_congr rfl hc_p, Finset.sum_congr rfl hc_q]\n simp only [Finset.sum_const, nsmul_eq_mul]\n ring\n have hsq : (∑ i ∈ p ∪ q, c i ^ 2) =\n (p.card : ℝ) * (q.card : ℝ) * ((p.card : ℝ) + (q.card : ℝ)) := by\n rw [Finset.sum_union hdis,\n Finset.sum_congr rfl (fun i hi => congrArg (fun x : ℝ => x ^ 2) (hc_p i hi)),\n Finset.sum_congr rfl (fun i hi => congrArg (fun x : ℝ => x ^ 2) (hc_q i hi))]\n simp only [Finset.sum_const, nsmul_eq_mul]\n ring\n have hiw : ⟪w, ∑ i ∈ p ∪ q, c i • v i⟫ =\n -2 * α * (p.card : ℝ) * (q.card : ℝ) := by\n rw [inner_sum]\n simp_rw [real_inner_smul_right]\n rw [Finset.sum_union hdis]\n have hp' : (∑ i ∈ p, c i * ⟪w, v i⟫) = ∑ i ∈ p, (q.card : ℝ) * -α := by\n apply Finset.sum_congr rfl\n intro i hi\n rw [hc_p i hi, hneg i hi]\n have hq' : (∑ i ∈ q, c i * ⟪w, v i⟫) = ∑ i ∈ q, -(p.card : ℝ) * α := by\n apply Finset.sum_congr rfl\n intro i hi\n rw [hc_q i hi, hpos i hi]\n rw [hp', hq']\n simp only [Finset.sum_const, nsmul_eq_mul]\n ring\n have hcs := real_inner_mul_inner_self_le w (∑ i ∈ p ∪ q, c i • v i)\n rw [hw, sign_reduction_inner_weighted_sum (p ∪ q) v α c hdiag hoff,\n hiw, hsum, hsq] at hcs\n have hpq : 0 < (p.card : ℝ) * (q.card : ℝ) :=\n mul_pos (Nat.cast_pos.mpr (Finset.card_pos.mpr hp))\n (Nat.cast_pos.mpr (Finset.card_pos.mpr hq))\n by_contra hnot\n have hgt := mul_pos hpq (sub_pos.mpr (lt_of_not_ge hnot))\n nlinarith only [hcs, hgt]\ntheorem sign_reduction_seed_projection\n {ι H : Type*} [DecidableEq ι] [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (s p : Finset ι) (v : ι → H) (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n (hp : p ⊆ s) (hs : s.Nonempty)\n (hdiag : ∀ i ∈ s, ⟪v i, v i⟫ = 1)\n (hoff : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → ⟪v i, v j⟫ = α) :\n let t : ℝ := s.card\n let k : ℝ := p.card\n let b : ι → ℝ := fun i => if i ∈ p then -1 else 1\n let c : ι → ℝ := fun i => α / (1 - α) *\n (b i - α * (t - 2 * k) / (1 + (t - 1) * α))\n let z : H := ∑ i ∈ s, c i • v i\n let a : ℝ := α ^ 2 / (1 - α) *\n (t - α * (t - 2 * k) ^ 2 / (1 + (t - 1) * α))\n ⟪z, z⟫ = a ∧\n (∀ w : H, (∀ i ∈ s, ⟪w, v i⟫ = α * b i) → ⟪w, z⟫ = a) ∧\n a - α = α * (4 * α ^ 2 * k * (t - k) - (1 - α) ^ 2) /\n ((1 - α) * (1 + (t - 1) * α)) := by\n dsimp only\n let t : ℝ := s.card\n let k : ℝ := p.card\n let b : ι → ℝ := fun i => if i ∈ p then -1 else 1\n let L : ℝ := 1 + (t - 1) * α\n have h0 : 1 - α ≠ 0 := ne_of_gt (sub_pos.mpr hα.2)\n have ht : 1 ≤ t := by\n change (1 : ℝ) ≤ (s.card : ℝ)\n have ht_nat : 1 ≤ s.card := Finset.card_pos.mpr hs\n exact_mod_cast ht_nat\n have hL : L ≠ 0 := by\n dsimp [L]\n have hprod : 0 ≤ (t - 1) * α := mul_nonneg (sub_nonneg.mpr ht) hα.1.le\n linarith\n have hbsum : (∑ i ∈ s, b i) = t - 2 * k := by\n have hsplit : s = p ∪ (s \\ p) := (Finset.union_sdiff_of_subset hp).symm\n have hdis : Disjoint p (s \\ p) := by\n apply Finset.disjoint_left.mpr\n intro i hi hj\n exact (Finset.mem_sdiff.mp hj).2 hi\n rw [hsplit, Finset.sum_union hdis]\n have hp' : (∑ i ∈ p, b i) = -(p.card : ℝ) := by\n simp only [b]\n rw [Finset.sum_congr rfl (fun i hi => if_pos hi)]\n simp\n have hq' : (∑ i ∈ s \\ p, b i) = ((s \\ p).card : ℝ) := by\n rw [Finset.sum_congr rfl (fun i hi => if_neg (Finset.mem_sdiff.mp hi).2)]\n simp\n rw [hp', hq', Finset.card_sdiff_of_subset hp, Nat.cast_sub (Finset.card_le_card hp)]\n dsimp [t, k]\n ring\n have hbsq : (∑ i ∈ s, b i ^ 2) = t := by\n have hb : ∀ i ∈ s, b i ^ 2 = 1 := by\n intro i hi\n dsimp [b]\n split_ifs <;> norm_num\n rw [Finset.sum_congr rfl hb]\n simp [t]\n let c : ι → ℝ := fun i => α / (1 - α) * (b i - α * (t - 2 * k) / L)\n have hcsum : (∑ i ∈ s, c i) = α * (t - 2 * k) / L := by\n simp only [c, ← Finset.mul_sum, Finset.sum_sub_distrib,\n Finset.sum_const, nsmul_eq_mul, hbsum]\n change α / (1 - α) * ((t - 2 * k) - t * (α * (t - 2 * k) / L)) = _\n field_simp [h0, hL]\n dsimp [L]\n ring\n have hcsq : (∑ i ∈ s, c i ^ 2) = (α / (1 - α)) ^ 2 *\n (t - 2 * (α * (t - 2 * k) / L) * (t - 2 * k) +\n t * (α * (t - 2 * k) / L) ^ 2) := by\n have hc : ∀ i ∈ s, c i ^ 2 = (α / (1 - α)) ^ 2 *\n (b i ^ 2 - 2 * (α * (t - 2 * k) / L) * b i +\n (α * (t - 2 * k) / L) ^ 2) := by\n intro i hi\n dsimp [c]\n ring\n rw [Finset.sum_congr rfl hc, ← Finset.mul_sum]\n simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib, ← Finset.mul_sum,\n Finset.sum_const, nsmul_eq_mul, hbsq, hbsum]\n rfl\n change ⟪∑ i ∈ s, c i • v i, ∑ i ∈ s, c i • v i⟫ =\n α ^ 2 / (1 - α) * (t - α * (t - 2 * k) ^ 2 / L) ∧\n (∀ w : H, (∀ i ∈ s, ⟪w, v i⟫ = α * b i) →\n ⟪w, ∑ i ∈ s, c i • v i⟫ =\n α ^ 2 / (1 - α) * (t - α * (t - 2 * k) ^ 2 / L)) ∧\n α ^ 2 / (1 - α) * (t - α * (t - 2 * k) ^ 2 / L) - α =\n α * (4 * α ^ 2 * k * (t - k) - (1 - α) ^ 2) / ((1 - α) * L)\n refine ⟨?_, ?_, ?_⟩\n · rw [sign_reduction_inner_weighted_sum s v α c hdiag hoff, hcsum, hcsq]\n field_simp [h0, hL]\n dsimp [L]\n ring\n · intro w hw\n rw [inner_sum]\n simp_rw [real_inner_smul_right]\n rw [Finset.sum_congr rfl (fun i hi => congrArg (fun x : ℝ => c i * x) (hw i hi))]\n have hc : ∀ i ∈ s, c i * (α * b i) =\n α ^ 2 / (1 - α) * (b i ^ 2 - (α * (t - 2 * k) / L) * b i) := by\n intro i hi\n dsimp [c]\n ring\n rw [Finset.sum_congr rfl hc, ← Finset.mul_sum]\n simp only [Finset.sum_sub_distrib, ← Finset.mul_sum, hbsq, hbsum]\n ring\n · field_simp [h0, hL]\n dsimp [L]\n ring\ntheorem sign_reduction_finite_ramsey (p q : ℕ) :\n ∃ N : ℕ, ∀ {ι : Type*} [DecidableEq ι] (s : Finset ι) (R : ι → ι → Prop),\n Symmetric R → N ≤ s.card →\n (∃ u : Finset ι, u ⊆ s ∧ u.card = p ∧\n ∀ i ∈ u, ∀ j ∈ u, i ≠ j → R i j) ∨\n (∃ u : Finset ι, u ⊆ s ∧ u.card = q ∧\n ∀ i ∈ u, ∀ j ∈ u, i ≠ j → ¬R i j) := by\n classical\n induction p generalizing q with\n | zero =>\n refine ⟨0, ?_⟩\n intro ι _ s R hR hcard\n exact Or.inl ⟨∅, Finset.empty_subset s, rfl, by simp⟩\n | succ p ihp =>\n induction q with\n | zero =>\n refine ⟨0, ?_⟩\n intro ι _ s R hR hcard\n exact Or.inr ⟨∅, Finset.empty_subset s, rfl, by simp⟩\n | succ q ihq =>\n obtain ⟨N₁, hN₁⟩ := ihp (q + 1)\n obtain ⟨N₂, hN₂⟩ := ihq\n refine ⟨N₁ + N₂ + 1, ?_⟩\n intro ι _ s R hR hcard\n have hs : s.Nonempty := Finset.card_pos.mp (by omega)\n obtain ⟨x, hx⟩ := hs\n let a := (s.erase x).filter (R x)\n let b := (s.erase x).filter (fun i => ¬R x i)\n have hsplit : a.card + b.card = s.card - 1 := by\n dsimp [a, b]\n rw [Finset.card_filter_add_card_filter_not, Finset.card_erase_of_mem hx]\n have hsuba : a ⊆ s := fun i hi =>\n (Finset.mem_erase.mp (Finset.mem_filter.mp hi).1).2\n have hsubb : b ⊆ s := fun i hi =>\n (Finset.mem_erase.mp (Finset.mem_filter.mp hi).1).2\n by_cases ha : N₁ ≤ a.card\n · rcases hN₁ a R hR ha with ⟨u, hua, hu, hRu⟩ | ⟨u, hua, hu, hRu⟩\n · left\n have hxu : x ∉ u := by\n intro h\n exact (Finset.mem_erase.mp (Finset.mem_filter.mp (hua h)).1).1 rfl\n refine ⟨insert x u, Finset.insert_subset hx (Finset.Subset.trans hua hsuba),\n by rw [Finset.card_insert_of_notMem hxu, hu], ?_⟩\n intro i hi j hj hij\n rcases Finset.mem_insert.mp hi with rfl | hiu\n · rcases Finset.mem_insert.mp hj with rfl | hju\n · exact False.elim (hij rfl)\n · exact (Finset.mem_filter.mp (hua hju)).2\n · rcases Finset.mem_insert.mp hj with rfl | hju\n · exact hR ((Finset.mem_filter.mp (hua hiu)).2)\n · exact hRu i hiu j hju hij\n · exact Or.inr ⟨u, Finset.Subset.trans hua hsuba, hu, hRu⟩\n · have hb : N₂ ≤ b.card := by omega\n rcases hN₂ b R hR hb with ⟨u, hub, hu, hRu⟩ | ⟨u, hub, hu, hRu⟩\n · exact Or.inl ⟨u, Finset.Subset.trans hub hsubb, hu, hRu⟩\n · right\n have hxu : x ∉ u := by\n intro h\n exact (Finset.mem_erase.mp (Finset.mem_filter.mp (hub h)).1).1 rfl\n refine ⟨insert x u, Finset.insert_subset hx (Finset.Subset.trans hub hsubb),\n by rw [Finset.card_insert_of_notMem hxu, hu], ?_⟩\n intro i hi j hj hij\n rcases Finset.mem_insert.mp hi with rfl | hiu\n · rcases Finset.mem_insert.mp hj with rfl | hju\n · exact False.elim (hij rfl)\n · exact (Finset.mem_filter.mp (hub hju)).2\n · rcases Finset.mem_insert.mp hj with rfl | hju\n · intro h\n exact (Finset.mem_filter.mp (hub hiu)).2 (hR h)\n · exact hRu i hiu j hju hij\ntheorem sign_reduction_large_groups_impossible (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n (D : ℕ) (hD : 1 - α < 2 * α ^ 2 * (D : ℝ))\n (p q : ℕ) (hp : D ≤ p) (hq : D ≤ q) (hDp : 0 < D)\n (hbound : 4 * α ^ 2 * (p : ℝ) * (q : ℝ) ≤\n (1 - α) * ((p : ℝ) + (q : ℝ))) : False := by\n have hp' : (D : ℝ) ≤ (p : ℝ) := Nat.cast_le.mpr hp\n have hq' : (D : ℝ) ≤ (q : ℝ) := Nat.cast_le.mpr hq\n have hpp : 0 < (p : ℝ) := Nat.cast_pos.mpr (lt_of_lt_of_le hDp hp)\n have hqp : 0 < (q : ℝ) := Nat.cast_pos.mpr (lt_of_lt_of_le hDp hq)\n have h1 := mul_lt_mul_of_pos_right hD hpp\n have h2 := mul_lt_mul_of_pos_right hD hqp\n have h3 := mul_le_mul_of_nonneg_left hq' (show 0 ≤ 2 * α ^ 2 * (p : ℝ) by positivity)\n have h4 := mul_le_mul_of_nonneg_left hp' (show 0 ≤ 2 * α ^ 2 * (q : ℝ) by positivity)\n nlinarith only [h1, h2, h3, h4, hbound]\ntheorem sign_reduction_orient_to_seed\n {ι H : Type*} [DecidableEq ι] [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (s : Finset ι) (v : ι → H) (w : H) (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n (D : ℕ) (hDp : 0 < D) (hD : 1 - α < 2 * α ^ 2 * (D : ℝ))\n (hw : ⟪w, w⟫ = 1)\n (hdiag : ∀ i ∈ s, ⟪v i, v i⟫ = 1)\n (hoff : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → ⟪v i, v j⟫ = α)\n (hwv : ∀ i ∈ s, |⟪w, v i⟫| = α) :\n ∃ σ : ℝ, (σ = 1 ∨ σ = -1) ∧ (s.filter (fun i => ⟪σ • w, v i⟫ < 0)).card < D := by\n classical\n let p := s.filter (fun i => ⟪w, v i⟫ < 0)\n let q := s.filter (fun i => ¬⟪w, v i⟫ < 0)\n have hdis : Disjoint p q := by\n apply Finset.disjoint_left.mpr\n intro i hi hj\n exact (Finset.mem_filter.mp hj).2 (Finset.mem_filter.mp hi).2\n have hsplit : p ∪ q = s := by\n ext i\n by_cases h : ⟪w, v i⟫ < 0\n · simp [p, q, h]\n · have h' : 0 ≤ ⟪w, v i⟫ := le_of_not_gt h\n simp [p, q, h, h']\n have hneg : ∀ i ∈ p, ⟪w, v i⟫ = -α := by\n intro i hi\n have h := hwv i (Finset.mem_filter.mp hi).1\n rw [abs_of_neg (Finset.mem_filter.mp hi).2] at h\n linarith\n have hpos : ∀ i ∈ q, ⟪w, v i⟫ = α := by\n intro i hi\n have h := hwv i (Finset.mem_filter.mp hi).1\n rw [abs_of_nonneg (le_of_not_gt (Finset.mem_filter.mp hi).2)] at h\n exact h\n by_cases hp : p.card < D\n · refine ⟨1, Or.inl rfl, ?_⟩\n simpa only [one_smul] using hp\n · have hq : q.card < D := by\n by_contra hq\n have hpp : p.Nonempty := Finset.card_pos.mp (by omega)\n have hqp : q.Nonempty := Finset.card_pos.mp (by omega)\n have hb := sign_reduction_mixed_sign_bound p q v w α hdis hpp hqp hw\n (by simpa only [hsplit] using hdiag) (by simpa only [hsplit] using hoff) hneg hpos\n exact sign_reduction_large_groups_impossible α hα D hD p.card q.card\n (by omega) (by omega) hDp hb\n refine ⟨-1, Or.inr rfl, ?_⟩\n have he : s.filter (fun i => ⟪(-1 : ℝ) • w, v i⟫ < 0) = q := by\n ext i\n simp only [Finset.mem_filter, real_inner_smul_left, neg_mul, one_mul, q]\n constructor\n · rintro ⟨hi, h⟩\n exact ⟨hi, by linarith⟩\n · rintro ⟨hi, h⟩\n have hh := hpos i (Finset.mem_filter.mpr ⟨hi, h⟩)\n exact ⟨hi, by linarith [hα.1]⟩\n rw [he]\n exact hq\ntheorem sign_reduction_seed_pattern_class\n {ι H : Type*} [DecidableEq ι] [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (s p r : Finset ι) (v : ι → H) (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n (D : ℕ) (hp : p ⊆ s) (hpn : p.Nonempty) (hpD : p.card ≤ D)\n (hsD : D < s.card)\n (hdiag : ∀ i ∈ s, ⟪v i, v i⟫ = 1)\n (hoff : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → ⟪v i, v j⟫ = α)\n (hrdiag : ∀ i ∈ r, ⟪v i, v i⟫ = 1)\n (hroff : ∀ i ∈ r, ∀ j ∈ r, i ≠ j → ⟪v i, v j⟫ ≤ α)\n (hrangle : ∀ i ∈ r, ∀ j ∈ s, |⟪v i, v j⟫| = α)\n (hpattern : ∀ i ∈ r, s.filter (fun j => ⟪v i, v j⟫ < 0) = p) :\n let δ := α * (4 * α ^ 2 * ((s.card : ℝ) - (D : ℝ)) - (1 - α) ^ 2) /\n ((1 - α) * (1 + ((s.card : ℝ) - 1) * α))\n 0 < δ → (r.card : ℝ) ≤ (1 - α) / δ := by\n intro δ hδ\n let t : ℝ := s.card\n let k : ℝ := p.card\n let b : ι → ℝ := fun j => if j ∈ p then -1 else 1\n let c : ι → ℝ := fun j => α / (1 - α) *\n (b j - α * (t - 2 * k) / (1 + (t - 1) * α))\n let z : H := ∑ j ∈ s, c j • v j\n let a : ℝ := α ^ 2 / (1 - α) *\n (t - α * (t - 2 * k) ^ 2 / (1 + (t - 1) * α))\n have hs : s.Nonempty := Finset.card_pos.mp (by omega)\n have hproj := sign_reduction_seed_projection s p v α hα hp hs hdiag hoff\n change ⟪z, z⟫ = a ∧\n (∀ w : H, (∀ j ∈ s, ⟪w, v j⟫ = α * b j) → ⟪w, z⟫ = a) ∧\n a - α = α * (4 * α ^ 2 * k * (t - k) - (1 - α) ^ 2) /\n ((1 - α) * (1 + (t - 1) * α)) at hproj\n have hden : 0 < (1 - α) * (1 + (t - 1) * α) := by\n have ht : 1 ≤ t := by\n change (1 : ℝ) ≤ (s.card : ℝ)\n have ht_nat : 1 ≤ s.card := Finset.card_pos.mpr hs\n exact_mod_cast ht_nat\n apply mul_pos (sub_pos.mpr hα.2)\n have hh := mul_nonneg (sub_nonneg.mpr ht) hα.1.le\n linarith\n have hδa : δ ≤ a - α := by\n rw [hproj.2.2]\n change α * (4 * α ^ 2 * (t - (D : ℝ)) - (1 - α) ^ 2) / _ ≤ _\n apply (div_le_div_iff_of_pos_right hden).mpr\n have hk1 : 1 ≤ k := by\n change (1 : ℝ) ≤ (p.card : ℝ)\n have hk_nat : 1 ≤ p.card := Finset.card_pos.mpr hpn\n exact_mod_cast hk_nat\n have hkD : k ≤ (D : ℝ) := Nat.cast_le.mpr hpD\n have hDt : (D : ℝ) < t := Nat.cast_lt.mpr hsD\n have htk : 0 ≤ t - k := by linarith\n have hkp := mul_le_mul_of_nonneg_right hk1 htk\n have hh : t - (D : ℝ) ≤ k * (t - k) := by nlinarith only [hkp, hkD]\n have hm := mul_le_mul_of_nonneg_left hh (show 0 ≤ 4 * α ^ 2 by positivity)\n have hm' := mul_le_mul_of_nonneg_left hm hα.1.le\n nlinarith only [hm']\n have ha : α < a := by linarith only [hδa, hδ]\n have hvz : ∀ i ∈ r, ⟪v i, z⟫ = a := by\n intro i hi\n apply hproj.2.1 (v i)\n intro j hj\n dsimp [b]\n by_cases hjp : j ∈ p\n · rw [if_pos hjp]\n have hneg : ⟪v i, v j⟫ < 0 := by\n rw [← hpattern i hi] at hjp\n exact (Finset.mem_filter.mp hjp).2\n have hh := hrangle i hi j hj\n rw [abs_of_neg hneg] at hh\n linarith\n · rw [if_neg hjp]\n have hnon : 0 ≤ ⟪v i, v j⟫ := by\n by_contra h\n apply hjp\n rw [← hpattern i hi]\n exact Finset.mem_filter.mpr ⟨hj, by linarith⟩\n have hh := hrangle i hi j hj\n rw [abs_of_nonneg hnon] at hh\n linarith\n have hr := sign_reduction_residual_class_bound r v z α a hα.2.le ha\n hrdiag hroff hvz hproj.1\n apply (le_div_iff₀ hδ).mpr\n have hrr : 0 ≤ (r.card : ℝ) := Nat.cast_nonneg _\n have hh := mul_le_mul_of_nonneg_left hδa hrr\n have hb := (le_div_iff₀ (sub_pos.mpr ha)).mp hr\n linarith only [hh, hb]\ntheorem sign_reduction_seeded_degree\n {ι H : Type*} [Fintype ι] [DecidableEq ι]\n [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (v : ι → H) (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n (D C R B : ℕ) (hDp : 0 < D) (hD : 1 - α < 2 * α ^ 2 * (D : ℝ))\n (hC : 1 + 1 / α < (C : ℝ))\n (hR : ∀ u : Finset ι, R ≤ u.card →\n (∃ p : Finset ι, p ⊆ u ∧ p.card = D ∧\n ∀ i ∈ p, ∀ j ∈ p, i ≠ j → ⟪v i, v j⟫ = α) ∨\n (∃ p : Finset ι, p ⊆ u ∧ p.card = C ∧\n ∀ i ∈ p, ∀ j ∈ p, i ≠ j → ⟪v i, v j⟫ ≠ α))\n (s : Finset ι) (hsD : 2 * D < s.card)\n (hdiag : ∀ i, ⟪v i, v i⟫ = 1)\n (hangle : ∀ i j, i ≠ j → |⟪v i, v j⟫| = α)\n (hseed : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → ⟪v i, v j⟫ = α)\n (hsmall : ∀ i, (s.filter (fun j => ⟪v i, v j⟫ < 0)).card < D)\n (hδ : 0 < α * (4 * α ^ 2 * ((s.card : ℝ) - (D : ℝ)) - (1 - α) ^ 2) /\n ((1 - α) * (1 + ((s.card : ℝ) - 1) * α)))\n (hB : (1 - α) /\n (α * (4 * α ^ 2 * ((s.card : ℝ) - (D : ℝ)) - (1 - α) ^ 2) /\n ((1 - α) * (1 + ((s.card : ℝ) - 1) * α))) ≤ (B : ℝ)) :\n ∀ i, (Finset.univ.filter (fun j => ⟪v i, v j⟫ < 0)).card ≤\n s.card + 2 ^ s.card * B + R := by\n classical\n let f : ι → Finset ι := fun i => s.filter (fun j => ⟪v i, v j⟫ < 0)\n let X : Finset ι := Finset.univ.filter (fun i => i ∉ s ∧ (f i).Nonempty)\n let U : Finset ι := Finset.univ.filter (fun i => i ∉ s ∧ f i = ∅)\n have hXp : X.card ≤ 2 ^ s.card * B := by\n have hf : Set.MapsTo f (X : Set ι) (s.powerset : Set (Finset ι)) := by\n intro i hi\n exact Finset.mem_powerset.mpr (Finset.filter_subset _ _)\n rw [Finset.card_eq_sum_card_fiberwise hf]\n have hclass : ∀ p ∈ s.powerset, (X.filter (fun i => f i = p)).card ≤ B := by\n intro p hp\n let r := X.filter (fun i => f i = p)\n by_cases hr : r.Nonempty\n · obtain ⟨i, hi⟩ := hr\n have hiX := Finset.mem_filter.mp hi\n have hiXX := (Finset.mem_filter.mp hiX.1).2\n have hpnon : p.Nonempty := hiX.2 ▸ hiXX.2\n have hpD : p.card ≤ D := by\n have hh := hsmall i\n change (f i).card < D at hh\n rw [hiX.2] at hh\n omega\n have hrr := sign_reduction_seed_pattern_class s p r v α hα D\n (Finset.mem_powerset.mp hp) hpnon hpD (by omega)\n (fun i hi => hdiag i) hseed (fun i hi => hdiag i)\n (fun i hi j hj hij => (le_abs_self _).trans (hangle i j hij).le)\n (fun i hi j hj => hangle i j (by\n intro hij\n subst j\n exact (Finset.mem_filter.mp (Finset.mem_filter.mp hi).1).2.1 hj))\n (fun i hi => (Finset.mem_filter.mp hi).2) hδ\n have hh : (r.card : ℝ) ≤ (B : ℝ) := hrr.trans hB\n exact_mod_cast hh\n · have hz : r = ∅ := Finset.not_nonempty_iff_eq_empty.mp hr\n change r.card ≤ B\n rw [hz, Finset.card_empty]\n exact Nat.zero_le _\n have hh := Finset.sum_le_sum hclass\n simpa only [Finset.sum_const, nsmul_eq_mul, Finset.card_powerset, Nat.cast_id] using hh\n have hUpos : ∀ i ∈ U, ∀ j ∈ s, ⟪v i, v j⟫ = α := by\n intro i hi j hj\n have hiU := (Finset.mem_filter.mp hi).2\n have hij : i ≠ j := by\n intro hij\n subst j\n exact hiU.1 hj\n have hnon : 0 ≤ ⟪v i, v j⟫ := by\n by_contra h\n have hh : j ∈ f i := Finset.mem_filter.mpr ⟨hj, by linarith⟩\n rw [hiU.2] at hh\n exact Finset.notMem_empty j hh\n have hh := hangle i j hij\n rwa [abs_of_nonneg hnon] at hh\n have hnegative : ∀ p : Finset ι,\n (∀ i ∈ p, ∀ j ∈ p, i ≠ j → ⟪v i, v j⟫ ≠ α) → p.card ≠ C := by\n intro p hp hpc\n have hh := sign_reduction_negative_clique_bound p v α hα.1\n (fun i hi => hdiag i) (by\n intro i hi j hj hij\n have h := hangle i j hij\n have hn : ⟪v i, v j⟫ < 0 := by\n by_contra hn\n have hh := abs_of_nonneg (le_of_not_gt hn)\n exact hp i hi j hj hij (by rwa [hh] at h)\n rw [abs_of_neg hn] at h\n linarith)\n rw [hpc] at hh\n linarith only [hh, hC]\n intro i\n let V : Finset ι := U.filter (fun j => ⟪v i, v j⟫ < 0)\n have hV : V.card ≤ R := by\n by_contra hnot\n have hrv : R ≤ V.card := by omega\n rcases hR V hrv with ⟨p, hpV, hpD, hpp⟩ | ⟨p, hpV, hpC, hpp⟩\n · have hiout : i ∉ s := by\n intro his\n have hpn : p.Nonempty := Finset.card_pos.mp (by omega)\n obtain ⟨j, hj⟩ := hpn\n have hjV := Finset.mem_filter.mp (hpV hj)\n have hh := hUpos j hjV.1 i his\n have hh' : ⟪v i, v j⟫ = α := by rw [real_inner_comm (v j) (v i)]; exact hh\n linarith only [hjV.2, hh', hα.1]\n let q := s \\ f i\n have hdis : Disjoint p q := by\n apply Finset.disjoint_left.mpr\n intro j hj hjq\n have hjU := (Finset.mem_filter.mp (hpV hj)).1\n exact (Finset.mem_filter.mp hjU).2.1 (Finset.mem_sdiff.mp hjq).1\n have hqcard : D ≤ q.card := by\n have hs := hsmall i\n change (f i).card < D at hs\n have hfsub : f i ⊆ s := Finset.filter_subset _ _\n dsimp only [q]\n rw [Finset.card_sdiff_of_subset hfsub]\n omega\n have hpn : p.Nonempty := Finset.card_pos.mp (by omega)\n have hqn : q.Nonempty := Finset.card_pos.mp (by omega)\n have hposq : ∀ j ∈ q, ⟪v i, v j⟫ = α := by\n intro j hj\n have hjs := (Finset.mem_sdiff.mp hj).1\n have hjf := (Finset.mem_sdiff.mp hj).2\n have hnon : 0 ≤ ⟪v i, v j⟫ := by\n by_contra h\n exact hjf (Finset.mem_filter.mpr ⟨hjs, by linarith⟩)\n have hh := hangle i j (by intro h; subst j; exact hiout hjs)\n rwa [abs_of_nonneg hnon] at hh\n have hclique : ∀ j ∈ p ∪ q, ∀ k ∈ p ∪ q, j ≠ k → ⟪v j, v k⟫ = α := by\n intro j hj k hk hjk\n rcases Finset.mem_union.mp hj with hj | hj\n · rcases Finset.mem_union.mp hk with hk | hk\n · exact hpp j hj k hk hjk\n · exact hUpos j (Finset.mem_filter.mp (hpV hj)).1 k\n (Finset.mem_sdiff.mp hk).1\n · rcases Finset.mem_union.mp hk with hk | hk\n · rw [real_inner_comm (v k) (v j)]\n exact hUpos k (Finset.mem_filter.mp (hpV hk)).1 j\n (Finset.mem_sdiff.mp hj).1\n · exact hseed j (Finset.mem_sdiff.mp hj).1 k (Finset.mem_sdiff.mp hk).1 hjk\n have hb := sign_reduction_mixed_sign_bound p q v (v i) α hdis hpn hqn\n (hdiag i) (fun j hj => hdiag j) hclique\n (fun j hj => by\n have hn := (Finset.mem_filter.mp (hpV hj)).2\n have hh := hangle i j (by\n intro h\n subst j\n rw [hdiag i] at hn\n linarith)\n rw [abs_of_neg hn] at hh\n linarith) hposq\n exact sign_reduction_large_groups_impossible α hα D hD p.card q.card\n (by omega) hqcard hDp hb\n · exact hnegative p hpp hpC\n let W : Finset ι := Finset.univ.filter (fun j => ⟪v i, v j⟫ < 0)\n have hsub : W ⊆ (s ∪ X) ∪ V := by\n intro j hj\n by_cases hjs : j ∈ s\n · exact Finset.mem_union_left _ (Finset.mem_union_left _ hjs)\n · by_cases hjf : (f j).Nonempty\n · exact Finset.mem_union_left _ (Finset.mem_union_right _\n (Finset.mem_filter.mpr ⟨Finset.mem_univ j, hjs, hjf⟩))\n · have hjU : j ∈ U := Finset.mem_filter.mpr\n ⟨Finset.mem_univ j, hjs, Finset.not_nonempty_iff_eq_empty.mp hjf⟩\n exact Finset.mem_union_right _ (Finset.mem_filter.mpr\n ⟨hjU, (Finset.mem_filter.mp hj).2⟩)\n have h1 := Finset.card_le_card hsub\n have h2 := Finset.card_union_le (s ∪ X) V\n have h3 := Finset.card_union_le s X\n change W.card ≤ _\n omega\ntheorem sign_reduction_graph_of_degree_bound\n {ι H : Type*} [Fintype ι] [DecidableEq ι]\n [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (v : ι → H) (σ : ι → ℝ) (Δ : ℕ)\n (hdegree : ∀ i, (Finset.univ.filter (fun j => ⟪σ i • v i, σ j • v j⟫ < 0)).card ≤ Δ) :\n ∃ G : SimpleGraph ι,\n (∀ i j, G.Adj i j ↔ i ≠ j ∧ ⟪σ i • v i, σ j • v j⟫ < 0) ∧\n (∀ i, ({j : ι | G.Adj i j} : Set ι).ncard ≤ Δ) := by\n classical\n let G : SimpleGraph ι := {\n Adj := fun i j => i ≠ j ∧ ⟪σ i • v i, σ j • v j⟫ < 0\n symm := ⟨fun i j h => ⟨h.1.symm, by\n rw [real_inner_comm (σ i • v i) (σ j • v j)]\n exact h.2⟩⟩\n loopless := ⟨fun i h => h.1 rfl⟩ }\n refine ⟨G, fun i j => Iff.rfl, ?_⟩\n intro i\n let s := Finset.univ.filter (fun j => ⟪σ i • v i, σ j • v j⟫ < 0)\n have hsub : {j : ι | G.Adj i j} ⊆ (s : Set ι) := by\n intro j hj\n exact Finset.mem_filter.mpr ⟨Finset.mem_univ j, hj.2⟩\n calc\n ({j : ι | G.Adj i j} : Set ι).ncard ≤ (s : Set ι).ncard := Set.ncard_le_ncard hsub\n _ = s.card := Set.ncard_coe_finset s\n _ ≤ Δ := hdegree i\ntheorem uniform_sign_reduction :\n ∀ (α : ℝ), α ∈ Set.Ioo 0 1 → ∃ Δ : ℕ,\n ∀ (d n : ℕ) (E : EquiangularLinesFixedAngle.EquiangularLines α d)\n (v : Fin n → EuclideanSpace ℝ (Fin d)),\n (∀ i, v i ∈ E.carrier) → Function.Injective v →\n ∃ (σ : Fin n → ℝ) (G : SimpleGraph (Fin n)),\n (∀ i, σ i = 1 ∨ σ i = -1) ∧\n (∀ i j, G.Adj i j ↔ i ≠ j ∧ ⟪σ i • v i, σ j • v j⟫ < 0) ∧\n (∀ i, ({j : Fin n | G.Adj i j} : Set (Fin n)).ncard ≤ Δ) := by\n classical\n intro α hα\n obtain ⟨Δ, hΔ⟩ := Helpers.uniform_switching_with_gram_data α hα\n refine ⟨Δ, ?_⟩\n intro d n E v hv hinj\n obtain ⟨σ, G, hσ, _, _, _, _, hG, hdegree, _⟩ := hΔ d n v\n (fun i => E.norm (v i) (hv i))\n (fun i j hij => E.angle (hv i) (hv j) (hinj.ne hij))\n exact ⟨σ, G, hσ, hG, hdegree⟩\nnoncomputable def negativeInnerGraph {d n : ℕ}\n (v : Fin n → EuclideanSpace ℝ (Fin d)) : SimpleGraph (Fin n) :=\n SimpleGraph.fromRel (fun i j => ⟪v i, v j⟫ < 0)\ntheorem negativeInnerGraph_adj {d n : ℕ}\n (v : Fin n → EuclideanSpace ℝ (Fin d)) (i j : Fin n) :\n (negativeInnerGraph v).Adj i j ↔ i ≠ j ∧ ⟪v i, v j⟫ < 0 := by\n simp only [negativeInnerGraph, SimpleGraph.fromRel_adj, real_inner_comm (v j) (v i),\n or_self]\nnoncomputable def negativeInnerAdjMatrix {d n : ℕ}\n (v : Fin n → EuclideanSpace ℝ (Fin d)) : Matrix (Fin n) (Fin n) ℝ := by\n classical\n exact (negativeInnerGraph v).adjMatrix ℝ\ntheorem configuration_gram_eq_adjacency (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n {d n : ℕ} (E : EquiangularLines α d)\n (v : Fin n → EuclideanSpace ℝ (Fin d))\n (hv : ∀ i, v i ∈ E.carrier) (hinj : Function.Injective v) :\n Matrix.gram ℝ v =\n (1 - α) • (1 : Matrix (Fin n) (Fin n) ℝ) +\n α • Matrix.of (fun _ _ : Fin n => (1 : ℝ)) -\n (2 * α) • negativeInnerAdjMatrix v := by\n classical\n ext i j\n by_cases hij : i = j\n · subst j\n simp [Matrix.gram_apply, E.norm _ (hv i), negativeInnerAdjMatrix]\n · have hangle := E.angle (hv i) (hv j) (hinj.ne hij)\n rcases (abs_eq hα.1.le).mp hangle with hpos | hneg\n · have hnot : ¬α < 0 := not_lt.mpr hα.1.le\n simp [Matrix.gram_apply, hij, negativeInnerAdjMatrix,\n negativeInnerGraph_adj, hpos, hnot]\n · simp [Matrix.gram_apply, hij, negativeInnerAdjMatrix,\n negativeInnerGraph_adj, hneg, hα.1]\n ring\ntheorem real_matrix_rank_add_le {m n : ℕ}\n (A B : Matrix (Fin m) (Fin n) ℝ) : (A + B).rank ≤ A.rank + B.rank := by\n rw [Matrix.rank, Matrix.rank, Matrix.rank, Matrix.mulVecLin_add]\n exact (Submodule.finrank_mono (LinearMap.range_add_le A.mulVecLin B.mulVecLin)).trans\n (Submodule.finrank_add_le_finrank_add_finrank _ _)\ntheorem configuration_shifted_adjacency_rank_le (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n {d n : ℕ} (E : EquiangularLines α d)\n (v : Fin n → EuclideanSpace ℝ (Fin d))\n (hv : ∀ i, v i ∈ E.carrier) (hinj : Function.Injective v) :\n (((1 - α) / (2 * α)) • (1 : Matrix (Fin n) (Fin n) ℝ) -\n negativeInnerAdjMatrix v).rank ≤ d + 1 := by\n classical\n let J : Matrix (Fin n) (Fin n) ℝ := Matrix.of (fun _ _ => (1 : ℝ))\n have hα0 : α ≠ 0 := ne_of_gt hα.1\n have heq : ((1 - α) / (2 * α)) • (1 : Matrix (Fin n) (Fin n) ℝ) -\n negativeInnerAdjMatrix v =\n (1 / (2 * α)) • Matrix.gram ℝ v + (-1 / 2 : ℝ) • J := by\n rw [configuration_gram_eq_adjacency α hα E v hv hinj]\n ext i j\n simp only [J, Matrix.add_apply, Matrix.sub_apply, Matrix.smul_apply, smul_eq_mul]\n field_simp [hα0] <;> ring\n have hJ : J.rank ≤ 1 := by\n have hones : J = Matrix.vecMulVec (fun _ : Fin n => (1 : ℝ))\n (fun _ : Fin n => (1 : ℝ)) := by\n ext i j\n simp [J, Matrix.vecMulVec]\n rw [hones]\n exact Matrix.rank_vecMulVec_le _ _\n rw [heq]\n calc\n ((1 / (2 * α)) • Matrix.gram ℝ v + (-1 / 2 : ℝ) • J).rank ≤\n ((1 / (2 * α)) • Matrix.gram ℝ v).rank + ((-1 / 2 : ℝ) • J).rank :=\n real_matrix_rank_add_le _ _\n _ ≤ (Matrix.gram ℝ v).rank + J.rank :=\n Nat.add_le_add (real_matrix_rank_smul_le _ _) (real_matrix_rank_smul_le _ _)\n _ ≤ d + 1 := Nat.add_le_add (euclidean_gram_rank_le v) hJ\ntheorem configuration_eigenspace_dimension_bound (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n {d n : ℕ} (E : EquiangularLines α d)\n (v : Fin n → EuclideanSpace ℝ (Fin d))\n (hv : ∀ i, v i ∈ E.carrier) (hinj : Function.Injective v) :\n n ≤ d + 1 + Module.finrank ℝ\n (Module.End.eigenspace (negativeInnerAdjMatrix v).mulVecLin ((1 - α) / (2 * α))) := by\n classical\n let B : Matrix (Fin n) (Fin n) ℝ :=\n ((1 - α) / (2 * α)) • 1 - negativeInnerAdjMatrix v\n have hker : LinearMap.ker B.mulVecLin =\n Module.End.eigenspace (negativeInnerAdjMatrix v).mulVecLin ((1 - α) / (2 * α)) := by\n ext c\n rw [LinearMap.mem_ker, Module.End.mem_eigenspace_iff]\n simp only [Matrix.mulVecLin_apply, B, Matrix.sub_mulVec, Matrix.smul_mulVec,\n Matrix.one_mulVec, sub_eq_zero]\n exact eq_comm\n have hdim : B.rank + Module.finrank ℝ (LinearMap.ker B.mulVecLin) = n := by\n simpa only [Matrix.rank, Module.finrank_fintype_fun_eq_card, Fintype.card_fin] using\n LinearMap.finrank_range_add_finrank_ker B.mulVecLin\n rw [hker] at hdim\n have hrank : B.rank ≤ d + 1 :=\n configuration_shifted_adjacency_rank_le α hα E v hv hinj\n omega\ntheorem configuration_gram_spectral_bridge :\n ∀ (α : ℝ), α ∈ Set.Ioo 0 1 →\n ∀ (d n : ℕ) (E : EquiangularLinesFixedAngle.EquiangularLines α d)\n (v : Fin n → EuclideanSpace ℝ (Fin d)),\n (∀ i, v i ∈ E.carrier) → Function.Injective v →\n ∃ G : SimpleGraph (Fin n),\n let A : Matrix (Fin n) (Fin n) ℝ :=\n (letI : DecidableRel G.Adj := Classical.decRel G.Adj; G.adjMatrix ℝ)\n Matrix.gram ℝ v = (1 - α) • (1 : Matrix (Fin n) (Fin n) ℝ) +\n α • Matrix.of (fun _ _ : Fin n => (1 : ℝ)) - (2 * α) • A ∧\n (((1 - α) / (2 * α)) • (1 : Matrix (Fin n) (Fin n) ℝ) - A).rank ≤ d + 1 ∧\n n ≤ d + 1 + Module.finrank ℝ\n (Module.End.eigenspace A.mulVecLin ((1 - α) / (2 * α))) := by\n classical\n intro α hα d n E v hv hinj\n refine ⟨negativeInnerGraph v, ?_⟩\n exact ⟨configuration_gram_eq_adjacency α hα E v hv hinj,\n configuration_shifted_adjacency_rank_le α hα E v hv hinj,\n configuration_eigenspace_dimension_bound α hα E v hv hinj⟩\ntheorem configuration_gram_spectral_bridge_from_units :\n ∀ (α : ℝ), α ∈ Set.Ioo 0 1 →\n ∀ (d n : ℕ) (E : EquiangularLinesFixedAngle.EquiangularLines α d)\n (v : Fin n → EuclideanSpace ℝ (Fin d)),\n (∀ i, v i ∈ E.carrier) → Function.Injective v →\n ∃ G : SimpleGraph (Fin n),\n let A : Matrix (Fin n) (Fin n) ℝ :=\n (letI : DecidableRel G.Adj := Classical.decRel G.Adj; G.adjMatrix ℝ)\n Matrix.gram ℝ v = (1 - α) • (1 : Matrix (Fin n) (Fin n) ℝ) +\n α • Matrix.of (fun _ _ : Fin n => (1 : ℝ)) - (2 * α) • A ∧\n (((1 - α) / (2 * α)) • (1 : Matrix (Fin n) (Fin n) ℝ) - A).rank ≤ d + 1 ∧\n n ≤ d + 1 + Module.finrank ℝ\n (Module.End.eigenspace A.mulVecLin ((1 - α) / (2 * α))) := by\n intro α hα d n E v hv hinj\n exact Helpers.gram_spectral_bridge_of_unit_vectors α hα d n v\n (fun i => E.norm (v i) (hv i))\n (fun i j hij => E.angle (hv i) (hv j) (hinj.ne hij))\ntheorem configuration_lower_bounds_nat_index :\n ∀ (α : ℝ), α ∈ Set.Ioo 0 1 →\n let k := spectralRadiusOrder ((1 - α) / (2 * α))\n (∀ d : ℕ, d ≤ N α d) ∧\n (k < ⊤ → ∀ᶠ (d : ℕ) in Filter.atTop,\n ⌊(k.toNat * (d - 1) : ℝ) / (k.toNat - 1 : ℝ)⌋₊ ≤ N α d) := by\n classical\n intro α hα\n refine ⟨configuration_dimension_lower_bound α hα, ?_⟩\n intro hfinite\n obtain ⟨q, G, hq, hradius⟩ := spectral_order_attained _ hfinite\n have hαpos : 0 < α := hα.1\n have hlambda : 0 < (1 - α) / (2 * α) :=\n div_pos (sub_pos.mpr hα.2) (by positivity)\n have hqge := lower_graph_order_ge_two _ hlambda q G hradius\n have hqn : (spectralRadiusOrder ((1 - α) / (2 * α))).toNat = q := by\n rw [← hq, ENat.toNat_natCast]\n apply Filter.eventually_atTop.mpr\n refine ⟨1, ?_⟩\n intro d hd\n rw [hqn, Helpers.lower_floor_count_real_subtraction q d hqge hd]\n have hc := lower_graph_copies_configuration α hα q G hradius\n ((d - 1) / (q - 1)) ((d - 1) % (q - 1))\n rwa [Helpers.floor_lower_bound_from_copies q d hqge hd] at hc\nend Submission\n" }, { "name": "Submission/Helpers.lean", "path": "accepted/annals_equiangular_lines_fixed_angle/Submission/Helpers.lean", "url": "https://github.com/LikC1606/theorem-os-site/blob/main/accepted/annals_equiangular_lines_fixed_angle/Submission/Helpers.lean", "sha256": "2b0ee3d08d6293710ee2348a00f8bd72e702332e7e05af0af61a434c6476e57f", "lines": 3887, "code": "import Mathlib.Tactic.FieldSimp\nimport Mathlib.Algebra.Order.Floor.Semifield\nimport Mathlib.Tactic.Ring\nimport Mathlib.Tactic.Positivity\nimport Mathlib.Algebra.Order.Archimedean.Basic\nimport Mathlib.Combinatorics.Pigeonhole\nimport Mathlib.Combinatorics.SimpleGraph.Metric\nimport Mathlib.Combinatorics.SimpleGraph.AdjMatrix\nimport Mathlib.Combinatorics.SimpleGraph.Connectivity.Connected\nimport Mathlib.LinearAlgebra.Eigenspace.Basic\nimport Mathlib.Analysis.Matrix.Spectrum\nimport Mathlib.LinearAlgebra.Matrix.Rank\nimport Mathlib.Analysis.InnerProductSpace.GramMatrix\nimport Mathlib.Analysis.Matrix.Order\nimport Mathlib.Tactic.Linarith\nimport Mathlib.Analysis.Asymptotics.Defs\nnamespace Submission.Helpers\n\ntheorem upper_spectralRadius_reindex\n {ι κ : Type*} [Fintype ι] [DecidableEq ι] [Fintype κ] [DecidableEq κ]\n (e : ι ≃ κ) (A : Matrix ι ι ℝ) :\n spectralRadius ℝ (Matrix.reindex e e A) = spectralRadius ℝ A := by\n have hs := AlgEquiv.spectrum_eq (Matrix.reindexAlgEquiv ℝ ℝ e) A\n change spectrum ℝ (Matrix.reindex e e A) = spectrum ℝ A at hs\n simp only [spectralRadius_eq_of_unital, hs]\ntheorem upper_eigenspace_finrank_reindex\n {ι κ : Type*} [Fintype ι] [Fintype κ]\n (e : ι ≃ κ) (A : Matrix ι ι ℝ) (lambda : ℝ) :\n Module.finrank ℝ (Module.End.eigenspace (Matrix.reindex e e A).mulVecLin lambda) =\n Module.finrank ℝ (Module.End.eigenspace A.mulVecLin lambda) := by\n let B := Matrix.reindex e e A\n let E := LinearEquiv.funCongrLeft ℝ ℝ e.symm\n have hcomm (x : ι → ℝ) : B.mulVec (E x) = E (A.mulVec x) := by\n change B.mulVecLin (E x) = E (A.mulVec x)\n rw [Matrix.mulVecLin_reindex]\n simp only [LinearMap.comp_apply, LinearEquiv.coe_coe]\n change E (A.mulVec (fun i => x (e.symm (e i)))) = E (A.mulVec x)\n simp only [e.symm_apply_apply]\n have hmap : (Module.End.eigenspace A.mulVecLin lambda).map E.toLinearMap =\n Module.End.eigenspace B.mulVecLin lambda := by\n ext y\n constructor\n · rintro ⟨x, hx, rfl⟩\n apply Module.End.mem_eigenspace_iff.mpr\n change B.mulVec (E x) = lambda • E x\n rw [hcomm]\n change E (A.mulVecLin x) = lambda • E x\n rw [Module.End.mem_eigenspace_iff.mp hx, map_smul]\n · intro hy\n refine ⟨E.symm y, ?_, E.apply_symm_apply y⟩\n apply Module.End.mem_eigenspace_iff.mpr\n apply E.injective\n change E (A.mulVec (E.symm y)) = E (lambda • E.symm y)\n rw [map_smul, ← hcomm, E.apply_symm_apply]\n exact Module.End.mem_eigenspace_iff.mp hy\n exact (LinearEquiv.ofSubmodules E _ _ hmap).finrank_eq.symm\ntheorem upper_relabel_connected_radius\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) [DecidableRel G.Adj] (hG : G.Connected) :\n ∃ H : SimpleGraph (Fin (Fintype.card ι)), H.Connected ∧\n (letI : DecidableRel H.Adj := Classical.decRel H.Adj;\n spectralRadius ℝ (H.adjMatrix ℝ)) = spectralRadius ℝ (G.adjMatrix ℝ) := by\n classical\n let H := G.overFin (rfl : Fintype.card ι = Fintype.card ι)\n let e := G.overFinIso (rfl : Fintype.card ι = Fintype.card ι)\n refine ⟨H, e.connected_iff.mp hG, ?_⟩\n have hm := e.reindex_adjMatrix ℝ\n rw [← hm]\n exact upper_spectralRadius_reindex e.toEquiv (G.adjMatrix ℝ)\ntheorem upper_component_overFin_data\n (n : ℕ) (G : SimpleGraph (Fin n)) (C : G.ConnectedComponent)\n (Δ : ℕ) (hΔ : ∀ i, ({j : Fin n | G.Adj i j} : Set (Fin n)).ncard ≤ Δ) :\n letI : Fintype C.supp := Fintype.ofFinite C.supp\n letI : DecidableEq C.supp := Classical.decEq C.supp\n letI : DecidableRel C.toSimpleGraph.Adj := Classical.decRel C.toSimpleGraph.Adj\n ∃ H : SimpleGraph (Fin (Fintype.card C.supp)), H.Connected ∧\n (∀ i, ({j | H.Adj i j} : Set (Fin (Fintype.card C.supp))).ncard ≤ Δ) ∧\n (letI : DecidableRel H.Adj := Classical.decRel H.Adj;\n spectralRadius ℝ (H.adjMatrix ℝ)) =\n spectralRadius ℝ (C.toSimpleGraph.adjMatrix ℝ) ∧\n ∀ lambda : ℝ,\n (letI : DecidableRel H.Adj := Classical.decRel H.Adj;\n Module.finrank ℝ (Module.End.eigenspace (H.adjMatrix ℝ).mulVecLin lambda)) =\n Module.finrank ℝ (Module.End.eigenspace\n (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda) := by\n classical\n letI : Fintype C.supp := Fintype.ofFinite C.supp\n letI : DecidableEq C.supp := Classical.decEq C.supp\n letI : DecidableRel C.toSimpleGraph.Adj := Classical.decRel C.toSimpleGraph.Adj\n let H := C.toSimpleGraph.overFin (rfl : Fintype.card C.supp = Fintype.card C.supp)\n let e := C.toSimpleGraph.overFinIso (rfl : Fintype.card C.supp = Fintype.card C.supp)\n refine ⟨H, e.connected_iff.mp C.connected_toSimpleGraph, ?_, ?_, ?_⟩\n · intro i\n apply le_trans _ (hΔ (e.symm i).val)\n exact Set.ncard_le_ncard_of_injOn (fun j => (e.symm j).val)\n (fun j hj => e.symm.map_adj_iff.mpr hj)\n (fun x _ y _ h => e.symm.injective (Subtype.ext h))\n · rw [← e.reindex_adjMatrix ℝ]\n exact upper_spectralRadius_reindex e.toEquiv (C.toSimpleGraph.adjMatrix ℝ)\n · intro lambda\n rw [← e.reindex_adjMatrix ℝ]\n exact upper_eigenspace_finrank_reindex e.toEquiv (C.toSimpleGraph.adjMatrix ℝ) lambda\ntheorem upper_small_eigenspace_bound\n {ι : Type*} [Fintype ι] (A : Matrix ι ι ℝ) (lambda : ℝ) :\n Module.finrank ℝ (Module.End.eigenspace A.mulVecLin lambda) ≤ Fintype.card ι := by\n simpa only [Module.finrank_pi, Module.finrank_self, mul_one] using\n (Module.End.eigenspace A.mulVecLin lambda).finrank_le\ntheorem upper_scaled_gram_psd_rank\n (α : ℝ) (hα : α ∈ Set.Ioo 0 1) (d n : ℕ)\n (w : Fin n → EuclideanSpace ℝ (Fin d)) (A : Matrix (Fin n) (Fin n) ℝ)\n (hgram : Matrix.gram ℝ w = (1 - α) • (1 : Matrix (Fin n) (Fin n) ℝ) +\n α • Matrix.of (fun _ _ : Fin n => (1 : ℝ)) - (2 * α) • A) :\n let P := ((1 - α) / (2 * α)) • (1 : Matrix (Fin n) (Fin n) ℝ) - A +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ : Fin n => (1 : ℝ))\n P.PosSemidef ∧ P.rank ≤ d := by\n classical\n dsimp only\n have hα0 : α ≠ 0 := ne_of_gt hα.1\n have hp : 0 < 1 / (2 * α) := one_div_pos.mpr (mul_pos (by norm_num) hα.1)\n have heq : ((1 - α) / (2 * α)) • (1 : Matrix (Fin n) (Fin n) ℝ) - A +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ : Fin n => (1 : ℝ)) =\n (1 / (2 * α)) • Matrix.gram ℝ w := by\n rw [hgram]\n ext i j\n simp only [Matrix.add_apply, Matrix.sub_apply, Matrix.smul_apply, smul_eq_mul]\n field_simp [hα0] <;> ring\n rw [heq]\n refine ⟨(Matrix.posSemidef_gram ℝ w).smul hp.le, ?_⟩\n rw [Matrix.rank_smul_of_mem_nonZeroDivisors _\n (mem_nonZeroDivisors_iff_ne_zero.mpr (ne_of_gt hp))]\n let b := EuclideanSpace.basisFun (Fin d) ℝ\n let M : Matrix (Fin d) (Fin n) ℝ := Matrix.of (fun i j => b.repr (w j) i)\n rw [Matrix.gram_eq_conjTranspose_mul b w]\n exact (Matrix.rank_mul_le_right M.conjTranspose M).trans\n (by simpa only [Fintype.card_fin] using Matrix.rank_le_card_height M)\ntheorem upper_floor_from_component_count\n (q n d t : ℕ) (hq : 2 ≤ q) (hcount : q * t ≤ n)\n (hrank : n + 1 - t ≤ d) :\n n ≤ ⌊(q * (d - 1) : ℝ) / (q - 1 : ℝ)⌋₊ := by\n have htn : t ≤ n := by nlinarith\n have hrNat : n + 1 ≤ d + t := by omega\n have hqR : (2 : ℝ) ≤ (q : ℝ) := by exact_mod_cast hq\n have hcountR : (q : ℝ) * (t : ℝ) ≤ (n : ℝ) := by exact_mod_cast hcount\n have hrR : (n : ℝ) + 1 ≤ (d : ℝ) + (t : ℝ) := by exact_mod_cast hrNat\n apply Nat.le_floor\n apply (le_div_iff₀ (by linarith : (0 : ℝ) < (q : ℝ) - 1)).mpr\n have hm := mul_le_mul_of_nonneg_left hrR (Nat.cast_nonneg q : (0 : ℝ) ≤ q)\n nlinarith only [hm, hcountR]\ntheorem upper_floor_ge_dimension (q d : ℕ) (hq : 2 ≤ q) (hd : q ≤ d) :\n d ≤ ⌊(q * (d - 1) : ℝ) / (q - 1 : ℝ)⌋₊ := by\n have hqR : (2 : ℝ) ≤ (q : ℝ) := by exact_mod_cast hq\n have hdR : (q : ℝ) ≤ (d : ℝ) := by exact_mod_cast hd\n apply Nat.le_floor\n apply (le_div_iff₀ (by linarith : (0 : ℝ) < (q : ℝ) - 1)).mpr\n nlinarith only [hdR]\ntheorem upper_floor_from_small_exception\n (q d n M : ℕ) (hq : 2 ≤ q)\n (hd : 2 * q + (q - 1) * M ≤ d) (hn : n ≤ d + 1 + M) :\n n ≤ ⌊(q * (d - 1) : ℝ) / (q - 1 : ℝ)⌋₊ := by\n have hqR : (2 : ℝ) ≤ (q : ℝ) := by exact_mod_cast hq\n have hdR : 2 * (q : ℝ) + ((q : ℝ) - 1) * (M : ℝ) ≤ (d : ℝ) := by\n have hdR' : 2 * (q : ℝ) + ((q - 1 : ℕ) : ℝ) * (M : ℝ) ≤ (d : ℝ) := by\n exact_mod_cast hd\n simpa only [Nat.cast_sub (show 1 ≤ q by omega), Nat.cast_one] using hdR'\n have hnR : (n : ℝ) ≤ (d : ℝ) + 1 + (M : ℝ) := by exact_mod_cast hn\n apply Nat.le_floor\n apply (le_div_iff₀ (by linarith : (0 : ℝ) < (q : ℝ) - 1)).mpr\n have hm := mul_le_mul_of_nonneg_right hnR (by linarith : (0 : ℝ) ≤ (q : ℝ) - 1)\n nlinarith only [hm, hdR]\ntheorem upper_floor_from_small_multiplicity\n (q d n : ℕ) (hq : 2 ≤ q) (hd : 4 * q ≤ d)\n (hn : (n : ℝ) ≤ (d : ℝ) + 1 + (1 / (2 * (q : ℝ))) * (n : ℝ)) :\n n ≤ ⌊(q * (d - 1) : ℝ) / (q - 1 : ℝ)⌋₊ := by\n have hqR : (2 : ℝ) ≤ (q : ℝ) := by exact_mod_cast hq\n have hdR : 4 * (q : ℝ) ≤ (d : ℝ) := by exact_mod_cast hd\n have hqpos : 0 < (q : ℝ) := by linarith\n have hm := mul_le_mul_of_nonneg_left hn (by positivity : (0 : ℝ) ≤ 2 * (q : ℝ))\n have hcancel : (2 * (q : ℝ)) * ((1 / (2 * (q : ℝ))) * (n : ℝ)) = (n : ℝ) := by\n field_simp\n have hr : (2 * (q : ℝ) - 1) * (n : ℝ) ≤ 2 * (q : ℝ) * ((d : ℝ) + 1) := by\n nlinarith only [hm, hcancel]\n apply Nat.le_floor\n apply (le_div_iff₀ (by linarith : (0 : ℝ) < (q : ℝ) - 1)).mpr\n have hr' := mul_le_mul_of_nonneg_left hr (by linarith : (0 : ℝ) ≤ (q : ℝ) - 1)\n have hd' : 0 ≤ (q : ℝ) * ((d : ℝ) - 4 * (q : ℝ) + 3) :=\n mul_nonneg hqpos.le (by linarith)\n nlinarith only [hr', hd', hqR]\ntheorem upper_rank_one_principal_psd\n {ι κ : Type*} [Fintype ι] [DecidableEq ι] [Fintype κ] [DecidableEq κ]\n (A : Matrix ι ι ℝ) (lambda : ℝ) (f : κ → ι) (hf : Function.Injective f)\n (hP : (lambda • (1 : Matrix ι ι ℝ) - A +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).PosSemidef) :\n (lambda • (1 : Matrix κ κ ℝ) - A.submatrix f f +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).PosSemidef := by\n have heq : (lambda • (1 : Matrix ι ι ℝ) - A +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).submatrix f f =\n lambda • (1 : Matrix κ κ ℝ) - A.submatrix f f +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ)) := by\n ext i j\n simp [Matrix.one_apply, hf.eq_iff]\n rw [← heq]\n exact hP.submatrix f\ntheorem upper_rank_one_quadratic\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (lambda : ℝ) (x : ι → ℝ) :\n dotProduct x ((lambda • (1 : Matrix ι ι ℝ) - A +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).mulVec x) =\n lambda * dotProduct x x - dotProduct x (A.mulVec x) +\n (1 / 2 : ℝ) * (∑ i, x i) ^ 2 := by\n have hJ : (Matrix.of (fun _ _ : ι => (1 : ℝ))).mulVec x = fun _ => ∑ i, x i := by\n funext i\n simp only [Matrix.mulVec, dotProduct, Matrix.of_apply, one_mul]\n rw [Matrix.add_mulVec, Matrix.sub_mulVec, Matrix.smul_mulVec, Matrix.one_mulVec,\n Matrix.smul_mulVec, dotProduct_add, dotProduct_sub, dotProduct_smul,\n dotProduct_smul, hJ]\n simp only [smul_eq_mul, dotProduct, Finset.sum_mul, pow_two]\ntheorem upper_psd_no_two_supercritical_eigenpairs\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (lambda rho tau : ℝ)\n (hP : (lambda • (1 : Matrix ι ι ℝ) - A +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).PosSemidef)\n (x y : ι → ℝ) (hx : A.mulVec x = rho • x) (hy : A.mulVec y = tau • y)\n (hxx : dotProduct x x = 1) (hyy : dotProduct y y = 1)\n (hxy : dotProduct x y = 0) (hrho : lambda < rho) (htau : lambda < tau) : False := by\n let a := ∑ i, x i\n let b := ∑ i, y i\n have ha : a ≠ 0 := by\n intro ha\n have hn := hP.dotProduct_mulVec_nonneg x\n simp only [star_trivial] at hn\n rw [upper_rank_one_quadratic, hx, dotProduct_smul, smul_eq_mul, hxx] at hn\n change 0 ≤ lambda * 1 - rho * 1 + (1 / 2 : ℝ) * a ^ 2 at hn\n rw [ha] at hn\n nlinarith only [hn, hrho]\n let z := b • x - a • y\n have hyx : dotProduct y x = 0 := by rw [dotProduct_comm, hxy]\n have hzsum : ∑ i, z i = 0 := by\n simp only [z, Pi.sub_apply, Pi.smul_apply, smul_eq_mul,\n Finset.sum_sub_distrib, ← Finset.mul_sum]\n change b * a - a * b = 0\n ring\n have hzq : dotProduct z (A.mulVec z) = b ^ 2 * rho + a ^ 2 * tau := by\n simp only [z, Matrix.mulVec_sub, Matrix.mulVec_smul, hx, hy,\n sub_dotProduct, dotProduct_sub, smul_dotProduct, dotProduct_smul,\n smul_eq_mul, hxy, hyx, hxx, hyy]\n ring\n have hzn : dotProduct z z = b ^ 2 + a ^ 2 := by\n simp only [z, sub_dotProduct, dotProduct_sub, smul_dotProduct,\n dotProduct_smul, smul_eq_mul, hxy, hyx, hxx, hyy]\n ring\n have hn := hP.dotProduct_mulVec_nonneg z\n simp only [star_trivial] at hn\n rw [upper_rank_one_quadratic, hzsum, hzq, hzn] at hn\n have hs := mul_pos (sq_pos_of_ne_zero ha) (sub_pos.mpr htau)\n have hw := mul_nonneg (sq_nonneg b) (sub_nonneg.mpr hrho.le)\n nlinarith only [hn, hs, hw]\ntheorem upper_psd_eigenvalues_except_one\n {ι : Type*} [Fintype ι] [DecidableEq ι] [Nonempty ι]\n (A : Matrix ι ι ℝ) (hA : A.IsHermitian) (lambda : ℝ)\n (hP : (lambda • (1 : Matrix ι ι ℝ) - A +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).PosSemidef) :\n ∃ j : ι, ∀ i : ι, i ≠ j → hA.eigenvalues i ≤ lambda := by\n classical\n have hn (i : ι) : dotProduct (hA.eigenvectorBasis i).ofLp\n (hA.eigenvectorBasis i).ofLp = 1 := by\n calc\n _ = ‖hA.eigenvectorBasis i‖ ^ 2 := by\n simpa only [dotProduct, ← pow_two] using\n (EuclideanSpace.real_norm_sq_eq (hA.eigenvectorBasis i)).symm\n _ = 1 := by rw [hA.eigenvectorBasis.norm_eq_one]; norm_num\n have ho (i j : ι) (hij : i ≠ j) : dotProduct (hA.eigenvectorBasis i).ofLp\n (hA.eigenvectorBasis j).ofLp = 0 := by\n have hh := hA.eigenvectorBasis.inner_eq_ite i j\n simpa only [PiLp.inner_apply, Real.inner_apply, dotProduct, if_neg hij] using hh\n by_cases hex : ∃ j, lambda < hA.eigenvalues j\n · obtain ⟨j, hj⟩ := hex\n refine ⟨j, ?_⟩\n intro i hij\n by_contra hi\n exact upper_psd_no_two_supercritical_eigenpairs A lambda\n (hA.eigenvalues i) (hA.eigenvalues j) hP\n (hA.eigenvectorBasis i).ofLp (hA.eigenvectorBasis j).ofLp\n (hA.mulVec_eigenvectorBasis i) (hA.mulVec_eigenvectorBasis j)\n (hn i) (hn j) (ho i j hij) (lt_of_not_ge hi) hj\n · refine ⟨Classical.arbitrary ι, ?_⟩\n intro i _\n exact le_of_not_gt (fun hi => hex ⟨i, hi⟩)\ntheorem supercritical_component_overFin_data\n (n : ℕ) (G : SimpleGraph (Fin n)) (C : G.ConnectedComponent)\n (Δ : ℕ) (hdegree : ∀ i, ({j : Fin n | G.Adj i j} : Set (Fin n)).ncard ≤ Δ) :\n letI : DecidableRel G.Adj := Classical.decRel G.Adj\n letI : Fintype C.supp := Fintype.ofFinite C.supp\n letI : DecidableEq C.supp := Classical.decEq C.supp\n letI : DecidableRel C.toSimpleGraph.Adj := Classical.decRel C.toSimpleGraph.Adj\n ∃ (H : SimpleGraph (Fin (Fintype.card C.supp)))\n (f : Fin (Fintype.card C.supp) → Fin n),\n H.Connected ∧ Function.Injective f ∧\n (∀ i, ({j | H.Adj i j} : Set (Fin (Fintype.card C.supp))).ncard ≤ Δ) ∧\n (letI : DecidableRel H.Adj := Classical.decRel H.Adj;\n (G.adjMatrix ℝ).submatrix f f = H.adjMatrix ℝ ∧\n ∀ lambda : ℝ,\n Module.finrank ℝ (Module.End.eigenspace (H.adjMatrix ℝ).mulVecLin lambda) =\n Module.finrank ℝ (Module.End.eigenspace\n (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda)) := by\n classical\n letI : DecidableRel G.Adj := Classical.decRel G.Adj\n letI : Fintype C.supp := Fintype.ofFinite C.supp\n letI : DecidableEq C.supp := Classical.decEq C.supp\n letI : DecidableRel C.toSimpleGraph.Adj := Classical.decRel C.toSimpleGraph.Adj\n let H := C.toSimpleGraph.overFin (rfl : Fintype.card C.supp = Fintype.card C.supp)\n let e := C.toSimpleGraph.overFinIso (rfl : Fintype.card C.supp = Fintype.card C.supp)\n letI : DecidableRel H.Adj := Classical.decRel H.Adj\n let f : Fin (Fintype.card C.supp) → Fin n := fun i => (e.symm i).val\n have hf : Function.Injective f := by\n intro i j hij\n exact e.symm.injective (Subtype.ext hij)\n refine ⟨H, f, e.connected_iff.mp C.connected_toSimpleGraph, hf, ?_, ?_, ?_⟩\n · intro i\n apply le_trans _ (hdegree (f i))\n exact Set.ncard_le_ncard_of_injOn f\n (fun j hj => e.symm.map_adj_iff.mpr hj)\n (fun _ _ _ _ hij => hf hij)\n · ext i j\n have ha : G.Adj (f i) (f j) ↔ H.Adj i j := e.symm.map_adj_iff\n simp only [Matrix.submatrix_apply, SimpleGraph.adjMatrix_apply, ha]\n · intro lambda\n rw [← e.reindex_adjMatrix ℝ]\n exact upper_eigenspace_finrank_reindex e.toEquiv (C.toSimpleGraph.adjMatrix ℝ) lambda\ntheorem error_term_of_bounds :\n ∀ (f : ℕ → ℕ), (∀ d : ℕ, d ≤ f d) →\n (∀ ε : ℝ, 0 < ε → ∀ᶠ d in Filter.atTop,\n (f d : ℝ) ≤ (1 + ε) * (d : ℝ)) →\n ∃ e : ℕ → ℝ, e =o[Filter.atTop] (Nat.cast : ℕ → ℝ) ∧\n ∀ d : ℕ, (f d : ℝ) = (d : ℝ) + e d := by\n intro f hlower hupper\n refine ⟨fun d => (f d : ℝ) - (d : ℝ), ?_, ?_⟩\n · apply Asymptotics.isLittleO_iff.mpr\n intro ε hε\n refine (hupper ε hε).mono ?_\n intro d hd\n change ‖(f d : ℝ) - (d : ℝ)‖ ≤ ε * ‖(d : ℝ)‖\n have hl : (d : ℝ) ≤ (f d : ℝ) := Nat.cast_le.mpr (hlower d)\n rw [Real.norm_of_nonneg (sub_nonneg.mpr hl),\n Real.norm_of_nonneg (Nat.cast_nonneg d)]\n linarith only [hd]\n · intro d\n dsimp only\n linarith\ntheorem real_inner_preserving_map_of_finrank_le\n (E : Type*) [NormedAddCommGroup E] [InnerProductSpace ℝ E]\n [FiniteDimensional ℝ E] (d : ℕ) (hd : Module.finrank ℝ E ≤ d) :\n ∃ f : E → EuclideanSpace ℝ (Fin d),\n ∀ x y, inner ℝ (f x) (f y) = inner ℝ x y := by\n classical\n let b : OrthonormalBasis (Fin (Module.finrank ℝ E)) ℝ E := stdOrthonormalBasis ℝ E\n let c := EuclideanSpace.basisFun (Fin d) ℝ\n let u : Fin (Module.finrank ℝ E) → EuclideanSpace ℝ (Fin d) :=\n fun i => c (Fin.castLE hd i)\n have hu : Orthonormal ℝ u := c.orthonormal.comp (Fin.castLE hd) (Fin.castLE_injective hd)\n refine ⟨fun x => ∑ i, b.repr x i • u i, ?_⟩\n intro x y\n calc\n inner ℝ (∑ i, b.repr x i • u i) (∑ i, b.repr y i • u i) =\n ∑ i, b.repr x i * b.repr y i := by\n simpa using hu.inner_sum (fun i => b.repr x i) (fun i => b.repr y i) Finset.univ\n _ = inner ℝ (b.repr x) (b.repr y) := by\n simp only [PiLp.inner_apply, Real.inner_apply]\n _ = inner ℝ x y := b.repr.inner_map_map x y\ntheorem positive_semidefinite_gram_realization :\n ∀ (n d : ℕ) (M : Matrix (Fin n) (Fin n) ℝ),\n M.PosSemidef → M.rank ≤ d →\n ∃ v : Fin n → EuclideanSpace ℝ (Fin d), Matrix.gram ℝ v = M := by\n classical\n intro n d M hM hd\n letI : PartialOrder (Matrix (Fin n) (Fin n) ℝ) := Matrix.instPartialOrder\n letI : StarOrderedRing (Matrix (Fin n) (Fin n) ℝ) := Matrix.instStarOrderedRing\n letI : NonnegSpectrumClass ℝ (Matrix (Fin n) (Fin n) ℝ) := Matrix.instNonnegSpectrumClass\n obtain ⟨B, hB⟩ := (CStarAlgebra.nonneg_iff_eq_star_mul_self (a := M)).mp hM.nonneg\n let L : EuclideanSpace ℝ (Fin n) →ₗ[ℝ] EuclideanSpace ℝ (Fin n) :=\n Matrix.toEuclideanLin B\n let W := LinearMap.range L\n have hW : Module.finrank ℝ W = M.rank := by\n calc\n Module.finrank ℝ W = B.rank := by\n change Module.finrank ℝ (LinearMap.range (Matrix.toEuclideanLin B)) = B.rank\n rw [Matrix.toEuclideanLin_eq_toLin_orthonormal]\n convert\n (B.rank_eq_finrank_range_toLin (EuclideanSpace.basisFun (Fin n) ℝ).toBasis\n (EuclideanSpace.basisFun (Fin n) ℝ).toBasis).symm using 1\n _ = M.rank := by\n rw [hB, Matrix.star_eq_conjTranspose, Matrix.rank_conjTranspose_mul_self]\n let w : Fin n → W := fun i =>\n ⟨WithLp.toLp 2 (B.transpose i), by\n refine ⟨WithLp.toLp 2 (Pi.single i 1), ?_⟩\n change WithLp.toLp 2 (B.mulVec (Pi.single i 1)) = WithLp.toLp 2 (B.transpose i)\n exact congrArg (WithLp.toLp 2) (Matrix.mulVec_single_one B i)⟩\n obtain ⟨f, hf⟩ := real_inner_preserving_map_of_finrank_le W d (hW.symm ▸ hd)\n refine ⟨fun i => f (w i), ?_⟩\n ext i j\n rw [Matrix.gram_apply, hf, Submodule.coe_inner]\n change inner ℝ (WithLp.toLp 2 (B.transpose i)) (WithLp.toLp 2 (B.transpose j)) = M i j\n rw [inner_matrix_col_col]\n rw [hB, Matrix.star_eq_conjTranspose]\ntheorem real_matrix_eigenspace_finrank_toEuclidean\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (μ : ℝ) :\n Module.finrank ℝ (Module.End.eigenspace A.mulVecLin μ) =\n Module.finrank ℝ (Module.End.eigenspace A.toEuclideanLin μ) := by\n let e := WithLp.linearEquiv 2 ℝ (ι → ℝ)\n have hm : (Module.End.eigenspace A.toEuclideanLin μ).map e.toLinearMap =\n Module.End.eigenspace A.mulVecLin μ := by\n ext x\n constructor\n · rintro ⟨y, hy, rfl⟩\n apply Module.End.mem_eigenspace_iff.mpr\n have h := congrArg e (Module.End.mem_eigenspace_iff.mp hy)\n simpa [e, Matrix.toLpLin_apply] using h\n · intro hx\n refine ⟨e.symm x, ?_, e.apply_symm_apply x⟩\n apply Module.End.mem_eigenspace_iff.mpr\n apply e.injective\n simpa [e, Matrix.toLpLin_apply] using Module.End.mem_eigenspace_iff.mp hx\n rw [← hm]\n exact e.finrank_map_eq _\ntheorem real_matrix_eigenspace_finrank_eq_card\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (hA : A.IsHermitian) (μ : ℝ) :\n Module.finrank ℝ (Module.End.eigenspace A.mulVecLin μ) =\n (Finset.univ.filter fun i => hA.eigenvalues i = μ).card := by\n classical\n rw [real_matrix_eigenspace_finrank_toEuclidean]\n let e : Fin (Fintype.card ι) ≃ ι :=\n Fintype.equivOfCardEq (Fintype.card_fin _)\n have hc : (Finset.univ.filter fun i => hA.eigenvalues i = μ).card =\n (Finset.univ.filter fun i => hA.eigenvalues₀ i = μ).card :=\n Finset.card_equiv e.symm (by\n intro i\n simp only [Finset.mem_filter, Finset.mem_univ, true_and]\n rfl)\n rw [hc]\n exact ((Matrix.isSymmetric_toEuclideanLin_iff.mpr hA).card_filter_eigenvalues_eq\n finrank_euclideanSpace μ).symm\ntheorem real_matrix_eigenspace_eq_bot_of_not_eigenvalue\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (hA : A.IsHermitian) (μ : ℝ)\n (hμ : ∀ i, hA.eigenvalues i ≠ μ) :\n Module.End.eigenspace A.mulVecLin μ = ⊥ := by\n classical\n apply Submodule.finrank_eq_zero.mp\n rw [real_matrix_eigenspace_finrank_eq_card A hA μ]\n simp [hμ]\ntheorem real_matrix_trace_pow_eq_sum\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (hA : A.IsHermitian) (k : ℕ) :\n (A ^ k).trace = ∑ i, (hA.eigenvalues i) ^ k := by\n conv_lhs => rw [hA.spectral_theorem, ← map_pow]\n rw [Unitary.conjStarAlgAut_apply, Matrix.trace_mul_cycle,\n Unitary.coe_star_mul_self, Matrix.one_mul, Matrix.diagonal_pow]\n simp only [Matrix.trace_diagonal, Pi.pow_apply, Function.comp_apply]\n rfl\ntheorem real_matrix_eigenspace_multiplicity_trace_bound\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (hA : A.IsHermitian) (μ : ℝ) (t : ℕ) :\n (Module.finrank ℝ (Module.End.eigenspace A.mulVecLin μ) : ℝ) * μ ^ (2 * t) ≤\n (A ^ (2 * t)).trace := by\n classical\n rw [real_matrix_eigenspace_finrank_eq_card A hA μ,\n real_matrix_trace_pow_eq_sum A hA (2 * t)]\n have hs : (∑ i ∈ Finset.univ.filter (fun i => hA.eigenvalues i = μ),\n (hA.eigenvalues i) ^ (2 * t)) =\n ((Finset.univ.filter (fun i => hA.eigenvalues i = μ)).card : ℝ) * μ ^ (2 * t) := by\n rw [Finset.sum_congr rfl (fun i hi => by rw [(Finset.mem_filter.mp hi).2])]\n simp\n rw [← hs]\n apply Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)\n intro i _ _\n rw [mul_comm 2 t, pow_mul]\n exact sq_nonneg _\ntheorem real_matrix_eigenspace_deletion_bound\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (μ : ℝ) (s : Finset ι) :\n Module.finrank ℝ (Module.End.eigenspace A.mulVecLin μ) ≤\n s.card + Module.finrank ℝ (Module.End.eigenspace\n (A.submatrix (fun i : {i // i ∉ s} => i.val)\n (fun i : {i // i ∉ s} => i.val)).mulVecLin μ) := by\n classical\n let E := Module.End.eigenspace A.mulVecLin μ\n let f : E →ₗ[ℝ] (s → ℝ) :=\n LinearMap.pi fun i => (LinearMap.proj i.val).comp E.subtype\n have hz (x : LinearMap.ker f) (i : ι) (hi : i ∈ s) : x.val.val i = 0 := by\n exact congrFun (LinearMap.mem_ker.mp x.property) ⟨i, hi⟩\n let B := A.submatrix (fun i : {i // i ∉ s} => i.val)\n (fun i : {i // i ∉ s} => i.val)\n have he (x : LinearMap.ker f) :\n (fun i : {i // i ∉ s} => x.val.val i.val) ∈\n Module.End.eigenspace B.mulVecLin μ := by\n apply Module.End.mem_eigenspace_iff.mpr\n funext i\n change (∑ j : {j // j ∉ s}, A i.val j.val * x.val.val j.val) = μ * x.val.val i.val\n rw [← Finset.sum_subtype (Finset.univ.filter fun j => j ∉ s)\n (by intro j; simp) (fun j => A i.val j * x.val.val j)]\n have hsum : (∑ j ∈ Finset.univ.filter (fun j => j ∉ s), A i.val j * x.val.val j) =\n ∑ j, A i.val j * x.val.val j := by\n rw [Finset.sum_filter]\n apply Finset.sum_congr rfl\n intro j _\n by_cases hj : j ∈ s\n · simp [hj, hz x j hj]\n · simp [hj]\n rw [hsum]\n exact congrFun (Module.End.mem_eigenspace_iff.mp x.val.property) i.val\n let g : LinearMap.ker f →ₗ[ℝ] Module.End.eigenspace B.mulVecLin μ :=\n { toFun := fun x => ⟨fun i => x.val.val i.val, he x⟩\n map_add' := fun x y => rfl\n map_smul' := fun c x => rfl }\n have hg : Function.Injective g := by\n intro x y h\n apply Subtype.ext\n apply Subtype.ext\n funext i\n by_cases hi : i ∈ s\n · rw [hz x i hi, hz y i hi]\n · exact congrFun (congrArg Subtype.val h) ⟨i, hi⟩\n have hk := LinearMap.finrank_le_finrank_of_injective (f := g) hg\n have hr : Module.finrank ℝ (LinearMap.range f) ≤ s.card := by\n have h := (LinearMap.range f).finrank_le\n simpa using h\n have hn := f.finrank_range_add_finrank_ker\n dsimp only [E] at hn\n exact hn.symm.le.trans (Nat.add_le_add hr hk)\ntheorem real_unitary_dotProduct_mulVec\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (U : Matrix.unitaryGroup ι ℝ) (x y : ι → ℝ) :\n dotProduct ((U : Matrix ι ι ℝ).mulVec x) ((U : Matrix ι ι ℝ).mulVec y) =\n dotProduct x y := by\n have hU : (U : Matrix ι ι ℝ).transpose * U = 1 := by\n simpa only [Matrix.star_eq_conjTranspose,\n Matrix.conjTranspose_eq_transpose_of_trivial] using Unitary.coe_star_mul_self U\n rw [dotProduct_comm, ← Matrix.dotProduct_transpose_mulVec,\n Matrix.mulVec_mulVec, hU, Matrix.one_mulVec]\ntheorem real_matrix_dotProduct_eq_eigen_coordinates\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (hA : A.IsHermitian) (x : ι → ℝ) :\n dotProduct x x = ∑ i, ((star (hA.eigenvectorUnitary : Matrix ι ι ℝ)).mulVec x i) ^ 2 := by\n let U := hA.eigenvectorUnitary\n let y := (star (U : Matrix ι ι ℝ)).mulVec x\n have hx : (U : Matrix ι ι ℝ).mulVec y = x := by\n dsimp only [y]\n rw [Matrix.mulVec_mulVec, ← Unitary.coe_star, Unitary.coe_mul_star_self, Matrix.one_mulVec]\n calc\n dotProduct x x = dotProduct ((U : Matrix ι ι ℝ).mulVec y)\n ((U : Matrix ι ι ℝ).mulVec y) := by rw [hx]\n _ = dotProduct y y := real_unitary_dotProduct_mulVec U y y\n _ = ∑ i, y i ^ 2 := by simp only [dotProduct, pow_two]\ntheorem real_matrix_quadratic_eq_eigen_coordinates\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (hA : A.IsHermitian) (x : ι → ℝ) :\n dotProduct x (A.mulVec x) =\n ∑ i, hA.eigenvalues i * ((star (hA.eigenvectorUnitary : Matrix ι ι ℝ)).mulVec x i) ^ 2 := by\n let U := hA.eigenvectorUnitary\n let y := (star (U : Matrix ι ι ℝ)).mulVec x\n have hx : (U : Matrix ι ι ℝ).mulVec y = x := by\n dsimp only [y]\n rw [Matrix.mulVec_mulVec, ← Unitary.coe_star, Unitary.coe_mul_star_self, Matrix.one_mulVec]\n have hAx : A.mulVec x = (U : Matrix ι ι ℝ).mulVec\n ((Matrix.diagonal hA.eigenvalues).mulVec y) := by\n conv_lhs => rw [hA.spectral_theorem]\n change ((U : Matrix ι ι ℝ) * Matrix.diagonal hA.eigenvalues *\n star (U : Matrix ι ι ℝ)).mulVec x = _\n rw [← Matrix.mulVec_mulVec, ← Matrix.mulVec_mulVec]\n calc\n dotProduct x (A.mulVec x) =\n dotProduct ((U : Matrix ι ι ℝ).mulVec y)\n ((U : Matrix ι ι ℝ).mulVec ((Matrix.diagonal hA.eigenvalues).mulVec y)) := by\n rw [hx, hAx]\n _ = dotProduct y ((Matrix.diagonal hA.eigenvalues).mulVec y) :=\n real_unitary_dotProduct_mulVec U y _\n _ = ∑ i, hA.eigenvalues i * (y i) ^ 2 := by\n simp only [Matrix.mulVec_diagonal, dotProduct]\n apply Finset.sum_congr rfl\n intro i _\n ring\ntheorem real_matrix_rayleigh_le_of_eigenvalues_le\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (hA : A.IsHermitian) (μ : ℝ)\n (hμ : ∀ i, hA.eigenvalues i ≤ μ) (x : ι → ℝ) :\n dotProduct x (A.mulVec x) ≤ μ * dotProduct x x := by\n rw [real_matrix_quadratic_eq_eigen_coordinates A hA x,\n real_matrix_dotProduct_eq_eigen_coordinates A hA x, Finset.mul_sum]\n exact Finset.sum_le_sum fun i _ => mul_le_mul_of_nonneg_right (hμ i) (sq_nonneg _)\ntheorem real_matrix_rayleigh_le_away_from_exception\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (hA : A.IsHermitian) (μ : ℝ) (j : ι)\n (hμ : ∀ i, i ≠ j → hA.eigenvalues i ≤ μ) (x : ι → ℝ)\n (hx : (star (hA.eigenvectorUnitary : Matrix ι ι ℝ)).mulVec x j = 0) :\n dotProduct x (A.mulVec x) ≤ μ * dotProduct x x := by\n rw [real_matrix_quadratic_eq_eigen_coordinates A hA x,\n real_matrix_dotProduct_eq_eigen_coordinates A hA x, Finset.mul_sum]\n apply Finset.sum_le_sum\n intro i _\n by_cases hi : i = j\n · subst i\n simp only [hx, zero_pow (by decide : 2 ≠ 0), mul_zero, le_refl]\n · exact mul_le_mul_of_nonneg_right (hμ i hi) (sq_nonneg _)\ntheorem real_matrix_no_two_orthogonal_supercritical_vectors\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (hA : A.IsHermitian) (μ : ℝ) (j : ι)\n (hμ : ∀ i, i ≠ j → hA.eigenvalues i ≤ μ)\n (x y : ι → ℝ)\n (hxy : dotProduct x y = 0)\n (hxyA : dotProduct x (A.mulVec y) = 0)\n (hx : μ * dotProduct x x < dotProduct x (A.mulVec x))\n (hy : μ * dotProduct y y < dotProduct y (A.mulVec y)) : False := by\n let U : Matrix ι ι ℝ := star (hA.eigenvectorUnitary : Matrix ι ι ℝ)\n let a := U.mulVec x j\n let b := U.mulVec y j\n have hAt : A.transpose = A := by\n simpa only [Matrix.conjTranspose_eq_transpose_of_trivial] using hA.eq\n have hyxA : dotProduct y (A.mulVec x) = 0 := by\n rw [← hAt, Matrix.dotProduct_transpose_mulVec, hxyA]\n have hyx : dotProduct y x = 0 := by rw [dotProduct_comm, hxy]\n by_cases ha : a = 0\n · by_cases hb : b = 0\n · exact (not_lt_of_ge (real_matrix_rayleigh_le_away_from_exception\n A hA μ j hμ x ha)) hx\n · let z := b • x - a • y\n have hz : U.mulVec z j = 0 := by\n simp only [z, Matrix.mulVec_sub, Matrix.mulVec_smul, Pi.sub_apply,\n Pi.smul_apply, smul_eq_mul]\n change b * a - a * b = 0\n ring\n have hbound := real_matrix_rayleigh_le_away_from_exception A hA μ j hμ z hz\n have hq : dotProduct z (A.mulVec z) =\n b ^ 2 * dotProduct x (A.mulVec x) + a ^ 2 * dotProduct y (A.mulVec y) := by\n simp only [z, Matrix.mulVec_sub, Matrix.mulVec_smul, sub_dotProduct,\n dotProduct_sub, smul_dotProduct, dotProduct_smul, smul_eq_mul, hxyA, hyxA]\n ring\n have hn : dotProduct z z = b ^ 2 * dotProduct x x + a ^ 2 * dotProduct y y := by\n simp only [z, sub_dotProduct, dotProduct_sub, smul_dotProduct,\n dotProduct_smul, smul_eq_mul, hxy, hyx]\n ring\n have hs := mul_pos (sq_pos_of_ne_zero hb) (sub_pos.mpr hx)\n rw [hq, hn, ha] at hbound\n simp only [zero_pow (by decide : 2 ≠ 0), zero_mul, add_zero] at hbound\n nlinarith only [hs, hbound]\n · let z := b • x - a • y\n have hz : U.mulVec z j = 0 := by\n simp only [z, Matrix.mulVec_sub, Matrix.mulVec_smul, Pi.sub_apply,\n Pi.smul_apply, smul_eq_mul]\n change b * a - a * b = 0\n ring\n have hbound := real_matrix_rayleigh_le_away_from_exception A hA μ j hμ z hz\n have hq : dotProduct z (A.mulVec z) =\n b ^ 2 * dotProduct x (A.mulVec x) + a ^ 2 * dotProduct y (A.mulVec y) := by\n simp only [z, Matrix.mulVec_sub, Matrix.mulVec_smul, sub_dotProduct,\n dotProduct_sub, smul_dotProduct, dotProduct_smul, smul_eq_mul, hxyA, hyxA]\n ring\n have hn : dotProduct z z = b ^ 2 * dotProduct x x + a ^ 2 * dotProduct y y := by\n simp only [z, sub_dotProduct, dotProduct_sub, smul_dotProduct,\n dotProduct_smul, smul_eq_mul, hxy, hyx]\n ring\n have hs := mul_pos (sq_pos_of_ne_zero ha) (sub_pos.mpr hy)\n have hs' := mul_nonneg (sq_nonneg b) (le_of_lt (sub_pos.mpr hx))\n rw [hq, hn] at hbound\n nlinarith only [hs, hs', hbound]\ntheorem real_matrix_eigen_of_rayleigh_eq\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (hA : A.IsHermitian) (μ : ℝ)\n (hμ : ∀ x, dotProduct x (A.mulVec x) ≤ μ * dotProduct x x)\n (p : ι → ℝ) (hp : dotProduct p (A.mulVec p) = μ * dotProduct p p) :\n A.mulVec p = μ • p := by\n have hB : (μ • (1 : Matrix ι ι ℝ) - A).PosSemidef := by\n apply Matrix.PosSemidef.of_dotProduct_mulVec_nonneg\n ((Matrix.isHermitian_one.smul (by rfl : IsSelfAdjoint μ)).sub hA)\n intro x\n simpa only [star_trivial, Matrix.sub_mulVec, Matrix.smul_mulVec,\n Matrix.one_mulVec, dotProduct_sub, dotProduct_smul, smul_eq_mul,\n sub_nonneg] using hμ x\n have hz : dotProduct (star p) ((μ • (1 : Matrix ι ι ℝ) - A).mulVec p) = 0 := by\n simp only [star_trivial, Matrix.sub_mulVec, Matrix.smul_mulVec,\n Matrix.one_mulVec, dotProduct_sub, dotProduct_smul, smul_eq_mul, hp, sub_self]\n have he := hB.dotProduct_mulVec_zero_iff.mp hz\n simpa only [Matrix.sub_mulVec, Matrix.smul_mulVec, Matrix.one_mulVec,\n sub_eq_zero, eq_comm] using he\ntheorem real_matrix_quadratic_le_abs\n {ι : Type*} [Fintype ι]\n (A : Matrix ι ι ℝ) (hA : ∀ i j, 0 ≤ A i j) (x : ι → ℝ) :\n dotProduct x (A.mulVec x) ≤\n dotProduct (fun i => |x i|) (A.mulVec (fun i => |x i|)) := by\n simp only [dotProduct, Matrix.mulVec, Finset.mul_sum]\n apply Finset.sum_le_sum\n intro i _\n apply Finset.sum_le_sum\n intro j _\n calc\n x i * (A i j * x j) = A i j * (x i * x j) := by ring\n _ ≤ A i j * |x i * x j| := mul_le_mul_of_nonneg_left (le_abs_self _) (hA i j)\n _ = |x i| * (A i j * |x j|) := by rw [abs_mul]; ring\ntheorem real_matrix_nonnegative_top_eigenvector\n {ι : Type*} [Fintype ι] [DecidableEq ι] [Nonempty ι]\n (A : Matrix ι ι ℝ) (hA : A.IsHermitian) (hn : ∀ i j, 0 ≤ A i j) :\n ∃ (ρ : ℝ) (p : ι → ℝ), p ≠ 0 ∧ (∀ i, 0 ≤ p i) ∧\n A.mulVec p = ρ • p ∧\n (∀ x, dotProduct x (A.mulVec x) ≤ ρ * dotProduct x x) := by\n classical\n obtain ⟨i, _, hi⟩ := Finset.exists_max_image Finset.univ hA.eigenvalues Finset.univ_nonempty\n let ρ := hA.eigenvalues i\n let x : ι → ℝ := WithLp.ofLp (hA.eigenvectorBasis i)\n let p : ι → ℝ := fun j => |x j|\n have hx : x ≠ 0 := by\n intro hx\n apply hA.eigenvectorBasis.toBasis.ne_zero i\n apply (WithLp.linearEquiv 2 ℝ (ι → ℝ)).injective\n exact hx\n have hp : p ≠ 0 := by\n intro hp\n apply hx\n funext j\n exact abs_eq_zero.mp (congrFun hp j)\n have hbound := real_matrix_rayleigh_le_of_eigenvalues_le A hA ρ\n (fun j => hi j (Finset.mem_univ j))\n have hnorm : dotProduct p p = dotProduct x x := by\n simp only [dotProduct, p]\n apply Finset.sum_congr rfl\n intro j _\n nlinarith only [sq_abs (x j)]\n have hqx : dotProduct x (A.mulVec x) = ρ * dotProduct x x := by\n rw [hA.mulVec_eigenvectorBasis i]\n exact dotProduct_smul ρ x x\n have heq : dotProduct p (A.mulVec p) = ρ * dotProduct p p := by\n apply le_antisymm (hbound p)\n rw [hnorm, ← hqx]\n exact real_matrix_quadratic_le_abs A hn x\n exact ⟨ρ, p, hp, fun j => abs_nonneg _,\n real_matrix_eigen_of_rayleigh_eq A hA ρ hbound p heq, hbound⟩\ntheorem adjacency_nonnegative_eigenvector_zero_of_zero\n {ι : Type*} [Fintype ι] (G : SimpleGraph ι) [DecidableRel G.Adj]\n (hG : G.Preconnected) (ρ : ℝ) (p : ι → ℝ)\n (hp : ∀ i, 0 ≤ p i) (he : (G.adjMatrix ℝ).mulVec p = ρ • p)\n (u : ι) (hu : p u = 0) : p = 0 := by\n classical\n have hstep {i j : ι} (hij : G.Adj i j) (hi : p i = 0) : p j = 0 := by\n have hsum := congrFun he i\n change (∑ k, G.adjMatrix ℝ i k * p k) = ρ * p i at hsum\n have ht : G.adjMatrix ℝ i j * p j ≤ ∑ k, G.adjMatrix ℝ i k * p k :=\n Finset.single_le_sum (fun k _ => mul_nonneg (by simp only [G.adjMatrix_apply]; split <;> norm_num)\n (hp k)) (Finset.mem_univ j)\n rw [hsum, hi, mul_zero, G.adjMatrix_apply, if_pos hij, one_mul] at ht\n exact le_antisymm ht (hp j)\n have hw {i j : ι} (w : G.Walk i j) : p i = 0 → p j = 0 := by\n induction w with\n | nil => exact id\n | cons h w ih => exact fun hi => ih (hstep h hi)\n funext i\n obtain ⟨w⟩ := hG u i\n exact hw w hu\ntheorem multiplicity_connected_positive_eigenpair\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) [DecidableRel G.Adj] (hG : G.Connected) :\n ∃ (ρ : ℝ) (p : ι → ℝ), (∀ i, 0 < p i) ∧\n (G.adjMatrix ℝ).mulVec p = ρ • p ∧\n (∀ x, dotProduct x ((G.adjMatrix ℝ).mulVec x) ≤ ρ * dotProduct x x) := by\n classical\n letI : Nonempty ι := hG.nonempty\n have hA : (G.adjMatrix ℝ).IsHermitian := by\n change (G.adjMatrix ℝ).conjTranspose = G.adjMatrix ℝ\n rw [Matrix.conjTranspose_eq_transpose_of_trivial, G.transpose_adjMatrix]\n obtain ⟨ρ, p, hpne, hp, he, hb⟩ := real_matrix_nonnegative_top_eigenvector\n (G.adjMatrix ℝ) hA (fun i j => by simp only [G.adjMatrix_apply]; split <;> norm_num)\n refine ⟨ρ, p, ?_, he, hb⟩\n intro i\n apply lt_of_le_of_ne (hp i)\n intro hi\n exact hpne (adjacency_nonnegative_eigenvector_zero_of_zero G hG.preconnected ρ p hp he i hi.symm)\ntheorem adjacency_positive_eigenvector_eigenspace_finrank\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) [DecidableRel G.Adj] (hG : G.Connected)\n (ρ : ℝ) (p : ι → ℝ) (hp : ∀ i, 0 < p i)\n (he : (G.adjMatrix ℝ).mulVec p = ρ • p) :\n Module.finrank ℝ (Module.End.eigenspace (G.adjMatrix ℝ).mulVecLin ρ) = 1 := by\n classical\n letI : Nonempty ι := hG.nonempty\n let E := Module.End.eigenspace (G.adjMatrix ℝ).mulVecLin ρ\n have hpmem : p ∈ E := Module.End.mem_eigenspace_iff.mpr he\n let pE : E := ⟨p, hpmem⟩\n apply finrank_eq_one pE\n · intro h\n have hi := hp (Classical.choice hG.nonempty)\n have hz := congrFun (congrArg Subtype.val h) (Classical.choice hG.nonempty)\n exact (ne_of_gt hi) hz\n · intro x\n obtain ⟨i, _, hi⟩ := Finset.exists_max_image Finset.univ\n (fun j => - (x.val j / p j)) Finset.univ_nonempty\n let c := x.val i / p i\n have hc : ∀ j, c ≤ x.val j / p j := by\n intro j\n dsimp only [c]\n simpa only [neg_le_neg_iff] using hi j (Finset.mem_univ j)\n let z := x.val - c • p\n have hz : ∀ j, 0 ≤ z j := by\n intro j\n change 0 ≤ x.val j - c * p j\n exact sub_nonneg.mpr ((le_div_iff₀ (hp j)).mp (hc j))\n have hex : (G.adjMatrix ℝ).mulVec x.val = ρ • x.val :=\n Module.End.mem_eigenspace_iff.mp x.property\n have hei : (G.adjMatrix ℝ).mulVec z = ρ • z := by\n simp only [z, Matrix.mulVec_sub, Matrix.mulVec_smul, he,\n hex, smul_sub, smul_smul]\n rw [mul_comm c ρ]\n have hzi : z i = 0 := by\n change x.val i - (x.val i / p i) * p i = 0\n rw [div_mul_cancel₀ _ (ne_of_gt (hp i)), sub_self]\n have hzero := adjacency_nonnegative_eigenvector_zero_of_zero G hG.preconnected\n ρ z hz hei i hzi\n refine ⟨c, ?_⟩\n apply Subtype.ext\n exact (sub_eq_zero.mp hzero).symm\ntheorem adjacency_mulVec_eq_neighbor_sum\n {ι : Type*} [Fintype ι] (G : SimpleGraph ι) [DecidableRel G.Adj]\n (p : ι → ℝ) (i : ι) :\n (G.adjMatrix ℝ).mulVec p i = ∑ j ∈ Finset.univ.filter (G.Adj i), p j := by\n classical\n simp only [Matrix.mulVec, dotProduct, G.adjMatrix_apply, Finset.sum_filter,\n ite_mul, one_mul, zero_mul]\ntheorem adjacency_positive_eigenvector_neighbor_le\n {ι : Type*} [Fintype ι] (G : SimpleGraph ι) [DecidableRel G.Adj]\n (ρ : ℝ) (p : ι → ℝ) (hp : ∀ i, 0 ≤ p i)\n (he : (G.adjMatrix ℝ).mulVec p = ρ • p)\n {i j : ι} (hij : G.Adj i j) : p j ≤ ρ * p i := by\n classical\n have h := Finset.single_le_sum (a := j) (s := Finset.univ.filter (G.Adj i))\n (fun k _ => hp k) (by simp [hij])\n rw [← adjacency_mulVec_eq_neighbor_sum G p i, he] at h\n exact h\ntheorem adjacency_positive_eigenvalue_bounds\n {ι : Type*} [Fintype ι] [Nonempty ι]\n (G : SimpleGraph ι) [DecidableRel G.Adj]\n (ρ Δ : ℝ) (p : ι → ℝ) (hp : ∀ i, 0 < p i)\n (he : (G.adjMatrix ℝ).mulVec p = ρ • p)\n (hΔ : ∀ i, ((Finset.univ.filter (G.Adj i)).card : ℝ) ≤ Δ) :\n 0 ≤ ρ ∧ ρ ≤ Δ := by\n classical\n obtain ⟨i, _, hi⟩ := Finset.exists_max_image Finset.univ p Finset.univ_nonempty\n have hsum : ∑ j ∈ Finset.univ.filter (G.Adj i), p j = ρ * p i := by\n rw [← adjacency_mulVec_eq_neighbor_sum G p i, he]\n rfl\n have hnonneg : 0 ≤ ρ * p i := by\n rw [← hsum]\n exact Finset.sum_nonneg fun j _ => le_of_lt (hp j)\n have hle : ρ * p i ≤ Δ * p i := by\n rw [← hsum]\n calc\n (∑ j ∈ Finset.univ.filter (G.Adj i), p j) ≤\n ∑ _j ∈ Finset.univ.filter (G.Adj i), p i :=\n Finset.sum_le_sum fun j _ => hi j (Finset.mem_univ j)\n _ = ((Finset.univ.filter (G.Adj i)).card : ℝ) * p i := by simp\n _ ≤ Δ * p i := mul_le_mul_of_nonneg_right (hΔ i) (le_of_lt (hp i))\n exact ⟨(mul_nonneg_iff_of_pos_right (hp i)).mp hnonneg,\n (mul_le_mul_iff_left₀ (hp i)).mp (by simpa only [mul_comm] using hle)⟩\ntheorem real_matrix_power_entry_mono\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A B : Matrix ι ι ℝ) (hn : ∀ i j, 0 ≤ A i j)\n (hAB : ∀ i j, A i j ≤ B i j) (k : ℕ) :\n ∀ i j, (A ^ k) i j ≤ (B ^ k) i j := by\n induction k with\n | zero => intro i j; exact le_refl _\n | succ k ih =>\n intro i j\n rw [pow_succ, pow_succ, Matrix.mul_apply, Matrix.mul_apply]\n apply Finset.sum_le_sum\n intro l _\n exact mul_le_mul (ih i l) (hAB l j) (hn l j)\n (Matrix.pow_apply_nonneg (fun u v => (hn u v).trans (hAB u v)) k i l)\ntheorem real_matrix_diagonal_power_lower\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (hn : ∀ i j, 0 ≤ A i j)\n (c : ℝ) (hc : 0 ≤ c) (hdiag : ∀ i, c ≤ A i i) (k : ℕ) (i : ι) :\n c ^ k ≤ (A ^ k) i i := by\n induction k with\n | zero => simp\n | succ k ih =>\n rw [pow_succ, pow_succ, Matrix.mul_apply]\n apply le_trans (mul_le_mul ih (hdiag i) hc\n (Matrix.pow_apply_nonneg hn k i i))\n exact Finset.single_le_sum (fun j _ => mul_nonneg\n (Matrix.pow_apply_nonneg hn k i j) (hn j i)) (Finset.mem_univ i)\ntheorem walk_power_entry_lower\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) (A : Matrix ι ι ℝ)\n (hn : ∀ i j, 0 ≤ A i j) (c : ℝ) (hc : 0 ≤ c)\n (hdiag : ∀ i, c ≤ A i i) (hedge : ∀ i j, G.Adj i j → c ≤ A i j)\n {i j : ι} (w : G.Walk i j) (k : ℕ) (hk : w.length ≤ k) :\n c ^ k ≤ (A ^ k) i j := by\n induction w generalizing k with\n | nil => exact real_matrix_diagonal_power_lower A hn c hc hdiag k _\n | @cons i l j h w ih =>\n cases k with\n | zero => simp at hk\n | succ k =>\n have hlen : w.length ≤ k := Nat.succ_le_succ_iff.mp hk\n rw [pow_succ', pow_succ', Matrix.mul_apply]\n apply le_trans (mul_le_mul (hedge i l h) (ih k hlen)\n (pow_nonneg hc k) (hn i l))\n exact Finset.single_le_sum (fun v _ => mul_nonneg (hn i v)\n (Matrix.pow_apply_nonneg hn k v j)) (Finset.mem_univ l)\ntheorem nonnegative_matrix_power_rowsum_bound\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (hn : ∀ i j, 0 ≤ A i j)\n (c : ℝ) (hc : 0 ≤ c) (hrow : ∀ i, (∑ j, A i j) ≤ c) (k : ℕ) :\n ∀ i, (∑ j, (A ^ k) i j) ≤ c ^ k := by\n induction k with\n | zero => intro i; simp [Matrix.one_apply]\n | succ k ih =>\n intro i\n simp only [pow_succ, Matrix.mul_apply]\n rw [Finset.sum_comm]\n simp only [← Finset.mul_sum]\n calc\n (∑ l, (A ^ k) i l * ∑ j, A l j) ≤ ∑ l, (A ^ k) i l * c := Finset.sum_le_sum fun l _ =>\n mul_le_mul_of_nonneg_left (hrow l) (Matrix.pow_apply_nonneg hn k i l)\n _ = (∑ l, (A ^ k) i l) * c := by rw [Finset.sum_mul]\n _ ≤ c ^ k * c := mul_le_mul_of_nonneg_right (ih i) hc\ntheorem nonnegative_matrix_block_power_rowsum_bound\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (hn : ∀ i j, 0 ≤ A i j)\n (c : ℝ) (hc : 0 ≤ c) (r : ℕ)\n (hrow : ∀ i, (∑ j, (A ^ r) i j) ≤ c) (k : ℕ) :\n ∀ i, (∑ j, (A ^ (r * k)) i j) ≤ c ^ k := by\n simpa only [pow_mul] using nonnegative_matrix_power_rowsum_bound (A ^ r)\n (Matrix.pow_apply_nonneg hn r) c hc hrow k\ntheorem killed_matrix_rowsum_bound\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (P K : Matrix ι ι ℝ) (hK : ∀ i j, 0 ≤ K i j)\n (hKP : ∀ i j, K i j ≤ P i j) (hrow : ∀ i, (∑ j, P i j) ≤ 1)\n (r : ℕ) (i d : ι) (c : ℝ)\n (hdead : (K ^ r) i d = 0) (hescape : c ≤ (P ^ r) i d) :\n (∑ j, (K ^ r) i j) ≤ 1 - c := by\n have hmono := real_matrix_power_entry_mono K P hK hKP r\n have hP : ∀ i j, 0 ≤ P i j := fun i j => (hK i j).trans (hKP i j)\n have htotal := nonnegative_matrix_power_rowsum_bound P hP 1 zero_le_one hrow r i\n have hsum : (∑ j, (K ^ r) i j) + c ≤ ∑ j, (P ^ r) i j := by\n have ht : (∑ j, ((K ^ r) i j + (if j = d then c else 0))) ≤ ∑ j, (P ^ r) i j := by\n apply Finset.sum_le_sum\n intro j _\n by_cases hj : j = d\n · subst j\n simpa only [if_pos rfl, if_true, hdead, zero_add] using hescape\n · simpa only [if_neg hj, add_zero] using hmono i j\n simpa only [Finset.sum_add_distrib, Finset.sum_ite_eq', Finset.mem_univ, if_true] using ht\n simp only [one_pow] at htotal\n linarith\ntheorem nonnegative_matrix_local_block_rowsum_bound\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (K : Matrix ι ι ℝ) (hn : ∀ i j, 0 ≤ K i j)\n (c : ℝ) (hc : 0 ≤ c) (r k : ℕ) (i : ι)\n (hrow : ∀ a, a < k → ∀ j, (K ^ (r * a)) i j ≠ 0 →\n (∑ l, (K ^ r) j l) ≤ c) :\n (∑ j, (K ^ (r * k)) i j) ≤ c ^ k := by\n induction k with\n | zero => simp [Matrix.one_apply]\n | succ k ih =>\n have hi := ih (fun a ha => hrow a (Nat.lt_succ_of_lt ha))\n simp only [Nat.mul_succ, pow_add, Matrix.mul_apply, pow_succ]\n rw [Finset.sum_comm]\n simp only [← Finset.mul_sum]\n calc\n (∑ j, (K ^ (r * k)) i j * ∑ l, (K ^ r) j l) ≤\n ∑ j, (K ^ (r * k)) i j * c := by\n apply Finset.sum_le_sum\n intro j _\n by_cases hj : (K ^ (r * k)) i j = 0\n · simp only [hj, zero_mul, le_refl]\n · exact mul_le_mul_of_nonneg_left (hrow k (Nat.lt_succ_self k) j hj)\n (Matrix.pow_apply_nonneg hn (r * k) i j)\n _ = (∑ j, (K ^ (r * k)) i j) * c := by rw [Finset.sum_mul]\n _ ≤ c ^ k * c := mul_le_mul_of_nonneg_right hi hc\ntheorem nonnegative_matrix_diagonal_le_initial_rowsum\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (K : Matrix ι ι ℝ) (hn : ∀ i j, 0 ≤ K i j)\n (hrow : ∀ i, (∑ j, K i j) ≤ 1) (a b : ℕ) (i : ι) :\n (K ^ (a + b)) i i ≤ ∑ j, (K ^ a) i j := by\n rw [pow_add, Matrix.mul_apply]\n apply Finset.sum_le_sum\n intro j _\n have hdiag : (K ^ b) j i ≤ 1 := by\n have ht := nonnegative_matrix_power_rowsum_bound K hn 1 zero_le_one hrow b j\n have he := Finset.single_le_sum (fun l _ => Matrix.pow_apply_nonneg hn b j l)\n (Finset.mem_univ i)\n exact he.trans (by simpa only [one_pow] using ht)\n simpa only [mul_one] using mul_le_mul_of_nonneg_left hdiag\n (Matrix.pow_apply_nonneg hn a i j)\ntheorem real_matrix_normalization_power\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (B P : Matrix ι ι ℝ) (q : ℝ) (p : ι → ℝ) (hp : ∀ i, p i ≠ 0)\n (hP : ∀ i j, q * p i * P i j = B i j * p j) (k : ℕ) :\n ∀ i j, q ^ k * p i * (P ^ k) i j = (B ^ k) i j * p j := by\n induction k with\n | zero =>\n intro i j\n by_cases hij : i = j\n · subst j; simp [Matrix.one_apply]\n · simp [Matrix.one_apply, hij]\n | succ k ih =>\n intro i j\n simp only [pow_succ, Matrix.mul_apply, Finset.mul_sum, Finset.sum_mul]\n apply Finset.sum_congr rfl\n intro l _\n apply mul_left_cancel₀ (hp l)\n calc\n p l * (q ^ k * q * p i * ((P ^ k) i l * P l j)) =\n (q ^ k * p i * (P ^ k) i l) * (q * p l * P l j) := by ring\n _ = ((B ^ k) i l * p l) * (B l j * p j) := by rw [ih, hP]\n _ = p l * (((B ^ k) i l * B l j) * p j) := by ring\ntheorem real_matrix_normalization_power_diagonal\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (B P : Matrix ι ι ℝ) (q : ℝ) (p : ι → ℝ) (hp : ∀ i, p i ≠ 0)\n (hP : ∀ i j, q * p i * P i j = B i j * p j) (k : ℕ) (i : ι) :\n q ^ k * (P ^ k) i i = (B ^ k) i i := by\n have h := real_matrix_normalization_power B P q p hp hP k i i\n apply mul_right_cancel₀ (hp i)\n convert h using 1 <;> ring\ntheorem real_matrix_normalization_rowsum\n {ι : Type*} [Fintype ι]\n (B P : Matrix ι ι ℝ) (q : ℝ) (hq : q ≠ 0)\n (p : ι → ℝ) (hp : ∀ i, p i ≠ 0)\n (he : B.mulVec p = q • p)\n (hP : ∀ i j, q * p i * P i j = B i j * p j) :\n ∀ i, ∑ j, P i j = 1 := by\n intro i\n apply mul_left_cancel₀ (mul_ne_zero hq (hp i))\n rw [Finset.mul_sum]\n simp_rw [hP]\n have h := congrFun he i\n change (∑ j, B i j * p j) = q * p i at h\n simpa only [mul_one] using h\ntheorem real_matrix_local_survival_diagonal_bound\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (P K : Matrix ι ι ℝ) (hn : ∀ i j, 0 ≤ K i j)\n (hKP : ∀ i j, K i j ≤ P i j)\n (hrow : ∀ i, (∑ j, P i j) ≤ 1)\n (c : ℝ) (hc : 0 ≤ 1 - c) (r k b : ℕ) (i : ι)\n (hescape : ∀ a, a < k → ∀ j, (K ^ (r * a)) i j ≠ 0 →\n ∃ d, (K ^ r) j d = 0 ∧ c ≤ (P ^ r) j d) :\n (K ^ (r * k + b)) i i ≤ (1 - c) ^ k := by\n have hKrow : ∀ i, (∑ j, K i j) ≤ 1 := by\n intro i\n exact (Finset.sum_le_sum fun j _ => hKP i j).trans (hrow i)\n apply (nonnegative_matrix_diagonal_le_initial_rowsum K hn hKrow (r * k) b i).trans\n apply nonnegative_matrix_local_block_rowsum_bound K hn (1 - c) hc r k i\n intro a ha j hj\n obtain ⟨d, hd, he⟩ := hescape a ha j hj\n exact killed_matrix_rowsum_bound P K hn hKP hrow r j d c hd he\ntheorem adjacency_positive_eigenvector_edge_transition_lower\n {ι : Type*} [Fintype ι] (G : SimpleGraph ι) [DecidableRel G.Adj]\n (ρ Δ : ℝ) (p : ι → ℝ) (hp : ∀ i, 0 < p i)\n (he : (G.adjMatrix ℝ).mulVec p = ρ • p)\n (hρ : 0 ≤ ρ) (hΔ : ρ ≤ Δ) (hΔpos : 0 ≤ Δ)\n {i j : ι} (hij : G.Adj i j) :\n 1 / (Δ + 1) ^ 2 ≤ p j / ((ρ + 1) * p i) := by\n have hi : p i ≤ ρ * p j := adjacency_positive_eigenvector_neighbor_le G ρ p\n (fun i => le_of_lt (hp i)) he hij.symm\n have hnum : (ρ + 1) * p i ≤ (Δ + 1) ^ 2 * p j := by\n calc\n (ρ + 1) * p i ≤ (Δ + 1) * (Δ * p j) :=\n mul_le_mul (by linarith : ρ + 1 ≤ Δ + 1)\n (hi.trans (mul_le_mul_of_nonneg_right hΔ (le_of_lt (hp j))))\n (le_of_lt (hp i)) (by linarith)\n _ ≤ (Δ + 1) ^ 2 * p j := by\n nlinarith [hp j]\n rw [le_div_iff₀ (mul_pos (by linarith) (hp i))]\n rw [div_mul_eq_mul_div, div_le_iff₀ (sq_pos_of_pos (by linarith : 0 < Δ + 1))]\n nlinarith only [hnum]\ntheorem adjacency_positive_eigenvector_diagonal_transition_lower\n (ρ Δ : ℝ) (hρ : 0 ≤ ρ) (hΔ : ρ ≤ Δ) :\n 1 / (Δ + 1) ^ 2 ≤ 1 / (ρ + 1) := by\n have hΔ0 : 0 ≤ Δ := hρ.trans hΔ\n apply one_div_le_one_div_of_le (by linarith : 0 < ρ + 1)\n nlinarith\nnoncomputable def multiplicityTransition\n {ι : Type*} (B : Matrix ι ι ℝ) (q : ℝ) (p : ι → ℝ) : Matrix ι ι ℝ :=\n fun i j => B i j * p j / (q * p i)\ntheorem multiplicityTransition_normalization\n {ι : Type*} (B : Matrix ι ι ℝ) (q : ℝ) (hq : q ≠ 0)\n (p : ι → ℝ) (hp : ∀ i, p i ≠ 0) (i j : ι) :\n q * p i * multiplicityTransition B q p i j = B i j * p j := by\n dsimp only [multiplicityTransition]\n exact mul_div_cancel₀ _ (mul_ne_zero hq (hp i))\nnoncomputable def multiplicityKilled\n {ι : Type*} (P : Matrix ι ι ℝ) (s : Set ι) : Matrix ι ι ℝ := by\n classical\n exact fun i j => if j ∈ s then 0 else P i j\ntheorem multiplicityKilled_power_dead_column\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (P : Matrix ι ι ℝ) (s : Set ι) (r : ℕ) (hr : 0 < r)\n (i d : ι) (hd : d ∈ s) :\n (multiplicityKilled P s ^ r) i d = 0 := by\n classical\n have hcol : (multiplicityKilled P s ^ 1).col d = 0 := by\n ext j\n simp [multiplicityKilled, hd]\n exact congrFun (Matrix.pow_col_eq_zero_of_le hcol hr) i\ntheorem connected_graph_sparse_walk_net\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) (hG : G.Connected) (r : ℕ) (hr : 0 < r) :\n ∃ s : Finset ι, s.card ≤ Fintype.card ι / r + 1 ∧\n ∀ v, ∃ d ∈ s, ∃ w : G.Walk v d, w.length ≤ r := by\n classical\n let u : ι := Classical.choice hG.nonempty\n obtain ⟨k, hk, hcard⟩ := Finset.exists_card_fiber_lt_of_card_lt_mul\n (s := (Finset.univ : Finset ι)) (t := Finset.range r)\n (f := fun v => G.dist u v % r)\n (by simpa using Nat.lt_mul_div_succ (Fintype.card ι) hr)\n have hkr : k < r := Finset.mem_range.mp hk\n let s : Finset ι := insert u (Finset.univ.filter fun v => G.dist u v % r = k)\n refine ⟨s, ?_, ?_⟩\n · exact (Finset.card_insert_le _ _).trans (by simpa using hcard)\n · intro v\n obtain ⟨w, hw⟩ := hG.exists_walk_length_eq_dist u v\n by_cases hv : G.dist u v < k\n · refine ⟨u, Finset.mem_insert_self _ _, w.reverse, ?_⟩\n rw [w.length_reverse, hw]\n omega\n · let t := G.dist u v - (G.dist u v - k) % r\n have ht : t ≤ w.length := by dsimp only [t]; omega\n have htmod : t % r = k := by\n have hmod := Nat.mod_lt (G.dist u v - k) hr\n have hdiv := Nat.mod_add_div (G.dist u v - k) r\n have he : t = k + r * ((G.dist u v - k) / r) := by dsimp only [t]; omega\n rw [he, Nat.add_mul_mod_self_left, Nat.mod_eq_of_lt hkr]\n have hdist : G.dist u (w.getVert t) = t := by\n have h := G.length_eq_dist_of_subwalk hw (w.isSubwalk_take t)\n rw [w.take_length, Nat.min_eq_left ht] at h\n exact h.symm\n refine ⟨w.getVert t, Finset.mem_insert_of_mem (by simp [hdist, htmod]),\n (w.drop t).reverse, ?_⟩\n rw [(w.drop t).length_reverse, w.drop_length, hw]\n have hmod := Nat.mod_lt (G.dist u v - k) hr\n dsimp only [t]\n omega\ntheorem connected_graph_closed_ball_connected\n {ι : Type*} (G : SimpleGraph ι) (hG : G.Connected) (o : ι) (R : ℕ) :\n (G.induce {v | G.dist o v ≤ R}).Connected := by\n rw [SimpleGraph.connected_iff_exists_forall_reachable]\n refine ⟨⟨o, by simp⟩, ?_⟩\n rintro ⟨v, hv⟩\n obtain ⟨w, hw⟩ := hG.exists_walk_length_eq_dist o v\n have hsupport : ∀ u ∈ w.support, G.dist o u ≤ R := by\n intro u hu\n obtain ⟨t, he, ht⟩ := (SimpleGraph.Walk.mem_support_iff_exists_getVert).mp hu\n have hdist := G.dist_le (w.take t)\n rw [w.take_length, he] at hdist\n exact hdist.trans ((Nat.min_le_right _ _).trans (hw ▸ hv))\n exact ⟨w.induce _ hsupport⟩\ntheorem adjacency_add_one_nonnegative\n {ι : Type*} [DecidableEq ι] (G : SimpleGraph ι) [DecidableRel G.Adj] :\n ∀ i j, 0 ≤ (G.adjMatrix ℝ + 1) i j := by\n intro i j\n exact add_nonneg (by simp [SimpleGraph.adjMatrix_apply]; split <;> norm_num)\n (by simp [Matrix.one_apply]; split <;> norm_num)\ntheorem adjacency_add_one_rowsum_bound\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) [DecidableRel G.Adj] (Δ : ℕ)\n (hΔ : ∀ i, ({j | G.Adj i j} : Set ι).ncard ≤ Δ) :\n ∀ i, (∑ j, (G.adjMatrix ℝ + 1) i j) ≤ (Δ : ℝ) + 1 := by\n intro i\n simp only [Matrix.add_apply, Finset.sum_add_distrib]\n have hcard : (Finset.univ.filter (G.Adj i)).card ≤ Δ := by\n simpa only [Set.ncard_eq_toFinset_card', Set.toFinset_setOf] using hΔ i\n have hsum : (∑ j, G.adjMatrix ℝ i j) =\n ((Finset.univ.filter (G.Adj i)).card : ℝ) := by\n simp [SimpleGraph.adjMatrix_apply, Finset.sum_boole]\n rw [hsum]\n simpa [Matrix.one_apply] using (by exact_mod_cast Nat.add_le_add_right hcard 1 :\n ((Finset.univ.filter (G.Adj i)).card : ℝ) + 1 ≤ (Δ : ℝ) + 1)\ntheorem connected_graph_closed_ball_card_bound\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) (hG : G.Connected) (Δ : ℕ)\n (hΔ : ∀ i, ({j | G.Adj i j} : Set ι).ncard ≤ Δ) (o : ι) (R : ℕ) :\n ({v | G.dist o v ≤ R} : Set ι).ncard ≤ (Δ + 1) ^ R := by\n classical\n let B := G.adjMatrix ℝ + 1\n have hn : ∀ i j, 0 ≤ B i j := adjacency_add_one_nonnegative G\n have hrow := nonnegative_matrix_power_rowsum_bound B hn ((Δ : ℝ) + 1)\n (by positivity) (adjacency_add_one_rowsum_bound G Δ hΔ) R o\n have he : ∀ v, G.dist o v ≤ R → 1 ≤ (B ^ R) o v := by\n intro v hv\n obtain ⟨w, hw⟩ := hG.exists_walk_length_eq_dist o v\n simpa only [one_pow] using walk_power_entry_lower G B hn 1 (by norm_num)\n (by intro i; simp [B])\n (by intro i j hij; simp [B, SimpleGraph.adjMatrix_apply, hij, Matrix.one_apply]; split <;> norm_num) w R (hw ▸ hv)\n have hcard : ((Finset.univ.filter fun v => G.dist o v ≤ R).card : ℝ) ≤\n ((Δ : ℝ) + 1) ^ R := by\n calc\n _ = ∑ v ∈ Finset.univ.filter (fun v => G.dist o v ≤ R), (1 : ℝ) := by simp\n _ ≤ ∑ v ∈ Finset.univ.filter (fun v => G.dist o v ≤ R), (B ^ R) o v :=\n Finset.sum_le_sum fun v hv => he v (Finset.mem_filter.mp hv).2\n _ ≤ ∑ v, (B ^ R) o v := Finset.sum_le_sum_of_subset_of_nonneg\n (Finset.filter_subset _ _) (fun v _ _ => Matrix.pow_apply_nonneg hn R o v)\n _ ≤ _ := hrow\n have hnat : (Finset.univ.filter fun v => G.dist o v ≤ R).card ≤ (Δ + 1) ^ R := by\n exact_mod_cast hcard\n simpa only [Set.ncard_eq_toFinset_card', Set.toFinset_setOf] using hnat\nnoncomputable def multiplicityExtend\n {ι : Type*} (s : Set ι) (x : s → ℝ) : ι → ℝ := by\n classical\n exact fun i => if hi : i ∈ s then x ⟨i, hi⟩ else 0\ntheorem multiplicityExtend_sum\n {ι : Type*} [Fintype ι] (s : Set ι) [Fintype s] (f : ι → ℝ)\n (hf : ∀ i, i ∉ s → f i = 0) :\n (∑ i, f i) = ∑ i : s, f i.val := by\n classical\n rw [← Finset.sum_subtype (Finset.univ.filter fun i => i ∈ s)\n (by intro i; simp) f, Finset.sum_filter]\n apply Finset.sum_congr rfl\n intro i _\n by_cases hi : i ∈ s <;> simp [hi, hf]\ntheorem multiplicityExtend_dotProduct\n {ι : Type*} [Fintype ι] (s : Set ι) [Fintype s] (x y : s → ℝ) :\n dotProduct (multiplicityExtend s x) (multiplicityExtend s y) = dotProduct x y := by\n classical\n rw [dotProduct, multiplicityExtend_sum s _ (by\n intro i hi; simp [multiplicityExtend, hi])]\n simp [multiplicityExtend, dotProduct]\ntheorem multiplicityExtend_quadratic\n {ι : Type*} [Fintype ι] (A : Matrix ι ι ℝ) (s : Set ι) [Fintype s] (x : s → ℝ) :\n dotProduct (multiplicityExtend s x) (A.mulVec (multiplicityExtend s x)) =\n dotProduct x ((A.submatrix Subtype.val Subtype.val).mulVec x) := by\n classical\n rw [dotProduct, multiplicityExtend_sum s _ (by\n intro i hi; simp [multiplicityExtend, hi])]\n apply Finset.sum_congr rfl\n intro i _\n simp only [multiplicityExtend, dif_pos i.property]\n congr 1\n rw [Matrix.mulVec, dotProduct, multiplicityExtend_sum s _ (by\n intro j hj; simp [multiplicityExtend, hj])]\n simp [multiplicityExtend, Matrix.mulVec, dotProduct, Matrix.submatrix]\ntheorem multiplicityExtend_cross_zero\n {ι : Type*} [Fintype ι] (A : Matrix ι ι ℝ) (s t : Set ι)\n (x : s → ℝ) (y : t → ℝ)\n (hcross : ∀ i ∈ s, ∀ j ∈ t, A i j = 0) :\n dotProduct (multiplicityExtend s x) (A.mulVec (multiplicityExtend t y)) = 0 := by\n classical\n rw [dotProduct]\n apply Finset.sum_eq_zero\n intro i _\n by_cases hi : i ∈ s\n · have hinner : A.mulVec (multiplicityExtend t y) i = 0 := by\n rw [Matrix.mulVec, dotProduct]\n apply Finset.sum_eq_zero\n intro j _\n by_cases hj : j ∈ t\n · simp [hcross i hi j hj]\n · simp [multiplicityExtend, hj]\n simp [hinner]\n · simp [multiplicityExtend, hi]\ntheorem real_matrix_separated_supercritical_principal_impossible\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (hA : A.IsHermitian) (μ : ℝ) (j : ι)\n (hμ : ∀ i, i ≠ j → hA.eigenvalues i ≤ μ)\n (s t : Set ι) [Fintype s] [Fintype t] (hst : Disjoint s t)\n (hcross : ∀ i ∈ s, ∀ j ∈ t, A i j = 0)\n (x : s → ℝ) (y : t → ℝ)\n (hx : μ * dotProduct x x <\n dotProduct x ((A.submatrix Subtype.val Subtype.val).mulVec x))\n (hy : μ * dotProduct y y <\n dotProduct y ((A.submatrix Subtype.val Subtype.val).mulVec y)) : False := by\n classical\n apply real_matrix_no_two_orthogonal_supercritical_vectors A hA μ j hμ\n (multiplicityExtend s x) (multiplicityExtend t y)\n · rw [dotProduct]\n apply Finset.sum_eq_zero\n intro i _\n by_cases hi : i ∈ s\n · have ht : i ∉ t := fun ht => Set.disjoint_left.mp hst hi ht\n simp [multiplicityExtend, ht]\n · simp [multiplicityExtend, hi]\n · exact multiplicityExtend_cross_zero A s t x y hcross\n · simpa only [multiplicityExtend_dotProduct, multiplicityExtend_quadratic] using hx\n · simpa only [multiplicityExtend_dotProduct, multiplicityExtend_quadratic] using hy\ntheorem induced_graph_degree_bound\n {ι : Type*} [Fintype ι] (G : SimpleGraph ι) (s : Set ι) (Δ : ℕ)\n (hΔ : ∀ i, ({j | G.Adj i j} : Set ι).ncard ≤ Δ) :\n ∀ i : s, ({j | (G.induce s).Adj i j} : Set s).ncard ≤ Δ := by\n intro i\n apply le_trans _ (hΔ i.val)\n exact Set.ncard_le_ncard_of_injOn Subtype.val (fun j hj => hj)\n (fun x _ y _ h => Subtype.ext h)\ntheorem graph_separated_supported_vectors_cross_zero\n {ι : Type*} [Fintype ι] (G : SimpleGraph ι) [DecidableRel G.Adj]\n (s t : Set ι) (x y : ι → ℝ)\n (hx : ∀ i, i ∉ s → x i = 0) (hy : ∀ j, j ∉ t → y j = 0)\n (hst : Disjoint s t) (hcross : ∀ i ∈ s, ∀ j ∈ t, ¬ G.Adj i j) :\n dotProduct x y = 0 ∧ dotProduct x ((G.adjMatrix ℝ).mulVec y) = 0 := by\n classical\n constructor\n · apply Finset.sum_eq_zero\n intro i _\n by_cases hi : i ∈ s\n · simp [hy i (fun ht => Set.disjoint_left.mp hst hi ht)]\n · simp [hx i hi]\n · apply Finset.sum_eq_zero\n intro i _\n by_cases hi : i ∈ s\n · have hz : (G.adjMatrix ℝ).mulVec y i = 0 := by\n apply Finset.sum_eq_zero\n intro j _\n by_cases hj : j ∈ t\n · simp [SimpleGraph.adjMatrix_apply, hcross i hi j hj]\n · simp [hy j hj]\n simp [hz]\n · simp [hx i hi]\ntheorem graph_uniform_local_rayleigh_bound\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) [DecidableRel G.Adj] (hG : G.Connected)\n (Δ : ℕ) (hΔ : ∀ i, ({j | G.Adj i j} : Set ι).ncard ≤ Δ)\n (μ : ℝ) (hA : (G.adjMatrix ℝ).IsHermitian)\n (j : ι) (hμ : ∀ i, i ≠ j → hA.eigenvalues i ≤ μ) (R : ℕ) :\n ∃ b : Finset ι, b.card ≤ (Δ + 1) ^ (2 * R + 1) ∧\n ∀ v ∉ b, ∀ x : ι → ℝ,\n (∀ i, R < G.dist v i → x i = 0) →\n dotProduct x ((G.adjMatrix ℝ).mulVec x) ≤ μ * dotProduct x x := by\n classical\n by_cases hex : ∃ o, ∃ x : ι → ℝ,\n (∀ i, R < G.dist o i → x i = 0) ∧\n μ * dotProduct x x < dotProduct x ((G.adjMatrix ℝ).mulVec x)\n · obtain ⟨o, x, hx, hxq⟩ := hex\n let b := Finset.univ.filter fun v => G.dist o v ≤ 2 * R + 1\n refine ⟨b, ?_, ?_⟩\n · simpa only [b, Set.ncard_eq_toFinset_card', Set.toFinset_ofPred] using\n connected_graph_closed_ball_card_bound G hG Δ hΔ o (2 * R + 1)\n · intro v hv y hy\n by_contra! hyq\n have hd : 2 * R + 1 < G.dist o v := by simpa [b] using hv\n have hst : Disjoint {i | G.dist o i ≤ R} {i | G.dist v i ≤ R} := by\n apply Set.disjoint_left.mpr\n intro i hi hj\n change G.dist o i ≤ R at hi\n change G.dist v i ≤ R at hj\n have ht := hG.dist_triangle (u := o) (v := i) (w := v)\n rw [G.dist_comm (u := i) (v := v)] at ht\n omega\n have hcross : ∀ i ∈ ({i | G.dist o i ≤ R} : Set ι),\n ∀ l ∈ ({l | G.dist v l ≤ R} : Set ι), ¬ G.Adj i l := by\n intro i hi l hl hil\n change G.dist o i ≤ R at hi\n change G.dist v l ≤ R at hl\n have h1 := hG.dist_triangle (u := o) (v := i) (w := l)\n have h2 := hG.dist_triangle (u := o) (v := l) (w := v)\n rw [G.dist_comm (u := l) (v := v)] at h2\n rw [SimpleGraph.dist_eq_one_iff_adj.mpr hil] at h1\n omega\n obtain ⟨hxy, hxyA⟩ := graph_separated_supported_vectors_cross_zero G\n {i | G.dist o i ≤ R} {i | G.dist v i ≤ R} x y\n (by intro i hi; exact hx i (by simpa using hi))\n (by intro i hi; exact hy i (by simpa using hi)) hst hcross\n exact real_matrix_no_two_orthogonal_supercritical_vectors\n (G.adjMatrix ℝ) hA μ j hμ x y hxy hxyA hxq hyq\n · refine ⟨∅, by simp, ?_⟩\n intro v _ x hx\n exact le_of_not_gt fun h => hex ⟨v, x, hx, h⟩\ntheorem graph_matrix_power_support_distance\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) (hG : G.Connected) (M : Matrix ι ι ℝ)\n (hs : ∀ i j, M i j ≠ 0 → i = j ∨ G.Adj i j) (k : ℕ) :\n ∀ i j, (M ^ k) i j ≠ 0 → G.dist i j ≤ k := by\n induction k with\n | zero =>\n intro i j hij\n have he : i = j := by\n by_contra hne\n exact hij (by simp [Matrix.one_apply, hne])\n subst j\n simp\n | succ k ih =>\n intro i j hij\n have hex : ∃ l, (M ^ k) i l ≠ 0 ∧ M l j ≠ 0 := by\n by_contra! h\n apply hij\n rw [pow_succ, Matrix.mul_apply]\n exact Finset.sum_eq_zero fun l _ => by\n by_cases hl : (M ^ k) i l = 0\n · simp [hl]\n · simp [h l hl]\n obtain ⟨l, hl, hlj⟩ := hex\n have hd := ih i l hl\n rcases hs l j hlj with he | he\n · subst j; omega\n · have ht := hG.dist_triangle (u := i) (v := l) (w := j)\n rw [SimpleGraph.dist_eq_one_iff_adj.mpr he] at ht\n omega\ntheorem graph_matrix_power_closed_ball_locality\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) (hG : G.Connected) (M : Matrix ι ι ℝ)\n (hs : ∀ i j, M i j ≠ 0 → i = j ∨ G.Adj i j)\n (o : ι) (R : ℕ) [Fintype {v // G.dist o v ≤ R}]\n [DecidableEq {v // G.dist o v ≤ R}] (k : ℕ) :\n ∀ (i j : {v // G.dist o v ≤ R}), G.dist o i.val + k ≤ R →\n (M ^ k) i.val j.val =\n ((M.submatrix (fun v : {v // G.dist o v ≤ R} => v.val) Subtype.val) ^ k) i j := by\n classical\n induction k with\n | zero =>\n intro i j _\n by_cases he : i = j\n · subst j; simp\n · have hval : i.val ≠ j.val := fun h => he (Subtype.ext h)\n simp [Matrix.one_apply, he, hval]\n | succ k ih =>\n intro i j hi\n rw [pow_succ', pow_succ', Matrix.mul_apply, Matrix.mul_apply]\n have hz : ∀ v, v ∉ ({v | G.dist o v ≤ R} : Set ι) →\n M i.val v * (M ^ k) v j.val = 0 := by\n intro v hv\n have hzero : M i.val v = 0 := by\n by_contra hz\n have hdist : G.dist o v ≤ G.dist o i.val + 1 := by\n rcases hs i.val v hz with he | he\n · rw [← he]; omega\n · have ht := hG.dist_triangle (u := o) (v := i.val) (w := v)\n rw [SimpleGraph.dist_eq_one_iff_adj.mpr he] at ht\n exact ht\n have hvr : R < G.dist o v := by simpa using hv\n omega\n simp [hzero]\n rw [@multiplicityExtend_sum ι _ {v | G.dist o v ≤ R}\n (inferInstance : Fintype {v // G.dist o v ≤ R}) _ hz]\n change (∑ l : {v // G.dist o v ≤ R}, M i.val l.val * (M ^ k) l.val j.val) =\n ∑ l : {v // G.dist o v ≤ R}, M i.val l.val *\n ((M.submatrix (fun v : {v // G.dist o v ≤ R} => v.val) Subtype.val) ^ k) l j\n apply Finset.sum_congr rfl\n intro l _\n by_cases hl : M i.val l.val = 0\n · simp [Matrix.submatrix, hl]\n · have hdist : G.dist o l.val ≤ G.dist o i.val + 1 := by\n rcases hs i.val l.val hl with he | he\n · rw [← he]; omega\n · have ht := hG.dist_triangle (u := o) (v := i.val) (w := l.val)\n rw [SimpleGraph.dist_eq_one_iff_adj.mpr he] at ht\n exact ht\n rw [ih l j (by omega)]\ntheorem multiplicityKilled_principal_power\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (B : Matrix ι ι ℝ) (s : Set ι) [Fintype {i // i ∉ s}]\n [DecidableEq {i // i ∉ s}] (k : ℕ) :\n ∀ (i j : {i // i ∉ s}),\n (multiplicityKilled B s ^ k) i.val j.val =\n ((B.submatrix (fun i : {i // i ∉ s} => i.val) Subtype.val) ^ k) i j := by\n classical\n induction k with\n | zero =>\n intro i j\n by_cases he : i = j\n · subst j; simp\n · have hval : i.val ≠ j.val := fun h => he (Subtype.ext h)\n simp [Matrix.one_apply, he, hval]\n | succ k ih =>\n intro i j\n rw [pow_succ', pow_succ', Matrix.mul_apply, Matrix.mul_apply]\n rw [@multiplicityExtend_sum ι _ {i | i ∉ s}\n (inferInstance : Fintype {i // i ∉ s}) _ (by\n intro l hl\n have hls : l ∈ s := by simpa using hl\n simp [multiplicityKilled, hls])]\n change (∑ l : {i // i ∉ s}, multiplicityKilled B s i.val l.val *\n (multiplicityKilled B s ^ k) l.val j.val) =\n ∑ l : {i // i ∉ s}, B i.val l.val *\n ((B.submatrix (fun i : {i // i ∉ s} => i.val) Subtype.val) ^ k) l j\n apply Finset.sum_congr rfl\n intro l _\n simp only [multiplicityKilled, if_neg l.property, Matrix.submatrix_apply, ih]\ntheorem real_matrix_eigenspace_shift_one\n {ι : Type*} [Fintype ι] [DecidableEq ι] (A : Matrix ι ι ℝ) (μ : ℝ) :\n Module.End.eigenspace (A + 1).mulVecLin (μ + 1) =\n Module.End.eigenspace A.mulVecLin μ := by\n ext x\n simp only [Module.End.mem_eigenspace_iff]\n change (A + 1).mulVec x = (μ + 1) • x ↔ A.mulVec x = μ • x\n rw [Matrix.add_mulVec, Matrix.one_mulVec, add_smul, one_smul]\n exact add_left_inj x\ntheorem graph_killed_shifted_diagonal_bound\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) [DecidableRel G.Adj] (hG : G.Connected)\n (ρ : ℝ) (Δ : ℕ) (p : ι → ℝ) (hp : ∀ i, 0 < p i)\n (he : (G.adjMatrix ℝ).mulVec p = ρ • p) (hρ : 0 ≤ ρ) (hΔ : ρ ≤ Δ)\n (s : Set ι) (r k : ℕ) (hr : 0 < r) (o : ι)\n (hnet : ∀ a, a < k → ∀ j, G.dist o j ≤ r * a →\n ∃ d ∈ s, ∃ w : G.Walk j d, w.length ≤ r) :\n (multiplicityKilled (G.adjMatrix ℝ + 1) s ^ (r * k)) o o ≤\n (ρ + 1) ^ (r * k) * (1 - (1 / ((Δ : ℝ) + 1) ^ 2) ^ r) ^ k := by\n classical\n let B := G.adjMatrix ℝ + 1\n let P := multiplicityTransition B (ρ + 1) p\n let K := multiplicityKilled P s\n let δ : ℝ := 1 / ((Δ : ℝ) + 1) ^ 2\n have hδ : 0 ≤ δ ∧ δ ≤ 1 := by\n dsimp only [δ]\n constructor\n · positivity\n · rw [div_le_one (by positivity : 0 < ((Δ : ℝ) + 1) ^ 2)]\n nlinarith [Nat.cast_nonneg (α := ℝ) Δ]\n have hnB : ∀ i j, 0 ≤ B i j := adjacency_add_one_nonnegative G\n have hnP : ∀ i j, 0 ≤ P i j := fun i j => div_nonneg\n (mul_nonneg (hnB i j) (le_of_lt (hp j)))\n (le_of_lt (mul_pos (by linarith : 0 < ρ + 1) (hp i)))\n have hnK : ∀ i j, 0 ≤ K i j := by\n intro i j; dsimp only [K, multiplicityKilled]; split <;> simp_all\n have hKP : ∀ i j, K i j ≤ P i j := by\n intro i j; dsimp only [K, multiplicityKilled]; split <;> simp_all\n have hP := multiplicityTransition_normalization B (ρ + 1) (by linarith) p\n (fun i => ne_of_gt (hp i))\n have heB : B.mulVec p = (ρ + 1) • p := by\n simp only [B, Matrix.add_mulVec, Matrix.one_mulVec, he, add_smul, one_smul]\n have hrow : ∀ i, (∑ j, P i j) ≤ 1 := by\n intro i\n exact le_of_eq (real_matrix_normalization_rowsum B P (ρ + 1) (by linarith) p\n (fun i => ne_of_gt (hp i)) heB hP i)\n have hedge : ∀ i j, G.Adj i j → δ ≤ P i j := by\n intro i j hij\n have hne : i ≠ j := hij.ne\n simpa [P, multiplicityTransition, B, Matrix.one_apply, hne,\n SimpleGraph.adjMatrix_apply, hij, δ] using\n adjacency_positive_eigenvector_edge_transition_lower G ρ Δ p hp he hρ hΔ\n (Nat.cast_nonneg Δ) hij\n have hdiag : ∀ i, δ ≤ P i i := by\n intro i\n simpa [P, multiplicityTransition, B, δ, mul_comm,\n div_mul_eq_div_mul_one_div, ne_of_gt (hp i)] using\n adjacency_positive_eigenvector_diagonal_transition_lower ρ Δ hρ hΔ\n have hstep : ∀ i j, K i j ≠ 0 → i = j ∨ G.Adj i j := by\n intro i j hij\n by_contra! h\n apply hij\n simp [K, multiplicityKilled, P, multiplicityTransition, B,\n SimpleGraph.adjMatrix_apply, Matrix.one_apply, h.1, h.2]\n have hescape : ∀ a, a < k → ∀ j, (K ^ (r * a)) o j ≠ 0 →\n ∃ d, (K ^ r) j d = 0 ∧ δ ^ r ≤ (P ^ r) j d := by\n intro a ha j hj\n have hd := graph_matrix_power_support_distance G hG K hstep (r * a) o j hj\n obtain ⟨d, hds, w, hw⟩ := hnet a ha j hd\n exact ⟨d, multiplicityKilled_power_dead_column P s r hr j d hds,\n walk_power_entry_lower G P hnP δ hδ.1 hdiag hedge w r hw⟩\n have hbound := real_matrix_local_survival_diagonal_bound P K hnK hKP hrow\n (δ ^ r) (sub_nonneg.mpr (pow_le_one₀ hδ.1 hδ.2)) r k 0 o hescape\n have hnorm : ∀ i j, (ρ + 1) * p i * K i j =\n multiplicityKilled B s i j * p j := by\n intro i j\n by_cases hj : j ∈ s\n · simp [K, multiplicityKilled, hj]\n · simpa only [K, multiplicityKilled, if_neg hj] using hP i j\n rw [← real_matrix_normalization_power_diagonal (multiplicityKilled B s) K\n (ρ + 1) p (fun i => ne_of_gt (hp i)) hnorm (r * k) o]\n exact mul_le_mul_of_nonneg_left (by simpa only [δ, Nat.add_zero] using hbound) (by positivity)\ntheorem graph_walk_support_distance_bound\n {ι : Type*} (G : SimpleGraph ι) (hG : G.Connected) (o : ι)\n {i j : ι} (w : G.Walk i j) :\n ∀ u ∈ w.support, G.dist o u ≤ G.dist o i + w.length := by\n intro u hu\n obtain ⟨t, he, ht⟩ := SimpleGraph.Walk.mem_support_iff_exists_getVert.mp hu\n have hdist := G.dist_le (w.take t)\n rw [w.take_length, he] at hdist\n exact (hG.dist_triangle (u := o) (v := i) (w := u)).trans\n (Nat.add_le_add_left (hdist.trans (Nat.min_le_right _ _)) _)\ntheorem graph_walk_induce_length\n {ι : Type*} (G : SimpleGraph ι) (s : Set ι)\n {i j : ι} (w : G.Walk i j) (hw : ∀ u ∈ w.support, u ∈ s) :\n (w.induce s hw).length = w.length := by\n induction w with\n | nil => rfl\n | cons h w ih => simp only [SimpleGraph.Walk.induce_cons,\n SimpleGraph.Walk.length_cons, ih]\ntheorem induced_graph_distance_ge\n {ι : Type*} (G : SimpleGraph ι) (hG : G.Connected) (s : Set ι)\n (hH : (G.induce s).Connected) (i j : s) :\n G.dist i.val j.val ≤ (G.induce s).dist i j := by\n obtain ⟨w, hw⟩ := hH.exists_walk_length_eq_dist i j\n have h := G.dist_le (w.map ({toFun := Subtype.val, map_rel' := fun h => h} : G.induce s →g G))\n change G.dist i.val j.val ≤ (w.map\n ({toFun := Subtype.val, map_rel' := fun h => h} : G.induce s →g G)).length at h\n simpa only [SimpleGraph.Walk.length_map, hw] using h\ntheorem graph_local_killed_diagonal_bound\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) [DecidableRel G.Adj] (hG : G.Connected)\n (Δ : ℕ) (hΔ : ∀ i, ({j | G.Adj i j} : Set ι).ncard ≤ Δ)\n (μ : ℝ) (hμ : 0 ≤ μ) (s : Set ι) (r k : ℕ) (hr : 0 < r)\n (hnet : ∀ j, ∃ d ∈ s, ∃ w : G.Walk j d, w.length ≤ r)\n (o : ι)\n (hgood : ∀ x : ι → ℝ,\n (∀ i, r * k + r < G.dist o i → x i = 0) →\n dotProduct x ((G.adjMatrix ℝ).mulVec x) ≤ μ * dotProduct x x) :\n (multiplicityKilled (G.adjMatrix ℝ + 1) s ^ (r * k)) o o ≤\n (μ + 1) ^ (r * k) * (1 - (1 / ((Δ : ℝ) + 1) ^ 2) ^ r) ^ k := by\n classical\n let T : Set ι := {v | G.dist o v ≤ r * k + r}\n let H := G.induce T\n let c : T := ⟨o, by simp [T]⟩\n have hH : H.Connected := connected_graph_closed_ball_connected G hG o _\n letI : Nonempty T := hH.nonempty\n obtain ⟨ρ, p, hp, he, hb⟩ := multiplicity_connected_positive_eigenpair H hH\n have hdeg : ∀ i : T, ((Finset.univ.filter (H.Adj i)).card : ℝ) ≤ (Δ : ℝ) := by\n intro i\n have hh := induced_graph_degree_bound G T Δ hΔ i\n have hnat : (Finset.univ.filter (H.Adj i)).card ≤ Δ := by\n simpa only [H, Set.ncard_eq_toFinset_card', Set.toFinset_ofPred] using hh\n exact_mod_cast hnat\n obtain ⟨hρ, hρΔ⟩ := adjacency_positive_eigenvalue_bounds H ρ Δ p hp he hdeg\n have hρμ : ρ ≤ μ := by\n have hbound := hgood (multiplicityExtend T p) (by\n intro i hi\n simp [multiplicityExtend, T, not_le.mpr hi])\n have hmat : (G.adjMatrix ℝ).submatrix (fun v : T => v.val) Subtype.val =\n H.adjMatrix ℝ := by ext i j; rfl\n rw [multiplicityExtend_dotProduct, multiplicityExtend_quadratic, hmat, he,\n dotProduct_smul, smul_eq_mul] at hbound\n have hnorm : 0 < dotProduct p p := by\n apply lt_of_lt_of_le (sq_pos_of_pos (hp c))\n simpa only [pow_two, dotProduct] using\n Finset.single_le_sum (fun i _ => mul_self_nonneg (p i)) (Finset.mem_univ c)\n exact (mul_le_mul_iff_left₀ hnorm).mp (by simpa only [mul_comm] using hbound)\n have hnetH : ∀ a, a < k → ∀ j : T, H.dist c j ≤ r * a →\n ∃ d ∈ (Subtype.val ⁻¹' s : Set T), ∃ w : H.Walk j d, w.length ≤ r := by\n intro a ha j hj\n have hd : G.dist o j.val ≤ r * a :=\n (induced_graph_distance_ge G hG T hH c j).trans hj\n obtain ⟨d, hds, w, hw⟩ := hnet j.val\n have hsupport : ∀ u ∈ w.support, u ∈ T := by\n intro u hu\n have hdist := graph_walk_support_distance_bound G hG o w u hu\n change G.dist o u ≤ r * k + r\n exact hdist.trans (Nat.add_le_add\n (hd.trans (Nat.mul_le_mul_left r (Nat.le_of_lt ha))) hw)\n refine ⟨⟨d, hsupport d w.end_mem_support⟩, hds, w.induce T hsupport, ?_⟩\n simpa only [graph_walk_induce_length] using hw\n have hlocal := graph_killed_shifted_diagonal_bound H hH ρ Δ p hp he hρ hρΔ\n (Subtype.val ⁻¹' s) r k hr c hnetH\n let M := multiplicityKilled (G.adjMatrix ℝ + 1) s\n have hsM : ∀ i j, M i j ≠ 0 → i = j ∨ G.Adj i j := by\n intro i j hij\n by_contra! h\n apply hij\n simp [M, multiplicityKilled, SimpleGraph.adjMatrix_apply, Matrix.one_apply, h.1, h.2]\n have hpow := @graph_matrix_power_closed_ball_locality ι _ _ G hG M hsM o\n (r * k + r) (inferInstance : Fintype T) (inferInstance : DecidableEq T) (r * k) c c (by simp [c])\n have hrestrict : M.submatrix (fun i : T => i.val) Subtype.val =\n multiplicityKilled (H.adjMatrix ℝ + 1) (Subtype.val ⁻¹' s) := by\n ext i j\n simp only [M, multiplicityKilled, Matrix.submatrix_apply, Set.mem_preimage,\n Matrix.add_apply]\n congr 1\n by_cases hij : i = j\n · subst j; simp\n · have hval : i.val ≠ j.val := fun h => hij (Subtype.ext h)\n simp [Matrix.one_apply, hij, hval, H, SimpleGraph.adjMatrix_apply]\n have heq := congrArg (fun Z : Matrix T T ℝ => (Z ^ (r * k)) c c) hrestrict\n have hfull := hpow.trans heq\n rw [hfull]\n apply hlocal.trans\n exact mul_le_mul_of_nonneg_right\n (pow_le_pow_left₀ (by linarith : 0 ≤ ρ + 1) (by linarith : ρ + 1 ≤ μ + 1) _)\n (pow_nonneg (sub_nonneg.mpr (pow_le_one₀ (by positivity)\n (by rw [div_le_one (by positivity : 0 < ((Δ : ℝ) + 1) ^ 2)];\n nlinarith [Nat.cast_nonneg (α := ℝ) Δ]))) k)\ntheorem graph_second_eigenvalue_multiplicity_finite_bound\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) [DecidableRel G.Adj] (hG : G.Connected)\n (Δ : ℕ) (hΔ : ∀ i, ({j | G.Adj i j} : Set ι).ncard ≤ Δ)\n (μ : ℝ) (hμ : 0 ≤ μ) (hA : (G.adjMatrix ℝ).IsHermitian)\n (j : ι) (heig : ∀ i, i ≠ j → hA.eigenvalues i ≤ μ)\n (r k : ℕ) (hr : 0 < r) :\n (Module.finrank ℝ (Module.End.eigenspace (G.adjMatrix ℝ).mulVecLin μ) : ℝ) ≤\n (Fintype.card ι : ℝ) / (r : ℝ) + 1 +\n (Fintype.card ι : ℝ) * (1 - (1 / ((Δ : ℝ) + 1) ^ 2) ^ r) ^ (2 * k) +\n ((Δ : ℝ) + 1) ^ (2 * (r * (2 * k) + r) + 1 + r * (2 * k)) := by\n classical\n let L := r * (2 * k)\n let R := L + r\n let D : ℝ := (Δ : ℝ) + 1\n let a : ℝ := (1 - (1 / D ^ 2) ^ r) ^ (2 * k)\n let q : ℝ := (μ + 1) ^ L\n let C : ℝ := D ^ (2 * R + 1 + L)\n let B := G.adjMatrix ℝ + 1\n have hnB : ∀ i j, 0 ≤ B i j := adjacency_add_one_nonnegative G\n have hq : 1 ≤ q := one_le_pow₀ (by linarith : 1 ≤ μ + 1)\n have ha : 0 ≤ a := by dsimp only [a]; rw [mul_comm 2 k, pow_mul]; exact sq_nonneg _\n have hC : 0 ≤ C := by dsimp only [C, D]; positivity\n obtain ⟨s, hscard, hnet⟩ := connected_graph_sparse_walk_net G hG r hr\n obtain ⟨b, hbcard, hgood⟩ := graph_uniform_local_rayleigh_bound G hG Δ hΔ μ hA j heig R\n let K := multiplicityKilled B (s : Set ι)\n have hnK : ∀ i j, 0 ≤ K i j := by\n intro i j; dsimp only [K, multiplicityKilled]; split <;> simp_all\n have hKB : ∀ i j, K i j ≤ B i j := by\n intro i j; dsimp only [K, multiplicityKilled]; split <;> simp_all\n have hdiag : ∀ i, (K ^ L) i i ≤ q * a + (if i ∈ b then D ^ L else 0) := by\n intro i\n by_cases hi : i ∈ b\n · have hrow := nonnegative_matrix_power_rowsum_bound B hnB D\n (by dsimp only [D]; positivity) (adjacency_add_one_rowsum_bound G Δ hΔ) L i\n have hbound : (K ^ L) i i ≤ D ^ L :=\n (real_matrix_power_entry_mono K B hnK hKB L i i).trans\n ((Finset.single_le_sum (fun l _ => Matrix.pow_apply_nonneg hnB L i l)\n (Finset.mem_univ i)).trans hrow)\n simp only [if_pos hi]\n exact hbound.trans (le_add_of_nonneg_left (mul_nonneg (by linarith) ha))\n · have hlocal := graph_local_killed_diagonal_bound G hG Δ hΔ μ hμ\n (s : Set ι) r (2 * k) hr\n (by intro v; obtain ⟨d, hd, w, hw⟩ := hnet v; exact ⟨d, hd, w, hw⟩) i\n (hgood i hi)\n simpa only [K, B, L, q, a, D, if_neg hi, add_zero] using hlocal\n have hsum : (∑ i, (K ^ L) i i) ≤ (Fintype.card ι : ℝ) * q * a + C := by\n apply (Finset.sum_le_sum (fun i _ => hdiag i)).trans\n simp only [Finset.sum_add_distrib, Finset.sum_const, Finset.card_univ,\n nsmul_eq_mul]\n have hb : (b.card : ℝ) ≤ D ^ (2 * R + 1) := by\n dsimp only [D]; exact_mod_cast hbcard\n have hsumB : (∑ i, if i ∈ b then D ^ L else 0) = (b.card : ℝ) * D ^ L := by\n rw [← Finset.sum_filter]\n simp\n rw [hsumB]\n have hmul := mul_le_mul_of_nonneg_right hb (by dsimp only [D]; positivity : 0 ≤ D ^ L)\n dsimp only [C]\n rw [pow_add]\n nlinarith only [hmul]\n let U := {i : ι // i ∉ s}\n let B' : Matrix U U ℝ := B.submatrix Subtype.val Subtype.val\n have hB' : B'.IsHermitian := (hA.add Matrix.isHermitian_one).submatrix Subtype.val\n have htrace : (B' ^ L).trace ≤ ∑ i, (K ^ L) i i := by\n have hp : ∀ i : U, (B' ^ L) i i = (K ^ L) i.val i.val := by\n intro i\n exact (multiplicityKilled_principal_power B (s : Set ι) L i i).symm\n simp only [Matrix.trace, Matrix.diag, hp]\n rw [← Finset.sum_subtype (Finset.univ.filter fun i => i ∉ s)\n (by intro i; simp) (fun i => (K ^ L) i i)]\n exact Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)\n (fun i _ _ => Matrix.pow_apply_nonneg hnK L i i)\n let m := Module.finrank ℝ (Module.End.eigenspace B'.mulVecLin (μ + 1))\n have hm : (m : ℝ) * q ≤ (Fintype.card ι : ℝ) * q * a + C := by\n have hh := real_matrix_eigenspace_multiplicity_trace_bound B' hB' (μ + 1) (r * k)\n have hL : 2 * (r * k) = L := by dsimp only [L]; ring\n rw [hL] at hh\n exact hh.trans (htrace.trans hsum)\n have hm' : (m : ℝ) ≤ (Fintype.card ι : ℝ) * a + C := by\n have hmul : C ≤ C * q := by nlinarith only [hq, hC]\n have hh : (m : ℝ) * q ≤ ((Fintype.card ι : ℝ) * a + C) * q := by\n nlinarith only [hm, hmul]\n exact (mul_le_mul_iff_left₀ (lt_of_lt_of_le zero_lt_one hq)).mp\n (by simpa only [mul_comm] using hh)\n have hdel := real_matrix_eigenspace_deletion_bound B (μ + 1) s\n rw [real_matrix_eigenspace_shift_one] at hdel\n have hdel' : (Module.finrank ℝ (Module.End.eigenspace (G.adjMatrix ℝ).mulVecLin μ) : ℝ) ≤\n (s.card : ℝ) + (m : ℝ) := by exact_mod_cast hdel\n have hscard' : (s.card : ℝ) ≤ (Fintype.card ι : ℝ) / (r : ℝ) + 1 := by\n have hnat : (s.card : ℝ) ≤ ((Fintype.card ι / r : ℕ) : ℝ) + 1 := by\n exact_mod_cast hscard\n have hdiv := Nat.cast_div_le (α := ℝ) (m := Fintype.card ι) (n := r)\n linarith\n change _ ≤ (Fintype.card ι : ℝ) / (r : ℝ) + 1 + (Fintype.card ι : ℝ) * a + C\n linarith\ntheorem uniform_second_eigenvalue_multiplicity :\n ∀ (Δ : ℕ) (ε : ℝ), 0 < ε → ∃ N : ℕ,\n ∀ (n : ℕ) (G : SimpleGraph (Fin n)) (lambda : ℝ),\n N ≤ n → 0 < lambda → G.Connected →\n (∀ i, ({j : Fin n | G.Adj i j} : Set (Fin n)).ncard ≤ Δ) →\n let A : Matrix (Fin n) (Fin n) ℝ :=\n (letI : DecidableRel G.Adj := Classical.decRel G.Adj; G.adjMatrix ℝ)\n ∀ hA : A.IsHermitian,\n (∃ j : Fin n, ∀ i : Fin n, i ≠ j → hA.eigenvalues i ≤ lambda) →\n (Module.finrank ℝ (Module.End.eigenspace A.mulVecLin lambda) : ℝ) ≤\n ε * (n : ℝ) := by\n classical\n intro Δ ε hε\n obtain ⟨r, hrlarge⟩ := exists_nat_gt (4 / ε)\n have hrreal : 0 < (r : ℝ) := (div_pos (by norm_num) hε).trans hrlarge\n have hr : 0 < r := by exact_mod_cast hrreal\n have hrinv : 1 / (r : ℝ) ≤ ε / 4 := by\n apply (div_le_iff₀ hrreal).mpr\n have hh := (div_lt_iff₀ hε).mp hrlarge\n nlinarith\n let δ : ℝ := 1 / ((Δ : ℝ) + 1) ^ 2\n have hδ : 0 < δ ∧ δ ≤ 1 := by\n dsimp only [δ]\n constructor\n · positivity\n · rw [div_le_one (by positivity : 0 < ((Δ : ℝ) + 1) ^ 2)]\n nlinarith [Nat.cast_nonneg (α := ℝ) Δ]\n let b : ℝ := 1 - δ ^ r\n have hb : 0 ≤ b ∧ b < 1 := by\n exact ⟨sub_nonneg.mpr (pow_le_one₀ hδ.1.le hδ.2), by\n dsimp only [b]; exact sub_lt_self _ (pow_pos hδ.1 r)⟩\n have hb2 : b ^ 2 < 1 := by nlinarith [sq_nonneg b]\n obtain ⟨k, hk⟩ := exists_pow_lt_of_lt_one (show 0 < ε / 4 by positivity) hb2\n have hk' : b ^ (2 * k) ≤ ε / 4 := by simpa only [pow_mul] using hk.le\n let C : ℝ := ((Δ : ℝ) + 1) ^ (2 * (r * (2 * k) + r) + 1 + r * (2 * k))\n obtain ⟨N, hN⟩ := exists_nat_gt (4 * (1 + C) / ε)\n refine ⟨N, ?_⟩\n intro n G lambda hn hlam hG hΔ\n dsimp only\n intro hA heig\n obtain ⟨j, hj⟩ := heig\n have hnreal : (N : ℝ) ≤ (n : ℝ) := by exact_mod_cast hn\n have hconstant : 1 + C ≤ ε / 4 * (n : ℝ) := by\n have hh := (div_lt_iff₀ hε).mp (hN.trans_le hnreal)\n nlinarith\n have hmain := graph_second_eigenvalue_multiplicity_finite_bound G hG Δ hΔ\n lambda hlam.le hA j hj r k hr\n have hfirst : (n : ℝ) / (r : ℝ) ≤ ε / 4 * (n : ℝ) := by\n have hh := mul_le_mul_of_nonneg_left hrinv (Nat.cast_nonneg (α := ℝ) n)\n simpa only [mul_one_div, mul_comm] using hh\n have hsecond : (n : ℝ) * b ^ (2 * k) ≤ ε / 4 * (n : ℝ) := by\n simpa only [mul_comm] using mul_le_mul_of_nonneg_left hk'\n (Nat.cast_nonneg (α := ℝ) n)\n have hbound :\n (Module.finrank ℝ (Module.End.eigenspace (G.adjMatrix ℝ).mulVecLin lambda) : ℝ) ≤\n (n : ℝ) / (r : ℝ) + 1 + (n : ℝ) * b ^ (2 * k) + C := by\n simpa only [Fintype.card_fin, b, δ, C] using hmain\n have hnonneg : 0 ≤ ε * (n : ℝ) := mul_nonneg hε.le (Nat.cast_nonneg n)\n linarith\ndef perron_revised_type_probe : Prop := ∀ (n : ℕ) (G : SimpleGraph (Fin n)), G.Connected → let A : Matrix (Fin n) (Fin n) ℝ := (letI : DecidableRel G.Adj := Classical.decRel G.Adj; G.adjMatrix ℝ); ∃ (rho : ℝ) (p : Fin n → ℝ), 0 ≤ rho ∧ spectralRadius ℝ A = ENNReal.ofReal rho ∧ (∀ i, 0 < p i) ∧ A.mulVec p = rho • p ∧ Module.finrank ℝ (Module.End.eigenspace A.mulVecLin rho) = 1 ∧ (∀ x : Fin n → ℝ, dotProduct x (A.mulVec x) ≤ rho * dotProduct x x)\ntheorem perron_abs_quadratic_bound {n : ℕ} (G : SimpleGraph (Fin n))\n [DecidableRel G.Adj] (x : Fin n → ℝ) :\n |dotProduct x ((G.adjMatrix ℝ).mulVec x)| ≤\n dotProduct (fun i => |x i|) ((G.adjMatrix ℝ).mulVec (fun i => |x i|)) := by\n classical\n calc\n |dotProduct x ((G.adjMatrix ℝ).mulVec x)| =\n |∑ i, ∑ j, x i * (G.adjMatrix ℝ i j * x j)| := by\n simp only [dotProduct, Matrix.mulVec, Finset.mul_sum]\n _ ≤ ∑ i, ∑ j, |x i * (G.adjMatrix ℝ i j * x j)| := by\n apply (Finset.abs_sum_le_sum_abs _ _).trans\n exact Finset.sum_le_sum (fun i _ => Finset.abs_sum_le_sum_abs _ _)\n _ = dotProduct (fun i => |x i|)\n ((G.adjMatrix ℝ).mulVec (fun i => |x i|)) := by\n simp only [dotProduct, Matrix.mulVec, Finset.mul_sum]\n apply Finset.sum_congr rfl\n intro i _\n apply Finset.sum_congr rfl\n intro j _\n by_cases h : G.Adj i j <;> simp [G.adjMatrix_apply, h, abs_mul]\ntheorem perron_nonnegative_eigenvector_positive {n : ℕ} (G : SimpleGraph (Fin n))\n [DecidableRel G.Adj] (hG : G.Connected) (rho : ℝ) (p : Fin n → ℝ)\n (hp : ∀ i, 0 ≤ p i) (hp0 : p ≠ 0)\n (heig : (G.adjMatrix ℝ).mulVec p = rho • p) : ∀ i, 0 < p i := by\n classical\n have hstep : ∀ {i j}, G.Adj i j → p i = 0 → p j = 0 := by\n intro i j hij hi\n have hrow : (∑ k, G.adjMatrix ℝ i k * p k) = 0 := by\n have h := congrFun heig i\n simpa only [Matrix.mulVec, dotProduct, Pi.smul_apply, smul_eq_mul, hi, mul_zero] using h\n have hterms := (Finset.sum_eq_zero_iff_of_nonneg\n (fun k (_ : k ∈ Finset.univ) =>\n mul_nonneg (by simp only [G.adjMatrix_apply]; split_ifs <;> positivity) (hp k))).mp hrow\n have h := hterms j (Finset.mem_univ j)\n simpa only [G.adjMatrix_apply, if_pos hij, one_mul] using h\n have hprop : ∀ {i j}, G.Reachable i j → p i = 0 → p j = 0 := by\n intro i j hr\n obtain ⟨w⟩ := hr\n induction w with\n | nil => exact id\n | cons hij w ih => exact fun hi => ih (hstep hij hi)\n intro i\n by_contra h\n have hi : p i = 0 := le_antisymm (le_of_not_gt h) (hp i)\n apply hp0\n funext j\n exact hprop (hG i j) hi\ntheorem perron_nonnegative_top_eigenvector {n : ℕ} (G : SimpleGraph (Fin n))\n [DecidableRel G.Adj] [Nonempty (Fin n)] :\n ∃ (rho : ℝ) (p : Fin n → ℝ), 0 ≤ rho ∧ (∀ i, 0 ≤ p i) ∧ p ≠ 0 ∧\n (G.adjMatrix ℝ).mulVec p = rho • p ∧\n (∀ x : Fin n → ℝ,\n dotProduct x ((G.adjMatrix ℝ).mulVec x) ≤ rho * dotProduct x x) := by\n classical\n let A := G.adjMatrix ℝ\n have hA : A.IsHermitian := by\n ext i j\n simp [A, Matrix.conjTranspose_apply, G.adj_comm]\n let T := (Matrix.isSymmetric_toEuclideanLin_iff.mpr hA).toSelfAdjoint\n have hT : ∀ x : EuclideanSpace ℝ (Fin n),\n T.val.reApplyInnerSelf x = dotProduct x.ofLp (A.mulVec x.ofLp) := by\n intro x\n rw [ContinuousLinearMap.reApplyInnerSelf_apply]\n have heq : T.val x = Matrix.toEuclideanLin A x := by\n exact congrArg (fun f : EuclideanSpace ℝ (Fin n) →ₗ[ℝ] EuclideanSpace ℝ (Fin n) => f x)\n (Matrix.isSymmetric_toEuclideanLin_iff.mpr hA).coe_toSelfAdjoint\n rw [heq, EuclideanSpace.inner_eq_star_dotProduct]\n simp only [Matrix.toEuclideanLin, Matrix.toLpLin_apply, WithLp.ofLp_toLp,\n star_trivial, RCLike.re_to_real]\n let i : Fin n := Classical.choice inferInstance\n let u : EuclideanSpace ℝ (Fin n) := EuclideanSpace.basisFun (Fin n) ℝ i\n have hu : ‖u‖ = 1 := (EuclideanSpace.basisFun (Fin n) ℝ).norm_eq_one i\n obtain ⟨q, hq, hmax⟩ := (isCompact_sphere (0 : EuclideanSpace ℝ (Fin n)) 1).exists_isMaxOn\n ⟨u, by simpa using hu⟩ T.val.reApplyInnerSelf_continuous.continuousOn\n have hqn : ‖q‖ = 1 := by simpa using hq\n let p : EuclideanSpace ℝ (Fin n) := WithLp.toLp 2 (fun i => |q i|)\n have hpn : ‖p‖ = 1 := by\n rw [EuclideanSpace.norm_eq] at hqn ⊢\n simpa only [p, WithLp.ofLp_toLp, Real.norm_eq_abs, abs_abs] using hqn\n have hpq : T.val.reApplyInnerSelf q ≤ T.val.reApplyInnerSelf p := by\n rw [hT, hT]\n exact (le_abs_self _).trans (perron_abs_quadratic_bound G q.ofLp)\n have hpmax : IsMaxOn T.val.reApplyInnerSelf (Metric.sphere 0 1) p := by\n intro x hx\n exact (hmax hx).trans hpq\n let rho := T.val.reApplyInnerSelf p\n have hp0 : p ≠ 0 := by\n intro h\n have := hpn\n rw [h, norm_zero] at this\n exact zero_ne_one this\n have heig : A.mulVec p.ofLp = rho • p.ofLp := by\n have h := T.prop.eq_smul_self_of_isLocalExtrOn\n (Or.inr (show IsMaxOn T.val.reApplyInnerSelf (Metric.sphere 0 ‖p‖) p by\n simpa only [hpn] using hpmax).localize)\n have heq : T.val p = Matrix.toEuclideanLin A p :=\n congrArg (fun f : EuclideanSpace ℝ (Fin n) →ₗ[ℝ] EuclideanSpace ℝ (Fin n) => f p)\n (Matrix.isSymmetric_toEuclideanLin_iff.mpr hA).coe_toSelfAdjoint\n rw [heq] at h\n have h' := congrArg (WithLp.ofLp) h\n simpa only [Matrix.toEuclideanLin, Matrix.toLpLin_apply, WithLp.ofLp_toLp,\n WithLp.ofLp_smul, ContinuousLinearMap.rayleighQuotient, hpn, one_pow, div_one,\n RCLike.ofReal_real_eq_id, id_eq, rho] using h'\n have hrho : 0 ≤ rho := by\n dsimp only [rho]\n rw [hT]\n change 0 ≤ ∑ i, |q i| * ∑ j, A i j * |q j|\n apply Finset.sum_nonneg\n intro i _\n apply mul_nonneg (abs_nonneg _)\n apply Finset.sum_nonneg\n intro j _\n apply mul_nonneg _ (abs_nonneg _)\n simp only [A, G.adjMatrix_apply]\n split_ifs <;> positivity\n refine ⟨rho, p.ofLp, hrho, fun i => abs_nonneg _, ?_, heig, ?_⟩\n · exact fun h => hp0 ((WithLp.ofLp_eq_zero _).mp h)\n · intro x\n let z : EuclideanSpace ℝ (Fin n) := WithLp.toLp 2 x\n by_cases hz : z = 0\n · have hx : x = 0 := by exact congrArg WithLp.ofLp hz\n simp [hx, dotProduct]\n · have hn : ‖z‖ ≠ 0 := norm_ne_zero_iff.mpr hz\n have hyn : ‖‖z‖⁻¹ • z‖ = 1 := by\n rw [norm_smul, Real.norm_eq_abs, abs_inv, abs_of_nonneg (norm_nonneg z), inv_mul_cancel₀ hn]\n have hy := hpmax (show ‖z‖⁻¹ • z ∈ Metric.sphere 0 1 by simpa using hyn)\n change T.val.reApplyInnerSelf (‖z‖⁻¹ • z) ≤ T.val.reApplyInnerSelf p at hy\n rw [ContinuousLinearMap.reApplyInnerSelf_smul] at hy\n simp only [Real.norm_eq_abs, abs_inv, abs_of_nonneg (norm_nonneg z)] at hy\n have hmul := mul_le_mul_of_nonneg_left hy (sq_nonneg ‖z‖)\n have hcancel : ‖z‖ ^ 2 * (‖z‖⁻¹ ^ 2 * T.val.reApplyInnerSelf z) = T.val.reApplyInnerSelf z := by\n field_simp\n rw [hcancel, hT] at hmul\n have hnorm : ‖z‖ ^ 2 = dotProduct x x := by\n rw [EuclideanSpace.real_norm_sq_eq]\n simp only [z, WithLp.ofLp_toLp, dotProduct, pow_two]\n simpa only [z, WithLp.ofLp_toLp, hnorm, rho, mul_comm] using hmul\ntheorem perron_eigenvector_proportional {n : ℕ} (G : SimpleGraph (Fin n))\n [DecidableRel G.Adj] (hG : G.Connected) (rho : ℝ) (p : Fin n → ℝ)\n (hp : ∀ i, 0 < p i) (heig : (G.adjMatrix ℝ).mulVec p = rho • p)\n (x : Fin n → ℝ) (hx : (G.adjMatrix ℝ).mulVec x = rho • x) :\n ∃ c : ℝ, c • p = x := by\n classical\n letI : Nonempty (Fin n) := hG.nonempty\n obtain ⟨j, _, hj⟩ := Finset.univ.exists_min_image (fun i => x i / p i) Finset.univ_nonempty\n let c := x j / p j\n let z := x - c • p\n have hznonneg : ∀ i, 0 ≤ z i := by\n intro i\n have hmin : c ≤ x i / p i := hj i (Finset.mem_univ i)\n have h := (le_div_iff₀ (hp i)).mp hmin\n change 0 ≤ x i - c * p i\n linarith\n have hzj : z j = 0 := by\n change x j - (x j / p j) * p j = 0\n rw [div_mul_cancel₀ _ (ne_of_gt (hp j)), sub_self]\n have hzeig : (G.adjMatrix ℝ).mulVec z = rho • z := by\n dsimp only [z]\n rw [Matrix.mulVec_sub, Matrix.mulVec_smul, hx, heig, smul_sub, smul_comm]\n have hz : z = 0 := by\n by_contra h\n have hpos := perron_nonnegative_eigenvector_positive G hG rho z hznonneg h hzeig j\n rw [hzj] at hpos\n exact (lt_irrefl 0) hpos\n exact ⟨c, (sub_eq_zero.mp hz).symm⟩\ntheorem perron_eigenspace_finrank_one {n : ℕ} (G : SimpleGraph (Fin n))\n [DecidableRel G.Adj] (hG : G.Connected) (rho : ℝ) (p : Fin n → ℝ)\n (hp : ∀ i, 0 < p i) (heig : (G.adjMatrix ℝ).mulVec p = rho • p) :\n Module.finrank ℝ (Module.End.eigenspace (G.adjMatrix ℝ).mulVecLin rho) = 1 := by\n classical\n letI : Nonempty (Fin n) := hG.nonempty\n have hp0 : p ≠ 0 := by\n intro h\n have hh := hp (Classical.choice inferInstance)\n rw [h, Pi.zero_apply] at hh\n exact (lt_irrefl 0) hh\n have hspace : Module.End.eigenspace (G.adjMatrix ℝ).mulVecLin rho =\n Submodule.span ℝ {p} := by\n apply le_antisymm\n · intro x hx\n obtain ⟨c, hc⟩ := perron_eigenvector_proportional G hG rho p hp heig x\n (Module.End.mem_eigenspace_iff.mp hx)\n exact Submodule.mem_span_singleton.mpr ⟨c, hc⟩\n · apply Submodule.span_le.mpr\n intro x hx\n rcases Set.mem_singleton_iff.mp hx with rfl\n exact Module.End.mem_eigenspace_iff.mpr heig\n rw [hspace]\n exact finrank_span_singleton hp0\ntheorem perron_spectralRadius_eq {n : ℕ} (G : SimpleGraph (Fin n))\n [DecidableRel G.Adj] (rho : ℝ) (hrho : 0 ≤ rho) (p : Fin n → ℝ)\n (hp0 : p ≠ 0) (heig : (G.adjMatrix ℝ).mulVec p = rho • p)\n (hbound : ∀ x : Fin n → ℝ,\n dotProduct x ((G.adjMatrix ℝ).mulVec x) ≤ rho * dotProduct x x) :\n spectralRadius ℝ (G.adjMatrix ℝ) = ENNReal.ofReal rho := by\n classical\n let A := G.adjMatrix ℝ\n have hA : A.IsHermitian := by\n ext i j\n simp [A, Matrix.conjTranspose_apply, G.adj_comm]\n have heigs : ∀ i, |hA.eigenvalues i| ≤ rho := by\n intro i\n let q := hA.eigenvectorBasis i\n have hnorm : dotProduct (fun j => |q j|) (fun j => |q j|) = 1 := by\n calc\n dotProduct (fun j => |q j|) (fun j => |q j|) = ∑ j, (q j) ^ 2 := by\n simp only [dotProduct, ← pow_two, sq_abs]\n _ = ‖q‖ ^ 2 := (EuclideanSpace.real_norm_sq_eq q).symm\n _ = 1 := by rw [hA.eigenvectorBasis.norm_eq_one]; norm_num\n have hb := (perron_abs_quadratic_bound G q.ofLp).trans (hbound (fun j => |q j|))\n rw [hnorm, mul_one] at hb\n simpa only [Matrix.IsHermitian.eigenvalues_eq, star_trivial, RCLike.re_to_real, q] using hb\n have hpv : Module.End.HasEigenvector (Matrix.toEuclideanLin A) rho (WithLp.toLp 2 p) := by\n constructor\n · rw [Module.End.mem_eigenspace_iff]\n change WithLp.toLp 2 (A.mulVec p) = rho • WithLp.toLp 2 p\n rw [heig, WithLp.toLp_smul]\n · intro h\n exact hp0 (congrArg WithLp.ofLp h)\n have hmem : rho ∈ spectrum ℝ A := by\n simpa only [Matrix.toEuclideanLin, Matrix.spectrum_toLpLin] using\n (Module.End.hasEigenvalue_of_hasEigenvector hpv).mem_spectrum\n apply le_antisymm\n · rw [spectralRadius_eq_of_unital]\n refine iSup₂_le fun t ht => ?_\n change t ∈ spectrum ℝ A at ht\n rw [hA.spectrum_real_eq_range_eigenvalues] at ht\n obtain ⟨i, rfl⟩ := ht\n have hnorm : ‖hA.eigenvalues i‖ ≤ rho := by\n simpa only [Real.norm_eq_abs] using heigs i\n calc\n (↑‖hA.eigenvalues i‖₊ : ENNReal) = ENNReal.ofReal ‖hA.eigenvalues i‖ :=\n ENNReal.coe_nnreal_eq ‖hA.eigenvalues i‖₊\n _ ≤ ENNReal.ofReal rho := ENNReal.ofReal_le_ofReal hnorm\n · calc\n ENNReal.ofReal rho = (↑‖rho‖₊ : ENNReal) := by\n calc\n ENNReal.ofReal rho = ENNReal.ofReal ‖rho‖ := by rw [Real.norm_of_nonneg hrho]\n _ = (↑‖rho‖₊ : ENNReal) := (ENNReal.coe_nnreal_eq ‖rho‖₊).symm\n _ ≤ spectralRadius ℝ A := by\n rw [spectralRadius_eq_of_unital]\n exact le_iSup_of_le rho (le_iSup_of_le hmem le_rfl)\ntheorem connected_perron_frobenius :\n ∀ (n : ℕ) (G : SimpleGraph (Fin n)), G.Connected →\n let A : Matrix (Fin n) (Fin n) ℝ :=\n (letI : DecidableRel G.Adj := Classical.decRel G.Adj; G.adjMatrix ℝ)\n ∃ (rho : ℝ) (p : Fin n → ℝ),\n 0 ≤ rho ∧ spectralRadius ℝ A = ENNReal.ofReal rho ∧\n (∀ i, 0 < p i) ∧ A.mulVec p = rho • p ∧\n Module.finrank ℝ (Module.End.eigenspace A.mulVecLin rho) = 1 ∧\n (∀ x : Fin n → ℝ, dotProduct x (A.mulVec x) ≤ rho * dotProduct x x) := by\n classical\n intro n G hG\n letI : Nonempty (Fin n) := hG.nonempty\n obtain ⟨rho, p, hrho, hp, hp0, heig, hbound⟩ := perron_nonnegative_top_eigenvector G\n have hpos := perron_nonnegative_eigenvector_positive G hG rho p hp hp0 heig\n exact ⟨rho, p, hrho, perron_spectralRadius_eq G rho hrho p hp0 heig hbound,\n hpos, heig, perron_eigenspace_finrank_one G hG rho p hpos heig, hbound⟩\ndef component_rank_one_runtime_type_probe : Prop :=\n ∀ (n : ℕ) (G : SimpleGraph (Fin n)) (lambda : ℝ), 0 < lambda →\n let A : Matrix (Fin n) (Fin n) ℝ :=\n (letI : DecidableRel G.Adj := Classical.decRel G.Adj; G.adjMatrix ℝ)\n let J : Matrix (Fin n) (Fin n) ℝ := Matrix.of (fun _ _ => 1)\n let P := lambda • (1 : Matrix (Fin n) (Fin n) ℝ) - A + (1 / 2 : ℝ) • J\n let r : G.ConnectedComponent → ENNReal := fun C =>\n (letI : Fintype C.supp := Fintype.ofFinite C.supp;\n letI : DecidableEq C.supp := Classical.decEq C.supp;\n letI : DecidableRel C.toSimpleGraph.Adj := Classical.decRel C.toSimpleGraph.Adj;\n spectralRadius ℝ (C.toSimpleGraph.adjMatrix ℝ))\n P.PosSemidef →\n ((¬ ∃ C, ENNReal.ofReal lambda < r C) →\n let t := ({C : G.ConnectedComponent | r C = ENNReal.ofReal lambda}).ncard\n P.rank = if t = 0 then n else n + 1 - t) ∧\n ((∃ C, ENNReal.ofReal lambda < r C) →\n ∃ C, ENNReal.ofReal lambda < r C ∧\n (∀ D, D ≠ C → r D < ENNReal.ofReal lambda) ∧\n let mC : ℕ :=\n (letI : Fintype C.supp := Fintype.ofFinite C.supp;\n letI : DecidableEq C.supp := Classical.decEq C.supp;\n letI : DecidableRel C.toSimpleGraph.Adj := Classical.decRel C.toSimpleGraph.Adj;\n Module.finrank ℝ (Module.End.eigenspace\n (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda))\n Module.finrank ℝ (Module.End.eigenspace A.mulVecLin lambda) = mC ∧\n n ≤ P.rank + 1 + mC)\ntheorem component_abs_quadratic_bound {ι : Type*} [Fintype ι] [DecidableEq ι] (G : SimpleGraph ι)\n [DecidableRel G.Adj] (x : ι → ℝ) :\n |dotProduct x ((G.adjMatrix ℝ).mulVec x)| ≤\n dotProduct (fun i => |x i|) ((G.adjMatrix ℝ).mulVec (fun i => |x i|)) := by\n classical\n calc\n |dotProduct x ((G.adjMatrix ℝ).mulVec x)| =\n |∑ i, ∑ j, x i * (G.adjMatrix ℝ i j * x j)| := by\n simp only [dotProduct, Matrix.mulVec, Finset.mul_sum]\n _ ≤ ∑ i, ∑ j, |x i * (G.adjMatrix ℝ i j * x j)| := by\n apply (Finset.abs_sum_le_sum_abs _ _).trans\n exact Finset.sum_le_sum (fun i _ => Finset.abs_sum_le_sum_abs _ _)\n _ = dotProduct (fun i => |x i|)\n ((G.adjMatrix ℝ).mulVec (fun i => |x i|)) := by\n simp only [dotProduct, Matrix.mulVec, Finset.mul_sum]\n apply Finset.sum_congr rfl\n intro i _\n apply Finset.sum_congr rfl\n intro j _\n by_cases h : G.Adj i j <;> simp [G.adjMatrix_apply, h, abs_mul]\ntheorem component_spectralRadius_eq {ι : Type*} [Fintype ι] [DecidableEq ι] (G : SimpleGraph ι)\n [DecidableRel G.Adj] (rho : ℝ) (hrho : 0 ≤ rho) (p : ι → ℝ)\n (hp0 : p ≠ 0) (heig : (G.adjMatrix ℝ).mulVec p = rho • p)\n (hbound : ∀ x : ι → ℝ,\n dotProduct x ((G.adjMatrix ℝ).mulVec x) ≤ rho * dotProduct x x) :\n spectralRadius ℝ (G.adjMatrix ℝ) = ENNReal.ofReal rho := by\n classical\n let A := G.adjMatrix ℝ\n have hA : A.IsHermitian := by\n ext i j\n simp [A, Matrix.conjTranspose_apply, G.adj_comm]\n have heigs : ∀ i, |hA.eigenvalues i| ≤ rho := by\n intro i\n let q := hA.eigenvectorBasis i\n have hnorm : dotProduct (fun j => |q j|) (fun j => |q j|) = 1 := by\n calc\n dotProduct (fun j => |q j|) (fun j => |q j|) = ∑ j, (q j) ^ 2 := by\n simp only [dotProduct, ← pow_two, sq_abs]\n _ = ‖q‖ ^ 2 := (EuclideanSpace.real_norm_sq_eq q).symm\n _ = 1 := by rw [hA.eigenvectorBasis.norm_eq_one]; norm_num\n have hb := (component_abs_quadratic_bound G q.ofLp).trans (hbound (fun j => |q j|))\n rw [hnorm, mul_one] at hb\n simpa only [Matrix.IsHermitian.eigenvalues_eq, star_trivial, RCLike.re_to_real, q] using hb\n have hpv : Module.End.HasEigenvector (Matrix.toEuclideanLin A) rho (WithLp.toLp 2 p) := by\n constructor\n · rw [Module.End.mem_eigenspace_iff]\n change WithLp.toLp 2 (A.mulVec p) = rho • WithLp.toLp 2 p\n rw [heig, WithLp.toLp_smul]\n · intro h\n exact hp0 (congrArg WithLp.ofLp h)\n have hmem : rho ∈ spectrum ℝ A := by\n simpa only [Matrix.toEuclideanLin, Matrix.spectrum_toLpLin] using\n (Module.End.hasEigenvalue_of_hasEigenvector hpv).mem_spectrum\n apply le_antisymm\n · rw [spectralRadius_eq_of_unital]\n refine iSup₂_le fun t ht => ?_\n change t ∈ spectrum ℝ A at ht\n rw [hA.spectrum_real_eq_range_eigenvalues] at ht\n obtain ⟨i, rfl⟩ := ht\n have hnorm : ‖hA.eigenvalues i‖ ≤ rho := by\n simpa only [Real.norm_eq_abs] using heigs i\n calc\n (↑‖hA.eigenvalues i‖₊ : ENNReal) = ENNReal.ofReal ‖hA.eigenvalues i‖ :=\n ENNReal.coe_nnreal_eq ‖hA.eigenvalues i‖₊\n _ ≤ ENNReal.ofReal rho := ENNReal.ofReal_le_ofReal hnorm\n · calc\n ENNReal.ofReal rho = (↑‖rho‖₊ : ENNReal) := by\n calc\n ENNReal.ofReal rho = ENNReal.ofReal ‖rho‖ := by rw [Real.norm_of_nonneg hrho]\n _ = (↑‖rho‖₊ : ENNReal) := (ENNReal.coe_nnreal_eq ‖rho‖₊).symm\n _ ≤ spectralRadius ℝ A := by\n rw [spectralRadius_eq_of_unital]\n exact le_iSup_of_le rho (le_iSup_of_le hmem le_rfl)\ntheorem component_connected_perron\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) [DecidableRel G.Adj] (hG : G.Connected) :\n ∃ (rho : ℝ) (p : ι → ℝ),\n 0 ≤ rho ∧ spectralRadius ℝ (G.adjMatrix ℝ) = ENNReal.ofReal rho ∧\n (∀ i, 0 < p i) ∧ (G.adjMatrix ℝ).mulVec p = rho • p ∧\n Module.finrank ℝ (Module.End.eigenspace (G.adjMatrix ℝ).mulVecLin rho) = 1 ∧\n (∀ x, dotProduct x ((G.adjMatrix ℝ).mulVec x) ≤ rho * dotProduct x x) := by\n classical\n letI : Nonempty ι := hG.nonempty\n obtain ⟨rho, p, hp, he, hb⟩ := multiplicity_connected_positive_eigenpair G hG\n let i : ι := Classical.choice hG.nonempty\n have hp0 : p ≠ 0 := by\n intro h\n have hh := hp i\n rw [h, Pi.zero_apply] at hh\n exact (lt_irrefl 0) hh\n have hrho : 0 ≤ rho := by\n have hh := congrFun he i\n change (∑ j, G.adjMatrix ℝ i j * p j) = rho * p i at hh\n have hn : 0 ≤ ∑ j, G.adjMatrix ℝ i j * p j := by\n apply Finset.sum_nonneg\n intro j _\n apply mul_nonneg _ (hp j).le\n simp only [G.adjMatrix_apply]\n split_ifs <;> norm_num\n rw [hh] at hn\n exact (mul_nonneg_iff_of_pos_right (hp i)).mp hn\n exact ⟨rho, p, hrho, component_spectralRadius_eq G rho hrho p hp0 he hb,\n hp, he, adjacency_positive_eigenvector_eigenspace_finrank G hG rho p hp he, hb⟩\ntheorem component_adj_mulVec_restrict\n {ι : Type*} [Fintype ι] (G : SimpleGraph ι) [DecidableRel G.Adj]\n (C : G.ConnectedComponent) [Fintype C.supp] [DecidableRel C.toSimpleGraph.Adj]\n (x : ι → ℝ) (i : C.supp) :\n (C.toSimpleGraph.adjMatrix ℝ).mulVec (fun j => x j.val) i =\n (G.adjMatrix ℝ).mulVec x i.val := by\n classical\n have hs := multiplicityExtend_sum C.supp\n (fun j => G.adjMatrix ℝ i.val j * x j) (by\n intro j hj\n have hnot : ¬ G.Adj i.val j := fun h =>\n hj ((C.mem_supp_congr_adj h).mp i.property)\n simp [SimpleGraph.adjMatrix_apply, hnot])\n calc\n _ = ∑ j : C.supp, G.adjMatrix ℝ i.val j.val * x j.val := by\n apply Finset.sum_congr rfl\n intro j _\n congr 1\n simp only [SimpleGraph.adjMatrix_apply,\n show C.toSimpleGraph.Adj i j ↔ G.Adj i.val j.val from Iff.rfl]\n _ = _ := hs.symm\ntheorem component_adj_mulVec_extend\n {ι : Type*} [Fintype ι] (G : SimpleGraph ι) [DecidableRel G.Adj]\n (C : G.ConnectedComponent) [Fintype C.supp] [DecidableRel C.toSimpleGraph.Adj]\n (x : C.supp → ℝ) :\n (G.adjMatrix ℝ).mulVec (multiplicityExtend C.supp x) =\n multiplicityExtend C.supp ((C.toSimpleGraph.adjMatrix ℝ).mulVec x) := by\n classical\n funext i\n by_cases hi : i ∈ C.supp\n · have h := component_adj_mulVec_restrict G C (multiplicityExtend C.supp x) ⟨i, hi⟩\n have hx : (fun j : C.supp => multiplicityExtend C.supp x j.val) = x := by\n funext j\n exact dif_pos j.property\n have hh := congrArg (fun z => (C.toSimpleGraph.adjMatrix ℝ).mulVec z ⟨i, hi⟩) hx\n exact h.symm.trans (hh.trans (by simp only [multiplicityExtend, dif_pos hi]))\n · change (∑ j, G.adjMatrix ℝ i j * multiplicityExtend C.supp x j) = _\n rw [multiplicityExtend, dif_neg hi]\n apply Finset.sum_eq_zero\n intro j _\n by_cases hj : j ∈ C.supp\n · have hnot : ¬ G.Adj i j := fun h => hi ((C.mem_supp_congr_adj h).mpr hj)\n simp [SimpleGraph.adjMatrix_apply, hnot]\n · simp [multiplicityExtend, hj]\ntheorem component_eigenspace_finrank_sum\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) [DecidableRel G.Adj]\n [Fintype G.ConnectedComponent]\n [∀ C : G.ConnectedComponent, Fintype C.supp]\n [∀ C : G.ConnectedComponent, DecidableRel C.toSimpleGraph.Adj]\n (lambda : ℝ) :\n Module.finrank ℝ (Module.End.eigenspace (G.adjMatrix ℝ).mulVecLin lambda) =\n ∑ C : G.ConnectedComponent,\n Module.finrank ℝ (Module.End.eigenspace\n (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda) := by\n classical\n let E := Module.End.eigenspace (G.adjMatrix ℝ).mulVecLin lambda\n let F := fun C : G.ConnectedComponent =>\n Module.End.eigenspace (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda\n let f : E →ₗ[ℝ] ((C : G.ConnectedComponent) → F C) :=\n { toFun := fun x C => ⟨fun i => x.val i.val, by\n apply Module.End.mem_eigenspace_iff.mpr\n funext i\n change (C.toSimpleGraph.adjMatrix ℝ).mulVec (fun i => x.val i.val) i =\n lambda * x.val i.val\n rw [component_adj_mulVec_restrict]\n exact congrFun (Module.End.mem_eigenspace_iff.mp x.property) i.val⟩\n map_add' := fun _ _ => rfl\n map_smul' := fun _ _ => rfl }\n have hfi : Function.Injective f := by\n intro x y h\n apply Subtype.ext\n funext i\n exact congrFun (congrArg Subtype.val (congrFun h (G.connectedComponentMk i))) ⟨i, rfl⟩\n have hfs : Function.Surjective f := by\n intro y\n let x : ι → ℝ := fun i => (y (G.connectedComponentMk i)).val ⟨i, rfl⟩\n have hx (C : G.ConnectedComponent) (i : C.supp) : x i.val = (y C).val i := by\n rcases i with ⟨i, hi⟩\n change G.connectedComponentMk i = C at hi\n subst C\n rfl\n refine ⟨⟨x, ?_⟩, ?_⟩\n · apply Module.End.mem_eigenspace_iff.mpr\n funext i\n let C := G.connectedComponentMk i\n let j : C.supp := ⟨i, rfl⟩\n have hy := congrFun (Module.End.mem_eigenspace_iff.mp (y C).property) j\n change (C.toSimpleGraph.adjMatrix ℝ).mulVec (y C).val j = lambda * (y C).val j at hy\n have hh : (fun k : C.supp => x k.val) = (y C).val := funext (hx C)\n have hrestrict := component_adj_mulVec_restrict G C x j\n have heq := congrArg (fun z => (C.toSimpleGraph.adjMatrix ℝ).mulVec z j) hh\n exact hrestrict.symm.trans (heq.trans hy)\n · funext C\n apply Subtype.ext\n funext i\n exact hx C i\n exact (LinearEquiv.ofBijective f ⟨hfi, hfs⟩).finrank_eq.trans\n (Module.finrank_pi_fintype ℝ)\ntheorem component_rank_add_le\n {ι κ : Type*} [Fintype ι] [Fintype κ]\n (A B : Matrix ι κ ℝ) : (A + B).rank ≤ A.rank + B.rank := by\n rw [Matrix.rank, Matrix.rank, Matrix.rank, Matrix.mulVecLin_add]\n exact (Submodule.finrank_mono (LinearMap.range_add_le A.mulVecLin B.mulVecLin)).trans\n (Submodule.finrank_add_le_finrank_add_finrank _ _)\ntheorem component_rank_smul_le\n {ι κ : Type*} [Fintype ι] [Fintype κ] (a : ℝ)\n (A : Matrix ι κ ℝ) : (a • A).rank ≤ A.rank := by\n rw [Matrix.rank, Matrix.rank]\n apply Submodule.finrank_mono\n rintro x ⟨c, rfl⟩\n refine ⟨a • c, ?_⟩\n simp only [Matrix.mulVecLin_apply, Matrix.mulVec_smul, Matrix.smul_mulVec]\ntheorem component_rank_one_general_bound\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (lambda : ℝ) :\n Fintype.card ι ≤\n (lambda • (1 : Matrix ι ι ℝ) - A +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).rank + 1 +\n Module.finrank ℝ (Module.End.eigenspace A.mulVecLin lambda) := by\n let Q := lambda • (1 : Matrix ι ι ℝ) - A\n let J : Matrix ι ι ℝ := Matrix.of (fun _ _ => 1)\n let P := Q + (1 / 2 : ℝ) • J\n have hker : LinearMap.ker Q.mulVecLin = Module.End.eigenspace A.mulVecLin lambda := by\n ext x\n simp only [LinearMap.mem_ker, Module.End.mem_eigenspace_iff,\n Matrix.mulVecLin_apply, Q, Matrix.sub_mulVec, Matrix.smul_mulVec,\n Matrix.one_mulVec, sub_eq_zero, eq_comm]\n have hn := Q.mulVecLin.finrank_range_add_finrank_ker\n rw [hker, Module.finrank_pi] at hn\n change Q.rank + Module.finrank ℝ (Module.End.eigenspace A.mulVecLin lambda) =\n Fintype.card ι at hn\n have hJ : J.rank ≤ 1 := by\n simpa only [Matrix.vecMulVec, one_mul, J, Matrix.of_apply] using\n Matrix.rank_vecMulVec_le (fun _ : ι => (1 : ℝ)) (fun _ : ι => (1 : ℝ))\n have heq : Q = P + (- (1 / 2 : ℝ)) • J := by\n dsimp only [P]\n rw [add_assoc, ← add_smul]\n norm_num\n have hr : Q.rank ≤ P.rank + 1 := by\n rw [heq]\n exact (component_rank_add_le _ _).trans\n (Nat.add_le_add_left ((component_rank_smul_le _ _).trans hJ) _)\n change _ ≤ P.rank + 1 + _\n omega\ntheorem component_allones_mulVec\n {ι : Type*} [Fintype ι] (x : ι → ℝ) :\n (Matrix.of (fun _ _ : ι => (1 : ℝ))).mulVec x = fun _ => ∑ i, x i := by\n funext i\n simp only [Matrix.mulVec, dotProduct, Matrix.of_apply, one_mul]\ntheorem component_rank_one_quadratic\n {ι : Type*} [Fintype ι] (Q : Matrix ι ι ℝ) (x : ι → ℝ) :\n dotProduct x ((Q + (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).mulVec x) =\n dotProduct x (Q.mulVec x) + (1 / 2 : ℝ) * (∑ i, x i) ^ 2 := by\n rw [Matrix.add_mulVec, Matrix.smul_mulVec, dotProduct_add, dotProduct_smul,\n component_allones_mulVec]\n simp only [dotProduct, Finset.sum_mul, smul_eq_mul, pow_two]\ntheorem component_rank_one_kernel\n {ι : Type*} [Fintype ι] [DecidableEq ι] (Q : Matrix ι ι ℝ)\n (hQ : Q.PosSemidef) (x : ι → ℝ) :\n (Q + (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).mulVec x = 0 ↔\n Q.mulVec x = 0 ∧ ∑ i, x i = 0 := by\n constructor\n · intro hx\n have hzero := congrArg (dotProduct x) hx\n rw [component_rank_one_quadratic, dotProduct_zero] at hzero\n have hn : 0 ≤ dotProduct x (Q.mulVec x) := by\n simpa only [star_trivial] using hQ.dotProduct_mulVec_nonneg x\n have hs : ∑ i, x i = 0 := by nlinarith [sq_nonneg (∑ i, x i)]\n refine ⟨?_, hs⟩\n apply hQ.dotProduct_mulVec_zero_iff.mp\n simp only [star_trivial]\n nlinarith [hs]\n · rintro ⟨hx, hs⟩\n rw [Matrix.add_mulVec, Matrix.smul_mulVec, component_allones_mulVec, hs, hx]\n simp\n rfl\ntheorem component_eigenspace_eq_bot_of_rayleigh_lt\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (rho lambda : ℝ) (hlt : rho < lambda)\n (hb : ∀ x, dotProduct x (A.mulVec x) ≤ rho * dotProduct x x) :\n Module.End.eigenspace A.mulVecLin lambda = ⊥ := by\n apply eq_bot_iff.mpr\n intro x hx\n have he : A.mulVec x = lambda • x := Module.End.mem_eigenspace_iff.mp hx\n have hh := hb x\n rw [he, dotProduct_smul, smul_eq_mul] at hh\n have hn : 0 ≤ dotProduct x x := Finset.sum_nonneg (fun i _ => mul_self_nonneg (x i))\n have hz : dotProduct x x = 0 := by nlinarith\n exact (dotProduct_self_eq_zero.mp hz)\ntheorem component_rank_one_positive_pair_impossible\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (A : Matrix ι ι ℝ) (lambda rho tau : ℝ)\n (hP : (lambda • (1 : Matrix ι ι ℝ) - A +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).PosSemidef)\n (x y : ι → ℝ) (hx : A.mulVec x = rho • x) (hy : A.mulVec y = tau • y)\n (hxy : dotProduct x y = 0) (hsx : 0 < ∑ i, x i) (hsy : 0 < ∑ i, y i)\n (hrho : lambda < rho) (htau : lambda ≤ tau) : False := by\n let a := ∑ i, x i\n let b := ∑ i, y i\n let z := b • x - a • y\n have hyx : dotProduct y x = 0 := by rw [dotProduct_comm, hxy]\n have hzsum : ∑ i, z i = 0 := by\n simp only [z, Pi.sub_apply, Pi.smul_apply, smul_eq_mul,\n Finset.sum_sub_distrib, ← Finset.mul_sum]\n dsimp only [a, b]\n ring\n have hzq : dotProduct z (A.mulVec z) =\n b ^ 2 * rho * dotProduct x x + a ^ 2 * tau * dotProduct y y := by\n simp only [z, Matrix.mulVec_sub, Matrix.mulVec_smul, hx, hy,\n sub_dotProduct, dotProduct_sub, smul_dotProduct, dotProduct_smul,\n smul_eq_mul, hxy, hyx]\n ring\n have hzn : dotProduct z z = b ^ 2 * dotProduct x x + a ^ 2 * dotProduct y y := by\n simp only [z, sub_dotProduct, dotProduct_sub, smul_dotProduct,\n dotProduct_smul, smul_eq_mul, hxy, hyx]\n ring\n have hnonneg := hP.dotProduct_mulVec_nonneg z\n simp only [star_trivial] at hnonneg\n rw [component_rank_one_quadratic, hzsum, zero_pow (by decide : 2 ≠ 0), mul_zero,\n add_zero, Matrix.sub_mulVec, Matrix.smul_mulVec, Matrix.one_mulVec,\n dotProduct_sub, dotProduct_smul, smul_eq_mul, hzq, hzn] at hnonneg\n have hxne : x ≠ 0 := by\n intro h\n have hh := hsx\n simp only [h, Pi.zero_apply, Finset.sum_const_zero] at hh\n exact (lt_irrefl 0) hh\n have hxpos : 0 < dotProduct x x := lt_of_le_of_ne\n (Finset.sum_nonneg (fun i _ => mul_self_nonneg (x i)))\n (fun h => hxne (dotProduct_self_eq_zero.mp h.symm))\n have hynonneg : 0 ≤ dotProduct y y := Finset.sum_nonneg (fun i _ => mul_self_nonneg (y i))\n have hstrict := mul_pos (sq_pos_of_pos hsy) (mul_pos (sub_pos.mpr hrho) hxpos)\n have hweak := mul_nonneg (sq_nonneg a) (mul_nonneg (sub_nonneg.mpr htau) hynonneg)\n dsimp only [b] at hnonneg\n nlinarith only [hnonneg, hstrict, hweak]\ntheorem component_psd_rank_one_rank\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (Q : Matrix ι ι ℝ) (hQ : Q.PosSemidef)\n (hw : Module.finrank ℝ (LinearMap.ker Q.mulVecLin) ≠ 0 →\n ∃ x : ι → ℝ, Q.mulVec x = 0 ∧ (∑ i, x i) ≠ 0) :\n (Q + (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).rank =\n if Module.finrank ℝ (LinearMap.ker Q.mulVecLin) = 0 then Fintype.card ι\n else Fintype.card ι + 1 - Module.finrank ℝ (LinearMap.ker Q.mulVecLin) := by\n let K := LinearMap.ker Q.mulVecLin\n let P := Q + (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))\n let f : K →ₗ[ℝ] ℝ :=\n { toFun := fun x => ∑ i, x.val i\n map_add' := by intro x y; simp [Finset.sum_add_distrib]\n map_smul' := by intro c x; simp [Finset.mul_sum] }\n have hker : LinearMap.ker P.mulVecLin = (LinearMap.ker f).map K.subtype := by\n ext x\n constructor\n · intro hx\n obtain ⟨hqx, hs⟩ := (component_rank_one_kernel Q hQ x).mp hx\n exact ⟨⟨x, hqx⟩, hs, rfl⟩\n · rintro ⟨x, hx, rfl⟩\n exact (component_rank_one_kernel Q hQ x.val).mpr ⟨x.property, hx⟩\n have hdimker : Module.finrank ℝ (LinearMap.ker P.mulVecLin) =\n Module.finrank ℝ (LinearMap.ker f) := by\n rw [hker]\n exact Submodule.finrank_map_subtype_eq K (LinearMap.ker f)\n have hP := P.mulVecLin.finrank_range_add_finrank_ker\n rw [hdimker, Module.finrank_pi] at hP\n change P.rank + Module.finrank ℝ (LinearMap.ker f) = Fintype.card ι at hP\n have hf := f.finrank_range_add_finrank_ker\n change Module.finrank ℝ (LinearMap.range f) + Module.finrank ℝ (LinearMap.ker f) =\n Module.finrank ℝ K at hf\n change P.rank = if Module.finrank ℝ K = 0 then _ else _\n by_cases ht : Module.finrank ℝ K = 0\n · rw [if_pos ht]\n omega\n · rw [if_neg ht]\n change P.rank = Fintype.card ι + 1 - Module.finrank ℝ K\n obtain ⟨x, hx, hs⟩ := hw ht\n have hfs : Function.Surjective f := by\n intro c\n refine ⟨(c / ∑ i, x i) • (⟨x, hx⟩ : K), ?_⟩\n change ∑ i, (c / ∑ i, x i) * x i = c\n rw [← Finset.mul_sum, div_mul_cancel₀ _ hs]\n have hr : Module.finrank ℝ (LinearMap.range f) = 1 := by\n rw [LinearMap.range_eq_top.mpr hfs, finrank_top, Module.finrank_self]\n omega\ntheorem component_sum_by_components\n {ι : Type*} [Fintype ι] (G : SimpleGraph ι)\n [Fintype G.ConnectedComponent] [∀ C : G.ConnectedComponent, Fintype C.supp]\n (x : ι → ℝ) :\n (∑ C : G.ConnectedComponent, ∑ i : C.supp, x i.val) = ∑ i, x i := by\n classical\n convert Fintype.sum_fiberwise G.connectedComponentMk x using 1\n apply Finset.sum_congr rfl\n intro C _\n apply Finset.sum_congr (congrArg (fun e : Fintype C.supp => @Finset.univ C.supp e)\n (Subsingleton.elim _ _))\n intro i _\n rfl\ntheorem component_shift_posSemidef\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) [DecidableRel G.Adj]\n [Fintype G.ConnectedComponent]\n [∀ C : G.ConnectedComponent, Fintype C.supp]\n [∀ C : G.ConnectedComponent, DecidableRel C.toSimpleGraph.Adj]\n (lambda : ℝ)\n (hb : ∀ C : G.ConnectedComponent, ∀ x : C.supp → ℝ,\n dotProduct x ((C.toSimpleGraph.adjMatrix ℝ).mulVec x) ≤ lambda * dotProduct x x) :\n (lambda • (1 : Matrix ι ι ℝ) - G.adjMatrix ℝ).PosSemidef := by\n apply Matrix.PosSemidef.of_dotProduct_mulVec_nonneg\n ((Matrix.isHermitian_one.smul (by rfl : IsSelfAdjoint lambda)).sub\n (by\n change (G.adjMatrix ℝ).conjTranspose = G.adjMatrix ℝ\n rw [Matrix.conjTranspose_eq_transpose_of_trivial, G.transpose_adjMatrix]))\n intro x\n simp only [star_trivial, Matrix.sub_mulVec, Matrix.smul_mulVec, Matrix.one_mulVec,\n dotProduct_sub, dotProduct_smul, smul_eq_mul, sub_nonneg]\n have hc := Finset.sum_le_sum (fun C (_ : C ∈ Finset.univ) =>\n hb C (fun i => x i.val))\n have hq : (∑ C : G.ConnectedComponent,\n dotProduct (fun i : C.supp => x i.val)\n ((C.toSimpleGraph.adjMatrix ℝ).mulVec (fun i => x i.val))) =\n dotProduct x ((G.adjMatrix ℝ).mulVec x) := by\n simp only [dotProduct]\n simp_rw [component_adj_mulVec_restrict]\n convert component_sum_by_components G\n (fun i => x i * (G.adjMatrix ℝ).mulVec x i) using 1\n have hn : (∑ C : G.ConnectedComponent,\n lambda * dotProduct (fun i : C.supp => x i.val) (fun i => x i.val)) =\n lambda * dotProduct x x := by\n rw [← Finset.mul_sum]\n congr 1\n simp only [dotProduct]\n convert component_sum_by_components G (fun i => x i * x i) using 1\n calc\n _ = _ := hq.symm\n _ ≤ _ := hc\n _ = _ := hn\ntheorem component_extend_sum_pos\n {ι : Type*} [Fintype ι] (C : Set ι) [Fintype C] [Nonempty C]\n (p : C → ℝ) (hp : ∀ i, 0 < p i) :\n 0 < ∑ i, multiplicityExtend C p i := by\n have hs := multiplicityExtend_sum C (multiplicityExtend C p)\n (by intro i hi; simp [multiplicityExtend, hi])\n have hh : ∑ i : C, multiplicityExtend C p i.val = ∑ i : C, p i := by\n apply Finset.sum_congr rfl\n intro i _\n exact dif_pos i.property\n rw [hs, hh]\n exact Finset.sum_pos (fun i _ => hp i) Finset.univ_nonempty\ntheorem component_extend_eigenpair\n {ι : Type*} [Fintype ι] (G : SimpleGraph ι) [DecidableRel G.Adj]\n (C : G.ConnectedComponent) [Fintype C.supp] [DecidableRel C.toSimpleGraph.Adj]\n (p : C.supp → ℝ) (rho : ℝ)\n (hp : (C.toSimpleGraph.adjMatrix ℝ).mulVec p = rho • p) :\n (G.adjMatrix ℝ).mulVec (multiplicityExtend C.supp p) =\n rho • multiplicityExtend C.supp p := by\n rw [component_adj_mulVec_extend, hp]\n funext i\n by_cases hi : i ∈ C.supp <;> simp [multiplicityExtend, hi]\ntheorem component_extend_orthogonal\n {ι : Type*} [Fintype ι] (G : SimpleGraph ι)\n (C D : G.ConnectedComponent) (hCD : C ≠ D)\n (p : C.supp → ℝ) (q : D.supp → ℝ) :\n dotProduct (multiplicityExtend C.supp p) (multiplicityExtend D.supp q) = 0 := by\n classical\n apply Finset.sum_eq_zero\n intro i _\n by_cases hi : i ∈ C.supp\n · have hd : i ∉ D.supp := fun hd =>\n hCD (SimpleGraph.ConnectedComponent.eq_of_common_vertex hi hd)\n simp [multiplicityExtend, hd]\n · simp [multiplicityExtend, hi]\ntheorem component_accounting_of_perron_data\n {ι : Type*} [Fintype ι] [DecidableEq ι]\n (G : SimpleGraph ι) [DecidableRel G.Adj]\n [Fintype G.ConnectedComponent]\n [∀ C : G.ConnectedComponent, Fintype C.supp]\n [∀ C : G.ConnectedComponent, DecidableRel C.toSimpleGraph.Adj]\n (lambda : ℝ) (rho : G.ConnectedComponent → ℝ)\n (p : (C : G.ConnectedComponent) → C.supp → ℝ)\n (hp : ∀ C i, 0 < p C i)\n (he : ∀ C, (C.toSimpleGraph.adjMatrix ℝ).mulVec (p C) = rho C • p C)\n (hm : ∀ C, Module.finrank ℝ\n (Module.End.eigenspace (C.toSimpleGraph.adjMatrix ℝ).mulVecLin (rho C)) = 1)\n (hb : ∀ C x, dotProduct x ((C.toSimpleGraph.adjMatrix ℝ).mulVec x) ≤\n rho C * dotProduct x x)\n (hP : (lambda • (1 : Matrix ι ι ℝ) - G.adjMatrix ℝ +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).PosSemidef) :\n ((∀ C, rho C ≤ lambda) →\n let t := (Finset.univ.filter fun C => rho C = lambda).card\n (lambda • (1 : Matrix ι ι ℝ) - G.adjMatrix ℝ +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).rank =\n if t = 0 then Fintype.card ι else Fintype.card ι + 1 - t) ∧\n ((∃ C, lambda < rho C) → ∃ C, lambda < rho C ∧\n (∀ D, D ≠ C → rho D < lambda) ∧\n Module.finrank ℝ (Module.End.eigenspace (G.adjMatrix ℝ).mulVecLin lambda) =\n Module.finrank ℝ (Module.End.eigenspace (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda) ∧\n Fintype.card ι ≤\n (lambda • (1 : Matrix ι ι ℝ) - G.adjMatrix ℝ +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).rank + 1 +\n Module.finrank ℝ (Module.End.eigenspace (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda)) := by\n classical\n let Q := lambda • (1 : Matrix ι ι ℝ) - G.adjMatrix ℝ\n let P := Q + (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))\n let m := fun C : G.ConnectedComponent => Module.finrank ℝ\n (Module.End.eigenspace (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda)\n have hker : LinearMap.ker Q.mulVecLin =\n Module.End.eigenspace (G.adjMatrix ℝ).mulVecLin lambda := by\n ext x\n simp only [LinearMap.mem_ker, Module.End.mem_eigenspace_iff,\n Matrix.mulVecLin_apply, Q, Matrix.sub_mulVec, Matrix.smul_mulVec,\n Matrix.one_mulVec, sub_eq_zero, eq_comm]\n constructor\n · intro hle\n let t := (Finset.univ.filter fun C => rho C = lambda).card\n have hdim : Module.finrank ℝ (LinearMap.ker Q.mulVecLin) = t := by\n rw [hker, component_eigenspace_finrank_sum]\n have hC : ∀ C, m C = if rho C = lambda then 1 else 0 := by\n intro C\n by_cases h : rho C = lambda\n · rw [if_pos h]\n dsimp only [m]\n have hh := hm C\n rw [h] at hh\n convert hh using 1\n · have hz := component_eigenspace_eq_bot_of_rayleigh_lt\n (C.toSimpleGraph.adjMatrix ℝ) (rho C) lambda (lt_of_le_of_ne (hle C) h)\n (hb C)\n rw [if_neg h]\n dsimp only [m]\n convert (congrArg (fun S : Submodule ℝ (C.supp → ℝ) => Module.finrank ℝ S) hz).trans\n (finrank_bot ℝ (C.supp → ℝ)) using 1\n calc\n _ = ∑ C, if rho C = lambda then 1 else 0 := Finset.sum_congr rfl (fun C _ => hC C)\n _ = t := by simp only [t, Finset.card_eq_sum_ones, Finset.sum_filter]\n have hQ : Q.PosSemidef := component_shift_posSemidef G lambda (by\n intro C x\n exact (hb C x).trans (mul_le_mul_of_nonneg_right (hle C)\n (Finset.sum_nonneg (fun i _ => mul_self_nonneg (x i)))))\n have hw : Module.finrank ℝ (LinearMap.ker Q.mulVecLin) ≠ 0 →\n ∃ x : ι → ℝ, Q.mulVec x = 0 ∧ (∑ i, x i) ≠ 0 := by\n intro hn\n have ht : t ≠ 0 := fun h => hn (hdim.trans h)\n obtain ⟨C, hC⟩ := Finset.card_ne_zero.mp ht\n have hcrit : rho C = lambda := (Finset.mem_filter.mp hC).2\n letI : Nonempty C.supp := C.connected_toSimpleGraph.nonempty\n refine ⟨multiplicityExtend C.supp (p C), ?_, ne_of_gt (component_extend_sum_pos\n C.supp (p C) (hp C))⟩\n have hext := component_extend_eigenpair G C (p C) (rho C) (he C)\n rw [hcrit] at hext\n simp only [Q, Matrix.sub_mulVec, Matrix.smul_mulVec, Matrix.one_mulVec, hext, sub_self]\n have hr := component_psd_rank_one_rank Q hQ hw\n rw [hdim] at hr\n exact hr\n · rintro ⟨C, hC⟩\n have hless : ∀ D, D ≠ C → rho D < lambda := by\n intro D hDC\n by_contra hD\n have hD' : lambda ≤ rho D := le_of_not_gt hD\n letI : Nonempty C.supp := C.connected_toSimpleGraph.nonempty\n letI : Nonempty D.supp := D.connected_toSimpleGraph.nonempty\n exact component_rank_one_positive_pair_impossible (G.adjMatrix ℝ) lambda (rho C) (rho D)\n hP (multiplicityExtend C.supp (p C)) (multiplicityExtend D.supp (p D))\n (component_extend_eigenpair G C (p C) (rho C) (he C))\n (component_extend_eigenpair G D (p D) (rho D) (he D))\n (component_extend_orthogonal G C D (Ne.symm hDC) (p C) (p D))\n (component_extend_sum_pos C.supp (p C) (hp C))\n (component_extend_sum_pos D.supp (p D) (hp D)) hC hD'\n have hdim : Module.finrank ℝ (Module.End.eigenspace (G.adjMatrix ℝ).mulVecLin lambda) = m C := by\n rw [component_eigenspace_finrank_sum]\n apply Finset.sum_eq_single C\n · intro D _ hDC\n have hz := component_eigenspace_eq_bot_of_rayleigh_lt\n (D.toSimpleGraph.adjMatrix ℝ) (rho D) lambda (hless D hDC) (hb D)\n convert (congrArg (fun S : Submodule ℝ (D.supp → ℝ) => Module.finrank ℝ S) hz).trans\n (finrank_bot ℝ (D.supp → ℝ)) using 1\n · simp\n refine ⟨C, hC, hless, hdim, ?_⟩\n have hr := component_rank_one_general_bound (G.adjMatrix ℝ) lambda\n rw [hdim] at hr\n exact hr\ntheorem component_rank_one_accounting :\n ∀ (n : ℕ) (G : SimpleGraph (Fin n)) (lambda : ℝ), 0 < lambda →\n let A : Matrix (Fin n) (Fin n) ℝ :=\n (letI : DecidableRel G.Adj := Classical.decRel G.Adj; G.adjMatrix ℝ)\n let J : Matrix (Fin n) (Fin n) ℝ := Matrix.of (fun _ _ => 1)\n let P := lambda • (1 : Matrix (Fin n) (Fin n) ℝ) - A + (1 / 2 : ℝ) • J\n let r : G.ConnectedComponent → ENNReal := fun C =>\n (letI : Fintype C.supp := Fintype.ofFinite C.supp;\n letI : DecidableEq C.supp := Classical.decEq C.supp;\n letI : DecidableRel C.toSimpleGraph.Adj := Classical.decRel C.toSimpleGraph.Adj;\n spectralRadius ℝ (C.toSimpleGraph.adjMatrix ℝ))\n P.PosSemidef →\n ((¬ ∃ C, ENNReal.ofReal lambda < r C) →\n let t := ({C : G.ConnectedComponent | r C = ENNReal.ofReal lambda}).ncard\n P.rank = if t = 0 then n else n + 1 - t) ∧\n ((∃ C, ENNReal.ofReal lambda < r C) →\n ∃ C, ENNReal.ofReal lambda < r C ∧\n (∀ D, D ≠ C → r D < ENNReal.ofReal lambda) ∧\n let mC : ℕ :=\n (letI : Fintype C.supp := Fintype.ofFinite C.supp;\n letI : DecidableEq C.supp := Classical.decEq C.supp;\n letI : DecidableRel C.toSimpleGraph.Adj := Classical.decRel C.toSimpleGraph.Adj;\n Module.finrank ℝ (Module.End.eigenspace\n (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda))\n Module.finrank ℝ (Module.End.eigenspace A.mulVecLin lambda) = mC ∧\n n ≤ P.rank + 1 + mC) := by\n classical\n intro n G lambda hlam\n letI : DecidableRel G.Adj := Classical.decRel G.Adj\n letI : Fintype G.ConnectedComponent := Fintype.ofFinite G.ConnectedComponent\n letI (C : G.ConnectedComponent) : Fintype C.supp := Fintype.ofFinite C.supp\n letI (C : G.ConnectedComponent) : DecidableEq C.supp := Classical.decEq C.supp\n letI (C : G.ConnectedComponent) : DecidableRel C.toSimpleGraph.Adj :=\n Classical.decRel C.toSimpleGraph.Adj\n dsimp only\n intro hP\n choose rho p hnonneg hradius hpos heig hdim hbound using\n (fun C : G.ConnectedComponent =>\n component_connected_perron C.toSimpleGraph C.connected_toSimpleGraph)\n let r : G.ConnectedComponent → ENNReal :=\n fun C => spectralRadius ℝ (C.toSimpleGraph.adjMatrix ℝ)\n have hr (C : G.ConnectedComponent) : r C = ENNReal.ofReal (rho C) := by\n convert hradius C using 1\n have heq (C : G.ConnectedComponent) :\n r C = ENNReal.ofReal lambda ↔ rho C = lambda := by\n rw [hr C]\n exact ENNReal.ofReal_eq_ofReal_iff (hnonneg C) hlam.le\n have hgt (C : G.ConnectedComponent) :\n ENNReal.ofReal lambda < r C ↔ lambda < rho C := by\n rw [hr C]\n exact ENNReal.ofReal_lt_ofReal_iff_of_nonneg hlam.le\n have hlt (C : G.ConnectedComponent) :\n r C < ENNReal.ofReal lambda ↔ rho C < lambda := by\n rw [hr C]\n exact ENNReal.ofReal_lt_ofReal_iff hlam\n have hcase := component_accounting_of_perron_data G lambda rho p hpos heig hdim hbound hP\n constructor\n · intro hnone\n have hle : ∀ C, rho C ≤ lambda := by\n intro C\n apply le_of_not_gt\n intro h\n exact hnone ⟨C, (hgt C).mpr h⟩\n have hs : ({C : G.ConnectedComponent | r C = ENNReal.ofReal lambda} : Set _) =\n {C : G.ConnectedComponent | rho C = lambda} := by\n ext C\n exact heq C\n have ht : ({C : G.ConnectedComponent | r C = ENNReal.ofReal lambda} : Set _).ncard =\n (Finset.univ.filter fun C => rho C = lambda).card := by\n rw [hs]\n simp only [Set.ncard_eq_toFinset_card', Set.toFinset_ofPred]\n have hh := hcase.1 hle\n dsimp only at hh\n change _ = if ({C : G.ConnectedComponent | r C = ENNReal.ofReal lambda} : Set _).ncard = 0\n then n else n + 1 - ({C : G.ConnectedComponent | r C = ENNReal.ofReal lambda} : Set _).ncard\n rw [ht]\n simpa only [Fintype.card_fin] using hh\n · intro hex\n have hex' : ∃ C, lambda < rho C := by\n obtain ⟨C, hC⟩ := hex\n exact ⟨C, (hgt C).mp hC⟩\n obtain ⟨C, hC, hD, hm, hn⟩ := hcase.2 hex'\n refine ⟨C, (hgt C).mpr hC, ?_, ?_⟩\n · intro D hDC\n exact (hlt D).mpr (hD D hDC)\n · constructor\n · convert hm using 1\n · simpa only [Fintype.card_fin] using hn\ntheorem supercritical_graph_rank_bound :\n ∀ (Δ : ℕ) (ε : ℝ), 0 < ε → ∃ M : ℕ,\n ∀ (n : ℕ) (G : SimpleGraph (Fin n)) (lambda : ℝ), 0 < lambda →\n (∀ i, ({j : Fin n | G.Adj i j} : Set (Fin n)).ncard ≤ Δ) →\n let A : Matrix (Fin n) (Fin n) ℝ :=\n (letI : DecidableRel G.Adj := Classical.decRel G.Adj; G.adjMatrix ℝ)\n let P := lambda • (1 : Matrix (Fin n) (Fin n) ℝ) - A +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))\n let r : G.ConnectedComponent → ENNReal := fun C =>\n (letI : Fintype C.supp := Fintype.ofFinite C.supp;\n letI : DecidableEq C.supp := Classical.decEq C.supp;\n letI : DecidableRel C.toSimpleGraph.Adj := Classical.decRel C.toSimpleGraph.Adj;\n spectralRadius ℝ (C.toSimpleGraph.adjMatrix ℝ))\n P.PosSemidef → (∃ C, ENNReal.ofReal lambda < r C) →\n n ≤ P.rank + 1 + M ∨\n (n : ℝ) ≤ (P.rank : ℝ) + 1 + ε * (n : ℝ) := by\n classical\n intro Δ ε hε\n obtain ⟨M, hM⟩ := uniform_second_eigenvalue_multiplicity Δ ε hε\n refine ⟨M, ?_⟩\n intro n G lambda hlam hdegree\n letI : DecidableRel G.Adj := Classical.decRel G.Adj\n letI (C : G.ConnectedComponent) : Fintype C.supp := Fintype.ofFinite C.supp\n letI (C : G.ConnectedComponent) : DecidableEq C.supp := Classical.decEq C.supp\n letI (C : G.ConnectedComponent) : DecidableRel C.toSimpleGraph.Adj :=\n Classical.decRel C.toSimpleGraph.Adj\n dsimp only\n intro hP hex\n obtain ⟨C, _, _, _, hn⟩ :=\n (component_rank_one_accounting n G lambda hlam hP).2 hex\n have hcard : Nat.card C = Nat.card C.supp := Nat.card_congr\n { toFun := fun i => ⟨i.val, i.property⟩\n invFun := fun i => ⟨i.val, i.property⟩\n left_inv := fun _ => rfl\n right_inv := fun _ => rfl }\n by_cases hsize : M ≤ Fintype.card C.supp\n · right\n obtain ⟨H, f, hH, hf, hdeg, hA, hdim⟩ :=\n supercritical_component_overFin_data n G C Δ hdegree\n letI : DecidableRel H.Adj := Classical.decRel H.Adj\n letI : Nonempty (Fin (Fintype.card C.supp)) := hH.nonempty\n have hPH : (lambda •\n (1 : Matrix (Fin (Fintype.card C.supp)) (Fin (Fintype.card C.supp)) ℝ) -\n H.adjMatrix ℝ + (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).PosSemidef := by\n rw [← hA]\n exact upper_rank_one_principal_psd (G.adjMatrix ℝ) lambda f hf hP\n have hHerm : (H.adjMatrix ℝ).IsHermitian := by\n change (H.adjMatrix ℝ).conjTranspose = H.adjMatrix ℝ\n rw [Matrix.conjTranspose_eq_transpose_of_trivial, H.transpose_adjMatrix]\n have hm := hM (Fintype.card C.supp) H lambda hsize hlam hH hdeg hHerm\n (upper_psd_eigenvalues_except_one (H.adjMatrix ℝ) hHerm lambda hPH)\n rw [hdim lambda] at hm\n have hCn : Fintype.card C.supp ≤ n := by\n simpa only [Fintype.card_fin] using\n Fintype.card_le_of_injective (Subtype.val : C.supp → Fin n) Subtype.val_injective\n have hCnR : (Fintype.card C.supp : ℝ) ≤ (n : ℝ) := by exact_mod_cast hCn\n have hmul := mul_le_mul_of_nonneg_left hCnR hε.le\n have hnR : (n : ℝ) ≤\n ((lambda • (1 : Matrix (Fin n) (Fin n) ℝ) - G.adjMatrix ℝ +\n (1 / 2 : ℝ) • Matrix.of (fun _ _ => (1 : ℝ))).rank : ℝ) + 1 +\n Module.finrank ℝ (Module.End.eigenspace\n (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda) := by exact_mod_cast hn\n linarith only [hnR, hm, hmul]\n · left\n have hm := upper_small_eigenspace_bound (C.toSimpleGraph.adjMatrix ℝ) lambda\n simp only [← Nat.card_eq_fintype_card] at hm hsize\n rw [hcard] at hm\n exact hn.trans (Nat.add_le_add_left (by omega :\n Module.finrank ℝ (Module.End.eigenspace\n (C.toSimpleGraph.adjMatrix ℝ).mulVecLin lambda) ≤ M) _)\ntheorem lower_floor_count_real_subtraction (q d : ℕ) (hq : 2 ≤ q) (hd : 1 ≤ d) :\n ⌊(q * (d - 1) : ℝ) / (q - 1 : ℝ)⌋₊ =\n q * ((d - 1) / (q - 1)) + (d - 1) % (q - 1) := by\n have hq1 : 1 ≤ q := by omega\n have hqreal : (2 : ℝ) ≤ q := by exact_mod_cast hq\n have hqpos : (0 : ℝ) < (q : ℝ) - 1 := by linarith\n have heq : (q * (d - 1) : ℝ) / (q - 1 : ℝ) =\n ((d - 1 : ℕ) : ℝ) / ((q - 1 : ℕ) : ℝ) + ((d - 1 : ℕ) : ℝ) := by\n rw [Nat.cast_sub hd, Nat.cast_sub hq1]\n push_cast\n field_simp [ne_of_gt hqpos]\n ring\n rw [heq, Nat.floor_add_natCast (by positivity), Nat.floor_div_eq_div]\n have hdiv := Nat.div_add_mod (d - 1) (q - 1)\n calc\n (d - 1) / (q - 1) + (d - 1) =\n (d - 1) / (q - 1) + ((q - 1) * ((d - 1) / (q - 1)) +\n (d - 1) % (q - 1)) := congrArg (fun a => (d - 1) / (q - 1) + a) hdiv.symm\n _ = ((q - 1) + 1) * ((d - 1) / (q - 1)) + (d - 1) % (q - 1) := by ring\n _ = q * ((d - 1) / (q - 1)) + (d - 1) % (q - 1) := by\n rw [Nat.sub_add_cancel hq1]\ntheorem floor_lower_bound_from_copies (q d : ℕ) (hq : 2 ≤ q) (hd : 1 ≤ d) :\n (q - 1) * ((d - 1) / (q - 1)) + (d - 1) % (q - 1) + 1 = d := by\n rw [Nat.div_add_mod, Nat.sub_add_cancel hd]\ntheorem gram_bridge_rank_add_le {m n : ℕ}\n (A B : Matrix (Fin m) (Fin n) ℝ) : (A + B).rank ≤ A.rank + B.rank := by\n rw [Matrix.rank, Matrix.rank, Matrix.rank, Matrix.mulVecLin_add]\n exact (Submodule.finrank_mono (LinearMap.range_add_le A.mulVecLin B.mulVecLin)).trans\n (Submodule.finrank_add_le_finrank_add_finrank _ _)\ntheorem gram_bridge_rank_smul_le {m n : ℕ} (a : ℝ)\n (A : Matrix (Fin m) (Fin n) ℝ) : (a • A).rank ≤ A.rank := by\n rw [Matrix.rank, Matrix.rank]\n apply Submodule.finrank_mono\n rintro x ⟨c, rfl⟩\n refine ⟨a • c, ?_⟩\n simp only [Matrix.mulVecLin_apply, Matrix.mulVec_smul, Matrix.smul_mulVec]\ntheorem gram_spectral_bridge_of_unit_vectors\n (α : ℝ) (hα : α ∈ Set.Ioo 0 1) (d n : ℕ)\n (v : Fin n → EuclideanSpace ℝ (Fin d))\n (hnorm : ∀ i, ‖v i‖ = 1)\n (hangle : ∀ i j, i ≠ j → |inner ℝ (v i) (v j)| = α) :\n ∃ G : SimpleGraph (Fin n),\n let A : Matrix (Fin n) (Fin n) ℝ :=\n (letI : DecidableRel G.Adj := Classical.decRel G.Adj; G.adjMatrix ℝ)\n Matrix.gram ℝ v = (1 - α) • (1 : Matrix (Fin n) (Fin n) ℝ) +\n α • Matrix.of (fun _ _ : Fin n => (1 : ℝ)) - (2 * α) • A ∧\n (((1 - α) / (2 * α)) • (1 : Matrix (Fin n) (Fin n) ℝ) - A).rank ≤ d + 1 ∧\n n ≤ d + 1 + Module.finrank ℝ\n (Module.End.eigenspace A.mulVecLin ((1 - α) / (2 * α))) := by\n classical\n let G := SimpleGraph.fromRel (fun i j => inner ℝ (v i) (v j) < 0)\n let A : Matrix (Fin n) (Fin n) ℝ :=\n (letI : DecidableRel G.Adj := Classical.decRel G.Adj; G.adjMatrix ℝ)\n have hadj : ∀ i j, G.Adj i j ↔ i ≠ j ∧ inner ℝ (v i) (v j) < 0 := by\n intro i j\n simp only [G, SimpleGraph.fromRel_adj, real_inner_comm (v j) (v i), or_self]\n have hgram : Matrix.gram ℝ v = (1 - α) • (1 : Matrix (Fin n) (Fin n) ℝ) +\n α • Matrix.of (fun _ _ : Fin n => (1 : ℝ)) - (2 * α) • A := by\n ext i j\n by_cases hij : i = j\n · subst j\n simp [Matrix.gram_apply, hnorm, A]\n · rcases (abs_eq hα.1.le).mp (hangle i j hij) with hpos | hneg\n · have hnot : ¬α < 0 := not_lt.mpr hα.1.le\n simp [Matrix.gram_apply, hij, A, hadj, hpos, hnot]\n · simp [Matrix.gram_apply, hij, A, hadj, hneg, hα.1]\n ring\n have hgramrank : (Matrix.gram ℝ v).rank ≤ d := by\n let b := EuclideanSpace.basisFun (Fin d) ℝ\n let M : Matrix (Fin d) (Fin n) ℝ := Matrix.of (fun i j => b.repr (v j) i)\n have hg : Matrix.gram ℝ v = M.conjTranspose * M :=\n Matrix.gram_eq_conjTranspose_mul b v\n calc\n (Matrix.gram ℝ v).rank = (M.conjTranspose * M).rank := congrArg Matrix.rank hg\n _ ≤ M.rank := Matrix.rank_mul_le_right _ _\n _ ≤ d := by simpa only [Fintype.card_fin] using Matrix.rank_le_card_height M\n let J : Matrix (Fin n) (Fin n) ℝ := Matrix.of (fun _ _ => (1 : ℝ))\n let B : Matrix (Fin n) (Fin n) ℝ := ((1 - α) / (2 * α)) • 1 - A\n have hα0 : α ≠ 0 := ne_of_gt hα.1\n have heq : B = (1 / (2 * α)) • Matrix.gram ℝ v + (-1 / 2 : ℝ) • J := by\n rw [hgram]\n ext i j\n simp only [B, J, Matrix.add_apply, Matrix.sub_apply, Matrix.smul_apply, smul_eq_mul]\n field_simp [hα0] <;> ring\n have hJ : J.rank ≤ 1 := by\n have hones : J = Matrix.vecMulVec (fun _ : Fin n => (1 : ℝ))\n (fun _ : Fin n => (1 : ℝ)) := by\n ext i j\n simp [J, Matrix.vecMulVec]\n rw [hones]\n exact Matrix.rank_vecMulVec_le _ _\n have hrank : B.rank ≤ d + 1 := by\n rw [heq]\n calc\n ((1 / (2 * α)) • Matrix.gram ℝ v + (-1 / 2 : ℝ) • J).rank ≤\n ((1 / (2 * α)) • Matrix.gram ℝ v).rank + ((-1 / 2 : ℝ) • J).rank :=\n gram_bridge_rank_add_le _ _\n _ ≤ (Matrix.gram ℝ v).rank + J.rank :=\n Nat.add_le_add (gram_bridge_rank_smul_le _ _) (gram_bridge_rank_smul_le _ _)\n _ ≤ d + 1 := Nat.add_le_add hgramrank hJ\n have hker : LinearMap.ker B.mulVecLin =\n Module.End.eigenspace A.mulVecLin ((1 - α) / (2 * α)) := by\n ext c\n rw [LinearMap.mem_ker, Module.End.mem_eigenspace_iff]\n simp only [Matrix.mulVecLin_apply, B, Matrix.sub_mulVec, Matrix.smul_mulVec,\n Matrix.one_mulVec, sub_eq_zero]\n exact eq_comm\n have hdim : B.rank + Module.finrank ℝ (LinearMap.ker B.mulVecLin) = n := by\n simpa only [Matrix.rank, Module.finrank_fintype_fun_eq_card, Fintype.card_fin] using\n LinearMap.finrank_range_add_finrank_ker B.mulVecLin\n rw [hker] at hdim\n refine ⟨G, hgram, hrank, ?_⟩\n exact hdim.symm.trans_le (Nat.add_le_add_right hrank _)\ntheorem switching_inner_weighted_sum\n {ι H : Type*} [DecidableEq ι] [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (s : Finset ι) (v : ι → H) (a : ℝ) (c : ι → ℝ)\n (hdiag : ∀ i ∈ s, (inner ℝ (v i) (v i)) = 1)\n (hoff : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → (inner ℝ (v i) (v j)) = a) :\n (inner ℝ (∑ i ∈ s, c i • v i) (∑ i ∈ s, c i • v i)) =\n (1 - a) * (∑ i ∈ s, c i ^ 2) + a * (∑ i ∈ s, c i) ^ 2 := by\n have hrow : ∀ i ∈ s, (inner ℝ (v i) (∑ j ∈ s, c j • v j)) =\n (1 - a) * c i + a * ∑ j ∈ s, c j := by\n intro i hi\n rw [inner_sum]\n simp_rw [real_inner_smul_right]\n calc\n ∑ j ∈ s, c j * (inner ℝ (v i) (v j)) =\n ∑ j ∈ s, (a * c j + if j = i then (1 - a) * c j else 0) := by\n apply Finset.sum_congr rfl\n intro j hj\n by_cases hij : j = i\n · subst j\n rw [hdiag i hi, if_pos rfl]\n ring\n · rw [hoff i hi j hj (Ne.symm hij), if_neg hij]\n ring\n _ = (1 - a) * c i + a * ∑ j ∈ s, c j := by\n rw [Finset.sum_add_distrib, Finset.sum_ite_eq', if_pos hi,\n ← Finset.mul_sum]\n ring\n rw [sum_inner]\n simp_rw [real_inner_smul_left]\n rw [Finset.sum_congr rfl (fun i hi => congrArg (fun x : ℝ => c i * x) (hrow i hi))]\n simp_rw [mul_add]\n rw [Finset.sum_add_distrib]\n have hfirst : (∑ i ∈ s, c i * ((1 - a) * c i)) =\n (1 - a) * ∑ i ∈ s, c i ^ 2 := by\n rw [Finset.mul_sum]\n apply Finset.sum_congr rfl\n intro i hi\n ring\n have hsecond : (∑ i ∈ s, c i * (a * ∑ j ∈ s, c j)) =\n a * (∑ i ∈ s, c i) ^ 2 := by\n rw [← Finset.sum_mul]\n ring\n rw [hfirst, hsecond]\ntheorem switching_negative_clique_bound\n {ι H : Type*} [DecidableEq ι] [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (s : Finset ι) (v : ι → H) (α : ℝ) (hα : 0 < α)\n (hdiag : ∀ i ∈ s, (inner ℝ (v i) (v i)) = 1)\n (hoff : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → (inner ℝ (v i) (v j)) = -α) :\n (s.card : ℝ) ≤ 1 + 1 / α := by\n have hs := switching_inner_weighted_sum s v (-α) (fun _ => 1) hdiag hoff\n simp only [one_smul, one_pow, Finset.sum_const, nsmul_eq_mul, mul_one] at hs\n have hn := real_inner_self_nonneg (x := ∑ i ∈ s, v i)\n have hc : 0 ≤ (s.card : ℝ) := Nat.cast_nonneg _\n by_cases hz : s.card = 0\n · rw [hz, Nat.cast_zero]\n positivity\n · have hcpos : 0 < (s.card : ℝ) := Nat.cast_pos.mpr (Nat.pos_of_ne_zero hz)\n have hb : α * (s.card : ℝ) ≤ 1 + α := by\n nlinarith [hs]\n calc\n (s.card : ℝ) ≤ (1 + α) / α := (le_div_iff₀ hα).mpr (by\n simpa only [mul_comm] using hb)\n _ = 1 + 1 / α := by field_simp; ring\ntheorem switching_residual_class_bound\n {ι H : Type*} [DecidableEq ι] [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (s : Finset ι) (v : ι → H) (z : H) (α a : ℝ) (hα : α ≤ 1) (ha : α < a)\n (hdiag : ∀ i ∈ s, (inner ℝ (v i) (v i)) = 1)\n (hoff : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → (inner ℝ (v i) (v j)) ≤ α)\n (hvz : ∀ i ∈ s, (inner ℝ (v i) (z)) = a) (hzz : (inner ℝ (z) (z)) = a) :\n (s.card : ℝ) ≤ (1 - α) / (a - α) := by\n have hsum : (inner ℝ (∑ i ∈ s, (v i - z)) (∑ i ∈ s, (v i - z))) ≤\n (1 - α) * (s.card : ℝ) - (a - α) * (s.card : ℝ) ^ 2 := by\n rw [sum_inner]\n simp_rw [inner_sum]\n calc\n ∑ i ∈ s, ∑ j ∈ s, (inner ℝ (v i - z) (v j - z)) ≤\n ∑ i ∈ s, ∑ j ∈ s, ((α - a) + if j = i then 1 - α else 0) := by\n apply Finset.sum_le_sum\n intro i hi\n apply Finset.sum_le_sum\n intro j hj\n rw [inner_sub_left, inner_sub_right, inner_sub_right,\n hvz i hi, ← real_inner_comm z (v j), hvz j hj, hzz]\n by_cases hij : j = i\n · subst j\n rw [hdiag i hi, if_pos rfl]\n linarith\n · rw [if_neg hij]\n linarith [hoff i hi j hj (Ne.symm hij)]\n _ = (1 - α) * (s.card : ℝ) - (a - α) * (s.card : ℝ) ^ 2 := by\n simp only [Finset.sum_add_distrib, Finset.sum_const, nsmul_eq_mul,\n Finset.sum_ite_eq']\n have he : ∀ i ∈ s, (if i ∈ s then 1 - α else 0) = 1 - α := by\n intro i hi\n rw [if_pos hi]\n rw [Finset.sum_congr rfl he]\n simp only [Finset.sum_const, nsmul_eq_mul]\n ring\n have hn := real_inner_self_nonneg (x := ∑ i ∈ s, (v i - z))\n by_cases hz : s.card = 0\n · rw [hz, Nat.cast_zero]\n apply div_nonneg ?_ (sub_pos.mpr ha).le\n exact sub_nonneg.mpr hα\n · have hcpos : 0 < (s.card : ℝ) := Nat.cast_pos.mpr (Nat.pos_of_ne_zero hz)\n apply (le_div_iff₀ (sub_pos.mpr ha)).mpr\n nlinarith\ntheorem switching_mixed_sign_bound\n {ι H : Type*} [DecidableEq ι] [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (p q : Finset ι) (v : ι → H) (w : H) (α : ℝ)\n (hdis : Disjoint p q) (hp : p.Nonempty) (hq : q.Nonempty)\n (hw : (inner ℝ (w) (w)) = 1)\n (hdiag : ∀ i ∈ p ∪ q, (inner ℝ (v i) (v i)) = 1)\n (hoff : ∀ i ∈ p ∪ q, ∀ j ∈ p ∪ q, i ≠ j → (inner ℝ (v i) (v j)) = α)\n (hneg : ∀ i ∈ p, (inner ℝ (w) (v i)) = -α)\n (hpos : ∀ i ∈ q, (inner ℝ (w) (v i)) = α) :\n 4 * α ^ 2 * (p.card : ℝ) * (q.card : ℝ) ≤\n (1 - α) * ((p.card : ℝ) + (q.card : ℝ)) := by\n let c : ι → ℝ := fun i => if i ∈ p then (q.card : ℝ) else -(p.card : ℝ)\n have hc_p : ∀ i ∈ p, c i = (q.card : ℝ) := by\n intro i hi\n simp only [c, if_pos hi]\n have hc_q : ∀ i ∈ q, c i = -(p.card : ℝ) := by\n intro i hi\n have hn : i ∉ p := fun h => Finset.disjoint_left.mp hdis h hi\n simp only [c, if_neg hn]\n have hsum : (∑ i ∈ p ∪ q, c i) = 0 := by\n rw [Finset.sum_union hdis, Finset.sum_congr rfl hc_p, Finset.sum_congr rfl hc_q]\n simp only [Finset.sum_const, nsmul_eq_mul]\n ring\n have hsq : (∑ i ∈ p ∪ q, c i ^ 2) =\n (p.card : ℝ) * (q.card : ℝ) * ((p.card : ℝ) + (q.card : ℝ)) := by\n rw [Finset.sum_union hdis,\n Finset.sum_congr rfl (fun i hi => congrArg (fun x : ℝ => x ^ 2) (hc_p i hi)),\n Finset.sum_congr rfl (fun i hi => congrArg (fun x : ℝ => x ^ 2) (hc_q i hi))]\n simp only [Finset.sum_const, nsmul_eq_mul]\n ring\n have hiw : (inner ℝ (w) (∑ i ∈ p ∪ q, c i • v i)) =\n -2 * α * (p.card : ℝ) * (q.card : ℝ) := by\n rw [inner_sum]\n simp_rw [real_inner_smul_right]\n rw [Finset.sum_union hdis]\n have hp' : (∑ i ∈ p, c i * (inner ℝ (w) (v i))) = ∑ i ∈ p, (q.card : ℝ) * -α := by\n apply Finset.sum_congr rfl\n intro i hi\n rw [hc_p i hi, hneg i hi]\n have hq' : (∑ i ∈ q, c i * (inner ℝ (w) (v i))) = ∑ i ∈ q, -(p.card : ℝ) * α := by\n apply Finset.sum_congr rfl\n intro i hi\n rw [hc_q i hi, hpos i hi]\n rw [hp', hq']\n simp only [Finset.sum_const, nsmul_eq_mul]\n ring\n have hcs := real_inner_mul_inner_self_le w (∑ i ∈ p ∪ q, c i • v i)\n rw [hw, switching_inner_weighted_sum (p ∪ q) v α c hdiag hoff,\n hiw, hsum, hsq] at hcs\n have hpq : 0 < (p.card : ℝ) * (q.card : ℝ) :=\n mul_pos (Nat.cast_pos.mpr (Finset.card_pos.mpr hp))\n (Nat.cast_pos.mpr (Finset.card_pos.mpr hq))\n by_contra hnot\n have hgt := mul_pos hpq (sub_pos.mpr (lt_of_not_ge hnot))\n nlinarith only [hcs, hgt]\ntheorem switching_seed_projection\n {ι H : Type*} [DecidableEq ι] [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (s p : Finset ι) (v : ι → H) (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n (hp : p ⊆ s) (hs : s.Nonempty)\n (hdiag : ∀ i ∈ s, (inner ℝ (v i) (v i)) = 1)\n (hoff : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → (inner ℝ (v i) (v j)) = α) :\n let t : ℝ := s.card\n let k : ℝ := p.card\n let b : ι → ℝ := fun i => if i ∈ p then -1 else 1\n let c : ι → ℝ := fun i => α / (1 - α) *\n (b i - α * (t - 2 * k) / (1 + (t - 1) * α))\n let z : H := ∑ i ∈ s, c i • v i\n let a : ℝ := α ^ 2 / (1 - α) *\n (t - α * (t - 2 * k) ^ 2 / (1 + (t - 1) * α))\n (inner ℝ (z) (z)) = a ∧\n (∀ w : H, (∀ i ∈ s, (inner ℝ (w) (v i)) = α * b i) → (inner ℝ (w) (z)) = a) ∧\n a - α = α * (4 * α ^ 2 * k * (t - k) - (1 - α) ^ 2) /\n ((1 - α) * (1 + (t - 1) * α)) := by\n dsimp only\n let t : ℝ := s.card\n let k : ℝ := p.card\n let b : ι → ℝ := fun i => if i ∈ p then -1 else 1\n let L : ℝ := 1 + (t - 1) * α\n have h0 : 1 - α ≠ 0 := ne_of_gt (sub_pos.mpr hα.2)\n have ht : 1 ≤ t := by\n change (1 : ℝ) ≤ (s.card : ℝ)\n have ht_nat : 1 ≤ s.card := Finset.card_pos.mpr hs\n exact_mod_cast ht_nat\n have hL : L ≠ 0 := by\n dsimp [L]\n have hprod : 0 ≤ (t - 1) * α := mul_nonneg (sub_nonneg.mpr ht) hα.1.le\n linarith\n have hbsum : (∑ i ∈ s, b i) = t - 2 * k := by\n have hsplit : s = p ∪ (s \\ p) := (Finset.union_sdiff_of_subset hp).symm\n have hdis : Disjoint p (s \\ p) := by\n apply Finset.disjoint_left.mpr\n intro i hi hj\n exact (Finset.mem_sdiff.mp hj).2 hi\n rw [hsplit, Finset.sum_union hdis]\n have hp' : (∑ i ∈ p, b i) = -(p.card : ℝ) := by\n simp only [b]\n rw [Finset.sum_congr rfl (fun i hi => if_pos hi)]\n simp\n have hq' : (∑ i ∈ s \\ p, b i) = ((s \\ p).card : ℝ) := by\n rw [Finset.sum_congr rfl (fun i hi => if_neg (Finset.mem_sdiff.mp hi).2)]\n simp\n rw [hp', hq', Finset.card_sdiff_of_subset hp, Nat.cast_sub (Finset.card_le_card hp)]\n dsimp [t, k]\n ring\n have hbsq : (∑ i ∈ s, b i ^ 2) = t := by\n have hb : ∀ i ∈ s, b i ^ 2 = 1 := by\n intro i hi\n dsimp [b]\n split_ifs <;> norm_num\n rw [Finset.sum_congr rfl hb]\n simp [t]\n let c : ι → ℝ := fun i => α / (1 - α) * (b i - α * (t - 2 * k) / L)\n have hcsum : (∑ i ∈ s, c i) = α * (t - 2 * k) / L := by\n simp only [c, ← Finset.mul_sum, Finset.sum_sub_distrib,\n Finset.sum_const, nsmul_eq_mul, hbsum]\n change α / (1 - α) * ((t - 2 * k) - t * (α * (t - 2 * k) / L)) = _\n field_simp [h0, hL]\n dsimp [L]\n ring\n have hcsq : (∑ i ∈ s, c i ^ 2) = (α / (1 - α)) ^ 2 *\n (t - 2 * (α * (t - 2 * k) / L) * (t - 2 * k) +\n t * (α * (t - 2 * k) / L) ^ 2) := by\n have hc : ∀ i ∈ s, c i ^ 2 = (α / (1 - α)) ^ 2 *\n (b i ^ 2 - 2 * (α * (t - 2 * k) / L) * b i +\n (α * (t - 2 * k) / L) ^ 2) := by\n intro i hi\n dsimp [c]\n ring\n rw [Finset.sum_congr rfl hc, ← Finset.mul_sum]\n simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib, ← Finset.mul_sum,\n Finset.sum_const, nsmul_eq_mul, hbsq, hbsum]\n rfl\n change (inner ℝ (∑ i ∈ s, c i • v i) (∑ i ∈ s, c i • v i)) =\n α ^ 2 / (1 - α) * (t - α * (t - 2 * k) ^ 2 / L) ∧\n (∀ w : H, (∀ i ∈ s, (inner ℝ (w) (v i)) = α * b i) →\n (inner ℝ (w) (∑ i ∈ s, c i • v i)) =\n α ^ 2 / (1 - α) * (t - α * (t - 2 * k) ^ 2 / L)) ∧\n α ^ 2 / (1 - α) * (t - α * (t - 2 * k) ^ 2 / L) - α =\n α * (4 * α ^ 2 * k * (t - k) - (1 - α) ^ 2) / ((1 - α) * L)\n refine ⟨?_, ?_, ?_⟩\n · rw [switching_inner_weighted_sum s v α c hdiag hoff, hcsum, hcsq]\n field_simp [h0, hL]\n dsimp [L]\n ring\n · intro w hw\n rw [inner_sum]\n simp_rw [real_inner_smul_right]\n rw [Finset.sum_congr rfl (fun i hi => congrArg (fun x : ℝ => c i * x) (hw i hi))]\n have hc : ∀ i ∈ s, c i * (α * b i) =\n α ^ 2 / (1 - α) * (b i ^ 2 - (α * (t - 2 * k) / L) * b i) := by\n intro i hi\n dsimp [c]\n ring\n rw [Finset.sum_congr rfl hc, ← Finset.mul_sum]\n simp only [Finset.sum_sub_distrib, ← Finset.mul_sum, hbsq, hbsum]\n ring\n · field_simp [h0, hL]\n dsimp [L]\n ring\ntheorem switching_finite_ramsey (p q : ℕ) :\n ∃ N : ℕ, ∀ {ι : Type*} [DecidableEq ι] (s : Finset ι) (R : ι → ι → Prop),\n Symmetric R → N ≤ s.card →\n (∃ u : Finset ι, u ⊆ s ∧ u.card = p ∧\n ∀ i ∈ u, ∀ j ∈ u, i ≠ j → R i j) ∨\n (∃ u : Finset ι, u ⊆ s ∧ u.card = q ∧\n ∀ i ∈ u, ∀ j ∈ u, i ≠ j → ¬R i j) := by\n classical\n induction p generalizing q with\n | zero =>\n refine ⟨0, ?_⟩\n intro ι _ s R hR hcard\n exact Or.inl ⟨∅, Finset.empty_subset s, rfl, by simp⟩\n | succ p ihp =>\n induction q with\n | zero =>\n refine ⟨0, ?_⟩\n intro ι _ s R hR hcard\n exact Or.inr ⟨∅, Finset.empty_subset s, rfl, by simp⟩\n | succ q ihq =>\n obtain ⟨N₁, hN₁⟩ := ihp (q + 1)\n obtain ⟨N₂, hN₂⟩ := ihq\n refine ⟨N₁ + N₂ + 1, ?_⟩\n intro ι _ s R hR hcard\n have hs : s.Nonempty := Finset.card_pos.mp (by omega)\n obtain ⟨x, hx⟩ := hs\n let a := (s.erase x).filter (R x)\n let b := (s.erase x).filter (fun i => ¬R x i)\n have hsplit : a.card + b.card = s.card - 1 := by\n dsimp [a, b]\n rw [Finset.card_filter_add_card_filter_not, Finset.card_erase_of_mem hx]\n have hsuba : a ⊆ s := fun i hi =>\n (Finset.mem_erase.mp (Finset.mem_filter.mp hi).1).2\n have hsubb : b ⊆ s := fun i hi =>\n (Finset.mem_erase.mp (Finset.mem_filter.mp hi).1).2\n by_cases ha : N₁ ≤ a.card\n · rcases hN₁ a R hR ha with ⟨u, hua, hu, hRu⟩ | ⟨u, hua, hu, hRu⟩\n · left\n have hxu : x ∉ u := by\n intro h\n exact (Finset.mem_erase.mp (Finset.mem_filter.mp (hua h)).1).1 rfl\n refine ⟨insert x u, Finset.insert_subset hx (Finset.Subset.trans hua hsuba),\n by rw [Finset.card_insert_of_notMem hxu, hu], ?_⟩\n intro i hi j hj hij\n rcases Finset.mem_insert.mp hi with rfl | hiu\n · rcases Finset.mem_insert.mp hj with rfl | hju\n · exact False.elim (hij rfl)\n · exact (Finset.mem_filter.mp (hua hju)).2\n · rcases Finset.mem_insert.mp hj with rfl | hju\n · exact hR ((Finset.mem_filter.mp (hua hiu)).2)\n · exact hRu i hiu j hju hij\n · exact Or.inr ⟨u, Finset.Subset.trans hua hsuba, hu, hRu⟩\n · have hb : N₂ ≤ b.card := by omega\n rcases hN₂ b R hR hb with ⟨u, hub, hu, hRu⟩ | ⟨u, hub, hu, hRu⟩\n · exact Or.inl ⟨u, Finset.Subset.trans hub hsubb, hu, hRu⟩\n · right\n have hxu : x ∉ u := by\n intro h\n exact (Finset.mem_erase.mp (Finset.mem_filter.mp (hub h)).1).1 rfl\n refine ⟨insert x u, Finset.insert_subset hx (Finset.Subset.trans hub hsubb),\n by rw [Finset.card_insert_of_notMem hxu, hu], ?_⟩\n intro i hi j hj hij\n rcases Finset.mem_insert.mp hi with rfl | hiu\n · rcases Finset.mem_insert.mp hj with rfl | hju\n · exact False.elim (hij rfl)\n · exact (Finset.mem_filter.mp (hub hju)).2\n · rcases Finset.mem_insert.mp hj with rfl | hju\n · intro h\n exact (Finset.mem_filter.mp (hub hiu)).2 (hR h)\n · exact hRu i hiu j hju hij\ntheorem switching_large_groups_impossible (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n (D : ℕ) (hD : 1 - α < 2 * α ^ 2 * (D : ℝ))\n (p q : ℕ) (hp : D ≤ p) (hq : D ≤ q) (hDp : 0 < D)\n (hbound : 4 * α ^ 2 * (p : ℝ) * (q : ℝ) ≤\n (1 - α) * ((p : ℝ) + (q : ℝ))) : False := by\n have hp' : (D : ℝ) ≤ (p : ℝ) := Nat.cast_le.mpr hp\n have hq' : (D : ℝ) ≤ (q : ℝ) := Nat.cast_le.mpr hq\n have hpp : 0 < (p : ℝ) := Nat.cast_pos.mpr (lt_of_lt_of_le hDp hp)\n have hqp : 0 < (q : ℝ) := Nat.cast_pos.mpr (lt_of_lt_of_le hDp hq)\n have h1 := mul_lt_mul_of_pos_right hD hpp\n have h2 := mul_lt_mul_of_pos_right hD hqp\n have h3 := mul_le_mul_of_nonneg_left hq' (show 0 ≤ 2 * α ^ 2 * (p : ℝ) by positivity)\n have h4 := mul_le_mul_of_nonneg_left hp' (show 0 ≤ 2 * α ^ 2 * (q : ℝ) by positivity)\n nlinarith only [h1, h2, h3, h4, hbound]\ntheorem switching_orient_to_seed\n {ι H : Type*} [DecidableEq ι] [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (s : Finset ι) (v : ι → H) (w : H) (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n (D : ℕ) (hDp : 0 < D) (hD : 1 - α < 2 * α ^ 2 * (D : ℝ))\n (hw : (inner ℝ (w) (w)) = 1)\n (hdiag : ∀ i ∈ s, (inner ℝ (v i) (v i)) = 1)\n (hoff : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → (inner ℝ (v i) (v j)) = α)\n (hwv : ∀ i ∈ s, |(inner ℝ (w) (v i))| = α) :\n ∃ σ : ℝ, (σ = 1 ∨ σ = -1) ∧ (s.filter (fun i => (inner ℝ (σ • w) (v i)) < 0)).card < D := by\n classical\n let p := s.filter (fun i => (inner ℝ (w) (v i)) < 0)\n let q := s.filter (fun i => ¬(inner ℝ (w) (v i)) < 0)\n have hdis : Disjoint p q := by\n apply Finset.disjoint_left.mpr\n intro i hi hj\n exact (Finset.mem_filter.mp hj).2 (Finset.mem_filter.mp hi).2\n have hsplit : p ∪ q = s := by\n ext i\n by_cases h : (inner ℝ (w) (v i)) < 0\n · simp [p, q, h]\n · have h' : 0 ≤ (inner ℝ (w) (v i)) := le_of_not_gt h\n simp [p, q, h, h']\n have hneg : ∀ i ∈ p, (inner ℝ (w) (v i)) = -α := by\n intro i hi\n have h := hwv i (Finset.mem_filter.mp hi).1\n rw [abs_of_neg (Finset.mem_filter.mp hi).2] at h\n linarith\n have hpos : ∀ i ∈ q, (inner ℝ (w) (v i)) = α := by\n intro i hi\n have h := hwv i (Finset.mem_filter.mp hi).1\n rw [abs_of_nonneg (le_of_not_gt (Finset.mem_filter.mp hi).2)] at h\n exact h\n by_cases hp : p.card < D\n · refine ⟨1, Or.inl rfl, ?_⟩\n simpa only [one_smul] using hp\n · have hq : q.card < D := by\n by_contra hq\n have hpp : p.Nonempty := Finset.card_pos.mp (by omega)\n have hqp : q.Nonempty := Finset.card_pos.mp (by omega)\n have hb := switching_mixed_sign_bound p q v w α hdis hpp hqp hw\n (by simpa only [hsplit] using hdiag) (by simpa only [hsplit] using hoff) hneg hpos\n exact switching_large_groups_impossible α hα D hD p.card q.card\n (by omega) (by omega) hDp hb\n refine ⟨-1, Or.inr rfl, ?_⟩\n have he : s.filter (fun i => (inner ℝ ((-1 : ℝ) • w) (v i)) < 0) = q := by\n ext i\n simp only [Finset.mem_filter, real_inner_smul_left, neg_mul, one_mul, q]\n constructor\n · rintro ⟨hi, h⟩\n exact ⟨hi, by linarith⟩\n · rintro ⟨hi, h⟩\n have hh := hpos i (Finset.mem_filter.mpr ⟨hi, h⟩)\n exact ⟨hi, by linarith [hα.1]⟩\n rw [he]\n exact hq\ntheorem switching_seed_pattern_class\n {ι H : Type*} [DecidableEq ι] [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (s p r : Finset ι) (v : ι → H) (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n (D : ℕ) (hp : p ⊆ s) (hpn : p.Nonempty) (hpD : p.card ≤ D)\n (hsD : D < s.card)\n (hdiag : ∀ i ∈ s, (inner ℝ (v i) (v i)) = 1)\n (hoff : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → (inner ℝ (v i) (v j)) = α)\n (hrdiag : ∀ i ∈ r, (inner ℝ (v i) (v i)) = 1)\n (hroff : ∀ i ∈ r, ∀ j ∈ r, i ≠ j → (inner ℝ (v i) (v j)) ≤ α)\n (hrangle : ∀ i ∈ r, ∀ j ∈ s, |(inner ℝ (v i) (v j))| = α)\n (hpattern : ∀ i ∈ r, s.filter (fun j => (inner ℝ (v i) (v j)) < 0) = p) :\n let δ := α * (4 * α ^ 2 * ((s.card : ℝ) - (D : ℝ)) - (1 - α) ^ 2) /\n ((1 - α) * (1 + ((s.card : ℝ) - 1) * α))\n 0 < δ → (r.card : ℝ) ≤ (1 - α) / δ := by\n intro δ hδ\n let t : ℝ := s.card\n let k : ℝ := p.card\n let b : ι → ℝ := fun j => if j ∈ p then -1 else 1\n let c : ι → ℝ := fun j => α / (1 - α) *\n (b j - α * (t - 2 * k) / (1 + (t - 1) * α))\n let z : H := ∑ j ∈ s, c j • v j\n let a : ℝ := α ^ 2 / (1 - α) *\n (t - α * (t - 2 * k) ^ 2 / (1 + (t - 1) * α))\n have hs : s.Nonempty := Finset.card_pos.mp (by omega)\n have hproj := switching_seed_projection s p v α hα hp hs hdiag hoff\n change (inner ℝ (z) (z)) = a ∧\n (∀ w : H, (∀ j ∈ s, (inner ℝ (w) (v j)) = α * b j) → (inner ℝ (w) (z)) = a) ∧\n a - α = α * (4 * α ^ 2 * k * (t - k) - (1 - α) ^ 2) /\n ((1 - α) * (1 + (t - 1) * α)) at hproj\n have hden : 0 < (1 - α) * (1 + (t - 1) * α) := by\n have ht : 1 ≤ t := by\n change (1 : ℝ) ≤ (s.card : ℝ)\n have ht_nat : 1 ≤ s.card := Finset.card_pos.mpr hs\n exact_mod_cast ht_nat\n apply mul_pos (sub_pos.mpr hα.2)\n have hh := mul_nonneg (sub_nonneg.mpr ht) hα.1.le\n linarith\n have hδa : δ ≤ a - α := by\n rw [hproj.2.2]\n change α * (4 * α ^ 2 * (t - (D : ℝ)) - (1 - α) ^ 2) / _ ≤ _\n apply (div_le_div_iff_of_pos_right hden).mpr\n have hk1 : 1 ≤ k := by\n change (1 : ℝ) ≤ (p.card : ℝ)\n have hk_nat : 1 ≤ p.card := Finset.card_pos.mpr hpn\n exact_mod_cast hk_nat\n have hkD : k ≤ (D : ℝ) := Nat.cast_le.mpr hpD\n have hDt : (D : ℝ) < t := Nat.cast_lt.mpr hsD\n have htk : 0 ≤ t - k := by linarith\n have hkp := mul_le_mul_of_nonneg_right hk1 htk\n have hh : t - (D : ℝ) ≤ k * (t - k) := by nlinarith only [hkp, hkD]\n have hm := mul_le_mul_of_nonneg_left hh (show 0 ≤ 4 * α ^ 2 by positivity)\n have hm' := mul_le_mul_of_nonneg_left hm hα.1.le\n nlinarith only [hm']\n have ha : α < a := by linarith only [hδa, hδ]\n have hvz : ∀ i ∈ r, (inner ℝ (v i) (z)) = a := by\n intro i hi\n apply hproj.2.1 (v i)\n intro j hj\n dsimp [b]\n by_cases hjp : j ∈ p\n · rw [if_pos hjp]\n have hneg : (inner ℝ (v i) (v j)) < 0 := by\n rw [← hpattern i hi] at hjp\n exact (Finset.mem_filter.mp hjp).2\n have hh := hrangle i hi j hj\n rw [abs_of_neg hneg] at hh\n linarith\n · rw [if_neg hjp]\n have hnon : 0 ≤ (inner ℝ (v i) (v j)) := by\n by_contra h\n apply hjp\n rw [← hpattern i hi]\n exact Finset.mem_filter.mpr ⟨hj, by linarith⟩\n have hh := hrangle i hi j hj\n rw [abs_of_nonneg hnon] at hh\n linarith\n have hr := switching_residual_class_bound r v z α a hα.2.le ha\n hrdiag hroff hvz hproj.1\n apply (le_div_iff₀ hδ).mpr\n have hrr : 0 ≤ (r.card : ℝ) := Nat.cast_nonneg _\n have hh := mul_le_mul_of_nonneg_left hδa hrr\n have hb := (le_div_iff₀ (sub_pos.mpr ha)).mp hr\n linarith only [hh, hb]\ntheorem switching_seeded_degree\n {ι H : Type*} [Fintype ι] [DecidableEq ι]\n [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (v : ι → H) (α : ℝ) (hα : α ∈ Set.Ioo 0 1)\n (D C R B : ℕ) (hDp : 0 < D) (hD : 1 - α < 2 * α ^ 2 * (D : ℝ))\n (hC : 1 + 1 / α < (C : ℝ))\n (hR : ∀ u : Finset ι, R ≤ u.card →\n (∃ p : Finset ι, p ⊆ u ∧ p.card = D ∧\n ∀ i ∈ p, ∀ j ∈ p, i ≠ j → (inner ℝ (v i) (v j)) = α) ∨\n (∃ p : Finset ι, p ⊆ u ∧ p.card = C ∧\n ∀ i ∈ p, ∀ j ∈ p, i ≠ j → (inner ℝ (v i) (v j)) ≠ α))\n (s : Finset ι) (hsD : 2 * D < s.card)\n (hdiag : ∀ i, (inner ℝ (v i) (v i)) = 1)\n (hangle : ∀ i j, i ≠ j → |(inner ℝ (v i) (v j))| = α)\n (hseed : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → (inner ℝ (v i) (v j)) = α)\n (hsmall : ∀ i, (s.filter (fun j => (inner ℝ (v i) (v j)) < 0)).card < D)\n (hδ : 0 < α * (4 * α ^ 2 * ((s.card : ℝ) - (D : ℝ)) - (1 - α) ^ 2) /\n ((1 - α) * (1 + ((s.card : ℝ) - 1) * α)))\n (hB : (1 - α) /\n (α * (4 * α ^ 2 * ((s.card : ℝ) - (D : ℝ)) - (1 - α) ^ 2) /\n ((1 - α) * (1 + ((s.card : ℝ) - 1) * α))) ≤ (B : ℝ)) :\n ∀ i, (Finset.univ.filter (fun j => (inner ℝ (v i) (v j)) < 0)).card ≤\n s.card + 2 ^ s.card * B + R := by\n classical\n let f : ι → Finset ι := fun i => s.filter (fun j => (inner ℝ (v i) (v j)) < 0)\n let X : Finset ι := Finset.univ.filter (fun i => i ∉ s ∧ (f i).Nonempty)\n let U : Finset ι := Finset.univ.filter (fun i => i ∉ s ∧ f i = ∅)\n have hXp : X.card ≤ 2 ^ s.card * B := by\n have hf : Set.MapsTo f (X : Set ι) (s.powerset : Set (Finset ι)) := by\n intro i hi\n exact Finset.mem_powerset.mpr (Finset.filter_subset _ _)\n rw [Finset.card_eq_sum_card_fiberwise hf]\n have hclass : ∀ p ∈ s.powerset, (X.filter (fun i => f i = p)).card ≤ B := by\n intro p hp\n let r := X.filter (fun i => f i = p)\n by_cases hr : r.Nonempty\n · obtain ⟨i, hi⟩ := hr\n have hiX := Finset.mem_filter.mp hi\n have hiXX := (Finset.mem_filter.mp hiX.1).2\n have hpnon : p.Nonempty := hiX.2 ▸ hiXX.2\n have hpD : p.card ≤ D := by\n have hh := hsmall i\n change (f i).card < D at hh\n rw [hiX.2] at hh\n omega\n have hrr := switching_seed_pattern_class s p r v α hα D\n (Finset.mem_powerset.mp hp) hpnon hpD (by omega)\n (fun i hi => hdiag i) hseed (fun i hi => hdiag i)\n (fun i hi j hj hij => (le_abs_self _).trans (hangle i j hij).le)\n (fun i hi j hj => hangle i j (by\n intro hij\n subst j\n exact (Finset.mem_filter.mp (Finset.mem_filter.mp hi).1).2.1 hj))\n (fun i hi => (Finset.mem_filter.mp hi).2) hδ\n have hh : (r.card : ℝ) ≤ (B : ℝ) := hrr.trans hB\n exact_mod_cast hh\n · have hz : r = ∅ := Finset.not_nonempty_iff_eq_empty.mp hr\n change r.card ≤ B\n rw [hz, Finset.card_empty]\n exact Nat.zero_le _\n have hh := Finset.sum_le_sum hclass\n simpa only [Finset.sum_const, nsmul_eq_mul, Finset.card_powerset, Nat.cast_id] using hh\n have hUpos : ∀ i ∈ U, ∀ j ∈ s, (inner ℝ (v i) (v j)) = α := by\n intro i hi j hj\n have hiU := (Finset.mem_filter.mp hi).2\n have hij : i ≠ j := by\n intro hij\n subst j\n exact hiU.1 hj\n have hnon : 0 ≤ (inner ℝ (v i) (v j)) := by\n by_contra h\n have hh : j ∈ f i := Finset.mem_filter.mpr ⟨hj, by linarith⟩\n rw [hiU.2] at hh\n exact Finset.notMem_empty j hh\n have hh := hangle i j hij\n rwa [abs_of_nonneg hnon] at hh\n have hnegative : ∀ p : Finset ι,\n (∀ i ∈ p, ∀ j ∈ p, i ≠ j → (inner ℝ (v i) (v j)) ≠ α) → p.card ≠ C := by\n intro p hp hpc\n have hh := switching_negative_clique_bound p v α hα.1\n (fun i hi => hdiag i) (by\n intro i hi j hj hij\n have h := hangle i j hij\n have hn : (inner ℝ (v i) (v j)) < 0 := by\n by_contra hn\n have hh := abs_of_nonneg (le_of_not_gt hn)\n exact hp i hi j hj hij (by rwa [hh] at h)\n rw [abs_of_neg hn] at h\n linarith)\n rw [hpc] at hh\n linarith only [hh, hC]\n intro i\n let V : Finset ι := U.filter (fun j => (inner ℝ (v i) (v j)) < 0)\n have hV : V.card ≤ R := by\n by_contra hnot\n have hrv : R ≤ V.card := by omega\n rcases hR V hrv with ⟨p, hpV, hpD, hpp⟩ | ⟨p, hpV, hpC, hpp⟩\n · have hiout : i ∉ s := by\n intro his\n have hpn : p.Nonempty := Finset.card_pos.mp (by omega)\n obtain ⟨j, hj⟩ := hpn\n have hjV := Finset.mem_filter.mp (hpV hj)\n have hh := hUpos j hjV.1 i his\n have hh' : (inner ℝ (v i) (v j)) = α := by rw [real_inner_comm (v j) (v i)]; exact hh\n linarith only [hjV.2, hh', hα.1]\n let q := s \\ f i\n have hdis : Disjoint p q := by\n apply Finset.disjoint_left.mpr\n intro j hj hjq\n have hjU := (Finset.mem_filter.mp (hpV hj)).1\n exact (Finset.mem_filter.mp hjU).2.1 (Finset.mem_sdiff.mp hjq).1\n have hqcard : D ≤ q.card := by\n have hs := hsmall i\n change (f i).card < D at hs\n have hfsub : f i ⊆ s := Finset.filter_subset _ _\n dsimp only [q]\n rw [Finset.card_sdiff_of_subset hfsub]\n omega\n have hpn : p.Nonempty := Finset.card_pos.mp (by omega)\n have hqn : q.Nonempty := Finset.card_pos.mp (by omega)\n have hposq : ∀ j ∈ q, (inner ℝ (v i) (v j)) = α := by\n intro j hj\n have hjs := (Finset.mem_sdiff.mp hj).1\n have hjf := (Finset.mem_sdiff.mp hj).2\n have hnon : 0 ≤ (inner ℝ (v i) (v j)) := by\n by_contra h\n exact hjf (Finset.mem_filter.mpr ⟨hjs, by linarith⟩)\n have hh := hangle i j (by intro h; subst j; exact hiout hjs)\n rwa [abs_of_nonneg hnon] at hh\n have hclique : ∀ j ∈ p ∪ q, ∀ k ∈ p ∪ q, j ≠ k → (inner ℝ (v j) (v k)) = α := by\n intro j hj k hk hjk\n rcases Finset.mem_union.mp hj with hj | hj\n · rcases Finset.mem_union.mp hk with hk | hk\n · exact hpp j hj k hk hjk\n · exact hUpos j (Finset.mem_filter.mp (hpV hj)).1 k\n (Finset.mem_sdiff.mp hk).1\n · rcases Finset.mem_union.mp hk with hk | hk\n · rw [real_inner_comm (v k) (v j)]\n exact hUpos k (Finset.mem_filter.mp (hpV hk)).1 j\n (Finset.mem_sdiff.mp hj).1\n · exact hseed j (Finset.mem_sdiff.mp hj).1 k (Finset.mem_sdiff.mp hk).1 hjk\n have hb := switching_mixed_sign_bound p q v (v i) α hdis hpn hqn\n (hdiag i) (fun j hj => hdiag j) hclique\n (fun j hj => by\n have hn := (Finset.mem_filter.mp (hpV hj)).2\n have hh := hangle i j (by\n intro h\n subst j\n rw [hdiag i] at hn\n linarith)\n rw [abs_of_neg hn] at hh\n linarith) hposq\n exact switching_large_groups_impossible α hα D hD p.card q.card\n (by omega) hqcard hDp hb\n · exact hnegative p hpp hpC\n let W : Finset ι := Finset.univ.filter (fun j => (inner ℝ (v i) (v j)) < 0)\n have hsub : W ⊆ (s ∪ X) ∪ V := by\n intro j hj\n by_cases hjs : j ∈ s\n · exact Finset.mem_union_left _ (Finset.mem_union_left _ hjs)\n · by_cases hjf : (f j).Nonempty\n · exact Finset.mem_union_left _ (Finset.mem_union_right _\n (Finset.mem_filter.mpr ⟨Finset.mem_univ j, hjs, hjf⟩))\n · have hjU : j ∈ U := Finset.mem_filter.mpr\n ⟨Finset.mem_univ j, hjs, Finset.not_nonempty_iff_eq_empty.mp hjf⟩\n exact Finset.mem_union_right _ (Finset.mem_filter.mpr\n ⟨hjU, (Finset.mem_filter.mp hj).2⟩)\n have h1 := Finset.card_le_card hsub\n have h2 := Finset.card_union_le (s ∪ X) V\n have h3 := Finset.card_union_le s X\n change W.card ≤ _\n omega\ntheorem switching_graph_of_degree_bound\n {ι H : Type*} [Fintype ι] [DecidableEq ι]\n [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (v : ι → H) (σ : ι → ℝ) (Δ : ℕ)\n (hdegree : ∀ i, (Finset.univ.filter (fun j => (inner ℝ (σ i • v i) (σ j • v j)) < 0)).card ≤ Δ) :\n ∃ G : SimpleGraph ι,\n (∀ i j, G.Adj i j ↔ i ≠ j ∧ (inner ℝ (σ i • v i) (σ j • v j)) < 0) ∧\n (∀ i, ({j : ι | G.Adj i j} : Set ι).ncard ≤ Δ) := by\n classical\n let G : SimpleGraph ι := {\n Adj := fun i j => i ≠ j ∧ (inner ℝ (σ i • v i) (σ j • v j)) < 0\n symm := ⟨fun i j h => ⟨h.1.symm, by\n rw [real_inner_comm (σ i • v i) (σ j • v j)]\n exact h.2⟩⟩\n loopless := ⟨fun i h => h.1 rfl⟩ }\n refine ⟨G, fun i j => Iff.rfl, ?_⟩\n intro i\n let s := Finset.univ.filter (fun j => (inner ℝ (σ i • v i) (σ j • v j)) < 0)\n have hsub : {j : ι | G.Adj i j} ⊆ (s : Set ι) := by\n intro j hj\n exact Finset.mem_filter.mpr ⟨Finset.mem_univ j, hj.2⟩\n calc\n ({j : ι | G.Adj i j} : Set ι).ncard ≤ (s : Set ι).ncard := Set.ncard_le_ncard hsub\n _ = s.card := Set.ncard_coe_finset s\n _ ≤ Δ := hdegree i\ntheorem uniform_switching_of_unit_vectors :\n ∀ (α : ℝ), α ∈ Set.Ioo 0 1 → ∃ Δ : ℕ,\n ∀ (d n : ℕ) (v : Fin n → EuclideanSpace ℝ (Fin d)),\n (∀ i, inner ℝ (v i) (v i) = 1) →\n (∀ i j, i ≠ j → |inner ℝ (v i) (v j)| = α) →\n ∃ (σ : Fin n → ℝ) (G : SimpleGraph (Fin n)),\n (∀ i, σ i = 1 ∨ σ i = -1) ∧\n (∀ i j, G.Adj i j ↔ i ≠ j ∧ inner ℝ (σ i • v i) (σ j • v j) < 0) ∧\n (∀ i, ({j : Fin n | G.Adj i j} : Set (Fin n)).ncard ≤ Δ) := by\n classical\n intro α hα\n have hαpos : 0 < α := hα.1\n have hαlt : α < 1 := hα.2\n have hαsq : 0 < 2 * α ^ 2 := by positivity\n have hαsq4 : 0 < 4 * α ^ 2 := by positivity\n obtain ⟨D, hDlarge⟩ := exists_nat_gt ((1 - α) / (2 * α ^ 2) + 1)\n have hDp : 0 < D := by\n have hn : 0 ≤ (1 - α) / (2 * α ^ 2) := by positivity\n have hh : 0 < (D : ℝ) := by linarith\n exact Nat.cast_pos.mp hh\n have hD : 1 - α < 2 * α ^ 2 * (D : ℝ) := by\n have hh : (1 - α) / (2 * α ^ 2) < (D : ℝ) := by linarith\n have hh' := (div_lt_iff₀ hαsq).mp hh\n nlinarith only [hh']\n obtain ⟨C, hC⟩ := exists_nat_gt (1 + 1 / α)\n obtain ⟨T, hT⟩ := exists_nat_gt\n (max (2 * (D : ℝ)) ((D : ℝ) + (1 - α) ^ 2 / (4 * α ^ 2)))\n have hT1 : 2 * D < T := by\n have hh : 2 * (D : ℝ) < (T : ℝ) := lt_of_le_of_lt (le_max_left _ _) hT\n exact_mod_cast hh\n have hT2 : (1 - α) ^ 2 < 4 * α ^ 2 * ((T : ℝ) - (D : ℝ)) := by\n have hh := lt_of_le_of_lt (le_max_right _ _) hT\n have hh' : (1 - α) ^ 2 / (4 * α ^ 2) < (T : ℝ) - (D : ℝ) := by linarith\n have hh'' := (div_lt_iff₀ hαsq4).mp hh'\n nlinarith only [hh'']\n let δ := α * (4 * α ^ 2 * ((T : ℝ) - (D : ℝ)) - (1 - α) ^ 2) /\n ((1 - α) * (1 + ((T : ℝ) - 1) * α))\n have hδ : 0 < δ := by\n have hTp : 1 ≤ T := by omega\n have hTp' : (1 : ℝ) ≤ (T : ℝ) := by exact_mod_cast hTp\n have hnum : 0 < α * (4 * α ^ 2 * ((T : ℝ) - (D : ℝ)) - (1 - α) ^ 2) :=\n mul_pos hα.1 (sub_pos.mpr hT2)\n have hprod : 0 ≤ ((T : ℝ) - 1) * α := mul_nonneg (sub_nonneg.mpr hTp') hα.1.le\n exact div_pos hnum (mul_pos (sub_pos.mpr hα.2) (by linarith))\n obtain ⟨B, hB⟩ := exists_nat_ge ((1 - α) / δ)\n obtain ⟨N, hN⟩ := switching_finite_ramsey T C\n obtain ⟨R, hR⟩ := switching_finite_ramsey D C\n let Δ := max N (T + 2 ^ T * B + R)\n refine ⟨Δ, ?_⟩\n intro d n v hdiag hangle\n by_cases hn : N ≤ n\n · have hs := hN (Finset.univ : Finset (Fin n)) (fun i j => (inner ℝ (v i) (v j)) = α)\n (fun i j h => by\n change (inner ℝ (v j) (v i)) = α\n rw [real_inner_comm (v i) (v j)]\n exact h)\n (by simpa using hn)\n have hnegative : ∀ p : Finset (Fin n), p.card = C →\n (∀ i ∈ p, ∀ j ∈ p, i ≠ j → (inner ℝ (v i) (v j)) ≠ α) → False := by\n intro p hp hnot\n have hh := switching_negative_clique_bound p v α hα.1\n (fun i hi => hdiag i) (by\n intro i hi j hj hij\n have hab := hangle i j hij\n have hneg : (inner ℝ (v i) (v j)) < 0 := by\n by_contra h\n rw [abs_of_nonneg (le_of_not_gt h)] at hab\n exact hnot i hi j hj hij hab\n rw [abs_of_neg hneg] at hab\n linarith)\n rw [hp] at hh\n linarith only [hh, hC]\n obtain ⟨s, hssub, hsT, hseed⟩ : ∃ s : Finset (Fin n),\n s ⊆ Finset.univ ∧ s.card = T ∧\n ∀ i ∈ s, ∀ j ∈ s, i ≠ j → (inner ℝ (v i) (v j)) = α := by\n rcases hs with h | ⟨p, hp, hpC, hnot⟩\n · exact h\n · exact False.elim (hnegative p hpC hnot)\n have horient : ∀ i : Fin n, ∃ a : ℝ,\n (a = 1 ∨ a = -1) ∧ (i ∈ s → a = 1) ∧\n (s.filter (fun j => (inner ℝ (a • v i) (v j)) < 0)).card < D := by\n intro i\n by_cases his : i ∈ s\n · refine ⟨1, Or.inl rfl, fun _ => rfl, ?_⟩\n have he : s.filter (fun j => (inner ℝ ((1 : ℝ) • v i) (v j)) < 0) = ∅ := by\n apply Finset.eq_empty_iff_forall_notMem.mpr\n intro j hj\n have h := Finset.mem_filter.mp hj\n rw [one_smul] at h\n by_cases hij : i = j\n · subst j\n rw [hdiag i] at h\n linarith only [h.2]\n · rw [hseed i his j h.1 hij] at h\n linarith only [h.2, hα.1]\n rw [he, Finset.card_empty]\n exact hDp\n · obtain ⟨a, ha, hsmall⟩ := switching_orient_to_seed s v (v i) α hα\n D hDp hD (hdiag i) (fun j hj => hdiag j) hseed\n (fun j hj => hangle i j (by intro h; subst j; exact his hj))\n exact ⟨a, ha, fun h => False.elim (his h), hsmall⟩\n choose σ hσ using horient\n let w : Fin n → EuclideanSpace ℝ (Fin d) := fun i => σ i • v i\n have hwdiag : ∀ i, (inner ℝ (w i) (w i)) = 1 := by\n intro i\n rcases (hσ i).1 with hi | hi\n · simp only [w, hi, one_smul, hdiag]\n · simp only [w, hi, neg_one_smul, inner_neg_left, inner_neg_right, neg_neg, hdiag]\n have hwangle : ∀ i j, i ≠ j → |(inner ℝ (w i) (w j))| = α := by\n intro i j hij\n rcases (hσ i).1 with hi | hi <;> rcases (hσ j).1 with hj | hj <;>\n simp only [w, hi, hj, one_smul, neg_one_smul, inner_neg_left,\n inner_neg_right, neg_neg, abs_neg, hangle i j hij]\n have hwseed : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → (inner ℝ (w i) (w j)) = α := by\n intro i hi j hj hij\n simp only [w, (hσ i).2.1 hi, (hσ j).2.1 hj, one_smul, hseed i hi j hj hij]\n have hwsmall : ∀ i, (s.filter (fun j => (inner ℝ (w i) (w j)) < 0)).card < D := by\n intro i\n have he : s.filter (fun j => (inner ℝ (w i) (w j)) < 0) =\n s.filter (fun j => (inner ℝ (σ i • v i) (v j)) < 0) := by\n apply Finset.filter_congr\n intro j hj\n simp only [w, (hσ j).2.1 hj, one_smul]\n rw [he]\n exact (hσ i).2.2\n have hRamsey : ∀ u : Finset (Fin n), R ≤ u.card →\n (∃ p : Finset (Fin n), p ⊆ u ∧ p.card = D ∧\n ∀ i ∈ p, ∀ j ∈ p, i ≠ j → (inner ℝ (w i) (w j)) = α) ∨\n (∃ p : Finset (Fin n), p ⊆ u ∧ p.card = C ∧\n ∀ i ∈ p, ∀ j ∈ p, i ≠ j → (inner ℝ (w i) (w j)) ≠ α) := by\n intro u hu\n exact hR u (fun i j => (inner ℝ (w i) (w j)) = α)\n (fun i j h => by\n change (inner ℝ (w j) (w i)) = α\n rw [real_inner_comm (w i) (w j)]\n exact h) hu\n have hdegree := switching_seeded_degree w α hα D C R B hDp hD hC\n hRamsey s (by omega) hwdiag hwangle hwseed hwsmall\n (by simpa only [hsT] using hδ) (by simpa only [hsT] using hB)\n have hb : ∀ i, (Finset.univ.filter (fun j => (inner ℝ (σ i • v i) (σ j • v j)) < 0)).card ≤ Δ := by\n intro i\n have hh := hdegree i\n rw [hsT] at hh\n exact hh.trans (le_max_right _ _)\n obtain ⟨G, hG, hdeg⟩ := switching_graph_of_degree_bound v σ Δ hb\n exact ⟨σ, G, fun i => (hσ i).1, hG, hdeg⟩\n · let σ : Fin n → ℝ := fun _ => 1\n have hb : ∀ i, (Finset.univ.filter (fun j => (inner ℝ (σ i • v i) (σ j • v j)) < 0)).card ≤ Δ := by\n intro i\n have hh := Finset.card_filter_le (Finset.univ : Finset (Fin n))\n (fun j => (inner ℝ (σ i • v i) (σ j • v j)) < 0)\n have hn' : n ≤ N := by omega\n have hh' : (Finset.univ.filter\n (fun j => (inner ℝ (σ i • v i) (σ j • v j)) < 0)).card ≤ n := by\n simpa only [Finset.card_univ, Fintype.card_fin] using hh\n exact hh'.trans (hn'.trans (le_max_left _ _))\n obtain ⟨G, hG, hdeg⟩ := switching_graph_of_degree_bound v σ Δ hb\n exact ⟨σ, G, fun _ => Or.inl rfl, hG, hdeg⟩\ntheorem switching_norm_eq\n {ι H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (v : ι → H) (σ : ι → ℝ) (hσ : ∀ i, σ i = 1 ∨ σ i = -1) (i : ι) :\n ‖σ i • v i‖ = ‖v i‖ := by\n rcases hσ i with hi | hi <;> simp [hi]\ntheorem switching_abs_inner_eq\n {ι H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (v : ι → H) (σ : ι → ℝ) (hσ : ∀ i, σ i = 1 ∨ σ i = -1) (i j : ι) :\n |inner ℝ (σ i • v i) (σ j • v j)| = |inner ℝ (v i) (v j)| := by\n rcases hσ i with hi | hi <;> rcases hσ j with hj | hj <;>\n simp [hi, hj]\ntheorem switching_injective_of_unit_angles\n {ι H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (v : ι → H) (σ : ι → ℝ) (hσ : ∀ i, σ i = 1 ∨ σ i = -1)\n (α : ℝ) (hα : α < 1) (hnorm : ∀ i, ‖v i‖ = 1)\n (hangle : ∀ i j, i ≠ j → |inner ℝ (v i) (v j)| = α) :\n Function.Injective (fun i => σ i • v i) := by\n intro i j hij\n change σ i • v i = σ j • v j at hij\n by_contra hne\n have ha : |inner ℝ (σ i • v i) (σ j • v j)| = α :=\n (switching_abs_inner_eq v σ hσ i j).trans (hangle i j hne)\n rw [hij, real_inner_self_eq_norm_sq, switching_norm_eq v σ hσ j, hnorm j] at ha\n norm_num at ha\n exact (ne_of_lt hα) ha.symm\ntheorem switching_negative_graph_eq\n {ι H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℝ H]\n (w : ι → H) (G : SimpleGraph ι)\n (hG : ∀ i j, G.Adj i j ↔ i ≠ j ∧ inner ℝ (w i) (w j) < 0) :\n G = SimpleGraph.fromRel (fun i j => inner ℝ (w i) (w j) < 0) := by\n ext i j\n simp only [hG, SimpleGraph.fromRel_adj, real_inner_comm (w j) (w i), or_self]\ntheorem switching_gram_eq_of_negative_graph\n (α : ℝ) (hα : α ∈ Set.Ioo 0 1) (d n : ℕ)\n (w : Fin n → EuclideanSpace ℝ (Fin d))\n (hnorm : ∀ i, ‖w i‖ = 1)\n (hangle : ∀ i j, i ≠ j → |inner ℝ (w i) (w j)| = α)\n (G : SimpleGraph (Fin n))\n (hG : ∀ i j, G.Adj i j ↔ i ≠ j ∧ inner ℝ (w i) (w j) < 0) :\n let A : Matrix (Fin n) (Fin n) ℝ :=\n (letI : DecidableRel G.Adj := Classical.decRel G.Adj; G.adjMatrix ℝ)\n Matrix.gram ℝ w = (1 - α) • (1 : Matrix (Fin n) (Fin n) ℝ) +\n α • Matrix.of (fun _ _ : Fin n => (1 : ℝ)) - (2 * α) • A := by\n classical\n dsimp only\n ext i j\n by_cases hij : i = j\n · subst j\n simp [Matrix.gram_apply, hnorm]\n · rcases (abs_eq hα.1.le).mp (hangle i j hij) with hpos | hneg\n · have hnot : ¬α < 0 := not_lt.mpr hα.1.le\n simp [Matrix.gram_apply, hij, SimpleGraph.adjMatrix_apply, hG, hpos, hnot]\n · simp [Matrix.gram_apply, hij, SimpleGraph.adjMatrix_apply, hG, hneg, hα.1]\n ring\ntheorem uniform_switching_with_gram_data :\n ∀ (α : ℝ), α ∈ Set.Ioo 0 1 → ∃ Δ : ℕ,\n ∀ (d n : ℕ) (v : Fin n → EuclideanSpace ℝ (Fin d)),\n (∀ i, ‖v i‖ = 1) →\n (∀ i j, i ≠ j → |inner ℝ (v i) (v j)| = α) →\n ∃ (σ : Fin n → ℝ) (G : SimpleGraph (Fin n)),\n (∀ i, σ i = 1 ∨ σ i = -1) ∧\n (∀ i, ‖σ i • v i‖ = 1) ∧\n (∀ i j, i ≠ j → |inner ℝ (σ i • v i) (σ j • v j)| = α) ∧\n Function.Injective (fun i => σ i • v i) ∧\n G = SimpleGraph.fromRel (fun i j => inner ℝ (σ i • v i) (σ j • v j) < 0) ∧\n (∀ i j, G.Adj i j ↔ i ≠ j ∧ inner ℝ (σ i • v i) (σ j • v j) < 0) ∧\n (∀ i, ({j : Fin n | G.Adj i j} : Set (Fin n)).ncard ≤ Δ) ∧\n (let A : Matrix (Fin n) (Fin n) ℝ :=\n (letI : DecidableRel G.Adj := Classical.decRel G.Adj; G.adjMatrix ℝ)\n Matrix.gram ℝ (fun i => σ i • v i) =\n (1 - α) • (1 : Matrix (Fin n) (Fin n) ℝ) +\n α • Matrix.of (fun _ _ : Fin n => (1 : ℝ)) - (2 * α) • A) := by\n intro α hα\n obtain ⟨Δ, hΔ⟩ := uniform_switching_of_unit_vectors α hα\n refine ⟨Δ, ?_⟩\n intro d n v hnorm hangle\n have hdiag : ∀ i, inner ℝ (v i) (v i) = 1 := by\n intro i\n rw [real_inner_self_eq_norm_sq, hnorm i]\n norm_num\n obtain ⟨σ, G, hσ, hG, hdegree⟩ := hΔ d n v hdiag hangle\n have hwnorm : ∀ i, ‖σ i • v i‖ = 1 := fun i =>\n (switching_norm_eq v σ hσ i).trans (hnorm i)\n have hwangle : ∀ i j, i ≠ j → |inner ℝ (σ i • v i) (σ j • v j)| = α :=\n fun i j hij => (switching_abs_inner_eq v σ hσ i j).trans (hangle i j hij)\n exact ⟨σ, G, hσ, hwnorm, hwangle,\n switching_injective_of_unit_angles v σ hσ α hα.2 hnorm hangle,\n switching_negative_graph_eq (fun i => σ i • v i) G hG,\n hG, hdegree,\n switching_gram_eq_of_negative_graph α hα d n (fun i => σ i • v i)\n hwnorm hwangle G hG⟩\nend Submission.Helpers\n" } ], "official": { "statementRevision": 1, "submissionUrl": "https://github.com/leanprover/lean-eval-submissions/issues/2135", "resultUrl": "https://github.com/leanprover/lean-eval-submissions/issues/2135#issuecomment-6186332699", "resultBody": "## Submission result\n\n✅ Newly-solved problems: annals_equiangular_lines_fixed_angle\n\nAttempted 1 / 1; succeeded on 1.\n\n### Per-problem\n- `annals_equiangular_lines_fixed_angle`: pass", "sourceUrl": "https://github.com/LikC1606/deepscientist-math-proofs/tree/1a46c11651e8346a13af410ae3e12292da694d81", "sourceCommit": "1a46c11651e8346a13af410ae3e12292da694d81", "checksums": { "README.md": "01a11641e2a5f0f18f15bdd1e7fcb6501ead04b93a5cdcb02fe09a63d96cedc1", "Submission.lean": "33bb5ef9ab4ba497af6218874580c54791358516812cd52b187e2091946903f1", "Submission/Helpers.lean": "2b0ee3d08d6293710ee2348a00f8bd72e702332e7e05af0af61a434c6476e57f", "compatibility-verification.json": "52bc09f6f7f67925d6c1daad37001d89cf3dc1a317da2bf33e64d47e8926f948", "lakefile.toml": "830b8ff82d0016b22f868cc9a9b9b3301bb01d710212926188ee6558c2560468", "lean-toolchain": "bc84812c94489d1e3e191baa1dc10d5eb684382d7fe9d2a5ab085e72c1c67e47", "verification.json": "b2c9c38d29712f16603aea5a2bee87be26fae1b6124fe5abf6ce98c138b0b04a" } }, "local": { "status": "evaluated_passed", "kernelVerified": true, "comparator": "official_verified", "receipt": "lean-70004c39bb2c79cce334a96c", "sourceProofCommit": "9a4ab8b1d8388cb757ea11842c4368bdf719b7cc", "sourceBinding": "differs", "axioms": [ "propext", "Classical.choice", "Quot.sound" ], "url": "https://github.com/LikC1606/theorem-os-site/blob/main/accepted/annals_equiangular_lines_fixed_angle/verification.json", "production": { "mode": "independent review and evaluation of a saved cooperative proof candidate", "humanDirection": "Task selection and runtime/environment repairs requested by a human user. A coding assistant recovered the saved candidate, corrected public-statement parsing, removed unrelated unfinished helpers from the checked projection, and arranged independent review and final evaluation.", "freshFromZero": false } } }, { "id": "annals_rademacher_enflo_type", "title": "Rademacher & Enflo type", "subtitle": "Rademacher 型与 Enflo 型的一致性", "area": "泛函分析", "summary": "在 1 ≤ p ≤ 2 时，比较 Banach 空间的 Rademacher 型与 Enflo 型常数，同时证明两侧常数界。对应原题 theorem_1_1。", "declaration": "theorem theorem_1_1", "en": { "subtitle": "Rademacher type and Enflo type coincide", "area": "Functional analysis", "summary": "For 1 ≤ p ≤ 2, compares the Rademacher type and Enflo type constants of Banach spaces and proves the bounds in both directions. Corresponds to theorem_1_1." }, "status": "official_accepted", "model": "DeepScientist Math + GPT-6.1 (gpt-6.1-sol)", "updatedAt": "2026-10-14T05:07:39Z", "archiveUrl": "https://github.com/LikC1606/theorem-os-site/tree/main/accepted/annals_rademacher_enflo_type", "sources": [ { "name": "Submission.lean", "path": "accepted/annals_rademacher_enflo_type/Submission.lean", "url": "https://github.com/LikC1606/theorem-os-site/blob/main/accepted/annals_rademacher_enflo_type/Submission.lean", "sha256": "ad93f9761455b4e52fba817c002cb8a662296d99444ff27ec05d632ba7872357", "lines": 2301, "code": "import Mathlib.Topology.Algebra.Monoid\nimport Mathlib.Analysis.Calculus.Deriv.Add\nimport Mathlib.Analysis.Calculus.Deriv.Mul\nimport Mathlib.MeasureTheory.Integral.IntervalIntegral.FundThmCalculus\nimport Mathlib.Analysis.SpecialFunctions.Trigonometric.InverseDeriv\nimport Mathlib.Analysis.SpecialFunctions.Trigonometric.Chebyshev.Orthogonality\nimport Mathlib.MeasureTheory.Integral.Bochner.ContinuousLinearMap\nimport Mathlib.MeasureTheory.Integral.Pi\nimport ChallengeDeps\nimport Submission.Helpers\n\nopen RademacherEnfloType\nopen Function MeasureTheory ProbabilityTheory Measure NNReal\nopen scoped ENNReal\n\nset_option autoImplicit false\nvariable {X : Type*} [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\nvariable (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n\nnamespace Submission\n\ntheorem theorem_1_1 (p : ℝ) (h1p : 1 ≤ p) (hp2 : p ≤ 2) :\n TR X p ≤ TE X p ∧ TE X p ≤ (pi / sqrt 2) * TR X p := by\n have rademacher_product_probability (n : ℕ) :\n IsProbabilityMeasure (rademacherProductDistribution (Fin n)) := by\n unfold rademacherProductDistribution\n haveI : IsProbabilityMeasure rademacherDistribution := by\n unfold rademacherDistribution\n infer_instance\n infer_instance\n have linear_cube_odd\n \n (n : ℕ) (x : Fin n → X) (ε : Fin n → ({-1, 1} : Set ℤ)) :\n (∑ j : Fin n, (((-ε) j) : ℝ) • x j) =\n -(∑ j : Fin n, ((ε j) : ℝ) • x j) := by\n change (∑ j : Fin n, (Int.cast (-(ε j : ℤ)) : ℝ) • x j) =\n -(∑ j : Fin n, ((ε j : ℤ) : ℝ) • x j)\n simp only [Int.cast_neg, neg_smul, Finset.sum_neg_distrib]\n have linear_cube_antipodal_half\n \n (n : ℕ) (x : Fin n → X) (ε : Fin n → ({-1, 1} : Set ℤ)) :\n (1 / (2 : ℝ)) • ((∑ j : Fin n, ((ε j) : ℝ) • x j) -\n (∑ j : Fin n, (((-ε) j) : ℝ) • x j)) =\n ∑ j : Fin n, ((ε j) : ℝ) • x j := by\n rw [linear_cube_odd n x ε, sub_neg_eq_add, ← two_smul ℝ, smul_smul]\n norm_num\n have linear_cube_derivative\n \n (n : ℕ) (x : Fin n → X) (j : Fin n) (ε : Fin n → ({-1, 1} : Set ℤ)) :\n D j (fun δ ↦ ∑ k : Fin n, ((δ k) : ℝ) • x k) ε =\n ((ε j) : ℝ) • x j := by\n classical\n unfold D\n rw [← Finset.sum_sub_distrib, Finset.smul_sum]\n rw [Finset.sum_eq_single j]\n · simp only [Function.update_self]\n change (1 / (2 : ℝ)) •\n (((ε j : ℤ) : ℝ) • x j - (Int.cast (-(ε j : ℤ)) : ℝ) • x j) =\n ((ε j : ℤ) : ℝ) • x j\n rw [Int.cast_neg, neg_smul, sub_neg_eq_add, ← two_smul ℝ, smul_smul]\n norm_num\n · intro k hk hkj\n simp [Function.update_of_ne hkj]\n · simp\n have rademacher_sign_enorm\n \n (x : X) (ε : ({-1, 1} : Set ℤ)) :\n ‖((ε : ℤ) : ℝ) • x‖ₑ = ‖x‖ₑ := by\n rcases ε with ⟨ε, hε⟩\n have h : ε = -1 ∨ ε = 1 := by\n simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using hε\n rcases h with h | h <;> subst ε <;> simp\n have linear_cube_derivative_integral\n \n (n : ℕ) (x : Fin n → X) (j : Fin n) (p : ℝ) :\n (∫⁻ ε, ‖D j (fun δ ↦ ∑ k : Fin n, ((δ k) : ℝ) • x k) ε‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n)) = ‖x j‖ₑ ^ p := by\n haveI := rademacher_product_probability n\n simp only [linear_cube_derivative, rademacher_sign_enorm]\n rw [lintegral_const, measure_univ, mul_one]\n have enflo_implies_rademacher :\n ∀ (p : ℝ) (C : ℝ≥0∞),\n 1 ≤ p → p ≤ 2 →\n RademacherEnfloType.IsEnfloType X C p →\n RademacherEnfloType.IsRademacherType X C p := by\n intro p C h1p hp2 hC n hn x\n have h := hC n hn (fun ε ↦ ∑ j : Fin n, ((ε j) : ℝ) • x j)\n simpa only [linear_cube_antipodal_half, linear_cube_derivative_integral] using h\n have bernoulli_difference_moment_eq (p : ℝ) (q : Set.Icc (0 : ℝ) 1)\n (hp : 0 < p) :\n (∫⁻ ξ : (({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ)),\n ‖((ξ.1 : ℤ) : ℝ) - ((ξ.2 : ℤ) : ℝ)‖ₑ ^ p\n ∂(bernoulliMeasure (⟨1, by decide⟩ : ({-1, 1} : Set ℤ))\n ⟨-1, by decide⟩ q).prod\n (bernoulliMeasure (⟨1, by decide⟩ : ({-1, 1} : Set ℤ))\n ⟨-1, by decide⟩ q)) =\n (2 : ℝ≥0∞) ^ p * ENNReal.ofReal (2 * (q : ℝ) * (1 - (q : ℝ))) := by\n simp only [bernoulliMeasure_def, Measure.add_prod, Measure.prod_add,\n Measure.prod_smul_left, Measure.prod_smul_right, Measure.dirac_prod_dirac,\n lintegral_add_measure, lintegral_smul_measure, lintegral_dirac]\n norm_num [ENNReal.zero_rpow_of_pos hp]\n have htwo : ‖(2 : ℝ)‖ₑ = (2 : ℝ≥0∞) := by\n simp [enorm_eq_nnnorm]\n rw [htwo]\n change (unitInterval.toNNReal q : ℝ≥0∞) *\n ((unitInterval.toNNReal (unitInterval.symm q) : ℝ≥0∞) * 2 ^ p) +\n (unitInterval.toNNReal (unitInterval.symm q) : ℝ≥0∞) *\n ((unitInterval.toNNReal q : ℝ≥0∞) * 2 ^ p) = _\n have hq : (unitInterval.toNNReal q : ℝ≥0∞) = ENNReal.ofReal (q : ℝ) := by\n rw [← unitInterval.coe_toNNReal q, ENNReal.ofReal_coe_nnreal]\n have hq' : (unitInterval.toNNReal (unitInterval.symm q) : ℝ≥0∞) =\n ENNReal.ofReal (1 - (q : ℝ)) := by\n rw [← unitInterval.coe_symm_eq q, ← unitInterval.coe_toNNReal (unitInterval.symm q),\n ENNReal.ofReal_coe_nnreal]\n rw [hq, hq', ENNReal.ofReal_mul (mul_nonneg (by norm_num) q.property.1),\n ENNReal.ofReal_mul (by norm_num : (0 : ℝ) ≤ 2)]\n norm_num\n ring\n have bernoulli_difference_moment_le :\n ∀ (p : ℝ) (q : Set.Icc (0 : ℝ) 1), 1 ≤ p → p ≤ 2 →\n (∫⁻ ξ : (({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ)),\n ‖((ξ.1 : ℤ) : ℝ) - ((ξ.2 : ℤ) : ℝ)‖ₑ ^ p\n ∂(bernoulliMeasure (⟨1, by decide⟩ : ({-1, 1} : Set ℤ))\n ⟨-1, by decide⟩ q).prod\n (bernoulliMeasure (⟨1, by decide⟩ : ({-1, 1} : Set ℤ))\n ⟨-1, by decide⟩ q)) ≤\n (ENNReal.ofReal (8 * (q : ℝ) * (1 - (q : ℝ)))) ^ (p / 2) := by\n intro p q h1p hp2\n have hp : 0 < p := by linarith\n have hp_half : 0 ≤ p / 2 := by linarith\n by_cases hq0 : (q : ℝ) = 0\n · rw [bernoulli_difference_moment_eq p q hp]\n simp [hq0, ENNReal.zero_rpow_of_pos (show 0 < p / 2 by linarith)]\n by_cases hq1 : (q : ℝ) = 1\n · rw [bernoulli_difference_moment_eq p q hp]\n simp [hq1, ENNReal.zero_rpow_of_pos (show 0 < p / 2 by linarith)]\n have ha : ENNReal.ofReal (2 * (q : ℝ) * (1 - (q : ℝ))) ≤ 1 := by\n apply ENNReal.ofReal_le_one.mpr\n nlinarith [sq_nonneg ((q : ℝ) - 1 / 2)]\n have ha_pow : ENNReal.ofReal (2 * (q : ℝ) * (1 - (q : ℝ))) ≤\n (ENNReal.ofReal (2 * (q : ℝ) * (1 - (q : ℝ)))) ^ (p / 2) := by\n simpa only [ENNReal.rpow_one] using\n (ENNReal.rpow_le_rpow_of_exponent_ge ha (show p / 2 ≤ 1 by linarith) :\n (ENNReal.ofReal (2 * (q : ℝ) * (1 - (q : ℝ)))) ^ (1 : ℝ) ≤ _)\n have hvariance : ENNReal.ofReal (8 * (q : ℝ) * (1 - (q : ℝ))) =\n 4 * ENNReal.ofReal (2 * (q : ℝ) * (1 - (q : ℝ))) := by\n rw [show 8 * (q : ℝ) * (1 - (q : ℝ)) =\n 4 * (2 * (q : ℝ) * (1 - (q : ℝ))) by ring,\n ENNReal.ofReal_mul (by norm_num : (0 : ℝ) ≤ 4)]\n norm_num\n have hfour : (4 : ℝ≥0∞) ^ (p / 2) = (2 : ℝ≥0∞) ^ p := by\n calc\n (4 : ℝ≥0∞) ^ (p / 2) = ((2 : ℝ≥0∞) ^ (2 : ℝ)) ^ (p / 2) := by\n norm_num [ENNReal.rpow_natCast]\n _ = (2 : ℝ≥0∞) ^ (2 * (p / 2)) := (ENNReal.rpow_mul _ _ _).symm\n _ = (2 : ℝ≥0∞) ^ p := by congr 1; ring\n rw [bernoulli_difference_moment_eq p q hp, hvariance,\n ENNReal.mul_rpow_of_nonneg _ _ hp_half, hfour]\n gcongr\n have probability_integral_enorm_rpow_le :\n ∀ (Ω : Type) [MeasurableSpace Ω] (μ : MeasureTheory.Measure Ω)\n [MeasureTheory.IsProbabilityMeasure μ] (p : ℝ) (f : Ω → X),\n 1 ≤ p → MeasureTheory.AEStronglyMeasurable f μ →\n ‖∫ ω, f ω ∂μ‖ₑ ^ p ≤ ∫⁻ ω, ‖f ω‖ₑ ^ p ∂μ := by\n intro Ω _ μ _ p f hp hf\n have hp_pos : 0 < p := lt_of_lt_of_le (by norm_num) hp\n have hL1 : (∫⁻ ω, ‖f ω‖ₑ ∂μ) = eLpNorm' f 1 μ := by\n simp [eLpNorm'_eq_lintegral_enorm]\n have hLp : ‖∫ ω, f ω ∂μ‖ₑ ≤ eLpNorm' f p μ := by\n calc\n ‖∫ ω, f ω ∂μ‖ₑ ≤ ∫⁻ ω, ‖f ω‖ₑ ∂μ :=\n enorm_integral_le_lintegral_enorm f\n _ = eLpNorm' f 1 μ := hL1\n _ ≤ eLpNorm' f p μ :=\n eLpNorm'_le_eLpNorm'_of_exponent_le (by norm_num) hp μ hf\n rw [lintegral_rpow_enorm_eq_rpow_eLpNorm' hp_pos]\n exact ENNReal.rpow_le_rpow hLp hp_pos.le\n have cube_flip_involutive (n : ℕ) (j : Fin n) :\n Function.Involutive (fun δ : Fin n → ({-1, 1} : Set ℤ) ↦\n Function.update δ j (-δ j)) := by\n intro δ\n funext k\n by_cases hk : k = j\n · subst k\n simp only [Function.update_self]\n apply Subtype.ext\n change -(-(δ j : ℤ)) = (δ j : ℤ)\n exact neg_neg _\n · simp [Function.update_of_ne hk]\n have sign_noise_scalar_identity (t : ℝ) (a : ({-1, 1} : Set ℤ)) :\n (1 + t * ((a : ℤ) : ℝ)) * (((a : ℤ) : ℝ) - t) =\n (1 - t ^ 2) * ((a : ℤ) : ℝ) := by\n rcases a with ⟨a, ha⟩\n have h : a = -1 ∨ a = 1 := by\n simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using ha\n rcases h with h | h <;> subst a <;> norm_num <;> ring\n have cube_erased_weight_flip (n : ℕ) (j : Fin n) (t : ℝ)\n (δ : Fin n → ({-1, 1} : Set ℤ)) :\n ((((Function.update δ j (-δ j)) j) : ℤ) : ℝ) *\n (∏ k ∈ Finset.univ.erase j,\n (1 + t * ((((Function.update δ j (-δ j)) k) : ℤ) : ℝ))) =\n -(((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) := by\n have hprod : (∏ k ∈ Finset.univ.erase j,\n (1 + t * ((((Function.update δ j (-δ j)) k) : ℤ) : ℝ))) =\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ)) := by\n apply Finset.prod_congr rfl\n intro k hk\n rw [Function.update_of_ne (Finset.mem_erase.mp hk).1]\n rw [hprod, Function.update_self]\n change (Int.cast (-(δ j : ℤ)) : ℝ) * _ = _\n simp only [Int.cast_neg, neg_mul]\n have cube_noise_weight_coefficient (n : ℕ) (j : Fin n) (t : ℝ)\n (δ : Fin n → ({-1, 1} : Set ℤ)) :\n (∏ k : Fin n, (1 + t * ((δ k : ℤ) : ℝ))) * (((δ j : ℤ) : ℝ) - t) =\n (1 - t ^ 2) * (((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) := by\n rw [← Finset.mul_prod_erase Finset.univ\n (fun k : Fin n ↦ 1 + t * ((δ k : ℤ) : ℝ)) (Finset.mem_univ j)]\n calc\n ((1 + t * ((δ j : ℤ) : ℝ)) *\n (∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ)))) *\n (((δ j : ℤ) : ℝ) - t) =\n ((1 + t * ((δ j : ℤ) : ℝ)) * (((δ j : ℤ) : ℝ) - t)) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ)) := by ring\n _ = _ := by rw [sign_noise_scalar_identity]; ring\n have cube_flip_weighted_difference\n \n (n : ℕ) (j : Fin n) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (w : (Fin n → ({-1, 1} : Set ℤ)) → ℝ)\n (hw : ∀ δ, w (Function.update δ j (-δ j)) = -w δ) :\n (∑ δ : Fin n → ({-1, 1} : Set ℤ), w δ • D j f δ) =\n ∑ δ : Fin n → ({-1, 1} : Set ℤ), w δ • f δ := by\n have hflip : (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n w δ • f (Function.update δ j (-δ j))) =\n -(∑ δ : Fin n → ({-1, 1} : Set ℤ), w δ • f δ) := by\n calc\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n w δ • f (Function.update δ j (-δ j))) =\n ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n w (Function.update δ j (-δ j)) • f δ := by\n refine Fintype.sum_bijective (fun δ ↦ Function.update δ j (-δ j))\n (cube_flip_involutive n j).bijective _ _ ?_\n intro δ\n have hδ : Function.update (Function.update δ j (-δ j)) j\n (-(Function.update δ j (-δ j)) j) = δ := cube_flip_involutive n j δ\n rw [hδ]\n _ = _ := by simp only [hw, neg_smul, Finset.sum_neg_distrib]\n calc\n (∑ δ : Fin n → ({-1, 1} : Set ℤ), w δ • D j f δ) =\n (1 / (2 : ℝ)) • ((∑ δ : Fin n → ({-1, 1} : Set ℤ), w δ • f δ) -\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n w δ • f (Function.update δ j (-δ j)))) := by\n simp only [D, smul_sub, smul_smul, Finset.smul_sum, Finset.sum_sub_distrib,\n mul_comm]\n _ = _ := by\n rw [hflip, sub_neg_eq_add, ← two_smul ℝ, smul_smul]\n norm_num\n have weighted_cube_derivative_identity :\n ∀ (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X) (t : ℝ),\n (1 - t ^ 2) • (∑ δ : (Fin n → ({-1, 1} : Set ℤ)),\n (∑ j : Fin n, ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) • f δ) =\n ∑ δ : (Fin n → ({-1, 1} : Set ℤ)),\n (∏ k : Fin n, (1 + t * ((δ k : ℤ) : ℝ))) •\n (∑ j : Fin n, (((δ j : ℤ) : ℝ) - t) • RademacherEnfloType.D j f δ) := by\n intro n f t\n symm\n calc\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∏ k : Fin n, (1 + t * ((δ k : ℤ) : ℝ))) •\n (∑ j : Fin n, (((δ j : ℤ) : ℝ) - t) • D j f δ)) =\n ∑ j : Fin n, ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n ((∏ k : Fin n, (1 + t * ((δ k : ℤ) : ℝ))) *\n (((δ j : ℤ) : ℝ) - t)) • D j f δ := by\n simp only [Finset.smul_sum, smul_smul]\n rw [Finset.sum_comm]\n _ = (1 - t ^ 2) •\n (∑ j : Fin n, ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) • D j f δ) := by\n simp only [cube_noise_weight_coefficient, Finset.smul_sum, smul_smul]\n _ = (1 - t ^ 2) •\n (∑ j : Fin n, ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) • f δ) := by\n congr 1\n apply Finset.sum_congr rfl\n intro j hj\n exact cube_flip_weighted_difference n j f\n (fun δ ↦ ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ)))\n (fun δ ↦ cube_erased_weight_flip n j t δ)\n _ = _ := by\n rw [Finset.sum_comm]\n simp only [Finset.sum_smul]\n let centeredBernoulliMeasure (q : Set.Icc (0 : ℝ) 1) :\n Measure ({-1, 1} : Set ℤ) :=\n bernoulliMeasure ⟨1, by decide⟩ ⟨-1, by decide⟩ q\n letI centeredBernoulliMeasure_probability (q : Set.Icc (0 : ℝ) 1) :\n IsProbabilityMeasure (centeredBernoulliMeasure q) := by\n unfold centeredBernoulliMeasure\n infer_instance\n let centeredBernoulliCube (n : ℕ) (q : Set.Icc (0 : ℝ) 1) :\n Measure (Fin n → ({-1, 1} : Set ℤ)) :=\n Measure.pi (fun _ : Fin n ↦ centeredBernoulliMeasure q)\n letI centeredBernoulliCube_probability (n : ℕ) (q : Set.Icc (0 : ℝ) 1) :\n IsProbabilityMeasure (centeredBernoulliCube n q) := by\n unfold centeredBernoulliCube\n infer_instance\n let cubeTranslate (n : ℕ) (δ ε : Fin n → ({-1, 1} : Set ℤ)) :\n Fin n → ({-1, 1} : Set ℤ) :=\n fun k ↦ if (δ k : ℤ) = 1 then ε k else -ε k\n have rademacher_sign_neg_preserving :\n MeasurePreserving (fun a : ({-1, 1} : Set ℤ) ↦ -a)\n rademacherDistribution rademacherDistribution := by\n constructor\n · exact measurable_of_countable _\n · unfold rademacherDistribution\n rw [map_bernoulliMeasure]\n simp only [bernoulliMeasure_def]\n have hp : (-(⟨1, by decide⟩ : ({-1, 1} : Set ℤ))) = ⟨-1, by decide⟩ := by rfl\n have hm : (-(⟨-1, by decide⟩ : ({-1, 1} : Set ℤ))) = ⟨1, by decide⟩ := by\n apply Subtype.ext\n change -(-1 : ℤ) = 1\n norm_num\n rw [hp, hm]\n have hq : unitInterval.symm (⟨1 / 2, by norm_num⟩ : Set.Icc (0 : ℝ) 1) =\n ⟨1 / 2, by norm_num⟩ := by\n apply Subtype.ext\n norm_num [unitInterval.coe_symm_eq]\n rw [hq, add_comm]\n have cubeTranslate_preserving (n : ℕ) (δ : Fin n → ({-1, 1} : Set ℤ)) :\n MeasurePreserving (cubeTranslate n δ)\n (rademacherProductDistribution (Fin n)) (rademacherProductDistribution (Fin n)) := by\n haveI : IsProbabilityMeasure rademacherDistribution := by\n unfold rademacherDistribution\n infer_instance\n unfold rademacherProductDistribution\n rw [Measure.infinitePi_eq_pi]\n unfold cubeTranslate\n refine measurePreserving_pi (fun _ : Fin n ↦ rademacherDistribution)\n (fun _ : Fin n ↦ rademacherDistribution)\n (f := fun j a ↦ if (δ j : ℤ) = 1 then a else -a) ?_\n intro j\n by_cases hj : (δ j : ℤ) = 1\n · simp only [hj, if_true]\n exact ⟨measurable_id, by simp⟩\n · simpa only [hj, if_false] using rademacher_sign_neg_preserving\n have cubeTranslate_lintegral (n : ℕ) (δ : Fin n → ({-1, 1} : Set ℤ))\n (g : (Fin n → ({-1, 1} : Set ℤ)) → ℝ≥0∞) :\n (∫⁻ ε, g (cubeTranslate n δ ε) ∂rademacherProductDistribution (Fin n)) =\n ∫⁻ ε, g ε ∂rademacherProductDistribution (Fin n) := by\n exact (cubeTranslate_preserving n δ).lintegral_comp (measurable_of_countable _)\n have centeredBernoulli_sign_mean (q : Set.Icc (0 : ℝ) 1) :\n (∫ a : ({-1, 1} : Set ℤ), ((a : ℤ) : ℝ) ∂centeredBernoulliMeasure q) =\n 2 * (q : ℝ) - 1 := by\n unfold centeredBernoulliMeasure\n rw [integral_bernoulliMeasure]\n norm_num\n ring\n have centeredBernoulli_coordinate_mean (n : ℕ) (q : Set.Icc (0 : ℝ) 1)\n (j : Fin n) :\n (∫ δ : Fin n → ({-1, 1} : Set ℤ), ((δ j : ℤ) : ℝ)\n ∂centeredBernoulliCube n q) = 2 * (q : ℝ) - 1 := by\n unfold centeredBernoulliCube\n rw [integral_comp_eval (μ := fun _ : Fin n ↦ centeredBernoulliMeasure q)\n (i := j) (f := fun a : ({-1, 1} : Set ℤ) ↦ ((a : ℤ) : ℝ))\n StronglyMeasurable.of_discrete.aestronglyMeasurable]\n exact centeredBernoulli_sign_mean q\n let centeredBernoulliPairs (n : ℕ) (q : Set.Icc (0 : ℝ) 1) :\n Measure (Fin n → (({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ))) :=\n Measure.pi (fun _ : Fin n ↦ (centeredBernoulliMeasure q).prod (centeredBernoulliMeasure q))\n letI centeredBernoulliPairs_probability (n : ℕ) (q : Set.Icc (0 : ℝ) 1) :\n IsProbabilityMeasure (centeredBernoulliPairs n q) := by\n unfold centeredBernoulliPairs\n infer_instance\n let bernoulliPairSwap (n : ℕ) (σ : Fin n → ({-1, 1} : Set ℤ))\n (ξ : Fin n → (({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ))) :\n Fin n → (({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ)) :=\n fun j ↦ if (σ j : ℤ) = 1 then ξ j else (ξ j).swap\n have bernoulliPairSwap_preserving (n : ℕ) (q : Set.Icc (0 : ℝ) 1)\n (σ : Fin n → ({-1, 1} : Set ℤ)) :\n MeasurePreserving (bernoulliPairSwap n σ)\n (centeredBernoulliPairs n q) (centeredBernoulliPairs n q) := by\n unfold centeredBernoulliPairs bernoulliPairSwap\n refine measurePreserving_pi\n (fun _ : Fin n ↦ (centeredBernoulliMeasure q).prod (centeredBernoulliMeasure q))\n (fun _ : Fin n ↦ (centeredBernoulliMeasure q).prod (centeredBernoulliMeasure q))\n (f := fun j (a : ({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ)) ↦\n if (σ j : ℤ) = 1 then a else a.swap) ?_\n intro j\n by_cases hj : (σ j : ℤ) = 1\n · simp only [hj, if_true]\n exact ⟨measurable_id, by simp⟩\n · simpa only [hj, if_false] using\n (Measure.measurePreserving_swap (μ := centeredBernoulliMeasure q)\n (ν := centeredBernoulliMeasure q))\n have bernoulliPairSwap_difference (n : ℕ)\n (σ : Fin n → ({-1, 1} : Set ℤ))\n (ξ : Fin n → (({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ))) (j : Fin n) :\n (((bernoulliPairSwap n σ ξ j).1 : ℤ) : ℝ) -\n (((bernoulliPairSwap n σ ξ j).2 : ℤ) : ℝ) =\n ((σ j : ℤ) : ℝ) * ((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) := by\n have h : (σ j : ℤ) = -1 ∨ (σ j : ℤ) = 1 := by\n simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using (σ j).property\n rcases h with h | h <;> simp [bernoulliPairSwap, h]\n have centeredBernoulliPairs_sign_integral\n \n (n : ℕ) (q : Set.Icc (0 : ℝ) 1) (p : ℝ) (x : Fin n → X)\n (σ : Fin n → ({-1, 1} : Set ℤ)) :\n (∫⁻ ξ, ‖∑ j : Fin n, ((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j‖ₑ ^ p\n ∂centeredBernoulliPairs n q) =\n (∫⁻ ξ, ‖∑ j : Fin n, ((σ j : ℤ) : ℝ) •\n (((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j)‖ₑ ^ p\n ∂centeredBernoulliPairs n q) := by\n have h := (bernoulliPairSwap_preserving n q σ).lintegral_comp\n (measurable_of_countable (fun ξ ↦\n ‖∑ j : Fin n, ((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j‖ₑ ^ p))\n symm\n convert h using 1\n apply lintegral_congr\n intro ξ\n simp only [bernoulliPairSwap_difference, smul_smul]\n have centeredBernoulli_copy_integral\n \n (n : ℕ) (q : Set.Icc (0 : ℝ) 1) (δ : Fin n → ({-1, 1} : Set ℤ))\n (x : Fin n → X) :\n (∫ δ' : Fin n → ({-1, 1} : Set ℤ),\n ∑ j : Fin n, (((δ j : ℤ) : ℝ) - ((δ' j : ℤ) : ℝ)) • x j\n ∂centeredBernoulliCube n q) =\n ∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) • x j := by\n rw [integral_finsetSum Finset.univ (fun j hj ↦ Integrable.of_finite)]\n apply Finset.sum_congr rfl\n intro j hj\n rw [integral_smul_const, integral_sub Integrable.of_finite Integrable.of_finite,\n integral_const, probReal_univ, one_smul, centeredBernoulli_coordinate_mean]\n have centeredBernoulli_copy_jensen\n \n (n : ℕ) (q : Set.Icc (0 : ℝ) 1) (p : ℝ) (hp : 1 ≤ p) (x : Fin n → X) :\n (∫⁻ δ, ‖∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) • x j‖ₑ ^ p\n ∂centeredBernoulliCube n q) ≤\n (∫⁻ ξ, ‖∑ j : Fin n,\n ((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j‖ₑ ^ p\n ∂centeredBernoulliPairs n q) := by\n calc\n _ ≤ ∫⁻ δ, ∫⁻ δ', ‖∑ j : Fin n,\n (((δ j : ℤ) : ℝ) - ((δ' j : ℤ) : ℝ)) • x j‖ₑ ^ p\n ∂centeredBernoulliCube n q ∂centeredBernoulliCube n q := by\n apply lintegral_mono\n intro δ\n have h := probability_integral_enorm_rpow_le\n (Fin n → ({-1, 1} : Set ℤ)) (centeredBernoulliCube n q) p\n (fun δ' ↦ ∑ j : Fin n, (((δ j : ℤ) : ℝ) - ((δ' j : ℤ) : ℝ)) • x j)\n hp StronglyMeasurable.of_discrete.aestronglyMeasurable\n rwa [centeredBernoulli_copy_integral] at h\n _ = ∫⁻ z, ‖∑ j : Fin n,\n (((z.1 j : ℤ) : ℝ) - ((z.2 j : ℤ) : ℝ)) • x j‖ₑ ^ p\n ∂(centeredBernoulliCube n q).prod (centeredBernoulliCube n q) :=\n lintegral_lintegral (measurable_of_countable _).aemeasurable\n _ = _ := by\n unfold centeredBernoulliCube centeredBernoulliPairs\n exact (measurePreserving_arrowProdEquivProdArrow\n ({-1, 1} : Set ℤ) ({-1, 1} : Set ℤ) (Fin n)\n (fun _ ↦ centeredBernoulliMeasure q) (fun _ ↦ centeredBernoulliMeasure q)\n |>.lintegral_comp (measurable_of_countable _)).symm\n have centeredBernoulliPairs_symmetrization\n \n (n : ℕ) (q : Set.Icc (0 : ℝ) 1) (p : ℝ) (x : Fin n → X) :\n (∫⁻ ξ, ‖∑ j : Fin n,\n ((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j‖ₑ ^ p\n ∂centeredBernoulliPairs n q) =\n (∫⁻ ξ, ∫⁻ σ, ‖∑ j : Fin n, ((σ j : ℤ) : ℝ) •\n (((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j)‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n) ∂centeredBernoulliPairs n q) := by\n haveI := rademacher_product_probability n\n calc\n _ = ∫⁻ σ : Fin n → ({-1, 1} : Set ℤ),\n (∫⁻ ξ, ‖∑ j : Fin n,\n ((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j‖ₑ ^ p\n ∂centeredBernoulliPairs n q)\n ∂rademacherProductDistribution (Fin n) := by\n rw [lintegral_const, measure_univ, mul_one]\n _ = ∫⁻ σ, ∫⁻ ξ, ‖∑ j : Fin n, ((σ j : ℤ) : ℝ) •\n (((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j)‖ₑ ^ p\n ∂centeredBernoulliPairs n q ∂rademacherProductDistribution (Fin n) := by\n apply lintegral_congr\n intro σ\n exact centeredBernoulliPairs_sign_integral n q p x σ\n _ = _ := lintegral_lintegral_swap (measurable_of_countable _).aemeasurable\n have centeredBernoulliPairs_scaled_moment_le\n \n (n : ℕ) (q : Set.Icc (0 : ℝ) 1) (p : ℝ) (hp : 1 ≤ p) (hp2 : p ≤ 2)\n (j : Fin n) (v : X) :\n (∫⁻ ξ, ‖(((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • v)‖ₑ ^ p\n ∂centeredBernoulliPairs n q) ≤\n (ENNReal.ofReal (8 * (q : ℝ) * (1 - (q : ℝ)))) ^ (p / 2) * ‖v‖ₑ ^ p := by\n calc\n _ = (∫⁻ ξ, ‖((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ))‖ₑ ^ p\n ∂centeredBernoulliPairs n q) * ‖v‖ₑ ^ p := by\n simp only [enorm_smul, ENNReal.mul_rpow_of_nonneg _ _ (show 0 ≤ p by linarith)]\n exact lintegral_mul_const _ (measurable_of_countable _)\n _ = (∫⁻ a : ({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ),\n ‖((a.1 : ℤ) : ℝ) - ((a.2 : ℤ) : ℝ)‖ₑ ^ p\n ∂(centeredBernoulliMeasure q).prod (centeredBernoulliMeasure q)) * ‖v‖ₑ ^ p := by\n congr 1\n unfold centeredBernoulliPairs\n exact (measurePreserving_eval\n (fun _ : Fin n ↦ (centeredBernoulliMeasure q).prod (centeredBernoulliMeasure q)) j\n |>.lintegral_comp (measurable_of_countable\n (fun a : ({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ) ↦\n ‖((a.1 : ℤ) : ℝ) - ((a.2 : ℤ) : ℝ)‖ₑ ^ p)))\n _ ≤ _ := mul_le_mul' (bernoulli_difference_moment_le p q hp hp2) le_rfl\n have centeredBernoulli_cube_bound\n \n (n : ℕ) (p : ℝ) (C : ℝ≥0∞) (q : Set.Icc (0 : ℝ) 1) (x : Fin n → X)\n (hn : 1 ≤ n) (hp : 1 ≤ p) (hp2 : p ≤ 2)\n (hC : IsRademacherType X C p) :\n (∫⁻ δ, ‖∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) • x j‖ₑ ^ p\n ∂centeredBernoulliCube n q) ≤\n (ENNReal.ofReal (8 * (q : ℝ) * (1 - (q : ℝ)))) ^ (p / 2) *\n C ^ p * ∑ j : Fin n, ‖x j‖ₑ ^ p := by\n calc\n _ ≤ ∫⁻ ξ, ‖∑ j : Fin n,\n ((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j‖ₑ ^ p\n ∂centeredBernoulliPairs n q := centeredBernoulli_copy_jensen n q p hp x\n _ = ∫⁻ ξ, ∫⁻ σ, ‖∑ j : Fin n, ((σ j : ℤ) : ℝ) •\n (((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j)‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n) ∂centeredBernoulliPairs n q :=\n centeredBernoulliPairs_symmetrization n q p x\n _ ≤ ∫⁻ ξ, C ^ p * ∑ j : Fin n,\n ‖(((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j)‖ₑ ^ p\n ∂centeredBernoulliPairs n q := by\n apply lintegral_mono\n intro ξ\n exact hC n hn _\n _ = C ^ p * ∑ j : Fin n, ∫⁻ ξ,\n ‖(((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j)‖ₑ ^ p\n ∂centeredBernoulliPairs n q := by\n rw [lintegral_const_mul _ (measurable_of_countable _),\n lintegral_finsetSum Finset.univ (fun j hj ↦ measurable_of_countable _)]\n _ ≤ C ^ p * ∑ j : Fin n,\n (ENNReal.ofReal (8 * (q : ℝ) * (1 - (q : ℝ)))) ^ (p / 2) * ‖x j‖ₑ ^ p := by\n refine mul_le_mul' le_rfl ?_\n apply Finset.sum_le_sum\n intro j hj\n exact centeredBernoulliPairs_scaled_moment_le n q p hp hp2 j (x j)\n _ = _ := by rw [← Finset.mul_sum]; ac_rfl\n have centered_bernoulli_cube_joint_bound :\n ∀ (n : ℕ) (p : ℝ) (C : ℝ≥0∞) (q : Set.Icc (0 : ℝ) 1)\n (x : (Fin n → ({-1, 1} : Set ℤ)) → Fin n → X),\n 1 ≤ n → 1 ≤ p → p ≤ 2 →\n RademacherEnfloType.IsRademacherType X C p →\n (∫⁻ ε : Fin n → ({-1, 1} : Set ℤ),\n (∫⁻ δ : Fin n → ({-1, 1} : Set ℤ),\n ‖∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) •\n x (fun k ↦ if (δ k : ℤ) = 1 then ε k else -ε k) j‖ₑ ^ p\n ∂MeasureTheory.Measure.infinitePi (fun _ : Fin n ↦\n ProbabilityTheory.bernoulliMeasure\n (⟨1, by decide⟩ : ({-1, 1} : Set ℤ)) ⟨-1, by decide⟩ q))\n ∂RademacherEnfloType.rademacherProductDistribution (Fin n)) ≤\n (ENNReal.ofReal (8 * (q : ℝ) * (1 - (q : ℝ)))) ^ (p / 2) *\n C ^ p * ∑ j : Fin n,\n (∫⁻ ε : Fin n → ({-1, 1} : Set ℤ), ‖x ε j‖ₑ ^ p\n ∂RademacherEnfloType.rademacherProductDistribution (Fin n)) := by\n intro n p C q x hn hp hp2 hC\n haveI := rademacher_product_probability n\n rw [Measure.infinitePi_eq_pi]\n change (∫⁻ ε, ∫⁻ δ,\n ‖∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) •\n x (cubeTranslate n δ ε) j‖ₑ ^ p\n ∂centeredBernoulliCube n q ∂rademacherProductDistribution (Fin n)) ≤ _\n calc\n _ = ∫⁻ δ, ∫⁻ ε,\n ‖∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) •\n x (cubeTranslate n δ ε) j‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n) ∂centeredBernoulliCube n q :=\n lintegral_lintegral_swap (measurable_of_countable _).aemeasurable\n _ = ∫⁻ δ, ∫⁻ ε,\n ‖∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) • x ε j‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n) ∂centeredBernoulliCube n q := by\n apply lintegral_congr\n intro δ\n exact cubeTranslate_lintegral n δ\n (fun ε ↦ ‖∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) • x ε j‖ₑ ^ p)\n _ = ∫⁻ ε, ∫⁻ δ,\n ‖∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) • x ε j‖ₑ ^ p\n ∂centeredBernoulliCube n q ∂rademacherProductDistribution (Fin n) :=\n lintegral_lintegral_swap (measurable_of_countable _).aemeasurable\n _ ≤ ∫⁻ ε, (ENNReal.ofReal (8 * (q : ℝ) * (1 - (q : ℝ)))) ^ (p / 2) *\n C ^ p * ∑ j : Fin n, ‖x ε j‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n) := by\n apply lintegral_mono\n intro ε\n exact centeredBernoulli_cube_bound n p C q (x ε) hn hp hp2 hC\n _ = _ := by\n rw [lintegral_const_mul _ (measurable_of_countable _),\n lintegral_finsetSum Finset.univ (fun j hj ↦ measurable_of_countable _)]\n have arcsine_kernel_mass :\n IntervalIntegrable (fun t : ℝ ↦ (Real.sqrt (1 - t ^ 2))⁻¹)\n MeasureTheory.volume (-1 : ℝ) (1 : ℝ) ∧\n (∫ t in (-1 : ℝ)..(1 : ℝ), (Real.sqrt (1 - t ^ 2))⁻¹) = Real.pi := by\n have hint : IntervalIntegrable (fun t : ℝ ↦ (Real.sqrt (1 - t ^ 2))⁻¹)\n MeasureTheory.volume (-1 : ℝ) (1 : ℝ) := by\n simpa only [Real.sqrt_inv] using\n Polynomial.Chebyshev.intervalIntegrable_sqrt_one_sub_sq_inv\n refine ⟨hint, ?_⟩\n have hFTC := intervalIntegral.integral_eq_sub_of_hasDerivAt_of_le\n (f := Real.arcsin) (f' := fun t : ℝ ↦ (Real.sqrt (1 - t ^ 2))⁻¹)\n (show (-1 : ℝ) ≤ 1 by norm_num) Real.continuous_arcsin.continuousOn\n (by\n intro t ht\n simpa only [one_div] using\n Real.hasDerivAt_arcsin (ne_of_gt ht.1) (ne_of_lt ht.2)) hint\n calc\n (∫ t in (-1 : ℝ)..(1 : ℝ), (Real.sqrt (1 - t ^ 2))⁻¹) =\n Real.arcsin 1 - Real.arcsin (-1) := hFTC\n _ = Real.pi := by rw [Real.arcsin_one, Real.arcsin_neg_one]; ring\n have noise_product_deriv (n : ℕ) (a : Fin n → ℝ) (t : ℝ) :\n HasDerivAt (fun s : ℝ => ∏ k : Fin n, (1 + s * a k))\n (∑ j : Fin n, a j * ∏ k ∈ Finset.univ.erase j, (1 + t * a k)) t := by\n have h := HasDerivAt.finsetProd (u := (Finset.univ : Finset (Fin n)))\n (f := fun i : Fin n => fun s : ℝ => 1 + s * a i) (f' := a) (x := t) (by\n intro i hi\n simpa [add_comm, mul_comm] using\n HasDerivAt.add_const 1 ((hasDerivAt_id' t).mul_const (a i)))\n have hder : HasDerivAt (∏ i : Fin n, fun s : ℝ => 1 + s * a i)\n (∑ j : Fin n, a j * ∏ k ∈ Finset.univ.erase j, (1 + t * a k)) t :=\n h.congr_deriv (by simp [smul_eq_mul, mul_comm])\n exact hder.congr_of_eventuallyEq (by\n filter_upwards [] with s\n simp only [Finset.prod_apply])\n have noise_polynomial_antipodal_integral\n \n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (ε : Fin n → ({-1, 1} : Set ℤ)) :\n (1 / (2 : ℝ)) • (f ε - f (-ε)) =\n ∫ t in (-1 : ℝ)..(1 : ℝ),\n (1 / (2 * (2 : ℝ) ^ n)) •\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∑ j : Fin n, ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) •\n f (fun k ↦ if (δ k : ℤ) = 1 then ε k else -ε k)) := by\n classical\n let g : (Fin n → ({-1, 1} : Set ℤ)) → X :=\n fun δ => f (fun k ↦ if (δ k : ℤ) = 1 then ε k else -ε k)\n let c : ℝ := 1 / (2 * (2 : ℝ) ^ n)\n let P : ℝ → X := fun t =>\n c • ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∏ k : Fin n, (1 + t * ((δ k : ℤ) : ℝ))) • g δ\n have hPderiv : ∀ t : ℝ, HasDerivAt P\n (c • ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∑ j : Fin n, ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) • g δ) t := by\n intro t\n have hsum : HasDerivAt\n (fun s : ℝ => ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∏ k : Fin n, (1 + s * ((δ k : ℤ) : ℝ))) • g δ)\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∑ j : Fin n, ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) • g δ) t := by\n apply HasDerivAt.fun_sum\n intro δ hδ\n have hp := noise_product_deriv n (fun k ↦ ((δ k : ℤ) : ℝ)) t\n have hs := hp.smul_const (g δ)\n simpa [smul_eq_mul, mul_comm] using hs\n have hc := hsum.const_smul c\n change HasDerivAt (fun s : ℝ => c •\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∏ k : Fin n, (1 + s * ((δ k : ℤ) : ℝ))) • g δ)) _ t\n convert hc using 1 <;> funext s <;> rfl\n have hPcont : ContinuousOn P (Set.Icc (-1 : ℝ) 1) := by\n fun_prop\n have hPint : IntervalIntegrable\n (fun t => c • ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∑ j : Fin n, ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) • g δ)\n MeasureTheory.volume (-1 : ℝ) 1 := by\n apply ContinuousOn.intervalIntegrable_of_Icc (by norm_num)\n fun_prop\n have hFTC := intervalIntegral.integral_eq_sub_of_hasDerivAt_of_le\n (a := (-1 : ℝ)) (b := (1 : ℝ)) (f := P)\n (f' := fun t => c • ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∑ j : Fin n, ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) • g δ)\n (by norm_num) hPcont (fun t ht => hPderiv t) hPint\n change (1 / (2 : ℝ)) • (f ε - f (-ε)) =\n ∫ t in (-1 : ℝ)..(1 : ℝ),\n c • (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∑ j : Fin n, ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) • g δ)\n let δp : Fin n → ({-1, 1} : Set ℤ) := fun _ => ⟨1, by simp⟩\n let δm : Fin n → ({-1, 1} : Set ℤ) := fun _ => ⟨-1, by simp⟩\n have hsum1 :\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∏ k : Fin n, (1 + (1 : ℝ) * ((δ k : ℤ) : ℝ))) • g δ) =\n (2 : ℝ) ^ n • f ε := by\n rw [Finset.sum_eq_single δp]\n · simp [δp, g]\n congr 1\n norm_num\n · intro δ hδ hne\n by_cases heq : δ = δp\n · exact (hne heq).elim\n · obtain ⟨k, hk⟩ : ∃ k : Fin n, δ k ≠ δp k := by\n by_contra hno\n apply heq\n funext k\n exact not_not.mp (fun h => hno ⟨k, h⟩)\n have hδk : (δ k : ℤ) = -1 := by\n have hv' : (δ k : ℤ) = -1 ∨ (δ k : ℤ) = 1 := by\n simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using (δ k).property\n rcases hv' with hv' | hv'\n · exact hv'\n · exfalso\n apply hk\n apply Subtype.ext\n simpa [δp] using hv'\n have hz : (∏ k : Fin n, (1 + (1 : ℝ) * ((δ k : ℤ) : ℝ))) = 0 := by\n apply Finset.prod_eq_zero (Finset.mem_univ k)\n simp [hδk]\n rw [hz]\n simp\n · simp\n have hsumm :\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∏ k : Fin n, (1 + (-1 : ℝ) * ((δ k : ℤ) : ℝ))) • g δ) =\n (2 : ℝ) ^ n • f (-ε) := by\n rw [Finset.sum_eq_single δm]\n · simp [δm, g]\n congr 1\n norm_num\n · intro δ hδ hne\n by_cases heq : δ = δm\n · exact (hne heq).elim\n · obtain ⟨k, hk⟩ : ∃ k : Fin n, δ k ≠ δm k := by\n by_contra hno\n apply heq\n funext k\n exact not_not.mp (fun h => hno ⟨k, h⟩)\n have hδk : (δ k : ℤ) = 1 := by\n have hv' : (δ k : ℤ) = -1 ∨ (δ k : ℤ) = 1 := by\n simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using (δ k).property\n rcases hv' with hv' | hv'\n · exfalso\n apply hk\n apply Subtype.ext\n simpa [δm] using hv'\n · exact hv'\n have hz : (∏ k : Fin n, (1 + (-1 : ℝ) * ((δ k : ℤ) : ℝ))) = 0 := by\n apply Finset.prod_eq_zero (Finset.mem_univ k)\n simp [hδk]\n rw [hz]\n simp\n · simp\n rw [hFTC]\n simp only [P, c]\n rw [hsum1, hsumm]\n rw [smul_sub, smul_smul, smul_smul]\n congr 1 <;> field_simp\n let enfloArcsineDensity (t : ℝ) : ℝ≥0∞ :=\n ENNReal.ofReal ((Real.pi * Real.sqrt (1 - t ^ 2))⁻¹)\n let enfloArcsineMeasure : MeasureTheory.Measure ℝ :=\n (MeasureTheory.volume.restrict (Set.Ioo (-1 : ℝ) 1)).withDensity enfloArcsineDensity\n have enfloArcsineDensity_measurable : Measurable enfloArcsineDensity := by\n unfold enfloArcsineDensity\n fun_prop\n have enfloArcsineDensity_toReal (t : ℝ) :\n (enfloArcsineDensity t).toReal = (Real.pi * Real.sqrt (1 - t ^ 2))⁻¹ := by\n dsimp only [enfloArcsineDensity]\n rw [ENNReal.toReal_ofReal]\n positivity\n have enfloArcsineMeasure_probability :\n MeasureTheory.IsProbabilityMeasure enfloArcsineMeasure := by\n have hmass := arcsine_kernel_mass\n have hi : Integrable (fun t : ℝ ↦ (Real.sqrt (1 - t ^ 2))⁻¹)\n (volume.restrict (Set.Ioo (-1 : ℝ) 1)) := by\n rw [restrict_Ioo_eq_restrict_Ioc]\n exact hmass.1.1\n have hi' : Integrable (fun t : ℝ ↦ (Real.pi * Real.sqrt (1 - t ^ 2))⁻¹)\n (volume.restrict (Set.Ioo (-1 : ℝ) 1)) := by\n simpa only [mul_inv_rev, mul_comm] using hi.const_mul Real.pi⁻¹\n constructor\n dsimp only [enfloArcsineMeasure]\n rw [withDensity_apply _ MeasurableSet.univ,\n Measure.restrict_univ]\n change (∫⁻ t in Set.Ioo (-1 : ℝ) 1,\n ENNReal.ofReal ((Real.pi * Real.sqrt (1 - t ^ 2))⁻¹)) = 1\n rw [← ofReal_integral_eq_lintegral_ofReal hi' (Filter.Eventually.of_forall (by\n intro t; positivity))]\n simp only [mul_inv_rev]\n rw [integral_mul_const, restrict_Ioo_eq_restrict_Ioc,\n ← intervalIntegral.integral_of_le (by norm_num : (-1 : ℝ) ≤ 1), hmass.2]\n rw [mul_inv_cancel₀ Real.pi_ne_zero]\n norm_num\n have enfloArcsineMeasure_ae_mem :\n ∀ᵐ t ∂enfloArcsineMeasure, t ∈ Set.Ioo (-1 : ℝ) 1 := by\n exact (withDensity_absolutelyContinuous _ _).ae_le\n (ae_restrict_mem measurableSet_Ioo)\n have enfloArcsineDensity_sqrt_cancel (t : ℝ) (ht : t ∈ Set.Ioo (-1 : ℝ) 1) :\n (enfloArcsineDensity t).toReal * Real.sqrt (2 * (1 - t ^ 2)) =\n Real.sqrt 2 / Real.pi := by\n have hs : 0 < 1 - t ^ 2 := by nlinarith [ht.1, ht.2]\n rw [enfloArcsineDensity_toReal, Real.sqrt_mul (by norm_num : (0 : ℝ) ≤ 2)]\n have hz := (Real.sqrt_pos.2 hs).ne'\n field_simp\n have enfloArcsineMeasure_integral_recovery\n \n (g : ℝ → X) :\n (∫ t in (-1 : ℝ)..(1 : ℝ), g t) =\n (Real.pi / Real.sqrt 2) •\n (∫ t, Real.sqrt (2 * (1 - t ^ 2)) • g t ∂enfloArcsineMeasure) := by\n dsimp only [enfloArcsineMeasure]\n rw [integral_withDensity_eq_integral_toReal_smul\n enfloArcsineDensity_measurable (Filter.Eventually.of_forall (by\n intro t; exact ENNReal.ofReal_lt_top))]\n rw [integral_congr_ae (Filter.Eventually.mono\n (ae_restrict_mem measurableSet_Ioo) (by\n intro t ht\n rw [smul_smul, enfloArcsineDensity_sqrt_cancel t ht]))]\n rw [integral_smul, smul_smul]\n have hc : Real.pi / Real.sqrt 2 * (Real.sqrt 2 / Real.pi) = 1 := by\n have hz : Real.sqrt (2 : ℝ) ≠ 0 := (Real.sqrt_pos.2 (by norm_num)).ne'\n field_simp\n rw [hc, one_smul, restrict_Ioo_eq_restrict_Ioc,\n intervalIntegral.integral_of_le (by norm_num : (-1 : ℝ) ≤ 1)]\n have centeredBernoulliMeasure_singleton_real\n (q : Set.Icc (0 : ℝ) 1) (a : ({-1, 1} : Set ℤ)) :\n (centeredBernoulliMeasure q).real {a} =\n (1 + (2 * (q : ℝ) - 1) * ((a : ℤ) : ℝ)) / 2 := by\n rcases a with ⟨a, ha⟩\n have h : a = -1 ∨ a = 1 := by\n simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using ha\n rcases h with h | h <;> subst a\n · simp [centeredBernoulliMeasure, bernoulliMeasure_def, Measure.real,\n unitInterval.coe_toNNReal, unitInterval.coe_symm_eq]\n ring\n · simp [centeredBernoulliMeasure, bernoulliMeasure_def, Measure.real,\n unitInterval.coe_toNNReal]\n have centeredBernoulliCube_singleton_real\n (n : ℕ) (q : Set.Icc (0 : ℝ) 1) (δ : Fin n → ({-1, 1} : Set ℤ)) :\n (centeredBernoulliCube n q).real {δ} =\n (1 / (2 : ℝ) ^ n) *\n ∏ k : Fin n, (1 + (2 * (q : ℝ) - 1) * ((δ k : ℤ) : ℝ)) := by\n rw [Measure.real]\n dsimp only [centeredBernoulliCube]\n rw [Measure.pi_singleton, ENNReal.toReal_prod]\n change (∏ k : Fin n, (centeredBernoulliMeasure q).real {δ k}) = _\n simp only [centeredBernoulliMeasure_singleton_real, div_eq_mul_inv,\n Finset.prod_mul_distrib, Finset.prod_const, Finset.card_univ, Fintype.card_fin, ← inv_pow]\n ring\n have centeredBernoulliCube_integral_eq\n \n (n : ℕ) (q : Set.Icc (0 : ℝ) 1)\n (g : (Fin n → ({-1, 1} : Set ℤ)) → X) :\n (∫ δ, g δ ∂centeredBernoulliCube n q) =\n (1 / (2 : ℝ) ^ n) •\n ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∏ k : Fin n, (1 + (2 * (q : ℝ) - 1) * ((δ k : ℤ) : ℝ))) • g δ := by\n rw [integral_fintype Integrable.of_finite]\n simp only [centeredBernoulliCube_singleton_real, Finset.smul_sum, smul_smul]\n have cubeTranslate_update (n : ℕ) (δ ε : Fin n → ({-1, 1} : Set ℤ)) (j : Fin n) :\n cubeTranslate n (Function.update δ j (-δ j)) ε =\n Function.update (cubeTranslate n δ ε) j (-(cubeTranslate n δ ε j)) := by\n classical\n funext k\n by_cases hk : k = j\n · subst k\n simp only [Function.update_self, cubeTranslate]\n change (if -(δ j : ℤ) = 1 then ε j else -ε j) =\n -(if (δ j : ℤ) = 1 then ε j else -ε j)\n have hj : (δ j : ℤ) = -1 ∨ (δ j : ℤ) = 1 := by\n simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using (δ j).property\n rcases hj with hj | hj\n · simp only [hj]\n norm_num\n apply Subtype.ext\n change (ε j : ℤ) = -(-(ε j : ℤ))\n simp\n · simp only [hj]\n norm_num\n · simp only [cubeTranslate, Function.update_of_ne hk]\n have cubeTranslate_derivative\n \n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (δ ε : Fin n → ({-1, 1} : Set ℤ)) (j : Fin n) :\n D j (fun η ↦ f (cubeTranslate n η ε)) δ = D j f (cubeTranslate n δ ε) := by\n unfold D\n dsimp only\n rw [cubeTranslate_update]\n let enfloNoiseDerivative\n \n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (ε : Fin n → ({-1, 1} : Set ℤ)) (t : ℝ) : X :=\n (1 / (2 * (2 : ℝ) ^ n)) •\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∑ j : Fin n, ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) •\n f (cubeTranslate n δ ε))\n let enfloNormalizedNoise\n \n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (ε : Fin n → ({-1, 1} : Set ℤ)) (t : ℝ) : X :=\n Real.sqrt (2 * (1 - t ^ 2)) • enfloNoiseDerivative n f ε t\n have enfloNormalizedNoise_continuous\n \n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (ε : Fin n → ({-1, 1} : Set ℤ)) :\n Continuous (enfloNormalizedNoise n f ε) := by\n unfold enfloNormalizedNoise enfloNoiseDerivative\n fun_prop\n have enflo_antipodal_kernel_expectation\n \n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (ε : Fin n → ({-1, 1} : Set ℤ)) :\n (1 / (2 : ℝ)) • (f ε - f (-ε)) =\n (Real.pi / Real.sqrt 2) •\n (∫ t, enfloNormalizedNoise n f ε t ∂enfloArcsineMeasure) := by\n rw [noise_polynomial_antipodal_integral n f ε]\n exact enfloArcsineMeasure_integral_recovery (enfloNoiseDerivative n f ε)\n have enfloNoiseDerivative_centered_integral\n \n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (ε : Fin n → ({-1, 1} : Set ℤ)) (t : ℝ)\n (q : Set.Icc (0 : ℝ) 1) (hq : 2 * (q : ℝ) - 1 = t) :\n (1 - t ^ 2) • enfloNoiseDerivative n f ε t =\n (1 / (2 : ℝ)) •\n (∫ δ, ∑ j : Fin n, (((δ j : ℤ) : ℝ) - t) •\n D j f (cubeTranslate n δ ε) ∂centeredBernoulliCube n q) := by\n have hw := weighted_cube_derivative_identity n (fun δ ↦ f (cubeTranslate n δ ε)) t\n simp only [cubeTranslate_derivative] at hw\n rw [centeredBernoulliCube_integral_eq, hq]\n unfold enfloNoiseDerivative\n rw [smul_comm (1 - t ^ 2), hw, smul_smul]\n congr 1\n field_simp\n have enfloNormalizedNoise_centered_expectation\n \n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (ε : Fin n → ({-1, 1} : Set ℤ)) (t : ℝ)\n (ht : t ∈ Set.Ioo (-1 : ℝ) 1)\n (q : Set.Icc (0 : ℝ) 1) (hq : 2 * (q : ℝ) - 1 = t) :\n enfloNormalizedNoise n f ε t =\n (Real.sqrt (2 * (1 - t ^ 2)))⁻¹ •\n (∫ δ, ∑ j : Fin n, (((δ j : ℤ) : ℝ) - t) •\n D j f (cubeTranslate n δ ε) ∂centeredBernoulliCube n q) := by\n have hs : 0 < 1 - t ^ 2 := by nlinarith [ht.1, ht.2]\n have hs' : 0 < 2 * (1 - t ^ 2) := by positivity\n have heq : enfloNoiseDerivative n f ε t =\n (1 - t ^ 2)⁻¹ • ((1 / (2 : ℝ)) •\n (∫ δ, ∑ j : Fin n, (((δ j : ℤ) : ℝ) - t) •\n D j f (cubeTranslate n δ ε) ∂centeredBernoulliCube n q)) := by\n rw [← enfloNoiseDerivative_centered_integral n f ε t q hq,\n smul_smul, inv_mul_cancel₀ hs.ne', one_smul]\n unfold enfloNormalizedNoise\n rw [heq, smul_smul, smul_smul]\n congr 1\n have hz : Real.sqrt (2 * (1 - t ^ 2)) ≠ 0 := (Real.sqrt_pos.2 hs').ne'\n have hsq := Real.sq_sqrt hs'.le\n field_simp\n nlinarith\n have enflo_sqrt_inv_moment_cancel (s p : ℝ) (hs : 0 < s) :\n (ENNReal.ofReal ((Real.sqrt s)⁻¹)) ^ p *\n (ENNReal.ofReal s) ^ (p / 2) = 1 := by\n have hz : Real.sqrt s ≠ 0 := (Real.sqrt_pos.2 hs).ne'\n have he : ENNReal.ofReal (Real.sqrt s) ≠ 0 :=\n (ENNReal.ofReal_pos.2 (Real.sqrt_pos.2 hs)).ne'\n have he' : ENNReal.ofReal (Real.sqrt s) ≠ ⊤ := ENNReal.ofReal_ne_top\n have hpow : (ENNReal.ofReal s) ^ (p / 2) =\n (ENNReal.ofReal (Real.sqrt s)) ^ p := by\n calc\n (ENNReal.ofReal s) ^ (p / 2) =\n ((ENNReal.ofReal (Real.sqrt s)) ^ (2 : ℝ)) ^ (p / 2) := by\n have hsq : (ENNReal.ofReal (Real.sqrt s)) ^ (2 : ℝ) = ENNReal.ofReal s := by\n calc\n _ = (ENNReal.ofReal (Real.sqrt s)) ^ (2 : ℕ) := by\n simpa using ENNReal.rpow_natCast (ENNReal.ofReal (Real.sqrt s)) 2\n _ = ENNReal.ofReal ((Real.sqrt s) ^ (2 : ℕ)) :=\n (ENNReal.ofReal_pow (Real.sqrt_nonneg s) 2).symm\n _ = ENNReal.ofReal s := by rw [Real.sq_sqrt hs.le]\n rw [hsq]\n _ = (ENNReal.ofReal (Real.sqrt s)) ^ (2 * (p / 2)) :=\n (ENNReal.rpow_mul _ _ _).symm\n _ = _ := by congr 1; ring\n rw [hpow, ENNReal.ofReal_inv_of_pos (Real.sqrt_pos.2 hs), ENNReal.inv_rpow]\n exact ENNReal.inv_mul_cancel (by simp [he, he'])\n (ENNReal.rpow_ne_top_of_ne_zero he he')\n have enflo_finite_lintegral_swap\n (n : ℕ) (μ : MeasureTheory.Measure ℝ)\n (g : ℝ → (Fin n → ({-1, 1} : Set ℤ)) → ℝ≥0∞)\n (hg : ∀ ε, Measurable (fun t ↦ g t ε)) :\n (∫⁻ ε, (∫⁻ t, g t ε ∂μ) ∂rademacherProductDistribution (Fin n)) =\n ∫⁻ t, (∫⁻ ε, g t ε ∂rademacherProductDistribution (Fin n)) ∂μ := by\n simp only [lintegral_fintype]\n rw [lintegral_finsetSum]\n · apply Finset.sum_congr rfl\n intro ε hε\n exact (lintegral_mul_const _ (hg ε)).symm\n · intro ε hε\n exact (hg ε).mul_const _\n have enfloNormalizedNoise_cube_moment_le\n \n (n : ℕ) (p : ℝ) (C : ℝ≥0∞)\n (f : (Fin n → ({-1, 1} : Set ℤ)) → X) (t : ℝ)\n (ht : t ∈ Set.Ioo (-1 : ℝ) 1) (hn : 1 ≤ n) (h1p : 1 ≤ p) (hp2 : p ≤ 2)\n (hC : RademacherEnfloType.IsRademacherType X C p) :\n (∫⁻ ε, ‖enfloNormalizedNoise n f ε t‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n)) ≤\n C ^ p * ∑ j : Fin n,\n (∫⁻ ε, ‖D j f ε‖ₑ ^ p ∂rademacherProductDistribution (Fin n)) := by\n let q : Set.Icc (0 : ℝ) 1 := ⟨(1 + t) / 2, by\n constructor <;> linarith [ht.1, ht.2]⟩\n have hq : 2 * (q : ℝ) - 1 = t := by dsimp [q]; ring\n have hs : 0 < 2 * (1 - t ^ 2) := by nlinarith [ht.1, ht.2]\n have hp : 0 ≤ p := by linarith\n let a : ℝ≥0∞ := (ENNReal.ofReal ((Real.sqrt (2 * (1 - t ^ 2)))⁻¹)) ^ p\n let S : (Fin n → ({-1, 1} : Set ℤ)) →\n (Fin n → ({-1, 1} : Set ℤ)) → X :=\n fun ε δ ↦ ∑ j : Fin n, (((δ j : ℤ) : ℝ) - t) • D j f (cubeTranslate n δ ε)\n have hjensen : ∀ ε, ‖enfloNormalizedNoise n f ε t‖ₑ ^ p ≤\n a * (∫⁻ δ, ‖S ε δ‖ₑ ^ p ∂centeredBernoulliCube n q) := by\n intro ε\n have hj := probability_integral_enorm_rpow_le\n (Fin n → ({-1, 1} : Set ℤ)) (centeredBernoulliCube n q) p (S ε)\n h1p StronglyMeasurable.of_discrete.aestronglyMeasurable\n rw [enfloNormalizedNoise_centered_expectation n f ε t ht q hq,\n enorm_smul, Real.enorm_of_nonneg (by positivity),\n ENNReal.mul_rpow_of_nonneg _ _ hp]\n exact mul_le_mul' le_rfl hj\n have hfirst :\n (∫⁻ ε, ‖enfloNormalizedNoise n f ε t‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n)) ≤\n a * (∫⁻ ε, (∫⁻ δ, ‖S ε δ‖ₑ ^ p ∂centeredBernoulliCube n q)\n ∂rademacherProductDistribution (Fin n)) := by\n calc\n _ ≤ ∫⁻ ε, a * (∫⁻ δ, ‖S ε δ‖ₑ ^ p ∂centeredBernoulliCube n q)\n ∂rademacherProductDistribution (Fin n) := lintegral_mono hjensen\n _ = _ := lintegral_const_mul a (measurable_of_countable _)\n have hvariance : 8 * (q : ℝ) * (1 - (q : ℝ)) = 2 * (1 - t ^ 2) := by\n dsimp [q]\n ring\n have hjoint :\n (∫⁻ ε, (∫⁻ δ, ‖S ε δ‖ₑ ^ p ∂centeredBernoulliCube n q)\n ∂rademacherProductDistribution (Fin n)) ≤\n (ENNReal.ofReal (2 * (1 - t ^ 2))) ^ (p / 2) * C ^ p *\n ∑ j : Fin n, (∫⁻ ε, ‖D j f ε‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n)) := by\n have h := centered_bernoulli_cube_joint_bound n p C q (fun ε j ↦ D j f ε)\n hn h1p hp2 hC\n rw [Measure.infinitePi_eq_pi, hq, hvariance] at h\n change (∫⁻ ε, (∫⁻ δ, ‖S ε δ‖ₑ ^ p ∂centeredBernoulliCube n q)\n ∂rademacherProductDistribution (Fin n)) ≤\n (ENNReal.ofReal (2 * (1 - t ^ 2))) ^ (p / 2) * C ^ p *\n ∑ j : Fin n, (∫⁻ ε, ‖D j f ε‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n)) at h\n exact h\n calc\n _ ≤ a * (∫⁻ ε, (∫⁻ δ, ‖S ε δ‖ₑ ^ p ∂centeredBernoulliCube n q)\n ∂rademacherProductDistribution (Fin n)) := hfirst\n _ ≤ a * ((ENNReal.ofReal (2 * (1 - t ^ 2))) ^ (p / 2) * C ^ p *\n ∑ j : Fin n, (∫⁻ ε, ‖D j f ε‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n))) := mul_le_mul' le_rfl hjoint\n _ = _ := by\n dsimp only [a]\n rw [← mul_assoc, ← mul_assoc, enflo_sqrt_inv_moment_cancel _ p hs, one_mul]\n have enflo_type_constant_eq :\n ENNReal.ofReal (Real.pi / Real.sqrt 2) =\n (NNReal.pi : ℝ≥0∞) / (NNReal.sqrt (2 : ℝ≥0) : ℝ≥0∞) := by\n rw [ENNReal.ofReal_div_of_pos (Real.sqrt_pos.2 (by norm_num))]\n have hpi : ENNReal.ofReal Real.pi = (NNReal.pi : ℝ≥0∞) := by\n rw [← NNReal.coe_real_pi, ENNReal.ofReal_coe_nnreal]\n have hs : ENNReal.ofReal (Real.sqrt 2) = (NNReal.sqrt (2 : ℝ≥0) : ℝ≥0∞) := by\n simpa only [Real.coe_sqrt, NNReal.coe_ofNat] using\n (show ENNReal.ofReal ((NNReal.sqrt (2 : ℝ≥0)) : ℝ) =\n (NNReal.sqrt (2 : ℝ≥0) : ℝ≥0∞) from ENNReal.ofReal_coe_nnreal)\n rw [hpi, hs]\n have rademacher_implies_enflo :\n ∀ (p : ℝ) (C : ℝ≥0∞),\n 1 ≤ p → p ≤ 2 →\n RademacherEnfloType.IsRademacherType X C p →\n RademacherEnfloType.IsEnfloType X\n (((NNReal.pi : ℝ≥0∞) / (NNReal.sqrt (2 : ℝ≥0) : ℝ≥0∞)) * C) p := by\n intro p C h1p hp2 hC n hn f\n letI := enfloArcsineMeasure_probability\n have hp : 0 ≤ p := by linarith\n have hscalar : 0 ≤ Real.pi / Real.sqrt 2 := by positivity\n have hJ : ∀ ε, ‖(1 / (2 : ℝ)) • (f ε - f (-ε))‖ₑ ^ p ≤\n (ENNReal.ofReal (Real.pi / Real.sqrt 2)) ^ p *\n (∫⁻ t, ‖enfloNormalizedNoise n f ε t‖ₑ ^ p ∂enfloArcsineMeasure) := by\n intro ε\n rw [enflo_antipodal_kernel_expectation n f ε, enorm_smul,\n Real.enorm_of_nonneg hscalar, ENNReal.mul_rpow_of_nonneg _ _ hp]\n exact mul_le_mul' le_rfl\n (probability_integral_enorm_rpow_le ℝ enfloArcsineMeasure p\n (enfloNormalizedNoise n f ε) h1p\n (enfloNormalizedNoise_continuous n f ε).aestronglyMeasurable)\n have hswap := enflo_finite_lintegral_swap n enfloArcsineMeasure\n (fun t ε ↦ ‖enfloNormalizedNoise n f ε t‖ₑ ^ p)\n (fun ε ↦ (enfloNormalizedNoise_continuous n f ε).enorm.measurable.pow_const p)\n have hmoment :\n (∫⁻ t, (∫⁻ ε, ‖enfloNormalizedNoise n f ε t‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n)) ∂enfloArcsineMeasure) ≤\n C ^ p * ∑ j : Fin n,\n (∫⁻ ε, ‖D j f ε‖ₑ ^ p ∂rademacherProductDistribution (Fin n)) := by\n calc\n _ ≤ ∫⁻ _t : ℝ,\n C ^ p * ∑ j : Fin n,\n (∫⁻ ε, ‖D j f ε‖ₑ ^ p ∂rademacherProductDistribution (Fin n))\n ∂enfloArcsineMeasure := lintegral_mono_ae (enfloArcsineMeasure_ae_mem.mono\n (fun t ht ↦ enfloNormalizedNoise_cube_moment_le n p C f t ht hn h1p hp2 hC))\n _ = _ := by rw [lintegral_const, measure_univ, mul_one]\n calc\n _ ≤ ∫⁻ ε, (ENNReal.ofReal (Real.pi / Real.sqrt 2)) ^ p *\n (∫⁻ t, ‖enfloNormalizedNoise n f ε t‖ₑ ^ p ∂enfloArcsineMeasure)\n ∂rademacherProductDistribution (Fin n) := lintegral_mono hJ\n _ = (ENNReal.ofReal (Real.pi / Real.sqrt 2)) ^ p *\n (∫⁻ t, (∫⁻ ε, ‖enfloNormalizedNoise n f ε t‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n)) ∂enfloArcsineMeasure) := by\n rw [lintegral_const_mul _ (measurable_of_countable _), hswap]\n _ ≤ (ENNReal.ofReal (Real.pi / Real.sqrt 2)) ^ p *\n (C ^ p * ∑ j : Fin n,\n (∫⁻ ε, ‖D j f ε‖ₑ ^ p ∂rademacherProductDistribution (Fin n))) :=\n mul_le_mul' le_rfl hmoment\n _ = _ := by\n rw [enflo_type_constant_eq, ENNReal.mul_rpow_of_nonneg _ _ hp, mul_assoc]\n have type_constants_of_reverse_conversion :\n ∀ (p : ℝ),\n 1 ≤ p → p ≤ 2 →\n (∀ C : ℝ≥0∞, RademacherEnfloType.IsRademacherType X C p →\n RademacherEnfloType.IsEnfloType X\n (((NNReal.pi : ℝ≥0∞) / (NNReal.sqrt (2 : ℝ≥0) : ℝ≥0∞)) * C) p) →\n RademacherEnfloType.TR X p ≤ RademacherEnfloType.TE X p ∧\n RademacherEnfloType.TE X p ≤\n ((NNReal.pi : ℝ≥0∞) / (NNReal.sqrt (2 : ℝ≥0) : ℝ≥0∞)) *\n RademacherEnfloType.TR X p := by\n intro p h1p hp2 hconvert\n let k : ℝ≥0∞ :=\n (NNReal.pi : ℝ≥0∞) / (NNReal.sqrt (2 : ℝ≥0) : ℝ≥0∞)\n have hsqrt : 0 < NNReal.sqrt (2 : ℝ≥0) :=\n NNReal.sqrt_pos.mpr (by norm_num)\n have hkcoe : k = ((NNReal.pi / NNReal.sqrt (2 : ℝ≥0) : ℝ≥0) : ℝ≥0∞) :=\n (ENNReal.coe_div (ne_of_gt hsqrt)).symm\n have hk0 : k ≠ 0 := by\n rw [hkcoe, ENNReal.coe_ne_zero]\n exact ne_of_gt (div_pos NNReal.pi_pos hsqrt)\n have hktop : k ≠ ∞ := by\n rw [hkcoe]\n exact ENNReal.coe_ne_top\n constructor\n · unfold RademacherEnfloType.TR RademacherEnfloType.TE\n apply le_sInf\n intro C hC\n exact sInf_le (enflo_implies_rademacher p C h1p hp2 hC)\n · change RademacherEnfloType.TE X p ≤ k * RademacherEnfloType.TR X p\n apply (ENNReal.div_le_iff' hk0 hktop).mp\n unfold RademacherEnfloType.TR\n apply le_sInf\n intro C hC\n apply (ENNReal.div_le_iff' hk0 hktop).mpr\n exact sInf_le (hconvert C hC)\n exact type_constants_of_reverse_conversion p h1p hp2\n (fun C hC ↦ rademacher_implies_enflo p C h1p hp2 hC)\ntheorem rademacher_product_probability (n : ℕ) :\n IsProbabilityMeasure (rademacherProductDistribution (Fin n)) := by\n unfold rademacherProductDistribution\n haveI : IsProbabilityMeasure rademacherDistribution := by\n unfold rademacherDistribution\n infer_instance\n infer_instance\ntheorem linear_cube_odd\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (x : Fin n → X) (ε : Fin n → ({-1, 1} : Set ℤ)) :\n (∑ j : Fin n, (((-ε) j) : ℝ) • x j) =\n -(∑ j : Fin n, ((ε j) : ℝ) • x j) := by\n change (∑ j : Fin n, (Int.cast (-(ε j : ℤ)) : ℝ) • x j) =\n -(∑ j : Fin n, ((ε j : ℤ) : ℝ) • x j)\n simp only [Int.cast_neg, neg_smul, Finset.sum_neg_distrib]\ntheorem linear_cube_antipodal_half\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (x : Fin n → X) (ε : Fin n → ({-1, 1} : Set ℤ)) :\n (1 / (2 : ℝ)) • ((∑ j : Fin n, ((ε j) : ℝ) • x j) -\n (∑ j : Fin n, (((-ε) j) : ℝ) • x j)) =\n ∑ j : Fin n, ((ε j) : ℝ) • x j := by\n rw [linear_cube_odd X n x ε, sub_neg_eq_add, ← two_smul ℝ, smul_smul]\n norm_num\ntheorem linear_cube_derivative\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (x : Fin n → X) (j : Fin n) (ε : Fin n → ({-1, 1} : Set ℤ)) :\n D j (fun δ ↦ ∑ k : Fin n, ((δ k) : ℝ) • x k) ε =\n ((ε j) : ℝ) • x j := by\n classical\n unfold D\n rw [← Finset.sum_sub_distrib, Finset.smul_sum]\n rw [Finset.sum_eq_single j]\n · simp only [Function.update_self]\n change (1 / (2 : ℝ)) •\n (((ε j : ℤ) : ℝ) • x j - (Int.cast (-(ε j : ℤ)) : ℝ) • x j) =\n ((ε j : ℤ) : ℝ) • x j\n rw [Int.cast_neg, neg_smul, sub_neg_eq_add, ← two_smul ℝ, smul_smul]\n norm_num\n · intro k hk hkj\n simp [Function.update_of_ne hkj]\n · simp\ntheorem rademacher_sign_enorm\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (x : X) (ε : ({-1, 1} : Set ℤ)) :\n ‖((ε : ℤ) : ℝ) • x‖ₑ = ‖x‖ₑ := by\n rcases ε with ⟨ε, hε⟩\n have h : ε = -1 ∨ ε = 1 := by\n simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using hε\n rcases h with h | h <;> subst ε <;> simp\ntheorem linear_cube_derivative_integral\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (x : Fin n → X) (j : Fin n) (p : ℝ) :\n (∫⁻ ε, ‖D j (fun δ ↦ ∑ k : Fin n, ((δ k) : ℝ) • x k) ε‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n)) = ‖x j‖ₑ ^ p := by\n haveI := rademacher_product_probability n\n simp only [linear_cube_derivative, rademacher_sign_enorm]\n rw [lintegral_const, measure_univ, mul_one]\ntheorem enflo_implies_rademacher :\n ∀ (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (p : ℝ) (C : ℝ≥0∞),\n 1 ≤ p → p ≤ 2 →\n RademacherEnfloType.IsEnfloType X C p →\n RademacherEnfloType.IsRademacherType X C p := by\n intro X _ _ _ p C h1p hp2 hC n hn x\n have h := hC n hn (fun ε ↦ ∑ j : Fin n, ((ε j) : ℝ) • x j)\n simpa only [linear_cube_antipodal_half, linear_cube_derivative_integral] using h\ntheorem bernoulli_difference_moment_eq (p : ℝ) (q : Set.Icc (0 : ℝ) 1)\n (hp : 0 < p) :\n (∫⁻ ξ : (({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ)),\n ‖((ξ.1 : ℤ) : ℝ) - ((ξ.2 : ℤ) : ℝ)‖ₑ ^ p\n ∂(bernoulliMeasure (⟨1, by decide⟩ : ({-1, 1} : Set ℤ))\n ⟨-1, by decide⟩ q).prod\n (bernoulliMeasure (⟨1, by decide⟩ : ({-1, 1} : Set ℤ))\n ⟨-1, by decide⟩ q)) =\n (2 : ℝ≥0∞) ^ p * ENNReal.ofReal (2 * (q : ℝ) * (1 - (q : ℝ))) := by\n simp only [bernoulliMeasure_def, Measure.add_prod, Measure.prod_add,\n Measure.prod_smul_left, Measure.prod_smul_right, Measure.dirac_prod_dirac,\n lintegral_add_measure, lintegral_smul_measure, lintegral_dirac]\n norm_num [ENNReal.zero_rpow_of_pos hp]\n have htwo : ‖(2 : ℝ)‖ₑ = (2 : ℝ≥0∞) := by\n simp [enorm_eq_nnnorm]\n rw [htwo]\n change (unitInterval.toNNReal q : ℝ≥0∞) *\n ((unitInterval.toNNReal (unitInterval.symm q) : ℝ≥0∞) * 2 ^ p) +\n (unitInterval.toNNReal (unitInterval.symm q) : ℝ≥0∞) *\n ((unitInterval.toNNReal q : ℝ≥0∞) * 2 ^ p) = _\n have hq : (unitInterval.toNNReal q : ℝ≥0∞) = ENNReal.ofReal (q : ℝ) := by\n rw [← unitInterval.coe_toNNReal q, ENNReal.ofReal_coe_nnreal]\n have hq' : (unitInterval.toNNReal (unitInterval.symm q) : ℝ≥0∞) =\n ENNReal.ofReal (1 - (q : ℝ)) := by\n rw [← unitInterval.coe_symm_eq q, ← unitInterval.coe_toNNReal (unitInterval.symm q),\n ENNReal.ofReal_coe_nnreal]\n rw [hq, hq', ENNReal.ofReal_mul (mul_nonneg (by norm_num) q.property.1),\n ENNReal.ofReal_mul (by norm_num : (0 : ℝ) ≤ 2)]\n norm_num\n ring\ntheorem bernoulli_difference_moment_le :\n ∀ (p : ℝ) (q : Set.Icc (0 : ℝ) 1), 1 ≤ p → p ≤ 2 →\n (∫⁻ ξ : (({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ)),\n ‖((ξ.1 : ℤ) : ℝ) - ((ξ.2 : ℤ) : ℝ)‖ₑ ^ p\n ∂(bernoulliMeasure (⟨1, by decide⟩ : ({-1, 1} : Set ℤ))\n ⟨-1, by decide⟩ q).prod\n (bernoulliMeasure (⟨1, by decide⟩ : ({-1, 1} : Set ℤ))\n ⟨-1, by decide⟩ q)) ≤\n (ENNReal.ofReal (8 * (q : ℝ) * (1 - (q : ℝ)))) ^ (p / 2) := by\n intro p q h1p hp2\n have hp : 0 < p := by linarith\n have hp_half : 0 ≤ p / 2 := by linarith\n by_cases hq0 : (q : ℝ) = 0\n · rw [bernoulli_difference_moment_eq p q hp]\n simp [hq0, ENNReal.zero_rpow_of_pos (show 0 < p / 2 by linarith)]\n by_cases hq1 : (q : ℝ) = 1\n · rw [bernoulli_difference_moment_eq p q hp]\n simp [hq1, ENNReal.zero_rpow_of_pos (show 0 < p / 2 by linarith)]\n have ha : ENNReal.ofReal (2 * (q : ℝ) * (1 - (q : ℝ))) ≤ 1 := by\n apply ENNReal.ofReal_le_one.mpr\n nlinarith [sq_nonneg ((q : ℝ) - 1 / 2)]\n have ha_pow : ENNReal.ofReal (2 * (q : ℝ) * (1 - (q : ℝ))) ≤\n (ENNReal.ofReal (2 * (q : ℝ) * (1 - (q : ℝ)))) ^ (p / 2) := by\n simpa only [ENNReal.rpow_one] using\n (ENNReal.rpow_le_rpow_of_exponent_ge ha (show p / 2 ≤ 1 by linarith) :\n (ENNReal.ofReal (2 * (q : ℝ) * (1 - (q : ℝ)))) ^ (1 : ℝ) ≤ _)\n have hvariance : ENNReal.ofReal (8 * (q : ℝ) * (1 - (q : ℝ))) =\n 4 * ENNReal.ofReal (2 * (q : ℝ) * (1 - (q : ℝ))) := by\n rw [show 8 * (q : ℝ) * (1 - (q : ℝ)) =\n 4 * (2 * (q : ℝ) * (1 - (q : ℝ))) by ring,\n ENNReal.ofReal_mul (by norm_num : (0 : ℝ) ≤ 4)]\n norm_num\n have hfour : (4 : ℝ≥0∞) ^ (p / 2) = (2 : ℝ≥0∞) ^ p := by\n calc\n (4 : ℝ≥0∞) ^ (p / 2) = ((2 : ℝ≥0∞) ^ (2 : ℝ)) ^ (p / 2) := by\n norm_num [ENNReal.rpow_natCast]\n _ = (2 : ℝ≥0∞) ^ (2 * (p / 2)) := (ENNReal.rpow_mul _ _ _).symm\n _ = (2 : ℝ≥0∞) ^ p := by congr 1; ring\n rw [bernoulli_difference_moment_eq p q hp, hvariance,\n ENNReal.mul_rpow_of_nonneg _ _ hp_half, hfour]\n gcongr\ntheorem probability_integral_enorm_rpow_le :\n ∀ (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (Ω : Type*) [MeasurableSpace Ω] (μ : MeasureTheory.Measure Ω)\n [MeasureTheory.IsProbabilityMeasure μ] (p : ℝ) (f : Ω → X),\n 1 ≤ p → MeasureTheory.AEStronglyMeasurable f μ →\n ‖∫ ω, f ω ∂μ‖ₑ ^ p ≤ ∫⁻ ω, ‖f ω‖ₑ ^ p ∂μ := by\n intro X _ _ _ Ω _ μ _ p f hp hf\n have hp_pos : 0 < p := lt_of_lt_of_le (by norm_num) hp\n have hL1 : (∫⁻ ω, ‖f ω‖ₑ ∂μ) = eLpNorm' f 1 μ := by\n simp [eLpNorm'_eq_lintegral_enorm]\n have hLp : ‖∫ ω, f ω ∂μ‖ₑ ≤ eLpNorm' f p μ := by\n calc\n ‖∫ ω, f ω ∂μ‖ₑ ≤ ∫⁻ ω, ‖f ω‖ₑ ∂μ :=\n enorm_integral_le_lintegral_enorm f\n _ = eLpNorm' f 1 μ := hL1\n _ ≤ eLpNorm' f p μ :=\n eLpNorm'_le_eLpNorm'_of_exponent_le (by norm_num) hp μ hf\n rw [lintegral_rpow_enorm_eq_rpow_eLpNorm' hp_pos]\n exact ENNReal.rpow_le_rpow hLp hp_pos.le\ntheorem cube_flip_involutive (n : ℕ) (j : Fin n) :\n Function.Involutive (fun δ : Fin n → ({-1, 1} : Set ℤ) ↦\n Function.update δ j (-δ j)) := by\n intro δ\n funext k\n by_cases hk : k = j\n · subst k\n simp only [Function.update_self]\n apply Subtype.ext\n change -(-(δ j : ℤ)) = (δ j : ℤ)\n exact neg_neg _\n · simp [Function.update_of_ne hk]\ntheorem sign_noise_scalar_identity (t : ℝ) (a : ({-1, 1} : Set ℤ)) :\n (1 + t * ((a : ℤ) : ℝ)) * (((a : ℤ) : ℝ) - t) =\n (1 - t ^ 2) * ((a : ℤ) : ℝ) := by\n rcases a with ⟨a, ha⟩\n have h : a = -1 ∨ a = 1 := by\n simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using ha\n rcases h with h | h <;> subst a <;> norm_num <;> ring\ntheorem cube_erased_weight_flip (n : ℕ) (j : Fin n) (t : ℝ)\n (δ : Fin n → ({-1, 1} : Set ℤ)) :\n ((((Function.update δ j (-δ j)) j) : ℤ) : ℝ) *\n (∏ k ∈ Finset.univ.erase j,\n (1 + t * ((((Function.update δ j (-δ j)) k) : ℤ) : ℝ))) =\n -(((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) := by\n have hprod : (∏ k ∈ Finset.univ.erase j,\n (1 + t * ((((Function.update δ j (-δ j)) k) : ℤ) : ℝ))) =\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ)) := by\n apply Finset.prod_congr rfl\n intro k hk\n rw [Function.update_of_ne (Finset.mem_erase.mp hk).1]\n rw [hprod, Function.update_self]\n change (Int.cast (-(δ j : ℤ)) : ℝ) * _ = _\n simp only [Int.cast_neg, neg_mul]\ntheorem cube_noise_weight_coefficient (n : ℕ) (j : Fin n) (t : ℝ)\n (δ : Fin n → ({-1, 1} : Set ℤ)) :\n (∏ k : Fin n, (1 + t * ((δ k : ℤ) : ℝ))) * (((δ j : ℤ) : ℝ) - t) =\n (1 - t ^ 2) * (((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) := by\n rw [← Finset.mul_prod_erase Finset.univ\n (fun k : Fin n ↦ 1 + t * ((δ k : ℤ) : ℝ)) (Finset.mem_univ j)]\n calc\n ((1 + t * ((δ j : ℤ) : ℝ)) *\n (∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ)))) *\n (((δ j : ℤ) : ℝ) - t) =\n ((1 + t * ((δ j : ℤ) : ℝ)) * (((δ j : ℤ) : ℝ) - t)) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ)) := by ring\n _ = _ := by rw [sign_noise_scalar_identity]; ring\ntheorem cube_flip_weighted_difference\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (j : Fin n) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (w : (Fin n → ({-1, 1} : Set ℤ)) → ℝ)\n (hw : ∀ δ, w (Function.update δ j (-δ j)) = -w δ) :\n (∑ δ : Fin n → ({-1, 1} : Set ℤ), w δ • D j f δ) =\n ∑ δ : Fin n → ({-1, 1} : Set ℤ), w δ • f δ := by\n have hflip : (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n w δ • f (Function.update δ j (-δ j))) =\n -(∑ δ : Fin n → ({-1, 1} : Set ℤ), w δ • f δ) := by\n calc\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n w δ • f (Function.update δ j (-δ j))) =\n ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n w (Function.update δ j (-δ j)) • f δ := by\n refine Fintype.sum_bijective (fun δ ↦ Function.update δ j (-δ j))\n (cube_flip_involutive n j).bijective _ _ ?_\n intro δ\n have hδ : Function.update (Function.update δ j (-δ j)) j\n (-(Function.update δ j (-δ j)) j) = δ := cube_flip_involutive n j δ\n rw [hδ]\n _ = _ := by simp only [hw, neg_smul, Finset.sum_neg_distrib]\n calc\n (∑ δ : Fin n → ({-1, 1} : Set ℤ), w δ • D j f δ) =\n (1 / (2 : ℝ)) • ((∑ δ : Fin n → ({-1, 1} : Set ℤ), w δ • f δ) -\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n w δ • f (Function.update δ j (-δ j)))) := by\n simp only [D, smul_sub, smul_smul, Finset.smul_sum, Finset.sum_sub_distrib,\n mul_comm]\n _ = _ := by\n rw [hflip, sub_neg_eq_add, ← two_smul ℝ, smul_smul]\n norm_num\ntheorem weighted_cube_derivative_identity :\n ∀ (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X) (t : ℝ),\n (1 - t ^ 2) • (∑ δ : (Fin n → ({-1, 1} : Set ℤ)),\n (∑ j : Fin n, ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) • f δ) =\n ∑ δ : (Fin n → ({-1, 1} : Set ℤ)),\n (∏ k : Fin n, (1 + t * ((δ k : ℤ) : ℝ))) •\n (∑ j : Fin n, (((δ j : ℤ) : ℝ) - t) • RademacherEnfloType.D j f δ) := by\n intro X _ _ _ n f t\n symm\n calc\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∏ k : Fin n, (1 + t * ((δ k : ℤ) : ℝ))) •\n (∑ j : Fin n, (((δ j : ℤ) : ℝ) - t) • D j f δ)) =\n ∑ j : Fin n, ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n ((∏ k : Fin n, (1 + t * ((δ k : ℤ) : ℝ))) *\n (((δ j : ℤ) : ℝ) - t)) • D j f δ := by\n simp only [Finset.smul_sum, smul_smul]\n rw [Finset.sum_comm]\n _ = (1 - t ^ 2) •\n (∑ j : Fin n, ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) • D j f δ) := by\n simp only [cube_noise_weight_coefficient, Finset.smul_sum, smul_smul]\n _ = (1 - t ^ 2) •\n (∑ j : Fin n, ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) • f δ) := by\n congr 1\n apply Finset.sum_congr rfl\n intro j hj\n exact cube_flip_weighted_difference X n j f\n (fun δ ↦ ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ)))\n (fun δ ↦ cube_erased_weight_flip n j t δ)\n _ = _ := by\n rw [Finset.sum_comm]\n simp only [Finset.sum_smul]\nnoncomputable def centeredBernoulliMeasure (q : Set.Icc (0 : ℝ) 1) :\n Measure ({-1, 1} : Set ℤ) :=\n bernoulliMeasure ⟨1, by decide⟩ ⟨-1, by decide⟩ q\ninstance centeredBernoulliMeasure_probability (q : Set.Icc (0 : ℝ) 1) :\n IsProbabilityMeasure (centeredBernoulliMeasure q) := by\n unfold centeredBernoulliMeasure\n infer_instance\nnoncomputable def centeredBernoulliCube (n : ℕ) (q : Set.Icc (0 : ℝ) 1) :\n Measure (Fin n → ({-1, 1} : Set ℤ)) :=\n Measure.pi (fun _ : Fin n ↦ centeredBernoulliMeasure q)\ninstance centeredBernoulliCube_probability (n : ℕ) (q : Set.Icc (0 : ℝ) 1) :\n IsProbabilityMeasure (centeredBernoulliCube n q) := by\n unfold centeredBernoulliCube\n infer_instance\ndef cubeTranslate (n : ℕ) (δ ε : Fin n → ({-1, 1} : Set ℤ)) :\n Fin n → ({-1, 1} : Set ℤ) :=\n fun k ↦ if (δ k : ℤ) = 1 then ε k else -ε k\ntheorem rademacher_sign_neg_preserving :\n MeasurePreserving (fun a : ({-1, 1} : Set ℤ) ↦ -a)\n rademacherDistribution rademacherDistribution := by\n constructor\n · exact measurable_of_countable _\n · unfold rademacherDistribution\n rw [map_bernoulliMeasure]\n simp only [bernoulliMeasure_def]\n have hp : (-(⟨1, by decide⟩ : ({-1, 1} : Set ℤ))) = ⟨-1, by decide⟩ := by rfl\n have hm : (-(⟨-1, by decide⟩ : ({-1, 1} : Set ℤ))) = ⟨1, by decide⟩ := by\n apply Subtype.ext\n change -(-1 : ℤ) = 1\n norm_num\n rw [hp, hm]\n have hq : unitInterval.symm (⟨1 / 2, by norm_num⟩ : Set.Icc (0 : ℝ) 1) =\n ⟨1 / 2, by norm_num⟩ := by\n apply Subtype.ext\n norm_num [unitInterval.coe_symm_eq]\n rw [hq, add_comm]\ntheorem cubeTranslate_preserving (n : ℕ) (δ : Fin n → ({-1, 1} : Set ℤ)) :\n MeasurePreserving (cubeTranslate n δ)\n (rademacherProductDistribution (Fin n)) (rademacherProductDistribution (Fin n)) := by\n haveI : IsProbabilityMeasure rademacherDistribution := by\n unfold rademacherDistribution\n infer_instance\n unfold rademacherProductDistribution\n rw [Measure.infinitePi_eq_pi]\n unfold cubeTranslate\n refine measurePreserving_pi (fun _ : Fin n ↦ rademacherDistribution)\n (fun _ : Fin n ↦ rademacherDistribution)\n (f := fun j a ↦ if (δ j : ℤ) = 1 then a else -a) ?_\n intro j\n by_cases hj : (δ j : ℤ) = 1\n · simp only [hj, if_true]\n exact ⟨measurable_id, by simp⟩\n · simpa only [hj, if_false] using rademacher_sign_neg_preserving\ntheorem cubeTranslate_lintegral (n : ℕ) (δ : Fin n → ({-1, 1} : Set ℤ))\n (g : (Fin n → ({-1, 1} : Set ℤ)) → ℝ≥0∞) :\n (∫⁻ ε, g (cubeTranslate n δ ε) ∂rademacherProductDistribution (Fin n)) =\n ∫⁻ ε, g ε ∂rademacherProductDistribution (Fin n) := by\n exact (cubeTranslate_preserving n δ).lintegral_comp (measurable_of_countable _)\ntheorem centeredBernoulli_sign_mean (q : Set.Icc (0 : ℝ) 1) :\n (∫ a : ({-1, 1} : Set ℤ), ((a : ℤ) : ℝ) ∂centeredBernoulliMeasure q) =\n 2 * (q : ℝ) - 1 := by\n unfold centeredBernoulliMeasure\n rw [integral_bernoulliMeasure]\n norm_num\n ring\ntheorem centeredBernoulli_coordinate_mean (n : ℕ) (q : Set.Icc (0 : ℝ) 1)\n (j : Fin n) :\n (∫ δ : Fin n → ({-1, 1} : Set ℤ), ((δ j : ℤ) : ℝ)\n ∂centeredBernoulliCube n q) = 2 * (q : ℝ) - 1 := by\n unfold centeredBernoulliCube\n rw [integral_comp_eval (μ := fun _ : Fin n ↦ centeredBernoulliMeasure q)\n (i := j) (f := fun a : ({-1, 1} : Set ℤ) ↦ ((a : ℤ) : ℝ))\n StronglyMeasurable.of_discrete.aestronglyMeasurable]\n exact centeredBernoulli_sign_mean q\nnoncomputable def centeredBernoulliPairs (n : ℕ) (q : Set.Icc (0 : ℝ) 1) :\n Measure (Fin n → (({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ))) :=\n Measure.pi (fun _ : Fin n ↦ (centeredBernoulliMeasure q).prod (centeredBernoulliMeasure q))\ninstance centeredBernoulliPairs_probability (n : ℕ) (q : Set.Icc (0 : ℝ) 1) :\n IsProbabilityMeasure (centeredBernoulliPairs n q) := by\n unfold centeredBernoulliPairs\n infer_instance\ndef bernoulliPairSwap (n : ℕ) (σ : Fin n → ({-1, 1} : Set ℤ))\n (ξ : Fin n → (({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ))) :\n Fin n → (({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ)) :=\n fun j ↦ if (σ j : ℤ) = 1 then ξ j else (ξ j).swap\ntheorem bernoulliPairSwap_preserving (n : ℕ) (q : Set.Icc (0 : ℝ) 1)\n (σ : Fin n → ({-1, 1} : Set ℤ)) :\n MeasurePreserving (bernoulliPairSwap n σ)\n (centeredBernoulliPairs n q) (centeredBernoulliPairs n q) := by\n unfold centeredBernoulliPairs bernoulliPairSwap\n refine measurePreserving_pi\n (fun _ : Fin n ↦ (centeredBernoulliMeasure q).prod (centeredBernoulliMeasure q))\n (fun _ : Fin n ↦ (centeredBernoulliMeasure q).prod (centeredBernoulliMeasure q))\n (f := fun j (a : ({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ)) ↦\n if (σ j : ℤ) = 1 then a else a.swap) ?_\n intro j\n by_cases hj : (σ j : ℤ) = 1\n · simp only [hj, if_true]\n exact ⟨measurable_id, by simp⟩\n · simpa only [hj, if_false] using\n (Measure.measurePreserving_swap (μ := centeredBernoulliMeasure q)\n (ν := centeredBernoulliMeasure q))\ntheorem bernoulliPairSwap_difference (n : ℕ)\n (σ : Fin n → ({-1, 1} : Set ℤ))\n (ξ : Fin n → (({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ))) (j : Fin n) :\n (((bernoulliPairSwap n σ ξ j).1 : ℤ) : ℝ) -\n (((bernoulliPairSwap n σ ξ j).2 : ℤ) : ℝ) =\n ((σ j : ℤ) : ℝ) * ((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) := by\n have h : (σ j : ℤ) = -1 ∨ (σ j : ℤ) = 1 := by\n simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using (σ j).property\n rcases h with h | h <;> simp [bernoulliPairSwap, h]\ntheorem centeredBernoulliPairs_sign_integral\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (q : Set.Icc (0 : ℝ) 1) (p : ℝ) (x : Fin n → X)\n (σ : Fin n → ({-1, 1} : Set ℤ)) :\n (∫⁻ ξ, ‖∑ j : Fin n, ((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j‖ₑ ^ p\n ∂centeredBernoulliPairs n q) =\n (∫⁻ ξ, ‖∑ j : Fin n, ((σ j : ℤ) : ℝ) •\n (((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j)‖ₑ ^ p\n ∂centeredBernoulliPairs n q) := by\n have h := (bernoulliPairSwap_preserving n q σ).lintegral_comp\n (measurable_of_countable (fun ξ ↦\n ‖∑ j : Fin n, ((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j‖ₑ ^ p))\n symm\n convert h using 1\n apply lintegral_congr\n intro ξ\n simp only [bernoulliPairSwap_difference, smul_smul]\ntheorem centeredBernoulli_copy_integral\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (q : Set.Icc (0 : ℝ) 1) (δ : Fin n → ({-1, 1} : Set ℤ))\n (x : Fin n → X) :\n (∫ δ' : Fin n → ({-1, 1} : Set ℤ),\n ∑ j : Fin n, (((δ j : ℤ) : ℝ) - ((δ' j : ℤ) : ℝ)) • x j\n ∂centeredBernoulliCube n q) =\n ∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) • x j := by\n rw [integral_finsetSum Finset.univ (fun j hj ↦ Integrable.of_finite)]\n apply Finset.sum_congr rfl\n intro j hj\n rw [integral_smul_const, integral_sub Integrable.of_finite Integrable.of_finite,\n integral_const, probReal_univ, one_smul, centeredBernoulli_coordinate_mean]\ntheorem centeredBernoulli_copy_jensen\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (q : Set.Icc (0 : ℝ) 1) (p : ℝ) (hp : 1 ≤ p) (x : Fin n → X) :\n (∫⁻ δ, ‖∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) • x j‖ₑ ^ p\n ∂centeredBernoulliCube n q) ≤\n (∫⁻ ξ, ‖∑ j : Fin n,\n ((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j‖ₑ ^ p\n ∂centeredBernoulliPairs n q) := by\n calc\n _ ≤ ∫⁻ δ, ∫⁻ δ', ‖∑ j : Fin n,\n (((δ j : ℤ) : ℝ) - ((δ' j : ℤ) : ℝ)) • x j‖ₑ ^ p\n ∂centeredBernoulliCube n q ∂centeredBernoulliCube n q := by\n apply lintegral_mono\n intro δ\n have h := probability_integral_enorm_rpow_le X\n (Fin n → ({-1, 1} : Set ℤ)) (centeredBernoulliCube n q) p\n (fun δ' ↦ ∑ j : Fin n, (((δ j : ℤ) : ℝ) - ((δ' j : ℤ) : ℝ)) • x j)\n hp StronglyMeasurable.of_discrete.aestronglyMeasurable\n rwa [centeredBernoulli_copy_integral] at h\n _ = ∫⁻ z, ‖∑ j : Fin n,\n (((z.1 j : ℤ) : ℝ) - ((z.2 j : ℤ) : ℝ)) • x j‖ₑ ^ p\n ∂(centeredBernoulliCube n q).prod (centeredBernoulliCube n q) :=\n lintegral_lintegral (measurable_of_countable _).aemeasurable\n _ = _ := by\n unfold centeredBernoulliCube centeredBernoulliPairs\n exact (measurePreserving_arrowProdEquivProdArrow\n ({-1, 1} : Set ℤ) ({-1, 1} : Set ℤ) (Fin n)\n (fun _ ↦ centeredBernoulliMeasure q) (fun _ ↦ centeredBernoulliMeasure q)\n |>.lintegral_comp (measurable_of_countable _)).symm\ntheorem centeredBernoulliPairs_symmetrization\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (q : Set.Icc (0 : ℝ) 1) (p : ℝ) (x : Fin n → X) :\n (∫⁻ ξ, ‖∑ j : Fin n,\n ((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j‖ₑ ^ p\n ∂centeredBernoulliPairs n q) =\n (∫⁻ ξ, ∫⁻ σ, ‖∑ j : Fin n, ((σ j : ℤ) : ℝ) •\n (((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j)‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n) ∂centeredBernoulliPairs n q) := by\n haveI := rademacher_product_probability n\n calc\n _ = ∫⁻ σ : Fin n → ({-1, 1} : Set ℤ),\n (∫⁻ ξ, ‖∑ j : Fin n,\n ((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j‖ₑ ^ p\n ∂centeredBernoulliPairs n q)\n ∂rademacherProductDistribution (Fin n) := by\n rw [lintegral_const, measure_univ, mul_one]\n _ = ∫⁻ σ, ∫⁻ ξ, ‖∑ j : Fin n, ((σ j : ℤ) : ℝ) •\n (((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j)‖ₑ ^ p\n ∂centeredBernoulliPairs n q ∂rademacherProductDistribution (Fin n) := by\n apply lintegral_congr\n intro σ\n exact centeredBernoulliPairs_sign_integral X n q p x σ\n _ = _ := lintegral_lintegral_swap (measurable_of_countable _).aemeasurable\ntheorem centeredBernoulliPairs_scaled_moment_le\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (q : Set.Icc (0 : ℝ) 1) (p : ℝ) (hp : 1 ≤ p) (hp2 : p ≤ 2)\n (j : Fin n) (v : X) :\n (∫⁻ ξ, ‖(((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • v)‖ₑ ^ p\n ∂centeredBernoulliPairs n q) ≤\n (ENNReal.ofReal (8 * (q : ℝ) * (1 - (q : ℝ)))) ^ (p / 2) * ‖v‖ₑ ^ p := by\n calc\n _ = (∫⁻ ξ, ‖((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ))‖ₑ ^ p\n ∂centeredBernoulliPairs n q) * ‖v‖ₑ ^ p := by\n simp only [enorm_smul, ENNReal.mul_rpow_of_nonneg _ _ (show 0 ≤ p by linarith)]\n exact lintegral_mul_const _ (measurable_of_countable _)\n _ = (∫⁻ a : ({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ),\n ‖((a.1 : ℤ) : ℝ) - ((a.2 : ℤ) : ℝ)‖ₑ ^ p\n ∂(centeredBernoulliMeasure q).prod (centeredBernoulliMeasure q)) * ‖v‖ₑ ^ p := by\n congr 1\n unfold centeredBernoulliPairs\n exact (measurePreserving_eval\n (fun _ : Fin n ↦ (centeredBernoulliMeasure q).prod (centeredBernoulliMeasure q)) j\n |>.lintegral_comp (measurable_of_countable\n (fun a : ({-1, 1} : Set ℤ) × ({-1, 1} : Set ℤ) ↦\n ‖((a.1 : ℤ) : ℝ) - ((a.2 : ℤ) : ℝ)‖ₑ ^ p)))\n _ ≤ _ := mul_le_mul' (bernoulli_difference_moment_le p q hp hp2) le_rfl\ntheorem centeredBernoulli_cube_bound\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (p : ℝ) (C : ℝ≥0∞) (q : Set.Icc (0 : ℝ) 1) (x : Fin n → X)\n (hn : 1 ≤ n) (hp : 1 ≤ p) (hp2 : p ≤ 2)\n (hC : IsRademacherType X C p) :\n (∫⁻ δ, ‖∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) • x j‖ₑ ^ p\n ∂centeredBernoulliCube n q) ≤\n (ENNReal.ofReal (8 * (q : ℝ) * (1 - (q : ℝ)))) ^ (p / 2) *\n C ^ p * ∑ j : Fin n, ‖x j‖ₑ ^ p := by\n calc\n _ ≤ ∫⁻ ξ, ‖∑ j : Fin n,\n ((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j‖ₑ ^ p\n ∂centeredBernoulliPairs n q := centeredBernoulli_copy_jensen X n q p hp x\n _ = ∫⁻ ξ, ∫⁻ σ, ‖∑ j : Fin n, ((σ j : ℤ) : ℝ) •\n (((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j)‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n) ∂centeredBernoulliPairs n q :=\n centeredBernoulliPairs_symmetrization X n q p x\n _ ≤ ∫⁻ ξ, C ^ p * ∑ j : Fin n,\n ‖(((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j)‖ₑ ^ p\n ∂centeredBernoulliPairs n q := by\n apply lintegral_mono\n intro ξ\n exact hC n hn _\n _ = C ^ p * ∑ j : Fin n, ∫⁻ ξ,\n ‖(((((ξ j).1 : ℤ) : ℝ) - (((ξ j).2 : ℤ) : ℝ)) • x j)‖ₑ ^ p\n ∂centeredBernoulliPairs n q := by\n rw [lintegral_const_mul _ (measurable_of_countable _),\n lintegral_finsetSum Finset.univ (fun j hj ↦ measurable_of_countable _)]\n _ ≤ C ^ p * ∑ j : Fin n,\n (ENNReal.ofReal (8 * (q : ℝ) * (1 - (q : ℝ)))) ^ (p / 2) * ‖x j‖ₑ ^ p := by\n refine mul_le_mul' le_rfl ?_\n apply Finset.sum_le_sum\n intro j hj\n exact centeredBernoulliPairs_scaled_moment_le X n q p hp hp2 j (x j)\n _ = _ := by rw [← Finset.mul_sum]; ac_rfl\ntheorem centered_bernoulli_cube_joint_bound :\n ∀ (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (p : ℝ) (C : ℝ≥0∞) (q : Set.Icc (0 : ℝ) 1)\n (x : (Fin n → ({-1, 1} : Set ℤ)) → Fin n → X),\n 1 ≤ n → 1 ≤ p → p ≤ 2 →\n RademacherEnfloType.IsRademacherType X C p →\n (∫⁻ ε : Fin n → ({-1, 1} : Set ℤ),\n (∫⁻ δ : Fin n → ({-1, 1} : Set ℤ),\n ‖∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) •\n x (fun k ↦ if (δ k : ℤ) = 1 then ε k else -ε k) j‖ₑ ^ p\n ∂MeasureTheory.Measure.infinitePi (fun _ : Fin n ↦\n ProbabilityTheory.bernoulliMeasure\n (⟨1, by decide⟩ : ({-1, 1} : Set ℤ)) ⟨-1, by decide⟩ q))\n ∂RademacherEnfloType.rademacherProductDistribution (Fin n)) ≤\n (ENNReal.ofReal (8 * (q : ℝ) * (1 - (q : ℝ)))) ^ (p / 2) *\n C ^ p * ∑ j : Fin n,\n (∫⁻ ε : Fin n → ({-1, 1} : Set ℤ), ‖x ε j‖ₑ ^ p\n ∂RademacherEnfloType.rademacherProductDistribution (Fin n)) := by\n intro X _ _ _ n p C q x hn hp hp2 hC\n haveI := rademacher_product_probability n\n rw [Measure.infinitePi_eq_pi]\n change (∫⁻ ε, ∫⁻ δ,\n ‖∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) •\n x (cubeTranslate n δ ε) j‖ₑ ^ p\n ∂centeredBernoulliCube n q ∂rademacherProductDistribution (Fin n)) ≤ _\n calc\n _ = ∫⁻ δ, ∫⁻ ε,\n ‖∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) •\n x (cubeTranslate n δ ε) j‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n) ∂centeredBernoulliCube n q :=\n lintegral_lintegral_swap (measurable_of_countable _).aemeasurable\n _ = ∫⁻ δ, ∫⁻ ε,\n ‖∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) • x ε j‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n) ∂centeredBernoulliCube n q := by\n apply lintegral_congr\n intro δ\n exact cubeTranslate_lintegral n δ\n (fun ε ↦ ‖∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) • x ε j‖ₑ ^ p)\n _ = ∫⁻ ε, ∫⁻ δ,\n ‖∑ j : Fin n, (((δ j : ℤ) : ℝ) - (2 * (q : ℝ) - 1)) • x ε j‖ₑ ^ p\n ∂centeredBernoulliCube n q ∂rademacherProductDistribution (Fin n) :=\n lintegral_lintegral_swap (measurable_of_countable _).aemeasurable\n _ ≤ ∫⁻ ε, (ENNReal.ofReal (8 * (q : ℝ) * (1 - (q : ℝ)))) ^ (p / 2) *\n C ^ p * ∑ j : Fin n, ‖x ε j‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n) := by\n apply lintegral_mono\n intro ε\n exact centeredBernoulli_cube_bound X n p C q (x ε) hn hp hp2 hC\n _ = _ := by\n rw [lintegral_const_mul _ (measurable_of_countable _),\n lintegral_finsetSum Finset.univ (fun j hj ↦ measurable_of_countable _)]\ntheorem Helpers.arcsine_kernel_mass :\n IntervalIntegrable (fun t : ℝ ↦ (Real.sqrt (1 - t ^ 2))⁻¹)\n MeasureTheory.volume (-1 : ℝ) (1 : ℝ) ∧\n (∫ t in (-1 : ℝ)..(1 : ℝ), (Real.sqrt (1 - t ^ 2))⁻¹) = Real.pi := by\n have hint : IntervalIntegrable (fun t : ℝ ↦ (Real.sqrt (1 - t ^ 2))⁻¹)\n MeasureTheory.volume (-1 : ℝ) (1 : ℝ) := by\n simpa only [Real.sqrt_inv] using\n Polynomial.Chebyshev.intervalIntegrable_sqrt_one_sub_sq_inv\n refine ⟨hint, ?_⟩\n have hFTC := intervalIntegral.integral_eq_sub_of_hasDerivAt_of_le\n (f := Real.arcsin) (f' := fun t : ℝ ↦ (Real.sqrt (1 - t ^ 2))⁻¹)\n (show (-1 : ℝ) ≤ 1 by norm_num) Real.continuous_arcsin.continuousOn\n (by\n intro t ht\n simpa only [one_div] using\n Real.hasDerivAt_arcsin (ne_of_gt ht.1) (ne_of_lt ht.2)) hint\n calc\n (∫ t in (-1 : ℝ)..(1 : ℝ), (Real.sqrt (1 - t ^ 2))⁻¹) =\n Real.arcsin 1 - Real.arcsin (-1) := hFTC\n _ = Real.pi := by rw [Real.arcsin_one, Real.arcsin_neg_one]; ring\ntheorem noise_product_deriv (n : ℕ) (a : Fin n → ℝ) (t : ℝ) :\n HasDerivAt (fun s : ℝ => ∏ k : Fin n, (1 + s * a k))\n (∑ j : Fin n, a j * ∏ k ∈ Finset.univ.erase j, (1 + t * a k)) t := by\n have h := HasDerivAt.finsetProd (u := (Finset.univ : Finset (Fin n)))\n (f := fun i : Fin n => fun s : ℝ => 1 + s * a i) (f' := a) (x := t) (by\n intro i hi\n simpa [add_comm, mul_comm] using\n HasDerivAt.add_const 1 ((hasDerivAt_id' t).mul_const (a i)))\n have hder : HasDerivAt (∏ i : Fin n, fun s : ℝ => 1 + s * a i)\n (∑ j : Fin n, a j * ∏ k ∈ Finset.univ.erase j, (1 + t * a k)) t :=\n h.congr_deriv (by simp [smul_eq_mul, mul_comm])\n exact hder.congr_of_eventuallyEq (by\n filter_upwards [] with s\n simp only [Finset.prod_apply])\ntheorem noise_polynomial_antipodal_integral\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (ε : Fin n → ({-1, 1} : Set ℤ)) :\n (1 / (2 : ℝ)) • (f ε - f (-ε)) =\n ∫ t in (-1 : ℝ)..(1 : ℝ),\n (1 / (2 * (2 : ℝ) ^ n)) •\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∑ j : Fin n, ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) •\n f (fun k ↦ if (δ k : ℤ) = 1 then ε k else -ε k)) := by\n classical\n let g : (Fin n → ({-1, 1} : Set ℤ)) → X :=\n fun δ => f (fun k ↦ if (δ k : ℤ) = 1 then ε k else -ε k)\n let c : ℝ := 1 / (2 * (2 : ℝ) ^ n)\n let P : ℝ → X := fun t =>\n c • ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∏ k : Fin n, (1 + t * ((δ k : ℤ) : ℝ))) • g δ\n have hPderiv : ∀ t : ℝ, HasDerivAt P\n (c • ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∑ j : Fin n, ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) • g δ) t := by\n intro t\n have hsum : HasDerivAt\n (fun s : ℝ => ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∏ k : Fin n, (1 + s * ((δ k : ℤ) : ℝ))) • g δ)\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∑ j : Fin n, ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) • g δ) t := by\n apply HasDerivAt.fun_sum\n intro δ hδ\n have hp := noise_product_deriv n (fun k ↦ ((δ k : ℤ) : ℝ)) t\n have hs := hp.smul_const (g δ)\n simpa [smul_eq_mul, mul_comm] using hs\n have hc := hsum.const_smul c\n change HasDerivAt (fun s : ℝ => c •\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∏ k : Fin n, (1 + s * ((δ k : ℤ) : ℝ))) • g δ)) _ t\n convert hc using 1 <;> funext s <;> rfl\n have hPcont : ContinuousOn P (Set.Icc (-1 : ℝ) 1) := by\n fun_prop\n have hPint : IntervalIntegrable\n (fun t => c • ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∑ j : Fin n, ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) • g δ)\n MeasureTheory.volume (-1 : ℝ) 1 := by\n apply ContinuousOn.intervalIntegrable_of_Icc (by norm_num)\n fun_prop\n have hFTC := intervalIntegral.integral_eq_sub_of_hasDerivAt_of_le\n (a := (-1 : ℝ)) (b := (1 : ℝ)) (f := P)\n (f' := fun t => c • ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∑ j : Fin n, ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) • g δ)\n (by norm_num) hPcont (fun t ht => hPderiv t) hPint\n change (1 / (2 : ℝ)) • (f ε - f (-ε)) =\n ∫ t in (-1 : ℝ)..(1 : ℝ),\n c • (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∑ j : Fin n, ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) • g δ)\n let δp : Fin n → ({-1, 1} : Set ℤ) := fun _ => ⟨1, by simp⟩\n let δm : Fin n → ({-1, 1} : Set ℤ) := fun _ => ⟨-1, by simp⟩\n have hsum1 :\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∏ k : Fin n, (1 + (1 : ℝ) * ((δ k : ℤ) : ℝ))) • g δ) =\n (2 : ℝ) ^ n • f ε := by\n rw [Finset.sum_eq_single δp]\n · simp [δp, g]\n congr 1\n norm_num\n · intro δ hδ hne\n by_cases heq : δ = δp\n · exact (hne heq).elim\n · obtain ⟨k, hk⟩ : ∃ k : Fin n, δ k ≠ δp k := by\n by_contra hno\n apply heq\n funext k\n exact not_not.mp (fun h => hno ⟨k, h⟩)\n have hδk : (δ k : ℤ) = -1 := by\n have hv' : (δ k : ℤ) = -1 ∨ (δ k : ℤ) = 1 := by\n simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using (δ k).property\n rcases hv' with hv' | hv'\n · exact hv'\n · exfalso\n apply hk\n apply Subtype.ext\n simpa [δp] using hv'\n have hz : (∏ k : Fin n, (1 + (1 : ℝ) * ((δ k : ℤ) : ℝ))) = 0 := by\n apply Finset.prod_eq_zero (Finset.mem_univ k)\n simp [hδk]\n rw [hz]\n simp\n · simp\n have hsumm :\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∏ k : Fin n, (1 + (-1 : ℝ) * ((δ k : ℤ) : ℝ))) • g δ) =\n (2 : ℝ) ^ n • f (-ε) := by\n rw [Finset.sum_eq_single δm]\n · simp [δm, g]\n congr 1\n norm_num\n · intro δ hδ hne\n by_cases heq : δ = δm\n · exact (hne heq).elim\n · obtain ⟨k, hk⟩ : ∃ k : Fin n, δ k ≠ δm k := by\n by_contra hno\n apply heq\n funext k\n exact not_not.mp (fun h => hno ⟨k, h⟩)\n have hδk : (δ k : ℤ) = 1 := by\n have hv' : (δ k : ℤ) = -1 ∨ (δ k : ℤ) = 1 := by\n simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using (δ k).property\n rcases hv' with hv' | hv'\n · exfalso\n apply hk\n apply Subtype.ext\n simpa [δm] using hv'\n · exact hv'\n have hz : (∏ k : Fin n, (1 + (-1 : ℝ) * ((δ k : ℤ) : ℝ))) = 0 := by\n apply Finset.prod_eq_zero (Finset.mem_univ k)\n simp [hδk]\n rw [hz]\n simp\n · simp\n rw [hFTC]\n simp only [P, c]\n rw [hsum1, hsumm]\n rw [smul_sub, smul_smul, smul_smul]\n congr 1 <;> field_simp\ntheorem type_constants_of_reverse_conversion :\n ∀ (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (p : ℝ),\n 1 ≤ p → p ≤ 2 →\n (∀ C : ℝ≥0∞, RademacherEnfloType.IsRademacherType X C p →\n RademacherEnfloType.IsEnfloType X\n (((NNReal.pi : ℝ≥0∞) / (NNReal.sqrt (2 : ℝ≥0) : ℝ≥0∞)) * C) p) →\n RademacherEnfloType.TR X p ≤ RademacherEnfloType.TE X p ∧\n RademacherEnfloType.TE X p ≤\n ((NNReal.pi : ℝ≥0∞) / (NNReal.sqrt (2 : ℝ≥0) : ℝ≥0∞)) *\n RademacherEnfloType.TR X p := by\n intro X _ _ _ p h1p hp2 hconvert\n let k : ℝ≥0∞ :=\n (NNReal.pi : ℝ≥0∞) / (NNReal.sqrt (2 : ℝ≥0) : ℝ≥0∞)\n have hsqrt : 0 < NNReal.sqrt (2 : ℝ≥0) :=\n NNReal.sqrt_pos.mpr (by norm_num)\n have hkcoe : k = ((NNReal.pi / NNReal.sqrt (2 : ℝ≥0) : ℝ≥0) : ℝ≥0∞) :=\n (ENNReal.coe_div (ne_of_gt hsqrt)).symm\n have hk0 : k ≠ 0 := by\n rw [hkcoe, ENNReal.coe_ne_zero]\n exact ne_of_gt (div_pos NNReal.pi_pos hsqrt)\n have hktop : k ≠ ∞ := by\n rw [hkcoe]\n exact ENNReal.coe_ne_top\n constructor\n · unfold RademacherEnfloType.TR RademacherEnfloType.TE\n apply le_sInf\n intro C hC\n exact sInf_le (enflo_implies_rademacher X p C h1p hp2 hC)\n · change RademacherEnfloType.TE X p ≤ k * RademacherEnfloType.TR X p\n apply (ENNReal.div_le_iff' hk0 hktop).mp\n unfold RademacherEnfloType.TR\n apply le_sInf\n intro C hC\n apply (ENNReal.div_le_iff' hk0 hktop).mpr\n exact sInf_le (hconvert C hC)\nnoncomputable def enfloArcsineDensity (t : ℝ) : ℝ≥0∞ :=\n ENNReal.ofReal ((Real.pi * Real.sqrt (1 - t ^ 2))⁻¹)\nnoncomputable def enfloArcsineMeasure : MeasureTheory.Measure ℝ :=\n (MeasureTheory.volume.restrict (Set.Ioo (-1 : ℝ) 1)).withDensity enfloArcsineDensity\ntheorem enfloArcsineDensity_measurable : Measurable enfloArcsineDensity := by\n unfold enfloArcsineDensity\n fun_prop\ntheorem enfloArcsineDensity_toReal (t : ℝ) :\n (enfloArcsineDensity t).toReal = (Real.pi * Real.sqrt (1 - t ^ 2))⁻¹ := by\n rw [enfloArcsineDensity, ENNReal.toReal_ofReal]\n positivity\ntheorem enfloArcsineMeasure_probability :\n MeasureTheory.IsProbabilityMeasure enfloArcsineMeasure := by\n have hmass := Helpers.arcsine_kernel_mass\n have hi : Integrable (fun t : ℝ ↦ (Real.sqrt (1 - t ^ 2))⁻¹)\n (volume.restrict (Set.Ioo (-1 : ℝ) 1)) := by\n rw [restrict_Ioo_eq_restrict_Ioc]\n exact hmass.1.1\n have hi' : Integrable (fun t : ℝ ↦ (Real.pi * Real.sqrt (1 - t ^ 2))⁻¹)\n (volume.restrict (Set.Ioo (-1 : ℝ) 1)) := by\n simpa only [mul_inv_rev, mul_comm] using hi.const_mul Real.pi⁻¹\n constructor\n rw [enfloArcsineMeasure, withDensity_apply _ MeasurableSet.univ,\n Measure.restrict_univ]\n change (∫⁻ t in Set.Ioo (-1 : ℝ) 1,\n ENNReal.ofReal ((Real.pi * Real.sqrt (1 - t ^ 2))⁻¹)) = 1\n rw [← ofReal_integral_eq_lintegral_ofReal hi' (Filter.Eventually.of_forall (by\n intro t; positivity))]\n simp only [mul_inv_rev]\n rw [integral_mul_const, restrict_Ioo_eq_restrict_Ioc,\n ← intervalIntegral.integral_of_le (by norm_num : (-1 : ℝ) ≤ 1), hmass.2]\n rw [mul_inv_cancel₀ Real.pi_ne_zero]\n norm_num\ntheorem enfloArcsineMeasure_ae_mem :\n ∀ᵐ t ∂enfloArcsineMeasure, t ∈ Set.Ioo (-1 : ℝ) 1 := by\n exact (withDensity_absolutelyContinuous _ _).ae_le\n (ae_restrict_mem measurableSet_Ioo)\ntheorem enfloArcsineDensity_sqrt_cancel (t : ℝ) (ht : t ∈ Set.Ioo (-1 : ℝ) 1) :\n (enfloArcsineDensity t).toReal * Real.sqrt (2 * (1 - t ^ 2)) =\n Real.sqrt 2 / Real.pi := by\n have hs : 0 < 1 - t ^ 2 := by nlinarith [ht.1, ht.2]\n rw [enfloArcsineDensity_toReal, Real.sqrt_mul (by norm_num : (0 : ℝ) ≤ 2)]\n have hz := (Real.sqrt_pos.2 hs).ne'\n field_simp\ntheorem enfloArcsineMeasure_integral_recovery\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (g : ℝ → X) :\n (∫ t in (-1 : ℝ)..(1 : ℝ), g t) =\n (Real.pi / Real.sqrt 2) •\n (∫ t, Real.sqrt (2 * (1 - t ^ 2)) • g t ∂enfloArcsineMeasure) := by\n rw [enfloArcsineMeasure, integral_withDensity_eq_integral_toReal_smul\n enfloArcsineDensity_measurable (Filter.Eventually.of_forall (by\n intro t; exact ENNReal.ofReal_lt_top))]\n rw [integral_congr_ae (Filter.Eventually.mono\n (ae_restrict_mem measurableSet_Ioo) (by\n intro t ht\n rw [smul_smul, enfloArcsineDensity_sqrt_cancel t ht]))]\n rw [integral_smul, smul_smul]\n have hc : Real.pi / Real.sqrt 2 * (Real.sqrt 2 / Real.pi) = 1 := by\n have hz : Real.sqrt (2 : ℝ) ≠ 0 := (Real.sqrt_pos.2 (by norm_num)).ne'\n field_simp\n rw [hc, one_smul, restrict_Ioo_eq_restrict_Ioc,\n intervalIntegral.integral_of_le (by norm_num : (-1 : ℝ) ≤ 1)]\ntheorem centeredBernoulliMeasure_singleton_real\n (q : Set.Icc (0 : ℝ) 1) (a : ({-1, 1} : Set ℤ)) :\n (centeredBernoulliMeasure q).real {a} =\n (1 + (2 * (q : ℝ) - 1) * ((a : ℤ) : ℝ)) / 2 := by\n rcases a with ⟨a, ha⟩\n have h : a = -1 ∨ a = 1 := by\n simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using ha\n rcases h with h | h <;> subst a\n · simp [centeredBernoulliMeasure, bernoulliMeasure_def, Measure.real,\n unitInterval.coe_toNNReal, unitInterval.coe_symm_eq]\n ring\n · simp [centeredBernoulliMeasure, bernoulliMeasure_def, Measure.real,\n unitInterval.coe_toNNReal]\ntheorem centeredBernoulliCube_singleton_real\n (n : ℕ) (q : Set.Icc (0 : ℝ) 1) (δ : Fin n → ({-1, 1} : Set ℤ)) :\n (centeredBernoulliCube n q).real {δ} =\n (1 / (2 : ℝ) ^ n) *\n ∏ k : Fin n, (1 + (2 * (q : ℝ) - 1) * ((δ k : ℤ) : ℝ)) := by\n rw [Measure.real, centeredBernoulliCube, Measure.pi_singleton, ENNReal.toReal_prod]\n change (∏ k : Fin n, (centeredBernoulliMeasure q).real {δ k}) = _\n simp only [centeredBernoulliMeasure_singleton_real, div_eq_mul_inv,\n Finset.prod_mul_distrib, Finset.prod_const, Finset.card_univ, Fintype.card_fin, ← inv_pow]\n ring\ntheorem centeredBernoulliCube_integral_eq\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (q : Set.Icc (0 : ℝ) 1)\n (g : (Fin n → ({-1, 1} : Set ℤ)) → X) :\n (∫ δ, g δ ∂centeredBernoulliCube n q) =\n (1 / (2 : ℝ) ^ n) •\n ∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∏ k : Fin n, (1 + (2 * (q : ℝ) - 1) * ((δ k : ℤ) : ℝ))) • g δ := by\n rw [integral_fintype Integrable.of_finite]\n simp only [centeredBernoulliCube_singleton_real, Finset.smul_sum, smul_smul]\ntheorem cubeTranslate_update (n : ℕ) (δ ε : Fin n → ({-1, 1} : Set ℤ)) (j : Fin n) :\n cubeTranslate n (Function.update δ j (-δ j)) ε =\n Function.update (cubeTranslate n δ ε) j (-(cubeTranslate n δ ε j)) := by\n classical\n funext k\n by_cases hk : k = j\n · subst k\n simp only [Function.update_self, cubeTranslate]\n change (if -(δ j : ℤ) = 1 then ε j else -ε j) =\n -(if (δ j : ℤ) = 1 then ε j else -ε j)\n have hj : (δ j : ℤ) = -1 ∨ (δ j : ℤ) = 1 := by\n simpa only [Set.mem_insert_iff, Set.mem_singleton_iff] using (δ j).property\n rcases hj with hj | hj\n · simp only [hj]\n norm_num\n apply Subtype.ext\n change (ε j : ℤ) = -(-(ε j : ℤ))\n simp\n · simp only [hj]\n norm_num\n · simp only [cubeTranslate, Function.update_of_ne hk]\ntheorem cubeTranslate_derivative\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (δ ε : Fin n → ({-1, 1} : Set ℤ)) (j : Fin n) :\n D j (fun η ↦ f (cubeTranslate n η ε)) δ = D j f (cubeTranslate n δ ε) := by\n unfold D\n dsimp only\n rw [cubeTranslate_update]\nnoncomputable def enfloNoiseDerivative\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (ε : Fin n → ({-1, 1} : Set ℤ)) (t : ℝ) : X :=\n (1 / (2 * (2 : ℝ) ^ n)) •\n (∑ δ : Fin n → ({-1, 1} : Set ℤ),\n (∑ j : Fin n, ((δ j : ℤ) : ℝ) *\n ∏ k ∈ Finset.univ.erase j, (1 + t * ((δ k : ℤ) : ℝ))) •\n f (cubeTranslate n δ ε))\nnoncomputable def enfloNormalizedNoise\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (ε : Fin n → ({-1, 1} : Set ℤ)) (t : ℝ) : X :=\n Real.sqrt (2 * (1 - t ^ 2)) • enfloNoiseDerivative X n f ε t\ntheorem enfloNormalizedNoise_continuous\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (ε : Fin n → ({-1, 1} : Set ℤ)) :\n Continuous (enfloNormalizedNoise X n f ε) := by\n unfold enfloNormalizedNoise enfloNoiseDerivative\n fun_prop\ntheorem enflo_antipodal_kernel_expectation\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (ε : Fin n → ({-1, 1} : Set ℤ)) :\n (1 / (2 : ℝ)) • (f ε - f (-ε)) =\n (Real.pi / Real.sqrt 2) •\n (∫ t, enfloNormalizedNoise X n f ε t ∂enfloArcsineMeasure) := by\n rw [noise_polynomial_antipodal_integral X n f ε]\n exact enfloArcsineMeasure_integral_recovery X (enfloNoiseDerivative X n f ε)\ntheorem enfloNoiseDerivative_centered_integral\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (ε : Fin n → ({-1, 1} : Set ℤ)) (t : ℝ)\n (q : Set.Icc (0 : ℝ) 1) (hq : 2 * (q : ℝ) - 1 = t) :\n (1 - t ^ 2) • enfloNoiseDerivative X n f ε t =\n (1 / (2 : ℝ)) •\n (∫ δ, ∑ j : Fin n, (((δ j : ℤ) : ℝ) - t) •\n D j f (cubeTranslate n δ ε) ∂centeredBernoulliCube n q) := by\n have hw := weighted_cube_derivative_identity X n (fun δ ↦ f (cubeTranslate n δ ε)) t\n simp only [cubeTranslate_derivative] at hw\n rw [centeredBernoulliCube_integral_eq, hq]\n unfold enfloNoiseDerivative\n rw [smul_comm (1 - t ^ 2), hw, smul_smul]\n congr 1\n field_simp\ntheorem enfloNormalizedNoise_centered_expectation\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (f : (Fin n → ({-1, 1} : Set ℤ)) → X)\n (ε : Fin n → ({-1, 1} : Set ℤ)) (t : ℝ)\n (ht : t ∈ Set.Ioo (-1 : ℝ) 1)\n (q : Set.Icc (0 : ℝ) 1) (hq : 2 * (q : ℝ) - 1 = t) :\n enfloNormalizedNoise X n f ε t =\n (Real.sqrt (2 * (1 - t ^ 2)))⁻¹ •\n (∫ δ, ∑ j : Fin n, (((δ j : ℤ) : ℝ) - t) •\n D j f (cubeTranslate n δ ε) ∂centeredBernoulliCube n q) := by\n have hs : 0 < 1 - t ^ 2 := by nlinarith [ht.1, ht.2]\n have hs' : 0 < 2 * (1 - t ^ 2) := by positivity\n have heq : enfloNoiseDerivative X n f ε t =\n (1 - t ^ 2)⁻¹ • ((1 / (2 : ℝ)) •\n (∫ δ, ∑ j : Fin n, (((δ j : ℤ) : ℝ) - t) •\n D j f (cubeTranslate n δ ε) ∂centeredBernoulliCube n q)) := by\n rw [← enfloNoiseDerivative_centered_integral X n f ε t q hq,\n smul_smul, inv_mul_cancel₀ hs.ne', one_smul]\n unfold enfloNormalizedNoise\n rw [heq, smul_smul, smul_smul]\n congr 1\n have hz : Real.sqrt (2 * (1 - t ^ 2)) ≠ 0 := (Real.sqrt_pos.2 hs').ne'\n have hsq := Real.sq_sqrt hs'.le\n field_simp\n nlinarith\ntheorem enflo_sqrt_inv_moment_cancel (s p : ℝ) (hs : 0 < s) :\n (ENNReal.ofReal ((Real.sqrt s)⁻¹)) ^ p *\n (ENNReal.ofReal s) ^ (p / 2) = 1 := by\n have hz : Real.sqrt s ≠ 0 := (Real.sqrt_pos.2 hs).ne'\n have he : ENNReal.ofReal (Real.sqrt s) ≠ 0 :=\n (ENNReal.ofReal_pos.2 (Real.sqrt_pos.2 hs)).ne'\n have he' : ENNReal.ofReal (Real.sqrt s) ≠ ⊤ := ENNReal.ofReal_ne_top\n have hpow : (ENNReal.ofReal s) ^ (p / 2) =\n (ENNReal.ofReal (Real.sqrt s)) ^ p := by\n calc\n (ENNReal.ofReal s) ^ (p / 2) =\n ((ENNReal.ofReal (Real.sqrt s)) ^ (2 : ℝ)) ^ (p / 2) := by\n have hsq : (ENNReal.ofReal (Real.sqrt s)) ^ (2 : ℝ) = ENNReal.ofReal s := by\n calc\n _ = (ENNReal.ofReal (Real.sqrt s)) ^ (2 : ℕ) := by\n simpa using ENNReal.rpow_natCast (ENNReal.ofReal (Real.sqrt s)) 2\n _ = ENNReal.ofReal ((Real.sqrt s) ^ (2 : ℕ)) :=\n (ENNReal.ofReal_pow (Real.sqrt_nonneg s) 2).symm\n _ = ENNReal.ofReal s := by rw [Real.sq_sqrt hs.le]\n rw [hsq]\n _ = (ENNReal.ofReal (Real.sqrt s)) ^ (2 * (p / 2)) :=\n (ENNReal.rpow_mul _ _ _).symm\n _ = _ := by congr 1; ring\n rw [hpow, ENNReal.ofReal_inv_of_pos (Real.sqrt_pos.2 hs), ENNReal.inv_rpow]\n exact ENNReal.inv_mul_cancel (by simp [he, he'])\n (ENNReal.rpow_ne_top_of_ne_zero he he')\ntheorem enflo_finite_lintegral_swap\n (n : ℕ) (μ : MeasureTheory.Measure ℝ)\n (g : ℝ → (Fin n → ({-1, 1} : Set ℤ)) → ℝ≥0∞)\n (hg : ∀ ε, Measurable (fun t ↦ g t ε)) :\n (∫⁻ ε, (∫⁻ t, g t ε ∂μ) ∂rademacherProductDistribution (Fin n)) =\n ∫⁻ t, (∫⁻ ε, g t ε ∂rademacherProductDistribution (Fin n)) ∂μ := by\n simp only [lintegral_fintype]\n rw [lintegral_finsetSum]\n · apply Finset.sum_congr rfl\n intro ε hε\n exact (lintegral_mul_const _ (hg ε)).symm\n · intro ε hε\n exact (hg ε).mul_const _\ntheorem enfloNormalizedNoise_cube_moment_le\n (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (n : ℕ) (p : ℝ) (C : ℝ≥0∞)\n (f : (Fin n → ({-1, 1} : Set ℤ)) → X) (t : ℝ)\n (ht : t ∈ Set.Ioo (-1 : ℝ) 1) (hn : 1 ≤ n) (h1p : 1 ≤ p) (hp2 : p ≤ 2)\n (hC : RademacherEnfloType.IsRademacherType X C p) :\n (∫⁻ ε, ‖enfloNormalizedNoise X n f ε t‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n)) ≤\n C ^ p * ∑ j : Fin n,\n (∫⁻ ε, ‖D j f ε‖ₑ ^ p ∂rademacherProductDistribution (Fin n)) := by\n let q : Set.Icc (0 : ℝ) 1 := ⟨(1 + t) / 2, by\n constructor <;> linarith [ht.1, ht.2]⟩\n have hq : 2 * (q : ℝ) - 1 = t := by dsimp [q]; ring\n have hs : 0 < 2 * (1 - t ^ 2) := by nlinarith [ht.1, ht.2]\n have hp : 0 ≤ p := by linarith\n let a : ℝ≥0∞ := (ENNReal.ofReal ((Real.sqrt (2 * (1 - t ^ 2)))⁻¹)) ^ p\n let S : (Fin n → ({-1, 1} : Set ℤ)) →\n (Fin n → ({-1, 1} : Set ℤ)) → X :=\n fun ε δ ↦ ∑ j : Fin n, (((δ j : ℤ) : ℝ) - t) • D j f (cubeTranslate n δ ε)\n have hjensen : ∀ ε, ‖enfloNormalizedNoise X n f ε t‖ₑ ^ p ≤\n a * (∫⁻ δ, ‖S ε δ‖ₑ ^ p ∂centeredBernoulliCube n q) := by\n intro ε\n have hj := probability_integral_enorm_rpow_le X\n (Fin n → ({-1, 1} : Set ℤ)) (centeredBernoulliCube n q) p (S ε)\n h1p StronglyMeasurable.of_discrete.aestronglyMeasurable\n rw [enfloNormalizedNoise_centered_expectation X n f ε t ht q hq,\n enorm_smul, Real.enorm_of_nonneg (by positivity),\n ENNReal.mul_rpow_of_nonneg _ _ hp]\n exact mul_le_mul' le_rfl hj\n have hfirst :\n (∫⁻ ε, ‖enfloNormalizedNoise X n f ε t‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n)) ≤\n a * (∫⁻ ε, (∫⁻ δ, ‖S ε δ‖ₑ ^ p ∂centeredBernoulliCube n q)\n ∂rademacherProductDistribution (Fin n)) := by\n calc\n _ ≤ ∫⁻ ε, a * (∫⁻ δ, ‖S ε δ‖ₑ ^ p ∂centeredBernoulliCube n q)\n ∂rademacherProductDistribution (Fin n) := lintegral_mono hjensen\n _ = _ := lintegral_const_mul a (measurable_of_countable _)\n have hvariance : 8 * (q : ℝ) * (1 - (q : ℝ)) = 2 * (1 - t ^ 2) := by\n dsimp [q]\n ring\n have hjoint :\n (∫⁻ ε, (∫⁻ δ, ‖S ε δ‖ₑ ^ p ∂centeredBernoulliCube n q)\n ∂rademacherProductDistribution (Fin n)) ≤\n (ENNReal.ofReal (2 * (1 - t ^ 2))) ^ (p / 2) * C ^ p *\n ∑ j : Fin n, (∫⁻ ε, ‖D j f ε‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n)) := by\n have h := centered_bernoulli_cube_joint_bound X n p C q (fun ε j ↦ D j f ε)\n hn h1p hp2 hC\n rw [Measure.infinitePi_eq_pi, hq, hvariance] at h\n change (∫⁻ ε, (∫⁻ δ, ‖S ε δ‖ₑ ^ p ∂centeredBernoulliCube n q)\n ∂rademacherProductDistribution (Fin n)) ≤\n (ENNReal.ofReal (2 * (1 - t ^ 2))) ^ (p / 2) * C ^ p *\n ∑ j : Fin n, (∫⁻ ε, ‖D j f ε‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n)) at h\n exact h\n calc\n _ ≤ a * (∫⁻ ε, (∫⁻ δ, ‖S ε δ‖ₑ ^ p ∂centeredBernoulliCube n q)\n ∂rademacherProductDistribution (Fin n)) := hfirst\n _ ≤ a * ((ENNReal.ofReal (2 * (1 - t ^ 2))) ^ (p / 2) * C ^ p *\n ∑ j : Fin n, (∫⁻ ε, ‖D j f ε‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n))) := mul_le_mul' le_rfl hjoint\n _ = _ := by\n dsimp only [a]\n rw [← mul_assoc, ← mul_assoc, enflo_sqrt_inv_moment_cancel _ p hs, one_mul]\ntheorem enflo_type_constant_eq :\n ENNReal.ofReal (Real.pi / Real.sqrt 2) =\n (NNReal.pi : ℝ≥0∞) / (NNReal.sqrt (2 : ℝ≥0) : ℝ≥0∞) := by\n rw [ENNReal.ofReal_div_of_pos (Real.sqrt_pos.2 (by norm_num))]\n have hpi : ENNReal.ofReal Real.pi = (NNReal.pi : ℝ≥0∞) := by\n rw [← NNReal.coe_real_pi, ENNReal.ofReal_coe_nnreal]\n have hs : ENNReal.ofReal (Real.sqrt 2) = (NNReal.sqrt (2 : ℝ≥0) : ℝ≥0∞) := by\n simpa only [Real.coe_sqrt, NNReal.coe_ofNat] using\n (show ENNReal.ofReal ((NNReal.sqrt (2 : ℝ≥0)) : ℝ) =\n (NNReal.sqrt (2 : ℝ≥0) : ℝ≥0∞) from ENNReal.ofReal_coe_nnreal)\n rw [hpi, hs]\ntheorem rademacher_implies_enflo :\n ∀ (X : Type*) [NormedAddCommGroup X] [NormedSpace ℝ X] [CompleteSpace X]\n (p : ℝ) (C : ℝ≥0∞),\n 1 ≤ p → p ≤ 2 →\n RademacherEnfloType.IsRademacherType X C p →\n RademacherEnfloType.IsEnfloType X\n (((NNReal.pi : ℝ≥0∞) / (NNReal.sqrt (2 : ℝ≥0) : ℝ≥0∞)) * C) p := by\n intro X _ _ _ p C h1p hp2 hC n hn f\n letI := enfloArcsineMeasure_probability\n have hp : 0 ≤ p := by linarith\n have hscalar : 0 ≤ Real.pi / Real.sqrt 2 := by positivity\n have hJ : ∀ ε, ‖(1 / (2 : ℝ)) • (f ε - f (-ε))‖ₑ ^ p ≤\n (ENNReal.ofReal (Real.pi / Real.sqrt 2)) ^ p *\n (∫⁻ t, ‖enfloNormalizedNoise X n f ε t‖ₑ ^ p ∂enfloArcsineMeasure) := by\n intro ε\n rw [enflo_antipodal_kernel_expectation X n f ε, enorm_smul,\n Real.enorm_of_nonneg hscalar, ENNReal.mul_rpow_of_nonneg _ _ hp]\n exact mul_le_mul' le_rfl\n (probability_integral_enorm_rpow_le X ℝ enfloArcsineMeasure p\n (enfloNormalizedNoise X n f ε) h1p\n (enfloNormalizedNoise_continuous X n f ε).aestronglyMeasurable)\n have hswap := enflo_finite_lintegral_swap n enfloArcsineMeasure\n (fun t ε ↦ ‖enfloNormalizedNoise X n f ε t‖ₑ ^ p)\n (fun ε ↦ (enfloNormalizedNoise_continuous X n f ε).enorm.measurable.pow_const p)\n have hmoment :\n (∫⁻ t, (∫⁻ ε, ‖enfloNormalizedNoise X n f ε t‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n)) ∂enfloArcsineMeasure) ≤\n C ^ p * ∑ j : Fin n,\n (∫⁻ ε, ‖D j f ε‖ₑ ^ p ∂rademacherProductDistribution (Fin n)) := by\n calc\n _ ≤ ∫⁻ _t : ℝ,\n C ^ p * ∑ j : Fin n,\n (∫⁻ ε, ‖D j f ε‖ₑ ^ p ∂rademacherProductDistribution (Fin n))\n ∂enfloArcsineMeasure := lintegral_mono_ae (enfloArcsineMeasure_ae_mem.mono\n (fun t ht ↦ enfloNormalizedNoise_cube_moment_le X n p C f t ht hn h1p hp2 hC))\n _ = _ := by rw [lintegral_const, measure_univ, mul_one]\n calc\n _ ≤ ∫⁻ ε, (ENNReal.ofReal (Real.pi / Real.sqrt 2)) ^ p *\n (∫⁻ t, ‖enfloNormalizedNoise X n f ε t‖ₑ ^ p ∂enfloArcsineMeasure)\n ∂rademacherProductDistribution (Fin n) := lintegral_mono hJ\n _ = (ENNReal.ofReal (Real.pi / Real.sqrt 2)) ^ p *\n (∫⁻ t, (∫⁻ ε, ‖enfloNormalizedNoise X n f ε t‖ₑ ^ p\n ∂rademacherProductDistribution (Fin n)) ∂enfloArcsineMeasure) := by\n rw [lintegral_const_mul _ (measurable_of_countable _), hswap]\n _ ≤ (ENNReal.ofReal (Real.pi / Real.sqrt 2)) ^ p *\n (C ^ p * ∑ j : Fin n,\n (∫⁻ ε, ‖D j f ε‖ₑ ^ p ∂rademacherProductDistribution (Fin n))) :=\n mul_le_mul' le_rfl hmoment\n _ = _ := by\n rw [enflo_type_constant_eq, ENNReal.mul_rpow_of_nonneg _ _ hp, mul_assoc]\nend Submission\n" }, { "name": "Submission/Helpers.lean", "path": "accepted/annals_rademacher_enflo_type/Submission/Helpers.lean", "url": "https://github.com/LikC1606/theorem-os-site/blob/main/accepted/annals_rademacher_enflo_type/Submission/Helpers.lean", "sha256": "b5b5c31e59632f5c10241037df5e8d8d3f4ba346d99917caffd60932c7dae226", "lines": 3, "code": "namespace Submission.Helpers\n\nend Submission.Helpers\n" } ], "official": { "statementRevision": 1, "submissionUrl": "https://github.com/leanprover/lean-eval-submissions/issues/2115", "resultUrl": "https://github.com/leanprover/lean-eval-submissions/issues/2115#issuecomment-6161355838", "resultBody": "## Submission result\n\n✅ Newly-solved problems: annals_rademacher_enflo_type\n\nAttempted 1 / 1; succeeded on 1.\n\n### Per-problem\n- `annals_rademacher_enflo_type`: pass", "sourceUrl": "https://github.com/LikC1606/deepscientist-math-proofs/tree/0c40463f2714beea03c5e8416ba9e7c62aa6aa50", "sourceCommit": "0c40463f2714beea03c5e8416ba9e7c62aa6aa50", "checksums": { "README.md": "7d742c9565136e3a1558aaba102f54c889aa6102d7c94d36b52535a02797dd3c", "Submission.lean": "ad93f9761455b4e52fba817c002cb8a662296d99444ff27ec05d632ba7872357", "Submission/Helpers.lean": "b5b5c31e59632f5c10241037df5e8d8d3f4ba346d99917caffd60932c7dae226", "lakefile.toml": "42cca2d8df61e708f738befd9546f5f9d1f7d20660aadbf88372bbaf38b1ac4e", "verification.json": "9c28ee8f06c5acda0e23131693ce25b865f0d9b11f1e437503c29b19a34296a0" } }, "local": { "status": "evaluated_passed", "kernelVerified": true, "comparator": "official_verified", "sourceProofCommit": "f58e1aca3241c2174583c4e51e92d34fb287628a", "sourceBinding": "matches", "axioms": [ "propext", "Classical.choice", "Quot.sound" ], "url": "https://github.com/LikC1606/theorem-os-site/blob/main/accepted/annals_rademacher_enflo_type/verification.json", "production": { "mode": "continuation from previously kernel-checked helper proofs", "humanDirection": "Task selection, runtime and environment fixes, library-access policy, and continuation setup directed by a human user through a coding assistant." } } }, { "id": "annals_unit_conjecture", "title": "Unit conjecture", "subtitle": "群环单位猜想", "area": "代数", "summary": "构造无挠群中的群环非平凡单位，对应原题 theorem_A。原始结果归属于 DeepScientist + GPT-5.6。", "declaration": "theorem theorem_A", "en": { "subtitle": "A nontrivial unit in a group ring", "area": "Algebra", "summary": "Constructs a nontrivial unit in the group ring of a torsion-free group, theorem_A of the statement. The original result is credited to DeepScientist + GPT-5.6." }, "status": "official_accepted", "model": "DeepScientist + GPT-5.6", "updatedAt": "2026-08-22T14:44:59Z", "archiveUrl": "https://github.com/LikC1606/theorem-os-site/tree/main/accepted/annals_unit_conjecture", "sources": [ { "name": "Submission.lean", "path": "accepted/annals_unit_conjecture/Submission.lean", "url": "https://github.com/LikC1606/theorem-os-site/blob/main/accepted/annals_unit_conjecture/Submission.lean", "sha256": "5b0740de41cc47385273cb26195b3c7f08e50fa349edfa36489731b6ba10f062", "lines": 1109, "code": "import ChallengeDeps\nimport Mathlib.Tactic\n\nopen UnitConjecture\n\nset_option autoImplicit false\n\nnamespace Submission\n\nnoncomputable section\n\nprivate structure Point where\n i : ℤ\n j : ℤ\n k : ℤ\nderiving DecidableEq\n\nprivate def affineA : Equiv.Perm Point where\n toFun v := ⟨v.i + 1, -v.j, 1 - v.k⟩\n invFun v := ⟨v.i - 1, -v.j, 1 - v.k⟩\n left_inv := by rintro ⟨i, j, k⟩; simp\n right_inv := by rintro ⟨i, j, k⟩; simp\n\nprivate def affineB : Equiv.Perm Point where\n toFun v := ⟨-v.i, v.j + 1, -v.k⟩\n invFun v := ⟨-v.i, v.j - 1, -v.k⟩\n left_inv := by rintro ⟨i, j, k⟩; simp\n right_inv := by rintro ⟨i, j, k⟩; simp\n\nprivate def affineGenerator : generators → Equiv.Perm Point\n | .a => affineA\n | .b => affineB\n\nprivate lemma affine_relations (w : FreeGroup generators) (hw : w ∈ relations) :\n FreeGroup.lift affineGenerator w = 1 := by\n simp only [relations, Set.mem_insert_iff, Set.mem_singleton_iff] at hw\n rcases hw with rfl | rfl\n · ext v\n rcases v with ⟨i, j, k⟩\n simp [UnitConjecture.a, UnitConjecture.b, affineGenerator, affineA, affineB, pow_two]\n · ext v\n rcases v with ⟨i, j, k⟩\n simp [UnitConjecture.a, UnitConjecture.b, affineGenerator, affineA, affineB, pow_two]\n\nprivate def affineRepresentation : P →* Equiv.Perm Point :=\n PresentedGroup.toGroup affine_relations\n\n@[simp] private lemma affineRepresentation_a : affineRepresentation (a : P) = affineA := by\n rfl\n\n@[simp] private lemma affineRepresentation_b : affineRepresentation (b : P) = affineB := by\n rfl\n\n@[simp] private lemma affineRepresentation_x : affineRepresentation x = affineA ^ 2 := by\n simp [x]\n\n@[simp] private lemma affineRepresentation_y : affineRepresentation y = affineB ^ 2 := by\n simp [y]\n\n@[simp] private lemma affineRepresentation_z :\n affineRepresentation z = (affineA * affineB) ^ 2 := by\n simp [z]\n\nprivate lemma affineX_zpow_apply (m : ℤ) : ∀ v : Point,\n ((affineA ^ 2) ^ m) v = ⟨v.i + 2 * m, v.j, v.k⟩ := by\n refine Int.inductionOn' m 0 ?_ ?_ ?_\n · intro v\n simp\n · intro n _ ih v\n rw [zpow_add_one, Equiv.Perm.mul_apply, ih]\n rcases v with ⟨i, j, k⟩\n simp [affineA, pow_two, Point.mk.injEq]\n omega\n · intro n _ ih v\n rw [zpow_sub_one, Equiv.Perm.mul_apply, ih]\n rcases v with ⟨i, j, k⟩\n simp [affineA, pow_two, Point.mk.injEq]\n omega\n\nprivate lemma affineY_zpow_apply (m : ℤ) : ∀ v : Point,\n ((affineB ^ 2) ^ m) v = ⟨v.i, v.j + 2 * m, v.k⟩ := by\n refine Int.inductionOn' m 0 ?_ ?_ ?_\n · intro v\n simp\n · intro n _ ih v\n rw [zpow_add_one, Equiv.Perm.mul_apply, ih]\n rcases v with ⟨i, j, k⟩\n simp [affineB, pow_two, Point.mk.injEq]\n omega\n · intro n _ ih v\n rw [zpow_sub_one, Equiv.Perm.mul_apply, ih]\n rcases v with ⟨i, j, k⟩\n simp [affineB, pow_two, Point.mk.injEq]\n omega\n\nprivate lemma affineZ_zpow_apply (m : ℤ) : ∀ v : Point,\n (((affineA * affineB) ^ 2) ^ m) v = ⟨v.i, v.j, v.k + 2 * m⟩ := by\n refine Int.inductionOn' m 0 ?_ ?_ ?_\n · intro v\n simp\n · intro n _ ih v\n rw [zpow_add_one, Equiv.Perm.mul_apply, ih]\n rcases v with ⟨i, j, k⟩\n simp [affineA, affineB, pow_two, Point.mk.injEq]\n omega\n · intro n _ ih v\n rw [zpow_sub_one, Equiv.Perm.mul_apply, ih]\n rcases v with ⟨i, j, k⟩\n simp [affineA, affineB, pow_two, Point.mk.injEq]\n omega\n\nprivate lemma relation_a : (b : P)⁻¹ * (a : P) ^ 2 * b * a ^ 2 = 1 := by\n exact PresentedGroup.one_of_mem (by simp [UnitConjecture.relations])\n\nprivate lemma relation_b : (a : P)⁻¹ * (b : P) ^ 2 * a * b ^ 2 = 1 := by\n exact PresentedGroup.one_of_mem (by simp [UnitConjecture.relations])\n\nprivate lemma conjugate_x_by_b : (b : P)⁻¹ * x * b = x⁻¹ := by\n apply eq_inv_of_mul_eq_one_left\n simpa [x, mul_assoc] using relation_a\n\nprivate lemma conjugate_y_by_a : (a : P)⁻¹ * y * a = y⁻¹ := by\n apply eq_inv_of_mul_eq_one_left\n simpa [y, mul_assoc] using relation_b\n\nprivate lemma conjugate_x_inv_by_b : (b : P)⁻¹ * x⁻¹ * b = x := by\n have h := congrArg Inv.inv conjugate_x_by_b\n simpa only [mul_inv_rev, inv_inv, mul_assoc] using h\n\nprivate lemma conjugate_y_inv_by_a : (a : P)⁻¹ * y⁻¹ * a = y := by\n have h := congrArg Inv.inv conjugate_y_by_a\n simpa only [mul_inv_rev, inv_inv, mul_assoc] using h\n\nprivate lemma commute_x_y : x * y = y * x := by\n calc\n x * y = b * ((b : P)⁻¹ * x * b) * b := by simp [y, pow_two, mul_assoc]\n _ = b * x⁻¹ * b := by rw [conjugate_x_by_b]\n _ = y * ((b : P)⁻¹ * x⁻¹ * b) := by simp [y, pow_two, mul_assoc]\n _ = y * x := by rw [conjugate_x_inv_by_b]\n\nprivate lemma commute_a_x : (a : P) * x = x * a := by\n simp [x, pow_two, mul_assoc]\n\nprivate lemma commute_b_y : (b : P) * y = y * b := by\n simp [y, pow_two, mul_assoc]\n\nprivate lemma a_mul_y : (a : P) * y = y⁻¹ * a := by\n calc\n (a : P) * y = x * ((a : P)⁻¹ * y * a) * (a : P)⁻¹ := by\n simp [x, pow_two, mul_assoc]\n _ = x * y⁻¹ * (a : P)⁻¹ := by rw [conjugate_y_by_a]\n _ = y⁻¹ * a := by\n rw [(show Commute x y⁻¹ from (show Commute x y from commute_x_y).inv_right).eq]\n simp [x, pow_two, mul_assoc]\n\nprivate lemma b_mul_x : (b : P) * x = x⁻¹ * b := by\n calc\n (b : P) * x = y * ((b : P)⁻¹ * x * b) * (b : P)⁻¹ := by\n simp [y, pow_two, mul_assoc]\n _ = y * x⁻¹ * (b : P)⁻¹ := by rw [conjugate_x_by_b]\n _ = x⁻¹ * b := by\n rw [(show Commute y x⁻¹ from (show Commute y x from commute_x_y.symm).inv_right).eq]\n simp [y, pow_two, mul_assoc]\n\nprivate lemma conjugate_z_by_a : (a : P)⁻¹ * z * a = z⁻¹ := by\n apply eq_inv_of_mul_eq_one_left\n calc\n ((a : P)⁻¹ * z * a) * z =\n (b : P) * a * b * x * b * a * b := by\n simp only [z, x, pow_two]\n group\n _ = (b : P) * a * (b * x) * b * a * b := by group\n _ = (b : P) * a * (x⁻¹ * b) * b * a * b := by rw [b_mul_x]\n _ = (b : P) * (a * x⁻¹) * b * b * a * b := by group\n _ = (b : P) * (x⁻¹ * a) * b * b * a * b := by\n rw [(show Commute (a : P) x⁻¹ from\n (show Commute (a : P) x from commute_a_x).inv_right).eq]\n _ = (b : P) * x⁻¹ * a * y * a * b := by\n simp only [y, pow_two]\n group\n _ = (b : P) * x⁻¹ * (a * y) * a * b := by group\n _ = (b : P) * x⁻¹ * (y⁻¹ * a) * a * b := by rw [a_mul_y]\n _ = (b : P) * x⁻¹ * y⁻¹ * x * b := by\n simp only [x, pow_two]\n group\n _ = (b : P) * (x⁻¹ * y⁻¹) * x * b := by group\n _ = (b : P) * y⁻¹ * b := by\n rw [(show Commute x⁻¹ y⁻¹ from\n (show Commute x y from commute_x_y).inv_left.inv_right).eq]\n simp [mul_assoc]\n _ = 1 := by\n rw [(show Commute (b : P) y⁻¹ from\n (show Commute (b : P) y from commute_b_y).inv_right).eq]\n simp [y, pow_two, mul_assoc]\n\nprivate lemma conjugate_z_inv_by_a : (a : P)⁻¹ * z⁻¹ * a = z := by\n have h := congrArg Inv.inv conjugate_z_by_a\n simpa only [mul_inv_rev, inv_inv, mul_assoc] using h\n\nprivate lemma conjugate_z_inv_by_b : (b : P)⁻¹ * z⁻¹ * b = z := by\n calc\n (b : P)⁻¹ * z⁻¹ * b =\n (b : P)⁻¹ * ((a : P)⁻¹ * z * a) * b := by rw [conjugate_z_by_a]\n _ = ((a : P) * b)⁻¹ * z * (a * b) := by group\n _ = z := by simp [z, pow_two, mul_assoc]\n\nprivate lemma conjugate_z_by_b : (b : P)⁻¹ * z * b = z⁻¹ := by\n have h := congrArg Inv.inv conjugate_z_inv_by_b\n simpa only [mul_inv_rev, inv_inv, mul_assoc] using h\n\nprivate lemma commute_x_z : x * z = z * x := by\n symm\n calc\n z * x = (a : P) * ((a : P)⁻¹ * z * a) * a := by simp [x, pow_two, mul_assoc]\n _ = (a : P) * z⁻¹ * a := by rw [conjugate_z_by_a]\n _ = x * ((a : P)⁻¹ * z⁻¹ * a) := by simp [x, pow_two, mul_assoc]\n _ = x * z := by rw [conjugate_z_inv_by_a]\n\nprivate lemma commute_y_z : y * z = z * y := by\n symm\n calc\n z * y = (b : P) * ((b : P)⁻¹ * z * b) * b := by simp [y, pow_two, mul_assoc]\n _ = (b : P) * z⁻¹ * b := by rw [conjugate_z_by_b]\n _ = y * ((b : P)⁻¹ * z⁻¹ * b) := by simp [y, pow_two, mul_assoc]\n _ = y * z := by rw [conjugate_z_inv_by_b]\n\nprivate def translations : Subgroup P where\n carrier := {g | ∃ i j k : ℤ, g = x ^ i * y ^ j * z ^ k}\n one_mem' := ⟨0, 0, 0, by simp⟩\n mul_mem' := by\n rintro _ _ ⟨i, j, k, rfl⟩ ⟨l, m, n, rfl⟩\n refine ⟨i + l, j + m, k + n, ?_⟩\n simp only [zpow_add]\n calc\n (x ^ i * y ^ j * z ^ k) * (x ^ l * y ^ m * z ^ n) =\n x ^ i * y ^ j * (z ^ k * x ^ l) * y ^ m * z ^ n := by group\n _ = x ^ i * y ^ j * (x ^ l * z ^ k) * y ^ m * z ^ n := by\n rw [(show Commute (z ^ k) (x ^ l) from\n (show Commute z x from commute_x_z.symm).zpow_zpow k l).eq]\n _ = x ^ i * (y ^ j * x ^ l) * z ^ k * y ^ m * z ^ n := by group\n _ = x ^ i * (x ^ l * y ^ j) * z ^ k * y ^ m * z ^ n := by\n rw [(show Commute (y ^ j) (x ^ l) from\n (show Commute y x from commute_x_y.symm).zpow_zpow j l).eq]\n _ = x ^ i * x ^ l * y ^ j * (z ^ k * y ^ m) * z ^ n := by group\n _ = x ^ i * x ^ l * y ^ j * (y ^ m * z ^ k) * z ^ n := by\n rw [(show Commute (z ^ k) (y ^ m) from\n (show Commute z y from commute_y_z.symm).zpow_zpow k m).eq]\n _ = (x ^ i * x ^ l) * (y ^ j * y ^ m) * (z ^ k * z ^ n) := by group\n inv_mem' := by\n rintro _ ⟨i, j, k, rfl⟩\n refine ⟨-i, -j, -k, ?_⟩\n simp only [zpow_neg]\n calc\n (x ^ i * y ^ j * z ^ k)⁻¹ = (z ^ k)⁻¹ * (y ^ j)⁻¹ * (x ^ i)⁻¹ := by group\n _ = (y ^ j)⁻¹ * (z ^ k)⁻¹ * (x ^ i)⁻¹ := by\n rw [(show Commute (z ^ k)⁻¹ (y ^ j)⁻¹ from\n (show Commute (z ^ k) (y ^ j) from\n (show Commute z y from commute_y_z.symm).zpow_zpow k j).inv_left.inv_right).eq]\n _ = (y ^ j)⁻¹ * ((z ^ k)⁻¹ * (x ^ i)⁻¹) := by group\n _ = (y ^ j)⁻¹ * (x ^ i)⁻¹ * (z ^ k)⁻¹ := by\n rw [(show Commute (z ^ k)⁻¹ (x ^ i)⁻¹ from\n (show Commute (z ^ k) (x ^ i) from\n (show Commute z x from commute_x_z.symm).zpow_zpow k i).inv_left.inv_right).eq]\n group\n _ = (x ^ i)⁻¹ * (y ^ j)⁻¹ * (z ^ k)⁻¹ := by\n rw [(show Commute (y ^ j)⁻¹ (x ^ i)⁻¹ from\n (show Commute (y ^ j) (x ^ i) from\n (show Commute y x from commute_x_y.symm).zpow_zpow j i).inv_left.inv_right).eq]\n\nprivate lemma conjugate_x_by_a : (a : P)⁻¹ * x * a = x := by\n calc\n (a : P)⁻¹ * x * a = (a : P)⁻¹ * (a * x) := by rw [commute_a_x]; group\n _ = x := by simp\n\nprivate lemma conjugate_y_by_b : (b : P)⁻¹ * y * b = y := by\n calc\n (b : P)⁻¹ * y * b = (b : P)⁻¹ * (b * y) := by rw [commute_b_y]; group\n _ = y := by simp\n\nprivate lemma conjugate_left_x_by_a : (a : P) * x * (a : P)⁻¹ = x := by\n rw [commute_a_x]\n simp [mul_assoc]\n\nprivate lemma conjugate_left_y_by_a : (a : P) * y * (a : P)⁻¹ = y⁻¹ := by\n rw [a_mul_y]\n simp [mul_assoc]\n\nprivate lemma conjugate_left_z_by_a : (a : P) * z * (a : P)⁻¹ = z⁻¹ := by\n calc\n (a : P) * z * (a : P)⁻¹ = x * ((a : P)⁻¹ * z * a) * x⁻¹ := by\n simp [x, pow_two, mul_assoc]\n _ = x * z⁻¹ * x⁻¹ := by rw [conjugate_z_by_a]\n _ = z⁻¹ := by\n rw [(show Commute x z⁻¹ from\n (show Commute x z from commute_x_z).inv_right).eq]\n simp [mul_assoc]\n\nprivate lemma conjugate_left_x_by_b : (b : P) * x * (b : P)⁻¹ = x⁻¹ := by\n calc\n (b : P) * x * (b : P)⁻¹ = y * ((b : P)⁻¹ * x * b) * y⁻¹ := by\n simp [y, pow_two, mul_assoc]\n _ = y * x⁻¹ * y⁻¹ := by rw [conjugate_x_by_b]\n _ = x⁻¹ := by\n rw [(show Commute y x⁻¹ from\n (show Commute y x from commute_x_y.symm).inv_right).eq]\n simp [mul_assoc]\n\nprivate lemma conjugate_left_y_by_b : (b : P) * y * (b : P)⁻¹ = y := by\n rw [commute_b_y]\n simp [mul_assoc]\n\nprivate lemma conjugate_left_z_by_b : (b : P) * z * (b : P)⁻¹ = z⁻¹ := by\n calc\n (b : P) * z * (b : P)⁻¹ = y * ((b : P)⁻¹ * z * b) * y⁻¹ := by\n simp [y, pow_two, mul_assoc]\n _ = y * z⁻¹ * y⁻¹ := by rw [conjugate_z_by_b]\n _ = z⁻¹ := by\n rw [(show Commute y z⁻¹ from\n (show Commute y z from commute_y_z).inv_right).eq]\n simp [mul_assoc]\n\nprivate lemma conjugate_inv_zpow (g h : P) (i : ℤ) :\n g⁻¹ * h ^ i * g = (g⁻¹ * h * g) ^ i := by\n simpa only [inv_inv] using (conj_zpow (a := g⁻¹) (b := h) (i := i)).symm\n\nprivate lemma conjugate_translation_by_a (i j k : ℤ) :\n (a : P)⁻¹ * (x ^ i * y ^ j * z ^ k) * a = x ^ i * y ^ (-j) * z ^ (-k) := by\n calc\n (a : P)⁻¹ * (x ^ i * y ^ j * z ^ k) * a =\n ((a : P)⁻¹ * x ^ i * a) * ((a : P)⁻¹ * y ^ j * a) *\n ((a : P)⁻¹ * z ^ k * a) := by group\n _ = ((a : P)⁻¹ * x * a) ^ i * ((a : P)⁻¹ * y * a) ^ j *\n ((a : P)⁻¹ * z * a) ^ k := by simp only [conjugate_inv_zpow]\n _ = x ^ i * (y⁻¹) ^ j * (z⁻¹) ^ k := by\n rw [conjugate_x_by_a, conjugate_y_by_a, conjugate_z_by_a]\n _ = x ^ i * y ^ (-j) * z ^ (-k) := by simp only [inv_zpow']\n\nprivate lemma conjugate_translation_left_by_a (i j k : ℤ) :\n (a : P) * (x ^ i * y ^ j * z ^ k) * (a : P)⁻¹ =\n x ^ i * y ^ (-j) * z ^ (-k) := by\n calc\n (a : P) * (x ^ i * y ^ j * z ^ k) * (a : P)⁻¹ =\n ((a : P) * x ^ i * (a : P)⁻¹) * ((a : P) * y ^ j * (a : P)⁻¹) *\n ((a : P) * z ^ k * (a : P)⁻¹) := by group\n _ = ((a : P) * x * (a : P)⁻¹) ^ i * ((a : P) * y * (a : P)⁻¹) ^ j *\n ((a : P) * z * (a : P)⁻¹) ^ k := by simp only [conj_zpow]\n _ = x ^ i * (y⁻¹) ^ j * (z⁻¹) ^ k := by\n rw [conjugate_left_x_by_a, conjugate_left_y_by_a, conjugate_left_z_by_a]\n _ = x ^ i * y ^ (-j) * z ^ (-k) := by simp only [inv_zpow']\n\nprivate lemma conjugate_translation_by_b (i j k : ℤ) :\n (b : P)⁻¹ * (x ^ i * y ^ j * z ^ k) * b = x ^ (-i) * y ^ j * z ^ (-k) := by\n calc\n (b : P)⁻¹ * (x ^ i * y ^ j * z ^ k) * b =\n ((b : P)⁻¹ * x ^ i * b) * ((b : P)⁻¹ * y ^ j * b) *\n ((b : P)⁻¹ * z ^ k * b) := by group\n _ = ((b : P)⁻¹ * x * b) ^ i * ((b : P)⁻¹ * y * b) ^ j *\n ((b : P)⁻¹ * z * b) ^ k := by simp only [conjugate_inv_zpow]\n _ = (x⁻¹) ^ i * y ^ j * (z⁻¹) ^ k := by\n rw [conjugate_x_by_b, conjugate_y_by_b, conjugate_z_by_b]\n _ = x ^ (-i) * y ^ j * z ^ (-k) := by simp only [inv_zpow']\n\nprivate lemma conjugate_translation_left_by_b (i j k : ℤ) :\n (b : P) * (x ^ i * y ^ j * z ^ k) * (b : P)⁻¹ =\n x ^ (-i) * y ^ j * z ^ (-k) := by\n calc\n (b : P) * (x ^ i * y ^ j * z ^ k) * (b : P)⁻¹ =\n ((b : P) * x ^ i * (b : P)⁻¹) * ((b : P) * y ^ j * (b : P)⁻¹) *\n ((b : P) * z ^ k * (b : P)⁻¹) := by group\n _ = ((b : P) * x * (b : P)⁻¹) ^ i * ((b : P) * y * (b : P)⁻¹) ^ j *\n ((b : P) * z * (b : P)⁻¹) ^ k := by simp only [conj_zpow]\n _ = (x⁻¹) ^ i * y ^ j * (z⁻¹) ^ k := by\n rw [conjugate_left_x_by_b, conjugate_left_y_by_b, conjugate_left_z_by_b]\n _ = x ^ (-i) * y ^ j * z ^ (-k) := by simp only [inv_zpow']\n\nprivate lemma a_mem_translations_normalizer :\n (a : P) ∈ Subgroup.normalizer (translations : Set P) := by\n rw [Subgroup.mem_normalizer_iff]\n intro h\n constructor\n · rintro ⟨i, j, k, rfl⟩\n exact ⟨i, -j, -k, conjugate_translation_left_by_a i j k⟩\n · rintro ⟨i, j, k, hh⟩\n refine ⟨i, -j, -k, ?_⟩\n calc\n h = (a : P)⁻¹ * ((a : P) * h * (a : P)⁻¹) * a := by group\n _ = (a : P)⁻¹ * (x ^ i * y ^ j * z ^ k) * a := by rw [hh]\n _ = x ^ i * y ^ (-j) * z ^ (-k) := conjugate_translation_by_a i j k\n\nprivate lemma b_mem_translations_normalizer :\n (b : P) ∈ Subgroup.normalizer (translations : Set P) := by\n rw [Subgroup.mem_normalizer_iff]\n intro h\n constructor\n · rintro ⟨i, j, k, rfl⟩\n exact ⟨-i, j, -k, conjugate_translation_left_by_b i j k⟩\n · rintro ⟨i, j, k, hh⟩\n refine ⟨-i, j, -k, ?_⟩\n calc\n h = (b : P)⁻¹ * ((b : P) * h * (b : P)⁻¹) * b := by group\n _ = (b : P)⁻¹ * (x ^ i * y ^ j * z ^ k) * b := by rw [hh]\n _ = x ^ (-i) * y ^ j * z ^ (-k) := conjugate_translation_by_b i j k\n\nprivate lemma translations_normal : translations.Normal := by\n rw [← Subgroup.normalizer_eq_top_iff]\n apply top_unique\n intro g _\n apply PresentedGroup.generated_by relations (Subgroup.normalizer (translations : Set P))\n intro c\n cases c with\n | a => exact a_mem_translations_normalizer\n | b => exact b_mem_translations_normalizer\n\nprivate instance : translations.Normal := translations_normal\n\nprivate abbrev TranslationQuotient := P ⧸ translations\n\nprivate abbrev quotientA : TranslationQuotient := (a : P)\n\nprivate abbrev quotientB : TranslationQuotient := (b : P)\n\nprivate lemma quotientA_sq : quotientA ^ 2 = 1 := by\n apply (QuotientGroup.eq_one_iff ((a : P) ^ 2)).mpr\n exact ⟨1, 0, 0, by simp [x]⟩\n\nprivate lemma quotientB_sq : quotientB ^ 2 = 1 := by\n apply (QuotientGroup.eq_one_iff ((b : P) ^ 2)).mpr\n exact ⟨0, 1, 0, by simp [y]⟩\n\nprivate lemma quotientAB_sq : (quotientA * quotientB) ^ 2 = 1 := by\n apply (QuotientGroup.eq_one_iff (((a : P) * b) ^ 2)).mpr\n exact ⟨0, 0, 1, by simp [z]⟩\n\nprivate lemma quotientA_inv : quotientA⁻¹ = quotientA := by\n apply inv_eq_of_mul_eq_one_right\n simpa only [pow_two] using quotientA_sq\n\nprivate lemma quotientB_inv : quotientB⁻¹ = quotientB := by\n apply inv_eq_of_mul_eq_one_right\n simpa only [pow_two] using quotientB_sq\n\nprivate lemma quotientAB_inv : (quotientA * quotientB)⁻¹ = quotientA * quotientB := by\n apply inv_eq_of_mul_eq_one_right\n simpa only [pow_two] using quotientAB_sq\n\nprivate lemma quotientA_commute_quotientB : quotientA * quotientB = quotientB * quotientA := by\n calc\n quotientA * quotientB = (quotientA * quotientB)⁻¹ := quotientAB_inv.symm\n _ = quotientB⁻¹ * quotientA⁻¹ := mul_inv_rev _ _\n _ = quotientB * quotientA := by rw [quotientA_inv, quotientB_inv]\n\nprivate lemma quotientA_mul_self : quotientA * quotientA = 1 := by\n simpa only [pow_two] using quotientA_sq\n\nprivate lemma quotientB_mul_self : quotientB * quotientB = 1 := by\n simpa only [pow_two] using quotientB_sq\n\nprivate lemma quotientAB_mul_self :\n (quotientA * quotientB) * (quotientA * quotientB) = 1 := by\n simpa only [pow_two] using quotientAB_sq\n\nprivate lemma quotientB_mul_quotientA : quotientB * quotientA = quotientA * quotientB :=\n quotientA_commute_quotientB.symm\n\nprivate lemma quotientA_mul_quotientAB :\n quotientA * (quotientA * quotientB) = quotientB := by\n rw [← mul_assoc, quotientA_mul_self, one_mul]\n\nprivate lemma quotientAB_mul_quotientA :\n (quotientA * quotientB) * quotientA = quotientB := by\n rw [quotientA_commute_quotientB, mul_assoc, quotientA_mul_self, mul_one]\n\nprivate lemma quotientB_mul_quotientAB :\n quotientB * (quotientA * quotientB) = quotientA := by\n calc\n quotientB * (quotientA * quotientB) = (quotientB * quotientA) * quotientB := by group\n _ = (quotientA * quotientB) * quotientB := by rw [quotientB_mul_quotientA]\n _ = quotientA := by rw [mul_assoc, quotientB_mul_self, mul_one]\n\nprivate lemma quotientAB_mul_quotientB :\n (quotientA * quotientB) * quotientB = quotientA := by\n rw [mul_assoc, quotientB_mul_self, mul_one]\n\nprivate def quotientFour : Subgroup TranslationQuotient where\n carrier := {1, quotientA, quotientB, quotientA * quotientB}\n one_mem' := by simp\n mul_mem' := by\n intro g h hg hh\n simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hg hh ⊢\n rcases hg with rfl | rfl | rfl | rfl <;>\n rcases hh with rfl | rfl | rfl | rfl\n all_goals simp only [one_mul, mul_one, quotientA_mul_self, quotientB_mul_self,\n quotientAB_mul_self, quotientB_mul_quotientA, quotientA_mul_quotientAB,\n quotientAB_mul_quotientA, quotientB_mul_quotientAB, quotientAB_mul_quotientB]\n all_goals aesop\n inv_mem' := by\n intro g hg\n simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hg ⊢\n rcases hg with rfl | rfl | rfl | rfl\n · exact Or.inl inv_one\n · exact Or.inr (Or.inl quotientA_inv)\n · exact Or.inr (Or.inr (Or.inl quotientB_inv))\n · exact Or.inr (Or.inr (Or.inr quotientAB_inv))\n\nprivate lemma quotientFour_eq_top : quotientFour = ⊤ := by\n apply top_unique\n intro q _\n refine Quotient.inductionOn' q ?_\n intro g\n apply PresentedGroup.generated_by relations\n (quotientFour.comap (QuotientGroup.mk' translations))\n intro c\n cases c with\n | a =>\n change quotientA ∈ quotientFour\n exact Or.inr (Or.inl rfl)\n | b =>\n change quotientB ∈ quotientFour\n exact Or.inr (Or.inr (Or.inl rfl))\n\nprivate lemma exists_normal_form (g : P) :\n ∃ i j k : ℤ,\n g = x ^ i * y ^ j * z ^ k ∨\n g = x ^ i * y ^ j * z ^ k * a ∨\n g = x ^ i * y ^ j * z ^ k * b ∨\n g = x ^ i * y ^ j * z ^ k * (a * b) := by\n have hq : (g : TranslationQuotient) ∈ quotientFour := by\n rw [quotientFour_eq_top]\n trivial\n simp only [quotientFour] at hq\n rcases hq with hq | hq | hq | hq\n · obtain ⟨i, j, k, hg⟩ := (QuotientGroup.eq_one_iff g).mp hq\n exact ⟨i, j, k, Or.inl hg⟩\n · obtain ⟨i, j, k, hg⟩ := (QuotientGroup.eq_iff_div_mem.mp hq)\n refine ⟨i, j, k, Or.inr (Or.inl ?_)⟩\n calc\n g = g / (a : P) * (a : P) := by simp\n _ = x ^ i * y ^ j * z ^ k * (a : P) := by rw [hg]\n · obtain ⟨i, j, k, hg⟩ := (QuotientGroup.eq_iff_div_mem.mp hq)\n refine ⟨i, j, k, Or.inr (Or.inr (Or.inl ?_))⟩\n calc\n g = g / (b : P) * (b : P) := by simp\n _ = x ^ i * y ^ j * z ^ k * (b : P) := by rw [hg]\n · obtain ⟨i, j, k, hg⟩ := (QuotientGroup.eq_iff_div_mem.mp hq)\n refine ⟨i, j, k, Or.inr (Or.inr (Or.inr ?_))⟩\n calc\n g = g / ((a : P) * (b : P)) * ((a : P) * (b : P)) := by simp\n _ = x ^ i * y ^ j * z ^ k * ((a : P) * (b : P)) := by rw [hg]\n\nprivate lemma affineTranslation_apply (i j k : ℤ) (v : Point) :\n affineRepresentation (x ^ i * y ^ j * z ^ k) v =\n ⟨v.i + 2 * i, v.j + 2 * j, v.k + 2 * k⟩ := by\n simp only [map_mul, map_zpow, affineRepresentation_x, affineRepresentation_y,\n affineRepresentation_z, Equiv.Perm.mul_apply]\n rw [affineZ_zpow_apply, affineY_zpow_apply, affineX_zpow_apply]\n\nprivate lemma affineTranslationA_i (i j k : ℤ) (v : Point) :\n (affineRepresentation (x ^ i * y ^ j * z ^ k * a) v).i =\n v.i + (2 * i + 1) := by\n calc\n (affineRepresentation (x ^ i * y ^ j * z ^ k * a) v).i =\n (affineRepresentation (x ^ i * y ^ j * z ^ k) (affineA v)).i := by\n simp only [map_mul, affineRepresentation_a, Equiv.Perm.mul_apply]\n _ = (affineA v).i + 2 * i := by rw [affineTranslation_apply]\n _ = v.i + (2 * i + 1) := by simp [affineA]; omega\n\nprivate lemma affineTranslationB_j (i j k : ℤ) (v : Point) :\n (affineRepresentation (x ^ i * y ^ j * z ^ k * b) v).j =\n v.j + (2 * j + 1) := by\n calc\n (affineRepresentation (x ^ i * y ^ j * z ^ k * b) v).j =\n (affineRepresentation (x ^ i * y ^ j * z ^ k) (affineB v)).j := by\n simp only [map_mul, affineRepresentation_b, Equiv.Perm.mul_apply]\n _ = (affineB v).j + 2 * j := by rw [affineTranslation_apply]\n _ = v.j + (2 * j + 1) := by simp [affineB]; omega\n\nprivate lemma affineTranslationAB_k (i j k : ℤ) (v : Point) :\n (affineRepresentation (x ^ i * y ^ j * z ^ k * (a * b)) v).k =\n v.k + (2 * k + 1) := by\n calc\n (affineRepresentation (x ^ i * y ^ j * z ^ k * (a * b)) v).k =\n (affineRepresentation (x ^ i * y ^ j * z ^ k) (affineA (affineB v))).k := by\n simp only [map_mul, affineRepresentation_a, affineRepresentation_b, Equiv.Perm.mul_apply]\n _ = (affineA (affineB v)).k + 2 * k := by rw [affineTranslation_apply]\n _ = v.k + (2 * k + 1) := by simp [affineA, affineB]; omega\n\nprivate lemma perm_pow_i_of_shift (f : Equiv.Perm Point) (d : ℤ)\n (h : ∀ v, (f v).i = v.i + d) (n : ℕ) (v : Point) :\n ((f ^ n) v).i = v.i + n * d := by\n induction n generalizing v with\n | zero => simp\n | succ n ih =>\n rw [pow_succ, Equiv.Perm.mul_apply, ih (f v), h]\n push_cast\n ring\n\nprivate lemma perm_pow_j_of_shift (f : Equiv.Perm Point) (d : ℤ)\n (h : ∀ v, (f v).j = v.j + d) (n : ℕ) (v : Point) :\n ((f ^ n) v).j = v.j + n * d := by\n induction n generalizing v with\n | zero => simp\n | succ n ih =>\n rw [pow_succ, Equiv.Perm.mul_apply, ih (f v), h]\n push_cast\n ring\n\nprivate lemma perm_pow_k_of_shift (f : Equiv.Perm Point) (d : ℤ)\n (h : ∀ v, (f v).k = v.k + d) (n : ℕ) (v : Point) :\n ((f ^ n) v).k = v.k + n * d := by\n induction n generalizing v with\n | zero => simp\n | succ n ih =>\n rw [pow_succ, Equiv.Perm.mul_apply, ih (f v), h]\n push_cast\n ring\n\nprivate lemma torsion_free_P : ∀ g : P, ∀ n ≠ 0, g ^ n = 1 → g = 1 := by\n intro g n hn hpow\n obtain ⟨i, j, k, hg | hg | hg | hg⟩ := exists_normal_form g\n · subst g\n have hp : (affineRepresentation (x ^ i * y ^ j * z ^ k)) ^ n = 1 := by\n simpa only [map_pow, map_one] using congrArg affineRepresentation hpow\n have happ := congrArg (fun f : Equiv.Perm Point => f ⟨0, 0, 0⟩) hp\n have hi := congrArg Point.i happ\n have hj := congrArg Point.j happ\n have hk := congrArg Point.k happ\n rw [perm_pow_i_of_shift _ (2 * i) (fun v => by rw [affineTranslation_apply]) n] at hi\n rw [perm_pow_j_of_shift _ (2 * j) (fun v => by rw [affineTranslation_apply]) n] at hj\n rw [perm_pow_k_of_shift _ (2 * k) (fun v => by rw [affineTranslation_apply]) n] at hk\n simp only [zero_add] at hi hj hk\n have hn' : (n : ℤ) ≠ 0 := by exact_mod_cast hn\n have hi' : 2 * i = 0 := (mul_eq_zero.mp hi).resolve_left hn'\n have hj' : 2 * j = 0 := (mul_eq_zero.mp hj).resolve_left hn'\n have hk' : 2 * k = 0 := (mul_eq_zero.mp hk).resolve_left hn'\n have : i = 0 ∧ j = 0 ∧ k = 0 := by omega\n rcases this with ⟨rfl, rfl, rfl⟩\n simp\n · subst g\n have hp : (affineRepresentation (x ^ i * y ^ j * z ^ k * a)) ^ n = 1 := by\n simpa only [map_pow, map_one] using congrArg affineRepresentation hpow\n have happ := congrArg (fun f : Equiv.Perm Point => f ⟨0, 0, 0⟩) hp\n have hi := congrArg Point.i happ\n rw [perm_pow_i_of_shift _ (2 * i + 1) (affineTranslationA_i i j k) n] at hi\n simp only [zero_add] at hi\n have hn' : (n : ℤ) ≠ 0 := by exact_mod_cast hn\n have : 2 * i + 1 = 0 := (mul_eq_zero.mp hi).resolve_left hn'\n omega\n · subst g\n have hp : (affineRepresentation (x ^ i * y ^ j * z ^ k * b)) ^ n = 1 := by\n simpa only [map_pow, map_one] using congrArg affineRepresentation hpow\n have happ := congrArg (fun f : Equiv.Perm Point => f ⟨0, 0, 0⟩) hp\n have hj := congrArg Point.j happ\n rw [perm_pow_j_of_shift _ (2 * j + 1) (affineTranslationB_j i j k) n] at hj\n simp only [zero_add] at hj\n have hn' : (n : ℤ) ≠ 0 := by exact_mod_cast hn\n have : 2 * j + 1 = 0 := (mul_eq_zero.mp hj).resolve_left hn'\n omega\n · subst g\n have hp : (affineRepresentation (x ^ i * y ^ j * z ^ k * (a * b))) ^ n = 1 := by\n simpa only [map_pow, map_one] using congrArg affineRepresentation hpow\n have happ := congrArg (fun f : Equiv.Perm Point => f ⟨0, 0, 0⟩) hp\n have hk := congrArg Point.k happ\n rw [perm_pow_k_of_shift _ (2 * k + 1) (affineTranslationAB_k i j k) n] at hk\n simp only [zero_add] at hk\n have hn' : (n : ℤ) ≠ 0 := by exact_mod_cast hn\n have : 2 * k + 1 = 0 := (mul_eq_zero.mp hk).resolve_left hn'\n omega\n\nprivate lemma affineRepresentation_eq_one (g : P) (hg : affineRepresentation g = 1) : g = 1 := by\n obtain ⟨i, j, k, h | h | h | h⟩ := exists_normal_form g\n · subst g\n have hv := congrArg (fun f : Equiv.Perm Point => f ⟨0, 0, 0⟩) hg\n rw [affineTranslation_apply] at hv\n have hi := congrArg Point.i hv\n have hj := congrArg Point.j hv\n have hk := congrArg Point.k hv\n simp at hi hj hk\n have : i = 0 ∧ j = 0 ∧ k = 0 := by omega\n rcases this with ⟨rfl, rfl, rfl⟩\n simp\n · subst g\n have hv := congrArg (fun f : Equiv.Perm Point => f ⟨0, 0, 0⟩) hg\n have hi := congrArg Point.i hv\n rw [affineTranslationA_i] at hi\n simp at hi\n omega\n · subst g\n have hv := congrArg (fun f : Equiv.Perm Point => f ⟨0, 0, 0⟩) hg\n have hj := congrArg Point.j hv\n rw [affineTranslationB_j] at hj\n simp at hj\n omega\n · subst g\n have hv := congrArg (fun f : Equiv.Perm Point => f ⟨0, 0, 0⟩) hg\n have hk := congrArg Point.k hv\n rw [affineTranslationAB_k] at hk\n simp at hk\n omega\n\nprivate lemma affineRepresentation_injective : Function.Injective affineRepresentation := by\n intro g h hgh\n apply eq_of_mul_inv_eq_one\n apply affineRepresentation_eq_one\n simp [hgh]\n\nprivate def T (i j k : ℤ) : P := x ^ i * y ^ j * z ^ k\n\nprivate def TA (i j k : ℤ) : P := T i j k * a\n\nprivate def TB (i j k : ℤ) : P := T i j k * b\n\nprivate def TAB (i j k : ℤ) : P := T i j k * (a * b)\n\nprivate lemma affineT_apply (i j k : ℤ) (v : Point) :\n affineRepresentation (T i j k) v = ⟨v.i + 2 * i, v.j + 2 * j, v.k + 2 * k⟩ := by\n simpa only [T] using affineTranslation_apply i j k v\n\nprivate lemma T_mul_T (i j k l m n : ℤ) :\n T i j k * T l m n = T (i + l) (j + m) (k + n) := by\n apply affineRepresentation_injective\n ext v\n simp only [map_mul, Equiv.Perm.mul_apply]\n rw [affineT_apply, affineT_apply, affineT_apply]\n rcases v with ⟨vi, vj, vk⟩\n simp [Point.mk.injEq]\n constructor <;> omega\n\nprivate lemma T_zero : T 0 0 0 = 1 := by\n simp [T]\n\nprivate lemma a_mul_T (i j k : ℤ) : (a : P) * T i j k = T i (-j) (-k) * a := by\n simp only [T]\n calc\n (a : P) * (x ^ i * y ^ j * z ^ k) =\n ((a : P) * (x ^ i * y ^ j * z ^ k) * (a : P)⁻¹) * a := by group\n _ = (x ^ i * y ^ (-j) * z ^ (-k)) * a := by rw [conjugate_translation_left_by_a]\n\nprivate lemma b_mul_T (i j k : ℤ) : (b : P) * T i j k = T (-i) j (-k) * b := by\n simp only [T]\n calc\n (b : P) * (x ^ i * y ^ j * z ^ k) =\n ((b : P) * (x ^ i * y ^ j * z ^ k) * (b : P)⁻¹) * b := by group\n _ = (x ^ (-i) * y ^ j * z ^ (-k)) * b := by rw [conjugate_translation_left_by_b]\n\nprivate lemma ab_mul_T (i j k : ℤ) :\n ((a : P) * b) * T i j k = T (-i) (-j) k * (a * b) := by\n calc\n ((a : P) * b) * T i j k = (a : P) * (b * T i j k) := by group\n _ = (a : P) * (T (-i) j (-k) * b) := by rw [b_mul_T]\n _ = ((a : P) * T (-i) j (-k)) * b := by group\n _ = (T (-i) (-j) (- -k) * a) * b := by rw [a_mul_T]\n _ = (T (-i) (-j) k * a) * b := by simp\n _ = T (-i) (-j) k * (a * b) := by group\n\nprivate lemma b_mul_a : (b : P) * a = T (-1) 1 (-1) * (a * b) := by\n apply affineRepresentation_injective\n ext v\n rcases v with ⟨vi, vj, vk⟩\n simp only [map_mul, affineRepresentation_a, affineRepresentation_b, Equiv.Perm.mul_apply]\n rw [affineT_apply]\n simp [affineA, affineB, Point.mk.injEq]\n omega\n\nprivate lemma b_mul_ab : (b : P) * (a * b) = T (-1) 0 (-1) * a := by\n apply affineRepresentation_injective\n ext v\n rcases v with ⟨vi, vj, vk⟩\n simp only [map_mul, affineRepresentation_a, affineRepresentation_b, Equiv.Perm.mul_apply]\n rw [affineT_apply]\n simp [affineA, affineB, Point.mk.injEq]\n omega\n\nprivate lemma ab_mul_a : ((a : P) * b) * a = T 0 (-1) 1 * b := by\n apply affineRepresentation_injective\n ext v\n rcases v with ⟨vi, vj, vk⟩\n simp only [map_mul, affineRepresentation_a, affineRepresentation_b, Equiv.Perm.mul_apply]\n rw [affineT_apply]\n simp [affineA, affineB, Point.mk.injEq]\n omega\n\nprivate lemma ab_mul_b : ((a : P) * b) * b = T 0 (-1) 0 * a := by\n apply affineRepresentation_injective\n ext v\n rcases v with ⟨vi, vj, vk⟩\n simp only [map_mul, affineRepresentation_a, affineRepresentation_b, Equiv.Perm.mul_apply]\n rw [affineT_apply]\n simp [affineA, affineB, Point.mk.injEq]\n omega\n\nprivate lemma a_mul_a : (a : P) * a = T 1 0 0 := by\n simp [T, x, pow_two]\n\nprivate lemma b_mul_b : (b : P) * b = T 0 1 0 := by\n simp [T, y, pow_two]\n\nprivate lemma ab_mul_ab : ((a : P) * b) * (a * b) = T 0 0 1 := by\n simp [T, z, pow_two]\n\nprivate lemma T_mul_TA (i j k l m n : ℤ) :\n T i j k * TA l m n = TA (i + l) (j + m) (k + n) := by\n unfold TA\n calc\n T i j k * (T l m n * a) = (T i j k * T l m n) * a := by group\n _ = T (i + l) (j + m) (k + n) * a := by rw [T_mul_T]\n\nprivate lemma T_mul_TB (i j k l m n : ℤ) :\n T i j k * TB l m n = TB (i + l) (j + m) (k + n) := by\n unfold TB\n calc\n T i j k * (T l m n * b) = (T i j k * T l m n) * b := by group\n _ = T (i + l) (j + m) (k + n) * b := by rw [T_mul_T]\n\nprivate lemma T_mul_TAB (i j k l m n : ℤ) :\n T i j k * TAB l m n = TAB (i + l) (j + m) (k + n) := by\n unfold TAB\n calc\n T i j k * (T l m n * (a * b)) = (T i j k * T l m n) * (a * b) := by group\n _ = T (i + l) (j + m) (k + n) * (a * b) := by rw [T_mul_T]\n\nprivate lemma TA_mul_T (i j k l m n : ℤ) :\n TA i j k * T l m n = TA (i + l) (j - m) (k - n) := by\n unfold TA\n calc\n (T i j k * a) * T l m n = T i j k * (a * T l m n) := by group\n _ = T i j k * (T l (-m) (-n) * a) := by rw [a_mul_T]\n _ = (T i j k * T l (-m) (-n)) * a := by group\n _ = T (i + l) (j + -m) (k + -n) * a := by rw [T_mul_T]\n _ = T (i + l) (j - m) (k - n) * a := by rfl\n\nprivate lemma TA_mul_TA (i j k l m n : ℤ) :\n TA i j k * TA l m n = T (i + l + 1) (j - m) (k - n) := by\n unfold TA\n calc\n (T i j k * a) * (T l m n * a) =\n T i j k * (a * T l m n) * a := by group\n _ = T i j k * (T l (-m) (-n) * a) * a := by rw [a_mul_T]\n _ = (T i j k * T l (-m) (-n)) * (a * a) := by group\n _ = T (i + l) (j + -m) (k + -n) * (a * a) := by rw [T_mul_T]\n _ = T (i + l) (j + -m) (k + -n) * T 1 0 0 := by rw [a_mul_a]\n _ = T (i + l + 1) (j - m) (k - n) := by\n rw [T_mul_T]\n simp [sub_eq_add_neg]\n\nprivate lemma TA_mul_TB (i j k l m n : ℤ) :\n TA i j k * TB l m n = TAB (i + l) (j - m) (k - n) := by\n unfold TA TB TAB\n calc\n (T i j k * a) * (T l m n * b) =\n T i j k * (a * T l m n) * b := by group\n _ = T i j k * (T l (-m) (-n) * a) * b := by rw [a_mul_T]\n _ = (T i j k * T l (-m) (-n)) * (a * b) := by group\n _ = T (i + l) (j + -m) (k + -n) * (a * b) := by rw [T_mul_T]\n _ = T (i + l) (j - m) (k - n) * (a * b) := by rfl\n\nprivate lemma TA_mul_TAB (i j k l m n : ℤ) :\n TA i j k * TAB l m n = TB (i + l + 1) (j - m) (k - n) := by\n unfold TA TAB TB\n calc\n (T i j k * a) * (T l m n * (a * b)) =\n T i j k * (a * T l m n) * (a * b) := by group\n _ = T i j k * (T l (-m) (-n) * a) * (a * b) := by rw [a_mul_T]\n _ = (T i j k * T l (-m) (-n)) * (a * a) * b := by group\n _ = T (i + l) (j + -m) (k + -n) * (a * a) * b := by rw [T_mul_T]\n _ = (T (i + l) (j + -m) (k + -n) * T 1 0 0) * b := by rw [a_mul_a]\n _ = T (i + l + 1) (j - m) (k - n) * b := by\n rw [T_mul_T]\n simp [sub_eq_add_neg]\n\nprivate lemma TB_mul_T (i j k l m n : ℤ) :\n TB i j k * T l m n = TB (i - l) (j + m) (k - n) := by\n unfold TB\n calc\n (T i j k * b) * T l m n = T i j k * (b * T l m n) := by group\n _ = T i j k * (T (-l) m (-n) * b) := by rw [b_mul_T]\n _ = (T i j k * T (-l) m (-n)) * b := by group\n _ = T (i + -l) (j + m) (k + -n) * b := by rw [T_mul_T]\n _ = T (i - l) (j + m) (k - n) * b := by rfl\n\nprivate lemma TB_mul_TA (i j k l m n : ℤ) :\n TB i j k * TA l m n = TAB (i - l - 1) (j + m + 1) (k - n - 1) := by\n unfold TB TA TAB\n calc\n (T i j k * b) * (T l m n * a) =\n T i j k * (b * T l m n) * a := by group\n _ = T i j k * (T (-l) m (-n) * b) * a := by rw [b_mul_T]\n _ = (T i j k * T (-l) m (-n)) * (b * a) := by group\n _ = T (i + -l) (j + m) (k + -n) * (b * a) := by rw [T_mul_T]\n _ = T (i + -l) (j + m) (k + -n) * (T (-1) 1 (-1) * (a * b)) := by rw [b_mul_a]\n _ = (T (i + -l) (j + m) (k + -n) * T (-1) 1 (-1)) * (a * b) := by group\n _ = T (i - l - 1) (j + m + 1) (k - n - 1) * (a * b) := by\n rw [T_mul_T]\n rfl\n\nprivate lemma TB_mul_TB (i j k l m n : ℤ) :\n TB i j k * TB l m n = T (i - l) (j + m + 1) (k - n) := by\n unfold TB\n calc\n (T i j k * b) * (T l m n * b) =\n T i j k * (b * T l m n) * b := by group\n _ = T i j k * (T (-l) m (-n) * b) * b := by rw [b_mul_T]\n _ = (T i j k * T (-l) m (-n)) * (b * b) := by group\n _ = T (i + -l) (j + m) (k + -n) * (b * b) := by rw [T_mul_T]\n _ = T (i + -l) (j + m) (k + -n) * T 0 1 0 := by rw [b_mul_b]\n _ = T (i - l) (j + m + 1) (k - n) := by\n rw [T_mul_T]\n simp [sub_eq_add_neg]\n\nprivate lemma TB_mul_TAB (i j k l m n : ℤ) :\n TB i j k * TAB l m n = TA (i - l - 1) (j + m) (k - n - 1) := by\n unfold TB TAB TA\n calc\n (T i j k * b) * (T l m n * (a * b)) =\n T i j k * (b * T l m n) * (a * b) := by group\n _ = T i j k * (T (-l) m (-n) * b) * (a * b) := by rw [b_mul_T]\n _ = (T i j k * T (-l) m (-n)) * (b * (a * b)) := by group\n _ = T (i + -l) (j + m) (k + -n) * (b * (a * b)) := by rw [T_mul_T]\n _ = T (i + -l) (j + m) (k + -n) * (T (-1) 0 (-1) * a) := by rw [b_mul_ab]\n _ = (T (i + -l) (j + m) (k + -n) * T (-1) 0 (-1)) * a := by group\n _ = T (i - l - 1) (j + m) (k - n - 1) * a := by\n rw [T_mul_T]\n simp [sub_eq_add_neg]\n\nprivate lemma TAB_mul_T (i j k l m n : ℤ) :\n TAB i j k * T l m n = TAB (i - l) (j - m) (k + n) := by\n unfold TAB\n calc\n (T i j k * (a * b)) * T l m n = T i j k * ((a * b) * T l m n) := by group\n _ = T i j k * (T (-l) (-m) n * (a * b)) := by rw [ab_mul_T]\n _ = (T i j k * T (-l) (-m) n) * (a * b) := by group\n _ = T (i + -l) (j + -m) (k + n) * (a * b) := by rw [T_mul_T]\n _ = T (i - l) (j - m) (k + n) * (a * b) := by rfl\n\nprivate lemma TAB_mul_TA (i j k l m n : ℤ) :\n TAB i j k * TA l m n = TB (i - l) (j - m - 1) (k + n + 1) := by\n unfold TAB TA TB\n calc\n (T i j k * (a * b)) * (T l m n * a) =\n T i j k * ((a * b) * T l m n) * a := by group\n _ = T i j k * (T (-l) (-m) n * (a * b)) * a := by rw [ab_mul_T]\n _ = (T i j k * T (-l) (-m) n) * ((a * b) * a) := by group\n _ = T (i + -l) (j + -m) (k + n) * ((a * b) * a) := by rw [T_mul_T]\n _ = T (i + -l) (j + -m) (k + n) * (T 0 (-1) 1 * b) := by rw [ab_mul_a]\n _ = (T (i + -l) (j + -m) (k + n) * T 0 (-1) 1) * b := by group\n _ = T (i - l) (j - m - 1) (k + n + 1) * b := by\n rw [T_mul_T]\n simp [sub_eq_add_neg]\n\nprivate lemma TAB_mul_TB (i j k l m n : ℤ) :\n TAB i j k * TB l m n = TA (i - l) (j - m - 1) (k + n) := by\n unfold TAB TB TA\n calc\n (T i j k * (a * b)) * (T l m n * b) =\n T i j k * ((a * b) * T l m n) * b := by group\n _ = T i j k * (T (-l) (-m) n * (a * b)) * b := by rw [ab_mul_T]\n _ = (T i j k * T (-l) (-m) n) * ((a * b) * b) := by group\n _ = T (i + -l) (j + -m) (k + n) * ((a * b) * b) := by rw [T_mul_T]\n _ = T (i + -l) (j + -m) (k + n) * (T 0 (-1) 0 * a) := by rw [ab_mul_b]\n _ = (T (i + -l) (j + -m) (k + n) * T 0 (-1) 0) * a := by group\n _ = T (i - l) (j - m - 1) (k + n) * a := by\n rw [T_mul_T]\n simp [sub_eq_add_neg]\n\nprivate lemma TAB_mul_TAB (i j k l m n : ℤ) :\n TAB i j k * TAB l m n = T (i - l) (j - m) (k + n + 1) := by\n unfold TAB\n calc\n (T i j k * (a * b)) * (T l m n * (a * b)) =\n T i j k * ((a * b) * T l m n) * (a * b) := by group\n _ = T i j k * (T (-l) (-m) n * (a * b)) * (a * b) := by rw [ab_mul_T]\n _ = (T i j k * T (-l) (-m) n) * ((a * b) * (a * b)) := by group\n _ = T (i + -l) (j + -m) (k + n) * ((a * b) * (a * b)) := by rw [T_mul_T]\n _ = T (i + -l) (j + -m) (k + n) * T 0 0 1 := by rw [ab_mul_ab]\n _ = T (i - l) (j - m) (k + n + 1) := by\n rw [T_mul_T]\n simp [sub_eq_add_neg]\n\nprivate def U : R :=\n T 0 0 0 + T 1 0 0 + T 0 1 0 + T 1 1 0 +\n T 0 0 (-1) + T 1 0 (-1) + T 0 1 (-1) + T 1 1 (-1) +\n TA (-1) (-1) 0 + TA 1 0 0 + TA 0 (-1) 1 + TA 0 0 1 +\n TB 0 0 0 + TB 1 0 0 + TB 0 (-1) 1 + TB 1 1 1 +\n TAB 0 0 0 + TAB 1 0 (-1) + TAB (-1) 0 (-1) + TAB 0 1 (-1) + TAB 0 (-1) (-1)\n\nprivate def V : R :=\n T 0 0 0 + T (-1) 0 0 + T 0 (-1) 0 + T (-1) (-1) 0 +\n T 0 0 1 + T (-1) 0 1 + T 0 (-1) 1 + T (-1) (-1) 1 +\n TA (-2) (-1) 0 + TA (-1) (-1) 1 + TA (-1) 0 1 + TA 0 0 0 +\n TB 0 (-2) 1 + TB 0 (-1) 0 + TB 1 (-1) 0 + TB 1 0 1 +\n TAB (-1) 0 0 + TAB 0 (-1) 0 + TAB 0 0 (-1) + TAB 0 1 0 + TAB 1 0 0\n\nprivate lemma u_eq_U : u = U := by\n simp [u, p, q, r, s, U, T, TA, TB, TAB, add_mul, mul_add]\n module\n\nprivate def oneCoeff : ZMod 2 := 1\n\nprivate lemma oneCoeff_smul (w : R) : oneCoeff • w = w := by\n simp [oneCoeff]\n\nprivate lemma U_mul_V : U * V = 1 := by\n simp [U, V, T_mul_T, T_mul_TA, T_mul_TB, T_mul_TAB,\n TA_mul_T, TA_mul_TA, TA_mul_TB, TA_mul_TAB,\n TB_mul_T, TB_mul_TA, TB_mul_TB, TB_mul_TAB,\n TAB_mul_T, TAB_mul_TA, TAB_mul_TB, TAB_mul_TAB,\n T_zero, add_mul, mul_add]\n rw [← oneCoeff_smul (1 : R)]\n match_scalars\n all_goals decide\n\nprivate lemma V_mul_U : V * U = 1 := by\n simp [U, V, T_mul_T, T_mul_TA, T_mul_TB, T_mul_TAB,\n TA_mul_T, TA_mul_TA, TA_mul_TB, TA_mul_TAB,\n TB_mul_T, TB_mul_TA, TB_mul_TB, TB_mul_TAB,\n TAB_mul_T, TAB_mul_TA, TAB_mul_TB, TAB_mul_TAB,\n T_zero, add_mul, mul_add]\n rw [← oneCoeff_smul (1 : R)]\n match_scalars\n all_goals decide\n\nprivate def unitU : Rˣ where\n val := U\n inv := V\n val_inv := U_mul_V\n inv_val := V_mul_U\n\nprivate lemma isUnit_u : IsUnit u := by\n rw [u_eq_U]\n exact unitU.isUnit\n\n@[simp] private lemma T_eq_T_iff (i j k l m n : ℤ) :\n T i j k = T l m n ↔ i = l ∧ j = m ∧ k = n := by\n constructor\n · intro h\n have hv := congrArg (fun g : P => affineRepresentation g ⟨0, 0, 0⟩) h\n rw [affineT_apply, affineT_apply] at hv\n have hi := congrArg Point.i hv\n have hj := congrArg Point.j hv\n have hk := congrArg Point.k hv\n simp at hi hj hk\n exact ⟨by omega, by omega, by omega⟩\n · rintro ⟨rfl, rfl, rfl⟩\n rfl\n\nprivate lemma affineTA_i (i j k : ℤ) (v : Point) :\n (affineRepresentation (TA i j k) v).i = v.i + (2 * i + 1) := by\n simpa only [TA, T] using affineTranslationA_i i j k v\n\nprivate lemma affineTB_j (i j k : ℤ) (v : Point) :\n (affineRepresentation (TB i j k) v).j = v.j + (2 * j + 1) := by\n simpa only [TB, T] using affineTranslationB_j i j k v\n\nprivate lemma affineTAB_k (i j k : ℤ) (v : Point) :\n (affineRepresentation (TAB i j k) v).k = v.k + (2 * k + 1) := by\n simpa only [TAB, T] using affineTranslationAB_k i j k v\n\n@[simp] private lemma TA_ne_T (i j k l m n : ℤ) : TA i j k ≠ T l m n := by\n intro h\n have hv := congrArg (fun g : P => affineRepresentation g ⟨0, 0, 0⟩) h\n have hi := congrArg Point.i hv\n rw [affineTA_i, affineT_apply] at hi\n simp at hi\n omega\n\n@[simp] private lemma TB_ne_T (i j k l m n : ℤ) : TB i j k ≠ T l m n := by\n intro h\n have hv := congrArg (fun g : P => affineRepresentation g ⟨0, 0, 0⟩) h\n have hj := congrArg Point.j hv\n rw [affineTB_j, affineT_apply] at hj\n simp at hj\n omega\n\n@[simp] private lemma TAB_ne_T (i j k l m n : ℤ) : TAB i j k ≠ T l m n := by\n intro h\n have hv := congrArg (fun g : P => affineRepresentation g ⟨0, 0, 0⟩) h\n have hk := congrArg Point.k hv\n rw [affineTAB_k, affineT_apply] at hk\n simp at hk\n omega\n\nprivate lemma U_apply_T_zero : U.coeff (T 0 0 0) = 1 := by\n simp [U, MonoidAlgebra.of_apply]\n\nprivate lemma U_apply_T_x : U.coeff (T 1 0 0) = 1 := by\n simp [U, MonoidAlgebra.of_apply]\n\nprivate lemma u_not_monomial : ¬ ∃ g : P, u = g := by\n rintro ⟨g, h⟩\n have hU : U = (g : R) := u_eq_U.symm.trans h\n have hzero := congrArg (fun w : R => w.coeff (T 0 0 0)) hU\n have hx := congrArg (fun w : R => w.coeff (T 1 0 0)) hU\n rw [U_apply_T_zero] at hzero\n rw [U_apply_T_x] at hx\n have hgzero : g = T 0 0 0 := by\n by_contra hne\n simp [MonoidAlgebra.of_apply, hne] at hzero\n have hgx : g = T 1 0 0 := by\n by_contra hne\n simp [MonoidAlgebra.of_apply, hne] at hx\n have htx : T 0 0 0 = T 1 0 0 := hgzero.symm.trans hgx\n have := (T_eq_T_iff 0 0 0 1 0 0).mp htx\n omega\n\ntheorem theorem_A : (∀ g : P, ∀ n ≠ 0, g ^ n = 1 → g = 1) ∧ IsUnit u ∧ ¬ ∃ g : P, u = g := by\n exact ⟨torsion_free_P, isUnit_u, u_not_monomial⟩\n\nend\n\nend Submission\n" } ], "official": { "statementRevision": 1, "submissionUrl": "https://github.com/leanprover/lean-eval-submissions/issues/1246", "resultUrl": "https://github.com/leanprover/lean-eval-submissions/issues/1246#issuecomment-5380977645", "resultBody": "## Submission result\n\n✅ Newly-solved problems: annals_unit_conjecture\n\nAttempted 1 / 1; succeeded on 1.\n\n### Per-problem\n- `annals_unit_conjecture`: pass", "sourceUrl": "https://gist.github.com/LikC1606/7570e284ff8b474a4139db2092de6eec/1062b1e6c3d5bda6ae4a218e41bd34dbf11a2c35", "sourceCommit": "1062b1e6c3d5bda6ae4a218e41bd34dbf11a2c35", "checksums": { "Submission.lean": "5b0740de41cc47385273cb26195b3c7f08e50fa349edfa36489731b6ba10f062", "lakefile.toml": "27369d856ec9815ed11b8aac39b1ae99b080c41da610edc559a6490c23c5f9b1" } } } ] }