diff --git a/LeanPool/LiebThirring.lean b/LeanPool/LiebThirring.lean new file mode 100644 index 0000000000..bcf3208909 --- /dev/null +++ b/LeanPool/LiebThirring.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ + +module + +public import LeanPool.LiebThirring.Theorems.Baxter +public import LeanPool.LiebThirring.Theorems.KineticEnergySchwartz +public import LeanPool.LiebThirring.Theorems.KineticLiebThirring +public import LeanPool.LiebThirring.Theorems.StabilityOfMatter +public import LeanPool.LiebThirring.Theorems.StabilityOfMatterReal + +/-! +# Stability of matter and the kinetic Lieb–Thirring inequality + +Source: arxiv:2007.09326, url:https://github.com/scottnarmstrong/LiebThirring/tree/8bf4656f07f5aaa227b0b850d77b16976915bbd4 +Authors: Scott Armstrong, Amélie Loher +Status: verified +Main declarations: `LiebThirring.stability_of_matter` +Tags: mathematical-physics, stability-of-matter, lieb-thirring, coulomb-energy, fourier-analysis +MSC: 81Q10, 35P15, 46N50 +-/ + +/-! +# Stability of non-relativistic Coulomb matter + +The stability, kinetic and electrostatic dependency closure from Armstrong and Loher. +Imported from +https://github.com/scottnarmstrong/LiebThirring/tree/8bf4656f07f5aaa227b0b850d77b16976915bbd4. +The upstream ionization, thermodynamic-limit and Thomas–Fermi developments are separate from this +scope. + +The kinetic and stability formulations follow Frank, arXiv:2007.09326, Section 2. +The explicit Rumin coefficient and Baxter correction follow Lundholm’s lecture notes, +Theorems 6.1 and 7.2; this import does not assert an optimal kinetic constant. +Lundholm’s notes: https://www.math.lmu.de/~lundholm/methmmp.pdf. + +Scott Armstrong acknowledges ERC grant No. 101200828. Amélie Loher acknowledges support from the +Fondation Sciences Mathématiques de Paris. +-/ diff --git a/LeanPool/LiebThirring/Analysis/FundamentalSolution.lean b/LeanPool/LiebThirring/Analysis/FundamentalSolution.lean new file mode 100644 index 0000000000..6899e88396 --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/FundamentalSolution.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Analysis.FundamentalSolutionMeasures +import LeanPool.LiebThirring.Analysis.FundamentalSolutionApproximation +import LeanPool.LiebThirring.Analysis.FundamentalSolutionLimits + +/-! +# The three-dimensional Coulomb fundamental solution + +The Coulomb fundamental-solution identity, the fundamental solution. Together with +`integrable_inv_norm_sub_mul_laplacian`, this asserts absolute integrability and the value of +the pairing. `C²` suffices, so in particular the identity holds for every smooth compactly +supported test. + +A finite positive charge with bounded extended potential satisfies the test-function identity +the fundamental solution. Local integrability is supplied by +`locallyIntegrable_coulombPotential_toReal`, and absolute test-pairing integrability by +`integrable_coulombPotential_toReal_mul_laplacian`. +-/ + +public section + +open MeasureTheory Filter InnerProductSpace Laplacian +open scoped Topology ENNReal + +namespace LiebThirring + +/-- The Coulomb fundamental-solution identity, the fundamental solution. +Together with `integrable_inv_norm_sub_mul_laplacian`, this asserts absolute +integrability and the value of the pairing. `C²` suffices, so in particular +the identity holds for every smooth compactly supported test. -/ +theorem integral_inv_norm_sub_mul_laplacian {f : Position → ℝ} + (hf : ContDiff ℝ 2 f) (hfc : HasCompactSupport f) (y : Position) : + (∫ x, ‖x - y‖⁻¹ * Δ f x) = -4 * Real.pi * f y := by + have hleft := tendsto_integral_regularizedCoulombKernel_sub_mul_laplacian hf hfc y + have hright := (tendsto_integral_coulombApproximationDensity_sub_mul + hf.continuous hfc y).neg + have ht : Tendsto (fun ε : ℝ => ∫ x, regularizedCoulombKernel ε (x - y) * Δ f x) + (𝓝[>] 0) (𝓝 (-4 * Real.pi * f y)) := by + have h := hright.congr' (by + filter_upwards [self_mem_nhdsWithin] with ε (hε : 0 < ε) + exact (integral_regularizedCoulombKernel_sub_mul_laplacian hε hf hfc y).symm) + simpa only [neg_mul] using h + exact tendsto_nhds_unique hleft ht + +/-- A finite positive charge with bounded extended potential satisfies +the test-function identity the fundamental solution. Local integrability is supplied by +`locallyIntegrable_coulombPotential_toReal`, and absolute test-pairing +integrability by `integrable_coulombPotential_toReal_mul_laplacian`. -/ +theorem integral_coulombPotential_toReal_mul_laplacian + (β : Measure Position) [IsFiniteMeasure β] {C : ℝ≥0∞} + (hC : C ≠ ⊤) (hβ : ∀ x, coulombPotential β x ≤ C) + {f : Position → ℝ} (hf : ContDiff ℝ 2 f) (hfc : HasCompactSupport f) : + (∫ x, (coulombPotential β x).toReal * Δ f x) = -4 * Real.pi * ∫ y, f y ∂β := by + rw [integral_coulombPotential_toReal_mul_laplacian_eq_integral_integral β hC hβ hf hfc] + simp_rw [integral_inv_norm_sub_mul_laplacian hf hfc] + exact integral_const_mul _ _ + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Analysis/FundamentalSolutionApproximation.lean b/LeanPool/LiebThirring/Analysis/FundamentalSolutionApproximation.lean new file mode 100644 index 0000000000..e0bff5fec1 --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/FundamentalSolutionApproximation.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Analysis.FundamentalSolutionRadial + +/-! +# Approximate identity from the regularized Coulomb density + +Scaling of the fundamental solution's regularization density in physical dimension three. + +The density pairing can be evaluated after dilating about its pole. +-/ + +public section + +open MeasureTheory Filter Set +open scoped Topology + +namespace LiebThirring + +/-- Scaling of the fundamental solution's regularization density in physical dimension three. -/ +theorem coulombApproximationDensity_smul {ε : ℝ} (hε : 0 < ε) (x : Position) : + coulombApproximationDensity ε (ε • x) = + (ε ^ 3)⁻¹ * coulombApproximationDensity 1 x := by + unfold coulombApproximationDensity + rw [norm_smul, Real.norm_eq_abs, abs_of_pos hε] + have hs : (ε * ‖x‖) ^ 2 + ε ^ 2 = ε ^ 2 * (‖x‖ ^ 2 + 1) := by ring + rw [hs, Real.mul_rpow (sq_nonneg _) (by positivity)] + have hp : (ε ^ 2) ^ (-(5 / 2 : ℝ)) = (ε ^ 5)⁻¹ := by + rw [← Real.rpow_natCast ε 2, ← Real.rpow_mul hε.le] + norm_num + rw [hp] + norm_num only [one_pow, mul_one] + field_simp [hε.ne'] + +/-- The density pairing can be evaluated after dilating about its pole. -/ +theorem integral_coulombApproximationDensity_sub_mul {ε : ℝ} (hε : 0 < ε) + (f : Position → ℝ) (y : Position) : + (∫ x, coulombApproximationDensity ε (x - y) * f x) = + ∫ x, coulombApproximationDensity 1 x * f (y + ε • x) := by + have ht : (∫ x, coulombApproximationDensity ε (x - y) * f x) = + ∫ x, coulombApproximationDensity ε x * f (y + x) := by + have h := integral_add_right_eq_self y (μ := (volume : Measure Position)) + (f := fun x => coulombApproximationDensity ε (x - y) * f x) + calc + _ = ∫ x, coulombApproximationDensity ε x * f (x + y) := by + simpa only [add_sub_cancel_right] using h.symm + _ = _ := by + apply integral_congr_ae + filter_upwards with x + rw [add_comm x y] + rw [ht] + have h := Measure.integral_comp_smul_of_nonneg (volume : Measure Position) + (fun x => coulombApproximationDensity ε x * f (y + x)) ε (hR := hε.le) + simp only [Position, finrank_euclideanSpace_fin, smul_eq_mul] at h + simp_rw [coulombApproximationDensity_smul hε] at h + rw [show (fun x => (ε ^ 3)⁻¹ * coulombApproximationDensity 1 x * f (y + ε • x)) = + (fun x => (ε ^ 3)⁻¹ * (coulombApproximationDensity 1 x * f (y + ε • x))) by + funext x; ring, integral_const_mul] at h + exact (mul_left_cancel₀ (inv_ne_zero (pow_ne_zero _ hε.ne')) h).symm + +/-- The regularized density converges to a point mass of weight `4π`. -/ +theorem tendsto_integral_coulombApproximationDensity_sub_mul + {f : Position → ℝ} (hf : Continuous f) (hfc : HasCompactSupport f) (y : Position) : + Tendsto (fun ε : ℝ => ∫ x, coulombApproximationDensity ε (x - y) * f x) + (𝓝[>] 0) (𝓝 (4 * Real.pi * f y)) := by + obtain ⟨M, hM⟩ := (hfc.isCompact_range hf).isBounded.exists_norm_le + have hbound (x : Position) : ‖f x‖ ≤ M := hM (f x) (mem_range_self x) + have ht : Tendsto (fun ε : ℝ => + ∫ x, coulombApproximationDensity 1 x * f (y + ε • x)) (𝓝[>] 0) + (𝓝 (∫ x, coulombApproximationDensity 1 x * f y)) := by + apply tendsto_integral_filter_of_dominated_convergence + (fun x => coulombApproximationDensity 1 x * M) + · filter_upwards with ε + have hq : Continuous (coulombApproximationDensity 1) := by + unfold coulombApproximationDensity + apply Continuous.mul continuous_const + exact ((continuous_norm.pow 2).add continuous_const).rpow_const + (fun x => Or.inl (norm_sq_add_sq_pos zero_lt_one x).ne') + have hm : Continuous (fun x : Position => y + ε • x) := + continuous_const.add (continuous_id.const_smul ε) + exact (hq.mul (hf.comp hm)).aestronglyMeasurable + · filter_upwards with ε + filter_upwards with x + rw [norm_mul, Real.norm_eq_abs, abs_of_nonneg (coulombApproximationDensity_nonneg _ _)] + exact mul_le_mul_of_nonneg_left (hbound _) (coulombApproximationDensity_nonneg _ _) + · exact integrable_coulombApproximationDensity_one.mul_const M + · filter_upwards with x + have hi : Tendsto (fun ε : ℝ => y + ε • x) (𝓝[>] 0) (𝓝 y) := by + have hiε : Tendsto (fun ε : ℝ => ε) (𝓝[>] 0) (𝓝 0) := + tendsto_id.mono_left nhdsWithin_le_nhds + simpa only [zero_smul, add_zero] using + (tendsto_const_nhds (x := y)).add (hiε.smul (tendsto_const_nhds (x := x))) + exact tendsto_const_nhds.mul ((hf.tendsto y).comp hi) + rw [integral_mul_const, integral_coulombApproximationDensity_one] at ht + apply ht.congr' + filter_upwards [self_mem_nhdsWithin] with ε (hε : 0 < ε) + exact (integral_coulombApproximationDensity_sub_mul hε f y).symm + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Analysis/FundamentalSolutionIntegrability.lean b/LeanPool/LiebThirring/Analysis/FundamentalSolutionIntegrability.lean new file mode 100644 index 0000000000..5ec229a1b1 --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/FundamentalSolutionIntegrability.lean @@ -0,0 +1,123 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.MeasureTheory.Function.LocallyIntegrable +public import Mathlib.Analysis.InnerProductSpace.Laplacian +public import LeanPool.LiebThirring.Electrostatics.Basic +import all LeanPool.LiebThirring.Electrostatics.Basic +import LeanPool.LiebThirring.Electrostatics.SphereRadial +import LeanPool.LiebThirring.Analysis.WeakHarmonicConvolution + +/-! +# Integrability for the three-dimensional fundamental solution + +The real inverse-norm kernel is integrable on every ball about its pole. + +The inverse-norm singularity is locally integrable in three dimensions. +-/ + +public section + +open MeasureTheory Set Metric InnerProductSpace Laplacian +open scoped Topology ENNReal + +namespace LiebThirring + +/-- The real inverse-norm kernel is integrable on every ball about its pole. -/ +theorem integrableOn_inv_norm_sub_ball (y : Position) (R : ℝ) : + IntegrableOn (fun x : Position => ‖x - y‖⁻¹) (ball y R) := by + have hzero : IntegrableOn (fun x : Position => ‖x‖⁻¹) (ball 0 R) := by + apply (integrableOn_fun_norm_addHaar (volume : Measure Position)).mpr + simp only [Position, finrank_euclideanSpace_fin, Nat.reduceSub, smul_eq_mul] + have hr : IntegrableOn (fun r : ℝ => r) (Ioo 0 R) := + continuous_id.integrableOn_Icc.mono_set Ioo_subset_Icc_self + apply hr.congr_fun _ measurableSet_Ioo + intro r hr + field_simp + have hpre : (fun x : Position => x - y) ⁻¹' ball 0 R = ball y R := by + ext x + simp only [mem_preimage, mem_ball, dist_eq_norm, sub_zero] + have he := (Homeomorph.subRight y).measurableEmbedding + simpa only [Function.comp_def, hpre] using + ((measurePreserving_sub_right (volume : Measure Position) y).integrableOn_comp_preimage + he).mpr hzero + +/-- The inverse-norm singularity is locally integrable in three dimensions. -/ +theorem locallyIntegrable_inv_norm_sub (y : Position) : + LocallyIntegrable (fun x : Position => ‖x - y‖⁻¹) := by + intro x + refine ⟨ball y (‖x - y‖ + 1), isOpen_ball.mem_nhds ?_, + integrableOn_inv_norm_sub_ball y _⟩ + rw [mem_ball, dist_eq_norm] + exact lt_add_one _ + +/-- A `C²` function has continuous Mathlib Laplacian on `Position`. -/ +theorem continuous_laplacian_position {f : Position → ℝ} (hf : ContDiff ℝ 2 f) : + Continuous (Δ f) := by + have heq : Δ f = fun x => ∑ i, + fderiv ℝ (fderiv ℝ f) x ((stdOrthonormalBasis ℝ Position) i) + ((stdOrthonormalBasis ℝ Position) i) := by + funext x + simp only [laplacian_eq_iteratedFDeriv_stdOrthonormalBasis, + iteratedFDeriv_two_apply, Matrix.cons_val_zero, Matrix.cons_val_one] + rw [heq] + exact continuous_finsetSum _ (fun i _ => continuous_kernel_hessian hf _ _) + +/-- Taking the Laplacian preserves compact support. -/ +theorem hasCompactSupport_laplacian_position {f : Position → ℝ} + (hf : HasCompactSupport f) : HasCompactSupport (Δ f) := by + have heq : Δ f = ∑ i, + (fun x => fderiv ℝ (fderiv ℝ f) x ((stdOrthonormalBasis ℝ Position) i) + ((stdOrthonormalBasis ℝ Position) i)) := by + funext x + simp only [laplacian_eq_iteratedFDeriv_stdOrthonormalBasis, + iteratedFDeriv_two_apply, Matrix.cons_val_zero, Matrix.cons_val_one, Finset.sum_apply] + rw [heq] + exact HasCompactSupport.finset_sum (fun i _ => hasCompactSupport_kernel_hessian hf _ _) + +/-- Absolute integrability in the fundamental solution, before the distributional identity. -/ +theorem integrable_inv_norm_sub_mul_laplacian {f : Position → ℝ} + (hf : ContDiff ℝ 2 f) (hfc : HasCompactSupport f) (y : Position) : + Integrable (fun x => ‖x - y‖⁻¹ * Δ f x) := + (locallyIntegrable_inv_norm_sub y).integrable_smul_right_of_hasCompactSupport + (continuous_laplacian_position hf) (hasCompactSupport_laplacian_position hfc) + +/-- The shared extended potential is measurable for an s-finite charge. -/ +theorem measurable_coulombPotential (β : Measure Position) [SFinite β] : + Measurable (coulombPotential β) := by + unfold coulombPotential + have hK : Measurable (Function.uncurry coulombKernel) := + ((measurable_fst.sub measurable_snd).norm.ennreal_ofReal).inv + exact hK.lintegral_prod_right (ν := β) + +/-- Bounded extended Coulomb potentials are locally integrable after `toReal`. +The bound is on the extended potential, so it also asserts finiteness everywhere. -/ +theorem locallyIntegrable_coulombPotential_toReal (β : Measure Position) [SFinite β] + {C : ℝ≥0∞} (hC : C ≠ ⊤) (hβ : ∀ x, coulombPotential β x ≤ C) : + LocallyIntegrable (fun x => (coulombPotential β x).toReal) := by + apply (locallyIntegrable_const (c := C.toReal)).mono + (measurable_coulombPotential β).ennreal_toReal.aestronglyMeasurable + filter_upwards with x + rw [Real.norm_eq_abs, abs_of_nonneg ENNReal.toReal_nonneg, + Real.norm_eq_abs, abs_of_nonneg ENNReal.toReal_nonneg] + exact ENNReal.toReal_mono hC (hβ x) + +/-- The left-hand test-function pairing in the fundamental solution is absolutely integrable. -/ +theorem integrable_coulombPotential_toReal_mul_laplacian + (β : Measure Position) [SFinite β] {C : ℝ≥0∞} + (hC : C ≠ ⊤) (hβ : ∀ x, coulombPotential β x ≤ C) + {f : Position → ℝ} (hf : ContDiff ℝ 2 f) (hfc : HasCompactSupport f) : + Integrable (fun x => (coulombPotential β x).toReal * Δ f x) := + (locallyIntegrable_coulombPotential_toReal β hC hβ).integrable_smul_right_of_hasCompactSupport + (continuous_laplacian_position hf) (hasCompactSupport_laplacian_position hfc) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Analysis/FundamentalSolutionIntegrationByParts.lean b/LeanPool/LiebThirring/Analysis/FundamentalSolutionIntegrationByParts.lean new file mode 100644 index 0000000000..f0c2331058 --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/FundamentalSolutionIntegrationByParts.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.Calculus.LineDeriv.IntegrationByParts +public import LeanPool.LiebThirring.Analysis.FundamentalSolutionIntegrability +import LeanPool.LiebThirring.Analysis.WeakHarmonicConvolution + +/-! +# Compact-test integration by parts for the Laplacian + +Evaluation of the first Fréchet derivative in a fixed direction commutes with differentiation. + +Two integrations by parts in one direction, with a compactly supported test. +-/ + +public section + +open MeasureTheory InnerProductSpace Laplacian + +namespace LiebThirring + +/-- Evaluation of the first Fréchet derivative in a fixed direction +commutes with differentiation. -/ +theorem fderiv_directional_fderiv {f : Position → ℝ} (hf : ContDiff ℝ 2 f) + (x u v : Position) : + fderiv ℝ (fun z => fderiv ℝ f z v) x u = + fderiv ℝ (fderiv ℝ f) x u v := by + have hd : ContDiff ℝ 1 (fderiv ℝ f) := hf.fderiv_right (by norm_num) + rw [fderiv_clm_apply (hd.differentiable one_ne_zero x) (differentiableAt_const v)] + rw [(hasFDerivAt_const v x).fderiv] + simp only [ContinuousLinearMap.comp_zero, zero_add, ContinuousLinearMap.flip_apply] + +/-- Two integrations by parts in one direction, with a compactly supported test. -/ +theorem integral_mul_hessian_eq_integral_hessian_mul + {u f : Position → ℝ} (hu : ContDiff ℝ 2 u) (hf : ContDiff ℝ 2 f) + (hfc : HasCompactSupport f) (v : Position) : + (∫ x, u x * fderiv ℝ (fderiv ℝ f) x v v) = + ∫ x, fderiv ℝ (fderiv ℝ u) x v v * f x := by + let du := fun x => fderiv ℝ u x v + let df := fun x => fderiv ℝ f x v + have hdu : ContDiff ℝ 1 du := + (hu.fderiv_right (by norm_num)).clm_apply contDiff_const + have hdf : ContDiff ℝ 1 df := + (hf.fderiv_right (by norm_num)).clm_apply contDiff_const + have hdfc : HasCompactSupport df := + (hfc.fderiv ℝ).comp_left (map_zero (ContinuousLinearMap.apply ℝ ℝ v)) + have hdf' (x : Position) : fderiv ℝ df x v = fderiv ℝ (fderiv ℝ f) x v v := + fderiv_directional_fderiv hf x v v + have hdu' (x : Position) : fderiv ℝ du x v = fderiv ℝ (fderiv ℝ u) x v v := + fderiv_directional_fderiv hu x v v + have hfirst : (∫ x, u x * fderiv ℝ df x v) = - ∫ x, du x * df x := by + apply integral_mul_fderiv_eq_neg_fderiv_mul_of_integrable + · exact (hdu.continuous.mul hdf.continuous).integrable_of_hasCompactSupport hdfc.mul_left + · simp_rw [hdf'] + exact (hu.continuous.mul (continuous_kernel_hessian hf v v)).integrable_of_hasCompactSupport + (hasCompactSupport_kernel_hessian hfc v v).mul_left + · exact (hu.continuous.mul hdf.continuous).integrable_of_hasCompactSupport hdfc.mul_left + · exact fun x _ => hu.differentiable (by norm_num) x + · exact fun x _ => hdf.differentiable one_ne_zero x + have hsecond : (∫ x, du x * fderiv ℝ f x v) = - ∫ x, fderiv ℝ du x v * f x := by + apply integral_mul_fderiv_eq_neg_fderiv_mul_of_integrable + · simp_rw [hdu'] + exact ((continuous_kernel_hessian hu v v).mul hf.continuous).integrable_of_hasCompactSupport + hfc.mul_left + · exact (hdu.continuous.mul hdf.continuous).integrable_of_hasCompactSupport hdfc.mul_left + · exact (hdu.continuous.mul hf.continuous).integrable_of_hasCompactSupport hfc.mul_left + · exact fun x _ => hdu.differentiable one_ne_zero x + · exact fun x _ => hf.differentiable (by norm_num) x + simp_rw [hdf'] at hfirst + simp_rw [hdu'] at hsecond + exact hfirst.trans ((congrArg Neg.neg hsecond).trans (neg_neg _)) + +/-- The Mathlib Laplacian is self-adjoint against compactly supported `C²` tests. -/ +theorem integral_mul_laplacian_eq_integral_laplacian_mul + {u f : Position → ℝ} (hu : ContDiff ℝ 2 u) (hf : ContDiff ℝ 2 f) + (hfc : HasCompactSupport f) : + (∫ x, u x * Δ f x) = ∫ x, Δ u x * f x := by + simp_rw [laplacian_eq_iteratedFDeriv_stdOrthonormalBasis, iteratedFDeriv_two_apply] + simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Finset.mul_sum, Finset.sum_mul] + rw [integral_finsetSum, integral_finsetSum] + · exact Finset.sum_congr rfl (fun i _ => integral_mul_hessian_eq_integral_hessian_mul hu hf hfc _) + · intro i _ + exact ((continuous_kernel_hessian hu _ _).mul hf.continuous).integrable_of_hasCompactSupport + hfc.mul_left + · intro i _ + exact (hu.continuous.mul (continuous_kernel_hessian hf _ _)).integrable_of_hasCompactSupport + (hasCompactSupport_kernel_hessian hfc _ _).mul_left + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Analysis/FundamentalSolutionLimits.lean b/LeanPool/LiebThirring/Analysis/FundamentalSolutionLimits.lean new file mode 100644 index 0000000000..44742fe17d --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/FundamentalSolutionLimits.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Analysis.FundamentalSolutionRegularization + +/-! +# Dominated convergence to the singular Coulomb kernel + +The negative half-power of a squared norm is the real inverse norm. + +The regularized kernel is bounded by the inverse norm away from the pole. +-/ + +public section + +open MeasureTheory Filter InnerProductSpace Laplacian +open scoped Topology + +namespace LiebThirring + +/-- The negative half-power of a squared norm is the real inverse norm. -/ +theorem norm_sq_rpow_neg_half (x : Position) : + (‖x‖ ^ 2) ^ (-(1 / 2 : ℝ)) = ‖x‖⁻¹ := by + rw [Real.rpow_neg (sq_nonneg _), ← Real.sqrt_eq_rpow, Real.sqrt_sq (norm_nonneg _)] + +/-- The regularized kernel is bounded by the inverse norm away from the pole. -/ +theorem regularizedCoulombKernel_le_inv_norm (ε : ℝ) {x : Position} (hx : x ≠ 0) : + regularizedCoulombKernel ε x ≤ ‖x‖⁻¹ := by + unfold regularizedCoulombKernel + rw [← norm_sq_rpow_neg_half x] + exact Real.rpow_le_rpow_of_nonpos (sq_pos_of_pos (norm_pos_iff.mpr hx)) + (le_add_of_nonneg_right (sq_nonneg _)) (by norm_num) + +/-- The regularized kernel tends pointwise to the inverse norm away from its pole. -/ +theorem tendsto_regularizedCoulombKernel {x : Position} (hx : x ≠ 0) : + Tendsto (fun ε : ℝ => regularizedCoulombKernel ε x) (𝓝[>] 0) (𝓝 ‖x‖⁻¹) := by + have hi : Tendsto (fun ε : ℝ => ε) (𝓝[>] 0) (𝓝 0) := + tendsto_id.mono_left nhdsWithin_le_nhds + have hs : Tendsto (fun ε : ℝ => ‖x‖ ^ 2 + ε ^ 2) (𝓝[>] 0) (𝓝 (‖x‖ ^ 2)) := by + simpa only [zero_pow (by decide : (2 : ℕ) ≠ 0), add_zero] using + (tendsto_const_nhds (x := ‖x‖ ^ 2)).add (hi.pow 2) + have ht := hs.rpow_const (p := -(1 / 2 : ℝ)) + (Or.inl (pow_ne_zero _ (norm_ne_zero_iff.mpr hx))) + rw [norm_sq_rpow_neg_half] at ht + exact ht + +/-- Dominated convergence for the regularized test-function pairing in the fundamental solution. -/ +theorem tendsto_integral_regularizedCoulombKernel_sub_mul_laplacian + {f : Position → ℝ} (hf : ContDiff ℝ 2 f) (hfc : HasCompactSupport f) (y : Position) : + Tendsto (fun ε : ℝ => ∫ x, regularizedCoulombKernel ε (x - y) * Δ f x) + (𝓝[>] 0) (𝓝 (∫ x, ‖x - y‖⁻¹ * Δ f x)) := by + have hpole : ∀ᵐ x : Position, x ≠ y := (volume : Measure Position).ae_ne y + apply tendsto_integral_filter_of_dominated_convergence + (fun x => ‖‖x - y‖⁻¹ * Δ f x‖) + · filter_upwards [self_mem_nhdsWithin] with ε (hε : 0 < ε) + have hcont : Continuous (fun x : Position => regularizedCoulombKernel ε (x - y)) := + (contDiff_regularizedCoulombKernel hε).continuous.comp (continuous_id.sub continuous_const) + exact (hcont.mul (continuous_laplacian_position hf)).aestronglyMeasurable + · filter_upwards with ε + filter_upwards [hpole] with x hx + have hpos : 0 ≤ regularizedCoulombKernel ε (x - y) := + Real.rpow_nonneg (add_nonneg (sq_nonneg _) (sq_nonneg _)) _ + simp only [norm_mul, Real.norm_eq_abs, + abs_of_nonneg hpos, abs_of_nonneg (inv_nonneg.mpr (norm_nonneg _))] + exact mul_le_mul_of_nonneg_right + (regularizedCoulombKernel_le_inv_norm ε (sub_ne_zero.mpr hx)) (abs_nonneg _) + · exact (integrable_inv_norm_sub_mul_laplacian hf hfc y).norm + · filter_upwards [hpole] with x hx + exact (tendsto_regularizedCoulombKernel (sub_ne_zero.mpr hx)).mul tendsto_const_nhds + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Analysis/FundamentalSolutionMeasures.lean b/LeanPool/LiebThirring/Analysis/FundamentalSolutionMeasures.lean new file mode 100644 index 0000000000..ef5048e2c9 --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/FundamentalSolutionMeasures.lean @@ -0,0 +1,136 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.MeasureTheory.Integral.Prod +public import LeanPool.LiebThirring.Analysis.FundamentalSolutionIntegrability +import all LeanPool.LiebThirring.Electrostatics.Basic + +/-! +# Fubini for bounded Coulomb potentials + +The real value of the extended kernel is the real inverse norm, including value zero on the +diagonal. + +A finite pointwise potential is the Bochner integral of the real kernel. +-/ + +public section + +open MeasureTheory Set InnerProductSpace Laplacian +open scoped ENNReal + +namespace LiebThirring + +/-- The real value of the extended kernel is the real inverse norm, +including value zero on the diagonal. -/ +theorem coulombKernel_toReal_eq_inv_norm (x y : Position) : + (coulombKernel x y).toReal = ‖x - y‖⁻¹ := by + simp only [coulombKernel, ENNReal.toReal_inv, ENNReal.toReal_ofReal (norm_nonneg _)] + +/-- A finite pointwise potential is the Bochner integral of the real kernel. -/ +theorem coulombPotential_toReal_eq_integral (β : Measure Position) (x : Position) + (hx : coulombPotential β x ≠ ⊤) : + (coulombPotential β x).toReal = ∫ y, ‖x - y‖⁻¹ ∂β := by + have hK : Measurable (coulombKernel x) := + ((measurable_const.sub measurable_id).norm.ennreal_ofReal).inv + rw [coulombPotential] + rw [← integral_toReal hK.aemeasurable (ae_lt_top hK hx)] + simp only [coulombKernel_toReal_eq_inv_norm] + +/-- Absolute Tonelli bound for a compactly supported continuous multiplier. -/ +theorem lintegral_abs_mul_coulombKernel_ne_top + (β : Measure Position) [SFinite β] {C : ℝ≥0∞} + (hC : C ≠ ⊤) (hβ : ∀ x, coulombPotential β x ≤ C) + {g : Position → ℝ} (hg : Continuous g) (hgc : HasCompactSupport g) : + (∫⁻ p : Position × Position, + ENNReal.ofReal ‖g p.1‖ * coulombKernel p.1 p.2 ∂volume.prod β) ≠ ⊤ := by + have hK : Measurable (Function.uncurry coulombKernel) := + ((measurable_fst.sub measurable_snd).norm.ennreal_ofReal).inv + have hgm : Measurable g := hg.measurable + have hgi : (∫⁻ x, ENNReal.ofReal ‖g x‖) ≠ ⊤ := by + have h := (hasFiniteIntegral_iff_ofReal (Filter.Eventually.of_forall + (fun x => norm_nonneg (g x)))).mp + (hg.integrable_of_hasCompactSupport (μ := volume) hgc).norm.hasFiniteIntegral + exact h.ne + have heq : (∫⁻ p : Position × Position, + ENNReal.ofReal ‖g p.1‖ * coulombKernel p.1 p.2 ∂volume.prod β) = + ∫⁻ x, ENNReal.ofReal ‖g x‖ * coulombPotential β x := by + have hm : AEMeasurable (fun p : Position × Position => + ENNReal.ofReal ‖g p.1‖ * coulombKernel p.1 p.2) (volume.prod β) := + ((hgm.comp measurable_fst).norm.ennreal_ofReal.mul hK).aemeasurable + rw [lintegral_prod (fun p : Position × Position => + ENNReal.ofReal ‖g p.1‖ * coulombKernel p.1 p.2) hm] + apply lintegral_congr + intro x + unfold coulombPotential + exact lintegral_const_mul (μ := β) (ENNReal.ofReal ‖g x‖) + (show Measurable (coulombKernel x) from + ((measurable_const.sub measurable_id).norm.ennreal_ofReal).inv) + rw [heq] + apply ne_top_of_le_ne_top (ENNReal.mul_ne_top hgi hC) + calc + _ ≤ ∫⁻ x, ENNReal.ofReal ‖g x‖ * C := + lintegral_mono (fun x => mul_le_mul' le_rfl (hβ x)) + _ = _ := lintegral_mul_const _ hgm.norm.ennreal_ofReal + +/-- Absolute product integrability licenses the ordinary Fubini exchange in the fundamental +solution. -/ +theorem integrable_inv_norm_sub_mul_prod + (β : Measure Position) [SFinite β] {C : ℝ≥0∞} + (hC : C ≠ ⊤) (hβ : ∀ x, coulombPotential β x ≤ C) + {g : Position → ℝ} (hg : Continuous g) (hgc : HasCompactSupport g) : + Integrable (fun p : Position × Position => ‖p.1 - p.2‖⁻¹ * g p.1) + (volume.prod β) := by + have hK : Measurable (Function.uncurry coulombKernel) := + ((measurable_fst.sub measurable_snd).norm.ennreal_ofReal).inv + have hgm : Measurable g := hg.measurable + have hmajor := integrable_toReal_of_lintegral_ne_top + (((hgm.comp measurable_fst).norm.ennreal_ofReal).mul hK).aemeasurable + (lintegral_abs_mul_coulombKernel_ne_top β hC hβ hg hgc) + apply hmajor.mono + ((((measurable_fst.sub measurable_snd).norm.inv).mul + (hgm.comp measurable_fst)).aestronglyMeasurable) + filter_upwards with p + change ‖‖p.1 - p.2‖⁻¹ * g p.1‖ ≤ + ‖(ENNReal.ofReal ‖g p.1‖ * coulombKernel p.1 p.2).toReal‖ + rw [ENNReal.toReal_mul, ENNReal.toReal_ofReal (norm_nonneg _), + coulombKernel_toReal_eq_inv_norm] + simp only [Real.norm_eq_abs, abs_mul, + abs_of_nonneg (inv_nonneg.mpr (norm_nonneg _)), abs_abs] + exact le_of_eq (mul_comm _ _) + +/-- Unconditional Fubini reduction of bounded-potential pairings to point-charge pairings. -/ +theorem integral_coulombPotential_toReal_mul_eq_integral_integral + (β : Measure Position) [SFinite β] {C : ℝ≥0∞} + (hC : C ≠ ⊤) (hβ : ∀ x, coulombPotential β x ≤ C) + {g : Position → ℝ} (hg : Continuous g) (hgc : HasCompactSupport g) : + (∫ x, (coulombPotential β x).toReal * g x) = + ∫ y, (∫ x, ‖x - y‖⁻¹ * g x) ∂β := by + calc + _ = ∫ x, ∫ y, ‖x - y‖⁻¹ * g x ∂β := by + apply integral_congr_ae + filter_upwards with x + rw [coulombPotential_toReal_eq_integral β x + (ne_top_of_le_ne_top hC (hβ x)), integral_mul_const] + _ = _ := integral_integral_swap (integrable_inv_norm_sub_mul_prod β hC hβ hg hgc) + +/-- the fundamental solution's Fubini reduction, with the weak-harmonic Laplacian. -/ +theorem integral_coulombPotential_toReal_mul_laplacian_eq_integral_integral + (β : Measure Position) [SFinite β] {C : ℝ≥0∞} + (hC : C ≠ ⊤) (hβ : ∀ x, coulombPotential β x ≤ C) + {f : Position → ℝ} (hf : ContDiff ℝ 2 f) (hfc : HasCompactSupport f) : + (∫ x, (coulombPotential β x).toReal * Δ f x) = + ∫ y, (∫ x, ‖x - y‖⁻¹ * Δ f x) ∂β := + integral_coulombPotential_toReal_mul_eq_integral_integral β hC hβ + (continuous_laplacian_position hf) (hasCompactSupport_laplacian_position hfc) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Analysis/FundamentalSolutionRadial.lean b/LeanPool/LiebThirring/Analysis/FundamentalSolutionRadial.lean new file mode 100644 index 0000000000..446645c4af --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/FundamentalSolutionRadial.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Analysis.FundamentalSolutionRegularization +import LeanPool.LiebThirring.Electrostatics.SphereRadial + +/-! +# Radial normalization of the regularized Coulomb density + +The elementary radial antiderivative in the fundamental solution's normalization argument, at +unit scale. + +The radial primitive tends to one at infinity. +-/ + +public section + +open MeasureTheory Filter Set +open scoped Topology ENNReal + +namespace LiebThirring + +/-- The elementary radial antiderivative in the fundamental solution's normalization argument, at +unit scale. -/ +theorem hasDerivAt_coulomb_radial_primitive (r : ℝ) : + HasDerivAt (fun t : ℝ => t ^ 3 * (t ^ 2 + 1) ^ (-(3 / 2 : ℝ))) + (3 * r ^ 2 * (r ^ 2 + 1) ^ (-(5 / 2 : ℝ))) r := by + have hs : 0 < r ^ 2 + 1 := add_pos_of_nonneg_of_pos (sq_nonneg _) zero_lt_one + have hh := ((hasDerivAt_id r).pow 3).fun_mul + (((hasDerivAt_id r).pow 2).add_const 1 |>.rpow_const (p := -(3 / 2 : ℝ)) (Or.inl hs.ne')) + simp only [Pi.pow_apply, id_eq] at hh + convert hh using 1 + have hp : (r ^ 2 + 1) ^ (-(3 / 2 : ℝ)) = + (r ^ 2 + 1) * (r ^ 2 + 1) ^ (-(5 / 2 : ℝ)) := by + calc + _ = (r ^ 2 + 1) ^ (1 + -(5 / 2 : ℝ)) := by norm_num + _ = _ := by rw [Real.rpow_add hs, Real.rpow_one] + norm_num only [Nat.cast_ofNat, Nat.reduceSub, mul_one] + rw [hp] + ring + +/-- The radial primitive tends to one at infinity. -/ +theorem tendsto_coulomb_radial_primitive : + Tendsto (fun r : ℝ => r ^ 3 * (r ^ 2 + 1) ^ (-(3 / 2 : ℝ))) atTop (𝓝 1) := by + have ht : Tendsto (fun r : ℝ => 1 + (r⁻¹) ^ 2) atTop (𝓝 (1 + 0 ^ 2)) := + tendsto_const_nhds.add (tendsto_inv_atTop_zero.pow 2) + have ht' := ht.rpow_const (p := -(3 / 2 : ℝ)) (Or.inl (by norm_num)) + norm_num only [zero_pow (by decide : (2 : ℕ) ≠ 0), add_zero, Real.one_rpow] at ht' + apply ht'.congr' + filter_upwards [Ioi_mem_atTop (0 : ℝ)] with r hr + have hs : r ^ 2 + 1 = r ^ 2 * (1 + (r⁻¹) ^ 2) := by + field_simp [hr.ne'] + rw [hs, Real.mul_rpow (sq_nonneg _) (by positivity)] + have hp : (r ^ 2) ^ (-(3 / 2 : ℝ)) = (r ^ 3)⁻¹ := by + rw [← Real.rpow_natCast r 2, ← Real.rpow_mul hr.le] + norm_num + rw [hp, ← mul_assoc, mul_inv_cancel₀ (pow_ne_zero _ hr.ne'), one_mul] + +/-- The radial Jacobian times the unit density is integrable and has integral one. -/ +theorem coulomb_radial_integrable_integral : + IntegrableOn (fun r : ℝ => 3 * r ^ 2 * (r ^ 2 + 1) ^ (-(5 / 2 : ℝ))) (Ioi 0) ∧ + (∫ r : ℝ in Ioi 0, 3 * r ^ 2 * (r ^ 2 + 1) ^ (-(5 / 2 : ℝ))) = 1 := by + have hd := fun r (_ : r ∈ Ici (0 : ℝ)) => hasDerivAt_coulomb_radial_primitive r + have hp : ∀ r ∈ Ioi (0 : ℝ), 0 ≤ 3 * r ^ 2 * (r ^ 2 + 1) ^ (-(5 / 2 : ℝ)) := by + intro r _ + exact mul_nonneg (mul_nonneg (by norm_num) (sq_nonneg _)) + (Real.rpow_nonneg (by positivity) _) + refine ⟨integrableOn_Ioi_deriv_of_nonneg' hd hp tendsto_coulomb_radial_primitive, ?_⟩ + simpa only [zero_pow (by decide : (3 : ℕ) ≠ 0), zero_mul, sub_zero] using + integral_Ioi_of_hasDerivAt_of_nonneg' hd hp tendsto_coulomb_radial_primitive + +/-- The unit-scale regularization density is integrable on physical three-space. -/ +theorem integrable_coulombApproximationDensity_one : Integrable (coulombApproximationDensity 1) := + by + unfold coulombApproximationDensity + norm_num only [one_pow, mul_one] + apply (integrable_fun_norm_addHaar (volume : Measure Position) + (f := fun r : ℝ => 3 * (r ^ 2 + 1) ^ (-(5 / 2 : ℝ)))).mpr + simp only [Position, finrank_euclideanSpace_fin, Nat.reduceSub, smul_eq_mul] + apply coulomb_radial_integrable_integral.1.congr_fun _ measurableSet_Ioi + intro r _ + ring + +/-- The regularization density has the exact Coulomb normalization `4π` at unit scale. -/ +theorem integral_coulombApproximationDensity_one : + (∫ x : Position, coulombApproximationDensity 1 x) = 4 * Real.pi := by + rw [integral_eq_lintegral_of_nonneg_ae + (Filter.Eventually.of_forall (coulombApproximationDensity_nonneg 1)) + integrable_coulombApproximationDensity_one.aestronglyMeasurable] + unfold coulombApproximationDensity + norm_num only [one_pow, mul_one] + rw [lintegral_norm (fun r : ℝ => ENNReal.ofReal (3 * (r ^ 2 + 1) ^ (-(5 / 2 : ℝ)))) + (by fun_prop)] + have hr : (∫⁻ r : ℝ in Ioi 0, + ENNReal.ofReal (r ^ 2) * ENNReal.ofReal (3 * (r ^ 2 + 1) ^ (-(5 / 2 : ℝ)))) = 1 := by + calc + _ = ∫⁻ r : ℝ in Ioi 0, ENNReal.ofReal (3 * r ^ 2 * (r ^ 2 + 1) ^ (-(5 / 2 : ℝ))) := by + apply lintegral_congr + intro r + rw [← ENNReal.ofReal_mul (sq_nonneg _)] + congr 1 + ring + _ = ENNReal.ofReal (∫ r : ℝ in Ioi 0, 3 * r ^ 2 * (r ^ 2 + 1) ^ (-(5 / 2 : ℝ))) := by + apply (ofReal_integral_eq_lintegral_ofReal coulomb_radial_integrable_integral.1 ?_).symm + filter_upwards with r + exact mul_nonneg (mul_nonneg (by norm_num) (sq_nonneg _)) (Real.rpow_nonneg (by positivity) + _) + _ = 1 := by rw [coulomb_radial_integrable_integral.2, ENNReal.ofReal_one] + rw [hr, mul_one, ENNReal.toReal_ofReal (by positivity : 0 ≤ 4 * Real.pi)] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Analysis/FundamentalSolutionRegularization.lean b/LeanPool/LiebThirring/Analysis/FundamentalSolutionRegularization.lean new file mode 100644 index 0000000000..2e2aa8b112 --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/FundamentalSolutionRegularization.lean @@ -0,0 +1,150 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Analysis.FundamentalSolutionIntegrationByParts +import LeanPool.LiebThirring.Analysis.WeakHarmonicRegularization + +/-! +# Regularization of the Coulomb kernel + +The regularized inverse-distance kernel of the fundamental solution. + +The nonnegative approximate-identity density `-Δ G_ε` in the fundamental solution. +-/ + +public section + +open MeasureTheory InnerProductSpace Laplacian +open scoped RealInnerProductSpace ContDiff + +namespace LiebThirring + +/-- The regularized inverse-distance kernel of the fundamental solution. -/ +@[expose] noncomputable def regularizedCoulombKernel (ε : ℝ) (x : Position) : ℝ := + (‖x‖ ^ 2 + ε ^ 2) ^ (-(1 / 2 : ℝ)) + +/-- The nonnegative approximate-identity density `-Δ G_ε` in the fundamental solution. -/ +@[expose] noncomputable def coulombApproximationDensity (ε : ℝ) (x : Position) : ℝ := + 3 * ε ^ 2 * (‖x‖ ^ 2 + ε ^ 2) ^ (-(5 / 2 : ℝ)) + +/-- The squared regularized distance is strictly positive. -/ +theorem norm_sq_add_sq_pos {ε : ℝ} (hε : 0 < ε) (x : Position) : + 0 < ‖x‖ ^ 2 + ε ^ 2 := + add_pos_of_nonneg_of_pos (sq_nonneg _) (sq_pos_of_pos hε) + +/-- The regularized kernel is smooth everywhere for positive regularization scale. -/ +theorem contDiff_regularizedCoulombKernel {ε : ℝ} (hε : 0 < ε) : + ContDiff ℝ ∞ (regularizedCoulombKernel ε) := + ((contDiff_norm_sq ℝ).add contDiff_const).rpow_const_of_ne + (fun x => (norm_sq_add_sq_pos hε x).ne') + +/-- First directional derivative of a regularized radial power. -/ +theorem fderiv_norm_sq_add_sq_rpow {ε : ℝ} (hε : 0 < ε) + (p : ℝ) (x v : Position) : + fderiv ℝ (fun z : Position => (‖z‖ ^ 2 + ε ^ 2) ^ p) x v = + 2 * p * (‖x‖ ^ 2 + ε ^ 2) ^ (p - 1) * ⟪x, v⟫ := by + have hs := (hasStrictFDerivAt_norm_sq x).hasFDerivAt.add_const (ε ^ 2) + have hh := hs.rpow_const (p := p) (Or.inl (norm_sq_add_sq_pos hε x).ne') + rw [hh.fderiv] + simp only [smul_apply, smul_eq_mul, innerSL_apply_apply] + ring + +/-- The directional Hessian of a regularized radial power. -/ +theorem hessian_norm_sq_add_sq_rpow {ε : ℝ} (hε : 0 < ε) + (p : ℝ) (x v : Position) : + fderiv ℝ (fderiv ℝ (fun z : Position => (‖z‖ ^ 2 + ε ^ 2) ^ p)) x v v = + 4 * p * (p - 1) * (‖x‖ ^ 2 + ε ^ 2) ^ (p - 2) * ⟪x, v⟫ ^ 2 + + 2 * p * (‖x‖ ^ 2 + ε ^ 2) ^ (p - 1) * ⟪v, v⟫ := by + have hc : ContDiff ℝ 2 (fun z : Position => (‖z‖ ^ 2 + ε ^ 2) ^ p) := + ((contDiff_norm_sq ℝ).add contDiff_const).rpow_const_of_ne + (fun z => (norm_sq_add_sq_pos hε z).ne') + rw [← fderiv_directional_fderiv hc] + have hd : (fun z : Position => + fderiv ℝ (fun w : Position => (‖w‖ ^ 2 + ε ^ 2) ^ p) z v) = + (fun z => 2 * p * (‖z‖ ^ 2 + ε ^ 2) ^ (p - 1) * ⟪z, v⟫) := + funext (fun z => fderiv_norm_sq_add_sq_rpow hε p z v) + rw [hd] + have hs := (hasStrictFDerivAt_norm_sq x).hasFDerivAt.add_const (ε ^ 2) + have hp := (hs.rpow_const (p := p - 1) (Or.inl (norm_sq_add_sq_pos hε x).ne')).const_mul (2 * p) + have hl : HasFDerivAt (fun z : Position => ⟪z, v⟫) (innerSL ℝ v) x := by + simpa only [coe_innerSL_apply, real_inner_comm] using (innerSL ℝ v).hasFDerivAt + rw [(hp.fun_mul hl).fderiv] + simp only [add_apply, smul_apply, smul_eq_mul, innerSL_apply_apply] + rw [show p - 1 - 1 = p - 2 by ring, real_inner_comm v x] + ring + +/-- The directional Hessian of the regularized Coulomb kernel in the fundamental solution. -/ +theorem hessian_regularizedCoulombKernel {ε : ℝ} (hε : 0 < ε) (x v : Position) : + fderiv ℝ (fderiv ℝ (regularizedCoulombKernel ε)) x v v = + 3 * (‖x‖ ^ 2 + ε ^ 2) ^ (-(5 / 2 : ℝ)) * ⟪x, v⟫ ^ 2 - + (‖x‖ ^ 2 + ε ^ 2) ^ (-(3 / 2 : ℝ)) * ⟪v, v⟫ := by + unfold regularizedCoulombKernel + rw [hessian_norm_sq_add_sq_rpow hε] + norm_num + ring + +/-- The exact negative Laplacian of the regularized kernel, the fundamental solution. -/ +theorem laplacian_regularizedCoulombKernel {ε : ℝ} (hε : 0 < ε) (x : Position) : + Δ (regularizedCoulombKernel ε) x = -coulombApproximationDensity ε x := by + rw [laplacian_eq_iteratedFDeriv_stdOrthonormalBasis] + simp only [iteratedFDeriv_two_apply, Matrix.cons_val_zero, Matrix.cons_val_one] + simp_rw [hessian_regularizedCoulombKernel hε, real_inner_self_eq_norm_sq, + OrthonormalBasis.norm_eq_one, one_pow, mul_one] + rw [Finset.sum_sub_distrib, ← Finset.mul_sum, + (stdOrthonormalBasis ℝ Position).sum_sq_inner_left] + simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul] + have hdim : Module.finrank ℝ Position = 3 := by + simp only [Position, finrank_euclideanSpace_fin] + rw [hdim] + have hp : (‖x‖ ^ 2 + ε ^ 2) ^ (-(3 / 2 : ℝ)) = + (‖x‖ ^ 2 + ε ^ 2) * (‖x‖ ^ 2 + ε ^ 2) ^ (-(5 / 2 : ℝ)) := by + calc + _ = (‖x‖ ^ 2 + ε ^ 2) ^ (1 + -(5 / 2 : ℝ)) := by norm_num + _ = _ := by rw [Real.rpow_add (norm_sq_add_sq_pos hε x), Real.rpow_one] + rw [hp] + unfold coulombApproximationDensity + ring + +/-- The density in the regularization argument is nonnegative. -/ +theorem coulombApproximationDensity_nonneg (ε : ℝ) (x : Position) : + 0 ≤ coulombApproximationDensity ε x := by + unfold coulombApproximationDensity + exact mul_nonneg (mul_nonneg (by norm_num) (sq_nonneg _)) + (Real.rpow_nonneg (add_nonneg (sq_nonneg _) (sq_nonneg _)) _) + +/-- Translation of the regularized Coulomb Laplacian to an arbitrary pole. -/ +theorem laplacian_regularizedCoulombKernel_sub {ε : ℝ} (hε : 0 < ε) + (y x : Position) : + Δ (fun z => regularizedCoulombKernel ε (z - y)) x = + -coulombApproximationDensity ε (x - y) := by + have hc : ContDiff ℝ 2 (regularizedCoulombKernel ε) := + (contDiff_regularizedCoulombKernel hε).of_le (by norm_num) + have he : (fun z => regularizedCoulombKernel ε (z - y)) = + (fun z => regularizedCoulombKernel ε (y - z)) := by + funext z + simp only [regularizedCoulombKernel, norm_sub_rev] + rw [he, laplacian_reflect hc y x, laplacian_regularizedCoulombKernel hε] + simp only [coulombApproximationDensity, norm_sub_rev] + +/-- the fundamental solution for a regularized kernel centered at an arbitrary pole. -/ +theorem integral_regularizedCoulombKernel_sub_mul_laplacian {ε : ℝ} (hε : 0 < ε) + {f : Position → ℝ} (hf : ContDiff ℝ 2 f) (hfc : HasCompactSupport f) (y : Position) : + (∫ x, regularizedCoulombKernel ε (x - y) * Δ f x) = + -∫ x, coulombApproximationDensity ε (x - y) * f x := by + have hc : ContDiff ℝ 2 (fun x => regularizedCoulombKernel ε (x - y)) := + ((contDiff_regularizedCoulombKernel hε).of_le (by norm_num)).comp + (contDiff_id.sub contDiff_const) + rw [integral_mul_laplacian_eq_integral_laplacian_mul hc hf hfc] + simp_rw [laplacian_regularizedCoulombKernel_sub hε, neg_mul] + exact integral_neg _ + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Analysis/Hardy.lean b/LeanPool/LiebThirring/Analysis/Hardy.lean new file mode 100644 index 0000000000..22c18f4c86 --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/Hardy.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. +public import LeanPool.LiebThirring.Analysis.HardyApproximation +/-! +# One-body Coulomb control by Fourier kinetic energy + +Squared Schwartz L² norm, in nonnegative extended-integral form. + +Every L² state has its Coulomb expectation bounded by its mass plus four times its Fourier +kinetic energy, uniformly in the pole. +-/ +public section +open MeasureTheory Filter FourierTransform +open scoped ENNReal NNReal Topology SchwartzMap FourierTransform +namespace LiebThirring +variable {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℂ E] [CompleteSpace E] + +omit [CompleteSpace E] in +/-- Squared Schwartz L² norm, in nonnegative extended-integral form. -/ +theorem lintegral_schwartz_norm_sq_eq_enorm_toLp_sq (f : 𝓢(Position, E)) : + (∫⁻ x, (‖f x‖₊ : ℝ≥0∞) ^ 2) = ‖f.toLp 2 volume‖ₑ ^ 2 := by + rw [SchwartzMap.toLp, Lp.enorm_toLp] + exact lintegral_norm_sq_eq_eLpNorm_sq f.continuous.aestronglyMeasurable + +/-- Every L² state has its Coulomb expectation bounded by its mass plus four +times its Fourier kinetic energy, uniformly in the pole. -/ +theorem lintegral_coulomb_le_of_fourier (c : Position) (u : Lp E 2 (volume : Measure Position)) : + (∫⁻ x, coulombKernel x c * (‖u x‖₊ : ℝ≥0∞) ^ 2) ≤ + (‖u‖₊ : ℝ≥0∞) ^ 2 + + 4 * ∫⁻ ξ, ENNReal.ofReal ((2 * Real.pi) ^ 2) * (‖ξ‖₊ : ℝ≥0∞) ^ 2 * + (‖(Lp.fourierTransformₗᵢ Position E u) ξ‖₊ : ℝ≥0∞) ^ 2 := by + let v : Lp E 2 (volume : Measure Position) := 𝓕 u + let K := ENNReal.ofReal ((2 * Real.pi) ^ 2) + have hK : K ≠ ⊤ := ENNReal.ofReal_ne_top + have he (g : Position → E) : + (∫⁻ ξ, K * (‖ξ‖₊ : ℝ≥0∞) ^ 2 * (‖g ξ‖₊ : ℝ≥0∞) ^ 2) = + K * ∫⁻ ξ, (‖ξ‖₊ : ℝ≥0∞) ^ 2 * (‖g ξ‖₊ : ℝ≥0∞) ^ 2 := by + simp only [mul_assoc] + exact lintegral_const_mul' K _ hK + by_cases hT : (∫⁻ ξ, K * (‖ξ‖₊ : ℝ≥0∞) ^ 2 * (‖v ξ‖₊ : ℝ≥0∞) ^ 2) = ⊤ + · change _ ≤ ‖u‖ₑ ^ 2 + 4 * ∫⁻ ξ, K * (‖ξ‖₊ : ℝ≥0∞) ^ 2 * (‖v ξ‖₊ : ℝ≥0∞) ^ 2 + rw [hT] + simp only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, ENNReal.mul_top, add_top, le_top] + have hv : (∫⁻ ξ, (‖ξ‖₊ : ℝ≥0∞) ^ 2 * (‖v ξ‖₊ : ℝ≥0∞) ^ 2) < ⊤ := by + rw [he] at hT + apply ENNReal.lt_top_of_mul_ne_top_right hT + exact (ENNReal.ofReal_pos.mpr (sq_pos_of_pos (mul_pos (by norm_num) Real.pi_pos))).ne' + obtain ⟨f, hf₀, hf₁⟩ := exists_schwartz_weighted_approximation v hv + let w : ℕ → Lp E 2 (volume : Measure Position) := fun n => (𝓕⁻ (f n)).toLp 2 volume + have hw : Tendsto w atTop (𝓝 u) := by + have hh := (Lp.fourierTransformₗᵢ Position E).symm.continuous.tendsto v |>.comp hf₀ + change Tendsto (fun n => 𝓕⁻ ((f n).toLp 2 volume)) atTop (𝓝 (𝓕⁻ v)) at hh + simpa only [SchwartzMap.toLp_fourierInv_eq, v, fourierInv_fourier_eq] using hh + have hn : Tendsto (fun n => ‖w n‖ₑ ^ 2) atTop (𝓝 (‖u‖ₑ ^ 2)) := by + exact ((ENNReal.continuous_pow 2).tendsto _).comp ((continuous_enorm.tendsto _).comp hw) + have hk : Tendsto (fun n => 4 * (K * ∫⁻ ξ, (‖ξ‖₊ : ℝ≥0∞) ^ 2 * (‖f n ξ‖₊ : ℝ≥0∞) ^ 2)) + atTop (𝓝 (4 * (K * ∫⁻ ξ, (‖ξ‖₊ : ℝ≥0∞) ^ 2 * (‖v ξ‖₊ : ℝ≥0∞) ^ 2))) := + ENNReal.Tendsto.const_mul (ENNReal.Tendsto.const_mul hf₁ (Or.inr hK)) (Or.inr (by finiteness)) + have hb (n : ℕ) : (∫⁻ x, coulombKernel x c * (‖w n x‖₊ : ℝ≥0∞) ^ 2) ≤ + ‖w n‖ₑ ^ 2 + 4 * (K * ∫⁻ ξ, (‖ξ‖₊ : ℝ≥0∞) ^ 2 * (‖f n ξ‖₊ : ℝ≥0∞) ^ 2) := by + have hh := lintegral_coulomb_schwartz_fourier_le c (𝓕⁻ (f n)) + rw [lintegral_schwartz_norm_sq_eq_enorm_toLp_sq, fourier_fourierInv_eq, he] at hh + have he' : (∫⁻ x, coulombKernel x c * (‖w n x‖₊ : ℝ≥0∞) ^ 2) = + ∫⁻ x, coulombKernel x c * (‖(𝓕⁻ (f n)) x‖₊ : ℝ≥0∞) ^ 2 := by + apply lintegral_congr_ae + filter_upwards [(𝓕⁻ (f n)).coeFn_toLp 2 volume] with x hx + rw [show w n x = (𝓕⁻ (f n)) x from hx] + rw [he'] + exact hh + obtain ⟨ns, hns, hpoint⟩ := (tendstoInMeasure_of_tendsto_Lp hw).exists_seq_tendsto_ae + have hc : ∀ᵐ x : Position ∂volume, x ≠ c := by rw [ae_iff]; simp + have hlim : ∀ᵐ x : Position ∂volume, + Tendsto (fun n => coulombKernel x c * (‖w (ns n) x‖₊ : ℝ≥0∞) ^ 2) atTop + (𝓝 (coulombKernel x c * (‖u x‖₊ : ℝ≥0∞) ^ 2)) := by + filter_upwards [hpoint, hc] with x hx hxc + have hkx : coulombKernel x c ≠ ⊤ := by + apply ENNReal.inv_ne_top.mpr + exact (ENNReal.ofReal_pos.mpr (norm_pos_iff.mpr (sub_ne_zero.mpr hxc))).ne' + apply ENNReal.Tendsto.const_mul _ (Or.inr hkx) + exact ((ENNReal.continuous_pow 2).tendsto _).comp ((continuous_enorm.tendsto _).comp hx) + have hm (n : ℕ) : AEMeasurable (fun x => coulombKernel x c * (‖w (ns n) x‖₊ : ℝ≥0∞) ^ 2) volume + := by + have hkx : Measurable (fun x : Position => coulombKernel x c) := by + exact (ENNReal.continuous_ofReal.measurable.comp + ((continuous_norm.comp (continuous_id.sub continuous_const)).measurable)).inv + exact hkx.aemeasurable.mul + ((Lp.aestronglyMeasurable (w (ns n))).nnnorm.aemeasurable.coe_nnreal_ennreal.pow_const 2) + have hr := (hn.add hk).comp hns.tendsto_atTop + have hfat : (∫⁻ x, coulombKernel x c * (‖u x‖₊ : ℝ≥0∞) ^ 2) ≤ + liminf (fun n => ∫⁻ x, coulombKernel x c * (‖w (ns n) x‖₊ : ℝ≥0∞) ^ 2) atTop := by + calc + _ = ∫⁻ x, liminf (fun n => coulombKernel x c * (‖w (ns n) x‖₊ : ℝ≥0∞) ^ 2) atTop := + lintegral_congr_ae (hlim.mono (fun x hx => hx.liminf_eq.symm)) + _ ≤ _ := lintegral_liminf_le' hm + change _ ≤ ‖u‖ₑ ^ 2 + 4 * ∫⁻ ξ, K * (‖ξ‖₊ : ℝ≥0∞) ^ 2 * (‖v ξ‖₊ : ℝ≥0∞) ^ 2 + rw [he] + apply hfat.trans + rw [← hr.liminf_eq] + exact liminf_le_liminf (Filter.Eventually.of_forall (fun n => hb (ns n))) + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Analysis/HardyApproximation.lean b/LeanPool/LiebThirring/Analysis/HardyApproximation.lean new file mode 100644 index 0000000000..8080749a29 --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/HardyApproximation.lean @@ -0,0 +1,141 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. +public import LeanPool.LiebThirring.Analysis.HardySchwartz +import Mathlib.Analysis.Normed.Lp.SmoothApprox +/-! +# Approximation in the squared-radius weighted norm + +Squared-radius weighted volume is finite on compact sets. + +The squared-norm integral is the square of the extended L² seminorm. +-/ +public section +open MeasureTheory Filter +open scoped ENNReal NNReal Topology SchwartzMap FourierTransform +namespace LiebThirring + +/-- Squared-radius weighted volume is finite on compact sets. -/ +theorem isFiniteMeasureOnCompacts_norm_sq_volume : + IsFiniteMeasureOnCompacts ((volume : Measure Position).withDensity + (fun x => ENNReal.ofReal (‖x‖ ^ 2))) := by + constructor + intro K hK + rw [withDensity_apply _ hK.measurableSet] + have hi := (continuous_norm.pow 2).continuousOn.integrableOn_compact + (μ := (volume : Measure Position)) hK + change IntegrableOn (fun x : Position => ‖x‖ ^ 2) K volume at hi + rw [← ofReal_integral_eq_lintegral_ofReal hi + (Filter.Eventually.of_forall (fun x => sq_nonneg ‖x‖))] + exact ENNReal.ofReal_lt_top + +variable {E : Type*} [NormedAddCommGroup E] + +/-- The squared-norm integral is the square of the extended L² seminorm. -/ +theorem lintegral_norm_sq_eq_eLpNorm_sq {μ : Measure Position} {f : Position → E} + (hf : AEStronglyMeasurable f μ) : + (∫⁻ x, (‖f x‖₊ : ℝ≥0∞) ^ 2 ∂μ) = eLpNorm f 2 μ ^ 2 := by + change (∫⁻ x, ‖f x‖ₑ ^ 2 ∂μ) = eLpNorm f 2 μ ^ 2 + simpa only [ENNReal.coe_ofNat, NNReal.coe_ofNat, ENNReal.rpow_ofNat] using + (eLpNorm_nnreal_pow_eq_lintegral (p := (2 : ℝ≥0)) (by norm_num) hf).symm + +/-- A finite squared-norm integral gives membership in L². -/ +theorem memLp_two_of_lintegral_norm_sq_lt_top {μ : Measure Position} {f : Position → E} + (hf : AEStronglyMeasurable f μ) (h : (∫⁻ x, (‖f x‖₊ : ℝ≥0∞) ^ 2 ∂μ) < ⊤) : + MemLp f 2 μ := by + rw [lintegral_norm_sq_eq_eLpNorm_sq hf] at h + exact (ENNReal.pow_lt_top_iff.mp h).resolve_right (by decide) + +/-- Vanishing L² approximation errors give convergence of the associated Lp elements. -/ +theorem tendsto_toLp_of_eLpNorm_sub_le {μ : Measure Position} {v : Position → E} + (hv : MemLp v 2 μ) {f : ℕ → Position → E} (hf : ∀ n, MemLp (f n) 2 μ) + (h : ∀ n, eLpNorm (v - f n) 2 μ ≤ ENNReal.ofReal ((n + 1 : ℝ)⁻¹)) : + Tendsto (fun n => (hf n).toLp (f n)) atTop (𝓝 (hv.toLp v)) := by + apply tendsto_iff_edist_tendsto_0.mpr + have hz : Tendsto (fun n : ℕ => ENNReal.ofReal ((n + 1 : ℝ)⁻¹)) atTop (𝓝 0) := by + simpa only [ENNReal.ofReal_zero, Function.comp_def] using ENNReal.tendsto_ofReal + (tendsto_inv_atTop_zero.comp + (tendsto_atTop_add_const_right atTop (1 : ℝ) tendsto_natCast_atTop_atTop)) + apply tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds hz (fun n => bot_le) + intro n + dsimp only + rw [Lp.edist_toLp_toLp, eLpNorm_sub_comm] + exact h n + +variable [NormedSpace ℝ E] + +/-- Schwartz approximation with both L² convergence and convergence of the radial quadratic +integral. -/ +theorem exists_schwartz_weighted_approximation (v : Lp E 2 (volume : Measure Position)) + (hv : (∫⁻ x, (‖x‖₊ : ℝ≥0∞) ^ 2 * (‖v x‖₊ : ℝ≥0∞) ^ 2) < ⊤) : + ∃ f : ℕ → 𝓢(Position, E), + Tendsto (fun n => (f n).toLp 2 volume) atTop (𝓝 v) ∧ + Tendsto (fun n => ∫⁻ x, (‖x‖₊ : ℝ≥0∞) ^ 2 * (‖f n x‖₊ : ℝ≥0∞) ^ 2) + atTop (𝓝 (∫⁻ x, (‖x‖₊ : ℝ≥0∞) ^ 2 * (‖v x‖₊ : ℝ≥0∞) ^ 2)) := by + let ν := (volume : Measure Position).withDensity (fun x => ENNReal.ofReal (‖x‖ ^ 2)) + let μ := (volume : Measure Position) + ν + have hν : IsFiniteMeasureOnCompacts ν := isFiniteMeasureOnCompacts_norm_sq_volume + let : IsFiniteMeasureOnCompacts ν := hν + have hμ : IsFiniteMeasureOnCompacts μ := ⟨fun K hK => + (by + change volume K + ν K < ⊤ + exact ENNReal.add_lt_top.mpr ⟨hK.measure_lt_top, hK.measure_lt_top⟩)⟩ + let : IsFiniteMeasureOnCompacts μ := hμ + have hm : Measurable (fun x : Position => ENNReal.ofReal (‖x‖ ^ 2)) := + ENNReal.continuous_ofReal.measurable.comp (continuous_norm.pow 2).measurable + have haν : AEStronglyMeasurable (fun x => v x) ν := + (Lp.aestronglyMeasurable v).mono_ac (withDensity_absolutelyContinuous _ _) + have haμ : AEStronglyMeasurable (fun x => v x) μ := + (Lp.aestronglyMeasurable v).add_measure haν + have he (g : Position → E) (hg : AEStronglyMeasurable g volume) : + (∫⁻ x, (‖g x‖₊ : ℝ≥0∞) ^ 2 ∂ν) = + ∫⁻ x, (‖x‖₊ : ℝ≥0∞) ^ 2 * (‖g x‖₊ : ℝ≥0∞) ^ 2 := by + rw [lintegral_withDensity_eq_lintegral_mul₀ hm.aemeasurable + (hg.nnnorm.aemeasurable.coe_nnreal_ennreal.pow_const 2)] + apply lintegral_congr + intro x + dsimp only [Pi.mul_apply] + rw [ENNReal.ofReal_pow (norm_nonneg _), ofReal_norm] + rfl + have hvν : MemLp (fun x => v x) 2 ν := + memLp_two_of_lintegral_norm_sq_lt_top haν (by rw [he _ (Lp.aestronglyMeasurable v)]; exact hv) + have hvμ : MemLp (fun x => v x) 2 μ := by + apply memLp_two_of_lintegral_norm_sq_lt_top haμ + rw [lintegral_add_measure, he _ (Lp.aestronglyMeasurable v)] + apply ENNReal.add_lt_top.mpr + exact ⟨by rw [lintegral_norm_sq_eq_eLpNorm_sq (Lp.aestronglyMeasurable v)]; finiteness, hv⟩ + have hh (n : ℕ) := hvμ.exist_eLpNorm_sub_le ENNReal.ofNat_ne_top (by norm_num : (1 : ℝ≥0∞) ≤ 2) + (by positivity : 0 < (n + 1 : ℝ)⁻¹) + choose g hgK hgC hg using hh + let f : ℕ → 𝓢(Position, E) := fun n => (hgK n).toSchwartzMap (hgC n) + have hfν (n : ℕ) : MemLp (f n) 2 ν := (hgC n).continuous.memLp_of_hasCompactSupport (hgK n) + have hf₀ (n : ℕ) : MemLp (f n) 2 volume := (f n).memLp 2 volume + have h₀ := tendsto_toLp_of_eLpNorm_sub_le (Lp.memLp v) hf₀ (fun n => + (eLpNorm_mono_measure (f := (fun x => v x) - (f n : Position → E)) (p := 2) + (show (volume : Measure Position) ≤ μ from Measure.le_add_right le_rfl)).trans (hg n)) + have h₁ := tendsto_toLp_of_eLpNorm_sub_le hvν hfν (fun n => + (eLpNorm_mono_measure (f := (fun x => v x) - (f n : Position → E)) (p := 2) (show ν ≤ μ from + Measure.le_add_left le_rfl)).trans (hg n)) + refine ⟨f, ?_, ?_⟩ + · have hi : (Lp.memLp v).toLp (fun x => v x) = v := by + apply Lp.ext + exact (Lp.memLp v).coeFn_toLp + simpa only [SchwartzMap.toLp, hi] using h₀ + · have hh := (ENNReal.continuous_pow 2).tendsto _ |>.comp (continuous_enorm.tendsto _ |>.comp h₁) + have hn (n : ℕ) : ‖(hfν n).toLp (f n)‖ₑ ^ 2 = + ∫⁻ x, (‖x‖₊ : ℝ≥0∞) ^ 2 * (‖f n x‖₊ : ℝ≥0∞) ^ 2 := by + rw [Lp.enorm_toLp, ← lintegral_norm_sq_eq_eLpNorm_sq (hfν n).aestronglyMeasurable, + he _ (f n).continuous.aestronglyMeasurable] + have hv' : ‖hvν.toLp (fun x => v x)‖ₑ ^ 2 = + ∫⁻ x, (‖x‖₊ : ℝ≥0∞) ^ 2 * (‖v x‖₊ : ℝ≥0∞) ^ 2 := by + rw [Lp.enorm_toLp, ← lintegral_norm_sq_eq_eLpNorm_sq haν, he _ (Lp.aestronglyMeasurable v)] + simpa only [Function.comp_def, hn, hv'] using hh + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Analysis/HardyRegularized.lean b/LeanPool/LiebThirring/Analysis/HardyRegularized.lean new file mode 100644 index 0000000000..aa1a3c8d56 --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/HardyRegularized.lean @@ -0,0 +1,264 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. +public import Mathlib.Analysis.InnerProductSpace.Calculus +public import Mathlib.Analysis.Calculus.LineDeriv.IntegrationByParts +public import Mathlib.Analysis.Distribution.SchwartzSpace.Deriv +public import LeanPool.LiebThirring.Defs.Coulomb +/-! +# Regularized Hardy inequality + +The regularized inverse-square weight is a valid Schwartz multiplier. + +Each component of the regularized Hardy field has temperate growth. +-/ +public section +open MeasureTheory +open scoped RealInnerProductSpace SchwartzMap +namespace LiebThirring + +/-- The regularized inverse-square weight is a valid Schwartz multiplier. -/ +theorem hasTemperateGrowth_hardy_weight {ε : ℝ} (hε : 0 < ε) (c : Position) : + (fun x : Position => (‖x - c‖ ^ 2 + ε ^ 2)⁻¹).HasTemperateGrowth := by + have ha : (fun x : Position => ε⁻¹ • (x - c)).HasTemperateGrowth := + (Function.HasTemperateGrowth.const ε⁻¹).smul + (Function.HasTemperateGrowth.id'.sub (Function.HasTemperateGrowth.const c)) + have hh := (Function.hasTemperateGrowth_one_add_norm_sq_rpow Position (-1)).comp ha + have he : (fun x : Position => (‖x - c‖ ^ 2 + ε ^ 2)⁻¹) = + (fun x : Position => (ε ^ 2)⁻¹ * (1 + ‖ε⁻¹ • (x - c)‖ ^ 2) ^ (-1 : ℝ)) := by + funext x + rw [Real.rpow_neg_one, norm_smul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr hε)] + field_simp + ring + rw [he] + exact (Function.HasTemperateGrowth.const _).mul hh + +/-- Each component of the regularized Hardy field has temperate growth. -/ +theorem hasTemperateGrowth_hardy_component {ε : ℝ} (hε : 0 < ε) (c v : Position) : + (fun x : Position => inner ℝ (x - c) v / (‖x - c‖ ^ 2 + ε ^ 2)).HasTemperateGrowth := by + have hi := (Function.hasTemperateGrowth_inner_left v).comp + (Function.HasTemperateGrowth.id'.sub (Function.HasTemperateGrowth.const c)) + exact hi.mul (hasTemperateGrowth_hardy_weight hε c) + +/-- Directional derivative of the regularized Hardy field component. -/ +theorem fderiv_hardy_component {ε : ℝ} (hε : 0 < ε) (c x v w : Position) : + fderiv ℝ (fun y : Position => inner ℝ (y - c) v / (‖y - c‖ ^ 2 + ε ^ 2)) x w = + inner ℝ w v / (‖x - c‖ ^ 2 + ε ^ 2) - + 2 * inner ℝ (x - c) v * inner ℝ (x - c) w / (‖x - c‖ ^ 2 + ε ^ 2) ^ 2 := by + have hs := (((hasFDerivAt_id (𝕜 := ℝ) x).sub_const c).norm_sq).add_const (ε ^ 2) + have hn : ‖x - c‖ ^ 2 + ε ^ 2 ≠ 0 := + (add_pos_of_nonneg_of_pos (sq_nonneg _) (sq_pos_of_pos hε)).ne' + have hi := ((innerSL ℝ v).hasFDerivAt.comp x ((hasFDerivAt_id x).sub_const c)) + have hi' : HasFDerivAt (fun y : Position => inner ℝ (y - c) v) + (innerSL ℝ v) x := by + simpa only [Function.comp_def, id_eq, coe_innerSL_apply, real_inner_comm, + ContinuousLinearMap.comp_id] using hi + have hd := hi'.fun_mul ((hasDerivAt_inv hn).comp_hasFDerivAt x hs) + change fderiv ℝ (fun y : Position => inner ℝ (y - c) v * (‖y - c‖ ^ 2 + ε ^ 2)⁻¹) x w = _ + simp only [Function.comp_def, id_eq] at hd + rw [hd.fderiv] + simp only [smul_apply, add_apply, ContinuousLinearMap.comp_apply, + ContinuousLinearMap.id_apply, innerSL_apply_apply, smul_eq_mul] + rw [real_inner_comm v w] + ring + +/-- The coordinate trace of the regularized Hardy field in dimension three. -/ +theorem sum_fderiv_hardy_component {ε : ℝ} (hε : 0 < ε) (c x : Position) : + (∑ i : Fin 3, fderiv ℝ + (fun y : Position => inner ℝ (y - c) (EuclideanSpace.basisFun (Fin 3) ℝ i) / + (‖y - c‖ ^ 2 + ε ^ 2)) x (EuclideanSpace.basisFun (Fin 3) ℝ i)) = + (‖x - c‖ ^ 2 + 3 * ε ^ 2) / (‖x - c‖ ^ 2 + ε ^ 2) ^ 2 := by + simp_rw [fderiv_hardy_component hε, EuclideanSpace.inner_basisFun_real, + EuclideanSpace.basisFun_apply, PiLp.single_apply, ite_true] + simp only [Finset.sum_sub_distrib, Finset.sum_const, Finset.card_univ, + Fintype.card_fin, nsmul_eq_mul] + simp_rw [show ∀ i : Fin 3, 2 * (x - c) i * (x - c) i = 2 * ((x - c) i) ^ 2 + from fun i => by ring] + rw [← Finset.sum_div, ← Finset.mul_sum, ← EuclideanSpace.real_norm_sq_eq] + have hn : ‖x - c‖ ^ 2 + ε ^ 2 ≠ 0 := + (add_pos_of_nonneg_of_pos (sq_nonneg _) (sq_pos_of_pos hε)).ne' + field_simp + ring + +/-- The field derivative is also a valid Schwartz multiplier. -/ +theorem hasTemperateGrowth_fderiv_hardy_component {ε : ℝ} (hε : 0 < ε) + (c v w : Position) : + (fun x : Position => fderiv ℝ + (fun y : Position => inner ℝ (y - c) v / (‖y - c‖ ^ 2 + ε ^ 2)) x w).HasTemperateGrowth := by + simp_rw [fderiv_hardy_component hε] + have hi (z : Position) := (Function.hasTemperateGrowth_inner_left z).comp + (Function.HasTemperateGrowth.id'.sub (Function.HasTemperateGrowth.const c)) + have hw := hasTemperateGrowth_hardy_weight hε c + have h₁ := (Function.HasTemperateGrowth.const (inner ℝ w v)).mul hw + have h₂ := (((Function.HasTemperateGrowth.const (2 : ℝ)).mul (hi v)).mul (hi w)).mul + (hw.pow 2) + convert h₁.sub h₂ using 1 + funext x + simp only [Pi.sub_apply, Pi.mul_apply, Function.comp_apply, Pi.pow_apply, inv_pow] + rfl + +/-- A temperate multiplier times a scalar Schwartz test is integrable. -/ +theorem integrable_temperate_mul_schwartz {a : Position → ℝ} + (ha : a.HasTemperateGrowth) (g : 𝓢(Position, ℝ)) : + Integrable (fun x => a x * g x) (volume : Measure Position) := by + have hh := (SchwartzMap.smulLeftCLM ℝ a g).integrable (μ := (volume : Measure Position)) + convert hh using 1 + funext x + exact (SchwartzMap.smulLeftCLM_apply_apply ha g x).symm + +/-- Integration by parts against one component of the regularized field. -/ +theorem integral_hardy_component_mul_fderiv {ε : ℝ} (hε : 0 < ε) + (c v : Position) (g : 𝓢(Position, ℝ)) : + (∫ x, (inner ℝ (x - c) v / (‖x - c‖ ^ 2 + ε ^ 2)) * fderiv ℝ g x v) = + -∫ x, fderiv ℝ + (fun y : Position => inner ℝ (y - c) v / (‖y - c‖ ^ 2 + ε ^ 2)) x v * g x := by + have hv := hasTemperateGrowth_hardy_component hε c v + have hd := hasTemperateGrowth_fderiv_hardy_component hε c v v + apply integral_mul_fderiv_eq_neg_fderiv_mul_of_integrable + · exact integrable_temperate_mul_schwartz hd g + · exact integrable_temperate_mul_schwartz hv (LineDeriv.lineDerivOp v g) + · exact integrable_temperate_mul_schwartz hv g + · exact fun x _ => hv.1.differentiable (by simp) x + · exact fun x _ => g.differentiableAt + +variable {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℝ E] + +/-- The derivative of the squared Hilbert norm, evaluated in one direction. -/ +theorem fderiv_schwartz_norm_sq (f : 𝓢(Position, E)) (x v : Position) : + fderiv ℝ (fun y => ‖f y‖ ^ 2) x v = 2 * inner ℝ (f x) (fderiv ℝ f x v) := by + rw [(f.hasFDerivAt x).norm_sq.fderiv] + simp only [two_smul, add_apply, ContinuousLinearMap.comp_apply, innerSL_apply_apply] + ring + +/-- Integration by parts against the squared norm of a Hilbert-valued Schwartz map. -/ +theorem integral_hardy_component_norm_sq {ε : ℝ} (hε : 0 < ε) + (c v : Position) (f : 𝓢(Position, E)) : + (∫ x, fderiv ℝ + (fun y : Position => inner ℝ (y - c) v / (‖y - c‖ ^ 2 + ε ^ 2)) x v * ‖f x‖ ^ 2) = + -2 * ∫ x, (inner ℝ (x - c) v / (‖x - c‖ ^ 2 + ε ^ 2)) * + inner ℝ (f x) (fderiv ℝ f x v) := by + let g := SchwartzMap.pairing (innerSL ℝ) f f + have hg : (g : Position → ℝ) = (fun x => ‖f x‖ ^ 2) := by + funext x + exact real_inner_self_eq_norm_sq (f x) + have hh := integral_hardy_component_mul_fderiv hε c v g + rw [hg] at hh + simp_rw [fderiv_schwartz_norm_sq] at hh + have he : (fun x => (inner ℝ (x - c) v / (‖x - c‖ ^ 2 + ε ^ 2)) * + (2 * inner ℝ (f x) (fderiv ℝ f x v))) = + (fun x => 2 * ((inner ℝ (x - c) v / (‖x - c‖ ^ 2 + ε ^ 2)) * + inner ℝ (f x) (fderiv ℝ f x v))) := by funext x; ring + rw [he, integral_const_mul] at hh + linarith only [hh] + +/-- The pointwise square estimate used to absorb half the weighted mass. -/ +theorem hardy_component_young (a : ℝ) (u v : E) : + -2 * a * inner ℝ u v ≤ (a ^ 2 * ‖u‖ ^ 2) / 2 + 2 * ‖v‖ ^ 2 := by + have hh := sq_nonneg ‖(a / 2) • u + v‖ + rw [norm_add_sq_real, norm_smul, Real.norm_eq_abs, mul_pow, sq_abs, + real_inner_smul_left] at hh + nlinarith only [hh] + +/-- A temperate multiplier times the squared Schwartz norm is integrable. -/ +theorem integrable_temperate_mul_norm_sq {a : Position → ℝ} + (ha : a.HasTemperateGrowth) (f : 𝓢(Position, E)) : + Integrable (fun x => a x * ‖f x‖ ^ 2) (volume : Measure Position) := by + convert integrable_temperate_mul_schwartz ha (SchwartzMap.pairing (innerSL ℝ) f f) using 1 + funext x + rw [SchwartzMap.pairing_apply_apply, innerSL_apply_apply, real_inner_self_eq_norm_sq] + +/-- The regularized Hardy estimate with constant four, uniform in the pole and scale. -/ +theorem integral_hardy_regularized_le {ε : ℝ} (hε : 0 < ε) + (c : Position) (f : 𝓢(Position, E)) : + (∫ x, (‖x - c‖ ^ 2 + ε ^ 2)⁻¹ * ‖f x‖ ^ 2) ≤ + 4 * ∑ i : Fin 3, ∫ x, ‖fderiv ℝ f x (EuclideanSpace.basisFun (Fin 3) ℝ i)‖ ^ 2 := by + let e := EuclideanSpace.basisFun (Fin 3) ℝ + let a := fun (i : Fin 3) (x : Position) => inner ℝ (x - c) (e i) / (‖x - c‖ ^ 2 + ε ^ 2) + let b := fun (i : Fin 3) (x : Position) => fderiv ℝ (a i) x (e i) + let g := fun (i : Fin 3) (x : Position) => fderiv ℝ f x (e i) + have hiA := integrable_temperate_mul_norm_sq (hasTemperateGrowth_hardy_weight hε c) f + have hiB (i : Fin 3) : Integrable (fun x => b i x * ‖f x‖ ^ 2) := + integrable_temperate_mul_norm_sq (hasTemperateGrowth_fderiv_hardy_component hε c (e i) (e i)) f + have hiG (i : Fin 3) : Integrable (fun x => ‖g i x‖ ^ 2) := by + simpa only [one_mul, SchwartzMap.lineDerivOp_apply_eq_fderiv, g] using + integrable_temperate_mul_norm_sq + (Function.HasTemperateGrowth.const (1 : ℝ)) (LineDeriv.lineDerivOp (e i) f) + have hiC (i : Fin 3) : Integrable (fun x => -2 * a i x * inner ℝ (f x) (g i x)) := by + have hh := (integrable_temperate_mul_schwartz (hasTemperateGrowth_hardy_component hε c (e i)) + (SchwartzMap.pairing (innerSL ℝ) f (LineDeriv.lineDerivOp (e i) f))).const_mul (-2) + convert hh using 1 + funext x + simp only [a, g, SchwartzMap.pairing_apply_apply, + SchwartzMap.lineDerivOp_apply_eq_fderiv] + change -2 * (inner ℝ (x - c) (e i) / (‖x - c‖ ^ 2 + ε ^ 2)) * + inner ℝ (f x) (fderiv ℝ f x (e i)) = + -2 * ((inner ℝ (x - c) (e i) / (‖x - c‖ ^ 2 + ε ^ 2)) * + inner ℝ (f x) (fderiv ℝ f x (e i))) + ring + have hdiv (x : Position) : (‖x - c‖ ^ 2 + ε ^ 2)⁻¹ ≤ ∑ i, b i x := by + rw [show (∑ i, b i x) = (‖x - c‖ ^ 2 + 3 * ε ^ 2) / + (‖x - c‖ ^ 2 + ε ^ 2) ^ 2 from sum_fderiv_hardy_component hε c x] + have hp := add_pos_of_nonneg_of_pos (sq_nonneg ‖x - c‖) (sq_pos_of_pos hε) + apply (le_div_iff₀ (sq_pos_of_pos hp)).mpr + rw [show (‖x - c‖ ^ 2 + ε ^ 2)⁻¹ * (‖x - c‖ ^ 2 + ε ^ 2) ^ 2 = + ‖x - c‖ ^ 2 + ε ^ 2 by + calc + _ = (‖x - c‖ ^ 2 + ε ^ 2)⁻¹ * + ((‖x - c‖ ^ 2 + ε ^ 2) * (‖x - c‖ ^ 2 + ε ^ 2)) := by ring + _ = _ := inv_mul_cancel_left₀ hp.ne' _] + nlinarith only [sq_nonneg ε] + have ha (x : Position) : (∑ i, a i x ^ 2) ≤ (‖x - c‖ ^ 2 + ε ^ 2)⁻¹ := by + change (∑ i : Fin 3, (inner ℝ (x - c) (e i) / (‖x - c‖ ^ 2 + ε ^ 2)) ^ 2) ≤ _ + dsimp [e] + simp_rw [div_pow, EuclideanSpace.inner_basisFun_real] + rw [← Finset.sum_div, ← EuclideanSpace.real_norm_sq_eq] + have hp := add_pos_of_nonneg_of_pos (sq_nonneg ‖x - c‖) (sq_pos_of_pos hε) + apply (div_le_iff₀ (sq_pos_of_pos hp)).mpr + rw [show (‖x - c‖ ^ 2 + ε ^ 2)⁻¹ * (‖x - c‖ ^ 2 + ε ^ 2) ^ 2 = + ‖x - c‖ ^ 2 + ε ^ 2 by + calc + _ = (‖x - c‖ ^ 2 + ε ^ 2)⁻¹ * + ((‖x - c‖ ^ 2 + ε ^ 2) * (‖x - c‖ ^ 2 + ε ^ 2)) := by ring + _ = _ := inv_mul_cancel_left₀ hp.ne' _] + exact le_add_of_nonneg_right (sq_nonneg ε) + have hy (x : Position) : + (∑ i, -2 * a i x * inner ℝ (f x) (g i x)) ≤ + ((‖x - c‖ ^ 2 + ε ^ 2)⁻¹ * ‖f x‖ ^ 2) / 2 + 2 * ∑ i, ‖g i x‖ ^ 2 := by + calc + _ ≤ ∑ i, ((a i x ^ 2 * ‖f x‖ ^ 2) / 2 + 2 * ‖g i x‖ ^ 2) := + Finset.sum_le_sum (fun i _ => hardy_component_young (a i x) (f x) (g i x)) + _ = ((∑ i, a i x ^ 2) * ‖f x‖ ^ 2) / 2 + 2 * ∑ i, ‖g i x‖ ^ 2 := by + rw [Finset.sum_add_distrib, ← Finset.sum_div, ← Finset.sum_mul, ← Finset.mul_sum] + _ ≤ _ := by gcongr; exact ha x + have he : (∫ x, ∑ i, b i x * ‖f x‖ ^ 2) = + ∫ x, ∑ i, -2 * a i x * inner ℝ (f x) (g i x) := by + rw [integral_finsetSum _ (fun i _ => hiB i), integral_finsetSum _ (fun i _ => hiC i)] + apply Finset.sum_congr rfl + intro i _ + rw [integral_hardy_component_norm_sq hε c (e i) f] + rw [← integral_const_mul] + apply integral_congr_ae + exact Filter.Eventually.of_forall (fun x => by dsimp [a, g]; ring) + have h₁ : (∫ x, (‖x - c‖ ^ 2 + ε ^ 2)⁻¹ * ‖f x‖ ^ 2) ≤ + ∫ x, ∑ i, b i x * ‖f x‖ ^ 2 := by + apply integral_mono hiA (integrable_finsetSum _ (fun i _ => hiB i)) + intro x + dsimp only + rw [← Finset.sum_mul] + exact mul_le_mul_of_nonneg_right (hdiv x) (sq_nonneg _) + have h₂ := integral_mono (integrable_finsetSum _ (fun i _ => hiC i)) + ((hiA.div_const 2).add ((integrable_finsetSum _ (fun i _ => hiG i)).const_mul 2)) hy + simp only [Pi.add_apply] at h₂ + rw [integral_add (hiA.div_const 2) ((integrable_finsetSum _ (fun i _ => hiG i)).const_mul 2), + integral_div, integral_const_mul, integral_finsetSum _ (fun i _ => hiG i)] at h₂ + rw [← he] at h₂ + linarith only [h₁, h₂] + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Analysis/HardySchwartz.lean b/LeanPool/LiebThirring/Analysis/HardySchwartz.lean new file mode 100644 index 0000000000..fef54f67ca --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/HardySchwartz.lean @@ -0,0 +1,148 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. +public import LeanPool.LiebThirring.Analysis.HardyRegularized +public import LeanPool.LiebThirring.Fourier.Schwartz +/-! +# Hardy and Coulomb bounds for Schwartz functions + +Hardy on the Schwartz core after removing the regularization by Fatou. + +The elementary comparison between the Coulomb and inverse-square kernels. +-/ +public section +open MeasureTheory Filter +open scoped RealInnerProductSpace SchwartzMap ENNReal NNReal Topology FourierTransform +namespace LiebThirring +variable {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℝ E] + +/-- Hardy on the Schwartz core after removing the regularization by Fatou. -/ +theorem lintegral_coulomb_sq_schwartz_le (c : Position) (f : 𝓢(Position, E)) : + (∫⁻ x, coulombKernel x c ^ 2 * (‖f x‖₊ : ℝ≥0∞) ^ 2) ≤ + ENNReal.ofReal (4 * ∑ i : Fin 3, + ∫ x, ‖fderiv ℝ f x (EuclideanSpace.basisFun (Fin 3) ℝ i)‖ ^ 2) := by + let F := fun (ε : ℝ) (x : Position) => + (ENNReal.ofReal (‖x - c‖ ^ 2 + ε ^ 2))⁻¹ * (‖f x‖₊ : ℝ≥0∞) ^ 2 + have hm (ε : ℝ) : Measurable (F ε) := by + dsimp [F] + exact ((ENNReal.continuous_ofReal.measurable.comp + ((continuous_norm.comp (continuous_id.sub continuous_const)).pow 2 |>.add + continuous_const).measurable).inv).mul + ((ENNReal.continuous_coe.measurable.comp f.continuous.nnnorm.measurable).pow_const 2) + have ht (x : Position) : Tendsto (fun ε : ℝ => F ε x) (𝓝[>] 0) + (𝓝 (coulombKernel x c ^ 2 * (‖f x‖₊ : ℝ≥0∞) ^ 2)) := by + have hh : Tendsto (fun ε : ℝ => ENNReal.ofReal (‖x - c‖ ^ 2 + ε ^ 2)) + (𝓝[>] 0) (𝓝 (ENNReal.ofReal (‖x - c‖ ^ 2))) := by + apply ENNReal.tendsto_ofReal + simpa only [zero_pow (by decide : (2 : ℕ) ≠ 0), add_zero] using + ((tendsto_const_nhds : Tendsto (fun _ : ℝ => ‖x - c‖ ^ 2) (𝓝[>] (0 : ℝ)) (𝓝 (‖x - c‖ ^ + 2))).add + ((show Tendsto (fun ε : ℝ => ε) (𝓝[>] 0) (𝓝 0) from nhdsWithin_le_nhds).pow 2)) + have hh' := ENNReal.Tendsto.mul_const (tendsto_inv_iff.mpr hh) + (Or.inr (by finiteness : (‖f x‖₊ : ℝ≥0∞) ^ 2 ≠ ⊤)) + simpa only [F, coulombKernel, ENNReal.ofReal_pow (norm_nonneg _), ENNReal.inv_pow] using hh' + have hb : ∀ᶠ ε : ℝ in 𝓝[>] 0, (∫⁻ x, F ε x) ≤ + ENNReal.ofReal (4 * ∑ i : Fin 3, + ∫ x, ‖fderiv ℝ f x (EuclideanSpace.basisFun (Fin 3) ℝ i)‖ ^ 2) := by + filter_upwards [self_mem_nhdsWithin] with ε hε + have hε' : 0 < ε := hε + have hi := integrable_temperate_mul_norm_sq (hasTemperateGrowth_hardy_weight hε' c) f + have he : (∫⁻ x, F ε x) = + ENNReal.ofReal (∫ x, (‖x - c‖ ^ 2 + ε ^ 2)⁻¹ * ‖f x‖ ^ 2) := by + rw [ofReal_integral_eq_lintegral_ofReal hi] + · apply lintegral_congr + intro x + have hp := add_pos_of_nonneg_of_pos (sq_nonneg ‖x - c‖) (sq_pos_of_pos hε') + simp only [F, ENNReal.ofReal_mul (inv_nonneg.mpr hp.le), + ENNReal.ofReal_inv_of_pos hp, ENNReal.ofReal_pow (norm_nonneg _), ofReal_norm] + rfl + · exact Filter.Eventually.of_forall (fun x => mul_nonneg (by positivity) (sq_nonneg _)) + rw [he] + exact ENNReal.ofReal_le_ofReal (integral_hardy_regularized_le hε' c f) + calc + _ = ∫⁻ x, liminf (fun ε : ℝ => F ε x) (𝓝[>] 0) := + lintegral_congr (fun x => (ht x).liminf_eq.symm) + _ ≤ liminf (fun ε : ℝ => ∫⁻ x, F ε x) (𝓝[>] 0) := lintegral_liminf_le hm + _ ≤ _ := liminf_le_of_frequently_le hb.frequently + +/-- The elementary comparison between the Coulomb and inverse-square kernels. -/ +theorem coulombKernel_le_one_add_sq (x c : Position) : + coulombKernel x c ≤ 1 + coulombKernel x c ^ 2 := by + by_cases h : coulombKernel x c ≤ 1 + · exact h.trans le_self_add + · have h₁ : 1 ≤ coulombKernel x c := (lt_of_not_ge h).le + rw [pow_two] + exact (le_mul_of_one_le_right' h₁).trans le_add_self + +end LiebThirring + +namespace LiebThirring +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- The three coordinate derivative energies equal the radial Fourier kinetic integral. -/ +theorem schwartz_dirichlet_eq_fourier (f : 𝓢(Position, H)) : + ENNReal.ofReal (4 * ∑ i : Fin 3, + ∫ x, ‖fderiv ℝ f x (EuclideanSpace.basisFun (Fin 3) ℝ i)‖ ^ 2) = + 4 * ∫⁻ ξ, ENNReal.ofReal ((2 * Real.pi) ^ 2) * (‖ξ‖₊ : ℝ≥0∞) ^ 2 * + (‖(𝓕 f) ξ‖₊ : ℝ≥0∞) ^ 2 := by + rw [ENNReal.ofReal_mul (by norm_num : (0 : ℝ) ≤ 4), ENNReal.ofReal_ofNat, + ENNReal.ofReal_sum_of_nonneg (fun i _ => integral_nonneg (fun x => sq_nonneg _))] + congr 1 + have hd (i : Fin 3) : ENNReal.ofReal + (∫ x, ‖fderiv ℝ f x (EuclideanSpace.basisFun (Fin 3) ℝ i)‖ ^ 2) = + ∫⁻ ξ, ENNReal.ofReal ((2 * Real.pi) ^ 2) * + ENNReal.ofReal ((inner ℝ ξ (EuclideanSpace.basisFun (Fin 3) ℝ i)) ^ 2) * + (‖(𝓕 f) ξ‖₊ : ℝ≥0∞) ^ 2 := by + have hh := Fourier.lintegral_norm_sq_eq_ofReal_integral + (LineDeriv.lineDerivOp (EuclideanSpace.basisFun (Fin 3) ℝ i) f) + simp only [SchwartzMap.lineDerivOp_apply_eq_fderiv] at hh + rw [← hh] + exact Fourier.lintegral_fderiv_eq_fourier f _ + simp_rw [hd] + rw [← lintegral_finsetSum] + · apply lintegral_congr + intro ξ + rw [← Finset.sum_mul, ← Finset.mul_sum, + ← ENNReal.ofReal_sum_of_nonneg (fun i _ => sq_nonneg _), + (EuclideanSpace.basisFun (Fin 3) ℝ).sum_sq_inner_left, ENNReal.ofReal_pow (norm_nonneg _), + ofReal_norm] + rfl + · intro i _ + exact (measurable_const.mul (ENNReal.continuous_ofReal.measurable.comp + (((continuous_id.inner continuous_const).pow 2).measurable))).mul + ((ENNReal.continuous_coe.measurable.comp (𝓕 f).continuous.nnnorm.measurable).pow_const 2) + +/-- Schwartz Hardy with the exact Mathlib Fourier normalization. -/ +theorem lintegral_coulomb_sq_schwartz_fourier_le (c : Position) (f : 𝓢(Position, H)) : + (∫⁻ x, coulombKernel x c ^ 2 * (‖f x‖₊ : ℝ≥0∞) ^ 2) ≤ + 4 * ∫⁻ ξ, ENNReal.ofReal ((2 * Real.pi) ^ 2) * (‖ξ‖₊ : ℝ≥0∞) ^ 2 * + (‖(𝓕 f) ξ‖₊ : ℝ≥0∞) ^ 2 := by + let : InnerProductSpace ℝ H := InnerProductSpace.rclikeToReal ℂ H + have hh := lintegral_coulomb_sq_schwartz_le (E := H) c f + rw [schwartz_dirichlet_eq_fourier f] at hh + exact hh + +/-- The Schwartz Coulomb expectation is bounded by mass plus four kinetic energies. -/ +theorem lintegral_coulomb_schwartz_fourier_le (c : Position) (f : 𝓢(Position, H)) : + (∫⁻ x, coulombKernel x c * (‖f x‖₊ : ℝ≥0∞) ^ 2) ≤ + (∫⁻ x, (‖f x‖₊ : ℝ≥0∞) ^ 2) + + 4 * ∫⁻ ξ, ENNReal.ofReal ((2 * Real.pi) ^ 2) * (‖ξ‖₊ : ℝ≥0∞) ^ 2 * + (‖(𝓕 f) ξ‖₊ : ℝ≥0∞) ^ 2 := by + calc + _ ≤ ∫⁻ x, (1 + coulombKernel x c ^ 2) * (‖f x‖₊ : ℝ≥0∞) ^ 2 := + lintegral_mono (fun x => mul_le_mul' (coulombKernel_le_one_add_sq x c) le_rfl) + _ = (∫⁻ x, (‖f x‖₊ : ℝ≥0∞) ^ 2) + + ∫⁻ x, coulombKernel x c ^ 2 * (‖f x‖₊ : ℝ≥0∞) ^ 2 := by + simp only [add_mul, one_mul] + apply lintegral_add_left + exact (ENNReal.continuous_coe.measurable.comp f.continuous.nnnorm.measurable).pow_const 2 + _ ≤ _ := add_le_add le_rfl (lintegral_coulomb_sq_schwartz_fourier_le c f) + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Analysis/MaximumPrinciple.lean b/LeanPool/LiebThirring/Analysis/MaximumPrinciple.lean new file mode 100644 index 0000000000..30b22e136c --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/MaximumPrinciple.lean @@ -0,0 +1,213 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. +import Mathlib.Analysis.Calculus.Taylor +public import Mathlib.Analysis.InnerProductSpace.Laplacian +import Mathlib.Analysis.InnerProductSpace.Calculus +/-! +# The maximum principle and decaying classical harmonic functions + +The scalar second derivative is nonpositive at a local maximum. + +The Hessian quadratic form is nonpositive at a local maximum. +-/ +public section +open Filter Set Metric +open scoped Topology +namespace LiebThirring +/-- The scalar second derivative is nonpositive at a local maximum. -/ +lemma second_deriv_nonpos_at_local_max {f : ℝ → ℝ} {a : ℝ} + (hf : ContDiffAt ℝ 2 f a) (hm : IsLocalMax f a) : iteratedDeriv 2 f a ≤ 0 := by + obtain ⟨s, hs, _, hfs⟩ := (hf.contDiffWithinAt (s := univ)).contDiffOn (m := 2) le_rfl (by + norm_num) + have hs' : s ∈ 𝓝 a := by simpa using hs + obtain ⟨ε, hε, hεs⟩ := Metric.mem_nhds_iff.mp hs' + have ha : a ∈ ball a ε := mem_ball_self hε + have hfb : ContDiffOn ℝ 2 f (ball a ε) := hfs.mono hεs + have ht := Real.taylor_tendsto (convex_ball a ε) ha hfb + have hp : ∀ t, taylorWithinEval f 2 (ball a ε) a t = + f a + iteratedDeriv 2 f a / 2 * (t - a)^2 := by + intro t + rw [taylorWithinEval_succ f 1, taylorWithinEval_succ f 0, taylor_within_zero_eval] + simp only [iteratedDerivWithin_of_isOpen isOpen_ball ha, smul_eq_mul] + norm_num + rw [hm.deriv_eq_zero] + ring + simp_rw [hp] at ht + rw [nhdsWithin_eq_nhds.mpr (ball_mem_nhds a hε)] at ht + have ht' := ht.mono_left (nhdsWithin_le_nhds (s := {a}ᶜ)) + have hm' : ∀ᶠ t in 𝓝[≠] a, f t ≤ f a := hm.filter_mono nhdsWithin_le_nhds + have hle : (0 : ℝ) ≤ -(iteratedDeriv 2 f a / 2) := le_of_tendsto ht' (by + filter_upwards [hm', eventually_mem_nhdsWithin] with t htm hta + have hne : t - a ≠ 0 := sub_ne_zero.mpr hta + have hsq : 0 < (t - a)^2 := sq_pos_of_ne_zero hne + apply (div_le_iff₀ hsq).mpr + nlinarith only [htm]) + linarith only [hle] + +variable {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℝ E] +/-- The Hessian quadratic form is nonpositive at a local maximum. -/ +lemma hessian_nonpos_at_local_max {f : E → ℝ} {x : E} + (hf : ContDiffAt ℝ 2 f x) (hm : IsLocalMax f x) (v : E) : + fderiv ℝ (fderiv ℝ f) x v v ≤ 0 := by + let l : ℝ → E := fun t => x + t • v + have hl : ∀ t, HasDerivAt l v t := by + intro t + simpa only [one_smul, id_eq, l] using ((hasDerivAt_id t).smul_const v).const_add x + have hl₀ : l 0 = x := by simp only [l, zero_smul, add_zero] + have hfl : ContDiffAt ℝ 2 (f ∘ l) 0 := by + have hf₀ : ContDiffAt ℝ 2 f (l 0) := hl₀.symm ▸ hf + exact hf₀.comp 0 (contDiffAt_const.add (contDiffAt_id.smul contDiffAt_const)) + have hm₀ : IsLocalMax (f ∘ l) 0 := by + apply IsLocalMax.comp_continuous (g := l) + · rwa [hl₀] + · exact (hl 0).continuousAt + have hd : deriv (f ∘ l) =ᶠ[𝓝 0] (fun t => fderiv ℝ f (l t) v) := by + have htend : Tendsto l (𝓝 0) (𝓝 x) := by + simpa only [ContinuousAt, hl₀] using (hl 0).continuousAt + have hneigh := htend.eventually (hf.eventually (by norm_num)) + filter_upwards [hneigh] with t ht + exact (ht.differentiableAt (by norm_num) |>.hasFDerivAt.comp_hasDerivAt t (hl t)).deriv + have hdf : ContDiffAt ℝ 1 (fderiv ℝ f) x := hf.fderiv_right (by norm_num) + have hdd : HasDerivAt (fun t => fderiv ℝ f (l t) v) + (fderiv ℝ (fderiv ℝ f) x v v) 0 := by + have h₁ := (hdf.differentiableAt one_ne_zero).hasFDerivAt + rw [← hl₀] at h₁ + simpa only [Function.comp_apply, add_zero, map_zero, hl₀] using + (h₁.comp_hasDerivAt 0 (hl 0)).clm_apply (hasDerivAt_const 0 v) + have hs := second_deriv_nonpos_at_local_max hfl hm₀ + rw [show (2 : ℕ) = 1 + 1 from rfl, iteratedDeriv_succ, iteratedDeriv_one, + hd.deriv_eq, hdd.deriv] at hs + exact hs + +variable [FiniteDimensional ℝ E] +open InnerProductSpace Laplacian +/-- The Laplacian of a `C²` function is nonpositive at a local maximum. -/ +lemma laplacian_nonpos_at_local_max {f : E → ℝ} {x : E} + (hf : ContDiffAt ℝ 2 f x) (hm : IsLocalMax f x) : Δ f x ≤ 0 := by + classical + rw [laplacian_eq_iteratedFDeriv_stdOrthonormalBasis] + apply Finset.sum_nonpos + intro i _ + simpa only [iteratedFDeriv_two_apply, Matrix.cons_val_zero, Matrix.cons_val_one] using + hessian_nonpos_at_local_max hf hm ((stdOrthonormalBasis ℝ E) i) + +/-- The Euclidean quadratic barrier has Laplacian twice the dimension. -/ +lemma laplacian_norm_sq (x : E) : Δ (fun y : E => ‖y‖^2) x = 2 * Module.finrank ℝ E := by + classical + rw [laplacian_eq_iteratedFDeriv_stdOrthonormalBasis] + simp only [iteratedFDeriv_two_apply, Matrix.cons_val_zero, Matrix.cons_val_one, fderiv_norm_sq] + rw [fderiv_const_smul (innerSL ℝ (E := E)).differentiableAt] + simp [ContinuousLinearMap.fderiv, innerSL, innerₛₗ, OrthonormalBasis.norm_eq_one] + ring + +/-- A function with positive Laplacian cannot have a local maximum. -/ +lemma not_isLocalMax_of_laplacian_pos {f : E → ℝ} {x : E} + (hf : ContDiffAt ℝ 2 f x) (hΔ : 0 < Δ f x) : ¬ IsLocalMax f x := + fun hm => (not_lt_of_ge (laplacian_nonpos_at_local_max hf hm)) hΔ + +variable [Nontrivial E] +/-- The maximum principle on a closed ball, proved with the quadratic barrier. -/ +theorem le_of_laplacian_eq_zero_on_closedBall {h : E → ℝ} {c x : E} {R M : ℝ} + (hR : 0 < R) (hh : ∀ y ∈ closedBall c R, ContDiffAt ℝ 2 h y) + (hΔ : ∀ y ∈ ball c R, Δ h y = 0) + (hbd : ∀ y ∈ sphere c R, h y ≤ M) (hx : x ∈ closedBall c R) : h x ≤ M := by + have hbound : ∀ τ : ℝ, 0 < τ → h x ≤ M + τ * (‖c‖ + R)^2 := by + intro τ hτ + let q : E → ℝ := fun y => h y + τ * ‖y‖^2 + have hq : ∀ y ∈ closedBall c R, ContDiffAt ℝ 2 q y := by + intro y hy + exact (hh y hy).add ((contDiff_norm_sq ℝ).contDiffAt.const_smul τ) + obtain ⟨y, hy, hmax⟩ := (isCompact_closedBall c R).exists_isMaxOn + (nonempty_closedBall.mpr hR.le) (fun y hy => (hq y hy).continuousAt.continuousWithinAt) + have hybd : y ∈ sphere c R := by + apply mem_sphere.mpr + apply le_antisymm (mem_closedBall.mp hy) + by_contra hnot + have hyin : y ∈ ball c R := mem_ball.mpr (lt_of_not_ge hnot) + have hloc : IsLocalMax q y := hmax.isLocalMax + (mem_of_superset (ball_mem_nhds y (sub_pos.mpr (mem_ball.mp hyin))) (by + intro z hz + apply mem_closedBall.mpr + calc dist z c ≤ dist z y + dist y c := dist_triangle z y c + _ ≤ R := by linarith only [mem_ball.mp hz])) + have hlap : Δ q y = τ * (2 * Module.finrank ℝ E) := by + calc + Δ q y = Δ h y + Δ (τ • (fun z : E => ‖z‖^2)) y := + (hh y hy).laplacian_add ((contDiff_norm_sq ℝ).contDiffAt.const_smul τ) + _ = τ * (2 * Module.finrank ℝ E) := by + rw [hΔ y hyin, laplacian_smul τ (contDiff_norm_sq ℝ).contDiffAt, laplacian_norm_sq] + simp only [zero_add, smul_eq_mul] + have hpos : 0 < Δ q y := by + rw [hlap] + exact mul_pos hτ (mul_pos (by norm_num) (Nat.cast_pos.mpr Module.finrank_pos)) + exact not_isLocalMax_of_laplacian_pos (hq y hy) hpos hloc + have hyn : ‖y‖ ≤ ‖c‖ + R := by + calc ‖y‖ ≤ ‖y - c‖ + ‖c‖ := norm_le_norm_sub_add y c + _ = ‖c‖ + R := by rw [← dist_eq_norm, mem_sphere.mp hybd]; ring + have hsq : ‖y‖^2 ≤ (‖c‖ + R)^2 := + pow_le_pow_left₀ (norm_nonneg _) hyn 2 + have hcomp := hmax hx + have hboundary := hbd y hybd + have hbarrier : τ * ‖y‖^2 ≤ τ * (‖c‖ + R)^2 := mul_le_mul_of_nonneg_left hsq hτ.le + have hxpos : 0 ≤ τ * ‖x‖^2 := mul_nonneg hτ.le (sq_nonneg _) + change h x + τ * ‖x‖^2 ≤ h y + τ * ‖y‖^2 at hcomp + linarith only [hcomp, hboundary, hbarrier, hxpos] + have hτlim : Tendsto (fun τ : ℝ => τ) (𝓝[>] 0) (𝓝 0) := + tendsto_id.mono_right nhdsWithin_le_nhds + have hclim : Tendsto (fun _ : ℝ => M) (𝓝[>] 0) (𝓝 M) := tendsto_const_nhds + apply ge_of_tendsto (x := 𝓝[>] (0 : ℝ)) + (show Tendsto (fun τ : ℝ => M + τ * (‖c‖ + R)^2) (𝓝[>] 0) (𝓝 M) from by + simpa only [zero_mul, add_zero] using hclim.add (hτlim.mul_const ((‖c‖ + R)^2))) + filter_upwards [eventually_mem_nhdsWithin] with τ hτ + exact hbound τ hτ + +/-- A globally `C²` harmonic function decaying at infinity is nonpositive. -/ +theorem nonpos_of_laplacian_eq_zero_of_tendsto {h : E → ℝ} + (hh : ContDiff ℝ 2 h) (hΔ : ∀ x, Δ h x = 0) + (hd : Tendsto h (cocompact E) (𝓝 0)) (x : E) : h x ≤ 0 := by + apply le_of_forall_pos_le_add + intro ε hε + have he : ∀ᶠ y in cocompact E, h y < ε := hd.eventually (Iio_mem_nhds hε) + obtain ⟨K, hK, hKe⟩ := mem_cocompact.mp he + obtain ⟨A, hKA⟩ := hK.isBounded.subset_closedBall (0 : E) + let R : ℝ := max A ‖x‖ + 1 + have hR : 0 < R := by + have hm := le_max_right A ‖x‖ + have hx₀ := norm_nonneg x + dsimp only [R] + linarith only [hm, hx₀] + have hxR : x ∈ closedBall (0 : E) R := by + rw [mem_closedBall_zero_iff] + exact (le_max_right A ‖x‖).trans (le_add_of_nonneg_right zero_le_one) + have hbd : ∀ y ∈ sphere (0 : E) R, h y ≤ ε := by + intro y hy + refine le_of_lt (hKe ?_) + intro hyK + have hyA := mem_closedBall_zero_iff.mp (hKA hyK) + have hyR : ‖y‖ = R := by simpa only [mem_sphere, dist_zero_right] using hy + have hAR := le_max_left A ‖x‖ + dsimp only [R] at hyR + linarith only [hyA, hyR, hAR] + simpa only [zero_add] using le_of_laplacian_eq_zero_on_closedBall hR + (fun y _ => hh.contDiffAt) (fun y _ => hΔ y) hbd hxR + +/-- Uniqueness for classical harmonic functions decaying at infinity. -/ +theorem eq_zero_of_laplacian_eq_zero_of_tendsto {h : E → ℝ} + (hh : ContDiff ℝ 2 h) (hΔ : ∀ x, Δ h x = 0) + (hd : Tendsto h (cocompact E) (𝓝 0)) : h = 0 := by + funext x + apply le_antisymm (nonpos_of_laplacian_eq_zero_of_tendsto hh hΔ hd x) + have hnΔ : ∀ y, Δ (-h) y = 0 := by simp only [laplacian_neg, Pi.neg_apply, hΔ, neg_zero, + implies_true] + have hnd : Tendsto (-h) (cocompact E) (𝓝 0) := by simpa only [neg_zero, Pi.neg_def] using hd.neg + have hn := nonpos_of_laplacian_eq_zero_of_tendsto hh.neg hnΔ hnd x + simpa only [Pi.neg_apply, neg_nonpos] using hn +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Analysis/WeakHarmonic.lean b/LeanPool/LiebThirring/Analysis/WeakHarmonic.lean new file mode 100644 index 0000000000..1262bd49ab --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/WeakHarmonic.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. +public import LeanPool.LiebThirring.Analysis.WeakHarmonicDecay +import LeanPool.LiebThirring.Analysis.MaximumPrinciple +public import LeanPool.LiebThirring.Defs.Configuration +import Mathlib.Analysis.Asymptotics.SpecificAsymptotics +/-! +# Uniqueness for continuous decaying weakly harmonic functions + +Continuity and decay at infinity imply a globally bounded range. + +A continuous weakly harmonic function decaying at infinity vanishes. +-/ +public section +open Filter MeasureTheory ContinuousLinearMap InnerProductSpace Laplacian +open scoped Topology Convolution ContDiff +namespace LiebThirring +variable {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℝ E] [FiniteDimensional ℝ E] + [Nontrivial E] [MeasurableSpace E] [BorelSpace E] {μ : Measure E} [μ.IsAddHaarMeasure] + +/-- A continuous weakly harmonic function decaying at infinity vanishes. -/ +theorem eq_zero_of_weak_laplacian_of_tendsto {w : E → ℝ} + (hw : Continuous w) + (hweak : ∀ f : E → ℝ, ContDiff ℝ ∞ f → HasCompactSupport f → + (∫ x, w x * Δ f x ∂μ) = 0) + (hd : Tendsto w (cocompact E) (𝓝 0)) : w = 0 := by + let b : ℕ → ContDiffBump (0 : E) := fun n => + ⟨(1 / ((n : ℝ) + 1)) / 2, 1 / ((n : ℝ) + 1), + half_pos (by positivity), half_lt_self (by positivity)⟩ + have hb : Tendsto (fun n => (b n).rOut) atTop (𝓝 0) := + tendsto_one_div_add_atTop_nhds_zero_nat + have hz : ∀ n, (b n).normed μ ⋆[lsmul ℝ ℝ, μ] w = 0 := by + intro n + rw [convolution_real_comm] + apply eq_zero_of_laplacian_eq_zero_of_tendsto + · exact contDiff_convolution_of_continuous hw (b n).contDiff_normed (b + n).hasCompactSupport_normed + · exact laplacian_convolution_eq_zero_of_weak hw hweak + (b n).contDiff_normed (b n).hasCompactSupport_normed + · rw [convolution_real_comm] + exact tendsto_normed_bump_convolution_cocompact hw hd (b n) + funext x + have ht := ContDiffBump.convolution_tendsto_right_of_continuous (μ := μ) hb hw x + simp only [hz, Pi.zero_apply] at ht + exact tendsto_nhds_unique ht tendsto_const_nhds + +/-- harmonic uniqueness on the three-dimensional carrier. -/ +theorem weak_harmonic_eq_zero {w : Position → ℝ} + (hw : Continuous w) + (hweak : ∀ f : Position → ℝ, ContDiff ℝ ∞ f → HasCompactSupport f → + (∫ x, w x * Δ f x) = 0) + (hd : Tendsto w (cocompact Position) (𝓝 0)) : w = 0 := + eq_zero_of_weak_laplacian_of_tendsto hw hweak hd +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Analysis/WeakHarmonicConvolution.lean b/LeanPool/LiebThirring/Analysis/WeakHarmonicConvolution.lean new file mode 100644 index 0000000000..9e447db0b4 --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/WeakHarmonicConvolution.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. +public import Mathlib.Analysis.Calculus.ContDiff.Convolution +public import Mathlib.Analysis.InnerProductSpace.Laplacian +/-! +# Second derivatives of compactly supported convolutions + +Smooth compactly supported kernels regularize continuous functions. + +The Hessian of a convolution is the convolution of the kernel Hessian. +-/ +public section +open MeasureTheory ContinuousLinearMap +open scoped Convolution +namespace LiebThirring +variable {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℝ E] [FiniteDimensional ℝ E] + [MeasurableSpace E] [BorelSpace E] {μ : Measure E} + [IsLocallyFiniteMeasure μ] [SFinite μ] [μ.IsAddLeftInvariant] + {w b : E → ℝ} + +omit [SFinite μ] [μ.IsAddLeftInvariant] [FiniteDimensional ℝ E] in +/-- Smooth compactly supported kernels regularize continuous functions. -/ +theorem contDiff_convolution_of_continuous {n : ℕ∞} + (hw : Continuous w) (hb : ContDiff ℝ n b) (hbc : HasCompactSupport b) : + ContDiff ℝ n (w ⋆[lsmul ℝ ℝ, μ] b) := + hbc.contDiff_convolution_right (lsmul ℝ ℝ) hw.locallyIntegrable hb + +omit [FiniteDimensional ℝ E] in +/-- The Hessian of a convolution is the convolution of the kernel Hessian. -/ +theorem fderiv_fderiv_convolution (hw : Continuous w) (hb : ContDiff ℝ 2 b) + (hbc : HasCompactSupport b) (x u v : E) : + fderiv ℝ (fderiv ℝ (w ⋆[lsmul ℝ ℝ, μ] b)) x u v = + ∫ z, w z * (fderiv ℝ (fderiv ℝ b) (x - z) u v) ∂μ := by + let L : ℝ →L[ℝ] ℝ →L[ℝ] ℝ := lsmul ℝ ℝ + have hb₁ : ContDiff ℝ 1 b := hb.of_le (by norm_num) + have hdb : ContDiff ℝ 1 (fderiv ℝ b) := hb.fderiv_right (by norm_num) + have hd : fderiv ℝ (w ⋆[L, μ] b) = w ⋆[L.precompR E, μ] fderiv ℝ b := by + funext y + exact (hbc.hasFDerivAt_convolution_right L hw.locallyIntegrable hb₁ y).fderiv + rw [hd, (hbc.fderiv ℝ).hasFDerivAt_convolution_right (L.precompR E) + hw.locallyIntegrable hdb x |>.fderiv] + rw [convolution_precompR_apply _ hw.locallyIntegrable (hbc.fderiv ℝ |>.fderiv ℝ) + (hdb.continuous_fderiv one_ne_zero)] + have hc : HasCompactSupport (fun z => fderiv ℝ (fderiv ℝ b) z u) := + (hbc.fderiv ℝ |>.fderiv ℝ).comp_left + (g := ContinuousLinearMap.apply ℝ _ u) (map_zero (ContinuousLinearMap.apply ℝ _ u)) + have hh : Continuous (fun z => fderiv ℝ (fderiv ℝ b) z u) := + (hdb.continuous_fderiv one_ne_zero).clm_apply continuous_const + rw [convolution_precompR_apply _ hw.locallyIntegrable hc hh] + rfl + +omit [FiniteDimensional ℝ E] [MeasurableSpace E] [BorelSpace E] in +/-- Scalar evaluations of the kernel Hessian have compact support. -/ +theorem hasCompactSupport_kernel_hessian (hbc : HasCompactSupport b) (u v : E) : + HasCompactSupport (fun z => fderiv ℝ (fderiv ℝ b) z u v) := by + let ev₁ : (E →L[ℝ] E →L[ℝ] ℝ) →L[ℝ] E →L[ℝ] ℝ := ContinuousLinearMap.apply ℝ _ u + let ev₂ : (E →L[ℝ] ℝ) →L[ℝ] ℝ := ContinuousLinearMap.apply ℝ _ v + exact (hbc.fderiv ℝ |>.fderiv ℝ).comp_left + (g := ev₂.comp ev₁) (map_zero (ev₂.comp ev₁)) + +omit [FiniteDimensional ℝ E] [SFinite μ] [μ.IsAddLeftInvariant] [IsLocallyFiniteMeasure μ] + [MeasurableSpace E] [BorelSpace E] in +/-- Scalar evaluations of a `C²` kernel Hessian are continuous. -/ +theorem continuous_kernel_hessian (hb : ContDiff ℝ 2 b) (u v : E) : + Continuous (fun z => fderiv ℝ (fderiv ℝ b) z u v) := by + let ev₁ : (E →L[ℝ] E →L[ℝ] ℝ) →L[ℝ] E →L[ℝ] ℝ := ContinuousLinearMap.apply ℝ _ u + let ev₂ : (E →L[ℝ] ℝ) →L[ℝ] ℝ := ContinuousLinearMap.apply ℝ _ v + have hdb : ContDiff ℝ 1 (fderiv ℝ b) := hb.fderiv_right (by norm_num) + exact (ev₂.comp ev₁).continuous.comp (hdb.continuous_fderiv one_ne_zero) + +omit [FiniteDimensional ℝ E] [SFinite μ] [μ.IsAddLeftInvariant] in +/-- Scalar Hessian evaluations against a continuous function are integrable. -/ +theorem integrable_mul_kernel_hessian (hw : Continuous w) (hb : ContDiff ℝ 2 b) + (hbc : HasCompactSupport b) (x u v : E) : + Integrable (fun z => w z * fderiv ℝ (fderiv ℝ b) (x - z) u v) μ := + (hasCompactSupport_kernel_hessian hbc u v).convolutionExists_right (lsmul ℝ ℝ) + hw.locallyIntegrable (continuous_kernel_hessian hb u v) x + +open InnerProductSpace Laplacian +/-- The Laplacian commutes with convolution by a compactly supported `C²` kernel. -/ +theorem laplacian_convolution (hw : Continuous w) (hb : ContDiff ℝ 2 b) + (hbc : HasCompactSupport b) (x : E) : + Δ (w ⋆[lsmul ℝ ℝ, μ] b) x = ∫ z, w z * Δ b (x - z) ∂μ := by + classical + rw [laplacian_eq_iteratedFDeriv_stdOrthonormalBasis] + simp_rw [laplacian_eq_iteratedFDeriv_stdOrthonormalBasis b, iteratedFDeriv_two_apply] + simp only [Matrix.cons_val_zero, Matrix.cons_val_one] + simp_rw [fderiv_fderiv_convolution hw hb hbc, Finset.mul_sum] + rw [integral_finsetSum] + intro i _ + exact integrable_mul_kernel_hessian hw hb hbc x _ _ +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Analysis/WeakHarmonicDecay.lean b/LeanPool/LiebThirring/Analysis/WeakHarmonicDecay.lean new file mode 100644 index 0000000000..b14acadfbb --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/WeakHarmonicDecay.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. +public import LeanPool.LiebThirring.Analysis.WeakHarmonicRegularization +/-! +# Decay of compactly supported mollifications + +Real scalar convolution is commutative. + +Convolution with a normalized compact bump preserves decay at infinity. +-/ +public section +open Filter MeasureTheory ContinuousLinearMap Set Metric +open scoped Topology Convolution +namespace LiebThirring +variable {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℝ E] [FiniteDimensional ℝ E] + [MeasurableSpace E] [BorelSpace E] {μ : Measure E} [μ.IsAddHaarMeasure] +/-- Real scalar convolution is commutative. -/ +lemma convolution_real_comm (f g : E → ℝ) : f ⋆[lsmul ℝ ℝ, μ] g = g ⋆[lsmul ℝ ℝ, μ] f := by + exact convolution_symm (lsmul ℝ ℝ) (by + ext + exact mul_comm _ _) + +/-- Convolution with a normalized compact bump preserves decay at infinity. -/ +lemma tendsto_normed_bump_convolution_cocompact {w : E → ℝ} + (hw : Continuous w) (hd : Tendsto w (cocompact E) (𝓝 0)) (b : ContDiffBump (0 : E)) : + Tendsto (b.normed μ ⋆[lsmul ℝ ℝ, μ] w) (cocompact E) (𝓝 0) := by + apply Metric.tendsto_nhds.mpr + intro ε hε + have he : ∀ᶠ y in cocompact E, dist (w y) 0 < ε / 2 := + (Metric.tendsto_nhds.mp hd) (ε / 2) (half_pos hε) + obtain ⟨K, hK, hKe⟩ := mem_cocompact.mp he + obtain ⟨A, hKA⟩ := hK.isBounded.subset_closedBall (0 : E) + have hlarge : ∀ᶠ x : E in cocompact E, A + b.rOut < ‖x‖ := + tendsto_norm_cocompact_atTop.eventually (eventually_gt_atTop (A + b.rOut)) + filter_upwards [hlarge] with x hx + have hnear : ∀ y ∈ ball x b.rOut, dist (w y) 0 ≤ ε / 2 := by + intro y hy + refine le_of_lt (hKe ?_) + intro hyK + have hyA : ‖y‖ ≤ A := mem_closedBall_zero_iff.mp (hKA hyK) + have hxy : ‖x‖ ≤ dist y x + ‖y‖ := by + simpa only [dist_eq_norm, norm_sub_rev] using norm_le_norm_sub_add x y + linarith only [hyA, hxy, mem_ball.mp hy, hx] + have hle := dist_convolution_le (μ := μ) (f := b.normed μ) (g := w) (x₀ := x) + (half_pos hε).le b.support_normed_eq.subset b.nonneg_normed b.integral_normed + hw.aestronglyMeasurable hnear + exact hle.trans_lt (half_lt_self hε) +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Analysis/WeakHarmonicRegularization.lean b/LeanPool/LiebThirring/Analysis/WeakHarmonicRegularization.lean new file mode 100644 index 0000000000..13b5ebb0b7 --- /dev/null +++ b/LeanPool/LiebThirring/Analysis/WeakHarmonicRegularization.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. +public import LeanPool.LiebThirring.Analysis.WeakHarmonicConvolution +public import Mathlib.Analysis.Calculus.BumpFunction.Convolution +/-! +# Regularization of weakly harmonic functions + +Reflection about a fixed point negates the Fréchet derivative. + +The Laplacian is unchanged by reflection about a fixed point. +-/ +public section +open Filter MeasureTheory ContinuousLinearMap +open scoped Topology Convolution ContDiff +open InnerProductSpace Laplacian +namespace LiebThirring +variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] +variable {F : Type*} [NormedAddCommGroup F] [NormedSpace ℝ F] +/-- Reflection about a fixed point negates the Fréchet derivative. -/ +lemma fderiv_reflect {b : E → F} (hb : Differentiable ℝ b) (x y : E) : + fderiv ℝ (fun z => b (x-z)) y = - fderiv ℝ b (x-y) := by + have hh := (hb (x-y)).hasFDerivAt.comp y + ((hasFDerivAt_const x y).sub (hasFDerivAt_id y)) + calc + _ = (fderiv ℝ b (x-y)).comp (0 - ContinuousLinearMap.id ℝ E) := hh.fderiv + _ = _ := by + ext v + simp only [ContinuousLinearMap.comp_apply, + ContinuousLinearMap.id_apply, zero_sub, map_neg, neg_apply] + +end LiebThirring +namespace LiebThirring +variable {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℝ E] [FiniteDimensional ℝ E] +/-- The Laplacian is unchanged by reflection about a fixed point. -/ +lemma laplacian_reflect {b : E → ℝ} (hb : ContDiff ℝ 2 b) (x y : E) : + Δ (fun z => b (x-z)) y = Δ b (x-y) := by + have hb₁ : Differentiable ℝ b := hb.differentiable (by norm_num) + have hdb : ContDiff ℝ 1 (fderiv ℝ b) := hb.fderiv_right (by norm_num) + have hd : fderiv ℝ (fun z => b (x-z)) = fun z => - fderiv ℝ b (x-z) := + funext (fderiv_reflect hb₁ x) + have hdd : fderiv ℝ (fderiv ℝ (fun z => b (x-z))) y = fderiv ℝ (fderiv ℝ b) (x-y) := by + rw [hd] + rw [fderiv_fun_neg, fderiv_reflect (hdb.differentiable one_ne_zero), neg_neg] + simp only [laplacian_eq_iteratedFDeriv_stdOrthonormalBasis, iteratedFDeriv_two_apply, hdd] + +variable [MeasurableSpace E] [BorelSpace E] {μ : Measure E} + [IsLocallyFiniteMeasure μ] [SFinite μ] [μ.IsAddLeftInvariant] +/-- The weak test equation makes every smooth compact-kernel convolution harmonic. -/ +theorem laplacian_convolution_eq_zero_of_weak {w b : E → ℝ} + (hw : Continuous w) + (hweak : ∀ f : E → ℝ, ContDiff ℝ ∞ f → HasCompactSupport f → + (∫ z, w z * Δ f z ∂μ) = 0) + (hb : ContDiff ℝ ∞ b) (hbc : HasCompactSupport b) (x : E) : + Δ (w ⋆[lsmul ℝ ℝ, μ] b) x = 0 := by + have hb₂ : ContDiff ℝ 2 b := hb.of_le (by norm_num) + rw [laplacian_convolution hw hb₂ hbc] + have htest := hweak (fun z => b (x-z)) (hb.comp (contDiff_const.sub contDiff_id)) + (hbc.comp_homeomorph (Homeomorph.subLeft x)) + simpa only [laplacian_reflect hb₂] using htest + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Assembly/Coulomb.lean b/LeanPool/LiebThirring/Assembly/Coulomb.lean new file mode 100644 index 0000000000..75a807ee56 --- /dev/null +++ b/LeanPool/LiebThirring/Assembly/Coulomb.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.Coulomb +import LeanPool.LiebThirring.Kinetic.DensityBasic + +/-! +# Extended Coulomb measurability and endpoints + +Measurability and endpoint identities for extended Coulomb interactions, including singular +values and zero charges. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring.Assembly + +theorem measurable_coulombKernel : Measurable (Function.uncurry coulombKernel) := + ((measurable_fst.sub measurable_snd).norm.ennreal_ofReal).inv + +theorem measurable_nearestNucleusDistance {M : ℕ} (R : Fin M → Position) : + Measurable (nearestNucleusDistance R) := + Measurable.iInf (fun k => + (measurable_id.sub (measurable_const (a := R k))).norm.ennreal_ofReal) + +theorem measurable_nearestNucleusInverse {M : ℕ} (R : Fin M → Position) : + Measurable (fun x => (nearestNucleusDistance R x)⁻¹) := + (measurable_nearestNucleusDistance R).inv + +theorem measurable_electronRepulsion {N : ℕ} : + Measurable (electronRepulsion (N := N)) := by + unfold electronRepulsion + have hk (i j : Fin N) : Measurable (fun x : Configuration N => + coulombKernel (particlePosition x i) (particlePosition x j)) := + ((measurable_particlePosition i).sub + (measurable_particlePosition j)).norm.ennreal_ofReal.inv + exact Finset.measurable_sum _ (fun i _ => Finset.measurable_sum _ (fun j _ => hk i j)) + +theorem coulombKernel_eq_of_ne {x y : Position} (h : x ≠ y) : + coulombKernel x y = ENNReal.ofReal (‖x - y‖⁻¹) := by + unfold coulombKernel + exact (ENNReal.ofReal_inv_of_pos (norm_pos_iff.mpr (sub_ne_zero.mpr h))).symm + +theorem attraction_zero {N M : ℕ} (R : Fin M → Position) (x : Configuration N) : + attraction (fun _ => 0) R x = 0 := by + simp only [attraction, ENNReal.coe_zero, zero_mul, Finset.sum_const_zero] + +theorem nearestNucleusDistance_restrict_le {M m : ℕ} (R : Fin M → Position) + (e : Fin m → Fin M) (x : Position) : + nearestNucleusDistance R x ≤ nearestNucleusDistance (R ∘ e) x := by + exact le_iInf (fun j => iInf_le _ (e j)) + +theorem nearestNucleusControl_restrict_le {N M m : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (e : Fin m → Fin M) (x : Configuration N) : + nearestNucleusControl Z (R ∘ e) x ≤ nearestNucleusControl Z R x := by + apply mul_le_mul_right + exact Finset.sum_le_sum (fun i _ => + ENNReal.inv_le_inv.mpr (nearestNucleusDistance_restrict_le R e _)) + +theorem attraction_restrict {N M m : ℕ} (I : Set (Fin M)) (e : Fin m ≃ I) + (z : Fin M → ℝ≥0) (R : Fin M → Position) (x : Configuration N) + (hz : ∀ k, k ∉ I → z k = 0) : + attraction z R x = + attraction (fun j => z (e j).val) (fun j => R (e j).val) x := by + classical + unfold attraction + apply Finset.sum_congr rfl + intro i _ + have hf : ∀ k, k ∉ I → + (z k : ℝ≥0∞) * coulombKernel (particlePosition x i) (R k) = 0 := by + intro k hk + rw [hz k hk, ENNReal.coe_zero, zero_mul] + calc + _ = ∑ k : I, (z k.val : ℝ≥0∞) * + coulombKernel (particlePosition x i) (R k.val) := + Finset.sum_congr_set I _ _ (fun _ _ => rfl) hf + _ = _ := (e.sum_comp _).symm + +end LiebThirring.Assembly + +end diff --git a/LeanPool/LiebThirring/Assembly/Cutoff.lean b/LeanPool/LiebThirring/Assembly/Cutoff.lean new file mode 100644 index 0000000000..90cbc8bab9 --- /dev/null +++ b/LeanPool/LiebThirring/Assembly/Cutoff.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. +public import Mathlib.Analysis.SpecialFunctions.Pow.Continuity +public import LeanPool.LiebThirring.Assembly.CutoffRadial +public import LeanPool.LiebThirring.Defs.Coulomb +import LeanPool.LiebThirring.Assembly.Coulomb + +/-! +# The everywhere nearest-nucleus cutoff + +The extended nearest-distance cutoff, infinite at nuclei when `a > 0`. + +The nearest-distance cutoff is measurable. +-/ + +public section +open MeasureTheory Set +open scoped ENNReal +namespace LiebThirring.Assembly +/-- The extended nearest-distance cutoff, infinite at nuclei when `a > 0`. -/ +@[expose] noncomputable def nearestNucleusCutoff {M : ℕ} + (a r : ℝ) (R : Fin M → Position) (x : Position) : ℝ≥0∞ := + if nearestNucleusDistance R x < ENNReal.ofReal r then + ENNReal.ofReal a * (nearestNucleusDistance R x)⁻¹ else 0 + +/-- The cutoff plus its constant tail controls the inverse nearest distance everywhere. -/ +theorem nearestNucleusInverse_le_cutoff {M : ℕ} (a r : ℝ) (hr : 0 < r) + (R : Fin M → Position) (x : Position) : + ENNReal.ofReal a * (nearestNucleusDistance R x)⁻¹ ≤ + nearestNucleusCutoff a r R x + ENNReal.ofReal (a / r) := by + unfold nearestNucleusCutoff + split_ifs with h + · exact le_add_right le_rfl + · rw [zero_add, ENNReal.ofReal_div_of_pos hr, div_eq_mul_inv] + exact mul_le_mul_right (ENNReal.inv_le_inv.mpr (le_of_not_gt h)) _ + +/-- A nearest-distance cutoff power is bounded pointwise by the sum of one-center powers. -/ +theorem nearestNucleusCutoff_rpow_le_sum {M : ℕ} (a r : ℝ) (hr : 0 < r) + (R : Fin M → Position) (x : Position) : + nearestNucleusCutoff a r R x ^ ((5 : ℝ) / 2) ≤ + ∑ k : Fin M, nucleusCutoff a r (R k) x ^ ((5 : ℝ) / 2) := by + classical + cases M with + | zero => + simp only [nearestNucleusCutoff, nearestNucleusDistance, iInf_of_empty, + not_top_lt, ite_false, ENNReal.zero_rpow_of_pos (by norm_num : (0 : ℝ) < 5 / 2), + Finset.univ_eq_empty, Finset.sum_empty, le_refl] + | succ M => + obtain ⟨k, hk⟩ := Finite.exists_min (fun k : Fin (M + 1) => ENNReal.ofReal ‖x - R k‖) + have hd : nearestNucleusDistance R x = ENNReal.ofReal ‖x - R k‖ := + le_antisymm (iInf_le _ k) (le_iInf hk) + unfold nearestNucleusCutoff + split_ifs with h + · have hkr : ‖x - R k‖ < r := by + rw [hd] at h + exact (ENNReal.ofReal_lt_ofReal_iff hr).mp h + rw [hd] + calc + _ = nucleusCutoff a r (R k) x ^ ((5 : ℝ) / 2) := by + rw [nucleusCutoff, ite_eq_left hkr] + _ ≤ _ := Finset.single_le_sum + (f := fun j : Fin (M + 1) => nucleusCutoff a r (R j) x ^ ((5 : ℝ) / 2)) + (fun j _ => bot_le) (Finset.mem_univ k) + · rw [ENNReal.zero_rpow_of_pos (by norm_num : (0 : ℝ) < 5 / 2)] + exact bot_le + +/-- The cutoff power integral of the nearest-nucleus cutoff, uniformly over all nuclear +configurations. -/ +theorem lintegral_nearestNucleusCutoff_rpow_le {M : ℕ} (a r : ℝ) (ha : 0 ≤ a) + (hr : 0 < r) (R : Fin M → Position) : + ∫⁻ x : Position, nearestNucleusCutoff a r R x ^ ((5 : ℝ) / 2) ≤ + ENNReal.ofReal (8 * Real.pi * M * a ^ ((5 : ℝ) / 2) * Real.sqrt r) := by + calc + _ ≤ ∫⁻ x : Position, ∑ k : Fin M, nucleusCutoff a r (R k) x ^ ((5 : ℝ) / 2) := + lintegral_mono (nearestNucleusCutoff_rpow_le_sum a r hr R) + _ = ∑ k : Fin M, ∫⁻ x : Position, nucleusCutoff a r (R k) x ^ ((5 : ℝ) / 2) := by + apply lintegral_finsetSum + intro k _ + exact (ENNReal.continuous_rpow_const).measurable.comp + (measurable_nucleusCutoff a r (R k)) + _ = _ := by + simp only [lintegral_nucleusCutoff_rpow a r ha hr, Finset.sum_const, + Finset.card_univ, Fintype.card_fin, nsmul_eq_mul] + rw [← ENNReal.ofReal_natCast, ← ENNReal.ofReal_mul (Nat.cast_nonneg M)] + congr 1 + ring + +end LiebThirring.Assembly + +end diff --git a/LeanPool/LiebThirring/Assembly/CutoffRadial.lean b/LeanPool/LiebThirring/Assembly/CutoffRadial.lean new file mode 100644 index 0000000000..29edc352c1 --- /dev/null +++ b/LeanPool/LiebThirring/Assembly/CutoffRadial.lean @@ -0,0 +1,125 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.Configuration +import LeanPool.LiebThirring.Electrostatics.SphereRadial + +/-! +# Inverse-distance cutoff integrals + +The scalar radial integral is finite and equals twice the square root of the radius. + +The radial Jacobian cancels two powers of the inverse-distance power. +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal + +namespace LiebThirring.Assembly + +/-- The scalar radial integral is finite and equals twice the square root of the radius. -/ +theorem lintegral_rpow_neg_half (r : ℝ) (hr : 0 < r) : + ∫⁻ t in Ioo (0 : ℝ) r, ENNReal.ofReal (t ^ (-(1 : ℝ) / 2)) = + ENNReal.ofReal (2 * Real.sqrt r) := by + have hi : IntegrableOn (fun t : ℝ => t ^ (-(1 : ℝ) / 2)) (Ioc 0 r) := + (intervalIntegrable_iff_integrableOn_Ioc_of_le hr.le).mp + (intervalIntegral.intervalIntegrable_rpow' (by norm_num)) + have hn : 0 ≤ᵐ[volume.restrict (Ioo (0 : ℝ) r)] (fun t : ℝ => t ^ (-(1 : ℝ) / 2)) := by + filter_upwards [ae_restrict_mem measurableSet_Ioo] with t ht + exact Real.rpow_nonneg ht.1.le _ + rw [← ofReal_integral_eq_lintegral_ofReal (hi.mono_set Ioo_subset_Ioc_self) hn] + rw [← integral_Ioc_eq_integral_Ioo, ← intervalIntegral.integral_of_le hr.le, + integral_rpow (Or.inl (by norm_num))] + congr 1 + rw [Real.sqrt_eq_rpow] + norm_num + ring + +/-- The radial Jacobian cancels two powers of the inverse-distance power. -/ +theorem radial_inv_rpow_integrand (t : ℝ) (ht : 0 < t) : + ENNReal.ofReal (t ^ 2) * ((ENNReal.ofReal t)⁻¹) ^ ((5 : ℝ) / 2) = + ENNReal.ofReal (t ^ (-(1 : ℝ) / 2)) := by + rw [← Real.rpow_natCast t 2, ← ENNReal.ofReal_rpow_of_pos ht, + ← ENNReal.rpow_neg_one, ← ENNReal.rpow_mul] + rw [← ENNReal.rpow_add _ _ (ne_of_gt (ENNReal.ofReal_pos.mpr ht)) ENNReal.ofReal_ne_top] + simp only [Nat.cast_ofNat] + rw [show (2 : ℝ) + -1 * (5 / 2) = -1 / 2 by norm_num] + rw [ENNReal.ofReal_rpow_of_pos ht] + +/-- The extended inverse-distance power integrates to `8π√r` on the radius cutoff. -/ +theorem lintegral_ball_inv_rpow (r : ℝ) (hr : 0 < r) : + ∫⁻ x : LiebThirring.Position, + (if ‖x‖ < r then (ENNReal.ofReal ‖x‖)⁻¹ else 0) ^ ((5 : ℝ) / 2) = + ENNReal.ofReal (8 * Real.pi * Real.sqrt r) := by + have hm : Measurable (fun t : ℝ => + (if t < r then (ENNReal.ofReal t)⁻¹ else 0) ^ ((5 : ℝ) / 2)) := by + have hm0 : Measurable (fun t : ℝ => if t < r then (ENNReal.ofReal t)⁻¹ else 0) := + Measurable.ite (measurableSet_lt measurable_id measurable_const) + measurable_id.ennreal_ofReal.inv measurable_const + fun_prop + rw [LiebThirring.lintegral_norm _ hm] + have he : + (∫⁻ t in Ioi (0 : ℝ), ENNReal.ofReal (t ^ 2) * + (if t < r then (ENNReal.ofReal t)⁻¹ else 0) ^ ((5 : ℝ) / 2)) = + ∫⁻ t in Ioo (0 : ℝ) r, ENNReal.ofReal (t ^ (-(1 : ℝ) / 2)) := by + calc + _ = ∫⁻ t in Ioi (0 : ℝ), (Iio r).indicator + (fun t : ℝ => ENNReal.ofReal (t ^ (-(1 : ℝ) / 2))) t := by + apply lintegral_congr_ae + filter_upwards [ae_restrict_mem measurableSet_Ioi] with t ht + by_cases htr : t < r + · simp only [htr, ite_true, indicator_of_mem (show t ∈ Iio r from htr)] + exact radial_inv_rpow_integrand t ht + · simp only [htr, ite_false, ENNReal.zero_rpow_of_pos (by norm_num : (0 : ℝ) < 5 / 2), + mul_zero, indicator_of_notMem (show t ∉ Iio r from htr)] + _ = _ := by + rw [lintegral_indicator measurableSet_Iio, Measure.restrict_restrict measurableSet_Iio] + rw [show Iio r ∩ Ioi (0 : ℝ) = Ioo 0 r by + ext t; exact and_comm] + rw [he, lintegral_rpow_neg_half r hr, ← ENNReal.ofReal_mul (by positivity)] + congr 1 + ring + +/-- The cutoff of the inverse distance to a single nucleus. -/ +@[expose] noncomputable def nucleusCutoff (a r : ℝ) (z x : Position) : ℝ≥0∞ := + if ‖x - z‖ < r then ENNReal.ofReal a * (ENNReal.ofReal ‖x - z‖)⁻¹ else 0 + +/-- One-center cutoffs are measurable, including their infinite value at the center. -/ +theorem measurable_nucleusCutoff (a r : ℝ) (z : Position) : + Measurable (nucleusCutoff a r z) := by + apply Measurable.ite + · exact measurableSet_lt (measurable_id.sub measurable_const).norm measurable_const + · exact measurable_const.mul (measurable_id.sub measurable_const).norm.ennreal_ofReal.inv + · exact measurable_const + +/-- The exact one-center power integral used to majorize the nearest-nucleus cutoff. -/ +theorem lintegral_nucleusCutoff_rpow (a r : ℝ) (ha : 0 ≤ a) (hr : 0 < r) + (z : Position) : + ∫⁻ x : Position, nucleusCutoff a r z x ^ ((5 : ℝ) / 2) = + ENNReal.ofReal (8 * Real.pi * a ^ ((5 : ℝ) / 2) * Real.sqrt r) := by + have he : ∀ x : Position, nucleusCutoff a r z x = ENNReal.ofReal a * + (if ‖x - z‖ < r then (ENNReal.ofReal ‖x - z‖)⁻¹ else 0) := by + intro x + unfold nucleusCutoff + split_ifs <;> simp only [mul_zero] + simp_rw [he, ENNReal.mul_rpow_of_nonneg _ _ (by norm_num : (0 : ℝ) ≤ 5 / 2)] + rw [lintegral_const_mul' _ _ (ENNReal.rpow_ne_top_of_nonneg (by norm_num) ENNReal.ofReal_ne_top)] + rw [lintegral_sub_right_eq_self + (fun x : Position => (if ‖x‖ < r then (ENNReal.ofReal ‖x‖)⁻¹ else 0) ^ ((5 : ℝ) / 2)) z] + rw [lintegral_ball_inv_rpow r hr, ENNReal.ofReal_rpow_of_nonneg ha (by norm_num), + ← ENNReal.ofReal_mul (Real.rpow_nonneg ha _)] + congr 1 + ring + +end LiebThirring.Assembly + +end diff --git a/LeanPool/LiebThirring/Assembly/FiniteAveraging.lean b/LeanPool/LiebThirring/Assembly/FiniteAveraging.lean new file mode 100644 index 0000000000..9a09850e34 --- /dev/null +++ b/LeanPool/LiebThirring/Assembly/FiniteAveraging.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Algebra.BigOperators.Ring.Finset +public import Mathlib.Basic.ENNReal.Inv + +/-! +# Finite product averaging + +Product-of-sums identities and their first and second moments hold for extended nonnegative +coefficients. +-/ + +public section + +open scoped ENNReal + +namespace LiebThirring.Assembly + +theorem sum_product_weights {ι β : Type*} [Fintype ι] [Fintype β] [DecidableEq ι] + (w : ι → β → ℝ≥0∞) (hw : ∀ i, ∑ b, w i b = 1) : + (∑ v : ι → β, ∏ i, w i (v i)) = 1 := by + rw [← Fintype.prod_sum] + simp only [hw, Finset.prod_const_one] + +theorem sum_product_weights_mul_product {ι β : Type*} [Fintype ι] [Fintype β] [DecidableEq ι] + (w c : ι → β → ℝ≥0∞) : + (∑ v : ι → β, (∏ i, w i (v i)) * (∏ i, c i (v i))) = + ∏ i, ∑ b, w i b * c i b := by + simp only [← Finset.prod_mul_distrib] + exact (Fintype.prod_sum (fun i b => w i b * c i b)).symm + +theorem sum_product_weights_first {ι β : Type*} [Fintype ι] [Fintype β] [DecidableEq ι] + (w c : ι → β → ℝ≥0∞) (hw : ∀ i, ∑ b, w i b = 1) (k : ι) : + (∑ v : ι → β, (∏ i, w i (v i)) * c k (v k)) = ∑ b, w k b * c k b := by + have hc (v : ι → β) : c k (v k) = + ∏ i, if i = k then c i (v i) else 1 := + (Fintype.prod_ite_eq' k (fun i => c i (v i))).symm + simp_rw [hc] + rw [sum_product_weights_mul_product w (fun i b => if i = k then c i b else 1)] + have hf (i : ι) : (∑ b, w i b * (if i = k then c i b else 1)) = + if i = k then ∑ b, w i b * c i b else 1 := by + split_ifs + · rfl + · simp only [mul_one, hw] + simp_rw [hf] + exact Fintype.prod_ite_eq' k _ + +theorem sum_product_weights_second {ι β : Type*} [Fintype ι] [Fintype β] [DecidableEq ι] + (w c : ι → β → ℝ≥0∞) (hw : ∀ i, ∑ b, w i b = 1) (k l : ι) (hkl : k ≠ l) : + (∑ v : ι → β, (∏ i, w i (v i)) * (c k (v k) * c l (v l))) = + (∑ b, w k b * c k b) * (∑ b, w l b * c l b) := by + have hc (v : ι → β) : c k (v k) * c l (v l) = + ∏ i, (if i = k then c i (v i) else 1) * + (if i = l then c i (v i) else 1) := by + rw [Finset.prod_mul_distrib, Fintype.prod_ite_eq', Fintype.prod_ite_eq'] + simp_rw [hc] + rw [sum_product_weights_mul_product w (fun i b => + (if i = k then c i b else 1) * (if i = l then c i b else 1))] + have hf (i : ι) : + (∑ b, w i b * ((if i = k then c i b else 1) * + (if i = l then c i b else 1))) = + (if i = k then ∑ b, w i b * c i b else 1) * + (if i = l then ∑ b, w i b * c i b else 1) := by + by_cases hik : i = k + · subst i + simp only [ite_true, hkl, ite_false, mul_one] + · by_cases hil : i = l + · subst i + simp only [hik, ite_false, ite_true, one_mul] + · simp only [hik, hil, ite_false, mul_one, hw] + simp_rw [hf] + rw [Finset.prod_mul_distrib, Fintype.prod_ite_eq', Fintype.prod_ite_eq'] + +end LiebThirring.Assembly + +end diff --git a/LeanPool/LiebThirring/Assembly/IntegratedBaxter.lean b/LeanPool/LiebThirring/Assembly/IntegratedBaxter.lean new file mode 100644 index 0000000000..6187e441b7 --- /dev/null +++ b/LeanPool/LiebThirring/Assembly/IntegratedBaxter.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Assembly.WeakBaxter +public import LeanPool.LiebThirring.Kinetic.DensityBasic + +/-! +# Integrated weak Baxter inequality + +Testing nearest-nucleus control against a state yields the density integral. + +The integrated weak Baxter bound, conditional on the exact Baxter proposition, for every +normalized state and bounded-charge configuration. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal +namespace LiebThirring.Assembly + +/-- Testing nearest-nucleus control against a state yields the density integral. -/ +theorem lintegral_nearestNucleusControl {N q M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (ψ : State N q) : + (∫⁻ X : Configuration N, nearestNucleusControl Z R X * (‖ψ X‖₊ : ℝ≥0∞) ^ 2) = + (2 * (Z : ℝ≥0∞) + 1) * + (∫⁻ x : Position, (nearestNucleusDistance R x)⁻¹ * density ψ x) := by + have hf (i : Fin N) : Measurable (fun X : Configuration N => + (nearestNucleusDistance R (particlePosition X i))⁻¹ * (‖ψ X‖₊ : ℝ≥0∞) ^ 2) := + ((measurable_nearestNucleusInverse R).comp (measurable_particlePosition i)).mul + (measurable_state_norm_sq ψ) + simp only [nearestNucleusControl, mul_assoc, Finset.sum_mul] + rw [lintegral_const_mul _ (Finset.measurable_sum _ (fun i _ => hf i)), + lintegral_finsetSum _ (fun i _ => hf i), + ← density_testing N q ψ _ (measurable_nearestNucleusInverse R)] + +private theorem integrated_weak_baxter {N q M : ℕ} (Z : ℝ≥0) + (z : Fin M → ℝ≥0) (R : Fin M → Position) (ψ : State N q) (hψ : ‖ψ‖ = 1) + (hW : ∀ X : Configuration N, attraction z R X ≤ + electronRepulsion X + nuclearRepulsion z R + nearestNucleusControl Z R X) : + (∫⁻ X : Configuration N, attraction z R X * (‖ψ X‖₊ : ℝ≥0∞) ^ 2) ≤ + (∫⁻ X : Configuration N, electronRepulsion X * (‖ψ X‖₊ : ℝ≥0∞) ^ 2) + + nuclearRepulsion z R + (2 * (Z : ℝ≥0∞) + 1) * + (∫⁻ x : Position, (nearestNucleusDistance R x)⁻¹ * density ψ x) := by + have hnorm : ‖ψ‖₊ = 1 := NNReal.eq hψ + have hm := measurable_state_norm_sq ψ + have he : Measurable (fun X : Configuration N => + electronRepulsion X * (‖ψ X‖₊ : ℝ≥0∞) ^ 2) := + (measurable_electronRepulsion (N := N)).mul hm + have hn : Measurable (fun X : Configuration N => + nuclearRepulsion z R * (‖ψ X‖₊ : ℝ≥0∞) ^ 2) := + (measurable_const (a := nuclearRepulsion z R)).mul hm + calc + _ ≤ ∫⁻ X : Configuration N, + (electronRepulsion X + nuclearRepulsion z R + nearestNucleusControl Z R X) * + (‖ψ X‖₊ : ℝ≥0∞) ^ 2 := + lintegral_mono (fun X => mul_le_mul_left (hW X) _) + _ = _ := by + conv_lhs => simp only [add_mul] + have hes : Measurable (fun X : Configuration N => + electronRepulsion X * (‖ψ X‖₊ : ℝ≥0∞) ^ 2 + + nuclearRepulsion z R * (‖ψ X‖₊ : ℝ≥0∞) ^ 2) := he.add hn + rw [lintegral_add_left hes, lintegral_add_left he, + lintegral_const_mul _ hm, lintegral_state_norm_sq, hnorm, + ENNReal.coe_one, one_pow, mul_one, lintegral_nearestNucleusControl] +/-- The integrated weak Baxter bound, conditional on the exact Baxter +proposition, for every normalized state and bounded-charge configuration. -/ +theorem integratedBaxter_of_baxter + (hB : ∀ (N M : ℕ) (Z : ℝ≥0) (R : Fin M → Position) (x : Configuration N), + attraction (fun _ => Z) R x + baxterCorrection Z R ≤ + electronRepulsion x + nuclearRepulsion (fun _ => Z) R + + nearestNucleusControl Z R x) + {N q M : ℕ} (Z : ℝ≥0) (z : Fin M → ℝ≥0) (R : Fin M → Position) + (ψ : State N q) (hz : ∀ k, z k ≤ Z) (hψ : ‖ψ‖ = 1) : + (∫⁻ X : Configuration N, attraction z R X * (‖ψ X‖₊ : ℝ≥0∞) ^ 2) ≤ + (∫⁻ X : Configuration N, electronRepulsion X * (‖ψ X‖₊ : ℝ≥0∞) ^ 2) + + nuclearRepulsion z R + (2 * (Z : ℝ≥0∞) + 1) * + (∫⁻ x : Position, (nearestNucleusDistance R x)⁻¹ * density ψ x) := by + exact integrated_weak_baxter Z z R ψ hψ + (fun X => weakBaxter_of_baxter hB N M Z z R X hz) + +end LiebThirring.Assembly + +end diff --git a/LeanPool/LiebThirring/Assembly/NuclearReindex.lean b/LeanPool/LiebThirring/Assembly/NuclearReindex.lean new file mode 100644 index 0000000000..6024a712f5 --- /dev/null +++ b/LeanPool/LiebThirring/Assembly/NuclearReindex.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.Coulomb + +/-! +# Reindexing nuclear repulsion + +The symmetric off-diagonal sum counts each nuclear pair twice. + +Deleting zero-charge nuclei and reindexing the remaining support preserve nuclear repulsion, +including singular configurations. +-/ + +public section + +open scoped ENNReal NNReal + +namespace LiebThirring.Assembly + +private theorem sum_support {α : Type*} [Fintype α] (I : Set α) [Fintype I] (f : α → ℝ≥0∞) + (hf : ∀ k, k ∉ I → f k = 0) : + (∑ k, f k) = ∑ k : I, f k.val := by + classical + rw [← Finset.sum_subset (Finset.subset_univ I.toFinset) + (fun k _ hk => hf k (by simpa only [Set.mem_toFinset] using hk))] + exact (Finset.sum_subtype I.toFinset (fun _ => Set.mem_toFinset) f) + +/-- The symmetric off-diagonal sum counts each nuclear pair twice. -/ +theorem nuclearRepulsion_double_sum {M : ℕ} (z : Fin M → ℝ≥0) (R : Fin M → Position) : + (∑ k, ∑ l, if k ≠ l then + ((z k : ℝ≥0∞) * (z l : ℝ≥0∞)) * coulombKernel (R k) (R l) else 0) = + 2 * nuclearRepulsion z R := by + apply sum_ne_eq_two_sum_lt + intro k l + simp only [coulombKernel, norm_sub_rev (R k) (R l)] + ac_rfl + +/-- Deleting zero-charge nuclei and reindexing the remaining support preserve +nuclear repulsion, including singular configurations. -/ +theorem nuclearRepulsion_reindex_support {M m : ℕ} (I : Set (Fin M)) (e : Fin m ≃ I) + (z : Fin M → ℝ≥0) (R : Fin M → Position) (hz : ∀ k, k ∉ I → z k = 0) : + nuclearRepulsion z R = + nuclearRepulsion (fun j => z (e j).val) (fun j => R (e j).val) := by + classical + let : Fintype I := Fintype.ofEquiv (Fin m) e + apply (ENNReal.mul_right_inj (by norm_num : (2 : ℝ≥0∞) ≠ 0) + (by norm_num : (2 : ℝ≥0∞) ≠ ⊤)).mp + rw [← nuclearRepulsion_double_sum, ← nuclearRepulsion_double_sum] + let f (k l : Fin M) : ℝ≥0∞ := if k ≠ l then + ((z k : ℝ≥0∞) * (z l : ℝ≥0∞)) * coulombKernel (R k) (R l) else 0 + have hfleft (k : Fin M) (hk : k ∉ I) (l : Fin M) : f k l = 0 := by + simp only [f, hz k hk, ENNReal.coe_zero, zero_mul, ite_self] + have hfright (l : Fin M) (hl : l ∉ I) (k : Fin M) : f k l = 0 := by + simp only [f, hz l hl, ENNReal.coe_zero, mul_zero, zero_mul, ite_self] + change (∑ k, ∑ l, f k l) = _ + rw [sum_support I (fun k => ∑ l, f k l) (fun k hk => by + simp only [hfleft k hk, Finset.sum_const_zero])] + simp_rw [sum_support I (f _) (fun l hl => hfright l hl _)] + rw [← e.sum_comp] + simp_rw [← e.sum_comp] + apply Finset.sum_congr rfl + intro k _ + apply Finset.sum_congr rfl + intro l _ + dsimp [f] + have heq : (e k).val = (e l).val ↔ k = l := by + rw [← Subtype.ext_iff, e.injective.eq_iff] + simp only [heq] + +end LiebThirring.Assembly + +end diff --git a/LeanPool/LiebThirring/Assembly/RealForm.lean b/LeanPool/LiebThirring/Assembly/RealForm.lean new file mode 100644 index 0000000000..d8d4aa32b3 --- /dev/null +++ b/LeanPool/LiebThirring/Assembly/RealForm.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Assembly.Coulomb + +/-! # Finite Coulomb forms and extended-to-real arithmetic + +Elementary finite-sum and arithmetic steps for the real quadratic-form corollary. +The electron estimate is supplied by `RealFormPairs`. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring.Assembly + +/-- Distinct nuclear positions give finite nuclear repulsion. -/ +theorem nuclearRepulsion_lt_top {M : ℕ} (z : Fin M → ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) : + nuclearRepulsion z R < ⊤ := by + unfold nuclearRepulsion + apply ENNReal.sum_lt_top.mpr + intro k _ + apply ENNReal.sum_lt_top.mpr + intro l hl + have hkl : k ≠ l := ne_of_lt (Finset.mem_filter.mp hl).2 + rw [coulombKernel_eq_of_ne (fun h => hkl (hR h))] + exact ENNReal.mul_lt_top (ENNReal.mul_lt_top ENNReal.coe_lt_top ENNReal.coe_lt_top) + ENNReal.ofReal_lt_top + +/-- An extended additive estimate with finite positive terms gives attraction +finiteness and the corresponding real energy lower bound. -/ +theorem real_form_of_extended_bound {A T B U : ℝ≥0∞} (C : ℝ≥0) (K : ℕ) + (hT : T < ⊤) (hB : B < ⊤) (hU : U < ⊤) + (hA : A ≤ T + B + U + (C : ℝ≥0∞) * K) : + A < ⊤ ∧ -(C : ℝ) * (K : ℝ) ≤ T.toReal + B.toReal + U.toReal - A.toReal := by + have hTB : T + B < ⊤ := ENNReal.add_lt_top.mpr ⟨hT, hB⟩ + have hTBU : T + B + U < ⊤ := ENNReal.add_lt_top.mpr ⟨hTB, hU⟩ + have hCK : (C : ℝ≥0∞) * K < ⊤ := + ENNReal.mul_lt_top ENNReal.coe_lt_top (ENNReal.natCast_lt_top K) + have htotal : T + B + U + (C : ℝ≥0∞) * K < ⊤ := + ENNReal.add_lt_top.mpr ⟨hTBU, hCK⟩ + have hAfin : A < ⊤ := hA.trans_lt htotal + refine ⟨hAfin, ?_⟩ + have hreal := (ENNReal.toReal_le_toReal hAfin.ne htotal.ne).mpr hA + rw [ENNReal.toReal_add hTBU.ne hCK.ne, ENNReal.toReal_add hTB.ne hU.ne, + ENNReal.toReal_add hT.ne hB.ne, ENNReal.toReal_mul, + ENNReal.coe_toReal, ENNReal.toReal_natCast] at hreal + linarith only [hreal] + +end LiebThirring.Assembly +end diff --git a/LeanPool/LiebThirring/Assembly/RealFormCurrying.lean b/LeanPool/LiebThirring/Assembly/RealFormCurrying.lean new file mode 100644 index 0000000000..f95e11346d --- /dev/null +++ b/LeanPool/LiebThirring/Assembly/RealFormCurrying.lean @@ -0,0 +1,265 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.CurryingState +public import LeanPool.LiebThirring.Fourier.Functoriality + +/-! # Interchanging L² slices and partial Fourier transformation + +Product currying supplies genuine L² classes in both orders. The interchange +of a partial Fourier transform is proved on scalar tensors and extended by +L² density; it does not assert pointwise Fourier integration for an L² state. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal FourierTransform + +namespace LiebThirring.Assembly + +variable {α E : Type*} [MeasurableSpace α] + [NormedAddCommGroup E] [InnerProductSpace ℂ E] [CompleteSpace E] + {ν : Measure α} [SFinite ν] + [SecondCountableTopology (Lp E 2 ν)] + [SecondCountableTopology (Lp E 2 (volume : Measure Position))] + +/-- Interchange the outer spatial variable and the remaining L² variable. -/ +@[expose] noncomputable def realFormSwapCurrying : + Lp (Lp E 2 ν) 2 (volume : Measure Position) ≃ₗᵢ[ℂ] + Lp (Lp E 2 (volume : Measure Position)) 2 ν := + (l2CurryLinearIsometryEquiv (μ := (volume : Measure Position)) (ν := ν) + (E := E)).symm |>.trans + (l2PullbackEquiv (E := E) (MeasurableEquiv.prodComm (α := α) (β := Position)) + Measure.measurePreserving_swap) |>.trans + (l2CurryLinearIsometryEquiv (μ := ν) (ν := (volume : Measure Position)) (E := E)) + +/-- Exchanging slices is currying the swapped product class. -/ +theorem realFormSwapCurrying_apply (u : Lp (Lp E 2 ν) 2 (volume : Measure Position)) : + realFormSwapCurrying u = l2Curry + (l2PullbackEquiv (E := E) + (MeasurableEquiv.prodComm (α := α) (β := Position)) Measure.measurePreserving_swap + ((l2CurryLinearIsometryEquiv (μ := (volume : Measure Position)) + (ν := ν) (E := E)).symm u)) := rfl + +/-- The exchanged class agrees with the uncurried product representative, +in the order needed to apply the one-body estimate on each remaining slice. -/ +theorem realFormSwapCurrying_ae_uncurry + (u : Lp (Lp E 2 ν) 2 (volume : Measure Position)) : + ∀ᵐ y ∂ν, ∀ᵐ x : Position, realFormSwapCurrying u y x = + ((l2CurryLinearIsometryEquiv (μ := (volume : Measure Position)) + (ν := ν) (E := E)).symm u) (x, y) := by + let f := (l2CurryLinearIsometryEquiv (μ := (volume : Measure Position)) + (ν := ν) (E := E)).symm u + let g := l2PullbackEquiv (E := E) + (MeasurableEquiv.prodComm (α := α) (β := Position)) Measure.measurePreserving_swap f + change ∀ᵐ y ∂ν, ∀ᵐ x : Position, l2Curry g y x = f (x, y) + filter_upwards [l2Curry_ae g, Measure.ae_ae_of_ae_prod (l2PullbackEquiv_ae + (MeasurableEquiv.prodComm (α := α) (β := Position)) Measure.measurePreserving_swap f)] + with y hy ht + filter_upwards [hy, ht] with x hx htx + exact hx.trans htx + +/-- Weighted spatial mass is unchanged by exchanging the slice order. -/ +theorem realFormSwapCurrying_weighted_norm_sq + (u : Lp (Lp E 2 ν) 2 (volume : Measure Position)) + (w : Position → ℝ≥0∞) (hw : Measurable w) : + (∫⁻ y, ∫⁻ x : Position, w x * ‖realFormSwapCurrying u y x‖ₑ ^ 2 ∂(volume : Measure Position) + ∂ν) = + ∫⁻ x : Position, w x * ‖u x‖ₑ ^ 2 := by + let f := (l2CurryLinearIsometryEquiv (μ := (volume : Measure Position)) + (ν := ν) (E := E)).symm u + have hc : ∀ᵐ x : Position, ∀ᵐ y ∂ν, u x y = f (x, y) := by + have h := l2Curry_ae f + rw [show l2Curry f = u from + (l2CurryLinearIsometryEquiv (μ := (volume : Measure Position)) + (ν := ν) (E := E)).apply_symm_apply u] at h + exact h + calc + _ = ∫⁻ y, ∫⁻ x : Position, w x * ‖f (x, y)‖ₑ ^ 2 ∂(volume : Measure Position) ∂ν := by + apply lintegral_congr_ae + filter_upwards [realFormSwapCurrying_ae_uncurry u] with y hy + exact lintegral_congr_ae (hy.mono fun x hx => congrArg (fun a : E => w x * ‖a‖ₑ ^ 2) hx) + _ = ∫⁻ x : Position, ∫⁻ y, w x * ‖f (x, y)‖ₑ ^ 2 ∂ν := by + exact (lintegral_lintegral_swap + ((hw.comp measurable_fst).mul ((Lp.stronglyMeasurable f).enorm.pow_const + 2)).aemeasurable).symm + _ = ∫⁻ x : Position, w x * ‖u x‖ₑ ^ 2 := by + apply lintegral_congr_ae + filter_upwards [hc] with x hx + rw [lintegral_const_mul (w x) + (f := fun y => ‖f (x, y)‖ₑ ^ 2) + (((Lp.stronglyMeasurable f).comp_measurable + (measurable_prodMk_left (x := x))).enorm.pow_const 2), + ← lintegral_l2_enorm_sq (u x)] + congr 1 + exact lintegral_congr_ae (hx.mono fun y hy => congrArg (fun a : E => ‖a‖ₑ ^ 2) hy.symm) + +/-- Scalar tensor insertion into a Hilbert-valued spatial L² space. -/ +@[expose] noncomputable def realFormScalarInsertion + (f : Lp ℂ 2 (volume : Measure Position)) : E →L[ℂ] Lp E 2 (volume : Measure Position) := + ((ContinuousLinearMap.lsmul ℂ ℂ (E := E)).flip.compLpL₂ 2 volume).flip f + +omit [CompleteSpace E] [SecondCountableTopology (Lp E 2 (volume : Measure Position))] in +theorem realFormScalarInsertion_ae (f : Lp ℂ 2 (volume : Measure Position)) (v : E) : + realFormScalarInsertion f v =ᵐ[volume] fun x => f x • v := + (ContinuousLinearMap.toSpanSingleton ℂ v).coeFn_compLp f + +omit [CompleteSpace E] [SecondCountableTopology (Lp E 2 ν)] + [SecondCountableTopology (Lp E 2 (volume : Measure Position))] in +private theorem memLp_realFormTensor (f : Lp ℂ 2 (volume : Measure Position)) + (v : Lp E 2 ν) : + MemLp (fun z : Position × α => f z.1 • v z.2) 2 ((volume : Measure Position).prod ν) := by + have hm : StronglyMeasurable (fun z : Position × α => f z.1 • v z.2) := + ((Lp.stronglyMeasurable f).comp_measurable measurable_fst).smul + ((Lp.stronglyMeasurable v).comp_measurable measurable_snd) + apply (eLpNorm_lt_top_iff_lintegral_rpow_enorm_lt_top + (by norm_num : (2 : ℝ≥0∞) ≠ 0) (by norm_num : (2 : ℝ≥0∞) ≠ ⊤) + hm.aestronglyMeasurable).mpr + simp only [ENNReal.toReal_ofNat, ENNReal.rpow_two, enorm_smul, mul_pow] + rw [lintegral_prod_mul ((Lp.stronglyMeasurable f).enorm.pow_const 2).aemeasurable + ((Lp.stronglyMeasurable v).enorm.pow_const 2).aemeasurable, + lintegral_l2_enorm_sq, lintegral_l2_enorm_sq] + exact ENNReal.mul_lt_top (ENNReal.pow_lt_top ENNReal.coe_lt_top) + (ENNReal.pow_lt_top ENNReal.coe_lt_top) + +/-- Slice interchange on an elementary scalar tensor. -/ +theorem realFormSwapCurrying_tensor (f : Lp ℂ 2 (volume : Measure Position)) + (v : Lp E 2 ν) : + realFormSwapCurrying ((ContinuousLinearMap.toSpanSingleton ℂ v).compLp f) = + (realFormScalarInsertion f).compLp v := by + let h := memLp_realFormTensor f v + let w := h.toLp (fun z : Position × α => f z.1 • v z.2) + have hw : ∀ᵐ x : Position, ∀ᵐ y ∂ν, w (x, y) = f x • v y := + Measure.ae_ae_of_ae_prod h.coeFn_toLp + have hc : l2Curry w = (ContinuousLinearMap.toSpanSingleton ℂ v).compLp f := by + apply Lp.ext + filter_upwards [l2Curry_ae w, + (ContinuousLinearMap.toSpanSingleton ℂ v).coeFn_compLp f, hw] with x hx ht hwx + rw [ht] + apply Lp.ext + filter_upwards [hx, hwx, Lp.coeFn_smul (f x) v] with y hxy hwy hsy + exact hxy.trans (hwy.trans hsy.symm) + have hinv : (l2CurryLinearIsometryEquiv (μ := (volume : Measure Position)) + (ν := ν) (E := E)).symm ((ContinuousLinearMap.toSpanSingleton ℂ v).compLp f) = w := by + rw [← hc] + exact (l2CurryLinearIsometryEquiv (μ := (volume : Measure Position)) + (ν := ν) (E := E)).symm_apply_apply w + rw [realFormSwapCurrying_apply, hinv] + apply Lp.ext + have hp := (Measure.measurePreserving_swap (μ := ν) + (ν := (volume : Measure Position))).quasiMeasurePreserving.ae h.coeFn_toLp + filter_upwards [l2Curry_ae + (l2PullbackEquiv (E := E) (MeasurableEquiv.prodComm (α := α) (β := Position)) + Measure.measurePreserving_swap w), + Measure.ae_ae_of_ae_prod (l2PullbackEquiv_ae + (MeasurableEquiv.prodComm (α := α) (β := Position)) Measure.measurePreserving_swap w), + Measure.ae_ae_of_ae_prod hp, + (realFormScalarInsertion f).coeFn_compLp v] with y hy ht hw' hr + rw [hr] + apply Lp.ext + filter_upwards [hy, ht, hw', realFormScalarInsertion_ae f (v y)] + with x hyx htx hwx hrx + exact hyx.trans (htx.trans (hwx.trans hrx.symm)) + +private theorem continuousLinearMap_ext_scalarTensor + {H K : Type*} [NormedAddCommGroup H] [NormedSpace ℂ H] + [NormedAddCommGroup K] [NormedSpace ℂ K] + (A B : Lp H 2 (volume : Measure Position) →L[ℂ] K) + (h : ∀ (f : Lp ℂ 2 (volume : Measure Position)) (v : H), + A ((ContinuousLinearMap.toSpanSingleton ℂ v).compLp f) = + B ((ContinuousLinearMap.toSpanSingleton ℂ v).compLp f)) : A = B := by + apply ContinuousLinearMap.ext + intro u + apply Lp.induction (p := (2 : ℝ≥0∞)) (μ := (volume : Measure Position)) + (by norm_num) (fun u => A u = B u) + · intro v s hs hμs + let f : Lp ℂ 2 (volume : Measure Position) := indicatorConstLp 2 hs hμs.ne 1 + have heq : Lp.simpleFunc.indicatorConst 2 hs hμs.ne v = + (ContinuousLinearMap.toSpanSingleton ℂ v).compLp f := by + rw [Lp.simpleFunc.coe_indicatorConst] + apply Lp.ext + filter_upwards [show ∀ᵐ x : Position, + (indicatorConstLp 2 hs hμs.ne v : Lp H 2 volume) x = s.indicator (fun _ => v) x + from indicatorConstLp_coeFn, + (ContinuousLinearMap.toSpanSingleton ℂ v).coeFn_compLp f, + show ∀ᵐ x : Position, f x = s.indicator (fun _ => (1 : ℂ)) x + from indicatorConstLp_coeFn] with x hx ht hf + rw [hx, ht, hf] + by_cases hxs : x ∈ s + · simp only [Set.indicator_of_mem hxs, ContinuousLinearMap.toSpanSingleton_apply, + one_smul] + · simp only [Set.indicator_of_notMem hxs, ContinuousLinearMap.toSpanSingleton_apply, + zero_smul] + rw [heq] + exact h f v + · intro f g hf hg hd hAf hAg + simpa only [map_add] using congrArg₂ (· + ·) hAf hAg + · exact isClosed_eq A.continuous B.continuous + +/-- Partial Fourier transformation commutes with exchanging the slice order. -/ +theorem realFormSwapCurrying_fourier + (u : Lp (Lp E 2 ν) 2 (volume : Measure Position)) : + realFormSwapCurrying (𝓕 u) = + (Lp.fourierTransformₗᵢ Position E).toContinuousLinearEquiv.toContinuousLinearMap.compLp + (realFormSwapCurrying u) := by + let S := (realFormSwapCurrying (E := E) (ν := ν)).toContinuousLinearEquiv.toContinuousLinearMap + let F := (Lp.fourierTransformₗᵢ Position E).toContinuousLinearEquiv.toContinuousLinearMap + let Fout := (Lp.fourierTransformₗᵢ Position (Lp E 2 + ν)).toContinuousLinearEquiv.toContinuousLinearMap + have heq : S.comp Fout = (F.compLpL 2 ν).comp S := by + apply continuousLinearMap_ext_scalarTensor + intro f v + change realFormSwapCurrying (𝓕 ((ContinuousLinearMap.toSpanSingleton ℂ v).compLp f)) = + F.compLp (realFormSwapCurrying ((ContinuousLinearMap.toSpanSingleton ℂ v).compLp f)) + rw [Fourier.fourier_compLp, realFormSwapCurrying_tensor, realFormSwapCurrying_tensor] + apply Lp.ext + filter_upwards [(realFormScalarInsertion (𝓕 f)).coeFn_compLp v, + F.coeFn_compLp ((realFormScalarInsertion f).compLp v), + (realFormScalarInsertion f).coeFn_compLp v] with y hl hr hv + rw [hl, hr, hv] + change (ContinuousLinearMap.toSpanSingleton ℂ (v y)).compLp (𝓕 f) = + 𝓕 ((ContinuousLinearMap.toSpanSingleton ℂ (v y)).compLp f) + exact (Fourier.fourier_compLp _ f).symm + exact congrArg (fun T => T u) heq + +/-- The integral of the slice Fourier energies is the outer partial Fourier energy. -/ +theorem realFormSwapCurrying_fourier_weighted_norm_sq + (u : Lp (Lp E 2 ν) 2 (volume : Measure Position)) + (w : Position → ℝ≥0∞) (hw : Measurable w) : + (∫⁻ y, ∫⁻ ξ : Position, w ξ * + ‖(𝓕 (realFormSwapCurrying u y) : Lp E 2 volume) ξ‖ₑ ^ 2 + ∂(volume : Measure Position) ∂ν) = + ∫⁻ ξ : Position, w ξ * ‖(𝓕 u : Lp (Lp E 2 ν) 2 volume) ξ‖ₑ ^ 2 := by + rw [← realFormSwapCurrying_weighted_norm_sq (𝓕 u) w hw, + realFormSwapCurrying_fourier] + apply lintegral_congr_ae + filter_upwards [(Lp.fourierTransformₗᵢ Position + E).toContinuousLinearEquiv.toContinuousLinearMap.coeFn_compLp + (realFormSwapCurrying u)] with y hy + rw [hy] + rfl + +/-- Target isometries preserve all weighted extended L² masses. -/ +theorem realFormTargetIsometry_weighted_norm_sq + {H K : Type*} [NormedAddCommGroup H] [NormedSpace ℂ H] + [NormedAddCommGroup K] [NormedSpace ℂ K] + (A : H ≃ₗᵢ[ℂ] K) (u : Lp H 2 (volume : Measure Position)) + (w : Position → ℝ≥0∞) : + (∫⁻ x : Position, w x * + (‖A.toContinuousLinearEquiv.toContinuousLinearMap.compLp u x‖₊ : ℝ≥0∞) ^ 2) = + ∫⁻ x : Position, w x * (‖u x‖₊ : ℝ≥0∞) ^ 2 := by + apply lintegral_congr_ae + filter_upwards [A.toContinuousLinearEquiv.toContinuousLinearMap.coeFn_compLp u] with x hx + rw [hx] + exact congrArg (fun a : ℝ≥0 => w x * (a : ℝ≥0∞) ^ 2) (A.nnnorm_map (u x)) + +end LiebThirring.Assembly +end diff --git a/LeanPool/LiebThirring/Assembly/RealFormPairs.lean b/LeanPool/LiebThirring/Assembly/RealFormPairs.lean new file mode 100644 index 0000000000..d1453bc05c --- /dev/null +++ b/LeanPool/LiebThirring/Assembly/RealFormPairs.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Assembly.RealFormSlices +public import LeanPool.LiebThirring.Assembly.RealForm + +/-! +# Electron-pair expectations from the one-body Coulomb estimate + +One-body Coulomb estimates and particle slicing control electron-pair expectations by the +selected particle’s Fourier energy. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal FourierTransform + +namespace LiebThirring.Assembly + +local instance : Fact ((2 : ℝ≥0∞) ≠ ⊤) := ⟨ENNReal.ofNat_ne_top⟩ + +/-- Inserting one particle does not move any other particle. -/ +theorem realForm_particlePosition_insert_ne {N : ℕ} (i j : Fin N) (hij : i ≠ j) + (x : Position) (y : OtherConfiguration i) : + particlePosition (insertParticle i x y) j = particlePosition (insertParticle i 0 y) j := by + ext a + simp only [particlePosition, insertParticle, PiLp.toLp_apply, dite_eq_right hij.symm] + +/-- A pair expectation is the integral of the one-body expectations on the +remaining-coordinate slices, with centre at the other particle. -/ +theorem realForm_pair_lintegral_eq_slices {N q : ℕ} (i j : Fin N) (hij : i ≠ j) + (ψ : State N q) : + (∫⁻ X : Configuration N, coulombKernel (particlePosition X i) (particlePosition X j) * + (‖ψ X‖₊ : ℝ≥0∞) ^ 2) = + ∫⁻ y : OtherConfiguration i, ∫⁻ x : Position, + coulombKernel x (particlePosition (insertParticle i 0 y) j) * + (‖realFormSwapCurrying (realFormParticleCurrying i ψ) y x‖₊ : ℝ≥0∞) ^ 2 := by + let F : Configuration N → ℝ≥0∞ := fun X => + coulombKernel (particlePosition X i) (particlePosition X j) * (‖ψ X‖₊ : ℝ≥0∞) ^ 2 + have hF : Measurable F := + (measurable_coulombKernel.comp + ((measurable_particlePosition i).prodMk (measurable_particlePosition j))).mul + (measurable_state_norm_sq ψ) + have hI : Measurable (fun z : Position × OtherConfiguration i => + F (insertParticle i z.1 z.2)) := + hF.comp (measurePreserving_insertParticle i).measurable + calc + _ = ∫⁻ z : Position × OtherConfiguration i, F (insertParticle i z.1 z.2) := + ((measurePreserving_insertParticle i).lintegral_comp hF).symm + _ = ∫⁻ y : OtherConfiguration i, ∫⁻ x : Position, F (insertParticle i x y) := + lintegral_prod_symm _ hI.aemeasurable + _ = _ := by + apply lintegral_congr_ae + filter_upwards [realFormParticleSlices_ae i ψ] with y hy + apply lintegral_congr_ae + filter_upwards [hy] with x hx + exact congrArg₂ (fun (a b : ℝ≥0∞) => a * b) + (congrArg₂ coulombKernel (particlePosition_insertParticle i x y) + (realForm_particlePosition_insert_ne i j hij x y)) + (congrArg (fun a : SpinAmplitudes N q => (‖a‖₊ : ℝ≥0∞) ^ 2) hx).symm + +/-- Conditional pair estimate: the input is the exact Hardy +one-body Fourier Coulomb bound, specialized to the full finite spin space. -/ +theorem lintegral_pair_coulomb_le_of_one_body_bound {N q : ℕ} + (hHardy : ∀ (c : Position) (u : Lp (SpinAmplitudes N q) 2 (volume : Measure Position)), + (∫⁻ x : Position, coulombKernel x c * (‖u x‖₊ : ℝ≥0∞) ^ 2) ≤ + (‖u‖₊ : ℝ≥0∞) ^ 2 + 4 * ∫⁻ ξ : Position, + ENNReal.ofReal ((2 * Real.pi) ^ 2) * (‖ξ‖₊ : ℝ≥0∞) ^ 2 * + (‖(Lp.fourierTransformₗᵢ Position (SpinAmplitudes N q) u) ξ‖₊ : ℝ≥0∞) ^ 2) + (i j : Fin N) (hij : i ≠ j) (ψ : State N q) : + (∫⁻ X : Configuration N, coulombKernel (particlePosition X i) (particlePosition X j) * + (‖ψ X‖₊ : ℝ≥0∞) ^ 2) ≤ + (‖ψ‖₊ : ℝ≥0∞) ^ 2 + 4 * particleFourierEnergy ψ i := by + let u := realFormParticleCurrying i ψ + let v := realFormSwapCurrying u + let w : Position → ℝ≥0∞ := fun ξ => + ENNReal.ofReal ((2 * Real.pi) ^ 2) * (‖ξ‖₊ : ℝ≥0∞) ^ 2 + have hw : Measurable w := + measurable_const.mul (measurable_id.nnnorm.coe_nnreal_ennreal.pow_const 2) + have henergy : (∫⁻ y : OtherConfiguration i, ∫⁻ ξ : Position, w ξ * + (‖(Lp.fourierTransformₗᵢ Position (SpinAmplitudes N q) (v y)) ξ‖₊ : ℝ≥0∞) ^ 2) = + particleFourierEnergy ψ i := + (realFormSwapCurrying_fourier_weighted_norm_sq u w hw).trans + (realFormParticleCurrying_fourier_energy i ψ) + have hmass : (∫⁻ y : OtherConfiguration i, (‖v y‖₊ : ℝ≥0∞) ^ 2) = + (‖ψ‖₊ : ℝ≥0∞) ^ 2 := by + change (∫⁻ y : OtherConfiguration i, ‖v y‖ₑ ^ 2) = ‖ψ‖ₑ ^ 2 + rw [lintegral_l2_enorm_sq, ← ofReal_norm, ← ofReal_norm, + LinearIsometryEquiv.norm_map, realFormParticleCurrying_norm] + have hmeas : Measurable (fun y : OtherConfiguration i => (‖v y‖₊ : ℝ≥0∞) ^ 2) := by + simpa only [enorm_eq_nnnorm] using (Lp.stronglyMeasurable v).enorm.pow_const 2 + rw [realForm_pair_lintegral_eq_slices i j hij ψ] + calc + _ ≤ ∫⁻ y : OtherConfiguration i, (‖v y‖₊ : ℝ≥0∞) ^ 2 + + 4 * ∫⁻ ξ : Position, w ξ * + (‖(Lp.fourierTransformₗᵢ Position (SpinAmplitudes N q) (v y)) ξ‖₊ : ℝ≥0∞) ^ 2 := + lintegral_mono (fun y => hHardy (particlePosition (insertParticle i 0 y) j) (v y)) + _ = _ := by + rw [lintegral_add_left hmeas, + lintegral_const_mul' 4 _ (by norm_num), hmass, henergy] + +/-- Each particle energy is dominated by the total kinetic energy. -/ +theorem realForm_particleFourierEnergy_le {N q : ℕ} (i : Fin N) (ψ : State N q) : + particleFourierEnergy ψ i ≤ kineticEnergy ψ := by + rw [kineticEnergy_eq_sum_particleFourierEnergy] + exact Finset.single_le_sum (fun _ _ => zero_le) (Finset.mem_univ i) + +/-- Conditional finiteness of the electron repulsion on the finite kinetic +form domain, with no symmetry or normalization required. -/ +theorem lintegral_electronRepulsion_lt_top_of_one_body_bound {N q : ℕ} + (hHardy : ∀ (c : Position) (u : Lp (SpinAmplitudes N q) 2 (volume : Measure Position)), + (∫⁻ x : Position, coulombKernel x c * (‖u x‖₊ : ℝ≥0∞) ^ 2) ≤ + (‖u‖₊ : ℝ≥0∞) ^ 2 + 4 * ∫⁻ ξ : Position, + ENNReal.ofReal ((2 * Real.pi) ^ 2) * (‖ξ‖₊ : ℝ≥0∞) ^ 2 * + (‖(Lp.fourierTransformₗᵢ Position (SpinAmplitudes N q) u) ξ‖₊ : ℝ≥0∞) ^ 2) + (ψ : State N q) (hT : kineticEnergy ψ < ⊤) : + (∫⁻ x : Configuration N, electronRepulsion x * (‖ψ x‖₊ : ℝ≥0∞) ^ 2) < ⊤ := by + classical + unfold electronRepulsion + simp_rw [Finset.sum_mul] + rw [lintegral_finsetSum] + · apply ENNReal.sum_lt_top.mpr + intro i _ + rw [lintegral_finsetSum] + · apply ENNReal.sum_lt_top.mpr + intro j hj + have hij : i ≠ j := ne_of_lt (Finset.mem_filter.mp hj).2 + apply (lintegral_pair_coulomb_le_of_one_body_bound hHardy i j hij ψ).trans_lt + apply ENNReal.add_lt_top.mpr + refine ⟨ENNReal.pow_lt_top ENNReal.coe_lt_top, ?_⟩ + exact ENNReal.mul_lt_top (by norm_num) + ((realForm_particleFourierEnergy_le i ψ).trans_lt hT) + · intro j _ + exact (measurable_coulombKernel.comp + ((measurable_particlePosition i).prodMk (measurable_particlePosition j))).mul + (measurable_state_norm_sq ψ) + · intro i _ + exact Finset.measurable_sum _ (fun j _ => + (measurable_coulombKernel.comp + ((measurable_particlePosition i).prodMk (measurable_particlePosition j))).mul + (measurable_state_norm_sq ψ)) + +end LiebThirring.Assembly +end diff --git a/LeanPool/LiebThirring/Assembly/RealFormSlices.lean b/LeanPool/LiebThirring/Assembly/RealFormSlices.lean new file mode 100644 index 0000000000..6c5b2fe71e --- /dev/null +++ b/LeanPool/LiebThirring/Assembly/RealFormSlices.lean @@ -0,0 +1,148 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Assembly.RealFormCurrying +public import LeanPool.LiebThirring.Kinetic.FourierFactorIdentity + +/-! # Full-spin one-particle L² slices + +Spatial currying without spin regrouping gives the slices on which the +one-body Hardy estimate is applied. Spin regrouping is an isometry, so the +partial Fourier weighted norm is exactly the landed particle Fourier energy. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal FourierTransform + +namespace LiebThirring.Assembly + +local instance : Fact ((2 : ℝ≥0∞) ≠ ⊤) := ⟨ENNReal.ofNat_ne_top⟩ + +/-- Spatial currying with the complete spin amplitude retained in each slice. -/ +@[expose] noncomputable def realFormParticleCurrying {N q : ℕ} (i : Fin N) + (ψ : State N q) : + Lp (Lp (SpinAmplitudes N q) 2 (volume : Measure (OtherConfiguration i))) 2 + (volume : Measure Position) := + l2Curry (l2PullbackEquiv (E := SpinAmplitudes N q) + (insertionMeasurableEquiv i) (measurePreserving_insertion i) ψ) + +/-- The full-spin curried representative is the inserted state. -/ +theorem realFormParticleCurrying_ae {N q : ℕ} (i : Fin N) (ψ : State N q) : + ∀ᵐ x : Position, ∀ᵐ y : OtherConfiguration i, + realFormParticleCurrying i ψ x y = ψ (insertParticle i x y) := by + let f := l2PullbackEquiv (E := SpinAmplitudes N q) + (insertionMeasurableEquiv i) (measurePreserving_insertion i) ψ + filter_upwards [l2Curry_ae f, Measure.ae_ae_of_ae_prod (l2PullbackEquiv_ae + (insertionMeasurableEquiv i) (measurePreserving_insertion i) ψ)] with x hx ht + filter_upwards [hx, ht] with y hxy hty + exact hxy.trans (hty.trans (congrArg ψ (insertionMeasurableEquiv_apply i (x, y)))) + +/-- Spatial currying preserves the original L² norm. -/ +theorem realFormParticleCurrying_norm {N q : ℕ} (i : Fin N) (ψ : State N q) : + ‖realFormParticleCurrying i ψ‖ = ‖ψ‖ := by + rw [realFormParticleCurrying, l2Curry_norm, LinearIsometryEquiv.norm_map] + +/-- Regroup the complete spin slice into the landed one-particle fiber. -/ +@[expose] noncomputable def realFormSpinRegrouping {N q : ℕ} (i : Fin N) : + Lp (SpinAmplitudes N q) 2 (volume : Measure (OtherConfiguration i)) ≃ₗᵢ[ℂ] + OneParticleFiber i q := + (l2TargetEquiv (volume : Measure (OtherConfiguration i)) + (spinCurryingLinearIsometryEquiv (q := q) i)).trans + (finiteLpPiLpEquiv (volume : Measure (OtherConfiguration i)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherSpinLabels i q))) + +/-- The representative formula for spin regrouping. -/ +theorem realFormSpinRegrouping_ae {N q : ℕ} (i : Fin N) + (v : Lp (SpinAmplitudes N q) 2 (volume : Measure (OtherConfiguration i))) + (s : Fin q) : + ∀ᵐ y : OtherConfiguration i, ∀ t : OtherSpinLabels i q, + realFormSpinRegrouping i v s y t = v y (insertSpin i s t) := by + filter_upwards [finiteLpPiLpEquiv_apply_ae + (volume : Measure (OtherConfiguration i)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherSpinLabels i q)) + (l2TargetEquiv (volume : Measure (OtherConfiguration i)) + (spinCurryingLinearIsometryEquiv (q := q) i) v) s, + l2TargetEquiv_ae (volume : Measure (OtherConfiguration i)) + (spinCurryingLinearIsometryEquiv (q := q) i) v] with y hy ht + intro t + change finiteLpPiLpEquiv (volume : Measure (OtherConfiguration i)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherSpinLabels i q)) + (l2TargetEquiv (volume : Measure (OtherConfiguration i)) + (spinCurryingLinearIsometryEquiv (q := q) i) v) s y t = _ + rw [hy, ht] + rfl + +/-- Full-spin currying and the currying currying differ only by a target isometry. -/ +theorem realFormSpinRegrouping_compLp {N q : ℕ} (i : Fin N) (ψ : State N q) : + (realFormSpinRegrouping (q := q) i).toContinuousLinearEquiv.toContinuousLinearMap.compLp + (realFormParticleCurrying i ψ) = oneParticleCurrying i ψ := by + apply Lp.ext + filter_upwards [(realFormSpinRegrouping (q := q) + i).toContinuousLinearEquiv.toContinuousLinearMap.coeFn_compLp + (realFormParticleCurrying i ψ), realFormParticleCurrying_ae i ψ, + oneParticleCurrying_ae i ψ] with x ht hx hc + rw [ht] + apply PiLp.ext + intro s + apply Lp.ext + filter_upwards [realFormSpinRegrouping_ae i (realFormParticleCurrying i ψ x) s, + hx, hc s] with y hty hxy hcy + ext t + change realFormSpinRegrouping i (realFormParticleCurrying i ψ x) s y t = + oneParticleCurrying i ψ x s y t + rw [hty t, hxy, hcy t] + +/-- Spin regrouping commutes with the spatial partial Fourier transform. -/ +theorem realFormParticleCurrying_fourier_regrouping {N q : ℕ} (i : Fin N) (ψ : State N q) : + (realFormSpinRegrouping (q := q) i).toContinuousLinearEquiv.toContinuousLinearMap.compLp + (𝓕 (realFormParticleCurrying i ψ)) = 𝓕 (oneParticleCurrying i ψ) := by + rw [← Fourier.fourier_compLp, realFormSpinRegrouping_compLp] + +/-- Partial Fourier kinetic mass of the full-spin slices is the particle energy. -/ +theorem realFormParticleCurrying_fourier_energy {N q : ℕ} (i : Fin N) (ψ : State N q) : + (∫⁻ ξ : Position, ENNReal.ofReal ((2 * Real.pi) ^ 2) * (‖ξ‖₊ : ℝ≥0∞) ^ 2 * + (‖(𝓕 (realFormParticleCurrying i ψ) : + Lp (Lp (SpinAmplitudes N q) 2 (volume : Measure (OtherConfiguration i))) 2 volume) ξ‖₊ : + ℝ≥0∞) ^ 2) = + particleFourierEnergy ψ i := by + have h := realFormTargetIsometry_weighted_norm_sq (realFormSpinRegrouping (q := q) i) + (𝓕 (realFormParticleCurrying i ψ)) + (fun ξ : Position => ENNReal.ofReal ((2 * Real.pi) ^ 2) * (‖ξ‖₊ : ℝ≥0∞) ^ 2) + rw [realFormParticleCurrying_fourier_regrouping] at h + exact h.symm.trans (particleFourierEnergy_eq_partialFourier i ψ).symm + +/-- In the opposite order, each remaining-coordinate slice is the original +state as a function of the selected particle position. -/ +theorem realFormParticleSlices_ae {N q : ℕ} (i : Fin N) (ψ : State N q) : + ∀ᵐ y : OtherConfiguration i, ∀ᵐ x : Position, + realFormSwapCurrying (realFormParticleCurrying i ψ) y x = + ψ (insertParticle i x y) := by + let f := l2PullbackEquiv (E := SpinAmplitudes N q) + (insertionMeasurableEquiv i) (measurePreserving_insertion i) ψ + have hinv : (l2CurryLinearIsometryEquiv (μ := (volume : Measure Position)) + (ν := (volume : Measure (OtherConfiguration i))) (E := SpinAmplitudes N q)).symm + (realFormParticleCurrying i ψ) = f := + (l2CurryLinearIsometryEquiv (μ := (volume : Measure Position)) + (ν := (volume : Measure (OtherConfiguration i))) (E := SpinAmplitudes N q)).symm_apply_apply f + have hS := realFormSwapCurrying_ae_uncurry (realFormParticleCurrying i ψ) + rw [hinv] at hS + have hA := l2PullbackEquiv_ae (insertionMeasurableEquiv i) + (measurePreserving_insertion i) ψ + have hback := (Measure.measurePreserving_swap + (μ := (volume : Measure (OtherConfiguration i))) (ν := (volume : Measure + Position))).quasiMeasurePreserving.ae hA + filter_upwards [hS, Measure.ae_ae_of_ae_prod hback] with y hy ht + filter_upwards [hy, ht] with x hx htx + exact hx.trans (htx.trans (congrArg ψ (insertionMeasurableEquiv_apply i (x, y)))) + +end LiebThirring.Assembly +end diff --git a/LeanPool/LiebThirring/Assembly/RealFormStability.lean b/LeanPool/LiebThirring/Assembly/RealFormStability.lean new file mode 100644 index 0000000000..44b5ad4aa5 --- /dev/null +++ b/LeanPool/LiebThirring/Assembly/RealFormStability.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Assembly.RealFormPairs +public import LeanPool.LiebThirring.Theorems.StabilityOfMatter + +/-! +# Real-form stability conditional on the one-body Hardy bound + +The one-body Hardy bound gives finite Coulomb expectations and a real quadratic-form inequality +with the same constant as extended stability. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring.Assembly + +/-- Real-form stability from additive stability and the one-body Fourier Coulomb bound. -/ +theorem stability_of_matter_real_of_one_body_bound (q : ℕ) (hq : 1 ≤ q) (Z : ℝ≥0) + (hHardy : ∀ (N : ℕ) (c : Position) + (u : Lp (SpinAmplitudes N q) 2 (volume : Measure Position)), + (∫⁻ x : Position, coulombKernel x c * (‖u x‖₊ : ℝ≥0∞) ^ 2) ≤ + (‖u‖₊ : ℝ≥0∞) ^ 2 + 4 * ∫⁻ ξ : Position, + ENNReal.ofReal ((2 * Real.pi) ^ 2) * (‖ξ‖₊ : ℝ≥0∞) ^ 2 * + (‖(Lp.fourierTransformₗᵢ Position (SpinAmplitudes N q) u) ξ‖₊ : ℝ≥0∞) ^ 2) : + ∃ C : ℝ≥0, 0 < C ∧ + ∀ (N M : ℕ) (z : Fin M → ℝ≥0) (R : Fin M → Position) (ψ : State N q), + (∀ k, z k ≤ Z) → Function.Injective R → + antisymmetric ψ → ‖ψ‖ = 1 → kineticEnergy ψ < ⊤ → + (∫⁻ x : Configuration N, + attraction z R x * (‖ψ x‖₊ : ℝ≥0∞) ^ 2) < ⊤ ∧ + (∫⁻ x : Configuration N, + electronRepulsion x * (‖ψ x‖₊ : ℝ≥0∞) ^ 2) < ⊤ ∧ + nuclearRepulsion z R < ⊤ ∧ + -(C : ℝ) * ((N + M : ℕ) : ℝ) ≤ + (kineticEnergy ψ).toReal + + (∫⁻ x : Configuration N, + electronRepulsion x * (‖ψ x‖₊ : ℝ≥0∞) ^ 2).toReal + + (nuclearRepulsion z R).toReal - + (∫⁻ x : Configuration N, + attraction z R x * (‖ψ x‖₊ : ℝ≥0∞) ^ 2).toReal := by + obtain ⟨C, hC, hstability⟩ := LiebThirring.stability_of_matter q hq Z + refine ⟨C, hC, ?_⟩ + intro N M z R ψ hz hR hψ hnorm hT + have hB := lintegral_electronRepulsion_lt_top_of_one_body_bound (hHardy N) ψ hT + have hU := nuclearRepulsion_lt_top z R hR + have hreal := real_form_of_extended_bound C (N + M) hT hB hU + (hstability N M z R ψ hz hψ hnorm) + exact ⟨hreal.1, hB, hU, hreal.2⟩ + +end LiebThirring.Assembly +end diff --git a/LeanPool/LiebThirring/Assembly/RuminIntegral.lean b/LeanPool/LiebThirring/Assembly/RuminIntegral.lean new file mode 100644 index 0000000000..cf65fce5a1 --- /dev/null +++ b/LeanPool/LiebThirring/Assembly/RuminIntegral.lean @@ -0,0 +1,169 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.RuminConstant +public import Mathlib.MeasureTheory.Integral.Bochner.Set +public import Mathlib.MeasureTheory.Measure.Lebesgue.Basic +import Mathlib.Analysis.SpecialFunctions.Integrals.Basic +import Mathlib.MeasureTheory.Integral.IntegralEqImproper + +/-! +# Exact scalar Rumin integration + +Rescaling the finite cutoff interval to `[0,1]` evaluates the squared positive part with +coefficient `9/35`. Integrability is established before conversion to the extended integral. See +Frank, Hundertmark, Jex and Nam (2018), equation (8). +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal NNReal +namespace LiebThirring.Assembly + +private lemma normalized_tail (E : ℝ) (hE : 1 ≤ E) : + (max (1 - E ^ ((3 : ℝ) / 4)) 0) ^ 2 = 0 := by + have hp : 1 ≤ E ^ ((3 : ℝ) / 4) := Real.one_le_rpow hE (by norm_num) + rw [max_eq_right (sub_nonpos.mpr hp), zero_pow (by decide)] + +private lemma normalized_integrable : + IntegrableOn (fun E : ℝ => (max (1 - E ^ ((3 : ℝ) / 4)) 0) ^ 2) (Ioi 0) := by + have hc : Continuous (fun E : ℝ => (max (1 - E ^ ((3 : ℝ) / 4)) 0) ^ 2) := + ((continuous_const.sub (Real.continuous_rpow_const (by norm_num))).max continuous_const).pow 2 + rw [← Ioc_union_Ioi_eq_Ioi (show (0 : ℝ) ≤ 1 by norm_num), integrableOn_union] + constructor + · exact hc.continuousOn.integrableOn_Icc.mono_set Ioc_subset_Icc_self + · exact (integrableOn_congr_fun (fun E hE => normalized_tail E hE.le) measurableSet_Ioi).mpr + integrableOn_zero + +private lemma normalized_integral : + (∫ E in Ioi (0 : ℝ), (max (1 - E ^ ((3 : ℝ) / 4)) 0) ^ 2) = (9 / 35 : ℝ) := by + rw [← Ioc_union_Ioi_eq_Ioi (show (0 : ℝ) ≤ 1 by norm_num), + integral_union_eq_left_of_forall measurableSet_Ioi (fun E hE => normalized_tail E hE.le), + ← intervalIntegral.integral_of_le (show (0 : ℝ) ≤ 1 by norm_num)] + have heq : (∫ E in (0 : ℝ)..1, (max (1 - E ^ ((3 : ℝ) / 4)) 0) ^ 2) = + ∫ E in (0 : ℝ)..1, (1 - 2 * E ^ ((3 : ℝ) / 4) + E ^ ((3 : ℝ) / 2)) := by + apply intervalIntegral.integral_congr + intro E hE + have hE' : E ∈ Icc (0 : ℝ) 1 := by simpa using hE + dsimp only + rw [max_eq_left (sub_nonneg.mpr (Real.rpow_le_one hE'.1 hE'.2 (by norm_num)))] + have hp : (E ^ ((3 : ℝ) / 4)) ^ 2 = E ^ ((3 : ℝ) / 2) := by + rw [← Real.rpow_mul_natCast hE'.1] + norm_num + rw [← hp] + ring + rw [heq] + have h34 : IntervalIntegrable (fun E : ℝ => E ^ ((3 : ℝ) / 4)) volume 0 1 := + (Real.continuous_rpow_const (by norm_num)).intervalIntegrable _ _ + have h32 : IntervalIntegrable (fun E : ℝ => E ^ ((3 : ℝ) / 2)) volume 0 1 := + (Real.continuous_rpow_const (by norm_num)).intervalIntegrable _ _ + rw [intervalIntegral.integral_add (intervalIntegrable_const.sub (h34.const_mul 2)) h32, + intervalIntegral.integral_sub intervalIntegrable_const (h34.const_mul 2), + intervalIntegral.integral_const_mul, intervalIntegral.integral_const, + integral_rpow (Or.inl (by norm_num : (-1 : ℝ) < 3 / 4)), + integral_rpow (Or.inl (by norm_num : (-1 : ℝ) < 3 / 2))] + norm_num + +private lemma rumin_scaling (t d E : ℝ) (ht : 0 ≤ t) (hd : 0 < d) (hE : 0 ≤ E) : + (max (Real.sqrt t - Real.sqrt d * (((t / d) ^ ((2 : ℝ) / 3)) * E) ^ ((3 : ℝ) / 4)) 0) ^ 2 = + t * (max (1 - E ^ ((3 : ℝ) / 4)) 0) ^ 2 := by + have htd : 0 ≤ t / d := div_nonneg ht hd.le + have hc : Real.sqrt d * ((t / d) ^ ((2 : ℝ) / 3)) ^ ((3 : ℝ) / 4) = Real.sqrt t := by + rw [← Real.rpow_mul htd] + norm_num + rw [← Real.sqrt_eq_rpow, Real.sqrt_div ht d] + exact mul_div_cancel₀ _ (Real.sqrt_pos.2 hd).ne' + rw [Real.mul_rpow (Real.rpow_nonneg htd _) hE, ← mul_assoc, hc] + have hfactor : Real.sqrt t - Real.sqrt t * E ^ ((3 : ℝ) / 4) = + Real.sqrt t * (1 - E ^ ((3 : ℝ) / 4)) := by ring + rw [hfactor, ← mul_zero (Real.sqrt t), ← mul_max_of_nonneg _ _ (Real.sqrt_nonneg t), + mul_pow, Real.sq_sqrt ht] + simp only [mul_zero] + +private lemma rumin_cutoff_value (t d : ℝ) (ht : 0 < t) (hd : 0 < d) : + ((t / d) ^ ((2 : ℝ) / 3)) * t = d ^ (-(2 : ℝ) / 3) * t ^ ((5 : ℝ) / 3) := by + rw [Real.div_rpow ht.le hd.le, div_eq_mul_inv, ← Real.rpow_neg hd.le] + have hp : t ^ ((2 : ℝ) / 3) * t = t ^ ((5 : ℝ) / 3) := by + calc + t ^ ((2 : ℝ) / 3) * t = t ^ ((2 : ℝ) / 3) * t ^ (1 : ℝ) := by rw [Real.rpow_one] + _ = t ^ ((5 : ℝ) / 3) := by rw [← Real.rpow_add ht]; norm_num + calc + t ^ ((2 : ℝ) / 3) * d ^ (-((2 : ℝ) / 3)) * t = + d ^ (-((2 : ℝ) / 3)) * (t ^ ((2 : ℝ) / 3) * t) := by ring + _ = d ^ (-(2 : ℝ) / 3) * t ^ ((5 : ℝ) / 3) := by rw [hp]; norm_num + +private lemma rumin_joint (t d : ℝ) (ht : 0 ≤ t) (hd : 0 < d) : + IntegrableOn (fun E : ℝ => (max (Real.sqrt t - Real.sqrt d * E ^ ((3 : ℝ) / 4)) 0) ^ 2) (Ioi 0) + ∧ + (∫ E in Ioi (0 : ℝ), (max (Real.sqrt t - Real.sqrt d * E ^ ((3 : ℝ) / 4)) 0) ^ 2) = + (9 / 35 : ℝ) * d ^ (-(2 : ℝ) / 3) * t ^ ((5 : ℝ) / 3) := by + rcases ht.eq_or_lt with rfl | ht + · have hzero : ∀ E ∈ Ioi (0 : ℝ), + (max (Real.sqrt 0 - Real.sqrt d * E ^ ((3 : ℝ) / 4)) 0) ^ 2 = 0 := by + intro E hE + rw [Real.sqrt_zero, zero_sub, + max_eq_right (neg_nonpos.mpr (mul_nonneg (Real.sqrt_nonneg d) (Real.rpow_nonneg hE.le _)))] + norm_num + constructor + · exact (integrableOn_congr_fun hzero measurableSet_Ioi).mpr integrableOn_zero + · rw [setIntegral_congr_fun measurableSet_Ioi hzero, integral_zero] + simp only [Real.zero_rpow (by norm_num : (5 : ℝ) / 3 ≠ 0), mul_zero] + · let e0 : ℝ := (t / d) ^ ((2 : ℝ) / 3) + have he0 : 0 < e0 := Real.rpow_pos_of_pos (div_pos ht hd) _ + have hscale : (fun E : ℝ => (max (Real.sqrt t - Real.sqrt d * (e0 * E) ^ ((3 : ℝ) / 4)) 0) ^ 2) + =ᵐ[volume.restrict (Ioi 0)] + (fun E : ℝ => t * (max (1 - E ^ ((3 : ℝ) / 4)) 0) ^ 2) := by + filter_upwards [ae_restrict_mem measurableSet_Ioi] with E hE + exact rumin_scaling t d E ht.le hd hE.le + constructor + · have hi := (normalized_integrable.const_mul t).congr hscale.symm + have hi' := (integrableOn_Ioi_comp_mul_left_iff + (fun E : ℝ => (max (Real.sqrt t - Real.sqrt d * E ^ ((3 : ℝ) / 4)) 0) ^ 2) 0 he0).mp hi + simpa only [mul_zero] using hi' + · have hchange := integral_comp_mul_left_Ioi' + (fun E : ℝ => (max (Real.sqrt t - Real.sqrt d * E ^ ((3 : ℝ) / 4)) 0) ^ 2) 0 he0 + simp only [mul_zero, smul_eq_mul] at hchange + rw [← hchange, integral_congr_ae hscale, integral_const_mul, normalized_integral] + have hc := rumin_cutoff_value t d ht hd + calc + e0 * (t * (9 / 35)) = (9 / 35) * (e0 * t) := by ring + _ = (9 / 35) * d ^ (-(2 : ℝ) / 3) * t ^ ((5 : ℝ) / 3) := by rw [hc]; ring + +/-- The scalar Rumin positive part is integrable on the positive half-line (scalar Rumin +integration). -/ +theorem rumin_integrableOn (t d : ℝ) (ht : 0 ≤ t) (hd : 0 < d) : + IntegrableOn (fun E : ℝ => (max (Real.sqrt t - Real.sqrt d * E ^ ((3 : ℝ) / 4)) 0) ^ 2) (Ioi 0) + := + (rumin_joint t d ht hd).1 + +/-- Exact scalar Rumin integral, with coefficient `9/35` (scalar Rumin integration). -/ +theorem integral_rumin (t d : ℝ) (ht : 0 ≤ t) (hd : 0 < d) : + (∫ E in Ioi (0 : ℝ), (max (Real.sqrt t - Real.sqrt d * E ^ ((3 : ℝ) / 4)) 0) ^ 2) = + (9 / 35 : ℝ) * d ^ (-(2 : ℝ) / 3) * t ^ ((5 : ℝ) / 3) := + (rumin_joint t d ht hd).2 + +/-- The nonnegative extended integral equals the same finite scalar value (scalar Rumin +integration). -/ +theorem lintegral_rumin (t d : ℝ) (ht : 0 ≤ t) (hd : 0 < d) : + (∫⁻ E in Ioi (0 : ℝ), ENNReal.ofReal + ((max (Real.sqrt t - Real.sqrt d * E ^ ((3 : ℝ) / 4)) 0) ^ 2)) = + ENNReal.ofReal ((9 / 35 : ℝ) * d ^ (-(2 : ℝ) / 3) * t ^ ((5 : ℝ) / 3)) := by + rw [← ofReal_integral_eq_lintegral_ofReal (rumin_integrableOn t d ht hd) + (Filter.Eventually.of_forall (fun E => sq_nonneg (max (Real.sqrt t - Real.sqrt d * E ^ ((3 : ℝ) + / 4)) 0))), + integral_rumin t d ht hd] + +/-- The exact Rumin coefficient is strictly positive (the Rumin bound). -/ +theorem ruminConstant_pos : 0 < LiebThirring.ruminConstant := by + unfold LiebThirring.ruminConstant + exact Real.toNNReal_pos.mpr (mul_pos (by norm_num) (Real.rpow_pos_of_pos (by positivity) _)) +end LiebThirring.Assembly +end diff --git a/LeanPool/LiebThirring/Assembly/Screening.lean b/LeanPool/LiebThirring/Assembly/Screening.lean new file mode 100644 index 0000000000..53f6ad3467 --- /dev/null +++ b/LeanPool/LiebThirring/Assembly/Screening.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.Antisymmetric +public import LeanPool.LiebThirring.Defs.Density +public import LeanPool.LiebThirring.Defs.KineticEnergy +public import LeanPool.LiebThirring.Defs.Coulomb +public import LeanPool.LiebThirring.Defs.RuminConstant +import LeanPool.LiebThirring.Assembly.RuminIntegral +import LeanPool.LiebThirring.Assembly.Young +import LeanPool.LiebThirring.Assembly.Cutoff +import LeanPool.LiebThirring.Kinetic.DensityBasic + +/-! +# Screening paid for by kinetic energy + +The nearest-nucleus cutoff, extended Young inequality, and kinetic Lieb–Thirring bound pay for +screening. The positive cutoff radius is `κ / (2Z + 1)`. +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal NNReal +namespace LiebThirring.Assembly + +/-- Positivity of the real kinetic coefficient for a nonzero spin multiplicity. -/ +theorem kinetic_coefficient_pos (q : ℕ) (hq : 1 ≤ q) : + 0 < (ruminConstant : ℝ) * (q : ℝ) ^ (-(2 : ℝ) / 3) := by + have hq' : 0 < (q : ℝ) := Nat.cast_pos.mpr (Nat.lt_of_lt_of_le Nat.zero_lt_one hq) + exact mul_pos (NNReal.coe_pos.mpr ruminConstant_pos) (Real.rpow_pos_of_pos hq' _) + +/-- The real kinetic coefficient embeds as the exact extended coefficient. -/ +theorem kinetic_coefficient_eq (q : ℕ) (hq : 1 ≤ q) : + ENNReal.ofReal ((ruminConstant : ℝ) * (q : ℝ) ^ (-(2 : ℝ) / 3)) = + (ruminConstant : ℝ≥0∞) * (q : ℝ≥0∞) ^ (-(2 : ℝ) / 3) := by + have hq' : 0 < (q : ℝ) := Nat.cast_pos.mpr (Nat.lt_of_lt_of_le Nat.zero_lt_one hq) + rw [ENNReal.ofReal_mul (NNReal.coe_nonneg _), ENNReal.ofReal_coe_nnreal, + ← ENNReal.ofReal_rpow_of_pos hq', ENNReal.ofReal_natCast] + +private theorem screening_scale_eq (κ a : ℝ) (hκ : 0 < κ) (ha : 0 < a) : + κ ^ (-(3 : ℝ) / 2) * a ^ ((5 : ℝ) / 2) * Real.sqrt (κ / a) = a ^ 2 / κ := by + have hk : κ ^ (-(3 : ℝ) / 2) * κ ^ ((1 : ℝ) / 2) = κ⁻¹ := by + rw [← Real.rpow_add hκ] + norm_num [Real.rpow_neg_one] + have ha' : a ^ ((5 : ℝ) / 2) / a ^ ((1 : ℝ) / 2) = a ^ 2 := by + rw [← Real.rpow_sub ha] + norm_num + rw [Real.sqrt_eq_rpow, Real.div_rpow hκ.le ha.le] + calc + κ ^ (-(3 : ℝ) / 2) * a ^ ((5 : ℝ) / 2) * (κ ^ ((1 : ℝ) / 2) / a ^ ((1 : ℝ) / 2)) = + (κ ^ (-(3 : ℝ) / 2) * κ ^ ((1 : ℝ) / 2)) * (a ^ ((5 : ℝ) / 2) / a ^ ((1 : ℝ) / 2)) := by + ring + _ = a ^ 2 / κ := by rw [hk, ha']; ring + +private theorem screening_cost_eq (κ a : ℝ) (hκ : 0 < κ) (ha : 0 < a) (N M : ℕ) : + ((2 / 5 : ℝ) * (3 / 5 : ℝ) ^ ((3 : ℝ) / 2) * κ ^ (-(3 : ℝ) / 2)) * + (8 * Real.pi * (M : ℝ) * a ^ ((5 : ℝ) / 2) * Real.sqrt (κ / a)) + + (a / (κ / a)) * (N : ℝ) = + (a ^ 2 / κ) * ((N : ℝ) + 8 * Real.pi * ((2 / 5 : ℝ) * (3 / 5 : ℝ) ^ ((3 : ℝ) / 2)) * M) := by + have hscale := screening_scale_eq κ a hκ ha + have hratio : a / (κ / a) = a ^ 2 / κ := by field_simp + rw [hratio] + calc + _ = ((2 / 5 : ℝ) * (3 / 5 : ℝ) ^ ((3 : ℝ) / 2)) * (8 * Real.pi * M) * + (κ ^ (-(3 : ℝ) / 2) * a ^ ((5 : ℝ) / 2) * Real.sqrt (κ / a)) + (a ^ 2 / κ) * N := by ring + _ = _ := by rw [hscale]; ring +/-- Screening is paid for by the exact kinetic LT hypothesis and the screening cost. -/ +theorem screening_of_lt + (hLT : ∀ (q : ℕ), 1 ≤ q → ∀ (N : ℕ) (ψ : State N q), antisymmetric ψ → ‖ψ‖ = 1 → + (ruminConstant : ℝ≥0∞) * (q : ℝ≥0∞) ^ (-(2 : ℝ) / 3) * + (∫⁻ x : Position, density ψ x ^ ((5 : ℝ) / 3)) ≤ kineticEnergy ψ) + (q : ℕ) (hq : 1 ≤ q) (Z : ℝ≥0) (N M : ℕ) (R : Fin M → Position) + (ψ : State N q) (hanti : antisymmetric ψ) (hnorm : ‖ψ‖ = 1) : + ENNReal.ofReal (2 * (Z : ℝ) + 1) * + (∫⁻ x : Position, (nearestNucleusDistance R x)⁻¹ * density ψ x) ≤ + kineticEnergy ψ + ENNReal.ofReal + ((((2 * (Z : ℝ) + 1) ^ 2) / ((ruminConstant : ℝ) * (q : ℝ) ^ (-(2 : ℝ) / 3))) * + ((N : ℝ) + 8 * Real.pi * ((2 / 5 : ℝ) * (3 / 5 : ℝ) ^ ((3 : ℝ) / 2)) * (M : ℝ))) := by + let κ : ℝ := (ruminConstant : ℝ) * (q : ℝ) ^ (-(2 : ℝ) / 3) + let a : ℝ := 2 * (Z : ℝ) + 1 + let r : ℝ := κ / a + let c : ℝ := (2 / 5 : ℝ) * (3 / 5 : ℝ) ^ ((3 : ℝ) / 2) * κ ^ (-(3 : ℝ) / 2) + have hκ : 0 < κ := kinetic_coefficient_pos q hq + have ha : 0 < a := by dsimp [a]; positivity + have hr : 0 < r := div_pos hκ ha + have hc : 0 < c := young_screening_coefficient_pos κ hκ + have hmass : (∫⁻ x : Position, density ψ x) = (N : ℝ≥0∞) := by + have hn : ‖ψ‖₊ = 1 := by apply NNReal.coe_injective; exact hnorm + rw [density_mass, hn] + simp only [ENNReal.coe_one, one_pow, mul_one] + have htail : ENNReal.ofReal a * + (∫⁻ x : Position, (nearestNucleusDistance R x)⁻¹ * density ψ x) ≤ + (∫⁻ x : Position, nearestNucleusCutoff a r R x * density ψ x) + + ENNReal.ofReal (a / r) * (N : ℝ≥0∞) := by + calc + _ = ∫⁻ x : Position, ENNReal.ofReal a * ((nearestNucleusDistance R x)⁻¹ * density ψ x) := + (lintegral_const_mul' _ _ ENNReal.ofReal_ne_top).symm + _ ≤ ∫⁻ x : Position, nearestNucleusCutoff a r R x * density ψ x + + ENNReal.ofReal (a / r) * density ψ x := by + apply lintegral_mono + intro x + simpa only [mul_assoc, add_mul] using + mul_le_mul_left (nearestNucleusInverse_le_cutoff a r hr R x) (density ψ x) + _ = _ := by + rw [lintegral_add_right _ ((measurable_density ψ).const_mul (ENNReal.ofReal (a / r))), + lintegral_const_mul' _ _ ENNReal.ofReal_ne_top, hmass] + have hdensitypower : Measurable (fun x : Position => density ψ x ^ ((5 : ℝ) / 3)) := + ENNReal.continuous_rpow_const.measurable.comp (measurable_density ψ) + have hyoung : (∫⁻ x : Position, nearestNucleusCutoff a r R x * density ψ x) ≤ + ENNReal.ofReal κ * (∫⁻ x : Position, density ψ x ^ ((5 : ℝ) / 3)) + + ENNReal.ofReal c * (∫⁻ x : Position, nearestNucleusCutoff a r R x ^ ((5 : ℝ) / 2)) := by + calc + _ ≤ ∫⁻ x : Position, ENNReal.ofReal κ * density ψ x ^ ((5 : ℝ) / 3) + + ENNReal.ofReal c * nearestNucleusCutoff a r R x ^ ((5 : ℝ) / 2) := + lintegral_mono (fun x => young_screening κ hκ (nearestNucleusCutoff a r R x) (density ψ x)) + _ = _ := by + rw [lintegral_add_left (hdensitypower.const_mul (ENNReal.ofReal κ)), + lintegral_const_mul' _ _ ENNReal.ofReal_ne_top, + lintegral_const_mul' _ _ ENNReal.ofReal_ne_top] + have hkinetic : ENNReal.ofReal κ * (∫⁻ x : Position, density ψ x ^ ((5 : ℝ) / 3)) ≤ + kineticEnergy ψ := by + rw [kinetic_coefficient_eq q hq] + exact hLT q hq N ψ hanti hnorm + have hcutoff := lintegral_nearestNucleusCutoff_rpow_le a r ha.le hr R + have hbound : (∫⁻ x : Position, nearestNucleusCutoff a r R x * density ψ x) ≤ + kineticEnergy ψ + ENNReal.ofReal c * + ENNReal.ofReal (8 * Real.pi * (M : ℝ) * a ^ ((5 : ℝ) / 2) * Real.sqrt r) := + hyoung.trans (add_le_add hkinetic (mul_le_mul_right hcutoff (ENNReal.ofReal c))) + have hrad : 0 ≤ 8 * Real.pi * (M : ℝ) * a ^ ((5 : ℝ) / 2) * Real.sqrt r := by positivity + have hratio : 0 ≤ a / r := (div_pos ha hr).le + have hcost : ENNReal.ofReal c * + ENNReal.ofReal (8 * Real.pi * (M : ℝ) * a ^ ((5 : ℝ) / 2) * Real.sqrt r) + + ENNReal.ofReal (a / r) * (N : ℝ≥0∞) = ENNReal.ofReal + ((a ^ 2 / κ) * ((N : ℝ) + 8 * Real.pi * ((2 / 5 : ℝ) * (3 / 5 : ℝ) ^ ((3 : ℝ) / 2)) * (M : + ℝ))) := by + rw [← ENNReal.ofReal_natCast N, ← ENNReal.ofReal_mul hc.le, + ← ENNReal.ofReal_mul hratio, + ← ENNReal.ofReal_add (mul_nonneg hc.le hrad) (mul_nonneg hratio (Nat.cast_nonneg N))] + exact congrArg ENNReal.ofReal (screening_cost_eq κ a hκ ha N M) + exact htail.trans ((add_le_add_left hbound _).trans_eq (by rw [add_assoc, hcost])) + +end LiebThirring.Assembly + +end diff --git a/LeanPool/LiebThirring/Assembly/Stability.lean b/LeanPool/LiebThirring/Assembly/Stability.lean new file mode 100644 index 0000000000..c3cc7c658e --- /dev/null +++ b/LeanPool/LiebThirring/Assembly/Stability.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Assembly.IntegratedBaxter +public import LeanPool.LiebThirring.Assembly.Screening + +/-! +# Conditional stability of matter + +The universally quantified Baxter and kinetic Lieb–Thirring inequalities yield a positive +stability constant chosen before particle counts, charges, nuclei, and the state. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring.Assembly + +private theorem cost_le_uniform (s f : ℝ) (hf : 0 ≤ f) (N M : ℕ) : + f * ((N : ℝ) + s * (M : ℝ)) ≤ (max 1 s * f) * ((N : ℝ) + (M : ℝ)) := by + have hN : (N : ℝ) ≤ max 1 s * (N : ℝ) := by + simpa only [one_mul] using mul_le_mul_of_nonneg_right (le_max_left 1 s) + (Nat.cast_nonneg N : (0 : ℝ) ≤ N) + have hM : s * (M : ℝ) ≤ max 1 s * (M : ℝ) := + mul_le_mul_of_nonneg_right (le_max_right 1 s) (Nat.cast_nonneg M) + calc + _ ≤ f * (max 1 s * (N : ℝ) + max 1 s * (M : ℝ)) := + mul_le_mul_of_nonneg_left (add_le_add hN hM) hf + _ = _ := by ring + +/-- Conditional assembly with the exact stability conclusion. -/ +theorem stability_of_matter_of_baxter_of_lt + (hB : ∀ (N M : ℕ) (Z : ℝ≥0) (R : Fin M → Position) (x : Configuration N), + attraction (fun _ => Z) R x + baxterCorrection Z R ≤ + electronRepulsion x + nuclearRepulsion (fun _ => Z) R + + nearestNucleusControl Z R x) + (hLT : ∀ (q : ℕ), 1 ≤ q → ∀ (N : ℕ) (ψ : State N q), + antisymmetric ψ → ‖ψ‖ = 1 → + (ruminConstant : ℝ≥0∞) * (q : ℝ≥0∞) ^ (-(2 : ℝ) / 3) * + (∫⁻ x : Position, density ψ x ^ ((5 : ℝ) / 3)) ≤ kineticEnergy ψ) + (q : ℕ) (hq : 1 ≤ q) (Z : ℝ≥0) : + ∃ C : ℝ≥0, 0 < C ∧ + ∀ (N M : ℕ) (z : Fin M → ℝ≥0) (R : Fin M → Position) (ψ : State N q), + (∀ k, z k ≤ Z) → antisymmetric ψ → ‖ψ‖ = 1 → + (∫⁻ x : Configuration N, attraction z R x * (‖ψ x‖₊ : ℝ≥0∞) ^ 2) ≤ + kineticEnergy ψ + + (∫⁻ x : Configuration N, electronRepulsion x * (‖ψ x‖₊ : ℝ≥0∞) ^ 2) + + nuclearRepulsion z R + (C : ℝ≥0∞) * (N + M : ℕ) := by + let κ : ℝ := (ruminConstant : ℝ) * (q : ℝ) ^ (-(2 : ℝ) / 3) + let a : ℝ := 2 * (Z : ℝ) + 1 + let b : ℝ := (2 / 5 : ℝ) * (3 / 5 : ℝ) ^ ((3 : ℝ) / 2) + let c : ℝ := max 1 (8 * Real.pi * b) * (a ^ 2 / κ) + have hκ : 0 < κ := kinetic_coefficient_pos q hq + have ha : 0 < a := add_pos_of_nonneg_of_pos (mul_nonneg (by norm_num) Z.coe_nonneg) + zero_lt_one + have hf : 0 < a ^ 2 / κ := div_pos (pow_pos ha 2) hκ + have hc : 0 < c := mul_pos ((zero_lt_one : (0 : ℝ) < 1).trans_le (le_max_left _ _)) hf + refine ⟨Real.toNNReal c, Real.toNNReal_pos.mpr hc, ?_⟩ + intro N M z R ψ hz hanti hnorm + have hscreen := screening_of_lt hLT q hq Z N M R ψ hanti hnorm + have hcoef : ENNReal.ofReal a = 2 * (Z : ℝ≥0∞) + 1 := by + rw [ENNReal.ofReal_add (mul_nonneg (by norm_num) Z.coe_nonneg) (by norm_num), + ENNReal.ofReal_mul (by norm_num), ENNReal.ofReal_ofNat, + ENNReal.ofReal_coe_nnreal, ENNReal.ofReal_one] + change ENNReal.ofReal a * + (∫⁻ x : Position, (nearestNucleusDistance R x)⁻¹ * density ψ x) ≤ + kineticEnergy ψ + ENNReal.ofReal ((a ^ 2 / κ) * ((N : ℝ) + + 8 * Real.pi * b * (M : ℝ))) at hscreen + rw [hcoef] at hscreen + have hcost : ENNReal.ofReal ((a ^ 2 / κ) * ((N : ℝ) + + 8 * Real.pi * b * (M : ℝ))) ≤ + (Real.toNNReal c : ℝ≥0∞) * (N + M : ℕ) := by + calc + _ ≤ ENNReal.ofReal (c * ((N : ℝ) + (M : ℝ))) := + ENNReal.ofReal_le_ofReal (cost_le_uniform (8 * Real.pi * b) (a ^ 2 / κ) hf.le N M) + _ = _ := by + rw [ENNReal.ofReal_mul hc.le] + congr 1 + simp only [← Nat.cast_add, ENNReal.ofReal_natCast] + have hbax := integratedBaxter_of_baxter hB Z z R ψ hz hnorm + calc + _ ≤ _ := hbax + _ ≤ (∫⁻ x : Configuration N, electronRepulsion x * (‖ψ x‖₊ : ℝ≥0∞) ^ 2) + + nuclearRepulsion z R + (kineticEnergy ψ + + (Real.toNNReal c : ℝ≥0∞) * (N + M : ℕ)) := + add_le_add le_rfl (hscreen.trans (add_le_add le_rfl hcost)) + _ = _ := by ac_rfl + +end LiebThirring.Assembly + +end diff --git a/LeanPool/LiebThirring/Assembly/WeakBaxter.lean b/LeanPool/LiebThirring/Assembly/WeakBaxter.lean new file mode 100644 index 0000000000..461e8e6b03 --- /dev/null +++ b/LeanPool/LiebThirring/Assembly/WeakBaxter.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Assembly.Coulomb +public import LeanPool.LiebThirring.Assembly.NuclearReindex +public import LeanPool.LiebThirring.Assembly.FiniteAveraging + +/-! +# Conditional bounded-charge Baxter inequality + +Weak Baxter for arbitrary bounded nonnegative charges, conditional only on the exact +equal-charge Baxter proposition. +-/ + +public section + +open scoped ENNReal NNReal + +namespace LiebThirring.Assembly + +private theorem vertex_baxter + (hB : ∀ (N M : ℕ) (Z : ℝ≥0) (R : Fin M → Position) (x : Configuration N), + attraction (fun _ => Z) R x + baxterCorrection Z R ≤ + electronRepulsion x + nuclearRepulsion (fun _ => Z) R + + nearestNucleusControl Z R x) + (N M : ℕ) (Z : ℝ≥0) (R : Fin M → Position) (x : Configuration N) + (v : Fin M → Bool) : + attraction (fun k => if v k then Z else 0) R x ≤ + electronRepulsion x + nuclearRepulsion (fun k => if v k then Z else 0) R + + nearestNucleusControl Z R x := by + classical + let I : Set (Fin M) := {k | v k = true} + let e : Fin (Fintype.card I) ≃ I := (Fintype.equivFin I).symm + have hz (k : Fin M) (hk : k ∉ I) : (if v k then Z else 0) = 0 := by + exact ite_eq_right hk + have he (j : Fin (Fintype.card I)) : (if v (e j).val then Z else 0) = Z := + ite_eq_left (e j).property + rw [attraction_restrict I e _ _ _ hz, nuclearRepulsion_reindex_support I e _ _ hz] + simp_rw [he] + calc + _ ≤ attraction (fun _ => Z) (fun j => R (e j).val) x + + baxterCorrection Z (fun j => R (e j).val) := le_self_add + _ ≤ _ := hB N (Fintype.card I) Z (fun j => R (e j).val) x + _ ≤ _ := add_le_add le_rfl + (nearestNucleusControl_restrict_le Z R (fun j => (e j).val) x) + +private theorem averaged_attraction {N M : ℕ} (w : Fin M → Bool → ℝ≥0∞) + (c : Fin M → Bool → ℝ≥0) (z : Fin M → ℝ≥0) (R : Fin M → Position) + (x : Configuration N) (hw : ∀ k, ∑ b, w k b = 1) + (hc : ∀ k, ∑ b, w k b * (c k b : ℝ≥0∞) = (z k : ℝ≥0∞)) : + (∑ v : Fin M → Bool, (∏ k, w k (v k)) * attraction (fun k => c k (v k)) R x) = + attraction z R x := by + classical + unfold attraction + simp_rw [Finset.mul_sum] + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro i _ + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro k _ + simp_rw [← mul_assoc] + rw [← Finset.sum_mul] + exact congrArg (fun a => a * coulombKernel (particlePosition x i) (R k)) + ((sum_product_weights_first w (fun k b => (c k b : ℝ≥0∞)) hw k).trans (hc k)) + +private theorem averaged_nuclearRepulsion {M : ℕ} (w : Fin M → Bool → ℝ≥0∞) + (c : Fin M → Bool → ℝ≥0) (z : Fin M → ℝ≥0) (R : Fin M → Position) + (hw : ∀ k, ∑ b, w k b = 1) + (hc : ∀ k, ∑ b, w k b * (c k b : ℝ≥0∞) = (z k : ℝ≥0∞)) : + (∑ v : Fin M → Bool, (∏ k, w k (v k)) * nuclearRepulsion (fun k => c k (v k)) R) = + nuclearRepulsion z R := by + classical + unfold nuclearRepulsion + simp_rw [Finset.mul_sum] + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro k _ + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro l hl + have hkl : k ≠ l := (Finset.mem_filter.mp hl).2.ne + simp_rw [← mul_assoc] + rw [← Finset.sum_mul] + have hs := sum_product_weights_second w (fun k b => (c k b : ℝ≥0∞)) hw k l hkl + have hs' : (∑ v : Fin M → Bool, (∏ k, w k (v k)) * + (c k (v k) : ℝ≥0∞) * (c l (v l) : ℝ≥0∞)) = + (∑ b, w k b * (c k b : ℝ≥0∞)) * (∑ b, w l b * (c l b : ℝ≥0∞)) := by + simpa only [mul_assoc] using hs + rw [hs', hc, hc] + +/-- Weak Baxter for arbitrary bounded nonnegative charges, conditional only on +the exact equal-charge Baxter proposition. -/ +theorem weakBaxter_of_baxter + (hB : ∀ (N M : ℕ) (Z : ℝ≥0) (R : Fin M → Position) (x : Configuration N), + attraction (fun _ => Z) R x + baxterCorrection Z R ≤ + electronRepulsion x + nuclearRepulsion (fun _ => Z) R + + nearestNucleusControl Z R x) + (N M : ℕ) (Z : ℝ≥0) (z : Fin M → ℝ≥0) (R : Fin M → Position) + (x : Configuration N) (hz : ∀ k, z k ≤ Z) : + attraction z R x ≤ electronRepulsion x + nuclearRepulsion z R + + nearestNucleusControl Z R x := by + classical + by_cases hZ : Z = 0 + · have hz0 : z = fun _ => 0 := funext (fun k => le_zero_iff.mp (hZ ▸ hz k)) + rw [hz0, attraction_zero] + exact zero_le + let t : Fin M → ℝ≥0 := fun k => z k / Z + have ht (k : Fin M) : t k ≤ 1 := (div_le_one (pos_iff_ne_zero.mpr hZ)).mpr (hz k) + let w : Fin M → Bool → ℝ≥0∞ := fun k b => if b then (t k : ℝ≥0∞) else (1 - t k : ℝ≥0) + let c : Fin M → Bool → ℝ≥0 := fun _ b => if b then Z else 0 + have hw (k : Fin M) : ∑ b, w k b = 1 := by + simp only [w, Fintype.sum_bool, Bool.false_eq_true, ite_false, ite_true] + rw [← ENNReal.coe_add, add_tsub_cancel_of_le (ht k), ENNReal.coe_one] + have hc (k : Fin M) : ∑ b, w k b * (c k b : ℝ≥0∞) = (z k : ℝ≥0∞) := by + simp only [w, c, Fintype.sum_bool, Bool.false_eq_true, ite_false, ite_true, + ENNReal.coe_zero, mul_zero, add_zero, ← ENNReal.coe_mul] + exact congrArg (fun a : ℝ≥0 => (a : ℝ≥0∞)) (div_mul_cancel₀ (z k) hZ) + have hav := Finset.sum_le_sum (s := Finset.univ) (fun v _ => + mul_le_mul_right (vertex_baxter hB N M Z R x v) (∏ k, w k (v k))) + change (∑ v : Fin M → Bool, (∏ k, w k (v k)) * attraction (fun k => c k (v k)) R x) ≤ + ∑ v : Fin M → Bool, (∏ k, w k (v k)) * + (electronRepulsion x + nuclearRepulsion (fun k => c k (v k)) R + + nearestNucleusControl Z R x) at hav + simp_rw [mul_add, Finset.sum_add_distrib] at hav + rw [averaged_attraction w c z R x hw hc, averaged_nuclearRepulsion w c z R hw hc, + ← Finset.sum_mul, ← Finset.sum_mul, sum_product_weights w hw, one_mul, one_mul] at hav + exact hav + +end LiebThirring.Assembly + +end diff --git a/LeanPool/LiebThirring/Assembly/Young.lean b/LeanPool/LiebThirring/Assembly/Young.lean new file mode 100644 index 0000000000..b157b487c6 --- /dev/null +++ b/LeanPool/LiebThirring/Assembly/Young.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.SpecialFunctions.Pow.NNReal +import Mathlib.Analysis.MeanInequalities +import Mathlib.Tactic.Positivity + +/-! +# Extended Young inequality for screening + +Positivity of the finite screening coefficient in extended Young. + +The exact additive extended Young bound of extended Young. +-/ + +public section + +open scoped ENNReal + +namespace LiebThirring.Assembly + +private theorem young_first_coefficient (κ : ℝ) (hκ : 0 < κ) : + ((5 * κ / 3) ^ ((3 : ℝ) / 5)) ^ ((5 : ℝ) / 3) / ((5 : ℝ) / 3) = κ := by + have hbase : 0 ≤ 5 * κ / 3 := by positivity + rw [← Real.rpow_mul hbase] + norm_num + ring + +private theorem young_second_coefficient (κ : ℝ) (hκ : 0 < κ) : + (((5 * κ / 3) ^ ((3 : ℝ) / 5))⁻¹) ^ ((5 : ℝ) / 2) / ((5 : ℝ) / 2) = + (2 / 5 : ℝ) * (3 / 5 : ℝ) ^ ((3 : ℝ) / 2) * κ ^ (-(3 : ℝ) / 2) := by + have hbase : 0 ≤ 5 * κ / 3 := by positivity + have hc : 0 ≤ (5 * κ / 3) ^ ((3 : ℝ) / 5) := Real.rpow_nonneg hbase _ + rw [Real.inv_rpow hc, ← Real.rpow_mul hbase, ← Real.rpow_neg hbase] + norm_num + have he : (5 * κ / 3 : ℝ) = (5 / 3 : ℝ) * κ := by ring + rw [he, Real.mul_rpow (by norm_num) hκ.le] + rw [Real.rpow_neg_eq_inv_rpow] + norm_num + ring + +/-- Positivity of the finite screening coefficient in extended Young. -/ +theorem young_screening_coefficient_pos (κ : ℝ) (hκ : 0 < κ) : + 0 < (2 / 5 : ℝ) * (3 / 5 : ℝ) ^ ((3 : ℝ) / 2) * κ ^ (-(3 : ℝ) / 2) := by + exact mul_pos (mul_pos (by norm_num) (Real.rpow_pos_of_pos (by norm_num) _)) + (Real.rpow_pos_of_pos hκ _) + +/-- The exact additive extended Young bound of extended Young. -/ +theorem young_screening (κ : ℝ) (hκ : 0 < κ) (w t : ℝ≥0∞) : + w * t ≤ ENNReal.ofReal κ * t ^ ((5 : ℝ) / 3) + + ENNReal.ofReal ((2 / 5 : ℝ) * (3 / 5 : ℝ) ^ ((3 : ℝ) / 2) * + κ ^ (-(3 : ℝ) / 2)) * w ^ ((5 : ℝ) / 2) := by + let c : ℝ := (5 * κ / 3) ^ ((3 : ℝ) / 5) + have hc : 0 < c := Real.rpow_pos_of_pos (by positivity) _ + have hc0 : ENNReal.ofReal c ≠ 0 := (ENNReal.ofReal_pos.mpr hc).ne' + have hcinv : 0 < c⁻¹ := inv_pos.mpr hc + have hpq : ((5 : ℝ) / 3).HolderConjugate ((5 : ℝ) / 2) := by + rw [Real.holderConjugate_iff] + norm_num + have hy := ENNReal.young_inequality (ENNReal.ofReal c * t) + ((ENNReal.ofReal c)⁻¹ * w) hpq + have hleft : (ENNReal.ofReal c * t) * ((ENNReal.ofReal c)⁻¹ * w) = w * t := by + calc + _ = (ENNReal.ofReal c * (ENNReal.ofReal c)⁻¹) * (w * t) := by ac_rfl + _ = w * t := by rw [ENNReal.mul_inv_cancel hc0 ENNReal.ofReal_ne_top, one_mul] + rw [hleft, ENNReal.mul_rpow_of_nonneg _ _ (by norm_num), + ENNReal.mul_rpow_of_nonneg _ _ (by norm_num)] at hy + have hfirst : (ENNReal.ofReal c) ^ ((5 : ℝ) / 3) / ENNReal.ofReal ((5 : ℝ) / 3) = + ENNReal.ofReal κ := by + rw [ENNReal.ofReal_rpow_of_pos hc, ← ENNReal.ofReal_div_of_pos (by norm_num)] + exact congrArg ENNReal.ofReal (young_first_coefficient κ hκ) + have hsecond : ((ENNReal.ofReal c)⁻¹) ^ ((5 : ℝ) / 2) / + ENNReal.ofReal ((5 : ℝ) / 2) = + ENNReal.ofReal ((2 / 5 : ℝ) * (3 / 5 : ℝ) ^ ((3 : ℝ) / 2) * + κ ^ (-(3 : ℝ) / 2)) := by + rw [← ENNReal.ofReal_inv_of_pos hc, ENNReal.ofReal_rpow_of_pos hcinv, + ← ENNReal.ofReal_div_of_pos (by norm_num)] + exact congrArg ENNReal.ofReal (young_second_coefficient κ hκ) + rw [ENNReal.mul_div_right_comm, ENNReal.mul_div_right_comm, hfirst, hsecond] at hy + exact hy + +end LiebThirring.Assembly + +end diff --git a/LeanPool/LiebThirring/Defs/Antisymmetric.lean b/LeanPool/LiebThirring/Defs/Antisymmetric.lean new file mode 100644 index 0000000000..d0e41b434f --- /dev/null +++ b/LeanPool/LiebThirring/Defs/Antisymmetric.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.State +public import Mathlib.GroupTheory.Perm.Sign + +/-! +# Antisymmetric states + +Simultaneous spatial and spin permutation with the fermionic sign. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- Fermionic sign under simultaneous permutation of spatial and spin coordinates. -/ +@[expose] def antisymmetric {N q : ℕ} (ψ : State N q) : Prop := + ∀ σ : Equiv.Perm (Fin N), ∀ᵐ x ∂(volume : Measure (Configuration N)), + ∀ s : SpinLabels N q, + ψ (permutePositions σ x) (permuteSpins σ s) = + (((Equiv.Perm.sign σ : ℤˣ) : ℤ) : ℂ) * ψ x s + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Defs/Configuration.lean b/LeanPool/LiebThirring/Defs/Configuration.lean new file mode 100644 index 0000000000..ab4b3678f4 --- /dev/null +++ b/LeanPool/LiebThirring/Defs/Configuration.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.InnerProductSpace.PiL2 +public import Mathlib.MeasureTheory.Measure.Haar.InnerProductSpace +public import Mathlib.Data.Fin.Basic + +/-! +# Spatial particle configurations + +Euclidean spatial configurations, coordinate insertion and particle permutations. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- Three-dimensional Euclidean physical space. -/ +@[expose] def Position : Type := + EuclideanSpace ℝ (Fin 3) + +attribute [reducible] Position + +/-- Euclidean spatial coordinates of all particles. -/ +@[expose] def Configuration (N : ℕ) : Type := + EuclideanSpace ℝ (Fin N × Fin 3) + +attribute [reducible] Configuration + +/-- The spatial position of the selected particle. -/ +@[expose] def particlePosition {N : ℕ} (x : Configuration N) (i : Fin N) : Position := + toLp 2 (fun a => x (i, a)) + +/-- Relabel the spatial coordinates by a permutation of the particles. -/ +@[expose] def permutePositions {N : ℕ} (σ : Equiv.Perm (Fin N)) + (x : Configuration N) : Configuration N := + toLp 2 (fun ia => x (σ ia.1, ia.2)) + +/-- Spatial coordinates of the particles other than the selected particle. -/ +@[expose] def OtherConfiguration {N : ℕ} (i : Fin N) : Type := + EuclideanSpace ℝ ({j : Fin N // j ≠ i} × Fin 3) + +attribute [reducible] OtherConfiguration + +/-- Fill the selected spatial coordinate while retaining all other particle coordinates. -/ +@[expose] def insertParticle {N : ℕ} (i : Fin N) (x : Position) + (y : OtherConfiguration i) : Configuration N := + toLp 2 (fun ja => if h : ja.1 = i then x ja.2 else y (⟨ja.1, h⟩, ja.2)) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Defs/Coulomb.lean b/LeanPool/LiebThirring/Defs/Coulomb.lean new file mode 100644 index 0000000000..77e9a457f4 --- /dev/null +++ b/LeanPool/LiebThirring/Defs/Coulomb.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.Configuration + +/-! +# Coulomb interactions + +Electron and nuclear interactions, nearest-nucleus distances, and the electrostatic correction +in Baxter’s inequality. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- Nonnegative Coulomb interaction, with infinite value at a collision. -/ +@[expose] noncomputable def coulombKernel (x y : Position) : ℝ≥0∞ := + (ENNReal.ofReal ‖x - y‖)⁻¹ + +/-- Sum the Coulomb interactions over each unordered pair of electrons. -/ +@[expose] noncomputable def electronRepulsion {N : ℕ} (x : Configuration N) : ℝ≥0∞ := + ∑ i : Fin N, ∑ j ∈ Finset.univ.filter (fun j : Fin N => i < j), + coulombKernel (particlePosition x i) (particlePosition x j) + +/-- Sum electron–nucleus Coulomb interactions weighted by the nuclear charges. -/ +@[expose] noncomputable def attraction {N M : ℕ} (z : Fin M → ℝ≥0) + (R : Fin M → Position) (x : Configuration N) : ℝ≥0∞ := + ∑ i : Fin N, ∑ k : Fin M, + (z k : ℝ≥0∞) * coulombKernel (particlePosition x i) (R k) + +/-- Sum the charge-weighted Coulomb interactions over unordered pairs of nuclei. -/ +@[expose] noncomputable def nuclearRepulsion {M : ℕ} (z : Fin M → ℝ≥0) + (R : Fin M → Position) : ℝ≥0∞ := + ∑ k : Fin M, ∑ l ∈ Finset.univ.filter (fun l : Fin M => k < l), + ((z k : ℝ≥0∞) * (z l : ℝ≥0∞)) * coulombKernel (R k) (R l) + +/-- The nearest nuclear distance, with infinite value when there are no nuclei. -/ +@[expose] noncomputable def nearestNucleusDistance {M : ℕ} + (R : Fin M → Position) (x : Position) : ℝ≥0∞ := + ⨅ k : Fin M, ENNReal.ofReal ‖x - R k‖ + +/-- The nearest distance to another nucleus, with infinite value for a single nucleus. -/ +@[expose] noncomputable def nearestOtherNucleusDistance {M : ℕ} + (R : Fin M → Position) (k : Fin M) : ℝ≥0∞ := + ⨅ l : {l : Fin M // l ≠ k}, ENNReal.ofReal ‖R k - R l‖ + +/-- Nearest-nucleus inverse-distance control with the electrostatic screening coefficient. -/ +@[expose] noncomputable def nearestNucleusControl {N M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (x : Configuration N) : ℝ≥0∞ := + (2 * (Z : ℝ≥0∞) + 1) * + ∑ i : Fin N, (nearestNucleusDistance R (particlePosition x i))⁻¹ + +/-- The positive nearest-other-nucleus correction in Baxter’s inequality. -/ +@[expose] noncomputable def baxterCorrection {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) : ℝ≥0∞ := + (Z : ℝ≥0∞) ^ 2 / 4 * ∑ k : Fin M, (nearestOtherNucleusDistance R k)⁻¹ + +/-- An off-diagonal symmetric finite sum counts each upper-triangular term twice. -/ +theorem sum_ne_eq_two_sum_lt {α : Type*} [Fintype α] [LinearOrder α] + (f : α → α → ℝ≥0∞) (hf : ∀ i j, f i j = f j i) : + (∑ i, ∑ j, if i ≠ j then f i j else 0) = + 2 * ∑ i, ∑ j ∈ Finset.univ.filter (fun j => i < j), f i j := by + have hs (i j : α) : (if i ≠ j then f i j else 0) = + (if i < j then f i j else 0) + (if j < i then f j i else 0) := by + rcases lt_trichotomy i j with h | h | h + · simp only [h.ne, ne_eq, not_false_eq_true, ite_true, h, ite_false, + not_lt.mpr h.le, add_zero] + · subst j + simp only [ne_eq, not_true_eq_false, ite_false, lt_self_iff_false, add_zero] + · simp only [h.ne', ne_eq, not_false_eq_true, ite_true, h, ite_false, + not_lt.mpr h.le, zero_add, hf i j] + simp_rw [hs, Finset.sum_add_distrib] + rw [Finset.sum_comm (f := fun i j => if j < i then f j i else 0)] + simp only [Finset.sum_filter, two_mul] + +/-- A symmetric finite sum is its diagonal plus twice the upper triangle. -/ +theorem sum_eq_diag_add_two_sum_lt {α : Type*} [Fintype α] [LinearOrder α] + (f : α → α → ℝ≥0∞) (hf : ∀ i j, f i j = f j i) : + (∑ i, ∑ j, f i j) = + (∑ i, f i i) + 2 * ∑ i, ∑ j ∈ Finset.univ.filter (fun j => i < j), f i j := by + classical + calc + (∑ i, ∑ j, f i j) = + (∑ i, f i i) + ∑ i, ∑ j, if i ≠ j then f i j else 0 := by + have hsplit (i j : α) : f i j = + (if j = i then f i i else 0) + (if i ≠ j then f i j else 0) := by + by_cases h : j = i + · subst j + simp + · have h' : i ≠ j := fun hij => h hij.symm + simp [h, h'] + conv_lhs => arg 2; ext i; arg 2; ext j; rw [hsplit i j] + simp only [Finset.sum_add_distrib] + simp + _ = (∑ i, f i i) + 2 * ∑ i, ∑ j ∈ Finset.univ.filter (fun j => i < j), f i j := by + rw [sum_ne_eq_two_sum_lt f hf] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Defs/Density.lean b/LeanPool/LiebThirring/Defs/Density.lean new file mode 100644 index 0000000000..f344e057f6 --- /dev/null +++ b/LeanPool/LiebThirring/Defs/Density.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.State + +/-! +# One-particle density + +The spatial density obtained by integrating out all other particle coordinates and summing over +particles. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- One-particle density obtained by integrating out the remaining spatial coordinates. -/ +@[expose] noncomputable def density {N q : ℕ} (ψ : State N q) (x : Position) : ℝ≥0∞ := + ∑ i : Fin N, ∫⁻ y : OtherConfiguration i, + (‖ψ (insertParticle i x y)‖₊ : ℝ≥0∞) ^ 2 + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Defs/KineticEnergy.lean b/LeanPool/LiebThirring/Defs/KineticEnergy.lean new file mode 100644 index 0000000000..4a71ae6c48 --- /dev/null +++ b/LeanPool/LiebThirring/Defs/KineticEnergy.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.State + +/-! +# Kinetic energy + +The nonnegative extended Fourier quadratic form with the physical kinetic normalization. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- Nonnegative Fourier quadratic form with the physical minus-Laplacian normalization. -/ +@[expose] noncomputable def kineticEnergy {N q : ℕ} (ψ : State N q) : ℝ≥0∞ := + ∫⁻ ξ : Configuration N, + ENNReal.ofReal ((2 * Real.pi) ^ 2) * (‖ξ‖₊ : ℝ≥0∞) ^ 2 * + (‖(Lp.fourierTransformₗᵢ (Configuration N) (SpinAmplitudes N q) ψ) ξ‖₊ : ℝ≥0∞) ^ 2 + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Defs/RuminConstant.lean b/LeanPool/LiebThirring/Defs/RuminConstant.lean new file mode 100644 index 0000000000..3107f8388a --- /dev/null +++ b/LeanPool/LiebThirring/Defs/RuminConstant.lean @@ -0,0 +1,32 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.SpecialFunctions.Pow.Real +public import Mathlib.Analysis.SpecialFunctions.Trigonometric.Basic + +/-! +# Rumin’s constant + +The explicit three-dimensional coefficient in the kinetic Lieb–Thirring inequality. +-/ + +public section + +open scoped NNReal + +namespace LiebThirring + +/-- The explicit three-dimensional kinetic coefficient obtained from Rumin’s argument. -/ +@[expose] noncomputable def ruminConstant : ℝ≥0 := + Real.toNNReal ((9 / 35 : ℝ) * (6 * Real.pi ^ 2) ^ ((2 : ℝ) / 3)) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Defs/State.lean b/LeanPool/LiebThirring/Defs/State.lean new file mode 100644 index 0000000000..58c3f34d08 --- /dev/null +++ b/LeanPool/LiebThirring/Defs/State.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.Configuration +public import Mathlib.Analysis.Fourier.LpSpace + +/-! +# Spin-valued quantum states + +The spin and L² carriers are separated from spatial geometry so that electrostatic modules +do not import Fourier theory merely to use positions and configurations. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- Assignments of one of the available spin labels to each particle. -/ +@[expose] def SpinLabels (N q : ℕ) : Type := + Fin N → Fin q + +attribute [reducible] SpinLabels + +/-- Complex amplitudes for every spin assignment, with the Euclidean norm. -/ +@[expose] def SpinAmplitudes (N q : ℕ) : Type := + EuclideanSpace ℂ (SpinLabels N q) + +attribute [reducible] SpinAmplitudes + +/-- Square-integrable spin-valued wavefunctions on the spatial configuration space. -/ +@[expose] def State (N q : ℕ) : Type := + Lp (SpinAmplitudes N q) 2 (volume : Measure (Configuration N)) + +attribute [reducible] State + +/-- Relabel spin assignments by the same particle permutation. -/ +@[expose] def permuteSpins {N q : ℕ} (σ : Equiv.Perm (Fin N)) + (s : SpinLabels N q) : SpinLabels N q := + fun i => s (σ i) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/Basic.lean b/LeanPool/LiebThirring/Electrostatics/Basic.lean new file mode 100644 index 0000000000..f95094c2a8 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/Basic.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.Coulomb + +/-! +# Coulomb potentials and energies of positive measures + +The Coulomb potential `Φ_α(x) = ∫ |x - y|⁻¹ dα(y)` of a positive measure, in `ℝ≥0∞`. + +The mutual Coulomb energy `I(α, β) = double integral |x - y|⁻¹ dα(x) dβ(y)` of positive measures, +in `ℝ≥0∞` +(no factor `1/2`). +-/ + +public section + +open MeasureTheory +open scoped ENNReal + +namespace LiebThirring + +/-- The Coulomb potential `Φ_α(x) = ∫ |x - y|⁻¹ dα(y)` of a positive measure, in `ℝ≥0∞`. -/ +noncomputable def coulombPotential (α : Measure Position) (x : Position) : ℝ≥0∞ := + ∫⁻ y, coulombKernel x y ∂α + +/-- The mutual Coulomb energy `I(α, β) = double integral |x - y|⁻¹ dα(x) dβ(y)` of positive +measures, +in `ℝ≥0∞` (no factor `1/2`). -/ +noncomputable def coulombEnergy (α β : Measure Position) : ℝ≥0∞ := + ∫⁻ x, coulombPotential β x ∂α + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/Collisions.lean b/LeanPool/LiebThirring/Electrostatics/Collisions.lean new file mode 100644 index 0000000000..d8e5cea0e9 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/Collisions.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.ShellAssembly + +/-! +# Baxter's additive inequality at collisions and empty configurations + +Meeting a nucleus makes the nearest-nucleus distance zero. + +An electron-nucleus collision makes the control infinite, including at zero charge. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- Meeting a nucleus makes the nearest-nucleus distance zero. -/ +theorem nearestNucleusDistance_eq_zero_of_eq {M : ℕ} (R : Fin M → Position) + (a : Position) (k : Fin M) (ha : a = R k) : + nearestNucleusDistance R a = 0 := by + apply le_antisymm ?_ zero_le + calc + nearestNucleusDistance R a ≤ ENNReal.ofReal ‖a - R k‖ := iInf_le _ k + _ = 0 := by rw [ha, sub_self, norm_zero, ENNReal.ofReal_zero] + +/-- An electron-nucleus collision makes the control infinite, including at zero charge. -/ +theorem nearestNucleusControl_eq_top_of_collision {N M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (x : Configuration N) (i : Fin N) (k : Fin M) + (hx : particlePosition x i = R k) : nearestNucleusControl Z R x = ⊤ := by + unfold nearestNucleusControl + have hs : (∑ j : Fin N, (nearestNucleusDistance R (particlePosition x j))⁻¹) = ⊤ := by + apply ENNReal.sum_eq_top.mpr + exact ⟨i, Finset.mem_univ _, by rw [nearestNucleusDistance_eq_zero_of_eq R _ k hx, + ENNReal.inv_zero]⟩ + rw [hs, ENNReal.mul_top] + exact ne_of_gt (by positivity) + +/-- A collision of two positive equally charged nuclei makes nuclear repulsion infinite. -/ +theorem nuclearRepulsion_eq_top_of_collision {M : ℕ} (Z : ℝ≥0) (hZ : Z ≠ 0) + (R : Fin M → Position) (k l : Fin M) (hkl : k < l) (hR : R k = R l) : + nuclearRepulsion (fun _ => Z) R = ⊤ := by + unfold nuclearRepulsion + apply ENNReal.sum_eq_top.mpr + refine ⟨k, Finset.mem_univ _, ENNReal.sum_eq_top.mpr ?_⟩ + refine ⟨l, Finset.mem_filter.mpr ⟨Finset.mem_univ _, hkl⟩, ?_⟩ + rw [coulombKernel, hR, sub_self, norm_zero, ENNReal.ofReal_zero, ENNReal.inv_zero, + ENNReal.mul_top] + exact mul_ne_zero (ENNReal.coe_ne_zero.mpr hZ) (ENNReal.coe_ne_zero.mpr hZ) + +/-- Zero charge annihilates attraction and correction even at collisions. -/ +theorem baxter_zero_charge (N M : ℕ) (R : Fin M → Position) (x : Configuration N) : + attraction (fun _ => (0 : ℝ≥0)) R x + baxterCorrection 0 R ≤ + electronRepulsion x + nuclearRepulsion (fun _ => 0) R + nearestNucleusControl 0 R x := by + simp only [attraction, baxterCorrection, ENNReal.coe_zero, zero_mul, + Finset.sum_const_zero, zero_pow (by norm_num : 2 ≠ 0), ENNReal.zero_div, zero_add] + exact zero_le + +/-- With no nuclei, attraction and correction are empty sums. -/ +theorem baxter_no_nuclei (N : ℕ) (Z : ℝ≥0) (R : Fin 0 → Position) + (x : Configuration N) : + attraction (fun _ => Z) R x + baxterCorrection Z R ≤ + electronRepulsion x + nuclearRepulsion (fun _ => Z) R + nearestNucleusControl Z R x := by + simp only [attraction, baxterCorrection, Finset.univ_eq_empty, Finset.sum_empty, + Finset.sum_const_zero, mul_zero, zero_add] + exact zero_le + +/-- The exact Baxter conclusion from the basic electrostatic inequality, for every endpoint and +collision case. -/ +theorem baxter_of_basicElectrostaticInequality + (hB12 : ∀ (M : ℕ) (Z : ℝ≥0) (R : Fin M → Position), 1 ≤ M → + Function.Injective R → BasicElectrostaticInequality Z R) + (N M : ℕ) (Z : ℝ≥0) (R : Fin M → Position) (x : Configuration N) : + attraction (fun _ => Z) R x + baxterCorrection Z R ≤ + electronRepulsion x + nuclearRepulsion (fun _ => Z) R + + nearestNucleusControl Z R x := by + classical + by_cases hZ : Z = 0 + · subst Z + exact baxter_zero_charge N M R x + by_cases hM : M = 0 + · subst M + exact baxter_no_nuclei N Z R x + by_cases hR : Function.Injective R + · by_cases hx : ∀ i k, particlePosition x i ≠ R k + · exact baxter_of_basicElectrostaticInequality_of_separated Z R x + (Nat.one_le_iff_ne_zero.mpr hM) (hB12 M Z R (Nat.one_le_iff_ne_zero.mpr hM) hR) hx + · push Not at hx + obtain ⟨i, k, hx⟩ := hx + rw [nearestNucleusControl_eq_top_of_collision Z R x i k hx, add_top] + exact le_top + · obtain ⟨k, l, heq, hne⟩ := Function.not_injective_iff.mp hR + rcases lt_or_gt_of_ne hne with hkl | hlk + · rw [nuclearRepulsion_eq_top_of_collision Z hZ R k l hkl heq, add_top, top_add] + exact le_top + · rw [nuclearRepulsion_eq_top_of_collision Z hZ R l k hlk heq.symm, add_top, top_add] + exact le_top + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/CoulombPositivity.lean b/LeanPool/LiebThirring/Electrostatics/CoulombPositivity.lean new file mode 100644 index 0000000000..db9fb2c1dd --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/CoulombPositivity.lean @@ -0,0 +1,127 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.Basic +public import LeanPool.LiebThirring.Electrostatics.Gaussian +public import LeanPool.LiebThirring.Electrostatics.CoulombPositivityKernel +import all LeanPool.LiebThirring.Electrostatics.Basic + +/-! +# Coulomb symmetry and positivity + +The defining iterated integral, exposed without changing the shared definitions. + +Symmetry by Tonelli; no energy-finiteness assumption is needed. +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal + +namespace LiebThirring + +/-- The defining iterated integral, exposed without changing the shared definitions. -/ +theorem coulombEnergy_eq_lintegral (α β : Measure Position) : + coulombEnergy α β = ∫⁻ x, ∫⁻ y, coulombKernel x y ∂β ∂α := by + rfl + +/-- Symmetry by Tonelli; no energy-finiteness assumption is needed. -/ +theorem coulombEnergy_symm (α β : Measure Position) [SFinite α] [SFinite β] : + coulombEnergy α β = coulombEnergy β α := by + rw [coulombEnergy_eq_lintegral, coulombEnergy_eq_lintegral, + lintegral_lintegral_swap measurable_coulombKernel.aemeasurable] + simp_rw [coulombKernel_symm] + +/-- The Gaussian feature used to represent the Coulomb kernel. -/ +@[expose] noncomputable def coulombFeature (x : Position) (u : ℝ × Position) : ℝ≥0∞ := + gaussianFeature (2 / Real.sqrt Real.pi) (u.1 ^ 2) x u.2 + +/-- The parameter-space measure for the Gaussian Coulomb representation. -/ +@[expose] noncomputable def coulombFeatureMeasure : Measure (ℝ × Position) := + (volume.restrict (Ioi 0)).prod volume + +/-- Joint measurability of the Coulomb feature. -/ +theorem measurable_coulombFeature : Measurable (Function.uncurry coulombFeature) := by + unfold coulombFeature gaussianFeature gaussianMass + fun_prop + +/-- The Coulomb kernel is an integral Gram kernel, including the diagonal. -/ +theorem coulombKernel_eq_lintegral_feature (x y : Position) : + coulombKernel x y = + ∫⁻ u, coulombFeature x u * coulombFeature y u ∂coulombFeatureMeasure := by + rw [coulombKernel_eq_lintegral_gaussian] + rw [coulombFeatureMeasure, lintegral_prod _ (by + exact ((measurable_coulombFeature.of_uncurry_left).mul + (measurable_coulombFeature.of_uncurry_left)).aemeasurable)] + apply lintegral_congr_ae + filter_upwards [ae_restrict_mem measurableSet_Ioi] with t ht + simpa only [coulombFeature, mul_comm (t ^ 2), neg_mul] using + (lintegral_gaussianFeature_mul (sq_pos_of_pos ht) (by positivity) x y).symm + +instance : SFinite coulombFeatureMeasure := by + unfold coulombFeatureMeasure + infer_instance + +/-- The nonnegative feature transform of a positive charge. -/ +@[expose] noncomputable def coulombTransform (α : Measure Position) (u : ℝ × Position) : ℝ≥0∞ := + ∫⁻ x, coulombFeature x u ∂α + +theorem measurable_coulombTransform (α : Measure Position) [SFinite α] : + Measurable (coulombTransform α) := + measurable_coulombFeature.lintegral_prod_left + +/-- Coulomb energies are integral Gram pairings of the feature transforms. -/ +theorem coulombEnergy_eq_lintegral_transform (α β : Measure Position) + [SFinite α] [SFinite β] : + coulombEnergy α β = ∫⁻ u, coulombTransform α u * coulombTransform β u + ∂coulombFeatureMeasure := by + rw [coulombEnergy_eq_lintegral] + simp_rw [coulombKernel_eq_lintegral_feature] + exact lintegral_gram_pairing α β coulombFeatureMeasure coulombFeature + measurable_coulombFeature + +/-- Extended Coulomb Cauchy–Schwarz. S-finiteness suffices, even when energies are infinite. -/ +theorem coulombEnergy_mul_self_le (α β : Measure Position) [SFinite α] [SFinite β] : + coulombEnergy α β ^ 2 ≤ coulombEnergy α α * coulombEnergy β β := by + simp only [coulombEnergy_eq_lintegral_transform, ← pow_two] + exact lintegral_mul_sq_le coulombFeatureMeasure (measurable_coulombTransform α) + (measurable_coulombTransform β) + +/-- Finite self-energies imply finite mutual energy, without circular Coulomb Fubini. -/ +theorem coulombEnergy_ne_top (α β : Measure Position) [SFinite α] [SFinite β] + (hα : coulombEnergy α α ≠ ⊤) (hβ : coulombEnergy β β ≠ ⊤) : + coulombEnergy α β ≠ ⊤ := by + have h := coulombEnergy_mul_self_le α β + intro htop + rw [htop] at h + norm_num at h + exact ENNReal.mul_ne_top hα hβ h + +/-- Positivity of the signed form for the difference of two finite-energy charges. -/ +theorem two_mul_coulombEnergy_le (α β : Measure Position) [SFinite α] [SFinite β] + (hα : coulombEnergy α α ≠ ⊤) (hβ : coulombEnergy β β ≠ ⊤) : + 2 * coulombEnergy α β ≤ coulombEnergy α α + coulombEnergy β β := by + have hm := coulombEnergy_ne_top α β hα hβ + apply (ENNReal.toReal_le_toReal (ENNReal.mul_ne_top (by norm_num) hm) + (ENNReal.add_ne_top.mpr ⟨hα, hβ⟩)).mp + simp only [ENNReal.toReal_mul, ENNReal.toReal_ofNat, ENNReal.toReal_add hα hβ] + have hcs := ENNReal.toReal_mono (ENNReal.mul_ne_top hα hβ) + (coulombEnergy_mul_self_le α β) + simp only [ENNReal.toReal_pow, ENNReal.toReal_mul] at hcs + have hnonneg := ENNReal.toReal_nonneg (a := coulombEnergy α β) + have hsquare := sq_nonneg ((coulombEnergy α α).toReal - (coulombEnergy β β).toReal) + have ha := ENNReal.toReal_nonneg (a := coulombEnergy α α) + have hb := ENNReal.toReal_nonneg (a := coulombEnergy β β) + nlinarith only [hcs, hnonneg, hsquare, ha, hb] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/CoulombPositivityKernel.lean b/LeanPool/LiebThirring/Electrostatics/CoulombPositivityKernel.lean new file mode 100644 index 0000000000..49534f8a7b --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/CoulombPositivityKernel.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.MeasureTheory.Integral.Bochner.Basic + +/-! +# Nonnegative integral Gram kernels + +Extended Cauchy–Schwarz, including zero and infinite diagonal integrals. + +The energy of an integral Gram kernel is itself an integral Gram pairing of potentials. +-/ + +public section + +open MeasureTheory +open scoped ENNReal + +namespace LiebThirring + +/-- Extended Cauchy–Schwarz, including zero and infinite diagonal integrals. -/ +theorem lintegral_mul_sq_le {Ω : Type*} [MeasurableSpace Ω] (ν : Measure Ω) + {f g : Ω → ℝ≥0∞} (hf : Measurable f) (hg : Measurable g) : + (∫⁻ z, f z * g z ∂ν) ^ 2 ≤ (∫⁻ z, f z ^ 2 ∂ν) * (∫⁻ z, g z ^ 2 ∂ν) := by + have hconj : (2 : ℝ).HolderConjugate 2 := + Real.holderConjugate_iff.mpr ⟨by norm_num, by norm_num⟩ + have h := ENNReal.lintegral_mul_le_Lp_mul_Lq ν hconj hf.aemeasurable hg.aemeasurable + have hsq := pow_le_pow_left' h 2 + have hroot (a : ℝ≥0∞) : (a ^ (1 / 2 : ℝ)) ^ 2 = a := by + rw [← ENNReal.rpow_two, ← ENNReal.rpow_mul] + norm_num + simpa only [Pi.mul_apply, ENNReal.rpow_two, mul_pow, hroot] using hsq + +/-- The energy of an integral Gram kernel is itself an integral Gram pairing of potentials. -/ +theorem lintegral_gram_pairing {X Ω : Type*} [MeasurableSpace X] [MeasurableSpace Ω] + (α β : Measure X) (ν : Measure Ω) [SFinite α] [SFinite β] [SFinite ν] + (f : X → Ω → ℝ≥0∞) (hf : Measurable (Function.uncurry f)) : + (∫⁻ x, ∫⁻ y, ∫⁻ z, f x z * f y z ∂ν ∂β ∂α) = + ∫⁻ z, (∫⁻ x, f x z ∂α) * (∫⁻ y, f y z ∂β) ∂ν := by + have hfx (x : X) : Measurable (f x) := hf.of_uncurry_left + have hxy (z : Ω) : Measurable (fun x : X => f x z) := hf.of_uncurry_right + have hinner (x : X) : + (∫⁻ y, ∫⁻ z, f x z * f y z ∂ν ∂β) = + ∫⁻ z, f x z * (∫⁻ y, f y z ∂β) ∂ν := by + rw [lintegral_lintegral_swap (by fun_prop)] + apply lintegral_congr + intro z + exact lintegral_const_mul _ (hxy z) + simp_rw [hinner] + rw [lintegral_lintegral_swap (by fun_prop)] + apply lintegral_congr + intro z + exact lintegral_mul_const _ (hxy z) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/EnergyDeficit.lean b/LeanPool/LiebThirring/Electrostatics/EnergyDeficit.lean new file mode 100644 index 0000000000..8e099a6539 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/EnergyDeficit.lean @@ -0,0 +1,107 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitBoundary +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitLowerBound +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitTrivial +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitFlux +import LeanPool.LiebThirring.Electrostatics.SlicingDivergence + +/-! +# Assembly of the energy deficit from the potential and exterior-flux identities + +The exterior flux identity, cutoff passage, geometric lower bound, and charge +coefficients combine with the screened-potential identity to give the energy deficit. +-/ + +public section + +open Set MeasureTheory +open scoped ENNReal NNReal ContDiff + +namespace LiebThirring + +/-- The exact exterior expression once the potential identity and the exterior flux +calculation are supplied. This is a conditional assembly helper. -/ +theorem half_energy_add_exterior_integrals_eq_repulsion_of_potential_eq_and_exterior_flux + {M : ℕ} (hM : 1 ≤ M) (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) + (hPhi : ∀ x, screenedPotential Z R x = + coulombPotential (voronoiFaceMeasure R hR (Z : ℝ)) x) + (hFlux : ∀ k : Fin M, + (∫⁻ x in (voronoiCell R k)ᶜ, ENNReal.ofReal ((‖x - R k‖ ^ 4)⁻¹)) = + ∑ l : {l : Fin M // l ≠ k}, ∫⁻ y in voronoiFace R k l.val, + ENNReal.ofReal (nuclearHalfDistance R k l.val / ‖y - R k‖ ^ 4) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm) : + coulombEnergy (voronoiFaceMeasure R hR (Z : ℝ)) (voronoiFaceMeasure R hR (Z : ℝ)) / 2 + + ENNReal.ofReal ((Z : ℝ) ^ 2 / (8 * Real.pi)) * + (∑ k : Fin M, ∫⁻ x in (voronoiCell R k)ᶜ, ENNReal.ofReal ((‖x - R k‖ ^ 4)⁻¹)) = + nuclearRepulsion (fun _ => Z) R := by + simp_rw [hFlux] + exact half_energy_add_directed_boundary_eq_repulsion_of_potential_eq hM Z R hR hPhi + +/-- The exact square-completion input conditional on the potential and exterior-flux identities. +The extra exterior-flux premise is displayed in the name and statement. -/ +theorem energyDeficit_of_potential_eq_and_exterior_flux {M : ℕ} + (hM : 1 ≤ M) (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) + (hPhi : ∀ x, screenedPotential Z R x = + coulombPotential (voronoiFaceMeasure R hR (Z : ℝ)) x) + (hFlux : 2 ≤ M → ∀ k : Fin M, + (∫⁻ x in (voronoiCell R k)ᶜ, ENNReal.ofReal ((‖x - R k‖ ^ 4)⁻¹)) = + ∑ l : {l : Fin M // l ≠ k}, ∫⁻ y in voronoiFace R k l.val, + ENNReal.ofReal (nuclearHalfDistance R k l.val / ‖y - R k‖ ^ 4) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm) : + coulombEnergy (voronoiFaceMeasure R hR (Z : ℝ)) (voronoiFaceMeasure R hR (Z : ℝ)) / 2 + + baxterCorrection Z R ≤ nuclearRepulsion (fun _ => Z) R := by + by_cases hM2 : 2 ≤ M + · calc + _ ≤ coulombEnergy (voronoiFaceMeasure R hR (Z : ℝ)) (voronoiFaceMeasure R hR (Z : ℝ)) / 2 + + ENNReal.ofReal ((Z : ℝ) ^ 2 / (8 * Real.pi)) * + (∑ k : Fin M, ∫⁻ x in (voronoiCell R k)ᶜ, ENNReal.ofReal ((‖x - R k‖ ^ 4)⁻¹)) := + add_le_add le_rfl (baxterCorrection_le_exterior_integrals hM2 Z R hR) + _ = _ := half_energy_add_exterior_integrals_eq_repulsion_of_potential_eq_and_exterior_flux + hM Z R hR hPhi (hFlux hM2) + · have he : M = 1 := le_antisymm (Nat.lt_succ_iff.mp (lt_of_not_ge hM2)) hM + subst M + exact energyDeficit_one Z R hR + +/-- A reusable assembly of the square-completion input from potential equality +and a compact-field flux identity. -/ +theorem energyDeficit_of_potential_eq_and_compact_flux {M : ℕ} + (hM : 1 ≤ M) (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) + (hPhi : ∀ x, screenedPotential Z R x = + coulombPotential (voronoiFaceMeasure R hR (Z : ℝ)) x) + (hCompactFlux : ∀ (k : Fin M) (V : Position → Position), + ContDiff ℝ 1 V → HasCompactSupport V → + (∫ x in (voronoiCell R k)ᶜ, positionDivergence V x) = + -(∑ l : {l : Fin M // l ≠ k}, + ∫ y in voronoiFace R k l.val, inner ℝ (bisectorNormal R k l.val) (V y) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm)) : + coulombEnergy (voronoiFaceMeasure R hR (Z : ℝ)) (voronoiFaceMeasure R hR (Z : ℝ)) / 2 + + baxterCorrection Z R ≤ nuclearRepulsion (fun _ => Z) R := + energyDeficit_of_potential_eq_and_exterior_flux hM Z R hR hPhi + (fun hM2 k => lintegral_voronoiExterior_inverse_fourth_of_compact_flux + R hR hM2 k (hCompactFlux k)) + +/-- The nearest-nucleus energy deficit used in square completion. +The potential identity is the only analytic hypothesis; compact-field flux, +the cutoff limit and the half-space lower bound are supplied by proved theorems. +The one-nucleus case is included. -/ +theorem energyDeficit_of_potential_eq {M : ℕ} + (hM : 1 ≤ M) (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) + (hPhi : ∀ x, screenedPotential Z R x = + coulombPotential (voronoiFaceMeasure R hR (Z : ℝ)) x) : + coulombEnergy (voronoiFaceMeasure R hR (Z : ℝ)) (voronoiFaceMeasure R hR (Z : ℝ)) / 2 + + baxterCorrection Z R ≤ nuclearRepulsion (fun _ => Z) R := + energyDeficit_of_potential_eq_and_compact_flux hM Z R hR hPhi + (voronoiExterior_compact_flux R hR) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/EnergyDeficitBoundary.lean b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitBoundary.lean new file mode 100644 index 0000000000..93f045f58b --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitBoundary.lean @@ -0,0 +1,99 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitGeometry +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitIdentity + +/-! +# Directed boundary expression for the nearest-nucleus deficit + +The nearest-distance factor turns outward inverse-cubic flux into inverse-fourth flux. + +The half nearest-charge integral has exactly the `Z²/(8π)` directed coefficient. +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- The nearest-distance factor turns outward inverse-cubic flux into inverse-fourth flux. -/ +theorem nearestKernel_mul_faceFlux {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) {k l : Fin M} {y : Position} + (hy : y ∈ voronoiFace R k l) : + (nearestNucleusDistance R y)⁻¹ * ENNReal.ofReal (nuclearFaceFlux R k l y) = + ENNReal.ofReal (nuclearHalfDistance R k l / ‖y - R k‖ ^ 4) := by + have ha := nuclearHalfDistance_pos R hR hy.1 + have hr : 0 < ‖y - R k‖ := + ha.trans_le (nuclearHalfDistance_le_norm_on_bisector R hR hy.1 hy.2.1) + rw [nearestNucleusDistance_eq_of_mem_voronoiFace R hy, + nuclearFaceFlux_on_face R hR hy, ← ENNReal.ofReal_inv_of_pos hr, + ← ENNReal.ofReal_mul (inv_nonneg.mpr hr.le)] + congr 1 + field_simp + +/-- The half nearest-charge integral has exactly the `Z²/(8π)` directed coefficient. -/ +theorem half_nearestIntegral_eq_directed_inverse_fourth {M : ℕ} + (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) : + (∫⁻ y, (Z : ℝ≥0∞) * (nearestNucleusDistance R y)⁻¹ + ∂voronoiFaceMeasure R hR (Z : ℝ)) / 2 = + ENNReal.ofReal ((Z : ℝ) ^ 2 / (8 * Real.pi)) * + ∑ k : Fin M, ∑ l : {l : Fin M // l ≠ k}, + ∫⁻ y in voronoiFace R k l.val, + ENNReal.ofReal (nuclearHalfDistance R k l.val / ‖y - R k‖ ^ 4) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm := by + have hm : Measurable (fun y : Position => (nearestNucleusDistance R y)⁻¹) := + (measurable_nearestNucleusDistance R).inv + rw [lintegral_const_mul _ hm] + have hdir := lintegral_voronoiFaceMeasure_directed R hR (NNReal.coe_nonneg Z) + (fun y => (nearestNucleusDistance R y)⁻¹) hm + change (∫⁻ y, (nearestNucleusDistance R y)⁻¹ ∂voronoiFaceMeasure R hR (Z : ℝ)) = _ at hdir + rw [hdir] + have hb (k : Fin M) (l : {l : Fin M // l ≠ k}) : + (∫⁻ y in voronoiFace R k l.val, + (nearestNucleusDistance R y)⁻¹ * + ENNReal.ofReal (inner ℝ (bisectorNormal R k l.val) (y - R k) / ‖y - R k‖ ^ 3) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm) = + ∫⁻ y in voronoiFace R k l.val, + ENNReal.ofReal (nuclearHalfDistance R k l.val / ‖y - R k‖ ^ 4) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm := by + exact setLIntegral_congr_fun (measurableSet_voronoiFace R k l.val) + fun y hy => nearestKernel_mul_faceFlux R hR hy + simp_rw [hb] + rw [← mul_assoc, ENNReal.mul_div_right_comm] + congr 1 + have hz : (Z : ℝ≥0∞) = ENNReal.ofReal (Z : ℝ) := ENNReal.coe_nnreal_eq Z + rw [hz, ← ENNReal.ofReal_mul (NNReal.coe_nonneg Z), ← ENNReal.ofReal_ofNat (n := 2), + ← ENNReal.ofReal_div_of_pos (by norm_num : (0 : ℝ) < 2)] + congr 1 + field_simp + ring + +/-- Exact energy normalization with the directed boundary integral, conditional only on the +potential identity. -/ +theorem half_energy_add_directed_boundary_eq_repulsion_of_potential_eq {M : ℕ} + (hM : 1 ≤ M) (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) + (hPhi : ∀ x, screenedPotential Z R x = + coulombPotential (voronoiFaceMeasure R hR (Z : ℝ)) x) : + coulombEnergy (voronoiFaceMeasure R hR (Z : ℝ)) (voronoiFaceMeasure R hR (Z : ℝ)) / 2 + + ENNReal.ofReal ((Z : ℝ) ^ 2 / (8 * Real.pi)) * + (∑ k : Fin M, ∑ l : {l : Fin M // l ≠ k}, + ∫⁻ y in voronoiFace R k l.val, + ENNReal.ofReal (nuclearHalfDistance R k l.val / ‖y - R k‖ ^ 4) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm) = + nuclearRepulsion (fun _ => Z) R := by + rw [← half_nearestIntegral_eq_directed_inverse_fourth] + exact half_energy_add_half_nearestIntegral_eq_repulsion_of_potential_eq hM Z R hR hPhi + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFlux.lean b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFlux.lean new file mode 100644 index 0000000000..179aaeda41 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFlux.lean @@ -0,0 +1,195 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitFluxExtension +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitLimits +import LeanPool.LiebThirring.Electrostatics.SlicingDivergence + +/-! +# The exterior cutoff calculation from compact-field flux + +The whole exterior lies outside every ball contained in the cell. + +A genuine face belongs to the exterior of either incident open cell. +-/ + +@[expose] public section + +open MeasureTheory Set Metric Filter +open scoped ENNReal Topology ContDiff + +namespace LiebThirring + +/-- The whole exterior lies outside every ball contained in the cell. -/ +theorem norm_ge_on_voronoiExterior {M : ℕ} (R : Fin M → Position) (k : Fin M) + (a : ℝ) (hball : ball (R k) a ⊆ voronoiCell R k) {x : Position} + (hx : x ∈ (voronoiCell R k)ᶜ) : a ≤ ‖x - R k‖ := by + apply le_of_not_gt + intro h + exact hx (hball (by simpa only [mem_ball, dist_eq_norm] using h)) + +/-- A genuine face belongs to the exterior of either incident open cell. -/ +theorem voronoiFace_subset_exterior {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) {k l : Fin M} (hkl : k ≠ l) : + voronoiFace R k l ⊆ (voronoiCell R k)ᶜ := by + intro y hy + apply exterior_halfSpace_subset_compl_voronoiCell R hR hkl + exact ((mem_bisectorPlane_iff_normal R hR hkl y).mp hy.2.1).ge + +/-- Exact normal value of the inverse-square gradient on a bisector face. -/ +theorem inner_exteriorInverseSquareField_on_face {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) {k l : Fin M} (hkl : k ≠ l) {y : Position} + (hy : y ∈ voronoiFace R k l) : + inner ℝ (bisectorNormal R k l) (exteriorInverseSquareField (R k) y) = + -2 * (nuclearHalfDistance R k l / ‖y - R k‖ ^ 4) := by + have he := (mem_bisectorPlane_iff_normal R hR hkl y).mp hy.2.1 + rw [exteriorInverseSquareField, inner_smul_right, he] + simp only [nuclearHalfDistance, div_eq_mul_inv, inv_pow, ← pow_mul] + ring + +/-- Integrability of a cutoff multiplied by any integrable density. -/ +theorem integrable_exteriorFluxCutoff_mul (μ : Measure Position) (c : Position) (T : ℝ) + (f : Position → ℝ) (hf : Integrable f μ) : + Integrable (fun x => exteriorFluxCutoff c T x * f x) μ := by + apply hf.bdd_mul (c := 1) ((contDiff_exteriorFluxCutoff c + T).continuous.measurable.aestronglyMeasurable) + exact Eventually.of_forall (fun x => by + rw [Real.norm_eq_abs, abs_of_nonneg + (show 0 ≤ exteriorFluxCutoff c T x from exteriorFluxBump.nonneg)] + exact exteriorFluxBump.le_one) + +/-- Integrability of the derivative defect multiplied by any integrable density. -/ +theorem integrable_exteriorFluxDefect_mul (μ : Measure Position) (c : Position) (T : ℝ) + (f : Position → ℝ) (hf : Integrable f μ) : + Integrable (fun x => exteriorFluxDefect (T⁻¹ • (x - c)) * f x) μ := by + obtain ⟨C, hC⟩ := exteriorFluxDefect_bounded + have hm : Continuous (fun x : Position => exteriorFluxDefect (T⁻¹ • (x - c))) := + continuous_exteriorFluxDefect.comp + ((continuous_const : Continuous (fun _ : Position => T⁻¹)).smul + (continuous_id.sub continuous_const)) + exact hf.bdd_mul hm.measurable.aestronglyMeasurable (Eventually.of_forall (fun x => hC _)) + +/-- Exact truncated balance, conditional only on compact C¹ flux. -/ +theorem integral_voronoiExterior_cutoff_of_compact_flux {M : ℕ} + (R : Fin M → Position) (hR : Function.Injective R) (hM : 2 ≤ M) (k : Fin M) + (hFlux : ∀ V : Position → Position, ContDiff ℝ 1 V → HasCompactSupport V → + (∫ x in (voronoiCell R k)ᶜ, positionDivergence V x) = + -(∑ l : {l : Fin M // l ≠ k}, ∫ y in voronoiFace R k l.val, + inner ℝ (bisectorNormal R k l.val) (V y) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm)) (T : ℝ) (hT : 0 < T) : + (∫ x in (voronoiCell R k)ᶜ, exteriorFluxCutoff (R k) T x * (1 / ‖x - R k‖ ^ 4)) - + (∫ x in (voronoiCell R k)ᶜ, + exteriorFluxDefect (T⁻¹ • (x - R k)) * (1 / ‖x - R k‖ ^ 4)) = + ∑ l : {l : Fin M // l ≠ k}, ∫ y in voronoiFace R k l.val, + exteriorFluxCutoff (R k) T y * (nuclearHalfDistance R k l.val / ‖y - R k‖ ^ 4) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm := by + let a := (nearestOtherNucleusDistance R k).toReal / 2 + have ha : 0 < a := half_pos (nearestOtherNucleusDistance_toReal_pos R hR hM k) + have hball : ball (R k) a ⊆ voronoiCell R k := ball_nearestOther_half_subset_voronoiCell R hM k + have hr {x : Position} (hx : x ∈ (voronoiCell R k)ᶜ) : a / 2 < ‖x - R k‖ := by + have hb := norm_ge_on_voronoiExterior R k a hball hx + linarith + have hdiv {x : Position} (hx : x ∈ (voronoiCell R k)ᶜ) : + positionDivergence (exteriorFluxExtendedField (R k) a T ha) x = + 2 * (exteriorFluxCutoff (R k) T x * (1 / ‖x - R k‖ ^ 4) - + exteriorFluxDefect (T⁻¹ • (x - R k)) * (1 / ‖x - R k‖ ^ 4)) := by + rw [positionDivergence_exteriorFluxExtendedField _ _ _ _ ha (hr hx)] + ring + have hnormal (l : {l : Fin M // l ≠ k}) {y : Position} (hy : y ∈ voronoiFace R k l.val) : + inner ℝ (bisectorNormal R k l.val) (exteriorFluxExtendedField (R k) a T ha y) = + -2 * (exteriorFluxCutoff (R k) T y * (nuclearHalfDistance R k l.val / ‖y - R k‖ ^ 4)) := by + rw [exteriorFluxExtendedField_eq _ _ _ _ ha + (hr (voronoiFace_subset_exterior R hR l.property.symm hy)).le, + inner_smul_right, inner_exteriorInverseSquareField_on_face R hR l.property.symm hy] + ring + have hf := integrableOn_inverse_fourth_voronoiExterior R hR hM k + have hχ := integrable_exteriorFluxCutoff_mul _ (R k) T _ hf + have hδ := integrable_exteriorFluxDefect_mul _ (R k) T _ hf + have he := hFlux (exteriorFluxExtendedField (R k) a T ha) + ((contDiff_exteriorFluxExtendedField (R k) a T ha).of_le (by simp)) + (hasCompactSupport_exteriorFluxExtendedField (R k) a T ha hT) + rw [setIntegral_congr_fun (isOpen_voronoiCell R k).measurableSet.compl (fun x hx => hdiv hx), + integral_const_mul, integral_sub hχ hδ] at he + have hb : (∑ l : {l : Fin M // l ≠ k}, ∫ y in voronoiFace R k l.val, + inner ℝ (bisectorNormal R k l.val) (exteriorFluxExtendedField (R k) a T ha y) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm) = + -2 * (∑ l : {l : Fin M // l ≠ k}, ∫ y in voronoiFace R k l.val, + exteriorFluxCutoff (R k) T y * (nuclearHalfDistance R k l.val / ‖y - R k‖ ^ 4) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm) := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro l _ + rw [setIntegral_congr_fun (measurableSet_voronoiFace R k l.val) (fun y hy => hnormal l hy), + integral_const_mul] + rw [hb] at he + linarith only [he] + +/-- The full real exterior identity after the proved cutoff passage from compact C¹ flux. -/ +theorem integral_voronoiExterior_inverse_fourth_of_compact_flux {M : ℕ} + (R : Fin M → Position) (hR : Function.Injective R) (hM : 2 ≤ M) (k : Fin M) + (hFlux : ∀ V : Position → Position, ContDiff ℝ 1 V → HasCompactSupport V → + (∫ x in (voronoiCell R k)ᶜ, positionDivergence V x) = + -(∑ l : {l : Fin M // l ≠ k}, ∫ y in voronoiFace R k l.val, + inner ℝ (bisectorNormal R k l.val) (V y) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm)) : + (∫ x in (voronoiCell R k)ᶜ, 1 / ‖x - R k‖ ^ 4) = + ∑ l : {l : Fin M // l ≠ k}, ∫ y in voronoiFace R k l.val, + nuclearHalfDistance R k l.val / ‖y - R k‖ ^ 4 + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm := by + have hleft := (tendsto_integral_cutoff_voronoiExterior R hR hM k).sub + (tendsto_integral_defect_voronoiExterior R hR hM k) + simp only [sub_zero] at hleft + have hright := tendsto_finsetSum Finset.univ (fun (l : {l : Fin M // l ≠ k}) _ => + tendsto_integral_cutoff_voronoiFace R hR k l.val l.property.symm) + have heq : (fun T : ℝ => + (∫ x in (voronoiCell R k)ᶜ, exteriorFluxCutoff (R k) T x * (1 / ‖x - R k‖ ^ 4)) - + (∫ x in (voronoiCell R k)ᶜ, + exteriorFluxDefect (T⁻¹ • (x - R k)) * (1 / ‖x - R k‖ ^ 4))) =ᶠ[atTop] + (fun T => ∑ l : {l : Fin M // l ≠ k}, ∫ y in voronoiFace R k l.val, + exteriorFluxCutoff (R k) T y * (nuclearHalfDistance R k l.val / ‖y - R k‖ ^ 4) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm) := by + filter_upwards [eventually_gt_atTop (0 : ℝ)] with T hT + exact integral_voronoiExterior_cutoff_of_compact_flux R hR hM k hFlux T hT + exact tendsto_nhds_unique (hleft.congr' heq) hright + +/-- The full extended nonnegative exterior identity from a compact C¹ flux identity. -/ +theorem lintegral_voronoiExterior_inverse_fourth_of_compact_flux {M : ℕ} + (R : Fin M → Position) (hR : Function.Injective R) (hM : 2 ≤ M) (k : Fin M) + (hFlux : ∀ V : Position → Position, ContDiff ℝ 1 V → HasCompactSupport V → + (∫ x in (voronoiCell R k)ᶜ, positionDivergence V x) = + -(∑ l : {l : Fin M // l ≠ k}, ∫ y in voronoiFace R k l.val, + inner ℝ (bisectorNormal R k l.val) (V y) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm)) : + (∫⁻ x in (voronoiCell R k)ᶜ, ENNReal.ofReal ((‖x - R k‖ ^ 4)⁻¹)) = + ∑ l : {l : Fin M // l ≠ k}, ∫⁻ y in voronoiFace R k l.val, + ENNReal.ofReal (nuclearHalfDistance R k l.val / ‖y - R k‖ ^ 4) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm := by + have hi := integrableOn_inverse_fourth_voronoiExterior R hR hM k + have hn : ∀ᵐ x ∂(volume.restrict (voronoiCell R k)ᶜ), 0 ≤ 1 / ‖x - R k‖ ^ 4 := + Eventually.of_forall (fun x => by positivity) + simp_rw [← one_div] + rw [← ofReal_integral_eq_lintegral_ofReal hi hn, + integral_voronoiExterior_inverse_fourth_of_compact_flux R hR hM k hFlux, + ENNReal.ofReal_sum_of_nonneg] + · apply Finset.sum_congr rfl + intro l _ + apply ofReal_integral_eq_lintegral_ofReal + (integrableOn_voronoiFace_inverse_fourth_flux R hR k l.val l.property.symm) + exact Eventually.of_forall (fun y => div_nonneg + (nuclearHalfDistance_pos R hR l.property.symm).le (pow_nonneg (norm_nonneg _) _)) + · intro l _ + apply integral_nonneg + intro y + exact div_nonneg (nuclearHalfDistance_pos R hR l.property.symm).le (pow_nonneg (norm_nonneg _) + _) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFluxCutoff.lean b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFluxCutoff.lean new file mode 100644 index 0000000000..f89e088a5b --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFluxCutoff.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.Calculus.BumpFunction.FiniteDimension +public import Mathlib.MeasureTheory.Integral.DominatedConvergence +public import Mathlib.Analysis.Calculus.BumpFunction.Basic +public import LeanPool.LiebThirring.Electrostatics.Basic + +/-! +# Smooth expanding cutoffs and the radial derivative defect + +The fixed smooth cutoff, one on the unit ball and zero outside radius two. + +Expanding smooth cutoff centred at the nucleus. +-/ + +@[expose] public section + +open MeasureTheory Filter Set Metric +open scoped Topology ContDiff + +namespace LiebThirring + +/-- The fixed smooth cutoff, one on the unit ball and zero outside radius two. -/ +def exteriorFluxBump : ContDiffBump (0 : Position) := ⟨1, 2, zero_lt_one, one_lt_two⟩ + +/-- Expanding smooth cutoff centred at the nucleus. -/ +noncomputable def exteriorFluxCutoff (c : Position) (T : ℝ) (x : Position) : ℝ := + exteriorFluxBump (T⁻¹ • (x - c)) + +/-- The fixed radial derivative defect whose scaled form appears in the cutoff error. -/ +noncomputable def exteriorFluxDefect (x : Position) : ℝ := + fderiv ℝ (exteriorFluxBump : Position → ℝ) x x + +/-- The cutoff is smooth for every scale. -/ +theorem contDiff_exteriorFluxCutoff (c : Position) (T : ℝ) : + ContDiff ℝ ∞ (exteriorFluxCutoff c T) := +by + apply exteriorFluxBump.contDiff.comp + exact (contDiff_const : ContDiff ℝ ∞ (fun _ : Position => T⁻¹)).smul + (contDiff_id.sub contDiff_const) + +/-- The radial derivative defect is continuous. -/ +theorem continuous_exteriorFluxDefect : Continuous exteriorFluxDefect := + (exteriorFluxBump.contDiff.continuous_fderiv (by simp : (∞ : ℕ∞ω) ≠ 0)).clm_apply continuous_id + +/-- Compact support of the radial derivative defect. -/ +theorem hasCompactSupport_exteriorFluxDefect : HasCompactSupport exteriorFluxDefect := by + apply (exteriorFluxBump.hasCompactSupport.fderiv ℝ).mono' + intro x hx + apply subset_closure + apply Function.mem_support.mpr + intro h + exact hx (by simp only [exteriorFluxDefect, h, zero_apply]) + +/-- A global bound on the fixed radial derivative defect. -/ +theorem exteriorFluxDefect_bounded : ∃ C : ℝ, ∀ x, ‖exteriorFluxDefect x‖ ≤ C := + hasCompactSupport_exteriorFluxDefect.exists_bound_of_continuous continuous_exteriorFluxDefect + +/-- The defect at the origin vanishes. -/ +@[simp] theorem exteriorFluxDefect_zero : exteriorFluxDefect 0 = 0 := by + simp only [exteriorFluxDefect, map_zero] + +/-- Expanding cutoffs tend to one pointwise. -/ +theorem tendsto_exteriorFluxCutoff (c x : Position) : + Tendsto (fun T : ℝ => exteriorFluxCutoff c T x) atTop (𝓝 1) := by + have hs : Tendsto (fun T : ℝ => T⁻¹ • (x - c)) atTop (𝓝 (0 : Position)) := by + simpa only [zero_smul] using (tendsto_inv_atTop_zero : Tendsto (fun T : ℝ => T⁻¹) atTop (𝓝 + 0)).smul_const (x - c) + have hone : exteriorFluxBump (0 : Position) = 1 := + exteriorFluxBump.one_of_mem_closedBall (by simp [exteriorFluxBump]) + simpa only [exteriorFluxCutoff, hone, Function.comp_def] using + exteriorFluxBump.continuous.continuousAt.tendsto.comp hs + +/-- The scaled radial derivative defect tends to zero pointwise. -/ +theorem tendsto_exteriorFluxDefect (c x : Position) : + Tendsto (fun T : ℝ => exteriorFluxDefect (T⁻¹ • (x - c))) atTop (𝓝 0) := by + have hs : Tendsto (fun T : ℝ => T⁻¹ • (x - c)) atTop (𝓝 (0 : Position)) := by + simpa only [zero_smul] using (tendsto_inv_atTop_zero : Tendsto (fun T : ℝ => T⁻¹) atTop (𝓝 + 0)).smul_const (x - c) + simpa only [exteriorFluxDefect_zero, Function.comp_def] using + continuous_exteriorFluxDefect.continuousAt.tendsto.comp hs + +/-- Dominated convergence for a cutoff against any integrable real density. -/ +theorem tendsto_integral_exteriorFluxCutoff (μ : Measure Position) (c : Position) + (f : Position → ℝ) (hf : Integrable f μ) : + Tendsto (fun T : ℝ => ∫ x, exteriorFluxCutoff c T x * f x ∂μ) + atTop (𝓝 (∫ x, f x ∂μ)) := by + apply tendsto_integral_filter_of_dominated_convergence (fun x => ‖f x‖) + · exact Eventually.of_forall (fun T => + ((contDiff_exteriorFluxCutoff c T).continuous.measurable.aestronglyMeasurable).mul + hf.aestronglyMeasurable) + · exact Eventually.of_forall (fun T => Eventually.of_forall (fun x => by + rw [norm_mul, Real.norm_eq_abs, + abs_of_nonneg (show 0 ≤ exteriorFluxCutoff c T x from exteriorFluxBump.nonneg)] + exact mul_le_of_le_one_left (norm_nonneg _) exteriorFluxBump.le_one)) + · exact hf.norm + · exact Eventually.of_forall (fun x => by + simpa only [one_mul] using (tendsto_exteriorFluxCutoff c x).mul_const (f x)) + +/-- The scaled radial cutoff derivative error vanishes under an integrable majorant. -/ +theorem tendsto_integral_exteriorFluxDefect (μ : Measure Position) (c : Position) + (f : Position → ℝ) (hf : Integrable f μ) : + Tendsto (fun T : ℝ => ∫ x, exteriorFluxDefect (T⁻¹ • (x - c)) * f x ∂μ) + atTop (𝓝 0) := by + obtain ⟨C, hC⟩ := exteriorFluxDefect_bounded + have hm (T : ℝ) : Continuous (fun x : Position => exteriorFluxDefect (T⁻¹ • (x - c))) := + continuous_exteriorFluxDefect.comp + ((continuous_const : Continuous (fun _ : Position => T⁻¹)).smul + (continuous_id.sub continuous_const)) + have hh := tendsto_integral_filter_of_dominated_convergence (μ := μ) + (F := fun T x => exteriorFluxDefect (T⁻¹ • (x - c)) * f x) + (f := fun _ : Position => (0 : ℝ)) (fun x => C * ‖f x‖) + (Eventually.of_forall (fun T => hm T |>.measurable.aestronglyMeasurable.mul + hf.aestronglyMeasurable)) + (Eventually.of_forall (fun T => Eventually.of_forall (fun x => by + rw [norm_mul] + exact mul_le_mul_of_nonneg_right (hC _) (norm_nonneg _)))) + (hf.norm.const_mul C) + (Eventually.of_forall (fun x => by + simpa only [zero_mul] using (tendsto_exteriorFluxDefect c x).mul_const (f x))) + simpa only [integral_zero] using hh + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFluxExtension.lean b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFluxExtension.lean new file mode 100644 index 0000000000..e97326b7c2 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFluxExtension.lean @@ -0,0 +1,123 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitFluxField + +/-! +# Compact smooth extension of the exterior cutoff field + +A smooth inner cutoff eliminates the nucleus singularity inside the cell. +The resulting field is globally smooth and compactly supported; outside +radius `a/2` it agrees with the original outer-cutoff field. +-/ + +@[expose] public section + +open Filter Set Metric +open scoped Topology ContDiff + +namespace LiebThirring + +/-- A smooth inner bump whose transition is confined inside radius `a/2`. -/ +noncomputable def exteriorFluxInnerBump (c : Position) (a : ℝ) (ha : 0 < a) : ContDiffBump c := + ⟨a / 4, a / 2, by positivity, by linarith⟩ + +/-- Compact smooth extension of the outer-cutoff inverse-square field. -/ +noncomputable def exteriorFluxExtendedField (c : Position) (a T : ℝ) (ha : 0 < a) + (x : Position) : Position := + (exteriorFluxCutoff c T x * (1 - exteriorFluxInnerBump c a ha x)) • + exteriorInverseSquareField c x + +/-- The inverse-square field is smooth off its singular centre. -/ +theorem contDiffAt_exteriorInverseSquareField (c x : Position) (hx : x ≠ c) : + ContDiffAt ℝ ∞ (exteriorInverseSquareField c) x := by + have hs : ContDiffAt ℝ ∞ (fun y : Position => ‖y - c‖ ^ 2) x := + ((contDiff_id : ContDiff ℝ ∞ (fun y : Position => y)).sub + (contDiff_const : ContDiff ℝ ∞ (fun _ : Position => c))).norm_sq (𝕜 := ℝ) |>.contDiffAt + have hn : ‖x - c‖ ^ 2 ≠ 0 := pow_ne_zero _ (norm_ne_zero_iff.mpr (sub_ne_zero.mpr hx)) + exact ((contDiffAt_const : ContDiffAt ℝ ∞ (fun _ : Position => (-2 : ℝ)) x).mul + ((hs.inv hn).pow 2)).smul + (((contDiff_id : ContDiff ℝ ∞ (fun y : Position => y)).sub + (contDiff_const : ContDiff ℝ ∞ (fun _ : Position => c))).contDiffAt) + +/-- Global smoothness of the extended field. -/ +theorem contDiff_exteriorFluxExtendedField (c : Position) (a T : ℝ) (ha : 0 < a) : + ContDiff ℝ ∞ (exteriorFluxExtendedField c a T ha) := by + rw [contDiff_iff_contDiffAt] + intro x + by_cases hx : x = c + · subst x + apply (contDiffAt_const : ContDiffAt ℝ ∞ (fun _ : Position => (0 : Position)) + c).congr_of_eventuallyEq + filter_upwards [(exteriorFluxInnerBump c a ha).eventuallyEq_one] with x hx + simp only [exteriorFluxExtendedField, hx, Pi.one_apply, sub_self, mul_zero, zero_smul] + · exact ((contDiff_exteriorFluxCutoff c T).contDiffAt.mul + (contDiffAt_const.sub (exteriorFluxInnerBump c a ha).contDiffAt)).smul + (contDiffAt_exteriorInverseSquareField c x hx) + +/-- The scaled cutoff is a standard compactly supported bump at positive scale. -/ +theorem exteriorFluxCutoff_eq_bump (c : Position) (T : ℝ) (hT : 0 < T) : + exteriorFluxCutoff c T = (⟨T, 2 * T, hT, by linarith⟩ : ContDiffBump c) := by + funext x + rw [exteriorFluxCutoff, exteriorFluxBump, ContDiffBump.apply, ContDiffBump.apply] + simp only [inv_one, one_smul, sub_zero, div_one] + rw [mul_div_cancel_right₀ _ (ne_of_gt hT)] + +/-- Compact support of the expanding cutoff. -/ +theorem hasCompactSupport_exteriorFluxCutoff (c : Position) (T : ℝ) (hT : 0 < T) : + HasCompactSupport (exteriorFluxCutoff c T) := by + rw [exteriorFluxCutoff_eq_bump c T hT] + exact ContDiffBump.hasCompactSupport _ + +/-- Compact support of the extended smooth field. -/ +theorem hasCompactSupport_exteriorFluxExtendedField (c : Position) (a T : ℝ) + (ha : 0 < a) (hT : 0 < T) : + HasCompactSupport (exteriorFluxExtendedField c a T ha) := + ((hasCompactSupport_exteriorFluxCutoff c T hT).mul_right).smul_right + +/-- The inner extension equals the original field outside its transition ball. -/ +theorem exteriorFluxExtendedField_eq (c x : Position) (a T : ℝ) (ha : 0 < a) + (hx : a / 2 ≤ ‖x - c‖) : + exteriorFluxExtendedField c a T ha x = + exteriorFluxCutoff c T x • exteriorInverseSquareField c x := by + have hb : exteriorFluxInnerBump c a ha x = 0 := + (exteriorFluxInnerBump c a ha).zero_of_le_dist (by simpa only [exteriorFluxInnerBump, + dist_eq_norm] using hx) + simp only [exteriorFluxExtendedField, hb, sub_zero, mul_one] + +/-- The inner extension is locally invisible outside the transition ball. -/ +theorem eventuallyEq_exteriorFluxExtendedField (c x : Position) (a T : ℝ) (ha : 0 < a) + (hx : a / 2 < ‖x - c‖) : + exteriorFluxExtendedField c a T ha =ᶠ[𝓝 x] + (fun y => exteriorFluxCutoff c T y • exteriorInverseSquareField c y) := by + have hn : ∀ᶠ y in 𝓝 x, a / 2 < ‖y - c‖ := + (isOpen_lt continuous_const (continuous_id.sub continuous_const).norm).mem_nhds hx + filter_upwards [hn] with y hy + exact exteriorFluxExtendedField_eq c y a T ha hy.le + +/-- Exact divergence of the globally smooth extension outside its transition ball. -/ +theorem positionDivergence_exteriorFluxExtendedField (c x : Position) (a T : ℝ) + (ha : 0 < a) (hx : a / 2 < ‖x - c‖) : + positionDivergence (exteriorFluxExtendedField c a T ha) x = + exteriorFluxCutoff c T x * (2 / ‖x - c‖ ^ 4) - + exteriorFluxDefect (T⁻¹ • (x - c)) * (2 / ‖x - c‖ ^ 4) := by + have he := (eventuallyEq_exteriorFluxExtendedField c x a T ha hx).fderiv_eq (𝕜 := ℝ) + have hxc : x ≠ c := by + intro h + subst x + simp only [sub_self, norm_zero] at hx + linarith + unfold positionDivergence + rw [he] + exact positionDivergence_cutoff_field c x T hxc + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFluxField.lean b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFluxField.lean new file mode 100644 index 0000000000..5c72b10946 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFluxField.lean @@ -0,0 +1,147 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitFluxCutoff + +/-! +# The inverse-square field and its divergence + +The gradient of the inverse-square potential, with its scalar factor written by squared norm. + +The inverse-square potential has precisely the displayed gradient field. +-/ + +@[expose] public section + +open scoped ContDiff + +namespace LiebThirring + +/-- The gradient of the inverse-square potential, with its scalar factor written by squared norm. -/ +noncomputable def exteriorInverseSquareField (c x : Position) : Position := + (-2 * ((‖x - c‖ ^ 2)⁻¹) ^ 2) • (x - c) + +/-- Coordinate trace of the derivative on physical Euclidean space. -/ +noncomputable def positionDivergence (V : Position → Position) (x : Position) : ℝ := + ∑ i : Fin 3, (fderiv ℝ V x (EuclideanSpace.basisFun (Fin 3) ℝ i)) i + +/-- Directional derivative of the scalar factor away from the nucleus. -/ +theorem hasFDerivAt_inverse_fourth_factor (c x : Position) (hx : x ≠ c) : + HasFDerivAt (fun y : Position => -2 * ((‖y - c‖ ^ 2)⁻¹) ^ 2) + ((8 / ‖x - c‖ ^ 6) • innerSL ℝ (x - c)) x := by + have hn : ‖x - c‖ ≠ 0 := norm_ne_zero_iff.mpr (sub_ne_zero.mpr hx) + have hs : ‖x - c‖ ^ 2 ≠ 0 := pow_ne_zero _ hn + have hd := (hasFDerivAt_id x).sub_const c |>.norm_sq + have hi := (hasDerivAt_inv hs).comp_hasFDerivAt x hd + convert (hi.pow 2).const_mul (-2) using 1 + · funext y + simp only [Function.comp_def, id_eq] + · ext v + simp only [smul_apply, ContinuousLinearMap.comp_apply, + ContinuousLinearMap.id_apply, innerSL_apply_apply, smul_eq_mul, Function.comp_def, id_eq, + Nat.reduceSub, pow_one, nsmul_eq_mul, Nat.cast_ofNat] + field_simp [hn] + ring + +/-- The vector field derivative evaluated in an arbitrary direction. -/ +theorem fderiv_exteriorInverseSquareField_apply (c x v : Position) (hx : x ≠ c) : + fderiv ℝ (exteriorInverseSquareField c) x v = + (-2 / ‖x - c‖ ^ 4) • v + + (8 / ‖x - c‖ ^ 6 * inner ℝ (x - c) v) • (x - c) := by + have hd := (hasFDerivAt_inverse_fourth_factor c x hx).smul + ((hasFDerivAt_id x).sub_const c) + change fderiv ℝ ((fun y : Position => -2 * ((‖y - c‖ ^ 2)⁻¹) ^ 2) • + (fun y : Position => y - c)) x v = _ + simp only [id_eq] at hd + rw [hd.fderiv] + simp only [add_apply, smul_apply, + ContinuousLinearMap.id_apply, ContinuousLinearMap.smulRight_apply, innerSL_apply_apply, + smul_eq_mul] + congr 2 + simp only [div_eq_mul_inv, inv_pow, ← pow_mul] + +/-- Exact divergence of the inverse-square gradient off the nucleus. -/ +theorem positionDivergence_exteriorInverseSquareField (c x : Position) (hx : x ≠ c) : + positionDivergence (exteriorInverseSquareField c) x = 2 / ‖x - c‖ ^ 4 := by + unfold positionDivergence + simp_rw [fderiv_exteriorInverseSquareField_apply c x _ hx, + EuclideanSpace.inner_basisFun_real] + have he (i : Fin 3) : + ((-2 / ‖x - c‖ ^ 4) • EuclideanSpace.basisFun (Fin 3) ℝ i + + (8 / ‖x - c‖ ^ 6 * (x - c) i) • (x - c)) i = + -2 / ‖x - c‖ ^ 4 + 8 / ‖x - c‖ ^ 6 * ((x - c) i) ^ 2 := by + simp only [PiLp.add_apply, PiLp.smul_apply, smul_eq_mul, EuclideanSpace.basisFun_apply, + PiLp.single_apply, ite_true, mul_one] + ring + simp_rw [he] + rw [Finset.sum_add_distrib, Finset.sum_const, Finset.card_univ, Fintype.card_fin, + nsmul_eq_mul, ← Finset.mul_sum, ← EuclideanSpace.real_norm_sq_eq] + have hn : ‖x - c‖ ≠ 0 := norm_ne_zero_iff.mpr (sub_ne_zero.mpr hx) + field_simp + ring + +/-- Applying the derivative of the scaled cutoff in the radial direction. -/ +theorem fderiv_exteriorFluxCutoff_radial (c x : Position) (T : ℝ) : + fderiv ℝ (exteriorFluxCutoff c T) x (x - c) = + exteriorFluxDefect (T⁻¹ • (x - c)) := by + have hs := ((hasFDerivAt_id (𝕜 := ℝ) x).sub_const c).fun_const_smul T⁻¹ + have hb := (exteriorFluxBump.contDiff.differentiable (by simp : (∞ : ℕ∞ω) ≠ 0) + (T⁻¹ • (x - c))).hasFDerivAt + have hd := hb.comp x hs + simp only [id_eq] at hd + rw [show fderiv ℝ (exteriorFluxCutoff c T) x = + (fderiv ℝ (exteriorFluxBump : Position → ℝ) (T⁻¹ • (x - c))).comp + (T⁻¹ • ContinuousLinearMap.id ℝ Position) from hd.fderiv] + simp only [ContinuousLinearMap.comp_apply, smul_apply, ContinuousLinearMap.id_apply, + exteriorFluxDefect] + +/-- Trace of a rank-one map in the standard orthonormal frame. -/ +theorem sum_position_rankOne (L : Position →L[ℝ] ℝ) (v : Position) : + (∑ i : Fin 3, L (EuclideanSpace.basisFun (Fin 3) ℝ i) * v i) = L v := by + calc + _ = ∑ i : Fin 3, L (v i • EuclideanSpace.basisFun (Fin 3) ℝ i) := by + simp only [map_smul, smul_eq_mul, mul_comm] + _ = L (∑ i : Fin 3, v i • EuclideanSpace.basisFun (Fin 3) ℝ i) := (map_sum _ _ _).symm + _ = L v := by + have he := (EuclideanSpace.basisFun (Fin 3) ℝ).sum_repr v + simpa only [EuclideanSpace.basisFun_repr] using congrArg L he + +/-- Divergence product rule for a scalar and a vector field at a differentiability point. -/ +theorem positionDivergence_smul (f : Position → ℝ) (V : Position → Position) (x : Position) + (hf : DifferentiableAt ℝ f x) (hV : DifferentiableAt ℝ V x) : + positionDivergence (fun y => f y • V y) x = + f x * positionDivergence V x + fderiv ℝ f x (V x) := by + have hd := hf.hasFDerivAt.fun_smul hV.hasFDerivAt + unfold positionDivergence + rw [hd.fderiv] + simp only [add_apply, smul_apply, ContinuousLinearMap.smulRight_apply, PiLp.add_apply, + PiLp.smul_apply, smul_eq_mul, Finset.sum_add_distrib, ← Finset.mul_sum, + sum_position_rankOne] + +/-- The exact pointwise cutoff divergence, including its gradient error. -/ +theorem positionDivergence_cutoff_field (c x : Position) (T : ℝ) (hx : x ≠ c) : + positionDivergence (fun y => exteriorFluxCutoff c T y • exteriorInverseSquareField c y) x = + exteriorFluxCutoff c T x * (2 / ‖x - c‖ ^ 4) - + exteriorFluxDefect (T⁻¹ • (x - c)) * (2 / ‖x - c‖ ^ 4) := by + have hV : DifferentiableAt ℝ (exteriorInverseSquareField c) x := by + convert ((hasFDerivAt_inverse_fourth_factor c x hx).fun_smul + ((hasFDerivAt_id x).sub_const c)).differentiableAt using 1 + funext y + rfl + rw [positionDivergence_smul (exteriorFluxCutoff c T) (exteriorInverseSquareField c) x + ((contDiff_exteriorFluxCutoff c T).differentiable (by simp : (∞ : ℕ∞ω) ≠ 0) x) hV, + positionDivergence_exteriorInverseSquareField c x hx] + simp only [exteriorInverseSquareField, map_smul, smul_eq_mul, fderiv_exteriorFluxCutoff_radial] + simp only [div_eq_mul_inv, inv_pow, ← pow_mul] + ring + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFluxPlane.lean b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFluxPlane.lean new file mode 100644 index 0000000000..e8f7d3c83f --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFluxPlane.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.PlaneDistance +public import LeanPool.LiebThirring.Electrostatics.PlanePolar +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitHalfSpaceRadial + +/-! +# Integrable boundary majorant for the exterior inverse-square flux + +Exact planar radial inverse-fourth mass with its flux numerator. + +Exact whole-plane integral of the positive inverse-square flux density. +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal + +namespace LiebThirring + +/-- Exact planar radial inverse-fourth mass with its flux numerator. -/ +theorem lintegral_planar_inverse_fourth_flux (a : ℝ) (ha : 0 < a) : + (∫⁻ q : Planar, ENNReal.ofReal (a / (‖q‖ ^ 2 + a ^ 2) ^ 2)) = + ENNReal.ofReal (Real.pi / a) := by + have hf : Measurable (fun r : ℝ => ENNReal.ofReal + (r / (a ^ 2 + r ^ 2) ^ 2)) := + (measurable_id.div ((measurable_const.add (measurable_id.pow_const 2)).pow_const + 2)).ennreal_ofReal + have hg : Measurable (fun r : ℝ => ENNReal.ofReal + (a / (r ^ 2 + a ^ 2) ^ 2)) := + (measurable_const.div (((measurable_id.pow_const 2).add measurable_const).pow_const + 2)).ennreal_ofReal + rw [lintegral_planar_norm _ hg] + have hrad : (∫⁻ r in Ioi (0 : ℝ), ENNReal.ofReal r * + ENNReal.ofReal (a / (r ^ 2 + a ^ 2) ^ 2)) = + ENNReal.ofReal a * ENNReal.ofReal (1 / (2 * a ^ 2)) := by + calc + _ = ∫⁻ r in Ioi (0 : ℝ), ENNReal.ofReal a * + ENNReal.ofReal (r / (a ^ 2 + r ^ 2) ^ 2) := by + refine setLIntegral_congr_fun measurableSet_Ioi (fun r hr => ?_) + rw [← ENNReal.ofReal_mul hr.le, ← ENNReal.ofReal_mul ha.le] + congr 1 + rw [add_comm (r ^ 2)] + ring + _ = _ := by rw [lintegral_const_mul _ hf, lintegral_inverse_fourth_radial a ha] + rw [hrad, ← mul_assoc, ← ENNReal.ofReal_mul (by positivity : 0 ≤ 2 * Real.pi), + ← ENNReal.ofReal_mul (by positivity : 0 ≤ 2 * Real.pi * a)] + congr 1 + field_simp + +/-- Exact whole-plane integral of the positive inverse-square flux density. -/ +theorem lintegral_plane_inverse_fourth_flux (n b c : Position) (hn : ‖n‖ = 1) + (F : PlaneFrame (affinePlane n b)) (ha : 0 < planeHeight n b c) : + (∫⁻ y, ENNReal.ofReal (planeHeight n b c / ‖y - c‖ ^ 4) ∂planeMeasure F) = + ENNReal.ofReal (Real.pi / planeHeight n b c) := by + have hf : Measurable (fun y : Position => ENNReal.ofReal + (planeHeight n b c / ‖y - c‖ ^ 4)) := + (measurable_const.div ((measurable_id.sub measurable_const).norm.pow_const 4)).ennreal_ofReal + rw [lintegral_planeMeasure_atFoot n b c hn F _ hf] + have hd (q : Planar) : + ‖(planeFrameAtFoot n b c hn F q : Position) - c‖ ^ 4 = + (‖q‖ ^ 2 + planeHeight n b c ^ 2) ^ 2 := by + rw [norm_sub_rev, norm_sub_planeFrameAtFoot_eq_sqrt, show 4 = 2 * 2 from rfl, + pow_mul, Real.sq_sqrt (by positivity)] + simp_rw [hd] + exact lintegral_planar_inverse_fourth_flux _ ha + +/-- The full-plane flux majorant is Bochner integrable. -/ +theorem integrable_plane_inverse_fourth_flux (n b c : Position) (hn : ‖n‖ = 1) + (F : PlaneFrame (affinePlane n b)) (ha : 0 < planeHeight n b c) : + Integrable (fun y : Position => planeHeight n b c / ‖y - c‖ ^ 4) (planeMeasure F) := by + refine ⟨(measurable_const.div ((measurable_id.sub measurable_const).norm.pow_const + 4)).aestronglyMeasurable, ?_⟩ + change (∫⁻ y, ‖planeHeight n b c / ‖y - c‖ ^ 4‖ₑ ∂planeMeasure F) < ⊤ + have hnonneg (y : Position) : 0 ≤ planeHeight n b c / ‖y - c‖ ^ 4 := by positivity + simp_rw [Real.enorm_eq_ofReal (hnonneg _)] + rw [lintegral_plane_inverse_fourth_flux n b c hn F ha] + exact ENNReal.ofReal_lt_top + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFluxVolume.lean b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFluxVolume.lean new file mode 100644 index 0000000000..98ef12a431 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitFluxVolume.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.SphereRadial +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitHalfSpaceRadial +public import LeanPool.LiebThirring.Electrostatics.VoronoiDistance + +/-! +# The volume majorant for the exterior cutoff limit + +Exact radial mass outside the closed positive-radius threshold. + +Translation-invariant exact inverse-fourth mass outside a positive-radius ball. +-/ + +public section + +open MeasureTheory Set Metric +open scoped ENNReal + +namespace LiebThirring + +/-- Exact radial mass outside the closed positive-radius threshold. -/ +theorem lintegral_inverse_fourth_outside_origin_ball (a : ℝ) (ha : 0 < a) : + (∫⁻ x : Position, if a ≤ ‖x‖ then ENNReal.ofReal (1 / ‖x‖ ^ 4) else 0) = + ENNReal.ofReal (4 * Real.pi / a) := by + have hf : Measurable (fun r : ℝ => ENNReal.ofReal (1 / r ^ 4)) := + (measurable_const.div (measurable_id.pow_const 4)).ennreal_ofReal + rw [lintegral_norm _ (Measurable.ite measurableSet_Ici hf measurable_const)] + have hrad : (∫⁻ r in Ioi (0 : ℝ), ENNReal.ofReal (r ^ 2) * + (if a ≤ r then ENNReal.ofReal (1 / r ^ 4) else 0)) = + ENNReal.ofReal (Real.pi / a) / ENNReal.ofReal Real.pi := by + have hπ : ENNReal.ofReal Real.pi ≠ 0 := ne_of_gt (ENNReal.ofReal_pos.mpr Real.pi_pos) + apply (ENNReal.eq_div_iff hπ ENNReal.ofReal_ne_top).mpr + rw [← lintegral_const_mul' _ _ ENNReal.ofReal_ne_top] + calc + _ = ∫⁻ r in Ioi (0 : ℝ), (Ici a).indicator + (fun r : ℝ => ENNReal.ofReal (Real.pi / r ^ 2)) r := by + refine setLIntegral_congr_fun measurableSet_Ioi (fun r hr => ?_) + by_cases har : a ≤ r + · rw [ite_eq_left har, indicator_of_mem (show r ∈ Ici a from har), ← ENNReal.ofReal_mul + (sq_nonneg r), + ← ENNReal.ofReal_mul Real.pi_pos.le] + congr 1 + field_simp + · rw [ite_eq_right har, indicator_of_notMem (show r ∉ Ici a from har), mul_zero, mul_zero] + _ = ∫⁻ r in Ici a, ENNReal.ofReal (Real.pi / r ^ 2) := by + rw [setLIntegral_indicator measurableSet_Ici, + inter_eq_left.mpr (show Ici a ⊆ Ioi (0 : ℝ) from fun r hr => ha.trans_le hr)] + _ = _ := lintegral_inverse_square_height a ha + rw [hrad, ← ENNReal.ofReal_div_of_pos Real.pi_pos, + ← ENNReal.ofReal_mul (by positivity : 0 ≤ 4 * Real.pi)] + congr 1 + field_simp + +/-- Translation-invariant exact inverse-fourth mass outside a positive-radius ball. -/ +theorem lintegral_inverse_fourth_outside_ball (c : Position) (a : ℝ) (ha : 0 < a) : + (∫⁻ x in (ball c a)ᶜ, ENNReal.ofReal (1 / ‖x - c‖ ^ 4)) = + ENNReal.ofReal (4 * Real.pi / a) := by + rw [← lintegral_indicator (measurableSet_ball.compl)] + have heq (x : Position) : ((ball c a)ᶜ).indicator + (fun x : Position => ENNReal.ofReal (1 / ‖x - c‖ ^ 4)) x = + (fun z : Position => if a ≤ ‖z‖ then ENNReal.ofReal (1 / ‖z‖ ^ 4) else 0) (x - c) := by + simp only [indicator, mem_compl_iff, mem_ball, dist_eq_norm, not_lt] + simp_rw [heq] + rw [lintegral_sub_right_eq_self (fun z : Position => if a ≤ ‖z‖ then ENNReal.ofReal (1 / ‖z‖ ^ 4) + else 0) c] + exact lintegral_inverse_fourth_outside_origin_ball a ha + +/-- Integrability of the inverse-fourth kernel outside a positive-radius ball. -/ +theorem integrableOn_inverse_fourth_outside_ball (c : Position) (a : ℝ) (ha : 0 < a) : + IntegrableOn (fun x : Position => 1 / ‖x - c‖ ^ 4) (ball c a)ᶜ := by + refine ⟨(measurable_const.div ((measurable_id.sub measurable_const).norm.pow_const + 4)).aestronglyMeasurable, ?_⟩ + change (∫⁻ x in (ball c a)ᶜ, ‖1 / ‖x - c‖ ^ 4‖ₑ) < ⊤ + have hn (x : Position) : 0 ≤ 1 / ‖x - c‖ ^ 4 := by positivity + simp_rw [Real.enorm_eq_ofReal (hn _)] + rw [lintegral_inverse_fourth_outside_ball c a ha] + exact ENNReal.ofReal_lt_top + +/-- Any ball contained in a Voronoi cell gives the exterior volume majorant. -/ +theorem integrableOn_inverse_fourth_exterior_of_ball_subset {M : ℕ} + (R : Fin M → Position) (k : Fin M) (a : ℝ) (ha : 0 < a) + (hball : ball (R k) a ⊆ voronoiCell R k) : + IntegrableOn (fun x : Position => 1 / ‖x - R k‖ ^ 4) (voronoiCell R k)ᶜ := + (integrableOn_inverse_fourth_outside_ball (R k) a ha).mono_set (compl_subset_compl.mpr hball) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/EnergyDeficitGeometry.lean b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitGeometry.lean new file mode 100644 index 0000000000..1d6e6003fe --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitGeometry.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.FaceMeasure +public import LeanPool.LiebThirring.Electrostatics.ShellAssemblyGeometry +import all LeanPool.LiebThirring.Electrostatics.Basic + +/-! +# Nearest-nucleus geometry for the energy deficit + +A finite configuration with at least two nuclei has a nearest other index. + +The finite minimum agrees with the extended nearest-other distance. +-/ + +@[expose] public section + +open MeasureTheory Set +open scoped ENNReal NNReal + +namespace LiebThirring + +variable {M : ℕ} + +/-- A finite configuration with at least two nuclei has a nearest other index. -/ +theorem exists_nearest_other_nucleus (R : Fin M → Position) (hM : 2 ≤ M) (k : Fin M) : + ∃ l : Fin M, l ≠ k ∧ ∀ p : Fin M, p ≠ k → ‖R k - R l‖ ≤ ‖R k - R p‖ := by + classical + have : Nontrivial (Fin M) := Fin.nontrivial_iff_two_le.mpr hM + obtain ⟨l, hl⟩ := exists_ne k + have : Nonempty {p : Fin M // p ≠ k} := ⟨⟨l, hl⟩⟩ + obtain ⟨p, _, hp⟩ := Finset.exists_min_image Finset.univ + (fun p : {p : Fin M // p ≠ k} => ‖R k - R p‖) Finset.univ_nonempty + exact ⟨p, p.property, fun q hq => hp ⟨q, hq⟩ (Finset.mem_univ _)⟩ + +/-- The finite minimum agrees with the extended nearest-other distance. -/ +theorem nearestOtherNucleusDistance_eq_of_nearest (R : Fin M → Position) + {k l : Fin M} (hkl : l ≠ k) + (hl : ∀ p : Fin M, p ≠ k → ‖R k - R l‖ ≤ ‖R k - R p‖) : + nearestOtherNucleusDistance R k = ENNReal.ofReal ‖R k - R l‖ := by + change (⨅ p : {p : Fin M // p ≠ k}, ENNReal.ofReal ‖R k - R p‖) = _ + apply le_antisymm + · exact iInf_le (fun p : {p : Fin M // p ≠ k} => ENNReal.ofReal ‖R k - R p‖) ⟨l, hkl⟩ + · exact le_iInf (fun p => ENNReal.ofReal_le_ofReal (hl p p.property)) + +theorem nearestOtherNucleusDistance_pos (R : Fin M → Position) + (hR : Function.Injective R) (hM : 2 ≤ M) (k : Fin M) : + 0 < nearestOtherNucleusDistance R k := by + obtain ⟨l, hl, hmin⟩ := exists_nearest_other_nucleus R hM k + rw [nearestOtherNucleusDistance_eq_of_nearest R hl hmin] + exact ENNReal.ofReal_pos.mpr (norm_pos_iff.mpr (sub_ne_zero.mpr (hR.ne hl.symm))) + +theorem nearestOtherNucleusDistance_lt_top (R : Fin M → Position) + (hM : 2 ≤ M) (k : Fin M) : nearestOtherNucleusDistance R k < ⊤ := by + obtain ⟨l, hl, hmin⟩ := exists_nearest_other_nucleus R hM k + rw [nearestOtherNucleusDistance_eq_of_nearest R hl hmin] + exact ENNReal.ofReal_lt_top + +theorem nearestOtherNucleusDistance_toReal_pos (R : Fin M → Position) + (hR : Function.Injective R) (hM : 2 ≤ M) (k : Fin M) : + 0 < (nearestOtherNucleusDistance R k).toReal := + ENNReal.toReal_pos (nearestOtherNucleusDistance_pos R hR hM k).ne' + (nearestOtherNucleusDistance_lt_top R hM k).ne + +/-- The nearest-other half-space lies in the cell exterior, with the radius. -/ +theorem exists_nearest_exterior_halfSpace (R : Fin M → Position) + (hR : Function.Injective R) (hM : 2 ≤ M) (k : Fin M) : + ∃ l : Fin M, l ≠ k ∧ + nearestOtherNucleusDistance R k = ENNReal.ofReal ‖R l - R k‖ ∧ + {x : Position | (nearestOtherNucleusDistance R k).toReal / 2 ≤ + inner ℝ (bisectorNormal R k l) (x - R k)} ⊆ (voronoiCell R k)ᶜ := by + obtain ⟨l, hl, hmin⟩ := exists_nearest_other_nucleus R hM k + have he : nearestOtherNucleusDistance R k = ENNReal.ofReal ‖R l - R k‖ := by + rw [nearestOtherNucleusDistance_eq_of_nearest R hl hmin, norm_sub_rev] + refine ⟨l, hl, he, ?_⟩ + rw [he, ENNReal.toReal_ofReal (norm_nonneg _)] + exact exterior_halfSpace_subset_compl_voronoiCell R hR hl.symm + +/-- Every genuine face has either incident nucleus as a nearest one. -/ +theorem nearestNucleusDistance_eq_of_mem_voronoiFace (R : Fin M → Position) + {k l : Fin M} {x : Position} (hx : x ∈ voronoiFace R k l) : + nearestNucleusDistance R x = ENNReal.ofReal ‖x - R k‖ := + nearestNucleusDistance_eq_of_mem_closedVoronoiCell R k (voronoiFace_subset_closed R k l hx) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/EnergyDeficitHalfSpace.lean b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitHalfSpace.lean new file mode 100644 index 0000000000..002420c39f --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitHalfSpace.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitHalfSpaceRadial +public import LeanPool.LiebThirring.Electrostatics.PlanePolar +public import LeanPool.LiebThirring.Electrostatics.SphereCap + +/-! +# Exact inverse-fourth mass of an exterior half-space + +The inverse-fourth planar slice has mass `π/s²` at positive normal height. + +In the volume-preserving height coordinates the inverse-fourth kernel has its literal radial +denominator. +-/ + +public section + +open MeasureTheory Set Filter +open scoped ENNReal Topology + +namespace LiebThirring + +/-- The inverse-fourth planar slice has mass `π/s²` at positive normal height. -/ +theorem lintegral_planar_inverse_fourth (s : ℝ) (hs : 0 < s) : + (∫⁻ q : Planar, ENNReal.ofReal ((s ^ 2 + ‖q‖ ^ 2) ^ 2)⁻¹) = + ENNReal.ofReal (Real.pi / s ^ 2) := by + have hg : Measurable (fun r : ℝ => ENNReal.ofReal ((s ^ 2 + r ^ 2) ^ 2)⁻¹) := + (((measurable_const.add (measurable_id.pow_const 2)).pow_const 2).inv).ennreal_ofReal + rw [lintegral_planar_norm _ hg] + have heq : (∫⁻ r in Ioi (0 : ℝ), ENNReal.ofReal r * + ENNReal.ofReal ((s ^ 2 + r ^ 2) ^ 2)⁻¹) = + ∫⁻ r in Ioi (0 : ℝ), ENNReal.ofReal (r / (s ^ 2 + r ^ 2) ^ 2) := by + refine setLIntegral_congr_fun measurableSet_Ioi (fun r hr => ?_) + rw [← ENNReal.ofReal_mul hr.le, div_eq_mul_inv] + rw [heq, lintegral_inverse_fourth_radial s hs, + ← ENNReal.ofReal_mul (by positivity : 0 ≤ 2 * Real.pi)] + congr 1 + field_simp + +/-- In the volume-preserving height coordinates the inverse-fourth kernel has +its literal radial denominator. -/ +lemma inverse_fourth_sphereHeightSplit (p : ℝ × Planar) : + ‖sphereHeightSplit.symm p‖ ^ 4 = (p.1 ^ 2 + ‖p.2‖ ^ 2) ^ 2 := by + have h := sphereHeightSplit_norm (sphereHeightSplit.symm p) + rw [sphereHeightSplit.apply_symm_apply] at h + calc + _ = (‖sphereHeightSplit.symm p‖ ^ 2) ^ 2 := by ring + _ = _ := congrArg (fun t : ℝ => t ^ 2) h + +/-- Exact inverse-fourth volume integral in the canonical coordinate half-space. -/ +theorem lintegral_inverse_fourth_coordinate_halfSpace {a : ℝ} (ha : 0 < a) : + (∫⁻ x : Position in {x | a ≤ x 2}, ENNReal.ofReal (‖x‖ ^ 4)⁻¹) = + ENNReal.ofReal (Real.pi / a) := by + classical + have hset : MeasurableSet {x : Position | a ≤ x 2} := + isClosed_le continuous_const (PiLp.continuous_apply 2 (fun _ : Fin 3 => ℝ) 2) |>.measurableSet + have hprod : Measurable (fun p : ℝ × Planar => + (Ici a).indicator (fun s : ℝ => ENNReal.ofReal ((s ^ 2 + ‖p.2‖ ^ 2) ^ 2)⁻¹) p.1) := by + have hm : Measurable (fun p : ℝ × Planar => + ENNReal.ofReal ((p.1 ^ 2 + ‖p.2‖ ^ 2) ^ 2)⁻¹) := + (((measurable_fst.pow_const 2).add (measurable_snd.norm.pow_const 2)).pow_const + 2).inv.ennreal_ofReal + exact hm.ite ((measurable_fst measurableSet_Ici)) measurable_const + calc + _ = ∫⁻ p : ℝ × Planar, (Ici a).indicator + (fun s : ℝ => ENNReal.ofReal ((s ^ 2 + ‖p.2‖ ^ 2) ^ 2)⁻¹) p.1 := by + rw [← lintegral_indicator hset, + ← sphereHeightSplit_preserving.symm.lintegral_comp_emb + sphereHeightSplit.symm.measurableEmbedding] + apply lintegral_congr + intro p + have hh : (sphereHeightSplit.symm p) 2 = p.1 := by + rw [← sphereHeightSplit_fst, sphereHeightSplit.apply_symm_apply] + by_cases hp : a ≤ p.1 + · rw [Set.indicator_of_mem (show sphereHeightSplit.symm p ∈ {x : Position | a ≤ x 2} + from by simpa only [mem_ofPred_eq, hh] using hp), Set.indicator_of_mem (show p.1 ∈ Ici a + from hp), + inverse_fourth_sphereHeightSplit] + · rw [Set.indicator_of_notMem (show sphereHeightSplit.symm p ∉ {x : Position | a ≤ x 2} + from fun h => hp (by simpa only [mem_ofPred_eq, hh] using h)), Set.indicator_of_notMem + (show p.1 ∉ Ici a from hp)] + _ = ∫⁻ s in Ici a, ∫⁻ q : Planar, ENNReal.ofReal ((s ^ 2 + ‖q‖ ^ 2) ^ 2)⁻¹ := by + rw [Measure.volume_eq_prod, lintegral_prod _ hprod.aemeasurable] + rw [← lintegral_indicator measurableSet_Ici] + apply lintegral_congr + intro s + by_cases hs : s ∈ Ici a + · simp only [Set.indicator_of_mem hs] + · simp only [Set.indicator_of_notMem hs, lintegral_zero] + _ = ∫⁻ s in Ici a, ENNReal.ofReal (Real.pi / s ^ 2) := by + refine setLIntegral_congr_fun measurableSet_Ici (fun s hs => ?_) + exact lintegral_planar_inverse_fourth s (ha.trans_le hs) + _ = _ := lintegral_inverse_square_height a ha + +/-- Exact inverse-fourth volume mass of an exterior half-space with arbitrary +unit normal and arbitrary centre. This is the energy deficit, equation. -/ +theorem lintegral_inverse_fourth_halfSpace (n c : Position) (hn : ‖n‖ = 1) + {a : ℝ} (ha : 0 < a) : + (∫⁻ x : Position in {x | a ≤ inner ℝ n (x - c)}, + ENNReal.ofReal ((‖x - c‖ ^ 4)⁻¹)) = ENNReal.ofReal (Real.pi / a) := by + classical + let v : Position := EuclideanSpace.single 2 1 + have hv : ‖v‖ = 1 := by simp [v, EuclideanSpace.single, PiLp.norm_single] + let Q : Position ≃ₗᵢ[ℝ] Position := (Submodule.span ℝ {v - n})ᗮ.reflection + have hQ : Q v = n := Submodule.reflection_sub (hv.trans hn.symm) + have hinner (z : Position) : inner ℝ n (Q z) = z 2 := by + rw [← hQ, Q.inner_map_map] + simp only [v, EuclideanSpace.inner_single_left, RCLike.conj_to_real, one_mul] + let e : Position ≃ᵃⁱ[ℝ] Position := + Q.toAffineIsometryEquiv.trans (AffineIsometryEquiv.vaddConst ℝ c) + have hsub (z : Position) : e z - c = Q z := by + change Q z + c - c = Q z + rw [add_sub_cancel_right] + have hmp : MeasurePreserving e (volume : Measure Position) volume := by + change MeasurePreserving (fun z : Position => Q z + c) volume volume + exact (measurePreserving_add_right (volume : Measure Position) c).comp Q.measurePreserving + have hset : MeasurableSet {x : Position | a ≤ inner ℝ n (x - c)} := + isClosed_le continuous_const (continuous_const.inner (continuous_id.sub continuous_const)) + |>.measurableSet + calc + _ = ∫⁻ z : Position, {z : Position | a ≤ z 2}.indicator + (fun z : Position => ENNReal.ofReal ((‖z‖ ^ 4)⁻¹)) z := by + rw [← lintegral_indicator hset, ← hmp.lintegral_comp_emb e.toHomeomorph.measurableEmbedding] + apply lintegral_congr + intro z + simp only [Set.indicator, mem_ofPred_eq, hsub, hinner, Q.norm_map] + _ = _ := by + rw [lintegral_indicator + (isClosed_le continuous_const + (PiLp.continuous_apply 2 (fun _ : Fin 3 => ℝ) 2)).measurableSet] + exact lintegral_inverse_fourth_coordinate_halfSpace ha + +/-- The exact mass supplies the lower bound used by the nearest-nucleus argument. -/ +theorem lintegral_inverse_fourth_halfSpace_le_of_subset (n c : Position) (hn : ‖n‖ = 1) + {a : ℝ} (ha : 0 < a) (E : Set Position) + (hE : {x : Position | a ≤ inner ℝ n (x - c)} ⊆ E) : + ENNReal.ofReal (Real.pi / a) ≤ + ∫⁻ x in E, ENNReal.ofReal ((‖x - c‖ ^ 4)⁻¹) := by + rw [← lintegral_inverse_fourth_halfSpace n c hn ha] + exact lintegral_mono' (Measure.restrict_mono hE le_rfl) le_rfl + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/EnergyDeficitHalfSpaceRadial.lean b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitHalfSpaceRadial.lean new file mode 100644 index 0000000000..5e9837a0f7 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitHalfSpaceRadial.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.MeasureTheory.Integral.IntegralEqImproper + +/-! +# Scalar integrals for the half-space inverse-fourth mass + +Primitive for the planar radial inverse-fourth integrand. + +The radial primitive vanishes at infinity. +-/ + +public section + +open MeasureTheory Filter Set +open scoped ENNReal Topology + +namespace LiebThirring + +/-- Primitive for the planar radial inverse-fourth integrand. -/ +lemma hasDerivAt_inverse_fourth_radial (s r : ℝ) (hs : 0 < s) : + HasDerivAt (fun t : ℝ => -((s ^ 2 + t ^ 2)⁻¹) / 2) + (r / (s ^ 2 + r ^ 2) ^ 2) r := by + have hpos : 0 < s ^ 2 + r ^ 2 := add_pos_of_pos_of_nonneg (sq_pos_of_pos hs) (sq_nonneg r) + have hd : HasDerivAt (fun t : ℝ => s ^ 2 + t ^ 2) (2 * r) r := by + simpa only [Pi.pow_apply, id_eq, Nat.cast_ofNat, Nat.reduceSub, pow_one, mul_one] + using ((hasDerivAt_id r).pow 2).const_add (s ^ 2) + convert (hd.inv (ne_of_gt hpos)).neg.div_const 2 using 1 + field_simp + +/-- The radial primitive vanishes at infinity. -/ +lemma tendsto_inverse_fourth_radial_primitive (s : ℝ) : + Tendsto (fun r : ℝ => -((s ^ 2 + r ^ 2)⁻¹) / 2) atTop (𝓝 0) := by + have hp : Tendsto (fun r : ℝ => s ^ 2 + r ^ 2) atTop atTop := + tendsto_const_nhds.add_atTop (tendsto_pow_atTop (by decide : 2 ≠ 0)) + simpa only [Function.comp_def, neg_zero, zero_div] using (tendsto_inv_atTop_zero.comp + hp).neg.div_const 2 + +/-- The radial inverse-fourth integrand is integrable for positive height. -/ +lemma integrableOn_inverse_fourth_radial (s : ℝ) (hs : 0 < s) : + IntegrableOn (fun r : ℝ => r / (s ^ 2 + r ^ 2) ^ 2) (Ioi 0) := + integrableOn_Ioi_deriv_of_nonneg' + (fun r _ => hasDerivAt_inverse_fourth_radial s r hs) + (fun _r hr => div_nonneg hr.le (sq_nonneg _)) + (tendsto_inverse_fourth_radial_primitive s) + +/-- Exact nonnegative radial inverse-fourth mass at a positive height. -/ +theorem lintegral_inverse_fourth_radial (s : ℝ) (hs : 0 < s) : + (∫⁻ r in Ioi (0 : ℝ), ENNReal.ofReal (r / (s ^ 2 + r ^ 2) ^ 2)) = + ENNReal.ofReal (1 / (2 * s ^ 2)) := by + have hi := integral_Ioi_of_hasDerivAt_of_nonneg' + (fun r (_hr : r ∈ Ici (0 : ℝ)) => hasDerivAt_inverse_fourth_radial s r hs) + (fun _r hr => div_nonneg hr.le (sq_nonneg _)) + (tendsto_inverse_fourth_radial_primitive s) + have hreal : (∫ r in Ioi (0 : ℝ), r / (s ^ 2 + r ^ 2) ^ 2) = 1 / (2 * s ^ 2) := by + calc + _ = -(-(s ^ 2)⁻¹ / 2) := by + simpa only [zero_pow (by decide : 2 ≠ 0), add_zero, zero_sub] using hi + _ = _ := by field_simp + rw [← ofReal_integral_eq_lintegral_ofReal (integrableOn_inverse_fourth_radial s hs) ?_, hreal] + filter_upwards [ae_restrict_mem measurableSet_Ioi] with r hr + exact div_nonneg hr.le (sq_nonneg _) + +/-- Primitive for the positive-height inverse-square integral. -/ +lemma hasDerivAt_inverse_square_height (s : ℝ) (hs : 0 < s) : + HasDerivAt (fun t : ℝ => -Real.pi / t) (Real.pi / s ^ 2) s := by + have hd : HasDerivAt (fun t : ℝ => t⁻¹) (-(s ^ 2)⁻¹) s := by + convert (hasDerivAt_id s).inv (ne_of_gt hs) using 1 + · funext t + rw [Pi.inv_apply, id_eq] + · simp only [id_eq, neg_div, one_div] + convert (hd.const_mul Real.pi).neg using 1 + · funext t + simp only [div_eq_mul_inv, neg_mul, Pi.neg_apply] + · simp only [mul_neg, neg_neg, div_eq_mul_inv] + +/-- The inverse-square height integrand is integrable away from zero. -/ +lemma integrableOn_inverse_square_height (a : ℝ) (ha : 0 < a) : + IntegrableOn (fun s : ℝ => Real.pi / s ^ 2) (Ioi a) := by + have hlim : Tendsto (fun t : ℝ => -Real.pi / t) atTop (𝓝 0) := + tendsto_const_nhds.div_atTop tendsto_id + exact integrableOn_Ioi_deriv_of_nonneg' + (fun s hs => hasDerivAt_inverse_square_height s (ha.trans_le hs)) + (fun s _ => div_nonneg Real.pi_pos.le (sq_nonneg s)) hlim + +/-- Exact nonnegative inverse-square height integral, including its lower endpoint. -/ +theorem lintegral_inverse_square_height (a : ℝ) (ha : 0 < a) : + (∫⁻ s in Ici a, ENNReal.ofReal (Real.pi / s ^ 2)) = ENNReal.ofReal (Real.pi / a) := by + have hlim : Tendsto (fun t : ℝ => -Real.pi / t) atTop (𝓝 0) := + tendsto_const_nhds.div_atTop tendsto_id + have hi := integral_Ioi_of_hasDerivAt_of_nonneg' + (fun s (hs : s ∈ Ici a) => hasDerivAt_inverse_square_height s (ha.trans_le hs)) + (fun s (_hs : s ∈ Ioi a) => div_nonneg Real.pi_pos.le (sq_nonneg s)) hlim + rw [← Measure.restrict_congr_set Ioi_ae_eq_Ici, + ← ofReal_integral_eq_lintegral_ofReal (integrableOn_inverse_square_height a ha) + (Eventually.of_forall (fun s => div_nonneg Real.pi_pos.le (sq_nonneg s)))] + simpa only [zero_sub, neg_div, neg_neg] using congrArg ENNReal.ofReal hi + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/EnergyDeficitIdentity.lean b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitIdentity.lean new file mode 100644 index 0000000000..5401320a3d --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitIdentity.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.FaceMeasure +public import LeanPool.LiebThirring.Electrostatics.Screened +import LeanPool.LiebThirring.Electrostatics.Gaussian +import LeanPool.LiebThirring.Electrostatics.ShellAssemblyGeometry +import all LeanPool.LiebThirring.Electrostatics.Basic +import all LeanPool.LiebThirring.Electrostatics.Screened + +/-! +# Exact energy bookkeeping conditional on the potential identity + +An off-diagonal symmetric finite sum counts its upper triangle twice. + +At a nucleus the screened potential omits that nucleus. +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- An off-diagonal symmetric finite sum counts its upper triangle twice. -/ +theorem sum_erase_eq_two_sum_upper {M : ℕ} (f : Fin M → Fin M → ℝ≥0∞) + (hf : ∀ k l, f k l = f l k) : + (∑ k : Fin M, ∑ l ∈ Finset.univ.erase k, f k l) = + 2 * ∑ k : Fin M, ∑ l ∈ Finset.univ.filter (fun l => k < l), f k l := by + classical + calc + (∑ k : Fin M, ∑ l ∈ Finset.univ.erase k, f k l) = + ∑ k, ∑ l, if l ≠ k then f k l else 0 := by + simp_rw [← Finset.filter_ne', Finset.sum_filter] + _ = 2 * ∑ k : Fin M, ∑ l ∈ Finset.univ.filter (fun l => k < l), f k l := by + simpa [ne_comm] using sum_ne_eq_two_sum_lt f hf + +/-- At a nucleus the screened potential omits that nucleus. -/ +theorem screenedPotential_at_nucleus_eq_sum {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (k : Fin M) : + screenedPotential Z R (R k) = + ∑ l ∈ Finset.univ.erase k, (Z : ℝ≥0∞) * coulombKernel (R k) (R l) := by + apply screenedPotential_eq_of_min + intro l + simp only [sub_self, norm_zero, norm_nonneg] + +/-- Testing the face charge against one nuclear kernel uses exactly the potential identity. -/ +theorem lintegral_nuclear_attraction_of_potential_eq {M : ℕ} + (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) + (hPhi : ∀ x, screenedPotential Z R x = + coulombPotential (voronoiFaceMeasure R hR (Z : ℝ)) x) (k : Fin M) : + (∫⁻ y, (Z : ℝ≥0∞) * coulombKernel y (R k) + ∂voronoiFaceMeasure R hR (Z : ℝ)) = + ∑ l ∈ Finset.univ.erase k, (Z : ℝ≥0∞) ^ 2 * coulombKernel (R k) (R l) := by + rw [lintegral_const_mul _ measurable_coulombKernel.of_uncurry_right] + simp_rw [coulombKernel_symm _ (R k)] + change (Z : ℝ≥0∞) * coulombPotential (voronoiFaceMeasure R hR (Z : ℝ)) (R k) = _ + rw [← hPhi, screenedPotential_at_nucleus_eq_sum, Finset.mul_sum] + apply Finset.sum_congr rfl + intro l _ + simp only [pow_two, mul_assoc] + +/-- Additive exact deficit identity, avoiding subtraction of extended quantities. -/ +theorem energy_add_nearestIntegral_eq_two_repulsion_of_potential_eq {M : ℕ} + (hM : 1 ≤ M) (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) + (hPhi : ∀ x, screenedPotential Z R x = + coulombPotential (voronoiFaceMeasure R hR (Z : ℝ)) x) : + coulombEnergy (voronoiFaceMeasure R hR (Z : ℝ)) (voronoiFaceMeasure R hR (Z : ℝ)) + + (∫⁻ y, (Z : ℝ≥0∞) * (nearestNucleusDistance R y)⁻¹ + ∂voronoiFaceMeasure R hR (Z : ℝ)) = + 2 * nuclearRepulsion (fun _ => Z) R := by + have hm : Measurable (fun y : Position => (Z : ℝ≥0∞) * (nearestNucleusDistance R y)⁻¹) := + measurable_const.mul (measurable_nearestNucleusDistance R).inv + have hsum : (∫⁻ y, ∑ k : Fin M, (Z : ℝ≥0∞) * coulombKernel y (R k) + ∂voronoiFaceMeasure R hR (Z : ℝ)) = 2 * nuclearRepulsion (fun _ => Z) R := by + rw [lintegral_finsetSum] + · simp_rw [lintegral_nuclear_attraction_of_potential_eq Z R hR hPhi] + rw [sum_erase_eq_two_sum_upper] + · simp only [nuclearRepulsion, pow_two] + · intro k l + rw [coulombKernel_symm] + · intro k _ + exact measurable_const.mul measurable_coulombKernel.of_uncurry_right + simp_rw [nuclearPotential_eq_screened_add hM Z R] at hsum + rw [lintegral_add_right _ hm] at hsum + simp_rw [hPhi] at hsum + exact hsum + +/-- The normalized first equality in the energy deficit, with its the potential identity premise +explicit. -/ +theorem half_energy_add_half_nearestIntegral_eq_repulsion_of_potential_eq {M : ℕ} + (hM : 1 ≤ M) (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) + (hPhi : ∀ x, screenedPotential Z R x = + coulombPotential (voronoiFaceMeasure R hR (Z : ℝ)) x) : + coulombEnergy (voronoiFaceMeasure R hR (Z : ℝ)) (voronoiFaceMeasure R hR (Z : ℝ)) / 2 + + (∫⁻ y, (Z : ℝ≥0∞) * (nearestNucleusDistance R y)⁻¹ + ∂voronoiFaceMeasure R hR (Z : ℝ)) / 2 = + nuclearRepulsion (fun _ => Z) R := by + rw [← ENNReal.add_div, energy_add_nearestIntegral_eq_two_repulsion_of_potential_eq hM Z R hR hPhi] + rw [mul_comm (2 : ℝ≥0∞), ENNReal.mul_div_cancel_right] <;> norm_num + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/EnergyDeficitIntegrability.lean b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitIntegrability.lean new file mode 100644 index 0000000000..6c6cb24bdb --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitIntegrability.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitGeometry +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitFluxVolume +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitFluxPlane + +/-! +# Unconditional integrability on the actual Voronoi exteriors and faces + +The literal half nearest-other ball is contained in the open cell. + +The positive-height exclusion applies to the actual nuclear configuration. +-/ + +public section + +open Set MeasureTheory Metric +open scoped ENNReal + +namespace LiebThirring + +/-- The literal half nearest-other ball is contained in the open cell. -/ +theorem ball_nearestOther_half_subset_voronoiCell {M : ℕ} (R : Fin M → Position) + (hM : 2 ≤ M) (k : Fin M) : + ball (R k) ((nearestOtherNucleusDistance R k).toReal / 2) ⊆ voronoiCell R k := by + obtain ⟨l, hl, hmin⟩ := exists_nearest_other_nucleus R hM k + rw [nearestOtherNucleusDistance_eq_of_nearest R hl hmin, + ENNReal.toReal_ofReal (norm_nonneg _)] + apply ball_subset_voronoiCell_of_bound + intro p hp + rw [dist_eq_norm] + linarith only [hmin p hp] + +/-- The positive-height exclusion applies to the actual nuclear configuration. -/ +theorem integrableOn_inverse_fourth_voronoiExterior {M : ℕ} + (R : Fin M → Position) (hR : Function.Injective R) (hM : 2 ≤ M) (k : Fin M) : + IntegrableOn (fun x : Position => 1 / ‖x - R k‖ ^ 4) (voronoiCell R k)ᶜ := + integrableOn_inverse_fourth_exterior_of_ball_subset R k _ + (half_pos (nearestOtherNucleusDistance_toReal_pos R hR hM k)) + (ball_nearestOther_half_subset_voronoiCell R hM k) + +/-- The inverse-fourth flux density is integrable on the whole bisector plane. -/ +theorem integrable_bisector_inverse_fourth_flux {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (k l : Fin M) (hkl : k ≠ l) : + Integrable (fun y : Position => nuclearHalfDistance R k l / ‖y - R k‖ ^ 4) + (bisectorSurfaceMeasure R hR k l hkl) := by + have hh := planeHeight_bisector R hR hkl + have hi := integrable_plane_inverse_fourth_flux (bisectorNormal R k l) + (midpoint ℝ (R k) (R l)) (R k) (norm_bisectorNormal R hR hkl) + (bisectorSurfaceFrame R hR k l hkl) (hh.symm ▸ nuclearHalfDistance_pos R hR hkl) + simpa only [hh, bisectorSurfaceMeasure] using hi + +/-- In particular the actual, potentially unbounded genuine face is integrable. -/ +theorem integrableOn_voronoiFace_inverse_fourth_flux {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (k l : Fin M) (hkl : k ≠ l) : + IntegrableOn (fun y : Position => nuclearHalfDistance R k l / ‖y - R k‖ ^ 4) + (voronoiFace R k l) (bisectorSurfaceMeasure R hR k l hkl) := + (integrable_bisector_inverse_fourth_flux R hR k l hkl).restrict + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/EnergyDeficitLimits.lean b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitLimits.lean new file mode 100644 index 0000000000..cf3cd46d1a --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitLimits.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitIntegrability +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitFluxCutoff + +/-! +# The actual Voronoi volume and boundary cutoff limits + +The principal exterior volume term converges on the actual exterior. + +The radial derivative error tends to zero on the actual exterior. +-/ + +public section + +open Set MeasureTheory Filter +open scoped ENNReal Topology + +namespace LiebThirring + +/-- The principal exterior volume term converges on the actual exterior. -/ +theorem tendsto_integral_cutoff_voronoiExterior {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (hM : 2 ≤ M) (k : Fin M) : + Tendsto (fun T : ℝ => ∫ x in (voronoiCell R k)ᶜ, + exteriorFluxCutoff (R k) T x * (1 / ‖x - R k‖ ^ 4)) atTop + (𝓝 (∫ x in (voronoiCell R k)ᶜ, 1 / ‖x - R k‖ ^ 4)) := + tendsto_integral_exteriorFluxCutoff _ (R k) _ + (integrableOn_inverse_fourth_voronoiExterior R hR hM k) + +/-- The radial derivative error tends to zero on the actual exterior. -/ +theorem tendsto_integral_defect_voronoiExterior {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (hM : 2 ≤ M) (k : Fin M) : + Tendsto (fun T : ℝ => ∫ x in (voronoiCell R k)ᶜ, + exteriorFluxDefect (T⁻¹ • (x - R k)) * (1 / ‖x - R k‖ ^ 4)) atTop (𝓝 0) := + tendsto_integral_exteriorFluxDefect _ (R k) _ + (integrableOn_inverse_fourth_voronoiExterior R hR hM k) + +/-- Every actual boundary term converges, including on unbounded genuine faces. -/ +theorem tendsto_integral_cutoff_voronoiFace {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (k l : Fin M) (hkl : k ≠ l) : + Tendsto (fun T : ℝ => ∫ y in voronoiFace R k l, + exteriorFluxCutoff (R k) T y * (nuclearHalfDistance R k l / ‖y - R k‖ ^ 4) + ∂bisectorSurfaceMeasure R hR k l hkl) atTop + (𝓝 (∫ y in voronoiFace R k l, nuclearHalfDistance R k l / ‖y - R k‖ ^ 4 + ∂bisectorSurfaceMeasure R hR k l hkl)) := + tendsto_integral_exteriorFluxCutoff _ (R k) _ + (integrableOn_voronoiFace_inverse_fourth_flux R hR k l hkl) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/EnergyDeficitLowerBound.lean b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitLowerBound.lean new file mode 100644 index 0000000000..9ea2782b7a --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitLowerBound.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitGeometry +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitHalfSpace + +/-! +# Exterior half-space lower bound for the Baxter correction + +Exact normalization of one half-space contribution. + +Each exterior contributes the required nearest-other inverse distance. +-/ + +public section + +open Set MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- Exact normalization of one half-space contribution. -/ +theorem inverse_fourth_halfSpace_coefficient (Z : ℝ≥0) (d : ℝ) (hd : 0 < d) : + ENNReal.ofReal ((Z : ℝ) ^ 2 / (8 * Real.pi)) * ENNReal.ofReal (Real.pi / (d / 2)) = + (Z : ℝ≥0∞) ^ 2 / 4 * (ENNReal.ofReal d)⁻¹ := by + rw [← ENNReal.ofReal_mul (by positivity : 0 ≤ (Z : ℝ) ^ 2 / (8 * Real.pi)), + ← ENNReal.ofReal_inv_of_pos hd] + have hz : (Z : ℝ≥0∞) = ENNReal.ofReal (Z : ℝ) := ENNReal.coe_nnreal_eq Z + rw [hz, ← ENNReal.ofReal_pow (NNReal.coe_nonneg Z) 2, ← ENNReal.ofReal_ofNat (n := 4), + ← ENNReal.ofReal_div_of_pos (by norm_num : (0 : ℝ) < 4), + ← ENNReal.ofReal_mul (by positivity : 0 ≤ (Z : ℝ) ^ 2 / 4)] + congr 1 + field_simp + ring + +/-- Each exterior contributes the required nearest-other inverse distance. -/ +theorem baxterCorrection_summand_le_exterior_integral {M : ℕ} + (hM : 2 ≤ M) (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) + (k : Fin M) : + (Z : ℝ≥0∞) ^ 2 / 4 * (nearestOtherNucleusDistance R k)⁻¹ ≤ + ENNReal.ofReal ((Z : ℝ) ^ 2 / (8 * Real.pi)) * + ∫⁻ x in (voronoiCell R k)ᶜ, ENNReal.ofReal ((‖x - R k‖ ^ 4)⁻¹) := by + obtain ⟨l, hl, he, hsub⟩ := exists_nearest_exterior_halfSpace R hR hM k + have hd : 0 < ‖R l - R k‖ := norm_pos_iff.mpr (sub_ne_zero.mpr (hR.ne hl)) + have hsub' : {x : Position | ‖R l - R k‖ / 2 ≤ inner ℝ (bisectorNormal R k l) (x - R k)} ⊆ + (voronoiCell R k)ᶜ := by + simpa only [he, ENNReal.toReal_ofReal (norm_nonneg _)] using hsub + rw [he, ← inverse_fourth_halfSpace_coefficient Z _ hd] + exact mul_le_mul_right + (lintegral_inverse_fourth_halfSpace_le_of_subset (bisectorNormal R k l) (R k) + (norm_bisectorNormal R hR hl.symm) (half_pos hd) _ hsub') _ + +/-- The entire nearest-nucleus correction is bounded by the exterior integral sum. -/ +theorem baxterCorrection_le_exterior_integrals {M : ℕ} + (hM : 2 ≤ M) (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) : + baxterCorrection Z R ≤ ENNReal.ofReal ((Z : ℝ) ^ 2 / (8 * Real.pi)) * + ∑ k : Fin M, ∫⁻ x in (voronoiCell R k)ᶜ, ENNReal.ofReal ((‖x - R k‖ ^ 4)⁻¹) := by + rw [baxterCorrection, Finset.mul_sum, Finset.mul_sum] + exact Finset.sum_le_sum fun k _ => baxterCorrection_summand_le_exterior_integral hM Z R hR k + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/EnergyDeficitTrivial.lean b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitTrivial.lean new file mode 100644 index 0000000000..86beb766bd --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/EnergyDeficitTrivial.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.FaceMeasure +public import LeanPool.LiebThirring.Electrostatics.Screened +import all LeanPool.LiebThirring.Electrostatics.Basic + +/-! +# Trivial cases of the energy deficit + +The square-completion deficit input is unconditional when the charge is zero. + +The square-completion deficit input for one nucleus is entirely unconditional. +-/ + +public section + +open Set MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring + +@[simp] theorem baxterCorrection_one (Z : ℝ≥0) (R : Fin 1 → Position) : + baxterCorrection Z R = 0 := by + simp [baxterCorrection] + +@[simp] theorem nuclearRepulsion_one (Z : ℝ≥0) (R : Fin 1 → Position) : + nuclearRepulsion (fun _ => Z) R = 0 := by + classical + have hi (k : Fin 1) : Finset.univ.filter (fun l : Fin 1 => k < l) = ∅ := by + ext l + simp only [Finset.mem_filter, Finset.mem_univ, true_and, Finset.notMem_empty, iff_false] + exact not_lt_of_ge (le_of_eq (Subsingleton.elim _ _)) + simp only [nuclearRepulsion, hi, Finset.sum_empty, Finset.sum_const_zero] + +/-- The square-completion deficit input for one nucleus is entirely unconditional. -/ +theorem energyDeficit_one (Z : ℝ≥0) (R : Fin 1 → Position) (hR : Function.Injective R) : + coulombEnergy (voronoiFaceMeasure R hR (Z : ℝ)) (voronoiFaceMeasure R hR (Z : ℝ)) / 2 + + baxterCorrection Z R ≤ nuclearRepulsion (fun _ => Z) R := by + simp [coulombEnergy, voronoiFaceMeasure_one] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/FaceMeasure.lean b/LeanPool/LiebThirring/Electrostatics/FaceMeasure.lean new file mode 100644 index 0000000000..be38688b5d --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/FaceMeasure.lean @@ -0,0 +1,127 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureDirected +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureMass +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureDensityDecay +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureDecay +import all LeanPool.LiebThirring.Electrostatics.Basic + +/-! +# Analytic bounds for the positive Voronoi face measure + +The explicit Voronoi face charge satisfies the finite-mass, energy, and decay bounds required by +the potential argument. +-/ + +@[expose] public section + +open Set MeasureTheory Filter +open scoped ENNReal Topology + +namespace LiebThirring + +variable {M : ℕ} + +/-- The actual face potential is everywhere finite, including at face points. -/ +theorem coulombPotential_voronoiFaceMeasure_lt_top (R : Fin M → Position) + (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) (x : Position) : + coulombPotential (voronoiFaceMeasure R hR Z) x < ⊤ := by + have := isFiniteMeasure_voronoiFaceMeasure R hR hZ + exact coulombPotential_lt_top_of_local_bound _ _ + (fun x _ε hε => lintegral_coulombKernel_ball_voronoiFaceMeasure_le R hR hZ x hε) x + +/-- Self-energy is finite as a consequence of the proved uniform potential bound. -/ +theorem coulombEnergy_voronoiFaceMeasure_lt_top (R : Fin M → Position) + (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) : + coulombEnergy (voronoiFaceMeasure R hR Z) (voronoiFaceMeasure R hR Z) < ⊤ := by + have := isFiniteMeasure_voronoiFaceMeasure R hR hZ + exact coulombEnergy_lt_top_of_local_bound _ _ + (fun x _ε hε => lintegral_coulombKernel_ball_voronoiFaceMeasure_le R hR hZ x hε) + +/-- The finite potential, regarded as a real function, is also continuous. -/ +theorem continuous_toReal_coulombPotential_voronoiFaceMeasure (R : Fin M → Position) + (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) : + Continuous (fun x => (coulombPotential (voronoiFaceMeasure R hR Z) x).toReal) := by + have := isFiniteMeasure_voronoiFaceMeasure R hR hZ + exact continuous_toReal_coulombPotential_of_local_bound _ _ + (voronoiLocalCoefficient_nonneg R hZ) + (fun x _ε hε => lintegral_coulombKernel_ball_voronoiFaceMeasure_le R hR hZ x hε) + +/-- Explicit data-dependent coefficient in (6.2). -/ +noncomputable def voronoiDecayCoefficient (R : Fin M → Position) (Z : ℝ) : ℝ := + ∑ p : NuclearPair M, (4 * Real.pi * nuclearFaceDensityBound R Z p.val.1 p.val.2 + + 6 * Z + 16 * Real.pi * nuclearFaceDecayCoefficient R Z p.val.1 p.val.2) + +theorem voronoiDecayCoefficient_nonneg (R : Fin M → Position) {Z : ℝ} (hZ : 0 ≤ Z) : + 0 ≤ voronoiDecayCoefficient R Z := by + unfold voronoiDecayCoefficient + apply Finset.sum_nonneg + intro p _ + have hB := nuclearFaceDensityBound_nonneg R hZ p.val.1 p.val.2 + have hA := nuclearFaceDecayCoefficient_nonneg R hZ p.val.1 p.val.2 + positivity + +/-- Apply cubic density decay and the exact planar kernel estimate to one face. -/ +theorem coulombPotential_nuclearFaceMeasure_decay (R : Fin M → Position) + (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) + (k l : Fin M) (hkl : k ≠ l) (x : Position) : + coulombPotential (nuclearFaceMeasure R hR Z k l hkl) x ≤ ENNReal.ofReal + ((4 * Real.pi * nuclearFaceDensityBound R Z k l + 6 * Z + + 16 * Real.pi * nuclearFaceDecayCoefficient R Z k l) / (1 + ‖x‖)) := by + exact coulombPotential_withDensity_planeMeasure_decay (bisectorNormal R k l) + (midpoint ℝ (R k) (R l)) (norm_bisectorNormal R hR hkl) + (bisectorSurfaceFrame R hR k l hkl) (voronoiFaceDensity R Z k l) + (measurable_voronoiFaceDensity R Z k l) _ _ Z + (nuclearFaceDecayCoefficient_nonneg R hZ k l) (nuclearFaceDensityBound_nonneg R hZ k l) hZ + (Eventually.of_forall (voronoiFaceDensity_le_bound R hR hZ k l hkl)) + (Eventually.of_forall (voronoiFaceDensity_le_decay R hR hZ k l hkl)) + (nuclearFaceMeasure_mass_le R hR hZ k l hkl) x + +/-- Equation (6.2), with an explicit coefficient depending only on the nuclei and charge. -/ +theorem coulombPotential_voronoiFaceMeasure_decay (R : Fin M → Position) + (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) (x : Position) : + coulombPotential (voronoiFaceMeasure R hR Z) x ≤ + ENNReal.ofReal (voronoiDecayCoefficient R Z / (1 + ‖x‖)) := by + change (∫⁻ y, coulombKernel x y ∂voronoiFaceMeasure R hR Z) ≤ _ + rw [voronoiFaceMeasure, lintegral_finsetSum_measure] + calc + _ ≤ ∑ p : NuclearPair M, ENNReal.ofReal + ((4 * Real.pi * nuclearFaceDensityBound R Z p.val.1 p.val.2 + 6 * Z + + 16 * Real.pi * nuclearFaceDecayCoefficient R Z p.val.1 p.val.2) / (1 + ‖x‖)) := + Finset.sum_le_sum fun p _ => coulombPotential_nuclearFaceMeasure_decay R hR hZ _ _ _ x + _ = _ := by + rw [← ENNReal.ofReal_sum_of_nonneg] + · congr 1 + simp only [voronoiDecayCoefficient, Finset.sum_div] + · intro p _ + have hB := nuclearFaceDensityBound_nonneg R hZ p.val.1 p.val.2 + have hA := nuclearFaceDecayCoefficient_nonneg R hZ p.val.1 p.val.2 + positivity + +/-- The decay at infinity used in the potential identity. -/ +theorem tendsto_coulombPotential_voronoiFaceMeasure_zero (R : Fin M → Position) + (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) : + Tendsto (coulombPotential (voronoiFaceMeasure R hR Z)) + (Bornology.cobounded Position) (𝓝 0) := + tendsto_coulombPotential_zero_of_decay _ _ (coulombPotential_voronoiFaceMeasure_decay R hR hZ) + +/-- The finite real-valued potential tends to zero at infinity as well. -/ +theorem tendsto_toReal_coulombPotential_voronoiFaceMeasure_zero (R : Fin M → Position) + (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) : + Tendsto (fun x => (coulombPotential (voronoiFaceMeasure R hR Z) x).toReal) + (Bornology.cobounded Position) (𝓝 0) := by + simpa only [ENNReal.toReal_zero, Function.comp_def] using + (ENNReal.tendsto_toReal ENNReal.zero_ne_top).comp + (tendsto_coulombPotential_voronoiFaceMeasure_zero R hR hZ) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/FaceMeasureBasic.lean b/LeanPool/LiebThirring/Electrostatics/FaceMeasureBasic.lean new file mode 100644 index 0000000000..4a32594a88 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/FaceMeasureBasic.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.MeasureTheory.Measure.WithDensity +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureGeometry + +/-! +# The positive measure of genuine Voronoi faces + +Unordered nuclear pairs, represented by their increasing ordering. + +The real density on a bisector plane, as prescribed in. +-/ + +@[expose] public section + +open Set MeasureTheory +open scoped ENNReal + +namespace LiebThirring + +variable {M : ℕ} + +/-- Unordered nuclear pairs, represented by their increasing ordering. -/ +abbrev NuclearPair (M : ℕ) := {p : Fin M × Fin M // p.1 < p.2} + +/-- The real density on a bisector plane, as prescribed in (6.1). -/ +noncomputable def nuclearFaceDensity (R : Fin M → Position) (Z : ℝ) + (k l : Fin M) (y : Position) : ℝ := + Z * nuclearHalfDistance R k l / (2 * Real.pi * ‖y - R k‖ ^ 3) + +/-- Extend the nonnegative density by zero off the genuine face. -/ +noncomputable def voronoiFaceDensity (R : Fin M → Position) (Z : ℝ) + (k l : Fin M) : Position → ℝ≥0∞ := + (voronoiFace R k l).indicator (fun y => ENNReal.ofReal (nuclearFaceDensity R Z k l y)) + +/-- One genuine face, equipped with its surface charge. -/ +noncomputable def nuclearFaceMeasure (R : Fin M → Position) (hR : Function.Injective R) + (Z : ℝ) (k l : Fin M) (hkl : k ≠ l) : Measure Position := + (bisectorSurfaceMeasure R hR k l hkl).withDensity (voronoiFaceDensity R Z k l) + +/-- The positive measure `ν` of (6.1); each genuine face occurs once. -/ +noncomputable def voronoiFaceMeasure (R : Fin M → Position) (hR : Function.Injective R) + (Z : ℝ) : Measure Position := + ∑ p : NuclearPair M, nuclearFaceMeasure R hR Z p.val.1 p.val.2 (ne_of_lt p.property) + +theorem measurable_nuclearFaceDensity (R : Fin M → Position) (Z : ℝ) (k l : Fin M) : + Measurable (nuclearFaceDensity R Z k l) := by + unfold nuclearFaceDensity + exact measurable_const.div (measurable_const.mul ((measurable_id.sub + measurable_const).norm.pow_const 3)) + +theorem measurable_voronoiFaceDensity (R : Fin M → Position) (Z : ℝ) (k l : Fin M) : + Measurable (voronoiFaceDensity R Z k l) := + (measurable_nuclearFaceDensity R Z k l).ennreal_ofReal.indicator + (measurableSet_voronoiFace R k l) + +theorem nuclearFaceDensity_nonneg (R : Fin M → Position) {Z : ℝ} (hZ : 0 ≤ Z) + (k l : Fin M) (y : Position) : 0 ≤ nuclearFaceDensity R Z k l y := by + unfold nuclearFaceDensity nuclearHalfDistance + positivity + +/-- The defining nonnegative Borel integral formula, with explicit face restriction. -/ +theorem lintegral_nuclearFaceMeasure (R : Fin M → Position) (hR : Function.Injective R) + (Z : ℝ) (k l : Fin M) (hkl : k ≠ l) (h : Position → ℝ≥0∞) (hh : Measurable h) : + (∫⁻ y, h y ∂nuclearFaceMeasure R hR Z k l hkl) = + ∫⁻ y in voronoiFace R k l, + ENNReal.ofReal (nuclearFaceDensity R Z k l y) * h y + ∂bisectorSurfaceMeasure R hR k l hkl := by + rw [nuclearFaceMeasure, lintegral_withDensity_eq_lintegral_mul _ + (measurable_voronoiFaceDensity R Z k l) hh] + rw [← lintegral_indicator (measurableSet_voronoiFace R k l)] + apply lintegral_congr + intro y + by_cases hy : y ∈ voronoiFace R k l <;> simp [voronoiFaceDensity, hy] + +@[simp] theorem voronoiFaceMeasure_one (R : Fin 1 → Position) (hR : Function.Injective R) + (Z : ℝ) : voronoiFaceMeasure R hR Z = 0 := by + have : IsEmpty (NuclearPair 1) := ⟨fun p => by + have he : p.val.1 = p.val.2 := Subsingleton.elim _ _ + exact (ne_of_lt p.property) he⟩ + simp [voronoiFaceMeasure] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/FaceMeasureBounds.lean b/LeanPool/LiebThirring/Electrostatics/FaceMeasureBounds.lean new file mode 100644 index 0000000000..128cda625e --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/FaceMeasureBounds.lean @@ -0,0 +1,128 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureBasic +public import LeanPool.LiebThirring.Electrostatics.PlaneLocal + +/-! +# Density bounds and local Coulomb integrals of the face measure + +Uniform bound of the density on one plane. + +Domination by bounded-density surface measure, with its literal coefficient. +-/ + +@[expose] public section + +open Set MeasureTheory +open scoped ENNReal + +namespace LiebThirring + +variable {M : ℕ} + +/-- Uniform bound of the density on one plane. -/ +noncomputable def nuclearFaceDensityBound (R : Fin M → Position) (Z : ℝ) (k l : Fin M) : ℝ := + Z / (2 * Real.pi * nuclearHalfDistance R k l ^ 2) + +theorem nuclearFaceDensityBound_nonneg (R : Fin M → Position) {Z : ℝ} (hZ : 0 ≤ Z) + (k l : Fin M) : 0 ≤ nuclearFaceDensityBound R Z k l := by + unfold nuclearFaceDensityBound + positivity + +theorem nuclearFaceDensity_le_bound (R : Fin M → Position) (hR : Function.Injective R) + {Z : ℝ} (hZ : 0 ≤ Z) {k l : Fin M} (hkl : k ≠ l) {y : Position} + (hy : y ∈ bisectorPlane R k l) : + nuclearFaceDensity R Z k l y ≤ nuclearFaceDensityBound R Z k l := by + have ha := nuclearHalfDistance_pos R hR hkl + have hr := nuclearHalfDistance_le_norm_on_bisector R hR hkl hy + have hc : nuclearFaceDensity R Z k l y ≤ + Z * nuclearHalfDistance R k l / (2 * Real.pi * nuclearHalfDistance R k l ^ 3) := by + apply div_le_div_of_nonneg_left (mul_nonneg hZ ha.le) + (by positivity : 0 < 2 * Real.pi * nuclearHalfDistance R k l ^ 3) + exact mul_le_mul_of_nonneg_left (pow_le_pow_left₀ ha.le hr 3) (by positivity) + have he : Z * nuclearHalfDistance R k l / (2 * Real.pi * nuclearHalfDistance R k l ^ 3) = + nuclearFaceDensityBound R Z k l := by + unfold nuclearFaceDensityBound + field_simp + exact hc.trans_eq he + +theorem voronoiFaceDensity_le_bound (R : Fin M → Position) (hR : Function.Injective R) + {Z : ℝ} (hZ : 0 ≤ Z) (k l : Fin M) (hkl : k ≠ l) (y : Position) : + voronoiFaceDensity R Z k l y ≤ ENNReal.ofReal (nuclearFaceDensityBound R Z k l) := by + by_cases hy : y ∈ voronoiFace R k l + · rw [voronoiFaceDensity, indicator_of_mem hy] + exact ENNReal.ofReal_le_ofReal (nuclearFaceDensity_le_bound R hR hZ hkl hy.2.1) + · simp only [voronoiFaceDensity, indicator_of_notMem hy, zero_le] + +/-- Domination by bounded-density surface measure, with its literal coefficient. -/ +theorem nuclearFaceMeasure_le_smul_surface (R : Fin M → Position) + (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) + (k l : Fin M) (hkl : k ≠ l) : + nuclearFaceMeasure R hR Z k l hkl ≤ + ENNReal.ofReal (nuclearFaceDensityBound R Z k l) • bisectorSurfaceMeasure R hR k l hkl := by + rw [nuclearFaceMeasure, ← withDensity_const] + exact withDensity_mono (Filter.Eventually.of_forall + (voronoiFaceDensity_le_bound R hR hZ k l hkl)) + +/-- The local estimate includes off-plane centres and the infinite kernel value. -/ +theorem lintegral_coulombKernel_ball_nuclearFaceMeasure_le + (R : Fin M → Position) (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) + (k l : Fin M) (hkl : k ≠ l) (x : Position) {ε : ℝ} (hε : 0 < ε) : + (∫⁻ y in Metric.ball x ε, coulombKernel x y ∂nuclearFaceMeasure R hR Z k l hkl) ≤ + ENNReal.ofReal (2 * Real.pi * ε * nuclearFaceDensityBound R Z k l) := by + have hle := lintegral_mono' (Measure.restrict_mono_measure + (nuclearFaceMeasure_le_smul_surface R hR hZ k l hkl) (Metric.ball x ε)) + (le_refl (fun y => coulombKernel x y)) + rw [Measure.restrict_smul, lintegral_smul_measure] at hle + have hb := lintegral_coulombKernel_ball_planeMeasure_le + (bisectorNormal R k l) (midpoint ℝ (R k) (R l)) x + (norm_bisectorNormal R hR hkl) (bisectorSurfaceFrame R hR k l hkl) hε + have hprod := mul_le_mul (le_refl (ENNReal.ofReal (nuclearFaceDensityBound R Z k l))) hb (by + positivity) (by positivity) + have he : ENNReal.ofReal (nuclearFaceDensityBound R Z k l) * ENNReal.ofReal (2 * Real.pi * ε) = + ENNReal.ofReal (2 * Real.pi * ε * nuclearFaceDensityBound R Z k l) := by + rw [← ENNReal.ofReal_mul (nuclearFaceDensityBound_nonneg R hZ k l), mul_comm] + exact hle.trans (hprod.trans_eq he) + +/-- The coefficient in the uniform local singular-integral bound (6.4). -/ +noncomputable def voronoiLocalCoefficient (R : Fin M → Position) (Z : ℝ) : ℝ := + 2 * Real.pi * ∑ p : NuclearPair M, nuclearFaceDensityBound R Z p.val.1 p.val.2 + +theorem voronoiLocalCoefficient_nonneg (R : Fin M → Position) {Z : ℝ} (hZ : 0 ≤ Z) : + 0 ≤ voronoiLocalCoefficient R Z := by + apply mul_nonneg (by positivity) + exact Finset.sum_nonneg fun p _ => nuclearFaceDensityBound_nonneg R hZ _ _ + +/-- Equation (6.4) for the actual unordered-face measure. -/ +theorem lintegral_coulombKernel_ball_voronoiFaceMeasure_le + (R : Fin M → Position) (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) + (x : Position) {ε : ℝ} (hε : 0 < ε) : + (∫⁻ y in Metric.ball x ε, coulombKernel x y ∂voronoiFaceMeasure R hR Z) ≤ + ENNReal.ofReal (voronoiLocalCoefficient R Z * ε) := by + rw [voronoiFaceMeasure, ← Measure.sum_fintype, Measure.restrict_sum _ + Metric.isOpen_ball.measurableSet, + lintegral_sum_measure, tsum_fintype] + calc + _ ≤ ∑ p : NuclearPair M, + ENNReal.ofReal (2 * Real.pi * ε * nuclearFaceDensityBound R Z p.val.1 p.val.2) := + Finset.sum_le_sum fun p _ => + lintegral_coulombKernel_ball_nuclearFaceMeasure_le R hR hZ _ _ _ x hε + _ = ENNReal.ofReal (voronoiLocalCoefficient R Z * ε) := by + rw [← ENNReal.ofReal_sum_of_nonneg] + · congr 1 + simp only [voronoiLocalCoefficient, ← Finset.mul_sum] + ring + · intro p _ + exact mul_nonneg (by positivity) (nuclearFaceDensityBound_nonneg R hZ _ _) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/FaceMeasureDecay.lean b/LeanPool/LiebThirring/Electrostatics/FaceMeasureDecay.lean new file mode 100644 index 0000000000..501c24f60d --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/FaceMeasureDecay.lean @@ -0,0 +1,237 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.FaceMeasurePotential +import all LeanPool.LiebThirring.Electrostatics.Basic +public import LeanPool.LiebThirring.Electrostatics.PlaneLocal + +/-! +# Decay of Coulomb potentials of planar densities + +Away from a radius `r > 0`, the Coulomb kernel is bounded by `1/r`. + +The far Coulomb contribution of any positive measure is controlled by its mass. +-/ + +public section + +open MeasureTheory Set Filter +open scoped ENNReal Topology + +namespace LiebThirring + +/-- Away from a radius `r > 0`, the Coulomb kernel is bounded by `1/r`. -/ +lemma coulombKernel_le_of_le_norm_sub (x y : Position) {r : ℝ} + (hr : 0 < r) (hxy : r ≤ ‖x - y‖) : + coulombKernel x y ≤ ENNReal.ofReal (1 / r) := by + rw [one_div, ENNReal.ofReal_inv_of_pos hr] + exact ENNReal.inv_le_inv.2 (ENNReal.ofReal_le_ofReal hxy) + +/-- The far Coulomb contribution of any positive measure is controlled by its mass. -/ +theorem lintegral_coulombKernel_compl_ball_le (μ : Measure Position) (x : Position) + {r : ℝ} (hr : 0 < r) : + (∫⁻ y in (Metric.ball x r)ᶜ, coulombKernel x y ∂μ) ≤ + ENNReal.ofReal (1 / r) * μ univ := by + calc + _ ≤ ∫⁻ _y in (Metric.ball x r)ᶜ, ENNReal.ofReal (1 / r) ∂μ := by + apply lintegral_mono_ae + filter_upwards [ae_restrict_mem Metric.isOpen_ball.measurableSet.compl] with y hy + apply coulombKernel_le_of_le_norm_sub x y hr + simpa only [mem_compl_iff, Metric.mem_ball, not_lt, dist_eq_norm, norm_sub_rev] using hy + _ ≤ _ := by + rw [lintegral_const, Measure.restrict_apply_univ] + exact mul_le_mul_right (measure_mono (subset_univ _)) _ + +/-- planar integration controls any planar density bounded on the indicated ball. -/ +theorem lintegral_coulombKernel_ball_withDensity_le (n b x : Position) + (hn : ‖n‖ = 1) (F : PlaneFrame (affinePlane n b)) + (f : Position → ℝ≥0∞) (hf : Measurable f) (B : ℝ) {r : ℝ} (hr : 0 < r) + (hfB : ∀ᵐ y ∂(planeMeasure F).restrict (Metric.ball x r), f y ≤ ENNReal.ofReal B) : + (∫⁻ y in Metric.ball x r, coulombKernel x y ∂(planeMeasure F).withDensity f) ≤ + ENNReal.ofReal B * ENNReal.ofReal (2 * Real.pi * r) := by + rw [restrict_withDensity Metric.isOpen_ball.measurableSet, + lintegral_withDensity_eq_lintegral_mul _ hf (measurable_coulombKernel_right x)] + calc + _ ≤ ∫⁻ y in Metric.ball x r, ENNReal.ofReal B * coulombKernel x y ∂planeMeasure F := by + apply lintegral_mono_ae + filter_upwards [hfB] with y hy + exact mul_le_mul_left hy _ + _ = ENNReal.ofReal B * ∫⁻ y in Metric.ball x r, coulombKernel x y ∂planeMeasure F := + lintegral_const_mul _ (measurable_coulombKernel_right x) + _ ≤ _ := mul_le_mul_right + (lintegral_coulombKernel_ball_planeMeasure_le n b x hn F hr) _ + +/-- Uniform potential bound for a bounded planar density of bounded mass. -/ +theorem coulombPotential_withDensity_planeMeasure_le (n b : Position) + (hn : ‖n‖ = 1) (F : PlaneFrame (affinePlane n b)) + (f : Position → ℝ≥0∞) (hf : Measurable f) (B m : ℝ) + (hB : 0 ≤ B) (hm : 0 ≤ m) + (hfB : ∀ᵐ y ∂planeMeasure F, f y ≤ ENNReal.ofReal B) + (hmass : (planeMeasure F).withDensity f univ ≤ ENNReal.ofReal m) (x : Position) : + coulombPotential ((planeMeasure F).withDensity f) x ≤ + ENNReal.ofReal (2 * Real.pi * B + m) := by + unfold coulombPotential + rw [← lintegral_add_compl _ (Metric.isOpen_ball.measurableSet : MeasurableSet (Metric.ball x 1))] + calc + _ ≤ ENNReal.ofReal B * ENNReal.ofReal (2 * Real.pi * 1) + + ENNReal.ofReal (1 / (1 : ℝ)) * (planeMeasure F).withDensity f univ := + add_le_add + (lintegral_coulombKernel_ball_withDensity_le n b x hn F f hf B + zero_lt_one (ae_restrict_of_ae hfB)) + (lintegral_coulombKernel_compl_ball_le _ x zero_lt_one) + _ ≤ ENNReal.ofReal B * ENNReal.ofReal (2 * Real.pi) + ENNReal.ofReal m := by + simpa only [mul_one, div_one, ENNReal.ofReal_one, one_mul] using + add_le_add (le_refl (ENNReal.ofReal B * ENNReal.ofReal (2 * Real.pi))) hmass + _ = _ := by + rw [← ENNReal.ofReal_mul hB, mul_comm B, ENNReal.ofReal_add (by positivity) hm] + +/-- Scalar cubic decay bound outside half the observation radius. -/ +lemma cubic_decay_le_half_radius (A R t : ℝ) (hA : 0 ≤ A) (hR : 0 < R) + (ht : 0 ≤ t) (hRt : R / 2 ≤ t) : + A / (1 + t) ^ 3 ≤ 8 * A / R ^ 3 := by + have hden : 0 < 1 + t := add_pos_of_pos_of_nonneg zero_lt_one ht + have hbase : R ≤ 2 * (1 + t) := by linarith only [hRt] + have hcube : R ^ 3 ≤ 8 * (1 + t) ^ 3 := by + calc + R ^ 3 ≤ (2 * (1 + t)) ^ 3 := pow_le_pow_left₀ hR.le hbase 3 + _ = _ := by ring + rw [div_le_div_iff₀ (pow_pos hden 3) (pow_pos hR 3)] + calc + A * R ^ 3 ≤ A * (8 * (1 + t) ^ 3) := mul_le_mul_of_nonneg_left hcube hA + _ = _ := by ring + +/-- Points in the observation ball of half-radius lie outside half the origin-radius. -/ +lemma half_norm_le_of_mem_ball (x y : Position) + (hy : y ∈ Metric.ball x (‖x‖ / 2)) : ‖x‖ / 2 ≤ ‖y‖ := by + have htri : ‖x‖ ≤ ‖x - y‖ + ‖y‖ := by + calc + ‖x‖ = ‖(x - y) + y‖ := by rw [sub_add_cancel] + _ ≤ _ := norm_add_le _ _ + have hdist : ‖x - y‖ < ‖x‖ / 2 := by + simpa only [Metric.mem_ball, dist_eq_norm, norm_sub_rev] using hy + linarith only [htri, hdist] + +/-- Large-radius potential estimate from cubic density decay and bounded mass. -/ +theorem coulombPotential_withDensity_planeMeasure_le_of_norm_pos (n b : Position) + (hn : ‖n‖ = 1) (F : PlaneFrame (affinePlane n b)) + (f : Position → ℝ≥0∞) (hf : Measurable f) (A m : ℝ) + (hA : 0 ≤ A) (hm : 0 ≤ m) + (hfA : ∀ᵐ y ∂planeMeasure F, f y ≤ ENNReal.ofReal (A / (1 + ‖y‖) ^ 3)) + (hmass : (planeMeasure F).withDensity f univ ≤ ENNReal.ofReal m) + (x : Position) (hx : 0 < ‖x‖) : + coulombPotential ((planeMeasure F).withDensity f) x ≤ + ENNReal.ofReal (2 * m / ‖x‖ + 8 * Real.pi * A / ‖x‖ ^ 2) := by + have hr : 0 < ‖x‖ / 2 := half_pos hx + have hfsmall : ∀ᵐ y ∂(planeMeasure F).restrict (Metric.ball x (‖x‖ / 2)), + f y ≤ ENNReal.ofReal (8 * A / ‖x‖ ^ 3) := by + filter_upwards [ae_restrict_of_ae hfA, + ae_restrict_mem Metric.isOpen_ball.measurableSet] with y hfy hy + exact hfy.trans (ENNReal.ofReal_le_ofReal + (cubic_decay_le_half_radius A ‖x‖ ‖y‖ hA hx (norm_nonneg y) + (half_norm_le_of_mem_ball x y hy))) + unfold coulombPotential + rw [← lintegral_add_compl _ + (Metric.isOpen_ball.measurableSet : MeasurableSet (Metric.ball x (‖x‖ / 2)))] + calc + _ ≤ ENNReal.ofReal (8 * A / ‖x‖ ^ 3) * ENNReal.ofReal (2 * Real.pi * (‖x‖ / 2)) + + ENNReal.ofReal (1 / (‖x‖ / 2)) * (planeMeasure F).withDensity f univ := + add_le_add + (lintegral_coulombKernel_ball_withDensity_le n b x hn F f hf _ hr hfsmall) + (lintegral_coulombKernel_compl_ball_le _ x hr) + _ ≤ ENNReal.ofReal (8 * A / ‖x‖ ^ 3) * ENNReal.ofReal (2 * Real.pi * (‖x‖ / 2)) + + ENNReal.ofReal (1 / (‖x‖ / 2)) * ENNReal.ofReal m := + add_le_add le_rfl (mul_le_mul_right hmass _) + _ = _ := by + rw [← ENNReal.ofReal_mul (by positivity : 0 ≤ 8 * A / ‖x‖ ^ 3), + ← ENNReal.ofReal_mul (by positivity : 0 ≤ 1 / (‖x‖ / 2)), + ← ENNReal.ofReal_add (by positivity) (by positivity)] + congr 1 + field_simp + ring + +/-- For radii at least one the quadratic tail is absorbed into the linear tail. -/ +lemma coulomb_decay_majorant_le (A m R : ℝ) (hA : 0 ≤ A) + (hR : 1 ≤ R) : + 2 * m / R + 8 * Real.pi * A / R ^ 2 ≤ (2 * m + 8 * Real.pi * A) / R := by + have hRpos : 0 < R := lt_of_lt_of_le zero_lt_one hR + have hRR : R ≤ R ^ 2 := by nlinarith only [hR] + calc + _ ≤ 2 * m / R + 8 * Real.pi * A / R := + add_le_add le_rfl (div_le_div_of_nonneg_left (by positivity) hRpos hRR) + _ = _ := (add_div _ _ _).symm + +/-- The explicit uniform decay bound for a bounded, cubically decaying planar density. -/ +theorem coulombPotential_withDensity_planeMeasure_decay (n b : Position) + (hn : ‖n‖ = 1) (F : PlaneFrame (affinePlane n b)) + (f : Position → ℝ≥0∞) (hf : Measurable f) (A B m : ℝ) + (hA : 0 ≤ A) (hB : 0 ≤ B) (hm : 0 ≤ m) + (hfB : ∀ᵐ y ∂planeMeasure F, f y ≤ ENNReal.ofReal B) + (hfA : ∀ᵐ y ∂planeMeasure F, f y ≤ ENNReal.ofReal (A / (1 + ‖y‖) ^ 3)) + (hmass : (planeMeasure F).withDensity f univ ≤ ENNReal.ofReal m) (x : Position) : + coulombPotential ((planeMeasure F).withDensity f) x ≤ + ENNReal.ofReal ((4 * Real.pi * B + 6 * m + 16 * Real.pi * A) / (1 + ‖x‖)) := by + let D : ℝ := 2 * Real.pi * B + m + let E : ℝ := 2 * m + 8 * Real.pi * A + have hD : 0 ≤ D := by dsimp [D]; positivity + have hE : 0 ≤ E := by dsimp [E]; positivity + have hden : 0 < 1 + ‖x‖ := add_pos_of_pos_of_nonneg zero_lt_one (norm_nonneg x) + have hC : 4 * Real.pi * B + 6 * m + 16 * Real.pi * A = 2 * D + 2 * E := by + dsimp [D, E] + ring + rw [hC] + by_cases hxsmall : ‖x‖ ≤ 1 + · calc + _ ≤ ENNReal.ofReal D := + coulombPotential_withDensity_planeMeasure_le n b hn F f hf B m hB hm hfB hmass x + _ ≤ _ := by + apply ENNReal.ofReal_le_ofReal + rw [le_div_iff₀ hden] + calc + D * (1 + ‖x‖) ≤ D * 2 := + mul_le_mul_of_nonneg_left (by linarith only [hxsmall]) hD + _ ≤ 2 * D + 2 * E := by + rw [mul_comm D 2] + exact le_add_of_nonneg_right (mul_nonneg (by norm_num) hE) + · have hx : 1 ≤ ‖x‖ := le_of_lt (lt_of_not_ge hxsmall) + have hxpos : 0 < ‖x‖ := lt_of_lt_of_le zero_lt_one hx + calc + _ ≤ ENNReal.ofReal (2 * m / ‖x‖ + 8 * Real.pi * A / ‖x‖ ^ 2) := + coulombPotential_withDensity_planeMeasure_le_of_norm_pos n b hn F f hf A m hA hm + hfA hmass x hxpos + _ ≤ ENNReal.ofReal (E / ‖x‖) := + ENNReal.ofReal_le_ofReal (coulomb_decay_majorant_le A m ‖x‖ hA hx) + _ ≤ _ := by + apply ENNReal.ofReal_le_ofReal + rw [div_le_div_iff₀ hxpos hden] + calc + E * (1 + ‖x‖) ≤ E * (2 * ‖x‖) := + mul_le_mul_of_nonneg_left (by linarith only [hx]) hE + _ ≤ (2 * D + 2 * E) * ‖x‖ := by + have h := mul_nonneg hD (norm_nonneg x) + nlinarith only [h] + +/-- A pointwise inverse-radius potential bound implies decay at spatial infinity. -/ +theorem tendsto_coulombPotential_zero_of_decay (μ : Measure Position) (C : ℝ) + (hdecay : ∀ x : Position, coulombPotential μ x ≤ ENNReal.ofReal (C / (1 + ‖x‖))) : + Tendsto (coulombPotential μ) (Bornology.cobounded Position) (𝓝 0) := by + have hreal : Tendsto (fun x : Position => C / (1 + ‖x‖)) + (Bornology.cobounded Position) (𝓝 0) := + tendsto_const_nhds.div_atTop + (tendsto_const_nhds.add_atTop tendsto_norm_cobounded_atTop) + have henn : Tendsto (fun x : Position => ENNReal.ofReal (C / (1 + ‖x‖))) + (Bornology.cobounded Position) (𝓝 0) := by + simpa only [Function.comp_def, ENNReal.ofReal_zero] using ENNReal.continuous_ofReal.tendsto 0 + |>.comp hreal + exact tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds henn + (Eventually.of_forall (fun _ => bot_le)) (Eventually.of_forall hdecay) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/FaceMeasureDensityDecay.lean b/LeanPool/LiebThirring/Electrostatics/FaceMeasureDensityDecay.lean new file mode 100644 index 0000000000..7efd31badc --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/FaceMeasureDensityDecay.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureBounds + +/-! +# Cubic decay of the actual Voronoi face densities + +Explicit cubic decay estimates for the Voronoi face densities. +-/ + +@[expose] public section + +open Set MeasureTheory +open scoped ENNReal + +namespace LiebThirring + +variable {M : ℕ} + +/-- The explicit coefficient of the cubic decay bound in face charge. -/ +noncomputable def nuclearFaceDecayCoefficient (R : Fin M → Position) (Z : ℝ) + (k l : Fin M) : ℝ := + (Z * nuclearHalfDistance R k l / (2 * Real.pi)) * + (1 + (1 + ‖R k‖) / nuclearHalfDistance R k l) ^ 3 + +theorem nuclearFaceDecayCoefficient_nonneg (R : Fin M → Position) {Z : ℝ} + (hZ : 0 ≤ Z) (k l : Fin M) : 0 ≤ nuclearFaceDecayCoefficient R Z k l := by + unfold nuclearFaceDecayCoefficient nuclearHalfDistance + positivity + +/-- The lower separation on a bisector converts inverse cubic nuclear distance +into inverse cubic distance from the origin. -/ +theorem nuclearFaceDensity_le_decay (R : Fin M → Position) (hR : Function.Injective R) + {Z : ℝ} (hZ : 0 ≤ Z) {k l : Fin M} (hkl : k ≠ l) {y : Position} + (hy : y ∈ bisectorPlane R k l) : + nuclearFaceDensity R Z k l y ≤ nuclearFaceDecayCoefficient R Z k l / (1 + ‖y‖) ^ 3 := by + let a := nuclearHalfDistance R k l + let D := 1 + (1 + ‖R k‖) / a + let c := Z * a / (2 * Real.pi) + have ha : 0 < a := nuclearHalfDistance_pos R hR hkl + have hr : a ≤ ‖y - R k‖ := nuclearHalfDistance_le_norm_on_bisector R hR hkl hy + have hrp : 0 < ‖y - R k‖ := ha.trans_le hr + have hD : 0 ≤ D := by dsimp [D]; positivity + have hc : 0 ≤ c := by dsimp [c]; positivity + have hnorm : ‖y‖ ≤ ‖y - R k‖ + ‖R k‖ := by + simpa only [sub_add_cancel] using norm_add_le (y - R k) (R k) + have hratio : 1 + ‖R k‖ ≤ (1 + ‖R k‖) / a * ‖y - R k‖ := by + calc + _ = ((1 + ‖R k‖) / a) * a := (div_mul_cancel₀ _ ha.ne').symm + _ ≤ _ := mul_le_mul_of_nonneg_left hr (by positivity) + have hd : 1 + ‖y‖ ≤ D * ‖y - R k‖ := by + dsimp [D] + nlinarith only [hnorm, hratio] + have hp := pow_le_pow_left₀ (by positivity : 0 ≤ 1 + ‖y‖) hd 3 + rw [mul_pow] at hp + have hmul := mul_le_mul_of_nonneg_left hp hc + have he : nuclearFaceDensity R Z k l y = c / ‖y - R k‖ ^ 3 := by + dsimp [nuclearFaceDensity, c, a] + rw [div_div] + rw [he] + change c / ‖y - R k‖ ^ 3 ≤ c * D ^ 3 / (1 + ‖y‖) ^ 3 + apply (div_le_div_iff₀ (pow_pos hrp 3) (by positivity)).mpr + simpa only [mul_assoc] using hmul + +/-- The genuine-face indicator preserves the cubic decay bound everywhere. -/ +theorem voronoiFaceDensity_le_decay (R : Fin M → Position) (hR : Function.Injective R) + {Z : ℝ} (hZ : 0 ≤ Z) (k l : Fin M) (hkl : k ≠ l) (y : Position) : + voronoiFaceDensity R Z k l y ≤ + ENNReal.ofReal (nuclearFaceDecayCoefficient R Z k l / (1 + ‖y‖) ^ 3) := by + by_cases hy : y ∈ voronoiFace R k l + · rw [voronoiFaceDensity, indicator_of_mem hy] + exact ENNReal.ofReal_le_ofReal (nuclearFaceDensity_le_decay R hR hZ hkl hy.2.1) + · simp only [voronoiFaceDensity, indicator_of_notMem hy, zero_le] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/FaceMeasureDirected.lean b/LeanPool/LiebThirring/Electrostatics/FaceMeasureDirected.lean new file mode 100644 index 0000000000..0f9dd91764 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/FaceMeasureDirected.lean @@ -0,0 +1,184 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.MeasureTheory.Integral.Bochner.ContinuousLinearMap +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureDirectedPairs + +/-! +# The directed Voronoi boundary formula + +The outward normal Coulomb flux on a nuclear face. + +The normal component equals the half separation on the literal bisector plane. +-/ + +@[expose] public section + +open Set MeasureTheory +open scoped ENNReal + +namespace LiebThirring + +variable {M : ℕ} + +/-- The outward normal Coulomb flux on a nuclear face. -/ +noncomputable def nuclearFaceFlux (R : Fin M → Position) (k l : Fin M) (y : Position) : ℝ := + inner ℝ (bisectorNormal R k l) (y - R k) / ‖y - R k‖ ^ 3 + +/-- The normal component equals the half separation on the literal bisector plane. -/ +theorem nuclearFaceFlux_on_face (R : Fin M → Position) (hR : Function.Injective R) + {k l : Fin M} {y : Position} (hy : y ∈ voronoiFace R k l) : + nuclearFaceFlux R k l y = nuclearHalfDistance R k l / ‖y - R k‖ ^ 3 := by + rw [nuclearFaceFlux, (mem_bisectorPlane_iff_normal R hR hy.1 y).mp hy.2.1] + rfl + +/-- The normal flux is the same in the two face orientations. -/ +theorem nuclearFaceFlux_comm_on_face (R : Fin M → Position) (hR : Function.Injective R) + {k l : Fin M} {y : Position} (hy : y ∈ voronoiFace R k l) : + nuclearFaceFlux R k l y = nuclearFaceFlux R l k y := by + have hy' : y ∈ voronoiFace R l k := by rw [← voronoiFace_comm]; exact hy + have hd : ‖y - R k‖ = ‖y - R l‖ := by + simpa only [dist_eq_norm] using (mem_bisectorPlane R k l y).mp hy.2.1 + rw [nuclearFaceFlux_on_face R hR hy, nuclearFaceFlux_on_face R hR hy', + nuclearHalfDistance_comm R k l, hd] + +/-- Orientation does not change Euclidean surface measure on a bisector. -/ +theorem bisectorSurfaceMeasure_comm (R : Fin M → Position) (hR : Function.Injective R) + (k l : Fin M) (hkl : k ≠ l) : + bisectorSurfaceMeasure R hR k l hkl = bisectorSurfaceMeasure R hR l k hkl.symm := by + unfold bisectorSurfaceMeasure + apply planeMeasure_eq_of_plane_eq + calc + _ = bisectorPlane R k l := (bisectorPlane_eq_affinePlane R hR hkl).symm + _ = bisectorPlane R l k := bisectorPlane_comm R k l + _ = _ := bisectorPlane_eq_affinePlane R hR hkl.symm + +/-- The density is exactly the normal flux times `Z/(2π)` on the face. -/ +theorem nuclearFaceDensity_eq_flux (R : Fin M → Position) (hR : Function.Injective R) + (Z : ℝ) {k l : Fin M} {y : Position} (hy : y ∈ voronoiFace R k l) : + nuclearFaceDensity R Z k l y = (Z / (2 * Real.pi)) * nuclearFaceFlux R k l y := by + rw [nuclearFaceFlux_on_face R hR hy, nuclearFaceDensity] + simp only [div_eq_mul_inv, mul_inv_rev] + ring + +/-- Nonnegative single-face integration in outward-normal form. -/ +theorem lintegral_nuclearFaceMeasure_flux (R : Fin M → Position) + (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) + (k l : Fin M) (hkl : k ≠ l) (h : Position → ℝ≥0∞) (hh : Measurable h) : + (∫⁻ y, h y ∂nuclearFaceMeasure R hR Z k l hkl) = ENNReal.ofReal (Z / (2 * Real.pi)) * + ∫⁻ y in voronoiFace R k l, h y * ENNReal.ofReal (nuclearFaceFlux R k l y) + ∂bisectorSurfaceMeasure R hR k l hkl := by + rw [lintegral_nuclearFaceMeasure R hR Z k l hkl h hh] + have hc : 0 ≤ Z / (2 * Real.pi) := by positivity + have hflux : Measurable (nuclearFaceFlux R k l) := + (by + unfold nuclearFaceFlux + exact (continuous_const.inner (continuous_id.sub continuous_const)).measurable |>.div + ((measurable_id.sub measurable_const).norm.pow_const 3)) + have hm : Measurable (fun y => h y * ENNReal.ofReal (nuclearFaceFlux R k l y)) := + hh.mul hflux.ennreal_ofReal + rw [← lintegral_const_mul _ hm] + apply setLIntegral_congr_fun (measurableSet_voronoiFace R k l) + intro y hy + change ENNReal.ofReal (nuclearFaceDensity R Z k l y) * h y = + ENNReal.ofReal (Z / (2 * Real.pi)) * (h y * ENNReal.ofReal (nuclearFaceFlux R k l y)) + rw [nuclearFaceDensity_eq_flux R hR Z hy, ENNReal.ofReal_mul hc] + ac_rfl + +/-- The flux integral is invariant under swapping the nuclei, in the extended setting. -/ +theorem lintegral_nuclearFaceFlux_comm (R : Fin M → Position) (hR : Function.Injective R) + (k l : Fin M) (hkl : k ≠ l) (h : Position → ℝ≥0∞) : + (∫⁻ y in voronoiFace R k l, h y * ENNReal.ofReal (nuclearFaceFlux R k l y) + ∂bisectorSurfaceMeasure R hR k l hkl) = + ∫⁻ y in voronoiFace R l k, h y * ENNReal.ofReal (nuclearFaceFlux R l k y) + ∂bisectorSurfaceMeasure R hR l k hkl.symm := by + rw [voronoiFace_comm R k l, bisectorSurfaceMeasure_comm R hR k l hkl] + apply setLIntegral_congr_fun (measurableSet_voronoiFace R l k) + intro y hy + change h y * ENNReal.ofReal (nuclearFaceFlux R k l y) = + h y * ENNReal.ofReal (nuclearFaceFlux R l k y) + rw [nuclearFaceFlux_comm_on_face R hR hy] + +/-- The factor `Z/(2π)` splits into the two directed factors `Z/(4π)`. -/ +theorem face_coefficient_eq_two_directed (Z : ℝ) : + Z / (2 * Real.pi) = Z / (4 * Real.pi) + Z / (4 * Real.pi) := by + field_simp + ring + +/-- Equation (6.3) tested against any nonnegative Borel function. -/ +theorem lintegral_voronoiFaceMeasure_directed (R : Fin M → Position) + (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) + (h : Position → ℝ≥0∞) (hh : Measurable h) : + (∫⁻ y, h y ∂voronoiFaceMeasure R hR Z) = ENNReal.ofReal (Z / (4 * Real.pi)) * + ∑ k : Fin M, ∑ l : {l : Fin M // l ≠ k}, + ∫⁻ y in voronoiFace R k l.val, + h y * ENNReal.ofReal (inner ℝ (bisectorNormal R k l.val) (y - R k) / ‖y - R k‖ ^ 3) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm := by + let f : ∀ k l : Fin M, k ≠ l → ℝ≥0∞ := fun k l hkl => + ∫⁻ y in voronoiFace R k l, h y * ENNReal.ofReal (nuclearFaceFlux R k l y) + ∂bisectorSurfaceMeasure R hR k l hkl + have hs := sum_directedNuclearPairs f (fun k l hkl => lintegral_nuclearFaceFlux_comm R hR k l hkl + h) + change (∫⁻ y, h y ∂voronoiFaceMeasure R hR Z) = + ENNReal.ofReal (Z / (4 * Real.pi)) * ∑ k, ∑ l : {l : Fin M // l ≠ k}, f k l l.property.symm + rw [voronoiFaceMeasure, lintegral_finsetSum_measure] + have hp : (∑ p : NuclearPair M, ∫⁻ y, h y ∂nuclearFaceMeasure R hR Z + p.val.1 p.val.2 (ne_of_lt p.property)) = + ENNReal.ofReal (Z / (2 * Real.pi)) * ∑ p : NuclearPair M, + f p.val.1 p.val.2 (ne_of_lt p.property) := by + rw [Finset.mul_sum] + exact Finset.sum_congr rfl fun p _ => + lintegral_nuclearFaceMeasure_flux R hR hZ _ _ _ h hh + rw [hp, hs] + have h4 : 0 ≤ Z / (4 * Real.pi) := by positivity + have hc : ENNReal.ofReal (Z / (2 * Real.pi)) = + ENNReal.ofReal (Z / (4 * Real.pi)) + ENNReal.ofReal (Z / (4 * Real.pi)) := by + rw [face_coefficient_eq_two_directed, ENNReal.ofReal_add h4 h4] + rw [hc, add_mul, mul_add] + +/-- Every face density is finite, including its zero extension. -/ +theorem voronoiFaceDensity_lt_top (R : Fin M → Position) (Z : ℝ) + (k l : Fin M) (y : Position) : voronoiFaceDensity R Z k l y < ⊤ := by + by_cases hy : y ∈ voronoiFace R k l + · rw [voronoiFaceDensity, indicator_of_mem hy] + exact ENNReal.ofReal_lt_top + · rw [voronoiFaceDensity, indicator_of_notMem hy] + exact ENNReal.zero_lt_top + +/-- A real face-charge integral is the weighted real surface integral, without a +separate global measurability premise on the function. -/ +theorem integral_nuclearFaceMeasure_flux (R : Fin M → Position) + (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) + (k l : Fin M) (hkl : k ≠ l) (h : Position → ℝ) : + (∫ y, h y ∂nuclearFaceMeasure R hR Z k l hkl) = (Z / (2 * Real.pi)) * + ∫ y in voronoiFace R k l, h y * nuclearFaceFlux R k l y + ∂bisectorSurfaceMeasure R hR k l hkl := by + rw [nuclearFaceMeasure, integral_withDensity_eq_integral_toReal_smul + (measurable_voronoiFaceDensity R Z k l) + (Filter.Eventually.of_forall (voronoiFaceDensity_lt_top R Z k l))] + have he : (fun y => (voronoiFaceDensity R Z k l y).toReal • h y) = + (voronoiFace R k l).indicator (fun y => nuclearFaceDensity R Z k l y * h y) := by + funext y + by_cases hy : y ∈ voronoiFace R k l + · rw [voronoiFaceDensity, indicator_of_mem hy, indicator_of_mem hy, + ENNReal.toReal_ofReal (nuclearFaceDensity_nonneg R hZ k l y), smul_eq_mul] + · rw [voronoiFaceDensity, indicator_of_notMem hy, indicator_of_notMem hy, + ENNReal.toReal_zero, zero_smul] + rw [he, integral_indicator (measurableSet_voronoiFace R k l), ← integral_const_mul] + apply setIntegral_congr_fun (measurableSet_voronoiFace R k l) + intro y hy + change nuclearFaceDensity R Z k l y * h y = + (Z / (2 * Real.pi)) * (h y * nuclearFaceFlux R k l y) + rw [nuclearFaceDensity_eq_flux R hR Z hy] + ring + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/FaceMeasureDirectedPairs.lean b/LeanPool/LiebThirring/Electrostatics/FaceMeasureDirectedPairs.lean new file mode 100644 index 0000000000..144e360e2c --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/FaceMeasureDirectedPairs.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureBasic + +/-! +# Counting directed nuclear pairs + +Each increasing pair occurs in the directed boundary sum once in each orientation. +-/ + +@[expose] public section + +namespace LiebThirring + +/-- A directed pair is an increasing pair together with its orientation. -/ +def directedNuclearPairEquiv (M : ℕ) : + (Σ k : Fin M, {l : Fin M // l ≠ k}) ≃ NuclearPair M ⊕ NuclearPair M where + toFun p := if h : p.1 < p.2.val then + Sum.inl ⟨(p.1, p.2.val), h⟩ + else Sum.inr ⟨(p.2.val, p.1), lt_of_le_of_ne (le_of_not_gt h) p.2.property⟩ + invFun p := match p with + | Sum.inl p => ⟨p.val.1, ⟨p.val.2, (ne_of_lt p.property).symm⟩⟩ + | Sum.inr p => ⟨p.val.2, ⟨p.val.1, ne_of_lt p.property⟩⟩ + left_inv p := by + rcases p with ⟨k, l, hl⟩ + by_cases h : k < l + · simp only [dite_eq_left h] + · simp only [dite_eq_right h] + right_inv p := by + cases p with + | inl p => + dsimp only + rw [dite_eq_left p.property] + | inr p => + dsimp only + rw [dite_eq_right (not_lt_of_gt p.property)] + +/-- Group each directed pair with its reverse orientation. -/ +theorem sum_directedNuclearPairs_oriented {M : ℕ} {A : Type*} [AddCommMonoid A] + (f : ∀ k l : Fin M, k ≠ l → A) : + (∑ k : Fin M, ∑ l : {l : Fin M // l ≠ k}, f k l.val l.property.symm) = + ∑ p : NuclearPair M, (f p.val.1 p.val.2 (ne_of_lt p.property) + + f p.val.2 p.val.1 (ne_of_lt p.property).symm) := by + classical + let g : NuclearPair M ⊕ NuclearPair M → A := Sum.elim + (fun p => f p.val.1 p.val.2 (ne_of_lt p.property)) + (fun p => f p.val.2 p.val.1 (ne_of_lt p.property).symm) + calc + _ = ∑ p : (Σ k : Fin M, {l : Fin M // l ≠ k}), f p.1 p.2.val p.2.property.symm := + (Fintype.sum_sigma _).symm + _ = ∑ p : NuclearPair M ⊕ NuclearPair M, g p := by + apply Fintype.sum_equiv (directedNuclearPairEquiv M) + rintro ⟨k, l, hl⟩ + dsimp only [directedNuclearPairEquiv, Equiv.coe_fn_mk] + by_cases h : k < l + · simp only [dite_eq_left h, g, Sum.elim_inl] + · simp only [dite_eq_right h, g, Sum.elim_inr] + _ = _ := by + rw [Fintype.sum_sum_type, Finset.sum_add_distrib] + rfl + +/-- A symmetric directed sum is twice its sum over increasing pairs. -/ +theorem sum_directedNuclearPairs {M : ℕ} {A : Type*} [AddCommMonoid A] + (f : ∀ k l : Fin M, k ≠ l → A) + (hf : ∀ (k l : Fin M) (hkl : k ≠ l), f k l hkl = f l k hkl.symm) : + (∑ k : Fin M, ∑ l : {l : Fin M // l ≠ k}, f k l.val l.property.symm) = + (∑ p : NuclearPair M, f p.val.1 p.val.2 (ne_of_lt p.property)) + + ∑ p : NuclearPair M, f p.val.1 p.val.2 (ne_of_lt p.property) := by + classical + rw [sum_directedNuclearPairs_oriented, ← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro p _ + rw [← hf p.val.1 p.val.2 (ne_of_lt p.property)] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/FaceMeasureGeometry.lean b/LeanPool/LiebThirring/Electrostatics/FaceMeasureGeometry.lean new file mode 100644 index 0000000000..442ca3163b --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/FaceMeasureGeometry.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.VoronoiStrata +public import LeanPool.LiebThirring.Electrostatics.PlaneDistance + +/-! +# Geometry for the positive Voronoi face measure + +Half the separation of two nuclei, the height appearing in. + +A frame chosen only to construct surface measure; its measure is independent of this choice, as +established by `bisectorSurfaceMeasure_eq`. +-/ + +@[expose] public section + +open Set MeasureTheory +open scoped ENNReal InnerProductSpace + +namespace LiebThirring + +variable {M : ℕ} + +/-- Half the separation of two nuclei, the height appearing in (6.1). -/ +noncomputable def nuclearHalfDistance (R : Fin M → Position) (k l : Fin M) : ℝ := + ‖R l - R k‖ / 2 + +theorem nuclearHalfDistance_pos (R : Fin M → Position) (hR : Function.Injective R) + {k l : Fin M} (hkl : k ≠ l) : 0 < nuclearHalfDistance R k l := + half_pos (norm_pos_iff.mpr (sub_ne_zero.mpr (hR.ne hkl.symm))) + +theorem nuclearHalfDistance_comm (R : Fin M → Position) (k l : Fin M) : + nuclearHalfDistance R k l = nuclearHalfDistance R l k := by + simp only [nuclearHalfDistance, norm_sub_rev] + +theorem measurableSet_voronoiFace (R : Fin M → Position) (k l : Fin M) : + MeasurableSet (voronoiFace R k l) := by + classical + by_cases hkl : k = l + · subst l + have he : voronoiFace R k k = ∅ := by + ext x + simp [voronoiFace] + rw [he] + exact MeasurableSet.empty + · have he : voronoiFace R k l = + (bisectorPlane R k l : Set Position) ∩ + ⋂ p : {p : Fin M // p ≠ k ∧ p ≠ l}, {x | dist x (R k) < dist x (R p)} := by + ext x + simp only [mem_inter_iff, mem_iInter, mem_ofPred_eq, Subtype.forall] + constructor + · rintro ⟨_, hx, hf⟩ + exact ⟨hx, fun p hp => hf p hp.1 hp.2⟩ + · rintro ⟨hx, hf⟩ + exact ⟨hkl, hx, fun p hpk hpl => hf p ⟨hpk, hpl⟩⟩ + rw [he] + exact (bisectorPlane R k l).closed_of_finiteDimensional.measurableSet.inter + (MeasurableSet.iInter fun p => + (isOpen_lt (continuous_id.dist continuous_const) + (continuous_id.dist continuous_const)).measurableSet) + +theorem bisectorPlane_eq_affinePlane (R : Fin M → Position) (hR : Function.Injective R) + {k l : Fin M} (hkl : k ≠ l) : + bisectorPlane R k l = affinePlane (bisectorNormal R k l) (midpoint ℝ (R k) (R l)) := by + have hm := (mem_bisectorPlane_iff_normal R hR hkl _).mp + (AffineSubspace.midpoint_mem_perpBisector (R k) (R l)) + ext x + rw [mem_bisectorPlane_iff_normal R hR hkl, mem_affinePlane] + have hv : x - midpoint ℝ (R k) (R l) = + (x - R k) - (midpoint ℝ (R k) (R l) - R k) := by abel + rw [hv, inner_sub_right (bisectorNormal R k l) (x - R k), hm, sub_eq_zero] + +theorem planeHeight_bisector (R : Fin M → Position) (hR : Function.Injective R) + {k l : Fin M} (hkl : k ≠ l) : + planeHeight (bisectorNormal R k l) (midpoint ℝ (R k) (R l)) (R k) = + nuclearHalfDistance R k l := by + have hm := (mem_bisectorPlane_iff_normal R hR hkl _).mp + (AffineSubspace.midpoint_mem_perpBisector (R k) (R l)) + simp only [planeHeight, ← neg_sub (midpoint ℝ (R k) (R l)) (R k), inner_neg_right, + abs_neg, hm, abs_of_nonneg (show 0 ≤ ‖R l - R k‖ / 2 from by positivity), nuclearHalfDistance] + +theorem nuclearHalfDistance_le_norm_on_bisector (R : Fin M → Position) + (hR : Function.Injective R) {k l : Fin M} (hkl : k ≠ l) {y : Position} + (hy : y ∈ bisectorPlane R k l) : nuclearHalfDistance R k l ≤ ‖y - R k‖ := by + have he := (mem_bisectorPlane_iff_normal R hR hkl y).mp hy + have hb := real_inner_le_norm (bisectorNormal R k l) (y - R k) + rw [norm_bisectorNormal R hR hkl, one_mul, he] at hb + exact hb + +/-- A frame chosen only to construct surface measure; its measure is independent +of this choice, as established by `bisectorSurfaceMeasure_eq`. -/ +noncomputable def bisectorSurfaceFrame (R : Fin M → Position) (hR : Function.Injective R) + (k l : Fin M) (hkl : k ≠ l) : + PlaneFrame (affinePlane (bisectorNormal R k l) (midpoint ℝ (R k) (R l))) := + Classical.choice (nonempty_planeFrame _ _ (by + intro hz + have h := norm_bisectorNormal R hR hkl + rw [hz, norm_zero] at h + exact zero_ne_one h)) + +/-- The usual Euclidean surface measure on a bisector plane. -/ +noncomputable def bisectorSurfaceMeasure (R : Fin M → Position) (hR : Function.Injective R) + (k l : Fin M) (hkl : k ≠ l) : Measure Position := + planeMeasure (bisectorSurfaceFrame R hR k l hkl) + +theorem planeMeasure_eq_of_plane_eq {H K : AffineSubspace ℝ Position} + [Nonempty H] [Nonempty K] (h : H = K) (F : PlaneFrame H) (G : PlaneFrame K) : + planeMeasure F = planeMeasure G := by + subst K + exact planeMeasure_eq F G + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/FaceMeasureMass.lean b/LeanPool/LiebThirring/Electrostatics/FaceMeasureMass.lean new file mode 100644 index 0000000000..e1db342ea0 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/FaceMeasureMass.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureBasic +public import LeanPool.LiebThirring.Electrostatics.FaceMeasurePlaneMass + +/-! +# Finite mass of the Voronoi face measure + +Integrating the displayed density on the full bisector plane gives `Z`. + +Restricting the whole-plane charge to the genuine face decreases its mass. +-/ + +public section + +open Set MeasureTheory +open scoped ENNReal + +namespace LiebThirring + +variable {M : ℕ} + +/-- Integrating the displayed density on the full bisector plane gives `Z`. -/ +theorem lintegral_bisector_nuclearFaceDensity (R : Fin M → Position) + (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) + (k l : Fin M) (hkl : k ≠ l) : + (∫⁻ y, ENNReal.ofReal (nuclearFaceDensity R Z k l y) + ∂bisectorSurfaceMeasure R hR k l hkl) = ENNReal.ofReal Z := by + have hh := planeHeight_bisector R hR hkl + have hm := lintegral_plane_faceDensity_mass (bisectorNormal R k l) + (midpoint ℝ (R k) (R l)) (R k) (norm_bisectorNormal R hR hkl) + (bisectorSurfaceFrame R hR k l hkl) Z hZ + (hh.symm ▸ nuclearHalfDistance_pos R hR hkl) + simpa only [hh, nuclearFaceDensity, bisectorSurfaceMeasure] using hm + +/-- Restricting the whole-plane charge to the genuine face decreases its mass. -/ +theorem nuclearFaceMeasure_mass_le (R : Fin M → Position) (hR : Function.Injective R) + {Z : ℝ} (hZ : 0 ≤ Z) (k l : Fin M) (hkl : k ≠ l) : + nuclearFaceMeasure R hR Z k l hkl univ ≤ ENNReal.ofReal Z := by + rw [nuclearFaceMeasure, withDensity_apply _ MeasurableSet.univ, Measure.restrict_univ] + apply le_trans (lintegral_mono (fun y => ?_)) + (le_of_eq (lintegral_bisector_nuclearFaceDensity R hR hZ k l hkl)) + exact indicator_le_self _ _ y + +theorem card_nuclearPair (M : ℕ) : Fintype.card (NuclearPair M) = M.choose 2 := by + classical + rw [Fintype.card_subtype] + simpa only [Finset.univ_product_univ, Fintype.card_fin, Finset.card_univ] using + (Finset.card_product_filter_lt (s := (Finset.univ : Finset (Fin M)))) + +/-- The preliminary mass bound in face charge; exact mass belongs to the potential identity. -/ +theorem voronoiFaceMeasure_mass_le (R : Fin M → Position) (hR : Function.Injective R) + {Z : ℝ} (hZ : 0 ≤ Z) : + voronoiFaceMeasure R hR Z univ ≤ (M.choose 2 : ℝ≥0∞) * ENNReal.ofReal Z := by + rw [voronoiFaceMeasure, Measure.finsetSum_apply] + calc + _ ≤ ∑ _p : NuclearPair M, ENNReal.ofReal Z := + Finset.sum_le_sum fun p _ => nuclearFaceMeasure_mass_le R hR hZ _ _ _ + _ = _ := by simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul, card_nuclearPair] + +theorem voronoiFaceMeasure_mass_lt_top (R : Fin M → Position) (hR : Function.Injective R) + {Z : ℝ} (hZ : 0 ≤ Z) : voronoiFaceMeasure R hR Z univ < ⊤ := + (voronoiFaceMeasure_mass_le R hR hZ).trans_lt (ENNReal.mul_lt_top (by simp) ENNReal.ofReal_lt_top) + +/-- Finiteness is proved from the explicit density, without a potential identity. -/ +theorem isFiniteMeasure_voronoiFaceMeasure (R : Fin M → Position) (hR : Function.Injective R) + {Z : ℝ} (hZ : 0 ≤ Z) : IsFiniteMeasure (voronoiFaceMeasure R hR Z) := + ⟨voronoiFaceMeasure_mass_lt_top R hR hZ⟩ + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/FaceMeasurePlaneMass.lean b/LeanPool/LiebThirring/Electrostatics/FaceMeasurePlaneMass.lean new file mode 100644 index 0000000000..54dfb5e14e --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/FaceMeasurePlaneMass.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.PlaneDistance +public import LeanPool.LiebThirring.Electrostatics.PlanePolar +public import LeanPool.LiebThirring.Electrostatics.FaceMeasurePlaneMassRadial + +/-! +# Whole-plane mass of the face-charge density + +At positive height, the whole-plane face-charge density has mass exactly `Z`. +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal + +namespace LiebThirring + +/-- Exact mass of the radial form of the planar face-charge density. -/ +theorem lintegral_planar_faceDensity_mass (a Z : ℝ) (ha : 0 < a) (hZ : 0 ≤ Z) : + (∫⁻ q : Planar, ENNReal.ofReal + (Z * a / (2 * Real.pi * (Real.sqrt (‖q‖ ^ 2 + a ^ 2)) ^ 3))) = + ENNReal.ofReal Z := by + have hs : Measurable (fun r : ℝ => Real.sqrt (r ^ 2 + a ^ 2)) := + Real.continuous_sqrt.measurable.comp ((measurable_id.pow_const 2).add measurable_const) + have hg : Measurable (fun r : ℝ => ENNReal.ofReal + (Z * a / (2 * Real.pi * (Real.sqrt (r ^ 2 + a ^ 2)) ^ 3))) := + (measurable_const.div (measurable_const.mul (hs.pow_const 3))).ennreal_ofReal + have hf : Measurable (fun r : ℝ => ENNReal.ofReal + (r / (Real.sqrt (r ^ 2 + a ^ 2)) ^ 3)) := + (measurable_id.div (hs.pow_const 3)).ennreal_ofReal + have hπ : 0 < 2 * Real.pi := mul_pos (by norm_num) Real.pi_pos + have hC : 0 ≤ Z * a / (2 * Real.pi) := div_nonneg (mul_nonneg hZ ha.le) hπ.le + rw [lintegral_planar_norm _ hg] + have hrad : (∫⁻ r in Ioi (0 : ℝ), ENNReal.ofReal r * ENNReal.ofReal + (Z * a / (2 * Real.pi * (Real.sqrt (r ^ 2 + a ^ 2)) ^ 3))) = + ENNReal.ofReal (Z * a / (2 * Real.pi)) * ENNReal.ofReal a⁻¹ := by + calc + _ = ∫⁻ r in Ioi (0 : ℝ), ENNReal.ofReal (Z * a / (2 * Real.pi)) * + ENNReal.ofReal (r / (Real.sqrt (r ^ 2 + a ^ 2)) ^ 3) := by + refine setLIntegral_congr_fun measurableSet_Ioi (fun r hr => ?_) + rw [← ENNReal.ofReal_mul hr.le, ← ENNReal.ofReal_mul hC] + congr 1 + simp only [div_eq_mul_inv, mul_inv_rev] + ring + _ = _ := by rw [lintegral_const_mul _ hf, lintegral_faceDensity_radial a ha] + rw [hrad, ← mul_assoc, ← ENNReal.ofReal_mul hπ.le, + ← ENNReal.ofReal_mul (mul_nonneg hπ.le hC)] + congr 1 + field_simp + +/-- The whole-plane face charge face-charge density has mass exactly `Z`. -/ +theorem lintegral_plane_faceDensity_mass (n b c : Position) (hn : ‖n‖ = 1) + (F : PlaneFrame (affinePlane n b)) (Z : ℝ) (hZ : 0 ≤ Z) + (ha : 0 < planeHeight n b c) : + (∫⁻ y, ENNReal.ofReal + (Z * planeHeight n b c / (2 * Real.pi * ‖y - c‖ ^ 3)) ∂planeMeasure F) = + ENNReal.ofReal Z := by + have hf : Measurable (fun y : Position => ENNReal.ofReal + (Z * planeHeight n b c / (2 * Real.pi * ‖y - c‖ ^ 3))) := + (measurable_const.div (measurable_const.mul + ((measurable_id.sub measurable_const).norm.pow_const 3))).ennreal_ofReal + rw [lintegral_planeMeasure_atFoot n b c hn F _ hf] + have hd (q : Planar) : + ‖(planeFrameAtFoot n b c hn F q : Position) - c‖ = + Real.sqrt (‖q‖ ^ 2 + planeHeight n b c ^ 2) := by + rw [norm_sub_rev, norm_sub_planeFrameAtFoot_eq_sqrt] + simp_rw [hd] + exact lintegral_planar_faceDensity_mass (planeHeight n b c) Z ha hZ + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/FaceMeasurePlaneMassRadial.lean b/LeanPool/LiebThirring/Electrostatics/FaceMeasurePlaneMassRadial.lean new file mode 100644 index 0000000000..48f04840cf --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/FaceMeasurePlaneMassRadial.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.PlaneRadialIntegral +public import Mathlib.MeasureTheory.Integral.IntegralEqImproper + +/-! +# Scalar radial mass integral for a planar face charge + +Radial integration of `r / (sqrt (r² + a²))³` at positive height gives the planar mass +calculation. +-/ + +public section + +open MeasureTheory Filter Set +open scoped ENNReal Topology + +namespace LiebThirring + +/-- The primitive of the radial planar face density. -/ +theorem hasDerivAt_faceDensity_primitive (a r : ℝ) (ha : 0 < a) : + HasDerivAt (fun t : ℝ => -(Real.sqrt (t ^ 2 + a ^ 2))⁻¹) + (r / (Real.sqrt (r ^ 2 + a ^ 2)) ^ 3) r := by + have hs : Real.sqrt (r ^ 2 + a ^ 2) ≠ 0 := ne_of_gt (Real.sqrt_pos.mpr + (add_pos_of_nonneg_of_pos (sq_nonneg r) (sq_pos_of_pos ha))) + convert ((hasDerivAt_sqrt_sq_add_sq a r ha).inv hs).neg using 1 + field_simp + +/-- The radial primitive tends to zero at infinity. -/ +theorem tendsto_faceDensity_primitive_atTop (a : ℝ) : + Tendsto (fun r : ℝ => -(Real.sqrt (r ^ 2 + a ^ 2))⁻¹) atTop (𝓝 0) := by + have hsq : Tendsto (fun r : ℝ => r ^ 2 + a ^ 2) atTop atTop := + tendsto_atTop_add_const_right _ _ (tendsto_pow_atTop (by decide : 2 ≠ 0)) + simpa only [Function.comp_apply, neg_zero] using + (tendsto_inv_atTop_zero.comp (Real.tendsto_sqrt_atTop.comp hsq)).neg + +/-- The radial planar face density is integrable on the positive half-line. -/ +theorem integrableOn_faceDensity_radial (a : ℝ) (ha : 0 < a) : + IntegrableOn (fun r : ℝ => r / (Real.sqrt (r ^ 2 + a ^ 2)) ^ 3) (Ioi 0) := by + exact integrableOn_Ioi_deriv_of_nonneg' + (fun r _ => hasDerivAt_faceDensity_primitive a r ha) + (fun r hr => div_nonneg hr.le (pow_nonneg (Real.sqrt_nonneg _) _)) + (tendsto_faceDensity_primitive_atTop a) + +/-- Exact real radial mass integral at positive height. -/ +theorem integral_faceDensity_radial (a : ℝ) (ha : 0 < a) : + (∫ r in Ioi (0 : ℝ), r / (Real.sqrt (r ^ 2 + a ^ 2)) ^ 3) = a⁻¹ := by + have hi := integral_Ioi_of_hasDerivAt_of_nonneg' + (fun r (_hr : r ∈ Ici (0 : ℝ)) => hasDerivAt_faceDensity_primitive a r ha) + (fun r hr => div_nonneg hr.le (pow_nonneg (Real.sqrt_nonneg _) _)) + (tendsto_faceDensity_primitive_atTop a) + simpa only [zero_pow (by decide : 2 ≠ 0), zero_add, Real.sqrt_sq ha.le, + zero_sub, neg_neg] using hi + +/-- Exact extended nonnegative radial mass integral at positive height. -/ +theorem lintegral_faceDensity_radial (a : ℝ) (ha : 0 < a) : + (∫⁻ r in Ioi (0 : ℝ), + ENNReal.ofReal (r / (Real.sqrt (r ^ 2 + a ^ 2)) ^ 3)) = ENNReal.ofReal a⁻¹ := by + rw [← ofReal_integral_eq_lintegral_ofReal (integrableOn_faceDensity_radial a ha) ?_, + integral_faceDensity_radial a ha] + filter_upwards [ae_restrict_mem measurableSet_Ioi] with r hr + exact div_nonneg hr.le (pow_nonneg (Real.sqrt_nonneg _) _) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/FaceMeasurePotential.lean b/LeanPool/LiebThirring/Electrostatics/FaceMeasurePotential.lean new file mode 100644 index 0000000000..949a5f1610 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/FaceMeasurePotential.lean @@ -0,0 +1,216 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.MeasureTheory.Integral.Lebesgue.DominatedConvergence +public import LeanPool.LiebThirring.Electrostatics.Basic +import all LeanPool.LiebThirring.Electrostatics.Basic + +/-! +# Generic potential estimates from uniform local Coulomb control + +The extended Coulomb kernel is measurable as a function of its second argument. + +Outside the unit ball the kernel is at most one. +-/ + +@[expose] public section + +open MeasureTheory Set Filter +open scoped ENNReal Topology + +namespace LiebThirring + +/-- The extended Coulomb kernel is measurable as a function of its second argument. -/ +theorem measurable_coulombKernel_right (x : Position) : Measurable (coulombKernel x) := + ((measurable_const.sub measurable_id).norm.ennreal_ofReal).inv + +/-- Outside the unit ball the kernel is at most one. -/ +theorem coulombKernel_le_one_of_not_mem_ball (x y : Position) + (hy : y ∉ Metric.ball x 1) : coulombKernel x y ≤ 1 := by + have hd : 1 ≤ ‖x - y‖ := by + simpa only [Metric.mem_ball, dist_eq_norm, norm_sub_rev, not_lt] using hy + change (ENNReal.ofReal ‖x - y‖)⁻¹ ≤ 1 + rw [← inv_one] + exact ENNReal.inv_le_inv.mpr (by simpa using ENNReal.ofReal_le_ofReal hd) + +/-- Uniform local control at radius one gives a global bound. -/ +theorem coulombPotential_le_of_local_bound (μ : Measure Position) (C : ℝ) + (hlocal : ∀ x : Position, ∀ ε : ℝ, 0 < ε → + ∫⁻ y in Metric.ball x ε, coulombKernel x y ∂μ ≤ ENNReal.ofReal (C * ε)) + (x : Position) : coulombPotential μ x ≤ ENNReal.ofReal C + μ univ := by + change (∫⁻ y, coulombKernel x y ∂μ) ≤ _ + rw [← lintegral_add_compl _ measurableSet_ball] + focus apply add_le_add + · simpa only [mul_one] using hlocal x 1 zero_lt_one + · calc + ∫⁻ y in (Metric.ball x 1)ᶜ, coulombKernel x y ∂μ ≤ + ∫⁻ y in (Metric.ball x 1)ᶜ, (1 : ℝ≥0∞) ∂μ := by + apply lintegral_mono_ae + filter_upwards [ae_restrict_mem measurableSet_ball.compl] with y hy + exact coulombKernel_le_one_of_not_mem_ball x y hy + _ = μ (Metric.ball x 1)ᶜ := by simp only [lintegral_const, Measure.restrict_apply_univ, + one_mul] + _ ≤ μ univ := measure_mono (subset_univ _) + +/-- A finite measure with uniform local control has an everywhere finite potential. -/ +theorem coulombPotential_lt_top_of_local_bound (μ : Measure Position) [IsFiniteMeasure μ] + (C : ℝ) (hlocal : ∀ x : Position, ∀ ε : ℝ, 0 < ε → + ∫⁻ y in Metric.ball x ε, coulombKernel x y ∂μ ≤ ENNReal.ofReal (C * ε)) + (x : Position) : coulombPotential μ x < ⊤ := + (coulombPotential_le_of_local_bound μ C hlocal x).trans_lt + (ENNReal.add_lt_top.mpr ⟨ENNReal.ofReal_lt_top, measure_lt_top μ univ⟩) + +/-- The self-energy is finite under the same uniform local estimate. -/ +theorem coulombEnergy_lt_top_of_local_bound (μ : Measure Position) [IsFiniteMeasure μ] + (C : ℝ) (hlocal : ∀ x : Position, ∀ ε : ℝ, 0 < ε → + ∫⁻ y in Metric.ball x ε, coulombKernel x y ∂μ ≤ ENNReal.ofReal (C * ε)) : + coulombEnergy μ μ < ⊤ := by + change (∫⁻ x, coulombPotential μ x ∂μ) < ⊤ + calc + ∫⁻ x, coulombPotential μ x ∂μ ≤ + ∫⁻ _ : Position, (ENNReal.ofReal C + μ univ) ∂μ := + lintegral_mono (coulombPotential_le_of_local_bound μ C hlocal) + _ = (ENNReal.ofReal C + μ univ) * μ univ := lintegral_const _ + _ < ⊤ := ENNReal.mul_lt_top + (ENNReal.add_lt_top.mpr ⟨ENNReal.ofReal_lt_top, measure_lt_top μ univ⟩) + (measure_lt_top μ univ) + +/-- Continuous capped Coulomb kernel, with a positive cap radius. -/ +noncomputable def cappedCoulombKernel (r : ℝ) (x y : Position) : ℝ≥0∞ := + (ENNReal.ofReal (max r ‖x - y‖))⁻¹ + +/-- Potential of the capped kernel. -/ +noncomputable def cappedCoulombPotential (μ : Measure Position) (r : ℝ) (x : Position) : ℝ≥0∞ := + ∫⁻ y, cappedCoulombKernel r x y ∂μ + +theorem continuous_cappedCoulombKernel_left (r : ℝ) (y : Position) : + Continuous (fun x : Position => cappedCoulombKernel r x y) := + (ENNReal.continuous_ofReal.comp (continuous_const.max + (continuous_id.sub continuous_const).norm)).fun_inv + +theorem measurable_cappedCoulombKernel_right (r : ℝ) (x : Position) : + Measurable (cappedCoulombKernel r x) := + ((measurable_const.max (measurable_const.sub measurable_id).norm).ennreal_ofReal).inv + +theorem cappedCoulombKernel_le (r : ℝ) (x y : Position) : + cappedCoulombKernel r x y ≤ coulombKernel x y := + ENNReal.inv_le_inv.mpr (ENNReal.ofReal_le_ofReal (le_max_right _ _)) + +theorem cappedCoulombKernel_le_cap (r : ℝ) (x y : Position) : + cappedCoulombKernel r x y ≤ (ENNReal.ofReal r)⁻¹ := + ENNReal.inv_le_inv.mpr (ENNReal.ofReal_le_ofReal (le_max_left _ _)) + +theorem cappedCoulombPotential_le (μ : Measure Position) (r : ℝ) (x : Position) : + cappedCoulombPotential μ r x ≤ coulombPotential μ x := + lintegral_mono (cappedCoulombKernel_le r x) + +/-- A positive cap radius gives a continuous potential for every finite measure. -/ +theorem continuous_cappedCoulombPotential (μ : Measure Position) [IsFiniteMeasure μ] + (r : ℝ) (hr : 0 < r) : Continuous (cappedCoulombPotential μ r) := by + apply continuous_iff_continuousAt.mpr + intro x + change Tendsto (fun z => ∫⁻ y, cappedCoulombKernel r z y ∂μ) (𝓝 x) + (𝓝 (∫⁻ y, cappedCoulombKernel r x y ∂μ)) + apply tendsto_lintegral_filter_of_dominated_convergence + (fun _ : Position => (ENNReal.ofReal r)⁻¹) + · exact Eventually.of_forall (measurable_cappedCoulombKernel_right r) + · exact Eventually.of_forall (fun z => Eventually.of_forall (cappedCoulombKernel_le_cap r z)) + · rw [lintegral_const] + exact (ENNReal.mul_lt_top (ENNReal.inv_lt_top.mpr (ENNReal.ofReal_pos.mpr hr)) + (measure_lt_top μ univ)).ne + · exact Eventually.of_forall (fun y => (continuous_cappedCoulombKernel_left r y).continuousAt) + +theorem cappedCoulombPotential_lt_top (μ : Measure Position) [IsFiniteMeasure μ] + (r : ℝ) (hr : 0 < r) (x : Position) : cappedCoulombPotential μ r x < ⊤ := by + calc + cappedCoulombPotential μ r x ≤ ∫⁻ _ : Position, (ENNReal.ofReal r)⁻¹ ∂μ := + lintegral_mono (cappedCoulombKernel_le_cap r x) + _ = (ENNReal.ofReal r)⁻¹ * μ univ := lintegral_const _ + _ < ⊤ := ENNReal.mul_lt_top (ENNReal.inv_lt_top.mpr (ENNReal.ofReal_pos.mpr hr)) + (measure_lt_top μ univ) + +/-- The potential differs from its capped approximation only in the local ball. -/ +theorem coulombPotential_le_capped_add_of_local_bound (μ : Measure Position) (C r : ℝ) + (hr : 0 < r) (hlocal : ∀ x : Position, ∀ ε : ℝ, 0 < ε → + ∫⁻ y in Metric.ball x ε, coulombKernel x y ∂μ ≤ ENNReal.ofReal (C * ε)) + (x : Position) : + coulombPotential μ x ≤ cappedCoulombPotential μ r x + ENNReal.ofReal (C * r) := by + classical + have hk : ∀ y : Position, coulombKernel x y ≤ cappedCoulombKernel r x y + + (Metric.ball x r).indicator (coulombKernel x) y := by + intro y + by_cases hy : y ∈ Metric.ball x r + · rw [Set.indicator_of_mem hy] + exact le_add_left le_rfl + · have hd : r ≤ ‖x - y‖ := by + simpa only [Metric.mem_ball, dist_eq_norm, norm_sub_rev, not_lt] using hy + rw [Set.indicator_of_notMem hy, add_zero] + simp only [cappedCoulombKernel, max_eq_right hd, coulombKernel, le_refl] + calc + coulombPotential μ x ≤ ∫⁻ y, cappedCoulombKernel r x y + + (Metric.ball x r).indicator (coulombKernel x) y ∂μ := lintegral_mono hk + _ = cappedCoulombPotential μ r x + ∫⁻ y in Metric.ball x r, coulombKernel x y ∂μ := by + rw [lintegral_add_left (measurable_cappedCoulombKernel_right r x), + lintegral_indicator measurableSet_ball] + rfl + _ ≤ _ := add_le_add le_rfl (hlocal x r hr) + +/-- The real-valued capped potential is continuous. -/ +theorem continuous_toReal_cappedCoulombPotential (μ : Measure Position) [IsFiniteMeasure μ] + (r : ℝ) (hr : 0 < r) : Continuous (fun x => (cappedCoulombPotential μ r x).toReal) := by + apply continuous_iff_continuousAt.mpr + intro x + exact (ENNReal.continuousAt_toReal (cappedCoulombPotential_lt_top μ r hr x).ne).comp + (continuous_cappedCoulombPotential μ r hr).continuousAt + +/-- Quantitative uniform approximation in the finite real-valued potential. -/ +theorem dist_toReal_coulombPotential_capped_le (μ : Measure Position) [IsFiniteMeasure μ] + (C r : ℝ) (hC : 0 ≤ C) (hr : 0 < r) + (hlocal : ∀ x : Position, ∀ ε : ℝ, 0 < ε → + ∫⁻ y in Metric.ball x ε, coulombKernel x y ∂μ ≤ ENNReal.ofReal (C * ε)) + (x : Position) : + dist (coulombPotential μ x).toReal (cappedCoulombPotential μ r x).toReal ≤ C * r := by + have hp := coulombPotential_lt_top_of_local_bound μ C hlocal x + have hq := cappedCoulombPotential_lt_top μ r hr x + have hle : (cappedCoulombPotential μ r x).toReal ≤ (coulombPotential μ x).toReal := + ENNReal.toReal_mono hp.ne (cappedCoulombPotential_le μ r x) + have hu := ENNReal.toReal_mono + (ENNReal.add_lt_top.mpr ⟨hq, ENNReal.ofReal_lt_top⟩).ne + (coulombPotential_le_capped_add_of_local_bound μ C r hr hlocal x) + rw [ENNReal.toReal_add hq.ne ENNReal.ofReal_ne_top, + ENNReal.toReal_ofReal (mul_nonneg hC hr.le)] at hu + rw [Real.dist_eq, abs_of_nonneg (sub_nonneg.mpr hle)] + linarith only [hu] + +/-- Uniform local control gives continuity of the finite real-valued potential. -/ +theorem continuous_toReal_coulombPotential_of_local_bound (μ : Measure Position) + [IsFiniteMeasure μ] (C : ℝ) (hC : 0 ≤ C) + (hlocal : ∀ x : Position, ∀ ε : ℝ, 0 < ε → + ∫⁻ y in Metric.ball x ε, coulombKernel x y ∂μ ≤ ENNReal.ofReal (C * ε)) : + Continuous (fun x => (coulombPotential μ x).toReal) := by + apply continuous_of_uniform_approx_of_continuous + intro u hu + obtain ⟨ε, hε, hsub⟩ := Metric.mem_uniformity_dist.mp hu + let r := ε / (2 * (C + 1)) + have hr : 0 < r := div_pos hε (mul_pos (by norm_num) (by linarith only [hC])) + have hsmall : C * r < ε := by + dsimp only [r] + rw [← mul_div_assoc] + apply (div_lt_iff₀ (mul_pos (by norm_num) (by linarith only [hC]))).mpr + nlinarith only [hC, hε] + refine ⟨fun x => (cappedCoulombPotential μ r x).toReal, + continuous_toReal_cappedCoulombPotential μ r hr, ?_⟩ + intro x + apply hsub + exact (dist_toReal_coulombPotential_capped_le μ C r hC hr hlocal x).trans_lt hsmall + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/Gaussian.lean b/LeanPool/LiebThirring/Electrostatics/Gaussian.lean new file mode 100644 index 0000000000..2d465c2574 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/Gaussian.lean @@ -0,0 +1,158 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.SpecialFunctions.Gaussian.FourierTransform +public import Mathlib.Analysis.SpecialFunctions.Gaussian.GaussianIntegral +public import LeanPool.LiebThirring.Defs.Coulomb + +/-! +# Gaussian representations of the Coulomb kernel + +Equation, including the infinite diagonal. + +Pointwise completion of squares, prior to integration. +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal RealInnerProductSpace + +namespace LiebThirring + +theorem measurable_coulombKernel : Measurable (Function.uncurry coulombKernel) := by + exact ((measurable_fst.sub measurable_snd).norm.ennreal_ofReal).inv + +theorem coulombKernel_symm (x y : Position) : coulombKernel x y = coulombKernel y x := by + simp only [coulombKernel, norm_sub_rev] + +theorem inverse_eq_lintegral_gaussian (s : ℝ) (hs : 0 ≤ s) : + (ENNReal.ofReal s)⁻¹ = + ∫⁻ t : ℝ in Ioi 0, ENNReal.ofReal (2 / Real.sqrt Real.pi * Real.exp (-(t ^ 2 * s ^ 2))) := by + by_cases hzero : s = 0 + · subst s + simp only [sq, mul_zero, neg_zero, Real.exp_zero, mul_one] + rw [lintegral_const, Measure.restrict_apply_univ, Real.volume_Ioi] + simp only [ENNReal.ofReal_zero, ENNReal.inv_zero] + exact (ENNReal.mul_top (by positivity)).symm + · have hpos : 0 < s := lt_of_le_of_ne hs (Ne.symm hzero) + have hi : Integrable (fun t : ℝ => 2 / Real.sqrt Real.pi * + Real.exp (-(t ^ 2 * s ^ 2))) (volume.restrict (Ioi 0)) := by + have hg := (integrable_exp_neg_mul_sq (sq_pos_of_pos hpos)).restrict (s := Ioi 0) + convert hg.const_mul (2 / Real.sqrt Real.pi) using 1 + ext t + rw [mul_comm (t ^ 2), neg_mul] + rw [← ofReal_integral_eq_lintegral_ofReal hi + (Filter.Eventually.of_forall (fun _ => by positivity)), integral_const_mul] + have heq : (∫ t : ℝ in Ioi 0, Real.exp (-(t ^ 2 * s ^ 2))) = + Real.sqrt (Real.pi / s ^ 2) / 2 := by + convert integral_gaussian_Ioi (s ^ 2) using 1 + congr 1 + ext t + rw [mul_comm (t ^ 2), neg_mul] + rw [heq, Real.sqrt_div Real.pi_pos.le, Real.sqrt_sq hs] + have hpi : Real.sqrt Real.pi ≠ 0 := (Real.sqrt_pos.2 Real.pi_pos).ne' + have halgebra : 2 / Real.sqrt Real.pi * (Real.sqrt Real.pi / s / 2) = s⁻¹ := by + field_simp + rw [halgebra, ENNReal.ofReal_inv_of_pos hpos] + +/-- Equation (2.1), including the infinite diagonal. -/ +theorem coulombKernel_eq_lintegral_gaussian (x y : Position) : + coulombKernel x y = + ∫⁻ t : ℝ in Ioi 0, + ENNReal.ofReal (2 / Real.sqrt Real.pi * Real.exp (-(t ^ 2 * ‖x - y‖ ^ 2))) := + inverse_eq_lintegral_gaussian ‖x - y‖ (norm_nonneg _) + +theorem norm_midpoint_sq (x y z : Position) : + ‖x - z‖ ^ 2 + ‖y - z‖ ^ 2 = + 2 * ‖z - (1 / 2 : ℝ) • (x + y)‖ ^ 2 + ‖x - y‖ ^ 2 / 2 := by + simp only [norm_sub_sq_real, norm_smul, + real_inner_smul_right, inner_add_right, Real.norm_eq_abs] + rw [real_inner_comm z x, real_inner_comm z y] + simp only [mul_pow] + rw [norm_add_sq_real] + norm_num + ring +/-- Pointwise completion of squares, prior to integration. -/ +theorem gaussian_product_eq (b : ℝ) (x y z : Position) : + Real.exp (-2 * b * ‖x - z‖ ^ 2) * Real.exp (-2 * b * ‖y - z‖ ^ 2) = + Real.exp (-b * ‖x - y‖ ^ 2) * + Real.exp (-(4 * b) * ‖z - (1 / 2 : ℝ) • (x + y)‖ ^ 2) := by + rw [← Real.exp_add, ← Real.exp_add] + congr 1 + calc + -2 * b * ‖x - z‖ ^ 2 + -2 * b * ‖y - z‖ ^ 2 = + -2 * b * (‖x - z‖ ^ 2 + ‖y - z‖ ^ 2) := by ring + _ = _ := by rw [norm_midpoint_sq]; ring + +theorem integral_gaussian_product (b : ℝ) (hb : 0 < b) (x y : Position) : + (∫ z : Position, Real.exp (-2 * b * ‖x - z‖ ^ 2) * + Real.exp (-2 * b * ‖y - z‖ ^ 2)) = + Real.exp (-b * ‖x - y‖ ^ 2) * (Real.pi / (4 * b)) ^ (3 / 2 : ℝ) := by + simp_rw [gaussian_product_eq] + rw [integral_const_mul] + rw [integral_sub_right_eq_self (fun z : Position => Real.exp (-(4 * b) * ‖z‖ ^ 2))] + rw [GaussianFourier.integral_rexp_neg_mul_sq_norm (by positivity)] + simp only [Position, finrank_euclideanSpace, Fintype.card_fin, Nat.cast_ofNat] + +theorem integrable_gaussian_norm {b : ℝ} (hb : 0 < b) : + Integrable (fun z : Position => Real.exp (-b * ‖z‖ ^ 2)) := by + have h := (GaussianFourier.integrable_cexp_neg_mul_sq_norm_add + (V := Position) (b := (b : ℂ)) (by simpa using hb) 0 0).re + convert h using 1 + ext z + simp only [zero_mul, add_zero] + change Real.exp (-b * ‖z‖ ^ 2) = (Complex.exp (-↑b * (↑‖z‖ : ℂ) ^ 2)).re + rw [← Complex.ofReal_neg, ← Complex.ofReal_pow, ← Complex.ofReal_mul, + Complex.exp_ofReal_re] + +/-- Absolute integrability of the product in (2.2). -/ +theorem integrable_gaussian_product {b : ℝ} (hb : 0 < b) (x y : Position) : + Integrable (fun z : Position => Real.exp (-2 * b * ‖x - z‖ ^ 2) * + Real.exp (-2 * b * ‖y - z‖ ^ 2)) := by + simp_rw [gaussian_product_eq] + exact ((integrable_gaussian_norm (by positivity : 0 < 4 * b)).comp_sub_right + ((1 / 2 : ℝ) • (x + y))).const_mul _ + +/-- Spatial Gaussian convolution mass in three Euclidean dimensions. -/ +@[expose] noncomputable def gaussianMass (b : ℝ) : ℝ := + (Real.pi / (4 * b)) ^ (3 / 2 : ℝ) + +/-- A nonnegative Gaussian feature with scalar normalization `c`. -/ +@[expose] noncomputable def gaussianFeature (c b : ℝ) (x z : Position) : ℝ≥0∞ := + ENNReal.ofReal (Real.sqrt (c / gaussianMass b) * Real.exp (-2 * b * ‖x - z‖ ^ 2)) + +/-- Cancellation of the square root normalization. -/ +theorem sqrt_mul_sqrt_mul (a u v : ℝ) (ha : 0 ≤ a) : + (Real.sqrt a * u) * (Real.sqrt a * v) = a * (u * v) := by + calc + _ = (Real.sqrt a) ^ 2 * (u * v) := by ring + _ = _ := by rw [Real.sq_sqrt ha] + +/-- Integral Gram representation of a Gaussian kernel. -/ +theorem lintegral_gaussianFeature_mul {b c : ℝ} (hb : 0 < b) (hc : 0 ≤ c) + (x y : Position) : + (∫⁻ z : Position, gaussianFeature c b x z * gaussianFeature c b y z) = + ENNReal.ofReal (c * Real.exp (-b * ‖x - y‖ ^ 2)) := by + have hm : 0 < gaussianMass b := Real.rpow_pos_of_pos (by positivity) _ + have hnormal : 0 ≤ c / gaussianMass b := div_nonneg hc hm.le + simp only [gaussianFeature, ← ENNReal.ofReal_mul + (mul_nonneg (Real.sqrt_nonneg _) (Real.exp_pos _).le)] + simp_rw [sqrt_mul_sqrt_mul _ _ _ hnormal] + rw [← ofReal_integral_eq_lintegral_ofReal + ((integrable_gaussian_product hb x y).const_mul (c / gaussianMass b)) + (Filter.Eventually.of_forall (fun _ => by positivity)), integral_const_mul, + integral_gaussian_product b hb x y] + congr 1 + change c / gaussianMass b * (Real.exp (-b * ‖x - y‖ ^ 2) * gaussianMass b) = _ + field_simp + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Electrostatics/Newton.lean b/LeanPool/LiebThirring/Electrostatics/Newton.lean new file mode 100644 index 0000000000..d31ee746f3 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/Newton.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.Basic +public import LeanPool.LiebThirring.Electrostatics.SphereAngular +import LeanPool.LiebThirring.Electrostatics.NewtonIntegral +import all LeanPool.LiebThirring.Electrostatics.Basic + +/-! +# Newton's shell potential theorem + +Newton’s shell formula holds at every observation point, including points on the shell. The +proof uses normalized sphere measure and its height distribution. +-/ + +public section + +open MeasureTheory Set Metric +open scoped ENNReal + +namespace LiebThirring + +/-- The value at the shell center, including the infinite value at radius zero. -/ +theorem coulombPotential_shell_center (a : Position) {r : ℝ} (hr : 0 ≤ r) : + coulombPotential (shell a r) a = (ENNReal.ofReal r)⁻¹ := by + unfold coulombPotential + calc + _ = ∫⁻ _y, (ENNReal.ofReal r)⁻¹ ∂shell a r := by + apply lintegral_congr_ae + filter_upwards [ae_shell_norm a hr] with y hy + simp only [coulombKernel, norm_sub_rev a y, hy] + _ = _ := by rw [lintegral_const, measure_univ, mul_one] + +/-- The squared-distance reduction in the direction from the shell center to `x`. -/ +theorem coulombKernel_shell_direction (a x : Position) {r : ℝ} (hr : 0 ≤ r) + (hz : 0 < ‖x - a‖) (ω : sphere (0 : Position) 1) : + coulombKernel x (a + r • (ω : Position)) = + (ENNReal.ofReal (Real.sqrt (‖x - a‖ ^ 2 + r ^ 2 - + 2 * ‖x - a‖ * r * inner ℝ (ω : Position) (‖x - a‖⁻¹ • (x - a)))))⁻¹ := by + have hω : ‖(ω : Position)‖ = 1 := mem_sphere_zero_iff_norm.mp ω.property + have hi : inner ℝ (x - a) (ω : Position) = ‖x - a‖ * + inner ℝ (ω : Position) (‖x - a‖⁻¹ • (x - a)) := by + rw [inner_smul_right, ← mul_assoc, mul_inv_cancel₀ hz.ne', one_mul, real_inner_comm] + have hsub : x - (a + r • (ω : Position)) = (x - a) - r • (ω : Position) := by abel + have hs : ‖x - (a + r • (ω : Position))‖ ^ 2 = ‖x - a‖ ^ 2 + r ^ 2 - + 2 * ‖x - a‖ * r * inner ℝ (ω : Position) (‖x - a‖⁻¹ • (x - a)) := by + rw [hsub, norm_sub_sq_real, norm_smul, Real.norm_eq_abs, abs_of_nonneg hr, hω, + mul_one, inner_smul_right, hi] + ring + rw [coulombKernel, ← hs, Real.sqrt_sq (norm_nonneg _)] + +/-- The shell potential is the Archimedes angular average, including zero observation radius. -/ +theorem coulombPotential_shell_angular (a : Position) {r : ℝ} (hr : 0 < r) (x : Position) : + coulombPotential (shell a r) x = (ENNReal.ofReal 2)⁻¹ * + ∫⁻ t in Icc (-1 : ℝ) 1, + (ENNReal.ofReal (Real.sqrt (‖x - a‖ ^ 2 + r ^ 2 - 2 * ‖x - a‖ * r * t)))⁻¹ := by + by_cases hxa : x = a + · subst x + rw [coulombPotential_shell_center a hr.le] + simp only [sub_self, norm_zero] + simpa only [max_eq_right hr.le] using + (newton_angular_integral (u := 0) (by norm_num) hr).symm + · have hz : 0 < ‖x - a‖ := norm_pos_iff.mpr (sub_ne_zero.mpr hxa) + let e : Position := ‖x - a‖⁻¹ • (x - a) + have he : ‖e‖ = 1 := by + rw [norm_smul, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr hz), inv_mul_cancel₀ hz.ne'] + let f : ℝ → ℝ≥0∞ := fun t => + (ENNReal.ofReal (Real.sqrt (‖x - a‖ ^ 2 + r ^ 2 - 2 * ‖x - a‖ * r * t)))⁻¹ + have hf : Measurable f := by + exact (ENNReal.measurable_ofReal.comp + ((continuous_const.sub (continuous_const.mul continuous_id)).sqrt.measurable)).inv + have hk : Measurable (coulombKernel x) := + (ENNReal.measurable_ofReal.comp + (continuous_norm.comp (continuous_const.sub continuous_id)).measurable).inv + have hm : Measurable (fun ω : sphere (0 : Position) 1 => inner ℝ (ω : Position) e) := + (continuous_subtype_val.inner continuous_const).measurable + unfold coulombPotential shell + rw [lintegral_map hk (measurable_shellMap a r)] + calc + _ = ∫⁻ ω : sphere (0 : Position) 1, f (inner ℝ (ω : Position) e) ∂unitSphereMeasure := by + apply lintegral_congr + intro ω + exact coulombKernel_shell_direction a x hr.le hz ω + _ = ∫⁻ t, f t ∂unitSphereMeasure.map + (fun ω : sphere (0 : Position) 1 => inner ℝ (ω : Position) e) := + (lintegral_map hf hm).symm + _ = _ := by + rw [unitSphereMeasure_inner_uniform e he, lintegral_smul_measure] + rfl + +/-- Newton's formula for every point, including the center and the singular sphere. -/ +theorem coulombPotential_shell (a : Position) {r : ℝ} (hr : 0 < r) (x : Position) : + coulombPotential (shell a r) x = (ENNReal.ofReal (max ‖x - a‖ r))⁻¹ := by + rw [coulombPotential_shell_angular a hr x] + exact newton_angular_integral (norm_nonneg _) hr +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/NewtonConsequences.lean b/LeanPool/LiebThirring/Electrostatics/NewtonConsequences.lean new file mode 100644 index 0000000000..761ec37f0b --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/NewtonConsequences.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.Newton +import LeanPool.LiebThirring.Electrostatics.Gaussian +import all LeanPool.LiebThirring.Electrostatics.Basic + +/-! +# Energies, comparison, and regularity of spherical shells + +Interacting with a point charge evaluates the potential at that point. + +A point charge in the first energy argument also evaluates the potential. +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal + +namespace LiebThirring + +/-- Newton's potential is no greater than the potential of the center point. -/ +theorem coulombPotential_shell_le_kernel (a : Position) {r : ℝ} (hr : 0 < r) + (x : Position) : coulombPotential (shell a r) x ≤ coulombKernel x a := by + rw [coulombPotential_shell a hr x, coulombKernel] + exact ENNReal.inv_le_inv.mpr (ENNReal.ofReal_le_ofReal (le_max_left _ _)) + +/-- Outside or on the shell, its potential equals the point-charge potential. -/ +theorem coulombPotential_shell_of_radius_le (a : Position) {r : ℝ} (hr : 0 < r) + (x : Position) (hx : r ≤ ‖x - a‖) : + coulombPotential (shell a r) x = coulombKernel x a := by + rw [coulombPotential_shell a hr x, max_eq_left hx] + rfl + +/-- The self-energy has no factor `1/2`, in accordance with the shared definition. -/ +theorem coulombEnergy_shell_self (a : Position) {r : ℝ} (hr : 0 < r) : + coulombEnergy (shell a r) (shell a r) = (ENNReal.ofReal r)⁻¹ := by + unfold coulombEnergy + calc + _ = ∫⁻ _x, (ENNReal.ofReal r)⁻¹ ∂shell a r := by + apply lintegral_congr_ae + filter_upwards [ae_shell_norm a hr.le] with x hx + rw [coulombPotential_shell a hr x, hx, max_self] + _ = _ := by rw [lintegral_const, measure_univ, mul_one] + +/-- Spherical smearing decreases mutual Coulomb energy, even for coincident centers. -/ +theorem coulombEnergy_shell_le_kernel (a b : Position) {r s : ℝ} + (hr : 0 < r) (hs : 0 < s) : + coulombEnergy (shell a r) (shell b s) ≤ coulombKernel a b := by + calc + _ ≤ ∫⁻ x, coulombKernel x b ∂shell a r := by + unfold coulombEnergy + exact lintegral_mono (fun x => coulombPotential_shell_le_kernel b hs x) + _ = coulombPotential (shell a r) b := by + unfold coulombPotential + simp_rw [coulombKernel_symm _ b] + _ ≤ coulombKernel a b := by + rw [coulombKernel_symm a b] + exact coulombPotential_shell_le_kernel a hr b + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/NewtonIntegral.lean b/LeanPool/LiebThirring/Electrostatics/NewtonIntegral.lean new file mode 100644 index 0000000000..953a05dd93 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/NewtonIntegral.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.SpecialFunctions.Integrals.Basic + +/-! +# The scalar Newton angular integral + +The elementary height integral used to evaluate the potential of a spherical shell. +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal + +namespace LiebThirring + +/-- Integrability of the real power after the Newton affine substitution. -/ +lemma intervalIntegrable_newton_rpow {u r : ℝ} (hu : 0 < u) (hr : 0 < r) : + IntervalIntegrable (fun t : ℝ => (u ^ 2 + r ^ 2 - 2 * u * r * t) ^ (-(1 / 2 : ℝ))) volume (-1) + 1 := by + let c := 2 * u * r + let d := u ^ 2 + r ^ 2 + have hi := (intervalIntegral.intervalIntegrable_rpow' (a := d + c) (b := d - c) + (r := -(1 / 2 : ℝ)) (by norm_num)).comp_sub_left d + have hj := hi.comp_mul_left (c := c) + convert hj using 1 <;> dsimp [c, d] at * <;> + field_simp [ne_of_gt hu, ne_of_gt hr] <;> ring + +/-- Real-valued angular integral for a positive observation radius. -/ +lemma integral_newton_rpow {u r : ℝ} (hu : 0 < u) (hr : 0 < r) : + (∫ t : ℝ in (-1)..1, (u ^ 2 + r ^ 2 - 2 * u * r * t) ^ (-(1 / 2 : ℝ))) = + 2 / max u r := by + have hc : 2 * u * r ≠ 0 := by positivity + rw [intervalIntegral.integral_comp_sub_mul (fun s : ℝ => s ^ (-(1 / 2 : ℝ))) hc, + integral_rpow (Or.inl (by norm_num : (-1 : ℝ) < -(1 / 2 : ℝ)))] + have ha : u ^ 2 + r ^ 2 - 2 * u * r * 1 = (u - r) ^ 2 := by ring + have hb : u ^ 2 + r ^ 2 - 2 * u * r * (-1) = (u + r) ^ 2 := by ring + norm_num only [neg_div, neg_add_eq_sub, show -(1 / 2 : ℝ) + 1 = 1 / 2 by norm_num] + rw [ha, hb, ← Real.sqrt_eq_rpow, ← Real.sqrt_eq_rpow, Real.sqrt_sq_eq_abs, Real.sqrt_sq_eq_abs] + rw [abs_of_nonneg (by positivity : 0 ≤ u + r)] + simp only [smul_eq_mul] + rcases le_total u r with h | h + · rw [max_eq_right h, abs_of_nonpos (sub_nonpos.mpr h)] + field_simp [ne_of_gt hu, ne_of_gt hr] + ring + · rw [max_eq_left h, abs_of_nonneg (sub_nonneg.mpr h)] + field_simp [ne_of_gt hu, ne_of_gt hr] + ring + +/-- The squared distance is positive before the possibly singular right endpoint. -/ +lemma newton_polynomial_pos {u r t : ℝ} (hu : 0 < u) (hr : 0 < r) + (ht : t < 1) : 0 < u ^ 2 + r ^ 2 - 2 * u * r * t := by + have hp : 0 < (2 * u * r) * (1 - t) := mul_pos (by positivity) (sub_pos.mpr ht) + nlinarith only [sq_nonneg (u - r), hp] + +/-- Evaluation of the extended integral, retaining its possibly infinite endpoint value. -/ +lemma lintegral_newton_rpow {u r : ℝ} (hu : 0 < u) (hr : 0 < r) : + (∫⁻ t : ℝ in Icc (-1) 1, + (ENNReal.ofReal (Real.sqrt (u ^ 2 + r ^ 2 - 2 * u * r * t)))⁻¹) = + ENNReal.ofReal (2 / max u r) := by + have hfi := (intervalIntegrable_iff_integrableOn_Icc_of_le (by norm_num : (-1 : ℝ) ≤ 1)).mp + (intervalIntegrable_newton_rpow hu hr) + have heq : (fun t : ℝ => (ENNReal.ofReal (Real.sqrt (u ^ 2 + r ^ 2 - 2 * u * r * t)))⁻¹) =ᵐ[ + volume.restrict (Icc (-1 : ℝ) 1)] + (fun t : ℝ => ENNReal.ofReal ((u ^ 2 + r ^ 2 - 2 * u * r * t) ^ (-(1 / 2 : ℝ)))) := by + filter_upwards [ae_restrict_mem measurableSet_Icc, + ae_restrict_of_ae (volume.ae_ne (1 : ℝ))] with t ht hne + have hp := newton_polynomial_pos hu hr (lt_of_le_of_ne ht.2 hne) + rw [← ENNReal.ofReal_inv_of_pos (Real.sqrt_pos.mpr hp), + Real.rpow_neg hp.le, ← Real.sqrt_eq_rpow] + rw [lintegral_congr_ae heq, ← ofReal_integral_eq_lintegral_ofReal hfi] + · rw [integral_Icc_eq_integral_Ioc, ← intervalIntegral.integral_of_le + (by norm_num : (-1 : ℝ) ≤ 1), integral_newton_rpow hu hr] + · filter_upwards [ae_restrict_mem measurableSet_Icc] with t ht + apply Real.rpow_nonneg + have hp : 0 ≤ (2 * u * r) * (1 - t) := mul_nonneg (by positivity) (sub_nonneg.mpr ht.2) + nlinarith only [sq_nonneg (u - r), hp] + +/-- The one-dimensional Newton average, including the singular endpoint when `u = r`. -/ +theorem newton_angular_integral {u r : ℝ} (hu : 0 ≤ u) (hr : 0 < r) : + (ENNReal.ofReal 2)⁻¹ * (∫⁻ t : ℝ in Icc (-1) 1, + (ENNReal.ofReal (Real.sqrt (u ^ 2 + r ^ 2 - 2 * u * r * t)))⁻¹) = + (ENNReal.ofReal (max u r))⁻¹ := by + rcases hu.eq_or_lt with hu | hu + · subst u + simp only [zero_pow (by norm_num : 2 ≠ 0), mul_zero, zero_mul, zero_add, sub_zero, + Real.sqrt_sq hr.le, lintegral_const, max_eq_right hr.le] + rw [Measure.restrict_apply_univ, Real.volume_Icc] + norm_num only [show (1 : ℝ) - (-1) = 2 by norm_num] + rw [mul_comm ((ENNReal.ofReal r)⁻¹), ← mul_assoc] + rw [ENNReal.inv_mul_cancel (by norm_num) (by norm_num), one_mul] + · rw [lintegral_newton_rpow hu hr, + ← ENNReal.ofReal_inv_of_pos (by norm_num : (0 : ℝ) < 2), + ← ENNReal.ofReal_mul (by norm_num : (0 : ℝ) ≤ 2⁻¹)] + have hcalc : (2 : ℝ)⁻¹ * (2 / max u r) = (max u r)⁻¹ := by ring + rw [hcalc, ENNReal.ofReal_inv_of_pos (lt_of_lt_of_le hr (le_max_right u r))] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/Plane.lean b/LeanPool/LiebThirring/Electrostatics/Plane.lean new file mode 100644 index 0000000000..3734914305 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/Plane.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.Configuration + +/-! +# Affine planar surface measure + +Orthonormal affine frames define plane surface measures as pushforwards of planar volume. +-/ + +@[expose] public section + +open MeasureTheory +open scoped ENNReal + +namespace LiebThirring + +/-- Euclidean parameter space for an orthonormal plane frame. -/ +abbrev Planar := EuclideanSpace ℝ (Fin 2) + +/-- The affine plane through `b` with normal `n`, given by its orthogonal direction. -/ +noncomputable def affinePlane (n b : Position) : AffineSubspace ℝ Position := + AffineSubspace.mk' b (ℝ ∙ n)ᗮ + +@[simp] theorem mem_affinePlane (n b x : Position) : + x ∈ affinePlane n b ↔ inner ℝ n (x - b) = 0 := by + exact Submodule.mem_orthogonal_singleton_iff_inner_right + +instance (n b : Position) : Nonempty (affinePlane n b) := + ⟨⟨b, AffineSubspace.self_mem_mk' b (ℝ ∙ n)ᗮ⟩⟩ + +/-- An orthonormal affine frame onto the indicated affine subspace. -/ +abbrev PlaneFrame (H : AffineSubspace ℝ Position) [Nonempty H] := + Planar ≃ᵃⁱ[ℝ] H + +/-- Build a named affine frame from an orthonormal basis and a point on the plane. -/ +noncomputable def planeFrameOfBasis {H : AffineSubspace ℝ Position} [Nonempty H] + (B : OrthonormalBasis (Fin 2) ℝ H.direction) (p : H) : PlaneFrame H := + B.repr.symm.toAffineIsometryEquiv.trans (AffineIsometryEquiv.vaddConst ℝ p) + +/-- A nonzero normal gives a two-dimensional affine plane. -/ +theorem finrank_affinePlane_direction (n b : Position) (hn : n ≠ 0) : + Module.finrank ℝ (affinePlane n b).direction = 2 := by + change Module.finrank ℝ (AffineSubspace.mk' b (ℝ ∙ n)ᗮ).direction = 2 + rw [AffineSubspace.direction_mk'] + let : Fact (Module.finrank ℝ Position = 2 + 1) := ⟨finrank_euclideanSpace⟩ + exact Submodule.finrank_orthogonal_span_singleton hn + +/-- An orthonormal affine frame exists for every plane with nonzero normal. -/ +theorem nonempty_planeFrame (n b : Position) (hn : n ≠ 0) : + Nonempty (PlaneFrame (affinePlane n b)) := by + let B := (stdOrthonormalBasis ℝ (affinePlane n b).direction).reindex + (Fin.castOrderIso (finrank_affinePlane_direction n b hn)).toEquiv + exact ⟨planeFrameOfBasis B ⟨b, AffineSubspace.self_mem_mk' b (ℝ ∙ n)ᗮ⟩⟩ + +/-- Surface measure in a named orthonormal affine frame. -/ +noncomputable def planeMeasure {H : AffineSubspace ℝ Position} [Nonempty H] + (F : PlaneFrame H) : Measure Position := + Measure.map (Subtype.val ∘ F) volume + +/-- Affine Euclidean isometries preserve planar Lebesgue measure, including translations. -/ +theorem measurePreserving_planar_affineIsometry (e : Planar ≃ᵃⁱ[ℝ] Planar) : + MeasurePreserving e volume volume := by + have h := (measurePreserving_add_right (volume : Measure Planar) (e 0)).comp + e.linearIsometryEquiv.measurePreserving + convert h using 1 + funext x + change e x = e.linearIsometryEquiv x + e 0 + simpa only [vadd_eq_add, add_zero] using (e.map_vadd (0 : Planar) x) + +/-- Changing the orthonormal frame and its origin does not change surface measure. -/ +theorem planeMeasure_eq {H : AffineSubspace ℝ Position} [Nonempty H] + (F G : PlaneFrame H) : planeMeasure F = planeMeasure G := by + let e := F.trans G.symm + have he := (measurePreserving_planar_affineIsometry e).map_eq + have hG : Measurable (Subtype.val ∘ G) := + continuous_subtype_val.measurable.comp G.continuous.measurable + have hcomp : (Subtype.val ∘ G) ∘ e = Subtype.val ∘ F := by + funext q + exact congrArg Subtype.val (G.apply_symm_apply (F q)) + unfold planeMeasure + rw [← hcomp, ← Measure.map_map hG e.continuous.measurable, he] + +/-- Integration against the planar surface measure is integration in its frame. -/ +theorem lintegral_planeMeasure {H : AffineSubspace ℝ Position} [Nonempty H] + (F : PlaneFrame H) (h : Position → ℝ≥0∞) (hh : Measurable h) : + ∫⁻ x, h x ∂planeMeasure F = ∫⁻ q, h (F q : Position) := by + exact lintegral_map hh (continuous_subtype_val.measurable.comp F.continuous.measurable) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/PlaneCofactor.lean b/LeanPool/LiebThirring/Electrostatics/PlaneCofactor.lean new file mode 100644 index 0000000000..eca21b3e02 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/PlaneCofactor.lean @@ -0,0 +1,128 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.PlaneProjection + +/-! +# The normal component of the planar projection Jacobian + +Deleting one row and the last column of an orthogonal matrix gives an absolute minor equal to +the corresponding last-column entry. + +The two unit direction vectors of an orthonormal affine frame. +-/ + +@[expose] public section + +open MeasureTheory Matrix +open scoped Matrix + +namespace LiebThirring + +/-- Deleting one row and the last column of an orthogonal matrix gives an absolute +minor equal to the corresponding last-column entry. -/ +theorem abs_det_minor_eq_abs_last_column + (Q : Matrix (Fin 3) (Fin 3) ℝ) (hQ : Qᵀ * Q = 1) (a : Fin 3) : + |(Q.submatrix a.succAbove (2 : Fin 3).succAbove).det| = |Q a 2| := by + have hQQ : Q * Qᵀ = 1 := mul_eq_one_comm.mp hQ + have hadj : Q.adjugate = Q.det • Qᵀ := by + calc + Q.adjugate = Q.adjugate * (Q * Qᵀ) := by rw [hQQ, mul_one] + _ = (Q.adjugate * Q) * Qᵀ := (mul_assoc _ _ _).symm + _ = Q.det • Qᵀ := by rw [Matrix.adjugate_mul, smul_mul_assoc, one_mul] + have hdet : |Q.det| = 1 := by + have hd := congrArg Matrix.det hQ + rw [Matrix.det_mul, Matrix.det_transpose, Matrix.det_one] at hd + have hdabs : |Q.det| * |Q.det| = 1 := by rw [← abs_mul, hd, abs_one] + nlinarith only [hdabs, abs_nonneg Q.det] + have he := congrArg (fun M : Matrix (Fin 3) (Fin 3) ℝ => M 2 a) hadj + rw [Matrix.adjugate_fin_succ_eq_det_submatrix, Matrix.smul_apply, + Matrix.transpose_apply, smul_eq_mul] at he + have heabs := congrArg abs he + simpa only [abs_mul, abs_pow, abs_neg, abs_one, one_pow, one_mul, hdet] using heabs + +/-- The two unit direction vectors of an orthonormal affine frame. -/ +noncomputable def planeFrameVector (n b : Position) + (F : PlaneFrame (affinePlane n b)) (i : Fin 2) : Position := + F.linearIsometryEquiv (EuclideanSpace.basisFun (Fin 2) ℝ i) + +/-- The frame direction vectors are orthonormal. -/ +theorem inner_planeFrameVector (n b : Position) (F : PlaneFrame (affinePlane n b)) + (i j : Fin 2) : inner ℝ (planeFrameVector n b F i) (planeFrameVector n b F j) = + if i = j then 1 else 0 := by + change inner ℝ (F.linearIsometryEquiv (EuclideanSpace.basisFun (Fin 2) ℝ i)) + (F.linearIsometryEquiv (EuclideanSpace.basisFun (Fin 2) ℝ j)) = _ + rw [F.linearIsometryEquiv.inner_map_map, OrthonormalBasis.inner_eq_ite] + +/-- The frame direction vectors are perpendicular to the given normal. -/ +theorem inner_normal_planeFrameVector (n b : Position) (F : PlaneFrame (affinePlane n b)) + (i : Fin 2) : inner ℝ n (planeFrameVector n b F i) = 0 := by + have hi := (F.linearIsometryEquiv (EuclideanSpace.basisFun (Fin 2) ℝ i)).property + change planeFrameVector n b F i ∈ (AffineSubspace.mk' b (ℝ ∙ n)ᗮ).direction at hi + rw [AffineSubspace.direction_mk'] at hi + exact Submodule.mem_orthogonal_singleton_iff_inner_right.mp hi + +/-- Columns of the affine frame's linear part, followed by the normal. -/ +noncomputable def planeFrameMatrix (n b : Position) + (F : PlaneFrame (affinePlane n b)) : Matrix (Fin 3) (Fin 3) ℝ := + fun i j => (![planeFrameVector n b F 0, planeFrameVector n b F 1, n] j) i + +/-- The completed frame columns are orthonormal when its normal has unit norm. -/ +theorem planeFrameMatrix_inner_columns (n b : Position) (hn : ‖n‖ = 1) + (F : PlaneFrame (affinePlane n b)) (i j : Fin 3) : + inner ℝ (![planeFrameVector n b F 0, planeFrameVector n b F 1, n] i) + (![planeFrameVector n b F 0, planeFrameVector n b F 1, n] j) = + if i = j then 1 else 0 := by + fin_cases i <;> fin_cases j + · exact inner_planeFrameVector n b F 0 0 + · exact inner_planeFrameVector n b F 0 1 + · exact (real_inner_comm _ _).trans (inner_normal_planeFrameVector n b F 0) + · exact inner_planeFrameVector n b F 1 0 + · exact inner_planeFrameVector n b F 1 1 + · exact (real_inner_comm _ _).trans (inner_normal_planeFrameVector n b F 1) + · exact inner_normal_planeFrameVector n b F 0 + · exact inner_normal_planeFrameVector n b F 1 + · change inner ℝ n n = 1 + rw [real_inner_self_eq_norm_sq, hn, one_pow] + +/-- The completed frame matrix is orthogonal when its normal has unit norm. -/ +theorem planeFrameMatrix_transpose_mul (n b : Position) (hn : ‖n‖ = 1) + (F : PlaneFrame (affinePlane n b)) : + (planeFrameMatrix n b F)ᵀ * planeFrameMatrix n b F = 1 := by + ext i j + rw [Matrix.mul_apply, Matrix.one_apply] + change (∑ k : Fin 3, + (![planeFrameVector n b F 0, planeFrameVector n b F 1, n] i) k * + (![planeFrameVector n b F 0, planeFrameVector n b F 1, n] j) k) = _ + rw [← planeFrameMatrix_inner_columns n b hn F i j, PiLp.inner_apply] + simp only [RCLike.inner_apply, starRingEnd_apply, star_trivial, mul_comm] + +/-- The projection chart's matrix is the corresponding minor of the completed frame. -/ +theorem planeProjectionChart_toMatrix (n b : Position) (a : Fin 3) (ha : n a ≠ 0) + (F : PlaneFrame (affinePlane n b)) : + LinearMap.toMatrix (PiLp.basisFun 2 ℝ (Fin 2)) (PiLp.basisFun 2 ℝ (Fin 2)) + ((planeProjectionChart n b a ha F).linear : Planar →ₗ[ℝ] Planar) = + (planeFrameMatrix n b F).submatrix a.succAbove (2 : Fin 3).succAbove := by + ext i j + rw [LinearMap.toMatrix_apply, PiLp.basisFun_repr] + fin_cases j <;> rfl + +/-- The absolute area Jacobian of coordinate deletion is the absolute normal component. -/ +theorem abs_det_planeProjectionChart (n b : Position) (hn : ‖n‖ = 1) + (a : Fin 3) (ha : n a ≠ 0) (F : PlaneFrame (affinePlane n b)) : + |LinearMap.det ((planeProjectionChart n b a ha F).linear : Planar →ₗ[ℝ] Planar)| = + |n a| := by + rw [← LinearMap.det_toMatrix (PiLp.basisFun 2 ℝ (Fin 2)), + planeProjectionChart_toMatrix] + exact abs_det_minor_eq_abs_last_column _ (planeFrameMatrix_transpose_mul n b hn F) a + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/PlaneDistance.lean b/LeanPool/LiebThirring/Electrostatics/PlaneDistance.lean new file mode 100644 index 0000000000..7fc2c06402 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/PlaneDistance.lean @@ -0,0 +1,145 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.Plane +public import LeanPool.LiebThirring.Defs.Coulomb + +/-! +# Distance from a point to a parametrized affine plane + +The perpendicular foot on a plane with unit normal. + +The nonnegative height of a point above a plane with unit normal. +-/ + +@[expose] public section + +open MeasureTheory +open scoped ENNReal + +namespace LiebThirring + +/-- The perpendicular foot on a plane with unit normal. -/ +noncomputable def planeFoot (n b x : Position) : Position := + x - inner ℝ n (x - b) • n + +/-- The nonnegative height of a point above a plane with unit normal. -/ +noncomputable def planeHeight (n b x : Position) : ℝ := + |inner ℝ n (x - b)| + +theorem planeHeight_nonneg (n b x : Position) : 0 ≤ planeHeight n b x := + abs_nonneg _ + +/-- The perpendicular foot satisfies the literal plane equation. -/ +theorem planeFoot_mem (n b x : Position) (hn : ‖n‖ = 1) : + planeFoot n b x ∈ affinePlane n b := by + rw [mem_affinePlane] + have hn' : inner ℝ n n = 1 := by + rw [real_inner_self_eq_norm_sq, hn] + norm_num + have he : planeFoot n b x - b = (x - b) - inner ℝ n (x - b) • n := by + simp only [planeFoot] + abel + rw [he, inner_sub_right, inner_smul_right, hn', mul_one, sub_self] + +/-- The centre-to-foot vector is the signed height times the unit normal. -/ +theorem sub_planeFoot (n b x : Position) : + x - planeFoot n b x = inner ℝ n (x - b) • n := by + simp only [planeFoot, sub_sub_cancel] + +/-- Every vector in the plane is perpendicular to its centre-to-foot vector. -/ +theorem inner_sub_planeFoot_sub_eq_zero (n b x y : Position) (hn : ‖n‖ = 1) + (hy : y ∈ affinePlane n b) : + inner ℝ (x - planeFoot n b x) (planeFoot n b x - y) = 0 := by + have hp := planeFoot_mem n b x hn + rw [mem_affinePlane] at hp hy + have he : planeFoot n b x - y = (planeFoot n b x - b) - (y - b) := by abel + have horth : inner ℝ n (planeFoot n b x - y) = 0 := by + rw [he, inner_sub_right, hp, hy, sub_self] + rw [sub_planeFoot, inner_smul_left, horth, mul_zero] + +/-- Pythagoras for the perpendicular foot and any point of the plane. -/ +theorem norm_sub_sq_eq_planeFoot (n b x y : Position) (hn : ‖n‖ = 1) + (hy : y ∈ affinePlane n b) : + ‖x - y‖ ^ 2 = ‖planeFoot n b x - y‖ ^ 2 + planeHeight n b x ^ 2 := by + have he : x - y = (x - planeFoot n b x) + (planeFoot n b x - y) := by abel + rw [he, norm_add_sq_real, + inner_sub_planeFoot_sub_eq_zero n b x y hn hy, mul_zero, add_zero, + sub_planeFoot, norm_smul, hn] + simp only [Real.norm_eq_abs, mul_one, planeHeight] + exact add_comm _ _ + +/-- Rebase an orthonormal frame at the perpendicular foot of the centre. -/ +noncomputable def planeFrameAtFoot (n b x : Position) (hn : ‖n‖ = 1) + (F : PlaneFrame (affinePlane n b)) : PlaneFrame (affinePlane n b) := + (AffineIsometryEquiv.constVAdd ℝ Planar + (F.symm ⟨planeFoot n b x, planeFoot_mem n b x hn⟩)).trans F + +@[simp] theorem planeFrameAtFoot_zero (n b x : Position) (hn : ‖n‖ = 1) + (F : PlaneFrame (affinePlane n b)) : + (planeFrameAtFoot n b x hn F 0 : Position) = planeFoot n b x := by + simp [planeFrameAtFoot] + +/-- Radial planar coordinates give the exact squared distance, including off-plane centres. -/ +theorem norm_sub_planeFrameAtFoot_sq (n b x : Position) (hn : ‖n‖ = 1) + (F : PlaneFrame (affinePlane n b)) (q : Planar) : + ‖x - (planeFrameAtFoot n b x hn F q : Position)‖ ^ 2 = + ‖q‖ ^ 2 + planeHeight n b x ^ 2 := by + let G := planeFrameAtFoot n b x hn F + have hd : ‖planeFoot n b x - (G q : Position)‖ = ‖q‖ := by + rw [← planeFrameAtFoot_zero n b x hn F] + change ‖(G 0 : Position) - (G q : Position)‖ = ‖q‖ + rw [← dist_eq_norm] + change dist (G 0) (G q) = ‖q‖ + rw [G.dist_map, dist_zero_left] + rw [norm_sub_sq_eq_planeFoot n b x _ hn (G q).property, hd] + +/-- The literal distance in a foot-based frame is the radial square-root expression. -/ +theorem norm_sub_planeFrameAtFoot_eq_sqrt (n b x : Position) (hn : ‖n‖ = 1) + (F : PlaneFrame (affinePlane n b)) (q : Planar) : + ‖x - (planeFrameAtFoot n b x hn F q : Position)‖ = + Real.sqrt (‖q‖ ^ 2 + planeHeight n b x ^ 2) := by + rw [← norm_sub_planeFrameAtFoot_sq n b x hn F q, Real.sqrt_sq (norm_nonneg _)] + +/-- Exact radial Coulomb expression; when both radius and height vanish its value is infinity. -/ +theorem coulombKernel_planeFrameAtFoot (n b x : Position) (hn : ‖n‖ = 1) + (F : PlaneFrame (affinePlane n b)) (q : Planar) : + coulombKernel x (planeFrameAtFoot n b x hn F q : Position) = + (ENNReal.ofReal (Real.sqrt (‖q‖ ^ 2 + planeHeight n b x ^ 2)))⁻¹ := by + rw [coulombKernel, norm_sub_planeFrameAtFoot_eq_sqrt] + +/-- Frame independence permits the perpendicular-foot chart for all measurable integrands. -/ +theorem lintegral_planeMeasure_atFoot (n b x : Position) (hn : ‖n‖ = 1) + (F : PlaneFrame (affinePlane n b)) (f : Position → ℝ≥0∞) (hf : Measurable f) : + ∫⁻ y, f y ∂planeMeasure F = + ∫⁻ q, f (planeFrameAtFoot n b x hn F q : Position) := by + rw [planeMeasure_eq F (planeFrameAtFoot n b x hn F), lintegral_planeMeasure _ f hf] + +/-- The ambient ball truncation becomes its exact radial square-root cutoff. +No positivity condition on the radius and no restriction on the centre is needed. -/ +theorem lintegral_coulombKernel_ball_planeMeasure (n b x : Position) (hn : ‖n‖ = 1) + (F : PlaneFrame (affinePlane n b)) (ε : ℝ) : + ∫⁻ y in Metric.ball x ε, coulombKernel x y ∂planeMeasure F = + ∫⁻ q : Planar, if Real.sqrt (‖q‖ ^ 2 + planeHeight n b x ^ 2) < ε then + (ENNReal.ofReal (Real.sqrt (‖q‖ ^ 2 + planeHeight n b x ^ 2)))⁻¹ else 0 := by + classical + have hf : Measurable (coulombKernel x) := + ((measurable_const.sub measurable_id).norm.ennreal_ofReal).inv + rw [← lintegral_indicator measurableSet_ball, + lintegral_planeMeasure_atFoot n b x hn F _ (hf.indicator measurableSet_ball)] + apply lintegral_congr + intro q + rw [Set.indicator_apply] + simp only [Metric.mem_ball, dist_eq_norm, norm_sub_rev, + norm_sub_planeFrameAtFoot_eq_sqrt, coulombKernel_planeFrameAtFoot] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/PlaneFormula.lean b/LeanPool/LiebThirring/Electrostatics/PlaneFormula.lean new file mode 100644 index 0000000000..59a979df67 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/PlaneFormula.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.MeasureTheory.Integral.Bochner.Basic +public import LeanPool.LiebThirring.Electrostatics.PlaneCofactor + +/-! +# Plane projection integration formula + +Coordinate formulas for nonnegative extended integration on affine planes. +-/ + +@[expose] public section + +open MeasureTheory +open scoped ENNReal + +namespace LiebThirring + +/-- The inverse coordinate projection chart is a closed embedding into ambient space. -/ +theorem isClosedEmbedding_planeGraph (n b : Position) (a : Fin 3) (ha : n a ≠ 0) : + Topology.IsClosedEmbedding (planeGraph n b a ha) := by + have hn : n ≠ 0 := by + intro hn + subst n + exact ha rfl + obtain ⟨F⟩ := nonempty_planeFrame n b hn + let e := planeProjectionChart n b a ha F + have hfun : planeGraph n b a ha = Subtype.val ∘ (F ∘ e.symm) := by + funext q + exact (planeProjectionChart_symm_frame n b a ha F q).symm + rw [hfun] + exact (affinePlane n b).closed_of_finiteDimensional.isClosedEmbedding_subtypeVal.comp + (F.toHomeomorph.isClosedEmbedding.comp + (AffineEquiv.toContinuousAffineEquiv e.symm).toHomeomorph.isClosedEmbedding) + +/-- The plane surface measure equals the explicit graph pushforward times the inverse +absolute normal coordinate. -/ +theorem planeMeasure_eq_projection_map (n b : Position) (hn : ‖n‖ = 1) + (a : Fin 3) (ha : n a ≠ 0) (F : PlaneFrame (affinePlane n b)) : + planeMeasure F = ENNReal.ofReal (|n a|⁻¹) • Measure.map (planeGraph n b a ha) volume := by + let e := planeProjectionChart n b a ha F + have he : Measure.map (e : Planar → Planar) volume = + ENNReal.ofReal (|n a|⁻¹) • volume := by + rw [map_planar_affineEquiv_volume, abs_inv] + rw [abs_det_planeProjectionChart n b hn a ha F] + have hcomp : planeGraph n b a ha ∘ (e : Planar → Planar) = Subtype.val ∘ F := by + funext q + exact planeGraph_planeProjection n b a ha (F q) (F q).property + have hg := (isClosedEmbedding_planeGraph n b a ha).continuous.measurable + have hem : Measurable (e : Planar → Planar) := e.continuous_of_finiteDimensional.measurable + rw [planeMeasure, ← hcomp, ← Measure.map_map hg hem, he, Measure.map_smul _ hg.aemeasurable] + +/-- Real integrability on the plane is exactly integrability in the coordinate projection chart. -/ +theorem integrable_planeMeasure_projection_iff (n b : Position) (hn : ‖n‖ = 1) + (a : Fin 3) (ha : n a ≠ 0) (F : PlaneFrame (affinePlane n b)) (h : Position → ℝ) : + Integrable h (planeMeasure F) ↔ Integrable (h ∘ planeGraph n b a ha) volume := by + rw [planeMeasure_eq_projection_map n b hn a ha F, + integrable_smul_measure + (ENNReal.ofReal_ne_zero_iff.mpr (inv_pos.mpr (abs_pos.mpr ha))) ENNReal.ofReal_ne_top] + exact (isClosedEmbedding_planeGraph n b a ha).measurableEmbedding.integrable_map_iff + +/-- Real coordinate projection formula (3.2). +The closed embedding also makes this valid for the total Bochner integral convention; +`integrable_planeMeasure_projection_iff` identifies the integrable locus. -/ +theorem integral_planeMeasure_projection (n b : Position) (hn : ‖n‖ = 1) + (a : Fin 3) (ha : n a ≠ 0) (F : PlaneFrame (affinePlane n b)) (h : Position → ℝ) : + ∫ x, h x ∂planeMeasure F = |n a|⁻¹ * ∫ q, h (planeGraph n b a ha q) := by + rw [planeMeasure_eq_projection_map n b hn a ha F, integral_smul_measure, + (isClosedEmbedding_planeGraph n b a ha).integral_map h, + ENNReal.toReal_ofReal (inv_nonneg.mpr (abs_nonneg _)), smul_eq_mul] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/PlaneLocal.lean b/LeanPool/LiebThirring/Electrostatics/PlaneLocal.lean new file mode 100644 index 0000000000..52ccf3002b --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/PlaneLocal.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.PlaneDistance +public import LeanPool.LiebThirring.Electrostatics.PlanePolar +public import LeanPool.LiebThirring.Electrostatics.PlaneRadialIntegral + +/-! +# Local planar Coulomb integration + +The truncated radial inverse-distance integrand is Borel measurable. + +Exact planar Coulomb integral with arbitrary nonnegative normal height. +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal + +namespace LiebThirring + +/-- The truncated radial inverse-distance integrand is Borel measurable. -/ +theorem measurable_truncated_planar_coulomb (h ε : ℝ) : + Measurable (fun r : ℝ => if Real.sqrt (r ^ 2 + h ^ 2) < ε then + (ENNReal.ofReal (Real.sqrt (r ^ 2 + h ^ 2)))⁻¹ else 0) := by + have hc : Continuous (fun r : ℝ => Real.sqrt (r ^ 2 + h ^ 2)) := + Real.continuous_sqrt.comp ((continuous_id.pow 2).add continuous_const) + exact (hc.measurable.ennreal_ofReal.inv).ite + (isOpen_lt hc continuous_const).measurableSet measurable_const + +/-- Exact planar Coulomb integral with arbitrary nonnegative normal height. -/ +theorem lintegral_planar_coulomb_cutoff (h ε : ℝ) (hh : 0 ≤ h) : + (∫⁻ q : Planar, if Real.sqrt (‖q‖ ^ 2 + h ^ 2) < ε then + (ENNReal.ofReal (Real.sqrt (‖q‖ ^ 2 + h ^ 2)))⁻¹ else 0) = + ENNReal.ofReal (2 * Real.pi * max (ε - h) 0) := by + rw [lintegral_planar_norm _ (measurable_truncated_planar_coulomb h ε), + lintegral_coulomb_radial h ε hh, + ← ENNReal.ofReal_mul (by positivity : 0 ≤ 2 * Real.pi)] + +/-- Exact local Coulomb mass in a plane at any centre, on or off the plane. -/ +theorem lintegral_coulombKernel_ball_planeMeasure_eq (n b x : Position) + (hn : ‖n‖ = 1) (F : PlaneFrame (affinePlane n b)) (ε : ℝ) : + (∫⁻ y in Metric.ball x ε, coulombKernel x y ∂planeMeasure F) = + ENNReal.ofReal (2 * Real.pi * max (ε - planeHeight n b x) 0) := by + rw [lintegral_coulombKernel_ball_planeMeasure n b x hn F ε, + lintegral_planar_coulomb_cutoff _ ε (planeHeight_nonneg n b x)] + +/-- The local planar Coulomb bound, including off-plane centres and the +infinite diagonal value of the Coulomb kernel. -/ +theorem lintegral_coulombKernel_ball_planeMeasure_le (n b x : Position) + (hn : ‖n‖ = 1) (F : PlaneFrame (affinePlane n b)) {ε : ℝ} (hε : 0 < ε) : + (∫⁻ y in Metric.ball x ε, coulombKernel x y ∂planeMeasure F) ≤ + ENNReal.ofReal (2 * Real.pi * ε) := by + rw [lintegral_coulombKernel_ball_planeMeasure_eq n b x hn F] + apply ENNReal.ofReal_le_ofReal + apply mul_le_mul_of_nonneg_left _ (by positivity : 0 ≤ 2 * Real.pi) + exact max_le (sub_le_self ε (planeHeight_nonneg n b x)) hε.le + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/PlanePolar.lean b/LeanPool/LiebThirring/Electrostatics/PlanePolar.lean new file mode 100644 index 0000000000..a3bab07cf6 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/PlanePolar.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.SpecialFunctions.PolarCoord +public import LeanPool.LiebThirring.Electrostatics.Plane + +/-! +# Polar integration on the Euclidean plane + +Planar polar integration for the singular Coulomb kernel. +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal + +namespace LiebThirring + +/-- Nonnegative radial integration on the Euclidean plane, with angular mass `2π`. -/ +theorem lintegral_planar_norm (g : ℝ → ℝ≥0∞) (hg : Measurable g) : + ∫⁻ q : Planar, g ‖q‖ = ENNReal.ofReal (2 * Real.pi) * + ∫⁻ r in Ioi (0 : ℝ), ENNReal.ofReal r * g r := by + let e := Complex.orthonormalBasisOneI.repr + calc + (∫⁻ q : Planar, g ‖q‖) = ∫⁻ z : ℂ, g ‖z‖ := by + simpa only [Function.comp_def, e.norm_map] using + (e.measurePreserving.lintegral_comp_emb e.toHomeomorph.measurableEmbedding + (fun q : Planar => g ‖q‖)).symm + _ = ∫⁻ p in polarCoord.target, ENNReal.ofReal p.1 * g p.1 := by + rw [← Complex.lintegral_comp_polarCoord_symm] + apply setLIntegral_congr_fun polarCoord.open_target.measurableSet + intro p hp + simp only [Complex.norm_polarCoord_symm, abs_of_pos hp.1, smul_eq_mul] + _ = _ := by + change (∫⁻ p in Ioi (0 : ℝ) ×ˢ Ioo (-Real.pi) Real.pi, + ENNReal.ofReal p.1 * g p.1 ∂(volume.prod volume)) = _ + rw [← Measure.prod_restrict] + have hf : Measurable (fun p : ℝ × ℝ => ENNReal.ofReal p.1 * g p.1) := + measurable_fst.ennreal_ofReal.mul (hg.comp measurable_fst) + rw [lintegral_prod _ hf.aemeasurable] + simp only [lintegral_const, Measure.restrict_apply_univ] + rw [Real.volume_Ioo] + have hπ : Real.pi - -Real.pi = 2 * Real.pi := by ring + have hrg : Measurable (fun r : ℝ => ENNReal.ofReal r * g r) := + measurable_id.ennreal_ofReal.mul hg + rw [hπ, lintegral_mul_const _ hrg] + exact mul_comm _ _ + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/PlaneProjection.lean b/LeanPool/LiebThirring/Electrostatics/PlaneProjection.lean new file mode 100644 index 0000000000..89b3380393 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/PlaneProjection.lean @@ -0,0 +1,158 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.Plane + +/-! +# Coordinate projection charts on affine planes + +Delete coordinate `a`, retaining the Euclidean norm on the remaining coordinates. + +The graph formula solving the omitted coordinate of a plane. +-/ + +@[expose] public section + +open MeasureTheory WithLp +open scoped ENNReal + +namespace LiebThirring + +/-- Delete coordinate `a`, retaining the Euclidean norm on the remaining coordinates. -/ +noncomputable def planeProjection (a : Fin 3) (x : Position) : Planar := + toLp 2 (fun i => x (a.succAbove i)) + +/-- The graph formula solving the omitted coordinate of a plane. -/ +noncomputable def planeGraph (n b : Position) (a : Fin 3) (_ha : n a ≠ 0) (q : Planar) : Position := + toLp 2 (a.insertNth + (b a - (∑ i : Fin 2, n (a.succAbove i) * (q i - b (a.succAbove i))) / n a) + (fun i => q i)) + +@[simp] theorem planeProjection_apply (a : Fin 3) (x : Position) (i : Fin 2) : + planeProjection a x i = x (a.succAbove i) := rfl + +@[simp] theorem planeGraph_apply_same (n b : Position) (a : Fin 3) (ha : n a ≠ 0) (q : Planar) : + planeGraph n b a ha q a = + b a - (∑ i : Fin 2, n (a.succAbove i) * (q i - b (a.succAbove i))) / n a := by + dsimp only [planeGraph] + exact Fin.insertNth_apply_same (α := fun _ => ℝ) a _ _ + +@[simp] theorem planeGraph_apply_succAbove (n b : Position) (a : Fin 3) (ha : n a ≠ 0) (q : Planar) + (i : Fin 2) : planeGraph n b a ha q (a.succAbove i) = q i := by + dsimp only [planeGraph] + exact Fin.insertNth_apply_succAbove (α := fun _ => ℝ) a _ _ i + +/-- The Euclidean plane equation expanded in its three coordinates. -/ +theorem inner_sub_eq_coordinate_sum (n x b : Position) : + inner ℝ n (x - b) = ∑ i : Fin 3, n i * (x i - b i) := by + simp [PiLp.inner_apply, RCLike.inner_apply, mul_comm] + +/-- The graph formula takes values on the plane when the deleted normal coordinate is nonzero. -/ +theorem planeGraph_mem (n b : Position) (a : Fin 3) (ha : n a ≠ 0) (q : Planar) : + planeGraph n b a ha q ∈ affinePlane n b := by + rw [mem_affinePlane, inner_sub_eq_coordinate_sum, Fin.sum_univ_succAbove _ a] + simp only [planeGraph_apply_same, planeGraph_apply_succAbove] + field_simp + ring + +/-- Projecting the graph returns its two parameters. -/ +@[simp] theorem planeProjection_planeGraph (n b : Position) (a : Fin 3) (ha : n a ≠ 0) (q : Planar) + : + planeProjection a (planeGraph n b a ha q) = q := by + ext i + exact planeGraph_apply_succAbove n b a ha q i + +/-- Solving the normal equation reconstructs each point on the plane. -/ +theorem planeGraph_planeProjection (n b : Position) (a : Fin 3) (ha : n a ≠ 0) + (x : Position) (hx : x ∈ affinePlane n b) : + planeGraph n b a ha (planeProjection a x) = x := by + rw [mem_affinePlane, inner_sub_eq_coordinate_sum, Fin.sum_univ_succAbove _ a] at hx + ext i + revert i + rw [a.forall_iff_succAbove] + constructor + · rw [planeGraph_apply_same] + simp only [planeProjection_apply] + have hs : (∑ j : Fin 2, n (a.succAbove j) * (x (a.succAbove j) - b (a.succAbove j))) / n a = b + a - x a := by + apply (div_eq_iff ha).mpr + linarith only [hx] + rw [hs] + ring + · intro j + rw [planeGraph_apply_succAbove, planeProjection_apply] + +/-- Coordinate deletion is bijective on a plane with nonzero corresponding normal component. -/ +theorem planeProjection_bijective (n b : Position) (a : Fin 3) (ha : n a ≠ 0) : + Function.Bijective (fun x : affinePlane n b => planeProjection a (x : Position)) := by + constructor + · intro x y hxy + change planeProjection a (x : Position) = planeProjection a (y : Position) at hxy + apply Subtype.ext + rw [← planeGraph_planeProjection n b a ha x x.property, + ← planeGraph_planeProjection n b a ha y y.property, hxy] + · intro q + exact ⟨⟨planeGraph n b a ha q, planeGraph_mem n b a ha q⟩, + planeProjection_planeGraph n b a ha q⟩ + +/-- Coordinate deletion as a linear map on Euclidean carriers. -/ +noncomputable def planeProjectionLinear (a : Fin 3) : Position →ₗ[ℝ] Planar where + toFun := planeProjection a + map_add' x y := by + ext i + rfl + map_smul' c x := by + ext i + rfl + +/-- Coordinate deletion after an orthonormal frame, as a bijective affine chart. -/ +noncomputable def planeProjectionChart (n b : Position) (a : Fin 3) (ha : n a ≠ 0) + (F : PlaneFrame (affinePlane n b)) : Planar ≃ᵃ[ℝ] Planar := + AffineEquiv.ofBijective (φ := (planeProjectionLinear a).toAffineMap.comp + ((affinePlane n b).subtype.comp F.toAffineEquiv.toAffineMap)) + ((planeProjection_bijective n b a ha).comp F.toAffineEquiv.bijective) + +/-- The inverse of the projection chart, followed by the frame, is the explicit plane graph. -/ +theorem planeProjectionChart_symm_frame (n b : Position) (a : Fin 3) (ha : n a ≠ 0) + (F : PlaneFrame (affinePlane n b)) (q : Planar) : + (F ((planeProjectionChart n b a ha F).symm q) : Position) = planeGraph n b a ha q := by + have hp : planeProjection a (F ((planeProjectionChart n b a ha F).symm q) : Position) = q := + (planeProjectionChart n b a ha F).apply_symm_apply q + calc + _ = planeGraph n b a ha + (planeProjection a (F ((planeProjectionChart n b a ha F).symm q) : Position)) := + (planeGraph_planeProjection n b a ha _ + (F ((planeProjectionChart n b a ha F).symm q)).property).symm + _ = _ := congrArg (planeGraph n b a ha) hp + +/-- A planar affine coordinate change rescales volume by its inverse absolute determinant. -/ +theorem map_planar_affineEquiv_volume (e : Planar ≃ᵃ[ℝ] Planar) : + Measure.map e volume = + ENNReal.ofReal |(LinearMap.det (e.linear : Planar →ₗ[ℝ] Planar))⁻¹| • volume := by + have hfun : (fun x : Planar => x + e 0) ∘ e.linear = e := by + funext x + symm + change e x = e.linear x + e 0 + simpa only [vadd_eq_add, add_zero] using e.map_vadd (0 : Planar) x + have hl : Measurable (e.linear : Planar → Planar) := + e.linear.toLinearMap.continuous_of_finiteDimensional.measurable + have ht : Measurable (fun x : Planar => x + e 0) := + continuous_id.add continuous_const |>.measurable + have hlin : Measure.map (e.linear : Planar → Planar) volume = + ENNReal.ofReal |(LinearMap.det (e.linear : Planar →ₗ[ℝ] Planar))⁻¹| • volume := by + simpa only [LinearEquiv.coe_coe] using + (Measure.map_linearMap_addHaar_eq_smul_addHaar volume e.linear.isUnit_det'.ne_zero) + rw [← hfun, ← Measure.map_map ht hl, hlin, + Measure.map_smul _ ht.aemeasurable, + (measurePreserving_add_right volume (e 0)).map_eq] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/PlaneRadialIntegral.lean b/LeanPool/LiebThirring/Electrostatics/PlaneRadialIntegral.lean new file mode 100644 index 0000000000..2ceb763a02 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/PlaneRadialIntegral.lean @@ -0,0 +1,146 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.SpecialFunctions.Sqrt +public import Mathlib.MeasureTheory.Integral.IntervalIntegral.FundThmCalculus + +/-! +# The scalar radial Coulomb integral in a plane + +The Coulomb radial primitive is differentiable at every point for positive height. + +The real radial Coulomb integral at positive height. +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal + +namespace LiebThirring + +/-- The Coulomb radial primitive is differentiable at every point for positive height. -/ +lemma hasDerivAt_sqrt_sq_add_sq (h x : ℝ) (hh : 0 < h) : + HasDerivAt (fun ρ : ℝ => Real.sqrt (ρ ^ 2 + h ^ 2)) + (x / Real.sqrt (x ^ 2 + h ^ 2)) x := by + have hpos : 0 < x ^ 2 + h ^ 2 := add_pos_of_nonneg_of_pos (sq_nonneg x) (sq_pos_of_pos hh) + have hd : HasDerivAt (fun ρ : ℝ => ρ ^ 2 + h ^ 2) (2 * x) x := by + simpa only [Pi.pow_apply, id_eq, Nat.cast_ofNat, Nat.reduceSub, pow_one, mul_one] + using ((hasDerivAt_id x).pow 2).add_const (h ^ 2) + convert hd.sqrt (ne_of_gt hpos) using 1 + field_simp + +/-- The real radial Coulomb integral at positive height. -/ +lemma integral_coulomb_radial_of_pos (h R : ℝ) (hh : 0 < h) : + (∫ ρ in (0 : ℝ)..R, ρ / Real.sqrt (ρ ^ 2 + h ^ 2)) = + Real.sqrt (R ^ 2 + h ^ 2) - h := by + have hc : Continuous (fun ρ : ℝ => ρ / Real.sqrt (ρ ^ 2 + h ^ 2)) := by + refine continuous_id.div (Real.continuous_sqrt.comp + ((continuous_id.pow 2).add continuous_const)) ?_ + intro ρ + exact ne_of_gt (Real.sqrt_pos.2 + (add_pos_of_nonneg_of_pos (sq_nonneg ρ) (sq_pos_of_pos hh))) + simpa only [zero_pow (by decide : 2 ≠ 0), zero_add, Real.sqrt_sq hh.le] using + intervalIntegral.integral_eq_sub_of_hasDerivAt + (fun x _ => hasDerivAt_sqrt_sq_add_sq h x hh) (hc.intervalIntegrable 0 R) + +/-- Exact nonnegative radial integral on an open interval, including zero height. -/ +theorem lintegral_coulomb_radial_Ioo (h R : ℝ) (hh : 0 ≤ h) (hR : 0 ≤ R) : + (∫⁻ ρ in Ioo (0 : ℝ) R, + ENNReal.ofReal ρ * (ENNReal.ofReal (Real.sqrt (ρ ^ 2 + h ^ 2)))⁻¹) = + ENNReal.ofReal (Real.sqrt (R ^ 2 + h ^ 2) - h) := by + rcases eq_or_lt_of_le hh with rfl | hhpos + · calc + _ = ∫⁻ _ρ in Ioo (0 : ℝ) R, (1 : ℝ≥0∞) := by + refine setLIntegral_congr_fun measurableSet_Ioo (fun ρ hρ => ?_) + simp only [zero_pow (by decide : 2 ≠ 0), add_zero, Real.sqrt_sq hρ.1.le] + exact ENNReal.mul_inv_cancel (ne_of_gt (ENNReal.ofReal_pos.2 hρ.1)) + ENNReal.ofReal_ne_top + _ = _ := by simp only [lintegral_const, one_mul, Measure.restrict_apply_univ, + Real.volume_Ioo, sub_zero, + zero_pow (by decide : 2 ≠ 0), add_zero, Real.sqrt_sq hR] + · have hc : Continuous (fun ρ : ℝ => ρ / Real.sqrt (ρ ^ 2 + h ^ 2)) := by + refine continuous_id.div (Real.continuous_sqrt.comp + ((continuous_id.pow 2).add continuous_const)) ?_ + intro ρ + exact ne_of_gt (Real.sqrt_pos.2 + (add_pos_of_nonneg_of_pos (sq_nonneg ρ) (sq_pos_of_pos hhpos))) + calc + _ = ∫⁻ ρ in Ioo (0 : ℝ) R, + ENNReal.ofReal (ρ / Real.sqrt (ρ ^ 2 + h ^ 2)) := by + refine setLIntegral_congr_fun measurableSet_Ioo (fun ρ _ => ?_) + rw [ENNReal.ofReal_div_of_pos (Real.sqrt_pos.2 + (add_pos_of_nonneg_of_pos (sq_nonneg ρ) (sq_pos_of_pos hhpos))), + div_eq_mul_inv] + _ = ENNReal.ofReal (∫ ρ in Ioo (0 : ℝ) R, + ρ / Real.sqrt (ρ ^ 2 + h ^ 2)) := by + apply (ofReal_integral_eq_lintegral_ofReal + (hc.continuousOn.integrableOn_Icc.mono_set Ioo_subset_Icc_self) ?_).symm + filter_upwards [ae_restrict_mem measurableSet_Ioo] with ρ hρ + exact div_nonneg hρ.1.le (Real.sqrt_nonneg _) + _ = _ := by + rw [restrict_Ioo_eq_restrict_Ioc, ← intervalIntegral.integral_of_le hR, + integral_coulomb_radial_of_pos h R hhpos] + +/-- Distance from a point of the plane to a centre at height `h` is at least `h`. -/ +lemma le_sqrt_sq_add_sq (h ρ : ℝ) (hh : 0 ≤ h) : + h ≤ Real.sqrt (ρ ^ 2 + h ^ 2) := by + calc + h = Real.sqrt (h ^ 2) := (Real.sqrt_sq hh).symm + _ ≤ Real.sqrt (ρ ^ 2 + h ^ 2) := Real.sqrt_le_sqrt + (le_add_of_nonneg_left (sq_nonneg ρ)) + +/-- Exact truncated radial Coulomb integral for every nonnegative height. + +This includes centres outside the ball (`ε ≤ h`), whose contribution is zero, +and centres in the plane (`h = 0`), whose kernel is infinite at the origin. +The radial origin is excluded by `Ioi 0`, as in planar polar coordinates. +-/ +theorem lintegral_coulomb_radial (h ε : ℝ) (hh : 0 ≤ h) : + (∫⁻ ρ in Ioi (0 : ℝ), ENNReal.ofReal ρ * + (if Real.sqrt (ρ ^ 2 + h ^ 2) < ε then + (ENNReal.ofReal (Real.sqrt (ρ ^ 2 + h ^ 2)))⁻¹ else 0)) = + ENNReal.ofReal (max (ε - h) 0) := by + classical + by_cases hlt : h < ε + · have hε : 0 < ε := lt_of_le_of_lt hh hlt + have hd : 0 ≤ ε ^ 2 - h ^ 2 := by + nlinarith only [hh, hlt, hε] + let R : ℝ := Real.sqrt (ε ^ 2 - h ^ 2) + have hR : 0 ≤ R := Real.sqrt_nonneg _ + have hs : Real.sqrt (R ^ 2 + h ^ 2) = ε := by + dsimp [R] + rw [Real.sq_sqrt hd, sub_add_cancel, Real.sqrt_sq hε.le] + have hiff (ρ : ℝ) (hρ : 0 < ρ) : + Real.sqrt (ρ ^ 2 + h ^ 2) < ε ↔ ρ < R := by + rw [Real.sqrt_lt' hε, Real.lt_sqrt hρ.le] + constructor <;> intro h <;> linarith only [h] + calc + _ = ∫⁻ ρ in Ioi (0 : ℝ), (Iio R).indicator + (fun ρ : ℝ => ENNReal.ofReal ρ * + (ENNReal.ofReal (Real.sqrt (ρ ^ 2 + h ^ 2)))⁻¹) ρ := by + refine setLIntegral_congr_fun measurableSet_Ioi (fun ρ hρ => ?_) + by_cases hρR : ρ < R + · rw [ite_eq_left ((hiff ρ hρ).2 hρR), indicator_of_mem (show ρ ∈ Iio R from hρR)] + · rw [ite_eq_right (fun h => hρR ((hiff ρ hρ).1 h)), + mul_zero, indicator_of_notMem (show ρ ∉ Iio R from hρR)] + _ = ∫⁻ ρ in Ioo (0 : ℝ) R, + ENNReal.ofReal ρ * (ENNReal.ofReal (Real.sqrt (ρ ^ 2 + h ^ 2)))⁻¹ := by + rw [setLIntegral_indicator measurableSet_Iio, Iio_inter_Ioi] + _ = _ := by + rw [lintegral_coulomb_radial_Ioo h R hh hR, hs, max_eq_left (sub_nonneg.2 hlt.le)] + · have hε : ε ≤ h := le_of_not_gt hlt + rw [max_eq_right (sub_nonpos.2 hε), ENNReal.ofReal_zero] + refine setLIntegral_eq_zero measurableSet_Ioi (fun ρ _ => ?_) + rw [ite_eq_right (not_lt_of_ge (hε.trans (le_sqrt_sq_add_sq h ρ hh))), mul_zero, Pi.zero_apply] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/PotentialIdentity.lean b/LeanPool/LiebThirring/Electrostatics/PotentialIdentity.lean new file mode 100644 index 0000000000..a4df30b1df --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/PotentialIdentity.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.FaceMeasure +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityCells +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityBounds +public import LeanPool.LiebThirring.Electrostatics.ShellAssemblyGeometry +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityIntegrability +import LeanPool.LiebThirring.Analysis.FundamentalSolution +import LeanPool.LiebThirring.Analysis.WeakHarmonic +import LeanPool.LiebThirring.Electrostatics.Slicing + +/-! +# Equality of the screened and face-charge potentials + +The screened and face-charge potentials have a weakly harmonic difference. Continuity and decay +force that difference to vanish everywhere. +-/ + +public section + +open MeasureTheory Filter Laplacian +open scoped ENNReal NNReal Topology ContDiff + +namespace LiebThirring + +/-- The screened real potential tends uniformly to zero outside large balls. -/ +theorem tendsto_screenedPotentialReal_zero {M : ℕ} (hM : 1 ≤ M) + (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) : + Tendsto (screenedPotentialReal Z R) (Bornology.cobounded Position) (𝓝 0) := by + obtain ⟨C, _, hC⟩ := exists_screenedPotentialReal_le_one_add_norm hM Z R hR + have ht : Tendsto (fun x : Position => C / (1 + ‖x‖)) + (Bornology.cobounded Position) (𝓝 0) := + tendsto_const_nhds.div_atTop + (tendsto_const_nhds.add_atTop tendsto_norm_cobounded_atTop) + exact tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds ht + (Eventually.of_forall (screenedPotentialReal_nonneg Z R)) + (Eventually.of_forall (fun x => (le_abs_self _).trans (hC x))) + +/-- the potential identity from the screened-potential test-function identity for smooth compactly +supported tests. +This is the expansion of the former `ScreenedLaplacianIdentity` premise. -/ +theorem screenedPotential_eq_coulombPotential_of_laplacian_identity {M : ℕ} + (hM : 1 ≤ M) (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) + (hLap : ∀ f : Position → ℝ, ContDiff ℝ ∞ f → HasCompactSupport f → + (∫ x, screenedPotentialReal Z R x * Δ f x) = + -4 * Real.pi * ∫ x, f x ∂voronoiFaceMeasure R hR (Z : ℝ)) + (x : Position) : + screenedPotential Z R x = coulombPotential (voronoiFaceMeasure R hR (Z : ℝ)) x := by + let ν := voronoiFaceMeasure R hR (Z : ℝ) + have : IsFiniteMeasure ν := isFiniteMeasure_voronoiFaceMeasure R hR Z.coe_nonneg + let C : ℝ≥0∞ := ENNReal.ofReal (voronoiDecayCoefficient R (Z : ℝ)) + have hC : C ≠ ⊤ := ENNReal.ofReal_ne_top + have hν : ∀ y, coulombPotential ν y ≤ C := by + intro y + exact (coulombPotential_voronoiFaceMeasure_decay R hR Z.coe_nonneg y).trans + (ENNReal.ofReal_le_ofReal (div_le_self (voronoiDecayCoefficient_nonneg R Z.coe_nonneg) + (le_add_of_nonneg_right (norm_nonneg y)))) + let w := fun y => screenedPotentialReal Z R y - (coulombPotential ν y).toReal + have hw : Continuous w := + (continuous_screenedPotentialReal hM Z R hR).sub + (continuous_toReal_coulombPotential_voronoiFaceMeasure R hR Z.coe_nonneg) + have hweak : ∀ f : Position → ℝ, ContDiff ℝ ∞ f → HasCompactSupport f → + (∫ y, w y * Δ f y) = 0 := by + intro f hf hfc + have hf2 : ContDiff ℝ 2 f := hf.of_le (by simp) + have hi := integrable_screenedPotentialReal_mul_laplacian hM Z R hR hf2 hfc + have hj := integrable_coulombPotential_toReal_mul_laplacian ν hC hν hf2 hfc + simp only [w, sub_mul] + rw [integral_sub hi hj, hLap f hf hfc, + integral_coulombPotential_toReal_mul_laplacian ν hC hν hf2 hfc, sub_self] + have hd : Tendsto w (cocompact Position) (𝓝 0) := by + have ht := (tendsto_screenedPotentialReal_zero hM Z R hR).sub + (tendsto_toReal_coulombPotential_voronoiFaceMeasure_zero R hR Z.coe_nonneg) + simpa only [sub_zero, Metric.cobounded_eq_cocompact] using ht + have hz := congrFun (weak_harmonic_eq_zero hw hweak hd) x + apply (ENNReal.toReal_eq_toReal_iff' (screenedPotential_ne_top hM Z R hR x) + (ne_of_lt (coulombPotential_voronoiFaceMeasure_lt_top R hR Z.coe_nonneg x))).mp + exact sub_eq_zero.mp hz + +/-- the potential identity: the actual face-charge measure represents the screened potential +everywhere. -/ +theorem screenedPotential_eq_coulombPotential_voronoiFaceMeasure {M : ℕ} + (hM : 1 ≤ M) (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) + (x : Position) : + screenedPotential Z R x = coulombPotential (voronoiFaceMeasure R hR (Z : ℝ)) x := + screenedPotential_eq_coulombPotential_of_laplacian_identity hM Z R hR + (fun f hf hfc => integral_screenedPotentialReal_mul_laplacian hM Z R hR f + (hf.of_le (by simp)) hfc) x + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/PotentialIdentityAssembly.lean b/LeanPool/LiebThirring/Electrostatics/PotentialIdentityAssembly.lean new file mode 100644 index 0000000000..ac662aebdc --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/PotentialIdentityAssembly.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.PotentialIdentity +import LeanPool.LiebThirring.Electrostatics.EnergyDeficit +import LeanPool.LiebThirring.Electrostatics.SquareCompletion + +/-! +# The basic electrostatic inequality from the Voronoi face charge + +Finite face-charge self-energy, the potential identity, and the energy deficit give the basic +electrostatic inequality for distinct nuclei by square completion. +-/ + +public section + +open MeasureTheory Laplacian +open scoped NNReal ContDiff + +namespace LiebThirring + +/-- the basic electrostatic inequality with no analytic premises: the Voronoi charge supplies +square completion. -/ +theorem basicElectrostaticInequality_of_injective {M : ℕ} + (hM : 1 ≤ M) (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) : + BasicElectrostaticInequality Z R := by + have := isFiniteMeasure_voronoiFaceMeasure R hR Z.coe_nonneg + have hPhi := screenedPotential_eq_coulombPotential_voronoiFaceMeasure hM Z R hR + exact basicElectrostaticInequality_of_potential Z R (voronoiFaceMeasure R hR (Z : ℝ)) + (ne_of_lt (coulombEnergy_voronoiFaceMeasure_lt_top R hR Z.coe_nonneg)) hPhi + (energyDeficit_of_potential_eq hM Z R hR hPhi) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/Screened.lean b/LeanPool/LiebThirring/Electrostatics/Screened.lean new file mode 100644 index 0000000000..70ab83df4f --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/Screened.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.Basic + +/-! +# The screened nuclear potential and the basic electrostatic inequality + +`screenedPotential Z R x` omits a nearest nucleus. The basic electrostatic inequality for +positive finite-energy measures connects the Voronoi face-charge argument with shell assembly. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- The potential of all nuclei except a nearest one: `min_k Σ_{p ≠ k} Z |x - R_p|⁻¹`. -/ +noncomputable def screenedPotential {M : ℕ} (Z : ℝ≥0) (R : Fin M → Position) + (x : Position) : ℝ≥0∞ := + ⨅ k : Fin M, ∑ p ∈ Finset.univ.erase k, (Z : ℝ≥0∞) * coulombKernel x (R p) + +/-- the basic electrostatic inequality,, for positive finite measures of finite Coulomb energy: +`∫ Φ dμ + C_R ≤ D(μ, μ) + U`. -/ +def BasicElectrostaticInequality {M : ℕ} (Z : ℝ≥0) (R : Fin M → Position) : Prop := + ∀ μ : Measure Position, IsFiniteMeasure μ → coulombEnergy μ μ ≠ ⊤ → + (∫⁻ x, screenedPotential Z R x ∂μ) + baxterCorrection Z R ≤ + coulombEnergy μ μ / 2 + nuclearRepulsion (fun _ => Z) R + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityBasic.lean b/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityBasic.lean new file mode 100644 index 0000000000..70fe3eba50 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityBasic.lean @@ -0,0 +1,125 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.Screened +public import LeanPool.LiebThirring.Electrostatics.VoronoiBasic +import all LeanPool.LiebThirring.Electrostatics.Screened +import LeanPool.LiebThirring.Electrostatics.ShellAssemblyGeometry + +/-! +# Finiteness and continuity of the screened potential + +The extended screened potential and its real representative agree on their finite locus. +-/ + +public section + +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- The real form of the shared extended screened potential. -/ +@[expose] noncomputable def screenedPotentialReal {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (x : Position) : ℝ := + (screenedPotential Z R x).toReal + +/-- Every retained pole is separated from a closed nearest-nucleus cell. -/ +theorem nuclear_separation_le_twice_dist {M : ℕ} (R : Fin M → Position) + (k p : Fin M) {x : Position} (hx : x ∈ closedVoronoiCell R k) : + ‖R p - R k‖ ≤ 2 * ‖x - R p‖ := by + have ht := norm_sub_le_norm_sub_add_norm_sub (R p) x (R k) + rw [norm_sub_rev (R p) x] at ht + have hk : ‖x - R k‖ ≤ ‖x - R p‖ := by + simpa only [dist_eq_norm] using hx p + linarith + +theorem ne_nucleus_of_mem_closedVoronoiCell {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (k p : Fin M) (hpk : p ≠ k) + {x : Position} (hx : x ∈ closedVoronoiCell R k) : x ≠ R p := by + intro he + have ht := nuclear_separation_le_twice_dist R k p hx + rw [he, sub_self, norm_zero, mul_zero] at ht + exact hpk (hR (sub_eq_zero.mp (norm_eq_zero.mp (le_antisymm ht (norm_nonneg _))))) + +/-- The shared minimum is the explicit formula on every closed cell. -/ +theorem screenedPotential_eq_on_closedVoronoiCell {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (k : Fin M) {x : Position} + (hx : x ∈ closedVoronoiCell R k) : + screenedPotential Z R x = + ∑ p ∈ Finset.univ.erase k, (Z : ℝ≥0∞) * coulombKernel x (R p) := by + apply screenedPotential_eq_of_min + intro p + simpa only [dist_eq_norm] using hx p + +/-- Distinct nuclei make the screened potential finite even at a nucleus. -/ +theorem screenedPotential_ne_top {M : ℕ} (hM : 1 ≤ M) (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) (x : Position) : + screenedPotential Z R x ≠ ⊤ := by + classical + obtain ⟨k, hk⟩ := exists_nearest_nucleus hM R x + have hx : x ∈ closedVoronoiCell R k := by + intro p + simpa only [dist_eq_norm] using hk p + rw [screenedPotential_eq_on_closedVoronoiCell Z R k hx] + apply ENNReal.sum_ne_top.mpr + intro p hp + apply ENNReal.mul_ne_top (by simp) + change (ENNReal.ofReal ‖x - R p‖)⁻¹ ≠ ⊤ + rw [ENNReal.inv_ne_top, ENNReal.ofReal_ne_zero_iff, norm_pos_iff, sub_ne_zero] + exact ne_nucleus_of_mem_closedVoronoiCell R hR k p (Finset.mem_erase.mp hp).1 hx + +/-- Extended continuity also holds without separation of the nuclei. -/ +theorem continuous_screenedPotential {M : ℕ} (Z : ℝ≥0) (R : Fin M → Position) : + Continuous (screenedPotential Z R) := by + classical + have hc (k : Fin M) : Continuous (fun x : Position => + ∑ p ∈ Finset.univ.erase k, (Z : ℝ≥0∞) * coulombKernel x (R p)) := by + apply continuous_finsetSum + intro p hp + exact (ENNReal.continuous_const_mul (by simp)).comp + ((ENNReal.continuous_ofReal.comp (continuous_id.sub continuous_const).norm).fun_inv) + have hi := Continuous.finset_inf_apply (s := Finset.univ) (fun k _ => hc k) + unfold screenedPotential + simpa only [Finset.inf_eq_iInf, Finset.mem_univ, iInf_true] using hi + +theorem continuous_screenedPotentialReal {M : ℕ} (hM : 1 ≤ M) (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) : + Continuous (screenedPotentialReal Z R) := by + apply continuous_iff_continuousAt.mpr + intro x + exact (ENNReal.continuousAt_toReal (screenedPotential_ne_top hM Z R hR x)).comp + (continuous_screenedPotential Z R).continuousAt + +/-- The real closed-cell formula has no singular retained denominators. -/ +theorem screenedPotentialReal_eq_on_closedVoronoiCell {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) (k : Fin M) + {x : Position} (hx : x ∈ closedVoronoiCell R k) : + screenedPotentialReal Z R x = + ∑ p ∈ Finset.univ.erase k, (Z : ℝ) * ‖x - R p‖⁻¹ := by + classical + unfold screenedPotentialReal + rw [screenedPotential_eq_on_closedVoronoiCell Z R k hx, ENNReal.toReal_sum] + · apply Finset.sum_congr rfl + intro p hp + simp only [ENNReal.toReal_mul, ENNReal.coe_toReal, coulombKernel, + ENNReal.toReal_inv, ENNReal.toReal_ofReal (norm_nonneg _)] + · intro p hp + apply ENNReal.mul_ne_top (by simp) + change (ENNReal.ofReal ‖x - R p‖)⁻¹ ≠ ⊤ + rw [ENNReal.inv_ne_top, ENNReal.ofReal_ne_zero_iff, norm_pos_iff, sub_ne_zero] + exact ne_nucleus_of_mem_closedVoronoiCell R hR k p (Finset.mem_erase.mp hp).1 hx + +theorem screenedPotentialReal_nonneg {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (x : Position) : 0 ≤ screenedPotentialReal Z R x := + ENNReal.toReal_nonneg + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityBounds.lean b/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityBounds.lean new file mode 100644 index 0000000000..f49007e646 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityBounds.lean @@ -0,0 +1,148 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityBasic +import LeanPool.LiebThirring.Electrostatics.ShellAssemblyGeometry + +/-! +# Global bounds for the screened potential + +An explicit finite bound valid throughout space, including at nuclei. + +The nuclear configuration fits inside a ball of some nonnegative radius. +-/ + +public section + +open scoped NNReal + +namespace LiebThirring + +theorem screenedPotentialReal_le_cell_bound {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) (k : Fin M) + {x : Position} (hx : x ∈ closedVoronoiCell R k) : + screenedPotentialReal Z R x ≤ + ∑ p ∈ Finset.univ.erase k, 2 * (Z : ℝ) / ‖R p - R k‖ := by + classical + rw [screenedPotentialReal_eq_on_closedVoronoiCell Z R hR k hx] + apply Finset.sum_le_sum + intro p hp + have hpk := (Finset.mem_erase.mp hp).1 + have hd : 0 < ‖R p - R k‖ := norm_pos_iff.mpr (sub_ne_zero.mpr (hR.ne hpk)) + have hxpos : 0 < ‖x - R p‖ := norm_pos_iff.mpr + (sub_ne_zero.mpr (ne_nucleus_of_mem_closedVoronoiCell R hR k p hpk hx)) + have hs := nuclear_separation_le_twice_dist R k p hx + have hi : ‖x - R p‖⁻¹ ≤ 2 / ‖R p - R k‖ := by + rw [← one_div, div_le_div_iff₀ hxpos hd] + simpa only [one_mul] using hs + calc + _ ≤ (Z : ℝ) * (2 / ‖R p - R k‖) := mul_le_mul_of_nonneg_left hi Z.coe_nonneg + _ = _ := by ring + +/-- An explicit finite bound valid throughout space, including at nuclei. -/ +theorem screenedPotentialReal_le_global_bound {M : ℕ} (hM : 1 ≤ M) (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) (x : Position) : + screenedPotentialReal Z R x ≤ + ∑ k : Fin M, ∑ p ∈ Finset.univ.erase k, 2 * (Z : ℝ) / ‖R p - R k‖ := by + classical + obtain ⟨k, hk⟩ := exists_nearest_nucleus hM R x + have hx : x ∈ closedVoronoiCell R k := by + intro p + simpa only [dist_eq_norm] using hk p + apply (screenedPotentialReal_le_cell_bound Z R hR k hx).trans + apply Finset.single_le_sum _ (Finset.mem_univ k) + intro l hl + exact Finset.sum_nonneg (fun p hp => div_nonneg + (mul_nonneg (by norm_num) Z.coe_nonneg) (norm_nonneg _)) + +theorem bounded_screenedPotentialReal {M : ℕ} (hM : 1 ≤ M) (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) : + ∃ C : ℝ, ∀ x, |screenedPotentialReal Z R x| ≤ C := by + classical + refine ⟨∑ k : Fin M, ∑ p ∈ Finset.univ.erase k, + 2 * (Z : ℝ) / ‖R p - R k‖, fun x => ?_⟩ + rw [abs_of_nonneg (screenedPotentialReal_nonneg Z R x)] + exact screenedPotentialReal_le_global_bound hM Z R hR x + +/-- The nuclear configuration fits inside a ball of some nonnegative radius. -/ +theorem exists_nuclear_radius {M : ℕ} (R : Fin M → Position) : + ∃ A : ℝ, 0 ≤ A ∧ ∀ k, ‖R k‖ ≤ A := by + classical + refine ⟨∑ k : Fin M, ‖R k‖, Finset.sum_nonneg (fun k _ => norm_nonneg _), ?_⟩ + intro k + exact Finset.single_le_sum (fun l _ => norm_nonneg _) (Finset.mem_univ k) + +/-- Outside twice a ball containing the nuclei, every denominator is large. -/ +theorem half_norm_le_nuclear_distance {M : ℕ} (R : Fin M → Position) + {A : ℝ} (hA : ∀ k, ‖R k‖ ≤ A) {x : Position} (hx : 2 * A ≤ ‖x‖) + (k : Fin M) : ‖x‖ / 2 ≤ ‖x - R k‖ := by + have ht := norm_le_norm_sub_add x (R k) + linarith only [ht, hA k, hx] + +/-- The explicit `O(1/|x|)` estimate of screened-potential regularity. -/ +theorem screenedPotentialReal_le_decay {M : ℕ} (hM : 1 ≤ M) (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) + {A : ℝ} (hA : ∀ k, ‖R k‖ ≤ A) {x : Position} + (hx : 2 * A ≤ ‖x‖) (hxpos : 0 < ‖x‖) : + screenedPotentialReal Z R x ≤ 2 * (M - 1 : ℕ) * (Z : ℝ) / ‖x‖ := by + classical + obtain ⟨k, hk⟩ := exists_nearest_nucleus hM R x + have hcell : x ∈ closedVoronoiCell R k := by + intro p + simpa only [dist_eq_norm] using hk p + rw [screenedPotentialReal_eq_on_closedVoronoiCell Z R hR k hcell] + have hterm (p : Fin M) : (Z : ℝ) * ‖x - R p‖⁻¹ ≤ (Z : ℝ) * (2 / ‖x‖) := by + apply mul_le_mul_of_nonneg_left _ Z.coe_nonneg + have hd := half_norm_le_nuclear_distance R hA hx p + have hp : 0 < ‖x - R p‖ := lt_of_lt_of_le (half_pos hxpos) hd + rw [← one_div, div_le_div_iff₀ hp hxpos] + simp only [one_mul] + linarith + calc + _ ≤ ∑ _p ∈ Finset.univ.erase k, (Z : ℝ) * (2 / ‖x‖) := + Finset.sum_le_sum (fun p _ => hterm p) + _ = _ := by + rw [Finset.sum_const, Finset.card_erase_of_mem (Finset.mem_univ k)] + simp only [Finset.card_univ, Fintype.card_fin, nsmul_eq_mul] + ring + +/-- A global version of the decay estimate, with denominator `1 + |x|`. -/ +theorem exists_screenedPotentialReal_le_one_add_norm {M : ℕ} (hM : 1 ≤ M) + (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) : + ∃ C : ℝ, 0 ≤ C ∧ ∀ x, |screenedPotentialReal Z R x| ≤ C / (1 + ‖x‖) := by + obtain ⟨B, hB⟩ := bounded_screenedPotentialReal hM Z R hR + have hBpos : 0 ≤ B := (abs_nonneg _).trans (hB 0) + obtain ⟨A, hA, hbound⟩ := exists_nuclear_radius R + let D : ℝ := 2 * (M - 1 : ℕ) * (Z : ℝ) + have hD : 0 ≤ D := mul_nonneg (mul_nonneg (by norm_num) (Nat.cast_nonneg _)) Z.coe_nonneg + refine ⟨B * (2 * A + 2) + 2 * D, + add_nonneg (mul_nonneg hBpos (by linarith)) (mul_nonneg (by norm_num) hD), ?_⟩ + intro x + have hden : 0 < 1 + ‖x‖ := by linarith [norm_nonneg x] + rw [le_div_iff₀ hden] + by_cases hx : ‖x‖ ≤ 2 * A + 1 + · have hb := mul_le_mul_of_nonneg_right (hB x) hden.le + have ht := mul_le_mul_of_nonneg_left (show 1 + ‖x‖ ≤ 2 * A + 2 by linarith) hBpos + exact (hb.trans ht).trans (le_add_of_nonneg_right (mul_nonneg (by norm_num) hD)) + · have hxpos : 0 < ‖x‖ := by linarith + have hfar : 2 * A ≤ ‖x‖ := by linarith + have hd := screenedPotentialReal_le_decay hM Z R hR hbound hfar hxpos + change screenedPotentialReal Z R x ≤ D / ‖x‖ at hd + have hb : |screenedPotentialReal Z R x| * ‖x‖ ≤ D := by + rw [abs_of_nonneg (screenedPotentialReal_nonneg Z R x)] + exact (le_div_iff₀ hxpos).mp hd + have ht : 1 + ‖x‖ ≤ 2 * ‖x‖ := by linarith + have hm := mul_le_mul_of_nonneg_left ht (abs_nonneg (screenedPotentialReal Z R x)) + have hs : |screenedPotentialReal Z R x| * (1 + ‖x‖) ≤ 2 * D := by nlinarith + exact hs.trans (le_add_of_nonneg_left (mul_nonneg hBpos (by linarith))) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityCells.lean b/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityCells.lean new file mode 100644 index 0000000000..c38e8f187d --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityCells.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityBasic +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityCoulomb +public import Mathlib.Analysis.InnerProductSpace.Harmonic.Basic + +/-! +# Smooth cell representatives and harmonicity + +The explicit smooth representative associated to a nearest-nucleus cell. +-/ + +public section + +open InnerProductSpace Laplacian Filter +open scoped Topology NNReal + +namespace LiebThirring + +/-- The explicit smooth representative associated to a nearest-nucleus cell. -/ +@[expose] noncomputable def screenedCellPotential {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (k : Fin M) (x : Position) : ℝ := + ∑ p ∈ Finset.univ.erase k, (Z : ℝ) * ‖x - R p‖⁻¹ + +theorem contDiffAt_screenedCellPotential {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) (k : Fin M) + {x : Position} (hx : x ∈ closedVoronoiCell R k) (n : WithTop ℕ∞) : + ContDiffAt ℝ n (screenedCellPotential Z R k) x := by + classical + apply ContDiffAt.sum + intro p hp + exact contDiffAt_const.mul (contDiffAt_inv_nuclear_distance (R p) x + (ne_nucleus_of_mem_closedVoronoiCell R hR k p (Finset.mem_erase.mp hp).1 hx) n) + +theorem screenedPotentialReal_eq_screenedCellPotential {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) (k : Fin M) + {x : Position} (hx : x ∈ closedVoronoiCell R k) : + screenedPotentialReal Z R x = screenedCellPotential Z R k x := + screenedPotentialReal_eq_on_closedVoronoiCell Z R hR k hx + +theorem harmonicAt_inv_nuclear_distance (y x : Position) (hx : x ≠ y) : + HarmonicAt (fun z : Position => ‖z - y‖⁻¹) x := by + refine ⟨contDiffAt_inv_nuclear_distance y x hx 2, ?_⟩ + filter_upwards [isOpen_ne.mem_nhds hx] with z hz + exact laplacian_inv_nuclear_distance y z hz + +theorem harmonicAt_screenedCellPotential {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) (k : Fin M) + {x : Position} (hx : x ∈ closedVoronoiCell R k) : + HarmonicAt (screenedCellPotential Z R k) x := by + classical + have hterm (p : Fin M) (hp : p ∈ Finset.univ.erase k) : + HarmonicAt (fun z => (Z : ℝ) * ‖z - R p‖⁻¹) x := by + have hh := (harmonicAt_inv_nuclear_distance (R p) x + (ne_nucleus_of_mem_closedVoronoiCell R hR k p (Finset.mem_erase.mp hp).1 hx)).const_smul (c + := (Z : ℝ)) + have he : (Z : ℝ) • (fun z : Position => ‖z - R p‖⁻¹) = + (fun z : Position => (Z : ℝ) * ‖z - R p‖⁻¹) := by + ext z + simp only [Pi.smul_apply, smul_eq_mul] + rwa [he] at hh + unfold screenedCellPotential + generalize Finset.univ.erase k = s at hterm ⊢ + induction s using Finset.induction_on with + | empty => simpa only [Finset.sum_empty] using harmonicAt_const (0 : ℝ) + | @insert p s hp ih => + simp only [Finset.sum_insert hp] + exact (hterm p (Finset.mem_insert_self p s)).add + (ih (fun l hl => hterm l (Finset.mem_insert_of_mem hl))) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityCoulomb.lean b/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityCoulomb.lean new file mode 100644 index 0000000000..2132773ce3 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityCoulomb.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.SpecialFunctions.Pow.Deriv +public import Mathlib.Analysis.InnerProductSpace.Calculus +public import Mathlib.Analysis.InnerProductSpace.Laplacian +public import LeanPool.LiebThirring.Defs.Configuration + +/-! +# Off-pole Coulomb differentiation + +Inverse distance is smooth and harmonic away from its pole. +-/ + +public section + +open InnerProductSpace Laplacian Filter +open scoped RealInnerProductSpace Topology + +namespace LiebThirring + +theorem contDiffAt_inv_nuclear_distance (y x : Position) (hx : x ≠ y) + (n : WithTop ℕ∞) : ContDiffAt ℝ n (fun z : Position => ‖z - y‖⁻¹) x := + ((contDiffAt_id.sub contDiffAt_const).norm ℝ (sub_ne_zero.mpr hx)).inv + (norm_ne_zero_iff.mpr (sub_ne_zero.mpr hx)) + +theorem norm_sq_rpow_neg_half (x : Position) : + (‖x‖ ^ 2) ^ (-(1 / 2 : ℝ)) = ‖x‖⁻¹ := by + rw [Real.rpow_neg (sq_nonneg _), ← Real.sqrt_eq_rpow, Real.sqrt_sq (norm_nonneg _)] + +theorem fderiv_nuclear_distance_sq_rpow (y x v : Position) (hx : x ≠ y) (p : ℝ) : + fderiv ℝ (fun z : Position => (‖z - y‖ ^ 2) ^ p) x v = + 2 * p * (‖x - y‖ ^ 2) ^ (p - 1) * ⟪x - y, v⟫ := by + have hs := ((hasFDerivAt_id x).sub_const y).norm_sq + simp only [id_eq] at hs + have hh := hs.rpow_const (p := p) + (Or.inl (pow_ne_zero 2 (norm_ne_zero_iff.mpr (sub_ne_zero.mpr hx)))) + rw [hh.fderiv] + simp only [smul_apply, smul_eq_mul, ContinuousLinearMap.comp_apply, + ContinuousLinearMap.id_apply, innerSL_apply_apply] + ring + +theorem hessian_nuclear_distance_sq_rpow (y x v : Position) (hx : x ≠ y) (p : ℝ) : + fderiv ℝ (fderiv ℝ (fun z : Position => (‖z - y‖ ^ 2) ^ p)) x v v = + 4 * p * (p - 1) * (‖x - y‖ ^ 2) ^ (p - 2) * ⟪x - y, v⟫ ^ 2 + + 2 * p * (‖x - y‖ ^ 2) ^ (p - 1) * ⟪v, v⟫ := by + have hn : ‖x - y‖ ^ 2 ≠ 0 := pow_ne_zero 2 + (norm_ne_zero_iff.mpr (sub_ne_zero.mpr hx)) + have hc : ContDiffAt ℝ 2 (fun z : Position => (‖z - y‖ ^ 2) ^ p) x := + ((contDiffAt_id.sub contDiffAt_const).norm_sq ℝ).rpow_const_of_ne hn + have hd := (hc.fderiv_right (by norm_num)).differentiableAt one_ne_zero + have heval : fderiv ℝ (fun z => fderiv ℝ + (fun w : Position => (‖w - y‖ ^ 2) ^ p) z v) x v = + fderiv ℝ (fderiv ℝ (fun z : Position => (‖z - y‖ ^ 2) ^ p)) x v v := by + rw [fderiv_clm_apply hd (differentiableAt_const v), (hasFDerivAt_const v x).fderiv] + simp only [ContinuousLinearMap.comp_zero, zero_add, ContinuousLinearMap.flip_apply] + rw [← heval] + have he : (fun z : Position => fderiv ℝ + (fun w : Position => (‖w - y‖ ^ 2) ^ p) z v) =ᶠ[𝓝 x] + (fun z => 2 * p * (‖z - y‖ ^ 2) ^ (p - 1) * ⟪z - y, v⟫) := by + filter_upwards [isOpen_ne.mem_nhds hx] with z hz + exact fderiv_nuclear_distance_sq_rpow y z v hz p + rw [he.fderiv_eq] + have hs := ((hasFDerivAt_id x).sub_const y).norm_sq + simp only [id_eq] at hs + have hp := (hs.rpow_const (p := p - 1) (Or.inl hn)).const_mul (2 * p) + have hl : HasFDerivAt (fun z : Position => ⟪z - y, v⟫) (innerSL ℝ v) x := by + simpa only [coe_innerSL_apply, inner_sub_left, real_inner_comm] using + ((innerSL ℝ v).hasFDerivAt.sub_const ⟪y, v⟫) + rw [(hp.fun_mul hl).fderiv] + simp only [add_apply, smul_apply, smul_eq_mul, ContinuousLinearMap.comp_apply, + ContinuousLinearMap.id_apply, innerSL_apply_apply] + rw [show p - 1 - 1 = p - 2 by ring, real_inner_comm v (x - y)] + ring + +theorem fderiv_inv_nuclear_distance (y x v : Position) (hx : x ≠ y) : + fderiv ℝ (fun z : Position => ‖z - y‖⁻¹) x v = + -⟪x - y, v⟫ / ‖x - y‖ ^ 3 := by + have he : (fun z : Position => ‖z - y‖⁻¹) = + (fun z => (‖z - y‖ ^ 2) ^ (-(1 / 2 : ℝ))) := + funext (fun z => (norm_sq_rpow_neg_half (z - y)).symm) + rw [he, fderiv_nuclear_distance_sq_rpow y x v hx] + have hp : (‖x - y‖ ^ 2) ^ (-(1 / 2 : ℝ) - 1) = (‖x - y‖ ^ 3)⁻¹ := by + rw [← Real.rpow_natCast ‖x - y‖ 2, ← Real.rpow_mul (norm_nonneg _)] + norm_num + rw [hp] + ring + +theorem laplacian_inv_nuclear_distance (y x : Position) (hx : x ≠ y) : + Δ (fun z : Position => ‖z - y‖⁻¹) x = 0 := by + have he : (fun z : Position => ‖z - y‖⁻¹) = + (fun z => (‖z - y‖ ^ 2) ^ (-(1 / 2 : ℝ))) := + funext (fun z => (norm_sq_rpow_neg_half (z - y)).symm) + rw [he, laplacian_eq_iteratedFDeriv_stdOrthonormalBasis] + simp only [iteratedFDeriv_two_apply, Matrix.cons_val_zero, Matrix.cons_val_one] + simp_rw [hessian_nuclear_distance_sq_rpow y _ _ hx, real_inner_self_eq_norm_sq, + OrthonormalBasis.norm_eq_one, one_pow, mul_one] + rw [Finset.sum_add_distrib, ← Finset.mul_sum, + (stdOrthonormalBasis ℝ Position).sum_sq_inner_left] + simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul] + have hdim : Module.finrank ℝ Position = 3 := by + simp only [Position, finrank_euclideanSpace_fin] + rw [hdim] + have hp : (‖x - y‖ ^ 2) ^ (-(1 / 2 : ℝ) - 1) = + (‖x - y‖ ^ 2) * (‖x - y‖ ^ 2) ^ (-(1 / 2 : ℝ) - 2) := by + calc + _ = (‖x - y‖ ^ 2) ^ (1 + (-(1 / 2 : ℝ) - 2)) := by congr 1; ring + _ = _ := by rw [Real.rpow_add (sq_pos_of_pos + (norm_pos_iff.mpr (sub_ne_zero.mpr hx))), Real.rpow_one] + rw [hp] + ring + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityExtension.lean b/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityExtension.lean new file mode 100644 index 0000000000..8ca2aa78ac --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityExtension.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.Calculus.BumpFunction.FiniteDimension +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityCells + +/-! +# Globally smooth extensions of screened cell representatives + +Small inner bumps remove the retained Coulomb poles. Their transition balls +lie strictly outside the associated closed cell, so the extension agrees +with the cell representative on a neighborhood of each point of that cell. +-/ + +public section + +open Filter Set +open scoped Topology ContDiff NNReal + +namespace LiebThirring + +/-- Smooth cutoff around a nuclear position for removing its Coulomb singularity. -/ +@[expose] noncomputable def screenedInnerBump (c : Position) (d : ℝ) (hd : 0 < d) : + ContDiffBump c := ⟨d / 8, d / 4, by positivity, by linarith⟩ + +/-- A smooth replacement of the inverse distance near a nuclear position. -/ +@[expose] noncomputable def screenedSmoothInverse (c : Position) (d : ℝ) (hd : 0 < d) + (x : Position) : ℝ := (1 - screenedInnerBump c d hd x) * ‖x - c‖⁻¹ + +theorem contDiff_screenedSmoothInverse (c : Position) (d : ℝ) (hd : 0 < d) : + ContDiff ℝ ∞ (screenedSmoothInverse c d hd) := by + rw [contDiff_iff_contDiffAt] + intro x + by_cases hx : x = c + · subst x + apply (contDiffAt_const : ContDiffAt ℝ ∞ (fun _ : Position => (0 : ℝ)) c).congr_of_eventuallyEq + filter_upwards [(screenedInnerBump c d hd).eventuallyEq_one] with x hx + simp only [screenedSmoothInverse, hx, Pi.one_apply, sub_self, zero_mul] + · exact (contDiffAt_const.sub (screenedInnerBump c d hd).contDiffAt).mul + (contDiffAt_inv_nuclear_distance c x hx ∞) + +theorem eventuallyEq_screenedSmoothInverse (c x : Position) (d : ℝ) (hd : 0 < d) + (hx : d / 4 < ‖x - c‖) : + screenedSmoothInverse c d hd =ᶠ[𝓝 x] (fun y => ‖y - c‖⁻¹) := by + have hn : ∀ᶠ y in 𝓝 x, d / 4 < ‖y - c‖ := + (isOpen_lt continuous_const (continuous_id.sub continuous_const).norm).mem_nhds hx + filter_upwards [hn] with y hy + have hz : screenedInnerBump c d hd y = 0 := + (screenedInnerBump c d hd).zero_of_le_dist (by + simpa only [screenedInnerBump, dist_eq_norm] using hy.le) + simp only [screenedSmoothInverse, hz, sub_zero, one_mul] + +/-- Smooth extension of the screened potential from a closed Voronoi cell. -/ +@[expose] noncomputable def screenedCellSmooth {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) (k : Fin M) (x : Position) : ℝ := + ∑ p : {p : Fin M // p ≠ k}, (Z : ℝ) * + screenedSmoothInverse (R p.val) ‖R p.val - R k‖ + (norm_pos_iff.mpr (sub_ne_zero.mpr (hR.ne p.property))) x + +theorem contDiff_screenedCellSmooth {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) (k : Fin M) : + ContDiff ℝ ∞ (screenedCellSmooth Z R hR k) := by + classical + apply ContDiff.sum + intro p _ + exact contDiff_const.mul (contDiff_screenedSmoothInverse _ _ _) + +theorem eventuallyEq_screenedCellSmooth {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) (k : Fin M) + {x : Position} (hx : x ∈ closedVoronoiCell R k) : + screenedCellSmooth Z R hR k =ᶠ[𝓝 x] screenedCellPotential Z R k := by + classical + have he (p : {p : Fin M // p ≠ k}) : + screenedSmoothInverse (R p.val) ‖R p.val - R k‖ + (norm_pos_iff.mpr (sub_ne_zero.mpr (hR.ne p.property))) =ᶠ[𝓝 x] + (fun y => ‖y - R p.val‖⁻¹) := by + apply eventuallyEq_screenedSmoothInverse + have hs := nuclear_separation_le_twice_dist R k p.val hx + have hp : 0 < ‖R p.val - R k‖ := norm_pos_iff.mpr (sub_ne_zero.mpr (hR.ne p.property)) + linarith only [hs, hp] + filter_upwards [eventually_all.mpr he] with y hy + unfold screenedCellSmooth screenedCellPotential + simp_rw [hy] + exact (Finset.sum_subtype (p := fun p : Fin M => p ≠ k) (Finset.univ.erase k) + (by intro p; simp only [Finset.mem_erase, Finset.mem_univ, and_true]) + (fun p : Fin M => (Z : ℝ) * ‖y - R p‖⁻¹)).symm + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityIntegrability.lean b/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityIntegrability.lean new file mode 100644 index 0000000000..417fcb9116 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/ScreenedRegularityIntegrability.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityBasic +public import LeanPool.LiebThirring.Analysis.FundamentalSolutionIntegrability + +/-! +# Integrability of screened-potential test integrands + +Continuity and compact support give integrability of screened-potential test integrands. +-/ + +public section + +open MeasureTheory Laplacian +open scoped NNReal + +namespace LiebThirring + +theorem integrable_screenedPotentialReal_mul_laplacian {M : ℕ} (hM : 1 ≤ M) + (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) + {f : Position → ℝ} (hf : ContDiff ℝ 2 f) (hfc : HasCompactSupport f) : + Integrable (fun x => screenedPotentialReal Z R x * Δ f x) := + ((continuous_screenedPotentialReal hM Z R hR).mul (continuous_laplacian_position + hf)).integrable_of_hasCompactSupport (hasCompactSupport_laplacian_position hfc).mul_left + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/ShellAssembly.lean b/LeanPool/LiebThirring/Electrostatics/ShellAssembly.lean new file mode 100644 index 0000000000..6ce05da97d --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/ShellAssembly.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.ShellAssemblyGeometry +public import LeanPool.LiebThirring.Electrostatics.ShellAssemblyEnergy +import all LeanPool.LiebThirring.Electrostatics.Screened + +/-! +# Baxter shell assembly from the basic electrostatic inequality + +The inverse half-distance is twice the inverse distance, in the extended reals. + +Shell assembly for nonempty nuclei and electrons away from nuclear singularities. No electron +separation is needed in this additive extended proof. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- The inverse half-distance is twice the inverse distance, in the extended reals. -/ +theorem inv_ofReal_half (d : ℝ) : + (ENNReal.ofReal (d / 2))⁻¹ = 2 * (ENNReal.ofReal d)⁻¹ := by + rw [ENNReal.ofReal_div_of_pos (by norm_num : (0 : ℝ) < 2)] + norm_num only [ENNReal.ofReal_ofNat] + rw [ENNReal.inv_div (Or.inl (by norm_num)) (Or.inl (by norm_num)), div_eq_mul_inv] + +/-- Shell assembly for nonempty nuclei and electrons away from nuclear singularities. +No electron separation is needed in this additive extended proof. -/ +theorem baxter_of_basicElectrostaticInequality_of_separated {N M : ℕ} + (Z : ℝ≥0) (R : Fin M → Position) (x : Configuration N) + (hM : 1 ≤ M) (hB12 : BasicElectrostaticInequality Z R) + (hx : ∀ i k, particlePosition x i ≠ R k) : + attraction (fun _ => Z) R x + baxterCorrection Z R ≤ + electronRepulsion x + nuclearRepulsion (fun _ => Z) R + + nearestNucleusControl Z R x := by + classical + choose k hk using fun i : Fin N => exists_nearest_nucleus hM R (particlePosition x i) + let d : Fin N → ℝ := fun i => ‖particlePosition x i - R (k i)‖ + have hd (i : Fin N) : 0 < d i := norm_pos_iff.mpr (sub_ne_zero.mpr (hx i (k i))) + have hbound (i : Fin N) (l : Fin M) : d i ≤ ‖particlePosition x i - R l‖ := hk i l + let μ : Measure Position := ∑ i, shell (particlePosition x i) (d i / 2) + have hμ : IsFiniteMeasure μ := by dsimp [μ]; infer_instance + have he : coulombEnergy μ μ ≠ ⊤ := + coulombEnergy_sum_shell_ne_top _ _ (fun i => half_pos (hd i)) + have hb := hB12 μ hμ he + let S : ℝ≥0∞ := ∫⁻ y, screenedPotential Z R y ∂μ + let T : ℝ≥0∞ := ∑ i, (ENNReal.ofReal (d i / 2))⁻¹ + have ha : attraction (fun _ => Z) R x ≤ S + (Z : ℝ≥0∞) * T := by + dsimp [attraction, S, T, μ] + rw [lintegral_finsetSum_measure, Finset.mul_sum, ← Finset.sum_add_distrib] + exact Finset.sum_le_sum (fun i _ => nuclearPotential_le_shell_screened_add + hM Z R _ (hd i) (hbound i)) + have henergy : coulombEnergy μ μ / 2 ≤ electronRepulsion x + T / 2 := + coulombEnergy_sum_shell_div_two_le x _ (fun i => half_pos (hd i)) + have hT : T = 2 * ∑ i, (nearestNucleusDistance R (particlePosition x i))⁻¹ := by + dsimp [T] + simp_rw [nearestNucleusDistance_eq_of_min R _ _ (hk _), inv_ofReal_half] + exact (Finset.mul_sum _ _ _).symm + calc + attraction (fun _ => Z) R x + baxterCorrection Z R ≤ + (S + (Z : ℝ≥0∞) * T) + baxterCorrection Z R := add_le_add_left ha _ + _ = (S + baxterCorrection Z R) + (Z : ℝ≥0∞) * T := by ac_rfl + _ ≤ (coulombEnergy μ μ / 2 + nuclearRepulsion (fun _ => Z) R) + (Z : ℝ≥0∞) * T := + add_le_add_left hb _ + _ ≤ (electronRepulsion x + T / 2 + nuclearRepulsion (fun _ => Z) R) + (Z : ℝ≥0∞) * T := + add_le_add_left (add_le_add_left henergy _) _ + _ = electronRepulsion x + nuclearRepulsion (fun _ => Z) R + nearestNucleusControl Z R x := by + rw [hT, ENNReal.mul_div_right_comm, ENNReal.div_self (by norm_num) (by norm_num)] + unfold nearestNucleusControl + ring + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/ShellAssemblyEnergy.lean b/LeanPool/LiebThirring/Electrostatics/ShellAssemblyEnergy.lean new file mode 100644 index 0000000000..00826d81d1 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/ShellAssemblyEnergy.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.NewtonConsequences +public import LeanPool.LiebThirring.Electrostatics.CoulombPositivity +import all LeanPool.LiebThirring.Electrostatics.Basic + +/-! +# Energy bookkeeping for finite families of electron shells + +Bilinearity for a finite family of positive measures, without subtraction. + +A symmetric finite double sum consists of its diagonal and twice its upper triangle. +-/ + +public section + +open MeasureTheory +open scoped ENNReal + +namespace LiebThirring + +/-- Bilinearity for a finite family of positive measures, without subtraction. -/ +theorem coulombEnergy_finsetSum {ι : Type*} (s : Finset ι) + (μ : ι → Measure Position) [∀ i, SFinite (μ i)] : + coulombEnergy (∑ i ∈ s, μ i) (∑ j ∈ s, μ j) = + ∑ i ∈ s, ∑ j ∈ s, coulombEnergy (μ i) (μ j) := by + unfold coulombEnergy coulombPotential + simp_rw [lintegral_finsetSum_measure] + apply Finset.sum_congr rfl + intro i _ + exact lintegral_finsetSum s (fun j _ => + measurable_coulombKernel.lintegral_prod_right) + +/-- A symmetric finite double sum consists of its diagonal and twice its upper triangle. -/ +theorem symmetric_sum_eq_diagonal_add {n : ℕ} (f : Fin n → Fin n → ℝ≥0∞) + (hf : ∀ i j, f i j = f j i) : + (∑ i : Fin n, ∑ j : Fin n, f i j) = + (∑ i : Fin n, f i i) + + 2 * ∑ i : Fin n, ∑ j ∈ Finset.univ.filter (fun j => i < j), f i j := by + exact sum_eq_diag_add_two_sum_lt f hf + +/-- A finite sum of positive-radius electron shells has finite Coulomb energy. -/ +theorem coulombEnergy_sum_shell_ne_top {N : ℕ} (a : Fin N → Position) + (r : Fin N → ℝ) (hr : ∀ i, 0 < r i) : + coulombEnergy (∑ i, shell (a i) (r i)) (∑ i, shell (a i) (r i)) ≠ ⊤ := by + rw [coulombEnergy_finsetSum] + apply (ENNReal.sum_lt_top.mpr ?_).ne + intro i _ + apply ENNReal.sum_lt_top.mpr + intro j _ + exact lt_top_iff_ne_top.mpr (coulombEnergy_ne_top _ _ + (by rw [coulombEnergy_shell_self (a i) (hr i)]; exact + (ENNReal.inv_lt_top.mpr (ENNReal.ofReal_pos.mpr (hr i))).ne) + (by rw [coulombEnergy_shell_self (a j) (hr j)]; exact + (ENNReal.inv_lt_top.mpr (ENNReal.ofReal_pos.mpr (hr j))).ne)) + +/-- Smearing bounds the total half-energy by repulsion and the shell self terms. -/ +theorem coulombEnergy_sum_shell_div_two_le {N : ℕ} (x : Configuration N) + (r : Fin N → ℝ) (hr : ∀ i, 0 < r i) : + coulombEnergy (∑ i, shell (particlePosition x i) (r i)) + (∑ i, shell (particlePosition x i) (r i)) / 2 ≤ + electronRepulsion x + (∑ i, (ENNReal.ofReal (r i))⁻¹) / 2 := by + rw [coulombEnergy_finsetSum, symmetric_sum_eq_diagonal_add] + · simp_rw [coulombEnergy_shell_self _ (hr _)] + have hp : (∑ i : Fin N, ∑ j ∈ Finset.univ.filter (fun j => i < j), + coulombEnergy (shell (particlePosition x i) (r i)) + (shell (particlePosition x j) (r j))) ≤ electronRepulsion x := by + apply Finset.sum_le_sum + intro i _ + apply Finset.sum_le_sum + intro j _ + exact coulombEnergy_shell_le_kernel _ _ (hr i) (hr j) + calc + _ ≤ ((∑ i, (ENNReal.ofReal (r i))⁻¹) + 2 * electronRepulsion x) / 2 := + ENNReal.div_le_div_right (add_le_add_right (mul_le_mul_right hp 2) _) _ + _ = _ := by + rw [ENNReal.add_div, mul_comm (2 : ℝ≥0∞), ENNReal.mul_div_cancel_right] + · exact add_comm _ _ + all_goals norm_num + · intro i j + exact coulombEnergy_symm _ _ + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/ShellAssemblyGeometry.lean b/LeanPool/LiebThirring/Electrostatics/ShellAssemblyGeometry.lean new file mode 100644 index 0000000000..48204ceacf --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/ShellAssemblyGeometry.lean @@ -0,0 +1,145 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.Screened +public import LeanPool.LiebThirring.Electrostatics.NewtonConsequences +import all LeanPool.LiebThirring.Electrostatics.Screened +import all LeanPool.LiebThirring.Electrostatics.Basic +import LeanPool.LiebThirring.Electrostatics.Gaussian + +/-! +# Geometry and attraction of electron shells + +A finite nonempty nuclear configuration has a nearest index. + +Identify the nearest distance without a Voronoi tie-breaking choice. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- A finite nonempty nuclear configuration has a nearest index. -/ +theorem exists_nearest_nucleus {M : ℕ} (hM : 1 ≤ M) + (R : Fin M → Position) (a : Position) : + ∃ k : Fin M, ∀ l, ‖a - R k‖ ≤ ‖a - R l‖ := by + classical + let : Nonempty (Fin M) := ⟨⟨0, hM⟩⟩ + obtain ⟨k, _, hk⟩ := Finset.exists_min_image Finset.univ + (fun k : Fin M => ‖a - R k‖) Finset.univ_nonempty + exact ⟨k, fun l => hk l (Finset.mem_univ l)⟩ + +/-- Identify the nearest distance without a Voronoi tie-breaking choice. -/ +theorem nearestNucleusDistance_eq_of_min {M : ℕ} (R : Fin M → Position) + (a : Position) (k : Fin M) (hk : ∀ l, ‖a - R k‖ ≤ ‖a - R l‖) : + nearestNucleusDistance R a = ENNReal.ofReal ‖a - R k‖ := by + apply le_antisymm (iInf_le _ k) + exact le_iInf (fun l => ENNReal.ofReal_le_ofReal (hk l)) + +/-- Removing a nearest nucleus minimizes the remaining nuclear potential. -/ +theorem screenedPotential_eq_of_min {M : ℕ} (Z : ℝ≥0) (R : Fin M → Position) + (a : Position) (k : Fin M) (hk : ∀ l, ‖a - R k‖ ≤ ‖a - R l‖) : + screenedPotential Z R a = + ∑ l ∈ Finset.univ.erase k, (Z : ℝ≥0∞) * coulombKernel a (R l) := by + classical + apply le_antisymm (iInf_le _ k) + apply le_iInf + intro l + by_cases hkl : k = l + · exact hkl ▸ le_rfl + · have hker : (Z : ℝ≥0∞) * coulombKernel a (R l) ≤ + (Z : ℝ≥0∞) * coulombKernel a (R k) := + mul_le_mul_right (ENNReal.inv_le_inv.mpr (ENNReal.ofReal_le_ofReal (hk l))) _ + have hkm : k ∈ Finset.univ.erase l := Finset.mem_erase.mpr ⟨hkl, Finset.mem_univ _⟩ + have hlm : l ∈ Finset.univ.erase k := Finset.mem_erase.mpr ⟨Ne.symm hkl, Finset.mem_univ _⟩ + rw [← Finset.sum_erase_add _ _ hlm, ← Finset.sum_erase_add _ _ hkm] + rw [Finset.erase_right_comm] + exact add_le_add_right hker _ + +/-- The nuclear potential splits into its screened part and nearest singularity. -/ +theorem nuclearPotential_eq_screened_add {M : ℕ} (hM : 1 ≤ M) + (Z : ℝ≥0) (R : Fin M → Position) (a : Position) : + (∑ k : Fin M, (Z : ℝ≥0∞) * coulombKernel a (R k)) = + screenedPotential Z R a + (Z : ℝ≥0∞) * (nearestNucleusDistance R a)⁻¹ := by + classical + obtain ⟨k, hk⟩ := exists_nearest_nucleus hM R a + rw [screenedPotential_eq_of_min Z R a k hk, nearestNucleusDistance_eq_of_min R a k hk] + exact (Finset.sum_erase_add _ _ (Finset.mem_univ k)).symm + +/-- On a half-nearest-distance sphere every nuclear distance is at least the radius. -/ +theorem shell_nuclear_distance_bound {M : ℕ} (R : Fin M → Position) + (a y : Position) (d : ℝ) (hd : ∀ k, d ≤ ‖a - R k‖) + (hy : ‖y - a‖ = d / 2) : + ENNReal.ofReal (d / 2) ≤ nearestNucleusDistance R y := by + apply le_iInf + intro k + apply ENNReal.ofReal_le_ofReal + have ht := norm_sub_le_norm_sub_add_norm_sub a y (R k) + rw [norm_sub_rev a y, hy] at ht + linarith only [hd k, ht] + +/-- Newton gives exact attraction to each nucleus from an electron shell. -/ +theorem lintegral_shell_nuclearPotential {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (a : Position) {d : ℝ} (hd : 0 < d) + (hbound : ∀ k, d ≤ ‖a - R k‖) : + (∫⁻ y, ∑ k : Fin M, (Z : ℝ≥0∞) * coulombKernel y (R k) ∂shell a (d / 2)) = + ∑ k : Fin M, (Z : ℝ≥0∞) * coulombKernel a (R k) := by + rw [lintegral_finsetSum] + · apply Finset.sum_congr rfl + intro k _ + rw [lintegral_const_mul] + · simp_rw [coulombKernel_symm _ (R k)] + change (Z : ℝ≥0∞) * coulombPotential (shell a (d / 2)) (R k) = _ + rw [coulombPotential_shell_of_radius_le a (half_pos hd) (R k), coulombKernel_symm] + rw [norm_sub_rev] + exact (half_le_self hd.le).trans (hbound k) + · exact measurable_coulombKernel.of_uncurry_right + · intro k _ + exact measurable_const.mul measurable_coulombKernel.of_uncurry_right + +/-- The shell contribution of the nearest singularity is at most `2Z/d`. -/ +theorem lintegral_shell_nearest_le {M : ℕ} (Z : ℝ≥0) (R : Fin M → Position) + (a : Position) {d : ℝ} (hd : 0 < d) (hbound : ∀ k, d ≤ ‖a - R k‖) : + (∫⁻ y, (Z : ℝ≥0∞) * (nearestNucleusDistance R y)⁻¹ ∂shell a (d / 2)) ≤ + (Z : ℝ≥0∞) * (ENNReal.ofReal (d / 2))⁻¹ := by + calc + _ ≤ ∫⁻ _y, (Z : ℝ≥0∞) * (ENNReal.ofReal (d / 2))⁻¹ ∂shell a (d / 2) := by + apply lintegral_mono_ae + filter_upwards [ae_shell_norm a (half_pos hd).le] with y hy + exact mul_le_mul_right (ENNReal.inv_le_inv.mpr + (shell_nuclear_distance_bound R a y d hbound hy)) _ + _ = _ := by rw [lintegral_const, measure_univ, mul_one] + +/-- Measurability of the nearest-nucleus distance, including the empty infimum. -/ +theorem measurable_nearestNucleusDistance {M : ℕ} (R : Fin M → Position) : + Measurable (nearestNucleusDistance R) := by + exact Measurable.iInf (fun k => + ((measurable_id.sub measurable_const).norm.ennreal_ofReal)) + +/-- Additive attraction estimate on one shell; its screened integral is kept intact. -/ +theorem nuclearPotential_le_shell_screened_add {M : ℕ} (hM : 1 ≤ M) + (Z : ℝ≥0) (R : Fin M → Position) (a : Position) {d : ℝ} (hd : 0 < d) + (hbound : ∀ k, d ≤ ‖a - R k‖) : + (∑ k : Fin M, (Z : ℝ≥0∞) * coulombKernel a (R k)) ≤ + (∫⁻ y, screenedPotential Z R y ∂shell a (d / 2)) + + (Z : ℝ≥0∞) * (ENNReal.ofReal (d / 2))⁻¹ := by + rw [← lintegral_shell_nuclearPotential Z R a hd hbound] + simp_rw [nuclearPotential_eq_screened_add hM Z R] + have hm : Measurable (fun y : Position => (Z : ℝ≥0∞) * (nearestNucleusDistance R y)⁻¹) := + measurable_const.mul (measurable_nearestNucleusDistance R).inv + rw [lintegral_add_right _ hm] + exact add_le_add_right (lintegral_shell_nearest_le Z R a hd hbound) _ + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/Slicing.lean b/LeanPool/LiebThirring/Electrostatics/Slicing.lean new file mode 100644 index 0000000000..2fb7f8ef8a --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/Slicing.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityBounds +public import LeanPool.LiebThirring.Electrostatics.ShellAssemblyGeometry +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityIntegrability +public import LeanPool.LiebThirring.Electrostatics.SlicingScreenedFaces +public import LeanPool.LiebThirring.Electrostatics.SlicingFaceIntegrals + +/-! +# The distributional Laplacian of the screened potential + +Equation with the explicit unordered genuine-face integrals. + +Equation, stated directly with the face measure `ν`. +-/ + +public section + +open Set MeasureTheory Laplacian +open scoped NNReal ContDiff + +namespace LiebThirring + +theorem integral_eq_sum_voronoiCells {M : ℕ} (hM : 1 ≤ M) + (R : Fin M → Position) (hR : Function.Injective R) + (g : Position → ℝ) (hg : Integrable g) : + (∫ x, g x) = ∑ k : Fin M, ∫ x in voronoiCell R k, g x := by + have ha : ∀ᵐ x : Position, x ∈ ⋃ k, voronoiCell R k := by + apply ae_iff.mpr + exact volume_compl_voronoiCells R hR (by omega) + rw [integral_eq_setIntegral ha g] + exact integral_iUnion_fintype (fun k => (isOpen_voronoiCell R k).measurableSet) + (fun _ _ h => disjoint_voronoiCell R h) (fun _ => hg.integrableOn) + +/-- Equation (8.2) with the explicit unordered genuine-face integrals. -/ +theorem integral_screenedPotentialReal_mul_laplacian_faces {M : ℕ} (hM : 1 ≤ M) + (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) + (f : Position → ℝ) (hf : ContDiff ℝ 2 f) (hfc : HasCompactSupport f) : + (∫ x, screenedPotentialReal Z R x * Δ f x) = + -4 * Real.pi * ∑ p : NuclearPair M, + ∫ x in voronoiFace R p.val.1 p.val.2, + nuclearFaceDensity R (Z : ℝ) p.val.1 p.val.2 x * f x + ∂bisectorSurfaceMeasure R hR p.val.1 p.val.2 (ne_of_lt p.property) := by + rw [integral_eq_sum_voronoiCells hM R hR _ + (integrable_screenedPotentialReal_mul_laplacian hM Z R hR hf hfc)] + simp_rw [integral_screenedPotentialReal_laplacian_voronoiCell Z R hR _ f hf hfc] + let G : ∀ k l : Fin M, k ≠ l → ℝ := fun k l hkl => + ∫ x in voronoiFace R k l, screenedCellBoundaryTerm Z R k l f x + ∂bisectorSurfaceMeasure R hR k l hkl + rw [sum_directedNuclearPairs_oriented G, Finset.mul_sum] + exact Finset.sum_congr rfl (fun p _ => + integral_screenedCellBoundaryTerm_pair Z R hR _ _ _ f hf hfc) + +/-- Equation (8.2), stated directly with the face measure `ν`. -/ +theorem integral_screenedPotentialReal_mul_laplacian {M : ℕ} (hM : 1 ≤ M) + (Z : ℝ≥0) (R : Fin M → Position) (hR : Function.Injective R) + (f : Position → ℝ) (hf : ContDiff ℝ 2 f) (hfc : HasCompactSupport f) : + (∫ x, screenedPotentialReal Z R x * Δ f x) = + -4 * Real.pi * ∫ x, f x ∂voronoiFaceMeasure R hR (Z : ℝ) := by + rw [integral_voronoiFaceMeasure_density R hR Z.coe_nonneg f + (integrable_compact_voronoiFaceMeasure R hR Z.coe_nonneg hf.continuous hfc)] + exact integral_screenedPotentialReal_mul_laplacian_faces hM Z R hR f hf hfc + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SlicingCellGeometry.lean b/LeanPool/LiebThirring/Electrostatics/SlicingCellGeometry.lean new file mode 100644 index 0000000000..114e21354f --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SlicingCellGeometry.lean @@ -0,0 +1,150 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.SlicingCoordinates +public import LeanPool.LiebThirring.Electrostatics.SlicingScalar +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureGeometry + +/-! +# Voronoi cells as finite halfspace slices + +The affine constraints and genuine-facet values needed to instantiate the +scalar fundamental theorem on almost every coordinate line. +-/ + +public section + +open Set +open scoped RealInnerProductSpace + +namespace LiebThirring + +/-- The affine offset of a Voronoi halfspace along a selected coordinate line. -/ +@[expose] noncomputable def voronoiSliceOffset {M : ℕ} (R : Fin M → Position) + (k l : Fin M) (a : Fin 3) (q : Planar) : ℝ := + ‖R l - R k‖ / 2 - inner ℝ (bisectorNormal R k l) (coordinateLine a q 0 - R k) + +theorem inner_bisectorNormal_coordinateLine {M : ℕ} (R : Fin M → Position) + (k l : Fin M) (a : Fin 3) (q : Planar) (t : ℝ) : + inner ℝ (bisectorNormal R k l) (coordinateLine a q t - R k) = + t * bisectorNormal R k l a + + inner ℝ (bisectorNormal R k l) (coordinateLine a q 0 - R k) := by + rw [coordinateLine_eq_affine a q t, coordinateLine_zero_one_eq_basis, + add_sub_right_comm, inner_add_right, inner_smul_right, + EuclideanSpace.inner_basisFun_real] + ring + +theorem dist_lt_dist_iff_bisectorNormal {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (k l : Fin M) (hkl : k ≠ l) (x : Position) : + dist x (R k) < dist x (R l) ↔ + inner ℝ (bisectorNormal R k l) (x - R k) < ‖R l - R k‖ / 2 := by + have hp : 0 < ‖R l - R k‖ := norm_pos_iff.mpr (sub_ne_zero.mpr (hR.ne hkl.symm)) + rw [dist_lt_dist_iff_inner_lt] + simp only [bisectorNormal, real_inner_smul_left, ← div_eq_inv_mul] + rw [div_lt_iff₀ hp] + constructor <;> intro h <;> nlinarith only [h] + +theorem dist_lt_dist_coordinateLine_iff {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (k l : Fin M) (hkl : k ≠ l) + (a : Fin 3) (q : Planar) (t : ℝ) : + dist (coordinateLine a q t) (R k) < dist (coordinateLine a q t) (R l) ↔ + t * bisectorNormal R k l a < voronoiSliceOffset R k l a q := by + rw [dist_lt_dist_iff_bisectorNormal R hR k l hkl, + inner_bisectorNormal_coordinateLine] + unfold voronoiSliceOffset + constructor <;> intro h <;> linarith only [h] + +theorem mem_voronoiCell_coordinateLine_iff {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (k : Fin M) (a : Fin 3) (q : Planar) (t : ℝ) : + coordinateLine a q t ∈ voronoiCell R k ↔ + ∀ l : {l : Fin M // l ≠ k}, + t * bisectorNormal R k l.val a < voronoiSliceOffset R k l.val a q := by + rw [mem_voronoiCell_iff_normal R hR] + simp only [Subtype.forall] + apply forall_congr' + intro l + apply imp_congr_right + intro hl + rw [inner_bisectorNormal_coordinateLine] + unfold voronoiSliceOffset + constructor <;> intro ht <;> linarith only [ht] + +theorem coordinateLine_slice_root_mem_bisector {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (k l : Fin M) (hkl : k ≠ l) (a : Fin 3) (q : Planar) + (ha : bisectorNormal R k l a ≠ 0) : + coordinateLine a q (voronoiSliceOffset R k l a q / bisectorNormal R k l a) ∈ + bisectorPlane R k l := by + rw [mem_bisectorPlane_iff_normal R hR hkl, inner_bisectorNormal_coordinateLine, + div_mul_cancel₀ _ ha, voronoiSliceOffset] + exact sub_add_cancel _ _ + +theorem voronoi_slice_constraints_regular {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (k : Fin M) (a : Fin 3) (q : Planar) + (hq : q ∉ slicingExceptionalSet R a) (t : ℝ) + (l p : {l : Fin M // l ≠ k}) (hlp : l ≠ p) + (hl : t * bisectorNormal R k l.val a = voronoiSliceOffset R k l.val a q) + (hp : t * bisectorNormal R k p.val a = voronoiSliceOffset R k p.val a q) : False := by + have hlplane : coordinateLine a q t ∈ bisectorPlane R k l.val := by + rw [mem_bisectorPlane_iff_normal R hR l.property.symm, + inner_bisectorNormal_coordinateLine, hl, voronoiSliceOffset] + exact sub_add_cancel _ _ + have hpplane : coordinateLine a q t ∈ bisectorPlane R k p.val := by + rw [mem_bisectorPlane_iff_normal R hR p.property.symm, + inner_bisectorNormal_coordinateLine, hp, voronoiSliceOffset] + exact sub_add_cancel _ _ + apply hq + apply Or.inl + refine ⟨coordinateLine a q t, ?_, planeProjection_coordinateLine a q t⟩ + exact ⟨k, l.val, p.val, l.property.symm, p.property.symm, + (fun he => hlp (Subtype.ext he)), hlplane, hpplane⟩ + +theorem coordinateLine_slice_root_eq_planeGraph {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (k l : Fin M) (hkl : k ≠ l) (a : Fin 3) (q : Planar) + (ha : bisectorNormal R k l a ≠ 0) : + coordinateLine a q (voronoiSliceOffset R k l a q / bisectorNormal R k l a) = + planeGraph (bisectorNormal R k l) (midpoint ℝ (R k) (R l)) a ha q := by + have hm := coordinateLine_slice_root_mem_bisector R hR k l hkl a q ha + rw [bisectorPlane_eq_affinePlane R hR hkl] at hm + exact (planeGraph_planeProjection _ _ a ha _ hm).symm.trans + (by rw [planeProjection_coordinateLine]) + +theorem halfspaceFaceValue_voronoi {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (k : Fin M) (l : {l : Fin M // l ≠ k}) + (a : Fin 3) (q : Planar) (ha : bisectorNormal R k l.val a ≠ 0) + (g : Position → ℝ) : + halfspaceFaceValue (fun p : {p : Fin M // p ≠ k} => bisectorNormal R k p.val a) + (fun p => voronoiSliceOffset R k p.val a q) (fun t => g (coordinateLine a q t)) l = + (voronoiFace R k l.val).indicator g + (coordinateLine a q (voronoiSliceOffset R k l.val a q / bisectorNormal R k l.val a)) := by + classical + let t := voronoiSliceOffset R k l.val a q / bisectorNormal R k l.val a + have he : (∀ p : {p : Fin M // p ≠ k}, p ≠ l → + t * bisectorNormal R k p.val a < voronoiSliceOffset R k p.val a q) ↔ + coordinateLine a q t ∈ voronoiFace R k l.val := by + constructor + · intro hp + refine ⟨l.property.symm, coordinateLine_slice_root_mem_bisector R hR k l.val + l.property.symm a q ha, ?_⟩ + intro p hpk hpl + exact (dist_lt_dist_coordinateLine_iff R hR k p hpk.symm a q t).mpr + (hp ⟨p, hpk⟩ (fun he => hpl (congrArg Subtype.val he))) + · intro hx p hpl + exact (dist_lt_dist_coordinateLine_iff R hR k p.val p.property.symm a q t).mp + (hx.2.2 p.val p.property (fun he => hpl (Subtype.ext he))) + unfold halfspaceFaceValue + dsimp only + by_cases hf : ∀ p : {p : Fin M // p ≠ k}, p ≠ l → + t * bisectorNormal R k p.val a < voronoiSliceOffset R k p.val a q + · rw [ite_eq_left hf, indicator_of_mem (he.mp hf)] + · rw [ite_eq_right hf, indicator_of_notMem (fun hm => hf (he.mpr hm))] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SlicingCellIntegral.lean b/LeanPool/LiebThirring/Electrostatics/SlicingCellIntegral.lean new file mode 100644 index 0000000000..83f04dae40 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SlicingCellIntegral.lean @@ -0,0 +1,124 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.SlicingDirectional +public import LeanPool.LiebThirring.Electrostatics.PlaneFormula +import all LeanPool.LiebThirring.Electrostatics.FaceMeasureGeometry + +/-! +# Directional integration over a Voronoi cell + +Fubini and the planar projection formula turn the almost-everywhere scalar +line identity into the cell integration-by-parts formula. +-/ + +public section + +open Set MeasureTheory + +namespace LiebThirring + +theorem integrable_compact_bisectorSurfaceMeasure {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (k l : Fin M) (hkl : k ≠ l) + (g : Position → ℝ) (hg : Continuous g) (hgc : HasCompactSupport g) : + Integrable g (bisectorSurfaceMeasure R hR k l hkl) := by + obtain ⟨a, ha⟩ : ∃ a, bisectorNormal R k l a ≠ 0 := by + by_contra! hz + have hn : bisectorNormal R k l = 0 := by ext a; exact hz a + have he := norm_bisectorNormal R hR hkl + rw [hn, norm_zero] at he + exact zero_ne_one he + rw [bisectorSurfaceMeasure, integrable_planeMeasure_projection_iff _ _ + (norm_bisectorNormal R hR hkl) a ha] + exact (hg.comp (isClosedEmbedding_planeGraph _ _ a ha).continuous).integrable_of_hasCompactSupport + (hgc.comp_isClosedEmbedding (isClosedEmbedding_planeGraph _ _ a ha)) + +theorem integrable_coordinateFaceTerm {M : ℕ} (R : Fin M → Position) + (k l : Fin M) (a : Fin 3) (g : Position → ℝ) + (hg : Continuous g) (hgc : HasCompactSupport g) : + Integrable (coordinateFaceTerm R k l a g) := by + classical + unfold coordinateFaceTerm + split_ifs with ha + · let G := planeGraph (bisectorNormal R k l) (midpoint ℝ (R k) (R l)) a ha + have hc := isClosedEmbedding_planeGraph (bisectorNormal R k l) + (midpoint ℝ (R k) (R l)) a ha + have hi : Integrable (g ∘ G) := (hg.comp hc.continuous).integrable_of_hasCompactSupport + (hgc.comp_isClosedEmbedding hc) + have he (q : Planar) : (voronoiFace R k l).indicator g (G q) = + (G ⁻¹' voronoiFace R k l).indicator (g ∘ G) q := by + by_cases hq : G q ∈ voronoiFace R k l + · rw [indicator_of_mem hq, indicator_of_mem (s := G ⁻¹' voronoiFace R k l) hq]; rfl + · rw [indicator_of_notMem hq, indicator_of_notMem (s := G ⁻¹' voronoiFace R k l) hq] + change Integrable (fun q => _ * (voronoiFace R k l).indicator g (G q)) + simp_rw [he] + exact (hi.indicator ((measurableSet_voronoiFace R k l).preimage + hc.continuous.measurable)).const_mul _ + · exact integrable_zero _ _ _ + +theorem integral_coordinateFaceTerm {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (k l : Fin M) (hkl : k ≠ l) + (a : Fin 3) (g : Position → ℝ) : + (∫ q, coordinateFaceTerm R k l a g q) = + bisectorNormal R k l a * ∫ x in voronoiFace R k l, g x + ∂bisectorSurfaceMeasure R hR k l hkl := by + classical + by_cases ha : bisectorNormal R k l a ≠ 0 + · simp only [coordinateFaceTerm, dite_eq_left ha] + rw [integral_const_mul, ← integral_indicator (measurableSet_voronoiFace R k l), + bisectorSurfaceMeasure, integral_planeMeasure_projection _ _ + (norm_bisectorNormal R hR hkl) a ha] + simp only [div_eq_mul_inv, mul_assoc] + · have he : coordinateFaceTerm R k l a g = fun _ => 0 := by + funext q + exact dite_eq_right ha + rw [he, integral_zero, not_ne_iff.mp ha, zero_mul] + +theorem voronoiCell_compact_directional_integral {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (k : Fin M) (a : Fin 3) (g : Position → ℝ) + (hg : ContDiff ℝ 1 g) (hgc : HasCompactSupport g) : + (∫ x in voronoiCell R k, fderiv ℝ g x (EuclideanSpace.basisFun (Fin 3) ℝ a)) = + ∑ l : {l : Fin M // l ≠ k}, bisectorNormal R k l.val a * + ∫ x in voronoiFace R k l.val, g x + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm := by + classical + let D := fun x => fderiv ℝ g x (EuclideanSpace.basisFun (Fin 3) ℝ a) + have hi : Integrable D := + ((hg.continuous_fderiv (by decide)).clm_apply continuous_const).integrable_of_hasCompactSupport + (hgc.fderiv_apply ℝ _) + let C := voronoiCell R k + have hC := (isOpen_voronoiCell R k).measurableSet + rw [← integral_indicator hC, integral_coordinateLines a _ (hi.indicator hC)] + have he (q : Planar) : (fun t => C.indicator D (coordinateLine a q t)) = + {t | coordinateLine a q t ∈ C}.indicator (fun t => D (coordinateLine a q t)) := by + ext t + by_cases ht : coordinateLine a q t ∈ C + · rw [indicator_of_mem ht, + indicator_of_mem (s := {t | coordinateLine a q t ∈ C}) ht] + · rw [indicator_of_notMem ht, + indicator_of_notMem (s := {t | coordinateLine a q t ∈ C}) ht] + have hs : (∫ q : Planar, ∫ t, C.indicator D (coordinateLine a q t)) = + ∫ q : Planar, ∑ l : {l : Fin M // l ≠ k}, coordinateFaceTerm R k l.val a g q := by + apply integral_congr_ae + filter_upwards [ae_notMem_slicingExceptionalSet R hR a] with q hq + rw [he q] + have hpre : MeasurableSet {t | coordinateLine a q t ∈ C} := + ((isOpen_voronoiCell R k).preimage (isClosedEmbedding_coordinateLine a + q).continuous).measurableSet + exact (integral_indicator hpre).trans + (integral_coordinateLine_voronoiCell R hR k a q hq g hg hgc) + rw [hs, integral_finsetSum _ (fun l _ => integrable_coordinateFaceTerm R k l.val a g + hg.continuous hgc)] + exact Finset.sum_congr rfl (fun l _ => integral_coordinateFaceTerm R hR k l.val l.property.symm a + g) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SlicingCoordinates.lean b/LeanPool/LiebThirring/Electrostatics/SlicingCoordinates.lean new file mode 100644 index 0000000000..04dfe138ff --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SlicingCoordinates.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.MeasureTheory.Integral.Bochner.Basic +public import LeanPool.LiebThirring.Electrostatics.SlicingLines +import LeanPool.LiebThirring.Electrostatics.SphereCap +import all Mathlib.MeasureTheory.MeasurableSpace.Embedding + +/-! +# Volume and derivative coordinates for slicing + +Coordinate insertion is an isometric embedding on each line; coordinate +deletion and insertion preserve Lebesgue volume as a product decomposition. +-/ + +public section + +open MeasureTheory + +namespace LiebThirring + +theorem coordinateLine_zero_one_eq_basis (a : Fin 3) : + coordinateLine a 0 1 = EuclideanSpace.basisFun (Fin 3) ℝ a := by + ext i + revert i + rw [a.forall_iff_succAbove] + constructor + · simp [EuclideanSpace.basisFun_apply] + · intro j + simp [EuclideanSpace.basisFun_apply, a.succAbove_ne j] + +theorem isometry_coordinateLine (a : Fin 3) (q : Planar) : + Isometry (coordinateLine a q) := by + apply isometry_iff_dist_eq.mpr + intro s t + rw [dist_eq_norm, coordinateLine_eq_affine a q s, coordinateLine_eq_affine a q t] + rw [add_sub_add_left_eq_sub, ← sub_smul, coordinateLine_zero_one_eq_basis, + norm_smul] + simp [EuclideanSpace.basisFun_apply, Real.dist_eq] + +theorem isClosedEmbedding_coordinateLine (a : Fin 3) (q : Planar) : + Topology.IsClosedEmbedding (coordinateLine a q) := + (isometry_coordinateLine a q).isClosedEmbedding + +/-- Measure-preserving separation of a selected spatial coordinate from its plane. -/ +@[expose] noncomputable def coordinateSplit (a : Fin 3) : Position ≃ᵐ Planar × ℝ := + ((MeasurableEquiv.toLp 2 (Fin 3 → ℝ)).symm.trans + ((MeasurableEquiv.piFinSuccAbove (fun _ : Fin 3 => ℝ) a).trans + (MeasurableEquiv.prodCongr (MeasurableEquiv.refl ℝ) + (MeasurableEquiv.toLp 2 (Fin 2 → ℝ))))).trans (MeasurableEquiv.prodComm : ℝ × Planar ≃ᵐ + Planar × ℝ) + +theorem coordinateSplit_preserving (a : Fin 3) : MeasurePreserving (coordinateSplit a) := by + have hs : MeasurePreserving (MeasurableEquiv.prodComm : ℝ × Planar ≃ᵐ Planar × ℝ) + volume volume := by + change MeasurePreserving Prod.swap volume volume + simpa only [Measure.volume_eq_prod] using + (Measure.measurePreserving_swap (μ := (volume : Measure ℝ)) + (ν := (volume : Measure Planar))) + exact ((EuclideanSpace.volume_preserving_symm_measurableEquiv_toLp (Fin 3)).trans + ((volume_preserving_piFinSuccAbove (fun _ : Fin 3 => ℝ) a).trans + ((MeasurePreserving.id volume).prod + (EuclideanSpace.volume_preserving_symm_measurableEquiv_toLp (Fin 2)).symm))).trans hs + +theorem integral_coordinateLines (a : Fin 3) (f : Position → ℝ) (hf : Integrable f) : + (∫ x, f x) = ∫ q : Planar, ∫ t : ℝ, f (coordinateLine a q t) := by + have hmp := (coordinateSplit_preserving a).symm + have hi : Integrable (fun p : Planar × ℝ => f ((coordinateSplit a).symm p)) := + (hmp.integrable_comp_emb (coordinateSplit a).symm.measurableEmbedding).mpr hf + rw [← hmp.integral_comp (coordinateSplit a).symm.measurableEmbedding, + Measure.volume_eq_prod, integral_prod _ hi] + rfl + +theorem hasDerivAt_coordinateLine (a : Fin 3) (q : Planar) (t : ℝ) : + HasDerivAt (coordinateLine a q) (EuclideanSpace.basisFun (Fin 3) ℝ a) t := by + have he : coordinateLine a q = + (fun t : ℝ => coordinateLine a q 0 + t • coordinateLine a 0 1) := + funext (coordinateLine_eq_affine a q) + rw [he, ← coordinateLine_zero_one_eq_basis] + simpa only [id_eq, one_smul] using + ((hasDerivAt_id t).smul_const (coordinateLine a 0 1)).const_add (coordinateLine a q 0) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SlicingDirectional.lean b/LeanPool/LiebThirring/Electrostatics/SlicingDirectional.lean new file mode 100644 index 0000000000..d2089c1805 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SlicingDirectional.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.Calculus.Deriv.Support +public import Mathlib.Analysis.Calculus.ContDiff.Deriv +public import LeanPool.LiebThirring.Electrostatics.SlicingCellGeometry + +/-! +# The directional cell identity on almost every line + +The compact scalar fundamental theorem, applied to each transverse line in a +Voronoi cell. The resulting terms are oriented genuine-face values. +-/ + +public section + +open Set MeasureTheory + +namespace LiebThirring + +/-- Boundary value selected by a coordinate slice of a genuine Voronoi face. -/ +@[expose] noncomputable def coordinateFaceTerm {M : ℕ} (R : Fin M → Position) + (k l : Fin M) (a : Fin 3) (g : Position → ℝ) (q : Planar) : ℝ := by + classical + exact if ha : bisectorNormal R k l a ≠ 0 then + (bisectorNormal R k l a / |bisectorNormal R k l a|) * + (voronoiFace R k l).indicator g + (planeGraph (bisectorNormal R k l) (midpoint ℝ (R k) (R l)) a ha q) + else 0 + +theorem hasDerivAt_comp_coordinateLine (g : Position → ℝ) (hg : ContDiff ℝ 1 g) + (a : Fin 3) (q : Planar) (t : ℝ) : + HasDerivAt (fun s => g (coordinateLine a q s)) + (fderiv ℝ g (coordinateLine a q t) (EuclideanSpace.basisFun (Fin 3) ℝ a)) t := + ((hg.differentiable (by decide)).differentiableAt.hasFDerivAt).comp_hasDerivAt t + (hasDerivAt_coordinateLine a q t) + +theorem integral_coordinateLine_voronoiCell {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (k : Fin M) (a : Fin 3) (q : Planar) + (hq : q ∉ slicingExceptionalSet R a) (g : Position → ℝ) + (hg : ContDiff ℝ 1 g) (hgc : HasCompactSupport g) : + (∫ t in {t | coordinateLine a q t ∈ voronoiCell R k}, + fderiv ℝ g (coordinateLine a q t) (EuclideanSpace.basisFun (Fin 3) ℝ a)) = + ∑ l : {l : Fin M // l ≠ k}, coordinateFaceTerm R k l.val a g q := by + classical + let α := fun l : {l : Fin M // l ≠ k} => bisectorNormal R k l.val a + let β := fun l : {l : Fin M // l ≠ k} => voronoiSliceOffset R k l.val a q + let G := fun t => g (coordinateLine a q t) + have hG : ContDiff ℝ 1 G := hg.comp (contDiff_coordinateLine a q 1) + have hGc : HasCompactSupport G := hgc.comp_isClosedEmbedding + (isClosedEmbedding_coordinateLine a q) + have hd (t : ℝ) : deriv G t = + fderiv ℝ g (coordinateLine a q t) (EuclideanSpace.basisFun (Fin 3) ℝ a) := + (hasDerivAt_comp_coordinateLine g hg a q t).deriv + have hs : {t | coordinateLine a q t ∈ voronoiCell R k} = + {t | ∀ l, t * α l < β l} := by + ext t + exact mem_voronoiCell_coordinateLine_iff R hR k a q t + rw [hs] + have hi := integral_derivative_finite_halfspaces α β + (fun t l p hlp _ hl hp => voronoi_slice_constraints_regular R hR k a q hq + t l p hlp hl hp) G (deriv G) + (fun t => (hG.differentiable (by decide) t).hasDerivAt) + hG.continuous_deriv_one hGc hGc.deriv + simp only [hd] at hi + rw [hi, ← Finset.sum_sub_distrib] + apply Finset.sum_congr rfl + intro l _ + by_cases ha : α l = 0 + · simp only [ha, lt_self_iff_false, ite_false, sub_self] + symm + unfold coordinateFaceTerm + exact dite_eq_right (not_ne_iff.mpr ha) + · rw [halfspaceFaceValue_voronoi R hR k l a q ha g, + coordinateLine_slice_root_eq_planeGraph R hR k l.val l.property.symm a q ha] + unfold coordinateFaceTerm + rw [dite_eq_left ha] + change ((if 0 < α l then _ else 0) - (if α l < 0 then _ else 0)) = + (α l / |α l|) * _ + rcases lt_or_gt_of_ne ha with hn | hp + · rw [ite_eq_right (not_lt_of_ge hn.le), ite_eq_left hn, abs_of_neg hn] + simp only [div_neg, div_self ha, neg_one_mul, zero_sub] + · rw [ite_eq_left hp, ite_eq_right (not_lt_of_ge hp.le), abs_of_pos hp, + div_self ha, one_mul, sub_zero] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SlicingDivergence.lean b/LeanPool/LiebThirring/Electrostatics/SlicingDivergence.lean new file mode 100644 index 0000000000..645d2be246 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SlicingDivergence.lean @@ -0,0 +1,154 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.SlicingCellIntegral +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitFluxField + +/-! +# Compact Voronoi cell and exterior divergence formulas + +Cell divergence theorem proved by coordinate line slicing. + +Equation, with precisely the directed bisector measures used in the energy deficit. +-/ + +public section + +open Set MeasureTheory +open scoped RealInnerProductSpace + +namespace LiebThirring + +theorem integrable_compact_directional_derivative {E : Type*} + [NormedAddCommGroup E] [NormedSpace ℝ E] + (g : Position → E) (hg : ContDiff ℝ 1 g) (hgc : HasCompactSupport g) (v : Position) : + Integrable (fun x => fderiv ℝ g x v) := + ((hg.continuous_fderiv (by decide)).clm_apply continuous_const).integrable_of_hasCompactSupport + (hgc.fderiv_apply ℝ v) + +theorem integral_compact_directional_derivative_eq_zero (g : Position → ℝ) + (hg : ContDiff ℝ 1 g) (hgc : HasCompactSupport g) (a : Fin 3) : + (∫ x, fderiv ℝ g x (EuclideanSpace.basisFun (Fin 3) ℝ a)) = 0 := by + rw [integral_coordinateLines a _ (integrable_compact_directional_derivative g hg hgc _)] + have he (q : Planar) : + (∫ t, fderiv ℝ g (coordinateLine a q t) (EuclideanSpace.basisFun (Fin 3) ℝ a)) = 0 := by + let G := fun t => g (coordinateLine a q t) + have hG : ContDiff ℝ 1 G := hg.comp (contDiff_coordinateLine a q 1) + have hGc : HasCompactSupport G := hgc.comp_isClosedEmbedding + (isClosedEmbedding_coordinateLine a q) + have hi := integral_derivative_finite_halfspaces (fun i : Fin 0 => Fin.elim0 i) + (fun i : Fin 0 => Fin.elim0 i) (fun _ i => Fin.elim0 i) G (deriv G) + (fun t => (hG.differentiable (by decide) t).hasDerivAt) + hG.continuous_deriv_one hGc hGc.deriv + have hd (t : ℝ) : deriv G t = + fderiv ℝ g (coordinateLine a q t) (EuclideanSpace.basisFun (Fin 3) ℝ a) := + (hasDerivAt_comp_coordinateLine g hg a q t).deriv + simpa only [Fin.forall_fin_zero, ofPred_true, Measure.restrict_univ, + Finset.univ_eq_empty, Finset.sum_empty, sub_zero, hd] using hi + simp only [he, integral_zero] + +theorem fderiv_position_component (V : Position → Position) (hV : ContDiff ℝ 1 V) + (a : Fin 3) (x v : Position) : + fderiv ℝ (fun y => V y a) x v = (fderiv ℝ V x v) a := by + have hd := (EuclideanSpace.proj a : Position →L[ℝ] ℝ).hasFDerivAt.comp x + ((hV.differentiable (by decide)).differentiableAt.hasFDerivAt) + have hd' : HasFDerivAt (fun y => V y a) + ((EuclideanSpace.proj a : Position →L[ℝ] ℝ).comp (fderiv ℝ V x)) x := by + simpa only [EuclideanSpace.coe_proj, Function.comp_def] using hd + rw [hd'.fderiv, ContinuousLinearMap.comp_apply, EuclideanSpace.coe_proj] + +theorem integrable_positionDivergence (V : Position → Position) + (hV : ContDiff ℝ 1 V) (hVc : HasCompactSupport V) : + Integrable (positionDivergence V) := by + apply integrable_finsetSum + intro a _ + simpa only [EuclideanSpace.coe_proj] using + (EuclideanSpace.proj a : Position →L[ℝ] ℝ).integrable_comp + (integrable_compact_directional_derivative V hV hVc (EuclideanSpace.basisFun (Fin 3) ℝ a)) + +theorem integral_positionDivergence_eq_zero (V : Position → Position) + (hV : ContDiff ℝ 1 V) (hVc : HasCompactSupport V) : + (∫ x, positionDivergence V x) = 0 := by + unfold positionDivergence + rw [integral_finsetSum _ (fun a _ => (by + simpa only [EuclideanSpace.coe_proj] using + (EuclideanSpace.proj a : Position →L[ℝ] ℝ).integrable_comp + (integrable_compact_directional_derivative V hV hVc (EuclideanSpace.basisFun (Fin 3) ℝ + a))))] + apply Finset.sum_eq_zero + intro a _ + have hg : ContDiff ℝ 1 (fun x => V x a) := by + simpa only [EuclideanSpace.coe_proj, Function.comp_def] using + (EuclideanSpace.proj a : Position →L[ℝ] ℝ).contDiff.comp hV + have hgc : HasCompactSupport (fun x => V x a) := hVc.comp_left (map_zero (EuclideanSpace.proj a : + Position →L[ℝ] ℝ)) + simpa only [fderiv_position_component V hV a] using + integral_compact_directional_derivative_eq_zero (fun x => V x a) hg hgc a + +/-- Cell divergence theorem proved by coordinate line slicing. -/ +theorem voronoiCell_compact_flux {M : ℕ} + (R : Fin M → Position) (hR : Function.Injective R) (k : Fin M) + (V : Position → Position) (hV : ContDiff ℝ 1 V) (hVc : HasCompactSupport V) : + (∫ x in voronoiCell R k, positionDivergence V x) = + ∑ l : {l : Fin M // l ≠ k}, + ∫ y in voronoiFace R k l.val, inner ℝ (bisectorNormal R k l.val) (V y) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm := by + classical + have hg (a : Fin 3) : ContDiff ℝ 1 (fun x => V x a) := by + simpa only [EuclideanSpace.coe_proj, Function.comp_def] using + (EuclideanSpace.proj a : Position →L[ℝ] ℝ).contDiff.comp hV + have hgc (a : Fin 3) : HasCompactSupport (fun x => V x a) := + hVc.comp_left (map_zero (EuclideanSpace.proj a : Position →L[ℝ] ℝ)) + have hi (a : Fin 3) : Integrable (fun x => (fderiv ℝ V x + (EuclideanSpace.basisFun (Fin 3) ℝ a)) a) := by + simpa only [EuclideanSpace.coe_proj] using + (EuclideanSpace.proj a : Position →L[ℝ] ℝ).integrable_comp + (integrable_compact_directional_derivative V hV hVc (EuclideanSpace.basisFun (Fin 3) ℝ a)) + have hb (a : Fin 3) (l : {l : Fin M // l ≠ k}) : + IntegrableOn (fun x => bisectorNormal R k l.val a * V x a) (voronoiFace R k l.val) + (bisectorSurfaceMeasure R hR k l.val l.property.symm) := + ((integrable_compact_bisectorSurfaceMeasure R hR k l.val l.property.symm + (fun x => V x a) (hg a).continuous (hgc a)).const_mul _).integrableOn + unfold positionDivergence + rw [integral_finsetSum _ (fun a _ => (hi a).integrableOn)] + have he (a : Fin 3) : + (∫ x in voronoiCell R k, (fderiv ℝ V x (EuclideanSpace.basisFun (Fin 3) ℝ a)) a) = + ∑ l : {l : Fin M // l ≠ k}, bisectorNormal R k l.val a * + ∫ x in voronoiFace R k l.val, V x a + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm := by + simpa only [fderiv_position_component V hV a] using + voronoiCell_compact_directional_integral R hR k a (fun x => V x a) (hg a) (hgc a) + simp_rw [he] + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro l _ + simp_rw [← integral_const_mul] + rw [← integral_finsetSum _ (fun a _ => hb a l)] + apply integral_congr_ae + filter_upwards with x + simp only [PiLp.inner_apply, RCLike.inner_apply, conj_trivial, mul_comm] + +/-- Equation, with precisely the directed bisector measures used in the energy deficit. -/ +theorem voronoiExterior_compact_flux {M : ℕ} + (R : Fin M → Position) (hR : Function.Injective R) (k : Fin M) + (V : Position → Position) (hV : ContDiff ℝ 1 V) (hVc : HasCompactSupport V) : + (∫ x in (voronoiCell R k)ᶜ, positionDivergence V x) = + -(∑ l : {l : Fin M // l ≠ k}, + ∫ y in voronoiFace R k l.val, inner ℝ (bisectorNormal R k l.val) (V y) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm) := by + have he := integral_add_compl (isOpen_voronoiCell R k).measurableSet + (integrable_positionDivergence V hV hVc) + rw [integral_positionDivergence_eq_zero V hV hVc, + voronoiCell_compact_flux R hR k V hV hVc] at he + exact eq_neg_of_add_eq_zero_right he + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SlicingExceptional.lean b/LeanPool/LiebThirring/Electrostatics/SlicingExceptional.lean new file mode 100644 index 0000000000..f9723b1015 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SlicingExceptional.lean @@ -0,0 +1,128 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.VoronoiStrata +public import LeanPool.LiebThirring.Electrostatics.PlaneProjection +import LeanPool.LiebThirring.Electrostatics.FaceMeasureGeometry + +/-! +# Null projected triple ties + +Coordinate projections of triple-tie strata form a null exceptional set for line slicing. +-/ + +public section + +open MeasureTheory Set + +namespace LiebThirring + +theorem volume_planeProjection_affineSubspace_eq_zero (a : Fin 3) + (S : AffineSubspace ℝ Position) (hS : Module.finrank ℝ S.direction ≤ 1) : + volume (planeProjection a '' (S : Set Position)) = 0 := by + let f := (planeProjectionLinear a).toAffineMap + have he : planeProjection a '' (S : Set Position) = (S.map f : Set Planar) := + (AffineSubspace.coe_map f S).symm + rw [he] + apply Measure.addHaar_affineSubspace + intro ht + have hd : Module.finrank ℝ (S.map f).direction ≤ 1 := by + rw [AffineSubspace.map_direction] + exact (Submodule.finrank_map_le f.linear S.direction).trans hS + rw [ht, AffineSubspace.direction_top, finrank_top] at hd + have hdim : Module.finrank ℝ Planar = 2 := by + simp only [Planar, finrank_euclideanSpace_fin] + rw [hdim] at hd + omega + +theorem volume_planeProjection_voronoiTripleStratum {M : ℕ} + (R : Fin M → Position) (hR : Function.Injective R) (a : Fin 3) : + volume (planeProjection a '' voronoiTripleStratum R) = 0 := by + rw [voronoiTripleStratum_eq_iUnion] + simp only [image_iUnion] + exact measure_iUnion_null fun k => measure_iUnion_null fun l => measure_iUnion_null fun p => + volume_planeProjection_affineSubspace_eq_zero a _ + (finrank_bisectorPlane_inf_le_one R hR l.property p.property.1 p.property.2) + +/-- A nontransverse plane projects into an affine line in the base plane. -/ +theorem volume_planeProjection_affinePlane_of_coordinate_zero + (n b : Position) (hn : n ≠ 0) (a : Fin 3) (ha : n a = 0) : + volume (planeProjection a '' (affinePlane n b : Set Position)) = 0 := by + have hnp : planeProjection a n ≠ 0 := by + intro he + apply hn + ext i + revert i + rw [a.forall_iff_succAbove] + constructor + · simpa only [PiLp.zero_apply] using ha + · intro j + have hc := congrArg (fun q : Planar => q j) he + simpa only [planeProjection_apply, PiLp.zero_apply] using hc + let H : AffineSubspace ℝ Planar := + AffineSubspace.mk' (planeProjection a b) (ℝ ∙ planeProjection a n)ᗮ + have hnull : volume (H : Set Planar) = 0 := by + apply Measure.addHaar_affineSubspace + intro ht + have hm : planeProjection a n + planeProjection a b ∈ H := by rw [ht]; trivial + change planeProjection a n + planeProjection a b ∈ + AffineSubspace.mk' (planeProjection a b) (ℝ ∙ planeProjection a n)ᗮ at hm + rw [AffineSubspace.mem_mk', vsub_eq_sub, add_sub_cancel_right, + Submodule.mem_orthogonal_singleton_iff_inner_right] at hm + exact hnp (inner_self_eq_zero.mp hm) + apply measure_mono_null _ hnull + rintro q ⟨x, hx, rfl⟩ + change planeProjection a x ∈ AffineSubspace.mk' (planeProjection a b) + (ℝ ∙ planeProjection a n)ᗮ + rw [AffineSubspace.mem_mk', vsub_eq_sub, + Submodule.mem_orthogonal_singleton_iff_inner_right] + have he : inner ℝ (planeProjection a n) (planeProjection a x - planeProjection a b) = + ∑ j : Fin 2, n (a.succAbove j) * (x (a.succAbove j) - b (a.succAbove j)) := by + simp [PiLp.inner_apply, RCLike.inner_apply, planeProjection_apply, mul_comm] + rw [he] + have hx' : x ∈ affinePlane n b := hx + rw [mem_affinePlane, inner_sub_eq_coordinate_sum, Fin.sum_univ_succAbove _ a, + ha, zero_mul, zero_add] at hx' + exact hx' + +theorem volume_planeProjection_bisector_of_coordinate_zero {M : ℕ} + (R : Fin M → Position) (hR : Function.Injective R) (k l : Fin M) + (hkl : k ≠ l) (a : Fin 3) (ha : bisectorNormal R k l a = 0) : + volume (planeProjection a '' (bisectorPlane R k l : Set Position)) = 0 := by + rw [bisectorPlane_eq_affinePlane R hR hkl] + apply volume_planeProjection_affinePlane_of_coordinate_zero _ _ _ a ha + intro he + have hh := norm_bisectorNormal R hR hkl + rw [he, norm_zero] at hh + exact zero_ne_one hh + +/-- Bases excluded in the slicing proof: triple ties and nontransverse planes. -/ +@[expose] def slicingExceptionalSet {M : ℕ} (R : Fin M → Position) (a : Fin 3) : Set Planar := + (planeProjection a '' voronoiTripleStratum R) ∪ + ⋃ k : Fin M, ⋃ l : {l : Fin M // k ≠ l}, + ⋃ (_ : bisectorNormal R k l.val a = 0), + planeProjection a '' (bisectorPlane R k l.val : Set Position) + +theorem volume_slicingExceptionalSet {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (a : Fin 3) : + volume (slicingExceptionalSet R a) = 0 := by + apply measure_union_null (volume_planeProjection_voronoiTripleStratum R hR a) + exact measure_iUnion_null fun k => measure_iUnion_null fun l => measure_iUnion_null fun ha => + volume_planeProjection_bisector_of_coordinate_zero R hR k l.val l.property a ha + +theorem ae_notMem_slicingExceptionalSet {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (a : Fin 3) : + ∀ᵐ q : Planar, q ∉ slicingExceptionalSet R a := by + apply ae_iff.mpr + simpa only [not_not, Set.ofPred_mem_eq] using volume_slicingExceptionalSet R hR a + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SlicingFaceIntegrals.lean b/LeanPool/LiebThirring/Electrostatics/SlicingFaceIntegrals.lean new file mode 100644 index 0000000000..ad118a243e --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SlicingFaceIntegrals.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureDirected +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureMass +public import LeanPool.LiebThirring.Electrostatics.PlaneFormula +import all LeanPool.LiebThirring.Electrostatics.FaceMeasureBasic +import all LeanPool.LiebThirring.Electrostatics.FaceMeasureGeometry + +/-! +# Surface charge and coordinate graph integrals + +Integration against one face charge, with the literal face charge density. + +The literal unordered-face surface integral form of the `ν`. +-/ + +public section + +open MeasureTheory Set +open scoped NNReal + +namespace LiebThirring + +/-- Integration against one face charge, with the literal face charge density. -/ +theorem integral_nuclearFaceMeasure_density {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) + (k l : Fin M) (hkl : k ≠ l) (f : Position → ℝ) : + (∫ x, f x ∂nuclearFaceMeasure R hR Z k l hkl) = + ∫ x in voronoiFace R k l, nuclearFaceDensity R Z k l x * f x + ∂bisectorSurfaceMeasure R hR k l hkl := by + rw [integral_nuclearFaceMeasure_flux R hR hZ k l hkl f, ← integral_const_mul] + apply setIntegral_congr_fun (measurableSet_voronoiFace R k l) + intro x hx + change (Z / (2 * Real.pi)) * (f x * nuclearFaceFlux R k l x) = + nuclearFaceDensity R Z k l x * f x + rw [nuclearFaceDensity_eq_flux R hR Z hx] + ring + +/-- The literal unordered-face surface integral form of the landed `ν`. -/ +theorem integral_voronoiFaceMeasure_density {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) + (f : Position → ℝ) (hf : Integrable f (voronoiFaceMeasure R hR Z)) : + (∫ x, f x ∂voronoiFaceMeasure R hR Z) = + ∑ p : NuclearPair M, ∫ x in voronoiFace R p.val.1 p.val.2, + nuclearFaceDensity R Z p.val.1 p.val.2 x * f x + ∂bisectorSurfaceMeasure R hR p.val.1 p.val.2 (ne_of_lt p.property) := by + rw [voronoiFaceMeasure] at hf ⊢ + rw [integral_finsetSum_measure (integrable_finsetSum_measure.mp hf)] + exact Finset.sum_congr rfl (fun p _ => integral_nuclearFaceMeasure_density R hR hZ _ _ _ f) + +theorem integrable_compact_voronoiFaceMeasure {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) {Z : ℝ} (hZ : 0 ≤ Z) + {f : Position → ℝ} (hf : Continuous f) (hfc : HasCompactSupport f) : + Integrable f (voronoiFaceMeasure R hR Z) := by + let := isFiniteMeasure_voronoiFaceMeasure R hR hZ + exact hf.integrable_of_hasCompactSupport hfc + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SlicingGreen.lean b/LeanPool/LiebThirring/Electrostatics/SlicingGreen.lean new file mode 100644 index 0000000000..8e9a383b85 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SlicingGreen.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.SlicingDivergence +public import LeanPool.LiebThirring.Analysis.FundamentalSolutionIntegrationByParts + +/-! +# Green's second identity on an open Voronoi cell + +Compact tests eliminate outer boundary terms. The genuine-face terms follow +from the directional cell identity proved by line slicing. +-/ + +public section + +open Set MeasureTheory InnerProductSpace Laplacian + +namespace LiebThirring + +/-- A coordinate component of the vector field in Green’s identity. -/ +@[expose] noncomputable def slicingGreenComponent (g f : Position → ℝ) + (a : Fin 3) (x : Position) : ℝ := + g x * fderiv ℝ f x (EuclideanSpace.basisFun (Fin 3) ℝ a) - + f x * fderiv ℝ g x (EuclideanSpace.basisFun (Fin 3) ℝ a) + +theorem contDiff_slicingGreenComponent {g f : Position → ℝ} + (hg : ContDiff ℝ 2 g) (hf : ContDiff ℝ 2 f) (a : Fin 3) : + ContDiff ℝ 1 (slicingGreenComponent g f a) := + ((hg.of_le (by norm_num)).mul ((hf.fderiv_right (by norm_num)).clm_apply contDiff_const)).sub + ((hf.of_le (by norm_num)).mul ((hg.fderiv_right (by norm_num)).clm_apply contDiff_const)) + +theorem hasCompactSupport_slicingGreenComponent {g f : Position → ℝ} + (hfc : HasCompactSupport f) (a : Fin 3) : + HasCompactSupport (slicingGreenComponent g f a) := + (hfc.fderiv_apply ℝ _).mul_left.sub hfc.mul_right + +theorem fderiv_slicingGreenComponent {g f : Position → ℝ} + (hg : ContDiff ℝ 2 g) (hf : ContDiff ℝ 2 f) (a : Fin 3) (x : Position) : + fderiv ℝ (slicingGreenComponent g f a) x (EuclideanSpace.basisFun (Fin 3) ℝ a) = + g x * fderiv ℝ (fderiv ℝ f) x (EuclideanSpace.basisFun (Fin 3) ℝ a) + (EuclideanSpace.basisFun (Fin 3) ℝ a) - + f x * fderiv ℝ (fderiv ℝ g) x (EuclideanSpace.basisFun (Fin 3) ℝ a) + (EuclideanSpace.basisFun (Fin 3) ℝ a) := by + let e := EuclideanSpace.basisFun (Fin 3) ℝ a + have hdg := (hg.fderiv_right (by norm_num)).clm_apply + (contDiff_const : ContDiff ℝ 1 (fun _ : Position => e)) + have hdf := (hf.fderiv_right (by norm_num)).clm_apply + (contDiff_const : ContDiff ℝ 1 (fun _ : Position => e)) + unfold slicingGreenComponent + rw [fderiv_fun_sub ((hg.differentiable (by norm_num) x).fun_mul (hdf.differentiable one_ne_zero + x)) + ((hf.differentiable (by norm_num) x).fun_mul (hdg.differentiable one_ne_zero x)), + fderiv_fun_mul (hg.differentiable (by norm_num) x) (hdf.differentiable one_ne_zero x), + fderiv_fun_mul (hf.differentiable (by norm_num) x) (hdg.differentiable one_ne_zero x)] + simp only [sub_apply, add_apply, smul_apply, smul_eq_mul, + fderiv_directional_fderiv hg, fderiv_directional_fderiv hf] + ring + +theorem laplacian_green_eq_sum {g f : Position → ℝ} + (hg : ContDiff ℝ 2 g) (hf : ContDiff ℝ 2 f) (x : Position) : + g x * Δ f x - f x * Δ g x = + ∑ a : Fin 3, fderiv ℝ (slicingGreenComponent g f a) x + (EuclideanSpace.basisFun (Fin 3) ℝ a) := by + rw [laplacian_eq_iteratedFDeriv_orthonormalBasis f (EuclideanSpace.basisFun (Fin 3) ℝ), + laplacian_eq_iteratedFDeriv_orthonormalBasis g (EuclideanSpace.basisFun (Fin 3) ℝ)] + simp only [fderiv_slicingGreenComponent hg hf, iteratedFDeriv_two_apply, + Matrix.cons_val_zero, Matrix.cons_val_one, Finset.mul_sum, Finset.sum_sub_distrib] + +/-- Green's second identity with explicit directed genuine-face integrals. -/ +theorem voronoiCell_compact_green {M : ℕ} (R : Fin M → Position) + (hR : Function.Injective R) (k : Fin M) (g f : Position → ℝ) + (hg : ContDiff ℝ 2 g) (hf : ContDiff ℝ 2 f) (hfc : HasCompactSupport f) : + (∫ x in voronoiCell R k, g x * Δ f x - f x * Δ g x) = + ∑ l : {l : Fin M // l ≠ k}, ∫ x in voronoiFace R k l.val, + (∑ a : Fin 3, bisectorNormal R k l.val a * slicingGreenComponent g f a x) + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm := by + classical + have hc (a : Fin 3) := contDiff_slicingGreenComponent hg hf a + have hsc (a : Fin 3) := hasCompactSupport_slicingGreenComponent (g := g) hfc a + have hi (a : Fin 3) := integrable_compact_directional_derivative _ (hc a) (hsc a) + (EuclideanSpace.basisFun (Fin 3) ℝ a) + simp_rw [laplacian_green_eq_sum hg hf] + rw [integral_finsetSum _ (fun a _ => (hi a).integrableOn)] + simp_rw [voronoiCell_compact_directional_integral R hR k _ _ (hc _) (hsc _)] + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro l _ + simp_rw [← integral_const_mul] + rw [← integral_finsetSum _ (fun a _ => + ((integrable_compact_bisectorSurfaceMeasure R hR k l.val l.property.symm _ + (hc a).continuous (hsc a)).const_mul _).integrableOn)] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SlicingIntervals.lean b/LeanPool/LiebThirring/Electrostatics/SlicingIntervals.lean new file mode 100644 index 0000000000..f19c939b71 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SlicingIntervals.lean @@ -0,0 +1,135 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.MeasureTheory.Integral.IntervalIntegral.Basic + +/-! +# Intervals cut out by finitely many affine inequalities + +The elementary one-dimensional geometry used in the cell divergence theorem. +Artificial outer endpoints allow a compactly supported field to be integrated +without improper endpoint bookkeeping. +-/ + +public section + +open Set + +namespace LiebThirring + +/-- A transverse genuine facet has points of the open intersection beside it. -/ +theorem exists_strict_halfspace_of_face {ι : Type*} [Finite ι] + (a b : ι → ℝ) (i : ι) (hi : a i ≠ 0) + (hface : ∀ j, j ≠ i → (b i / a i) * a j < b j) : + ∃ t : ℝ, ∀ j, t * a j < b j := by + let O : Set ℝ := {t | ∀ j : {j : ι // j ≠ i}, t * a j.val < b j.val} + have hO : IsOpen O := by + have he : O = ⋂ j : {j : ι // j ≠ i}, {t : ℝ | t * a j.val < b j.val} := by + ext t + simp only [O, mem_ofPred_eq, mem_iInter] + rw [he] + apply isOpen_iInter_of_finite + intro j + have hc : Continuous (fun t : ℝ => t * a j.val) := continuous_id.mul continuous_const + exact isOpen_lt hc continuous_const + have hm : b i / a i ∈ O := fun j => hface j.val j.property + obtain ⟨ε, hε, hball⟩ := Metric.isOpen_iff.mp hO (b i / a i) hm + rcases hi.lt_or_gt with hi | hi + · refine ⟨b i / a i + ε / 2, ?_⟩ + have ht : b i / a i + ε / 2 ∈ O := hball (by + rw [Metric.mem_ball, Real.dist_eq, add_sub_cancel_left, abs_of_pos (half_pos hε)] + exact half_lt_self hε) + intro j + by_cases hj : j = i + · rw [hj, add_mul, div_mul_cancel₀ _ hi.ne] + exact add_lt_of_neg_right _ (mul_neg_of_pos_of_neg (half_pos hε) hi) + · exact ht ⟨j, hj⟩ + · refine ⟨b i / a i - ε / 2, ?_⟩ + have ht : b i / a i - ε / 2 ∈ O := hball (by + rw [Metric.mem_ball, Real.dist_eq, sub_sub_cancel_left, abs_neg, + abs_of_pos (half_pos hε)] + exact half_lt_self hε) + intro j + by_cases hj : j = i + · rw [hj, sub_mul, div_mul_cancel₀ _ hi.ne'] + exact sub_lt_self _ (mul_pos (half_pos hε) hi) + · exact ht ⟨j, hj⟩ + +/-- A nonempty slice of finitely many strict affine halfspaces, truncated to +an interval containing a point of the slice, is itself an open interval. -/ +theorem exists_truncated_halfspace_interval {ι : Type*} [Finite ι] + (a b : ι → ℝ) {A B t₀ : ℝ} (hA : A < t₀) (hB : t₀ < B) + (h₀ : ∀ i, t₀ * a i < b i) : + ∃ L U : ℝ, A ≤ L ∧ L < t₀ ∧ t₀ < U ∧ U ≤ B ∧ + (∀ i, 0 < a i → U ≤ b i / a i) ∧ + (∀ i, a i < 0 → b i / a i ≤ L) ∧ + (U = B ∨ ∃ i, 0 < a i ∧ U = b i / a i) ∧ + (L = A ∨ ∃ i, a i < 0 ∧ L = b i / a i) ∧ + (∀ t, ((∀ i, t * a i < b i) ∧ A < t ∧ t < B) ↔ L < t ∧ t < U) := by + classical + let := Fintype.ofFinite ι + let P : Finset (Option ι) := insert none ((Finset.univ.filter (fun i => 0 < a i)).image some) + let N : Finset (Option ι) := insert none ((Finset.univ.filter (fun i => a i < 0)).image some) + let up : Option ι → ℝ := fun i => i.elim B (fun i => b i / a i) + let lo : Option ι → ℝ := fun i => i.elim A (fun i => b i / a i) + have hPn : P.Nonempty := ⟨none, Finset.mem_insert_self _ _⟩ + have hNn : N.Nonempty := ⟨none, Finset.mem_insert_self _ _⟩ + obtain ⟨ip, hip, hmin⟩ := Finset.exists_min_image P up hPn + obtain ⟨im, him, hmax⟩ := Finset.exists_max_image N lo hNn + have hsomeP (i : ι) : some i ∈ P ↔ 0 < a i := by simp [P] + have hsomeN (i : ι) : some i ∈ N ↔ a i < 0 := by simp [N] + have hUpper : up ip ≤ B := hmin none (Finset.mem_insert_self _ _) + have hLower : A ≤ lo im := hmax none (Finset.mem_insert_self _ _) + have hUpper₀ : t₀ < up ip := by + cases ip with + | none => exact hB + | some i => exact (lt_div_iff₀ (hsomeP i |>.mp hip)).mpr (h₀ i) + have hLower₀ : lo im < t₀ := by + cases im with + | none => exact hA + | some i => exact (div_lt_iff_of_neg (hsomeN i |>.mp him)).mpr (h₀ i) + have hp (i : ι) (hi : 0 < a i) : up ip ≤ b i / a i := + hmin (some i) ((hsomeP i).mpr hi) + have hm (i : ι) (hi : a i < 0) : b i / a i ≤ lo im := + hmax (some i) ((hsomeN i).mpr hi) + have hup : up ip = B ∨ ∃ i, 0 < a i ∧ up ip = b i / a i := by + cases ip with + | none => exact Or.inl rfl + | some i => exact Or.inr ⟨i, (hsomeP i).mp hip, rfl⟩ + have hlo : lo im = A ∨ ∃ i, a i < 0 ∧ lo im = b i / a i := by + cases im with + | none => exact Or.inl rfl + | some i => exact Or.inr ⟨i, (hsomeN i).mp him, rfl⟩ + refine ⟨lo im, up ip, hLower, hLower₀, hUpper₀, hUpper, hp, hm, hup, hlo, ?_⟩ + intro t + constructor + · rintro ⟨ht, htA, htB⟩ + constructor + · rcases hlo with he | ⟨i, hi, he⟩ + · exact he ▸ htA + · rw [he] + exact (div_lt_iff_of_neg hi).mpr (ht i) + · rcases hup with he | ⟨i, hi, he⟩ + · exact he ▸ htB + · rw [he] + exact (lt_div_iff₀ hi).mpr (ht i) + · rintro ⟨htL, htU⟩ + refine ⟨?_, hLower.trans_lt htL, htU.trans_le hUpper⟩ + intro i + rcases lt_trichotomy (a i) 0 with hi | hi | hi + · have ht := (hm i hi).trans_lt htL + exact (div_lt_iff_of_neg hi).mp ht + · simpa only [hi, mul_zero] using h₀ i + · have ht := htU.trans_le (hp i hi) + exact (lt_div_iff₀ hi).mp ht + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SlicingJump.lean b/LeanPool/LiebThirring/Electrostatics/SlicingJump.lean new file mode 100644 index 0000000000..00f2b07515 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SlicingJump.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityCells +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureDirected +import all LeanPool.LiebThirring.Electrostatics.FaceMeasureBasic +import all LeanPool.LiebThirring.Electrostatics.FaceMeasureGeometry + +/-! +# The derivative jump between adjacent screened representatives + +The jump of directional derivatives across a genuine Voronoi face. +-/ + +public section + +open InnerProductSpace +open scoped RealInnerProductSpace NNReal + +namespace LiebThirring + +theorem screenedCellPotential_sub {M : ℕ} (Z : ℝ≥0) (R : Fin M → Position) + (k l : Fin M) (x : Position) : + screenedCellPotential Z R l x - screenedCellPotential Z R k x = + (Z : ℝ) * ‖x - R k‖⁻¹ - (Z : ℝ) * ‖x - R l‖⁻¹ := by + classical + have hk := Finset.sum_erase_add (Finset.univ : Finset (Fin M)) + (fun p => (Z : ℝ) * ‖x - R p‖⁻¹) (Finset.mem_univ k) + have hl := Finset.sum_erase_add (Finset.univ : Finset (Fin M)) + (fun p => (Z : ℝ) * ‖x - R p‖⁻¹) (Finset.mem_univ l) + unfold screenedCellPotential + linear_combination hl - hk + +theorem fderiv_screenedCellPotential_jump {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) (k l : Fin M) + {x : Position} (hx : x ∈ voronoiFace R k l) (v : Position) : + fderiv ℝ (screenedCellPotential Z R l) x v - + fderiv ℝ (screenedCellPotential Z R k) x v = + -(Z : ℝ) * ‖R l - R k‖ / ‖x - R k‖ ^ 3 * ⟪bisectorNormal R k l, v⟫ := by + have hkl : k ≠ l := hx.1 + have hcellk := voronoiFace_subset_closed R k l hx + have hcelll := voronoiFace_subset_closed R l k ((voronoiFace_comm R k l) ▸ hx) + have hxk : x ≠ R k := ne_nucleus_of_mem_closedVoronoiCell R hR l k hkl hcelll + have hxl : x ≠ R l := ne_nucleus_of_mem_closedVoronoiCell R hR k l hkl.symm hcellk + have hcK := (contDiffAt_screenedCellPotential Z R hR k hcellk 1).differentiableAt one_ne_zero + have hcL := (contDiffAt_screenedCellPotential Z R hR l hcelll 1).differentiableAt one_ne_zero + have hdK := (contDiffAt_inv_nuclear_distance (R k) x hxk 1).differentiableAt one_ne_zero + have hdL := (contDiffAt_inv_nuclear_distance (R l) x hxl 1).differentiableAt one_ne_zero + have he : (fun y => screenedCellPotential Z R l y - screenedCellPotential Z R k y) = + (fun y => (Z : ℝ) * ‖y - R k‖⁻¹ - (Z : ℝ) * ‖y - R l‖⁻¹) := + funext (screenedCellPotential_sub Z R k l) + have hh := congrArg (fun f : Position → ℝ => fderiv ℝ f x v) he + rw [fderiv_fun_sub hcL hcK, + fderiv_fun_sub (hdK.const_mul _) (hdL.const_mul _), + fderiv_const_mul hdK, fderiv_const_mul hdL] at hh + simp only [sub_apply, smul_apply, smul_eq_mul] at hh + rw [fderiv_inv_nuclear_distance _ _ _ hxk, fderiv_inv_nuclear_distance _ _ _ hxl] at hh + have hr : ‖x - R k‖ = ‖x - R l‖ := by + simpa only [dist_eq_norm] using (mem_bisectorPlane R k l x).mp hx.2.1 + rw [← hr] at hh + rw [hh] + have hdist : ‖R l - R k‖ ≠ 0 := norm_ne_zero_iff.mpr (sub_ne_zero.mpr (hR.ne hkl.symm)) + simp only [bisectorNormal, real_inner_smul_left, inner_sub_left] + field_simp + ring + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SlicingLines.lean b/LeanPool/LiebThirring/Electrostatics/SlicingLines.lean new file mode 100644 index 0000000000..f0ebe1fefd --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SlicingLines.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.Calculus.ContDiff.Operations +public import LeanPool.LiebThirring.Electrostatics.SlicingExceptional +import LeanPool.LiebThirring.Electrostatics.FaceMeasureGeometry +import LeanPool.LiebThirring.Electrostatics.ShellAssemblyGeometry + +/-! +# Coordinate lines and finite crossing times + +Each tie on a nonexceptional coordinate line has an explicit transverse crossing time. +-/ + +public section + +open Set + +namespace LiebThirring + +/-- Insert the coordinate along which the line is sliced. -/ +@[expose] def coordinateLine (a : Fin 3) (q : Planar) (t : ℝ) : Position := + WithLp.toLp 2 (a.insertNth t (fun i => q i)) + +@[simp] theorem coordinateLine_apply_same (a : Fin 3) (q : Planar) (t : ℝ) : + coordinateLine a q t a = t := +by + dsimp only [coordinateLine] + exact Fin.insertNth_apply_same (α := fun _ => ℝ) a _ _ + +@[simp] theorem coordinateLine_apply_succAbove (a : Fin 3) (q : Planar) (t : ℝ) + (i : Fin 2) : coordinateLine a q t (a.succAbove i) = q i := +by + dsimp only [coordinateLine] + exact Fin.insertNth_apply_succAbove (α := fun _ => ℝ) a _ _ i + +@[simp] theorem planeProjection_coordinateLine (a : Fin 3) (q : Planar) (t : ℝ) : + planeProjection a (coordinateLine a q t) = q := by + ext i + exact coordinateLine_apply_succAbove a q t i + +theorem coordinateLine_eq_affine (a : Fin 3) (q : Planar) (t : ℝ) : + coordinateLine a q t = coordinateLine a q 0 + t • coordinateLine a 0 1 := by + ext i + revert i + rw [a.forall_iff_succAbove] + constructor + · simp + · intro j + simp + +theorem contDiff_coordinateLine (a : Fin 3) (q : Planar) (n : WithTop ℕ∞) : + ContDiff ℝ n (coordinateLine a q) := by + have he : coordinateLine a q = + (fun t : ℝ => coordinateLine a q 0 + t • coordinateLine a 0 1) := + funext (coordinateLine_eq_affine a q) + rw [he] + exact contDiff_const.add (contDiff_id.smul contDiff_const) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SlicingScalar.lean b/LeanPool/LiebThirring/Electrostatics/SlicingScalar.lean new file mode 100644 index 0000000000..ea7d138c33 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SlicingScalar.lean @@ -0,0 +1,126 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.SlicingScalarBoundary +public import Mathlib.MeasureTheory.Integral.IntervalIntegral.FundThmCalculus + +/-! +# Scalar fundamental theorem on a finite halfspace slice + +Integration of a compactly supported scalar derivative over the interval +cut out by finitely many affine inequalities, with the endpoints written as +the signed sum of genuine transverse constraint values. +-/ + +public section + +open Set MeasureTheory + +namespace LiebThirring + +theorem integral_derivative_finite_halfspaces {ι : Type*} [Fintype ι] + (a b : ι → ℝ) + (hregular : ∀ t i j, i ≠ j → (∀ p, t * a p ≤ b p) → + t * a i = b i → t * a j = b j → False) + (g g' : ℝ → ℝ) (hg : ∀ t, HasDerivAt g (g' t) t) + (hg' : Continuous g') (hgc : HasCompactSupport g) (hg'c : HasCompactSupport g') : + (∫ t in {t | ∀ i, t * a i < b i}, g' t) = + (∑ i : ι, if 0 < a i then halfspaceFaceValue a b g i else 0) - + ∑ i : ι, if a i < 0 then halfspaceFaceValue a b g i else 0 := by + classical + by_cases hnonempty : ∃ t, ∀ i, t * a i < b i + · obtain ⟨t₀, h₀⟩ := hnonempty + obtain ⟨C, hC⟩ := (hgc.isCompact.union hg'c.isCompact).isBounded.exists_norm_le + let D : ℝ := max C |t₀| + 1 + have hDC : C < D := by dsimp [D]; linarith only [le_max_left C |t₀|] + have hDt₀ : |t₀| < D := by dsimp [D]; linarith only [le_max_right C |t₀|] + have hzero (t : ℝ) (ht : t ≤ -D ∨ D ≤ t) : g t = 0 ∧ g' t = 0 := by + have hn : C < ‖t‖ := by + rw [Real.norm_eq_abs] + rcases ht with ht | ht + · linarith only [hDC, ht, neg_le_abs t] + · exact hDC.trans_le (ht.trans (le_abs_self t)) + constructor + · apply image_eq_zero_of_notMem_tsupport + intro hm + exact (not_le_of_gt hn) (hC t (Or.inl hm)) + · apply image_eq_zero_of_notMem_tsupport + intro hm + exact (not_le_of_gt hn) (hC t (Or.inr hm)) + have hA : -D < t₀ := by linarith only [hDt₀, neg_le_abs t₀] + have hB : t₀ < D := (le_abs_self t₀).trans_lt hDt₀ + obtain ⟨L, U, hAL, hLt₀, ht₀U, hUB, hp, hm, hup, hlo, hinterval⟩ := + exists_truncated_halfspace_interval a b hA hB h₀ + have hLU : L < U := hLt₀.trans ht₀U + have hclosedL (i : ι) : L * a i ≤ b i := by + rcases lt_trichotomy (a i) 0 with hi | hi | hi + · exact (div_le_iff_of_neg hi).mp (hm i hi) + · simpa only [hi, mul_zero] using (h₀ i).le + · exact ((lt_div_iff₀ hi).mp (hLU.trans_le (hp i hi))).le + have hclosedU (i : ι) : U * a i ≤ b i := by + rcases lt_trichotomy (a i) 0 with hi | hi | hi + · exact ((div_lt_iff_of_neg hi).mp ((hm i hi).trans_lt hLU)).le + · simpa only [hi, mul_zero] using (h₀ i).le + · exact (le_div_iff₀ hi).mp (hp i hi) + have hpositive := sum_positive_halfspaceFaceValue a b g U D hp hclosedU + (fun i j hij => hregular U i j hij hclosedU) hup + (fun t ht => (hzero t (Or.inr ht)).1) + have hnegative := sum_negative_halfspaceFaceValue a b g L (-D) hm hclosedL + (fun i j hij => hregular L i j hij hclosedL) hlo + (fun t ht => (hzero t (Or.inl ht)).1) + have hset : MeasurableSet {t : ℝ | ∀ i, t * a i < b i} := by + have he : {t : ℝ | ∀ i, t * a i < b i} = ⋂ i, {t : ℝ | t * a i < b i} := by + ext t; simp only [mem_ofPred_eq, mem_iInter] + rw [he] + exact (isOpen_iInter_of_finite (fun i => + isOpen_lt (show Continuous (fun t : ℝ => t * a i) from continuous_id.mul continuous_const) + continuous_const)).measurableSet + have he : {t : ℝ | ∀ i, t * a i < b i}.indicator g' = (Ioo L U).indicator g' := by + ext t + by_cases ht : -D < t ∧ t < D + · have hs : (∀ i, t * a i < b i) ↔ L < t ∧ t < U := by + simpa only [ht.1, ht.2, and_true] using hinterval t + by_cases hc : ∀ i, t * a i < b i + · rw [indicator_of_mem (show t ∈ {t : ℝ | ∀ i, t * a i < b i} from hc), + indicator_of_mem (show t ∈ Ioo L U from hs.mp hc)] + · rw [indicator_of_notMem (show t ∉ {t : ℝ | ∀ i, t * a i < b i} from hc), + indicator_of_notMem (show t ∉ Ioo L U from fun h => hc (hs.mpr h))] + · have hz := (hzero t (by simpa only [not_and_or, not_lt] using ht)).2 + simp only [indicator, hz, ite_self] + rw [hpositive, hnegative, ← integral_indicator hset, he, + integral_indicator measurableSet_Ioo, ← integral_Ioc_eq_integral_Ioo, + ← intervalIntegral.integral_of_le hLU.le] + exact intervalIntegral.integral_eq_sub_of_hasDerivAt (fun t _ => hg t) + (hg'.intervalIntegrable L U) + · have hempty : {t : ℝ | ∀ i, t * a i < b i} = ∅ := by + ext t + exact iff_false_intro (fun ht => hnonempty ⟨t, ht⟩) + have hfacezero (i : ι) (hi : a i ≠ 0) : halfspaceFaceValue a b g i = 0 := by + unfold halfspaceFaceValue + split_ifs with hf + · exact False.elim (hnonempty (exists_strict_halfspace_of_face a b i hi hf)) + · rfl + have hpos : (∑ i : ι, if 0 < a i then halfspaceFaceValue a b g i else 0) = 0 := by + apply Finset.sum_eq_zero + intro i _ + split_ifs with hi + · exact hfacezero i hi.ne' + · rfl + have hneg : (∑ i : ι, if a i < 0 then halfspaceFaceValue a b g i else 0) = 0 := by + apply Finset.sum_eq_zero + intro i _ + split_ifs with hi + · exact hfacezero i hi.ne + · rfl + rw [hempty, setIntegral_empty, hpos, hneg, sub_self] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SlicingScalarBoundary.lean b/LeanPool/LiebThirring/Electrostatics/SlicingScalarBoundary.lean new file mode 100644 index 0000000000..2671318457 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SlicingScalarBoundary.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.SlicingIntervals + +/-! +# Genuine endpoints of a finite halfspace slice + +The scalar boundary bookkeeping for the cell divergence theorem: a finite +endpoint is either an artificial outer endpoint, where the compact field +vanishes, or the unique genuine facet having the appropriate orientation. +-/ + +public section + +namespace LiebThirring + +/-- The value of a scalar field at a genuine transverse constraint endpoint. -/ +@[expose] noncomputable def halfspaceFaceValue {ι : Type*} + (a b : ι → ℝ) (g : ℝ → ℝ) (i : ι) : ℝ := by + classical + exact if ∀ j, j ≠ i → (b i / a i) * a j < b j then g (b i / a i) else 0 + +/-- Positive-oriented genuine facets give precisely the value at the upper end. -/ +theorem sum_positive_halfspaceFaceValue {ι : Type*} [Fintype ι] + (a b : ι → ℝ) (g : ℝ → ℝ) (U B : ℝ) + (hmin : ∀ i, 0 < a i → U ≤ b i / a i) + (hclosed : ∀ i, U * a i ≤ b i) + (hregular : ∀ i j, i ≠ j → U * a i = b i → U * a j = b j → False) + (hupper : U = B ∨ ∃ i, 0 < a i ∧ U = b i / a i) + (hzero : ∀ t, B ≤ t → g t = 0) : + (∑ i : ι, if 0 < a i then halfspaceFaceValue a b g i else 0) = g U := by + classical + rcases hupper with he | ⟨i, hi, he⟩ + · rw [he, hzero B le_rfl] + apply Finset.sum_eq_zero + intro i _ + by_cases hi : 0 < a i + · rw [ite_eq_left hi] + unfold halfspaceFaceValue + split_ifs with hf + · exact hzero _ (he ▸ hmin i hi) + · rfl + · exact ite_eq_right hi + · have hei : U * a i = b i := by rw [he, div_mul_cancel₀ _ hi.ne'] + have hface : ∀ j, j ≠ i → U * a j < b j := by + intro j hj + apply lt_of_le_of_ne (hclosed j) + intro hej + exact hregular i j hj.symm hei hej + have hs : (∑ j : ι, if 0 < a j then halfspaceFaceValue a b g j else 0) = + (if 0 < a i then halfspaceFaceValue a b g i else 0) := by + apply Finset.sum_eq_single i + · intro j _ hj + by_cases hjpos : 0 < a j + · rw [ite_eq_left hjpos] + unfold halfspaceFaceValue + split_ifs with hjface + · have hlt : b j / a j < U := by + rw [he] + exact (lt_div_iff₀ hi).mpr (hjface i hj.symm) + exact False.elim (not_lt_of_ge (hmin j hjpos) hlt) + · rfl + · exact ite_eq_right hjpos + · intro hnot + exact False.elim (hnot (Finset.mem_univ i)) + rw [hs, ite_eq_left hi, halfspaceFaceValue] + rw [ite_eq_left (he ▸ hface)] + rw [← he] + +theorem halfspaceFaceValue_reflect {ι : Type*} (a b : ι → ℝ) (g : ℝ → ℝ) (i : ι) : + halfspaceFaceValue (fun i => -a i) b (fun t => g (-t)) i = + halfspaceFaceValue a b g i := by + unfold halfspaceFaceValue + dsimp only + have he : (∀ j, j ≠ i → (b i / -a i) * (-a j) < b j) ↔ + (∀ j, j ≠ i → (b i / a i) * a j < b j) := by + apply forall_congr' + intro j + rw [div_neg, neg_mul_neg] + simp only [div_neg, neg_neg] + by_cases hf : ∀ j, j ≠ i → (b i / a i) * a j < b j + · rw [ite_eq_left (he.mpr hf), ite_eq_left hf] + · rw [ite_eq_right (fun hn => hf (he.mp hn)), ite_eq_right hf] + +/-- Negative-oriented genuine facets give precisely the value at the lower end. -/ +theorem sum_negative_halfspaceFaceValue {ι : Type*} [Fintype ι] + (a b : ι → ℝ) (g : ℝ → ℝ) (L A : ℝ) + (hmax : ∀ i, a i < 0 → b i / a i ≤ L) + (hclosed : ∀ i, L * a i ≤ b i) + (hregular : ∀ i j, i ≠ j → L * a i = b i → L * a j = b j → False) + (hlower : L = A ∨ ∃ i, a i < 0 ∧ L = b i / a i) + (hzero : ∀ t, t ≤ A → g t = 0) : + (∑ i : ι, if a i < 0 then halfspaceFaceValue a b g i else 0) = g L := by + have hmin' (i : ι) (hi : 0 < -a i) : -L ≤ b i / -a i := by + rw [div_neg] + exact neg_le_neg (hmax i (neg_pos.mp hi)) + have hclosed' (i : ι) : (-L) * (-a i) ≤ b i := by simpa only [neg_mul_neg] using hclosed i + have hreg' (i j : ι) (hij : i ≠ j) (hi : (-L) * (-a i) = b i) + (hj : (-L) * (-a j) = b j) : False := + hregular i j hij (by simpa only [neg_mul_neg] using hi) (by simpa only [neg_mul_neg] using hj) + have hupper' : -L = -A ∨ ∃ i, 0 < -a i ∧ -L = b i / -a i := by + rcases hlower with he | ⟨i, hi, he⟩ + · exact Or.inl (congrArg Neg.neg he) + · exact Or.inr ⟨i, neg_pos.mpr hi, by rw [he, div_neg]⟩ + have hzero' (t : ℝ) (ht : -A ≤ t) : g (-t) = 0 := hzero _ (by linarith only [ht]) + have hh := sum_positive_halfspaceFaceValue (fun i => -a i) b (fun t => g (-t)) + (-L) (-A) hmin' hclosed' hreg' hupper' hzero' + simpa only [neg_pos, halfspaceFaceValue_reflect, neg_neg] using hh + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SlicingScreenedCells.lean b/LeanPool/LiebThirring/Electrostatics/SlicingScreenedCells.lean new file mode 100644 index 0000000000..6a541b783f --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SlicingScreenedCells.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.SlicingGreen +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityExtension +public import LeanPool.LiebThirring.Electrostatics.SlicingJump + +/-! +# The screened Green identity in each cell + +The globally smooth extension agrees with the Coulomb representative near +its closed cell. Green's second identity therefore applies without any +singular field or unproved trace assumption. +-/ + +public section + +open Set MeasureTheory InnerProductSpace Laplacian +open scoped NNReal ContDiff + +namespace LiebThirring + +/-- The screened-potential boundary contribution of a Voronoi cell in Green’s identity. -/ +@[expose] noncomputable def screenedCellBoundaryTerm {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (k l : Fin M) (f : Position → ℝ) (x : Position) : ℝ := + screenedCellPotential Z R k x * fderiv ℝ f x (bisectorNormal R k l) - + f x * fderiv ℝ (screenedCellPotential Z R k) x (bisectorNormal R k l) + +theorem sum_slicingGreenComponent (g f : Position → ℝ) (n x : Position) : + (∑ a : Fin 3, n a * slicingGreenComponent g f a x) = + g x * fderiv ℝ f x n - f x * fderiv ℝ g x n := by + unfold slicingGreenComponent + have h₁ := sum_position_rankOne (fderiv ℝ f x) n + have h₂ := sum_position_rankOne (fderiv ℝ g x) n + calc + _ = g x * (∑ a : Fin 3, fderiv ℝ f x (EuclideanSpace.basisFun (Fin 3) ℝ a) * n a) - + f x * (∑ a : Fin 3, fderiv ℝ g x (EuclideanSpace.basisFun (Fin 3) ℝ a) * n a) := by + simp only [Finset.mul_sum, mul_sub, Finset.sum_sub_distrib] + congr 1 <;> apply Finset.sum_congr rfl <;> intro a _ <;> ring + _ = _ := by rw [h₁, h₂] + +theorem integrableOn_screenedCellBoundaryTerm {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) (k l : Fin M) (hkl : k ≠ l) + (f : Position → ℝ) (hf : ContDiff ℝ 2 f) (hfc : HasCompactSupport f) : + IntegrableOn (screenedCellBoundaryTerm Z R k l f) (voronoiFace R k l) + (bisectorSurfaceMeasure R hR k l hkl) := by + classical + let g := screenedCellSmooth Z R hR k + have hg : ContDiff ℝ 2 g := (contDiff_screenedCellSmooth Z R hR k).of_le (by simp) + have hi : IntegrableOn (fun x => ∑ a : Fin 3, + bisectorNormal R k l a * slicingGreenComponent g f a x) (voronoiFace R k l) + (bisectorSurfaceMeasure R hR k l hkl) := by + apply integrable_finsetSum + intro a _ + exact ((integrable_compact_bisectorSurfaceMeasure R hR k l hkl _ + (contDiff_slicingGreenComponent hg hf a).continuous + (hasCompactSupport_slicingGreenComponent hfc a)).const_mul _).integrableOn + apply hi.congr_fun _ (measurableSet_voronoiFace R k l) + intro x hx + have he := eventuallyEq_screenedCellSmooth Z R hR k (voronoiFace_subset_closed R k l hx) + dsimp only + rw [sum_slicingGreenComponent g f (bisectorNormal R k l) x] + dsimp only [g] + rw [he.eq_of_nhds, he.fderiv_eq] + rfl + +/-- The harmonic bulk term vanishes; only the directed screened face term remains. -/ +theorem integral_screenedPotentialReal_laplacian_voronoiCell {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) (k : Fin M) + (f : Position → ℝ) (hf : ContDiff ℝ 2 f) (hfc : HasCompactSupport f) : + (∫ x in voronoiCell R k, screenedPotentialReal Z R x * Δ f x) = + ∑ l : {l : Fin M // l ≠ k}, ∫ x in voronoiFace R k l.val, + screenedCellBoundaryTerm Z R k l.val f x + ∂bisectorSurfaceMeasure R hR k l.val l.property.symm := by + classical + let g := screenedCellSmooth Z R hR k + have hg : ContDiff ℝ 2 g := (contDiff_screenedCellSmooth Z R hR k).of_le (by simp) + have he := voronoiCell_compact_green R hR k g f hg hf hfc + have hleft : (∫ x in voronoiCell R k, g x * Δ f x - f x * Δ g x) = + ∫ x in voronoiCell R k, screenedPotentialReal Z R x * Δ f x := by + apply setIntegral_congr_fun (isOpen_voronoiCell R k).measurableSet + intro x hx + have hc := voronoiCell_subset_closed R k hx + have hs := eventuallyEq_screenedCellSmooth Z R hR k hc + have hharm := (harmonicAt_screenedCellPotential Z R hR k hc).2 + dsimp only [g] + rw [(laplacian_congr_nhds hs).eq_of_nhds, hharm.eq_of_nhds, Pi.zero_apply, mul_zero, sub_zero, + hs.eq_of_nhds, + ← screenedPotentialReal_eq_screenedCellPotential Z R hR k hc] + rw [hleft] at he + apply he.trans + apply Finset.sum_congr rfl + intro l _ + apply setIntegral_congr_fun (measurableSet_voronoiFace R k l.val) + intro x hx + have hs := eventuallyEq_screenedCellSmooth Z R hR k (voronoiFace_subset_closed R k l.val hx) + dsimp only + rw [sum_slicingGreenComponent g f (bisectorNormal R k l.val) x] + dsimp only [g] + rw [hs.eq_of_nhds, hs.fderiv_eq] + rfl + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SlicingScreenedFaces.lean b/LeanPool/LiebThirring/Electrostatics/SlicingScreenedFaces.lean new file mode 100644 index 0000000000..ff49ca3648 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SlicingScreenedFaces.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.SlicingScreenedCells +import all LeanPool.LiebThirring.Electrostatics.FaceMeasureGeometry +import all LeanPool.LiebThirring.Electrostatics.FaceMeasureBasic + +/-! +# Cancellation of the directed screened face terms + +Pairing the two cell orientations cancels the common potential trace and +leaves the normal derivative jump, with coefficient exactly minus 4 pi +times the landed face density. +-/ + +public section + +open Set MeasureTheory +open scoped NNReal RealInnerProductSpace + +namespace LiebThirring + +theorem bisectorNormal_reverse {M : ℕ} (R : Fin M → Position) (k l : Fin M) : + bisectorNormal R l k = -bisectorNormal R k l := by + unfold bisectorNormal + rw [norm_sub_rev (R k) (R l), ← neg_sub (R l) (R k), smul_neg] + +theorem screenedCellBoundaryTerm_pair {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) (k l : Fin M) + (f : Position → ℝ) {x : Position} (hx : x ∈ voronoiFace R k l) : + screenedCellBoundaryTerm Z R k l f x + screenedCellBoundaryTerm Z R l k f x = + -4 * Real.pi * nuclearFaceDensity R (Z : ℝ) k l x * f x := by + have hx' : x ∈ voronoiFace R l k := (voronoiFace_comm R k l) ▸ hx + have hk := screenedPotentialReal_eq_screenedCellPotential Z R hR k + (voronoiFace_subset_closed R k l hx) + have hl := screenedPotentialReal_eq_screenedCellPotential Z R hR l + (voronoiFace_subset_closed R l k hx') + have hj := fderiv_screenedCellPotential_jump Z R hR k l hx (bisectorNormal R k l) + have hi : inner ℝ (bisectorNormal R k l) (bisectorNormal R k l) = 1 := by + rw [real_inner_self_eq_norm_sq, norm_bisectorNormal R hR hx.1, one_pow] + rw [hi, mul_one] at hj + unfold screenedCellBoundaryTerm + rw [bisectorNormal_reverse R k l, map_neg, map_neg, ← hk, ← hl] + calc + _ = f x * (fderiv ℝ (screenedCellPotential Z R l) x (bisectorNormal R k l) - + fderiv ℝ (screenedCellPotential Z R k) x (bisectorNormal R k l)) := by ring + _ = _ := by + rw [hj, nuclearFaceDensity, nuclearHalfDistance] + field_simp + ring + +theorem integral_screenedCellBoundaryTerm_pair {M : ℕ} (Z : ℝ≥0) + (R : Fin M → Position) (hR : Function.Injective R) (k l : Fin M) (hkl : k ≠ l) + (f : Position → ℝ) (hf : ContDiff ℝ 2 f) (hfc : HasCompactSupport f) : + (∫ x in voronoiFace R k l, screenedCellBoundaryTerm Z R k l f x + ∂bisectorSurfaceMeasure R hR k l hkl) + + (∫ x in voronoiFace R l k, screenedCellBoundaryTerm Z R l k f x + ∂bisectorSurfaceMeasure R hR l k hkl.symm) = + -4 * Real.pi * ∫ x in voronoiFace R k l, + nuclearFaceDensity R (Z : ℝ) k l x * f x ∂bisectorSurfaceMeasure R hR k l hkl := by + have hleft := integrableOn_screenedCellBoundaryTerm Z R hR k l hkl f hf hfc + have hright := integrableOn_screenedCellBoundaryTerm Z R hR l k hkl.symm f hf hfc + rw [← voronoiFace_comm R k l, ← bisectorSurfaceMeasure_comm R hR k l hkl] at hright ⊢ + rw [← integral_add hleft hright, ← integral_const_mul] + apply setIntegral_congr_fun (measurableSet_voronoiFace R k l) + intro x hx + simpa only [mul_assoc] using screenedCellBoundaryTerm_pair Z R hR k l f hx + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/Sphere.lean b/LeanPool/LiebThirring/Electrostatics/Sphere.lean new file mode 100644 index 0000000000..1031a55fa1 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/Sphere.lean @@ -0,0 +1,118 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.Configuration +public import Mathlib.MeasureTheory.Constructions.HaarToSphere +public import Mathlib.MeasureTheory.Measure.Support +import Mathlib.MeasureTheory.Measure.Lebesgue.VolumeOfBalls + +/-! +# Uniform Euclidean spherical shells + +Normalized sphere measure and spherical shell charges on `Position`. +-/ + +public section + +open MeasureTheory Set Metric +open scoped ENNReal Pointwise + +namespace LiebThirring + +/-- Uniform probability measure on the physical Euclidean unit sphere. -/ +@[expose] noncomputable def unitSphereMeasure : Measure (sphere (0 : Position) 1) := + ((volume : Measure Position).toSphere univ)⁻¹ • (volume : Measure Position).toSphere + +instance instIsProbabilityMeasureUnitSphereMeasure : IsProbabilityMeasure unitSphereMeasure := by + let : NeZero (volume : Measure Position).toSphere := + ⟨Measure.toSphere_ne_zero volume⟩ + unfold unitSphereMeasure + infer_instance + +/-- The pushforward of uniform unit-sphere probability by `ω ↦ a + r • ω`. -/ +@[expose] noncomputable def shell (a : Position) (r : ℝ) : Measure Position := + unitSphereMeasure.map (fun ω : sphere (0 : Position) 1 => a + r • (ω : Position)) + +theorem measurable_shellMap (a : Position) (r : ℝ) : + Measurable (fun ω : sphere (0 : Position) 1 => a + r • (ω : Position)) := + measurable_const.add (measurable_subtype_coe.const_smul r) + +instance instIsProbabilityMeasureShell (a : Position) (r : ℝ) : IsProbabilityMeasure (shell a r) := + by + unfold shell + infer_instance + +theorem ae_shell_norm (a : Position) {r : ℝ} (hr : 0 ≤ r) : + ∀ᵐ y ∂shell a r, ‖y - a‖ = r := by + unfold shell + apply (ae_map_iff (measurable_shellMap a r).aemeasurable + (show MeasurableSet {y : Position | ‖y - a‖ = r} from + (isClosed_eq (continuous_norm.comp (continuous_id.sub continuous_const)) + continuous_const).measurableSet)).2 + apply Filter.Eventually.of_forall + intro ω + have hω : ‖(ω : Position)‖ = 1 := by simpa only [mem_sphere_zero_iff_norm] using ω.property + simp only [add_sub_cancel_left, norm_smul, Real.norm_eq_abs, abs_of_nonneg hr, hω, mul_one] + +/-- The Euclidean unit sphere has area `4π` in Mathlib's cone normalization. -/ +theorem sphere_area : (volume : Measure Position).toSphere univ = ENNReal.ofReal (4 * Real.pi) := by + rw [Measure.toSphere_apply_univ] + simp only [Position, finrank_euclideanSpace_fin, EuclideanSpace.volume_ball_fin_three, + ENNReal.ofReal_one, one_pow, one_mul] + rw [← ENNReal.ofReal_natCast] + norm_num only [Nat.cast_ofNat] + rw [← ENNReal.ofReal_mul (by norm_num : (0 : ℝ) ≤ 3)] + congr 1 + ring + +/-- The restriction of a linear isometry to the unit sphere. -/ +@[expose] def unitSphereRotation (Q : Position ≃ₗᵢ[ℝ] Position) + (ω : sphere (0 : Position) 1) : sphere (0 : Position) 1 := + ⟨Q ω, by simpa only [mem_sphere_zero_iff_norm, Q.norm_map] using ω.property⟩ + +theorem measurable_unitSphereRotation (Q : Position ≃ₗᵢ[ℝ] Position) : + Measurable (unitSphereRotation Q) := + (Q.continuous.measurable.comp measurable_subtype_coe).subtype_mk + +theorem map_toSphere_unitSphereRotation (Q : Position ≃ₗᵢ[ℝ] Position) : + (volume : Measure Position).toSphere.map (unitSphereRotation Q) = + (volume : Measure Position).toSphere := by + apply Measure.ext + intro s hs + rw [Measure.map_apply (measurable_unitSphereRotation Q) hs, + Measure.toSphere_apply' _ (hs.preimage (measurable_unitSphereRotation Q)), + Measure.toSphere_apply' _ hs] + congr 1 + have hsector : Ioo (0 : ℝ) 1 • (Subtype.val '' (unitSphereRotation Q ⁻¹' s)) = + Q ⁻¹' (Ioo (0 : ℝ) 1 • (Subtype.val '' s)) := by + ext x + constructor + · rintro ⟨t, ht, z, ⟨ω, hω, rfl⟩, rfl⟩ + exact ⟨t, ht, Q ω, ⟨unitSphereRotation Q ω, hω, rfl⟩, (Q.map_smul t ω).symm⟩ + · rintro ⟨t, ht, z, ⟨ω, hω, rfl⟩, hx⟩ + refine ⟨t, ht, Q.symm ω, ⟨unitSphereRotation Q.symm ω, ?_, rfl⟩, ?_⟩ + · change unitSphereRotation Q (unitSphereRotation Q.symm ω) ∈ s + have heq : unitSphereRotation Q (unitSphereRotation Q.symm ω) = ω := + Subtype.ext (Q.apply_symm_apply ω) + rw [heq] + exact hω + · apply Q.injective + simpa only [Q.map_smul, Q.apply_symm_apply] using hx + rw [hsector] + exact Q.measurePreserving.measure_preimage_emb Q.toHomeomorph.measurableEmbedding _ + +theorem map_unitSphereMeasure_rotation (Q : Position ≃ₗᵢ[ℝ] Position) : + unitSphereMeasure.map (unitSphereRotation Q) = unitSphereMeasure := by + rw [unitSphereMeasure, Measure.map_smul, map_toSphere_unitSphereRotation] + exact (measurable_unitSphereRotation Q).aemeasurable + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SphereAngular.lean b/LeanPool/LiebThirring/Electrostatics/SphereAngular.lean new file mode 100644 index 0000000000..b2e865699f --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SphereAngular.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.Sphere +import LeanPool.LiebThirring.Electrostatics.SphereCap +import LeanPool.LiebThirring.Electrostatics.SphereRealMarginal +/-! +# Archimedes' angular marginal + +The height coordinate of uniform sphere probability is uniform on `[-1,1]`. + +Archimedes' hat-box identity for every Euclidean unit direction. +-/ + +public section + +open MeasureTheory Set Metric WithLp +open scoped ENNReal Pointwise +namespace LiebThirring + +/-- The height coordinate of uniform sphere probability is uniform on `[-1,1]`. -/ +theorem sphereHeight_uniform : + unitSphereMeasure.map (fun ω : sphere (0 : Position) 1 => (ω : Position) 2) = + (ENNReal.ofReal 2)⁻¹ • (volume : Measure ℝ).restrict (Icc (-1) 1) := by + exact eq_uniform_interval_of_symmetric_positive_tails _ sphereHeight_neg_invariant + (fun t ht => sphereHeight_Ioi ht) + +/-- Archimedes' hat-box identity for every Euclidean unit direction. -/ +theorem unitSphereMeasure_inner_uniform (e : Position) (he : ‖e‖ = 1) : + unitSphereMeasure.map (fun ω : sphere (0 : Position) 1 => inner ℝ (ω : Position) e) = + (ENNReal.ofReal 2)⁻¹ • (volume : Measure ℝ).restrict (Icc (-1) 1) := by + let v : Position := EuclideanSpace.single 2 1 + have hv : ‖v‖ = 1 := by simp [v, EuclideanSpace.single, PiLp.norm_single] + let Q : Position ≃ₗᵢ[ℝ] Position := (Submodule.span ℝ {v - e})ᗮ.reflection + have hQ : Q v = e := Submodule.reflection_sub (hv.trans he.symm) + have hm : Measurable (fun ω : sphere (0 : Position) 1 => inner ℝ (ω : Position) e) := + (continuous_subtype_val.inner continuous_const).measurable + have hc : (fun ω : sphere (0 : Position) 1 => inner ℝ (ω : Position) e) ∘ unitSphereRotation Q = + (fun ω : sphere (0 : Position) 1 => (ω : Position) 2) := by + funext ω + change inner ℝ (Q (ω : Position)) e = _ + rw [← hQ, Q.inner_map_map] + simp only [v, EuclideanSpace.inner_single_right, RCLike.conj_to_real, one_mul] + calc + _ = (unitSphereMeasure.map (unitSphereRotation Q)).map + (fun ω : sphere (0 : Position) 1 => inner ℝ (ω : Position) e) := by + rw [map_unitSphereMeasure_rotation] + _ = _ := by + rw [Measure.map_map hm (measurable_unitSphereRotation Q), hc, sphereHeight_uniform] +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SphereCap.lean b/LeanPool/LiebThirring/Electrostatics/SphereCap.lean new file mode 100644 index 0000000000..1e408f34c6 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SphereCap.lean @@ -0,0 +1,311 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.Sphere +public import Mathlib.MeasureTheory.Measure.Lebesgue.VolumeOfBalls +/-! +# Euclidean cap volumes + +Volume coordinates separating height `x 2` from the horizontal Euclidean plane. + +The open unit cone selected by the height-to-radius threshold `t`. +-/ + +public section + +open MeasureTheory Set Metric WithLp intervalIntegral +open scoped ENNReal Pointwise +namespace LiebThirring + +/-- Volume coordinates separating height `x 2` from the horizontal Euclidean plane. -/ +@[expose] noncomputable def sphereHeightSplit : Position ≃ᵐ ℝ × EuclideanSpace ℝ (Fin 2) := + (MeasurableEquiv.toLp 2 (Fin 3 → ℝ)).symm.trans + ((MeasurableEquiv.piFinSuccAbove (fun _ : Fin 3 => ℝ) 2).trans + (MeasurableEquiv.prodCongr (MeasurableEquiv.refl ℝ) + (MeasurableEquiv.toLp 2 (Fin 2 → ℝ)))) + +theorem sphereHeightSplit_preserving : MeasurePreserving sphereHeightSplit := by + exact (EuclideanSpace.volume_preserving_symm_measurableEquiv_toLp (Fin 3)).trans + ((volume_preserving_piFinSuccAbove (fun _ : Fin 3 => ℝ) 2).trans + ((MeasurePreserving.id volume).prod + (EuclideanSpace.volume_preserving_symm_measurableEquiv_toLp (Fin 2)).symm)) + +theorem sphereHeightSplit_fst (x : Position) : (sphereHeightSplit x).1 = x 2 := rfl + +theorem sphereHeightSplit_norm (x : Position) : + ‖x‖ ^ 2 = (sphereHeightSplit x).1 ^ 2 + ‖(sphereHeightSplit x).2‖ ^ 2 := by + simp only [EuclideanSpace.real_norm_sq_eq, Fin.sum_univ_succ] + change x 0 ^ 2 + (x 1 ^ 2 + (x 2 ^ 2 + 0)) = + x 2 ^ 2 + (x 0 ^ 2 + (x 1 ^ 2 + 0)) + ring + +theorem height_sub_one (x : Position) (hx : ‖x‖ < 1) : x 2 < 1 := by + have hb := PiLp.norm_apply_le x 2 + exact (le_abs_self _).trans_lt (hb.trans_lt hx) + +-- Real core: slice below the cone slope. +theorem cap_slice_low {t s q n : ℝ} (ht : 0 < t) (ht1 : t < 1) + (hs : 0 < s) (hst : s ≤ t) (hq : 0 ≤ q) (hn : 0 ≤ n) + (hn2 : n ^ 2 = s ^ 2 + q ^ 2) : + (n < 1 ∧ t * n < s) ↔ q < s * Real.sqrt (1 - t ^ 2) / t := by + have ht2 : 0 ≤ 1 - t ^ 2 := by nlinarith + have ha : 0 ≤ Real.sqrt (1 - t ^ 2) := Real.sqrt_nonneg _ + have ha2 : (Real.sqrt (1 - t ^ 2)) ^ 2 = 1 - t ^ 2 := Real.sq_sqrt ht2 + have hc : 0 ≤ s * Real.sqrt (1 - t ^ 2) / t := by positivity + have hnum : (s * Real.sqrt (1 - t ^ 2)) ^ 2 = s ^ 2 * (1 - t ^ 2) := by + rw [mul_pow, ha2] + have hscaled := congrArg (fun z : ℝ => t ^ 2 * z) hn2 + rw [← sq_lt_sq₀ hq hc, div_pow, lt_div_iff₀ (sq_pos_of_pos ht)] + constructor + · rintro ⟨_, hc⟩ + have hcs : (t * n) ^ 2 < s ^ 2 := (sq_lt_sq₀ (mul_nonneg ht.le hn) hs.le).mpr hc + nlinarith only [hcs, hscaled, hnum] + · intro hc + have hcs : (t * n) ^ 2 < s ^ 2 := by nlinarith only [hc, hscaled, hnum] + have hcone := (sq_lt_sq₀ (mul_nonneg ht.le hn) hs.le).mp hcs + have hn1 : n < 1 := (mul_lt_mul_iff_right₀ ht).mp (by + simpa only [mul_one] using hcone.trans_le hst) + exact ⟨hn1, hcone⟩ + +theorem cap_slice_high {t s q n : ℝ} (ht : 0 < t) (hst : t ≤ s) (hs1 : s < 1) + (hq : 0 ≤ q) (hn : 0 ≤ n) (hn2 : n ^ 2 = s ^ 2 + q ^ 2) : + (n < 1 ∧ t * n < s) ↔ q < Real.sqrt (1 - s ^ 2) := by + have hs : 0 < s := ht.trans_le hst + have hs2 : 0 ≤ 1 - s ^ 2 := by nlinarith only [hs, hs1] + rw [← sq_lt_sq₀ hq (Real.sqrt_nonneg _), Real.sq_sqrt hs2] + constructor + · rintro ⟨hn1, _⟩ + have hns : n ^ 2 < 1 := by simpa using (sq_lt_sq₀ hn zero_le_one).mpr hn1 + linarith only [hns, hn2] + · intro hq2 + have hn1 : n < 1 := (sq_lt_sq₀ hn zero_le_one).mp (by nlinarith only [hq2, hn2]) + have hprod : t * n < t := by simpa only [mul_one] using mul_lt_mul_of_pos_left hn1 ht + have hcone : t * n < s := hprod.trans_le hst + exact ⟨hn1, hcone⟩ + +/-- The open unit cone selected by the height-to-radius threshold `t`. -/ +@[expose] def sphereCone (t : ℝ) : Set Position := {x | ‖x‖ < 1 ∧ t * ‖x‖ < x 2} + +theorem measurableSet_sphereCone (t : ℝ) : MeasurableSet (sphereCone t) := by + apply MeasurableSet.inter + · exact isOpen_lt continuous_norm continuous_const |>.measurableSet + · exact isOpen_lt (continuous_const.mul continuous_norm) (PiLp.continuous_apply 2 (fun _ : Fin 3 + => ℝ) 2) |>.measurableSet + +theorem cap_cone_eq (t : ℝ) : + Ioo (0 : ℝ) 1 • (Subtype.val '' {ω : sphere (0 : Position) 1 | t < (ω : Position) 2}) = + sphereCone t := by + ext x + constructor + · rintro ⟨s, hs, z, ⟨ω, hω, rfl⟩, rfl⟩ + have hnorm : ‖(ω : Position)‖ = 1 := mem_sphere_zero_iff_norm.mp ω.property + change ‖s • (ω : Position)‖ < 1 ∧ t * ‖s • (ω : Position)‖ < (s • (ω : Position)) 2 + simp only [norm_smul, Real.norm_eq_abs, abs_of_pos hs.1, hnorm, mul_one, PiLp.smul_apply, + smul_eq_mul] + exact ⟨hs.2, by simpa only [mul_comm t s] using mul_lt_mul_of_pos_left hω hs.1⟩ + · intro hx + have hpos : 0 < ‖x‖ := by + apply norm_pos_iff.mpr + intro heq + simp only [sphereCone, mem_ofPred_eq, heq, norm_zero, mul_zero, PiLp.zero_apply, + lt_self_iff_false, + and_false] at hx + refine ⟨‖x‖, ⟨hpos, hx.1⟩, ‖x‖⁻¹ • x, ?_, ?_⟩ + · refine ⟨⟨‖x‖⁻¹ • x, ?_⟩, ?_, rfl⟩ + · rw [mem_sphere_zero_iff_norm, norm_smul, Real.norm_eq_abs, + abs_of_pos (inv_pos.mpr hpos), inv_mul_cancel₀ hpos.ne'] + · change t < (‖x‖⁻¹ • x) 2 + simp only [PiLp.smul_apply, smul_eq_mul] + rw [inv_mul_eq_div, lt_div_iff₀ hpos] + exact hx.2 + · change ‖x‖ • (‖x‖⁻¹ • x) = x + rw [smul_smul, mul_inv_cancel₀ hpos.ne', one_smul] +theorem cone_slice_eq_disk_low {t s : ℝ} (ht : 0 < t) (ht1 : t < 1) + (hs : 0 < s) (hst : s ≤ t) : + (fun y : EuclideanSpace ℝ (Fin 2) => sphereHeightSplit.symm (s,y)) ⁻¹' sphereCone t = + ball 0 (s * Real.sqrt (1 - t ^ 2) / t) := by + ext y + have hx := sphereHeightSplit_norm (sphereHeightSplit.symm (s,y)) + rw [sphereHeightSplit.apply_symm_apply] at hx + have hh : (sphereHeightSplit.symm (s,y)) 2 = s := by + rw [← sphereHeightSplit_fst, sphereHeightSplit.apply_symm_apply] + simp only [sphereCone, mem_preimage, mem_ofPred_eq, hh, mem_ball_zero_iff] + exact cap_slice_low ht ht1 hs hst (norm_nonneg y) (norm_nonneg _) hx + +theorem cone_slice_eq_disk_high {t s : ℝ} (ht : 0 < t) (hst : t ≤ s) (hs1 : s < 1) : + (fun y : EuclideanSpace ℝ (Fin 2) => sphereHeightSplit.symm (s,y)) ⁻¹' sphereCone t = + ball 0 (Real.sqrt (1 - s ^ 2)) := by + ext y + have hx := sphereHeightSplit_norm (sphereHeightSplit.symm (s,y)) + rw [sphereHeightSplit.apply_symm_apply] at hx + have hh : (sphereHeightSplit.symm (s,y)) 2 = s := by + rw [← sphereHeightSplit_fst, sphereHeightSplit.apply_symm_apply] + simp only [sphereCone, mem_preimage, mem_ofPred_eq, hh, mem_ball_zero_iff] + exact cap_slice_high ht hst hs1 (norm_nonneg y) (norm_nonneg _) hx + +theorem cone_slice_empty {t s : ℝ} (ht : 0 ≤ t) (hs : s ≤ 0 ∨ 1 ≤ s) : + (fun y : EuclideanSpace ℝ (Fin 2) => sphereHeightSplit.symm (s,y)) ⁻¹' sphereCone t = ∅ := by + apply Set.eq_empty_iff_forall_notMem.mpr + intro y hy + have hh : (sphereHeightSplit.symm (s,y)) 2 = s := by + rw [← sphereHeightSplit_fst, sphereHeightSplit.apply_symm_apply] + change ‖sphereHeightSplit.symm (s,y)‖ < 1 ∧ t * ‖sphereHeightSplit.symm (s,y)‖ < s at hy + rcases hs with hs | hs + · exact (not_lt_of_ge hs) ((mul_nonneg ht (norm_nonneg _)).trans_lt hy.2) + · have hheight := height_sub_one (sphereHeightSplit.symm (s,y)) hy.1 + rw [hh] at hheight + exact (not_lt_of_ge hs) hheight +theorem cone_slice_area {t : ℝ} (ht : 0 < t) (ht1 : t < 1) (s : ℝ) : + (volume : Measure (EuclideanSpace ℝ (Fin 2))) + ((fun y => sphereHeightSplit.symm (s,y)) ⁻¹' sphereCone t) = + (Ioo 0 t).indicator (fun s : ℝ => ENNReal.ofReal (Real.pi * ((1 - t ^ 2) / t ^ 2) * s ^ 2)) s + + + (Ico t 1).indicator (fun s : ℝ => ENNReal.ofReal (Real.pi * (1 - s ^ 2))) s := by + by_cases hs0 : 0 < s + · by_cases hs1 : s < 1 + · by_cases hst : s < t + · rw [cone_slice_eq_disk_low ht ht1 hs0 hst.le, EuclideanSpace.volume_ball_fin_two] + have ht2 : 0 ≤ 1 - t ^ 2 := by nlinarith only [ht, ht1] + have hc : 0 ≤ s * Real.sqrt (1 - t ^ 2) / t := by positivity + have heq : (s * Real.sqrt (1 - t ^ 2) / t) ^ 2 * Real.pi = + Real.pi * ((1 - t ^ 2) / t ^ 2) * s ^ 2 := by + rw [div_pow, mul_pow, Real.sq_sqrt ht2] + ring + simp only [Set.indicator_of_mem (show s ∈ Ioo 0 t from ⟨hs0,hst⟩), + Set.indicator_of_notMem (show s ∉ Ico t 1 from fun h => not_le_of_gt hst h.1), add_zero] + rw [← ENNReal.ofReal_pow hc, ← ENNReal.ofReal_mul (sq_nonneg _), heq] + · rw [cone_slice_eq_disk_high ht (le_of_not_gt hst) hs1, EuclideanSpace.volume_ball_fin_two] + have hs2 : 0 ≤ 1 - s ^ 2 := by nlinarith only [hs0,hs1] + simp only [Set.indicator_of_notMem (show s ∉ Ioo 0 t from fun h => hst h.2), + Set.indicator_of_mem (show s ∈ Ico t 1 from ⟨le_of_not_gt hst,hs1⟩), zero_add] + rw [← ENNReal.ofReal_pow (Real.sqrt_nonneg _), Real.sq_sqrt hs2, + ← ENNReal.ofReal_mul hs2, mul_comm] + · rw [cone_slice_empty ht.le (Or.inr (le_of_not_gt hs1)), measure_empty] + simp only [Set.indicator_of_notMem (show s ∉ Ioo 0 t from fun h => hs1 (h.2.trans ht1)), + Set.indicator_of_notMem (show s ∉ Ico t 1 from fun h => hs1 h.2), add_zero] + · rw [cone_slice_empty ht.le (Or.inl (le_of_not_gt hs0)), measure_empty] + simp only [Set.indicator_of_notMem (show s ∉ Ioo 0 t from fun h => hs0 h.1), + Set.indicator_of_notMem (show s ∉ Ico t 1 from fun h => hs0 (ht.trans_le h.1)), add_zero] + +theorem lintegral_sq_Ioo (c a b : ℝ) (hab : a ≤ b) (hc : 0 ≤ c) : + (∫⁻ s in Ioo a b, ENNReal.ofReal (c * s ^ 2)) = + ENNReal.ofReal (c * ((b ^ 3 - a ^ 3) / 3)) := by + rw [Measure.restrict_congr_set Ioo_ae_eq_Ioc, + ← ofReal_integral_eq_lintegral_ofReal ((intervalIntegrable_pow 2).const_mul c).1] + · rw [← intervalIntegral.integral_of_le hab, intervalIntegral.integral_const_mul, integral_pow] + norm_num + · exact Filter.Eventually.of_forall (fun s => mul_nonneg hc (sq_nonneg s)) + +theorem lintegral_one_sub_sq_Ico {t : ℝ} (ht : 0 ≤ t) (ht1 : t ≤ 1) : + (∫⁻ s in Ico t 1, ENNReal.ofReal (Real.pi * (1 - s ^ 2))) = + ENNReal.ofReal (Real.pi * ((1 - t) - (1 - t ^ 3) / 3)) := by + have hi : IntervalIntegrable (fun s : ℝ => Real.pi * (1 - s ^ 2)) volume t 1 := + (intervalIntegrable_const.sub (intervalIntegrable_pow 2)).const_mul Real.pi + rw [Measure.restrict_congr_set Ico_ae_eq_Ioc, + ← ofReal_integral_eq_lintegral_ofReal hi.1] + · rw [← intervalIntegral.integral_of_le ht1, intervalIntegral.integral_const_mul, + intervalIntegral.integral_sub intervalIntegrable_const (intervalIntegrable_pow 2), + integral_pow, intervalIntegral.integral_const] + norm_num + · filter_upwards [ae_restrict_mem measurableSet_Ioc] with s hs + apply mul_nonneg Real.pi_pos.le + have hs0 := ht.trans hs.1.le + nlinarith only [hs0, hs.2] + +theorem volume_sphereCone {t : ℝ} (ht : 0 < t) (ht1 : t < 1) : + (volume : Measure Position) (sphereCone t) = ENNReal.ofReal ((2 * Real.pi / 3) * (1 - t)) := by + rw [← sphereHeightSplit_preserving.symm.measure_preimage_emb + sphereHeightSplit.symm.measurableEmbedding, + Measure.volume_eq_prod, Measure.prod_apply ((measurableSet_sphereCone t).preimage + sphereHeightSplit.symm.measurable)] + have heq : (fun s : ℝ => (volume : Measure (EuclideanSpace ℝ (Fin 2))) + (Prod.mk s ⁻¹' (sphereHeightSplit.symm ⁻¹' sphereCone t))) = + (Ioo 0 t).indicator (fun s : ℝ => ENNReal.ofReal (Real.pi * ((1 - t ^ 2) / t ^ 2) * s ^ 2)) + + (Ico t 1).indicator (fun s : ℝ => ENNReal.ofReal (Real.pi * (1 - s ^ 2))) := by + funext s + exact cone_slice_area ht ht1 s + rw [heq] + change (∫⁻ s : ℝ, + (Ioo 0 t).indicator (fun s : ℝ => ENNReal.ofReal (Real.pi * ((1 - t ^ 2) / t ^ 2) * s ^ 2)) s + + (Ico t 1).indicator (fun s : ℝ => ENNReal.ofReal (Real.pi * (1 - s ^ 2))) s) = _ + have ht2 : 0 ≤ 1 - t ^ 2 := by nlinarith only [ht, ht1] + rw [lintegral_add_left ((by fun_prop : Measurable (fun s : ℝ => + ENNReal.ofReal (Real.pi * ((1 - t ^ 2) / t ^ 2) * s ^ 2))).indicator measurableSet_Ioo), + lintegral_indicator measurableSet_Ioo, + lintegral_indicator measurableSet_Ico, lintegral_sq_Ioo _ _ _ ht.le (by positivity), + lintegral_one_sub_sq_Ico ht.le ht1.le] + have hlow : 0 ≤ Real.pi * ((1 - t ^ 2) / t ^ 2) * ((t ^ 3 - 0 ^ 3) / 3) := by + norm_num only [zero_pow (by norm_num : 2 + 1 ≠ 0), sub_zero] + positivity + have hhigh : 0 ≤ Real.pi * ((1 - t) - (1 - t ^ 3) / 3) := by + have heq : (1 - t) - (1 - t ^ 3) / 3 = (1 - t) ^ 2 * (t + 2) / 3 := by ring + rw [heq] + positivity + rw [← ENNReal.ofReal_add hlow hhigh] + congr 1 + field_simp [ht.ne'] + ring +theorem unitSphereMeasure_cap {t : ℝ} (ht : 0 < t) (ht1 : t < 1) : + unitSphereMeasure {ω : sphere (0 : Position) 1 | t < (ω : Position) 2} = + ENNReal.ofReal ((1 - t) / 2) := by + have hm : MeasurableSet {ω : sphere (0 : Position) 1 | t < (ω : Position) 2} := by + exact isOpen_lt continuous_const + ((PiLp.continuous_apply 2 (fun _ : Fin 3 => ℝ) 2).comp continuous_subtype_val) + |>.measurableSet + rw [unitSphereMeasure, Measure.smul_apply, smul_eq_mul, sphere_area, + Measure.toSphere_apply' _ hm, cap_cone_eq, volume_sphereCone ht ht1] + simp only [Position, finrank_euclideanSpace_fin] + rw [← ENNReal.ofReal_inv_of_pos (by positivity : 0 < 4 * Real.pi), + ← ENNReal.ofReal_natCast] + norm_num only [Nat.cast_ofNat] + rw [← mul_assoc, ← ENNReal.ofReal_mul (by positivity : 0 ≤ (4 * Real.pi)⁻¹), + ← ENNReal.ofReal_mul (by positivity : 0 ≤ (4 * Real.pi)⁻¹ * 3)] + congr 1 + field_simp + ring +theorem measurable_sphereHeight : + Measurable (fun ω : sphere (0 : Position) 1 => (ω : Position) 2) := + ((PiLp.continuous_apply 2 (fun _ : Fin 3 => ℝ) 2).comp continuous_subtype_val).measurable + +theorem sphereHeight_Ioi {t : ℝ} (ht : 0 < t) : + (unitSphereMeasure.map (fun ω : sphere (0 : Position) 1 => (ω : Position) 2)) (Ioi t) = + (ENNReal.ofReal 2)⁻¹ * ENNReal.ofReal (max (1 - t) 0) := by + rw [Measure.map_apply measurable_sphereHeight measurableSet_Ioi] + by_cases ht1 : t < 1 + · change unitSphereMeasure {ω : sphere (0 : Position) 1 | t < (ω : Position) 2} = _ + rw [unitSphereMeasure_cap ht ht1, max_eq_left (sub_nonneg.mpr ht1.le)] + rw [ENNReal.ofReal_div_of_pos (by norm_num : (0 : ℝ) < 2), div_eq_mul_inv, mul_comm] + · have he : (fun ω : sphere (0 : Position) 1 => (ω : Position) 2) ⁻¹' Ioi t = ∅ := by + apply Set.eq_empty_iff_forall_notMem.mpr + intro ω hω + have hnorm : ‖(ω : Position)‖ = 1 := mem_sphere_zero_iff_norm.mp ω.property + have hc : (ω : Position) 2 ≤ 1 := by + have h := PiLp.norm_apply_le (ω : Position) 2 + rw [hnorm, Real.norm_eq_abs] at h + exact (le_abs_self _).trans h + exact not_lt_of_ge ((le_of_not_gt ht1).trans' hc) hω + rw [he, measure_empty, max_eq_right (sub_nonpos.mpr (le_of_not_gt ht1)), + ENNReal.ofReal_zero, mul_zero] + +theorem sphereHeight_neg_invariant : + (unitSphereMeasure.map (fun ω : sphere (0 : Position) 1 => (ω : Position) 2)).map + (fun s : ℝ => -s) = + unitSphereMeasure.map (fun ω : sphere (0 : Position) 1 => (ω : Position) 2) := by + let Q : Position ≃ₗᵢ[ℝ] Position := LinearIsometryEquiv.neg ℝ + rw [Measure.map_map measurable_neg measurable_sphereHeight] + have hc : (fun s : ℝ => -s) ∘ (fun ω : sphere (0 : Position) 1 => (ω : Position) 2) = + (fun ω : sphere (0 : Position) 1 => (ω : Position) 2) ∘ unitSphereRotation Q := by + funext ω + rfl + rw [hc, ← Measure.map_map measurable_sphereHeight (measurable_unitSphereRotation Q), + map_unitSphereMeasure_rotation] +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SphereRadial.lean b/LeanPool/LiebThirring/Electrostatics/SphereRadial.lean new file mode 100644 index 0000000000..a80b5e659b --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SphereRadial.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.Sphere + +/-! +# Radial integration on the Euclidean carrier + +Radial integration in physical Euclidean three-space, for nonnegative Borel functions. +-/ + +public section + +open MeasureTheory Set Metric +open scoped ENNReal + +namespace LiebThirring + +/-- Radial integration in physical Euclidean three-space, for nonnegative Borel functions. -/ +theorem lintegral_norm (g : ℝ → ℝ≥0∞) (hg : Measurable g) : + ∫⁻ x : Position, g ‖x‖ = ENNReal.ofReal (4 * Real.pi) * + ∫⁻ r in Ioi (0 : ℝ), ENNReal.ofReal (r ^ 2) * g r := by + calc + _ = ∫⁻ x : ({(0 : Position)}ᶜ : Set Position), g ‖x.1‖ + ∂((volume : Measure Position).comap Subtype.val) := by + rw [lintegral_subtype_comap (measurableSet_singleton _).compl (fun x : Position => g ‖x‖), + restrict_compl_singleton] + _ = ∫⁻ x, g x.2 ∂(volume : Measure Position).toSphere.prod + (Measure.volumeIoiPow (Module.finrank ℝ Position - 1)) := by + simpa only [Function.comp_def, homeomorphUnitSphereProd_apply_snd_coe] using + (volume : Measure Position).measurePreserving_homeomorphUnitSphereProd.lintegral_comp_emb + (Homeomorph.measurableEmbedding _) (g ∘ Subtype.val ∘ Prod.snd) + _ = _ := by + rw [lintegral_prod (fun x : sphere (0 : Position) 1 × Ioi (0 : ℝ) => g x.2) + (hg.comp (measurable_subtype_coe.comp measurable_snd)).aemeasurable] + simp only [lintegral_const] + rw [sphere_area, mul_comm] + congr 1 + simp only [Position, finrank_euclideanSpace_fin, Nat.reduceSub, + Measure.volumeIoiPow] + rw [lintegral_withDensity_eq_lintegral_mul _ (by fun_prop) + (show Measurable (fun r : Ioi (0 : ℝ) => g r) from + hg.comp measurable_subtype_coe)] + simp only [Pi.mul_apply] + rw [lintegral_subtype_comap measurableSet_Ioi (fun r : ℝ => ENNReal.ofReal (r ^ 2) * g r)] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SphereRealMarginal.lean b/LeanPool/LiebThirring/Electrostatics/SphereRealMarginal.lean new file mode 100644 index 0000000000..679fa3b259 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SphereRealMarginal.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.MeasureTheory.Measure.Lebesgue.Basic +import Mathlib.MeasureTheory.Measure.Haar.Unique + +/-! +# Determining a symmetric real probability measure from positive tails + +Symmetric probability measures with equal positive upper tails agree. The cap formula then +identifies the sphere height distribution with uniform measure on `[-1,1]`. +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal + +namespace LiebThirring + +/-- Reflection symmetry and agreement of strictly positive upper tails determine +an arbitrary real probability measure. -/ +lemma symmetric_probability_ext_of_positive_tails + (μ ν : Measure ℝ) [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (hμ : μ.map (fun x => -x) = μ) (hν : ν.map (fun x => -x) = ν) + (h : ∀ t > 0, μ (Ioi t) = ν (Ioi t)) : μ = ν := by + have hzero : μ (Ioi 0) = ν (Ioi 0) := by + let s := fun q : {q : ℚ // 0 < q} => Ioi (q.val : ℝ) + have hs : Antitone s := by + intro i j hij + exact Ioi_subset_Ioi (Rat.cast_le.mpr hij) + have heq : (⋃ q, s q) = Ioi 0 := by + ext x + simp only [mem_iUnion, mem_Ioi] + constructor + · rintro ⟨q, hqx⟩ + exact lt_trans (Rat.cast_pos.mpr q.property) hqx + · intro hx + obtain ⟨q, hq0, hqx⟩ := exists_rat_btwn hx + exact ⟨⟨q, Rat.cast_pos.mp hq0⟩, hqx⟩ + rw [← heq, hs.measure_iUnion, hs.measure_iUnion] + congr 1 + ext q + exact h q.val (Rat.cast_pos.mpr q.property) + have hclosed : ∀ b > 0, μ (Ici b) = ν (Ici b) := by + intro b hb + let s := fun q : {q : ℚ // 0 < (q : ℝ) ∧ (q : ℝ) < b} => Ioi (q.val : ℝ) + have hs : Antitone s := by + intro i j hij + exact Ioi_subset_Ioi (Rat.cast_le.mpr hij) + have heq : (⋂ q, s q) = Ici b := by + ext x + simp only [mem_iInter, mem_Ici] + constructor + · intro hx + by_contra hxb + have hmax : max x 0 < b := max_lt (lt_of_not_ge hxb) hb + obtain ⟨q, hq0, hqb⟩ := exists_rat_btwn hmax + have hq : 0 < (q : ℝ) := lt_of_le_of_lt (le_max_right x 0) hq0 + have hqx := hx ⟨q, hq, hqb⟩ + exact (not_lt_of_ge (le_max_left x 0)) (lt_trans hq0 hqx) + · intro hbx q + exact lt_of_lt_of_le q.property.2 hbx + obtain ⟨q, hq0, hqb⟩ := exists_rat_btwn hb + have hfμ : ∃ q, μ (s q) ≠ ⊤ := ⟨⟨q, hq0, hqb⟩, measure_ne_top μ _⟩ + have hfν : ∃ q, ν (s q) ≠ ⊤ := ⟨⟨q, hq0, hqb⟩, measure_ne_top ν _⟩ + rw [← heq, hs.measure_iInter (fun _ => measurableSet_Ioi.nullMeasurableSet) hfμ, + hs.measure_iInter (fun _ => measurableSet_Ioi.nullMeasurableSet) hfν] + congr 1 + ext q + exact h q.val q.property.1 + apply Measure.ext_of_Iic μ ν + intro a + by_cases ha : 0 ≤ a + · have htail : μ (Ioi a) = ν (Ioi a) := by + rcases ha.eq_or_lt with ha | ha + · subst a + exact hzero + · exact h a ha + rw [← compl_Ioi, measure_compl measurableSet_Ioi (measure_ne_top μ _), + measure_compl measurableSet_Ioi (measure_ne_top ν _), measure_univ, measure_univ, htail] + · have hp : 0 < -a := neg_pos.mpr (lt_of_not_ge ha) + have hpre : (fun x : ℝ => -x) ⁻¹' Iic a = Ici (-a) := by + ext x + simp only [mem_preimage, mem_Iic, mem_Ici] + exact neg_le + calc + μ (Iic a) = μ (Ici (-a)) := by + conv_lhs => rw [← hμ, Measure.map_apply measurable_neg measurableSet_Iic, hpre] + _ = ν (Ici (-a)) := hclosed (-a) hp + _ = ν (Iic a) := by + conv_rhs => rw [← hν, Measure.map_apply measurable_neg measurableSet_Iic, hpre] + +/-- A symmetric probability distribution with the uniform positive-tail formula +is normalized Lebesgue measure on `[-1, 1]`. -/ +theorem eq_uniform_interval_of_symmetric_positive_tails + (μ : Measure ℝ) [IsProbabilityMeasure μ] + (hμ : μ.map (fun z => -z) = μ) + (h : ∀ t > 0, μ (Ioi t) = (ENNReal.ofReal 2)⁻¹ * ENNReal.ofReal (max (1 - t) 0)) : + μ = (ENNReal.ofReal 2)⁻¹ • (volume : Measure ℝ).restrict (Icc (-1) 1) := by + let ν : Measure ℝ := (ENNReal.ofReal 2)⁻¹ • (volume : Measure ℝ).restrict (Icc (-1) 1) + have huniv : ν univ = 1 := by + dsimp [ν] + rw [Measure.restrict_apply_univ, Real.volume_Icc] + norm_num + exact ENNReal.inv_mul_cancel (by norm_num) (by norm_num) + let : IsProbabilityMeasure ν := ⟨huniv⟩ + have hpre : (fun z : ℝ => -z) ⁻¹' Icc (-1) 1 = Icc (-1) 1 := by + ext x + simp only [mem_preimage, mem_Icc] + constructor <;> intro hx <;> constructor <;> linarith + have hν : ν.map (fun z => -z) = ν := by + dsimp [ν] + rw [Measure.map_smul _ measurable_neg.aemeasurable] + rw [← hpre, ← measurableEmbedding_neg.restrict_map, Measure.map_neg_eq_self, hpre] + apply symmetric_probability_ext_of_positive_tails μ ν hμ hν + intro t ht + rw [h t ht] + dsimp [ν] + rw [Measure.restrict_apply measurableSet_Ioi] + have hinter : Ioi t ∩ Icc (-1 : ℝ) 1 = Ioc t 1 := by + ext x + simp only [mem_inter_iff, mem_Ioi, mem_Icc, mem_Ioc] + constructor + · exact fun hx => ⟨hx.1, hx.2.2⟩ + · exact fun hx => ⟨hx.1, le_trans (by linarith : (-1 : ℝ) ≤ t) hx.1.le, hx.2⟩ + rw [hinter, Real.volume_Ioc, ENNReal.ofReal_max] + simp only [ENNReal.ofReal_zero, max_zero] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/SquareCompletion.lean b/LeanPool/LiebThirring/Electrostatics/SquareCompletion.lean new file mode 100644 index 0000000000..278be48e6a --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/SquareCompletion.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.Screened +import LeanPool.LiebThirring.Electrostatics.CoulombPositivity +import all LeanPool.LiebThirring.Electrostatics.Basic +import all LeanPool.LiebThirring.Electrostatics.Screened + +/-! +# Abstract square completion for the basic electrostatic inequality + +Coulomb positivity gives the basic electrostatic inequality from a finite-energy screening +measure with the prescribed potential and nuclear-energy deficit. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- the basic electrostatic inequality from a finite-energy screening measure with the prescribed +potential and nuclear-energy deficit. -/ +theorem basicElectrostaticInequality_of_potential {M : ℕ} + (Z : ℝ≥0) (R : Fin M → Position) (ν : Measure Position) [IsFiniteMeasure ν] + (hνE : coulombEnergy ν ν ≠ ⊤) + (hΦ : ∀ x, screenedPotential Z R x = coulombPotential ν x) + (hdef : coulombEnergy ν ν / 2 + baxterCorrection Z R ≤ + nuclearRepulsion (fun _ => Z) R) : + BasicElectrostaticInequality Z R := by + intro μ hμ hμE + have : IsFiniteMeasure μ := hμ + have hpotential : (∫⁻ x, screenedPotential Z R x ∂μ) = coulombEnergy μ ν := by + unfold coulombEnergy + exact lintegral_congr hΦ + have henergy : coulombEnergy μ ν ≤ coulombEnergy μ μ / 2 + coulombEnergy ν ν / 2 := by + have h := ENNReal.div_le_div_right (two_mul_coulombEnergy_le μ ν hμE hνE) 2 + rwa [ENNReal.add_div, mul_comm (2 : ℝ≥0∞), + ENNReal.mul_div_cancel_right (by norm_num) (by norm_num)] at h + rw [hpotential] + calc + coulombEnergy μ ν + baxterCorrection Z R ≤ + (coulombEnergy μ μ / 2 + coulombEnergy ν ν / 2) + baxterCorrection Z R := + add_le_add henergy le_rfl + _ = coulombEnergy μ μ / 2 + (coulombEnergy ν ν / 2 + baxterCorrection Z R) := + add_assoc _ _ _ + _ ≤ coulombEnergy μ μ / 2 + nuclearRepulsion (fun _ => Z) R := + add_le_add le_rfl hdef + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/VoronoiBasic.lean b/LeanPool/LiebThirring/Electrostatics/VoronoiBasic.lean new file mode 100644 index 0000000000..67ea295483 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/VoronoiBasic.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.Coulomb +public import Mathlib.Geometry.Euclidean.PerpBisector + +/-! +# Voronoi cells and strict faces + +The perpendicular bisector affine subspace of two nuclei. + +Points having nucleus `k` as their unique closest nucleus. +-/ + +public section + +open Set Metric +open scoped InnerProductSpace ENNReal + +namespace LiebThirring + +variable {M : ℕ} + +/-- The perpendicular bisector affine subspace of two nuclei. -/ +@[expose] noncomputable def bisectorPlane (R : Fin M → Position) (k l : Fin M) : + AffineSubspace ℝ Position := + AffineSubspace.perpBisector (R k) (R l) + +/-- Points having nucleus `k` as their unique closest nucleus. -/ +@[expose] def voronoiCell (R : Fin M → Position) (k : Fin M) : Set Position := + {x | ∀ l, l ≠ k → dist x (R k) < dist x (R l)} + +/-- Points having nucleus `k` among their closest nuclei. -/ +@[expose] def closedVoronoiCell (R : Fin M → Position) (k : Fin M) : Set Position := + {x | ∀ l, dist x (R k) ≤ dist x (R l)} + +/-- The genuine face: exactly `k` and `l` are closest, with no third tie. -/ +@[expose] def voronoiFace (R : Fin M → Position) (k l : Fin M) : Set Position := + {x | k ≠ l ∧ x ∈ bisectorPlane R k l ∧ + ∀ p, p ≠ k → p ≠ l → dist x (R k) < dist x (R p)} + +/-- The finite union of intersections of bisectors with a common nucleus. +It contains every point with at least three nearest nuclei. -/ +@[expose] def voronoiTripleStratum (R : Fin M → Position) : Set Position := + {x | ∃ k l p, k ≠ l ∧ k ≠ p ∧ l ≠ p ∧ + x ∈ bisectorPlane R k l ∧ x ∈ bisectorPlane R k p} + +/-- The directed unit bisector normal for distinct nuclei. -/ +@[expose] noncomputable def bisectorNormal (R : Fin M → Position) (k l : Fin M) : + Position := + ‖R l - R k‖⁻¹ • (R l - R k) + +@[simp] theorem mem_bisectorPlane (R : Fin M → Position) (k l : Fin M) (x : Position) : + x ∈ bisectorPlane R k l ↔ dist x (R k) = dist x (R l) := + AffineSubspace.mem_perpBisector_iff_dist_eq + +theorem bisectorPlane_comm (R : Fin M → Position) (k l : Fin M) : + bisectorPlane R k l = bisectorPlane R l k := + AffineSubspace.perpBisector_comm _ _ + +/-- Squared-distance comparison, in affine-linear form. -/ +theorem dist_lt_dist_iff_inner_lt (x a b : Position) : + dist x a < dist x b ↔ 2 * inner ℝ (b - a) (x - a) < ‖b - a‖ ^ 2 := by + have hexp := norm_sub_sq_real (x - a) (b - a) + rw [sub_sub_sub_cancel_right, real_inner_comm] at hexp + rw [dist_eq_norm, dist_eq_norm] + constructor + · intro h + have hsq := (sq_lt_sq₀ (norm_nonneg (x - a)) (norm_nonneg (x - b))).2 h + linarith only [hexp, hsq] + · intro h + apply (sq_lt_sq₀ (norm_nonneg (x - a)) (norm_nonneg (x - b))).1 + linarith only [hexp, h] + +theorem dist_le_dist_iff_inner_le (x a b : Position) : + dist x a ≤ dist x b ↔ 2 * inner ℝ (b - a) (x - a) ≤ ‖b - a‖ ^ 2 := by + have hexp := norm_sub_sq_real (x - a) (b - a) + rw [sub_sub_sub_cancel_right, real_inner_comm] at hexp + rw [dist_eq_norm, dist_eq_norm] + constructor + · intro h + have hsq := (sq_le_sq₀ (norm_nonneg (x - a)) (norm_nonneg (x - b))).2 h + linarith only [hexp, hsq] + · intro h + apply (sq_le_sq₀ (norm_nonneg (x - a)) (norm_nonneg (x - b))).1 + linarith only [hexp, h] + +theorem mem_voronoiCell_iff_inner (R : Fin M → Position) (k : Fin M) (x : Position) : + x ∈ voronoiCell R k ↔ + ∀ l, l ≠ k → 2 * inner ℝ (R l - R k) (x - R k) < ‖R l - R k‖ ^ 2 := by + simp only [voronoiCell, mem_ofPred_eq, dist_lt_dist_iff_inner_lt] + +theorem voronoiCell_subset_closed (R : Fin M → Position) (k : Fin M) : + voronoiCell R k ⊆ closedVoronoiCell R k := by + intro x hx l + by_cases hl : l = k + · rw [hl] + · exact (hx l hl).le + +theorem isOpen_voronoiCell (R : Fin M → Position) (k : Fin M) : + IsOpen (voronoiCell R k) := by + have heq : voronoiCell R k = ⋂ l : {l : Fin M // l ≠ k}, + {x | dist x (R k) < dist x (R l)} := by + ext x + simp only [voronoiCell, mem_ofPred_eq, mem_iInter, Subtype.forall] + rw [heq] + exact isOpen_iInter_of_finite fun l => isOpen_lt + (continuous_id.dist continuous_const) (continuous_id.dist continuous_const) + +theorem disjoint_voronoiCell (R : Fin M → Position) {k l : Fin M} (hkl : k ≠ l) : + Disjoint (voronoiCell R k) (voronoiCell R l) := by + rw [disjoint_left] + intro x hx hy + exact (hx l hkl.symm).not_gt (hy k hkl) + +theorem voronoiFace_comm (R : Fin M → Position) (k l : Fin M) : + voronoiFace R k l = voronoiFace R l k := by + ext x + simp only [voronoiFace, mem_ofPred_eq, mem_bisectorPlane] + constructor <;> rintro ⟨hkl, heq, hx⟩ + · refine ⟨hkl.symm, heq.symm, ?_⟩ + intro p hpl hpk + rw [← heq] + exact hx p hpk hpl + · refine ⟨hkl.symm, heq.symm, ?_⟩ + intro p hpl hpk + rw [← heq] + exact hx p hpk hpl + +theorem voronoiFace_subset_closed (R : Fin M → Position) (k l : Fin M) : + voronoiFace R k l ⊆ closedVoronoiCell R k := by + rintro x ⟨hkl, heq, hx⟩ p + by_cases hpk : p = k + · rw [hpk] + by_cases hpl : p = l + · rw [hpl, (mem_bisectorPlane R k l x).mp heq] + · exact (hx p hpk hpl).le + +theorem nearestNucleusDistance_eq_of_mem_closedVoronoiCell + (R : Fin M → Position) (k : Fin M) {x : Position} + (hx : x ∈ closedVoronoiCell R k) : + nearestNucleusDistance R x = ENNReal.ofReal ‖x - R k‖ := by + apply le_antisymm + · exact iInf_le _ k + · apply le_iInf + intro l + exact ENNReal.ofReal_le_ofReal (by simpa only [dist_eq_norm] using hx l) + +@[simp] theorem nearestOtherNucleusDistance_one (R : Fin 1 → Position) (k : Fin 1) : + nearestOtherNucleusDistance R k = ⊤ := by + apply iInf_eq_top.mpr + intro l + exact (l.property (Subsingleton.elim l.val k)).elim + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/VoronoiBoundary.lean b/LeanPool/LiebThirring/Electrostatics/VoronoiBoundary.lean new file mode 100644 index 0000000000..1b26d5ee92 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/VoronoiBoundary.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.VoronoiBasic + +/-! +# Voronoi boundary decomposition and volume partition + +Strict faces partition each Voronoi boundary up to triple-tie strata. +-/ + +public section + +open Set Metric MeasureTheory +open scoped ENNReal InnerProductSpace + +namespace LiebThirring + +variable {M : ℕ} + +/-- A closest nucleus fails to be uniquely closest exactly when another nucleus ties it. -/ +theorem exists_tie_of_mem_closed_not_mem_cell (R : Fin M → Position) + (k : Fin M) {x : Position} (hx : x ∈ closedVoronoiCell R k) + (hn : x ∉ voronoiCell R k) : + ∃ l, l ≠ k ∧ dist x (R k) = dist x (R l) := by + classical + change ¬ ∀ l, l ≠ k → dist x (R k) < dist x (R l) at hn + push Not at hn + obtain ⟨l, hl, he⟩ := hn + exact ⟨l, hl, (hx l).antisymm he⟩ + +theorem closedVoronoiCells_cover (R : Fin M → Position) (hM : 0 < M) : + (⋃ k, closedVoronoiCell R k) = univ := by + classical + have : NeZero M := ⟨Nat.ne_of_gt hM⟩ + apply eq_univ_of_forall + intro x + obtain ⟨k, _, hk⟩ := Finset.exists_min_image Finset.univ + (fun k : Fin M => dist x (R k)) Finset.univ_nonempty + exact mem_iUnion.mpr ⟨k, fun l => hk l (Finset.mem_univ l)⟩ + +/-- Outside all open cells, two closest nuclei tie. -/ +theorem exists_nearest_tie_of_not_mem_cells (R : Fin M → Position) (hM : 0 < M) + {x : Position} (hx : x ∉ ⋃ k, voronoiCell R k) : + ∃ k l, k ≠ l ∧ x ∈ closedVoronoiCell R k ∧ + dist x (R k) = dist x (R l) := by + have hcover : x ∈ ⋃ k, closedVoronoiCell R k := by rw [closedVoronoiCells_cover R hM]; trivial + obtain ⟨k, hk⟩ := mem_iUnion.mp hcover + have hn : x ∉ voronoiCell R k := fun hc => hx (mem_iUnion.mpr ⟨k, hc⟩) + obtain ⟨l, hl, he⟩ := exists_tie_of_mem_closed_not_mem_cell R k hk hn + exact ⟨k, l, hl.symm, hk, he⟩ + +theorem volume_bisectorPlane (R : Fin M → Position) (hR : Function.Injective R) + {k l : Fin M} (hkl : k ≠ l) : + volume (bisectorPlane R k l : Set Position) = 0 := by + apply Measure.addHaar_affineSubspace volume + change AffineSubspace.perpBisector (R k) (R l) ≠ ⊤ + simpa only [Ne, AffineSubspace.perpBisector_eq_top] using hR.ne hkl + +/-- The disjoint open cells cover ambient space up to a volume-null set. -/ +theorem volume_compl_voronoiCells (R : Fin M → Position) + (hR : Function.Injective R) (hM : 0 < M) : + volume (⋃ k, voronoiCell R k)ᶜ = 0 := by + classical + let T : Set Position := ⋃ k : Fin M, ⋃ l : {l : Fin M // k ≠ l}, + (bisectorPlane R k l : Set Position) + have hnull : volume T = 0 := + measure_iUnion_null fun k => measure_iUnion_null fun l => volume_bisectorPlane R hR l.property + apply measure_mono_null _ hnull + intro x hx + obtain ⟨k, l, hkl, _, heq⟩ := exists_nearest_tie_of_not_mem_cells R hM hx + exact mem_iUnion.mpr ⟨k, mem_iUnion.mpr ⟨⟨l, hkl⟩, + (mem_bisectorPlane R k l x).mpr heq⟩⟩ + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/VoronoiDistance.lean b/LeanPool/LiebThirring/Electrostatics/VoronoiDistance.lean new file mode 100644 index 0000000000..6c23294391 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/VoronoiDistance.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.VoronoiBoundary +import Mathlib.Geometry.Euclidean.Triangle + +/-! +# Nearest Voronoi face and boundary distance + +Nearest-other nuclear distance determines the distance from a nucleus to its Voronoi boundary. +-/ + +public section + +open Set Metric MeasureTheory +open scoped ENNReal InnerProductSpace + +namespace LiebThirring + +variable {M : ℕ} + +theorem norm_bisectorNormal (R : Fin M → Position) (hR : Function.Injective R) + {k l : Fin M} (hkl : k ≠ l) : ‖bisectorNormal R k l‖ = 1 := by + have hp : 0 < ‖R l - R k‖ := norm_pos_iff.mpr (sub_ne_zero.mpr (hR.ne hkl.symm)) + simp only [bisectorNormal, norm_smul, Real.norm_eq_abs, abs_inv, + abs_of_pos hp, inv_mul_cancel₀ hp.ne'] + +theorem mem_voronoiCell_iff_normal (R : Fin M → Position) + (hR : Function.Injective R) (k : Fin M) (x : Position) : + x ∈ voronoiCell R k ↔ ∀ l, l ≠ k → + inner ℝ (bisectorNormal R k l) (x - R k) < ‖R l - R k‖ / 2 := by + rw [mem_voronoiCell_iff_inner] + apply forall_congr' + intro l + apply imp_congr_right + intro hl + have hp : 0 < ‖R l - R k‖ := norm_pos_iff.mpr (sub_ne_zero.mpr (hR.ne hl)) + simp only [bisectorNormal, real_inner_smul_left, ← div_eq_inv_mul] + rw [div_lt_iff₀ hp] + constructor <;> intro h <;> nlinarith only [h] + +theorem mem_bisectorPlane_iff_normal (R : Fin M → Position) + (hR : Function.Injective R) {k l : Fin M} (hkl : k ≠ l) (x : Position) : + x ∈ bisectorPlane R k l ↔ + inner ℝ (bisectorNormal R k l) (x - R k) = ‖R l - R k‖ / 2 := by + have hp : 0 < ‖R l - R k‖ := norm_pos_iff.mpr (sub_ne_zero.mpr (hR.ne hkl.symm)) + rw [mem_bisectorPlane, le_antisymm_iff, dist_le_dist_iff_inner_le] + have hexp := norm_sub_sq_real (x - R k) (R l - R k) + rw [sub_sub_sub_cancel_right, real_inner_comm] at hexp + simp only [bisectorNormal, real_inner_smul_left, ← div_eq_inv_mul] + rw [div_eq_iff hp.ne'] + constructor + · rintro ⟨h₁, h₂⟩ + have hsq := (sq_le_sq₀ (dist_nonneg : 0 ≤ dist x (R l)) + (dist_nonneg : 0 ≤ dist x (R k))).2 h₂ + simp only [dist_eq_norm] at hsq + nlinarith only [hexp, h₁, hsq] + · intro he + constructor + · nlinarith only [he] + · apply (sq_le_sq₀ (dist_nonneg : 0 ≤ dist x (R l)) + (dist_nonneg : 0 ≤ dist x (R k))).1 + simp only [dist_eq_norm] + nlinarith only [hexp, he] + +/-- The direction `n_kl` points from `C_k` into its excluded half-space. -/ +theorem exterior_halfSpace_subset_compl_voronoiCell + (R : Fin M → Position) (hR : Function.Injective R) + {k l : Fin M} (hkl : k ≠ l) : + {x | ‖R l - R k‖ / 2 ≤ inner ℝ (bisectorNormal R k l) (x - R k)} ⊆ + (voronoiCell R k)ᶜ := by + intro x hx hc + exact ((mem_voronoiCell_iff_normal R hR k x).mp hc l hkl.symm).not_ge hx + +/-- Any radius below all half inter-nuclear distances gives a ball in the cell. -/ +theorem ball_subset_voronoiCell_of_bound (R : Fin M → Position) (k : Fin M) + (r : ℝ) (hr : ∀ l, l ≠ k → 2 * r ≤ dist (R k) (R l)) : + ball (R k) r ⊆ voronoiCell R k := by + intro x hx l hl + have ht := dist_triangle (R k) x (R l) + have hx' : dist x (R k) < r := hx + rw [dist_comm (R k) x] at ht + linarith only [ht, hr l hl, hx'] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Electrostatics/VoronoiStrata.lean b/LeanPool/LiebThirring/Electrostatics/VoronoiStrata.lean new file mode 100644 index 0000000000..bd062b1d98 --- /dev/null +++ b/LeanPool/LiebThirring/Electrostatics/VoronoiStrata.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Electrostatics.VoronoiDistance +public import LeanPool.LiebThirring.Electrostatics.Plane + +/-! +# Voronoi faces and surface-null triple strata + +Intersections of distinct bisectors give the lower-dimensional triple-tie strata. +-/ + +public section + +open Set Metric MeasureTheory +open scoped InnerProductSpace ENNReal + +namespace LiebThirring + +variable {M : ℕ} + +/-- Distinct bisectors with a common nucleus cannot contain one another. -/ +theorem bisectorPlane_not_le (R : Fin M → Position) (hR : Function.Injective R) + {k l p : Fin M} (hkl : k ≠ l) (hkp : k ≠ p) (hlp : l ≠ p) : + ¬ bisectorPlane R k l ≤ bisectorPlane R k p := by + intro hH + have hd := AffineSubspace.direction_le hH + change (AffineSubspace.perpBisector (R k) (R l)).direction ≤ + (AffineSubspace.perpBisector (R k) (R p)).direction at hd + rw [AffineSubspace.direction_perpBisector, AffineSubspace.direction_perpBisector] at hd + have hspan := Submodule.orthogonal_le hd + simp only [Submodule.orthogonal_orthogonal, vsub_eq_sub] at hspan + obtain ⟨t, ht⟩ := Submodule.mem_span_singleton.mp + (hspan (Submodule.mem_span_singleton_self (R p - R k))) + have hm := hH (AffineSubspace.midpoint_mem_perpBisector (R k) (R l)) + change midpoint ℝ (R k) (R l) ∈ AffineSubspace.perpBisector (R k) (R p) at hm + rw [AffineSubspace.mem_perpBisector_iff_inner_eq, midpoint_vsub_left, + invOf_eq_inv, real_inner_smul_left, vsub_eq_sub, dist_eq_norm, + norm_sub_rev (R k) (R p)] at hm + simp only [vsub_eq_sub] at hm + norm_num only at hm + have hi : inner ℝ (R l - R k) (R p - R k) = ‖R p - R k‖ ^ 2 := by + linarith only [hm] + have he : t * ‖R l - R k‖ ^ 2 = t * t * ‖R l - R k‖ ^ 2 := by + calc + t * ‖R l - R k‖ ^ 2 = inner ℝ (R l - R k) (R p - R k) := by + rw [← ht, real_inner_smul_right, real_inner_self_eq_norm_sq] + _ = inner ℝ (R p - R k) (R p - R k) := hi.trans (real_inner_self_eq_norm_sq _).symm + _ = t * t * ‖R l - R k‖ ^ 2 := by + rw [← ht, real_inner_smul_left, real_inner_smul_right, real_inner_self_eq_norm_sq] + ring + have hd0 : ‖R l - R k‖ ^ 2 ≠ 0 := + ne_of_gt (sq_pos_of_pos (norm_pos_iff.mpr (sub_ne_zero.mpr (hR.ne hkl.symm)))) + have ht0 : t ≠ 0 := by + intro ht0 + rw [ht0, zero_smul] at ht + exact hR.ne hkp.symm (sub_eq_zero.mp ht.symm) + have ht1 : t = 1 := by + have hf : (t * (t - 1)) * ‖R l - R k‖ ^ 2 = 0 := by + nlinarith only [he] + have hh := (mul_eq_zero.mp hf).resolve_right hd0 + exact sub_eq_zero.mp ((mul_eq_zero.mp hh).resolve_left ht0) + rw [ht1, one_smul] at ht + exact hR.ne hlp (sub_left_inj.mp ht) + +theorem finrank_bisectorPlane_direction (R : Fin M → Position) + (hR : Function.Injective R) {k l : Fin M} (hkl : k ≠ l) : + Module.finrank ℝ (bisectorPlane R k l).direction = 2 := by + change Module.finrank ℝ (AffineSubspace.perpBisector (R k) (R l)).direction = 2 + rw [AffineSubspace.direction_perpBisector, vsub_eq_sub] + have : Fact (Module.finrank ℝ Position = 2 + 1) := ⟨finrank_euclideanSpace⟩ + exact Submodule.finrank_orthogonal_span_singleton (sub_ne_zero.mpr (hR.ne hkl.symm)) + +/-- Each constituent of the triple stratum is an affine line, a point, or empty, +as expressed by direction dimension at most one. -/ +theorem finrank_bisectorPlane_inf_le_one (R : Fin M → Position) + (hR : Function.Injective R) {k l p : Fin M} + (hkl : k ≠ l) (hkp : k ≠ p) (hlp : l ≠ p) : + Module.finrank ℝ (bisectorPlane R k l ⊓ bisectorPlane R k p).direction ≤ 1 := by + let S := bisectorPlane R k l ⊓ bisectorPlane R k p + change Module.finrank ℝ S.direction ≤ 1 + rcases S.eq_bot_or_nonempty with he | ⟨x, hx⟩ + · rw [he, AffineSubspace.direction_bot, finrank_bot] + omega + · have hle : S.direction ≤ (bisectorPlane R k l).direction := + AffineSubspace.direction_le inf_le_left + have hne : S.direction ≠ (bisectorPlane R k l).direction := by + intro heq + have heqS : S = bisectorPlane R k l := + AffineSubspace.ext_of_direction_eq heq ⟨x, hx, hx.1⟩ + have hbad : bisectorPlane R k l ≤ bisectorPlane R k p := heqS ▸ inf_le_right + exact bisectorPlane_not_le R hR hkl hkp hlp hbad + have hlt := Submodule.finrank_lt_finrank_of_lt (lt_of_le_of_ne hle hne) + rw [finrank_bisectorPlane_direction R hR hkl] at hlt + omega + +/-- The triple stratum is a finite union of affine subspaces with direction dimension ≤ 1. -/ +theorem voronoiTripleStratum_eq_iUnion (R : Fin M → Position) : + voronoiTripleStratum R = ⋃ k : Fin M, ⋃ l : {l : Fin M // k ≠ l}, + ⋃ p : {p : Fin M // k ≠ p ∧ l.val ≠ p}, + (bisectorPlane R k l ⊓ bisectorPlane R k p : Set Position) := by + ext x + simp only [voronoiTripleStratum, mem_ofPred_eq, mem_iUnion, Subtype.exists] + constructor + · rintro ⟨k, l, p, hkl, hkp, hlp, hx₁, hx₂⟩ + exact ⟨k, l, hkl, p, ⟨hkp, hlp⟩, hx₁, hx₂⟩ + · rintro ⟨k, l, hkl, p, ⟨hkp, hlp⟩, hx₁, hx₂⟩ + exact ⟨k, l, p, hkl, hkp, hlp, hx₁, hx₂⟩ + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Fourier/ContractionFourier.lean b/LeanPool/LiebThirring/Fourier/ContractionFourier.lean new file mode 100644 index 0000000000..00ead33fdd --- /dev/null +++ b/LeanPool/LiebThirring/Fourier/ContractionFourier.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.ContractionTensor +public import LeanPool.LiebThirring.Fourier.Functoriality + +/-! +# Fourier invariance of tensor contraction + +Outer Fourier transforms preserve the contraction against a spatial-and-spin +one-particle vector. These identities hold for arbitrary complete complex +Hilbert fibers and require no integrability beyond L². +-/ + +public section + +open MeasureTheory +open scoped FourierTransform + +namespace LiebThirring.Fourier + +variable {V ι H : Type*} [Fintype ι] + [NormedAddCommGroup V] [InnerProductSpace ℝ V] [FiniteDimensional ℝ V] + [MeasurableSpace V] [BorelSpace V] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- Outer Fourier transforms act on the spatial factor of a tensor insertion. -/ +theorem fourier_tensorInsertion + (f : Lp (EuclideanSpace ℂ ι) 2 (volume : Measure V)) (v : H) : + 𝓕 (tensorInsertion (H := H) f v) = tensorInsertion (H := H) (𝓕 f) v := by + change 𝓕 ((tensorInsertionBilinear v).compLp f) = + (tensorInsertionBilinear v).compLp (𝓕 f) + exact fourier_compLp _ f + +/-- Simultaneous outer Fourier transforms leave tensor contraction unchanged. -/ +theorem tensorContraction_fourier + (f : Lp (EuclideanSpace ℂ ι) 2 (volume : Measure V)) + (h : Lp (PiLp 2 (fun _ : ι => H)) 2 (volume : Measure V)) : + tensorContraction (H := H) (𝓕 f) (𝓕 h) = tensorContraction (H := H) f h := by + apply ext_inner_left ℂ + intro v + change inner ℂ v ((tensorInsertion (H := H) (𝓕 f)).adjoint (𝓕 h)) = + inner ℂ v ((tensorInsertion (H := H) f).adjoint h) + rw [ContinuousLinearMap.adjoint_inner_right, ContinuousLinearMap.adjoint_inner_right, + ← fourier_tensorInsertion] + exact Lp.inner_fourier_eq _ _ + +end LiebThirring.Fourier +end diff --git a/LeanPool/LiebThirring/Fourier/Covariance.lean b/LeanPool/LiebThirring/Fourier/Covariance.lean new file mode 100644 index 0000000000..4525a61100 --- /dev/null +++ b/LeanPool/LiebThirring/Fourier/Covariance.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Fourier.Functoriality + +/-! +# Orthogonal covariance of the L² Fourier transform + +Orthogonal changes of spatial coordinates commute with the L² Fourier transform, by the integral +formula and Schwartz density. +-/ + +public section + +open MeasureTheory +open scoped SchwartzMap FourierTransform + +namespace LiebThirring.Fourier + +variable {V H : Type*} + [NormedAddCommGroup V] [InnerProductSpace ℝ V] [FiniteDimensional ℝ V] + [MeasurableSpace V] [BorelSpace V] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +omit [CompleteSpace H] in +/-- Schwartz Fourier covariance under an orthogonal change of variables. -/ +theorem fourier_comp_isometry (A : V ≃ₗᵢ[ℝ] V) (f : 𝓢(V, H)) : + 𝓕 (SchwartzMap.compCLMOfContinuousLinearEquiv ℂ A.toContinuousLinearEquiv f) = + SchwartzMap.compCLMOfContinuousLinearEquiv ℂ A.toContinuousLinearEquiv (𝓕 f) := by + ext x + exact Real.fourier_comp_linearIsometry A (fun y => f y) x + +omit [CompleteSpace H] in +/-- The measure-preserving L² pullback agrees with composition on Schwartz maps. -/ +theorem compMeasurePreserving_toLp (A : V ≃ₗᵢ[ℝ] V) (f : 𝓢(V, H)) : + Lp.compMeasurePreserving A A.measurePreserving (f.toLp 2 (volume : Measure V)) = + (SchwartzMap.compCLMOfContinuousLinearEquiv ℂ A.toContinuousLinearEquiv f).toLp 2 volume := by + apply Lp.ext + filter_upwards [Lp.coeFn_compMeasurePreserving (f.toLp 2 (volume : Measure V)) + A.measurePreserving, + A.measurePreserving.quasiMeasurePreserving.ae (f.coeFn_toLp 2 (volume : Measure V)), + (SchwartzMap.compCLMOfContinuousLinearEquiv ℂ A.toContinuousLinearEquiv f).coeFn_toLp 2 volume] + with x hx hf hg + rw [hx, hg] + exact hf + +/-- Fourier on L² commutes with orthogonal spatial pullback. -/ +theorem fourier_compMeasurePreserving (A : V ≃ₗᵢ[ℝ] V) + (f : Lp H 2 (volume : Measure V)) : + 𝓕 (Lp.compMeasurePreserving A A.measurePreserving f) = + Lp.compMeasurePreserving A A.measurePreserving (𝓕 f) := by + apply DenseRange.induction_on (p := fun f : Lp H 2 (volume : Measure V) => + 𝓕 (Lp.compMeasurePreserving A A.measurePreserving f) = + Lp.compMeasurePreserving A A.measurePreserving (𝓕 f)) + (SchwartzMap.denseRange_toLpCLM (E := V) (F := H) (p := 2) + (μ := (volume : Measure V)) ENNReal.ofNat_ne_top) f + · have hc : Continuous (Lp.compMeasurePreserving A A.measurePreserving : + Lp H 2 (volume : Measure V) → Lp H 2 volume) := + (Lp.compMeasurePreservingₗᵢ ℂ A A.measurePreserving).continuous + exact isClosed_eq ((Lp.fourierTransformₗᵢ V H).continuous.comp hc) + (hc.comp (Lp.fourierTransformₗᵢ V H).continuous) + · intro g + change 𝓕 (Lp.compMeasurePreserving A A.measurePreserving (g.toLp 2 volume)) = + Lp.compMeasurePreserving A A.measurePreserving (𝓕 (g.toLp 2 volume)) + rw [compMeasurePreserving_toLp, SchwartzMap.toLp_fourier_eq, fourier_comp_isometry, + SchwartzMap.toLp_fourier_eq, compMeasurePreserving_toLp] + +end LiebThirring.Fourier +end diff --git a/LeanPool/LiebThirring/Fourier/Functoriality.lean b/LeanPool/LiebThirring/Fourier/Functoriality.lean new file mode 100644 index 0000000000..e876cb593c --- /dev/null +++ b/LeanPool/LiebThirring/Fourier/Functoriality.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.Fourier.LpSpace + +/-! +# Fourier transform and bounded target maps + +Bounded target maps commute with Fourier transform. Schwartz identities extend by unweighted L² +density. +-/ + +public section + +open MeasureTheory +open scoped SchwartzMap FourierTransform + +namespace LiebThirring.Fourier + +variable {V H K : Type*} + [NormedAddCommGroup V] [InnerProductSpace ℝ V] [FiniteDimensional ℝ V] + [MeasurableSpace V] [BorelSpace V] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + [NormedAddCommGroup K] [InnerProductSpace ℂ K] [CompleteSpace K] + +/-- A bounded complex target map commutes with the Schwartz Fourier transform. -/ +theorem fourier_postcomp (L : H →L[ℂ] K) (f : 𝓢(V, H)) : + 𝓕 (f.postcompCLM L) = (𝓕 f).postcompCLM L := by + ext x + change (𝓕 (fun y => L (f y))) x = L ((𝓕 (fun y => f y)) x) + rw [Real.fourier_eq, Real.fourier_eq] + have hi := (Real.fourierIntegral_convergent_iff x).mpr (f.integrable (μ := (volume : Measure V))) + rw [← L.integral_comp_comm hi] + apply integral_congr_ae + filter_upwards with y + simp only [Circle.smul_def, map_smul] + +omit [CompleteSpace H] [CompleteSpace K] in +/-- The bounded L² target map agrees with postcomposition on Schwartz maps. -/ +theorem compLp_toLp (L : H →L[ℂ] K) (f : 𝓢(V, H)) : + L.compLp (f.toLp 2 (volume : Measure V)) = + (f.postcompCLM L).toLp 2 (volume : Measure V) := by + apply Lp.ext + filter_upwards [L.coeFn_compLp (f.toLp 2 (volume : Measure V)), + f.coeFn_toLp 2 (volume : Measure V), + (f.postcompCLM L).coeFn_toLp 2 (volume : Measure V)] with x hx hf hg + rw [hx, hf, hg, SchwartzMap.postcompCLM_apply] + +/-- Fourier on L² commutes with every bounded complex map on the target. -/ +theorem fourier_compLp (L : H →L[ℂ] K) (f : Lp H 2 (volume : Measure V)) : + 𝓕 (L.compLp f) = L.compLp (𝓕 f) := by + apply DenseRange.induction_on (p := fun f : Lp H 2 (volume : Measure V) => + 𝓕 (L.compLp f) = L.compLp (𝓕 f)) + (SchwartzMap.denseRange_toLpCLM (E := V) (F := H) (p := 2) (μ := (volume : Measure V)) + ENNReal.ofNat_ne_top) f + · exact isClosed_eq + ((Lp.fourierTransformₗᵢ V K).continuous.comp (L.compLpL 2 volume).continuous) + ((L.compLpL 2 volume).continuous.comp (Lp.fourierTransformₗᵢ V H).continuous) + · intro g + change 𝓕 (L.compLp (g.toLp 2 volume)) = L.compLp (𝓕 (g.toLp 2 volume)) + rw [compLp_toLp, SchwartzMap.toLp_fourier_eq, fourier_postcomp, + SchwartzMap.toLp_fourier_eq, compLp_toLp] + +end LiebThirring.Fourier +end diff --git a/LeanPool/LiebThirring/Fourier/IntegralL2.lean b/LeanPool/LiebThirring/Fourier/IntegralL2.lean new file mode 100644 index 0000000000..984cb0bc82 --- /dev/null +++ b/LeanPool/LiebThirring/Fourier/IntegralL2.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.Fourier.LpSpace + +/-! +# Integral and L² Fourier representatives + +The raw Bochner Fourier integral represents the L² Fourier transform for integrable L² +functions. Smooth compactly supported tests and tempered distributions identify the two +representatives. +-/ + +public section + +open MeasureTheory +open scoped FourierTransform SchwartzMap TemperedDistribution ContDiff + +namespace LiebThirring.Fourier + +variable {V H : Type*} + [NormedAddCommGroup V] [InnerProductSpace ℝ V] [FiniteDimensional ℝ V] + [MeasurableSpace V] [BorelSpace V] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- Fourier integrals commute with Schwartz test-function pairings. -/ +theorem integral_fourier_smul_eq (g : 𝓢(V, ℂ)) {f : V → H} + (hf : Integrable f) : + (∫ x, (𝓕 g) x • f x) = ∫ x, g x • (𝓕 f) x := by + simpa using! VectorFourier.integral_fourierIntegral_smul_eq_flip + (L := innerₗ V) Real.continuous_fourierChar continuous_inner g.integrable hf + +/-- Inverse Fourier integrals commute with Schwartz test-function pairings. -/ +theorem integral_fourierInv_smul_eq (g : 𝓢(V, ℂ)) {f : V → H} + (hf : Integrable f) : + (∫ x, (𝓕⁻ g) x • f x) = ∫ x, g x • (𝓕⁻ f) x := by + simpa only [SchwartzMap.fourierInv_coe, Real.fourierInv_eq, + VectorFourier.fourierIntegral, LinearMap.neg_apply, LinearMap.flip_apply, + innerₗ_apply_apply, neg_neg, real_inner_comm] using! + VectorFourier.integral_fourierIntegral_smul_eq_flip + (L := -innerₗ V) (μ := (volume : Measure V)) (ν := (volume : Measure V)) + Real.continuous_fourierChar continuous_inner.neg g.integrable hf + +/-- The raw Fourier integral agrees almost everywhere with the L² Fourier transform. -/ +theorem fourier_toLp_ae_eq {f : V → H} (hf : Integrable f) + (hf2 : MemLp f 2 (volume : Measure V)) : + ((𝓕 (hf2.toLp f) : Lp H 2 volume) : V → H) =ᵐ[volume] 𝓕 f := by + apply ae_eq_of_integral_contDiff_smul_eq + ((Lp.memLp (𝓕 (hf2.toLp f))).locallyIntegrable (by norm_num)) + (VectorFourier.fourierIntegral_continuous Real.continuous_fourierChar + (innerSL ℝ).continuous₂ hf).locallyIntegrable + intro g hg hc + have hgC : HasCompactSupport (Complex.ofRealCLM ∘ g) := hc.comp_left rfl + have hgD : ContDiff ℝ ∞ (Complex.ofRealCLM ∘ g) := by fun_prop + let G : 𝓢(V, ℂ) := hgC.toSchwartzMap hgD + have hd := congrArg (fun T : 𝓢'(V, H) => T G) + (Lp.fourier_toTemperedDistribution_eq (hf2.toLp f)) + simp only [TemperedDistribution.fourier_apply, Lp.toTemperedDistribution_apply] at hd + calc + _ = ∫ x, G x • ((𝓕 (hf2.toLp f) : Lp H 2 volume) : V → H) x := by + change (∫ x, g x • _) = ∫ x, (g x : ℂ) • _ + simp only [Complex.coe_smul] + _ = ∫ x, (𝓕 G) x • (hf2.toLp f) x := hd.symm + _ = ∫ x, (𝓕 G) x • f x := by + apply integral_congr_ae + filter_upwards [hf2.coeFn_toLp] with x hx + rw [hx] + _ = ∫ x, G x • (𝓕 f) x := integral_fourier_smul_eq G hf + _ = _ := by + change (∫ x, (g x : ℂ) • _) = ∫ x, g x • _ + simp only [Complex.coe_smul] + rfl + +/-- The raw inverse Fourier integral agrees almost everywhere with the L² inverse transform. -/ +theorem fourierInv_toLp_ae_eq {f : V → H} (hf : Integrable f) + (hf2 : MemLp f 2 (volume : Measure V)) : + ((𝓕⁻ (hf2.toLp f) : Lp H 2 volume) : V → H) =ᵐ[volume] 𝓕⁻ f := by + apply ae_eq_of_integral_contDiff_smul_eq + ((Lp.memLp (𝓕⁻ (hf2.toLp f))).locallyIntegrable (by norm_num)) + (VectorFourier.fourierIntegral_continuous Real.continuous_fourierChar + ((innerSL ℝ).continuous₂.neg) hf).locallyIntegrable + intro g hg hc + have hgC : HasCompactSupport (Complex.ofRealCLM ∘ g) := hc.comp_left rfl + have hgD : ContDiff ℝ ∞ (Complex.ofRealCLM ∘ g) := by fun_prop + let G : 𝓢(V, ℂ) := hgC.toSchwartzMap hgD + have hd := congrArg (fun T : 𝓢'(V, H) => T G) + (Lp.fourierInv_toTemperedDistribution_eq (hf2.toLp f)) + simp only [TemperedDistribution.fourierInv_apply, Lp.toTemperedDistribution_apply] at hd + calc + _ = ∫ x, G x • ((𝓕⁻ (hf2.toLp f) : Lp H 2 volume) : V → H) x := by + change (∫ x, g x • _) = ∫ x, (g x : ℂ) • _ + simp only [Complex.coe_smul] + _ = ∫ x, (𝓕⁻ G) x • (hf2.toLp f) x := hd.symm + _ = ∫ x, (𝓕⁻ G) x • f x := by + apply integral_congr_ae + filter_upwards [hf2.coeFn_toLp] with x hx + rw [hx] + _ = ∫ x, G x • (𝓕⁻ f) x := integral_fourierInv_smul_eq G hf + _ = _ := by + change (∫ x, (g x : ℂ) • _) = ∫ x, g x • _ + simp only [Complex.coe_smul] + rfl + +end LiebThirring.Fourier +end diff --git a/LeanPool/LiebThirring/Fourier/Schwartz.lean b/LeanPool/LiebThirring/Fourier/Schwartz.lean new file mode 100644 index 0000000000..1970f68ad8 --- /dev/null +++ b/LeanPool/LiebThirring/Fourier/Schwartz.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.Fourier.LpSpace + +/-! +# Schwartz Fourier identities for kinetic energy + +Extended Plancherel and the squared directional derivative formula for Schwartz functions use +Mathlib’s `exp(-2πi⟪ξ,x⟫)` convention. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal SchwartzMap FourierTransform + +namespace LiebThirring.Fourier + +variable {V H : Type*} [NormedAddCommGroup V] [InnerProductSpace ℝ V] + [FiniteDimensional ℝ V] [MeasurableSpace V] [BorelSpace V] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +omit [CompleteSpace H] in +/-- Identify the nonnegative squared-norm integral with its real integral. -/ +theorem lintegral_norm_sq_eq_ofReal_integral (f : 𝓢(V, H)) : + (∫⁻ x, (‖f x‖₊ : ℝ≥0∞) ^ 2) = ENNReal.ofReal (∫ x, ‖f x‖ ^ 2) := by + rw [ofReal_integral_eq_lintegral_ofReal + ((f.memLp 2 (volume : Measure V)).integrable_norm_pow (by decide)) + (Filter.Eventually.of_forall (fun x => sq_nonneg ‖f x‖))] + apply lintegral_congr + intro x + rw [ENNReal.ofReal_pow (norm_nonneg _), ofReal_norm] + rfl + +/-- Plancherel in nonnegative extended-integral form. -/ +theorem lintegral_norm_sq_fourier (f : 𝓢(V, H)) : + (∫⁻ x, (‖(𝓕 f) x‖₊ : ℝ≥0∞) ^ 2) = ∫⁻ x, (‖f x‖₊ : ℝ≥0∞) ^ 2 := by + rw [lintegral_norm_sq_eq_ofReal_integral, lintegral_norm_sq_eq_ofReal_integral, + SchwartzMap.integral_norm_sq_fourier] + +omit [CompleteSpace H] in +/-- The squared Fourier norm of a directional derivative, with the `2π` factor. -/ +theorem norm_sq_fourier_lineDeriv (f : 𝓢(V, H)) (m x : V) : + ‖(𝓕 (LineDeriv.lineDerivOp m f)) x‖ ^ 2 = + (2 * Real.pi) ^ 2 * (inner ℝ x m) ^ 2 * ‖(𝓕 f) x‖ ^ 2 := by + rw [SchwartzMap.fourier_lineDerivOp_eq] + have hg : (fun x : V => inner ℝ x m).HasTemperateGrowth := + ((innerSL ℝ).flip m).hasTemperateGrowth + simp only [SchwartzMap.smulLeftCLM_apply_apply hg, smul_apply, + norm_smul, norm_mul, Complex.norm_ofNat, Complex.norm_real, Complex.norm_I, + mul_one, Real.norm_eq_abs, mul_pow, sq_abs] + ring + +/-- The directional derivative energy equals its weighted Fourier integral. -/ +theorem lintegral_fderiv_eq_fourier (f : 𝓢(V, H)) (m : V) : + (∫⁻ x, (‖fderiv ℝ (fun y => f y) x m‖₊ : ℝ≥0∞) ^ 2) = + ∫⁻ x, ENNReal.ofReal ((2 * Real.pi) ^ 2) * + ENNReal.ofReal ((inner ℝ x m) ^ 2) * (‖(𝓕 f) x‖₊ : ℝ≥0∞) ^ 2 := by + calc + _ = ∫⁻ x, (‖LineDeriv.lineDerivOp m f x‖₊ : ℝ≥0∞) ^ 2 := by + simp only [SchwartzMap.lineDerivOp_apply_eq_fderiv] + _ = ∫⁻ x, (‖(𝓕 (LineDeriv.lineDerivOp m f)) x‖₊ : ℝ≥0∞) ^ 2 := + (lintegral_norm_sq_fourier _).symm + _ = _ := by + apply lintegral_congr + intro x + change ‖(𝓕 (LineDeriv.lineDerivOp m f)) x‖ₑ ^ 2 = _ + rw [← ofReal_norm] + rw [← ENNReal.ofReal_pow (norm_nonneg _), norm_sq_fourier_lineDeriv, + ENNReal.ofReal_mul (mul_nonneg (sq_nonneg _) (sq_nonneg _)), + ENNReal.ofReal_mul (sq_nonneg _), ENNReal.ofReal_pow (norm_nonneg _), ofReal_norm] + rfl + +end LiebThirring.Fourier + +end diff --git a/LeanPool/LiebThirring/Fourier/TensorDensity.lean b/LeanPool/LiebThirring/Fourier/TensorDensity.lean new file mode 100644 index 0000000000..36832a25a5 --- /dev/null +++ b/LeanPool/LiebThirring/Fourier/TensorDensity.lean @@ -0,0 +1,167 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.Distribution.SchwartzSpace.Basic +public import LeanPool.LiebThirring.Kinetic.ContractionState + +/-! +# Density of smooth one-particle tensors + +Continuous linear maps out of a finite-spin normed-space-valued `L²` space are determined by their +values on elementary tensors. + +Applying a linear isometry componentwise to the normed factor of an elementary tensor +is the same as applying it before insertion. +-/ + +public section + +open MeasureTheory +open scoped ENNReal SchwartzMap + +namespace LiebThirring + +variable {ι α H K : Type*} [Fintype ι] [MeasurableSpace α] + [NormedAddCommGroup H] [NormedSpace ℂ H] + [NormedAddCommGroup K] [NormedSpace ℂ K] + {μ : Measure α} + +/-- Continuous linear maps out of a finite-spin normed-space-valued `L²` space are +determined by their values on elementary tensors. -/ +theorem continuousLinearMap_ext_tensorInsertion + (A B : Lp (PiLp 2 (fun _ : ι => H)) 2 μ →L[ℂ] K) + (h : ∀ (f : Lp (EuclideanSpace ℂ ι) 2 μ) (v : H), + A (tensorInsertion (ι := ι) (H := H) f v) = + B (tensorInsertion (ι := ι) (H := H) f v)) : + A = B := by + classical + apply ContinuousLinearMap.ext + intro g + apply Lp.induction (p := (2 : ℝ≥0∞)) (μ := μ) (by norm_num) + (fun g => A g = B g) + · intro c s hs hμs + let f (j : ι) : Lp (EuclideanSpace ℂ ι) 2 μ := + indicatorConstLp 2 hs hμs.ne (EuclideanSpace.single j (1 : ℂ)) + have hg : Lp.simpleFunc.indicatorConst 2 hs hμs.ne c = + ∑ j : ι, tensorInsertion (ι := ι) (H := H) (f j) (c j) := by + rw [Lp.simpleFunc.coe_indicatorConst] + apply Lp.ext + have hc : ∀ᵐ x ∂μ, + (indicatorConstLp 2 hs hμs.ne c : Lp (PiLp 2 (fun _ : ι => H)) 2 μ) x = + s.indicator (fun _ => c) x := indicatorConstLp_coeFn + filter_upwards [hc, + eventually_countable_forall.mpr (fun j => + tensorInsertion_apply_ae (ι := ι) (H := H) (f j) (c j)), + eventually_countable_forall.mpr (fun j => + show ∀ᵐ x ∂μ, f j x = s.indicator + (fun _ => EuclideanSpace.single j (1 : ℂ)) x from indicatorConstLp_coeFn), + Lp.coeFn_finsetSum Finset.univ (fun j => + tensorInsertion (ι := ι) (H := H) (f j) (c j))] + with x hx ht hfi hsum + rw [hx] + rw [hsum] + apply PiLp.ext + intro k + simp only [Finset.sum_apply] + by_cases hxs : x ∈ s + · rw [Set.indicator_of_mem hxs] + simp [ht, hfi, hxs, EuclideanSpace.single] + · rw [Set.indicator_of_notMem hxs] + simp [ht, hfi, hxs, EuclideanSpace.single] + rw [hg, map_sum, map_sum] + apply Finset.sum_congr rfl + intro j _ + exact h (f j) (c j) + · intro f g hf hg hd hAf hAg + simpa only [map_add] using congrArg₂ (· + ·) hAf hAg + · exact isClosed_eq A.continuous B.continuous + +/-- Applying a linear isometry componentwise to the normed-space-valued factor of +an elementary tensor is the same as applying it before insertion. -/ +theorem piLpCongrRight_compLp_tensorInsertion + {E F : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E] + [NormedAddCommGroup F] [NormedSpace ℂ F] + (T : E ≃ₗᵢ[ℂ] F) (f : Lp (EuclideanSpace ℂ ι) 2 μ) (v : E) : + (LinearIsometryEquiv.piLpCongrRight 2 + (fun _ : ι => T)).toContinuousLinearEquiv.toContinuousLinearMap.compLp + (tensorInsertion (ι := ι) (H := E) f v) = + tensorInsertion (ι := ι) (H := F) f (T v) := by + apply Lp.ext + filter_upwards [ + (LinearIsometryEquiv.piLpCongrRight 2 + (fun _ : ι => T)).toContinuousLinearEquiv.toContinuousLinearMap.coeFn_compLp + (tensorInsertion (ι := ι) (H := E) f v), + tensorInsertion_apply_ae (ι := ι) (H := E) f v, + tensorInsertion_apply_ae (ι := ι) (H := F) f (T v)] with x hx hE hF + rw [hx] + apply PiLp.ext + intro s + change T (tensorInsertion (ι := ι) (H := E) f v x s) = + tensorInsertion (ι := ι) (H := F) f (T v) x s + rw [hE s, hF s, map_smul] + +/-- Continuous linear maps out of the state space are determined by +one-particle insertions whose two factors are Schwartz maps. -/ +theorem continuousLinearMap_ext_oneParticleInsertion_schwartz {N q : ℕ} (i : Fin N) + (A B : State N q →L[ℂ] K) + (h : ∀ (f : SchwartzMap Position (EuclideanSpace ℂ (Fin q))) + (v : SchwartzMap (OtherConfiguration i) + (EuclideanSpace ℂ (OtherSpinLabels i q))), + A (oneParticleInsertion i (f.toLp 2 volume) (v.toLp 2 volume)) = + B (oneParticleInsertion i (f.toLp 2 volume) (v.toLp 2 volume))) : + A = B := by + let C : Lp (PiLp 2 (fun _ : Fin q => RestState i q)) 2 + (volume : Measure Position) →L[ℂ] State N q := + (oneParticleCurryingLinearIsometryEquiv (q := q) i).symm.toContinuousLinearEquiv + |>.toContinuousLinearMap + have hAB : A.comp C = B.comp C := by + apply continuousLinearMap_ext_tensorInsertion + intro f v + have hv : A (oneParticleInsertion i f v) = B (oneParticleInsertion i f v) := by + apply DenseRange.induction_on + (p := fun v : RestState i q => + A (oneParticleInsertion i f v) = B (oneParticleInsertion i f v)) + (SchwartzMap.denseRange_toLpCLM + (E := OtherConfiguration i) (F := EuclideanSpace ℂ (OtherSpinLabels i q)) + (p := 2) (μ := (volume : Measure (OtherConfiguration i))) ENNReal.ofNat_ne_top) v + · exact isClosed_eq (A.continuous.comp (oneParticleInsertion i f).continuous) + (B.continuous.comp (oneParticleInsertion i f).continuous) + · intro w + apply DenseRange.induction_on + (p := fun f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position) => + A (oneParticleInsertion i f (w.toLp 2 volume)) = + B (oneParticleInsertion i f (w.toLp 2 volume))) + (SchwartzMap.denseRange_toLpCLM + (E := Position) (F := EuclideanSpace ℂ (Fin q)) (p := 2) + (μ := (volume : Measure Position)) ENNReal.ofNat_ne_top) f + · let J : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position) →L[ℂ] + Lp (PiLp 2 (fun _ : Fin q => RestState i q)) 2 volume := + (tensorInsertionBilinear (ι := Fin q) (H := RestState i q)).compLpL₂ + 2 volume (w.toLp 2 volume) + exact isClosed_eq (A.continuous.comp (C.continuous.comp J.continuous)) + (B.continuous.comp (C.continuous.comp J.continuous)) + · intro g + exact h g w + exact hv + apply ContinuousLinearMap.ext + intro ψ + have hψ := congrArg (fun T : + Lp (PiLp 2 (fun _ : Fin q => RestState i q)) 2 volume →L[ℂ] K => + T (oneParticleCurryingLinearIsometryEquiv i ψ)) hAB + change A (C (oneParticleCurryingLinearIsometryEquiv i ψ)) = + B (C (oneParticleCurryingLinearIsometryEquiv i ψ)) at hψ + have hc : C (oneParticleCurryingLinearIsometryEquiv i ψ) = ψ := + (oneParticleCurryingLinearIsometryEquiv i).symm_apply_apply ψ + rw [hc] at hψ + exact hψ + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Imports.lean b/LeanPool/LiebThirring/Imports.lean new file mode 100644 index 0000000000..bea8496d44 --- /dev/null +++ b/LeanPool/LiebThirring/Imports.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2026 Lean Pool contributors. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Lean Pool contributors +-/ +module -- shake: keep-all --deprecated_module: ignore + +-- Generated project imports; run `lake exe mk_all`. +public import LeanPool.LiebThirring +public import LeanPool.LiebThirring.Analysis.FundamentalSolution +public import LeanPool.LiebThirring.Analysis.FundamentalSolutionApproximation +public import LeanPool.LiebThirring.Analysis.FundamentalSolutionIntegrability +public import LeanPool.LiebThirring.Analysis.FundamentalSolutionIntegrationByParts +public import LeanPool.LiebThirring.Analysis.FundamentalSolutionLimits +public import LeanPool.LiebThirring.Analysis.FundamentalSolutionMeasures +public import LeanPool.LiebThirring.Analysis.FundamentalSolutionRadial +public import LeanPool.LiebThirring.Analysis.FundamentalSolutionRegularization +public import LeanPool.LiebThirring.Analysis.Hardy +public import LeanPool.LiebThirring.Analysis.HardyApproximation +public import LeanPool.LiebThirring.Analysis.HardyRegularized +public import LeanPool.LiebThirring.Analysis.HardySchwartz +public import LeanPool.LiebThirring.Analysis.MaximumPrinciple +public import LeanPool.LiebThirring.Analysis.WeakHarmonic +public import LeanPool.LiebThirring.Analysis.WeakHarmonicConvolution +public import LeanPool.LiebThirring.Analysis.WeakHarmonicDecay +public import LeanPool.LiebThirring.Analysis.WeakHarmonicRegularization +public import LeanPool.LiebThirring.Assembly.Coulomb +public import LeanPool.LiebThirring.Assembly.Cutoff +public import LeanPool.LiebThirring.Assembly.CutoffRadial +public import LeanPool.LiebThirring.Assembly.FiniteAveraging +public import LeanPool.LiebThirring.Assembly.IntegratedBaxter +public import LeanPool.LiebThirring.Assembly.NuclearReindex +public import LeanPool.LiebThirring.Assembly.RealForm +public import LeanPool.LiebThirring.Assembly.RealFormCurrying +public import LeanPool.LiebThirring.Assembly.RealFormPairs +public import LeanPool.LiebThirring.Assembly.RealFormSlices +public import LeanPool.LiebThirring.Assembly.RealFormStability +public import LeanPool.LiebThirring.Assembly.RuminIntegral +public import LeanPool.LiebThirring.Assembly.Screening +public import LeanPool.LiebThirring.Assembly.Stability +public import LeanPool.LiebThirring.Assembly.WeakBaxter +public import LeanPool.LiebThirring.Assembly.Young +public import LeanPool.LiebThirring.Defs.Antisymmetric +public import LeanPool.LiebThirring.Defs.Configuration +public import LeanPool.LiebThirring.Defs.Coulomb +public import LeanPool.LiebThirring.Defs.Density +public import LeanPool.LiebThirring.Defs.KineticEnergy +public import LeanPool.LiebThirring.Defs.RuminConstant +public import LeanPool.LiebThirring.Defs.State +public import LeanPool.LiebThirring.Electrostatics.Basic +public import LeanPool.LiebThirring.Electrostatics.Collisions +public import LeanPool.LiebThirring.Electrostatics.CoulombPositivity +public import LeanPool.LiebThirring.Electrostatics.CoulombPositivityKernel +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficit +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitBoundary +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitFlux +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitFluxCutoff +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitFluxExtension +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitFluxField +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitFluxPlane +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitFluxVolume +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitGeometry +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitHalfSpace +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitHalfSpaceRadial +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitIdentity +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitIntegrability +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitLimits +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitLowerBound +public import LeanPool.LiebThirring.Electrostatics.EnergyDeficitTrivial +public import LeanPool.LiebThirring.Electrostatics.FaceMeasure +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureBasic +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureBounds +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureDecay +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureDensityDecay +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureDirected +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureDirectedPairs +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureGeometry +public import LeanPool.LiebThirring.Electrostatics.FaceMeasureMass +public import LeanPool.LiebThirring.Electrostatics.FaceMeasurePlaneMass +public import LeanPool.LiebThirring.Electrostatics.FaceMeasurePlaneMassRadial +public import LeanPool.LiebThirring.Electrostatics.FaceMeasurePotential +public import LeanPool.LiebThirring.Electrostatics.Gaussian +public import LeanPool.LiebThirring.Electrostatics.Newton +public import LeanPool.LiebThirring.Electrostatics.NewtonConsequences +public import LeanPool.LiebThirring.Electrostatics.NewtonIntegral +public import LeanPool.LiebThirring.Electrostatics.Plane +public import LeanPool.LiebThirring.Electrostatics.PlaneCofactor +public import LeanPool.LiebThirring.Electrostatics.PlaneDistance +public import LeanPool.LiebThirring.Electrostatics.PlaneFormula +public import LeanPool.LiebThirring.Electrostatics.PlaneLocal +public import LeanPool.LiebThirring.Electrostatics.PlanePolar +public import LeanPool.LiebThirring.Electrostatics.PlaneProjection +public import LeanPool.LiebThirring.Electrostatics.PlaneRadialIntegral +public import LeanPool.LiebThirring.Electrostatics.PotentialIdentity +public import LeanPool.LiebThirring.Electrostatics.PotentialIdentityAssembly +public import LeanPool.LiebThirring.Electrostatics.Screened +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityBasic +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityBounds +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityCells +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityCoulomb +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityExtension +public import LeanPool.LiebThirring.Electrostatics.ScreenedRegularityIntegrability +public import LeanPool.LiebThirring.Electrostatics.ShellAssembly +public import LeanPool.LiebThirring.Electrostatics.ShellAssemblyEnergy +public import LeanPool.LiebThirring.Electrostatics.ShellAssemblyGeometry +public import LeanPool.LiebThirring.Electrostatics.Slicing +public import LeanPool.LiebThirring.Electrostatics.SlicingCellGeometry +public import LeanPool.LiebThirring.Electrostatics.SlicingCellIntegral +public import LeanPool.LiebThirring.Electrostatics.SlicingCoordinates +public import LeanPool.LiebThirring.Electrostatics.SlicingDirectional +public import LeanPool.LiebThirring.Electrostatics.SlicingDivergence +public import LeanPool.LiebThirring.Electrostatics.SlicingExceptional +public import LeanPool.LiebThirring.Electrostatics.SlicingFaceIntegrals +public import LeanPool.LiebThirring.Electrostatics.SlicingGreen +public import LeanPool.LiebThirring.Electrostatics.SlicingIntervals +public import LeanPool.LiebThirring.Electrostatics.SlicingJump +public import LeanPool.LiebThirring.Electrostatics.SlicingLines +public import LeanPool.LiebThirring.Electrostatics.SlicingScalar +public import LeanPool.LiebThirring.Electrostatics.SlicingScalarBoundary +public import LeanPool.LiebThirring.Electrostatics.SlicingScreenedCells +public import LeanPool.LiebThirring.Electrostatics.SlicingScreenedFaces +public import LeanPool.LiebThirring.Electrostatics.Sphere +public import LeanPool.LiebThirring.Electrostatics.SphereAngular +public import LeanPool.LiebThirring.Electrostatics.SphereCap +public import LeanPool.LiebThirring.Electrostatics.SphereRadial +public import LeanPool.LiebThirring.Electrostatics.SphereRealMarginal +public import LeanPool.LiebThirring.Electrostatics.SquareCompletion +public import LeanPool.LiebThirring.Electrostatics.VoronoiBasic +public import LeanPool.LiebThirring.Electrostatics.VoronoiBoundary +public import LeanPool.LiebThirring.Electrostatics.VoronoiDistance +public import LeanPool.LiebThirring.Electrostatics.VoronoiStrata +public import LeanPool.LiebThirring.Fourier.ContractionFourier +public import LeanPool.LiebThirring.Fourier.Covariance +public import LeanPool.LiebThirring.Fourier.Functoriality +public import LeanPool.LiebThirring.Fourier.IntegralL2 +public import LeanPool.LiebThirring.Fourier.Schwartz +public import LeanPool.LiebThirring.Fourier.TensorDensity +public import LeanPool.LiebThirring.Kinetic.ContractionExchange +public import LeanPool.LiebThirring.Kinetic.ContractionExchangeEncoding +public import LeanPool.LiebThirring.Kinetic.ContractionFactors +public import LeanPool.LiebThirring.Kinetic.ContractionIntegral +public import LeanPool.LiebThirring.Kinetic.ContractionProjectionTransport +public import LeanPool.LiebThirring.Kinetic.ContractionRestCurrying +public import LeanPool.LiebThirring.Kinetic.ContractionRestEncoding +public import LeanPool.LiebThirring.Kinetic.ContractionState +public import LeanPool.LiebThirring.Kinetic.ContractionTensor +public import LeanPool.LiebThirring.Kinetic.Currying +public import LeanPool.LiebThirring.Kinetic.CurryingDensity +public import LeanPool.LiebThirring.Kinetic.CurryingExchange +public import LeanPool.LiebThirring.Kinetic.CurryingFinite +public import LeanPool.LiebThirring.Kinetic.CurryingMarginal +public import LeanPool.LiebThirring.Kinetic.CurryingMeasurable +public import LeanPool.LiebThirring.Kinetic.CurryingProduct +public import LeanPool.LiebThirring.Kinetic.CurryingProductBasic +public import LeanPool.LiebThirring.Kinetic.CurryingProductMap +public import LeanPool.LiebThirring.Kinetic.CurryingProductSurjective +public import LeanPool.LiebThirring.Kinetic.CurryingState +public import LeanPool.LiebThirring.Kinetic.CurryingTransport +public import LeanPool.LiebThirring.Kinetic.Cutoff +public import LeanPool.LiebThirring.Kinetic.CutoffProjection +public import LeanPool.LiebThirring.Kinetic.DensityBasic +public import LeanPool.LiebThirring.Kinetic.Encoding +public import LeanPool.LiebThirring.Kinetic.FourierFactor +public import LeanPool.LiebThirring.Kinetic.FourierFactorCurrying +public import LeanPool.LiebThirring.Kinetic.FourierFactorDensity +public import LeanPool.LiebThirring.Kinetic.FourierFactorIdentity +public import LeanPool.LiebThirring.Kinetic.FourierFactorTensor +public import LeanPool.LiebThirring.Kinetic.Insertion +public import LeanPool.LiebThirring.Kinetic.KineticLT +public import LeanPool.LiebThirring.Kinetic.KineticLTVacuum +public import LeanPool.LiebThirring.Kinetic.LayerCakeBasic +public import LeanPool.LiebThirring.Kinetic.LayerCakeBounds +public import LeanPool.LiebThirring.Kinetic.LayerCakeIdentity +public import LeanPool.LiebThirring.Kinetic.LayerCakeMass +public import LeanPool.LiebThirring.Kinetic.LowMomentumBound +public import LeanPool.LiebThirring.Kinetic.LowMomentumFormula +public import LeanPool.LiebThirring.Kinetic.LowMomentumTest +public import LeanPool.LiebThirring.Kinetic.PauliAbstract +public import LeanPool.LiebThirring.Kinetic.PauliDoubleInsertion +public import LeanPool.LiebThirring.Kinetic.PauliLiftCurrying +public import LeanPool.LiebThirring.Kinetic.PauliLiftEncoding +public import LeanPool.LiebThirring.Kinetic.PauliLiftIntertwining +public import LeanPool.LiebThirring.Kinetic.PauliLiftProjections +public import LeanPool.LiebThirring.Kinetic.PauliOccupation +public import LeanPool.LiebThirring.Kinetic.PauliScaling +public import LeanPool.LiebThirring.Kinetic.PauliStateConditional +public import LeanPool.LiebThirring.Kinetic.Permutation +public import LeanPool.LiebThirring.Kinetic.RuminCoefficient +public import LeanPool.LiebThirring.Kinetic.RuminIntegration +public import LeanPool.LiebThirring.Theorems.Baxter +public import LeanPool.LiebThirring.Theorems.KineticEnergySchwartz +public import LeanPool.LiebThirring.Theorems.KineticLiebThirring +public import LeanPool.LiebThirring.Theorems.StabilityOfMatter +public import LeanPool.LiebThirring.Theorems.StabilityOfMatterReal diff --git a/LeanPool/LiebThirring/Kinetic/ContractionExchange.lean b/LeanPool/LiebThirring/Kinetic/ContractionExchange.lean new file mode 100644 index 0000000000..94b98f787a --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/ContractionExchange.lean @@ -0,0 +1,104 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.ContractionExchangeEncoding + +/-! # Exchange covariance of one-particle insertion + +The concrete insertion maps intertwine simultaneous exchange with the +remaining-coordinate unitary. Pairing with an antisymmetric state then gives +equality of contraction norms across particle coordinates. +-/ + +public section + +open MeasureTheory +open scoped InnerProduct + +namespace LiebThirring + +/-- Exchanging particles transports insertion into the exchanged coordinate. -/ +theorem simultaneousPermutation_oneParticleInsertion {N q : ℕ} (i j : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) + (v : RestState i q) : + simultaneousPermutation (Equiv.swap i j) (oneParticleInsertion i f v) = + oneParticleInsertion j f (restExchange i j v) := by + apply (oneParticleCurrying j).injective + apply Lp.ext + have hu := Measure.ae_ae_of_ae_prod ((measurePreserving_insertParticle + j).quasiMeasurePreserving.ae + (simultaneousPermutation_apply_ae (Equiv.swap i j) (oneParticleInsertion i f v))) + filter_upwards [oneParticleCurrying_ae j + (simultaneousPermutation (Equiv.swap i j) (oneParticleInsertion i f v)), + oneParticleCurrying_ae j (oneParticleInsertion j f (restExchange i j v)), + hu, oneParticleInsertion_ae i f v, oneParticleInsertion_ae j f (restExchange i j v)] + with x hc hd hx hi hj + apply PiLp.ext + intro s + apply Lp.ext + have hit := (restExchangeSpatial i j).measurePreserving.quasiMeasurePreserving.ae (hi s) + filter_upwards [hc s, hd s, hx, hit, hj s, restExchange_ae i j v] + with y hcy hdy hxy hiy hjy hrv + ext t + rw [hcy t, hdy t, hxy, permutePositions_swap_insertParticle, + permuteSpins_swap_insertSpin, hiy, hjy, hrv] + +/-- On an antisymmetric state, exchange identifies the contracted vectors up to +sign and the remaining-coordinate unitary. -/ +theorem oneParticleContraction_exchange {N q : ℕ} (i j : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) + (ψ : State N q) (hψ : antisymmetric ψ) (hij : i ≠ j) : + oneParticleContraction j f ψ = -restExchange i j (oneParticleContraction i f ψ) := by + apply ext_inner_left ℂ + intro w + let v := (restExchange i j).symm w + have hw : restExchange i j v = w := (restExchange i j).apply_symm_apply w + rw [← hw] + have hu : statePermutationLinearIsometryEquiv (Equiv.swap i j) ψ = -ψ := + simultaneousPermutation_swap_eq_neg ψ hψ i j hij + calc + inner ℂ (restExchange i j v) (oneParticleContraction j f ψ) = + inner ℂ (oneParticleInsertion j f (restExchange i j v)) ψ := by + rw [← oneParticleInsertion_adjoint, ContinuousLinearMap.adjoint_inner_right] + _ = inner ℂ (statePermutationLinearIsometryEquiv (Equiv.swap i j) + (oneParticleInsertion i f v)) ψ := by + rw [statePermutationLinearIsometryEquiv_apply, simultaneousPermutation_oneParticleInsertion] + _ = -inner ℂ (oneParticleInsertion i f v) ψ := by + have h := (statePermutationLinearIsometryEquiv (q := q) (Equiv.swap i j)).inner_map_map + (oneParticleInsertion i f v) ψ + rw [hu, inner_neg_right] at h + exact neg_eq_iff_eq_neg.mp h + _ = -inner ℂ v (oneParticleContraction i f ψ) := by + rw [← oneParticleInsertion_adjoint, ContinuousLinearMap.adjoint_inner_right] + _ = inner ℂ (restExchange i j v) + (-restExchange i j (oneParticleContraction i f ψ)) := by + rw [inner_neg_right, LinearIsometryEquiv.inner_map_map] + +/-- The concrete contraction norms agree across all particle coordinates. -/ +theorem oneParticleContraction_norm_eq {N q : ℕ} (i j : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) + (ψ : State N q) (hψ : antisymmetric ψ) : + ‖oneParticleContraction j f ψ‖ = ‖oneParticleContraction i f ψ‖ := by + by_cases hij : i = j + · subst j + rfl + rw [oneParticleContraction_exchange i j f ψ hψ hij, norm_neg, LinearIsometryEquiv.norm_map] + +/-- Equality of unit-vector projection norms on an antisymmetric state. -/ +theorem oneParticleProjection_norm_eq {N q : ℕ} (i j : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) (hf : ‖f‖ = 1) + (ψ : State N q) (hψ : antisymmetric ψ) : + ‖oneParticleProjection j f ψ‖ = ‖oneParticleProjection i f ψ‖ := by + rw [oneParticleProjection_norm j f hf, oneParticleProjection_norm i f hf] + exact oneParticleContraction_norm_eq i j f ψ hψ + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/ContractionExchangeEncoding.lean b/LeanPool/LiebThirring/Kinetic/ContractionExchangeEncoding.lean new file mode 100644 index 0000000000..2b4ec6b46f --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/ContractionExchangeEncoding.lean @@ -0,0 +1,125 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.ContractionState +public import LeanPool.LiebThirring.Kinetic.CurryingExchange + +/-! # Remaining-coordinate transport under particle exchange + +The transposition between two particle labels bijects their complementary +spatial and spin labels. This is the concrete unitary needed to compare +one-particle contractions in different coordinates. +-/ + +public section + +open MeasureTheory WithLp + +namespace LiebThirring + +/-- Exchange bijects the indices complementary to its two distinguished labels. -/ +@[expose] def restExchangeIndexEquiv {N : ℕ} (i j : Fin N) : + {k : Fin N // k ≠ i} ≃ {k : Fin N // k ≠ j} where + toFun k := ⟨Equiv.swap i j k, by + intro h + have := (Equiv.swap_apply_eq_iff.mp h) + simp only [Equiv.swap_apply_right] at this + exact k.property this⟩ + invFun k := ⟨Equiv.swap i j k, by + intro h + have := (Equiv.swap_apply_eq_iff.mp h) + simp only [Equiv.swap_apply_left] at this + exact k.property this⟩ + left_inv k := by ext; simp + right_inv k := by ext; simp + +/-- Spatial exchange on the remaining coordinates. -/ +@[expose] noncomputable def restExchangeSpatial {N : ℕ} (i j : Fin N) : + OtherConfiguration j ≃ₗᵢ[ℝ] OtherConfiguration i := + LinearIsometryEquiv.piLpCongrLeft 2 ℝ ℝ + ((restExchangeIndexEquiv i j).symm.prodCongr (Equiv.refl (Fin 3))) + +/-- Spin exchange on the remaining labels. -/ +@[expose] def restExchangeSpins {N q : ℕ} (i j : Fin N) : + OtherSpinLabels i q ≃ OtherSpinLabels j q := + Equiv.piCongrLeft (fun _ : {k : Fin N // k ≠ j} => Fin q) + (restExchangeIndexEquiv i j) + +/-- Spin-amplitude transport on the remaining labels. -/ +@[expose] noncomputable def restExchangeAmplitudes {N q : ℕ} (i j : Fin N) : + EuclideanSpace ℂ (OtherSpinLabels i q) ≃ₗᵢ[ℂ] + EuclideanSpace ℂ (OtherSpinLabels j q) := + LinearIsometryEquiv.piLpCongrLeft 2 ℂ ℂ (restExchangeSpins i j) + +/-- The remaining-state unitary induced by particle exchange. -/ +@[expose] noncomputable def restExchange {N q : ℕ} (i j : Fin N) : + RestState i q ≃ₗᵢ[ℂ] RestState j q := + (l2PullbackEquiv (restExchangeSpatial i j).toHomeomorph.toMeasurableEquiv + (restExchangeSpatial i j).measurePreserving).trans + (l2TargetEquiv (volume : Measure (OtherConfiguration j)) (restExchangeAmplitudes i j)) + +/-- Remaining spatial exchange intertwines the two insertion maps. -/ +theorem permutePositions_swap_insertParticle {N : ℕ} (i j : Fin N) + (x : Position) (y : OtherConfiguration j) : + permutePositions (Equiv.swap i j) (insertParticle j x y) = + insertParticle i x (restExchangeSpatial i j y) := by + ext ka + rcases ka with ⟨k, a⟩ + change (if h : Equiv.swap i j k = j then x a else y (⟨Equiv.swap i j k, h⟩, a)) = + (if h : k = i then x a else restExchangeSpatial i j y (⟨k, h⟩, a)) + by_cases hk : k = i + · subst k + simp + have hs : Equiv.swap i j k ≠ j := by + intro h + exact hk (by simpa only [Equiv.swap_apply_right] using (Equiv.swap_apply_eq_iff.mp h)) + simp only [hk, hs, ↓reduceDIte] + rfl + +/-- Remaining spin exchange intertwines the two spin insertions. -/ +theorem permuteSpins_swap_insertSpin {N q : ℕ} (i j : Fin N) (s : Fin q) + (t : OtherSpinLabels j q) : + permuteSpins (Equiv.swap i j) (insertSpin j s t) = + insertSpin i s ((restExchangeSpins i j).symm t) := by + funext k + change (if h : Equiv.swap i j k = j then s else t ⟨Equiv.swap i j k, h⟩) = + (if h : k = i then s else (restExchangeSpins i j).symm t ⟨k, h⟩) + by_cases hk : k = i + · subst k + simp + have hs : Equiv.swap i j k ≠ j := by + intro h + exact hk (by simpa only [Equiv.swap_apply_right] using (Equiv.swap_apply_eq_iff.mp h)) + simp only [hk, hs, ↓reduceDIte] + rfl + +/-- Exact representative of the remaining-state exchange unitary. -/ +theorem restExchange_ae {N q : ℕ} (i j : Fin N) (v : RestState i q) : + ∀ᵐ y : OtherConfiguration j, ∀ t : OtherSpinLabels j q, + restExchange i j v y t = + v (restExchangeSpatial i j y) ((restExchangeSpins i j).symm t) := by + let A := l2PullbackEquiv (E := EuclideanSpace ℂ (OtherSpinLabels i q)) + (restExchangeSpatial i j).toHomeomorph.toMeasurableEquiv + (restExchangeSpatial i j).measurePreserving + filter_upwards [l2PullbackEquiv_ae + (restExchangeSpatial i j).toHomeomorph.toMeasurableEquiv + (restExchangeSpatial i j).measurePreserving v, + l2TargetEquiv_ae (volume : Measure (OtherConfiguration j)) + (restExchangeAmplitudes i j) (A v)] with y ha hb + intro t + change l2TargetEquiv (volume : Measure (OtherConfiguration j)) + (restExchangeAmplitudes i j) (A v) y t = _ + rw [hb, ha] + rfl + + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/ContractionFactors.lean b/LeanPool/LiebThirring/Kinetic/ContractionFactors.lean new file mode 100644 index 0000000000..0d9d6f8e36 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/ContractionFactors.lean @@ -0,0 +1,262 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.ContractionTensor + +/-! # Operators acting on two finite-spin L² factors + +This module lifts a bounded operator pointwise through a finite-spin `L²` factor. It uses +that lift to construct the two tensor insertions and proves that their projection products +commute and equal the projection generated by double insertion. +-/ + +public section + +open MeasureTheory WithLp +open scoped InnerProduct + +namespace LiebThirring + +variable {ι α E F : Type*} [Fintype ι] [MeasurableSpace α] + [NormedAddCommGroup E] [NormedAddCommGroup F] + {μ : Measure α} + +section Normed + +variable [NormedSpace ℂ E] [NormedSpace ℂ F] + +/-- Apply a bounded complex linear operator to each finite-spin amplitude. -/ +@[expose] noncomputable def piLpMap (T : E →L[ℂ] F) : + PiLp 2 (fun _ : ι => E) →L[ℂ] PiLp 2 (fun _ : ι => F) := + ({ toFun := fun u => toLp 2 (fun s => T (u s)) + map_add' := fun u v => by ext s; change T (u s + v s) = T (u s) + T (v s); rw [map_add] + map_smul' := fun c u => by ext s; change T (c • u s) = c • T (u s); rw [map_smul] } : + PiLp 2 (fun _ : ι => E) →ₗ[ℂ] PiLp 2 (fun _ : ι => F)).mkContinuous ‖T‖ (fun u => by + apply (sq_le_sq₀ (norm_nonneg _) (mul_nonneg (norm_nonneg T) (norm_nonneg u))).mp + rw [PiLp.norm_sq_eq_of_L2, mul_pow, PiLp.norm_sq_eq_of_L2] + calc + ∑ s : ι, ‖T (u s)‖ ^ 2 ≤ ∑ s : ι, (‖T‖ * ‖u s‖) ^ 2 := + Finset.sum_le_sum fun s _ => + (sq_le_sq₀ (norm_nonneg _) (mul_nonneg (norm_nonneg T) (norm_nonneg _))).mpr + (T.le_opNorm _) + _ = ‖T‖ ^ 2 * ∑ s : ι, ‖u s‖ ^ 2 := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro s _ + ring + _ = _ := rfl + ) + +/-- Lift a bounded operator through the finite-spin L² space pointwise. -/ +@[expose] noncomputable def tensorTargetLift (T : E →L[ℂ] F) : + Lp (PiLp 2 (fun _ : ι => E)) 2 μ →L[ℂ] + Lp (PiLp 2 (fun _ : ι => F)) 2 μ := + (piLpMap (ι := ι) T).compLpL 2 μ + +theorem tensorTargetLift_apply_ae (T : E →L[ℂ] F) + (u : Lp (PiLp 2 (fun _ : ι => E)) 2 μ) : + ∀ᵐ x ∂μ, ∀ s : ι, tensorTargetLift T u x s = T (u x s) := by + filter_upwards [(piLpMap (ι := ι) T).coeFn_compLp' u] with x hx + intro s + change ((piLpMap (ι := ι) T).compLp u) x s = T (u x s) + exact congrArg (fun z : PiLp 2 (fun _ : ι => F) => z s) hx + +theorem tensorTargetLift_comp_tensorInsertion + (T : E →L[ℂ] F) (f : Lp (EuclideanSpace ℂ ι) 2 μ) : + tensorTargetLift (ι := ι) (μ := μ) T ∘L tensorInsertion (H := E) f = + tensorInsertion (H := F) f ∘L T := by + apply ContinuousLinearMap.ext + intro v + apply Lp.ext + filter_upwards [tensorTargetLift_apply_ae (ι := ι) T (tensorInsertion (H := E) f v), + tensorInsertion_apply_ae (H := E) f v, + tensorInsertion_apply_ae (H := F) f (T v)] with x hl hi hr + apply PiLp.ext + intro s + change tensorTargetLift (ι := ι) (μ := μ) T (tensorInsertion (H := E) f v) x s = + tensorInsertion (H := F) f (T v) x s + rw [hl s, hi s, hr s, map_smul] + +end Normed + +section Complete + +variable [InnerProductSpace ℂ E] [InnerProductSpace ℂ F] + [CompleteSpace E] [CompleteSpace F] + +theorem piLpMap_adjoint (T : E →L[ℂ] F) : + (piLpMap (ι := ι) T).adjoint = piLpMap (ι := ι) T.adjoint := by + apply ContinuousLinearMap.ext + intro u + apply ext_inner_right ℂ + intro v + rw [ContinuousLinearMap.adjoint_inner_left] + simp only [PiLp.inner_apply] + apply Finset.sum_congr rfl + intro s _ + exact (ContinuousLinearMap.adjoint_inner_left T (v s) (u s)).symm + +theorem tensorTargetLift_adjoint (T : E →L[ℂ] F) : + (tensorTargetLift (ι := ι) (μ := μ) T).adjoint = + tensorTargetLift (ι := ι) (μ := μ) T.adjoint := by + apply ContinuousLinearMap.ext + intro u + apply ext_inner_right ℂ + intro v + rw [ContinuousLinearMap.adjoint_inner_left] + simp only [MeasureTheory.L2.inner_def] + apply integral_congr_ae + filter_upwards [tensorTargetLift_apply_ae (ι := ι) T.adjoint u, + tensorTargetLift_apply_ae (ι := ι) T v] with x hu hv + rw [show tensorTargetLift (ι := ι) (μ := μ) T.adjoint u x = + piLpMap (ι := ι) T.adjoint (u x) by ext s; exact hu s] + rw [show tensorTargetLift (ι := ι) (μ := μ) T v x = + piLpMap (ι := ι) T (v x) by ext s; exact hv s] + rw [← piLpMap_adjoint] + exact (ContinuousLinearMap.adjoint_inner_left + (piLpMap (ι := ι) T) (v x) (u x)).symm + +end Complete + +section Factors + +variable {H : Type*} [NormedAddCommGroup H] + +/-- The L² carrier of one finite-spin factor over the residual measure. -/ +noncomputable abbrev FirstFactorSpace (ι α H : Type*) [Fintype ι] [MeasurableSpace α] + [NormedAddCommGroup H] (μ : Measure α) : Type _ := + Lp (PiLp 2 (fun _ : ι => H)) 2 μ + +/-- The nested L² carrier of two finite-spin factors over the residual measure. -/ +noncomputable abbrev SecondFactorSpace (ι α H : Type*) [Fintype ι] [MeasurableSpace α] + [NormedAddCommGroup H] (μ : Measure α) : Type _ := + Lp (PiLp 2 (fun _ : ι => FirstFactorSpace ι α H μ)) 2 μ + +section NormedFactors + +variable [NormedSpace ℂ H] + +/-- Insert a wavefunction into the outer finite-spin L² factor. -/ +@[expose] noncomputable def firstFactorInsertion + (f : Lp (EuclideanSpace ℂ ι) 2 μ) : + FirstFactorSpace ι α H μ →L[ℂ] SecondFactorSpace ι α H μ := + tensorInsertion (H := FirstFactorSpace ι α H μ) f + +/-- Insert a wavefunction into the inner finite-spin L² factor. -/ +@[expose] noncomputable def secondFactorInsertion + (f : Lp (EuclideanSpace ℂ ι) 2 μ) : + FirstFactorSpace ι α H μ →L[ℂ] SecondFactorSpace ι α H μ := + tensorTargetLift (ι := ι) (μ := μ) (tensorInsertion (H := H) f) + +/-- Insert the same wavefunction into both finite-spin L² factors. -/ +@[expose] noncomputable def doubleFactorInsertion + (f : Lp (EuclideanSpace ℂ ι) 2 μ) : + H →L[ℂ] SecondFactorSpace ι α H μ := + (firstFactorInsertion (H := H) f).comp (tensorInsertion (H := H) f) + +theorem secondFactorInsertion_comp_tensorInsertion + (f : Lp (EuclideanSpace ℂ ι) 2 μ) : + secondFactorInsertion (H := H) f ∘L tensorInsertion (H := H) f = + doubleFactorInsertion (H := H) f := by + exact tensorTargetLift_comp_tensorInsertion (ι := ι) (μ := μ) + (E := H) (F := FirstFactorSpace ι α H μ) (tensorInsertion (H := H) f) f + +end NormedFactors + +variable [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- The operator obtained by composing outer insertion with its adjoint. -/ +@[expose] noncomputable def firstFactorProjection + (f : Lp (EuclideanSpace ℂ ι) 2 μ) : + SecondFactorSpace ι α H μ →L[ℂ] SecondFactorSpace ι α H μ := + (firstFactorInsertion (H := H) f).comp (firstFactorInsertion (H := H) f).adjoint + +/-- The operator obtained by composing inner insertion with its adjoint. -/ +@[expose] noncomputable def secondFactorProjection + (f : Lp (EuclideanSpace ℂ ι) 2 μ) : + SecondFactorSpace ι α H μ →L[ℂ] SecondFactorSpace ι α H μ := + (secondFactorInsertion (H := H) f).comp (secondFactorInsertion (H := H) f).adjoint + +theorem secondFactorInsertion_adjoint + (f : Lp (EuclideanSpace ℂ ι) 2 μ) : + (secondFactorInsertion (H := H) f).adjoint = + tensorTargetLift (ι := ι) (μ := μ) (tensorInsertion (H := H) f).adjoint := by + exact tensorTargetLift_adjoint (ι := ι) (μ := μ) + (E := H) (F := FirstFactorSpace ι α H μ) (tensorInsertion (H := H) f) + +theorem secondFactorInsertion_adjoint_comp_firstFactorInsertion + (f : Lp (EuclideanSpace ℂ ι) 2 μ) : + (secondFactorInsertion (H := H) f).adjoint ∘L firstFactorInsertion (H := H) f = + tensorInsertion (H := H) f ∘L (tensorInsertion (H := H) f).adjoint := by + rw [secondFactorInsertion_adjoint] + exact tensorTargetLift_comp_tensorInsertion (tensorInsertion (H := H) f).adjoint f + +theorem firstFactorInsertion_adjoint_comp_secondFactorInsertion + (f : Lp (EuclideanSpace ℂ ι) 2 μ) : + (firstFactorInsertion (H := H) f).adjoint ∘L secondFactorInsertion (H := H) f = + tensorInsertion (H := H) f ∘L (tensorInsertion (H := H) f).adjoint := by + have h := congrArg ContinuousLinearMap.adjoint + (secondFactorInsertion_adjoint_comp_firstFactorInsertion (H := H) f) + simpa only [ContinuousLinearMap.adjoint_comp, ContinuousLinearMap.adjoint_adjoint] using h + +theorem operator_projection_product_first {H X Y : Type*} + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + [NormedAddCommGroup X] [InnerProductSpace ℂ X] [CompleteSpace X] + [NormedAddCommGroup Y] [InnerProductSpace ℂ Y] [CompleteSpace Y] + (A : X →L[ℂ] Y) (B : H →L[ℂ] X) (J : X →L[ℂ] Y) + (hcross : A.adjoint ∘L J = B ∘L B.adjoint) + (hcomm : J ∘L B = A ∘L B) : + (A ∘L A.adjoint) ∘L (J ∘L J.adjoint) = + (A ∘L B) ∘L (A ∘L B).adjoint := by + have hadj := congrArg ContinuousLinearMap.adjoint hcomm + simp only [ContinuousLinearMap.adjoint_comp] at hadj + rw [ContinuousLinearMap.adjoint_comp] + simp only [ContinuousLinearMap.comp_assoc] + rw [← ContinuousLinearMap.comp_assoc A.adjoint J, hcross] + simp only [ContinuousLinearMap.comp_assoc] + apply ContinuousLinearMap.ext + intro x + exact congrArg (fun z => A (B z)) (congrArg (fun T => T x) hadj) + +theorem firstFactorProjection_secondFactorProjection + (f : Lp (EuclideanSpace ℂ ι) 2 μ) : + firstFactorProjection (H := H) f ∘L secondFactorProjection (H := H) f = + doubleFactorInsertion (H := H) f ∘L (doubleFactorInsertion (H := H) f).adjoint := by + exact operator_projection_product_first _ _ _ + (firstFactorInsertion_adjoint_comp_secondFactorInsertion (H := H) f) + (secondFactorInsertion_comp_tensorInsertion (H := H) f) + +theorem operator_projection_comp_eq_of_comp_eq {H Y : Type*} + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + [NormedAddCommGroup Y] [InnerProductSpace ℂ Y] [CompleteSpace Y] + (D : H →L[ℂ] Y) (U : Y ≃ₗᵢ[ℂ] Y) + (hU : U.toContinuousLinearEquiv.toContinuousLinearMap ∘L D = D) : + (D ∘L D.adjoint) ∘L U.toContinuousLinearEquiv.toContinuousLinearMap = + D ∘L D.adjoint := by + have hleft : (U.symm : Y →L[ℂ] Y) ∘L D = D := by + apply ContinuousLinearMap.ext + intro x + have hx := congrArg (fun T => T x) hU + simp only [ContinuousLinearMap.comp_apply] at hx + change U.symm (D x) = D x + calc + U.symm (D x) = U.symm (U (D x)) := congrArg U.symm hx.symm + _ = D x := U.symm_apply_apply (D x) + have hright := congrArg ContinuousLinearMap.adjoint hleft + simp only [ContinuousLinearMap.adjoint_comp, + LinearIsometryEquiv.adjoint_eq_symm] at hright + have hright' : D.adjoint ∘L U.toContinuousLinearEquiv.toContinuousLinearMap = + D.adjoint := by + simpa only [LinearIsometryEquiv.symm_symm] using hright + rw [ContinuousLinearMap.comp_assoc, hright'] + +end Factors + +end LiebThirring diff --git a/LeanPool/LiebThirring/Kinetic/ContractionIntegral.lean b/LeanPool/LiebThirring/Kinetic/ContractionIntegral.lean new file mode 100644 index 0000000000..9510a98434 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/ContractionIntegral.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.ContractionTensor +public import LeanPool.LiebThirring.Kinetic.CurryingProductMap +public import LeanPool.LiebThirring.Kinetic.CurryingTransport +public import LeanPool.LiebThirring.Kinetic.CurryingFinite +public import Mathlib.MeasureTheory.Integral.Prod + +/-! +# Integral formula for Hilbert-valued contraction + +The adjoint definition of tensor contraction is identified with its literal +finite-spin integral formula after pairing against an arbitrary target vector. +For an L² target, the second theorem expands that target pairing as the nested +integral over its representatives. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal InnerProduct ComplexConjugate + +namespace LiebThirring + +variable {ι α H : Type*} [Fintype ι] [MeasurableSpace α] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] {μ : Measure α} + +/-- Weak integral formula for tensor contraction. Since the test vector is arbitrary, +this identity uniquely determines the contracted Hilbert vector. -/ +theorem inner_tensorContraction (f : Lp (EuclideanSpace ℂ ι) 2 μ) + (ψ : Lp (PiLp 2 (fun _ : ι => H)) 2 μ) (v : H) : + inner ℂ v (tensorContraction (ι := ι) (H := H) f ψ) = + ∫ x, ∑ s : ι, conj (f x s) * inner ℂ v (ψ x s) ∂μ := by + rw [tensorContraction, ContinuousLinearMap.adjoint_inner_right] + rw [MeasureTheory.L2.inner_def] + apply integral_congr_ae + filter_upwards [tensorInsertion_apply_ae (ι := ι) (H := H) f v] with x hx + rw [PiLp.inner_apply] + apply Finset.sum_congr rfl + intro s _ + rw [hx s, inner_smul_left] + +variable {β E : Type*} [MeasurableSpace β] [NormedAddCommGroup E] + [InnerProductSpace ℂ E] [CompleteSpace E] {ν : Measure β} + +section Joint + +variable [SFinite μ] [SFinite ν] + +end Joint + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/ContractionProjectionTransport.lean b/LeanPool/LiebThirring/Kinetic/ContractionProjectionTransport.lean new file mode 100644 index 0000000000..ce16675f6d --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/ContractionProjectionTransport.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.InnerProductSpace.Adjoint + +/-! # Transport of Hilbert-space range projections + +This module records the operator algebra transporting `I I†` through linear isometric +equivalences. It also specializes the result to an operator pulled back along an equivalence. +-/ + +public section + +open scoped InnerProduct + +namespace LiebThirring + +variable {E H Y X : Type*} + [NormedAddCommGroup E] [InnerProductSpace ℂ E] [CompleteSpace E] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + [NormedAddCommGroup Y] [InnerProductSpace ℂ Y] [CompleteSpace Y] + [NormedAddCommGroup X] [InnerProductSpace ℂ X] [CompleteSpace X] + +theorem projection_conj_eq_of_intertwining + (C : E ≃ₗᵢ[ℂ] Y) (R : H ≃ₗᵢ[ℂ] X) + (I : H →L[ℂ] E) (A : X →L[ℂ] Y) + (h : (C : E →L[ℂ] Y) ∘L I = A ∘L (R : H →L[ℂ] X)) : + (C : E →L[ℂ] Y) ∘L (I ∘L I.adjoint) ∘L (C : E →L[ℂ] Y).adjoint = + A ∘L A.adjoint := by + calc + (C : E →L[ℂ] Y) ∘L (I ∘L I.adjoint) ∘L (C : E →L[ℂ] Y).adjoint = + ((C : E →L[ℂ] Y) ∘L I) ∘L ((C : E →L[ℂ] Y) ∘L I).adjoint := by + simp only [ContinuousLinearMap.adjoint_comp, ContinuousLinearMap.comp_assoc] + _ = (A ∘L (R : H →L[ℂ] X)) ∘L (A ∘L (R : H →L[ℂ] X)).adjoint := + congrArg (fun T => T ∘L T.adjoint) h + _ = A ∘L A.adjoint := by + simp only [ContinuousLinearMap.adjoint_comp, ContinuousLinearMap.comp_assoc, + LinearIsometryEquiv.adjoint_eq_symm] + rw [← ContinuousLinearMap.comp_assoc (R : H →L[ℂ] X) (R.symm : X →L[ℂ] H)] + simp + +theorem projection_transport_apply + (C : E ≃ₗᵢ[ℂ] Y) (R : H ≃ₗᵢ[ℂ] X) + (I : H →L[ℂ] E) (A : X →L[ℂ] Y) + (h : (C : E →L[ℂ] Y) ∘L I = A ∘L (R : H →L[ℂ] X)) (ψ : E) : + (C : E →L[ℂ] Y) ((I ∘L I.adjoint) ψ) = + (A ∘L A.adjoint) ((C : E →L[ℂ] Y) ψ) := by + have hop := projection_conj_eq_of_intertwining C R I A h + have hψ := congrArg (fun T => T ((C : E →L[ℂ] Y) ψ)) hop + simp only [ContinuousLinearMap.comp_apply, LinearIsometryEquiv.adjoint_eq_symm] at hψ + rw [show (C.symm : Y →L[ℂ] E) ((C : E →L[ℂ] Y) ψ) = ψ from + C.symm_apply_apply ψ] at hψ + exact hψ + +theorem projection_symm_comp + (C : E ≃ₗᵢ[ℂ] Y) (D : H →L[ℂ] Y) : + ((C.symm : Y →L[ℂ] E) ∘L D) ∘L ((C.symm : Y →L[ℂ] E) ∘L D).adjoint = + (C.symm : Y →L[ℂ] E) ∘L (D ∘L D.adjoint) ∘L (C : E →L[ℂ] Y) := by + simp only [ContinuousLinearMap.adjoint_comp, LinearIsometryEquiv.adjoint_eq_symm, + LinearIsometryEquiv.symm_symm, ContinuousLinearMap.comp_assoc] + +theorem projection_conj_symm_comp + (C : E ≃ₗᵢ[ℂ] Y) (D : H →L[ℂ] Y) : + (C : E →L[ℂ] Y) ∘L + (((C.symm : Y →L[ℂ] E) ∘L D) ∘L + ((C.symm : Y →L[ℂ] E) ∘L D).adjoint) ∘L + (C : E →L[ℂ] Y).adjoint = D ∘L D.adjoint := by + rw [projection_symm_comp] + simp only [LinearIsometryEquiv.adjoint_eq_symm, ContinuousLinearMap.comp_assoc] + rw [← ContinuousLinearMap.comp_assoc (C : E →L[ℂ] Y) (C.symm : Y →L[ℂ] E)] + simp + +theorem projection_pullback_apply + (C : E ≃ₗᵢ[ℂ] Y) (D : H →L[ℂ] Y) (ψ : E) : + (C : E →L[ℂ] Y) + ((((C.symm : Y →L[ℂ] E) ∘L D) ∘L + ((C.symm : Y →L[ℂ] E) ∘L D).adjoint) ψ) = + (D ∘L D.adjoint) ((C : E →L[ℂ] Y) ψ) := by + have hop := projection_conj_symm_comp C D + have hψ := congrArg (fun T => T ((C : E →L[ℂ] Y) ψ)) hop + simp only [ContinuousLinearMap.comp_apply, LinearIsometryEquiv.adjoint_eq_symm] at hψ + rw [show (C.symm : Y →L[ℂ] E) ((C : E →L[ℂ] Y) ψ) = ψ from + C.symm_apply_apply ψ] at hψ + exact hψ + +end LiebThirring diff --git a/LeanPool/LiebThirring/Kinetic/ContractionRestCurrying.lean b/LeanPool/LiebThirring/Kinetic/ContractionRestCurrying.lean new file mode 100644 index 0000000000..dceb6ff32f --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/ContractionRestCurrying.lean @@ -0,0 +1,143 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.ContractionRestEncoding +public import LeanPool.LiebThirring.Kinetic.PauliLiftCurrying + +/-! # Currying a second particle from a remaining state + +The two equivalences here identify either one-particle remaining carrier with +the same ordered second-factor space used by pair currying. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal + +namespace LiebThirring + +/-- The second one-particle factor over the ordered pair-rest state. -/ +noncomputable abbrev RestFactorState {N : ℕ} (i j : Fin N) (q : ℕ) : Type := + Lp (PiLp 2 (fun _ : Fin q => PairRestState i j q)) 2 + (volume : Measure Position) + +/-- Split particle `j` from a state on the coordinates complementary to `i`. -/ +@[expose] noncomputable def restCurryingLeftLinearIsometryEquiv {N q : ℕ} + (i j : Fin N) (hij : i ≠ j) : RestState i q ≃ₗᵢ[ℂ] RestFactorState i j q := by + let A := l2PullbackEquiv (E := EuclideanSpace ℂ (OtherSpinLabels i q)) + (restLeftInsertionMeasurableEquiv i j hij) (measurePreserving_restLeftInsertion i j hij) + let B := l2TargetEquiv (volume : Measure (Position × OtherPairConfiguration i j)) + (restLeftSpinCurryingEquiv (q := q) i j hij) + let C := l2CurryLinearIsometryEquiv (μ := (volume : Measure Position)) + (ν := (volume : Measure (OtherPairConfiguration i j))) + (E := PiLp 2 (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q))) + let D := l2TargetEquiv (volume : Measure Position) + (finiteLpPiLpEquiv (volume : Measure (OtherPairConfiguration i j)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q))) + exact ((A.trans B).trans C).trans D + +/-- Split particle `i` from a state on the coordinates complementary to `j`, +using the same ordered pair-rest carrier as the left equivalence. -/ +@[expose] noncomputable def restCurryingRightLinearIsometryEquiv {N q : ℕ} + (i j : Fin N) (hij : i ≠ j) : RestState j q ≃ₗᵢ[ℂ] RestFactorState i j q := by + let A := l2PullbackEquiv (E := EuclideanSpace ℂ (OtherSpinLabels j q)) + (restRightInsertionMeasurableEquiv i j hij) (measurePreserving_restRightInsertion i j hij) + let B := l2TargetEquiv (volume : Measure (Position × OtherPairConfiguration i j)) + (restRightSpinCurryingEquiv (q := q) i j hij) + let C := l2CurryLinearIsometryEquiv (μ := (volume : Measure Position)) + (ν := (volume : Measure (OtherPairConfiguration i j))) + (E := PiLp 2 (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q))) + let D := l2TargetEquiv (volume : Measure Position) + (finiteLpPiLpEquiv (volume : Measure (OtherPairConfiguration i j)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q))) + exact ((A.trans B).trans C).trans D + +/-- Literal representative of left remaining-state currying. -/ +theorem restCurryingLeftLinearIsometryEquiv_apply_ae {N q : ℕ} + (i j : Fin N) (hij : i ≠ j) (v : RestState i q) : + ∀ᵐ z : Position, ∀ r : Fin q, ∀ᵐ y : OtherPairConfiguration i j, + ∀ t : OtherPairSpinLabels i j q, + restCurryingLeftLinearIsometryEquiv i j hij v z r y t = + v (insertOtherParticleLeft i j z y) (insertOtherSpinLeft i j r t) := by + let A := l2PullbackEquiv (E := EuclideanSpace ℂ (OtherSpinLabels i q)) + (restLeftInsertionMeasurableEquiv i j hij) (measurePreserving_restLeftInsertion i j hij) + let B := l2TargetEquiv (volume : Measure (Position × OtherPairConfiguration i j)) + (restLeftSpinCurryingEquiv (q := q) i j hij) + let h := B (A v) + let D := l2TargetEquiv (volume : Measure Position) + (finiteLpPiLpEquiv (volume : Measure (OtherPairConfiguration i j)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q))) + have hA := Measure.ae_ae_of_ae_prod (l2PullbackEquiv_ae + (restLeftInsertionMeasurableEquiv i j hij) (measurePreserving_restLeftInsertion i j hij) v) + have hB := Measure.ae_ae_of_ae_prod (l2TargetEquiv_ae + (volume : Measure (Position × OtherPairConfiguration i j)) + (restLeftSpinCurryingEquiv (q := q) i j hij) (A v)) + change ∀ᵐ z : Position, ∀ r : Fin q, ∀ᵐ y : OtherPairConfiguration i j, + ∀ t : OtherPairSpinLabels i j q, + D (l2Curry h) z r y t = + v (insertOtherParticleLeft i j z y) (insertOtherSpinLeft i j r t) + filter_upwards [l2TargetEquiv_ae (volume : Measure Position) + (finiteLpPiLpEquiv (volume : Measure (OtherPairConfiguration i j)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q))) (l2Curry h), + l2Curry_ae h, hA, hB] with z hz hc ha hb + intro r + rw [hz] + filter_upwards [finiteLpPiLpEquiv_apply_ae (volume : Measure (OtherPairConfiguration i j)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q)) (l2Curry h z) r, + hc, ha, hb] with y hy hcy hay hby + intro t + rw [hy, hcy, hby, hay] + exact congrArg (fun u : EuclideanSpace ℂ (OtherSpinLabels i q) => + u (insertOtherSpinLeft i j r t)) + (congrArg v (restLeftInsertionMeasurableEquiv_apply i j hij (z, y))) + +/-- Literal representative of right remaining-state currying. -/ +theorem restCurryingRightLinearIsometryEquiv_apply_ae {N q : ℕ} + (i j : Fin N) (hij : i ≠ j) (v : RestState j q) : + ∀ᵐ x : Position, ∀ s : Fin q, ∀ᵐ y : OtherPairConfiguration i j, + ∀ t : OtherPairSpinLabels i j q, + restCurryingRightLinearIsometryEquiv i j hij v x s y t = + v (insertOtherParticleRight i j x y) (insertOtherSpinRight i j s t) := by + let A := l2PullbackEquiv (E := EuclideanSpace ℂ (OtherSpinLabels j q)) + (restRightInsertionMeasurableEquiv i j hij) (measurePreserving_restRightInsertion i j hij) + let B := l2TargetEquiv (volume : Measure (Position × OtherPairConfiguration i j)) + (restRightSpinCurryingEquiv (q := q) i j hij) + let h := B (A v) + let D := l2TargetEquiv (volume : Measure Position) + (finiteLpPiLpEquiv (volume : Measure (OtherPairConfiguration i j)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q))) + have hA := Measure.ae_ae_of_ae_prod (l2PullbackEquiv_ae + (restRightInsertionMeasurableEquiv i j hij) (measurePreserving_restRightInsertion i j hij) v) + have hB := Measure.ae_ae_of_ae_prod (l2TargetEquiv_ae + (volume : Measure (Position × OtherPairConfiguration i j)) + (restRightSpinCurryingEquiv (q := q) i j hij) (A v)) + change ∀ᵐ x : Position, ∀ s : Fin q, ∀ᵐ y : OtherPairConfiguration i j, + ∀ t : OtherPairSpinLabels i j q, + D (l2Curry h) x s y t = + v (insertOtherParticleRight i j x y) (insertOtherSpinRight i j s t) + filter_upwards [l2TargetEquiv_ae (volume : Measure Position) + (finiteLpPiLpEquiv (volume : Measure (OtherPairConfiguration i j)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q))) (l2Curry h), + l2Curry_ae h, hA, hB] with x hx hc ha hb + intro s + rw [hx] + filter_upwards [finiteLpPiLpEquiv_apply_ae (volume : Measure (OtherPairConfiguration i j)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q)) (l2Curry h x) s, + hc, ha, hb] with y hy hcy hay hby + intro t + rw [hy, hcy, hby, hay] + exact congrArg (fun u : EuclideanSpace ℂ (OtherSpinLabels j q) => + u (insertOtherSpinRight i j s t)) + (congrArg v (restRightInsertionMeasurableEquiv_apply i j hij (x, y))) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/ContractionRestEncoding.lean b/LeanPool/LiebThirring/Kinetic/ContractionRestEncoding.lean new file mode 100644 index 0000000000..d3e5c2acc9 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/ContractionRestEncoding.lean @@ -0,0 +1,263 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.PauliLiftEncoding + +/-! # Splitting a second particle from a remaining-coordinate carrier + +These ordered encodings split particle `j` from the coordinates complementary +to `i`, or particle `i` from those complementary to `j`, while using the same +ordered pair-rest carrier in both cases. +-/ + +@[expose] public section + +open MeasureTheory WithLp + +namespace LiebThirring + +/-- Split the coordinate `j` from the spatial indices complementary to `i`. -/ +def restLeftIndexEquiv {N : ℕ} (i j : Fin N) (hij : i ≠ j) : + ({k : Fin N // k ≠ i} × Fin 3) ≃ + (Fin 3 ⊕ ({k : Fin N // k ≠ i ∧ k ≠ j} × Fin 3)) where + toFun ka := if h : ka.1.val = j then Sum.inl ka.2 else + Sum.inr (⟨ka.1.val, ka.1.property, h⟩, ka.2) + invFun := Sum.elim (fun a => (⟨j, hij.symm⟩, a)) + (fun ka => (⟨ka.1.val, ka.1.property.1⟩, ka.2)) + left_inv ka := by + rcases ka with ⟨k, a⟩ + by_cases h : k.val = j + · simp only [h, ↓reduceDIte] + change (⟨j, hij.symm⟩, a) = (k, a) + apply Prod.ext + · apply Subtype.ext + exact h.symm + · rfl + · simp only [h, ↓reduceDIte] + change (⟨k.val, k.property⟩, a) = (k, a) + rfl + right_inv u := by + rcases u with a | ka + · simp + · simp [ka.1.property.2] + +/-- Split the coordinate `i` from the spatial indices complementary to `j`. -/ +def restRightIndexEquiv {N : ℕ} (i j : Fin N) (hij : i ≠ j) : + ({k : Fin N // k ≠ j} × Fin 3) ≃ + (Fin 3 ⊕ ({k : Fin N // k ≠ i ∧ k ≠ j} × Fin 3)) where + toFun ka := if h : ka.1.val = i then Sum.inl ka.2 else + Sum.inr (⟨ka.1.val, h, ka.1.property⟩, ka.2) + invFun := Sum.elim (fun a => (⟨i, hij⟩, a)) + (fun ka => (⟨ka.1.val, ka.1.property.2⟩, ka.2)) + left_inv ka := by + rcases ka with ⟨k, a⟩ + by_cases h : k.val = i + · simp only [h, ↓reduceDIte] + change (⟨i, hij⟩, a) = (k, a) + apply Prod.ext + · apply Subtype.ext + exact h.symm + · rfl + · simp only [h, ↓reduceDIte] + change (⟨k.val, k.property⟩, a) = (k, a) + rfl + right_inv u := by + rcases u with a | ka + · simp + · simp [ka.1.property.1] + +/-- Insert particle `j` into the spatial coordinates complementary to `i`. -/ +def insertOtherParticleLeft {N : ℕ} (i j : Fin N) (z : Position) + (y : OtherPairConfiguration i j) : OtherConfiguration i := + toLp 2 (fun ka => if h : ka.1.val = j then z ka.2 else + y (⟨ka.1.val, ka.1.property, h⟩, ka.2)) + +/-- Insert particle `i` into the spatial coordinates complementary to `j`. -/ +def insertOtherParticleRight {N : ℕ} (i j : Fin N) (x : Position) + (y : OtherPairConfiguration i j) : OtherConfiguration j := + toLp 2 (fun ka => if h : ka.1.val = i then x ka.2 else + y (⟨ka.1.val, h, ka.1.property⟩, ka.2)) + +/-- Insert spin `j` into the labels complementary to `i`. -/ +def insertOtherSpinLeft {N q : ℕ} (i j : Fin N) (r : Fin q) + (t : OtherPairSpinLabels i j q) : OtherSpinLabels i q := + fun k => if h : k.val = j then r else t ⟨k.val, k.property, h⟩ + +/-- Insert spin `i` into the labels complementary to `j`. -/ +def insertOtherSpinRight {N q : ℕ} (i j : Fin N) (s : Fin q) + (t : OtherPairSpinLabels i j q) : OtherSpinLabels j q := + fun k => if h : k.val = i then s else t ⟨k.val, h, k.property⟩ + +/-- Spatial insertion into `RestState i` as a measurable equivalence. -/ +noncomputable def restLeftInsertionMeasurableEquiv {N : ℕ} + (i j : Fin N) (hij : i ≠ j) : + (Position × OtherPairConfiguration i j) ≃ᵐ OtherConfiguration i := + ((MeasurableEquiv.toLp 2 (Fin 3 → ℝ)).symm.prodCongr + (MeasurableEquiv.toLp 2 + (({k : Fin N // k ≠ i ∧ k ≠ j} × Fin 3) → ℝ)).symm).trans + ((MeasurableEquiv.sumPiEquivProdPi (fun _ : Fin 3 ⊕ + ({k : Fin N // k ≠ i ∧ k ≠ j} × Fin 3) => ℝ)).symm.trans + ((MeasurableEquiv.piCongrLeft + (fun _ : {k : Fin N // k ≠ i} × Fin 3 => ℝ) + (restLeftIndexEquiv i j hij).symm).trans (MeasurableEquiv.toLp 2 _))) + +/-- Spatial insertion into `RestState j` as a measurable equivalence. -/ +noncomputable def restRightInsertionMeasurableEquiv {N : ℕ} + (i j : Fin N) (hij : i ≠ j) : + (Position × OtherPairConfiguration i j) ≃ᵐ OtherConfiguration j := + ((MeasurableEquiv.toLp 2 (Fin 3 → ℝ)).symm.prodCongr + (MeasurableEquiv.toLp 2 + (({k : Fin N // k ≠ i ∧ k ≠ j} × Fin 3) → ℝ)).symm).trans + ((MeasurableEquiv.sumPiEquivProdPi (fun _ : Fin 3 ⊕ + ({k : Fin N // k ≠ i ∧ k ≠ j} × Fin 3) => ℝ)).symm.trans + ((MeasurableEquiv.piCongrLeft + (fun _ : {k : Fin N // k ≠ j} × Fin 3 => ℝ) + (restRightIndexEquiv i j hij).symm).trans (MeasurableEquiv.toLp 2 _))) + +theorem restLeftInsertionMeasurableEquiv_apply {N : ℕ} + (i j : Fin N) (hij : i ≠ j) (w : Position × OtherPairConfiguration i j) : + restLeftInsertionMeasurableEquiv i j hij w = insertOtherParticleLeft i j w.1 w.2 := by + ext ka + simp [restLeftInsertionMeasurableEquiv, MeasurableEquiv.coe_piCongrLeft, + Equiv.piCongrLeft_apply, MeasurableEquiv.coe_sumPiEquivProdPi_symm, + Equiv.sumPiEquivProdPi, restLeftIndexEquiv, insertOtherParticleLeft] + split <;> rfl + +theorem restRightInsertionMeasurableEquiv_apply {N : ℕ} + (i j : Fin N) (hij : i ≠ j) (w : Position × OtherPairConfiguration i j) : + restRightInsertionMeasurableEquiv i j hij w = insertOtherParticleRight i j w.1 w.2 := by + ext ka + simp [restRightInsertionMeasurableEquiv, MeasurableEquiv.coe_piCongrLeft, + Equiv.piCongrLeft_apply, MeasurableEquiv.coe_sumPiEquivProdPi_symm, + Equiv.sumPiEquivProdPi, restRightIndexEquiv, insertOtherParticleRight] + split <;> rfl + +theorem measurePreserving_restLeftInsertion {N : ℕ} + (i j : Fin N) (hij : i ≠ j) : + MeasurePreserving (restLeftInsertionMeasurableEquiv i j hij) volume volume := by + exact ((PiLp.volume_preserving_ofLp (Fin 3)).prod + (PiLp.volume_preserving_ofLp ({k : Fin N // k ≠ i ∧ k ≠ j} × Fin 3))).trans + ((volume_measurePreserving_sumPiEquivProdPi_symm _).trans + ((volume_measurePreserving_piCongrLeft _ (restLeftIndexEquiv i j hij).symm).trans + (PiLp.volume_preserving_toLp ({k : Fin N // k ≠ i} × Fin 3)))) + +theorem measurePreserving_restRightInsertion {N : ℕ} + (i j : Fin N) (hij : i ≠ j) : + MeasurePreserving (restRightInsertionMeasurableEquiv i j hij) volume volume := by + exact ((PiLp.volume_preserving_ofLp (Fin 3)).prod + (PiLp.volume_preserving_ofLp ({k : Fin N // k ≠ i ∧ k ≠ j} × Fin 3))).trans + ((volume_measurePreserving_sumPiEquivProdPi_symm _).trans + ((volume_measurePreserving_piCongrLeft _ (restRightIndexEquiv i j hij).symm).trans + (PiLp.volume_preserving_toLp ({k : Fin N // k ≠ j} × Fin 3)))) + +/-- Split remaining spin labels in the left orientation. -/ +def restLeftSpinInsertionEquiv {N q : ℕ} (i j : Fin N) (hij : i ≠ j) : + (Fin q × OtherPairSpinLabels i j q) ≃ OtherSpinLabels i q where + toFun w := insertOtherSpinLeft i j w.1 w.2 + invFun u := (u ⟨j, hij.symm⟩, fun k => u ⟨k.val, k.property.1⟩) + left_inv w := by + apply Prod.ext + · simp [insertOtherSpinLeft] + · funext k + simp [insertOtherSpinLeft, k.property.2] + right_inv u := by + funext k + by_cases h : k.val = j + · subst h + simp [insertOtherSpinLeft] + · simp [insertOtherSpinLeft, h] + +/-- Split remaining spin labels in the right orientation. -/ +def restRightSpinInsertionEquiv {N q : ℕ} (i j : Fin N) (hij : i ≠ j) : + (Fin q × OtherPairSpinLabels i j q) ≃ OtherSpinLabels j q where + toFun w := insertOtherSpinRight i j w.1 w.2 + invFun u := (u ⟨i, hij⟩, fun k => u ⟨k.val, k.property.2⟩) + left_inv w := by + apply Prod.ext + · simp [insertOtherSpinRight] + · funext k + simp [insertOtherSpinRight, k.property.1] + right_inv u := by + funext k + by_cases h : k.val = i + · subst h + simp [insertOtherSpinRight] + · simp [insertOtherSpinRight, h] + +/-- Split off the left selected spin from the remaining spin assignment. -/ +noncomputable def restLeftSpinCurryingEquiv {N q : ℕ} + (i j : Fin N) (hij : i ≠ j) : + EuclideanSpace ℂ (OtherSpinLabels i q) ≃ₗᵢ[ℂ] + PiLp 2 (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q)) := + (LinearIsometryEquiv.piLpCongrLeft 2 ℂ ℂ (restLeftSpinInsertionEquiv i j hij).symm).trans + ((LinearIsometryEquiv.piLpCongrLeft 2 ℂ ℂ + (Equiv.sigmaEquivProd (Fin q) (OtherPairSpinLabels i j q)).symm).trans + (LinearIsometryEquiv.piLpCurry ℂ 2 + (fun (_ : Fin q) (_ : OtherPairSpinLabels i j q) => ℂ))) + +/-- Split off the right selected spin from the remaining spin assignment. -/ +noncomputable def restRightSpinCurryingEquiv {N q : ℕ} + (i j : Fin N) (hij : i ≠ j) : + EuclideanSpace ℂ (OtherSpinLabels j q) ≃ₗᵢ[ℂ] + PiLp 2 (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q)) := + (LinearIsometryEquiv.piLpCongrLeft 2 ℂ ℂ (restRightSpinInsertionEquiv i j hij).symm).trans + ((LinearIsometryEquiv.piLpCongrLeft 2 ℂ ℂ + (Equiv.sigmaEquivProd (Fin q) (OtherPairSpinLabels i j q)).symm).trans + (LinearIsometryEquiv.piLpCurry ℂ 2 + (fun (_ : Fin q) (_ : OtherPairSpinLabels i j q) => ℂ))) + +theorem insertParticle_insertOtherParticleLeft {N : ℕ} (i j : Fin N) + (x z : Position) (y : OtherPairConfiguration i j) : + insertParticle i x (insertOtherParticleLeft i j z y) = + insertParticlePair i j x z y := by + ext ka + rcases ka with ⟨k, a⟩ + change (if hi : k = i then x a else if hj : k = j then z a else + y (⟨k, hi, hj⟩, a)) = + if hi : k = i then x a else if hj : k = j then z a else y (⟨k, hi, hj⟩, a) + rfl + +theorem insertParticle_insertOtherParticleRight {N : ℕ} (i j : Fin N) + (hij : i ≠ j) (x z : Position) (y : OtherPairConfiguration i j) : + insertParticle j z (insertOtherParticleRight i j x y) = + insertParticlePair i j x z y := by + ext ka + rcases ka with ⟨k, a⟩ + by_cases hj : k = j + · subst k + simp [insertParticle, insertParticlePair, hij.symm] + by_cases hi : k = i + · subst k + simp [insertParticle, insertParticlePair, insertOtherParticleRight, hij] + · simp [insertParticle, insertParticlePair, insertOtherParticleRight, hi, hj] + +theorem insertSpin_insertOtherSpinLeft {N q : ℕ} (i j : Fin N) + (s r : Fin q) (t : OtherPairSpinLabels i j q) : + insertSpin i s (insertOtherSpinLeft i j r t) = insertSpinPair i j s r t := by + funext k + change (if hi : k = i then s else if hj : k = j then r else t ⟨k, hi, hj⟩) = + if hi : k = i then s else if hj : k = j then r else t ⟨k, hi, hj⟩ + rfl + +theorem insertSpin_insertOtherSpinRight {N q : ℕ} (i j : Fin N) + (hij : i ≠ j) (s r : Fin q) (t : OtherPairSpinLabels i j q) : + insertSpin j r (insertOtherSpinRight i j s t) = insertSpinPair i j s r t := by + funext k + by_cases hj : k = j + · subst k + simp [insertSpin, insertSpinPair, hij.symm] + by_cases hi : k = i + · subst k + simp [insertSpin, insertSpinPair, insertOtherSpinRight, hij] + · simp [insertSpin, insertSpinPair, insertOtherSpinRight, hi, hj] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/ContractionState.lean b/LeanPool/LiebThirring/Kinetic/ContractionState.lean new file mode 100644 index 0000000000..d53ac9fd3c --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/ContractionState.lean @@ -0,0 +1,170 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.CurryingState +public import LeanPool.LiebThirring.Kinetic.ContractionTensor + +/-! +# One-particle insertion, contraction and projection on `State` + +Insert a fixed one-particle vector into coordinate `i`. + +Contract coordinate `i` against the full spatial-and-spin one-particle vector. +-/ + +public section + +open MeasureTheory +open scoped InnerProduct + +namespace LiebThirring + +private theorem adjoint_transport {E F H : Type*} + [NormedAddCommGroup E] [InnerProductSpace ℂ E] [CompleteSpace E] + [NormedAddCommGroup F] [InnerProductSpace ℂ F] [CompleteSpace F] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + (C : E ≃ₗᵢ[ℂ] F) (I : H →L[ℂ] F) : + ((C.symm : F →L[ℂ] E).comp I).adjoint = I.adjoint.comp (C : E →L[ℂ] F) := by + simp only [ContinuousLinearMap.adjoint_comp, LinearIsometryEquiv.adjoint_eq_symm, + LinearIsometryEquiv.symm_symm] + +/-- Insert a fixed one-particle vector into coordinate `i`. -/ +@[expose] noncomputable def oneParticleInsertion {N q : ℕ} (i : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) : + RestState i q →L[ℂ] State N q := + (oneParticleCurryingLinearIsometryEquiv i).symm.toContinuousLinearEquiv.toContinuousLinearMap.comp + (tensorInsertion (H := RestState i q) f) + +/-- Contract coordinate `i` against the full spatial-and-spin one-particle vector. -/ +@[expose] noncomputable def oneParticleContraction {N q : ℕ} (i : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) : + State N q →L[ℂ] RestState i q := + (tensorContraction (H := RestState i q) f).comp + (oneParticleCurryingLinearIsometryEquiv i).toContinuousLinearEquiv.toContinuousLinearMap + +/-- The concrete contraction is conjugate-linear in its one-particle vector. -/ +theorem oneParticleContraction_smul {N q : ℕ} (i : Fin N) + (a : ℂ) (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) : + oneParticleContraction i (a • f) = star a • oneParticleContraction i f := by + rw [oneParticleContraction, tensorContraction_smul, ContinuousLinearMap.smul_comp] + rfl + +/-- The concrete contraction is the adjoint of the concrete insertion. -/ +theorem oneParticleInsertion_adjoint {N q : ℕ} (i : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) : + (oneParticleInsertion i f).adjoint = oneParticleContraction i f := by + exact adjoint_transport (oneParticleCurryingLinearIsometryEquiv (q := q) i) + (tensorInsertion (H := RestState i q) f) + +/-- Exact norm of insertion on the state carrier. -/ +theorem oneParticleInsertion_norm {N q : ℕ} (i : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) (v : RestState i q) : + ‖oneParticleInsertion i f v‖ = ‖f‖ * ‖v‖ := by + change ‖(oneParticleCurryingLinearIsometryEquiv i).symm (tensorInsertion (H := RestState i q) f + v)‖ = _ + rw [LinearIsometryEquiv.norm_map, tensorInsertion_norm] + +/-- contraction contraction bound, with no antisymmetry or normalization assumption. -/ +theorem oneParticleContraction_norm_le {N q : ℕ} (i : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) (ψ : State N q) : + ‖oneParticleContraction i f ψ‖ ≤ ‖f‖ * ‖ψ‖ := by + change ‖tensorContraction (H := RestState i q) f (oneParticleCurryingLinearIsometryEquiv i ψ)‖ ≤ _ + calc + _ ≤ ‖f‖ * ‖oneParticleCurryingLinearIsometryEquiv i ψ‖ := + tensorContraction_norm_le (H := RestState i q) f _ + _ = _ := by rw [LinearIsometryEquiv.norm_map] + +/-- The zero one-particle vector contracts every state to zero. -/ +theorem oneParticleContraction_zero {N q : ℕ} (i : Fin N) (ψ : State N q) : + oneParticleContraction i 0 ψ = 0 := by + apply norm_eq_zero.mp + exact le_antisymm (by simpa using oneParticleContraction_norm_le i 0 ψ) (norm_nonneg _) + +/-- Currying the inserted state recovers the literal Hilbert-valued tensor. -/ +theorem oneParticleCurrying_insertion {N q : ℕ} (i : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) (v : RestState i q) : + oneParticleCurrying i (oneParticleInsertion i f v) = tensorInsertion (H := RestState i q) f v + := by + change oneParticleCurryingLinearIsometryEquiv i + ((oneParticleCurryingLinearIsometryEquiv i).symm (tensorInsertion (H := RestState i q) f v)) = _ + exact (oneParticleCurryingLinearIsometryEquiv i).apply_symm_apply _ + +/-- The inserted state has the prescribed product amplitudes on a.e. slices. -/ +theorem oneParticleInsertion_ae {N q : ℕ} (i : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) (v : RestState i q) : + ∀ᵐ x : Position, ∀ s : Fin q, ∀ᵐ y : OtherConfiguration i, + ∀ t : OtherSpinLabels i q, + oneParticleInsertion i f v (insertParticle i x y) (insertSpin i s t) = + f x s * v y t := by + have hc := oneParticleCurrying_ae i (oneParticleInsertion i f v) + rw [oneParticleCurrying_insertion] at hc + filter_upwards [hc, tensorInsertion_apply_ae (H := RestState i q) f v] with x hx ht + intro s + have heq := hx s + rw [ht s] at heq + filter_upwards [heq, Lp.coeFn_smul (f x s) v] with y hy hs + simp only [Pi.smul_apply] at hs + intro t + rw [← hy t, hs] + rfl + +/-- The rank-one lift obtained by inserting back after contraction. +It is an orthogonal projection when the inserted one-particle vector is unit. -/ +@[expose] noncomputable def oneParticleProjection {N q : ℕ} (i : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) : + State N q →L[ℂ] State N q := + (oneParticleInsertion i f).comp (oneParticleContraction i f) + +/-- Every lifted rank-one operator is self-adjoint. -/ +theorem oneParticleProjection_adjoint {N q : ℕ} (i : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) : + (oneParticleProjection i f).adjoint = oneParticleProjection i f := by + rw [oneParticleProjection, ← oneParticleInsertion_adjoint, + ContinuousLinearMap.adjoint_comp, ContinuousLinearMap.adjoint_adjoint] + +/-- The symmetry identity needed by the finite projection sum estimate. -/ +theorem oneParticleProjection_inner {N q : ℕ} (i : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) (ψ φ : State N q) : + inner ℂ (oneParticleProjection i f ψ) φ = inner ℂ ψ (oneParticleProjection i f φ) := by + calc + _ = inner ℂ ((oneParticleProjection i f).adjoint ψ) φ := by + rw [oneParticleProjection_adjoint] + _ = _ := ContinuousLinearMap.adjoint_inner_left (oneParticleProjection i f) φ ψ + +/-- Contraction undoes insertion of a unit one-particle vector. -/ +theorem oneParticleContraction_insertion {N q : ℕ} (i : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) (hf : ‖f‖ = 1) + (v : RestState i q) : oneParticleContraction i f (oneParticleInsertion i f v) = v := by + have h : (oneParticleInsertion i f).adjoint.comp (oneParticleInsertion i f) = 1 := + (oneParticleInsertion i f).norm_map_iff_adjoint_comp_self.mp (fun w => by + rw [oneParticleInsertion_norm, hf, one_mul]) + rw [oneParticleInsertion_adjoint] at h + exact congrArg (fun T : RestState i q →L[ℂ] RestState i q => T v) h + +/-- Inserting a unit vector after contraction is idempotent. -/ +theorem oneParticleProjection_idempotent {N q : ℕ} (i : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) (hf : ‖f‖ = 1) + (ψ : State N q) : oneParticleProjection i f (oneParticleProjection i f ψ) = + oneParticleProjection i f ψ := by + change oneParticleInsertion i f + (oneParticleContraction i f (oneParticleInsertion i f (oneParticleContraction i f ψ))) = _ + rw [oneParticleContraction_insertion i f hf] + rfl + +/-- Unit-vector projection and contraction have equal output norms. -/ +theorem oneParticleProjection_norm {N q : ℕ} (i : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) (hf : ‖f‖ = 1) + (ψ : State N q) : ‖oneParticleProjection i f ψ‖ = ‖oneParticleContraction i f ψ‖ := by + change ‖oneParticleInsertion i f (oneParticleContraction i f ψ)‖ = _ + rw [oneParticleInsertion_norm, hf, one_mul] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/ContractionTensor.lean b/LeanPool/LiebThirring/Kinetic/ContractionTensor.lean new file mode 100644 index 0000000000..be08c704e0 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/ContractionTensor.lean @@ -0,0 +1,166 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.InnerProductSpace.Adjoint +public import Mathlib.MeasureTheory.Function.L2Space + +/-! +# Normed-space tensor insertion and Hilbert-space contraction + +Pointwise tensoring of a normed-space vector with a finite complex spin vector, as a continuous +bilinear map. + +Insert a finite-spin `L²` function into a normed-space-valued `L²` space. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal InnerProduct + +namespace LiebThirring + +variable {ι α H : Type*} [Fintype ι] [MeasurableSpace α] + [NormedAddCommGroup H] {μ : Measure α} + +section Normed + +variable [NormedSpace ℂ H] + +/-- Pointwise tensoring of a normed-space vector with a finite complex spin vector, +as a continuous bilinear map. -/ +@[expose] noncomputable def tensorInsertionBilinear : + H →L[ℂ] EuclideanSpace ℂ ι →L[ℂ] PiLp 2 (fun _ : ι => H) := + (LinearMap.mk₂ ℂ (fun v : H => fun a : EuclideanSpace ℂ ι => + toLp 2 (fun s => a s • v)) + (fun v w a => by + ext i + change a i • (v + w) = a i • v + a i • w + rw [smul_add]) + (fun c v a => by + ext i + change a i • (c • v) = c • (a i • v) + rw [smul_smul, smul_smul, mul_comm]) + (fun v a b => by + ext i + change (a i + b i) • v = a i • v + b i • v + rw [add_smul]) + (fun c v a => by + ext i + change (c * a i) • v = c • (a i • v) + rw [mul_smul])).mkContinuous₂ 1 (fun v a => by + rw [PiLp.norm_eq_of_L2] + change √(∑ s : ι, ‖a s • v‖ ^ 2) ≤ 1 * ‖v‖ * ‖a‖ + simp only [norm_smul, one_mul] + have heq : ∑ s : ι, (‖a s‖ * ‖v‖) ^ 2 = ‖a‖ ^ 2 * ‖v‖ ^ 2 := by + rw [PiLp.norm_sq_eq_of_L2, Finset.sum_mul] + apply Finset.sum_congr rfl + intro s _ + ring + rw [heq, Real.sqrt_mul (sq_nonneg ‖a‖), Real.sqrt_sq_eq_abs, abs_norm, + Real.sqrt_sq_eq_abs, abs_norm, mul_comm]) + +/-- Insert a finite-spin `L²` function into a normed-space-valued `L²` space. -/ +@[expose] noncomputable def tensorInsertion (f : Lp (EuclideanSpace ℂ ι) 2 μ) : + H →L[ℂ] Lp (PiLp 2 (fun _ : ι => H)) 2 μ := + (tensorInsertionBilinear (ι := ι) (H := H)).compLpL₂ 2 μ |>.flip f + +/-- The inserted `L²` class has the expected pointwise representative. -/ +theorem tensorInsertion_apply_ae (f : Lp (EuclideanSpace ℂ ι) 2 μ) (v : H) : + ∀ᵐ x ∂μ, ∀ s : ι, tensorInsertion (ι := ι) (H := H) f v x s = f x s • v := by + filter_upwards [(tensorInsertionBilinear (ι := ι) (H := H) v).coeFn_compLp' f] with x hx + intro s + change ((tensorInsertionBilinear (ι := ι) (H := H) v).compLp f) x s = f x s • v + exact + congrArg (fun u : PiLp 2 (fun _ : ι => H) => u s) hx + +/-- Exact norm of tensor insertion at a vector. -/ +theorem tensorInsertion_norm (f : Lp (EuclideanSpace ℂ ι) 2 μ) (v : H) : + ‖tensorInsertion (ι := ι) (H := H) f v‖ = ‖f‖ * ‖v‖ := by + rw [Lp.norm_def] + have heq : eLpNorm (tensorInsertion (ι := ι) (H := H) f v) 2 μ = + eLpNorm ((‖v‖ : ℝ) • fun x => f x) 2 μ := by + apply eLpNorm_congr_norm_ae (Lp.aestronglyMeasurable _) + ((Lp.aestronglyMeasurable f).const_smul _) + filter_upwards [tensorInsertion_apply_ae (ι := ι) (H := H) f v] with x hx + have hvec : tensorInsertion (ι := ι) (H := H) f v x = + toLp 2 (fun s => f x s • v) := by + ext s + exact hx s + rw [hvec] + rw [PiLp.norm_eq_of_L2] + change √(∑ s : ι, ‖f x s • v‖ ^ 2) = ‖(‖v‖ : ℝ) • f x‖ + simp only [norm_smul, Real.norm_eq_abs, abs_norm] + have hs : ∑ s : ι, (‖f x s‖ * ‖v‖) ^ 2 = ‖f x‖ ^ 2 * ‖v‖ ^ 2 := by + rw [PiLp.norm_sq_eq_of_L2, Finset.sum_mul] + apply Finset.sum_congr rfl + intro s _ + ring + rw [hs, Real.sqrt_mul (sq_nonneg ‖f x‖), Real.sqrt_sq_eq_abs, abs_norm, + Real.sqrt_sq_eq_abs, abs_norm, mul_comm] + rw [heq, eLpNorm_const_smul] + simp [enorm_eq_nnnorm, Lp.norm_def, mul_comm] + +/-- The operator norm of insertion is bounded by the norm of the inserted +finite-spin function. -/ +theorem tensorInsertion_opNorm_le (f : Lp (EuclideanSpace ℂ ι) 2 μ) : + ‖tensorInsertion (ι := ι) (H := H) f‖ ≤ ‖f‖ := by + apply ContinuousLinearMap.opNorm_le_bound _ (norm_nonneg f) + intro v + rw [tensorInsertion_norm (ι := ι) (H := H)] + +/-- Tensor insertion is complex-linear in the inserted finite-spin function. -/ +theorem tensorInsertion_smul (a : ℂ) (f : Lp (EuclideanSpace ℂ ι) 2 μ) : + tensorInsertion (H := H) (a • f) = a • tensorInsertion (H := H) f := by + exact map_smul + ((tensorInsertionBilinear (ι := ι) (H := H)).compLpL₂ 2 μ).flip a f + +end Normed + +section Complete + +variable [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- The abstract contraction against `f`, defined as the adjoint of tensor +insertion. -/ +@[expose] noncomputable def tensorContraction (f : Lp (EuclideanSpace ℂ ι) 2 μ) : + Lp (PiLp 2 (fun _ : ι => H)) 2 μ →L[ℂ] H := + (tensorInsertion (ι := ι) (H := H) f).adjoint + +/-- Contraction is conjugate-linear in the contracted finite-spin function. -/ +theorem tensorContraction_smul (a : ℂ) (f : Lp (EuclideanSpace ℂ ι) 2 μ) : + tensorContraction (H := H) (a • f) = star a • tensorContraction (H := H) f := by + change (tensorInsertion (H := H) (a • f)).adjoint = + star a • (tensorInsertion (H := H) f).adjoint + rw [tensorInsertion_smul] + exact map_smulₛₗ + (ContinuousLinearMap.adjoint : + (H →L[ℂ] Lp (PiLp 2 (fun _ : ι => H)) 2 μ) ≃ₗᵢ⋆[ℂ] + (Lp (PiLp 2 (fun _ : ι => H)) 2 μ →L[ℂ] H)) + a (tensorInsertion (H := H) f) + +/-- Contraction has the expected Hilbert-space norm bound. -/ +theorem tensorContraction_norm_le (f : Lp (EuclideanSpace ℂ ι) 2 μ) + (ψ : Lp (PiLp 2 (fun _ : ι => H)) 2 μ) : + ‖tensorContraction (ι := ι) (H := H) f ψ‖ ≤ ‖f‖ * ‖ψ‖ := by + calc + ‖tensorContraction (ι := ι) (H := H) f ψ‖ ≤ + ‖tensorContraction (ι := ι) (H := H) f‖ * ‖ψ‖ := + ContinuousLinearMap.le_opNorm _ _ + _ = ‖tensorInsertion (ι := ι) (H := H) f‖ * ‖ψ‖ := by + rw [tensorContraction, LinearIsometryEquiv.norm_map] + _ ≤ ‖f‖ * ‖ψ‖ := mul_le_mul_of_nonneg_right + (tensorInsertion_opNorm_le (ι := ι) (H := H) f) (norm_nonneg ψ) + +end Complete + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/Currying.lean b/LeanPool/LiebThirring/Kinetic/Currying.lean new file mode 100644 index 0000000000..f499f76881 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/Currying.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.Encoding +public import LeanPool.LiebThirring.Kinetic.DensityBasic +public import Mathlib.MeasureTheory.Measure.SeparableMeasure + +/-! +# Spaces and slice integrability for one-particle currying + +The Hilbert space of the remaining spatial and spin coordinates (currying). + +The singled-out spin components with values in the remaining-state space (currying). +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- The Hilbert space of the remaining spatial and spin coordinates (currying). -/ +noncomputable abbrev RestState {N : ℕ} (i : Fin N) (q : ℕ) := + Lp (EuclideanSpace ℂ (OtherSpinLabels i q)) 2 + (volume : Measure (OtherConfiguration i)) + +/-- The singled-out spin components with values in the remaining-state space (currying). -/ +abbrev OneParticleFiber {N : ℕ} (i : Fin N) (q : ℕ) := + PiLp 2 (fun _ : Fin q => RestState i q) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/CurryingDensity.lean b/LeanPool/LiebThirring/Kinetic/CurryingDensity.lean new file mode 100644 index 0000000000..fe196df946 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/CurryingDensity.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.CurryingState +public import LeanPool.LiebThirring.Kinetic.CurryingMarginal + +/-! +# The curried density field + +Curried fiber norms identify the particle marginals and the scaled density field. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- Extended squared norm of a finite Hilbert sum. -/ +theorem piLp_enorm_sq {ι : Type*} [Fintype ι] {E : ι → Type*} + [∀ i, NormedAddCommGroup (E i)] (u : PiLp 2 E) : + ‖u‖ₑ ^ 2 = ∑ i, ‖u i‖ₑ ^ 2 := by + simp only [← ofReal_norm] + simp_rw [← ENNReal.ofReal_pow (norm_nonneg _)] + rw [PiLp.norm_sq_eq_of_L2] + exact ENNReal.ofReal_sum_of_nonneg (fun _ _ => sq_nonneg _) + +/-- Each marginal is the squared norm of the currying outer fiber a.e. -/ +theorem particle_marginal_eq_currying_norm_sq_ae {N q : ℕ} (i : Fin N) (ψ : State N q) : + (fun x : Position => ∫⁻ y : OtherConfiguration i, + (‖ψ (insertParticle i x y)‖₊ : ℝ≥0∞) ^ 2) =ᵐ[volume] + fun x => (‖oneParticleCurrying i ψ x‖₊ : ℝ≥0∞) ^ 2 := by + filter_upwards [oneParticleCurrying_ae i ψ] with x hx + have hxy : ∀ᵐ y : OtherConfiguration i, ∀ s : Fin q, ∀ t : OtherSpinLabels i q, + oneParticleCurrying i ψ x s y t = ψ (insertParticle i x y) (insertSpin i s t) := + ae_all_iff.mpr hx + calc + _ = ∫⁻ y : OtherConfiguration i, + ‖spinCurryingLinearIsometryEquiv i (ψ (insertParticle i x y))‖ₑ ^ 2 := by + apply lintegral_congr + intro y + rw [LinearIsometryEquiv.enorm_map] + rfl + _ = ∫⁻ y : OtherConfiguration i, ∑ s : Fin q, + ‖oneParticleCurrying i ψ x s y‖ₑ ^ 2 := by + apply lintegral_congr_ae + filter_upwards [hxy] with y hy + rw [piLp_enorm_sq] + apply Finset.sum_congr rfl + intro s _ + congr 2 + ext t + exact (hy s t).symm + _ = ∑ s : Fin q, ∫⁻ y : OtherConfiguration i, + ‖oneParticleCurrying i ψ x s y‖ₑ ^ 2 := + lintegral_finsetSum _ (fun s _ => + ((Lp.stronglyMeasurable (oneParticleCurrying i ψ x s)).enorm.pow_const 2)) + _ = ∑ s : Fin q, ‖oneParticleCurrying i ψ x s‖ₑ ^ 2 := by + apply Finset.sum_congr rfl + intro s _ + exact lintegral_l2_enorm_sq _ + _ = _ := (piLp_enorm_sq _).symm + +/-- The density is `N` times the squared norm of any selected curried fiber. -/ +theorem density_eq_mul_currying_norm_sq_ae {N q : ℕ} (i : Fin N) (ψ : State N q) + (hψ : antisymmetric ψ) : + density ψ =ᵐ[volume] fun x : Position => + (N : ℝ≥0∞) * (‖oneParticleCurrying i ψ x‖₊ : ℝ≥0∞) ^ 2 := by + filter_upwards [density_eq_mul_particle_marginal_ae ψ hψ i, + particle_marginal_eq_currying_norm_sq_ae i ψ] with x hx hy + exact hx.trans (congrArg (fun z : ℝ≥0∞ => (N : ℝ≥0∞) * z) hy) + +/-- The outer density field used by the Rumin argument. -/ +@[expose] noncomputable def densityField {N q : ℕ} (i : Fin N) (ψ : State N q) : + Lp (OneParticleFiber i q) 2 (volume : Measure Position) := + (Real.sqrt N : ℂ) • oneParticleCurrying i ψ + +/-- The density is the squared fiber norm of the density field a.e. -/ +theorem density_eq_densityField_norm_sq_ae {N q : ℕ} (i : Fin N) (ψ : State N q) + (hψ : antisymmetric ψ) : + density ψ =ᵐ[volume] fun x : Position => (‖densityField i ψ x‖₊ : ℝ≥0∞) ^ 2 := by + filter_upwards [density_eq_mul_currying_norm_sq_ae i ψ hψ, + Lp.coeFn_smul (Real.sqrt N : ℂ) (oneParticleCurrying i ψ)] with x hx hs + simp only [Pi.smul_apply] at hs + rw [hx] + change _ = (‖((Real.sqrt N : ℂ) • oneParticleCurrying i ψ) x‖₊ : ℝ≥0∞) ^ 2 + rw [hs] + have hnorm : ‖(Real.sqrt N : ℂ) • oneParticleCurrying i ψ x‖ ^ 2 = + (N : ℝ) * ‖oneParticleCurrying i ψ x‖ ^ 2 := by + rw [norm_smul, mul_pow, Complex.norm_real, Real.norm_eq_abs, + abs_of_nonneg (Real.sqrt_nonneg _), Real.sq_sqrt (Nat.cast_nonneg N)] + simpa only [ENNReal.ofReal_mul (Nat.cast_nonneg N), ENNReal.ofReal_natCast, + ENNReal.ofReal_pow (norm_nonneg ((Real.sqrt N : ℂ) • oneParticleCurrying i ψ x)), + ENNReal.ofReal_pow (norm_nonneg (oneParticleCurrying i ψ x)), + ofReal_norm, enorm_eq_nnnorm] + using (congrArg ENNReal.ofReal hnorm).symm + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/CurryingExchange.lean b/LeanPool/LiebThirring/Kinetic/CurryingExchange.lean new file mode 100644 index 0000000000..d18f8a063e --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/CurryingExchange.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.FourierFactor + +/-! +# Exchange of full Fourier energies + +Fourier covariance gives equality of exchanged particle energies and the exchange-odd L² +identity. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- All full-space particle Fourier energies of an antisymmetric state agree. -/ +theorem particleFourierEnergy_eq {N q : ℕ} (ψ : State N q) (hψ : antisymmetric ψ) + (i j : Fin N) : particleFourierEnergy ψ i = particleFourierEnergy ψ j := by + exact particle_marginals_eq (Lp.fourierTransformₗᵢ _ _ ψ) + (antisymmetric_fourier ψ hψ) i j + (fun x : Position => ENNReal.ofReal ((2 * Real.pi) ^ 2) * (‖x‖₊ : ℝ≥0∞) ^ 2) + +/-- The extended kinetic energy is the particle count times any selected +full Fourier energy, including infinite energy. -/ +theorem kineticEnergy_eq_mul_particleFourierEnergy {N q : ℕ} (ψ : State N q) + (hψ : antisymmetric ψ) (i : Fin N) : + kineticEnergy ψ = (N : ℝ≥0∞) * particleFourierEnergy ψ i := by + rw [kineticEnergy_eq_sum_particleFourierEnergy] + simp only [particleFourierEnergy_eq ψ hψ _ i, Finset.sum_const, + Finset.card_univ, Fintype.card_fin, nsmul_eq_mul] + +/-- A transposition of distinct particles acts by negation on an antisymmetric +L² state. This is an equality of classes, not only of representative values. -/ +theorem simultaneousPermutation_swap_eq_neg {N q : ℕ} (ψ : State N q) + (hψ : antisymmetric ψ) (i j : Fin N) (hij : i ≠ j) : + simultaneousPermutation (Equiv.swap i j) ψ = -ψ := by + rw [simultaneousPermutation_eq_sign_smul _ ψ hψ] + simp [Equiv.Perm.sign_swap hij] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/CurryingFinite.lean b/LeanPool/LiebThirring/Kinetic/CurryingFinite.lean new file mode 100644 index 0000000000..33fca978c5 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/CurryingFinite.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.MeasureTheory.SpecificCodomains.WithLp +public import Mathlib.MeasureTheory.Function.L2Space + +/-! +# Interchanging finite Hilbert sums and L² + +This module gives the canonical complex linear isometric equivalence between +`L²(X; ⨁₂ i, E i)` and `⨁₂ i, L²(X; E i)` for a finite family of complete +complex Hilbert spaces. Its evaluation theorem records the representative +identity in every coordinate. +-/ + +@[expose] public section + +open MeasureTheory WithLp +open scoped ENNReal + +namespace LiebThirring + +noncomputable section + +variable {X ι : Type*} [MeasurableSpace X] (μ : Measure X) [Fintype ι] +variable (E : ι → Type*) [∀ i, NormedAddCommGroup (E i)] + [∀ i, InnerProductSpace ℂ (E i)] + +/-- Send a `PiLp`-valued L² class to its finite family of coordinate classes. -/ +noncomputable def finiteLpPiLpForward + (f : Lp (PiLp 2 E) 2 μ) : PiLp 2 (fun i => Lp (E i) 2 μ) := + toLp 2 fun i => (PiLp.proj (𝕜 := ℂ) 2 E i).compLpL 2 μ f + +/-- Assemble a finite family of L² classes from their strongly measurable representatives. -/ +noncomputable def finiteLpPiLpInverse + (f : PiLp 2 (fun i => Lp (E i) 2 μ)) : Lp (PiLp 2 E) 2 μ := + (memLp_piLp_iff.mpr fun i => Lp.memLp (f i)).toLp + (fun x => toLp 2 fun i => f i x) + +theorem finiteLpPiLpInverse_forward (f : Lp (PiLp 2 E) 2 μ) : + finiteLpPiLpInverse μ E (finiteLpPiLpForward μ E f) = f := by + apply Lp.ext + have hbmem : MemLp + (fun x => toLp 2 fun i => (finiteLpPiLpForward μ E f) i x) 2 μ := + memLp_piLp_iff.mpr fun i => Lp.memLp ((finiteLpPiLpForward μ E f) i) + have hfwd : ∀ᵐ x ∂μ, ∀ i, + ((finiteLpPiLpForward μ E f) i) x = + (PiLp.proj (𝕜 := ℂ) 2 E i) (f x) := + ae_all_iff.mpr fun i => ContinuousLinearMap.coeFn_compLp _ _ + filter_upwards [hbmem.coeFn_toLp, hfwd] with x hx hfx + apply PiLp.ext + intro i + rw [show (finiteLpPiLpInverse μ E (finiteLpPiLpForward μ E f)) x = + toLp 2 (fun i => (finiteLpPiLpForward μ E f) i x) from hx] + rw [PiLp.toLp_apply] + exact hfx i + +theorem finiteLpPiLpForward_inverse (f : PiLp 2 (fun i => Lp (E i) 2 μ)) : + finiteLpPiLpForward μ E (finiteLpPiLpInverse μ E f) = f := by + apply PiLp.ext + intro i + apply Lp.ext + have hbmem : MemLp (fun x => toLp 2 fun i => f i x) 2 μ := + memLp_piLp_iff.mpr fun i => Lp.memLp (f i) + filter_upwards [ContinuousLinearMap.coeFn_compLp + (PiLp.proj (𝕜 := ℂ) 2 E i) (finiteLpPiLpInverse μ E f), hbmem.coeFn_toLp] + intro x hp hx + change ((PiLp.proj (𝕜 := ℂ) 2 E i).compLp (finiteLpPiLpInverse μ E f)) x = f i x + rw [hp] + exact congrArg (fun z => z i) hx + +theorem finiteLpPiLpForward_add (f g : Lp (PiLp 2 E) 2 μ) : + finiteLpPiLpForward μ E (f + g) = + finiteLpPiLpForward μ E f + finiteLpPiLpForward μ E g := by + apply PiLp.ext + intro i + simp [finiteLpPiLpForward] + +theorem finiteLpPiLpForward_smul (c : ℂ) (f : Lp (PiLp 2 E) 2 μ) : + finiteLpPiLpForward μ E (c • f) = c • finiteLpPiLpForward μ E f := by + apply PiLp.ext + intro i + simp [finiteLpPiLpForward] + +theorem finiteLpPiLpForward_norm (f : Lp (PiLp 2 E) 2 μ) : + ‖finiteLpPiLpForward μ E f‖ = ‖f‖ := by + rw [← sq_eq_sq₀ (norm_nonneg _) (norm_nonneg _)] + rw [norm_sq_eq_re_inner (𝕜 := ℂ) (finiteLpPiLpForward μ E f), + norm_sq_eq_re_inner (𝕜 := ℂ) f] + rw [PiLp.inner_apply, MeasureTheory.L2.inner_def] + simp_rw [MeasureTheory.L2.inner_def] + rw [← integral_finsetSum Finset.univ (fun i _ => + MeasureTheory.L2.integrable_inner (𝕜 := ℂ) + ((finiteLpPiLpForward μ E f) i) ((finiteLpPiLpForward μ E f) i))] + apply congrArg RCLike.re + apply integral_congr_ae + have hfwd : ∀ᵐ x ∂μ, ∀ i, + ((finiteLpPiLpForward μ E f) i) x = + (PiLp.proj (𝕜 := ℂ) 2 E i) (f x) := + ae_all_iff.mpr fun i => ContinuousLinearMap.coeFn_compLp _ _ + filter_upwards [hfwd] with x hx + simp only [hx, PiLp.proj_apply, PiLp.inner_apply] + +/-- The canonical finite-coordinate interchange `L²(X; ⨁₂ i, E i) ≃ ⨁₂ i, L²(X; E i)`. -/ +noncomputable def finiteLpPiLpEquiv : + Lp (PiLp 2 E) 2 μ ≃ₗᵢ[ℂ] PiLp 2 (fun i => Lp (E i) 2 μ) where + toFun := finiteLpPiLpForward μ E + invFun := finiteLpPiLpInverse μ E + left_inv := finiteLpPiLpInverse_forward μ E + right_inv := finiteLpPiLpForward_inverse μ E + map_add' := finiteLpPiLpForward_add μ E + map_smul' := finiteLpPiLpForward_smul μ E + norm_map' := finiteLpPiLpForward_norm μ E + +/-- Componentwise representative characterization of the finite-coordinate interchange. -/ +theorem finiteLpPiLpEquiv_apply_ae (f : Lp (PiLp 2 E) 2 μ) (i : ι) : + finiteLpPiLpEquiv μ E f i =ᵐ[μ] fun x => f x i := + ContinuousLinearMap.coeFn_compLp' (PiLp.proj (𝕜 := ℂ) 2 E i) f + +end + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/CurryingMarginal.lean b/LeanPool/LiebThirring/Kinetic/CurryingMarginal.lean new file mode 100644 index 0000000000..dd3612901f --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/CurryingMarginal.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.MeasureTheory.Function.AEEqOfLIntegral +public import LeanPool.LiebThirring.Kinetic.Currying +public import LeanPool.LiebThirring.Kinetic.Permutation + +/-! +# Almost-everywhere equality of particle marginals + +Particle marginals of an antisymmetric state agree as functions almost everywhere, strengthening +the existing equality of marginal tests. + +The density is the particle count times any selected marginal almost everywhere. Selecting `i: +Fin N` already excludes the vacuum. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- Particle marginals of an antisymmetric state agree as functions almost +everywhere, strengthening the existing equality of marginal tests. -/ +theorem particle_marginal_eq_ae {N q : ℕ} (ψ : State N q) (hψ : antisymmetric ψ) + (i j : Fin N) : + (fun x : Position => ∫⁻ y : OtherConfiguration i, + (‖ψ (insertParticle i x y)‖₊ : ℝ≥0∞) ^ 2) =ᵐ[volume] + (fun x : Position => ∫⁻ y : OtherConfiguration j, + (‖ψ (insertParticle j x y)‖₊ : ℝ≥0∞) ^ 2) := by + apply ae_eq_of_forall_setLIntegral_eq_of_sigmaFinite + (measurable_particle_marginal ψ i) (measurable_particle_marginal ψ j) + intro A hA _ + let v : Position → ℝ≥0∞ := A.indicator (fun _ => 1) + have hv : Measurable v := measurable_const.indicator hA + have h := (particle_marginal_testing ψ i v hv).trans + ((particle_marginals_eq ψ hψ i j v).trans + (particle_marginal_testing ψ j v hv).symm) + have ht (k : Fin N) : + (∫⁻ x : Position, v x * ∫⁻ y : OtherConfiguration k, + (‖ψ (insertParticle k x y)‖₊ : ℝ≥0∞) ^ 2) = + ∫⁻ x : Position in A, ∫⁻ y : OtherConfiguration k, + (‖ψ (insertParticle k x y)‖₊ : ℝ≥0∞) ^ 2 := by + rw [← lintegral_indicator hA] + apply lintegral_congr + intro x + simpa only [one_mul] using + (Set.indicator_mul_left (i := x) A (fun _ : Position => (1 : ℝ≥0∞)) + (fun z => ∫⁻ y : OtherConfiguration k, + (‖ψ (insertParticle k z y)‖₊ : ℝ≥0∞) ^ 2)).symm + rw [ht i, ht j] at h + exact h + +/-- The density is the particle count times any selected marginal almost +everywhere. Selecting `i: Fin N` already excludes the vacuum. -/ +theorem density_eq_mul_particle_marginal_ae {N q : ℕ} (ψ : State N q) + (hψ : antisymmetric ψ) (i : Fin N) : + density ψ =ᵐ[volume] fun x : Position => (N : ℝ≥0∞) * + ∫⁻ y : OtherConfiguration i, (‖ψ (insertParticle i x y)‖₊ : ℝ≥0∞) ^ 2 := by + have h := Filter.eventually_all.mpr (fun j : Fin N => particle_marginal_eq_ae ψ hψ j i) + filter_upwards [h] with x hx + simp only [density, hx, Finset.sum_const, Finset.card_univ, Fintype.card_fin, + nsmul_eq_mul] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/CurryingMeasurable.lean b/LeanPool/LiebThirring/Kinetic/CurryingMeasurable.lean new file mode 100644 index 0000000000..2990f27577 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/CurryingMeasurable.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.MeasureTheory.Constructions.BorelSpace.Metric +public import Mathlib.MeasureTheory.Constructions.BorelSpace.Real + +/-! +# Measurability detected by distances + +A map into a second-countable metric Borel space is measurable when all of its distance +functions to fixed target points are measurable. + +An extended-distance variant of `measurable_of_dist_functions` for metric spaces. +-/ + +public section + +open Set Filter MeasureTheory TopologicalSpace + +namespace LiebThirring + +/-- A map into a second-countable metric Borel space is measurable when all of +its distance functions to fixed target points are measurable. -/ +theorem measurable_of_dist_functions {α E : Type*} [MeasurableSpace α] + [MetricSpace E] [SecondCountableTopology E] [MeasurableSpace E] [BorelSpace E] + (f : α → E) (hf : ∀ h : E, Measurable (fun x => dist (f x) h)) : Measurable f := by + apply measurable_of_isOpen + intro s hs + have hex : ∀ h : E, ∃ r > 0, h ∈ s → Metric.ball h r ⊆ s := by + intro h + by_cases hh : h ∈ s + · obtain ⟨r, hr, hrs⟩ := Metric.isOpen_iff.mp hs h hh + exact ⟨r, hr, fun _ => hrs⟩ + · exact ⟨1, zero_lt_one, fun hhs => (hh hhs).elim⟩ + choose r hr_pos hr_sub using hex + obtain ⟨t, ht_sub, ht_countable, ht_cover⟩ := + TopologicalSpace.countable_cover_nhdsWithin + (s := s) (f := fun h => Metric.ball h (r h)) + (fun h _ => mem_nhdsWithin_of_mem_nhds (Metric.ball_mem_nhds h (hr_pos h))) + have h_eq : s = ⋃ h ∈ t, Metric.ball h (r h) := by + apply Set.Subset.antisymm ht_cover + exact iUnion₂_subset fun h hh => hr_sub h (ht_sub hh) + rw [h_eq, preimage_iUnion₂] + apply MeasurableSet.biUnion ht_countable + intro h _ + convert (hf h) (measurableSet_Iio (a := r h)) using 1 + ext x + simp only [mem_preimage, Metric.mem_ball, mem_Iio] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/CurryingProduct.lean b/LeanPool/LiebThirring/Kinetic/CurryingProduct.lean new file mode 100644 index 0000000000..f6b0028b2d --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/CurryingProduct.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.CurryingProductBasic +import LeanPool.LiebThirring.Kinetic.CurryingMeasurable + +/-! +# Existence and uniqueness of the outer L² class + +Uniqueness of an outer L² class from its nested a.e. representative formula. + +A strongly measurable product L² function has a uniquely characterized outer L² class. The +target separability is used only to establish measurability. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring + +variable {α β E : Type*} [MeasurableSpace α] [MeasurableSpace β] + [NormedAddCommGroup E] {μ : Measure α} {ν : Measure β} + +/-- Uniqueness of an outer L² class from its nested a.e. representative formula. -/ +theorem l2_curry_unique (f : α × β → E) (c d : Lp (Lp E 2 ν) 2 μ) + (hc : ∀ᵐ x ∂μ, ∀ᵐ y ∂ν, c x y = f (x, y)) + (hd : ∀ᵐ x ∂μ, ∀ᵐ y ∂ν, d x y = f (x, y)) : c = d := by + apply Lp.ext + filter_upwards [hc, hd] with x hx hy + apply Lp.ext + exact Filter.EventuallyEq.trans hx (Filter.EventuallyEq.symm hy) + +variable [SFinite ν] [SecondCountableTopology (Lp E 2 ν)] + +/-- A strongly measurable product L² function has a uniquely characterized +outer L² class. The target separability is used only to establish measurability. -/ +theorem existsUnique_l2_curry (f : α × β → E) (hf : StronglyMeasurable f) + (hLp : MemLp f 2 (μ.prod ν)) : + ∃! c : Lp (Lp E 2 ν) 2 μ, ∀ᵐ x ∂μ, ∀ᵐ y ∂ν, c x y = f (x, y) := by + classical + borelize ↥(Lp E 2 ν) + let g : α → Lp E 2 ν := fun x => + if hx : MemLp (fun y => f (x, y)) 2 ν then hx.toLp _ else 0 + have hgood : MeasurableSet {x | MemLp (fun y => f (x, y)) 2 ν} := + measurableSet_lt (measurable_l2_slice_eLpNorm f hf) measurable_const + have hdist (h : Lp E 2 ν) : Measurable (fun x => dist (g x) h) := by + have hF : StronglyMeasurable (fun z : α × β => f z - h z.2) := + hf.sub ((Lp.stronglyMeasurable h).comp_measurable measurable_snd) + have hnorm : Measurable (fun x => + (eLpNorm (fun y => f (x, y) - h y) 2 ν).toReal) := + (measurable_l2_slice_eLpNorm _ hF).ennreal_toReal + have heq : (fun x => dist (g x) h) = fun x => + if MemLp (fun y => f (x, y)) 2 ν then + (eLpNorm (fun y => f (x, y) - h y) 2 ν).toReal else dist 0 h := by + funext x + dsimp only [g] + split_ifs with hx + · rw [Lp.dist_def] + apply congrArg ENNReal.toReal + apply eLpNorm_congr_ae + exact hx.coeFn_toLp.sub Filter.EventuallyEq.rfl + · rfl + rw [heq] + exact Measurable.ite hgood hnorm measurable_const + have hg : StronglyMeasurable g := + (measurable_of_dist_functions g hdist).stronglyMeasurable + have hax := memLp_l2_slice_ae f hf hLp + have hmass : (∫⁻ x, ‖g x‖ₑ ^ 2 ∂μ) = + ∫⁻ z, ‖f z‖ₑ ^ 2 ∂(μ.prod ν) := by + calc + _ = ∫⁻ x, ∫⁻ y, ‖f (x, y)‖ₑ ^ 2 ∂ν ∂μ := by + apply lintegral_congr_ae + filter_upwards [hax] with x hx + dsimp only [g] + rw [dite_eq_left hx, ← lintegral_l2_enorm_sq] + exact lintegral_congr_ae (hx.coeFn_toLp.mono + (fun _ hy => congrArg (fun u : E => ‖u‖ₑ ^ 2) hy)) + _ = _ := (lintegral_prod _ (hf.enorm.pow_const 2).aemeasurable).symm + have hgLp : MemLp g 2 μ := by + apply (eLpNorm_lt_top_iff_lintegral_rpow_enorm_lt_top + (by norm_num : (2 : ℝ≥0∞) ≠ 0) (by norm_num : (2 : ℝ≥0∞) ≠ ⊤) + hg.aestronglyMeasurable).mpr + simp only [ENNReal.toReal_ofNat, ENNReal.rpow_two] + rw [hmass] + simpa only [ENNReal.toReal_ofNat, ENNReal.rpow_two] using + lintegral_rpow_enorm_lt_top_of_eLpNorm_lt_top + (by norm_num : (2 : ℝ≥0∞) ≠ 0) (by norm_num : (2 : ℝ≥0∞) ≠ ⊤) hLp + have hc : ∀ᵐ x ∂μ, ∀ᵐ y ∂ν, (hgLp.toLp g) x y = f (x, y) := by + filter_upwards [hgLp.coeFn_toLp, hax] with x hx hxLp + rw [hx] + dsimp only [g] + rw [dite_eq_left hxLp] + exact hxLp.coeFn_toLp + refine ⟨hgLp.toLp g, hc, ?_⟩ + intro d hd + exact l2_curry_unique f d _ hd hc + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/CurryingProductBasic.lean b/LeanPool/LiebThirring/Kinetic/CurryingProductBasic.lean new file mode 100644 index 0000000000..6823844763 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/CurryingProductBasic.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.MeasureTheory.Function.L2Space + +/-! +# Tonelli and seminorms for L² currying + +Tonelli and seminorm identities for product-space L² currying. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring + +variable {α β E : Type*} [MeasurableSpace α] [MeasurableSpace β] + [NormedAddCommGroup E] {μ : Measure α} {ν : Measure β} + +/-- L² mass in extended norm form, valid for arbitrary normed targets. -/ +theorem lintegral_l2_enorm_sq (u : Lp E 2 μ) : + (∫⁻ x, ‖u x‖ₑ ^ 2 ∂μ) = ‖u‖ₑ ^ 2 := by + have h := eLpNorm_nnreal_pow_eq_lintegral (p := (2 : ℝ≥0)) + (by norm_num) (Lp.aestronglyMeasurable u) + simpa only [ENNReal.coe_ofNat, NNReal.coe_ofNat, ENNReal.rpow_two, + ← Lp.enorm_def] using h.symm + +/-- The L² seminorm of a strongly measurable slice is a Tonelli formula. -/ +theorem l2_slice_eLpNorm_eq (f : α × β → E) (hf : StronglyMeasurable f) (x : α) : + eLpNorm (fun y => f (x, y)) 2 ν = + (∫⁻ y, ‖f (x, y)‖ₑ ^ 2 ∂ν) ^ (1 / 2 : ℝ) := by + have hm : AEStronglyMeasurable (fun y => f (x, y)) ν := + (hf.comp_measurable measurable_prodMk_left).aestronglyMeasurable + simpa only [ENNReal.toReal_ofNat, ENNReal.rpow_two] using + eLpNorm_eq_lintegral_rpow_enorm_toReal (by norm_num : (2 : ℝ≥0∞) ≠ 0) + (by norm_num : (2 : ℝ≥0∞) ≠ ⊤) hm + +/-- Slice seminorms are measurable, even before slices are known to be L². -/ +theorem measurable_l2_slice_eLpNorm [SFinite ν] (f : α × β → E) + (hf : StronglyMeasurable f) : + Measurable (fun x => eLpNorm (fun y => f (x, y)) 2 ν) := by + simp_rw [l2_slice_eLpNorm_eq f hf] + exact (ENNReal.continuous_rpow_const (y := (1 / 2 : ℝ))).measurable.comp + ((hf.enorm.pow_const 2).lintegral_prod_right') + +/-- A product L² function has L² slices on almost every outer coordinate. -/ +theorem memLp_l2_slice_ae [SFinite ν] (f : α × β → E) + (hf : StronglyMeasurable f) (hLp : MemLp f 2 (μ.prod ν)) : + ∀ᵐ x ∂μ, MemLp (fun y => f (x, y)) 2 ν := by + have hm : Measurable (fun x => ∫⁻ y, ‖f (x, y)‖ₑ ^ 2 ∂ν) := + (hf.enorm.pow_const 2).lintegral_prod_right' + have hmass : (∫⁻ x, ∫⁻ y, ‖f (x, y)‖ₑ ^ 2 ∂ν ∂μ) < ⊤ := by + rw [← lintegral_prod _ (hf.enorm.pow_const 2).aemeasurable] + simpa only [ENNReal.toReal_ofNat, ENNReal.rpow_two] using + lintegral_rpow_enorm_lt_top_of_eLpNorm_lt_top + (by norm_num : (2 : ℝ≥0∞) ≠ 0) (by norm_num : (2 : ℝ≥0∞) ≠ ⊤) hLp + filter_upwards [ae_lt_top hm hmass.ne] with x hx + have hsm : AEStronglyMeasurable (fun y => f (x, y)) ν := + (hf.comp_measurable measurable_prodMk_left).aestronglyMeasurable + apply (eLpNorm_lt_top_iff_lintegral_rpow_enorm_lt_top + (by norm_num : (2 : ℝ≥0∞) ≠ 0) (by norm_num : (2 : ℝ≥0∞) ≠ ⊤) hsm).mpr + simpa only [ENNReal.toReal_ofNat, ENNReal.rpow_two] using hx + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/CurryingProductMap.lean b/LeanPool/LiebThirring/Kinetic/CurryingProductMap.lean new file mode 100644 index 0000000000..89b16d3ae4 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/CurryingProductMap.lean @@ -0,0 +1,104 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.CurryingProduct + +/-! # The product L² currying linear isometry + +The unique class characterization supplies both linearity and the Tonelli +norm identity. No choices of slice representatives enter the public API. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring + +variable {α β E : Type*} [MeasurableSpace α] [MeasurableSpace β] + [NormedAddCommGroup E] {μ : Measure α} {ν : Measure β} + [SFinite ν] [SecondCountableTopology (Lp E 2 ν)] + +/-- Currying is the unique outer class with the nested slice formula. -/ +@[expose] noncomputable def l2Curry (f : Lp E 2 (μ.prod ν)) : Lp (Lp E 2 ν) 2 μ := + (existsUnique_l2_curry (fun z => f z) (Lp.stronglyMeasurable f) (Lp.memLp f)).choose + +/-- The exact representative characterization of product currying. -/ +theorem l2Curry_ae (f : Lp E 2 (μ.prod ν)) : + ∀ᵐ x ∂μ, ∀ᵐ y ∂ν, l2Curry f x y = f (x, y) := + (existsUnique_l2_curry (fun z => f z) (Lp.stronglyMeasurable f) + (Lp.memLp f)).choose_spec.1 + +/-- The iterated L² norm of the curried class is the original L² norm. -/ +theorem l2Curry_norm (f : Lp E 2 (μ.prod ν)) : ‖l2Curry f‖ = ‖f‖ := by + have hsq : ‖l2Curry f‖ₑ ^ 2 = ‖f‖ₑ ^ 2 := by + calc + _ = ∫⁻ x, ‖l2Curry f x‖ₑ ^ 2 ∂μ := (lintegral_l2_enorm_sq _).symm + _ = ∫⁻ x, ∫⁻ y, ‖l2Curry f x y‖ₑ ^ 2 ∂ν ∂μ := by + apply lintegral_congr + intro x + exact (lintegral_l2_enorm_sq _).symm + _ = ∫⁻ x, ∫⁻ y, ‖f (x, y)‖ₑ ^ 2 ∂ν ∂μ := by + apply lintegral_congr_ae + filter_upwards [l2Curry_ae f] with x hx + exact lintegral_congr_ae (hx.mono + (fun _ hy => congrArg (fun u : E => ‖u‖ₑ ^ 2) hy)) + _ = ∫⁻ z, ‖f z‖ₑ ^ 2 ∂(μ.prod ν) := + (lintegral_prod _ ((Lp.stronglyMeasurable f).enorm.pow_const 2).aemeasurable).symm + _ = _ := lintegral_l2_enorm_sq _ + have hnormsq : ‖l2Curry f‖ ^ 2 = ‖f‖ ^ 2 := by + simpa only [ENNReal.toReal_pow, enorm_eq_nnnorm, ENNReal.coe_toReal, coe_nnnorm] + using congrArg ENNReal.toReal hsq + exact (sq_eq_sq₀ (norm_nonneg _) (norm_nonneg _)).mp hnormsq + +/-- Product currying commutes with addition. -/ +theorem l2Curry_add (f h : Lp E 2 (μ.prod ν)) : l2Curry (f + h) = l2Curry f + l2Curry h := by + apply Lp.ext + have hj := Measure.ae_ae_of_ae_prod (Lp.coeFn_add f h) + filter_upwards [l2Curry_ae (f + h), l2Curry_ae f, l2Curry_ae h, + Lp.coeFn_add (l2Curry f) (l2Curry h), hj] with x hc hf hh hs hx + simp only [Pi.add_apply] at hs hx + rw [hs] + apply Lp.ext + filter_upwards [hc, hf, hh, Lp.coeFn_add (l2Curry f x) (l2Curry h x), hx] + with y hcy hfy hhy hsy hxy + simp only [Pi.add_apply] at hsy + rw [hsy, hcy, hfy, hhy] + exact hxy + +variable [NormedSpace ℂ E] + +/-- Product currying commutes with complex scalar multiplication. -/ +theorem l2Curry_smul (a : ℂ) (f : Lp E 2 (μ.prod ν)) : + l2Curry (a • f) = a • l2Curry f := by + apply Lp.ext + have hj := Measure.ae_ae_of_ae_prod (Lp.coeFn_smul a f) + filter_upwards [l2Curry_ae (a • f), l2Curry_ae f, + Lp.coeFn_smul a (l2Curry f), hj] with x hc hf hs hx + simp only [Pi.smul_apply] at hs hx + rw [hs] + apply Lp.ext + filter_upwards [hc, hf, Lp.coeFn_smul a (l2Curry f x), hx] with y hcy hfy hsy hxy + simp only [Pi.smul_apply] at hsy + rw [hsy, hcy, hfy] + exact hxy + +/-- The generic complex linear isometry from product L² to iterated L². -/ +@[expose] noncomputable def l2CurryLinearIsometry : + Lp E 2 (μ.prod ν) →ₗᵢ[ℂ] Lp (Lp E 2 ν) 2 μ where + toFun := l2Curry + map_add' := l2Curry_add + map_smul' := l2Curry_smul + norm_map' := l2Curry_norm + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/CurryingProductSurjective.lean b/LeanPool/LiebThirring/Kinetic/CurryingProductSurjective.lean new file mode 100644 index 0000000000..908ad6ab63 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/CurryingProductSurjective.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.CurryingProductMap + +/-! +# Surjectivity of product L² currying + +Product currying is onto when the target is complete. The proof puts finite-measure +outer indicators in the range by an explicit product-space representative, then uses +density of L² simple functions and closedness of the range of an isometry. +-/ + +public section + +open MeasureTheory +open scoped ENNReal + +namespace LiebThirring + +variable {α β E : Type*} [MeasurableSpace α] [MeasurableSpace β] + [NormedAddCommGroup E] [NormedSpace ℂ E] [CompleteSpace E] + {μ : Measure α} {ν : Measure β} [SFinite ν] + [SecondCountableTopology (Lp E 2 ν)] + +/-- Every iterated L² class is the curry of a product-space L² class. -/ +theorem l2CurryLinearIsometry_surjective : Function.Surjective + (l2CurryLinearIsometry (μ := μ) (ν := ν) (E := E)) := by + classical + intro g + apply Lp.induction (p := (2 : ℝ≥0∞)) (μ := μ) (by norm_num) + (fun g => g ∈ Set.range (l2CurryLinearIsometry (μ := μ) (ν := ν) (E := E))) + · intro h A hA hμA + let F : α × β → E := (A ×ˢ Set.univ).indicator (fun z => h z.2) + have hFsm : StronglyMeasurable F := by + exact ((Lp.stronglyMeasurable h).comp_measurable measurable_snd).indicator + (hA.prod MeasurableSet.univ) + have hmass : (∫⁻ z, ‖F z‖ₑ ^ 2 ∂(μ.prod ν)) = μ A * ‖h‖ₑ ^ 2 := by + rw [lintegral_prod _ (hFsm.enorm.pow_const 2).aemeasurable] + simp only [F, Set.indicator_apply, apply_ite, enorm_zero] + simp only [Set.mem_prod, Set.mem_univ, and_true] + rw [show (fun x => ∫⁻ y, (if x ∈ A then ‖h y‖ₑ else 0) ^ 2 ∂ν) = + A.indicator (fun _ => ‖h‖ₑ ^ 2) by + funext x + by_cases hx : x ∈ A + · simp only [hx, ↓reduceIte, Set.indicator_of_mem] + exact lintegral_l2_enorm_sq h + · simp [hx]] + rw [lintegral_indicator hA, setLIntegral_const] + exact mul_comm _ _ + have hFLp : MemLp F 2 (μ.prod ν) := by + apply (eLpNorm_lt_top_iff_lintegral_rpow_enorm_lt_top + (by norm_num : (2 : ℝ≥0∞) ≠ 0) (by norm_num : (2 : ℝ≥0∞) ≠ ⊤) + hFsm.aestronglyMeasurable).mpr + simp only [ENNReal.toReal_ofNat, ENNReal.rpow_two, hmass] + exact ENNReal.mul_lt_top hμA (ENNReal.pow_lt_top (by finiteness)) + refine ⟨hFLp.toLp F, ?_⟩ + change l2Curry (hFLp.toLp F) = indicatorConstLp 2 hA hμA.ne h + apply Lp.ext + have hprod := Measure.ae_ae_of_ae_prod hFLp.coeFn_toLp + have hi0 : ((indicatorConstLp 2 hA hμA.ne h : Lp (Lp E 2 ν) 2 μ) : + α → Lp E 2 ν) =ᵐ[μ] A.indicator (fun _ => h) := indicatorConstLp_coeFn + filter_upwards [l2Curry_ae (hFLp.toLp F), hi0, hprod] with x hx hi hp + apply Lp.ext + filter_upwards [hx, hp, Lp.coeFn_zero E 2 ν] with y hxy hprod hz + rw [hxy, hprod, hi] + by_cases hxA : x ∈ A + · simp [F, hxA] + · rw [Set.indicator_of_notMem hxA] + dsimp only [F] + rw [Set.indicator_of_notMem (by simp [hxA]), hz] + rfl + · intro f g hf hg hd ⟨u, hu⟩ ⟨v, hv⟩ + refine ⟨u + v, ?_⟩ + rw [map_add, hu, hv] + · exact (l2CurryLinearIsometry (μ := μ) (ν := ν) (E := + E)).isometry.isUniformInducing.isComplete_range.isClosed + +/-- Product L² and iterated L² are canonically complex-linearly isometric. -/ +@[expose] noncomputable def l2CurryLinearIsometryEquiv : + Lp E 2 (μ.prod ν) ≃ₗᵢ[ℂ] Lp (Lp E 2 ν) 2 μ := + LinearIsometryEquiv.ofSurjective l2CurryLinearIsometry l2CurryLinearIsometry_surjective + +/-- The equivalence has the expected nested representative formula. -/ +theorem l2CurryLinearIsometryEquiv_apply_ae (f : Lp E 2 (μ.prod ν)) : + ∀ᵐ x ∂μ, ∀ᵐ y ∂ν, l2CurryLinearIsometryEquiv f x y = f (x, y) := by + exact l2Curry_ae f + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/CurryingState.lean b/LeanPool/LiebThirring/Kinetic/CurryingState.lean new file mode 100644 index 0000000000..2c70319d56 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/CurryingState.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.Currying +public import LeanPool.LiebThirring.Kinetic.CurryingFinite +public import LeanPool.LiebThirring.Kinetic.CurryingProductSurjective +public import LeanPool.LiebThirring.Kinetic.CurryingTransport + +/-! +# Currying on the state carriers + +The one-particle currying isometry on the spatial and spin carriers. + +The full currying complex linear isometric equivalence, with the original state as its source +and the literal one-particle fiber as its target. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- The full currying complex linear isometric equivalence, with the original state +as its source and the literal one-particle fiber as its target. -/ +@[expose] noncomputable def oneParticleCurryingLinearIsometryEquiv {N q : ℕ} (i : Fin N) : + State N q ≃ₗᵢ[ℂ] Lp (OneParticleFiber i q) 2 (volume : Measure Position) := by + let : Fact ((2 : ℝ≥0∞) ≠ ⊤) := ⟨by norm_num⟩ + let A := l2PullbackEquiv (E := SpinAmplitudes N q) + (insertionMeasurableEquiv i) (measurePreserving_insertion i) + let B := l2TargetEquiv (volume : Measure (Position × OtherConfiguration i)) + (spinCurryingLinearIsometryEquiv (q := q) i) + let C := l2CurryLinearIsometryEquiv (μ := (volume : Measure Position)) + (ν := (volume : Measure (OtherConfiguration i))) + (E := PiLp 2 (fun _ : Fin q => EuclideanSpace ℂ (OtherSpinLabels i q))) + let D := l2TargetEquiv (volume : Measure Position) + (finiteLpPiLpEquiv (volume : Measure (OtherConfiguration i)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherSpinLabels i q))) + exact ((A.trans B).trans C).trans D + +/-- The one-particle currying isometry on the spatial and spin carriers. -/ +@[expose] noncomputable def oneParticleCurrying {N q : ℕ} (i : Fin N) : + State N q →ₗᵢ[ℂ] Lp (OneParticleFiber i q) 2 (volume : Measure Position) := + (oneParticleCurryingLinearIsometryEquiv i).toLinearIsometry + +/-- The currying representative identity, on one common full-measure outer set. -/ +theorem oneParticleCurrying_ae {N q : ℕ} (i : Fin N) (ψ : State N q) : + ∀ᵐ x : Position, ∀ s : Fin q, ∀ᵐ y : OtherConfiguration i, + ∀ t : OtherSpinLabels i q, + oneParticleCurrying i ψ x s y t = + ψ (insertParticle i x y) (insertSpin i s t) := by + let : Fact ((2 : ℝ≥0∞) ≠ ⊤) := ⟨by norm_num⟩ + let A := l2PullbackEquiv (E := SpinAmplitudes N q) + (insertionMeasurableEquiv i) (measurePreserving_insertion i) + let B := l2TargetEquiv (volume : Measure (Position × OtherConfiguration i)) + (spinCurryingLinearIsometryEquiv (q := q) i) + let h := B (A ψ) + let D := l2TargetEquiv (volume : Measure Position) + (finiteLpPiLpEquiv (volume : Measure (OtherConfiguration i)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherSpinLabels i q))) + have hA := Measure.ae_ae_of_ae_prod (l2PullbackEquiv_ae + (insertionMeasurableEquiv i) (measurePreserving_insertion i) ψ) + have hB := Measure.ae_ae_of_ae_prod (l2TargetEquiv_ae + (volume : Measure (Position × OtherConfiguration i)) + (spinCurryingLinearIsometryEquiv (q := q) i) (A ψ)) + change ∀ᵐ x : Position, ∀ s : Fin q, ∀ᵐ y : OtherConfiguration i, + ∀ t : OtherSpinLabels i q, + D (l2Curry h) x s y t = ψ (insertParticle i x y) (insertSpin i s t) + filter_upwards [l2TargetEquiv_ae (volume : Measure Position) + (finiteLpPiLpEquiv (volume : Measure (OtherConfiguration i)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherSpinLabels i q))) (l2Curry h), + l2Curry_ae h, hA, hB] with x hx hc ha hb + intro s + rw [hx] + filter_upwards [finiteLpPiLpEquiv_apply_ae (volume : Measure (OtherConfiguration i)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherSpinLabels i q)) (l2Curry h x) s, + hc, ha, hb] with y hy hcy hay hby + intro t + rw [hy, hcy, hby, hay] + exact congrArg (fun u : SpinAmplitudes N q => u (insertSpin i s t)) + (congrArg ψ (insertionMeasurableEquiv_apply i (x, y))) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/CurryingTransport.lean b/LeanPool/LiebThirring/Kinetic/CurryingTransport.lean new file mode 100644 index 0000000000..7dfe7e3f73 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/CurryingTransport.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.MeasureTheory.Function.L2Space + +/-! +# L² transport by measure and target isometries + +Applying a target isometry pointwise is an isometry of L² classes. + +Pointwise target transport has the prescribed a.e. representative. +-/ + +public section + +open MeasureTheory + +namespace LiebThirring + +variable {α β E F : Type*} [MeasurableSpace α] [MeasurableSpace β] + [NormedAddCommGroup E] [NormedSpace ℂ E] + [NormedAddCommGroup F] [NormedSpace ℂ F] + +/-- Applying a target isometry pointwise is an isometry of L² classes. -/ +@[expose] noncomputable def l2TargetEquiv (μ : Measure α) (A : E ≃ₗᵢ[ℂ] F) : + Lp E 2 μ ≃ₗᵢ[ℂ] Lp F 2 μ where + toFun := A.toContinuousLinearEquiv.toContinuousLinearMap.compLp + invFun := A.symm.toContinuousLinearEquiv.toContinuousLinearMap.compLp + left_inv f := by + apply Lp.ext + filter_upwards [A.symm.toContinuousLinearEquiv.toContinuousLinearMap.coeFn_compLp + (A.toContinuousLinearEquiv.toContinuousLinearMap.compLp f), + A.toContinuousLinearEquiv.toContinuousLinearMap.coeFn_compLp f] with x hx hy + rw [hx, hy] + exact A.symm_apply_apply _ + right_inv f := by + apply Lp.ext + filter_upwards [A.toContinuousLinearEquiv.toContinuousLinearMap.coeFn_compLp + (A.symm.toContinuousLinearEquiv.toContinuousLinearMap.compLp f), + A.symm.toContinuousLinearEquiv.toContinuousLinearMap.coeFn_compLp f] with x hx hy + rw [hx, hy] + exact A.apply_symm_apply _ + map_add' f h := by + exact map_add (A.toContinuousLinearEquiv.toContinuousLinearMap.compLpL 2 μ) f h + map_smul' a f := by + exact map_smul (A.toContinuousLinearEquiv.toContinuousLinearMap.compLpL 2 μ) a f + norm_map' f := by + change ‖A.toContinuousLinearEquiv.toContinuousLinearMap.compLp f‖ = ‖f‖ + rw [Lp.norm_def, Lp.norm_def] + apply congrArg ENNReal.toReal + apply eLpNorm_congr_norm_ae (Lp.aestronglyMeasurable _) (Lp.aestronglyMeasurable f) + filter_upwards [A.toContinuousLinearEquiv.toContinuousLinearMap.coeFn_compLp f] with x hx + rw [hx] + exact A.norm_map _ + +/-- Pointwise target transport has the prescribed a.e. representative. -/ +theorem l2TargetEquiv_ae (μ : Measure α) (A : E ≃ₗᵢ[ℂ] F) (f : Lp E 2 μ) : + l2TargetEquiv μ A f =ᵐ[μ] fun x => A (f x) := + A.toContinuousLinearEquiv.toContinuousLinearMap.coeFn_compLp f + +omit [NormedAddCommGroup F] [NormedSpace ℂ F] in +/-- Pullback by a measure-preserving measurable equivalence is an L² isometry. -/ +@[expose] noncomputable def l2PullbackEquiv {μ : Measure α} {ν : Measure β} + (e : α ≃ᵐ β) (he : MeasurePreserving e μ ν) : Lp E 2 ν ≃ₗᵢ[ℂ] Lp E 2 μ where + toFun := Lp.compMeasurePreserving e he + invFun := Lp.compMeasurePreserving e.symm (MeasurePreserving.symm e he) + left_inv f := by + have h := Lp.compMeasurePreserving_comp_apply f he (MeasurePreserving.symm e he) + simp only [MeasurableEquiv.self_comp_symm, Lp.compMeasurePreserving_id_apply] at h + exact h.symm + right_inv f := by + have h := Lp.compMeasurePreserving_comp_apply f (MeasurePreserving.symm e he) he + simp only [MeasurableEquiv.symm_comp_self, Lp.compMeasurePreserving_id_apply] at h + exact h.symm + map_add' := map_add (Lp.compMeasurePreservingₗ ℂ e he) + map_smul' := map_smul (Lp.compMeasurePreservingₗ ℂ e he) + norm_map' := fun f => Lp.norm_compMeasurePreserving f he + +omit [NormedAddCommGroup F] [NormedSpace ℂ F] in +/-- The measure transport is pullback on a.e. representatives. -/ +theorem l2PullbackEquiv_ae {μ : Measure α} {ν : Measure β} + (e : α ≃ᵐ β) (he : MeasurePreserving e μ ν) (f : Lp E 2 ν) : + l2PullbackEquiv e he f =ᵐ[μ] fun x => f (e x) := + Lp.coeFn_compMeasurePreserving f he + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/Cutoff.lean b/LeanPool/LiebThirring/Kinetic/Cutoff.lean new file mode 100644 index 0000000000..a7e896f3fc --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/Cutoff.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.Fourier.LpSpace +public import LeanPool.LiebThirring.Defs.Configuration +public import Mathlib.MeasureTheory.Measure.Lebesgue.VolumeOfBalls + +/-! +# Low Fourier cutoff fields + +The Fourier kinetic multiplier with the normalization. + +The closed low momentum region at real energy `E`. +-/ + +public section + +open MeasureTheory +open scoped FourierTransform SchwartzMap ENNReal + +namespace LiebThirring + +/-- The Fourier kinetic multiplier with the normalization. -/ +@[expose] noncomputable def fourierKineticMultiplier (ξ : Position) : ℝ := + (2 * Real.pi) ^ 2 * ‖ξ‖ ^ 2 + +/-- The closed low momentum region at real energy `E`. -/ +@[expose] noncomputable def lowMomentumRegion (E : ℝ) : Set Position := + {ξ | fourierKineticMultiplier ξ ≤ E} + +theorem continuous_fourierKineticMultiplier : Continuous fourierKineticMultiplier := by + unfold fourierKineticMultiplier + fun_prop + +theorem measurableSet_lowMomentumRegion (E : ℝ) : MeasurableSet (lowMomentumRegion E) := + measurableSet_le continuous_fourierKineticMultiplier.measurable measurable_const + +/-- The low region is exactly the ball of radius `sqrt E / (2π)`. -/ +theorem lowMomentumRegion_eq_closedBall (E : ℝ) (hE : 0 ≤ E) : + lowMomentumRegion E = Metric.closedBall 0 (Real.sqrt E / (2 * Real.pi)) := by + ext ξ + simp only [lowMomentumRegion, fourierKineticMultiplier, Set.mem_ofPred_eq, + Metric.mem_closedBall, dist_zero_right] + rw [le_div_iff₀ (mul_pos (by norm_num) Real.pi_pos)] + have hs := Real.sq_sqrt hE + have hn := norm_nonneg ξ + have hsn := Real.sqrt_nonneg E + have hprod : 0 ≤ ‖ξ‖ * (2 * Real.pi) := mul_nonneg hn (by positivity) + rw [← sq_le_sq₀ hprod hsn] + rw [hs] + ring_nf + +/-- Every low momentum region at nonnegative energy has finite volume. -/ +theorem volume_lowMomentumRegion_ne_top (E : ℝ) (hE : 0 ≤ E) : + volume (lowMomentumRegion E) ≠ ⊤ := by + rw [lowMomentumRegion_eq_closedBall E hE, EuclideanSpace.volume_closedBall_fin_three] + finiteness + +/-- Exact three-dimensional phase-space volume, including `E = 0`. -/ +theorem volume_lowMomentumRegion (E : ℝ) (hE : 0 ≤ E) : + volume (lowMomentumRegion E) = ENNReal.ofReal ((1 / (6 * Real.pi ^ 2)) * E ^ ((3 : ℝ) / 2)) := + by + rw [lowMomentumRegion_eq_closedBall E hE, EuclideanSpace.volume_closedBall_fin_three, + ← ENNReal.ofReal_pow (div_nonneg (Real.sqrt_nonneg E) (by positivity)), + ← ENNReal.ofReal_mul (by positivity)] + congr 1 + rw [Real.rpow_div_two_eq_sqrt 3 hE] + rw [show (3 : ℝ) = (3 : ℕ) by norm_num, Real.rpow_natCast] + field_simp + ring + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- The same raw inverse Fourier integral is used for every real energy and point. -/ +@[expose] noncomputable def lowFourierField (h : Lp H 2 (volume : Measure Position)) + (E : ℝ) (x : Position) : H := + 𝓕⁻ ((lowMomentumRegion E).indicator + (Lp.fourierTransformₗᵢ Position H h : Position → H)) x + +/-- The supported Fourier representative is integrable, with no finite-energy premise. -/ +theorem integrable_lowFourierRepresentative (h : Lp H 2 (volume : Measure Position)) + (E : ℝ) (hE : 0 ≤ E) : + Integrable ((lowMomentumRegion E).indicator + (Lp.fourierTransformₗᵢ Position H h : Position → H)) := + (integrable_indicator_iff (measurableSet_lowMomentumRegion E)).mpr + (integrableOn_Lp_of_measure_ne_top (Lp.fourierTransformₗᵢ Position H h) + (by norm_num) (volume_lowMomentumRegion_ne_top E hE)) + +/-- Each inverse Fourier integrand defining the low field is Bochner integrable. -/ +theorem integrable_lowFourierField (h : Lp H 2 (volume : Measure Position)) + (E : ℝ) (hE : 0 ≤ E) (x : Position) : + Integrable (fun ξ : Position => Real.fourierChar (inner ℝ ξ x) • + (lowMomentumRegion E).indicator + (Lp.fourierTransformₗᵢ Position H h : Position → H) ξ) := by + simpa only [inner_neg_right, neg_neg] using + (Real.fourierIntegral_convergent_iff (-x)).mpr + (integrable_lowFourierRepresentative h E hE) + +/-- The defining integral has the positive inverse Fourier phase from Fourier cutoff. -/ +theorem lowFourierField_eq_integral (h : Lp H 2 (volume : Measure Position)) + (E : ℝ) (x : Position) : + lowFourierField h E x = ∫ ξ in lowMomentumRegion E, + Real.fourierChar (inner ℝ ξ x) • (Lp.fourierTransformₗᵢ Position H h) ξ := by + rw [lowFourierField, Real.fourierInv_eq, ← integral_indicator + (measurableSet_lowMomentumRegion E)] + apply integral_congr_ae + filter_upwards with ξ + by_cases hξ : ξ ∈ lowMomentumRegion E + · simp only [Set.indicator_of_mem hξ] + · simp only [Set.indicator_of_notMem hξ, smul_zero] + +/-- One fixed Fourier representative gives joint strong measurability for all energies. -/ +theorem stronglyMeasurable_lowFourierField (h : Lp H 2 (volume : Measure Position)) : + StronglyMeasurable (fun p : ℝ × Position => lowFourierField h p.1 p.2) := by + let A : Set ((ℝ × Position) × Position) := + {p | fourierKineticMultiplier p.2 ≤ p.1.1} + have hA : MeasurableSet A := measurableSet_le + (continuous_fourierKineticMultiplier.measurable.comp measurable_snd) + (measurable_fst.comp measurable_fst) + have hc : Continuous (fun p : (ℝ × Position) × Position => + Real.fourierChar (inner ℝ p.2 p.1.2)) := by + fun_prop + have hf := (Lp.stronglyMeasurable (Lp.fourierTransformₗᵢ Position H h)).comp_measurable + (measurable_snd : Measurable (Prod.snd : (ℝ × Position) × Position → Position)) + have hi := (hc.stronglyMeasurable.smul hf).indicator hA + have hm := hi.integral_prod_right' (ν := (volume : Measure Position)) + have heq : (fun p : ℝ × Position => lowFourierField h p.1 p.2) = + (fun p : ℝ × Position => ∫ ξ, A.indicator + (fun z => Real.fourierChar (inner ℝ z.2 z.1.2) • + (Lp.fourierTransformₗᵢ Position H h) z.2) (p, ξ)) := by + funext p + rw [lowFourierField_eq_integral, ← integral_indicator + (measurableSet_lowMomentumRegion p.1)] + apply integral_congr_ae + filter_upwards with ξ + by_cases hξ : ξ ∈ lowMomentumRegion p.1 + · have hz : (p, ξ) ∈ A := hξ + simp only [Set.indicator_of_mem hξ, Set.indicator_of_mem hz] + · have hz : (p, ξ) ∉ A := hξ + simp only [Set.indicator_of_notMem hξ, Set.indicator_of_notMem hz] + rw [heq] + exact hm + +/-- Subtracting the low integral from any fixed strongly measurable representative +preserves joint strong measurability. -/ +theorem stronglyMeasurable_highFourierField (h : Lp H 2 (volume : Measure Position)) + (f : Position → H) (hf : StronglyMeasurable f) : + StronglyMeasurable (fun p : ℝ × Position => f p.2 - lowFourierField h p.1 p.2) := + (hf.comp_measurable measurable_snd).sub (stronglyMeasurable_lowFourierField h) + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/CutoffProjection.lean b/LeanPool/LiebThirring/Kinetic/CutoffProjection.lean new file mode 100644 index 0000000000..21eada0441 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/CutoffProjection.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.Cutoff +public import LeanPool.LiebThirring.Fourier.IntegralL2 + +/-! +# Cutoff integrals represent the L² projections + +The literal low-frequency part of the L² Fourier transform. + +The spatial low projection is inverse L² Fourier of the cutoff class. +-/ + +public section + +open MeasureTheory +open scoped FourierTransform + +namespace LiebThirring + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- The literal low-frequency part of the L² Fourier transform. -/ +@[expose] noncomputable def lowFrequencyClass (h : Lp H 2 (volume : Measure Position)) + (E : ℝ) : Lp H 2 (volume : Measure Position) := + ((Lp.memLp (Lp.fourierTransformₗᵢ Position H h)).indicator + (measurableSet_lowMomentumRegion E)).toLp + ((lowMomentumRegion E).indicator + (Lp.fourierTransformₗᵢ Position H h : Position → H)) + +/-- The spatial low projection is inverse L² Fourier of the cutoff class. -/ +@[expose] noncomputable def lowFourierProjection (h : Lp H 2 (volume : Measure Position)) + (E : ℝ) : Lp H 2 (volume : Measure Position) := + 𝓕⁻ (lowFrequencyClass h E) + +/-- The continuous raw low field represents the exact inverse L² projection. -/ +theorem lowFourierProjection_ae (h : Lp H 2 (volume : Measure Position)) + (E : ℝ) (hE : 0 ≤ E) : + (lowFourierProjection h E : Position → H) =ᵐ[volume] lowFourierField h E := + Fourier.fourierInv_toLp_ae_eq (integrable_lowFourierRepresentative h E hE) + ((Lp.memLp (Lp.fourierTransformₗᵢ Position H h)).indicator + (measurableSet_lowMomentumRegion E)) + +/-- The literal complementary high-frequency class. -/ +@[expose] noncomputable def highFrequencyClass (h : Lp H 2 (volume : Measure Position)) + (E : ℝ) : Lp H 2 (volume : Measure Position) := + ((Lp.memLp (Lp.fourierTransformₗᵢ Position H h)).indicator + (measurableSet_lowMomentumRegion E).compl).toLp + ((lowMomentumRegion E)ᶜ.indicator + (Lp.fourierTransformₗᵢ Position H h : Position → H)) + +/-- The complementary frequency class is Fourier minus its low-frequency part. -/ +theorem highFrequencyClass_eq_sub (h : Lp H 2 (volume : Measure Position)) (E : ℝ) : + highFrequencyClass h E = 𝓕 h - lowFrequencyClass h E := by + apply Lp.ext + filter_upwards [ + ((Lp.memLp (Lp.fourierTransformₗᵢ Position H h)).indicator + (measurableSet_lowMomentumRegion E).compl).coeFn_toLp, + ((Lp.memLp (Lp.fourierTransformₗᵢ Position H h)).indicator + (measurableSet_lowMomentumRegion E)).coeFn_toLp, + Lp.coeFn_sub (𝓕 h) (lowFrequencyClass h E)] with ξ hh hl hs + change highFrequencyClass h E ξ = _ at hh + change lowFrequencyClass h E ξ = _ at hl + rw [hh, hs, Pi.sub_apply, hl] + change (lowMomentumRegion E)ᶜ.indicator ((Lp.fourierTransformₗᵢ Position H h : Lp H 2 volume) : + Position → H) ξ = + (Lp.fourierTransformₗᵢ Position H h) ξ - (lowMomentumRegion E).indicator + ((Lp.fourierTransformₗᵢ Position H h : Lp H 2 volume) : Position → H) ξ + by_cases hξ : ξ ∈ lowMomentumRegion E + · rw [Set.indicator_of_notMem (Set.notMem_compl_iff.mpr hξ), + Set.indicator_of_mem hξ, sub_self] + · rw [Set.indicator_of_mem (show ξ ∈ (lowMomentumRegion E)ᶜ from hξ), + Set.indicator_of_notMem hξ, sub_zero] + +/-- The fixed representative difference represents inverse L² high projection. -/ +theorem highFourierProjection_ae (h : Lp H 2 (volume : Measure Position)) + (E : ℝ) (hE : 0 ≤ E) (f : Position → H) (hf : (h : Position → H) =ᵐ[volume] f) : + ((𝓕⁻ (highFrequencyClass h E) : Lp H 2 volume) : Position → H) =ᵐ[volume] + (fun x => f x - lowFourierField h E x) := by + have heq : (𝓕⁻ (highFrequencyClass h E) : Lp H 2 volume) = + h - lowFourierProjection h E := by + rw [highFrequencyClass_eq_sub] + change (Lp.fourierTransformₗᵢ Position H).symm + ((Lp.fourierTransformₗᵢ Position H) h - lowFrequencyClass h E) = _ + rw [map_sub, LinearIsometryEquiv.symm_apply_apply] + rfl + rw [heq] + filter_upwards [Lp.coeFn_sub h (lowFourierProjection h E), hf, + lowFourierProjection_ae h E hE] with x hs hh hl + exact hs.trans (congrArg₂ (fun a b : H => a - b) hh hl) + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/DensityBasic.lean b/LeanPool/LiebThirring/Kinetic/DensityBasic.lean new file mode 100644 index 0000000000..8f928ce7ff --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/DensityBasic.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. +public import LeanPool.LiebThirring.Defs.Density +public import LeanPool.LiebThirring.Kinetic.Insertion +/-! +# Measurability, testing and mass of the one-particle density + +Arbitrary representatives agreeing almost everywhere give the same density almost everywhere, +with no measurability assumption on the replacement. +-/ +public section +open MeasureTheory WithLp +open scoped ENNReal NNReal +namespace LiebThirring + +theorem measurable_particlePosition {N : ℕ} (i : Fin N) : + Measurable (fun x : Configuration N => particlePosition x i) := by + exact ((PiLp.continuous_toLp 2 (fun _ : Fin 3 => ℝ)).comp + (continuous_pi (fun a => PiLp.continuous_apply 2 (fun _ : Fin N × Fin 3 => ℝ) + (i, a)))).measurable + +theorem measurable_state_norm_sq {N q : ℕ} (ψ : State N q) : + Measurable (fun x : Configuration N => (‖ψ x‖₊ : ℝ≥0∞) ^ 2) := + (Lp.stronglyMeasurable ψ).measurable.nnnorm.coe_nnreal_ennreal.pow_const 2 + +theorem measurable_inserted_state_norm_sq {N q : ℕ} (ψ : State N q) (i : Fin N) : + Measurable (fun z : Position × OtherConfiguration i => + (‖ψ (insertParticle i z.1 z.2)‖₊ : ℝ≥0∞) ^ 2) := + (measurable_state_norm_sq ψ).comp (measurePreserving_insertParticle i).measurable + +theorem measurable_particle_marginal {N q : ℕ} (ψ : State N q) (i : Fin N) : + Measurable (fun x : Position => ∫⁻ y : OtherConfiguration i, + (‖ψ (insertParticle i x y)‖₊ : ℝ≥0∞) ^ 2) := + (measurable_inserted_state_norm_sq ψ i).lintegral_prod_right' + +theorem measurable_density {N q : ℕ} (ψ : State N q) : Measurable (density ψ) := by + exact Finset.measurable_sum _ (fun i _ => measurable_particle_marginal ψ i) + +theorem particle_marginal_testing {N q : ℕ} (ψ : State N q) (i : Fin N) + (v : Position → ℝ≥0∞) (hv : Measurable v) : + (∫⁻ x : Position, v x * ∫⁻ y : OtherConfiguration i, + (‖ψ (insertParticle i x y)‖₊ : ℝ≥0∞) ^ 2) = + ∫⁻ x : Configuration N, v (particlePosition x i) * (‖ψ x‖₊ : ℝ≥0∞) ^ 2 := by + have hf : Measurable (fun z : Configuration N => + v (particlePosition z i) * (‖ψ z‖₊ : ℝ≥0∞) ^ 2) := + (hv.comp (measurable_particlePosition i)).mul (measurable_state_norm_sq ψ) + have hm : Measurable (fun z : Position × OtherConfiguration i => + v z.1 * (‖ψ (insertParticle i z.1 z.2)‖₊ : ℝ≥0∞) ^ 2) := + (hv.comp measurable_fst).mul (measurable_inserted_state_norm_sq ψ i) + calc + _ = ∫⁻ x : Position, ∫⁻ y : OtherConfiguration i, + v x * (‖ψ (insertParticle i x y)‖₊ : ℝ≥0∞) ^ 2 := by + apply lintegral_congr + intro x + have hy := (measurable_inserted_state_norm_sq ψ i).comp + (measurable_prodMk_left (x := x)) + exact (lintegral_const_mul (v x) hy).symm + _ = ∫⁻ z : Position × OtherConfiguration i, + v z.1 * (‖ψ (insertParticle i z.1 z.2)‖₊ : ℝ≥0∞) ^ 2 := + (lintegral_prod _ hm.aemeasurable).symm + _ = _ := by + have ht := (measurePreserving_insertParticle i).lintegral_comp hf + simpa only [particlePosition_insertParticle] using ht + +theorem density_testing (N q : ℕ) (ψ : State N q) (v : Position → ℝ≥0∞) + (hv : Measurable v) : + (∫⁻ x : Position, v x * density ψ x) = + ∑ i : Fin N, ∫⁻ x : Configuration N, + v (particlePosition x i) * (‖ψ x‖₊ : ℝ≥0∞) ^ 2 := by + simp only [density, Finset.mul_sum] + rw [lintegral_finsetSum (f := fun i x => v x * ∫⁻ y : OtherConfiguration i, + (‖ψ (insertParticle i x y)‖₊ : ℝ≥0∞) ^ 2) Finset.univ + (fun i _ => hv.mul (measurable_particle_marginal ψ i))] + exact Finset.sum_congr rfl (fun i _ => particle_marginal_testing ψ i v hv) + +theorem lintegral_state_norm_sq {N q : ℕ} (ψ : State N q) : + (∫⁻ x : Configuration N, (‖ψ x‖₊ : ℝ≥0∞) ^ 2) = (‖ψ‖₊ : ℝ≥0∞) ^ 2 := by + have h := eLpNorm_nnreal_pow_eq_lintegral (p := (2 : ℝ≥0)) (by norm_num) + (Lp.aestronglyMeasurable ψ) + simpa only [ENNReal.coe_ofNat, NNReal.coe_ofNat, ENNReal.rpow_two, + ← Lp.enorm_def, enorm_eq_nnnorm] using h.symm + +theorem density_mass {N q : ℕ} (ψ : State N q) : + (∫⁻ x : Position, density ψ x) = (N : ℝ≥0∞) * (‖ψ‖₊ : ℝ≥0∞) ^ 2 := by + have h := density_testing N q ψ (fun _ => 1) measurable_const + simpa only [one_mul, lintegral_state_norm_sq, Finset.sum_const, Finset.card_univ, + Fintype.card_fin, nsmul_eq_mul] using h + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/Encoding.lean b/LeanPool/LiebThirring/Kinetic/Encoding.lean new file mode 100644 index 0000000000..dbede0ce29 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/Encoding.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.State + +/-! +# Coordinate norms and singled-out spin encoding + +The configuration norm is the sum of particle squared norms (coordinate norms). + +The amplitude norm is the sum of squared scalar spin amplitudes (coordinate norms). +-/ + +public section + +open MeasureTheory WithLp + +namespace LiebThirring + +/-- Spins of all particles other than the selected particle. -/ +abbrev OtherSpinLabels {N : ℕ} (i : Fin N) (q : ℕ) := + {j : Fin N // j ≠ i} → Fin q + +/-- Insert the selected spin into a configuration of the remaining spins. -/ +@[expose] def insertSpin {N q : ℕ} (i : Fin N) (s : Fin q) + (t : OtherSpinLabels i q) : SpinLabels N q := + fun j => if h : j = i then s else t ⟨j, h⟩ + +@[simp] theorem insertSpin_self {N q : ℕ} (i : Fin N) (s : Fin q) + (t : OtherSpinLabels i q) : insertSpin i s t i = s := by + simp [insertSpin] + +@[simp] theorem insertSpin_other {N q : ℕ} (i : Fin N) (s : Fin q) + (t : OtherSpinLabels i q) (j : {j : Fin N // j ≠ i}) : + insertSpin i s t j.val = t j := by + simp only [insertSpin, dite_eq_right j.property] + +/-- Split a spin assignment into the selected spin and the remaining spins. -/ +@[expose] def spinInsertionEquiv {N q : ℕ} (i : Fin N) : + (Fin q × OtherSpinLabels i q) ≃ SpinLabels N q where + toFun z := insertSpin i z.1 z.2 + invFun t := (t i, fun j => t j.val) + left_inv z := by + apply Prod.ext + · exact insertSpin_self i z.1 z.2 + · funext j + exact insertSpin_other i z.1 z.2 j + right_inv t := by + funext j + dsimp [insertSpin] + split + · rename_i h + exact congrArg t h.symm + · rfl + +/-- Spin regrouping as a complex linear isometry, before spatial currying. -/ +@[expose] noncomputable def spinCurryingLinearIsometryEquiv {N q : ℕ} (i : Fin N) : + SpinAmplitudes N q ≃ₗᵢ[ℂ] + PiLp 2 (fun _ : Fin q => EuclideanSpace ℂ (OtherSpinLabels i q)) := + (LinearIsometryEquiv.piLpCongrLeft 2 ℂ ℂ (spinInsertionEquiv i).symm).trans + ((LinearIsometryEquiv.piLpCongrLeft 2 ℂ ℂ + (Equiv.sigmaEquivProd (Fin q) (OtherSpinLabels i q)).symm).trans + (LinearIsometryEquiv.piLpCurry ℂ 2 + (fun (_ : Fin q) (_ : OtherSpinLabels i q) => ℂ))) + +@[simp] theorem spinCurryingLinearIsometryEquiv_apply {N q : ℕ} (i : Fin N) + (u : SpinAmplitudes N q) (s : Fin q) (t : OtherSpinLabels i q) : + spinCurryingLinearIsometryEquiv i u s t = u (insertSpin i s t) := rfl + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/FourierFactor.lean b/LeanPool/LiebThirring/Kinetic/FourierFactor.lean new file mode 100644 index 0000000000..50cf948c27 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/FourierFactor.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.KineticEnergy +public import LeanPool.LiebThirring.Kinetic.DensityBasic +public import LeanPool.LiebThirring.Fourier.Covariance +public import LeanPool.LiebThirring.Kinetic.Permutation +public import LeanPool.LiebThirring.Kinetic.CurryingTransport + +/-! +# Particle Fourier energies + +The Fourier kinetic energy associated with particle `i` (Fourier factorization). + +Full kinetic energy is the sum of the particle energies, including at infinity. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal FourierTransform + +namespace LiebThirring + +/-- The Fourier kinetic energy associated with particle `i` (Fourier factorization). -/ +@[expose] noncomputable def particleFourierEnergy {N q : ℕ} (ψ : State N q) + (i : Fin N) : ℝ≥0∞ := + ∫⁻ ξ : Configuration N, + ENNReal.ofReal ((2 * Real.pi) ^ 2) * (‖particlePosition ξ i‖₊ : ℝ≥0∞) ^ 2 * + (‖(Lp.fourierTransformₗᵢ (Configuration N) (SpinAmplitudes N q) ψ) ξ‖₊ : ℝ≥0∞) ^ 2 + +/-- Full kinetic energy is the sum of the particle energies, including at infinity. -/ +theorem kineticEnergy_eq_sum_particleFourierEnergy {N q : ℕ} (ψ : State N q) : + kineticEnergy ψ = ∑ i : Fin N, particleFourierEnergy ψ i := by + have hnorm (ξ : Configuration N) : + (‖ξ‖₊ : ℝ≥0∞) ^ 2 = ∑ i : Fin N, (‖particlePosition ξ i‖₊ : ℝ≥0∞) ^ 2 := by + have hp (i : Fin N) : (‖particlePosition ξ i‖₊ : ℝ≥0∞) ^ 2 = + ∑ a : Fin 3, ENNReal.ofReal (ξ (i, a) ^ 2) := by + change ‖particlePosition ξ i‖ₑ ^ 2 = _ + rw [← ofReal_norm, ← ENNReal.ofReal_pow (norm_nonneg _), + EuclideanSpace.real_norm_sq_eq, + ENNReal.ofReal_sum_of_nonneg (fun _ _ => sq_nonneg _)] + rfl + change ‖ξ‖ₑ ^ 2 = _ + rw [← ofReal_norm, ← ENNReal.ofReal_pow (norm_nonneg _), + EuclideanSpace.real_norm_sq_eq, + ENNReal.ofReal_sum_of_nonneg (fun _ _ => sq_nonneg _), Fintype.sum_prod_type] + exact Finset.sum_congr rfl (fun i _ => (hp i).symm) + unfold kineticEnergy particleFourierEnergy + simp_rw [hnorm, Finset.mul_sum, Finset.sum_mul] + rw [lintegral_finsetSum] + intro i _ + exact ((measurable_const.mul + ((measurable_particlePosition i).nnnorm.coe_nnreal_ennreal.pow_const 2)).mul + (measurable_state_norm_sq (Lp.fourierTransformₗᵢ _ _ ψ))) + +/-- Simultaneous particle permutation packaged as a unitary on `State`. -/ +@[expose] noncomputable def statePermutationLinearIsometryEquiv {N q : ℕ} + (σ : Equiv.Perm (Fin N)) : State N q ≃ₗᵢ[ℂ] State N q := + (l2PullbackEquiv (permutationLinearIsometryEquiv σ).toHomeomorph.toMeasurableEquiv + (permutationLinearIsometryEquiv σ).measurePreserving).trans + (l2TargetEquiv (volume : Measure (Configuration N)) (spinPermutationLinearIsometryEquiv σ)) + +/-- The L² simultaneous spatial and spin permutation from the formulas. -/ +@[expose] noncomputable def simultaneousPermutation {N q : ℕ} + (σ : Equiv.Perm (Fin N)) (ψ : State N q) : State N q := + statePermutationLinearIsometryEquiv σ ψ + +@[simp] theorem statePermutationLinearIsometryEquiv_apply {N q : ℕ} + (σ : Equiv.Perm (Fin N)) (ψ : State N q) : + statePermutationLinearIsometryEquiv σ ψ = simultaneousPermutation σ ψ := rfl + +/-- The permutation operator has exactly the simultaneous representative. -/ +theorem simultaneousPermutation_apply_ae {N q : ℕ} (σ : Equiv.Perm (Fin N)) + (ψ : State N q) : + ∀ᵐ x ∂(volume : Measure (Configuration N)), + ∀ s : SpinLabels N q, simultaneousPermutation σ ψ x s = + ψ (permutePositions σ x) (permuteSpins σ s) := by + filter_upwards [ + (spinPermutationLinearIsometryEquiv (q := q) + σ).toContinuousLinearEquiv.toContinuousLinearMap.coeFn_compLp + (Lp.compMeasurePreserving (permutationLinearIsometryEquiv σ) + (permutationLinearIsometryEquiv σ).measurePreserving ψ), + Lp.coeFn_compMeasurePreserving ψ (permutationLinearIsometryEquiv σ).measurePreserving] + with x hx hy + intro s + change simultaneousPermutation σ ψ x = + spinPermutationLinearIsometryEquiv σ + (Lp.compMeasurePreserving (permutationLinearIsometryEquiv σ) + (permutationLinearIsometryEquiv σ).measurePreserving ψ x) at hx + rw [hx, hy] + rfl + +/-- The full L² Fourier transform intertwines every simultaneous particle permutation. -/ +theorem fourier_simultaneousPermutation {N q : ℕ} (σ : Equiv.Perm (Fin N)) + (ψ : State N q) : + 𝓕 (simultaneousPermutation σ ψ) = simultaneousPermutation σ (𝓕 ψ) := by + unfold simultaneousPermutation statePermutationLinearIsometryEquiv + change 𝓕 + ((spinPermutationLinearIsometryEquiv σ).toContinuousLinearEquiv.toContinuousLinearMap.compLp + (Lp.compMeasurePreserving (permutationLinearIsometryEquiv σ) + (permutationLinearIsometryEquiv σ).measurePreserving ψ)) = _ + rw [Fourier.fourier_compLp, Fourier.fourier_compMeasurePreserving] + rfl + +/-- An antisymmetric state is an eigenvector of each simultaneous permutation. -/ +theorem simultaneousPermutation_eq_sign_smul {N q : ℕ} (σ : Equiv.Perm (Fin N)) + (ψ : State N q) (hψ : antisymmetric ψ) : + simultaneousPermutation σ ψ = ((((Equiv.Perm.sign σ : ℤˣ) : ℤ) : ℂ)) • ψ := by + apply Lp.ext + filter_upwards [simultaneousPermutation_apply_ae σ ψ, hψ σ, + Lp.coeFn_smul ((((Equiv.Perm.sign σ : ℤˣ) : ℤ) : ℂ)) ψ] with x hx ha hs + rw [hs] + ext s + exact (hx s).trans (ha s) + +/-- Full Fourier transformation preserves the antisymmetry condition. -/ +theorem antisymmetric_fourier {N q : ℕ} (ψ : State N q) (hψ : antisymmetric ψ) : + antisymmetric (𝓕 ψ) := by + intro σ + have heq : simultaneousPermutation σ (𝓕 ψ) = + ((((Equiv.Perm.sign σ : ℤˣ) : ℤ) : ℂ)) • 𝓕 ψ := by + rw [← fourier_simultaneousPermutation, simultaneousPermutation_eq_sign_smul σ ψ hψ, + FourierTransform.fourier_smul] + filter_upwards [simultaneousPermutation_apply_ae σ (𝓕 ψ), + Lp.coeFn_smul ((((Equiv.Perm.sign σ : ℤˣ) : ℤ) : ℂ)) (𝓕 ψ)] with x hx hs + intro s + rw [← hx s, heq, hs] + rfl + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/FourierFactorCurrying.lean b/LeanPool/LiebThirring/Kinetic/FourierFactorCurrying.lean new file mode 100644 index 0000000000..f548d45e8c --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/FourierFactorCurrying.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.FourierFactor +public import LeanPool.LiebThirring.Kinetic.CurryingDensity + +/-! +# Fiber Fourier transform and weighted currying + +Fourier transform on every remaining-spin Hilbert component. + +The full Fourier particle integral equals the weighted norm of its curried full Fourier +transform, without any finite-energy assumption. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal FourierTransform + +namespace LiebThirring + +/-- Fourier transform on every remaining-spin Hilbert component. -/ +@[expose] noncomputable def restFourierLinearIsometryEquiv {N q : ℕ} (i : Fin N) : + OneParticleFiber i q ≃ₗᵢ[ℂ] OneParticleFiber i q := + LinearIsometryEquiv.piLpCongrRight 2 (fun _ : Fin q => + Lp.fourierTransformₗᵢ (OtherConfiguration i) (EuclideanSpace ℂ (OtherSpinLabels i q))) + +/-- The full Fourier particle integral equals the weighted norm of its curried +full Fourier transform, without any finite-energy assumption. -/ +theorem particleFourierEnergy_eq_currying_fullFourier {N q : ℕ} (i : Fin N) (ψ : State N q) : + particleFourierEnergy ψ i = ∫⁻ ξ : Position, + ENNReal.ofReal ((2 * Real.pi) ^ 2) * (‖ξ‖₊ : ℝ≥0∞) ^ 2 * + (‖oneParticleCurrying i (𝓕 ψ) ξ‖₊ : ℝ≥0∞) ^ 2 := by + let w : Position → ℝ≥0∞ := fun x => + ENNReal.ofReal ((2 * Real.pi) ^ 2) * (‖x‖₊ : ℝ≥0∞) ^ 2 + have hw : Measurable w := + measurable_const.mul (measurable_id.nnnorm.coe_nnreal_ennreal.pow_const 2) + change (∫⁻ X : Configuration N, w (particlePosition X i) * + (‖(Lp.fourierTransformₗᵢ (Configuration N) (SpinAmplitudes N q) ψ) X‖₊ : ℝ≥0∞) ^ 2) = _ + calc + _ = ∫⁻ ξ : Position, w ξ * ∫⁻ y : OtherConfiguration i, + (‖(Lp.fourierTransformₗᵢ (Configuration N) (SpinAmplitudes N q) ψ) + (insertParticle i ξ y)‖₊ : ℝ≥0∞) ^ 2 := + (particle_marginal_testing (Lp.fourierTransformₗᵢ _ _ ψ) i w hw).symm + _ = _ := by + apply lintegral_congr_ae + filter_upwards [particle_marginal_eq_currying_norm_sq_ae i (𝓕 ψ)] with ξ hξ + exact congrArg (fun a : ℝ≥0∞ => w ξ * a) hξ + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/FourierFactorDensity.lean b/LeanPool/LiebThirring/Kinetic/FourierFactorDensity.lean new file mode 100644 index 0000000000..518718b8c1 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/FourierFactorDensity.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.FourierFactorIdentity + +/-! +# Exact density-field Fourier energy + +Extended multiplier in the same factorization as the energy. + +Fourier of the scaled density field has exactly N times the squared norm. +-/ + +public section + +open MeasureTheory +open scoped FourierTransform ENNReal + +namespace LiebThirring + +/-- Extended multiplier in the same factorization as the energy. -/ +theorem ofReal_fourierKineticMultiplier (ξ : Position) : + ENNReal.ofReal ((2 * Real.pi) ^ 2 * ‖ξ‖ ^ 2) = + ENNReal.ofReal ((2 * Real.pi) ^ 2) * ‖ξ‖ₑ ^ 2 := by + rw [ENNReal.ofReal_mul (sq_nonneg _), ENNReal.ofReal_pow (norm_nonneg _), ofReal_norm] + +/-- Fourier of the scaled density field has exactly N times the squared norm. -/ +theorem densityField_fourier_enorm_sq_ae {N q : ℕ} (i : Fin N) (ψ : State N q) : + ∀ᵐ ξ : Position, + ‖(Lp.fourierTransformₗᵢ Position (OneParticleFiber i q) (densityField i ψ)) ξ‖ₑ ^ 2 = + (N : ℝ≥0∞) * + ‖(Lp.fourierTransformₗᵢ Position (OneParticleFiber i q) (oneParticleCurrying i ψ)) ξ‖ₑ ^ + 2 := by + have hft : Lp.fourierTransformₗᵢ Position (OneParticleFiber i q) (densityField i ψ) = + (Real.sqrt N : ℂ) • Lp.fourierTransformₗᵢ Position (OneParticleFiber i q) + (oneParticleCurrying i ψ) := + map_smul _ _ _ + have hc : ‖(Real.sqrt N : ℂ)‖ₑ ^ 2 = (N : ℝ≥0∞) := by + rw [← ofReal_norm, ← ENNReal.ofReal_pow (norm_nonneg _), Complex.norm_real, + Real.norm_eq_abs, abs_of_nonneg (Real.sqrt_nonneg _), Real.sq_sqrt (Nat.cast_nonneg N), + ENNReal.ofReal_natCast] + rw [hft] + filter_upwards [Lp.coeFn_smul (Real.sqrt N : ℂ) + (Lp.fourierTransformₗᵢ Position (OneParticleFiber i q) (oneParticleCurrying i ψ))] with ξ hξ + rw [hξ, Pi.smul_apply, enorm_smul, mul_pow, hc] + +/-- The literal density-field Fourier energy is the full kinetic energy. -/ +theorem kineticEnergy_eq_densityField_fourier {N q : ℕ} (i : Fin N) + (ψ : State N q) (hψ : antisymmetric ψ) : + kineticEnergy ψ = ∫⁻ ξ : Position, + ENNReal.ofReal ((2 * Real.pi) ^ 2 * ‖ξ‖ ^ 2) * + ‖(Lp.fourierTransformₗᵢ Position (OneParticleFiber i q) (densityField i ψ)) ξ‖ₑ ^ 2 := by + rw [kineticEnergy_eq_mul_particleFourierEnergy ψ hψ i, + particleFourierEnergy_eq_partialFourier] + rw [← lintegral_const_mul' _ _ (by simp)] + apply lintegral_congr_ae + filter_upwards [densityField_fourier_enorm_sq_ae i ψ] with ξ hξ + rw [hξ, ofReal_fourierKineticMultiplier] + change (N : ℝ≥0∞) * (ENNReal.ofReal ((2 * Real.pi) ^ 2) * ‖ξ‖ₑ ^ 2 * + ‖(Lp.fourierTransformₗᵢ Position (OneParticleFiber i q) (oneParticleCurrying i ψ)) ξ‖ₑ ^ 2) = _ + ring + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/FourierFactorIdentity.lean b/LeanPool/LiebThirring/Kinetic/FourierFactorIdentity.lean new file mode 100644 index 0000000000..abd5accf37 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/FourierFactorIdentity.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.FourierFactorTensor +public import LeanPool.LiebThirring.Kinetic.FourierFactorCurrying +public import LeanPool.LiebThirring.Fourier.TensorDensity +public import LeanPool.LiebThirring.Kinetic.CurryingExchange + +/-! +# Full and partial Fourier factorization + +Outer Fourier transform acts on the spatial factor of a curried tensor. + +Rest-coordinate Fourier transforms act on the remaining factor of a tensor. +-/ + +public section + +open MeasureTheory +open scoped FourierTransform SchwartzMap ENNReal NNReal + +namespace LiebThirring + +/-- Outer Fourier transform acts on the spatial factor of a curried tensor. -/ +theorem fourier_tensorInsertion {N q : ℕ} (i : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) (v : RestState i q) : + 𝓕 (tensorInsertion (H := RestState i q) f v) = + tensorInsertion (H := RestState i q) (𝓕 f) v := by + change 𝓕 ((tensorInsertionBilinear v).compLp f) = + (tensorInsertionBilinear v).compLp (𝓕 f) + exact Fourier.fourier_compLp _ f + +/-- Rest-coordinate Fourier transforms act on the remaining factor of a tensor. -/ +theorem restFourier_tensorInsertion {N q : ℕ} (i : Fin N) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) (v : RestState i q) : + (restFourierLinearIsometryEquiv (q := q) i).toContinuousLinearEquiv.toContinuousLinearMap.compLp + (tensorInsertion (H := RestState i q) f v) = + tensorInsertion (H := RestState i q) f (𝓕 v) := by + exact piLpCongrRight_compLp_tensorInsertion + (Lp.fourierTransformₗᵢ (OtherConfiguration i) + (EuclideanSpace ℂ (OtherSpinLabels i q))) f v + +/-- The full/partial factorization on the smooth tensor core. -/ +theorem oneParticleCurrying_fourier_insertion_toLp {N q : ℕ} (i : Fin N) + (f : 𝓢(Position, EuclideanSpace ℂ (Fin q))) + (v : 𝓢(OtherConfiguration i, EuclideanSpace ℂ (OtherSpinLabels i q))) : + oneParticleCurrying i (𝓕 (oneParticleInsertion i (f.toLp 2 volume) (v.toLp 2 volume))) = + (restFourierLinearIsometryEquiv (q := q) + i).toContinuousLinearEquiv.toContinuousLinearMap.compLp + (𝓕 (oneParticleCurrying i (oneParticleInsertion i (f.toLp 2 volume) (v.toLp 2 volume)))) := + by + let V := (restFourierLinearIsometryEquiv (q := q) i).toContinuousLinearEquiv.toContinuousLinearMap + have hleft := congrArg (oneParticleCurrying i) (fourier_oneParticleInsertion_toLp i f v) + have hcore := oneParticleCurrying_insertion i ((𝓕 f : 𝓢(Position, EuclideanSpace ℂ (Fin q))).toLp + 2 volume) + ((𝓕 v : 𝓢(OtherConfiguration i, EuclideanSpace ℂ (OtherSpinLabels i q))).toLp 2 volume) + have hright := congrArg (fun z => V.compLp (𝓕 z)) + (oneParticleCurrying_insertion i (f.toLp 2 volume) (v.toLp 2 volume)) + have hout := fourier_tensorInsertion i (f.toLp 2 volume) (v.toLp 2 volume) + have hrest := restFourier_tensorInsertion i (𝓕 (f.toLp 2 volume)) (v.toLp 2 volume) + have heq := congrArg₂ (fun a b => tensorInsertion (H := RestState i q) a b) + (SchwartzMap.toLp_fourier_eq f) (SchwartzMap.toLp_fourier_eq v) + exact (hleft.trans hcore).trans + (heq.symm.trans (hrest.symm.trans ((congrArg V.compLp hout).symm.trans hright.symm))) + +/-- Exact unweighted Fourier factorization factorization as an equality of L² classes. -/ +theorem oneParticleCurrying_fourier {N q : ℕ} (i : Fin N) (ψ : State N q) : + oneParticleCurrying i (𝓕 ψ) = + (restFourierLinearIsometryEquiv (q := q) + i).toContinuousLinearEquiv.toContinuousLinearMap.compLp + (𝓕 (oneParticleCurrying i ψ)) := by + let C := (oneParticleCurryingLinearIsometryEquiv (q := q) + i).toContinuousLinearEquiv.toContinuousLinearMap + let V := (restFourierLinearIsometryEquiv (q := q) i).toContinuousLinearEquiv.toContinuousLinearMap + let A : State N q →L[ℂ] Lp (OneParticleFiber i q) 2 volume := + C.comp (Lp.fourierTransformₗᵢ (Configuration N) (SpinAmplitudes N + q)).toContinuousLinearEquiv.toContinuousLinearMap + let B : State N q →L[ℂ] Lp (OneParticleFiber i q) 2 volume := + (V.compLpL 2 volume).comp + ((Lp.fourierTransformₗᵢ Position (OneParticleFiber i + q)).toContinuousLinearEquiv.toContinuousLinearMap.comp C) + have heq : A = B := by + apply continuousLinearMap_ext_oneParticleInsertion_schwartz i + intro f v + exact oneParticleCurrying_fourier_insertion_toLp i f v + exact congrArg (fun T : State N q →L[ℂ] Lp (OneParticleFiber i q) 2 volume => T ψ) heq + +/-- Currying the full Fourier transform and partial Fourier have identical fiber norms a.e. -/ +theorem norm_oneParticleCurrying_fourier_ae {N q : ℕ} (i : Fin N) (ψ : State N q) : + ∀ᵐ ξ : Position, + ‖oneParticleCurrying i (𝓕 ψ) ξ‖₊ = ‖(𝓕 (oneParticleCurrying i ψ) : Lp (OneParticleFiber i q) + 2 volume) ξ‖₊ := by + rw [oneParticleCurrying_fourier] + filter_upwards [(restFourierLinearIsometryEquiv (q := q) + i).toContinuousLinearEquiv.toContinuousLinearMap.coeFn_compLp + (𝓕 (oneParticleCurrying i ψ))] with ξ hξ + rw [hξ] + exact (restFourierLinearIsometryEquiv i).nnnorm_map _ + +/-- The particle energy equals the partial Fourier kinetic integral, including infinite energy. -/ +theorem particleFourierEnergy_eq_partialFourier {N q : ℕ} (i : Fin N) (ψ : State N q) : + particleFourierEnergy ψ i = ∫⁻ ξ : Position, + ENNReal.ofReal ((2 * Real.pi) ^ 2) * (‖ξ‖₊ : ℝ≥0∞) ^ 2 * + (‖(Lp.fourierTransformₗᵢ Position (OneParticleFiber i q) (oneParticleCurrying i ψ)) ξ‖₊ : + ℝ≥0∞) ^ 2 := by + rw [particleFourierEnergy_eq_currying_fullFourier] + apply lintegral_congr_ae + filter_upwards [norm_oneParticleCurrying_fourier_ae i ψ] with ξ hξ + rw [hξ] + rfl + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/FourierFactorTensor.lean b/LeanPool/LiebThirring/Kinetic/FourierFactorTensor.lean new file mode 100644 index 0000000000..aee514a847 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/FourierFactorTensor.lean @@ -0,0 +1,205 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.ContractionState +public import LeanPool.LiebThirring.Fourier.Functoriality +public import LeanPool.LiebThirring.Fourier.IntegralL2 + +/-! +# Fourier factorization on particle tensors + +The insertion phase splits into the selected and remaining spatial phases. + +The literal full-state representative of a separated particle tensor. +-/ + +public section + +open MeasureTheory WithLp +open scoped FourierTransform SchwartzMap + +namespace LiebThirring + +/-- The insertion phase splits into the selected and remaining spatial phases. -/ +theorem inner_insertParticle {N : ℕ} (i : Fin N) (x ξ : Position) + (y η : OtherConfiguration i) : + inner ℝ (insertParticle i x y) (insertParticle i ξ η) = + inner ℝ x ξ + inner ℝ y η := by + classical + simp only [PiLp.inner_apply, RCLike.inner_apply, conj_trivial] + rw [← (insertionIndexEquiv i).symm.sum_comp] + rw [Fintype.sum_sum_type] + congr 1 + · apply Finset.sum_congr rfl + intro a _ + simp [insertionIndexEquiv, insertParticle] + · apply Finset.sum_congr rfl + rintro ⟨j, a⟩ _ + simp [insertionIndexEquiv, insertParticle, j.property] + +/-- The literal full-state representative of a separated particle tensor. -/ +@[expose] noncomputable def particleTensorFunction {N q : ℕ} (i : Fin N) + (f : Position → EuclideanSpace ℂ (Fin q)) + (v : OtherConfiguration i → EuclideanSpace ℂ (OtherSpinLabels i q)) + (X : Configuration N) : SpinAmplitudes N q := + (spinCurryingLinearIsometryEquiv i).symm + (tensorInsertionBilinear + (v ((insertionMeasurableEquiv i).symm X).2) + (f ((insertionMeasurableEquiv i).symm X).1)) + +/-- Exact regrouped tensor evaluation on inserted spatial coordinates. -/ +theorem particleTensorFunction_insert {N q : ℕ} (i : Fin N) + (f : Position → EuclideanSpace ℂ (Fin q)) + (v : OtherConfiguration i → EuclideanSpace ℂ (OtherSpinLabels i q)) + (x : Position) (y : OtherConfiguration i) (s : Fin q) (t : OtherSpinLabels i q) : + particleTensorFunction i f v (insertParticle i x y) (insertSpin i s t) = f x s * v y t := by + have he := congrArg (fun a : PiLp 2 (fun _ : Fin q => EuclideanSpace ℂ (OtherSpinLabels i q)) => + a s t) + ((spinCurryingLinearIsometryEquiv (q := q) i).apply_symm_apply + (tensorInsertionBilinear (v y) (f x))) + rw [spinCurryingLinearIsometryEquiv_apply] at he + unfold particleTensorFunction + rw [← insertionMeasurableEquiv_apply i (x, y), MeasurableEquiv.symm_apply_apply] + exact he + +/-- A product of integrable spatial factors gives an integrable full tensor. -/ +theorem integrable_particleTensorFunction {N q : ℕ} (i : Fin N) + {f : Position → EuclideanSpace ℂ (Fin q)} + {v : OtherConfiguration i → EuclideanSpace ℂ (OtherSpinLabels i q)} + (hf : Integrable f) (hv : Integrable v) : Integrable (particleTensorFunction i f v) := by + have hi : Integrable (fun z : Position × OtherConfiguration i => + tensorInsertionBilinear (v z.2) (f z.1)) := by + exact hf.op_fst_snd (by fun_prop) + ⟨‖(tensorInsertionBilinear (ι := Fin q) (H := EuclideanSpace ℂ (OtherSpinLabels i q))).flip‖, + (tensorInsertionBilinear (ι := Fin q) (H := EuclideanSpace ℂ (OtherSpinLabels i + q))).flip.le_opNorm₂⟩ hv + have hm := (spinCurryingLinearIsometryEquiv (q := q) + i).symm.toContinuousLinearEquiv.toContinuousLinearMap.integrable_comp hi + exact ((MeasurePreserving.symm (insertionMeasurableEquiv i) + (measurePreserving_insertion i)).integrable_comp + hm.aestronglyMeasurable).mpr hm + +/-- The full Fourier integral of a separated particle tensor is the tensor of +its two Fourier integrals. -/ +theorem fourier_particleTensorFunction {N q : ℕ} (i : Fin N) + {f : Position → EuclideanSpace ℂ (Fin q)} + {v : OtherConfiguration i → EuclideanSpace ℂ (OtherSpinLabels i q)} + (hf : Integrable f) (hv : Integrable v) (ξ : Position) (η : OtherConfiguration i) : + (𝓕 (particleTensorFunction i f v)) (insertParticle i ξ η) = + particleTensorFunction i (𝓕 f) (𝓕 v) (insertParticle i ξ η) := by + apply (spinCurryingLinearIsometryEquiv i).injective + rw [Real.fourier_eq] + let A := (spinCurryingLinearIsometryEquiv (q := q) i).toLinearIsometry + change A (∫ X : Configuration N, Real.fourierChar (-inner ℝ X (insertParticle i ξ η)) • + particleTensorFunction i f v X) = _ + rw [← A.integral_comp_comm] + rw [← (measurePreserving_insertion i).integral_comp + (insertionMeasurableEquiv i).measurableEmbedding] + have heq : (fun z : Position × OtherConfiguration i => + A (Real.fourierChar (-inner ℝ (insertionMeasurableEquiv i z) (insertParticle i ξ η)) • + particleTensorFunction i f v (insertionMeasurableEquiv i z))) = + (fun z : Position × OtherConfiguration i => tensorInsertionBilinear + (Real.fourierChar (-inner ℝ z.2 η) • v z.2) + (Real.fourierChar (-inner ℝ z.1 ξ) • f z.1)) := by + funext z + change (spinCurryingLinearIsometryEquiv i) + (Real.fourierChar (-inner ℝ (insertionMeasurableEquiv i z) (insertParticle i ξ η)) • + particleTensorFunction i f v (insertionMeasurableEquiv i z)) = _ + simp only [Circle.smul_def] + rw [map_smul, insertionMeasurableEquiv_apply, inner_insertParticle] + unfold particleTensorFunction + rw [← insertionMeasurableEquiv_apply i z, MeasurableEquiv.symm_apply_apply, + LinearIsometryEquiv.apply_symm_apply] + simp only [neg_add, Real.fourierChar.map_add_eq_mul, + Circle.coe_mul, map_smul, smul_apply, smul_smul] + rw [heq] + change (∫ z : Position × OtherConfiguration i, + (tensorInsertionBilinear (ι := Fin q) (H := EuclideanSpace ℂ (OtherSpinLabels i q))).flip + (Real.fourierChar (-inner ℝ z.1 ξ) • f z.1) + (Real.fourierChar (-inner ℝ z.2 η) • v z.2) ∂volume.prod volume) = _ + rw [integral_prod_bilin (tensorInsertionBilinear (ι := Fin q) + (H := EuclideanSpace ℂ (OtherSpinLabels i q))).flip + ((Real.fourierIntegral_convergent_iff ξ).mpr hf) + ((Real.fourierIntegral_convergent_iff η).mpr hv)] + unfold particleTensorFunction + rw [← insertionMeasurableEquiv_apply i (ξ, η), MeasurableEquiv.symm_apply_apply, + LinearIsometryEquiv.apply_symm_apply] + rfl + +/-- Smooth factors give a strongly measurable literal tensor representative. -/ +theorem stronglyMeasurable_particleTensorFunction {N q : ℕ} (i : Fin N) + (f : 𝓢(Position, EuclideanSpace ℂ (Fin q))) + (v : 𝓢(OtherConfiguration i, EuclideanSpace ℂ (OtherSpinLabels i q))) : + StronglyMeasurable (particleTensorFunction i f v) := by + have hf := f.continuous.stronglyMeasurable.comp_measurable + (measurable_fst.comp (insertionMeasurableEquiv i).symm.measurable) + have hv := v.continuous.stronglyMeasurable.comp_measurable + (measurable_snd.comp (insertionMeasurableEquiv i).symm.measurable) + exact (spinCurryingLinearIsometryEquiv (q := q) i).symm.continuous.comp_stronglyMeasurable + ((tensorInsertionBilinear (ι := Fin q) (H := EuclideanSpace ℂ (OtherSpinLabels i + q))).continuous₂.comp_stronglyMeasurable (hv.prodMk hf)) + +/-- The concrete State insertion is the literal smooth tensor almost everywhere. -/ +theorem oneParticleInsertion_toLp_ae {N q : ℕ} (i : Fin N) + (f : 𝓢(Position, EuclideanSpace ℂ (Fin q))) + (v : 𝓢(OtherConfiguration i, EuclideanSpace ℂ (OtherSpinLabels i q))) : + (oneParticleInsertion i (f.toLp 2 volume) (v.toLp 2 volume) : + Configuration N → SpinAmplitudes N q) =ᵐ[volume] particleTensorFunction i f v := by + let ψ := oneParticleInsertion i (f.toLp 2 volume) (v.toLp 2 volume) + have hnested : ∀ᵐ x : Position, ∀ᵐ y : OtherConfiguration i, + ψ (insertParticle i x y) = particleTensorFunction i f v (insertParticle i x y) := by + filter_upwards [oneParticleInsertion_ae i (f.toLp 2 volume) (v.toLp 2 volume), + f.coeFn_toLp 2 volume] with x hx hf + filter_upwards [ae_all_iff.mpr hx, v.coeFn_toLp 2 volume] with y hy hv + apply (spinCurryingLinearIsometryEquiv i).injective + ext s t + rw [spinCurryingLinearIsometryEquiv_apply, spinCurryingLinearIsometryEquiv_apply, + particleTensorFunction_insert, hy s t, hf, hv] + have hψ := (Lp.stronglyMeasurable ψ).measurable.comp + (measurePreserving_insertParticle i).measurable + have hF := (stronglyMeasurable_particleTensorFunction i f v).measurable.comp + (measurePreserving_insertParticle i).measurable + have hprod := (Measure.ae_prod_iff_ae_ae (measurableSet_eq_fun hψ hF)).mpr hnested + have h := (MeasurePreserving.symm (insertionMeasurableEquiv i) + (measurePreserving_insertion i)).quasiMeasurePreserving.ae hprod + filter_upwards [h] with X hX + simpa only [Function.comp_apply, ← insertionMeasurableEquiv_apply, + MeasurableEquiv.apply_symm_apply] using hX + +/-- Full L² Fourier carries a smooth inserted tensor to the Fourier-factor tensor. -/ +theorem fourier_oneParticleInsertion_toLp {N q : ℕ} (i : Fin N) + (f : 𝓢(Position, EuclideanSpace ℂ (Fin q))) + (v : 𝓢(OtherConfiguration i, EuclideanSpace ℂ (OtherSpinLabels i q))) : + 𝓕 (oneParticleInsertion i (f.toLp 2 volume) (v.toLp 2 volume)) = + oneParticleInsertion i ((𝓕 f).toLp 2 volume) ((𝓕 v).toLp 2 volume) := by + let ψ := oneParticleInsertion i (f.toLp 2 volume) (v.toLp 2 volume) + have hψ := oneParticleInsertion_toLp_ae i f v + have hmem : MemLp (particleTensorFunction i f v) 2 volume := (Lp.memLp ψ).ae_eq hψ + have hclass : hmem.toLp (particleTensorFunction i f v) = ψ := by + apply Lp.ext + exact hmem.coeFn_toLp.trans hψ.symm + have hfourier := Fourier.fourier_toLp_ae_eq + (integrable_particleTensorFunction i (f.integrable (μ := volume)) (v.integrable (μ := volume))) + hmem + rw [hclass] at hfourier + have hm : (𝓕 (particleTensorFunction i f v) : Configuration N → SpinAmplitudes N q) =ᵐ[volume] + particleTensorFunction i (𝓕 f : 𝓢(Position, EuclideanSpace ℂ (Fin q))) + (𝓕 v : 𝓢(OtherConfiguration i, EuclideanSpace ℂ (OtherSpinLabels i q))) := by + apply Filter.Eventually.of_forall + intro X + obtain ⟨z, rfl⟩ := (insertionMeasurableEquiv i).surjective X + rw [insertionMeasurableEquiv_apply] + exact fourier_particleTensorFunction i (f.integrable (μ := volume)) + (v.integrable (μ := volume)) z.1 z.2 + apply Lp.ext + exact hfourier.trans (hm.trans (oneParticleInsertion_toLp_ae i (𝓕 f) (𝓕 v)).symm) + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/Insertion.lean b/LeanPool/LiebThirring/Kinetic/Insertion.lean new file mode 100644 index 0000000000..fbd59bb89b --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/Insertion.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. +public import LeanPool.LiebThirring.Defs.Configuration +/-! +# Particle insertion and product volume + +Partition spatial coordinates into particle `i` and the other particles. + +Coordinate insertion as an equivalence of measurable spaces. +-/ +public section +open MeasureTheory WithLp +namespace LiebThirring + +/-- Partition spatial coordinates into particle `i` and the other particles. -/ +@[expose] def insertionIndexEquiv {N : ℕ} (i : Fin N) : + (Fin N × Fin 3) ≃ (Fin 3 ⊕ ({j : Fin N // j ≠ i} × Fin 3)) where + toFun ja := if h : ja.1 = i then Sum.inl ja.2 else Sum.inr (⟨ja.1, h⟩, ja.2) + invFun := Sum.elim (fun a => (i, a)) (fun ja => (ja.1.val, ja.2)) + left_inv := by + rintro ⟨j, a⟩ + dsimp + split <;> simp_all + right_inv ja := by cases ja with + | inl a => simp + | inr ja => simp [ja.1.property] + +/-- Coordinate insertion as an equivalence of measurable spaces. -/ +@[expose] noncomputable def insertionMeasurableEquiv {N : ℕ} (i : Fin N) : + (Position × OtherConfiguration i) ≃ᵐ Configuration N := + ((MeasurableEquiv.toLp 2 (Fin 3 → ℝ)).symm.prodCongr + (MeasurableEquiv.toLp 2 (({j : Fin N // j ≠ i} × Fin 3) → ℝ)).symm).trans + ((MeasurableEquiv.sumPiEquivProdPi (fun _ : Fin 3 ⊕ + ({j : Fin N // j ≠ i} × Fin 3) => ℝ)).symm.trans + ((MeasurableEquiv.piCongrLeft (fun _ : Fin N × Fin 3 => ℝ) + (insertionIndexEquiv i).symm).trans (MeasurableEquiv.toLp 2 _))) + +theorem insertionMeasurableEquiv_apply {N : ℕ} (i : Fin N) + (z : Position × OtherConfiguration i) : + insertionMeasurableEquiv i z = insertParticle i z.1 z.2 := by + ext ja + simp [insertionMeasurableEquiv, MeasurableEquiv.coe_piCongrLeft, + Equiv.piCongrLeft_apply, MeasurableEquiv.coe_sumPiEquivProdPi_symm, + Equiv.sumPiEquivProdPi, insertionIndexEquiv, insertParticle] + split <;> rfl + +theorem measurePreserving_insertion {N : ℕ} (i : Fin N) : + MeasurePreserving (insertionMeasurableEquiv i) volume volume := by + exact ((PiLp.volume_preserving_ofLp (Fin 3)).prod + (PiLp.volume_preserving_ofLp ({j : Fin N // j ≠ i} × Fin 3))).trans + ((volume_measurePreserving_sumPiEquivProdPi_symm _).trans + ((volume_measurePreserving_piCongrLeft _ (insertionIndexEquiv i).symm).trans + (PiLp.volume_preserving_toLp (Fin N × Fin 3)))) + +theorem measurePreserving_insertParticle {N : ℕ} (i : Fin N) : + MeasurePreserving (fun z : Position × OtherConfiguration i => + insertParticle i z.1 z.2) volume volume := by + simpa only [← insertionMeasurableEquiv_apply] using measurePreserving_insertion i + +@[simp] theorem particlePosition_insertParticle {N : ℕ} (i : Fin N) + (x : Position) (y : OtherConfiguration i) : + particlePosition (insertParticle i x y) i = x := by + ext a + simp [particlePosition, insertParticle] + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/KineticLT.lean b/LeanPool/LiebThirring/Kinetic/KineticLT.lean new file mode 100644 index 0000000000..37f14bcd85 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/KineticLT.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.RuminIntegration +public import LeanPool.LiebThirring.Kinetic.LowMomentumBound +public import LeanPool.LiebThirring.Kinetic.KineticLTVacuum + +/-! +# Kinetic Lieb--Thirring inequality on the state carrier + +The non-vacuum Rumin estimate and the vacuum density identity give the kinetic Lieb–Thirring +inequality. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring.Kinetic + +/-- Conditional assembly with exactly the pointwise low-momentum estimate +as its sole extra premise. The final theorem supplies it from the unconditional low-momentum +theorem. -/ +theorem kinetic_lieb_thirring_of_lowMomentumBound (q : ℕ) (hq : 1 ≤ q) + (N : ℕ) (ψ : State N q) (hanti : antisymmetric ψ) + (hLow : ∀ i : Fin N, ∀ E : ℝ, 0 ≤ E → ∀ x : Position, + ‖lowFourierField (densityField i ψ) E x‖ ^ 2 ≤ + (q : ℝ) * (1 / (6 * Real.pi ^ 2)) * E ^ ((3 : ℝ) / 2)) : + (ruminConstant : ℝ≥0∞) * (q : ℝ≥0∞) ^ (-(2 : ℝ) / 3) * + (∫⁻ x : Position, density ψ x ^ ((5 : ℝ) / 3)) ≤ kineticEnergy ψ := by + cases N with + | zero => + rw [lintegral_density_rpow_vacuum ψ _ (by norm_num), mul_zero] + exact zero_le + | succ N => + let i : Fin (N + 1) := ⟨0, Nat.succ_pos N⟩ + exact rumin_bound_of_lowMomentumBound q hq i ψ hanti (hLow i) + +/-- Proof of the kinetic Lieb--Thirring theorem. -/ +theorem kinetic_lieb_thirring (q : ℕ) (hq : 1 ≤ q) (N : ℕ) (ψ : State N q) + (hanti : antisymmetric ψ) (hnorm : ‖ψ‖ = 1) : + (ruminConstant : ℝ≥0∞) * (q : ℝ≥0∞) ^ (-(2 : ℝ) / 3) * + (∫⁻ x : Position, density ψ x ^ ((5 : ℝ) / 3)) ≤ kineticEnergy ψ := + kinetic_lieb_thirring_of_lowMomentumBound q hq N ψ hanti + (fun i E hE x => lowFourierField_density_bound i ψ hanti hnorm E hE x) + +end LiebThirring.Kinetic +end diff --git a/LeanPool/LiebThirring/Kinetic/KineticLTVacuum.lean b/LeanPool/LiebThirring/Kinetic/KineticLTVacuum.lean new file mode 100644 index 0000000000..6090b64da9 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/KineticLTVacuum.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.FourierFactor + +/-! +# Vacuum density-power integral + +The density is zero everywhere in the vacuum. + +The vacuum density-power integral vanishes for every positive real exponent. +-/ + +public section + +open MeasureTheory +open scoped ENNReal + +namespace LiebThirring + +/-- The density is zero everywhere in the vacuum. -/ +theorem density_vacuum {q : ℕ} (ψ : State 0 q) (x : Position) : density ψ x = 0 := + Finset.sum_empty + +/-- The vacuum density-power integral vanishes for every positive real exponent. -/ +theorem lintegral_density_rpow_vacuum {q : ℕ} (ψ : State 0 q) + (p : ℝ) (hp : 0 < p) : + (∫⁻ x : Position, density ψ x ^ p) = 0 := by + simp only [density_vacuum, ENNReal.zero_rpow_of_pos hp, lintegral_zero] + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/LayerCakeBasic.lean b/LeanPool/LiebThirring/Kinetic/LayerCakeBasic.lean new file mode 100644 index 0000000000..f74f84fea0 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/LayerCakeBasic.lean @@ -0,0 +1,49 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.CutoffProjection + +/-! +# Fixed high-field representatives + +The high field uses the same chosen L² representative at every cutoff. + +Joint strong measurability holds for this fixed representative. +-/ + +public section + +open MeasureTheory +open scoped FourierTransform + +namespace LiebThirring + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- The high field uses the same chosen L² representative at every cutoff. -/ +@[expose] noncomputable def highFourierField + (h : Lp H 2 (volume : Measure Position)) (E : ℝ) (x : Position) : H := + h x - lowFourierField h E x + +/-- Joint strong measurability holds for this fixed representative. -/ +theorem stronglyMeasurable_highFourierField_canonical + (h : Lp H 2 (volume : Measure Position)) : + StronglyMeasurable (fun p : ℝ × Position => highFourierField h p.1 p.2) := + stronglyMeasurable_highFourierField h h (Lp.stronglyMeasurable h) + +/-- Each nonnegative cutoff's high field represents its exact inverse L² class. -/ +theorem highFourierField_ae (h : Lp H 2 (volume : Measure Position)) + (E : ℝ) (hE : 0 ≤ E) : + ((𝓕⁻ (highFrequencyClass h E) : Lp H 2 volume) : Position → H) =ᵐ[volume] + highFourierField h E := + highFourierProjection_ae h E hE h (Filter.EventuallyEq.rfl) + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/LayerCakeBounds.lean b/LeanPool/LiebThirring/Kinetic/LayerCakeBounds.lean new file mode 100644 index 0000000000..b20aa53fa3 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/LayerCakeBounds.lean @@ -0,0 +1,87 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.CurryingDensity +public import LeanPool.LiebThirring.Kinetic.LayerCakeBasic + +/-! +# Density lower bounds for high Fourier fields + +The positive part of a norm difference is bounded by the difference norm. + +A quadratic low-field bound gives the corresponding square-root bound. +-/ + +public section + +open MeasureTheory +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- The positive part of a norm difference is bounded by the difference norm. -/ +theorem max_norm_sub_norm_le_norm_sub {H : Type*} [NormedAddCommGroup H] (a b : H) : + max (‖a‖ - ‖b‖) 0 ≤ ‖a - b‖ := + max_le (norm_sub_norm_le a b) (norm_nonneg _) + +/-- A quadratic low-field bound gives the corresponding square-root bound. -/ +theorem norm_le_sqrt_mul_rpow_of_norm_sq_le {H : Type*} [NormedAddCommGroup H] + (u : H) (C E : ℝ) (hC : 0 ≤ C) (hE : 0 ≤ E) + (hu : ‖u‖ ^ 2 ≤ C * E ^ ((3 : ℝ) / 2)) : + ‖u‖ ≤ Real.sqrt C * E ^ ((3 : ℝ) / 4) := by + have hs : (Real.sqrt C * E ^ ((3 : ℝ) / 4)) ^ 2 = C * E ^ ((3 : ℝ) / 2) := by + rw [mul_pow, Real.sq_sqrt hC, + ← Real.rpow_mul_natCast hE ((3 : ℝ) / 4) 2] + norm_num + exact (sq_le_sq₀ (norm_nonneg _) + (mul_nonneg (Real.sqrt_nonneg _) (Real.rpow_nonneg hE _))).mp (hu.trans_eq hs.symm) + +/-- Density finiteness and its real norm identification hold on one conull set. -/ +theorem densityField_density_data_ae {N q : ℕ} (i : Fin N) (ψ : State N q) + (hψ : antisymmetric ψ) : + ∀ᵐ x : Position, + density ψ x ≠ ⊤ ∧ + (density ψ x).toReal = ‖densityField i ψ x‖ ^ 2 ∧ + Real.sqrt ((density ψ x).toReal) = ‖densityField i ψ x‖ := by + filter_upwards [density_eq_densityField_norm_sq_ae i ψ hψ] with x hx + have hreal : (density ψ x).toReal = ‖densityField i ψ x‖ ^ 2 := by + rw [hx, ENNReal.toReal_pow, ENNReal.coe_toReal] + rfl + refine ⟨?_, hreal, ?_⟩ + · rw [hx] + exact ENNReal.pow_ne_top ENNReal.coe_ne_top + · rw [hreal, Real.sqrt_sq (norm_nonneg _)] + +/-- the layer cake reverse triangle bound on a single density-conull set for every energy, +assembled conditionally from the exact pointwise the low-momentum bound low-field estimate. -/ +theorem densityField_high_bound_ae_of_lowMomentumBound {N q : ℕ} (i : Fin N) (ψ : State N q) + (hψ : antisymmetric ψ) + (hLow : ∀ E : ℝ, 0 ≤ E → ∀ x : Position, + ‖lowFourierField (densityField i ψ) E x‖ ^ 2 ≤ + (q : ℝ) * (1 / (6 * Real.pi ^ 2)) * E ^ ((3 : ℝ) / 2)) : + ∀ᵐ x : Position, ∀ E : ℝ, 0 ≤ E → + max (Real.sqrt ((density ψ x).toReal) - + Real.sqrt ((q : ℝ) * (1 / (6 * Real.pi ^ 2))) * E ^ ((3 : ℝ) / 4)) 0 ≤ + ‖highFourierField (densityField i ψ) E x‖ := by + filter_upwards [densityField_density_data_ae i ψ hψ] with x hx + intro E hE + have hC : 0 ≤ (q : ℝ) * (1 / (6 * Real.pi ^ 2)) := by positivity + have hnorm := norm_le_sqrt_mul_rpow_of_norm_sq_le + (lowFourierField (densityField i ψ) E x) _ E hC hE (hLow E hE x) + rw [hx.2.2] + calc + _ ≤ max (‖densityField i ψ x‖ - ‖lowFourierField (densityField i ψ) E x‖) 0 := + max_le_max (sub_le_sub_left hnorm _) le_rfl + _ ≤ ‖densityField i ψ x - lowFourierField (densityField i ψ) E x‖ := + max_norm_sub_norm_le_norm_sub _ _ + _ = _ := rfl + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/LayerCakeIdentity.lean b/LeanPool/LiebThirring/Kinetic/LayerCakeIdentity.lean new file mode 100644 index 0000000000..b20c25cfa3 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/LayerCakeIdentity.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.LayerCakeMass +public import LeanPool.LiebThirring.Kinetic.FourierFactorDensity + +/-! +# Exact kinetic layer cake + +The Fourier density-field energy equals the kinetic energy and its extended high-field layer +cake. The two half-line conventions differ only at the null zero cutoff. +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal + +namespace LiebThirring + +/-- the layer cake extended layer-cake identity on the nonnegative real half-line. -/ +theorem kineticEnergy_eq_densityField_layerCake {N q : ℕ} (i : Fin N) + (ψ : State N q) (hψ : antisymmetric ψ) : + kineticEnergy ψ = ∫⁻ E in Ici (0 : ℝ), ∫⁻ x : Position, + ‖highFourierField (densityField i ψ) E x‖ₑ ^ 2 := by + exact (kineticEnergy_eq_densityField_fourier i ψ hψ).trans + (lintegral_highFourierField_layerCake (densityField i ψ)).symm + +/-- The positive half-line convention consumed by the scalar Rumin integral. -/ +theorem kineticEnergy_eq_densityField_layerCake_Ioi {N q : ℕ} (i : Fin N) + (ψ : State N q) (hψ : antisymmetric ψ) : + kineticEnergy ψ = ∫⁻ E in Ioi (0 : ℝ), ∫⁻ x : Position, + ‖highFourierField (densityField i ψ) E x‖ₑ ^ 2 := by + rw [restrict_Ioi_eq_restrict_Ici] + exact kineticEnergy_eq_densityField_layerCake i ψ hψ + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/LayerCakeMass.lean b/LeanPool/LiebThirring/Kinetic/LayerCakeMass.lean new file mode 100644 index 0000000000..ba33ff1339 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/LayerCakeMass.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.LayerCakeBasic +import LeanPool.LiebThirring.Kinetic.CurryingProductBasic + +/-! +# High-field mass and extended Fourier layer cake + +Plancherel gives the literal strict high-frequency mass at each cutoff. + +Integrating the strict threshold over real nonnegative energies gives its length. +-/ + +public section + +open MeasureTheory Set +open scoped FourierTransform ENNReal + +namespace LiebThirring + +variable {H : Type*} [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- Plancherel gives the literal strict high-frequency mass at each cutoff. -/ +theorem lintegral_highFourierField (h : Lp H 2 (volume : Measure Position)) + (E : ℝ) (hE : 0 ≤ E) : + (∫⁻ x : Position, ‖highFourierField h E x‖ₑ ^ 2) = + ∫⁻ ξ : Position, if E < fourierKineticMultiplier ξ then + ‖(Lp.fourierTransformₗᵢ Position H h) ξ‖ₑ ^ 2 else 0 := by + calc + _ = ∫⁻ x : Position, ‖(𝓕⁻ (highFrequencyClass h E) : Lp H 2 volume) x‖ₑ ^ 2 := by + apply lintegral_congr_ae + filter_upwards [highFourierField_ae h E hE] with x hx + rw [hx] + _ = ‖(𝓕⁻ (highFrequencyClass h E) : Lp H 2 volume)‖ₑ ^ 2 := + lintegral_l2_enorm_sq _ + _ = ‖highFrequencyClass h E‖ₑ ^ 2 := by + change ‖(Lp.fourierTransformₗᵢ Position H).symm (highFrequencyClass h E)‖ₑ ^ 2 = _ + rw [LinearIsometryEquiv.enorm_map] + _ = ∫⁻ ξ : Position, ‖highFrequencyClass h E ξ‖ₑ ^ 2 := + (lintegral_l2_enorm_sq _).symm + _ = _ := by + apply lintegral_congr_ae + filter_upwards [((Lp.memLp (Lp.fourierTransformₗᵢ Position H h)).indicator + (measurableSet_lowMomentumRegion E).compl).coeFn_toLp] with ξ hξ + change highFrequencyClass h E ξ = _ at hξ + rw [hξ] + by_cases hc : E < fourierKineticMultiplier ξ + · rw [ite_eq_left hc, Set.indicator_of_mem] + exact not_le.mpr hc + · rw [ite_eq_right hc, Set.indicator_of_notMem, enorm_zero, zero_pow (by decide)] + exact not_not.mpr (not_lt.mp hc) + +/-- Integrating the strict threshold over real nonnegative energies gives its length. -/ +theorem lintegral_cutoff_threshold (threshold : ℝ) (a : ℝ≥0∞) : + (∫⁻ E in Ici (0 : ℝ), if E < threshold then a else 0) = ENNReal.ofReal threshold * a := by + change (∫⁻ E in Ici (0 : ℝ), (Iio threshold).indicator (fun _ => a) E) = _ + rw [lintegral_indicator measurableSet_Iio, lintegral_const, + Measure.restrict_apply MeasurableSet.univ, univ_inter, + Measure.restrict_apply measurableSet_Iio] + have hset : Iio threshold ∩ Ici (0 : ℝ) = Ico 0 threshold := by + ext E + simp only [mem_inter_iff, mem_Iio, mem_Ici, mem_Ico] + exact and_comm + rw [hset, Real.volume_Ico, sub_zero, mul_comm] + +/-- Tonelli integrates the high-field masses to the weighted outer Fourier energy. -/ +theorem lintegral_highFourierField_layerCake + (h : Lp H 2 (volume : Measure Position)) : + (∫⁻ E in Ici (0 : ℝ), ∫⁻ x : Position, ‖highFourierField h E x‖ₑ ^ 2) = + ∫⁻ ξ : Position, ENNReal.ofReal (fourierKineticMultiplier ξ) * + ‖(Lp.fourierTransformₗᵢ Position H h) ξ‖ₑ ^ 2 := by + have heq : (∫⁻ E in Ici (0 : ℝ), ∫⁻ x : Position, ‖highFourierField h E x‖ₑ ^ 2) = + ∫⁻ E in Ici (0 : ℝ), ∫⁻ ξ : Position, + if E < fourierKineticMultiplier ξ then + ‖(Lp.fourierTransformₗᵢ Position H h) ξ‖ₑ ^ 2 else 0 := by + apply lintegral_congr_ae + filter_upwards [ae_restrict_mem measurableSet_Ici] with E hE + exact lintegral_highFourierField h E hE + rw [heq] + have hm : Measurable (fun p : ℝ × Position => + if p.1 < fourierKineticMultiplier p.2 then + ‖(Lp.fourierTransformₗᵢ Position H h) p.2‖ₑ ^ 2 else 0) := by + apply Measurable.ite + · exact measurableSet_lt measurable_fst + (continuous_fourierKineticMultiplier.measurable.comp measurable_snd) + · exact ((Lp.stronglyMeasurable _).enorm.comp measurable_snd).pow_const 2 + · exact measurable_const + rw [lintegral_lintegral_swap hm.aemeasurable] + apply lintegral_congr + intro ξ + exact lintegral_cutoff_threshold _ _ + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/LowMomentumBound.lean b/LeanPool/LiebThirring/Kinetic/LowMomentumBound.lean new file mode 100644 index 0000000000..685f4aa4f5 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/LowMomentumBound.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.LowMomentumFormula +public import LeanPool.LiebThirring.Kinetic.PauliOccupation + +/-! +# The unconditional low-momentum density bound + +Each low-field spin component is bounded by the phase-space volume. + +Summing the spin components gives `q` times the low-region volume. +-/ + +public section + +open MeasureTheory + +namespace LiebThirring + +/-- Each low-field spin component is bounded by the phase-space volume. -/ +theorem lowFourierField_density_component_bound {N q : ℕ} (i : Fin N) + (ψ : State N q) (hψ : antisymmetric ψ) (hnorm : ‖ψ‖ = 1) + (E : ℝ) (hE : 0 ≤ E) (x : Position) (s : Fin q) : + ‖lowFourierField (densityField i ψ) E x s‖ ^ 2 ≤ + (volume (lowMomentumRegion E)).toReal := by + rw [lowFourierField_density_component_norm_sq] + exact (oneParticleContraction_pauli_of_norm_eq_one i ψ hψ hnorm + (lowMomentumTest E x s hE)).trans_eq (lowMomentumTest_norm_sq E hE x s) + +/-- Summing the spin components gives `q` times the low-region volume. -/ +theorem lowFourierField_density_bound_volume {N q : ℕ} (i : Fin N) + (ψ : State N q) (hψ : antisymmetric ψ) (hnorm : ‖ψ‖ = 1) + (E : ℝ) (hE : 0 ≤ E) (x : Position) : + ‖lowFourierField (densityField i ψ) E x‖ ^ 2 ≤ + (q : ℝ) * (volume (lowMomentumRegion E)).toReal := by + rw [PiLp.norm_sq_eq_of_L2] + calc + _ ≤ ∑ s : Fin q, (volume (lowMomentumRegion E)).toReal := + Finset.sum_le_sum (fun s _ => + lowFourierField_density_component_bound i ψ hψ hnorm E hE x s) + _ = _ := by + simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul] + +/-- the low-momentum bound: the scaled density field has the exact three-dimensional low-momentum +bound at every spatial point, with no finite-energy or positive-spin premise. -/ +theorem lowFourierField_density_bound {N q : ℕ} (i : Fin N) + (ψ : State N q) (hψ : antisymmetric ψ) (hnorm : ‖ψ‖ = 1) + (E : ℝ) (hE : 0 ≤ E) (x : Position) : + ‖lowFourierField (densityField i ψ) E x‖ ^ 2 ≤ + (q : ℝ) * (1 / (6 * Real.pi ^ 2)) * E ^ ((3 : ℝ) / 2) := by + have hvol : (volume (lowMomentumRegion E)).toReal = + (1 / (6 * Real.pi ^ 2)) * E ^ ((3 : ℝ) / 2) := by + rw [volume_lowMomentumRegion E hE, ENNReal.toReal_ofReal] + positivity + exact (lowFourierField_density_bound_volume i ψ hψ hnorm E hE x).trans_eq (by + rw [hvol, mul_assoc]) + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/LowMomentumFormula.lean b/LeanPool/LiebThirring/Kinetic/LowMomentumFormula.lean new file mode 100644 index 0000000000..3cb17467d9 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/LowMomentumFormula.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.ContractionIntegral +public import LeanPool.LiebThirring.Kinetic.ContractionState +public import LeanPool.LiebThirring.Kinetic.CurryingDensity +public import LeanPool.LiebThirring.Kinetic.LowMomentumTest +public import LeanPool.LiebThirring.Fourier.ContractionFourier + +/-! +# Pointwise low fields and one-particle contraction + +The negative Fourier phase in the one-spin test becomes the positive +inverse phase under the adjoint contraction. The equality is in the Hilbert +fiber at every spatial point, without pointwise claims about state slices. +-/ + +public section + +open MeasureTheory +open scoped FourierTransform ComplexConjugate + +namespace LiebThirring + +variable {ι H : Type*} [Fintype ι] [DecidableEq ι] + [NormedAddCommGroup H] [InnerProductSpace ℂ H] [CompleteSpace H] + +/-- A one-spin negative-phase Fourier test contracts to the continuous low +field component. The representative premise characterizes the test, rather +than assuming a low-momentum estimate. -/ +theorem lowFourierField_component_eq_of_fourier_ae + (h : Lp (PiLp 2 (fun _ : ι => H)) 2 (volume : Measure Position)) + (E : ℝ) (hE : 0 ≤ E) (x : Position) (s : ι) + (g : Lp (EuclideanSpace ℂ ι) 2 (volume : Measure Position)) + (hg : ((𝓕 g : Lp (EuclideanSpace ℂ ι) 2 volume) : Position → EuclideanSpace ℂ ι) =ᵐ[volume] + (lowMomentumRegion E).indicator (fun ξ => + EuclideanSpace.single s (Real.fourierChar (-inner ℝ ξ x) : ℂ))) : + lowFourierField h E x s = tensorContraction (H := H) g h := by + apply ext_inner_left ℂ + intro v + rw [← Fourier.tensorContraction_fourier, inner_tensorContraction] + let P : PiLp 2 (fun _ : ι => H) →L[ℂ] ℂ := + (innerSL ℂ v).comp (PiLp.proj (𝕜 := ℂ) 2 (fun _ : ι => H) s) + have hraw := integrable_lowFourierField h E hE x + have hcomm := P.integral_comp_comm hraw + have hlow : lowFourierField h E x = ∫ ξ : Position, + Real.fourierChar (inner ℝ ξ x) • + (lowMomentumRegion E).indicator + (Lp.fourierTransformₗᵢ Position (PiLp 2 (fun _ : ι => H)) h : Position → PiLp 2 (fun _ : + ι => H)) ξ := by + rw [lowFourierField, Real.fourierInv_eq] + change P (lowFourierField h E x) = _ + rw [hlow] + rw [← hcomm] + apply integral_congr_ae + filter_upwards [hg] with ξ hξ + rw [hξ] + by_cases hmem : ξ ∈ lowMomentumRegion E + · simp [P, Set.indicator_of_mem hmem, Circle.smul_def, EuclideanSpace.single, + apply_ite, ite_mul] + rfl + · simp [P, Set.indicator_of_notMem hmem] + +/-- The exact the low-momentum bound test contracts to the scaled density-field component. -/ +theorem lowFourierField_density_component_eq {N q : ℕ} (i : Fin N) + (ψ : State N q) (E : ℝ) (hE : 0 ≤ E) (x : Position) (s : Fin q) : + lowFourierField (densityField i ψ) E x s = + (Real.sqrt N : ℂ) • oneParticleContraction i (lowMomentumTest E x s hE) ψ := by + calc + _ = tensorContraction (H := RestState i q) (lowMomentumTest E x s hE) + (densityField i ψ) := + lowFourierField_component_eq_of_fourier_ae _ E hE x s _ + (lowMomentumTest_fourier_ae E hE x s) + _ = _ := by + change tensorContraction (H := RestState i q) (lowMomentumTest E x s hE) + ((Real.sqrt N : ℂ) • oneParticleCurrying i ψ) = + (Real.sqrt N : ℂ) • tensorContraction (H := RestState i q) + (lowMomentumTest E x s hE) (oneParticleCurrying i ψ) + exact map_smul _ _ _ + +/-- Squared component norm in the exact normalization used by the Pauli bound. -/ +theorem lowFourierField_density_component_norm_sq {N q : ℕ} (i : Fin N) + (ψ : State N q) (E : ℝ) (hE : 0 ≤ E) (x : Position) (s : Fin q) : + ‖lowFourierField (densityField i ψ) E x s‖ ^ 2 = + (N : ℝ) * ‖oneParticleContraction i (lowMomentumTest E x s hE) ψ‖ ^ 2 := by + rw [lowFourierField_density_component_eq, norm_smul, mul_pow, + Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg (Real.sqrt_nonneg _), + Real.sq_sqrt (Nat.cast_nonneg N)] + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/LowMomentumTest.lean b/LeanPool/LiebThirring/Kinetic/LowMomentumTest.lean new file mode 100644 index 0000000000..9d37697331 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/LowMomentumTest.lean @@ -0,0 +1,128 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.Cutoff + +/-! +# One-particle test vectors for low Fourier fields + +Literal Fourier-side spin test with negative phase. + +The Fourier-side test has the norm of a constant unit-spin indicator. +-/ + +public section + +open MeasureTheory +open scoped FourierTransform + +namespace LiebThirring + +/-- Literal Fourier-side spin test with negative phase. -/ +@[expose] noncomputable def lowMomentumTestFourierFunction {q : ℕ} (E : ℝ) + (x : Position) (s : Fin q) : Position → EuclideanSpace ℂ (Fin q) := + (lowMomentumRegion E).indicator (fun ξ => + EuclideanSpace.single s (Real.fourierChar (-inner ℝ ξ x) : ℂ)) + +/-- The Fourier-side test has the norm of a constant unit-spin indicator. -/ +theorem norm_lowMomentumTestFourierFunction {q : ℕ} (E : ℝ) + (x ξ : Position) (s : Fin q) : + ‖lowMomentumTestFourierFunction E x s ξ‖ = + ‖(lowMomentumRegion E).indicator + (fun _ => EuclideanSpace.single s (1 : ℂ)) ξ‖ := by + classical + by_cases hξ : ξ ∈ lowMomentumRegion E + · simp only [lowMomentumTestFourierFunction, Set.indicator_of_mem hξ, + PiLp.norm_single, Circle.norm_coe, norm_one] + · simp only [lowMomentumTestFourierFunction, Set.indicator_of_notMem hξ] + +/-- Every Fourier-side test is strongly measurable. -/ +theorem stronglyMeasurable_lowMomentumTestFourierFunction {q : ℕ} (E : ℝ) + (x : Position) (s : Fin q) : + StronglyMeasurable (lowMomentumTestFourierFunction E x s) := by + have hc : Continuous (fun ξ : Position => + EuclideanSpace.single s (Real.fourierChar (-inner ℝ ξ x) : ℂ)) := by + classical + change Continuous (fun ξ : Position => + WithLp.toLp 2 (Pi.single s (Real.fourierChar (-inner ℝ ξ x) : ℂ) : Fin q → ℂ)) + apply (PiLp.continuous_toLp 2 (fun _ : Fin q => ℂ)).comp + apply continuous_pi + intro t + simp only [Pi.single_apply] + split_ifs <;> fun_prop + exact hc.stronglyMeasurable.indicator (measurableSet_lowMomentumRegion E) + +/-- Finite low-region volume makes the literal Fourier-side test an L² function. -/ +theorem memLp_lowMomentumTestFourierFunction {q : ℕ} (E : ℝ) (hE : 0 ≤ E) + (x : Position) (s : Fin q) : + MemLp (lowMomentumTestFourierFunction E x s) 2 (volume : Measure Position) := by + have hc : MemLp ((lowMomentumRegion E).indicator + (fun _ : Position => EuclideanSpace.single s (1 : ℂ))) 2 volume := + memLp_indicator_const 2 (measurableSet_lowMomentumRegion E) + (EuclideanSpace.single s (1 : ℂ)) (Or.inr (volume_lowMomentumRegion_ne_top E hE)) + exact hc.congr_norm (stronglyMeasurable_lowMomentumTestFourierFunction E x s).aestronglyMeasurable + (Filter.Eventually.of_forall (fun ξ => (norm_lowMomentumTestFourierFunction E x ξ s).symm)) + +/-- The exact Fourier-side L² class of the cutoff spin test. -/ +@[expose] noncomputable def lowMomentumTestFrequencyClass {q : ℕ} (E : ℝ) (hE : 0 ≤ E) + (x : Position) (s : Fin q) : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position) := + (memLp_lowMomentumTestFourierFunction E hE x s).toLp + (lowMomentumTestFourierFunction E x s) + +/-- The spatial one-particle cutoff test is inverse L² Fourier of its literal frequency class. -/ +@[expose] noncomputable def lowMomentumTest {q : ℕ} (E : ℝ) + (x : Position) (s : Fin q) (hE : 0 ≤ E) : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure + Position) := + 𝓕⁻ (lowMomentumTestFrequencyClass E hE x s) + +/-- Fourier of the test is exactly the prescribed cutoff frequency class. -/ +theorem fourier_lowMomentumTest {q : ℕ} (E : ℝ) (hE : 0 ≤ E) + (x : Position) (s : Fin q) : + 𝓕 (lowMomentumTest E x s hE) = lowMomentumTestFrequencyClass E hE x s := + FourierTransform.fourier_fourierInv_eq _ + +/-- One common literal negative-phase Fourier representative for the test. -/ +theorem lowMomentumTest_fourier_ae {q : ℕ} (E : ℝ) (hE : 0 ≤ E) + (x : Position) (s : Fin q) : + ((𝓕 (lowMomentumTest E x s hE) : Lp (EuclideanSpace ℂ (Fin q)) 2 volume) : + Position → EuclideanSpace ℂ (Fin q)) =ᵐ[volume] lowMomentumTestFourierFunction E x s := by + rw [fourier_lowMomentumTest] + exact (memLp_lowMomentumTestFourierFunction E hE x s).coeFn_toLp + +/-- The test has squared norm equal to the finite low-region volume. -/ +theorem lowMomentumTest_norm_sq {q : ℕ} (E : ℝ) (hE : 0 ≤ E) + (x : Position) (s : Fin q) : + ‖lowMomentumTest E x s hE‖ ^ 2 = (volume (lowMomentumRegion E)).toReal := by + classical + have hn : ‖lowMomentumTestFrequencyClass E hE x s‖ = + ‖indicatorConstLp (μ := (volume : Measure Position)) 2 + (measurableSet_lowMomentumRegion E) (volume_lowMomentumRegion_ne_top E hE) + (EuclideanSpace.single s (1 : ℂ))‖ := by + rw [Lp.norm_def, Lp.norm_def] + congr 1 + apply eLpNorm_congr_norm_ae + (Lp.aestronglyMeasurable _) (Lp.aestronglyMeasurable _) + filter_upwards [(memLp_lowMomentumTestFourierFunction E hE x s).coeFn_toLp, + indicatorConstLp_coeFn (p := 2) (μ := (volume : Measure Position)) + (hs := measurableSet_lowMomentumRegion E) + (hμs := volume_lowMomentumRegion_ne_top E hE) + (c := EuclideanSpace.single s (1 : ℂ))] with ξ hf hc + change lowMomentumTestFrequencyClass E hE x s ξ = _ at hf + rw [hf, hc] + exact norm_lowMomentumTestFourierFunction E x ξ s + change ‖(Lp.fourierTransformₗᵢ Position (EuclideanSpace ℂ (Fin q))).symm + (lowMomentumTestFrequencyClass E hE x s)‖ ^ 2 = _ + rw [LinearIsometryEquiv.norm_map, hn, norm_indicatorConstLp (by norm_num) (by norm_num)] + simp only [PiLp.norm_single, norm_one, one_mul, ENNReal.toReal_ofNat, Measure.real, + ← Real.sqrt_eq_rpow] + exact Real.sq_sqrt ENNReal.toReal_nonneg + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/PauliAbstract.lean b/LeanPool/LiebThirring/Kinetic/PauliAbstract.lean new file mode 100644 index 0000000000..3555b881ba --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/PauliAbstract.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import Mathlib.Analysis.InnerProductSpace.LinearMap + +/-! +# The finite projection argument underlying the Pauli bound + +Finite families of symmetric idempotent lifts with zero double occupancy satisfy a +projection-sum bound. The operator relations are explicit hypotheses. +-/ + +public section + +namespace LiebThirring + +section + +variable {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℂ E] +variable {ι : Type*} [Fintype ι] + +/-- Symmetric idempotent lifts with zero double occupancy have a bounded sum +of squared projected norms. All operator relations are explicit inputs to this +abstract lemma. -/ +theorem sum_norm_sq_le_of_projection_relations (P : ι → E →L[ℂ] E) (ψ : E) + (hsym : ∀ i x y, inner ℂ (P i x) y = inner ℂ x (P i y)) + (hid : ∀ i, P i (P i ψ) = P i ψ) + (hzero : ∀ i j, i ≠ j → P i (P j ψ) = 0) : + ∑ i : ι, ‖P i ψ‖ ^ 2 ≤ ‖ψ‖ ^ 2 := by + classical + have horth (i j : ι) (hij : i ≠ j) : inner ℂ (P i ψ) (P j ψ) = 0 := by + rw [hsym, hzero i j hij, inner_zero_right] + have hdiag (i : ι) : inner ℂ ψ (P i ψ) = inner ℂ (P i ψ) (P i ψ) := by + rw [hsym, hid] + have hv : ‖∑ i : ι, P i ψ‖ ^ 2 = ∑ i : ι, ‖P i ψ‖ ^ 2 := by + have hinner : inner ℂ (∑ i : ι, P i ψ) (∑ i : ι, P i ψ) = + ∑ i : ι, inner ℂ (P i ψ) (P i ψ) := by + rw [sum_inner] + apply Finset.sum_congr rfl + intro i _ + rw [inner_sum] + apply Finset.sum_eq_single i + · intro j _ hji + exact horth i j hji.symm + · intro hi + exact (hi (Finset.mem_univ i)).elim + rw [← inner_self_eq_norm_sq (𝕜 := ℂ), hinner] + simp only [map_sum, inner_self_eq_norm_sq] + have hψv : RCLike.re (inner ℂ ψ (∑ i : ι, P i ψ)) = ∑ i : ι, ‖P i ψ‖ ^ 2 := by + rw [inner_sum] + simp only [hdiag, map_sum, inner_self_eq_norm_sq] + have hnorm := norm_sub_sq (𝕜 := ℂ) ψ (∑ i : ι, P i ψ) + rw [hv, hψv] at hnorm + linarith only [hnorm, sq_nonneg ‖ψ - ∑ i : ι, P i ψ‖] + +/-- Equal projection norms turn the projection sum estimate into an occupation +estimate. This is abstract infrastructure, not Pauli occupation on the state space. -/ +theorem card_mul_norm_sq_le_of_projection_relations (P : ι → E →L[ℂ] E) (ψ : E) + (hsym : ∀ i x y, inner ℂ (P i x) y = inner ℂ x (P i y)) + (hid : ∀ i, P i (P i ψ) = P i ψ) + (hzero : ∀ i j, i ≠ j → P i (P j ψ) = 0) + (i : ι) (hequal : ∀ j, ‖P j ψ‖ = ‖P i ψ‖) : + (Fintype.card ι : ℝ) * ‖P i ψ‖ ^ 2 ≤ ‖ψ‖ ^ 2 := by + have h := sum_norm_sq_le_of_projection_relations P ψ hsym hid hzero + simpa only [hequal, Finset.sum_const, Finset.card_univ, nsmul_eq_mul] using h + +end + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/PauliDoubleInsertion.lean b/LeanPool/LiebThirring/Kinetic/PauliDoubleInsertion.lean new file mode 100644 index 0000000000..ee1021d216 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/PauliDoubleInsertion.lean @@ -0,0 +1,224 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.ContractionFactors +public import LeanPool.LiebThirring.Kinetic.PauliLiftCurrying +public import LeanPool.LiebThirring.Kinetic.FourierFactor + +/-! +# Two-particle insertion on the state carrier + +Insert the same one-particle vector in two distinct coordinates. + +The two-particle insertion has its literal nested product representative. +-/ + +@[expose] public section + +open MeasureTheory +open scoped ENNReal InnerProduct + +namespace LiebThirring + +/-- Insert the same one-particle vector in two distinct coordinates. -/ +noncomputable def doubleParticleInsertion {N q : ℕ} (i j : Fin N) (hij : i ≠ j) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) : + PairRestState i j q →L[ℂ] State N q := + let C : PairCurriedState i j q ≃L[ℂ] State N q := + (pairCurryingLinearIsometryEquiv (q := q) i j hij).symm.toContinuousLinearEquiv + C.toContinuousLinearMap.comp (doubleFactorInsertion (H := PairRestState i j q) f) + +/-- The two-particle insertion has its literal nested product representative. -/ +theorem doubleParticleInsertion_apply_ae {N q : ℕ} (i j : Fin N) (hij : i ≠ j) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) + (v : PairRestState i j q) : + ∀ᵐ x : Position, ∀ s : Fin q, ∀ᵐ z : Position, ∀ r : Fin q, + ∀ᵐ y : OtherPairConfiguration i j, ∀ t : OtherPairSpinLabels i j q, + doubleParticleInsertion i j hij f v + (insertParticlePair i j x z y) (insertSpinPair i j s r t) = + f x s * f z r * v y t := by + have hc := pairCurryingLinearIsometryEquiv_apply_ae i j hij + (doubleParticleInsertion i j hij f v) + have hout := tensorInsertion_apply_ae (H := + FirstFactorSpace (Fin q) Position (PairRestState i j q) (volume : Measure Position)) + f (tensorInsertion (H := PairRestState i j q) f v) + have hin := tensorInsertion_apply_ae (H := PairRestState i j q) f v + have heq : pairCurryingLinearIsometryEquiv (q := q) i j hij + (doubleParticleInsertion i j hij f v) = + doubleFactorInsertion (H := PairRestState i j q) f v := by + change pairCurryingLinearIsometryEquiv (q := q) i j hij + ((pairCurryingLinearIsometryEquiv (q := q) i j hij).symm + (doubleFactorInsertion (H := PairRestState i j q) f v)) = _ + exact (pairCurryingLinearIsometryEquiv (q := q) i j hij).apply_symm_apply _ + filter_upwards [hc, hout] with x hcx hox + intro s + filter_upwards [hcx s, hin, + Lp.coeFn_smul (f x s) (tensorInsertion (H := PairRestState i j q) f v)] + with z hcz hiz hsmz + intro r + filter_upwards [hcz r, + Lp.coeFn_smul (f x s) (f z r • v), Lp.coeFn_smul (f z r) v] + with y hczy hsm hsmv + intro t + rw [← hczy t, heq] + change ((tensorInsertion (H := FirstFactorSpace (Fin q) Position + (PairRestState i j q) (volume : Measure Position)) f + (tensorInsertion (H := PairRestState i j q) f v)) x s) z r y t = _ + rw [hox s, hsmz] + change ((f x s) • ((tensorInsertion (H := PairRestState i j q) f v) z r)) y t = _ + rw [hiz r, hsm] + change f x s * ((f z r • v) y t) = _ + rw [hsmv] + change f x s * (f z r * v y t) = _ + ring + +private theorem doubleParticleInsertion_apply_swap_ae {N q : ℕ} + (i j : Fin N) (hij : i ≠ j) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) + (v : PairRestState i j q) : + ∀ᵐ x : Position, ∀ s : Fin q, ∀ᵐ z : Position, ∀ r : Fin q, + ∀ᵐ y : OtherPairConfiguration i j, ∀ t : OtherPairSpinLabels i j q, + doubleParticleInsertion i j hij f v + (insertParticlePair i j z x y) (insertSpinPair i j r s t) = + f z r * f x s * v y t := by + let μp : Measure Position := volume + let μr : Measure (OtherPairConfiguration i j) := volume + let mtranspose : MeasurePreserving + (fun w : Position × (Position × OtherPairConfiguration i j) => + (w.2.1, (w.1, w.2.2))) (μp.prod (μp.prod μr)) (μp.prod (μp.prod μr)) := by + let massoc₁ : MeasurePreserving (MeasurableEquiv.prodAssoc.symm : + Position × (Position × OtherPairConfiguration i j) → + (Position × Position) × OtherPairConfiguration i j) + (μp.prod (μp.prod μr)) ((μp.prod μp).prod μr) := + (measurePreserving_prodAssoc μp μp μr).symm MeasurableEquiv.prodAssoc + let mswap : MeasurePreserving (Prod.map Prod.swap id) + ((μp.prod μp).prod μr) ((μp.prod μp).prod μr) := + MeasurePreserving.prod Measure.measurePreserving_swap (MeasurePreserving.id μr) + let massoc₂ : MeasurePreserving MeasurableEquiv.prodAssoc + ((μp.prod μp).prod μr) (μp.prod (μp.prod μr)) := + measurePreserving_prodAssoc μp μp μr + exact massoc₂.comp (mswap.comp massoc₁) + have hbase := doubleParticleInsertion_apply_ae i j hij f v + have hswap (s : Fin q) (r : Fin q) (t : OtherPairSpinLabels i j q) : + ∀ᵐ x : Position, ∀ᵐ z : Position, ∀ᵐ y : OtherPairConfiguration i j, + doubleParticleInsertion i j hij f v + (insertParticlePair i j z x y) (insertSpinPair i j r s t) = + f z r * f x s * v y t := by + let P := fun w : Position × (Position × OtherPairConfiguration i j) => + doubleParticleInsertion i j hij f v + (insertParticlePair i j w.1 w.2.1 w.2.2) (insertSpinPair i j r s t) = + f w.1 r * f w.2.1 s * v w.2.2 t + have hP : MeasurableSet {w | P w} := by + apply measurableSet_setOfPred.mpr + have hins : Measurable (fun w : Position × (Position × OtherPairConfiguration i j) => + insertParticlePair i j w.1 w.2.1 w.2.2) := by + convert (pairInsertionMeasurableEquiv i j hij).measurable using 1 + funext w + exact (pairInsertionMeasurableEquiv_apply i j hij w).symm + have hl : StronglyMeasurable (fun w : Position × + (Position × OtherPairConfiguration i j) => + doubleParticleInsertion i j hij f v + (insertParticlePair i j w.1 w.2.1 w.2.2) (insertSpinPair i j r s t)) := + (PiLp.proj (𝕜 := ℂ) 2 (fun _ : SpinLabels N q => ℂ) + (insertSpinPair i j r s t)).continuous.comp_stronglyMeasurable + ((Lp.stronglyMeasurable (doubleParticleInsertion i j hij f v)).comp_measurable hins) + exact Measurable.eq hl.measurable (by fun_prop) + have hnested : ∀ᵐ x : Position, ∀ᵐ z : Position, + ∀ᵐ y : OtherPairConfiguration i j, P (x, (z, y)) := by + filter_upwards [hbase] with x hx + filter_upwards [hx r] with z hz + filter_upwards [hz s] with y hy + exact hy t + have hjoint : ∀ᵐ w ∂μp.prod (μp.prod μr), P w := by + apply (Measure.ae_prod_iff_ae_ae hP).2 + filter_upwards [hnested] with x hx + apply (Measure.ae_prod_iff_ae_ae (show MeasurableSet {w | P (x, w)} from by + change MeasurableSet ((fun w => (x, w)) ⁻¹' {w | P w}) + exact hP.preimage (by fun_prop))).2 hx + have htrans := mtranspose.quasiMeasurePreserving.ae hjoint + have htrans' : ∀ᵐ x : Position, ∀ᵐ z : Position, + ∀ᵐ y : OtherPairConfiguration i j, P (z, (x, y)) := by + have hP' : MeasurableSet {w : Position × + (Position × OtherPairConfiguration i j) | P (w.2.1, (w.1, w.2.2))} := + hP.preimage mtranspose.measurable + have := (Measure.ae_prod_iff_ae_ae hP').1 htrans + filter_upwards [this] with x hx + exact (Measure.ae_prod_iff_ae_ae + (show MeasurableSet {w : Position × OtherPairConfiguration i j | + P (w.1, (x, w.2))} from by + change MeasurableSet ((fun w => (x, w)) ⁻¹' + {w : Position × (Position × OtherPairConfiguration i j) | + P (w.2.1, (w.1, w.2.2))}) + exact hP'.preimage (by fun_prop))).1 hx + simpa only [P] using htrans' + have hall : ∀ᵐ x : Position, ∀ s : Fin q, ∀ r : Fin q, + ∀ t : OtherPairSpinLabels i j q, ∀ᵐ z : Position, + ∀ᵐ y : OtherPairConfiguration i j, + doubleParticleInsertion i j hij f v + (insertParticlePair i j z x y) (insertSpinPair i j r s t) = + f z r * f x s * v y t := + ae_all_iff.mpr fun s => ae_all_iff.mpr fun r => ae_all_iff.mpr fun t => hswap s r t + filter_upwards [hall] with x hx + intro s + have hzr : ∀ᵐ z : Position, ∀ r : Fin q, ∀ t : OtherPairSpinLabels i j q, + ∀ᵐ y : OtherPairConfiguration i j, + doubleParticleInsertion i j hij f v + (insertParticlePair i j z x y) (insertSpinPair i j r s t) = + f z r * f x s * v y t := + ae_all_iff.mpr fun r => ae_all_iff.mpr fun t => hx s r t + filter_upwards [hzr] with z hz + intro r + have hyt : ∀ᵐ y : OtherPairConfiguration i j, ∀ t : OtherPairSpinLabels i j q, + doubleParticleInsertion i j hij f v + (insertParticlePair i j z x y) (insertSpinPair i j r s t) = + f z r * f x s * v y t := ae_all_iff.mpr fun t => hz r t + exact hyt + +/-- Exchanging the two inserted coordinates fixes the double insertion. -/ +theorem simultaneousPermutation_doubleParticleInsertion {N q : ℕ} + (i j : Fin N) (hij : i ≠ j) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) + (v : PairRestState i j q) : + simultaneousPermutation (Equiv.swap i j) + (doubleParticleInsertion i j hij f v) = + doubleParticleInsertion i j hij f v := by + apply (pairCurryingLinearIsometryEquiv (q := q) i j hij).injective + apply Lp.ext + have hp := Measure.ae_ae_of_ae_prod + ((measurePreserving_pairInsertion i j hij).quasiMeasurePreserving.ae + (simultaneousPermutation_apply_ae (Equiv.swap i j) + (doubleParticleInsertion i j hij f v))) + filter_upwards [pairCurryingLinearIsometryEquiv_apply_ae i j hij + (simultaneousPermutation (Equiv.swap i j) (doubleParticleInsertion i j hij f v)), + pairCurryingLinearIsometryEquiv_apply_ae i j hij + (doubleParticleInsertion i j hij f v), hp, + doubleParticleInsertion_apply_ae i j hij f v, + doubleParticleInsertion_apply_swap_ae i j hij f v] with x hl hr hp hD hDswap + apply PiLp.ext + intro s + apply Lp.ext + have hp' := Measure.ae_ae_of_ae_prod hp + filter_upwards [hl s, hr s, hp', hD s, hDswap s] with z hlz hrz hpz hDz hDswapz + apply PiLp.ext + intro r + apply Lp.ext + filter_upwards [hlz r, hrz r, hpz, hDz r, hDswapz r] + with y hly hry hpy hDy hDswapy + ext t + rw [hly t, hry t, ← pairInsertionMeasurableEquiv_apply i j hij (x, (z, y)), + hpy, pairInsertionMeasurableEquiv_apply, + permutePositions_swap_insertParticlePair i j hij, + permuteSpins_swap_insertSpinPair i j hij, hDy t] + rw [hDswapy t] + ring + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/PauliLiftCurrying.lean b/LeanPool/LiebThirring/Kinetic/PauliLiftCurrying.lean new file mode 100644 index 0000000000..5cdb8e107a --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/PauliLiftCurrying.lean @@ -0,0 +1,231 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.PauliLiftEncoding +public import LeanPool.LiebThirring.Kinetic.CurryingState + +/-! # Two-particle currying + +An ordered two-coordinate version of the state currying equivalence. Its +parenthesization exposes the first one-particle factor and then the second. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal + +namespace LiebThirring + +instance pairProductVolumeIsSeparable {N : ℕ} (i j : Fin N) : + IsSeparable (volume : Measure (Position × OtherPairConfiguration i j)) := + isSeparable_of_sigmaFinite _ + +/-- The Hilbert space of spatial and spin coordinates remaining after two +distinct particles are removed. -/ +noncomputable abbrev PairRestState {N : ℕ} (i j : Fin N) (q : ℕ) : Type := + Lp (EuclideanSpace ℂ (OtherPairSpinLabels i j q)) 2 + (volume : Measure (OtherPairConfiguration i j)) + +/-- The ordered two-coordinate curried state carrier. -/ +noncomputable abbrev PairCurriedState {N : ℕ} (i j : Fin N) (q : ℕ) : Type := + Lp (PiLp 2 (fun _ : Fin q => + Lp (PiLp 2 (fun _ : Fin q => PairRestState i j q)) 2 + (volume : Measure Position))) 2 (volume : Measure Position) + +instance pairSpinRestSecondCountableTopology {N : ℕ} (i j : Fin N) (q : ℕ) : + SecondCountableTopology + (Lp (PiLp 2 (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q))) 2 + (volume : Measure (OtherPairConfiguration i j))) := by + let : Fact ((2 : ℝ≥0∞) ≠ ⊤) := ⟨by norm_num⟩ + infer_instance + +instance pairNestedSpinSecondCountableTopology {N : ℕ} (i j : Fin N) (q : ℕ) : + SecondCountableTopology + (Lp (PiLp 2 (fun _ : Fin q => PiLp 2 (fun _ : Fin q => + EuclideanSpace ℂ (OtherPairSpinLabels i j q)))) 2 + (volume : Measure (Position × OtherPairConfiguration i j))) := by + let : Fact ((2 : ℝ≥0∞) ≠ ⊤) := ⟨by norm_num⟩ + infer_instance + +/-- Curry the inner position and distribute both finite spin coordinates. -/ +@[expose] noncomputable def innerPairCurryingEquiv {N q : ℕ} + (i j : Fin N) : + Lp (PiLp 2 (fun _ : Fin q => PiLp 2 (fun _ : Fin q => + EuclideanSpace ℂ (OtherPairSpinLabels i j q)))) 2 + (volume : Measure (Position × OtherPairConfiguration i j)) ≃ₗᵢ[ℂ] + PiLp 2 (fun _ : Fin q => + Lp (PiLp 2 (fun _ : Fin q => PairRestState i j q)) 2 + (volume : Measure Position)) := by + let D := finiteLpPiLpEquiv + (volume : Measure (Position × OtherPairConfiguration i j)) + (fun _ : Fin q => PiLp 2 (fun _ : Fin q => + EuclideanSpace ℂ (OtherPairSpinLabels i j q))) + let E (s : Fin q) := + (l2CurryLinearIsometryEquiv (μ := (volume : Measure Position)) + (ν := (volume : Measure (OtherPairConfiguration i j))) + (E := PiLp 2 (fun _ : Fin q => + EuclideanSpace ℂ (OtherPairSpinLabels i j q)))).trans + (l2TargetEquiv (volume : Measure Position) + (finiteLpPiLpEquiv (volume : Measure (OtherPairConfiguration i j)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q)))) + exact D.trans (LinearIsometryEquiv.piLpCongrRight 2 (𝕜 := ℂ) E) + +/-- Representative formula for the inner half of ordered pair currying. -/ +theorem innerPairCurryingEquiv_ae {N q : ℕ} (i j : Fin N) + (h : Lp (PiLp 2 (fun _ : Fin q => PiLp 2 (fun _ : Fin q => + EuclideanSpace ℂ (OtherPairSpinLabels i j q)))) 2 + (volume : Measure (Position × OtherPairConfiguration i j))) : + ∀ s : Fin q, ∀ᵐ z : Position, ∀ r : Fin q, + ∀ᵐ y : OtherPairConfiguration i j, ∀ t : OtherPairSpinLabels i j q, + innerPairCurryingEquiv i j h s z r y t = h (z, y) s r t := by + let D := finiteLpPiLpEquiv + (volume : Measure (Position × OtherPairConfiguration i j)) + (fun _ : Fin q => PiLp 2 (fun _ : Fin q => + EuclideanSpace ℂ (OtherPairSpinLabels i j q))) + intro s + have hD := Measure.ae_ae_of_ae_prod (finiteLpPiLpEquiv_apply_ae + (μ := (volume : Measure (Position × OtherPairConfiguration i j))) + (E := fun _ : Fin q => PiLp 2 (fun _ : Fin q => + EuclideanSpace ℂ (OtherPairSpinLabels i j q))) h s) + change ∀ᵐ z : Position, ∀ r : Fin q, + ∀ᵐ y : OtherPairConfiguration i j, ∀ t : OtherPairSpinLabels i j q, + l2TargetEquiv (volume : Measure Position) + (finiteLpPiLpEquiv (volume : Measure (OtherPairConfiguration i j)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q))) + (l2CurryLinearIsometryEquiv (D h s)) z r y t = h (z, y) s r t + filter_upwards [l2TargetEquiv_ae (volume : Measure Position) + (finiteLpPiLpEquiv (volume : Measure (OtherPairConfiguration i j)) + (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q))) + (l2CurryLinearIsometryEquiv (D h s)), + l2CurryLinearIsometryEquiv_apply_ae (D h s), hD] with z hz hc hDz + intro r + rw [hz] + filter_upwards [finiteLpPiLpEquiv_apply_ae + (μ := (volume : Measure (OtherPairConfiguration i j))) + (E := fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q)) + (l2CurryLinearIsometryEquiv (D h s) z) r, hc, hDz] with y hy hcy hDy + intro t + rw [hy, hcy, hDy] + +/-- The state carrier after separating two spatial coordinates, before spin regrouping. -/ +noncomputable abbrev PairRawState {N q : ℕ} (i j : Fin N) : Type := + Lp (SpinAmplitudes N q) 2 + (volume : Measure (Position × (Position × OtherPairConfiguration i j))) + +/-- The state carrier after separating and regrouping the two selected spins. -/ +noncomputable abbrev PairSpinState {N q : ℕ} (i j : Fin N) : Type := + Lp (PiLp 2 (fun _ : Fin q => PiLp 2 (fun _ : Fin q => + EuclideanSpace ℂ (OtherPairSpinLabels i j q)))) 2 + (volume : Measure (Position × (Position × OtherPairConfiguration i j))) + +/-- The state carrier after currying the first selected spatial coordinate. -/ +noncomputable abbrev PairOuterState {N q : ℕ} (i j : Fin N) : Type := + Lp (Lp (PiLp 2 (fun _ : Fin q => PiLp 2 (fun _ : Fin q => + EuclideanSpace ℂ (OtherPairSpinLabels i j q)))) 2 + (volume : Measure (Position × OtherPairConfiguration i j))) 2 + (volume : Measure Position) + +/-- Pull states back along the measure-preserving two-particle coordinate insertion. -/ +noncomputable def pairPullbackEquiv {N q : ℕ} (i j : Fin N) (hij : i ≠ j) : + State N q ≃ₗᵢ[ℂ] PairRawState (q := q) i j := + l2PullbackEquiv (E := SpinAmplitudes N q) + (pairInsertionMeasurableEquiv i j hij) (measurePreserving_pairInsertion i j hij) + +theorem pairPullbackEquiv_apply_ae {N q : ℕ} (i j : Fin N) (hij : i ≠ j) + (ψ : State N q) : + pairPullbackEquiv i j hij ψ =ᵐ[volume] + fun w => ψ (pairInsertionMeasurableEquiv i j hij w) := by + exact l2PullbackEquiv_ae (E := SpinAmplitudes N q) + (pairInsertionMeasurableEquiv i j hij) (measurePreserving_pairInsertion i j hij) ψ + +/-- Regroup the two selected spin coordinates in the pulled-back state. -/ +noncomputable def pairSpinTargetEquiv {N q : ℕ} (i j : Fin N) (hij : i ≠ j) : + PairRawState (q := q) i j ≃ₗᵢ[ℂ] PairSpinState (q := q) i j := + l2TargetEquiv (volume : Measure (Position × (Position × OtherPairConfiguration i j))) + (spinPairCurryingLinearIsometryEquiv (q := q) i j hij) + +theorem pairSpinTargetEquiv_apply_ae {N q : ℕ} (i j : Fin N) (hij : i ≠ j) + (a : PairRawState (q := q) i j) : + pairSpinTargetEquiv i j hij a =ᵐ[volume] + fun w => spinPairCurryingLinearIsometryEquiv i j hij (a w) := by + exact l2TargetEquiv_ae + (volume : Measure (Position × (Position × OtherPairConfiguration i j))) + (spinPairCurryingLinearIsometryEquiv (q := q) i j hij) a + +/-- Curry the first selected spatial coordinate in the spin-regrouped state. -/ +noncomputable def pairOuterCurryEquiv {N q : ℕ} (i j : Fin N) : + PairSpinState (q := q) i j ≃ₗᵢ[ℂ] PairOuterState (q := q) i j := + l2CurryLinearIsometryEquiv (μ := (volume : Measure Position)) + (ν := (volume : Measure (Position × OtherPairConfiguration i j))) + (E := PiLp 2 (fun _ : Fin q => PiLp 2 (fun _ : Fin q => + EuclideanSpace ℂ (OtherPairSpinLabels i j q)))) + +theorem pairOuterCurryEquiv_apply_ae {N q : ℕ} (i j : Fin N) + (h : PairSpinState (q := q) i j) : + ∀ᵐ x : Position, ∀ᵐ w : Position × OtherPairConfiguration i j, + pairOuterCurryEquiv i j h x w = h (x, w) := by + exact l2CurryLinearIsometryEquiv_apply_ae h + +/-- Curry the inner spatial coordinate and distribute its finite-spin factors. -/ +noncomputable def pairInnerTargetEquiv {N q : ℕ} (i j : Fin N) := + l2TargetEquiv (volume : Measure Position) (innerPairCurryingEquiv (q := q) i j) + +theorem pairInnerTargetEquiv_apply_ae {N q : ℕ} (i j : Fin N) + (c : PairOuterState (q := q) i j) : + pairInnerTargetEquiv i j c =ᵐ[volume] + fun x => innerPairCurryingEquiv i j (c x) := by + exact l2TargetEquiv_ae (volume : Measure Position) + (innerPairCurryingEquiv (q := q) i j) c + +/-- The ordered two-particle currying equivalence on the state carrier. -/ +noncomputable def pairCurryingLinearIsometryEquiv {N q : ℕ} + (i j : Fin N) (hij : i ≠ j) : State N q ≃ₗᵢ[ℂ] PairCurriedState i j q := + (((pairPullbackEquiv (q := q) i j hij).trans (pairSpinTargetEquiv i j hij)).trans + (pairOuterCurryEquiv i j)).trans (pairInnerTargetEquiv i j) + +/-- The ordered pair currying has the literal two-particle representative. -/ +theorem pairCurryingLinearIsometryEquiv_apply_ae {N q : ℕ} + (i j : Fin N) (hij : i ≠ j) (ψ : State N q) : + ∀ᵐ x : Position, ∀ s : Fin q, ∀ᵐ z : Position, ∀ r : Fin q, + ∀ᵐ y : OtherPairConfiguration i j, ∀ t : OtherPairSpinLabels i j q, + pairCurryingLinearIsometryEquiv i j hij ψ x s z r y t = + ψ (insertParticlePair i j x z y) (insertSpinPair i j s r t) := by + let a : PairRawState (q := q) i j := pairPullbackEquiv i j hij ψ + let h : PairSpinState (q := q) i j := pairSpinTargetEquiv i j hij a + let c : PairOuterState (q := q) i j := pairOuterCurryEquiv i j h + change ∀ᵐ x : Position, ∀ s : Fin q, ∀ᵐ z : Position, ∀ r : Fin q, + ∀ᵐ y : OtherPairConfiguration i j, ∀ t : OtherPairSpinLabels i j q, + pairInnerTargetEquiv i j c x s z r y t = + ψ (insertParticlePair i j x z y) (insertSpinPair i j s r t) + have ha := Measure.ae_ae_of_ae_prod (pairPullbackEquiv_apply_ae i j hij ψ) + have hh := Measure.ae_ae_of_ae_prod (pairSpinTargetEquiv_apply_ae i j hij a) + filter_upwards [pairInnerTargetEquiv_apply_ae i j c, + pairOuterCurryEquiv_apply_ae i j h, ha, hh] with x hinner hc hax hhx + intro s + rw [hinner] + have hc' := Measure.ae_ae_of_ae_prod hc + have hax' := Measure.ae_ae_of_ae_prod hax + have hhx' := Measure.ae_ae_of_ae_prod hhx + filter_upwards [innerPairCurryingEquiv_ae i j (c x) s, hc', hax', hhx'] + with z hz hcz haz hhz + intro r + filter_upwards [hz r, hcz, haz, hhz] with y hzy hczy hay hhy + intro t + rw [hzy t, hczy] + rw [hhy] + change a (x, (z, y)) (insertSpinPair i j s r t) = _ + rw [hay] + exact congrArg (fun u : SpinAmplitudes N q => u (insertSpinPair i j s r t)) + (congrArg ψ (pairInsertionMeasurableEquiv_apply i j hij (x, z, y))) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/PauliLiftEncoding.lean b/LeanPool/LiebThirring/Kinetic/PauliLiftEncoding.lean new file mode 100644 index 0000000000..65b7f49d9f --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/PauliLiftEncoding.lean @@ -0,0 +1,193 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.Insertion +public import LeanPool.LiebThirring.Kinetic.Encoding +public import LeanPool.LiebThirring.Kinetic.Permutation + +/-! # Two-particle coordinate encoding + +The coordinate splitting used to compare rank-one lifts in two distinct +particle coordinates. The order of the two displayed particles is retained; +simultaneous exchange therefore acts by swapping those two entries and fixes +the remaining configuration. +-/ + +@[expose] public section + +open MeasureTheory WithLp + +namespace LiebThirring + +/-- Partition the full spatial index into two selected particles and all +remaining coordinates. -/ +def pairInsertionIndexEquiv {N : ℕ} (i j : Fin N) (hij : i ≠ j) : + (Fin N × Fin 3) ≃ (Fin 3 ⊕ (Fin 3 ⊕ ({k : Fin N // k ≠ i ∧ k ≠ j} × Fin 3))) where + toFun ka := if hi : ka.1 = i then Sum.inl ka.2 else if hj : ka.1 = j then + Sum.inr (Sum.inl ka.2) else Sum.inr (Sum.inr (⟨ka.1, hi, hj⟩, ka.2)) + invFun := Sum.elim (fun a => (i, a)) + (Sum.elim (fun a => (j, a)) (fun ka => (ka.1.val, ka.2))) + left_inv ka := by + rcases ka with ⟨k, a⟩ + dsimp + by_cases hi : k = i + · simp [hi] + by_cases hj : k = j + · simp [hj, hij.symm] + · simp [hi, hj] + right_inv u := by + rcases u with a | u + · simp + · rcases u with a | ka + · simp [hij.symm] + · simp [ka.1.property.1, ka.1.property.2] + +/-- Spatial coordinates other than two specified distinct particles. -/ +abbrev OtherPairConfiguration {N : ℕ} (i j : Fin N) := + EuclideanSpace ℝ ({k : Fin N // k ≠ i ∧ k ≠ j} × Fin 3) + +/-- Spin labels other than two specified distinct particles. -/ +abbrev OtherPairSpinLabels {N : ℕ} (i j : Fin N) (q : ℕ) := + {k : Fin N // k ≠ i ∧ k ≠ j} → Fin q + +/-- Insert two distinct spatial particle coordinates. -/ +def insertParticlePair {N : ℕ} (i j : Fin N) (x z : Position) + (y : OtherPairConfiguration i j) : Configuration N := + toLp 2 (fun ka => if hi : ka.1 = i then x ka.2 else + if hj : ka.1 = j then z ka.2 else y (⟨ka.1, hi, hj⟩, ka.2)) + +/-- Insert two distinct spin coordinates. -/ +def insertSpinPair {N q : ℕ} (i j : Fin N) (s r : Fin q) + (t : OtherPairSpinLabels i j q) : SpinLabels N q := + fun k => if hi : k = i then s else if hj : k = j then r else t ⟨k, hi, hj⟩ + +/-- The measurable coordinate equivalence associated with ordered insertion +of two distinct particles. -/ +noncomputable def pairInsertionMeasurableEquiv {N : ℕ} (i j : Fin N) (hij : i ≠ j) : + (Position × (Position × OtherPairConfiguration i j)) ≃ᵐ Configuration N := + ((MeasurableEquiv.toLp 2 (Fin 3 → ℝ)).symm.prodCongr + ((MeasurableEquiv.toLp 2 (Fin 3 → ℝ)).symm.prodCongr + (MeasurableEquiv.toLp 2 + (({k : Fin N // k ≠ i ∧ k ≠ j} × Fin 3) → ℝ)).symm)).trans + (((MeasurableEquiv.refl (Fin 3 → ℝ)).prodCongr + (MeasurableEquiv.sumPiEquivProdPi (fun _ : Fin 3 ⊕ + ({k : Fin N // k ≠ i ∧ k ≠ j} × Fin 3) => ℝ)).symm).trans + ((MeasurableEquiv.sumPiEquivProdPi (fun _ : Fin 3 ⊕ (Fin 3 ⊕ + ({k : Fin N // k ≠ i ∧ k ≠ j} × Fin 3)) => ℝ)).symm.trans + ((MeasurableEquiv.piCongrLeft (fun _ : Fin N × Fin 3 => ℝ) + (pairInsertionIndexEquiv i j hij).symm).trans (MeasurableEquiv.toLp 2 _)))) + +theorem pairInsertionMeasurableEquiv_apply {N : ℕ} (i j : Fin N) (hij : i ≠ j) + (z : Position × (Position × OtherPairConfiguration i j)) : + pairInsertionMeasurableEquiv i j hij z = insertParticlePair i j z.1 z.2.1 z.2.2 := by + ext ka + rcases ka with ⟨k, a⟩ + by_cases hi : k = i + · simp [pairInsertionMeasurableEquiv, MeasurableEquiv.coe_piCongrLeft, + Equiv.piCongrLeft_apply, MeasurableEquiv.coe_sumPiEquivProdPi_symm, + Equiv.sumPiEquivProdPi, MeasurableEquiv.toLp_symm_apply, MeasurableEquiv.prodCongr, + pairInsertionIndexEquiv, insertParticlePair, hi] + by_cases hj : k = j + · simp [pairInsertionMeasurableEquiv, MeasurableEquiv.coe_piCongrLeft, + Equiv.piCongrLeft_apply, MeasurableEquiv.coe_sumPiEquivProdPi_symm, + Equiv.sumPiEquivProdPi, MeasurableEquiv.toLp_symm_apply, MeasurableEquiv.prodCongr, + pairInsertionIndexEquiv, insertParticlePair, hj, hij.symm] + · simp [pairInsertionMeasurableEquiv, MeasurableEquiv.coe_piCongrLeft, + Equiv.piCongrLeft_apply, MeasurableEquiv.coe_sumPiEquivProdPi_symm, + Equiv.sumPiEquivProdPi, MeasurableEquiv.toLp_symm_apply, MeasurableEquiv.prodCongr, + pairInsertionIndexEquiv, insertParticlePair, hi, hj] + +/-- Ordered insertion of two distinct particles preserves product volume. -/ +theorem measurePreserving_pairInsertion {N : ℕ} (i j : Fin N) (hij : i ≠ j) : + MeasurePreserving (pairInsertionMeasurableEquiv i j hij) volume volume := by + exact ((PiLp.volume_preserving_ofLp (Fin 3)).prod + ((PiLp.volume_preserving_ofLp (Fin 3)).prod + (PiLp.volume_preserving_ofLp ({k : Fin N // k ≠ i ∧ k ≠ j} × Fin 3)))).trans + (((MeasurePreserving.id (volume : Measure (Fin 3 → ℝ))).prod + (volume_measurePreserving_sumPiEquivProdPi_symm (fun _ : Fin 3 ⊕ + ({k : Fin N // k ≠ i ∧ k ≠ j} × Fin 3) => ℝ))).trans + ((volume_measurePreserving_sumPiEquivProdPi_symm (fun _ : Fin 3 ⊕ (Fin 3 ⊕ + ({k : Fin N // k ≠ i ∧ k ≠ j} × Fin 3)) => ℝ)).trans + ((volume_measurePreserving_piCongrLeft _ (pairInsertionIndexEquiv i j hij).symm).trans + (PiLp.volume_preserving_toLp (Fin N × Fin 3))))) + +/-- Split a spin assignment into two selected labels and the remaining labels. -/ +def spinPairInsertionEquiv {N q : ℕ} (i j : Fin N) (hij : i ≠ j) : + (Fin q × (Fin q × OtherPairSpinLabels i j q)) ≃ SpinLabels N q where + toFun z := insertSpinPair i j z.1 z.2.1 z.2.2 + invFun t := (t i, t j, fun k => t k.val) + left_inv z := by + rcases z with ⟨s, r, t⟩ + apply Prod.ext + · simp [insertSpinPair] + · apply Prod.ext + · simp [insertSpinPair, hij.symm] + · funext k + simp [insertSpinPair, k.property.1, k.property.2] + right_inv t := by + funext k + by_cases hki : k = i + · subst k + simp [insertSpinPair] + by_cases hkj : k = j + · subst k + simp [insertSpinPair, hij.symm] + · simp [insertSpinPair, hki, hkj] + +/-- Regroup finite spin amplitudes into two selected spin factors. -/ +noncomputable def spinPairCurryingLinearIsometryEquiv {N q : ℕ} + (i j : Fin N) (hij : i ≠ j) : + SpinAmplitudes N q ≃ₗᵢ[ℂ] PiLp 2 (fun _ : Fin q => + PiLp 2 (fun _ : Fin q => EuclideanSpace ℂ (OtherPairSpinLabels i j q))) := + (LinearIsometryEquiv.piLpCongrLeft 2 ℂ ℂ (spinPairInsertionEquiv i j hij).symm).trans + ((LinearIsometryEquiv.piLpCongrLeft 2 ℂ ℂ + (Equiv.sigmaEquivProd (Fin q) + (Fin q × OtherPairSpinLabels i j q)).symm).trans + ((LinearIsometryEquiv.piLpCurry ℂ 2 + (fun (_ : Fin q) (_ : Fin q × OtherPairSpinLabels i j q) => ℂ)).trans + (LinearIsometryEquiv.piLpCongrRight 2 (𝕜 := ℂ) + (fun _ : Fin q => (LinearIsometryEquiv.piLpCongrLeft 2 ℂ ℂ + (Equiv.sigmaEquivProd (Fin q) (OtherPairSpinLabels i j q)).symm).trans + (LinearIsometryEquiv.piLpCurry ℂ 2 + (fun (_ : Fin q) (_ : OtherPairSpinLabels i j q) => ℂ)))))) + +/-- Swapping the two displayed spatial entries is simultaneous particle exchange. -/ +theorem permutePositions_swap_insertParticlePair {N : ℕ} (i j : Fin N) (hij : i ≠ j) + (x z : Position) (y : OtherPairConfiguration i j) : + permutePositions (Equiv.swap i j) (insertParticlePair i j x z y) = + insertParticlePair i j z x y := by + ext ka + rcases ka with ⟨k, a⟩ + simp only [permutePositions, insertParticlePair] + by_cases hki : k = i + · subst k + simp [hij.symm] + by_cases hkj : k = j + · subst k + simp [hki] + simp [Equiv.swap_apply_of_ne_of_ne hki hkj, hki, hkj] + +/-- Swapping the two displayed spin entries is simultaneous particle exchange. -/ +theorem permuteSpins_swap_insertSpinPair {N q : ℕ} (i j : Fin N) (hij : i ≠ j) + (s r : Fin q) (t : OtherPairSpinLabels i j q) : + permuteSpins (Equiv.swap i j) (insertSpinPair i j s r t) = + insertSpinPair i j r s t := by + funext k + by_cases hki : k = i + · subst k + simp [permuteSpins, insertSpinPair, hij.symm] + by_cases hkj : k = j + · subst k + simp [permuteSpins, insertSpinPair, hki] + simp [permuteSpins, insertSpinPair, Equiv.swap_apply_of_ne_of_ne hki hkj, hki, hkj] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/PauliLiftIntertwining.lean b/LeanPool/LiebThirring/Kinetic/PauliLiftIntertwining.lean new file mode 100644 index 0000000000..43e56b4085 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/PauliLiftIntertwining.lean @@ -0,0 +1,256 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.ContractionRestCurrying +public import LeanPool.LiebThirring.Kinetic.ContractionState +public import LeanPool.LiebThirring.Kinetic.ContractionFactors + +/-! # Intertwining concrete coordinate insertion with pair factors + +Pair currying sends insertion in the first or second selected particle to the +corresponding abstract tensor-factor insertion. +-/ + +public section + +open MeasureTheory WithLp + +namespace LiebThirring + +private theorem eventually_forall_finite {α β : Type*} [Finite α] + {l : Filter β} {p : α → β → Prop} (h : ∀ a, ∀ᶠ b in l, p a b) : + ∀ᶠ b in l, ∀ a, p a b := by + classical + let := Fintype.ofFinite α + have hu : ∀ᶠ b in l, ∀ a ∈ Finset.univ, p a b := + (Finset.eventually_all Finset.univ).2 fun a _ => h a + simpa using hu + +/-- Reassociate ordered pair coordinates so that insertion in coordinate `j` +is expressed in its native one-particle splitting. -/ +noncomputable def pairToRightRestMeasurableEquiv {N : ℕ} + (i j : Fin N) (hij : i ≠ j) : + (Position × (Position × OtherPairConfiguration i j)) ≃ᵐ + (Position × OtherConfiguration j) := + MeasurableEquiv.prodAssoc.symm |>.trans + ((MeasurableEquiv.prodComm (α := Position) (β := Position)).prodCongr + (MeasurableEquiv.refl (OtherPairConfiguration i j))) |>.trans + MeasurableEquiv.prodAssoc |>.trans + ((MeasurableEquiv.refl Position).prodCongr + (restRightInsertionMeasurableEquiv i j hij)) + +theorem pairToRightRestMeasurableEquiv_apply {N : ℕ} + (i j : Fin N) (hij : i ≠ j) + (w : Position × (Position × OtherPairConfiguration i j)) : + pairToRightRestMeasurableEquiv i j hij w = + (w.2.1, insertOtherParticleRight i j w.1 w.2.2) := by + change (w.2.1, restRightInsertionMeasurableEquiv i j hij (w.1, w.2.2)) = _ + rw [restRightInsertionMeasurableEquiv_apply] + +theorem measurePreserving_pairToRightRest {N : ℕ} + (i j : Fin N) (hij : i ≠ j) : + MeasurePreserving (pairToRightRestMeasurableEquiv i j hij) volume volume := by + have h1 : MeasurePreserving + (MeasurableEquiv.prodAssoc.symm : + Position × (Position × OtherPairConfiguration i j) → + (Position × Position) × OtherPairConfiguration i j) volume volume := + volume_preserving_prodAssoc.symm + have h2 : MeasurePreserving + ((MeasurableEquiv.prodComm (α := Position) (β := Position)).prodCongr + (MeasurableEquiv.refl (OtherPairConfiguration i j))) volume volume := + Measure.measurePreserving_swap.prod (MeasurePreserving.id volume) + have h3 : MeasurePreserving + (MeasurableEquiv.prodAssoc : + (Position × Position) × OtherPairConfiguration i j → + Position × (Position × OtherPairConfiguration i j)) volume volume := + volume_preserving_prodAssoc + have h4 : MeasurePreserving + ((MeasurableEquiv.refl Position).prodCongr + (restRightInsertionMeasurableEquiv i j hij)) volume volume := + (MeasurePreserving.id volume).prod (measurePreserving_restRightInsertion i j hij) + exact ((h1.trans h2).trans h3).trans h4 + +/-- Pair currying transports concrete insertion in coordinate `i` to insertion +in the first abstract tensor factor. -/ +theorem pairCurrying_oneParticleInsertion_left {N q : ℕ} (i j : Fin N) + (hij : i ≠ j) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) + (v : RestState i q) : + pairCurryingLinearIsometryEquiv i j hij (oneParticleInsertion i f v) = + firstFactorInsertion (H := PairRestState i j q) f + (restCurryingLeftLinearIsometryEquiv i j hij v) := by + apply Lp.ext + filter_upwards [pairCurryingLinearIsometryEquiv_apply_ae i j hij + (oneParticleInsertion i f v), + tensorInsertion_apply_ae (H := RestFactorState i j q) f + (restCurryingLeftLinearIsometryEquiv i j hij v), + oneParticleInsertion_ae i f v] with x hp ht hi + apply PiLp.ext + intro s + apply Lp.ext + have hi' := Measure.ae_ae_of_ae_prod + ((measurePreserving_restLeftInsertion i j hij).quasiMeasurePreserving.ae (hi s)) + have hs := Lp.coeFn_smul (f x s) (restCurryingLeftLinearIsometryEquiv i j hij v) + filter_upwards [hp s, hi', restCurryingLeftLinearIsometryEquiv_apply_ae i j hij v, hs] + with z hpz hiz hrz hsz + apply PiLp.ext + intro r + apply Lp.ext + have hs' := Lp.coeFn_smul (f x s) + (restCurryingLeftLinearIsometryEquiv i j hij v z r) + filter_upwards [hpz r, hiz, hrz r, hs'] with y hpy hiy hry hsy + ext t + change pairCurryingLinearIsometryEquiv i j hij (oneParticleInsertion i f v) x s z r y t = + firstFactorInsertion (H := PairRestState i j q) f + (restCurryingLeftLinearIsometryEquiv i j hij v) x s z r y t + rw [hpy t] + rw [show firstFactorInsertion (H := PairRestState i j q) f + (restCurryingLeftLinearIsometryEquiv i j hij v) x s z r y t = + (f x s • restCurryingLeftLinearIsometryEquiv i j hij v) z r y t by + rw [firstFactorInsertion, ht s]] + rw [hsz] + simp only [Pi.smul_apply, PiLp.smul_apply] + rw [hsy] + change oneParticleInsertion i f v (insertParticlePair i j x z y) + (insertSpinPair i j s r t) = + f x s * restCurryingLeftLinearIsometryEquiv i j hij v z r y t + rw [hry t] + have hiPair := hiy (insertOtherSpinLeft i j r t) + rw [restLeftInsertionMeasurableEquiv_apply, + insertParticle_insertOtherParticleLeft, insertSpin_insertOtherSpinLeft] at hiPair + exact hiPair + +/-- Pair currying transports concrete insertion in coordinate `j` to insertion +in the second abstract tensor factor. -/ +theorem pairCurrying_oneParticleInsertion_right {N q : ℕ} (i j : Fin N) + (hij : i ≠ j) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) + (v : RestState j q) : + pairCurryingLinearIsometryEquiv i j hij (oneParticleInsertion j f v) = + secondFactorInsertion (H := PairRestState i j q) f + (restCurryingRightLinearIsometryEquiv i j hij v) := by + have hi := oneParticleInsertion_ae j f v + have hpull (r s : Fin q) (t : OtherPairSpinLabels i j q) : + ∀ᵐ x : Position, ∀ᵐ z : Position, ∀ᵐ y : OtherPairConfiguration i j, + oneParticleInsertion j f v (insertParticlePair i j x z y) + (insertSpinPair i j s r t) = + f z r * v (insertOtherParticleRight i j x y) + (insertOtherSpinRight i j s t) := by + have hnested : ∀ᵐ z : Position, ∀ᵐ y : OtherConfiguration j, + oneParticleInsertion j f v (insertParticle j z y) + (insertSpin j r (insertOtherSpinRight i j s t)) = + f z r * v y (insertOtherSpinRight i j s t) := by + filter_upwards [hi] with z hz + exact (hz r).mono fun y hy => hy (insertOtherSpinRight i j s t) + have hmeas : MeasurableSet {w : Position × OtherConfiguration j | + oneParticleInsertion j f v (insertParticle j w.1 w.2) + (insertSpin j r (insertOtherSpinRight i j s t)) = + f w.1 r * v w.2 (insertOtherSpinRight i j s t)} := by + let pState := PiLp.proj (𝕜 := ℂ) 2 + (fun _ : SpinLabels N q => ℂ) (insertSpin j r (insertOtherSpinRight i j s t)) + let pF := PiLp.proj (𝕜 := ℂ) 2 (fun _ : Fin q => ℂ) r + let pV := PiLp.proj (𝕜 := ℂ) 2 + (fun _ : OtherSpinLabels j q => ℂ) (insertOtherSpinRight i j s t) + have hleft : StronglyMeasurable (fun w : Position × OtherConfiguration j => + oneParticleInsertion j f v (insertParticle j w.1 w.2) + (insertSpin j r (insertOtherSpinRight i j s t))) := + pState.continuous.comp_stronglyMeasurable + ((Lp.stronglyMeasurable (oneParticleInsertion j f v)).comp_measurable + (measurePreserving_insertParticle j).measurable) + have hright : StronglyMeasurable (fun w : Position × OtherConfiguration j => + f w.1 r * v w.2 (insertOtherSpinRight i j s t)) := + ((pF.continuous.comp_stronglyMeasurable (Lp.stronglyMeasurable f)).comp_measurable + measurable_fst).mul + ((pV.continuous.comp_stronglyMeasurable (Lp.stronglyMeasurable v)).comp_measurable + measurable_snd) + exact hleft.measurableSet_eq_fun hright + have hprod := (Measure.ae_prod_iff_ae_ae hmeas).2 hnested + have hback := (measurePreserving_pairToRightRest i j hij).quasiMeasurePreserving.ae hprod + have houter := Measure.ae_ae_of_ae_prod hback + filter_upwards [houter] with x hx + have hx' := Measure.ae_ae_of_ae_prod hx + filter_upwards [hx'] with z hz + filter_upwards [hz] with y hy + rw [pairToRightRestMeasurableEquiv_apply] at hy + simpa only [insertParticle_insertOtherParticleRight i j hij, + insertSpin_insertOtherSpinRight i j hij] using hy + have hpullRS (r s : Fin q) : ∀ᵐ x : Position, ∀ᵐ z : Position, + ∀ᵐ y : OtherPairConfiguration i j, ∀ t : OtherPairSpinLabels i j q, + oneParticleInsertion j f v (insertParticlePair i j x z y) + (insertSpinPair i j s r t) = + f z r * v (insertOtherParticleRight i j x y) + (insertOtherSpinRight i j s t) := by + have h₁ := eventually_forall_finite (fun t => hpull r s t) + filter_upwards [h₁] with x hx + have h₂ := eventually_forall_finite hx + filter_upwards [h₂] with z hz + exact eventually_forall_finite hz + have hpullAll : ∀ᵐ x : Position, ∀ s : Fin q, ∀ᵐ z : Position, + ∀ᵐ y : OtherPairConfiguration i j, ∀ r : Fin q, + ∀ t : OtherPairSpinLabels i j q, + oneParticleInsertion j f v (insertParticlePair i j x z y) + (insertSpinPair i j s r t) = + f z r * v (insertOtherParticleRight i j x y) + (insertOtherSpinRight i j s t) := by + have hrs (s : Fin q) : ∀ᵐ x : Position, ∀ᵐ z : Position, + ∀ᵐ y : OtherPairConfiguration i j, ∀ r : Fin q, + ∀ t : OtherPairSpinLabels i j q, + oneParticleInsertion j f v (insertParticlePair i j x z y) + (insertSpinPair i j s r t) = + f z r * v (insertOtherParticleRight i j x y) + (insertOtherSpinRight i j s t) := by + have h₁ := eventually_forall_finite (fun r => hpullRS r s) + filter_upwards [h₁] with x hx + have h₂ := eventually_forall_finite hx + filter_upwards [h₂] with z hz + exact eventually_forall_finite hz + have h := eventually_forall_finite hrs + filter_upwards [h] with x hx + exact hx + apply Lp.ext + filter_upwards [pairCurryingLinearIsometryEquiv_apply_ae i j hij + (oneParticleInsertion j f v), + tensorTargetLift_apply_ae (ι := Fin q) + (tensorInsertion (H := PairRestState i j q) f) + (restCurryingRightLinearIsometryEquiv i j hij v), + restCurryingRightLinearIsometryEquiv_apply_ae i j hij v, + hpullAll] with x hp hl hrx hix + apply PiLp.ext + intro s + apply Lp.ext + filter_upwards [hp s, + tensorInsertion_apply_ae (H := PairRestState i j q) f + (restCurryingRightLinearIsometryEquiv i j hij v x s), hix s] with z hpz ht hiz + apply PiLp.ext + intro r + apply Lp.ext + have hs := Lp.coeFn_smul (f z r) (restCurryingRightLinearIsometryEquiv i j hij v x s) + filter_upwards [hpz r, hrx s, hs, hiz] with y hpy hry hsy hiy + ext t + change pairCurryingLinearIsometryEquiv i j hij (oneParticleInsertion j f v) x s z r y t = + secondFactorInsertion (H := PairRestState i j q) f + (restCurryingRightLinearIsometryEquiv i j hij v) x s z r y t + rw [hpy t] + rw [show secondFactorInsertion (H := PairRestState i j q) f + (restCurryingRightLinearIsometryEquiv i j hij v) x s = + tensorInsertion (H := PairRestState i j q) f + (restCurryingRightLinearIsometryEquiv i j hij v x s) by + rw [secondFactorInsertion, hl s]] + rw [ht r] + rw [hsy] + simp only [Pi.smul_apply, PiLp.smul_apply] + change oneParticleInsertion j f v (insertParticlePair i j x z y) + (insertSpinPair i j s r t) = + f z r * restCurryingRightLinearIsometryEquiv i j hij v x s y t + rw [hry t, hiy r t] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/PauliLiftProjections.lean b/LeanPool/LiebThirring/Kinetic/PauliLiftProjections.lean new file mode 100644 index 0000000000..9c35da2f69 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/PauliLiftProjections.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.PauliLiftIntertwining +public import LeanPool.LiebThirring.Kinetic.PauliDoubleInsertion +public import LeanPool.LiebThirring.Kinetic.ContractionProjectionTransport + +/-! # Identifying the actual coordinate projections with factor projections + +The remaining-state unitaries intertwine insertion on `State` with insertion +on the two-factor carrier. Taking adjoints identifies the projections, and +their product is the operator generated by actual double insertion. +-/ + +public section + +open MeasureTheory + +namespace LiebThirring + +/-- Pair currying identifies the first actual coordinate projection with the +first generic factor projection. -/ +theorem pairCurrying_oneParticleProjection_left {N q : ℕ} (i j : Fin N) + (hij : i ≠ j) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) + (ψ : State N q) : + pairCurryingLinearIsometryEquiv (q := q) i j hij (oneParticleProjection i f ψ) = + firstFactorProjection (H := PairRestState i j q) f + (pairCurryingLinearIsometryEquiv (q := q) i j hij ψ) := by + have h : (pairCurryingLinearIsometryEquiv (q := q) i j hij : + State N q →L[ℂ] PairCurriedState i j q).comp (oneParticleInsertion i f) = + (firstFactorInsertion (H := PairRestState i j q) f).comp + (restCurryingLeftLinearIsometryEquiv (q := q) i j hij : + RestState i q →L[ℂ] RestFactorState i j q) := by + apply ContinuousLinearMap.ext + intro v + exact pairCurrying_oneParticleInsertion_left i j hij f v + have ht := projection_transport_apply (pairCurryingLinearIsometryEquiv (q := q) i j hij) + (restCurryingLeftLinearIsometryEquiv (q := q) i j hij) (oneParticleInsertion i f) + (firstFactorInsertion (H := PairRestState i j q) f) h ψ + rw [oneParticleInsertion_adjoint] at ht + exact ht + +/-- Pair currying identifies the second actual coordinate projection with the +second generic factor projection. -/ +theorem pairCurrying_oneParticleProjection_right {N q : ℕ} (i j : Fin N) + (hij : i ≠ j) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) + (ψ : State N q) : + pairCurryingLinearIsometryEquiv (q := q) i j hij (oneParticleProjection j f ψ) = + secondFactorProjection (H := PairRestState i j q) f + (pairCurryingLinearIsometryEquiv (q := q) i j hij ψ) := by + have h : (pairCurryingLinearIsometryEquiv (q := q) i j hij : + State N q →L[ℂ] PairCurriedState i j q).comp (oneParticleInsertion j f) = + (secondFactorInsertion (H := PairRestState i j q) f).comp + (restCurryingRightLinearIsometryEquiv (q := q) i j hij : + RestState j q →L[ℂ] RestFactorState i j q) := by + apply ContinuousLinearMap.ext + intro v + exact pairCurrying_oneParticleInsertion_right i j hij f v + have ht := projection_transport_apply (pairCurryingLinearIsometryEquiv (q := q) i j hij) + (restCurryingRightLinearIsometryEquiv (q := q) i j hij) (oneParticleInsertion j f) + (secondFactorInsertion (H := PairRestState i j q) f) h ψ + rw [oneParticleInsertion_adjoint] at ht + exact ht + +/-- Pair currying also transports the operator generated by double insertion. -/ +theorem pairCurrying_doubleParticleInsertion_projection {N q : ℕ} (i j : Fin N) + (hij : i ≠ j) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) + (ψ : State N q) : + pairCurryingLinearIsometryEquiv (q := q) i j hij + (((doubleParticleInsertion i j hij f).comp + (doubleParticleInsertion i j hij f).adjoint) ψ) = + ((doubleFactorInsertion (H := PairRestState i j q) f).comp + (doubleFactorInsertion (H := PairRestState i j q) f).adjoint) + (pairCurryingLinearIsometryEquiv (q := q) i j hij ψ) := by + exact projection_pullback_apply (pairCurryingLinearIsometryEquiv (q := q) i j hij) + (doubleFactorInsertion (H := PairRestState i j q) f) ψ + +/-- The product of two distinct coordinate projections is generated by actual +double insertion. No unit-vector hypothesis is needed for this identity. -/ +theorem oneParticleProjection_comp_oneParticleProjection {N q : ℕ} (i j : Fin N) + (hij : i ≠ j) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) : + (oneParticleProjection i f).comp (oneParticleProjection j f) = + (doubleParticleInsertion i j hij f).comp + (doubleParticleInsertion i j hij f).adjoint := by + apply ContinuousLinearMap.ext + intro ψ + apply (pairCurryingLinearIsometryEquiv (q := q) i j hij).injective + change pairCurryingLinearIsometryEquiv (q := q) i j hij + (oneParticleProjection i f (oneParticleProjection j f ψ)) = _ + rw [pairCurrying_oneParticleProjection_left, pairCurrying_oneParticleProjection_right, + pairCurrying_doubleParticleInsertion_projection] + exact congrArg (fun T : PairCurriedState i j q →L[ℂ] PairCurriedState i j q => + T (pairCurryingLinearIsometryEquiv (q := q) i j hij ψ)) + (firstFactorProjection_secondFactorProjection (H := PairRestState i j q) f) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/PauliOccupation.lean b/LeanPool/LiebThirring/Kinetic/PauliOccupation.lean new file mode 100644 index 0000000000..4820d8c0fa --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/PauliOccupation.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.PauliLiftProjections +public import LeanPool.LiebThirring.Kinetic.PauliStateConditional + +/-! +# The Pauli occupation bound + +The double coordinate projection is unchanged by exchanging its input coordinates. This holds on +every state and for every one-particle vector. + +Pauli occupation: the occupation of any spatial-and-spin one-particle vector is at most one in +an antisymmetric state, with the state norm kept explicit. +-/ + +public section + +open MeasureTheory + +namespace LiebThirring + +/-- The double coordinate projection is unchanged by exchanging its input +coordinates. This holds on every state and for every one-particle vector. -/ +theorem oneParticleProjection_double_exchange {N q : ℕ} (i j : Fin N) + (hij : i ≠ j) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) + (φ : State N q) : + oneParticleProjection i f (oneParticleProjection j f + (simultaneousPermutation (Equiv.swap i j) φ)) = + oneParticleProjection i f (oneParticleProjection j f φ) := by + let D := doubleParticleInsertion i j hij f + let U := statePermutationLinearIsometryEquiv (q := q) (Equiv.swap i j) + have hU : U.toContinuousLinearEquiv.toContinuousLinearMap.comp D = D := by + apply ContinuousLinearMap.ext + intro v + exact simultaneousPermutation_doubleParticleInsertion i j hij f v + have h := operator_projection_comp_eq_of_comp_eq D U hU + rw [← oneParticleProjection_comp_oneParticleProjection i j hij f] at h + exact congrArg (fun T : State N q →L[ℂ] State N q => T φ) h + +/-- Pauli occupation: the occupation of any spatial-and-spin one-particle vector is at most +one in an antisymmetric state, with the state norm kept explicit. -/ +theorem oneParticleContraction_pauli {N q : ℕ} (i : Fin N) + (ψ : State N q) (hψ : antisymmetric ψ) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) : + (N : ℝ) * ‖oneParticleContraction i f ψ‖ ^ 2 ≤ ‖f‖ ^ 2 * ‖ψ‖ ^ 2 := by + exact oneParticleContraction_pauli_of_double_exchange i ψ hψ + (fun g _ k l hkl φ => oneParticleProjection_double_exchange k l hkl g φ) f + +/-- The normalized Pauli occupation estimate consumed by the low-momentum bound. -/ +theorem oneParticleContraction_pauli_of_norm_eq_one {N q : ℕ} (i : Fin N) + (ψ : State N q) (hψ : antisymmetric ψ) (hnorm : ‖ψ‖ = 1) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) : + (N : ℝ) * ‖oneParticleContraction i f ψ‖ ^ 2 ≤ ‖f‖ ^ 2 := by + simpa only [hnorm, one_pow, mul_one] using oneParticleContraction_pauli i ψ hψ f + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/PauliScaling.lean b/LeanPool/LiebThirring/Kinetic/PauliScaling.lean new file mode 100644 index 0000000000..e7ad27ed1d --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/PauliScaling.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.ContractionState + +/-! +# Extending a unit-vector occupation bound by scaling + +A unit-vector Pauli bound extends to every one-particle vector, including zero. This is a +conditional scaling helper, not the unconditional Pauli occupation result. +-/ + +public section + +open MeasureTheory + +namespace LiebThirring + +/-- A unit-vector Pauli bound extends to every one-particle vector, including +zero. This is a conditional scaling helper, not the unconditional Pauli occupation result. -/ +theorem oneParticleContraction_pauli_of_unit_bound {N q : ℕ} (i : Fin N) + (ψ : State N q) + (hunit : ∀ g : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position), + ‖g‖ = 1 → (N : ℝ) * ‖oneParticleContraction i g ψ‖ ^ 2 ≤ ‖ψ‖ ^ 2) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) : + (N : ℝ) * ‖oneParticleContraction i f ψ‖ ^ 2 ≤ ‖f‖ ^ 2 * ‖ψ‖ ^ 2 := by + by_cases hf : f = 0 + · subst f + rw [oneParticleContraction_zero, norm_zero] + simp + have hn : ‖f‖ ≠ 0 := norm_ne_zero_iff.mpr hf + let g := ((‖f‖⁻¹ : ℝ) : ℂ) • f + have hg : ‖g‖ = 1 := by + dsimp only [g] + rw [norm_smul, Complex.norm_real, Real.norm_eq_abs, + abs_of_nonneg (inv_nonneg.mpr (norm_nonneg f)), inv_mul_cancel₀ hn] + have hfg : ((‖f‖ : ℝ) : ℂ) • g = f := by + dsimp only [g] + rw [smul_smul, ← Complex.ofReal_mul, mul_inv_cancel₀ hn, Complex.ofReal_one, one_smul] + have hnorm : ‖oneParticleContraction i f ψ‖ = + ‖f‖ * ‖oneParticleContraction i g ψ‖ := by + conv_lhs => rw [← hfg, oneParticleContraction_smul] + rw [smul_apply, norm_smul, norm_star, Complex.norm_real, + Real.norm_eq_abs, abs_norm] + have h := mul_le_mul_of_nonneg_left (hunit g hg) (sq_nonneg ‖f‖) + rw [hnorm, mul_pow] + calc + _ = ‖f‖ ^ 2 * ((N : ℝ) * ‖oneParticleContraction i g ψ‖ ^ 2) := by ring + _ ≤ _ := h + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/PauliStateConditional.lean b/LeanPool/LiebThirring/Kinetic/PauliStateConditional.lean new file mode 100644 index 0000000000..5f3be2a046 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/PauliStateConditional.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.ContractionExchange +public import LeanPool.LiebThirring.Kinetic.PauliScaling +public import LeanPool.LiebThirring.Kinetic.PauliAbstract + +/-! +# Conditional specialization of the projection argument to `State` + +For unit one-particle vectors, the Pauli estimate follows from the two concrete lift relations +supplied as explicit hypotheses. + +The complete occupation estimate conditional on the global contraction double-exchange identity. +Covariance, norm equality, and nonunit scaling are discharged by proved lemmas on the actual +`State` carrier. +-/ + +public section + +open MeasureTheory + +namespace LiebThirring + +/-- For unit one-particle vectors, the Pauli estimate follows from the two +concrete lift relations supplied as explicit hypotheses. -/ +theorem oneParticleContraction_pauli_unit_of_lift_relations {N q : ℕ} + (i : Fin N) (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) + (hf : ‖f‖ = 1) (ψ : State N q) (hψ : antisymmetric ψ) + (hdouble : ∀ k l : Fin N, k ≠ l → ∀ φ : State N q, + oneParticleProjection k f (oneParticleProjection l f + (simultaneousPermutation (Equiv.swap k l) φ)) = + oneParticleProjection k f (oneParticleProjection l f φ)) + (hequal : ∀ j : Fin N, ‖oneParticleProjection j f ψ‖ = + ‖oneParticleProjection i f ψ‖) : + (N : ℝ) * ‖oneParticleContraction i f ψ‖ ^ 2 ≤ ‖ψ‖ ^ 2 := by + have hzero (k l : Fin N) (hkl : k ≠ l) : + oneParticleProjection k f (oneParticleProjection l f ψ) = 0 := by + have h := hdouble k l hkl ψ + rw [simultaneousPermutation_swap_eq_neg ψ hψ k l hkl, map_neg, map_neg] at h + have htwo : (2 : ℂ) • oneParticleProjection k f (oneParticleProjection l f ψ) = 0 := by + rw [two_smul] + calc + _ = -oneParticleProjection k f (oneParticleProjection l f ψ) + + oneParticleProjection k f (oneParticleProjection l f ψ) := + congrArg (fun v : State N q => v + + oneParticleProjection k f (oneParticleProjection l f ψ)) h.symm + _ = 0 := neg_add_cancel _ + exact (smul_eq_zero.mp htwo).resolve_left (by norm_num) + have h := card_mul_norm_sq_le_of_projection_relations + (fun j : Fin N => oneParticleProjection j f) ψ + (fun j x y => oneParticleProjection_inner j f x y) + (fun j => oneParticleProjection_idempotent j f hf ψ) hzero i hequal + simpa only [Fintype.card_fin, oneParticleProjection_norm i f hf ψ] using h + +/-- The complete occupation estimate conditional on the global +contraction double-exchange identity. Covariance, norm equality, and nonunit scaling +are discharged by proved lemmas on the actual `State` carrier. -/ +theorem oneParticleContraction_pauli_of_double_exchange {N q : ℕ} + (i : Fin N) (ψ : State N q) (hψ : antisymmetric ψ) + (hdouble : ∀ g : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position), + ‖g‖ = 1 → ∀ k l : Fin N, k ≠ l → ∀ φ : State N q, + oneParticleProjection k g (oneParticleProjection l g + (simultaneousPermutation (Equiv.swap k l) φ)) = + oneParticleProjection k g (oneParticleProjection l g φ)) + (f : Lp (EuclideanSpace ℂ (Fin q)) 2 (volume : Measure Position)) : + (N : ℝ) * ‖oneParticleContraction i f ψ‖ ^ 2 ≤ ‖f‖ ^ 2 * ‖ψ‖ ^ 2 := by + apply oneParticleContraction_pauli_of_unit_bound i ψ _ f + intro g hg + exact oneParticleContraction_pauli_unit_of_lift_relations i g hg ψ hψ (hdouble g hg) + (fun j => oneParticleProjection_norm_eq i j g hg ψ hψ) + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/Permutation.lean b/LeanPool/LiebThirring/Kinetic/Permutation.lean new file mode 100644 index 0000000000..a1606850eb --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/Permutation.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. +public import LeanPool.LiebThirring.Defs.Antisymmetric +/-! +# Particle permutations + +Spatial coordinate permutation as a linear isometry. + +The finite spin labels are permuted bijectively. +-/ +public section +open MeasureTheory WithLp +open scoped ENNReal NNReal +namespace LiebThirring + +/-- Spatial coordinate permutation as a linear isometry. -/ +@[expose] noncomputable def permutationLinearIsometryEquiv {N : ℕ} + (σ : Equiv.Perm (Fin N)) : Configuration N ≃ₗᵢ[ℝ] Configuration N := + LinearIsometryEquiv.piLpCongrLeft 2 ℝ ℝ (σ.symm.prodCongr (Equiv.refl (Fin 3))) + +theorem permutationLinearIsometryEquiv_apply {N : ℕ} (σ : Equiv.Perm (Fin N)) + (x : Configuration N) : permutationLinearIsometryEquiv σ x = permutePositions σ x := by + rfl + +theorem measurePreserving_permutePositions {N : ℕ} (σ : Equiv.Perm (Fin N)) : + MeasurePreserving (permutePositions σ) volume volume := by + have h : (permutationLinearIsometryEquiv σ : Configuration N → Configuration N) = + permutePositions σ := funext (permutationLinearIsometryEquiv_apply σ) + rw [← h] + exact (permutationLinearIsometryEquiv σ).measurePreserving + +theorem measurableEmbedding_permutePositions {N : ℕ} (σ : Equiv.Perm (Fin N)) : + MeasurableEmbedding (permutePositions σ) := by + have h : (permutationLinearIsometryEquiv σ : Configuration N → Configuration N) = + permutePositions σ := funext (permutationLinearIsometryEquiv_apply σ) + rw [← h] + exact (permutationLinearIsometryEquiv σ).toHomeomorph.measurableEmbedding + +@[simp] theorem particlePosition_permutePositions {N : ℕ} (σ : Equiv.Perm (Fin N)) + (x : Configuration N) (i : Fin N) : + particlePosition (permutePositions σ x) i = particlePosition x (σ i) := rfl + +/-- The finite spin labels are permuted bijectively. -/ +@[expose] def spinPermutationEquiv {N q : ℕ} (σ : Equiv.Perm (Fin N)) : + SpinLabels N q ≃ SpinLabels N q where + toFun := permuteSpins σ + invFun := permuteSpins σ.symm + left_inv s := by funext i; simp [permuteSpins] + right_inv s := by funext i; simp [permuteSpins] + +/-- Spin-coordinate reindexing is a complex linear isometry. -/ +@[expose] noncomputable def spinPermutationLinearIsometryEquiv {N q : ℕ} + (σ : Equiv.Perm (Fin N)) : SpinAmplitudes N q ≃ₗᵢ[ℂ] SpinAmplitudes N q := + LinearIsometryEquiv.piLpCongrLeft 2 ℂ ℂ (spinPermutationEquiv (q := q) σ).symm + +theorem norm_permutePositions_ae {N q : ℕ} (ψ : State N q) (hψ : antisymmetric ψ) + (σ : Equiv.Perm (Fin N)) : + ∀ᵐ x ∂(volume : Measure (Configuration N)), ‖ψ (permutePositions σ x)‖ = ‖ψ x‖ := by + filter_upwards [hψ σ] with x hx + have heq : spinPermutationLinearIsometryEquiv σ (ψ (permutePositions σ x)) = + ((((Equiv.Perm.sign σ : ℤˣ) : ℤ) : ℂ)) • ψ x := by + ext s + exact hx s + have hc : ‖((((Equiv.Perm.sign σ : ℤˣ) : ℤ) : ℂ))‖ = 1 := by + rcases Int.units_eq_one_or (Equiv.Perm.sign σ) with h | h <;> simp [h] + calc + ‖ψ (permutePositions σ x)‖ = + ‖spinPermutationLinearIsometryEquiv σ (ψ (permutePositions σ x))‖ := + ((spinPermutationLinearIsometryEquiv σ).norm_map _).symm + _ = ‖ψ x‖ := by rw [heq, norm_smul, hc, one_mul] + +/-- The norm equality also holds in the nonnegative norm used by the density. -/ +theorem nnnorm_permutePositions_ae {N q : ℕ} (ψ : State N q) (hψ : antisymmetric ψ) + (σ : Equiv.Perm (Fin N)) : + ∀ᵐ x ∂(volume : Measure (Configuration N)), ‖ψ (permutePositions σ x)‖₊ = ‖ψ x‖₊ := by + filter_upwards [norm_permutePositions_ae ψ hψ σ] with x hx + exact NNReal.coe_injective hx + +/-- Relabeling particles preserves every nonnegative marginal test. -/ +theorem particle_marginal_permutation {N q : ℕ} (ψ : State N q) (hψ : antisymmetric ψ) + (σ : Equiv.Perm (Fin N)) (i : Fin N) (v : Position → ℝ≥0∞) : + (∫⁻ x : Configuration N, v (particlePosition x (σ i)) * (‖ψ x‖₊ : ℝ≥0∞) ^ 2) = + ∫⁻ x : Configuration N, v (particlePosition x i) * (‖ψ x‖₊ : ℝ≥0∞) ^ 2 := by + calc + _ = ∫⁻ x : Configuration N, v (particlePosition (permutePositions σ x) i) * + (‖ψ (permutePositions σ x)‖₊ : ℝ≥0∞) ^ 2 := by + apply lintegral_congr_ae + filter_upwards [nnnorm_permutePositions_ae ψ hψ σ] with x hx + rw [particlePosition_permutePositions, hx] + _ = _ := (measurePreserving_permutePositions σ).lintegral_comp_emb + (measurableEmbedding_permutePositions σ) + (fun x : Configuration N => v (particlePosition x i) * (‖ψ x‖₊ : ℝ≥0∞) ^ 2) + +/-- All particle marginals of an antisymmetric state have the same tests. -/ +theorem particle_marginals_eq {N q : ℕ} (ψ : State N q) (hψ : antisymmetric ψ) + (i j : Fin N) (v : Position → ℝ≥0∞) : + (∫⁻ x : Configuration N, v (particlePosition x i) * (‖ψ x‖₊ : ℝ≥0∞) ^ 2) = + ∫⁻ x : Configuration N, v (particlePosition x j) * (‖ψ x‖₊ : ℝ≥0∞) ^ 2 := by + simpa only [Equiv.swap_apply_left] using + particle_marginal_permutation ψ hψ (Equiv.swap j i) j v + +end LiebThirring +end diff --git a/LeanPool/LiebThirring/Kinetic/RuminCoefficient.lean b/LeanPool/LiebThirring/Kinetic/RuminCoefficient.lean new file mode 100644 index 0000000000..2b6d8bdf1d --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/RuminCoefficient.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Assembly.RuminIntegral + +/-! +# The exact Rumin coefficient + +The real coefficient obtained after inserting the three-dimensional low-momentum volume is the +real value of the coefficient. + +Exact equality between the coefficient emitted by scalar Rumin integration and the extended +nonnegative coefficient. +-/ + +public section + +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- The real coefficient obtained after inserting the three-dimensional +low-momentum volume is the real value of the coefficient. -/ +theorem ruminCoefficient_real_eq (q : ℕ) (hq : 1 ≤ q) : + (9 / 35 : ℝ) * + (((q : ℝ) * (1 / (6 * Real.pi ^ 2))) ^ (-(2 : ℝ) / 3)) = + (ruminConstant : ℝ) * (q : ℝ) ^ (-(2 : ℝ) / 3) := by + have hqpos : 0 < (q : ℝ) := Nat.cast_pos.mpr (Nat.lt_of_lt_of_le Nat.zero_lt_one hq) + have hcpos : 0 < (6 * Real.pi ^ 2 : ℝ) := by positivity + have hbase : 0 < (9 / 35 : ℝ) * (6 * Real.pi ^ 2) ^ ((2 : ℝ) / 3) := + mul_pos (by norm_num) (Real.rpow_pos_of_pos hcpos _) + unfold ruminConstant + rw [Real.coe_toNNReal _ hbase.le] + have hc : (1 / (6 * Real.pi ^ 2 : ℝ)) ^ (-(2 : ℝ) / 3) = + (6 * Real.pi ^ 2 : ℝ) ^ ((2 : ℝ) / 3) := by + rw [one_div, Real.inv_rpow] <;> try positivity + rw [← Real.rpow_neg hcpos.le] + congr 1 + ring + rw [Real.mul_rpow hqpos.le (one_div_nonneg.mpr hcpos.le), hc] + ring + +/-- Exact equality between the coefficient emitted by scalar Rumin integration and the extended +nonnegative coefficient. -/ +theorem ofReal_ruminCoefficient_eq (q : ℕ) (hq : 1 ≤ q) : + ENNReal.ofReal ((9 / 35 : ℝ) * + (((q : ℝ) * (1 / (6 * Real.pi ^ 2))) ^ (-(2 : ℝ) / 3))) = + (ruminConstant : ℝ≥0∞) * (q : ℝ≥0∞) ^ (-(2 : ℝ) / 3) := by + rw [ruminCoefficient_real_eq q hq] + have hqpos : 0 < (q : ℝ) := Nat.cast_pos.mpr (Nat.lt_of_lt_of_le Nat.zero_lt_one hq) + rw [ENNReal.ofReal_mul (NNReal.coe_nonneg _), ENNReal.ofReal_coe_nnreal, + ← ENNReal.ofReal_rpow_of_pos hqpos, ENNReal.ofReal_natCast] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Kinetic/RuminIntegration.lean b/LeanPool/LiebThirring/Kinetic/RuminIntegration.lean new file mode 100644 index 0000000000..c3f5cdf023 --- /dev/null +++ b/LeanPool/LiebThirring/Kinetic/RuminIntegration.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Kinetic.RuminCoefficient +public import LeanPool.LiebThirring.Kinetic.LayerCakeBounds +public import LeanPool.LiebThirring.Kinetic.LayerCakeIdentity + +/-! # Rumin integration of the high Fourier field + +The exact scalar integral and the kinetic layer cake turn the pointwise +low-momentum estimate into the kinetic Lieb--Thirring bound. +-/ + +public section + +open MeasureTheory Set +open scoped ENNReal NNReal + +namespace LiebThirring + +/-- Conditional the Rumin bound: the exact pointwise low-momentum bound implies the kinetic +Lieb--Thirring inequality. the low-momentum bound supplies the sole conditional input. -/ +theorem rumin_bound_of_lowMomentumBound (q : ℕ) (hq : 1 ≤ q) {N : ℕ} + (i : Fin N) (ψ : State N q) (hanti : antisymmetric ψ) + (hLow : ∀ E : ℝ, 0 ≤ E → ∀ x : Position, + ‖lowFourierField (densityField i ψ) E x‖ ^ 2 ≤ + (q : ℝ) * (1 / (6 * Real.pi ^ 2)) * E ^ ((3 : ℝ) / 2)) : + (ruminConstant : ℝ≥0∞) * (q : ℝ≥0∞) ^ (-(2 : ℝ) / 3) * + (∫⁻ x : Position, density ψ x ^ ((5 : ℝ) / 3)) ≤ kineticEnergy ψ := by + let κ : ℝ≥0∞ := + (ruminConstant : ℝ≥0∞) * (q : ℝ≥0∞) ^ (-(2 : ℝ) / 3) + let d : ℝ := (q : ℝ) * (1 / (6 * Real.pi ^ 2)) + have hd : 0 < d := by + dsimp [d] + positivity + have hswap : + (∫⁻ E in Ioi (0 : ℝ), ∫⁻ x : Position, + ‖highFourierField (densityField i ψ) E x‖ₑ ^ 2) = + ∫⁻ x : Position, ∫⁻ E in Ioi (0 : ℝ), + ‖highFourierField (densityField i ψ) E x‖ₑ ^ 2 := by + apply MeasureTheory.lintegral_lintegral_swap + exact ((stronglyMeasurable_highFourierField_canonical + (densityField i ψ)).enorm.pow_const 2).aemeasurable + rw [kineticEnergy_eq_densityField_layerCake_Ioi i ψ hanti, hswap] + have hρmeas : Measurable (fun x : Position => + density ψ x ^ ((5 : ℝ) / 3)) := + ENNReal.continuous_rpow_const.measurable.comp (measurable_density ψ) + change κ * (∫⁻ x : Position, density ψ x ^ ((5 : ℝ) / 3)) ≤ _ + rw [← lintegral_const_mul κ hρmeas] + apply lintegral_mono_ae + filter_upwards [densityField_density_data_ae i ψ hanti, + densityField_high_bound_ae_of_lowMomentumBound i ψ hanti hLow] with x hρ hhigh + let t : ℝ := (density ψ x).toReal + have ht : 0 ≤ t := ENNReal.toReal_nonneg + have hscalar : κ * density ψ x ^ ((5 : ℝ) / 3) = + ENNReal.ofReal ((9 / 35 : ℝ) * d ^ (-(2 : ℝ) / 3) * + t ^ ((5 : ℝ) / 3)) := by + have hκ : κ = ENNReal.ofReal ((9 / 35 : ℝ) * d ^ (-(2 : ℝ) / 3)) := by + dsimp [κ, d] + exact (ofReal_ruminCoefficient_eq q hq).symm + rw [hκ, ← ENNReal.ofReal_toReal hρ.1] + rw [ENNReal.ofReal_rpow_of_nonneg ht (by norm_num : 0 ≤ (5 : ℝ) / 3)] + rw [← ENNReal.ofReal_mul] + positivity + rw [hscalar, ← Assembly.lintegral_rumin t d ht hd] + apply lintegral_mono_ae + filter_upwards [ae_restrict_mem measurableSet_Ioi] with E hE + have hb := hhigh E hE.le + have hsq : + (max (Real.sqrt t - Real.sqrt d * E ^ ((3 : ℝ) / 4)) 0) ^ 2 ≤ + ‖highFourierField (densityField i ψ) E x‖ ^ 2 := + (sq_le_sq₀ (by positivity) (norm_nonneg _)).mpr hb + calc + ENNReal.ofReal + ((max (Real.sqrt t - Real.sqrt d * E ^ ((3 : ℝ) / 4)) 0) ^ 2) ≤ + ENNReal.ofReal (‖highFourierField (densityField i ψ) E x‖ ^ 2) := + ENNReal.ofReal_le_ofReal hsq + _ = ‖highFourierField (densityField i ψ) E x‖ₑ ^ 2 := by + rw [ENNReal.ofReal_pow (norm_nonneg _), ofReal_norm] + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Theorems/Baxter.lean b/LeanPool/LiebThirring/Theorems/Baxter.lean new file mode 100644 index 0000000000..e7e000984d --- /dev/null +++ b/LeanPool/LiebThirring/Theorems/Baxter.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.Coulomb +import LeanPool.LiebThirring.Electrostatics.PotentialIdentityAssembly +import LeanPool.LiebThirring.Electrostatics.Collisions + +/-! +# Baxter + +Baxter’s electrostatic inequality, including collisions and empty configurations, from the +Voronoi boundary measure argument. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal + +namespace LiebThirring + +theorem baxter (N M : ℕ) (Z : ℝ≥0) (R : Fin M → Position) (x : Configuration N) : + attraction (fun _ => Z) R x + baxterCorrection Z R ≤ + electronRepulsion x + nuclearRepulsion (fun _ => Z) R + + nearestNucleusControl Z R x := + baxter_of_basicElectrostaticInequality + (fun _ Z R hM hR => basicElectrostaticInequality_of_injective hM Z R hR) N M Z R x + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Theorems/KineticEnergySchwartz.lean b/LeanPool/LiebThirring/Theorems/KineticEnergySchwartz.lean new file mode 100644 index 0000000000..1702560914 --- /dev/null +++ b/LeanPool/LiebThirring/Theorems/KineticEnergySchwartz.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.KineticEnergy +import LeanPool.LiebThirring.Fourier.Schwartz + +/-! +# Kinetic energy of Schwartz states + +The Fourier kinetic form agrees with the integral of squared coordinate derivatives on Schwartz +states. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal + +open scoped SchwartzMap FourierTransform + +namespace LiebThirring + +theorem kineticEnergy_schwartz (N q : ℕ) (f : 𝓢(Configuration N, SpinAmplitudes N q)) : + kineticEnergy (f.toLp 2 (volume : Measure (Configuration N))) = + ∑ i : Fin N, ∑ a : Fin 3, ∫⁻ x : Configuration N, + (‖fderiv ℝ (fun y => f y) x (PiLp.single 2 (i, a) (1 : ℝ))‖₊ : ℝ≥0∞) ^ 2 := by + classical + have hnorm (x : Configuration N) : + (‖x‖₊ : ℝ≥0∞) ^ 2 = + ∑ i : Fin N, ∑ a : Fin 3, ENNReal.ofReal (x (i, a) ^ 2) := by + change ‖x‖ₑ ^ 2 = _ + rw [← ofReal_norm, ← ENNReal.ofReal_pow (norm_nonneg _), EuclideanSpace.real_norm_sq_eq, + ENNReal.ofReal_sum_of_nonneg (fun j _ => sq_nonneg _)] + exact Fintype.sum_prod_type _ + have hderiv (i : Fin N) (a : Fin 3) : + (∫⁻ x : Configuration N, + (‖fderiv ℝ (fun y => f y) x (PiLp.single 2 (i, a) (1 : ℝ))‖₊ : ℝ≥0∞) ^ 2) = + ∫⁻ x : Configuration N, ENNReal.ofReal ((2 * Real.pi) ^ 2) * + ENNReal.ofReal (x (i, a) ^ 2) * (‖(𝓕 f) x‖₊ : ℝ≥0∞) ^ 2 := by + simpa only [EuclideanSpace.inner_single_right, map_one, one_mul, + RCLike.conj_to_real] using + Fourier.lintegral_fderiv_eq_fourier f (PiLp.single 2 (i, a) (1 : ℝ)) + unfold kineticEnergy + change (∫⁻ x : Configuration N, ENNReal.ofReal ((2 * Real.pi) ^ 2) * + (‖x‖₊ : ℝ≥0∞) ^ 2 * + (‖(𝓕 (f.toLp 2 (volume : Measure (Configuration N))) : State N q) x‖₊ : ℝ≥0∞) ^ 2) = _ + rw [SchwartzMap.toLp_fourier_eq] + calc + _ = ∫⁻ x : Configuration N, ENNReal.ofReal ((2 * Real.pi) ^ 2) * + (‖x‖₊ : ℝ≥0∞) ^ 2 * (‖(𝓕 f) x‖₊ : ℝ≥0∞) ^ 2 := by + apply lintegral_congr_ae + filter_upwards [(𝓕 f).coeFn_toLp 2 (volume : Measure (Configuration N))] with x hx + rw [hx] + _ = ∫⁻ x : Configuration N, ∑ i : Fin N, ∑ a : Fin 3, + ENNReal.ofReal ((2 * Real.pi) ^ 2) * ENNReal.ofReal (x (i, a) ^ 2) * + (‖(𝓕 f) x‖₊ : ℝ≥0∞) ^ 2 := by + apply lintegral_congr + intro x + rw [hnorm] + simp only [Finset.mul_sum, Finset.sum_mul] + _ = ∑ i : Fin N, ∑ a : Fin 3, ∫⁻ x : Configuration N, + ENNReal.ofReal ((2 * Real.pi) ^ 2) * ENNReal.ofReal (x (i, a) ^ 2) * + (‖(𝓕 f) x‖₊ : ℝ≥0∞) ^ 2 := by + rw [lintegral_finsetSum] + · apply Finset.sum_congr rfl + intro i _ + rw [lintegral_finsetSum] + intro a _ + fun_prop + · intro i _ + fun_prop + _ = _ := by + apply Finset.sum_congr rfl + intro i _ + apply Finset.sum_congr rfl + intro a _ + exact (hderiv i a).symm + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Theorems/KineticLiebThirring.lean b/LeanPool/LiebThirring/Theorems/KineticLiebThirring.lean new file mode 100644 index 0000000000..3e1309ebb3 --- /dev/null +++ b/LeanPool/LiebThirring/Theorems/KineticLiebThirring.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.Antisymmetric +public import LeanPool.LiebThirring.Defs.KineticEnergy +public import LeanPool.LiebThirring.Defs.Density +public import LeanPool.LiebThirring.Defs.RuminConstant +import LeanPool.LiebThirring.Kinetic.KineticLT + +/-! +# Kinetic Lieb–Thirring inequality + +The kinetic Lieb–Thirring inequality for normalized antisymmetric L² states, from the Pauli +occupation estimate and Rumin integration. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal + +namespace LiebThirring + +theorem kinetic_lieb_thirring (q : ℕ) (hq : 1 ≤ q) (N : ℕ) (ψ : State N q) + (hanti : antisymmetric ψ) (hnorm : ‖ψ‖ = 1) : + (ruminConstant : ℝ≥0∞) * (q : ℝ≥0∞) ^ (-(2 : ℝ) / 3) * + (∫⁻ x : Position, density ψ x ^ ((5 : ℝ) / 3)) ≤ kineticEnergy ψ := + Kinetic.kinetic_lieb_thirring q hq N ψ hanti hnorm + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Theorems/StabilityOfMatter.lean b/LeanPool/LiebThirring/Theorems/StabilityOfMatter.lean new file mode 100644 index 0000000000..53a6a949ee --- /dev/null +++ b/LeanPool/LiebThirring/Theorems/StabilityOfMatter.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.Antisymmetric +public import LeanPool.LiebThirring.Defs.KineticEnergy +public import LeanPool.LiebThirring.Defs.Coulomb +import LeanPool.LiebThirring.Theorems.Baxter +import LeanPool.LiebThirring.Theorems.KineticLiebThirring +import LeanPool.LiebThirring.Assembly.Stability + +/-! +# Stability of matter + +Stability of matter in nonnegative extended additive form, from Baxter’s electrostatic +inequality and the kinetic Lieb–Thirring inequality. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal + +namespace LiebThirring + +theorem stability_of_matter (q : ℕ) (hq : 1 ≤ q) (Z : ℝ≥0) : + ∃ C : ℝ≥0, 0 < C ∧ + ∀ (N M : ℕ) (z : Fin M → ℝ≥0) (R : Fin M → Position) (ψ : State N q), + (∀ k, z k ≤ Z) → antisymmetric ψ → ‖ψ‖ = 1 → + (∫⁻ x : Configuration N, attraction z R x * (‖ψ x‖₊ : ℝ≥0∞) ^ 2) ≤ + kineticEnergy ψ + + (∫⁻ x : Configuration N, electronRepulsion x * (‖ψ x‖₊ : ℝ≥0∞) ^ 2) + + nuclearRepulsion z R + (C : ℝ≥0∞) * (N + M : ℕ) := + Assembly.stability_of_matter_of_baxter_of_lt LiebThirring.baxter + LiebThirring.kinetic_lieb_thirring q hq Z + +end LiebThirring + +end diff --git a/LeanPool/LiebThirring/Theorems/StabilityOfMatterReal.lean b/LeanPool/LiebThirring/Theorems/StabilityOfMatterReal.lean new file mode 100644 index 0000000000..3bceeb3791 --- /dev/null +++ b/LeanPool/LiebThirring/Theorems/StabilityOfMatterReal.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 Scott Armstrong, Amélie Loher. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Armstrong, Amélie Loher +-/ +module + +-- Imported from upstream commit 8bf4656f07f5aaa227b0b850d77b16976915bbd4. +-- Imports adapted for Lean Pool. + +public import LeanPool.LiebThirring.Defs.Antisymmetric +public import LeanPool.LiebThirring.Defs.KineticEnergy +public import LeanPool.LiebThirring.Defs.Coulomb +public import LeanPool.LiebThirring.Assembly.RealFormStability +import LeanPool.LiebThirring.Analysis.Hardy + +/-! +# Real quadratic-form stability + +Finiteness of Coulomb expectations and real quadratic-form stability, using the Fourier Hardy +bound and extended stability with the same constant. +-/ + +public section + +open MeasureTheory WithLp +open scoped ENNReal NNReal + +namespace LiebThirring + +theorem stability_of_matter_real (q : ℕ) (hq : 1 ≤ q) (Z : ℝ≥0) : + ∃ C : ℝ≥0, 0 < C ∧ + ∀ (N M : ℕ) (z : Fin M → ℝ≥0) (R : Fin M → Position) (ψ : State N q), + (∀ k, z k ≤ Z) → Function.Injective R → + antisymmetric ψ → ‖ψ‖ = 1 → kineticEnergy ψ < ⊤ → + (∫⁻ x : Configuration N, + attraction z R x * (‖ψ x‖₊ : ℝ≥0∞) ^ 2) < ⊤ ∧ + (∫⁻ x : Configuration N, + electronRepulsion x * (‖ψ x‖₊ : ℝ≥0∞) ^ 2) < ⊤ ∧ + nuclearRepulsion z R < ⊤ ∧ + -(C : ℝ) * ((N + M : ℕ) : ℝ) ≤ + (kineticEnergy ψ).toReal + + (∫⁻ x : Configuration N, + electronRepulsion x * (‖ψ x‖₊ : ℝ≥0∞) ^ 2).toReal + + (nuclearRepulsion z R).toReal - + (∫⁻ x : Configuration N, + attraction z R x * (‖ψ x‖₊ : ℝ≥0∞) ^ 2).toReal := by + exact LiebThirring.Assembly.stability_of_matter_real_of_one_body_bound q hq Z + (fun _ c u => LiebThirring.lintegral_coulomb_le_of_fourier c u) + +end LiebThirring + +end diff --git a/LeanPool/projects/stability-of-matter.yaml b/LeanPool/projects/stability-of-matter.yaml new file mode 100644 index 0000000000..50ace251b9 --- /dev/null +++ b/LeanPool/projects/stability-of-matter.yaml @@ -0,0 +1,57 @@ +slug: stability-of-matter +title: Stability of matter and the kinetic Lieb–Thirring inequality +summary: Formalizes stability of non-relativistic fermionic Coulomb matter in three dimensions, + the kinetic Lieb–Thirring inequality with Rumin's explicit coefficient, Baxter's electrostatic + inequality with its positive nuclear correction, and real quadratic-form stability with Coulomb + finiteness. Preserves the Fourier, Pauli-occupation, Hardy and Voronoi infrastructure in the + 184-module dependency closure of these results. The separate ionization, thermodynamic-limit + and Thomas–Fermi developments are outside the imported scope. +branch: mathematical physics and analysis +entry_module: LeanPool.LiebThirring +authors: +- Scott Armstrong +- Amélie Loher +source: + url: https://github.com/scottnarmstrong/LiebThirring/tree/8bf4656f07f5aaa227b0b850d77b16976915bbd4 + github_repo: scottnarmstrong/LiebThirring + commit: 8bf4656f07f5aaa227b0b850d77b16976915bbd4 + arxiv: '2007.09326' + announcement_url: https://x.com/scottnarmstrong/status/2109220234028536270 + announcement_date: '2026-10-11' +license: Apache-2.0 +status: verified +provenance: AI +main_declarations: +- LiebThirring.stability_of_matter +main_results: +- declaration: LiebThirring.stability_of_matter + informal: For each positive spin multiplicity and nonnegative maximum nuclear charge, one + positive constant bounds electron–nucleus attraction by kinetic energy, electron and nuclear + repulsion, and the total particle count, uniformly over normalized antisymmetric L² states, + charges and nuclear positions, in nonnegative extended-energy form. +- declaration: LiebThirring.stability_of_matter_real + informal: With distinct nuclear positions and finite kinetic energy, Coulomb expectations + and nuclear repulsion are finite and the real quadratic energy is bounded below by a negative + constant times the total particle count, with the constant depending only on spin and maximum + charge. +- declaration: LiebThirring.kinetic_lieb_thirring + informal: Every normalized antisymmetric L² state with positive spin multiplicity q has kinetic + energy at least Rumin's coefficient times q to the power minus two thirds times the integral + of the density to the power five thirds, including states of infinite kinetic energy. +- declaration: LiebThirring.baxter + informal: For equal nonnegative nuclear charges, attraction plus the positive nearest-other-nucleus + correction is bounded by electron and nuclear repulsion plus nearest-nucleus control, including + collisions and empty configurations in nonnegative extended arithmetic. +- declaration: LiebThirring.kineticEnergy_schwartz + informal: The Fourier kinetic energy of a spin-valued Schwartz state equals the sum of the + squared classical spatial derivative integrals, with the physical minus-Laplacian normalization. +tags: +- mathematical-physics +- stability-of-matter +- lieb-thirring +- coulomb-energy +- fourier-analysis +msc: +- 81Q10 +- 35P15 +- 46N50