diff --git a/.codespellignore b/.codespellignore new file mode 100644 index 000000000..35ba186f6 --- /dev/null +++ b/.codespellignore @@ -0,0 +1,11 @@ +digitalize +Digitalising +statics +disjointness +lightYears +tne +hge +Breal +ket +rIn +FRO diff --git a/.github/ISSUE_TEMPLATE/API.yml b/.github/ISSUE_TEMPLATE/API.yml new file mode 100644 index 000000000..46cc5ee63 --- /dev/null +++ b/.github/ISSUE_TEMPLATE/API.yml @@ -0,0 +1,33 @@ +name: API +description: Auto-filled issue for API building +title: "API: " +labels: + - API + - help wanted + - Requirements needed +body: + - type: textarea + id: content + attributes: + label: Details + value: | + The details of this issue are not yet completed. The issue is here to track the progress of the API specified by the title. Parts of this API may already be included within the project. There are a number of things we need to specify, help in specifying these points is appreciated. + + ## Key data structure + + What is the key data structure the API is built around. + + ## Need + + Why is this API needed, after it is completed, what will it make easier or allow us to do. + + ## Requirements + + A tickbox list of the requirements of the API. This should include things which have already been done as well as things still to be worked on. Details on writing good system requirements can be found [here](https://www.ibm.com/docs/en/SSYQBZ_9.6.1/com.ibm.doors.requirements.doc/topics/get_it_right_the_first_time.pdf). + + ## Corresponding file system + + If it exists, the part of the PhysLean which corresponds to this API. + + validations: + required: false diff --git a/.github/ISSUE_TEMPLATE/Bump.yml b/.github/ISSUE_TEMPLATE/Bump.yml index e7b1fd598..5d6ea79cc 100644 --- a/.github/ISSUE_TEMPLATE/Bump.yml +++ b/.github/ISSUE_TEMPLATE/Bump.yml @@ -20,7 +20,8 @@ body: options: - label: Update mathlib rev in lakefile.toml. - label: Update doc-gen4 rev in lakefile.toml. - - label: Run `rm -rf .lake; lake update`. + - label: Remove the `.lake` file, e.g. on unix run `rm -rf .lake`. + - label: Run `lake update`. - label: Check `lean-toolchain` updates correctly. - label: Update the Lean version badge in the `README.md` file. validations: @@ -55,15 +56,17 @@ body: description: Please check off these items as you complete them options: - label: Create a tag for the new version. + - label: Put a bump notice on this [thread](https://leanprover.zulipchat.com/#narrow/channel/479953-PhysLean/topic/Bumps.20of.20PhysLean.2E/with/572707099). validations: required: false - type: textarea id: examples_of_previous_bumps attributes: - label: Previous bump + label: Example past bumps description: Please do not modify this text. value: | - [v4.20.0](https://github.com/HEPLean/PhysLean/pull/591), - [v4.20.0-rc5](https://github.com/HEPLean/PhysLean/pull/566) + [v4.20.0](https://github.com/lean-phys-community/PhysLean/pull/591), + [v4.20.0-rc5](https://github.com/lean-phys-community/PhysLean/pull/566) + [v4.27.0](https://github.com/lean-phys-community/PhysLean/pull/929) validations: required: true diff --git a/.github/ISSUE_TEMPLATE/NoteDocString.yml b/.github/ISSUE_TEMPLATE/NoteDocString.yml deleted file mode 100644 index c97bcbabc..000000000 --- a/.github/ISSUE_TEMPLATE/NoteDocString.yml +++ /dev/null @@ -1,24 +0,0 @@ -name: Note doc string -description: Improvements to docstrings from curated notes -title: "[doc-string]: " -body: - - type: markdown - attributes: - value: | - Thanks for taking the time to suggest an improvement! - - type: input - id: name - attributes: - label: Name of result - description: What is the name of the result you are suggesting an improvement for? - placeholder: - validations: - required: true - - type: textarea - id: improvement - attributes: - label: Improvement - description: What is the improvement you are suggesting? - placeholder: - validations: - required: true diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index c7fa94bc0..6d00bca4d 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -89,3 +89,13 @@ jobs: run: | chmod u+x scripts/lint-style.sh ./scripts/lint-style.sh + + codespell: + name: Check for spelling errors + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v6 + - uses: codespell-project/actions-codespell@v2 + with: + exclude_file: scripts/MetaPrograms/spellingWords.txt,scripts/physleanNoShake.json + ignore_words_file: .codespellignore diff --git a/PhysLean.lean b/PhysLean.lean index 9bee6f20b..b45cee7ae 100644 --- a/PhysLean.lean +++ b/PhysLean.lean @@ -1,13 +1,18 @@ import PhysLean.ClassicalMechanics.Basic +import PhysLean.ClassicalMechanics.DampedHarmonicOscillator.Basic import PhysLean.ClassicalMechanics.EulerLagrange import PhysLean.ClassicalMechanics.HamiltonsEquations import PhysLean.ClassicalMechanics.HarmonicOscillator.Basic +import PhysLean.ClassicalMechanics.HarmonicOscillator.ConfigurationSpace import PhysLean.ClassicalMechanics.HarmonicOscillator.Solution +import PhysLean.ClassicalMechanics.Lagrangian.TotalDerivativeEquivalence import PhysLean.ClassicalMechanics.Mass.MassUnit +import PhysLean.ClassicalMechanics.Pendulum.CoplanarDoublePendulum +import PhysLean.ClassicalMechanics.Pendulum.MiscellaneousPendulumPivotMotions +import PhysLean.ClassicalMechanics.Pendulum.SlidingPendulum import PhysLean.ClassicalMechanics.RigidBody.Basic import PhysLean.ClassicalMechanics.RigidBody.SolidSphere import PhysLean.ClassicalMechanics.Scattering.RigidSphere -import PhysLean.ClassicalMechanics.VectorFields import PhysLean.ClassicalMechanics.Vibrations.LinearTriatomic import PhysLean.ClassicalMechanics.WaveEquation.Basic import PhysLean.ClassicalMechanics.WaveEquation.HarmonicWave @@ -17,13 +22,14 @@ import PhysLean.Cosmology.Basic import PhysLean.Cosmology.FLRW.Basic import PhysLean.Electromagnetism.Basic import PhysLean.Electromagnetism.Charge.ChargeUnit -import PhysLean.Electromagnetism.Distributions.Potential +import PhysLean.Electromagnetism.Current.CircularCoil +import PhysLean.Electromagnetism.Current.InfiniteWire +import PhysLean.Electromagnetism.Dynamics.Basic import PhysLean.Electromagnetism.Dynamics.CurrentDensity import PhysLean.Electromagnetism.Dynamics.Hamiltonian import PhysLean.Electromagnetism.Dynamics.IsExtrema import PhysLean.Electromagnetism.Dynamics.KineticTerm import PhysLean.Electromagnetism.Dynamics.Lagrangian -import PhysLean.Electromagnetism.Electrostatics.Basic import PhysLean.Electromagnetism.Kinematics.Boosts import PhysLean.Electromagnetism.Kinematics.EMPotential import PhysLean.Electromagnetism.Kinematics.ElectricField @@ -31,23 +37,17 @@ import PhysLean.Electromagnetism.Kinematics.FieldStrength import PhysLean.Electromagnetism.Kinematics.MagneticField import PhysLean.Electromagnetism.Kinematics.ScalarPotential import PhysLean.Electromagnetism.Kinematics.VectorPotential -import PhysLean.Electromagnetism.MaxwellEquations -import PhysLean.Electromagnetism.PointParticle.FiniteCollection import PhysLean.Electromagnetism.PointParticle.OneDimension import PhysLean.Electromagnetism.PointParticle.ThreeDimension import PhysLean.Electromagnetism.Vacuum.Constant -import PhysLean.Electromagnetism.Vacuum.Homogeneous -import PhysLean.Electromagnetism.Vacuum.OneDimension -import PhysLean.Electromagnetism.Vacuum.Wave +import PhysLean.Electromagnetism.Vacuum.HarmonicWave +import PhysLean.Electromagnetism.Vacuum.IsPlaneWave import PhysLean.Mathematics.Calculus.AdjFDeriv import PhysLean.Mathematics.Calculus.Divergence import PhysLean.Mathematics.DataStructures.FourTree.Basic import PhysLean.Mathematics.DataStructures.FourTree.UniqueMap import PhysLean.Mathematics.DataStructures.Matrix.LieTrace import PhysLean.Mathematics.Distribution.Basic -import PhysLean.Mathematics.Distribution.Function.InvPowMeasure -import PhysLean.Mathematics.Distribution.Function.IsDistBounded -import PhysLean.Mathematics.Distribution.Function.OfFunction import PhysLean.Mathematics.Distribution.PowMul import PhysLean.Mathematics.FDerivCurry import PhysLean.Mathematics.Fin @@ -57,6 +57,8 @@ import PhysLean.Mathematics.Geometry.Metric.Riemannian.Defs import PhysLean.Mathematics.InnerProductSpace.Adjoint import PhysLean.Mathematics.InnerProductSpace.Basic import PhysLean.Mathematics.InnerProductSpace.Calculus +import PhysLean.Mathematics.InnerProductSpace.Submodule +import PhysLean.Mathematics.KroneckerDelta import PhysLean.Mathematics.LinearMaps import PhysLean.Mathematics.List import PhysLean.Mathematics.List.InsertIdx @@ -109,7 +111,8 @@ import PhysLean.Particles.BeyondTheStandardModel.RHN.AnomalyCancellation.PlusU1. import PhysLean.Particles.BeyondTheStandardModel.RHN.AnomalyCancellation.PlusU1.QuadSolToSol import PhysLean.Particles.BeyondTheStandardModel.Spin10.Basic import PhysLean.Particles.BeyondTheStandardModel.TwoHDM.Basic -import PhysLean.Particles.BeyondTheStandardModel.TwoHDM.GaugeOrbits +import PhysLean.Particles.BeyondTheStandardModel.TwoHDM.GramMatrix +import PhysLean.Particles.BeyondTheStandardModel.TwoHDM.Potential import PhysLean.Particles.FlavorPhysics.CKMMatrix.Basic import PhysLean.Particles.FlavorPhysics.CKMMatrix.Invariants import PhysLean.Particles.FlavorPhysics.CKMMatrix.PhaseFreedom @@ -225,12 +228,22 @@ import PhysLean.QFT.QED.AnomalyCancellation.Odd.Parameterization import PhysLean.QFT.QED.AnomalyCancellation.Permutations import PhysLean.QFT.QED.AnomalyCancellation.Sorts import PhysLean.QFT.QED.AnomalyCancellation.VectorLike +import PhysLean.QuantumMechanics.DDimensions.Hydrogen.Basic +import PhysLean.QuantumMechanics.DDimensions.Hydrogen.LaplaceRungeLenzVector +import PhysLean.QuantumMechanics.DDimensions.Operators.AngularMomentum +import PhysLean.QuantumMechanics.DDimensions.Operators.Commutation +import PhysLean.QuantumMechanics.DDimensions.Operators.Momentum +import PhysLean.QuantumMechanics.DDimensions.Operators.Position +import PhysLean.QuantumMechanics.DDimensions.Operators.Unbounded +import PhysLean.QuantumMechanics.DDimensions.SpaceDHilbertSpace.Basic +import PhysLean.QuantumMechanics.DDimensions.SpaceDHilbertSpace.SchwartzSubmodule import PhysLean.QuantumMechanics.FiniteTarget.Basic import PhysLean.QuantumMechanics.FiniteTarget.HilbertSpace import PhysLean.QuantumMechanics.OneDimension.GeneralPotential.Basic import PhysLean.QuantumMechanics.OneDimension.HarmonicOscillator.Basic import PhysLean.QuantumMechanics.OneDimension.HarmonicOscillator.Completeness import PhysLean.QuantumMechanics.OneDimension.HarmonicOscillator.Eigenfunction +import PhysLean.QuantumMechanics.OneDimension.HarmonicOscillator.Examples import PhysLean.QuantumMechanics.OneDimension.HarmonicOscillator.TISE import PhysLean.QuantumMechanics.OneDimension.HilbertSpace.Basic import PhysLean.QuantumMechanics.OneDimension.HilbertSpace.Gaussians @@ -270,6 +283,7 @@ import PhysLean.Relativity.SL2C.Basic import PhysLean.Relativity.SL2C.SelfAdjoint import PhysLean.Relativity.Special.ProperTime import PhysLean.Relativity.Special.TwinParadox.Basic +import PhysLean.Relativity.SpeedOfLight import PhysLean.Relativity.Tensors.Basic import PhysLean.Relativity.Tensors.Color.Basic import PhysLean.Relativity.Tensors.Color.Discrete @@ -325,20 +339,33 @@ import PhysLean.Relativity.Tensors.TensorSpecies.Basic import PhysLean.Relativity.Tensors.Tensorial import PhysLean.Relativity.Tensors.UnitTensor import PhysLean.SpaceAndTime.Space.Basic -import PhysLean.SpaceAndTime.Space.Distributions.Basic -import PhysLean.SpaceAndTime.Space.Distributions.ConstantTime +import PhysLean.SpaceAndTime.Space.ConstantSliceDist +import PhysLean.SpaceAndTime.Space.CrossProduct +import PhysLean.SpaceAndTime.Space.Derivatives.Basic +import PhysLean.SpaceAndTime.Space.Derivatives.Curl +import PhysLean.SpaceAndTime.Space.Derivatives.Div +import PhysLean.SpaceAndTime.Space.Derivatives.Grad +import PhysLean.SpaceAndTime.Space.Derivatives.Laplacian +import PhysLean.SpaceAndTime.Space.DistConst +import PhysLean.SpaceAndTime.Space.DistOfFunction +import PhysLean.SpaceAndTime.Space.IsDistBounded import PhysLean.SpaceAndTime.Space.LengthUnit -import PhysLean.SpaceAndTime.Space.SpaceStruct +import PhysLean.SpaceAndTime.Space.Norm +import PhysLean.SpaceAndTime.Space.RadialAngularMeasure +import PhysLean.SpaceAndTime.Space.Slice import PhysLean.SpaceAndTime.Space.Translations -import PhysLean.SpaceAndTime.Space.VectorIdentities import PhysLean.SpaceAndTime.SpaceTime.Basic import PhysLean.SpaceAndTime.SpaceTime.Boosts -import PhysLean.SpaceAndTime.SpaceTime.Distributions +import PhysLean.SpaceAndTime.SpaceTime.Derivatives +import PhysLean.SpaceAndTime.SpaceTime.LorentzAction import PhysLean.SpaceAndTime.SpaceTime.TimeSlice import PhysLean.SpaceAndTime.Time.Basic +import PhysLean.SpaceAndTime.Time.Derivatives import PhysLean.SpaceAndTime.Time.TimeMan import PhysLean.SpaceAndTime.Time.TimeTransMan import PhysLean.SpaceAndTime.Time.TimeUnit +import PhysLean.SpaceAndTime.TimeAndSpace.Basic +import PhysLean.SpaceAndTime.TimeAndSpace.ConstantTimeDist import PhysLean.StatisticalMechanics.BoltzmannConstant import PhysLean.StatisticalMechanics.CanonicalEnsemble.Basic import PhysLean.StatisticalMechanics.CanonicalEnsemble.Finite @@ -358,6 +385,7 @@ import PhysLean.StringTheory.FTheory.SU5.Quanta.FiveQuanta import PhysLean.StringTheory.FTheory.SU5.Quanta.IsViable import PhysLean.StringTheory.FTheory.SU5.Quanta.TenQuanta import PhysLean.Thermodynamics.Basic +import PhysLean.Thermodynamics.IdealGas.Basic import PhysLean.Thermodynamics.Temperature.Basic import PhysLean.Thermodynamics.Temperature.TemperatureUnits import PhysLean.Units.Basic diff --git a/PhysLean/ClassicalMechanics/DampedHarmonicOscillator/Basic.lean b/PhysLean/ClassicalMechanics/DampedHarmonicOscillator/Basic.lean new file mode 100644 index 000000000..24c4a98df --- /dev/null +++ b/PhysLean/ClassicalMechanics/DampedHarmonicOscillator/Basic.lean @@ -0,0 +1,230 @@ +/- +Copyright (c) 2025 Nicola Bernini. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nicola Bernini +-/ +import PhysLean.Meta.Informal.SemiFormal +import PhysLean.ClassicalMechanics.EulerLagrange +import PhysLean.ClassicalMechanics.HamiltonsEquations +/-! + +# The Damped Harmonic Oscillator + +## i. Overview + +The damped harmonic oscillator is a classical mechanical system corresponding to a +mass `m` under a restoring force `- k x` and a damping force `- γ ẋ`, where `k` is the +spring constant, `γ` is the damping coefficient, `x` is the position, and `ẋ` is the velocity. + +The equation of motion for the damped harmonic oscillator is: +``` +m ẍ + γ ẋ + k x = 0 +``` + +Depending on the relationship between the damping coefficient and the natural frequency, +the system exhibits three different behaviors: +- **Underdamped** (γ² < 4mk) : Oscillatory motion with exponentially decaying amplitude +- **Critically damped** (γ² = 4mk) : Fastest return to equilibrium without oscillation +- **Overdamped** (γ² > 4mk) : Slow return to equilibrium without oscillation + +## ii. Key results + +This module is currently a placeholder for future implementation. The following results +are planned to be formalized: + +- `DampedHarmonicOscillator`: Structure containing the input data (mass, spring constant, + damping coefficient) +- `EquationOfMotion`: The equation of motion for the damped harmonic oscillator +- Solutions for underdamped, critically damped, and overdamped cases +- Energy dissipation properties +- Quality factor and relaxation time + +## iii. Table of contents + +- A. The input data (to be implemented) +- B. The damped angular frequency (to be implemented) +- C. The energies and energy dissipation (to be implemented) +- D. The equation of motion (to be implemented) +- E. Solutions (to be implemented) + - E.1. Underdamped case + - E.2. Critically damped case + - E.3. Overdamped case +- F. Quality factor and decay time (to be implemented) + +## iv. References + +References for the damped harmonic oscillator include: +- Landau & Lifshitz, Mechanics, page 76, section 25. +- Goldstein, Classical Mechanics, Chapter 2. + +-/ + +namespace ClassicalMechanics +open Real +open Space +open InnerProductSpace + +TODO "DHO01" "Define the DampedHarmonicOscillator structure with mass m, spring constant k, + and damping coefficient γ." + +TODO "DHO04" "Prove that energy is not conserved and derive the energy dissipation rate." + +TODO "DHO05" "Derive solutions for the underdamped case (oscillatory with exponential decay)." + +TODO "DHO06" "Derive solutions for the critically damped case (fastest non-oscillatory return)." + +TODO "DHO07" "Derive solutions for the overdamped case (slow non-oscillatory return)." + +TODO "DHO08" "Define and prove properties of the quality factor Q." + +TODO "DHO09" "Define and prove properties of the relaxation time τ." + +TODO "DHO10" "Prove that the damped harmonic oscillator reduces to the undamped case when γ = 0." + +/-! + +## A. The input data (placeholder) + +The input data for the damped harmonic oscillator will consist of: +- Mass `m > 0` +- Spring constant `k > 0` +- Damping coefficient `γ ≥ 0` + +-/ + +/-- Placeholder structure for the damped harmonic oscillator. + The damped harmonic oscillator is specified by a mass `m`, a spring constant `k`, + and a damping coefficient `γ`. All parameters are assumed to be positive (or non-negative + for the damping coefficient). -/ +structure DampedHarmonicOscillator where + /-- The mass of the oscillator. -/ + m : ℝ + /-- The spring constant of the oscillator. -/ + k : ℝ + /-- The damping coefficient of the oscillator. -/ + γ : ℝ + m_pos : 0 < m + k_pos : 0 < k + γ_nonneg : 0 ≤ γ + +namespace DampedHarmonicOscillator + +variable (S : DampedHarmonicOscillator) + +@[simp] +lemma k_ne_zero : S.k ≠ 0 := Ne.symm (ne_of_lt S.k_pos) + +@[simp] +lemma m_ne_zero : S.m ≠ 0 := Ne.symm (ne_of_lt S.m_pos) + +/-! + +## B. The natural angular frequency (placeholder) + +The natural angular frequency ω₀ = √(k/m) will be defined here. + +-/ + +/-- The natural (undamped) angular frequency of the oscillator, ω₀ = √(k/m). -/ +noncomputable def ω₀ : ℝ := √(S.k / S.m) + +@[simp] +lemma ω₀_pos : 0 < S.ω₀ := sqrt_pos.mpr (div_pos S.k_pos S.m_pos) + +lemma ω₀_sq : S.ω₀^2 = S.k / S.m := by + rw [ω₀, sq_sqrt] + exact div_nonneg (le_of_lt S.k_pos) (le_of_lt S.m_pos) + +/-! +## C. Equation of motion (Tag: DHO03) + +The damped harmonic oscillator with mass `m`, spring +constant `k`, and damping coefficient `γ` satisfies + + m ẍ + γ ẋ + k x = 0, + +where `x : Time → ℝ` is the position as a function of time. +-/ + +/-- The equation of motion for the damped harmonic oscillator. + +A function `x : Time → ℝ` is a solution if it satisfies + + S.m * x¨ + S.γ * ẋ + S.k * x = 0 + +for all times `t`. -/ +noncomputable def EquationOfMotion (x : Time → ℝ) : Prop := + ∀ t : Time, + S.m * (Time.deriv (Time.deriv x) t) + + S.γ * (Time.deriv x t) + + S.k * x t = 0 + +/-! +## D. The energies and energy dissipation (Tag: DHO04) + +For the damped harmonic oscillator, the mechanical energy is + + E(t) = ½ S.m (ẋ(t))^2 + ½ S.k (x(t))^2, + +where `x : Time → ℝ` is the position as a function of time. + +If `x` satisfies the equation of motion + + S.m * x¨ + S.γ * ẋ + S.k * x = 0, + +then differentiating `E` with respect to time and substituting the +equation of motion yields + + dE/dt = - S.γ * (ẋ(t))^2 ≤ 0 + +Thus the energy is non-increasing in time, and it is strictly decreasing +whenever `S.γ > 0` and `ẋ(t) ≠ 0`. In particular, for `S.γ > 0` +the energy is not conserved, and the energy dissipation rate is +proportional to the squared velocity. +-/ + +/-- The kinetic energy of the damped harmonic oscillator. -/ +noncomputable def kineticEnergy (x : Time → ℝ) : Time → ℝ := + fun t => (1 / 2 : ℝ) * S.m * (Time.deriv x t)^2 + +/-- The potential energy of the damped harmonic oscillator. -/ +noncomputable def potentialEnergy (x : Time → ℝ) : Time → ℝ := + fun t => (1 / 2 : ℝ) * S.k * (x t)^2 + +/-- Mechanical energy of the damped harmonic oscillator. -/ +noncomputable def energy (x : Time → ℝ) : Time → ℝ := + S.kineticEnergy x + S.potentialEnergy x + +/-- Energy dissipation rate along a trajectory `x : Time → ℝ`. + + if `x` satisfies `S.equationOfMotion x`, then + + Time.deriv (S.energy x) t = - S.γ * (Time.deriv x t)^2, + +so the energy is non-increasing and not conserved when `S.γ > 0`. -/ +noncomputable def energyDissipationRate (x : Time → ℝ) : Time → ℝ := + fun t => - S.γ * (Time.deriv x t)^2 + +/-! + +## E. Damping regimes (placeholder) + +The three damping regimes will be defined based on the discriminant γ² - 4mk. + +-/ + +/-- The discriminant that determines the damping regime. -/ +noncomputable def discriminant : ℝ := S.γ^2 - 4 * S.m * S.k + +/-- The system is underdamped when γ² < 4mk. -/ +def IsUnderdamped : Prop := S.discriminant < 0 + +/-- The system is critically damped when γ² = 4mk. -/ +def IsCriticallyDamped : Prop := S.discriminant = 0 + +/-- The system is overdamped when γ² > 4mk. -/ +def IsOverdamped : Prop := S.discriminant > 0 + +end DampedHarmonicOscillator + +end ClassicalMechanics diff --git a/PhysLean/ClassicalMechanics/EulerLagrange.lean b/PhysLean/ClassicalMechanics/EulerLagrange.lean index e06c6c493..d1c75fdbe 100644 --- a/PhysLean/ClassicalMechanics/EulerLagrange.lean +++ b/PhysLean/ClassicalMechanics/EulerLagrange.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Tomas Skrivan, Joseph Tooby-Smith -/ import PhysLean.Mathematics.VariationalCalculus.HasVarGradient -import PhysLean.SpaceAndTime.Time.Basic /-! # Euler-Lagrange equations @@ -67,11 +66,11 @@ theorem euler_lagrange_varGradient simp[sub_eq_add_neg] congr rw [gradient_eq_adjFDeriv, adjFDeriv_uncurry] - apply ContDiff.differentiable (n := ∞) (by fun_prop) ENat.LEInfty.out - apply ContDiff.differentiable (n := ∞) (by fun_prop) ENat.LEInfty.out + apply ContDiff.differentiable (n := ∞) (by fun_prop) (by simp) + apply ContDiff.differentiable (n := ∞) (by fun_prop) (by simp) funext t rw [gradient_eq_adjFDeriv, adjFDeriv_uncurry] - apply ContDiff.differentiable (n := ∞) (by fun_prop) ENat.LEInfty.out - apply ContDiff.differentiable (n := ∞) (by fun_prop) ENat.LEInfty.out + apply ContDiff.differentiable (n := ∞) (by fun_prop) (by simp) + apply ContDiff.differentiable (n := ∞) (by fun_prop) (by simp) end ClassicalMechanics diff --git a/PhysLean/ClassicalMechanics/HamiltonsEquations.lean b/PhysLean/ClassicalMechanics/HamiltonsEquations.lean index 31b7c7b4e..0c5edb7d0 100644 --- a/PhysLean/ClassicalMechanics/HamiltonsEquations.lean +++ b/PhysLean/ClassicalMechanics/HamiltonsEquations.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Tomas Skrivan, Joseph Tooby-Smith -/ import PhysLean.Mathematics.VariationalCalculus.HasVarGradient -import PhysLean.SpaceAndTime.Time.Basic /-! # Hamilton's equations @@ -17,6 +16,11 @@ We show that the variational derivative of the action functional `∫ ⟪p, dq/dt⟫ - H(t, p, q) dt` is equal to the `hamiltonEqOp` applied to `(p, q)`. +## References + +- G. J. Sussman and J. Wisdom, "Structure and Interpretation of Classical Mechanics", Section 3.1.2. + + -/ open MeasureTheory ContDiff InnerProductSpace Time diff --git a/PhysLean/ClassicalMechanics/HarmonicOscillator/Basic.lean b/PhysLean/ClassicalMechanics/HarmonicOscillator/Basic.lean index 48a3f93ad..5d7b4a39e 100644 --- a/PhysLean/ClassicalMechanics/HarmonicOscillator/Basic.lean +++ b/PhysLean/ClassicalMechanics/HarmonicOscillator/Basic.lean @@ -6,6 +6,7 @@ Authors: Joseph Tooby-Smith, Lode Vermeulen import PhysLean.Meta.Informal.SemiFormal import PhysLean.ClassicalMechanics.EulerLagrange import PhysLean.ClassicalMechanics.HamiltonsEquations +import PhysLean.ClassicalMechanics.HarmonicOscillator.ConfigurationSpace /-! # The Classical Harmonic Oscillator @@ -112,10 +113,10 @@ namespace HarmonicOscillator variable (S : HarmonicOscillator) @[simp] -lemma k_neq_zero : S.k ≠ 0 := Ne.symm (ne_of_lt S.k_pos) +lemma k_ne_zero : S.k ≠ 0 := Ne.symm (ne_of_lt S.k_pos) @[simp] -lemma m_neq_zero : S.m ≠ 0 := Ne.symm (ne_of_lt S.m_pos) +lemma m_ne_zero : S.m ≠ 0 := Ne.symm (ne_of_lt S.m_pos) /-! @@ -145,7 +146,7 @@ lemma ω_sq : S.ω^2 = S.k / S.m := by exact div_nonneg (le_of_lt S.k_pos) (le_of_lt S.m_pos) /-- The angular frequency of the classical harmonic oscillator is not equal to zero. -/ -lemma ω_neq_zero : S.ω ≠ 0 := Ne.symm (ne_of_lt S.ω_pos) +lemma ω_ne_zero : S.ω ≠ 0 := Ne.symm (ne_of_lt S.ω_pos) /-- The inverse of the square of the angular frequency of the classical harmonic oscillator is `m/k`. -/ @@ -177,15 +178,15 @@ of the harmonic oscillator, through the lagrangian. -/ /-- The kinetic energy of the harmonic oscillator is $\frac{1}{2} m ‖\dot x‖^2$. -/ -noncomputable def kineticEnergy (xₜ : Time → Space 1) : Time → ℝ := fun t => +noncomputable def kineticEnergy (xₜ : Time → ConfigurationSpace) : Time → ℝ := fun t => (1 / (2 : ℝ)) * S.m * ⟪∂ₜ xₜ t, ∂ₜ xₜ t⟫_ℝ /-- The potential energy of the harmonic oscillator is `1/2 k x ^ 2` -/ -noncomputable def potentialEnergy (x : Space 1) : ℝ := +noncomputable def potentialEnergy (x : ConfigurationSpace) : ℝ := (1 / (2 : ℝ)) • S.k • ⟪x, x⟫_ℝ /-- The energy of the harmonic oscillator is the kinetic energy plus the potential energy. -/ -noncomputable def energy (xₜ : Time → Space 1) : Time → ℝ := fun t => +noncomputable def energy (xₜ : Time → ConfigurationSpace) : Time → ℝ := fun t => kineticEnergy S xₜ t + potentialEnergy S (xₜ t) /-! @@ -194,13 +195,13 @@ noncomputable def energy (xₜ : Time → Space 1) : Time → ℝ := fun t => -/ -lemma kineticEnergy_eq (xₜ : Time → Space 1) : +lemma kineticEnergy_eq (xₜ : Time → ConfigurationSpace) : kineticEnergy S xₜ = fun t => (1 / (2 : ℝ)) * S.m * ⟪∂ₜ xₜ t, ∂ₜ xₜ t⟫_ℝ:= by rfl -lemma potentialEnergy_eq (x : Space 1) : +lemma potentialEnergy_eq (x : ConfigurationSpace) : potentialEnergy S x = (1 / (2 : ℝ)) • S.k • ⟪x, x⟫_ℝ:= by rfl -lemma energy_eq (xₜ : Time → Space 1) : +lemma energy_eq (xₜ : Time → ConfigurationSpace) : energy S xₜ = fun t => kineticEnergy S xₜ t + potentialEnergy S (xₜ t) := by rfl /-! @@ -210,7 +211,7 @@ On smooth trajectories the energies are differentiable. -/ @[fun_prop] -lemma kineticEnergy_differentiable (xₜ : Time → Space 1) (hx : ContDiff ℝ ∞ xₜ) : +lemma kineticEnergy_differentiable (xₜ : Time → ConfigurationSpace) (hx : ContDiff ℝ ∞ xₜ) : Differentiable ℝ (kineticEnergy S xₜ) := by rw [kineticEnergy_eq] change Differentiable ℝ ((fun x => (1 / (2 : ℝ)) * S.m * ⟪x, x⟫_ℝ) ∘ (fun t => ∂ₜ xₜ t)) @@ -219,9 +220,9 @@ lemma kineticEnergy_differentiable (xₜ : Time → Space 1) (hx : ContDiff ℝ · exact deriv_differentiable_of_contDiff xₜ hx @[fun_prop] -lemma potentialEnergy_differentiable (xₜ : Time → Space 1) (hx : ContDiff ℝ ∞ xₜ) : +lemma potentialEnergy_differentiable (xₜ : Time → ConfigurationSpace) (hx : ContDiff ℝ ∞ xₜ) : Differentiable ℝ (fun t => potentialEnergy S (xₜ t)) := by - simp [potentialEnergy_eq] + simp only [potentialEnergy_eq, one_div, smul_eq_mul] change Differentiable ℝ ((fun x => 2⁻¹ * (S.k * ⟪x, x⟫_ℝ)) ∘ xₜ) apply Differentiable.comp · fun_prop @@ -229,7 +230,7 @@ lemma potentialEnergy_differentiable (xₜ : Time → Space 1) (hx : ContDiff exact hx.1 @[fun_prop] -lemma energy_differentiable (xₜ : Time → Space 1) (hx : ContDiff ℝ ∞ xₜ) : +lemma energy_differentiable (xₜ : Time → ConfigurationSpace) (hx : ContDiff ℝ ∞ xₜ) : Differentiable ℝ (energy S xₜ) := by rw [energy_eq] fun_prop @@ -243,11 +244,11 @@ the time derivatives of the energies. -/ -lemma kineticEnergy_deriv (xₜ : Time → Space 1) (hx : ContDiff ℝ ∞ xₜ) : +lemma kineticEnergy_deriv (xₜ : Time → ConfigurationSpace) (hx : ContDiff ℝ ∞ xₜ) : ∂ₜ (kineticEnergy S xₜ) = fun t => ⟪∂ₜ xₜ t, S.m • ∂ₜ (∂ₜ xₜ) t⟫_ℝ := by funext t unfold kineticEnergy - conv_lhs => simp [Time.deriv] + conv_lhs => simp only [Time.deriv, one_div, ringHom_apply] change (fderiv ℝ ((fun x => 2⁻¹ * S.m * ⟪x, x⟫_ℝ) ∘ (fun t => ∂ₜ xₜ t)) t) 1 = _ rw [fderiv_comp] rw [fderiv_const_mul (by fun_prop)] @@ -261,11 +262,11 @@ lemma kineticEnergy_deriv (xₜ : Time → Space 1) (hx : ContDiff ℝ ∞ xₜ) module repeat fun_prop -lemma potentialEnergy_deriv (xₜ : Time → Space 1) (hx : ContDiff ℝ ∞ xₜ) : +lemma potentialEnergy_deriv (xₜ : Time → ConfigurationSpace) (hx : ContDiff ℝ ∞ xₜ) : ∂ₜ (fun t => potentialEnergy S (xₜ t)) = fun t => ⟪∂ₜ xₜ t, S.k • xₜ t⟫_ℝ := by funext t unfold potentialEnergy - conv_lhs => simp [Time.deriv] + conv_lhs => simp only [Time.deriv, one_div, smul_eq_mul] change (fderiv ℝ ((fun x => 2⁻¹ * (S.k * ⟪x, x⟫_ℝ)) ∘ (fun t => xₜ t)) t) 1 = _ rw [fderiv_comp] rw [fderiv_const_mul (by fun_prop), fderiv_const_mul (by fun_prop)] @@ -284,7 +285,7 @@ lemma potentialEnergy_deriv (xₜ : Time → Space 1) (hx : ContDiff ℝ ∞ x rw [contDiff_infty_iff_fderiv] at hx exact hx.1 -lemma energy_deriv (xₜ : Time → Space 1) (hx : ContDiff ℝ ∞ xₜ) : +lemma energy_deriv (xₜ : Time → ConfigurationSpace) (hx : ContDiff ℝ ∞ xₜ) : ∂ₜ (energy S xₜ) = fun t => ⟪∂ₜ xₜ t, S.m • ∂ₜ (∂ₜ xₜ) t + S.k • xₜ t⟫_ℝ := by unfold energy funext t @@ -321,8 +322,9 @@ to make the lagrangian a function on phase-space we reserve this result for a le set_option linter.unusedVariables false in /-- The lagrangian of the harmonic oscillator is the kinetic energy minus the potential energy. -/ @[nolint unusedArguments] -noncomputable def lagrangian (t : Time) (x : Space 1) (v : EuclideanSpace ℝ (Fin 1)) : - ℝ := 1 / (2 : ℝ) * S.m * ⟪v, v⟫_ℝ - S.potentialEnergy x +noncomputable def lagrangian (t : Time) (x : ConfigurationSpace) + (v : ConfigurationSpace) : ℝ := + 1 / (2 : ℝ) * S.m * ⟪v, v⟫_ℝ - S.potentialEnergy x /-! @@ -341,7 +343,8 @@ lemma lagrangian_eq : lagrangian S = fun t x v => simp [lagrangian, potentialEnergy] ring -lemma lagrangian_eq_kineticEnergy_sub_potentialEnergy (t : Time) (xₜ : Time → Space 1) : +lemma lagrangian_eq_kineticEnergy_sub_potentialEnergy (t : Time) + (xₜ : Time → ConfigurationSpace) : lagrangian S t (xₜ t) (∂ₜ xₜ t) = kineticEnergy S xₜ t - potentialEnergy S (xₜ t) := by rw [lagrangian_eq, kineticEnergy, potentialEnergy] simp only [one_div, smul_eq_mul, sub_right_inj] @@ -358,7 +361,54 @@ The lagrangian is smooth in all its arguments. @[fun_prop] lemma contDiff_lagrangian (n : WithTop ℕ∞) : ContDiff ℝ n ↿S.lagrangian := by rw [lagrangian_eq] - fun_prop + apply ContDiff.sub + · apply ContDiff.mul + · apply ContDiff.mul + · exact contDiff_const + · exact contDiff_const + · exact ContDiff.inner (𝕜 := ℝ) (contDiff_snd.comp contDiff_snd) + (contDiff_snd.comp contDiff_snd) + · apply ContDiff.mul + · apply ContDiff.mul + · exact contDiff_const + · exact contDiff_const + · exact ContDiff.inner (𝕜 := ℝ) (contDiff_fst.comp contDiff_snd) + (contDiff_fst.comp contDiff_snd) + +lemma toDual_symm_innerSL (x : ConfigurationSpace) : + (InnerProductSpace.toDual ℝ ConfigurationSpace).symm (innerSL ℝ x) = x := by + apply (innerSL_inj (𝕜:=ℝ) (E:=ConfigurationSpace)).1 + ext y + simp [InnerProductSpace.toDual_symm_apply] + +lemma gradient_inner_self (x : ConfigurationSpace) : + gradient (fun y : ConfigurationSpace => ⟪y, y⟫_ℝ) x = (2 : ℝ) • x := by + refine ext_inner_right (𝕜 := ℝ) fun y => ?_ + unfold gradient + rw [InnerProductSpace.toDual_symm_apply] + have hid : DifferentiableAt ℝ (fun y : ConfigurationSpace => y) x := differentiableAt_id + rw [show (fun y : ConfigurationSpace => ⟪y, y⟫_ℝ) = + fun y => ⟪(fun y => y) y, (fun y => y) y⟫_ℝ from rfl] + rw [fderiv_inner_apply (𝕜 := ℝ) hid hid] + simp only [fderiv_id', ContinuousLinearMap.coe_id', id_eq, + ConfigurationSpace.inner_def, ConfigurationSpace.smul_val] + ring + +lemma gradient_const_mul_inner_self (c : ℝ) (x : ConfigurationSpace) : + gradient (fun y : ConfigurationSpace => c * ⟪y, y⟫_ℝ) x = (2 * c) • x := by + calc + gradient (fun y : ConfigurationSpace => c * ⟪y, y⟫_ℝ) x + = (InnerProductSpace.toDual ℝ ConfigurationSpace).symm + (fderiv ℝ (fun y : ConfigurationSpace => c * ⟪y, y⟫_ℝ) x) := rfl + _ = (InnerProductSpace.toDual ℝ ConfigurationSpace).symm + (c • fderiv ℝ (fun y : ConfigurationSpace => ⟪y, y⟫_ℝ) x) := by + rw [fderiv_const_mul (ConfigurationSpace.differentiableAt_inner_self x)] + _ = c • gradient (fun y : ConfigurationSpace => ⟪y, y⟫_ℝ) x := by + simp only [gradient, map_smul] + _ = c • ((2 : ℝ) • x) := by + rw [gradient_inner_self] + _ = (2 * c) • x := by + rw [smul_smul, mul_comm] /-! @@ -369,42 +419,30 @@ position and velocity. -/ -lemma gradient_lagrangian_position_eq (t : Time) (x : Space 1) (v : EuclideanSpace ℝ (Fin 1)) : - gradient (fun x => lagrangian S t x v) x = - S.k • x := by - simp [lagrangian_eq] - rw [← grad_eq_gradiant, grad_eq_sum] - simp [Space.deriv_eq_fderiv_basis] - rw [fderiv_fun_sub (by fun_prop) (by fun_prop)] - simp only [fderiv_fun_const, Pi.zero_apply, zero_sub, Fin.isValue, ContinuousLinearMap.neg_apply, - neg_smul, neg_inj] - rw [fderiv_const_mul (by fun_prop)] - simp [← Space.deriv_eq_fderiv_basis, deriv_eq_inner_self] - have hx : x = x 0 • basis 0 := by - ext i - fin_cases i - simp - rw [hx] - simp [smul_smul] - congr 1 - field_simp +private lemma gradient_add_const' {f : ConfigurationSpace → ℝ} {c : ℝ} + (x : ConfigurationSpace) : + gradient (fun y => f y + c) x = gradient f x := by + unfold gradient + rw [fderiv_add_const] -lemma gradient_lagrangian_velocity_eq (t : Time) (x : Space 1) (v : EuclideanSpace ℝ (Fin 1)) : +lemma gradient_lagrangian_position_eq (t : Time) (x : ConfigurationSpace) + (v : ConfigurationSpace) : + gradient (fun x => lagrangian S t x v) x = - S.k • x := by + have h_eq : (fun y : ConfigurationSpace => lagrangian S t y v) = + fun y => (-(1 / (2 : ℝ)) * S.k) * ⟪y, y⟫_ℝ + (1 / (2 : ℝ) * S.m * ⟪v, v⟫_ℝ) := by + funext y; unfold lagrangian potentialEnergy; simp only [smul_eq_mul]; ring + rw [h_eq, gradient_add_const', gradient_const_mul_inner_self] + ext; simp only [ConfigurationSpace.smul_val]; ring + +lemma gradient_lagrangian_velocity_eq (t : Time) (x : ConfigurationSpace) + (v : ConfigurationSpace) : gradient (lagrangian S t x) v = S.m • v := by - simp [lagrangian_eq] - rw [← grad_eq_gradiant, grad_eq_sum] - simp [Space.deriv_eq_fderiv_basis] - rw [fderiv_fun_sub (by fun_prop) (by fun_prop)] - simp only [fderiv_fun_const, Pi.zero_apply, sub_zero, Fin.isValue] - rw [fderiv_const_mul (by fun_prop)] - simp [← Space.deriv_eq_fderiv_basis, deriv_eq_inner_self] - have hx : v = v 0 • basis 0 := by - ext i - fin_cases i - simp - rw [hx] - simp [smul_smul] - congr 1 - field_simp + have h_eq : (fun y : ConfigurationSpace => lagrangian S t x y) = + fun y => ((1 / (2 : ℝ)) * S.m) * ⟪y, y⟫_ℝ + (-(1 / (2 : ℝ)) * S.k * ⟪x, x⟫_ℝ) := by + funext y; unfold lagrangian potentialEnergy; simp only [smul_eq_mul]; ring + change gradient (fun y : ConfigurationSpace => lagrangian S t x y) v = S.m • v + rw [h_eq, gradient_add_const', gradient_const_mul_inner_self] + ext; simp only [ConfigurationSpace.smul_val]; ring /-! @@ -422,7 +460,8 @@ equation of motion. -/ /-- The Euler-Lagrange operator for the classical harmonic oscillator. -/ -noncomputable def gradLagrangian (xₜ : Time → Space 1) : Time → Space 1 := +noncomputable def gradLagrangian (xₜ : Time → ConfigurationSpace) : + Time → ConfigurationSpace := (δ (q':=xₜ), ∫ t, lagrangian S t (q' t) (fderiv ℝ q' t 1)) /-! @@ -433,7 +472,8 @@ Basic equalities for the variational derivative of the action. -/ -lemma gradLagrangian_eq_eulerLagrangeOp (xₜ : Time → Space 1) (hq : ContDiff ℝ ∞ xₜ) : +lemma gradLagrangian_eq_eulerLagrangeOp (xₜ : Time → ConfigurationSpace) + (hq : ContDiff ℝ ∞ xₜ) : gradLagrangian S xₜ = eulerLagrangeOp S.lagrangian xₜ := by rw [gradLagrangian, ClassicalMechanics.euler_lagrange_varGradient _ _ hq (S.contDiff_lagrangian _)] @@ -448,7 +488,7 @@ variational derivative of the action equal to zero. -/ /-- The equation of motion for the Harmonic oscillator. -/ -def EquationOfMotion (xₜ : Time → Space 1) : Prop := +def EquationOfMotion (xₜ : Time → ConfigurationSpace) : Prop := S.gradLagrangian xₜ = 0 /-! @@ -459,7 +499,7 @@ We write a simple iff statement for the definition of the equation of motions. -/ -lemma equationOfMotion_iff_gradLagrangian_zero (xₜ : Time → Space 1) : +lemma equationOfMotion_iff_gradLagrangian_zero (xₜ : Time → ConfigurationSpace) : S.EquationOfMotion xₜ ↔ S.gradLagrangian xₜ = 0 := by rfl /-! @@ -482,8 +522,9 @@ and show that this is equal to `- k x`. /-- The force of the classical harmonic oscillator defined as `- dU(x)/dx` where `U(x)` is the potential energy. -/ -noncomputable def force (S : HarmonicOscillator) (x : Space 1) : EuclideanSpace ℝ (Fin 1) := - - ∇ (potentialEnergy S) x +noncomputable def force (S : HarmonicOscillator) (x : ConfigurationSpace) : + ConfigurationSpace := + - gradient (potentialEnergy S) x /-! @@ -494,17 +535,19 @@ We now show that the force is equal to `- k x`. -/ /-- The force on the classical harmonic oscillator is `- k x`. -/ -lemma force_eq_linear (x : Space 1) : force S x = - S.k • x := by +lemma force_eq_linear (x : ConfigurationSpace) : force S x = - S.k • x := by unfold force potentialEnergy - change -∇ ((1 / (2 : ℝ)) • S.k • (fun (x : Space 1) => ⟪x, x⟫_ℝ)) x = -S.k • x - rw [grad_smul, grad_smul] - · rw [grad_inner] - simp only [Pi.smul_apply, neg_smul, neg_inj, smul_smul] - simp only [mul_smul] - rw [smul_comm] - simp only [one_div, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, inv_smul_smul₀] - · simp only [inner_differentiable] - · simp only [Differentiable.const_smul, inner_differentiable] + have hpot : (fun y : ConfigurationSpace => (1 / (2 : ℝ)) • S.k • ⟪y, y⟫_ℝ) = + fun y => ((1 / (2 : ℝ)) * S.k) * ⟪y, y⟫_ℝ := by + funext y + simp [smul_eq_mul, mul_assoc] + rw [hpot] + have hgrad : gradient (fun y : ConfigurationSpace => ((1 / (2 : ℝ)) * S.k) * ⟪y, y⟫_ℝ) x + = S.k • x := by + simpa [smul_eq_mul, mul_assoc] using + (gradient_const_mul_inner_self (c := (1 / (2 : ℝ)) * S.k) x) + rw [hgrad] + simp [neg_smul] /-! @@ -516,32 +559,25 @@ to Newton's second law. -/ /-- The Euler lagrange operator corresponds to Newton's second law. -/ -lemma gradLagrangian_eq_force (xₜ : Time → Space 1) (hx : ContDiff ℝ ∞ xₜ) : +lemma gradLagrangian_eq_force (xₜ : Time → ConfigurationSpace) (hx : ContDiff ℝ ∞ xₜ) : S.gradLagrangian xₜ = fun t => force S (xₜ t) - S.m • ∂ₜ (∂ₜ xₜ) t := by funext t rw [gradLagrangian_eq_eulerLagrangeOp S xₜ hx, eulerLagrangeOp] - simp only congr - · simp [lagrangian_eq] - rw [← grad_eq_gradiant, grad_eq_sum] - simp [Space.deriv_eq_fderiv_basis] - rw [fderiv_fun_sub (by fun_prop) (by fun_prop)] - simp only [fderiv_fun_const, Pi.zero_apply, zero_sub, Fin.isValue, - ContinuousLinearMap.neg_apply, neg_smul] - rw [fderiv_const_mul (by fun_prop)] - simp [← Space.deriv_eq_fderiv_basis, deriv_eq_inner_self, force_eq_linear] - have hx : xₜ t = xₜ t 0 • basis 0 := by - ext i - fin_cases i - simp - rw [hx] - simp [smul_smul] - congr 1 - field_simp - · rw [← Time.deriv_smul _ _ (by fun_prop)] - congr - funext t - rw [gradient_lagrangian_velocity_eq] + · simp [gradient_lagrangian_position_eq, force_eq_linear] + · conv_lhs => + arg 1 + ext t' + rw [gradient_lagrangian_velocity_eq] + show ∂ₜ (fun t' => S.m • ∂ₜ xₜ t') t = S.m • ∂ₜ (∂ₜ xₜ) t + have hd : DifferentiableAt ℝ (∂ₜ xₜ) t := + (deriv_differentiable_of_contDiff xₜ hx).differentiableAt + calc + ∂ₜ (fun t' => S.m • ∂ₜ xₜ t') t + = fderiv ℝ (fun t' => S.m • ∂ₜ xₜ t') t 1 := rfl + _ = S.m • (fderiv ℝ (∂ₜ xₜ) t 1) := by + simpa using congrArg (fun L => L 1) (fderiv_const_smul (c := S.m) (f := ∂ₜ xₜ) hd) + _ = S.m • ∂ₜ (∂ₜ xₜ) t := rfl /-! @@ -551,7 +587,8 @@ We show that the equation of motion is equivalent to Newton's second law. -/ -lemma equationOfMotion_iff_newtons_2nd_law (xₜ : Time → Space 1) (hx : ContDiff ℝ ∞ xₜ) : +lemma equationOfMotion_iff_newtons_2nd_law (xₜ : Time → ConfigurationSpace) + (hx : ContDiff ℝ ∞ xₜ) : S.EquationOfMotion xₜ ↔ (∀ t, S.m • ∂ₜ (∂ₜ xₜ) t = force S (xₜ t)) := by rw [EquationOfMotion, gradLagrangian_eq_force S xₜ hx, funext_iff] @@ -580,7 +617,8 @@ the equation of motion. -/ -lemma energy_conservation_of_equationOfMotion (xₜ : Time → Space 1) (hx : ContDiff ℝ ∞ xₜ) +lemma energy_conservation_of_equationOfMotion (xₜ : Time → ConfigurationSpace) + (hx : ContDiff ℝ ∞ xₜ) (h : S.EquationOfMotion xₜ) : ∂ₜ (S.energy xₜ) = 0 := by rw [energy_deriv _ _ hx] rw [equationOfMotion_iff_newtons_2nd_law _ _ hx] at h @@ -597,7 +635,8 @@ We prove that the energy is constant for any trajectory satisfying the equation -/ -lemma energy_conservation_of_equationOfMotion' (xₜ : Time → Space 1) (hx : ContDiff ℝ ∞ xₜ) +lemma energy_conservation_of_equationOfMotion' (xₜ : Time → ConfigurationSpace) + (hx : ContDiff ℝ ∞ xₜ) (h : S.EquationOfMotion xₜ) (t : Time) : S.energy xₜ t = S.energy xₜ 0 := by have h1 := S.energy_conservation_of_equationOfMotion xₜ hx h unfold Time.deriv at h1 @@ -633,8 +672,8 @@ the velocity. -/ /-- The equivalence between velocity and canonical momentum. -/ -noncomputable def toCanonicalMomentum (t : Time) (x : Space 1) : - EuclideanSpace ℝ (Fin 1) ≃ₗ[ℝ] EuclideanSpace ℝ (Fin 1) where +noncomputable def toCanonicalMomentum (t : Time) (x : ConfigurationSpace) : + ConfigurationSpace ≃ₗ[ℝ] ConfigurationSpace where toFun v := gradient (S.lagrangian t x ·) v invFun p := (1 / S.m) • p left_inv v := by @@ -655,7 +694,8 @@ An simple equality for the canonical momentum. -/ -lemma toCanonicalMomentum_eq (t : Time) (x : Space 1) (v : EuclideanSpace ℝ (Fin 1)) : +lemma toCanonicalMomentum_eq (t : Time) (x : ConfigurationSpace) + (v : ConfigurationSpace) : toCanonicalMomentum S t x v = S.m • v := by simp [toCanonicalMomentum, gradient_lagrangian_velocity_eq] @@ -672,7 +712,8 @@ where `v` is a function of `p` and `x` through the canonical momentum. -/ /-- The hamiltonian as a function of time, momentum and position. -/ -noncomputable def hamiltonian (t : Time) (p : EuclideanSpace ℝ (Fin 1)) (x : Space 1) : ℝ := +noncomputable def hamiltonian (t : Time) (p : ConfigurationSpace) + (x : ConfigurationSpace) : ℝ := ⟪p, (toCanonicalMomentum S t x).symm p⟫_ℝ - S.lagrangian t x ((toCanonicalMomentum S t x).symm p) /-! @@ -687,8 +728,9 @@ lemma hamiltonian_eq : hamiltonian S = fun _ p x => (1 / (2 : ℝ)) * (1 / S.m) * ⟪p, p⟫_ℝ + (1 / (2 : ℝ)) * S.k * ⟪x, x⟫_ℝ := by funext t x p - simp [hamiltonian, lagrangian_eq, toCanonicalMomentum, inner_smul_right, inner_smul_left] - have hm : S.m ≠ 0 := by exact m_neq_zero S + simp only [hamiltonian, toCanonicalMomentum, lagrangian_eq, one_div, LinearEquiv.coe_symm_mk', + inner_smul_right, inner_smul_left, map_inv₀, ringHom_apply] + have hm : S.m ≠ 0 := by exact m_ne_zero S field_simp ring @@ -703,7 +745,19 @@ We show that the Hamiltonian is smooth in all its arguments. @[fun_prop] lemma hamiltonian_contDiff (n : WithTop ℕ∞) : ContDiff ℝ n ↿S.hamiltonian := by rw [hamiltonian_eq] - fun_prop + apply ContDiff.add + · apply ContDiff.mul + · apply ContDiff.mul + · exact contDiff_const + · exact contDiff_const + · exact ContDiff.inner (𝕜 := ℝ) (contDiff_fst.comp contDiff_snd) + (contDiff_fst.comp contDiff_snd) + · apply ContDiff.mul + · apply ContDiff.mul + · exact contDiff_const + · exact contDiff_const + · exact ContDiff.inner (𝕜 := ℝ) (contDiff_snd.comp contDiff_snd) + (contDiff_snd.comp contDiff_snd) /-! @@ -713,37 +767,37 @@ We now write down the gradients of the Hamiltonian with respect to the momentum -/ -lemma gradient_hamiltonian_position_eq (t : Time) (x : Space 1) (p : EuclideanSpace ℝ (Fin 1)) : +lemma gradient_hamiltonian_position_eq (t : Time) (x : ConfigurationSpace) + (p : ConfigurationSpace) : gradient (hamiltonian S t p) x = S.k • x := by - rw [hamiltonian_eq] - simp only [one_div] - rw [← grad_eq_gradiant, grad_eq_sum] - simp [Space.deriv_eq_fderiv_basis] - rw [fderiv_const_mul (by fun_prop)] - simp [← Space.deriv_eq_fderiv_basis, deriv_eq_inner_self] - have hx : x = x 0 • basis 0 := by - ext i - fin_cases i - simp - rw [hx] - simp only [Fin.isValue, PiLp.smul_apply, basis_self, smul_eq_mul, mul_one] - module + have h_eq : (fun y : ConfigurationSpace => hamiltonian S t p y) = + fun y => ((1 / (2 : ℝ)) * S.k) * ⟪y, y⟫_ℝ + + ((1 / (2 : ℝ)) * (1 / S.m) * ⟪p, p⟫_ℝ) := by + funext y; unfold hamiltonian; simp only [toCanonicalMomentum, lagrangian, + potentialEnergy, LinearEquiv.coe_symm_mk', ConfigurationSpace.inner_def, + ConfigurationSpace.smul_val, smul_eq_mul] + have hm : S.m ≠ 0 := m_ne_zero S + field_simp + ring + change gradient (fun y : ConfigurationSpace => hamiltonian S t p y) x = S.k • x + rw [h_eq, gradient_add_const', gradient_const_mul_inner_self] + ext; simp only [ConfigurationSpace.smul_val]; ring -lemma gradient_hamiltonian_momentum_eq (t : Time) (x : Space 1) (p : EuclideanSpace ℝ (Fin 1)) : +lemma gradient_hamiltonian_momentum_eq (t : Time) (x : ConfigurationSpace) + (p : ConfigurationSpace) : gradient (hamiltonian S t · x) p = (1 / S.m) • p := by - rw [hamiltonian_eq] - simp only [one_div] - rw [← grad_eq_gradiant, grad_eq_sum] - simp [Space.deriv_eq_fderiv_basis] - rw [fderiv_const_mul (by fun_prop)] - simp [← Space.deriv_eq_fderiv_basis, deriv_eq_inner_self] - have hx : p = p 0 • basis 0 := by - ext i - fin_cases i - simp - rw [hx] - simp only [Fin.isValue, PiLp.smul_apply, basis_self, smul_eq_mul, mul_one] - module + have h_eq : (fun y : ConfigurationSpace => hamiltonian S t y x) = + fun y => ((1 / (2 : ℝ)) * (1 / S.m)) * ⟪y, y⟫_ℝ + + ((1 / (2 : ℝ)) * S.k * ⟪x, x⟫_ℝ) := by + funext y; unfold hamiltonian; simp only [toCanonicalMomentum, lagrangian, + potentialEnergy, LinearEquiv.coe_symm_mk', ConfigurationSpace.inner_def, + ConfigurationSpace.smul_val, smul_eq_mul] + have hm : S.m ≠ 0 := m_ne_zero S + field_simp + ring + change gradient (fun y : ConfigurationSpace => hamiltonian S t y x) p = (1 / S.m) • p + rw [h_eq, gradient_add_const', gradient_const_mul_inner_self] + ext; simp only [ConfigurationSpace.smul_val]; ring /-! @@ -754,13 +808,18 @@ This is independent of whether the trajectory satisfies the equations of motion -/ -lemma hamiltonian_eq_energy (xₜ : Time → Space 1) : +lemma hamiltonian_eq_energy (xₜ : Time → ConfigurationSpace) : (fun t => hamiltonian S t (toCanonicalMomentum S t (xₜ t) (∂ₜ xₜ t)) (xₜ t)) = energy S xₜ := by funext t - rw [hamiltonian] - simp [toCanonicalMomentum_eq, lagrangian, energy, kineticEnergy] - simp [toCanonicalMomentum, inner_smul_left] - ring + have hsymm : + (toCanonicalMomentum S t (xₜ t)).symm (S.m • ∂ₜ xₜ t) = ∂ₜ xₜ t := by + rw [← toCanonicalMomentum_eq (S := S) (t := t) (x := xₜ t) (v := ∂ₜ xₜ t)] + exact LinearEquiv.symm_apply_apply (toCanonicalMomentum S t (xₜ t)) (∂ₜ xₜ t) + unfold hamiltonian lagrangian energy kineticEnergy potentialEnergy + simp only [toCanonicalMomentum_eq, + ConfigurationSpace.inner_def, ConfigurationSpace.smul_val, one_div, smul_eq_mul] + rw [hsymm] + ring_nf /-! @@ -773,7 +832,8 @@ to Hamilton's equations. /-- The operator on the momentum-position phase-space whose vanishing is equivalent to the hamilton's equations between the momentum and position. -/ -noncomputable def hamiltonEqOp (p : Time → EuclideanSpace ℝ (Fin 1)) (q : Time → Space 1) := +noncomputable def hamiltonEqOp (p : Time → ConfigurationSpace) + (q : Time → ConfigurationSpace) := ClassicalMechanics.hamiltonEqOp (hamiltonian S) p q /-! @@ -785,14 +845,23 @@ to the vanishing of the Hamilton equation operator. -/ -lemma equationOfMotion_iff_hamiltonEqOp_eq_zero (xₜ : Time → Space 1) (hx : ContDiff ℝ ∞ xₜ) : - S.EquationOfMotion xₜ ↔ +lemma equationOfMotion_iff_hamiltonEqOp_eq_zero (xₜ : Time → ConfigurationSpace) + (hx : ContDiff ℝ ∞ xₜ) : S.EquationOfMotion xₜ ↔ hamiltonEqOp S (fun t => S.toCanonicalMomentum t (xₜ t) (∂ₜ xₜ t)) xₜ = 0 := by rw [hamiltonEqOp, hamiltonEqOp_eq_zero_iff_hamiltons_equations] simp [toCanonicalMomentum_eq, gradient_hamiltonian_momentum_eq, gradient_hamiltonian_position_eq] rw [equationOfMotion_iff_newtons_2nd_law _ _ hx] - conv_rhs => enter[t]; rw [Time.deriv_smul _ _ (by fun_prop)] - simp [force_eq_linear] + have hderiv_smul : ∀ t, ∂ₜ (fun t' => S.m • ∂ₜ xₜ t') t = S.m • ∂ₜ (∂ₜ xₜ) t := by + intro t + have hd : DifferentiableAt ℝ (∂ₜ xₜ) t := + (deriv_differentiable_of_contDiff xₜ hx).differentiableAt + calc + ∂ₜ (fun t' => S.m • ∂ₜ xₜ t') t + = fderiv ℝ (fun t' => S.m • ∂ₜ xₜ t') t 1 := rfl + _ = S.m • (fderiv ℝ (∂ₜ xₜ) t 1) := by + simpa using congrArg (fun L => L 1) (fderiv_const_smul (c := S.m) (f := ∂ₜ xₜ) hd) + _ = S.m • ∂ₜ (∂ₜ xₜ) t := rfl + simp [hderiv_smul, force_eq_linear] /-! @@ -807,7 +876,7 @@ We show that the following are equivalent statements for a smooth trajectory `x -/ -lemma equationOfMotion_tfae (xₜ : Time → Space 1) (hx : ContDiff ℝ ∞ xₜ) : +lemma equationOfMotion_tfae (xₜ : Time → ConfigurationSpace) (hx : ContDiff ℝ ∞ xₜ) : List.TFAE [S.EquationOfMotion xₜ, (∀ t, S.m • ∂ₜ (∂ₜ xₜ) t = force S (xₜ t)), hamiltonEqOp S (fun t => S.toCanonicalMomentum t (xₜ t) (∂ₜ xₜ t)) xₜ = 0, diff --git a/PhysLean/ClassicalMechanics/HarmonicOscillator/ConfigurationSpace.lean b/PhysLean/ClassicalMechanics/HarmonicOscillator/ConfigurationSpace.lean new file mode 100644 index 000000000..4ae1e08d3 --- /dev/null +++ b/PhysLean/ClassicalMechanics/HarmonicOscillator/ConfigurationSpace.lean @@ -0,0 +1,262 @@ +/- +Copyright (c) 2026 Nicola Bernini. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nicola Bernini +-/ +import Mathlib.Geometry.Manifold.Diffeomorph +import PhysLean.SpaceAndTime.Time.Basic +/-! +# Configuration space of the harmonic oscillator + +The configuration space is defined as a one-dimensional smooth manifold, +modeled on `ℝ`, with a chosen coordinate. +-/ + +namespace ClassicalMechanics + +namespace HarmonicOscillator + +/-- The configuration space of the harmonic oscillator. -/ +structure ConfigurationSpace where + /-- The underlying real coordinate. -/ + val : ℝ + +namespace ConfigurationSpace + +@[ext] +lemma ext {x y : ConfigurationSpace} (h : x.val = y.val) : x = y := by + cases x + cases y + simp at h + simp [h] + +/-! +## Algebraic and analytical structure +-/ + +instance : Zero ConfigurationSpace := { zero := ⟨0⟩ } + +instance : OfNat ConfigurationSpace 0 := { ofNat := ⟨0⟩ } + +@[simp] +lemma zero_val : (0 : ConfigurationSpace).val = 0 := rfl + +instance : Add ConfigurationSpace where + add x y := ⟨x.val + y.val⟩ + +@[simp] +lemma add_val (x y : ConfigurationSpace) : (x + y).val = x.val + y.val := rfl + +instance : Neg ConfigurationSpace where + neg x := ⟨-x.val⟩ + +@[simp] +lemma neg_val (x : ConfigurationSpace) : (-x).val = -x.val := rfl + +instance : Sub ConfigurationSpace where + sub x y := ⟨x.val - y.val⟩ + +@[simp] +lemma sub_val (x y : ConfigurationSpace) : (x - y).val = x.val - y.val := rfl + +instance : SMul ℝ ConfigurationSpace where + smul r x := ⟨r * x.val⟩ + +@[simp] +lemma smul_val (r : ℝ) (x : ConfigurationSpace) : (r • x).val = r * x.val := rfl + +instance : CoeFun ConfigurationSpace (fun _ => Fin 1 → ℝ) where + coe x := fun _ => x.val + +@[simp] +lemma apply_zero (x : ConfigurationSpace) : x 0 = x.val := rfl + +@[simp] +lemma apply_eq_val (x : ConfigurationSpace) (i : Fin 1) : x i = x.val := rfl + +instance : AddGroup ConfigurationSpace where + add_assoc x y z := by ext; simp [add_assoc] + zero_add x := by ext; simp [zero_add] + add_zero x := by ext; simp [add_zero] + neg_add_cancel x := by ext; simp [neg_add_cancel] + nsmul := nsmulRec + zsmul := zsmulRec + +instance : AddCommGroup ConfigurationSpace where + add_comm x y := by ext; simp [add_comm] + +instance : Module ℝ ConfigurationSpace where + one_smul x := by ext; simp + smul_add r x y := by ext; simp [mul_add] + smul_zero r := by ext; simp [mul_zero] + add_smul r s x := by ext; simp [add_mul] + mul_smul r s x := by ext; simp [mul_assoc] + zero_smul x := by ext; simp + +instance : Norm ConfigurationSpace where + norm x := ‖x.val‖ + +instance : Dist ConfigurationSpace where + dist x y := ‖x - y‖ + +lemma dist_eq_val (x y : ConfigurationSpace) : + dist x y = ‖x.val - y.val‖ := rfl + +instance : SeminormedAddCommGroup ConfigurationSpace where + dist_self x := by simp [dist_eq_val] + dist_comm x y := by + simpa [dist_eq_val, Real.dist_eq] using (dist_comm x.val y.val) + dist_triangle x y z := by + simpa [dist_eq_val, Real.dist_eq] using (dist_triangle x.val y.val z.val) + +instance : NormedAddCommGroup ConfigurationSpace where + eq_of_dist_eq_zero := by + intro a b h + ext + have h' : dist a.val b.val = 0 := by + simpa [dist_eq_val, Real.dist_eq] using h + exact dist_eq_zero.mp h' + +instance : NormedSpace ℝ ConfigurationSpace where + norm_smul_le r x := by + simp [norm, smul_val, abs_mul] + +open InnerProductSpace + +instance : Inner ℝ ConfigurationSpace where + inner x y := x.val * y.val + +@[simp] +lemma inner_def (x y : ConfigurationSpace) : ⟪x, y⟫_ℝ = x.val * y.val := rfl + +noncomputable instance : InnerProductSpace ℝ ConfigurationSpace where + norm_sq_eq_re_inner := by + intro x + have hx : ‖x‖ ^ 2 = x.val ^ 2 := by + simp [norm, sq_abs] + simpa [inner_def, pow_two] using hx + conj_inner_symm := by + intro x y + simp [inner_def] + ring + add_left := by + intro x y z + simp [inner_def, add_mul] + smul_left := by + intro x y r + simp [inner_def] + ring + +@[fun_prop] +lemma differentiable_inner_self : + Differentiable ℝ (fun x : ConfigurationSpace => ⟪x, x⟫_ℝ) := by + have h_id : Differentiable ℝ (fun x : ConfigurationSpace => x) := differentiable_id + simpa using (Differentiable.inner (𝕜:=ℝ) (f:=fun x : ConfigurationSpace => x) + (g:=fun x : ConfigurationSpace => x) h_id h_id) + +@[fun_prop] +lemma differentiableAt_inner_self (x : ConfigurationSpace) : + DifferentiableAt ℝ (fun y : ConfigurationSpace => ⟪y, y⟫_ℝ) x := by + have h_id : DifferentiableAt ℝ (fun y : ConfigurationSpace => y) x := differentiableAt_id + simpa using (DifferentiableAt.inner (𝕜:=ℝ) (f:=fun y : ConfigurationSpace => y) + (g:=fun y : ConfigurationSpace => y) h_id h_id) + +@[fun_prop] +lemma contDiff_inner_self (n : WithTop ℕ∞) : + ContDiff ℝ n (fun x : ConfigurationSpace => ⟪x, x⟫_ℝ) := by + have h_id : ContDiff ℝ n (fun x : ConfigurationSpace => x) := contDiff_id + simpa using (ContDiff.inner (𝕜:=ℝ) (f:=fun x : ConfigurationSpace => x) + (g:=fun x : ConfigurationSpace => x) h_id h_id) + +/-- Linear map sending a configuration space element to its underlying real value. -/ +noncomputable def toRealLM : ConfigurationSpace →ₗ[ℝ] ℝ := + { toFun := ConfigurationSpace.val + map_add' := by simp + map_smul' := by simp } + +/-- Linear map embedding a real value into the configuration space. -/ +noncomputable def fromRealLM : ℝ →ₗ[ℝ] ConfigurationSpace := + { toFun := fun x => ⟨x⟩ + map_add' := by + intro x y + ext + simp + map_smul' := by + intro r x + ext + simp } + +/-- Continuous linear map sending a configuration space element to its underlying real value. -/ +noncomputable def toRealCLM : ConfigurationSpace →L[ℝ] ℝ := + toRealLM.mkContinuous 1 (by + intro x + simp [toRealLM, norm]) + +/-- Continuous linear map embedding a real value into the configuration space. -/ +noncomputable def fromRealCLM : ℝ →L[ℝ] ConfigurationSpace := + fromRealLM.mkContinuous 1 (by + intro x + simp [fromRealLM, norm]) + +/-- Homeomorphism between configuration space and `ℝ` given by `ConfigurationSpace.val`. -/ +noncomputable def valHomeomorphism : ConfigurationSpace ≃ₜ ℝ where + toFun := ConfigurationSpace.val + invFun := fun t => ⟨t⟩ + left_inv := by + intro t + cases t + rfl + right_inv := by + intro t + rfl + continuous_toFun := by + simpa [toRealCLM, toRealLM] using toRealCLM.continuous + continuous_invFun := by + simpa [fromRealCLM, fromRealLM] using fromRealCLM.continuous + +/-- The structure of a charted space on `ConfigurationSpace`. -/ +noncomputable instance : ChartedSpace ℝ ConfigurationSpace where + atlas := { valHomeomorphism.toOpenPartialHomeomorph } + chartAt _ := valHomeomorphism.toOpenPartialHomeomorph + mem_chart_source := by + simp + chart_mem_atlas := by + intro x + simp + +open Manifold ContDiff + +/-- The structure of a smooth manifold on `ConfigurationSpace`. -/ +noncomputable instance : IsManifold 𝓘(ℝ, ℝ) ω ConfigurationSpace where + compatible := by + intro e1 e2 h1 h2 + simp [atlas, ChartedSpace.atlas] at h1 h2 + subst h1 h2 + exact symm_trans_mem_contDiffGroupoid valHomeomorphism.toOpenPartialHomeomorph + +instance : FiniteDimensional ℝ ConfigurationSpace := by + classical + refine FiniteDimensional.of_injective toRealLM ?_ + intro x y h + ext + simpa using h + +instance : CompleteSpace ConfigurationSpace := by + classical + simpa using (FiniteDimensional.complete ℝ ConfigurationSpace) + +/-! +## Map to space +-/ + +/-- The position in one-dimensional space associated to the configuration. -/ +def toSpace (q : ConfigurationSpace) : Space 1 := ⟨fun _ => q.val⟩ + +@[simp] +lemma toSpace_apply (q : ConfigurationSpace) (i : Fin 1) : q.toSpace i = q.val := rfl + +end ConfigurationSpace + +end HarmonicOscillator + +end ClassicalMechanics diff --git a/PhysLean/ClassicalMechanics/HarmonicOscillator/Solution.lean b/PhysLean/ClassicalMechanics/HarmonicOscillator/Solution.lean index 84a3323dc..276fab0d9 100644 --- a/PhysLean/ClassicalMechanics/HarmonicOscillator/Solution.lean +++ b/PhysLean/ClassicalMechanics/HarmonicOscillator/Solution.lean @@ -3,11 +3,7 @@ Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith, Lode Vermeulen -/ -import Mathlib.Algebra.Lie.OfAssociative import Mathlib.Analysis.CStarAlgebra.Classes -import Mathlib.Analysis.SpecialFunctions.Integrals.Basic -import Mathlib.Analysis.SpecialFunctions.PolarCoord -import Mathlib.Data.Real.StarOrdered import PhysLean.ClassicalMechanics.HarmonicOscillator.Basic import PhysLean.Units.Basic /-! @@ -58,7 +54,7 @@ References for the classical harmonic oscillator include: -/ namespace ClassicalMechanics -open Real Time +open Real Time ContDiff namespace HarmonicOscillator @@ -85,9 +81,9 @@ We start by defining the type of initial conditions for the harmonic oscillator. and an initial velocity. -/ structure InitialConditions where /-- The initial position of the harmonic oscillator. -/ - x₀ : Space 1 + x₀ : ConfigurationSpace /-- The initial velocity of the harmonic oscillator. -/ - v₀ : Space 1 + v₀ : ConfigurationSpace /-! @@ -111,17 +107,112 @@ lemma InitialConditions.ext {IC₁ IC₂ : InitialConditions} (h1 : IC₁.x₀ = ### A.2. Relation to other types of initial conditions We relate the initial condition given by an initial position and an initial velocity -to other specifications of initial conditions. This is currently not implemented, -and is a TODO. +to other specifications of initial conditions. + +In this section, we implement alternative ways to specify initial conditions for the harmonic +oscillator. The standard `InitialConditions` type specifies position and velocity at time `t=0`, +but in practice it is often useful to specify initial conditions at other times or in other forms. + +Currently implemented: +- **Initial conditions at arbitrary time**: Specify position and velocity at any time `t₀`, + not necessarily at `t=0`. + This is useful for problems where the natural reference time is not zero. + +Future work (to be added in separate PRs) : +- Initial conditions from two positions at different times +- Initial conditions from two velocities at different times +- Amplitude-phase parametrization + +All alternative forms can be converted to the standard `InitialConditions` type via conversion +functions, and we prove that the converted initial conditions produce trajectories that satisfy +the original specifications. + +-/ + +/-! + +#### A.2.1. Initial conditions at arbitrary time + +We define a type for initial conditions specified at an arbitrary time `t₀`, rather than at `t=0`. +This is useful when the natural reference point for a problem is not at time zero. + +-/ + +/-- Initial conditions for the harmonic oscillator specified at an arbitrary time `t₀`. + + This structure allows specifying the position and velocity at any time `t₀`, not necessarily + at `t=0`. This is useful for problems where the natural reference time is not zero. + + The conditions can be converted to the standard `InitialConditions` format (at `t=0`) + using the `toInitialConditions` function. -/ +structure InitialConditionsAtTime where + /-- The time at which the initial conditions are specified. -/ + t₀ : Time + /-- The position at time t₀. -/ + x_t₀ : ConfigurationSpace + /-- The velocity at time t₀. -/ + v_t₀ : ConfigurationSpace + +/-! + +##### A.2.1.1. Extensionality lemma + +We prove an extensionality lemma for `InitialConditionsAtTime`. -/ -TODO "6VZME" "Implement other initial condtions. For example: -- initial conditions at a given time. +@[ext] +lemma InitialConditionsAtTime.ext {IC₁ IC₂ : InitialConditionsAtTime} + (h1 : IC₁.t₀ = IC₂.t₀) (h2 : IC₁.x_t₀ = IC₂.x_t₀) (h3 : IC₁.v_t₀ = IC₂.v_t₀) : + IC₁ = IC₂ := by + cases IC₁ + cases IC₂ + simp_all + +/-! + +##### A.2.1.2. Conversion to standard initial conditions + +We now define the conversion from `InitialConditionsAtTime` to the standard `InitialConditions`. + +The conversion works by "running the trajectory backward in time" from `t₀` to `0`. +Given that we know `x(t₀)` and `v(t₀)`, we use the harmonic oscillator solution formula +with time-reversal to determine what `x(0)` and `v(0)` must have been. + +Mathematically, if `x(t) = cos(ωt)·x₀ + (sin(ωt)/ω)·v₀`, then setting `t = t₀`: + `x(t₀) = cos(ωt₀)·x₀ + (sin(ωt₀)/ω)·v₀` + `v(t₀) = -ω·sin(ωt₀)·x₀ + cos(ωt₀)·v₀` + +Solving this linear system for `x₀` and `v₀` gives the formulas below. + +-/ + +namespace InitialConditionsAtTime + +/-- Convert initial conditions at time `t₀` to standard initial conditions at `t=0`. + + This conversion uses the harmonic oscillator solution formula with time-reversal. + The resulting `InitialConditions` will produce a trajectory that passes through + `x_t₀` with velocity `v_t₀` at time `t₀`. + + See `toInitialConditions_trajectory_at_t₀` and `toInitialConditions_velocity_at_t₀` for + the correctness proofs. -/ +noncomputable def toInitialConditions (S : HarmonicOscillator) + (IC : InitialConditionsAtTime) : InitialConditions where + x₀ := cos (S.ω * IC.t₀) • IC.x_t₀ - (sin (S.ω * IC.t₀) / S.ω) • IC.v_t₀ + v₀ := S.ω • sin (S.ω * IC.t₀) • IC.x_t₀ + cos (S.ω * IC.t₀) • IC.v_t₀ + +/-! +The correctness proofs showing that the conversion produces the expected trajectory +are given later in section D.1, after the trajectory machinery has been defined. +-/ + +TODO "6VZME" "Implement other initial conditions (deferred to future PRs). For example: - Two positions at different times. - Two velocities at different times. -And convert them into the type `InitialConditions` above (which may need generalzing a bit -to make this possible)." +And convert them into the type `InitialConditions` above." + +end InitialConditionsAtTime /-! @@ -177,7 +268,7 @@ namespace InitialConditions -/ /-- Given initial conditions, the solution to the classical harmonic oscillator. -/ -noncomputable def trajectory (IC : InitialConditions) : Time → Space 1 := fun t => +noncomputable def trajectory (IC : InitialConditions) : Time → ConfigurationSpace := fun t => cos (S.ω * t) • IC.x₀ + (sin (S.ω * t)/S.ω) • IC.v₀ /-! @@ -216,15 +307,17 @@ lemma trajectory_contDiff (S : HarmonicOscillator) (IC : InitialConditions) {n : ContDiff ℝ n (IC.trajectory S) := by rw [trajectory_eq] apply ContDiff.add - apply ContDiff.smul _ contDiff_const - · change ContDiff ℝ _ (((fun x => cos x) ∘ (fun y => S.ω * y))∘ Time.toRealCLM) - refine ContDiff.comp_continuousLinearMap (ContDiff.comp contDiff_cos ?_) - fun_prop - apply ContDiff.smul _ contDiff_const - · have hx := contDiff_sin (n := n) - change ContDiff ℝ _ (((fun x => sin x / S.ω) ∘ (fun y => S.ω * y))∘ Time.toRealCLM) - refine ContDiff.comp_continuousLinearMap (ContDiff.comp ?_ ?_) + · apply fun_smul + · change ContDiff ℝ _ (((fun x => cos x) ∘ (fun y => S.ω * y))∘ Time.toRealCLM) + refine ContDiff.comp_continuousLinearMap (ContDiff.comp contDiff_cos ?_) + fun_prop · fun_prop + · have hx := contDiff_sin (n := n) + apply fun_smul + · change ContDiff ℝ _ (((fun x => sin x / S.ω) ∘ (fun y => S.ω * y))∘ Time.toRealCLM) + refine ContDiff.comp_continuousLinearMap (ContDiff.comp ?_ ?_) + · fun_prop + · fun_prop · fun_prop /-! @@ -239,7 +332,6 @@ lemma trajectory_velocity (IC : InitialConditions) : ∂ₜ (IC.trajectory S) = fun t : Time => - S.ω • sin (S.ω * t.val) • IC.x₀ + cos (S.ω * t.val) • IC.v₀ := by funext t rw [trajectory_eq, Time.deriv, fderiv_fun_add (by fun_prop) (by fun_prop)] - simp only rw [fderiv_smul_const (by fun_prop), fderiv_smul_const (by fun_prop)] have h1 : (fderiv ℝ (fun t => sin (S.ω * t.val) / S.ω) t) = (1/ S.ω) • (fderiv ℝ (fun t => sin (S.ω * t.val)) t) := by @@ -257,7 +349,7 @@ lemma trajectory_velocity (IC : InitialConditions) : ∂ₜ (IC.trajectory S) = field_simp ring_nf rw [← mul_smul, mul_rotate, NonUnitalRing.mul_assoc] - field_simp [mul_div_assoc, div_self, mul_one, S.ω_neq_zero] + field_simp [mul_div_assoc, div_self, mul_one, S.ω_ne_zero] /-! @@ -271,16 +363,15 @@ lemma trajectory_acceleration (IC : InitialConditions) : ∂ₜ (∂ₜ (IC.traj fun t : Time => - S.ω^2 • cos (S.ω * t.val) • IC.x₀ - S.ω • sin (S.ω * t.val) • IC.v₀ := by funext t rw [trajectory_velocity, Time.deriv, fderiv_fun_add (by fun_prop) (by fun_prop)] - simp only rw [fderiv_smul_const (by fun_prop), fderiv_fun_const_smul (by fun_prop), fderiv_smul_const (by fun_prop)] - simp only [neg_smul, ContinuousLinearMap.add_apply, ContinuousLinearMap.neg_apply, - ContinuousLinearMap.coe_smul', Pi.smul_apply, ContinuousLinearMap.smulRight_apply] + simp only [neg_smul, ContinuousLinearMap.add_apply, ContinuousLinearMap.smulRight_apply] rw [fderiv_cos (by fun_prop), fderiv_sin (by fun_prop), fderiv_fun_mul (by fun_prop) (by fun_prop)] field_simp [smul_smul] - simp only [fderiv_fun_const, Pi.zero_apply, smul_zero, add_zero, ContinuousLinearMap.coe_smul', - Pi.smul_apply, fderiv_val, smul_eq_mul, mul_one, neg_smul, ContinuousLinearMap.neg_apply] + simp only [fderiv_fun_const, Pi.ofNat_apply, smul_zero, add_zero, ContinuousLinearMap.neg_apply, + ContinuousLinearMap.coe_smul', Pi.smul_apply, ContinuousLinearMap.smulRight_apply, fderiv_val, + smul_eq_mul, mul_one, neg_smul] ring_nf module @@ -313,22 +404,20 @@ The trajectories satisfy the equation of motion for the harmonic oscillator. lemma trajectory_equationOfMotion (IC : InitialConditions) : EquationOfMotion S (IC.trajectory S) := by - rw [EquationOfMotion, gradLagrangian_eq_force] + have hcont : ContDiff ℝ ∞ (IC.trajectory S) := trajectory_contDiff S IC + rw [EquationOfMotion, gradLagrangian_eq_force (S := S) (xₜ := IC.trajectory S) hcont] funext t simp only [Pi.zero_apply] rw [trajectory_acceleration, force_eq_linear] - simp [trajectory_eq] - funext i - simp only [PiLp.sub_apply, PiLp.add_apply, PiLp.neg_apply, PiLp.smul_apply, smul_eq_mul, - PiLp.zero_apply] - rw [ω_sq] - have h : S.ω ≠ 0 := by exact ω_neq_zero S - field_simp - ring_nf - rw [ω_sq] - field_simp - simp only [neg_add_cancel, mul_zero] - fun_prop + ext + have hω : S.ω ≠ 0 := ω_ne_zero S + have hωm : S.ω ^ 2 * S.m = S.k := by + rw [ω_sq] + field_simp [m_ne_zero S] + simp [trajectory_eq, smul_add, smul_smul, mul_comm, mul_left_comm] + rw [← hωm] + field_simp [hω] + ring /-! @@ -344,10 +433,179 @@ for the given initial conditions. This is currently a TODO. Semiformal implementation: - One may needed the added condition of smoothness on `x` here. - `EquationOfMotion` needs defining before this can be proved. -/ -@[sorryful] -lemma trajectories_unique (IC : InitialConditions) (x : Time → Space 1) : +lemma trajectories_unique (IC : InitialConditions) (x : Time → ConfigurationSpace) + (hx : ContDiff ℝ ∞ x) : S.EquationOfMotion x ∧ x 0 = IC.x₀ ∧ ∂ₜ x 0 = IC.v₀ → - x = IC.trajectory S := by sorry + x = IC.trajectory S := by + intro h + rcases h with ⟨hEOM, hx0, hv0⟩ + + -- Newton form for x + have hNewt_x : + ∀ t, S.m • ∂ₜ (∂ₜ x) t = force S (x t) := + (S.equationOfMotion_iff_newtons_2nd_law (xₜ := x) hx).1 hEOM + + -- Newton form for the explicit trajectory + have hTrajContDiff : ContDiff ℝ ∞ (IC.trajectory S) := by + -- trajectory_contDiff already exists and is [fun_prop] + fun_prop + + have hNewt_traj : + ∀ t, S.m • ∂ₜ (∂ₜ (IC.trajectory S)) t = force S ((IC.trajectory S) t) := + (S.equationOfMotion_iff_newtons_2nd_law (xₜ := IC.trajectory S) hTrajContDiff).1 + (trajectory_equationOfMotion S IC) + + -- Define the difference y = x - traj + set y : Time → ConfigurationSpace := fun t => x t - IC.trajectory S t with hydef + + have hyContDiff : ContDiff ℝ ∞ y := by + -- ContDiff closed under subtraction + simpa [hydef] using hx.sub hTrajContDiff + + -- First derivative of y + have hy_deriv : ∂ₜ y = fun t => ∂ₜ x t - ∂ₜ (IC.trajectory S) t := by + funext t + -- same style as in trajectory_velocity: unfold Time.deriv and use fderiv_fun_sub + rw [hydef, Time.deriv] + -- ContDiff implies DifferentiableAt - use this explicitly since fun_prop can't infer it + -- ContDiff ℝ ∞ f implies ContDiffAt ℝ ∞ f t for any t + have hx_contDiffAt : ContDiffAt ℝ ∞ x t := hx.contDiffAt + have htraj_contDiffAt : ContDiffAt ℝ ∞ (IC.trajectory S) t := hTrajContDiff.contDiffAt + have hx_diff : DifferentiableAt ℝ x t := + ContDiffAt.differentiableAt hx_contDiffAt (by simp) + have htraj_diff : DifferentiableAt ℝ (IC.trajectory S) t := + ContDiffAt.differentiableAt htraj_contDiffAt (by simp) + rw [fderiv_fun_sub hx_diff htraj_diff] + simp only [ContinuousLinearMap.sub_apply, Time.deriv] + + -- Second derivative of y + have hy_deriv2 : + ∂ₜ (∂ₜ y) = fun t => ∂ₜ (∂ₜ x) t - ∂ₜ (∂ₜ (IC.trajectory S)) t := by + funext t + rw [hy_deriv, Time.deriv] + -- now differentiate (∂ₜ x - ∂ₜ traj) + -- use differentiability of time-derivatives from ContDiff + have hx1 : Differentiable ℝ (fun t => ∂ₜ x t) := + deriv_differentiable_of_contDiff x hx + have htr1 : Differentiable ℝ (fun t => ∂ₜ (IC.trajectory S) t) := + deriv_differentiable_of_contDiff (IC.trajectory S) hTrajContDiff + -- Apply fderiv_fun_sub and use Time.deriv to convert back + -- Differentiable ℝ f means ∀ x, DifferentiableAt ℝ f x + -- In Mathlib, Differentiable is defined as ∀ x, DifferentiableAt, so we can apply directly + have hx1_at : DifferentiableAt ℝ (fun t => ∂ₜ x t) t := hx1 t + have htr1_at : DifferentiableAt ℝ (fun t => ∂ₜ (IC.trajectory S) t) t := htr1 t + rw [fderiv_fun_sub hx1_at htr1_at] + -- Now we need to show fderiv of (fun t => fderiv ℝ x t 1) equals fderiv of (∂ₜ x) + -- This follows from Time.deriv f t = fderiv ℝ f t 1 + simp only [ContinuousLinearMap.sub_apply] + rw [Time.deriv, Time.deriv] + + -- Newton form for y (linearity of force) + have hNewt_y : ∀ t, S.m • ∂ₜ (∂ₜ y) t = force S (y t) := by + intro t + have hy2t : ∂ₜ (∂ₜ y) t = + (∂ₜ (∂ₜ x) t - ∂ₜ (∂ₜ (IC.trajectory S)) t) := by + simpa using congrFun hy_deriv2 t + + -- Expand and substitute Newton laws for x and traj, then fold back using force_eq_linear + calc + S.m • ∂ₜ (∂ₜ y) t + = S.m • (∂ₜ (∂ₜ x) t - ∂ₜ (∂ₜ (IC.trajectory S)) t) := by + simp [hy2t] + _ = (S.m • ∂ₜ (∂ₜ x) t) - (S.m • ∂ₜ (∂ₜ (IC.trajectory S)) t) := by + simp [smul_sub] + _ = force S (x t) - force S ((IC.trajectory S) t) := by + simp [hNewt_x t, hNewt_traj t] + _ = force S (y t) := by + -- force = -k•x, so it is linear: force(x) - force(traj) = force(x-traj) + -- and y t = x t - traj t by definition + simp [hydef, force_eq_linear, smul_sub] + + -- Turn Newton form back into EquationOfMotion for y + have hEOM_y : S.EquationOfMotion y := + (S.equationOfMotion_iff_newtons_2nd_law (xₜ := y) hyContDiff).2 hNewt_y + + -- Initial conditions for y are zero + have hy0 : y 0 = 0 := by + -- y 0 = x 0 - traj 0 = IC.x₀ - IC.x₀ + simp [hydef, hx0] + + have hyv0 : ∂ₜ y 0 = 0 := by + -- ∂ₜ y 0 = ∂ₜ x 0 - ∂ₜ traj 0 = IC.v₀ - IC.v₀ + rw [congr_fun hy_deriv 0] + rw [hv0, trajectory_velocity_at_zero S IC] + simp + + -- Energy at time 0 is 0 + have hE0 : S.energy y 0 = 0 := by + -- unfold energy, kinetic, potential and use hy0, hyv0 + simp [HarmonicOscillator.energy, HarmonicOscillator.kineticEnergy, + HarmonicOscillator.potentialEnergy, hy0, hyv0, one_div, smul_eq_mul] + + -- Energy is constant, hence always 0 + have hE : ∀ t, S.energy y t = 0 := by + intro t + have ht := S.energy_conservation_of_equationOfMotion' (xₜ := y) hyContDiff hEOM_y t + simpa [hE0] using ht + + -- From energy=0 and positivity => y(t)=0 + have hy_all : ∀ t, y t = 0 := by + intro t + have hEt : S.energy y t = 0 := hE t + + have hk_nonneg : 0 ≤ S.kineticEnergy y t := by + unfold HarmonicOscillator.kineticEnergy + have hcoeff : 0 ≤ (1 / (2 : ℝ)) * S.m := by + exact mul_nonneg (by norm_num) (le_of_lt S.m_pos) + -- Use the same approach as for potential energy below + have hin : 0 ≤ inner ℝ (∂ₜ y t) (∂ₜ y t) := by + -- For EuclideanSpace ℝ (Fin 1), inner product with itself is nonnegative + exact real_inner_self_nonneg (x := ∂ₜ y t) + exact mul_nonneg hcoeff hin + + have hp_nonneg : 0 ≤ S.potentialEnergy (y t) := by + unfold HarmonicOscillator.potentialEnergy + -- potentialEnergy = (1/2) * k * ⟪y,y⟫ + simp only [one_div, smul_eq_mul] + -- Goal is 0 ≤ 2⁻¹ * (S.k * inner ℝ (y t) (y t)) + apply mul_nonneg + · norm_num -- 0 ≤ 2⁻¹ + · -- 0 ≤ S.k * inner ℝ (y t) (y t) + have hk_pos : 0 ≤ S.k := le_of_lt S.k_pos + have hin : 0 ≤ inner ℝ (y t) (y t) := by + -- For EuclideanSpace ℝ (Fin 1), inner product with itself is nonnegative + exact real_inner_self_nonneg (x := y t) + exact mul_nonneg hk_pos hin + + have hp_le : S.potentialEnergy (y t) ≤ S.energy y t := by + unfold HarmonicOscillator.energy + exact le_add_of_nonneg_left hk_nonneg + + have hp0 : S.potentialEnergy (y t) = 0 := by + have : S.potentialEnergy (y t) ≤ 0 := by + calc + S.potentialEnergy (y t) ≤ S.energy y t := hp_le + _ = 0 := hEt + exact le_antisymm this hp_nonneg + + -- extract ⟪y,y⟫ = 0 from potentialEnergy = 0, then y=0 + have hy_inner0 : inner ℝ (y t) (y t) = 0 := by + -- potentialEnergy = (1/2) * k * ⟪y,y⟫ + have hmul : ((1 / (2 : ℝ)) * S.k) * inner ℝ (y t) (y t) = 0 := by + simpa [HarmonicOscillator.potentialEnergy, one_div, smul_eq_mul, mul_assoc] using hp0 + have hcoeff : ((1 / (2 : ℝ)) * S.k) ≠ 0 := by + exact mul_ne_zero (by norm_num) (S.k_ne_zero) + rcases mul_eq_zero.mp hmul with hcoeff0 | hinner + · exact (False.elim (hcoeff hcoeff0)) + · exact hinner + + exact (inner_self_eq_zero.mp hy_inner0) + + -- Conclude x = traj + funext t + have : y t = 0 := hy_all t + -- y t = x t - traj t + simpa [hydef] using (sub_eq_zero.mp this) /-! @@ -362,9 +620,68 @@ lemma trajectory_energy (IC : InitialConditions) : S.energy (IC.trajectory S) = fun _ => 1/2 * (S.m * ‖IC.v₀‖ ^2 + S.k * ‖IC.x₀‖ ^ 2) := by funext t rw [energy_conservation_of_equationOfMotion' _ _ (by fun_prop) (trajectory_equationOfMotion S IC)] - simp [energy, kineticEnergy, potentialEnergy, real_inner_self_eq_norm_sq] + simp [energy, kineticEnergy, potentialEnergy] ring +end InitialConditions + +/-! + +## D.1. Correctness of InitialConditionsAtTime conversion + +We now prove the correctness lemmas for the `InitialConditionsAtTime.toInitialConditions` +conversion function. These show that the conversion produces a trajectory that passes through +the specified position and velocity at the specified time. + +-/ + +namespace InitialConditionsAtTime + +/-- The trajectory resulting from `toInitialConditions` passes through the specified + position `x_t₀` at time `t₀`. -/ +@[simp] +lemma toInitialConditions_trajectory_at_t₀ (S : HarmonicOscillator) + (IC : InitialConditionsAtTime) : + (IC.toInitialConditions S).trajectory S IC.t₀ = IC.x_t₀ := by + rw [InitialConditions.trajectory_eq, toInitialConditions] + ext + simp only [ConfigurationSpace.add_val, ConfigurationSpace.smul_val, ConfigurationSpace.sub_val] + have h1 : cos (S.ω * IC.t₀.val) ^ 2 + sin (S.ω * IC.t₀.val) ^ 2 = 1 := + cos_sq_add_sin_sq (S.ω * IC.t₀.val) + field_simp [S.ω_ne_zero] + linear_combination S.ω * IC.x_t₀.val * h1 + +/-- The trajectory resulting from `toInitialConditions` has the specified + velocity `v_t₀` at time `t₀`. -/ +@[simp] +lemma toInitialConditions_velocity_at_t₀ (S : HarmonicOscillator) + (IC : InitialConditionsAtTime) : + ∂ₜ ((IC.toInitialConditions S).trajectory S) IC.t₀ = IC.v_t₀ := by + rw [InitialConditions.trajectory_velocity, toInitialConditions] + ext + simp only [ConfigurationSpace.add_val, ConfigurationSpace.smul_val, ConfigurationSpace.sub_val, + neg_mul] + have h1 : cos (S.ω * IC.t₀.val) ^ 2 + sin (S.ω * IC.t₀.val) ^ 2 = 1 := + cos_sq_add_sin_sq (S.ω * IC.t₀.val) + field_simp [S.ω_ne_zero] + linear_combination IC.v_t₀.val * h1 + +/-- The energy of the trajectory at time `t₀` equals the energy computed from the + initial conditions at `t₀`. -/ +lemma toInitialConditions_energy_at_t₀ (S : HarmonicOscillator) + (IC : InitialConditionsAtTime) : + S.energy ((IC.toInitialConditions S).trajectory S) IC.t₀ = + 1/2 * (S.m * ‖IC.v_t₀‖^2 + S.k * ‖IC.x_t₀‖^2) := by + unfold energy kineticEnergy potentialEnergy + simp only [toInitialConditions_trajectory_at_t₀, toInitialConditions_velocity_at_t₀] + rw [real_inner_self_eq_norm_sq, real_inner_self_eq_norm_sq] + simp only [smul_eq_mul] + ring + +end InitialConditionsAtTime + +namespace InitialConditions + /-! ## E. The trajectories at zero velocity @@ -389,14 +706,13 @@ lemma tan_time_eq_of_trajectory_velocity_eq_zero (IC : InitialConditions) (t : T tan (S.ω * t) = IC.v₀ 0 / (S.ω * IC.x₀ 0) := by rw [trajectory_velocity] at h simp at h - have hx : S.ω ≠ 0 := by exact ω_neq_zero S + have hx : S.ω ≠ 0 := by exact ω_ne_zero S by_cases h1 : IC.x₀ ≠ 0 by_cases h2 : IC.v₀ ≠ 0 have h1' : IC.x₀ 0 ≠ 0 := by intro hn apply h1 - funext i - fin_cases i + ext simp [hn] have hcos : cos (S.ω * t.val) ≠ 0 := by by_contra hn @@ -408,10 +724,10 @@ lemma tan_time_eq_of_trajectory_velocity_eq_zero (IC : InitialConditions) (t : T trans (sin (S.ω * t.val) * (S.ω * IC.x₀ 0)) + (-(S.ω • sin (S.ω * t.val) • IC.x₀) + cos (S.ω * t.val) • IC.v₀) 0 · rw [h] - simp only [Fin.isValue, PiLp.zero_apply, add_zero] - ring - · simp - ring + simp only [ConfigurationSpace.zero_val] + ring_nf + · simp only [ConfigurationSpace.add_val, ConfigurationSpace.smul_val, ConfigurationSpace.neg_val] + ring_nf simp at h2 rw [h2] at h ⊢ simp_all @@ -433,25 +749,22 @@ the time `arctan (IC.v₀ 0 / (S.ω * IC.x₀ 0)) / S.ω` the velocity is zero. lemma trajectory_velocity_eq_zero_at_arctan (IC : InitialConditions) (hx : IC.x₀ ≠ 0) : (∂ₜ (IC.trajectory S)) (arctan (IC.v₀ 0 / (S.ω * IC.x₀ 0)) / S.ω) = 0 := by rw [trajectory_velocity] - simp only [Fin.isValue, neg_smul] - have hx' : S.ω ≠ 0 := by exact ω_neq_zero S + simp [neg_smul] + have hx' : S.ω ≠ 0 := by exact ω_ne_zero S field_simp rw [Real.sin_arctan, Real.cos_arctan] - funext i - fin_cases i - simp only [Fin.isValue, one_div, Fin.zero_eta, PiLp.add_apply, PiLp.neg_apply, PiLp.smul_apply, - smul_eq_mul, PiLp.zero_apply] + ext + simp [one_div] trans (-(S.ω * (IC.v₀ 0 / (S.ω * IC.x₀ 0) * IC.x₀ 0)) + IC.v₀ 0) * (√(1 + (IC.v₀ 0 / (S.ω * IC.x₀ 0)) ^ 2))⁻¹ · ring - simp only [Fin.isValue, mul_eq_zero, inv_eq_zero] + simp [mul_eq_zero, inv_eq_zero] left field_simp have hx : IC.x₀ 0 ≠ 0 := by intro hn apply hx - funext i - fin_cases i + ext simp [hn] field_simp ring @@ -470,7 +783,7 @@ lemma trajectory_velocity_eq_zero_iff (IC : InitialConditions) (t : Time) : ‖(IC.trajectory S) t‖ = √(‖IC.x₀‖^2 + (‖IC.v₀‖/S.ω)^2) := by have := by exact energy_eq S (trajectory S IC) have h_energy_t := congrFun this t - simp [kineticEnergy_eq, potentialEnergy_eq] at h_energy_t + simp only [kineticEnergy_eq, one_div, potentialEnergy_eq, smul_eq_mul] at h_energy_t rw [real_inner_self_eq_norm_sq (trajectory S IC t)] at h_energy_t have := by exact trajectory_energy S IC have h_init := congrFun this t @@ -493,7 +806,7 @@ lemma trajectory_velocity_eq_zero_iff (IC : InitialConditions) (t : Time) : · rw [mul_one, inv_eq_one_div S.k, mul_assoc] rw [mul_one_div S.m S.k, ← inverse_ω_sq] ring - · exact k_neq_zero S + · exact k_ne_zero S · intro h_norm apply norm_eq_zero.mp rw [real_inner_self_eq_norm_sq (∂ₜ (trajectory S IC) t)] at h_energy_t @@ -535,7 +848,7 @@ lemma trajectory_velocity_eq_zero_iff (IC : InitialConditions) (t : Time) : _ = (1 / S.m) * (S.m * ‖IC.v₀‖ ^ 2) - (1 / S.m) * (S.k * (‖IC.v₀‖ / S.ω) ^ 2) := by rw [mul_sub (1 / S.m) (S.m * ‖IC.v₀‖ ^ 2) (S.k * (‖IC.v₀‖ / S.ω) ^ 2)] _ = ‖IC.v₀‖ ^ 2 - (S.k / S.m) * (‖IC.v₀‖ / S.ω) ^ 2 := by - simp only [one_div, ne_eq, m_neq_zero, not_false_eq_true, inv_mul_cancel_left₀, + simp only [one_div, ne_eq, m_ne_zero, not_false_eq_true, inv_mul_cancel_left₀, sub_right_inj] rw [← mul_assoc, inv_mul_eq_div S.m S.k] rw [← ω_sq, div_pow ‖IC.v₀‖ S.ω 2] at h₃ @@ -544,7 +857,7 @@ lemma trajectory_velocity_eq_zero_iff (IC : InitialConditions) (t : Time) : rw [sq_eq_zero_iff] at h₃ exact h₃ rw [pow_ne_zero_iff ?_] - apply ω_neq_zero + apply ω_ne_zero exact Ne.symm (Nat.zero_ne_add_one 1) /-! diff --git a/PhysLean/ClassicalMechanics/Lagrangian/TotalDerivativeEquivalence.lean b/PhysLean/ClassicalMechanics/Lagrangian/TotalDerivativeEquivalence.lean new file mode 100644 index 000000000..a3f2679bc --- /dev/null +++ b/PhysLean/ClassicalMechanics/Lagrangian/TotalDerivativeEquivalence.lean @@ -0,0 +1,165 @@ +/- +Copyright (c) 2025 Rein Zustand. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rein Zustand +-/ +import PhysLean.Mathematics.VariationalCalculus.HasVarGradient +/-! + +# Equivalent Lagrangians under Total Derivatives + +## i. Overview + +Two Lagrangians are physically equivalent if they differ by a total time derivative +d/dt F(q, t). This is because the Euler-Lagrange equations depend only on extremizing +the action integral, and total derivatives don't affect which paths are extremal. + +This module defines the key concept of a function being a total time derivative, +which is essential for analyzing symmetries like Galilean invariance. + +Note: Some authors call this "gauge equivalence" by analogy with gauge transformations +in field theory, but we avoid that terminology here since no gauge fields are involved. + +## ii. Key insight + +A general function δL(r, v, t) is a total time derivative if there exists a function +F(r, t) (independent of velocity) such that: + δL(r, v, t) = d/dt F(r, t) = fderiv ℝ F (r, t) (v, 1) + +By the chain rule, this expands to: + δL(r, v, t) = ∂F/∂t + ⟨∇ᵣF, v⟩ + +For the special case where δL depends only on velocity v (not position or time), +this implies a strong constraint: + δL(v) = ⟨g, v⟩ for some constant vector g + +This is because: +1. d/dt F(r, t) = ∂F/∂t + ⟨∇F, v⟩ +2. For δL to be r-independent, ∇F must be r-independent +3. For δL to be t-independent, the time-dependent part must vanish +4. The result is δL = ⟨g, v⟩ for constant g + +## iii. Key definitions + +- `IsTotalTimeDerivative`: General case for δL(r, v, t) +- `IsTotalTimeDerivativeVelocity`: Velocity-only case, equivalent to δL(v) = ⟨g, v⟩ + +## iv. References + +- Landau & Lifshitz, "Mechanics", §2 (The principle of least action) +- Landau & Lifshitz, "Mechanics", §4 (The Lagrangian for a free particle) + +-/ + +namespace ClassicalMechanics + +open InnerProductSpace + +namespace Lagrangian + +/-! + +## A. General Total Time Derivative + +-/ + +/-- A function δL(r, v, t) is a total time derivative if it can be written as d/dt F(r, t) + for some function F that depends on position and time but not velocity. + + Mathematically: δL(r, v, t) = fderiv ℝ F (r, t) (v, 1) + + By the chain rule, this equals ∂F/∂t(r, t) + ⟨∇ᵣF(r, t), v⟩. + + This is the most general form of Lagrangian equivalence under total derivatives. + The key point is that F must be independent of velocity. -/ +def IsTotalTimeDerivative {n : ℕ} + (δL : EuclideanSpace ℝ (Fin n) → EuclideanSpace ℝ (Fin n) → ℝ → ℝ) : Prop := + ∃ (F : EuclideanSpace ℝ (Fin n) × ℝ → ℝ) (_ : Differentiable ℝ F), + ∀ r v t, δL r v t = fderiv ℝ F (r, t) (v, 1) + +/-! + +## B. Velocity-Only Total Time Derivative + +When δL depends only on velocity (the free particle case), the condition simplifies. + +-/ + +/-- A velocity-only function that is a total time derivative must be linear in velocity. + + If δL depends only on velocity and equals d/dt F(r, t) for some F, + then δL(v) = ⟨g, v⟩ for some constant vector g. + + This characterization comes from the requirement that: + - d/dt F(r, t) = ∂F/∂t + ⟨∇F, ṙ⟩ = ∂F/∂t + ⟨∇F, v⟩ + - For the result to be independent of r and t, we need ∇F = g (constant) and ∂F/∂t = 0 + - Thus δL(v) = ⟨g, v⟩ + + WLOG, we assume `δL 0 = 0` since constants are total derivatives (c = d/dt(c·t)) + and can be absorbed without affecting the equations of motion. -/ +lemma isTotalTimeDerivativeVelocity {n : ℕ} + (δL : EuclideanSpace ℝ (Fin n) → ℝ) + (hδL0 : δL 0 = 0) + (h : IsTotalTimeDerivative (fun _ v _ => δL v)) : + ∃ g : EuclideanSpace ℝ (Fin n), ∀ v, δL v = ⟪g, v⟫_ℝ := by + classical + rcases h with ⟨F, hFdiff, hEq⟩ + + -- Derivative of F at (0,0) + let dF : (EuclideanSpace ℝ (Fin n) × ℝ) →L[ℝ] ℝ := + fderiv ℝ F ((0 : EuclideanSpace ℝ (Fin n)), (0 : ℝ)) + + -- The "time-direction" derivative must vanish because δL 0 = 0. + have h_time : dF ((0 : EuclideanSpace ℝ (Fin n)), (1 : ℝ)) = 0 := by + have h0 : + δL (0 : EuclideanSpace ℝ (Fin n)) = + fderiv ℝ F ((0 : EuclideanSpace ℝ (Fin n)), (0 : ℝ)) + ((0 : EuclideanSpace ℝ (Fin n)), (1 : ℝ)) := by + simpa using (hEq (0 : EuclideanSpace ℝ (Fin n)) + (0 : EuclideanSpace ℝ (Fin n)) (0 : ℝ)) + have : dF ((0 : EuclideanSpace ℝ (Fin n)), (1 : ℝ)) = + δL (0 : EuclideanSpace ℝ (Fin n)) := by + simpa [dF] using h0.symm + simpa [hδL0] using this + + -- Induced continuous linear functional on velocity: v ↦ dF (v,0). + let φ : (EuclideanSpace ℝ (Fin n)) →L[ℝ] ℝ := + dF.comp (ContinuousLinearMap.inl ℝ (EuclideanSpace ℝ (Fin n)) ℝ) + + -- Show δL v = φ v for all v. + have hφ : ∀ v : EuclideanSpace ℝ (Fin n), δL v = φ v := by + intro v + have hv : + δL v = + fderiv ℝ F ((0 : EuclideanSpace ℝ (Fin n)), (0 : ℝ)) + (v, (1 : ℝ)) := by + simpa using (hEq (0 : EuclideanSpace ℝ (Fin n)) v (0 : ℝ)) + have hv' : δL v = dF (v, (1 : ℝ)) := by + simpa [dF] using hv + calc + δL v = dF (v, (1 : ℝ)) := hv' + _ = dF ((v, (0 : ℝ)) + ((0 : EuclideanSpace ℝ (Fin n)), (1 : ℝ))) := by + simp + _ = dF (v, (0 : ℝ)) + dF ((0 : EuclideanSpace ℝ (Fin n)), (1 : ℝ)) := by + simpa using + (dF.map_add (v, (0 : ℝ)) ((0 : EuclideanSpace ℝ (Fin n)), (1 : ℝ))) + _ = dF (v, (0 : ℝ)) := by + simp [h_time] + _ = φ v := by + simp [φ] + + -- Frechet–Riesz: represent φ as inner product with some g. + refine ⟨(InnerProductSpace.toDual ℝ (EuclideanSpace ℝ (Fin n))).symm φ, ?_⟩ + intro v + have hinner : + ⟪(InnerProductSpace.toDual ℝ (EuclideanSpace ℝ (Fin n))).symm φ, v⟫_ℝ = φ v := by + rw [InnerProductSpace.toDual_symm_apply (𝕜 := ℝ) + (E := EuclideanSpace ℝ (Fin n)) (x := v) (y := φ)] + calc + δL v = φ v := hφ v + _ = ⟪(InnerProductSpace.toDual ℝ (EuclideanSpace ℝ (Fin n))).symm φ, v⟫_ℝ := by + rw [hinner.symm] + +end Lagrangian + +end ClassicalMechanics diff --git a/PhysLean/ClassicalMechanics/Mass/MassUnit.lean b/PhysLean/ClassicalMechanics/Mass/MassUnit.lean index 92e2ee79c..4eee024bd 100644 --- a/PhysLean/ClassicalMechanics/Mass/MassUnit.lean +++ b/PhysLean/ClassicalMechanics/Mass/MassUnit.lean @@ -5,7 +5,6 @@ Authors: Joseph Tooby-Smith -/ import Mathlib.Geometry.Manifold.Diffeomorph import PhysLean.SpaceAndTime.Time.Basic -import PhysLean.Meta.TODO.Basic /-! # Units on Mass @@ -19,8 +18,8 @@ positive reals. On `MassUnit` there is an instance of division giving a real number, corresponding to the ratio of the two scales of mass unit. -To define specific mass units, we first axiomise the existence of a -a given mass unit, and then construct all other mass units from it. We choose to axiomise the +To define specific mass units, we first state the existence of a +a given mass unit, and then construct all other mass units from it. We choose to state the existence of the mass unit of kilograms, and construct all other mass units from that. -/ @@ -37,7 +36,7 @@ structure MassUnit where namespace MassUnit @[simp] -lemma val_neq_zero (x : MassUnit) : x.val ≠ 0 := by +lemma val_ne_zero (x : MassUnit) : x.val ≠ 0 := by exact Ne.symm (ne_of_lt x.property) lemma val_pos (x : MassUnit) : 0 < x.val := x.property @@ -58,7 +57,7 @@ lemma div_eq_val (x y : MassUnit) : x / y = (⟨x.val / y.val, div_nonneg (le_of_lt x.val_pos) (le_of_lt y.val_pos)⟩ : ℝ≥0) := rfl @[simp] -lemma div_neq_zero (x y : MassUnit) : ¬ x / y = (0 : ℝ≥0) := by +lemma div_ne_zero (x y : MassUnit) : ¬ x / y = (0 : ℝ≥0) := by rw [div_eq_val] refine coe_ne_zero.mp ?_ simp @@ -67,12 +66,12 @@ lemma div_neq_zero (x y : MassUnit) : ¬ x / y = (0 : ℝ≥0) := by lemma div_pos (x y : MassUnit) : (0 : ℝ≥0) < x/ y := by apply lt_of_le_of_ne · exact zero_le (x / y) - · exact Ne.symm (div_neq_zero x y) + · exact Ne.symm (div_ne_zero x y) @[simp] lemma div_self (x : MassUnit) : x / x = (1 : ℝ≥0) := by - simp [div_eq_val, x.val_neq_zero] + simp [div_eq_val, x.val_ne_zero] lemma div_symm (x y : MassUnit) : x / y = (y / x)⁻¹ := NNReal.eq <| by @@ -129,16 +128,16 @@ lemma scale_scale (x : MassUnit) (r1 r2 : ℝ) (hr1 : 0 < r1) (hr2 : 0 < r2) : ## Specific choices of mass units -To define a specific mass units, we must first axiomise the existence of a -a given mass unit, and then construct all other mass units from it. -We choose to axiomise the existence of the mass unit of kilograms. - -We need an axiom since this relates something to something in the physical world. +To define a specific mass units. +We first define the notion of a kilogram to correspond to the mass unit with underlying value +equal to `1`. This is really down to a choice in the isomorphism between the set of metrics +on the mass manifold and the positive reals. +From this choice of kilograms, we can define other length units by scaling kilograms. -/ -/-- The axiom corresponding to the definition of a mass unit of kilograms. -/ -axiom kilograms : MassUnit +/-- The definition of a mass unit of kilograms. -/ +def kilograms : MassUnit := ⟨1, by norm_num⟩ /-- The mass unit of a microgram (10^(-9) of a kilogram). -/ noncomputable def micrograms : MassUnit := scale ((1/10) ^ 9) kilograms diff --git a/PhysLean/ClassicalMechanics/Pendulum/CoplanarDoublePendulum.lean b/PhysLean/ClassicalMechanics/Pendulum/CoplanarDoublePendulum.lean new file mode 100644 index 000000000..4fe0da0c7 --- /dev/null +++ b/PhysLean/ClassicalMechanics/Pendulum/CoplanarDoublePendulum.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2025 Shlok Vaibhav Singh. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Shlok Vaibhav Singh +-/ +import PhysLean.Meta.Informal.Basic +import PhysLean.Meta.Sorry +/-! +# Coplanar Double Pendulum +### Tag: LnL_1.5.1 +## Source: +* Textbook: Landau and Lifshitz, Mechanics, 3rd Edition +* Chapter: 1 The Equations of motion +* Section: 5 The Lagrangian for a system of particles +* Problem: 1 Coplanar Double Pendulum + +Description: This problem involves: +a) identifying the appropriate Degrees of Freedom or generalized coordinates +and their relation to cartesian coordinates + +b) and using them to write down the Lagrangian for + +a coplanar double pendulum made up of two +point masses $m_1$ and $m_2$. Mass $m_1$ is attached to the pivot and $m_2$ is attached +to $m_1$ via strings of length $l_1$ and $l_2$ respectively. + +Solution: + +The Cartesian coordinates $(x_1, y_1)$ for mass $m_1$ and $(x_2, y_2)$ for mass $m_2$ can be +expressed in terms of the two angles $\phi_1$ and $\phi_2$ made by the strings with the vertical: +$$ +\begin{aligned} +x_1 &= l_1\sin\phi_1\\ +y_1 &= -l_1\cos\phi_1\\ +x_2 &= l_1\sin\phi_1 + l_2\sin\phi_2\\ +y_2 &= -l_1\cos\phi_1 - l_2\cos\phi_2 +\end{aligned} +$$ + +b) The Lagrangian is obtained by writing down the kinetic and potential energies +first in terms of cartesian coordinates and their time derivates and then substituting +the coordinates and derivatives with transformations obtained in a) : + +$$\mathcal{L} = T_1 + T_2 - V_1 - V_2$$ where $T$ denotes the kinetic energy and $V$ +the potential energy +$$ +\begin{aligned} +T_1 &= \tfrac{1}{2}m_1(\dot{x}_1^2 + \dot{y}_1^2) = \tfrac{1}{2}m_1 l_1^2\dot{\phi}_1^2\\ +V_1 &= m_1 g y_1 = -m_1 g l_1\cos\phi_1\\ +T_2 &= \tfrac{1}{2}m_2(\dot{x}_2^2 + \dot{y}_2^2) + = \tfrac{1}{2}m_2\bigl(l_1^2\dot{\phi}_1^2 + l_2^2\dot{\phi}_2^2 + + 2l_1 l_2\dot{\phi}_1\dot{\phi}_2\cos(\phi_1 - \phi_2)\bigr)\\ +V_2 &= m_2 g y_2 = -m_2 g\bigl(l_1\cos\phi_1 + l_2\cos\phi_2\bigr) +\end{aligned} +$$ + +so that the Lagrangian becomes: + $$ +\mathcal{L} = \tfrac{1}{2}(m_1 + m_2)l_1^2\dot{\phi}_1^2 + \tfrac{1}{2}m_2 l_2^2\dot{\phi}_2^2+ + m_2 l_1 l_2\dot{\phi}_1\dot{\phi}_2\cos(\phi_1 - \phi_2)+ + (m_1 + m_2)g l_1\cos\phi_1 + m_2 g l_2\cos\phi_2 +$$ +-/ + +namespace ClassicalMechanics + +namespace CoplanarDoublePendulum + +/-- The configuration space of the coplaner double pendulum. -/ +@[sorryful] +def ConfigurationSpace : Type := sorry + +end CoplanarDoublePendulum +end ClassicalMechanics diff --git a/PhysLean/ClassicalMechanics/Pendulum/MiscellaneousPendulumPivotMotions.lean b/PhysLean/ClassicalMechanics/Pendulum/MiscellaneousPendulumPivotMotions.lean new file mode 100644 index 000000000..02962f19a --- /dev/null +++ b/PhysLean/ClassicalMechanics/Pendulum/MiscellaneousPendulumPivotMotions.lean @@ -0,0 +1,146 @@ +/- +Copyright (c) 2025 Shlok Vaibhav Singh. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Shlok Vaibhav Singh +-/ +/-! +# Miscellaneous Pendulum Pivot Motions +### Tag: LnL_1.5.3 +## Source: +* Textbook: Landau and Lifshitz, Mechanics, 3rd Edition +* Chapter 1 The Equations of motion +* Section 5 The Lagrangian for a system of particles +* Problem 3: Pendulum with a moving suspension point + +In all three cases described below, the point of support moves in the same plane as the pendulum as +per a given function of time. The lagrangian of the pendulum is to be found. + +## Part a) +Description: The pendulum moves uniformally in a vertical circle of radius $a$ and angular velocity +$\gamma$ + +Solution: +The coordinates of m can be expressed as: +$$ +\begin{aligned} +x &= a\cos(\gamma t) + l\sin\phi\\ +y &= a\sin(\gamma t) - l\cos\phi +\end{aligned} +$$ +(where generalized coordinate, $\phi$, is the angle the string makes +with vertical, $\gamma$ is angle with horizontal) + +$$\mathcal{L} = T-V$$ where +Kinetic and potential energies: +$$ +\begin{aligned} +T &= \tfrac{1}{2}m(\dot{x}^2 + \dot{y}^2) += \tfrac{1}{2}m\bigl(l^2\dot{\phi}^2 + 2al\gamma\sin(\phi-\gamma t)\dot{\phi} + a^2\gamma^2\bigr)\\ +V &= mg y = mg\bigl(a\sin(\gamma t) - l\cos\phi\bigr) +\end{aligned} +$$ + +We can ignore the constant term $\tfrac{1}{2}ma^2\gamma^2$ in $T$ as it does not affect the +equations of motion. +Like wise, $mg a\sin(\gamma t)$ in $V$ can be ignored since its contribution to action is constant +Let us note that the total derivative of $a l \cos(\phi - \gamma t)$ is: +$$ +\frac{d}{dt}\bigl[al\cos(\phi-\gamma t)\bigr] += -al\sin(\phi-\gamma t)\dot{\phi} + al\gamma\sin(\phi-\gamma t) +$$ + +Rearraging the terms, the lagrangian can be written as: +$$ +L = \tfrac{1}{2}m l^{2}\dot{\phi}^{2} + m a l \gamma^{2}\sin(\phi-\gamma t) + m g l \cos\phi- + m\gamma\frac{d}{dt}\bigl[al\cos(\phi-\gamma t)\bigr] +$$ +Since lagrangians differing by a total time derivate lead to the same equations of motion +we can ignore the last term. So that the final lagrangian becomes: +$$ +L = \tfrac{1}{2}m l^2\dot{\phi}^2 + m a l \gamma^2 \sin(\phi-\gamma t) + m g l \cos\phi +$$ + +## Part b) +Description: The point of support oscillates horizontally according to the law $x = a\cos(\gamma t)$ + +Solution: +The coordinates of $m$ can be expressed as: +$$ +\begin{aligned} +x &= a\cos(\gamma t) + l\sin\phi\\ +y &= -l\cos\phi +\end{aligned} +$$ +(where generalized coordinate, $\phi$, is the angle the string makes with vertical) +so that $\dot{x} = -a\gamma\sin(\gamma t) + l\dot{\phi}\cos\phi$ and $\dot{y} = l\dot{\phi}\sin\phi$ +$\mathcal{L} = T - V$ where + +$$ +\begin{aligned} +T &= \tfrac{1}{2}m(\dot{x}^2 + \dot{y}^2) + = \tfrac{1}{2}m\bigl(l^2\dot{\phi}^2 + a^2\gamma^2\sin^2(\gamma t) + - 2 a l \gamma\sin(\gamma t)\dot{\phi}\cos\phi\bigr)\\ +V &= m g y = - m g l \cos\phi +\end{aligned} +$$ +We can ignore the constant term $\tfrac{1}{2}m a^2\gamma^2\sin^2(\gamma t)$ in $T$ again. +The derivative of $\sin\phi\sin(\gamma t)$ is +$$ +\frac{d}{dt}\bigl[\sin\phi\sin(\gamma t)\bigr] += \dot{\phi}\cos\phi\sin(\gamma t) + \gamma\sin\phi\cos(\gamma t) +$$ +substituting this in the lagrangian, we get: +$$ +L = \tfrac{1}{2} m l^2\dot{\phi}^2 + m a l \gamma^2 \sin\phi\cos(\gamma t) + m g l \cos\phi- + m a l \gamma\frac{d}{dt}\bigl[\sin\phi\sin(\gamma t)\bigr] +$$ + +Ignoring the total time derivate term, the final lagrangian becomes: +$$ +L = \tfrac{1}{2} m l^2\dot{\phi}^2 + m a l \gamma^2 \sin\phi\cos(\gamma t) + m g l \cos\phi +$$ +## Part c) +Description: The point of support oscillates vertically according to the law $y = a\cos(\gamma t)$ + +Solution: +The coordinates of m can be expressed as: +$$ +\begin{aligned} +x &= l\sin\phi\\ +y &= a\cos(\gamma t) - l\cos\phi +\end{aligned} +$$ +(where generalized coordinate, $\phi$, is angle string makes with vertical) +$L = T - V$ where +$$ +\begin{aligned} +T &= \tfrac{1}{2}m(\dot{x}^2 + \dot{y}^2) + = \tfrac{1}{2}m\bigl(l^2\dot{\phi}^2 + a^2\gamma^2\sin^2(\gamma t) + - 2 a l \gamma\sin(\gamma t)\dot{\phi}\sin\phi\bigr)\\ +V &= m g y = m g\bigl(a\cos(\gamma t) - l\cos\phi\bigr) +\end{aligned} +$$ + +We can ignore the constant term $\tfrac{1}{2}m a^2\gamma^2\sin^2(\gamma t)$ in $T$ as it does not +lead to variation. +Likewise, $m g a\cos(\gamma t)$ in $V$ can be ignored since its contribution to action is constant. +The time derivative of $\cos\phi\sin(\gamma t)$ is: +$$ +\frac{d}{dt}\bigl[\cos\phi\sin(\gamma t)\bigr] += -\dot{\phi}\sin\phi\sin(\gamma t) + \gamma\cos\phi\cos(\gamma t) +$$ +substituting this in the lagrangian, we get: +$$ +L = \tfrac{1}{2} m l^2\dot{\phi}^2 + m g l \cos\phi - + m a l \gamma^2 \cos\phi\cos(\gamma t) + + m a l \gamma\frac{d}{dt}\bigl[\cos\phi\cos(\gamma t)\bigr] +$$ +Ignoring the total time derivate term, the final lagrangian becomes: +$$ +L = \tfrac{1}{2} m l^2\dot{\phi}^2 + m g l \cos\phi - m a l \gamma^2 \cos\phi\cos(\gamma t) +$$ +-/ + +namespace ClassicalMechanics + +end ClassicalMechanics diff --git a/PhysLean/ClassicalMechanics/Pendulum/SlidingPendulum.lean b/PhysLean/ClassicalMechanics/Pendulum/SlidingPendulum.lean new file mode 100644 index 000000000..062fa321d --- /dev/null +++ b/PhysLean/ClassicalMechanics/Pendulum/SlidingPendulum.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2025 Shlok Vaibhav Singh. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Shlok Vaibhav Singh +-/ +import PhysLean.Meta.Sorry +/-! +# Sliding Pendulum +### Tag: LnL_1.5.2 +## Source: +* Textbook: Landau and Lifshitz, Mechanics, 3rd Edition +* Chapter: 1 The Equations of motion +* Section: 5 The Lagrangian for a system of particles +* Problem: 2 Sliding Pendulum + +Description: +A simple pendulum of mass $m_2$ attached to a mass $m_1$ as its point of support via a string of +length $l$. The mass $m_1$ is free to move horizontally. +The Lagrangian of the system is to be found. + +Solution: +First, the constraints are identified: +$$ +\begin{aligned} +y_1 &= 0\\ +(x_2 - x_1)^2 + (y_2 - y_1)^2 &= l^2 +\end{aligned} +$$ +And the second constraint gives: +$$ +\begin{aligned} +x_2 - x_1 &= l\sin\phi\\ +y_2 - y_1 &= y_2 = -\,l\cos\phi +\end{aligned} +$$ +with the generalized coordinate $\phi$ being the angle the string makes with the vertical. + +The Lagrangian is obtained as: +$$\mathcal{L} = T_1 + T_2 - V_1 - V_2$$ where + +$$ +\begin{aligned} +T_1 &= \tfrac{1}{2} m_1 \dot{x}_1^2, & V_1 &= 0,\\[4pt] +T_2 &= \tfrac{1}{2} m_2(\dot{x}_2^2 + \dot{y}_2^2) + = \tfrac{1}{2} m_2\bigl(l^2\dot{\phi}^2 + \dot{x}_1^2 + 2l\dot{\phi}\dot{x}_1\cos\phi\bigr), + & V_2 &= m_2 g y_2 = -m_2 g l \cos\phi +\end{aligned} +$$ + +Thus the Lagrangian is +$$ +\mathcal{L} = \tfrac{1}{2}(m_1 + m_2)\dot{x}_1^2 + \tfrac{1}{2} m_2\bigl(l^2\dot{\phi}^2+ +2l\dot{\phi}\dot{x}_1\cos\phi\bigr) + m_2 g l \cos\phi +$$ + +-/ + +namespace ClassicalMechanics + +namespace SlidingPendulum + +/-- The configuration space of the sliding pendulum system. -/ +@[sorryful] +def ConfigurationSpace : Type := sorry + +end SlidingPendulum + +end ClassicalMechanics diff --git a/PhysLean/ClassicalMechanics/RigidBody/Basic.lean b/PhysLean/ClassicalMechanics/RigidBody/Basic.lean index 8808d6007..dd3ddc073 100644 --- a/PhysLean/ClassicalMechanics/RigidBody/Basic.lean +++ b/PhysLean/ClassicalMechanics/RigidBody/Basic.lean @@ -3,7 +3,7 @@ Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ -import PhysLean.SpaceAndTime.Space.Distributions.Basic +import PhysLean.SpaceAndTime.Space.Derivatives.Curl import Mathlib.Geometry.Manifold.Algebra.SmoothFunctions /-! @@ -38,8 +38,8 @@ namespace RigidBody def mass {d : ℕ} (R : RigidBody d) : ℝ := R.ρ ⟨fun _ => 1, contMDiff_const⟩ /-- The center of mass of the rigid body. -/ -noncomputable def centerOfMass {d : ℕ} (R : RigidBody d) : Space d := fun i => - (1 / R.mass) • R.ρ ⟨fun x => x i, ContDiff.contMDiff <| by fun_prop⟩ +noncomputable def centerOfMass {d : ℕ} (R : RigidBody d) : Space d := ⟨fun i => + (1 / R.mass) • R.ρ ⟨fun x => x i, ContDiff.contMDiff <| by fun_prop⟩⟩ /-- The inertia tensor of the rigid body. -/ noncomputable def inertiaTensor {d : ℕ} (R : RigidBody d) : diff --git a/PhysLean/ClassicalMechanics/RigidBody/SolidSphere.lean b/PhysLean/ClassicalMechanics/RigidBody/SolidSphere.lean index 3811e0851..970d8e410 100644 --- a/PhysLean/ClassicalMechanics/RigidBody/SolidSphere.lean +++ b/PhysLean/ClassicalMechanics/RigidBody/SolidSphere.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.ClassicalMechanics.RigidBody.Basic -import Mathlib.MeasureTheory.Measure.Lebesgue.VolumeOfBalls /-! # The solid sphere as a rigid body @@ -45,24 +44,28 @@ lemma solidSphere_mass {d : ℕ} (m R : ℝ≥0) (hr : R ≠ 0) : (solidSphere d have h1 : (@volume (Space d.succ) measureSpaceOfInnerProductSpace).real (Metric.closedBall 0 R) ≠ 0 := by refine (measureReal_ne_zero_iff ?_).mpr ?_ - · rw [EuclideanSpace.volume_closedBall] - simp - exact not_eq_of_beq_eq_false rfl - · rw [EuclideanSpace.volume_closedBall] - simp only [ENNReal.ofReal_coe_nnreal, Nat.succ_eq_add_one, Fintype.card_fin, Nat.cast_add, - Nat.cast_one, ne_eq, mul_eq_zero, Nat.add_eq_zero, one_ne_zero, and_false, - not_false_eq_true, pow_eq_zero_iff, ENNReal.coe_eq_zero, ENNReal.ofReal_eq_zero, not_or, - not_le] - apply And.intro - · exact hr - · positivity + · apply Space.volume_closedBall_ne_top + · apply Space.volume_closedBall_ne_zero + have hr' := R.2 + have hx : R.1 ≠ 0 := by simpa using hr + apply lt_of_le_of_ne hr' (Ne.symm hx) field_simp /-- The center of mass of a solid sphere located at the origin is `0`. -/ -@[sorryful] -lemma solidSphere_centerOfMass {d : ℕ} (m R : ℝ≥0) (hr : R ≠ 0) : - (solidSphere d.succ m R).centerOfMass = 0 := by - sorry +lemma solidSphere_centerOfMass {d : ℕ} (m R : ℝ≥0) : (solidSphere d.succ m R).centerOfMass = 0 := by + ext i + simp only [Nat.succ_eq_add_one, centerOfMass, solidSphere, one_div, LinearMap.coe_mk, + AddHom.coe_mk, ContMDiffMap.coeFn_mk, smul_eq_mul, Space.zero_apply, mul_eq_zero, inv_eq_zero, + div_eq_zero_iff, coe_eq_zero] + right + right + suffices ∫ x in Metric.closedBall (0 : Space d.succ) R, x i ∂MeasureSpace.volume + = -∫ x in Metric.closedBall (0 : Space d.succ) R, x i ∂MeasureSpace.volume by linarith + rw [← integral_neg] + simp only [← integral_indicator measurableSet_closedBall, Set.indicator, Metric.mem_closedBall, + dist_zero_right] + rw [← integral_neg_eq_self] + norm_num /-- The moment of inertia tensor of a solid sphere through its center of mass is `2/5 m R^2 * I`. -/ diff --git a/PhysLean/ClassicalMechanics/VectorFields.lean b/PhysLean/ClassicalMechanics/VectorFields.lean deleted file mode 100644 index aadb9af56..000000000 --- a/PhysLean/ClassicalMechanics/VectorFields.lean +++ /dev/null @@ -1,280 +0,0 @@ -/- -Copyright (c) 2025 Zhi Kai Pong. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Zhi Kai Pong, Joseph Tooby-Smith --/ -import PhysLean.Mathematics.FDerivCurry -import PhysLean.SpaceAndTime.Time.Basic -import Mathlib.Analysis.Calculus.Deriv.Prod -import Mathlib.LinearAlgebra.CrossProduct -import Mathlib.Analysis.Calculus.FDeriv.Pi -import Mathlib.Analysis.SpecialFunctions.Log.Deriv -import PhysLean.SpaceAndTime.Space.Basic -/-! -# Classical vector calculus properties - -Vector calculus properties under classical space and time derivatives. - --/ -namespace ClassicalMechanics - -open Space -open Time - -lemma dt_distrib (f : Time → Space → EuclideanSpace ℝ (Fin 3)) : - (fderiv ℝ (fun t => (fderiv ℝ (fun x => f t x u) x) dx1) t - - fderiv ℝ (fun t => (fderiv ℝ (fun x => f t x v) x) dx2) t) 1 - = - (fderiv ℝ (fun t => (fderiv ℝ (fun x => f t x u) x) dx1) t) 1 - - (fderiv ℝ (fun t => (fderiv ℝ (fun x => f t x v) x) dx2) t) 1 := by - rfl - -lemma fderiv_coord_dt (f : Time → Space → EuclideanSpace ℝ (Fin 3)) (t dt : Time) - (hf : Differentiable ℝ (↿f)) : - (fun x => (fderiv ℝ (fun t => f t x i) t) dt) - = - (fun x => (fderiv ℝ (fun t => f t x) t) dt i) := by - ext x - rw [fderiv_pi] - rfl - · fun_prop - -/-- Derivatives along space coordinates and time commute. -/ -lemma fderiv_swap_time_space_coord - (f : Time → Space → EuclideanSpace ℝ (Fin 3)) (t dt : Time) (x dx : Space) - (hf : ContDiff ℝ 2 ↿f) : - fderiv ℝ (fun t' => fderiv ℝ (fun x' => f t' x' i) x dx) t dt - = - fderiv ℝ (fun x' => fderiv ℝ (fun t' => f t' x' i) t dt) x dx := by - have h' := fderiv_swap (𝕜 := ℝ) f t dt x dx - change (fderiv ℝ - (fun t' => (fderiv ℝ ((EuclideanSpace.proj i) ∘ - (fun x' => f t' x')) x) dx) t) dt = _ - trans (fderiv ℝ - (fun t' => ((fderiv ℝ (⇑(EuclideanSpace.proj i)) (f t' x)).comp - (fderiv ℝ (fun x' => f t' x') x)) dx) t) dt - · congr - funext t' - rw [fderiv_comp] - · fun_prop - · apply function_differentiableAt_snd - exact hf.two_differentiable - simp only [ContinuousLinearMap.fderiv, ContinuousLinearMap.coe_comp', - Function.comp_apply] - rw [fderiv_comp'] - simp only [ContinuousLinearMap.fderiv, ContinuousLinearMap.coe_comp', - Function.comp_apply] - rw [h'] - change _ = - (fderiv ℝ (fun x' => (fderiv ℝ ((EuclideanSpace.proj i) ∘ - (fun t' => f t' x')) t) dt) x) dx - trans (fderiv ℝ - (fun x' => ((fderiv ℝ (⇑(EuclideanSpace.proj i)) (f t x')).comp - (fderiv ℝ (fun t' => f t' x') t)) dt) x) dx - swap - · congr - funext x' - rw [fderiv_comp] - · fun_prop - · apply function_differentiableAt_fst - exact hf.two_differentiable - simp only [ContinuousLinearMap.fderiv, ContinuousLinearMap.coe_comp', - Function.comp_apply] - rw [fderiv_comp'] - simp only [PiLp.proj_apply, ContinuousLinearMap.fderiv, - ContinuousLinearMap.coe_comp', Function.comp_apply] - /- Start of differentiability conditions. -/ - · fun_prop - · apply fderiv_curry_differentiableAt_fst_comp_snd - exact hf - · fun_prop - · fun_prop - · apply fderiv_curry_differentiableAt_snd_comp_fst - exact hf - -lemma differentiableAt_fderiv_coord_single - (ft : Time → Space → EuclideanSpace ℝ (Fin 3)) (hf : ContDiff ℝ 2 ↿ft) : - DifferentiableAt ℝ (fun t => - (fderiv ℝ (fun x => ft t x u) x) (EuclideanSpace.single v 1)) t := by - apply Differentiable.clm_apply - · let ftt : Time → Space → ℝ := fun t x => ft t x u - have hd : ContDiff ℝ 2 (↿ftt) := by - change ContDiff ℝ 2 (fun x => (↿ft) x u) - change ContDiff ℝ 2 ((EuclideanSpace.proj u) ∘ (↿ft)) - apply ContDiff.comp - · exact ContinuousLinearMap.contDiff (EuclideanSpace.proj u) (𝕜 := ℝ) - · exact hf - have hdd : Differentiable ℝ (↿ftt) := hd.two_differentiable - have h1 (t : Time) : fderiv ℝ (fun x => ftt t x) x - = fderiv ℝ (↿ftt) (t, x) ∘L (ContinuousLinearMap.inr ℝ Time Space) := by - ext w - simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, ContinuousLinearMap.inr_apply] - rw [fderiv_uncurry] - simp only [map_zero, zero_add] - fun_prop - conv => - enter [2, y] - change fderiv ℝ (fun x => ftt y x) x - rw [h1] - fun_prop - · fun_prop - -/-- Curl and time derivative commute. -/ -lemma time_deriv_curl_commute (fₜ : Time → Space → EuclideanSpace ℝ (Fin 3)) - (t : Time) (x : Space) (hf : ContDiff ℝ 2 ↿fₜ) : - ∂ₜ (fun t => (∇ × fₜ t) x) t = (∇ × fun x => (∂ₜ (fun t => fₜ t x) t)) x:= by - funext i - unfold Time.deriv - rw [fderiv_pi] - · change (fderiv ℝ (fun t => curl (fₜ t) x i) t) 1 = _ - unfold curl Space.deriv Space.coord Space.basis - fin_cases i <;> - · simp only [Fin.zero_eta, Fin.isValue, EuclideanSpace.basisFun_apply, PiLp.inner_apply, - EuclideanSpace.single_apply, RCLike.inner_apply, conj_trivial, ite_mul, one_mul, zero_mul, - Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte] - rw [fderiv_fun_sub] - rw [dt_distrib] - rw [fderiv_swap_time_space_coord, fderiv_swap_time_space_coord] - rw [fderiv_coord_dt, fderiv_coord_dt] - repeat exact hf.two_differentiable - repeat fun_prop - repeat - apply differentiableAt_fderiv_coord_single - exact hf - · intro i - unfold curl Space.deriv Space.coord Space.basis - fin_cases i <;> - · simp only [Fin.isValue, EuclideanSpace.basisFun_apply, PiLp.inner_apply, - EuclideanSpace.single_apply, RCLike.inner_apply, conj_trivial, ite_mul, one_mul, zero_mul, - Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte] - apply DifferentiableAt.sub - repeat - apply differentiableAt_fderiv_coord_single - exact hf - -open Matrix - -set_option quotPrecheck false in -/-- Cross product in `EuclideanSpace ℝ (Fin 3)`. Uses `⨯` which is typed using `\X` or -`\vectorproduct` or `\crossproduct`. -/ -infixl:70 " ⨯ₑ₃ " => fun a b => (WithLp.equiv 2 (Fin 3 → ℝ)).symm - (WithLp.equiv 2 (Fin 3 → ℝ) a ⨯₃ WithLp.equiv 2 (Fin 3 → ℝ) b) - -/-- Cross product and fderiv commute. -/ -lemma fderiv_cross_commute {u : Time} {s : Space} {f : Time → EuclideanSpace ℝ (Fin 3)} - (hf : Differentiable ℝ f) : - s ⨯ₑ₃ (fderiv ℝ (fun u => f u) u) 1 - = - fderiv ℝ (fun u => s ⨯ₑ₃ (f u)) u 1 := by - have h (i j : Fin 3) : s i * (fderiv ℝ (fun u => f u) u) 1 j - - s j * (fderiv ℝ (fun u => f u) u) 1 i - = - (fderiv ℝ (fun t => s i * f t j - s j * f t i) u) 1:= by - rw [fderiv_fun_sub, fderiv_const_mul, fderiv_const_mul] - rw [fderiv_pi] - rfl - intro i - repeat fun_prop - rw [crossProduct] - ext i - fin_cases i <;> - · simp [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.isValue, WithLp.equiv_apply, - LinearMap.mk₂_apply, PiLp.ofLp_apply, Fin.reduceFinMk, WithLp.equiv_symm_apply, - PiLp.toLp_apply, cons_val] - rw [h] - simp only [Fin.isValue] - rw [fderiv_pi] - simp only [Fin.isValue, PiLp.toLp_apply] - rfl - · intro i - fin_cases i <;> - · simp - fun_prop - -/-- Cross product and time derivative commute. -/ -lemma time_deriv_cross_commute {s : Space} {f : Time → EuclideanSpace ℝ (Fin 3)} - (hf : Differentiable ℝ f) : - s ⨯ₑ₃ (∂ₜ (fun t => f t) t) - = - ∂ₜ (fun t => s ⨯ₑ₃ (f t)) t := by - repeat rw [Time.deriv] - rw [fderiv_cross_commute] - fun_prop - -lemma inner_cross_self (v w : EuclideanSpace ℝ (Fin 3)) : - inner ℝ v (w ⨯ₑ₃ v) = 0 := by - cases v using WithLp.rec with | _ v => - cases w using WithLp.rec with | _ w => - simp only [WithLp.equiv_apply, WithLp.ofLp_toLp, WithLp.equiv_symm_apply] - change (crossProduct w) v ⬝ᵥ v = _ - rw [dotProduct_comm, dot_cross_self] - -lemma inner_self_cross (v w : EuclideanSpace ℝ (Fin 3)) : - inner ℝ v (v ⨯ₑ₃ w) = 0 := by - cases v using WithLp.rec with | _ v => - cases w using WithLp.rec with | _ w => - simp only [WithLp.equiv_apply, WithLp.ofLp_toLp, WithLp.equiv_symm_apply, PiLp.inner_apply, - PiLp.toLp_apply, RCLike.inner_apply, conj_trivial] - change (crossProduct v) w ⬝ᵥ v = _ - rw [dotProduct_comm, dot_self_cross] - -/-! - -## Differentiablity conditions - --/ - -@[fun_prop] -lemma space_deriv_differentiable_time {d i} {M} [NormedAddCommGroup M] [NormedSpace ℝ M] - {f : Time → Space d → M} (hf : ContDiff ℝ 2 ↿f) (x : Space d) : - Differentiable ℝ (fun t => Space.deriv i (f t) x) := by - conv => - enter [2, t]; - rw [Space.deriv_eq_fderiv_basis] - apply Differentiable.clm_apply - · have hdd : Differentiable ℝ ↿f := hf.two_differentiable - have h1 (t : Time) : fderiv ℝ (fun x => f t x) x - = fderiv ℝ (↿f) (t, x) ∘L (ContinuousLinearMap.inr ℝ Time (Space d)) := by - ext w - simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, ContinuousLinearMap.inr_apply] - rw [fderiv_uncurry] - simp only [map_zero, zero_add] - fun_prop - conv => - enter [2, y] - change fderiv ℝ (fun x => f y x) x - rw [h1] - fun_prop - · fun_prop - -@[fun_prop] -lemma time_deriv_differentiable_space {d } {M} [NormedAddCommGroup M] [NormedSpace ℝ M] - {f : Time → Space d → M} (hf : ContDiff ℝ 2 ↿f) (t : Time) : - Differentiable ℝ (fun x => Time.deriv (f · x) t) := by - conv => - enter [2, x]; - rw [Time.deriv_eq] - apply Differentiable.clm_apply - · have hdd : Differentiable ℝ ↿f := hf.two_differentiable - have h1 (x : Space d) : fderiv ℝ (fun t => f t x) t - = fderiv ℝ (↿f) (t, x) ∘L (ContinuousLinearMap.inl ℝ Time (Space d)) := by - ext w - simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, ContinuousLinearMap.inl_apply] - rw [fderiv_uncurry] - simp only [map_zero, add_zero] - fun_prop - conv => - enter [2, t'] - change fderiv ℝ (fun x => f x t') t - rw [h1] - fun_prop - · fun_prop - -lemma time_deriv_comm_space_deriv {d i} {M} [NormedAddCommGroup M] [NormedSpace ℝ M] - {f : Time → Space d → M} (hf : ContDiff ℝ 2 ↿f) (t : Time) (x : Space d) : - Time.deriv (fun t' => Space.deriv i (f t') x) t - = Space.deriv i (fun x' => Time.deriv (fun t' => f t' x') t) x := by - simp only [Time.deriv_eq, Space.deriv_eq_fderiv_basis] - exact fderiv_swap (𝕜 := ℝ) f t 1 x (basis i) hf - -end ClassicalMechanics diff --git a/PhysLean/ClassicalMechanics/WaveEquation/Basic.lean b/PhysLean/ClassicalMechanics/WaveEquation/Basic.lean index 2737bc718..a3687d8ba 100644 --- a/PhysLean/ClassicalMechanics/WaveEquation/Basic.lean +++ b/PhysLean/ClassicalMechanics/WaveEquation/Basic.lean @@ -3,8 +3,8 @@ Copyright (c) 2025 Zhi Kai Pong. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Zhi Kai Pong -/ -import Mathlib.Analysis.InnerProductSpace.Calculus -import PhysLean.ClassicalMechanics.VectorFields +import PhysLean.SpaceAndTime.Space.CrossProduct +import PhysLean.SpaceAndTime.TimeAndSpace.Basic /-! # Wave equation @@ -147,18 +147,18 @@ lemma planeWave_time_deriv_time_deriv {d f₀ c x} {s : Direction d} enter [1, i] rw [planeWave_time_deriv (h'.differentiable (by simp))] ext t i - rw [Time.deriv_eq, fderiv_const_smul] + rw [Time.deriv_eq, fderiv_const_smul (by fun_prop)] simp only [fderiv_eq_smul_deriv, one_smul, neg_smul, ContinuousLinearMap.neg_apply, ContinuousLinearMap.coe_smul', Pi.smul_apply, PiLp.neg_apply, PiLp.smul_apply, smul_eq_mul] - rw [← Time.deriv_eq, planeWave_time_deriv] + rw [← Time.deriv_eq, planeWave_time_deriv (by fun_prop)] simp only [fderiv_eq_smul_deriv, one_smul, Pi.smul_apply, PiLp.smul_apply, smul_eq_mul, neg_mul, mul_neg, neg_neg] ring_nf - congr + suffices h : (fun x => _root_.deriv (fun x => _root_.deriv f₀ x) x) = + fun x => iteratedDeriv 2 f₀ x by rw [h] funext x erw [iteratedDeriv_succ] simp only [iteratedDeriv_one] - repeat fun_prop /-! @@ -175,19 +175,17 @@ lemma planeWave_space_deriv {d f₀ c} {s : Direction d} ext x j rw [Space.deriv_eq] change fderiv ℝ - (f₀ ∘ fun x : Space d => (inner ℝ x s.unit - c * t)) x (EuclideanSpace.single i 1) j = _ + (f₀ ∘ fun x : Space d => (inner ℝ x s.unit - c * t)) x (Space.basis i) j = _ rw [fderiv_comp] simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, fderiv_eq_smul_deriv, PiLp.smul_apply, smul_eq_mul, one_smul, Pi.smul_apply] rw [fderiv_sub_const] rw [fderiv_inner_apply] - simp [EuclideanSpace.inner_single_left] + simp only [fderiv_fun_const, Pi.zero_apply, ContinuousLinearMap.zero_apply, inner_zero_right, + fderiv_id', ContinuousLinearMap.coe_id', id_eq, basis_inner, zero_add, mul_eq_mul_left_iff] left simp [planeWave_eq] repeat fun_prop - · apply DifferentiableAt.sub - apply DifferentiableAt.inner - repeat fun_prop lemma planeWave_apply_space_deriv {d f₀ c} {s : Direction d} (h' : Differentiable ℝ f₀) (i j : Fin d) : @@ -241,8 +239,9 @@ lemma planeWave_apply_space_deriv_space_deriv {d f₀ c} {s : Direction d} rw [← Space.deriv_eq_fderiv_basis, planeWave_apply_space_deriv] simp only [fderiv_eq_smul_deriv, one_smul, Pi.smul_apply, smul_eq_mul] ring_nf - congr - funext x i + suffices h : (fun x => _root_.deriv (fun x => _root_.deriv f₀ x) x) = + fun x => iteratedDeriv 2 f₀ x by rw [h] + ext x i erw [iteratedDeriv_succ'] simp only [iteratedDeriv_one] repeat fun_prop @@ -256,7 +255,7 @@ lemma planeWave_apply_space_deriv_space_deriv {d f₀ c} {s : Direction d} lemma planeWave_laplacian {d f₀ c} {s : Direction d} (h' : ContDiff ℝ 2 f₀) : Δ (planeWave f₀ c s t) = fun x => planeWave (iteratedDeriv 2 f₀ ·) c s t x := by ext x j - simp [laplacianVec, coord, laplacian] + simp [laplacianVec, laplacian] conv_lhs => enter [2, i] rw [planeWave_apply_space_deriv_space_deriv h'] @@ -286,7 +285,7 @@ These lemmas will eventually be moved, renamed and/or replaced. -/ -lemma wave_differentiable {s : Direction d} {c : ℝ} {x : EuclideanSpace ℝ (Fin d)} : +lemma wave_differentiable {s : Direction d} {c : ℝ} {x : Space d} : DifferentiableAt ℝ (fun x => inner ℝ x s.unit - c * t) x := by apply DifferentiableAt.sub apply DifferentiableAt.inner @@ -296,26 +295,24 @@ lemma wave_dx2 {u v : Fin d} {s : Direction d} {f₀' : ℝ → ℝ →L[ℝ] EuclideanSpace ℝ (Fin d)} {f₀'' : ℝ → ℝ →L[ℝ] EuclideanSpace ℝ (Fin d)} (h'' : ∀ x, HasFDerivAt (fun x' => f₀' x' 1) (f₀'' x) x) : (fderiv ℝ (fun x' => (inner ℝ ((f₀' (inner ℝ x' s.unit - c * t)) (s.unit u)) - (EuclideanSpace.single v 1))) x) (EuclideanSpace.single u 1) + (EuclideanSpace.single v 1))) x) (Space.basis u) = inner ℝ ((s.unit u) ^ 2 • f₀'' (inner ℝ x s.unit - c * t) 1) (EuclideanSpace.single v 1) := by rw [fderiv_inner_apply] have hdi' : (fderiv ℝ (fun x' => (f₀' (inner ℝ x' s.unit - c * t)) - (s.unit u)) x) (EuclideanSpace.single u 1) + (s.unit u)) x) (Space.basis u) = (s.unit u) ^ 2 • (f₀'' (inner ℝ x s.unit - c * t) 1) := by change (fderiv ℝ ((fun x' => f₀' x' (s.unit u)) ∘ - fun x' => (inner ℝ x' s.unit - c * t)) x) (EuclideanSpace.single u 1) = _ + fun x' => (inner ℝ x' s.unit - c * t)) x) (Space.basis u) = _ rw [fderiv_comp, fderiv_fun_sub] simp only [fderiv_fun_const, Pi.ofNat_apply, sub_zero, ContinuousLinearMap.coe_comp', Function.comp_apply] rw [fderiv_inner_apply] simp only [fderiv_id', ContinuousLinearMap.coe_id', id_eq] trans (fderiv ℝ (fun x' => (f₀' x') (s.unit u • 1)) (inner ℝ x s.unit - c * t)) (s.unit u • 1) - simp only [PiLp.inner_apply, RCLike.inner_apply, conj_trivial, fderiv_fun_const, Pi.zero_apply, - ContinuousLinearMap.zero_apply, inner_zero_right, EuclideanSpace.single_apply, - MonoidWithZeroHom.map_ite_one_zero, mul_ite, mul_one, mul_zero, Finset.sum_ite_eq', - Finset.mem_univ, ↓reduceIte, zero_add, fderiv_eq_smul_deriv, smul_eq_mul] + simp only [fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.zero_apply, inner_zero_right, + basis_inner, zero_add, fderiv_eq_smul_deriv, smul_eq_mul, mul_one] conv_lhs => enter [1, 2, x'] rw [ContinuousLinearMap.map_smul] @@ -324,8 +321,6 @@ lemma wave_dx2 {u v : Fin d} {s : Direction d} change s.unit u • s.unit u • (f₀'' (inner ℝ x s.unit - c * t) 1) = _ rw [← smul_assoc, smul_eq_mul] repeat fun_prop - apply DifferentiableAt.inner - repeat fun_prop · conv_lhs => enter [x] rw [← mul_one (s.unit u), ← smul_eq_mul, ContinuousLinearMap.map_smul] @@ -353,16 +348,12 @@ lemma space_fderiv_of_inner_product_wave_eq_space_fderiv {t : Time} {f₀ : ℝ → EuclideanSpace ℝ (Fin d)} {s : Direction d} {u v : Fin d} (h' : Differentiable ℝ f₀) : c * ((fun x' => (fderiv ℝ (fun x => inner ℝ (f₀ (inner ℝ x s.unit - c * t)) - (EuclideanSpace.single v 1)) x') (EuclideanSpace.single u 1)) x) + (EuclideanSpace.single v 1)) x') ((Space.basis u))) x) = - s.unit u * ∂ₜ (fun t => f₀ (inner ℝ x s.unit - c * t)) t v := by simp [EuclideanSpace.inner_single_right] trans c * (fderiv ℝ (fun x => f₀ (⟪x, s.unit⟫_ℝ - c * t.val) v) x) (Space.basis u) - · congr 2 - funext x - simp [basis_apply] - congr 1 - exact Eq.propIntro (fun a => id (Eq.symm a)) fun a => id (Eq.symm a) + · rfl erw [← Space.deriv_eq_fderiv_basis, planeWave_apply_space_deriv h' u v, planeWave_time_deriv h'] simp only [fderiv_eq_smul_deriv, one_smul, Pi.smul_apply, smul_eq_mul, PiLp.smul_apply, neg_mul, @@ -382,27 +373,32 @@ open Matrix lemma crossProduct_time_differentiable_of_right_eq_planewave {s : Direction} {f₀ : ℝ → EuclideanSpace ℝ (Fin 3)} {f : Time → Space → EuclideanSpace ℝ (Fin 3)} (h' : Differentiable ℝ f₀) (hf : f = planeWave f₀ c s) : - DifferentiableAt ℝ (fun t => s.unit ⨯ₑ₃ (f t x)) t := by + DifferentiableAt ℝ (fun t => Space.basis.repr s.unit ⨯ₑ₃ (f t x)) t := by rw [hf, crossProduct] unfold planeWave - apply differentiable_pi'' + apply differentiable_euclid intro i fin_cases i <;> - · simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.isValue, WithLp.equiv_apply, - PiLp.inner_apply, RCLike.inner_apply, conj_trivial, LinearMap.mk₂_apply, PiLp.ofLp_apply, - Fin.reduceFinMk, WithLp.equiv_symm_apply, PiLp.toLp_apply, Matrix.cons_val] + · simp only [Fin.reduceFinMk, Fin.isValue, Nat.succ_eq_add_one, Nat.reduceAdd, + WithLp.equiv_apply, LinearMap.mk₂_apply, WithLp.equiv_symm_apply, PiLp.toLp_apply, cons_val] fun_prop lemma crossProduct_differentiable_of_right_eq_planewave {s : Direction} {f₀ : ℝ → EuclideanSpace ℝ (Fin 3)} (h' : Differentiable ℝ f₀) : - DifferentiableAt ℝ (fun u => s.unit ⨯ₑ₃ (f₀ u)) u := by + DifferentiableAt ℝ (fun u => Space.basis.repr s.unit ⨯ₑ₃ (f₀ u)) u := by rw [crossProduct] + apply Differentiable.differentiableAt + apply Differentiable.comp + · simp only [WithLp.equiv_symm_apply] + rw [@differentiable_euclidean] + intro i + simp only + fun_prop apply differentiable_pi'' intro i fin_cases i <;> · simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.isValue, WithLp.equiv_apply, - LinearMap.mk₂_apply, PiLp.ofLp_apply, Fin.reduceFinMk, WithLp.equiv_symm_apply, PiLp.toLp_apply, - Matrix.cons_val] + Fin.reduceFinMk, LinearMap.mk₂_apply, cons_val] fun_prop lemma wave_fderiv_inner_eq_inner_fderiv_proj {f₀ : ℝ → EuclideanSpace ℝ (Fin d)} @@ -410,39 +406,26 @@ lemma wave_fderiv_inner_eq_inner_fderiv_proj {f₀ : ℝ → EuclideanSpace ℝ ∀ x y, s.unit i * (fderiv ℝ (fun x => f₀ (inner ℝ x s.unit - c * t)) x) y i = inner ℝ y s.unit * (fderiv ℝ (fun x => f₀ (inner ℝ x s.unit - c * t) i) x) - (EuclideanSpace.single i 1) := by + (Space.basis i) := by intro x y - rw [fderiv_pi] - change s.unit i * fderiv ℝ ((EuclideanSpace.proj i) ∘ - fun x => f₀ (inner ℝ x s.unit - c * t)) x y = + change _ = inner ℝ y s.unit * (fderiv ℝ ((EuclideanSpace.proj i) ∘ - fun x => f₀ (inner ℝ x s.unit - c * t)) x) (EuclideanSpace.single i 1) + fun x => f₀ (inner ℝ x s.unit - c * t)) x) (Space.basis i) rw [fderiv_comp] simp only [ContinuousLinearMap.fderiv, ContinuousLinearMap.coe_comp', Function.comp_apply, PiLp.proj_apply] change s.unit i * (fderiv ℝ (f₀ ∘ fun x => (inner ℝ x s.unit - c * t)) x) y i = inner ℝ y s.unit * (fderiv ℝ (f₀ ∘ fun x => (inner ℝ x s.unit - c * t)) x) - (EuclideanSpace.single i 1) i + (Space.basis i) i rw [fderiv_comp, fderiv_fun_sub] simp only [fderiv_fun_const, Pi.zero_apply, sub_zero, ContinuousLinearMap.coe_comp', Function.comp_apply, differentiableAt_fun_id, differentiableAt_const, fderiv_inner_apply, ContinuousLinearMap.zero_apply, inner_zero_right, fderiv_id', ContinuousLinearMap.coe_id', id_eq, zero_add] - nth_rw 5 [PiLp.inner_apply] - simp only [EuclideanSpace.single_apply, RCLike.inner_apply, MonoidWithZeroHom.map_ite_one_zero, - mul_ite, mul_one, mul_zero, Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte] - rw [← mul_one (s.unit i), ← smul_eq_mul (s.unit i), ContinuousLinearMap.map_smul] - rw [← mul_one (inner ℝ y s.unit), ← smul_eq_mul (inner ℝ y s.unit), ContinuousLinearMap.map_smul] - simp only [smul_eq_mul, PiLp.smul_apply, ← mul_assoc, mul_comm, one_mul] - apply DifferentiableAt.inner + simp only [fderiv_eq_smul_deriv, PiLp.smul_apply, smul_eq_mul, basis_inner] + rw [← mul_one (s.unit i), ← smul_eq_mul (s.unit i)] + rw [← mul_one (inner ℝ y s.unit), ← smul_eq_mul (inner ℝ y s.unit)] + simp only [smul_eq_mul, mul_comm, one_mul, ← mul_assoc] repeat fun_prop - · exact wave_differentiable - · fun_prop - · apply DifferentiableAt.comp - · fun_prop - · exact wave_differentiable - · intro i - simp only [PiLp.inner_apply, RCLike.inner_apply, conj_trivial] - fun_prop end ClassicalMechanics diff --git a/PhysLean/ClassicalMechanics/WaveEquation/HarmonicWave.lean b/PhysLean/ClassicalMechanics/WaveEquation/HarmonicWave.lean index 2efc1d3a4..e97044ead 100644 --- a/PhysLean/ClassicalMechanics/WaveEquation/HarmonicWave.lean +++ b/PhysLean/ClassicalMechanics/WaveEquation/HarmonicWave.lean @@ -24,8 +24,10 @@ abbrev WaveVector (d : ℕ := 3) := EuclideanSpace ℝ (Fin d) /-- Direction of a wavevector. -/ noncomputable def WaveVector.toDirection {d : ℕ} (k : WaveVector d) (h : k ≠ 0) : Direction d where - unit := (‖k‖⁻¹) • (k) - norm := norm_smul_inv_norm h + unit := (‖k‖⁻¹) • basis.repr.symm (k) + norm := by + simp [norm_smul] + field_simp /-- General form of time-harmonic wave in terms of angular frequency `ω` and wave vector `k`. -/ noncomputable def harmonicWave (a g : ℝ → Space d → ℝ) (ω : WaveVector d → ℝ) (k : WaveVector d) : @@ -33,8 +35,8 @@ noncomputable def harmonicWave (a g : ℝ → Space d → ℝ) (ω : WaveVector fun t r => a (ω k) r * Real.cos (ω k * t - g (ω k) r) TODO "EGQUA" "Show that the wave equation is invariant under rotations and any direction `s` - can be rotated to `EuclideanSpace.single 2 1` if only one wave is concerened." - + can be rotated to `EuclideanSpace.single 2 1` if only one wave is concerned." +open InnerProductSpace set_option linter.unusedVariables false in /-- Transverse monochromatic time-harmonic plane wave where the direction of propagation is taken to be `EuclideanSpace.single 2 1`. `f₀x` and `f₀y` are the respective amplitudes, @@ -43,8 +45,8 @@ set_option linter.unusedVariables false in noncomputable def transverseHarmonicPlaneWave (k : WaveVector) (f₀x f₀y ω δx δy : ℝ) (hk : k = EuclideanSpace.single 2 (ω/c)) : Time → Space → EuclideanSpace ℝ (Fin 3) := - let fx := harmonicWave (fun _ _ => f₀x) (fun _ r => inner ℝ k r - δx) (fun _ => ω) k - let fy := harmonicWave (fun _ _ => f₀y) (fun _ r => inner ℝ k r - δy) (fun _ => ω) k + let fx := harmonicWave (fun _ _ => f₀x) (fun _ r => ⟪k, basis.repr r⟫_ℝ - δx) (fun _ => ω) k + let fy := harmonicWave (fun _ _ => f₀y) (fun _ r => ⟪k, basis.repr r⟫_ℝ - δy) (fun _ => ω) k fun t r => fx t r • EuclideanSpace.single 0 1 + fy t r • EuclideanSpace.single 1 1 /-- The transverse harmonic planewave representation is equivalent to the general planewave @@ -66,9 +68,9 @@ lemma transverseHarmonicPlaneWave_eq_planeWave {c : ℝ} {k : WaveVector} {f₀x rw [normk] rw [mul_sub, inner_smul_right, real_inner_comm, ← mul_assoc] ring_nf - simp [ne_of_gt, hc_ge_zero, hω_ge_zero, mul_comm ω, mul_assoc] + simp [ne_of_gt, hc_ge_zero, hω_ge_zero, mul_comm ω, mul_assoc, basis_repr_inner_eq] -TODO "EGU3E" "Show that any disturbance (subject to certian conditions) can be expressed +TODO "EGU3E" "Show that any disturbance (subject to certain conditions) can be expressed as a superposition of harmonic plane waves via Fourier integral." end ClassicalMechanics diff --git a/PhysLean/CondensedMatter/TightBindingChain/Basic.lean b/PhysLean/CondensedMatter/TightBindingChain/Basic.lean index 1b084a7a2..9efa879a9 100644 --- a/PhysLean/CondensedMatter/TightBindingChain/Basic.lean +++ b/PhysLean/CondensedMatter/TightBindingChain/Basic.lean @@ -193,6 +193,13 @@ lemma localizedComp_apply_localizedState (m n p : Fin T.N) : rw [localizedComp, LinearMap.coe_mk, AddHom.coe_mk, orthonormal_iff_ite.mp T.localizedState_orthonormal n p, ite_smul, one_smul, zero_smul] +/-- The adjoint of localizedComp |m⟩⟨n| is |n⟩⟨m|. -/ +lemma localizedComp_adjoint (m n : Fin T.N) (ψ φ : T.HilbertSpace) : + ⟪|m⟩⟨n| ψ, φ⟫_ℂ = ⟪ψ, |n⟩⟨m| φ⟫_ℂ := by + simp only [localizedComp, LinearMap.coe_mk, AddHom.coe_mk] + rw [inner_smul_left, inner_smul_right, inner_conj_symm] + ring + /-! ## D. The Hamiltonian of the tight binding chain @@ -213,9 +220,28 @@ noncomputable def hamiltonian : T.HilbertSpace →ₗ[ℂ] T.HilbertSpace := -/ /-- The hamiltonian of the tight binding chain is hermitian. -/ -@[sorryful] lemma hamiltonian_hermitian (ψ φ : T.HilbertSpace) : - ⟪T.hamiltonian ψ, φ⟫_ℂ = ⟪ψ, T.hamiltonian φ⟫_ℂ := by sorry + ⟪T.hamiltonian ψ, φ⟫_ℂ = ⟪ψ, T.hamiltonian φ⟫_ℂ := by + simp only [hamiltonian, LinearMap.sub_apply, LinearMap.smul_apply, LinearMap.coe_sum, + Finset.sum_apply, LinearMap.add_apply] + rw [inner_sub_left, inner_sub_right] + congr 1 + · -- E0 term + simp only [Finset.smul_sum] + rw [sum_inner, inner_sum] + apply Finset.sum_congr rfl + intro n _ + simp only [inner_smul_left_eq_smul, inner_smul_right_eq_smul] + rw [localizedComp_adjoint] + · -- t term + simp only [Finset.smul_sum, smul_add] + rw [sum_inner, inner_sum] + apply Finset.sum_congr rfl + intro n _ + rw [inner_add_left, inner_add_right] + simp only [inner_smul_left_eq_smul, inner_smul_right_eq_smul] + rw [localizedComp_adjoint, localizedComp_adjoint] + ring /-! @@ -227,7 +253,7 @@ lemma hamiltonian_hermitian (ψ φ : T.HilbertSpace) : `T.E0 • |n⟩ - T.t • (|n + 1⟩ + |n - 1⟩)`. -/ lemma hamiltonian_apply_localizedState (n : Fin T.N) : T.hamiltonian |n⟩ = (T.E0 : ℂ) • |n⟩ - (T.t : ℂ) • (|n + 1⟩ + |n - 1⟩) := by - simp only [hamiltonian, LinearMap.sub_apply, LinearMap.smul_apply, LinearMap.coeFn_sum, + simp only [hamiltonian, LinearMap.sub_apply, LinearMap.smul_apply, LinearMap.coe_sum, Finset.sum_apply, LinearMap.add_apply, smul_add] congr · /- The `|n⟩` term -/ @@ -411,7 +437,7 @@ lemma quantaWaveNumber_exp_N (n : ℕ) (k : T.QuantaWaveNumber) : lemma quantaWaveNumber_exp_sub_one (n : Fin T.N) (k : T.QuantaWaveNumber) : Complex.exp (Complex.I * k * (n - 1).val * T.a) = Complex.exp (Complex.I * k * n * T.a) * Complex.exp (- Complex.I * k * T.a) := by - rw [Fin.coe_sub] + rw [Fin.val_sub] trans Complex.exp (Complex.I * ↑↑k * ↑(((T.N - 1 + n)/T.N) * T.N + (n - 1).val) * ↑T.a) · simp only [Nat.cast_add, Nat.cast_mul] have h0 : (Complex.I * ↑↑k * (↑((T.N - 1 + ↑n) / T.N) * ↑T.N + (n - 1).val) * ↑T.a) @@ -432,7 +458,7 @@ lemma quantaWaveNumber_exp_sub_one (n : Fin T.N) (k : T.QuantaWaveNumber) : have h0 : n = 0 := by omega subst h0 simpa using hn - · rw [@Fin.coe_sub] + · rw [@Fin.val_sub] congr simp [Nat.one_mod_eq_one.mpr hn] rw [hx] @@ -478,10 +504,74 @@ noncomputable def energyEigenstate (k : T.QuantaWaveNumber) : T.HilbertSpace := -/ -/-- The energy eigenstates of the tight binding chain are orthogonal. -/ -@[sorryful] +/-- The energy eigenstates of the tight binding chain are orthogonal. + +This is a fundamental quantum mechanical result: eigenstates of a Hermitian operator +(the Hamiltonian) with distinct eigenvalues are orthogonal. Here we prove it directly +using the periodic boundary conditions which quantize the wavenumbers. + +The key physical insight is that different wavenumbers k₁ ≠ k₂ give rise to different +N-th roots of unity exp(i(k₂-k₁)a), and the sum of all N-th roots of unity equals zero. -/ lemma energyEigenstate_orthogonal : - Pairwise fun k1 k2 => ⟪T.energyEigenstate k1, T.energyEigenstate k2⟫_ℂ = 0 := by sorry + Pairwise fun k1 k2 => ⟪T.energyEigenstate k1, T.energyEigenstate k2⟫_ℂ = 0 := by + intro k1 k2 hne + simp only [energyEigenstate, sum_inner] + simp_rw [inner_sum, inner_smul_left, inner_smul_right, + orthonormal_iff_ite.mp T.localizedState_orthonormal] + simp only [mul_ite, mul_one, mul_zero, Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte] + set ω := Complex.exp (Complex.I * (k2 - k1) * T.a) with hω_def + have hsum_eq : ∑ n : Fin T.N, (starRingEnd ℂ) (Complex.exp (Complex.I * k1 * n * T.a)) * + Complex.exp (Complex.I * k2 * n * T.a) = ∑ i ∈ Finset.range T.N, ω ^ i := by + rw [Fin.sum_univ_eq_sum_range (fun n => + (starRingEnd ℂ) (Complex.exp (Complex.I * k1 * n * T.a)) * + Complex.exp (Complex.I * k2 * n * T.a))] + refine Finset.sum_congr rfl fun i _ => ?_ + rw [starRingEnd_apply, Complex.star_def, ← Complex.exp_conj] + simp only [map_mul, Complex.conj_I, Complex.conj_ofReal, Complex.conj_natCast] + rw [← Complex.exp_add, hω_def, ← Complex.exp_nat_mul] + ring_nf + rw [hsum_eq] + have hω_pow : ω ^ T.N = 1 := by + simp only [hω_def, ← Complex.exp_nat_mul] + have h2 := quantaWaveNumber_exp_N T 1 k2 + have h1 := quantaWaveNumber_exp_N T 1 k1 + simp only [Nat.cast_one] at h2 h1 + calc + _ = Complex.exp (Complex.I * k2 * 1 * T.N * T.a - Complex.I * k1 * 1 * T.N * T.a) := by + ring_nf + _ = 1 := by rw [Complex.exp_sub, h2, h1, div_one] + have hω_ne_one : ω ≠ 1 := by + intro hω_eq_one + apply hne + obtain ⟨_, ⟨n1, rfl⟩⟩ := k1 + obtain ⟨_, ⟨n2, rfl⟩⟩ := k2 + simp only [Subtype.mk.injEq] + have hexp := Complex.exp_eq_one_iff.mp (hω_def ▸ hω_eq_one) + obtain ⟨m, hm⟩ := hexp + have ha : (T.a : ℂ) ≠ 0 := Complex.ne_zero_of_re_pos T.a_pos + have hN : (T.N : ℂ) ≠ 0 := by simp [Ne.symm (NeZero.ne' T.N)] + simp only [Complex.ofReal_mul, Complex.ofReal_div, Complex.ofReal_ofNat, + Complex.ofReal_natCast, Complex.ofReal_sub] at hm + field_simp at hm + have hm_int : (n2 : ℤ) - n1 = T.N * m := by + have hm_eq : (n2 : ℂ) - n1 = (T.N : ℂ) * m := by ring_nf at hm ⊢; exact hm + exact_mod_cast congrArg Complex.re hm_eq + have hn1_lt : (n1 : ℤ) < T.N := by exact_mod_cast n1.isLt + have hn2_lt : (n2 : ℤ) < T.N := by exact_mod_cast n2.isLt + have hN_pos : (0 : ℤ) < T.N := by exact_mod_cast Nat.pos_of_ne_zero (NeZero.ne T.N) + have hm_bound : m = 0 := by + have h1 : -(T.N : ℤ) < (n2 : ℤ) - n1 := by omega + have h2 : (n2 : ℤ) - n1 < T.N := by omega + rw [hm_int] at h1 h2 + nlinarith + simp only [hm_bound, mul_zero] at hm_int + have heq : n1.val = n2.val := by omega + simp only [heq] + -- Use the geometric series formula: (ω - 1) * ∑ω^i = ω^N - 1 + -- Since ω^N = 1 and ω ≠ 1, the sum must be zero + have hgeom := mul_geom_sum ω T.N + rw [hω_pow, sub_self] at hgeom + exact mul_eq_zero.mp hgeom |>.resolve_left (sub_ne_zero.mpr hω_ne_one) /-! diff --git a/PhysLean/Cosmology/FLRW/Basic.lean b/PhysLean/Cosmology/FLRW/Basic.lean index 708f41239..5bef35ced 100644 --- a/PhysLean/Cosmology/FLRW/Basic.lean +++ b/PhysLean/Cosmology/FLRW/Basic.lean @@ -3,9 +3,8 @@ Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Luis Gabriel C. Bariuan, Joseph Tooby-Smith -/ -import Mathlib.Analysis.Complex.Trigonometric -import PhysLean.Meta.Informal.SemiFormal import PhysLean.SpaceAndTime.Space.Basic +import Mathlib.Analysis.SpecialFunctions.Trigonometric.DerivHyp /-! # The Friedmann-Lemaître-Robertson-Walker metric @@ -50,13 +49,19 @@ lemma mul_sinh_as_div (r k : ℝ) : /-- First, show that limit of `sinh(r * x) / x` is r at the limit x goes to zero. Then the next theorem will address the rewrite using Filter.Tendsto.comp -/ -@[sorryful] lemma tendsto_sinh_rx_over_x (r : ℝ) : - Tendsto (fun x : ℝ => Real.sinh (r * x) / x) (𝓝[≠] 0) (𝓝 r) := by sorry - -@[sorryful] -lemma limit_S_saddle(r : ℝ) : - Tendsto (fun k : ℝ => k * Real.sinh (r / k)) atTop (𝓝 r) := by sorry + Tendsto (fun x : ℝ => Real.sinh (r * x) / x) (𝓝[≠] 0) (𝓝 r) := by + simpa [div_eq_inv_mul] using HasDerivAt.tendsto_slope_zero + (HasDerivAt.sinh (HasDerivAt.const_mul r (hasDerivAt_id 0))) + +lemma limit_S_saddle (r : ℝ) : + Tendsto (fun k : ℝ => k * Real.sinh (r / k)) atTop (𝓝 r) := by + suffices h_sinh_y : Tendsto (fun y => Real.sinh (r * y) / y) + (map (fun k => 1 / k) atTop) (𝓝 r) by + exact h_sinh_y.congr fun x => by simp [div_eq_mul_inv, mul_comm] + have h_deriv : HasDerivAt (fun y => Real.sinh (r * y)) r 0 := by + simpa using HasDerivAt.sinh (HasDerivAt.const_mul r (hasDerivAt_id 0)) + simpa [div_eq_inv_mul] using h_deriv.tendsto_slope_zero_right /-- The limit of `S (Sphere k) r` as `k → ∞` is equal to `S (Flat) r`. First show that `k * sinh(r / k) = sin(r / k) / (1 / k)` pointwise. -/ @@ -65,13 +70,22 @@ lemma mul_sin_as_div (r k : ℝ) : /-- First, show that limit of `sin(r * x) / x` is r at the limit x goes to zero. Then the next theorem will address the rewrite using Filter.Tendsto.comp -/ -@[sorryful] lemma tendsto_sin_rx_over_x (r : ℝ) : - Tendsto (fun x : ℝ => Real.sin (r * x) / x) (𝓝[≠] 0) (𝓝 r) := by sorry + Tendsto (fun x : ℝ => Real.sin (r * x) / x) (𝓝[≠] 0) (𝓝 r) := by + simpa [div_eq_inv_mul] using HasDerivAt.tendsto_slope_zero + (HasDerivAt.sin (HasDerivAt.const_mul r (hasDerivAt_id 0))) -@[sorryful] lemma limit_S_sphere(r : ℝ) : - Tendsto (fun k : ℝ => k * Real.sin (r / k)) atTop (𝓝 r) := by sorry + Tendsto (fun k : ℝ => k * Real.sin (r / k)) atTop (𝓝 r) := by + have h_sin_deriv : Filter.Tendsto (fun x : ℝ => Real.sin x / x) (nhdsWithin 0 {0}ᶜ) (nhds 1) := by + simpa [div_eq_inv_mul] using Real.hasDerivAt_sin 0 |> HasDerivAt.tendsto_slope_zero + by_cases hr : r = 0 + · simp [hr] + · have h_subst : Filter.Tendsto (fun k : ℝ => Real.sin (r / k) / (r / k)) Filter.atTop (𝓝 1) := by + refine h_sin_deriv.comp <| tendsto_inf.mpr + ⟨tendsto_const_nhds.div_atTop tendsto_id, tendsto_principal.mpr + <| eventually_ne_atTop 0 |> Eventually.mono <| by aesop⟩ + convert h_subst.const_mul r using 2 <;> field_simp end SpatialGeometry diff --git a/PhysLean/Electromagnetism/Charge/ChargeUnit.lean b/PhysLean/Electromagnetism/Charge/ChargeUnit.lean index c7a03e50c..89ab1848f 100644 --- a/PhysLean/Electromagnetism/Charge/ChargeUnit.lean +++ b/PhysLean/Electromagnetism/Charge/ChargeUnit.lean @@ -23,9 +23,9 @@ electron being in the negative direction. On `ChargeUnit` there is an instance of division giving a real number, corresponding to the ratio of the two scales of temperature unit. -To define specific charge units, we first axiomise the existence of a +To define specific charge units, we first state the existence of a a given charge unit, and then construct all other charge units from it. -We choose to axiomise the +We choose to state the existence of the charge unit of the coulomb, and construct all other charge units from that. -/ @@ -43,7 +43,7 @@ structure ChargeUnit where namespace ChargeUnit @[simp] -lemma val_neq_zero (x : ChargeUnit) : x.val ≠ 0 := by +lemma val_ne_zero (x : ChargeUnit) : x.val ≠ 0 := by exact Ne.symm (ne_of_lt x.property) lemma val_pos (x : ChargeUnit) : 0 < x.val := x.property @@ -64,7 +64,7 @@ lemma div_eq_val (x y : ChargeUnit) : x / y = (⟨x.val / y.val, div_nonneg (le_of_lt x.val_pos) (le_of_lt y.val_pos)⟩ : ℝ≥0) := rfl @[simp] -lemma div_neq_zero (x y : ChargeUnit) : ¬ x / y = (0 : ℝ≥0) := by +lemma div_ne_zero (x y : ChargeUnit) : ¬ x / y = (0 : ℝ≥0) := by rw [div_eq_val] refine coe_ne_zero.mp ?_ simp @@ -73,12 +73,12 @@ lemma div_neq_zero (x y : ChargeUnit) : ¬ x / y = (0 : ℝ≥0) := by lemma div_pos (x y : ChargeUnit) : (0 : ℝ≥0) < x/ y := by apply lt_of_le_of_ne · exact zero_le (x / y) - · exact Ne.symm (div_neq_zero x y) + · exact Ne.symm (div_ne_zero x y) @[simp] lemma div_self (x : ChargeUnit) : x / x = (1 : ℝ≥0) := by - simp [div_eq_val, x.val_neq_zero] + simp [div_eq_val, x.val_ne_zero] lemma div_symm (x y : ChargeUnit) : x / y = (y / x)⁻¹ := NNReal.eq <| by @@ -135,16 +135,15 @@ lemma scale_scale (x : ChargeUnit) (r1 r2 : ℝ) (hr1 : 0 < r1) (hr2 : 0 < r2) : ## Specific choices of charge units -To define a specific charge units, we must first axiomise the existence of a -a given charge unit, and then construct all other charge units from it. -We choose to axiomise the existence of the charge unit of coulomb. - -We need an axiom since this relates something to something in the physical world. +We define specific choices of charge units. +We first define the notion of a columb to correspond to the charge unit with underlying value +equal to `1`. This is really down to a choice in the isomorphism between the set of metrics +on the charge manifold and the positive reals. -/ -/-- The axiom corresponding to the definition of a charge unit of coulomb. -/ -axiom coulombs : ChargeUnit +/-- The definition of a charge unit of coulomb. -/ +def coulombs : ChargeUnit := ⟨1, by norm_num⟩ /-- The charge unit of a elementryCharge (1.602176634×10−19 coulomb). -/ noncomputable def elementaryCharge : ChargeUnit := scale (1.602176634e-19) coulombs diff --git a/PhysLean/Electromagnetism/Current/CircularCoil.lean b/PhysLean/Electromagnetism/Current/CircularCoil.lean new file mode 100644 index 000000000..99503e2f1 --- /dev/null +++ b/PhysLean/Electromagnetism/Current/CircularCoil.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +import PhysLean.Electromagnetism.Dynamics.IsExtrema +import PhysLean.SpaceAndTime.Space.Norm +import PhysLean.SpaceAndTime.Space.Translations +import PhysLean.SpaceAndTime.Space.ConstantSliceDist +import PhysLean.SpaceAndTime.TimeAndSpace.ConstantTimeDist +/-! +# The electrostatics of a circular coil + +## i. Overview + +This module is currently a stub, but will eventually contain the electrostatics of a +circular coil carrying a steady current. The references below have in them statements of the +electromagnetic potentials and fields around a circular coil. + +## ii. Key results + +## iii. Table of contents + +- A. The current density + +## iv. References + +- https://ntrs.nasa.gov/api/citations/20140002333/downloads/20140002333.pdf + +-/ + +TODO "TCGIW" "Copying the structure of the electrostatics of an infinite wire, + complete the definitions and proofs for a circular coil carrying a steady current." + +namespace Electromagnetism +namespace DistElectromagneticPotential +open minkowskiMatrix SpaceTime SchwartzMap Lorentz +attribute [-simp] Fintype.sum_sum_type +attribute [-simp] Nat.succ_eq_add_one +/-! + +## A. The current density + +-/ +end DistElectromagneticPotential +end Electromagnetism diff --git a/PhysLean/Electromagnetism/Current/InfiniteWire.lean b/PhysLean/Electromagnetism/Current/InfiniteWire.lean new file mode 100644 index 000000000..3f0ee1330 --- /dev/null +++ b/PhysLean/Electromagnetism/Current/InfiniteWire.lean @@ -0,0 +1,280 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +import PhysLean.Electromagnetism.Dynamics.IsExtrema +import PhysLean.SpaceAndTime.Space.Norm +import PhysLean.SpaceAndTime.Space.Translations +import PhysLean.SpaceAndTime.Space.ConstantSliceDist +import PhysLean.SpaceAndTime.TimeAndSpace.ConstantTimeDist +/-! + +# The magnetic field around a infinite wire + +## i. Overview + +In this module we verify the electromagnetic properties of an infinite wire +carrying a steady current along the x-axis. + +## ii. Key results + +- `wireCurrentDensity` : The current density associated with an infinite wire + carrying a current `I` along the `x`-axis. +- `infiniteWire` : The electromagnetic potential associated with an infinite wire + carrying a current `I` along the `x`-axis. +- `infiniteWire_isExterma` : The electromagnetic potential of an infinite wire + carrying a current `I` along the `x`-axis satisfies Maxwell's equations. + +## iii. Table of contents + +- A. The current density +- B. The electromagnetic potential + - B.1. The scalar potential + - B.2. The vector potential +- C. The electric field +- D. Maxwell's equations + +## iv. References + +-/ + +namespace Electromagnetism +open Distribution SchwartzMap +open Space MeasureTheory +namespace DistElectromagneticPotential + +/-! + +## A. The current density + +The 4-current density of an infinite wire carrying a current `I` along the `x`-axis is given by + +$$J(t, x, y, z) = (0, I δ((y, z)), 0, 0).$$ + +-/ + +/-- The current density associated with an infinite wire carrying a current `I` + along the `x`-axis. -/ +noncomputable def wireCurrentDensity (c : SpeedOfLight) : + ℝ →ₗ[ℝ] DistLorentzCurrentDensity 3 where + toFun I := (SpaceTime.distTimeSlice c).symm <| + constantTime <| + constantSliceDist 0 + (I • diracDelta' ℝ 0 (Lorentz.Vector.basis (Sum.inr 0))) + map_add' I1 I2 := by simp [add_smul] + map_smul' r I := by simp [smul_smul] + +@[simp] +lemma wireCurrentDensity_chargeDesnity (c : SpeedOfLight) (I : ℝ) : + (wireCurrentDensity c I).chargeDensity c = 0 := by + ext η + simp [DistLorentzCurrentDensity.chargeDensity, wireCurrentDensity, constantTime_apply, + constantSliceDist_apply] + +lemma wireCurrentDensity_currentDensity_fst (c : SpeedOfLight) (I : ℝ) + (η : 𝓢(Time × Space 3, ℝ)) : + (wireCurrentDensity c I).currentDensity c η 0 = + (constantTime <| + constantSliceDist 0 <| + I • diracDelta ℝ 0) η := by + simp [wireCurrentDensity, DistLorentzCurrentDensity.currentDensity, + constantTime_apply, constantSliceDist_apply, diracDelta'_apply] + +@[simp] +lemma wireCurrentDensity_currentDensity_snd (c : SpeedOfLight) (I : ℝ) + (ε : 𝓢(Time × Space 3, ℝ)) : + (wireCurrentDensity c I).currentDensity c ε 1 = 0 := by + simp [wireCurrentDensity, DistLorentzCurrentDensity.currentDensity, + constantTime_apply, constantSliceDist_apply] + +@[simp] +lemma wireCurrentDensity_currentDensity_thrd (c : SpeedOfLight) (I : ℝ) + (ε : 𝓢(Time × Space 3, ℝ)) : + (wireCurrentDensity c I).currentDensity c ε 2 = 0 := by + simp [wireCurrentDensity, DistLorentzCurrentDensity.currentDensity, + constantTime_apply, constantSliceDist_apply, diracDelta'_apply] + +/-! + +## B. The electromagnetic potential + +The electromagnetic potential of an infinite wire carrying a current `I` along the `x`-axis is +given by + +$$A(t, x, y, z) = \left(0, -\frac{μ_0 I}{2\pi} \log (\sqrt{y^2 + z^2}), 0, 0\right).$$ +-/ + +/-- The electromagnetic potential of an infinite wire along the x-axis carrying a current `I`. -/ +noncomputable def infiniteWire (𝓕 : FreeSpace) (I : ℝ) : + DistElectromagneticPotential 3 := + (SpaceTime.distTimeSlice 𝓕.c).symm <| + constantTime <| + constantSliceDist 0 + ((- I * 𝓕.μ₀ / (2 * Real.pi)) • distOfFunction (fun (x : Space 2) => + Real.log ‖x‖ • Lorentz.Vector.basis (Sum.inr 0)) + (IsDistBounded.log_norm.smul_const _)) + +/-! + +### B.1. The scalar potential + +THe scalar potential of an infinite wire carrying a current `I` along the `x`-axis is zero: + +$$V(t, x, y, z) = 0.$$ + +-/ + +@[simp] +lemma infiniteWire_scalarPotential (𝓕 : FreeSpace) (I : ℝ) : + (infiniteWire 𝓕 I).scalarPotential 𝓕.c = 0 := by + ext η + simp [scalarPotential, Lorentz.Vector.temporalCLM, + infiniteWire, constantTime_apply, constantSliceDist_apply, distOfFunction_vector_eval] + +/-! + +### B.2. The vector potential + +The vector potential of an infinite wire carrying a current `I` along the `x`-axis is given by +$$\vec A(t, x, y, z) = \left(-\frac{μ_0 I}{2\pi} \log (\sqrt{y^2 + z^2}), 0, 0\right).$$ + +The time derivative $\partial_t \vec A$ is zero, as expected for a steady current, +and the spatial derivative $\partial_x \vec A$ is also zero, as expected for +a system with translational symmetry along the x-axis. + +-/ + +lemma infiniteWire_vectorPotential (𝓕 : FreeSpace) (I : ℝ) : + (infiniteWire 𝓕 I).vectorPotential 𝓕.c = + (constantTime <| + constantSliceDist 0 + ((- I * 𝓕.μ₀ / (2 * Real.pi)) • distOfFunction (fun (x : Space 2) => + Real.log ‖x‖ • EuclideanSpace.single 0 (1 : ℝ)) + (IsDistBounded.log_norm.smul_const _))) := by + ext η i + simp [vectorPotential, infiniteWire, constantTime_apply, + constantSliceDist_apply, Lorentz.Vector.spatialCLM, distOfFunction_vector_eval, + distOfFunction_eculid_eval] + left + congr + funext x + congr 1 + exact Eq.propIntro (fun a => id (Eq.symm a)) fun a => id (Eq.symm a) + +lemma infiniteWire_vectorPotential_fst (𝓕 : FreeSpace) (I : ℝ)(η : 𝓢(Time × Space 3, ℝ)) : + (infiniteWire 𝓕 I).vectorPotential 𝓕.c η 0 = + (constantTime <| + constantSliceDist 0 <| + (- I * 𝓕.μ₀ / (2 * Real.pi)) • distOfFunction (fun (x : Space 2) => Real.log ‖x‖) + (IsDistBounded.log_norm)) η := by + simp [infiniteWire_vectorPotential 𝓕 I, constantTime_apply, + constantSliceDist_apply, distOfFunction_eculid_eval] + +@[simp] +lemma infiniteWire_vectorPotential_snd (𝓕 : FreeSpace) (I : ℝ) : + (infiniteWire 𝓕 I).vectorPotential 𝓕.c η 1 = 0 := by + simp [infiniteWire_vectorPotential 𝓕 I, constantTime_apply, + constantSliceDist_apply, distOfFunction_eculid_eval] + +@[simp] +lemma infiniteWire_vectorPotential_thrd (𝓕 : FreeSpace) (I : ℝ) : + (infiniteWire 𝓕 I).vectorPotential 𝓕.c η 2 = 0 := by + simp [infiniteWire_vectorPotential 𝓕 I, constantTime_apply, + constantSliceDist_apply, distOfFunction_eculid_eval] + +@[simp] +lemma infiniteWire_vectorPotential_distTimeDeriv (𝓕 : FreeSpace) (I : ℝ) : + distTimeDeriv ((infiniteWire 𝓕 I).vectorPotential 𝓕.c) = 0 := by + ext1 η + ext i + simp [infiniteWire_vectorPotential _ I] + +@[simp] +lemma infiniteWire_vectorPotential_distSpaceDeriv_0 (𝓕 : FreeSpace) (I : ℝ) : + distSpaceDeriv 0 ((infiniteWire 𝓕 I).vectorPotential 𝓕.c) = 0 := by + ext1 η + simp [infiniteWire_vectorPotential _ I] + right + rw [constantTime_distSpaceDeriv, distDeriv_constantSliceDist_same] + simp + +/-! + +## C. The electric field + +The electric field of an infinite wire carrying a current `I` along the `x`-axis is zero: +$$\vec E(t, x, y, z) = 0.$$ + +-/ + +@[simp] +lemma infiniteWire_electricField (𝓕 : FreeSpace) (I : ℝ) : + (infiniteWire 𝓕 I).electricField 𝓕.c = 0 := by + ext1 η + ext i + simp [electricField] + +/-! + +## D. Maxwell's equations + +-/ + +lemma infiniteWire_isExterma {𝓕 : FreeSpace} {I : ℝ} : + IsExtrema 𝓕 (infiniteWire 𝓕 I) (wireCurrentDensity 𝓕.c I) := by + simp only [isExtrema_iff_vectorPotential, infiniteWire_electricField, map_zero, + ContinuousLinearMap.zero_apply, one_div, wireCurrentDensity_chargeDesnity, mul_zero, + implies_true, PiLp.zero_apply, zero_sub, true_and] + intro ε i + field_simp + rw [neg_add_eq_zero] + fin_cases i + · simp [Fin.sum_univ_three] + simp [distSpaceDeriv_apply', infiniteWire_vectorPotential_fst] + simp [apply_fderiv_eq_distSpaceDeriv, wireCurrentDensity_currentDensity_fst] + field_simp + simp only [constantTime_distSpaceDeriv, mul_assoc] + congr + rw [← ContinuousLinearMap.add_apply, ← map_add constantTime] + trans (constantTime ((constantSliceDist 0) ((2 * Real.pi) • diracDelta ℝ 0))) ε;swap + · simp + ring + congr + rw [show (2 : Fin 3) = Fin.succAbove (0 : Fin 3) 1 by simp, + show (1 : Fin 3) = Fin.succAbove (0 : Fin 3) 0 by simp] + repeat rw [distDeriv_constantSliceDist_succAbove, distDeriv_constantSliceDist_succAbove] + rw [← map_add (constantSliceDist 0)] + congr + trans distDiv (distGrad (distOfFunction (fun (x : Space 2) => Real.log ‖x‖) + (IsDistBounded.log_norm))) + · ext ε + simp [distDiv_apply_eq_sum_distDeriv] + rw [add_comm] + congr + · rw [distDeriv_apply, fderivD_apply] + conv_rhs => rw [distDeriv_apply, fderivD_apply] + simp [distGrad_apply] + · rw [distDeriv_apply, fderivD_apply] + conv_rhs => rw [distDeriv_apply, fderivD_apply] + simp [distGrad_apply] + rw [distGrad_distOfFunction_log_norm] + have h1 := distDiv_inv_pow_eq_dim (d := 1) + simp at h1 + simp [h1] + · simp only [Fin.mk_one, Fin.isValue, neg_sub, Finset.sum_sub_distrib, Fin.sum_univ_three, + infiniteWire_vectorPotential_distSpaceDeriv_0, map_zero, ContinuousLinearMap.zero_apply, + PiLp.zero_apply, zero_add, wireCurrentDensity_currentDensity_snd, mul_zero] + ring_nf + rw [distSpaceDeriv_commute] + simp [distSpaceDeriv_apply'] + · simp only [Fin.reduceFinMk, Fin.isValue, neg_sub, Finset.sum_sub_distrib, Fin.sum_univ_three, + infiniteWire_vectorPotential_distSpaceDeriv_0, map_zero, ContinuousLinearMap.zero_apply, + PiLp.zero_apply, zero_add, add_sub_add_right_eq_sub, wireCurrentDensity_currentDensity_thrd, + mul_zero] + ring_nf + rw [distSpaceDeriv_commute] + simp [distSpaceDeriv_apply'] + +end DistElectromagneticPotential +end Electromagnetism diff --git a/PhysLean/Electromagnetism/Distributions/Potential.lean b/PhysLean/Electromagnetism/Distributions/Potential.lean deleted file mode 100644 index b89dbd028..000000000 --- a/PhysLean/Electromagnetism/Distributions/Potential.lean +++ /dev/null @@ -1,520 +0,0 @@ -/- -Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Tooby-Smith --/ -import PhysLean.Electromagnetism.Basic -import PhysLean.SpaceAndTime.SpaceTime.TimeSlice -import PhysLean.SpaceAndTime.SpaceTime.Distributions -import PhysLean.Relativity.Tensors.RealTensor.CoVector.Basic -import PhysLean.Mathematics.VariationalCalculus.HasVarGradient -/-! - -# The electromagnetic potential for distributions - -## i. Overview - -In this file we make the basic definitions of the electromagnetic potential, -the field strength tensor, the electric and magnetic fields, and the -Lagrangian gradient in the context of distributions. - -Note that all of these quantities depend linearly on the electromagnetic potential, -allowing them to be defined in the context of distributions. - -Unlike in the function case, many of the properties here can be defined as linear maps, -due to the no need to check things like differentiability. - -## ii. Key results - -- `ElectromagneticPotentialD` : The type of electromagnetic potentials as distributions. -- `ElectromagneticPotentialD.scalarPotential` : The scalar potential as a distribution. -- `ElectromagneticPotentialD.vectorPotential` : The vector potential as a distribution. -- `ElectromagneticPotentialD.electricField` : The electric field as a distribution. -- `ElectromagneticPotentialD.magneticField` : The magnetic field as a distribution. -- `LorentzCurrentDensityD` : The type of Lorentz current densities as distributions. -- `ElectromagneticPotentialD.gradLagrangian` : The variational gradient of the - electromagnetic Lagrangian as a distribution. - -## iii. Table of contents - -- A. The electromagnetic potential - - A.1. The components of the electromagnetic potential -- B. The field strength tensor matrix - - B.1. Diagonal of the field strength matrix - - B.2. Antisymmetry of the field strength matrix -- C. The scalar and vector potentials - - C.1. The scalar potential - - C.2. The vector potential -- D. The electric and magnetic fields - - D.1. Linear map to components - - D.2. The electric field in d-dimensions - - D.2.1. The electric field in terms of the field strength matrix - - D.2.2. The first column of the field strength matrix in terms of the electric field - - D.2.3. The first row of the field strength matrix in terms of the electric field - - D.3. The magnetic field in 3-dimensions -- E. The Lorentz current density - - E.1. The components of the Lorentz current density -- F. The Lagrangian variational gradient - - F.1. The variational gradient in 1-dimension - -## iv. References - --/ -namespace Electromagnetism -open Module realLorentzTensor -open IndexNotation -open TensorSpecies -open Tensor - -/-! - -## A. The electromagnetic potential - -We define the electromagnetic potential as a function from spacetime to -contravariant Lorentz vectors, and prove some simple results about it. - --/ - -/-- The electromagnetic potential is a tensor `A^μ`. -/ -noncomputable abbrev ElectromagneticPotentialD (d : ℕ := 3) := - (SpaceTime d) →d[ℝ] Lorentz.Vector d - -namespace ElectromagneticPotentialD - -open TensorSpecies -open Tensor -open SpaceTime -open TensorProduct -open PiTensorProduct -open minkowskiMatrix -attribute [-simp] Fintype.sum_sum_type -attribute [-simp] Nat.succ_eq_add_one - -/-! - -### A.1. The components of the electromagnetic potential --/ - -/-- The linear map from an electromagnetic potential to its components. -/ -noncomputable def toComponents {d : ℕ} : - ElectromagneticPotentialD d ≃ₗ[ℝ] ((Fin 1 ⊕ Fin d) → (SpaceTime d) →d[ℝ] ℝ) where - toFun A := fun μ => { - toFun := fun ε => A ε μ - map_add' := by - intro ε1 ε2 - simp - map_smul' := by - intro c ε - simp - cont := by fun_prop} - invFun A := { - toFun := fun ε μ => A μ ε - map_add' := by - intro ε1 ε2 - funext μ - simp - map_smul' := by - intro c ε - funext μ - simp - cont := by fun_prop} - left_inv := by - intro A - ext ε - simp - right_inv := by - intro A - ext μ ε - simp - map_add' := by - intro A1 A2 - ext μ ε - simp - map_smul' := by - intro c A - ext μ ε - simp - -/-! - -## B. The field strength tensor matrix - --/ - -/-- The field strength matrix with indices `F^μ^ν`. -/ -noncomputable def fieldStrengthMatrix {d : ℕ} : - ElectromagneticPotentialD d →ₗ[ℝ] - ((Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d) → (SpaceTime d) →d[ℝ] ℝ) where - toFun A := fun (μ, ν) => η μ μ • SpaceTime.derivD μ (A.toComponents ν) - - η ν ν • SpaceTime.derivD ν (A.toComponents μ) - map_add' A1 A2 := by - ext μν - match μν with - | (μ, ν) => - simp only [map_add, Pi.add_apply, smul_add, ContinuousLinearMap.coe_sub', Pi.sub_apply, - ContinuousLinearMap.add_apply, ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] - ring - map_smul' a A := by - ext μν - match μν with - | (μ, ν) => - simp only [map_smul, Pi.smul_apply, ContinuousLinearMap.coe_sub', ContinuousLinearMap.coe_smul', - Pi.sub_apply, smul_eq_mul, RingHom.id_apply] - ring - -/-! - -### B.1. Diagonal of the field strength matrix - --/ - -@[simp] -lemma fieldStrengthMatrix_same_same {d : ℕ} (A : ElectromagneticPotentialD d) (μ : Fin 1 ⊕ Fin d) : - A.fieldStrengthMatrix (μ, μ) = 0 := by - ext ε - simp [fieldStrengthMatrix] - -/-! - -### B.2. Antisymmetry of the field strength matrix - --/ - -lemma fieldStrengthMatrix_antisymm {d : ℕ} (A : ElectromagneticPotentialD d) - (μ ν : Fin 1 ⊕ Fin d) : - A.fieldStrengthMatrix (μ, ν) = - A.fieldStrengthMatrix (ν, μ) := by - ext ε - simp [fieldStrengthMatrix] -/-! - -## C. The scalar and vector potentials - --/ - -/-! - -### C.1. The scalar potential - --/ - -/-- The scalar potential from an electromagnetic potential which is a - distribution. -/ -noncomputable def scalarPotential {d} : - ElectromagneticPotentialD d →ₗ[ℝ] (Time × Space d) →d[ℝ] ℝ where - toFun A := timeSliceD <| A.toComponents (Sum.inl 0) - map_add' A1 A2 := by - ext ε - simp - map_smul' a A := by - ext ε - simp - -/-! - -### C.2. The vector potential - --/ - -/-- The vector potential from an electromagnetic potential which is a - distribution. -/ -noncomputable def vectorPotential {d}: - ElectromagneticPotentialD d →ₗ[ℝ] (Time × Space d) →d[ℝ] EuclideanSpace ℝ (Fin d) where - toFun A := { - toFun := fun κ i => (timeSliceD <| A.toComponents (Sum.inr i)) κ - map_add' := by - intro κ1 κ2 - funext i - simp - map_smul' := by - intro c κ - funext i - simp - cont := by fun_prop - } - map_add' A1 A2 := by - ext κ i - simp - map_smul' a A := by - ext κ i - simp - -/-! - -## D. The electric and magnetic fields - --/ - -/-! - -### D.1. Linear map to components - --/ - -/-- The linear map taking a distribution on Euclidean space to its components. -/ -noncomputable def toComponentsEuclidean {d : ℕ} : - ((Time × Space d) →d[ℝ] EuclideanSpace ℝ (Fin d)) ≃ₗ[ℝ] - (Fin d → (Time × Space d) →d[ℝ] ℝ) where - toFun J := fun μ => { - toFun := fun ε => J ε μ - map_add' := by - intro ε1 ε2 - simp - map_smul' := by - intro c ε - simp - cont := by fun_prop} - invFun J := { - toFun := fun ε μ => J μ ε - map_add' := by - intro ε1 ε2 - funext μ - simp - map_smul' := by - intro c ε - funext μ - simp - cont := by fun_prop} - left_inv := by - intro J - ext ε - simp - right_inv := by - intro J - ext μ ε - simp - map_add' := by - intro J1 J2 - ext μ ε - simp - map_smul' := by - intro c J - ext μ ε - simp - -open SchwartzMap -@[simp] -lemma toComponentsEuclidean_apply {d : ℕ} (E : (Time × Space d) →d[ℝ] EuclideanSpace ℝ (Fin d)) - (i : Fin d) (ε : 𝓢(Time × Space d, ℝ)) : - (toComponentsEuclidean E i) ε = E ε i := by rfl - -/-! - -### D.2. The electric field in d-dimensions - --/ - -/-- The electric field associated with a electromagnetic potential which is a distribution. -/ -noncomputable def electricField {d} : - ElectromagneticPotentialD d →ₗ[ℝ] (Time × Space d) →d[ℝ] EuclideanSpace ℝ (Fin d) where - toFun A := - - Space.spaceGradD (A.scalarPotential) - Space.timeDerivD (A.vectorPotential) - map_add' A1 A2 := by - ext κ i - simp only [map_add, neg_add_rev, ContinuousLinearMap.coe_sub', Pi.sub_apply, - ContinuousLinearMap.add_apply, ContinuousLinearMap.neg_apply, PiLp.sub_apply, PiLp.add_apply, - PiLp.neg_apply] - ring - map_smul' a A := by - ext κ i - simp only [map_smul, ContinuousLinearMap.coe_sub', ContinuousLinearMap.coe_smul', Pi.sub_apply, - ContinuousLinearMap.neg_apply, Pi.smul_apply, PiLp.sub_apply, PiLp.neg_apply, PiLp.smul_apply, - smul_eq_mul, RingHom.id_apply] - ring - -/-! - -#### D.2.1. The electric field in terms of the field strength matrix - --/ - -lemma electricField_fieldStrengthMatrix {d} {A : ElectromagneticPotentialD d} (i : Fin d) : - toComponentsEuclidean A.electricField i = - timeSliceD (A.fieldStrengthMatrix (Sum.inr i, Sum.inl 0)) := by - rw [electricField] - simp [fieldStrengthMatrix] - ext ε - simp [timeSliceD_derivD_inl, timeSliceD_derivD_inr, Space.spaceGradD_apply] - ring_nf - rfl - -/-! - -#### D.2.2. The first column of the field strength matrix in terms of the electric field - --/ - -lemma fieldStrengthMatrix_col_eq_electricField {d} {A : ElectromagneticPotentialD d} - (i : Fin d) : - (A.fieldStrengthMatrix (Sum.inr i, Sum.inl 0)) = - timeSliceD.symm (toComponentsEuclidean A.electricField i) := by - rw [electricField_fieldStrengthMatrix] - simp - -/-! - -#### D.2.3. The first row of the field strength matrix in terms of the electric field - --/ - -lemma fieldStrengthMatrix_row_eq_electricField {d} {A : ElectromagneticPotentialD d} - (i : Fin d) : - (A.fieldStrengthMatrix (Sum.inl 0, Sum.inr i)) = - - timeSliceD.symm (toComponentsEuclidean A.electricField i) := by - rw [fieldStrengthMatrix_antisymm, electricField_fieldStrengthMatrix] - simp - -/-! - -### D.3. The magnetic field in 3-dimensions - --/ - -/-- The magnetic field associated with a electromagnetic potential in 3 dimensions. -/ -noncomputable def magneticField : - ElectromagneticPotentialD 3 →ₗ[ℝ] (Time × Space 3) →d[ℝ] EuclideanSpace ℝ (Fin 3) where - toFun A := Space.spaceCurlD A.vectorPotential - map_add' A1 A2 := by - ext κ i - simp - map_smul' a A := by - ext κ i - simp - -end ElectromagneticPotentialD - -/-! - -## E. The Lorentz current density - --/ - -/-- The Lorentz current density (aka four-current) as a distribution. -/ -abbrev LorentzCurrentDensityD (d : ℕ := 3) := - (SpaceTime d) →d[ℝ] Lorentz.Vector d - -namespace LorentzCurrentDensityD - -/-! - -### E.1. The components of the Lorentz current density - --/ - -/-- The linear map taking a Lorentz current density to its components. -/ -noncomputable def toComponents {d : ℕ} : - LorentzCurrentDensityD d ≃ₗ[ℝ] ((Fin 1 ⊕ Fin d) → (SpaceTime d) →d[ℝ] ℝ) where - toFun J := fun μ => { - toFun := fun ε => J ε μ - map_add' := by - intro ε1 ε2 - simp - map_smul' := by - intro c ε - simp - cont := by fun_prop} - invFun J := { - toFun := fun ε μ => J μ ε - map_add' := by - intro ε1 ε2 - funext μ - simp - map_smul' := by - intro c ε - funext μ - simp - cont := by fun_prop} - left_inv := by - intro J - ext ε - simp - right_inv := by - intro J - ext μ ε - simp - map_add' := by - intro J1 J2 - ext μ ε - simp - map_smul' := by - intro c J - ext μ ε - simp - -end LorentzCurrentDensityD - -namespace ElectromagneticPotentialD - -open minkowskiMatrix - -/-! - -## F. The Lagrangian variational gradient - -The variational gradient of the Lagrangian density with respect to the electromagnetic potential -which is a distribution. We do not prove this is correct, the proof -is done for the function case. - -We take the definition to be: - -``` -∑ ν, (η ν ν • (∑ μ, ∂_ μ (fun x => (A.fieldStrengthMatrix x) (μ, ν)) x - J x ν) - • Lorentz.Vector.basis ν) -``` - -which matches the result of the calculation from the function case. --/ - -/-- The variational gradient of the lagrangian for an electromagnetic potential - which is a distribution. This is defined nor proved for distributions. -/ -noncomputable def gradLagrangian {d : ℕ} (A : ElectromagneticPotentialD d) - (J : LorentzCurrentDensityD d) : - (Fin 1 ⊕ Fin d) → (SpaceTime d) →d[ℝ] ℝ := fun ν => - η ν ν • (∑ μ, SpaceTime.derivD μ (A.fieldStrengthMatrix (μ, ν)) - J.toComponents ν) - -/-! - -### F.1. The variational gradient in 1-dimension - -We simplify the variational gradient in 1-dimension. - --/ - -lemma gradLagrangian_one_dimension_electricField (A : ElectromagneticPotentialD 1) - (J : LorentzCurrentDensityD 1) : - A.gradLagrangian J = fun μ => - match μ with - | Sum.inl 0 => SpaceTime.timeSliceD.symm - (Space.spaceDivD A.electricField) - J.toComponents (Sum.inl 0) - | Sum.inr 0 => J.toComponents (Sum.inr 0) + - SpaceTime.timeSliceD.symm - (toComponentsEuclidean (Space.timeDerivD A.electricField) 0) := by - funext μ - match μ with - | Sum.inl 0 => - simp [gradLagrangian] - rw [fieldStrengthMatrix_col_eq_electricField] - simp [SpaceTime.timeSliceD_symm_derivD_inr] - have h1 : ((Space.spaceDerivD 0) (toComponentsEuclidean A.electricField 0)) = - Space.spaceDivD (A.electricField) := by - ext ε - rw [Space.spaceDivD_apply_eq_sum_spaceDerivD] - simp only [Fin.isValue, Finset.univ_unique, Fin.default_eq_zero, Finset.sum_singleton] - rw [Space.spaceDerivD_apply, Space.spaceDerivD_apply, Distribution.fderivD_apply, - Distribution.fderivD_apply] - simp - rw [h1] - | Sum.inr 0 => - simp [gradLagrangian] - rw [fieldStrengthMatrix_row_eq_electricField] - simp only [Fin.isValue, map_neg, sub_neg_eq_add, add_right_inj] - rw [SpaceTime.timeSliceD_symm_derivD_inl] - have h1 : (Space.timeDerivD (toComponentsEuclidean A.electricField 0)) - = toComponentsEuclidean (Space.timeDerivD (A.electricField)) 0:= by - ext ε - simp [Space.timeDerivD_apply, Distribution.fderivD_apply, - Distribution.fderivD_apply] - rw [h1] - -end ElectromagneticPotentialD - -end Electromagnetism diff --git a/PhysLean/Electromagnetism/Dynamics/Basic.lean b/PhysLean/Electromagnetism/Dynamics/Basic.lean new file mode 100644 index 000000000..18b673a5f --- /dev/null +++ b/PhysLean/Electromagnetism/Dynamics/Basic.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +import PhysLean.Electromagnetism.Basic +/-! + +# Free space + +## i. Overview + +In this module we define a type `FreeSpace` which encapsulates the +electric permittivity and magnetic permeability of free space, that is +the physical constants which make it up. + +We prove basic properties from this definition, and define the speed of light +in free space in terms of these constants. + +## ii. Key results + +- `FreeSpace` : The structure encapsulating the electric permittivity + and magnetic permeability of free space. +- `FreeSpace.c` : The speed of light in free space. + +## iii. Table of contents + +- A. The definition of the free space type +- B. Positivity properties +- C. The speed of light + +## iv. References + +-/ + +namespace Electromagnetism + +/-! + +## A. The definition of the free space type + +-/ + +/-- Free space consists of the specification of the + electric permittivity and the magnetic permeability. -/ +structure FreeSpace where + /-- The permittivity. -/ + ε₀ : ℝ + /-- The permeability. -/ + μ₀ : ℝ + ε₀_pos : 0 < ε₀ + μ₀_pos : 0 < μ₀ + +namespace FreeSpace + +variable (𝓕 : FreeSpace) + +/-! + +## B. Positivity properties + +-/ + +@[simp] +lemma ε₀_nonneg : 0 ≤ 𝓕.ε₀ := le_of_lt 𝓕.ε₀_pos + +@[simp] +lemma μ₀_nonneg : 0 ≤ 𝓕.μ₀ := le_of_lt 𝓕.μ₀_pos + +@[simp] +lemma ε₀_ne_zero : 𝓕.ε₀ ≠ 0 := ne_of_gt 𝓕.ε₀_pos + +@[simp] +lemma μ₀_ne_zero : 𝓕.μ₀ ≠ 0 := ne_of_gt 𝓕.μ₀_pos + +/-! + +## C. The speed of light + +-/ + +/-- The speed of light in free space. -/ +noncomputable def c : SpeedOfLight := + ⟨1 / √(𝓕.ε₀ * 𝓕.μ₀), by + apply div_pos + · exact zero_lt_one + · refine Real.sqrt_pos_of_pos ?_ + apply mul_pos 𝓕.ε₀_pos 𝓕.μ₀_pos⟩ + +lemma c_val : (𝓕.c : ℝ) = 1 / √(𝓕.ε₀ * 𝓕.μ₀) := rfl + +lemma c_sq : (𝓕.c : ℝ) ^ 2 = 1 / (𝓕.ε₀ * 𝓕.μ₀) := by + rw [c_val, sq, div_eq_mul_inv] + field_simp + refine (Real.sqrt_eq_iff_eq_sq ?_ ?_).mp rfl + · apply mul_nonneg 𝓕.ε₀_nonneg 𝓕.μ₀_nonneg + · positivity + +@[simp] +lemma c_abs : abs (𝓕.c : ℝ) = 𝓕.c := by + rw [abs_of_pos (SpeedOfLight.val_pos 𝓕.c)] + +end FreeSpace + +end Electromagnetism diff --git a/PhysLean/Electromagnetism/Dynamics/CurrentDensity.lean b/PhysLean/Electromagnetism/Dynamics/CurrentDensity.lean index 6edb36e37..c62fa4843 100644 --- a/PhysLean/Electromagnetism/Dynamics/CurrentDensity.lean +++ b/PhysLean/Electromagnetism/Dynamics/CurrentDensity.lean @@ -3,8 +3,7 @@ Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ -import PhysLean.Electromagnetism.Dynamics.KineticTerm -import PhysLean.ClassicalMechanics.VectorFields +import PhysLean.SpaceAndTime.SpaceTime.TimeSlice /-! # The Lorentz Current Density @@ -25,14 +24,23 @@ The current density is given in terms of the charge density `ρ` and the current Lorentz current density. - `LorentzCurrentDensity.currentDensity` : The current density associated with a Lorentz current density. +- `DistLorentzCurrentDensity` : The type of Lorentz current densities + as distributions. ## iii. Table of contents - A. The Lorentz Current Density - B. The underlying charge - - B.1. Differentiability of the charge density + - B.1. Charge density of zero Lorentz current density + - B.2. Differentiability of the charge density + - B.3. Smoothness of the charge density - C. The underlying current density - - C.1. Differentiability of the current density + - C.1. current density of zero Lorentz current density + - C.2. Differentiability of the current density + - C.3. Smoothness of the current density +- D. The Lorentz current density as a distribution + - D.1. The underlying charge density + - D.2. The underlying current density ## iv. References @@ -68,32 +76,62 @@ namespace LorentzCurrentDensity -/ /-- The underlying charge density associated with a Lorentz current density. -/ -noncomputable def chargeDensity (J : LorentzCurrentDensity d) : Time → Space d → ℝ := - fun t x => J (toTimeAndSpace.symm (t, x)) (Sum.inl 0) +noncomputable def chargeDensity (c : SpeedOfLight := 1) + (J : LorentzCurrentDensity d) : Time → Space d → ℝ := + fun t x => (1 / (c : ℝ)) * J ((toTimeAndSpace c).symm (t, x)) (Sum.inl 0) + +lemma chargeDensity_eq_timeSlice {d : ℕ} {c : SpeedOfLight} {J : LorentzCurrentDensity d} : + J.chargeDensity c = timeSlice c (fun x => (1 / (c : ℝ)) • J x (Sum.inl 0)) := by rfl -lemma chargeDensity_eq_timeSlice {d : ℕ} {J : LorentzCurrentDensity d} : - J.chargeDensity = timeSlice (fun x => J x (Sum.inl 0)) := by rfl /-! -### B.1. Differentiability of the charge density +### B.1. Charge density of zero Lorentz current density + -/ -lemma chargeDensity_differentiable {d : ℕ} {J : LorentzCurrentDensity d} - (hJ : Differentiable ℝ J) : Differentiable ℝ ↿(J.chargeDensity) := by +@[simp] +lemma chargeDensity_zero {d : ℕ} {c : SpeedOfLight}: + chargeDensity c (0 : LorentzCurrentDensity d) = 0 := by + simp [chargeDensity_eq_timeSlice, timeSlice] + rfl + +/-! + +### B.2. Differentiability of the charge density +-/ + +lemma chargeDensity_differentiable {d : ℕ} {c : SpeedOfLight} {J : LorentzCurrentDensity d} + (hJ : Differentiable ℝ J) : Differentiable ℝ ↿(J.chargeDensity c) := by rw [chargeDensity_eq_timeSlice] apply timeSlice_differentiable have h1 : ∀ i, Differentiable ℝ (fun x => J x i) := by - rw [← differentiable_euclidean] + rw [SpaceTime.differentiable_vector] exact hJ + apply Differentiable.fun_const_smul exact h1 (Sum.inl 0) -lemma chargeDensity_contDiff {d : ℕ} {J : LorentzCurrentDensity d} - (hJ : ContDiff ℝ n J) : ContDiff ℝ n ↿(J.chargeDensity) := by +lemma chargeDensity_differentiable_space {d : ℕ} {c : SpeedOfLight} {J : LorentzCurrentDensity d} + (hJ : Differentiable ℝ J) (t : Time) : + Differentiable ℝ (fun x => J.chargeDensity c t x) := by + change Differentiable ℝ (↿(J.chargeDensity c) ∘ fun x => (t, x)) + refine Differentiable.comp ?_ ?_ + · exact chargeDensity_differentiable hJ + · fun_prop + +/-! + +### B.3. Smoothness of the charge density + +-/ + +lemma chargeDensity_contDiff {d : ℕ} {c : SpeedOfLight} {J : LorentzCurrentDensity d} + (hJ : ContDiff ℝ n J) : ContDiff ℝ n ↿(J.chargeDensity c) := by rw [chargeDensity_eq_timeSlice] apply timeSlice_contDiff have h1 : ∀ i, ContDiff ℝ n (fun x => J x i) := by - rw [← contDiff_euclidean] + rw [SpaceTime.contDiff_vector] exact hJ + apply ContDiff.const_smul exact h1 (Sum.inl 0) /-! @@ -103,80 +141,143 @@ lemma chargeDensity_contDiff {d : ℕ} {J : LorentzCurrentDensity d} -/ /-- The underlying (non-Lorentz) current density associated with a Lorentz current density. -/ -noncomputable def currentDensity (J : LorentzCurrentDensity d) : +noncomputable def currentDensity (c : SpeedOfLight := 1) (J : LorentzCurrentDensity d) : Time → Space d → EuclideanSpace ℝ (Fin d) := - fun t x i => J (toTimeAndSpace.symm (t, x)) (Sum.inr i) + fun t x => WithLp.toLp 2 fun i => J ((toTimeAndSpace c).symm (t, x)) (Sum.inr i) lemma currentDensity_eq_timeSlice {d : ℕ} {J : LorentzCurrentDensity d} : - J.currentDensity = timeSlice (fun x i => J x (Sum.inr i)) := by rfl + J.currentDensity c = timeSlice c (fun x => WithLp.toLp 2 + fun i => J x (Sum.inr i)) := by rfl + +/-! + +### C.1. current density of zero Lorentz current density + +-/ + +@[simp] +lemma currentDensity_zero {d : ℕ} {c : SpeedOfLight}: + currentDensity c (0 : LorentzCurrentDensity d) = 0 := by + simp [currentDensity_eq_timeSlice, timeSlice] + rfl /-! -### C.1. Differentiability of the current density +### C.2. Differentiability of the current density -/ -lemma currentDensity_differentiable {d : ℕ} {J : LorentzCurrentDensity d} - (hJ : Differentiable ℝ J) : Differentiable ℝ ↿(J.currentDensity) := by +lemma currentDensity_differentiable {d : ℕ} {c : SpeedOfLight} {J : LorentzCurrentDensity d} + (hJ : Differentiable ℝ J) : Differentiable ℝ ↿(J.currentDensity c) := by rw [currentDensity_eq_timeSlice] apply timeSlice_differentiable have h1 : ∀ i, Differentiable ℝ (fun x => J x i) := by - rw [← differentiable_euclidean] + rw [SpaceTime.differentiable_vector] exact hJ exact differentiable_euclidean.mpr fun i => h1 (Sum.inr i) -lemma currentDensity_apply_differentiable {d : ℕ} {J : LorentzCurrentDensity d} +lemma currentDensity_apply_differentiable {d : ℕ} {c : SpeedOfLight} {J : LorentzCurrentDensity d} (hJ : Differentiable ℝ J) (i : Fin d) : - Differentiable ℝ ↿(fun t x => J.currentDensity t x i) := by - change Differentiable ℝ (EuclideanSpace.proj i ∘ ↿(J.currentDensity)) + Differentiable ℝ ↿(fun t x => J.currentDensity c t x i) := by + change Differentiable ℝ (EuclideanSpace.proj i ∘ ↿(J.currentDensity c)) refine Differentiable.comp ?_ ?_ · exact ContinuousLinearMap.differentiable (𝕜 := ℝ) (EuclideanSpace.proj i) · exact currentDensity_differentiable hJ -lemma currentDensity_differentiable_space {d : ℕ} {J : LorentzCurrentDensity d} +lemma currentDensity_differentiable_space {d : ℕ} {c : SpeedOfLight} {J : LorentzCurrentDensity d} (hJ : Differentiable ℝ J) (t : Time) : - Differentiable ℝ (fun x => J.currentDensity t x) := by - change Differentiable ℝ (↿(J.currentDensity) ∘ fun x => (t, x)) + Differentiable ℝ (fun x => J.currentDensity c t x) := by + change Differentiable ℝ (↿(J.currentDensity c) ∘ fun x => (t, x)) refine Differentiable.comp ?_ ?_ · exact currentDensity_differentiable hJ · fun_prop -lemma currentDensity_apply_differentiable_space {d : ℕ} {J : LorentzCurrentDensity d} +lemma currentDensity_apply_differentiable_space {d : ℕ} {c : SpeedOfLight} + {J : LorentzCurrentDensity d} (hJ : Differentiable ℝ J) (t : Time) (i : Fin d) : - Differentiable ℝ (fun x => J.currentDensity t x i) := by - change Differentiable ℝ (EuclideanSpace.proj i ∘ (↿(J.currentDensity) ∘ fun x => (t, x))) + Differentiable ℝ (fun x => J.currentDensity c t x i) := by + change Differentiable ℝ (EuclideanSpace.proj i ∘ (↿(J.currentDensity c) ∘ fun x => (t, x))) refine Differentiable.comp ?_ ?_ · exact ContinuousLinearMap.differentiable (𝕜 := ℝ) _ · apply Differentiable.comp ?_ ?_ · exact currentDensity_differentiable hJ · fun_prop -lemma currentDensity_differentiable_time {d : ℕ} {J : LorentzCurrentDensity d} +lemma currentDensity_differentiable_time {d : ℕ} {c : SpeedOfLight} {J : LorentzCurrentDensity d} (hJ : Differentiable ℝ J) (x : Space d) : - Differentiable ℝ (fun t => J.currentDensity t x) := by - change Differentiable ℝ (↿(J.currentDensity) ∘ fun t => (t, x)) + Differentiable ℝ (fun t => J.currentDensity c t x) := by + change Differentiable ℝ (↿(J.currentDensity c) ∘ fun t => (t, x)) refine Differentiable.comp ?_ ?_ · exact currentDensity_differentiable hJ · fun_prop -lemma currentDensity_apply_differentiable_time {d : ℕ} {J : LorentzCurrentDensity d} +lemma currentDensity_apply_differentiable_time {d : ℕ} {c : SpeedOfLight} + {J : LorentzCurrentDensity d} (hJ : Differentiable ℝ J) (x : Space d) (i : Fin d) : - Differentiable ℝ (fun t => J.currentDensity t x i) := by - change Differentiable ℝ (EuclideanSpace.proj i ∘ (↿(J.currentDensity) ∘ fun t => (t, x))) + Differentiable ℝ (fun t => J.currentDensity c t x i) := by + change Differentiable ℝ (EuclideanSpace.proj i ∘ (↿(J.currentDensity c) ∘ fun t => (t, x))) refine Differentiable.comp ?_ ?_ · exact ContinuousLinearMap.differentiable (𝕜 := ℝ) _ · apply Differentiable.comp ?_ ?_ · exact currentDensity_differentiable hJ · fun_prop -lemma currentDensity_ContDiff {d : ℕ} {J : LorentzCurrentDensity d} - (hJ : ContDiff ℝ n J) : ContDiff ℝ n ↿(J.currentDensity) := by +/-! + +### C.3. Smoothness of the current density + +-/ + +lemma currentDensity_ContDiff {d : ℕ} {c : SpeedOfLight} {J : LorentzCurrentDensity d} + (hJ : ContDiff ℝ n J) : ContDiff ℝ n ↿(J.currentDensity c) := by rw [currentDensity_eq_timeSlice] apply timeSlice_contDiff have h1 : ∀ i, ContDiff ℝ n (fun x => J x i) := by - rw [← contDiff_euclidean] + rw [SpaceTime.contDiff_vector] exact hJ exact contDiff_euclidean.mpr fun i => h1 (Sum.inr i) end LorentzCurrentDensity +/-! + +## D. The Lorentz current density as a distribution + +-/ +/-- The Lorentz current density, also called four-current as a distribution. -/ +abbrev DistLorentzCurrentDensity (d : ℕ := 3) := (SpaceTime d) →d[ℝ] Lorentz.Vector d + +namespace DistLorentzCurrentDensity + +/-! + +### D.1. The underlying charge density + +-/ + +/-- The charge density underlying a Lorentz current density which is a distribution. -/ +noncomputable def chargeDensity {d : ℕ} (c : SpeedOfLight) : + (DistLorentzCurrentDensity d) →ₗ[ℝ] (Time × Space d) →d[ℝ] ℝ where + toFun J := (1 / (c : ℝ)) • (Lorentz.Vector.temporalCLM d ∘L distTimeSlice c J) + map_add' J1 J2 := by + simp + map_smul' r J := by + simp only [one_div, map_smul, ContinuousLinearMap.comp_smulₛₗ, RingHom.id_apply] + rw [smul_comm] + +/-! + +### D.2. The underlying current density + +-/ +/-- The underlying (non-Lorentz) current density associated with a distributive + Lorentz current density. -/ +noncomputable def currentDensity (c : SpeedOfLight) : + DistLorentzCurrentDensity d →ₗ[ℝ] (Time × Space d) →d[ℝ] EuclideanSpace ℝ (Fin d) where + toFun J := Lorentz.Vector.spatialCLM d ∘L distTimeSlice c J + map_add' J1 J2 := by + simp + map_smul' r J := by + simp + +end DistLorentzCurrentDensity end Electromagnetism diff --git a/PhysLean/Electromagnetism/Dynamics/Hamiltonian.lean b/PhysLean/Electromagnetism/Dynamics/Hamiltonian.lean index 8d376ecbc..17a38b4f7 100644 --- a/PhysLean/Electromagnetism/Dynamics/Hamiltonian.lean +++ b/PhysLean/Electromagnetism/Dynamics/Hamiltonian.lean @@ -29,13 +29,15 @@ in the case of three spatial dimensions. - A. The canonical momentum - A.1. The canonical momentum in terms of the kinetic term - A.2. The canonical momentum in terms of the field strength tensor + - A.3. The canonical momentum in terms of the electric field - B. The Hamiltonian - - B.1. The hamiltonian in terms of the electric and magnetic fields + - B.1. The hamiltonian in terms of the vector potential + - B.2. The hamiltonian in terms of the electric and magnetic fields ## iv. References - https://quantummechanics.ucsd.edu/ph130a/130_notes/node452.html - +- https://ph.qmul.ac.uk/sites/default/files/EMT10new.pdf -/ namespace Electromagnetism @@ -68,24 +70,25 @@ This is equivalent to `∂ L/∂ (∂_0 A)`. /-- The canonical momentum associated with the lagrangian of an electromagnetic potential and a Lorentz current density. -/ -noncomputable def canonicalMomentum (A : ElectromagneticPotential d) +noncomputable def canonicalMomentum (𝓕 : FreeSpace) (A : ElectromagneticPotential d) (J : LorentzCurrentDensity d) : SpaceTime d → Lorentz.Vector d := fun x => gradient (fun (v : Lorentz.Vector d) => - lagrangian (fun x => A x + x (Sum.inl 0) • v) J x) 0 + lagrangian 𝓕 (fun x => A x + x (Sum.inl 0) • v) J x) 0 - x (Sum.inl 0) • gradient (fun (v : Lorentz.Vector d) => - lagrangian (fun x => A x + v) J x) 0 + lagrangian 𝓕 (fun x => A x + v) J x) 0 /-! ### A.1. The canonical momentum in terms of the kinetic term -/ -lemma canonicalMomentum_eq_gradient_kineticTerm {d} (A : ElectromagneticPotential d) +lemma canonicalMomentum_eq_gradient_kineticTerm {d} + {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (hA : ContDiff ℝ 2 A) (J : LorentzCurrentDensity d) : - A.canonicalMomentum J = fun x => + A.canonicalMomentum 𝓕 J = fun x => gradient (fun (v : Lorentz.Vector d) => - kineticTerm (fun x => A x + x (Sum.inl 0) • v) x) 0:= by + kineticTerm 𝓕 (fun x => A x + x (Sum.inl 0) • v) x) 0:= by funext x apply ext_inner_right (𝕜 := ℝ) intro v @@ -96,7 +99,7 @@ lemma canonicalMomentum_eq_gradient_kineticTerm {d} (A : ElectromagneticPotentia conv_lhs => enter [2] simp [lagrangian_add_const] - have hx : DifferentiableAt ℝ (fun v => kineticTerm (fun x => A x + x (Sum.inl 0) • v) x) 0 := by + have hx : DifferentiableAt ℝ (fun v => kineticTerm 𝓕 (fun x => A x + x (Sum.inl 0) • v) x) 0 := by apply Differentiable.differentiableAt _ conv => enter [2, v] @@ -107,9 +110,10 @@ lemma canonicalMomentum_eq_gradient_kineticTerm {d} (A : ElectromagneticPotentia enter [1] simp only [lagrangian, Fin.isValue, map_add, map_smul, LinearMap.smul_apply, smul_eq_mul] - rw [fderiv_fun_sub hx (by fun_prop)] - simp only [Fin.isValue, ContinuousLinearMap.add_apply, ContinuousLinearMap.coe_smul', - Pi.smul_apply, smul_eq_mul, fderiv_const_add, ContinuousLinearMap.coe_sub', Pi.sub_apply] + rw [fderiv_fun_sub hx (by simp [freeCurrentPotential]; fun_prop)] + simp only [Fin.isValue, freeCurrentPotential, map_add, map_smul, ContinuousLinearMap.add_apply, + ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, fderiv_const_add, + ContinuousLinearMap.coe_sub', Pi.sub_apply] rw [fderiv_const_mul (by fun_prop)] simp only [Fin.isValue, ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] rw [fderiv_fun_sub (by fun_prop) (by fun_prop)] @@ -121,9 +125,10 @@ lemma canonicalMomentum_eq_gradient_kineticTerm {d} (A : ElectromagneticPotentia -/ -lemma canonicalMomentum_eq {d} (A : ElectromagneticPotential d) +lemma canonicalMomentum_eq {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (hA : ContDiff ℝ 2 A) (J : LorentzCurrentDensity d) : - A.canonicalMomentum J = fun x => fun μ => η μ μ • A.fieldStrengthMatrix x (μ, Sum.inl 0) := by + A.canonicalMomentum 𝓕 J = fun x => fun μ => + (1/𝓕.μ₀) * η μ μ • A.fieldStrengthMatrix x (μ, Sum.inl 0) := by rw [canonicalMomentum_eq_gradient_kineticTerm A hA J] funext x apply ext_inner_right (𝕜 := ℝ) @@ -158,8 +163,9 @@ lemma canonicalMomentum_eq {d} (A : ElectromagneticPotential d) rw [← Finset.sum_sub_distrib] rw [Finset.mul_sum] congr - funext μ + ext μ simp only [Fin.isValue, RCLike.inner_apply, conj_trivial] + simp only [Fin.isValue, equivEuclid_apply] rw [fieldStrengthMatrix, toFieldStrength_basis_repr_apply_eq_single] simp only [Fin.isValue, inl_0_inl_0, one_mul] ring_nf @@ -167,73 +173,118 @@ lemma canonicalMomentum_eq {d} (A : ElectromagneticPotential d) /-! +### A.3. The canonical momentum in terms of the electric field + +-/ + +lemma canonicalMomentum_eq_electricField {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) + (hA : ContDiff ℝ 2 A) (J : LorentzCurrentDensity d) : + A.canonicalMomentum 𝓕 J = fun x => fun μ => + match μ with + | Sum.inl 0 => 0 + | Sum.inr i => - (1/(𝓕.μ₀ * 𝓕.c)) * A.electricField 𝓕.c (x.time 𝓕.c) x.space i := by + rw [canonicalMomentum_eq A hA J] + funext x μ + match μ with + | Sum.inl 0 => simp + | Sum.inr i => + simp only [one_div, inr_i_inr_i, Fin.isValue, smul_eq_mul, neg_mul, one_mul, mul_neg, mul_inv_rev, + neg_inj] + rw [electricField_eq_fieldStrengthMatrix] + simp only [Fin.isValue, toTimeAndSpace_symm_apply_time_space, neg_mul, mul_neg] + field_simp + exact fieldStrengthMatrix_antisymm A x (Sum.inr i) (Sum.inl 0) + exact hA.differentiable (by simp) +/-! + ## B. The Hamiltonian -/ /-- The Hamiltonian associated with an electromagnetic potential and a Lorentz current density. -/ -noncomputable def hamiltonian (A : ElectromagneticPotential d) +noncomputable def hamiltonian (𝓕 : FreeSpace) (A : ElectromagneticPotential d) (J : LorentzCurrentDensity d) (x : SpaceTime d) : ℝ := - ∑ μ, A.canonicalMomentum J x μ * ∂_ (Sum.inl 0) A x μ - lagrangian A J x + ∑ μ, A.canonicalMomentum 𝓕 J x μ * ∂_ (Sum.inl 0) A x μ - lagrangian 𝓕 A J x /-! -### B.1. The hamiltonian in terms of the electric and magnetic fields +### B.1. The hamiltonian in terms of the vector potential +-/ + +open Time + +lemma hamiltonian_eq_electricField_vectorPotential {d} {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) (hA : ContDiff ℝ 2 A) + (J : LorentzCurrentDensity d) (x : SpaceTime d) : + A.hamiltonian 𝓕 J x = + - (1/ 𝓕.c.val^2 * 𝓕.μ₀⁻¹) * ∑ i, A.electricField 𝓕.c (x.time 𝓕.c) x.space i * + (∂ₜ (A.vectorPotential 𝓕.c · x.space) (x.time 𝓕.c) i) - lagrangian 𝓕 A J x := by + rw [hamiltonian] + congr 1 + simp [Fintype.sum_sum_type, canonicalMomentum_eq_electricField A hA J] + rw [Finset.mul_sum] + congr + funext i + rw [SpaceTime.deriv_sum_inl 𝓕.c] + rw [← Time.deriv_euclid] + simp [vectorPotential, timeSlice] + ring_nf + congr + rw [← Time.deriv_lorentzVector] + rfl + · change Differentiable ℝ (A ∘ fun t =>((toTimeAndSpace 𝓕.c).symm + (t, ((toTimeAndSpace 𝓕.c) x).2))) + apply Differentiable.comp + · exact hA.differentiable (by simp) + · fun_prop + · apply vectorPotential_differentiable_time + exact hA.differentiable (by simp) + · exact hA.differentiable (by simp) + +lemma hamiltonian_eq_electricField_scalarPotential {d} {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) (hA : ContDiff ℝ 2 A) + (J : LorentzCurrentDensity d) (x : SpaceTime d) : + A.hamiltonian 𝓕 J x = + (1/ 𝓕.c.val^2 * 𝓕.μ₀⁻¹) * (‖A.electricField 𝓕.c (x.time 𝓕.c) x.space‖ ^ 2 + + ⟪A.electricField 𝓕.c (x.time 𝓕.c) x.space, + Space.grad (A.scalarPotential 𝓕.c (x.time 𝓕.c) ·) x.space⟫_ℝ) + - lagrangian 𝓕 A J x := by + rw [hamiltonian_eq_electricField_vectorPotential A hA J x] + congr 1 + conv_lhs => + enter [2, 2, i] + rw [time_deriv_vectorPotential_eq_electricField] + simp [mul_sub, Finset.sum_sub_distrib] + rw [EuclideanSpace.norm_sq_eq] + ring_nf + congr 1 + · simp + congr + funext i + simp only [RCLike.inner_apply, conj_trivial] + ring + +/-! -This only holds in three spatial dimensions. +### B.2. The hamiltonian in terms of the electric and magnetic fields -/ -lemma hamiltonian_eq_electricField_magneticField (A : ElectromagneticPotential 3) - (hA : ContDiff ℝ 2 A) (J : LorentzCurrentDensity 3) (x : SpaceTime) : - A.hamiltonian J x = 1/2 * (‖A.electricField x.time x.space‖ ^ 2 - + ‖A.magneticField x.time x.space‖ ^ 2) - + ∑ i, (A.electricField x.time x.space i * ∂_ (Sum.inr i) A x (Sum.inl 0)) + - ⟪A x, J x⟫ₘ := by - conv_lhs => - rw [hamiltonian, lagrangian, canonicalMomentum_eq A hA J] - - rw [kineticTerm_eq_electric_magnetic' (hA.differentiable (by simp))] - simp [Fintype.sum_sum_type, Fin.sum_univ_three] - repeat rw [fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime] - simp only [Fin.isValue, one_div, space_toCoord_symm] - have h1 (i : Fin 3) : ∂_ (Sum.inl 0) A x (Sum.inr i) = - - (A.fieldStrengthMatrix x (Sum.inr i, Sum.inl 0) + ∂_ (Sum.inr i) A x (Sum.inl 0)) := by - rw [fieldStrengthMatrix, toFieldStrength_basis_repr_apply_eq_single] - simp - rw [h1, h1, h1] - repeat rw [fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime] - simp only [Fin.isValue, neg_add_rev] - calc _ - _ = ∑ i, (A.electricField (toTimeAndSpace x).1 (toTimeAndSpace x).2 i)^2 - + ∑ i, (A.electricField (toTimeAndSpace x).1 (toTimeAndSpace x).2 i * - (∂_ (Sum.inr i) A x (Sum.inl 0))) - - 2⁻¹ * (‖A.electricField (time x) fun i => x (Sum.inr i)‖ ^ 2 - - ‖A.magneticField (time x) fun i => x (Sum.inr i)‖ ^ 2) + - (minkowskiProduct (A x)) (J x) := by - rw [Fin.sum_univ_three, Fin.sum_univ_three] - ring - _ = ‖A.electricField (toTimeAndSpace x).1 (toTimeAndSpace x).2‖ ^ 2 - + ∑ i, (A.electricField (toTimeAndSpace x).1 (toTimeAndSpace x).2 i * - (∂_ (Sum.inr i) A x (Sum.inl 0))) - - 2⁻¹ * (‖A.electricField (time x) fun i => x (Sum.inr i)‖ ^ 2 - - ‖A.magneticField (time x) fun i => x (Sum.inr i)‖ ^ 2) + - (minkowskiProduct (A x)) (J x) := by - congr - rw [PiLp.norm_sq_eq_of_L2] - simp - _ = ‖A.electricField x.time x.space‖ ^ 2 - + ∑ i, (A.electricField x.time x.space i * - (∂_ (Sum.inr i) A x (Sum.inl 0))) - - 2⁻¹ * (‖A.electricField (time x) fun i => x (Sum.inr i)‖ ^ 2 - - ‖A.magneticField (time x) fun i => x (Sum.inr i)‖ ^ 2) + - (minkowskiProduct (A x)) (J x) := by rfl - _ = 1/2 * (‖A.electricField x.time x.space‖ ^ 2 + ‖A.magneticField x.time x.space‖ ^ 2) - + ∑ i, (A.electricField x.time x.space i * ∂_ (Sum.inr i) A x (Sum.inl 0)) + - ⟪A x, J x⟫ₘ := by simp [space]; ring - simp only [one_div, space_toCoord_symm, Fin.isValue] - repeat exact hA.differentiable (by simp) +lemma hamiltonian_eq_electricField_magneticField (A : ElectromagneticPotential d) + (hA : ContDiff ℝ 2 A) (J : LorentzCurrentDensity d) (x : SpaceTime d) : + A.hamiltonian 𝓕 J x = 1/2 * 𝓕.ε₀ * (‖A.electricField 𝓕.c (x.time 𝓕.c) x.space‖ ^ 2 + + 𝓕.c ^ 2 / 2 * ∑ i, ∑ j, ‖A.magneticFieldMatrix 𝓕.c (x.time 𝓕.c) x.space (i, j)‖ ^ 2) + + 𝓕.ε₀ * ⟪A.electricField 𝓕.c (x.time 𝓕.c) x.space, + Space.grad (A.scalarPotential 𝓕.c (x.time 𝓕.c) ·) x.space⟫_ℝ + + A.scalarPotential 𝓕.c (x.time 𝓕.c) x.space * J.chargeDensity 𝓕.c (x.time 𝓕.c) x.space + - ∑ i, A.vectorPotential 𝓕.c (x.time 𝓕.c) x.space i * + J.currentDensity 𝓕.c (x.time 𝓕.c) x.space i := by + rw [hamiltonian_eq_electricField_scalarPotential A hA J x] + rw [lagrangian_eq_electric_magnetic A hA J x] + simp [FreeSpace.c_sq 𝓕] + field_simp + ring end ElectromagneticPotential diff --git a/PhysLean/Electromagnetism/Dynamics/IsExtrema.lean b/PhysLean/Electromagnetism/Dynamics/IsExtrema.lean index 014d6fd50..799780212 100644 --- a/PhysLean/Electromagnetism/Dynamics/IsExtrema.lean +++ b/PhysLean/Electromagnetism/Dynamics/IsExtrema.lean @@ -31,13 +31,18 @@ Maxwell's equations with sources, i.e. Gauss's law and Ampère's law. - A. The condition for an extrema of the Lagrangian density - A.1. Extrema condition in terms of the field strength matrix + - A.2. Extrema condition in terms of tensors + - A.3. Equivariance of the extrema condition - B. Gauss's law and Ampère's law and the extrema condition - - B.1. Gauss's law from the extrema condition - - B.2. Ampere's law from the extrema condition - - B.3. Extrema condition if and only if Gauss's law and Ampère's law -- C. Second time derivatives from the extrema condition - - C.1. Second time derivatives of the magnetic field from the extrema condition - - C.2. Second time derivatives of the electric field from the extrema condition +- C. Time derivatives from the extrema condition +- D. Second time derivatives from the extrema condition + - D.1. Second time derivatives of the magnetic field from the extrema condition + - D.2. Second time derivatives of the electric field from the extrema condition +- E. Is Extema condition in the distributional case + - E.1. IsExtrema and Gauss's law and Ampère's law + - E.2. IsExtrema in terms of Vector Potentials + - E.3. The exterma condition in terms of tensors + - E.4. The invariance of the exterma condition under Lorentz transformations ## iv. References @@ -68,13 +73,13 @@ attribute [-simp] Nat.succ_eq_add_one -/ /-- The condition on an electromagnetic potential to be an extrema of the lagrangian. -/ -def IsExtrema {d} (A : ElectromagneticPotential d) +def IsExtrema {d} (𝓕 : FreeSpace) (A : ElectromagneticPotential d) (J : LorentzCurrentDensity d) : Prop := - gradLagrangian A J = 0 + gradLagrangian 𝓕 A J = 0 -lemma isExtrema_iff_gradLagrangian (A : ElectromagneticPotential d) +lemma isExtrema_iff_gradLagrangian {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (J : LorentzCurrentDensity d) : - IsExtrema A J ↔ A.gradLagrangian J = 0 := by rfl + IsExtrema 𝓕 A J ↔ A.gradLagrangian 𝓕 J = 0 := by rfl /-! @@ -82,378 +87,370 @@ lemma isExtrema_iff_gradLagrangian (A : ElectromagneticPotential d) -/ -lemma isExtrema_iff_fieldStrengthMatrix (A : ElectromagneticPotential d) +lemma isExtrema_iff_fieldStrengthMatrix {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) (hJ : ContDiff ℝ ∞ J) : - IsExtrema A J ↔ - ∀ x, ∀ ν, ∑ μ, ∂_ μ (A.fieldStrengthMatrix · (μ, ν)) x = J x ν := by + IsExtrema 𝓕 A J ↔ + ∀ x, ∀ ν, ∑ μ, ∂_ μ (A.fieldStrengthMatrix · (μ, ν)) x = 𝓕.μ₀ * J x ν := by rw [isExtrema_iff_gradLagrangian, gradLagrangian_eq_sum_fieldStrengthMatrix A hA J hJ, funext_iff] conv_lhs => enter [x, 1, 2, ν] rw [smul_smul] - simp only [Pi.zero_apply] - trans ∀ x, ∀ ν, (η ν ν * (∑ μ, ∂_ μ (fun x => (A.fieldStrengthMatrix x) (μ, ν)) x - J x ν)) = 0 - · apply Iff.intro - · intro h x - specialize h x - have h' := linearIndependent_iff'.mp (Lorentz.Vector.basis.linearIndependent) - Finset.univ - (fun ν => (η ν ν * (∑ μ, ∂_ μ (fun x => (A.fieldStrengthMatrix x) (μ, ν)) x - J x ν))) - (by simpa using h) - intro ν - simpa using h' ν - · intro h x - simp [h x] + conv_lhs => + enter [x] + simp only [one_div, Pi.zero_apply] + rw [Lorentz.Vector.sum_basis_eq_zero_iff] apply Iff.intro · intro h x ν - have h' := h x ν - simp at h' - have h'' : η ν ν ≠ 0 := by - exact η_diag_ne_zero + specialize h x ν + simp at h + have h' : η ν ν ≠ 0 := η_diag_ne_zero simp_all - linear_combination h' + linear_combination (norm := field_simp) 𝓕.μ₀ * h + ring · intro h x ν - rw [h x] - simp + specialize h x ν + simp only [mul_eq_zero] + right + linear_combination (norm := field_simp) 𝓕.μ₀⁻¹ * h + ring /-! -## B. Gauss's law and Ampère's law and the extrema condition +### A.2. Extrema condition in terms of tensors + +The electromagnetic potential is an exterma of the lagrangian if and only if + +$$\frac{1}{\mu_0} \partial_\mu F^{\mu \nu} - J^{\nu} = 0.$$ -/ +lemma isExtrema_iff_tensors {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) + (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) (hJ : ContDiff ℝ ∞ J) : + IsExtrema 𝓕 A J ↔ ∀ x, + {((1/ 𝓕.μ₀ : ℝ) • tensorDeriv A.toFieldStrength x | κ κ ν') + - (J x | ν')}ᵀ = 0 := by + apply Iff.intro + · intro h + simp only [IsExtrema] at h + intro x + have h1 : ((Tensorial.toTensor (M := Lorentz.Vector d)).symm + (permT id (PermCond.auto) {((1/ 𝓕.μ₀ : ℝ) • tensorDeriv A.toFieldStrength x | κ κ ν') + + - (J x | ν')}ᵀ)) = 0 := by + funext ν + have h2 : gradLagrangian 𝓕 A J x ν = 0 := by simp [h] + rw [gradLagrangian_eq_tensor A hA J hJ] at h2 + simp only [Nat.reduceSucc, Nat.reduceAdd, Fin.isValue, one_div, map_smul, map_neg, map_add, + permT_permT, CompTriple.comp_eq, apply_add, apply_smul, Lorentz.Vector.neg_apply, + mul_eq_zero] at h2 + have hn : η ν ν ≠ 0 := η_diag_ne_zero + simp_all only [Fin.isValue, false_or, ne_eq, Nat.reduceSucc, Nat.reduceAdd, one_div, map_smul, + map_neg, map_add, permT_permT, CompTriple.comp_eq, apply_add, apply_smul, + Lorentz.Vector.neg_apply, Lorentz.Vector.zero_apply] + generalize {((1/ 𝓕.μ₀ : ℝ) • tensorDeriv A.toFieldStrength x | κ κ ν') + + - (J x | ν')}ᵀ = V at * + simp only [Nat.reduceSucc, Nat.reduceAdd, Fin.isValue, EmbeddingLike.map_eq_zero_iff] at h1 + rw [permT_eq_zero_iff] at h1 + exact h1 + · intro h + simp only [IsExtrema] + funext x + funext ν + rw [gradLagrangian_eq_tensor A hA J hJ, h] + simp only [map_zero, Lorentz.Vector.zero_apply, mul_zero, Pi.zero_apply] + /-! -### B.1. Gauss's law from the extrema condition +### A.3. Equivariance of the extrema condition + +If `A` is an extrema of the lagrangian with current density `J`, then the Lorentz transformation +`Λ • A (Λ⁻¹ • x)` is an extrema of the lagrangian with current density `Λ • J (Λ⁻¹ • x)`. + +Combined with `time_deriv_time_deriv_electricField_of_isExtrema`, this shows that +the speed with which an electromagnetic wave propagates is invariant under Lorentz transformations. -/ -lemma gaussLaw_electricField_of_isExtrema {A : ElectromagneticPotential d} - (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) - (hJ : ContDiff ℝ ∞ J) (h : IsExtrema A J) - (t : Time) (x : Space d) : (∇ ⬝ (A.electricField t)) x = J.chargeDensity t x := by - rw [isExtrema_iff_fieldStrengthMatrix A hA J hJ] at h - specialize h (SpaceTime.toTimeAndSpace.symm (t, x)) (Sum.inl 0) - simp [LorentzCurrentDensity.chargeDensity] - rw [← h] - simp [Fintype.sum_sum_type, Space.div] - congr - funext i - rw [SpaceTime.deriv_sum_inr] - congr - funext x - simp [Space.coord_apply] - rw [electricField_eq_fieldStrengthMatrix A t x i (hA.differentiable (by simp))] - rw [fieldStrengthMatrix_antisymm] - simp only [Fin.isValue, neg_neg] - · refine fieldStrengthMatrix_differentiable ?_ - exact hA.of_le (ENat.LEInfty.out) +lemma isExtrema_lorentzGroup_apply_iff {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) + (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) (hJ : ContDiff ℝ ∞ J) + (Λ : LorentzGroup d) : + IsExtrema 𝓕 (fun x => Λ • A (Λ⁻¹ • x)) (fun x => Λ • J (Λ⁻¹ • x)) ↔ + IsExtrema 𝓕 A J := by + rw [isExtrema_iff_tensors] + conv_lhs => + enter [x, 1, 1, 2, 2, 2] + change tensorDeriv (fun x => toFieldStrength (fun x => Λ • A (Λ⁻¹ • x)) x) x + enter [1,x] + rw [toFieldStrength_equivariant _ _ (hA.differentiable (by simp))] + conv_lhs => + enter [x] + rw [tensorDeriv_equivariant _ _ _ (by + apply toFieldStrength_differentiable + exact hA.of_le ENat.LEInfty.out)] + rw [smul_comm] + rw [Tensorial.toTensor_smul, Tensorial.toTensor_smul] + simp only [Nat.reduceAdd, Nat.reduceSucc, Fin.isValue, one_div, map_smul, actionT_smul, + contrT_equivariant, map_neg, permT_equivariant] + rw [smul_comm, ← Tensor.actionT_neg, ← Tensor.actionT_add] + apply Iff.intro + · intro h + rw [isExtrema_iff_tensors A hA J hJ] + intro x + apply MulAction.injective Λ + simp only [Nat.reduceAdd, Nat.reduceSucc, Fin.isValue, one_div, map_smul, map_neg, + _root_.smul_add, actionT_smul, _root_.smul_neg, _root_.smul_zero] + simpa using h (Λ • x) + · intro h x + rw [isExtrema_iff_tensors A hA J hJ] at h + specialize h (Λ⁻¹ • x) + simp at h + rw [h] + simp + · change ContDiff ℝ ∞ (actionCLM Λ ∘ A ∘ actionCLM Λ⁻¹) + apply ContDiff.comp + · exact ContinuousLinearMap.contDiff (actionCLM Λ) + · apply ContDiff.comp + · exact hA + · exact ContinuousLinearMap.contDiff (actionCLM Λ⁻¹) + · change ContDiff ℝ ∞ (actionCLM Λ ∘ J ∘ actionCLM Λ⁻¹) + apply ContDiff.comp + · exact ContinuousLinearMap.contDiff (actionCLM Λ) + · apply ContDiff.comp + · exact hJ + · exact ContinuousLinearMap.contDiff (actionCLM Λ⁻¹) /-! -### B.2. Ampere's law from the extrema condition - -Working in general spatial dimension `d`. +## B. Gauss's law and Ampère's law and the extrema condition -/ -lemma ampereLaw_magneticFieldMatrix_of_isExtrema {A : ElectromagneticPotential d} +lemma isExtrema_iff_gauss_ampere_magneticFieldMatrix {d} {𝓕 : FreeSpace} + {A : ElectromagneticPotential d} (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) - (hJ : ContDiff ℝ ∞ J) (h : IsExtrema A J) - (t : Time) (x : Space d) (i : Fin d) : - ∂ₜ (fun t => A.electricField t x) t i = - ∑ j, Space.deriv j (A.magneticFieldMatrix t · (j, i)) x - J.currentDensity t x i := by - rw [isExtrema_iff_fieldStrengthMatrix A hA J hJ] at h - specialize h (SpaceTime.toTimeAndSpace.symm (t, x)) (Sum.inr i) - simp [LorentzCurrentDensity.currentDensity] - rw [← h] - - simp [Fintype.sum_sum_type] - have h1 : ∂ₜ (fun t => A.electricField t x) t i = - - ∂_ (Sum.inl 0) (fun x => (A.fieldStrengthMatrix x) (Sum.inl 0, Sum.inr i)) - (toTimeAndSpace.symm (t, x)) := by - rw [SpaceTime.deriv_sum_inl _ - (fieldStrengthMatrix_differentiable (hA.of_le (ENat.LEInfty.out)))] - trans ∂ₜ (fun t => A.electricField t x i) t - · rw [Time.deriv_eq, Time.deriv_eq] - trans (fderiv ℝ (EuclideanSpace.proj i ∘ fun t => A.electricField t x) t) 1;swap - · rfl - rw [fderiv_comp] - simp only [ContinuousLinearMap.fderiv, ContinuousLinearMap.coe_comp', Function.comp_apply, - PiLp.proj_apply] - · fun_prop - · apply Differentiable.differentiableAt - apply A.electricField_differentiable_time - exact hA.of_le (ENat.LEInfty.out) - · conv_lhs => - enter [1, t] - rw [electricField_eq_fieldStrengthMatrix A t x i (hA.differentiable (by simp))] - simp [Time.deriv_eq] - have h2 : ∑ j, Space.deriv j (fun x => A.magneticFieldMatrix t x (j, i)) x = - ∑ a₂, ∂_ (Sum.inr a₂) (fun x => (A.fieldStrengthMatrix x) (Sum.inr a₂, Sum.inr i)) - (toTimeAndSpace.symm (t, x)) := by - congr - funext j - rw [SpaceTime.deriv_sum_inr _ - (fieldStrengthMatrix_differentiable (hA.of_le (ENat.LEInfty.out)))] - simp [magneticFieldMatrix] - rfl - rw [h1, h2] - simp + (hJ : ContDiff ℝ ∞ J) : + IsExtrema 𝓕 A J ↔ ∀ t, ∀ x, (∇ ⬝ (A.electricField 𝓕.c t)) x = J.chargeDensity 𝓕.c t x / 𝓕.ε₀ + ∧ ∀ i, 𝓕.μ₀ * 𝓕.ε₀ * ∂ₜ (fun t => A.electricField 𝓕.c t x) t i = + ∑ j, ∂[j] (A.magneticFieldMatrix 𝓕.c t · (j, i)) x - 𝓕.μ₀ * J.currentDensity 𝓕.c t x i := by + rw [isExtrema_iff_gradLagrangian] + rw [funext_iff] + conv_lhs => + enter [x] + rw [gradLagrangian_eq_electricField_magneticField (𝓕 := 𝓕) A hA J hJ] + simp only [Pi.zero_apply] + rw [Lorentz.Vector.sum_inl_inr_basis_eq_zero_iff] + simp only [forall_and] + apply and_congr + · apply Iff.intro + · intro h t x + specialize h ((toTimeAndSpace 𝓕.c).symm (t, x)) + simp at h + linear_combination (norm := simp) (𝓕.μ₀ * 𝓕.c) * h + field_simp + simp only [FreeSpace.c_sq, one_div, mul_inv_rev, mul_zero] + field_simp + ring + · intro h x + specialize h (x.time 𝓕.c) x.space + linear_combination (norm := simp) (𝓕.μ₀⁻¹ * 𝓕.c⁻¹) * h + field_simp + simp only [FreeSpace.c_sq, one_div, mul_inv_rev, mul_zero] + field_simp + ring + · apply Iff.intro + · intro h t x i + specialize h ((toTimeAndSpace 𝓕.c).symm (t, x)) i + simp at h + linear_combination (norm := simp) (𝓕.μ₀) * h + field_simp + simp + · intro h x i + specialize h (x.time 𝓕.c) x.space i + linear_combination (norm := simp) (𝓕.μ₀⁻¹) * h + field_simp + simp /-! -### B.3. Extrema condition if and only if Gauss's law and Ampère's law +## C. Time derivatives from the extrema condition -/ -lemma isExtrema_iff_gauss_ampere_magneticFieldMatrix {d} {A : ElectromagneticPotential d} - (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) - (hJ : ContDiff ℝ ∞ J) : - IsExtrema A J ↔ ∀ x, ∀ t, (∇ ⬝ (A.electricField t)) x = J.chargeDensity t x - ∧ ∀ i, ∂ₜ (fun t => A.electricField t x) t i = - ∑ j, ∂[j] (A.magneticFieldMatrix t · (j, i)) x - J.currentDensity t x i := by - apply Iff.intro - · intro h x t - apply And.intro - · exact gaussLaw_electricField_of_isExtrema hA J hJ h t x - · exact ampereLaw_magneticFieldMatrix_of_isExtrema hA J hJ h t x - intro h - rw [isExtrema_iff_fieldStrengthMatrix A hA J hJ] - intro x ν - match ν with - | Sum.inl 0 => - have h1 := (h x.space x.time).1 - simp [Fintype.sum_sum_type] - simp [LorentzCurrentDensity.chargeDensity] at h1 - rw [← h1] - simp [Space.div] - congr - funext ν - rw [SpaceTime.deriv_sum_inr] - congr - funext y - simp [Space.coord_apply] - rw [electricField_eq_fieldStrengthMatrix, fieldStrengthMatrix_antisymm] - simp - rfl - · exact hA.differentiable (by simp) - · apply fieldStrengthMatrix_differentiable - exact hA.of_le (ENat.LEInfty.out) - | Sum.inr i => - have hn := (h x.space x.time).2 i - simp [Fintype.sum_sum_type] - have h1 : - ∂ₜ (fun t => A.electricField t x.space) x.time i = - ∂_ (Sum.inl 0) (fun x => (A.fieldStrengthMatrix x) (Sum.inl 0, Sum.inr i)) x := by - rw [SpaceTime.deriv_sum_inl _ - (fieldStrengthMatrix_differentiable (hA.of_le (ENat.LEInfty.out)))] - trans -∂ₜ (fun t => A.electricField t x.space i) x.time - · rw [Time.deriv_eq, Time.deriv_eq] - trans -(fderiv ℝ (EuclideanSpace.proj i ∘ fun t => A.electricField t x.space) x.time) 1;swap - · rfl - rw [fderiv_comp] - simp only [ContinuousLinearMap.fderiv, ContinuousLinearMap.coe_comp', Function.comp_apply, - PiLp.proj_apply] - · fun_prop - · apply Differentiable.differentiableAt - apply A.electricField_differentiable_time - exact hA.of_le (ENat.LEInfty.out) - · conv_lhs => - enter [1, 1, t] - rw [electricField_eq_fieldStrengthMatrix A t x.space i (hA.differentiable (by simp))] - simp [Time.deriv_eq] - rfl - have h2 : ∑ j, Space.deriv j (fun y => A.magneticFieldMatrix x.time y (j, i)) x.space = - ∑ a₂, ∂_ (Sum.inr a₂) (fun x => (A.fieldStrengthMatrix x) (Sum.inr a₂, Sum.inr i)) x := by - congr - funext j - rw [SpaceTime.deriv_sum_inr _ - (fieldStrengthMatrix_differentiable (hA.of_le (ENat.LEInfty.out)))] - simp [magneticFieldMatrix] - rfl - rw [← h1, ← h2, hn] - simp [LorentzCurrentDensity.currentDensity] +lemma time_deriv_electricField_of_isExtrema {A : ElectromagneticPotential d} + {𝓕 : FreeSpace} + (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) (hJ : ContDiff ℝ ∞ J) + (h : IsExtrema 𝓕 A J) (t : Time) (x : Space d) (i : Fin d) : + ∂ₜ (A.electricField 𝓕.c · x) t i = + 1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, ∂[j] (A.magneticFieldMatrix 𝓕.c t · (j, i)) x - + (1/ 𝓕.ε₀) * J.currentDensity 𝓕.c t x i := by + rw [isExtrema_iff_gauss_ampere_magneticFieldMatrix hA J hJ] at h + linear_combination (norm := simp) (𝓕.μ₀ * 𝓕.ε₀)⁻¹ * ((h t x).2 i) + field_simp + ring /-! -## C. Second time derivatives from the extrema condition +## D. Second time derivatives from the extrema condition -/ -open Time /-! -### C.1. Second time derivatives of the magnetic field from the extrema condition +### D.1. Second time derivatives of the magnetic field from the extrema condition + +We show that the magnetic field matrix $B_{ij}$ satisfies the following wave-like equation +$$\frac{\partial^2 B_{ij}}{\partial t^2} = c^2 \sum_k \frac{\partial^2 B_{ij}}{\partial x_k^2} + + \frac{1}{\epsilon_0} \left(\frac{\partial J_i}{\partial x_j} - + \frac{\partial J_j}{\partial x_i} \right).$$ +When the free current density is zero, this reduces to the wave equation. -/ lemma time_deriv_time_deriv_magneticFieldMatrix_of_isExtrema {A : ElectromagneticPotential d} - (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) (hJd : Differentiable ℝ J) - (hJ : ContDiff ℝ ∞ J) (h : IsExtrema A J) + {𝓕 : FreeSpace} + (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) + (hJ : ContDiff ℝ ∞ J) (h : IsExtrema 𝓕 A J) (t : Time) (x : Space d) (i j : Fin d) : - ∂ₜ (∂ₜ (A.magneticFieldMatrix · x (i, j))) t = - ∑ k, ∂[k] (∂[k] (A.magneticFieldMatrix t · (i, j))) x + - ∂[j] (J.currentDensity t · i) x - ∂[i] (J.currentDensity t · j) x := by - calc _ - _ = ∂ₜ (fun t => Space.deriv i (fun x => A.electricField t x j) x - - Space.deriv j (fun x => A.electricField t x i) x) t := by - conv_lhs => - enter [1, t] - rw [time_deriv_magneticFieldMatrix _ (hA.of_le (ENat.LEInfty.out))] - _ = ∂ₜ (fun t => Space.deriv i (fun x => A.electricField t x j) x) t - - ∂ₜ (fun t => Space.deriv j (fun x => A.electricField t x i) x) t := by - rw [Time.deriv_eq, fderiv_fun_sub] - simp [Time.deriv_eq] - all_goals - · apply ClassicalMechanics.space_deriv_differentiable_time - apply electricField_apply_contDiff - apply hA.of_le (right_eq_inf.mp rfl) - _ = ∂[i] (fun x => ∂ₜ (fun t => A.electricField t x j) t) x - - ∂[j] (fun x => ∂ₜ (fun t => A.electricField t x i) t) x := by - rw [ClassicalMechanics.time_deriv_comm_space_deriv, - ClassicalMechanics.time_deriv_comm_space_deriv] - all_goals - · apply electricField_apply_contDiff - apply hA.of_le (right_eq_inf.mp rfl) - _ = ∂[i] (fun x => ∂ₜ (fun t => A.electricField t x) t j) x - - ∂[j] (fun x => ∂ₜ (fun t => A.electricField t x) t i) x := by - congr - all_goals - · funext x - rw [Time.deriv_euclid] - apply electricField_differentiable_time - apply hA.of_le (right_eq_inf.mp rfl) - _ = ∂[i] (fun x => ∑ k, ∂[k] (A.magneticFieldMatrix t · (k, j)) x - - J.currentDensity t x j) x - - ∂[j] (fun x => ∑ k, ∂[k] (A.magneticFieldMatrix t · (k, i)) x - - J.currentDensity t x i) x := by - rw [isExtrema_iff_gauss_ampere_magneticFieldMatrix hA J hJ] at h - congr - all_goals - · funext x - rw [(h _ _).2] - _ = ∂[i] (fun x => ∑ k, ∂[k] (A.magneticFieldMatrix t · (k, j)) x) x - - ∂[i] (fun x => J.currentDensity t x j) x - - ∂[j] (fun x => ∑ k, ∂[k] (A.magneticFieldMatrix t · (k, i)) x) x + - ∂[j] (fun x => J.currentDensity t x i) x := by - rw [Space.deriv_eq_fderiv_basis] - rw [fderiv_fun_sub] - conv_lhs => - enter [2] - rw [Space.deriv_eq_fderiv_basis, - fderiv_fun_sub (by - apply Differentiable.fun_sum - intro i _ - apply Space.deriv_differentiable - apply magneticFieldMatrix_space_contDiff - apply hA.of_le - exact right_eq_inf.mp rfl) - (by - apply Differentiable.differentiableAt - apply LorentzCurrentDensity.currentDensity_apply_differentiable_space - exact hJd)] - simp [Space.deriv_eq_fderiv_basis] - ring - · apply Differentiable.fun_sum + ∂ₜ (∂ₜ (A.magneticFieldMatrix 𝓕.c · x (i, j))) t = + 𝓕.c ^ 2 * ∑ k, ∂[k] (∂[k] (A.magneticFieldMatrix 𝓕.c t · (i, j))) x + + 𝓕.ε₀⁻¹ * (∂[j] (J.currentDensity 𝓕.c t · i) x - ∂[i] (J.currentDensity 𝓕.c t · j) x) := by + rw [time_deriv_time_deriv_magneticFieldMatrix A (hA.of_le (ENat.LEInfty.out))] + conv_lhs => + enter [2, 2, x] + rw [time_deriv_electricField_of_isExtrema hA J hJ h] + conv_lhs => + enter [1, 2, x] + rw [time_deriv_electricField_of_isExtrema hA J hJ h] + rw [Space.deriv_eq_fderiv_basis] + rw [fderiv_fun_sub (by + apply Differentiable.const_mul + apply Differentiable.fun_sum intro i _ apply Space.deriv_differentiable - apply magneticFieldMatrix_space_contDiff - apply hA.of_le - exact right_eq_inf.mp rfl - · apply Differentiable.differentiableAt - apply LorentzCurrentDensity.currentDensity_apply_differentiable_space - exact hJd - _ = ∂[i] (fun x => ∑ k, ∂[k] (A.magneticFieldMatrix t · (k, j)) x) x - - ∂[j] (fun x => ∑ k, ∂[k] (A.magneticFieldMatrix t · (k, i)) x) x + - ∂[j] (fun x => J.currentDensity t x i) x - - ∂[i] (fun x => J.currentDensity t x j) x := by ring - _ = ∑ k, (∂[i] (fun x => ∂[k] (A.magneticFieldMatrix t · (k, j)) x) x - - ∂[j] (fun x => ∂[k] (A.magneticFieldMatrix t · (k, i)) x) x) + - ∂[j] (fun x => J.currentDensity t x i) x - - ∂[i] (fun x => J.currentDensity t x j) x := by - rw [Finset.sum_sub_distrib] - congr - all_goals - rw [Space.deriv_eq_fderiv_basis] - rw [fderiv_fun_sum] - simp only [ContinuousLinearMap.coe_sum', Finset.sum_apply] - congr - funext k - rw [Space.deriv_eq_fderiv_basis] + apply magneticFieldMatrix_space_contDiff _ (hA.of_le (right_eq_inf.mp rfl))) + ((LorentzCurrentDensity.currentDensity_apply_differentiable_space + (hJ.differentiable (by simp)) _ _).const_mul _).differentiableAt, + fderiv_const_mul (by + apply Differentiable.fun_sum intro i _ + apply Space.deriv_differentiable + apply magneticFieldMatrix_space_contDiff _ (hA.of_le (right_eq_inf.mp rfl))), + fderiv_const_mul (by + apply (LorentzCurrentDensity.currentDensity_apply_differentiable_space + (hJ.differentiable (by simp)) _ _).differentiableAt), + fderiv_fun_sum fun i _ => by apply Differentiable.differentiableAt apply Space.deriv_differentiable - apply magneticFieldMatrix_space_contDiff - apply hA.of_le - exact right_eq_inf.mp rfl - _ = ∑ k, ∂[k] (∂[k] (A.magneticFieldMatrix t · (i, j))) x + - ∂[j] (fun x => J.currentDensity t x i) x - - ∂[i] (fun x => J.currentDensity t x j) x := by - congr - funext k - rw [Space.deriv_commute _ (by - apply magneticFieldMatrix_space_contDiff - apply hA.of_le - exact right_eq_inf.mp rfl), Space.deriv_eq_fderiv_basis] - conv_lhs => - enter [2] - rw [Space.deriv_commute _ (by - apply magneticFieldMatrix_space_contDiff - apply hA.of_le - exact right_eq_inf.mp rfl), Space.deriv_eq_fderiv_basis] - trans fderiv ℝ (Space.deriv i (fun x => A.magneticFieldMatrix t x (k, j)) - - Space.deriv j fun x => A.magneticFieldMatrix t x (k, i)) x (Space.basis k) - · rw [fderiv_sub] - simp only [ContinuousLinearMap.coe_sub', Pi.sub_apply] - all_goals + apply magneticFieldMatrix_space_contDiff _ (hA.of_le (right_eq_inf.mp rfl))] + conv_lhs => + enter [2] + rw [Space.deriv_eq_fderiv_basis] + rw [fderiv_fun_sub (by + apply Differentiable.const_mul + apply Differentiable.fun_sum + intro i _ + apply Space.deriv_differentiable + apply magneticFieldMatrix_space_contDiff _ (hA.of_le (right_eq_inf.mp rfl))) + ((LorentzCurrentDensity.currentDensity_apply_differentiable_space + (hJ.differentiable (by simp)) _ _).const_mul _).differentiableAt, + fderiv_const_mul (by + apply Differentiable.fun_sum + intro i _ + apply Space.deriv_differentiable + apply magneticFieldMatrix_space_contDiff _ (hA.of_le (right_eq_inf.mp rfl))), + fderiv_const_mul (by + apply (LorentzCurrentDensity.currentDensity_apply_differentiable_space + (hJ.differentiable (by simp)) _ _).differentiableAt), + fderiv_fun_sum fun i _ => by apply Differentiable.differentiableAt apply Space.deriv_differentiable - apply magneticFieldMatrix_space_contDiff - apply hA.of_le - exact right_eq_inf.mp rfl - rw [← Space.deriv_eq_fderiv_basis] - congr - funext x - conv_rhs => - rw [magneticFieldMatrix_space_deriv_eq _ (hA.of_le (ENat.LEInfty.out))] - simp + apply magneticFieldMatrix_space_contDiff _ (hA.of_le (right_eq_inf.mp rfl))] + simp [← Space.deriv_eq_fderiv_basis, FreeSpace.c_sq] + field_simp + conv_rhs => + enter [1, 2, k, 2, x] + rw [magneticFieldMatrix_space_deriv_eq A (hA.of_le (right_eq_inf.mp rfl))] + conv_rhs => + enter [1, 2, k] + rw [Space.deriv_eq_fderiv_basis] + rw [fderiv_fun_sub (by + apply Space.deriv_differentiable + apply magneticFieldMatrix_space_contDiff _ (hA.of_le (right_eq_inf.mp rfl))) + (by + apply Space.deriv_differentiable + apply magneticFieldMatrix_space_contDiff _ (hA.of_le (right_eq_inf.mp rfl)))] + simp [← Space.deriv_eq_fderiv_basis] + rw [Space.deriv_commute _ (by + apply magneticFieldMatrix_space_contDiff _ (hA.of_le (right_eq_inf.mp rfl)))] + enter [2] + rw [Space.deriv_commute _ (by + apply magneticFieldMatrix_space_contDiff _ (hA.of_le (right_eq_inf.mp rfl)))] + simp only [Finset.sum_sub_distrib] + ring /-! -### C.2. Second time derivatives of the electric field from the extrema condition +### D.2. Second time derivatives of the electric field from the extrema condition + +We show that the electric field $E_i$ satisfies the following wave-like equation: + +$$\frac{\partial^2 E_{i}}{\partial t^2} = c^2 \sum_k \frac{\partial^2 E_{i}}{\partial x_k^2} - + \frac{c ^ 2}{\epsilon_0} \frac{\partial \rho}{\partial x_i} - + c ^ 2 μ_0 \frac{\partial J_i}{\partial t}.$$ + +When the free current density and charge density are zero, this reduces to the wave equation. -/ lemma time_deriv_time_deriv_electricField_of_isExtrema {A : ElectromagneticPotential d} - (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) (hJd : Differentiable ℝ J) - (hJ : ContDiff ℝ ∞ J) (h : IsExtrema A J) + {𝓕 : FreeSpace} + (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) + (hJ : ContDiff ℝ ∞ J) (h : IsExtrema 𝓕 A J) (t : Time) (x : Space d) (i : Fin d) : - ∂ₜ (∂ₜ (A.electricField · x i)) t = ∑ j, (∂[j] (∂[j] (A.electricField t · i)) x) - - ∂[i] (J.chargeDensity t ·) x - ∂ₜ (J.currentDensity · x i) t := by + ∂ₜ (∂ₜ (A.electricField 𝓕.c · x i)) t = + 𝓕.c ^ 2 * ∑ j, (∂[j] (∂[j] (A.electricField 𝓕.c t · i)) x) - + 𝓕.c ^ 2 / 𝓕.ε₀ * ∂[i] (J.chargeDensity 𝓕.c t ·) x - + 𝓕.c ^ 2 * 𝓕.μ₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by calc _ - _ = ∂ₜ (fun t => ∑ j, ∂[j] (A.magneticFieldMatrix t · (j, i)) x - - J.currentDensity t x i) t := by - rw [isExtrema_iff_gauss_ampere_magneticFieldMatrix hA J hJ] at h - congr - funext t - rw [Time.deriv_euclid] - rw [(h _ _).2] - apply electricField_differentiable_time - apply hA.of_le (right_eq_inf.mp rfl) - _ = ∂ₜ (fun t => ∑ j, ∂[j] (A.magneticFieldMatrix t · (j, i)) x) t - - ∂ₜ (J.currentDensity · x i) t := by + _= ∂ₜ (fun t => + 1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, Space.deriv j (fun x => magneticFieldMatrix 𝓕.c A t x (j, i)) x - + 1 / 𝓕.ε₀ * LorentzCurrentDensity.currentDensity 𝓕.c J t x i) t := by + conv_lhs => + enter [1] + change fun t => ∂ₜ (A.electricField 𝓕.c · x i) t + enter [t] + rw [Time.deriv_euclid (electricField_differentiable_time + (hA.of_le (right_eq_inf.mp rfl)) _), + time_deriv_electricField_of_isExtrema hA J hJ h] + _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) * ∂ₜ (fun t => ∑ j, ∂[j] (A.magneticFieldMatrix 𝓕.c t · (j, i)) x) t - + 1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by rw [Time.deriv_eq] rw [fderiv_fun_sub] + simp only [one_div, mul_inv_rev, ContinuousLinearMap.coe_sub', Pi.sub_apply] + rw [fderiv_const_mul (by + apply Differentiable.fun_sum + intro j _ + apply Space.space_deriv_differentiable_time + apply magneticFieldMatrix_contDiff + apply hA.of_le (right_eq_inf.mp rfl))] + rw [fderiv_const_mul (by + apply Differentiable.differentiableAt + apply LorentzCurrentDensity.currentDensity_apply_differentiable_time + exact hJ.differentiable (by simp))] simp [Time.deriv_eq] - · apply Differentiable.fun_sum + · apply Differentiable.const_mul + apply Differentiable.fun_sum intro j _ - apply ClassicalMechanics.space_deriv_differentiable_time + apply Space.space_deriv_differentiable_time apply magneticFieldMatrix_contDiff apply hA.of_le (right_eq_inf.mp rfl) - · apply Differentiable.differentiableAt + · apply DifferentiableAt.const_mul + apply Differentiable.differentiableAt apply LorentzCurrentDensity.currentDensity_apply_differentiable_time - exact hJd - _ = (∑ j, ∂ₜ (fun t => ∂[j] (A.magneticFieldMatrix t · (j, i)) x)) t - - ∂ₜ (J.currentDensity · x i) t := by + exact hJ.differentiable (by simp) + _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) * ((∑ j, ∂ₜ (fun t => ∂[j] (A.magneticFieldMatrix 𝓕.c t · (j, i)) x)) t) - + 1 / 𝓕.ε₀ * (∂ₜ (J.currentDensity 𝓕.c · x i) t) := by congr rw [Time.deriv_eq] rw [fderiv_fun_sum] @@ -461,20 +458,21 @@ lemma time_deriv_time_deriv_electricField_of_isExtrema {A : ElectromagneticPoten rfl intro i _ apply Differentiable.differentiableAt - apply ClassicalMechanics.space_deriv_differentiable_time + apply Space.space_deriv_differentiable_time apply magneticFieldMatrix_contDiff apply hA.of_le (right_eq_inf.mp rfl) - _ = (∑ j, ∂[j] (fun x => ∂ₜ (A.magneticFieldMatrix · x (j, i)) t)) x - - ∂ₜ (J.currentDensity · x i) t := by + _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) * (∑ j, ∂[j] (fun x => ∂ₜ (A.magneticFieldMatrix 𝓕.c · x (j, i)) t)) x - + 1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by congr simp only [Finset.sum_apply] congr funext k - rw [ClassicalMechanics.time_deriv_comm_space_deriv] + rw [Space.time_deriv_comm_space_deriv] apply magneticFieldMatrix_contDiff apply hA.of_le (right_eq_inf.mp rfl) - _ = (∑ j, ∂[j] (fun x => ∂[j] (A.electricField t · i) x - ∂[i] (A.electricField t · j) x)) x - - ∂ₜ (J.currentDensity · x i) t := by + _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) *(∑ j, ∂[j] (fun x => ∂[j] (A.electricField 𝓕.c t · i) x - + ∂[i] (A.electricField 𝓕.c t · j) x)) x - + 1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by congr simp only [Finset.sum_apply] congr @@ -482,9 +480,9 @@ lemma time_deriv_time_deriv_electricField_of_isExtrema {A : ElectromagneticPoten congr funext x rw [time_deriv_magneticFieldMatrix _ (hA.of_le (ENat.LEInfty.out))] - _ = (∑ j, (∂[j] (fun x => ∂[j] (A.electricField t · i) x) x - - ∂[j] (fun x => ∂[i] (A.electricField t · j) x) x)) - - ∂ₜ (J.currentDensity · x i) t := by + _ = (1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, (∂[j] (fun x => ∂[j] (A.electricField 𝓕.c t · i) x) x - + ∂[j] (fun x => ∂[i] (A.electricField 𝓕.c t · j) x) x)) - + 1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by congr simp only [Finset.sum_apply] congr @@ -498,21 +496,21 @@ lemma time_deriv_time_deriv_electricField_of_isExtrema {A : ElectromagneticPoten apply electricField_apply_contDiff_space apply hA.of_le exact right_eq_inf.mp rfl - _ = ∑ j, (∂[j] (fun x => ∂[j] (A.electricField t · i) x) x) - - ∑ j, (∂[j] (fun x => ∂[i] (A.electricField t · j) x) x) - - ∂ₜ (J.currentDensity · x i) t := by simp - _ = ∑ j, (∂[j] (fun x => ∂[j] (A.electricField t · i) x) x) - - ∑ j, (∂[i] (fun x => ∂[j] (A.electricField t · j) x) x) - - ∂ₜ (J.currentDensity · x i) t := by + _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, (∂[j] (fun x => ∂[j] (A.electricField 𝓕.c t · i) x) x) - + 1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, (∂[j] (fun x => ∂[i] (A.electricField 𝓕.c t · j) x) x) - + 1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by simp [mul_sub] + _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, (∂[j] (fun x => ∂[j] (A.electricField 𝓕.c t · i) x) x) - + 1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, (∂[i] (fun x => ∂[j] (A.electricField 𝓕.c t · j) x) x) - + 1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by congr funext j rw [Space.deriv_commute _ (by apply electricField_apply_contDiff_space apply hA.of_le exact right_eq_inf.mp rfl), Space.deriv_eq_fderiv_basis] - _ = ∑ j, (∂[j] (fun x => ∂[j] (A.electricField t · i) x) x) - - (∂[i] (fun x => ∑ j, ∂[j] (A.electricField t · j) x) x) - - ∂ₜ (J.currentDensity · x i) t := by + _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, (∂[j] (fun x => ∂[j] (A.electricField 𝓕.c t · i) x) x) - + 1 / (𝓕.μ₀ * 𝓕.ε₀) * (∂[i] (fun x => ∑ j, ∂[j] (A.electricField 𝓕.c t · j) x) x) - + 1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by congr rw [Space.deriv_eq_fderiv_basis] rw [fderiv_fun_sum] @@ -523,18 +521,266 @@ lemma time_deriv_time_deriv_electricField_of_isExtrema {A : ElectromagneticPoten apply electricField_apply_contDiff_space apply hA.of_le exact right_eq_inf.mp rfl - _ = ∑ j, (∂[j] (fun x => ∂[j] (A.electricField t · i) x) x) - - (∂[i] (fun x => (∇ ⬝ (A.electricField t)) x) x) - - ∂ₜ (J.currentDensity · x i) t := by + _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, (∂[j] (fun x => ∂[j] (A.electricField 𝓕.c t · i) x) x) - + 1 / (𝓕.μ₀ * 𝓕.ε₀) * (∂[i] (fun x => (∇ ⬝ (A.electricField 𝓕.c t)) x) x) - + 1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by + rfl + _ = 1 / (𝓕.μ₀ * 𝓕.ε₀) * ∑ j, (∂[j] (∂[j] (A.electricField 𝓕.c t · i)) x) - + 1 / (𝓕.μ₀ * 𝓕.ε₀ ^ 2) * ∂[i] (J.chargeDensity 𝓕.c t ·) x - + 1 / 𝓕.ε₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by + congr 2 + rw [isExtrema_iff_gauss_ampere_magneticFieldMatrix] at h + + conv_lhs => + enter [2, 2, x] + rw [(h t x).1] + trans 1 / (𝓕.μ₀ * 𝓕.ε₀) * Space.deriv i + (fun x => (1/ 𝓕.ε₀) * LorentzCurrentDensity.chargeDensity 𝓕.c J t x) x + · congr + funext x + ring + · rw [Space.deriv_eq_fderiv_basis] + rw [fderiv_const_mul] + simp [← Space.deriv_eq_fderiv_basis] + field_simp + apply Differentiable.differentiableAt + apply LorentzCurrentDensity.chargeDensity_differentiable_space + exact hJ.differentiable (by simp) + · exact hA + · exact hJ + _ = 𝓕.c ^ 2 * ∑ j, (∂[j] (∂[j] (A.electricField 𝓕.c t · i)) x) - + 𝓕.c ^ 2 / 𝓕.ε₀ * ∂[i] (J.chargeDensity 𝓕.c t ·) x - + 𝓕.c ^ 2 * 𝓕.μ₀ * ∂ₜ (J.currentDensity 𝓕.c · x i) t := by + simp [FreeSpace.c_sq] + field_simp + +end ElectromagneticPotential + +/-! + +## E. Is Extema condition in the distributional case + +The above results looked at the extrema condition for electromagnetic potentials that are +functions. We now look at the case where the electromagnetic potential is a distribution. + +-/ + +namespace DistElectromagneticPotential + +/-- The proposition on an electromagnetic potential, corresponding to the statement that + it is an extrema of the lagrangian. -/ +def IsExtrema {d} (𝓕 : FreeSpace) + (A : DistElectromagneticPotential d) + (J : DistLorentzCurrentDensity d) : Prop := A.gradLagrangian 𝓕 J = 0 + +lemma isExtrema_iff_gradLagrangian {𝓕 : FreeSpace} + (A : DistElectromagneticPotential d) + (J : DistLorentzCurrentDensity d) : + IsExtrema 𝓕 A J ↔ A.gradLagrangian 𝓕 J = 0 := by rfl + +lemma isExtrema_iff_components {𝓕 : FreeSpace} + (A : DistElectromagneticPotential d) + (J : DistLorentzCurrentDensity d) : + IsExtrema 𝓕 A J ↔ (∀ ε, A.gradLagrangian 𝓕 J ε (Sum.inl 0) = 0) + ∧ (∀ ε i, A.gradLagrangian 𝓕 J ε (Sum.inr i) = 0) := by + apply Iff.intro + · intro h + rw [isExtrema_iff_gradLagrangian] at h + simp [h] + · intro h + rw [isExtrema_iff_gradLagrangian] + ext ε + funext i + match i with + | Sum.inl 0 => exact h.1 ε + | Sum.inr j => exact h.2 ε j +/-! + +### E.1. IsExtrema and Gauss's law and Ampère's law + +We show that `A` is an extrema of the lagrangian if and only if Gauss's law and Ampère's law hold. +In other words, + +$$\nabla \cdot \mathbf{E} = \frac{\rho}{\varepsilon_0}$$ +and +$$\mu_0 \varepsilon_0 \frac{\partial \mathbf{E}_i}{\partial t} - + \sum_j \partial_j \mathbf{B}_{j i} + \mu_0 \mathbf{J}_i = 0.$$ +Here $\mathbf{B}$ is the magnetic field matrix. + +-/ +open Space +lemma isExtrema_iff_space_time {𝓕 : FreeSpace} + (A : DistElectromagneticPotential d) + (J : DistLorentzCurrentDensity d) : + IsExtrema 𝓕 A J ↔ + (∀ ε, distSpaceDiv (A.electricField 𝓕.c) ε = (1/𝓕.ε₀) * (J.chargeDensity 𝓕.c) ε) ∧ + (∀ ε i, 𝓕.μ₀ * 𝓕.ε₀ * (Space.distTimeDeriv (A.electricField 𝓕.c)) ε i - + ∑ j, ((PiLp.basisFun 2 ℝ (Fin d)).tensorProduct (PiLp.basisFun 2 ℝ (Fin d))).repr + ((Space.distSpaceDeriv j (A.magneticFieldMatrix 𝓕.c)) ε) (j, i) + + 𝓕.μ₀ * J.currentDensity 𝓕.c ε i = 0) := by + rw [isExtrema_iff_components] + refine and_congr ?_ ?_ + · simp [gradLagrangian_sum_inl_0] + field_simp + simp [𝓕.c_sq] + field_simp + simp [sub_eq_zero] + apply Iff.intro + · intro h ε + convert h (SchwartzMap.compCLMOfContinuousLinearEquiv (F := ℝ) ℝ + (SpaceTime.toTimeAndSpace 𝓕.c (d := d)) ε) using 1 + · simp [SpaceTime.distTimeSlice_symm_apply] + ring_nf congr - funext x - simp [Space.div, Space.coord_apply] - _ = ∑ j, (∂[j] (∂[j] (A.electricField t · i)) x) - - ∂[i] (J.chargeDensity t ·) x - ∂ₜ (J.currentDensity · x i) t := by + ext x + simp + · simp [SpaceTime.distTimeSlice_symm_apply] congr - funext x - rw [gaussLaw_electricField_of_isExtrema hA J hJ h t x] + ext x + simp + · intro h ε + convert h (SchwartzMap.compCLMOfContinuousLinearEquiv (F := ℝ) ℝ + (SpaceTime.toTimeAndSpace 𝓕.c (d := d)).symm ε) using 1 + · simp [SpaceTime.distTimeSlice_symm_apply] + ring_nf + · apply Iff.intro + · intro h ε i + specialize h (SchwartzMap.compCLMOfContinuousLinearEquiv (F := ℝ) ℝ + (SpaceTime.toTimeAndSpace 𝓕.c (d := d)) ε) i + linear_combination (norm := field_simp) (𝓕.μ₀) * h + simp [gradLagrangian_sum_inr_i, SpaceTime.distTimeSlice_symm_apply] + have hx : (SchwartzMap.compCLMOfContinuousLinearEquiv ℝ (SpaceTime.toTimeAndSpace 𝓕.c).symm) + ((SchwartzMap.compCLMOfContinuousLinearEquiv ℝ (SpaceTime.toTimeAndSpace 𝓕.c)) ε) + = ε := by + ext i + simp + simp [hx, 𝓕.c_sq] + field_simp + ring + · intro h ε i + specialize h (SchwartzMap.compCLMOfContinuousLinearEquiv (F := ℝ) ℝ + (SpaceTime.toTimeAndSpace 𝓕.c (d := d)).symm ε) i + linear_combination (norm := field_simp) (𝓕.μ₀⁻¹) * h + simp [gradLagrangian_sum_inr_i, SpaceTime.distTimeSlice_symm_apply, 𝓕.c_sq] + field_simp + ring -end ElectromagneticPotential +/-! + +### E.2. IsExtrema in terms of Vector Potentials + +We show that `A` is an extrema of the lagrangian if and only if Gauss's law and Ampère's law hold. +In other words, + +$$\nabla \cdot \mathbf{E} = \frac{\rho}{\varepsilon_0}$$ +and +$$\mu_0 \varepsilon_0 \frac{\partial \mathbf{E}_i}{\partial t} - + \sum_j -(\partial_j \partial_j \vec A_i - \partial_j \partial_i \vec A_j) + + \mu_0 \mathbf{J}_i = 0.$$ + +-/ + +lemma isExtrema_iff_vectorPotential {𝓕 : FreeSpace} + (A : DistElectromagneticPotential d) + (J : DistLorentzCurrentDensity d) : + IsExtrema 𝓕 A J ↔ + (∀ ε, distSpaceDiv (A.electricField 𝓕.c) ε = (1/𝓕.ε₀) * (J.chargeDensity 𝓕.c) ε) ∧ + (∀ ε i, 𝓕.μ₀ * 𝓕.ε₀ * distTimeDeriv (A.electricField 𝓕.c) ε i - + (∑ x, -(distSpaceDeriv x (distSpaceDeriv x (A.vectorPotential 𝓕.c)) ε i + - distSpaceDeriv x (distSpaceDeriv i (A.vectorPotential 𝓕.c)) ε x)) + + 𝓕.μ₀ * J.currentDensity 𝓕.c ε i = 0) := by + rw [isExtrema_iff_space_time] + refine and_congr (by rfl) ?_ + suffices ∀ ε i, ∑ x, -(distSpaceDeriv x (distSpaceDeriv x (A.vectorPotential 𝓕.c)) ε i + - distSpaceDeriv x (distSpaceDeriv i (A.vectorPotential 𝓕.c)) ε x) = + ∑ j, ((PiLp.basisFun 2 ℝ (Fin d)).tensorProduct (PiLp.basisFun 2 ℝ (Fin d))).repr + ((Space.distSpaceDeriv j (A.magneticFieldMatrix 𝓕.c)) ε) (j, i) by + conv_lhs => enter [2, 2]; rw [← this] + intro ε i + congr + funext j + rw [magneticFieldMatrix_distSpaceDeriv_basis_repr_eq_vector_potential] + ring + +/-! + +### E.3. The exterma condition in terms of tensors + +We show that `A` is an extrema of the lagrangian if and only if the equation +$$\frac{1}{\mu_0} \partial_\kappa F^{\kappa \nu'} - J^{\nu'} = 0,$$ +holds. + +-/ +open SpaceTime minkowskiMatrix +lemma isExterma_iff_tensor {𝓕 : FreeSpace} + (A : DistElectromagneticPotential d) + (J : DistLorentzCurrentDensity d) : + IsExtrema 𝓕 A J ↔ ∀ ε, + {((1/ 𝓕.μ₀ : ℝ) • distTensorDeriv A.fieldStrength ε | κ κ ν') + - (J ε | ν')}ᵀ = 0 := by + apply Iff.intro + · intro h + simp only [IsExtrema] at h + intro x + have h1 : ((Tensorial.toTensor (M := Lorentz.Vector d)).symm + (permT id (PermCond.auto) {((1/ 𝓕.μ₀ : ℝ) • distTensorDeriv A.fieldStrength x | κ κ ν') + + - (J x | ν')}ᵀ)) = 0 := by + funext ν + have h2 : gradLagrangian 𝓕 A J x ν = 0 := by simp [h] + rw [gradLagrangian_eq_tensor A J] at h2 + simp at h2 + have hn : minkowskiMatrix ν ν ≠ 0 := minkowskiMatrix.η_diag_ne_zero + simp_all + rw [EmbeddingLike.map_eq_zero_iff, permT_eq_zero_iff] at h1 + exact h1 + · intro h + simp only [IsExtrema] + ext x + funext ν + rw [gradLagrangian_eq_tensor A J, h] + simp + +/-! + +### E.4. The invariance of the exterma condition under Lorentz transformations + +We show that the Exterma condition is invariant under Lorentz transformations. +This implies that if an electromagnetic potential is an extrema in one inertial frame, +it is also an extrema in any other inertial frame. +In otherwords that the Maxwell's equations are Lorentz invariant. +A natural consequence of this is that the speed of light is the same in all inertial frames. + +-/ + +lemma isExterma_equivariant {𝓕 : FreeSpace} + (A : DistElectromagneticPotential d) + (J : DistLorentzCurrentDensity d) (Λ : LorentzGroup d) : + IsExtrema 𝓕 (Λ • A) (Λ • J) ↔ IsExtrema 𝓕 A J := by + rw [isExterma_iff_tensor] + conv_lhs => + enter [x, 1, 1, 2, 2, 2] + rw [fieldStrength_equivariant, distTensorDeriv_equivariant] + rw [lorentzGroup_smul_dist_apply] + conv_lhs => + enter [x] + rw [smul_comm] + rw [Tensorial.toTensor_smul, lorentzGroup_smul_dist_apply, Tensorial.toTensor_smul] + simp only [Nat.reduceAdd, Nat.reduceSucc, Fin.isValue, one_div, map_smul, actionT_smul, + contrT_equivariant, map_neg, permT_equivariant] + rw [smul_comm, ← Tensor.actionT_neg, ← Tensor.actionT_add] + apply Iff.intro + · intro h + rw [isExterma_iff_tensor A J] + intro x + apply MulAction.injective Λ + simp only [Nat.reduceAdd, Nat.reduceSucc, Fin.isValue, one_div, map_smul, map_neg, + _root_.smul_add, actionT_smul, _root_.smul_neg, _root_.smul_zero] + simpa [schwartzAction_mul_apply] using h (schwartzAction Λ x) + · intro h x + rw [isExterma_iff_tensor A J] at h + specialize h (schwartzAction Λ⁻¹ x) + simp at h + rw [h] + simp +end DistElectromagneticPotential end Electromagnetism diff --git a/PhysLean/Electromagnetism/Dynamics/KineticTerm.lean b/PhysLean/Electromagnetism/Dynamics/KineticTerm.lean index c7b593ba8..aed2091a9 100644 --- a/PhysLean/Electromagnetism/Dynamics/KineticTerm.lean +++ b/PhysLean/Electromagnetism/Dynamics/KineticTerm.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Electromagnetism.Kinematics.MagneticField +import PhysLean.Electromagnetism.Dynamics.Basic /-! # The kinetic term @@ -27,6 +28,8 @@ In this implementation we have set `μ₀ = 1`. It is a TODO to introduce this c - `ElectromagneticPotential.gradKineticTerm` is the variational gradient of the kinetic term. - `ElectromagneticPotential.gradKineticTerm_eq_electric_magnetic` gives a first expression for the variational gradient in terms of the electric and magnetic fields. +- `DistElectromagneticPotential.gradKineticTerm` is the variational gradient of the kinetic term + for distributional electromagnetic potentials. ## iii. Table of contents @@ -34,9 +37,10 @@ In this implementation we have set `μ₀ = 1`. It is a TODO to introduce this c - A.1. Lorentz invariance of the kinetic term - A.2. Kinetic term simplified expressions - A.3. The kinetic term in terms of the electric and magnetic fields - - A.4. The kinetic term for constant fields - - A.5. Smoothness of the kinetic term - - A.6. The kinetic term shifted by time mul a constant + - A.4. The kinetic term in terms of the electric and magnetic matrix + - A.5. The kinetic term for constant fields + - A.6. Smoothness of the kinetic term + - A.7. The kinetic term shifted by time mul a constant - B. Variational gradient of the kinetic term - B.1. Variational gradient in terms of fderiv - B.2. Writing the variational gradient as a sums over double derivatives of the potential @@ -44,6 +48,9 @@ In this implementation we have set `μ₀ = 1`. It is a TODO to introduce this c - B.4. Variational gradient in terms of the Gauss's and Ampère laws - B.5. Linearity properties of the variational gradient - B.6. HasVarGradientAt for the variational gradient + - B.7. Gradient of the kinetic term in terms of the tensor derivative +- C. The gradient of the kinetic term for distributions + - C.1. The gradient of the kinetic term as a tensor ## iv. References @@ -71,14 +78,15 @@ attribute [-simp] Nat.succ_eq_add_one ## A. The kinetic term -The kinetic term is `- 1/4 F_μν F^μν`. We define this and show that it is +The kinetic term is `- 1/(4 μ₀) F_μν F^μν`. We define this and show that it is Lorentz invariant. -/ /-- The kinetic energy from an electromagnetic potential. -/ -noncomputable def kineticTerm {d} (A : ElectromagneticPotential d) : SpaceTime d → ℝ := fun x => - - 1/4 * {η' d | μ μ' ⊗ η' d | ν ν' ⊗ +noncomputable def kineticTerm {d} (𝓕 : FreeSpace) (A : ElectromagneticPotential d) : + SpaceTime d → ℝ := fun x => + - 1/(4 * 𝓕.μ₀) * {η' d | μ μ' ⊗ η' d | ν ν' ⊗ A.toFieldStrength x | μ ν ⊗ A.toFieldStrength x | μ' ν'}ᵀ.toField /-! @@ -89,9 +97,10 @@ We show that the kinetic energy is Lorentz invariant. -/ -lemma kineticTerm_equivariant {d} (A : ElectromagneticPotential d) (Λ : LorentzGroup d) +lemma kineticTerm_equivariant {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) + (Λ : LorentzGroup d) (hf : Differentiable ℝ A) (x : SpaceTime d) : - kineticTerm (fun x => Λ • A (Λ⁻¹ • x)) x = kineticTerm A (Λ⁻¹ • x) := by + kineticTerm 𝓕 (fun x => Λ • A (Λ⁻¹ • x)) x = kineticTerm 𝓕 A (Λ⁻¹ • x) := by rw [kineticTerm, kineticTerm] conv_lhs => enter [2] @@ -105,9 +114,9 @@ lemma kineticTerm_equivariant {d} (A : ElectromagneticPotential d) (Λ : Lorentz -/ -lemma kineticTerm_eq_sum {d} (A : ElectromagneticPotential d) (x : SpaceTime d) : - A.kineticTerm x = - - 1/4 * ∑ μ, ∑ ν, ∑ μ', ∑ ν', η μ μ' * η ν ν' * +lemma kineticTerm_eq_sum {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (x : SpaceTime d) : + A.kineticTerm 𝓕 x = + - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, ∑ μ', ∑ ν', η μ μ' * η ν ν' * (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr (A.toFieldStrength x) (μ, ν) * (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr (A.toFieldStrength x) (μ', ν') := by @@ -162,17 +171,43 @@ lemma kineticTerm_eq_sum {d} (A : ElectromagneticPotential d) (x : SpaceTime d) conv_lhs => enter [2, 2, μ']; rw [Finset.sum_comm] rfl -lemma kineticTerm_eq_sum_fieldStrengthMatrix {d} - (A : ElectromagneticPotential d) (x : SpaceTime d) : A.kineticTerm x = - - 1/4 * ∑ μ, ∑ ν, ∑ μ', ∑ ν', η μ μ' * η ν ν' * +lemma kineticTerm_eq_sum_fieldStrengthMatrix {d} {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) (x : SpaceTime d) : A.kineticTerm 𝓕 x = + - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, ∑ μ', ∑ ν', η μ μ' * η ν ν' * A.fieldStrengthMatrix x (μ, ν) * A.fieldStrengthMatrix x (μ', ν') := by rw [kineticTerm_eq_sum] -lemma kineticTerm_eq_sum_potential {d} (A : ElectromagneticPotential d) (x : SpaceTime d) : - A.kineticTerm x = - 1 / 2 * ∑ μ, ∑ ν, +lemma kineticTerm_eq_sum_fieldStrengthMatrix_sq {d} {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) (x : SpaceTime d) : A.kineticTerm 𝓕 x = + - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, η μ μ * η ν ν * ‖A.fieldStrengthMatrix x (μ, ν)‖ ^ 2 := by + rw [kineticTerm_eq_sum_fieldStrengthMatrix] + congr + funext μ + congr + funext ν + rw [Finset.sum_eq_single μ] + · rw [Finset.sum_eq_single ν] + · simp + ring + · intro b _ hb + nth_rewrite 2 [minkowskiMatrix.off_diag_zero] + simp only [mul_zero, zero_mul] + exact id (Ne.symm hb) + · simp + · intro b _ hb + rw [Finset.sum_eq_zero] + intro ν' _ + rw [minkowskiMatrix.off_diag_zero] + simp only [zero_mul] + exact id (Ne.symm hb) + · simp + +lemma kineticTerm_eq_sum_potential {d} {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) (x : SpaceTime d) : + A.kineticTerm 𝓕 x = - 1 / (2 * 𝓕.μ₀) * ∑ μ, ∑ ν, (η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - ∂_ μ A x ν * ∂_ ν A x μ) := by calc _ - _ = - 1/4 * ∑ μ, ∑ ν, ∑ μ', ∑ ν', η μ μ' * η ν ν' * + _ = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, ∑ μ', ∑ ν', η μ μ' * η ν ν' * (η μ μ * ∂_ μ A x ν - η ν ν * ∂_ ν A x μ) * (η μ' μ' * ∂_ μ' A x ν' - η ν' ν' * ∂_ ν' A x μ') := by rw [kineticTerm_eq_sum] @@ -182,7 +217,7 @@ lemma kineticTerm_eq_sum_potential {d} (A : ElectromagneticPotential d) (x : Spa apply Finset.sum_congr rfl (fun μ' _ => ?_) apply Finset.sum_congr rfl (fun ν' _ => ?_) rw [toFieldStrength_basis_repr_apply_eq_single, toFieldStrength_basis_repr_apply_eq_single] - _ = - 1/4 * ∑ μ, ∑ ν, ∑ μ', η μ μ' * η ν ν * + _ = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, ∑ μ', η μ μ' * η ν ν * (η μ μ * ∂_ μ A x ν - η ν ν * ∂_ ν A x μ) * (η μ' μ' * ∂_ μ' A x ν - η ν ν * ∂_ ν A x μ') := by congr 1 @@ -195,7 +230,7 @@ lemma kineticTerm_eq_sum_potential {d} (A : ElectromagneticPotential d) (x : Spa simp only [mul_zero, zero_mul] exact id (Ne.symm hb) · simp - _ = - 1/4 * ∑ μ, ∑ ν, η μ μ * η ν ν * + _ = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, η μ μ * η ν ν * (η μ μ * ∂_ μ A x ν - η ν ν * ∂_ ν A x μ) * (η μ μ * ∂_ μ A x ν - η ν ν * ∂_ ν A x μ) := by congr 1 @@ -207,27 +242,27 @@ lemma kineticTerm_eq_sum_potential {d} (A : ElectromagneticPotential d) (x : Spa simp only [zero_mul] exact id (Ne.symm hb) · simp - _ = - 1/4 * ∑ μ, ∑ ν, + _ = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, ((η μ μ) ^ 2 * η ν ν * ∂_ μ A x ν - (η ν ν) ^ 2 * η μ μ * ∂_ ν A x μ) * (η μ μ * ∂_ μ A x ν - η ν ν * ∂_ ν A x μ) := by congr 1 apply Finset.sum_congr rfl (fun μ _ => ?_) apply Finset.sum_congr rfl (fun ν _ => ?_) ring - _ = - 1/4 * ∑ μ, ∑ ν, + _ = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, (η ν ν * ∂_ μ A x ν - η μ μ * ∂_ ν A x μ) * (η μ μ * ∂_ μ A x ν - η ν ν * ∂_ ν A x μ) := by simp - _ = - 1/4 * ∑ μ, ∑ ν, + _ = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, ((η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - (η ν ν) ^ 2 * ∂_ μ A x ν * ∂_ ν A x μ) + (- (η μ μ) ^ 2 * ∂_ ν A x μ * ∂_ μ A x ν + η μ μ * η ν ν * (∂_ ν A x μ)^2)) := by congr 1 apply Finset.sum_congr rfl (fun μ _ => ?_) apply Finset.sum_congr rfl (fun ν _ => ?_) ring - _ = - 1/4 * ∑ μ, ∑ ν, + _ = - 1/(4 * 𝓕.μ₀) * ∑ μ, ∑ ν, ((η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - ∂_ μ A x ν * ∂_ ν A x μ) + (- ∂_ ν A x μ * ∂_ μ A x ν + η μ μ * η ν ν * (∂_ ν A x μ)^2)) := by simp - _ = - 1 / 4 * ∑ μ, ∑ ν, + _ = - 1 / (4 * 𝓕.μ₀) * ∑ μ, ∑ ν, ((η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - ∂_ μ A x ν * ∂_ ν A x μ) + (- ∂_ μ A x ν * ∂_ ν A x μ + η ν ν * η μ μ * (∂_ μ A x ν)^2)) := by congr 1 @@ -240,13 +275,13 @@ lemma kineticTerm_eq_sum_potential {d} (A : ElectromagneticPotential d) (x : Spa conv_lhs => enter [2, μ]; rw [← Finset.sum_add_distrib] - _ = - 1 / 4 * ∑ μ, ∑ ν, + _ = - 1 / (4 * 𝓕.μ₀) * ∑ μ, ∑ ν, (2 * (η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - ∂_ μ A x ν * ∂_ ν A x μ)) := by congr 1 apply Finset.sum_congr rfl (fun μ _ => ?_) apply Finset.sum_congr rfl (fun ν _ => ?_) ring - _ = - 1 / 2 * ∑ μ, ∑ ν, + _ = - 1 / (2 * 𝓕.μ₀) * ∑ μ, ∑ ν, (η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - ∂_ μ A x ν * ∂_ ν A x μ) := by conv_lhs => enter [2, 2, μ] @@ -261,10 +296,10 @@ lemma kineticTerm_eq_sum_potential {d} (A : ElectromagneticPotential d) (x : Spa -/ open InnerProductSpace -lemma kineticTerm_eq_electric_magnetic (A : ElectromagneticPotential) (t : Time) +lemma kineticTerm_eq_electric_magnetic {𝓕 : FreeSpace} (A : ElectromagneticPotential) (t : Time) (x : Space) (hA : Differentiable ℝ A) : - A.kineticTerm (SpaceTime.toTimeAndSpace.symm (t, x)) = - 1/2 * (‖A.electricField t x‖ ^ 2 - ‖A.magneticField t x‖ ^ 2) := by + A.kineticTerm 𝓕 ((toTimeAndSpace 𝓕.c).symm (t, x)) = + 1/2 * (𝓕.ε₀ * ‖A.electricField 𝓕.c t x‖ ^ 2 - (1 / 𝓕.μ₀) * ‖A.magneticField 𝓕.c t x‖ ^ 2) := by rw [kineticTerm_eq_sum] simp only [one_div] conv_lhs => @@ -274,26 +309,79 @@ lemma kineticTerm_eq_electric_magnetic (A : ElectromagneticPotential) (t : Time) simp [Fintype.sum_sum_type, Fin.sum_univ_three] rw [EuclideanSpace.norm_sq_eq, EuclideanSpace.norm_sq_eq] simp [Fin.sum_univ_three] + field_simp + simp only [Fin.isValue, FreeSpace.c_sq, one_div, mul_inv_rev] + field_simp ring -lemma kineticTerm_eq_electric_magnetic' {A : ElectromagneticPotential} (hA : Differentiable ℝ A) - (x : SpaceTime) : - A.kineticTerm x = - 1/2 * (‖A.electricField x.time x.space‖ ^ 2 - ‖A.magneticField x.time x.space‖ ^ 2) := by +lemma kineticTerm_eq_electric_magnetic' {𝓕 : FreeSpace} {A : ElectromagneticPotential} + (hA : Differentiable ℝ A) (x : SpaceTime) : + A.kineticTerm 𝓕 x = + 1/2 * (𝓕.ε₀ * ‖A.electricField 𝓕.c (x.time 𝓕.c) x.space‖ ^ 2 - + (1 / 𝓕.μ₀) * ‖A.magneticField 𝓕.c (x.time 𝓕.c) x.space‖ ^ 2) := by rw [← kineticTerm_eq_electric_magnetic _ _ _ hA] congr apply toTimeAndSpace.injective - simp only [space_toCoord_symm, ContinuousLinearEquiv.apply_symm_apply] - rfl + simp /-! -### A.4. The kinetic term for constant fields +### A.4. The kinetic term in terms of the electric and magnetic matrix -/ -lemma kineticTerm_const {d} (A₀ : Lorentz.Vector d) : - kineticTerm (fun _ : SpaceTime d => A₀) = 0 := by +lemma kineticTerm_eq_electricMatrix_magneticFieldMatrix_time_space {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) (t : Time) + (x : Space d) (hA : Differentiable ℝ A) : + A.kineticTerm 𝓕 ((toTimeAndSpace 𝓕.c).symm (t, x)) = + 1/2 * (𝓕.ε₀ * ‖A.electricField 𝓕.c t x‖ ^ 2 - + (1 / (2 * 𝓕.μ₀)) * ∑ i, ∑ j, ‖A.magneticFieldMatrix 𝓕.c t x (i, j)‖ ^ 2) := by + rw [kineticTerm_eq_sum_fieldStrengthMatrix_sq] + simp [Fintype.sum_sum_type] + rw [Finset.sum_add_distrib] + simp only [Fin.isValue, Finset.sum_neg_distrib] + have h1 : ∑ i, ∑ j, magneticFieldMatrix 𝓕.c A t x (i, j) ^ 2 + = ∑ i, ∑ j, (A.fieldStrengthMatrix ((toTimeAndSpace 𝓕.c).symm (t, x))) + (Sum.inr i, Sum.inr j) ^ 2 := by rfl + rw [h1] + ring_nf + have h2 : ‖electricField 𝓕.c A t x‖ ^ 2 = 𝓕.c.val ^ 2 * + ∑ i, |(A.fieldStrengthMatrix ((toTimeAndSpace 𝓕.c).symm (t, x))) + (Sum.inl 0, Sum.inr i)| ^ 2 := by + rw [EuclideanSpace.norm_sq_eq] + conv_lhs => + enter [2, i] + rw [electricField_eq_fieldStrengthMatrix A t x i hA] + simp only [Fin.isValue, neg_mul, norm_neg, norm_mul, Real.norm_eq_abs, FreeSpace.c_abs] + rw [mul_pow] + rw [← Finset.mul_sum] + rw [h2] + simp only [Fin.isValue, one_div, sq_abs] + conv_lhs => + enter [1, 2, 1, 2, 2, i] + rw [fieldStrengthMatrix_antisymm] + simp [FreeSpace.c_sq] + field_simp + ring + +lemma kineticTerm_eq_electricMatrix_magneticFieldMatrix {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) (x : SpaceTime d) + (hA : Differentiable ℝ A) : + A.kineticTerm 𝓕 x = + 1/2 * (𝓕.ε₀ * ‖A.electricField 𝓕.c (x.time 𝓕.c) x.space‖ ^ 2 - + (1 / (2 * 𝓕.μ₀)) * ∑ i, ∑ j, ‖A.magneticFieldMatrix 𝓕.c (x.time 𝓕.c) x.space (i, j)‖ ^ 2) := by + rw [← kineticTerm_eq_electricMatrix_magneticFieldMatrix_time_space A (x.time 𝓕.c)] + simp only [toTimeAndSpace_symm_apply_time_space] + exact hA + +/-! + +### A.5. The kinetic term for constant fields + +-/ + +lemma kineticTerm_const {d} {𝓕 : FreeSpace} (A₀ : Lorentz.Vector d) : + kineticTerm 𝓕 (fun _ : SpaceTime d => A₀) = 0 := by funext x rw [kineticTerm_eq_sum_potential] conv_lhs => @@ -302,9 +390,9 @@ lemma kineticTerm_const {d} (A₀ : Lorentz.Vector d) : simp simp -lemma kineticTerm_add_const {d} (A : ElectromagneticPotential d) +lemma kineticTerm_add_const {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (A₀ : Lorentz.Vector d) : - kineticTerm (fun x => A x + A₀) = kineticTerm A := by + kineticTerm 𝓕 (fun x => A x + A₀) = kineticTerm 𝓕 A := by funext x rw [kineticTerm_eq_sum_potential, kineticTerm_eq_sum_potential] congr @@ -319,14 +407,14 @@ lemma kineticTerm_add_const {d} (A : ElectromagneticPotential d) /-! -### A.5. Smoothness of the kinetic term +### A.6. Smoothness of the kinetic term -/ -lemma kineticTerm_contDiff {d} {n : WithTop ℕ∞} (A : ElectromagneticPotential d) +lemma kineticTerm_contDiff {d} {n : WithTop ℕ∞} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (hA : ContDiff ℝ (n + 1) A) : - ContDiff ℝ n A.kineticTerm := by - change ContDiff ℝ n (fun x => A.kineticTerm x) + ContDiff ℝ n (A.kineticTerm 𝓕) := by + change ContDiff ℝ n (fun x => A.kineticTerm 𝓕 x) conv => enter [3, x] rw [kineticTerm_eq_sum_fieldStrengthMatrix] @@ -348,21 +436,22 @@ lemma kineticTerm_contDiff {d} {n : WithTop ℕ∞} (A : ElectromagneticPotentia /-! -### A.6. The kinetic term shifted by time mul a constant +### A.7. The kinetic term shifted by time mul a constant This result is used in finding the canonical momentum. -/ -lemma kineticTerm_add_time_mul_const {d} (A : ElectromagneticPotential d) +lemma kineticTerm_add_time_mul_const {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (ha : Differentiable ℝ A) (c : Lorentz.Vector d) (x : SpaceTime d) : - kineticTerm (fun x => A x + x (Sum.inl 0) • c) x = A.kineticTerm x + - (-1 / 2 * ∑ ν, ((2 * c ν * η ν ν * ∂_ (Sum.inl 0) A x ν + η ν ν * c ν ^ 2 - - 2 * c ν * (∂_ ν A x (Sum.inl 0)))) + 1/2 * c (Sum.inl 0) ^2) := by + kineticTerm 𝓕 (fun x => A x + x (Sum.inl 0) • c) x = A.kineticTerm 𝓕 x + + (-1 / (2 * 𝓕.μ₀) * ∑ ν, ((2 * c ν * η ν ν * ∂_ (Sum.inl 0) A x ν + η ν ν * c ν ^ 2 - + 2 * c ν * (∂_ ν A x (Sum.inl 0)))) + 1/(2 * 𝓕.μ₀) * c (Sum.inl 0) ^2) := by have diff_a : ∂_ (Sum.inl 0) (fun x => A x + x (Sum.inl 0) • c) = ∂_ (Sum.inl 0) A + (fun x => c) := by funext x ν rw [SpaceTime.deriv_eq] + rw [fderiv_fun_add _ (by fun_prop)] simp only [Fin.isValue, ContinuousLinearMap.add_apply, Lorentz.Vector.apply_add, Pi.add_apply] congr @@ -376,7 +465,7 @@ lemma kineticTerm_add_time_mul_const {d} (A : ElectromagneticPotential d) rw [fderiv_fun_add _ (by fun_prop)] simp only [Fin.isValue, ContinuousLinearMap.add_apply, Lorentz.Vector.apply_add] rw [fderiv_smul_const (by fun_prop)] - simp only [Fin.isValue, Lorentz.Vector.fderiv_apply, ContinuousLinearMap.smulRight_apply, + simp only [Fin.isValue, ContinuousLinearMap.smulRight_apply, Lorentz.Vector.apply_smul] rw [← SpaceTime.deriv_eq] simp [Lorentz.Vector.coordCLM] @@ -389,7 +478,7 @@ lemma kineticTerm_add_time_mul_const {d} (A : ElectromagneticPotential d) | Sum.inr i => simp [diff_b i] rw [kineticTerm_eq_sum_potential] calc _ - _ = -1 / 2 * + _ = -1 / (2 * 𝓕.μ₀) * ∑ μ, ∑ ν, (η μ μ * η ν ν * (∂_ μ A x + if μ = Sum.inl 0 then c else 0) ν ^ 2 - (∂_ μ A x + if μ = Sum.inl 0 then c else 0) ν * (∂_ ν A x + if ν = Sum.inl 0 then c else 0) μ) := by @@ -398,7 +487,7 @@ lemma kineticTerm_add_time_mul_const {d} (A : ElectromagneticPotential d) congr funext ν rw [hdiff μ, hdiff ν] - _ = -1 / 2 * + _ = -1 / (2 * 𝓕.μ₀) * ∑ μ, ∑ ν, (η μ μ * η ν ν * (∂_ μ A x ν + if μ = Sum.inl 0 then c ν else 0) ^ 2 - (∂_ μ A x ν + if μ = Sum.inl 0 then c ν else 0) * (∂_ ν A x μ + if ν = Sum.inl 0 then c μ else 0)) := by @@ -412,7 +501,7 @@ lemma kineticTerm_add_time_mul_const {d} (A : ElectromagneticPotential d) split_ifs simp rfl - _ = -1 / 2 * + _ = -1 / (2 * 𝓕.μ₀) * ∑ μ, ∑ ν, ((η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - ∂_ μ A x ν * ∂_ ν A x μ) + (if μ = Sum.inl 0 then c ν else 0) * (2 * η μ μ * η ν ν * ∂_ μ A x ν + η μ μ * η ν ν * (if μ = Sum.inl 0 then c ν else 0) - @@ -423,9 +512,10 @@ lemma kineticTerm_add_time_mul_const {d} (A : ElectromagneticPotential d) congr funext ν ring - _ = -1 / 2 * + _ = -1 / (2 * 𝓕.μ₀) * ∑ μ, ∑ ν, ((η μ μ * η ν ν * (∂_ μ A x ν) ^ 2 - ∂_ μ A x ν * ∂_ ν A x μ)) + - -1 / 2 * ∑ μ, ∑ ν, ((if μ = Sum.inl 0 then c ν else 0) * (2 * η μ μ * η ν ν * ∂_ μ A x ν + + -1 / (2 * 𝓕.μ₀) * ∑ μ, ∑ ν, ((if μ = Sum.inl 0 then c ν else 0) * + (2 * η μ μ * η ν ν * ∂_ μ A x ν + η μ μ * η ν ν * (if μ = Sum.inl 0 then c ν else 0) - (∂_ ν A x μ) - (if ν = Sum.inl 0 then c μ else 0)) - (∂_ μ A x ν) * (if ν = Sum.inl 0 then c μ else 0)) := by @@ -436,14 +526,16 @@ lemma kineticTerm_add_time_mul_const {d} (A : ElectromagneticPotential d) rw [← Finset.sum_add_distrib] congr ring_nf - _ = A.kineticTerm x + - -1 / 2 * ∑ μ, ∑ ν, ((if μ = Sum.inl 0 then c ν else 0) * (2 * η μ μ * η ν ν * ∂_ μ A x ν + + _ = A.kineticTerm 𝓕 x + + -1 / (2 * 𝓕.μ₀) * ∑ μ, ∑ ν, ((if μ = Sum.inl 0 then c ν else 0) * + (2 * η μ μ * η ν ν * ∂_ μ A x ν + η μ μ * η ν ν * (if μ = Sum.inl 0 then c ν else 0) - (∂_ ν A x μ) - (if ν = Sum.inl 0 then c μ else 0)) - (∂_ μ A x ν) * (if ν = Sum.inl 0 then c μ else 0)) := by rw [kineticTerm_eq_sum_potential] - _ = A.kineticTerm x + - -1 / 2 * ∑ μ, ∑ ν, ((if μ = Sum.inl 0 then c ν else 0) * (2 * η μ μ * η ν ν * ∂_ μ A x ν + + _ = A.kineticTerm 𝓕 x + + -1 / (2 * 𝓕.μ₀)* ∑ μ, ∑ ν, ((if μ = Sum.inl 0 then c ν else 0) * + (2 * η μ μ * η ν ν * ∂_ μ A x ν + η μ μ * η ν ν * (if μ = Sum.inl 0 then c ν else 0) - (∂_ ν A x μ) - (if ν = Sum.inl 0 then c μ else 0)) - (∂_ ν A x μ) * (if μ = Sum.inl 0 then c ν else 0)) := by @@ -459,22 +551,22 @@ lemma kineticTerm_add_time_mul_const {d} (A : ElectromagneticPotential d) conv_rhs => enter [2, 2, μ] rw [← Finset.sum_sub_distrib] - _ = A.kineticTerm x + - -1 / 2 * ∑ ν, (c ν * (2 * η ν ν * ∂_ (Sum.inl 0) A x ν + η ν ν * c ν - + _ = A.kineticTerm 𝓕 x + + -1 / (2 * 𝓕.μ₀) * ∑ ν, (c ν * (2 * η ν ν * ∂_ (Sum.inl 0) A x ν + η ν ν * c ν - (∂_ ν A x (Sum.inl 0)) - (if ν = Sum.inl 0 then c (Sum.inl 0) else 0)) - (∂_ ν A x (Sum.inl 0)) * c ν) := by congr 1 simp - _ = A.kineticTerm x + - -1 / 2 * ∑ ν, ((2 * c ν * η ν ν * ∂_ (Sum.inl 0) A x ν + η ν ν * c ν ^ 2 - + _ = A.kineticTerm 𝓕 x + + -1 / (2 * 𝓕.μ₀) * ∑ ν, ((2 * c ν * η ν ν * ∂_ (Sum.inl 0) A x ν + η ν ν * c ν ^ 2 - 2 * c ν * (∂_ ν A x (Sum.inl 0))) - c ν * (if ν = Sum.inl 0 then c (Sum.inl 0) else 0)) := by congr funext ν ring - _ = A.kineticTerm x + - (-1 / 2 * ∑ ν, ((2 * c ν * η ν ν * ∂_ (Sum.inl 0) A x ν + η ν ν * c ν ^ 2 - - 2 * c ν * (∂_ ν A x (Sum.inl 0)))) + 1/2 * c (Sum.inl 0) ^2) := by + _ = A.kineticTerm 𝓕 x + + (-1 / (2 * 𝓕.μ₀) * ∑ ν, ((2 * c ν * η ν ν * ∂_ (Sum.inl 0) A x ν + η ν ν * c ν ^ 2 - + 2 * c ν * (∂_ ν A x (Sum.inl 0)))) + 1/(2 * 𝓕.μ₀) * c (Sum.inl 0) ^2) := by simp only [Fin.isValue, mul_ite, mul_zero, Finset.sum_sub_distrib, Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte, one_div, add_right_inj] ring @@ -488,14 +580,10 @@ of Gauss's law and Ampère's law in vacuum. -/ -/-- A local instance of an inner product structure on `SpaceTime`. -/ -noncomputable local instance {d} : InnerProductSpace ℝ (SpaceTime d) := - SpaceTime.innerProductSpace d - /-- The variational gradient of the kinetic term of an electromagnetic potential. -/ -noncomputable def gradKineticTerm {d} (A : ElectromagneticPotential d) : +noncomputable def gradKineticTerm {d} (𝓕 : FreeSpace) (A : ElectromagneticPotential d) : SpaceTime d → Lorentz.Vector d := - (δ (q':=A), ∫ x, kineticTerm q' x) + (δ (q':=A), ∫ x, kineticTerm 𝓕 q' x) /-! @@ -506,7 +594,7 @@ a complicated expression involving `fderiv`. This is not very useful in itself, but acts as a starting point for further simplifications. -/ -lemma gradKineticTerm_eq_sum_fderiv {d} (A : ElectromagneticPotential d) +lemma gradKineticTerm_eq_sum_fderiv {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (hA : ContDiff ℝ ∞ A) : let F' : (Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d) → (SpaceTime d → ℝ) → SpaceTime d → Lorentz.Vector d := fun μν => (fun ψ x => @@ -520,9 +608,9 @@ lemma gradKineticTerm_eq_sum_fderiv {d} (A : ElectromagneticPotential d) Lorentz.Vector.basis μν.2 + -(fderiv ℝ (fun x' => ∂_ μν.1 A x' μν.2 * ψ x') x) (Lorentz.Vector.basis μν.2) • Lorentz.Vector.basis μν.1)) - A.gradKineticTerm = fun x => ∑ μν, F' μν (fun x' => -1 / 2 * (fun _ => 1) x') x := by + A.gradKineticTerm 𝓕 = fun x => ∑ μν, F' μν (fun x' => -1/(2 * 𝓕.μ₀) * (fun _ => 1) x') x := by apply HasVarGradientAt.varGradient - change HasVarGradientAt (fun A' x => ElectromagneticPotential.kineticTerm A' x) _ A + change HasVarGradientAt (fun A' x => ElectromagneticPotential.kineticTerm 𝓕 A' x) _ A conv => enter [1, A', x] rw [kineticTerm_eq_sum_potential] @@ -559,8 +647,8 @@ lemma gradKineticTerm_eq_sum_fderiv {d} (A : ElectromagneticPotential d) HasVarAdjDerivAt (fun A' x => ∑ μ, ∑ ν, F (μ, ν) A' x) (fun ψ x => ∑ μν, F' μν ψ x) A := by convert HasVarAdjDerivAt.sum _ _ A (hA) (fun i => F_hasVarAdjDerivAt i) exact Eq.symm (Fintype.sum_prod_type fun x => F x _ _) - have hF_mul := HasVarAdjDerivAt.const_mul _ _ A F_sum_hasVarAdjDerivAt (c := -1/2) - change HasVarGradientAt (fun A' x => -1 / 2 * ∑ μ, ∑ ν, F (μ, ν) A' x) _ A + have hF_mul := HasVarAdjDerivAt.const_mul _ _ A F_sum_hasVarAdjDerivAt (c := -1/(2 * 𝓕.μ₀)) + change HasVarGradientAt (fun A' x => -1 / (2 * 𝓕.μ₀) * ∑ μ, ∑ ν, F (μ, ν) A' x) _ A apply HasVarGradientAt.intro _ hF_mul rfl @@ -573,29 +661,29 @@ second derivatives of the potential. -/ -lemma gradKineticTerm_eq_sum_sum {d} (A : ElectromagneticPotential d) (x : SpaceTime d) - (ha : ContDiff ℝ ∞ A) : - A.gradKineticTerm x = ∑ (ν : (Fin 1 ⊕ Fin d)), ∑ (μ : (Fin 1 ⊕ Fin d)), - (η μ μ * η ν ν * ∂_ μ (fun x' => ∂_ μ A x' ν) x - - ∂_ μ (fun x' => ∂_ ν A x' μ) x) • Lorentz.Vector.basis ν := by +lemma gradKineticTerm_eq_sum_sum {d} {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) (x : SpaceTime d) (ha : ContDiff ℝ ∞ A) : + A.gradKineticTerm 𝓕 x = ∑ (ν : (Fin 1 ⊕ Fin d)), ∑ (μ : (Fin 1 ⊕ Fin d)), + (1 / (𝓕.μ₀) * (η μ μ * η ν ν * ∂_ μ (fun x' => ∂_ μ A x' ν) x - + ∂_ μ (fun x' => ∂_ ν A x' μ) x)) • Lorentz.Vector.basis ν := by have diff_partial (μ) : ∀ ν, Differentiable ℝ fun x => (fderiv ℝ A x) (Lorentz.Vector.basis μ) ν := by - rw [← differentiable_pi] + rw [Lorentz.Vector.differentiable_apply] refine Differentiable.clm_apply ?_ ?_ · refine ((contDiff_succ_iff_fderiv (n := 1)).mp ?_).2.2.differentiable - (Preorder.le_refl 1) + (by simp) exact ContDiff.of_le ha (right_eq_inf.mp rfl) · fun_prop rw [gradKineticTerm_eq_sum_fderiv A ha] calc _ _ = ∑ (μ : (Fin 1 ⊕ Fin d)), ∑ (ν : (Fin 1 ⊕ Fin d)), - (- (fderiv ℝ (fun x' => (η μ μ * η ν ν * -1 / 2) * ∂_ μ A x' ν) x) + (- (fderiv ℝ (fun x' => (η μ μ * η ν ν * -1 / (2 * 𝓕.μ₀)) * ∂_ μ A x' ν) x) (Lorentz.Vector.basis μ) • Lorentz.Vector.basis ν + - -(fderiv ℝ (fun x' => (η μ μ * η ν ν * -1 / 2) * ∂_ μ A x' ν) x) + -(fderiv ℝ (fun x' => (η μ μ * η ν ν * -1 / (2 * 𝓕.μ₀)) * ∂_ μ A x' ν) x) (Lorentz.Vector.basis μ) • Lorentz.Vector.basis ν + - -(-(fderiv ℝ (fun x' => -1 / 2 * ∂_ ν A x' μ) x) (Lorentz.Vector.basis μ) + -(-(fderiv ℝ (fun x' => -1 / (2 * 𝓕.μ₀) * ∂_ ν A x' μ) x) (Lorentz.Vector.basis μ) • Lorentz.Vector.basis ν + - -(fderiv ℝ (fun x' => -1 / 2 * ∂_ μ A x' ν) x) (Lorentz.Vector.basis ν) + -(fderiv ℝ (fun x' => -1 / (2 * 𝓕.μ₀) * ∂_ μ A x' ν) x) (Lorentz.Vector.basis ν) • Lorentz.Vector.basis μ)) := by dsimp rw [Fintype.sum_prod_type] @@ -604,11 +692,11 @@ lemma gradKineticTerm_eq_sum_sum {d} (A : ElectromagneticPotential d) (x : Space simp only [mul_one, neg_smul, neg_add_rev, neg_neg, mul_neg] ring_nf _ = ∑ (μ : (Fin 1 ⊕ Fin d)), ∑ (ν : (Fin 1 ⊕ Fin d)), - ((- 2 * (fderiv ℝ (fun x' => (η μ μ * η ν ν * -1 / 2) * ∂_ μ A x' ν) x) + ((- 2 * (fderiv ℝ (fun x' => (η μ μ * η ν ν * -1 / (2 * 𝓕.μ₀)) * ∂_ μ A x' ν) x) (Lorentz.Vector.basis μ) + - ((fderiv ℝ (fun x' => -1 / 2 * ∂_ ν A x' μ) x) (Lorentz.Vector.basis μ))) • + ((fderiv ℝ (fun x' => -1 / (2 * 𝓕.μ₀) * ∂_ ν A x' μ) x) (Lorentz.Vector.basis μ))) • Lorentz.Vector.basis ν + - (fderiv ℝ (fun x' => -1 / 2 * ∂_ μ A x' ν) x) (Lorentz.Vector.basis ν) • + (fderiv ℝ (fun x' => -1 / (2 * 𝓕.μ₀) * ∂_ μ A x' ν) x) (Lorentz.Vector.basis ν) • Lorentz.Vector.basis μ) := by apply Finset.sum_congr rfl (fun μ _ => ?_) apply Finset.sum_congr rfl (fun ν _ => ?_) @@ -618,9 +706,9 @@ lemma gradKineticTerm_eq_sum_sum {d} (A : ElectromagneticPotential d) (x : Space · ring_nf · simp [← neg_smul] _ = ∑ (μ : (Fin 1 ⊕ Fin d)), ∑ (ν : (Fin 1 ⊕ Fin d)), - ((- 2 * (fderiv ℝ (fun x' => (η μ μ * η ν ν * -1 / 2) * ∂_ μ A x' ν) x) + ((- 2 * (fderiv ℝ (fun x' => (η μ μ * η ν ν * -1 / (2 * 𝓕.μ₀)) * ∂_ μ A x' ν) x) (Lorentz.Vector.basis μ) + - 2 * ((fderiv ℝ (fun x' => -1 / 2 * ∂_ ν A x' μ) x) (Lorentz.Vector.basis μ)))) • + 2 * ((fderiv ℝ (fun x' => -1 / (2 * 𝓕.μ₀) * ∂_ ν A x' μ) x) (Lorentz.Vector.basis μ)))) • Lorentz.Vector.basis ν := by conv_lhs => enter [2, μ]; rw [Finset.sum_add_distrib] rw [Finset.sum_add_distrib] @@ -632,8 +720,8 @@ lemma gradKineticTerm_eq_sum_sum {d} (A : ElectromagneticPotential d) (x : Space rw [← add_smul] ring_nf _ = ∑ (μ : (Fin 1 ⊕ Fin d)), ∑ (ν : (Fin 1 ⊕ Fin d)), - ((- 2 * ((η μ μ * η ν ν * -1 / 2) * ∂_ μ (fun x' => ∂_ μ A x' ν) x) + - 2 * ((-1 / 2 * ∂_ μ (fun x' => ∂_ ν A x' μ) x)))) • Lorentz.Vector.basis ν := by + ((- 2 * ((η μ μ * η ν ν * -1 / (2 * 𝓕.μ₀)) * ∂_ μ (fun x' => ∂_ μ A x' ν) x) + + 2 * ((-1 / (2 * 𝓕.μ₀) * ∂_ μ (fun x' => ∂_ ν A x' μ) x)))) • Lorentz.Vector.basis ν := by apply Finset.sum_congr rfl (fun μ _ => ?_) apply Finset.sum_congr rfl (fun ν _ => ?_) congr @@ -646,14 +734,14 @@ lemma gradKineticTerm_eq_sum_sum {d} (A : ElectromagneticPotential d) (x : Space conv => enter [2, x]; rw [SpaceTime.deriv_eq] apply diff_partial ν μ _ = ∑ (μ : (Fin 1 ⊕ Fin d)), ∑ (ν : (Fin 1 ⊕ Fin d)), - (η μ μ * η ν ν * ∂_ μ (fun x' => ∂_ μ A x' ν) x - - ∂_ μ (fun x' => ∂_ ν A x' μ) x) • Lorentz.Vector.basis ν := by + ((1 / (𝓕.μ₀) * (η μ μ * η ν ν * ∂_ μ (fun x' => ∂_ μ A x' ν) x - + ∂_ μ (fun x' => ∂_ ν A x' μ) x)) • Lorentz.Vector.basis ν) := by apply Finset.sum_congr rfl (fun μ _ => ?_) apply Finset.sum_congr rfl (fun ν _ => ?_) ring_nf _ = ∑ (ν : (Fin 1 ⊕ Fin d)), ∑ (μ : (Fin 1 ⊕ Fin d)), - (η μ μ * η ν ν * ∂_ μ (fun x' => ∂_ μ A x' ν) x - - ∂_ μ (fun x' => ∂_ ν A x' μ) x) • Lorentz.Vector.basis ν := by rw [Finset.sum_comm] + (1 / (𝓕.μ₀) * (η μ μ * η ν ν * ∂_ μ (fun x' => ∂_ μ A x' ν) x - + ∂_ μ (fun x' => ∂_ ν A x' μ) x)) • Lorentz.Vector.basis ν := by rw [Finset.sum_comm] /-! @@ -664,34 +752,34 @@ fieldStrengthMatrix. -/ -lemma gradKineticTerm_eq_fieldStrength {d} (A : ElectromagneticPotential d) +lemma gradKineticTerm_eq_fieldStrength {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (x : SpaceTime d) (ha : ContDiff ℝ ∞ A) : - A.gradKineticTerm x = ∑ (ν : (Fin 1 ⊕ Fin d)), η ν ν • + A.gradKineticTerm 𝓕 x = ∑ (ν : (Fin 1 ⊕ Fin d)), (1/𝓕.μ₀ * η ν ν) • (∑ (μ : (Fin 1 ⊕ Fin d)), (∂_ μ (A.fieldStrengthMatrix · (μ, ν)) x)) • Lorentz.Vector.basis ν := by have diff_partial (μ) : ∀ ν, Differentiable ℝ fun x => (fderiv ℝ A x) (Lorentz.Vector.basis μ) ν := by - rw [← differentiable_pi] + rw [Lorentz.Vector.differentiable_apply] refine Differentiable.clm_apply ?_ ?_ · refine ((contDiff_succ_iff_fderiv (n := 1)).mp ?_).2.2.differentiable - (Preorder.le_refl 1) + (by simp) exact ContDiff.of_le ha (right_eq_inf.mp rfl) · fun_prop calc _ _ = ∑ (ν : (Fin 1 ⊕ Fin d)), ∑ (μ : (Fin 1 ⊕ Fin d)), - (η μ μ * η ν ν * ∂_ μ (fun x' => ∂_ μ A x' ν) x - - ∂_ μ (fun x' => ∂_ ν A x' μ) x) • Lorentz.Vector.basis ν := by + (1/𝓕.μ₀ * (η μ μ * η ν ν * ∂_ μ (fun x' => ∂_ μ A x' ν) x - + ∂_ μ (fun x' => ∂_ ν A x' μ) x)) • Lorentz.Vector.basis ν := by rw [gradKineticTerm_eq_sum_sum A x ha] _ = ∑ (ν : (Fin 1 ⊕ Fin d)), ∑ (μ : (Fin 1 ⊕ Fin d)), - (η ν ν * (η μ μ * ∂_ μ (fun x' => ∂_ μ A x' ν) x - + ((1/𝓕.μ₀ * η ν ν) * (η μ μ * ∂_ μ (fun x' => ∂_ μ A x' ν) x - η ν ν * ∂_ μ (fun x' => ∂_ ν A x' μ) x)) • Lorentz.Vector.basis ν := by apply Finset.sum_congr rfl (fun ν _ => ?_) apply Finset.sum_congr rfl (fun μ _ => ?_) - congr + congr 1 ring_nf simp _ = ∑ (ν : (Fin 1 ⊕ Fin d)), ∑ (μ : (Fin 1 ⊕ Fin d)), - (η ν ν * (∂_ μ (fun x' => η μ μ * ∂_ μ A x' ν) x - + ((1/𝓕.μ₀ * η ν ν) * (∂_ μ (fun x' => η μ μ * ∂_ μ A x' ν) x - ∂_ μ (fun x' => η ν ν * ∂_ ν A x' μ) x)) • Lorentz.Vector.basis ν := by apply Finset.sum_congr rfl (fun ν _ => ?_) apply Finset.sum_congr rfl (fun μ _ => ?_) @@ -703,7 +791,7 @@ lemma gradKineticTerm_eq_fieldStrength {d} (A : ElectromagneticPotential d) rfl apply diff_partial ν μ _ = ∑ (ν : (Fin 1 ⊕ Fin d)), ∑ (μ : (Fin 1 ⊕ Fin d)), - (η ν ν * (∂_ μ (fun x' => η μ μ * ∂_ μ A x' ν - + ((1/𝓕.μ₀ * η ν ν) * (∂_ μ (fun x' => η μ μ * ∂_ μ A x' ν - η ν ν * ∂_ ν A x' μ) x)) • Lorentz.Vector.basis ν := by apply Finset.sum_congr rfl (fun ν _ => ?_) apply Finset.sum_congr rfl (fun μ _ => ?_) @@ -719,18 +807,19 @@ lemma gradKineticTerm_eq_fieldStrength {d} (A : ElectromagneticPotential d) apply Differentiable.const_mul exact diff_partial ν μ _ = ∑ (ν : (Fin 1 ⊕ Fin d)), ∑ (μ : (Fin 1 ⊕ Fin d)), - (η ν ν * (∂_ μ (A.fieldStrengthMatrix · (μ, ν)) x)) • Lorentz.Vector.basis ν := by + ((1/𝓕.μ₀ * η ν ν) * (∂_ μ (A.fieldStrengthMatrix · (μ, ν)) x)) • + Lorentz.Vector.basis ν := by apply Finset.sum_congr rfl (fun ν _ => ?_) apply Finset.sum_congr rfl (fun μ _ => ?_) congr funext x rw [toFieldStrength_basis_repr_apply_eq_single] - _ = ∑ (ν : (Fin 1 ⊕ Fin d)), (η ν ν * + _ = ∑ (ν : (Fin 1 ⊕ Fin d)), ((1/𝓕.μ₀ * η ν ν) * ∑ (μ : (Fin 1 ⊕ Fin d)), (∂_ μ (A.fieldStrengthMatrix · (μ, ν)) x)) • Lorentz.Vector.basis ν := by apply Finset.sum_congr rfl (fun ν _ => ?_) rw [← Finset.sum_smul, Finset.mul_sum] - _ = ∑ (ν : (Fin 1 ⊕ Fin d)), η ν ν • + _ = ∑ (ν : (Fin 1 ⊕ Fin d)), (1/𝓕.μ₀ * η ν ν) • (∑ (μ : (Fin 1 ⊕ Fin d)), (∂_ μ (A.fieldStrengthMatrix · (μ, ν)) x)) • Lorentz.Vector.basis ν := by apply Finset.sum_congr rfl (fun ν _ => ?_) @@ -744,22 +833,22 @@ We rewrite the variational gradient in terms of the electric and magnetic fields explicitly relating it to Gauss's law and Ampère's law. -/ -open Time +open Time Space -lemma gradKineticTerm_eq_electric_magnetic (A : ElectromagneticPotential) - (x : SpaceTime) (ha : ContDiff ℝ ∞ A) : - A.gradKineticTerm x = - Space.div (A.electricField (toTimeAndSpace x).1) (toTimeAndSpace x).2 • - Lorentz.Vector.basis (Sum.inl 0) + - ∑ i, (∂ₜ (fun t => A.electricField t (toTimeAndSpace x).2) (toTimeAndSpace x).1 i- - Space.curl (A.magneticField (toTimeAndSpace x).1) (toTimeAndSpace x).2 i) • - Lorentz.Vector.basis (Sum.inr i) := by +lemma gradKineticTerm_eq_electric_magnetic {𝓕 : FreeSpace} (A : ElectromagneticPotential d) + (x : SpaceTime d) (ha : ContDiff ℝ ∞ A) : + A.gradKineticTerm 𝓕 x = + (1/(𝓕.μ₀ * 𝓕.c) * Space.div (A.electricField 𝓕.c (x.time 𝓕.c)) x.space) • + Lorentz.Vector.basis (Sum.inl 0) + + ∑ i, (𝓕.μ₀⁻¹ * (1 / 𝓕.c ^ 2 * ∂ₜ (fun t => A.electricField 𝓕.c t x.space) (x.time 𝓕.c) i- + ∑ j, Space.deriv j (A.magneticFieldMatrix 𝓕.c (x.time 𝓕.c) · (j, i)) x.space)) • + Lorentz.Vector.basis (Sum.inr i) := by have diff_partial (μ) : ∀ ν, Differentiable ℝ fun x => (fderiv ℝ A x) (Lorentz.Vector.basis μ) ν := by - rw [← differentiable_pi] + rw [Lorentz.Vector.differentiable_apply] refine Differentiable.clm_apply ?_ ?_ · refine ((contDiff_succ_iff_fderiv (n := 1)).mp ?_).2.2.differentiable - (Preorder.le_refl 1) + (by simp) exact ContDiff.of_le ha (right_eq_inf.mp rfl) · fun_prop have hdiff (μ ν) : Differentiable ℝ fun x => (A.fieldStrengthMatrix x) (μ, ν) := by @@ -770,72 +859,48 @@ lemma gradKineticTerm_eq_electric_magnetic (A : ElectromagneticPotential) · exact diff_partial (μ, ν).1 (μ, ν).2 apply Differentiable.const_mul · exact diff_partial (μ, ν).2 (μ, ν).1 - calc _ - _ = ∑ (ν : (Fin 1 ⊕ Fin 3)), η ν ν • - (∑ (μ : (Fin 1 ⊕ Fin 3)), - (∂_ μ (A.fieldStrengthMatrix · (μ, ν)) x)) • Lorentz.Vector.basis ν := by - rw [gradKineticTerm_eq_fieldStrength A x ha] - have term_inl_0 : (∑ (μ : (Fin 1 ⊕ Fin 3)), (∂_ μ (A.fieldStrengthMatrix · (μ, Sum.inl 0)) x)) = - (∇ ⬝ A.electricField (toTimeAndSpace x).1) (toTimeAndSpace x).2 := by - simp [Fintype.sum_sum_type] - conv_lhs => - enter [2, i] - rw [SpaceTime.deriv_sum_inr _ (hdiff _ _)] - simp only [Fin.isValue] - enter [2, y] - rw [fieldStrengthMatrix_eq_electric_magnetic _ _ _ (ha.differentiable (by simp))] - simp only - rw [Space.div] - simp [Space.coord] - have term_inr (i : Fin 3) : (∑ (μ : (Fin 1 ⊕ Fin 3)), - (∂_ μ (A.fieldStrengthMatrix · (μ, Sum.inr i)) x)) = - (-∂ₜ (fun t => A.electricField t (toTimeAndSpace x).2) (toTimeAndSpace x).1 i + - (∇ × (A.magneticField (toTimeAndSpace x).1)) (toTimeAndSpace x).2 i) := by - simp [Fintype.sum_sum_type] - congr - conv_lhs => - rw [SpaceTime.deriv_sum_inl _ (hdiff _ _)] - simp only [Fin.isValue] - enter [1, t] - rw [fieldStrengthMatrix_eq_electric_magnetic _ _ _ (ha.differentiable (by simp))] - simp - simp [Time.deriv] - rw [fderiv_pi] - rfl - intro i - have h1 := electricField_differentiable (ha.of_le (ENat.LEInfty.out)) - fun_prop - conv_lhs => - enter [2, i] - rw [SpaceTime.deriv_sum_inr _ (hdiff _ _)] - simp only - enter [2, y] - rw [fieldStrengthMatrix_eq_electric_magnetic _ _ _ (ha.differentiable (by simp))] - fin_cases i - all_goals - simp [Fin.sum_univ_three] - rw [Space.curl] - simp [Space.coord] - simp [Space.deriv_eq] - ring - rw [Fintype.sum_sum_type, Fin.sum_univ_one, term_inl_0] - conv_lhs => enter [2, 2, i]; rw [term_inr] - simp only [Fin.isValue, inl_0_inl_0, one_smul, inr_i_inr_i, neg_smul, - add_right_inj] - congr - funext x - rw [← neg_smul] - ring_nf + rw [gradKineticTerm_eq_fieldStrength A x ha] + rw [Fintype.sum_sum_type, Fin.sum_univ_one] + congr 1 + · rw [smul_smul] + congr 1 + rw [div_electricField_eq_fieldStrengthMatrix] + simp only [one_div, Fin.isValue, inl_0_inl_0, mul_one, mul_inv_rev, + toTimeAndSpace_symm_apply_time_space] + field_simp + apply ha.of_le (ENat.LEInfty.out) + · congr + funext j + simp only [one_div, inr_i_inr_i, mul_neg, mul_one, neg_smul] + rw [curl_magneticFieldMatrix_eq_electricField_fieldStrengthMatrix] + rw [smul_smul, ← neg_smul] + congr + simp only [one_div, toTimeAndSpace_symm_apply_time_space, sub_add_cancel_left, mul_neg] + apply ha.of_le (ENat.LEInfty.out) +lemma gradKineticTerm_eq_electric_magnetic_three {𝓕 : FreeSpace} (A : ElectromagneticPotential) + (x : SpaceTime) (ha : ContDiff ℝ ∞ A) : + A.gradKineticTerm 𝓕 x = + (1/(𝓕.μ₀ * 𝓕.c) * Space.div (A.electricField 𝓕.c (x.time 𝓕.c)) x.space) • + Lorentz.Vector.basis (Sum.inl 0) + + ∑ i, (𝓕.μ₀⁻¹ * (1 / 𝓕.c ^ 2 * ∂ₜ (fun t => A.electricField 𝓕.c t x.space) (x.time 𝓕.c) i- + Space.curl (A.magneticField 𝓕.c (x.time 𝓕.c)) x.space i)) • + Lorentz.Vector.basis (Sum.inr i) := by + rw [gradKineticTerm_eq_electric_magnetic A x ha] + congr + funext i + congr + rw [magneticField_curl_eq_magneticFieldMatrix] + exact ha.of_le (ENat.LEInfty.out) /-! ### B.5. Linearity properties of the variational gradient -/ -lemma gradKineticTerm_add {d} (A1 A2 : ElectromagneticPotential d) +lemma gradKineticTerm_add {d} {𝓕 : FreeSpace} (A1 A2 : ElectromagneticPotential d) (hA1 : ContDiff ℝ ∞ A1) (hA2 : ContDiff ℝ ∞ A2) : - (A1 + A2).gradKineticTerm = A1.gradKineticTerm + A2.gradKineticTerm := by + (A1 + A2).gradKineticTerm 𝓕 = A1.gradKineticTerm 𝓕 + A2.gradKineticTerm 𝓕 := by funext x rw [gradKineticTerm_eq_fieldStrength] simp only [Pi.add_apply] @@ -859,9 +924,9 @@ lemma gradKineticTerm_add {d} (A1 A2 : ElectromagneticPotential d) · exact hA1 · exact hA1.add hA2 -lemma gradKineticTerm_smul {d} (A : ElectromagneticPotential d) +lemma gradKineticTerm_smul {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (hA : ContDiff ℝ ∞ A) (c : ℝ) : - (c • A).gradKineticTerm = c • A.gradKineticTerm := by + (c • A).gradKineticTerm 𝓕 = c • A.gradKineticTerm 𝓕 := by funext x rw [gradKineticTerm_eq_fieldStrength] simp only [Pi.smul_apply] @@ -894,10 +959,10 @@ lemma gradKineticTerm_smul {d} (A : ElectromagneticPotential d) -/ -lemma kineticTerm_hasVarGradientAt {d} (A : ElectromagneticPotential d) - (hA : ContDiff ℝ ∞ A) : HasVarGradientAt kineticTerm A.gradKineticTerm A := by +lemma kineticTerm_hasVarGradientAt {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) + (hA : ContDiff ℝ ∞ A) : HasVarGradientAt (kineticTerm 𝓕) (A.gradKineticTerm 𝓕) A := by rw [gradKineticTerm_eq_sum_fderiv A hA] - change HasVarGradientAt (fun A' x => ElectromagneticPotential.kineticTerm A' x) _ A + change HasVarGradientAt (fun A' x => ElectromagneticPotential.kineticTerm 𝓕 A' x) _ A conv => enter [1, A', x] rw [kineticTerm_eq_sum_potential] @@ -934,11 +999,301 @@ lemma kineticTerm_hasVarGradientAt {d} (A : ElectromagneticPotential d) HasVarAdjDerivAt (fun A' x => ∑ μ, ∑ ν, F (μ, ν) A' x) (fun ψ x => ∑ μν, F' μν ψ x) A := by convert HasVarAdjDerivAt.sum _ _ A (hA) (fun i => F_hasVarAdjDerivAt i) exact Eq.symm (Fintype.sum_prod_type fun x => F x _ _) - have hF_mul := HasVarAdjDerivAt.const_mul _ _ A F_sum_hasVarAdjDerivAt (c := -1/2) - change HasVarGradientAt (fun A' x => -1 / 2 * ∑ μ, ∑ ν, F (μ, ν) A' x) _ A + have hF_mul := HasVarAdjDerivAt.const_mul _ _ A F_sum_hasVarAdjDerivAt (c := -1/(2 * 𝓕.μ₀)) + change HasVarGradientAt (fun A' x => -1 / (2 * 𝓕.μ₀) * ∑ μ, ∑ ν, F (μ, ν) A' x) _ A apply HasVarGradientAt.intro _ hF_mul rfl +/-! + +### B.7. Gradient of the kinetic term in terms of the tensor derivative + +-/ + +lemma gradKineticTerm_eq_tensorDeriv {d} {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) (x : SpaceTime d) + (hA : ContDiff ℝ ∞ A) (ν : Fin 1 ⊕ Fin d) : + A.gradKineticTerm 𝓕 x ν = η ν ν * ((Tensorial.toTensor (M := Lorentz.Vector d)).symm + (permT id (PermCond.auto) {(1/ 𝓕.μ₀ : ℝ) • tensorDeriv A.toFieldStrength x | κ κ ν'}ᵀ)) ν := by + trans η ν ν * (Lorentz.Vector.basis.repr + ((Tensorial.toTensor (M := Lorentz.Vector d)).symm + (permT id (PermCond.auto) {(1/ 𝓕.μ₀ : ℝ) • tensorDeriv A.toFieldStrength x | κ κ ν'}ᵀ))) ν + swap + · simp [Lorentz.Vector.basis_repr_apply] + simp [Lorentz.Vector.basis_eq_map_tensor_basis] + rw [permT_basis_repr_symm_apply, contrT_basis_repr_apply_eq_fin] + conv_rhs => + enter [2, 2, 2, μ] + rw [tensorDeriv_toTensor_basis_repr (by + apply toFieldStrength_differentiable + apply hA.of_le (ENat.LEInfty.out))] + enter [2, x] + rw [toFieldStrength_tensor_basis_eq_basis] + change fieldStrengthMatrix A x _ + conv_lhs => + rw [gradKineticTerm_eq_fieldStrength A x hA] + simp [Lorentz.Vector.apply_sum] + ring_nf + congr 1 + rw [← finSumFinEquiv.sum_comp] + congr + funext μ + congr + · apply Lorentz.CoVector.indexEquiv.symm.injective + simp only [Nat.reduceSucc, Nat.reduceAdd, Fin.isValue, Function.comp_apply, Fin.cast_eq_self, + Equiv.symm_apply_apply] + simp [Lorentz.CoVector.indexEquiv] + funext j + fin_cases j + simp [ComponentIdx.prodEquiv, ComponentIdx.prodIndexEquiv] + simp [ComponentIdx.DropPairSection.ofFinEquiv, ComponentIdx.DropPairSection.ofFin] + intro h + change ¬ 0 = 0 at h + simp at h + funext x + congr + · apply finSumFinEquiv.injective + simp only [Nat.reduceSucc, Nat.reduceAdd, Fin.isValue, Function.comp_apply, Fin.cast_eq_self, + Equiv.apply_symm_apply] + simp [ComponentIdx.prodEquiv, ComponentIdx.prodIndexEquiv] + simp [ComponentIdx.DropPairSection.ofFinEquiv, ComponentIdx.DropPairSection.ofFin] + intro _ h + apply False.elim + apply h + decide + · apply finSumFinEquiv.injective + simp only [Nat.reduceSucc, Nat.reduceAdd, Fin.isValue, Function.comp_apply, Fin.cast_eq_self, + Equiv.apply_symm_apply] + simp [ComponentIdx.prodEquiv, ComponentIdx.prodIndexEquiv] + simp [ComponentIdx.DropPairSection.ofFinEquiv, ComponentIdx.DropPairSection.ofFin] + split_ifs + · rename_i h + suffices ¬ (finSumFinEquiv (Sum.inr 1) = (0 : Fin (1 + 1 + 1))) from False.elim (this h) + decide + · rename_i h h2 + suffices ¬ (finSumFinEquiv (Sum.inr 1) = (1 : Fin (1 + 1 + 1))) from False.elim (this h2) + decide + · rfl + end ElectromagneticPotential +/-! + +## C. The gradient of the kinetic term for distributions + +For distributions we define the gradient of the kinetic term directly +using `ElectromagneticPotential.gradKineticTerm_eq_sum_sum` as the defining formula. + +-/ + +namespace DistElectromagneticPotential +open minkowskiMatrix SpaceTime SchwartzMap Lorentz +attribute [-simp] Fintype.sum_sum_type +attribute [-simp] Nat.succ_eq_add_one + +/-- The gradient of the kinetic term for an Electromagnetic potential which + is a distribution. -/ +noncomputable def gradKineticTerm {d} (𝓕 : FreeSpace) : + DistElectromagneticPotential d →ₗ[ℝ] (SpaceTime d) →d[ℝ] Lorentz.Vector d where + toFun A := { + toFun ε := ∑ ν, ∑ μ, + (1 / (𝓕.μ₀) * (η μ μ * η ν ν * distDeriv μ (distDeriv μ A) ε ν - + distDeriv μ (distDeriv ν A) ε μ)) • Lorentz.Vector.basis ν + map_add' ε1 ε2 := by + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl (fun ν _ => ?_) + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl (fun μ _ => ?_) + simp only [one_div, map_add, Lorentz.Vector.apply_add, ← add_smul] + ring_nf + map_smul' r ε := by + simp [Finset.smul_sum, smul_smul] + apply Finset.sum_congr rfl (fun ν _ => ?_) + apply Finset.sum_congr rfl (fun μ _ => ?_) + ring_nf + cont := by fun_prop} + map_add' A1 A2 := by + ext ε + simp only [one_div, map_add, ContinuousLinearMap.add_apply, Lorentz.Vector.apply_add, + ContinuousLinearMap.coe_mk', LinearMap.coe_mk, AddHom.coe_mk] + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl (fun ν _ => ?_) + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl (fun μ _ => ?_) + simp only [← add_smul] + ring_nf + map_smul' r A := by + ext ε + simp only [one_div, map_smul, ContinuousLinearMap.smul_apply, Lorentz.Vector.apply_smul, + ContinuousLinearMap.coe_mk', LinearMap.coe_mk, AddHom.coe_mk] + simp [Finset.smul_sum, smul_smul] + apply Finset.sum_congr rfl (fun ν _ => ?_) + apply Finset.sum_congr rfl (fun μ _ => ?_) + ring_nf + +lemma gradKineticTerm_eq_sum_sum {d} {𝓕 : FreeSpace} + (A : DistElectromagneticPotential d) (ε : 𝓢(SpaceTime d, ℝ)) : + A.gradKineticTerm 𝓕 ε = ∑ ν, ∑ μ, + (1 / (𝓕.μ₀) * (η μ μ * η ν ν * distDeriv μ (distDeriv μ A) ε ν - + distDeriv μ (distDeriv ν A) ε μ)) • Lorentz.Vector.basis ν := rfl + +lemma gradKineticTerm_eq_fieldStrength {d} {𝓕 : FreeSpace} (A : DistElectromagneticPotential d) + (ε : 𝓢(SpaceTime d, ℝ)) : + A.gradKineticTerm 𝓕 ε = ∑ ν, (1/𝓕.μ₀ * η ν ν) • + (∑ μ, ((Vector.basis.tensorProduct Vector.basis).repr + (distDeriv μ (A.fieldStrength) ε) (μ, ν))) • Lorentz.Vector.basis ν := by + rw [gradKineticTerm_eq_sum_sum A] + apply Finset.sum_congr rfl (fun ν _ => ?_) + rw [smul_smul, ← Finset.sum_smul, ← Finset.mul_sum, mul_assoc] + congr 2 + rw [Finset.mul_sum] + apply Finset.sum_congr rfl (fun μ _ => ?_) + conv_rhs => + rw [distDeriv_apply, Distribution.fderivD_apply, map_neg] + simp only [Finsupp.coe_neg, Pi.neg_apply, mul_neg] + rw [fieldStrength_basis_repr_eq_single] + simp only + rw [SpaceTime.apply_fderiv_eq_distDeriv, SpaceTime.apply_fderiv_eq_distDeriv] + simp + ring_nf + simp + +lemma gradKineticTerm_sum_inl_eq {d} {𝓕 : FreeSpace} + (A : DistElectromagneticPotential d) (ε : 𝓢(SpaceTime d, ℝ)) : + A.gradKineticTerm 𝓕 ε (Sum.inl 0) = + (1/(𝓕.μ₀ * 𝓕.c) * (distTimeSlice 𝓕.c).symm (Space.distSpaceDiv (A.electricField 𝓕.c)) ε) := by + rw [gradKineticTerm_eq_fieldStrength A ε, Lorentz.Vector.apply_sum, distTimeSlice_symm_apply, + Space.distSpaceDiv_apply_eq_sum_distSpaceDeriv, Finset.mul_sum] + simp [Fintype.sum_sum_type, Finset.mul_sum] + apply Finset.sum_congr rfl (fun ν _ => ?_) + rw [← distTimeSlice_symm_apply] + conv_rhs => + enter [2] + rw [distTimeSlice_symm_apply, Space.distSpaceDeriv_apply'] + simp only [PiLp.neg_apply] + rw [electricField_eq_fieldStrength, distTimeSlice_apply] + simp only [Fin.isValue, neg_mul, neg_neg] + rw [fieldStrength_antisymmetric_basis] + rw [← distTimeSlice_apply, Space.apply_fderiv_eq_distSpaceDeriv, ← distTimeSlice_symm_apply, + ← distTimeSlice_distDeriv_inr] + simp + field_simp + +lemma gradKineticTerm_sum_inr_eq {d} {𝓕 : FreeSpace} + (A : DistElectromagneticPotential d) (ε : 𝓢(SpaceTime d, ℝ)) (i : Fin d) : + A.gradKineticTerm 𝓕 ε (Sum.inr i) = + (𝓕.μ₀⁻¹ * (1 / 𝓕.c ^ 2 * (distTimeSlice 𝓕.c).symm + (Space.distTimeDeriv (A.electricField 𝓕.c)) ε i - + ∑ j, ((PiLp.basisFun 2 ℝ (Fin d)).tensorProduct (PiLp.basisFun 2 ℝ (Fin d))).repr + ((distTimeSlice 𝓕.c).symm (Space.distSpaceDeriv j + (A.magneticFieldMatrix 𝓕.c)) ε) (j, i))) := by + simp [gradKineticTerm_eq_fieldStrength A ε, Lorentz.Vector.apply_sum, + Fintype.sum_sum_type, mul_add, sub_eq_add_neg] + congr + · conv_rhs => + enter [2, 2] + rw [distTimeSlice_symm_apply, Space.distTimeDeriv_apply'] + simp only [PiLp.neg_apply] + rw [electricField_eq_fieldStrength, Space.apply_fderiv_eq_distTimeDeriv, + ← distTimeSlice_symm_apply] + simp [distTimeSlice_symm_distTimeDeriv_eq] + field_simp + · ext k + conv_rhs => + rw [distTimeSlice_symm_apply, Space.distSpaceDeriv_apply'] + simp only [map_neg, Finsupp.coe_neg, Pi.neg_apply] + rw [magneticFieldMatrix_basis_repr_eq_fieldStrength, Space.apply_fderiv_eq_distSpaceDeriv, + ← distTimeSlice_symm_apply] + simp [← distTimeSlice_distDeriv_inr] + +/-! + +### C.1. The gradient of the kinetic term as a tensor + +-/ + +lemma gradKineticTerm_eq_distTensorDeriv {d} {𝓕 : FreeSpace} + (A : DistElectromagneticPotential d) (ε : 𝓢(SpaceTime d, ℝ)) (ν : Fin 1 ⊕ Fin d) : + A.gradKineticTerm 𝓕 ε ν = η ν ν * ((Tensorial.toTensor (M := Lorentz.Vector d)).symm + (permT id (PermCond.auto) {(1/ 𝓕.μ₀ : ℝ) • + distTensorDeriv A.fieldStrength ε | κ κ ν'}ᵀ)) ν := by + trans η ν ν * (Lorentz.Vector.basis.repr + ((Tensorial.toTensor (M := Lorentz.Vector d)).symm + (permT id (PermCond.auto) {(1/ 𝓕.μ₀ : ℝ) • distTensorDeriv A.fieldStrength ε | κ κ ν'}ᵀ))) ν + swap + · rfl + simp [Lorentz.Vector.basis_eq_map_tensor_basis] + rw [permT_basis_repr_symm_apply, contrT_basis_repr_apply_eq_fin] + conv_lhs => + rw [gradKineticTerm_eq_fieldStrength A ε] + simp [Lorentz.Vector.apply_sum] + ring_nf + congr 1 + rw [← finSumFinEquiv.sum_comp] + congr + funext μ + rw [distTensorDeriv_toTensor_basis_repr] + conv_rhs => + enter [1, 2, 2] + trans (Tensor.basis _).repr (Tensorial.toTensor (distDeriv μ (A.fieldStrength) ε)) + (fun | 0 => finSumFinEquiv μ | 1 => finSumFinEquiv ν) + · generalize (distDeriv μ (A.fieldStrength) ε) = t at * + rw [Tensorial.basis_toTensor_apply] + rw [Tensorial.basis_map_prod] + simp only [Nat.reduceSucc, Nat.reduceAdd, Basis.repr_reindex, Finsupp.mapDomain_equiv_apply, + Equiv.symm_symm] + rw [Lorentz.Vector.tensor_basis_map_eq_basis_reindex] + have hb : (((Lorentz.Vector.basis (d := d)).reindex + Lorentz.Vector.indexEquiv.symm).tensorProduct + (Lorentz.Vector.basis.reindex Lorentz.Vector.indexEquiv.symm)) = + ((Lorentz.Vector.basis (d := d)).tensorProduct (Lorentz.Vector.basis (d := d))).reindex + (Lorentz.Vector.indexEquiv.symm.prodCongr Lorentz.Vector.indexEquiv.symm) := by + ext b + match b with + | ⟨i, j⟩ => + simp + rw [hb] + rw [Module.Basis.repr_reindex_apply] + congr 1 + simp [ComponentIdx.prodEquiv,ComponentIdx.prodIndexEquiv, Vector.indexEquiv] + apply And.intro + · rw [@Equiv.eq_symm_apply] + rfl + · rw [@Equiv.eq_symm_apply] + rfl + apply congr + · simp + congr + apply Lorentz.CoVector.indexEquiv.symm.injective + simp only [Nat.reduceSucc, Fin.isValue, Equiv.symm_apply_apply] + simp [Lorentz.CoVector.indexEquiv] + funext j + fin_cases j + simp [ComponentIdx.prodEquiv, ComponentIdx.prodIndexEquiv] + simp [ComponentIdx.DropPairSection.ofFinEquiv, ComponentIdx.DropPairSection.ofFin] + intro h + change ¬ 0 = 0 at h + simp at h + funext x + fin_cases x + · simp only [Nat.reduceSucc, Nat.reduceAdd, Fin.isValue, Function.comp_apply, Fin.cast_eq_self] + simp [ComponentIdx.prodEquiv, ComponentIdx.prodIndexEquiv] + simp [ComponentIdx.DropPairSection.ofFinEquiv, ComponentIdx.DropPairSection.ofFin] + intro _ h + apply False.elim + apply h + decide + · simp only [Nat.reduceSucc, Nat.reduceAdd, Fin.isValue, Function.comp_apply, Fin.cast_eq_self] + simp [ComponentIdx.prodEquiv, ComponentIdx.prodIndexEquiv] + simp [ComponentIdx.DropPairSection.ofFinEquiv, ComponentIdx.DropPairSection.ofFin] + split_ifs + · rename_i h + suffices ¬ (finSumFinEquiv (Sum.inr 1) = (0 : Fin (1 + 1 + 1))) from False.elim (this h) + decide + · rename_i h h2 + suffices ¬ (finSumFinEquiv (Sum.inr 1) = (1 : Fin (1 + 1 + 1))) from False.elim (this h2) + decide + · rfl + +end DistElectromagneticPotential end Electromagnetism diff --git a/PhysLean/Electromagnetism/Dynamics/Lagrangian.lean b/PhysLean/Electromagnetism/Dynamics/Lagrangian.lean index fac7984bd..d4219ab6b 100644 --- a/PhysLean/Electromagnetism/Dynamics/Lagrangian.lean +++ b/PhysLean/Electromagnetism/Dynamics/Lagrangian.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Electromagnetism.Dynamics.CurrentDensity -import PhysLean.Electromagnetism.Kinematics.MagneticField +import PhysLean.Electromagnetism.Dynamics.KineticTerm /-! # The Lagrangian in electromagnetism @@ -22,6 +22,9 @@ In this implementation we set `μ₀ = 1`. It is a TODO to introduce this consta ## ii. Key results +- `freeCurrentPotential` : The potential energy from the interaction of the electromagnetic + potential with a free Lorentz current density. +- `gradFreeCurrentPotential` : The variational gradient of the free current potential. - `lagrangian` : The lagrangian density for the electromagnetic field in presence of a Lorentz current density. - `gradLagrangian` : The variational gradient of the lagrangian density. @@ -30,15 +33,27 @@ In this implementation we set `μ₀ = 1`. It is a TODO to introduce this consta ## iii. Table of contents -- A. The Lagrangian density - - A.1. Shifts in the lagrangian under shifts in the potential -- B. The variational gradient of the lagrangian density - - B.1. The lagrangian density has a variational gradient - - B.2. The definition of, `gradLagrangian`, the variational gradient of the lagrangian density - - B.3. The variational gradient in terms of the gradient of the kinetic term - - B.4. The lagrangian density has the variational gradient equal to `gradLagrangian` - - B.5. The variational gradient in terms of the field strength tensor - - B.6. The lagrangian gradient recovering Gauss's and Ampère laws +- A. Free current potential + - A.1. Shifts in the free current potential under shifts in the potential + - A.2. The free current potential has a variational gradient + - A.3. The free current potential in terms of the scalar and vector potentials + - A.4. The variational gradient of the free current potential +- B. The Lagrangian density + - B.1. Shifts in the lagrangian under shifts in the potential + - B.2. Lagrangian in terms of electric and magnetic fields +- C. The variational gradient of the lagrangian density + - C.1. The lagrangian density has a variational gradient + - C.2. The definition of, `gradLagrangian`, the variational gradient of the lagrangian density + - C.3. The variational gradient in terms of the gradient of the kinetic term + - C.4. The lagrangian density has the variational gradient equal to `gradLagrangian` + - C.5. The variational gradient in terms of the field strength tensor + - C.6. The lagrangian gradient recovering Gauss's and Ampère laws + - C.7. The lagrangian gradient in tensor notation +- D. The gradient of the lagrangian density for distributions + - D.1. The gradient of the free current potential + - D.1.1. Free current potential as a tensor + - D.2. The gradient of the lagrangian density + - D.2.1. The lagrangian gradient as a tensor ## iv. References @@ -64,9 +79,128 @@ open InnerProductSpace open Lorentz.Vector attribute [-simp] Fintype.sum_sum_type attribute [-simp] Nat.succ_eq_add_one + +/-! + +## A. Free current potential + +-/ + +/-- The potential energy from the interaction of the electromagnetic potential + with the free current `J`. -/ +noncomputable def freeCurrentPotential (A : ElectromagneticPotential d) + (J : LorentzCurrentDensity d) + (x : SpaceTime d) : ℝ := ⟪A x, J x⟫ₘ + +/-! + +### A.1. Shifts in the free current potential under shifts in the potential + +-/ + +lemma freeCurrentPotential_add_const (A : ElectromagneticPotential d) + (J : LorentzCurrentDensity d) (c : Lorentz.Vector d) (x : SpaceTime d) : + freeCurrentPotential (fun x => A x + c) J x = freeCurrentPotential A J x + ⟪c, J x⟫ₘ := by + rw [freeCurrentPotential, freeCurrentPotential] + simp + /-! -## A. The Lagrangian density +### A.2. The free current potential has a variational gradient + +-/ + +lemma freeCurrentPotential_hasVarGradientAt (A : ElectromagneticPotential d) + (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) + (hJ : ContDiff ℝ ∞ J) : + HasVarGradientAt (fun A => freeCurrentPotential A J) + (((∑ μ, fun x => (η μ μ * J x μ) • Lorentz.Vector.basis μ))) A := by + conv => + enter [1, q', x] + rw [freeCurrentPotential, minkowskiProduct_toCoord_minkowskiMatrix] + apply HasVarGradientAt.sum _ hA + intro μ + have h1 := hasVarAdjDerivAt_component μ A hA + have h2' : ContDiff ℝ ∞ fun x => η μ μ * J x μ := + ContDiff.mul (by fun_prop) ((Lorentz.Vector.contDiff_apply _).mpr hJ μ) + have h2 := HasVarAdjDerivAt.fun_mul h2' _ _ A h1 + have h3' : (fun (φ : SpaceTime d → Lorentz.Vector d) x => η μ μ * J x μ * φ x μ) = + (fun (φ : SpaceTime d → Lorentz.Vector d) x => η μ μ * φ x μ * J x μ) := by + funext φ x + ring + rw [h3'] at h2 + apply HasVarGradientAt.intro _ h2 + simp + +/-! + +### A.3. The free current potential in terms of the scalar and vector potentials + +-/ + +lemma freeCurrentPotential_eq_sum_scalarPotential_vectorPotential + (𝓕 : FreeSpace) (A : ElectromagneticPotential d) + (J : LorentzCurrentDensity d) (x : SpaceTime d) : + A.freeCurrentPotential J x = + A.scalarPotential 𝓕.c (x.time 𝓕.c) x.space * J.chargeDensity 𝓕.c (x.time 𝓕.c) x.space + - ∑ i, A.vectorPotential 𝓕.c (x.time 𝓕.c) x.space i * + J.currentDensity 𝓕.c (x.time 𝓕.c) x.space i := by + rw [freeCurrentPotential, minkowskiProduct_toCoord_minkowskiMatrix] + simp [Fintype.sum_sum_type, scalarPotential, vectorPotential, LorentzCurrentDensity.chargeDensity, + LorentzCurrentDensity.currentDensity, timeSlice] + field_simp + ring + +/-! + +### A.4. The variational gradient of the free current potential + +-/ + +/-- The variational gradient of the free current potential. -/ +noncomputable def gradFreeCurrentPotential {d} (A : ElectromagneticPotential d) + (J : LorentzCurrentDensity d) : SpaceTime d → Lorentz.Vector d := + (δ (q':=A), ∫ x, freeCurrentPotential q' J x) + +lemma gradFreeCurrentPotential_eq_sum_basis {d} (A : ElectromagneticPotential d) + (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) + (hJ : ContDiff ℝ ∞ J) : + A.gradFreeCurrentPotential J = (∑ μ, fun x => (η μ μ * J x μ) • Lorentz.Vector.basis μ) := by + apply HasVarGradientAt.varGradient + apply freeCurrentPotential_hasVarGradientAt A hA J hJ + +lemma gradFreeCurrentPotential_eq_chargeDensity_currentDensity {d} + (𝓕 : FreeSpace) (A : ElectromagneticPotential d) + (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) + (hJ : ContDiff ℝ ∞ J) (x : SpaceTime d) : + A.gradFreeCurrentPotential J x = + (𝓕.c * J.chargeDensity 𝓕.c (x.time 𝓕.c) x.space) • Lorentz.Vector.basis (Sum.inl 0) + + (∑ i, - J.currentDensity 𝓕.c (x.time 𝓕.c) x.space i • Lorentz.Vector.basis (Sum.inr i)) := by + rw [gradFreeCurrentPotential_eq_sum_basis A hA J hJ] + rw [Fintype.sum_sum_type] + simp only [Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Finset.sum_singleton, + inl_0_inl_0, one_mul, inr_i_inr_i, neg_mul, _root_.neg_smul, Pi.add_apply, Finset.sum_apply, + Finset.sum_neg_distrib] + congr + · simp [LorentzCurrentDensity.chargeDensity] + · simp [LorentzCurrentDensity.currentDensity] + +lemma gradFreeCurrentPotential_eq_tensor {d} (A : ElectromagneticPotential d) + (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) + (hJ : ContDiff ℝ ∞ J) (x : SpaceTime d) (ν : Fin 1 ⊕ Fin d) : + A.gradFreeCurrentPotential J x ν = η ν ν * ((Tensorial.toTensor (M := Lorentz.Vector d)).symm + (permT id (PermCond.auto) {J x | ν'}ᵀ)) ν := by + trans η ν ν * (Lorentz.Vector.basis.repr ((Tensorial.toTensor (M := Lorentz.Vector d)).symm + (permT id (PermCond.auto) {J x | ν'}ᵀ))) ν + swap + · simp [Lorentz.Vector.basis_repr_apply] + simp [Lorentz.Vector.basis_repr_apply] + rw [gradFreeCurrentPotential_eq_sum_basis A hA J hJ] + simp [Lorentz.Vector.apply_sum] + +/-! + +## B. The Lagrangian density The lagrangian density for the electromagnetic field in presence of a current density `J` is `L = -1/(4 μ₀) F_{μν} F^{μν} - A_μ J^μ` @@ -75,180 +209,356 @@ The lagrangian density for the electromagnetic field in presence of a current de /-- The lagrangian density associated with a electromagnetic potential and a Lorentz current density. -/ -noncomputable def lagrangian (A : ElectromagneticPotential d) (J : LorentzCurrentDensity d) - (x : SpaceTime d) : ℝ := - A.kineticTerm x - ⟪A x, J x⟫ₘ +noncomputable def lagrangian (𝓕 : FreeSpace) (A : ElectromagneticPotential d) + (J : LorentzCurrentDensity d) (x : SpaceTime d) : ℝ := + A.kineticTerm 𝓕 x - A.freeCurrentPotential J x /-! -### A.1. Shifts in the lagrangian under shifts in the potential +### B.1. Shifts in the lagrangian under shifts in the potential -/ -lemma lagrangian_add_const {d} (A : ElectromagneticPotential d) +lemma lagrangian_add_const {d} {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (J : LorentzCurrentDensity d) (c : Lorentz.Vector d) (x : SpaceTime d) : - lagrangian (fun x => A x + c) J x = lagrangian A J x - ⟪c, J x⟫ₘ := by - rw [lagrangian, lagrangian, kineticTerm_add_const] - simp only [map_add, ContinuousLinearMap.add_apply] + lagrangian 𝓕 (fun x => A x + c) J x = lagrangian 𝓕 A J x - ⟪c, J x⟫ₘ := by + rw [lagrangian, lagrangian, kineticTerm_add_const, freeCurrentPotential_add_const] ring /-! -## B. The variational gradient of the lagrangian density +### B.2. Lagrangian in terms of electric and magnetic fields + -/ +/-- The Lagrangian is equal to `1/2 * (ε₀ E^2 - 1/μ₀ B^2) - φρ + A · j`-/ +lemma lagrangian_eq_electric_magnetic {d} {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) (hA : ContDiff ℝ 2 A) + (J : LorentzCurrentDensity d) (x : SpaceTime d) : + A.lagrangian 𝓕 J x = 1 / 2 * (𝓕.ε₀ * ‖A.electricField 𝓕.c (x.time 𝓕.c) x.space‖ ^ 2 - + (1 / (2 * 𝓕.μ₀)) * ∑ i, ∑ j, ‖A.magneticFieldMatrix 𝓕.c (x.time 𝓕.c) x.space (i, j)‖ ^ 2) + - A.scalarPotential 𝓕.c (x.time 𝓕.c) x.space * J.chargeDensity 𝓕.c (x.time 𝓕.c) x.space + + ∑ i, A.vectorPotential 𝓕.c (x.time 𝓕.c) x.space i * + J.currentDensity 𝓕.c (x.time 𝓕.c) x.space i := by + rw [lagrangian] + rw[kineticTerm_eq_electricMatrix_magneticFieldMatrix _ _ (hA.differentiable (by simp))] + rw [freeCurrentPotential_eq_sum_scalarPotential_vectorPotential 𝓕 A J x] + ring + /-! -### B.1. The lagrangian density has a variational gradient +## C. The variational gradient of the lagrangian density +-/ + +/-! + +### C.1. The lagrangian density has a variational gradient -/ -lemma lagrangian_hasVarGradientAt_eq_add_gradKineticTerm (A : ElectromagneticPotential d) - (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) +lemma lagrangian_hasVarGradientAt_eq_add_gradKineticTerm {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) (hJ : ContDiff ℝ ∞ J) : - HasVarGradientAt (fun A => lagrangian A J) - (A.gradKineticTerm - ((∑ μ, fun x => (η μ μ * J x μ) • Lorentz.Vector.basis μ))) A := by + HasVarGradientAt (fun A => lagrangian 𝓕 A J) + (A.gradKineticTerm 𝓕 - A.gradFreeCurrentPotential J) A := by conv => enter [1, q', x] rw [lagrangian] apply HasVarGradientAt.add · exact A.kineticTerm_hasVarGradientAt hA apply HasVarGradientAt.neg - conv => - enter [1, q', x] - rw [minkowskiProduct_toCoord_minkowskiMatrix] - apply HasVarGradientAt.sum _ hA - intro μ - have h1 := hasVarAdjDerivAt_component μ A hA - have h2' : ContDiff ℝ ∞ fun x => η μ μ * J x μ := - ContDiff.mul (by fun_prop) (contDiff_euclidean.mp hJ μ) - have h2 := HasVarAdjDerivAt.fun_mul h2' _ _ A h1 - have h3' : (fun (φ : SpaceTime d → Lorentz.Vector d) x => η μ μ * J x μ * φ x μ) = - (fun (φ : SpaceTime d → Lorentz.Vector d) x => η μ μ * φ x μ * J x μ) := by - funext φ x - ring - rw [h3'] at h2 - apply HasVarGradientAt.intro _ h2 - simp + convert freeCurrentPotential_hasVarGradientAt A hA J hJ + rw [← gradFreeCurrentPotential_eq_sum_basis A hA J hJ] /-! -### B.2. The definition of, `gradLagrangian`, the variational gradient of the lagrangian density +### C.2. The definition of, `gradLagrangian`, the variational gradient of the lagrangian density -/ /-- The variational gradient of the lagrangian of electromagnetic field. -/ -noncomputable def gradLagrangian {d} (A : ElectromagneticPotential d) +noncomputable def gradLagrangian {d} (𝓕 : FreeSpace) (A : ElectromagneticPotential d) (J : LorentzCurrentDensity d) : SpaceTime d → Lorentz.Vector d := - (δ (q':=A), ∫ x, lagrangian q' J x) + (δ (q':=A), ∫ x, lagrangian 𝓕 q' J x) /-! -### B.3. The variational gradient in terms of the gradient of the kinetic term +### C.3. The variational gradient in terms of the gradient of the kinetic term -/ -lemma gradLagrangian_eq_kineticTerm_sub (A : ElectromagneticPotential d) +lemma gradLagrangian_eq_kineticTerm_sub {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) (hJ : ContDiff ℝ ∞ J) : - A.gradLagrangian J = A.gradKineticTerm - - ((∑ μ, fun x => (η μ μ * J x μ) • Lorentz.Vector.basis μ)) := by + A.gradLagrangian 𝓕 J = A.gradKineticTerm 𝓕 - A.gradFreeCurrentPotential J := by apply HasVarGradientAt.varGradient apply lagrangian_hasVarGradientAt_eq_add_gradKineticTerm A hA J hJ /-! -### B.4. The lagrangian density has the variational gradient equal to `gradLagrangian` +### C.4. The lagrangian density has the variational gradient equal to `gradLagrangian` -/ -lemma lagrangian_hasVarGradientAt_gradLagrangian (A : ElectromagneticPotential d) +lemma lagrangian_hasVarGradientAt_gradLagrangian {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) (hJ : ContDiff ℝ ∞ J) : - HasVarGradientAt (fun A => lagrangian A J) (A.gradLagrangian J) A := by + HasVarGradientAt (fun A => lagrangian 𝓕 A J) (A.gradLagrangian 𝓕 J) A := by rw [gradLagrangian_eq_kineticTerm_sub A hA J hJ] apply lagrangian_hasVarGradientAt_eq_add_gradKineticTerm A hA J hJ /-! -### B.5. The variational gradient in terms of the field strength tensor +### C.5. The variational gradient in terms of the field strength tensor -/ -lemma gradLagrangian_eq_sum_fieldStrengthMatrix (A : ElectromagneticPotential d) +lemma gradLagrangian_eq_sum_fieldStrengthMatrix {𝓕 : FreeSpace} (A : ElectromagneticPotential d) (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) (hJ : ContDiff ℝ ∞ J) : - A.gradLagrangian J = fun x => ∑ ν, - (η ν ν • (∑ μ, ∂_ μ (fun x => (A.fieldStrengthMatrix x) (μ, ν)) x - J x ν) + A.gradLagrangian 𝓕 J = fun x => ∑ ν, + (η ν ν • (1 / 𝓕.μ₀ * ∑ μ, ∂_ μ (fun x => (A.fieldStrengthMatrix x) (μ, ν)) x - J x ν) • Lorentz.Vector.basis ν) := by rw [gradLagrangian_eq_kineticTerm_sub A hA J hJ] funext x - simp only [Pi.sub_apply, Finset.sum_apply] - rw [gradKineticTerm_eq_fieldStrength] + simp only [Pi.sub_apply] + rw [gradKineticTerm_eq_fieldStrength, gradFreeCurrentPotential_eq_sum_basis A hA J hJ] + simp only [one_div, Finset.sum_apply] rw [← Finset.sum_sub_distrib] refine Finset.sum_congr rfl (fun ν _ => ?_) - rw [smul_smul, ← sub_smul, ← mul_sub, ← smul_smul] + rw [smul_smul, smul_smul, ← sub_smul] + ring_nf exact hA /-! -### B.6. The lagrangian gradient recovering Gauss's and Ampère laws - --/ - -open Time -lemma gradLagrangian_eq_electricField_magneticField (A : ElectromagneticPotential 3) - (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity 3) - (hJ : ContDiff ℝ ∞ J) (x : SpaceTime) : - A.gradLagrangian J x = ((∇ ⬝ A.electricField x.time) x.space - J.chargeDensity x.time x.space) • - Lorentz.Vector.basis (Sum.inl 0) + - (∑ i, (∂ₜ (A.electricField · x.space) x.time - (∇ × (A.magneticField x.time)) x.space - + J.currentDensity x.time x.space) i • Lorentz.Vector.basis (Sum.inr i)) := by - calc A.gradLagrangian J x - _ = A.gradKineticTerm x - ((∑ μ, (η μ μ * J x μ) • Lorentz.Vector.basis μ)) := by - rw [gradLagrangian_eq_kineticTerm_sub A hA J hJ] - simp - _ = (∇ ⬝ (A.electricField x.time)) x.space • Lorentz.Vector.basis (Sum.inl 0) + - ∑ i, (∂ₜ (A.electricField · x.space) x.time i - (∇ × (A.magneticField x.time)) x.space i) - • Lorentz.Vector.basis (Sum.inr i) - - ((∑ μ, (η μ μ * J x μ) • Lorentz.Vector.basis μ)) := by - rw [gradKineticTerm_eq_electric_magnetic _ _ hA] - rfl - _ = (∇ ⬝ (A.electricField x.time)) x.space • Lorentz.Vector.basis (Sum.inl 0) + - ∑ i, (∂ₜ (A.electricField · x.space) x.time i - (∇ × (A.magneticField x.time)) x.space i) - • Lorentz.Vector.basis (Sum.inr i) - - ((J x (Sum.inl 0) • Lorentz.Vector.basis (Sum.inl 0)) - - (∑ i, J x (Sum.inr i) • Lorentz.Vector.basis (Sum.inr i))) := by - rw [Fintype.sum_sum_type] - simp - rfl - _ = (∇ ⬝ (A.electricField x.time)) x.space • Lorentz.Vector.basis (Sum.inl 0) - - (J x (Sum.inl 0) • Lorentz.Vector.basis (Sum.inl 0)) + - (∑ i, (∂ₜ (A.electricField · x.space) x.time i - (∇ × (A.magneticField x.time)) x.space i) - • Lorentz.Vector.basis (Sum.inr i) - + (∑ i, J x (Sum.inr i) • Lorentz.Vector.basis (Sum.inr i))) := by - module - _ = ((∇ ⬝ (A.electricField x.time)) x.space - J x (Sum.inl 0)) • - Lorentz.Vector.basis (Sum.inl 0) + - (∑ i, (∂ₜ (A.electricField · x.space) x.time i - (∇ × (A.magneticField x.time)) x.space i) - • Lorentz.Vector.basis (Sum.inr i) - + (∑ i, J x (Sum.inr i) • Lorentz.Vector.basis (Sum.inr i))) := by - module - _ = ((∇ ⬝ (A.electricField x.time)) x.space - J.chargeDensity x.time x.space) • - Lorentz.Vector.basis (Sum.inl 0) + - (∑ i, (∂ₜ (A.electricField · x.space) x.time i - (∇ × (A.magneticField x.time)) x.space i - + J x (Sum.inr i)) • Lorentz.Vector.basis (Sum.inr i)) := by - conv_rhs => - enter [2, 2, i] - rw [add_smul] - rw [Finset.sum_add_distrib] - congr - simp - _ = ((∇ ⬝ A.electricField x.time) x.space - J.chargeDensity x.time x.space) • - Lorentz.Vector.basis (Sum.inl 0) + - (∑ i, (∂ₜ (A.electricField · x.space) x.time - (∇ × (A.magneticField x.time)) x.space - + J.currentDensity x.time x.space) i • Lorentz.Vector.basis (Sum.inr i)) := by +### C.6. The lagrangian gradient recovering Gauss's and Ampère laws + +-/ + +open Time LorentzCurrentDensity +lemma gradLagrangian_eq_electricField_magneticField {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) + (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) + (hJ : ContDiff ℝ ∞ J) (x : SpaceTime d) : + A.gradLagrangian 𝓕 J x = (1 / (𝓕.μ₀ * 𝓕.c.val) * + Space.div (electricField 𝓕.c A ((time 𝓕.c) x)) (space x) + + - 𝓕.c * J.chargeDensity 𝓕.c (x.time 𝓕.c) x.space) • + Lorentz.Vector.basis (Sum.inl 0) + + ∑ i, (𝓕.μ₀⁻¹ * (𝓕.ε₀ * 𝓕.μ₀ * ∂ₜ (electricField 𝓕.c A · x.space) ((time 𝓕.c) x) i - + ∑ j, ∂[j] (magneticFieldMatrix 𝓕.c A (x.time 𝓕.c) · (j, i)) x.space) + + J.currentDensity 𝓕.c (x.time 𝓕.c) x.space i) • + Lorentz.Vector.basis (Sum.inr i) := by + rw [gradLagrangian_eq_kineticTerm_sub A hA J hJ] + simp only [Pi.sub_apply, one_div, mul_inv_rev, neg_mul, Fin.isValue] + rw [gradKineticTerm_eq_electric_magnetic _ _ hA] + rw [gradFreeCurrentPotential_eq_chargeDensity_currentDensity 𝓕 A hA J hJ x] + conv_lhs => + enter [2] + rw [add_comm] + rw [add_sub_assoc] + conv_lhs => + enter [2] + rw [sub_add_eq_sub_sub] + rw [← Finset.sum_sub_distrib] + rw [← neg_add_eq_sub] + rw [← add_assoc] + conv_lhs => + enter [1, 2] + rw [← _root_.neg_smul] + rw [← add_smul] + conv_lhs => + enter [2, 2, i] + rw [← sub_smul] + simp [FreeSpace.c_sq] + ring_nf + +/-! + +### C.7. The lagrangian gradient in tensor notation + +-/ + +lemma gradLagrangian_eq_tensor {𝓕 : FreeSpace} + (A : ElectromagneticPotential d) + (hA : ContDiff ℝ ∞ A) (J : LorentzCurrentDensity d) + (hJ : ContDiff ℝ ∞ J) (x : SpaceTime d) (ν : Fin 1 ⊕ Fin d) : + A.gradLagrangian 𝓕 J x ν = + η ν ν * ((Tensorial.toTensor (M := Lorentz.Vector d)).symm + (permT id (PermCond.auto) {((1/ 𝓕.μ₀ : ℝ) • tensorDeriv A.toFieldStrength x | κ κ ν') + + - (J x | ν')}ᵀ)) ν := by + rw [gradLagrangian_eq_kineticTerm_sub _ hA _ hJ] + simp only [Pi.sub_apply, apply_sub, Nat.reduceSucc, Nat.reduceAdd, Fin.isValue, one_div, map_smul, + map_neg, map_add, permT_permT, CompTriple.comp_eq, apply_add, apply_smul, neg_apply] + rw [gradKineticTerm_eq_tensorDeriv A x hA] + rw [gradFreeCurrentPotential_eq_tensor A hA J hJ x ν] + simp only [Nat.reduceSucc, Nat.reduceAdd, Fin.isValue, one_div, map_smul, apply_smul, + permT_id_self, LinearEquiv.symm_apply_apply] + ring_nf + congr + rw [permT_congr_eq_id] + simp only [LinearEquiv.symm_apply_apply] + funext i + fin_cases i + simp + +end ElectromagneticPotential + +/-! + +## D. The gradient of the lagrangian density for distributions + +-/ + +namespace DistElectromagneticPotential +open TensorSpecies +open Tensor +open SpaceTime +open TensorProduct +open minkowskiMatrix +open InnerProductSpace +open Lorentz.Vector SchwartzMap +attribute [-simp] Fintype.sum_sum_type +attribute [-simp] Nat.succ_eq_add_one +/-! + +### D.1. The gradient of the free current potential + +We define this through the lemma `gradFreeCurrentPotential_eq_sum_basis` +-/ + +/-- The variational gradient of the free current potential for distributional potentials. -/ +noncomputable def gradFreeCurrentPotential {d} : + DistLorentzCurrentDensity d →ₗ[ℝ] ((SpaceTime d) →d[ℝ] Lorentz.Vector d) where + toFun J := { + toFun ε := ∑ μ, (η μ μ • (J ε μ) • Lorentz.Vector.basis μ) + map_add' ε₁ ε₂ := by + simp [Finset.sum_add_distrib, add_smul] + map_smul' r ε := by + simp only [map_smul, apply_smul, smul_smul, Real.ringHom_apply, Finset.smul_sum] congr funext i - simp [LorentzCurrentDensity.currentDensity] + ring_nf + cont := by fun_prop + } + map_add' J₁ J₂ := by + ext ε + simp [Finset.sum_add_distrib, add_smul] + map_smul' r J := by + ext ε + simp [Finset.smul_sum, smul_smul] + congr + funext i + ring_nf + +lemma gradFreeCurrentPotential_eq_sum_basis {d} + (J : DistLorentzCurrentDensity d) (ε : 𝓢(SpaceTime d, ℝ)) : + (gradFreeCurrentPotential J) ε = + (∑ μ, (η μ μ • (J ε μ) • Lorentz.Vector.basis μ)) := rfl + +lemma gradFreeCurrentPotential_sum_inl_0 (𝓕 : FreeSpace) {d} + (J : DistLorentzCurrentDensity d) (ε : 𝓢(SpaceTime d, ℝ)) : + (gradFreeCurrentPotential J) ε (Sum.inl 0) = + 𝓕.c * (distTimeSlice 𝓕.c).symm (J.chargeDensity 𝓕.c) ε := by + simp only [gradFreeCurrentPotential, LinearMap.coe_mk, AddHom.coe_mk, Fin.isValue, + ContinuousLinearMap.coe_mk', apply_sum, apply_smul, Lorentz.Vector.basis_apply, mul_ite, + mul_one, mul_zero, Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte, inl_0_inl_0, one_mul, + DistLorentzCurrentDensity.chargeDensity, one_div, temporalCLM, map_smul, + ContinuousLinearMap.coe_smul', Pi.smul_apply, distTimeSlice_symm_apply, + ContinuousLinearMap.coe_comp', LinearMap.coe_toContinuousLinearMap', Function.comp_apply, + smul_eq_mul, ne_eq, SpeedOfLight.val_ne_zero, not_false_eq_true, mul_inv_cancel_left₀] + rw [← distTimeSlice_symm_apply] + simp -end ElectromagneticPotential +lemma gradFreeCurrentPotential_sum_inr_i (𝓕 : FreeSpace) {d} + (J : DistLorentzCurrentDensity d) (ε : 𝓢(SpaceTime d, ℝ)) (i : Fin d) : + (gradFreeCurrentPotential J) ε (Sum.inr i) = + - (distTimeSlice 𝓕.c).symm (J.currentDensity 𝓕.c) ε i := by + simp only [gradFreeCurrentPotential, LinearMap.coe_mk, AddHom.coe_mk, ContinuousLinearMap.coe_mk', + apply_sum, apply_smul, Lorentz.Vector.basis_apply, mul_ite, mul_one, mul_zero, + Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte, inr_i_inr_i, + DistLorentzCurrentDensity.currentDensity, spatialCLM, distTimeSlice_symm_apply, + ContinuousLinearMap.coe_comp', Function.comp_apply] + rw [← distTimeSlice_symm_apply] + simp + +/-! + +#### D.1.1. Free current potential as a tensor + +-/ + +lemma gradFreeCurrentPotential_eq_tensor {d} + (J : DistLorentzCurrentDensity d) (ε : 𝓢(SpaceTime d, ℝ)) + (ν : Fin 1 ⊕ Fin d) : + gradFreeCurrentPotential J ε ν = η ν ν * ((Tensorial.toTensor (M := Lorentz.Vector d)).symm + (permT id (PermCond.auto) {J ε | ν'}ᵀ)) ν:= by + trans η ν ν * (Lorentz.Vector.basis.repr ((Tensorial.toTensor (M := Lorentz.Vector d)).symm + (permT id (PermCond.auto) {J ε | ν'}ᵀ))) ν + swap + · simp [Lorentz.Vector.basis_repr_apply] + simp [Lorentz.Vector.basis_repr_apply] + rw [gradFreeCurrentPotential_eq_sum_basis] + simp [Lorentz.Vector.apply_sum] + +/-! + +### D.2. The gradient of the lagrangian density + +Defined through `gradLagrangian_eq_kineticTerm_sub`. + +-/ + +/-- The variational gradient of lagrangian for an electromagnetic potential which is + a distribution. -/ +noncomputable def gradLagrangian {d} (𝓕 : FreeSpace) (A : DistElectromagneticPotential d) + (J : DistLorentzCurrentDensity d) : ((SpaceTime d) →d[ℝ] Lorentz.Vector d) := + A.gradKineticTerm 𝓕 - gradFreeCurrentPotential J + +lemma gradLagrangian_sum_inl_0 {𝓕 : FreeSpace} + (A : DistElectromagneticPotential d) (J : DistLorentzCurrentDensity d) + (ε : 𝓢(SpaceTime d, ℝ)) : + A.gradLagrangian 𝓕 J ε (Sum.inl 0) = + (1/(𝓕.μ₀ * 𝓕.c) * (distTimeSlice 𝓕.c).symm (Space.distSpaceDiv (A.electricField 𝓕.c)) ε) + - 𝓕.c * (distTimeSlice 𝓕.c).symm (J.chargeDensity 𝓕.c) ε := by + simp [gradLagrangian, gradKineticTerm_sum_inl_eq, gradFreeCurrentPotential_sum_inl_0 𝓕] + +lemma gradLagrangian_sum_inr_i {𝓕 : FreeSpace} + (A : DistElectromagneticPotential d) (J : DistLorentzCurrentDensity d) + (ε : 𝓢(SpaceTime d, ℝ)) (i : Fin d) : + A.gradLagrangian 𝓕 J ε (Sum.inr i) = + 𝓕.μ₀⁻¹ * (1 / 𝓕.c ^ 2 * + (distTimeSlice 𝓕.c).symm (Space.distTimeDeriv (A.electricField 𝓕.c)) ε i - + ∑ j, ((PiLp.basisFun 2 ℝ (Fin d)).tensorProduct (PiLp.basisFun 2 ℝ (Fin d))).repr + ((distTimeSlice 𝓕.c).symm (Space.distSpaceDeriv j (A.magneticFieldMatrix 𝓕.c)) ε) (j, i)) + + (distTimeSlice 𝓕.c).symm (J.currentDensity 𝓕.c) ε i := by + simp [gradLagrangian, gradKineticTerm_sum_inr_eq, gradFreeCurrentPotential_sum_inr_i 𝓕] + +/-! + +#### D.2.1. The lagrangian gradient as a tensor + +-/ + +lemma gradLagrangian_eq_tensor {𝓕 : FreeSpace} + (A : DistElectromagneticPotential d) (J : DistLorentzCurrentDensity d) + (ε : 𝓢(SpaceTime d, ℝ)) (ν : Fin 1 ⊕ Fin d) : + A.gradLagrangian 𝓕 J ε ν = + η ν ν * ((Tensorial.toTensor (M := Lorentz.Vector d)).symm + (permT id (PermCond.auto) {((1/ 𝓕.μ₀ : ℝ) • distTensorDeriv A.fieldStrength ε | κ κ ν') + + - (J ε | ν')}ᵀ)) ν := by + rw [gradLagrangian] + simp only [ContinuousLinearMap.coe_sub', Pi.sub_apply, apply_sub, Nat.reduceSucc, Nat.reduceAdd, + Fin.isValue, one_div, map_smul, map_neg, map_add, permT_permT, CompTriple.comp_eq, apply_add, + apply_smul, Lorentz.Vector.neg_apply] + rw [gradKineticTerm_eq_distTensorDeriv, gradFreeCurrentPotential_eq_tensor J ε ν] + simp only [Nat.reduceSucc, Nat.reduceAdd, Fin.isValue, one_div, map_smul, apply_smul, + permT_id_self, LinearEquiv.symm_apply_apply] + ring_nf + congr + rw [permT_congr_eq_id] + simp only [LinearEquiv.symm_apply_apply] + funext i + fin_cases i + simp +end DistElectromagneticPotential end Electromagnetism diff --git a/PhysLean/Electromagnetism/Electrostatics/Basic.lean b/PhysLean/Electromagnetism/Electrostatics/Basic.lean deleted file mode 100644 index 44cb0e88a..000000000 --- a/PhysLean/Electromagnetism/Electrostatics/Basic.lean +++ /dev/null @@ -1,68 +0,0 @@ -/- -Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Tooby-Smith --/ -import PhysLean.SpaceAndTime.Space.Distributions.Basic -/-! - -# Electrostatics - -Electrostatics corresponds to the study of electric fields and potentials in the absence of -time variation or magnetic fields. - -The study of electrostatics usually necessitates the use of distributions, since point charges -are often used to model charged particles. The formal definition of such distributions -are often glossed over in physics. As a result some of the definitions or proofs -within PhysLean's electrostatics may seem over the top - but this is necessary for complete -mathematical correctness. - -This script is old, and will soon be replaced. - --/ - -namespace Electromagnetism -open Distribution SchwartzMap - -/-- The type of static electric fields (i.e. time-independent electric fields), defined - as distributions from `Space d` to `EuclideanSpace ℝ (Fin d)`. -/ -abbrev StaticElectricField (d : ℕ := 3) := (Space d) →d[ℝ] EuclideanSpace ℝ (Fin d) - -/-- The type of charge distributions. Mathematically this is equivalent to the - type of distributions from `Space d` to `ℝ`. -/ -abbrev ChargeDistribution (d : ℕ := 3) := (Space d) →d[ℝ] ℝ - -/-- The type of static electric potentials. - Mathematically defined as distributions from `Space d` to `ℝ`. -/ -abbrev StaticElectricPotential (d : ℕ := 3) := - (Space d) →d[ℝ] ℝ - -namespace StaticElectricField - -/-- The static electric field associated with a static electric potential. -/ -noncomputable def ofPotential {d : ℕ} (φ : StaticElectricPotential d) : StaticElectricField d := - - Space.gradD φ - -/-- Gauss's law for static electric fields. -/ -def GaussLaw {d : ℕ} (E : StaticElectricField d) (ε : ℝ) (ρ : ChargeDistribution d) : - Prop := Space.divD E = (1 / ε) • ρ - -lemma gaussLaw_iff {d : ℕ} (E : StaticElectricField d) (ε : ℝ) (ρ : ChargeDistribution d) : - E.GaussLaw ε ρ ↔ Space.divD E = (1 / ε) • ρ := by - rw [GaussLaw] - -TODO "IBQW4" "Generalize Faraday's law to arbitrary space dimensions. - This may involve generalizing the curl operator to arbitrary dimensions." - -/-- Faraday's law in 3d for static electric fields. -/ -def FaradaysLaw (E : StaticElectricField) : Prop := - Space.curlD E = 0 - -/-- If the electric field is of the form `-∇φ` then Faraday's law holds. -/ -lemma ofPotential_faradaysLaw (φ : StaticElectricPotential) : - FaradaysLaw (ofPotential φ) := by - simp [ofPotential, FaradaysLaw] - -end StaticElectricField - -end Electromagnetism diff --git a/PhysLean/Electromagnetism/Kinematics/Boosts.lean b/PhysLean/Electromagnetism/Kinematics/Boosts.lean index 5dac210cd..12db3e0eb 100644 --- a/PhysLean/Electromagnetism/Kinematics/Boosts.lean +++ b/PhysLean/Electromagnetism/Kinematics/Boosts.lean @@ -11,20 +11,28 @@ import PhysLean.SpaceAndTime.SpaceTime.Boosts ## i. Overview -We find the transformations of the electric and magnetic fields under a Lorentz boost -in the `x` direction. +We find the transformations of the electric and magnetic field matrix under +boosts in the 'x' direction. We do this in full-generality for `d+1` space dimensions. ## ii. Key results -- `electricField_apply_x_boost` : The transformation of the electric field under a - boost in the `x` direction. -- `magneticField_apply_x_boost` : The transformation of the magnetic field under a - boost in the `x` direction. +- `electricField_apply_x_boost_zero` : The transformation of the x-component of the electric + field under a boost in the 'x' direction. +- `electricField_apply_x_boost_succ` : The transformation of the other components of the electric + field under a boost in the 'x' direction. +- `magneticFieldMatrix_apply_x_boost_zero_succ` : The transformation of the 'x-components' of the + magnetic field matrix under a boost in the 'x' direction +- `magneticFieldMatrix_apply_x_boost_succ_succ` : The transformation of the other components of the + magnetic field matrix under a boost in the 'x' direction. ## iii. Table of contents - A. Boost of the electric field + - A.1. Boost of the x-component of the electric field + - A.2. Boost of other components of the electric field - B. Boost of the magnetic field + - B.1. Boost of the 'x-components' of the magnetic field matrix + - B.2. Boost of the other components of the magnetic field matrix ## iv. References @@ -42,109 +50,46 @@ open LorentzGroup ## A. Boost of the electric field -The electric field `E` in a frame `F` following a boost in the `x` direction with speed `β` -with `|β| < 1` compared to a frame `F'` at a point `x := (t, x, y, z)` is related to the -electric `E'` and magnetic fields `B'` in `F'` at the point -`x' := (γ (t + β x), γ (x + β t), y, z)` -(corresponding to the same space-time point) by: +-/ + +/-! -- `E_x x = E'_x x'`, -- `E_y x = γ (E'_y x' - β B_z x')`, -- `E_z x = γ (E'_z x' + β B_y x')`. +### A.1. Boost of the x-component of the electric field -/ - -lemma electricField_apply_x_boost (β : ℝ) (hβ : |β| < 1) - (A : ElectromagneticPotential) (hA : Differentiable ℝ A) (t : Time) (x : Space) : - let Λ := LorentzGroup.boost (d := 3) 0 β hβ - let t' : Time := γ β * (t.val + β * x 0) - let x' : Space := fun | 0 => γ β * (x 0 + β * t.val) | 1 => x 1 | 2 => x 2 - electricField (fun x => Λ • A (Λ⁻¹ • x)) t x = - fun | 0 => A.electricField t' x' 0 - | 1 => γ β * (A.electricField t' x' 1 - β * A.magneticField t' x' 2) - | 2 => γ β * (A.electricField t' x' 2 + β * A.magneticField t' x' 1) := by +lemma electricField_apply_x_boost_zero {d : ℕ} {c : SpeedOfLight} (β : ℝ) (hβ : |β| < 1) + (A : ElectromagneticPotential d.succ) (hA : Differentiable ℝ A) (t : Time) (x : Space d.succ) : + let Λ := LorentzGroup.boost (d := d.succ) 0 β hβ + let t' : Time := γ β * (t.val + β /c * x 0) + let x' : Space d.succ := ⟨fun + | 0 => γ β * (x 0 + c * β * t.val) + | ⟨Nat.succ n, ih⟩ => x ⟨Nat.succ n, ih⟩⟩ + electricField c (fun x => Λ • A (Λ⁻¹ • x)) t x 0 = + A.electricField c t' x' 0 := by dsimp - let t' : Time := γ β * (t.val + β * x 0) - let x' : Space := fun | 0 => γ β * (x 0 + β * t.val) | 1 => x 1 | 2 => x 2 - have t_trans : (SpaceTime.toTimeAndSpace ((boost (d := 3) 0 β hβ)⁻¹ • - SpaceTime.toTimeAndSpace.symm (t, x))).1 = t' := by - rw [boost_inverse, SpaceTime.boost_x_smul] - simp [SpaceTime.toTimeAndSpace, SpaceTime.time, Lorentz.Vector.timeComponent] - rfl - have x_trans : (SpaceTime.toTimeAndSpace ((boost (d := 3) 0 β hβ)⁻¹ • - SpaceTime.toTimeAndSpace.symm (t, x))).2 = x' := by - rw [boost_inverse, SpaceTime.boost_x_smul] - simp [SpaceTime.toTimeAndSpace, SpaceTime.time, Lorentz.Vector.timeComponent] - funext j - fin_cases j <;> simp <;> rfl - let x' : Space := fun | 0 => γ β * (x 0 + β * t.val) | 1 => x 1 | 2 => x 2 - funext i rw [electricField_eq_fieldStrengthMatrix, fieldStrengthMatrix_equivariant] - fin_cases i - · simp [Fin.sum_univ_three] - rw [LorentzGroup.boost_inl_0_inr_other _ (by decide)] - simp only [Fin.isValue, zero_mul, neg_zero, add_zero, zero_add] - rw [LorentzGroup.boost_inl_0_inr_other _ (by decide)] - simp only [Fin.isValue, zero_mul, neg_zero, add_zero, zero_add] - rw [LorentzGroup.boost_inr_inr_other _ (by decide)] - simp only [Fin.isValue, Fin.reduceEq, ↓reduceIte, mul_zero, zero_mul, zero_add, neg_zero] - rw [LorentzGroup.boost_inr_inr_other _ (by decide)] - simp only [Fin.isValue, one_ne_zero, ↓reduceIte, mul_zero, zero_mul, zero_add, neg_zero] - rw [fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime, - fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime] - simp only [Fin.isValue, mul_neg, neg_neg] - trans ((LorentzGroup.γ β) ^ 2 * (1- β^2)) * A.electricField - (SpaceTime.toTimeAndSpace ((LorentzGroup.boost (d := 3) 0 β hβ)⁻¹ • - SpaceTime.toTimeAndSpace.symm (t, x))).1 - (SpaceTime.toTimeAndSpace ((LorentzGroup.boost (d := 3) 0 β hβ)⁻¹ • - SpaceTime.toTimeAndSpace.symm (t, x))).2 0 - · ring - have h1 : ((LorentzGroup.γ β) ^ 2 * (1- β^2)) = 1 := by - rw [LorentzGroup.γ_sq β hβ] - field_simp - rw [h1] - simp only [Fin.isValue, Nat.succ_eq_add_one, Nat.reduceAdd, one_mul] - rw [x_trans, t_trans] - · exact hA - · exact hA - · simp [Fin.sum_univ_three] - rw [LorentzGroup.boost_inr_other_inl_0 _ (by decide), - LorentzGroup.boost_inr_other_inr _ (by decide), - LorentzGroup.boost_inr_other_inr _ (by decide), - LorentzGroup.boost_inr_other_inr _ (by decide), - LorentzGroup.boost_inl_0_inr_other _ (by decide),] - simp only [Fin.isValue, ↓reduceIte, mul_one, zero_mul, neg_zero, one_ne_zero, mul_zero, - add_zero, Fin.reduceEq, zero_add] - rw [fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime, - fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime] - simp only [Fin.isValue, mul_neg, neg_neg] - trans -(γ β * β *A.magneticField t' x' 2) + - γ β * A.electricField t' x' 1 - · rw [x_trans, t_trans] - · ring - · exact hA - · exact hA - · simp [Fin.sum_univ_three] - rw [LorentzGroup.boost_inr_other_inl_0 _ (by decide), - LorentzGroup.boost_inr_other_inr _ (by decide), - LorentzGroup.boost_inr_other_inr _ (by decide), - LorentzGroup.boost_inr_other_inr _ (by decide)] - simp only [Fin.isValue, Fin.reduceEq, ↓reduceIte, mul_zero, zero_mul, neg_zero, add_zero, - mul_one, zero_add] - rw [LorentzGroup.boost_inl_0_inr_other _ (by decide)] - simp only [Fin.isValue, zero_mul, neg_zero, zero_add] - rw [fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime, - fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime] - simp only [Fin.isValue, mul_neg, neg_neg] - trans γ β * β * - A.magneticField t' x' 1 + - γ β * - A.electricField t' x' 2 - · rw [x_trans, t_trans] - · ring - · exact hA - · exact hA - · exact hA + simp [Fintype.sum_sum_type] + rw [Fin.sum_univ_succ, Fin.sum_univ_succ, Fin.sum_univ_succ] + simp only [boost_inr_self_inr_self, Fin.isValue, boost_zero_inr_0_inr_succ, mul_zero, zero_mul, + Finset.sum_const_zero, add_zero, boost_inl_0_inr_self, neg_mul, neg_neg, + fieldStrengthMatrix_diag_eq_zero, boost_zero_inl_0_inr_succ, neg_zero] + rw [electricField_eq_fieldStrengthMatrix] + simp only [Fin.isValue, neg_mul, neg_inj, mul_eq_mul_left_iff, SpeedOfLight.val_ne_zero, or_false] + conv_lhs => + enter [2] + rw [fieldStrengthMatrix_antisymm] + trans γ β ^ 2 * (1 - β ^ 2) * + (A.fieldStrengthMatrix + ((boost (d := d.succ) 0 β hβ)⁻¹ • (SpaceTime.toTimeAndSpace c).symm (t, x))) + (Sum.inl 0, Sum.inr 0) + · ring + rw [γ_sq β hβ] + field_simp + rw [SpaceTime.boost_zero_apply_time_space] + field_simp + rfl + exact hA + exact hA · apply Differentiable.comp · change Differentiable ℝ (Lorentz.Vector.actionCLM (boost 0 β hβ)) exact ContinuousLinearMap.differentiable (Lorentz.Vector.actionCLM (boost 0 β hβ)) @@ -154,104 +99,106 @@ lemma electricField_apply_x_boost (β : ℝ) (hβ : |β| < 1) /-! -## B. Boost of the magnetic field - -The magnetic field `B` in a frame `F` following a boost in the `x` direction with speed `β` -with `|β| < 1` compared to a frame `F'` at a point `x := (t, x, y, z)` is related to the -electric `E'` and magnetic fields `B'` in `F'` at the point -`x' := (γ (t + β x), γ (x + β t), y, z)` -(corresponding to the same space-time point) by: - -- `B_x x = B'_x x'`, -- `B_y x = γ (B'_y x' + β E_z x')`, -- `B_z x = γ (B'_z x' - β E_y x')`. +### A.2. Boost of other components of the electric field -/ -lemma magneticField_apply_x_boost (β : ℝ) (hβ : |β| < 1) - (A : ElectromagneticPotential) (hA : Differentiable ℝ A) (t : Time) (x : Space) : - let Λ := LorentzGroup.boost (d := 3) 0 β hβ - let t' : Time := γ β * (t.val + β * x 0) - let x' : Space := fun | 0 => γ β * (x 0 + β * t.val) | 1 => x 1 | 2 => x 2 - magneticField (fun x => Λ • A (Λ⁻¹ • x)) t x = - fun | 0 => A.magneticField t' x' 0 - | 1 => γ β * (A.magneticField t' x' 1 + β * A.electricField t' x' 2) - | 2 => γ β * (A.magneticField t' x' 2 - β * A.electricField t' x' 1) := by +lemma electricField_apply_x_boost_succ {d : ℕ} {c : SpeedOfLight} (β : ℝ) (hβ : |β| < 1) + (A : ElectromagneticPotential d.succ) (hA : Differentiable ℝ A) (t : Time) (x : Space d.succ) + (i : Fin d) : + let Λ := LorentzGroup.boost (d := d.succ) 0 β hβ + let t' : Time := γ β * (t.val + β /c * x 0) + let x' : Space d.succ := ⟨fun + | 0 => γ β * (x 0 + c * β * t.val) + | ⟨Nat.succ n, ih⟩ => x ⟨Nat.succ n, ih⟩⟩ + electricField c (fun x => Λ • A (Λ⁻¹ • x)) t x i.succ = + γ β * (A.electricField c t' x' i.succ + c * β * A.magneticFieldMatrix c t' x' (0, i.succ)) := by dsimp - let t' : Time := γ β * (t.val + β * x 0) - let x' : Space := fun | 0 => γ β * (x 0 + β * t.val) | 1 => x 1 | 2 => x 2 - have t_trans : (SpaceTime.toTimeAndSpace - ((boost (d := 3) 0 β hβ)⁻¹ • SpaceTime.toTimeAndSpace.symm (t, x))).1 = t' := by - rw [boost_inverse, SpaceTime.boost_x_smul] - simp [SpaceTime.toTimeAndSpace, SpaceTime.time, Lorentz.Vector.timeComponent] - rfl - have x_trans : (SpaceTime.toTimeAndSpace ((boost (d := 3) 0 β hβ)⁻¹ • - SpaceTime.toTimeAndSpace.symm (t, x))).2 = x' := by - rw [boost_inverse, SpaceTime.boost_x_smul] - simp [SpaceTime.toTimeAndSpace, SpaceTime.time, Lorentz.Vector.timeComponent] - funext j - fin_cases j <;> simp <;> rfl - have h_diff : Differentiable ℝ fun x => - boost (d := 3) 0 β hβ • A ((boost (d := 3) 0 β hβ)⁻¹ • x) := by - apply Differentiable.comp + rw [electricField_eq_fieldStrengthMatrix, + fieldStrengthMatrix_equivariant _ _ hA] + simp [Fintype.sum_sum_type] + rw [Fin.sum_univ_succ, Fin.sum_univ_succ, Fin.sum_univ_succ] + simp [boost_zero_inr_succ_inr_succ] + rw [fieldStrengthMatrix_inl_inr_eq_electricField (c := c)] + rw [fieldStrengthMatrix_inr_inr_eq_magneticFieldMatrix (c := c)] + rw [SpaceTime.boost_zero_apply_time_space] + simp only [one_div, Nat.succ_eq_add_one, SpaceTime.time_toTimeAndSpace_symm, + SpaceTime.space_toTimeAndSpace_symm, neg_mul, mul_neg] + field_simp + ring_nf + field_simp + rfl + exact hA + · apply Differentiable.comp · change Differentiable ℝ (Lorentz.Vector.actionCLM (boost 0 β hβ)) exact ContinuousLinearMap.differentiable (Lorentz.Vector.actionCLM (boost 0 β hβ)) · apply Differentiable.comp · exact hA · exact ContinuousLinearMap.differentiable (Lorentz.Vector.actionCLM (boost 0 β hβ)⁻¹) - let x' : Space := fun | 0 => γ β * (x 0 + β * t.val) | 1 => x 1 | 2 => x 2 - funext i - fin_cases i - · dsimp - conv_lhs => rw [magneticField_fst_eq_fieldStrengthMatrix _ _ _ h_diff, - fieldStrengthMatrix_equivariant _ _ hA] - simp [Fin.sum_univ_three] - rw [LorentzGroup.boost_inr_inr_other _ (by decide)] - simp only [Fin.isValue, Fin.reduceEq, ↓reduceIte, zero_mul, neg_zero, add_zero, zero_add] - rw [LorentzGroup.boost_inr_inr_other _ (by decide)] - simp only [Fin.isValue, ↓reduceIte, one_mul] - rw [LorentzGroup.boost_inr_inr_other _ (by decide)] - simp only [Fin.isValue, ↓reduceIte, one_mul, mul_one] - repeat rw [LorentzGroup.boost_inr_other_inr_self _ (by decide)] - repeat rw [LorentzGroup.boost_inr_other_inl_0 _ (by decide)] - simp only [Fin.isValue, zero_mul, neg_zero, add_zero, mul_zero] - rw [fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime] - simp only [Fin.isValue, neg_neg] - rw [t_trans, x_trans] - · exact hA - · dsimp - conv_lhs => rw [magneticField_snd_eq_fieldStrengthMatrix _ _ _ h_diff, - fieldStrengthMatrix_equivariant _ _ hA] - simp [Fin.sum_univ_three] - repeat rw [LorentzGroup.boost_inr_other_inl_0 _ (by decide)] - repeat rw [LorentzGroup.boost_inr_other_inr_self _ (by decide)] - repeat rw [LorentzGroup.boost_inr_other_inr _ (by decide)] - repeat rw [LorentzGroup.boost_inr_self_inr_other _ (by decide)] - simp only [mul_zero, Fin.isValue, zero_mul, neg_zero, Fin.reduceEq, ↓reduceIte, add_zero, - mul_one, zero_add] - rw [fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime _ _ hA, - fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime _ _ hA] - simp only [Fin.isValue, mul_neg, neg_neg] - trans (γ β * β * A.electricField t' x' 2) + γ β * A.magneticField t' x' 1 - · rw [x_trans, t_trans] - · ring - · dsimp - conv_lhs => rw [magneticField_thd_eq_fieldStrengthMatrix _ _ _ h_diff, - fieldStrengthMatrix_equivariant _ _ hA] - simp [Fin.sum_univ_three] - repeat rw [LorentzGroup.boost_inr_other_inl_0 _ (by decide)] - repeat rw [LorentzGroup.boost_inr_other_inr_self _ (by decide)] - repeat rw [LorentzGroup.boost_inr_self_inr_other _ (by decide)] - repeat rw [LorentzGroup.boost_inr_inr_other _ (by decide)] - simp only [Fin.isValue, ↓reduceIte, mul_one, zero_mul, neg_zero, mul_zero, add_zero, - Fin.reduceEq, zero_add] - rw [fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime _ _ hA, - fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime _ _ hA] - simp only [Fin.isValue, mul_neg, neg_neg] - trans γ β * A.magneticField t' x' 2 - γ β * β * A.electricField t' x' 1 - · rw [x_trans, t_trans] - ring - · ring + +/-! + +## B. Boost of the magnetic field + +-/ + +/-! + +### B.1. Boost of the 'x-components' of the magnetic field matrix + +-/ + +lemma magneticFieldMatrix_apply_x_boost_zero_succ {d : ℕ} {c : SpeedOfLight} (β : ℝ) (hβ : |β| < 1) + (A : ElectromagneticPotential d.succ) (hA : Differentiable ℝ A) (t : Time) (x : Space d.succ) + (i : Fin d) : + let Λ := LorentzGroup.boost (d := d.succ) 0 β hβ + let t' : Time := γ β * (t.val + β /c * x 0) + let x' : Space d.succ := ⟨fun + | 0 => γ β * (x 0 + c * β * t.val) + | ⟨Nat.succ n, ih⟩ => x ⟨Nat.succ n, ih⟩⟩ + magneticFieldMatrix c (fun x => Λ • A (Λ⁻¹ • x)) t x (0, i.succ) = + γ β * (A.magneticFieldMatrix c t' x' (0, i.succ) + β / c * A.electricField c t' x' i.succ) := by + dsimp + rw [magneticFieldMatrix_eq] + simp only + rw [fieldStrengthMatrix_equivariant _ _ hA] + simp [Fintype.sum_sum_type] + rw [Fin.sum_univ_succ, Fin.sum_univ_succ, Fin.sum_univ_succ] + simp [boost_zero_inr_succ_inr_succ] + rw [fieldStrengthMatrix_inl_inr_eq_electricField (c := c)] + rw [fieldStrengthMatrix_inr_inr_eq_magneticFieldMatrix (c := c)] + simp only [one_div, neg_mul, mul_neg, neg_neg] + rw [SpaceTime.boost_zero_apply_time_space] + simp only [Nat.succ_eq_add_one, SpaceTime.time_toTimeAndSpace_symm, + SpaceTime.space_toTimeAndSpace_symm] + field_simp + ring_nf + rfl + exact hA + +/-! + +### B.2. Boost of the other components of the magnetic field matrix + +-/ + +lemma magneticFieldMatrix_apply_x_boost_succ_succ {d : ℕ} {c : SpeedOfLight} (β : ℝ) (hβ : |β| < 1) + (A : ElectromagneticPotential d.succ) (hA : Differentiable ℝ A) (t : Time) (x : Space d.succ) + (i j : Fin d) : + let Λ := LorentzGroup.boost (d := d.succ) 0 β hβ + let t' : Time := γ β * (t.val + β /c * x 0) + let x' : Space d.succ := ⟨fun + | 0 => γ β * (x 0 + c * β * t.val) + | ⟨Nat.succ n, ih⟩ => x ⟨Nat.succ n, ih⟩⟩ + magneticFieldMatrix c (fun x => Λ • A (Λ⁻¹ • x)) t x (i.succ, j.succ) = + A.magneticFieldMatrix c t' x' (i.succ, j.succ) := by + dsimp + rw [magneticFieldMatrix_eq] + simp only + rw [fieldStrengthMatrix_equivariant _ _ hA] + simp [Fintype.sum_sum_type, boost_zero_inr_succ_inr_succ, Fin.sum_univ_succ] + rw [SpaceTime.boost_zero_apply_time_space] + rfl end ElectromagneticPotential end Electromagnetism diff --git a/PhysLean/Electromagnetism/Kinematics/EMPotential.lean b/PhysLean/Electromagnetism/Kinematics/EMPotential.lean index 212696751..f76046a36 100644 --- a/PhysLean/Electromagnetism/Kinematics/EMPotential.lean +++ b/PhysLean/Electromagnetism/Kinematics/EMPotential.lean @@ -5,7 +5,6 @@ Authors: Joseph Tooby-Smith -/ import PhysLean.Electromagnetism.Basic import PhysLean.SpaceAndTime.SpaceTime.TimeSlice -import PhysLean.Relativity.Tensors.RealTensor.CoVector.Basic import PhysLean.Mathematics.VariationalCalculus.HasVarGradient /-! @@ -22,8 +21,9 @@ spacetime to contravariant Lorentz vectors. ## ii. Key results -- `ElectromagneticPotential`: is the type of electromagnetic potentials. -- `ElectromagneticPotential.deriv`: the derivative tensor `∂_μ A^ν`. +- `ElectromagneticPotential` : is the type of electromagnetic potentials. +- `ElectromagneticPotential.deriv` : the derivative tensor `∂_μ A^ν`. +- `DistElectromagneticPotential` : the type of electromagnetic potentials as distributions. ## iii. Table of contents @@ -35,6 +35,10 @@ spacetime to contravariant Lorentz vectors. - B. The derivative tensor of the electromagnetic potential - B.1. Equivariance of the derivative tensor - B.2. The elements of the derivative tensor in terms of the basis +- C. The electromagnetic potential as a distribution + - C.1. The derivative of the electromagnetic potential as a distribution + - C.2. The derivative in terms of the basis + - C.3. Equivariance of the derivative distribution ## iv. References @@ -88,20 +92,19 @@ lemma spaceTime_deriv_action_eq_sum {d} {μ ν : Fin 1 ⊕ Fin d} {x : SpaceTime calc _ _ = ((Λ • (∂_ μ (fun x => A (Λ⁻¹ • x)) x)) ν) := by have hdif : ∀ i, DifferentiableAt ℝ (fun x => A (Λ⁻¹ • x) i) x := by - rw [← differentiableAt_pi] + intro i + apply Differentiable.differentiableAt + revert i + rw [SpaceTime.differentiable_vector] conv => enter [2, x]; rw [← Lorentz.Vector.actionCLM_apply] - apply Differentiable.differentiableAt - apply Differentiable.comp hA + apply Differentiable.fun_comp hA exact ContinuousLinearMap.differentiable (Lorentz.Vector.actionCLM Λ⁻¹) trans ∂_ μ (fun x => (Λ • A (Λ⁻¹ • x)) ν) x - · rw [SpaceTime.deriv_eq, SpaceTime.deriv_eq] - rw [fderiv_pi] - rfl - rw [← differentiableAt_pi] + · rw [SpaceTime.deriv_eq, SpaceTime.deriv_eq, SpaceTime.fderiv_vector] + intro ν conv => enter [2, x]; rw [← Lorentz.Vector.actionCLM_apply, ← Lorentz.Vector.actionCLM_apply] - apply Differentiable.differentiableAt apply Differentiable.comp · exact ContinuousLinearMap.differentiable (Lorentz.Vector.actionCLM Λ) · apply Differentiable.comp @@ -121,9 +124,8 @@ lemma spaceTime_deriv_action_eq_sum {d} {μ ν : Fin 1 ⊕ Fin d} {x : SpaceTime congr funext κ congr - rw [SpaceTime.deriv_eq, fderiv_pi] - rfl - · exact fun i => hdif i + rw [SpaceTime.deriv_eq, SpaceTime.fderiv_vector] + · exact hA.comp (Lorentz.Vector.actionCLM Λ⁻¹).differentiable · intro i _ apply DifferentiableAt.const_mul exact hdif i @@ -154,7 +156,7 @@ lemma differentiable_component {d : ℕ} (A : ElectromagneticPotential d) (hA : Differentiable ℝ A) (μ : Fin 1 ⊕ Fin d) : Differentiable ℝ (fun x => A x μ) := by revert μ - rw [← differentiable_pi] + rw [SpaceTime.differentiable_vector] exact hA /-! @@ -167,10 +169,6 @@ and derive the equations of motion. -/ -/-- A local instance of the inner product structure on `SpaceTime`. -/ -noncomputable local instance {d : ℕ}: InnerProductSpace ℝ (SpaceTime d) := - SpaceTime.innerProductSpace d - open ContDiff lemma hasVarAdjDerivAt_component {d : ℕ} (μ : Fin 1 ⊕ Fin d) (A : SpaceTime d → Lorentz.Vector d) (hA : ContDiff ℝ ∞ A) : @@ -189,11 +187,8 @@ lemma hasVarAdjDerivAt_component {d : ℕ} (μ : Fin 1 ⊕ Fin d) (A : SpaceTime refine { adjoint_inner_left := ?_ } intro u v simp [f,f'] - rw [PiLp.inner_apply] - simp only [Lorentz.Vector.apply_smul, Lorentz.Vector.basis_apply, mul_ite, mul_one, mul_zero, - RCLike.inner_apply, conj_trivial, Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte, - mul_eq_mul_right_iff] - left + simp [inner_smul_left, Lorentz.Vector.basis_inner] + ring_nf rfl /-! @@ -358,4 +353,108 @@ lemma toTensor_deriv_basis_repr_apply {d} (A : ElectromagneticPotential d) end ElectromagneticPotential +/-! + +## C. The electromagnetic potential as a distribution + +-/ + +/-- The electromagnetic potential as a distribution and as a tensor `A^μ`. -/ +noncomputable abbrev DistElectromagneticPotential (d : ℕ := 3) := + (SpaceTime d) →d[ℝ] Lorentz.Vector d + +namespace DistElectromagneticPotential +open TensorSpecies +open Tensor +open SpaceTime +open TensorProduct +open minkowskiMatrix SchwartzMap +attribute [-simp] Fintype.sum_sum_type +attribute [-simp] Nat.succ_eq_add_one + +/-! + +### C.1. The derivative of the electromagnetic potential as a distribution + +-/ + +/-- The derivative of a electromagnetic potential, which is a distribution. -/ +noncomputable def deriv {d} : DistElectromagneticPotential d →ₗ[ℝ] + (SpaceTime d) →d[ℝ] Lorentz.CoVector d ⊗[ℝ] Lorentz.Vector d := distTensorDeriv + +lemma deriv_eq_sum_sum {d} (A : DistElectromagneticPotential d) + (ε : 𝓢(SpaceTime d, ℝ)) : + deriv A ε =∑ μ, ∑ ν, (SpaceTime.distDeriv μ A ε ν) • + Lorentz.CoVector.basis μ ⊗ₜ[ℝ] Lorentz.Vector.basis ν := by + simp [deriv, distTensorDeriv_apply] + congr + funext μ + conv_lhs => rw [← Lorentz.Vector.basis.sum_repr (SpaceTime.distDeriv μ A ε)] + rw [tmul_sum] + congr + funext ν + simp + rfl +/-! + +### C.2. The derivative in terms of the basis + +-/ + +@[simp] +lemma deriv_basis_repr_apply {d} {μν : (Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d)} + (A : DistElectromagneticPotential d) + (ε : 𝓢(SpaceTime d, ℝ)) : + (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr (deriv A ε) μν = + distDeriv μν.1 A ε μν.2 := by + match μν with + | (μ, ν) => + rw [deriv_eq_sum_sum] + simp only [map_sum, map_smul, Finsupp.coe_finset_sum, Finsupp.coe_smul, Finset.sum_apply, + Pi.smul_apply, Basis.tensorProduct_repr_tmul_apply, Basis.repr_self, smul_eq_mul] + rw [Finset.sum_eq_single μ, Finset.sum_eq_single ν] + · simp + · intro μ' _ h + simp [h] + · simp + · intro ν' _ h + simp [h] + · simp + +lemma toTensor_deriv_basis_repr_apply {d} (A : DistElectromagneticPotential d) + (ε : 𝓢(SpaceTime d, ℝ)) (b : ComponentIdx (S := realLorentzTensor d) + (Fin.append ![Color.down] ![Color.up])) : + (Tensor.basis _).repr (Tensorial.toTensor (deriv A ε)) b = + distDeriv (finSumFinEquiv.symm (b 0)) A ε (finSumFinEquiv.symm (b 1)) := by + rw [Tensorial.basis_toTensor_apply] + rw [Tensorial.basis_map_prod] + simp only [Nat.reduceSucc, Nat.reduceAdd, Basis.repr_reindex, Finsupp.mapDomain_equiv_apply, + Equiv.symm_symm, Fin.isValue] + rw [Lorentz.Vector.tensor_basis_map_eq_basis_reindex, + Lorentz.CoVector.tensor_basis_map_eq_basis_reindex] + have hb : (((Lorentz.CoVector.basis (d := d)).reindex + Lorentz.CoVector.indexEquiv.symm).tensorProduct + (Lorentz.Vector.basis.reindex Lorentz.Vector.indexEquiv.symm)) = + ((Lorentz.CoVector.basis (d := d)).tensorProduct (Lorentz.Vector.basis (d := d))).reindex + (Lorentz.CoVector.indexEquiv.symm.prodCongr Lorentz.Vector.indexEquiv.symm) := by + ext b + match b with + | ⟨i, j⟩ => + simp + rw [hb] + rw [Module.Basis.repr_reindex_apply, deriv_basis_repr_apply] + rfl + +/-! + +### C.3. Equivariance of the derivative distribution + +-/ + +lemma deriv_equivariant {d} {A : DistElectromagneticPotential d} + (Λ : LorentzGroup d) : deriv (Λ • A) = Λ • deriv A := by + rw [deriv, distTensorDeriv_equivariant] + +end DistElectromagneticPotential + end Electromagnetism diff --git a/PhysLean/Electromagnetism/Kinematics/ElectricField.lean b/PhysLean/Electromagnetism/Kinematics/ElectricField.lean index 420d9f5a6..9a9024a88 100644 --- a/PhysLean/Electromagnetism/Kinematics/ElectricField.lean +++ b/PhysLean/Electromagnetism/Kinematics/ElectricField.lean @@ -6,9 +6,6 @@ Authors: Joseph Tooby-Smith import PhysLean.Electromagnetism.Kinematics.VectorPotential import PhysLean.Electromagnetism.Kinematics.ScalarPotential import PhysLean.Electromagnetism.Kinematics.FieldStrength -import PhysLean.SpaceAndTime.SpaceTime.TimeSlice -import PhysLean.Relativity.Tensors.RealTensor.CoVector.Basic -import PhysLean.Mathematics.VariationalCalculus.HasVarGradient /-! # The Electric Field @@ -25,6 +22,8 @@ In this module we define the electric field, and prove lemmas about it. - `electricField` : The electric field from the electromagnetic potential. - `electricField_eq_fieldStrengthMatrix` : The electric field expressed in terms of the field strength tensor. +- `DistElectromagneticPotential.electricField` : The electric field for + electromagnetic potentials which are distributions. ## iii. Table of contents @@ -33,6 +32,8 @@ In this module we define the electric field, and prove lemmas about it. - C. Smoothness of the electric field - D. Differentiability of the electric field - E. Time derivative of the vector potential in terms of the electric field +- F. Derivatives of the electric field in terms of field strength tensor +- G. Electric field for distributions ## iv. References @@ -62,104 +63,143 @@ open Space Time -/ /-- The electric field from the electromagnetic potential. -/ -noncomputable def electricField {d} (A : ElectromagneticPotential d) : ElectricField d := - fun t x => - ∇ (A.scalarPotential t) x - ∂ₜ (fun t => A.vectorPotential t x) t +noncomputable def electricField {d} (c : SpeedOfLight := 1) + (A : ElectromagneticPotential d) : ElectricField d := + fun t x => - ∇ (A.scalarPotential c t) x - ∂ₜ (fun t => A.vectorPotential c t x) t -lemma electricField_eq (A : ElectromagneticPotential d) : - A.electricField = fun t x => - - ∇ (A.scalarPotential t) x - ∂ₜ (fun t => A.vectorPotential t x) t := rfl +lemma electricField_eq {c : SpeedOfLight} (A : ElectromagneticPotential d) : + A.electricField c = fun t x => + - ∇ (A.scalarPotential c t) x - ∂ₜ (fun t => A.vectorPotential c t x) t := rfl /-! ## B. Relation to the field strength tensor +The electric field can be expressed in terms of the field strength tensor as +`E_i = - c * F_0^i`. -/ -lemma electricField_eq_fieldStrengthMatrix (A : ElectromagneticPotential d) (t : Time) +lemma electricField_eq_fieldStrengthMatrix {c : SpeedOfLight} + (A : ElectromagneticPotential d) (t : Time) (x : Space d) (i : Fin d) (hA : Differentiable ℝ A) : - A.electricField t x i = - - A.fieldStrengthMatrix (SpaceTime.toTimeAndSpace.symm (t, x)) (Sum.inl 0, Sum.inr i) := by + A.electricField c t x i = - + c * A.fieldStrengthMatrix ((toTimeAndSpace c).symm (t, x)) (Sum.inl 0, Sum.inr i) := by rw [toFieldStrength_basis_repr_apply_eq_single] - simp only [Fin.isValue, inl_0_inl_0, one_mul, inr_i_inr_i, neg_mul, sub_neg_eq_add, neg_add_rev] + simp only [Fin.isValue, inl_0_inl_0, one_mul, inr_i_inr_i, neg_mul, sub_neg_eq_add] rw [electricField] - simp only [PiLp.sub_apply, PiLp.neg_apply, Fin.isValue] + simp only [PiLp.sub_apply, PiLp.neg_apply, Fin.isValue, mul_add, neg_add_rev] congr - · rw [Space.grad_apply] - trans ∂_ (Sum.inr i) (fun x => A x (Sum.inl 0)) (toTimeAndSpace.symm (t, x)); swap + · simp only [grad_apply, Fin.isValue] + trans c * ∂_ (Sum.inr i) (fun x => A x (Sum.inl 0)) ((toTimeAndSpace c).symm (t, x)); swap · rw [SpaceTime.deriv_eq, SpaceTime.deriv_eq] - rw [fderiv_pi] - rfl - · exact fun μ => (differentiable_component A hA μ).differentiableAt - · rw [SpaceTime.deriv_sum_inr] - simp - rfl + rw [Lorentz.Vector.fderiv_apply] + exact hA + · rw [SpaceTime.deriv_sum_inr c] + simp [scalarPotential] + change Space.deriv i (fun y => c * A ((toTimeAndSpace c).symm (t, y)) (Sum.inl 0)) x = _ + rw [Space.deriv_eq_fderiv_basis, fderiv_const_mul] + simp [← Space.deriv_eq_fderiv_basis] + · apply Differentiable.differentiableAt + have h1 := (differentiable_component A hA (Sum.inl 0)) + apply Differentiable.comp h1 + refine Differentiable.fun_comp ?_ ?_ + · exact ContinuousLinearEquiv.differentiable (toTimeAndSpace c).symm + · fun_prop · exact fun μ => (differentiable_component A hA _).differentiableAt - · rw [SpaceTime.deriv_sum_inl] + · exact 2 + · rw [SpaceTime.deriv_sum_inl c] simp only [ContinuousLinearEquiv.apply_symm_apply] rw [Time.deriv_eq, Time.deriv_eq] rw [vectorPotential] simp [timeSlice] - rw [fderiv_pi, fderiv_pi] - rfl - · intro μ + rw [Lorentz.Vector.fderiv_apply] + change ((fderiv ℝ (fun t => WithLp.toLp 2 fun i => + A ((toTimeAndSpace c).symm (t, x)) (Sum.inr i)) t) 1).ofLp i = _ + rw [← Time.fderiv_euclid] + · apply Time.differentiable_euclid + intro i + simp only + generalize (Sum.inr i) = j + revert j + rw [Lorentz.Vector.differentiable_apply] + intro μ apply Differentiable.differentiableAt - have h1 := (differentiable_component A hA μ) - apply Differentiable.comp h1 refine Differentiable.fun_comp ?_ ?_ - · exact ContinuousLinearEquiv.differentiable toTimeAndSpace.symm + · exact hA + refine Differentiable.fun_comp ?_ ?_ + · exact ContinuousLinearEquiv.differentiable (toTimeAndSpace c).symm · fun_prop · intro μ apply Differentiable.differentiableAt - have h1 := (differentiable_component A hA (Sum.inr μ)) - apply Differentiable.comp h1 + refine Differentiable.fun_comp hA ?_ refine Differentiable.fun_comp ?_ ?_ - · exact ContinuousLinearEquiv.differentiable toTimeAndSpace.symm + · exact ContinuousLinearEquiv.differentiable (toTimeAndSpace c).symm · fun_prop · exact hA + · exact 1 + +lemma fieldStrengthMatrix_inl_inr_eq_electricField {c : SpeedOfLight} + (A : ElectromagneticPotential d) + (x : SpaceTime d) (i : Fin d) (hA : Differentiable ℝ A) : + A.fieldStrengthMatrix x (Sum.inl 0, Sum.inr i) = + - (1 /c) * A.electricField c (x.time c) x.space i := by + rw [electricField_eq_fieldStrengthMatrix A (x.time c) x.space i hA] + simp +lemma fieldStrengthMatrix_inr_inl_eq_electricField {c : SpeedOfLight} + (A : ElectromagneticPotential d) + (x : SpaceTime d) (i : Fin d) (hA : Differentiable ℝ A) : + A.fieldStrengthMatrix x (Sum.inr i, Sum.inl 0) = + (1 /c) * A.electricField c (x.time c) x.space i := by + rw [electricField_eq_fieldStrengthMatrix A (x.time c) x.space i hA] + simp only [Fin.isValue, one_div, toTimeAndSpace_symm_apply_time_space, neg_mul, mul_neg, ne_eq, + SpeedOfLight.val_ne_zero, not_false_eq_true, inv_mul_cancel_left₀] + rw [fieldStrengthMatrix_antisymm A x (Sum.inr i) (Sum.inl 0)] /-! ## C. Smoothness of the electric field -/ -lemma electricField_contDiff {n} {A : ElectromagneticPotential d} - (hA : ContDiff ℝ (n + 1) A) : ContDiff ℝ n (↿A.electricField) := by +lemma electricField_contDiff {n} {c : SpeedOfLight} {A : ElectromagneticPotential d} + (hA : ContDiff ℝ (n + 1) A) : ContDiff ℝ n ↿(A.electricField c) := by rw [@contDiff_euclidean] intro i conv => enter [3, x]; - change A.electricField x.1 x.2 i + change A.electricField c x.1 x.2 i rw [electricField_eq_fieldStrengthMatrix (A) x.1 x.2 i (hA.differentiable (by simp))] - change - A.fieldStrengthMatrix (toTimeAndSpace.symm (x.1, x.2)) (Sum.inl 0, Sum.inr i) - apply ContDiff.neg + change - c * A.fieldStrengthMatrix ((toTimeAndSpace c).symm (x.1, x.2)) (Sum.inl 0, Sum.inr i) + apply ContDiff.mul + · fun_prop change ContDiff ℝ n ((fun x => A.fieldStrengthMatrix x (Sum.inl 0, Sum.inr i)) - ∘ (toTimeAndSpace (d := d)).symm) + ∘ (toTimeAndSpace c (d := d)).symm) refine ContDiff.comp ?_ ?_ - · exact fieldStrengthMatrix_contDiff (hA) - · exact ContinuousLinearEquiv.contDiff toTimeAndSpace.symm + · exact fieldStrengthMatrix_contDiff hA + · exact ContinuousLinearEquiv.contDiff (toTimeAndSpace c).symm -lemma electricField_apply_contDiff {n} {A : ElectromagneticPotential d} - (hA : ContDiff ℝ (n + 1) A) : ContDiff ℝ n (↿(fun t x => A.electricField t x i)) := by - change ContDiff ℝ n (EuclideanSpace.proj i ∘ ↿A.electricField) +lemma electricField_apply_contDiff {n} {c : SpeedOfLight} {A : ElectromagneticPotential d} + (hA : ContDiff ℝ (n + 1) A) : ContDiff ℝ n (↿(fun t x => A.electricField c t x i)) := by + change ContDiff ℝ n (EuclideanSpace.proj i ∘ ↿(A.electricField c)) refine ContDiff.comp ?_ ?_ · exact ContinuousLinearMap.contDiff (𝕜 := ℝ) _ · exact electricField_contDiff hA lemma electricField_apply_contDiff_space {n} {A : ElectromagneticPotential d} + {c : SpeedOfLight} (hA : ContDiff ℝ (n + 1) A) (t : Time) : - ContDiff ℝ n (fun x => A.electricField t x i) := by - change ContDiff ℝ n (EuclideanSpace.proj i ∘ (↿A.electricField ∘ fun x => (t, x))) + ContDiff ℝ n (fun x => A.electricField c t x i) := by + change ContDiff ℝ n (EuclideanSpace.proj i ∘ (↿(A.electricField c) ∘ fun x => (t, x))) refine ContDiff.comp ?_ ?_ · exact ContinuousLinearMap.contDiff (𝕜 := ℝ) _ · refine ContDiff.comp ?_ ?_ · exact electricField_contDiff hA · fun_prop -lemma electricField_apply_contDiff_time {n} {A : ElectromagneticPotential d} +lemma electricField_apply_contDiff_time {n} {c : SpeedOfLight} {A : ElectromagneticPotential d} (hA : ContDiff ℝ (n + 1) A) (x : Space d) : - ContDiff ℝ n (fun t => A.electricField t x i) := by - change ContDiff ℝ n (EuclideanSpace.proj i ∘ (↿A.electricField ∘ fun t => (t, x))) + ContDiff ℝ n (fun t => A.electricField c t x i) := by + change ContDiff ℝ n (EuclideanSpace.proj i ∘ (↿(A.electricField c) ∘ fun t => (t, x))) refine ContDiff.comp ?_ ?_ · exact ContinuousLinearMap.contDiff (𝕜 := ℝ) _ · refine ContDiff.comp ?_ ?_ @@ -172,67 +212,195 @@ lemma electricField_apply_contDiff_time {n} {A : ElectromagneticPotential d} -/ -lemma electricField_differentiable {A : ElectromagneticPotential d} - (hA : ContDiff ℝ 2 A) : Differentiable ℝ (↿A.electricField) := by - rw [differentiable_pi] +lemma electricField_differentiable {A : ElectromagneticPotential d} {c : SpeedOfLight} + (hA : ContDiff ℝ 2 A) : Differentiable ℝ (↿(A.electricField c)) := by + rw [differentiable_euclidean] intro i conv => enter [2, x]; - change A.electricField x.1 x.2 i + change A.electricField c x.1 x.2 i rw [electricField_eq_fieldStrengthMatrix (A) x.1 x.2 i (hA.differentiable (by simp))] - change - A.fieldStrengthMatrix (toTimeAndSpace.symm (x.1, x.2)) (Sum.inl 0, Sum.inr i) - apply Differentiable.neg + change - c * A.fieldStrengthMatrix ((toTimeAndSpace c).symm (x.1, x.2)) (Sum.inl 0, Sum.inr i) + apply Differentiable.mul + · fun_prop change Differentiable ℝ ((fun x => A.fieldStrengthMatrix x (Sum.inl 0, Sum.inr i)) - ∘ (toTimeAndSpace (d := d)).symm) + ∘ (toTimeAndSpace c (d := d)).symm) refine Differentiable.comp ?_ ?_ · exact fieldStrengthMatrix_differentiable (hA) - · exact ContinuousLinearEquiv.differentiable toTimeAndSpace.symm + · exact ContinuousLinearEquiv.differentiable (toTimeAndSpace c).symm -lemma electricField_differentiable_time {A : ElectromagneticPotential d} - (hA : ContDiff ℝ 2 A) (x : Space d) : Differentiable ℝ (A.electricField · x) := by - change Differentiable ℝ (↿A.electricField ∘ fun t => (t, x)) +lemma electricField_differentiable_time {A : ElectromagneticPotential d} {c : SpeedOfLight} + (hA : ContDiff ℝ 2 A) (x : Space d) : Differentiable ℝ (A.electricField c · x) := by + change Differentiable ℝ (↿(A.electricField c) ∘ fun t => (t, x)) refine Differentiable.comp ?_ ?_ · exact electricField_differentiable hA · fun_prop -lemma electricField_differentiable_space {A : ElectromagneticPotential d} - (hA : ContDiff ℝ 2 A) (t : Time) : Differentiable ℝ (A.electricField t) := by - change Differentiable ℝ (↿A.electricField ∘ fun x => (t, x)) +lemma electricField_differentiable_space {A : ElectromagneticPotential d} {c : SpeedOfLight} + (hA : ContDiff ℝ 2 A) (t : Time) : Differentiable ℝ (A.electricField c t) := by + change Differentiable ℝ (↿(A.electricField c) ∘ fun x => (t, x)) refine Differentiable.comp ?_ ?_ · exact electricField_differentiable hA · fun_prop +lemma electricField_apply_differentiable {A : ElectromagneticPotential d} + {c : SpeedOfLight} + (hA : ContDiff ℝ 2 A) : + Differentiable ℝ (fun (tx : Time × Space d) => A.electricField c tx.1 tx.2 i) := by + change Differentiable ℝ (EuclideanSpace.proj i ∘ ↿(A.electricField c)) + refine Differentiable.comp ?_ ?_ + · exact ContinuousLinearMap.differentiable (𝕜 := ℝ) (EuclideanSpace.proj i) + · exact electricField_differentiable hA lemma electricField_apply_differentiable_space {A : ElectromagneticPotential d} + {c : SpeedOfLight} (hA : ContDiff ℝ 2 A) (t : Time) (i : Fin d) : - Differentiable ℝ (fun x => A.electricField t x i) := by - change Differentiable ℝ (EuclideanSpace.proj i ∘ (A.electricField t)) + Differentiable ℝ (fun x => A.electricField c t x i) := by + change Differentiable ℝ (EuclideanSpace.proj i ∘ (A.electricField c t)) refine Differentiable.comp ?_ ?_ · exact ContinuousLinearMap.differentiable (𝕜 := ℝ) (EuclideanSpace.proj i) · exact electricField_differentiable_space hA t +lemma electricField_apply_differentiable_time {A : ElectromagneticPotential d} + {c : SpeedOfLight} + (hA : ContDiff ℝ 2 A) (x : Space d) (i : Fin d) : + Differentiable ℝ (fun t => A.electricField c t x i) := by + change Differentiable ℝ (EuclideanSpace.proj i ∘ (A.electricField c · x)) + refine Differentiable.comp ?_ ?_ + · exact ContinuousLinearMap.differentiable (𝕜 := ℝ) (EuclideanSpace.proj i) + · exact electricField_differentiable_time hA x + /-! ## E. Time derivative of the vector potential in terms of the electric field -/ -lemma time_deriv_vectorPotential_eq_electricField {d} (A : ElectromagneticPotential d) +lemma time_deriv_vectorPotential_eq_electricField {d} {c : SpeedOfLight} + (A : ElectromagneticPotential d) (t : Time) (x : Space d) : - ∂ₜ (fun t => A.vectorPotential t x) t = - - A.electricField t x - ∇ (A.scalarPotential t) x := by + ∂ₜ (fun t => A.vectorPotential c t x) t = + - A.electricField c t x - ∇ (A.scalarPotential c t) x := by rw [electricField] abel lemma time_deriv_comp_vectorPotential_eq_electricField {d} {A : ElectromagneticPotential d} + {c : SpeedOfLight} (hA : Differentiable ℝ A) (t : Time) (x : Space d) (i : Fin d) : - ∂ₜ (fun t => A.vectorPotential t x i) t = - - A.electricField t x i - ∂[i] (A.scalarPotential t) x := by + ∂ₜ (fun t => A.vectorPotential c t x i) t = + - A.electricField c t x i - ∂[i] (A.scalarPotential c t) x := by rw [Time.deriv_euclid, time_deriv_vectorPotential_eq_electricField] simp rfl apply vectorPotential_differentiable_time A hA x +/-! + +## F. Derivatives of the electric field in terms of field strength tensor + +-/ + +open Space + +lemma time_deriv_electricField_eq_fieldStrengthMatrix {d} {A : ElectromagneticPotential d} + {c : SpeedOfLight} (hA : ContDiff ℝ 2 A) (t : Time) (x : Space d) (i : Fin d) : + ∂ₜ (fun t => A.electricField c t x) t i = + - c ^ 2 * ∂_ (Sum.inl 0) (fun x => (A.fieldStrengthMatrix x) (Sum.inl 0, Sum.inr i)) + ((toTimeAndSpace c).symm (t, x)) := by + rw [SpaceTime.deriv_sum_inl c] + simp only [one_div, ContinuousLinearEquiv.apply_symm_apply, Fin.isValue, smul_eq_mul, neg_mul] + rw [← Time.deriv_euclid] + conv_lhs => + enter [1, t] + rw [electricField_eq_fieldStrengthMatrix (c := c) A t x i (hA.differentiable (by simp))] + rw [Time.deriv_eq] + rw [fderiv_const_mul] + simp [← Time.deriv_eq] + field_simp + · apply Differentiable.differentiableAt + apply fieldStrengthMatrix_differentiable_time hA + · apply electricField_differentiable_time hA x + · apply fieldStrengthMatrix_differentiable hA + +lemma div_electricField_eq_fieldStrengthMatrix{d} {A : ElectromagneticPotential d} + {c : SpeedOfLight} (hA : ContDiff ℝ 2 A) (t : Time) (x : Space d) : + (∇ ⬝ A.electricField c t) x = c * ∑ (μ : (Fin 1 ⊕ Fin d)), + (∂_ μ (A.fieldStrengthMatrix · (μ, Sum.inl 0)) ((toTimeAndSpace c).symm (t, x))) := by + rw [Finset.mul_sum] + simp only [Fin.isValue, Fintype.sum_sum_type, Finset.univ_unique, Fin.default_eq_zero, + Finset.sum_singleton, fieldStrengthMatrix_diag_eq_zero, SpaceTime.deriv_zero, Pi.ofNat_apply, + mul_zero, zero_add] + conv_rhs => + enter [2, i] + rw [SpaceTime.deriv_sum_inr c _ (fieldStrengthMatrix_differentiable hA)] + simp only [Fin.isValue] + rw [Space.div] + congr + funext i + simp only [ContinuousLinearEquiv.apply_symm_apply, Fin.isValue] + conv_lhs => + enter [2, y] + rw [electricField_eq_fieldStrengthMatrix (c := c) A t y i (hA.differentiable (by simp))] + rw [fieldStrengthMatrix_antisymm] + rw [Space.deriv_eq_fderiv_basis, fderiv_const_mul] + simp [← Space.deriv_eq_fderiv_basis] + apply Differentiable.differentiableAt + apply Differentiable.neg + apply fieldStrengthMatrix_differentiable_space hA end ElectromagneticPotential +/-! + +## G. Electric field for distributions + +-/ + +namespace DistElectromagneticPotential +open TensorSpecies +open Tensor +open SpaceTime +open TensorProduct +open minkowskiMatrix SchwartzMap Lorentz +attribute [-simp] Fintype.sum_sum_type +attribute [-simp] Nat.succ_eq_add_one + +/-- The electric field of an electromagnetic potential which is a distribution. -/ +noncomputable def electricField {d} (c : SpeedOfLight) : + DistElectromagneticPotential d →ₗ[ℝ] + (Time × Space d) →d[ℝ] EuclideanSpace ℝ (Fin d) where + toFun A := - Space.distSpaceGrad (A.scalarPotential c) - + Space.distTimeDeriv (A.vectorPotential c) + map_add' A1 A2 := by + ext ε i + simp only [map_add, neg_add_rev, ContinuousLinearMap.coe_sub', Pi.sub_apply, + ContinuousLinearMap.add_apply, ContinuousLinearMap.neg_apply, PiLp.sub_apply, PiLp.add_apply, + PiLp.neg_apply] + ring + map_smul' r A := by + ext ε i + simp only [map_smul, ContinuousLinearMap.coe_sub', ContinuousLinearMap.coe_smul', Pi.sub_apply, + ContinuousLinearMap.neg_apply, Pi.smul_apply, PiLp.sub_apply, PiLp.neg_apply, PiLp.smul_apply, + smul_eq_mul, Real.ringHom_apply] + ring + +lemma electricField_eq_fieldStrength {d} {c : SpeedOfLight} + (A : DistElectromagneticPotential d) (ε : 𝓢(Time × Space d, ℝ)) + (i : Fin d) : A.electricField c ε i = - c * (Vector.basis.tensorProduct Vector.basis).repr + (distTimeSlice c (A.fieldStrength) ε) (Sum.inl 0, Sum.inr i) := by + simp only [distTimeSlice_apply, Fin.isValue, fieldStrength_basis_repr_eq_single, inl_0_inl_0, + one_mul, inr_i_inr_i, neg_mul, sub_neg_eq_add] + simp only [electricField, scalarPotential, Vector.temporalCLM, Fin.isValue, map_smul, + ContinuousLinearMap.comp_smulₛₗ, Real.ringHom_apply, LinearMap.coe_mk, AddHom.coe_mk, + vectorPotential, Vector.spatialCLM, Space.distTimeDeriv_apply_CLM, ContinuousLinearMap.coe_sub', + ContinuousLinearMap.coe_comp', ContinuousLinearMap.coe_mk', Pi.sub_apply, + ContinuousLinearMap.neg_apply, ContinuousLinearMap.coe_smul', Pi.smul_apply, + Function.comp_apply, PiLp.sub_apply, PiLp.neg_apply, PiLp.smul_apply, Space.distSpaceGrad_apply, + Space.distSpaceDeriv_apply_CLM, LinearMap.coe_toContinuousLinearMap', smul_eq_mul, + ← distTimeSlice_apply, distTimeSlice_distDeriv_inl, one_div, Vector.apply_smul, + distTimeSlice_distDeriv_inr] + field_simp + ring + +end DistElectromagneticPotential + end Electromagnetism diff --git a/PhysLean/Electromagnetism/Kinematics/FieldStrength.lean b/PhysLean/Electromagnetism/Kinematics/FieldStrength.lean index bf139eff0..c091859ee 100644 --- a/PhysLean/Electromagnetism/Kinematics/FieldStrength.lean +++ b/PhysLean/Electromagnetism/Kinematics/FieldStrength.lean @@ -4,9 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Electromagnetism.Kinematics.EMPotential -import PhysLean.SpaceAndTime.SpaceTime.TimeSlice -import PhysLean.Relativity.Tensors.RealTensor.CoVector.Basic -import PhysLean.Mathematics.VariationalCalculus.HasVarGradient /-! # The Field Strength Tensor @@ -22,6 +19,8 @@ We define a tensor version and a matrix version and prover various properties of - `toFieldStrength` : The field strength tensor from an electromagnetic potential. - `fieldStrengthMatrix` : The field strength matrix from an electromagnetic potential (matrix representation of the field strength tensor in the standard basis). +- `DistElectromagneticPotential.fieldStrength` : The field strength for + electromagnetic potentials which are distributions. ## iii. Table of contents @@ -33,6 +32,11 @@ We define a tensor version and a matrix version and prover various properties of - A.4. The antisymmetry of the field strength tensor - A.5. Equivariance of the field strength tensor - A.6. Linearity of the field strength tensor +- B. Field strength for distributions + - B.1. Auxiliary definition of field strength for distributions, with no linearity + - B.2. The definition of the field strength + - B.3. Field strength written in terms of a basis + - B.4. Equivariance of the field strength for distributions ## iv. References @@ -202,6 +206,10 @@ open ContDiff noncomputable abbrev fieldStrengthMatrix {d} (A : ElectromagneticPotential d) (x : SpaceTime d) := (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr (A.toFieldStrength x) +lemma fieldStrengthMatrix_eq {d} (A : ElectromagneticPotential d) (x : SpaceTime d) : + A.fieldStrengthMatrix x = + (Lorentz.CoVector.basis.tensorProduct Lorentz.Vector.basis).repr (A.toFieldStrength x) := by rfl + lemma fieldStrengthMatrix_eq_tensor_basis_repr {d} (A : ElectromagneticPotential d) (x : SpaceTime d) (μ ν : (Fin 1 ⊕ Fin d)) : A.fieldStrengthMatrix x (μ, ν) = @@ -211,6 +219,18 @@ lemma fieldStrengthMatrix_eq_tensor_basis_repr {d} (A : ElectromagneticPotential simp only [Equiv.symm_apply_apply] rfl +lemma toFieldStrength_eq_fieldStrengthMatrix {d} (A : ElectromagneticPotential d) : + toFieldStrength A = fun x => ∑ μ, ∑ ν, + A.fieldStrengthMatrix x (μ, ν) • (Lorentz.Vector.basis μ) ⊗ₜ (Lorentz.Vector.basis ν) := by + ext x + apply (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr.injective + simp only [map_sum, map_smul] + ext κ + match κ with + | (μ', ν') => + simp [Finsupp.single_apply] + rfl + /-! #### A.3.1. Differentiability of the field strength matrix @@ -222,10 +242,10 @@ lemma fieldStrengthMatrix_differentiable {d} {A : ElectromagneticPotential d} Differentiable ℝ (A.fieldStrengthMatrix · μν) := by have diff_partial (μ) : ∀ ν, Differentiable ℝ fun x => (fderiv ℝ A x) (Lorentz.Vector.basis μ) ν := by - rw [← differentiable_pi] + rw [SpaceTime.differentiable_vector] refine Differentiable.clm_apply ?_ ?_ · exact ((contDiff_succ_iff_fderiv (n := 1)).mp hA).2.2.differentiable - (Preorder.le_refl 1) + (by simp) · fun_prop conv => enter [2, x]; rw [toFieldStrength_basis_repr_apply_eq_single, SpaceTime.deriv_eq, SpaceTime.deriv_eq] @@ -235,6 +255,35 @@ lemma fieldStrengthMatrix_differentiable {d} {A : ElectromagneticPotential d} apply Differentiable.const_mul · exact diff_partial _ _ +lemma toFieldStrength_differentiable {d} {A : ElectromagneticPotential d} + (hA : ContDiff ℝ 2 A) : + Differentiable ℝ (toFieldStrength A) := by + conv => + enter [2] + rw [toFieldStrength_eq_fieldStrengthMatrix] + apply Differentiable.fun_sum + intro μ _ + apply Differentiable.fun_sum + intro ν _ + apply Differentiable.smul_const + exact fieldStrengthMatrix_differentiable hA + +lemma fieldStrengthMatrix_differentiable_space {d} {A : ElectromagneticPotential d} + {μν} (hA : ContDiff ℝ 2 A) (t : Time) {c : SpeedOfLight} : + Differentiable ℝ (fun x => A.fieldStrengthMatrix ((toTimeAndSpace c).symm (t, x)) μν) := by + change Differentiable ℝ ((A.fieldStrengthMatrix · μν) ∘ fun x => (toTimeAndSpace c).symm (t, x)) + refine Differentiable.comp ?_ ?_ + · exact fieldStrengthMatrix_differentiable hA + · fun_prop + +lemma fieldStrengthMatrix_differentiable_time {d} {A : ElectromagneticPotential d} + {μν} (hA : ContDiff ℝ 2 A) (x : Space d) {c : SpeedOfLight} : + Differentiable ℝ (fun t => A.fieldStrengthMatrix ((toTimeAndSpace c).symm (t, x)) μν) := by + change Differentiable ℝ ((A.fieldStrengthMatrix · μν) ∘ fun t => (toTimeAndSpace c).symm (t, x)) + refine Differentiable.comp ?_ ?_ + · exact fieldStrengthMatrix_differentiable hA + · fun_prop + lemma fieldStrengthMatrix_contDiff {d} {n : WithTop ℕ∞} {A : ElectromagneticPotential d} {μν} (hA : ContDiff ℝ (n + 1) A) : ContDiff ℝ n (A.fieldStrengthMatrix · μν) := by @@ -247,7 +296,7 @@ lemma fieldStrengthMatrix_contDiff {d} {n : WithTop ℕ∞} {A : Electromagnetic | (μ, ν) => simp only revert ν - rw [← contDiff_euclidean] + rw [SpaceTime.contDiff_vector] apply ContDiff.clm_apply · exact ContDiff.fderiv_right (m := n) hA (by rfl) · fun_prop @@ -257,7 +306,7 @@ lemma fieldStrengthMatrix_contDiff {d} {n : WithTop ℕ∞} {A : Electromagnetic | (μ, ν) => simp only revert μ - rw [← contDiff_euclidean] + rw [SpaceTime.contDiff_vector] apply ContDiff.clm_apply · exact ContDiff.fderiv_right (m := n) hA (by rfl) · fun_prop @@ -320,8 +369,7 @@ lemma toFieldStrength_equivariant {d} (A : ElectromagneticPotential d) (Λ : Lor Λ • toFieldStrength A (Λ⁻¹ • x) := by rw [toFieldStrength, deriv_equivariant A Λ hf, ← actionT_contrMetric Λ, toFieldStrength] simp only [Tensorial.toTensor_smul, prodT_equivariant, contrT_equivariant, map_neg, - permT_equivariant, map_add, ← Tensorial.smul_toTensor_symm, Tensorial.smul_add, - Tensorial.smul_neg] + permT_equivariant, map_add, ← Tensorial.smul_toTensor_symm, smul_add, smul_neg] lemma fieldStrengthMatrix_equivariant {d} (A : ElectromagneticPotential d) (Λ : LorentzGroup d) (hf : Differentiable ℝ A) (x : SpaceTime d) @@ -415,4 +463,268 @@ lemma fieldStrengthMatrix_smul {d} (c : ℝ) (A : ElectromagneticPotential d) end ElectromagneticPotential +/-! + +## B. Field strength for distributions + +-/ + +namespace DistElectromagneticPotential +open TensorSpecies +open Tensor +open SpaceTime +open TensorProduct Lorentz +open minkowskiMatrix SchwartzMap +attribute [-simp] Fintype.sum_sum_type +attribute [-simp] Nat.succ_eq_add_one + +/-! + +### B.1. Auxiliary definition of field strength for distributions, with no linearity + +-/ + +/-- An auxiliary definition for the field strength of an electromagnetic potential + based on a distribution. On Schwartz maps this has the same value as the field strength + tensor, but no linearity or continuous properties built in. -/ +noncomputable def fieldStrengthAux {d} (A : DistElectromagneticPotential d) + (ε : 𝓢(SpaceTime d, ℝ)) : Lorentz.Vector d ⊗[ℝ] Lorentz.Vector d := + Tensorial.toTensor.symm + (permT id (PermCond.auto) {(η d | μ μ' ⊗ A.deriv ε | μ' ν) + - + (η d | ν ν' ⊗ A.deriv ε | ν' μ)}ᵀ) + +lemma fieldStrengthAux_eq_add {d} (A : DistElectromagneticPotential d) (ε : 𝓢(SpaceTime d, ℝ)) : + fieldStrengthAux A ε = + Tensorial.toTensor.symm (permT id (PermCond.auto) {(η d | μ μ' ⊗ A.deriv ε | μ' ν)}ᵀ) + - Tensorial.toTensor.symm (permT ![1, 0] (PermCond.auto) + {(η d | μ μ' ⊗ A.deriv ε | μ' ν)}ᵀ) := by + rw [fieldStrengthAux] + simp only [map_add, map_neg] + rw [sub_eq_add_neg] + apply congrArg₂ + · rfl + · rw [permT_permT] + rfl + +lemma toTensor_fieldStrengthAux {d} (A : DistElectromagneticPotential d) + (ε : 𝓢(SpaceTime d, ℝ)) : + Tensorial.toTensor (fieldStrengthAux A ε) = + (permT id (PermCond.auto) {(η d | μ μ' ⊗ A.deriv ε | μ' ν)}ᵀ) + - (permT ![1, 0] (PermCond.auto) {(η d | μ μ' ⊗ A.deriv ε | μ' ν)}ᵀ) := by + rw [fieldStrengthAux_eq_add] + simp + +lemma toTensor_fieldStrengthAux_basis_repr {d} (A : DistElectromagneticPotential d) + (ε : 𝓢(SpaceTime d, ℝ)) + (b : ComponentIdx (S := realLorentzTensor d) (Fin.append ![Color.up] ![Color.up])) : + (Tensor.basis _).repr (Tensorial.toTensor (fieldStrengthAux A ε)) b = + ∑ κ, (η (finSumFinEquiv.symm (b 0)) κ * SpaceTime.distDeriv κ A ε (finSumFinEquiv.symm (b 1)) - + η (finSumFinEquiv.symm (b 1)) κ * SpaceTime.distDeriv κ A ε (finSumFinEquiv.symm (b 0))) := by + rw [toTensor_fieldStrengthAux] + simp only [Tensorial.self_toTensor_apply, map_sub, + Finsupp.coe_sub, Pi.sub_apply] + rw [Tensor.permT_basis_repr_symm_apply, contrT_basis_repr_apply_eq_fin] + conv_lhs => + enter [1, 2, n] + rw [Tensor.prodT_basis_repr_apply, contrMetric_repr_apply_eq_minkowskiMatrix] + enter [1] + change η (finSumFinEquiv.symm (b 0)) (finSumFinEquiv.symm n) + conv_lhs => + enter [1, 2, n, 2] + rw [toTensor_deriv_basis_repr_apply] + change distDeriv (finSumFinEquiv.symm n) A ε (finSumFinEquiv.symm (b 1)) + rw [Tensor.permT_basis_repr_symm_apply, contrT_basis_repr_apply_eq_fin] + conv_lhs => + enter [2, 2, n] + rw [Tensor.prodT_basis_repr_apply, contrMetric_repr_apply_eq_minkowskiMatrix] + enter [1] + change η (finSumFinEquiv.symm (b 1)) (finSumFinEquiv.symm n) + conv_lhs => + enter [2, 2, n, 2] + rw [toTensor_deriv_basis_repr_apply] + change distDeriv (finSumFinEquiv.symm n) A ε (finSumFinEquiv.symm (b 0)) + rw [← Finset.sum_sub_distrib] + rw [← finSumFinEquiv.sum_comp] + simp only [Fin.isValue, Equiv.symm_apply_apply] + +lemma fieldStrengthAux_tensor_basis_eq_basis {d} (A : DistElectromagneticPotential d) + (ε : 𝓢(SpaceTime d, ℝ)) + (b : ComponentIdx (S := realLorentzTensor d) (Fin.append ![Color.up] ![Color.up])) : + (Tensor.basis _).repr (Tensorial.toTensor (A.fieldStrengthAux ε)) b = + (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr (A.fieldStrengthAux ε) + (finSumFinEquiv.symm (b 0), finSumFinEquiv.symm (b 1)) := by + rw [Tensorial.basis_toTensor_apply] + rw [Tensorial.basis_map_prod] + simp only [Nat.reduceSucc, Nat.reduceAdd, Basis.repr_reindex, Finsupp.mapDomain_equiv_apply, + Equiv.symm_symm, Fin.isValue] + rw [Lorentz.Vector.tensor_basis_map_eq_basis_reindex] + have hb : (((Lorentz.Vector.basis (d := d)).reindex Lorentz.Vector.indexEquiv.symm).tensorProduct + (Lorentz.Vector.basis.reindex Lorentz.Vector.indexEquiv.symm)) = + ((Lorentz.Vector.basis (d := d)).tensorProduct (Lorentz.Vector.basis (d := d))).reindex + (Lorentz.Vector.indexEquiv.symm.prodCongr Lorentz.Vector.indexEquiv.symm) := by + ext b + match b with + | ⟨i, j⟩ => + simp + rw [hb] + rw [Module.Basis.repr_reindex_apply] + congr 1 + +lemma fieldStrengthAux_basis_repr_apply {d} {μν : (Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d)} + (A : DistElectromagneticPotential d) (ε : 𝓢(SpaceTime d, ℝ)) : + (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr (A.fieldStrengthAux ε) μν = + ∑ κ, ((η μν.1 κ * distDeriv κ A ε μν.2) - η μν.2 κ * distDeriv κ A ε μν.1) := by + match μν with + | (μ, ν) => + trans (Tensor.basis _).repr (Tensorial.toTensor (A.fieldStrengthAux ε)) + (fun | 0 => finSumFinEquiv μ | 1 => finSumFinEquiv ν); swap + · rw [toTensor_fieldStrengthAux_basis_repr] + simp + rw [fieldStrengthAux_tensor_basis_eq_basis] + congr 1 + change _ = (finSumFinEquiv.symm (finSumFinEquiv μ), finSumFinEquiv.symm (finSumFinEquiv ν)) + simp + +lemma fieldStrengthAux_basis_repr_apply_eq_single {d} {μν : (Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d)} + (A : DistElectromagneticPotential d) (ε : 𝓢(SpaceTime d, ℝ)) : + (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr (A.fieldStrengthAux ε) μν = + ((η μν.1 μν.1 * distDeriv μν.1 A ε μν.2) - η μν.2 μν.2 * distDeriv μν.2 A ε μν.1) := by + rw [fieldStrengthAux_basis_repr_apply] + simp only [Finset.sum_sub_distrib] + rw [Finset.sum_eq_single μν.1, Finset.sum_eq_single μν.2] + · intro b _ hb + rw [minkowskiMatrix.off_diag_zero] + simp only [zero_mul] + exact id (Ne.symm hb) + · simp + · intro b _ hb + rw [minkowskiMatrix.off_diag_zero] + simp only [zero_mul] + exact id (Ne.symm hb) + · simp + +lemma fieldStrengthAux_eq_basis {d} (A : DistElectromagneticPotential d) + (ε : 𝓢(SpaceTime d, ℝ)) : + (A.fieldStrengthAux ε) = ∑ μ, ∑ ν, + ((η μ μ * distDeriv μ A ε ν) - η ν ν * distDeriv ν A ε μ) + • Lorentz.Vector.basis μ ⊗ₜ[ℝ] Lorentz.Vector.basis ν := by + apply (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr.injective + ext b + match b with + | (μ, ν) => + simp [map_sum, map_smul, Finsupp.coe_finset_sum, Finsupp.coe_smul, Finset.sum_apply, + Pi.smul_apply, Basis.tensorProduct_repr_tmul_apply, Basis.repr_self, smul_eq_mul] + simp [Finsupp.single_apply] + rw [fieldStrengthAux_basis_repr_apply_eq_single] + +/-! + +### B.2. The definition of the field strength + +-/ + +/-- The field strength of an electromagnetic potential which is a distribution. -/ +noncomputable def fieldStrength {d} : + DistElectromagneticPotential d →ₗ[ℝ] + (SpaceTime d) →d[ℝ] Lorentz.Vector d ⊗[ℝ] Lorentz.Vector d where + toFun A := { + toFun ε := A.fieldStrengthAux ε + map_add' ε1 ε2 := by + apply (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr.injective + ext μν + simp [fieldStrengthAux_basis_repr_apply_eq_single] + ring + map_smul' c ε := by + apply (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr.injective + ext μν + simp [fieldStrengthAux_basis_repr_apply_eq_single] + ring + cont := by + simp [fieldStrengthAux_eq_basis] + fun_prop} + map_add' A1 A2 := by + ext ε + apply (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr.injective + ext μν + simp only [ContinuousLinearMap.coe_mk', LinearMap.coe_mk, AddHom.coe_mk, + fieldStrengthAux_basis_repr_apply_eq_single, map_add, ContinuousLinearMap.add_apply, + Lorentz.Vector.apply_add, Finsupp.coe_add, Pi.add_apply] + ring + map_smul' c A := by + ext ε + apply (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr.injective + ext μν + simp only [ContinuousLinearMap.coe_mk', LinearMap.coe_mk, AddHom.coe_mk, + fieldStrengthAux_basis_repr_apply_eq_single, map_smul, ContinuousLinearMap.coe_smul', + Pi.smul_apply, Lorentz.Vector.apply_smul, Real.ringHom_apply, Finsupp.coe_smul, smul_eq_mul] + ring + +lemma fieldStrength_eq_fieldStrengthAux {d} (A : DistElectromagneticPotential d) + (ε : 𝓢(SpaceTime d, ℝ)) : + A.fieldStrength ε = A.fieldStrengthAux ε := by rfl +/-! + +### B.3. Field strength written in terms of a basis + +-/ + +lemma fieldStrength_eq_basis {d} (A : DistElectromagneticPotential d) + (ε : 𝓢(SpaceTime d, ℝ)) : + A.fieldStrength ε = ∑ μ, ∑ ν, + ((η μ μ * distDeriv μ A ε ν) - η ν ν * distDeriv ν A ε μ) + • Lorentz.Vector.basis μ ⊗ₜ[ℝ] Lorentz.Vector.basis ν := by + rw [fieldStrength] + exact fieldStrengthAux_eq_basis A ε + +lemma fieldStrength_basis_repr_eq_single {d} {μν : (Fin 1 ⊕ Fin d) × (Fin 1 ⊕ Fin d)} + (A : DistElectromagneticPotential d) (ε : 𝓢(SpaceTime d, ℝ)) : + (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr (A.fieldStrength ε) μν = + ((η μν.1 μν.1 * distDeriv μν.1 A ε μν.2) - η μν.2 μν.2 * distDeriv μν.2 A ε μν.1) := by + rw [fieldStrength] + exact fieldStrengthAux_basis_repr_apply_eq_single A ε + +@[simp] +lemma fieldStrength_diag_zero {d} (A : DistElectromagneticPotential d) + (ε : 𝓢(SpaceTime d, ℝ)) (μ : Fin 1 ⊕ Fin d) : + (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr + (A.fieldStrength ε) (μ, μ) = 0 := by + rw [fieldStrength_basis_repr_eq_single] + simp + +@[simp] +lemma distDeriv_fieldStrength_diag_zero {d} (A : DistElectromagneticPotential d) + (ε : 𝓢(SpaceTime d, ℝ)) (μ ν : Fin 1 ⊕ Fin d) : + (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr + (distDeriv ν A.fieldStrength ε) (μ, μ) = 0 := by + rw [SpaceTime.distDeriv_apply'] + simp + +lemma fieldStrength_antisymmetric_basis {d} (A : DistElectromagneticPotential d) + (ε : 𝓢(SpaceTime d, ℝ)) (μ ν : Fin 1 ⊕ Fin d) : + (Vector.basis.tensorProduct Vector.basis).repr + (A.fieldStrength ε) (μ, ν) = - (Vector.basis.tensorProduct Vector.basis).repr + (A.fieldStrength ε) (ν, μ) := by + rw [fieldStrength_basis_repr_eq_single, fieldStrength_basis_repr_eq_single] + ring + +/-! + +### B.4. Equivariance of the field strength for distributions + +-/ + +lemma fieldStrength_equivariant {d} (A : DistElectromagneticPotential d) + (Λ : LorentzGroup d) : + (Λ • A).fieldStrength = Λ • A.fieldStrength := by + ext ε + rw [fieldStrength_eq_fieldStrengthAux, lorentzGroup_smul_dist_apply] + rw [fieldStrengthAux_eq_add, deriv_equivariant, lorentzGroup_smul_dist_apply, + ← actionT_contrMetric Λ] + generalize ((schwartzAction Λ⁻¹) ε) = ε' + rw [fieldStrength_eq_fieldStrengthAux, fieldStrengthAux_eq_add] + simp only [Tensorial.toTensor_smul, prodT_equivariant, contrT_equivariant, permT_equivariant, + ← Tensorial.smul_toTensor_symm, smul_sub] + +end DistElectromagneticPotential + end Electromagnetism diff --git a/PhysLean/Electromagnetism/Kinematics/MagneticField.lean b/PhysLean/Electromagnetism/Kinematics/MagneticField.lean index 404a36dda..db43e67c5 100644 --- a/PhysLean/Electromagnetism/Kinematics/MagneticField.lean +++ b/PhysLean/Electromagnetism/Kinematics/MagneticField.lean @@ -4,10 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Electromagnetism.Kinematics.ElectricField -import PhysLean.SpaceAndTime.SpaceTime.TimeSlice -import PhysLean.Relativity.Tensors.RealTensor.CoVector.Basic -import PhysLean.Mathematics.VariationalCalculus.HasVarGradient -import PhysLean.ClassicalMechanics.VectorFields /-! # The Magnetic Field @@ -44,6 +40,11 @@ field strength matrix. This is an antisymmetric matrix. - C.5. Differentiablity of the magnetic field matrix - C.6. Spatial derivative of the magnetic field matrix - C.7. Temporal derivative of the magnetic field matrix + - C.8. `curl` of the magnetic field matrix +- D. Magnetic field matrix for distributions + - D.1. Magnetic field matrix in terms of vector potentials + - D.2. The magnetic field matrix in terms of the field strength + - D.3. Magnetic field matrix in 1d ## iv. References @@ -74,11 +75,12 @@ open Space Time -/ /-- The magnetic field from the electromagnetic potential. -/ -noncomputable def magneticField (A : ElectromagneticPotential) : MagneticField := - fun t x => (∇ × (A.vectorPotential t)) x +noncomputable def magneticField (c : SpeedOfLight := 1) (A : ElectromagneticPotential) : + MagneticField := + fun t x => (∇ × (A.vectorPotential c t)) x -lemma magneticField_eq (A : ElectromagneticPotential) : - A.magneticField = fun t x => (∇ × (A.vectorPotential t)) x := rfl +lemma magneticField_eq {c : SpeedOfLight} (A : ElectromagneticPotential) : + A.magneticField c = fun t x => (∇ × (A.vectorPotential c t)) x := rfl /-! @@ -86,73 +88,66 @@ lemma magneticField_eq (A : ElectromagneticPotential) : -/ -lemma magneticField_fst_eq_fieldStrengthMatrix (A : ElectromagneticPotential) (t : Time) +lemma magneticField_fst_eq_fieldStrengthMatrix {c : SpeedOfLight} + (A : ElectromagneticPotential) (t : Time) (x : Space) (hA : Differentiable ℝ A) : - A.magneticField t x 0 = - - A.fieldStrengthMatrix (SpaceTime.toTimeAndSpace.symm (t, x)) (Sum.inr 1, Sum.inr 2) := by + A.magneticField c t x 0 = + - A.fieldStrengthMatrix ((toTimeAndSpace c).symm (t, x)) (Sum.inr 1, Sum.inr 2) := by rw [toFieldStrength_basis_repr_apply_eq_single] simp only [Fin.isValue, inr_i_inr_i, neg_mul, one_mul, sub_neg_eq_add, neg_add_rev, neg_neg] rw [magneticField] - simp [Space.curl, Space.coord] + simp only [curl, Fin.isValue] rw [neg_add_eq_sub] congr all_goals - · rw [SpaceTime.deriv_sum_inr _ hA] + · rw [SpaceTime.deriv_sum_inr c _ hA] simp only [Fin.isValue, ContinuousLinearEquiv.apply_symm_apply] - rw [Space.deriv_eq, Space.deriv_eq, fderiv_pi] + rw [Space.deriv_eq, Space.deriv_eq, Lorentz.Vector.fderiv_apply] rfl - · intro μ - apply Differentiable.differentiableAt - have h1 := (differentiable_component A hA μ) - apply Differentiable.comp h1 + · refine Differentiable.comp hA ?_ refine Differentiable.fun_comp ?_ ?_ - · exact ContinuousLinearEquiv.differentiable toTimeAndSpace.symm + · exact ContinuousLinearEquiv.differentiable (toTimeAndSpace c).symm · fun_prop -lemma magneticField_snd_eq_fieldStrengthMatrix (A : ElectromagneticPotential) (t : Time) +lemma magneticField_snd_eq_fieldStrengthMatrix {c : SpeedOfLight} + (A : ElectromagneticPotential) (t : Time) (x : Space) (hA : Differentiable ℝ A) : - A.magneticField t x 1 = A.fieldStrengthMatrix (SpaceTime.toTimeAndSpace.symm (t, x)) + A.magneticField c t x 1 = A.fieldStrengthMatrix ((toTimeAndSpace c).symm (t, x)) (Sum.inr 0, Sum.inr 2) := by rw [toFieldStrength_basis_repr_apply_eq_single] simp only [Fin.isValue, inr_i_inr_i, neg_mul, one_mul, sub_neg_eq_add] rw [magneticField] - simp [Space.curl, Space.coord] + simp only [curl, Fin.isValue] rw [neg_add_eq_sub] congr all_goals - · rw [SpaceTime.deriv_sum_inr _ hA] + · rw [SpaceTime.deriv_sum_inr c _ hA] simp only [Fin.isValue, ContinuousLinearEquiv.apply_symm_apply] - rw [Space.deriv_eq, Space.deriv_eq, fderiv_pi] + rw [Space.deriv_eq, Space.deriv_eq, Lorentz.Vector.fderiv_apply] rfl - · intro μ - apply Differentiable.differentiableAt - have h1 := (differentiable_component A hA μ) - apply Differentiable.comp h1 + · refine Differentiable.comp hA ?_ refine Differentiable.fun_comp ?_ ?_ - · exact ContinuousLinearEquiv.differentiable toTimeAndSpace.symm + · exact ContinuousLinearEquiv.differentiable (toTimeAndSpace c).symm · fun_prop -lemma magneticField_thd_eq_fieldStrengthMatrix (A : ElectromagneticPotential) (t : Time) - (x : Space) (hA : Differentiable ℝ A) : - A.magneticField t x 2 = - - A.fieldStrengthMatrix (SpaceTime.toTimeAndSpace.symm (t, x)) (Sum.inr 0, Sum.inr 1) := by +lemma magneticField_thd_eq_fieldStrengthMatrix {c : SpeedOfLight} (A : ElectromagneticPotential) + (t : Time) (x : Space) (hA : Differentiable ℝ A) : + A.magneticField c t x 2 = + - A.fieldStrengthMatrix ((toTimeAndSpace c).symm (t, x)) (Sum.inr 0, Sum.inr 1) := by rw [toFieldStrength_basis_repr_apply_eq_single] simp only [Fin.isValue, inr_i_inr_i, neg_mul, one_mul, sub_neg_eq_add, neg_add_rev, neg_neg] rw [magneticField] - simp [Space.curl, Space.coord] + simp only [curl, Fin.isValue] rw [neg_add_eq_sub] congr all_goals - · rw [SpaceTime.deriv_sum_inr _ hA] + · rw [SpaceTime.deriv_sum_inr c _ hA] simp only [Fin.isValue, ContinuousLinearEquiv.apply_symm_apply] - rw [Space.deriv_eq, Space.deriv_eq, fderiv_pi] + rw [Space.deriv_eq, Space.deriv_eq, Lorentz.Vector.fderiv_apply] rfl - · intro μ - apply Differentiable.differentiableAt - have h1 := (differentiable_component A hA μ) - apply Differentiable.comp h1 + · refine Differentiable.comp hA ?_ refine Differentiable.fun_comp ?_ ?_ - · exact ContinuousLinearEquiv.differentiable toTimeAndSpace.symm + · exact ContinuousLinearEquiv.differentiable (toTimeAndSpace c).symm · fun_prop /-! @@ -162,7 +157,7 @@ lemma magneticField_thd_eq_fieldStrengthMatrix (A : ElectromagneticPotential) (t -/ lemma magneticField_div_eq_zero (A : ElectromagneticPotential) - (hA : ContDiff ℝ 2 A) (t : Time) : Space.div (A.magneticField t) = 0 := by + (hA : ContDiff ℝ 2 A) (t : Time) : Space.div (A.magneticField c t) = 0 := by rw [magneticField_eq] simp only rw [Space.div_of_curl_eq_zero] @@ -174,30 +169,31 @@ lemma magneticField_div_eq_zero (A : ElectromagneticPotential) -/ -lemma fieldStrengthMatrix_eq_electric_magnetic (A : ElectromagneticPotential) (t : Time) +lemma fieldStrengthMatrix_eq_electric_magnetic {c} (A : ElectromagneticPotential) (t : Time) (x : Space) (hA : Differentiable ℝ A) (μ ν : Fin 1 ⊕ Fin 3) : - A.fieldStrengthMatrix (SpaceTime.toTimeAndSpace.symm (t, x)) (μ, ν) = + A.fieldStrengthMatrix ((toTimeAndSpace c).symm (t, x)) (μ, ν) = match μ, ν with | Sum.inl 0, Sum.inl 0 => 0 - | Sum.inl 0, Sum.inr i => - A.electricField t x i - | Sum.inr i, Sum.inl 0 => A.electricField t x i + | Sum.inl 0, Sum.inr i => - A.electricField c t x i / c + | Sum.inr i, Sum.inl 0 => A.electricField c t x i / c | Sum.inr i, Sum.inr j => match i, j with | 0, 0 => 0 - | 0, 1 => - A.magneticField t x 2 - | 0, 2 => A.magneticField t x 1 - | 1, 0 => A.magneticField t x 2 + | 0, 1 => - A.magneticField c t x 2 + | 0, 2 => A.magneticField c t x 1 + | 1, 0 => A.magneticField c t x 2 | 1, 1 => 0 - | 1, 2 => - A.magneticField t x 0 - | 2, 0 => - A.magneticField t x 1 - | 2, 1 => A.magneticField t x 0 + | 1, 2 => - A.magneticField c t x 0 + | 2, 0 => - A.magneticField c t x 1 + | 2, 1 => A.magneticField c t x 0 | 2, 2 => 0 := by match μ, ν with | Sum.inl 0, Sum.inl 0 => simp | Sum.inl 0, Sum.inr i => simp [electricField_eq_fieldStrengthMatrix A t x i hA] | Sum.inr i, Sum.inl 0 => simp [electricField_eq_fieldStrengthMatrix A t x i hA] - exact fieldStrengthMatrix_antisymm A (toTimeAndSpace.symm (t, x)) (Sum.inr i) (Sum.inl 0) + field_simp + exact fieldStrengthMatrix_antisymm A ((toTimeAndSpace c).symm (t, x)) (Sum.inr i) (Sum.inl 0) | Sum.inr i, Sum.inr j => match i, j with | 0, 0 => simp @@ -219,24 +215,25 @@ lemma fieldStrengthMatrix_eq_electric_magnetic (A : ElectromagneticPotential) (t rw [fieldStrengthMatrix_antisymm] | 2, 2 => simp -lemma fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime (A : ElectromagneticPotential) +lemma fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime (c : SpeedOfLight) + (A : ElectromagneticPotential) (x : SpaceTime) (hA : Differentiable ℝ A) (μ ν : Fin 1 ⊕ Fin 3) : - let tx := SpaceTime.toTimeAndSpace x + let tx := SpaceTime.toTimeAndSpace c x A.fieldStrengthMatrix x (μ, ν) = match μ, ν with | Sum.inl 0, Sum.inl 0 => 0 - | Sum.inl 0, Sum.inr i => - A.electricField tx.1 tx.2 i - | Sum.inr i, Sum.inl 0 => A.electricField tx.1 tx.2 i + | Sum.inl 0, Sum.inr i => - A.electricField c tx.1 tx.2 i / c + | Sum.inr i, Sum.inl 0 => A.electricField c tx.1 tx.2 i / c | Sum.inr i, Sum.inr j => match i, j with | 0, 0 => 0 - | 0, 1 => - A.magneticField tx.1 tx.2 2 - | 0, 2 => A.magneticField tx.1 tx.2 1 - | 1, 0 => A.magneticField tx.1 tx.2 2 + | 0, 1 => - A.magneticField c tx.1 tx.2 2 + | 0, 2 => A.magneticField c tx.1 tx.2 1 + | 1, 0 => A.magneticField c tx.1 tx.2 2 | 1, 1 => 0 - | 1, 2 => - A.magneticField tx.1 tx.2 0 - | 2, 0 => - A.magneticField tx.1 tx.2 1 - | 2, 1 => A.magneticField tx.1 tx.2 0 + | 1, 2 => - A.magneticField c tx.1 tx.2 0 + | 2, 0 => - A.magneticField c tx.1 tx.2 1 + | 2, 1 => A.magneticField c tx.1 tx.2 0 | 2, 2 => 0 := by dsimp rw [← fieldStrengthMatrix_eq_electric_magnetic A] @@ -251,13 +248,21 @@ lemma fieldStrengthMatrix_eq_electric_magnetic_of_spaceTime (A : Electromagnetic /-- The matrix corresponding to the magnetic field in general dimensions. In `3` space-dimensions this reduces to a vector. -/ -noncomputable def magneticFieldMatrix (A : ElectromagneticPotential d) : - Time → Space d → (Fin d × Fin d) → ℝ := timeSlice <| fun x ij => +noncomputable def magneticFieldMatrix (c : SpeedOfLight := 1) (A : ElectromagneticPotential d) : + Time → Space d → (Fin d × Fin d) → ℝ := timeSlice c <| fun x ij => A.fieldStrengthMatrix x (Sum.inr ij.1, Sum.inr ij.2) -lemma magneticFieldMatrix_eq (A : ElectromagneticPotential d) : - A.magneticFieldMatrix = fun t x ij => - A.fieldStrengthMatrix (toTimeAndSpace.symm (t, x)) (Sum.inr ij.1, Sum.inr ij.2) := rfl +lemma magneticFieldMatrix_eq {c : SpeedOfLight} (A : ElectromagneticPotential d) : + A.magneticFieldMatrix c = fun t x ij => + A.fieldStrengthMatrix ((toTimeAndSpace c).symm (t, x)) (Sum.inr ij.1, Sum.inr ij.2) := rfl + +lemma fieldStrengthMatrix_inr_inr_eq_magneticFieldMatrix {c : SpeedOfLight} + (A : ElectromagneticPotential d) + (x : SpaceTime d) (i j : Fin d) : + A.fieldStrengthMatrix x (Sum.inr i, Sum.inr j) = + A.magneticFieldMatrix c (x.time c) x.space (i, j) := by + rw [magneticFieldMatrix_eq] + simp /-! @@ -265,18 +270,20 @@ lemma magneticFieldMatrix_eq (A : ElectromagneticPotential d) : -/ -lemma magneticFieldMatrix_antisymm (A : ElectromagneticPotential d) (t : Time) +lemma magneticFieldMatrix_antisymm {c : SpeedOfLight} + (A : ElectromagneticPotential d) (t : Time) (x : Space d) (i j : Fin d) : - A.magneticFieldMatrix t x (i, j) = - A.magneticFieldMatrix t x (j, i) := by + A.magneticFieldMatrix c t x (i, j) = - A.magneticFieldMatrix c t x (j, i) := by rw [magneticFieldMatrix_eq] - exact fieldStrengthMatrix_antisymm A (toTimeAndSpace.symm (t, x)) (Sum.inr i) (Sum.inr j) + exact fieldStrengthMatrix_antisymm A ((toTimeAndSpace c).symm (t, x)) (Sum.inr i) (Sum.inr j) @[simp] -lemma magneticFieldMatrix_diag_eq_zero (A : ElectromagneticPotential d) (t : Time) +lemma magneticFieldMatrix_diag_eq_zero {c : SpeedOfLight} + (A : ElectromagneticPotential d) (t : Time) (x : Space d) (i : Fin d) : - A.magneticFieldMatrix t x (i, i) = 0 := by + A.magneticFieldMatrix c t x (i, i) = 0 := by rw [magneticFieldMatrix_eq] - exact fieldStrengthMatrix_diag_eq_zero A (toTimeAndSpace.symm (t, x)) (Sum.inr i) + exact fieldStrengthMatrix_diag_eq_zero A ((toTimeAndSpace c).symm (t, x)) (Sum.inr i) /-! @@ -284,25 +291,25 @@ lemma magneticFieldMatrix_diag_eq_zero (A : ElectromagneticPotential d) (t : Tim -/ -lemma magneticField_eq_magneticFieldMatrix (A : ElectromagneticPotential) +lemma magneticField_eq_magneticFieldMatrix {c : SpeedOfLight} (A : ElectromagneticPotential) (hA : Differentiable ℝ A) : - A.magneticField = fun t x i => + A.magneticField c = fun t x => WithLp.toLp 2 fun i => match i with - | 0 => - A.magneticFieldMatrix t x (1, 2) - | 1 => A.magneticFieldMatrix t x (0, 2) - | 2 => - A.magneticFieldMatrix t x (0, 1) := by + | 0 => - A.magneticFieldMatrix c t x (1, 2) + | 1 => A.magneticFieldMatrix c t x (0, 2) + | 2 => - A.magneticFieldMatrix c t x (0, 1) := by rw [magneticFieldMatrix_eq] - funext t x i + ext t x i fin_cases i · simp [magneticField_fst_eq_fieldStrengthMatrix A t x hA] · simp [magneticField_snd_eq_fieldStrengthMatrix A t x hA] · simp [magneticField_thd_eq_fieldStrengthMatrix A t x hA] -lemma magneticField_curl_eq_magneticFieldMatrix (A : ElectromagneticPotential) +lemma magneticField_curl_eq_magneticFieldMatrix{c : SpeedOfLight} (A : ElectromagneticPotential) (hA : ContDiff ℝ 2 A) (t : Time) : - (∇ × A.magneticField t) x i = ∑ j, Space.deriv j (A.magneticFieldMatrix t · (j, i)) x:= by + (∇ × A.magneticField c t) x i = ∑ j, Space.deriv j (A.magneticFieldMatrix c t · (j, i)) x:= by rw [magneticField_eq_magneticFieldMatrix A (hA.differentiable (by simp))] - simp [Space.curl, Space.coord] + simp only [curl, Fin.isValue] fin_cases i · simp only [Fin.isValue, deriv_eq_fderiv_basis, fderiv_fun_neg, ContinuousLinearMap.neg_apply, Fin.zero_eta, Fin.sum_univ_three, magneticFieldMatrix_diag_eq_zero, fderiv_fun_const, @@ -332,15 +339,15 @@ lemma magneticField_curl_eq_magneticFieldMatrix (A : ElectromagneticPotential) -/ -lemma magneticFieldMatrix_eq_vectorPotential (A : ElectromagneticPotential d) +lemma magneticFieldMatrix_eq_vectorPotential {c : SpeedOfLight} (A : ElectromagneticPotential d) (hA : Differentiable ℝ A) (t : Time) (x : Space d) (i j : Fin d) : - A.magneticFieldMatrix t x (i, j) = Space.deriv j (A.vectorPotential t · i) x - - Space.deriv i (A.vectorPotential t · j) x := by + A.magneticFieldMatrix c t x (i, j) = Space.deriv j (A.vectorPotential c t · i) x - + Space.deriv i (A.vectorPotential c t · j) x := by rw [magneticFieldMatrix_eq] simp only rw [toFieldStrength_basis_repr_apply_eq_single] simp only [inr_i_inr_i, neg_mul, one_mul, sub_neg_eq_add] - rw [SpaceTime.deriv_sum_inr _ hA, SpaceTime.deriv_sum_inr _ hA] + rw [SpaceTime.deriv_sum_inr c _ hA, SpaceTime.deriv_sum_inr c _ hA] simp [vectorPotential] rw [add_comm] congr @@ -350,7 +357,7 @@ lemma magneticFieldMatrix_eq_vectorPotential (A : ElectromagneticPotential d) apply Differentiable.comp · exact hA · apply Differentiable.fun_comp - · exact ContinuousLinearEquiv.differentiable toTimeAndSpace.symm + · exact ContinuousLinearEquiv.differentiable (toTimeAndSpace c).symm · fun_prop /-! @@ -359,27 +366,28 @@ lemma magneticFieldMatrix_eq_vectorPotential (A : ElectromagneticPotential d) -/ -lemma magneticFieldMatrix_contDiff {n} (A : ElectromagneticPotential d) - (hA : ContDiff ℝ (n + 1) A) (ij) : ContDiff ℝ n ↿(fun t x => A.magneticFieldMatrix t x ij) := by +lemma magneticFieldMatrix_contDiff {n} {c : SpeedOfLight} (A : ElectromagneticPotential d) + (hA : ContDiff ℝ (n + 1) A) (ij) : + ContDiff ℝ n ↿(fun t x => A.magneticFieldMatrix c t x ij) := by simp [magneticFieldMatrix_eq] change ContDiff ℝ n ((A.fieldStrengthMatrix · (Sum.inr ij.1, Sum.inr ij.2)) ∘ - toTimeAndSpace.symm) + (toTimeAndSpace c).symm) refine ContDiff.comp ?_ ?_ · exact fieldStrengthMatrix_contDiff (hA) - · exact ContinuousLinearEquiv.contDiff toTimeAndSpace.symm + · exact ContinuousLinearEquiv.contDiff (toTimeAndSpace c).symm -lemma magneticFieldMatrix_space_contDiff {n} (A : ElectromagneticPotential d) +lemma magneticFieldMatrix_space_contDiff {n} {c : SpeedOfLight} (A : ElectromagneticPotential d) (hA : ContDiff ℝ (n + 1) A) (t : Time) (ij) : - ContDiff ℝ n (fun x => A.magneticFieldMatrix t x ij) := by - change ContDiff ℝ n (↿(fun t x => A.magneticFieldMatrix t x ij) ∘ fun x => (t, x)) + ContDiff ℝ n (fun x => A.magneticFieldMatrix c t x ij) := by + change ContDiff ℝ n (↿(fun t x => A.magneticFieldMatrix c t x ij) ∘ fun x => (t, x)) refine ContDiff.comp ?_ ?_ · exact magneticFieldMatrix_contDiff A hA ij · fun_prop -lemma magneticFieldMatrix_time_contDiff {n} (A : ElectromagneticPotential d) +lemma magneticFieldMatrix_time_contDiff {n} {c : SpeedOfLight} (A : ElectromagneticPotential d) (hA : ContDiff ℝ (n + 1) A) (x : Space d) (ij) : - ContDiff ℝ n (fun t => A.magneticFieldMatrix t x ij) := by - change ContDiff ℝ n (↿(fun t x => A.magneticFieldMatrix t x ij) ∘ fun t => (t, x)) + ContDiff ℝ n (fun t => A.magneticFieldMatrix c t x ij) := by + change ContDiff ℝ n (↿(fun t x => A.magneticFieldMatrix c t x ij) ∘ fun t => (t, x)) refine ContDiff.comp ?_ ?_ · exact magneticFieldMatrix_contDiff A hA ij · fun_prop @@ -390,27 +398,27 @@ lemma magneticFieldMatrix_time_contDiff {n} (A : ElectromagneticPotential d) -/ -lemma magneticFieldMatrix_differentiable (A : ElectromagneticPotential d) - (hA : ContDiff ℝ 2 A) (ij) : Differentiable ℝ ↿(fun t x => A.magneticFieldMatrix t x ij) := by +lemma magneticFieldMatrix_differentiable {c : SpeedOfLight} (A : ElectromagneticPotential d) + (hA : ContDiff ℝ 2 A) (ij) : Differentiable ℝ ↿(fun t x => A.magneticFieldMatrix c t x ij) := by simp [magneticFieldMatrix_eq] change Differentiable ℝ ((A.fieldStrengthMatrix · (Sum.inr ij.1, Sum.inr ij.2)) ∘ - toTimeAndSpace.symm) + (toTimeAndSpace c).symm) refine Differentiable.comp ?_ ?_ · exact fieldStrengthMatrix_differentiable (hA) - · exact ContinuousLinearEquiv.differentiable toTimeAndSpace.symm + · exact ContinuousLinearEquiv.differentiable (toTimeAndSpace c).symm -lemma magneticFieldMatrix_differentiable_space (A : ElectromagneticPotential d) +lemma magneticFieldMatrix_differentiable_space {c : SpeedOfLight} (A : ElectromagneticPotential d) (hA : ContDiff ℝ 2 A) (t : Time) (ij) : - Differentiable ℝ (fun x => A.magneticFieldMatrix t x ij) := by - change Differentiable ℝ (↿(fun t x => A.magneticFieldMatrix t x ij) ∘ fun x => (t, x)) + Differentiable ℝ (fun x => A.magneticFieldMatrix c t x ij) := by + change Differentiable ℝ (↿(fun t x => A.magneticFieldMatrix c t x ij) ∘ fun x => (t, x)) refine Differentiable.comp ?_ ?_ · exact magneticFieldMatrix_differentiable A hA ij · fun_prop -lemma magneticFieldMatrix_differentiable_time (A : ElectromagneticPotential d) +lemma magneticFieldMatrix_differentiable_time {c : SpeedOfLight} (A : ElectromagneticPotential d) (hA : ContDiff ℝ 2 A) (x : Space d) (ij) : - Differentiable ℝ (fun t => A.magneticFieldMatrix t x ij) := by - change Differentiable ℝ (↿(fun t x => A.magneticFieldMatrix t x ij) ∘ fun t => (t, x)) + Differentiable ℝ (fun t => A.magneticFieldMatrix c t x ij) := by + change Differentiable ℝ (↿(fun t x => A.magneticFieldMatrix c t x ij) ∘ fun t => (t, x)) refine Differentiable.comp ?_ ?_ · exact magneticFieldMatrix_differentiable A hA ij · fun_prop @@ -421,11 +429,11 @@ lemma magneticFieldMatrix_differentiable_time (A : ElectromagneticPotential d) -/ -lemma magneticFieldMatrix_space_deriv_eq (A : ElectromagneticPotential d) +lemma magneticFieldMatrix_space_deriv_eq {c : SpeedOfLight} (A : ElectromagneticPotential d) (hA : ContDiff ℝ 2 A) (t : Time) (x : Space d) (i j k : Fin d) : - ∂[k] (A.magneticFieldMatrix t · (i, j)) x = - ∂[i] (A.magneticFieldMatrix t · (k, j)) x - - ∂[j] (A.magneticFieldMatrix t · (k, i)) x := by + ∂[k] (A.magneticFieldMatrix c t · (i, j)) x = + ∂[i] (A.magneticFieldMatrix c t · (k, j)) x + - ∂[j] (A.magneticFieldMatrix c t · (k, i)) x := by conv_lhs => enter [2, x] rw [magneticFieldMatrix_eq_vectorPotential A (hA.differentiable (by simp)) t x i j] @@ -464,13 +472,13 @@ lemma magneticFieldMatrix_space_deriv_eq (A : ElectromagneticPotential d) -/ -lemma time_deriv_magneticFieldMatrix {d : ℕ} (A : ElectromagneticPotential d) +lemma time_deriv_magneticFieldMatrix {d : ℕ} {c : SpeedOfLight} (A : ElectromagneticPotential d) (hA : ContDiff ℝ 2 A) (t : Time) (x : Space d) (i j : Fin d) : - ∂ₜ (A.magneticFieldMatrix · x (i, j)) t = - ∂[i] (A.electricField t · j) x - ∂[j] (A.electricField t · i) x := by + ∂ₜ (A.magneticFieldMatrix c · x (i, j)) t = + ∂[i] (A.electricField c t · j) x - ∂[j] (A.electricField c t · i) x := by calc _ - _ = ∂ₜ (fun t => ∂[j] (fun x => A.vectorPotential t x i) x) t - - ∂ₜ (fun t => ∂[i] (fun x => A.vectorPotential t x j) x) t := by + _ = ∂ₜ (fun t => ∂[j] (fun x => A.vectorPotential c t x i) x) t + - ∂ₜ (fun t => ∂[i] (fun x => A.vectorPotential c t x j) x) t := by conv_lhs => enter [1, t] rw [magneticFieldMatrix_eq_vectorPotential _ (hA.differentiable (by simp))] @@ -478,15 +486,15 @@ lemma time_deriv_magneticFieldMatrix {d : ℕ} (A : ElectromagneticPotential d) rfl all_goals · apply Differentiable.differentiableAt - apply ClassicalMechanics.space_deriv_differentiable_time + apply Space.space_deriv_differentiable_time apply vectorPotential_comp_contDiff _ hA - _ = ∂[j] (fun x => ∂ₜ (fun t => A.vectorPotential t x i) t) x - - ∂[i] (fun x => ∂ₜ (fun t => A.vectorPotential t x j) t) x := by - rw [ClassicalMechanics.time_deriv_comm_space_deriv _] - rw [ClassicalMechanics.time_deriv_comm_space_deriv _] + _ = ∂[j] (fun x => ∂ₜ (fun t => A.vectorPotential c t x i) t) x + - ∂[i] (fun x => ∂ₜ (fun t => A.vectorPotential c t x j) t) x := by + rw [Space.time_deriv_comm_space_deriv _] + rw [Space.time_deriv_comm_space_deriv _] all_goals · apply vectorPotential_comp_contDiff _ hA - _ = ∂[i] (A.electricField t · j) x - ∂[j] (A.electricField t · i) x := by + _ = ∂[i] (A.electricField c t · j) x - ∂[j] (A.electricField c t · i) x := by conv_lhs => enter [1, 2, x] rw [time_deriv_comp_vectorPotential_eq_electricField (hA.differentiable (by simp))] @@ -498,7 +506,7 @@ lemma time_deriv_magneticFieldMatrix {d : ℕ} (A : ElectromagneticPotential d) (by apply Differentiable.differentiableAt apply Space.deriv_differentiable - exact scalarPotential_contDiff_space A hA t), fderiv_fun_neg] + exact scalarPotential_contDiff_space c A hA t), fderiv_fun_neg] conv_lhs => enter [2] rw [Space.deriv_eq_fderiv_basis, fderiv_fun_sub @@ -506,16 +514,186 @@ lemma time_deriv_magneticFieldMatrix {d : ℕ} (A : ElectromagneticPotential d) (by apply Differentiable.differentiableAt apply Space.deriv_differentiable - exact scalarPotential_contDiff_space A hA t), fderiv_fun_neg] + exact scalarPotential_contDiff_space c A hA t), fderiv_fun_neg] conv_lhs => enter [1] simp only [ContinuousLinearMap.coe_sub', Pi.sub_apply, ContinuousLinearMap.neg_apply] enter [2] rw [← Space.deriv_eq_fderiv_basis, Space.deriv_commute _ - (scalarPotential_contDiff_space A hA t)] + (scalarPotential_contDiff_space c A hA t)] simp [← Space.deriv_eq_fderiv_basis] ring +lemma time_deriv_time_deriv_magneticFieldMatrix {d : ℕ} {c : SpeedOfLight} + (A : ElectromagneticPotential d) + (hA : ContDiff ℝ 3 A) (t : Time) (x : Space d) (i j : Fin d) : + ∂ₜ (∂ₜ (A.magneticFieldMatrix c · x (i, j))) t = + ∂[i] (fun x => ∂ₜ (fun t => A.electricField c t x) t j) x - + ∂[j] (fun x => ∂ₜ (fun t => A.electricField c t x) t i) x := by + conv_lhs => + enter [1, t] + rw [time_deriv_magneticFieldMatrix A (hA.of_le (right_eq_inf.mp rfl)) t x i j] + rw [Time.deriv, fderiv_fun_sub] + simp [← Time.deriv_eq] + rw [Space.time_deriv_comm_space_deriv _] + rw [Space.time_deriv_comm_space_deriv _] + congr + · funext x + rw [Time.deriv_euclid] + apply electricField_differentiable_time (hA.of_le (right_eq_inf.mp rfl)) + · funext x + rw [Time.deriv_euclid] + apply electricField_differentiable_time (hA.of_le (right_eq_inf.mp rfl)) + · apply electricField_apply_contDiff hA + · apply electricField_apply_contDiff hA + · apply Differentiable.differentiableAt + apply Space.space_deriv_differentiable_time + apply electricField_apply_contDiff hA + · apply Differentiable.differentiableAt + apply Space.space_deriv_differentiable_time + apply electricField_apply_contDiff hA + +/-! + +### C.8. `curl` of the magnetic field matrix + +-/ + +lemma curl_magneticFieldMatrix_eq_electricField_fieldStrengthMatrix {d : ℕ} {c : SpeedOfLight} + (A : ElectromagneticPotential d) + (hA : ContDiff ℝ 2 A) (t : Time) (x : Space d) (i : Fin d) : + ∑ j, Space.deriv j (A.magneticFieldMatrix c t · (j, i)) x = + (1/c^2) * ∂ₜ (fun t => A.electricField c t x) t i + + (∑ (μ : (Fin 1 ⊕ Fin d)), (∂_ μ (A.fieldStrengthMatrix · (μ, Sum.inr i)) + ((toTimeAndSpace c).symm (t, x)))) := by + trans (1/c^2) * ∂ₜ (fun t => A.electricField c t x) t i + + (- (1/c^2) * ∂ₜ (fun t => A.electricField c t x) t i + + ∑ j, Space.deriv j (A.magneticFieldMatrix c t · (j, i)) x) + · ring + congr 1 + rw [Fintype.sum_sum_type] + congr + · simp + rw [time_deriv_electricField_eq_fieldStrengthMatrix hA t x i] + field_simp + · funext j + rw [SpaceTime.deriv_sum_inr c] + simp + rfl + · apply fieldStrengthMatrix_differentiable hA + end ElectromagneticPotential +/-! + +## D. Magnetic field matrix for distributions + +-/ + +namespace DistElectromagneticPotential +open TensorSpecies +open Tensor +open SpaceTime +open TensorProduct +open minkowskiMatrix SchwartzMap Lorentz +attribute [-simp] Fintype.sum_sum_type +attribute [-simp] Nat.succ_eq_add_one + +/-- The magnetic field matrix of an electromagnetic potential which is a distribution. -/ +noncomputable def magneticFieldMatrix {d} (c : SpeedOfLight) : + DistElectromagneticPotential d →ₗ[ℝ] + (Time × Space d) →d[ℝ] (EuclideanSpace ℝ (Fin d) ⊗[ℝ] EuclideanSpace ℝ (Fin d)) where + toFun A := + ⟨TensorProduct.map (Lorentz.Vector.spatialCLM d).toLinearMap + (Lorentz.Vector.spatialCLM d).toLinearMap, by continuity⟩ ∘L + distTimeSlice c A.fieldStrength + map_add' A1 A2 := by + ext ε + simp + map_smul' r A := by + ext ε + simp + +/-! + +### D.1. Magnetic field matrix in terms of vector potentials + +-/ + +lemma magneticFieldMatrix_eq_vectorPotential {c : SpeedOfLight} + (A : DistElectromagneticPotential d) + (ε : 𝓢(Time × Space d, ℝ)) : + A.magneticFieldMatrix c ε = ∑ i, ∑ j, + (Space.distSpaceDeriv j (A.vectorPotential c) ε i - + Space.distSpaceDeriv i (A.vectorPotential c) ε j) • + EuclideanSpace.basisFun (Fin d) ℝ i ⊗ₜ[ℝ] EuclideanSpace.basisFun (Fin d) ℝ j := by + simp only [magneticFieldMatrix, LinearMap.coe_mk, AddHom.coe_mk, ContinuousLinearMap.coe_comp', + ContinuousLinearMap.coe_mk', Function.comp_apply, distTimeSlice_apply, fieldStrength_eq_basis, + Fintype.sum_sum_type, Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, + Finset.sum_singleton, inl_0_inl_0, one_mul, inr_i_inr_i, neg_mul, sub_neg_eq_add, sub_self, + zero_smul, zero_add, map_add, map_sum, map_smul, map_tmul, ContinuousLinearMap.coe_coe, + Lorentz.Vector.spatialCLM_basis_sum_inl, Lorentz.Vector.spatialCLM_basis_sum_inr, + EuclideanSpace.basisFun_apply, zero_tmul, smul_zero, Finset.sum_const_zero, tmul_zero] + simp [← distTimeSlice_apply, distTimeSlice_distDeriv_inr, vectorPotential, + Space.distSpaceDeriv_apply_CLM, Lorentz.Vector.spatialCLM, neg_add_eq_sub] + +lemma magneticFieldMatrix_basis_repr_eq_vector_potential {c : SpeedOfLight} + (A : DistElectromagneticPotential d) + (ε : 𝓢(Time × Space d, ℝ)) (i j : Fin d) : + ((PiLp.basisFun 2 ℝ (Fin d)).tensorProduct (PiLp.basisFun 2 ℝ (Fin d))).repr + (A.magneticFieldMatrix c ε) (i, j) = + Space.distSpaceDeriv j (A.vectorPotential c) ε i - + Space.distSpaceDeriv i (A.vectorPotential c) ε j := by + rw [magneticFieldMatrix_eq_vectorPotential] + simp + +lemma magneticFieldMatrix_distSpaceDeriv_basis_repr_eq_vector_potential {c : SpeedOfLight} + (A : DistElectromagneticPotential d) + (ε : 𝓢(Time × Space d, ℝ)) (i j k : Fin d) : + ((PiLp.basisFun 2 ℝ (Fin d)).tensorProduct (PiLp.basisFun 2 ℝ (Fin d))).repr + (Space.distSpaceDeriv k (A.magneticFieldMatrix c) ε) (i, j) = + Space.distSpaceDeriv k (Space.distSpaceDeriv j (A.vectorPotential c)) ε i - + Space.distSpaceDeriv k (Space.distSpaceDeriv i (A.vectorPotential c)) ε j := by + simp [Space.distSpaceDeriv_apply', magneticFieldMatrix_basis_repr_eq_vector_potential] + ring + +/-! + +### D.2. The magnetic field matrix in terms of the field strength + +-/ + +lemma magneticFieldMatrix_basis_repr_eq_fieldStrength {c : SpeedOfLight} + (A : DistElectromagneticPotential d) + (ε : 𝓢(Time × Space d, ℝ)) (i j : Fin d) : + ((PiLp.basisFun 2 ℝ (Fin d)).tensorProduct (PiLp.basisFun 2 ℝ (Fin d))).repr + (A.magneticFieldMatrix c ε) (i, j) = + (Lorentz.Vector.basis.tensorProduct Lorentz.Vector.basis).repr + (distTimeSlice c A.fieldStrength ε) (Sum.inr i, Sum.inr j) := by + simp only [magneticFieldMatrix_eq_vectorPotential, EuclideanSpace.basisFun_apply, map_sum, + map_smul, Finsupp.coe_finset_sum, Finsupp.coe_smul, Finset.sum_apply, Pi.smul_apply, + Basis.tensorProduct_repr_tmul_apply, PiLp.basisFun_repr, EuclideanSpace.single_apply, + smul_eq_mul, mul_ite, mul_one, mul_zero, Finset.sum_ite_irrel, Finset.sum_ite_eq, + Finset.mem_univ, ↓reduceIte, Finset.sum_const_zero, distTimeSlice_apply, + fieldStrength_basis_repr_eq_single, inr_i_inr_i, neg_mul, one_mul, sub_neg_eq_add] + simp only [vectorPotential, Vector.spatialCLM, LinearMap.coe_mk, AddHom.coe_mk, + Space.distSpaceDeriv_apply_CLM, ContinuousLinearMap.coe_comp', ContinuousLinearMap.coe_mk', + Function.comp_apply, ← distTimeSlice_apply, distTimeSlice_distDeriv_inr] + ring + +/-! + +### D.3. Magnetic field matrix in 1d + +-/ + +@[simp] +lemma magneticFieldMatrix_one_dim_eq_zero {c : SpeedOfLight} + (A : DistElectromagneticPotential 1) : + A.magneticFieldMatrix c = 0 := by + ext ε + rw [magneticFieldMatrix_eq_vectorPotential] + simp + +end DistElectromagneticPotential end Electromagnetism diff --git a/PhysLean/Electromagnetism/Kinematics/ScalarPotential.lean b/PhysLean/Electromagnetism/Kinematics/ScalarPotential.lean index 8f1494492..6d4a3f722 100644 --- a/PhysLean/Electromagnetism/Kinematics/ScalarPotential.lean +++ b/PhysLean/Electromagnetism/Kinematics/ScalarPotential.lean @@ -4,9 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Electromagnetism.Kinematics.EMPotential -import PhysLean.SpaceAndTime.SpaceTime.TimeSlice -import PhysLean.Relativity.Tensors.RealTensor.CoVector.Basic -import PhysLean.Mathematics.VariationalCalculus.HasVarGradient /-! # The Scalar Potential @@ -18,8 +15,6 @@ The electromagnetic potential is given by where `φ` is the scalar potential and `\vec A` is the vector potential. In this module we define the scalar potential, and prove lemmas about it. -In our current implementation `c = 1` so the scalar potential is simply given -by the time component of the electromagnetic potential. Since `A` is relativistic it is a function of `SpaceTime d`, whilst the scalar potential is non-relativistic and is therefore a function of `Time` and `Space d`. @@ -28,12 +23,15 @@ the scalar potential is non-relativistic and is therefore a function of `Time` a - `ElectromagneticPotential.scalarPotential` : The scalar potential from an electromagnetic potential. +- `DistElectromagneticPotential.scalarPotential` : The scalar potential from an + electromagnetic potential which is a distribution. ## iii. Table of contents - A. Definition of the Scalar Potential - B. Smoothness of the Scalar Potential - C. Differentiability of the Scalar Potential +- D. Scalar potential for distributions ## iv. References @@ -61,9 +59,9 @@ attribute [-simp] Nat.succ_eq_add_one -/ /-- The scalar potential from the electromagnetic potential. -/ -noncomputable def scalarPotential {d} (A : ElectromagneticPotential d) : - Time → Space d → ℝ := timeSlice <| - fun x => A x (Sum.inl 0) +noncomputable def scalarPotential {d} (c : SpeedOfLight := 1) (A : ElectromagneticPotential d) : + Time → Space d → ℝ := timeSlice c <| + fun x => c * A x (Sum.inl 0) /-! @@ -73,27 +71,30 @@ We prove various lemmas about the smoothness of the scalar potential. -/ -lemma scalarPotential_contDiff {n} {d} (A : ElectromagneticPotential d) - (hA : ContDiff ℝ n A) : ContDiff ℝ n ↿A.scalarPotential := by +lemma scalarPotential_contDiff {n} {d} (c : SpeedOfLight) (A : ElectromagneticPotential d) + (hA : ContDiff ℝ n A) : ContDiff ℝ n ↿(A.scalarPotential c) := by simp [scalarPotential] apply timeSlice_contDiff have h1 : ∀ i, ContDiff ℝ n (fun x => A x i) := by - rw [← contDiff_euclidean] + rw [SpaceTime.contDiff_vector] exact hA + apply ContDiff.mul + · fun_prop exact h1 (Sum.inl 0) -lemma scalarPotential_contDiff_space {n} {d} (A : ElectromagneticPotential d) - (hA : ContDiff ℝ n A) (t : Time) : ContDiff ℝ n (A.scalarPotential t) := by - change ContDiff ℝ n (↿A.scalarPotential ∘ fun x => (t, x)) +lemma scalarPotential_contDiff_space {n} {d} (c : SpeedOfLight) + (A : ElectromagneticPotential d) + (hA : ContDiff ℝ n A) (t : Time) : ContDiff ℝ n (A.scalarPotential c t) := by + change ContDiff ℝ n (↿(A.scalarPotential c) ∘ fun x => (t, x)) refine ContDiff.comp ?_ ?_ - · exact scalarPotential_contDiff A hA + · exact scalarPotential_contDiff c A hA · fun_prop -lemma scalarPotential_contDiff_time {n} {d} (A : ElectromagneticPotential d) - (hA : ContDiff ℝ n A) (x : Space d) : ContDiff ℝ n (A.scalarPotential · x) := by - change ContDiff ℝ n (↿A.scalarPotential ∘ fun t => (t, x)) +lemma scalarPotential_contDiff_time {n} {d} (c : SpeedOfLight) (A : ElectromagneticPotential d) + (hA : ContDiff ℝ n A) (x : Space d) : ContDiff ℝ n (A.scalarPotential c · x) := by + change ContDiff ℝ n (↿(A.scalarPotential c) ∘ fun t => (t, x)) refine ContDiff.comp ?_ ?_ - · exact scalarPotential_contDiff A hA + · exact scalarPotential_contDiff c A hA · fun_prop /-! @@ -104,29 +105,62 @@ We prove various lemmas about the differentiability of the scalar potential. -/ -lemma scalarPotential_differentiable {d} (A : ElectromagneticPotential d) - (hA : Differentiable ℝ A) : Differentiable ℝ ↿A.scalarPotential := by +lemma scalarPotential_differentiable {d} (c : SpeedOfLight) (A : ElectromagneticPotential d) + (hA : Differentiable ℝ A) : Differentiable ℝ ↿(A.scalarPotential c) := by simp [scalarPotential] apply timeSlice_differentiable have h1 : ∀ i, Differentiable ℝ (fun x => A x i) := by - rw [← differentiable_euclidean] + rw [SpaceTime.differentiable_vector] exact hA + apply Differentiable.mul + · fun_prop exact h1 (Sum.inl 0) -lemma scalarPotential_differentiable_space {d} (A : ElectromagneticPotential d) - (hA : Differentiable ℝ A) (t : Time) : Differentiable ℝ (A.scalarPotential t) := by - change Differentiable ℝ (↿A.scalarPotential ∘ fun x => (t, x)) +lemma scalarPotential_differentiable_space {d} (c : SpeedOfLight) (A : ElectromagneticPotential d) + (hA : Differentiable ℝ A) (t : Time) : Differentiable ℝ (A.scalarPotential c t) := by + change Differentiable ℝ (↿(A.scalarPotential c) ∘ fun x => (t, x)) refine Differentiable.comp ?_ ?_ - · exact scalarPotential_differentiable A hA + · exact scalarPotential_differentiable c A hA · fun_prop -lemma scalarPotential_differentiable_time {d} (A : ElectromagneticPotential d) - (hA : Differentiable ℝ A) (x : Space d) : Differentiable ℝ (A.scalarPotential · x) := by - change Differentiable ℝ (↿A.scalarPotential ∘ fun t => (t, x)) +lemma scalarPotential_differentiable_time {d} (c : SpeedOfLight) (A : ElectromagneticPotential d) + (hA : Differentiable ℝ A) (x : Space d) : Differentiable ℝ (A.scalarPotential c · x) := by + change Differentiable ℝ (↿(A.scalarPotential c) ∘ fun t => (t, x)) refine Differentiable.comp ?_ ?_ - · exact scalarPotential_differentiable A hA + · exact scalarPotential_differentiable c A hA · fun_prop end ElectromagneticPotential +/-! + +## D. Scalar potential for distributions + +-/ + +namespace DistElectromagneticPotential +open TensorSpecies +open Tensor +open SpaceTime +open TensorProduct +open minkowskiMatrix +attribute [-simp] Fintype.sum_sum_type +attribute [-simp] Nat.succ_eq_add_one + +/-- The scalar potential of an electromagnetic potential which is a distribution. -/ +noncomputable def scalarPotential {d} (c : SpeedOfLight) : + DistElectromagneticPotential d →ₗ[ℝ] + (Time × Space d) →d[ℝ] ℝ where + toFun A := Lorentz.Vector.temporalCLM d ∘L distTimeSlice c (c.val • A) + map_add' A₁ A₂ := by + ext ε + simp [distTimeSlice] + map_smul' r A := by + ext ε + simp only [distTimeSlice, map_smul, ContinuousLinearEquiv.coe_mk, LinearEquiv.coe_mk, + LinearMap.coe_mk, AddHom.coe_mk, ContinuousLinearMap.coe_comp', ContinuousLinearMap.coe_smul', + Function.comp_apply, Pi.smul_apply, smul_eq_mul, Real.ringHom_apply] + ring + +end DistElectromagneticPotential end Electromagnetism diff --git a/PhysLean/Electromagnetism/Kinematics/VectorPotential.lean b/PhysLean/Electromagnetism/Kinematics/VectorPotential.lean index ef0345324..d8cb943d9 100644 --- a/PhysLean/Electromagnetism/Kinematics/VectorPotential.lean +++ b/PhysLean/Electromagnetism/Kinematics/VectorPotential.lean @@ -4,9 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Electromagnetism.Kinematics.EMPotential -import PhysLean.SpaceAndTime.SpaceTime.TimeSlice -import PhysLean.Relativity.Tensors.RealTensor.CoVector.Basic -import PhysLean.Mathematics.VariationalCalculus.HasVarGradient /-! # The vector Potential @@ -26,12 +23,15 @@ the vector potential is non-relativistic and is therefore a function of `Time` a - `ElectromagneticPotential.vectorPotential` : The vector potential from an electromagnetic potential. +- `DistElectromagneticPotential.vectorPotential` : The vector potential from an + electromagnetic potential which is a distribution. ## iii. Table of contents - A. Definition of the Vector Potential - B. Smoothness of the vector potential - C. Differentiablity of the vector potential +- D. Vector potential for distributions ## iv. References @@ -60,9 +60,9 @@ attribute [-simp] Nat.succ_eq_add_one -/ /-- The vector potential from the electromagnetic potential. -/ -noncomputable def vectorPotential {d} (A : ElectromagneticPotential d) : - Time → Space d → EuclideanSpace ℝ (Fin d) := timeSlice <| - fun x i => A x (Sum.inr i) +noncomputable def vectorPotential {d} (c : SpeedOfLight := 1) (A : ElectromagneticPotential d) : + Time → Space d → EuclideanSpace ℝ (Fin d) := timeSlice c <| + fun x => WithLp.toLp 2 fun i => A x (Sum.inr i) /-! @@ -73,48 +73,49 @@ the smoothness of the electromagnetic potential. -/ -lemma vectorPotential_contDiff {n} {d} (A : ElectromagneticPotential d) - (hA : ContDiff ℝ n A) : ContDiff ℝ n ↿A.vectorPotential := by +lemma vectorPotential_contDiff {n} {d} {c : SpeedOfLight} (A : ElectromagneticPotential d) + (hA : ContDiff ℝ n A) : ContDiff ℝ n ↿(A.vectorPotential c) := by simp [vectorPotential] apply timeSlice_contDiff refine contDiff_euclidean.mpr ?_ have h1 : ∀ i, ContDiff ℝ n (fun x => A x i) := by - rw [← contDiff_euclidean] + rw [SpaceTime.contDiff_vector] exact hA exact fun i => h1 (Sum.inr i) -lemma vectorPotential_apply_contDiff {n} {d} (A : ElectromagneticPotential d) - (hA : ContDiff ℝ n A) (i : Fin d) : ContDiff ℝ n ↿(fun t x => A.vectorPotential t x i) := by - change ContDiff ℝ n (EuclideanSpace.proj i ∘ ↿A.vectorPotential) +lemma vectorPotential_apply_contDiff {n} {d} {c : SpeedOfLight} (A : ElectromagneticPotential d) + (hA : ContDiff ℝ n A) (i : Fin d) : ContDiff ℝ n ↿(fun t x => A.vectorPotential c t x i) := by + change ContDiff ℝ n (EuclideanSpace.proj i ∘ ↿(A.vectorPotential c)) refine ContDiff.comp ?_ ?_ · exact ContinuousLinearMap.contDiff (𝕜 := ℝ) (n := n) (EuclideanSpace.proj i) · exact vectorPotential_contDiff A hA -lemma vectorPotential_comp_contDiff {n} {d} (A : ElectromagneticPotential d) - (hA : ContDiff ℝ n A) (i : Fin d) : ContDiff ℝ n ↿(fun t x => A.vectorPotential t x i) := by - change ContDiff ℝ n (EuclideanSpace.proj i ∘ ↿A.vectorPotential) +lemma vectorPotential_comp_contDiff {n} {d} {c : SpeedOfLight} (A : ElectromagneticPotential d) + (hA : ContDiff ℝ n A) (i : Fin d) : ContDiff ℝ n ↿(fun t x => A.vectorPotential c t x i) := by + change ContDiff ℝ n (EuclideanSpace.proj i ∘ ↿(A.vectorPotential c)) refine ContDiff.comp ?_ ?_ · exact ContinuousLinearMap.contDiff (𝕜 := ℝ) (n := n) (EuclideanSpace.proj i) · exact vectorPotential_contDiff A hA -lemma vectorPotential_contDiff_space {n} {d} (A : ElectromagneticPotential d) - (hA : ContDiff ℝ n A) (t : Time) : ContDiff ℝ n (A.vectorPotential t) := by - change ContDiff ℝ n (↿A.vectorPotential ∘ fun x => (t, x)) +lemma vectorPotential_contDiff_space {n} {d} {c : SpeedOfLight} (A : ElectromagneticPotential d) + (hA : ContDiff ℝ n A) (t : Time) : ContDiff ℝ n (A.vectorPotential c t) := by + change ContDiff ℝ n (↿(A.vectorPotential c) ∘ fun x => (t, x)) refine ContDiff.comp ?_ ?_ · exact vectorPotential_contDiff A hA · fun_prop -lemma vectorPotential_apply_contDiff_space {n} {d} (A : ElectromagneticPotential d) +lemma vectorPotential_apply_contDiff_space {n} {d} {c : SpeedOfLight} + (A : ElectromagneticPotential d) (hA : ContDiff ℝ n A) (t : Time) (i : Fin d) : - ContDiff ℝ n (fun x => A.vectorPotential t x i) := by - change ContDiff ℝ n (EuclideanSpace.proj i ∘ (↿A.vectorPotential ∘ fun x => (t, x))) + ContDiff ℝ n (fun x => A.vectorPotential c t x i) := by + change ContDiff ℝ n (EuclideanSpace.proj i ∘ (↿(A.vectorPotential c) ∘ fun x => (t, x))) refine ContDiff.comp ?_ ?_ · exact ContinuousLinearMap.contDiff (𝕜 := ℝ) (n := n) (EuclideanSpace.proj i) · exact vectorPotential_contDiff_space A hA t -lemma vectorPotential_contDiff_time {n} {d} (A : ElectromagneticPotential d) - (hA : ContDiff ℝ n A) (x : Space d) : ContDiff ℝ n (A.vectorPotential · x) := by - change ContDiff ℝ n (↿A.vectorPotential ∘ fun t => (t, x)) +lemma vectorPotential_contDiff_time {n} {d} {c : SpeedOfLight} (A : ElectromagneticPotential d) + (hA : ContDiff ℝ n A) (x : Space d) : ContDiff ℝ n (A.vectorPotential c · x) := by + change ContDiff ℝ n (↿(A.vectorPotential c) ∘ fun t => (t, x)) refine ContDiff.comp ?_ ?_ · exact vectorPotential_contDiff A hA · fun_prop @@ -128,23 +129,55 @@ the differentiablity of the electromagnetic potential. -/ -lemma vectorPotential_differentiable {d} (A : ElectromagneticPotential d) - (hA : Differentiable ℝ A) : Differentiable ℝ ↿A.vectorPotential := by +lemma vectorPotential_differentiable {d} {c : SpeedOfLight} (A : ElectromagneticPotential d) + (hA : Differentiable ℝ A) : Differentiable ℝ ↿(A.vectorPotential c) := by simp [vectorPotential] apply timeSlice_differentiable refine differentiable_euclidean.mpr ?_ have h1 : ∀ i, Differentiable ℝ (fun x => A x i) := by - rw [← differentiable_euclidean] + rw [SpaceTime.differentiable_vector] exact hA exact fun i => h1 (Sum.inr i) -lemma vectorPotential_differentiable_time {d} (A : ElectromagneticPotential d) - (hA : Differentiable ℝ A) (x : Space d) : Differentiable ℝ (A.vectorPotential · x) := by - change Differentiable ℝ (↿A.vectorPotential ∘ fun t => (t, x)) +lemma vectorPotential_differentiable_time {d} {c : SpeedOfLight} (A : ElectromagneticPotential d) + (hA : Differentiable ℝ A) (x : Space d) : Differentiable ℝ (A.vectorPotential c · x) := by + change Differentiable ℝ (↿(A.vectorPotential c) ∘ fun t => (t, x)) refine Differentiable.comp ?_ ?_ · exact vectorPotential_differentiable A hA · fun_prop end ElectromagneticPotential +/-! + +## D. Vector potential for distributions + +-/ + +namespace DistElectromagneticPotential +open TensorSpecies +open Tensor +open SpaceTime +open TensorProduct +open minkowskiMatrix SchwartzMap +attribute [-simp] Fintype.sum_sum_type +attribute [-simp] Nat.succ_eq_add_one + +/-- The vector potential of an electromagnetic potential which is a distribution. -/ +noncomputable def vectorPotential {d} (c : SpeedOfLight) : + DistElectromagneticPotential d →ₗ[ℝ] + (Time × Space d) →d[ℝ] EuclideanSpace ℝ (Fin d) where + toFun A := Lorentz.Vector.spatialCLM d ∘L distTimeSlice c A + map_add' A₁ A₂ := by + ext ε + simp [distTimeSlice] + map_smul' r A := by + ext ε i + simp only [distTimeSlice, map_smul, ContinuousLinearEquiv.coe_mk, LinearEquiv.coe_mk, + LinearMap.coe_mk, AddHom.coe_mk, ContinuousLinearMap.coe_smul', ContinuousLinearMap.coe_comp', + Pi.smul_apply, Function.comp_apply, + Real.ringHom_apply, PiLp.smul_apply, smul_eq_mul] + +end DistElectromagneticPotential + end Electromagnetism diff --git a/PhysLean/Electromagnetism/MaxwellEquations.lean b/PhysLean/Electromagnetism/MaxwellEquations.lean deleted file mode 100644 index 8a8b4d13c..000000000 --- a/PhysLean/Electromagnetism/MaxwellEquations.lean +++ /dev/null @@ -1,61 +0,0 @@ -/- -Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Tooby-Smith --/ -import PhysLean.Electromagnetism.Basic -/-! - -# Maxwell's equations - -Note that currently the equations are defined for isotropic and homogeneous domains. - -This module is old, and will soon be replaced. --/ - -namespace Electromagnetism - -/-- An optical medium refers to an isotropic medium - (which may or may not be free space) - which consists of the electric permittivity - and the magnetic permeability. -/ -structure OpticalMedium where - /-- The permittivity. -/ - ε : ℝ - /-- The permeability. -/ - μ : ℝ - eps_ge_zero : ε > 0 - mu_ge_zero : μ > 0 - -variable (𝓔 : OpticalMedium) (ρ : ChargeDensity) (J : CurrentDensity) -open SpaceTime - -local notation "ε" => 𝓔.ε -local notation "μ" => 𝓔.μ -open Time - -/-- Gauss's law for the Electric field. -/ -def GaussLawElectric (E : ElectricField) : Prop := - ∀ t : Time, ∀ x : Space, ε * (∇ ⬝ E t) x = ρ t x - -/-- Gauss's law for the Magnetic field. -/ -def GaussLawMagnetic (B : MagneticField) : Prop := - ∀ t : Time, ∀ x : Space, (∇ ⬝ B t) x = 0 - -/-- Ampère's law. -/ -def AmpereLaw (E : ElectricField) (B : MagneticField) : Prop := - ∀ t : Time, ∀ x : Space, (∇ × B t) x = μ • (J t x + ε • ∂ₜ (fun t => E t x) t) - -/-- Faraday's law. -/ -def FaradayLaw (E : ElectricField) (B : MagneticField) : Prop := - ∀ t : Time, ∀ x : Space, (∇ × E t) x = - ∂ₜ (fun t => B t x) t - -/-- Maxwell's equations. -/ -def MaxwellEquations (E : ElectricField) (B : MagneticField) : Prop := - GaussLawElectric 𝓔 ρ E ∧ GaussLawMagnetic B ∧ - AmpereLaw 𝓔 J E B ∧ FaradayLaw E B - -TODO "6V2VD" "Show that if the charge density is spherically symmetric, - then the electric field is also spherically symmetric." - -end Electromagnetism diff --git a/PhysLean/Electromagnetism/PointParticle/FiniteCollection.lean b/PhysLean/Electromagnetism/PointParticle/FiniteCollection.lean deleted file mode 100644 index 9193c5d07..000000000 --- a/PhysLean/Electromagnetism/PointParticle/FiniteCollection.lean +++ /dev/null @@ -1,65 +0,0 @@ -/- -Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Tooby-Smith --/ -import PhysLean.Electromagnetism.PointParticle.ThreeDimension -/-! - -# Finite collection of point particles in 3d - -This module contains the electrostatics of a finite collection of point particles. -Since Gauss' law and Faraday's law are linear, the electrostatic potential and electric field -of a finite collection of point particles is just the sum of the potentials and fields of the -individual particles. - --/ - -namespace Electromagnetism -open Distribution SchwartzMap - -namespace ThreeDimDiscreteCollection -open Space StaticElectricField MeasureTheory Real InnerProductSpace -noncomputable section - -/-- The charge distribution for a finite collection of point particles. -/ -def chargeDistribution {n : ℕ} (q : Fin n → ℝ) (r₀ : Fin n → Space) : ChargeDistribution 3 := - ∑ i, (q i) • diracDelta ℝ (r₀ i) - -/-- The electrostatic potential of a finite collection of point particles. -/ -def electricPotential {n : ℕ} (q : Fin n → ℝ) (ε : ℝ) (r₀ : Fin n → Space) : - StaticElectricPotential 3 := - ∑ i, ThreeDimPointParticle.electricPotential (q i) ε (r₀ i) - -/-- The electric field of a finite collection of point particles. -/ -def electricField {n : ℕ} (q : Fin n → ℝ) (ε : ℝ) (r₀ : Fin n → Space) : StaticElectricField 3 := - ∑ i, ThreeDimPointParticle.electricField (q i) ε (r₀ i) - -lemma electricField_eq_neg_gradD_electricPotential {n : ℕ} (q : Fin n → ℝ) (ε : ℝ) - (r₀ : Fin n → Space) : - electricField q ε r₀ = - Space.gradD (electricPotential q ε r₀) := by - simp [electricField, electricPotential, - ThreeDimPointParticle.electricField_eq_neg_gradD_electricPotential] - -lemma electricField_eq_ofPotential_electricPotential {n : ℕ} (q : Fin n → ℝ) (ε : ℝ) - (r₀ : Fin n → Space) : - electricField q ε r₀ = ofPotential (electricPotential q ε r₀) := - electricField_eq_neg_gradD_electricPotential q ε r₀ - -/-- Gauss's law for a finite collection of point particles. -/ -lemma gaussLaw {n : ℕ} (q : Fin n → ℝ) (ε : ℝ) - (r₀ : Fin n → Space) : - (electricField q ε r₀).GaussLaw ε (chargeDistribution q r₀) := by - simp [electricField, chargeDistribution, GaussLaw, Finset.smul_sum] - congr - funext i - simpa [GaussLaw] using ThreeDimPointParticle.gaussLaw (q i) ε (r₀ i) - -/-- Faraday's law for a finite collection of point particles. -/ -lemma faradaysLaw {n : ℕ} (q : Fin n → ℝ) (ε : ℝ) - (r₀ : Fin n → Space) : - (electricField q ε r₀).FaradaysLaw := by - simp [electricField, FaradaysLaw] - apply Finset.sum_eq_zero - intro i _ - simpa [FaradaysLaw] using ThreeDimPointParticle.faradaysLaw (q i) ε (r₀ i) diff --git a/PhysLean/Electromagnetism/PointParticle/OneDimension.lean b/PhysLean/Electromagnetism/PointParticle/OneDimension.lean index 1e742bbce..e8f72a743 100644 --- a/PhysLean/Electromagnetism/PointParticle/OneDimension.lean +++ b/PhysLean/Electromagnetism/PointParticle/OneDimension.lean @@ -3,10 +3,10 @@ Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ -import PhysLean.Electromagnetism.Electrostatics.Basic -import PhysLean.Electromagnetism.Distributions.Potential -import PhysLean.SpaceAndTime.Space.Distributions.ConstantTime -import PhysLean.Mathematics.Distribution.PowMul +import PhysLean.Electromagnetism.Dynamics.IsExtrema +import PhysLean.SpaceAndTime.Space.Norm +import PhysLean.SpaceAndTime.Space.Translations +import PhysLean.SpaceAndTime.TimeAndSpace.ConstantTimeDist /-! # The electrostatics of a stationary point particle in 1d @@ -16,30 +16,24 @@ import PhysLean.Mathematics.Distribution.PowMul In this module we give the electromagnetic properties of a point particle sitting at the origin in 1d space. -The electric field is given by the Heaviside step function, and the scalar potential -is given by a function proportional to the absolute value of the distance from the particle. - ## ii. Key results -- `oneDimPointParticleCurrentDensity` : The Lorentz current density of a point particle - stationary at the origin of 1d space. - `oneDimPointParticle` : The electromagnetic potential of a point particle stationary at the origin of 1d space. -- `oneDimPointParticle_gradLagrangian` : The variational gradient of the Lagrangian - for a point particle stationary at the origin of 1d space is zero for the - given electromagnetic potential. (i.e. Maxwell's equations are satisfied). +- `oneDimPointParticle_isExterma` : The electric field of a point + particle stationary at the origin of 1d space satisfies Maxwell's equations ## iii. Table of contents -- A. The electromagnetic potential +- A. The current density - B. The Potentials - B.1. The electromagnetic potential - B.2. The vector potential is zero - B.3. The scalar potential - C. The electric field -- D. Maxwell's equations - - D.1. Gauss' law - - D.2. The variational gradient of the Lagrangian is zero + - C.1. The time derivative of the electric field +- D. The magnetic field +- E. Maxwell's equations ## iv. References @@ -47,21 +41,50 @@ is given by a function proportional to the absolute value of the distance from t namespace Electromagnetism open Distribution SchwartzMap -open Space StaticElectricField MeasureTheory +open Space MeasureTheory +namespace DistElectromagneticPotential /-! -## A. The electromagnetic potential +## A. The current density -/ -/-- The current density of of a point particle stationary at the origin +/-- The current density of a point particle stationary at the origin of 1d space. -/ -noncomputable def oneDimPointParticleCurrentDensity (q : ℝ) : LorentzCurrentDensityD 1 := - LorentzCurrentDensityD.toComponents.symm fun μ => - match μ with - | Sum.inl 0 => SpaceTime.timeSliceD.symm <| constantTime (q • diracDelta ℝ 0) - | Sum.inr _ => 0 +noncomputable def oneDimPointParticleCurrentDensity (c : SpeedOfLight) (q : ℝ) (r₀ : Space 1) : + DistLorentzCurrentDensity 1 := (SpaceTime.distTimeSlice c).symm <| + constantTime ((c * q) • diracDelta' ℝ r₀ (Lorentz.Vector.basis (Sum.inl 0))) + +lemma oneDimPointParticleCurrentDensity_eq_distTranslate (c : SpeedOfLight) (q : ℝ) (r₀ : Space 1) : + oneDimPointParticleCurrentDensity c q r₀ = ((SpaceTime.distTimeSlice c).symm <| + constantTime <| + distTranslate (basis.repr r₀) <| + ((c * q) • diracDelta' ℝ 0 (Lorentz.Vector.basis (Sum.inl 0)))) := by + rw [oneDimPointParticleCurrentDensity] + congr + ext η + simp [distTranslate_apply] + +@[simp] +lemma oneDimPointParticleCurrentDensity_currentDensity (c : SpeedOfLight) (q : ℝ) (r₀ : Space 1) : + (oneDimPointParticleCurrentDensity c q r₀).currentDensity c = 0 := by + ext ε i + simp [oneDimPointParticleCurrentDensity, DistLorentzCurrentDensity.currentDensity, + Lorentz.Vector.spatialCLM, constantTime_apply] + +@[simp] +lemma oneDimPointParticleCurrentDensity_chargeDensity (c : SpeedOfLight) (q : ℝ) (r₀ : Space 1) : + (oneDimPointParticleCurrentDensity c q r₀).chargeDensity c = + constantTime (q • diracDelta ℝ r₀) := by + ext ε + simp only [DistLorentzCurrentDensity.chargeDensity, one_div, Lorentz.Vector.temporalCLM, + Fin.isValue, oneDimPointParticleCurrentDensity, map_smul, LinearMap.coe_mk, AddHom.coe_mk, + ContinuousLinearEquiv.apply_symm_apply, ContinuousLinearMap.coe_smul', + ContinuousLinearMap.coe_comp', LinearMap.coe_toContinuousLinearMap', Pi.smul_apply, + Function.comp_apply, constantTime_apply, diracDelta'_apply, Lorentz.Vector.apply_smul, + Lorentz.Vector.basis_apply, ↓reduceIte, mul_one, smul_eq_mul, diracDelta_apply] + field_simp /-! @@ -75,32 +98,36 @@ noncomputable def oneDimPointParticleCurrentDensity (q : ℝ) : LorentzCurrentDe -/ -/-- The electromagnetic potential of a point particle stationary at the origin +/-- The electromagnetic potential of a point particle stationary at `r₀` of 1d space. -/ -noncomputable def oneDimPointParticle (q : ℝ) : ElectromagneticPotentialD 1 := - ElectromagneticPotentialD.toComponents.symm fun μ => - match μ with - | Sum.inl 0 => SpaceTime.timeSliceD.symm <| Space.constantTime - (- Distribution.ofFunction (fun x => (q/(2)) • ‖x‖) - (by - apply IsDistBounded.const_smul - convert IsDistBounded.pow (n := 1) (by simp) - simp) - (by fun_prop)) - | Sum.inr i => 0 +noncomputable def oneDimPointParticle (𝓕 : FreeSpace) (q : ℝ) (r₀ : Space 1) : + DistElectromagneticPotential 1 := (SpaceTime.distTimeSlice 𝓕.c).symm <| Space.constantTime <| + distOfFunction (fun x => ((- (q * 𝓕.μ₀ * 𝓕.c)/ 2) * ‖x - r₀‖) • Lorentz.Vector.basis (Sum.inl 0)) + (by fun_prop) + +lemma oneDimPointParticle_eq_distTranslate (𝓕 : FreeSpace) (q : ℝ) (r₀ : Space 1) : + oneDimPointParticle 𝓕 q r₀ = ((SpaceTime.distTimeSlice 𝓕.c).symm <| + constantTime <| + distTranslate (basis.repr r₀) <| + distOfFunction (fun x => ((- (q * 𝓕.μ₀ * 𝓕.c)/ 2) * ‖x‖) • Lorentz.Vector.basis (Sum.inl 0)) + (by fun_prop)) := by + rw [oneDimPointParticle] + congr + ext η + simp [distTranslate_ofFunction] -/-! +/- ### B.2. The vector potential is zero -/ @[simp] -lemma oneDimPointParticle_vectorPotential (q : ℝ) : - (oneDimPointParticle q).vectorPotential = 0 := by - rw [Electromagnetism.ElectromagneticPotentialD.vectorPotential] - ext i - simp [oneDimPointParticle] +lemma oneDimPointParticle_vectorPotential (𝓕 : FreeSpace) (q : ℝ) (r₀ : Space 1) : + (oneDimPointParticle 𝓕 q r₀).vectorPotential 𝓕.c = 0 := by + ext ε i + simp [vectorPotential, Lorentz.Vector.spatialCLM, + oneDimPointParticle, constantTime_apply, distOfFunction_vector_eval] /-! @@ -108,17 +135,22 @@ lemma oneDimPointParticle_vectorPotential (q : ℝ) : -/ -lemma oneDimPointParticle_scalarPotential (q : ℝ) : - (oneDimPointParticle q).scalarPotential = - Space.constantTime (- Distribution.ofFunction (fun x => (q/(2)) • ‖x‖) - (by - apply IsDistBounded.const_smul - convert IsDistBounded.pow (n := 1) (by simp) - simp) - (by fun_prop)) := by - rw [Electromagnetism.ElectromagneticPotentialD.scalarPotential] - ext x - simp [oneDimPointParticle] +lemma oneDimPointParticle_scalarPotential (𝓕 : FreeSpace) (q : ℝ) (r₀ : Space 1) : + (oneDimPointParticle 𝓕 q r₀).scalarPotential 𝓕.c = + Space.constantTime (distOfFunction (fun x => + - ((q * 𝓕.μ₀ * 𝓕.c ^ 2)/(2)) • ‖x-r₀‖) (by fun_prop)) := by + ext ε + simp only [scalarPotential, Lorentz.Vector.temporalCLM, Fin.isValue, map_smul, + ContinuousLinearMap.comp_smulₛₗ, Real.ringHom_apply, oneDimPointParticle, LinearMap.coe_mk, + AddHom.coe_mk, ContinuousLinearEquiv.apply_symm_apply, ContinuousLinearMap.coe_smul', + ContinuousLinearMap.coe_comp', LinearMap.coe_toContinuousLinearMap', Pi.smul_apply, + Function.comp_apply, constantTime_apply, distOfFunction_vector_eval, Lorentz.Vector.apply_smul, + Lorentz.Vector.basis_apply, ↓reduceIte, mul_one, smul_eq_mul, neg_mul] + rw [distOfFunction_mul_fun _ (by fun_prop), distOfFunction_neg, + distOfFunction_mul_fun _ (by fun_prop)] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, + ContinuousLinearMap.neg_apply] + ring /-! @@ -126,401 +158,97 @@ lemma oneDimPointParticle_scalarPotential (q : ℝ) : -/ -set_option maxHeartbeats 400000 in -lemma oneDimPointParticle_electricField_eq_heavisideStep (q : ℝ) : - (oneDimPointParticle q).electricField = constantTime (q • - ((heavisideStep 0).smulRight (basis 0) - (1 / (2 : ℝ)) • constD 1 (basis 0))) := by - suffices hE : - Space.gradD (- Distribution.ofFunction (fun x => (q/(2)) • ‖x‖) - (by - apply IsDistBounded.const_smul - convert IsDistBounded.pow (n := 1) (by simp) - simp) - (by fun_prop)) = ((q) • ((heavisideStep 0).smulRight (basis 0) - - (1/(2 : ℝ)) • constD 1 (basis 0))) by - rw [Electromagnetism.ElectromagneticPotentialD.electricField] - simp only [LinearMap.coe_mk, AddHom.coe_mk, oneDimPointParticle_vectorPotential, map_zero, - sub_zero, Nat.succ_eq_add_one, Nat.reduceAdd, Fin.isValue, one_div, map_smul, map_sub] - rw [oneDimPointParticle_scalarPotential, constantTime_spaceGradD, ← map_neg, hE] - simp - /- Some preamble for results which are used throughout this proof. -/ - let s : Set (EuclideanSpace ℝ (Fin 1)) := - {x : EuclideanSpace ℝ (Fin 1) | 0 < x (Fin.last 0)} - have hs : NullMeasurableSet s volume := by - simp [s] - refine nullMeasurableSet_lt ?_ ?_ - · fun_prop - · change AEMeasurable oneEquivCLE volume - fun_prop - /- We are showing equality of two distributions of the from - `(Space 1) →d[ℝ] EuclideanSpace ℝ (Fin 1)`. Two such distributions `f` and `g` are equal - if and only if for all Schwartz maps η `⟪f, η⟫ 0 = ⟪g, η⟫ 0` -/ - ext η i - fin_cases i - calc _ - - /- By the definition of the gradiant on distributions - `-⟪∇ (- q/(2 * ε) |x|), η⟫ 0 = - ⟪(-q/(2 * ε) |x|), -dη/dx⟫` - which is equal to `- ⟪(q/(2 * ε) |x|), dη/dx⟫`. - By definition of `(q/(2 * ε) |x|)` as a distribution this is equal to - `- ∫ x, dη/dx • (q/(2 * ε) |x|)`. - -/ - _ = - (∫ x, fderiv ℝ η x (basis 0) • (q/(2)) • ‖x‖) := by - simp only [Nat.succ_eq_add_one, Nat.reduceAdd, smul_eq_mul, map_neg, neg_neg, Fin.zero_eta, - Fin.isValue, gradD_eq_sum_basis, Finset.univ_unique, Fin.default_eq_zero, neg_smul, - Finset.sum_neg_distrib, Finset.sum_singleton, PiLp.neg_apply, PiLp.smul_apply, basis_self, - mul_one, neg_inj] - rw [ofFunction_apply] - rfl - /- Pulling out the scalar `q/(2 * ε)` gives - `- ∫ x, dη/dx • (q/(2 * ε) |x|) = - q/(2 * ε) ∫ x, dη/dx • |x|`. - With the bounds of the integral explicit this is - `- q/(2 * ε) ∫_(-∞)^(∞) x, dη/dx • |x|` - -/ - _ = - (q/(2)) * (∫ x, fderiv ℝ η x (basis 0) • ‖x‖) := by - rw [← integral_const_mul, ← integral_neg] - congr - funext x - simp only [Fin.isValue, smul_eq_mul, neg_mul, neg_inj] - ring - /- We split the integral - `- q/(2 * ε) ∫_(-∞)^(∞) x, dη/dx • |x|` - into two halfs - `- q/(2 * ε) ∫_0^(∞) x, dη/dx • |x| - q/(2 * ε) ∫_(-∞)^0 x, dη/dx • |x| ` - -/ - _ = - (q/(2)) * (∫ x in s, fderiv ℝ η x (basis 0) • ‖x‖) + - - (q/(2)) * (∫ x in sᶜ, fderiv ℝ η x (basis 0) • ‖x‖) := by - rw [← integral_add_compl₀ hs ?_] - · ring - change Integrable (fun x : EuclideanSpace ℝ (Fin 1) => - ((SchwartzMap.evalCLM (𝕜 := ℝ) (basis 0)) ((fderivCLM ℝ) η)) x • ‖x‖) - apply IsDistBounded.schwartzMap_smul_integrable - · convert IsDistBounded.pow (n := 1) (by simp) - simp - · fun_prop - /- In the first of these integrals `|x|=x` whilst in the second `|x| = -x` giving - us - `- q/(2 * ε) ∫_0^(∞) x, dη/dx • x - q/(2 * ε) ∫_(-∞)^0 x, dη/dx • (-x)` -/ - _ = - (q/(2)) * (∫ x in s, fderiv ℝ η x (basis 0) • x 0) + - - (q/(2)) * (∫ x in sᶜ, fderiv ℝ η x (basis 0) • (- x 0)) := by - congr 2 - · refine setIntegral_congr_ae₀ hs ?_ - filter_upwards with x hx - congr - rw [@PiLp.norm_eq_of_L2] - simp only [Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Real.norm_eq_abs, sq_abs, - Finset.sum_singleton] - refine Real.sqrt_eq_cases.mpr ?_ - left - apply And.intro - · exact Eq.symm (Lean.Grind.Semiring.pow_two (x 0)) - · simp [s] at hx - apply le_of_lt hx - · refine setIntegral_congr_ae₀ ?_ ?_ - · simpa using hs - filter_upwards with x hx - congr - rw [@PiLp.norm_eq_of_L2] - simp only [Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Real.norm_eq_abs, sq_abs, - Finset.sum_singleton] - refine Real.sqrt_eq_cases.mpr ?_ - left - simp only [Fin.isValue, mul_neg, neg_mul, neg_neg, Left.nonneg_neg_iff] - apply And.intro - · exact Eq.symm (Lean.Grind.Semiring.pow_two (x 0)) - · simp [s] at hx - exact hx - /- The next couple of steps are setting things up to use the - result `MeasureTheory.integral_Ioi_of_hasDerivAt_of_tendsto`. -/ - /- So far our integral has really being over `Space 1` we now transorm it - into an integral over `ℝ`, using `oneEquivCLE`. - Here `(η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm)` is just `η` as - a Schwartz map from `ℝ` rather then from `Space 1`. - So symatically we have exactly the same thing as above - `- q/(2 * ε) ∫_0^(∞) x, dη/dx • x - q/(2 * ε) ∫_(-∞)^0 x, dη/dx • (-x)` - exacpt `x` is now `ℝ` rather then `Space 1`. - -/ - _ = - (q/(2)) * (∫ x in Set.Ioi (0 : ℝ), - deriv (η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm) x * x) + - - (q/(2)) * (∫ x in Set.Iic (0 : ℝ), - deriv (η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm) x * (-x)) := by - rw [← oneEquiv_symm_measurePreserving.setIntegral_preimage_emb - (oneEquiv_symm_measurableEmbedding)] - rw [← oneEquiv_symm_measurePreserving.setIntegral_preimage_emb - (oneEquiv_symm_measurableEmbedding)] - congr 3 - · simp only [Fin.isValue, smul_eq_mul, compCLMOfContinuousLinearEquiv_apply] - funext x - congr 1 - rw [← fderiv_deriv] - rw [ContinuousLinearEquiv.comp_right_fderiv] - simp only [Fin.isValue, ContinuousLinearMap.coe_comp', ContinuousLinearEquiv.coe_coe, - Function.comp_apply] - congr 1 - funext i - fin_cases i - simp only [Fin.isValue, Fin.zero_eta, basis_self, oneEquivCLE] - rfl - · congr - simp only [Fin.reduceLast, Fin.isValue, Set.preimage_compl, Set.preimage_setOf_eq, s] - ext x - simp [oneEquiv_symm_apply] - · simp only [Fin.isValue, smul_eq_mul, mul_neg, compCLMOfContinuousLinearEquiv_apply] - funext x - congr 1 - rw [← fderiv_deriv] - rw [ContinuousLinearEquiv.comp_right_fderiv] - simp only [Fin.isValue, ContinuousLinearMap.coe_comp', ContinuousLinearEquiv.coe_coe, - Function.comp_apply] - congr 2 - funext i - fin_cases i - simp only [Fin.isValue, Fin.zero_eta, basis_self, oneEquivCLE] - rfl - /- We use the fact that e.g. `(d(η • x)/dx - η x) = d η/dx • x` to rewrite - `- q/(2 * ε) ∫_0^(∞) x, dη/dx • x - q/(2 * ε) ∫_(-∞)^0 x, dη/dx • (-x)` - as - `- q/(2 * ε) ∫_0^(∞) x, (d(η • x)/dx - η x) - q/(2 * ε) ∫_(-∞)^0 x, (d(η • (-x))/dx + η x)` -/ - _ = - (q/(2)) * (∫ x in Set.Ioi (0 : ℝ), - deriv (fun x => η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm x * (fun x => x) x) x - - η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm x) + - - (q/(2)) * (∫ x in Set.Iic (0 : ℝ), - deriv (fun x => η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm x * (fun x => - x) x) x - + η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm x) := by - congr - · funext x - rw [deriv_fun_mul] - simp only [compCLMOfContinuousLinearEquiv_apply, Function.comp_apply, deriv_id'', mul_one, - add_sub_cancel_right] - · exact SchwartzMap.differentiableAt _ - · fun_prop - · funext x - rw [deriv_fun_mul] - simp only [compCLMOfContinuousLinearEquiv_apply, mul_neg, Function.comp_apply, deriv_neg'', - mul_one, neg_add_cancel_right] - · exact SchwartzMap.differentiableAt _ - · fun_prop - /- By definition of `powOneMul` we rewrite `η • x` using `powOneMul`. Symatically we now have - `- q/(2 * ε) ∫_0^(∞) x, (d(η • x)/dx - η x) - q/(2 * ε) ∫_(-∞)^0 x, (d(- (η • x)))/dx + η x)` - things are just written in different ways. -/ - _ = - (q/(2)) * (∫ x in Set.Ioi (0 : ℝ), - deriv (powOneMul ℝ (η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm)) x - - η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm x) + - - (q/(2)) * (∫ x in Set.Iic (0 : ℝ), - deriv (-powOneMul ℝ (η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm)) x - + η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm x) := by - congr - · funext x - congr - funext x - simp [powOneMul_apply] - rw [mul_comm] - · funext x - congr - funext x - change _ = - ((powOneMul ℝ) ((compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm) η)) x - simp [powOneMul_apply] - rw [mul_comm] - /- We seperate the integrals to get - `- q/(2 * ε) (∫_0^(∞) x, d(η • x)/dx - ∫_0^(∞) x, η x) ` - `- q/(2 * ε) (∫_(-∞)^0 x, d(- (η • x)))/dx + ∫_(-∞)^0 x, η x)`. -/ - _ = - (q/(2)) * ((∫ x in Set.Ioi (0 : ℝ), - deriv (powOneMul ℝ (η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm)) x) - - ∫ x in Set.Ioi (0 : ℝ), η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm x) + - - (q/(2)) * ((∫ x in Set.Iic (0 : ℝ), - deriv (-powOneMul ℝ (η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm)) x) - + ∫ x in Set.Iic (0 : ℝ), η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm x) := by - rw [integral_sub, integral_add] - · refine Integrable.restrict ?_ - change Integrable (derivCLM ℝ - (-(powOneMul ℝ) ((compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm) η))) volume - exact integrable - ((derivCLM ℝ) (-(powOneMul ℝ) ((compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm) η))) - · refine Integrable.restrict ?_ - exact integrable _ - · refine Integrable.restrict ?_ - change Integrable (derivCLM ℝ - (powOneMul ℝ ((compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm) η))) volume - exact integrable - ((derivCLM ℝ) (powOneMul ℝ ((compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm) η))) - · refine Integrable.restrict ?_ - exact integrable _ - /- We are now in a position to use `MeasureTheory.integral_Ioi_of_hasDerivAt_of_tendsto` - which rewrites `∫_0^(∞) x, d(η • x)/dx = 0 - (η 0 • 0)` - and `∫_(-∞)^0 x, d(- (η • x)))/dx = (- η 0 • 0) - 0`. This gives us - `- q/(2 * ε) ((0 - (η 0 • 0))- ∫_0^(∞) x, η x)` - `- q/(2 * ε) (((- η 0 • 0) - 0)+ ∫_(-∞)^0 x, η x)`. -/ - _ = - (q/(2)) * ((0 - - (powOneMul ℝ (η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm)) 0) - - ∫ x in Set.Ioi (0 : ℝ), η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm x) + - - (q/(2)) * - (((-powOneMul ℝ (η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm)) 0 - 0) - + ∫ x in Set.Iic (0 : ℝ), η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm x) := by - congr - · apply MeasureTheory.integral_Ioi_of_hasDerivAt_of_tendsto - · apply Continuous.continuousWithinAt - fun_prop - · intro x hx - refine DifferentiableAt.hasDerivAt ?_ - exact SchwartzMap.differentiableAt _ - · apply Integrable.integrableOn - change Integrable (derivCLM ℝ ((powOneMul ℝ) - ((compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm) η))) volume - exact integrable - ((derivCLM ℝ) ((powOneMul ℝ) ((compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm) η))) - · exact Filter.Tendsto.mono_left ((powOneMul ℝ) - ((compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm) η)).toZeroAtInfty.zero_at_infty' - atTop_le_cocompact - · apply MeasureTheory.integral_Iic_of_hasDerivAt_of_tendsto - · apply Continuous.continuousWithinAt - fun_prop - · intro x hx - refine DifferentiableAt.hasDerivAt ?_ - exact SchwartzMap.differentiableAt _ - · apply Integrable.integrableOn - change Integrable (derivCLM ℝ (- (powOneMul ℝ) - ((compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm) η))) - exact integrable - ((derivCLM ℝ) (- (powOneMul ℝ) ((compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm) η))) - · apply Filter.Tendsto.mono_left - ((- (powOneMul ℝ) - ((compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm) η)).toZeroAtInfty.zero_at_infty') - exact atBot_le_cocompact - /- We simplify the `(η 0 • 0)` and `(- η 0 • 0)` terms to be `0`. Giving us - `- q/(2 * ε) ((0 - 0)- ∫_0^(∞) x, η x)` - `- q/(2 * ε) ((0 - 0)+ ∫_(-∞)^0 x, η x)`. -/ - _ = - (q/(2)) * ((0 - 0) - - ∫ x in Set.Ioi (0 : ℝ), η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm x) + - - (q/(2)) * ((0 - 0) - + ∫ x in Set.Iic (0 : ℝ), η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm x) := by - congr - · simp [powOneMul_apply] - · change - ((powOneMul ℝ) ((compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm) η)) 0 = 0 - simp [powOneMul_apply] - /- Simplifying further gives - `q/(2 * ε) ∫_0^(∞) x, η x + - q/(2 * ε) ∫_(-∞)^0 x, η x)`. -/ - _ = (q/(2)) * - (∫ x in Set.Ioi (0 : ℝ), η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm x) + - - (q/(2)) * - (∫ x in Set.Iic (0 : ℝ), η.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm x) := by - simp - /- We now turn back to integrals over `Space 1` instead of integrals over `x`. - Schematically the integral remains the same. - `q/(2 * ε) ∫_0^(∞) x, η x + - q/(2 * ε) ∫_(-∞)^0 x, η x)`. -/ - _ = (q/(2)) * (∫ x in s, η x) + - (q/2) * (∫ x in sᶜ, η x) := by - rw [← oneEquiv_symm_measurePreserving.setIntegral_preimage_emb - (oneEquiv_symm_measurableEmbedding)] - rw [← oneEquiv_symm_measurePreserving.setIntegral_preimage_emb - (oneEquiv_symm_measurableEmbedding)] - congr - ext x - simp [oneEquiv_symm_apply, s] - /- We rewrite the second integral `∫_(-∞)^0 = ∫_(-∞)^∞ - ∫_0^∞` to give - `q/(2 * ε) ∫_0^(∞) x, η x + - q/(2 * ε) (∫_(-∞)^∞ x, η x - ∫_0^∞ x, η x)`. -/ - _ = (q/(2)) * (∫ x in s, η x) + - (q/(2)) * ((∫ x, η x) - ∫ x in s, η x) := by - congr 2 - rw [← integral_add_compl₀ hs] - · ring - exact integrable η - /- Simplifying we get: - `q/(ε) ∫_0^(∞) x, η x + - q/(2 * ε) ∫_(-∞)^∞ x, η x`. -/ - _ = (q) * (∫ x in s, η x) + - (q/(2)) * (∫ x, η x) := by - ring - /- Both sides are now essentially equal, by the definition of the heaviside step, - and the constant distribution. What is left is some small tidying up. -/ - simp [mul_sub] - congr 2 - rw [← mul_assoc] - congr 1 - simp [constD, const_apply] - rw [integral_smul_const] - simp +lemma oneDimPointParticle_electricField (𝓕 : FreeSpace) (q : ℝ) (r₀ : Space 1) : + (oneDimPointParticle 𝓕 q r₀).electricField 𝓕.c = + ((q * 𝓕.μ₀ * 𝓕.c ^ 2) / 2) • constantTime (distOfFunction (fun x : Space 1 => + ‖x - r₀‖ ^ (- 1 : ℤ) • basis.repr (x - r₀)) + ((IsDistBounded.zpow_smul_repr_self (- 1 : ℤ) (by omega)).comp_sub_right r₀)) := by + have h1 := Space.distGrad_distOfFunction_norm_zpow (d := 0) 1 (by grind) + simp at h1 + simp only [electricField, LinearMap.coe_mk, AddHom.coe_mk, oneDimPointParticle_scalarPotential, + smul_eq_mul, neg_mul, oneDimPointParticle_vectorPotential, map_zero, sub_zero, Int.reduceNeg, + zpow_neg, zpow_one] + rw [constantTime_distSpaceGrad, distOfFunction_neg, distOfFunction_mul_fun _ (by fun_prop)] + simp only [map_neg, map_smul, neg_neg] + congr + trans distGrad <| distTranslate (basis.repr r₀) <| (distOfFunction (fun x => ‖x‖) (by fun_prop)) + · ext1 η + simp [distTranslate_ofFunction] + rw [Space.distTranslate_distGrad] + simp [h1, distTranslate_ofFunction] /-! -## D. Maxwell's equations +### C.1. The time derivative of the electric field -/ +@[simp] +lemma oneDimPointParticle_electricField_timeDeriv (𝓕 : FreeSpace) (q : ℝ) (r₀ : Space 1) : + Space.distTimeDeriv ((oneDimPointParticle 𝓕 q r₀).electricField 𝓕.c) = 0 := by + rw [oneDimPointParticle_electricField] + simp + /-! -### D.1. Gauss' law +## D. The magnetic field -/ -lemma oneDimPointParticle_gaussLaw (q : ℝ) : - spaceDivD (oneDimPointParticle q).electricField = constantTime (q • diracDelta ℝ 0) := by - ext η - rw [oneDimPointParticle_electricField_eq_heavisideStep] - rw [constantTime_spaceDivD] - congr - ext η - change (divD ((q) • (ContinuousLinearMap.smulRight (heavisideStep 0) (basis 0) - - (1 / 2) • constD 1 (basis 0)))) η = (q • diracDelta ℝ 0) η - haveI : SMulZeroClass ℝ ((Space 1)→d[ℝ] ℝ) := by infer_instance - simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.isValue, one_div, map_smul, map_sub, - divD_constD, ContinuousLinearMap.coe_smul', ContinuousLinearMap.coe_sub', Pi.smul_apply, - Pi.sub_apply, ContinuousLinearMap.zero_apply, smul_eq_mul, mul_zero, sub_zero, diracDelta_apply] - field_simp - congr 1 - rw [divD_apply_eq_sum_fderivD] - simp only [Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Finset.sum_singleton] - rw [fderivD_apply] - simp only [Fin.isValue, ContinuousLinearMap.smulRight_apply, PiLp.neg_apply, PiLp.smul_apply, - basis_self, smul_eq_mul, mul_one] - rw [heavisideStep_apply] - simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.reduceLast, Fin.isValue] - rw [← MeasureTheory.MeasurePreserving.setIntegral_preimage_emb - (μ := volume) (ν := volume) (f := oneEquiv.symm)] - simp only [Fin.isValue, Set.preimage_setOf_eq] - let f' := SchwartzMap.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm - ((SchwartzMap.evalCLM (𝕜 := ℝ) (basis 0)) ((fderivCLM ℝ) η)) - let f := SchwartzMap.compCLMOfContinuousLinearEquiv ℝ oneEquivCLE.symm η - change -∫ (x : ℝ) in Set.Ioi 0, f' x = _ - rw [neg_eq_iff_eq_neg] - trans 0 - f 0 - · apply MeasureTheory.integral_Ioi_of_hasDerivAt_of_tendsto - (f' := f') - (f := f) - · apply Continuous.continuousWithinAt - fun_prop - · have hf : f' = (SchwartzMap.derivCLM ℝ) f := by - ext x - simp [f'] - change fderiv ℝ η (oneEquivCLE.symm x) (basis 0) = _ - trans fderiv ℝ η (oneEquivCLE.symm x) (oneEquivCLE.symm 1) - · congr 1 - funext i - fin_cases i - simp - rfl - rw [← fderiv_deriv] - dsimp [f] - rw [ContinuousLinearEquiv.comp_right_fderiv] - rfl - rw [hf] - simpa using fun x hx => SchwartzMap.differentiableAt f - · exact (integrable f').integrableOn - · exact Filter.Tendsto.mono_left f.toZeroAtInfty.zero_at_infty' atTop_le_cocompact - · simp [f] - · exact oneEquiv_symm_measurePreserving - · exact oneEquiv_symm_measurableEmbedding +lemma oneDimPointParticle_magneticFieldMatrix (q : ℝ) (r₀ : Space 1) : + (oneDimPointParticle 𝓕 q r₀).magneticFieldMatrix 𝓕.c = 0 := by + simp /-! -### D.2. The variational gradient of the Lagrangian is zero +## E. Maxwell's equations -/ -lemma oneDimPointParticle_gradLagrangian (q : ℝ) : - (oneDimPointParticle q).gradLagrangian (oneDimPointParticleCurrentDensity q) = 0 := by - rw [ElectromagneticPotentialD.gradLagrangian_one_dimension_electricField] - funext μ - match μ with - | Sum.inl 0 => - simp [oneDimPointParticleCurrentDensity] - rw [oneDimPointParticle_gaussLaw] +lemma oneDimPointParticle_div_electricField {𝓕} (q : ℝ) (r₀ : Space 1) : + distSpaceDiv ((oneDimPointParticle 𝓕 q r₀).electricField 𝓕.c) = + (𝓕.μ₀ * 𝓕.c ^ 2) • constantTime (q • diracDelta ℝ r₀) := by + rw [oneDimPointParticle_electricField] + simp only [Int.reduceNeg, zpow_neg, zpow_one, map_smul, smul_smul] + have h1 := Space.distDiv_inv_pow_eq_dim (d := 0) + simp at h1 + trans (q * 𝓕.μ₀ * 𝓕.c.val ^ 2 / 2) • + distSpaceDiv (constantTime <| + distTranslate (basis.repr r₀) <| + (distOfFunction (fun x => ‖x‖ ^ (-1 : ℤ) • basis.repr x) + (IsDistBounded.zpow_smul_repr_self (- 1 : ℤ) (by omega)))) + · ext η + simp [distTranslate_ofFunction] + simp only [Int.reduceNeg, zpow_neg, zpow_one] + rw [constantTime_distSpaceDiv, distDiv_distTranslate, h1] + simp only [map_smul] + suffices h : volume.real (Metric.ball (0 : Space 1) 1) = 2 by + rw [h] + simp [smul_smul] + ext η + simp [constantTime_apply, diracDelta_apply, distTranslate_apply] + left + ring_nf + simp [MeasureTheory.Measure.real] + rw [InnerProductSpace.volume_ball_of_dim_odd (k := 0)] + · simp + · simp + +lemma oneDimPointParticle_isExterma (𝓕 : FreeSpace) (q : ℝ) (r₀ : Space 1) : + (oneDimPointParticle 𝓕 q r₀).IsExtrema 𝓕 (oneDimPointParticleCurrentDensity 𝓕.c q r₀) := by + rw [isExtrema_iff_components] + apply And.intro + · intro ε + rw [gradLagrangian_sum_inl_0] + simp only [one_div, mul_inv_rev, oneDimPointParticleCurrentDensity_chargeDensity, map_smul, + ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] + rw [oneDimPointParticle_div_electricField] + simp only [map_smul, ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] + field_simp + ring + · intro ε i + rw [gradLagrangian_sum_inr_i] simp - | Sum.inr 0 => - simp [oneDimPointParticleCurrentDensity, oneDimPointParticle_electricField_eq_heavisideStep] +end DistElectromagneticPotential end Electromagnetism diff --git a/PhysLean/Electromagnetism/PointParticle/ThreeDimension.lean b/PhysLean/Electromagnetism/PointParticle/ThreeDimension.lean index 59c5c37e9..85f8105e0 100644 --- a/PhysLean/Electromagnetism/PointParticle/ThreeDimension.lean +++ b/PhysLean/Electromagnetism/PointParticle/ThreeDimension.lean @@ -3,1082 +3,320 @@ Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ -import PhysLean.Electromagnetism.Electrostatics.Basic +import PhysLean.Electromagnetism.Dynamics.IsExtrema +import PhysLean.SpaceAndTime.Space.Norm import PhysLean.SpaceAndTime.Space.Translations -import PhysLean.Mathematics.Distribution.PowMul -import Mathlib.MeasureTheory.Measure.Lebesgue.VolumeOfBalls -import Mathlib.Analysis.InnerProductSpace.NormPow -import Mathlib.Analysis.Calculus.FDeriv.Norm +import PhysLean.SpaceAndTime.TimeAndSpace.ConstantTimeDist /-! -# A electrostatics of a point particle in 3d. +# Electrostatics of a stationary point particle in 3d -In this module we derive properties of the electrostatics of a point particle of -charge `q` sitting in `3`d space. +## i. Overview -### i. Key results +In this module we give the electromagnetic properties of a point particle +sitting at the origin in 3d space. -- The electric potential is given by `electricPotential q ε r₀`. -- The electric field is given by `electricField q ε r₀`. -- Gauss's law is given in `gaussLaw`. -- Faraday's law is given in `faradaysLaw`. +## ii. Key results -### ii. References +- `threeDimPointParticle` : The electromagnetic potential of a point particle + stationary at a point in 3d space. +- `threeDimPointParticle_isExterma` : The electric field of a point + particle stationary at a point of 3d space satisfies Maxwell's equations -- The proof of Gauss' law in this module follows: - https://math.stackexchange.com/questions/2409008/ +## iii. Table of contents --/ - -namespace Electromagnetism -open Distribution SchwartzMap - -namespace ThreeDimPointParticle -open Space StaticElectricField MeasureTheory Real InnerProductSpace -noncomputable section - -/-! - -## A. Definitions - -We start by stating the charge distribution, electric potential and electric field of -the point particle. Later on in this module we will prove that these definitions are -correct, by showing they satisfy the necessary physical properties. +- A. The current density + - A.1. The charge density + - A.2. The 3-current density +- B. The Potentials + - B.1. The electromagnetic potential + - B.2. The scalar potential + - B.3. The vector potential is zero +- C. The electric field + - C.1. the time derivative of the electric field +- D. The magnetic field +- E. Maxwell's equations -We have the following definitions: -- The `chargeDistribution` is `q δ(r-r₀)`. -- The `electricPotential` is `(q/(4 * π * ε)) • ‖r - r₀‖⁻¹`. -- The `electricField` is `(q/(4 * π * ε)) • ‖r - r₀‖⁻¹ ^ 3 • (r - r₀)`. +## iv. References -/ -/-- The charge distribution of a point particle of charge `q` in 3d space sitting at the `r₀`. - In the physicists notation this corresponds to the 'function' `q δ(r-r₀)`. -/ -def chargeDistribution (q : ℝ) (r₀ : Space) : ChargeDistribution 3 := q • diracDelta ℝ r₀ - -/-- The electric potential of a point particle of charge `q` in 3d space sitting at the `r₀`. - In physics notation this corresponds to the 'function' `(q/(4 * π * ε)) • ‖r - r₀‖⁻¹`. - Here it is defined as the distribution corresponding to that function. -/ -def electricPotential (q ε : ℝ) (r₀ : Space) : StaticElectricPotential 3 := - Distribution.ofFunction (fun r => (q/(4 * π * ε)) • ‖r - r₀‖⁻¹) - (by - apply IsDistBounded.const_smul - apply IsDistBounded.congr (f := fun r => ‖r - r₀‖ ^ (-1 : ℤ)) - (IsDistBounded.pow_shift (-1) r₀ (by simp)) - simp) (by - simp only [Nat.succ_eq_add_one, Nat.reduceAdd]; - refine AEStronglyMeasurable.const_mul ?_ (q / (4 * π * ε)) - refine StronglyMeasurable.aestronglyMeasurable ?_ - refine stronglyMeasurable_iff_measurable.mpr ?_ - fun_prop) - -/-- The electric field of a point particle of charge `q` in 3d space sitting at `r₀`. - In physics notation this corresponds to the 'function' - `(q/(4 * π * ε)) • ‖r - r₀‖⁻¹ ^ 3 • (r - r₀)`. - Here it is defined as the distribution corresponding to that function. -/ -def electricField (q ε : ℝ) (r₀ : Space) : StaticElectricField 3 := - ofFunction (fun r => (q/(4 * π * ε)) • ‖r - r₀‖⁻¹ ^ 3 • (r - r₀)) - (by - apply IsDistBounded.const_smul - apply IsDistBounded.congr (f := fun r => ‖r - r₀‖ ^ (-2 : ℤ)) - (IsDistBounded.pow_shift _ r₀ (by simp)) - simp [norm_smul] - intro x - by_cases hx : ‖x - r₀‖ = 0 - · simp [hx, zpow_two] - · field_simp [zpow_two]) (by fun_prop) +namespace Electromagnetism +open Distribution SchwartzMap +open Space MeasureTheory +namespace DistElectromagneticPotential /-! -## B. Properties for `q = 0` - -We first prove that the charge distribution, electric potential and electric field are -all zero when the charge of the particle is zero. - --/ +## A. The current density -lemma chargeDistribution_eq_zero_of_charge_eq_zero (r₀ : Space) : - chargeDistribution 0 r₀ = 0 := by simp [chargeDistribution] - -lemma electricPotential_eq_zero_of_charge_eq_zero {ε : ℝ} (r₀ : Space) : - electricPotential 0 ε r₀ = 0 := by simp [electricPotential] - -lemma electricField_eq_zero_of_charge_eq_zero {ε : ℝ} (r₀ : Space) : - electricField 0 ε r₀ = 0 := by simp [electricField] - -/-! +The current density of a point particle in 3d space is given by: -## C. Translations +$$J(r) = (c q \delta(r - r₀), 0, 0, 0) $$ -We now prove that the charge distribution, electric potential and electric field -for the point particle at `r₀` is just the translation of the charge distribution, -electric potential and electric field for the point particle located at `0`. +where $c$ is the speed light, $q$ is the charge of the particle and $r₀$ is the position of the +particle in 3d space. -/ -lemma chargeDistribution_eq_translateD (q : ℝ) (r₀ : Space) : - chargeDistribution q r₀ = Space.translateD r₀ - (chargeDistribution q 0) := by - ext η - simp [chargeDistribution, Space.translateD_apply] - -lemma electricPotential_eq_translateD (q ε : ℝ) (r₀ : Space) : - electricPotential q ε r₀ = Space.translateD r₀ (electricPotential q ε 0) := by - ext η - simp [electricPotential] - rw [Space.translateD_ofFunction] - -lemma electricField_eq_translateD (q ε : ℝ) (r₀ : Space) : - electricField q ε r₀ = Space.translateD r₀ (electricField q ε 0) := by +/-- The current density of a point particle stationary at a point `r₀` + of 3d space. -/ +noncomputable def threeDimPointParticleCurrentDensity (c : SpeedOfLight) (q : ℝ) (r₀ : Space 3) : + DistLorentzCurrentDensity 3 := (SpaceTime.distTimeSlice c).symm <| + constantTime ((c * q) • diracDelta' ℝ r₀ (Lorentz.Vector.basis (Sum.inl 0))) + +lemma threeDimPointParticleCurrentDensity_eq_distTranslate (c : SpeedOfLight) (q : ℝ) + (r₀ : Space 3) : + threeDimPointParticleCurrentDensity c q r₀ = ((SpaceTime.distTimeSlice c).symm <| + constantTime <| + distTranslate (basis.repr r₀) <| + ((c * q) • diracDelta' ℝ 0 (Lorentz.Vector.basis (Sum.inl 0)))) := by + rw [threeDimPointParticleCurrentDensity] + congr ext η - simp [electricField] - rw [Space.translateD_ofFunction] - -open InnerProductSpace - -open scoped Topology BigOperators FourierTransform - -/-! - -## D. Proving the gradient of the potential is the electric field - -We now prove that the electric field is equal to the negative gradient of the potential, -i.e. `E = -∇φ`. - --/ - -/-! - -### D.1. Reducing the problem to showing an integral is zero - -Until the very end of this problem we will implicitly assume that `r₀ = 0`. -We generalize at the end. - -The first step of our proof is to show that `E = -∇φ` if for any Schwartz map `η` and direction `y` -the integral -`∫ r, d_y η r * ‖r‖⁻¹ + η r * -⟪(‖r‖ ^ 3)⁻¹ • x, r⟫_ℝ = 0` -is equal to zero. - -Recall that a 'Schwartz map' is a smooth function which, along with all it's -derivatives, decays fast. It's presence here is because the electric field and potential -are defined as distributions, and distributions are defined by how they act on Schwartz maps. - --/ - -/-- - The relation `E = -∇φ` holds for the point particle if the integral - `∫ x, d_y η x * ‖x‖⁻¹ + η x * -⟪(‖x‖ ^ 3)⁻¹ • x, y⟫_ℝ = 0` - is zero. --/ -lemma gradD_electricPotential_eq_electricField_of_integral_eq_zero (q ε : ℝ) - (h_integral : ∀ η : 𝓢(EuclideanSpace ℝ (Fin 3), ℝ), ∀ y : EuclideanSpace ℝ (Fin 3), - ∫ (a : EuclideanSpace ℝ (Fin 3)), (fderivCLM ℝ η a y * ‖a‖⁻¹ + - η a * - ⟪(‖a‖ ^ 3)⁻¹ • a, y⟫_ℝ) = 0) : - - Space.gradD (electricPotential q ε 0) = electricField q ε 0 := by - rw [← sub_eq_zero] - ext1 η - apply ext_inner_right ℝ - intro y - simp [inner_sub_left, gradD_inner_eq, fderivD_apply] - dsimp [electricPotential, electricField] - rw [ofFunction_inner, ofFunction_apply] - simp only [Nat.succ_eq_add_one, Nat.reduceAdd, smul_eq_mul, inv_pow] - rw [← integral_sub] - simp only [sub_zero] - change ∫ (a : EuclideanSpace ℝ (Fin 3)), (fderivCLM ℝ η a y * (q / (4 * π * ε) * ‖a‖⁻¹)) - - η a * ⟪(q / (4 * π * ε)) • (‖a‖ ^ 3)⁻¹ • a, y⟫_ℝ = _ - trans ∫ (a : EuclideanSpace ℝ (Fin 3)), (q / (4 * π * ε)) * (fderivCLM ℝ η a y * ‖a‖⁻¹ + - η a * -⟪(‖a‖ ^ 3)⁻¹ • a, y⟫_ℝ) - · congr - funext a - rw [inner_smul_left] - simp only [fderivCLM_apply, map_div₀, conj_trivial] - ring - rw [integral_const_mul, h_integral, mul_zero] - apply IsDistBounded.schwartzMap_mul_integrable - · simp only [Nat.succ_eq_add_one, Nat.reduceAdd, sub_zero] - change IsDistBounded fun x => (q / (4 * π * ε)) • ‖x‖⁻¹ - apply IsDistBounded.const_smul - fun_prop - · simp only [Nat.succ_eq_add_one, Nat.reduceAdd]; - refine AEStronglyMeasurable.const_mul ?_ (q / (4 * π * ε)) - refine StronglyMeasurable.aestronglyMeasurable ?_ - refine stronglyMeasurable_iff_measurable.mpr ?_ - fun_prop - apply IsDistBounded.schwartzMap_mul_integrable - · apply IsDistBounded.inner_left - apply IsDistBounded.const_smul - apply IsDistBounded.congr (f := fun r => ‖r‖ ^ (-2 : ℤ)) (IsDistBounded.pow _ (by simp)) - simp [norm_smul] - intro x - by_cases hx : ‖x‖ = 0 - · simp [hx, zpow_two] - · field_simp [zpow_two] - · fun_prop + simp [distTranslate_apply] /-! -### D.2. A smooth approximation to `‖r‖⁻¹` - -Notice that in the integral -`∫ r, d_y η r * ‖r‖⁻¹ + η r * -⟪(‖r‖ ^ 3)⁻¹ • x, r⟫_ℝ = 0` -the integrand is has the structure of the total derivative of the function -`η r * ‖r‖⁻¹` in the direction `y`, i.e. `d_y (η r * ‖r‖⁻¹)`. - -However, this does not quite work because `‖r‖⁻¹` is not differentiable at `r = 0`. -To get around this we define a sequence of functions, which for `n : ℕ` are given by -`potentialLimitSeries n r = (‖r‖ ^ 2 + 1/(n + 1))^ (-1/2 : ℝ)`. - -The overall aim will be to write `∫ r, d_y η r * ‖r‖⁻¹ + η r * -⟪(‖r‖ ^ 3)⁻¹ • x, r⟫_ℝ` -as the limit of the integrals -`∫ r, d_y η r * potentialLimitSeries n r + η r * d_y (potentialLimitSeries n) r y` -as `n → ∞`, and then show that each of these integrals is zero because they -are integrals of total derivatives of differentiable functions. - --/ - -/-- A series of functions whose limit is the `‖x‖⁻¹` and for which each function is - differentiable everywhere. -/ -def potentialLimitSeries : ℕ → EuclideanSpace ℝ (Fin 3) → ℝ := fun n x => - (‖x‖ ^ 2 + 1/(n + 1))^ (-1/2 : ℝ) +### A.1. The charge density -lemma potentialLimitSeries_eq (n : ℕ) : - potentialLimitSeries n = fun x => (‖x‖ ^ 2 + 1/(n + 1))^ (-1/2 : ℝ) := rfl +The charge density of a point particle in 3d space is given by: +$$ρ(r) = q \delta(r - r₀) $$ -/-! - -#### Part D.2.I. -The most important property of `potentialLimitSeries` is that it converges to `‖x‖⁻¹` as -`n → ∞`. That is, it approximates `‖x‖⁻¹` arbitrarily closely for large enough `n`. +where $q$ is the charge of the particle and $r₀$ is the position of the particle in 3d space. -/ -lemma potentialLimitSeries_tendsto (x : EuclideanSpace ℝ (Fin 3)) (hx : x ≠ 0) : - Filter.Tendsto (fun n => potentialLimitSeries n x) Filter.atTop (𝓝 (‖x‖⁻¹)) := by - conv => enter [1, n]; rw [potentialLimitSeries_eq] - simp only [one_div] - have hx_norm : ‖x‖⁻¹ = (‖x‖ ^ 2 + 0) ^ (-1 / 2 : ℝ) := by - trans √(‖x‖ ^ 2)⁻¹ - · simp - rw [sqrt_eq_rpow] - nth_rewrite 1 [← Real.rpow_neg_one] - rw [← Real.rpow_mul] - congr - ring - simp only [one_div] - simp - rw [hx_norm] - refine Filter.Tendsto.rpow ?_ tendsto_const_nhds ?_ - · apply Filter.Tendsto.add - · exact tendsto_const_nhds - · simpa using tendsto_one_div_add_atTop_nhds_zero_nat - left - simpa using hx +@[simp] +lemma threeDimPointParticleCurrentDensity_chargeDensity (c : SpeedOfLight) (q : ℝ) (r₀ : Space 3) : + (threeDimPointParticleCurrentDensity c q r₀).chargeDensity c = + constantTime (q • diracDelta ℝ r₀) := by + ext ε + simp only [DistLorentzCurrentDensity.chargeDensity, one_div, Lorentz.Vector.temporalCLM, + Fin.isValue, threeDimPointParticleCurrentDensity, map_smul, LinearMap.coe_mk, AddHom.coe_mk, + ContinuousLinearEquiv.apply_symm_apply, ContinuousLinearMap.coe_smul', + ContinuousLinearMap.coe_comp', LinearMap.coe_toContinuousLinearMap', Pi.smul_apply, + Function.comp_apply, constantTime_apply, diracDelta'_apply, Lorentz.Vector.apply_smul, + Lorentz.Vector.basis_apply, ↓reduceIte, mul_one, smul_eq_mul, diracDelta_apply] + field_simp /-! -#### Part D.2.II. -Unlike `‖r‖⁻¹`, importantly the functions `potentialLimitSeries n` are -differentiable everywhere. - --/ - -lemma potentialLimitSeries_differentiable (n : ℕ) : - Differentiable ℝ (potentialLimitSeries n) := by - rw [potentialLimitSeries_eq] - refine Differentiable.rpow_const ?_ ?_ - · refine (Differentiable.fun_add_iff_right ?_).mpr ?_ - apply Differentiable.norm_sq ℝ - · fun_prop - · fun_prop - · intro x - left - have h1 : 0 < ‖x‖ ^ 2 + 1 / (↑n + 1) := by - apply add_pos_of_nonneg_of_pos - · apply sq_nonneg - · positivity - by_contra hn - rw [hn] at h1 - simp at h1 +### A.2. The 3-current density -/-! +The 3-current density of a point particle in 3d space is given by: +$$\vec J(r) = 0.$$ -#### Part D.2.III. - The derivative of `potentialLimitSeries n` in the direction `y` is given by - `- (‖r‖^1 + 1/(1 + n))^(-3/2) * ⟪r, y⟫_ℝ`, or equivalently - `- (potentialLimitSeries n r) ^ 3 * ⟪r, y⟫_ℝ`. +In other words, there is no current flow for a point particle at rest. -/ -lemma potentialLimitSeries_fderiv (x y : EuclideanSpace ℝ (Fin 3)) (n : ℕ) : - fderiv ℝ (potentialLimitSeries n) x y = - - ((‖x‖ ^ 2 + (1 + (n : ℝ))⁻¹) ^ (- 1 /2 : ℝ)) ^ 3 * ⟪x, y⟫_ℝ := by - have h0 (x : EuclideanSpace ℝ (Fin 3)) : (‖x‖ ^ 2 + ((n : ℝ) + 1)⁻¹) ^ (-1 / 2 : ℝ) = - (√(‖x‖ ^ 2 + ((n : ℝ) + 1)⁻¹))⁻¹ := by - rw [sqrt_eq_rpow] - nth_rewrite 2 [← Real.rpow_neg_one] - rw [← Real.rpow_mul] - congr - ring - positivity - trans fderiv ℝ (fun x => (√(‖x‖ ^2 + 1/(n + 1)))⁻¹) x y - · congr - funext x - simp only [one_div] - dsimp [potentialLimitSeries] - simp only [one_div] - exact h0 x - rw [fderiv_comp'] - simp only [one_div, ContinuousLinearMap.coe_comp', Function.comp_apply, fderiv_eq_smul_deriv, - deriv_inv', smul_eq_mul, mul_neg, neg_mul, neg_inj] - rw [fderiv_sqrt] - simp only [one_div, mul_inv_rev, fderiv_add_const, ContinuousLinearMap.coe_smul', Pi.smul_apply, - smul_eq_mul] - rw [← @grad_inner_eq] - rw [grad_norm_sq] - simp [inner_smul_left] - ring_nf - rw [mul_comm] - congr 2 - trans (‖x‖ ^ 2 + ((n : ℝ)+ 1)⁻¹) ^ (-1 / 2 : ℝ) - · rw [h0 x] - ring_nf - ring_nf - · refine (DifferentiableAt.fun_add_iff_right ?_).mpr ?_ - · apply Differentiable.norm_sq ℝ - · fun_prop - · fun_prop - · have h1 : 0 < ‖x‖ ^ 2 + 1 / (↑n + 1) := by - apply add_pos_of_nonneg_of_pos - · apply sq_nonneg - · positivity - by_contra hn - simp at h1 - rw [hn] at h1 - simp at h1 - · refine differentiableAt_inv ?_ - simp only [one_div, ne_eq] - refine sqrt_ne_zero'.mpr ?_ - apply add_pos_of_nonneg_of_pos - · apply sq_nonneg - · positivity - · refine DifferentiableAt.sqrt ?_ ?_ - refine (DifferentiableAt.fun_add_iff_right ?_).mpr ?_ - · apply Differentiable.norm_sq ℝ - · fun_prop - · fun_prop - have h1 : 0 < ‖x‖ ^ 2 + 1 / (↑n + 1) := by - apply add_pos_of_nonneg_of_pos - · apply sq_nonneg - · positivity - by_contra hn - rw [hn] at h1 - simp at h1 - -lemma potentialLimitSeries_fderiv_eq_potentialLimitseries_mul - (x y : EuclideanSpace ℝ (Fin 3)) (n : ℕ) : - fderiv ℝ (potentialLimitSeries n) x y = - (potentialLimitSeries n x) ^ 3 * ⟪x, y⟫_ℝ := by - rw [potentialLimitSeries_fderiv] - congr - simp only [one_div, inv_inj] - ring +@[simp] +lemma threeDimPointParticleCurrentDensity_currentDensity (c : SpeedOfLight) (q : ℝ) (r₀ : Space 3) : + (threeDimPointParticleCurrentDensity c q r₀).currentDensity c = 0 := by + ext ε i + simp [threeDimPointParticleCurrentDensity, DistLorentzCurrentDensity.currentDensity, + Lorentz.Vector.spatialCLM, constantTime_apply] /-! -#### Part D.2.IV. - as `n → ∞` the limit of the derivative of `potentialLimitSeries n` in the direction `y` is - `-⟪(‖x‖ ^ 3)⁻¹ • x, y⟫_ℝ`. This is exactly the derivative of `‖x‖⁻¹` - in the direction `y`, when it exists (i.e. when `x ≠ 0`). +## B. The Potentials -/ -lemma potentialLimitSeries_fderiv_tendsto (x y : EuclideanSpace ℝ (Fin 3)) (hx : x ≠ 0) : - Filter.Tendsto (fun n => fderiv ℝ (potentialLimitSeries n) x y) Filter.atTop - (𝓝 (-⟪(‖x‖ ^ 3)⁻¹ • x, y⟫_ℝ)) := by - conv => enter [1, n]; rw [potentialLimitSeries_fderiv, neg_mul] - apply Filter.Tendsto.neg - rw [inner_smul_left] - apply Filter.Tendsto.mul_const - simp only [map_inv₀, conj_trivial] - have hx' : (‖x‖ ^ 3)⁻¹ = ‖x‖⁻¹^ 3 := by exact Eq.symm (inv_pow ‖x‖ 3) - rw [hx'] - apply Filter.Tendsto.pow - convert potentialLimitSeries_tendsto x hx - rw [potentialLimitSeries_eq] - simp only [one_div] - ring_nf - /-! -#### Part D.2.V - -Because we are integrating, we need to show some integrability and measurability properties -of `potentialLimitSeries` and it's derivative. - -We first show that they are almost everywhere strongly measurable. +### B.1. The electromagnetic potential --/ - -@[fun_prop] -lemma potentialLimitSeries_aeStronglyMeasurable (n : ℕ) : - AEStronglyMeasurable (potentialLimitSeries n) := by - rw [potentialLimitSeries_eq] - refine StronglyMeasurable.aestronglyMeasurable ?_ - refine stronglyMeasurable_iff_measurable.mpr ?_ - fun_prop - -@[fun_prop] -lemma potentialLimitSeries_fderiv_aeStronglyMeasurable (n : ℕ) (y : EuclideanSpace ℝ (Fin 3)) : - AEStronglyMeasurable (fun x => fderiv ℝ (potentialLimitSeries n) x y) := by - refine StronglyMeasurable.aestronglyMeasurable ?_ - refine stronglyMeasurable_iff_measurable.mpr ?_ - fun_prop - -/-! - -#### Part D.2.VI. +The 4-potential of a point particle in 3d space is given by: -We now show that `potentialLimitSeries` satisfies the condition `IsDistBounded`. -Along with the fact it is almost everywhere strongly measurable, this means -it can be made into a tempered distribution, but for our purposes means that it is -integrable when multiplied by a Schwartz map. +$$A(r) = \frac{q μ₀ c}{4 π |r - r₀|} (1, 0, 0, 0) $$ -There are a number of precursory lemmas first. +where $μ₀$ is the permeability of free space, $c$ is the speed of light, +$q$ is the charge of the particle and $r₀$ is the position of the particle in 3d space. -/ - -lemma potentialLimitSeries_eq_sqrt_inv (n : ℕ) : - potentialLimitSeries n = fun x => √(‖x‖ ^ 2 + 1/(n + 1))⁻¹ := by - funext x - rw [potentialLimitSeries_eq] - simp only [one_div, sqrt_inv] - rw [sqrt_eq_rpow] - nth_rewrite 2 [← Real.rpow_neg_one] - rw [← Real.rpow_mul] +open Real + +/-- The electromagnetic potential of a point particle stationary at `r₀` + of 3d space. -/ +noncomputable def threeDimPointParticle (𝓕 : FreeSpace) (q : ℝ) (r₀ : Space 3) : + DistElectromagneticPotential 3 := (SpaceTime.distTimeSlice 𝓕.c).symm <| Space.constantTime <| + distOfFunction (fun x => (((q * 𝓕.μ₀ * 𝓕.c)/ (4 * π)) * ‖x - r₀‖⁻¹) • + Lorentz.Vector.basis (Sum.inl 0)) + (((IsDistBounded.inv_shift _).const_mul_fun _).smul_const _) + +lemma threeDimPointParticle_eq_distTranslate (𝓕 : FreeSpace) (q : ℝ) (r₀ : Space 3) : + threeDimPointParticle 𝓕 q r₀ = ((SpaceTime.distTimeSlice 𝓕.c).symm <| + constantTime <| + distTranslate (basis.repr r₀) <| + distOfFunction (fun x => (((q * 𝓕.μ₀ * 𝓕.c)/ (4 * π))* ‖x‖⁻¹) • + Lorentz.Vector.basis (Sum.inl 0)) + ((IsDistBounded.inv.const_mul_fun _).smul_const _)) := by + rw [threeDimPointParticle] congr - ring - positivity - -lemma potentialLimitSeries_nonneg (n : ℕ) (x : EuclideanSpace ℝ (Fin 3)) : - 0 ≤ potentialLimitSeries n x := by - rw [potentialLimitSeries_eq_sqrt_inv] - simp - -lemma potentialLimitSeries_bounded_neq_zero (n : ℕ) (x : EuclideanSpace ℝ (Fin 3)) (hx : x ≠ 0) : - ‖potentialLimitSeries n x‖ ≤ ‖x‖⁻¹ := by - simp only [norm_eq_abs] - rw [abs_of_nonneg (potentialLimitSeries_nonneg _ _)] - rw [potentialLimitSeries_eq_sqrt_inv] - simp only [one_div, sqrt_inv] - have hx : 0 < ‖x‖ := by positivity - generalize ‖x‖ = r at * - refine inv_anti₀ hx ?_ - refine (le_sqrt' hx).mpr ?_ - simp only [le_add_iff_nonneg_right, inv_nonneg] - linarith - -lemma potentialLimitSeries_bounded (n : ℕ) (x : EuclideanSpace ℝ (Fin 3)) : - ‖potentialLimitSeries n x‖ ≤ ‖x‖⁻¹ + √(n + 1) := by - by_cases hx : x = 0 - · subst hx - simp only [norm_eq_abs, norm_zero, inv_zero, zero_add] - rw [abs_of_nonneg (potentialLimitSeries_nonneg _ _)] - simp [potentialLimitSeries_eq_sqrt_inv] - · apply (potentialLimitSeries_bounded_neq_zero n x hx).trans - simp - -lemma potentialLimitSeries_isDistBounded (n : ℕ) : - IsDistBounded (potentialLimitSeries n) := by - apply IsDistBounded.mono (f := fun x => ‖x‖⁻¹ + √(n + 1)) - · apply IsDistBounded.add - · apply IsDistBounded.inv - · apply IsDistBounded.const - · intro x - apply (potentialLimitSeries_bounded n x).trans - apply le_of_eq - simp only [Nat.succ_eq_add_one, Nat.reduceAdd, norm_eq_abs] - rw [abs_of_nonneg] - positivity - -/-! - -#### Part D.2.VII. - -In a similar fashion, and for the same reason, -we now show that the derivative of `potentialLimitSeries` satisfies the condition `IsDistBounded`. - --/ - -lemma potentialLimitSeries_fderiv_bounded (n : ℕ) - (x y : EuclideanSpace ℝ (Fin 3)) : - ‖fderiv ℝ (potentialLimitSeries n) x y‖ ≤ (‖x‖⁻¹) ^ 2 * ‖y‖ := by - by_cases hx : x = 0 - · subst hx - rw [potentialLimitSeries_fderiv] - simp - trans (‖x‖⁻¹) ^ 3 * ‖x‖ * ‖y‖ - rw [potentialLimitSeries_fderiv_eq_potentialLimitseries_mul] - simp only [neg_mul, norm_neg, norm_mul, norm_pow, norm_eq_abs, inv_pow] - rw [mul_assoc] - refine mul_le_mul_of_nonneg ?_ ?_ ?_ ?_ - · trans ‖x‖⁻¹ ^ 3 - · refine (pow_le_pow_iff_left₀ ?_ ?_ ?_).mpr ?_ - · exact abs_nonneg (potentialLimitSeries n x) - · simp - · simp - · exact potentialLimitSeries_bounded_neq_zero n x hx - · apply le_of_eq - exact inv_pow ‖x‖ 3 - · exact abs_real_inner_le_norm x y - · positivity - · positivity - apply le_of_eq - have hx : 0 < ‖x‖ := by positivity - field_simp - -lemma potentialLimitSeries_fderiv_isDistBounded (n : ℕ) (y : EuclideanSpace ℝ (Fin 3)) : - IsDistBounded (fun x => fderiv ℝ (potentialLimitSeries n) x y) := by - apply IsDistBounded.mono (f := fun x => (‖x‖⁻¹) ^ 2 * ‖y‖) - · conv => enter [1, x]; rw [mul_comm] - apply IsDistBounded.const_mul_fun - convert IsDistBounded.pow (dm1 := 2) (-2) (by simp) using 1 - funext x - simp - rfl - · intro x - apply (potentialLimitSeries_fderiv_bounded n x y).trans - simp + ext η + simp [distTranslate_ofFunction] /-! -### D.3. A series of integrals - -We now show that the integral -`∫ r, d_y η r * ‖r‖⁻¹ + η r * -⟪(‖r‖ ^ 3)⁻¹ • x, r⟫_ℝ` is the limit of the integrals -`∫ r, d_y (η r * potentialLimitSeries n r)` as `n → ∞`. - --/ +### B.2. The scalar potential -/-! -#### Part D.3.I. +The first component of the 4-potential is the scalar potential, once +one has taken account of factors of the speed of light. It is given by: -We first define a series of functions which are the integrands of -`∫ r, d_y (η r * potentialLimitSeries n r)`. -These functions are `potentialLimitSeriesFDerivSchwartz y η n r`. +$$V(r) = \frac{q}{4 π \epsilon_0 |r - r_0|}.$$ -/ -/-- A series of functions of the form `fderiv ℝ (fun x => η x * potentialLimitSeries n x) x y`. -/ -def potentialLimitSeriesFDerivSchwartz - (y : EuclideanSpace ℝ (Fin 3)) (η : 𝓢(EuclideanSpace ℝ (Fin 3), ℝ)) (n : ℕ) - (x : EuclideanSpace ℝ (Fin 3)) : ℝ := - fderiv ℝ (fun x => η x * potentialLimitSeries n x) x y - -lemma potentialLimitSeriesFDerivSchwartz_eq - (y : EuclideanSpace ℝ (Fin 3)) (η : 𝓢(EuclideanSpace ℝ (Fin 3), ℝ)) (n : ℕ) - (x : EuclideanSpace ℝ (Fin 3)) : - potentialLimitSeriesFDerivSchwartz y η n x= - fderiv ℝ η x y * potentialLimitSeries n x + η x * fderiv ℝ (potentialLimitSeries n) x y := by - simp [potentialLimitSeriesFDerivSchwartz] - rw [fderiv_fun_mul] - simp only [ContinuousLinearMap.add_apply, ContinuousLinearMap.coe_smul', Pi.smul_apply, +lemma threeDimPointParticle_scalarPotential (𝓕 : FreeSpace) (q : ℝ) (r₀ : Space 3) : + (threeDimPointParticle 𝓕 q r₀).scalarPotential 𝓕.c = + Space.constantTime (distOfFunction (fun x => (q/ (4 * π * 𝓕.ε₀))• ‖x - r₀‖⁻¹) + (((IsDistBounded.inv_shift _).const_mul_fun _))) := by + ext ε + simp only [scalarPotential, Lorentz.Vector.temporalCLM, Fin.isValue, map_smul, + ContinuousLinearMap.comp_smulₛₗ, ringHom_apply, threeDimPointParticle, LinearMap.coe_mk, + AddHom.coe_mk, ContinuousLinearEquiv.apply_symm_apply, ContinuousLinearMap.coe_smul', + ContinuousLinearMap.coe_comp', LinearMap.coe_toContinuousLinearMap', Pi.smul_apply, + Function.comp_apply, constantTime_apply, distOfFunction_vector_eval, Lorentz.Vector.apply_smul, + Lorentz.Vector.basis_apply, ↓reduceIte, mul_one, smul_eq_mul] + rw [distOfFunction_mul_fun _ (IsDistBounded.inv_shift _), + distOfFunction_mul_fun _ (IsDistBounded.inv_shift _)] + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] - ring - · exact SchwartzMap.differentiableAt η - · refine Differentiable.differentiableAt ?_ - exact potentialLimitSeries_differentiable n - -/-! -#### Part D.3.II. - -We show that these integrands converge to the integrand of -`∫ r, d_y η r * ‖r‖⁻¹ + η r * -⟪(‖r‖ ^ 3)⁻¹ • x, r⟫_ℝ` as `n → ∞`. - --/ -lemma potentialLimitSeriesFDerivSchwartz_tendsto - (y : EuclideanSpace ℝ (Fin 3)) (η : 𝓢(EuclideanSpace ℝ (Fin 3), ℝ)) : - ∀ᵐ (a : EuclideanSpace ℝ (Fin 3)) ∂(volume), - Filter.Tendsto (fun n => potentialLimitSeriesFDerivSchwartz y η n a) - Filter.atTop (𝓝 (fderiv ℝ η a y * ‖a‖⁻¹ + η a * -⟪(‖a‖ ^ 3)⁻¹ • a, y⟫_ℝ)) := by - rw [Filter.eventually_iff_exists_mem] - use {0}ᶜ - constructor - · rw [compl_mem_ae_iff, measure_singleton] - intro x hx - simp at hx - conv => enter [1, n]; rw [potentialLimitSeriesFDerivSchwartz_eq y η n x] - apply Filter.Tendsto.add - · apply Filter.Tendsto.const_mul - exact potentialLimitSeries_tendsto x hx - · apply Filter.Tendsto.mul - · exact tendsto_const_nhds - · exact potentialLimitSeries_fderiv_tendsto x y hx + ring_nf + simp only [𝓕.c_sq, one_div, mul_inv_rev, mul_eq_mul_right_iff, inv_eq_zero, OfNat.ofNat_ne_zero, + or_false] + field_simp /-! -#### Part D.3.III. +### B.3. The vector potential is zero -We use 'Lebesgue dominated convergence theorem' to show that the integrals -`∫ r, d_y (η r * potentialLimitSeries n r)` converge to the integral -`∫ r, d_y η r * ‖r‖⁻¹ + η r * -⟪(‖r‖ ^ 3)⁻¹ • x, r⟫_ℝ` as `n → ∞`. +The spatial components of the 4-potential give the vector potential, which is zero +for a stationary point particle. -This requires some measurability properties of `potentialLimitSeriesFDerivSchwartz` -and uses the integrability properties of `potentialLimitSeries` and -its derivative shown above. +$$\vec A(r) = 0.$$ -/ -lemma potentialLimitSeriesFDerivSchwartz_aeStronglyMeasurable - (y : EuclideanSpace ℝ (Fin 3)) (η : 𝓢(EuclideanSpace ℝ (Fin 3), ℝ)) (n : ℕ) : - AEStronglyMeasurable (fun x => potentialLimitSeriesFDerivSchwartz y η n x) := by - conv => enter [1, x]; rw [potentialLimitSeriesFDerivSchwartz_eq y η n x] - fun_prop - -lemma potentialLimitSeriesFDerivSchwartz_integral_tendsto_eq_integral - (y : EuclideanSpace ℝ (Fin 3)) (η : 𝓢(EuclideanSpace ℝ (Fin 3), ℝ)) : - Filter.Tendsto (fun n => ∫ (x : EuclideanSpace ℝ (Fin 3)), - potentialLimitSeriesFDerivSchwartz y η n x) Filter.atTop - (𝓝 (∫ (x : EuclideanSpace ℝ (Fin 3)), fderiv ℝ η x y * ‖x‖⁻¹ + - η x * -⟪(‖x‖ ^ 3)⁻¹ • x, y⟫_ℝ)) := by - refine MeasureTheory.tendsto_integral_of_dominated_convergence - (fun x => ‖fderiv ℝ η x y * ‖x‖⁻¹‖+ ‖η x * (‖x‖⁻¹ ^ 2 * ‖y‖)‖) - (potentialLimitSeriesFDerivSchwartz_aeStronglyMeasurable y η) - ?_ ?_ - (potentialLimitSeriesFDerivSchwartz_tendsto y η) - · apply Integrable.add - · refine Integrable.norm ?_ - apply IsDistBounded.integrable_fderviv_schwartzMap_mul - · fun_prop - · refine StronglyMeasurable.aestronglyMeasurable ?_ - refine stronglyMeasurable_iff_measurable.mpr ?_ - fun_prop - · refine Integrable.norm ?_ - apply IsDistBounded.schwartzMap_mul_integrable - · conv => enter [1, x]; rw [mul_comm] - refine IsDistBounded.const_mul_fun ?_ ‖y‖ - convert IsDistBounded.pow (dm1 := 2) (-2) (by simp) using 1 - funext x - simp - rfl - · refine StronglyMeasurable.aestronglyMeasurable ?_ - refine stronglyMeasurable_iff_measurable.mpr ?_ - fun_prop - · intro n - rw [Filter.eventually_iff_exists_mem] - use {0}ᶜ - constructor - · rw [compl_mem_ae_iff, measure_singleton] - intro x hx - simp at hx - simp [potentialLimitSeriesFDerivSchwartz_eq y η n x] - apply (abs_add_le _ _).trans - apply add_le_add - · simp [abs_mul] - refine mul_le_mul_of_nonneg ?_ ?_ ?_ ?_ - · rfl - · exact potentialLimitSeries_bounded_neq_zero n x hx - · exact abs_nonneg (fderiv ℝ η x y) - · positivity - · simp [abs_mul] - refine mul_le_mul_of_nonneg ?_ ?_ ?_ ?_ - · rfl - · convert potentialLimitSeries_fderiv_bounded n x y - simp - · exact abs_nonneg (η x) - · positivity +@[simp] +lemma threeDimPointParticle_vectorPotential (𝓕 : FreeSpace) (q : ℝ) (r₀ : Space 3) : + (threeDimPointParticle 𝓕 q r₀).vectorPotential 𝓕.c = 0 := by + ext ε i + simp [vectorPotential, Lorentz.Vector.spatialCLM, + threeDimPointParticle, constantTime_apply, distOfFunction_vector_eval] /-! -### D.4. The limit of the series of integrals is zero - -Above we showed that the limit of the integrals -`∫ r, d_y (η r * potentialLimitSeries n r)` as `n → ∞` is -`∫ r, d_y η r * ‖r‖⁻¹ + η r * -⟪(‖r‖ ^ 3)⁻¹ • x, r⟫_ℝ`. -We now show that this same limit is zero. +## C. The electric field --/ - -/-! -#### Part D.4.I. +The electric field of a point particle in 3d space is given by: +$$\vec E(r) = \frac{q}{4 π \epsilon_0} \frac{\vec r - \vec r₀}{|\vec r - \vec r₀|^3}.$$ -The integral -`∫ r, d_y (η r * potentialLimitSeries n r)` is zero for each `n : ℕ`. -This follows because this integrand is the total derivative of a differentiable function. -/ -lemma potentialLimitSeriesFDerivSchwartz_integral_eq_zero - (y : EuclideanSpace ℝ (Fin 3)) (η : 𝓢(EuclideanSpace ℝ (Fin 3), ℝ)) (n : ℕ) : - ∫ (x : EuclideanSpace ℝ (Fin 3)), potentialLimitSeriesFDerivSchwartz y η n x = 0 := by - conv_lhs => enter [2, x]; rw [potentialLimitSeriesFDerivSchwartz_eq y η n x] - rw [integral_add, integral_mul_fderiv_eq_neg_fderiv_mul_of_integrable] - simp only [add_neg_cancel] - · apply IsDistBounded.integrable_fderviv_schwartzMap_mul - · exact potentialLimitSeries_isDistBounded n - · exact potentialLimitSeries_aeStronglyMeasurable n - · apply IsDistBounded.schwartzMap_mul_integrable - · exact potentialLimitSeries_fderiv_isDistBounded n y - · exact potentialLimitSeries_fderiv_aeStronglyMeasurable n y - · apply IsDistBounded.schwartzMap_mul_integrable - · exact potentialLimitSeries_isDistBounded n - · exact potentialLimitSeries_aeStronglyMeasurable n - · exact SchwartzMap.differentiable η - · exact potentialLimitSeries_differentiable n - · apply IsDistBounded.integrable_fderviv_schwartzMap_mul - · exact potentialLimitSeries_isDistBounded n - · exact potentialLimitSeries_aeStronglyMeasurable n - · apply IsDistBounded.schwartzMap_mul_integrable - · exact potentialLimitSeries_fderiv_isDistBounded n y - · exact potentialLimitSeries_fderiv_aeStronglyMeasurable n y +lemma threeDimPointParticle_electricField (𝓕 : FreeSpace) (q : ℝ) (r₀ : Space 3) : + (threeDimPointParticle 𝓕 q r₀).electricField 𝓕.c = + (q/ (4 * π * 𝓕.ε₀)) • constantTime (distOfFunction (fun x : Space 3 => + ‖x - r₀‖ ^ (- 3 : ℤ) • basis.repr (x - r₀)) + ((IsDistBounded.zpow_smul_repr_self (- 3 : ℤ) (by omega)).comp_sub_right r₀)) := by + simp only [electricField, LinearMap.coe_mk, AddHom.coe_mk, threeDimPointParticle_scalarPotential, + smul_eq_mul, threeDimPointParticle_vectorPotential, map_zero, sub_zero, Int.reduceNeg, zpow_neg] + rw [constantTime_distSpaceGrad, distOfFunction_mul_fun _ + (IsDistBounded.inv_shift r₀)] + simp only [map_smul] + trans -(q / (4 * π * 𝓕.ε₀)) • (constantTime <| distGrad <| distTranslate (basis.repr r₀) <| + (distOfFunction (fun x => ‖x‖⁻¹) (IsDistBounded.inv))) + · simp [distTranslate_ofFunction] + rw [Space.distTranslate_distGrad] + have := Space.distGrad_distOfFunction_norm_zpow (d := 2) (-1) (by grind) + simp_all [distOfFunction_neg, distTranslate_ofFunction] /-! -#### Part D.4.II. -From part D.4.I it follows that the limit of the integrals -`∫ r, d_y (η r * potentialLimitSeries n r)` as `n → ∞` is zero, since each -individual integral is zero. +### C.1. the time derivative of the electric field -/ -lemma potentialLimitSeriesFDerivSchwartz_integral_tendsto_eq_zero - (y : EuclideanSpace ℝ (Fin 3)) (η : 𝓢(EuclideanSpace ℝ (Fin 3), ℝ)) : - Filter.Tendsto (fun n => ∫ (x : EuclideanSpace ℝ (Fin 3)), - potentialLimitSeriesFDerivSchwartz y η n x) Filter.atTop (𝓝 (0)) := by - conv => enter [1, n]; rw [potentialLimitSeriesFDerivSchwartz_integral_eq_zero y η n] - simp - -/-! - -### D.5. E = -∇ V for a particle at the origin - -We now put everything together. In part D.1 we showed that `E = -∇ V` follows from the integral -`∫ r, d_y η r * ‖r‖⁻¹ + η r * -⟪(‖r‖ ^ 3)⁻¹ • x, r⟫_ℝ = 0` for all Schwartz maps `η` and -directions `y`. -In part D.3 we showed that this integral is the limit of the integrals -`∫ r, d_y (η r * potentialLimitSeries n r)` as `n → ∞`. -In part D.4 we showed that this limit is zero, and therefore this integral itself must be zero. - -It follows that `E = -∇ V` for a particle at the origin. --/ -lemma electricField_eq_neg_gradD_electricPotential_origin (q ε : ℝ) : - electricField q ε 0 = - Space.gradD (electricPotential q ε 0) := - Eq.symm <| - gradD_electricPotential_eq_electricField_of_integral_eq_zero q ε <| - fun η y => tendsto_nhds_unique - (potentialLimitSeriesFDerivSchwartz_integral_tendsto_eq_integral y η) - (potentialLimitSeriesFDerivSchwartz_integral_tendsto_eq_zero y η) - -/-! - -### D.6. E = -∇ V for a particle at r₀ - -The general case of a particle at `r₀` follows from the case of a particle at the origin -by using that the gradient commutes with translation. - --/ -lemma electricField_eq_neg_gradD_electricPotential (q ε : ℝ) (r₀ : EuclideanSpace ℝ (Fin 3)) : - electricField q ε r₀ = - Space.gradD (electricPotential q ε r₀) := by - rw [electricField_eq_translateD, electricPotential_eq_translateD] - simp only [Space.translateD_gradD] - rw [electricField_eq_neg_gradD_electricPotential_origin] +@[simp] +lemma threeDimPointParticle_electricField_timeDeriv (𝓕 : FreeSpace) (q : ℝ) (r₀ : Space 3) : + Space.distTimeDeriv ((threeDimPointParticle 𝓕 q r₀).electricField 𝓕.c) = 0 := by + rw [threeDimPointParticle_electricField] simp -lemma electricField_eq_ofPotential_electricPotential (q ε : ℝ) (r₀ : EuclideanSpace ℝ (Fin 3)) : - electricField q ε r₀ = ofPotential (electricPotential q ε r₀) := - electricField_eq_neg_gradD_electricPotential q ε r₀ - -/-! - -## E. Faraday's law - -Faraday's law, which says that `∇ × E = 0`, -is an immediate consequence of the fact that `E = -∇ V`, because -the curl of a gradient is always zero. - --/ - -lemma faradaysLaw (q ε : ℝ) (r₀ : Space) : (electricField q ε r₀).FaradaysLaw := by - rw [electricField_eq_ofPotential_electricPotential] - exact ofPotential_faradaysLaw (electricPotential q ε r₀) - /-! -## F. Gauss' law - -We now prove Gauss' law for a point particle in 3-dimensions. Recall that Gauss' law states that -the divergence of the electric field is equal to the charge density divided by the permittivity, -i.e. `∇ • E = ρ/ε`. +## D. The magnetic field -In this case, this result is related to the sometimes confusing fact that -`∇ • ((‖r‖⁻¹) ^ 3 • r) ∝ δ(r)`. - -We first prove Gauss' law for a point particle at the origin, and then use translation to -prove it for a point particle at `r₀`. +Given that the vector potential is zero, the magnetic field is also zero. -/ -/-! - -### F.1. Gauss' law for a point particle at the origin - -The proof of Gauss' law for a point particle at the origin follows the proof given here: -https://math.stackexchange.com/questions/2409008/ - -We highlight the main steps of the proof here (the below comments also appear -in-line within the proof) : -- **Step 1**: `∇ ⬝ E = 1/ε ρ` if for all Schwartz maps`η`, `∇ ⬝ E η = (1/ε ρ) η`. -- **Step 2**: We focus on rewriting the LHS, by definition it is equal to - `- ∫ d³r ⟪(q/(4 * π * ε)) • ‖r‖⁻¹ ^ 3 • r, (∇ η) r⟫` -- **Step 3**: We rearrange the integral to - `- q/(4 * π * ε) * ∫ d³r ‖r‖⁻¹ ^ 2 * ⟪‖r‖⁻¹ • r), (∇ η) r⟫` -- **Step 4**: We use that `⟪‖r‖⁻¹ • r), (∇ η) r⟫ = (d(η (a • ‖r‖⁻¹ • r))/d a)_‖r‖` - to rewrite the integral as - `- q/(4 * π * ε) * ∫ d³r ‖r‖⁻¹ ^ 2 * (d(η (a • ‖r‖⁻¹ • r))/d a)_‖r‖`. -- **Step 5**: We move over to spherical coordinates rewriting - `d³r` as `r² dr dn` where `dn` is the integral over the unit vectors `n`. - In `d³r` the `r` is a vector whilst in `r² dr dn` the `r` is a scalar (the distance). - `- q/(4 * π * ε) * ∫ dr² dr dn r⁻¹ ^ 2 * (d(η (a • n))/d a)_r` -- **Step 6**: The integral is rearranged to - `- q/(4 * π * ε) * ∫ dn (∫_0^∞ r² dr r⁻¹ ^ 2 * (d(η (a • n))/d a)_r)` -- **Step 7**: The integral is further rearranged to - `- q/(4 * π * ε) * ∫ dn (∫_0^∞ dr (d(η (a • n))/d a)_r)` -- **Step 8**: The inner integral `(∫_0^∞ dr (d(η (a • n))/d a)_r)` is an integral over - a total derivative of a function which tends to zero at infinity, - and so is equal to `-η 0`. Thus the integral is equal to - `- q/(4 * π * ε) * ∫ dn (-η 0)`. -- **Step 9**: The integral `∫ dn` is equal to the surface area of the unit sphere, which is - `4 * π`. And thus we get after some simplification - `(q/ε) * η 0`. -- **Step 10**: This is manifestly equal to the right hand side `1/ε ρ η` since `ρ = q δ(r)`, - thereby proving the result. - --/ - -/-- Gauss' law for a point particle in 3-dimensions at the origin, that is this theorem states that - the divergence of `(q/(4 * π * ε)) • ‖r‖⁻¹ ^ 3 • r` is equal to `q • δ(r)`. -/ -lemma gaussLaw_origin (q ε : ℝ) : (electricField q ε 0).GaussLaw ε (chargeDistribution q 0) := by - /- Step 1: `∇ ⬝ E = 1/ε ρ` if for all Schwartz maps`η`, `∇ ⬝ E η = (1/ε ρ) η`. -/ +@[simp] +lemma threeDimPointParticle_magneticFieldMatrix (q : ℝ) (r₀ : Space 3) : + (threeDimPointParticle 𝓕 q r₀).magneticFieldMatrix 𝓕.c = 0 := by ext η - /- Preliminary definitions. -/ - let η' (n : ↑(Metric.sphere 0 1)) : 𝓢(ℝ, ℝ) := compCLM (g := fun a => a • n.1) ℝ (by - apply And.intro - · fun_prop - · intro n' - match n' with - | 0 => - simp [norm_smul] - use 1, 1 - simp - | 1 => - use 0, 1 - intro x - rw [iteratedFDeriv_succ_eq_comp_right] - simp [fderiv_smul_const] - | n' + 1 + 1 => - use 0, 0 - intro x - simp only [norm_eq_abs, pow_zero, mul_one, norm_le_zero_iff] - rw [iteratedFDeriv_succ_eq_comp_right] - simp [fderiv_smul_const] - rw [iteratedFDeriv_succ_const] - simp - rfl) (by use 1, 1; simp [norm_smul]) η - let s : Set (EuclideanSpace ℝ (Fin 3)) := {0}ᶜ - haveI : MeasureSpace s := by - exact Measure.Subtype.measureSpace - calc _ - _ = (divD (electricField q ε 0)) η := by rfl - /- Step 2: We focus on rewriting the LHS, by definition it is equal to - `- ∫ d³r ⟪(q/(4 * π * ε)) • ‖r‖⁻¹ ^ 3 • r, (∇ η) r⟫`. -/ - _ = - ∫ r, ⟪(q/(4 * π * ε)) • ‖r‖⁻¹ ^ 3 • r, Space.grad η r⟫_ℝ := by - rw [electricField, Space.divD_ofFunction] - simp - /- Step 3: We rearrange the integral to - `- q/(4 * π * ε) * ∫ d³r ‖r‖⁻¹ ^ 2 * ⟪‖r‖⁻¹ • r), (∇ η) r⟫`. -/ - _ = - (q/(4 * π * ε)) * ∫ r : Space 3, ‖r‖⁻¹ ^ 2 * ⟪‖r‖⁻¹ • r, Space.grad η r⟫_ℝ := by - simp [inner_smul_left, integral_const_mul] - left - congr - funext r - ring - /- Step 4: We use that `⟪‖r‖⁻¹ • r), (∇ η) r⟫ = (d(η (a • ‖r‖⁻¹ • r))/d a)_‖r‖` - to rewrite the integral as - `- q/(4 * π * ε) * ∫ d³r ‖r‖⁻¹ ^ 2 * (d(η (a • ‖r‖⁻¹ • r))/d a)_‖r‖`. -/ - _ = - (q/(4 * π * ε)) * ∫ r : Space 3, ‖r‖⁻¹ ^ 2 * - (_root_.deriv (fun a => η (a • ‖r‖⁻¹ • r)) ‖r‖) := by - congr - funext r - congr - rw [real_inner_comm, ← grad_inner_space_unit_vector _ _ (SchwartzMap.differentiable η)] - /- Step 5: We move over to spherical coordinates rewriting - `d³r` as `r² dr dn` where `dn` is the integral over the unit vectors `n`. - In `d³r` the `r` is a vector whilst in `r² dr dn` the `r` is a scalar (the distance). - `- q/(4 * π * ε) * ∫ dr² dr dn r⁻¹ ^ 2 * (d(η (a • n))/d a)_r` -/ - _ = - (q/(4 * π * ε)) * ∫ r, ‖r.2.1‖⁻¹ ^ 2 * - (_root_.deriv (fun a => η (a • r.1)) ‖r.2.1‖) - ∂(volume (α := EuclideanSpace ℝ (Fin 3)).toSphere.prod - (Measure.volumeIoiPow (Module.finrank ℝ (EuclideanSpace ℝ (Fin 3)) - 1))) := by - rw [← MeasureTheory.MeasurePreserving.integral_comp (f := homeomorphUnitSphereProd _) - (MeasureTheory.Measure.measurePreserving_homeomorphUnitSphereProd - (volume (α := EuclideanSpace ℝ (Fin 3)))) - (Homeomorph.measurableEmbedding (homeomorphUnitSphereProd (EuclideanSpace ℝ (Fin 3))))] - congr 1 - simp only [inv_pow, homeomorphUnitSphereProd_apply_snd_coe, norm_norm, - homeomorphUnitSphereProd_apply_fst_coe] - let f (x : Space 3) : ℝ := - (‖↑x‖ ^ 2)⁻¹ * _root_.deriv (fun a => η (a • ‖↑x‖⁻¹ • ↑x)) ‖↑x‖ - conv_rhs => - enter [2, x] - change f x.1 - rw [MeasureTheory.integral_subtype_comap (by simp), ← setIntegral_univ] - change ∫ x in Set.univ, f x = ∫ (x : Space) in _, f x - refine (setIntegral_congr_set ?_) - rw [← MeasureTheory.ae_eq_set_compl] - trans (∅ : Set (EuclideanSpace ℝ (Fin 3))) - · apply Filter.EventuallyEq.of_eq - rw [← Set.compl_empty] - exact compl_compl _ - · symm - simp - /- Step 6: The integral is rearranged to - `- q/(4 * π * ε) * ∫ dn (∫_0^∞ r² dr r⁻¹ ^ 2 * (d(η (a • n))/d a)_r)` -/ - _ = - (q/(4 * π * ε)) * ∫ n, (∫ r, ‖r.1‖⁻¹ ^ 2 * - (_root_.deriv (fun a => η (a • n)) ‖r.1‖) - ∂((Measure.volumeIoiPow (Module.finrank ℝ (EuclideanSpace ℝ (Fin 3)) - 1)))) - ∂(volume (α := EuclideanSpace ℝ (Fin 3)).toSphere) := by - congr 1 - rw [MeasureTheory.integral_prod] - /- Integrable condition. -/ - convert integrable_isDistBounded_inner_grad_schwartzMap_spherical - (f := fun r => ‖r‖⁻¹ ^ 3 • r) - (by - apply IsDistBounded.congr (f := fun r => ‖r‖ ^ (-2 : ℤ)) (IsDistBounded.pow _ (by simp)) - simp [norm_smul] - intro x - by_cases hx : ‖x‖ = 0 - · simp [hx, zpow_two] - · field_simp [zpow_two]) (by fun_prop) η - rename_i r - simp only [norm_eq_abs, inv_pow, sq_abs, Nat.succ_eq_add_one, Nat.reduceAdd, - Function.comp_apply, homeomorphUnitSphereProd_symm_apply_coe] - let x : Space 3 := r.2.1 • r.1.1 - have hr := r.2.2 - simp [-Subtype.coe_prop] at hr - have hr2 : r.2.1 ≠ 0 := by exact Ne.symm (ne_of_lt hr) - trans (r.2.1 ^ 2)⁻¹ * _root_.deriv (fun a => η (a • ‖↑x‖⁻¹ • ↑x)) ‖x‖ - · simp [x, norm_smul] - left - congr - funext a - congr - simp [smul_smul] - rw [abs_of_nonneg (le_of_lt hr)] - field_simp - simp - rw [← grad_inner_space_unit_vector] - rw [real_inner_comm] - simp [inner_smul_left, x, norm_smul, abs_of_nonneg (le_of_lt hr)] - field_simp - exact SchwartzMap.differentiable η - /- Step 7: The integral is further rearranged to - `- q/(4 * π * ε) * ∫ dn (∫_0^∞ dr (d(η (a • n))/d a)_r)` -/ - _ = - (q/(4 * π * ε)) * ∫ n, (∫ (r : Set.Ioi (0 : ℝ)), - (_root_.deriv (fun a => η (a • n)) r.1) ∂(.comap Subtype.val volume)) - ∂(volume (α := EuclideanSpace ℝ (Fin 3)).toSphere) := by - congr - funext n - simp [Measure.volumeIoiPow] - erw [integral_withDensity_eq_integral_smul] - congr - funext r - trans ((r.1 ^ 2).toNNReal : ℝ) • ((r.1 ^ 2)⁻¹ * _root_.deriv (fun a => η (a • ↑n)) |r.1|) - · rfl - trans ((r.1 ^ 2) : ℝ) • ((r.1 ^ 2)⁻¹ * _root_.deriv (fun a => η (a • ↑n)) |r.1|) - · congr - refine coe_toNNReal (↑r ^ 2) ?_ - apply pow_two_nonneg - have h1 : r.1 ≠ 0 := by exact ne_of_gt r.2 - simp only [smul_eq_mul] - field_simp - congr - rw [abs_of_nonneg] - have h1 := r.2 - simp [- Subtype.coe_prop] at h1 - exact le_of_lt h1 - fun_prop - /- Step 8: The inner integral `(∫_0^∞ dr (d(η (a • n))/d a)_r)` is an integral over - a total derivative of a function which tends to zero at infinity, - and so is equal to `-η 0`. Thus the integral is equal to - `- q/(4 * π * ε) * ∫ dn (-η 0) ` -/ - _ = - (q/(4 * π * ε)) * ∫ n, (-η 0) ∂(volume (α := EuclideanSpace ℝ (Fin 3)).toSphere) := by - congr - funext n - rw [MeasureTheory.integral_subtype_comap (by simp)] - rw [MeasureTheory.integral_Ioi_of_hasDerivAt_of_tendsto - (f := fun a => η (a • n)) (m := 0)] - · simp - · refine ContinuousAt.continuousWithinAt ?_ - fun_prop - · intro x hx - refine DifferentiableAt.hasDerivAt ?_ - have h1 : Differentiable ℝ η := by exact SchwartzMap.differentiable η - fun_prop - · change IntegrableOn (SchwartzMap.derivCLM ℝ (η' n)) (Set.Ioi 0) volume - refine Integrable.integrableOn ?_ - exact integrable ((derivCLM ℝ) (η' n)) - · change Filter.Tendsto (η' n) Filter.atTop (nhds 0) - exact Filter.Tendsto.mono_left (η' n).toZeroAtInfty.zero_at_infty' atTop_le_cocompact - /- Step 9: The integral `∫ dn` is equal to the surface area of the unit sphere, which is - `4 * π`. And thus we get after some simplification - `(q/ε) * η 0` -/ - _ = (q/(4 * π * ε)) * η 0 * (3 * (volume (α := EuclideanSpace ℝ (Fin 3))).real - (Metric.ball 0 1)) := by - simp only [integral_const, Measure.toSphere_real_apply_univ, finrank_euclideanSpace, - Fintype.card_fin, Nat.cast_ofNat, smul_eq_mul, mul_neg, neg_mul, neg_neg] - ring - _ = (q/(4 * π * ε)) * η 0 * (3 * (π * 4/3)) := by - congr - simp [Measure.real] - positivity - _ = (q/ε) * η 0 := by - by_cases hε : ε = 0 - · subst hε - simp - field_simp - /- Step 10: This is manifestly equal to the right hand side `1/ε ρ η` since `ρ = q δ(r)`, - thereby proving the result. -/ - simp [chargeDistribution] - ring + simp [magneticFieldMatrix_eq_vectorPotential] /-! -### F.2. Gauss' law for a point particle at `r₀` +## E. Maxwell's equations -We now show Gauss' law for a point particle at `r₀`. -This follows from the case of a point particle at the origin -by using that the divergence commutes with translation. +The divergence of the electric field of a point particle in 3d space is given by: +$$∇ · \vec E(r) = \frac{1}{\epsilon_0} q \delta(r - r₀).$$ --/ - -lemma gaussLaw (q ε : ℝ) (r₀ : EuclideanSpace ℝ (Fin 3)) : - (electricField q ε r₀).GaussLaw ε (chargeDistribution q r₀) := by - rw [electricField_eq_translateD, chargeDistribution_eq_translateD] - rw [gaussLaw_iff] - rw [Space.divD_translateD] - rw [gaussLaw_origin q ε] - simp - -/-! - -## G. Rotational invariance - -We now prove the electric field, charge distribution and potential of a point particle -are rotationally invariant. - -This is yet to be done, and is a TODO item. +From this, it follows that the electromagnetic potential of a point particle in 3d space +satisfies Maxwell's equations for a point particle at rest. -/ -/-- The electrostatic field of a point particle is rotationally invariant. -/ -informal_lemma electricField_rotationally_invariant where - deps := [``electricField] - tag := "L7NXF" +lemma threeDimPointParticle_div_electricField {𝓕} (q : ℝ) (r₀ : Space 3) : + distSpaceDiv ((threeDimPointParticle 𝓕 q r₀).electricField 𝓕.c) = + (1/𝓕.ε₀) • constantTime (q • diracDelta ℝ r₀) := by + rw [threeDimPointParticle_electricField] + simp only [Int.reduceNeg, zpow_neg, map_smul, smul_smul] + have h1 := Space.distDiv_inv_pow_eq_dim (d := 2) + simp at h1 + trans (q / (4 * π * 𝓕.ε₀)) • + distSpaceDiv (constantTime <| + distTranslate (basis.repr r₀) <| + (distOfFunction (fun x => ‖x‖ ^ (-3 : ℤ) • basis.repr x) + (IsDistBounded.zpow_smul_repr_self (- 3 : ℤ) (by omega)))) + · ext η + simp [distTranslate_ofFunction] + simp only [Int.reduceNeg, zpow_neg, one_div] + rw [constantTime_distSpaceDiv, distDiv_distTranslate, h1] + simp only [map_smul] + suffices h : volume.real (Metric.ball (0 : Space 3) 1) = (4/3 * Real.pi) by + rw [h] + simp [smul_smul] + ext η + simp [constantTime_apply, diracDelta_apply, distTranslate_apply] + left + ring_nf + field_simp + simp [MeasureTheory.Measure.real] + exact pi_nonneg + +lemma threeDimPointParticle_isExterma (𝓕 : FreeSpace) (q : ℝ) (r₀ : Space 3) : + (threeDimPointParticle 𝓕 q r₀).IsExtrema 𝓕 (threeDimPointParticleCurrentDensity 𝓕.c q r₀) := by + rw [isExtrema_iff_components] + apply And.intro + · intro ε + rw [gradLagrangian_sum_inl_0] + simp only [one_div, mul_inv_rev, threeDimPointParticleCurrentDensity_chargeDensity, map_smul, + ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] + rw [threeDimPointParticle_div_electricField] + simp only [one_div, map_smul, ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] + field_simp + simp [𝓕.c_sq] + right + field_simp + simp + · intro ε i + rw [gradLagrangian_sum_inr_i] + simp + +end DistElectromagneticPotential +end Electromagnetism diff --git a/PhysLean/Electromagnetism/Vacuum/Constant.lean b/PhysLean/Electromagnetism/Vacuum/Constant.lean index 7cabea81e..fe943b1c8 100644 --- a/PhysLean/Electromagnetism/Vacuum/Constant.lean +++ b/PhysLean/Electromagnetism/Vacuum/Constant.lean @@ -3,8 +3,7 @@ Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ -import PhysLean.Electromagnetism.Dynamics.KineticTerm -import PhysLean.ClassicalMechanics.VectorFields +import PhysLean.Electromagnetism.Dynamics.IsExtrema /-! # The constant electric and magnetic fields @@ -12,28 +11,24 @@ import PhysLean.ClassicalMechanics.VectorFields ## i. Overview In this module we define the electromagnetic potential which gives rise to a -given constant electric and magnetic field in 3d. +given constant electric and magnetic field matrix. -We show that the kinetic term for this potential has a variational gradient equal to -zero, i.e. it satisfies the source-free Maxwell equations. +We will show that this electromagnetic potential is an extrema of the free-space +electromagnetic action. ## ii. Key results -- `ElectromagneticPotential.constantEB E₀ B₀` : An electromagnetic potential which gives rise to a - given constant electric field `E₀` and magnetic field `B₀` in 3d. -- `ElectromagneticPotential.constantEB_gradKineticTerm` : The variational gradient of the kinetic - term for the potential `constantEB E₀ B₀` is equal to zero. - ## iii. Table of contents - A. The definition of the potential - B. Smoothness of the potential - C. The scalar potential - D. The vector potential + - D.1. Time derivative of the vector potential + - D.2. Space derivative of the vector potential - E. The electric field - F. The magnetic field -- G. The kinetic term -- H. The variational gradient of the kinetic term +- G. Is extrema ## iv. References @@ -60,181 +55,191 @@ attribute [-simp] Nat.succ_eq_add_one ## A. The definition of the potential -The potential which gives rise to a constant electric field `E₀` and magnetic field `B₀` in 3d is -given by -`(- ⟪E₀, x⟫, (1/2) B₀ × x)` -where `x` is the spatial position vector. +The electromagnetic potential which gives rise to a constant electric field `E₀` +and a constant magnetic field matrix `B₀`. -/ open Matrix - -/-- An electric potential in 3d which gives a given constant E-field and B-field. -/ -noncomputable def constantEB (E₀ B₀ : EuclideanSpace ℝ (Fin 3)) : ElectromagneticPotential 3 := +set_option linter.unusedVariables false +/-- An electric potential which gives a given constant E-field and B-field. -/ +@[nolint unusedArguments] +noncomputable def constantEB {d : ℕ} (c : SpeedOfLight) + (E₀ : EuclideanSpace ℝ (Fin d)) (B₀ : Fin d × Fin d → ℝ) + (B₀_antisymm : ∀ i j, B₀ (i, j) = - B₀ (j, i)) : ElectromagneticPotential d := fun x μ => match μ with - | Sum.inl _ => -⟪E₀, x.space⟫_ℝ - | Sum.inr i => (1/2) * (B₀ ⨯ₑ₃ x.space) i + | Sum.inl _ => - (1/c) * ⟪E₀, Space.basis.repr x.space⟫_ℝ + | Sum.inr i => (1/2) * ∑ j, B₀ (i, j) * x.space j /-! ## B. Smoothness of the potential -The potential `constantEB E₀ B₀` is smooth. +The potential is smooth. -/ -lemma constantEB_smooth {E₀ B₀ : EuclideanSpace ℝ (Fin 3)} : - ContDiff ℝ ∞ (constantEB E₀ B₀) := by - rw [contDiff_euclidean] +lemma constantEB_smooth {c : SpeedOfLight} + {E₀ : EuclideanSpace ℝ (Fin d)} {B₀ : Fin d × Fin d → ℝ} + {B₀_antisymm : ∀ i j, B₀ (i, j) = - B₀ (j, i)} : + ContDiff ℝ ∞ (constantEB c E₀ B₀ B₀_antisymm) := by + rw [← Lorentz.Vector.contDiff_apply] intro μ match μ with | Sum.inl _ => simp [constantEB] apply ContDiff.neg + apply ContDiff.mul + · fun_prop apply ContDiff.inner · fun_prop - · change ContDiff ℝ ∞ SpaceTime.space - fun_prop + · fun_prop | Sum.inr i => - fin_cases i - all_goals - simp [constantEB, cross_apply] + simp [constantEB] + apply ContDiff.mul + · fun_prop + · apply ContDiff.sum + intro j _ apply ContDiff.mul · fun_prop - apply ContDiff.sub - · fun_prop - · fun_prop + fun_prop /-! ## C. The scalar potential -The scalar potential for `constantEB E₀ B₀` is given by `-⟪E₀, x⟫`. +The scalar potential of the electromagnetic potential is given by `-⟪E₀, x⟫`. -/ -lemma constantEB_scalarPotential {E₀ B₀ : EuclideanSpace ℝ (Fin 3)} : - (constantEB E₀ B₀).scalarPotential = fun _ x => -⟪E₀, x⟫_ℝ := by +lemma constantEB_scalarPotential {c : SpeedOfLight} + {E₀ : EuclideanSpace ℝ (Fin d)} {B₀ : Fin d × Fin d → ℝ} + {B₀_antisymm : ∀ i j, B₀ (i, j) = - B₀ (j, i)} : + (constantEB c E₀ B₀ B₀_antisymm).scalarPotential c = fun _ x => + -⟪E₀, Space.basis.repr x⟫_ℝ := by ext t x - simp only [scalarPotential, timeSlice, constantEB, space_toCoord_symm, Equiv.coe_fn_mk, + simp [scalarPotential, timeSlice, constantEB, Equiv.coe_fn_mk, Function.curry_apply, Function.comp_apply] - rfl /-! ## D. The vector potential -The vector potential for `constantEB E₀ B₀` is given by `(1/2) B₀ × x`. +The vector potential of the electromagnetic potential is `(1 / 2) * ∑ j, B₀ (i, j) * x j `. -/ -lemma constantEB_vectorPotential {E₀ B₀ : EuclideanSpace ℝ (Fin 3)} : - (constantEB E₀ B₀).vectorPotential = fun _ x => (1/2 : ℝ) • B₀ ⨯ₑ₃ x := by +lemma constantEB_vectorPotential {c : SpeedOfLight} + {E₀ : EuclideanSpace ℝ (Fin d)} {B₀ : Fin d × Fin d → ℝ} + {B₀_antisymm : ∀ i j, B₀ (i, j) = - B₀ (j, i)} : + (constantEB c E₀ B₀ B₀_antisymm).vectorPotential c = fun _ x => WithLp.toLp 2 fun i => + (1 / 2) * ∑ j, B₀ (i, j) * x j := by ext t x i simp [vectorPotential, timeSlice, constantEB, space_toCoord_symm, Equiv.coe_fn_mk, Function.curry_apply, Function.comp_apply] - rfl /-! -## E. The electric field - -The electric field for `constantEB E₀ B₀` is given by `E₀`. +### D.1. Time derivative of the vector potential -/ +open Time @[simp] -lemma constantEB_electricField {E₀ B₀ : EuclideanSpace ℝ (Fin 3)} : - (constantEB E₀ B₀).electricField = fun _ _ => E₀ := by - funext t x - rw [electricField_eq] - simp only +lemma constantEB_vectorPotential_time_deriv {c : SpeedOfLight} + {E₀ : EuclideanSpace ℝ (Fin d)} {B₀ : Fin d × Fin d → ℝ} + {B₀_antisymm : ∀ i j, B₀ (i, j) = - B₀ (j, i)} (t : Time) (x : Space d) : + ∂ₜ ((constantEB c E₀ B₀ B₀_antisymm).vectorPotential c · x) t = 0 := by rw [constantEB_vectorPotential] - simp only [one_div, WithLp.equiv_apply, WithLp.ofLp_smul, map_smul, LinearMap.smul_apply, - WithLp.equiv_symm_apply, WithLp.toLp_smul] - rw [Time.deriv_eq, fderiv_fun_const] - simp only [Pi.zero_apply, ContinuousLinearMap.zero_apply, sub_zero] - rw [constantEB_scalarPotential] - simp only - erw [Space.grad_neg] - rw [Space.grad_inner_right] simp /-! -## F. The magnetic field - -The magnetic field for `constantEB E₀ B₀` is given by `B₀`. +### D.2. Space derivative of the vector potential -/ -@[simp] -lemma constantEB_magneticField {E₀ B₀ : EuclideanSpace ℝ (Fin 3)} : - (constantEB E₀ B₀).magneticField = fun _ _ => B₀ := by - funext t x - rw [magneticField_eq] - simp only +lemma constantEB_vectorPotential_space_deriv {c : SpeedOfLight} + {E₀ : EuclideanSpace ℝ (Fin d)} {B₀ : Fin d × Fin d → ℝ} + {B₀_antisymm : ∀ i j, B₀ (i, j) = - B₀ (j, i)} (t : Time) (x : Space d) (i j : Fin d) : + Space.deriv i ((constantEB c E₀ B₀ B₀_antisymm).vectorPotential c t · j) x = + (1 / 2) * B₀ (j, i) := by rw [constantEB_vectorPotential] - simp only [one_div, WithLp.equiv_apply, WithLp.ofLp_smul, map_smul, LinearMap.smul_apply, - WithLp.equiv_symm_apply, WithLp.toLp_smul] - ext i - fin_cases i - all_goals - · simp [Space.curl, Space.coord, cross_apply] - rw [Space.deriv_eq, Space.deriv_eq] - rw [fderiv_const_mul (by fun_prop)] + rw [Space.deriv_eq] + rw [fderiv_const_mul (by fun_prop)] + rw [fderiv_fun_sum (by fun_prop)] + simp only [one_div, ContinuousLinearMap.coe_smul', ContinuousLinearMap.coe_sum', Pi.smul_apply, + Finset.sum_apply, smul_eq_mul, mul_eq_mul_left_iff, inv_eq_zero, OfNat.ofNat_ne_zero, or_false] + rw [Finset.sum_eq_single i] + · rw [fderiv_const_mul (by fun_prop)] + simp [← Space.deriv_eq] + · intro k _ hk rw [fderiv_const_mul (by fun_prop)] - rw [fderiv_fun_sub (by fun_prop) (by fun_prop)] - rw [fderiv_fun_sub (by fun_prop) (by fun_prop)] - rw [fderiv_const_mul (by fun_prop)] - rw [fderiv_const_mul (by fun_prop)] - rw [fderiv_const_mul (by fun_prop)] - rw [fderiv_const_mul (by fun_prop)] - simp only [Fin.isValue, ContinuousLinearMap.coe_smul', ContinuousLinearMap.coe_sub', - Pi.smul_apply, Pi.sub_apply, smul_eq_mul] - repeat rw [← Space.deriv_eq] - repeat rw [Space.deriv_component] - simp only [Fin.isValue, ↓reduceIte, mul_one, one_ne_zero, mul_zero, sub_zero, Fin.reduceEq, - zero_sub, mul_neg, sub_neg_eq_add] - ring + simp [← Space.deriv_eq] + rw [Space.deriv_component_diff] + simp only [or_true] + exact id (Ne.symm hk) + · simp /-! -## G. The kinetic term - -The kinetic term for `constantEB E₀ B₀` is given by `1/2 (‖E₀‖² - ‖B₀‖²)`. -Note this is not the same as the kinetic energy. +## E. The electric field -/ -lemma constantEB_kineticTerm {E₀ B₀ : EuclideanSpace ℝ (Fin 3)} - (x : SpaceTime 3) : - (constantEB E₀ B₀).kineticTerm x = 1/2 * (‖E₀‖ ^ 2 - ‖B₀‖ ^ 2) := by - obtain ⟨t, rfl⟩ := SpaceTime.toTimeAndSpace.symm.surjective x - rw [kineticTerm_eq_electric_magnetic] - simp only [one_div, constantEB_electricField, constantEB_magneticField] - exact constantEB_smooth.differentiable (ENat.LEInfty.out) +@[simp] +lemma constantEB_electricField {c : SpeedOfLight} + {E₀ : EuclideanSpace ℝ (Fin d)} {B₀ : Fin d × Fin d → ℝ} + {B₀_antisymm : ∀ i j, B₀ (i, j) = - B₀ (j, i)} : + (constantEB c E₀ B₀ B₀_antisymm).electricField c = fun _ _ => E₀ := by + funext t x + rw [electricField_eq] + simp [constantEB_scalarPotential] + erw [Space.grad_neg] + conv_lhs => + enter [1, 1,1, x] + rw [real_inner_comm, Space.basis_repr_inner_eq, real_inner_comm] + rw [Space.grad_inner_right] + simp /-! -## H. The variational gradient of the kinetic term +## F. The magnetic field + +-/ + +@[simp] +lemma constantEB_magneticFieldMatrix {c : SpeedOfLight} + {E₀ : EuclideanSpace ℝ (Fin d)} {B₀ : Fin d × Fin d → ℝ} + {B₀_antisymm : ∀ i j, B₀ (i, j) = - B₀ (j, i)} : + (constantEB c E₀ B₀ B₀_antisymm).magneticFieldMatrix c = fun _ _ => B₀ := by + funext t x + funext i + match i with + | (i, j) => + rw [magneticFieldMatrix_eq_vectorPotential] + rw [constantEB_vectorPotential_space_deriv, constantEB_vectorPotential_space_deriv] + conv_lhs => + enter [2] + rw [B₀_antisymm] + ring + apply constantEB_smooth.differentiable (by simp) + +/-! -The variational gradient of the kinetic term for `constantEB E₀ B₀` is equal to zero. +## G. Is extrema -/ -lemma constantEB_gradKineticTerm {E₀ B₀ : EuclideanSpace ℝ (Fin 3)} : - (constantEB E₀ B₀).gradKineticTerm = 0 := by - funext x - rw [gradKineticTerm_eq_electric_magnetic] - rw [constantEB_electricField, constantEB_magneticField] - simp only [Space.div_const, Pi.zero_apply, Fin.isValue, zero_smul, Space.curl_const, - PiLp.zero_apply, sub_zero, zero_add] - apply Finset.sum_eq_zero - intro x _ - rw [Time.deriv, fderiv_fun_const] - simp only [Pi.zero_apply, ContinuousLinearMap.zero_apply, PiLp.zero_apply, zero_smul] - exact constantEB_smooth +lemma constantEB_isExtrema {𝓕 : FreeSpace} + {E₀ : EuclideanSpace ℝ (Fin d)} {B₀ : Fin d × Fin d → ℝ} + {B₀_antisymm : ∀ i j, B₀ (i, j) = - B₀ (j, i)} : + IsExtrema 𝓕 (constantEB 𝓕.c E₀ B₀ B₀_antisymm) 0 := by + rw [isExtrema_iff_gauss_ampere_magneticFieldMatrix] + · intro t x + simp + · exact constantEB_smooth + · exact contDiff_zero_fun end ElectromagneticPotential diff --git a/PhysLean/Electromagnetism/Vacuum/HarmonicWave.lean b/PhysLean/Electromagnetism/Vacuum/HarmonicWave.lean new file mode 100644 index 000000000..e3fca392b --- /dev/null +++ b/PhysLean/Electromagnetism/Vacuum/HarmonicWave.lean @@ -0,0 +1,678 @@ +/- +Copyright (c) 2025 Zhi Kai Pong. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong, Joseph Tooby-Smith +-/ +import PhysLean.Electromagnetism.Vacuum.IsPlaneWave +/-! + +# Harmonic Wave in Vacuum + +## i. Overview + +In this module we define the electromagnetic potential for a monochromatic harmonic wave +travelling in the x-direction in free space, and prove various properties about it, +including that it satisfies Maxwell's equations in free space, that it is a plane wave. + +We work here in a general dimension `d` so we use the magnetic field is the +form of a matrix rather than a vector. + +## ii. Key results + +- `harmonicWaveX` : Definition of the electromagnetic + potential for a harmonic wave travelling in the x-direction. +- `harmonicWaveX_isExtrema` : The harmonic wave satisfies Maxwell's equations in free space. +- `harmonicWaveX_isPlaneWave` : The harmonic wave is a plane wave. +- `harmonicWaveX_polarization_ellipse` : The polarization ellipse equation for the harmonic wave. + +## iii. Table of contents + +- A. The electromagnetic potential for a harmonic wave + - A.1. Differentiability of the electromagnetic potential + - A.2. Smoothness of the electromagnetic potential +- B. The scalar potential +- C. The vector potential + - C.1. Components of the vector potential + - C.2. Space derivatives of the vector potential +- D. The electric field + - D.1. Components of the electric field + - D.2. Spatial derivatives of the electric field + - D.3. Time derivatives of the electric field + - D.4. Divergence of the electric field +- E. The magnetic field matrix for a harmonic wave + - E.1. Components of the magnetic field matrix + - E.2. Space derivatives of the magnetic field matrix +- F. Maxwell's equations for a harmonic wave +- G. The harmonic wave is a plane wave +- H. Polarization ellipse of the harmonic wave + +## iv. References + +-/ +namespace Electromagnetism + +open Space Module +open Time +open ClassicalMechanics + +variable (OM : OpticalMedium) +open Matrix +open Real +namespace ElectromagneticPotential +open InnerProductSpace + +/-! + +## A. The electromagnetic potential for a harmonic wave + +-/ + +/-- The electromagnetic potential for a Harmonic wave travelling in the `x`-direction + with wave number `k`. -/ +noncomputable def harmonicWaveX (𝓕 : FreeSpace) (k : ℝ) (E₀ : Fin d → ℝ) + (φ : Fin d → ℝ) : ElectromagneticPotential d.succ := fun x μ => + match μ with + | Sum.inl 0 => 0 + | Sum.inr 0 => 0 + | Sum.inr ⟨Nat.succ i, h⟩ => -E₀ ⟨i, Nat.succ_lt_succ_iff.mp h⟩ * 1 / (𝓕.c * k) * + Real.sin (k * (𝓕.c * x.time 𝓕.c - x.space 0) + φ ⟨i, Nat.succ_lt_succ_iff.mp h⟩) + +/-! + +### A.1. Differentiability of the electromagnetic potential + +-/ + +lemma harmonicWaveX_differentiable {d} (𝓕 : FreeSpace) (k : ℝ) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) : + Differentiable ℝ (harmonicWaveX 𝓕 k E₀ φ) := by + rw [← Lorentz.Vector.differentiable_apply] + intro μ + match μ with + | Sum.inl 0 => simp [harmonicWaveX] + | Sum.inr ⟨0, h⟩ => simp [harmonicWaveX] + | Sum.inr ⟨Nat.succ i, h⟩ => + simp [harmonicWaveX] + apply Differentiable.const_mul + fun_prop + +/-! + +### A.2. Smoothness of the electromagnetic potential + +-/ + +lemma harmonicWaveX_contDiff {d} (n : WithTop ℕ∞) (𝓕 : FreeSpace) (k : ℝ) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) : + ContDiff ℝ n (harmonicWaveX 𝓕 k E₀ φ) := by + rw [← Lorentz.Vector.contDiff_apply] + intro μ + match μ with + | Sum.inl 0 => simp [harmonicWaveX]; fun_prop + | Sum.inr ⟨0, h⟩ => simp [harmonicWaveX]; fun_prop + | Sum.inr ⟨Nat.succ i, h⟩ => + simp [harmonicWaveX] + apply ContDiff.mul + · fun_prop + · fun_prop + +/-! + +## B. The scalar potential + +The scalar potential of the harmonic wave is zero. + +-/ + +@[simp] +lemma harmonicWaveX_scalarPotential_eq_zero {d} (𝓕 : FreeSpace) (k : ℝ) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) : + (harmonicWaveX 𝓕 k E₀ φ).scalarPotential 𝓕.c = 0 := by + ext x + simp [harmonicWaveX, scalarPotential] + rfl + +/-! + +## C. The vector potential + +-/ + +/-! + +### C.1. Components of the vector potential + +-/ + +@[simp] +lemma harmonicWaveX_vectorPotential_zero_eq_zero {d} (𝓕 : FreeSpace) (k : ℝ) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) : + (harmonicWaveX 𝓕 k E₀ φ).vectorPotential 𝓕.c t x 0 = 0 := by + simp [harmonicWaveX, vectorPotential, SpaceTime.timeSlice] + rfl + +lemma harmonicWaveX_vectorPotential_succ {d} (𝓕 : FreeSpace) (k : ℝ) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) (i : Fin d) : + (harmonicWaveX 𝓕 k E₀ φ).vectorPotential 𝓕.c t x i.succ = + - E₀ i * 1 / (𝓕.c * k) * Real.sin (k * (t.val * 𝓕.c - x 0) + φ i) := by + simp [harmonicWaveX, vectorPotential, SpaceTime.timeSlice, Fin.succ] + left + ring_nf + +lemma harmonicWaveX_vectorPotential_succ' {d} (𝓕 : FreeSpace) (k : ℝ) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) (i : ℕ) + (hi : i.succ < d.succ) : + (harmonicWaveX 𝓕 k E₀ φ).vectorPotential 𝓕.c t x ⟨i.succ, hi⟩ = + - E₀ ⟨i, by grind⟩ * 1 / (𝓕.c * k) * Real.sin (k * (t.val * 𝓕.c - x 0) + φ ⟨i, by grind⟩) := by + simp [harmonicWaveX, vectorPotential, SpaceTime.timeSlice] + left + ring_nf + +/-! + +### C.2. Space derivatives of the vector potential + +-/ + +open Space +@[simp] +lemma harmonicWaveX_vectorPotential_space_deriv_succ {d} (𝓕 : FreeSpace) (k : ℝ) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) (j : Fin d) + (i : Fin d.succ) : + Space.deriv j.succ (fun x => vectorPotential 𝓕.c (harmonicWaveX 𝓕 k E₀ φ) t x i) x + = 0 := by + match i with + | 0 => simp + | ⟨Nat.succ i, hi⟩ => + simp [harmonicWaveX_vectorPotential_succ'] + rw [Space.deriv_eq] + rw [fderiv_const_mul (by fun_prop)] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, mul_eq_zero, + div_eq_zero_iff, neg_eq_zero, SpeedOfLight.val_ne_zero, false_or] + rw [fderiv_sin (by fun_prop)] + simp only [fderiv_add_const, ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, + mul_eq_zero] + right + right + rw [fderiv_const_mul (by fun_prop)] + rw [fderiv_const_sub] + simp only [smul_neg, ContinuousLinearMap.neg_apply, ContinuousLinearMap.coe_smul', + Pi.smul_apply, smul_eq_mul, neg_eq_zero, mul_eq_zero] + rw [← Space.deriv_eq] + rw [Space.deriv_component] + simp + +open Space +@[simp] +lemma harmonicWaveX_vectorPotential_succ_space_deriv_zero {d} (𝓕 : FreeSpace) (k : ℝ) (hk : k ≠ 0) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) (i : Fin d) : + Space.deriv 0 (fun x => vectorPotential 𝓕.c (harmonicWaveX 𝓕 k E₀ φ) t x i.succ) x + = E₀ i / 𝓕.c.val * Real.cos (𝓕.c.val * k * t.val - k * x 0 + φ i) := by + simp [harmonicWaveX_vectorPotential_succ] + rw [Space.deriv_eq_fderiv_basis] + rw [fderiv_const_mul (by fun_prop)] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] + rw [fderiv_sin (by fun_prop)] + simp only [fderiv_add_const, ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] + rw [fderiv_const_mul (by fun_prop)] + rw [fderiv_const_sub] + simp only [smul_neg, ContinuousLinearMap.neg_apply, ContinuousLinearMap.coe_smul', Pi.smul_apply, + smul_eq_mul, mul_neg] + rw [← Space.deriv_eq_fderiv_basis] + rw [Space.deriv_component] + simp only [↓reduceIte, mul_one] + field_simp + +/-! + +## D. The electric field + +-/ + +/-! + +### D.1. Components of the electric field + +-/ +lemma harmonicWaveX_electricField_zero {d} (𝓕 : FreeSpace) (k : ℝ) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) : + (harmonicWaveX 𝓕 k E₀ φ).electricField 𝓕.c t x 0 = 0 := by + simp [ElectromagneticPotential.electricField] + rw [← Time.deriv_euclid] + simp only [harmonicWaveX_vectorPotential_zero_eq_zero, Time.deriv_const] + refine vectorPotential_differentiable_time (harmonicWaveX 𝓕 k E₀ φ) ?_ x + exact harmonicWaveX_differentiable 𝓕 k E₀ φ + +lemma harmonicWaveX_electricField_succ {d} (𝓕 : FreeSpace) (k : ℝ) (hk : k ≠ 0) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) (i : Fin d) : + (harmonicWaveX 𝓕 k E₀ φ).electricField 𝓕.c t x i.succ = + E₀ i * Real.cos (k * 𝓕.c * t.val - k * x 0 + φ i) := by + simp [ElectromagneticPotential.electricField] + rw [← Time.deriv_euclid] + simp [harmonicWaveX_vectorPotential_succ] + rw [Time.deriv_eq] + rw [fderiv_const_mul] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] + rw [fderiv_sin (by fun_prop)] + rw [fderiv_add_const] + rw [fderiv_const_mul (by fun_prop)] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] + rw [fderiv_sub_const] + rw [fderiv_mul_const (by fun_prop)] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, Time.fderiv_val, smul_eq_mul, mul_one] + field_simp + · fun_prop + · refine vectorPotential_differentiable_time (harmonicWaveX 𝓕 k E₀ φ) ?_ x + exact harmonicWaveX_differentiable 𝓕 k E₀ φ + +/-! + +### D.2. Spatial derivatives of the electric field + +-/ + +lemma harmonicWaveX_electricField_space_deriv_same {d} (𝓕 : FreeSpace) (k : ℝ) (hk : k ≠ 0) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) (i : Fin d.succ) : + Space.deriv i (fun x => electricField 𝓕.c (harmonicWaveX 𝓕 k E₀ φ) t x i) x + = 0 := by + match i with + | 0 => simp [harmonicWaveX_electricField_zero] + | ⟨Nat.succ i, hi⟩ => + rw [← Fin.succ_mk _ _ (by grind)] + conv_lhs => + enter [2, x] + rw [harmonicWaveX_electricField_succ _ _ hk] + rw [Space.deriv_eq] + rw [fderiv_const_mul (by fun_prop)] + simp only [Nat.succ_eq_add_one, Fin.succ_mk, ContinuousLinearMap.coe_smul', Pi.smul_apply, + smul_eq_mul, mul_eq_zero] + rw [fderiv_cos (by fun_prop)] + simp only [fderiv_add_const, neg_smul, ContinuousLinearMap.neg_apply, + ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, neg_eq_zero, mul_eq_zero] + right + right + rw [fderiv_const_sub] + simp only [ContinuousLinearMap.neg_apply, neg_eq_zero] + rw [fderiv_const_mul (by fun_prop)] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, mul_eq_zero] + rw [← Space.deriv_eq] + rw [Space.deriv_component] + simp + +/-! + +### D.3. Time derivatives of the electric field + +-/ + +lemma harmonicWaveX_electricField_succ_time_deriv {d} (𝓕 : FreeSpace) (k : ℝ) (hk : k ≠ 0) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) (i : Fin d) : + Time.deriv (fun t => electricField 𝓕.c (harmonicWaveX 𝓕 k E₀ φ) t x i.succ) t + = - k * 𝓕.c * E₀ i * Real.sin (k * 𝓕.c * t.val - k * x 0 + φ i) := by + conv_lhs => + enter [1, t] + rw [harmonicWaveX_electricField_succ _ _ hk] + rw [Time.deriv_eq] + rw [fderiv_const_mul (by fun_prop)] + simp only [Nat.succ_eq_add_one, ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, + neg_mul] + rw [fderiv_cos (by fun_prop)] + simp only [fderiv_add_const, neg_smul, ContinuousLinearMap.neg_apply, + ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, mul_neg, neg_inj] + rw [fderiv_sub_const] + rw [fderiv_const_mul (by fun_prop)] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, Time.fderiv_val, smul_eq_mul, mul_one] + ring + +/-! + +### D.4. Divergence of the electric field + +-/ + +@[simp] +lemma harmonicWaveX_div_electricField_eq_zero {d} (𝓕 : FreeSpace) (k : ℝ) (hk : k ≠ 0) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) : + Space.div (fun x => electricField 𝓕.c (harmonicWaveX 𝓕 k E₀ φ) t x) x = 0 := by + simp [Space.div] + apply Finset.sum_eq_zero + intro i _ + exact harmonicWaveX_electricField_space_deriv_same 𝓕 k hk E₀ φ t x i + +/-! + +## E. The magnetic field matrix for a harmonic wave +-/ + +/-! + +### E.1. Components of the magnetic field matrix + +-/ + +@[simp] +lemma harmonicWaveX_magneticFieldMatrix_succ_succ {d} (𝓕 : FreeSpace) (k : ℝ) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) + (i j : Fin d) : + (harmonicWaveX 𝓕 k E₀ φ).magneticFieldMatrix 𝓕.c t x (i.succ, j.succ) = 0 := by + rw [magneticFieldMatrix_eq_vectorPotential] + simp only [Nat.succ_eq_add_one, harmonicWaveX_vectorPotential_space_deriv_succ, sub_self] + exact harmonicWaveX_differentiable 𝓕 k E₀ φ + +lemma harmonicWaveX_magneticFieldMatrix_zero_succ {d} (𝓕 : FreeSpace) (k : ℝ) (hk : k ≠ 0) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) + (i : Fin d) : + (harmonicWaveX 𝓕 k E₀ φ).magneticFieldMatrix 𝓕.c t x (0, i.succ) = + (- E₀ i / 𝓕.c.val) * cos (𝓕.c.val * k * t.val - k * x 0 + φ i) := by + rw [magneticFieldMatrix_eq_vectorPotential] + simp only [Nat.succ_eq_add_one, harmonicWaveX_vectorPotential_zero_eq_zero, Space.deriv_const, + zero_sub] + rw [harmonicWaveX_vectorPotential_succ_space_deriv_zero] + simp only [Nat.succ_eq_add_one] + ring + grind + exact harmonicWaveX_differentiable 𝓕 k E₀ φ + +lemma harmonicWaveX_magneticFieldMatrix_succ_zero {d} (𝓕 : FreeSpace) (k : ℝ) (hk : k ≠ 0) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) + (i : Fin d) : + (harmonicWaveX 𝓕 k E₀ φ).magneticFieldMatrix 𝓕.c t x (i.succ, 0) = + (E₀ i / 𝓕.c.val) * cos (𝓕.c.val * k * t.val - k * x 0 + φ i) := by + rw [magneticFieldMatrix_eq_vectorPotential] + simp only [Nat.succ_eq_add_one, harmonicWaveX_vectorPotential_zero_eq_zero, Space.deriv_const, + sub_zero] + rw [harmonicWaveX_vectorPotential_succ_space_deriv_zero] + simp only [ne_eq] + grind + exact harmonicWaveX_differentiable 𝓕 k E₀ φ + +/-! + +### E.2. Space derivatives of the magnetic field matrix + +-/ + +lemma harmonicWaveX_magneticFieldMatrix_space_deriv_succ {d} (𝓕 : FreeSpace) (k : ℝ) + (hk : k ≠ 0) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) + (i j : Fin d.succ) (l : Fin d) : + Space.deriv l.succ (fun x => magneticFieldMatrix 𝓕.c (harmonicWaveX 𝓕 k E₀ φ) t x (i, j)) x + = 0 := by + match i, j with + | 0, 0 => simp + | ⟨Nat.succ i, hi⟩, ⟨Nat.succ j, hj⟩ => + conv_lhs => + enter [2, x] + rw [← Fin.succ_mk _ _ (by grind)] + rw [← Fin.succ_mk _ _ (by grind)] + rw [harmonicWaveX_magneticFieldMatrix_succ_succ _ _] + simp + | 0, ⟨Nat.succ j, hj⟩ => + conv_lhs => + enter [2, x] + rw [← Fin.succ_mk _ _ (by grind)] + rw [harmonicWaveX_magneticFieldMatrix_zero_succ _ k hk] + have h1 (i : Fin d) : Space.deriv l.succ + (fun x => - E₀ i / 𝓕.c.val * cos (𝓕.c.val * k * t.val - k * x 0 + φ i)) x + = 0 := by + rw [Space.deriv_eq] + rw [fderiv_const_mul] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, mul_eq_zero, + div_eq_zero_iff, neg_eq_zero, SpeedOfLight.val_ne_zero, or_false] + rw [fderiv_cos (by fun_prop)] + simp only [fderiv_add_const, neg_smul, ContinuousLinearMap.neg_apply, + ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, neg_eq_zero, mul_eq_zero] + right + right + rw [fderiv_const_sub] + simp only [ContinuousLinearMap.neg_apply, neg_eq_zero] + rw [fderiv_const_mul (by fun_prop)] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, mul_eq_zero] + rw [← Space.deriv_eq] + rw [Space.deriv_component] + simp only [Fin.succ_ne_zero, ↓reduceIte, or_true] + fun_prop + rw [← h1 ⟨j, by grind⟩] + + | ⟨Nat.succ j, hj⟩, 0 => + conv_lhs => + enter [2, x] + rw [← Fin.succ_mk _ _ (by grind)] + rw [harmonicWaveX_magneticFieldMatrix_succ_zero _ k hk] + have h1 (i : Fin d) : Space.deriv l.succ + (fun x => E₀ i / 𝓕.c.val * cos (𝓕.c.val * k * t.val - k * x 0 + φ i)) x + = 0 := by + rw [Space.deriv_eq] + rw [fderiv_const_mul] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, mul_eq_zero, + div_eq_zero_iff, SpeedOfLight.val_ne_zero, or_false] + rw [fderiv_cos (by fun_prop)] + simp only [fderiv_add_const, neg_smul, ContinuousLinearMap.neg_apply, + ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, neg_eq_zero, mul_eq_zero] + right + right + rw [fderiv_const_sub] + simp only [ContinuousLinearMap.neg_apply, neg_eq_zero] + rw [fderiv_const_mul (by fun_prop)] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, mul_eq_zero] + rw [← Space.deriv_eq] + rw [Space.deriv_component] + simp only [Fin.succ_ne_zero, ↓reduceIte, or_true] + fun_prop + rw [← h1 ⟨j, by grind⟩] + +lemma harmonicWaveX_magneticFieldMatrix_zero_succ_space_deriv_zero {d} (𝓕 : FreeSpace) (k : ℝ) + (hk : k ≠ 0) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) + (i : Fin d) : + Space.deriv 0 (fun x => magneticFieldMatrix 𝓕.c (harmonicWaveX 𝓕 k E₀ φ) t x (0, i.succ)) x + = -E₀ i * k / 𝓕.c.val * sin (𝓕.c.val * k * t.val - k * x 0 + φ i) := by + conv_lhs => + enter [2, x] + rw [harmonicWaveX_magneticFieldMatrix_zero_succ _ k hk] + rw [Space.deriv_eq] + rw [fderiv_const_mul] + simp only [Nat.succ_eq_add_one, ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, + neg_mul] + rw [fderiv_cos (by fun_prop)] + simp only [fderiv_add_const, neg_smul, ContinuousLinearMap.neg_apply, + ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, mul_neg] + rw [fderiv_const_sub] + simp only [ContinuousLinearMap.neg_apply, mul_neg, neg_neg] + rw [fderiv_const_mul (by fun_prop)] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] + rw [← Space.deriv_eq] + rw [Space.deriv_component] + simp only [↓reduceIte, mul_one] + ring + fun_prop + +/-! + +## F. Maxwell's equations for a harmonic wave + +-/ + +lemma harmonicWaveX_isExtrema {d} (𝓕 : FreeSpace) (k : ℝ) (hk : k ≠ 0) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) : + IsExtrema 𝓕 (harmonicWaveX 𝓕 k E₀ φ) 0 := by + rw [isExtrema_iff_gauss_ampere_magneticFieldMatrix] + intro t x + apply And.intro + /- Gauss's law -/ + · simp + rw [harmonicWaveX_div_electricField_eq_zero 𝓕 k hk E₀ φ t x] + /- Ampère's law -/ + · intro i + rw [Fin.sum_univ_succ] + conv_rhs => + enter [1, 2, 2, i] + rw [harmonicWaveX_magneticFieldMatrix_space_deriv_succ _ _ hk] + simp + rcases Fin.eq_zero_or_eq_succ i with rfl | ⟨i, rfl⟩ + · simp + rw [← Time.deriv_euclid] + conv_lhs => + enter [1, t] + rw [harmonicWaveX_electricField_zero 𝓕 k E₀] + simp only [Time.deriv_const] + refine electricField_differentiable_time ?_ x + exact harmonicWaveX_contDiff 2 𝓕 k E₀ φ + rw [harmonicWaveX_magneticFieldMatrix_zero_succ_space_deriv_zero _ k hk] + rw [← Time.deriv_euclid] + rw [harmonicWaveX_electricField_succ_time_deriv _ _ hk] + field_simp + simp [𝓕.c_sq] + field_simp + ring_nf + left + trivial + apply electricField_differentiable_time + exact harmonicWaveX_contDiff 2 𝓕 k E₀ φ + · apply harmonicWaveX_contDiff + · change ContDiff ℝ _ (fun _ => 0) + fun_prop + +/-! + +## G. The harmonic wave is a plane wave + +-/ + +lemma harmonicWaveX_isPlaneWave {d} (𝓕 : FreeSpace) (k : ℝ) (hk : k ≠ 0) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) : + IsPlaneWave 𝓕 (harmonicWaveX 𝓕 k E₀ φ) ⟨Space.basis 0, by simp⟩ := by + apply And.intro + · use fun u => WithLp.toLp 2 fun i => + match i with + | 0 => 0 + | ⟨Nat.succ i, h⟩ => E₀ ⟨i, by grind⟩ * cos (-k * u + φ ⟨i, by grind⟩) + ext t x i + match i with + | 0 => + simp [harmonicWaveX_electricField_zero, planeWave] + rfl + | ⟨Nat.succ i, h⟩ => + simp only [Nat.succ_eq_add_one, neg_mul] + rw [← Fin.succ_mk _ _ (by grind)] + rw [harmonicWaveX_electricField_succ _ _ hk] + simp [planeWave] + left + congr + ring + · use fun u ij => + match ij with + | (0, 0) => 0 + | (0, ⟨Nat.succ j, hj⟩) => + (- E₀ ⟨j, by grind⟩ / 𝓕.c.val) * cos (-k * u + φ ⟨j, by grind⟩) + | (⟨Nat.succ i, hi⟩, 0) => + (E₀ ⟨i, by grind⟩ / 𝓕.c.val) * cos (-k * u + φ ⟨i, by grind⟩) + | (⟨Nat.succ i, hi⟩, ⟨Nat.succ j, hj⟩) => 0 + intro t x + ext ij + match ij with + | (0, 0) => + simp only [Nat.succ_eq_add_one, magneticFieldMatrix_diag_eq_zero, inner_basis, neg_mul] + rfl + | (⟨0, h0⟩, ⟨Nat.succ j, hj⟩) => + simp only [Nat.succ_eq_add_one, Fin.zero_eta, inner_basis, neg_mul] + rw [← Fin.succ_mk _ _ (by grind)] + rw [harmonicWaveX_magneticFieldMatrix_zero_succ _ k hk] + simp only [Nat.succ_eq_add_one, mul_eq_mul_left_iff, div_eq_zero_iff, neg_eq_zero, + SpeedOfLight.val_ne_zero, or_false] + left + congr + ring + | (⟨Nat.succ i, hi⟩, ⟨0, h0⟩) => + simp only [Nat.succ_eq_add_one, Fin.zero_eta, inner_basis, neg_mul] + rw [← Fin.succ_mk _ _ (by grind)] + rw [harmonicWaveX_magneticFieldMatrix_succ_zero _ k hk] + simp only [Nat.succ_eq_add_one, mul_eq_mul_left_iff, div_eq_zero_iff, + SpeedOfLight.val_ne_zero, or_false] + left + congr + ring + | (⟨Nat.succ i, hi⟩, ⟨Nat.succ j, hj⟩) => + simp only [Nat.succ_eq_add_one] + rw [← Fin.succ_mk _ _ (by grind)] + rw [← Fin.succ_mk _ _ (by grind)] + rw [harmonicWaveX_magneticFieldMatrix_succ_succ _ _] + +/-! + +## H. Polarization ellipse of the harmonic wave + +-/ + +open Real in +lemma harmonicWaveX_polarization_ellipse {d} (𝓕 : FreeSpace) (k : ℝ) (hk : k ≠ 0) + (E₀ : Fin d → ℝ) (φ : Fin d → ℝ) (t : Time) (x : Space d.succ) (hi : ∀ i, E₀ i ≠ 0) : + 2 * d * ∑ i : Fin d, ((harmonicWaveX 𝓕 k E₀ φ).electricField 𝓕.c t x i.succ / E₀ i) ^ 2 - + 2 * ∑ i, ∑ j, ((harmonicWaveX 𝓕 k E₀ φ).electricField 𝓕.c t x i.succ / E₀ i) * + ((harmonicWaveX 𝓕 k E₀ φ).electricField 𝓕.c t x j.succ / E₀ j) * + Real.cos (φ j - φ i) = + ∑ i, ∑ j, Real.sin (φ j - φ i) ^ 2 := by + have h1 (i : Fin d) : (harmonicWaveX 𝓕 k E₀ φ).electricField 𝓕.c t x i.succ / E₀ i + = Real.cos (k * 𝓕.c * t.val - k * x 0 + φ i) := by + rw [harmonicWaveX_electricField_succ 𝓕 k hk E₀ φ t x i] + specialize hi i + field_simp + conv_lhs => + enter [1, 2, 2, i] + rw [h1] + conv_lhs => + enter [2, 2, 2, i, 2, j] + rw [h1, h1] + let τ := k * 𝓕.c * t.val - k * x 0 + have hij (i j : Fin d) : + cos (τ + φ i) ^ 2 + cos (τ + φ j) ^ 2 + - 2 * cos (τ + φ i) * cos (τ + φ j) * cos (φ j - φ i) = sin (φ j - φ i) ^ 2 := by + calc _ + _ = cos (τ + φ i) ^ 2 * (sin (φ j) ^ 2 + cos (φ j) ^ 2) + cos (τ + φ j) ^ 2 + * (sin (φ i) ^ 2 + cos (φ i) ^ 2) + - 2 * cos (τ + φ i) * cos (τ + φ j) * cos (φ j - φ i) := by simp + _ = (cos (τ) * sin (φ j - φ i)) ^ 2 + (sin (τ) * sin (φ j - φ i)) ^ 2 := by + have h1 : cos (τ + φ i) * sin (φ j) - cos (τ + φ j) * sin (φ i) = + cos τ * sin (φ j - φ i) := by + field_simp + symm + rw [cos_add, cos_add, sin_sub] + ring + have h2 : cos (τ + φ i) * cos (φ j) - cos (τ + φ j) * cos (φ i) = + sin τ * sin (φ j - φ i) := by + field_simp + conv_lhs => enter [1]; rw [cos_add] + conv_lhs => enter [2]; rw [cos_add] + conv_rhs => enter [2]; rw [sin_sub] + ring + rw [← h1, ← h2] + rw [cos_sub] + ring + _ = sin (φ j - φ i) ^ 2 * (cos (τ) ^ 2 + sin (τ) ^ 2) := by ring + _ = sin (φ j - φ i) ^ 2 := by simp + symm + calc _ + _ = ∑ (i : Fin d), ∑ (j : Fin d), (cos (τ + φ i) ^ 2 + cos (τ + φ j) ^ 2 + - 2 * cos (τ + φ i) * cos (τ + φ j) * cos (φ j - φ i)) := by + simp [← hij] + _ = 2 * ∑ (i : Fin d), ∑ (j : Fin d), cos (τ + φ j) ^ 2 + - 2 * ∑ (i : Fin d), ∑ (j : Fin d), cos (τ + φ i) * cos (τ + φ j) * cos (φ j - φ i) := by + rw [two_mul] + conv_rhs => + enter [1, 1] + rw [Finset.sum_comm] + rw [← Finset.sum_add_distrib, Finset.mul_sum, ← Finset.sum_sub_distrib] + congr + funext i + rw [← Finset.sum_add_distrib, Finset.mul_sum, ← Finset.sum_sub_distrib] + congr + funext j + ring + _ = 2 * d * ∑ (j : Fin d), cos (τ + φ j) ^ 2 + - 2 * ∑ (i : Fin d), ∑ (j : Fin d), cos (τ + φ i) * cos (τ + φ j) * cos (φ j - φ i) := by + rw [Finset.sum_const, Finset.card_fin] + ring + +end ElectromagneticPotential + +end Electromagnetism diff --git a/PhysLean/Electromagnetism/Vacuum/Homogeneous.lean b/PhysLean/Electromagnetism/Vacuum/Homogeneous.lean deleted file mode 100644 index 645a3444b..000000000 --- a/PhysLean/Electromagnetism/Vacuum/Homogeneous.lean +++ /dev/null @@ -1,102 +0,0 @@ -/- -Copyright (c) 2025 Zhi Kai Pong. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Zhi Kai Pong --/ -import PhysLean.Electromagnetism.MaxwellEquations -/-! -# Electromagnetism in Homogeneous medium - -Basic properties for homogeneous medium and free space. - -Variables are bundled in structure, for unbundled version use -PhysLean.Electromagnetism.MaxwellEquations. - -This module is old, and will soon be replaced. - --/ - -namespace Electromagnetism - -/-- Charged Medium is defined as Optical Medium with charge and current. -/ -structure ChargedMedium extends OpticalMedium where - /-- The charge density. -/ - ρ : ChargeDensity - /-- The current density. -/ - J : CurrentDensity - -open Space -open Time - -variable (CM : ChargedMedium) - -/-- Gauss's law for the Electric field in homogeneous medium. -/ -abbrev ChargedMedium.GaussLawElectric (E : ElectricField) : Prop := - Electromagnetism.GaussLawElectric CM.toOpticalMedium CM.ρ E - -/-- Gauss's law for the Magnetic field in homogeneous medium. -/ -abbrev ChargedMedium.GaussLawMagnetic - (B : MagneticField) : Prop := - Electromagnetism.GaussLawMagnetic B - -/-- Ampère's law in homogeneous medium. -/ -abbrev ChargedMedium.AmpereLaw (CM : ChargedMedium) - (E : ElectricField) (B : MagneticField) : Prop := - Electromagnetism.AmpereLaw CM.toOpticalMedium CM.J E B - -/-- Faraday's law in homogeneous medium. -/ -abbrev ChargedMedium.FaradayLaw - (E : ElectricField) (B : MagneticField) : Prop := - Electromagnetism.FaradayLaw E B - -/-! -## Maxwell's equations for charge and current free medium --/ -/-- Optical medium defined as charge and current free charged medium. -/ -def OpticalMedium.free (OM : OpticalMedium) : ChargedMedium where - μ := OM.μ - ε := OM.ε - ρ := fun _ _ => 0 - J := fun _ _ => 0 - eps_ge_zero := OM.eps_ge_zero - mu_ge_zero := OM.mu_ge_zero - -variable (OM : OpticalMedium) - -local notation "ε" => OM.ε -local notation "μ" => OM.μ - -/-- The Maxwell equations for charge and current free medium. -/ -def OpticalMedium.FreeMaxwellEquations (OM : OpticalMedium) - (E : ElectricField) (B : MagneticField) : Prop := - MaxwellEquations OM OM.free.ρ OM.free.J E B - -theorem OpticalMedium.gaussLawElectric_of_free {t : Time} {x : Space} - (E : ElectricField) (B : MagneticField) (h : OM.FreeMaxwellEquations E B) : - (∇ ⬝ E t) x = 0 := by - have h' := h.1 - rw [GaussLawElectric] at h' - have h'' : OM.ε * div (E t) x = OM.ε * 0 := by - rw [mul_zero, h'] - rfl - apply mul_left_cancel₀ at h'' - · exact h'' - · exact ne_of_gt OM.eps_ge_zero - -theorem OpticalMedium.gaussLawMagnetic_of_free {t : Time} {x : Space} - (E : ElectricField) (B : MagneticField) (h : OM.FreeMaxwellEquations E B) : - (∇ ⬝ B t) x = 0 := by - rw [h.2.1] - -theorem OpticalMedium.ampereLaw_of_free {t : Time} {x : Space} - (E : ElectricField) (B : MagneticField) (h : OM.FreeMaxwellEquations E B) : - (∇ × B t) x = μ • ε • ∂ₜ (fun t => E t x) t := by - rw [h.2.2.1] - aesop - -theorem OpticalMedium.faradayLaw_of_free {t : Time} {x : Space} - (E : ElectricField) (B : MagneticField) (h : OM.FreeMaxwellEquations E B) : - (∇ × E t) x = - ∂ₜ (fun t => B t x) t := by - rw [h.2.2.2] - -end Electromagnetism diff --git a/PhysLean/Electromagnetism/Vacuum/IsPlaneWave.lean b/PhysLean/Electromagnetism/Vacuum/IsPlaneWave.lean new file mode 100644 index 000000000..7f2e4b920 --- /dev/null +++ b/PhysLean/Electromagnetism/Vacuum/IsPlaneWave.lean @@ -0,0 +1,620 @@ +/- +Copyright (c) 2025 Zhi Kai Pong. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong, Joseph Tooby-Smith +-/ +import PhysLean.ClassicalMechanics.WaveEquation.Basic +import PhysLean.Electromagnetism.Dynamics.IsExtrema +/-! + +# Electromagnetic wave equation + +## i. Overview + +In this module we define a proposition `IsPlaneWave` on electromagnetic potentials +which is true if the potential corresponds to a plane wave. +From this we derive various properties of plane waves including +the orthogonality of the electric field, magnetic field and direction of propagation, +in general dimensions. + +## ii. Key results + +- `IsPlaneWave` : The proposition defining plane waves. +- `IsPlaneWave.electricFunction` : The electric function corresponding to a plane wave. +- `IsPlaneWave.magneticFunction` : The magnetic function corresponding to a plane wave. +- `IsPlaneWave.magneticFieldMatrix_eq_propogator_cross_electricField` : + The magnetic field expressed in terms of the electric field and direction of propagation. +- `IsPlaneWave.electricField_eq_propogator_cross_magneticFieldMatrix` : + The electric field expressed in terms of the magnetic field and direction of propagation. + +## iii. Table of contents + +- A. The property of being a plane wave + - A.1. The electric and magnetic functions from a plane wave + - A.1.1. Electric function and magnetic function in terms of E and B fields + - A.1.2. Uniqueness of the electric function + - A.1.3. Uniqueness of the magnetic function + - A.2. Differentiability conditions + - A.3. Time derivative of electric and magnetic fields of a plane wave + - A.4. Space derivative of electric and magnetic fields of a plane wave + - A.5. Space derivative in terms of time derivative +- B. The magnetic field in terms of the electric field + - B.1. Time derivative of the magnetic field in terms of electric field + - B.2. Space derivative of the magnetic field in terms of electric field + - B.3. Magnetic field equal propogator cross electric field up to constant +- C. The electric field in terms of the magnetic field + - C.1. The time derivative of the electric field in terms of magnetic field + - C.2. The space derivative of the electric field in terms of magnetic field + - C.3. Electric field equal propogator cross magnetic field up to constant + +## iv. References + +-/ + +namespace Electromagnetism + +open Space Module +open Time +open ClassicalMechanics + +open Matrix +/-! + +## A. The property of being a plane wave +-/ +namespace ElectromagneticPotential +open InnerProductSpace + +/-- The proposition on a electromagnetic potential which is true if + it corresponds to a plane wave. -/ +def IsPlaneWave {d : ℕ} (𝓕 : FreeSpace) + (A : ElectromagneticPotential d) (s : Direction d) : Prop := + (∃ E₀, A.electricField 𝓕.c = planeWave E₀ 𝓕.c s) ∧ + (∃ (B₀ : ℝ → Fin d × Fin d → ℝ), ∀ t x, A.magneticFieldMatrix 𝓕.c t x = + B₀ (⟪x, s.unit⟫_ℝ - 𝓕.c * t)) +namespace IsPlaneWave +/-! + +### A.1. The electric and magnetic functions from a plane wave +-/ + +/-- The corresponding electric field function from `ℝ` to `EuclideanSpace ℝ (Fin d)` + of a plane wave. -/ +noncomputable def electricFunction {d : ℕ} {𝓕 : FreeSpace} + {A : ElectromagneticPotential d} {s : Direction d} + (hA : IsPlaneWave 𝓕 A s) : ℝ → EuclideanSpace ℝ (Fin d) := + Classical.choose hA.1 + +lemma electricField_eq_electricFunction {d : ℕ} {𝓕 : FreeSpace} + {A : ElectromagneticPotential d} {s : Direction d} + (P : IsPlaneWave 𝓕 A s) (t : Time) (x : Space d) : + A.electricField 𝓕.c t x = + P.electricFunction (⟪x, s.unit⟫_ℝ - 𝓕.c * t) := by + rw [Classical.choose_spec P.1] + rfl + +/-- The corresponding magnetic field function from `ℝ` to + `Fin d × Fin d → ℝ` of a plane wave. -/ +noncomputable def magneticFunction {d : ℕ} {𝓕 : FreeSpace} + {A : ElectromagneticPotential d} {s : Direction d} + (hA : IsPlaneWave 𝓕 A s) : ℝ → Fin d × Fin d → ℝ := + Classical.choose hA.2 + +lemma magneticFieldMatrix_eq_magneticFunction {d : ℕ} + {𝓕 : FreeSpace} {A : ElectromagneticPotential d} {s : Direction d} + (P : IsPlaneWave 𝓕 A s) (t : Time) (x : Space d) : + A.magneticFieldMatrix 𝓕.c t x = + P.magneticFunction (⟪x, s.unit⟫_ℝ - 𝓕.c * t) := by + rw [Classical.choose_spec P.2 t x] + rfl + +/-! + +#### A.1.1. Electric function and magnetic function in terms of E and B fields + +-/ + +lemma electricFunction_eq_electricField {d : ℕ} + {𝓕 : FreeSpace} {A : ElectromagneticPotential d} + {s : Direction d} (P : IsPlaneWave 𝓕 A s) : + P.electricFunction = fun u => + A.electricField 𝓕.c ⟨(- u)/𝓕.c.1⟩ (0 : Space d) := by + funext u + rw [P.electricField_eq_electricFunction] + congr + simp only [inner_zero_left, zero_sub] + field_simp + +lemma magneticFunction_eq_magneticFieldMatrix {d : ℕ} + {𝓕 : FreeSpace} {A : ElectromagneticPotential d} + {s : Direction d} (P : IsPlaneWave 𝓕 A s) : + P.magneticFunction = fun u => + A.magneticFieldMatrix 𝓕.c ⟨(- u)/𝓕.c.1⟩ (0 : Space d) := by + funext u + rw [P.magneticFieldMatrix_eq_magneticFunction] + congr + simp only [inner_zero_left, zero_sub] + field_simp + +/-! + +#### A.1.2. Uniqueness of the electric function + +-/ + +lemma electricFunction_unique {d : ℕ} {𝓕 : FreeSpace} + {A : ElectromagneticPotential d} {s : Direction d} + (P : IsPlaneWave 𝓕 A s) (E1 : ℝ → EuclideanSpace ℝ (Fin d)) + (hE₁ : A.electricField 𝓕.c = planeWave E1 𝓕.c s) : + E1 = P.electricFunction := by + funext x + obtain ⟨t, rfl⟩ : ∃ t, x = ⟪0, s.unit⟫_ℝ - 𝓕.c * t := by use (- x/𝓕.c); field_simp; simp + trans A.electricField 𝓕.c t (0 : Space d) + · rw [hE₁] + rfl + · rw [P.electricField_eq_electricFunction] + +/-! + +#### A.1.3. Uniqueness of the magnetic function + +-/ + +lemma magneticFunction_unique {d : ℕ} {𝓕 : FreeSpace} + {A : ElectromagneticPotential d} {s : Direction d} + (P : IsPlaneWave 𝓕 A s) + (B1 : ℝ → Fin d × Fin d → ℝ) + (hB₁ : ∀ t x, A.magneticFieldMatrix 𝓕.c t x = + B1 (⟪x, s.unit⟫_ℝ - 𝓕.c * t)) : + B1 = P.magneticFunction := by + funext x + obtain ⟨t, rfl⟩ : ∃ t, x = ⟪0, s.unit⟫_ℝ - 𝓕.c * t := by use (- x/𝓕.c); field_simp; simp + trans A.magneticFieldMatrix 𝓕.c t (0 : Space d) + · rw [hB₁] + · rw [P.magneticFieldMatrix_eq_magneticFunction] + +/-! + +### A.2. Differentiability conditions + +-/ + +lemma electricFunction_differentiable {d : ℕ} + {𝓕 : FreeSpace} {A : ElectromagneticPotential d} + {s : Direction d} (P : IsPlaneWave 𝓕 A s) (hA : ContDiff ℝ 2 A) : + Differentiable ℝ P.electricFunction := by + rw [electricFunction_eq_electricField] + change Differentiable ℝ (↿(electricField 𝓕.c A) ∘ fun u => ({ val := -u / 𝓕.c.val }, 0)) + apply Differentiable.comp + · exact electricField_differentiable hA + · refine Differentiable.prodMk ?_ ?_ + · change Differentiable ℝ (Time.toRealCLE.symm ∘ fun u => -u / 𝓕.c.val) + apply Differentiable.comp + · fun_prop + · fun_prop + · fun_prop + +lemma magneticFunction_differentiable {d : ℕ} + {𝓕 : FreeSpace} {A : ElectromagneticPotential d} + {s : Direction d} (P : IsPlaneWave 𝓕 A s) (hA : ContDiff ℝ 2 A) + (ij : Fin d × Fin d) : + Differentiable ℝ (fun u => P.magneticFunction u ij) := by + rw [magneticFunction_eq_magneticFieldMatrix] + simp only + change Differentiable ℝ (↿(fun t x => A.magneticFieldMatrix 𝓕.c t x ij) ∘ + fun u => ({ val := -u / 𝓕.c.val }, 0)) + apply Differentiable.comp + · exact magneticFieldMatrix_differentiable A hA ij + · refine Differentiable.prodMk ?_ ?_ + · change Differentiable ℝ (Time.toRealCLE.symm ∘ fun u => -u / 𝓕.c.val) + apply Differentiable.comp + · fun_prop + · fun_prop + · fun_prop + +/-! + +### A.3. Time derivative of electric and magnetic fields of a plane wave + +-/ + +lemma electricField_time_deriv {d : ℕ} + {𝓕 : FreeSpace} {A : ElectromagneticPotential d} + {s : Direction d} (P : IsPlaneWave 𝓕 A s) (hA : ContDiff ℝ 2 A) (t : Time) + (x : Space d) : + ∂ₜ (A.electricField 𝓕.c · x) t = - 𝓕.c.val • + fderiv ℝ P.electricFunction (⟪x, s.unit⟫_ℝ - 𝓕.c.val * t.val) 1 := by + conv_lhs => + enter [1, t] + rw [P.electricField_eq_electricFunction] + rw [Time.deriv_eq] + rw [fderiv_comp'] + simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, fderiv_eq_smul_deriv, one_smul, + neg_smul] + rw [fderiv_fun_sub] + simp only [fderiv_fun_const, Pi.zero_apply, zero_sub, ContinuousLinearMap.neg_apply, neg_smul, + neg_inj] + rw [fderiv_const_mul] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, Time.fderiv_val, smul_eq_mul, mul_one] + · fun_prop + · fun_prop + · fun_prop + · apply Differentiable.differentiableAt + exact IsPlaneWave.electricFunction_differentiable P hA + · fun_prop + +lemma magneticFieldMatrix_time_deriv {d : ℕ} + {𝓕 : FreeSpace} {A : ElectromagneticPotential d} + {s : Direction d} (P : IsPlaneWave 𝓕 A s) (hA : ContDiff ℝ 2 A) (t : Time) + (x : Space d) (i j : Fin d) : + ∂ₜ (A.magneticFieldMatrix 𝓕.c · x (i, j)) t = - 𝓕.c.val • + fderiv ℝ (fun u => P.magneticFunction u (i, j)) (⟪x, s.unit⟫_ℝ - 𝓕.c.val * t.val) 1 := by + conv_lhs => + enter [1, t] + rw [P.magneticFieldMatrix_eq_magneticFunction] + rw [Time.deriv_eq] + change fderiv ℝ ((fun u => P.magneticFunction u (i, j)) ∘ + fun t => ⟪x, s.unit⟫_ℝ - 𝓕.c.val * t.val) t 1 = _ + rw [fderiv_comp] + simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, fderiv_eq_smul_deriv, smul_eq_mul, + one_mul, neg_mul] + rw [fderiv_fun_sub] + simp only [fderiv_fun_const, Pi.zero_apply, zero_sub, ContinuousLinearMap.neg_apply, neg_mul, + neg_inj, mul_eq_mul_right_iff] + rw [fderiv_const_mul] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, Time.fderiv_val, smul_eq_mul, mul_one, + true_or] + · fun_prop + · fun_prop + · fun_prop + · apply Differentiable.differentiableAt + exact magneticFunction_differentiable P hA (i, j) + · fun_prop + +/-! + +### A.4. Space derivative of electric and magnetic fields of a plane wave + +-/ + +lemma electricField_space_deriv {d : ℕ} + {𝓕 : FreeSpace} {A : ElectromagneticPotential d} + {s : Direction d} (P : IsPlaneWave 𝓕 A s) (hA : ContDiff ℝ 2 A) (t : Time) + (x : Space d) (i : Fin d) : + ∂[i] (A.electricField 𝓕.c t ·) x = s.unit i • + fderiv ℝ P.electricFunction (⟪x, s.unit⟫_ℝ - 𝓕.c.val * t.val) 1 := by + conv_lhs => + enter [2, t] + rw [P.electricField_eq_electricFunction] + rw [Space.deriv_eq_fderiv_basis] + rw [fderiv_comp'] + simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, fderiv_eq_smul_deriv, one_smul] + rw [fderiv_fun_sub] + simp only [fderiv_fun_const, Pi.zero_apply, sub_zero] + rw [← Space.deriv_eq_fderiv_basis] + simp only [deriv_inner_left] + · fun_prop + · fun_prop + · apply Differentiable.differentiableAt + exact IsPlaneWave.electricFunction_differentiable P hA + · fun_prop + +lemma magneticFieldMatrix_space_deriv {d : ℕ} + {𝓕 : FreeSpace} {A : ElectromagneticPotential d} + {s : Direction d} (P : IsPlaneWave 𝓕 A s) (hA : ContDiff ℝ 2 A) (t : Time) + (x : Space d) (i j : Fin d) (k : Fin d) : + ∂[k] (A.magneticFieldMatrix 𝓕.c t · (i, j)) x = s.unit k • + fderiv ℝ (fun u => P.magneticFunction u (i, j)) + (⟪x, s.unit⟫_ℝ - 𝓕.c.val * t.val) 1 := by + conv_lhs => + enter [2, t] + rw [P.magneticFieldMatrix_eq_magneticFunction] + rw [Space.deriv_eq_fderiv_basis] + change fderiv ℝ ((fun u => P.magneticFunction u (i, j)) ∘ + fun x => ⟪x, s.unit⟫_ℝ - 𝓕.c.val * t.val) x _ = _ + rw [fderiv_comp] + simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, fderiv_eq_smul_deriv, smul_eq_mul, + one_mul, mul_eq_mul_right_iff] + rw [fderiv_fun_sub] + simp only [fderiv_fun_const, Pi.zero_apply, sub_zero] + rw [← Space.deriv_eq_fderiv_basis] + simp only [deriv_inner_left, true_or] + · fun_prop + · fun_prop + · apply Differentiable.differentiableAt + exact magneticFunction_differentiable P hA (i, j) + · fun_prop + +/-! + +### A.5. Space derivative in terms of time derivative +-/ + +lemma electricField_space_deriv_eq_time_deriv {d : ℕ} {𝓕 : FreeSpace} + {A : ElectromagneticPotential d} + {s : Direction d} (P : IsPlaneWave 𝓕 A s) (hA : ContDiff ℝ 2 A) (t : Time) + (x : Space d) (i : Fin d) (k : Fin d) : + ∂[k] (A.electricField 𝓕.c t · i) x = - (s.unit k / 𝓕.c.val) • + ∂ₜ (A.electricField 𝓕.c · x i) t := by + rw [Space.deriv_euclid] + rw [IsPlaneWave.electricField_space_deriv P hA t x k] + rw [Time.deriv_euclid] + rw [IsPlaneWave.electricField_time_deriv P hA t x] + simp only [fderiv_eq_smul_deriv, one_smul, PiLp.smul_apply, smul_eq_mul, neg_mul, mul_neg, + neg_neg] + field_simp + · exact electricField_differentiable_time hA x + · exact electricField_differentiable_space hA t + +lemma magneticFieldMatrix_space_deriv_eq_time_deriv {d : ℕ} + {𝓕 : FreeSpace} {A : ElectromagneticPotential d} + {s : Direction d} (P : IsPlaneWave 𝓕 A s) (hA : ContDiff ℝ 2 A) (t : Time) + (x : Space d) (i j : Fin d) (k : Fin d) : + ∂[k] (A.magneticFieldMatrix 𝓕.c t · (i, j)) x = - (s.unit k / 𝓕.c.val) • + ∂ₜ (A.magneticFieldMatrix 𝓕.c · x (i, j)) t := by + rw [IsPlaneWave.magneticFieldMatrix_space_deriv P hA t x i j k, + IsPlaneWave.magneticFieldMatrix_time_deriv P hA t x i j] + simp only [fderiv_eq_smul_deriv, smul_eq_mul, one_mul, neg_mul, mul_neg, neg_neg] + field_simp + +/-! + +## B. The magnetic field in terms of the electric field + +-/ + +/-! + +### B.1. Time derivative of the magnetic field in terms of electric field + +-/ +open ContDiff + +lemma time_deriv_magneticFieldMatrix_eq_electricField_mul_propogator {d : ℕ} + {𝓕 : FreeSpace} {A : ElectromagneticPotential d} + {s : Direction d} (P : IsPlaneWave 𝓕 A s) (hA : ContDiff ℝ 2 A) + (t : Time) (x : Space d) (i j : Fin d) : + ∂ₜ (A.magneticFieldMatrix 𝓕.c · x (i, j)) t = + ∂ₜ (fun t => s.unit j / 𝓕.c * A.electricField 𝓕.c t x i + - s.unit i / 𝓕.c * A.electricField 𝓕.c t x j) t := by + rw [time_deriv_magneticFieldMatrix] + rw [P.electricField_space_deriv_eq_time_deriv, P.electricField_space_deriv_eq_time_deriv] + conv_rhs => + rw [Time.deriv_eq] + rw [fderiv_fun_sub (by + apply Differentiable.differentiableAt + apply Differentiable.const_mul + exact electricField_apply_differentiable_time hA _ _) (by + apply Differentiable.differentiableAt + apply Differentiable.const_mul + exact electricField_apply_differentiable_time hA _ _)] + rw [fderiv_const_mul (by + apply Differentiable.differentiableAt + exact electricField_apply_differentiable_time hA _ _)] + rw [fderiv_const_mul (by + apply Differentiable.differentiableAt + exact electricField_apply_differentiable_time hA _ _)] + simp [← Time.deriv_eq] + field_simp + ring + · exact hA + · exact hA + · exact hA + +/-! + +### B.2. Space derivative of the magnetic field in terms of electric field + +-/ + +lemma space_deriv_magneticFieldMatrix_eq_electricField_mul_propogator {d : ℕ} + {𝓕 : FreeSpace} {A : ElectromagneticPotential d} + {s : Direction d} (P : IsPlaneWave 𝓕 A s) (hA : ContDiff ℝ 2 A) + (t : Time) (x : Space d) (i j k : Fin d) : + ∂[k] (A.magneticFieldMatrix 𝓕.c t · (i, j)) x = + ∂[k] (fun x => s.unit j / 𝓕.c * A.electricField 𝓕.c t x i + - s.unit i / 𝓕.c * A.electricField 𝓕.c t x j) x := by + rw [P.magneticFieldMatrix_space_deriv_eq_time_deriv hA] + rw [P.time_deriv_magneticFieldMatrix_eq_electricField_mul_propogator hA] + rw [Space.deriv_eq_fderiv_basis] + rw [fderiv_fun_sub] + rw [fderiv_const_mul, fderiv_const_mul] + simp [← Space.deriv_eq_fderiv_basis] + rw [Time.deriv_eq] + rw [fderiv_fun_sub] + rw [fderiv_const_mul, fderiv_const_mul] + simp [← Time.deriv_eq] + rw [P.electricField_space_deriv_eq_time_deriv, P.electricField_space_deriv_eq_time_deriv] + simp only [smul_eq_mul, neg_mul, mul_neg, sub_neg_eq_add] + field_simp + ring + any_goals exact hA + any_goals apply Differentiable.differentiableAt + any_goals apply Differentiable.const_mul + any_goals exact electricField_apply_differentiable_time hA x _ + any_goals exact electricField_apply_differentiable_space hA t _ + +/-! + +### B.3. Magnetic field equal propogator cross electric field up to constant + +-/ + +lemma magneticFieldMatrix_eq_propogator_cross_electricField {d : ℕ} + {𝓕 : FreeSpace} {A : ElectromagneticPotential d} + {s : Direction d} (P : IsPlaneWave 𝓕 A s) (hA : ContDiff ℝ 2 A) (i j : Fin d) : + ∃ C, ∀ t x, A.magneticFieldMatrix 𝓕.c t x (i, j) = + 1/ 𝓕.c * (s.unit j * A.electricField 𝓕.c t x i - + s.unit i * A.electricField 𝓕.c t x j) + C := by + apply Space.equal_up_to_const_of_deriv_eq + · exact magneticFieldMatrix_differentiable A hA (i, j) + · apply Differentiable.const_mul + apply Differentiable.sub + · apply Differentiable.const_mul + exact electricField_apply_differentiable hA + · apply Differentiable.const_mul + exact electricField_apply_differentiable hA + · intro t x + rw [P.time_deriv_magneticFieldMatrix_eq_electricField_mul_propogator hA t x i j] + congr + funext t + field_simp + · intro t x k + rw [P.space_deriv_magneticFieldMatrix_eq_electricField_mul_propogator hA t x i j] + congr + funext x + field_simp + +/-! + +## C. The electric field in terms of the magnetic field + +-/ +/-! + +### C.1. The time derivative of the electric field in terms of magnetic field + +-/ + +lemma time_deriv_electricField_eq_magneticFieldMatrix {d : ℕ} + {𝓕 : FreeSpace} {A : ElectromagneticPotential d} + {s : Direction d} (P : IsPlaneWave 𝓕 A s) (hA : ContDiff ℝ ∞ A) + (h : IsExtrema 𝓕 A 0) + (t : Time) (x : Space d) (i : Fin d) : + ∂ₜ (A.electricField 𝓕.c · x i) t = + ∂ₜ (fun t => 𝓕.c * ∑ j, A.magneticFieldMatrix 𝓕.c t x (i, j) * s.unit j) t := by + rw [Time.deriv_euclid] + rw [time_deriv_electricField_of_isExtrema hA 0 _ h t x i] + simp only [one_div, _root_.mul_inv_rev, LorentzCurrentDensity.currentDensity_zero, Pi.zero_apply, + PiLp.zero_apply, mul_zero, sub_zero] + conv_lhs => + enter [2, 2, i]; + rw [magneticFieldMatrix_space_deriv_eq_time_deriv P (hA.of_le ENat.LEInfty.out) t x i] + rw [Time.deriv_eq, fderiv_const_mul] + simp [← Time.deriv_eq] + have h1 : ∂ₜ (fun t => ∑ j, A.magneticFieldMatrix 𝓕.c t x (i, j) * s.unit j) t + = ∑ j, ∂ₜ (A.magneticFieldMatrix 𝓕.c · x (i, j)) t * s.unit j := by + rw [Time.deriv_eq] + rw [fderiv_fun_sum] + simp only [ContinuousLinearMap.coe_sum', Finset.sum_apply] + conv_lhs => + enter [2, k] + rw [fderiv_mul_const (by + apply Differentiable.differentiableAt + apply magneticFieldMatrix_differentiable_time + exact (hA.of_le ENat.LEInfty.out))] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] + congr + funext i + ring_nf + rfl + · intro k _ + apply DifferentiableAt.mul_const + apply Differentiable.differentiableAt + apply magneticFieldMatrix_differentiable_time + exact (hA.of_le ENat.LEInfty.out) + + rw [h1, Finset.mul_sum, Finset.mul_sum,← Finset.sum_neg_distrib] + field_simp + congr + funext k + field_simp + simp [𝓕.c_sq] + field_simp + conv_lhs => + enter [1, 2, 1, t] + rw [magneticFieldMatrix_antisymm] + rw [Time.deriv_eq, fderiv_fun_neg] + simp [← Time.deriv_eq] + · refine DifferentiableAt.fun_sum ?_ + intro k _ + apply DifferentiableAt.mul_const + apply Differentiable.differentiableAt + apply magneticFieldMatrix_differentiable_time + exact (hA.of_le ENat.LEInfty.out) + · change ContDiff ℝ ∞ (fun _ => 0) + fun_prop + · exact electricField_differentiable_time (hA.of_le (ENat.LEInfty.out)) x + +/-! + +### C.2. The space derivative of the electric field in terms of magnetic field + +-/ + +lemma space_deriv_electricField_eq_magneticFieldMatrix {d : ℕ} + {𝓕 : FreeSpace} {A : ElectromagneticPotential d} + {s : Direction d} (P : IsPlaneWave 𝓕 A s) (hA : ContDiff ℝ ∞ A) + (h : IsExtrema 𝓕 A 0) + (t : Time) (x : Space d) (i k : Fin d) : + ∂[k] (A.electricField 𝓕.c t · i) x = + ∂[k] (fun x => 𝓕.c * ∑ j, A.magneticFieldMatrix 𝓕.c t x (i, j) * s.unit j) x := by + have hA2 : ContDiff ℝ 2 A := hA.of_le ENat.LEInfty.out + rw [P.electricField_space_deriv_eq_time_deriv hA2 t x i k] + rw [P.time_deriv_electricField_eq_magneticFieldMatrix hA h t x i] + rw [Time.deriv_eq] + rw [fderiv_const_mul] + rw [fderiv_fun_sum] + simp [Finset.mul_sum, - Finset.sum_neg_distrib] + rw [Space.deriv_eq_fderiv_basis] + rw [fderiv_fun_sum] + simp [- Finset.sum_neg_distrib] + congr + funext j + rw [fderiv_mul_const, fderiv_const_mul, fderiv_mul_const] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] + rw [← Space.deriv_eq_fderiv_basis] + rw [P.magneticFieldMatrix_space_deriv_eq_time_deriv hA2 t x i j k] + simp [← Time.deriv_eq] + field_simp + any_goals apply Differentiable.differentiableAt + · exact fieldStrengthMatrix_differentiable_space hA2 t + · apply Differentiable.mul_const + exact fieldStrengthMatrix_differentiable_space hA2 t + · exact fieldStrengthMatrix_differentiable_time hA2 x + · intro i _ + apply Differentiable.differentiableAt + apply Differentiable.const_mul + apply Differentiable.mul_const + exact fieldStrengthMatrix_differentiable_space hA2 t + · intro i _ + apply Differentiable.differentiableAt + apply Differentiable.mul_const + exact fieldStrengthMatrix_differentiable_time hA2 x + · apply Differentiable.fun_sum + intro i _ + apply Differentiable.mul_const + exact fieldStrengthMatrix_differentiable_time hA2 x + +/-! + +### C.3. Electric field equal propogator cross magnetic field up to constant + +-/ + +lemma electricField_eq_propogator_cross_magneticFieldMatrix {d : ℕ} + {𝓕 : FreeSpace} {A : ElectromagneticPotential d} + {s : Direction d} (P : IsPlaneWave 𝓕 A s) (hA : ContDiff ℝ ∞ A) + (h : IsExtrema 𝓕 A 0) (i : Fin d) : + ∃ C, ∀ t x, A.electricField 𝓕.c t x i = + 𝓕.c * ∑ j, A.magneticFieldMatrix 𝓕.c t x (i, j) * s.unit j + C := by + have hA2 : ContDiff ℝ 2 A := hA.of_le ENat.LEInfty.out + apply Space.equal_up_to_const_of_deriv_eq + · exact electricField_apply_differentiable hA2 + · apply Differentiable.const_mul + apply Differentiable.fun_sum + intro j _ + apply Differentiable.mul_const + exact magneticFieldMatrix_differentiable A hA2 (i, j) + · intro t x + rw [P.time_deriv_electricField_eq_magneticFieldMatrix hA _ t x i] + congr + · intro t x i + rw [P.space_deriv_electricField_eq_magneticFieldMatrix hA] + congr + +end IsPlaneWave + +end ElectromagneticPotential + +end Electromagnetism diff --git a/PhysLean/Electromagnetism/Vacuum/OneDimension.lean b/PhysLean/Electromagnetism/Vacuum/OneDimension.lean deleted file mode 100644 index 8ad0b4571..000000000 --- a/PhysLean/Electromagnetism/Vacuum/OneDimension.lean +++ /dev/null @@ -1,39 +0,0 @@ -/- -Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Tooby-Smith --/ -import PhysLean.Electromagnetism.Electrostatics.Basic -import PhysLean.Mathematics.Distribution.PowMul -/-! - -# A electrostatics in a 1d vacuum - -In this module we study the electrostatics in 1d with the presence of no charges. - -The aim of this module is to show that, in 1-dimension, if an electric field satisfies -Gauss's law for the vacuum, then it must be the constant electric field. - --/ - -namespace Electromagnetism -open Distribution SchwartzMap - -namespace OneDimVacuum -open Space StaticElectricField MeasureTheory -noncomputable section - -/-- The zero charge distribution in 1d space. -/ -def chargeDistribution : ChargeDistribution 1 := 0 - -/-- An electric field obey's Gauss's law for the vacuum in 1 dimension if and only if - it is the constant electric field. -/ -@[sorryful] -lemma gaussLaw_iff (q ε : ℝ) (E : StaticElectricField 1) : - E.GaussLaw ε (chargeDistribution) ↔ ∃ m, E = constD 1 m := by - sorry - -end -end OneDimVacuum - -end Electromagnetism diff --git a/PhysLean/Electromagnetism/Vacuum/Wave.lean b/PhysLean/Electromagnetism/Vacuum/Wave.lean deleted file mode 100644 index 6b2d06de1..000000000 --- a/PhysLean/Electromagnetism/Vacuum/Wave.lean +++ /dev/null @@ -1,724 +0,0 @@ -/- -Copyright (c) 2025 Zhi Kai Pong. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Zhi Kai Pong --/ -import PhysLean.Electromagnetism.Vacuum.Homogeneous -import PhysLean.ClassicalMechanics.WaveEquation.Basic -import PhysLean.SpaceAndTime.Space.VectorIdentities -/-! - -# Electromagnetic wave equation - -## i. Overview - -The first part of this module shows that the electric and magnetic fields -of an electromagnetic field in a homogeneous isotropic medium -satisfy the wave equation. - -The second part shows orthogonality properties of plane waves. - -## ii. Key results - -- `waveEquation_electricField_of_freeMaxwellEquations` : The electric field of an - EM field in free space satisfies the wave equation. -- `waveEquation_magneticField_of_freeMaxwellEquations` : The magnetic field of an - EM field in free space satisfies the wave equation. -- `orthonormal_triad_of_electromagneticplaneWave` : The electric field, magnetic field and - direction of propagation of an electromagnetic plane wave form an orthonormal triad, - up to constant fields. - -## iii. Table of contents - -- A. The wave equation from Maxwell's equations - - A.1. The electric field of an EM field in free space satisfies the wave equation - - A.2. The magnetic field of an EM field in free space satisfies the wave equation -- B. Orthogonality properties of plane waves - - B.1. Definition of the electric and magnetic plane waves - - B.2. Up to a time-dependent constant, the E field is transverse to the direction of propagation - - B.3. Up to a time-dependent constant, the B field is transverse to the direction of propagation - - B.4. E proportional to cross of direction of propagation & B, up to a constant - - B.4.1. Time derivative of E-field proportional to propagation cross time derivative of B-field - - B.4.2. Proportional up to a space-dependent constant - - B.4.3. Proportional up to a constant - - B.5. B proportional to cross of direction of propagation & B, up to a constant - - B.5.1. Time derivative of B-field proportional to propagation cross time derivative of E-field - - B.5.2. Proportional up to a space-dependent constant - - B.5.3. Proportional up to a constant - - B.6. E-field orthogonal to direction of propagation up to a constant - - B.7. B-field orthogonal to direction of propagation up to a constant - - B.8. E, B and direction of propagation form an orthonormal triad up to constants - -## iv. References - --/ - -namespace Electromagnetism - -open Space Module -open Time -open ClassicalMechanics - -variable (OM : OpticalMedium) -open Matrix - -local notation "ε" => OM.ε -local notation "μ" => OM.μ - -/-! - -## A. The wave equation from Maxwell's equations - --/ - -/-! - -### A.1. The electric field of an EM field in free space satisfies the wave equation - --/ - -/-- The electromagnetic wave equation for electric field. -/ -theorem waveEquation_electricField_of_freeMaxwellEquations - (E : ElectricField) (B : MagneticField) (h : OM.FreeMaxwellEquations E B) - (hE : ContDiff ℝ 2 ↿E) (hB : ContDiff ℝ 2 ↿B) : - WaveEquation E t x ((√(μ • ε))⁻¹) := by - rw [WaveEquation, ← Real.sqrt_inv, Real.sq_sqrt] - have hdt : ∀ t, (∂ₜ (fun t => E t x) t) = (μ • ε)⁻¹ • (∇ × B t) x := by - intro t - rw [OM.ampereLaw_of_free E B] - · simp [← smul_assoc, mul_assoc, OM.mu_ge_zero, ne_of_gt, OM.eps_ge_zero] - · exact h - have hdt2 : ∂ₜ (fun t => ∂ₜ (fun t => E t x) t) t = - ∂ₜ (fun t => (μ • ε)⁻¹ • (∇ × B t) x) t := by aesop - rw [hdt2] - have hd0 : (∇ ⬝ (E t)) = 0 := by - ext x - simp [OM.gaussLawElectric_of_free E B, h] - have hlpE : Δ (E t) = - ((fun x => ∇ (∇ ⬝ (E t)) - Δ (E t)) x) := by simp [hd0] - rw [hlpE, ← curl_of_curl] - have hcE : curl (E t) = fun x => - ∂ₜ (fun t => B t x) t := by - funext x - simp [OM.faradayLaw_of_free E B, h] - rw [hcE] - have hcn : curl (fun x => -∂ₜ (fun t => B t x) t) = - - curl (fun x => ∂ₜ (fun t => B t x) t) := by - trans - (1:ℝ) • curl (fun x => ∂ₜ (fun t => B t x) t) - rw [← curl_smul, neg_smul, one_smul] - rfl - · exact fun x ↦ fderiv_curry_differentiableAt_fst_comp_snd (hf := hB) .. - · exact neg_one_smul .. - simp only [smul_eq_mul, _root_.mul_inv_rev, hcn, Pi.neg_apply, neg_neg] - rw [← time_deriv_curl_commute] - have hdt_smul : ∂ₜ (fun t => (OM.ε⁻¹ * OM.μ⁻¹) • curl (B t) x) t = - (OM.ε⁻¹ * OM.μ⁻¹) • ∂ₜ (fun t => curl (B t) x) t := by - rw [deriv_smul] - unfold curl Space.deriv coord basis - simp only [Fin.isValue, EuclideanSpace.basisFun_apply, PiLp.inner_apply, - EuclideanSpace.single_apply, RCLike.inner_apply, conj_trivial, ite_mul, one_mul, zero_mul, - Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte] - apply differentiable_pi'' - intro i - fin_cases i <;> fun_prop - rw [hdt_smul, sub_self] - · exact hB - · exact hE.uncurry .. - · rw [inv_nonneg] - exact smul_nonneg (le_of_lt OM.mu_ge_zero) (le_of_lt OM.eps_ge_zero) - -/-! - -### A.2. The magnetic field of an EM field in free space satisfies the wave equation - --/ - -/-- The electromagnetic wave equation for magnetic field. -/ -theorem waveEquation_magneticField_of_freeMaxwellEquations - (E : ElectricField) (B : MagneticField) (h : OM.FreeMaxwellEquations E B) - (hE : ContDiff ℝ 2 ↿E) (hB : ContDiff ℝ 2 ↿B) : - WaveEquation B t x ((√(μ • ε))⁻¹) := by - rw [WaveEquation, ← Real.sqrt_inv, Real.sq_sqrt] - have hdt : ∀ t, (∂ₜ (fun t => B t x) t) = - (∇ × E t) x := by - intro t - rwa [OM.faradayLaw_of_free E B, neg_neg] - have hdt2 : ∂ₜ (fun t => ∂ₜ (fun t => B t x) t) t = - - ∂ₜ (fun t => (∇ × E t) x) t := by - trans - (1:ℝ) • ∂ₜ (fun t => (∇ × E t) x) t - rw [← deriv_smul] - simp only [neg_smul, one_smul] - congr - funext t - rw [hdt] - · unfold curl Space.deriv coord basis - simp only [Fin.isValue, EuclideanSpace.basisFun_apply, PiLp.inner_apply, - EuclideanSpace.single_apply, RCLike.inner_apply, conj_trivial, ite_mul, one_mul, zero_mul, - Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte] - apply differentiable_pi'' - intro i - fin_cases i <;> fun_prop - simp - rw [hdt2] - have hd0 : (∇ ⬝ (B t)) = 0 := by - ext x - simp [OM.gaussLawMagnetic_of_free E B, h] - have hlpB : Δ (B t) = - ((fun x => ∇ (∇ ⬝ (B t)) - Δ (B t)) x) := by simp [hd0] - rw [hlpB, ← curl_of_curl] - have hcB : curl (B t) = OM.μ • OM.ε • fun x => ∂ₜ (fun t => E t x) t := by - funext x - rw [OM.ampereLaw_of_free E B] - · rfl - · exact h - rw [hcB] - have hcn : (OM.μ • OM.ε)⁻¹ • (-(fun x => - curl (OM.μ • OM.ε • fun x => ∂ₜ (fun t => E t x) t)) x) x = - - curl (fun x => ∂ₜ (fun t => E t x) t) x := by - simp only [smul_eq_mul, _root_.mul_inv_rev, Pi.neg_apply, smul_neg, neg_inj] - change ((OM.ε⁻¹ * OM.μ⁻¹) • (curl (OM.μ • OM.ε • fun x => ∂ₜ (fun t => E t x) t))) x = _ - rw [← curl_smul] - simp only [← smul_assoc, smul_eq_mul, mul_assoc, ne_eq, OM.mu_ge_zero, ne_of_gt, - not_false_eq_true, inv_mul_cancel_left₀, OM.eps_ge_zero, inv_mul_cancel₀, one_smul] - · unfold Time.deriv - rw [← smul_assoc] - change Differentiable ℝ (fun x => (OM.μ • OM.ε) • (fderiv ℝ (fun t => E t x) t) 1) - fun_prop - rw [time_deriv_curl_commute, hcn, sub_self] - · exact hE - · exact hB.uncurry (x := t) - · rw [inv_nonneg] - exact smul_nonneg (le_of_lt OM.mu_ge_zero) (le_of_lt OM.eps_ge_zero) - -/-! - -## B. Orthogonality properties of plane waves - --/ - -/-! - -### B.1. Definition of the electric and magnetic plane waves - --/ - -/-- An electric plane wave travelling in the direction of `s` with propagation speed `c`. -/ -noncomputable def electricPlaneWave (E₀ : ℝ → EuclideanSpace ℝ (Fin 3)) - (c : ℝ) (s : Direction) : ElectricField := - planeWave E₀ c s - -/-- A magnetic plane wave travelling in the direction of `s` with propagation speed `c`. -/ -noncomputable def magneticPlaneWave (B₀ : ℝ → EuclideanSpace ℝ (Fin 3)) - (c : ℝ) (s : Direction) : MagneticField := - planeWave B₀ c s - -/-! - -### B.2. Up to a time-dependent constant, the E field is transverse to the direction of propagation - --/ -open InnerProductSpace -/-- An electric plane wave minus a constant field is transverse for all x. -/ -lemma transverse_upto_time_fun_of_eq_electricPlaneWave {E₀ : ℝ → EuclideanSpace ℝ (Fin 3)} - {s : Direction} {E : ElectricField} {B : MagneticField} - (hEwave : E = electricPlaneWave E₀ c s) - (h' : Differentiable ℝ E₀) (hm : OM.FreeMaxwellEquations E B) : - ∃ (c : Time → EuclideanSpace ℝ (Fin 3)), ∀ t x, - inner ℝ (E t x) s.unit = inner ℝ (c t) s.unit := by - have E'eqdivE : ∀ t x y, ⟪fderiv ℝ (E t) x y, s.unit⟫_ℝ = - ⟪y, s.unit⟫_ℝ * (∇ ⬝ (E t)) x := by - intro t x y - rw [hEwave, electricPlaneWave] - unfold planeWave div coord basis Space.deriv - rw [PiLp.inner_apply] - simp only [RCLike.inner_apply, conj_trivial, EuclideanSpace.basisFun_apply] - conv_lhs => - enter [2, i] - rw [wave_fderiv_inner_eq_inner_fderiv_proj h'] - rw [← Finset.mul_sum] - simp [PiLp.inner_apply] - have E'eqzero : ∀ t x, fderiv ℝ (fun x => (inner ℝ (E t x) s.unit)) x = 0 := by - intro t x - ext y - rw [fderiv_inner_apply] - simp only [fderiv_fun_const, Pi.zero_apply, ContinuousLinearMap.zero_apply, inner_zero_right, - zero_add] - rw [E'eqdivE] - rw [OM.gaussLawElectric_of_free E B] - simp only [PiLp.inner_apply, RCLike.inner_apply, conj_trivial, mul_zero] - exact hm - rw [hEwave, electricPlaneWave] - unfold planeWave - apply Differentiable.comp - fun_prop - exact fun x => wave_differentiable - fun_prop - use fun t => E t 0 - intro t x - have hx' := E'eqzero t - apply is_const_of_fderiv_eq_zero at hx' - rw [hx' x 0] - apply Differentiable.inner - rw [hEwave, electricPlaneWave] - unfold planeWave - apply Differentiable.comp - fun_prop - exact fun x => wave_differentiable - fun_prop - -/-! - -### B.3. Up to a time-dependent constant, the B field is transverse to the direction of propagation - --/ - -/-- An magnetic plane wave minus a constant field is transverse for all x. -/ -lemma transverse_upto_time_fun_of_eq_magneticPlaneWave {B₀ : ℝ → EuclideanSpace ℝ (Fin 3)} - {s : Direction} {E : ElectricField} {B : MagneticField} - (hBwave : B = magneticPlaneWave B₀ c s) - (h' : Differentiable ℝ B₀) (hm : OM.FreeMaxwellEquations E B) : - ∃ (c : Time → EuclideanSpace ℝ (Fin 3)), ∀ t x, - inner ℝ (B t x) s.unit = inner ℝ (c t) s.unit := by - have B'eqdivB : ∀ t x y, inner ℝ (fderiv ℝ (B t) x y) s.unit = - inner ℝ y s.unit * (∇ ⬝ (B t)) x := by - intro t x y - rw [hBwave, magneticPlaneWave] - unfold planeWave div coord basis Space.deriv - rw [PiLp.inner_apply] - simp only [RCLike.inner_apply, conj_trivial, EuclideanSpace.basisFun_apply] - conv_lhs => - enter [2, i] - rw [wave_fderiv_inner_eq_inner_fderiv_proj h'] - rw [← Finset.mul_sum] - simp [PiLp.inner_apply] - have B'eqzero : ∀ t x, fderiv ℝ (fun x => (inner ℝ (B t x) s.unit)) x = 0 := by - intro t x - ext y - rw [fderiv_inner_apply] - simp only [fderiv_fun_const, Pi.zero_apply, ContinuousLinearMap.zero_apply, inner_zero_right, - zero_add] - rw [B'eqdivB] - rw [OM.gaussLawMagnetic_of_free E B] - simp only [PiLp.inner_apply, RCLike.inner_apply, conj_trivial, mul_zero] - exact hm - rw [hBwave, magneticPlaneWave] - unfold planeWave - apply Differentiable.comp - fun_prop - exact fun x => wave_differentiable - fun_prop - use fun t => B t 0 - intro t x - have hx' := B'eqzero t - apply is_const_of_fderiv_eq_zero at hx' - rw [hx' x 0] - apply Differentiable.inner - rw [hBwave, magneticPlaneWave] - unfold planeWave - apply Differentiable.comp - fun_prop - exact fun x => wave_differentiable - fun_prop - -/-! - -### B.4. E proportional to cross of direction of propagation & B, up to a constant - --/ - -/-! - -#### B.4.1. Time derivative of E-field proportional to propagation cross time derivative of B-field - --/ - -/-- The time derivative of a magnetic planewave induces an electric field with -time derivative equal to `- s ⨯ₑ₃ B'`. -/ -lemma time_deriv_electricPlaneWave_eq_cross_time_deriv_magneticPlaneWave - {t : Time} {x : Space} {B₀ : ℝ → EuclideanSpace ℝ (Fin 3)} - {s : Direction} {E : ElectricField} {B : MagneticField} - (hc : c = (√(μ • ε))⁻¹) (hBwave : B = magneticPlaneWave B₀ c s) - (h' : Differentiable ℝ B₀) (hm : OM.FreeMaxwellEquations E B) : - ∂ₜ (fun t => E t x) t = - (√(μ • ε))⁻¹ • (s.unit ⨯ₑ₃ (∂ₜ (fun t => B t x) t)) := by - have hdt : ∀ t, (∂ₜ (fun t => E t x) t) = (μ • ε)⁻¹ • (∇ × B t) x := by - intro t - rw [OM.ampereLaw_of_free E B] - simp only [smul_eq_mul, _root_.mul_inv_rev, ← smul_assoc, mul_assoc, ne_eq, OM.mu_ge_zero, - ne_of_gt, not_false_eq_true, inv_mul_cancel_left₀, OM.eps_ge_zero, inv_mul_cancel₀, one_smul] - exact hm - rw [hdt, hBwave, magneticPlaneWave, ← hc, crossProduct] - unfold planeWave curl coord basis Space.deriv - ext i - fin_cases i <;> - · rw [← Real.sq_sqrt (inv_nonneg_of_nonneg (le_of_lt (smul_pos OM.mu_ge_zero OM.eps_ge_zero))), - Real.sqrt_inv, ← hc] - simp only [Fin.isValue, EuclideanSpace.basisFun_apply, Fin.reduceFinMk, PiLp.smul_apply, - smul_eq_mul, Nat.succ_eq_add_one, Nat.reduceAdd, WithLp.equiv_apply, LinearMap.mk₂_apply, - PiLp.ofLp_apply, WithLp.equiv_symm_apply, PiLp.toLp_apply, Matrix.cons_val, neg_mul] - rw [mul_sub, pow_two, - mul_assoc, space_fderiv_of_inner_product_wave_eq_space_fderiv h', - mul_assoc, space_fderiv_of_inner_product_wave_eq_space_fderiv h'] - ring - -/-! - -#### B.4.2. Proportional up to a space-dependent constant - --/ - -/-- A magnetic planewave induces an electric field equal to `- s ⨯ₑ₃ B` plus a constant field. -/ -lemma electricPlaneWave_eq_cross_magneticPlaneWave_upto_space_fun - {B₀ : ℝ → EuclideanSpace ℝ (Fin 3)} {s : Direction} - {E : ElectricField} {B : MagneticField} (hc : c = (√(μ • ε))⁻¹) - (hBwave : B = magneticPlaneWave B₀ c s) (h' : Differentiable ℝ B₀) - (hm : OM.FreeMaxwellEquations E B) (hE : Differentiable ℝ ↿E) : - ∃ (c : Space → EuclideanSpace ℝ (Fin 3)), ∀ t x, - (E t x) = - (√(μ • ε))⁻¹ • (s.unit ⨯ₑ₃ (B t x)) + c x := by - have h : ∀ t x, ∂ₜ (fun t => (E t x)) t + (√(μ • ε))⁻¹ • - ∂ₜ (fun t => s.unit ⨯ₑ₃ (B t x)) t = 0 := by - intro t x - rw [time_deriv_electricPlaneWave_eq_cross_time_deriv_magneticPlaneWave - OM hc hBwave h' hm] - rw [time_deriv_cross_commute] - simp only [smul_eq_mul, neg_smul, neg_add_cancel] - · exact time_differentiable_of_eq_planewave h' hBwave - unfold Time.deriv at h - have hderiv' : ∀ t x, fderiv ℝ (fun t => (E t x) + - (√(μ • ε))⁻¹ • (s.unit ⨯ₑ₃ (B t x))) t 1 = 0 := by - intro t x - rw [fderiv_fun_add, fderiv_fun_smul] - simp_all - · fun_prop - · exact crossProduct_time_differentiable_of_right_eq_planewave h' hBwave - · exact function_differentiableAt_fst (hf := by fun_prop) .. - · apply DifferentiableAt.fun_const_smul - exact crossProduct_time_differentiable_of_right_eq_planewave h' hBwave - have hderiv : ∀ t x, fderiv ℝ (fun t => (E t x) + - (√(μ • ε))⁻¹ • (s.unit ⨯ₑ₃ (B t x))) t = 0 := by - intro t x - ext1 r - conv_lhs => - enter [2] - rw [Time.eq_one_smul r] - simp only [smul_eq_mul, WithLp.equiv_apply, WithLp.equiv_symm_apply, map_smul, - ContinuousLinearMap.zero_apply, smul_eq_zero] - right - exact hderiv' t x - use fun x => (E 0 x) + (√(μ • ε))⁻¹ • (s.unit ⨯ₑ₃ B 0 x) - intro t x - have ht' := fun t => hderiv t x - apply is_const_of_fderiv_eq_zero at ht' - simp only - rw [ht' 0 t] - simp only [smul_eq_mul, neg_smul, neg_add_cancel_comm_assoc] - · intro x - apply DifferentiableAt.add - · exact function_differentiableAt_fst (hf := by fun_prop) .. - · apply DifferentiableAt.fun_const_smul - exact crossProduct_time_differentiable_of_right_eq_planewave h' hBwave - -/-! - -#### B.4.3. Proportional up to a constant - --/ - -/-- `E + s ⨯ₑ₃ B` is constant for an EMwave. -/ -lemma electricField_add_cross_magneticField_eq_const_of_planeWave - {s : Direction} {E₀ : ℝ → EuclideanSpace ℝ (Fin 3)} {B₀ : ℝ → EuclideanSpace ℝ (Fin 3)} - {E : ElectricField} {B : MagneticField} (hc : c = (√(μ • ε))⁻¹) - (hEwave : E = electricPlaneWave E₀ c s) - (hBwave : B = magneticPlaneWave B₀ c s) - (hE' : Differentiable ℝ E₀) (hB' : Differentiable ℝ B₀) - (hm : OM.FreeMaxwellEquations E B) : - ∃ (Ec : EuclideanSpace ℝ (Fin 3)), ∀ t x, - (E t x) + (√(μ • ε))⁻¹ • (s.unit ⨯ₑ₃ (B t x)) = Ec := by - have hc_non_zero : c ≠ 0 := by - rw [hc] - simp [ne_of_gt, OM.mu_ge_zero, OM.eps_ge_zero] - have hcuE' : ∃ (Ecu : ℝ → EuclideanSpace ℝ (Fin 3)), ∀ t x, - (E t x) + (√(μ • ε))⁻¹ • (s.unit ⨯ₑ₃ (B t x)) = Ecu (inner ℝ x s.unit - c * t) := by - use fun u => E₀ u + (√(μ • ε))⁻¹ • (s.unit ⨯ₑ₃ B₀ u) - intro t x - rw [hEwave, hBwave, electricPlaneWave, magneticPlaneWave, planeWave, planeWave] - have hcxE' := electricPlaneWave_eq_cross_magneticPlaneWave_upto_space_fun - OM hc hBwave hB' hm (by subst hEwave; exact planeWave_differentiable hE') - obtain ⟨Ecx, hcxE''⟩ := hcxE' - obtain ⟨Ecu, hcuE⟩ := hcuE' - have hcxE : ∀ t x, (E t x) + (√(μ • ε))⁻¹ • (s.unit ⨯ₑ₃ (B t x)) = Ecx x := by - simp [hcxE''] - use Ecu 0 - intro t x - rw [hcxE] - have hu : inner ℝ x s.unit - c * (c⁻¹ * inner ℝ x s.unit) = 0 := by - rw [← mul_assoc] - simp [hc_non_zero] - rw [← hu, ← hcuE _ x, hcxE] - -/-! - -### B.5. B proportional to cross of direction of propagation & B, up to a constant - --/ - -/-! - -#### B.5.1. Time derivative of B-field proportional to propagation cross time derivative of E-field - --/ - -/-- The time derivative of an electric planewave induces a magnetic field with -time derivative equal to `s ⨯ₑ₃ E'`. -/ -lemma time_deriv_magneticPlaneWave_eq_cross_time_deriv_electricPlaneWave - {t : Time} {x : Space} {E₀ : ℝ → EuclideanSpace ℝ (Fin 3)} - {s : Direction} {E : ElectricField} {B : MagneticField} - (hc : c = (√(μ • ε))⁻¹) (hEwave : E = electricPlaneWave E₀ c s) - (h' : Differentiable ℝ E₀) (hm : OM.FreeMaxwellEquations E B) : - ∂ₜ (fun t => B t x) t = (√(μ • ε)) • (s.unit ⨯ₑ₃ (∂ₜ (fun t => E t x) t)) := by - have h : (√(μ • ε)) = c⁻¹ := by - rw [hc] - simp - have hc_non_zero : c ≠ 0 := by - rw [hc] - simp [ne_of_gt, OM.mu_ge_zero, OM.eps_ge_zero] - rw [← neg_neg (∂ₜ (fun t => B t x) t), - ← OM.faradayLaw_of_free E B, hEwave, electricPlaneWave, h, crossProduct] - unfold planeWave curl coord basis Space.deriv - ext i - fin_cases i <;> - · simp - rw [← mul_right_inj' hc_non_zero, mul_sub, - space_fderiv_of_inner_product_wave_eq_space_fderiv h', - space_fderiv_of_inner_product_wave_eq_space_fderiv h', - ← mul_assoc, mul_inv_cancel₀ hc_non_zero] - ring - exact hm - -/-! - -#### B.5.2. Proportional up to a space-dependent constant --/ - -/-- An electric planewave induces an magnetic field equal to `s ×₃ E` plus a constant field. -/ -lemma magneticPlaneWave_eq_cross_electricPlaneWave_upto_space_fun - {E₀ : ℝ → EuclideanSpace ℝ (Fin 3)} {s : Direction} - {E : ElectricField} {B : MagneticField} (hc : c = (√(μ • ε))⁻¹) - (hEwave : E = electricPlaneWave E₀ c s) (h' : Differentiable ℝ E₀) - (hm : OM.FreeMaxwellEquations E B) (hB : Differentiable ℝ ↿B) : - ∃ (c : Space → EuclideanSpace ℝ (Fin 3)), ∀ t x, - (B t x) = (√(μ • ε)) • (s.unit ⨯ₑ₃ (E t x)) + c x := by - have h : ∀ t x, ∂ₜ (fun t => (B t x)) t - - (√(μ • ε)) • ∂ₜ (fun t => s.unit ⨯ₑ₃ (E t x)) t = 0 := by - intro t x - rw [time_deriv_magneticPlaneWave_eq_cross_time_deriv_electricPlaneWave - OM hc hEwave h' hm] - rw [time_deriv_cross_commute] - simp only [smul_eq_mul, sub_self] - · exact time_differentiable_of_eq_planewave h' hEwave - unfold Time.deriv at h - have hderiv : ∀ t x, fderiv ℝ (fun t => (B t x) - - (√(μ • ε)) • (s.unit ⨯ₑ₃ (E t x))) t = 0 := by - intro t x - ext1 r - conv_lhs => - enter [2] - rw [Time.eq_one_smul r] - simp only [smul_eq_mul, WithLp.equiv_apply, WithLp.equiv_symm_apply, map_smul, - ContinuousLinearMap.zero_apply, smul_eq_zero] - right - rw [fderiv_fun_sub] - rw [fderiv_fun_const_smul] - change (fderiv ℝ (fun t => B t x) t 1) - - ((√(μ • ε)) • fderiv ℝ (fun t => (s.unit ⨯ₑ₃ (E t x))) t 1) = _ - rw [h] - · exact crossProduct_time_differentiable_of_right_eq_planewave h' hEwave - · exact function_differentiableAt_fst (hf := by fun_prop) .. - · apply DifferentiableAt.fun_const_smul - exact crossProduct_time_differentiable_of_right_eq_planewave h' hEwave - use fun x => (B 0 x) - (√(μ • ε)) • (s.unit ⨯ₑ₃ E 0 x) - intro t x - have ht' := fun t => hderiv t x - apply is_const_of_fderiv_eq_zero at ht' - simp only - rw [ht' 0 t] - simp only [smul_eq_mul, WithLp.equiv_apply, WithLp.equiv_symm_apply, add_sub_cancel] - · intro x - apply DifferentiableAt.sub - · exact function_differentiableAt_fst (hf := by fun_prop) .. - · apply DifferentiableAt.fun_const_smul - exact crossProduct_time_differentiable_of_right_eq_planewave h' hEwave - -/-! - -#### B.5.3. Proportional up to a constant --/ - -/-- `B - s ⨯ₑ₃ E` is constant for an EMwave. -/ -lemma magneticField_sub_cross_electricField_eq_const_of_planeWave - {s : Direction} {E₀ : ℝ → EuclideanSpace ℝ (Fin 3)} {B₀ : ℝ → EuclideanSpace ℝ (Fin 3)} - {E : ElectricField} {B : MagneticField} (hc : c = (√(μ • ε))⁻¹) - (hEwave : E = electricPlaneWave E₀ c s) - (hBwave : B = magneticPlaneWave B₀ c s) - (hE' : Differentiable ℝ E₀) (hB' : Differentiable ℝ B₀) - (hm : OM.FreeMaxwellEquations E B) : - ∃ (Ec : EuclideanSpace ℝ (Fin 3)), ∀ t x, - (B t x) - (√(μ • ε)) • (s.unit ⨯ₑ₃ (E t x)) = Ec := by - have hc_non_zero : c ≠ 0 := by - rw [hc] - simp [ne_of_gt, OM.mu_ge_zero, OM.eps_ge_zero] - have hcuB' : ∃ (Ecu : ℝ → EuclideanSpace ℝ (Fin 3)), ∀ t x, - (B t x) - (√(μ • ε)) • (s.unit ⨯ₑ₃ (E t x)) = Ecu (inner ℝ x s.unit - c * t) := by - use fun u => B₀ u - (√(μ • ε)) • (s.unit ⨯ₑ₃ E₀ u) - intro t x - rw [hEwave, hBwave, electricPlaneWave, magneticPlaneWave, planeWave, planeWave] - have hcxB' := magneticPlaneWave_eq_cross_electricPlaneWave_upto_space_fun - OM hc hEwave hE' hm (by subst hBwave; exact planeWave_differentiable hB') - obtain ⟨Bcx, hcxB''⟩ := hcxB' - obtain ⟨Bcu, hcuB⟩ := hcuB' - have hcxB : ∀ t x, (B t x) - (√(μ • ε)) • (s.unit ⨯ₑ₃ (E t x)) = Bcx x := by - simp [hcxB''] - use Bcu 0 - intro t x - rw [hcxB] - have hu : inner ℝ x s.unit - c * (c⁻¹ * inner ℝ x s.unit) = 0 := by - rw [← mul_assoc] - simp [hc_non_zero] - rw [← hu, ← hcuB _ x, hcxB] - -/-! - -### B.6. E-field orthogonal to direction of propagation up to a constant - --/ - -/-- The electric field of an EMwave minus a constant field is transverse. -/ -theorem electricField_transverse_upto_const_of_EMwave {s : Direction} - {E₀ : ℝ → EuclideanSpace ℝ (Fin 3)} {B₀ : ℝ → EuclideanSpace ℝ (Fin 3)} - {E : ElectricField} {B : MagneticField} (hc : c = (√(μ • ε))⁻¹) - (hEwave : E = electricPlaneWave E₀ c s) - (hBwave : B = magneticPlaneWave B₀ c s) - (hE' : Differentiable ℝ E₀) (hB' : Differentiable ℝ B₀) - (hm : OM.FreeMaxwellEquations E B) : - ∃ (c : EuclideanSpace ℝ (Fin 3)), ∀ t x, inner ℝ (E t x - c) s.unit = 0 := by - have hct := transverse_upto_time_fun_of_eq_electricPlaneWave OM hEwave hE' hm - have hcx' := electricPlaneWave_eq_cross_magneticPlaneWave_upto_space_fun - OM hc hBwave hB' hm (by subst hEwave; exact planeWave_differentiable hE') - obtain ⟨ct, hct⟩ := hct - obtain ⟨cx, hcx'⟩ := hcx' - have hcx : ∀ t x, inner ℝ (E t x) s.unit = inner ℝ (cx x) s.unit := by - intro t x - rw [hcx'] - simp only [smul_eq_mul, neg_smul, PiLp.inner_apply, PiLp.add_apply, PiLp.neg_apply, - PiLp.smul_apply, WithLp.equiv_symm_apply, PiLp.toLp_apply, RCLike.inner_apply, conj_trivial] - rw [crossProduct, Finset.sum, Finset.sum] - simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.isValue, LinearMap.mk₂_apply, - WithLp.equiv_apply, PiLp.ofLp_apply, Fin.univ_val_map, List.ofFn_succ, Matrix.cons_val_zero, - Matrix.cons_val_succ, Fin.succ_zero_eq_one, Matrix.cons_val_fin_one, Fin.succ_one_eq_two, - List.ofFn_zero, Multiset.sum_coe, List.sum_cons, List.sum_nil, add_zero] - ring - use cx 0 - intro t x - rw [inner_sub_left] - rw [hct] - rw [← hcx t 0, ← hct t 0] - simp - -/-! - -### B.7. B-field orthogonal to direction of propagation up to a constant - --/ - -/-- The magnetic field of an EMwave minus a constant field is transverse. -/ -theorem magneticField_transverse_upto_const_of_EMwave {s : Direction} - {E₀ : ℝ → EuclideanSpace ℝ (Fin 3)} {B₀ : ℝ → EuclideanSpace ℝ (Fin 3)} - {E : ElectricField} {B : MagneticField} (hc : c = (√(μ • ε))⁻¹) - (hEwave : E = electricPlaneWave E₀ c s) - (hBwave : B = magneticPlaneWave B₀ c s) - (hE' : Differentiable ℝ E₀) (hB' : Differentiable ℝ B₀) - (hm : OM.FreeMaxwellEquations E B) : - ∃ (c : EuclideanSpace ℝ (Fin 3)), ∀ t x, inner ℝ (B t x - c) s.unit = 0 := by - have hct := transverse_upto_time_fun_of_eq_magneticPlaneWave OM hBwave hB' hm - have hcx' := magneticPlaneWave_eq_cross_electricPlaneWave_upto_space_fun - OM hc hEwave hE' hm (by subst hBwave; exact planeWave_differentiable hB') - obtain ⟨ct, hct⟩ := hct - obtain ⟨cx, hcx'⟩ := hcx' - have hcx : ∀ t x, inner ℝ (B t x) s.unit = inner ℝ (cx x) s.unit := by - intro t x - rw [hcx'] - simp only [smul_eq_mul, PiLp.inner_apply, PiLp.add_apply, - PiLp.smul_apply, WithLp.equiv_symm_apply, PiLp.toLp_apply, RCLike.inner_apply, conj_trivial] - rw [crossProduct, Finset.sum, Finset.sum] - simp only [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.isValue, WithLp.equiv_apply, - LinearMap.mk₂_apply, PiLp.ofLp_apply, Fin.univ_val_map, List.ofFn_succ, Matrix.cons_val_zero, - Matrix.cons_val_succ, Fin.succ_zero_eq_one, Matrix.cons_val_fin_one, Fin.succ_one_eq_two, - List.ofFn_zero, Multiset.sum_coe, List.sum_cons, List.sum_nil, add_zero] - ring - use cx 0 - intro t x - rw [inner_sub_left] - rw [hct] - rw [← hcx t 0, ← hct t 0] - simp - -/-! - -### B.8. E, B and direction of propagation form an orthonormal triad up to constants - --/ - -/-- Unit vectors in the direction of `B`, `E` and `s` form an orthonormal triad for an EMwave -after subtracting the appropriate constant fields. -/ -theorem orthonormal_triad_of_electromagneticplaneWave {s : Direction} - {E₀ : ℝ → EuclideanSpace ℝ (Fin 3)} {B₀ : ℝ → EuclideanSpace ℝ (Fin 3)} - {E : ElectricField} {B : MagneticField} (hc : c = (√(μ • ε))⁻¹) - (hEwave : E = electricPlaneWave E₀ c s) - (hBwave : B = magneticPlaneWave B₀ c s) - (hE' : Differentiable ℝ E₀) (hB' : Differentiable ℝ B₀) - (hm : OM.FreeMaxwellEquations E B) : - ∃ (Ep Bp : EuclideanSpace ℝ (Fin 3)), ∀ t x, - E t x - Ep ≠ 0 ∧ B t x - Bp ≠ 0 → - Orthonormal ℝ ![((‖E t x - Ep‖)⁻¹) • (E t x - Ep), - ((‖B t x - Bp‖)⁻¹) • (B t x - Bp), s.unit] := by - obtain ⟨Ec, hEc⟩ := electricField_transverse_upto_const_of_EMwave OM hc hEwave hBwave hE' hB' hm - obtain ⟨Bcdiff, hBcdiff⟩ := magneticField_sub_cross_electricField_eq_const_of_planeWave - OM hc hEwave hBwave hE' hB' hm - use Ec, Bcdiff + (√(μ • ε)) • (s.unit ⨯ₑ₃ Ec) - intro t x h - simp only [Nat.succ_eq_add_one, Nat.reduceAdd, smul_eq_mul, orthonormal_vecCons_iff, - Fin.forall_fin_succ, Fin.isValue, Matrix.cons_val_zero, Matrix.cons_val_succ, - Matrix.cons_val_fin_one, forall_const, IsEmpty.forall_iff, Orthonormal.of_isEmpty, and_self, - and_true] - repeat' constructor - · exact norm_smul_inv_norm h.1 - · /- E orthogonal to B. -/ - rw [inner_smul_left, inner_smul_right] - simp only [map_inv₀, conj_trivial, mul_eq_zero, inv_eq_zero, norm_eq_zero] - right - right - rw [← hBcdiff t x] - simp only [smul_eq_mul, sub_add, sub_sub_cancel] - rw [← smul_sub, inner_smul_right] - simp only [WithLp.equiv_symm_apply, WithLp.equiv_apply] - rw [← WithLp.toLp_sub, ← LinearMap.map_sub, ← WithLp.ofLp_sub] - conv_lhs => - enter [2] - erw [inner_cross_self] - simp - · /- E orthogonal to s. -/ - rw [inner_smul_left] - simp only [map_inv₀, conj_trivial, mul_eq_zero, inv_eq_zero, norm_eq_zero] - right - rw [hEc] - · exact norm_smul_inv_norm h.2 - · /- B orthogonal to s. -/ - rw [inner_smul_left] - simp only [map_inv₀, conj_trivial, mul_eq_zero, inv_eq_zero, norm_eq_zero] - right - rw [← hBcdiff t x] - simp only [smul_eq_mul, sub_add, sub_sub_cancel] - rw [← smul_sub, inner_smul_left] - simp only [WithLp.equiv_symm_apply, WithLp.equiv_apply] - rw [← WithLp.toLp_sub, ← LinearMap.map_sub, ← WithLp.ofLp_sub] - rw [real_inner_comm] - erw [inner_self_cross (s.unit) (E t x - Ec)] - simp - · exact s.norm - -end Electromagnetism diff --git a/PhysLean/Mathematics/Calculus/Divergence.lean b/PhysLean/Mathematics/Calculus/Divergence.lean index c2c38575d..4547076c5 100644 --- a/PhysLean/Mathematics/Calculus/Divergence.lean +++ b/PhysLean/Mathematics/Calculus/Divergence.lean @@ -5,7 +5,7 @@ Authors: Tomas Skrivan -/ import Mathlib.Analysis.InnerProductSpace.Trace import PhysLean.Mathematics.Calculus.AdjFDeriv -import PhysLean.SpaceAndTime.Space.Basic +import PhysLean.SpaceAndTime.TimeAndSpace.Basic /-! # Divergence @@ -37,7 +37,8 @@ lemma divergence_eq_sum_fderiv {s : Finset E} (b : Basis s 𝕜 E) {f : E → E} funext x unfold divergence rw[LinearMap.trace_eq_matrix_trace_of_finset (s:=s) _ b] - simp[Matrix.trace,Matrix.diag,LinearMap.toMatrix] + simp only [Matrix.trace, Matrix.diag, LinearMap.toMatrix_apply] + rfl lemma divergence_eq_sum_fderiv' {ι} [Fintype ι] (b : Basis ι 𝕜 E) {f : E → E} : divergence 𝕜 f = fun x => ∑ i, b.repr (fderiv 𝕜 f x (b i)) i := by @@ -60,14 +61,12 @@ lemma divergence_eq_sum_fderiv' {ι} [Fintype ι] (b : Basis ι 𝕜 E) {f : E simp [b'] lemma divergence_eq_space_div {d} (f : Space d → Space d) - (h : Differentiable ℝ f) : divergence ℝ f = Space.div f := by + (h : Differentiable ℝ f) : divergence ℝ f = Space.div (Space.basis.repr ∘ f) := by let b := (Space.basis (d:=d)).toBasis rw[divergence_eq_sum_fderiv' b] funext x - simp +zetaDelta only [Space.basis, OrthonormalBasis.coe_toBasis, EuclideanSpace.basisFun_apply, - OrthonormalBasis.coe_toBasis_repr_apply, EuclideanSpace.basisFun_repr, Space.div, Space.deriv, - Space.coord, PiLp.inner_apply, EuclideanSpace.single_apply, RCLike.inner_apply, conj_trivial, - ite_mul, one_mul, zero_mul, Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte] + simp +zetaDelta only [OrthonormalBasis.coe_toBasis, OrthonormalBasis.coe_toBasis_repr_apply, + Space.basis_repr_apply, Space.div, Space.deriv, Function.comp_apply] congr funext i have h1 : (fderiv ℝ (fun x => f x i) x) @@ -129,15 +128,6 @@ lemma divergence_const_smul {f : E → E} {x : E} {c : 𝕜} unfold divergence simp [fderiv_fun_const_smul hf] -@[simp] -lemma ContinuousLinearMap.smulRight_toLinearMap {M₁ : Type*} [TopologicalSpace M₁] - [AddCommMonoid M₁] {M₂ : Type*} [TopologicalSpace M₂] [AddCommMonoid M₂] {R : Type*} {S : Type*} - [Semiring R] [Semiring S] [Module R M₁] [Module R M₂] [Module R S] [Module S M₂] - [IsScalarTower R S M₂] [TopologicalSpace S] [ContinuousSMul S M₂] (c : M₁ →L[R] S) (f : M₂) : - (↑(ContinuousLinearMap.smulRight c f) : M₁ →ₗ[R] M₂) = - LinearMap.smulRight (↑c : M₁ →ₗ[R] S) f := - rfl - open InnerProductSpace' in lemma divergence_smul [InnerProductSpace' 𝕜 E] {f : E → 𝕜} {g : E → E} {x : E} (hf : DifferentiableAt 𝕜 f x) (hg : DifferentiableAt 𝕜 g x) diff --git a/PhysLean/Mathematics/DataStructures/FourTree/UniqueMap.lean b/PhysLean/Mathematics/DataStructures/FourTree/UniqueMap.lean index dd06ff580..3b80d890e 100644 --- a/PhysLean/Mathematics/DataStructures/FourTree/UniqueMap.lean +++ b/PhysLean/Mathematics/DataStructures/FourTree/UniqueMap.lean @@ -96,7 +96,7 @@ lemma map_mem_uniqueMap4 {T : FourTree α1 α2 α3 α4} use twig use (leaf.uniqueMap4 f) constructor - · simp [Twig.uniqueMap4] + · simp [Twig.uniqueMap4, -existsAndEq] use f leaf.1 constructor · use leaf diff --git a/PhysLean/Mathematics/DataStructures/Matrix/LieTrace.lean b/PhysLean/Mathematics/DataStructures/Matrix/LieTrace.lean index 74060a026..31878cf68 100644 --- a/PhysLean/Mathematics/DataStructures/Matrix/LieTrace.lean +++ b/PhysLean/Mathematics/DataStructures/Matrix/LieTrace.lean @@ -95,9 +95,9 @@ lemma diag_pow_of_blockTriangular_id {A : Matrix m m 𝕂} /-- The exponential of an upper-triangular matrix is upper-triangular. -/ lemma blockTriangular_exp_of_blockTriangular_id {A : Matrix m m 𝕂} (hA : BlockTriangular A id) : - (NormedSpace.exp 𝕂 A).BlockTriangular id := by + (NormedSpace.exp A).BlockTriangular id := by intro i j hij - rw [NormedSpace.exp_eq_tsum] + rw [NormedSpace.exp_eq_tsum 𝕂] let exp_series := fun n => ((n.factorial : 𝕂)⁻¹) • (A ^ n) change (∑' n, exp_series n) i j = 0 rw [matrix_tsum_apply (NormedSpace.expSeries_summable' A) i j] @@ -137,20 +137,20 @@ lemma matrix_exp_series_diag_eq_scalar_series {A : Matrix m m 𝕂} (hA : BlockT exponentials of the diagonal entries of `A`. -/ theorem diag_exp_of_blockTriangular_id {A : Matrix m m 𝕂} (hA : BlockTriangular A id) : - (NormedSpace.exp 𝕂 A).diag = fun i => NormedSpace.exp 𝕂 (A i i) := by + (NormedSpace.exp A).diag = fun i => NormedSpace.exp (A i i) := by funext i - rw [NormedSpace.exp_eq_tsum (𝕂 := 𝕂), diag_apply] + rw [NormedSpace.exp_eq_tsum 𝕂, diag_apply] simp_rw [matrix_tsum_apply (NormedSpace.expSeries_summable' A) i i] rw [matrix_exp_series_diag_eq_scalar_series hA i] - rw [NormedSpace.exp_eq_tsum (𝕂 := 𝕂)] + rw [NormedSpace.exp_eq_tsum 𝕂] /-- Lie's trace formula for upper triangular matrices. -/ lemma det_exp_of_blockTriangular_id {A : Matrix m m 𝕂} (hA : BlockTriangular A id) : - (NormedSpace.exp 𝕂 A).det = NormedSpace.exp 𝕂 A.trace := by - have h_exp_upper : BlockTriangular (NormedSpace.exp 𝕂 A) id := + (NormedSpace.exp A).det = NormedSpace.exp A.trace := by + have h_exp_upper : BlockTriangular (NormedSpace.exp A) id := blockTriangular_exp_of_blockTriangular_id hA rw [det_of_upperTriangular h_exp_upper] - have h_diag_exp : (NormedSpace.exp 𝕂 A).diag = fun i => NormedSpace.exp 𝕂 (A i i) := + have h_diag_exp : (NormedSpace.exp A).diag = fun i => NormedSpace.exp (A i i) := diag_exp_of_blockTriangular_id hA simp_rw [← diag_apply] simp_rw [h_diag_exp] @@ -169,39 +169,39 @@ lemma trace_unitary_conj (A : Matrix m m 𝕂) (U : unitaryGroup m 𝕂) : lemma det_unitary_conj (A : Matrix m m 𝕂) (U : unitaryGroup m 𝕂) : det ((U : Matrix m m 𝕂) * A * star (U : Matrix m m 𝕂)) = det A := by rw [det_mul_right_comm] - simp_all only [SetLike.coe_mem, unitary.mul_star_self_of_mem, one_mul] + simp_all only [SetLike.coe_mem, Unitary.mul_star_self_of_mem, one_mul] /-- The exponential of a matrix commutes with unitary conjugation. -/ lemma exp_unitary_conj (A : Matrix m m 𝕂) (U : unitaryGroup m 𝕂) : - NormedSpace.exp 𝕂 ((U : Matrix m m 𝕂) * A * star (U : Matrix m m 𝕂)) = - (U : Matrix m m 𝕂) * NormedSpace.exp 𝕂 A * star (U : Matrix m m 𝕂) := by + NormedSpace.exp ((U : Matrix m m 𝕂) * A * star (U : Matrix m m 𝕂)) = + (U : Matrix m m 𝕂) * NormedSpace.exp A * star (U : Matrix m m 𝕂) := by let Uu : (Matrix m m 𝕂)ˣ := { val := (U : Matrix m m 𝕂) inv := star (U : Matrix m m 𝕂) val_inv := by simp inv_val := by simp} - have h_units := Matrix.exp_units_conj (𝕂 := 𝕂) Uu A + have h_units := Matrix.exp_units_conj Uu A simpa [Uu] using h_units lemma det_exp_unitary_conj (A : Matrix m m 𝕂) (U : unitaryGroup m 𝕂) : - (NormedSpace.exp 𝕂 ((U : Matrix m m 𝕂) * A * star (U : Matrix m m 𝕂))).det = - (NormedSpace.exp 𝕂 A).det := by + (NormedSpace.exp ((U : Matrix m m 𝕂) * A * star (U : Matrix m m 𝕂))).det = + (NormedSpace.exp A).det := by rw [exp_unitary_conj, det_unitary_conj] /-- The determinant of the exponential of a matrix is the exponential of its trace. This is also known as **Lie's trace formula**. -/ theorem det_exp {𝕂 m : Type*} [RCLike 𝕂] [IsAlgClosed 𝕂] [Fintype m] [LinearOrder m] (A : Matrix m m 𝕂) : - (NormedSpace.exp 𝕂 A).det = NormedSpace.exp 𝕂 A.trace := by + (NormedSpace.exp A).det = NormedSpace.exp A.trace := by let U := A.schurTriangulationUnitary let T := A.schurTriangulation have h_prop : T.val.IsUpperTriangular := T.property have h_conj : A = U * T * star U := schur_triangulation A have h_trace_invariant : A.trace = T.val.trace := by erw [h_conj, trace_unitary_conj] - have h_det_invariant : (NormedSpace.exp 𝕂 A).det = (NormedSpace.exp 𝕂 T.val).det := by + have h_det_invariant : (NormedSpace.exp A).det = (NormedSpace.exp T.val).det := by erw [h_conj, det_exp_unitary_conj] - have h_triangular_case : (NormedSpace.exp 𝕂 T.val).det = NormedSpace.exp 𝕂 T.val.trace := + have h_triangular_case : (NormedSpace.exp T.val).det = NormedSpace.exp T.val.trace := det_exp_of_blockTriangular_id h_prop rw [h_det_invariant, h_triangular_case, h_trace_invariant] @@ -221,23 +221,13 @@ attribute [local instance] Matrix.linftyOpNormedAlgebra attribute [local instance] Matrix.linftyOpNormedRing attribute [local instance] Matrix.instCompleteSpace -lemma map_pow {α β m : Type*} - [Fintype m] [DecidableEq m] [Semiring α] [Semiring β] - (f : α →+* β) (A : Matrix m m α) (k : ℕ) : - (A ^ k).map f = (A.map f) ^ k := by - induction k with - | zero => - rw [pow_zero, pow_zero, Matrix.map_one]; all_goals aesop - | succ k ih => - rw [pow_succ, pow_succ, Matrix.map_mul, ih] - end Matrix namespace NormedSpace lemma exp_map_algebraMap {n : Type*} [Fintype n] [DecidableEq n] (A : Matrix n n ℝ) : - (exp ℝ A).map (algebraMap ℝ ℂ) = exp ℂ (A.map (algebraMap ℝ ℂ)) := by + (exp A).map (algebraMap ℝ ℂ) = exp (A.map (algebraMap ℝ ℂ)) := by letI : SeminormedRing (Matrix n n ℝ) := Matrix.linftyOpSemiNormedRing letI : NormedRing (Matrix n n ℝ) := Matrix.linftyOpNormedRing letI : NormedAlgebra ℝ (Matrix n n ℝ) := Matrix.linftyOpNormedAlgebra @@ -246,21 +236,14 @@ lemma exp_map_algebraMap {n : Type*} [Fintype n] [DecidableEq n] letI : NormedRing (Matrix n n ℂ) := Matrix.linftyOpNormedRing letI : NormedAlgebra ℂ (Matrix n n ℂ) := Matrix.linftyOpNormedAlgebra letI : CompleteSpace (Matrix n n ℂ) := inferInstance - simp only [exp_eq_tsum] + simp only [exp_eq_tsum ℝ] have hs : Summable (fun k => (k.factorial : ℝ)⁻¹ • A ^ k) := by exact NormedSpace.expSeries_summable' A erw [Matrix.map_tsum (algebraMap ℝ ℂ).toAddMonoidHom RCLike.continuous_ofReal hs] apply tsum_congr intro k erw [Matrix.map_smul, Matrix.map_pow] - simp_all only [Complex.coe_algebraMap] - ext i j : 1 - simp_all only [Matrix.smul_apply, Complex.real_smul, Complex.ofReal_inv, Complex.ofReal_natCast, - smul_eq_mul] - intro a - simp_all only [RingHom.toAddMonoidHom_eq_coe, smul_eq_mul, AddMonoidHom.coe_coe, - Complex.coe_algebraMap, Complex.ofReal_mul, Complex.ofReal_inv, Complex.ofReal_natCast, - Complex.real_smul] + simp end NormedSpace @@ -271,14 +254,14 @@ Lie's trace formula over ℝ: det(exp(A)) = exp(tr(A)) for any real matrix A. This is proved by transferring the result from ℂ using the naturality of polynomial identities. -/ theorem det_exp_real {n : Type*} [Fintype n] [LinearOrder n] - (A : Matrix n n ℝ) : (NormedSpace.exp ℝ A).det = Real.exp A.trace := by + (A : Matrix n n ℝ) : (NormedSpace.exp A).det = Real.exp A.trace := by let A_ℂ := A.map (algebraMap ℝ ℂ) - have h_complex : (NormedSpace.exp ℂ A_ℂ).det = Complex.exp A_ℂ.trace := by + have h_complex : (NormedSpace.exp A_ℂ).det = Complex.exp A_ℂ.trace := by haveI : IsAlgClosed ℂ := Complex.isAlgClosed rw [Complex.exp_eq_exp_ℂ, ← Matrix.det_exp] have h_trace_comm : A_ℂ.trace = (algebraMap ℝ ℂ) A.trace := by simp only [A_ℂ, trace, diag_map, map_sum];rfl - have h_det_comm : (algebraMap ℝ ℂ) ((NormedSpace.exp ℝ A).det) = (NormedSpace.exp ℂ A_ℂ).det := by + have h_det_comm : (algebraMap ℝ ℂ) ((NormedSpace.exp A).det) = (NormedSpace.exp A_ℂ).det := by rw [@RingHom.map_det] rw [← NormedSpace.exp_map_algebraMap]; rfl rw [← h_det_comm] at h_complex diff --git a/PhysLean/Mathematics/Distribution/Basic.lean b/PhysLean/Mathematics/Distribution/Basic.lean index 2cb4c2df5..76db930e2 100644 --- a/PhysLean/Mathematics/Distribution/Basic.lean +++ b/PhysLean/Mathematics/Distribution/Basic.lean @@ -3,7 +3,7 @@ Copyright (c) 2025 Kenny Lau. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Kenny Lau, Joseph Tooby-Smith -/ -import Mathlib.Analysis.Distribution.FourierSchwartz +import Mathlib.Analysis.Distribution.TemperedDistribution import PhysLean.Meta.TODO.Basic /-! @@ -180,12 +180,12 @@ def fderivD [FiniteDimensional ℝ E] : (E →d[𝕜] F) →ₗ[𝕜] (E →d[ toFun u := { toFun η := LinearMap.toContinuousLinearMap { toFun v := ContinuousLinearEquiv.neg 𝕜 <| u <| - SchwartzMap.evalCLM (𝕜 := 𝕜) v <| + SchwartzMap.evalCLM (𝕜 := 𝕜) E 𝕜 v <| SchwartzMap.fderivCLM 𝕜 (E := E) (F := 𝕜) η map_add' v1 v2 := by simp only [ContinuousLinearEquiv.neg_apply] - trans -u ((SchwartzMap.evalCLM (𝕜 := 𝕜) v1) ((fderivCLM 𝕜) η) + - (SchwartzMap.evalCLM (𝕜 := 𝕜) v2) ((fderivCLM 𝕜) η)) + trans -u ((SchwartzMap.evalCLM (𝕜 := 𝕜) E 𝕜 v1) ((fderivCLM 𝕜) E 𝕜 η) + + (SchwartzMap.evalCLM (𝕜 := 𝕜) E 𝕜 v2) ((fderivCLM 𝕜) E 𝕜 η)) swap · simp only [map_add, neg_add_rev] abel @@ -196,7 +196,7 @@ def fderivD [FiniteDimensional ℝ E] : (E →d[𝕜] F) →ₗ[𝕜] (E →d[ rfl map_smul' a v1 := by simp only [ContinuousLinearEquiv.neg_apply, RingHom.id_apply, smul_neg, neg_inj] - trans u (a • (SchwartzMap.evalCLM (𝕜 := 𝕜) v1) ((fderivCLM 𝕜) η)) + trans u (a • (SchwartzMap.evalCLM (𝕜 := 𝕜) E 𝕜 v1) ((fderivCLM 𝕜) E 𝕜 η)) swap · simp congr @@ -230,7 +230,7 @@ def fderivD [FiniteDimensional ℝ E] : (E →d[𝕜] F) →ₗ[𝕜] (E →d[ simp lemma fderivD_apply [FiniteDimensional ℝ E] (u : E →d[𝕜] F) (η : 𝓢(E, 𝕜)) (v : E) : - fderivD 𝕜 u η v = - u (SchwartzMap.evalCLM (𝕜 := 𝕜) v (SchwartzMap.fderivCLM 𝕜 η)) := by + fderivD 𝕜 u η v = - u (SchwartzMap.evalCLM (𝕜 := 𝕜) E 𝕜 v (SchwartzMap.fderivCLM 𝕜 E 𝕜 η)) := by rfl TODO "01-09-25-JTS" "For distributions, prove that the derivative fderivD commutes with @@ -361,11 +361,10 @@ lemma fderivD_const [hμ : Measure.IsAddHaarMeasure (volume (α := E))] swap · simp rw [integral_smul_fderiv_eq_neg_fderiv_smul_of_integrable] - simp - rfl + simp only [evalCLM_apply_apply, fderivCLM_apply, neg_neg] · apply MeasureTheory.Integrable.smul_const - change Integrable (SchwartzMap.evalCLM (𝕜 := ℝ) v (SchwartzMap.fderivCLM ℝ η)) volume - exact integrable ((SchwartzMap.evalCLM v) ((fderivCLM ℝ) η)) + change Integrable (SchwartzMap.evalCLM (𝕜 := ℝ) E ℝ v (SchwartzMap.fderivCLM ℝ E ℝ η)) volume + exact integrable ((SchwartzMap.evalCLM ℝ E ℝ v) ((fderivCLM ℝ) E ℝ η)) · simp · apply MeasureTheory.Integrable.smul_const exact integrable η @@ -387,12 +386,15 @@ outputs `η a • v`. section DiracDelta +open TemperedDistribution ContinuousLinearMap + variable [NormedSpace ℝ E] [NormedSpace 𝕜 F] /-- Dirac delta distribution `diracDelta 𝕜 a : E →d[𝕜] 𝕜` takes in a test function `η : 𝓢(E, 𝕜)` and outputs `η a`. Intuitively this is an infinite density at a single point `a`. -/ def diracDelta (a : E) : E →d[𝕜] 𝕜 := - delta 𝕜 𝕜 a + toPointwiseConvergenceCLM _ _ _ _ <| + (BoundedContinuousFunction.evalCLM 𝕜 a).comp (toBoundedContinuousFunctionCLM 𝕜 E 𝕜) @[simp] lemma diracDelta_apply (a : E) (η : 𝓢(E, 𝕜)) : diracDelta 𝕜 a η = η a := diff --git a/PhysLean/Mathematics/Distribution/Function/IsDistBounded.lean b/PhysLean/Mathematics/Distribution/Function/IsDistBounded.lean deleted file mode 100644 index e274c762d..000000000 --- a/PhysLean/Mathematics/Distribution/Function/IsDistBounded.lean +++ /dev/null @@ -1,515 +0,0 @@ -/- -Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Tooby-Smith --/ -import PhysLean.Mathematics.Distribution.Function.InvPowMeasure -import Mathlib.Tactic.Cases -/-! - -## Bounded functions for distributions - -In this module we define the property `IsDistBounded f` for a function `f`. -It says that `f` is bounded by a finite sum of terms of the form `c * ‖x + g‖ ^ p` for -constants `c`, `g` and `-d ≤ p ` where `d` is the dimension of the space minus 1. - -We prove a number of properties of these functions, in particular that they -are integrable when multiplied by a Schwartz map. This allows us to define distributions -from such functions. - --/ -open SchwartzMap NNReal -noncomputable section - -variable (𝕜 : Type) {E F F' : Type} [RCLike 𝕜] [NormedAddCommGroup E] [NormedAddCommGroup F] - [NormedAddCommGroup F'] - -namespace Distribution - -variable [NormedSpace ℝ E] - -open MeasureTheory - -/-! - -## IsBounded - --/ - -/-- The boundedness condition on a function ` EuclideanSpace ℝ (Fin dm1.succ) → F` - for it to form a distribution. -/ -@[fun_prop] -def IsDistBounded {dm1 : ℕ} (f : EuclideanSpace ℝ (Fin dm1.succ) → F) : Prop := - ∃ n, ∃ c : Fin n → ℝ, ∃ g : Fin n → EuclideanSpace ℝ (Fin dm1.succ), - ∃ p : Fin n → ℤ, - (∀ i, 0 ≤ c i) ∧ - (∀ i, -dm1 ≤ p i) ∧ - ∀ x, ‖f x‖ ≤ ∑ i, c i * ‖x + g i‖ ^ p i - -@[fun_prop] -lemma IsDistBounded.add {dm1 : ℕ} {f g : EuclideanSpace ℝ (Fin dm1.succ) → F} - (hf : IsDistBounded f) (hg : IsDistBounded g) : IsDistBounded (f + g) := by - rcases hf with ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩ - rcases hg with ⟨n2, c2, g2, p2, c2_nonneg, p2_bound, bound2⟩ - refine ⟨n1 + n2, Fin.append c1 c2, Fin.append g1 g2, Fin.append p1 p2, ?_, ?_, ?_⟩ - · intro i - obtain ⟨i, rfl⟩ := finSumFinEquiv.surjective i - match i with - | .inl i => - simp only [finSumFinEquiv_apply_left, Fin.append_left, ge_iff_le] - exact c1_nonneg i - | .inr i => - simp only [finSumFinEquiv_apply_right, Fin.append_right, ge_iff_le] - exact c2_nonneg i - · intro i - obtain ⟨i, rfl⟩ := finSumFinEquiv.surjective i - match i with - | .inl i => - simp only [finSumFinEquiv_apply_left, Fin.append_left, ge_iff_le] - exact p1_bound i - | .inr i => - simp only [finSumFinEquiv_apply_right, Fin.append_right, ge_iff_le] - exact p2_bound i - · intro x - apply (norm_add_le _ _).trans - apply (add_le_add (bound1 x) (bound2 x)).trans - apply le_of_eq - rw [← finSumFinEquiv.sum_comp] - simp - -@[fun_prop] -lemma IsDistBounded.const_smul {dm1 : ℕ} [NormedSpace ℝ F] {f : EuclideanSpace ℝ (Fin dm1.succ) → F} - (hf : IsDistBounded f) (c : ℝ) : IsDistBounded (c • f) := by - rcases hf with ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩ - refine ⟨n1, ‖c‖ • c1, g1, p1, ?_, p1_bound, ?_⟩ - · intro i - simp only [Real.norm_eq_abs, Pi.smul_apply, smul_eq_mul] - have hi := c1_nonneg i - positivity - · intro x - simp [norm_smul] - conv_rhs => enter [2, x]; rw [mul_assoc] - rw [← Finset.mul_sum] - refine mul_le_mul (by rfl) (bound1 x) ?_ ?_ - · exact norm_nonneg (f x) - · exact abs_nonneg c - -lemma IsDistBounded.pi_comp {dm1 n : ℕ} - {f : EuclideanSpace ℝ (Fin dm1.succ) → EuclideanSpace ℝ (Fin n)} - (hf : IsDistBounded f) (j : Fin n) : IsDistBounded (fun x => f x j) := by - rcases hf with ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩ - refine ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, ?_⟩ - intro x - apply le_trans ?_ (bound1 x) - simp only [Real.norm_eq_abs] - rw [@PiLp.norm_eq_of_L2] - refine Real.abs_le_sqrt ?_ - trans ∑ i ∈ {j}, ‖(f x) i‖ ^ 2 - · simp - apply Finset.sum_le_univ_sum_of_nonneg - intro y - exact sq_nonneg ‖f x y‖ - -lemma IsDistBounded.comp_add_right {dm1 : ℕ} {f : EuclideanSpace ℝ (Fin dm1.succ) → F} - (hf : IsDistBounded f) (c : EuclideanSpace ℝ (Fin dm1.succ)) : - IsDistBounded (fun x => f (x + c)) := by - rcases hf with ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩ - refine ⟨n1, c1, fun i => g1 i + c, p1, c1_nonneg, p1_bound, ?_⟩ - intro x - apply (bound1 (x + c)).trans - apply le_of_eq - simp only [Nat.succ_eq_add_one] - congr 1 - funext x - congr 3 - module - -@[fun_prop] -lemma IsDistBounded.const_mul_fun {dm1 : ℕ} - {f : EuclideanSpace ℝ (Fin dm1.succ) → ℝ} - (hf : IsDistBounded f) (c : ℝ) : IsDistBounded (fun x => c * f x) := by - convert hf.const_smul c using 1 - -lemma IsDistBounded.congr {dm1 : ℕ} {f : EuclideanSpace ℝ (Fin dm1.succ) → F} - {g : EuclideanSpace ℝ (Fin dm1.succ) → F'} - (hf : IsDistBounded f) (hfg : ∀ x, ‖g x‖ = ‖f x‖) : IsDistBounded g := by - rcases hf with ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩ - refine ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, ?_⟩ - intro x - rw [hfg x] - exact bound1 x - -lemma IsDistBounded.mono {dm1 : ℕ} {f : EuclideanSpace ℝ (Fin dm1.succ) → F} - {g : EuclideanSpace ℝ (Fin dm1.succ) → F'} - (hf : IsDistBounded f) (hfg : ∀ x, ‖g x‖ ≤ ‖f x‖) : IsDistBounded g := by - rcases hf with ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩ - refine ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, ?_⟩ - intro x - exact (hfg x).trans (bound1 x) - -open InnerProductSpace -@[fun_prop] -lemma IsDistBounded.inner_left {dm1 n : ℕ} - {f : EuclideanSpace ℝ (Fin dm1.succ) → EuclideanSpace ℝ (Fin n) } - (hf : IsDistBounded f) (y : EuclideanSpace ℝ (Fin n)) : - IsDistBounded (fun x => ⟪f x, y⟫_ℝ) := by - rcases hf with ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩ - refine ⟨n1, fun i => ‖y‖ * c1 i, g1, p1, ?_, p1_bound, ?_⟩ - · intro i - simp only - have hi := c1_nonneg i - positivity - · intro x - apply (norm_inner_le_norm (f x) y).trans - rw [mul_comm] - simp only [Nat.succ_eq_add_one] - conv_rhs => enter [2, i]; rw [mul_assoc] - rw [← Finset.mul_sum] - refine mul_le_mul (by rfl) (bound1 x) ?_ ?_ - · exact norm_nonneg (f x) - · exact norm_nonneg y - -/-! - -## Specific cases - --/ - -TODO "LSLHW" "The proof `IsDistBounded.pow` needs golfing." - -@[fun_prop] -lemma IsDistBounded.const {dm1 : ℕ} (f : F) : - IsDistBounded (dm1 := dm1) (fun _ : EuclideanSpace ℝ (Fin dm1.succ) => f) := by - use 1, fun _ => ‖f‖, fun _ => 0, fun _ => 0 - simp - -@[fun_prop] -lemma IsDistBounded.pow {dm1 : ℕ} (n : ℤ) (hn : - dm1 ≤ n) : - IsDistBounded (dm1 := dm1) (fun x => ‖x‖ ^ n) := by - refine ⟨1, fun _ => 1, fun _ => 0, fun _ => n, ?_, ?_, ?_⟩ - · simp - · simp - exact hn - · intro x - simp - -@[fun_prop] -lemma IsDistBounded.pow_shift {dm1 : ℕ} (n : ℤ) - (g : EuclideanSpace ℝ (Fin dm1.succ)) (hn : - dm1 ≤ n) : - IsDistBounded (dm1 := dm1) (fun x => ‖x - g‖ ^ n) := by - refine ⟨1, fun _ => 1, fun _ => (- g), fun _ => n, ?_, ?_, ?_⟩ - · simp - · simp - exact hn - · intro x - simp - rfl - -@[fun_prop] -lemma IsDistBounded.inv {n : ℕ} : - IsDistBounded (dm1 := n.succ) (fun x => ‖x‖⁻¹) := by - convert IsDistBounded.pow (dm1 := n.succ) (-1) (by simp) using 1 - ext1 x - simp - -/-! - -## Integrability - --/ - -lemma schwartzMap_mul_pow_integrable {dm1 : ℕ} (η : 𝓢(EuclideanSpace ℝ (Fin dm1.succ), ℝ)) - (p : ℤ) (hp : - (dm1 : ℤ) ≤ p) : - Integrable (fun x => ‖η x‖ * ‖x‖ ^ p) volume := by - by_cases hp : p = 0 - · subst hp - simp only [Nat.succ_eq_add_one, zpow_zero, mul_one] - apply Integrable.norm - exact η.integrable - suffices h1 : Integrable (fun x => ‖η x‖ * ‖x‖ ^ (p + dm1)) (invPowMeasure (dm1 := dm1)) by - rw [invPowMeasure] at h1 - erw [integrable_withDensity_iff_integrable_smul₀ (by fun_prop)] at h1 - convert h1 using 1 - funext x - simp only [Nat.succ_eq_add_one, Real.norm_eq_abs, one_div] - rw [Real.toNNReal_of_nonneg, NNReal.smul_def] - simp only [inv_nonneg, norm_nonneg, pow_nonneg, coe_mk, smul_eq_mul] - ring_nf - rw [mul_assoc] - congr - have hx : 0 ≤ ‖x‖ := norm_nonneg x - generalize ‖x‖ = r at * - by_cases hr : r = 0 - · subst hr - simp only [inv_zero] - rw [zero_pow_eq, zero_zpow_eq, zero_zpow_eq] - split_ifs <;> simp - any_goals omega - · simp only [inv_pow] - field_simp - rw [zpow_add₀ hr] - simp - · simp - convert integrable_pow_mul_iteratedFDeriv invPowMeasure η (p + dm1).toNat 0 using 1 - funext x - simp only [Nat.succ_eq_add_one, Real.norm_eq_abs, norm_iteratedFDeriv_zero] - rw [mul_comm] - congr 1 - rw [← zpow_natCast] - congr - refine Int.eq_natCast_toNat.mpr ?_ - omega - -lemma IsDistBounded.schwartzMap_mul_integrable_norm {dm1 : ℕ} - {η : 𝓢(EuclideanSpace ℝ (Fin dm1.succ), ℝ)} - {f : EuclideanSpace ℝ (Fin dm1.succ) → F} - (hf : IsDistBounded f) - (hae: AEStronglyMeasurable (fun x => f x) volume) : - Integrable (fun x => ‖η x‖ * ‖f x‖) volume := by - rcases hf with ⟨n, c, g, p, c_nonneg, p_bound, hbound⟩ - apply Integrable.mono' (g := fun x => ∑ i, ‖η x‖ * (c i * ‖x + g i‖ ^ p i)) _ - · fun_prop - · filter_upwards with x - rw [← Finset.mul_sum] - simp - exact mul_le_mul (by rfl) (hbound x) (norm_nonneg _) (abs_nonneg _) - · apply MeasureTheory.integrable_finset_sum - intro i _ - conv => - enter [1, x] - rw [← mul_assoc, mul_comm _ (c i), mul_assoc] - apply Integrable.const_mul - suffices h1 : Integrable (fun x => ‖η ((x + g i) - g i)‖ * ‖x + g i‖ ^ p i) volume by - convert h1 using 1 - simp - apply MeasureTheory.Integrable.comp_add_right (g := g i) - (f := fun x => ‖η (x - g i)‖ * ‖x‖ ^ p i) - let η' := SchwartzMap.compCLM (𝕜 := ℝ) - (g := fun x => x - g i) - (by - apply Function.HasTemperateGrowth.of_fderiv (k := 1) (C := 1 + ‖g i‖) - · have hx : (fderiv ℝ (fun x => x - g i)) = - fun _ => ContinuousLinearMap.id ℝ (EuclideanSpace ℝ (Fin (dm1 + 1))) := by - funext x - simp only [Nat.succ_eq_add_one] - erw [fderiv_sub] - simp only [fderiv_id', fderiv_fun_const, Pi.zero_apply, sub_zero] - fun_prop - fun_prop - rw [hx] - exact - Function.HasTemperateGrowth.const - (ContinuousLinearMap.id ℝ (EuclideanSpace ℝ (Fin (dm1 + 1)))) - · fun_prop - · intro x - simp only [Nat.succ_eq_add_one, pow_one] - trans ‖x‖ + ‖g i‖ - · apply norm_sub_le - simp [mul_add, add_mul] - trans 1 + (‖x‖ + ‖g i‖) - · simp - trans (1 + (‖x‖ + ‖g i‖)) + ‖x‖ * ‖g i‖ - · simp - positivity - ring_nf - rfl) (by - simp only [Nat.succ_eq_add_one] - use 1, (1 + ‖g i‖) - intro x - simp only [Nat.succ_eq_add_one, pow_one] - apply (norm_le_norm_add_norm_sub' x (g i)).trans - trans 1 + (‖g i‖ + ‖x - g i‖) - · simp - trans (1 + (‖g i‖ + ‖x - g i‖)) + ‖g i‖ * ‖x - g i‖ - · simp - positivity - ring_nf - rfl) η - exact schwartzMap_mul_pow_integrable η' (p i) (p_bound i) - -lemma IsDistBounded.schwartzMap_smul_integrable {dm1 : ℕ} - {η : 𝓢(EuclideanSpace ℝ (Fin dm1.succ), ℝ)} - {f : EuclideanSpace ℝ (Fin dm1.succ) → F} - (hf : IsDistBounded f) [NormedSpace ℝ F] - (hae: AEStronglyMeasurable (fun x => f x) volume) : - Integrable (fun x => η x • f x) volume := by - rw [← MeasureTheory.integrable_norm_iff] - convert hf.schwartzMap_mul_integrable_norm (η := η) hae using 1 - funext x - simp [norm_smul] - fun_prop - -@[fun_prop] -lemma IsDistBounded.schwartzMap_mul_integrable {dm1 : ℕ} (f : EuclideanSpace ℝ (Fin dm1.succ) → ℝ) - (hf : IsDistBounded f) - (hae: AEStronglyMeasurable (fun x => f x) volume) - (η : 𝓢(EuclideanSpace ℝ (Fin dm1.succ), ℝ)) : - Integrable (fun x : EuclideanSpace ℝ (Fin dm1.succ) => η x * f x) := by - convert hf.schwartzMap_smul_integrable (η := η) hae using 1 - -@[fun_prop] -lemma IsDistBounded.integrable_fderviv_schwartzMap_mul {dm1 : ℕ} - (f : EuclideanSpace ℝ (Fin dm1.succ) → ℝ) (hf : IsDistBounded f) - (hae: AEStronglyMeasurable (fun x => f x) volume) - (η : 𝓢(EuclideanSpace ℝ (Fin dm1.succ), ℝ)) (y : EuclideanSpace ℝ (Fin dm1.succ)) : - Integrable (fun x : EuclideanSpace ℝ (Fin dm1.succ) => fderiv ℝ η x y * f x) := by - exact hf.schwartzMap_smul_integrable hae - (η := ((SchwartzMap.evalCLM (𝕜 := ℝ) y) ((fderivCLM ℝ) η))) - -/-! - -## Integrability of 1/(1 + ‖x‖) --/ - -lemma intergrable_pow {dm1 : ℕ} (p: ℤ) (r : ℕ) (p_bound : -dm1 ≤ p) - (r_bound : (p + ↑dm1).toNat + (invPowMeasure (dm1 := dm1)).integrablePower ≤ r) - (v : EuclideanSpace ℝ (Fin dm1.succ)) : - Integrable (fun x => ‖x + v‖ ^ p * ‖((1 + ‖x‖) ^ r)⁻¹‖) volume := by - let m := (invPowMeasure (dm1 := dm1)).integrablePower - have h0 (q : ℕ) : Integrable (fun x => ‖x‖ ^ q * ‖((1 + ‖x - v‖) ^ (q + m))⁻¹‖) - invPowMeasure := by - have hr1 (x : EuclideanSpace ℝ (Fin dm1.succ)) : - ‖((1 + ‖x - v‖) ^ (q + m))⁻¹‖ = ((1 + ‖x - v‖) ^ (q + m))⁻¹ := by - simp only [Nat.succ_eq_add_one, norm_inv, norm_pow, Real.norm_eq_abs, inv_inj] - rw [abs_of_nonneg (by positivity)] - apply integrable_of_le_of_pow_mul_le (C₁ := 1) (C₂ :=2 ^ (q + m - 1) * (‖v‖ ^ (q + m) + 1)) - · simp - intro x - refine inv_le_one_of_one_le₀ ?_ - rw [abs_of_nonneg (by positivity)] - refine one_le_pow₀ ?_ - simp - · intro x - rw [hr1] - refine mul_inv_le_of_le_mul₀ ?_ (by positivity) ?_ - · positivity - change ‖x‖^ (q + m) ≤ _ - by_cases hzero : m = 0 ∧ q = 0 - · rcases hzero with ⟨hm, hq⟩ - generalize hm : m = m' at * - subst hm hq - rw [pow_zero, pow_zero] - simp - trans (‖v‖ + ‖x - v‖) ^ (q + m) - · rw [pow_le_pow_iff_left₀] - · apply norm_le_norm_add_norm_sub' - · positivity - · positivity - simp only [ne_eq, Nat.add_eq_zero, not_and] - intro hq - omega - apply (add_pow_le _ _ _).trans - trans 2 ^ (q + m - 1) * (‖v‖ ^ (q + m) + ‖x - v‖ ^ (q + m)) + (2 ^ (q + m - 1) - + 2 ^ (q + m - 1) * ‖v‖ ^ (q + m) * ‖x - v‖ ^ (q + m)) - · simp - positivity - trans (2 ^ (q + m - 1) * (‖v‖ ^ (q + m) + 1)) * (1 + ‖x - v‖ ^ (q + m)) - · ring_nf - apply le_of_eq - rfl - refine mul_le_mul_of_nonneg (by rfl) ?_ ?_ ?_ - · trans 1 ^ (q + m) + ‖x - v‖ ^ (q + m) - · simp - apply pow_add_pow_le - · simp - · positivity - · simp - omega - · positivity - · positivity - · positivity - · positivity - · refine Measurable.aestronglyMeasurable ?_ - fun_prop - have h0' (q : ℕ) : - Integrable (fun x => ‖x‖ ^ (q - dm1 : ℤ) * ‖((1 + ‖x - v‖) ^ (q + m))⁻¹‖) volume := by - specialize h0 q - rw [invPowMeasure] at h0 - rw [MeasureTheory.integrable_withDensity_iff] at h0 - apply Integrable.congr h0 - rw [Filter.eventuallyEq_iff_exists_mem] - use {0}ᶜ - constructor - · rw [compl_mem_ae_iff, measure_singleton] - intro x hx - simp only [Nat.succ_eq_add_one, norm_inv, norm_pow, Real.norm_eq_abs, one_div, inv_nonneg, - norm_nonneg, pow_nonneg, ENNReal.toReal_ofReal] - simp at hx - field_simp - have hx': ‖x‖ ≠ 0 := by simpa using hx - rw [zpow_sub₀ hx'] - simp only [Nat.succ_eq_add_one, zpow_natCast] - field_simp - ring_nf - · fun_prop - · filter_upwards with x - simp - have h2 (q : ℕ) : Integrable (fun x => ‖x + v‖ ^ (q - dm1 : ℤ) - * ‖((1 + ‖x‖) ^ (q + (invPowMeasure (dm1 := dm1)).integrablePower))⁻¹‖) volume := by - convert (h0' q).comp_add_right v using 1 - funext x - simp [m] - apply Integrable.mono' (h2 (p + dm1).toNat) - · fun_prop - rw [Filter.eventually_iff_exists_mem] - use {0}ᶜ - constructor - · rw [compl_mem_ae_iff, measure_singleton] - intro x hx - refine norm_mul_le_of_le ?_ ?_ - simp only [Nat.succ_eq_add_one, norm_zpow, norm_norm, Int.ofNat_toNat] - apply le_of_eq - congr - rw [max_eq_left] - simp only [add_sub_cancel_right] - omega - simp only [Nat.succ_eq_add_one, norm_inv, norm_pow, Real.norm_eq_abs, abs_abs] - refine inv_pow_le_inv_pow_of_le ?_ ?_ - · rw [abs_of_nonneg (by positivity)] - simp - · exact r_bound - -lemma IsDistBounded.norm_inv_mul_exists_pow_integrable {dm1 : ℕ} - (f : EuclideanSpace ℝ (Fin dm1.succ) → F) (hf : IsDistBounded f) - (hae: AEStronglyMeasurable (fun x => f x) volume) : - ∃ r, Integrable (fun x => ‖f x‖ * ‖((1 + ‖x‖) ^ r)⁻¹‖) volume := by - rcases hf with ⟨n, c, g, p, c_nonneg, p_bound, hbound⟩ - induction' n with n ih - · simp at hbound - conv => - enter [1, r, 1, x] - rw [hbound] - simp - let pMax := Finset.max' (Finset.image p Finset.univ) (by simp) - have pMax_max (i : Fin n.succ) : p i ≤ pMax := by - simp [pMax] - apply Finset.le_max' - simp - use (pMax + ↑dm1).toNat + (invPowMeasure (dm1 := dm1)).integrablePower - apply Integrable.mono' (g := fun x => ∑ i, c i * ‖x + g i‖ ^ p i - * ‖((1 + ‖x‖) ^ ((pMax + ↑dm1).toNat + (invPowMeasure (dm1 := dm1)).integrablePower))⁻¹‖) _ - · apply AEStronglyMeasurable.mul - · fun_prop - · refine Measurable.aestronglyMeasurable ?_ - fun_prop - · filter_upwards with x - simp [Nat.succ_eq_add_one, norm_inv, norm_pow, Real.norm_eq_abs, norm_mul, abs_abs] - rw [← Finset.sum_mul] - refine mul_le_mul_of_nonneg (hbound x) ?_ ?_ ?_ - · rfl - · exact norm_nonneg (f x) - · positivity - apply MeasureTheory.integrable_finset_sum - intro i _ - conv => - enter [1, x] - rw [mul_assoc] - apply Integrable.const_mul - apply intergrable_pow (p i) _ (p_bound i) - simp only [Nat.succ_eq_add_one, add_le_add_iff_right, Int.toNat_le, Int.ofNat_toNat, le_sup_iff] - left - exact pMax_max i - -open InnerProductSpace - -end Distribution diff --git a/PhysLean/Mathematics/Distribution/Function/OfFunction.lean b/PhysLean/Mathematics/Distribution/Function/OfFunction.lean deleted file mode 100644 index dbf3dd099..000000000 --- a/PhysLean/Mathematics/Distribution/Function/OfFunction.lean +++ /dev/null @@ -1,143 +0,0 @@ -/- -Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Tooby-Smith --/ -import PhysLean.Mathematics.Distribution.Function.IsDistBounded -/-! - -# Distributions from bounded functions - -In this module we define distributions from functions `f : EuclideanSpace ℝ (Fin d.succ) → F` -whose norm is bounded by `c1 * ‖x‖ ^ (-d : ℝ) + c2 * ‖x‖ ^ n` -for some constants `c1`, `c2` and `n`. - -This gives a convenient way to construct distributions from functions, without needing -to reference the underlying Schwartz maps. - -## Key definition - -- `ofFunction`: Creates a distribution from a `f` satisfying `IsDistBounded f`. - --/ -open SchwartzMap NNReal -noncomputable section - -variable (𝕜 : Type) {E F F' : Type} [RCLike 𝕜] [NormedAddCommGroup E] [NormedAddCommGroup F] - [NormedAddCommGroup F'] [NormedSpace ℝ E] [NormedSpace ℝ F] - -namespace Distribution - -open MeasureTheory - -/-- A distribution `(EuclideanSpace ℝ (Fin 3)) →d[ℝ] F` from a function - `f : EuclideanSpace ℝ (Fin 3) → F` bounded by `c1 * ‖x‖ ^ (-2 : ℝ) + c2 * ‖x‖ ^ n`. --/ -def ofFunction {dm1 : ℕ} (f : EuclideanSpace ℝ (Fin dm1.succ) → F) - (hf : IsDistBounded f) - (hae: AEStronglyMeasurable (fun x => f x) volume) : - (EuclideanSpace ℝ (Fin dm1.succ)) →d[ℝ] F := by - refine mkCLMtoNormedSpace (fun η => ∫ x, η x • f x) ?_ ?_ ?_ - · /- Addition -/ - intro η κ - simp only [add_apply] - conv_lhs => - enter [2, a] - rw [add_smul] - rw [integral_add] - · apply hf.schwartzMap_smul_integrable hae - · exact hf.schwartzMap_smul_integrable hae - · /- SMul-/ - intro a η - simp only [smul_apply, smul_eq_mul, RingHom.id_apply] - conv_lhs => - enter [2, a] - rw [← smul_smul] - rw [integral_smul] - /- boundedness -/ - obtain ⟨r, hr⟩ := hf.norm_inv_mul_exists_pow_integrable f hae - use Finset.Iic (r, 0), 2 ^ r * ∫ x, ‖f x‖ * ‖((1 + ‖x‖) ^ r)⁻¹‖ - refine ⟨by positivity, fun η ↦ (norm_integral_le_integral_norm _).trans ?_⟩ - rw [← integral_const_mul, ← integral_mul_const] - refine integral_mono_of_nonneg ?_ ?_ ?_ - · filter_upwards with x - positivity - · apply Integrable.mul_const - apply Integrable.const_mul - exact hr - · filter_upwards with x - simp [norm_smul] - trans (2 ^ r * - ((Finset.Iic (r, 0)).sup (schwartzSeminormFamily ℝ (EuclideanSpace ℝ (Fin (dm1 + 1))) ℝ)) η - *(|1 + ‖x‖| ^ r)⁻¹) * ‖f x‖; swap - · apply le_of_eq - ring - apply mul_le_mul_of_nonneg ?_ (by rfl) (by positivity) (by positivity) - have h0 := one_add_le_sup_seminorm_apply (𝕜 := ℝ) (m := (r, 0)) - (k := r) (n := 0) le_rfl le_rfl η x - rw [Lean.Grind.Field.IsOrdered.le_mul_inv_iff_mul_le _ _ (by positivity)] - convert h0 using 1 - simp only [Nat.succ_eq_add_one, norm_iteratedFDeriv_zero, Real.norm_eq_abs] - ring_nf - congr - rw [abs_of_nonneg (by positivity)] - -lemma ofFunction_apply {dm1 : ℕ} (f : EuclideanSpace ℝ (Fin dm1.succ) → F) - (hf : IsDistBounded f) - (hae: AEStronglyMeasurable (fun x => f x) volume) (η : 𝓢(EuclideanSpace ℝ (Fin dm1.succ), ℝ)) : - ofFunction f hf hae η = ∫ x, η x • f x := rfl - -@[simp] -lemma ofFunction_zero_eq_zero {dm1 : ℕ} : - ofFunction (fun _ : EuclideanSpace ℝ (Fin (dm1 + 1)) => (0 : F)) - ⟨0, 0, 0, 0, by simp⟩ (by fun_prop) = 0 := by - ext η - simp [ofFunction_apply] - -lemma ofFunction_smul {dm1 : ℕ} (f : EuclideanSpace ℝ (Fin dm1.succ) → F) - (hf : IsDistBounded f) - (hae: AEStronglyMeasurable (fun x => f x) volume) (c : ℝ) : - ofFunction (c • f) (by fun_prop) (by fun_prop) = c • ofFunction f hf hae := by - ext η - change _ = c • ∫ x, η x • f x - rw [ofFunction_apply] - simp only [Nat.succ_eq_add_one, Pi.smul_apply] - rw [← integral_smul] - congr - funext x - rw [smul_comm] - -lemma ofFunction_smul_fun {dm1 : ℕ} (f : EuclideanSpace ℝ (Fin dm1.succ) → F) - (hf : IsDistBounded f) - (hae: AEStronglyMeasurable (fun x => f x) volume) (c : ℝ) : - ofFunction (fun x => c • f x) (by - change IsDistBounded (c • f) - fun_prop) (by fun_prop) = c • ofFunction f hf hae := by - ext η - change _ = c • ∫ x, η x • f x - rw [ofFunction_apply] - simp only [Nat.succ_eq_add_one] - rw [← integral_smul] - congr - funext x - rw [smul_comm] - -open InnerProductSpace - -lemma ofFunction_inner {dm1 n : ℕ} (f : EuclideanSpace ℝ (Fin dm1.succ) → EuclideanSpace ℝ (Fin n)) - (hf : IsDistBounded f) - (hae: AEStronglyMeasurable (fun x => f x) volume) - (η : 𝓢(EuclideanSpace ℝ (Fin dm1.succ), ℝ)) (y : EuclideanSpace ℝ (Fin n)) : - ⟪ofFunction f hf hae η, y⟫_ℝ = ∫ x, η x * ⟪f x, y⟫_ℝ := by - rw [ofFunction_apply] - trans ∫ x, ⟪y, η x • f x⟫_ℝ; swap - · congr - funext x - rw [real_inner_comm] - simp [inner_smul_left] - rw [integral_inner, real_inner_comm] - exact IsDistBounded.schwartzMap_smul_integrable hf hae - -TODO "LV5RM" "Add a general lemma specifying the derivative of - functions from distributions." -end Distribution diff --git a/PhysLean/Mathematics/Distribution/PowMul.lean b/PhysLean/Mathematics/Distribution/PowMul.lean index 17409524d..25e74f8c3 100644 --- a/PhysLean/Mathematics/Distribution/PowMul.lean +++ b/PhysLean/Mathematics/Distribution/PowMul.lean @@ -50,8 +50,8 @@ private lemma norm_iteratedFDeriv_ofRealCLM {x} (i : ℕ) : | succ i ih => rw [iteratedFDeriv_succ_eq_comp_right] simp only [Nat.succ_eq_add_one, ContinuousLinearMap.fderiv, Function.comp_apply, - LinearIsometryEquiv.norm_map, Nat.add_eq_zero, one_ne_zero, and_false, and_self, ↓reduceIte, - Nat.add_eq_right] + LinearIsometryEquiv.norm_map, Nat.add_eq_zero_iff, one_ne_zero, and_false, and_self, + ↓reduceIte, Nat.add_eq_right] rw [iteratedFDeriv_succ_eq_comp_right] conv_lhs => enter [1, 2, 3, y] @@ -120,7 +120,7 @@ def powOneMul : 𝓢(ℝ, 𝕜) →L[𝕜] 𝓢(ℝ, 𝕜) := by ((SchwartzMap.seminorm 𝕜 (k + 1) 0) ψ) | .succ n => rw [Finset.sum_range_succ', Finset.sum_range_succ'] - simp only [Real.norm_eq_abs, Nat.succ_eq_add_one, Nat.add_eq_zero, one_ne_zero, and_false, + simp only [Real.norm_eq_abs, Nat.succ_eq_add_one, Nat.add_eq_zero_iff, one_ne_zero, and_false, and_self, ↓reduceIte, Nat.add_eq_right, mul_zero, zero_mul, Finset.sum_const_zero, zero_add, Nat.choose_one_right, Nat.cast_add, Nat.cast_one, mul_one, Nat.reduceAdd, Nat.add_one_sub_one, Nat.choose_zero_right, one_mul, Nat.sub_zero, ge_iff_le] diff --git a/PhysLean/Mathematics/FDerivCurry.lean b/PhysLean/Mathematics/FDerivCurry.lean index 12d1b94e5..bc2ed0359 100644 --- a/PhysLean/Mathematics/FDerivCurry.lean +++ b/PhysLean/Mathematics/FDerivCurry.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Zhi Kai Pong, Tomáš Skřivan, Joseph Tooby-Smith -/ import Mathlib.Analysis.Calculus.FDeriv.Symmetric -import PhysLean.Meta.TODO.Basic /-! # fderiv currying lemmas @@ -95,30 +94,6 @@ lemma fderiv_curry_clm_apply (f : X → Y →L[𝕜] Z) (y : Y) (x dx : X) (h : fderiv 𝕜 (f · y) x dx := by rw [fderiv_clm_apply] <;> first | simp | fun_prop -TODO "AZ2QN" "Replace following helper lemmas with fun_prop after - #24056 in Mathlib has gone through." - -/-- Helper lemmas showing differentiability from ContDiff 𝕜 2 ↿f. -/ -lemma ContDiff.two_differentiable (f : X → Y → Z) (hf : ContDiff 𝕜 2 ↿f) : - Differentiable 𝕜 (↿f) := - ContDiff.differentiable hf (by simp) - -lemma ContDiff.uncurry (f : X → Y → Z) (x : X) (hf : ContDiff 𝕜 2 ↿f) : - ContDiff 𝕜 2 (f x) := by - have h : f x = ↿f ∘ (x, ·) := by rfl - rw [h] - apply ContDiff.comp - · exact hf - · exact contDiff_prodMk_right x - -lemma ContDiff.two_fderiv_differentiable (f : X → Y → Z) (hf : ContDiff 𝕜 2 ↿f) : - Differentiable 𝕜 (fderiv 𝕜 (↿f)) := by - change ContDiff 𝕜 (1 + 1) ↿f at hf - rw [contDiff_succ_iff_fderiv] at hf - have hd2 := hf.2.2 - apply ContDiff.differentiable hd2 - rfl - /- Helper rw lemmas for proving differentiability conditions. -/ lemma fderiv_uncurry_comp_fst (f : X → Y → Z) (y : Y) (hf : Differentiable 𝕜 (↿f)) : fderiv 𝕜 (fun x' => (↿f) (x', y)) @@ -205,123 +180,47 @@ lemma function_differentiableAt_snd (f : X → Y → Z) (x : X) (y : Y) (hf : Di @[fun_prop] lemma fderiv_uncurry_differentiable_fst (f : X → Y → Z) (y : Y) (hf : ContDiff 𝕜 2 ↿f) : Differentiable 𝕜 (fderiv 𝕜 fun x' => (↿f) (x', y)) := by - conv_rhs => - ext x - rw [fderiv_uncurry_comp_fst (hf := hf.two_differentiable)] - apply Differentiable.clm_comp - · apply Differentiable.comp - · exact hf.two_fderiv_differentiable - · fun_prop - · conv_rhs => - enter [x] - rw [fderiv_inl_snd_clm] - fun_prop + fun_prop @[fun_prop] lemma fderiv_uncurry_differentiable_snd (f : X → Y → Z) (x : X) (hf : ContDiff 𝕜 2 ↿f) : Differentiable 𝕜 (fderiv 𝕜 fun y' => (↿f) (x, y')) := by - conv_rhs => - ext y - rw [fderiv_uncurry_comp_snd (hf := hf.two_differentiable)] - apply Differentiable.clm_comp - · apply Differentiable.comp - · exact hf.two_fderiv_differentiable - · fun_prop - · conv_rhs => - enter [y] - rw [fderiv_inr_fst_clm] - fun_prop + fun_prop @[fun_prop] lemma fderiv_uncurry_differentiable_fst_comp_snd (f : X → Y → Z) (x : X) (hf : ContDiff 𝕜 2 ↿f) : Differentiable 𝕜 (fun y' => fderiv 𝕜 (fun x' => (↿f) (x', y')) x) := by - conv_rhs => - enter [y'] - rw [fderiv_uncurry_comp_fst (hf := hf.two_differentiable)] - apply Differentiable.clm_comp - · apply Differentiable.comp - · exact hf.two_fderiv_differentiable - · fun_prop - · conv_rhs => - enter [y] - rw [fderiv_inl_snd_clm] - fun_prop + fun_prop +@[fun_prop] lemma fderiv_uncurry_differentiable_fst_comp_snd_apply (f : X → Y → Z) (x δx : X) (hf : ContDiff 𝕜 2 ↿f) : Differentiable 𝕜 (fun y' => fderiv 𝕜 (fun x' => (↿f) (x', y')) x δx) := by - have h1 : (fun y' => fderiv 𝕜 (fun x' => (↿f) (x', y')) x δx) - = (fun f => f δx) ∘ (fun y' => fderiv 𝕜 (fun x' => (↿f) (x', y')) x) := by - funext y' - simp - rw [h1] - apply Differentiable.comp - · fun_prop - · apply fderiv_uncurry_differentiable_fst_comp_snd - exact hf + fun_prop @[fun_prop] lemma fderiv_uncurry_differentiable_snd_comp_fst (f : X → Y → Z) (y : Y) (hf : ContDiff 𝕜 2 ↿f) : Differentiable 𝕜 (fun x' => fderiv 𝕜 (fun y' => (↿f) (x', y')) y) := by - conv_rhs => - enter [x'] - rw [fderiv_uncurry_comp_snd (hf := hf.two_differentiable)] - apply Differentiable.clm_comp - · apply Differentiable.comp - · exact hf.two_fderiv_differentiable - · fun_prop - · conv_rhs => - enter [x] - rw [fderiv_inr_fst_clm] - fun_prop + fun_prop +@[fun_prop] lemma fderiv_uncurry_differentiable_snd_comp_fst_apply (f : X → Y → Z) (y δy : Y) (hf : ContDiff 𝕜 2 ↿f) : Differentiable 𝕜 (fun x' => fderiv 𝕜 (fun y' => (↿f) (x', y')) y δy) := by - have h1 : (fun x' => fderiv 𝕜 (fun y' => (↿f) (x', y')) y δy) - = (fun f => f δy) ∘ (fun x' => fderiv 𝕜 (fun y' => (↿f) (x', y')) y) := by - funext y' - simp - rw [h1] - apply Differentiable.comp - · fun_prop - · apply fderiv_uncurry_differentiable_snd_comp_fst - exact hf + fun_prop @[fun_prop] lemma fderiv_curry_differentiableAt_fst_comp_snd (f : X → Y → Z) (x dx : X) (y : Y) (hf : ContDiff 𝕜 2 ↿f) : DifferentiableAt 𝕜 (fun y' => (fderiv 𝕜 (fun x' => f x' y') x) dx) y := by - conv_lhs => - enter [x'] - rw [fderiv_curry_comp_fst (hf := hf.two_differentiable)] - refine DifferentiableAt.clm_apply ?_ ?_ - · simp - refine DifferentiableAt.comp y ?_ ?_ - · apply Differentiable.differentiableAt - exact hf.two_fderiv_differentiable - · fun_prop - · conv_lhs => - enter [x'] - rw [fderiv_inl_snd_clm] - fun_prop + apply Differentiable.differentiableAt + fun_prop lemma fderiv_curry_differentiableAt_snd_comp_fst (f : X → Y → Z) (x : X) (y dy : Y) (hf : ContDiff 𝕜 2 ↿f) : DifferentiableAt 𝕜 (fun x' => (fderiv 𝕜 (fun y' => f x' y') y) dy) x := by - conv_lhs => - enter [x'] - rw [fderiv_curry_comp_snd (hf := hf.two_differentiable)] - refine DifferentiableAt.clm_apply ?_ ?_ - · simp - refine DifferentiableAt.comp x ?_ ?_ - · apply Differentiable.differentiableAt - exact hf.two_fderiv_differentiable - · fun_prop - · conv_lhs => - enter [x'] - rw [fderiv_inr_fst_clm] - fun_prop + apply Differentiable.differentiableAt + fun_prop /- fderiv commutes on X × Y. -/ lemma fderiv_swap [IsRCLikeNormedField 𝕜] (f : X → Y → Z) (x dx : X) (y dy : Y) @@ -344,23 +243,7 @@ lemma fderiv_swap [IsRCLikeNormedField 𝕜] (f : X → Y → Z) (x dx : X) (y d zero_add, add_zero] at h exact h /- Start of differentiability conditions. -/ - · refine Differentiable.add ?_ ?_ - · refine Differentiable.clm_comp ?_ ?_ - · apply fderiv_uncurry_differentiable_fst_comp_snd - exact hf - · fun_prop - · refine Differentiable.clm_comp ?_ ?_ - · apply fderiv_uncurry_differentiable_snd - exact hf - · fun_prop - · refine Differentiable.add ?_ ?_ - · refine Differentiable.clm_comp ?_ ?_ - · apply fderiv_uncurry_differentiable_fst - exact hf - · fun_prop - · refine Differentiable.clm_comp ?_ ?_ - · apply fderiv_uncurry_differentiable_snd_comp_fst - exact hf - · fun_prop - · exact hf.two_differentiable - · exact hf.two_fderiv_differentiable + · fun_prop + · fun_prop + · exact hf.differentiable (by simp) + · fun_prop diff --git a/PhysLean/Mathematics/Fin.lean b/PhysLean/Mathematics/Fin.lean index e8a22175e..045506a32 100644 --- a/PhysLean/Mathematics/Fin.lean +++ b/PhysLean/Mathematics/Fin.lean @@ -42,7 +42,7 @@ lemma predAboveI_succAbove (i : Fin n.succ.succ) (x : Fin n.succ) : split_ifs · rfl · rename_i h1 h2 - simp only [Fin.lt_def, Fin.coe_castSucc, not_lt, Fin.val_succ] at h1 h2 + simp only [Fin.lt_def, Fin.val_castSucc, not_lt, Fin.val_succ] at h1 h2 omega · rfl lemma succsAbove_predAboveI {i x : Fin n.succ.succ} (h : i ≠ x) : @@ -95,7 +95,7 @@ lemma succAbove_succAbove_predAboveI (i : Fin n.succ.succ) (j : Fin n.succ) (x : · rw [Fin.succAbove_of_castSucc_lt] exact hx1 · rw [Fin.lt_def] at h1 hx1 ⊢ - simp_all only [Nat.succ_eq_add_one, Fin.coe_castSucc] + simp_all only [Nat.succ_eq_add_one, Fin.val_castSucc] omega · exact Nat.lt_trans hx1 h1 · simp only [not_lt] at hx1 @@ -109,7 +109,7 @@ lemma succAbove_succAbove_predAboveI (i : Fin n.succ.succ) (j : Fin n.succ) (x : · rfl · assumption · rw [Fin.lt_def] at hx2 ⊢ - simp_all only [Nat.succ_eq_add_one, Fin.coe_castSucc, Fin.val_succ] + simp_all only [Nat.succ_eq_add_one, Fin.val_castSucc, Fin.val_succ] omega · simp only [not_lt] at hx2 rw [Fin.succAbove_of_le_castSucc _ _ hx2] @@ -127,12 +127,12 @@ lemma succAbove_succAbove_predAboveI (i : Fin n.succ.succ) (j : Fin n.succ) (x : · nth_rewrite 2 [Fin.succAbove_of_le_castSucc _ _] · rw [Fin.succAbove_of_le_castSucc] rw [Fin.le_def] at hx1 ⊢ - simp_all only [Nat.succ_eq_add_one, Fin.coe_castSucc, Fin.val_succ, add_le_add_iff_right] + simp_all only [Nat.succ_eq_add_one, Fin.val_castSucc, Fin.val_succ, add_le_add_iff_right] · rw [Fin.le_def] at h1 hx1 ⊢ - simp_all only [Nat.succ_eq_add_one, Fin.coe_castSucc] + simp_all only [Nat.succ_eq_add_one, Fin.val_castSucc] omega · rw [Fin.le_def] at hx1 h1 ⊢ - simp_all only [Nat.succ_eq_add_one, Fin.coe_castSucc, Fin.val_succ] + simp_all only [Nat.succ_eq_add_one, Fin.val_castSucc, Fin.val_succ] omega · simp only [Nat.succ_eq_add_one, not_le] at hx1 rw [Fin.lt_def] at hx1 @@ -143,7 +143,7 @@ lemma succAbove_succAbove_predAboveI (i : Fin n.succ.succ) (j : Fin n.succ) (x : nth_rewrite 2 [Fin.succAbove_of_castSucc_lt] · rw [Fin.succAbove_of_castSucc_lt] rw [Fin.lt_def] at hx2 ⊢ - simp_all only [Nat.succ_eq_add_one, Fin.coe_castSucc, Fin.val_succ] + simp_all only [Nat.succ_eq_add_one, Fin.val_castSucc, Fin.val_succ] omega · rw [Fin.lt_def] at hx2 ⊢ simp_all @@ -183,7 +183,7 @@ lemma finExtractOne_symm_inr {n : ℕ} (i : Fin n.succ) : ext x simp only [Nat.succ_eq_add_one, finExtractOne, Function.comp_apply, Equiv.symm_trans_apply, finCongr_symm, Equiv.symm_symm, Equiv.sumCongr_symm, Equiv.refl_symm, Equiv.sumCongr_apply, - Equiv.coe_refl, Sum.map_inr, finCongr_apply, Fin.coe_cast] + Equiv.coe_refl, Sum.map_inr, finCongr_apply, Fin.val_cast] change (finSumFinEquiv (Sum.map (⇑(finSumFinEquiv.symm.trans (Equiv.sumComm (Fin ↑i) (Fin 1))).symm) id ((Equiv.sumAssoc (Fin 1) (Fin ↑i) (Fin (n - i))).symm @@ -202,7 +202,7 @@ lemma finExtractOne_symm_inr {n : ℕ} (i : Fin n.succ) : split · rfl rename_i hn - simp_all only [Nat.succ_eq_add_one, not_lt, Fin.le_def, Fin.coe_castSucc, Fin.val_succ, + simp_all only [Nat.succ_eq_add_one, not_lt, Fin.le_def, Fin.val_castSucc, Fin.val_succ, left_eq_add, one_ne_zero] omega · generalize_proofs hp @@ -211,7 +211,7 @@ lemma finExtractOne_symm_inr {n : ℕ} (i : Fin n.succ) : rw [← finSumFinEquiv_symm_apply_natAdd] apply congrArg ext - simp only [Nat.succ_eq_add_one, Fin.coe_cast, Fin.natAdd_mk] + simp only [Nat.succ_eq_add_one, Fin.val_cast, Fin.natAdd_mk] omega rw [h1, Fin.succAbove] split diff --git a/PhysLean/Mathematics/Fin/Involutions.lean b/PhysLean/Mathematics/Fin/Involutions.lean index 9664b20fa..905e6a9db 100644 --- a/PhysLean/Mathematics/Fin/Involutions.lean +++ b/PhysLean/Mathematics/Fin/Involutions.lean @@ -103,7 +103,7 @@ def involutionCons (n : ℕ) : {f : Fin n.succ → Fin n.succ // Function.Involu · rw [← h0] at hj have hn := Function.Involutive.injective hf hj exact False.elim (Fin.succ_ne_zero j hn) - · simp only [hj, ↓reduceDIte, Fin.coe_pred] + · simp only [hj, ↓reduceDIte, Fin.val_pred] rw [Fin.ext_iff] at hj simp only [succ_eq_add_one, Fin.val_zero] at hj omega @@ -123,7 +123,7 @@ def involutionCons (n : ℕ) : {f : Fin n.succ → Fin n.succ // Function.Involu · rw [← hj] at hf' rw [hf] at hf' simp only [not_true_eq_false] at hf' - · simp only [hj, ↓reduceDIte, Fin.coe_pred] + · simp only [hj, ↓reduceDIte, Fin.val_pred] rw [Fin.ext_iff] at hj simp only [succ_eq_add_one, Fin.val_zero] at hj omega @@ -448,7 +448,7 @@ def involutionNoFixedSetOne {n : ℕ} : right_inv f := by simp only [ne_eq, succ_eq_add_one, Function.comp_apply] ext i - simp only [Fin.coe_pred] + simp only [Fin.val_pred] split · rename_i h simp [Fin.ext_iff] at h diff --git a/PhysLean/Mathematics/Geometry/Metric/PseudoRiemannian/Defs.lean b/PhysLean/Mathematics/Geometry/Metric/PseudoRiemannian/Defs.lean index 8f36ce5f3..c5a120a0d 100644 --- a/PhysLean/Mathematics/Geometry/Metric/PseudoRiemannian/Defs.lean +++ b/PhysLean/Mathematics/Geometry/Metric/PseudoRiemannian/Defs.lean @@ -309,7 +309,14 @@ lemma toBilinForm_isSymm (g : PseudoRiemannianMetric E H M n I) (x : M) : @[simp] lemma toBilinForm_nondegenerate (g : PseudoRiemannianMetric E H M n I) (x : M) : (toBilinForm g x).Nondegenerate := by - intro v hv; simp_rw [toBilinForm_apply] at hv; exact g.nondegenerate x v hv + unfold LinearMap.BilinForm.Nondegenerate LinearMap.Nondegenerate + LinearMap.SeparatingLeft LinearMap.SeparatingRight + constructor + · intro v hv; simp_rw [toBilinForm_apply] at hv; exact g.nondegenerate x v hv + · intro v hv; simp_rw [toBilinForm_apply] at hv; + have hw : ∀ (w : TangentSpace I x), ((g.val x) v) w = 0 := by + intro w; rw [symm]; simp [hv] + exact g.nondegenerate x v hw /-- The inner product (or scalar product) on the tangent space at point `x` induced by the pseudo-Riemannian metric `g`. This is `gₓ(v, w)`. -/ @@ -608,10 +615,19 @@ lemma cotangentMetricVal_nondegenerate (g : PseudoRiemannianMetric E H M n I) (x @[simp] lemma cotangentToBilinForm_nondegenerate (g : PseudoRiemannianMetric E H M n I) (x : M) : (cotangentToBilinForm g x).Nondegenerate := by - intro ω hω - apply cotangentMetricVal_nondegenerate g x ω - intro v - exact hω v + unfold LinearMap.BilinForm.Nondegenerate LinearMap.Nondegenerate + LinearMap.SeparatingLeft LinearMap.SeparatingRight + constructor + · intro ω hω + apply cotangentMetricVal_nondegenerate g x ω + intro v + exact hω v + · intro ω hω + apply cotangentMetricVal_nondegenerate g x ω + intro v + have hv : ∀ (y : TangentSpace I x →L[ℝ] ℝ), ((g.cotangentToBilinForm x) ω) y = 0 := by + intro y; rw [LinearMap.BilinForm.isSymm_def.mp (cotangentToBilinForm_isSymm g x)]; simp [hω] + exact hv v end Cotangent diff --git a/PhysLean/Mathematics/Geometry/Metric/Riemannian/Defs.lean b/PhysLean/Mathematics/Geometry/Metric/Riemannian/Defs.lean index a9f51068f..3caa55842 100644 --- a/PhysLean/Mathematics/Geometry/Metric/Riemannian/Defs.lean +++ b/PhysLean/Mathematics/Geometry/Metric/Riemannian/Defs.lean @@ -142,7 +142,7 @@ noncomputable def TangentSpace.metricNormedAddCommGroup (g : RiemannianMetric I noncomputable def TangentSpace.metricInnerProductSpace' (g : RiemannianMetric I n M) (x : M) : letI := TangentSpace.metricNormedAddCommGroup g x InnerProductSpace ℝ (TangentSpace I x) := - InnerProductSpace.ofCore (tangentInnerCore g x) + InnerProductSpace.ofCore (tangentInnerCore g x).toCore /-- Creates an `InnerProductSpace` structure on `TₓM` from a Riemannian metric `g`. -/ noncomputable def TangentSpace.metricInnerProductSpace (g : RiemannianMetric I n M) (x : M) : @@ -150,7 +150,7 @@ noncomputable def TangentSpace.metricInnerProductSpace (g : RiemannianMetric I n InnerProductSpace ℝ (TangentSpace I x) := let inner_core := tangentInnerCore g x let _ := TangentSpace.metricNormedAddCommGroup g x - InnerProductSpace.ofCore inner_core + InnerProductSpace.ofCore inner_core.toCore /-- The norm on a tangent space induced by a Riemannian metric, defined as the square root of the inner product of a vector with itself. -/ diff --git a/PhysLean/Mathematics/InnerProductSpace/Basic.lean b/PhysLean/Mathematics/InnerProductSpace/Basic.lean index f88457335..bef7b3863 100644 --- a/PhysLean/Mathematics/InnerProductSpace/Basic.lean +++ b/PhysLean/Mathematics/InnerProductSpace/Basic.lean @@ -4,8 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Tomas Skrivan -/ import Mathlib.Analysis.InnerProductSpace.Calculus +import Mathlib.Analysis.InnerProductSpace.Completion import Mathlib.Analysis.InnerProductSpace.ProdL2 -import Mathlib.Analysis.NormedSpace.HahnBanach.SeparatingDual +import Mathlib.Data.Real.CompleteField +import Mathlib.Data.Real.StarOrdered /-! # Inner product space @@ -92,7 +94,7 @@ instance {𝕜 : Type*} {E : Type*} [RCLike 𝕜] [NormedAddCommGroup E] [inst : norm₂_sq_eq_re_inner := norm_sq_eq_re_inner inner_top_equiv_norm := by use 1; use 1 - simp[← norm_sq_eq_re_inner] + simp end BasicInstances @@ -109,6 +111,11 @@ local notation "⟪" x ", " y "⟫" => inner 𝕜 x y local postfix:90 "†" => starRingEnd _ namespace InnerProductSpace' +/-! + +## B. Deriving the inner product structure on `WithLp 2 E` from `InnerProductSpace' 𝕜 E` + +-/ /-- Attach L₂ norm to `WithLp 2 E` -/ noncomputable @@ -125,10 +132,14 @@ noncomputable scoped instance toNormedAddCommGroupWitL2 : NormedAddCommGroup (WithLp 2 E) := let core : InnerProductSpace.Core (𝕜:=𝕜) (F:=E) := by infer_instance { - dist_self := core.toNormedAddCommGroup.dist_self - dist_comm := core.toNormedAddCommGroup.dist_comm - dist_triangle := core.toNormedAddCommGroup.dist_triangle - eq_of_dist_eq_zero := fun {x y} => core.toNormedAddCommGroup.eq_of_dist_eq_zero (x:=x) (y:=y) + dist_self x := core.toNormedAddCommGroup.dist_self (WithLp.equiv 2 E x) + dist_comm x y := core.toNormedAddCommGroup.dist_comm (WithLp.equiv 2 E x) (WithLp.equiv 2 E y) + dist_triangle x y z := core.toNormedAddCommGroup.dist_triangle (WithLp.equiv 2 E x) + (WithLp.equiv 2 E y) (WithLp.ofLp z) + eq_of_dist_eq_zero {x y} := by + intro h + simpa [-WithLp.equiv_apply] using core.toNormedAddCommGroup.eq_of_dist_eq_zero + (x:= WithLp.equiv 2 E x) (y:= WithLp.equiv 2 E y) h } lemma norm_withLp2_eq_norm2 (x : WithLp 2 E) : @@ -144,15 +155,16 @@ noncomputable scoped instance toNormedSpaceWithL2 : NormedSpace 𝕜 (WithLp 2 E) where norm_smul_le := by let core : PreInnerProductSpace.Core (𝕜:=𝕜) (F:=E) := by infer_instance + intro a x apply (InnerProductSpace.Core.toNormedSpace (c := core)).norm_smul_le /-- Attach inner product space structure to `WithLp 2 E`. -/ noncomputable instance toInnerProductSpaceWithL2 : InnerProductSpace 𝕜 (WithLp 2 E) where norm_sq_eq_re_inner := by intros; simp [norm, Real.sq_sqrt,hE.core.re_inner_nonneg]; rfl - conj_inner_symm := hE.core.conj_inner_symm - add_left := hE.core.add_left - smul_left := hE.core.smul_left + conj_inner_symm x y := hE.core.conj_inner_symm (WithLp.equiv 2 E x) (WithLp.equiv 2 E y) + add_left x y z := hE.core.add_left _ _ _ + smul_left x y := hE.core.smul_left _ _ variable (𝕜) in /-- Continuous linear map from `E` to `WithLp 2 E`. @@ -196,14 +208,23 @@ def fromL2 : WithLp 2 E →L[𝕜] E where constructor · apply inv_pos.2 hc · intro x - have h := Real.sqrt_le_sqrt (h x).1 + have h := Real.sqrt_le_sqrt (h ((WithLp.equiv 2 E) x)).1 simp [smul_eq_mul] at h apply (le_inv_mul_iff₀' hc).2 - exact h + convert h using 1 + simp only [WithLp.equiv_apply] + ring lemma fromL2_inner_left (x : WithLp 2 E) (y : E) : ⟪fromL2 𝕜 x, y⟫ = ⟪x, toL2 𝕜 y⟫ := rfl + +lemma ofLp_inner_left (x : E) (y : WithLp 2 E) : ⟪WithLp.ofLp y, x⟫ = ⟪y, WithLp.toLp 2 x⟫ := by + exact fromL2_inner_left y x + lemma toL2_inner_left (x : E) (y : WithLp 2 E) : ⟪toL2 𝕜 x, y⟫ = ⟪x, fromL2 𝕜 y⟫ := rfl +lemma toLp_inner_left (x : WithLp 2 E) (y : E) : ⟪WithLp.toLp 2 y, x⟫ = ⟪y, WithLp.ofLp x⟫ := by + exact toL2_inner_left y x + @[simp] lemma toL2_fromL2 (x : WithLp 2 E) : toL2 𝕜 (fromL2 𝕜 x) = x := rfl @[simp] @@ -234,59 +255,75 @@ open InnerProductSpace' variable (𝕜) in +/-! + +## C. Basic properties of the inner product + +-/ + lemma ext_inner_left' {x y : E} (h : ∀ v, ⟪v, x⟫ = ⟪v, y⟫) : x = y := - ext_inner_left (E:=WithLp 2 E) 𝕜 h + (WithLp.equiv 2 E).symm.injective <| ext_inner_left (E := WithLp 2 E) 𝕜 <| by + simpa [← ofLp_inner_left] using fun v => h (WithLp.ofLp v) variable (𝕜) in lemma ext_inner_right' {x y : E} (h : ∀ v, ⟪x, v⟫ = ⟪y, v⟫) : x = y := - ext_inner_right (E:=WithLp 2 E) 𝕜 h + (WithLp.equiv 2 E).symm.injective <| ext_inner_right (E := WithLp 2 E) 𝕜 <| by + simpa [← ofLp_inner_left] using fun v => h (WithLp.ofLp v) @[simp] lemma inner_conj_symm' (x y : E) : ⟪y, x⟫† = ⟪x, y⟫ := - inner_conj_symm (E:=WithLp 2 E) x y + inner_conj_symm (E:=WithLp 2 E) _ _ lemma inner_smul_left' (x y : E) (r : 𝕜) : ⟪r • x, y⟫ = r† * ⟪x, y⟫ := - inner_smul_left (E:=WithLp 2 E) x y r + inner_smul_left (E:=WithLp 2 E) _ _ r lemma inner_smul_right' (x y : E) (r : 𝕜) : ⟪x, r • y⟫ = r * ⟪x, y⟫ := - inner_smul_right (E:=WithLp 2 E) x y r + inner_smul_right (E:=WithLp 2 E) _ _ r @[simp] lemma inner_zero_left' (x : E) : ⟪0, x⟫ = 0 := - inner_zero_left (E:=WithLp 2 E) x + inner_zero_left (E:=WithLp 2 E) _ @[simp] lemma inner_zero_right' (x : E) : ⟪x, 0⟫ = 0 := - inner_zero_right (E:=WithLp 2 E) x + inner_zero_right (E:=WithLp 2 E) _ lemma inner_add_left' (x y z : E) : ⟪x + y, z⟫ = ⟪x, z⟫ + ⟪y, z⟫ := - inner_add_left (E:=WithLp 2 E) x y z + inner_add_left (E:=WithLp 2 E) _ _ _ lemma inner_add_right' (x y z : E) : ⟪x, y + z⟫ = ⟪x, y⟫ + ⟪x, z⟫ := - inner_add_right (E:=WithLp 2 E) x y z + inner_add_right (E:=WithLp 2 E) _ _ _ lemma inner_sub_left' (x y z : E) : ⟪x - y, z⟫ = ⟪x, z⟫ - ⟪y, z⟫ := - inner_sub_left (E:=WithLp 2 E) x y z + inner_sub_left (E:=WithLp 2 E) _ _ _ lemma inner_sub_right' (x y z : E) : ⟪x, y - z⟫ = ⟪x, y⟫ - ⟪x, z⟫ := - inner_sub_right (E:=WithLp 2 E) x y z + inner_sub_right (E:=WithLp 2 E) _ _ _ @[simp] lemma inner_neg_left' (x y : E) : ⟪-x, y⟫ = -⟪x, y⟫ := - inner_neg_left (E:=WithLp 2 E) x y + inner_neg_left (E:=WithLp 2 E) _ _ @[simp] lemma inner_neg_right' (x y : E) : ⟪x, -y⟫ = -⟪x, y⟫ := - inner_neg_right (E:=WithLp 2 E) x y + inner_neg_right (E:=WithLp 2 E) _ _ @[simp] -lemma inner_self_eq_zero' {x : E} : ⟪x, x⟫ = 0 ↔ x = 0 := - inner_self_eq_zero (E:=WithLp 2 E) +lemma inner_self_eq_zero' {x : E} : ⟪x, x⟫ = 0 ↔ x = 0 := by + erw [inner_self_eq_zero (E:=WithLp 2 E)] + simp @[simp] lemma inner_sum'{ι : Type*} [Fintype ι] (x : E) (g : ι → E) : ⟪x, ∑ i, g i⟫ = ∑ i, ⟪x, g i⟫ := by - rw [inner_sum (E:=WithLp 2 E)] + have h1 := inner_sum (𝕜 := 𝕜) (E:=WithLp 2 E) (x := WithLp.toLp 2 x) + (f := fun i => WithLp.toLp 2 (g i)) + convert h1 (Finset.univ) + rw [← ofLp_inner_left] + simp only + congr + change _ = (WithLp.linearEquiv 2 𝕜 E) _ + simp @[fun_prop] lemma Continuous.inner' {α} [TopologicalSpace α] (f g : α → E) @@ -307,7 +344,7 @@ lemma real_inner_self_nonneg' {x : F} : 0 ≤ re (⟪x, x⟫) := real_inner_self_nonneg (F:=WithLp 2 F) lemma real_inner_comm' (x y : F) : ⟪y, x⟫ = ⟪x, y⟫ := - real_inner_comm (F:=WithLp 2 F) x y + real_inner_comm (F:=WithLp 2 F) _ _ @[fun_prop] lemma ContDiffAt.inner' {f g : E → F} {x : E} @@ -350,20 +387,36 @@ lemma prod_inner_apply' (x y : (E × F)) : ⟪x, y⟫ = ⟪x.fst, y.fst⟫ + ⟪ open InnerProductSpace' in noncomputable -instance : InnerProductSpace' 𝕜 (E×F) where - norm₂ := (WithLp.instProdNormedAddCommGroup 2 (WithLp 2 E) (WithLp 2 F)).toNorm.norm +instance : InnerProductSpace' 𝕜 (E × F) where + norm₂ x := (WithLp.instProdNormedAddCommGroup 2 (WithLp 2 E) (WithLp 2 F)).toNorm.norm + (WithLp.toLp 2 (WithLp.toLp 2 x.1, WithLp.toLp 2 x.2)) core := let _ := WithLp.instProdNormedAddCommGroup 2 (WithLp 2 E) (WithLp 2 F) let inst := (WithLp.instProdInnerProductSpace (𝕜:=𝕜) (E := WithLp 2 E) (F := WithLp 2 F)).toCore - inst + { + inner x y := inst.inner (WithLp.toLp 2 (WithLp.toLp 2 x.1, WithLp.toLp 2 x.2)) + (WithLp.toLp 2 (WithLp.toLp 2 y.1, WithLp.toLp 2 y.2)) + conj_inner_symm x y := inst.conj_inner_symm _ _ + re_inner_nonneg x := inst.re_inner_nonneg _ + add_left x y z := inst.add_left (WithLp.toLp 2 (WithLp.toLp 2 x.1, WithLp.toLp 2 x.2)) + (WithLp.toLp 2 (WithLp.toLp 2 y.1, WithLp.toLp 2 y.2)) + (WithLp.toLp 2 (WithLp.toLp 2 z.1, WithLp.toLp 2 z.2)) + smul_left x y r := inst.smul_left (WithLp.toLp 2 (WithLp.toLp 2 x.1, WithLp.toLp 2 x.2)) + (WithLp.toLp 2 (WithLp.toLp 2 y.1, WithLp.toLp 2 y.2)) r + definite x := by + intro h + have h1 := inst.definite (WithLp.toLp 2 (WithLp.toLp 2 x.1, WithLp.toLp 2 x.2)) h + simp at h1 + exact Prod.ext_iff.mpr h1 + } + norm₂_sq_eq_re_inner := by intro (x,y) - have hx : re ⟪(WithLp.equiv 2 E) x, (WithLp.equiv 2 E) x⟫ = re ⟪x,x⟫ := rfl - have hy : re ⟪(WithLp.equiv 2 F) y, (WithLp.equiv 2 F) y⟫ = re ⟪y,y⟫ := rfl have : 0 ≤ re ⟪x,x⟫ := PreInnerProductSpace.Core.re_inner_nonneg (𝕜:=𝕜) (F:=E) _ x have : 0 ≤ re ⟪y,y⟫ := PreInnerProductSpace.Core.re_inner_nonneg (𝕜:=𝕜) (F:=F) _ y - simp only [norm, OfNat.ofNat_ne_zero, ↓reduceDIte, ENNReal.ofNat_ne_top, ↓reduceIte, hx, - ENNReal.toReal_ofNat, Real.rpow_two, hy, one_div, prod_inner_apply', map_add] + simp only [norm, OfNat.ofNat_ne_zero, ↓reduceDIte, ENNReal.ofNat_ne_top, ↓reduceIte, + WithLp.toLp_fst, WithLp.equiv_apply, ENNReal.toReal_ofNat, Real.rpow_ofNat, WithLp.toLp_snd, + one_div, WithLp.prod_inner_apply, prod_inner_apply', map_add] repeat rw [Real.sq_sqrt (by assumption)] norm_num rw[← Real.rpow_mul_natCast (by linarith)] @@ -406,31 +459,45 @@ instance : InnerProductSpace' 𝕜 (E×F) where open InnerProductSpace' in noncomputable instance {ι : Type*} [Fintype ι] : InnerProductSpace' 𝕜 (ι → E) where - norm₂ := (PiLp.seminormedAddCommGroup 2 (fun _ : ι => (WithLp 2 E))).toNorm.norm + norm₂ x := (PiLp.seminormedAddCommGroup 2 (fun _ : ι => (WithLp 2 E))).toNorm.norm + (WithLp.toLp 2 (fun i => WithLp.toLp 2 (x i))) core := let _ := PiLp.normedAddCommGroup 2 (fun _ : ι => (WithLp 2 E)) let inst := (PiLp.innerProductSpace (𝕜:=𝕜) (fun _ : ι => (WithLp 2 E))) - inst.toCore + { + inner x y := inst.inner (WithLp.toLp 2 (fun i => WithLp.toLp 2 (x i))) + (WithLp.toLp 2 (fun i => WithLp.toLp 2 (y i))) + conj_inner_symm x y := inst.conj_inner_symm _ _ + re_inner_nonneg x := inst.toCore.re_inner_nonneg (WithLp.toLp 2 (fun i => WithLp.toLp 2 (x i))) + add_left x y z := inst.add_left + (WithLp.toLp 2 (fun i => WithLp.toLp 2 (x i))) + (WithLp.toLp 2 (fun i => WithLp.toLp 2 (y i))) + (WithLp.toLp 2 (fun i => WithLp.toLp 2 (z i))) + smul_left x y r := inst.smul_left + (WithLp.toLp 2 (fun i => WithLp.toLp 2 (x i))) + (WithLp.toLp 2 (fun i => WithLp.toLp 2 (y i))) r + definite x := by + intro h + have h1 := inst.toCore.definite (WithLp.toLp 2 (fun i => WithLp.toLp 2 (x i))) h + simp at h1 + funext i + simpa using congrFun h1 i + } norm₂_sq_eq_re_inner := by intro x simp only [norm, OfNat.ofNat_ne_zero, ↓reduceIte, ENNReal.ofNat_ne_top, ENNReal.toReal_ofNat, Real.rpow_two, one_div] conv_rhs => rw [inner] - simp [InnerProductSpace.toCore, InnerProductSpace.toInner, PiLp.innerProductSpace] + simp [InnerProductSpace.toInner, PiLp.innerProductSpace] rw [← Real.rpow_two, ← Real.rpow_mul] swap · apply Finset.sum_nonneg intro i hi - exact sq_nonneg √(re ⟪(WithLp.equiv 2 E) (x i), (WithLp.equiv 2 E) (x i)⟫) + exact sq_nonneg √(re ⟪ (x i),(x i)⟫) simp only [isUnit_iff_ne_zero, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, IsUnit.inv_mul_cancel, Real.rpow_one] - congr - funext i - rw [Real.sqrt_eq_rpow, ← Real.rpow_two, - ← Real.rpow_mul InnerProductSpace.Core.inner_self_nonneg] - simp only [one_div, isUnit_iff_ne_zero, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, - IsUnit.inv_mul_cancel, Real.rpow_one] rfl + inner_top_equiv_norm := by rename_i i1 i2 i3 i4 i5 i6 i7 i8 by_cases hnEmpty : Nonempty ι @@ -453,19 +520,39 @@ instance {ι : Type*} [Fintype ι] : InnerProductSpace' 𝕜 (ι → E) where rw [hi] constructor · apply le_trans (h (x i)).1 - conv_rhs => rw [inner] - simp [InnerProductSpace.toCore, InnerProductSpace.toInner, PiLp.innerProductSpace] have h1 := Finset.sum_le_univ_sum_of_nonneg - (f := fun i => re (@inner 𝕜 (WithLp 2 E) toInnerProductSpaceWithL2.2 (x i) (x i))) + (f := fun i => re (@inner 𝕜 (WithLp 2 E) toInnerProductSpaceWithL2.2 + (WithLp.toLp 2 (x i)) (WithLp.toLp 2 (x i)))) (s := {i}) (by intro i simp only exact InnerProductSpace.Core.inner_self_nonneg) - apply le_trans _ h1 - simp + + apply le_trans _ (le_trans h1 _) + · simp [norm] + apply le_of_eq + symm + refine Real.sq_sqrt ?_ + exact InnerProductSpace.Core.inner_self_nonneg + · apply le_of_eq + simp only [norm, OfNat.ofNat_ne_zero, ↓reduceIte, ENNReal.ofNat_ne_top, + WithLp.equiv_apply, ENNReal.toReal_ofNat, Real.rpow_ofNat, one_div] + rw [← Real.rpow_ofNat, ← Real.rpow_mul] + simp + rfl + · positivity · have h2 := (h (x i)).2 - conv_lhs => rw [inner] - simp [InnerProductSpace.toCore, InnerProductSpace.toInner, PiLp.innerProductSpace] + trans ∑ j, re ⟪x j, x j⟫ + · apply le_of_eq + simp only [norm, OfNat.ofNat_ne_zero, ↓reduceIte, ENNReal.ofNat_ne_top, + WithLp.equiv_apply, ENNReal.toReal_ofNat, Real.rpow_ofNat, one_div] + rw [← Real.rpow_ofNat, ← Real.rpow_mul] + simp only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, inv_mul_cancel₀, Real.rpow_one] + congr + funext j + refine Real.sq_sqrt ?_ + · exact InnerProductSpace.Core.inner_self_nonneg + · positivity trans ∑ j, d * ‖x j‖ ^ 2 · refine Finset.sum_le_sum ?_ intro j _ @@ -493,8 +580,6 @@ instance {ι : Type*} [Fintype ι] : InnerProductSpace' 𝕜 (ι → E) where exact False.elim (hn hnEmpty) subst h1 simp [norm] - rw [inner] - simp [InnerProductSpace.toCore, InnerProductSpace.toInner, PiLp.innerProductSpace] variable {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [hE : InnerProductSpace' ℝ E] local notation "⟪" x ", " y "⟫" => inner ℝ x y @@ -513,8 +598,8 @@ lemma _root_.isBoundedBilinearMap_inner' : simp_all intro x y trans |‖x‖₂| * |‖y‖₂| - change |@inner ℝ (WithLp 2 E) _ x y| ≤ _ - have h1 := norm_inner_le_norm (𝕜 := ℝ) (E := WithLp 2 E) x y + change |@inner ℝ (WithLp 2 E) _ _ _| ≤ _ + have h1 := norm_inner_le_norm (𝕜 := ℝ) (E := WithLp 2 E) (WithLp.toLp 2 x) (WithLp.toLp 2 y) simp at h1 apply h1.trans apply le_of_eq diff --git a/PhysLean/Mathematics/InnerProductSpace/Submodule.lean b/PhysLean/Mathematics/InnerProductSpace/Submodule.lean new file mode 100644 index 000000000..452258608 --- /dev/null +++ b/PhysLean/Mathematics/InnerProductSpace/Submodule.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2026 Gregory J. Loges. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gregory J. Loges +-/ +import Mathlib.Analysis.InnerProductSpace.LinearPMap +/-! + +# Submodules of `E × E` + +In this module we define `submoduleToLp` which reinterprets a submodule of `E × E`, +where `E` is an inner product space, as a submodule of `WithLp 2 (E × E)`. +This allows us to take advantage of the inner product structure, since otherwise +by default `E × E` is given the sup norm. + +-/ + +namespace InnerProductSpaceSubmodule + +open LinearPMap Submodule + +variable + {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℂ E] + (M : Submodule ℂ (E × E)) + +/-- The submodule of `WithLp 2 (E × E)` defined by `M`. -/ +def submoduleToLp : Submodule ℂ (WithLp 2 (E × E)) where + carrier := {x | x.ofLp ∈ M} + add_mem' := by + intro a b ha hb + exact Submodule.add_mem M ha hb + zero_mem' := Submodule.zero_mem M + smul_mem' := by + intro c x hx + exact Submodule.smul_mem M c hx + +lemma mem_submodule_iff_mem_submoduleToLp (f : E × E) : + f ∈ M ↔ (WithLp.toLp 2 f) ∈ submoduleToLp M := Eq.to_iff rfl + +lemma submoduleToLp_closure : + (submoduleToLp M.topologicalClosure) = (submoduleToLp M).topologicalClosure := by + rw [Submodule.ext_iff] + intro x + rw [← mem_submodule_iff_mem_submoduleToLp] + change x.ofLp ∈ _root_.closure M ↔ x ∈ _root_.closure (submoduleToLp M) + repeat rw [mem_closure_iff_nhds] + constructor + · intro h t ht + apply mem_nhds_iff.mp at ht + rcases ht with ⟨t1, ht1, ht1', hx⟩ + have : ∃ t' ∈ nhds x.ofLp, (∀ y ∈ t', WithLp.toLp 2 y ∈ t1) := by + refine Filter.eventually_iff_exists_mem.mp ?_ + apply ContinuousAt.eventually_mem (by fun_prop) (IsOpen.mem_nhds ht1' hx) + rcases this with ⟨t2, ht2, ht2'⟩ + rcases h t2 ht2 with ⟨w, hw⟩ + use WithLp.toLp 2 w + exact ⟨Set.mem_preimage.mp (ht1 (ht2' w hw.1)), + (mem_submodule_iff_mem_submoduleToLp M w).mpr hw.2⟩ + · intro h t ht + apply mem_nhds_iff.mp at ht + rcases ht with ⟨t1, ht1, ht1', hx⟩ + have : ∃ t' ∈ nhds x, (∀ y ∈ t', y.ofLp ∈ t1) := by + refine Filter.eventually_iff_exists_mem.mp ?_ + exact ContinuousAt.eventually_mem (by fun_prop) (IsOpen.mem_nhds ht1' hx) + rcases this with ⟨t2, ht2, ht2'⟩ + rcases h t2 ht2 with ⟨w, hw⟩ + use w.ofLp + exact ⟨Set.mem_preimage.mp (ht1 (ht2' w hw.1)), (mem_toAddSubgroup (submoduleToLp M)).mp hw.2⟩ + +lemma mem_submodule_closure_iff_mem_submoduleToLp_closure (f : E × E) : + f ∈ M.topologicalClosure ↔ (WithLp.toLp 2 f) ∈ (submoduleToLp M).topologicalClosure := by + rw [← submoduleToLp_closure] + rfl + +lemma mem_submodule_adjoint_iff_mem_submoduleToLp_orthogonal (f : E × E) : + f ∈ M.adjoint ↔ WithLp.toLp 2 (f.2, -f.1) ∈ (submoduleToLp M)ᗮ := by + constructor <;> intro h + · rw [mem_orthogonal] + intro u hu + rw [mem_adjoint_iff] at h + have h' : inner ℂ u.snd f.1 = inner ℂ u.fst f.2 := by + rw [← sub_eq_zero] + exact h u.fst u.snd hu + simp [h'] + · rw [mem_adjoint_iff] + intro a b hab + rw [mem_orthogonal] at h + have hab' := (mem_submodule_iff_mem_submoduleToLp M (a, b)).mp hab + have h' : inner ℂ a f.2 = inner ℂ b f.1 := by + rw [← sub_eq_zero, sub_eq_add_neg, ← inner_neg_right] + exact h (WithLp.toLp 2 (a, b)) hab' + simp [h'] + +lemma mem_submodule_adjoint_adjoint_iff_mem_submoduleToLp_orthogonal_orthogonal (f : E × E) : + f ∈ M.adjoint.adjoint ↔ WithLp.toLp 2 f ∈ (submoduleToLp M)ᗮᗮ := by + simp only [mem_adjoint_iff] + trans ∀ v, (∀ w ∈ submoduleToLp M, inner ℂ w v = 0) → inner ℂ v (WithLp.toLp 2 f) = 0 + · constructor <;> intro h + · intro v hw + have h' := h (-v.snd) v.fst + rw [inner_neg_left, sub_neg_eq_add] at h' + apply h' + intro a b hab + rw [inner_neg_right, neg_sub_left, neg_eq_zero] + exact hw (WithLp.toLp 2 (a, b)) ((mem_submodule_iff_mem_submoduleToLp M (a, b)).mp hab) + · intro a b h' + rw [sub_eq_add_neg, ← inner_neg_left] + apply h (WithLp.toLp 2 (b, -a)) + intro w hw + have hw' := h' w.fst w.snd hw + rw [sub_eq_zero] at hw' + simp [hw'] + simp only [← mem_orthogonal] + +lemma mem_submodule_closure_adjoint_iff_mem_submoduleToLp_closure_orthogonal (f : E × E) : + f ∈ M.topologicalClosure.adjoint ↔ + WithLp.toLp 2 (f.2, -f.1) ∈ (submoduleToLp M).topologicalClosureᗮ := by + rw [mem_submodule_adjoint_iff_mem_submoduleToLp_orthogonal, submoduleToLp_closure] + +end InnerProductSpaceSubmodule diff --git a/PhysLean/Mathematics/KroneckerDelta.lean b/PhysLean/Mathematics/KroneckerDelta.lean new file mode 100644 index 000000000..448a6e026 --- /dev/null +++ b/PhysLean/Mathematics/KroneckerDelta.lean @@ -0,0 +1,33 @@ +/- +Copyright (c) 2026 Gregory J. Loges. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gregory J. Loges +-/ +import Mathlib.Algebra.Ring.Basic +import PhysLean.Meta.TODO.Basic +/-! + +# Kronecker delta + +This file defines the Kronecker delta, `δ[i,j] ≔ if (i = j) then 1 else 0`. + +-/ +TODO "YVABB" "Build functionality for working with sums involving Kronecker deltas." + +namespace KroneckerDelta + +/-- The Kronecker delta function, `ite (i = j) 1 0`. -/ +def kroneckerDelta [Ring R] (i j : Fin d) : R := if (i = j) then 1 else 0 + +@[inherit_doc kroneckerDelta] +macro "δ[" i:term "," j:term "]" : term => `(kroneckerDelta $i $j) + +lemma kroneckerDelta_symm [Ring R] (i j : Fin d) : + kroneckerDelta (R := R) i j = kroneckerDelta j i := + ite_cond_congr (Eq.propIntro Eq.symm Eq.symm) + +lemma kroneckerDelta_self [Ring R] : ∀ i : Fin d, kroneckerDelta (R := R) i i = 1 := by + intro i + exact if_pos rfl + +end KroneckerDelta diff --git a/PhysLean/Mathematics/LinearMaps.lean b/PhysLean/Mathematics/LinearMaps.lean index 47199fe9f..7c32ea911 100644 --- a/PhysLean/Mathematics/LinearMaps.lean +++ b/PhysLean/Mathematics/LinearMaps.lean @@ -26,7 +26,7 @@ namespace HomogeneousQuadratic variable {V : Type} [AddCommMonoid V] [Module ℚ V] -/-- A homogenous quadratic equation can be treated as a function from `V` to `ℚ`. -/ +/-- A homogeneous quadratic equation can be treated as a function from `V` to `ℚ`. -/ instance instFun : FunLike (HomogeneousQuadratic V) V ℚ where coe f := f.toFun coe_injective' f g h := by @@ -117,7 +117,7 @@ lemma map_sum₁ {n : ℕ} (f : BiLinearSymm V) (S : Fin n → V) (T : V) : lemma map_sum₂ {n : ℕ} (f : BiLinearSymm V) (S : Fin n → V) (T : V) : f T (∑ i, S i) = ∑ i, f T (S i) := map_sum (f T) S Finset.univ -/-- The homogenous quadratic equation obtainable from a bilinear function. -/ +/-- The homogeneous quadratic equation obtainable from a bilinear function. -/ @[simps!] def toHomogeneousQuad {V : Type} [AddCommMonoid V] [Module ℚ V] (τ : BiLinearSymm V) : HomogeneousQuadratic V where @@ -144,7 +144,7 @@ namespace HomogeneousCubic variable {V : Type} [AddCommMonoid V] [Module ℚ V] -/-- A homogenous cubic equation can be treated as a function from `V` to `ℚ`. -/ +/-- A homogeneous cubic equation can be treated as a function from `V` to `ℚ`. -/ instance instFun : FunLike (HomogeneousCubic V) V ℚ where coe f := f.toFun coe_injective' f g h := by @@ -266,7 +266,7 @@ lemma map_sum₁₂₃ {n1 n2 n3 : ℕ} (f : TriLinearSymm V) (S : Fin n1 → V) rw [map_sum₂] exact Fintype.sum_congr _ _ fun _ ↦ map_sum₃ f L (S _) (T _) -/-- The homogenous cubic equation obtainable from a symmetric trilinear function. -/ +/-- The homogeneous cubic equation obtainable from a symmetric trilinear function. -/ @[simps!] def toCubic {charges : Type} [AddCommMonoid charges] [Module ℚ charges] (τ : TriLinearSymm charges) : HomogeneousCubic charges where diff --git a/PhysLean/Mathematics/List.lean b/PhysLean/Mathematics/List.lean index b4287968a..3781a13b2 100644 --- a/PhysLean/Mathematics/List.lean +++ b/PhysLean/Mathematics/List.lean @@ -5,6 +5,7 @@ Authors: Joseph Tooby-Smith -/ import PhysLean.Mathematics.Fin import Mathlib.Data.Nat.Lattice +import Mathlib.Data.List.TakeWhile /-! # List lemmas @@ -93,17 +94,13 @@ lemma dropWile_eraseIdx {I : Type} (P : I → Prop) [DecidablePred P] : · have hPa : P a := by simpa using h ⟨0, by simp⟩ ⟨1, by simp⟩ (by simp [Fin.lt_def]) (by simpa using hPb) simp [hPb, hPa] - · simp only [hPb, decide_false, nonpos_iff_eq_zero, List.length_eq_zero_iff] + · simp only [List.tail_cons, hPb, decide_false, Bool.false_eq_true, not_false_eq_true, + List.dropWhile_cons_of_neg] simp_all only [List.length_cons, List.get_eq_getElem] - simp_rw [decide_false] - simp_all only [List.tail_cons, decide_false, Bool.false_eq_true, not_false_eq_true, - List.dropWhile_cons_of_neg, nonpos_iff_eq_zero, List.length_eq_zero_iff] split next x heq => - simp_all only [decide_eq_true_eq, List.length_singleton, nonpos_iff_eq_zero, one_ne_zero, - ↓reduceIte] - next x heq => simp_all only [decide_eq_false_iff_not, List.length_nil, - le_refl, ↓reduceIte, List.tail_cons] + simp_all only [decide_eq_true_eq, List.cons_ne_self, ↓reduceIte] + next x heq => simp_all only [decide_eq_false_iff_not, ↓reduceIte, List.tail_cons] | a :: b :: l, Nat.succ n, h => by simp only [Nat.succ_eq_add_one, List.eraseIdx_cons_succ] by_cases hPb : P b @@ -278,12 +275,12 @@ lemma lt_orderedInsertPos_rel_fin {I : Type} (le1 : I → I → Prop) [Decidable simpa using List.mem_takeWhile_imp htake lemma gt_orderedInsertPos_rel {I : Type} (le1 : I → I → Prop) [DecidableRel le1] - [IsTotal I le1] [IsTrans I le1] (r0 : I) (r : List I) (hs : List.Sorted le1 r) + [Std.Total le1] [IsTrans I le1] (r0 : I) (r : List I) (hs : List.Pairwise le1 r) (n : Fin r.length) (hn : ¬ n.val < (orderedInsertPos le1 r r0).val) : le1 r0 (r.get n) := by - have hrsSorted : List.Sorted le1 (List.orderedInsert le1 r0 r) := - List.Sorted.orderedInsert r0 r hs - apply List.Sorted.rel_of_mem_take_of_mem_drop (k := (orderedInsertPos le1 r r0).succ) hrsSorted + have hrsSorted : List.Pairwise le1 (List.orderedInsert le1 r0 r) := + List.Pairwise.orderedInsert r0 r hs + apply List.Pairwise.rel_of_mem_take_of_mem_drop (i := (orderedInsertPos le1 r r0).succ) hrsSorted · rw [orderedInsertPos_succ_take_orderedInsert] simp · rw [← orderedInsertPos_drop_eq_orderedInsert] @@ -367,7 +364,7 @@ lemma orderedInsertEquiv_succ {I : Type} (le1 : I → I → Prop) [DecidableRel simp only [List.length_cons, orderedInsertEquiv, Nat.succ_eq_add_one, Equiv.trans_apply] match r with | [] => - simp + simp [List.orderedInsert.eq_1] | r1 :: r => simp only [List.orderedInsert.eq_2, List.length_cons] rw [finExtractOne_apply_neq] @@ -384,7 +381,7 @@ lemma orderedInsertEquiv_fin_succ {I : Type} (le1 : I → I → Prop) [Decidable simp only [orderedInsertEquiv, Equiv.trans_apply] match r with | [] => - simp + simp [List.orderedInsert.eq_1] | r1 :: r => simp only [List.orderedInsert.eq_2, List.length_cons, Fin.eta] rw [finExtractOne_apply_neq] @@ -399,7 +396,7 @@ lemma orderedInsertEquiv_monotone_fin_succ {I : Type} (hx : orderedInsertEquiv le1 r r0 n.succ < orderedInsertEquiv le1 r r0 m.succ) : n < m := by rw [orderedInsertEquiv_fin_succ, orderedInsertEquiv_fin_succ, Fin.lt_def] at hx - simp only [Fin.eta, Fin.coe_cast, Fin.val_fin_lt] at hx + simp only [Fin.eta, Fin.val_cast, Fin.val_fin_lt] at hx rw [Fin.succAbove_lt_succAbove_iff] at hx exact hx @@ -421,7 +418,7 @@ lemma get_eq_orderedInsertEquiv {I : Type} (le1 : I → I → Prop) [DecidableRe simp only [List.length_cons, Nat.succ_eq_add_one, List.get_eq_getElem, List.getElem_cons_succ, Function.comp_apply] rw [orderedInsertEquiv_succ] - simp only [Fin.succAbove, Fin.castSucc_mk, Fin.mk_lt_mk, Fin.succ_mk, Fin.coe_cast] + simp only [Fin.succAbove, Fin.castSucc_mk, Fin.mk_lt_mk, Fin.succ_mk, Fin.val_cast] by_cases hn : n < ↑(orderedInsertPos le1 r r0) · simp [hn, orderedInsert_get_lt] · simp only [hn, ↓reduceIte, List.orderedInsert_eq_take_drop, decide_not] @@ -470,7 +467,7 @@ lemma orderedInsert_eraseIdx_orderedInsertEquiv_succ | cons r1 r ih => rw [orderedInsertEquiv_succ] simp only [List.length_cons, Fin.succAbove, - Fin.castSucc_mk, Fin.mk_lt_mk, Fin.succ_mk, Fin.coe_cast] + Fin.castSucc_mk, Fin.mk_lt_mk, Fin.succ_mk, Fin.val_cast] by_cases hn' : n < (orderedInsertPos le1 (r1 :: r) r0) · simp only [hn', ↓reduceIte] rw [orderedInsert_eraseIdx_lt_orderedInsertPos le1 (r1 :: r) r0 n hn' hr] @@ -500,20 +497,21 @@ lemma orderedInsertEquiv_sigma {I : Type} {f : I → Type} match x with | ⟨0, h0⟩ => simp only [Fin.zero_eta, Equiv.trans_apply, RelIso.coe_fn_toEquiv, Fin.castOrderIso_apply, - Fin.cast_zero, Fin.coe_cast] + Fin.cast_zero, Fin.val_cast] rw [orderedInsertEquiv_zero, orderedInsertEquiv_zero] simp [orderedInsertPos_sigma] | ⟨Nat.succ n, h0⟩ => simp only [Nat.succ_eq_add_one, Equiv.trans_apply, RelIso.coe_fn_toEquiv, - Fin.castOrderIso_apply, Fin.cast_mk, Fin.coe_cast] + Fin.castOrderIso_apply, Fin.cast_mk, Fin.val_cast] erw [orderedInsertEquiv_succ, orderedInsertEquiv_succ] - simp only [orderedInsertPos_sigma, Fin.coe_cast] + simp only [orderedInsertPos_sigma, Fin.val_cast] rw [Fin.succAbove, Fin.succAbove] simp only [Fin.castSucc_mk, Fin.mk_lt_mk, Fin.succ_mk] split · rfl · rfl +set_option maxHeartbeats 350000 lemma orderedInsert_eq_insertIdx_orderedInsertPos {I : Type} (le1 : I → I → Prop) [DecidableRel le1] (r : List I) (r0 : I) : List.orderedInsert le1 r0 r = List.insertIdx r (orderedInsertPos le1 r r0).1 r0 := by @@ -531,9 +529,8 @@ lemma orderedInsert_eq_insertIdx_orderedInsertPos {I : Type} (le1 : I → I → simp only [List.length_cons, Function.comp_apply, Equiv.symm_apply_apply, List.get_eq_getElem] match n' with | ⟨0, h0⟩ => - simp only [List.getElem_cons_zero, orderedInsertEquiv, List.length_cons, Fin.zero_eta, - Equiv.trans_apply, finExtractOne_apply_eq, Fin.isValue, finExtractOne_symm_inl_apply] - erw [List.getElem_insertIdx_self] + simp only [List.getElem_cons_zero, Fin.zero_eta, orderedInsertEquiv_zero, + List.getElem_insertIdx_self] | ⟨Nat.succ n', h0⟩ => simp only [Nat.succ_eq_add_one, List.getElem_cons_succ] have hr := orderedInsertEquiv_succ le1 r r0 n' h0 @@ -595,6 +592,15 @@ lemma insertionSortEquiv_congr {α : Type} {r : α → α → Prop} [DecidableRe ((insertionSortEquiv r l').trans (Fin.castOrderIso (by simp [h])).toEquiv) := by subst h rfl + +lemma insertionSortEquiv_congr_apply {α : Type} {r : α → α → Prop} [DecidableRel r] (l l' : List α) + (h : l = l') (i : Fin l.length) : + insertionSortEquiv r l i = + Fin.cast (by simp [h]) + ((insertionSortEquiv r l') (Fin.cast (by simp [h]) i)) := by + rw [insertionSortEquiv_congr l l' h] + simp + lemma insertionSort_get_comp_insertionSortEquiv {α : Type} {r : α → α → Prop} [DecidableRel r] (l : List α) : (List.insertionSort r l).get ∘ (insertionSortEquiv r l) = l.get := by rw [← insertionSortEquiv_get] @@ -615,24 +621,17 @@ lemma insertionSortEquiv_order {α : Type} {r : α → α → Prop} [DecidableRe simp only [List.length_cons, Fin.zero_eta, Fin.getElem_fin, Fin.val_zero, List.getElem_cons_zero, List.getElem_cons_succ] nth_rewrite 2 [insertionSortEquiv] at hij' - simp only [List.insertionSort.eq_2, List.length_cons, Nat.succ_eq_add_one, Fin.zero_eta, + simp only [List.length_cons, Nat.succ_eq_add_one, Fin.zero_eta, Equiv.trans_apply, equivCons_zero] at hij' have hx := orderedInsertEquiv_zero r (List.insertionSort r as) a simp only at hx - rw [hx] at hij' - have h1 := lt_orderedInsertPos_rel_fin r a (List.insertionSort r as) _ hij' - rw [insertionSortEquiv] at h1 - simp only [Nat.succ_eq_add_one, List.insertionSort.eq_2, Equiv.trans_apply, - equivCons_succ] at h1 - rw [← orderedInsertEquiv_get] at h1 - simp only [List.length_cons, Function.comp_apply, Equiv.symm_apply_apply, List.get_eq_getElem, - Fin.val_succ, List.getElem_cons_succ] at h1 - rw [← List.get_eq_getElem] at h1 - rw [← insertionSortEquiv_get] at h1 - simpa using h1 + convert lt_orderedInsertPos_rel_fin r a (List.insertionSort r as) _ hij' + change _ = ((List.insertionSort r (a :: as))).get ((insertionSortEquiv r (a :: as)) ⟨j + 1, hj⟩) + rw [← insertionSortEquiv_get] + simp | a :: as, ⟨i + 1, hi⟩, ⟨j + 1, hj⟩, hij, hij' => by - simp only [List.insertionSort.eq_2, List.length_cons, insertionSortEquiv, Nat.succ_eq_add_one, - Equiv.trans_apply, equivCons_succ] at hij' + simp only [List.length_cons, insertionSortEquiv, Nat.succ_eq_add_one, Equiv.trans_apply, + equivCons_succ] at hij' have h1 := orderedInsertEquiv_monotone_fin_succ _ _ _ _ _ hij' have h2 := insertionSortEquiv_order as ⟨i, Nat.succ_lt_succ_iff.mp hi⟩ ⟨j, Nat.succ_lt_succ_iff.mp hj⟩ (by simpa using hij) h1 @@ -670,31 +669,29 @@ lemma eraseIdx_get {I : Type} (l : List I) (i : Fin l.length) : (Fin.cast (eraseIdx_length l i).symm i).succAbove := by ext x simp only [Function.comp_apply, List.get_eq_getElem, List.getElem_eraseIdx] - simp only [Fin.succAbove, Fin.coe_cast] + simp only [Fin.succAbove, Fin.val_cast] by_cases hi: x.castSucc < Fin.cast (Eq.symm (eraseIdx_length l i)) i - · simp only [hi, ↓reduceIte, Fin.coe_castSucc, dite_eq_left_iff, not_lt] + · simp only [hi, ↓reduceIte, Fin.val_castSucc, dite_eq_left_iff, not_lt] intro h rw [Fin.lt_def] at hi - simp_all only [Fin.coe_castSucc, Fin.coe_cast] + simp_all only [Fin.val_castSucc, Fin.val_cast] omega · simp only [hi, ↓reduceIte, Fin.val_succ] rw [Fin.lt_def] at hi - simp only [Fin.coe_castSucc, Fin.coe_cast, not_lt] at hi + simp only [Fin.val_castSucc, Fin.val_cast, not_lt] at hi have hn : ¬ x.val < i.val := by omega simp [hn] lemma eraseIdx_insertionSort {I : Type} (le1 : I → I → Prop) [DecidableRel le1] - [IsTotal I le1] [IsTrans I le1] : + [Std.Total le1] [IsTrans I le1] : (n : ℕ) → (r : List I) → (hn : n < r.length) → (List.insertionSort le1 r).eraseIdx ↑((insertionSortEquiv le1 r) ⟨n, hn⟩) = List.insertionSort le1 (r.eraseIdx n) | 0, [], _ => by rfl | 0, (r0 :: r), hn => by - simp only [List.insertionSort, List.insertionSort.eq_2, List.length_cons, insertionSortEquiv, - Nat.succ_eq_add_one, Fin.zero_eta, Equiv.trans_apply, equivCons_zero, List.eraseIdx_zero, - List.tail_cons] - erw [orderedInsertEquiv_zero] - simp + simp only [List.insertionSort, List.foldr_cons, List.length_cons, insertionSortEquiv, + Nat.succ_eq_add_one, Fin.zero_eta, Equiv.trans_apply, equivCons_zero, orderedInsertEquiv_zero, + orderedInsert_eraseIdx_orderedInsertPos, List.eraseIdx_zero, List.tail_cons] | Nat.succ n, [], hn => by rfl | Nat.succ n, (r0 :: r), hn => by simp only [List.insertionSort, List.length_cons, insertionSortEquiv, Nat.succ_eq_add_one, @@ -705,8 +702,8 @@ lemma eraseIdx_insertionSort {I : Type} (le1 : I → I → Prop) [DecidableRel l congr refine eraseIdx_insertionSort le1 n r _ intro i j hij hn - have hx := List.Sorted.rel_get_of_lt (r := le1) (l := (List.insertionSort le1 r)) - (List.sorted_insertionSort le1 r) hij + have hx := List.Pairwise.rel_get_of_lt (R := le1) (l := (List.insertionSort le1 r)) + (List.pairwise_insertionSort le1 r) hij have ht (i j k : I) (hij : le1 i j) (hjk : ¬ le1 k j) : ¬ le1 k i := by intro hik have ht := IsTrans.trans (r := le1) k i j hik hij @@ -714,7 +711,7 @@ lemma eraseIdx_insertionSort {I : Type} (le1 : I → I → Prop) [DecidableRel l exact ht ((List.insertionSort le1 r).get i) ((List.insertionSort le1 r).get j) r0 hx hn lemma eraseIdx_insertionSort_fin {I : Type} (le1 : I → I → Prop) [DecidableRel le1] - [IsTotal I le1] [IsTrans I le1] (r : List I) (n : Fin r.length) : + [Std.Total le1] [IsTrans I le1] (r : List I) (n : Fin r.length) : (List.insertionSort le1 r).eraseIdx ↑((PhysLean.List.insertionSortEquiv le1 r) n) = List.insertionSort le1 (r.eraseIdx n) := eraseIdx_insertionSort le1 n.val r (Fin.prop n) @@ -753,7 +750,7 @@ def insertionSortDropMinPos {α : Type} (r : α → α → Prop) [DecidableRel r List α := (i :: l).eraseIdx (insertionSortMinPos r i l) lemma insertionSort_eq_insertionSortMin_cons {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTotal α r] [IsTrans α r] (i : α) (l : List α) : + [Std.Total r] [IsTrans α r] (i : α) (l : List α) : List.insertionSort r (i :: l) = (insertionSortMin r i l) :: List.insertionSort r (insertionSortDropMinPos r i l) := by rw [insertionSortDropMinPos, ← eraseIdx_insertionSort_fin] diff --git a/PhysLean/Mathematics/List/InsertIdx.lean b/PhysLean/Mathematics/List/InsertIdx.lean index 88e7a2dee..399af0cb5 100644 --- a/PhysLean/Mathematics/List/InsertIdx.lean +++ b/PhysLean/Mathematics/List/InsertIdx.lean @@ -26,15 +26,15 @@ lemma insertIdx_map {I J : Type} (f : I → J) : (i : ℕ) → (r : List I) → lemma eraseIdx_sorted {I : Type} (le : I → I → Prop) : (r : List I) → (n : ℕ) → - List.Sorted le r → List.Sorted le (r.eraseIdx n) + List.Pairwise le r → List.Pairwise le (r.eraseIdx n) | [], _, _ => by simp | a::as, 0, h => by simp only [List.eraseIdx] - simp only [List.sorted_cons] at h + simp only [List.pairwise_cons] at h exact h.2 | a::as, n+1, h => by - simp only [List.eraseIdx_cons_succ, List.sorted_cons] - simp only [List.sorted_cons] at h + simp only [List.eraseIdx_cons_succ, List.pairwise_cons] + simp only [List.pairwise_cons] at h refine And.intro ?_ (eraseIdx_sorted le as n h.2) intro b hb refine h.1 _ ?_ diff --git a/PhysLean/Mathematics/List/InsertionSort.lean b/PhysLean/Mathematics/List/InsertionSort.lean index 18931ac53..97310421f 100644 --- a/PhysLean/Mathematics/List/InsertionSort.lean +++ b/PhysLean/Mathematics/List/InsertionSort.lean @@ -18,7 +18,7 @@ lemma insertionSortMin_lt_length_succ {α : Type} (r : α → α → Prop) [Deci (i : α) (l : List α) : insertionSortMinPos r i l < (insertionSortDropMinPos r i l).length.succ := by rw [insertionSortMinPos] - simp only [List.length_cons, List.insertionSort.eq_2, insertionSortDropMinPos, + simp only [List.length_cons, insertionSortDropMinPos, Nat.succ_eq_add_one] rw [eraseIdx_length'] simp @@ -30,14 +30,14 @@ def insertionSortMinPosFin {α : Type} (r : α → α → Prop) [DecidableRel r] ⟨insertionSortMinPos r i l, insertionSortMin_lt_length_succ r i l⟩ lemma insertionSortMin_lt_mem_insertionSortDropMinPos {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTotal α r] [IsTrans α r] (a : α) (l : List α) + [Std.Total r] [IsTrans α r] (a : α) (l : List α) (i : Fin (insertionSortDropMinPos r a l).length) : r (insertionSortMin r a l) ((insertionSortDropMinPos r a l)[i]) := by let l1 := List.insertionSort r (a :: l) - have hl1 : l1.Sorted r := List.sorted_insertionSort r (a :: l) + have hl1 : l1.Pairwise r := List.pairwise_insertionSort r (a :: l) simp only [l1] at hl1 rw [insertionSort_eq_insertionSortMin_cons r a l] at hl1 - simp only [List.sorted_cons, List.mem_insertionSort] at hl1 + simp only [List.pairwise_cons, List.mem_insertionSort] at hl1 apply hl1.1 ((insertionSortDropMinPos r a l)[i]) simp @@ -53,9 +53,9 @@ lemma insertionSortEquiv_gt_zero_of_ne_insertionSortMinPos {α : Type} (r : α (hk : k ≠ insertionSortMinPos r a l) : ⟨0, by simp [List.orderedInsert_length]⟩ < insertionSortEquiv r (a :: l) k := by by_contra hn - simp only [List.insertionSort.eq_2, List.length_cons, not_lt] at hn + simp only [List.length_cons, not_lt] at hn refine hk ((Equiv.apply_eq_iff_eq_symm_apply (insertionSortEquiv r (a :: l))).mp ?_) - simp_all only [List.length_cons, ne_eq, Fin.le_def, nonpos_iff_eq_zero, List.insertionSort.eq_2] + simp_all only [List.length_cons, ne_eq, Fin.le_def, nonpos_iff_eq_zero] simp only [Fin.ext_iff] omega @@ -72,40 +72,39 @@ lemma insertionSortMin_lt_mem_insertionSortDropMinPos_of_lt {α : Type} (r : α simp only [Fin.getElem_fin, List.get_eq_getElem] simp only [insertionSortDropMinPos, List.length_cons, Nat.succ_eq_add_one, finCongr_apply] rw [eraseIdx_get] - simp only [List.length_cons, Function.comp_apply, List.get_eq_getElem, Fin.coe_cast] + simp only [List.length_cons, Function.comp_apply, List.get_eq_getElem, Fin.val_cast] rfl erw [h1] simp only [List.length_cons, Nat.succ_eq_add_one, List.get_eq_getElem] apply insertionSortEquiv_order simpa using h - simp only [List.insertionSort.eq_2, List.length_cons, finCongr_apply] + simp only [List.length_cons, finCongr_apply] apply lt_of_eq_of_lt (insertionSortMinPos_insertionSortEquiv r a l) - simp only [List.insertionSort.eq_2] apply insertionSortEquiv_gt_zero_of_ne_insertionSortMinPos r a l - simp only [List.length_cons, ne_eq, Fin.ext_iff, Fin.coe_cast] + simp only [List.length_cons, ne_eq, Fin.ext_iff, Fin.val_cast] have hl : (insertionSortMinPos r a l).val = (insertionSortMinPosFin r a l).val := by rfl simp only [hl, Nat.succ_eq_add_one, Fin.val_eq_val, ne_eq] exact Fin.succAbove_ne (insertionSortMinPosFin r a l) i lemma insertionSort_insertionSort {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTotal α r] [IsTrans α r] (l1 : List α) : + [Std.Total r] [IsTrans α r] (l1 : List α) : List.insertionSort r (List.insertionSort r l1) = List.insertionSort r l1 := by - apply List.Sorted.insertionSort_eq - exact List.sorted_insertionSort r l1 + apply List.Pairwise.insertionSort_eq + exact List.pairwise_insertionSort r l1 lemma orderedInsert_commute {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTotal α r] [IsTrans α r] (a b : α) (hr : ¬ r a b) : (l : List α) → + [Std.Total r] [IsTrans α r] (a b : α) (hr : ¬ r a b) : (l : List α) → List.orderedInsert r a (List.orderedInsert r b l) = List.orderedInsert r b (List.orderedInsert r a l) | [] => by have hrb : r b a := by - have ht := IsTotal.total (r := r) a b + have ht := Std.Total.total (r := r) a b simp_all simp [hr, hrb] | c :: l => by have hrb : r b a := by - have ht := IsTotal.total (r := r) a b + have ht := Std.Total.total (r := r) a b simp_all simp only [List.orderedInsert] by_cases h : r a c @@ -120,7 +119,7 @@ lemma orderedInsert_commute {α : Type} (r : α → α → Prop) [DecidableRel r exact orderedInsert_commute r a b hr l lemma insertionSort_orderedInsert_append {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTotal α r] [IsTrans α r] (a : α) : (l1 l2 : List α) → + [Std.Total r] [IsTrans α r] (a : α) : (l1 l2 : List α) → List.insertionSort r (List.orderedInsert r a l1 ++ l2) = List.insertionSort r (a :: l1 ++ l2) | [], l2 => by simp @@ -130,29 +129,29 @@ lemma insertionSort_orderedInsert_append {α : Type} (r : α → α → Prop) [D · simp [h] conv_lhs => simp [h] rw [insertionSort_orderedInsert_append r a l1 l2] - simp only [List.cons_append, List.insertionSort] + simp only [List.cons_append, List.insertionSort_cons] rw [orderedInsert_commute r a b h] lemma insertionSort_insertionSort_append {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTotal α r] [IsTrans α r] : (l1 l2 : List α) → + [Std.Total r] [IsTrans α r] : (l1 l2 : List α) → List.insertionSort r (List.insertionSort r l1 ++ l2) = List.insertionSort r (l1 ++ l2) | [], l2 => by simp | a :: l1, l2 => by conv_lhs => simp rw [insertionSort_orderedInsert_append] - simp only [List.cons_append, List.insertionSort] + simp only [List.cons_append, List.insertionSort_cons] rw [insertionSort_insertionSort_append r l1 l2] lemma insertionSort_append_insertionSort_append {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTotal α r] [IsTrans α r] : (l1 l2 l3 : List α) → + [Std.Total r] [IsTrans α r] : (l1 l2 l3 : List α) → List.insertionSort r (l1 ++ List.insertionSort r l2 ++ l3) = List.insertionSort r (l1 ++ l2 ++ l3) | [], l2, l3 => by simp only [List.nil_append] exact insertionSort_insertionSort_append r l2 l3 | a :: l1, l2, l3 => by - simp only [List.cons_append, List.insertionSort] + simp only [List.cons_append, List.insertionSort_cons] rw [insertionSort_append_insertionSort_append r l1 l2 l3] @[simp] @@ -162,7 +161,7 @@ lemma orderedInsert_length {α : Type} (r : α → α → Prop) [DecidableRel r] exact List.perm_orderedInsert r a l lemma takeWhile_orderedInsert {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTotal α r] [IsTrans α r] + [Std.Total r] [IsTrans α r] (a b : α) (hr : ¬ r a b) : (l : List α) → (List.takeWhile (fun c => !decide (r a c)) (List.orderedInsert r b l)).length = (List.takeWhile (fun c => !decide (r a c)) l).length + 1 @@ -177,7 +176,7 @@ lemma takeWhile_orderedInsert {α : Type} (r : α → α → Prop) [DecidableRel simp [hr] · simp only [h, ↓reduceIte] have hrba : r b a:= by - have ht := IsTotal.total (r := r) a b + have ht := Std.Total.total (r := r) a b simp_all have hl : ¬ r a c := by by_contra hn @@ -188,7 +187,7 @@ lemma takeWhile_orderedInsert {α : Type} (r : α → α → Prop) [DecidableRel exact takeWhile_orderedInsert r a b hr l lemma takeWhile_orderedInsert' {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTotal α r] [IsTrans α r] + [Std.Total r] [IsTrans α r] (a b : α) (hr : ¬ r a b) : (l : List α) → (List.takeWhile (fun c => !decide (r b c)) (List.orderedInsert r a l)).length = (List.takeWhile (fun c => !decide (r b c)) l).length @@ -197,11 +196,11 @@ lemma takeWhile_orderedInsert' {α : Type} (r : α → α → Prop) [DecidableRe List.takeWhile_eq_nil_iff, List.length_singleton, zero_lt_one, Fin.zero_eta, Fin.isValue, List.get_eq_getElem, Fin.val_eq_zero, List.getElem_cons_zero, Bool.not_eq_eq_eq_not, Bool.not_true, decide_eq_false_iff_not, Decidable.not_not, forall_const] - have ht := IsTotal.total (r := r) a b + have ht := Std.Total.total (r := r) a b simp_all | c :: l => by have hrba : r b a:= by - have ht := IsTotal.total (r := r) a b + have ht := Std.Total.total (r := r) a b simp_all simp only [List.orderedInsert] by_cases h : r b c @@ -220,12 +219,12 @@ lemma takeWhile_orderedInsert' {α : Type} (r : α → α → Prop) [DecidableRe exact takeWhile_orderedInsert' r a b hr l lemma insertionSortEquiv_commute {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTotal α r] [IsTrans α r] (a b : α) (hr : ¬ r a b) (n : ℕ) : (l : List α) → + [Std.Total r] [IsTrans α r] (a b : α) (hr : ¬ r a b) (n : ℕ) : (l : List α) → (hn : n + 2 < (a :: b :: l).length) → insertionSortEquiv r (a :: b :: l) ⟨n + 2, hn⟩ = (finCongr (by simp)) (insertionSortEquiv r (b :: a :: l) ⟨n + 2, hn⟩) := by have hrba : r b a:= by - have ht := IsTotal.total (r := r) a b + have ht := Std.Total.total (r := r) a b simp_all intro l hn simp only [List.insertionSort, List.length_cons, insertionSortEquiv, Nat.succ_eq_add_one, @@ -238,14 +237,14 @@ lemma insertionSortEquiv_commute {α : Type} (r : α → α → Prop) [Decidable rhs erw [orderedInsertEquiv_succ] conv_lhs => erw [orderedInsertEquiv_fin_succ] - simp only [Fin.eta, Fin.coe_cast] + simp only [Fin.eta, Fin.val_cast] conv_rhs => rhs rhs erw [orderedInsertEquiv_succ] conv_rhs => erw [orderedInsertEquiv_fin_succ] ext - simp only [Fin.coe_cast, Fin.eta, Fin.cast_cast] + simp only [Fin.val_cast, Fin.eta, Fin.cast_cast] let a1 : Fin ((List.orderedInsert r b (List.insertionSort r l)).length + 1) := ⟨↑(orderedInsertPos r (List.orderedInsert r b (List.insertionSort r l)) a), orderedInsertPos_lt_length r (List.orderedInsert r b (List.insertionSort r l)) a⟩ @@ -333,16 +332,17 @@ lemma insertionSortEquiv_commute {α : Type} (r : α → α → Prop) [Decidable exact ha1 lemma insertionSortEquiv_orderedInsert_append {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTotal α r] [IsTrans α r] (a a2 : α) : (l1 l2 : List α) → + [Std.Total r] [IsTrans α r] (a a2 : α) : (l1 l2 : List α) → (insertionSortEquiv r (List.orderedInsert r a l1 ++ a2 :: l2) ⟨l1.length + 1, by simp⟩) = (finCongr (by - simp only [List.cons_append, List.insertionSort, orderedInsert_length, List.length_cons, + simp only [List.cons_append, List.insertionSort_cons, orderedInsert_length, List.length_cons, List.length_insertionSort, List.length_append] omega)) ((insertionSortEquiv r (a :: l1 ++ a2 :: l2)) ⟨l1.length + 1, by simp⟩) | [], l2 => by - simp + simp only [List.orderedInsert.eq_1, List.cons_append, List.nil_append, List.insertionSort, + List.length_cons, List.length_nil, zero_add, Fin.mk_one, finCongr_refl, Equiv.refl_apply] | b :: l1, l2 => by by_cases h : r a b · have h1 : (List.orderedInsert r a (b :: l1) ++ a2 :: l2) = (a :: b :: l1 ++ a2 :: l2) := by @@ -353,7 +353,7 @@ lemma insertionSortEquiv_orderedInsert_append {α : Type} (r : α → α → Pro (b :: List.orderedInsert r a (l1) ++ a2 :: l2) := by simp [h] rw [insertionSortEquiv_congr _ _ h1] - simp only [List.orderedInsert.eq_2, List.cons_append, List.length_cons, List.insertionSort, + simp only [List.orderedInsert.eq_2, List.cons_append, List.length_cons, Equiv.trans_apply, RelIso.coe_fn_toEquiv, Fin.castOrderIso_apply, Fin.cast_mk, finCongr_apply] conv_lhs => simp [insertionSortEquiv] @@ -362,9 +362,12 @@ lemma insertionSortEquiv_orderedInsert_append {α : Type} (r : α → α → Pro List.insertionSort r (a :: l1 ++ a2 :: l2) := by exact insertionSort_orderedInsert_append r a l1 (a2 :: l2) rw [orderedInsertEquiv_congr _ _ _ hl] - simp only [List.length_cons, List.cons_append, List.insertionSort, finCongr_apply, - Equiv.trans_apply, RelIso.coe_fn_toEquiv, Fin.castOrderIso_apply, Fin.cast_succ_eq, - Fin.cast_cast, Fin.cast_eq_self] + conv_lhs => + enter [2, 1, 2, 1] + simp [List.insertionSort_cons] + simp only [List.insertionSort, List.foldr_cons, List.cons_append, List.length_cons, + finCongr_apply, Equiv.trans_apply, RelIso.coe_fn_toEquiv, Fin.castOrderIso_apply, + Fin.cast_succ_eq, Fin.cast_cast, Fin.cast_eq_self] change Fin.cast _ ((insertionSortEquiv r (b :: a :: (l1 ++ a2 :: l2))) ⟨l1.length + 2, by simp⟩) = _ have hl : l1.length + 1 +1 = l1.length + 2 := by omega @@ -372,29 +375,31 @@ lemma insertionSortEquiv_orderedInsert_append {α : Type} (r : α → α → Pro conv_rhs => erw [insertionSortEquiv_commute _ _ _ h _ _] simp + rfl lemma insertionSortEquiv_insertionSort_append {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTotal α r] [IsTrans α r] (a : α) : (l1 l2 : List α) → + [Std.Total r] [IsTrans α r] (a : α) : (l1 l2 : List α) → (insertionSortEquiv r (List.insertionSort r l1 ++ a :: l2) ⟨l1.length, by simp⟩) = finCongr (by simp) (insertionSortEquiv r (l1 ++ a :: l2) ⟨l1.length, by simp⟩) | [], l2 => by - simp only [List.insertionSort, List.nil_append, List.length_cons, List.length_nil, Fin.zero_eta, - finCongr_refl, Equiv.refl_apply] + apply insertionSortEquiv_congr_apply + simp | b :: l1, l2 => by simp only [List.insertionSort, List.length_cons, List.cons_append, finCongr_apply] have hl := insertionSortEquiv_orderedInsert_append r b a (List.insertionSort r l1) l2 - simp only [List.length_insertionSort, List.cons_append, List.insertionSort, List.length_cons, + simp only [List.length_insertionSort, List.cons_append, List.length_cons, finCongr_apply] at hl - rw [hl] + erw [hl] have ih := insertionSortEquiv_insertionSort_append r a l1 l2 simp only [insertionSortEquiv, Nat.succ_eq_add_one, List.insertionSort, Equiv.trans_apply, equivCons_succ] - rw [ih] + erw [ih] have hl : (List.insertionSort r (List.insertionSort r l1 ++ a :: l2)) = (List.insertionSort r (l1 ++ a :: l2)) := by exact insertionSort_insertionSort_append r l1 (a :: l2) - rw [orderedInsertEquiv_congr _ _ _ hl] - simp + erw [orderedInsertEquiv_congr _ _ _ hl] + simp only [List.foldr_cons, finCongr_apply] + rfl /-! @@ -404,7 +409,7 @@ lemma insertionSortEquiv_insertionSort_append {α : Type} (r : α → α → Pro lemma orderedInsert_filter_of_pos {α : Type} (r : α → α → Prop) [DecidableRel r] [IsTrans α r] (a : α) (p : α → Prop) [DecidablePred p] (h : p a) : (l : List α) → - (hl : l.Sorted r) → + (hl : l.Pairwise r) → List.filter p (List.orderedInsert r a l) = List.orderedInsert r a (List.filter p l) | [], hl => by simp only [List.orderedInsert, List.filter_nil, List.orderedInsert_nil, List.filter_eq_self, @@ -421,7 +426,7 @@ lemma orderedInsert_filter_of_pos {α : Type} (r : α → α → Prop) [Decidabl rw [List.filter_cons_of_pos (by simp [hpb])] rw [List.filter_cons_of_pos (by simp [hpb])] simp only [List.orderedInsert, hab, ↓reduceIte, List.cons.injEq, true_and] - simp only [List.sorted_cons] at hl + simp only [List.pairwise_cons] at hl exact orderedInsert_filter_of_pos r a p h l hl.2 · simp only [hab, ↓reduceIte] rw [List.filter_cons_of_pos (by simp [h]), @@ -435,7 +440,7 @@ lemma orderedInsert_filter_of_pos {α : Type} (r : α → α → Prop) [Decidabl decide_eq_false_iff_not] at hc apply hc apply IsTrans.trans a b _ hab - simp only [List.sorted_cons] at hl + simp only [List.pairwise_cons] at hl apply hl.1 have hlf : (List.filter (fun b => decide (p b)) l)[0] ∈ (List.filter (fun b => decide (p b)) l) := by @@ -451,7 +456,7 @@ lemma orderedInsert_filter_of_pos {α : Type} (r : α → α → Prop) [Decidabl · simp only [hab, ↓reduceIte] rw [List.filter_cons_of_neg (by simp [hpb])] rw [List.filter_cons_of_neg (by simp [hpb])] - simp only [List.sorted_cons] at hl + simp only [List.pairwise_cons] at hl exact orderedInsert_filter_of_pos r a p h l hl.2 lemma orderedInsert_filter_of_neg {α : Type} (r : α → α → Prop) [DecidableRel r] @@ -465,21 +470,21 @@ lemma orderedInsert_filter_of_neg {α : Type} (r : α → α → Prop) [Decidabl exact List.takeWhile_append_dropWhile simp [h] -lemma insertionSort_filter {α : Type} (r : α → α → Prop) [DecidableRel r] [IsTotal α r] +lemma insertionSort_filter {α : Type} (r : α → α → Prop) [DecidableRel r] [Std.Total r] [IsTrans α r] (p : α → Prop) [DecidablePred p] : (l : List α) → List.insertionSort r (List.filter p l) = List.filter p (List.insertionSort r l) | [] => by simp | a :: l => by - simp only [List.insertionSort] + simp only [List.insertionSort_cons] by_cases h : p a · rw [orderedInsert_filter_of_pos] rw [List.filter_cons_of_pos] - simp only [List.insertionSort] + simp only [List.insertionSort_cons] rw [insertionSort_filter] simp_all only [decide_true] simp_all only - exact List.sorted_insertionSort r l + exact List.pairwise_insertionSort r l · rw [orderedInsert_filter_of_neg] rw [List.filter_cons_of_neg] rw [insertionSort_filter] @@ -487,11 +492,11 @@ lemma insertionSort_filter {α : Type} (r : α → α → Prop) [DecidableRel r] exact h lemma takeWhile_sorted_eq_filter {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTrans α r] (a : α) : (l : List α) → (hl : l.Sorted r) → + [IsTrans α r] (a : α) : (l : List α) → (hl : l.Pairwise r) → List.takeWhile (fun c => ¬ r a c) l = List.filter (fun c => ¬ r a c) l | [], _ => by simp | b :: l, hl => by - simp only [List.sorted_cons] at hl + simp only [List.pairwise_cons] at hl by_cases hb : ¬ r a b · simp only [decide_not, hb, decide_false, Bool.not_false, List.takeWhile_cons_of_pos, List.filter_cons_of_pos, List.cons.injEq, true_and] @@ -504,11 +509,11 @@ lemma takeWhile_sorted_eq_filter {α : Type} (r : α → α → Prop) [Decidable exact hl.1 c hc lemma dropWhile_sorted_eq_filter {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTrans α r] (a : α) : (l : List α) → (hl : l.Sorted r) → + [IsTrans α r] (a : α) : (l : List α) → (hl : l.Pairwise r) → List.dropWhile (fun c => ¬ r a c) l = List.filter (fun c => r a c) l | [], _ => by simp | b :: l, hl => by - simp only [List.sorted_cons] at hl + simp only [List.pairwise_cons] at hl by_cases hb : ¬ r a b · simp only [decide_not, hb, decide_false, Bool.not_false, List.dropWhile_cons_of_pos, Bool.false_eq_true, not_false_eq_true, List.filter_cons_of_neg] @@ -524,13 +529,13 @@ lemma dropWhile_sorted_eq_filter {α : Type} (r : α → α → Prop) [Decidable exact hl.1 c hc lemma dropWhile_sorted_eq_filter_filter {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTrans α r] (a : α) :(l : List α) → (hl : l.Sorted r) → + [IsTrans α r] (a : α) :(l : List α) → (hl : l.Pairwise r) → List.filter (fun c => r a c) l = List.filter (fun c => r a c ∧ r c a) l ++ List.filter (fun c => r a c ∧ ¬ r c a) l | [], _ => by simp | b :: l, hl => by - simp only [List.sorted_cons] at hl + simp only [List.pairwise_cons] at hl by_cases hb : ¬ r a b · simp only [hb, decide_false, Bool.false_eq_true, not_false_eq_true, List.filter_cons_of_neg, Bool.decide_and, Bool.false_and, decide_not] @@ -564,7 +569,7 @@ lemma dropWhile_sorted_eq_filter_filter {α : Type} (r : α → α → Prop) [De exact hl.2 lemma filter_rel_eq_insertionSort {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTotal α r] [IsTrans α r] (a : α) : (l : List α) → + [Std.Total r] [IsTrans α r] (a : α) : (l : List α) → List.filter (fun c => r a c ∧ r c a) (l.insertionSort r) = List.filter (fun c => r a c ∧ r c a) l | [] => by simp @@ -572,9 +577,9 @@ lemma filter_rel_eq_insertionSort {α : Type} (r : α → α → Prop) [Decidabl simp only [List.insertionSort] by_cases h : r a b ∧ r b a · have hl := orderedInsert_filter_of_pos r b (fun c => r a c ∧ r c a) h - (List.insertionSort r l) (by exact List.sorted_insertionSort r l) + (List.insertionSort r l) (by exact List.pairwise_insertionSort r l) simp only [Bool.decide_and] at hl ⊢ - rw [hl] + erw [hl] rw [List.orderedInsert_eq_take_drop] have ht : List.takeWhile (fun b_1 => decide ¬r b b_1) (List.filter (fun b => decide (r a b) && decide (r b a)) @@ -611,14 +616,14 @@ lemma filter_rel_eq_insertionSort {α : Type} (r : α → α → Prop) [Decidabl simp_all · have hl := orderedInsert_filter_of_neg r b (fun c => r a c ∧ r c a) h (List.insertionSort r l) simp only [Bool.decide_and] at hl ⊢ - rw [hl] + erw [hl] rw [List.filter_cons_of_neg] have ih := filter_rel_eq_insertionSort r a l simp_all only [not_and, Bool.decide_and] simpa using h lemma insertionSort_of_eq_list {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTotal α r] [IsTrans α r] (a : α) (l1 l l2 : List α) + [Std.Total r] [IsTrans α r] (a : α) (l1 l l2 : List α) (h : ∀ b ∈ l, r a b ∧ r b a) : List.insertionSort r (l1 ++ l ++ l2) = (List.takeWhile (fun c => ¬ r a c) ((l1 ++ l2).insertionSort r)) @@ -639,8 +644,8 @@ lemma insertionSort_of_eq_list {α : Type} (r : α → α → Prop) [DecidableRe List.append_left_eq_self, List.filter_eq_nil_iff, Bool.not_eq_eq_eq_not, Bool.not_true, decide_eq_false_iff_not, Decidable.not_not] exact fun b hb => (h b hb).1 - exact List.sorted_insertionSort r (l1 ++ l2) - exact List.sorted_insertionSort r (l1 ++ l ++ l2) + exact List.pairwise_insertionSort r (l1 ++ l2) + exact List.pairwise_insertionSort r (l1 ++ l ++ l2) conv_lhs => rw [hl, hlt] simp only [decide_not, Bool.decide_and] simp only [List.append_assoc, List.append_cancel_left_eq] @@ -669,11 +674,11 @@ lemma insertionSort_of_eq_list {α : Type} (r : α → α → Prop) [DecidableRe simp_all rw [hl] simp only [List.nil_append] - exact List.sorted_insertionSort r (l1 ++ (l ++ l2)) - exact List.sorted_insertionSort r (l1 ++ (l ++ l2)) + exact List.pairwise_insertionSort r (l1 ++ (l ++ l2)) + exact List.pairwise_insertionSort r (l1 ++ (l ++ l2)) lemma insertionSort_of_takeWhile_filter {α : Type} (r : α → α → Prop) [DecidableRel r] - [IsTotal α r] [IsTrans α r] (a : α) (l1 l2 : List α) : + [Std.Total r] [IsTrans α r] (a : α) (l1 l2 : List α) : List.insertionSort r (l1 ++ l2) = (List.takeWhile (fun c => ¬ r a c) ((l1 ++ l2).insertionSort r)) ++ (List.filter (fun c => r a c ∧ r c a) l1) diff --git a/PhysLean/Mathematics/SO3/Basic.lean b/PhysLean/Mathematics/SO3/Basic.lean index 246023438..f2e3f9406 100644 --- a/PhysLean/Mathematics/SO3/Basic.lean +++ b/PhysLean/Mathematics/SO3/Basic.lean @@ -27,13 +27,13 @@ instance SO3Group : Group SO3 where trans A.1 * ((B.1 * (B.1)ᵀ) * (A.1)ᵀ) · noncomm_ring · simp [B.2.2, A.2.2]⟩ - mul_assoc A B C := Subtype.eq (Matrix.mul_assoc A.1 B.1 C.1) + mul_assoc A B C := Subtype.ext (Matrix.mul_assoc A.1 B.1 C.1) one := ⟨1, det_one, by rw [transpose_one, mul_one]⟩ - one_mul A := Subtype.eq (Matrix.one_mul A.1) - mul_one A := Subtype.eq (Matrix.mul_one A.1) + one_mul A := Subtype.ext (Matrix.one_mul A.1) + mul_one A := Subtype.ext (Matrix.mul_one A.1) inv A := ⟨A.1ᵀ, by simp only [det_transpose, A.2], by simp only [transpose_transpose, mul_eq_one_comm.mpr A.2.2]⟩ - inv_mul_cancel A := Subtype.eq (mul_eq_one_comm.mpr A.2.2) + inv_mul_cancel A := Subtype.ext (mul_eq_one_comm.mpr A.2.2) /-- Notation for the group `SO3`. -/ scoped[GroupTheory] notation (name := SO3_notation) "SO(3)" => SO3 @@ -58,7 +58,7 @@ lemma subtype_val_eq_toGL : (Subtype.val : SO3 → Matrix (Fin 3) (Fin 3) ℝ) = /-- The inclusion of `SO(3)` into `GL(3,ℝ)` is an injection. -/ lemma toGL_injective : Function.Injective toGL := by - refine fun A B h ↦ Subtype.eq ?_ + refine fun A B h ↦ Subtype.ext ?_ rwa [@Units.ext_iff] at h /-- The inclusion of `SO(3)` into the monoid of matrices times the opposite of @@ -72,7 +72,7 @@ lemma toProd_eq_transpose : toProd A = (A.1, ⟨A.1ᵀ⟩) := rfl lemma toProd_injective : Function.Injective toProd := by intro A B h rw [toProd_eq_transpose, toProd_eq_transpose, Prod.mk_inj] at h - exact Subtype.eq h.1 + exact Subtype.ext h.1 lemma toProd_continuous : Continuous toProd := continuous_prodMk.mpr ⟨continuous_iff_le_induced.mpr fun _ a ↦ a, diff --git a/PhysLean/Mathematics/SchurTriangulation.lean b/PhysLean/Mathematics/SchurTriangulation.lean index 9e22da071..81eb6c360 100644 --- a/PhysLean/Mathematics/SchurTriangulation.lean +++ b/PhysLean/Mathematics/SchurTriangulation.lean @@ -131,6 +131,7 @@ equivalence is propositionally established by `Equiv.sumEquivSigmalCond`. variable [IsAlgClosed 𝕜] set_option maxHeartbeats 800000 in +set_option maxRecDepth 2000 in /-- **Don't use this definition directly.** This is the key algorithm behind `Matrix.schur_triangulation`. -/ protected noncomputable def SchurTriangulationAux.of diff --git a/PhysLean/Mathematics/Trigonometry/Tanh.lean b/PhysLean/Mathematics/Trigonometry/Tanh.lean index a095f267f..7a1e87a42 100644 --- a/PhysLean/Mathematics/Trigonometry/Tanh.lean +++ b/PhysLean/Mathematics/Trigonometry/Tanh.lean @@ -3,9 +3,9 @@ Copyright (c) 2025 Afiq Hatta. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Afiq Hatta -/ -import Mathlib.Analysis.Calculus.Deriv.Polynomial -import Mathlib.Analysis.Distribution.SchwartzSpace import Mathlib.Topology.Algebra.Polynomial +import Mathlib.Analysis.SpecialFunctions.Trigonometric.DerivHyp +import Mathlib.Analysis.Distribution.SchwartzSpace.Deriv /-! # Properties of Tanh We want to prove that the reflectionless potential is a Schwartz map. @@ -23,23 +23,6 @@ open NNReal open Field open scoped ContDiff -/-- tanh(x) is less than 1 for all x -/ -lemma tanh_lt_one (x : ℝ) : tanh x < 1 := by - rw [tanh_eq_sinh_div_cosh, div_lt_one (cosh_pos x)] - exact sinh_lt_cosh x - -/-- tanh(x) is greater than -1 for all x -/ -lemma minus_one_lt_tanh (x : ℝ) : -1 < tanh x := by - rw [tanh_eq_sinh_div_cosh, lt_div_iff₀ (cosh_pos x), ← sub_pos, neg_one_mul] - simp [exp_pos x] - -/-- The absolute value of tanh is bounded by 1 -/ -lemma abs_tanh_lt_one (x : ℝ) : |tanh x| < 1 := by - rw [abs_lt] - constructor - · exact minus_one_lt_tanh x - · exact tanh_lt_one x - /-- The derivative of tanh(x) is 1 - tanh(x)^2 -/ lemma deriv_tanh : deriv Real.tanh = fun x => 1 - Real.tanh x ^ 2 := by have h: deriv (sinh / cosh) = fun x => 1 - Real.tanh x ^ 2 := by @@ -125,7 +108,7 @@ lemma polynomial_tanh_bounded (P : Polynomial ℝ) : have h_range : ∀ x : ℝ, Real.tanh x ∈ Set.Icc (-1) 1 := by intro x constructor - · exact le_of_lt (minus_one_lt_tanh x) + · exact le_of_lt (neg_one_lt_tanh x) · exact le_of_lt (tanh_lt_one x) -- Apply polynomial boundedness on [-1, 1] obtain ⟨M, hM⟩ := polynomial_bounded_on_interval P (-1) 1 diff --git a/PhysLean/Mathematics/VariationalCalculus/Basic.lean b/PhysLean/Mathematics/VariationalCalculus/Basic.lean index 89b77c87d..497c38b2d 100644 --- a/PhysLean/Mathematics/VariationalCalculus/Basic.lean +++ b/PhysLean/Mathematics/VariationalCalculus/Basic.lean @@ -3,8 +3,6 @@ Copyright (c) 2025 Tomas Skrivan. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Tomas Skrivan, Joseph Tooby-Smith -/ -import Mathlib.MeasureTheory.Integral.Bochner.Basic -import Mathlib.Analysis.Calculus.BumpFunction.InnerProduct import PhysLean.Mathematics.VariationalCalculus.IsTestFunction /-! diff --git a/PhysLean/Mathematics/VariationalCalculus/HasVarAdjDeriv.lean b/PhysLean/Mathematics/VariationalCalculus/HasVarAdjDeriv.lean index 2e7b0d69c..0b9c25e6d 100644 --- a/PhysLean/Mathematics/VariationalCalculus/HasVarAdjDeriv.lean +++ b/PhysLean/Mathematics/VariationalCalculus/HasVarAdjDeriv.lean @@ -94,7 +94,7 @@ lemma smooth_adjoint {F : (X → U) → (X → V)} {F' : (X → V) → (X → U) lemma differentiable_linear {F : (X → U) → (X → V)} {F' : (X → V) → (X → U)} {u : X → U} (h : HasVarAdjDerivAt F F' u) {φ : ℝ → X → U} (hφ : ContDiff ℝ ∞ ↿φ) (x : X) : Differentiable ℝ (fun s' : ℝ => F (fun x => φ 0 x + s' • deriv (φ · x) 0) x) := by - exact fun x => (h.smooth_linear hφ).differentiable (ENat.LEInfty.out) x + exact fun x => (h.smooth_linear hφ).differentiable (by simp) x omit [MeasureSpace X] [InnerProductSpace' ℝ U] [InnerProductSpace' ℝ V] in lemma linearize_of_linear {F : (X → U) → (X → V)} @@ -117,7 +117,7 @@ lemma linearize_of_linear {F : (X → U) → (X → V)} fun_prop conv => enter [3, x] - rw [← fderiv_deriv] + rw [← fderiv_apply_one_eq_deriv] apply ContDiff.fderiv_apply (n := ∞) (m := ∞) fun_prop fun_prop @@ -125,7 +125,7 @@ lemma linearize_of_linear {F : (X → U) → (X → V)} simp · conv => enter [3, x] - rw [← fderiv_deriv] + rw [← fderiv_apply_one_eq_deriv] apply ContDiff.fderiv_apply (n := ∞) (m := ∞) repeat fun_prop simp @@ -249,11 +249,11 @@ lemma congr {F G : (X → U) → (Y → V)} {F' } {u : X → U} fun_prop conv => enter [3, x]; - rw [← fderiv_deriv] + rw [← fderiv_apply_one_eq_deriv] erw [fderiv_uncurry_comp_fst _ _ (hφ.differentiable (by simp))] simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, fderiv_eq_smul_deriv, one_smul] - rw [← fderiv_deriv] + rw [← fderiv_apply_one_eq_deriv] rw [DifferentiableAt.fderiv_prodMk (by fun_prop) (by fun_prop)] simp only [fderiv_id', fderiv_fun_const, Pi.zero_apply, ContinuousLinearMap.prod_apply, ContinuousLinearMap.coe_id', id_eq, ContinuousLinearMap.zero_apply] @@ -303,24 +303,24 @@ lemma prod [OpensMeasurableSpace X] [IsFiniteMeasureOnCompacts (volume (α := X) intro φ hφ x rw [@Prod.eq_iff_fst_eq_snd_eq] constructor - · rw [← fderiv_deriv, ← fderiv_deriv, DifferentiableAt.fderiv_prodMk, + · rw [← fderiv_apply_one_eq_deriv, ← fderiv_apply_one_eq_deriv, DifferentiableAt.fderiv_prodMk, DifferentiableAt.fderiv_prodMk] simp only [ContinuousLinearMap.prod_apply, fderiv_eq_smul_deriv, one_smul] rw [hF.linearize] · exact hφ · apply ContDiff.differentiable (n := ∞) _ (by simp) apply hF.smooth_R _ x - conv => enter [3, 1, x, y]; rw [← fderiv_deriv] + conv => enter [3, 1, x, y]; rw [← fderiv_apply_one_eq_deriv] fun_prop · apply ContDiff.differentiable (n := ∞) _ (by simp) apply hG.smooth_R _ x - conv => enter [3, 1, x, y]; rw [← fderiv_deriv] + conv => enter [3, 1, x, y]; rw [← fderiv_apply_one_eq_deriv] fun_prop · apply ContDiff.differentiable (n := ∞) _ (by simp) exact smooth_R hF hφ x · apply ContDiff.differentiable (n := ∞) _ (by simp) exact smooth_R hG hφ x - · rw [← fderiv_deriv, ← fderiv_deriv, DifferentiableAt.fderiv_prodMk, + · rw [← fderiv_apply_one_eq_deriv, ← fderiv_apply_one_eq_deriv, DifferentiableAt.fderiv_prodMk, DifferentiableAt.fderiv_prodMk] simp only [ContinuousLinearMap.prod_apply, fderiv_eq_smul_deriv, one_smul] rw [hG.linearize] @@ -342,7 +342,7 @@ lemma prod [OpensMeasurableSpace X] [IsFiniteMeasureOnCompacts (volume (α := X) · exact hG.adjoint intro φ hφ funext x - rw [← fderiv_deriv, ← fderiv_deriv, DifferentiableAt.fderiv_prodMk] + rw [← fderiv_apply_one_eq_deriv, ← fderiv_apply_one_eq_deriv, DifferentiableAt.fderiv_prodMk] simp only [ContinuousLinearMap.prod_apply, fderiv_eq_smul_deriv, one_smul] · apply ContDiff.differentiable (n := ∞) _ (by simp) apply hF.smooth_adjoint @@ -361,12 +361,12 @@ lemma fst {F : (X → U) → (X → W×V)} linearize := by intro φ hφ x have h1 := hF.linearize φ hφ x - rw [← fderiv_deriv, fderiv_comp'] + rw [← fderiv_apply_one_eq_deriv, fderiv_comp'] simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, fderiv_eq_smul_deriv, one_smul] rw [h1, fderiv_fst] simp only [ContinuousLinearMap.coe_fst'] conv_rhs => - rw [← fderiv_deriv] + rw [← fderiv_apply_one_eq_deriv] rw [fderiv_comp' _ (by fun_prop)] simp [fderiv_fst] · apply ContDiff.differentiable (n := ∞) (hF.smooth_linear hφ) (by simp) @@ -378,7 +378,7 @@ lemma fst {F : (X → U) → (X → W×V)} · exact HasVarAdjoint.fst hF.adjoint · intro φ hφ funext x - rw [← fderiv_deriv, fderiv_comp', fderiv_fst] + rw [← fderiv_apply_one_eq_deriv, fderiv_comp', fderiv_fst] simp only [ContinuousLinearMap.coe_comp', ContinuousLinearMap.coe_fst', Function.comp_apply, fderiv_eq_smul_deriv, one_smul] fun_prop @@ -396,12 +396,12 @@ lemma snd {F : (X → U) → (X → W×V)} linearize := by intro φ hφ x have h1 := hF.linearize φ hφ x - rw [← fderiv_deriv, fderiv_comp'] + rw [← fderiv_apply_one_eq_deriv, fderiv_comp'] simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, fderiv_eq_smul_deriv, one_smul] rw [h1, fderiv_snd] simp only [ContinuousLinearMap.coe_snd'] conv_rhs => - rw [← fderiv_deriv] + rw [← fderiv_apply_one_eq_deriv] rw [fderiv_comp' _ (by fun_prop)] simp [fderiv_snd] · apply ContDiff.differentiable (n := ∞) (hF.smooth_linear hφ) (by simp) @@ -413,7 +413,7 @@ lemma snd {F : (X → U) → (X → W×V)} · exact HasVarAdjoint.snd hF.adjoint · intro φ hφ funext x - rw [← fderiv_deriv, fderiv_comp', fderiv_snd] + rw [← fderiv_apply_one_eq_deriv, fderiv_comp', fderiv_snd] simp only [ContinuousLinearMap.coe_comp', ContinuousLinearMap.coe_snd', Function.comp_apply, fderiv_eq_smul_deriv, one_smul] fun_prop @@ -421,8 +421,6 @@ lemma snd {F : (X → U) → (X → W×V)} apply hF.smooth_adjoint exact IsTestFunction.contDiff hφ -attribute [fun_prop] differentiableAt_id' - lemma deriv' (u : ℝ → U) (hu : ContDiff ℝ ∞ u) : HasVarAdjDerivAt (fun φ : ℝ → U => deriv φ) (fun φ x => - deriv φ x) u where smooth_at := hu @@ -437,26 +435,24 @@ lemma deriv' (u : ℝ → U) (hu : ContDiff ℝ ∞ u) : apply Differentiable.const_smul conv => enter [2, x] - rw [← fderiv_deriv] + rw [← fderiv_apply_one_eq_deriv] apply fderiv_uncurry_differentiable_fst_comp_snd_apply - apply ContDiff.of_le hφ - exact ENat.LEInfty.out)] + exact hφ.of_le ENat.LEInfty.out)] rw [deriv_fun_const_smul _ (by conv => enter [2, x] - rw [← fderiv_deriv] - refine Differentiable.differentiableAt ?_ + rw [← fderiv_apply_one_eq_deriv] + apply Differentiable.differentiableAt apply fderiv_uncurry_differentiable_fst_comp_snd_apply - apply ContDiff.of_le hφ - exact ENat.LEInfty.out)] + exact hφ.of_le ENat.LEInfty.out)] simp only [differentiableAt_const, differentiableAt_fun_id, DifferentiableAt.fun_smul, deriv_fun_add, deriv_const', zero_add] rw [deriv_smul_const] simp only [deriv_id'', one_smul] - rw [← fderiv_deriv] + rw [← fderiv_apply_one_eq_deriv] conv_lhs => enter [1, 2, s] - rw [← fderiv_deriv] + rw [← fderiv_apply_one_eq_deriv] rw [fderiv_swap] simp only [fderiv_eq_smul_deriv, one_smul] · apply ContDiff.of_le hφ @@ -467,8 +463,8 @@ lemma deriv' (u : ℝ → U) (hu : ContDiff ℝ ∞ u) : · exact HasVarAdjoint.deriv · intro φ hφ funext x - have := hφ.smooth.differentiable (ENat.LEInfty.out) - have := hu.differentiable (ENat.LEInfty.out) + have := hφ.smooth.differentiable (by simp) + have := hu.differentiable (by simp) simp (disch:=fun_prop) conv_lhs => enter [1, x] @@ -590,16 +586,16 @@ lemma add intro φ hφ x; rw[deriv_fun_add]; rw[deriv_fun_add]; rw[hF.linearize _ hφ, hG.linearize _ hφ] · exact hF.differentiable_linear hφ x 0 · exact hG.differentiable_linear hφ x 0 - · apply ContDiff.differentiable _ ENat.LEInfty.out - have hf := hF.diff φ hφ - change ContDiff ℝ ∞ ((fun sx : ℝ × X => F (φ sx.1) sx.2) ∘ fun s' => (s', x)) - apply ContDiff.comp hf - fun_prop - · apply ContDiff.differentiable _ ENat.LEInfty.out - have hf := hG.diff φ hφ - change ContDiff ℝ ∞ ((fun sx : ℝ × X => G (φ sx.1) sx.2) ∘ fun s' => (s', x)) - apply ContDiff.comp hf - fun_prop + · change DifferentiableAt ℝ ((fun sx : ℝ × X => F (φ sx.1) sx.2) ∘ fun s' => (s', x)) 0 + apply DifferentiableAt.comp + · have hf := hF.diff φ hφ + apply ContDiff.differentiable hf (by simp) + · fun_prop + · change DifferentiableAt ℝ ((fun sx : ℝ × X => G (φ sx.1) sx.2) ∘ fun s' => (s', x)) 0 + apply DifferentiableAt.comp + · have hg := hG.diff φ hφ + apply ContDiff.differentiable hg (by simp) + · fun_prop adjoint := by apply HasVarAdjoint.congr_fun case h' => @@ -607,10 +603,10 @@ lemma add have := hφ.smooth; have := hF.smooth_at have h1 : DifferentiableAt ℝ (fun s => F (fun x' => u x' + s • φ x') x) (0 : ℝ) := (hF.smooth_R (φ:=fun s x' => u x' + s • φ x') (by fun_prop) x) - |>.differentiable ENat.LEInfty.out 0 + |>.differentiable (by simp) 0 have h2 : DifferentiableAt ℝ (fun s => G (fun x' => u x' + s • φ x') x) (0 : ℝ) := (hG.smooth_R (φ:=fun s x' => u x' + s • φ x') (by fun_prop) x) - |>.differentiable ENat.LEInfty.out 0 + |>.differentiable (by simp) 0 conv => lhs rw[deriv_fun_add h1 h2] @@ -669,16 +665,16 @@ lemma mul · simp · exact hF.differentiable_linear hφ x 0 · exact hG.differentiable_linear hφ x 0 - · apply ContDiff.differentiable _ ENat.LEInfty.out - have hf := hF.diff φ hφ - change ContDiff ℝ ∞ ((fun sx : ℝ × X => F (φ sx.1) sx.2) ∘ fun s' => (s', x)) - apply ContDiff.comp hf - fun_prop - · apply ContDiff.differentiable _ ENat.LEInfty.out - have hf := hG.diff φ hφ - change ContDiff ℝ ∞ ((fun sx : ℝ × X => G (φ sx.1) sx.2) ∘ fun s' => (s', x)) - apply ContDiff.comp hf - fun_prop + · change DifferentiableAt ℝ ((fun sx : ℝ × X => F (φ sx.1) sx.2) ∘ fun s' => (s', x)) 0 + apply DifferentiableAt.comp + · have hf := hF.diff φ hφ + apply ContDiff.differentiable hf (by simp) + · fun_prop + · change DifferentiableAt ℝ ((fun sx : ℝ × X => G (φ sx.1) sx.2) ∘ fun s' => (s', x)) 0 + apply DifferentiableAt.comp + · have hg := hG.diff φ hφ + apply ContDiff.differentiable hg (by simp) + · fun_prop adjoint := by apply HasVarAdjoint.congr_fun case h' => @@ -687,10 +683,10 @@ lemma mul -- Same two results as the `add` case have h1 : DifferentiableAt ℝ (fun s => F (fun x' => u x' + s • φ x') x) (0 : ℝ) := (hF.smooth_R (φ:=fun s x' => u x' + s • φ x') (by fun_prop) x) - |>.differentiable ENat.LEInfty.out 0 + |>.differentiable (by simp) 0 have h2 : DifferentiableAt ℝ (fun s => G (fun x' => u x' + s • φ x') x) (0 : ℝ) := (hG.smooth_R (φ:=fun s x' => u x' + s • φ x') (by fun_prop) x) - |>.differentiable ENat.LEInfty.out 0 + |>.differentiable (by simp) 0 conv => lhs rw[deriv_fun_mul h1 h2] @@ -699,17 +695,15 @@ lemma mul case h => apply HasVarAdjoint.add · apply HasVarAdjoint.mul_right - convert hF.adjoint - rw [deriv_smul_const] - simp only [deriv_id'', one_smul] - fun_prop - exact apply_smooth_self hG + · convert hF.adjoint + rw [deriv_smul_const, deriv_id'', one_smul] + fun_prop + · exact apply_smooth_self hG · apply HasVarAdjoint.mul_left - convert hG.adjoint - rw [deriv_smul_const] - simp only [deriv_id'', one_smul] - fun_prop - exact apply_smooth_self hF + · convert hG.adjoint + rw [deriv_smul_const, deriv_id'', one_smul] + fun_prop + · exact apply_smooth_self hF lemma const_mul (F : (X → U) → (X → ℝ)) (F') (u) @@ -770,7 +764,7 @@ protected lemma fderiv (u : X → U) (dx : X) (hu : ContDiff ℝ ∞ u) simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply] exact (hφ.differentiable (by simp)).differentiableAt · intro φ hφ x - rw [← fderiv_deriv] + rw [← fderiv_apply_one_eq_deriv] rw [fderiv_swap] simp only [fderiv_eq_smul_deriv, one_smul] · apply ContDiff.of_le hφ @@ -790,35 +784,37 @@ protected lemma fderiv' (F : (X → U) → (X → V)) (F') (u) (dx : X) protected lemma gradient {d} (u : Space d → ℝ) (hu : ContDiff ℝ ∞ u) : HasVarAdjDerivAt (fun (φ : Space d → ℝ) x => gradient φ x) - (fun ψ x => - Space.div ψ x) u := by + (fun ψ x => - Space.div (Space.basis.repr ∘ ψ) x) u := by apply hasVarAdjDerivAt_of_hasVarAdjoint_of_linear · intro φ hφ - simp [← Space.grad_eq_gradiant, Space.grad_eq_sum] + simp [Space.gradient_eq_sum] apply ContDiff.sum intro i _ - apply ContDiff.smul - simp [Space.deriv] - fun_prop + simp only [Space.deriv] fun_prop · intro φ1 φ2 h1 h2 - rw [← Space.grad_eq_gradiant] + rw [Space.gradient_eq_grad] rw [Space.grad_add, Space.grad_eq_gradiant, Space.grad_eq_gradiant] + simp + rfl · exact h1.differentiable (by simp) · exact h2.differentiable (by simp) · intro c φ hφ - rw [← Space.grad_eq_gradiant] + rw [Space.gradient_eq_grad] rw [Space.grad_smul, Space.grad_eq_gradiant] + simp + rfl exact hφ.differentiable (by simp) · intro φ hφ x - rw [← Space.grad_eq_gradiant, Space.grad_eq_sum] - conv_lhs => enter [1, x]; rw [← Space.grad_eq_gradiant, Space.grad_eq_sum] + rw [Space.gradient_eq_sum] + conv_lhs => enter [1, x]; rw [Space.gradient_eq_sum] rw [deriv_fun_sum] congr funext i rw [deriv_smul_const] congr simp [Space.deriv] - rw [← fderiv_deriv] + rw [← fderiv_apply_one_eq_deriv] rw [fderiv_swap] simp only [fderiv_eq_smul_deriv, smul_eq_mul, one_mul] · apply ContDiff.of_le hφ @@ -826,22 +822,64 @@ protected lemma gradient {d} (u : Space d → ℝ) (hu : ContDiff ℝ ∞ u) : · simp [Space.deriv] apply Differentiable.differentiableAt apply fderiv_uncurry_differentiable_snd_comp_fst_apply - apply ContDiff.of_le hφ - exact ENat.LEInfty.out + exact hφ.of_le ENat.LEInfty.out · intro i _ apply Differentiable.differentiableAt apply Differentiable.smul_const simp [Space.deriv] apply fderiv_uncurry_differentiable_snd_comp_fst_apply - apply ContDiff.of_le hφ - exact ENat.LEInfty.out + exact hφ.of_le ENat.LEInfty.out · exact hu · exact HasVarAdjoint.gradient -lemma div {d} (u : Space d → Space d) (hu : ContDiff ℝ ∞ u) : +protected lemma grad {d} (u : Space d → ℝ) (hu : ContDiff ℝ ∞ u) : HasVarAdjDerivAt - (fun (φ : Space d → Space d) x => Space.div φ x) - (fun ψ x => - gradient ψ x) u := by + (fun (φ : Space d → ℝ) x => Space.grad φ x) + (fun ψ x => - Space.div ψ x) u := by + apply hasVarAdjDerivAt_of_hasVarAdjoint_of_linear + · intro φ hφ + simp [Space.grad_eq_sum] + apply ContDiff.sum + intro i _ + simp only [Space.deriv] + fun_prop + · intro φ1 φ2 h1 h2 + rw [Space.grad_add] + · exact h1.differentiable (by simp) + · exact h2.differentiable (by simp) + · intro c φ hφ + rw [Space.grad_smul] + exact hφ.differentiable (by simp) + · intro φ hφ x + rw [Space.grad_eq_sum] + conv_lhs => enter [1, x]; rw [Space.grad_eq_sum] + rw [deriv_fun_sum] + congr + funext i + rw [deriv_smul_const] + congr + simp [Space.deriv] + rw [← fderiv_apply_one_eq_deriv] + rw [fderiv_swap] + simp only [fderiv_eq_smul_deriv, smul_eq_mul, one_mul] + · apply ContDiff.of_le hφ + exact ENat.LEInfty.out + · simp [Space.deriv] + apply Differentiable.differentiableAt + apply fderiv_uncurry_differentiable_snd_comp_fst_apply + exact hφ.of_le ENat.LEInfty.out + · intro i _ + apply Differentiable.differentiableAt + apply Differentiable.smul_const + simp [Space.deriv] + apply fderiv_uncurry_differentiable_snd_comp_fst_apply + exact hφ.of_le ENat.LEInfty.out + · exact hu + · exact HasVarAdjoint.grad +lemma div {d} (u : Space d → EuclideanSpace ℝ (Fin d)) (hu : ContDiff ℝ ∞ u) : + HasVarAdjDerivAt + (fun (φ : Space d → EuclideanSpace ℝ (Fin d)) x => Space.div φ x) + (fun ψ x => - Space.grad ψ x) u := by apply hasVarAdjDerivAt_of_hasVarAdjoint_of_linear · intro φ hφ simp [Space.div] @@ -862,29 +900,31 @@ lemma div {d} (u : Space d → Space d) (hu : ContDiff ℝ ∞ u) : congr funext i simp [Space.deriv] - rw [← fderiv_deriv] + rw [← fderiv_apply_one_eq_deriv] rw [fderiv_swap] simp only [fderiv_eq_smul_deriv, smul_eq_mul, one_mul] congr funext y - trans deriv (fun x' => Space.coordCLM i (φ x' y)) 0 - simp [Space.coordCLM_apply] - rw [← fderiv_deriv, fderiv_comp'] - simp [Space.coordCLM_apply] + trans deriv (EuclideanSpace.proj i ∘ fun x' => (φ x' y)) 0 + rfl + rw [← fderiv_apply_one_eq_deriv, fderiv_comp] + simp only [ContinuousLinearMap.fderiv, ContinuousLinearMap.coe_comp', Function.comp_apply, + PiLp.proj_apply] + rfl · fun_prop · apply function_differentiableAt_fst exact hφ.differentiable (by simp) - · apply ContDiff.comp (g := Space.coord i) - · change ContDiff ℝ 2 (Space.coordCLM i) + · apply ContDiff.comp (g := EuclideanSpace.proj i) + · change ContDiff ℝ 2 (EuclideanSpace.proj i) fun_prop · apply ContDiff.of_le hφ exact ENat.LEInfty.out · intro i _ apply Differentiable.differentiableAt simp [Space.deriv] - have h1 (s' : ℝ) : (fderiv ℝ (fun x => Space.coord i (φ s' x)) x) = - Space.coordCLM i ∘L (fderiv ℝ (fun x' => φ s' x') x) := by - trans (fderiv ℝ (fun x => Space.coordCLM i (φ s' x)) x) + have h1 (s' : ℝ) : (fderiv ℝ (fun x => EuclideanSpace.proj i (φ s' x)) x) = + EuclideanSpace.proj i ∘L (fderiv ℝ (fun x' => φ s' x') x) := by + trans (fderiv ℝ (fun x => EuclideanSpace.proj i (φ s' x)) x) rfl rw [fderiv_comp'] simp only [ContinuousLinearMap.fderiv] @@ -893,12 +933,11 @@ lemma div {d} (u : Space d → Space d) (hu : ContDiff ℝ ∞ u) : exact hφ.differentiable (by simp) conv => enter [2, s] - rw [h1] + erw [h1] simp only [ContinuousLinearMap.coe_comp', Function.comp_apply] apply Differentiable.comp · fun_prop apply fderiv_uncurry_differentiable_snd_comp_fst_apply - apply ContDiff.of_le hφ - exact ENat.LEInfty.out + exact hφ.of_le ENat.LEInfty.out · exact hu · exact HasVarAdjoint.div diff --git a/PhysLean/Mathematics/VariationalCalculus/HasVarAdjoint.lean b/PhysLean/Mathematics/VariationalCalculus/HasVarAdjoint.lean index 223cc5f85..f596c544f 100644 --- a/PhysLean/Mathematics/VariationalCalculus/HasVarAdjoint.lean +++ b/PhysLean/Mathematics/VariationalCalculus/HasVarAdjoint.lean @@ -679,7 +679,8 @@ lemma adjFDeriv_apply -- ext := IsLocalizedFunctionTransform.adjFDeriv protected lemma gradient {d} : - HasVarAdjoint (fun φ : Space d → ℝ => gradient φ) (fun φ x => - Space.div φ x) := by + HasVarAdjoint (fun φ : Space d → ℝ => gradient φ) + (fun φ x => - Space.div (Space.basis.repr ∘ φ) x) := by apply HasVarAdjoint.congr_fun (G := (fun φ => (adjFDeriv ℝ φ · 1))) · apply of_eq adjFDeriv_apply · intro φ hφ @@ -688,20 +689,39 @@ protected lemma gradient {d} : simp only [smul_eq_mul, mul_one] exact hφ.differentiable · apply IsLocalizedFunctionTransform.neg - apply IsLocalizedFunctionTransform.div + + apply IsLocalizedFunctionTransform.div_comp_repr · intro φ hφ funext x rw [gradient_eq_adjFDeriv] apply hφ.differentiable x -lemma div {d} : HasVarAdjoint (fun (φ : Space d → Space d) x => Space.div φ x) - (fun ψ x => - gradient ψ x) := by +lemma grad {d} : HasVarAdjoint (fun (φ : Space d → ℝ) x => Space.grad φ x) + (fun ψ x => - Space.div ψ x) := by + let f : Space d → Space d →L[ℝ] EuclideanSpace ℝ (Fin d) := fun x => + Space.basis.repr.toContinuousLinearMap + have h1 := clm_apply f (by fun_prop) + simp [f] at h1 + have hx : (_root_.adjoint ℝ (⇑Space.basis.repr)) = (Space.basis (d := d)).repr.symm := by + refine HasAdjoint.adjoint ?_ + refine { adjoint_inner_left := ?_ } + intro x y + rw [real_inner_comm, ← Space.basis_repr_inner_eq, real_inner_comm] + simp [hx] at h1 + have h2 := HasVarAdjoint.comp h1 (HasVarAdjoint.gradient (d := d)) + convert h2 using 1 + · funext x t + rw [Space.grad_eq_gradiant] + simp + +lemma div {d} : HasVarAdjoint (fun (φ : Space d → EuclideanSpace ℝ (Fin d)) x => Space.div φ x) + (fun ψ x => - Space.grad ψ x) := by apply HasVarAdjoint.of_neg apply HasVarAdjoint.symm simp only [neg_neg] - exact HasVarAdjoint.gradient + exact HasVarAdjoint.grad simp only [neg_neg] - exact IsLocalizedFunctionTransform.gradient + exact IsLocalizedFunctionTransform.grad lemma prod [IsFiniteMeasureOnCompacts (@volume X _)] [OpensMeasurableSpace X] diff --git a/PhysLean/Mathematics/VariationalCalculus/IsLocalizedfunctionTransform.lean b/PhysLean/Mathematics/VariationalCalculus/IsLocalizedfunctionTransform.lean index a48c52f27..cb2e48f5f 100644 --- a/PhysLean/Mathematics/VariationalCalculus/IsLocalizedfunctionTransform.lean +++ b/PhysLean/Mathematics/VariationalCalculus/IsLocalizedfunctionTransform.lean @@ -3,9 +3,7 @@ Copyright (c) 2025 Tomas Skrivan. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Tomas Skrivan, Joseph Tooby-Smith -/ -import Mathlib.Analysis.Calculus.LineDeriv.IntegrationByParts import PhysLean.Mathematics.VariationalCalculus.Basic -import PhysLean.SpaceAndTime.Space.VectorIdentities /-! # Localized function transforms @@ -139,14 +137,43 @@ lemma smul_left [NormedAddCommGroup V] [NormedSpace ℝ V] {F : (X → U) → (X · simp_all · simp_all -lemma div {d} : IsLocalizedFunctionTransform fun (φ : Space d → Space d) x => Space.div φ x := by +lemma div {d} : IsLocalizedFunctionTransform fun (φ : Space d → EuclideanSpace ℝ (Fin d)) x => + Space.div φ x := by intro K cK use (Metric.cthickening 1 K) constructor · exact IsCompact.cthickening cK · intro φ φ' hφ have h : ∀ (i : Fin d), ∀ x ∈ K, - (fun x => Space.coord i (φ x)) =ᶠ[nhds x] fun x => Space.coord i (φ' x) := by + (fun x => (φ x) i) =ᶠ[nhds x] fun x => (φ' x) i := by + intro i x hx + apply Filter.eventuallyEq_of_mem (s := Metric.thickening 1 K) + refine mem_interior_iff_mem_nhds.mp ?_ + rw [@mem_interior] + use Metric.thickening 1 K + simp only [subset_refl, true_and] + apply And.intro + · exact Metric.isOpen_thickening + · rw [@Metric.mem_thickening_iff_exists_edist_lt] + use x + simpa using hx + · intro x hx + have hx' : x ∈ Metric.cthickening 1 K := Metric.thickening_subset_cthickening 1 K hx + simp_all + intro x hx; dsimp; + simp [Space.div,Space.deriv] + congr; funext i; congr 1 + exact Filter.EventuallyEq.fderiv_eq (h _ _ hx) + +lemma div_comp_repr {d} : IsLocalizedFunctionTransform fun (φ : Space d → Space d) x => + Space.div (Space.basis.repr ∘ φ) x := by + intro K cK + use (Metric.cthickening 1 K) + constructor + · exact IsCompact.cthickening cK + · intro φ φ' hφ + have h : ∀ (i : Fin d), ∀ x ∈ K, + (fun x => (φ x) i) =ᶠ[nhds x] fun x => (φ' x) i := by intro i x hx apply Filter.eventuallyEq_of_mem (s := Metric.thickening 1 K) refine mem_interior_iff_mem_nhds.mp ?_ @@ -173,7 +200,7 @@ lemma grad : IsLocalizedFunctionTransform fun (ψ : Space d → ℝ) x => Space. · exact IsCompact.cthickening cK · intro φ φ' hφ x hx dsimp - simp [Space.grad_eq_sum,Space.deriv] + simp [Space.grad_eq_sum, Space.deriv] congr funext i congr 2 @@ -193,10 +220,30 @@ lemma grad : IsLocalizedFunctionTransform fun (ψ : Space d → ℝ) x => Space. simp_all lemma gradient : IsLocalizedFunctionTransform fun (ψ : Space d → ℝ) x => gradient ψ x := by - conv => - enter [1, ψ, x] - rw [← Space.grad_eq_gradiant] - exact grad + intro K cK + use (Metric.cthickening 1 K) + constructor + · exact IsCompact.cthickening cK + · intro φ φ' hφ x hx + dsimp + simp [Space.gradient_eq_sum,Space.deriv] + congr + funext i + congr 2 + refine Filter.EventuallyEq.fderiv_eq ?_ + apply Filter.eventuallyEq_of_mem (s := Metric.thickening 1 K) + refine mem_interior_iff_mem_nhds.mp ?_ + rw [@mem_interior] + use Metric.thickening 1 K + simp only [subset_refl, true_and] + apply And.intro + · exact Metric.isOpen_thickening + · rw [@Metric.mem_thickening_iff_exists_edist_lt] + use x + simpa using hx + · intro x hx + have hx' : x ∈ Metric.cthickening 1 K := Metric.thickening_subset_cthickening 1 K hx + simp_all lemma clm_apply [NormedAddCommGroup V] [NormedSpace ℝ V] [NormedAddCommGroup U] [NormedSpace ℝ U] (f : X → (U →L[ℝ] V)) : IsLocalizedFunctionTransform fun φ x => (f x) (φ x) := by diff --git a/PhysLean/Mathematics/VariationalCalculus/IsTestFunction.lean b/PhysLean/Mathematics/VariationalCalculus/IsTestFunction.lean index 62eb41859..8b21454c0 100644 --- a/PhysLean/Mathematics/VariationalCalculus/IsTestFunction.lean +++ b/PhysLean/Mathematics/VariationalCalculus/IsTestFunction.lean @@ -3,8 +3,6 @@ Copyright (c) 2025 Tomas Skrivan. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Tomas Skrivan, Joseph Tooby-Smith -/ -import Mathlib.Analysis.Calculus.Deriv.Support -import Mathlib.MeasureTheory.Function.LocallyIntegrable import PhysLean.Mathematics.Calculus.Divergence /-! @@ -48,7 +46,7 @@ lemma IsTestFunction.integrable [MeasurableSpace X] [OpensMeasurableSpace X] @[fun_prop] lemma IsTestFunction.differentiable {f : X → U} (hf : IsTestFunction f) : - Differentiable ℝ f := hf.1.differentiable ENat.LEInfty.out + Differentiable ℝ f := hf.1.differentiable (by simp) @[fun_prop] lemma IsTestFunction.contDiff {f : X → U} (hf : IsTestFunction f) : @@ -312,7 +310,7 @@ lemma IsTestFunction.gradient {d : ℕ} (φ : Space d → ℝ) fun_prop @[fun_prop] -lemma IsTestFunction.of_div {d : ℕ} (φ : Space d → Space d) +lemma IsTestFunction.of_div {d : ℕ} (φ : Space d → EuclideanSpace ℝ (Fin d)) (hφ : IsTestFunction φ) : IsTestFunction (Space.div φ) := by unfold Space.div Space.deriv; dsimp; fun_prop (disch:=simp) diff --git a/PhysLean/Meta/Basic.lean b/PhysLean/Meta/Basic.lean index 9d2d0bc48..00964ea57 100644 --- a/PhysLean/Meta/Basic.lean +++ b/PhysLean/Meta/Basic.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license. Authors: Joseph Tooby-Smith -/ import Mathlib.Lean.Expr.Basic -import Lean.Elab.PreDefinition.Structural.BRecOn +import ImportGraph.Imports.RequiredModules /-! ## Basic Lean meta programming commands @@ -137,7 +137,8 @@ def getDeclString (name : Name) : CoreM String := do | some fileName => let fileContent ← IO.FS.readFile fileName.toRelativeFilePath let fileMap := fileContent.toFileMap - return fileMap.source.extract (fileMap.ofPosition pos) (fileMap.ofPosition endPos) + return (String.Pos.Raw.extract fileMap.source) + (fileMap.ofPosition pos) (fileMap.ofPosition endPos) | none => return "" | none => return "" diff --git a/PhysLean/Meta/Linters/Sorry.lean b/PhysLean/Meta/Linters/Sorry.lean index 732ae3cbb..eb360e432 100644 --- a/PhysLean/Meta/Linters/Sorry.lean +++ b/PhysLean/Meta/Linters/Sorry.lean @@ -59,7 +59,7 @@ def addSorryfulEntry {m : Type → Type} [MonadEnv m] /-! -## The `psudo` environment extension +## The `pseudo` environment extension -/ diff --git a/PhysLean/Optics/Polarization/Basic.lean b/PhysLean/Optics/Polarization/Basic.lean index afb2613da..f795c278e 100644 --- a/PhysLean/Optics/Polarization/Basic.lean +++ b/PhysLean/Optics/Polarization/Basic.lean @@ -3,8 +3,7 @@ Copyright (c) 2025 Zhi Kai Pong. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Zhi Kai Pong -/ -import PhysLean.ClassicalMechanics.WaveEquation.HarmonicWave -import PhysLean.Electromagnetism.Vacuum.Wave +import PhysLean.Electromagnetism.Vacuum.HarmonicWave /-! # Polarization @@ -16,100 +15,8 @@ time-harmonic electromagnetic plane waves. More general definitions that can be applied to a wider range of situations will be shown to be equivalent to the definitions in this file where appropriate. --/ - -/-! - -## Monochromatic wave - --/ - -namespace Optics -open ClassicalMechanics -open Electromagnetism -open Real - -/-- x-component of monochromatic time-harmonic wave. -/ -noncomputable def monochromX (k : WaveVector) (E₀x ω δx : ℝ) := - harmonicWave (fun _ _ => E₀x) (fun _ r => inner ℝ k r - δx) (fun _ => ω) k - -/-- y-component of monochromatic time-harmonic wave. -/ -noncomputable def monochromY (k : WaveVector) (E₀y ω δy : ℝ) := - harmonicWave (fun _ _ => E₀y) (fun _ r => inner ℝ k r - δy) (fun _ => ω) k - -set_option linter.unusedVariables false in -/-- General form of monochromatic time-harmonic electromagnetic plane wave where - the direction of propagation is taken to be `EuclideanSpace.single 2 1`. - `E₀x` and `E₀y` are the respective amplitudes, `ω` is the angular frequency, - `δx` and `δy` are the respective phases for `Ex` and `Ey`. -/ -@[nolint unusedArguments] -noncomputable def harmonicElectromagneticPlaneWave (k : WaveVector) (E₀x E₀y ω δx δy : ℝ) - (hk : k = EuclideanSpace.single 2 (ω/c)) : - ElectricField := - fun t r => monochromX k E₀x ω δx t r • EuclideanSpace.single 0 1 + - monochromY k E₀y ω δy t r • EuclideanSpace.single 1 1 - -/-- The transverse harmonic planewave representation is equivalent to the general electric field - planewave expression with `‖k‖ = ω/c`. -/ -lemma harmonicElectromagneticPlaneWave_eq_electricplaneWave {c : ℝ} {k : WaveVector} - {E₀x E₀y ω δx δy : ℝ} (hc_ge_zero : 0 < c) (hω_ge_zero : 0 < ω) - (hk : k = EuclideanSpace.single 2 (ω/c)) : - (harmonicElectromagneticPlaneWave k E₀x E₀y ω δx δy hk) = electricPlaneWave - (fun p => (E₀x * cos (-(ω/c)*p + δx)) • (EuclideanSpace.single 0 1) + - (E₀y * cos (-(ω/c)*p + δy)) • (EuclideanSpace.single 1 1)) c - (WaveVector.toDirection k (by rw [hk]; simp [ne_of_gt, hc_ge_zero, hω_ge_zero])) := by - unfold harmonicElectromagneticPlaneWave monochromX monochromY electricPlaneWave - trans transverseHarmonicPlaneWave k E₀x E₀y ω δx δy hk - rfl - rw [transverseHarmonicPlaneWave_eq_planeWave hc_ge_zero hω_ge_zero] - -/-! - -## Polarization ellipse +The material that was in this file has been moved to +`PhysLean.Electromagnetism.Vacuum.HarmonicWave` for better organization. +This file is kept because there is still some material to be added here in the future. -/ - -variable {k : WaveVector} {E₀x E₀y τ ω δx δy : ℝ} {t : Time} {r : Space} - -/-- `monochromX` is equivalent to `E₀x * cos (τ + δx)` with `τ = ω * t - inner ℝ k r`. -/ -lemma eq_monochromX (h : τ = ω * t - inner ℝ k r) : - monochromX k E₀x ω δx t r = E₀x * cos (τ + δx) := by - rw [h, monochromX, harmonicWave, sub_add] - -/-- `monochromY` is equivalent to `E₀y * cos (τ + δy)` with `τ = ω * t - inner ℝ k r`. -/ -lemma eq_monochromY (h : τ = ω * t - inner ℝ k r) : - monochromY k E₀y ω δy t r = E₀y * cos (τ + δy) := by - rw [h, monochromY, harmonicWave, sub_add] - -local notation "Ex" => monochromX k E₀x ω δx t r -local notation "Ey" => monochromY k E₀y ω δy t r - -/-- The locus of the electric field vector of an monochromatic time-harmonic - electromagnetic plane wave is an ellipse. -/ -theorem polarizationEllipse (hx : E₀x ≠ 0) (hy : E₀y ≠ 0) (h : τ = ω * t - inner ℝ k r) : - (Ex / E₀x)^2 + (Ey / E₀y)^2 - 2 * (Ex / E₀x) * (Ey / E₀y) * cos (δy - δx) = - sin (δy - δx) ^ 2 := by - rw [eq_monochromX h, eq_monochromY h] - have h1 : (E₀x * cos (τ + δx)) / E₀x * sin δy - (E₀y * cos (τ + δy)) / E₀y * sin δx = - cos τ * sin (δy - δx) := by - field_simp - rw [cos_add, cos_add, sin_sub] - ring - have h2 : (E₀x * cos (τ + δx)) / E₀x * cos δy - (E₀y * cos (τ + δy)) / E₀y * cos δx = - sin τ * sin (δy - δx) := by - field_simp - rw [cos_add, cos_add, sin_sub] - ring - trans (E₀x * cos (τ + δx) / E₀x) ^ 2 * (sin δy ^ 2 + cos δy ^ 2) + - (E₀y * cos (τ + δy) / E₀y) ^ 2 * (sin δx ^ 2 + cos δx ^ 2) - - 2 * (E₀x * cos (τ + δx) / E₀x) * (E₀y * cos (τ + δy) / E₀y) * cos (δy - δx) - · simp - trans (cos τ * sin (δy - δx)) ^ 2 + (sin τ * sin (δy - δx)) ^ 2 - · rw [← h1, ← h2] - rw [cos_sub] - ring - trans (cos τ ^ 2 + sin τ ^ 2) * sin (δy - δx) ^ 2 - · ring - simp - -end Optics diff --git a/PhysLean/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/PlaneNonSols.lean b/PhysLean/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/PlaneNonSols.lean index 21b5c4414..5e5f80a60 100644 --- a/PhysLean/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/PlaneNonSols.lean +++ b/PhysLean/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/PlaneNonSols.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Particles.BeyondTheStandardModel.RHN.AnomalyCancellation.PlusU1.Basic +import Mathlib.Tactic.LinearCombination /-! # Plane of non-solutions diff --git a/PhysLean/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSol.lean b/PhysLean/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSol.lean index 420028001..be28e671d 100644 --- a/PhysLean/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSol.lean +++ b/PhysLean/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSol.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Particles.BeyondTheStandardModel.RHN.AnomalyCancellation.PlusU1.Basic -import Mathlib.Tactic.FieldSimp /-! # Properties of Quad Sols for SM with RHN @@ -71,7 +70,7 @@ lemma genericToQuad_on_quad (S : (PlusU1 n).QuadSols) : rw [α₂_AFQ] simp -lemma genericToQuad_neq_zero (S : (PlusU1 n).QuadSols) (h : α₁ C S.1 ≠ 0) : +lemma genericToQuad_ne_zero (S : (PlusU1 n).QuadSols) (h : α₁ C S.1 ≠ 0) : (α₁ C S.1)⁻¹ • genericToQuad C S.1 = S := by rw [genericToQuad_on_quad, smul_smul, Rat.inv_mul_cancel _ h, one_smul] @@ -125,7 +124,7 @@ lemma toQuadInv_generic (S : (PlusU1 n).QuadSols) (h : α₁ C S.1 ≠ 0) : (toQuadInv C S).2.1 • genericToQuad C (toQuadInv C S).1 = S := by simp only [toQuadInv_fst] rw [show (toQuadInv C S).2.1 = (α₁ C S.1)⁻¹ by rw [toQuadInv, if_neg h]] - rw [genericToQuad_neq_zero C S h] + rw [genericToQuad_ne_zero C S h] lemma toQuad_rightInverse : Function.RightInverse (@toQuadInv n C) (toQuad C) := by intro S diff --git a/PhysLean/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSolToSol.lean b/PhysLean/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSolToSol.lean index 5168eae15..5d7c45b69 100644 --- a/PhysLean/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSolToSol.lean +++ b/PhysLean/Particles/BeyondTheStandardModel/RHN/AnomalyCancellation/PlusU1/QuadSolToSol.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Particles.BeyondTheStandardModel.RHN.AnomalyCancellation.PlusU1.BMinusL -import Mathlib.Tactic.FieldSimp /-! # Solutions from quad solutions @@ -110,7 +109,7 @@ lemma quadSolToSolInv_α₁_α₂_zero (S : (PlusU1 n).Sols) (h : α₁ S.1 = 0) rw [quadSolToSolInv_1, α₂_AF S, h] exact Prod.mk_eq_zero.mp rfl -lemma quadSolToSolInv_α₁_α₂_neq_zero (S : (PlusU1 n).Sols) (h : α₁ S.1 ≠ 0) : +lemma quadSolToSolInv_α₁_α₂_ne_zero (S : (PlusU1 n).Sols) (h : α₁ S.1 ≠ 0) : ¬ (α₁ (quadSolToSolInv S).1 = 0 ∧ α₂ (quadSolToSolInv S).1 = 0) := by rw [not_and, quadSolToSolInv_1, α₂_AF S] intro hn @@ -135,7 +134,7 @@ lemma quadSolToSolInv_rightInverse : Function.RightInverse (@quadSolToSolInv n) by_cases h : α₁ S.1 = 0 · rw [quadSolToSol, dif_pos (quadSolToSolInv_α₁_α₂_zero S h)] exact quadSolToSolInv_special S h - · rw [quadSolToSol, dif_neg (quadSolToSolInv_α₁_α₂_neq_zero S h)] + · rw [quadSolToSol, dif_neg (quadSolToSolInv_α₁_α₂_ne_zero S h)] exact quadSolToSolInv_generic S h theorem quadSolToSol_surjective : Function.Surjective (@quadSolToSol n) := diff --git a/PhysLean/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean b/PhysLean/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean index 28b0f07dc..c4833f8ce 100644 --- a/PhysLean/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean +++ b/PhysLean/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean @@ -4,229 +4,75 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Particles.StandardModel.HiggsBoson.Potential +import Mathlib.Analysis.Matrix.Normed +import Mathlib.Analysis.Matrix.Order /-! # The Two Higgs Doublet Model The two Higgs doublet model is the standard model plus an additional Higgs doublet. -Currently this file contains the definition of the 2HDM potential. +## i. Overview --/ +The two Higgs doublet model (2HDM) is an extension of the Standard Model which adds a second Higgs +doublet. + +## References -namespace TwoHDM +- https://arxiv.org/abs/hep-ph/0605184 +- https://arxiv.org/abs/1605.03237 + +-/ open StandardModel -open ComplexConjugate -open HiggsField - -noncomputable section - -TODO "6V2TZ" "Within the definition of the 2HDM potential. The structure `Potential` should be - renamed to TwoHDM and moved out of the TwoHDM namespace. - Then `toFun` should be renamed to `potential`." - -/-- The parameters of the Two Higgs doublet model potential. -/ -structure Potential where - /-- The parameter corresponding to `m₁₁²` in the 2HDM potential. -/ - m₁₁2 : ℝ - /-- The parameter corresponding to `m₂₂²` in the 2HDM potential. -/ - m₂₂2 : ℝ - /-- The parameter corresponding to `m₁₂²` in the 2HDM potential. -/ - m₁₂2 : ℂ - /-- The parameter corresponding to `λ₁` in the 2HDM potential. -/ - 𝓵₁ : ℝ - /-- The parameter corresponding to `λ₂` in the 2HDM potential. -/ - 𝓵₂ : ℝ - /-- The parameter corresponding to `λ₃` in the 2HDM potential. -/ - 𝓵₃ : ℝ - /-- The parameter corresponding to `λ₄` in the 2HDM potential. -/ - 𝓵₄ : ℝ - /-- The parameter corresponding to `λ₅` in the 2HDM potential. -/ - 𝓵₅ : ℂ - /-- The parameter corresponding to `λ₆` in the 2HDM potential. -/ - 𝓵₆ : ℂ - /-- The parameter corresponding to `λ₇` in the 2HDM potential. -/ - 𝓵₇ : ℂ - -namespace Potential - -variable (P : Potential) (Φ1 Φ2 : HiggsField) -open InnerProductSpace -/-- The potential of the two Higgs doublet model. -/ -def toFun (Φ1 Φ2 : HiggsField) (x : SpaceTime) : ℝ := - P.m₁₁2 * ‖Φ1‖_H^2 x + P.m₂₂2 * ‖Φ2‖_H^2 x - - (P.m₁₂2 * ⟪Φ1, Φ2⟫_(SpaceTime → ℂ) x + conj P.m₁₂2 * ⟪Φ2, Φ1⟫_(SpaceTime → ℂ) x).re - + 1/2 * P.𝓵₁ * ‖Φ1‖_H^2 x * ‖Φ1‖_H^2 x + 1/2 * P.𝓵₂ * ‖Φ2‖_H^2 x * ‖Φ2‖_H^2 x - + P.𝓵₃ * ‖Φ1‖_H^2 x * ‖Φ2‖_H^2 x - + P.𝓵₄ * ‖⟪Φ1, Φ2⟫_(SpaceTime → ℂ) x‖ ^ 2 - + (1/2 * P.𝓵₅ * ⟪Φ1, Φ2⟫_(SpaceTime → ℂ) x ^ 2 + - 1/2 * conj P.𝓵₅ * ⟪Φ2, Φ1⟫_(SpaceTime → ℂ) x ^ 2).re - + (P.𝓵₆ * ‖Φ1‖_H^2 x * ⟪Φ1, Φ2⟫_(SpaceTime → ℂ) x + - conj P.𝓵₆ * ‖Φ1‖_H^2 x * ⟪Φ2, Φ1⟫_(SpaceTime → ℂ) x).re - + (P.𝓵₇ * ‖Φ2‖_H^2 x * ⟪Φ1, Φ2⟫_(SpaceTime → ℂ) x + - conj P.𝓵₇ * ‖Φ2‖_H^2 x * ⟪Φ2, Φ1⟫_(SpaceTime → ℂ) x).re - -/-- The potential where all parameters are zero. -/ -def zero : Potential := ⟨0, 0, 0, 0, 0, 0, 0, 0, 0, 0⟩ - -lemma swap_fields : P.toFun Φ1 Φ2 = - (Potential.mk P.m₂₂2 P.m₁₁2 (conj P.m₁₂2) P.𝓵₂ P.𝓵₁ P.𝓵₃ P.𝓵₄ - (conj P.𝓵₅) (conj P.𝓵₇) (conj P.𝓵₆)).toFun Φ2 Φ1 := by - funext x - simp only [toFun, normSq, Complex.add_re, Complex.mul_re, Complex.conj_re, Complex.conj_im, - neg_mul, sub_neg_eq_add, one_div, Complex.inv_re, Complex.re_ofNat, Complex.normSq_ofNat, - div_self_mul_self', Complex.inv_im, Complex.im_ofNat, neg_zero, zero_div, zero_mul, sub_zero, - Complex.mul_im, add_zero, mul_neg, Complex.ofReal_pow, RingHomCompTriple.comp_apply, - RingHom.id_apply] - ring_nf - simp only [one_div, add_left_inj, add_right_inj, mul_eq_mul_left_iff] - left - rw [← inner_symm] - simp - -/-- If `Φ₂` is zero the potential reduces to the Higgs potential on `Φ₁`. -/ -lemma right_zero : P.toFun Φ1 0 = - (HiggsField.Potential.mk (- P.m₁₁2) (P.𝓵₁/2)).toFun Φ1 := by - funext x - simp only [toFun, normSq, ContMDiffSection.coe_zero, Pi.zero_apply, norm_zero, ne_eq, - OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, mul_zero, add_zero, - HiggsField.inner_zero_right, HiggsField.inner_zero_left, Complex.zero_re, sub_zero, one_div, - Complex.ofReal_pow, Complex.ofReal_zero, HiggsField.Potential.toFun, neg_neg, add_right_inj, - mul_eq_mul_right_iff, pow_eq_zero_iff, norm_eq_zero, or_self_right] - ring_nf - simp only [true_or] - -/-- If `Φ₁` is zero the potential reduces to the Higgs potential on `Φ₂`. -/ -lemma left_zero : P.toFun 0 Φ2 = - (HiggsField.Potential.mk (- P.m₂₂2) (P.𝓵₂/2)).toFun Φ2 := by - rw [swap_fields, right_zero] - -/-- Negating `Φ₁` is equivalent to negating `m₁₂2`, `𝓵₆` and `𝓵₇`. -/ -lemma neg_left : P.toFun (- Φ1) Φ2 - = (Potential.mk P.m₁₁2 P.m₂₂2 (- P.m₁₂2) P.𝓵₁ P.𝓵₂ P.𝓵₃ P.𝓵₄ P.𝓵₅ (- P.𝓵₆) (- P.𝓵₇)).toFun - Φ1 Φ2 := by - funext x - simp only [toFun, normSq, ContMDiffSection.coe_neg, Pi.neg_apply, norm_neg, - HiggsField.inner_neg_left, mul_neg, HiggsField.inner_neg_right, Complex.add_re, Complex.neg_re, - Complex.mul_re, neg_sub, Complex.conj_re, Complex.conj_im, neg_mul, sub_neg_eq_add, neg_add_rev, - one_div, even_two, Even.neg_pow, Complex.inv_re, Complex.re_ofNat, Complex.normSq_ofNat, - div_self_mul_self', Complex.inv_im, Complex.im_ofNat, neg_zero, zero_div, zero_mul, sub_zero, - Complex.mul_im, add_zero, Complex.ofReal_pow, map_neg] - -/-- Negating `Φ₁` is equivalent to negating `m₁₂2`, `𝓵₆` and `𝓵₇`. -/ -lemma neg_right : P.toFun Φ1 (- Φ2) - = (Potential.mk P.m₁₁2 P.m₂₂2 (- P.m₁₂2) P.𝓵₁ P.𝓵₂ P.𝓵₃ P.𝓵₄ P.𝓵₅ (- P.𝓵₆) (- P.𝓵₇)).toFun - Φ1 Φ2 := by - rw [swap_fields, neg_left, swap_fields] - simp only [map_neg, RingHomCompTriple.comp_apply, RingHom.id_apply] - -lemma left_eq_right : P.toFun Φ1 Φ1 = - (HiggsField.Potential.mk (- P.m₁₁2 - P.m₂₂2 + 2 * P.m₁₂2.re) - (P.𝓵₁/2 + P.𝓵₂/2 + P.𝓵₃ + P.𝓵₄ + P.𝓵₅.re + 2 * P.𝓵₆.re + 2 * P.𝓵₇.re)).toFun Φ1 := by - funext x - simp only [toFun, normSq, inner_self_eq_normSq, Complex.ofReal_pow, Complex.add_re, - Complex.mul_re, Complex.conj_re, Complex.conj_im, neg_mul, sub_neg_eq_add, sub_add_add_cancel, - one_div, norm_pow, Complex.norm_real, norm_norm, Complex.inv_re, Complex.re_ofNat, - Complex.normSq_ofNat, div_self_mul_self', Complex.inv_im, Complex.im_ofNat, neg_zero, zero_div, - zero_mul, sub_zero, Complex.mul_im, add_zero, mul_neg, HiggsField.Potential.toFun, neg_add_rev, - neg_sub] - ring_nf - rw [show ((Complex.ofReal ‖Φ1 x‖) ^ 4).re = ‖Φ1 x‖ ^ 4 by - rw [← Complex.ofReal_pow]; rfl] - rw [show ((Complex.ofReal ‖Φ1 x‖) ^ 2).re = ‖Φ1 x‖ ^ 2 by - rw [← Complex.ofReal_pow]; rfl] - rw [show (Complex.ofReal ‖Φ1 x‖ ^ 2).im = 0 by - rw [← Complex.ofReal_pow, Complex.ofReal_im]] - ring - -lemma left_eq_neg_right : P.toFun Φ1 (- Φ1) = - (HiggsField.Potential.mk (- P.m₁₁2 - P.m₂₂2 - 2 * P.m₁₂2.re) - (P.𝓵₁/2 + P.𝓵₂/2 + P.𝓵₃ + P.𝓵₄ + P.𝓵₅.re - 2 * P.𝓵₆.re - 2 * P.𝓵₇.re)).toFun Φ1 := by - rw [neg_right, left_eq_right] - simp_all only [Complex.neg_re, mul_neg] - rfl +/-! + +## A. The configuration space + +-/ +/-- The configuration space of the two Higgs doublet model. + In otherwords, the underlying vector space associated with the model. -/ +structure TwoHiggsDoublet where + /-- The first Higgs doublet. -/ + Φ1 : HiggsVec + /-- The second Higgs doublet. -/ + Φ2 : HiggsVec + +namespace TwoHiggsDoublet + +open InnerProductSpace + +@[ext] +lemma ext_of_fst_snd {H1 H2 : TwoHiggsDoublet} + (h1 : H1.Φ1 = H2.Φ1) (h2 : H1.Φ2 = H2.Φ2) : H1 = H2 := by + cases H1 + cases H2 + congr /-! -## Potential bounded from below +## B. Gauge group actions -/ -TODO "6V2UD" "Prove bounded properties of the 2HDM potential. - See e.g. https://inspirehep.net/literature/201299 and - https://arxiv.org/pdf/hep-ph/0605184." - -/-- The proposition on the coefficients for a potential to be bounded. -/ -def IsBounded : Prop := - ∃ c, ∀ Φ1 Φ2 x, c ≤ P.toFun Φ1 Φ2 x - -section IsBounded - -variable {P : Potential} - -lemma isBounded_right_zero (h : P.IsBounded) : - (HiggsField.Potential.mk (- P.m₁₁2) (P.𝓵₁/2)).IsBounded := by - obtain ⟨c, hc⟩ := h - use c - intro Φ x - have hc1 := hc Φ 0 x - rw [right_zero] at hc1 - exact hc1 - -lemma isBounded_left_zero (h : P.IsBounded) : - (HiggsField.Potential.mk (- P.m₂₂2) (P.𝓵₂/2)).IsBounded := by - obtain ⟨c, hc⟩ := h - use c - intro Φ x - have hc1 := hc 0 Φ x - rw [left_zero] at hc1 - exact hc1 - -lemma isBounded_𝓵₁_nonneg (h : P.IsBounded) : - 0 ≤ P.𝓵₁ := by - have h1 := isBounded_right_zero h - have h2 := HiggsField.Potential.isBounded_𝓵_nonneg _ h1 - simp only at h2 - linarith - -lemma isBounded_𝓵₂_nonneg (h : P.IsBounded) : - 0 ≤ P.𝓵₂ := by - have h1 := isBounded_left_zero h - have h2 := HiggsField.Potential.isBounded_𝓵_nonneg _ h1 - simp only at h2 - linarith - -lemma isBounded_of_left_eq_right (h : P.IsBounded) : - 0 ≤ P.𝓵₁/2 + P.𝓵₂/2 + P.𝓵₃ + P.𝓵₄ + P.𝓵₅.re + 2 * P.𝓵₆.re + 2 * P.𝓵₇.re := by - obtain ⟨c, hc⟩ := h - refine (HiggsField.Potential.mk (- P.m₁₁2 - P.m₂₂2 + 2 * P.m₁₂2.re) - (P.𝓵₁/2 + P.𝓵₂/2 + P.𝓵₃ + P.𝓵₄ + P.𝓵₅.re + 2 * P.𝓵₆.re + 2 * P.𝓵₇.re)).isBounded_𝓵_nonneg - ⟨c, fun Φ x => ?_⟩ - have hc1 := hc Φ Φ x - rw [left_eq_right] at hc1 - exact hc1 - -lemma isBounded_of_left_eq_neg_right (h : P.IsBounded) : - 0 ≤ P.𝓵₁/2 + P.𝓵₂/2 + P.𝓵₃ + P.𝓵₄ + P.𝓵₅.re - 2 * P.𝓵₆.re - 2 * P.𝓵₇.re := by - obtain ⟨c, hc⟩ := h - refine (HiggsField.Potential.mk (- P.m₁₁2 - P.m₂₂2 - 2 * P.m₁₂2.re) - (P.𝓵₁/2 + P.𝓵₂/2 + P.𝓵₃ + P.𝓵₄ + P.𝓵₅.re - 2 * P.𝓵₆.re - 2 * P.𝓵₇.re)).isBounded_𝓵_nonneg - ⟨c, fun Φ x => ?_⟩ - have hc1 := hc Φ (- Φ) x - rw [left_eq_neg_right] at hc1 - exact hc1 - -lemma nonneg_sum_𝓵₁_to_𝓵₅_of_isBounded (h : P.IsBounded) : - 0 ≤ P.𝓵₁/2 + P.𝓵₂/2 + P.𝓵₃ + P.𝓵₄ + P.𝓵₅.re := by - have h1 := isBounded_of_left_eq_neg_right h - have h2 := isBounded_of_left_eq_right h - linarith - -end IsBounded - -end Potential - -end -end TwoHDM +noncomputable instance : SMul StandardModel.GaugeGroupI TwoHiggsDoublet where + smul g H := + { Φ1 := g • H.Φ1 + Φ2 := g • H.Φ2 } + +@[simp] +lemma gaugeGroupI_smul_fst (g : StandardModel.GaugeGroupI) (H : TwoHiggsDoublet) : + (g • H).Φ1 = g • H.Φ1 := rfl + +@[simp] +lemma gaugeGroupI_smul_snd (g : StandardModel.GaugeGroupI) (H : TwoHiggsDoublet) : + (g • H).Φ2 = g • H.Φ2 := rfl + +noncomputable instance : MulAction StandardModel.GaugeGroupI TwoHiggsDoublet where + one_smul H := by + ext <;> simp + mul_smul g1 g2 H := by + ext <;> simp [mul_smul] + +end TwoHiggsDoublet diff --git a/PhysLean/Particles/BeyondTheStandardModel/TwoHDM/GaugeOrbits.lean b/PhysLean/Particles/BeyondTheStandardModel/TwoHDM/GaugeOrbits.lean deleted file mode 100644 index ae113d78a..000000000 --- a/PhysLean/Particles/BeyondTheStandardModel/TwoHDM/GaugeOrbits.lean +++ /dev/null @@ -1,109 +0,0 @@ -/- -Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Tooby-Smith --/ -import Mathlib.Analysis.Matrix -import PhysLean.Particles.StandardModel.HiggsBoson.Basic -import Mathlib.Analysis.Matrix.Order -/-! - -# Gauge orbits for the 2HDM - -The main reference for material in this section is https://arxiv.org/pdf/hep-ph/0605184. - --/ - -namespace TwoHDM - -open StandardModel -open ComplexConjugate -open HiggsField -open Manifold -open Matrix -open Complex -open SpaceTime - -noncomputable section -open InnerProductSpace - -/-- For two Higgs fields `Φ₁` and `Φ₂`, the map from space time to 2 x 2 complex matrices - defined by `((Φ₁^†Φ₁, Φ₂^†Φ₁), (Φ₁^†Φ₂, Φ₂^†Φ₂))`. -/ -def prodMatrix (Φ1 Φ2 : HiggsField) (x : SpaceTime) : Matrix (Fin 2) (Fin 2) ℂ := - !![⟪Φ1, Φ1⟫_(SpaceTime → ℂ) x, ⟪Φ2, Φ1⟫_(SpaceTime → ℂ) x; - ⟪Φ1, Φ2⟫_(SpaceTime → ℂ) x, ⟪Φ2, Φ2⟫_(SpaceTime → ℂ) x] - -/-- The 2 x 2 complex matrices made up of components of the two Higgs fields. -/ -def fieldCompMatrix (Φ1 Φ2 : HiggsField) (x : SpaceTime) : Matrix (Fin 2) (Fin 2) ℂ := - !![Φ1 x 0, Φ1 x 1; Φ2 x 0, Φ2 x 1] - -/-- The matrix `prodMatrix Φ1 Φ2 x` is equal to the square of `fieldCompMatrix Φ1 Φ2 x`. -/ -lemma prodMatrix_eq_fieldCompMatrix_sq (Φ1 Φ2 : HiggsField) (x : SpaceTime) : - prodMatrix Φ1 Φ2 x = fieldCompMatrix Φ1 Φ2 x * (fieldCompMatrix Φ1 Φ2 x).conjTranspose := by - rw [fieldCompMatrix] - trans !![Φ1 x 0, Φ1 x 1; Φ2 x 0, Φ2 x 1] * - !![conj (Φ1 x 0), conj (Φ2 x 0); conj (Φ1 x 1), conj (Φ2 x 1)] - · rw [Matrix.mul_fin_two, prodMatrix, inner_expand_conj, inner_expand_conj, inner_expand_conj, - inner_expand_conj] - funext i j - fin_cases i <;> fin_cases j <;> ring_nf - · funext i j - fin_cases i <;> fin_cases j <;> rfl - -/-- An instance of `PartialOrder` on `ℂ` defined through `Complex.partialOrder`. -/ -local instance : PartialOrder ℂ := Complex.partialOrder - -/-- An instance of `NormedAddCommGroup` on `Matrix (Fin 2) (Fin 2) ℂ` defined through - `Matrix.normedAddCommGroup`. -/ -local instance : NormedAddCommGroup (Matrix (Fin 2) (Fin 2) ℂ) := - Matrix.normedAddCommGroup - -/-- An instance of `NormedSpace` on `Matrix (Fin 2) (Fin 2) ℂ` defined through - `Matrix.normedSpace`. -/ -local instance : NormedSpace ℝ (Matrix (Fin 2) (Fin 2) ℂ) := Matrix.normedSpace - -open Matrix -open MatrixOrder - -/-- The matrix `prodMatrix` is positive semi-definite. -/ -lemma prodMatrix_posSemiDef (Φ1 Φ2 : HiggsField) (x : SpaceTime) : - (prodMatrix Φ1 Φ2 x).PosSemidef := by - rw [prodMatrix_eq_fieldCompMatrix_sq Φ1 Φ2 x, ← nonneg_iff_posSemidef] - apply (CStarAlgebra.nonneg_iff_eq_mul_star_self (A := Matrix (Fin 2) (Fin 2) ℂ)).mpr - use (fieldCompMatrix Φ1 Φ2 x) - rfl - -/-- The matrix `prodMatrix` is hermitian. -/ -lemma prodMatrix_hermitian (Φ1 Φ2 : HiggsField) (x : SpaceTime) : - (prodMatrix Φ1 Φ2 x).IsHermitian := (prodMatrix_posSemiDef Φ1 Φ2 x).isHermitian - -/-- The map `prodMatrix` is a smooth function on spacetime. -/ -lemma prodMatrix_smooth (Φ1 Φ2 : HiggsField) : - ContMDiff 𝓘(ℝ, SpaceTime) 𝓘(ℝ, Matrix (Fin 2) (Fin 2) ℂ) ⊤ (prodMatrix Φ1 Φ2) := by - rw [show 𝓘(ℝ, Matrix (Fin 2) (Fin 2) ℂ) = modelWithCornersSelf ℝ (Fin 2 → Fin 2 → ℂ) from rfl, - contMDiff_pi_space] - intro i - rw [contMDiff_pi_space] - intro j - fin_cases i <;> fin_cases j <;> - simpa only [prodMatrix, Fin.zero_eta, Fin.isValue, of_apply, cons_val', cons_val_zero, - empty_val', cons_val_fin_one] using inner_smooth _ _ - -/-- The map `prodMatrix` is invariant under the simultaneous action of `gaugeAction` on the two -Higgs fields. -/ -informal_lemma prodMatrix_invariant where - deps := [``prodMatrix, ``gaugeAction] - tag := "6V2VS" - -/-- Given any smooth map `f` from spacetime to 2-by-2 complex matrices landing on positive -semi-definite matrices, there exist smooth Higgs fields `Φ1` and `Φ2` such that `f` is equal to -`prodMatrix Φ1 Φ2`. - -See https://arxiv.org/pdf/hep-ph/0605184 --/ -informal_lemma prodMatrix_to_higgsField where - deps := [``prodMatrix, ``HiggsField, ``prodMatrix_smooth] - tag := "6V2V2" - -end -end TwoHDM diff --git a/PhysLean/Particles/BeyondTheStandardModel/TwoHDM/GramMatrix.lean b/PhysLean/Particles/BeyondTheStandardModel/TwoHDM/GramMatrix.lean new file mode 100644 index 000000000..1640273a1 --- /dev/null +++ b/PhysLean/Particles/BeyondTheStandardModel/TwoHDM/GramMatrix.lean @@ -0,0 +1,529 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +import PhysLean.Particles.BeyondTheStandardModel.TwoHDM.Basic +/-! + +# The gram matrix for the two Higgs doublet model + +The main reference for material in this section is https://arxiv.org/pdf/hep-ph/0605184. + +We will show that the gram matrix of the two Higgs doublet model +describes the gauge orbits of the configuration space. + +-/ +namespace TwoHiggsDoublet + +open InnerProductSpace +open StandardModel + +/-! + +## A. The Gram matrix + +-/ + +/-- The Gram matrix of the two Higgs doublet. + This matrix is used in https://arxiv.org/abs/hep-ph/0605184. -/ +noncomputable def gramMatrix (H : TwoHiggsDoublet) : Matrix (Fin 2) (Fin 2) ℂ := + !![⟪H.Φ1, H.Φ1⟫_ℂ, ⟪H.Φ2, H.Φ1⟫_ℂ; ⟪H.Φ1, H.Φ2⟫_ℂ, ⟪H.Φ2, H.Φ2⟫_ℂ] + +lemma gramMatrix_selfAdjoint (H : TwoHiggsDoublet) : + IsSelfAdjoint (gramMatrix H) := by + rw [gramMatrix] + ext i j + fin_cases i <;> fin_cases j <;> simp [inner_conj_symm] + +lemma eq_fst_norm_of_eq_gramMatrix {H1 H2 : TwoHiggsDoublet} + (h : H1.gramMatrix = H2.gramMatrix) : ‖H1.Φ1‖ = ‖H2.Φ1‖ := by + rw [gramMatrix, gramMatrix] at h + have h1 := congrArg (fun x => x 0 0) h + simp only [Matrix.of_apply, Matrix.cons_val', Matrix.cons_val_zero, Fin.isValue] at h1 + rw [inner_self_eq_norm_sq_to_K, inner_self_eq_norm_sq_to_K] at h1 + rw [sq_eq_sq_iff_eq_or_eq_neg] at h1 + rcases h1 with h1 | h1 + · simpa using h1 + · rw [← RCLike.ofReal_neg] at h1 + have hnorm1 : 0 ≤ ‖H1.Φ1‖ := norm_nonneg H1.Φ1 + have hnorm2 : 0 ≤ ‖H2.Φ1‖ := norm_nonneg H2.Φ1 + have hl : ‖H1.Φ1‖ = (-‖H2.Φ1‖) := Eq.symm + ((fun {z w} => Complex.ofReal_inj.mp) (id (Eq.symm h1))) + grind + +lemma eq_snd_norm_of_eq_gramMatrix {H1 H2 : TwoHiggsDoublet} + (h : H1.gramMatrix = H2.gramMatrix) : ‖H1.Φ2‖ = ‖H2.Φ2‖ := by + rw [gramMatrix, gramMatrix] at h + have h1 := congrArg (fun x => x 1 1) h + simp [Matrix.of_apply, Matrix.cons_val', Matrix.cons_val_one, Fin.isValue] at h1 + rw [sq_eq_sq_iff_eq_or_eq_neg] at h1 + rcases h1 with h1 | h1 + · simpa using h1 + · erw [← RCLike.ofReal_neg] at h1 + have hnorm1 : 0 ≤ ‖H1.Φ2‖ := norm_nonneg H1.Φ2 + have hnorm2 : 0 ≤ ‖H2.Φ2‖ := norm_nonneg H2.Φ2 + have hl : ‖H1.Φ2‖ = (-‖H2.Φ2‖) := Eq.symm + ((fun {z w} => Complex.ofReal_inj.mp) (id (Eq.symm h1))) + grind + +@[simp] +lemma gaugeGroupI_smul_gramMatrix (g : StandardModel.GaugeGroupI) (H : TwoHiggsDoublet) : + (g • H).gramMatrix = H.gramMatrix := by + rw [gramMatrix, gramMatrix, gaugeGroupI_smul_fst, gaugeGroupI_smul_snd] + ext i j + fin_cases i <;> fin_cases j <;> simp + +lemma gramMatrix_det_eq (H : TwoHiggsDoublet) : + H.gramMatrix.det = ‖H.Φ1‖ ^ 2 * ‖H.Φ2‖ ^ 2 - ‖⟪H.Φ1, H.Φ2⟫_ℂ‖ ^ 2 := by + rw [gramMatrix, Matrix.det_fin_two] + simp only [inner_self_eq_norm_sq_to_K, Complex.coe_algebraMap, Fin.isValue, Matrix.of_apply, + Matrix.cons_val', Matrix.cons_val_zero, Matrix.cons_val_fin_one, Matrix.cons_val_one, + sub_right_inj] + rw [← Complex.conj_mul'] + simp only [inner_conj_symm] + +lemma gramMatrix_det_eq_real (H : TwoHiggsDoublet) : + H.gramMatrix.det.re = ‖H.Φ1‖ ^ 2 * ‖H.Φ2‖ ^ 2 - ‖⟪H.Φ1, H.Φ2⟫_ℂ‖ ^ 2 := by + rw [gramMatrix_det_eq] + simp [← Complex.ofReal_pow, Complex.ofReal_im] + +lemma gramMatrix_det_nonneg (H : TwoHiggsDoublet) : + 0 ≤ H.gramMatrix.det.re := by + rw [gramMatrix_det_eq_real] + simp only [sub_nonneg] + convert inner_mul_inner_self_le (𝕜 := ℂ) H.Φ1 H.Φ2 + · simp [sq, norm_inner_symm] + · exact norm_sq_eq_re_inner H.Φ1 + · exact norm_sq_eq_re_inner H.Φ2 + +lemma gramMatrix_tr_nonneg (H : TwoHiggsDoublet) : + 0 ≤ H.gramMatrix.trace.re := by + rw [gramMatrix, Matrix.trace_fin_two] + simp only [inner_self_eq_norm_sq_to_K, Complex.coe_algebraMap, Fin.isValue, Matrix.of_apply, + Matrix.cons_val', Matrix.cons_val_zero, Matrix.cons_val_fin_one, Matrix.cons_val_one, + Complex.add_re] + apply add_nonneg + · rw [← Complex.ofReal_pow, Complex.ofReal_re] + exact sq_nonneg ‖H.Φ1‖ + · rw [← Complex.ofReal_pow, Complex.ofReal_re] + exact sq_nonneg ‖H.Φ2‖ + +lemma gaugeGroupI_exists_fst_eq {H : TwoHiggsDoublet} (h1 : H.Φ1 ≠ 0) : + ∃ g : StandardModel.GaugeGroupI, + g • H.Φ1 = (!₂[‖H.Φ1‖, 0] : HiggsVec) ∧ + (g • H.Φ2) 0 = ⟪H.Φ1, H.Φ2⟫_ℂ / ‖H.Φ1‖ ∧ + ‖(g • H.Φ2) 1‖ = Real.sqrt (H.gramMatrix.det.re) / ‖H.Φ1‖ := by + rw [gramMatrix_det_eq_real] + obtain ⟨g, h⟩ := (HiggsVec.mem_orbit_gaugeGroupI_iff (H.Φ1) (!₂[‖H.Φ1‖, 0] : HiggsVec)).mpr + (by simp [@PiLp.norm_eq_of_L2]) + use g + simp at h + simp [h] + have h_fst : (g • H.Φ2).ofLp 0 = ⟪H.Φ1, H.Φ2⟫_ℂ / ‖H.Φ1‖ := by + have h2 : ⟪H.Φ1, H.Φ2⟫_ℂ = ⟪g • H.Φ1, g • H.Φ2⟫_ℂ := by + simp + rw [h] at h2 + conv_rhs at h2 => + simp [PiLp.inner_apply] + rw [h2] + have hx : (‖H.Φ1‖ : ℂ) ≠ 0 := by + simp_all + field_simp + apply And.intro h_fst + have hx : ‖g • H.Φ2‖ ^ 2 = ‖H.Φ2‖ ^ 2 := by + simp + rw [PiLp.norm_sq_eq_of_L2] at hx + simp at hx + have hx0 : ‖(g • H.Φ2).ofLp 1‖ ^ 2 = ‖H.Φ2‖ ^ 2 - ‖(g • H.Φ2).ofLp 0‖ ^ 2 := by + rw [← hx] + simp + have h0 : ‖(g • H.Φ2) 1‖ ^ 2 = (‖H.Φ1‖ ^ 2 * ‖H.Φ2‖ ^ 2 - ‖⟪H.Φ1, H.Φ2⟫_ℂ‖ ^ 2) / ‖H.Φ1‖ ^ 2 := by + field_simp + rw [hx0, h_fst] + simp only [Fin.isValue, Complex.norm_div, Complex.norm_real, norm_norm] + ring_nf + field_simp + have habc (a b c : ℝ) (ha : 0 ≤ a) (hx : a ^ 2 = b / c ^2) (hc : c ≠ 0) (hc : 0 < c) : + a = Real.sqrt b / c := by + field_simp + symm + have hb : b = a ^ 2 * c ^ 2 := by + rw [hx] + field_simp + subst hb + rw [Real.sqrt_eq_iff_eq_sq] + · ring + · positivity + · positivity + apply habc + rw [h0] + ring_nf + · exact norm_ne_zero_iff.mpr h1 + · simpa using h1 + · exact norm_nonneg ((g • H.Φ2).ofLp 1) + +lemma gaugeGroupI_exists_fst_eq_snd_eq {H : TwoHiggsDoublet} (h1 : H.Φ1 ≠ 0) : + ∃ g : StandardModel.GaugeGroupI, + g • H.Φ1 = (!₂[‖H.Φ1‖, 0] : HiggsVec) ∧ + g • H.Φ2 = (!₂[⟪H.Φ1, H.Φ2⟫_ℂ / ‖H.Φ1‖, √(H.gramMatrix.det.re) / ‖H.Φ1‖] : HiggsVec) := by + obtain ⟨g, h_fst, h_snd_0, h_snd_1⟩ := gaugeGroupI_exists_fst_eq h1 + obtain ⟨k, h1, h2, h3⟩ := HiggsVec.gaugeGroupI_smul_phase_snd (g • H.Φ2) + use k * g + apply And.intro + · rw [mul_smul, h_fst, h3] + · rw [mul_smul] + ext i + fin_cases i + · simp + rw [h2, h_snd_0] + · simp + rw [h1, h_snd_1] + simp + +lemma mem_orbit_gaugeGroupI_iff_gramMatrix (H1 H2 : TwoHiggsDoublet) : + H1 ∈ MulAction.orbit GaugeGroupI H2 ↔ H1.gramMatrix = H2.gramMatrix := by + apply Iff.intro + · intro h + obtain ⟨g, hg⟩ := h + simp at hg + simp [← hg] + by_cases Φ1_zero : H1.Φ1 = 0 + · intro h + obtain ⟨g1, hg1⟩ := (HiggsVec.mem_orbit_gaugeGroupI_iff (H1.Φ2) (!₂[‖H1.Φ2‖, 0] : HiggsVec)).mpr + (by simp [@PiLp.norm_eq_of_L2]) + obtain ⟨g2, hg2⟩ := (HiggsVec.mem_orbit_gaugeGroupI_iff (H2.Φ2) (!₂[‖H2.Φ2‖, 0] : HiggsVec)).mpr + (by simp [@PiLp.norm_eq_of_L2]) + use g1⁻¹ * g2 + simp only + ext:1 + · simp [Φ1_zero] + have hnorm : ‖H2.Φ1‖ = ‖H1.Φ1‖ := by + symm + rw [← eq_fst_norm_of_eq_gramMatrix h] + simp [Φ1_zero] at hnorm + simp [hnorm] + · simp [mul_smul] + refine inv_smul_eq_iff.mpr ?_ + simp at hg1 hg2 + simp [hg1, hg2] + exact eq_snd_norm_of_eq_gramMatrix (id (Eq.symm h)) + · intro h + obtain ⟨g1, H1_Φ1, H1_Φ2⟩ := gaugeGroupI_exists_fst_eq_snd_eq (H := H1) Φ1_zero + have Φ2_nezero : H2.Φ1 ≠ 0 := by + intro hzero + have hnorm : ‖H1.Φ1‖ = ‖H2.Φ1‖ := by + rw [← eq_fst_norm_of_eq_gramMatrix h] + simp [hzero] at hnorm + simp [hnorm] at Φ1_zero + obtain ⟨g2, H2_Φ1, H2_Φ2⟩ := gaugeGroupI_exists_fst_eq_snd_eq (H := H2) Φ2_nezero + use g1⁻¹ * g2 + simp only + ext:1 + · simp [mul_smul] + refine inv_smul_eq_iff.mpr ?_ + simp [H1_Φ1, H2_Φ1] + apply eq_fst_norm_of_eq_gramMatrix (id (Eq.symm h)) + · simp [mul_smul] + refine inv_smul_eq_iff.mpr ?_ + simp [H1_Φ2, H2_Φ2] + apply And.intro + · congr 1 + · symm + exact congrArg (fun x => x 1 0) h + · simp only [Complex.ofReal_inj] + exact eq_fst_norm_of_eq_gramMatrix (id (Eq.symm h)) + · congr 2 + · simp [h] + · exact eq_fst_norm_of_eq_gramMatrix (id (Eq.symm h)) + +/-! + +### A.1. Gram matrix is surjective + +-/ + +open ComplexConjugate + +lemma gramMatrix_surjective_det_tr (K : Matrix (Fin 2) (Fin 2) ℂ) + (hKs : IsSelfAdjoint K) (hKdet : 0 ≤ K.det.re) (hKtr : 0 ≤ K.trace.re) : + ∃ H : TwoHiggsDoublet, H.gramMatrix = K := by + /- Basic results related to K. -/ + have hK_explicit : K = !![K 0 0, K 0 1; K 1 0, K 1 1] := by + ext i j + fin_cases i <;> fin_cases j <;> simp + have hK_star_explicit : star K = !![star (K 0 0), star (K 1 0); star (K 0 1), star (K 1 1)] := by + ext i j + fin_cases i <;> fin_cases j <;> simp + rw [isSelfAdjoint_iff, hK_star_explicit] at hKs + conv_rhs at hKs => rw [hK_explicit] + simp at hKs + have hK_explicit2 : K = !![((K 0 0).re : ℂ), K 0 1; conj (K 0 1), ((K 1 1).re : ℂ)] := by + conv_lhs => rw [hK_explicit] + simp [hKs] + apply And.intro + · refine Eq.symm ((fun {z} => Complex.conj_eq_iff_re.mp) ?_) + simp [hKs] + · refine Eq.symm ((fun {z} => Complex.conj_eq_iff_re.mp) ?_) + simp [hKs] + clear hK_explicit hK_star_explicit hKs + generalize (K 0 0).re = a at * + generalize (K 1 1).re = b at * + generalize K 0 1 = c at * + have det_eq_abc : K.det = a * b - ‖c‖ ^ 2 := by + simp [hK_explicit2] + rw [Complex.mul_conj'] + have tra_eq_abc : K.trace.re = a + b := by + simp [hK_explicit2] + simp [det_eq_abc, ← Complex.ofReal_pow] at hKdet + rw [tra_eq_abc] at hKtr + rw [hK_explicit2] + clear hK_explicit2 det_eq_abc tra_eq_abc + have ha_nonneg : 0 ≤ a := by nlinarith + have hb_nonneg : 0 ≤ b := by nlinarith + /- Splitting the cases into a = 0 and other. -/ + by_cases ha : a = 0 + · use ⟨(0 : HiggsVec), (!₂[√b, 0] : HiggsVec)⟩ + subst ha + simp_all + subst hKdet + ext i j + fin_cases i <;> fin_cases j <;> simp [gramMatrix] + simp [PiLp.norm_eq_of_L2, ← Complex.ofReal_pow] + exact Real.sq_sqrt hb_nonneg + /- The case when a ≠ 0. -/ + have h1 : (√a : ℂ) ≠ 0 := by + simp_all + use ⟨(!₂[√a, 0] : HiggsVec), !₂[conj c/ √a, √(a * b - ‖c‖ ^ 2) / √a]⟩ + ext i j + fin_cases i <;> fin_cases j <;> simp [gramMatrix, PiLp.norm_eq_of_L2, ← Complex.ofReal_pow] + · exact Real.sq_sqrt ha_nonneg + · simp [PiLp.inner_apply] + field_simp + · simp [PiLp.inner_apply] + field_simp + · rw [Real.sq_sqrt, abs_of_nonneg, abs_of_nonneg] + field_simp + rw [Real.sq_sqrt, Real.sq_sqrt] + ring + · positivity + · nlinarith + · exact Real.sqrt_nonneg (a * b - ‖c‖ ^ 2) + · positivity + · positivity + +/-! + +## B. The Gram vector + +-/ + +/-- A real vector containing the components of the Gram matrix in the Pauli basis. -/ +noncomputable def gramVector (H : TwoHiggsDoublet) : Fin 1 ⊕ Fin 3 → ℝ := fun μ => + 2 * PauliMatrix.pauliBasis.repr ⟨gramMatrix H, gramMatrix_selfAdjoint H⟩ μ + +/-- The lemma manifesting the definitional equality for the gramVector. -/ +lemma gramVector_eq (H : TwoHiggsDoublet) : H.gramVector = fun μ => + 2 * PauliMatrix.pauliBasis.repr ⟨gramMatrix H, gramMatrix_selfAdjoint H⟩ μ := rfl + +@[simp] +lemma gaugeGroupI_smul_fst_gramVector (g : StandardModel.GaugeGroupI) + (H : TwoHiggsDoublet) (μ : Fin 1 ⊕ Fin 3) : + (g • H).gramVector μ = H.gramVector μ := by + rw [gramVector, gramVector] + congr 1 + simp + +lemma gramMatrix_eq_gramVector_sum_pauliMatrix (H : TwoHiggsDoublet) : + gramMatrix H = (1 / 2 : ℝ) • ∑ μ, H.gramVector μ • PauliMatrix.pauliMatrix μ := by + have h1 := congrArg (fun x => x.1) <| + PauliMatrix.pauliBasis.sum_repr ⟨gramMatrix H, gramMatrix_selfAdjoint H⟩ + simp [-Module.Basis.sum_repr] at h1 + rw [← h1] + simp [gramVector, smul_smul, Finset.smul_sum] + congr 1 + · simp [PauliMatrix.pauliBasis, PauliMatrix.pauliSelfAdjoint] + · simp [PauliMatrix.pauliBasis, PauliMatrix.pauliSelfAdjoint] + +lemma gramMatrix_eq_component_gramVector (H : TwoHiggsDoublet) : + gramMatrix H = + !![(1 / 2 : ℂ) * (H.gramVector (Sum.inl 0) + H.gramVector (Sum.inr 2)), + (1 / 2 : ℂ) * (H.gramVector (Sum.inr 0) - Complex.I * H.gramVector (Sum.inr 1)); + (1 / 2 : ℂ) * (H.gramVector (Sum.inr 0) + Complex.I * H.gramVector (Sum.inr 1)), + (1 / 2 : ℂ) * (H.gramVector (Sum.inl 0) - H.gramVector (Sum.inr 2))] := by + rw [gramMatrix_eq_gramVector_sum_pauliMatrix] + simp only [one_div, PauliMatrix.pauliMatrix, Matrix.one_fin_two, Fintype.sum_sum_type, + Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Finset.sum_singleton, Matrix.smul_of, + Matrix.smul_cons, Complex.real_smul, mul_one, smul_zero, Matrix.smul_empty, Fin.sum_univ_three, + smul_neg, Matrix.of_add_of, Matrix.add_cons, Matrix.head_cons, add_zero, Matrix.tail_cons, + Matrix.empty_add_empty, zero_add, smul_add, Complex.ofReal_inv, Complex.ofReal_ofNat, + EmbeddingLike.apply_eq_iff_eq, Matrix.vecCons_inj, and_true] + ring_nf + simp + +lemma gramVector_inl_eq_trace_gramMatrix (H : TwoHiggsDoublet) : + H.gramVector (Sum.inl 0) = H.gramMatrix.trace.re := by + rw [gramMatrix_eq_component_gramVector, Matrix.trace_fin_two] + simp only [Fin.isValue, one_div, Matrix.of_apply, Matrix.cons_val', Matrix.cons_val_zero, + Matrix.cons_val_fin_one, Matrix.cons_val_one] + ring_nf + simp + +lemma gramVector_inl_nonneg (H : TwoHiggsDoublet) : + 0 ≤ H.gramVector (Sum.inl 0) := by + rw [gramVector_inl_eq_trace_gramMatrix] + exact gramMatrix_tr_nonneg H + +lemma normSq_Φ1_eq_gramVector (H : TwoHiggsDoublet) : + ‖H.Φ1‖ ^ 2 = (1/2 : ℝ) * (H.gramVector (Sum.inl 0) + H.gramVector (Sum.inr 2)) := by + trans (gramMatrix H 0 0).re + · simp [gramMatrix] + rw [← Complex.ofReal_pow, Complex.ofReal_re] + · rw [gramMatrix_eq_component_gramVector] + simp + +lemma normSq_Φ2_eq_gramVector (H : TwoHiggsDoublet) : + ‖H.Φ2‖ ^ 2 = (1/2 : ℝ) * (H.gramVector (Sum.inl 0) - H.gramVector (Sum.inr 2)) := by + trans (gramMatrix H 1 1).re + · simp [gramMatrix] + rw [← Complex.ofReal_pow, Complex.ofReal_re] + · rw [gramMatrix_eq_component_gramVector] + simp + +lemma Φ1_inner_Φ2_eq_gramVector (H : TwoHiggsDoublet) : + (⟪H.Φ1, H.Φ2⟫_ℂ) = (1/2 : ℝ) * (H.gramVector (Sum.inr 0) + + Complex.I * H.gramVector (Sum.inr 1)) := by + trans (gramMatrix H 1 0) + · simp [gramMatrix] + · simp [gramMatrix_eq_component_gramVector] + +lemma Φ2_inner_Φ1_eq_gramVector (H : TwoHiggsDoublet) : + (⟪H.Φ2, H.Φ1⟫_ℂ) = (1/2 : ℝ) * (H.gramVector (Sum.inr 0) - + Complex.I * H.gramVector (Sum.inr 1)) := by + trans (gramMatrix H 0 1) + · simp [gramMatrix] + · simp [gramMatrix_eq_component_gramVector] + +open ComplexConjugate + +lemma Φ1_inner_Φ2_normSq_eq_gramVector (H : TwoHiggsDoublet) : + ‖⟪H.Φ1, H.Φ2⟫_ℂ‖ ^ 2 = + (1/4 : ℝ) * (H.gramVector (Sum.inr 0) ^ 2 + H.gramVector (Sum.inr 1) ^ 2) := by + trans (⟪H.Φ1, H.Φ2⟫_ℂ * conj ⟪H.Φ1, H.Φ2⟫_ℂ).re + · rw [Complex.mul_conj', ← Complex.ofReal_pow] + rfl + rw [conj_inner_symm H.Φ2 H.Φ1] + rw [Φ1_inner_Φ2_eq_gramVector, Φ2_inner_Φ1_eq_gramVector] + simp only [one_div, Complex.ofReal_inv, Complex.ofReal_ofNat, Fin.isValue, Complex.mul_re, + Complex.inv_re, Complex.re_ofNat, Complex.normSq_ofNat, div_self_mul_self', Complex.add_re, + Complex.ofReal_re, Complex.I_re, zero_mul, Complex.I_im, Complex.ofReal_im, mul_zero, sub_self, + add_zero, Complex.inv_im, Complex.im_ofNat, neg_zero, zero_div, Complex.add_im, Complex.mul_im, + one_mul, zero_add, sub_zero, Complex.sub_re, Complex.sub_im, zero_sub, mul_neg, sub_neg_eq_add] + ring + +lemma gramVector_inl_zero_eq (H : TwoHiggsDoublet) : + H.gramVector (Sum.inl 0) = ‖H.Φ1‖ ^ 2 + ‖H.Φ2‖ ^ 2 := by + rw [normSq_Φ1_eq_gramVector, normSq_Φ2_eq_gramVector] + ring + +lemma gramVector_inl_zero_eq_gramMatrix (H : TwoHiggsDoublet) : + H.gramVector (Sum.inl 0) = (H.gramMatrix 0 0).re + (H.gramMatrix 1 1).re := by + simp [gramVector_inl_zero_eq, gramMatrix, ← Complex.ofReal_pow, Complex.ofReal_re] + +lemma gramVector_inr_zero_eq (H : TwoHiggsDoublet) : + H.gramVector (Sum.inr 0) = 2 * (⟪H.Φ1, H.Φ2⟫_ℂ).re := by + rw [Φ1_inner_Φ2_eq_gramVector] + simp + +lemma gramVector_inr_zero_eq_gramMatrix (H : TwoHiggsDoublet) : + H.gramVector (Sum.inr 0) = 2 * (H.gramMatrix 1 0).re := by + rw [gramMatrix, gramVector_inr_zero_eq] + simp + +lemma gramVector_inr_one_eq (H : TwoHiggsDoublet) : + H.gramVector (Sum.inr 1) = 2 * (⟪H.Φ1, H.Φ2⟫_ℂ).im := by + rw [Φ1_inner_Φ2_eq_gramVector] + simp + +lemma gramVector_inr_one_eq_gramMatrix (H : TwoHiggsDoublet) : + H.gramVector (Sum.inr 1) = 2 * (H.gramMatrix 1 0).im := by + rw [gramMatrix, gramVector_inr_one_eq] + simp + +lemma gramVector_inr_two_eq (H : TwoHiggsDoublet) : + H.gramVector (Sum.inr 2) = ‖H.Φ1‖ ^ 2 - ‖H.Φ2‖ ^ 2 := by + rw [normSq_Φ1_eq_gramVector, normSq_Φ2_eq_gramVector] + ring + +lemma gramVector_inr_two_eq_gramMatrix (H : TwoHiggsDoublet) : + H.gramVector (Sum.inr 2) = (H.gramMatrix 0 0).re - (H.gramMatrix 1 1).re := by + simp [gramVector_inr_two_eq, gramMatrix, ← Complex.ofReal_pow, Complex.ofReal_re] + +lemma gramMatrix_det_eq_gramVector (H : TwoHiggsDoublet) : + H.gramMatrix.det.re = + (1/4 : ℝ) * (H.gramVector (Sum.inl 0) ^ 2 - + ∑ μ : Fin 3, H.gramVector (Sum.inr μ) ^ 2) := by + rw [gramMatrix_det_eq_real] + simp [normSq_Φ1_eq_gramVector, normSq_Φ2_eq_gramVector, Φ1_inner_Φ2_normSq_eq_gramVector, + Fin.sum_univ_three] + ring + +lemma gramVector_inr_sum_sq_le_inl (H : TwoHiggsDoublet) : + ∑ μ : Fin 3, H.gramVector (Sum.inr μ) ^ 2 ≤ H.gramVector (Sum.inl 0) ^ 2 := by + apply sub_nonneg.mp + trans (4 : ℝ) * H.gramMatrix.det.re + · apply mul_nonneg + · norm_num + · exact gramMatrix_det_nonneg H + apply (le_of_eq _) + rw [gramMatrix_det_eq_gramVector] + ring + +lemma gramVector_surjective (v : Fin 1 ⊕ Fin 3 → ℝ) + (h_inl : 0 ≤ v (Sum.inl 0)) + (h_det : ∑ μ : Fin 3, v (Sum.inr μ) ^ 2 ≤ v (Sum.inl 0) ^ 2) : + ∃ H : TwoHiggsDoublet, H.gramVector = v := by + let K := !![(1 / 2 : ℂ) * (v (Sum.inl 0) + v (Sum.inr 2)), + (1 / 2 : ℂ) * (v (Sum.inr 0) - Complex.I * v (Sum.inr 1)); + (1 / 2 : ℂ) * (v (Sum.inr 0) + Complex.I * v (Sum.inr 1)), + (1 / 2 : ℂ) * (v (Sum.inl 0) - v (Sum.inr 2))] + have K_star : star K = !![(1 / 2 : ℂ) * (v (Sum.inl 0) + v (Sum.inr 2)), + (1 / 2 : ℂ) * (v (Sum.inr 0) - Complex.I * v (Sum.inr 1)); + (1 / 2 : ℂ) * (v (Sum.inr 0) + Complex.I * v (Sum.inr 1)), + (1 / 2 : ℂ) * (v (Sum.inl 0) - v (Sum.inr 2))] := by + ext i j + fin_cases i <;> fin_cases j <;> simp [K] + ring + have hK_selfAdjoint : IsSelfAdjoint K := by + exact K_star + have hK_det_nonneg : 0 ≤ K.det.re := by + simp [K] + simp [Fin.sum_univ_three] at h_det + linarith + have hK_tr : 0 ≤ K.trace.re := by + simp [K] + linarith + obtain ⟨H, hH⟩ := gramMatrix_surjective_det_tr K hK_selfAdjoint hK_det_nonneg hK_tr + use H + ext μ + fin_cases μ + · simp [gramVector_inl_zero_eq_gramMatrix, hH, K] + ring + · simp [gramVector_inr_zero_eq_gramMatrix, hH, K] + · simp [gramVector_inr_one_eq_gramMatrix, hH, K] + · simp [gramVector_inr_two_eq_gramMatrix, hH, K] + ring + +lemma mem_orbit_gaugeGroupI_iff_gramVector (H1 H2 : TwoHiggsDoublet) : + H1 ∈ MulAction.orbit GaugeGroupI H2 ↔ H1.gramVector = H2.gramVector := by + rw [mem_orbit_gaugeGroupI_iff_gramMatrix] + constructor + · intro h + rw [gramVector_eq, gramVector_eq] + funext μ + congr + · intro h + rw [gramMatrix_eq_gramVector_sum_pauliMatrix, + gramMatrix_eq_gramVector_sum_pauliMatrix, h] + +end TwoHiggsDoublet diff --git a/PhysLean/Particles/BeyondTheStandardModel/TwoHDM/Potential.lean b/PhysLean/Particles/BeyondTheStandardModel/TwoHDM/Potential.lean new file mode 100644 index 000000000..3896e9c27 --- /dev/null +++ b/PhysLean/Particles/BeyondTheStandardModel/TwoHDM/Potential.lean @@ -0,0 +1,989 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +import PhysLean.Particles.BeyondTheStandardModel.TwoHDM.GramMatrix +/-! + +# The potential of the Two Higgs doublet model + +## i. Overview + +In this module we give the define the parameters of the 2HDM potential, and +give stability properties of the potential. + +## ii. Key results + +- `PotentialParameters` : The parameters of the 2HDM potential. +- `massTerm` : The mass term of the 2HDM potential. +- `quarticTerm` : The quartic term of the 2HDM potential. +- `potential` : The full potential of the 2HDM. +- `PotentialIsStable` : The condition that the potential is stable. + +## iii. Table of contents + +- A. The parameters of the potential + - A.1. The potential parameters corresponding to zero + - A.2. Gram parameters + - A.3. Specific cases +- B. The mass term +- C. The quartic term +- D. The full potential +- E. Stability of the potential + - E.1. The stability condition + - E.2. Instability of the stabilityCounterExample potential + - E.3. The reduced mass term + - E.4. The reduced quartic term + - E.5. Stability in terms of the gram vectors + - E.6. Strong stability implies stability + - E.7. Showing step in hep-ph/0605184 is invalid + +## iv. References + +For the parameterization of the potential we follow the convention of +- https://arxiv.org/pdf/1605.03237 + +Stability arguments of the potential follow, in part, those from +- https://arxiv.org/abs/hep-ph/0605184 +Although we note that we explicitly prove that one of the steps in this paper is not valid. + +-/ +namespace TwoHiggsDoublet +open InnerProductSpace +open StandardModel + +/-! + +## A. The parameters of the potential + +We define a type for the parameters of the Higgs potential in the 2HDM. + +We follow the convention of `1605.03237`, which is highlighted in the explicit construction +of the potential itself. + +We relate these parameters to the `ξ` and `η` parameters used in the gram vector formalism +given in arXiv:hep-ph/0605184. + +-/ + +/-- The parameters of the Two Higgs doublet model potential. + Following the convention of https://arxiv.org/pdf/1605.03237. -/ +structure PotentialParameters where + /-- The parameter corresponding to `m₁₁²` in the 2HDM potential. -/ + m₁₁2 : ℝ + /-- The parameter corresponding to `m₂₂²` in the 2HDM potential. -/ + m₂₂2 : ℝ + /-- The parameter corresponding to `m₁₂²` in the 2HDM potential. -/ + m₁₂2 : ℂ + /-- The parameter corresponding to `λ₁` in the 2HDM potential. -/ + 𝓵₁ : ℝ + /-- The parameter corresponding to `λ₂` in the 2HDM potential. -/ + 𝓵₂ : ℝ + /-- The parameter corresponding to `λ₃` in the 2HDM potential. -/ + 𝓵₃ : ℝ + /-- The parameter corresponding to `λ₄` in the 2HDM potential. -/ + 𝓵₄ : ℝ + /-- The parameter corresponding to `λ₅` in the 2HDM potential. -/ + 𝓵₅ : ℂ + /-- The parameter corresponding to `λ₆` in the 2HDM potential. -/ + 𝓵₆ : ℂ + /-- The parameter corresponding to `λ₇` in the 2HDM potential. -/ + 𝓵₇ : ℂ + +namespace PotentialParameters + +/-! + +### A.1. The potential parameters corresponding to zero + +We define an instance of `Zero` for the potential parameters, corresponding to all +parameters being zero, and therefore the potential itself being zero. + +-/ + +instance : Zero PotentialParameters where + zero := + { m₁₁2 := 0 + m₂₂2 := 0 + m₁₂2 := 0 + 𝓵₁ := 0 + 𝓵₂ := 0 + 𝓵₃ := 0 + 𝓵₄ := 0 + 𝓵₅ := 0 + 𝓵₆ := 0 + 𝓵₇ := 0 } + +@[simp] lemma zero_m₁₁2 : (0 : PotentialParameters).m₁₁2 = 0 := rfl + +@[simp] lemma zero_m₂₂2 : (0 : PotentialParameters).m₂₂2 = 0 := rfl + +@[simp] lemma zero_m₁₂2 : (0 : PotentialParameters).m₁₂2 = 0 := rfl + +@[simp] lemma zero_𝓵₁ : (0 : PotentialParameters).𝓵₁ = 0 := rfl + +@[simp] lemma zero_𝓵₂ : (0 : PotentialParameters).𝓵₂ = 0 := rfl + +@[simp] lemma zero_𝓵₃ : (0 : PotentialParameters).𝓵₃ = 0 := rfl + +@[simp] lemma zero_𝓵₄ : (0 : PotentialParameters).𝓵₄ = 0 := rfl + +@[simp] lemma zero_𝓵₅ : (0 : PotentialParameters).𝓵₅ = 0 := rfl + +@[simp] lemma zero_𝓵₆ : (0 : PotentialParameters).𝓵₆ = 0 := rfl + +@[simp] lemma zero_𝓵₇ : (0 : PotentialParameters).𝓵₇ = 0 := rfl + +/-! + +### A.2. Gram parameters + +A reparameterization of the potential parameters corresponding to `ξ` and `η` in +arXiv:hep-ph/0605184. + +-/ + +/-- A reparameterization of the parameters of the quadratic terms of the + potential for use with the gramVector. -/ +noncomputable def ξ (P : PotentialParameters) (μ : Fin 1 ⊕ Fin 3) : ℝ := + match μ with + | .inl 0 => (P.m₁₁2 + P.m₂₂2) / 2 + | .inr 0 => -Complex.re P.m₁₂2 + | .inr 1 => Complex.im P.m₁₂2 + | .inr 2 => (P.m₁₁2 - P.m₂₂2) / 2 + +@[simp] +lemma ξ_zero : (0 : PotentialParameters).ξ = 0 := by + ext μ + fin_cases μ <;> simp [ξ] + +/-- A reparameterization of the parameters of the quartic terms of the + potential for use with the gramVector. -/ +noncomputable def η (P : PotentialParameters) : Fin 1 ⊕ Fin 3 → Fin 1 ⊕ Fin 3 → ℝ + | .inl 0, .inl 0 => (P.𝓵₁ + P.𝓵₂ + 2 * P.𝓵₃) / 8 + | .inl 0, .inr 0 => (P.𝓵₆.re + P.𝓵₇.re) / 4 + | .inl 0, .inr 1 => - (P.𝓵₆.im + P.𝓵₇.im) / 4 + | .inl 0, .inr 2 => (P.𝓵₁ - P.𝓵₂) / 8 + | .inr 0, .inl 0 => (P.𝓵₆.re + P.𝓵₇.re) / 4 + | .inr 1, .inl 0 => -(P.𝓵₆.im + P.𝓵₇.im) / 4 + | .inr 2, .inl 0 => (P.𝓵₁ - P.𝓵₂) / 8 + | .inr 0, .inr 0 => (P.𝓵₅.re + P.𝓵₄) / 4 + | .inr 1, .inr 1 => (P.𝓵₄ - P.𝓵₅.re) / 4 + | .inr 2, .inr 2 => (P.𝓵₁ + P.𝓵₂ - 2 * P.𝓵₃) / 8 + | .inr 0, .inr 1 => - P.𝓵₅.im / 4 + | .inr 2, .inr 0 => (P.𝓵₆.re - P.𝓵₇.re) / 4 + | .inr 2, .inr 1 => (P.𝓵₇.im - P.𝓵₆.im) / 4 + | .inr 1, .inr 0 => - P.𝓵₅.im / 4 + | .inr 0, .inr 2 => (P.𝓵₆.re - P.𝓵₇.re) / 4 + | .inr 1, .inr 2 => (P.𝓵₇.im - P.𝓵₆.im) / 4 + +lemma η_symm (P : PotentialParameters) (μ ν : Fin 1 ⊕ Fin 3) : + P.η μ ν = P.η ν μ := by + fin_cases μ <;> fin_cases ν <;> simp [η] + +@[simp] +lemma η_zero : (0 : PotentialParameters).η = 0 := by + ext μ ν + fin_cases μ <;> fin_cases ν <;> simp [η] + +/-! + +### A.3. Specific cases + +-/ + +/-- An example of potential parameters that serve as a counterexample to the stability + condition given in arXiv:hep-ph/0605184. + This corresponds to the potential: + `2 * (⟪H.Φ1, H.Φ2⟫_ℂ).im + ‖H.Φ1 - H.Φ2‖ ^ 4` + which has the property that the quartic term is non-negative and only zero if + the mass term is also zero, but the potential is not stable. + In the proof that `stabilityCounterExample_not_potentialIsStable`, we give + explicit vectors `H.Φ1` and `H.Φ2` that show this potential is not stable. + + This is the first occurrence of such a counterexample in the literature to the best of + the author's knowledge. +-/ +def stabilityCounterExample : PotentialParameters := {(0 : PotentialParameters) with + m₁₂2 := Complex.I + 𝓵₁ := 2 + 𝓵₂ := 2 + 𝓵₃ := 2 + 𝓵₄ := 2 + 𝓵₅ := 2 + 𝓵₆ := -2 + 𝓵₇ := -2} + +lemma stabilityCounterExample_ξ : + stabilityCounterExample.ξ = fun + | .inl 0 => 0 + | .inr 0 => 0 + | .inr 1 => 1 + | .inr 2 => 0 := by + funext μ + simp [stabilityCounterExample, ξ] + +lemma stabilityCounterExample_η : + stabilityCounterExample.η = fun μ => fun ν => + match μ, ν with + | .inl 0, .inl 0 => 1 + | .inl 0, .inr 0 => -1 + | .inl 0, .inr 1 => 0 + | .inl 0, .inr 2 => 0 + | .inr 0, .inl 0 => -1 + | .inr 1, .inl 0 => 0 + | .inr 2, .inl 0 => 0 + | .inr 0, .inr 0 => 1 + | .inr 1, .inr 1 => 0 + | .inr 2, .inr 2 => 0 + | .inr 0, .inr 1 => 0 + | .inr 2, .inr 0 => 0 + | .inr 2, .inr 1 => 0 + | .inr 1, .inr 0 => 0 + | .inr 0, .inr 2 => 0 + | .inr 1, .inr 2 => 0 := by + funext μ ν + simp [stabilityCounterExample, η] + ring_nf + +end PotentialParameters + +open ComplexConjugate + +/-! + +## B. The mass term + +We define the mass term of the potential, write it in terms of the gram vector, +and prove that it is gauge invariant. + +-/ + +/-- The mass term of the two Higgs doublet model potential. -/ +noncomputable def massTerm (P : PotentialParameters) (H : TwoHiggsDoublet) : ℝ := + P.m₁₁2 * ‖H.Φ1‖ ^ 2 + P.m₂₂2 * ‖H.Φ2‖ ^ 2 - + (P.m₁₂2 * ⟪H.Φ1, H.Φ2⟫_ℂ + conj P.m₁₂2 * ⟪H.Φ2, H.Φ1⟫_ℂ).re + +lemma massTerm_eq_gramVector (P : PotentialParameters) (H : TwoHiggsDoublet) : + massTerm P H = ∑ μ, P.ξ μ * H.gramVector μ := by + simp [massTerm, Fin.sum_univ_three, PotentialParameters.ξ, normSq_Φ1_eq_gramVector, + normSq_Φ2_eq_gramVector, Φ1_inner_Φ2_eq_gramVector, Φ2_inner_Φ1_eq_gramVector] + ring + +@[simp] +lemma gaugeGroupI_smul_massTerm (g : StandardModel.GaugeGroupI) (P : PotentialParameters) + (H : TwoHiggsDoublet) : + massTerm P (g • H) = massTerm P H := by + rw [massTerm_eq_gramVector, massTerm_eq_gramVector] + simp + +@[simp] +lemma massTerm_zero : massTerm 0 = 0 := by + ext H + simp [massTerm] + +lemma massTerm_stabilityCounterExample (H : TwoHiggsDoublet) : + massTerm PotentialParameters.stabilityCounterExample H = + 2 * (⟪H.Φ1, H.Φ2⟫_ℂ).im := by + simp [massTerm, PotentialParameters.stabilityCounterExample] + rw [show ⟪H.Φ2, H.Φ1⟫_ℂ = conj ⟪H.Φ1, H.Φ2⟫_ℂ from Eq.symm (conj_inner_symm H.Φ2 H.Φ1)] + rw [Complex.conj_im] + ring_nf + +/-! + +## C. The quartic term + +We define the quartic term of the potential, write it in terms of the gram vector, +and prove that it is gauge invariant. + +-/ + +/-- The quartic term of the two Higgs doublet model potential. -/ +noncomputable def quarticTerm (P : PotentialParameters) (H : TwoHiggsDoublet) : ℝ := + 1/2 * P.𝓵₁ * ‖H.Φ1‖ ^ 2 * ‖H.Φ1‖ ^ 2 + 1/2 * P.𝓵₂ * ‖H.Φ2‖ ^ 2 * ‖H.Φ2‖ ^ 2 + + P.𝓵₃ * ‖H.Φ1‖ ^ 2 * ‖H.Φ2‖ ^ 2 + + P.𝓵₄ * ‖⟪H.Φ1, H.Φ2⟫_ℂ‖ ^ 2 + + (1/2 * P.𝓵₅ * ⟪H.Φ1, H.Φ2⟫_ℂ ^ 2 + 1/2 * conj P.𝓵₅ * ⟪H.Φ2, H.Φ1⟫_ℂ ^ 2).re + + (P.𝓵₆ * ‖H.Φ1‖ ^ 2 * ⟪H.Φ1, H.Φ2⟫_ℂ + conj P.𝓵₆ * ‖H.Φ1‖ ^ 2 * ⟪H.Φ2, H.Φ1⟫_ℂ).re + + (P.𝓵₇ * ‖H.Φ2‖ ^ 2 * ⟪H.Φ1, H.Φ2⟫_ℂ + conj P.𝓵₇ * ‖H.Φ2‖ ^ 2 * ⟪H.Φ2, H.Φ1⟫_ℂ).re + +lemma quarticTerm_𝓵₄_expand (P : PotentialParameters) (H : TwoHiggsDoublet) : + H.quarticTerm P = + 1/2 * P.𝓵₁ * ‖H.Φ1‖ ^ 2 * ‖H.Φ1‖ ^ 2 + 1/2 * P.𝓵₂ * ‖H.Φ2‖ ^ 2 * ‖H.Φ2‖ ^ 2 + + P.𝓵₃ * ‖H.Φ1‖ ^ 2 * ‖H.Φ2‖ ^ 2 + + P.𝓵₄ * (⟪H.Φ1, H.Φ2⟫_ℂ * ⟪H.Φ2, H.Φ1⟫_ℂ).re + + (1/2 * P.𝓵₅ * ⟪H.Φ1, H.Φ2⟫_ℂ ^ 2 + 1/2 * conj P.𝓵₅ * ⟪H.Φ2, H.Φ1⟫_ℂ ^ 2).re + + (P.𝓵₆ * ‖H.Φ1‖ ^ 2 * ⟪H.Φ1, H.Φ2⟫_ℂ + conj P.𝓵₆ * ‖H.Φ1‖ ^ 2 * ⟪H.Φ2, H.Φ1⟫_ℂ).re + + (P.𝓵₇ * ‖H.Φ2‖ ^ 2 * ⟪H.Φ1, H.Φ2⟫_ℂ + conj P.𝓵₇ * ‖H.Φ2‖ ^ 2 * ⟪H.Φ2, H.Φ1⟫_ℂ).re := by + simp [quarticTerm] + left + rw [Complex.sq_norm] + rw [← Complex.mul_re] + rw [← inner_conj_symm, ← Complex.normSq_eq_conj_mul_self] + simp only [inner_conj_symm, Complex.ofReal_re] + rw [← inner_conj_symm] + exact Complex.normSq_conj ⟪H.Φ2, H.Φ1⟫_ℂ + +lemma quarticTerm_eq_gramVector (P : PotentialParameters) (H : TwoHiggsDoublet) : + quarticTerm P H = ∑ a, ∑ b, H.gramVector a * H.gramVector b * P.η a b := by + simp [quarticTerm_𝓵₄_expand, Fin.sum_univ_three, PotentialParameters.η, normSq_Φ1_eq_gramVector, + normSq_Φ2_eq_gramVector, Φ1_inner_Φ2_eq_gramVector, Φ2_inner_Φ1_eq_gramVector] + ring_nf + simp [← Complex.ofReal_pow, Complex.ofReal_re, normSq_Φ1_eq_gramVector, + normSq_Φ2_eq_gramVector] + ring + +@[simp] +lemma gaugeGroupI_smul_quarticTerm (g : StandardModel.GaugeGroupI) (P : PotentialParameters) + (H : TwoHiggsDoublet) : + quarticTerm P (g • H) = quarticTerm P H := by + rw [quarticTerm_eq_gramVector, quarticTerm_eq_gramVector] + simp + +@[simp] +lemma quarticTerm_zero : quarticTerm 0 = 0 := by + ext H + simp [quarticTerm] + +lemma quarticTerm_stabilityCounterExample (H : TwoHiggsDoublet) : + quarticTerm .stabilityCounterExample H = + (‖H.Φ1‖ ^ 2 + ‖H.Φ2‖ ^ 2 - 2 * (⟪H.Φ1, H.Φ2⟫_ℂ).re) ^ 2:= by + /- Proof by calculation. -/ + calc _ = (‖H.Φ1‖ ^ 2 + ‖H.Φ2‖ ^ 2) ^ 2 + + 2 * ‖⟪H.Φ1, H.Φ2⟫_ℂ‖ ^ 2 + + (⟪H.Φ1, H.Φ2⟫_ℂ ^ 2 + ⟪H.Φ2, H.Φ1⟫_ℂ ^ 2).re + - 2 * (‖H.Φ1‖ ^ 2 + ‖H.Φ2‖ ^ 2) * ((⟪H.Φ1, H.Φ2⟫_ℂ).re + (⟪H.Φ2, H.Φ1⟫_ℂ).re) := by + simp [quarticTerm, PotentialParameters.stabilityCounterExample, Complex.add_re, + ← Complex.ofReal_pow] + ring + _ = (‖H.Φ1‖ ^ 2 + ‖H.Φ2‖ ^ 2) ^ 2 + + 4 * (⟪H.Φ1, H.Φ2⟫_ℂ).re ^ 2 + - 2 * (‖H.Φ1‖ ^ 2 + ‖H.Φ2‖ ^ 2) * ((⟪H.Φ1, H.Φ2⟫_ℂ).re + (⟪H.Φ2, H.Φ1⟫_ℂ).re) := by + have h1 : 2 * ‖⟪H.Φ1, H.Φ2⟫_ℂ‖ ^ 2 + + (⟪H.Φ1, H.Φ2⟫_ℂ ^ 2 + ⟪H.Φ2, H.Φ1⟫_ℂ ^ 2).re = 4 * (⟪H.Φ1, H.Φ2⟫_ℂ).re ^ 2 := by + rw [show ⟪H.Φ2, H.Φ1⟫_ℂ = conj ⟪H.Φ1, H.Φ2⟫_ℂ from Eq.symm (conj_inner_symm H.Φ2 H.Φ1)] + generalize ⟪H.Φ1, H.Φ2⟫_ℂ = z + have hz : z = z.re + z.im * Complex.I := by exact Eq.symm (Complex.re_add_im z) + generalize z.re = x at hz + generalize z.im = y at hz + subst hz + have h0 : ‖↑x + ↑y * Complex.I‖ ^ 2 = x ^ 2 + y ^ 2 := by + rw [Complex.norm_add_mul_I, Real.sq_sqrt] + positivity + rw [h0] + simp [Complex.add_re, sq] + ring + rw [← h1] + ring + _ = (‖H.Φ1‖ ^ 2 + ‖H.Φ2‖ ^ 2 - 2 * (⟪H.Φ1, H.Φ2⟫_ℂ).re) ^ 2 := by + rw [show ⟪H.Φ2, H.Φ1⟫_ℂ = conj ⟪H.Φ1, H.Φ2⟫_ℂ from Eq.symm (conj_inner_symm H.Φ2 H.Φ1)] + rw [Complex.conj_re] + ring + +lemma quarticTerm_stabilityCounterExample_eq_norm_pow_four (H : TwoHiggsDoublet) : + quarticTerm .stabilityCounterExample H = ‖H.Φ1 - H.Φ2‖ ^ 4 := by + /- Proof by calculation. -/ + calc _ + _ = (‖H.Φ1‖ ^ 2 + ‖H.Φ2‖ ^ 2 - 2 * (⟪H.Φ1, H.Φ2⟫_ℂ).re) ^ 2 := by + rw [quarticTerm_stabilityCounterExample] + _ = (‖H.Φ1 - H.Φ2‖ ^ 2) ^ 2 := by + congr + have h1 (v : HiggsVec) : ‖v‖ ^ 2 = (⟪v, v⟫_ℂ).re := by + rw [inner_self_eq_norm_sq_to_K] + simp [← Complex.ofReal_pow] + rw [h1, h1, h1] + simp only [inner_sub_right, inner_sub_left, Complex.sub_re] + rw [show ⟪H.Φ2, H.Φ1⟫_ℂ = conj ⟪H.Φ1, H.Φ2⟫_ℂ from Eq.symm (conj_inner_symm H.Φ2 H.Φ1)] + rw [Complex.conj_re] + ring + _ = ‖H.Φ1 - H.Φ2‖ ^ 4 := by ring + +lemma quarticTerm_stabilityCounterExample_nonneg (H : TwoHiggsDoublet) : + 0 ≤ quarticTerm .stabilityCounterExample H := by + rw [quarticTerm_stabilityCounterExample_eq_norm_pow_four] + positivity + +lemma massTerm_zero_of_quarticTerm_zero_stabilityCounterExample (H : TwoHiggsDoublet) + (h : quarticTerm .stabilityCounterExample H = 0) : + massTerm .stabilityCounterExample H = 0 := by + rw [quarticTerm_stabilityCounterExample_eq_norm_pow_four] at h + rw [massTerm_stabilityCounterExample] + simp at h + have h1 : H.Φ1 = H.Φ2 := by grind + simp [← Complex.ofReal_pow, h1] + +/-! + +## D. The full potential + +We define the full potential as the sum of the mass and quartic terms, +and prove that it is gauge invariant. + +-/ + +/-- The potential of the two Higgs doublet model. -/ +noncomputable def potential (P : PotentialParameters) (H : TwoHiggsDoublet) : ℝ := + massTerm P H + quarticTerm P H + +@[simp] +lemma gaugeGroupI_smul_potential (g : StandardModel.GaugeGroupI) + (P : PotentialParameters) (H : TwoHiggsDoublet) : + potential P (g • H) = potential P H := by + rw [potential, potential] + simp + +@[simp] +lemma potential_zero : potential 0 = 0 := by + ext H + simp [potential] + +lemma potential_stabilityCounterExample (H : TwoHiggsDoublet) : + potential .stabilityCounterExample H = 2 * (⟪H.Φ1, H.Φ2⟫_ℂ).im + ‖H.Φ1 - H.Φ2‖ ^ 4 := by + simp [potential, massTerm_stabilityCounterExample, + quarticTerm_stabilityCounterExample_eq_norm_pow_four] + +lemma potential_eq_gramVector (P : PotentialParameters) (H : TwoHiggsDoublet) : + potential P H = ∑ μ, P.ξ μ * H.gramVector μ + + ∑ a, ∑ b, H.gramVector a * H.gramVector b * P.η a b := by + rw [potential, massTerm_eq_gramVector, quarticTerm_eq_gramVector] + +/-! + +## E. Stability of the potential + +-/ + +/-! + +### E.1. The stability condition + +We define the condition that the potential is stable, that is, bounded from below. + +-/ + +/-- The condition that the potential is stable. -/ +def PotentialIsStable (P : PotentialParameters) : Prop := + ∃ c : ℝ, ∀ H : TwoHiggsDoublet, c ≤ potential P H + +/-! + +### E.2. Instability of the stabilityCounterExample potential + +-/ + +open Real + +/-- The potential `stabilityCounterExample` is not stable. -/ +lemma stabilityCounterExample_not_potentialIsStable : + ¬ PotentialIsStable .stabilityCounterExample := by + simp [PotentialIsStable] + intro c + /- The angle t and properties thereof. -/ + let t := Real.arctan (2 * Real.sqrt (|c| + 1))⁻¹ + have t_pos : 0 < t := by + simp [t] + grind + have t_le_pi_div_2 : t ≤ Real.pi / 2 := by + simpa [t] using le_of_lt <| arctan_lt_pi_div_two ((√(|c| + 1))⁻¹ * 2⁻¹) + have t_ne_zero : t ≠ 0 := by + simp [t] + grind + have sin_t_pos : 0 < sin t := by + simp [t] + grind + have cos_t_pos : 0 < cos t := by + simp [t] + exact cos_arctan_pos ((√(|c| + 1))⁻¹ * 2⁻¹) + have t_mul_sin_t_nonneg : 0 ≤ 2 * t * sin t - t ^ 2 := by + rw [sub_nonneg] + trans 2 * t * (2 / Real.pi * t) + · ring_nf + rw [mul_assoc] + apply le_mul_of_one_le_right + · positivity + · field_simp + exact Real.pi_le_four + · have := Real.mul_le_sin (le_of_lt t_pos) t_le_pi_div_2 + nlinarith + /- The Two Higgs doublet violating stability. + The two Higgs doublet is constructed so that for the gram vector + `v` we have: + - `v₀ = cos t/(2 * t * (sin t)^2)` + - `v₁/v₀ = (1 - t * sin t)` + - `v₂/v₀ = - t * cos t` + - `v₃ = 0` -/ + let H : TwoHiggsDoublet := { + Φ1 := !₂[√(cos t/(4 * t * (sin t)^2)), 0] + Φ2 := √(cos t/(4 * t * (sin t)^2)) • !₂[1 - t * sin t - Complex.I * t * cos t, + √(2 * t * sin t - t ^ 2)] } + have Φ1_norm_sq : ‖H.Φ1‖ ^ 2 = cos t/(4 * t * (sin t)^2) := by + simp [H, PiLp.norm_sq_eq_of_L2] + rw [sq_sqrt] + positivity + have Φ2_norm_sq : ‖H.Φ2‖ ^ 2 = cos t/(4 * t * (sin t)^2) := by + simp [H, norm_smul, mul_pow] + rw [sq_sqrt (by positivity)] + simp [PiLp.norm_sq_eq_of_L2] + rw [sq_sqrt (by positivity)] + have h0 : ‖1 - ↑t * Complex.sin ↑t - Complex.I * ↑t * Complex.cos ↑t‖ ^ 2 = + 1 + t ^ 2 - 2 * t * sin t := by + rw [← Complex.normSq_eq_norm_sq] + trans Complex.normSq (Complex.ofReal (1 - t * sin t) + + Complex.ofReal (-t * cos t) * Complex.I) + · simp + ring_nf + rw [Complex.normSq_add_mul_I] + trans 1 + t ^2 * (sin t ^2 + cos t ^2) - 2 *(t * sin t) + · ring + rw [sin_sq_add_cos_sq] + ring + rw [h0] + field_simp + ring + have Φ1_inner_Φ2 : ⟪H.Φ1, H.Φ2⟫_ℂ = Complex.ofReal (cos t/(4 * t * (sin t)^2) * + (1 - t * sin t)) + Complex.I * + Complex.ofReal (cos t/(4 * t * (sin t)^2) * (- t * cos t)) := by + simp [H, PiLp.inner_apply] + trans Complex.ofReal ((√(cos t / (4 * t * sin t ^ 2))) ^ 2) * + (1 - ↑t * Complex.sin ↑t - Complex.I * ↑t * Complex.cos ↑t) + · simp + ring + rw [sq_sqrt (by positivity)] + simp only [Complex.ofReal_div, Complex.ofReal_cos, Complex.ofReal_mul, Complex.ofReal_ofNat, + Complex.ofReal_pow, Complex.ofReal_sin] + ring + have Φ1_inner_Φ2_re : (⟪H.Φ1, H.Φ2⟫_ℂ).re = cos t/(4 * t * (sin t)^2) * (1 - t * sin t) := by + rw [Φ1_inner_Φ2, Complex.add_re, Complex.ofReal_re, Complex.re_mul_ofReal] + simp + have Φ1_inner_Φ2_im : (⟪H.Φ1, H.Φ2⟫_ℂ).im = cos t/(4 * t * (sin t)^2) * (- t * cos t) := by + rw [Φ1_inner_Φ2, Complex.add_im, Complex.im_mul_ofReal, Complex.ofReal_im] + simp + have potential_H_cos_sin : potential .stabilityCounterExample H = + - (cos t) ^ 2/ (4 * (sin t)^2) := by + rw [potential, massTerm_stabilityCounterExample, quarticTerm_stabilityCounterExample] + rw [Φ1_norm_sq, Φ2_norm_sq, Φ1_inner_Φ2_re, Φ1_inner_Φ2_im] + field + have potential_H_tan : potential .stabilityCounterExample H = + - 1/(4 * tan t ^ 2) := by + rw [potential_H_cos_sin, tan_eq_sin_div_cos] + field + have potential_eq_c : potential .stabilityCounterExample H = - (|c| + 1) := by + rw [potential_H_tan, tan_arctan] + field_simp + rw [sq_sqrt (by positivity)] + ring + /- Proving potential is unbounded. -/ + use H + rw [potential_eq_c] + grind + +/-! + +### E.3. The reduced mass term + +The reduced mass term is a function that helps express the stability condition. +It is the function `J2` in https://arxiv.org/abs/hep-ph/0605184. + +-/ + +/-- A function related to the mass term of the potential, used in the stableness + condition and equivalent to the term `J2` in + https://arxiv.org/abs/hep-ph/0605184. -/ +noncomputable def massTermReduced (P : PotentialParameters) (k : EuclideanSpace ℝ (Fin 3)) : ℝ := + P.ξ (Sum.inl 0) + ∑ μ, P.ξ (Sum.inr μ) * k μ + +lemma massTermReduced_lower_bound (P : PotentialParameters) (k : EuclideanSpace ℝ (Fin 3)) + (hk : ‖k‖ ^ 2 ≤ 1) : P.ξ (Sum.inl 0) - √(∑ a, |P.ξ (Sum.inr a)| ^ 2) ≤ massTermReduced P k := by + simp only [Fin.isValue, massTermReduced] + have h1 (a b c : ℝ) (h : - b ≤ c) : a - b ≤ a + c:= by grind + apply h1 + let ξEuclid : EuclideanSpace ℝ (Fin 3) := WithLp.toLp 2 (fun a => P.ξ (Sum.inr a)) + trans - ‖ξEuclid‖ + · simp [PiLp.norm_eq_of_L2, ξEuclid] + trans - (‖k‖ * ‖ξEuclid‖) + · simp + simp at hk + have ha (a b : ℝ) (h : a ≤ 1) (ha : 0 ≤ a) (hb : 0 ≤ b) : a * b ≤ b := by nlinarith + apply ha + · exact hk + · exact norm_nonneg k + · exact norm_nonneg ξEuclid + trans - ‖⟪k, ξEuclid⟫_ℝ‖ + · simp + exact abs_real_inner_le_norm k ξEuclid + trans ⟪k, ξEuclid⟫_ℝ + · simp + grind + simp [PiLp.inner_apply, ξEuclid] + +@[simp] +lemma massTermReduced_zero : massTermReduced 0 = 0 := by + ext k + simp [massTermReduced] + +lemma massTermReduced_stabilityCounterExample (k : EuclideanSpace ℝ (Fin 3)) : + massTermReduced .stabilityCounterExample k = k 1 := by + simp [massTermReduced, PotentialParameters.ξ, Fin.isValue, + PotentialParameters.stabilityCounterExample, Fin.sum_univ_three] + +/-! + +### E.4. The reduced quartic term + +The reduced quartic term is a function that helps express the stability condition. +It is the function `J4` in https://arxiv.org/abs/hep-ph/0605184. + +-/ + +/-- A function related to the quartic term of the potential, used in the stableness + condition and equivalent to the term `J4` in + https://arxiv.org/abs/hep-ph/0605184. -/ +noncomputable def quarticTermReduced (P : PotentialParameters) (k : EuclideanSpace ℝ (Fin 3)) : ℝ := + P.η (Sum.inl 0) (Sum.inl 0) + 2 * ∑ b, k b * P.η (Sum.inl 0) (Sum.inr b) + + ∑ a, ∑ b, k a * k b * P.η (Sum.inr a) (Sum.inr b) + +@[simp] +lemma quarticTermReduced_zero : quarticTermReduced 0 = 0 := by + ext k + simp [quarticTermReduced] + +lemma quarticTermReduced_stabilityCounterExample (k : EuclideanSpace ℝ (Fin 3)) : + quarticTermReduced .stabilityCounterExample k = (1 - k 0) ^ 2 := by + simp [quarticTermReduced, PotentialParameters.η, Fin.isValue, + PotentialParameters.stabilityCounterExample, Fin.sum_univ_three] + ring + +lemma quarticTermReduced_stabilityCounterExample_nonneg (k : EuclideanSpace ℝ (Fin 3)) : + 0 ≤ quarticTermReduced .stabilityCounterExample k := by + rw [quarticTermReduced_stabilityCounterExample] + apply sq_nonneg + +/-! + +### E.5. Stability in terms of the gram vectors + +We give some necessary and sufficient conditions for the potential to be stable +in terms of the gram vectors. + +This follows the analysis in https://arxiv.org/abs/hep-ph/0605184. + +We also give some necessary conditions. + +-/ + +lemma potentialIsStable_iff_forall_gramVector (P : PotentialParameters) : + PotentialIsStable P ↔ ∃ c : ℝ, ∀ K : Fin 1 ⊕ Fin 3 → ℝ, 0 ≤ K (Sum.inl 0) → + ∑ μ : Fin 3, K (Sum.inr μ) ^ 2 ≤ K (Sum.inl 0) ^ 2 → + c ≤ ∑ μ, P.ξ μ * K μ + ∑ a, ∑ b, K a * K b * P.η a b := by + apply Iff.intro + · intro h + obtain ⟨c, hc⟩ := h + use c + intro v hv₀ hv_sum + obtain ⟨H, hH⟩ := gramVector_surjective v hv₀ hv_sum + apply (hc H).trans + apply le_of_eq + rw [potential, massTerm_eq_gramVector, quarticTerm_eq_gramVector] + simp [hH] + · intro h + obtain ⟨c, hc⟩ := h + use c + intro H + apply (hc H.gramVector (gramVector_inl_nonneg H) (gramVector_inr_sum_sq_le_inl H)).trans + apply le_of_eq + rw [potential, massTerm_eq_gramVector, quarticTerm_eq_gramVector] + +lemma potentialIsStable_iff_forall_euclid (P : PotentialParameters) : + PotentialIsStable P ↔ ∃ c, ∀ K0 : ℝ, ∀ K : EuclideanSpace ℝ (Fin 3), 0 ≤ K0 → + ‖K‖ ^ 2 ≤ K0 ^ 2 → c ≤ P.ξ (Sum.inl 0) * K0 + ∑ μ, P.ξ (Sum.inr μ) * K μ + + K0 ^ 2 * P.η (Sum.inl 0) (Sum.inl 0) + + 2 * K0 * ∑ b, K b * P.η (Sum.inl 0) (Sum.inr b) + + ∑ a, ∑ b, K a * K b * P.η (Sum.inr a) (Sum.inr b) := by + rw [potentialIsStable_iff_forall_gramVector] + refine exists_congr (fun c => ?_) + rw [Equiv.forall_congr_left (Equiv.sumArrowEquivProdArrow (Fin 1) (Fin 3) ℝ)] + simp only [Fin.isValue, Fintype.sum_sum_type, Finset.univ_unique, Fin.default_eq_zero, + Finset.sum_singleton, Prod.forall, Equiv.sumArrowEquivProdArrow_symm_apply_inl, + Equiv.sumArrowEquivProdArrow_symm_apply_inr] + rw [Equiv.forall_congr_left <| Equiv.funUnique (Fin 1) ℝ] + apply forall_congr' + intro K0 + rw [Equiv.forall_congr_left <| (WithLp.equiv 2 ((i : Fin 3) → (fun x => ℝ) i)).symm] + apply forall_congr' + intro K + simp only [Fin.isValue, Equiv.funUnique_symm_apply, uniqueElim_const, Equiv.symm_symm, + WithLp.equiv_apply] + refine imp_congr_right ?_ + intro hle + simp only [PiLp.norm_sq_eq_of_L2] + simp only [Fin.isValue, Real.norm_eq_abs, sq_abs] + refine imp_congr_right ?_ + intro hle' + apply le_iff_le_of_cmp_eq_cmp + congr 1 + simp [add_assoc, sq, Finset.sum_add_distrib] + ring_nf + simp [mul_assoc, ← Finset.mul_sum] + conv_lhs => + enter [2, 2, 2, i] + rw [PotentialParameters.η_symm] + ring + +lemma potentialIsStable_iff_forall_euclid_lt (P : PotentialParameters) : + PotentialIsStable P ↔ ∃ c ≤ 0, ∀ K0 : ℝ, ∀ K : EuclideanSpace ℝ (Fin 3), 0 < K0 → + ‖K‖ ^ 2 ≤ K0 ^ 2 → c ≤ P.ξ (Sum.inl 0) * K0 + ∑ μ, P.ξ (Sum.inr μ) * K μ + + K0 ^ 2 * P.η (Sum.inl 0) (Sum.inl 0) + + 2 * K0 * ∑ b, K b * P.η (Sum.inl 0) (Sum.inr b) + + ∑ a, ∑ b, K a * K b * P.η (Sum.inr a) (Sum.inr b) := by + rw [potentialIsStable_iff_forall_euclid] + apply Iff.intro + · intro h + obtain ⟨c, hc⟩ := h + use c + apply And.intro + · simpa using hc 0 0 (by simp) (by simp) + · intro K0 K hk0 hle + exact hc K0 K hk0.le hle + · intro h + obtain ⟨c, hc₀, hc⟩ := h + use c + intro K0 K hK0 hle + by_cases hK0' : K0 = 0 + · subst hK0' + simp_all + · refine hc K0 K ?_ hle + grind + +lemma potentialIsStable_iff_exists_forall_forall_reduced (P : PotentialParameters) : + PotentialIsStable P ↔ ∃ c ≤ 0, ∀ K0 : ℝ, ∀ k : EuclideanSpace ℝ (Fin 3), 0 < K0 → + ‖k‖ ^ 2 ≤ 1 → c ≤ K0 * massTermReduced P k + K0 ^ 2 * quarticTermReduced P k := by + rw [potentialIsStable_iff_forall_euclid_lt] + refine exists_congr <| fun c => and_congr_right <| fun hc => forall_congr' <| fun K0 => ?_ + apply Iff.intro + · refine fun h k hK0 k_le_one => (h (K0 • k) hK0 ?_).trans (le_of_eq ?_) + · simp [norm_smul] + rw [abs_of_nonneg (by positivity), mul_pow] + nlinarith + · simp [add_assoc, massTermReduced, quarticTermReduced] + ring_nf + simp [add_assoc, mul_assoc, ← Finset.mul_sum, sq] + ring + · intro h K hK0 hle + refine (h ((1 / K0) • K) hK0 ?_).trans (le_of_eq ?_) + · simp [norm_smul] + field_simp + rw [sq_le_sq] at hle + simpa using hle + · simp [add_assoc, massTermReduced, quarticTermReduced] + ring_nf + simp [add_assoc, mul_assoc, ← Finset.mul_sum, sq] + field_simp + ring_nf + simp only [← Finset.sum_mul, Fin.isValue] + field_simp + ring + +lemma quarticTermReduced_nonneg_of_potentialIsStable (P : PotentialParameters) + (hP : PotentialIsStable P) (k : EuclideanSpace ℝ (Fin 3)) + (hk : ‖k‖ ^ 2 ≤ 1) : 0 ≤ quarticTermReduced P k := by + rw [potentialIsStable_iff_exists_forall_forall_reduced] at hP + suffices hp : ∀ (a b : ℝ), (∃ c ≤ 0, ∀ x, 0 < x → c ≤ a * x + b * x ^ 2) → + 0 ≤ b ∧ (b = 0 → 0 ≤ a) by + obtain ⟨c, hc, h⟩ := hP + refine (hp (massTermReduced P k) (quarticTermReduced P k) ⟨c, hc, ?_⟩).1 + grind + intro a b + by_cases hb : b = 0 + /- The case of b = 0. -/ + · subst hb + by_cases ha : a = 0 + · subst ha + simp + · simp only [zero_mul, add_zero, le_refl, forall_const, true_and] + rintro ⟨c, hc, hx⟩ + by_contra h2 + simp_all + refine not_lt_of_ge (hx (c/a + 1) ?_) ?_ + · exact add_pos_of_nonneg_of_pos (div_nonneg_of_nonpos hc (Std.le_of_lt h2)) + Real.zero_lt_one + · field_simp + grind + /- The case of b ≠ 0. -/ + have h1 (x : ℝ) : a * x + b * x ^ 2 = b * (x + a / (2 * b)) ^ 2 - a ^ 2 / (4 * b) := by grind + generalize a ^ 2 / (4 * b) = c1 at h1 + generalize a / (2 * b) = d at h1 + simp only [hb, IsEmpty.forall_iff, and_true] + have hlt (c : ℝ) (x : ℝ) : (c ≤ a * x + b * x ^ 2) ↔ c + c1 ≤ b * (x + d) ^ 2 := by grind + conv_lhs => enter [1, c, 2, x]; rw [hlt c] + trans ∃ c, ∀ x, 0 < x → c ≤ b * (x + d) ^ 2 + · rintro ⟨c, hc, hx⟩ + use c + c1 + rintro ⟨c, hc⟩ + by_contra hn + suffices hs : ∀ x, x ^ 2 ≤ c/b from not_lt_of_ge (hs √(|c/b| + 1)) (by grind) + suffices hs : ∀ x, 0 < x → (x + d) ^ 2 ≤ c/b from + fun x => le_trans ((Real.sqrt_le_left (by grind)).mp + (by grind [Real.sqrt_sq_eq_abs])) (hs (|x| + |d| + 1) (by positivity)) + exact fun x hx => (le_div_iff_of_neg (by grind)).mpr (by grind) + +lemma potentialIsStable_iff_massTermReduced_sq_le_quarticTermReduced (P : PotentialParameters) : + PotentialIsStable P ↔ ∃ c, 0 ≤ c ∧ ∀ k : EuclideanSpace ℝ (Fin 3), ‖k‖ ^ 2 ≤ 1 → + 0 ≤ quarticTermReduced P k ∧ + (massTermReduced P k < 0 → + massTermReduced P k ^ 2 ≤ 4 * quarticTermReduced P k * c) := by + rw [potentialIsStable_iff_exists_forall_forall_reduced] + refine Iff.intro (fun ⟨c, hc, h⟩ => ⟨-c, by grind, fun k hk => ?_⟩) + (fun ⟨c, hc, h⟩ => ⟨-c, by grind, fun K0 k hk0 hk => ?_⟩) + · have hJ4_nonneg : 0 ≤ quarticTermReduced P k := by + refine quarticTermReduced_nonneg_of_potentialIsStable P ?_ k hk + rw [potentialIsStable_iff_exists_forall_forall_reduced] + exact ⟨c, hc, h⟩ + have h0 : ∀ K0, 0 < K0 → c ≤ K0 * massTermReduced P k + K0 ^ 2 * quarticTermReduced P k := + fun K0 a => h K0 k a hk + clear h + generalize massTermReduced P k = j2 at * + generalize quarticTermReduced P k = j4 at * + by_cases j4_zero : j4 = 0 + · subst j4_zero + simp_all + intro hj2 + by_contra hn + specialize h0 ((c - 1) / j2) <| by + refine div_pos_iff.mpr (Or.inr ?_) + grind + field_simp at h0 + linarith + · have hsq (K0 : ℝ) : K0 * j2 + K0 ^ 2 * j4 = + j4 * (K0 + j2 / (2 * j4)) ^ 2 - j2 ^ 2 / (4 * j4) := by + grind + have hj_pos : 0 < j4 := by grind + apply And.intro + · grind + · intro j2_neg + conv at h0 => enter [2]; rw [hsq] + specialize h0 (- j2 / (2 * j4)) <| by + field_simp + grind + ring_nf at h0 + field_simp at h0 + grind + · specialize h k hk + generalize massTermReduced P k = j2 at * + generalize quarticTermReduced P k = j4 at * + by_cases hJ4 : j4 = 0 + · subst j4 + simp_all + trans 0 + · grind + · by_cases hJ2 : j2 = 0 + · simp_all + · simp_all + · have hJ4_pos : 0 < j4 := by grind + have h0 : K0 * j2 + K0 ^ 2 * j4 = j4 * (K0 + j2 / (2 * j4)) ^ 2 - j2 ^ 2 / (4 * j4) := by + grind + rw [h0] + by_cases hJ2_neg : j2 < 0 + · trans j4 * (K0 + j2 / (2 * j4)) ^ 2 - c + · nlinarith + · field_simp + grind + · refine neg_le_sub_iff_le_add.mpr ?_ + trans j4 * (K0 + j2 / (2 * j4)) ^ 2 + · nlinarith + · grind + +lemma massTermReduced_pos_of_quarticTermReduced_zero_potentialIsStable (P : PotentialParameters) + (hP : PotentialIsStable P) (k : EuclideanSpace ℝ (Fin 3)) + (hk : ‖k‖ ^ 2 ≤ 1) (hq : quarticTermReduced P k = 0) : 0 ≤ massTermReduced P k := by + rw [potentialIsStable_iff_massTermReduced_sq_le_quarticTermReduced] at hP + obtain ⟨c, hc₀, hc⟩ := hP + specialize hc k hk + rw [hq] at hc + simp only [le_refl, mul_zero, zero_mul, sq_nonpos_iff, true_and] at hc + generalize massTermReduced P k = j2 at * + grind + +/-! + +### E.6. Strong stability implies stability + +Stability in terms of the positivity of the quartic term, implies that the whole +potential is stable. + +-/ + +/-- The potential is stable if it is strongly stable, i.e. its quartic term is always positive. + The proof of this result relies on the compactness of the closed unit ball in + `EuclideanSpace ℝ (Fin 3)`, and the `extreme value theorem`. -/ +lemma potentialIsStable_of_strong (P : PotentialParameters) + (h : ∀ k, ‖k‖ ^ 2 ≤ 1 → 0 < quarticTermReduced P k) : + PotentialIsStable P := by + rw [potentialIsStable_iff_massTermReduced_sq_le_quarticTermReduced] + let S := Metric.closedBall (0 : EuclideanSpace ℝ (Fin 3)) 1 + have S_isCompact : IsCompact S := isCompact_closedBall 0 1 + have S_nonEmpty : S.Nonempty := ⟨0, by simp [S]⟩ + obtain ⟨kmax, kmax_S, kmax_isMax⟩ := IsCompact.exists_isMaxOn + (isCompact_closedBall 0 1) S_nonEmpty + (f := fun k => (massTermReduced P k ^ 2) / (4 * quarticTermReduced P k)) <| by + apply ContinuousOn.div₀ + · apply Continuous.continuousOn + simp only [massTermReduced, Fin.isValue] + fun_prop + · apply Continuous.continuousOn + simp only [quarticTermReduced, Fin.isValue] + fun_prop + · intro x hx + specialize h x (by simpa using hx) + linarith + use (massTermReduced P kmax) ^ 2 / (4 * quarticTermReduced P kmax) + apply And.intro + · refine (le_div_iff₀ ?_).mpr ?_ + · specialize h kmax (by simpa using kmax_S) + linarith + · simp only [zero_mul] + exact sq_nonneg (massTermReduced P kmax) + · intro k hk + apply And.intro + · specialize h k hk + linarith + · intro hq + rw [isMaxOn_iff] at kmax_isMax + refine (div_le_iff₀' ?_).mp (kmax_isMax k (by simpa using hk)) + grind + +/-! + +### E.7. Showing step in hep-ph/0605184 is invalid + +-/ + +/-- A lemma invalidating the step in https://arxiv.org/pdf/hep-ph/0605184 leading to + equation (4.4). -/ +lemma forall_reduced_exists_not_potentialIsStable : + ∃ P, ¬ PotentialIsStable P ∧ (∀ k : EuclideanSpace ℝ (Fin 3), ‖k‖ ^ 2 ≤ 1 → + 0 ≤ quarticTermReduced P k ∧ (quarticTermReduced P k = 0 → 0 ≤ massTermReduced P k)) := by + /- Construction of the explicit counter example. + The reason that this counter example works is that: + - There is a zero of the quartic term `z` on the boundary. + - The quartic term is equal to `((k - z) · z)²`, as `k - z` approaches orthogonal to `z`, + this becomes small on two accounts: the abs of `k - z` has to become small as `z` is on + the boundary, and the angle between `k - z` and `z` also becomes small. + - The mass term is of the form `-(k - z) · w` for some `w` orthogonal to `z`, so as `k - z` + approaches orthogonal to `z`, the mass term becomes small only on the account that the abs of + `k - z` becomes small. -/ + use .stabilityCounterExample + apply And.intro + /- The condition that P is not stable. -/ + · exact stabilityCounterExample_not_potentialIsStable + /- The condition on the reduced terms. -/ + · refine fun k hk => And.intro (quarticTermReduced_stabilityCounterExample_nonneg k) + (fun hq => ?_) + simp [quarticTermReduced_stabilityCounterExample] at hq + simp only [PiLp.norm_sq_eq_of_L2, Real.norm_eq_abs, sq_abs, Fin.sum_univ_three, + Fin.isValue] at hk + have hk1 : k 1 = 0 := by nlinarith + rw [massTermReduced_stabilityCounterExample, hk1] + +end TwoHiggsDoublet diff --git a/PhysLean/Particles/FlavorPhysics/CKMMatrix/PhaseFreedom.lean b/PhysLean/Particles/FlavorPhysics/CKMMatrix/PhaseFreedom.lean index 7783af8d7..4dc0756b1 100644 --- a/PhysLean/Particles/FlavorPhysics/CKMMatrix/PhaseFreedom.lean +++ b/PhysLean/Particles/FlavorPhysics/CKMMatrix/PhaseFreedom.lean @@ -301,7 +301,7 @@ lemma ubOnePhaseCond_hold_up_to_equiv_of_ub_one {V : CKMMatrix} (hb : ¬ ([V]ud apply shift_ub_phase_zero _ _ _ _ _ _ _ ring rw [hU1] - have h1:= (ud_us_neq_zero_iff_ub_neq_one V).mpr.mt hb + have h1:= (ud_us_ne_zero_iff_ub_ne_one V).mpr.mt hb simpa using h1 apply And.intro · have hτ : [V]t = cexp ((0 : ℝ) * I) • (conj ([V]u) ⨯₃ conj ([V]c)) := by @@ -331,7 +331,7 @@ lemma cd_of_fstRowThdColRealCond {V : CKMMatrix} (hb : [V]ud ≠ 0 ∨ [V]us ≠ rw [hV.1, hV.2.1, hV.2.2.1, hV.2.2.2.1] simp only [Fin.isValue, VudAbs, VcbAbs, ofReal_zero, zero_mul, exp_zero, VtbAbs, conj_ofReal, one_mul, VusAbs, neg_add_rev, normSq_ofReal, ofReal_mul, neg_mul, sq, VubAbs] - have hx := Vabs_sq_add_neq_zero hb + have hx := Vabs_sq_add_ne_zero hb field_simp have h1 : conj [V]ub = VubAbs ⟦V⟧ * cexp (- arg [V]ub * I) := by nth_rewrite 1 [← norm_mul_exp_arg_mul_I [V]ub] @@ -351,7 +351,7 @@ lemma cs_of_fstRowThdColRealCond {V : CKMMatrix} (hb : [V]ud ≠ 0 ∨ [V]us ≠ rw [cs_of_ud_us_ub_cb_tb hb hτ, hV.1, hV.2.1, hV.2.2.1, hV.2.2.2.1] simp only [Fin.isValue, VusAbs, neg_mul, VcbAbs, ofReal_zero, zero_mul, exp_zero, VtbAbs, conj_ofReal, one_mul, VudAbs, normSq_ofReal, ofReal_mul, sq, VubAbs] - have hx := Vabs_sq_add_neq_zero hb + have hx := Vabs_sq_add_ne_zero hb field_simp have h1 : conj [V]ub = VubAbs ⟦V⟧ * cexp (- arg [V]ub * I) := by nth_rewrite 1 [← norm_mul_exp_arg_mul_I [V]ub] diff --git a/PhysLean/Particles/FlavorPhysics/CKMMatrix/Relations.lean b/PhysLean/Particles/FlavorPhysics/CKMMatrix/Relations.lean index 69ff5f524..c8c520f56 100644 --- a/PhysLean/Particles/FlavorPhysics/CKMMatrix/Relations.lean +++ b/PhysLean/Particles/FlavorPhysics/CKMMatrix/Relations.lean @@ -76,7 +76,7 @@ lemma normSq_Vud_plus_normSq_Vus (V : CKMMatrix) : lemma VudAbs_sq_add_VusAbs_sq : VudAbs V ^ 2 + VusAbs V ^2 = 1 - VubAbs V ^2 := by linear_combination VAbs_sum_sq_row_eq_one V 0 -lemma ud_us_neq_zero_iff_ub_neq_one (V : CKMMatrix) : +lemma ud_us_ne_zero_iff_ub_ne_one (V : CKMMatrix) : [V]ud ≠ 0 ∨ [V]us ≠ 0 ↔ norm [V]ub ≠ 1 := by have h2 := V.fst_row_normalized_abs refine Iff.intro (fun h h1 => ?_) (fun h => ?_) @@ -93,10 +93,10 @@ lemma ud_us_neq_zero_iff_ub_neq_one (V : CKMMatrix) : refine (?_ : ¬ 0 ≤ (-1 : ℝ)) h1 simp -lemma normSq_Vud_plus_normSq_Vus_neq_zero_ℝ {V : CKMMatrix} (hb : [V]ud ≠ 0 ∨ [V]us ≠ 0) : +lemma normSq_Vud_plus_normSq_Vus_ne_zero_ℝ {V : CKMMatrix} (hb : [V]ud ≠ 0 ∨ [V]us ≠ 0) : normSq [V]ud + normSq [V]us ≠ 0 := by rw [normSq_Vud_plus_normSq_Vus V] - rw [ud_us_neq_zero_iff_ub_neq_one] at hb + rw [ud_us_ne_zero_iff_ub_ne_one] at hb by_contra hn rw [← Complex.sq_norm] at hn have h2 : norm (V.1 0 2) ^2 = 1 := by @@ -109,33 +109,33 @@ lemma normSq_Vud_plus_normSq_Vus_neq_zero_ℝ {V : CKMMatrix} (hb : [V]ud ≠ 0 have h2 : ¬ 0 ≤ (-1 : ℝ) := by simp exact h2 h3 -lemma VAbsub_neq_zero_Vud_Vus_neq_zero {V : Quotient CKMMatrixSetoid} +lemma VAbsub_ne_zero_Vud_Vus_ne_zero {V : Quotient CKMMatrixSetoid} (hV : VAbs 0 2 V ≠ 1) :(VudAbs V ^ 2 + VusAbs V ^ 2) ≠ 0 := by obtain ⟨V⟩ := V change VubAbs ⟦V⟧ ≠ 1 at hV simp only [VubAbs, VAbs, VAbs', Fin.isValue, Quotient.lift_mk] at hV - rw [← ud_us_neq_zero_iff_ub_neq_one V] at hV - simpa [← Complex.sq_norm] using (normSq_Vud_plus_normSq_Vus_neq_zero_ℝ hV) + rw [← ud_us_ne_zero_iff_ub_ne_one V] at hV + simpa [← Complex.sq_norm] using (normSq_Vud_plus_normSq_Vus_ne_zero_ℝ hV) -lemma VAbsub_neq_zero_sqrt_Vud_Vus_neq_zero {V : Quotient CKMMatrixSetoid} +lemma VAbsub_ne_zero_sqrt_Vud_Vus_ne_zero {V : Quotient CKMMatrixSetoid} (hV : VAbs 0 2 V ≠ 1) : √(VudAbs V ^ 2 + VusAbs V ^ 2) ≠ 0 := by obtain ⟨V⟩ := V rw [Real.sqrt_ne_zero (Left.add_nonneg (sq_nonneg _) (sq_nonneg _))] change VubAbs ⟦V⟧ ≠ 1 at hV simp only [VubAbs, VAbs, VAbs', Fin.isValue, Quotient.lift_mk] at hV - rw [← ud_us_neq_zero_iff_ub_neq_one V] at hV - simpa [← Complex.sq_norm] using (normSq_Vud_plus_normSq_Vus_neq_zero_ℝ hV) + rw [← ud_us_ne_zero_iff_ub_ne_one V] at hV + simpa [← Complex.sq_norm] using (normSq_Vud_plus_normSq_Vus_ne_zero_ℝ hV) -lemma normSq_Vud_plus_normSq_Vus_neq_zero_ℂ {V : CKMMatrix} (hb : [V]ud ≠ 0 ∨ [V]us ≠ 0) : +lemma normSq_Vud_plus_normSq_Vus_ne_zero_ℂ {V : CKMMatrix} (hb : [V]ud ≠ 0 ∨ [V]us ≠ 0) : (normSq [V]ud : ℂ) + normSq [V]us ≠ 0 := by - have h1 := normSq_Vud_plus_normSq_Vus_neq_zero_ℝ hb + have h1 := normSq_Vud_plus_normSq_Vus_ne_zero_ℝ hb simp only [Fin.isValue, ne_eq] at h1 rw [← ofReal_inj] at h1 simp_all -lemma Vabs_sq_add_neq_zero {V : CKMMatrix} (hb : [V]ud ≠ 0 ∨ [V]us ≠ 0) : +lemma Vabs_sq_add_ne_zero {V : CKMMatrix} (hb : [V]ud ≠ 0 ∨ [V]us ≠ 0) : ((VudAbs ⟦V⟧ : ℂ) * ↑(VudAbs ⟦V⟧) + ↑(VusAbs ⟦V⟧) * ↑(VusAbs ⟦V⟧)) ≠ 0 := by - have h1 := normSq_Vud_plus_normSq_Vus_neq_zero_ℂ hb + have h1 := normSq_Vud_plus_normSq_Vus_ne_zero_ℂ hb rw [← Complex.sq_norm, ← Complex.sq_norm] at h1 simp only [Fin.isValue, sq, ofReal_mul, ne_eq] at h1 exact h1 @@ -237,7 +237,7 @@ lemma cs_of_ud_us_ub_cb_tb {V : CKMMatrix} (h : [V]ud ≠ 0 ∨ [V]us ≠ 0) {τ : ℝ} (hτ : [V]t = cexp (τ * I) • (conj ([V]u) ⨯₃ conj ([V]c))) : [V]cs = (- conj [V]ub * [V]us * [V]cb + cexp (τ * I) * conj [V]tb * conj [V]ud) / (normSq [V]ud + normSq [V]us) := by - have h1 := normSq_Vud_plus_normSq_Vus_neq_zero_ℂ h + have h1 := normSq_Vud_plus_normSq_Vus_ne_zero_ℂ h rw [conj_Vtb_mul_Vud hτ] field_simp ring @@ -246,7 +246,7 @@ lemma cd_of_ud_us_ub_cb_tb {V : CKMMatrix} (h : [V]ud ≠ 0 ∨ [V]us ≠ 0) {τ : ℝ} (hτ : [V]t = cexp (τ * I) • (conj ([V]u) ⨯₃ conj ([V]c))) : [V]cd = - (conj [V]ub * [V]ud * [V]cb + cexp (τ * I) * conj [V]tb * conj [V]us) / (normSq [V]ud + normSq [V]us) := by - have h1 := normSq_Vud_plus_normSq_Vus_neq_zero_ℂ h + have h1 := normSq_Vud_plus_normSq_Vus_ne_zero_ℂ h rw [conj_Vtb_mul_Vus hτ] field_simp ring @@ -338,7 +338,7 @@ lemma VcbAbs_sq_add_VtbAbs_sq (V : Quotient CKMMatrixSetoid) : VcbAbs V ^ 2 + VtbAbs V ^ 2 = 1 - VubAbs V ^2 := by linear_combination (VAbs_sum_sq_col_eq_one V 2) -lemma cb_tb_neq_zero_iff_ub_neq_one (V : CKMMatrix) : +lemma cb_tb_ne_zero_iff_ub_ne_one (V : CKMMatrix) : [V]cb ≠ 0 ∨ [V]tb ≠ 0 ↔ norm [V]ub ≠ 1 := by have h2 := V.thd_col_normalized_abs refine Iff.intro (fun h h1 => ?_) (fun h => ?_) diff --git a/PhysLean/Particles/FlavorPhysics/CKMMatrix/StandardParameterization/StandardParameters.lean b/PhysLean/Particles/FlavorPhysics/CKMMatrix/StandardParameterization/StandardParameters.lean index b58a5ea11..c20577568 100644 --- a/PhysLean/Particles/FlavorPhysics/CKMMatrix/StandardParameterization/StandardParameters.lean +++ b/PhysLean/Particles/FlavorPhysics/CKMMatrix/StandardParameterization/StandardParameters.lean @@ -171,7 +171,7 @@ lemma S₁₃_of_Vub_one {V : Quotient CKMMatrixSetoid} (ha : VubAbs V = 1) : S lemma S₂₃_of_Vub_eq_one {V : Quotient CKMMatrixSetoid} (ha : VubAbs V = 1) : S₂₃ V = VcdAbs V := by rw [S₂₃, if_pos ha] -lemma S₂₃_of_Vub_neq_one {V : Quotient CKMMatrixSetoid} (ha : VubAbs V ≠ 1) : +lemma S₂₃_of_Vub_ne_one {V : Quotient CKMMatrixSetoid} (ha : VubAbs V ≠ 1) : S₂₃ V = VcbAbs V / √ (VudAbs V ^ 2 + VusAbs V ^ 2) := by rw [S₂₃, if_neg ha] @@ -239,7 +239,7 @@ lemma C₁₂_eq_Vud_div_sqrt {V : Quotient CKMMatrixSetoid} (ha : VubAbs V ≠ · rw [Real.sqrt_sq] · exact VAbs_ge_zero 0 0 V exact sq_nonneg (VAbs 0 0 V) - exact VAbsub_neq_zero_Vud_Vus_neq_zero ha + exact VAbsub_ne_zero_Vud_Vus_ne_zero ha exact (Left.add_nonneg (sq_nonneg (VAbs 0 0 V)) (sq_nonneg (VAbs 0 1 V))) --rename @@ -249,16 +249,16 @@ lemma C₁₃_eq_add_sq (V : Quotient CKMMatrixSetoid) : C₁₃ V = √ (VudAbs linear_combination - (VAbs_sum_sq_row_eq_one V 0) rw [h1] -lemma C₂₃_of_Vub_neq_one {V : Quotient CKMMatrixSetoid} (ha : VubAbs V ≠ 1) : +lemma C₂₃_of_Vub_ne_one {V : Quotient CKMMatrixSetoid} (ha : VubAbs V ≠ 1) : C₂₃ V = VtbAbs V / √ (VudAbs V ^ 2 + VusAbs V ^ 2) := by - rw [C₂₃, θ₂₃, Real.cos_arcsin, S₂₃_of_Vub_neq_one ha, div_pow, Real.sq_sqrt] + rw [C₂₃, θ₂₃, Real.cos_arcsin, S₂₃_of_Vub_ne_one ha, div_pow, Real.sq_sqrt] · rw [VudAbs_sq_add_VusAbs_sq, ← VcbAbs_sq_add_VtbAbs_sq] rw [one_sub_div] · simp only [VcbAbs, Fin.isValue, VtbAbs, add_sub_cancel_left] rw [Real.sqrt_div (sq_nonneg (VAbs 2 2 V))] rw [Real.sqrt_sq (VAbs_ge_zero 2 2 V)] · rw [VcbAbs_sq_add_VtbAbs_sq, ← VudAbs_sq_add_VusAbs_sq] - exact VAbsub_neq_zero_Vud_Vus_neq_zero ha + exact VAbsub_ne_zero_Vud_Vus_ne_zero ha exact (Left.add_nonneg (sq_nonneg (VAbs 0 0 V)) (sq_nonneg (VAbs 0 1 V))) end cosines @@ -276,7 +276,7 @@ lemma VudAbs_eq_C₁₂_mul_C₁₃ (V : Quotient CKMMatrixSetoid) : VudAbs V = have h1 : 1 - VubAbs V ^ 2 = VudAbs V ^ 2 + VusAbs V ^ 2 := by linear_combination - (VAbs_sum_sq_row_eq_one V 0) rw [h1, mul_comm] - exact (mul_div_cancel₀ (VudAbs V) (VAbsub_neq_zero_sqrt_Vud_Vus_neq_zero ha)).symm + exact (mul_div_cancel₀ (VudAbs V) (VAbsub_ne_zero_sqrt_Vud_Vus_ne_zero ha)).symm lemma VusAbs_eq_S₁₂_mul_C₁₃ (V : Quotient CKMMatrixSetoid) : VusAbs V = S₁₂ V * C₁₃ V := by rw [C₁₃, θ₁₃, Real.cos_arcsin, S₁₂, S₁₃] @@ -290,7 +290,7 @@ lemma VusAbs_eq_S₁₂_mul_C₁₃ (V : Quotient CKMMatrixSetoid) : VusAbs V = rw [← h1] simp only [Real.sqrt_zero, div_zero, mul_zero] exact VAbs_thd_eq_one_snd_eq_zero ha - · have h2 := VAbsub_neq_zero_sqrt_Vud_Vus_neq_zero ha + · have h2 := VAbsub_ne_zero_sqrt_Vud_Vus_ne_zero ha exact (mul_div_cancel₀ (VusAbs V) h2).symm lemma VubAbs_eq_S₁₃ (V : Quotient CKMMatrixSetoid) : VubAbs V = S₁₃ V := rfl @@ -300,16 +300,16 @@ lemma VcbAbs_eq_S₂₃_mul_C₁₃ (V : Quotient CKMMatrixSetoid) : VcbAbs V = · rw [C₁₃_of_Vub_eq_one ha] simp only [VcbAbs, Fin.isValue, mul_zero] exact VAbs_fst_col_eq_one_snd_eq_zero ha - · rw [S₂₃_of_Vub_neq_one ha, C₁₃_eq_add_sq, mul_comm] - exact (mul_div_cancel₀ (VcbAbs V) (VAbsub_neq_zero_sqrt_Vud_Vus_neq_zero ha)).symm + · rw [S₂₃_of_Vub_ne_one ha, C₁₃_eq_add_sq, mul_comm] + exact (mul_div_cancel₀ (VcbAbs V) (VAbsub_ne_zero_sqrt_Vud_Vus_ne_zero ha)).symm lemma VtbAbs_eq_C₂₃_mul_C₁₃ (V : Quotient CKMMatrixSetoid) : VtbAbs V = C₂₃ V * C₁₃ V := by by_cases ha : VubAbs V = 1 · rw [C₁₃_of_Vub_eq_one ha] simp only [VtbAbs, Fin.isValue, mul_zero] exact VAbs_fst_col_eq_one_thd_eq_zero ha - · rw [C₂₃_of_Vub_neq_one ha, C₁₃_eq_add_sq, mul_comm] - exact (mul_div_cancel₀ (VtbAbs V) (VAbsub_neq_zero_sqrt_Vud_Vus_neq_zero ha)).symm + · rw [C₂₃_of_Vub_ne_one ha, C₁₃_eq_add_sq, mul_comm] + exact (mul_div_cancel₀ (VtbAbs V) (VAbsub_ne_zero_sqrt_Vud_Vus_ne_zero ha)).symm lemma VubAbs_of_cos_θ₁₃_zero {V : Quotient CKMMatrixSetoid} (h1 : Real.cos (θ₁₃ V) = 0) : VubAbs V = 1 := by @@ -375,7 +375,7 @@ lemma mulExpδ₁₃_on_param_abs (V : CKMMatrix) (δ₁₃ : ℝ) : rw [complexAbs_sin_θ₁₃, complexAbs_cos_θ₁₃, complexAbs_sin_θ₁₂, complexAbs_cos_θ₁₂, complexAbs_sin_θ₂₃, complexAbs_cos_θ₂₃] -lemma mulExpδ₁₃_on_param_neq_zero_arg (V : CKMMatrix) (δ₁₃ : ℝ) +lemma mulExpδ₁₃_on_param_ne_zero_arg (V : CKMMatrix) (δ₁₃ : ℝ) (h1 : mulExpδ₁₃ ⟦standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃⟧ ≠ 0) : cexp (arg (mulExpδ₁₃ ⟦standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃⟧) * I) = cexp (δ₁₃ * I) := by @@ -387,11 +387,11 @@ lemma mulExpδ₁₃_on_param_neq_zero_arg (V : CKMMatrix) (δ₁₃ : ℝ) ring_nf nth_rewrite 1 [← norm_mul_exp_arg_mul_I (mulExpδ₁₃ ⟦standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃⟧)] at h2 - have habs_neq_zero : + have habs_ne_zero : (norm (mulExpδ₁₃ ⟦standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃⟧) : ℂ) ≠ 0 := by simp only [ne_eq, ofReal_eq_zero, norm_eq_zero] exact h1 - rw [← mul_right_inj' habs_neq_zero] + rw [← mul_right_inj' habs_ne_zero] rw [← h2] lemma on_param_cos_θ₁₃_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.cos (θ₁₃ ⟦V⟧) = 0) : @@ -533,14 +533,14 @@ lemma on_param_sin_θ₂₃_eq_zero {V : CKMMatrix} (δ₁₃ : ℝ) (h : Real.s lemma eq_standParam_of_fstRowThdColRealCond {V : CKMMatrix} (hb : [V]ud ≠ 0 ∨ [V]us ≠ 0) (hV : FstRowThdColRealCond V) : V = standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) (- arg [V]ub) := by have hb' : VubAbs ⟦V⟧ ≠ 1 := by - rw [ud_us_neq_zero_iff_ub_neq_one] at hb + rw [ud_us_ne_zero_iff_ub_ne_one] at hb exact hb have h1 : ofRealHom (√(VAbs 0 0 ⟦V⟧ ^ 2 + VAbs 0 1 ⟦V⟧ ^ 2) * ↑√(VAbs 0 0 ⟦V⟧ ^ 2 + VAbs 0 1 ⟦V⟧ ^ 2)) = ofRealHom (VAbs 0 0 ⟦V⟧ ^ 2 + VAbs 0 1 ⟦V⟧ ^ 2) := by rw [Real.mul_self_sqrt] apply add_nonneg (sq_nonneg _) (sq_nonneg _) simp only [Fin.isValue, _root_.map_mul, ofRealHom_eq_coe, map_add, map_pow] at h1 - have hx := Vabs_sq_add_neq_zero hb + have hx := Vabs_sq_add_ne_zero hb refine eq_rows V ?_ ?_ hV.2.2.2.2 · funext i fin_cases i @@ -573,8 +573,8 @@ lemma eq_standParam_of_fstRowThdColRealCond {V : CKMMatrix} (hb : [V]ud ≠ 0 tail_cons] rw [cd_of_fstRowThdColRealCond hb hV] rw [S₁₂_eq_ℂsin_θ₁₂ ⟦V⟧, S₁₂, C₁₂_eq_ℂcos_θ₁₂ ⟦V⟧, C₁₂_eq_Vud_div_sqrt hb'] - rw [S₂₃_eq_ℂsin_θ₂₃ ⟦V⟧, S₂₃_of_Vub_neq_one hb', C₂₃_eq_ℂcos_θ₂₃ ⟦V⟧, - C₂₃_of_Vub_neq_one hb', S₁₃_eq_ℂsin_θ₁₃ ⟦V⟧, S₁₃] + rw [S₂₃_eq_ℂsin_θ₂₃ ⟦V⟧, S₂₃_of_Vub_ne_one hb', C₂₃_eq_ℂcos_θ₂₃ ⟦V⟧, + C₂₃_of_Vub_ne_one hb', S₁₃_eq_ℂsin_θ₁₃ ⟦V⟧, S₁₃] simp only [VtbAbs, Fin.isValue, VusAbs, neg_mul, VudAbs, VubAbs, VcbAbs, ofReal_div] field_simp conv_rhs => rw [sq, h1] @@ -587,7 +587,7 @@ lemma eq_standParam_of_fstRowThdColRealCond {V : CKMMatrix} (hb : [V]ud ≠ 0 tail_cons] rw [C₁₂_eq_ℂcos_θ₁₂ ⟦V⟧, C₂₃_eq_ℂcos_θ₂₃ ⟦V⟧, S₁₂_eq_ℂsin_θ₁₂ ⟦V⟧, S₁₃_eq_ℂsin_θ₁₃ ⟦V⟧, S₂₃_eq_ℂsin_θ₂₃ ⟦V⟧] - rw [C₁₂_eq_Vud_div_sqrt hb', C₂₃_of_Vub_neq_one hb', S₁₂, S₁₃, S₂₃_of_Vub_neq_one hb'] + rw [C₁₂_eq_Vud_div_sqrt hb', C₂₃_of_Vub_ne_one hb', S₁₂, S₁₃, S₂₃_of_Vub_ne_one hb'] rw [cs_of_fstRowThdColRealCond hb hV] simp only [VtbAbs, Fin.isValue, VudAbs, VusAbs, VubAbs, neg_mul, VcbAbs, ofReal_div] field_simp @@ -706,7 +706,7 @@ theorem eq_standardParameterization_δ₃ (V : CKMMatrix) : have hSV := (Quotient.eq.mpr (hδ₃)) by_cases h : Invariant.mulExpδ₁₃ ⟦standParam (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃'⟧ ≠ 0 · have h2 := eq_exp_of_phases (θ₁₂ ⟦V⟧) (θ₁₃ ⟦V⟧) (θ₂₃ ⟦V⟧) δ₁₃' - (δ₁₃ ⟦V⟧) (by rw [← mulExpδ₁₃_on_param_neq_zero_arg V δ₁₃' h, + (δ₁₃ ⟦V⟧) (by rw [← mulExpδ₁₃_on_param_ne_zero_arg V δ₁₃' h, ← hSV, δ₁₃, Invariant.mulExpδ₁₃]) rw [h2] at hδ₃ exact hδ₃ diff --git a/PhysLean/Particles/StandardModel/AnomalyCancellation/Basic.lean b/PhysLean/Particles/StandardModel/AnomalyCancellation/Basic.lean index dd11ec7a3..3650c5e29 100644 --- a/PhysLean/Particles/StandardModel/AnomalyCancellation/Basic.lean +++ b/PhysLean/Particles/StandardModel/AnomalyCancellation/Basic.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.QFT.AnomalyCancellation.Basic +import Mathlib.Tactic.LinearCombination /-! # Anomaly cancellation conditions for the n-family SM. diff --git a/PhysLean/Particles/StandardModel/AnomalyCancellation/NoGrav/One/Lemmas.lean b/PhysLean/Particles/StandardModel/AnomalyCancellation/NoGrav/One/Lemmas.lean index d995bee37..c008ea783 100644 --- a/PhysLean/Particles/StandardModel/AnomalyCancellation/NoGrav/One/Lemmas.lean +++ b/PhysLean/Particles/StandardModel/AnomalyCancellation/NoGrav/One/Lemmas.lean @@ -50,7 +50,7 @@ lemma accGrav_Q_zero {S : (SMNoGrav 1).Sols} (hQ : Q S.val (0 : Fin 1) = 0) : /-- For a set of 1-family SM charges satisfying all ACCs except the gravitational, if the `Q` charge is not zero then the charges satisfy the gravitational ACCs. -/ -lemma accGrav_Q_neq_zero {S : (SMNoGrav 1).Sols} (hQ : Q S.val (0 : Fin 1) ≠ 0) : +lemma accGrav_Q_ne_zero {S : (SMNoGrav 1).Sols} (hQ : Q S.val (0 : Fin 1) ≠ 0) : accGrav S.val = 0 := by have hE := E_zero_iff_Q_zero.mpr.mt hQ let S' := linearParametersQENeqZero.bijection.symm ⟨S.1.1, And.intro hQ hE⟩ @@ -66,7 +66,7 @@ theorem accGravSatisfied {S : (SMNoGrav 1).Sols} : accGrav S.val = 0 := by by_cases hQ : Q S.val (0 : Fin 1)= 0 · exact accGrav_Q_zero hQ - · exact accGrav_Q_neq_zero hQ + · exact accGrav_Q_ne_zero hQ end One end SMNoGrav diff --git a/PhysLean/Particles/StandardModel/Basic.lean b/PhysLean/Particles/StandardModel/Basic.lean index cb9e2fd16..8927bf029 100644 --- a/PhysLean/Particles/StandardModel/Basic.lean +++ b/PhysLean/Particles/StandardModel/Basic.lean @@ -72,6 +72,38 @@ instance : InvolutiveStar GaugeGroupI where star_involutive g := by ext1 <;> simp +/-- The inclusion of a U(1) subgroup. -/ +def ofU1Subgroup (u1 : unitary ℂ) : GaugeGroupI := + (1, + ⟨!![star (u1 ^ 3 : unitary ℂ), 0;0, (u1 ^ 3 : unitary ℂ)], by + simp only [SetLike.mem_coe] + rw [mem_unitaryGroup_iff'] + funext i j + rw [Matrix.mul_apply] + fin_cases i <;> fin_cases j <;> simp [conj_mul'], by + simp only [RCLike.star_def, SetLike.mem_coe, MonoidHom.mem_mker, coe_detMonoidHom, + det_fin_two_of, conj_mul', mul_zero, sub_zero] + simp⟩, u1) + +@[simp] +lemma ofU1Subgroup_toSU3 (u1 : unitary ℂ) : + toSU3 (ofU1Subgroup u1) = 1 := rfl + +@[simp] +lemma ofU1Subgroup_toSU2 (u1 : unitary ℂ) : + toSU2 (ofU1Subgroup u1) = ⟨!![star (u1 ^ 3 : unitary ℂ), 0;0, (u1 ^ 3 : unitary ℂ)], by + simp only [SetLike.mem_coe] + rw [mem_unitaryGroup_iff'] + funext i j + rw [Matrix.mul_apply] + fin_cases i <;> fin_cases j <;> simp [conj_mul'], by + simp only [RCLike.star_def, SetLike.mem_coe, MonoidHom.mem_mker, coe_detMonoidHom, + det_fin_two_of, conj_mul', mul_zero, sub_zero] + simp⟩ := rfl + +@[simp] +lemma ofU1Subgroup_toU1 (u1 : unitary ℂ) : + toU1 (ofU1Subgroup u1) = u1 := rfl end GaugeGroupI /-- The subgroup of the un-quotiented gauge group which acts trivially on all particles in the diff --git a/PhysLean/Particles/StandardModel/HiggsBoson/Basic.lean b/PhysLean/Particles/StandardModel/HiggsBoson/Basic.lean index c8bd3717a..d127ff8eb 100644 --- a/PhysLean/Particles/StandardModel/HiggsBoson/Basic.lean +++ b/PhysLean/Particles/StandardModel/HiggsBoson/Basic.lean @@ -4,8 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Particles.StandardModel.Basic -import Mathlib.Geometry.Manifold.VectorBundle.SmoothSection import Mathlib.Analysis.InnerProductSpace.Adjoint +import Mathlib.Geometry.Manifold.VectorBundle.SmoothSection /-! # The Higgs field @@ -139,7 +139,7 @@ as `(√a, 0)`. This has the property that it's norm is equal to `a`. /-- Generating a Higgs vector from a real number, such that the norm-squared of that Higgs vector is the given real number. -/ def ofReal (a : ℝ) : HiggsVec := - ![Real.sqrt a, 0] + !₂[Real.sqrt a, 0] @[simp] lemma ofReal_normSq {a : ℝ} (ha : 0 ≤ a) : ‖ofReal a‖ ^ 2 = a := by @@ -165,15 +165,20 @@ The gauge group of the Standard Model acts on `HiggsVec` by matrix multiplicatio -/ instance : SMul StandardModel.GaugeGroupI HiggsVec where - smul g φ := g.toU1 ^ 3 • (g.toSU2.1 *ᵥ φ) + smul g φ := WithLp.toLp 2 <| g.toU1 ^ 3 • (g.toSU2.1 *ᵥ φ.ofLp) lemma gaugeGroupI_smul_eq (g : StandardModel.GaugeGroupI) (φ : HiggsVec) : - g • φ = g.toU1 ^ 3 • (g.toSU2.1 *ᵥ φ) := rfl + g • φ = (WithLp.toLp 2 <| g.toU1 ^ 3 • (g.toSU2.1 *ᵥ φ.ofLp)) := rfl lemma gaugeGroupI_smul_eq_U1_mul_SU2 (g : StandardModel.GaugeGroupI) (φ : HiggsVec) : - g • φ = g.toSU2.1 *ᵥ (g.toU1 ^ 3 • φ) := by + g • φ = (WithLp.toLp 2 <| g.toSU2.1 *ᵥ (g.toU1 ^ 3 • φ.ofLp)) := by rw [gaugeGroupI_smul_eq, ← mulVec_smul] +lemma gaugeGroupI_smul_eq_U1_smul_SU2 (g : StandardModel.GaugeGroupI) (φ : HiggsVec) : + g • φ = (WithLp.toLp 2 <| (g.toU1 ^ 3 • g.toSU2.1) *ᵥ φ.ofLp) := by + rw [gaugeGroupI_smul_eq] + rw [Matrix.smul_mulVec] + instance : MulAction StandardModel.GaugeGroupI HiggsVec where one_smul φ := by simp [gaugeGroupI_smul_eq] mul_smul g₁ g₂ φ := by @@ -182,6 +187,14 @@ instance : MulAction StandardModel.GaugeGroupI HiggsVec where congr simp [mul_pow] +instance : DistribMulAction StandardModel.GaugeGroupI HiggsVec where + smul_zero g := by + rw [gaugeGroupI_smul_eq_U1_smul_SU2] + simp + smul_add g φ ψ := by + rw [gaugeGroupI_smul_eq_U1_smul_SU2] + simp [mulVec_add] + simp [← gaugeGroupI_smul_eq_U1_smul_SU2] /-! #### A.5.2. Unitary nature of the action @@ -197,7 +210,6 @@ lemma gaugeGroupI_smul_inner (g : StandardModel.GaugeGroupI) (φ ψ : HiggsVec) calc ⟪g • φ, g • ψ⟫_ℂ _ = WithLp.ofLp (g • ψ) ⬝ᵥ star (WithLp.ofLp (g • φ)) := by rw [EuclideanSpace.inner_eq_star_dotProduct] - _ = (g • ψ) ⬝ᵥ star (g • φ) := by rfl _ = (g.toSU2.1 *ᵥ (g.toU1 ^ 3 • ψ)) ⬝ᵥ star (g.toSU2.1 *ᵥ (g.toU1 ^ 3 • φ)) := by rw [gaugeGroupI_smul_eq_U1_mul_SU2, gaugeGroupI_smul_eq_U1_mul_SU2] _ = (g.toSU2.1 *ᵥ (g.toU1 ^ 3 • ψ)) ⬝ᵥ (star ((g.toU1 ^ 3 • φ)) ᵥ* star (g.toSU2.1)) := by @@ -205,6 +217,7 @@ lemma gaugeGroupI_smul_inner (g : StandardModel.GaugeGroupI) (φ ψ : HiggsVec) rfl _ = ((star (g.toSU2.1) * g.toSU2.1) *ᵥ (g.toU1 ^ 3 • ψ)) ⬝ᵥ star ((g.toU1 ^ 3 • φ)) := by rw [dotProduct_comm, ← Matrix.dotProduct_mulVec, dotProduct_comm, mulVec_mulVec] + rfl _ = ((g.toU1 ^ 3 • ψ)) ⬝ᵥ star ((g.toU1 ^ 3 • φ)) := by rw [mem_unitaryGroup_iff'.mp (GaugeGroupI.toSU2 g).2.1] simp @@ -216,14 +229,14 @@ lemma gaugeGroupI_smul_inner (g : StandardModel.GaugeGroupI) (φ ψ : HiggsVec) simp rfl _ = (ψ ⬝ᵥ star (φ.toFin2ℂ)) := by - rw [dotProduct_smul, smul_dotProduct, smul_smul, unitary.star_mul_self] + erw [dotProduct_smul, smul_dotProduct, smul_smul, Unitary.star_mul_self] simp @[simp] lemma gaugeGroupI_smul_norm (g : StandardModel.GaugeGroupI) (φ : HiggsVec) : ‖g • φ‖ = ‖φ‖ := by rw [norm_eq_sqrt_re_inner (𝕜 := ℂ), norm_eq_sqrt_re_inner (𝕜 := ℂ)] - simp + rw [gaugeGroupI_smul_inner] /-! @@ -268,7 +281,7 @@ def toRealGroupElem (φ : HiggsVec) : GaugeGroupI := field_simp rw [h0'] ring - /- Determinant equals zeor. -/ + /- Determinant equals zero. -/ · have h1 : (‖φ‖ : ℂ) ≠ 0 := ofReal_inj.mp.mt (norm_ne_zero_iff.mpr hφ) simp [det_fin_two] field_simp @@ -356,6 +369,71 @@ informal_lemma stability_group where deps := [``HiggsVec] tag := "6V2MO" +/-! + +## A.8. Gauge action removing phase from second component + +-/ + +lemma ofU1Subgroup_smul_eq_smul (g : unitary ℂ) (φ : HiggsVec) : + (StandardModel.GaugeGroupI.ofU1Subgroup g) • φ = + (WithLp.toLp 2 <| !![1, 0; 0, g.1 ^ 6] *ᵥ φ.ofLp) := by + rw [gaugeGroupI_smul_eq_U1_smul_SU2] + simp only [GaugeGroupI.ofU1Subgroup_toU1, GaugeGroupI.ofU1Subgroup_toSU2, SubmonoidClass.coe_pow, + star_pow, RCLike.star_def, smul_of, smul_cons, smul_zero, smul_empty, cons_mulVec, + cons_dotProduct, zero_mul, dotProduct_of_isEmpty, add_zero, zero_add, empty_mulVec, one_mul, + WithLp.toLp.injEq, vecCons_inj, mul_eq_mul_right_iff, and_true] + apply And.intro + · have h0 : g ^ 3 • (starRingEnd ℂ) ↑g ^ 3 = 1 := by + trans (normSq (g ^ 3).1 : ℂ) + · rw [← mul_conj] + simp + rfl + · rw [normSq_eq_norm_sq] + simp + simp [h0] + · left + trans (g ^ 3 : ℂ) • (g ^ 3 : ℂ) + · rfl + simp only [smul_eq_mul] + ring + +lemma gaugeGroupI_smul_phase_snd (φ : HiggsVec) : + ∃ g : StandardModel.GaugeGroupI, + (g • φ).ofLp 1 = ‖(φ.ofLp 1)‖ ∧ + (∀ φ1 : HiggsVec, (g • φ1).ofLp 0 = φ1.ofLp 0) ∧ + (∀ a : ℝ, g • (!₂[a, 0] : HiggsVec) = (!₂[a, 0] : HiggsVec)) := by + let θ := arg (φ 1) + use StandardModel.GaugeGroupI.ofU1Subgroup ⟨Complex.exp (-I * θ / 6), by + rw [Unitary.mem_iff] + simp [← Complex.exp_conj, ← Complex.exp_add, Complex.conj_ofNat] + ring_nf + simp⟩ + apply And.intro + · rw [ofU1Subgroup_smul_eq_smul] + simp only [Fin.isValue, neg_mul, cons_mulVec, cons_dotProduct, one_mul, zero_mul, + dotProduct_of_isEmpty, add_zero, zero_add, empty_mulVec, cons_val_one, cons_val_fin_one] + trans Complex.exp (-I * θ / 6) ^ 6 * φ.ofLp 1 + · congr + simp + have habs : φ.ofLp 1 = cexp (I * arg (φ.ofLp 1)) * ‖φ.ofLp 1‖ := by + conv_lhs => rw [← Complex.norm_mul_exp_arg_mul_I (φ.ofLp 1)] + ring_nf + conv_lhs => rw [habs] + rw [← mul_assoc, ← Complex.exp_nat_mul, ← Complex.exp_add] + simp [θ] + ring_nf + simp + apply And.intro + · intro φ + rw [ofU1Subgroup_smul_eq_smul] + simp + rfl + · intro a + simp [ofU1Subgroup_smul_eq_smul] + ext i + fin_cases i <;> simp + end HiggsVec /-! @@ -467,7 +545,7 @@ lemma const_toHiggsVec_apply (φ : HiggsField) (x : SpaceTime) : const (φ.toHiggsVec x) x = φ x := rfl lemma toFin2ℂ_comp_toHiggsVec (φ : HiggsField) : - toFin2ℂ ∘ φ.toHiggsVec = φ := rfl + φ.toHiggsVec = φ := rfl /-! @@ -477,12 +555,23 @@ We prove some smoothness properties of the components of a Higgs field. -/ -lemma toVec_smooth (φ : HiggsField) : ContMDiff 𝓘(ℝ, SpaceTime) 𝓘(ℝ, Fin 2 → ℂ) ⊤ φ := - smooth_toFin2ℂ.comp φ.toHiggsVec_smooth +@[fun_prop] +lemma contDiff (φ : HiggsField) : + ContDiff ℝ ⊤ φ := by + simpa [contMDiff_iff_contDiff] using φ.toHiggsVec_smooth + +lemma toVec_smooth (φ : HiggsField) : + ContMDiff 𝓘(ℝ, SpaceTime) 𝓘(ℝ, EuclideanSpace ℂ (Fin 2)) ⊤ φ := + φ.toHiggsVec_smooth lemma apply_smooth (φ : HiggsField) : - ∀ i, ContMDiff 𝓘(ℝ, SpaceTime) 𝓘(ℝ, ℂ) ⊤ (fun (x : SpaceTime) => (φ x i)) := - (contMDiff_pi_space).mp (φ.toVec_smooth) + ∀ i, ContMDiff 𝓘(ℝ, SpaceTime) 𝓘(ℝ, ℂ) ⊤ (fun (x : SpaceTime) => (φ x i)) := by + have h1 := φ.contDiff + intro i + refine ContDiff.contMDiff ?_ + simp only + rw [contDiff_piLp] at h1 + exact h1 i lemma apply_re_smooth (φ : HiggsField) (i : Fin 2) : ContMDiff 𝓘(ℝ, SpaceTime) 𝓘(ℝ, ℝ) ⊤ (reCLM ∘ (fun (x : SpaceTime) => (φ x i))) := diff --git a/PhysLean/Particles/StandardModel/Representations.lean b/PhysLean/Particles/StandardModel/Representations.lean index b26ff8ed2..892019262 100644 --- a/PhysLean/Particles/StandardModel/Representations.lean +++ b/PhysLean/Particles/StandardModel/Representations.lean @@ -26,7 +26,7 @@ noncomputable def repU1Map (g : unitary ℂ) : unitaryGroup (Fin 2) ℂ := simp only [SubmonoidClass.mk_pow, Submonoid.mk_smul, star_smul, star_pow, RCLike.star_def, star_one] rw [smul_smul, ← mul_pow] - erw [(unitary.mem_iff.mp g.prop).2] + erw [(Unitary.mem_iff.mp g.prop).2] simp only [one_pow, one_smul]⟩ /-- The 2d representation of U(1) with charge 3 as a homomorphism diff --git a/PhysLean/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/B3.lean b/PhysLean/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/B3.lean index 88b1860a4..c4c7566bf 100644 --- a/PhysLean/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/B3.lean +++ b/PhysLean/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/B3.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Particles.SuperSymmetry.MSSMNu.AnomalyCancellation.Basic +import Mathlib.Tactic.LinearCombination /-! # The definition of the solution B₃ and properties thereof diff --git a/PhysLean/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/Basic.lean b/PhysLean/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/Basic.lean index 59d947519..79f238544 100644 --- a/PhysLean/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/Basic.lean +++ b/PhysLean/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/Basic.lean @@ -63,16 +63,7 @@ lemma Y₃_plus_B₃_plus_proj (T : MSSMACC.LinSols) (a b c : ℚ) : + (dot Y₃.val B₃.val * c) • T.val:= by rw [proj_val] rw [DistribMulAction.smul_add, DistribMulAction.smul_add] - rw [add_assoc (_ • _ • Y₃.val), ← add_assoc (_ • Y₃.val + _ • B₃.val), add_assoc (_ • Y₃.val)] - rw [add_comm (_ • B₃.val) (_ • _ • Y₃.val), ← add_assoc (_ • Y₃.val)] - rw [← MulAction.mul_smul, ← Module.add_smul] - repeat rw [add_assoc] - apply congrArg - rw [← add_assoc, ← MulAction.mul_smul, ← Module.add_smul] - apply congrArg - simp only [HSMul.hSMul, SMul.smul, MSSMACC_numberCharges] - funext i - linarith + module lemma quad_Y₃_proj (T : MSSMACC.LinSols) : quadBiLin Y₃.val (proj T).val = dot Y₃.val B₃.val * quadBiLin Y₃.val T.val := by diff --git a/PhysLean/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/ToSols.lean b/PhysLean/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/ToSols.lean index 35372bfaf..72bccbb40 100644 --- a/PhysLean/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/ToSols.lean +++ b/PhysLean/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/OrthogY3B3/ToSols.lean @@ -233,7 +233,7 @@ lemma toSolNS_proj (T : NotInLineEqSol) : toSolNS (toSolNSProj T.val) = T.val := ring rw [h1] have h1 := (lineEqPropSol_iff_lineEqCoeff_zero T.val).mpr.mt T.prop - rw [← MulAction.mul_smul, mul_comm, mul_inv_cancel₀ h1] + rw [← SemigroupAction.mul_smul, mul_comm, mul_inv_cancel₀ h1] exact MulAction.one_smul T.1.val /-- A solution to the ACCs, given an element of `inLineEq × ℚ × ℚ × ℚ`. -/ @@ -276,7 +276,7 @@ lemma inLineEqToSol_proj (T : InLineEqSol) : inLineEqToSol (inLineEqProj T) = T. ring rw [h1] have h2 := (inQuadSolProp_iff_quadCoeff_zero T.val).mpr.mt T.prop.2 - rw [← MulAction.mul_smul, mul_comm, mul_inv_cancel₀ h2] + rw [← SemigroupAction.mul_smul, mul_comm, mul_inv_cancel₀ h2] exact MulAction.one_smul T.1.val /-- Given an element of `inQuad × ℚ × ℚ × ℚ`, a solution to the ACCs. -/ @@ -316,7 +316,7 @@ lemma inQuadToSol_proj (T : InQuadSol) : inQuadToSol (inQuadProj T) = T.val := b ring rw [h1] have h2 := (inCubeSolProp_iff_cubicCoeff_zero T.val).mpr.mt T.prop.2.2 - rw [← MulAction.mul_smul, mul_comm, mul_inv_cancel₀ h2] + rw [← SemigroupAction.mul_smul, mul_comm, mul_inv_cancel₀ h2] exact MulAction.one_smul T.1.val /-- Given a element of `inQuadCube × ℚ × ℚ × ℚ`, a solution to the ACCs. -/ @@ -349,7 +349,7 @@ lemma inQuadCubeToSol_proj (T : InQuadCubeSol) : rw [planeY₃B₃_val, Y₃_plus_B₃_plus_proj] ring_nf simp only [zero_smul, add_zero, zero_add] - rw [← MulAction.mul_smul, mul_comm, mul_inv_cancel₀] + rw [← SemigroupAction.mul_smul, mul_comm, mul_inv_cancel₀] · exact MulAction.one_smul (T.1).val · rw [show dot Y₃.val B₃.val = 108 by with_unfolding_all rfl] exact Ne.symm (OfNat.zero_ne_ofNat 108) diff --git a/PhysLean/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Y3.lean b/PhysLean/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Y3.lean index 5e6fe6138..c4bdda4d7 100644 --- a/PhysLean/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Y3.lean +++ b/PhysLean/Particles/SuperSymmetry/MSSMNu/AnomalyCancellation/Y3.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Particles.SuperSymmetry.MSSMNu.AnomalyCancellation.Basic +import Mathlib.Tactic.LinearCombination /-! # The definition of the solution Y₃ and properties thereof diff --git a/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/AllowsTerm.lean b/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/AllowsTerm.lean index 63d9c1e91..646ba2433 100644 --- a/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/AllowsTerm.lean +++ b/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/AllowsTerm.lean @@ -175,56 +175,26 @@ lemma allowsTermForm_allowsTerm {a b c : 𝓩} {T : PotentialTerm} : all_goals simp [PotentialTerm.toFieldLabel, ofFieldLabel] case Λ => - use a + b - simp only [add_add_sub_cancel, add_neg_cancel, and_true] use a, b - simp only [or_true, and_true] - use 0, a simp case W3 => - use - 2 • a - apply And.intro ?_ (by abel) use b, -b - 2 • a - apply And.intro ?_ (by abel) - simp only [or_true, and_true] - use 0, b - simp + simp only [true_or, or_true, and_self, true_and] + abel case K1 => - use - a - apply And.intro ?_ (by abel) use b, - a - b - apply And.intro ?_ (by abel) - simp only [or_true, and_true] - use 0, b simp case topYukawa => - use - a - apply And.intro ?_ (by abel) use b, - a - b - apply And.intro ?_ (by abel) - simp only [or_true, and_true] - use 0, b simp case W1 => - use a + b + c - apply And.intro ?_ (by abel) - use a + b, c - apply And.intro ?_ (by abel) - simp only [or_true, and_true] - use a, b - simp only [true_or, or_true, and_true] - use 0, a - simp + use a, b, c + simp only [true_or, or_true, and_self, true_and] + abel case W2 => - use a + b + c - apply And.intro ?_ (by abel) - use a + b, c - apply And.intro ?_ (by abel) - simp only [or_true, and_true] - use a, b - simp only [true_or, or_true, and_true] - use 0, a - simp + use a, b, c + simp only [true_or, or_true, and_self, true_and] + abel all_goals abel lemma allowsTerm_of_eq_allowsTermForm {T : PotentialTerm} @@ -330,7 +300,7 @@ lemma allowsTermForm_subset_allowsTerm_of_allowsTerm {T : PotentialTerm} {x : Ch simp [AllowsTerm, ofPotentialTerm] at h cases T all_goals - simp [PotentialTerm.toFieldLabel] at h + simp [PotentialTerm.toFieldLabel, -existsAndEq] at h obtain ⟨f1, f2, ⟨⟨f3, f4, ⟨h3, f4_mem⟩, rfl⟩, f2_mem⟩, f1_add_f2_eq_zero⟩ := h case' μ | β => obtain ⟨rfl⟩ := h3 case' Λ | W1 | W2 | W3 | W4 | K1 | K2 | topYukawa | bottomYukawa => @@ -394,35 +364,19 @@ lemma allowsTermForm_subset_allowsTerm_of_allowsTerm {T : PotentialTerm} {x : Ch simp_all -- AllowsTerm case W3 => - use (- f6 -2 • f4) + f6 - apply And.intro ?_ (by abel) - try simp - use (- f6 -2 • f4), f6 - simp only [true_or, and_true] - use 0, (- f6 -2 • f4) - simp + use (- f6 - 2 • f4), f6 + simpa using f1_add_f2_eq_zero case W1 | W2 => - use f8 + f6 + f4 - apply And.intro ?_ (by abel) - use f8 + f6, f4 - apply And.intro ?_ (by abel) - try simp - use f8, f6 - simp only [true_or, or_true, and_true] - use 0, f8 - simp + use f4, f6, f8 + simp only [true_or, or_true, and_self, true_and] + abel case K1 => have hf6 : f6 = - f2 - f4 := by rw [← sub_zero f2, ← f1_add_f2_eq_zero] abel subst hf6 simp_all - use (-f2 - f4) + f4 - apply And.intro ?_ (by abel) use (-f2 - f4), f4 - apply And.intro ?_ (by abel) - simp only [true_or, and_true] - use 0, (-f2 - f4) simp case' topYukawa => have hf2 : f2 = - f4 - f6 := by @@ -431,13 +385,9 @@ lemma allowsTermForm_subset_allowsTerm_of_allowsTerm {T : PotentialTerm} {x : Ch subst hf2 simp_all case topYukawa | Λ => - use f6 + f4 - apply And.intro ?_ (by omega) use f6, f4 - apply And.intro ?_ (by abel) - simp only [true_or, and_true] - use 0, f6 - simp + simp only [or_true, true_or, and_self, true_and] + abel case W4 => apply And.intro · rw [← sub_zero f8, ← f1_add_f2_eq_zero] @@ -605,9 +555,7 @@ lemma allowsTermQ5_or_allowsTerm_of_allowsTerm_insertQ5 {qHd qHu : Option 𝓩} convert h using 1 rw [neg_add_eq_zero, eq_comm] | none => simp at h - · simp only [SProd.sprod, Multiset.mem_product] at h ⊢ - obtain ⟨a1, a2, a3, ⟨h1, h2, h3⟩, hsum⟩ := h - simp at h1 h2 + · obtain ⟨a1, a2, a3, ⟨h1, h2, h3⟩, hsum⟩ := h rcases h1 with h1 | h1 · subst h1 left @@ -624,24 +572,18 @@ lemma allowsTermQ5_or_allowsTerm_of_allowsTerm_insertQ5 {qHd qHu : Option 𝓩} simp_all · right use a1, a2, a3 - simp_all - · simp only [SProd.sprod, Multiset.mem_product] at h ⊢ - obtain ⟨a1, a2, a3, a4, ⟨h1, h2, h3, h4⟩, hsum⟩ := h - simp at h1 + · obtain ⟨a1, a2, a3, a4, ⟨h1, h2, h3, h4⟩, hsum⟩ := h rcases h1 with h1 | h1 · left use a2, a3, a4 simp_all · right use a1, a2, a3, a4 - simp_all · simp_all · match qHu with | some qHu => simp at h - simp only [SProd.sprod, Multiset.mem_product] at h ⊢ obtain ⟨a1, a2, ⟨h1, h2⟩, hsum⟩ := h - simp at h1 h2 rcases h1 with h1 | h1 · subst h1 left @@ -678,25 +620,20 @@ lemma allowsTermQ5_or_allowsTerm_of_allowsTerm_insertQ5 {qHd qHu : Option 𝓩} abel | none, _ => simp at h | some x, none => simp at h - · simp only [SProd.sprod, Multiset.mem_product] at h ⊢ - obtain ⟨a1, a2, a3, ⟨h1, h2, h3⟩, hsum⟩ := h - simp at h1 + · obtain ⟨a1, a2, a3, ⟨h1, h2, h3⟩, hsum⟩ := h rcases h1 with h1 | h1 · left use a2, a3 simp_all · right use a1, a2, a3 - simp_all · simp_all · simp_all · match qHd with | none => simp at h | some qHd => simp_all - simp only [SProd.sprod, Multiset.mem_product] at h ⊢ obtain ⟨a1, a2, ⟨h1, h2⟩, hsum⟩ := h - simp at h1 rcases h1 with h1 | h1 · subst h1 left @@ -706,7 +643,6 @@ lemma allowsTermQ5_or_allowsTerm_of_allowsTerm_insertQ5 {qHd qHu : Option 𝓩} abel · right use a1, a2 - simp_all /-! @@ -726,7 +662,6 @@ lemma allowsTerm_insertQ5_of_allowsTermQ5 {qHd qHu : Option 𝓩} simp [AllowsTermQ5] at h all_goals simp [allowsTerm_iff_zero_mem_ofPotentialTerm', ofPotentialTerm'] - try simp only [SProd.sprod, Multiset.mem_product] at h ⊢ · match qHu with | some qHu => simp at h @@ -734,7 +669,6 @@ lemma allowsTerm_insertQ5_of_allowsTermQ5 {qHd qHu : Option 𝓩} simp | none => simp at h · obtain ⟨q1, q2, ⟨h1, h2⟩, hsum⟩ := h - simp at h1 use q1, q5, q2 simp_all · obtain ⟨q1, q2, q3, h3, hsum⟩ := h @@ -923,19 +857,14 @@ lemma allowsTermQ10_or_allowsTerm_of_allowsTerm_insertQ10 {qHd qHu : Option 𝓩 simp [allowsTerm_iff_zero_mem_ofPotentialTerm', ofPotentialTerm', AllowsTermQ10] at h ⊢ · simp_all · simp_all - · simp only [SProd.sprod, Multiset.mem_product] at h ⊢ - obtain ⟨a1, a2, a3, ⟨h1, h2, h3⟩, hsum⟩ := h - simp at h3 + · obtain ⟨a1, a2, a3, ⟨h1, h2, h3⟩, hsum⟩ := h rcases h3 with h3 | h3 · subst h3 left use a1, a2 · right use a1, a2, a3 - simp_all - · simp only [SProd.sprod, Multiset.mem_product] at h ⊢ - obtain ⟨a1, a2, a3, a4, ⟨h1, h2, h3, h4⟩, hsum⟩ := h - simp at h2 + · obtain ⟨a1, a2, a3, a4, ⟨h1, h2, h3, h4⟩, hsum⟩ := h rcases h2 with h2 | h2 · subst h2 left @@ -943,7 +872,6 @@ lemma allowsTermQ10_or_allowsTerm_of_allowsTerm_insertQ10 {qHd qHu : Option 𝓩 simp_all rw [← hsum] abel - simp at h3 rcases h3 with h3 | h3 · subst h3 left @@ -951,7 +879,6 @@ lemma allowsTermQ10_or_allowsTerm_of_allowsTerm_insertQ10 {qHd qHu : Option 𝓩 simp_all rw [← hsum] abel - simp at h4 rcases h4 with h4 | h4 · subst h4 left @@ -959,14 +886,11 @@ lemma allowsTermQ10_or_allowsTerm_of_allowsTerm_insertQ10 {qHd qHu : Option 𝓩 simp_all right use a1, a2, a3, a4 - simp_all · match qHd with | none => simp at h | some qHd => simp_all - simp only [SProd.sprod, Multiset.mem_product] at h ⊢ obtain ⟨a1, a2, a3, ⟨h1, h2, h3⟩, hsum⟩ := h - simp at h1 rcases h1 with h1 | h1 · subst h1 left @@ -974,7 +898,6 @@ lemma allowsTermQ10_or_allowsTerm_of_allowsTerm_insertQ10 {qHd qHu : Option 𝓩 simp_all rw [← hsum] abel - simp at h2 rcases h2 with h2 | h2 · subst h2 left @@ -982,7 +905,6 @@ lemma allowsTermQ10_or_allowsTerm_of_allowsTerm_insertQ10 {qHd qHu : Option 𝓩 simp_all rw [← hsum] abel - simp at h3 rcases h3 with h3 | h3 · subst h3 left @@ -990,7 +912,6 @@ lemma allowsTermQ10_or_allowsTerm_of_allowsTerm_insertQ10 {qHd qHu : Option 𝓩 simp_all right use a1, a2, a3 - simp_all · match qHu with | none => simp at h | some qHu => simp_all @@ -998,23 +919,19 @@ lemma allowsTermQ10_or_allowsTerm_of_allowsTerm_insertQ10 {qHd qHu : Option 𝓩 | none, _ => simp at h | some x, none => simp at h | some qHd, some qHu => simp_all - · simp only [SProd.sprod, Multiset.mem_product] at h ⊢ - obtain ⟨a1, a2, a3, ⟨h1, h2, h3⟩, hsum⟩ := h - simp at h2 + · obtain ⟨a1, a2, a3, ⟨h1, h2, h3⟩, hsum⟩ := h rcases h2 with h2 | h2 · left use a1, a3 simp_all rw [← hsum] abel - simp at h3 rcases h3 with h3 | h3 · left use a1, a2 simp_all right use a1, a2, a3 - simp_all · match qHd, qHu with | none, _ => simp at h | some x, none => simp at h @@ -1023,13 +940,10 @@ lemma allowsTermQ10_or_allowsTerm_of_allowsTerm_insertQ10 {qHd qHu : Option 𝓩 | none => simp at h | some qHu => simp at h - simp only [SProd.sprod, Multiset.mem_product] at h ⊢ obtain ⟨a1, a2, ⟨h1, h2⟩, hsum⟩ := h - simp at h1 rcases h1 with h1 | h1 · subst h1 left - simp at h2 rcases h2 with h2 | h2 · subst h2 left @@ -1040,7 +954,6 @@ lemma allowsTermQ10_or_allowsTerm_of_allowsTerm_insertQ10 {qHd qHu : Option 𝓩 simp_all rw [← hsum] abel - simp at h2 rcases h2 with h2 | h2 · subst h2 left; right @@ -1055,9 +968,7 @@ lemma allowsTermQ10_or_allowsTerm_of_allowsTerm_insertQ10 {qHd qHu : Option 𝓩 | none => simp at h | some qHd => simp_all - simp only [SProd.sprod, Multiset.mem_product] at h ⊢ obtain ⟨a1, a2, ⟨h1, h2⟩, hsum⟩ := h - simp at h2 rcases h2 with h2 | h2 · subst h2 left @@ -1067,7 +978,6 @@ lemma allowsTermQ10_or_allowsTerm_of_allowsTerm_insertQ10 {qHd qHu : Option 𝓩 abel right use a1, a2 - simp_all /-! @@ -1088,7 +998,6 @@ lemma allowsTerm_insertQ10_of_allowsTermQ10 {qHd qHu : Option 𝓩} simp [AllowsTermQ10] at h all_goals simp [allowsTerm_iff_zero_mem_ofPotentialTerm', ofPotentialTerm'] - try simp only [SProd.sprod, Multiset.mem_product] at h ⊢ · obtain ⟨a1, a2, ⟨h1, h2⟩, hsum⟩ := h use a1, a2, q10 simp_all diff --git a/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/Basic.lean b/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/Basic.lean index 7eec9920c..b5fd31f93 100644 --- a/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/Basic.lean +++ b/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/Basic.lean @@ -6,6 +6,7 @@ Authors: Joseph Tooby-Smith import Mathlib.Data.Finset.Powerset import Mathlib.Data.Finset.Prod import Mathlib.Data.Finset.Sort +import Mathlib.Data.Finset.Option import PhysLean.Particles.SuperSymmetry.SU5.Potential /-! diff --git a/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/Completions.lean b/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/Completions.lean index fc3921418..b1039a0ce 100644 --- a/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/Completions.lean +++ b/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/Completions.lean @@ -141,7 +141,7 @@ def completions (S5 S10 : Finset 𝓩) (x : ChargeSpectrum 𝓩) : Multiset (Cha let SqHu := if x.qHu.isSome then {x.qHu} else S5.val.map fun y => some y let SQ5 := if x.Q5 ≠ ∅ then {x.Q5} else S5.val.map fun y => {y} let SQ10 := if x.Q10 ≠ ∅ then {x.Q10} else S10.val.map fun y => {y} - (SqHd.product (SqHu.product (SQ5.product SQ10))).map (toProd).symm + (SqHd ×ˢ SqHu ×ˢ SQ5 ×ˢ SQ10).map (toProd).symm /-! @@ -305,6 +305,8 @@ lemma self_subset_mem_completions (S5 S10 : Finset 𝓩) (x y : ChargeSpectrum · simp_all · simp_all +/-- If `x` is a subset of `y` and `y` is complete, then there is a completion of `x` which is also + a subset of `y`. -/ lemma exist_completions_subset_of_complete (S5 S10 : Finset 𝓩) (x y : ChargeSpectrum 𝓩) (hsubset : x ⊆ y) (hy : y ∈ ofFinset S5 S10) (hycomplete : IsComplete y) : ∃ z ∈ completions S5 S10 x, z ⊆ y := by @@ -400,7 +402,7 @@ look at. `minimallyAllowsTermsOfFinset S5 S10 .topYukawa`. -/ def completionsTopYukawa (S5 : Finset 𝓩) (x : ChargeSpectrum 𝓩) : Multiset (ChargeSpectrum 𝓩) := - (S5.val.product S5.val).map fun (qHd, q5) => ⟨qHd, x.qHu, {q5}, x.Q10⟩ + (S5.val ×ˢ S5.val).map fun (qHd, q5) => ⟨qHd, x.qHu, {q5}, x.Q10⟩ /-! @@ -444,11 +446,11 @@ lemma completions_eq_completionsTopYukawa_of_mem_minimallyAllowsTermsOfFinset [A simp [minimallyAllowsTermsOfFinset] at hx obtain ⟨qHu, Q10, ⟨⟨h1, ⟨h2, hcard⟩⟩, h3⟩, rfl⟩ := hx simp [completions, completionsTopYukawa] - have Q10_neq_zero : Q10 ≠ 0 := by + have Q10_ne_zero : Q10 ≠ 0 := by by_contra hn subst hn simp at hcard - simp [Q10_neq_zero] + simp [Q10_ne_zero] match a with | ⟨xqHd, xqHu, xQ5, xQ10⟩ => simp [eq_iff] diff --git a/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/Map.lean b/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/Map.lean index 18f87ee76..02a61af98 100644 --- a/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/Map.lean +++ b/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/Map.lean @@ -207,7 +207,6 @@ lemma map_ofPotentialTerm_toFinset [DecidableEq 𝓩] ofPotentialTerm'_W4_finset, ofPotentialTerm'_K2_finset, ofPotentialTerm'_topYukawa_finset, ofPotentialTerm'_bottomYukawa_finset] at h try simp [ofPotentialTerm'] at h - simp only [SProd.sprod, Multiset.mem_product] at h case' μ | β => obtain ⟨q1, q2, ⟨q1_mem, q2_mem⟩, q_sum⟩ := h simp [map] at q1_mem q2_mem @@ -240,11 +239,10 @@ lemma map_ofPotentialTerm_toFinset [DecidableEq 𝓩] ofPotentialTerm'_W4_finset, ofPotentialTerm'_K2_finset, ofPotentialTerm'_topYukawa_finset, ofPotentialTerm'_bottomYukawa_finset] try simp [ofPotentialTerm'] - simp only [SProd.sprod, Multiset.mem_product] use q1, q2 - simp_all · use q3, q4 · use q3, q4 + all_goals use q3 · intro h obtain ⟨a, h, rfl⟩ := h cases T @@ -254,7 +252,6 @@ lemma map_ofPotentialTerm_toFinset [DecidableEq 𝓩] ofPotentialTerm'_W4_finset, ofPotentialTerm'_K2_finset, ofPotentialTerm'_topYukawa_finset, ofPotentialTerm'_bottomYukawa_finset] at h try simp [ofPotentialTerm'] at h - simp only [SProd.sprod, Multiset.mem_product] at h try simp [ofPotentialTerm'_W2_finset, ofPotentialTerm'_W3_finset, ofPotentialTerm'_β_finset, ofPotentialTerm'_μ_finset, ofPotentialTerm'_W4_finset, ofPotentialTerm'_K2_finset, @@ -270,7 +267,7 @@ lemma map_ofPotentialTerm_toFinset [DecidableEq 𝓩] obtain ⟨q1, q2, q3, q4, ⟨q1_mem, q2_mem, q3_mem, q4_mem⟩, q_sum⟩ := h use f q1, f q2, f q3, f q4 all_goals - simp only [SProd.sprod, Multiset.mem_product, map] + simp only [map] subst a simp_all case W1 => refine ⟨⟨q1, q1_mem, rfl⟩, ⟨q2, q2_mem, rfl⟩, ⟨q3, q3_mem, rfl⟩, ⟨q4, q4_mem, rfl⟩⟩ diff --git a/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimalSuperSet.lean b/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimalSuperSet.lean index 48b13a7ac..becb87ec0 100644 --- a/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimalSuperSet.lean +++ b/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimalSuperSet.lean @@ -125,7 +125,7 @@ lemma self_not_mem_minimalSuperSet (S5 S10 : Finset 𝓩) (x : ChargeSpectrum x ∉ minimalSuperSet S5 S10 x := by simp [minimalSuperSet] -lemma self_neq_mem_minimalSuperSet (S5 S10 : Finset 𝓩) (x y : ChargeSpectrum 𝓩) +lemma self_ne_mem_minimalSuperSet (S5 S10 : Finset 𝓩) (x y : ChargeSpectrum 𝓩) (hy : y ∈ minimalSuperSet S5 S10 x) : x ≠ y := by by_contra h subst h diff --git a/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/FinsetTerms.lean b/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/FinsetTerms.lean index cdbc737e7..2cf0439f8 100644 --- a/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/FinsetTerms.lean +++ b/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/FinsetTerms.lean @@ -130,7 +130,7 @@ Here we define `minTopBottom` in a way which is computationally efficient. /-- The set of charges of the form `(qHd, qHu, {q5}, {-qHd-q5, q10, qHu - q10})` This includes every charge which minimally allows for the top and bottom Yukawas. -/ def minTopBottom (S5 S10 : Finset 𝓩) : Multiset (ChargeSpectrum 𝓩) := Multiset.dedup <| - (S5.val.product <| S5.val.product <| S5.val.product <| S10.val).map + (S5.val ×ˢ S5.val ×ˢ S5.val ×ˢ S10.val).map (fun x => ⟨x.1, x.2.1, {x.2.2.1}, {- x.1 - x.2.2.1, x.2.2.2, x.2.1 - x.2.2.2}⟩) /-! @@ -142,7 +142,8 @@ def minTopBottom (S5 S10 : Finset 𝓩) : Multiset (ChargeSpectrum 𝓩) := Mult lemma allowsTerm_topYukawa_of_mem_minTopBottom {S5 S10 : Finset 𝓩} {x : ChargeSpectrum 𝓩} (h : x ∈ minTopBottom S5 S10) : x.AllowsTerm topYukawa := by - simp [minTopBottom] at h + simp only [minTopBottom, Multiset.mem_dedup, Multiset.mem_map, Multiset.mem_product, + Finset.mem_val, Prod.exists] at h obtain ⟨qHd, qHu, q5, q10, ⟨hHd, hHu, h5, h10⟩, rfl⟩ := h rw [allowsTerm_iff_subset_allowsTermForm] simp [allowsTermForm] diff --git a/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/OfFinset.lean b/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/OfFinset.lean index b4f7e54d5..b54ac179a 100644 --- a/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/OfFinset.lean +++ b/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/MinimallyAllowsTerm/OfFinset.lean @@ -252,71 +252,71 @@ def minimallyAllowsTermsOfFinset (S5 S10 : Finset 𝓩) : | μ => let SqHd := S5.val let SqHu := S5.val - let prod := SqHd.product (SqHu) + let prod := SqHd ×ˢ (SqHu) let Filt := prod.filter (fun x => - x.1 + x.2 = 0) (Filt.map (fun x => ⟨x.1, x.2, ∅, ∅⟩)) | K2 => let SqHd := S5.val let SqHu := S5.val let Q10 := toMultisetsOne S10 - let prod := SqHd.product (SqHu.product Q10) + let prod := SqHd ×ˢ (SqHu ×ˢ Q10) let Filt := prod.filter (fun x => x.1 + x.2.1 + x.2.2.sum = 0) (Filt.map (fun x => ⟨x.1, x.2.1, ∅, x.2.2.toFinset⟩)) | K1 => let Q5 := toMultisetsOne S5 let Q10 := toMultisetsTwo S10 - let Prod := Q5.product Q10 + let Prod := Q5 ×ˢ Q10 let Filt := Prod.filter (fun x => - x.1.sum + x.2.sum = 0) (Filt.map (fun x => ⟨none, none, x.1.toFinset, x.2.toFinset⟩)) | W4 => let SqHd := S5.val let SqHu := S5.val let Q5 := toMultisetsOne S5 - let prod := SqHd.product (SqHu.product Q5) + let prod := SqHd ×ˢ (SqHu ×ˢ Q5) let Filt := prod.filter (fun x => x.1 - 2 • x.2.1 + x.2.2.sum = 0) (Filt.map (fun x => ⟨x.1, x.2.1, x.2.2.toFinset, ∅⟩)) | W3 => let SqHu := S5.val let Q5 := toMultisetsTwo S5 - let prod := SqHu.product Q5 + let prod := SqHu ×ˢ Q5 let Filt := prod.filter (fun x => - 2 • x.1 + x.2.sum = 0) (Filt.map (fun x => ⟨none, x.1, x.2.toFinset, ∅⟩)) | W2 => let SqHd := S5.val let Q10 := toMultisetsThree S10 - let prod := SqHd.product Q10 + let prod := SqHd ×ˢ Q10 let Filt := prod.filter (fun x => x.1 + x.2.sum = 0) (Filt.map (fun x => ⟨x.1, none, ∅, x.2.toFinset⟩)).filter fun x => MinimallyAllowsTerm x W2 | W1 => let Q5 := toMultisetsOne S5 let Q10 := toMultisetsThree S10 - let Prod := Q5.product Q10 + let Prod := Q5 ×ˢ Q10 let Filt := Prod.filter (fun x => x.1.sum + x.2.sum = 0) (Filt.map (fun x => ⟨none, none, x.1.toFinset, x.2.toFinset⟩)).filter fun x => MinimallyAllowsTerm x W1 | Λ => let Q5 := toMultisetsTwo S5 let Q10 := toMultisetsOne S10 - let Prod := Q5.product Q10 + let Prod := Q5 ×ˢ Q10 let Filt := Prod.filter (fun x => x.1.sum + x.2.sum = 0) (Filt.map (fun x => ⟨none, none, x.1.toFinset, x.2.toFinset⟩)) | β => let SqHu := S5.val let Q5 := toMultisetsOne S5 - let prod := SqHu.product Q5 + let prod := SqHu ×ˢ Q5 let Filt := prod.filter (fun x => - x.1 + x.2.sum = 0) (Filt.map (fun x => ⟨none, x.1, x.2.toFinset, ∅⟩)) | topYukawa => let SqHu := S5.val let Q10 := toMultisetsTwo S10 - let prod := SqHu.product Q10 + let prod := SqHu ×ˢ Q10 let Filt := prod.filter (fun x => - x.1 + x.2.sum = 0) (Filt.map (fun x => ⟨none, x.1, ∅, x.2.toFinset⟩)) | bottomYukawa => let SqHd := S5.val let Q5 := toMultisetsOne S5 let Q10 := toMultisetsOne S10 - let prod := SqHd.product (Q5.product Q10) + let prod := SqHd ×ˢ (Q5 ×ˢ Q10) let Filt := prod.filter (fun x => x.1 + x.2.1.sum + x.2.2.sum = 0) (Filt.map (fun x => ⟨x.1, none,x.2.1.toFinset, x.2.2.toFinset⟩)) @@ -545,7 +545,7 @@ lemma mem_minimallyAllowsTermOfFinset_of_minimallyAllowsTerm {S5 S10 : Finset case μ => simp_all [allowsTermForm] case β => - use a, {a} + use {a} simp_all [allowsTermForm] case Λ => use {a, b}, {- a - b} @@ -558,28 +558,28 @@ lemma mem_minimallyAllowsTermOfFinset_of_minimallyAllowsTerm {S5 S10 : Finset · exact h case W2 => apply And.intro - · use (- a - b - c), {a, b, c} + · use {a, b, c} simp_all [allowsTermForm] abel · exact h case W3 => - use (-a), {b, - b - 2 • a} + use {b, - b - 2 • a} simp_all [allowsTermForm] abel case W4 => - use (- c - 2 • b), (-b), {c} + use {c} simp_all [allowsTermForm] case K1 => use {-a}, {b, - a - b} simp_all [allowsTermForm] case K2 => - use a, b, {- a - b} + use {- a - b} simp_all [allowsTermForm] case topYukawa => - use (-a), {b, - a - b} + use {b, - a - b} simp_all [allowsTermForm] case bottomYukawa => - use a, {b}, {- a - b} + use {b}, {- a - b} simp_all [allowsTermForm] /-! diff --git a/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/OfPotentialTerm.lean b/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/OfPotentialTerm.lean index 0760c807e..d66f801d8 100644 --- a/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/OfPotentialTerm.lean +++ b/PhysLean/Particles/SuperSymmetry/SU5/ChargeSpectrum/OfPotentialTerm.lean @@ -68,7 +68,7 @@ This is slow to compute in practice. /-- Given a charges `x : Charges` associated to the representations, and a potential term `T`, the charges associated with instances of that potential term. -/ def ofPotentialTerm (x : ChargeSpectrum 𝓩) (T : PotentialTerm) : Multiset 𝓩 := - let add : Multiset 𝓩 → Multiset 𝓩 → Multiset 𝓩 := fun a b => (a.product b).map + let add : Multiset 𝓩 → Multiset 𝓩 → Multiset 𝓩 := fun a b => (a ×ˢ b).map fun (x, y) => x + y (T.toFieldLabel.map fun F => (ofFieldLabel x F).val).foldl add {0} @@ -83,8 +83,9 @@ That is if `x ⊆ y` then `ofPotentialTerm x T ⊆ ofPotentialTerm y T`. lemma ofPotentialTerm_mono {x y : ChargeSpectrum 𝓩} (h : x ⊆ y) (T : PotentialTerm) : x.ofPotentialTerm T ⊆ y.ofPotentialTerm T := by have h1 {S1 S2 T1 T2 : Multiset 𝓩} (h1 : S1 ⊆ S2) (h2 : T1 ⊆ T2) : - (S1.product T1) ⊆ S2.product T2 := - Multiset.subset_iff.mpr (fun x => by simpa using fun h1' h2' => ⟨h1 h1', h2 h2'⟩) + (S1 ×ˢ T1) ⊆ S2 ×ˢ T2 := + Multiset.subset_iff.mpr (fun x => by simpa only [Multiset.mem_product, and_imp] using + fun h1' h2' => ⟨h1 h1', h2 h2'⟩) rw [subset_def] at h cases T all_goals @@ -305,7 +306,7 @@ lemma ofPotentialTerm_subset_ofPotentialTerm' {x : ChargeSpectrum 𝓩} (T : Pot simp [ofPotentialTerm] at h cases T all_goals - simp [PotentialTerm.toFieldLabel] at h + simp [PotentialTerm.toFieldLabel, -existsAndEq] at h obtain ⟨f1, f2, ⟨⟨f3, f4, ⟨h3, f4_mem⟩, rfl⟩, f2_mem⟩, f1_add_f2_eq_zero⟩ := h case' μ | β => obtain ⟨rfl⟩ := h3 case' Λ | W1 | W2 | W3 | W4 | K1 | K2 | topYukawa | bottomYukawa => @@ -317,9 +318,8 @@ lemma ofPotentialTerm_subset_ofPotentialTerm' {x : ChargeSpectrum 𝓩} (T : Pot ofPotentialTerm'_β_finset, ofPotentialTerm'_μ_finset, ofPotentialTerm'_W4_finset, ofPotentialTerm'_K2_finset, ofPotentialTerm'_topYukawa_finset, ofPotentialTerm'_bottomYukawa_finset] - try simp [ofPotentialTerm'] - simp only [SProd.sprod, Multiset.mem_product] - simp_all [ofFieldLabel] + try simp [ofPotentialTerm', -existsAndEq] + simp_all [ofFieldLabel, -existsAndEq] case' W1 => use f2, f4, f6, f8 case' W2 => use f2, f4, f6, f8 case' W3 => use (-f2), f6, f8 @@ -354,8 +354,7 @@ lemma ofPotentialTerm'_subset_ofPotentialTerm [DecidableEq 𝓩] ofPotentialTerm'_β_finset, ofPotentialTerm'_μ_finset, ofPotentialTerm'_W4_finset, ofPotentialTerm'_K2_finset, ofPotentialTerm'_topYukawa_finset, ofPotentialTerm'_bottomYukawa_finset] at h - try simp [ofPotentialTerm'] at h - simp only [SProd.sprod, Multiset.mem_product] at h + try simp [ofPotentialTerm', -existsAndEq] at h case' μ | β => obtain ⟨q1, q2, ⟨q1_mem, q2_mem⟩, q_sum⟩ := h case' Λ | W3 | W4 | K1 | K2 | topYukawa | bottomYukawa => @@ -385,62 +384,19 @@ lemma ofPotentialTerm'_subset_ofPotentialTerm [DecidableEq 𝓩] case' μSub | βSub | ΛSub | W1Sub | W2Sub | W3Sub | W4Sub | K1Sub | K2Sub | topYukawaSub | bottomYukawaSub => rw [subset_def] - simp_all [Finset.insert_subset] + simp_all [Finset.insert_subset, -existsAndEq] all_goals simp [ofPotentialTerm, PotentialTerm.toFieldLabel, ofFieldLabel] - case' ΛP => - use - q3 + n - simp only [neg_add_cancel_comm, and_true] - use - q1 - q3 + n, q1 - apply And.intro ?_ (by abel) - simp only [true_or, and_true] - use 0 - simp only [true_and, zero_add, exists_eq_right] - right - rw [← q_sum] - abel - case' W3P => - use 2 • q1 + n - apply And.intro ?_ (by abel) - use - q2 + 2 • q1 + n, q2 - apply And.intro ?_ (by abel) - simp only [true_or, and_true] - use 0, q3 - simp only [or_true, and_self, zero_add, true_and] - rw [← q_sum] - abel - case' K1P => - use q1 + n - apply And.intro ?_ (by abel) - use q1 - q2 + n, q2 - apply And.intro ?_ (by abel) - simp only [true_or, and_true] - use 0, q3 - simp only [or_true, and_self, zero_add, true_and] - rw [← q_sum] - abel - case' topYukawaP => - use q1 + n - apply And.intro ?_ (by abel) - use q1 - q2 + n, q2 - apply And.intro ?_ (by abel) - simp only [true_or, and_true] - use 0, q3 - simp only [or_true, and_self, zero_add, true_and] - rw [← q_sum] + case ΛP => + use q1, q2 + simp [← q_sum] + case W3P | K1P | topYukawaP => + use q2, q3 + simp [← q_sum] abel - case' W1P | W2P => - use - q1 + n - apply And.intro ?_ (by abel) - use - q1 - q2 + n, q2 - apply And.intro ?_ (by abel) - simp only [true_or, and_true] - use -q1 - q2 - q3 + n, q3 - apply And.intro ?_ (by abel) - simp only [true_or, or_true, and_true] - use 0, q4 - simp only [or_true, and_self, zero_add, true_and] - rw [← q_sum] + case W1P | W2P => + use q2, q3, q4 + simp [← q_sum] abel all_goals rw [← q_sum] diff --git a/PhysLean/QFT/AnomalyCancellation/Basic.lean b/PhysLean/QFT/AnomalyCancellation/Basic.lean index 4fb60faed..87cedf6a8 100644 --- a/PhysLean/QFT/AnomalyCancellation/Basic.lean +++ b/PhysLean/QFT/AnomalyCancellation/Basic.lean @@ -273,10 +273,8 @@ def linSolsIncl (χ : ACCSystemLinear) : χ.LinSols →ₗ[ℚ] χ.Charges where map_add' _ _ := rfl map_smul' _ _ := rfl -@[sorryful] lemma linSolsIncl_injective (χ : ACCSystemLinear) : - Function.Injective χ.linSolsIncl := by - sorry + Function.Injective χ.linSolsIncl := fun _ _ h => LinSols.ext h end ACCSystemLinear @@ -360,10 +358,12 @@ def quadSolsInclLinSols (χ : ACCSystemQuad) : χ.QuadSols →[ℚ] χ.LinSols w toFun := QuadSols.toLinSols map_smul' _ _ := rfl -@[sorryful] lemma quadSolsInclLinSols_injective (χ : ACCSystemQuad) : Function.Injective χ.quadSolsInclLinSols := by - sorry + intro S T h + ext + simpa [ACCSystemQuad.quadSolsInclLinSols] using + congrArg (fun X => X.val) h /-! @@ -394,10 +394,13 @@ the module of all charges `Charges`. def quadSolsIncl (χ : ACCSystemQuad) : χ.QuadSols →[ℚ] χ.Charges := MulActionHom.comp χ.linSolsIncl.toMulActionHom χ.quadSolsInclLinSols -@[sorryful] lemma quadSolsIncl_injective (χ : ACCSystemQuad) : Function.Injective χ.quadSolsIncl := by - sorry + intro S T h + have h' : χ.quadSolsInclLinSols S = χ.quadSolsInclLinSols T := by + apply ACCSystemLinear.linSolsIncl_injective (χ := χ.toACCSystemLinear) + simpa [ACCSystemQuad.quadSolsIncl, MulActionHom.comp_apply] using h + exact quadSolsInclLinSols_injective χ h' end ACCSystemQuad @@ -410,7 +413,16 @@ in the rational charges. This corresponds to the `u(1)^3` anomaly. -/ -/-- The type of charges plus the anomaly cancellation conditions. -/ +/-- +The type of charges plus the anomaly cancellation conditions. + +In many physical settings these conditions are derived formally from the gauge group and the +fermionic representations. They arise from triangle Feynman diagrams, and can also be obtained +using index-theoretic or characteristic-class constructions. + +In this file, we take the resulting conditions as input data: linear, quadratic and cubic +homogeneous forms on the space of rational charges. +-/ structure ACCSystem extends ACCSystemQuad where /-- The cubic ACC. -/ cubicACC : HomogeneousCubic toACCSystemCharges.Charges @@ -486,10 +498,13 @@ def solsInclQuadSols (χ : ACCSystem) : χ.Sols →[ℚ] χ.QuadSols where toFun := Sols.toQuadSols map_smul' _ _ := rfl -@[sorryful] lemma solsInclQuadSols_injective (χ : ACCSystem) : Function.Injective χ.solsInclQuadSols := by - sorry + intro S T h + apply Sols.ext + have hv : (χ.solsInclQuadSols S).val = (χ.solsInclQuadSols T).val := + congrArg (fun X => X.val) h + simpa [ACCSystem.solsInclQuadSols] using hv /-! @@ -500,10 +515,13 @@ lemma solsInclQuadSols_injective (χ : ACCSystem) : def solsInclLinSols (χ : ACCSystem) : χ.Sols →[ℚ] χ.LinSols := MulActionHom.comp χ.quadSolsInclLinSols χ.solsInclQuadSols -@[sorryful] lemma solsInclLinSols_injective (χ : ACCSystem) : Function.Injective χ.solsInclLinSols := by - sorry + intro S T h + have h' : χ.solsInclQuadSols S = χ.solsInclQuadSols T := by + apply ACCSystemQuad.quadSolsInclLinSols_injective (χ := χ.toACCSystemQuad) + simpa [ACCSystem.solsInclLinSols, MulActionHom.comp_apply] using h + exact solsInclQuadSols_injective χ h' /-! @@ -515,10 +533,13 @@ lemma solsInclLinSols_injective (χ : ACCSystem) : def solsIncl (χ : ACCSystem) : χ.Sols →[ℚ] χ.Charges := MulActionHom.comp χ.quadSolsIncl χ.solsInclQuadSols -@[sorryful] lemma solsIncl_injective (χ : ACCSystem) : Function.Injective χ.solsIncl := by - sorry + intro S T h + have h' : χ.solsInclQuadSols S = χ.solsInclQuadSols T := by + apply ACCSystemQuad.quadSolsIncl_injective (χ := χ.toACCSystemQuad) + simpa [ACCSystem.solsIncl, MulActionHom.comp_apply] using h + exact (solsInclQuadSols_injective χ) h' /-! @@ -561,6 +582,12 @@ end ACCSystem We give some open TODO items for future work. +One natural direction is to formalize how the anomaly cancellation conditions defining an +`ACCSystem` arise from gauge-theoretic data (a gauge group together with fermionic representations). +Physically these arise from triangle Feynman diagrams, and can also be described via index-theoretic +or characteristic-class constructions (e.g. through an anomaly polynomial). At present we do not +formalize this derivation in Lean, and instead take the resulting homogeneous forms as data. + (To view these you may need to go to the GitHub source code for the file.) -/ diff --git a/PhysLean/QFT/PerturbationTheory/CreateAnnihilate.lean b/PhysLean/QFT/PerturbationTheory/CreateAnnihilate.lean index 0d156993f..e47b4f393 100644 --- a/PhysLean/QFT/PerturbationTheory/CreateAnnihilate.lean +++ b/PhysLean/QFT/PerturbationTheory/CreateAnnihilate.lean @@ -48,7 +48,7 @@ instance : (φ φ' : CreateAnnihilate) → Decidable (normalOrder φ φ') | annihilate, create => isFalse False.elim /-- Normal ordering is total. -/ -instance : IsTotal CreateAnnihilate normalOrder where +instance : Std.Total normalOrder where total a b := by cases a <;> cases b <;> simp [normalOrder] diff --git a/PhysLean/QFT/PerturbationTheory/FieldOpFreeAlgebra/SuperCommute.lean b/PhysLean/QFT/PerturbationTheory/FieldOpFreeAlgebra/SuperCommute.lean index e599120dc..f79368f61 100644 --- a/PhysLean/QFT/PerturbationTheory/FieldOpFreeAlgebra/SuperCommute.lean +++ b/PhysLean/QFT/PerturbationTheory/FieldOpFreeAlgebra/SuperCommute.lean @@ -77,7 +77,7 @@ lemma superCommuteF_ofFieldOpListF_ofFieldOpFsList (φ : List 𝓕.FieldOp) (φs [ofFieldOpListF φ, ofFieldOpListF φs]ₛF = ofFieldOpListF φ * ofFieldOpListF φs - 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ φs) • ofFieldOpListF φs * ofFieldOpListF φ := by conv_lhs => rw [ofFieldOpListF_sum] - simp only [map_sum, LinearMap.coeFn_sum, Finset.sum_apply, instCommGroup.eq_1, + simp only [map_sum, LinearMap.coe_sum, Finset.sum_apply, instCommGroup.eq_1, Algebra.smul_mul_assoc] conv_lhs => enter [2, x] @@ -861,7 +861,7 @@ lemma superCommuteF_fermionic_ofCrAnListF_eq_sum (a : 𝓕.FieldOpFreeAlgebra) simp [smul_smul, mul_comm] · exact ha -lemma statistic_neq_of_superCommuteF_fermionic {φs φs' : List 𝓕.CrAnFieldOp} +lemma statistic_ne_of_superCommuteF_fermionic {φs φs' : List 𝓕.CrAnFieldOp} (h : [ofCrAnListF φs, ofCrAnListF φs']ₛF ∈ statisticSubmodule fermionic) : (𝓕 |>ₛ φs) ≠ (𝓕 |>ₛ φs') ∨ [ofCrAnListF φs, ofCrAnListF φs']ₛF = 0 := by by_cases h0 : [ofCrAnListF φs, ofCrAnListF φs']ₛF = 0 diff --git a/PhysLean/QFT/PerturbationTheory/FieldOpFreeAlgebra/TimeOrder.lean b/PhysLean/QFT/PerturbationTheory/FieldOpFreeAlgebra/TimeOrder.lean index f351b73dd..059833b46 100644 --- a/PhysLean/QFT/PerturbationTheory/FieldOpFreeAlgebra/TimeOrder.lean +++ b/PhysLean/QFT/PerturbationTheory/FieldOpFreeAlgebra/TimeOrder.lean @@ -155,7 +155,7 @@ lemma timeOrderF_ofFieldOpF_ofFieldOpF_not_ordered_eq_timeOrderF {φ ψ : 𝓕.F rw [timeOrderF_ofFieldOpF_ofFieldOpF_not_ordered h] rw [timeOrderF_ofFieldOpF_ofFieldOpF_ordered] simp only [instCommGroup.eq_1, Algebra.smul_mul_assoc] - have hx := IsTotal.total (r := timeOrderRel) ψ φ + have hx := Std.Total.total (r := timeOrderRel) ψ φ simp_all lemma timeOrderF_superCommuteF_ofCrAnOpF_ofCrAnOpF_not_crAnTimeOrderRel @@ -168,7 +168,7 @@ lemma timeOrderF_superCommuteF_ofCrAnOpF_ofCrAnOpF_not_crAnTimeOrderRel simp only [List.singleton_append] rw [crAnTimeOrderSign_pair_not_ordered h, crAnTimeOrderList_pair_not_ordered h] rw [sub_eq_zero, smul_smul] - have h1 := IsTotal.total (r := crAnTimeOrderRel) φ ψ + have h1 := Std.Total.total (r := crAnTimeOrderRel) φ ψ congr · rw [crAnTimeOrderSign_pair_ordered, exchangeSign_symm] simp only [instCommGroup.eq_1, mul_one] @@ -334,7 +334,7 @@ lemma timeOrderF_eq_maxTimeField_mul_finset (φ : 𝓕.FieldOp) (φs : List 𝓕 rw [timeOrderF_eq_maxTimeField_mul] congr 3 apply FieldStatistic.ofList_perm - nth_rewrite 1 [← List.finRange_map_get (φ :: φs)] + nth_rewrite 1 [← List.map_get_finRange (φ :: φs)] simp only [List.length_cons, eraseMaxTimeField, insertionSortDropMinPos] rw [eraseIdx_get, ← List.map_take, ← List.map_map] refine List.Perm.map (φ :: φs).get ?_ @@ -356,22 +356,22 @@ lemma timeOrderF_eq_maxTimeField_mul_finset (φ : 𝓕.FieldOp) (φs : List 𝓕 omega · omega · simp only [Fin.succAbove, List.length_cons, Fin.castSucc_mk, Fin.succ_mk, Fin.ext_iff, - Fin.coe_cast] + Fin.val_cast] split · simp · simp_all [Fin.lt_def] · obtain ⟨j, h1, h2⟩ := h subst h2 - simp only [Fin.lt_def, Fin.coe_cast] + simp only [Fin.lt_def, Fin.val_cast] exact h1 · exact List.Sublist.nodup (List.take_sublist _ _) <| List.nodup_finRange (φs.length + 1) · refine List.Nodup.map ?_ ?_ · refine Function.Injective.comp ?hf.hg Fin.succAbove_right_injective exact Fin.cast_injective (eraseIdx_length (φ :: φs) (insertionSortMinPos timeOrderRel φ φs)) - · exact Finset.sort_nodup (fun x1 x2 => x1 ≤ x2) + · exact Finset.sort_nodup (Finset.filter (fun x => (maxTimeFieldPosFin φ φs).succAbove x < maxTimeFieldPosFin φ φs) - Finset.univ) + Finset.univ) (fun x1 x2 => x1 ≤ x2) end diff --git a/PhysLean/QFT/PerturbationTheory/FieldSpecification/NormalOrder.lean b/PhysLean/QFT/PerturbationTheory/FieldSpecification/NormalOrder.lean index 0a0ec7580..813258f84 100644 --- a/PhysLean/QFT/PerturbationTheory/FieldSpecification/NormalOrder.lean +++ b/PhysLean/QFT/PerturbationTheory/FieldSpecification/NormalOrder.lean @@ -26,7 +26,7 @@ def normalOrderRel : 𝓕.CrAnFieldOp → 𝓕.CrAnFieldOp → Prop := fun a b => CreateAnnihilate.normalOrder (𝓕 |>ᶜ a) (𝓕 |>ᶜ b) /-- Normal ordering is total. -/ -instance : IsTotal 𝓕.CrAnFieldOp 𝓕.normalOrderRel where +instance : Std.Total 𝓕.normalOrderRel where total _ _ := total_of CreateAnnihilate.normalOrder _ _ /-- Normal ordering is transitive. -/ @@ -255,7 +255,7 @@ lemma orderedInsert_create (φ : 𝓕.CrAnFieldOp) lemma normalOrderList_cons_create (φ : 𝓕.CrAnFieldOp) (hφ : 𝓕 |>ᶜ φ = CreateAnnihilate.create) (φs : List 𝓕.CrAnFieldOp) : normalOrderList (φ :: φs) = φ :: normalOrderList φs := by - simp only [normalOrderList, List.insertionSort] + simp only [normalOrderList, List.insertionSort_cons] rw [orderedInsert_create φ hφ] lemma orderedInsert_append_annihilate (φ' φ : 𝓕.CrAnFieldOp) @@ -278,10 +278,10 @@ lemma normalOrderList_append_annihilate (φ : 𝓕.CrAnFieldOp) normalOrderList (φs ++ [φ]) = normalOrderList φs ++ [φ] | [] => by simp [normalOrderList] | φ' :: φs => by - simp only [normalOrderList, List.insertionSort] + simp only [normalOrderList, List.insertionSort_cons] have hi := normalOrderList_append_annihilate φ hφ φs dsimp only [normalOrderList] at hi - simp only [List.cons_append, List.insertionSort] + simp only [List.cons_append, List.insertionSort_cons] rw [hi, orderedInsert_append_annihilate φ' φ hφ] lemma normalOrder_swap_create_annihilate_fst (φc φa : 𝓕.CrAnFieldOp) @@ -291,7 +291,7 @@ lemma normalOrder_swap_create_annihilate_fst (φc φa : 𝓕.CrAnFieldOp) normalOrderList (φc :: φa :: φs) = normalOrderList (φa :: φc :: φs) := by rw [normalOrderList_cons_create φc hφc (φa :: φs)] conv_rhs => - rw [normalOrderList, List.insertionSort] + rw [normalOrderList, List.insertionSort_cons] have hi := normalOrderList_cons_create φc hφc φs rw [normalOrderList] at hi rw [hi] @@ -309,7 +309,7 @@ lemma normalOrderList_swap_create_annihilate (φc φa : 𝓕.CrAnFieldOp) normalOrderList (φs ++ φc :: φa :: φs') = normalOrderList (φs ++ φa :: φc :: φs') | [], φs' => normalOrder_swap_create_annihilate_fst φc φa hφc hφa φs' | φ :: φs, φs' => by - dsimp only [List.cons_append, normalOrderList, List.insertionSort] + simp only [List.cons_append, normalOrderList, List.insertionSort_cons] have hi := normalOrderList_swap_create_annihilate φc φa hφc hφa φs φs' dsimp only [normalOrderList] at hi rw [hi] @@ -412,7 +412,7 @@ lemma normalOrderList_eq_createFilter_append_annihilateFilter : (φs : List 𝓕 simp only [hφ, reduceCtorEq, decide_false, Bool.false_eq_true, not_false_eq_true] rw [normalOrderList_eq_createFilter_append_annihilateFilter φs] rfl - · dsimp only [normalOrderList, List.insertionSort] + · simp only [normalOrderList, List.insertionSort_cons] rw [← normalOrderList] have hφ' : 𝓕 |>ᶜ φ = CreateAnnihilate.annihilate := by have hx := CreateAnnihilate.eq_create_or_annihilate (𝓕 |>ᶜ φ) diff --git a/PhysLean/QFT/PerturbationTheory/FieldSpecification/TimeOrder.lean b/PhysLean/QFT/PerturbationTheory/FieldSpecification/TimeOrder.lean index 374b5ed05..2d905db92 100644 --- a/PhysLean/QFT/PerturbationTheory/FieldSpecification/TimeOrder.lean +++ b/PhysLean/QFT/PerturbationTheory/FieldSpecification/TimeOrder.lean @@ -45,7 +45,7 @@ noncomputable instance : (φ φ' : 𝓕.FieldOp) → Decidable (timeOrderRel φ | FieldOp.inAsymp _, FieldOp.inAsymp _ => isTrue True.intro /-- Time ordering is total. -/ -instance : IsTotal 𝓕.FieldOp 𝓕.timeOrderRel where +instance : Std.Total 𝓕.timeOrderRel where total a b := by cases a <;> cases b <;> simp only [or_self, or_false, or_true, timeOrderRel, Fin.isValue] @@ -73,7 +73,8 @@ def maxTimeFieldPos (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) : ℕ := lemma maxTimeFieldPos_lt_length (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) : maxTimeFieldPos φ φs < (φ :: φs).length := by - simp [maxTimeFieldPos] + simp only [maxTimeFieldPos, List.length_cons, Order.lt_add_one_iff] + exact Fin.is_le (insertionSortMinPos timeOrderRel φ φs) /-- Given a list `φ :: φs` of states, the left-most state of maximum time, if there are more. As an example: @@ -161,14 +162,14 @@ def timeOrderList (φs : List 𝓕.FieldOp) : List 𝓕.FieldOp := lemma timeOrderList_pair_ordered {φ ψ : 𝓕.FieldOp} (h : timeOrderRel φ ψ) : timeOrderList [φ, ψ] = [φ, ψ] := by - simp only [timeOrderList, List.insertionSort, List.orderedInsert, ite_eq_left_iff, - List.cons.injEq, and_true] + simp only [timeOrderList, List.insertionSort_cons, List.insertionSort_nil, List.orderedInsert, + ite_eq_left_iff, List.cons.injEq, and_true] exact fun h' => False.elim (h' h) lemma timeOrderList_pair_not_ordered {φ ψ : 𝓕.FieldOp} (h : ¬ timeOrderRel φ ψ) : timeOrderList [φ, ψ] = [ψ, φ] := by - simp only [timeOrderList, List.insertionSort, List.orderedInsert, ite_eq_right_iff, - List.cons.injEq, and_true] + simp only [timeOrderList, List.insertionSort_cons, List.insertionSort_nil, List.orderedInsert, + ite_eq_right_iff, List.cons.injEq, and_true] exact fun h' => False.elim (h h') @[simp] @@ -212,8 +213,8 @@ noncomputable instance (φ φ' : 𝓕.CrAnFieldOp) : Decidable (crAnTimeOrderRel inferInstanceAs (Decidable (𝓕.timeOrderRel φ.1 φ'.1)) /-- Time ordering of `CrAnFieldOp` is total. -/ -instance : IsTotal 𝓕.CrAnFieldOp 𝓕.crAnTimeOrderRel where - total a b := IsTotal.total (r := 𝓕.timeOrderRel) a.1 b.1 +instance : Std.Total 𝓕.crAnTimeOrderRel where + total a b := Std.Total.total (r := 𝓕.timeOrderRel) a.1 b.1 /-- Time ordering of `CrAnFieldOp` is transitive. -/ instance : IsTrans 𝓕.CrAnFieldOp 𝓕.crAnTimeOrderRel where @@ -221,7 +222,7 @@ instance : IsTrans 𝓕.CrAnFieldOp 𝓕.crAnTimeOrderRel where @[simp] lemma crAnTimeOrderRel_refl (φ : 𝓕.CrAnFieldOp) : crAnTimeOrderRel φ φ := by - exact (IsTotal.to_isRefl (r := 𝓕.crAnTimeOrderRel)).refl φ + exact (Std.Total.to_refl (r := 𝓕.crAnTimeOrderRel)).refl φ /-- For a field specification `𝓕`, and a list `φs` of `𝓕.CrAnFieldOp`, `𝓕.crAnTimeOrderSign φs` is the sign corresponding to the number of `ferimionic`-`fermionic` @@ -263,14 +264,14 @@ lemma crAnTimeOrderList_nil : crAnTimeOrderList (𝓕 := 𝓕) [] = [] := by lemma crAnTimeOrderList_pair_ordered {φ ψ : 𝓕.CrAnFieldOp} (h : crAnTimeOrderRel φ ψ) : crAnTimeOrderList [φ, ψ] = [φ, ψ] := by - simp only [crAnTimeOrderList, List.insertionSort, List.orderedInsert, ite_eq_left_iff, - List.cons.injEq, and_true] + simp only [crAnTimeOrderList, List.insertionSort_cons, List.insertionSort_nil, List.orderedInsert, + ite_eq_left_iff, List.cons.injEq, and_true] exact fun h' => False.elim (h' h) lemma crAnTimeOrderList_pair_not_ordered {φ ψ : 𝓕.CrAnFieldOp} (h : ¬ crAnTimeOrderRel φ ψ) : crAnTimeOrderList [φ, ψ] = [ψ, φ] := by - simp only [crAnTimeOrderList, List.insertionSort, List.orderedInsert, ite_eq_right_iff, - List.cons.injEq, and_true] + simp only [crAnTimeOrderList, List.insertionSort_cons, List.insertionSort_nil, List.orderedInsert, + ite_eq_right_iff, List.cons.injEq, and_true] exact fun h' => False.elim (h h') lemma orderedInsert_swap_eq_time {φ ψ : 𝓕.CrAnFieldOp} @@ -344,7 +345,7 @@ lemma crAnTimeOrderList_swap_eq_time {φ ψ : 𝓕.CrAnFieldOp} simpa using orderedInsert_swap_eq_time h2 h1 _ | φ'' :: φs, φs' => by rw [crAnTimeOrderList, crAnTimeOrderList] - simp only [List.cons_append, List.insertionSort] + simp only [List.cons_append, List.insertionSort_cons] obtain ⟨l1, l2, hl⟩ := crAnTimeOrderList_swap_eq_time h1 h2 φs φs' simp only [crAnTimeOrderList] at hl rw [hl.1, hl.2] @@ -460,7 +461,7 @@ lemma orderedInsert_crAnTimeOrderRel_injective {ψ ψ' : 𝓕.CrAnFieldOp} (h : simp_all only [and_self, implies_true, not_false_eq_true, true_and] apply Subtype.ext simp only [List.cons.injEq, true_and] - rw [Subtype.eq_iff] at ih' + rw [Subtype.ext_iff] at ih' exact ih'.2 lemma crAnSectionTimeOrder_injective : {φs : List 𝓕.FieldOp} → @@ -472,7 +473,7 @@ lemma crAnSectionTimeOrder_injective : {φs : List 𝓕.FieldOp} → apply Subtype.ext simp only [List.cons.injEq] simp only [crAnSectionTimeOrder] at h1 - rw [Subtype.eq_iff] at h1 + rw [Subtype.ext_iff] at h1 simp only [crAnTimeOrderList, List.insertionSort] at h1 simp only [List.map_cons, List.cons.injEq] at h h' rw [crAnFieldOpToFieldOp] at h h' @@ -513,11 +514,11 @@ noncomputable instance (φ φ' : 𝓕.CrAnFieldOp) : Decidable (normTimeOrderRel instDecidableAnd /-- Norm-Time ordering of `CrAnFieldOp` is total. -/ -instance : IsTotal 𝓕.CrAnFieldOp 𝓕.normTimeOrderRel where +instance : Std.Total 𝓕.normTimeOrderRel where total a b := by simp only [normTimeOrderRel] - match IsTotal.total (r := 𝓕.crAnTimeOrderRel) a b, - IsTotal.total (r := 𝓕.normalOrderRel) a b with + match Std.Total.total (r := 𝓕.crAnTimeOrderRel) a b, + Std.Total.total (r := 𝓕.normalOrderRel) a b with | Or.inl h1, Or.inl h2 => simp [h1, h2] | Or.inr h1, Or.inl h2 => simp only [h1, h2, imp_self, and_true, true_and] diff --git a/PhysLean/QFT/PerturbationTheory/FieldStatistics/Basic.lean b/PhysLean/QFT/PerturbationTheory/FieldStatistics/Basic.lean index d8d92bb6c..d62f4f16d 100644 --- a/PhysLean/QFT/PerturbationTheory/FieldStatistics/Basic.lean +++ b/PhysLean/QFT/PerturbationTheory/FieldStatistics/Basic.lean @@ -107,13 +107,13 @@ lemma neq_bosonic_iff_eq_fermionic (a : FieldStatistic) : ¬ a = bosonic ↔ a = · simp @[simp] -lemma bosonic_neq_iff_fermionic_eq (a : FieldStatistic) : ¬ bosonic = a ↔ fermionic = a := by +lemma bosonic_ne_iff_fermionic_eq (a : FieldStatistic) : ¬ bosonic = a ↔ fermionic = a := by fin_cases a · simp · simp @[simp] -lemma fermionic_neq_iff_bosonic_eq (a : FieldStatistic) : ¬ fermionic = a ↔ bosonic = a := by +lemma fermionic_ne_iff_bosonic_eq (a : FieldStatistic) : ¬ fermionic = a ↔ bosonic = a := by fin_cases a · simp · simp diff --git a/PhysLean/QFT/PerturbationTheory/FieldStatistics/OfFinset.lean b/PhysLean/QFT/PerturbationTheory/FieldStatistics/OfFinset.lean index 576033507..53bb02b84 100644 --- a/PhysLean/QFT/PerturbationTheory/FieldStatistics/OfFinset.lean +++ b/PhysLean/QFT/PerturbationTheory/FieldStatistics/OfFinset.lean @@ -41,11 +41,11 @@ lemma ofFinset_finset_map {n m : ℕ} refine List.Perm.map f ?_ apply List.perm_of_nodup_nodup_toFinset_eq · refine (List.nodup_map_iff_inj_on ?_).mpr ?_ - exact Finset.sort_nodup (fun x1 x2 => x1 ≤ x2) a + exact a.sort_nodup (fun x1 x2 => x1 ≤ x2) simp only [Finset.mem_sort] intro x hx y hy exact fun a => hi a - · exact Finset.sort_nodup (fun x1 x2 => x1 ≤ x2) (Finset.map { toFun := i, inj' := hi } a) + · exact (Finset.map { toFun := i, inj' := hi } a).sort_nodup (fun x1 x2 => x1 ≤ x2) · ext a simp @@ -54,14 +54,14 @@ lemma ofFinset_insert (q : 𝓕 → FieldStatistic) (φs : List 𝓕) (a : Finse ofFinset q φs.get (Insert.insert i a) = (q φs[i]) * ofFinset q φs.get a := by simp only [ofFinset, instCommGroup, Fin.getElem_fin] rw [← ofList_cons_eq_mul] - have h1 : (φs[↑i] :: List.map φs.get (Finset.sort (fun x1 x2 => x1 ≤ x2) a)) - = List.map φs.get (i :: Finset.sort (fun x1 x2 => x1 ≤ x2) a) := by + have h1 : (φs[↑i] :: List.map φs.get (a.sort (fun x1 x2 => x1 ≤ x2))) + = List.map φs.get (i :: a.sort (fun x1 x2 => x1 ≤ x2)) := by simp erw [h1] apply ofList_perm refine List.Perm.map φs.get ?_ refine (List.perm_ext_iff_of_nodup ?_ ?_).mpr ?_ - · exact Finset.sort_nodup (fun x1 x2 => x1 ≤ x2) (Insert.insert i a) + · exact (Insert.insert i a).sort_nodup (fun x1 x2 => x1 ≤ x2) · simp only [List.nodup_cons, Finset.mem_sort, Finset.sort_nodup, and_true] exact h intro a @@ -85,7 +85,7 @@ lemma ofFinset_eq_prod (q : 𝓕 → FieldStatistic) (φs : List 𝓕) (a : Fins congr funext i simp only [Finset.mem_sort, Fin.getElem_fin] - exact Finset.sort_nodup (fun x1 x2 => x1 ≤ x2) a + exact a.sort_nodup (fun x1 x2 => x1 ≤ x2) lemma ofFinset_union (q : 𝓕 → FieldStatistic) (φs : List 𝓕) (a b : Finset (Fin φs.length)) : ofFinset q φs.get a * ofFinset q φs.get b = ofFinset q φs.get ((a ∪ b) \ (a ∩ b)) := by @@ -113,8 +113,8 @@ lemma ofFinset_filter_mul_neg (q : 𝓕 → FieldStatistic) (φs : List 𝓕) (a ofFinset q φs.get (Finset.filter (fun i => ¬ p i) a) = ofFinset q φs.get a := by rw [ofFinset_union_disjoint] congr - exact Finset.filter_union_filter_neg_eq p a - exact Finset.disjoint_filter_filter_neg a a p + exact Finset.filter_union_filter_not_eq p a + exact Finset.disjoint_filter_filter_not a a p lemma ofFinset_filter (q : 𝓕 → FieldStatistic) (φs : List 𝓕) (a : Finset (Fin φs.length)) (p : Fin φs.length → Prop) [DecidablePred p] : diff --git a/PhysLean/QFT/PerturbationTheory/Koszul/KoszulSign.lean b/PhysLean/QFT/PerturbationTheory/Koszul/KoszulSign.lean index 99939f0f0..7481d6f4d 100644 --- a/PhysLean/QFT/PerturbationTheory/Koszul/KoszulSign.lean +++ b/PhysLean/QFT/PerturbationTheory/Koszul/KoszulSign.lean @@ -83,7 +83,7 @@ lemma koszulSign_erase_boson {𝓕 : Type} (q : 𝓕 → FieldStatistic) (le : congr 1 rw [koszulSignInsert_erase_boson q le φ φs ⟨n, Nat.succ_lt_succ_iff.mp h⟩ h'] -lemma koszulSign_insertIdx [IsTotal 𝓕 le] [IsTrans 𝓕 le] (φ : 𝓕) : +lemma koszulSign_insertIdx [Std.Total le] [IsTrans 𝓕 le] (φ : 𝓕) : (φs : List 𝓕) → (n : ℕ) → (hn : n ≤ φs.length) → koszulSign q le (List.insertIdx φs n φ) = 𝓢(q φ, ofList q (φs.take n)) * koszulSign q le φs * 𝓢(q φ, ofList q ((List.insertionSort le (List.insertIdx φs n φ)).take @@ -96,14 +96,12 @@ lemma koszulSign_insertIdx [IsTotal 𝓕 le] [IsTrans 𝓕 le] (φ : 𝓕) : | [], n + 1, h => by simp at h | φ1 :: φs, 0, h => by - simp only [List.insertIdx_zero, List.insertionSort, List.length_cons, Fin.zero_eta] + simp only [List.insertIdx_zero, List.insertionSort_cons, List.length_cons, Fin.zero_eta] rw [koszulSign] trans koszulSign q le (φ1 :: φs) * koszulSignInsert q le φ (φ1 :: φs) · ring - simp only [insertionSortEquiv, List.length_cons, Nat.succ_eq_add_one, List.insertionSort, - orderedInsertEquiv, PhysLean.Fin.equivCons_trans, Equiv.trans_apply, - PhysLean.Fin.equivCons_zero, PhysLean.Fin.finExtractOne_apply_eq, Fin.isValue, - PhysLean.Fin.finExtractOne_symm_inl_apply] + simp only [insertionSortEquiv, List.length_cons, Nat.succ_eq_add_one, orderedInsertEquiv, + PhysLean.Fin.equivCons_trans, Equiv.trans_apply, PhysLean.Fin.equivCons_zero] conv_rhs => enter [2,2, 2, 2] rw [orderedInsert_eq_insertIdx_orderedInsertPos] @@ -123,10 +121,10 @@ lemma koszulSign_insertIdx [IsTotal 𝓕 le] [IsTrans 𝓕 le] (φ : 𝓕) : conv_rhs => rhs simp only [List.insertIdx_succ_cons] - simp only [List.insertionSort, List.length_cons, insertionSortEquiv, Nat.succ_eq_add_one, + simp only [List.insertionSort_cons, List.length_cons, insertionSortEquiv, Nat.succ_eq_add_one, Equiv.trans_apply, PhysLean.Fin.equivCons_succ] erw [orderedInsertEquiv_fin_succ] - simp only [Fin.eta, Fin.coe_cast] + simp only [Fin.eta, Fin.val_cast] rhs simp [orderedInsert_eq_insertIdx_orderedInsertPos] conv_rhs => @@ -173,9 +171,9 @@ lemma koszulSign_insertIdx [IsTotal 𝓕 le] [IsTrans 𝓕 le] (φ : 𝓕) : have hc2 (hninro : ¬ ni.castSucc < nro) : le φ1 φ := by rw [← hns] refine gt_orderedInsertPos_rel le φ1 rs ?_ ni hninro - exact List.sorted_insertionSort le (List.insertIdx φs n φ) + exact List.pairwise_insertionSort le (List.insertIdx φs n φ) by_cases hn : ni.castSucc < nro - · simp only [hn, ↓reduceIte, Fin.coe_castSucc] + · simp only [hn, ↓reduceIte, Fin.val_castSucc] rw [ofList_take_insertIdx_gt] swap · exact hn @@ -202,7 +200,7 @@ lemma insertIdx_eraseIdx {I : Type} : (n : ℕ) → (r : List I) → (hn : n < r List.eraseIdx_cons_succ, List.insertIdx_succ_cons, List.cons.injEq, true_and] exact insertIdx_eraseIdx n r _ -lemma koszulSign_eraseIdx [IsTotal 𝓕 le] [IsTrans 𝓕 le] (φs : List 𝓕) (n : Fin φs.length) : +lemma koszulSign_eraseIdx [Std.Total le] [IsTrans 𝓕 le] (φs : List 𝓕) (n : Fin φs.length) : koszulSign q le (φs.eraseIdx n) = koszulSign q le φs * 𝓢(q (φs.get n), ofList q (φs.take n)) * 𝓢(q (φs.get n), ofList q (List.take (↑(insertionSortEquiv le φs n)) (List.insertionSort le φs))) := by @@ -232,7 +230,7 @@ lemma koszulSign_eraseIdx [IsTotal 𝓕 le] [IsTrans 𝓕 le] (φs : List 𝓕) · simp only [Fin.getElem_fin] rw [Equiv.trans_apply, Equiv.trans_apply] simp only [instCommGroup.eq_1, Fin.castOrderIso, - Equiv.coe_fn_mk, Fin.cast_mk, Fin.eta, Fin.coe_cast] + Equiv.coe_fn_mk, Fin.cast_mk, Fin.eta, Fin.val_cast] ring conv_rhs => rhs @@ -243,7 +241,7 @@ lemma koszulSign_eraseIdx [IsTotal 𝓕 le] [IsTrans 𝓕 le] (φs : List 𝓕) rw [ofList_take_eraseIdx, exchangeSign_mul_self] simp -lemma koszulSign_eraseIdx_insertionSortMinPos [IsTotal 𝓕 le] [IsTrans 𝓕 le] (φ : 𝓕) (φs : List 𝓕) : +lemma koszulSign_eraseIdx_insertionSortMinPos [Std.Total le] [IsTrans 𝓕 le] (φ : 𝓕) (φs : List 𝓕) : koszulSign q le ((φ :: φs).eraseIdx (insertionSortMinPos le φ φs)) = koszulSign q le (φ :: φs) * 𝓢(q (insertionSortMin le φ φs), ofList q ((φ :: φs).take (insertionSortMinPos le φ φs))) := by rw [koszulSign_eraseIdx] @@ -309,23 +307,23 @@ lemma koszulSign_eq_rel_eq_stat {ψ φ : 𝓕} [IsTrans 𝓕 le] · rw [koszulSignInsert_eq_remove_same_stat_append q le h1 h2 hq] lemma koszulSign_of_sorted : (φs : List 𝓕) - → (hs : List.Sorted le φs) → koszulSign q le φs = 1 + → (hs : List.Pairwise le φs) → koszulSign q le φs = 1 | [], _ => by simp [koszulSign] | φ :: φs, h => by simp only [koszulSign] - simp only [List.sorted_cons] at h + simp only [List.pairwise_cons] at h rw [koszulSign_of_sorted φs h.2] simp only [mul_one] exact koszulSignInsert_of_le_mem _ _ _ _ h.1 @[simp] -lemma koszulSign_of_insertionSort [IsTotal 𝓕 le] [IsTrans 𝓕 le] (φs : List 𝓕) : +lemma koszulSign_of_insertionSort [Std.Total le] [IsTrans 𝓕 le] (φs : List 𝓕) : koszulSign q le (List.insertionSort le φs) = 1 := by apply koszulSign_of_sorted - exact List.sorted_insertionSort le φs + exact List.pairwise_insertionSort le φs -lemma koszulSign_of_append_eq_insertionSort_left [IsTotal 𝓕 le] [IsTrans 𝓕 le] : +lemma koszulSign_of_append_eq_insertionSort_left [Std.Total le] [IsTrans 𝓕 le] : (φs φs' : List 𝓕) → koszulSign q le (φs ++ φs') = koszulSign q le (List.insertionSort le φs ++ φs') * koszulSign q le φs | φs, [] => by @@ -355,9 +353,9 @@ lemma koszulSign_of_append_eq_insertionSort_left [IsTotal 𝓕 le] [IsTrans 𝓕 simp rw [insertionSortEquiv_congr _ _ h2.symm] simp only [Equiv.trans_apply, RelIso.coe_fn_toEquiv, Fin.castOrderIso_apply, Fin.cast_mk, - Fin.coe_cast] + Fin.val_cast] rw [insertionSortEquiv_insertionSort_append] - simp only [finCongr_apply, Fin.coe_cast] + simp only [finCongr_apply, Fin.val_cast] rw [insertionSortEquiv_congr _ _ h1.symm] simp · rw [insertIdx_length_fst_append] @@ -366,7 +364,7 @@ lemma koszulSign_of_append_eq_insertionSort_left [IsTotal 𝓕 le] [IsTrans 𝓕 symm apply insertionSort_insertionSort_append -lemma koszulSign_of_append_eq_insertionSort [IsTotal 𝓕 le] [IsTrans 𝓕 le] : (φs'' φs φs' : List 𝓕) → +lemma koszulSign_of_append_eq_insertionSort [Std.Total le] [IsTrans 𝓕 le] : (φs'' φs φs' : List 𝓕) → koszulSign q le (φs'' ++ φs ++ φs') = koszulSign q le (φs'' ++ List.insertionSort le φs ++ φs') * koszulSign q le φs | [], φs, φs'=> by diff --git a/PhysLean/QFT/PerturbationTheory/Koszul/KoszulSignInsert.lean b/PhysLean/QFT/PerturbationTheory/Koszul/KoszulSignInsert.lean index eb5b6f5d4..73bfb23bf 100644 --- a/PhysLean/QFT/PerturbationTheory/Koszul/KoszulSignInsert.lean +++ b/PhysLean/QFT/PerturbationTheory/Koszul/KoszulSignInsert.lean @@ -96,11 +96,11 @@ lemma koszulSignInsert_eq_filter (φ : 𝓕) : (φs : List 𝓕) → · simp only [decide_not] · simp -lemma koszulSignInsert_eq_cons [IsTotal 𝓕 le] (φ : 𝓕) (φs : List 𝓕) : +lemma koszulSignInsert_eq_cons [Std.Total le] (φ : 𝓕) (φs : List 𝓕) : koszulSignInsert q le φ φs = koszulSignInsert q le φ (φ :: φs) := by simp only [koszulSignInsert, and_self] have h1 : le φ φ := by - simpa only [or_self] using IsTotal.total (r := le) φ φ + simpa only [or_self] using Std.Total.total (r := le) φ φ simp [h1] lemma koszulSignInsert_eq_grade (φ : 𝓕) (φs : List 𝓕) : @@ -154,7 +154,7 @@ lemma koszulSignInsert_eq_sort (φs : List 𝓕) (φ : 𝓕) : apply koszulSignInsert_eq_perm exact List.Perm.symm (List.perm_insertionSort le φs) -lemma koszulSignInsert_eq_exchangeSign_take [IsTotal 𝓕 le] [IsTrans 𝓕 le] (φ : 𝓕) (φs : List 𝓕) : +lemma koszulSignInsert_eq_exchangeSign_take [Std.Total le] [IsTrans 𝓕 le] (φ : 𝓕) (φs : List 𝓕) : koszulSignInsert q le φ φs = 𝓢(q φ, ofList q ((List.insertionSort le φs).take (orderedInsertPos le (List.insertionSort le φs) φ))) := by rw [koszulSignInsert_eq_cons, koszulSignInsert_eq_sort, koszulSignInsert_eq_filter, @@ -169,7 +169,7 @@ lemma koszulSignInsert_eq_exchangeSign_take [IsTotal 𝓕 le] [IsTrans 𝓕 le] rw [hx] congr simp only [List.filter_filter, Bool.and_self] - rw [List.insertionSort] + rw [List.insertionSort_cons] nth_rewrite 1 [List.orderedInsert_eq_take_drop] rw [List.filter_append] have h1 : List.filter (fun a => decide ¬le φ a) @@ -185,21 +185,21 @@ lemma koszulSignInsert_eq_exchangeSign_take [IsTotal 𝓕 le] [IsTrans 𝓕 le] simp_all rw [h1] rw [List.filter_cons] - simp only [decide_not, (IsTotal.to_isRefl le).refl φ, not_true_eq_false, decide_false, + simp only [decide_not, (Std.Total.to_refl le).refl φ, not_true_eq_false, decide_false, Bool.false_eq_true, ↓reduceIte] rw [orderedInsertPos_take] simp only [decide_not, List.append_right_eq_self, List.filter_eq_nil_iff, Bool.not_eq_eq_eq_not, Bool.not_true, decide_eq_false_iff_not, Decidable.not_not] intro a ha - refine List.Sorted.rel_of_mem_take_of_mem_drop - (k := (orderedInsertPos le (List.insertionSort le φs) φ).1 + 1) - (List.sorted_insertionSort le (φ :: φs)) ?_ ?_ - · simp only [List.insertionSort, List.orderedInsert_eq_take_drop, decide_not] + refine List.Pairwise.rel_of_mem_take_of_mem_drop + (i := (orderedInsertPos le (List.insertionSort le φs) φ).1 + 1) + (List.pairwise_insertionSort le (φ :: φs)) ?_ ?_ + · simp only [List.insertionSort, List.foldr_cons, List.orderedInsert_eq_take_drop, decide_not] rw [List.take_append] rw [List.take_of_length_le] · simp [orderedInsertPos] · simp [orderedInsertPos] - · simp only [List.insertionSort, List.orderedInsert_eq_take_drop, decide_not] + · simp only [List.insertionSort_cons, List.orderedInsert_eq_take_drop, decide_not] rw [List.drop_append, List.drop_of_length_le] · simpa [orderedInsertPos] using ha · simp [orderedInsertPos] diff --git a/PhysLean/QFT/PerturbationTheory/WickAlgebra/Basic.lean b/PhysLean/QFT/PerturbationTheory/WickAlgebra/Basic.lean index 8eaacb54e..6d44e0277 100644 --- a/PhysLean/QFT/PerturbationTheory/WickAlgebra/Basic.lean +++ b/PhysLean/QFT/PerturbationTheory/WickAlgebra/Basic.lean @@ -120,7 +120,7 @@ lemma ι_superCommuteF_zero_of_fermionic (φ ψ : 𝓕.CrAnFieldOp) (h : [ofCrAnOpF φ, ofCrAnOpF ψ]ₛF ∈ statisticSubmodule fermionic) : ι [ofCrAnOpF φ, ofCrAnOpF ψ]ₛF = 0 := by rw [← ofCrAnListF_singleton, ← ofCrAnListF_singleton] at h ⊢ - rcases statistic_neq_of_superCommuteF_fermionic h with h | h + rcases statistic_ne_of_superCommuteF_fermionic h with h | h · simp only [ofCrAnListF_singleton] apply ι_superCommuteF_of_diff_statistic simpa using h @@ -208,7 +208,7 @@ lemma ι_eq_zero_iff_mem_ideal (x : FieldOpFreeAlgebra 𝓕) : ι x = 0 ↔ x ∈ TwoSidedIdeal.span 𝓕.fieldOpIdealSet := by rw [ι_apply] change ⟦x⟧ = ⟦0⟧ ↔ _ - aesop + simp_all only [Quotient.eq, Con.rel_eq_coe, RingCon.toCon_coe_eq_coe, TwoSidedIdeal.mem_mk] lemma bosonicProjF_mem_fieldOpIdealSet_or_zero (x : FieldOpFreeAlgebra 𝓕) (hx : x ∈ 𝓕.fieldOpIdealSet) : diff --git a/PhysLean/QFT/PerturbationTheory/WickAlgebra/Grading.lean b/PhysLean/QFT/PerturbationTheory/WickAlgebra/Grading.lean index 7aa374d4b..a5be8b09d 100644 --- a/PhysLean/QFT/PerturbationTheory/WickAlgebra/Grading.lean +++ b/PhysLean/QFT/PerturbationTheory/WickAlgebra/Grading.lean @@ -104,7 +104,7 @@ lemma bosonicProjFree_eq_ι_bosonicProjF (a : 𝓕.FieldOpFreeAlgebra) : lemma bosonicProjFree_zero_of_ι_zero (a : 𝓕.FieldOpFreeAlgebra) (h : ι a = 0) : bosonicProjFree a = 0 := by rw [ι_eq_zero_iff_ι_bosonicProjF_fermonicProj_zero] at h - apply Subtype.eq + apply Subtype.ext rw [bosonicProjFree_eq_ι_bosonicProjF] exact h.1 @@ -150,7 +150,7 @@ lemma fermionicProjFree_eq_ι_fermionicProjF (a : 𝓕.FieldOpFreeAlgebra) : lemma fermionicProjFree_zero_of_ι_zero (a : 𝓕.FieldOpFreeAlgebra) (h : ι a = 0) : fermionicProjFree a = 0 := by rw [ι_eq_zero_iff_ι_bosonicProjF_fermonicProj_zero] at h - apply Subtype.eq + apply Subtype.ext rw [fermionicProjFree_eq_ι_fermionicProjF] exact h.2 @@ -202,7 +202,7 @@ lemma bosonicProj_mem_bosonic (a : 𝓕.WickAlgebra) (ha : a ∈ statSubmodule . · intro x hx obtain ⟨φs, rfl, h⟩ := hx simp only [p] - apply Subtype.eq + apply Subtype.ext simp only rw [ofCrAnList] rw [bosonicProj_eq_bosonicProjFree] @@ -225,7 +225,7 @@ lemma fermionicProj_mem_fermionic (a : 𝓕.WickAlgebra) (ha : a ∈ statSubmodu · intro x hx obtain ⟨φs, rfl, h⟩ := hx simp only [p] - apply Subtype.eq + apply Subtype.ext simp only rw [ofCrAnList] rw [fermionicProj_eq_fermionicProjFree] diff --git a/PhysLean/QFT/PerturbationTheory/WickAlgebra/NormalOrder/Basic.lean b/PhysLean/QFT/PerturbationTheory/WickAlgebra/NormalOrder/Basic.lean index a49e7ff8c..9df0a592a 100644 --- a/PhysLean/QFT/PerturbationTheory/WickAlgebra/NormalOrder/Basic.lean +++ b/PhysLean/QFT/PerturbationTheory/WickAlgebra/NormalOrder/Basic.lean @@ -215,8 +215,7 @@ lemma ι_normalOrderF_zero_of_mem_ideal (a : 𝓕.FieldOpFreeAlgebra) lemma ι_normalOrderF_eq_of_equiv (a b : 𝓕.FieldOpFreeAlgebra) (h : a ≈ b) : ι 𝓝ᶠ(a) = ι 𝓝ᶠ(b) := by rw [equiv_iff_sub_mem_ideal] at h - rw [LinearMap.sub_mem_ker_iff.mp] - simp only [LinearMap.mem_ker, ← map_sub] + rw [← sub_eq_zero, ← map_sub, ← LinearMap.map_sub] exact ι_normalOrderF_zero_of_mem_ideal (a - b) h /-- For a field specification `𝓕`, `normalOrder` is the linear map diff --git a/PhysLean/QFT/PerturbationTheory/WickAlgebra/NormalOrder/Lemmas.lean b/PhysLean/QFT/PerturbationTheory/WickAlgebra/NormalOrder/Lemmas.lean index 5ea7e3702..da216a3b4 100644 --- a/PhysLean/QFT/PerturbationTheory/WickAlgebra/NormalOrder/Lemmas.lean +++ b/PhysLean/QFT/PerturbationTheory/WickAlgebra/NormalOrder/Lemmas.lean @@ -273,7 +273,7 @@ lemma ofCrAnOp_superCommute_normalOrder_ofFieldOpList_sum (φ : 𝓕.CrAnFieldOp rw [CrAnSection.take_statistics_eq_take_state_statistics, smul_mul_assoc] rw [Finset.sum_comm] refine Finset.sum_congr rfl (fun n _ => ?_) - simp only [instCommGroup.eq_1, Fin.coe_cast, Fin.getElem_fin, + simp only [instCommGroup.eq_1, Fin.val_cast, Fin.getElem_fin, CrAnSection.sum_eraseIdxEquiv n _ n.prop, CrAnSection.eraseIdxEquiv_symm_getElem, CrAnSection.eraseIdxEquiv_symm_eraseIdx, ← Finset.smul_sum, Algebra.smul_mul_assoc] diff --git a/PhysLean/QFT/PerturbationTheory/WickAlgebra/NormalOrder/WickContractions.lean b/PhysLean/QFT/PerturbationTheory/WickAlgebra/NormalOrder/WickContractions.lean index 3436648f8..9ce64d5ab 100644 --- a/PhysLean/QFT/PerturbationTheory/WickAlgebra/NormalOrder/WickContractions.lean +++ b/PhysLean/QFT/PerturbationTheory/WickAlgebra/NormalOrder/WickContractions.lean @@ -41,7 +41,8 @@ lemma normalOrder_uncontracted_none (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp 𝓝(ofFieldOpList (φ :: [φsΛ]ᵘᶜ)) := by simp only [Nat.succ_eq_add_one, instCommGroup.eq_1] rw [ofFieldOpList_normalOrder_insert φ [φsΛ]ᵘᶜ - ⟨(φsΛ.uncontractedListOrderPos i), by simp [uncontractedListGet]⟩, smul_smul] + ⟨(φsΛ.uncontractedListOrderPos i), by simp [uncontractedListGet]⟩, + smul_smul] trans (1 : ℂ) • (𝓝(ofFieldOpList [φsΛ ↩Λ φ i none]ᵘᶜ)) · simp congr 1 @@ -53,11 +54,11 @@ lemma normalOrder_uncontracted_none (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp congr rw [uncontractedList_eq_sort] have hdup : (List.filter (fun x => decide (x.1 < i.1)) - (Finset.sort (fun x1 x2 => x1 ≤ x2) φsΛ.uncontracted)).Nodup := by - exact List.Nodup.filter _ (Finset.sort_nodup (fun x1 x2 => x1 ≤ x2) φsΛ.uncontracted) + (φsΛ.uncontracted.sort (fun x1 x2 => x1 ≤ x2))).Nodup := by + exact List.Nodup.filter _ (φsΛ.uncontracted.sort_nodup (fun x1 x2 => x1 ≤ x2)) have hsort : (List.filter (fun x => decide (x.1 < i.1)) - (Finset.sort (fun x1 x2 => x1 ≤ x2) φsΛ.uncontracted)).Sorted (· ≤ ·) := by - exact List.Sorted.filter _ (Finset.sort_sorted (fun x1 x2 => x1 ≤ x2) φsΛ.uncontracted) + (φsΛ.uncontracted.sort (fun x1 x2 => x1 ≤ x2))).Pairwise (· ≤ ·) := by + exact List.Pairwise.filter _ (φsΛ.uncontracted.pairwise_sort (fun x1 x2 => x1 ≤ x2)) rw [← (List.toFinset_sort (· ≤ ·) hdup).mpr hsort] congr ext a @@ -77,7 +78,7 @@ lemma normalOrder_uncontracted_none (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp · intro h rename_i h rw [Fin.lt_def] at h - simp only [Fin.coe_castSucc] at h + simp only [Fin.val_castSucc] at h omega · apply Iff.intro · intro h @@ -85,7 +86,7 @@ lemma normalOrder_uncontracted_none (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp rw [Fin.lt_def] simp only [Fin.val_succ] rw [Fin.lt_def] at h' - simp only [Fin.coe_castSucc, not_lt] at h' + simp only [Fin.val_castSucc, not_lt] at h' omega · intro h rename_i h @@ -112,7 +113,7 @@ lemma normalOrder_uncontracted_some (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp = 𝓝(ofFieldOpList (optionEraseZ [φsΛ]ᵘᶜ φ ((uncontractedFieldOpEquiv φs φsΛ) k))) := by simp only [Nat.succ_eq_add_one, insertAndContract, optionEraseZ, uncontractedFieldOpEquiv, Equiv.optionCongr_apply, Equiv.coe_trans, Option.map_some, Function.comp_apply, finCongr_apply, - Fin.coe_cast, uncontractedListGet] + Fin.val_cast, uncontractedListGet] congr rw [congr_uncontractedList] erw [uncontractedList_extractEquiv_symm_some] diff --git a/PhysLean/QFT/PerturbationTheory/WickAlgebra/StaticWickTerm.lean b/PhysLean/QFT/PerturbationTheory/WickAlgebra/StaticWickTerm.lean index 4dc49372b..c23bdad74 100644 --- a/PhysLean/QFT/PerturbationTheory/WickAlgebra/StaticWickTerm.lean +++ b/PhysLean/QFT/PerturbationTheory/WickAlgebra/StaticWickTerm.lean @@ -103,7 +103,7 @@ lemma staticWickTerm_insert_zero_some (φ : 𝓕.FieldOp) (φs : List 𝓕.Field have h1 : contractStateAtIndex φ [φsΛ]ᵘᶜ (uncontractedFieldOpEquiv φs φsΛ k) = 0 := by simp only [contractStateAtIndex, uncontractedFieldOpEquiv, Equiv.optionCongr_apply, Equiv.coe_trans, Option.map_some, Function.comp_apply, finCongr_apply, - instCommGroup.eq_1, Fin.coe_cast, Fin.getElem_fin, smul_eq_zero] + instCommGroup.eq_1, Fin.val_cast, Fin.getElem_fin, smul_eq_zero] right simp only [uncontractedListGet, List.getElem_map, uncontractedList_getElem_uncontractedIndexEquiv_symm, List.get_eq_getElem] diff --git a/PhysLean/QFT/PerturbationTheory/WickAlgebra/SuperCommute.lean b/PhysLean/QFT/PerturbationTheory/WickAlgebra/SuperCommute.lean index 9f8a92112..4625534f8 100644 --- a/PhysLean/QFT/PerturbationTheory/WickAlgebra/SuperCommute.lean +++ b/PhysLean/QFT/PerturbationTheory/WickAlgebra/SuperCommute.lean @@ -44,8 +44,7 @@ lemma ι_superCommuteF_right_zero_of_mem_ideal (a b : 𝓕.FieldOpFreeAlgebra) lemma ι_superCommuteF_eq_of_equiv_right (a b1 b2 : 𝓕.FieldOpFreeAlgebra) (h : b1 ≈ b2) : ι [a, b1]ₛF = ι [a, b2]ₛF := by rw [equiv_iff_sub_mem_ideal] at h - rw [LinearMap.sub_mem_ker_iff.mp] - simp only [LinearMap.mem_ker, ← map_sub] + rw [← sub_eq_zero, ← map_sub, ← LinearMap.map_sub] exact ι_superCommuteF_right_zero_of_mem_ideal a (b1 - b2) h /-- The super commutator on the `WickAlgebra` defined as a linear map `[a,_]ₛ`. -/ diff --git a/PhysLean/QFT/PerturbationTheory/WickAlgebra/TimeContraction.lean b/PhysLean/QFT/PerturbationTheory/WickAlgebra/TimeContraction.lean index 34b05da6d..2dd22a082 100644 --- a/PhysLean/QFT/PerturbationTheory/WickAlgebra/TimeContraction.lean +++ b/PhysLean/QFT/PerturbationTheory/WickAlgebra/TimeContraction.lean @@ -66,7 +66,7 @@ lemma timeContract_of_not_timeOrderRel_expand (φ ψ : 𝓕.FieldOp) (h : ¬ tim timeContract φ ψ = 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ψ) • [anPart ψ, ofFieldOp φ]ₛ := by rw [timeContract_of_not_timeOrderRel _ _ h] rw [timeContract_of_timeOrderRel _ _ _] - have h1 := IsTotal.total (r := 𝓕.timeOrderRel) φ ψ + have h1 := Std.Total.total (r := 𝓕.timeOrderRel) φ ψ simp_all lemma timeContract_eq_superCommute (φ ψ : 𝓕.FieldOp) : @@ -89,7 +89,7 @@ lemma timeContract_mem_center (φ ψ : 𝓕.FieldOp) : refine Subalgebra.smul_mem (Subalgebra.center ℂ _) ?_ 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ψ) rw [timeContract_of_timeOrderRel] exact superCommute_anPart_ofFieldOp_mem_center _ _ - have h1 := IsTotal.total (r := 𝓕.timeOrderRel) φ ψ + have h1 := Std.Total.total (r := 𝓕.timeOrderRel) φ ψ simp_all lemma timeContract_zero_of_diff_grade (φ ψ : 𝓕.FieldOp) (h : (𝓕 |>ₛ φ) ≠ (𝓕 |>ₛ ψ)) : @@ -103,7 +103,7 @@ lemma timeContract_zero_of_diff_grade (φ ψ : 𝓕.FieldOp) (h : (𝓕 |>ₛ φ rw [superCommute_anPart_ofFieldOpF_diff_grade_zero] simp only [instCommGroup.eq_1, smul_zero] exact h.symm - have ht := IsTotal.total (r := 𝓕.timeOrderRel) φ ψ + have ht := Std.Total.total (r := 𝓕.timeOrderRel) φ ψ simp_all lemma normalOrder_timeContract (φ ψ : 𝓕.FieldOp) : @@ -114,7 +114,7 @@ lemma normalOrder_timeContract (φ ψ : 𝓕.FieldOp) : · rw [timeContract_of_not_timeOrderRel _ _ h] simp only [instCommGroup.eq_1, map_smul, smul_eq_zero] have h1 : timeOrderRel ψ φ := by - have ht : timeOrderRel φ ψ ∨ timeOrderRel ψ φ := IsTotal.total (r := 𝓕.timeOrderRel) φ ψ + have ht : timeOrderRel φ ψ ∨ timeOrderRel ψ φ := Std.Total.total (r := 𝓕.timeOrderRel) φ ψ simp_all rw [timeContract_of_timeOrderRel _ _ h1] simp @@ -149,7 +149,7 @@ lemma timeOrder_timeContract_eq_time_left {φ ψ : 𝓕.FieldOp} rw [timeOrder_timeContract_eq_time_mid h1 h2] simp -lemma timeOrder_timeContract_neq_time {φ ψ : 𝓕.FieldOp} +lemma timeOrder_timeContract_ne_time {φ ψ : 𝓕.FieldOp} (h1 : ¬ (timeOrderRel φ ψ ∧ timeOrderRel ψ φ)) : 𝓣(timeContract φ ψ) = 0 := by by_cases h2 : timeOrderRel φ ψ @@ -165,11 +165,11 @@ lemma timeOrder_timeContract_neq_time {φ ψ : 𝓕.FieldOp} simp | .position φ => simp only [anPart_position] - apply timeOrder_superCommute_neq_time + apply timeOrder_superCommute_ne_time simp_all [crAnTimeOrderRel] | .outAsymp φ => simp only [anPart_outAsymp] - apply timeOrder_superCommute_neq_time + apply timeOrder_superCommute_ne_time simp_all [crAnTimeOrderRel] · rw [timeContract_of_not_timeOrderRel_expand _ _ h2] simp only [instCommGroup.eq_1, map_smul, smul_eq_zero] @@ -183,11 +183,11 @@ lemma timeOrder_timeContract_neq_time {φ ψ : 𝓕.FieldOp} simp | .position ψ => simp only [anPart_position] - apply timeOrder_superCommute_neq_time + apply timeOrder_superCommute_ne_time simp_all [crAnTimeOrderRel] | .outAsymp ψ => simp only [anPart_outAsymp] - apply timeOrder_superCommute_neq_time + apply timeOrder_superCommute_ne_time simp_all [crAnTimeOrderRel] /-- The time contraction of an incoming asymptotic field with diff --git a/PhysLean/QFT/PerturbationTheory/WickAlgebra/TimeOrder.lean b/PhysLean/QFT/PerturbationTheory/WickAlgebra/TimeOrder.lean index f52d127ae..431f26e2f 100644 --- a/PhysLean/QFT/PerturbationTheory/WickAlgebra/TimeOrder.lean +++ b/PhysLean/QFT/PerturbationTheory/WickAlgebra/TimeOrder.lean @@ -278,7 +278,7 @@ lemma ι_timeOrderF_superCommuteF_eq_time {φ ψ : 𝓕.CrAnFieldOp} · intro x hx hpx simp_all [pb] -lemma ι_timeOrderF_superCommuteF_neq_time {φ ψ : 𝓕.CrAnFieldOp} +lemma ι_timeOrderF_superCommuteF_ne_time {φ ψ : 𝓕.CrAnFieldOp} (hφψ : ¬ (crAnTimeOrderRel φ ψ ∧ crAnTimeOrderRel ψ φ)) (a b : 𝓕.FieldOpFreeAlgebra) : ι 𝓣ᶠ(a * [ofCrAnOpF φ, ofCrAnOpF ψ]ₛF * b) = 0 := by rw [timeOrderF_timeOrderF_mid] @@ -328,7 +328,7 @@ lemma ι_timeOrderF_zero_of_mem_ideal (a : 𝓕.FieldOpFreeAlgebra) · exact hφb · exact heqt.1 · exact heqt.2 - · rw [ι_timeOrderF_superCommuteF_neq_time heqt] + · rw [ι_timeOrderF_superCommuteF_ne_time heqt] | Or.inr (Or.inr (Or.inl hc)) => obtain ⟨φa, hφa, φb, hφb, rfl⟩ := hc by_cases heqt : (crAnTimeOrderRel φa φb ∧ crAnTimeOrderRel φb φa) @@ -340,7 +340,7 @@ lemma ι_timeOrderF_zero_of_mem_ideal (a : 𝓕.FieldOpFreeAlgebra) · exact hφb · exact heqt.1 · exact heqt.2 - · rw [ι_timeOrderF_superCommuteF_neq_time heqt] + · rw [ι_timeOrderF_superCommuteF_ne_time heqt] | Or.inr (Or.inr (Or.inr hc)) => obtain ⟨φa, φb, hdiff, rfl⟩ := hc by_cases heqt : (crAnTimeOrderRel φa φb ∧ crAnTimeOrderRel φb φa) @@ -351,7 +351,7 @@ lemma ι_timeOrderF_zero_of_mem_ideal (a : 𝓕.FieldOpFreeAlgebra) · exact hdiff · exact heqt.1 · exact heqt.2 - · rw [ι_timeOrderF_superCommuteF_neq_time heqt] + · rw [ι_timeOrderF_superCommuteF_ne_time heqt] · simp [p] · intro x y hx hy simp only [map_add, p] @@ -363,8 +363,7 @@ lemma ι_timeOrderF_zero_of_mem_ideal (a : 𝓕.FieldOpFreeAlgebra) lemma ι_timeOrderF_eq_of_equiv (a b : 𝓕.FieldOpFreeAlgebra) (h : a ≈ b) : ι 𝓣ᶠ(a) = ι 𝓣ᶠ(b) := by rw [equiv_iff_sub_mem_ideal] at h - rw [LinearMap.sub_mem_ker_iff.mp] - simp only [LinearMap.mem_ker, ← map_sub] + rw [← sub_eq_zero, ← map_sub, ← LinearMap.map_sub] exact ι_timeOrderF_zero_of_mem_ideal (a - b) h /-- For a field specification `𝓕`, `timeOrder` is the linear map @@ -468,7 +467,7 @@ lemma timeOrder_superCommute_eq_time_left {φ ψ : 𝓕.CrAnFieldOp} rw [timeOrder_superCommute_eq_time_mid hφψ hψφ] simp -lemma timeOrder_superCommute_neq_time {φ ψ : 𝓕.CrAnFieldOp} +lemma timeOrder_superCommute_ne_time {φ ψ : 𝓕.CrAnFieldOp} (hφψ : ¬ (crAnTimeOrderRel φ ψ ∧ crAnTimeOrderRel ψ φ)) : 𝓣([ofCrAnOp φ, ofCrAnOp ψ]ₛ) = 0 := by rw [ofCrAnOp, ofCrAnOp] @@ -476,10 +475,10 @@ lemma timeOrder_superCommute_neq_time {φ ψ : 𝓕.CrAnFieldOp} rw [timeOrder_eq_ι_timeOrderF] trans ι (timeOrderF (1 * (superCommuteF (ofCrAnOpF φ)) (ofCrAnOpF ψ) * 1)) simp only [one_mul, mul_one] - rw [ι_timeOrderF_superCommuteF_neq_time] + rw [ι_timeOrderF_superCommuteF_ne_time] exact hφψ -lemma timeOrder_superCommute_anPart_ofFieldOp_neq_time {φ ψ : 𝓕.FieldOp} +lemma timeOrder_superCommute_anPart_ofFieldOp_ne_time {φ ψ : 𝓕.FieldOp} (hφψ : ¬ (timeOrderRel φ ψ ∧ timeOrderRel ψ φ)) : 𝓣([anPart φ,ofFieldOp ψ]ₛ) = 0 := by rw [ofFieldOp_eq_sum] @@ -491,11 +490,11 @@ lemma timeOrder_superCommute_anPart_ofFieldOp_neq_time {φ ψ : 𝓕.FieldOp} simp | .position φ => simp only [anPart_position] - apply timeOrder_superCommute_neq_time + apply timeOrder_superCommute_ne_time simp_all [crAnTimeOrderRel] | .outAsymp φ => simp only [anPart_outAsymp] - apply timeOrder_superCommute_neq_time + apply timeOrder_superCommute_ne_time simp_all [crAnTimeOrderRel] /-- For a field specification `𝓕`, and `a`, `b`, `c` in `𝓕.WickAlgebra`, then diff --git a/PhysLean/QFT/PerturbationTheory/WickAlgebra/WickTerm.lean b/PhysLean/QFT/PerturbationTheory/WickAlgebra/WickTerm.lean index 5fb3ef5e0..a16877c61 100644 --- a/PhysLean/QFT/PerturbationTheory/WickAlgebra/WickTerm.lean +++ b/PhysLean/QFT/PerturbationTheory/WickAlgebra/WickTerm.lean @@ -150,7 +150,7 @@ lemma wickTerm_insert_some (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) · have hg := hg hg' simp only [Nat.succ_eq_add_one, Fin.getElem_fin, ite_mul, Algebra.smul_mul_assoc, instCommGroup.eq_1, contractStateAtIndex, uncontractedFieldOpEquiv, Equiv.optionCongr_apply, - Equiv.coe_trans, Option.map_some, Function.comp_apply, finCongr_apply, Fin.coe_cast, + Equiv.coe_trans, Option.map_some, Function.comp_apply, finCongr_apply, Fin.val_cast, List.getElem_map, uncontractedList_getElem_uncontractedIndexEquiv_symm, List.get_eq_getElem, uncontractedListGet] by_cases h1 : i < i.succAbove ↑k diff --git a/PhysLean/QFT/PerturbationTheory/WickAlgebra/WicksTheoremNormal.lean b/PhysLean/QFT/PerturbationTheory/WickAlgebra/WicksTheoremNormal.lean index 8eb983e30..e938345d3 100644 --- a/PhysLean/QFT/PerturbationTheory/WickAlgebra/WicksTheoremNormal.lean +++ b/PhysLean/QFT/PerturbationTheory/WickAlgebra/WicksTheoremNormal.lean @@ -192,8 +192,8 @@ lemma wicks_theorem_normal_order_empty : 𝓣(𝓝(ofFieldOpList [])) = left_inv := by intro a simp only [List.length_nil] - apply Subtype.eq - apply Subtype.eq + apply Subtype.ext + apply Subtype.ext simp only [empty] ext i simp only [Finset.notMem_empty, false_iff] @@ -245,7 +245,7 @@ theorem wicks_theorem_normal_order : (φs : List 𝓕.FieldOp) → simp [wickTerm] termination_by φs => φs.length decreasing_by - simp only [uncontractedListGet, List.length_cons, List.length_map, gt_iff_lt] + simp only [uncontractedListGet, List.length_cons, List.length_map] rw [uncontractedList_length_eq_card] have hc := uncontracted_card_eq_iff φsΛ.1 simp only [List.length_cons, φsΛ.2.2, iff_false] at hc diff --git a/PhysLean/QFT/PerturbationTheory/WickContraction/Basic.lean b/PhysLean/QFT/PerturbationTheory/WickContraction/Basic.lean index 454b262ac..b768fa18d 100644 --- a/PhysLean/QFT/PerturbationTheory/WickContraction/Basic.lean +++ b/PhysLean/QFT/PerturbationTheory/WickContraction/Basic.lean @@ -35,7 +35,7 @@ instance : DecidableEq (WickContraction n) := Subtype.instDecidableEq def empty : WickContraction n := ⟨∅, by simp, by simp⟩ lemma card_zero_iff_empty (c : WickContraction n) : c.1.card = 0 ↔ c = empty := by - rw [Subtype.eq_iff, Finset.card_eq_zero, empty] + rw [Subtype.ext_iff, Finset.card_eq_zero, empty] lemma exists_pair_of_not_eq_empty (c : WickContraction n) (h : c ≠ empty) : ∃ i j, {i, j} ∈ c.1 := by @@ -50,7 +50,7 @@ lemma exists_pair_of_not_eq_empty (c : WickContraction n) (h : c ≠ empty) : obtain ⟨x, y, hx, rfl⟩ := hc exact hn x y hn' apply h - apply Subtype.eq + apply Subtype.ext_iff.mpr simp [empty, hc] /-- The equivalence between `WickContraction n` and `WickContraction m` @@ -141,7 +141,7 @@ lemma eq_filter_mem_self : c.1 = Finset.filter (fun x => x ∈ c.1) Finset.univ /-- For a contraction `c : WickContraction n` and `i : Fin n` the `j` such that `{i, j}` is a contracted pair in `c`. If such an `j` does not exist, this returns `none`. -/ -def getDual? (i : Fin n) : Option (Fin n) := Fin.find (fun j => {i, j} ∈ c.1) +def getDual? (i : Fin n) : Option (Fin n) := Fin.find? (fun j => {i, j} ∈ c.1) lemma getDual?_congr {n m : ℕ} (h : n = m) (c : WickContraction n) (i : Fin m) : (congr h c).getDual? i = Option.map (finCongr h) (c.getDual? (finCongr h.symm i)) := by @@ -158,11 +158,11 @@ lemma getDual?_congr_get {n m : ℕ} (h : n = m) (c : WickContraction n) (i : Fi lemma getDual?_eq_some_iff_mem (i j : Fin n) : c.getDual? i = some j ↔ {i, j} ∈ c.1 := by simp only [getDual?] - rw [Fin.find_eq_some_iff] + rw [Fin.find?_eq_some_iff] apply Iff.intro <;> intro h - · exact h.1 - · simp only [h, true_and] - intro k hk + · simpa using h.1 + · simp [h, true_and] + intro k hkj hk have hc := c.2.2 _ h _ hk simp only [Finset.disjoint_insert_right, Finset.mem_insert, Finset.mem_singleton, true_or, not_true_eq_false, Finset.disjoint_singleton_right, not_or, false_and, or_false] at hc @@ -174,7 +174,7 @@ lemma getDual?_eq_some_iff_mem (i j : Fin n) : have hc := c.2.1 _ hk simp at hc · subst hj - simp + simp at hkj @[simp] lemma getDual?_one_eq_none (c : WickContraction 1) (i : Fin 1) : c.getDual? i = none := by @@ -209,7 +209,7 @@ lemma getDual?_eq_some_neq (i j : Fin n) (h : c.getDual? i = some j) : simp at hc @[simp] -lemma self_neq_getDual?_get (i : Fin n) (h : (c.getDual? i).isSome) : +lemma self_ne_getDual?_get (i : Fin n) (h : (c.getDual? i).isSome) : ¬ i = (c.getDual? i).get h := by by_contra hn have hx : {i, (c.getDual? i).get h} ∈ c.1 := by simp @@ -228,9 +228,10 @@ lemma getDual?_get_self_neq (i : Fin n) (h : (c.getDual? i).isSome) : lemma getDual?_isSome_iff (i : Fin n) : (c.getDual? i).isSome ↔ ∃ (a : c.1), i ∈ a.1 := by apply Iff.intro <;> intro h - · rw [getDual?, Fin.isSome_find_iff] at h + · rw [getDual?, Fin.isSome_find?_iff] at h obtain ⟨a, ha⟩ := h - exact ⟨⟨{i, a}, ha⟩, Finset.mem_insert_self ..⟩ + use ⟨{i, a}, by simpa using ha⟩ + simp · obtain ⟨a, ha⟩ := h have ha := c.2.1 a a.2 rw [@Finset.card_eq_two] at ha @@ -240,14 +241,14 @@ lemma getDual?_isSome_iff (i : Fin n) : (c.getDual? i).isSome ↔ ∃ (a : c.1), match ha with | Or.inl ha => subst ha - rw [getDual?, Fin.isSome_find_iff] - exact ⟨y, hy ▸ a.2⟩ + rw [getDual?, Fin.isSome_find?_iff] + exact ⟨y, by simpa using hy ▸ a.2⟩ | Or.inr ha => subst ha - rw [getDual?, Fin.isSome_find_iff] + rw [getDual?, Fin.isSome_find?_iff] use x rw [Finset.pair_comm] - exact hy ▸ a.2 + simpa using hy ▸ a.2 lemma getDual?_isSome_of_mem (a : c.1) (i : a.1) : (c.getDual? i).isSome := by rw [getDual?_isSome_iff] @@ -275,7 +276,7 @@ lemma getDual?_getDual?_get_not_none (i : Fin n) (h : (c.getDual? i).isSome) : /-- The smallest of the two positions in a contracted pair given a Wick contraction. -/ def fstFieldOfContract (c : WickContraction n) (a : c.1) : Fin n := (a.1.sort (· ≤ ·)).head (by - have hx : (Finset.sort (fun x1 x2 => x1 ≤ x2) a.1).length = a.1.card := Finset.length_sort .. + have hx : (a.1.sort (fun x1 x2 => x1 ≤ x2)).length = a.1.card := Finset.length_sort .. by_contra hn simp only [hn, List.length_nil, c.2.1 a.1 a.2, OfNat.zero_ne_ofNat] at hx) @@ -288,7 +289,7 @@ lemma fstFieldOfContract_congr {n m : ℕ} (h : n = m) (c : WickContraction n) ( /-- The largest of the two positions in a contracted pair given a Wick contraction. -/ def sndFieldOfContract (c : WickContraction n) (a : c.1) : Fin n := (a.1.sort (· ≤ ·)).tail.head (by - have hx : (Finset.sort (fun x1 x2 => x1 ≤ x2) a.1).length = a.1.card := Finset.length_sort .. + have hx : (a.1.sort (fun x1 x2 => x1 ≤ x2)).length = a.1.card := Finset.length_sort .. by_contra hn have hn := congrArg List.length hn simp [c.2.1] at hn) @@ -308,7 +309,7 @@ lemma finset_eq_fstFieldOfContract_sndFieldOfContract (c : WickContraction n) (a by_cases hxyle : x ≤ y · have ha : a.1.sort (· ≤ ·) = [x, y] := by rw [ha] - trans Finset.sort (· ≤ ·) (Finset.cons x {y} (by simp [hxy])) + trans Finset.sort (Finset.cons x {y} (by simp [hxy])) (· ≤ ·) · congr simp rw [Finset.sort_cons] @@ -320,7 +321,7 @@ lemma finset_eq_fstFieldOfContract_sndFieldOfContract (c : WickContraction n) (a simp [fstFieldOfContract, ha, sndFieldOfContract] · have ha : a.1.sort (· ≤ ·) = [y, x] := by rw [ha] - trans Finset.sort (· ≤ ·) (Finset.cons y {x} (by simp only [Finset.mem_singleton]; omega)) + trans Finset.sort (Finset.cons y {x} (by simp only [Finset.mem_singleton]; omega)) (· ≤ ·) · congr simp only [Finset.cons_eq_insert] rw [@Finset.pair_comm] @@ -333,7 +334,7 @@ lemma finset_eq_fstFieldOfContract_sndFieldOfContract (c : WickContraction n) (a simp only [fstFieldOfContract, ha, List.head_cons, sndFieldOfContract, List.tail_cons] rw [Finset.pair_comm] -lemma fstFieldOfContract_neq_sndFieldOfContract (c : WickContraction n) (a : c.1) : +lemma fstFieldOfContract_ne_sndFieldOfContract (c : WickContraction n) (a : c.1) : c.fstFieldOfContract a ≠ c.sndFieldOfContract a := by have h1 := c.2.1 a.1 a.2 have h2 := c.finset_eq_fstFieldOfContract_sndFieldOfContract a @@ -343,21 +344,21 @@ lemma fstFieldOfContract_neq_sndFieldOfContract (c : WickContraction n) (a : c.1 lemma fstFieldOfContract_le_sndFieldOfContract (c : WickContraction n) (a : c.1) : c.fstFieldOfContract a ≤ c.sndFieldOfContract a := by simp only [fstFieldOfContract, sndFieldOfContract, List.head_tail] - have h1 (n : ℕ) (l : List (Fin n)) (h : l ≠ []) (hl : l.Sorted (· ≤ ·)) : + have h1 (n : ℕ) (l : List (Fin n)) (h : l ≠ []) (hl : l.Pairwise (· ≤ ·)) : ∀ a ∈ l, l.head h ≤ a := by induction l with | nil => simp at h | cons i l ih => - simp only [List.sorted_cons] at hl + simp only [List.pairwise_cons] at hl simpa using hl.1 apply h1 - · exact Finset.sort_sorted .. + · exact Finset.pairwise_sort .. · exact List.getElem_mem .. lemma fstFieldOfContract_lt_sndFieldOfContract (c : WickContraction n) (a : c.1) : c.fstFieldOfContract a < c.sndFieldOfContract a := lt_of_le_of_ne (c.fstFieldOfContract_le_sndFieldOfContract a) - (c.fstFieldOfContract_neq_sndFieldOfContract a) + (c.fstFieldOfContract_ne_sndFieldOfContract a) @[simp] lemma fstFieldOfContract_mem (c : WickContraction n) (a : c.1) : @@ -448,15 +449,15 @@ def contractEquivFinTwo (c : WickContraction n) (a : c.1) : rcases hi with hi | hi · rw [hi] simp only [↓reduceIte, Fin.isValue] - exact Subtype.eq hi.symm + exact Subtype.ext hi.symm · rw [hi, if_neg] - · exact Subtype.eq hi.symm - · exact Ne.symm <| fstFieldOfContract_neq_sndFieldOfContract c a + · exact Subtype.ext hi.symm + · exact Ne.symm <| fstFieldOfContract_ne_sndFieldOfContract c a right_inv i := by fin_cases i · simp · simp only [Fin.isValue, Fin.mk_one, ite_eq_right_iff, zero_ne_one, imp_false] - exact Ne.symm <| fstFieldOfContract_neq_sndFieldOfContract c a + exact Ne.symm <| fstFieldOfContract_ne_sndFieldOfContract c a lemma prod_finset_eq_mul_fst_snd (c : WickContraction n) (a : c.1) (f : a.1 → M) [CommMonoid M] : @@ -511,7 +512,7 @@ def sigmaContractedEquiv : (a : c.1) × a ≃ {x : Fin n // (c.getDual? x).isSom exact ⟨i, fun x ↦ (x rfl).elim⟩ simp_all only [or_false, disjoint_self, Finset.bot_eq_empty, Finset.insert_ne_empty, not_false_eq_true] - exact Subtype.eq (id (Eq.symm hc)) + exact Subtype.ext (id (Eq.symm hc)) · simp right_inv := by intro x diff --git a/PhysLean/QFT/PerturbationTheory/WickContraction/Erase.lean b/PhysLean/QFT/PerturbationTheory/WickContraction/Erase.lean index 1921b7322..6e13181c4 100644 --- a/PhysLean/QFT/PerturbationTheory/WickContraction/Erase.lean +++ b/PhysLean/QFT/PerturbationTheory/WickContraction/Erase.lean @@ -37,7 +37,7 @@ lemma mem_erase_uncontracted_iff (c : WickContraction n.succ) (i : Fin n.succ) ( rw [getDual?_eq_some_iff_mem] simp only [uncontracted, getDual?, erase, Nat.succ_eq_add_one, Finset.mem_filter, Finset.mem_univ, Finset.map_insert, Fin.succAboveEmb_apply, Finset.map_singleton, true_and] - rw [Fin.find_eq_none_iff, Fin.find_eq_none_iff] + rw [Fin.find?_eq_none_iff, Fin.find?_eq_none_iff] apply Iff.intro · intro h by_cases hi : {i.succAbove j, i} ∈ c.1 @@ -46,7 +46,7 @@ lemma mem_erase_uncontracted_iff (c : WickContraction n.succ) (i : Fin n.succ) ( intro k by_cases hi' : k = i · subst hi' - exact hi + simpa using hi · simp only [← Fin.exists_succAbove_eq_iff] at hi' obtain ⟨z, hz⟩ := hi' subst hz @@ -55,7 +55,7 @@ lemma mem_erase_uncontracted_iff (c : WickContraction n.succ) (i : Fin n.succ) ( rcases h with h | h · exact h (i.succAbove k) · by_contra hn - have hc := c.2.2 _ h _ hn + have hc := c.2.2 _ h _ (by simpa using hn) simp only [Nat.succ_eq_add_one, Finset.disjoint_insert_right, Finset.mem_insert, Finset.mem_singleton, true_or, not_true_eq_false, Finset.disjoint_singleton_right, not_or, false_and, or_false] at hc diff --git a/PhysLean/QFT/PerturbationTheory/WickContraction/ExtractEquiv.lean b/PhysLean/QFT/PerturbationTheory/WickContraction/ExtractEquiv.lean index 2de3f43b3..1f2b7d6d3 100644 --- a/PhysLean/QFT/PerturbationTheory/WickContraction/ExtractEquiv.lean +++ b/PhysLean/QFT/PerturbationTheory/WickContraction/ExtractEquiv.lean @@ -70,7 +70,7 @@ instance fintype_zero : Fintype (WickContraction 0) where complete := by intro c simp only [Finset.mem_singleton] - apply Subtype.eq + apply Subtype.ext simp only [empty] ext a apply Iff.intro @@ -118,13 +118,8 @@ The proof of this result uses the fact that Lean is an executable programming la and can calculate all Wick contractions for a given `n`. -/ lemma mem_three (c : WickContraction 3) : c.1 ∈ ({∅, {{0, 1}}, {{0, 2}}, {{1, 2}}} : Finset (Finset (Finset (Fin 3)))) := by - fin_cases c <;> - simp only [Fin.isValue, Nat.succ_eq_add_one, Nat.reduceAdd, Function.Embedding.coeFn_mk, - Finset.mem_insert, Finset.mem_singleton] - · exact Or.inl rfl - · exact Or.inr (Or.inl rfl) - · exact Or.inr (Or.inr (Or.inl rfl)) - · exact Or.inr (Or.inr (Or.inr rfl)) + revert c + decide +kernel /-- For `n = 4` there are `10` possible Wick contractions including e.g. @@ -141,18 +136,7 @@ lemma mem_four (c : WickContraction 4) : c.1 ∈ ({∅, {{0, 1}}, {{0, 2}}, {{0, 3}}, {{1, 2}}, {{1, 3}}, {{2,3}}, {{0, 1}, {2, 3}}, {{0, 2}, {1, 3}}, {{0, 3}, {1, 2}}} : Finset (Finset (Finset (Fin 4)))) := by - fin_cases c <;> - simp only [Fin.isValue, Nat.succ_eq_add_one, Nat.reduceAdd, Function.Embedding.coeFn_mk, - Finset.mem_insert, Finset.mem_singleton] - · exact Or.inl rfl -- ∅ - · exact Or.inr (Or.inl rfl) -- {{0, 1}} - · exact Or.inr (Or.inr (Or.inl rfl)) -- {{0, 2}} - · exact Or.inr (Or.inr (Or.inr (Or.inl rfl))) -- {{0, 3}} - · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl rfl)))) -- {{1, 2}} - · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr rfl)))))))) - · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl rfl))))) -- {{1, 3}} - · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl rfl)))))))) - · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl rfl)))))) -- {{2, 3 }} - · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl rfl))))))) + revert c + decide +kernel end WickContraction diff --git a/PhysLean/QFT/PerturbationTheory/WickContraction/InsertAndContract.lean b/PhysLean/QFT/PerturbationTheory/WickContraction/InsertAndContract.lean index 6bdaf68c4..167088bc3 100644 --- a/PhysLean/QFT/PerturbationTheory/WickContraction/InsertAndContract.lean +++ b/PhysLean/QFT/PerturbationTheory/WickContraction/InsertAndContract.lean @@ -93,7 +93,7 @@ lemma insertAndContract_fstFieldOfContract_some_incl (φ : 𝓕.FieldOp) (φs : · simp [congrLift] · simp [congrLift] · rw [Fin.lt_def] at h ⊢ - simp_all only [Nat.succ_eq_add_one, Fin.val_fin_lt, not_lt, finCongr_apply, Fin.coe_cast] + simp_all only [Nat.succ_eq_add_one, Fin.val_fin_lt, not_lt, finCongr_apply, Fin.val_cast] have hi : i.succAbove j ≠ i := Fin.succAbove_ne i j omega @@ -208,7 +208,7 @@ lemma insertAndContract_sndFieldOfContract_some_incl (φ : 𝓕.FieldOp) (φs : · simp [congrLift] · simp [congrLift] · rw [Fin.lt_def] at h ⊢ - simp_all only [Nat.succ_eq_add_one, Fin.val_fin_lt, not_lt, finCongr_apply, Fin.coe_cast] + simp_all only [Nat.succ_eq_add_one, Fin.val_fin_lt, not_lt, finCongr_apply, Fin.val_cast] have hi : i.succAbove j ≠ i := Fin.succAbove_ne i j omega @@ -342,23 +342,23 @@ lemma stat_ofFinset_of_insertAndContractLiftFinset (φ : 𝓕.FieldOp) (φs : Li rw [get_eq_insertIdx_succAbove φ _ i, ← List.map_map, ← List.map_map] congr have h1 : (List.map (⇑(finCongr (insertIdx_length_fin φ φs i).symm)) - (List.map i.succAbove (Finset.sort (fun x1 x2 => x1 ≤ x2) a))).Sorted (· ≤ ·) := by + (List.map i.succAbove (a.sort (fun x1 x2 => x1 ≤ x2)))).Pairwise (· ≤ ·) := by simp only [Nat.succ_eq_add_one, List.map_map] refine - fin_list_sorted_monotone_sorted (Finset.sort (fun x1 x2 => x1 ≤ x2) a) ?hl + fin_list_sorted_monotone_sorted (a.sort (fun x1 x2 => x1 ≤ x2)) ?hl (⇑(finCongr (Eq.symm (insertIdx_length_fin φ φs i))) ∘ i.succAbove) ?hf - exact Finset.sort_sorted (fun x1 x2 => x1 ≤ x2) a + exact a.pairwise_sort (fun x1 x2 => x1 ≤ x2) refine StrictMono.comp (fun ⦃a b⦄ a => a) ?hf.hf exact Fin.strictMono_succAbove i have h2 : (List.map (⇑(finCongr (insertIdx_length_fin φ φs i).symm)) - (List.map i.succAbove (Finset.sort (fun x1 x2 => x1 ≤ x2) a))).Nodup := by + (List.map i.succAbove (a.sort (fun x1 x2 => x1 ≤ x2)))).Nodup := by simp only [Nat.succ_eq_add_one, List.map_map] refine List.Nodup.map ?_ ?_ apply (Equiv.comp_injective _ (finCongr _)).mpr exact Fin.succAbove_right_injective - exact Finset.sort_nodup (fun x1 x2 => x1 ≤ x2) a + exact a.sort_nodup (fun x1 x2 => x1 ≤ x2) have h3 : (List.map (⇑(finCongr (insertIdx_length_fin φ φs i).symm)) - (List.map i.succAbove (Finset.sort (fun x1 x2 => x1 ≤ x2) a))).toFinset + (List.map i.succAbove (a.sort (fun x1 x2 => x1 ≤ x2)))).toFinset = (insertAndContractLiftFinset φ i a) := by ext b simp only [Nat.succ_eq_add_one, List.map_map, List.mem_toFinset, List.mem_map, Finset.mem_sort, @@ -369,7 +369,7 @@ lemma stat_ofFinset_of_insertAndContractLiftFinset (φ : 𝓕.FieldOp) (φs : Li not_exists, not_and] intro x hx refine Fin.ne_of_val_ne ?h.inl.h - simp only [Fin.coe_cast, ne_eq] + simp only [Fin.val_cast, ne_eq] rw [Fin.val_eq_val] exact Fin.succAbove_ne i x · obtain ⟨k, hk⟩ := hk @@ -379,7 +379,7 @@ lemma stat_ofFinset_of_insertAndContractLiftFinset (φ : 𝓕.FieldOp) (φs : Li apply Iff.intro · intro h obtain ⟨x, hx⟩ := h - simp only [Fin.ext_iff, Fin.coe_cast] at hx + simp only [Fin.ext_iff, Fin.val_cast] at hx rw [Fin.val_eq_val] at hx rw [Function.Injective.eq_iff] at hx rw [← hx.2] diff --git a/PhysLean/QFT/PerturbationTheory/WickContraction/InsertAndContractNat.lean b/PhysLean/QFT/PerturbationTheory/WickContraction/InsertAndContractNat.lean index 6b8341d02..6cd4bfd13 100644 --- a/PhysLean/QFT/PerturbationTheory/WickContraction/InsertAndContractNat.lean +++ b/PhysLean/QFT/PerturbationTheory/WickContraction/InsertAndContractNat.lean @@ -389,7 +389,7 @@ lemma insertAndContractNat_some_getDual?_eq (c : WickContraction n) (i : Fin n.s rw [getDual?_eq_some_iff_mem] simp [insertAndContractNat] -lemma insertAndContractNat_some_getDual?_neq_none (c : WickContraction n) (i : Fin n.succ) +lemma insertAndContractNat_some_getDual?_ne_none (c : WickContraction n) (i : Fin n.succ) (j : c.uncontracted) (k : Fin n) (hkj : k ≠ j.1) : (insertAndContractNat c i (some j)).getDual? (i.succAbove k) = none ↔ c.getDual? k = none := by apply Iff.intro @@ -410,28 +410,28 @@ lemma insertAndContractNat_some_getDual?_neq_none (c : WickContraction n) (i : F simpa [uncontracted] using h simpa [uncontracted, -mem_uncontracted_insertAndContractNat_some_iff, ne_eq] using hk -lemma insertAndContractNat_some_getDual?_neq_isSome (c : WickContraction n) (i : Fin n.succ) +lemma insertAndContractNat_some_getDual?_ne_isSome (c : WickContraction n) (i : Fin n.succ) (j : c.uncontracted) (k : Fin n) (hkj : k ≠ j.1) : ((insertAndContractNat c i (some j)).getDual? (i.succAbove k)).isSome ↔ (c.getDual? k).isSome := by rw [← not_iff_not] - simp [hkj, insertAndContractNat_some_getDual?_neq_none] + simp [hkj, insertAndContractNat_some_getDual?_ne_none] -lemma insertAndContractNat_some_getDual?_neq_isSome_get (c : WickContraction n) (i : Fin n.succ) +lemma insertAndContractNat_some_getDual?_ne_isSome_get (c : WickContraction n) (i : Fin n.succ) (j : c.uncontracted) (k : Fin n) (hkj : k ≠ j.1) (h : ((insertAndContractNat c i (some j)).getDual? (i.succAbove k)).isSome) : ((insertAndContractNat c i (some j)).getDual? (i.succAbove k)).get h = i.succAbove ((c.getDual? k).get - (by simpa [hkj, insertAndContractNat_some_getDual?_neq_isSome] using h)) := by + (by simpa [hkj, insertAndContractNat_some_getDual?_ne_isSome] using h)) := by have h1 : ((insertAndContractNat c i (some j)).getDual? (i.succAbove k)) = some (i.succAbove ((c.getDual? k).get - (by simpa [hkj, insertAndContractNat_some_getDual?_neq_isSome] using h))) := by + (by simpa [hkj, insertAndContractNat_some_getDual?_ne_isSome] using h))) := by rw [getDual?_eq_some_iff_mem] simp only [Nat.succ_eq_add_one, insertAndContractNat, Finset.le_eq_subset, Finset.mem_insert, Finset.mem_map, RelEmbedding.coe_toEmbedding] apply Or.inr use { k, ((c.getDual? k).get - (by simpa [hkj, insertAndContractNat_some_getDual?_neq_isSome] using h))} + (by simpa [hkj, insertAndContractNat_some_getDual?_ne_isSome] using h))} simp only [self_getDual?_get_mem, true_and] rw [Finset.mapEmbedding_apply] simp @@ -445,17 +445,17 @@ lemma insertAndContractNat_some_getDual?_of_neq (c : WickContraction n) (i : Fin by_cases h : (c.getDual? k).isSome · have h1 : (c.insertAndContractNat i (some j)).getDual? (i.succAbove k) = some (i.succAbove ((c.getDual? k).get h)) := by - rw [← insertAndContractNat_some_getDual?_neq_isSome_get c i j k hkj] + rw [← insertAndContractNat_some_getDual?_ne_isSome_get c i j k hkj] refine Eq.symm (Option.some_get ?_) all_goals - simpa [hkj, insertAndContractNat_some_getDual?_neq_isSome] using h + simpa [hkj, insertAndContractNat_some_getDual?_ne_isSome] using h rw [h1] have h2 :(c.getDual? k) = some ((c.getDual? k).get h) := by simp conv_rhs => rw [h2] rw [@Option.map_coe'] · simp only [Bool.not_eq_true, Option.isSome_eq_false_iff, Option.isNone_iff_eq_none] at h simp only [Nat.succ_eq_add_one, h, Option.map_none] - simp only [ne_eq, hkj, not_false_eq_true, insertAndContractNat_some_getDual?_neq_none] + simp only [ne_eq, hkj, not_false_eq_true, insertAndContractNat_some_getDual?_ne_none] exact h /-! @@ -466,7 +466,7 @@ lemma insertAndContractNat_some_getDual?_of_neq (c : WickContraction n) (i : Fin @[simp] lemma insertAndContractNat_erase (c : WickContraction n) (i : Fin n.succ) (j : Option c.uncontracted) : erase (insertAndContractNat c i j) i = c := by - refine Subtype.eq ?_ + refine Subtype.ext ?_ simp only [erase, Nat.succ_eq_add_one, insertAndContractNat, Finset.le_eq_subset] conv_rhs => rw [c.eq_filter_mem_self] refine Finset.filter_inj'.mpr ?_ @@ -533,7 +533,7 @@ lemma erase_insert (c : WickContraction n.succ) (i : Fin n.succ) : insertAndContractNat (erase c i) i (getDualErase c i) = c := by match n with | 0 => - apply Subtype.eq + apply Subtype.ext simp only [Nat.succ_eq_add_one, Nat.reduceAdd, insertAndContractNat, getDualErase, Finset.le_eq_subset] ext a @@ -556,7 +556,7 @@ lemma erase_insert (c : WickContraction n.succ) (i : Fin n.succ) : } · simp_all only | Nat.succ n => - apply Subtype.eq + apply Subtype.ext by_cases hi : (c.getDual? i).isSome · rw [insertAndContractNat_of_isSome] simp only [Nat.succ_eq_add_one, getDualErase, hi, ↓reduceDIte, Option.get_some, @@ -585,7 +585,7 @@ lemma erase_insert (c : WickContraction n.succ) (i : Fin n.succ) : obtain ⟨left, right⟩ := ha' subst right rfl - simp only [Nat.succ_eq_add_one, ne_eq, self_neq_getDual?_get, not_false_eq_true] + simp only [Nat.succ_eq_add_one, ne_eq, self_ne_getDual?_get, not_false_eq_true] exact (getDualErase_isSome_iff_getDual?_isSome c i).mpr hi · simp only [Nat.succ_eq_add_one, insertAndContractNat, getDualErase, hi, Bool.false_eq_true, ↓reduceDIte, Finset.le_eq_subset] @@ -629,7 +629,7 @@ lemma insertLift_injective {c : WickContraction n} (i : Fin n.succ) (j : Option Function.Injective (insertLift i j) := by intro a b hab simp only [Nat.succ_eq_add_one, insertLift, Subtype.mk.injEq, Finset.map_inj] at hab - exact Subtype.eq hab + exact Subtype.ext hab lemma insertLift_none_surjective {c : WickContraction n} (i : Fin n.succ) : Function.Surjective (c.insertLift i none) := by @@ -639,7 +639,7 @@ lemma insertLift_none_surjective {c : WickContraction n} (i : Fin n.succ) : RelEmbedding.coe_toEmbedding] at ha obtain ⟨a', ha', ha''⟩ := ha use ⟨a', ha'⟩ - exact Subtype.eq ha'' + exact Subtype.ext ha'' lemma insertLift_none_bijective {c : WickContraction n} (i : Fin n.succ) : Function.Bijective (c.insertLift i none) := by @@ -728,11 +728,11 @@ lemma insertLiftSome_surjective {c : WickContraction n} (i : Fin n.succ) (j : c. Finset.mem_map, RelEmbedding.coe_toEmbedding] at ha rcases ha with ha | ha · use Sum.inl () - exact Subtype.eq ha.symm + exact Subtype.ext ha.symm · obtain ⟨a', ha', ha''⟩ := ha use Sum.inr ⟨a', ha'⟩ simp only [Nat.succ_eq_add_one, insertLiftSome, insertLift] - exact Subtype.eq ha'' + exact Subtype.ext ha'' lemma insertLiftSome_bijective {c : WickContraction n} (i : Fin n.succ) (j : c.uncontracted) : Function.Bijective (insertLiftSome i j) := @@ -749,13 +749,13 @@ lemma insertAndContractNat_injective (i : Fin n.succ) : intro c1 c2 hc1c2 rw [Subtype.ext_iff] at hc1c2 simp [insertAndContractNat] at hc1c2 - exact Subtype.eq hc1c2 + exact Subtype.ext hc1c2 lemma insertAndContractNat_surjective_on_nodual (i : Fin n.succ) (c : WickContraction n.succ) (hc : c.getDual? i = none) : ∃ c', insertAndContractNat c' i none = c := by use c.erase i - apply Subtype.eq + apply Subtype.ext ext a simp [insertAndContractNat, erase] apply Iff.intro diff --git a/PhysLean/QFT/PerturbationTheory/WickContraction/Involutions.lean b/PhysLean/QFT/PerturbationTheory/WickContraction/Involutions.lean index 340da1019..55f6a29b5 100644 --- a/PhysLean/QFT/PerturbationTheory/WickContraction/Involutions.lean +++ b/PhysLean/QFT/PerturbationTheory/WickContraction/Involutions.lean @@ -114,7 +114,7 @@ lemma fromInvolution_getDual?_get (f : {f : Fin n → Fin n // Function.Involuti exact Option.get_of_mem h h1 lemma toInvolution_fromInvolution : fromInvolution c.toInvolution = c := by - apply Subtype.eq + apply Subtype.ext simp only [fromInvolution, toInvolution] ext a simp only [Finset.mem_filter, Finset.mem_univ, true_and] @@ -136,7 +136,7 @@ lemma toInvolution_fromInvolution : fromInvolution c.toInvolution = c := by lemma fromInvolution_toInvolution (f : {f : Fin n → Fin n // Function.Involutive f}) : (fromInvolution f).toInvolution = f := by - apply Subtype.eq + apply Subtype.ext funext i simp only [toInvolution] split diff --git a/PhysLean/QFT/PerturbationTheory/WickContraction/Join.lean b/PhysLean/QFT/PerturbationTheory/WickContraction/Join.lean index e3e49f012..c2a5ac08b 100644 --- a/PhysLean/QFT/PerturbationTheory/WickContraction/Join.lean +++ b/PhysLean/QFT/PerturbationTheory/WickContraction/Join.lean @@ -81,7 +81,7 @@ lemma jointLiftLeft_injective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction intro a b h simp only [joinLiftLeft] at h rw [Subtype.mk_eq_mk] at h - refine Subtype.eq h + refine Subtype.ext h /-- Given a contracting pair within `φsucΛ` the corresponding contracting pair within `(join φsΛ φsucΛ)`. -/ @@ -102,7 +102,7 @@ lemma joinLiftRight_injective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction simp only [joinLiftRight] at h rw [Subtype.mk_eq_mk] at h simp only [Finset.map_inj] at h - refine Subtype.eq h + refine Subtype.ext h lemma jointLiftLeft_disjoint_joinLiftRight {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} (a : φsΛ.1) (b : φsucΛ.1) : @@ -112,7 +112,7 @@ lemma jointLiftLeft_disjoint_joinLiftRight {φs : List 𝓕.FieldOp} {φsΛ : Wi apply uncontractedListEmd_finset_disjoint_left exact a.2 -lemma jointLiftLeft_neq_joinLiftRight {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} +lemma jointLiftLeft_ne_joinLiftRight {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} (a : φsΛ.1) (b : φsucΛ.1) : joinLiftLeft a ≠ joinLiftRight b := by by_contra hn @@ -143,11 +143,11 @@ lemma joinLift_injective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs. exact joinLiftRight_injective h | Sum.inl a, Sum.inr b => simp only [joinLift] at h - have h1 := jointLiftLeft_neq_joinLiftRight a b + have h1 := jointLiftLeft_ne_joinLiftRight a b simp_all | Sum.inr a, Sum.inl b => simp only [joinLift] at h - have h1 := jointLiftLeft_neq_joinLiftRight b a + have h1 := jointLiftLeft_ne_joinLiftRight b a simp_all lemma joinLift_surjective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} @@ -162,7 +162,7 @@ lemma joinLift_surjective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs · rw [Finset.mapEmbedding_apply] at ha3 use Sum.inr ⟨a2, ha3.1⟩ simp only [joinLift, joinLiftRight] - refine Subtype.eq ?_ + refine Subtype.ext ?_ exact ha3.2 lemma joinLift_bijective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} @@ -614,6 +614,7 @@ lemma exists_contraction_pair_of_card_ge_zero {φs : List 𝓕.FieldOp} ∃ a, a ∈ φsΛ.1 := by simpa using h +set_option maxHeartbeats 400000 in lemma exists_join_singleton_of_card_ge_zero {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) (h : 0 < φsΛ.1.card) (hc : φsΛ.GradingCompliant) : ∃ (i j : Fin φs.length) (h : i < j) (φsucΛ : WickContraction [singleton h]ᵘᶜ.length), diff --git a/PhysLean/QFT/PerturbationTheory/WickContraction/Sign/InsertNone.lean b/PhysLean/QFT/PerturbationTheory/WickContraction/Sign/InsertNone.lean index 88261f8f7..f0776971e 100644 --- a/PhysLean/QFT/PerturbationTheory/WickContraction/Sign/InsertNone.lean +++ b/PhysLean/QFT/PerturbationTheory/WickContraction/Sign/InsertNone.lean @@ -52,7 +52,7 @@ lemma signFinset_insertAndContract_none (φ : 𝓕.FieldOp) (φs : List 𝓕.Fie insertAndContractLiftFinset φ i (φsΛ.signFinset i1 i2) := by split · simp only [Nat.succ_eq_add_one, finCongr_apply, Finset.mem_insert, Fin.ext_iff, - Fin.coe_cast, or_iff_right_iff_imp] + Fin.val_cast, or_iff_right_iff_imp] intro h have h1 : i.succAbove k ≠ i := by exact Fin.succAbove_ne i k @@ -64,7 +64,7 @@ lemma signFinset_insertAndContract_none (φ : 𝓕.FieldOp) (φs : List 𝓕.Fie insertAndContract_none_succAbove_getDual?_eq_none_iff, true_and, insertAndContract_none_succAbove_getDual?_isSome_iff, insertAndContract_none_getDual?_get_eq] rw [Fin.lt_def, Fin.lt_def, Fin.lt_def, Fin.lt_def] - simp only [Fin.coe_cast, Fin.val_fin_lt] + simp only [Fin.val_cast, Fin.val_fin_lt] rw [Fin.succAbove_lt_succAbove_iff, Fin.succAbove_lt_succAbove_iff] simp only [and_congr_right_iff] intro h1 h2 @@ -72,7 +72,7 @@ lemma signFinset_insertAndContract_none (φ : 𝓕.FieldOp) (φs : List 𝓕.Fie rhs enter [h] rw [Fin.lt_def] - simp only [Fin.coe_cast, Fin.val_fin_lt] + simp only [Fin.val_cast, Fin.val_fin_lt] rw [Fin.succAbove_lt_succAbove_iff] /-- Given a Wick contraction `φsΛ` associated with a list of states `φs` @@ -97,12 +97,12 @@ lemma sign_insert_none_eq_signInsertNone_mul_sign (φ : 𝓕.FieldOp) (φs : Lis congr funext a simp only [instCommGroup, Nat.succ_eq_add_one, insertAndContract_sndFieldOfContract, - finCongr_apply, Fin.getElem_fin, Fin.coe_cast, insertIdx_getElem_fin, + finCongr_apply, Fin.getElem_fin, Fin.val_cast, insertIdx_getElem_fin, insertAndContract_fstFieldOfContract, ite_mul, one_mul] rw [signFinset_insertAndContract_none] split · rw [ofFinset_insert] - simp only [instCommGroup, Nat.succ_eq_add_one, finCongr_apply, Fin.getElem_fin, Fin.coe_cast, + simp only [instCommGroup, Nat.succ_eq_add_one, finCongr_apply, Fin.getElem_fin, Fin.val_cast, List.getElem_insertIdx_self, map_mul] rw [stat_ofFinset_of_insertAndContractLiftFinset] simp only [exchangeSign_symm, instCommGroup.eq_1] diff --git a/PhysLean/QFT/PerturbationTheory/WickContraction/Sign/InsertSome.lean b/PhysLean/QFT/PerturbationTheory/WickContraction/Sign/InsertSome.lean index edaedd6b1..4523815b7 100644 --- a/PhysLean/QFT/PerturbationTheory/WickContraction/Sign/InsertSome.lean +++ b/PhysLean/QFT/PerturbationTheory/WickContraction/Sign/InsertSome.lean @@ -106,7 +106,7 @@ lemma signFinset_insertAndContract_some (φ : 𝓕.FieldOp) (φs : List 𝓕.Fie insertAndContract_some_getDual?_self_eq, reduceCtorEq, Option.isSome_some, Option.get_some, forall_const, false_or, true_and] rw [Fin.lt_def, Fin.lt_def, Fin.lt_def, Fin.lt_def] - simp only [Fin.coe_cast, Fin.val_fin_lt, and_congr_right_iff] + simp only [Fin.val_cast, Fin.val_fin_lt, and_congr_right_iff] intro h1 h2 exact Fin.succAbove_lt_succAbove_iff · obtain ⟨k, hk⟩ := hk @@ -117,16 +117,16 @@ lemma signFinset_insertAndContract_some (φ : 𝓕.FieldOp) (φs : List 𝓕.Fie Finset.mem_univ, insertAndContract_some_getDual?_some_eq, reduceCtorEq, Option.isSome_some, Option.get_some, forall_const, false_or, true_and, not_lt] rw [Fin.lt_def, Fin.lt_def] - simp only [Fin.coe_cast, Fin.val_fin_lt, Nat.succ_eq_add_one, finCongr_apply, not_lt] + simp only [Fin.val_cast, Fin.val_fin_lt, Nat.succ_eq_add_one, finCongr_apply, not_lt] conv_lhs => enter [2, 2] rw [Fin.lt_def] - simp only [Fin.coe_cast, Fin.val_fin_lt] + simp only [Fin.val_cast, Fin.val_fin_lt] split · rename_i h simp_all only [and_true, Finset.mem_insert] rw [succAbove_mem_insertAndContractLiftFinset] - simp only [Fin.ext_iff, Fin.coe_cast] + simp only [Fin.ext_iff, Fin.val_cast] have h1 : ¬ (i.succAbove ↑j) = i := Fin.succAbove_ne i ↑j simp only [Fin.val_eq_val, h1, signFinset, Finset.mem_filter, Finset.mem_univ, true_and, false_or] @@ -135,7 +135,7 @@ lemma signFinset_insertAndContract_some (φ : 𝓕.FieldOp) (φs : List 𝓕.Fie intro h1 h2 apply Or.inl have hj:= j.2 - simpa [uncontracted, -Finset.coe_mem] using hj + simpa [uncontracted, -SetLike.coe_mem] using hj · rename_i h simp only [not_and, not_lt] at h rw [Fin.succAbove_lt_succAbove_iff, Fin.succAbove_lt_succAbove_iff] @@ -169,7 +169,7 @@ lemma signFinset_insertAndContract_some (φ : 𝓕.FieldOp) (φs : List 𝓕.Fie split · simp only [Nat.succ_eq_add_one, finCongr_apply, Finset.mem_insert, or_iff_right_iff_imp] intro h - simp only [Fin.ext_iff, Fin.coe_cast] at h + simp only [Fin.ext_iff, Fin.val_cast] at h simp only [Fin.val_eq_val] at h have hn : ¬ i.succAbove k = i := Fin.succAbove_ne i k exact False.elim (hn h) @@ -177,7 +177,7 @@ lemma signFinset_insertAndContract_some (φ : 𝓕.FieldOp) (φs : List 𝓕.Fie simp only [Nat.succ_eq_add_one, finCongr_apply, Finset.mem_erase, ne_eq, and_iff_right_iff_imp] intro h - simp only [Fin.ext_iff, Fin.coe_cast] + simp only [Fin.ext_iff, Fin.val_cast] simp only [Fin.val_eq_val] rw [Function.Injective.eq_iff] exact hkj @@ -188,7 +188,7 @@ lemma signFinset_insertAndContract_some (φ : 𝓕.FieldOp) (φs : List 𝓕.Fie simp only [Nat.succ_eq_add_one, signFinset, finCongr_apply, Finset.mem_filter, Finset.mem_univ, true_and] rw [Fin.lt_def, Fin.lt_def, Fin.lt_def, Fin.lt_def] - simp only [Fin.coe_cast, Fin.val_fin_lt] + simp only [Fin.val_cast, Fin.val_fin_lt] rw [Fin.succAbove_lt_succAbove_iff, Fin.succAbove_lt_succAbove_iff] simp only [and_congr_right_iff] intro h1 h2 @@ -198,7 +198,7 @@ lemma signFinset_insertAndContract_some (φ : 𝓕.FieldOp) (φs : List 𝓕.Fie rhs enter [h] rw [Fin.lt_def] - simp only [Fin.coe_cast, Option.get_map, Function.comp_apply, Fin.val_fin_lt] + simp only [Fin.val_cast, Option.get_map, Function.comp_apply, Fin.val_fin_lt] rw [Fin.succAbove_lt_succAbove_iff] /-- @@ -251,14 +251,14 @@ lemma sign_insert_some (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ : Wi congr funext a simp only [instCommGroup, Nat.succ_eq_add_one, insertAndContract_sndFieldOfContract, - finCongr_apply, Fin.getElem_fin, Fin.coe_cast, insertIdx_getElem_fin, + finCongr_apply, Fin.getElem_fin, Fin.val_cast, insertIdx_getElem_fin, insertAndContract_fstFieldOfContract, not_lt, ite_mul, one_mul] erw [signFinset_insertAndContract_some] split · rename_i h simp only [Nat.succ_eq_add_one, finCongr_apply] rw [ofFinset_insert] - simp only [instCommGroup, Fin.getElem_fin, Fin.coe_cast, List.getElem_insertIdx_self, map_mul] + simp only [instCommGroup, Fin.getElem_fin, Fin.val_cast, List.getElem_insertIdx_self, map_mul] rw [stat_ofFinset_of_insertAndContractLiftFinset] simp only [exchangeSign_symm, instCommGroup.eq_1] simp @@ -268,7 +268,7 @@ lemma sign_insert_some (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ : Wi simp only [Nat.succ_eq_add_one, finCongr_apply, h1, true_and] rw [if_pos] rw [ofFinset_erase] - simp only [instCommGroup, Fin.getElem_fin, Fin.coe_cast, insertIdx_getElem_fin, map_mul] + simp only [instCommGroup, Fin.getElem_fin, Fin.val_cast, insertIdx_getElem_fin, map_mul] rw [stat_ofFinset_of_insertAndContractLiftFinset] simp only [exchangeSign_symm, instCommGroup.eq_1] · rw [succAbove_mem_insertAndContractLiftFinset] @@ -276,7 +276,7 @@ lemma sign_insert_some (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) (φsΛ : Wi simp_all only [Nat.succ_eq_add_one, and_true, false_and, not_false_eq_true, not_lt, true_and] apply Or.inl - simpa [uncontracted, -Finset.coe_mem] using j.2 + simpa [uncontracted, -SetLike.coe_mem] using j.2 · simp_all · rename_i h1 rw [if_neg] @@ -454,7 +454,7 @@ lemma stat_signFinset_insert_some_self_fst reduceCtorEq, Option.isSome_some, Option.get_some, forall_const, false_or, and_self, false_and, false_iff, not_exists, not_and, and_imp] intro x hi hx h - simp only [Fin.ext_iff, Fin.coe_cast] + simp only [Fin.ext_iff, Fin.val_cast] simp only [Fin.val_eq_val] exact Fin.succAbove_ne i x · obtain ⟨x, hx⟩ := hx @@ -465,7 +465,7 @@ lemma stat_signFinset_insert_some_self_fst reduceCtorEq, Option.isSome_some, Option.get_some, imp_false, not_true_eq_false, or_self, and_self, and_false, false_iff, not_exists, not_and, and_imp] intro x hi hx h0 - simp only [Fin.ext_iff, Fin.coe_cast] + simp only [Fin.ext_iff, Fin.val_cast] simp only [Fin.val_eq_val] rw [Function.Injective.eq_iff] omega @@ -474,7 +474,7 @@ lemma stat_signFinset_insert_some_self_fst insertAndContract_some_succAbove_getDual?_eq_option, Option.map_eq_none_iff, Option.isSome_map] rw [Fin.lt_def, Fin.lt_def] - simp only [Fin.coe_cast, Fin.val_fin_lt] + simp only [Fin.val_cast, Fin.val_fin_lt] apply Iff.intro · intro h use x @@ -490,7 +490,7 @@ lemma stat_signFinset_insert_some_self_fst simpa using h2 · intro h obtain ⟨y, hy1, hy2⟩ := h - simp only [Fin.ext_iff, Fin.coe_cast] at hy2 + simp only [Fin.ext_iff, Fin.val_cast] at hy2 simp only [Fin.val_eq_val] at hy2 rw [Function.Injective.eq_iff (Fin.succAbove_right_injective)] at hy2 subst hy2 @@ -530,7 +530,7 @@ lemma stat_signFinset_insert_some_self_snd (φ : 𝓕.FieldOp) (φs : List 𝓕. reduceCtorEq, Option.isSome_some, Option.get_some, imp_false, not_true_eq_false, or_self, and_self, and_false, false_iff, not_exists, not_and, and_imp] intro x hi hx h - simp only [Fin.ext_iff, Fin.coe_cast] + simp only [Fin.ext_iff, Fin.val_cast] simp only [Fin.val_eq_val] exact Fin.succAbove_ne i x · obtain ⟨x, hx⟩ := hx @@ -541,7 +541,7 @@ lemma stat_signFinset_insert_some_self_snd (φ : 𝓕.FieldOp) (φs : List 𝓕. reduceCtorEq, Option.isSome_some, Option.get_some, forall_const, false_or, and_self, false_and, false_iff, not_exists, not_and, and_imp] intro x hi hx h0 - simp only [Fin.ext_iff, Fin.coe_cast] + simp only [Fin.ext_iff, Fin.val_cast] simp only [Fin.val_eq_val] rw [Function.Injective.eq_iff] omega @@ -550,7 +550,7 @@ lemma stat_signFinset_insert_some_self_snd (φ : 𝓕.FieldOp) (φs : List 𝓕. insertAndContract_some_succAbove_getDual?_eq_option, Option.map_eq_none_iff, Option.isSome_map] rw [Fin.lt_def, Fin.lt_def] - simp only [Fin.coe_cast, Fin.val_fin_lt] + simp only [Fin.val_cast, Fin.val_fin_lt] apply Iff.intro · intro h use x @@ -564,11 +564,11 @@ lemma stat_signFinset_insert_some_self_snd (φ : 𝓕.FieldOp) (φs : List 𝓕. intro h have h2 := h2 h rw [Fin.lt_def] at h2 - simp only [Fin.coe_cast, Fin.val_fin_lt] at h2 + simp only [Fin.val_cast, Fin.val_fin_lt] at h2 exact Fin.succAbove_lt_succAbove_iff.mp h2 · intro h obtain ⟨y, hy1, hy2⟩ := h - simp only [Fin.ext_iff, Fin.coe_cast] at hy2 + simp only [Fin.ext_iff, Fin.val_cast] at hy2 simp only [Fin.val_eq_val] at hy2 rw [Function.Injective.eq_iff (Fin.succAbove_right_injective)] at hy2 subst hy2 @@ -582,8 +582,8 @@ lemma stat_signFinset_insert_some_self_snd (φ : 𝓕.FieldOp) (φs : List 𝓕. · apply Or.inr intro h have hy2 := hy2 h - simp only [Fin.lt_def, Fin.coe_cast, gt_iff_lt] - simp only [Option.get_map, Function.comp_apply, Fin.coe_cast, Fin.val_fin_lt] + simp only [Fin.lt_def, Fin.val_cast, gt_iff_lt] + simp only [Option.get_map, Function.comp_apply, Fin.val_cast, Fin.val_fin_lt] exact Fin.succAbove_lt_succAbove_iff.mpr hy2 lemma signInsertSomeCoef_eq_finset (φ : 𝓕.FieldOp) (φs : List 𝓕.FieldOp) diff --git a/PhysLean/QFT/PerturbationTheory/WickContraction/Sign/Join.lean b/PhysLean/QFT/PerturbationTheory/WickContraction/Sign/Join.lean index 0369ccaa4..e77854355 100644 --- a/PhysLean/QFT/PerturbationTheory/WickContraction/Sign/Join.lean +++ b/PhysLean/QFT/PerturbationTheory/WickContraction/Sign/Join.lean @@ -231,10 +231,10 @@ lemma joinSignRightExtra_eq_i_j_finset_eq_if {φs : List 𝓕.FieldOp} rw [h11] ext x simp only [Finset.mem_filter, Finset.mem_insert, Finset.mem_singleton, Finset.mem_union] - have hjneqfst := singleton_uncontractedEmd_neq_right h (φsucΛ.fstFieldOfContract a) - have hjneqsnd := singleton_uncontractedEmd_neq_right h (φsucΛ.sndFieldOfContract a) - have hineqfst := singleton_uncontractedEmd_neq_left h (φsucΛ.fstFieldOfContract a) - have hineqsnd := singleton_uncontractedEmd_neq_left h (φsucΛ.sndFieldOfContract a) + have hjneqfst := singleton_uncontractedEmd_ne_right h (φsucΛ.fstFieldOfContract a) + have hjneqsnd := singleton_uncontractedEmd_ne_right h (φsucΛ.sndFieldOfContract a) + have hineqfst := singleton_uncontractedEmd_ne_left h (φsucΛ.fstFieldOfContract a) + have hineqsnd := singleton_uncontractedEmd_ne_left h (φsucΛ.sndFieldOfContract a) by_cases hj1 : ¬ uncontractedListEmd (φsucΛ.fstFieldOfContract a) < j · simp only [hj1, false_and, ↓reduceIte, Finset.notMem_empty, false_or] have hi1 : ¬ uncontractedListEmd (φsucΛ.fstFieldOfContract a) < i := by omega @@ -332,7 +332,7 @@ lemma joinSignLeftExtra_eq_joinSignRightExtra {φs : List 𝓕.FieldOp} rw [joinSignRightExtra_eq_i_j_finset_eq_if] congr funext a - have hjneqsnd := singleton_uncontractedEmd_neq_right h (φsucΛ.sndFieldOfContract a) + have hjneqsnd := singleton_uncontractedEmd_ne_right h (φsucΛ.sndFieldOfContract a) have hl : uncontractedListEmd (φsucΛ.fstFieldOfContract a) < uncontractedListEmd (φsucΛ.sndFieldOfContract a) := by apply uncontractedListEmd_strictMono diff --git a/PhysLean/QFT/PerturbationTheory/WickContraction/Singleton.lean b/PhysLean/QFT/PerturbationTheory/WickContraction/Singleton.lean index 10838de1e..89678698f 100644 --- a/PhysLean/QFT/PerturbationTheory/WickContraction/Singleton.lean +++ b/PhysLean/QFT/PerturbationTheory/WickContraction/Singleton.lean @@ -82,7 +82,7 @@ lemma singleton_getDual?_eq_none_iff_neq {i j : Fin n} (hij : i < j) (a : Fin n) simp only [singleton, Finset.mem_singleton, forall_eq, Finset.mem_insert, not_or, ne_eq] omega -lemma singleton_uncontractedEmd_neq_left {φs : List 𝓕.FieldOp} {i j : Fin φs.length} (hij : i < j) +lemma singleton_uncontractedEmd_ne_left {φs : List 𝓕.FieldOp} {i j : Fin φs.length} (hij : i < j) (a : Fin [singleton hij]ᵘᶜ.length) : (singleton hij).uncontractedListEmd a ≠ i := by by_contra hn @@ -93,7 +93,7 @@ lemma singleton_uncontractedEmd_neq_left {φs : List 𝓕.FieldOp} {i j : Fin φ simp [singleton] simp_all -lemma singleton_uncontractedEmd_neq_right {φs : List 𝓕.FieldOp} {i j : Fin φs.length} (hij : i < j) +lemma singleton_uncontractedEmd_ne_right {φs : List 𝓕.FieldOp} {i j : Fin φs.length} (hij : i < j) (a : Fin [singleton hij]ᵘᶜ.length) : (singleton hij).uncontractedListEmd a ≠ j := by by_contra hn diff --git a/PhysLean/QFT/PerturbationTheory/WickContraction/StaticContract.lean b/PhysLean/QFT/PerturbationTheory/WickContraction/StaticContract.lean index febe692f7..22b281949 100644 --- a/PhysLean/QFT/PerturbationTheory/WickContraction/StaticContract.lean +++ b/PhysLean/QFT/PerturbationTheory/WickContraction/StaticContract.lean @@ -87,7 +87,7 @@ lemma staticContract_insert_some_of_lt rw [staticContract_insert_some] simp only [Nat.succ_eq_add_one, Fin.getElem_fin, ite_mul, instCommGroup.eq_1, contractStateAtIndex, uncontractedFieldOpEquiv, Equiv.optionCongr_apply, - Equiv.coe_trans, Option.map_some, Function.comp_apply, finCongr_apply, Fin.coe_cast, + Equiv.coe_trans, Option.map_some, Function.comp_apply, finCongr_apply, Fin.val_cast, List.getElem_map, uncontractedList_getElem_uncontractedIndexEquiv_symm, List.get_eq_getElem, Algebra.smul_mul_assoc, uncontractedListGet] · simp only [hik, ↓reduceIte, MulMemClass.coe_mul] @@ -116,7 +116,7 @@ lemma staticContract_of_not_gradingCompliant (φs : List 𝓕.FieldOp) obtain ⟨ha, ha2⟩ := ha apply Finset.prod_eq_zero (i := ⟨a, ha⟩) simp only [Finset.univ_eq_attach, Finset.mem_attach] - apply Subtype.eq + apply Subtype.ext simp only [List.get_eq_getElem, ZeroMemClass.coe_zero] rw [superCommute_anPart_ofFieldOpF_diff_grade_zero] simp [ha2] diff --git a/PhysLean/QFT/PerturbationTheory/WickContraction/TimeCond.lean b/PhysLean/QFT/PerturbationTheory/WickContraction/TimeCond.lean index d00f80be6..2bbc20dc0 100644 --- a/PhysLean/QFT/PerturbationTheory/WickContraction/TimeCond.lean +++ b/PhysLean/QFT/PerturbationTheory/WickContraction/TimeCond.lean @@ -205,6 +205,7 @@ lemma timeOrder_timeContract_mul_of_eqTimeOnly_left {φs : List 𝓕.FieldOp} rw [timeOrder_timeContract_mul_of_eqTimeOnly_mid φsΛ hl] simp +set_option maxHeartbeats 400000 in lemma exists_join_singleton_of_not_eqTimeOnly {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) (h1 : ¬ φsΛ.EqTimeOnly) : ∃ (i j : Fin φs.length) (h : i < j) (φsucΛ : WickContraction [singleton h]ᵘᶜ.length), @@ -238,7 +239,7 @@ lemma timeOrder_timeContract_of_not_eqTimeOnly {φs : List 𝓕.FieldOp} rw [singleton_timeContract] simp only [Fin.getElem_fin, MulMemClass.coe_mul] rw [timeOrder_timeOrder_left] - rw [timeOrder_timeContract_neq_time] + rw [timeOrder_timeContract_ne_time] simp only [zero_mul, map_zero] simp_all only [Fin.getElem_fin, not_and] intro h @@ -254,7 +255,7 @@ lemma timeOrder_staticContract_of_not_mem {φs : List 𝓕.FieldOp} (φsΛ : Wic simp only [MulMemClass.coe_mul] rw [singleton_staticContract] rw [timeOrder_timeOrder_left] - rw [timeOrder_superCommute_anPart_ofFieldOp_neq_time] + rw [timeOrder_superCommute_anPart_ofFieldOp_ne_time] simp only [zero_mul, map_zero] intro h simp_all @@ -446,7 +447,7 @@ lemma subContraction_eqTimeContractSet_not_empty_of_haveEqTime {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) (h : HaveEqTime φsΛ) : φsΛ.subContraction (eqTimeContractSet φsΛ) (eqTimeContractSet_subset φsΛ) ≠ empty := by simp only [ne_eq] - erw [Subtype.eq_iff] + erw [Subtype.ext_iff] simp only [subContraction, empty] rw [Finset.eq_empty_iff_forall_notMem] simp only [HaveEqTime, Fin.getElem_fin, exists_and_left, exists_prop] at h @@ -495,12 +496,12 @@ lemma hasEqTimeEquiv_ext_sigma {φs : List 𝓕.FieldOp} {x1 x2 : Σ (φsΛ : {φsΛ : WickContraction φs.length // φsΛ.EqTimeOnly ∧ φsΛ ≠ empty}), {φssucΛ : WickContraction [φsΛ.1]ᵘᶜ.length // ¬ HaveEqTime φssucΛ}} (h1 : x1.1.1 = x2.1.1) (h2 : x1.2.1 = congr (by simp [h1]) x2.2.1) : x1 = x2 := by - match x1, x2 with - | ⟨⟨a1, b1⟩, ⟨c1, d1⟩⟩, ⟨⟨a2, b2⟩, ⟨c2, d2⟩⟩ => - simp only at h1 - subst h1 - simp only [ne_eq, congr_refl] at h2 - simp [h2] + rcases x1 with ⟨⟨a1, b1⟩, ⟨c1, d1⟩⟩ + rcases x2 with ⟨b2, h2⟩ + simp only at h1 + subst h1 + simp only [ne_eq, congr_refl] at h2 + simp [h2] /-- The equivalence which separates a Wick contraction which has an equal time contraction into a non-empty contraction only between equal-time fields and a Wick contraction which diff --git a/PhysLean/QFT/PerturbationTheory/WickContraction/TimeContract.lean b/PhysLean/QFT/PerturbationTheory/WickContraction/TimeContract.lean index 48992927e..42bfa2c4b 100644 --- a/PhysLean/QFT/PerturbationTheory/WickContraction/TimeContract.lean +++ b/PhysLean/QFT/PerturbationTheory/WickContraction/TimeContract.lean @@ -101,7 +101,7 @@ lemma timeContract_insert_some_of_lt rw [timeContract_insertAndContract_some] simp only [Nat.succ_eq_add_one, Fin.getElem_fin, ite_mul, instCommGroup.eq_1, contractStateAtIndex, uncontractedFieldOpEquiv, Equiv.optionCongr_apply, - Equiv.coe_trans, Option.map_some, Function.comp_apply, finCongr_apply, Fin.coe_cast, + Equiv.coe_trans, Option.map_some, Function.comp_apply, finCongr_apply, Fin.val_cast, List.getElem_map, uncontractedList_getElem_uncontractedIndexEquiv_symm, List.get_eq_getElem, Algebra.smul_mul_assoc, uncontractedListGet] · simp only [hik, ↓reduceIte, MulMemClass.coe_mul] @@ -145,7 +145,7 @@ lemma timeContract_insert_some_of_not_lt rw [timeContract_insertAndContract_some] simp only [Nat.succ_eq_add_one, Fin.getElem_fin, ite_mul, instCommGroup.eq_1, contractStateAtIndex, uncontractedFieldOpEquiv, Equiv.optionCongr_apply, - Equiv.coe_trans, Option.map_some, Function.comp_apply, finCongr_apply, Fin.coe_cast, + Equiv.coe_trans, Option.map_some, Function.comp_apply, finCongr_apply, Fin.val_cast, List.getElem_map, uncontractedList_getElem_uncontractedIndexEquiv_symm, List.get_eq_getElem, Algebra.smul_mul_assoc, uncontractedListGet] simp only [hik, ↓reduceIte, MulMemClass.coe_mul] @@ -182,7 +182,7 @@ lemma timeContract_insert_some_of_not_lt omega · have h2' := h.2 h1.1 (by omega) h1.1 omega - have ht := IsTotal.total (r := timeOrderRel) φs[k.1] φ + have ht := Std.Total.total (r := timeOrderRel) φs[k.1] φ simp_all only [Fin.getElem_fin, Nat.succ_eq_add_one, not_lt, false_or] exact ht @@ -195,7 +195,7 @@ lemma timeContract_of_not_gradingCompliant (φs : List 𝓕.FieldOp) obtain ⟨ha, ha2⟩ := ha apply Finset.prod_eq_zero (i := ⟨a, ha⟩) simp only [Finset.univ_eq_attach, Finset.mem_attach] - apply Subtype.eq + apply Subtype.ext simp only [List.get_eq_getElem, ZeroMemClass.coe_zero] rw [timeContract_zero_of_diff_grade] simp [ha2] diff --git a/PhysLean/QFT/PerturbationTheory/WickContraction/Uncontracted.lean b/PhysLean/QFT/PerturbationTheory/WickContraction/Uncontracted.lean index 7c325a51d..126d8b87c 100644 --- a/PhysLean/QFT/PerturbationTheory/WickContraction/Uncontracted.lean +++ b/PhysLean/QFT/PerturbationTheory/WickContraction/Uncontracted.lean @@ -52,19 +52,21 @@ lemma mem_uncontracted_iff_not_contracted (i : Fin n) : have hp := c.2.1 p hp rw [Finset.card_eq_two] at hp obtain ⟨a, b, ha, hb, hab⟩ := hp - rw [Fin.find_eq_none_iff] at h + rw [Fin.find?_eq_none_iff] at h by_contra hn simp only [Finset.mem_insert, Finset.mem_singleton] at hn rcases hn with hn | hn · subst hn + simp at h exact h b hp · subst hn rw [Finset.pair_comm] at hp + simp at h exact h a hp · intro h - rw [Fin.find_eq_none_iff] + rw [Fin.find?_eq_none_iff] by_contra hn - simp only [not_forall, Decidable.not_not] at hn + simp only [decide_eq_false_iff_not, not_forall, Decidable.not_not] at hn obtain ⟨j, hj⟩ := hn apply h {i, j} hj simp diff --git a/PhysLean/QFT/PerturbationTheory/WickContraction/UncontractedList.lean b/PhysLean/QFT/PerturbationTheory/WickContraction/UncontractedList.lean index c53bd965c..25decf7d2 100644 --- a/PhysLean/QFT/PerturbationTheory/WickContraction/UncontractedList.lean +++ b/PhysLean/QFT/PerturbationTheory/WickContraction/UncontractedList.lean @@ -24,52 +24,52 @@ open PhysLean.Fin -/ -lemma fin_list_sorted_monotone_sorted {n m : ℕ} (l: List (Fin n)) (hl : l.Sorted (· ≤ ·)) - (f : Fin n → Fin m) (hf : StrictMono f) : ((List.map f l)).Sorted (· ≤ ·) := by +lemma fin_list_sorted_monotone_sorted {n m : ℕ} (l: List (Fin n)) (hl : l.Pairwise (· ≤ ·)) + (f : Fin n → Fin m) (hf : StrictMono f) : ((List.map f l)).Pairwise (· ≤ ·) := by induction l with | nil => simp | cons a l ih => - simp only [List.map_cons, List.sorted_cons, List.mem_map, forall_exists_index, and_imp, + simp only [List.map_cons, List.pairwise_cons, List.mem_map, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂] apply And.intro - · simp only [List.sorted_cons] at hl + · simp only [List.pairwise_cons] at hl intro b hb have hl1 := hl.1 b hb exact (StrictMono.le_iff_le hf).mpr hl1 - · simp only [List.sorted_cons] at hl + · simp only [List.pairwise_cons] at hl exact ih hl.2 -lemma fin_list_sorted_succAboveEmb_sorted (l: List (Fin n)) (hl : l.Sorted (· ≤ ·)) - (i : Fin n.succ) : ((List.map i.succAboveEmb l)).Sorted (· ≤ ·) := by +lemma fin_list_sorted_succAboveEmb_sorted (l: List (Fin n)) (hl : l.Pairwise (· ≤ ·)) + (i : Fin n.succ) : ((List.map i.succAboveEmb l)).Pairwise (· ≤ ·) := by apply fin_list_sorted_monotone_sorted exact hl simp only [Fin.coe_succAboveEmb] exact Fin.strictMono_succAbove i lemma fin_finset_sort_map_monotone {n m : ℕ} (a : Finset (Fin n)) (f : Fin n ↪ Fin m) - (hf : StrictMono f) : (Finset.sort (· ≤ ·) a).map f = - (Finset.sort (· ≤ ·) (a.map f)) := by - have h1 : ((Finset.sort (· ≤ ·) a).map f).Sorted (· ≤ ·) := by + (hf : StrictMono f) : (a.sort (· ≤ ·)).map f = + ((a.map f).sort (· ≤ ·)) := by + have h1 : ((a.sort (· ≤ ·)).map f).Pairwise (· ≤ ·) := by apply fin_list_sorted_monotone_sorted - exact Finset.sort_sorted (fun x1 x2 => x1 ≤ x2) a + exact a.pairwise_sort (fun x1 x2 => x1 ≤ x2) exact hf - have h2 : ((Finset.sort (· ≤ ·) a).map f).Nodup := by + have h2 : ((a.sort (· ≤ ·)).map f).Nodup := by refine (List.nodup_map_iff_inj_on ?_).mpr ?_ - exact Finset.sort_nodup (fun x1 x2 => x1 ≤ x2) a + exact a.sort_nodup (fun x1 x2 => x1 ≤ x2) intro a ha b hb hf exact f.2 hf - have h3 : ((Finset.sort (· ≤ ·) a).map f).toFinset = (a.map f) := by + have h3 : ((a.sort (· ≤ ·)).map f).toFinset = (a.map f) := by ext a simp rw [← h3] exact ((List.toFinset_sort (· ≤ ·) h2).mpr h1).symm lemma fin_list_sorted_split : - (l : List (Fin n)) → (hl : l.Sorted (· ≤ ·)) → (i : ℕ) → + (l : List (Fin n)) → (hl : l.Pairwise (· ≤ ·)) → (i : ℕ) → l = l.filter (fun x => x.1 < i) ++ l.filter (fun x => i ≤ x.1) | [], _, _ => by simp | a :: l, hl, i => by - simp only [List.sorted_cons] at hl + simp only [List.pairwise_cons] at hl by_cases ha : a < i · conv_lhs => rw [fin_list_sorted_split l hl.2 i] rw [← List.cons_append] @@ -97,12 +97,12 @@ lemma fin_list_sorted_split : omega lemma fin_list_sorted_indexOf_filter_le_mem : - (l : List (Fin n)) → (hl : l.Sorted (· ≤ ·)) → (i : Fin n) → + (l : List (Fin n)) → (hl : l.Pairwise (· ≤ ·)) → (i : Fin n) → (hl : i ∈ l) → List.idxOf i (List.filter (fun x => decide (↑i ≤ ↑x)) l) = 0 | [], _, _, _ => by simp | a :: l, hl, i, hi => by - simp only [List.sorted_cons] at hl + simp only [List.pairwise_cons] at hl by_cases ha : i ≤ a · simp only [ha, decide_true, List.filter_cons_of_pos] have ha : a = i := by @@ -123,7 +123,7 @@ lemma fin_list_sorted_indexOf_filter_le_mem : · exact hi lemma fin_list_sorted_indexOf_mem : - (l : List (Fin n)) → (hl : l.Sorted (· ≤ ·)) → (i : Fin n) → + (l : List (Fin n)) → (hl : l.Pairwise (· ≤ ·)) → (i : Fin n) → (hi : i ∈ l) → l.idxOf i = (l.filter (fun x => x.1 < i.1)).length := by intro l hl i hi @@ -134,12 +134,12 @@ lemma fin_list_sorted_indexOf_mem : · simp lemma orderedInsert_of_fin_list_sorted : - (l : List (Fin n)) → (hl : l.Sorted (· ≤ ·)) → (i : Fin n) → + (l : List (Fin n)) → (hl : l.Pairwise (· ≤ ·)) → (i : Fin n) → List.orderedInsert (· ≤ ·) i l = l.filter (fun x => x.1 < i.1) ++ i :: l.filter (fun x => i.1 ≤ x.1) | [], _, _ => by simp | a :: l, hl, i => by - simp only [List.sorted_cons] at hl + simp only [List.pairwise_cons] at hl by_cases ha : i ≤ a · simp only [List.orderedInsert, ha, ↓reduceIte, Fin.val_fin_lt, decide_eq_true_eq, not_lt, List.filter_cons_of_neg, Fin.val_fin_le, decide_true, List.filter_cons_of_pos] @@ -160,7 +160,7 @@ lemma orderedInsert_of_fin_list_sorted : simp only [decide_eq_true_eq] omega -lemma orderedInsert_eq_insertIdx_of_fin_list_sorted (l : List (Fin n)) (hl : l.Sorted (· ≤ ·)) +lemma orderedInsert_eq_insertIdx_of_fin_list_sorted (l : List (Fin n)) (hl : l.Pairwise (· ≤ ·)) (i : Fin n) : List.orderedInsert (· ≤ ·) i l = l.insertIdx (l.filter (fun x => x.1 < i.1)).length i := by let n : Fin l.length.succ := ⟨(List.filter (fun x => decide (x < i)) l).length, by @@ -212,17 +212,18 @@ lemma uncontractedList_get_mem_uncontracted (i : Fin c.uncontractedList.length) rw [← uncontractedList_mem_iff] simp -lemma uncontractedList_sorted : List.Sorted (· ≤ ·) c.uncontractedList := by +lemma uncontractedList_sorted : List.Pairwise (· ≤ ·) c.uncontractedList := by rw [uncontractedList] - apply List.Sorted.filter + apply List.Pairwise.filter rw [← List.ofFn_id] - exact Monotone.ofFn_sorted fun ⦃a b⦄ a => a + refine List.sortedLE_iff_pairwise.mp ?_ + exact Monotone.sortedLE_ofFn fun ⦃a b⦄ a => a -lemma uncontractedList_sorted_lt : List.Sorted (· < ·) c.uncontractedList := by +lemma uncontractedList_sorted_lt : List.Pairwise (· < ·) c.uncontractedList := by rw [uncontractedList] - apply List.Sorted.filter + apply List.Pairwise.filter rw [← List.ofFn_id] - exact List.sorted_lt_ofFn_iff.mpr fun ⦃a b⦄ a => a + exact List.pairwise_ofFn.mpr fun ⦃i j⦄ a => a lemma uncontractedList_nodup : c.uncontractedList.Nodup := by rw [uncontractedList] @@ -248,8 +249,8 @@ lemma uncontractedList_length_eq_card (c : WickContraction n) : lemma filter_uncontractedList (c : WickContraction n) (p : Fin n → Prop) [DecidablePred p] : (c.uncontractedList.filter p) = (c.uncontracted.filter p).sort (· ≤ ·) := by - have h1 : (c.uncontractedList.filter p).Sorted (· ≤ ·) := by - apply List.Sorted.filter + have h1 : (c.uncontractedList.filter p).Pairwise (· ≤ ·) := by + apply List.Pairwise.filter exact uncontractedList_sorted c have h2 : (c.uncontractedList.filter p).Nodup := by refine List.Nodup.filter _ ?_ @@ -382,8 +383,10 @@ lemma uncontractedListEmd_strictMono {φs : List 𝓕.FieldOp} {φsΛ : WickCont {i j : Fin [φsΛ]ᵘᶜ.length} (h : i < j) : uncontractedListEmd i < uncontractedListEmd j := by simp only [uncontractedListEmd, uncontractedIndexEquiv, List.get_eq_getElem, Equiv.trans_toEmbedding, Function.Embedding.trans_apply, Equiv.coe_toEmbedding, finCongr_apply, - Equiv.coe_fn_mk, Fin.coe_cast, Function.Embedding.coe_subtype] - exact List.Sorted.get_strictMono φsΛ.uncontractedList_sorted_lt h + Equiv.coe_fn_mk, Fin.val_cast, Function.Embedding.coe_subtype] + apply List.SortedLT.strictMono_get + exact φsΛ.uncontractedList_sorted_lt.sortedLT + exact h lemma uncontractedListEmd_mem_uncontracted {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length} (i : Fin [φsΛ]ᵘᶜ.length) : uncontractedListEmd i ∈ φsΛ.uncontracted := by @@ -445,7 +448,7 @@ lemma uncontractedListEmd_empty {φs : List 𝓕.FieldOp} : -/ lemma uncontractedList_succAboveEmb_sorted (c : WickContraction n) (i : Fin n.succ) : - ((List.map i.succAboveEmb c.uncontractedList)).Sorted (· ≤ ·) := by + ((List.map i.succAboveEmb c.uncontractedList)).Pairwise (· ≤ ·) := by apply fin_list_sorted_succAboveEmb_sorted exact uncontractedList_sorted c @@ -470,8 +473,8 @@ lemma uncontractedList_succAbove_orderedInsert_nodup (c : WickContraction n) (i lemma uncontractedList_succAbove_orderedInsert_sorted (c : WickContraction n) (i : Fin n.succ) : (List.orderedInsert (· ≤ ·) i - (List.map i.succAboveEmb c.uncontractedList)).Sorted (· ≤ ·) := by - refine List.Sorted.orderedInsert i (List.map (⇑i.succAboveEmb) c.uncontractedList) ?_ + (List.map i.succAboveEmb c.uncontractedList)).Pairwise (· ≤ ·) := by + refine List.Pairwise.orderedInsert i (List.map (⇑i.succAboveEmb) c.uncontractedList) ?_ exact uncontractedList_succAboveEmb_sorted c i lemma uncontractedList_succAbove_orderedInsert_toFinset (c : WickContraction n) (i : Fin n.succ) : @@ -533,7 +536,7 @@ lemma uncontractedList_succAboveEmb_eraseIdx_toFinset (c : WickContraction n) (i exact uncontractedList_succAboveEmb_nodup c i lemma uncontractedList_succAboveEmb_eraseIdx_sorted (c : WickContraction n) (i : Fin n.succ) - (k: ℕ) : ((List.map i.succAboveEmb c.uncontractedList).eraseIdx k).Sorted (· ≤ ·) := by + (k: ℕ) : ((List.map i.succAboveEmb c.uncontractedList).eraseIdx k).Pairwise (· ≤ ·) := by apply PhysLean.List.eraseIdx_sorted exact uncontractedList_succAboveEmb_sorted c i @@ -590,8 +593,8 @@ def uncontractedListOrderPos (c : WickContraction n) (i : Fin n.succ) : ℕ := (List.filter (fun x => x.1 < i.1) c.uncontractedList).length @[simp] -lemma uncontractedListOrderPos_lt_length_add_one (c : WickContraction n) (i : Fin n.succ) : - c.uncontractedListOrderPos i < c.uncontractedList.length + 1 := by +lemma uncontractedListOrderPos_le_length (c : WickContraction n) (i : Fin n.succ) : + c.uncontractedListOrderPos i ≤ c.uncontractedList.length := by simp only [uncontractedListOrderPos, Nat.succ_eq_add_one] have h1 := c.uncontractedList.length_filter_le (fun x => x.1 < i.1) omega @@ -607,8 +610,8 @@ lemma take_uncontractedListOrderPos_eq_filter_sort (c : WickContraction n) (i : (c.uncontractedList.take (c.uncontractedListOrderPos i)) = (c.uncontracted.filter (fun x => x.1 < i.1)).sort (· ≤ ·) := by rw [take_uncontractedListOrderPos_eq_filter] - have h1 : (c.uncontractedList.filter (fun x => x.1 < i.1)).Sorted (· ≤ ·) := by - apply List.Sorted.filter + have h1 : (c.uncontractedList.filter (fun x => x.1 < i.1)).Pairwise (· ≤ ·) := by + apply List.Pairwise.filter exact uncontractedList_sorted c have h2 : (c.uncontractedList.filter (fun x => x.1 < i.1)).Nodup := by refine List.Nodup.filter _ ?_ @@ -633,9 +636,9 @@ lemma orderedInsert_succAboveEmb_uncontractedList_eq_insertIdx (c : WickContract funext x simp only [Function.comp_apply, Fin.succAbove, decide_eq_decide] split - · simp only [Fin.lt_def, Fin.coe_castSucc] + · simp only [Fin.lt_def, Fin.val_castSucc] · rename_i h - simp_all only [Fin.lt_def, Fin.coe_castSucc, not_lt, Fin.val_succ] + simp_all only [Fin.lt_def, Fin.val_castSucc, not_lt, Fin.val_succ] omega · exact uncontractedList_succAboveEmb_sorted c i diff --git a/PhysLean/QFT/QED/AnomalyCancellation/Basic.lean b/PhysLean/QFT/QED/AnomalyCancellation/Basic.lean index d489f0f00..e545af696 100644 --- a/PhysLean/QFT/QED/AnomalyCancellation/Basic.lean +++ b/PhysLean/QFT/QED/AnomalyCancellation/Basic.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.QFT.AnomalyCancellation.Basic +import Mathlib.Tactic.LinearCombination /-! # Anomaly cancellation of a theory with a pure U(1)-gauge group diff --git a/PhysLean/QFT/QED/AnomalyCancellation/BasisLinear.lean b/PhysLean/QFT/QED/AnomalyCancellation/BasisLinear.lean index 332024fa8..f01b9b20f 100644 --- a/PhysLean/QFT/QED/AnomalyCancellation/BasisLinear.lean +++ b/PhysLean/QFT/QED/AnomalyCancellation/BasisLinear.lean @@ -42,7 +42,7 @@ lemma asCharges_ne_castSucc {k j : Fin n} (h : k ≠ j) : · split · rename_i h1 h2 rw [Fin.ext_iff] at h1 h2 - simp only [Fin.coe_castSucc, Fin.val_last] at h1 h2 + simp only [Fin.val_castSucc, Fin.val_last] at h1 h2 have hj : j.val < n := by exact j.prop simp_all @@ -85,8 +85,8 @@ def coordinateMap : (PureU1 n.succ).LinSols ≃ₗ[ℚ] Fin n →₀ ℚ where map_smul' a S := Finsupp.ext (congrFun rfl) invFun f := ∑ i : Fin n, f i • asLinSols i left_inv S := by - simp only [PureU1_numberCharges, Equiv.invFun_as_coe, Finsupp.equivFunOnFinite_symm_apply_toFun, - Function.comp_apply] + simp only [Nat.succ_eq_add_one, PureU1_numberCharges, Equiv.invFun_as_coe, + Finsupp.equivFunOnFinite_symm_apply_apply, Function.comp_apply] apply pureU1_anomalyFree_ext intro j rw [sum_of_vectors] @@ -102,7 +102,7 @@ def coordinateMap : (PureU1 n.succ).LinSols ≃ₗ[ℚ] Fin n →₀ ℚ where simp only [PureU1_numberCharges, Equiv.invFun_as_coe] ext rename_i j - simp only [Finsupp.equivFunOnFinite_symm_apply_toFun, Function.comp_apply] + simp only [Nat.succ_eq_add_one, Finsupp.equivFunOnFinite_symm_apply_apply, Function.comp_apply] rw [sum_of_vectors] simp only [HSMul.hSMul, SMul.smul, PureU1_numberCharges, asLinSols_val] diff --git a/PhysLean/QFT/QED/AnomalyCancellation/ConstAbs.lean b/PhysLean/QFT/QED/AnomalyCancellation/ConstAbs.lean index fc190933b..58b117804 100644 --- a/PhysLean/QFT/QED/AnomalyCancellation/ConstAbs.lean +++ b/PhysLean/QFT/QED/AnomalyCancellation/ConstAbs.lean @@ -32,7 +32,7 @@ lemma constAbs_perm (S : (PureU1 n).Charges) (M :(FamilyPermutations n).group) : MonoidHom.coe_mk, OneHom.coe_mk, chargeMap_apply] refine Iff.intro (fun h i j => ?_) (fun h i j => h (M.invFun i) (M.invFun j)) have h2 := h (M.toFun i) (M.toFun j) - simp only [Equiv.toFun_as_coe, Equiv.Perm.inv_apply_self] at h2 + simp only [Equiv.toFun_as_coe, Equiv.Perm.coe_inv, Equiv.symm_apply_apply] at h2 exact h2 lemma constAbs_sort {S : (PureU1 n).Charges} (CA : ConstAbs S) : ConstAbs (sort S) := by @@ -224,7 +224,7 @@ lemma AFL_even_below' {A : (PureU1 (2 * n.succ)).LinSols} (h : ConstAbsSorted A. rw [← boundary_castSucc h hk] apply lt_eq h (le_of_lt hk.left) rw [Fin.le_def] - simp only [PureU1_numberCharges, Fin.coe_cast, Fin.coe_castAdd, mul_eq, Fin.coe_castSucc] + simp only [PureU1_numberCharges, Fin.val_cast, Fin.val_castAdd, mul_eq, Fin.val_castSucc] rw [AFL_even_Boundary h hA hk] exact Fin.is_le i @@ -245,7 +245,7 @@ lemma AFL_even_above' {A : (PureU1 (2 * n.succ)).LinSols} (h : ConstAbsSorted A. rw [← boundary_succ h hk] apply gt_eq h (le_of_lt hk.right) rw [Fin.le_def] - simp only [mul_eq, Fin.val_succ, PureU1_numberCharges, Fin.coe_cast, Fin.coe_natAdd] + simp only [mul_eq, Fin.val_succ, PureU1_numberCharges, Fin.val_cast, Fin.val_natAdd] rw [AFL_even_Boundary h hA hk] exact Nat.le_add_right (n + 1) ↑i diff --git a/PhysLean/QFT/QED/AnomalyCancellation/Even/BasisLinear.lean b/PhysLean/QFT/QED/AnomalyCancellation/Even/BasisLinear.lean index a4266dae3..a2f5ffae0 100644 --- a/PhysLean/QFT/QED/AnomalyCancellation/Even/BasisLinear.lean +++ b/PhysLean/QFT/QED/AnomalyCancellation/Even/BasisLinear.lean @@ -6,10 +6,74 @@ Authors: Joseph Tooby-Smith import PhysLean.QFT.QED.AnomalyCancellation.BasisLinear import PhysLean.QFT.QED.AnomalyCancellation.VectorLike /-! -# Basis of `LinSols` in the even case -We give a basis of `LinSols` in the even case. This basis has the special property -that splits into two planes on which every point is a solution to the ACCs. +# Splitting the linear solutions in the even case into two ACC-satisfying planes + +## i. Overview + +We split the linear solutions of `PureU1 (2 * n.succ)` into two planes, +where every point in either plane satisfies both the linear and cubic anomaly cancellation +conditions. + +## ii. Key results + +- `P'` : The inclusion of the first plane into linear solutions +- `P_accCube` : The statement that chares from the first plane satisfy the cubic ACC +- `P!'` : The inclusion of the second plane. +- `P!_accCube` : The statement that charges from the second plane satisfy the cubic ACC +- `span_basis` : Every linear solution is the sum of a point from each plane. + +## iii. Table of contents + +- A. Splitting the charges up into groups + - A.1. The even split: Spltting the charges up via `n.succ + n.succ` + - A.2. The shifted even split: Spltting the charges up via `1 + (n + n + 1)` + - A.3. Lemmas relating the two splittings +- B. The first plane + - B.1. The basis vectors of the first plane as charges + - B.2. Components of the basis vectors + - B.3. The basis vectors satisfy the linear ACCs + - B.4. The basis vectors satisfy the cubic ACC + - B.5. The basis vectors as linear solutions + - B.6. The inclusion of the first plane into charges + - B.7. Components of the inclusion into charges + - B.8. The inclusion into charges satisfies the linear and cubic ACCs + - B.9. Kernel of the inclusion into charges + - B.10. The inclusion of the plane into linear solutions + - B.11. The basis vectors are linearly independent + - B.12. Every vector-like even solution is in the span of the basis of the first plane +- C. The vectors of the basis spanning the second plane, via the shifted even split + - C.2. Components of the vectors + - C.3. The vectors satisfy the linear ACCs + - C.4. The vectors satisfy the cubic ACC + - C.6. The vectors as linear solutions + - C.7. The inclusion of the second plane into charges + - C.8. Components of the inclusion into charges + - C.9. The inclusion into charges satisfies the cubic ACC + - C.10. Kernel of the inclusion into charges + - C.11. The inclusion of the second plane into the span of the basis + - C.12. The inclusion of the plane into linear solutions + - C.13. The basis vectors are linearly independent + - C.14. Properties of the basis vectors relating to the span + - C.15. Permutations as additions of basis vectors +- D. Mixed cubic ACCs involving points from both planes +- E. The combined basis + - E.1. As a map into linear solutions + - E.2. Inclusion of the span of the basis into charges + - E.3. Components of the inclusion into charges + - E.4. Kernel of the inclusion into charges + - E.5. The inclusion of the span of the basis into linear solutions + - E.6. The combined basis vectors are linearly independent + - E.7. Injectivity of the inclusion into linear solutions + - E.8. Cardinality of the basis + - E.9. The basis vectors as a basis +- F. Every Lienar solution is the sum of a point from each plane + - F.1. Relation under permutations + +## iv. References + +- https://arxiv.org/pdf/1912.04804.pdf + -/ open Nat Module Finset BigOperators @@ -20,8 +84,26 @@ variable {n : ℕ} namespace VectorLikeEvenPlane -lemma n_cond₂ (n : ℕ) : 1 + ((n + n) + 1) = 2 * n.succ := by - linarith +/-! + +## A. Splitting the charges up into groups + +We have `2 * n.succ` charges, which we split up in the following ways: + +`| evenFst j (0 to n) | evenSnd j (n.succ to n + n.succ)|` + +``` +| evenShiftZero (0) | evenShiftFst j (1 to n) | + evenShiftSnd j (n.succ to 2 * n) | evenShiftLast (2 * n.succ - 1) | +``` + +-/ + +/-! + +### A.1. The even split: Spltting the charges up via `n.succ + n.succ` + +-/ /-- The inclusion of `Fin n.succ` into `Fin (n.succ + n.succ)` via the first `n.succ`, casted into `Fin (2 * n.succ)`. -/ @@ -33,24 +115,6 @@ def evenFst (j : Fin n.succ) : Fin (2 * n.succ) := def evenSnd (j : Fin n.succ) : Fin (2 * n.succ) := Fin.cast (split_equal n.succ) (Fin.natAdd n.succ j) -/-- The inclusion of `Fin n` into `Fin (1 + (n + n + 1))` via the first `n`, - casted into `Fin (2 * n.succ)`. -/ -def evenShiftFst (j : Fin n) : Fin (2 * n.succ) := Fin.cast (n_cond₂ n) - (Fin.natAdd 1 (Fin.castAdd 1 (Fin.castAdd n j))) - -/-- The inclusion of `Fin n` into `Fin (1 + (n + n + 1))` via the second `n`, - casted into `Fin (2 * n.succ)`. -/ -def evenShiftSnd (j : Fin n) : Fin (2 * n.succ) := Fin.cast (n_cond₂ n) - (Fin.natAdd 1 (Fin.castAdd 1 (Fin.natAdd n j))) - -/-- The element of `Fin (1 + (n + n + 1))` corresponding to the first `1`, - casted into `Fin (2 * n.succ)`. -/ -def evenShiftZero : Fin (2 * n.succ) := (Fin.cast (n_cond₂ n) (Fin.castAdd ((n + n) + 1) 0)) - -/-- The element of `Fin (1 + (n + n + 1))` corresponding to the second `1`, - casted into `Fin (2 * n.succ)`. -/ -def evenShiftLast : Fin (2 * n.succ) := (Fin.cast (n_cond₂ n) (Fin.natAdd 1 (Fin.natAdd (n + n) 0))) - lemma ext_even (S T : Fin (2 * n.succ) → ℚ) (h1 : ∀ i, S (evenFst i) = T (evenFst i)) (h2 : ∀ i, S (evenSnd i) = T (evenSnd i)) : S = T := by funext i @@ -63,7 +127,7 @@ lemma ext_even (S T : Fin (2 * n.succ) → ℚ) (h1 : ∀ i, S (evenFst i) = T ( · let j : Fin n.succ := ⟨i - n.succ, by omega⟩ have h2 := h2 j have h3 : evenSnd j = i := by - simp only [succ_eq_add_one, evenSnd, Fin.ext_iff, Fin.coe_cast, Fin.coe_natAdd, j] + simp only [succ_eq_add_one, evenSnd, Fin.ext_iff, Fin.val_cast, Fin.val_natAdd, j] omega rw [h3] at h2 exact h2 @@ -78,6 +142,33 @@ lemma sum_even (S : Fin (2 * n.succ) → ℚ) : rw [h1, Fin.sum_univ_add, Finset.sum_add_distrib] rfl +/-! + +### A.2. The shifted even split: Spltting the charges up via `1 + (n + n + 1)` + +-/ + +lemma n_cond₂ (n : ℕ) : 1 + ((n + n) + 1) = 2 * n.succ := by + linarith + +/-- The inclusion of `Fin n` into `Fin (1 + (n + n + 1))` via the first `n`, + casted into `Fin (2 * n.succ)`. -/ +def evenShiftFst (j : Fin n) : Fin (2 * n.succ) := Fin.cast (n_cond₂ n) + (Fin.natAdd 1 (Fin.castAdd 1 (Fin.castAdd n j))) + +/-- The inclusion of `Fin n` into `Fin (1 + (n + n + 1))` via the second `n`, + casted into `Fin (2 * n.succ)`. -/ +def evenShiftSnd (j : Fin n) : Fin (2 * n.succ) := Fin.cast (n_cond₂ n) + (Fin.natAdd 1 (Fin.castAdd 1 (Fin.natAdd n j))) + +/-- The element of `Fin (1 + (n + n + 1))` corresponding to the first `1`, + casted into `Fin (2 * n.succ)`. -/ +def evenShiftZero : Fin (2 * n.succ) := (Fin.cast (n_cond₂ n) (Fin.castAdd ((n + n) + 1) 0)) + +/-- The element of `Fin (1 + (n + n + 1))` corresponding to the second `1`, + casted into `Fin (2 * n.succ)`. -/ +def evenShiftLast : Fin (2 * n.succ) := (Fin.cast (n_cond₂ n) (Fin.natAdd 1 (Fin.natAdd (n + n) 0))) + lemma sum_evenShift (S : Fin (2 * n.succ) → ℚ) : ∑ i, S i = S evenShiftZero + S evenShiftLast + ∑ i : Fin n, ((S ∘ evenShiftFst) i + (S ∘ evenShiftSnd) i) := by @@ -98,26 +189,43 @@ lemma sum_evenShift (S : Fin (2 * n.succ) → ℚ) : nth_rewrite 2 [Rat.add_comm] rfl +/-! + +### A.3. Lemmas relating the two splittings + +-/ lemma evenShiftZero_eq_evenFst_zero : @evenShiftZero n = evenFst 0 := rfl lemma evenShiftLast_eq_evenSnd_last: @evenShiftLast n = evenSnd (Fin.last n) := by rw [Fin.ext_iff] - simp only [succ_eq_add_one, evenShiftLast, Fin.isValue, Fin.coe_cast, Fin.coe_natAdd, + simp only [succ_eq_add_one, evenShiftLast, Fin.isValue, Fin.val_cast, Fin.val_natAdd, Fin.val_eq_zero, add_zero, evenSnd, Fin.natAdd_last, Fin.val_last] omega lemma evenShiftFst_eq_evenFst_succ (j : Fin n) : evenShiftFst j = evenFst j.succ := by rw [Fin.ext_iff, evenFst, evenShiftFst] - simp only [Fin.coe_cast, Fin.coe_natAdd, Fin.coe_castAdd, Fin.val_succ] + simp only [Fin.val_cast, Fin.val_natAdd, Fin.val_castAdd, Fin.val_succ] ring lemma evenShiftSnd_eq_evenSnd_castSucc (j : Fin n) : evenShiftSnd j = evenSnd j.castSucc := by rw [Fin.ext_iff, evenSnd, evenShiftSnd] - simp only [Fin.coe_cast, Fin.coe_natAdd, Fin.coe_castAdd, Fin.coe_castSucc] + simp only [Fin.val_cast, Fin.val_natAdd, Fin.val_castAdd, Fin.val_castSucc] ring_nf rw [Nat.succ_eq_add_one] ring +/-! + +## B. The first plane + +-/ + +/-! + +### B.1. The basis vectors of the first plane as charges + +-/ + /-- The first part of the basis as charges. -/ def basisAsCharges (j : Fin n.succ) : (PureU1 (2 * n.succ)).Charges := fun i => @@ -129,23 +237,15 @@ def basisAsCharges (j : Fin n.succ) : (PureU1 (2 * n.succ)).Charges := else 0 -/-- The second part of the basis as charges. -/ -def basis!AsCharges (j : Fin n) : (PureU1 (2 * n.succ)).Charges := - fun i => - if i = evenShiftFst j then - 1 - else - if i = evenShiftSnd j then - - 1 - else - 0 +/-! + +### B.2. Components of the basis vectors + +-/ lemma basis_on_evenFst_self (j : Fin n.succ) : basisAsCharges j (evenFst j) = 1 := by simp [basisAsCharges] -lemma basis!_on_evenShiftFst_self (j : Fin n) : basis!AsCharges j (evenShiftFst j) = 1 := by - simp [basis!AsCharges] - lemma basis_on_evenFst_other {k j : Fin n.succ} (h : k ≠ j) : basisAsCharges k (evenFst j) = 0 := by simp only [basisAsCharges, succ_eq_add_one, PureU1_numberCharges, evenFst, evenSnd] @@ -160,7 +260,7 @@ lemma basis_on_evenFst_other {k j : Fin n.succ} (h : k ≠ j) : simp_all only [succ_eq_add_one, ne_eq, Fin.natAdd_eq_addNat, Fin.cast_inj, neg_eq_zero, one_ne_zero] rw [Fin.ext_iff] at h2 - simp only [Fin.coe_castAdd, Fin.coe_addNat] at h2 + simp only [Fin.val_castAdd, Fin.val_addNat] at h2 omega · rfl @@ -169,29 +269,6 @@ lemma basis_on_other {k : Fin n.succ} {j : Fin (2 * n.succ)} (h1 : j ≠ evenFst simp only [basisAsCharges, succ_eq_add_one, PureU1_numberCharges] simp_all only [ne_eq, ↓reduceIte] -lemma basis!_on_other {k : Fin n} {j : Fin (2 * n.succ)} (h1 : j ≠ evenShiftFst k) - (h2 : j ≠ evenShiftSnd k) : basis!AsCharges k j = 0 := by - simp only [basis!AsCharges, succ_eq_add_one, PureU1_numberCharges] - simp_all only [ne_eq, ↓reduceIte] - -lemma basis!_on_evenShiftFst_other {k j : Fin n} (h : k ≠ j) : - basis!AsCharges k (evenShiftFst j) = 0 := by - simp only [basis!AsCharges, succ_eq_add_one, PureU1_numberCharges] - simp only [evenShiftFst, succ_eq_add_one, evenShiftSnd] - split - · rename_i h1 - rw [Fin.ext_iff] at h1 - simp_all - rw [Fin.ext_iff] at h - simp_all - · split - · rename_i h1 h2 - simp_all - rw [Fin.ext_iff] at h2 - simp only [Fin.coe_castAdd, Fin.coe_addNat] at h2 - omega - · rfl - lemma basis_evenSnd_eq_neg_evenFst (j i : Fin n.succ) : basisAsCharges j (evenSnd i) = - basisAsCharges j (evenFst i) := by simp only [basisAsCharges, succ_eq_add_one, PureU1_numberCharges, evenSnd, evenFst] @@ -210,80 +287,29 @@ lemma basis_evenSnd_eq_neg_evenFst (j i : Fin n.succ) : simp_all all_goals omega -lemma basis!_evenShftSnd_eq_neg_evenShiftFst (j i : Fin n) : - basis!AsCharges j (evenShiftSnd i) = - basis!AsCharges j (evenShiftFst i) := by - simp only [basis!AsCharges, succ_eq_add_one, PureU1_numberCharges, evenShiftSnd, evenShiftFst] - split <;> split - any_goals split - any_goals split - any_goals rfl - all_goals - rename_i h1 h2 - rw [Fin.ext_iff] at h1 h2 - simp_all only [Fin.natAdd_eq_addNat, Fin.cast_inj, Fin.coe_cast, Fin.coe_natAdd, - Fin.coe_castAdd, add_right_inj, Fin.coe_addNat, add_eq_left] - · subst h1 - exact Fin.elim0 i - all_goals - rename_i h3 - rw [Fin.ext_iff] at h3 - simp_all only [Fin.coe_natAdd, Fin.coe_castAdd, Fin.coe_addNat, not_true_eq_false] - all_goals - omega - lemma basis_on_evenSnd_self (j : Fin n.succ) : basisAsCharges j (evenSnd j) = - 1 := by rw [basis_evenSnd_eq_neg_evenFst, basis_on_evenFst_self] -lemma basis!_on_evenShiftSnd_self (j : Fin n) : basis!AsCharges j (evenShiftSnd j) = - 1 := by - rw [basis!_evenShftSnd_eq_neg_evenShiftFst, basis!_on_evenShiftFst_self] - lemma basis_on_evenSnd_other {k j : Fin n.succ} (h : k ≠ j) : basisAsCharges k (evenSnd j) = 0 := by rw [basis_evenSnd_eq_neg_evenFst, basis_on_evenFst_other h] rfl -lemma basis!_on_evenShiftSnd_other {k j : Fin n} (h : k ≠ j) : - basis!AsCharges k (evenShiftSnd j) = 0 := by - rw [basis!_evenShftSnd_eq_neg_evenShiftFst, basis!_on_evenShiftFst_other h] - rfl +/-! -lemma basis!_on_evenShiftZero (j : Fin n) : basis!AsCharges j evenShiftZero = 0 := by - simp only [basis!AsCharges, succ_eq_add_one, PureU1_numberCharges] - split<;> rename_i h - · simp only [evenShiftZero, succ_eq_add_one, Fin.isValue, evenShiftFst, Fin.ext_iff, - Fin.coe_cast, Fin.coe_castAdd, Fin.val_eq_zero, Fin.coe_natAdd] at h - omega - · split <;> rename_i h2 - · simp only [evenShiftZero, succ_eq_add_one, Fin.isValue, evenShiftSnd, Fin.ext_iff, - Fin.coe_cast, Fin.coe_castAdd, Fin.val_eq_zero, Fin.coe_natAdd] at h2 - omega - · rfl +### B.3. The basis vectors satisfy the linear ACCs -lemma basis!_on_evenShiftLast (j : Fin n) : basis!AsCharges j evenShiftLast = 0 := by - simp only [basis!AsCharges, succ_eq_add_one, PureU1_numberCharges] - split <;> rename_i h - · rw [Fin.ext_iff] at h - simp only [succ_eq_add_one, evenShiftLast, Fin.isValue, Fin.coe_cast, Fin.coe_natAdd, - Fin.val_eq_zero, add_zero, evenShiftFst, Fin.coe_castAdd, add_right_inj] at h - omega - · split <;> rename_i h2 - · rw [Fin.ext_iff] at h2 - simp only [succ_eq_add_one, evenShiftLast, Fin.isValue, Fin.coe_cast, Fin.coe_natAdd, - Fin.val_eq_zero, add_zero, evenShiftSnd, Fin.coe_castAdd, add_right_inj] at h2 - omega - · rfl +-/ lemma basis_linearACC (j : Fin n.succ) : (accGrav (2 * n.succ)) (basisAsCharges j) = 0 := by rw [accGrav] simp only [LinearMap.coe_mk, AddHom.coe_mk] rw [sum_even] simp [basis_evenSnd_eq_neg_evenFst] +/-! -lemma basis!_linearACC (j : Fin n) : (accGrav (2 * n.succ)) (basis!AsCharges j) = 0 := by - rw [accGrav] - simp only [LinearMap.coe_mk, AddHom.coe_mk] - rw [sum_evenShift, basis!_on_evenShiftZero, basis!_on_evenShiftLast] - simp [basis!_evenShftSnd_eq_neg_evenShiftFst] +### B.4. The basis vectors satisfy the cubic ACC +-/ lemma basis_accCube (j : Fin n.succ) : accCube (2 * n.succ) (basisAsCharges j) = 0 := by rw [accCube_explicit, sum_even] @@ -292,16 +318,11 @@ lemma basis_accCube (j : Fin n.succ) : simp only [succ_eq_add_one, Function.comp_apply, basis_evenSnd_eq_neg_evenFst] ring -lemma basis!_accCube (j : Fin n) : - accCube (2 * n.succ) (basis!AsCharges j) = 0 := by - rw [accCube_explicit, sum_evenShift] - rw [basis!_on_evenShiftLast, basis!_on_evenShiftZero] - simp only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, add_zero, Function.comp_apply, - zero_add] - apply Finset.sum_eq_zero - intro i _ - simp only [basis!_evenShftSnd_eq_neg_evenShiftFst] - ring +/-! + +### B.5. The basis vectors as linear solutions + +-/ /-- The first part of the basis as `LinSols`. -/ @[simps!] @@ -313,50 +334,20 @@ def basis (j : Fin n.succ) : (PureU1 (2 * n.succ)).LinSols := | 0 => exact basis_linearACC j⟩ -/-- The second part of the basis as `LinSols`. -/ -@[simps!] -def basis! (j : Fin n) : (PureU1 (2 * n.succ)).LinSols := - ⟨basis!AsCharges j, by - intro i - simp only [succ_eq_add_one, PureU1_numberLinear] at i - match i with - | 0 => - exact basis!_linearACC j⟩ +/-! -/-- The whole basis as `LinSols`. -/ -def basisa : (Fin n.succ) ⊕ (Fin n) → (PureU1 (2 * n.succ)).LinSols := fun i => - match i with - | .inl i => basis i - | .inr i => basis! i +### B.6. The inclusion of the first plane into charges -/-- Swapping the elements evenShiftFst j and evenShiftSnd j is equivalent to - adding a vector basis!AsCharges j. -/ -lemma swap!_as_add {S S' : (PureU1 (2 * n.succ)).LinSols} (j : Fin n) - (hS : ((FamilyPermutations (2 * n.succ)).linSolRep - (pairSwap (evenShiftFst j) (evenShiftSnd j))) S = S') : - S'.val = S.val + (S.val (evenShiftSnd j) - S.val (evenShiftFst j)) • basis!AsCharges j := by - funext i - rw [← hS, FamilyPermutations_anomalyFreeLinear_apply] - by_cases hi : i = evenShiftFst j - · subst hi - simp [HSMul.hSMul, basis!_on_evenShiftFst_self, pairSwap_inv_fst] - · by_cases hi2 : i = evenShiftSnd j - · simp [HSMul.hSMul, hi2, basis!_on_evenShiftSnd_self, pairSwap_inv_snd] - · simp only [succ_eq_add_one, Equiv.invFun_as_coe, HSMul.hSMul, - ACCSystemCharges.chargesAddCommMonoid_add, ACCSystemCharges.chargesModule_smul] - rw [basis!_on_other hi hi2] - change S.val ((pairSwap (evenShiftFst j) (evenShiftSnd j)).invFun i) =_ - erw [pairSwap_inv_other (Ne.symm hi) (Ne.symm hi2)] - simp +-/ /-- A point in the span of the first part of the basis as a charge. -/ def P (f : Fin n.succ → ℚ) : (PureU1 (2 * n.succ)).Charges := ∑ i, f i • basisAsCharges i -/-- A point in the span of the second part of the basis as a charge. -/ -def P! (f : Fin n → ℚ) : (PureU1 (2 * n.succ)).Charges := ∑ i, f i • basis!AsCharges i +/-! -/-- A point in the span of the basis as a charge. -/ -def Pa (f : Fin n.succ → ℚ) (g : Fin n → ℚ) : (PureU1 (2 * n.succ)).Charges := P f + P! g +### B.7. Components of the inclusion into charges + +-/ lemma P_evenFst (f : Fin n.succ → ℚ) (j : Fin n.succ) : P f (evenFst j) = f j := by rw [P, sum_of_charges] @@ -369,23 +360,6 @@ lemma P_evenFst (f : Fin n.succ → ℚ) (j : Fin n.succ) : P f (evenFst j) = f exact Rat.mul_zero (f k) · simp only [mem_univ, not_true_eq_false, _root_.mul_eq_zero, IsEmpty.forall_iff] -lemma P!_evenShiftFst (f : Fin n → ℚ) (j : Fin n) : P! f (evenShiftFst j) = f j := by - rw [P!, sum_of_charges] - simp only [HSMul.hSMul, SMul.smul] - rw [Finset.sum_eq_single j] - · rw [basis!_on_evenShiftFst_self] - exact Rat.mul_one (f j) - · intro k _ hkj - rw [basis!_on_evenShiftFst_other hkj] - exact Rat.mul_zero (f k) - · simp only [mem_univ, not_true_eq_false, _root_.mul_eq_zero, IsEmpty.forall_iff] - -lemma Pa_evenShiftFst (f : Fin n.succ → ℚ) (g : Fin n → ℚ) (j : Fin n) : - Pa f g (evenShiftFst j) = f j.succ + g j := by - rw [Pa] - simp only [ACCSystemCharges.chargesAddCommMonoid_add] - rw [P!_evenShiftFst, evenShiftFst_eq_evenFst_succ, P_evenFst] - lemma P_evenSnd (f : Fin n.succ → ℚ) (j : Fin n.succ) : P f (evenSnd j) = - f j := by rw [P, sum_of_charges] simp only [succ_eq_add_one, HSMul.hSMul, SMul.smul] @@ -395,49 +369,16 @@ lemma P_evenSnd (f : Fin n.succ → ℚ) (j : Fin n.succ) : P f (evenSnd j) = - simp only [basis_on_evenSnd_other hkj, mul_zero] · simp -lemma P!_evenShiftSnd (f : Fin n → ℚ) (j : Fin n) : P! f (evenShiftSnd j) = - f j := by - rw [P!, sum_of_charges] - simp only [HSMul.hSMul, SMul.smul] - rw [Finset.sum_eq_single j] - · rw [basis!_on_evenShiftSnd_self] - exact mul_neg_one (f j) - · intro k _ hkj - rw [basis!_on_evenShiftSnd_other hkj] - exact Rat.mul_zero (f k) - · simp +lemma P_evenSnd_evenFst (f : Fin n.succ → ℚ) : P f ∘ evenSnd = - P f ∘ evenFst := by + funext j + simp only [PureU1_numberCharges, Function.comp_apply, Pi.neg_apply] + rw [P_evenFst, P_evenSnd] -lemma Pa_evenShiftSnd (f : Fin n.succ → ℚ) (g : Fin n → ℚ) (j : Fin n) : - Pa f g (evenShiftSnd j) = - f j.castSucc - g j := by - rw [Pa] - simp only [ACCSystemCharges.chargesAddCommMonoid_add] - rw [P!_evenShiftSnd, evenShiftSnd_eq_evenSnd_castSucc, P_evenSnd] - ring +/-! -lemma P!_evenShiftZero (f : Fin n → ℚ) : P! f (evenShiftZero) = 0 := by - rw [P!, sum_of_charges] - simp [HSMul.hSMul, SMul.smul, basis!_on_evenShiftZero] +### B.8. The inclusion into charges satisfies the linear and cubic ACCs -lemma Pa_evenShitZero (f : Fin n.succ → ℚ) (g : Fin n → ℚ) : Pa f g (evenShiftZero) = f 0 := by - rw [Pa] - simp only [ACCSystemCharges.chargesAddCommMonoid_add] - rw [P!_evenShiftZero, evenShiftZero_eq_evenFst_zero, P_evenFst] - exact Rat.add_zero (f 0) - -lemma P!_evenShiftLast (f : Fin n → ℚ) : P! f evenShiftLast = 0 := by - rw [P!, sum_of_charges] - simp [HSMul.hSMul, SMul.smul, basis!_on_evenShiftLast] - -lemma Pa_evenShiftLast (f : Fin n.succ → ℚ) (g : Fin n → ℚ) : - Pa f g (evenShiftLast) = - f (Fin.last n) := by - rw [Pa] - simp only [ACCSystemCharges.chargesAddCommMonoid_add] - rw [P!_evenShiftLast, evenShiftLast_eq_evenSnd_last, P_evenSnd] - exact Rat.add_zero (-f (Fin.last n)) - -lemma P_evenSnd_evenFst (f : Fin n.succ → ℚ) : P f ∘ evenSnd = - P f ∘ evenFst := by - funext j - simp only [PureU1_numberCharges, Function.comp_apply, Pi.neg_apply] - rw [P_evenFst, P_evenSnd] +-/ lemma P_linearACC (f : Fin n.succ → ℚ) : (accGrav (2 * n.succ)) (P f) = 0 := by rw [accGrav] @@ -452,6 +393,279 @@ lemma P_accCube (f : Fin n.succ → ℚ) : accCube (2 * n.succ) (P f) = 0 := by simp only [succ_eq_add_one, Function.comp_apply, P_evenFst, P_evenSnd] ring +/-! + +### B.9. Kernel of the inclusion into charges + +-/ + +lemma P_zero (f : Fin n.succ → ℚ) (h : P f = 0) : ∀ i, f i = 0 := by + intro i + erw [← P_evenFst f] + rw [h] + rfl + +/-! + +### B.10. The inclusion of the plane into linear solutions + +-/ + +/-- A point in the span of the first part of the basis. -/ +def P' (f : Fin n.succ → ℚ) : (PureU1 (2 * n.succ)).LinSols := ∑ i, f i • basis i + +lemma P'_val (f : Fin n.succ → ℚ) : (P' f).val = P f := by + simp only [succ_eq_add_one, P', P] + funext i + rw [sum_of_anomaly_free_linear, sum_of_charges] + rfl + +/-! + +### B.11. The basis vectors are linearly independent + +-/ + +theorem basis_linear_independent : LinearIndependent ℚ (@basis n) := by + apply Fintype.linearIndependent_iff.mpr + intro f h + change P' f = 0 at h + have h1 : (P' f).val = 0 := + (AddSemiconjBy.eq_zero_iff (ACCSystemLinear.LinSols.val 0) + (congrFun (congrArg HAdd.hAdd (congrArg ACCSystemLinear.LinSols.val (id (Eq.symm h)))) + (ACCSystemLinear.LinSols.val 0))).mp rfl + rw [P'_val] at h1 + exact P_zero f h1 + +/-! + +### B.12. Every vector-like even solution is in the span of the basis of the first plane + +-/ + +lemma vectorLikeEven_in_span (S : (PureU1 (2 * n.succ)).LinSols) + (hS : VectorLikeEven S.val) : ∃ (M : (FamilyPermutations (2 * n.succ)).group), + (FamilyPermutations (2 * n.succ)).linSolRep M S ∈ Submodule.span ℚ (Set.range basis) := by + use (Tuple.sort S.val).symm + change sortAFL S ∈ Submodule.span ℚ (Set.range basis) + rw [Submodule.mem_span_range_iff_exists_fun ℚ] + let f : Fin n.succ → ℚ := fun i => (sortAFL S).val (evenFst i) + use f + apply ACCSystemLinear.LinSols.ext + rw [sortAFL_val] + erw [P'_val] + apply ext_even + · intro i + rw [P_evenFst] + rfl + · intro i + rw [P_evenSnd] + have ht := hS i + change sort S.val (evenFst i) = - sort S.val (evenSnd i) at ht + have h : sort S.val (evenSnd i) = - sort S.val (evenFst i) := by + rw [ht] + ring + rw [h] + rfl + +/-! + +## C. The vectors of the basis spanning the second plane, via the shifted even split + +-/ + +/-- The second part of the basis as charges. -/ +def basis!AsCharges (j : Fin n) : (PureU1 (2 * n.succ)).Charges := + fun i => + if i = evenShiftFst j then + 1 + else + if i = evenShiftSnd j then + - 1 + else + 0 +/-! + +### C.2. Components of the vectors + +-/ + +lemma basis!_on_evenShiftFst_self (j : Fin n) : basis!AsCharges j (evenShiftFst j) = 1 := by + simp [basis!AsCharges] + +lemma basis!_on_other {k : Fin n} {j : Fin (2 * n.succ)} (h1 : j ≠ evenShiftFst k) + (h2 : j ≠ evenShiftSnd k) : basis!AsCharges k j = 0 := by + simp only [basis!AsCharges, succ_eq_add_one, PureU1_numberCharges] + simp_all only [ne_eq, ↓reduceIte] + +lemma basis!_on_evenShiftFst_other {k j : Fin n} (h : k ≠ j) : + basis!AsCharges k (evenShiftFst j) = 0 := by + simp only [basis!AsCharges, succ_eq_add_one, PureU1_numberCharges] + simp only [evenShiftFst, succ_eq_add_one, evenShiftSnd] + split + · rename_i h1 + rw [Fin.ext_iff] at h1 + simp_all + rw [Fin.ext_iff] at h + simp_all + · split + · rename_i h1 h2 + simp_all + rw [Fin.ext_iff] at h2 + simp only [Fin.val_castAdd, Fin.val_addNat] at h2 + omega + · rfl + +lemma basis!_evenShftSnd_eq_neg_evenShiftFst (j i : Fin n) : + basis!AsCharges j (evenShiftSnd i) = - basis!AsCharges j (evenShiftFst i) := by + simp only [basis!AsCharges, succ_eq_add_one, PureU1_numberCharges, evenShiftSnd, evenShiftFst] + split <;> split + any_goals split + any_goals split + any_goals rfl + all_goals + rename_i h1 h2 + rw [Fin.ext_iff] at h1 h2 + simp_all only [Fin.natAdd_eq_addNat, Fin.cast_inj, Fin.val_cast, Fin.val_natAdd, + Fin.val_castAdd, add_right_inj, Fin.val_addNat, add_eq_left] + · subst h1 + exact Fin.elim0 i + all_goals + rename_i h3 + rw [Fin.ext_iff] at h3 + simp_all only [Fin.val_natAdd, Fin.val_castAdd, Fin.val_addNat, not_true_eq_false] + all_goals + omega + +lemma basis!_on_evenShiftSnd_self (j : Fin n) : basis!AsCharges j (evenShiftSnd j) = - 1 := by + rw [basis!_evenShftSnd_eq_neg_evenShiftFst, basis!_on_evenShiftFst_self] + +lemma basis!_on_evenShiftSnd_other {k j : Fin n} (h : k ≠ j) : + basis!AsCharges k (evenShiftSnd j) = 0 := by + rw [basis!_evenShftSnd_eq_neg_evenShiftFst, basis!_on_evenShiftFst_other h] + rfl + +lemma basis!_on_evenShiftZero (j : Fin n) : basis!AsCharges j evenShiftZero = 0 := by + simp only [basis!AsCharges, succ_eq_add_one, PureU1_numberCharges] + split<;> rename_i h + · simp only [evenShiftZero, succ_eq_add_one, Fin.isValue, evenShiftFst, Fin.ext_iff, + Fin.val_cast, Fin.val_castAdd, Fin.val_eq_zero, Fin.val_natAdd] at h + omega + · split <;> rename_i h2 + · simp only [evenShiftZero, succ_eq_add_one, Fin.isValue, evenShiftSnd, Fin.ext_iff, + Fin.val_cast, Fin.val_castAdd, Fin.val_eq_zero, Fin.val_natAdd] at h2 + omega + · rfl + +lemma basis!_on_evenShiftLast (j : Fin n) : basis!AsCharges j evenShiftLast = 0 := by + simp only [basis!AsCharges, succ_eq_add_one, PureU1_numberCharges] + split <;> rename_i h + · rw [Fin.ext_iff] at h + simp only [succ_eq_add_one, evenShiftLast, Fin.isValue, Fin.val_cast, Fin.val_natAdd, + Fin.val_eq_zero, add_zero, evenShiftFst, Fin.val_castAdd, add_right_inj] at h + omega + · split <;> rename_i h2 + · rw [Fin.ext_iff] at h2 + simp only [succ_eq_add_one, evenShiftLast, Fin.isValue, Fin.val_cast, Fin.val_natAdd, + Fin.val_eq_zero, add_zero, evenShiftSnd, Fin.val_castAdd, add_right_inj] at h2 + omega + · rfl + +/-! + +### C.3. The vectors satisfy the linear ACCs + +-/ + +lemma basis!_linearACC (j : Fin n) : (accGrav (2 * n.succ)) (basis!AsCharges j) = 0 := by + rw [accGrav] + simp only [LinearMap.coe_mk, AddHom.coe_mk] + rw [sum_evenShift, basis!_on_evenShiftZero, basis!_on_evenShiftLast] + simp [basis!_evenShftSnd_eq_neg_evenShiftFst] + +/-! + +### C.4. The vectors satisfy the cubic ACC + +-/ + +lemma basis!_accCube (j : Fin n) : + accCube (2 * n.succ) (basis!AsCharges j) = 0 := by + rw [accCube_explicit, sum_evenShift] + rw [basis!_on_evenShiftLast, basis!_on_evenShiftZero] + simp only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, add_zero, Function.comp_apply, + zero_add] + apply Finset.sum_eq_zero + intro i _ + simp only [basis!_evenShftSnd_eq_neg_evenShiftFst] + ring + +/-! + +### C.6. The vectors as linear solutions + +-/ +/-- The second part of the basis as `LinSols`. -/ +@[simps!] +def basis! (j : Fin n) : (PureU1 (2 * n.succ)).LinSols := + ⟨basis!AsCharges j, by + intro i + simp only [succ_eq_add_one, PureU1_numberLinear] at i + match i with + | 0 => + exact basis!_linearACC j⟩ + +/-! + +### C.7. The inclusion of the second plane into charges + +-/ + +/-- A point in the span of the second part of the basis as a charge. -/ +def P! (f : Fin n → ℚ) : (PureU1 (2 * n.succ)).Charges := ∑ i, f i • basis!AsCharges i + +/-! + +### C.8. Components of the inclusion into charges + +-/ + +lemma P!_evenShiftFst (f : Fin n → ℚ) (j : Fin n) : P! f (evenShiftFst j) = f j := by + rw [P!, sum_of_charges] + simp only [HSMul.hSMul, SMul.smul] + rw [Finset.sum_eq_single j] + · rw [basis!_on_evenShiftFst_self] + exact Rat.mul_one (f j) + · intro k _ hkj + rw [basis!_on_evenShiftFst_other hkj] + exact Rat.mul_zero (f k) + · simp only [mem_univ, not_true_eq_false, _root_.mul_eq_zero, IsEmpty.forall_iff] + +lemma P!_evenShiftSnd (f : Fin n → ℚ) (j : Fin n) : P! f (evenShiftSnd j) = - f j := by + rw [P!, sum_of_charges] + simp only [HSMul.hSMul, SMul.smul] + rw [Finset.sum_eq_single j] + · rw [basis!_on_evenShiftSnd_self] + exact mul_neg_one (f j) + · intro k _ hkj + rw [basis!_on_evenShiftSnd_other hkj] + exact Rat.mul_zero (f k) + · simp + +lemma P!_evenShiftZero (f : Fin n → ℚ) : P! f (evenShiftZero) = 0 := by + rw [P!, sum_of_charges] + simp [HSMul.hSMul, SMul.smul, basis!_on_evenShiftZero] + +lemma P!_evenShiftLast (f : Fin n → ℚ) : P! f evenShiftLast = 0 := by + rw [P!, sum_of_charges] + simp [HSMul.hSMul, SMul.smul, basis!_on_evenShiftLast] + +/-! + +### C.9. The inclusion into charges satisfies the cubic ACC + +-/ + lemma P!_accCube (f : Fin n → ℚ) : accCube (2 * n.succ) (P! f) = 0 := by rw [accCube_explicit, sum_evenShift, P!_evenShiftZero, P!_evenShiftLast] simp only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, add_zero, Function.comp_apply, @@ -461,6 +675,104 @@ lemma P!_accCube (f : Fin n → ℚ) : accCube (2 * n.succ) (P! f) = 0 := by simp only [P!_evenShiftFst, P!_evenShiftSnd] ring +/-! + +### C.10. Kernel of the inclusion into charges + +-/ + +lemma P!_zero (f : Fin n → ℚ) (h : P! f = 0) : ∀ i, f i = 0 := by + intro i + rw [← P!_evenShiftFst f] + rw [h] + rfl + +/-! + +### C.11. The inclusion of the second plane into the span of the basis + +-/ + +lemma P!_in_span (f : Fin n → ℚ) : P! f ∈ Submodule.span ℚ (Set.range basis!AsCharges) := by + rw [(Submodule.mem_span_range_iff_exists_fun ℚ)] + use f + rfl + +/-! + +### C.12. The inclusion of the plane into linear solutions + +-/ + +/-- A point in the span of the second part of the basis. -/ +def P!' (f : Fin n → ℚ) : (PureU1 (2 * n.succ)).LinSols := ∑ i, f i • basis! i + +lemma P!'_val (f : Fin n → ℚ) : (P!' f).val = P! f := by + simp only [succ_eq_add_one, P!', P!] + funext i + rw [sum_of_anomaly_free_linear, sum_of_charges] + rfl + +/-! + +### C.13. The basis vectors are linearly independent + +-/ + +theorem basis!_linear_independent : LinearIndependent ℚ (@basis! n) := by + apply Fintype.linearIndependent_iff.mpr + intro f h + change P!' f = 0 at h + have h1 : (P!' f).val = 0 := + (AddSemiconjBy.eq_zero_iff (ACCSystemLinear.LinSols.val 0) + (congrFun (congrArg HAdd.hAdd (congrArg ACCSystemLinear.LinSols.val (id (Eq.symm h)))) + (ACCSystemLinear.LinSols.val 0))).mp rfl + rw [P!'_val] at h1 + exact P!_zero f h1 + +/-! + +### C.14. Properties of the basis vectors relating to the span + +-/ + +lemma smul_basis!AsCharges_in_span (S : (PureU1 (2 * n.succ)).LinSols) (j : Fin n) : + (S.val (evenShiftSnd j) - S.val (evenShiftFst j)) • basis!AsCharges j ∈ + Submodule.span ℚ (Set.range basis!AsCharges) := by + apply Submodule.smul_mem + apply SetLike.mem_of_subset + · exact Submodule.subset_span + · simp_all only [Set.mem_range, exists_apply_eq_apply] + +/-! + +### C.15. Permutations as additions of basis vectors + +-/ + +/-- Swapping the elements evenShiftFst j and evenShiftSnd j is equivalent to + adding a vector basis!AsCharges j. -/ +lemma swap!_as_add {S S' : (PureU1 (2 * n.succ)).LinSols} (j : Fin n) + (hS : ((FamilyPermutations (2 * n.succ)).linSolRep + (Equiv.swap (evenShiftFst j) (evenShiftSnd j))) S = S') : + S'.val = S.val + (S.val (evenShiftSnd j) - S.val (evenShiftFst j)) • basis!AsCharges j := by + funext i + rw [← hS, FamilyPermutations_anomalyFreeLinear_apply] + by_cases hi : i = evenShiftFst j + · subst hi + simp [HSMul.hSMul, basis!_on_evenShiftFst_self, Equiv.swap_apply_left] + · by_cases hi2 : i = evenShiftSnd j + · simp [HSMul.hSMul, hi2, basis!_on_evenShiftSnd_self, Equiv.swap_apply_right] + · simp only [succ_eq_add_one, Equiv.invFun_as_coe, HSMul.hSMul, + ACCSystemCharges.chargesAddCommMonoid_add, ACCSystemCharges.chargesModule_smul] + rw [basis!_on_other hi hi2] + aesop +/-! + +## D. Mixed cubic ACCs involving points from both planes + +-/ + lemma P_P_P!_accCube (g : Fin n.succ → ℚ) (j : Fin n) : accCubeTriLinSymm (P g) (P g) (basis!AsCharges j) = g (j.succ) ^ 2 - g (j.castSucc) ^ 2 := by @@ -492,17 +804,69 @@ lemma P_P!_P!_accCube (g : Fin n → ℚ) (j : Fin n.succ) : simp only [mul_zero, add_zero] · simp -lemma P_zero (f : Fin n.succ → ℚ) (h : P f = 0) : ∀ i, f i = 0 := by - intro i - erw [← P_evenFst f] - rw [h] - rfl +/-! -lemma P!_zero (f : Fin n → ℚ) (h : P! f = 0) : ∀ i, f i = 0 := by - intro i - rw [← P!_evenShiftFst f] - rw [h] - rfl +## E. The combined basis + +-/ + +/-! + +### E.1. As a map into linear solutions + +-/ +/-- The whole basis as `LinSols`. -/ +def basisa : (Fin n.succ) ⊕ (Fin n) → (PureU1 (2 * n.succ)).LinSols := fun i => + match i with + | .inl i => basis i + | .inr i => basis! i + +/-! + +### E.2. Inclusion of the span of the basis into charges + +-/ + +/-- A point in the span of the basis as a charge. -/ +def Pa (f : Fin n.succ → ℚ) (g : Fin n → ℚ) : (PureU1 (2 * n.succ)).Charges := P f + P! g + +/-! + +### E.3. Components of the inclusion into charges + +-/ + +lemma Pa_evenShiftFst (f : Fin n.succ → ℚ) (g : Fin n → ℚ) (j : Fin n) : + Pa f g (evenShiftFst j) = f j.succ + g j := by + rw [Pa] + simp only [ACCSystemCharges.chargesAddCommMonoid_add] + rw [P!_evenShiftFst, evenShiftFst_eq_evenFst_succ, P_evenFst] + +lemma Pa_evenShiftSnd (f : Fin n.succ → ℚ) (g : Fin n → ℚ) (j : Fin n) : + Pa f g (evenShiftSnd j) = - f j.castSucc - g j := by + rw [Pa] + simp only [ACCSystemCharges.chargesAddCommMonoid_add] + rw [P!_evenShiftSnd, evenShiftSnd_eq_evenSnd_castSucc, P_evenSnd] + ring + +lemma Pa_evenShitZero (f : Fin n.succ → ℚ) (g : Fin n → ℚ) : Pa f g (evenShiftZero) = f 0 := by + rw [Pa] + simp only [ACCSystemCharges.chargesAddCommMonoid_add] + rw [P!_evenShiftZero, evenShiftZero_eq_evenFst_zero, P_evenFst] + exact Rat.add_zero (f 0) + +lemma Pa_evenShiftLast (f : Fin n.succ → ℚ) (g : Fin n → ℚ) : + Pa f g (evenShiftLast) = - f (Fin.last n) := by + rw [Pa] + simp only [ACCSystemCharges.chargesAddCommMonoid_add] + rw [P!_evenShiftLast, evenShiftLast_eq_evenSnd_last, P_evenSnd] + exact Rat.add_zero (-f (Fin.last n)) + +/-! + +### E.4. Kernel of the inclusion into charges + +-/ lemma Pa_zero (f : Fin n.succ → ℚ) (g : Fin n → ℚ) (h : Pa f g = 0) : ∀ i, f i = 0 := by @@ -534,12 +898,11 @@ lemma Pa_zero! (f : Fin n.succ → ℚ) (g : Fin n → ℚ) (h : Pa f g = 0) : simp only [succ_eq_add_one, hf, zero_smul, sum_const_zero, zero_add] at h exact P!_zero g h -/-- A point in the span of the first part of the basis. -/ -def P' (f : Fin n.succ → ℚ) : (PureU1 (2 * n.succ)).LinSols := ∑ i, f i • basis i +/-! -/-- A point in the span of the second part of the basis. -/ -def P!' (f : Fin n → ℚ) : (PureU1 (2 * n.succ)).LinSols := ∑ i, f i • basis! i +### E.5. The inclusion of the span of the basis into linear solutions +-/ /-- A point in the span of the whole basis. -/ def Pa' (f : (Fin n.succ) ⊕ (Fin n) → ℚ) : (PureU1 (2 * n.succ)).LinSols := ∑ i, f i • basisa i @@ -548,39 +911,11 @@ lemma Pa'_P'_P!' (f : (Fin n.succ) ⊕ (Fin n) → ℚ) : Pa' f = P' (f ∘ Sum.inl) + P!' (f ∘ Sum.inr) := by exact Fintype.sum_sum_type _ -lemma P'_val (f : Fin n.succ → ℚ) : (P' f).val = P f := by - simp only [succ_eq_add_one, P', P] - funext i - rw [sum_of_anomaly_free_linear, sum_of_charges] - rfl - -lemma P!'_val (f : Fin n → ℚ) : (P!' f).val = P! f := by - simp only [succ_eq_add_one, P!', P!] - funext i - rw [sum_of_anomaly_free_linear, sum_of_charges] - rfl +/-! -theorem basis_linear_independent : LinearIndependent ℚ (@basis n) := by - apply Fintype.linearIndependent_iff.mpr - intro f h - change P' f = 0 at h - have h1 : (P' f).val = 0 := - (AddSemiconjBy.eq_zero_iff (ACCSystemLinear.LinSols.val 0) - (congrFun (congrArg HAdd.hAdd (congrArg ACCSystemLinear.LinSols.val (id (Eq.symm h)))) - (ACCSystemLinear.LinSols.val 0))).mp rfl - rw [P'_val] at h1 - exact P_zero f h1 +### E.6. The combined basis vectors are linearly independent -theorem basis!_linear_independent : LinearIndependent ℚ (@basis! n) := by - apply Fintype.linearIndependent_iff.mpr - intro f h - change P!' f = 0 at h - have h1 : (P!' f).val = 0 := - (AddSemiconjBy.eq_zero_iff (ACCSystemLinear.LinSols.val 0) - (congrFun (congrArg HAdd.hAdd (congrArg ACCSystemLinear.LinSols.val (id (Eq.symm h)))) - (ACCSystemLinear.LinSols.val 0))).mp rfl - rw [P!'_val] at h1 - exact P!_zero f h1 +-/ theorem basisa_linear_independent : LinearIndependent ℚ (@basisa n) := by apply Fintype.linearIndependent_iff.mpr @@ -601,6 +936,11 @@ theorem basisa_linear_independent : LinearIndependent ℚ (@basisa n) := by cases i · simp_all · simp_all +/-! + +### E.7. Injectivity of the inclusion into linear solutions + +-/ lemma Pa'_eq (f f' : (Fin n.succ) ⊕ (Fin n) → ℚ) : Pa' f = Pa' f' ↔ f = f' := by refine Iff.intro (fun h => (funext (fun i => ?_))) (fun h => ?_) @@ -618,24 +958,10 @@ lemma Pa'_eq (f f' : (Fin n.succ) ⊕ (Fin n) → ℚ) : Pa' f = Pa' f' ↔ f = linarith · rw [h] -TODO "6VZTB" "Replace the definition of `join` with a Mathlib definition, most likely `Sum.elim`." -/-- A helper function for what follows. -/ -def join (g : Fin n.succ → ℚ) (f : Fin n → ℚ) : (Fin n.succ) ⊕ (Fin n) → ℚ := fun i => - match i with - | .inl i => g i - | .inr i => f i - -lemma join_ext (g g' : Fin n.succ → ℚ) (f f' : Fin n → ℚ) : - join g f = join g' f' ↔ g = g' ∧ f = f' := by - refine Iff.intro (fun h => ?_) (fun h => ?_) - · apply And.intro (funext (fun i => congr_fun h (Sum.inl i))) - (funext (fun i => congr_fun h (Sum.inr i))) - · rw [h.left, h.right] - -lemma join_Pa (g g' : Fin n.succ → ℚ) (f f' : Fin n → ℚ) : - Pa' (join g f) = Pa' (join g' f') ↔ Pa g f = Pa g' f' := by +lemma Pa'_elim_eq_iff (g g' : Fin n.succ → ℚ) (f f' : Fin n → ℚ) : + Pa' (Sum.elim g f) = Pa' (Sum.elim g' f') ↔ Pa g f = Pa g' f' := by refine Iff.intro (fun h => ?_) (fun h => ?_) - · rw [Pa'_eq, join_ext] at h + · rw [Pa'_eq, Sum.elim_eq_iff] at h rw [h.left, h.right] · apply ACCSystemLinear.LinSols.ext rw [Pa'_P'_P!', Pa'_P'_P!'] @@ -644,20 +970,38 @@ lemma join_Pa (g g' : Fin n.succ → ℚ) (f f' : Fin n → ℚ) : lemma Pa_eq (g g' : Fin n.succ → ℚ) (f f' : Fin n → ℚ) : Pa g f = Pa g' f' ↔ g = g' ∧ f = f' := by - rw [← join_Pa, ← join_ext] + rw [← Pa'_elim_eq_iff, ← Sum.elim_eq_iff] exact Pa'_eq _ _ +/-! + +### E.8. Cardinality of the basis + +-/ + lemma basisa_card : Fintype.card ((Fin n.succ) ⊕ (Fin n)) = Module.finrank ℚ (PureU1 (2 * n.succ)).LinSols := by erw [BasisLinear.finrank_AnomalyFreeLinear] simp only [Fintype.card_sum, Fintype.card_fin, mul_eq] exact split_odd n +/-! + +### E.9. The basis vectors as a basis + +-/ + /-- The basis formed out of our `basisa` vectors. -/ noncomputable def basisaAsBasis : Basis (Fin (succ n) ⊕ Fin n) ℚ (PureU1 (2 * succ n)).LinSols := basisOfLinearIndependentOfCardEqFinrank (@basisa_linear_independent n) basisa_card +/-! + +## F. Every Lienar solution is the sum of a point from each plane + +-/ + lemma span_basis (S : (PureU1 (2 * n.succ)).LinSols) : ∃ (g : Fin n.succ → ℚ) (f : Fin n → ℚ), S.val = P g + P! f := by have h := (Submodule.mem_span_range_iff_exists_fun ℚ).mp (Basis.mem_span basisaAsBasis S) @@ -671,22 +1015,14 @@ lemma span_basis (S : (PureU1 (2 * n.succ)).LinSols) : simp only [succ_eq_add_one, ACCSystemLinear.linSolsAddCommMonoid_add_val, P'_val, P!'_val] rfl -lemma P!_in_span (f : Fin n → ℚ) : P! f ∈ Submodule.span ℚ (Set.range basis!AsCharges) := by - rw [(Submodule.mem_span_range_iff_exists_fun ℚ)] - use f - rfl +/-! -lemma smul_basis!AsCharges_in_span (S : (PureU1 (2 * n.succ)).LinSols) (j : Fin n) : - (S.val (evenShiftSnd j) - S.val (evenShiftFst j)) • basis!AsCharges j ∈ - Submodule.span ℚ (Set.range basis!AsCharges) := by - apply Submodule.smul_mem - apply SetLike.mem_of_subset - · exact Submodule.subset_span - · simp_all only [Set.mem_range, exists_apply_eq_apply] +### F.1. Relation under permutations +-/ lemma span_basis_swap! {S : (PureU1 (2 * n.succ)).LinSols} (j : Fin n) (hS : ((FamilyPermutations (2 * n.succ)).linSolRep - (pairSwap (evenShiftFst j) (evenShiftSnd j))) S = S') (g : Fin n.succ → ℚ) (f : Fin n → ℚ) + (Equiv.swap (evenShiftFst j) (evenShiftSnd j))) S = S') (g : Fin n.succ → ℚ) (f : Fin n → ℚ) (h : S.val = P g + P! f) : ∃ (g' : Fin n.succ → ℚ) (f' : Fin n → ℚ), S'.val = P g' + P! f' ∧ P! f' = P! f + (S.val (evenShiftSnd j) - S.val (evenShiftFst j)) • basis!AsCharges j ∧ g' = g := by @@ -706,31 +1042,6 @@ lemma span_basis_swap! {S : (PureU1 (2 * n.succ)).LinSols} (j : Fin n) apply swap!_as_add at hS exact hS -lemma vectorLikeEven_in_span (S : (PureU1 (2 * n.succ)).LinSols) - (hS : VectorLikeEven S.val) : ∃ (M : (FamilyPermutations (2 * n.succ)).group), - (FamilyPermutations (2 * n.succ)).linSolRep M S ∈ Submodule.span ℚ (Set.range basis) := by - use (Tuple.sort S.val).symm - change sortAFL S ∈ Submodule.span ℚ (Set.range basis) - rw [Submodule.mem_span_range_iff_exists_fun ℚ] - let f : Fin n.succ → ℚ := fun i => (sortAFL S).val (evenFst i) - use f - apply ACCSystemLinear.LinSols.ext - rw [sortAFL_val] - erw [P'_val] - apply ext_even - · intro i - rw [P_evenFst] - rfl - · intro i - rw [P_evenSnd] - have ht := hS i - change sort S.val (evenFst i) = - sort S.val (evenSnd i) at ht - have h : sort S.val (evenSnd i) = - sort S.val (evenFst i) := by - rw [ht] - ring - rw [h] - rfl - end VectorLikeEvenPlane end PureU1 diff --git a/PhysLean/QFT/QED/AnomalyCancellation/Even/LineInCubic.lean b/PhysLean/QFT/QED/AnomalyCancellation/Even/LineInCubic.lean index 218c7b3d5..4d5a5da98 100644 --- a/PhysLean/QFT/QED/AnomalyCancellation/Even/LineInCubic.lean +++ b/PhysLean/QFT/QED/AnomalyCancellation/Even/LineInCubic.lean @@ -97,14 +97,14 @@ lemma lineInCubicPerm_swap {S : (PureU1 (2 * n.succ)).LinSols} * accCubeTriLinSymm (P g) (P g) (basis!AsCharges j) = 0 := by intro j g f h let S' := (FamilyPermutations (2 * n.succ)).linSolRep - (pairSwap (evenShiftFst j) (evenShiftSnd j)) S + (Equiv.swap (evenShiftFst j) (evenShiftSnd j)) S have hSS' : ((FamilyPermutations (2 * n.succ)).linSolRep - (pairSwap (evenShiftFst j) (evenShiftSnd j))) S = S' := rfl + (Equiv.swap (evenShiftFst j) (evenShiftSnd j))) S = S' := rfl obtain ⟨g', f', hall⟩ := span_basis_swap! j hSS' g f h have h1 := line_in_cubic_P_P_P! (lineInCubicPerm_self LIC) g f h have h2 := line_in_cubic_P_P_P! (lineInCubicPerm_self (lineInCubicPerm_permute LIC - (pairSwap (evenShiftFst j) (evenShiftSnd j)))) g' f' hall.1 + (Equiv.swap (evenShiftFst j) (evenShiftSnd j)))) g' f' hall.1 rw [hall.2.1, hall.2.2] at h2 rw [accCubeTriLinSymm.map_add₃, h1, accCubeTriLinSymm.map_smul₃] at h2 simpa using h2 @@ -158,7 +158,7 @@ lemma lineInCubicPerm_last_perm {S : (PureU1 (2 * n.succ.succ)).LinSols} · simp [Fin.ext_iff, evenShiftSnd, evenShiftFst] · simp [Fin.ext_iff, evenShiftSnd, evenShiftLast] · simp only [Nat.succ_eq_add_one, evenShiftFst, evenShiftLast, Fin.isValue, ne_eq, Fin.ext_iff, - Fin.coe_cast, Fin.coe_natAdd, Fin.coe_castAdd, Fin.val_last, Fin.val_eq_zero, add_zero, + Fin.val_cast, Fin.val_natAdd, Fin.val_castAdd, Fin.val_last, Fin.val_eq_zero, add_zero, add_right_inj] omega · exact fun M => lineInCubicPerm_last_cond (lineInCubicPerm_permute LIC M) diff --git a/PhysLean/QFT/QED/AnomalyCancellation/LineInPlaneCond.lean b/PhysLean/QFT/QED/AnomalyCancellation/LineInPlaneCond.lean index a66f76921..a8f969fa0 100644 --- a/PhysLean/QFT/QED/AnomalyCancellation/LineInPlaneCond.lean +++ b/PhysLean/QFT/QED/AnomalyCancellation/LineInPlaneCond.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.QFT.QED.AnomalyCancellation.ConstAbs -import Mathlib.Tactic.FieldSimp /-! # Line in plane condition @@ -61,9 +60,9 @@ lemma lineInPlaneCond_eq_last' {S : (PureU1 (n.succ.succ)).LinSols} (hS : LineIn (by simp only [Fin.ext_iff, Nat.succ_eq_add_one, Fin.succ_last, ne_eq] exact Nat.ne_add_one ↑(Fin.last n).castSucc) (by simp only [Nat.succ_eq_add_one, Fin.succ_last, ne_eq, Fin.ext_iff, Fin.val_last, - Fin.coe_castSucc] + Fin.val_castSucc] omega) - (by simp only [Nat.succ_eq_add_one, ne_eq, Fin.ext_iff, Fin.coe_castSucc, Fin.val_last] + (by simp only [Nat.succ_eq_add_one, ne_eq, Fin.ext_iff, Fin.val_castSucc, Fin.val_last] omega) simp_all only [Nat.succ_eq_add_one, ne_eq, Fin.succ_last, false_or, neg_add_rev] field_simp diff --git a/PhysLean/QFT/QED/AnomalyCancellation/Odd/BasisLinear.lean b/PhysLean/QFT/QED/AnomalyCancellation/Odd/BasisLinear.lean index b37e3899f..cf468002f 100644 --- a/PhysLean/QFT/QED/AnomalyCancellation/Odd/BasisLinear.lean +++ b/PhysLean/QFT/QED/AnomalyCancellation/Odd/BasisLinear.lean @@ -6,10 +6,69 @@ Authors: Joseph Tooby-Smith import PhysLean.QFT.QED.AnomalyCancellation.BasisLinear import PhysLean.QFT.QED.AnomalyCancellation.VectorLike /-! -# Basis of `LinSols` in the odd case +# Splitting the linear solutions in the odd case into two ACC-satisfying planes + +## i. Overview + +We split the linear solutions of `PureU1 (2 * n + 1)` into two planes, +where every point in either plane satisfies both the linear and cubic anomaly cancellation +conditions. + +## ii. Key results + +- `P'` : The inclusion of the first plane into linear solutions +- `P_accCube` : The statement that chares from the first plane satisfy the cubic ACC +- `P!'` : The inclusion of the second plane. +- `P!_accCube` : The statement that charges from the second plane satisfy the cubic ACC +- `span_basis` : Every linear solution is the sum of a point from each plane. + +## iii. Table of contents + +- A. Splitting the charges up into groups + - A.1. The symmetric split: Spltting the charges up via `(n + 1) + 1` + - A.2. The shifted split: Spltting the charges up via `1 + n + n` + - A.3. The shifte shifted split: Spltting the charges up via `((1+n)+1) + n.succ` + - A.4. Relating the splittings together +- B. The first plane + - B.1. The basis vectors of the first plane as charges + - B.2. Components of the basis vectors as charges + - B.3. The basis vectors satisfy the linear ACCs + - B.4. The basis vectors as `LinSols` + - B.5. The inclusion of the first plane into charges + - B.6. Components of the first plane + - B.7. Points on the first plane satisfies the ACCs + - B.8. Kernel of the inclusion into charges + - B.9. The basis vectors are linearly independent +- C. The second plane + - C.1. The basis vectors of the second plane as charges + - C.2. Components of the basis vectors as charges + - C.3. The basis vectors satisfy the linear ACCs + - C.4. The basis vectors as `LinSols` + - C.5. Permutations equal adding basis vectors + - C.6. The inclusion of the second plane into charges + - C.7. Components of the second plane + - C.8. Points on the second plane satisfies the ACCs + - C.9. Kernel of the inclusion into charges + - C.10. The inclusion of the second plane into LinSols + - C.11. The basis vectors are linearly independent +- D. The mixed cubic ACC from points in both planes +- E. The combined basis + - E.1. The combined basis as `LinSols` + - E.2. The inclusion of the span of the combined basis into charges + - E.3. Components of the inclusion + - E.4. Kernel of the inclusion into charges + - E.5. The inclusion of the span of the combined basis into LinSols + - E.6. The combined basis vectors are linearly independent + - E.7. Injectivity of the inclusion into linear solutions + - E.8. Cardinality of the basis + - E.9. The basis vectors as a basis +- F. Every Lienar solution is the sum of a point from each plane + - F.1. Relation under permutations + +## iv. References + +- https://arxiv.org/pdf/1912.04804.pdf -We give a basis of `LinSols` in the odd case. This basis has the special property -that splits into two planes on which every point is a solution to the ACCs. -/ open Module Nat Finset BigOperators @@ -20,14 +79,32 @@ variable {n : ℕ} namespace VectorLikeOddPlane -lemma odd_shift_eq (n : ℕ) : (1 + n) + n = 2 * n +1 := by - omega +/-! -lemma odd_shift_shift_eq (n : ℕ) : ((1+n)+1) + n.succ = 2 * n.succ + 1 := by - omega +## A. Splitting the charges up into groups + +We have `2 * n + 1` charges, which we split up in the following ways: + +`| evenFst j (0 to n) | evenSnd j (n.succ to n + n.succ)|` + +``` +| evenShiftZero (0) | evenShiftFst j (1 to n) | + evenShiftSnd j (n.succ to 2 * n) | evenShiftLast (2 * n.succ - 1) | +``` + +-/ section theDeltas +/-! + +### A.1. The symmetric split: Spltting the charges up via `(n + 1) + 1` + +-/ + +lemma odd_shift_eq (n : ℕ) : (1 + n) + n = 2 * n +1 := by + omega + /-- The inclusion of `Fin n` into `Fin ((n + 1) + n)` via the first `n`. This is then casted to `Fin (2 * n + 1)`. -/ def oddFst (j : Fin n) : Fin (2 * n + 1) := @@ -43,6 +120,27 @@ def oddSnd (j : Fin n) : Fin (2 * n + 1) := def oddMid : Fin (2 * n + 1) := Fin.cast (split_odd n) (Fin.castAdd n (Fin.natAdd n 1)) +lemma sum_odd (S : Fin (2 * n + 1) → ℚ) : + ∑ i, S i = S oddMid + ∑ i : Fin n, ((S ∘ oddFst) i + (S ∘ oddSnd) i) := by + have h1 : ∑ i, S i = ∑ i : Fin (n + 1 + n), S (Fin.cast (split_odd n) i) := by + rw [Finset.sum_equiv (Fin.castOrderIso (split_odd n)).symm.toEquiv] + · intro i + simp only [mem_univ, Fin.symm_castOrderIso, RelIso.coe_fn_toEquiv] + · exact fun _ _ => rfl + rw [h1] + rw [Fin.sum_univ_add, Fin.sum_univ_add] + simp only [univ_unique, Fin.default_eq_zero, Fin.isValue, sum_singleton, Function.comp_apply] + nth_rewrite 2 [add_comm] + rw [add_assoc] + rw [Finset.sum_add_distrib] + rfl + +/-! + +### A.2. The shifted split: Spltting the charges up via `1 + n + n` + +-/ + /-- The inclusion of `Fin n` into `Fin (1 + n + n)` via the first `n`. This is then casted to `Fin (2 * n + 1)`. -/ def oddShiftFst (j : Fin n) : Fin (2 * n + 1) := @@ -58,6 +156,27 @@ def oddShiftSnd (j : Fin n) : Fin (2 * n + 1) := def oddShiftZero : Fin (2 * n + 1) := Fin.cast (odd_shift_eq n) (Fin.castAdd n (Fin.castAdd n 1)) +lemma sum_oddShift (S : Fin (2 * n + 1) → ℚ) : + ∑ i, S i = S oddShiftZero + ∑ i : Fin n, ((S ∘ oddShiftFst) i + (S ∘ oddShiftSnd) i) := by + have h1 : ∑ i, S i = ∑ i : Fin ((1+n)+n), S (Fin.cast (odd_shift_eq n) i) := by + rw [Finset.sum_equiv (Fin.castOrderIso (odd_shift_eq n)).symm.toEquiv] + · intro i + simp only [mem_univ, Fin.castOrderIso, RelIso.coe_fn_toEquiv] + · exact fun _ _ => rfl + rw [h1, Fin.sum_univ_add, Fin.sum_univ_add] + simp only [univ_unique, Fin.default_eq_zero, Fin.isValue, sum_singleton, Function.comp_apply] + rw [add_assoc, Finset.sum_add_distrib] + rfl + +/-! + +### A.3. The shifte shifted split: Spltting the charges up via `((1+n)+1) + n.succ` + +-/ + +lemma odd_shift_shift_eq (n : ℕ) : ((1+n)+1) + n.succ = 2 * n.succ + 1 := by + omega + /-- The element representing the first `1` in `Fin (1 + n + 1 + n.succ)` casted to `Fin (2 * n.succ + 1)`. -/ def oddShiftShiftZero : Fin (2 * n.succ + 1) := @@ -78,6 +197,11 @@ def oddShiftShiftMid : Fin (2 * n.succ + 1) := def oddShiftShiftSnd (j : Fin n.succ) : Fin (2 * n.succ + 1) := Fin.cast (odd_shift_shift_eq n) (Fin.natAdd ((1+n)+1) j) +/-! + +### A.4. Relating the splittings together + +-/ lemma oddShiftShiftZero_eq_oddFst_zero : @oddShiftShiftZero n = oddFst 0 := Fin.rev_inj.mp rfl @@ -86,7 +210,7 @@ lemma oddShiftShiftZero_eq_oddShiftZero : @oddShiftShiftZero n = oddShiftZero := lemma oddShiftShiftFst_eq_oddFst_succ (j : Fin n) : oddShiftShiftFst j = oddFst j.succ := by rw [Fin.ext_iff] - simp only [succ_eq_add_one, oddShiftShiftFst, Fin.coe_cast, Fin.coe_castAdd, Fin.coe_natAdd, + simp only [succ_eq_add_one, oddShiftShiftFst, Fin.val_cast, Fin.val_castAdd, Fin.val_natAdd, oddFst, Fin.val_succ] exact Nat.add_comm 1 ↑j @@ -96,8 +220,8 @@ lemma oddShiftShiftFst_eq_oddShiftFst_castSucc (j : Fin n) : lemma oddShiftShiftMid_eq_oddMid : @oddShiftShiftMid n = oddMid := by rw [Fin.ext_iff] - simp only [succ_eq_add_one, oddShiftShiftMid, Fin.isValue, Fin.coe_cast, Fin.coe_castAdd, - Fin.coe_natAdd, Fin.val_eq_zero, add_zero, oddMid] + simp only [succ_eq_add_one, oddShiftShiftMid, Fin.isValue, Fin.val_cast, Fin.val_castAdd, + Fin.val_natAdd, Fin.val_eq_zero, add_zero, oddMid] exact Nat.add_comm 1 n lemma oddShiftShiftMid_eq_oddShiftFst_last : oddShiftShiftMid = oddShiftFst (Fin.last n) := by @@ -105,7 +229,7 @@ lemma oddShiftShiftMid_eq_oddShiftFst_last : oddShiftShiftMid = oddShiftFst (Fin lemma oddShiftShiftSnd_eq_oddSnd (j : Fin n.succ) : oddShiftShiftSnd j = oddSnd j := by rw [Fin.ext_iff] - simp only [succ_eq_add_one, oddShiftShiftSnd, Fin.coe_cast, Fin.coe_natAdd, oddSnd, add_left_inj] + simp only [succ_eq_add_one, oddShiftShiftSnd, Fin.val_cast, Fin.val_natAdd, oddSnd, add_left_inj] exact Nat.add_comm 1 n lemma oddShiftShiftSnd_eq_oddShiftSnd (j : Fin n.succ) : oddShiftShiftSnd j = oddShiftSnd j := by @@ -114,39 +238,22 @@ lemma oddShiftShiftSnd_eq_oddShiftSnd (j : Fin n.succ) : oddShiftShiftSnd j = od lemma oddSnd_eq_oddShiftSnd (j : Fin n) : oddSnd j = oddShiftSnd j := by rw [Fin.ext_iff] - simp only [oddSnd, Fin.coe_cast, Fin.coe_natAdd, oddShiftSnd, add_left_inj] + simp only [oddSnd, Fin.val_cast, Fin.val_natAdd, oddShiftSnd, add_left_inj] exact Nat.add_comm n 1 -lemma sum_odd (S : Fin (2 * n + 1) → ℚ) : - ∑ i, S i = S oddMid + ∑ i : Fin n, ((S ∘ oddFst) i + (S ∘ oddSnd) i) := by - have h1 : ∑ i, S i = ∑ i : Fin (n + 1 + n), S (Fin.cast (split_odd n) i) := by - rw [Finset.sum_equiv (Fin.castOrderIso (split_odd n)).symm.toEquiv] - · intro i - simp only [mem_univ, Fin.symm_castOrderIso, RelIso.coe_fn_toEquiv] - · exact fun _ _ => rfl - rw [h1] - rw [Fin.sum_univ_add, Fin.sum_univ_add] - simp only [univ_unique, Fin.default_eq_zero, Fin.isValue, sum_singleton, Function.comp_apply] - nth_rewrite 2 [add_comm] - rw [add_assoc] - rw [Finset.sum_add_distrib] - rfl +end theDeltas -lemma sum_oddShift (S : Fin (2 * n + 1) → ℚ) : - ∑ i, S i = S oddShiftZero + ∑ i : Fin n, ((S ∘ oddShiftFst) i + (S ∘ oddShiftSnd) i) := by - have h1 : ∑ i, S i = ∑ i : Fin ((1+n)+n), S (Fin.cast (odd_shift_eq n) i) := by - rw [Finset.sum_equiv (Fin.castOrderIso (odd_shift_eq n)).symm.toEquiv] - · intro i - simp only [mem_univ, Fin.castOrderIso, RelIso.coe_fn_toEquiv] - · exact fun _ _ => rfl - rw [h1, Fin.sum_univ_add, Fin.sum_univ_add] - simp only [univ_unique, Fin.default_eq_zero, Fin.isValue, sum_singleton, Function.comp_apply] - rw [add_assoc, Finset.sum_add_distrib] - rfl +/-! -end theDeltas +## B. The first plane + +-/ -section theBasisVectors +/-! + +### B.1. The basis vectors of the first plane as charges + +-/ /-- The first part of the basis as charge assignments. -/ def basisAsCharges (j : Fin n) : (PureU1 (2 * n + 1)).Charges := @@ -159,23 +266,15 @@ def basisAsCharges (j : Fin n) : (PureU1 (2 * n + 1)).Charges := else 0 -/-- The second part of the basis as charge assignments. -/ -def basis!AsCharges (j : Fin n) : (PureU1 (2 * n + 1)).Charges := - fun i => - if i = oddShiftFst j then - 1 - else - if i = oddShiftSnd j then - - 1 - else - 0 +/-! + +### B.2. Components of the basis vectors as charges + +-/ lemma basis_on_oddFst_self (j : Fin n) : basisAsCharges j (oddFst j) = 1 := by simp [basisAsCharges] -lemma basis!_on_oddShiftFst_self (j : Fin n) : basis!AsCharges j (oddShiftFst j) = 1 := by - simp [basis!AsCharges] - lemma basis_on_oddFst_other {k j : Fin n} (h : k ≠ j) : basisAsCharges k (oddFst j) = 0 := by simp only [basisAsCharges, PureU1_numberCharges] @@ -190,39 +289,15 @@ lemma basis_on_oddFst_other {k j : Fin n} (h : k ≠ j) : · rename_i h1 h2 simp_all rw [Fin.ext_iff] at h2 - simp only [Fin.coe_castAdd, Fin.coe_natAdd] at h2 + simp only [Fin.val_castAdd, Fin.val_natAdd] at h2 omega · rfl -lemma basis!_on_oddShiftFst_other {k j : Fin n} (h : k ≠ j) : - basis!AsCharges k (oddShiftFst j) = 0 := by - simp only [basis!AsCharges, PureU1_numberCharges] - simp only [oddShiftFst, oddShiftSnd] - split - · rename_i h1 - rw [Fin.ext_iff] at h1 - simp_all - rw [Fin.ext_iff] at h - simp_all - · split - · rename_i h1 h2 - simp_all - rw [Fin.ext_iff] at h2 - simp only [Fin.coe_castAdd, Fin.coe_natAdd] at h2 - omega - rfl - lemma basis_on_other {k : Fin n} {j : Fin (2 * n + 1)} (h1 : j ≠ oddFst k) (h2 : j ≠ oddSnd k) : basisAsCharges k j = 0 := by simp only [basisAsCharges, PureU1_numberCharges] simp_all only [ne_eq, ↓reduceIte] -lemma basis!_on_other {k : Fin n} {j : Fin (2 * n + 1)} - (h1 : j ≠ oddShiftFst k) (h2 : j ≠ oddShiftSnd k) : - basis!AsCharges k j = 0 := by - simp only [basis!AsCharges, PureU1_numberCharges] - simp_all only [ne_eq, ↓reduceIte] - lemma basis_oddSnd_eq_minus_oddFst (j i : Fin n) : basisAsCharges j (oddSnd i) = - basisAsCharges j (oddFst i) := by simp only [basisAsCharges, PureU1_numberCharges, oddSnd, oddFst] @@ -233,75 +308,42 @@ lemma basis_oddSnd_eq_minus_oddFst (j i : Fin n) : all_goals rename_i h1 h2 rw [Fin.ext_iff] at h1 h2 - simp_all only [Fin.cast_inj, Fin.coe_cast, Fin.coe_castAdd, Fin.coe_natAdd, neg_neg, + simp_all only [Fin.cast_inj, Fin.val_cast, Fin.val_castAdd, Fin.val_natAdd, neg_neg, add_eq_right, AddLeftCancelMonoid.add_eq_zero, one_ne_zero, and_false, not_false_eq_true] all_goals rename_i h3 rw [Fin.ext_iff] at h3 - simp_all only [Fin.coe_natAdd, Fin.coe_castAdd, add_eq_right, + simp_all only [Fin.val_natAdd, Fin.val_castAdd, add_eq_right, AddLeftCancelMonoid.add_eq_zero, one_ne_zero, and_false, not_false_eq_true] all_goals omega -lemma basis!_oddShiftSnd_eq_minus_oddShiftFst (j i : Fin n) : - basis!AsCharges j (oddShiftSnd i) = - basis!AsCharges j (oddShiftFst i) := by - simp only [basis!AsCharges, PureU1_numberCharges, oddShiftSnd, oddShiftFst] - split <;> split - any_goals split - any_goals split - any_goals rfl - all_goals rename_i h1 h2 - all_goals rw [Fin.ext_iff] at h1 h2 - all_goals simp_all - · subst h1 - exact Fin.elim0 i - all_goals rename_i h3 - all_goals rw [Fin.ext_iff] at h3 - all_goals simp_all - all_goals omega - lemma basis_on_oddSnd_self (j : Fin n) : basisAsCharges j (oddSnd j) = - 1 := by rw [basis_oddSnd_eq_minus_oddFst, basis_on_oddFst_self] -lemma basis!_on_oddShiftSnd_self (j : Fin n) : basis!AsCharges j (oddShiftSnd j) = - 1 := by - rw [basis!_oddShiftSnd_eq_minus_oddShiftFst, basis!_on_oddShiftFst_self] - lemma basis_on_oddSnd_other {k j : Fin n} (h : k ≠ j) : basisAsCharges k (oddSnd j) = 0 := by rw [basis_oddSnd_eq_minus_oddFst, basis_on_oddFst_other h] rfl -lemma basis!_on_oddShiftSnd_other {k j : Fin n} (h : k ≠ j) : - basis!AsCharges k (oddShiftSnd j) = 0 := by - rw [basis!_oddShiftSnd_eq_minus_oddShiftFst, basis!_on_oddShiftFst_other h] - rfl - lemma basis_on_oddMid (j : Fin n) : basisAsCharges j oddMid = 0 := by simp only [basisAsCharges, PureU1_numberCharges] split <;> rename_i h · rw [Fin.ext_iff] at h - simp only [oddMid, Fin.isValue, Fin.coe_cast, Fin.coe_castAdd, Fin.coe_natAdd, Fin.val_eq_zero, + simp only [oddMid, Fin.isValue, Fin.val_cast, Fin.val_castAdd, Fin.val_natAdd, Fin.val_eq_zero, add_zero, oddFst] at h omega · split <;> rename_i h2 · rw [Fin.ext_iff] at h2 - simp only [oddMid, Fin.isValue, Fin.coe_cast, Fin.coe_castAdd, Fin.coe_natAdd, + simp only [oddMid, Fin.isValue, Fin.val_cast, Fin.val_castAdd, Fin.val_natAdd, Fin.val_eq_zero, add_zero, oddSnd] at h2 omega · rfl -lemma basis!_on_oddShiftZero (j : Fin n) : basis!AsCharges j oddShiftZero = 0 := by - simp only [basis!AsCharges, PureU1_numberCharges] - split <;> rename_i h - · rw [Fin.ext_iff] at h - simp only [oddShiftZero, Fin.isValue, Fin.coe_cast, Fin.coe_castAdd, Fin.val_eq_zero, - oddShiftFst, Fin.coe_natAdd] at h - omega - · split <;> rename_i h2 - · rw [Fin.ext_iff] at h2 - simp only [oddShiftZero, Fin.isValue, Fin.coe_cast, Fin.coe_castAdd, Fin.val_eq_zero, - oddShiftSnd, Fin.coe_natAdd] at h2 - omega - · rfl +/-! + +### B.3. The basis vectors satisfy the linear ACCs + +-/ lemma basis_linearACC (j : Fin n) : (accGrav (2 * n + 1)) (basisAsCharges j) = 0 := by rw [accGrav] @@ -309,11 +351,11 @@ lemma basis_linearACC (j : Fin n) : (accGrav (2 * n + 1)) (basisAsCharges j) = 0 erw [sum_odd] simp [basis_oddSnd_eq_minus_oddFst, basis_on_oddMid] -lemma basis!_linearACC (j : Fin n) : (accGrav (2 * n + 1)) (basis!AsCharges j) = 0 := by - rw [accGrav] - simp only [LinearMap.coe_mk, AddHom.coe_mk] - rw [sum_oddShift, basis!_on_oddShiftZero] - simp [basis!_oddShiftSnd_eq_minus_oddShiftFst] +/-! + +### B.4. The basis vectors as `LinSols` + +-/ /-- The first part of the basis as `LinSols`. -/ @[simps!] @@ -325,53 +367,20 @@ def basis (j : Fin n) : (PureU1 (2 * n + 1)).LinSols := | 0 => exact basis_linearACC j⟩ -/-- The second part of the basis as `LinSols`. -/ -@[simps!] -def basis! (j : Fin n) : (PureU1 (2 * n + 1)).LinSols := - ⟨basis!AsCharges j, by - intro i - simp only [PureU1_numberLinear] at i - match i with - | 0 => - exact basis!_linearACC j⟩ - -/-- The whole basis as `LinSols`. -/ -def basisa : Fin n ⊕ Fin n → (PureU1 (2 * n + 1)).LinSols := fun i => - match i with - | .inl i => basis i - | .inr i => basis! i +/-! -end theBasisVectors +### B.5. The inclusion of the first plane into charges -/-- Swapping the elements oddShiftFst j and oddShiftSnd j is equivalent to adding a vector - basis!AsCharges j. -/ -lemma swap!_as_add {S S' : (PureU1 (2 * n + 1)).LinSols} (j : Fin n) - (hS : ((FamilyPermutations (2 * n + 1)).linSolRep - (pairSwap (oddShiftFst j) (oddShiftSnd j))) S = S') : - S'.val = S.val + (S.val (oddShiftSnd j) - S.val (oddShiftFst j)) • basis!AsCharges j := by - funext i - rw [← hS, FamilyPermutations_anomalyFreeLinear_apply] - by_cases hi : i = oddShiftFst j - · subst hi - simp [HSMul.hSMul, basis!_on_oddShiftFst_self, pairSwap_inv_fst] - · by_cases hi2 : i = oddShiftSnd j - · subst hi2 - simp [HSMul.hSMul,basis!_on_oddShiftSnd_self, pairSwap_inv_snd] - · simp only [Equiv.invFun_as_coe, HSMul.hSMul, ACCSystemCharges.chargesAddCommMonoid_add, - ACCSystemCharges.chargesModule_smul] - rw [basis!_on_other hi hi2] - change S.val ((pairSwap (oddShiftFst j) (oddShiftSnd j)).invFun i) =_ - erw [pairSwap_inv_other (Ne.symm hi) (Ne.symm hi2)] - simp +-/ /-- A point in the span of the first part of the basis as a charge. -/ def P (f : Fin n → ℚ) : (PureU1 (2 * n + 1)).Charges := ∑ i, f i • basisAsCharges i -/-- A point in the span of the second part of the basis as a charge. -/ -def P! (f : Fin n → ℚ) : (PureU1 (2 * n + 1)).Charges := ∑ i, f i • basis!AsCharges i +/-! -/-- A point in the span of the basis as a charge. -/ -def Pa (f : Fin n → ℚ) (g : Fin n → ℚ) : (PureU1 (2 * n + 1)).Charges := P f + P! g +### B.6. Components of the first plane + +-/ lemma P_oddFst (f : Fin n → ℚ) (j : Fin n) : P f (oddFst j) = f j := by rw [P, sum_of_charges] @@ -384,17 +393,6 @@ lemma P_oddFst (f : Fin n → ℚ) (j : Fin n) : P f (oddFst j) = f j := by exact Rat.mul_zero (f k) · simp only [mem_univ, not_true_eq_false, _root_.mul_eq_zero, IsEmpty.forall_iff] -lemma P!_oddShiftFst (f : Fin n → ℚ) (j : Fin n) : P! f (oddShiftFst j) = f j := by - rw [P!, sum_of_charges] - simp only [HSMul.hSMul, SMul.smul] - rw [Finset.sum_eq_single j] - · rw [basis!_on_oddShiftFst_self] - exact Rat.mul_one (f j) - · intro k _ hkj - rw [basis!_on_oddShiftFst_other hkj] - exact Rat.mul_zero (f k) - · simp only [mem_univ, not_true_eq_false, _root_.mul_eq_zero, IsEmpty.forall_iff] - lemma P_oddSnd (f : Fin n → ℚ) (j : Fin n) : P f (oddSnd j) = - f j := by rw [P, sum_of_charges] simp only [HSMul.hSMul, SMul.smul] @@ -406,57 +404,15 @@ lemma P_oddSnd (f : Fin n → ℚ) (j : Fin n) : P f (oddSnd j) = - f j := by exact Rat.mul_zero (f k) · simp -lemma P!_oddShiftSnd (f : Fin n → ℚ) (j : Fin n) : P! f (oddShiftSnd j) = - f j := by - rw [P!, sum_of_charges] - simp only [HSMul.hSMul, SMul.smul] - rw [Finset.sum_eq_single j] - · rw [basis!_on_oddShiftSnd_self] - exact mul_neg_one (f j) - · intro k _ hkj - rw [basis!_on_oddShiftSnd_other hkj] - exact Rat.mul_zero (f k) - · simp - lemma P_oddMid (f : Fin n → ℚ) : P f oddMid = 0 := by rw [P, sum_of_charges] simp [HSMul.hSMul, SMul.smul, basis_on_oddMid] -lemma P!_oddShiftZero (f : Fin n → ℚ) : P! f oddShiftZero = 0 := by - rw [P!, sum_of_charges] - simp [HSMul.hSMul, SMul.smul, basis!_on_oddShiftZero] +/-! -lemma Pa_oddShiftShiftZero (f g : Fin n.succ → ℚ) : Pa f g oddShiftShiftZero = f 0 := by - rw [Pa] - simp only [ACCSystemCharges.chargesAddCommMonoid_add] - nth_rewrite 1 [oddShiftShiftZero_eq_oddFst_zero] - rw [oddShiftShiftZero_eq_oddShiftZero] - rw [P_oddFst, P!_oddShiftZero] - exact Rat.add_zero (f 0) +### B.7. Points on the first plane satisfies the ACCs -lemma Pa_oddShiftShiftFst (f g : Fin n.succ → ℚ) (j : Fin n) : - Pa f g (oddShiftShiftFst j) = f j.succ + g j.castSucc := by - rw [Pa] - simp only [ACCSystemCharges.chargesAddCommMonoid_add] - nth_rewrite 1 [oddShiftShiftFst_eq_oddFst_succ] - rw [oddShiftShiftFst_eq_oddShiftFst_castSucc] - rw [P_oddFst, P!_oddShiftFst] - -lemma Pa_oddShiftShiftMid (f g : Fin n.succ → ℚ) : Pa f g oddShiftShiftMid = g (Fin.last n) := by - rw [Pa] - simp only [ACCSystemCharges.chargesAddCommMonoid_add] - nth_rewrite 1 [oddShiftShiftMid_eq_oddMid] - rw [oddShiftShiftMid_eq_oddShiftFst_last] - rw [P_oddMid, P!_oddShiftFst] - exact Rat.zero_add (g (Fin.last n)) - -lemma Pa_oddShiftShiftSnd (f g : Fin n.succ → ℚ) (j : Fin n.succ) : - Pa f g (oddShiftShiftSnd j) = - f j - g j := by - rw [Pa] - simp only [ACCSystemCharges.chargesAddCommMonoid_add] - nth_rewrite 1 [oddShiftShiftSnd_eq_oddSnd] - rw [oddShiftShiftSnd_eq_oddShiftSnd] - rw [P_oddSnd, P!_oddShiftSnd] - ring +-/ lemma P_linearACC (f : Fin n → ℚ) : (accGrav (2 * n + 1)) (P f) = 0 := by rw [accGrav] @@ -464,12 +420,6 @@ lemma P_linearACC (f : Fin n → ℚ) : (accGrav (2 * n + 1)) (P f) = 0 := by rw [sum_odd] simp [P_oddSnd, P_oddFst, P_oddMid] -lemma P!_linearACC (f : Fin n → ℚ) : (accGrav (2 * n + 1)) (P! f) = 0 := by - rw [accGrav] - simp only [LinearMap.coe_mk, AddHom.coe_mk] - rw [sum_oddShift] - simp [P!_oddShiftSnd, P!_oddShiftFst, P!_oddShiftZero] - lemma P_accCube (f : Fin n → ℚ) : accCube (2 * n +1) (P f) = 0 := by rw [accCube_explicit, sum_odd, P_oddMid] simp only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, Function.comp_apply, zero_add] @@ -478,6 +428,245 @@ lemma P_accCube (f : Fin n → ℚ) : accCube (2 * n +1) (P f) = 0 := by simp only [P_oddFst, P_oddSnd] ring +/-! + +### B.8. Kernel of the inclusion into charges + +-/ + +lemma P_zero (f : Fin n → ℚ) (h : P f = 0) : ∀ i, f i = 0 := by + intro i + erw [← P_oddFst f] + rw [h] + rfl + +/-- A point in the span of the first part of the basis. -/ +def P' (f : Fin n → ℚ) : (PureU1 (2 * n + 1)).LinSols := ∑ i, f i • basis i + +lemma P'_val (f : Fin n → ℚ) : (P' f).val = P f := by + simp only [P', P] + funext i + rw [sum_of_anomaly_free_linear, sum_of_charges] + rfl + +/-! + +### B.9. The basis vectors are linearly independent + +-/ + +theorem basis_linear_independent : LinearIndependent ℚ (@basis n) := by + apply Fintype.linearIndependent_iff.mpr + intro f h + change P' f = 0 at h + have h1 : (P' f).val = 0 := + (AddSemiconjBy.eq_zero_iff (ACCSystemLinear.LinSols.val 0) + (congrFun (congrArg HAdd.hAdd (congrArg ACCSystemLinear.LinSols.val (id (Eq.symm h)))) + (ACCSystemLinear.LinSols.val 0))).mp rfl + rw [P'_val] at h1 + exact P_zero f h1 + +/-! + +## C. The second plane + +-/ + +/-! + +### C.1. The basis vectors of the second plane as charges + +-/ + +/-- The second part of the basis as charge assignments. -/ +def basis!AsCharges (j : Fin n) : (PureU1 (2 * n + 1)).Charges := + fun i => + if i = oddShiftFst j then + 1 + else + if i = oddShiftSnd j then + - 1 + else + 0 + +/-! + +### C.2. Components of the basis vectors as charges + +-/ + +lemma basis!_on_oddShiftFst_self (j : Fin n) : basis!AsCharges j (oddShiftFst j) = 1 := by + simp [basis!AsCharges] + +lemma basis!_on_oddShiftFst_other {k j : Fin n} (h : k ≠ j) : + basis!AsCharges k (oddShiftFst j) = 0 := by + simp only [basis!AsCharges, PureU1_numberCharges] + simp only [oddShiftFst, oddShiftSnd] + split + · rename_i h1 + rw [Fin.ext_iff] at h1 + simp_all + rw [Fin.ext_iff] at h + simp_all + · split + · rename_i h1 h2 + simp_all + rw [Fin.ext_iff] at h2 + simp only [Fin.val_castAdd, Fin.val_natAdd] at h2 + omega + rfl + +lemma basis!_on_other {k : Fin n} {j : Fin (2 * n + 1)} + (h1 : j ≠ oddShiftFst k) (h2 : j ≠ oddShiftSnd k) : + basis!AsCharges k j = 0 := by + simp only [basis!AsCharges, PureU1_numberCharges] + simp_all only [ne_eq, ↓reduceIte] + +lemma basis!_oddShiftSnd_eq_minus_oddShiftFst (j i : Fin n) : + basis!AsCharges j (oddShiftSnd i) = - basis!AsCharges j (oddShiftFst i) := by + simp only [basis!AsCharges, PureU1_numberCharges, oddShiftSnd, oddShiftFst] + split <;> split + any_goals split + any_goals split + any_goals rfl + all_goals rename_i h1 h2 + all_goals rw [Fin.ext_iff] at h1 h2 + all_goals simp_all + · subst h1 + exact Fin.elim0 i + all_goals rename_i h3 + all_goals rw [Fin.ext_iff] at h3 + all_goals simp_all + all_goals omega + +lemma basis!_on_oddShiftSnd_self (j : Fin n) : basis!AsCharges j (oddShiftSnd j) = - 1 := by + rw [basis!_oddShiftSnd_eq_minus_oddShiftFst, basis!_on_oddShiftFst_self] + +lemma basis!_on_oddShiftSnd_other {k j : Fin n} (h : k ≠ j) : + basis!AsCharges k (oddShiftSnd j) = 0 := by + rw [basis!_oddShiftSnd_eq_minus_oddShiftFst, basis!_on_oddShiftFst_other h] + rfl + +lemma basis!_on_oddShiftZero (j : Fin n) : basis!AsCharges j oddShiftZero = 0 := by + simp only [basis!AsCharges, PureU1_numberCharges] + split <;> rename_i h + · rw [Fin.ext_iff] at h + simp only [oddShiftZero, Fin.isValue, Fin.val_cast, Fin.val_castAdd, Fin.val_eq_zero, + oddShiftFst, Fin.val_natAdd] at h + omega + · split <;> rename_i h2 + · rw [Fin.ext_iff] at h2 + simp only [oddShiftZero, Fin.isValue, Fin.val_cast, Fin.val_castAdd, Fin.val_eq_zero, + oddShiftSnd, Fin.val_natAdd] at h2 + omega + · rfl + +/-! + +### C.3. The basis vectors satisfy the linear ACCs + +-/ + +lemma basis!_linearACC (j : Fin n) : (accGrav (2 * n + 1)) (basis!AsCharges j) = 0 := by + rw [accGrav] + simp only [LinearMap.coe_mk, AddHom.coe_mk] + rw [sum_oddShift, basis!_on_oddShiftZero] + simp [basis!_oddShiftSnd_eq_minus_oddShiftFst] + +/-! + +### C.4. The basis vectors as `LinSols` + +-/ + +/-- The second part of the basis as `LinSols`. -/ +@[simps!] +def basis! (j : Fin n) : (PureU1 (2 * n + 1)).LinSols := + ⟨basis!AsCharges j, by + intro i + simp only [PureU1_numberLinear] at i + match i with + | 0 => + exact basis!_linearACC j⟩ + +/-! + +### C.5. Permutations equal adding basis vectors + +-/ + +/-- Swapping the elements oddShiftFst j and oddShiftSnd j is equivalent to adding a vector + basis!AsCharges j. -/ +lemma swap!_as_add {S S' : (PureU1 (2 * n + 1)).LinSols} (j : Fin n) + (hS : ((FamilyPermutations (2 * n + 1)).linSolRep + (Equiv.swap (oddShiftFst j) (oddShiftSnd j))) S = S') : + S'.val = S.val + (S.val (oddShiftSnd j) - S.val (oddShiftFst j)) • basis!AsCharges j := by + funext i + rw [← hS, FamilyPermutations_anomalyFreeLinear_apply] + by_cases hi : i = oddShiftFst j + · subst hi + simp [HSMul.hSMul, basis!_on_oddShiftFst_self, Equiv.swap_apply_left] + · by_cases hi2 : i = oddShiftSnd j + · subst hi2 + simp [HSMul.hSMul,basis!_on_oddShiftSnd_self, Equiv.swap_apply_right] + · simp only [Equiv.invFun_as_coe, HSMul.hSMul, ACCSystemCharges.chargesAddCommMonoid_add, + ACCSystemCharges.chargesModule_smul] + rw [basis!_on_other hi hi2] + aesop + +/-! + +### C.6. The inclusion of the second plane into charges + +-/ + +/-- A point in the span of the second part of the basis as a charge. -/ +def P! (f : Fin n → ℚ) : (PureU1 (2 * n + 1)).Charges := ∑ i, f i • basis!AsCharges i + +/-! + +### C.7. Components of the second plane + +-/ + +lemma P!_oddShiftFst (f : Fin n → ℚ) (j : Fin n) : P! f (oddShiftFst j) = f j := by + rw [P!, sum_of_charges] + simp only [HSMul.hSMul, SMul.smul] + rw [Finset.sum_eq_single j] + · rw [basis!_on_oddShiftFst_self] + exact Rat.mul_one (f j) + · intro k _ hkj + rw [basis!_on_oddShiftFst_other hkj] + exact Rat.mul_zero (f k) + · simp only [mem_univ, not_true_eq_false, _root_.mul_eq_zero, IsEmpty.forall_iff] + +lemma P!_oddShiftSnd (f : Fin n → ℚ) (j : Fin n) : P! f (oddShiftSnd j) = - f j := by + rw [P!, sum_of_charges] + simp only [HSMul.hSMul, SMul.smul] + rw [Finset.sum_eq_single j] + · rw [basis!_on_oddShiftSnd_self] + exact mul_neg_one (f j) + · intro k _ hkj + rw [basis!_on_oddShiftSnd_other hkj] + exact Rat.mul_zero (f k) + · simp + +lemma P!_oddShiftZero (f : Fin n → ℚ) : P! f oddShiftZero = 0 := by + rw [P!, sum_of_charges] + simp [HSMul.hSMul, SMul.smul, basis!_on_oddShiftZero] + +/-! + +### C.8. Points on the second plane satisfies the ACCs + +-/ + +lemma P!_linearACC (f : Fin n → ℚ) : (accGrav (2 * n + 1)) (P! f) = 0 := by + rw [accGrav] + simp only [LinearMap.coe_mk, AddHom.coe_mk] + rw [sum_oddShift] + simp [P!_oddShiftSnd, P!_oddShiftFst, P!_oddShiftZero] + lemma P!_accCube (f : Fin n → ℚ) : accCube (2 * n +1) (P! f) = 0 := by rw [accCube_explicit, sum_oddShift, P!_oddShiftZero] simp only [ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, Function.comp_apply, zero_add] @@ -486,6 +675,56 @@ lemma P!_accCube (f : Fin n → ℚ) : accCube (2 * n +1) (P! f) = 0 := by simp only [P!_oddShiftFst, P!_oddShiftSnd] ring +/-! + +### C.9. Kernel of the inclusion into charges + +-/ + +lemma P!_zero (f : Fin n → ℚ) (h : P! f = 0) : ∀ i, f i = 0 := by + intro i + rw [← P!_oddShiftFst f] + rw [h] + rfl + +/-! + +### C.10. The inclusion of the second plane into LinSols + +-/ + +/-- A point in the span of the second part of the basis. -/ +def P!' (f : Fin n → ℚ) : (PureU1 (2 * n + 1)).LinSols := ∑ i, f i • basis! i + +lemma P!'_val (f : Fin n → ℚ) : (P!' f).val = P! f := by + simp only [P!', P!] + funext i + rw [sum_of_anomaly_free_linear, sum_of_charges] + rfl + +/-! + +### C.11. The basis vectors are linearly independent + +-/ + +theorem basis!_linear_independent : LinearIndependent ℚ (@basis! n) := by + apply Fintype.linearIndependent_iff.mpr + intro f h + change P!' f = 0 at h + have h1 : (P!' f).val = 0 := + (AddSemiconjBy.eq_zero_iff (ACCSystemLinear.LinSols.val 0) + (congrFun (congrArg HAdd.hAdd (congrArg ACCSystemLinear.LinSols.val (id (Eq.symm h)))) + (ACCSystemLinear.LinSols.val 0))).mp rfl + rw [P!'_val] at h1 + exact P!_zero f h1 + +/-! + +## D. The mixed cubic ACC from points in both planes + +-/ + lemma P_P_P!_accCube (g : Fin n → ℚ) (j : Fin n) : accCubeTriLinSymm (P g) (P g) (basis!AsCharges j) = (P g (oddShiftFst j))^2 - (g j)^2 := by @@ -500,17 +739,77 @@ lemma P_P_P!_accCube (g : Fin n → ℚ) (j : Fin n) : simp only [mul_zero, add_zero] · simp -lemma P_zero (f : Fin n → ℚ) (h : P f = 0) : ∀ i, f i = 0 := by - intro i - erw [← P_oddFst f] - rw [h] - rfl +/-! -lemma P!_zero (f : Fin n → ℚ) (h : P! f = 0) : ∀ i, f i = 0 := by - intro i - rw [← P!_oddShiftFst f] - rw [h] - rfl +## E. The combined basis + +-/ + +/-! + +### E.1. The combined basis as `LinSols` + +-/ + +/-- The whole basis as `LinSols`. -/ +def basisa : Fin n ⊕ Fin n → (PureU1 (2 * n + 1)).LinSols := fun i => + match i with + | .inl i => basis i + | .inr i => basis! i + +/-! + +### E.2. The inclusion of the span of the combined basis into charges + +-/ + +/-- A point in the span of the basis as a charge. -/ +def Pa (f : Fin n → ℚ) (g : Fin n → ℚ) : (PureU1 (2 * n + 1)).Charges := P f + P! g + +/-! + +### E.3. Components of the inclusion + +-/ + +lemma Pa_oddShiftShiftZero (f g : Fin n.succ → ℚ) : Pa f g oddShiftShiftZero = f 0 := by + rw [Pa] + simp only [ACCSystemCharges.chargesAddCommMonoid_add] + nth_rewrite 1 [oddShiftShiftZero_eq_oddFst_zero] + rw [oddShiftShiftZero_eq_oddShiftZero] + rw [P_oddFst, P!_oddShiftZero] + exact Rat.add_zero (f 0) + +lemma Pa_oddShiftShiftFst (f g : Fin n.succ → ℚ) (j : Fin n) : + Pa f g (oddShiftShiftFst j) = f j.succ + g j.castSucc := by + rw [Pa] + simp only [ACCSystemCharges.chargesAddCommMonoid_add] + nth_rewrite 1 [oddShiftShiftFst_eq_oddFst_succ] + rw [oddShiftShiftFst_eq_oddShiftFst_castSucc] + rw [P_oddFst, P!_oddShiftFst] + +lemma Pa_oddShiftShiftMid (f g : Fin n.succ → ℚ) : Pa f g oddShiftShiftMid = g (Fin.last n) := by + rw [Pa] + simp only [ACCSystemCharges.chargesAddCommMonoid_add] + nth_rewrite 1 [oddShiftShiftMid_eq_oddMid] + rw [oddShiftShiftMid_eq_oddShiftFst_last] + rw [P_oddMid, P!_oddShiftFst] + exact Rat.zero_add (g (Fin.last n)) + +lemma Pa_oddShiftShiftSnd (f g : Fin n.succ → ℚ) (j : Fin n.succ) : + Pa f g (oddShiftShiftSnd j) = - f j - g j := by + rw [Pa] + simp only [ACCSystemCharges.chargesAddCommMonoid_add] + nth_rewrite 1 [oddShiftShiftSnd_eq_oddSnd] + rw [oddShiftShiftSnd_eq_oddShiftSnd] + rw [P_oddSnd, P!_oddShiftSnd] + ring + +/-! + +### E.4. Kernel of the inclusion into charges + +-/ lemma Pa_zero (f g : Fin n.succ → ℚ) (h : Pa f g = 0) : ∀ i, f i = 0 := by @@ -540,11 +839,11 @@ lemma Pa_zero! (f g : Fin n.succ → ℚ) (h : Pa f g = 0) : simp only [succ_eq_add_one, hf, zero_smul, sum_const_zero, zero_add] at h exact P!_zero g h -/-- A point in the span of the first part of the basis. -/ -def P' (f : Fin n → ℚ) : (PureU1 (2 * n + 1)).LinSols := ∑ i, f i • basis i +/-! -/-- A point in the span of the second part of the basis. -/ -def P!' (f : Fin n → ℚ) : (PureU1 (2 * n + 1)).LinSols := ∑ i, f i • basis! i +### E.5. The inclusion of the span of the combined basis into LinSols + +-/ /-- A point in the span of the whole basis. -/ def Pa' (f : (Fin n) ⊕ (Fin n) → ℚ) : (PureU1 (2 * n + 1)).LinSols := @@ -554,39 +853,11 @@ lemma Pa'_P'_P!' (f : (Fin n) ⊕ (Fin n) → ℚ) : Pa' f = P' (f ∘ Sum.inl) + P!' (f ∘ Sum.inr) := by exact Fintype.sum_sum_type _ -lemma P'_val (f : Fin n → ℚ) : (P' f).val = P f := by - simp only [P', P] - funext i - rw [sum_of_anomaly_free_linear, sum_of_charges] - rfl - -lemma P!'_val (f : Fin n → ℚ) : (P!' f).val = P! f := by - simp only [P!', P!] - funext i - rw [sum_of_anomaly_free_linear, sum_of_charges] - rfl +/-! -theorem basis_linear_independent : LinearIndependent ℚ (@basis n) := by - apply Fintype.linearIndependent_iff.mpr - intro f h - change P' f = 0 at h - have h1 : (P' f).val = 0 := - (AddSemiconjBy.eq_zero_iff (ACCSystemLinear.LinSols.val 0) - (congrFun (congrArg HAdd.hAdd (congrArg ACCSystemLinear.LinSols.val (id (Eq.symm h)))) - (ACCSystemLinear.LinSols.val 0))).mp rfl - rw [P'_val] at h1 - exact P_zero f h1 +### E.6. The combined basis vectors are linearly independent -theorem basis!_linear_independent : LinearIndependent ℚ (@basis! n) := by - apply Fintype.linearIndependent_iff.mpr - intro f h - change P!' f = 0 at h - have h1 : (P!' f).val = 0 := - (AddSemiconjBy.eq_zero_iff (ACCSystemLinear.LinSols.val 0) - (congrFun (congrArg HAdd.hAdd (congrArg ACCSystemLinear.LinSols.val (id (Eq.symm h)))) - (ACCSystemLinear.LinSols.val 0))).mp rfl - rw [P!'_val] at h1 - exact P!_zero f h1 +-/ theorem basisa_linear_independent : LinearIndependent ℚ (@basisa n.succ) := by apply Fintype.linearIndependent_iff.mpr @@ -608,6 +879,12 @@ theorem basisa_linear_independent : LinearIndependent ℚ (@basisa n.succ) := by · simp_all · simp_all +/-! + +### E.7. Injectivity of the inclusion into linear solutions + +-/ + lemma Pa'_eq (f f' : (Fin n.succ) ⊕ (Fin n.succ) → ℚ) : Pa' f = Pa' f' ↔ f = f' := by refine Iff.intro (fun h => ?_) (fun h => ?_) · funext i @@ -625,27 +902,10 @@ lemma Pa'_eq (f f' : (Fin n.succ) ⊕ (Fin n.succ) → ℚ) : Pa' f = Pa' f' ↔ linarith · rw [h] -TODO "6VZRN" "Replace the definition of `join` with a Mathlib definition, most likely `Sum.elim`." -/-- A helper function for what follows. -/ -def join (g f : Fin n → ℚ) : Fin n ⊕ Fin n → ℚ := fun i => - match i with - | .inl i => g i - | .inr i => f i - -lemma join_ext (g g' : Fin n → ℚ) (f f' : Fin n → ℚ) : - join g f = join g' f' ↔ g = g' ∧ f = f' := by - refine Iff.intro (fun h => ?_) (fun h => ?_) - · apply And.intro - · funext i - exact congr_fun h (Sum.inl i) - · funext i - exact congr_fun h (Sum.inr i) - · rw [h.left, h.right] - -lemma join_Pa (g g' : Fin n.succ → ℚ) (f f' : Fin n.succ → ℚ) : - Pa' (join g f) = Pa' (join g' f') ↔ Pa g f = Pa g' f' := by +lemma Pa'_elim_eq_iff (g g' : Fin n.succ → ℚ) (f f' : Fin n.succ → ℚ) : + Pa' (Sum.elim g f) = Pa' (Sum.elim g' f') ↔ Pa g f = Pa g' f' := by refine Iff.intro (fun h => ?_) (fun h => ?_) - · rw [Pa'_eq, join_ext] at h + · rw [Pa'_eq, Sum.elim_eq_iff] at h rw [h.left, h.right] · apply ACCSystemLinear.LinSols.ext rw [Pa'_P'_P!', Pa'_P'_P!'] @@ -654,21 +914,39 @@ lemma join_Pa (g g' : Fin n.succ → ℚ) (f f' : Fin n.succ → ℚ) : lemma Pa_eq (g g' : Fin n.succ → ℚ) (f f' : Fin n.succ → ℚ) : Pa g f = Pa g' f' ↔ g = g' ∧ f = f' := by - rw [← join_Pa] - rw [← join_ext] + rw [← Pa'_elim_eq_iff] + rw [← Sum.elim_eq_iff] exact Pa'_eq _ _ +/-! + +### E.8. Cardinality of the basis + +-/ + lemma basisa_card : Fintype.card ((Fin n.succ) ⊕ (Fin n.succ)) = Module.finrank ℚ (PureU1 (2 * n.succ + 1)).LinSols := by erw [BasisLinear.finrank_AnomalyFreeLinear] simp only [Fintype.card_sum, Fintype.card_fin] exact Eq.symm (Nat.two_mul n.succ) +/-! + +### E.9. The basis vectors as a basis + +-/ + /-- The basis formed out of our basisa vectors. -/ noncomputable def basisaAsBasis : Basis (Fin n.succ ⊕ Fin n.succ) ℚ (PureU1 (2 * n.succ + 1)).LinSols := basisOfLinearIndependentOfCardEqFinrank (@basisa_linear_independent n) basisa_card +/-! + +## F. Every Lienar solution is the sum of a point from each plane + +-/ + lemma span_basis (S : (PureU1 (2 * n.succ + 1)).LinSols) : ∃ (g f : Fin n.succ → ℚ), S.val = P g + P! f := by have h := (Submodule.mem_span_range_iff_exists_fun ℚ).mp (Basis.mem_span basisaAsBasis S) @@ -682,9 +960,15 @@ lemma span_basis (S : (PureU1 (2 * n.succ + 1)).LinSols) : simp only [succ_eq_add_one, ACCSystemLinear.linSolsAddCommMonoid_add_val, P'_val, P!'_val] rfl +/-! + +### F.1. Relation under permutations + +-/ + lemma span_basis_swap! {S : (PureU1 (2 * n.succ + 1)).LinSols} (j : Fin n.succ) (hS : ((FamilyPermutations (2 * n.succ + 1)).linSolRep - (pairSwap (oddShiftFst j) (oddShiftSnd j))) S = S') (g f : Fin n.succ → ℚ) + (Equiv.swap (oddShiftFst j) (oddShiftSnd j))) S = S') (g f : Fin n.succ → ℚ) (hS1 : S.val = P g + P! f) : ∃ (g' f' : Fin n.succ → ℚ), S'.val = P g' + P! f' ∧ P! f' = P! f + (S.val (oddShiftSnd j) - S.val (oddShiftFst j)) • basis!AsCharges j ∧ g' = g := by diff --git a/PhysLean/QFT/QED/AnomalyCancellation/Odd/LineInCubic.lean b/PhysLean/QFT/QED/AnomalyCancellation/Odd/LineInCubic.lean index 6566fdcae..08492f168 100644 --- a/PhysLean/QFT/QED/AnomalyCancellation/Odd/LineInCubic.lean +++ b/PhysLean/QFT/QED/AnomalyCancellation/Odd/LineInCubic.lean @@ -80,13 +80,13 @@ lemma lineInCubicPerm_swap {S : (PureU1 (2 * n.succ + 1)).LinSols} * accCubeTriLinSymm (P g) (P g) (basis!AsCharges j) = 0 := by intro j g f h let S' := (FamilyPermutations (2 * n.succ + 1)).linSolRep - (pairSwap (oddShiftFst j) (oddShiftSnd j)) S + (Equiv.swap (oddShiftFst j) (oddShiftSnd j)) S have hSS' : ((FamilyPermutations (2 * n.succ + 1)).linSolRep - (pairSwap (oddShiftFst j) (oddShiftSnd j))) S = S' := rfl + (Equiv.swap (oddShiftFst j) (oddShiftSnd j))) S = S' := rfl obtain ⟨g', f', hall⟩ := span_basis_swap! j hSS' g f h have h1 := line_in_cubic_P_P_P! (lineInCubicPerm_self LIC) g f h have h2 := line_in_cubic_P_P_P! (lineInCubicPerm_self (lineInCubicPerm_permute LIC - (pairSwap (oddShiftFst j) (oddShiftSnd j)))) g' f' hall.1 + (Equiv.swap (oddShiftFst j) (oddShiftSnd j)))) g' f' hall.1 rw [hall.2.1, hall.2.2] at h2 rw [accCubeTriLinSymm.map_add₃, h1, accCubeTriLinSymm.map_smul₃] at h2 simpa using h2 diff --git a/PhysLean/QFT/QED/AnomalyCancellation/Permutations.lean b/PhysLean/QFT/QED/AnomalyCancellation/Permutations.lean index 0aa843393..1e2eebe2f 100644 --- a/PhysLean/QFT/QED/AnomalyCancellation/Permutations.lean +++ b/PhysLean/QFT/QED/AnomalyCancellation/Permutations.lean @@ -86,67 +86,6 @@ lemma FamilyPermutations_anomalyFreeLinear_apply (S : (PureU1 n).LinSols) ((FamilyPermutations n).linSolRep f S).val i = S.val (f.invFun i) := by rfl -TODO "6VZPL" "Remove `pairSwap`, and use the Mathlib defined function `Equiv.swap` instead." -/-- The permutation which swaps i and j. -/ -def pairSwap {n : ℕ} (i j : Fin n) : (FamilyPermutations n).group where - toFun s := - if s = i then - j - else - if s = j then - i - else - s - invFun s := - if s = i then - j - else - if s = j then - i - else - s - left_inv s := by - aesop - right_inv s := by - aesop - -lemma pairSwap_self_inv {n : ℕ} (i j : Fin n) : (pairSwap i j)⁻¹ = (pairSwap i j) := by - rfl - -lemma pairSwap_fst {n : ℕ} (i j : Fin n) : (pairSwap i j).toFun i = j := by - simp [pairSwap] - -lemma pairSwap_snd {n : ℕ} (i j : Fin n) : (pairSwap i j).toFun j = i := by - simp [pairSwap] - -lemma pairSwap_inv_fst {n : ℕ} (i j : Fin n) : (pairSwap i j).invFun i = j := by - simp [pairSwap] - -lemma pairSwap_inv_snd {n : ℕ} (i j : Fin n) : (pairSwap i j).invFun j = i := by - simp [pairSwap] - -lemma pairSwap_other {n : ℕ} (i j k : Fin n) (hik : i ≠ k) (hjk : j ≠ k) : - (pairSwap i j).toFun k = k := by - simp only [pairSwap, Equiv.toFun_as_coe, Equiv.coe_fn_mk] - split - · rename_i h - exact False.elim (hik (id (Eq.symm h))) - · split - · rename_i h - exact False.elim (hjk (id (Eq.symm h))) - · rfl - -lemma pairSwap_inv_other {n : ℕ} {i j k : Fin n} (hik : i ≠ k) (hjk : j ≠ k) : - (pairSwap i j).invFun k = k := by - simp only [pairSwap, Equiv.invFun_as_coe, Equiv.coe_fn_symm_mk] - split - · rename_i h - exact False.elim (hik (id (Eq.symm h))) - · split - · rename_i h - exact False.elim (hjk (id (Eq.symm h))) - · rfl - /-- A permutation of fermions which takes one ordered subset into another. -/ noncomputable def permOfInjection (f g : Fin m ↪ Fin n) : (FamilyPermutations n).group := Equiv.extendSubtype (g.toEquivRange.symm.trans f.toEquivRange) diff --git a/PhysLean/QuantumMechanics/DDimensions/Hydrogen/Basic.lean b/PhysLean/QuantumMechanics/DDimensions/Hydrogen/Basic.lean new file mode 100644 index 000000000..82872c280 --- /dev/null +++ b/PhysLean/QuantumMechanics/DDimensions/Hydrogen/Basic.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Gregory J. Loges. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gregory J. Loges +-/ +import PhysLean.QuantumMechanics.DDimensions.Operators.Momentum +import PhysLean.QuantumMechanics.DDimensions.Operators.Position +/-! + +# Hydrogen atom + +This module introduces the `d`-dimensional hydrogen atom with `1/r` potential. + +In addition to the dimension `d`, the quantum mechanical system is characterized by +a mass `m > 0` and constant `k` appearing in the potential `V = -k/r`. +The standard hydrogen atom has `d=3`, `m = mₑmₚ/(mₑ + mₚ) ≈ mₑ` and `k = e²/4πε₀`. + +The potential `V = -k/r` is singular at the origin. To address this we define a regularized +Hamiltonian in which the potential is replaced by `-k(r(ε)⁻¹ + ½ε²r(ε)⁻³)`, where +`r(ε)² = ‖x‖² + ε²`. The `ε²/r³` term limits to the zero distribution for `ε → 0` +but is convenient to include for two reasons: +- It improves the convergence: `r(ε)⁻¹ + ½ε²r(ε)⁻³ = r⁻¹(1 + O(ε⁴/r⁴))` with no `O(ε²/r²)` term. +- It is what appears in the commutators of the (regularized) LRL vector components. + +-/ + +namespace QuantumMechanics +open SchwartzMap + +/-- A hydrogen atom is characterized by the number of spatial dimensions `d`, + the mass `m` and the coefficient `k` for the `1/r` potential. -/ +structure HydrogenAtom where + /-- Number of spatial dimensions -/ + d : ℕ + + /-- Mass (positive) -/ + m : ℝ + hm : 0 < m + + /-- Coefficient in potential (positive for attractive) -/ + k : ℝ + +namespace HydrogenAtom +noncomputable section + +variable (H : HydrogenAtom) + +@[simp] +lemma m_ne_zero : H.m ≠ 0 := by linarith [H.hm] + +/-- The hydrogen atom Hamiltonian regularized by `ε > 0` is defined to be + `𝐇(ε) ≔ (2m)⁻¹𝐩² - k(𝐫(ε)⁻¹ + ½ε²𝐫(ε)⁻³)`. -/ +def hamiltonianReg (ε : ℝ) : 𝓢(Space H.d, ℂ) →L[ℂ] 𝓢(Space H.d, ℂ) := + (2 * H.m)⁻¹ • 𝐩² - H.k • (𝐫[ε,-1] + (2⁻¹ * ε ^ 2) • 𝐫[ε,-3]) + +end +end HydrogenAtom +end QuantumMechanics diff --git a/PhysLean/QuantumMechanics/DDimensions/Hydrogen/LaplaceRungeLenzVector.lean b/PhysLean/QuantumMechanics/DDimensions/Hydrogen/LaplaceRungeLenzVector.lean new file mode 100644 index 000000000..474cc0a24 --- /dev/null +++ b/PhysLean/QuantumMechanics/DDimensions/Hydrogen/LaplaceRungeLenzVector.lean @@ -0,0 +1,859 @@ +/- +Copyright (c) 2026 Gregory J. Loges. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gregory J. Loges +-/ +import PhysLean.QuantumMechanics.DDimensions.Hydrogen.Basic +import PhysLean.QuantumMechanics.DDimensions.Operators.Commutation +/-! + +# Laplace-Runge-Lenz vector + +In this file we define +- The (regularized) LRL vector operator for the quantum mechanical hydrogen atom, + `𝐀(ε)ᵢ ≔ ½(𝐩ⱼ𝐋ᵢⱼ + 𝐋ᵢⱼ𝐩ⱼ) - mk·𝐫(ε)⁻¹𝐱ᵢ`. +- The square of the LRL vector operator, `𝐀(ε)² ≔ 𝐀(ε)ᵢ𝐀(ε)ᵢ`. + +The main results are +- The commutators `⁅𝐋ᵢⱼ, 𝐀(ε)ₖ⁆ = iℏ(δᵢₖ𝐀(ε)ⱼ - δⱼₖ𝐀(ε)ᵢ)` in `angularMomentum_commutation_lrl` +- The commutators `⁅𝐀(ε)ᵢ, 𝐀(ε)ⱼ⁆ = -iℏ 2m 𝐇(ε)𝐋ᵢⱼ` in `lrl_commutation_lrl` +- The commutators `⁅𝐇(ε), 𝐀(ε)ᵢ⁆ = iℏε²(⋯)` in `hamiltonianReg_commutation_lrl` +- The relation `𝐀(ε)² = 2m 𝐇(ε)(𝐋² + ¼ℏ²(d-1)²) + m²k² + ε²(⋯)` in `lrlOperatorSqr_eq` + +-/ + +namespace QuantumMechanics +namespace HydrogenAtom +noncomputable section +open Constants +open KroneckerDelta +open ContinuousLinearMap SchwartzMap + +variable (H : HydrogenAtom) + +/-- The (regularized) Laplace-Runge-Lenz vector operator for the `d`-dimensional hydrogen atom, + `𝐀(ε)ᵢ ≔ ½(𝐩ⱼ𝐋ᵢⱼ + 𝐋ᵢⱼ𝐩ⱼ) - mk·𝐫(ε)⁻¹𝐱ᵢ`. -/ +def lrlOperator (ε : ℝ) (i : Fin H.d) : 𝓢(Space H.d, ℂ) →L[ℂ] 𝓢(Space H.d, ℂ) := + (2 : ℝ)⁻¹ • ∑ j, (𝐩[j] ∘L 𝐋[i,j] + 𝐋[i,j] ∘L 𝐩[j]) - (H.m * H.k) • 𝐫[ε,-1] ∘L 𝐱[i] + +/-- The square of the LRL vector operator, `𝐀(ε)² ≔ 𝐀(ε)ᵢ𝐀(ε)ᵢ`. -/ +def lrlOperatorSqr (ε : ℝ) : 𝓢(Space H.d, ℂ) →L[ℂ] 𝓢(Space H.d, ℂ) := + ∑ i, (H.lrlOperator ε i) ∘L (H.lrlOperator ε i) + +/-- `𝐀(ε)ᵢ = 𝐱ᵢ𝐩² - (𝐱ⱼ𝐩ⱼ)𝐩ᵢ + ½iℏ(d-1)𝐩ᵢ - mk·𝐫(ε)⁻¹𝐱ᵢ` -/ +lemma lrlOperator_eq (i : Fin H.d) : + H.lrlOperator ε i = 𝐱[i] ∘L 𝐩² - (∑ j, 𝐱[j] ∘L 𝐩[j]) ∘L 𝐩[i] + + (2⁻¹ * Complex.I * ℏ * (H.d - 1)) • 𝐩[i] - (H.m * H.k) • 𝐫[ε,-1] ∘L 𝐱[i] := by + unfold lrlOperator angularMomentumOperator + congr + conv_lhs => + enter [2, 2, j] + rw [comp_sub, sub_comp] + repeat rw [← comp_assoc, momentum_comp_position_eq, sub_comp, smul_comp, id_comp] + repeat rw [comp_assoc] + rw [momentum_comp_commute i j] + + simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib] + rw [← ContinuousLinearMap.comp_finset_sum] + simp only [← comp_assoc, ← ContinuousLinearMap.finset_sum_comp] + rw [← momentumOperatorSqr] + unfold kroneckerDelta + simp only [mul_ite_zero, ite_zero_smul, Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte, + Finset.sum_const, Finset.card_univ, Fintype.card_fin, ← smul_assoc] + ext ψ x + simp only [mul_one, nsmul_eq_mul, smul_add, ContinuousLinearMap.add_apply, coe_smul', coe_sub', + coe_comp', Pi.smul_apply, Pi.sub_apply, Function.comp_apply, SchwartzMap.add_apply, + SchwartzMap.smul_apply, SchwartzMap.sub_apply, smul_eq_mul, Complex.real_smul, + Complex.ofReal_inv, Complex.ofReal_ofNat] + ring + +/-- `𝐀(ε)ᵢ = 𝐋ᵢⱼ𝐩ⱼ + ½iℏ(d-1)𝐩ᵢ - mk·𝐫(ε)⁻¹𝐱ᵢ` -/ +lemma lrlOperator_eq' (i : Fin H.d) : H.lrlOperator ε i = ∑ j, 𝐋[i,j] ∘L 𝐩[j] + + (2⁻¹ * Complex.I * ℏ * (H.d - 1)) • 𝐩[i] - (H.m * H.k) • 𝐫[ε,-1] ∘L 𝐱[i] := by + unfold lrlOperator + congr + conv_lhs => + enter [2, 2, j] + rw [comp_eq_comp_sub_commute 𝐩[j] 𝐋[i,j], angularMomentum_commutation_momentum] + repeat rw [Finset.sum_add_distrib, Finset.sum_sub_distrib, Finset.sum_sub_distrib] + unfold kroneckerDelta + ext ψ x + simp only [ContinuousLinearMap.add_apply, coe_smul', coe_sum', coe_comp', Pi.smul_apply, + Finset.sum_apply, Function.comp_apply, coe_sub', Pi.sub_apply, SchwartzMap.add_apply, + SchwartzMap.smul_apply, SchwartzMap.sum_apply, SchwartzMap.sub_apply] + simp only [mul_ite, mul_one, mul_zero, smul_eq_mul, ite_mul, zero_mul, Finset.sum_ite_eq, + Finset.mem_univ, ↓reduceIte, Finset.sum_const, Finset.card_univ, Fintype.card_fin, + nsmul_eq_mul, smul_add, Complex.real_smul, Complex.ofReal_inv, Complex.ofReal_ofNat] + ring + +/-- `𝐀(ε)ᵢ = 𝐩ⱼ𝐋ᵢⱼ - ½iℏ(d-1)𝐩ᵢ - mk·𝐫(ε)⁻¹𝐱ᵢ` -/ +lemma lrlOperator_eq'' (i : Fin H.d) : H.lrlOperator ε i = ∑ j, 𝐩[j] ∘L 𝐋[i,j] + - (2⁻¹ * Complex.I * ℏ * (H.d - 1)) • 𝐩[i] - (H.m * H.k) • 𝐫[ε,-1] ∘L 𝐱[i] := by + unfold lrlOperator + congr + conv_lhs => + enter [2, 2, j] + rw [comp_eq_comp_add_commute 𝐋[i,j] 𝐩[j], angularMomentum_commutation_momentum] + rw [Finset.sum_add_distrib, Finset.sum_add_distrib, Finset.sum_sub_distrib] + ext ψ x + unfold kroneckerDelta + simp only [ContinuousLinearMap.add_apply, coe_smul', coe_sum', coe_comp', + Pi.smul_apply, Finset.sum_apply, Function.comp_apply, coe_sub', Pi.sub_apply, + SchwartzMap.add_apply, SchwartzMap.smul_apply, SchwartzMap.sum_apply, Complex.real_smul, + Complex.ofReal_inv, Complex.ofReal_ofNat, SchwartzMap.sub_apply] + simp only [mul_ite, mul_one, mul_zero, smul_eq_mul, ite_mul, zero_mul, Finset.sum_ite_eq, + Finset.mem_univ, ↓reduceIte, Finset.sum_const, Finset.card_univ, Fintype.card_fin, + nsmul_eq_mul] + ring + +/-- The operator `𝐱ᵢ𝐩ᵢ` on Schwartz maps. -/ +private def positionDotMomentum {d} := ∑ i : Fin d, 𝐱[i] ∘L 𝐩[i] + +/-- The operator `𝐱ᵢ𝐩²` on Schwartz maps. -/ +private def positionCompMomentumSqr {d} (i : Fin d) := 𝐱[i] ∘L 𝐩² + +/-- The operator `(𝐱ⱼ𝐩ⱼ)𝐱ᵢ` on Schwartz maps. -/ +private def positionDotMomentumCompMomentum {d} (i : Fin d) := positionDotMomentum ∘L 𝐩[i] + +/-- The operator `½iℏ(d-1)𝐩ᵢ` on Schwartz maps. -/ +private def constMomentum {d} (i : Fin d) := (2⁻¹ * Complex.I * ℏ * (d - 1)) • 𝐩[i] + +/-- The operator `mk·𝐫(ε)⁻¹𝐱ᵢ` on Schwartz maps. -/ +private def constRadiusRegInvCompPosition (ε : ℝ) (i : Fin H.d) := (H.m * H.k) • 𝐫[ε,-1] ∘L 𝐱[i] + +/- +## Angular momentum / LRL vector commutators +-/ + +/-- `⁅𝐋ᵢⱼ, 𝐀(ε)ₖ⁆ = iℏ(δᵢₖ𝐀(ε)ⱼ - δⱼₖ𝐀(ε)ᵢ)` -/ +lemma angularMomentum_commutation_lrl (hε : 0 < ε) (i j k : Fin H.d) : + ⁅𝐋[i,j], H.lrlOperator ε k⁆ = (Complex.I * ℏ * δ[i,k]) • H.lrlOperator ε j + - (Complex.I * ℏ * δ[j,k]) • H.lrlOperator ε i := by + rcases eq_or_ne i j with (⟨hij, rfl⟩ | hij) + · rw [angularMomentumOperator_eq_zero, zero_lie, sub_self] + + unfold lrlOperator + simp only [lie_sub, lie_smul, lie_sum, lie_add, lie_leibniz] + simp only [angularMomentum_commutation_angularMomentum, angularMomentum_commutation_momentum, + angularMomentum_commutation_position, angularMomentum_commutation_radiusRegPow hε] + simp only [comp_add, comp_sub, add_comp, sub_comp, comp_smul, smul_comp, zero_comp, add_zero] + ext ψ x + simp only [ContinuousLinearMap.sub_apply, ContinuousLinearMap.smul_apply, + ContinuousLinearMap.sum_apply, ContinuousLinearMap.add_apply, ContinuousLinearMap.comp_apply] + simp only [SchwartzMap.sub_apply, SchwartzMap.smul_apply, SchwartzMap.sum_apply, + SchwartzMap.add_apply, SchwartzMap.smul_apply, smul_eq_mul] + simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib] + dsimp only [kroneckerDelta] + simp only [mul_ite_zero, mul_one, ite_mul, zero_mul, Finset.sum_ite_irrel, Complex.real_smul, + Finset.sum_const_zero, Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte, smul_add] + simp only [angularMomentumOperator_antisymm k _] + simp only [mul_sub, mul_add, mul_ite_zero, Finset.mul_sum] + simp only [ContinuousLinearMap.neg_apply, map_neg, SchwartzMap.neg_apply] + + rcases eq_or_ne i k with (⟨_, rfl⟩ | hik) + · simp only [↓reduceIte, angularMomentumOperator_eq_zero] + repeat rw [ite_cond_eq_false _ _ (eq_false hij.symm)] + simp only [ContinuousLinearMap.zero_apply, SchwartzMap.zero_apply] + ring_nf + · rcases eq_or_ne j k with (⟨_, rfl⟩ | hjk) + · simp only [↓reduceIte] + repeat rw [ite_cond_eq_false _ _ (eq_false hij)] + ring_nf + · repeat rw [ite_cond_eq_false _ _ (eq_false hik)] + repeat rw [ite_cond_eq_false _ _ (eq_false hjk)] + ring + +/-- `⁅𝐋ᵢⱼ, 𝐀(ε)²⁆ = 0` -/ +lemma angularMomentum_commutation_lrlSqr (hε : 0 < ε) (i j : Fin H.d) : + ⁅𝐋[i,j], H.lrlOperatorSqr ε⁆ = 0 := by + unfold lrlOperatorSqr + simp only [lie_sum, lie_leibniz, H.angularMomentum_commutation_lrl hε] + simp only [comp_sub, comp_smul, sub_comp, smul_comp] + dsimp only [kroneckerDelta] + simp [Finset.sum_add_distrib, Finset.sum_sub_distrib] + +/-- `⁅𝐋², 𝐀(ε)²⁆ = 0` -/ +lemma angularMomentumSqr_commutation_lrlSqr (hε : 0 < ε) : + ⁅angularMomentumOperatorSqr (d := H.d), H.lrlOperatorSqr ε⁆ = 0 := by + unfold angularMomentumOperatorSqr + simp [sum_lie, leibniz_lie, H.angularMomentum_commutation_lrlSqr hε] + +/- + +## LRL / LRL commutators + +To compute the commutator `⁅𝐀ᵢ(ε), 𝐀ⱼ(ε)⁆` we take the following approach: +- Write `𝐀(ε)ᵢ = 𝐱ᵢ𝐩² - (𝐱ⱼ𝐩ⱼ)𝐩ᵢ + ½iℏ(d-1)𝐩ᵢ - mk·𝐫(ε)⁻¹𝐱ᵢ ≕ f1ᵢ - f2ᵢ + f3ᵢ - f4ᵢ` +- Organize the sixteen terms which result from expanding `⁅f1ᵢ-f2ᵢ+f3ᵢ-f4ᵢ, f1ⱼ-f2ⱼ+f3ⱼ-f4ⱼ⁆` + into four diagonal terms such as `⁅f1ᵢ, f1ⱼ⁆` and six off-diagonal pairs such as + `⁅f1ᵢ, f3ⱼ⁆ + ⁅f3ᵢ, f1ⱼ⁆ = ⁅f1ᵢ, f3ⱼ⁆ - ⁅f1ⱼ, f3ᵢ⁆`. +- Compute the diagonal commutators and off-diagonal pairs individually. Many vanish, and those + that don't are all of the form `iℏ (⋯) 𝐋ᵢⱼ` (as they must to be antisymmetric in `i,j`). +- Collect terms. + +-/ + +private lemma positionDotMomentum_commutation_position {d} (i : Fin d) : + ⁅positionDotMomentum (d := d), 𝐱[i]⁆ = (-Complex.I * ℏ) • 𝐱[i] := by + unfold positionDotMomentum + simp only [← lie_skew 𝐩[_] _, position_commutation_position, position_commutation_momentum, + leibniz_lie, kroneckerDelta, sum_lie, comp_neg, comp_smul] + simp + +private lemma positionDotMomentum_commutation_momentum {d} (i : Fin d) : + ⁅positionDotMomentum (d := d), 𝐩[i]⁆ = (Complex.I * ℏ) • 𝐩[i] := by + unfold positionDotMomentum + simp only [momentum_commutation_momentum, position_commutation_momentum, kroneckerDelta, + sum_lie, leibniz_lie, smul_comp] + simp + +private lemma positionDotMomentum_commutation_momentumSqr {d} : + ⁅positionDotMomentum (d := d), momentumOperatorSqr (d := d)⁆ = (2 * Complex.I * ℏ) • 𝐩² := by + unfold momentumOperatorSqr + simp only [positionDotMomentum_commutation_momentum, lie_sum, lie_leibniz, comp_smul, + smul_comp] + rw [Finset.smul_sum] + congr + ext i ψ x + simp only [ContinuousLinearMap.add_apply, coe_smul', coe_comp', Pi.smul_apply, + Function.comp_apply, SchwartzMap.add_apply, SchwartzMap.smul_apply, smul_eq_mul] + ring + +private lemma positionDotMomentum_commutation_radiusRegPow {d} (hε : 0 < ε) : + ⁅positionDotMomentum (d := d), radiusRegPowOperator (d := d) ε s⁆ = + (-s * Complex.I * ℏ) • (𝐫[ε,s] - ε ^ 2 • 𝐫[ε,s-2]) := by + unfold positionDotMomentum + rw [sum_lie] + conv_lhs => + enter [2, i] + rw [leibniz_lie, position_commutation_radiusRegPow hε, zero_comp, add_zero] + rw [← lie_skew, radiusRegPow_commutation_momentum hε, comp_neg, comp_smul] + rw [comp_eq_comp_sub_commute 𝐫[ε,_] 𝐱[_], position_commutation_radiusRegPow hε, sub_zero, + ← comp_assoc] + rw [Finset.sum_neg_distrib, ← Finset.smul_sum, ← finset_sum_comp] + rw [positionOperatorSqr_eq hε] + rw [sub_comp, smul_comp, id_comp, radiusRegPowOperator_comp_eq hε] + simp + +private lemma positionCompMomentumSqr_comm {d} (i j : Fin d) : + ⁅positionCompMomentumSqr (d := d) i, positionCompMomentumSqr j⁆ = + (-2 * Complex.I * ℏ) • 𝐩² ∘L 𝐋[i,j] := by + unfold positionCompMomentumSqr + rw [leibniz_lie, lie_leibniz, lie_leibniz] + rw [lie_self, ← lie_skew 𝐩² 𝐱[j]] + rw [position_commutation_position, momentumSqr_comp_angularMomentum_commute] + repeat rw [position_commutation_momentumSqr] + unfold angularMomentumOperator + ext ψ x + simp only [comp_zero, neg_comp, smul_comp, zero_add, comp_neg, comp_smulₛₗ, RingHom.id_apply, + zero_comp, add_zero, ContinuousLinearMap.add_apply, ContinuousLinearMap.neg_apply, coe_smul', + coe_comp', Pi.smul_apply, Function.comp_apply, SchwartzMap.add_apply, SchwartzMap.neg_apply, + SchwartzMap.smul_apply, smul_eq_mul, neg_mul, sub_comp, neg_smul, coe_sub', Pi.sub_apply, + SchwartzMap.sub_apply] + ring + +private lemma positionCompMomentumSqr_comm_positionDotMomentumCompMomentum_add {d} (i j : Fin d) : + ⁅positionCompMomentumSqr (d := d) i, positionDotMomentumCompMomentum j⁆ + + ⁅positionDotMomentumCompMomentum i, positionCompMomentumSqr j⁆ = + (-Complex.I * ℏ) • 𝐩² ∘L 𝐋[i,j] := by + unfold positionCompMomentumSqr positionDotMomentumCompMomentum + nth_rw 2 [← lie_skew] + repeat rw [leibniz_lie, lie_leibniz, lie_leibniz] + repeat rw [← lie_skew _ positionDotMomentum] + repeat rw [position_commutation_momentum] + repeat rw [momentumSqr_commutation_momentum] + repeat rw [positionDotMomentum_commutation_position] + repeat rw [positionDotMomentum_commutation_momentumSqr] + simp only [neg_comp, smul_comp, add_comp, comp_zero, zero_add, comp_smul, id_comp, comp_assoc] + repeat rw [comp_eq_comp_add_commute 𝐩² 𝐩[_], momentumSqr_commutation_momentum] + rw [kroneckerDelta_symm j i] + trans (-Complex.I * ℏ) • 𝐋[i,j] ∘L 𝐩² + · ext ψ x + unfold angularMomentumOperator + simp only [add_zero, comp_neg, comp_smulₛₗ, RingHom.id_apply, neg_mul, neg_smul, neg_neg, + coe_sub', Pi.sub_apply, ContinuousLinearMap.add_apply, ContinuousLinearMap.neg_apply, + coe_smul', coe_comp', Pi.smul_apply, Function.comp_apply, SchwartzMap.sub_apply, + SchwartzMap.add_apply, SchwartzMap.neg_apply, SchwartzMap.smul_apply, smul_eq_mul, sub_comp] + ring + rw [comp_eq_comp_sub_commute 𝐩² _, angularMomentum_commutation_momentumSqr, sub_zero] + +private lemma positionDotMomentumCompMomentum_comm {d} (i j : Fin d) : + ⁅positionDotMomentumCompMomentum i, positionDotMomentumCompMomentum j⁆ = 0 := by + unfold positionDotMomentumCompMomentum + rw [leibniz_lie, lie_leibniz, lie_leibniz, lie_self, + ← lie_skew _ positionDotMomentum] + ext ψ x + simp [momentum_commutation_momentum, positionDotMomentum_commutation_momentum, + momentum_comp_commute i j] + +private lemma positionCompMomentumSqr_comm_constMomentum_add {d} (i j : Fin d) : + ⁅positionCompMomentumSqr i, constMomentum j⁆ + + ⁅constMomentum i, positionCompMomentumSqr j⁆ = 0 := by + unfold positionCompMomentumSqr constMomentum + nth_rw 2 [← lie_skew] + repeat rw [lie_smul, leibniz_lie, momentumSqr_commutation_momentum, comp_zero, zero_add, + position_commutation_momentum, smul_comp, id_comp] + rw [kroneckerDelta_symm j i, add_neg_eq_zero] + +private lemma positionDotMomentumCompMomentum_comm_constMomentum_add {d} (i j : Fin d) : + ⁅positionDotMomentumCompMomentum (d := d) i, constMomentum j⁆ + + ⁅constMomentum i, positionDotMomentumCompMomentum j⁆ = 0 := by + unfold positionDotMomentumCompMomentum constMomentum + nth_rw 2 [← lie_skew] + repeat rw [lie_smul, leibniz_lie, momentum_commutation_momentum, comp_zero, zero_add, + positionDotMomentum_commutation_momentum, smul_comp] + rw [momentum_comp_commute, add_neg_eq_zero] + +private lemma constMomentum_comm_constMomentum {d} (i j : Fin d) : + ⁅constMomentum i, constMomentum j⁆ = 0 := by + unfold constMomentum + simp [momentum_commutation_momentum] + +private lemma positionCompMomentumSqr_comm_constRadiusRegInvCompPosition_add + (hε : 0 < ε) (i j : Fin H.d) : + ⁅positionCompMomentumSqr i, constRadiusRegInvCompPosition H ε j⁆ + + ⁅constRadiusRegInvCompPosition H ε i, positionCompMomentumSqr j⁆ = + - (2 * H.m * H.k * Complex.I * ℏ) • 𝐫[ε,-1] ∘L 𝐋[i,j] := by + unfold positionCompMomentumSqr constRadiusRegInvCompPosition + nth_rw 2 [← lie_skew] + repeat rw [lie_smul, leibniz_lie, lie_leibniz, lie_leibniz] + repeat rw [position_commutation_position] + repeat rw [position_commutation_radiusRegPow hε] + repeat rw [← lie_skew 𝐩² _] + repeat rw [position_commutation_momentumSqr] + rw [radiusRegPow_commutation_momentumSqr hε] + rw [← positionDotMomentum] + + simp only [zero_comp, comp_zero, add_zero, comp_smul, comp_add, comp_neg, smul_sub, smul_add, + smul_neg, neg_comp, add_comp, smul_comp, comp_assoc, sub_comp, comp_sub] + repeat rw [comp_eq_comp_add_commute positionDotMomentum 𝐱[_], + positionDotMomentum_commutation_position] + + have hxr : ∀ i : Fin H.d, ∀ s, ∀ (A : 𝓢(Space H.d, ℂ) →L[ℂ] 𝓢(Space H.d, ℂ)), + 𝐱[i] ∘L 𝐫[ε,s] ∘L A = 𝐫[ε,s] ∘L 𝐱[i] ∘L A := by + intro i p A + rw [← comp_assoc, position_comp_radiusRegPow_commute hε, comp_assoc] + repeat rw [hxr] + simp only [comp_add, comp_smul] + rw [position_comp_commute j i] + + have hxx_xp : 𝐱[j] ∘L 𝐱[i] ∘L positionDotMomentum = 𝐱[i] ∘L 𝐱[j] ∘L positionDotMomentum := by + rw [← comp_assoc, position_comp_commute, comp_assoc] + rw [hxx_xp] + + unfold angularMomentumOperator + ext ψ x + simp only [Complex.ofReal_neg, Complex.ofReal_one, mul_neg, mul_one, neg_mul, neg_smul, smul_add, + smul_neg, neg_neg, one_mul, sub_neg_eq_add, neg_add_rev, ContinuousLinearMap.add_apply, + ContinuousLinearMap.neg_apply, coe_smul', coe_comp', Pi.smul_apply, Function.comp_apply, + SchwartzMap.add_apply, SchwartzMap.neg_apply, SchwartzMap.smul_apply, smul_eq_mul, + Complex.real_smul, Complex.ofReal_mul, Complex.ofReal_pow, Complex.ofReal_sub, + Complex.ofReal_ofNat, Complex.ofReal_add, Complex.ofReal_natCast, comp_sub, coe_sub', + Pi.sub_apply, SchwartzMap.sub_apply] + ring + +private lemma positionDotMomentumCompMomentum_comm_constRadiusRegInvCompPosition_add + (hε : 0 < ε) (i j : Fin H.d) : + ⁅positionDotMomentumCompMomentum i, constRadiusRegInvCompPosition H ε j⁆ + + ⁅constRadiusRegInvCompPosition H ε i, positionDotMomentumCompMomentum j⁆ = + (H.m * H.k * Complex.I * ℏ * ε ^ 2) • 𝐫[ε,-3] ∘L 𝐋[i,j] := by + unfold positionDotMomentumCompMomentum constRadiusRegInvCompPosition + nth_rw 2 [← lie_skew] + repeat rw [lie_smul, leibniz_lie, lie_leibniz, lie_leibniz] + repeat rw [← lie_skew 𝐩[_] 𝐱[_], position_commutation_momentum] + repeat rw [positionDotMomentum_commutation_position] + repeat rw [← lie_skew 𝐩[_] _, radiusRegPow_commutation_momentum hε] + repeat rw [positionDotMomentum_commutation_radiusRegPow hε] + simp only [smul_comp, neg_comp, comp_assoc] + rw [position_comp_commute j i, kroneckerDelta_symm j i] + unfold angularMomentumOperator + ext ψ x + simp only [comp_neg, comp_smulₛₗ, RingHom.id_apply, comp_id, Complex.ofReal_neg, + Complex.ofReal_one, neg_mul, one_mul, neg_smul, neg_neg, comp_add, sub_comp, smul_comp, + add_comp, neg_comp, smul_add, smul_neg, neg_add_rev, ContinuousLinearMap.add_apply, + ContinuousLinearMap.neg_apply, coe_smul', coe_comp', Pi.smul_apply, Function.comp_apply, + coe_sub', Pi.sub_apply, SchwartzMap.add_apply, SchwartzMap.neg_apply, SchwartzMap.smul_apply, + smul_eq_mul, Complex.real_smul, Complex.ofReal_mul, SchwartzMap.sub_apply, Complex.ofReal_pow, + comp_sub] + ring_nf + +private lemma constMomentum_comm_constRadiusRegInvCompPosition_add (hε : 0 < ε) (i j : Fin H.d) : + ⁅constMomentum i, constRadiusRegInvCompPosition H ε j⁆ + + ⁅constRadiusRegInvCompPosition H ε i, constMomentum j⁆ = 0 := by + unfold constMomentum constRadiusRegInvCompPosition + nth_rw 2 [← lie_skew] + repeat rw [smul_lie, lie_smul, lie_leibniz] + repeat rw [← lie_skew 𝐩[_] _] + repeat rw [position_commutation_momentum, radiusRegPow_commutation_momentum hε] + simp only [neg_comp, smul_comp, comp_assoc] + rw [position_comp_commute j i, kroneckerDelta_symm j i] + ext ψ x + simp only [comp_neg, comp_smulₛₗ, RingHom.id_apply, comp_id, Complex.ofReal_neg, + Complex.ofReal_one, neg_mul, one_mul, neg_smul, neg_neg, smul_add, smul_neg, neg_add_rev, + ContinuousLinearMap.add_apply, ContinuousLinearMap.neg_apply, coe_smul', Pi.smul_apply, + coe_comp', Function.comp_apply, SchwartzMap.add_apply, SchwartzMap.neg_apply, + SchwartzMap.smul_apply, smul_eq_mul, Complex.real_smul, Complex.ofReal_mul, + ContinuousLinearMap.zero_apply, SchwartzMap.zero_apply] + ring + +private lemma constRadiusRegInvCompPosition_comm_constRadiusRegInvCompPosition + (hε : 0 < ε) (i j : Fin H.d) : + ⁅constRadiusRegInvCompPosition H ε i, constRadiusRegInvCompPosition H ε j⁆ = 0 := by + unfold constRadiusRegInvCompPosition + rw [lie_smul, smul_lie, leibniz_lie, lie_leibniz, lie_leibniz] + rw [← lie_skew 𝐫[ε,-1] _] + rw [position_commutation_position] + rw [radiusRegPow_commutation_radiusRegPow hε] + repeat rw [position_commutation_radiusRegPow hε] + simp only [comp_zero, zero_comp, add_zero, neg_zero, smul_zero] + +/-- `⁅𝐀(ε)ᵢ, 𝐀(ε)ⱼ⁆ = -iℏ 2m 𝐇(ε)𝐋ᵢⱼ` -/ +lemma lrl_commutation_lrl (hε : 0 < ε) (i j : Fin H.d) : ⁅H.lrlOperator ε i, H.lrlOperator ε j⁆ + = (-2 * Complex.I * ℏ * H.m) • (H.hamiltonianReg ε) ∘L 𝐋[i,j] := by + repeat rw [lrlOperator_eq] + + let f_x_p_sqr := positionCompMomentumSqr (d := H.d) + let f_xdotp_p := positionDotMomentumCompMomentum (d := H.d) + let f_const_p := constMomentum (d := H.d) + let f_c_rinvx := constRadiusRegInvCompPosition H ε + trans ⁅f_x_p_sqr i, f_x_p_sqr j⁆ + ⁅f_xdotp_p i, f_xdotp_p j⁆ + + ⁅f_const_p i, f_const_p j⁆ + ⁅f_c_rinvx i, f_c_rinvx j⁆ + - (⁅f_x_p_sqr i, f_xdotp_p j⁆ + ⁅f_xdotp_p i, f_x_p_sqr j⁆) + + (⁅f_x_p_sqr i, f_const_p j⁆ + ⁅f_const_p i, f_x_p_sqr j⁆) + - (⁅f_x_p_sqr i, f_c_rinvx j⁆ + ⁅f_c_rinvx i, f_x_p_sqr j⁆) + - (⁅f_xdotp_p i, f_const_p j⁆ + ⁅f_const_p i, f_xdotp_p j⁆) + + (⁅f_xdotp_p i, f_c_rinvx j⁆ + ⁅f_c_rinvx i, f_xdotp_p j⁆) + - (⁅f_const_p i, f_c_rinvx j⁆ + ⁅f_c_rinvx i, f_const_p j⁆) + · unfold f_x_p_sqr f_xdotp_p f_const_p f_c_rinvx + unfold positionCompMomentumSqr positionDotMomentumCompMomentum constMomentum + constRadiusRegInvCompPosition positionDotMomentum + simp only [lie_add, lie_sub, add_lie, sub_lie] + ext ψ x + simp only [ContinuousLinearMap.sub_apply, ContinuousLinearMap.add_apply, SchwartzMap.sub_apply, + SchwartzMap.add_apply] + ring + + rw [positionCompMomentumSqr_comm] + rw [positionDotMomentumCompMomentum_comm] + rw [positionCompMomentumSqr_comm_positionDotMomentumCompMomentum_add] + rw [positionCompMomentumSqr_comm_constMomentum_add] + rw [positionDotMomentumCompMomentum_comm_constMomentum_add] + rw [constMomentum_comm_constMomentum] + rw [positionCompMomentumSqr_comm_constRadiusRegInvCompPosition_add H hε] + rw [positionDotMomentumCompMomentum_comm_constRadiusRegInvCompPosition_add H hε] + rw [constMomentum_comm_constRadiusRegInvCompPosition_add H hε] + rw [constRadiusRegInvCompPosition_comm_constRadiusRegInvCompPosition H hε] + + unfold hamiltonianReg + ext ψ x + simp only [ContinuousLinearMap.add_apply, coe_smul', coe_comp', Pi.smul_apply, + Function.comp_apply, SchwartzMap.add_apply, SchwartzMap.smul_apply, smul_eq_mul, + coe_sub', Pi.sub_apply, SchwartzMap.sub_apply, Complex.real_smul, Complex.ofReal_mul, + Complex.ofReal_inv, Complex.ofReal_pow, ContinuousLinearMap.zero_apply, SchwartzMap.zero_apply] + ring_nf + simp + +/- +## Hamiltonian / LRL vector commutators +-/ + +private lemma pSqr_comm_pL_Lp (i : Fin H.d) : + ⁅momentumOperatorSqr (d := H.d), ∑ j, (𝐩[j] ∘L 𝐋[i,j] + 𝐋[i,j] ∘L 𝐩[j])⁆ = 0 := by + rw [lie_sum] + conv_lhs => + enter [2, j] + rw [lie_add, lie_leibniz, lie_leibniz] + rw [momentumSqr_commutation_momentum] + rw [← lie_skew, angularMomentum_commutation_momentumSqr] + simp only [neg_zero, comp_zero, zero_comp, add_zero, Finset.sum_const_zero] + +private lemma rr_comm_rx (hε : 0 < ε) (i : Fin H.d) : + ⁅radiusRegPowOperator (d := H.d) ε (-1) + (2⁻¹ * ε ^ 2) • 𝐫[ε,-3], 𝐫[ε,-1] ∘L 𝐱[i]⁆ = 0 := by + rw [add_lie, smul_lie, lie_leibniz, lie_leibniz] + repeat rw [radiusRegPow_commutation_radiusRegPow hε] + repeat rw [← lie_skew, position_commutation_radiusRegPow hε] + simp only [neg_zero, comp_zero, zero_comp, add_zero, smul_zero] + +private lemma pSqr_comm_rx (hε : 0 < ε) (i : Fin H.d) : + ⁅momentumOperatorSqr (d := H.d), 𝐫[ε,-1] ∘L 𝐱[i]⁆ = + (-2 * Complex.I * ℏ) • 𝐫[ε,-1] ∘L 𝐩[i] + + (ℏ ^ 2 * (H.d - 3) : ℝ) • 𝐫[ε,-3] ∘L 𝐱[i] + + (3 * ℏ ^ 2 * ε ^ 2) • 𝐫[ε,-5] ∘L 𝐱[i] + + (2 * Complex.I * ℏ) • 𝐫[ε,-3] ∘L (∑ j, 𝐱[j] ∘L 𝐩[j]) ∘L 𝐱[i] := by + rw [lie_leibniz] + rw [← lie_skew, position_commutation_momentumSqr] + rw [← lie_skew, radiusRegPow_commutation_momentumSqr hε] + ext ψ x + simp only [comp_neg, comp_smulₛₗ, RingHom.id_apply, Complex.ofReal_neg, Complex.ofReal_one, + mul_neg, mul_one, neg_mul, neg_smul, one_mul, neg_add_rev, neg_neg, add_comp, smul_comp, + sub_comp, ContinuousLinearMap.add_apply, ContinuousLinearMap.neg_apply, coe_smul', coe_comp', + Pi.smul_apply, Function.comp_apply, coe_sub', Pi.sub_apply, coe_sum', Finset.sum_apply, map_sum, + SchwartzMap.add_apply, SchwartzMap.neg_apply, SchwartzMap.smul_apply, smul_eq_mul, + SchwartzMap.sub_apply, Complex.real_smul, Complex.ofReal_sub, Complex.ofReal_add, + Complex.ofReal_natCast, Complex.ofReal_ofNat, Complex.ofReal_mul, Complex.ofReal_pow, + SchwartzMap.sum_apply] + ring_nf + +private lemma rr_comm_pL_Lp (hε : 0 < ε) (i : Fin H.d) : + ⁅radiusRegPowOperator (d := H.d) ε (-1) + (2⁻¹ * ε ^ 2) • 𝐫[ε,-3], + ∑ j, (𝐩[j] ∘L 𝐋[i,j] + 𝐋[i,j] ∘L 𝐩[j])⁆ = + (- Complex.I * ℏ) • + (𝐫[ε,-3] + (3 * 2⁻¹ * ε ^ 2) • 𝐫[ε,-5]) ∘L ∑ j, (𝐱[j] ∘L 𝐋[i,j] + 𝐋[i,j] ∘L 𝐱[j]) := by + rw [lie_sum] + conv_lhs => + enter [2, j] + simp only [add_lie, lie_add, smul_lie, lie_leibniz] + repeat rw [← lie_skew _ 𝐋[_,_], angularMomentum_commutation_radiusRegPow hε] + repeat rw [radiusRegPow_commutation_momentum hε] + simp only [neg_zero, comp_zero, zero_comp, zero_add, add_zero] + simp only [smul_comp, comp_smul, smul_add, ← comp_assoc] + repeat rw [comp_eq_comp_add_commute 𝐋[_,_] 𝐫[ε,_], + angularMomentum_commutation_radiusRegPow hε] + simp only [comp_assoc] + simp only [Finset.sum_add_distrib, ← Finset.smul_sum, ← comp_finset_sum] + ext ψ x + simp only [Complex.ofReal_neg, Complex.ofReal_one, neg_mul, one_mul, neg_smul, + Complex.ofReal_ofNat, smul_neg, add_zero, ContinuousLinearMap.add_apply, + ContinuousLinearMap.neg_apply, coe_smul', coe_comp', coe_sum', Pi.smul_apply, + Function.comp_apply, Finset.sum_apply, map_sum, SchwartzMap.add_apply, SchwartzMap.neg_apply, + SchwartzMap.smul_apply, SchwartzMap.sum_apply, smul_eq_mul, Complex.real_smul, + Complex.ofReal_mul, Complex.ofReal_inv, Complex.ofReal_pow, comp_add, add_comp, smul_comp, + smul_add] + ring_nf + +private lemma xL_Lx_eq (hε : 0 < ε) (i : Fin H.d) : ∑ j, (𝐱[j] ∘L 𝐋[i,j] + 𝐋[i,j] ∘L 𝐱[j]) = + (2 : ℝ) • (∑ j, 𝐱[j] ∘L 𝐩[j]) ∘L 𝐱[i] - (2 : ℝ) • 𝐫[ε,2] ∘L 𝐩[i] + (2 * ε ^ 2) • 𝐩[i] + - (Complex.I * ℏ * (H.d - 3)) • 𝐱[i] := by + conv_lhs => + enter [2, j] + calc + _ = 𝐱[j] ∘L (𝐱[i] ∘L 𝐩[j] - 𝐱[j] ∘L 𝐩[i]) + + (𝐱[i] ∘L 𝐩[j] - 𝐱[j] ∘L 𝐩[i]) ∘L 𝐱[j] := rfl + _ = 𝐱[j] ∘L 𝐱[i] ∘L 𝐩[j] + 𝐱[i] ∘L 𝐩[j] ∘L 𝐱[j] + - 𝐱[j] ∘L 𝐱[j] ∘L 𝐩[i] - 𝐱[j] ∘L 𝐩[i] ∘L 𝐱[j] := by + rw [comp_sub, sub_comp] + ext ψ x + simp only [ContinuousLinearMap.add_apply, coe_sub', coe_comp', Pi.sub_apply, + Function.comp_apply, SchwartzMap.add_apply, SchwartzMap.sub_apply] + ring + _ = 𝐱[j] ∘L 𝐩[j] ∘L 𝐱[i] + 𝐱[i] ∘L 𝐱[j] ∘L 𝐩[j] - (2 : ℝ) • 𝐱[j] ∘L 𝐱[j] ∘L 𝐩[i] + + (2 * Complex.I * ℏ * δ[i,j]) • 𝐱[j] - (Complex.I * ℏ) • 𝐱[i] := by + rw [comp_eq_comp_add_commute 𝐱[i] 𝐩[j], position_commutation_momentum] + rw [comp_eq_comp_sub_commute 𝐩[i] 𝐱[j], position_commutation_momentum] + rw [comp_eq_comp_add_commute 𝐱[j] 𝐩[j], position_commutation_momentum] + rw [kroneckerDelta_symm j i, kroneckerDelta_self] + ext ψ x + simp only [comp_add, comp_smulₛₗ, RingHom.id_apply, comp_id, comp_sub, coe_sub', coe_comp', + coe_smul', Pi.sub_apply, ContinuousLinearMap.add_apply, Function.comp_apply, + Pi.smul_apply, SchwartzMap.sub_apply, SchwartzMap.add_apply, SchwartzMap.smul_apply, + smul_eq_mul, mul_one, Complex.real_smul, Complex.ofReal_ofNat] + ring + _ = 𝐱[j] ∘L 𝐩[j] ∘L 𝐱[i] + 𝐱[j] ∘L 𝐱[i] ∘L 𝐩[j] - (2 : ℝ) • 𝐱[j] ∘L 𝐱[j] ∘L 𝐩[i] + + (2 * Complex.I * ℏ * δ[i,j]) • 𝐱[j] - (Complex.I * ℏ) • 𝐱[i] := by + nth_rw 2 [← comp_assoc] + rw [position_comp_commute i j, comp_assoc] + _ = (2 : ℝ) • (𝐱[j] ∘L 𝐩[j]) ∘L 𝐱[i] - (2 : ℝ) • (𝐱[j] ∘L 𝐱[j]) ∘L 𝐩[i] + + (3 * Complex.I * ℏ * δ[i,j]) • 𝐱[j] - (Complex.I * ℏ) • 𝐱[i] := by + rw [comp_eq_comp_add_commute 𝐱[i] 𝐩[j], position_commutation_momentum] + ext ψ x + simp only [comp_add, comp_smulₛₗ, RingHom.id_apply, comp_id, coe_sub', coe_smul', + Pi.sub_apply, ContinuousLinearMap.add_apply, coe_comp', Function.comp_apply, + Pi.smul_apply, SchwartzMap.sub_apply, SchwartzMap.add_apply, SchwartzMap.smul_apply, + smul_eq_mul, Complex.real_smul, Complex.ofReal_ofNat, sub_left_inj] + ring + simp only [Finset.sum_sub_distrib, Finset.sum_add_distrib, ← Finset.smul_sum, ← finset_sum_comp] + rw [positionOperatorSqr_eq hε, sub_comp, smul_comp, id_comp] + + unfold kroneckerDelta + ext ψ x + simp only [ContinuousLinearMap.sub_apply, ContinuousLinearMap.add_apply, + ContinuousLinearMap.smul_apply, ContinuousLinearMap.sum_apply, SchwartzMap.sub_apply, + SchwartzMap.add_apply, SchwartzMap.smul_apply, SchwartzMap.sum_apply] + simp only [coe_comp', coe_sum', Function.comp_apply, Finset.sum_apply, SchwartzMap.sum_apply, + Complex.real_smul, Complex.ofReal_ofNat, Complex.ofReal_pow, mul_ite, mul_one, mul_zero, + smul_eq_mul, ite_mul, zero_mul, Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte, + Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul, Complex.ofReal_mul] + ring + +/-- `⁅𝐇(ε), 𝐀(ε)ᵢ⁆ = iℏkε²(¾𝐫(ε)⁻⁵(𝐱ⱼ𝐋ᵢⱼ + 𝐋ᵢⱼ𝐱ⱼ) + 3iℏ/2 𝐫(ε)⁻⁵𝐱ᵢ + 𝐫(ε)⁻³𝐩ᵢ)` -/ +lemma hamiltonianReg_commutation_lrl (hε : 0 < ε) (i : Fin H.d) : + ⁅H.hamiltonianReg ε, H.lrlOperator ε i⁆ = (Complex.I * ℏ * H.k * ε ^ 2) • + ((3 * 4⁻¹ : ℝ) • 𝐫[ε,-5] ∘L ∑ j, (𝐱[j] ∘L 𝐋[i,j] + 𝐋[i,j] ∘L 𝐱[j]) + + (3 * 2⁻¹ * Complex.I * ℏ) • 𝐫[ε,-5] ∘L 𝐱[i] + 𝐫[ε,-3] ∘L 𝐩[i]) := by + unfold hamiltonianReg lrlOperator + rw [sub_lie, lie_sub, lie_sub] + simp only [lie_smul, smul_lie] + + rw [pSqr_comm_pL_Lp] + rw [rr_comm_rx H hε] + rw [pSqr_comm_rx H hε] + rw [rr_comm_pL_Lp H hε] + rw [xL_Lx_eq H hε] + + simp only [smul_zero, sub_zero, zero_sub, smul_smul, smul_add, smul_sub, comp_smul, smul_comp, + add_comp, comp_sub, comp_add] + simp only [← comp_assoc, radiusRegPowOperator_comp_eq hε] + rw [comp_assoc] + field_simp + rw [← sub_eq_zero] + + ext ψ x + simp only [neg_smul, smul_neg, neg_add_rev, neg_neg, Complex.I_sq, neg_mul, one_mul, coe_sub', + Pi.sub_apply, ContinuousLinearMap.add_apply, ContinuousLinearMap.neg_apply, coe_smul', + coe_comp', coe_sum', Pi.smul_apply, Function.comp_apply, Finset.sum_apply, map_sum, + SchwartzMap.sub_apply, SchwartzMap.add_apply, SchwartzMap.neg_apply, SchwartzMap.smul_apply, + SchwartzMap.sum_apply, smul_eq_mul, Complex.real_smul, Complex.ofReal_div, Complex.ofReal_ofNat, + Complex.ofReal_mul, Complex.ofReal_pow, Complex.ofReal_sub, Complex.ofReal_natCast, + ContinuousLinearMap.zero_apply, SchwartzMap.zero_apply] + ring_nf + rw [Complex.I_sq] + simp + +/- + +## LRL vector squared + +To compute `𝐀(ε)²` we take the following approach: +- Write `𝐀(ε)ᵢ = 𝐋ᵢⱼ𝐩ⱼ + ½iℏ(d-1)𝐩ᵢ - mk·𝐫(ε)⁻¹𝐱ᵢ` for the first term and + `𝐀(ε)ᵢ = 𝐩ⱼ𝐋ᵢⱼ - ½iℏ(d-1)𝐩ᵢ - mk·𝐫(ε)⁻¹𝐱ᵢ` for the second. +- Expand out to nine terms: one is a triple sum, two are double sums and the rest are single sums. +- Compute each term, symmetrizing the sums (see `sum_symmetrize` and `sum_symmetrize'`). +- Collect terms. + +-/ + +private lemma sum_symmetrize (f : Fin H.d → Fin H.d → 𝓢(Space H.d, ℂ) →L[ℂ] 𝓢(Space H.d, ℂ)) : + ∑ i, ∑ j, f i j = (2 : ℂ)⁻¹ • ∑ i, ∑ j, (f i j + f j i) := by + simp only [Finset.sum_add_distrib] + nth_rw 3 [Finset.sum_comm] + ext ψ x + rw [ContinuousLinearMap.smul_apply, SchwartzMap.smul_apply, ContinuousLinearMap.add_apply, + SchwartzMap.add_apply, smul_eq_mul] + ring + +private lemma sum_symmetrize' + (f : Fin H.d → Fin H.d → Fin H.d → 𝓢(Space H.d, ℂ) →L[ℂ] 𝓢(Space H.d, ℂ)) : + ∑ i, ∑ j, ∑ k, f i j k = (2 : ℂ)⁻¹ • ∑ i, ∑ k, ∑ j, (f i j k + f k j i) := by + simp only [Finset.sum_add_distrib] + nth_rw 3 [Finset.sum_comm] + conv_rhs => + enter [2, 1, 2, i] + rw [Finset.sum_comm] + conv_rhs => + enter [2, 2, 2, i] + rw [Finset.sum_comm] + ext ψ x + rw [ContinuousLinearMap.smul_apply, SchwartzMap.smul_apply, ContinuousLinearMap.add_apply, + SchwartzMap.add_apply, smul_eq_mul] + ring + +private lemma sum_Lpp_zero : ∑ i : Fin H.d, ∑ j, 𝐋[i,j] ∘L 𝐩[j] ∘L 𝐩[i] = 0 := by + rw [sum_symmetrize] + conv_lhs => + enter [2, 2, i, 2, j] + rw [angularMomentumOperator_antisymm j i, momentum_comp_commute j i, neg_comp, add_neg_cancel] + simp + +private lemma sum_ppL_zero : ∑ i : Fin H.d, ∑ j, 𝐩[i] ∘L 𝐩[j] ∘L 𝐋[i,j] = 0 := by + rw [sum_symmetrize] + conv_lhs => + enter [2, 2, i, 2, j] + rw [← comp_assoc, ← comp_assoc] + rw [angularMomentumOperator_antisymm j i, momentum_comp_commute j i, comp_neg, add_neg_cancel] + simp + +private lemma sum_LppL : ∑ i : Fin H.d, ∑ j, ∑ k, 𝐋[i,j] ∘L 𝐩[j] ∘L 𝐩[k] ∘L 𝐋[i,k] + = 𝐩² ∘L 𝐋² := by + -- Apply a particular symmetrization to the triple sum + rw [sum_symmetrize'] + conv_lhs => + enter [2, 2, i, 2, j, 2, k] + rw [angularMomentumOperator_antisymm j i] + repeat rw [comp_neg] + repeat rw [← comp_assoc] + rw [← sub_eq_add_neg, ← sub_comp] + enter [1] + unfold angularMomentumOperator + calc + _ = 𝐱[i] ∘L 𝐩[k] ∘L 𝐩[k] ∘L 𝐩[j] - 𝐱[k] ∘L 𝐩[i] ∘L 𝐩[k] ∘L 𝐩[j] + - 𝐱[j] ∘L 𝐩[k] ∘L 𝐩[k] ∘L 𝐩[i] + 𝐱[k] ∘L 𝐩[j] ∘L 𝐩[k] ∘L 𝐩[i] := by + simp only [sub_comp, comp_assoc, sub_add] + + _ = 𝐱[i] ∘L 𝐩[k] ∘L 𝐩[k] ∘L 𝐩[j] - 𝐱[j] ∘L 𝐩[k] ∘L 𝐩[k] ∘L 𝐩[i] := by + nth_rw 2 [momentum_comp_commute k j] + nth_rw 2 [momentum_comp_commute k i] + nth_rw 4 [← comp_assoc] + rw [momentum_comp_commute i j, comp_assoc] + ext ψ x + simp only [ContinuousLinearMap.add_apply, coe_sub', coe_comp', Pi.sub_apply, + Function.comp_apply, SchwartzMap.add_apply, SchwartzMap.sub_apply] + ring + + -- Back out of inner sum + conv_lhs => + enter [2, 2, i, 2, j] + rw [← finset_sum_comp, Finset.sum_sub_distrib, ← comp_finset_sum, ← comp_finset_sum] + simp only [← comp_assoc, ← finset_sum_comp] + rw [← momentumOperatorSqr] + repeat rw [comp_eq_comp_add_commute 𝐱[_] 𝐩², position_commutation_momentumSqr, add_comp, + smul_comp, comp_assoc] + rw [momentum_comp_commute j i] + rw [add_sub_add_right_eq_sub] + rw [← comp_sub, ← angularMomentumOperator, comp_assoc] + + simp only [← comp_finset_sum] + rw [← comp_smul, ← angularMomentumOperatorSqr] + +private lemma sum_Lprx (hε : 0 < ε) : + ∑ i : Fin H.d, ∑ j, 𝐋[i,j] ∘L 𝐩[j] ∘L 𝐫[ε,-1] ∘L 𝐱[i] = 𝐫[ε,-1] ∘L 𝐋² := by + simp only [comp_eq_comp_sub_commute 𝐫[ε,-1] 𝐱[_], position_commutation_radiusRegPow hε, + sub_zero] + simp only [← comp_assoc, ← finset_sum_comp _ 𝐫[ε,-1]] + rw [sum_symmetrize] + conv_lhs => + enter [1, 2, 2, i, 2, j] + rw [angularMomentumOperator_antisymm j i, neg_comp, neg_comp, ← sub_eq_add_neg] + rw [comp_assoc, comp_assoc, ← comp_sub] + repeat rw [comp_eq_comp_sub_commute 𝐩[_] 𝐱[_], position_commutation_momentum] + rw [kroneckerDelta_symm j i, sub_sub_sub_cancel_right] + rw [← angularMomentumOperator] + rw [← angularMomentumOperatorSqr, ← sub_eq_zero] + exact angularMomentumSqr_commutation_radiusRegPow hε + +private lemma sum_rxpL : + ∑ i : Fin H.d, ∑ j, 𝐫[ε,-1] ∘L 𝐱[i] ∘L 𝐩[j] ∘L 𝐋[i,j] = 𝐫[ε,-1] ∘L 𝐋² := by + simp only [← comp_finset_sum 𝐫[ε,-1]] + rw [sum_symmetrize] + conv_lhs => + enter [2, 2, 2, i, 2, j] + rw [angularMomentumOperator_antisymm j i, comp_neg, comp_neg, ← sub_eq_add_neg] + rw [← comp_assoc, ← comp_assoc, ← sub_comp, ← angularMomentumOperator] + rw [← angularMomentumOperatorSqr] + +private lemma sum_prx (hε : 0 < ε) : ∑ i : Fin H.d, 𝐩[i] ∘L 𝐫[ε,-1] ∘L 𝐱[i] = + 𝐫[ε,-1] ∘L ∑ i : Fin H.d, 𝐱[i] ∘L 𝐩[i] - (Complex.I * ℏ * (H.d - 1)) • 𝐫[ε,-1] + - (Complex.I * ℏ * ε ^ 2) • 𝐫[ε,-3] := by + conv_lhs => + enter [2, i] + rw [← comp_assoc, comp_eq_comp_sub_commute 𝐩[_] 𝐫[ε,-1], radiusRegPow_commutation_momentum hε] + rw [sub_comp, smul_comp, comp_assoc, comp_assoc] + rw [comp_eq_comp_sub_commute 𝐩[_] 𝐱[_], position_commutation_momentum] + rw [kroneckerDelta_self] + rw [comp_sub, comp_smul, comp_id] + repeat rw [Finset.sum_sub_distrib, ← Finset.smul_sum, ← comp_finset_sum] + rw [positionOperatorSqr_eq hε, comp_sub, radiusRegPowOperator_comp_eq hε, comp_smul, comp_id] + + ext ψ x + simp only [ContinuousLinearMap.sub_apply, SchwartzMap.sub_apply, ContinuousLinearMap.smul_apply, + SchwartzMap.smul_apply, ContinuousLinearMap.sum_apply, SchwartzMap.sum_apply] + simp only [coe_comp', coe_sum', Function.comp_apply, Finset.sum_apply, map_sum, + SchwartzMap.sum_apply, mul_one, Finset.sum_const, Finset.card_univ, Fintype.card_fin, + nsmul_eq_mul, smul_eq_mul, Complex.ofReal_neg, Complex.ofReal_one, neg_mul, one_mul, + sub_add_cancel, Complex.real_smul, Complex.ofReal_pow, sub_neg_eq_add] + ring_nf + +private lemma sum_rxp : ∑ i : Fin H.d, 𝐫[ε,-1] ∘L 𝐱[i] ∘L 𝐩[i] = + 𝐫[ε,-1] ∘L ∑ i : Fin H.d, 𝐱[i] ∘L 𝐩[i] := by rw [comp_finset_sum] + +private lemma sum_rxrx (hε : 0 < ε) : ∑ i, 𝐫[ε,-1] ∘L 𝐱[i] ∘L 𝐫[ε,-1] ∘L 𝐱[i] = + ContinuousLinearMap.id ℂ 𝓢(Space H.d, ℂ) - (ε ^ 2) • 𝐫[ε,-2] := by + conv_lhs => + enter [2, i] + calc + _ = 𝐫[ε,-1] ∘L 𝐫[ε,-1] ∘L 𝐱[i] ∘L 𝐱[i] := by + nth_rw 2 [← comp_assoc] + rw [comp_eq_comp_add_commute 𝐱[i] 𝐫[ε,-1], position_commutation_radiusRegPow hε, + add_zero, comp_assoc] + _ = 𝐫[ε,-2] ∘L 𝐱[i] ∘L 𝐱[i] := by + rw [← comp_assoc, radiusRegPowOperator_comp_eq hε] + congr + ring + rw [← comp_finset_sum, positionOperatorSqr_eq hε, comp_sub, comp_smul, comp_id, + radiusRegPowOperator_comp_eq hε, neg_add_cancel, radiusRegPowOperator_zero hε] + +/-- The square of the (regularized) LRL vector operator is related to the (regularized) Hamiltonian + `𝐇(ε)` of the hydrogen atom, square of the angular momentum `𝐋²` and powers of `𝐫(ε)` as + `𝐀(ε)² = 2m 𝐇(ε)(𝐋² + ¼ℏ²(d-1)²) + m²k² - m²k²ε²𝐫(ε)⁻² + mkε²𝐫(ε)⁻³(𝐋² + ¼ℏ²(d-1)(d-3))`. -/ +lemma lrlOperatorSqr_eq (hε : 0 < ε) : H.lrlOperatorSqr ε = + (2 * H.m) • (H.hamiltonianReg ε) ∘L + (𝐋² + (4⁻¹ * ℏ ^ 2 * (H.d - 1) ^ 2 : ℝ) • ContinuousLinearMap.id ℂ 𝓢(Space H.d, ℂ)) + + (H.m * H.k) ^ 2 • ContinuousLinearMap.id ℂ 𝓢(Space H.d, ℂ) + - ((H.m * H.k) ^ 2 * ε ^ 2) • 𝐫[ε,-2] + + (H.m * H.k * ε ^ 2) • 𝐫[ε,-3] ∘L + (𝐋² + (4⁻¹ * ℏ^2 * (H.d - 1) * (H.d - 3) : ℝ) • + ContinuousLinearMap.id ℂ 𝓢(Space H.d, ℂ)) := by + unfold lrlOperatorSqr + + let a := (2⁻¹ * Complex.I * ℏ * (H.d - 1)) + + -- Replace the two copies of `𝐀(ε)` in different ways and expand to nine terms + conv_lhs => + enter [2, i, 1] + rw [lrlOperator_eq'] + conv_lhs => + enter [2, i] + rw [lrlOperator_eq''] + calc + _ = (∑ j, 𝐋[i,j] ∘L 𝐩[j]) ∘L (∑ k, 𝐩[k] ∘L 𝐋[i,k]) + - a • (∑ j, 𝐋[i,j] ∘L 𝐩[j]) ∘L 𝐩[i] + + a • 𝐩[i] ∘L (∑ k, 𝐩[k] ∘L 𝐋[i,k]) + - (a * a) • 𝐩[i] ∘L 𝐩[i] + - (H.m * H.k) • (∑ j, 𝐋[i,j] ∘L 𝐩[j]) ∘L 𝐫[ε,-1] ∘L 𝐱[i] + - (H.m * H.k) • 𝐫[ε,-1] ∘L 𝐱[i] ∘L (∑ k, 𝐩[k] ∘L 𝐋[i,k]) + - (a * H.m * H.k) • 𝐩[i] ∘L 𝐫[ε,-1] ∘L 𝐱[i] + + (a * H.m * H.k) • 𝐫[ε,-1] ∘L 𝐱[i] ∘L 𝐩[i] + + (H.m * H.k) ^ 2 • 𝐫[ε,-1] ∘L 𝐱[i] ∘L 𝐫[ε,-1] ∘L 𝐱[i] := by + simp only [comp_sub, add_comp, sub_comp, comp_smul, smul_comp] + ext ψ x + simp only [coe_sub', coe_smul', coe_comp', coe_sum', Pi.sub_apply, Function.comp_apply, + ContinuousLinearMap.add_apply, Finset.sum_apply, Pi.smul_apply, SchwartzMap.sub_apply, + SchwartzMap.add_apply, SchwartzMap.sum_apply, SchwartzMap.smul_apply, + smul_eq_mul, Complex.real_smul, Complex.ofReal_mul, Complex.ofReal_pow] + ring + _ = ∑ j, ∑ k, 𝐋[i,j] ∘L 𝐩[j] ∘L 𝐩[k] ∘L 𝐋[i,k] + - a • (∑ j, 𝐋[i,j] ∘L 𝐩[j] ∘L 𝐩[i]) + + a • (∑ k, 𝐩[i] ∘L 𝐩[k] ∘L 𝐋[i,k]) + - (a * a) • 𝐩[i] ∘L 𝐩[i] + - (H.m * H.k) • (∑ j, 𝐋[i,j] ∘L 𝐩[j] ∘L 𝐫[ε,-1] ∘L 𝐱[i]) + - (H.m * H.k) • (∑ k, 𝐫[ε,-1] ∘L 𝐱[i] ∘L 𝐩[k] ∘L 𝐋[i,k]) + - (a * H.m * H.k) • 𝐩[i] ∘L 𝐫[ε,-1] ∘L 𝐱[i] + + (a * H.m * H.k) • 𝐫[ε,-1] ∘L 𝐱[i] ∘L 𝐩[i] + + (H.m * H.k) ^ 2 • 𝐫[ε,-1] ∘L 𝐱[i] ∘L 𝐫[ε,-1] ∘L 𝐱[i] := by + repeat rw [finset_sum_comp, comp_finset_sum] + ext ψ x + simp only [ContinuousLinearMap.add_apply, coe_sub', coe_smul', coe_comp', coe_sum', + Pi.sub_apply, Finset.sum_apply, Function.comp_apply, map_sum, Pi.smul_apply, + SchwartzMap.add_apply, SchwartzMap.sub_apply, SchwartzMap.sum_apply, smul_eq_mul, + SchwartzMap.smul_apply, Complex.real_smul, Complex.ofReal_mul, Complex.ofReal_pow] + + -- Split the outer sum + simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib, ← Finset.smul_sum] + + rw [sum_LppL] -- ∑∑∑ LppL = p²L² + rw [sum_Lpp_zero, smul_zero] -- ∑∑ Lpp = 0 + rw [sum_ppL_zero, smul_zero] -- ∑∑ ppL = 0 + rw [← momentumOperatorSqr] -- ∑ pp = p² + rw [sum_Lprx H hε] -- ∑∑ Lpr⁻¹x = r⁻¹L² + rw [sum_rxpL] -- ∑∑ r⁻¹xpL = r⁻¹L² + rw [sum_prx H hε] -- ∑ pr⁻¹x = r⁻¹ ∑ xp - iℏ(d-1)r⁻¹ - iℏε²r⁻³ + rw [sum_rxp] -- ∑ r⁻¹xp = r⁻¹ ∑ xp + rw [sum_rxrx H hε] -- ∑ r⁻¹xr⁻¹x = 1 - ε²r⁻² + + unfold a hamiltonianReg + ext ψ x + simp only [ContinuousLinearMap.add_apply, coe_sub', coe_comp', coe_smul', SchwartzMap.add_apply, + Pi.sub_apply, Function.comp_apply, Pi.smul_apply, SchwartzMap.sub_apply, smul_eq_mul, + SchwartzMap.smul_apply, Complex.real_smul, Complex.ofReal_mul, Complex.ofReal_ofNat] + ring_nf + rw [Complex.I_sq] + simp only [neg_mul, one_mul, one_div, sub_neg_eq_add, Complex.ofReal_mul, Complex.ofReal_pow, + coe_id', id_eq, Complex.ofReal_inv, Complex.ofReal_ofNat, map_add, map_smul_of_tower, + SchwartzMap.add_apply, SchwartzMap.smul_apply, Complex.real_smul, Complex.ofReal_add, + Complex.ofReal_natCast, Complex.ofReal_div, Complex.ofReal_neg, Complex.ofReal_one, + Complex.ofReal_sub, ne_eq, Complex.ofReal_eq_zero, m_ne_zero, not_false_eq_true, + mul_inv_cancel_left₀, add_left_inj] + ring + +end +end HydrogenAtom +end QuantumMechanics diff --git a/PhysLean/QuantumMechanics/DDimensions/Operators/AngularMomentum.lean b/PhysLean/QuantumMechanics/DDimensions/Operators/AngularMomentum.lean new file mode 100644 index 000000000..7c5a72d3e --- /dev/null +++ b/PhysLean/QuantumMechanics/DDimensions/Operators/AngularMomentum.lean @@ -0,0 +1,107 @@ +/- +Copyright (c) 2026 Gregory J. Loges. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gregory J. Loges +-/ +import PhysLean.QuantumMechanics.DDimensions.Operators.Position +import PhysLean.QuantumMechanics.DDimensions.Operators.Momentum +/-! + +# Angular momentum operator + +In this module we define: +- The angular momentum operator on Schwartz maps, component-wise. +- The angular momentum squared operator. +- The angular momentum scalar operator in 2d and angular momentum vector operator in 3d. + +-/ + +namespace QuantumMechanics +noncomputable section +open Constants +open ContDiff SchwartzMap + +/- + +# Definition + +-/ + +/-- Component `i j` of the angular momentum operator is the continuous linear map +from `𝓢(Space d, ℂ)` to itself defined by `𝐋ᵢⱼ ≔ 𝐱ᵢ∘𝐩ⱼ - 𝐱ⱼ∘𝐩ᵢ`. -/ +def angularMomentumOperator {d : ℕ} (i j : Fin d) : 𝓢(Space d, ℂ) →L[ℂ] 𝓢(Space d, ℂ) := + 𝐱[i] ∘L 𝐩[j] - 𝐱[j] ∘L 𝐩[i] + +@[inherit_doc angularMomentumOperator] +macro "𝐋[" i:term "," j:term "]" : term => `(angularMomentumOperator $i $j) + +lemma angularMomentumOperator_apply_fun {d : ℕ} (i j : Fin d) (ψ : 𝓢(Space d, ℂ)) : + 𝐋[i,j] ψ = 𝐱[i] (𝐩[j] ψ) - 𝐱[j] (𝐩[i] ψ) := rfl + +lemma angularMomentumOperator_apply {d : ℕ} (i j : Fin d) (ψ : 𝓢(Space d, ℂ)) (x : Space d) : + 𝐋[i,j] ψ x = 𝐱[i] (𝐩[j] ψ) x - 𝐱[j] (𝐩[i] ψ) x := rfl + +/-- The square of the angular momentum operator, `𝐋² ≔ ½ ∑ᵢⱼ 𝐋ᵢⱼ∘𝐋ᵢⱼ`. -/ +def angularMomentumOperatorSqr {d : ℕ} : 𝓢(Space d, ℂ) →L[ℂ] 𝓢(Space d, ℂ) := + (2 : ℂ)⁻¹ • ∑ i, ∑ j, 𝐋[i,j] ∘L 𝐋[i,j] + +@[inherit_doc angularMomentumOperatorSqr] +notation "𝐋²" => angularMomentumOperatorSqr + +lemma angularMomentumOperatorSqr_apply_fun {d : ℕ} (ψ : 𝓢(Space d, ℂ)) : + 𝐋² ψ = (2 : ℂ)⁻¹ • ∑ i, ∑ j, 𝐋[i,j] (𝐋[i,j] ψ) := by + dsimp only [angularMomentumOperatorSqr] + simp only [ContinuousLinearMap.coe_sum', ContinuousLinearMap.coe_smul', + ContinuousLinearMap.coe_comp', Finset.sum_apply, Pi.smul_apply, Function.comp_apply] + +lemma angularMomentumOperatorSqr_apply {d : ℕ} (ψ : 𝓢(Space d, ℂ)) (x : Space d) : + 𝐋² ψ x = (2 : ℂ)⁻¹ * ∑ i, ∑ j, 𝐋[i,j] (𝐋[i,j] ψ) x := by + rw [angularMomentumOperatorSqr_apply_fun] + simp only [smul_apply, sum_apply, smul_eq_mul] + +/- + +## Basic properties + +-/ + +/-- The angular momentum operator is antisymmetric, `𝐋ᵢⱼ = -𝐋ⱼᵢ` -/ +lemma angularMomentumOperator_antisymm {d : ℕ} (i j : Fin d) : 𝐋[i,j] = - 𝐋[j,i] := + Eq.symm (neg_sub _ _) + +/-- Angular momentum operator components with repeated index vanish, `𝐋ᵢᵢ = 0`. -/ +lemma angularMomentumOperator_eq_zero {d : ℕ} (i : Fin d) : 𝐋[i,i] = 0 := sub_self _ + +/- + +## Special cases in low dimensions + + • d = 1 : The angular momentum operator is trivial. + + • d = 2 : The angular momentum operator has only one independent component, 𝐋₀₁, which may + be thought of as a (pseudo)scalar operator. + + • d = 3 : The angular momentum operator has three independent components, 𝐋₀₁, 𝐋₁₂ and 𝐋₂₀. + Dualizing using the Levi-Civita symbol produces the familiar (pseudo)vector angular + momentum operator with components 𝐋₀ = 𝐋₂₀, 𝐋₁ = 𝐋₂₀ and 𝐋₂ = 𝐋₀₁. + +-/ + +/-- In one dimension the angular momentum operator is trivial. -/ +lemma angularMomentumOperator1D_trivial : ∀ (i j : Fin 1), 𝐋[i,j] = 0 := by + intro i j + fin_cases i, j + exact angularMomentumOperator_eq_zero 0 + +/-- The angular momentum (pseudo)scalar operator in two dimensions, `𝐋 ≔ 𝐋₀₁`. -/ +def angularMomentumOperator2D : 𝓢(Space 2, ℂ) →L[ℂ] 𝓢(Space 2, ℂ) := 𝐋[0,1] + +/-- The angular momentum (pseudo)vector operator in three dimension, `𝐋ᵢ ≔ ½ ∑ⱼₖ εᵢⱼₖ 𝐋ⱼₖ`. -/ +def angularMomentumOperator3D (i : Fin 3) : 𝓢(Space 3, ℂ) →L[ℂ] 𝓢(Space 3, ℂ) := + match i with + | 0 => 𝐋[1,2] + | 1 => 𝐋[2,0] + | 2 => 𝐋[0,1] + +end +end QuantumMechanics diff --git a/PhysLean/QuantumMechanics/DDimensions/Operators/Commutation.lean b/PhysLean/QuantumMechanics/DDimensions/Operators/Commutation.lean new file mode 100644 index 000000000..4134f285b --- /dev/null +++ b/PhysLean/QuantumMechanics/DDimensions/Operators/Commutation.lean @@ -0,0 +1,372 @@ +/- +Copyright (c) 2026 Gregory J. Loges. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gregory J. Loges +-/ +import PhysLean.Mathematics.KroneckerDelta +import PhysLean.QuantumMechanics.DDimensions.Operators.AngularMomentum +/-! + +# Commutation relations + +-/ + +namespace QuantumMechanics +noncomputable section +open Constants +open KroneckerDelta +open SchwartzMap ContinuousLinearMap + +private lemma ite_cond_symm (i j : Fin d) : + (if i = j then A else B) = (if j = i then A else B) := + ite_cond_congr (Eq.propIntro Eq.symm Eq.symm) + +lemma leibniz_lie {d : ℕ} (A B C : 𝓢(Space d, ℂ) →L[ℂ] 𝓢(Space d, ℂ)) : + ⁅A ∘L B, C⁆ = A ∘L ⁅B, C⁆ + ⁅A, C⁆ ∘L B := by + dsimp only [Bracket.bracket] + simp only [ContinuousLinearMap.mul_def, comp_assoc, comp_sub, sub_comp, sub_add_sub_cancel] + +lemma lie_leibniz {d : ℕ} (A B C : 𝓢(Space d, ℂ) →L[ℂ] 𝓢(Space d, ℂ)) : + ⁅A, B ∘L C⁆ = B ∘L ⁅A, C⁆ + ⁅A, B⁆ ∘L C := by + dsimp only [Bracket.bracket] + simp only [ContinuousLinearMap.mul_def, comp_assoc, comp_sub, sub_comp, sub_add_sub_cancel'] + +lemma comp_eq_comp_add_commute (A B : 𝓢(Space d, ℂ) →L[ℂ] 𝓢(Space d, ℂ)) : + A ∘L B = B ∘L A + ⁅A, B⁆ := by + dsimp only [Bracket.bracket] + simp only [ContinuousLinearMap.mul_def, add_sub_cancel] + +lemma comp_eq_comp_sub_commute (A B : 𝓢(Space d, ℂ) →L[ℂ] 𝓢(Space d, ℂ)) : + A ∘L B = B ∘L A - ⁅B, A⁆ := by + dsimp only [Bracket.bracket] + simp only [ContinuousLinearMap.mul_def, sub_sub_cancel] + +/- +## Position / position commutators +-/ + +/-- Position operators commute: `[xᵢ, xⱼ] = 0`. -/ +lemma position_commutation_position {d : ℕ} (i j : Fin d) : ⁅𝐱[i], 𝐱[j]⁆ = 0 := by + dsimp only [Bracket.bracket] + ext ψ x + simp only [coe_sub', coe_mul, Pi.sub_apply, Function.comp_apply, SchwartzMap.sub_apply, + ContinuousLinearMap.zero_apply, SchwartzMap.zero_apply, positionOperator_apply] + ring + +lemma position_comp_commute {d : ℕ} (i j : Fin d) : 𝐱[i] ∘L 𝐱[j] = 𝐱[j] ∘L 𝐱[i] := by + rw [← sub_eq_zero] + exact position_commutation_position i j + +lemma position_commutation_radiusRegPow (hε : 0 < ε) (i : Fin d) : + ⁅𝐱[i], radiusRegPowOperator (d := d) ε s⁆ = 0 := by + dsimp only [Bracket.bracket] + ext ψ x + simp only [coe_sub', coe_mul, Pi.sub_apply, Function.comp_apply, SchwartzMap.sub_apply] + simp only [positionOperator_apply, radiusRegPowOperator_apply hε] + simp only [Complex.real_smul, ContinuousLinearMap.zero_apply, SchwartzMap.zero_apply] + ring + +lemma position_comp_radiusRegPow_commute (hε : 0 < ε) (i : Fin d) : + 𝐱[i] ∘L 𝐫[ε,s] = 𝐫[ε,s] ∘L 𝐱[i] := by + rw [← sub_eq_zero] + exact position_commutation_radiusRegPow hε _ + +lemma radiusRegPow_commutation_radiusRegPow (hε : 0 < ε) : + ⁅radiusRegPowOperator (d := d) ε s, radiusRegPowOperator (d := d) ε t⁆ = 0 := by + dsimp only [Bracket.bracket] + simp only [ContinuousLinearMap.mul_def, radiusRegPowOperator_comp_eq hε, add_comm, sub_self] + +/- +## Momentum / momentum commutators +-/ + +/-- Momentum operators commute: `[pᵢ, pⱼ] = 0`. -/ +lemma momentum_commutation_momentum {d : ℕ} (i j : Fin d) : ⁅𝐩[i], 𝐩[j]⁆ = 0 := by + dsimp only [Bracket.bracket] + ext ψ x + simp only [coe_sub', coe_mul, Pi.sub_apply, Function.comp_apply, SchwartzMap.sub_apply, + ContinuousLinearMap.zero_apply, SchwartzMap.zero_apply, momentumOperator_apply_fun] + rw [Space.deriv_const_smul _ ?_, Space.deriv_const_smul _ ?_] + · rw [Space.deriv_commute _ (ψ.smooth _), sub_self] + · exact Space.deriv_differentiable (ψ.smooth _) i + · exact Space.deriv_differentiable (ψ.smooth _) j + +lemma momentum_comp_commute {d : ℕ} (i j : Fin d) : 𝐩[i] ∘L 𝐩[j] = 𝐩[j] ∘L 𝐩[i] := by + rw [← sub_eq_zero] + exact momentum_commutation_momentum i j + +lemma momentumSqr_commutation_momentum {d : ℕ} (i : Fin d) : + ⁅momentumOperatorSqr (d := d), 𝐩[i]⁆ = 0 := by + dsimp only [Bracket.bracket, momentumOperatorSqr] + rw [Finset.mul_sum, Finset.sum_mul, ← Finset.sum_sub_distrib] + conv_lhs => + enter [2, j] + simp only [ContinuousLinearMap.mul_def] + rw [comp_assoc] + rw [momentum_comp_commute j i, ← comp_assoc] + rw [momentum_comp_commute j i, comp_assoc] + rw [sub_self] + rw [Finset.sum_const_zero] + +lemma momentumSqr_comp_momentum_commute {d : ℕ} (i : Fin d) : 𝐩² ∘L 𝐩[i] = 𝐩[i] ∘L 𝐩² := by + rw [← sub_eq_zero] + exact momentumSqr_commutation_momentum i + +/- +## Position / momentum commutators +-/ + +/-- The canonical commutation relations: `[xᵢ, pⱼ] = iℏ δᵢⱼ𝟙`. -/ +lemma position_commutation_momentum {d : ℕ} (i j : Fin d) : ⁅𝐱[i], 𝐩[j]⁆ = + (Complex.I * ℏ * δ[i,j]) • ContinuousLinearMap.id ℂ 𝓢(Space d, ℂ) := by + dsimp only [Bracket.bracket, kroneckerDelta] + ext ψ x + simp only [ContinuousLinearMap.smul_apply, SchwartzMap.smul_apply, coe_id', id_eq, smul_eq_mul, + coe_sub', coe_mul, Pi.sub_apply, Function.comp_apply, SchwartzMap.sub_apply] + rw [positionOperator_apply, momentumOperator_apply_fun] + rw [momentumOperator_apply, positionOperator_apply_fun] + simp only [neg_mul, Pi.smul_apply, smul_eq_mul, mul_neg, sub_neg_eq_add] + + have h : (fun x ↦ ↑(x i) * ψ x) = (fun (x : Space d) ↦ x i) • ψ := rfl + rw [h] + rw [Space.deriv_smul (by fun_prop) (SchwartzMap.differentiableAt ψ)] + rw [Space.deriv_component, ite_cond_symm j i] + simp only [mul_add, Complex.real_smul, ite_smul, one_smul, zero_smul, mul_ite, mul_one, mul_zero, + ite_mul, zero_mul] + ring + +lemma momentum_comp_position_eq (i j : Fin d) : 𝐩[j] ∘L 𝐱[i] = + 𝐱[i] ∘L 𝐩[j] - (Complex.I * ℏ * δ[i,j]) • ContinuousLinearMap.id ℂ 𝓢(Space d, ℂ) := by + rw [← position_commutation_momentum] + dsimp only [Bracket.bracket] + simp only [ContinuousLinearMap.mul_def, sub_sub_cancel] + +lemma position_position_commutation_momentum {d : ℕ} (i j k : Fin d) : ⁅𝐱[i] ∘L 𝐱[j], 𝐩[k]⁆ = + (Complex.I * ℏ * δ[i,k]) • 𝐱[j] + (Complex.I * ℏ * δ[j,k]) • 𝐱[i] := by + rw [leibniz_lie] + rw [position_commutation_momentum, position_commutation_momentum] + rw [ContinuousLinearMap.comp_smul, ContinuousLinearMap.smul_comp] + rw [id_comp, comp_id] + rw [add_comm] + +lemma position_commutation_momentum_momentum {d : ℕ} (i j k : Fin d) : ⁅𝐱[i], 𝐩[j] ∘L 𝐩[k]⁆ = + (Complex.I * ℏ * δ[i,k]) • 𝐩[j] + (Complex.I * ℏ * δ[i,j]) • 𝐩[k] := by + rw [lie_leibniz] + rw [position_commutation_momentum, position_commutation_momentum] + rw [ContinuousLinearMap.comp_smul, ContinuousLinearMap.smul_comp] + rw [id_comp, comp_id] + +lemma position_commutation_momentumSqr {d : ℕ} (i : Fin d) : ⁅𝐱[i], 𝐩²⁆ = + (2 * Complex.I * ℏ) • 𝐩[i] := by + unfold momentumOperatorSqr + rw [lie_sum] + simp only [position_commutation_momentum_momentum] + dsimp only [kroneckerDelta] + simp only [mul_ite_zero, ite_zero_smul, Finset.sum_add_distrib, Finset.sum_ite_eq, + Finset.mem_univ, ↓reduceIte] + ext ψ x + simp only [ContinuousLinearMap.add_apply, coe_smul', Pi.smul_apply, SchwartzMap.add_apply, + SchwartzMap.smul_apply, smul_eq_mul] + ring + +lemma radiusRegPow_commutation_momentum (hε : 0 < ε) (i : Fin d) : + ⁅radiusRegPowOperator (d := d) ε s, 𝐩[i]⁆ = (s * Complex.I * ℏ) • 𝐫[ε,s-2] ∘L 𝐱[i] := by + dsimp only [Bracket.bracket] + ext ψ x + simp only [coe_sub', coe_mul, Pi.sub_apply, Function.comp_apply, SchwartzMap.sub_apply, coe_smul', + coe_comp', Pi.smul_apply, SchwartzMap.smul_apply, smul_eq_mul] + simp only [momentumOperator_apply, positionOperator_apply, radiusRegPowOperator_apply_fun hε] + + have hne : ∀ x : Space d, ‖x‖ ^ 2 + ε ^ 2 ≠ 0 := by + intro x + apply ne_of_gt + exact add_pos_of_nonneg_of_pos (sq_nonneg _) (sq_pos_of_pos hε) + + have h : (fun x ↦ (‖x‖ ^ 2 + ε ^ 2) ^ (s / 2) • ψ x) = + (fun (x : Space d) ↦ (‖x‖ ^ 2 + ε ^ 2) ^ (s / 2)) • ψ := rfl + have h' : ∂[i] (fun x ↦ (‖x‖ ^ 2 + ε ^ 2) ^ (s / 2)) = + fun x ↦ s * (‖x‖ ^ 2 + ε ^ 2) ^ (s / 2 - 1) * x i := by + trans ∂[i] ((fun x ↦ x ^ (s / 2)) ∘ (fun x ↦ ‖x‖ ^ 2 + ε ^ 2)) + · congr + ext x + rw [Space.deriv_eq, fderiv_comp] + · simp only [fderiv_add_const, fderiv_norm_sq_apply, comp_smul, coe_smul', coe_comp', + coe_innerSL_apply, Pi.smul_apply, Function.comp_apply, Space.inner_basis, + fderiv_eq_smul_deriv, smul_eq_mul, nsmul_eq_mul, Nat.cast_ofNat] + rw [deriv_rpow_const] + · simp only [deriv_id'', one_mul] + ring + · fun_prop + · left + exact hne _ + · exact Real.differentiableAt_rpow_const_of_ne (s / 2) (hne x) + · exact Differentiable.differentiableAt (by fun_prop) + + rw [h, Space.deriv_smul] + · rw [h'] + simp only [neg_mul, smul_neg, Complex.real_smul, Complex.ofReal_mul, sub_neg_eq_add] + ring_nf + · refine DifferentiableAt.rpow ?_ (by fun_prop) (hne _) + exact Differentiable.differentiableAt (by fun_prop) + · fun_prop + +lemma momentum_comp_radiusRegPow_eq (hε : 0 < ε) (i : Fin d) : + 𝐩[i] ∘L 𝐫[ε,s] = 𝐫[ε,s] ∘L 𝐩[i] - (s * Complex.I * ℏ) • 𝐫[ε,s-2] ∘L 𝐱[i] := by + rw [← radiusRegPow_commutation_momentum hε] + dsimp only [Bracket.bracket] + simp only [ContinuousLinearMap.mul_def, sub_sub_cancel] + +lemma radiusRegPow_commutation_momentumSqr (hε : 0 < ε) : + ⁅radiusRegPowOperator (d := d) ε s, momentumOperatorSqr (d := d)⁆ = + (2 * s * Complex.I * ℏ) • 𝐫[ε,s-2] ∘L ∑ i, 𝐱[i] ∘L 𝐩[i] + + (s * ℏ ^ 2) • ((d + s - 2) • 𝐫[ε,s-2] - (ε ^ 2 * (s - 2)) • 𝐫[ε,s-4]) := by + unfold momentumOperatorSqr + rw [lie_sum] + conv_lhs => + enter [2, i] + rw [lie_leibniz, radiusRegPow_commutation_momentum hε] + rw [comp_smul, ← comp_assoc, momentum_comp_radiusRegPow_eq hε] + rw [sub_comp, comp_assoc, momentum_comp_position_eq] + simp only [kroneckerDelta, ↓reduceIte, mul_one] + simp only [smul_comp, comp_sub, comp_smul, comp_id, smul_sub, comp_assoc, + Finset.sum_add_distrib, Finset.sum_sub_distrib, ← Finset.smul_sum, Finset.sum_const, + Finset.card_univ, Fintype.card_fin, ← ContinuousLinearMap.comp_finset_sum] + rw [positionOperatorSqr_eq hε, comp_sub, radiusRegPowOperator_comp_eq hε, comp_smul, comp_id] + rw [← Nat.cast_smul_eq_nsmul ℂ] + ext ψ x + simp only [Complex.ofReal_sub, Complex.ofReal_ofNat, sub_add_cancel, coe_sub', Pi.sub_apply, + ContinuousLinearMap.add_apply, coe_smul', coe_comp', coe_sum', Pi.smul_apply, + Function.comp_apply, Finset.sum_apply, map_sum, SchwartzMap.sub_apply, SchwartzMap.add_apply, + SchwartzMap.smul_apply, SchwartzMap.sum_apply, smul_eq_mul, Complex.real_smul, + Complex.ofReal_pow, Complex.ofReal_add, Complex.ofReal_natCast, Complex.ofReal_mul] + ring_nf + rw [Complex.I_sq] + ring + +/- +## Angular momentum / position commutators +-/ + +lemma angularMomentum_commutation_position {d : ℕ} (i j k : Fin d) : ⁅𝐋[i,j], 𝐱[k]⁆ = + (Complex.I * ℏ * δ[i,k]) • 𝐱[j] - (Complex.I * ℏ * δ[j,k]) • 𝐱[i] := by + unfold angularMomentumOperator + rw [sub_lie] + rw [leibniz_lie, leibniz_lie] + rw [position_commutation_position, position_commutation_position] + rw [← lie_skew, position_commutation_momentum] + rw [← lie_skew, position_commutation_momentum] + rw [kroneckerDelta_symm k i, kroneckerDelta_symm k j] + simp only [ContinuousLinearMap.comp_neg, ContinuousLinearMap.comp_smul, comp_id, zero_comp, + add_zero, add_comm, sub_neg_eq_add, ← sub_eq_add_neg] + +lemma angularMomentum_commutation_radiusRegPow (hε : 0 < ε) (i j : Fin d) : + ⁅𝐋[i,j], radiusRegPowOperator (d := d) ε s⁆ = 0 := by + dsimp only [Bracket.bracket] + unfold angularMomentumOperator + simp only [sub_mul, ContinuousLinearMap.mul_def, ContinuousLinearMap.comp_assoc] + repeat rw [momentum_comp_radiusRegPow_eq hε] + simp only [comp_sub, comp_smulₛₗ, RingHom.id_apply, ← ContinuousLinearMap.comp_assoc] + repeat rw [position_comp_radiusRegPow_commute hε] + simp only [ContinuousLinearMap.comp_assoc] + rw [position_comp_commute] + simp only [sub_sub_sub_cancel_right, sub_self] + +lemma angularMomentumSqr_commutation_radiusRegPow (hε : 0 < ε) : + ⁅angularMomentumOperatorSqr (d := d), radiusRegPowOperator (d := d) ε s⁆ = 0 := by + unfold angularMomentumOperatorSqr + simp only [sum_lie, smul_lie, leibniz_lie, angularMomentum_commutation_radiusRegPow hε, + comp_zero, zero_comp, add_zero, smul_zero, Finset.sum_const_zero] + +/- +## Angular momentum / momentum commutators +-/ + +lemma angularMomentum_commutation_momentum {d : ℕ} (i j k : Fin d) : ⁅𝐋[i,j], 𝐩[k]⁆ = + (Complex.I * ℏ * δ[i,k]) • 𝐩[j] - (Complex.I * ℏ * δ[j,k]) • 𝐩[i] := by + unfold angularMomentumOperator + rw [sub_lie] + rw [leibniz_lie, leibniz_lie] + rw [momentum_commutation_momentum, momentum_commutation_momentum] + rw [position_commutation_momentum, position_commutation_momentum] + simp only [ContinuousLinearMap.smul_comp, id_comp, comp_zero, zero_add] + +lemma momentum_comp_angularMomentum_eq {d : ℕ} (i j k : Fin d) : 𝐩[k] ∘L 𝐋[i,j] = + 𝐋[i,j] ∘L 𝐩[k] - (Complex.I * ℏ * δ[i,k]) • 𝐩[j] + (Complex.I * ℏ * δ[j,k]) • 𝐩[i] := by + rw [← sub_eq_zero, sub_add] + rw [← angularMomentum_commutation_momentum] + dsimp only [Bracket.bracket] + simp only [ContinuousLinearMap.mul_def, sub_sub_cancel, sub_eq_zero] + +lemma angularMomentum_commutation_momentumSqr {d : ℕ} (i j : Fin d) : + ⁅𝐋[i,j], momentumOperatorSqr (d := d)⁆ = 0 := by + unfold momentumOperatorSqr + conv_lhs => + rw [lie_sum] + enter [2, k] + rw [lie_leibniz, angularMomentum_commutation_momentum] + simp only [comp_sub, comp_smulₛₗ, RingHom.id_apply, sub_comp, smul_comp] + rw [momentum_comp_commute _ i, momentum_comp_commute j _] + dsimp only [kroneckerDelta] + simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib, mul_ite, mul_zero, ite_smul, + zero_smul, Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte, sub_self, add_zero] + +lemma momentumSqr_comp_angularMomentum_commute {d : ℕ} (i j : Fin d) : + 𝐩² ∘L 𝐋[i,j] = 𝐋[i,j] ∘L 𝐩² := by + apply Eq.symm + rw [← sub_eq_zero] + exact angularMomentum_commutation_momentumSqr i j + +lemma angularMomentumSqr_commutation_momentumSqr {d : ℕ} : + ⁅angularMomentumOperatorSqr (d := d), momentumOperatorSqr (d := d)⁆ = 0 := by + unfold angularMomentumOperatorSqr + simp only [smul_lie, sum_lie, leibniz_lie] + simp [angularMomentum_commutation_momentumSqr] + +/- +## Angular momentum / angular momentum commutators +-/ + +lemma angularMomentum_commutation_angularMomentum {d : ℕ} (i j k l : Fin d) : ⁅𝐋[i,j], 𝐋[k,l]⁆ = + (Complex.I * ℏ * δ[i,k]) • 𝐋[j,l] - (Complex.I * ℏ * δ[i,l]) • 𝐋[j,k] + - (Complex.I * ℏ * δ[j,k]) • 𝐋[i,l] + (Complex.I * ℏ * δ[j,l]) • 𝐋[i,k] := by + nth_rw 2 [angularMomentumOperator] + rw [lie_sub] + rw [lie_leibniz, lie_leibniz] + rw [angularMomentum_commutation_momentum, angularMomentum_commutation_position] + rw [angularMomentum_commutation_momentum, angularMomentum_commutation_position] + dsimp only [angularMomentumOperator, kroneckerDelta] + simp only [ContinuousLinearMap.comp_sub, ContinuousLinearMap.sub_comp, + ContinuousLinearMap.comp_smul, ContinuousLinearMap.smul_comp] + ext ψ x + simp only [mul_ite, mul_one, mul_zero, ite_smul, zero_smul, coe_sub', Pi.sub_apply, + ContinuousLinearMap.add_apply, SchwartzMap.sub_apply, SchwartzMap.add_apply, smul_sub] + ring + +lemma angularMomentumSqr_commutation_angularMomentum {d : ℕ} (i j : Fin d) : + ⁅angularMomentumOperatorSqr (d := d), 𝐋[i,j]⁆ = 0 := by + unfold angularMomentumOperatorSqr + conv_lhs => + simp only [smul_lie, sum_lie, leibniz_lie, angularMomentum_commutation_angularMomentum] + dsimp only [kroneckerDelta] + simp only [comp_add, comp_sub, add_comp, sub_comp, comp_smul, smul_comp, mul_ite, mul_zero, + mul_one] + simp only [ite_smul, zero_smul] + + -- Split into individual terms to do one of the sums, then recombine + simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib, Finset.sum_ite_irrel, + Finset.sum_const_zero, Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte] + simp only [← Finset.sum_add_distrib, ← Finset.sum_sub_distrib] + + ext ψ x + simp only [angularMomentumOperator_antisymm _ i, angularMomentumOperator_antisymm j _, + neg_comp, comp_neg, neg_neg, smul_neg, sub_neg_eq_add] + simp only [ContinuousLinearMap.sum_apply, ContinuousLinearMap.add_apply, + ContinuousLinearMap.sub_apply, ContinuousLinearMap.smul_apply, ContinuousLinearMap.comp_apply, + ContinuousLinearMap.neg_apply, ContinuousLinearMap.zero_apply, SchwartzMap.add_apply, + SchwartzMap.sum_apply, SchwartzMap.sub_apply, SchwartzMap.smul_apply, SchwartzMap.neg_apply, + SchwartzMap.zero_apply] + ring_nf + rw [Finset.sum_const_zero, smul_zero] + +end +end QuantumMechanics diff --git a/PhysLean/QuantumMechanics/DDimensions/Operators/Momentum.lean b/PhysLean/QuantumMechanics/DDimensions/Operators/Momentum.lean new file mode 100644 index 000000000..474175a4d --- /dev/null +++ b/PhysLean/QuantumMechanics/DDimensions/Operators/Momentum.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 Gregory J. Loges. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gregory J. Loges +-/ +import PhysLean.SpaceAndTime.Space.Derivatives.Basic +import PhysLean.QuantumMechanics.PlanckConstant +/-! + +# Momentum vector operator + +In this module we define: +- The momentum operator on Schwartz maps, component-wise. +- The momentum squared operator on Schwartz maps. + +-/ + +namespace QuantumMechanics +noncomputable section +open Constants +open Space +open ContDiff SchwartzMap + +/-- Component `i` of the momentum operator is the continuous linear map +from `𝓢(Space d, ℂ)` to itself which maps `ψ` to `-iℏ ∂ᵢψ`. -/ +def momentumOperator {d : ℕ} (i : Fin d) : 𝓢(Space d, ℂ) →L[ℂ] 𝓢(Space d, ℂ) := + (- Complex.I * ℏ) • (SchwartzMap.evalCLM ℂ (Space d) ℂ (basis i)) ∘L + (SchwartzMap.fderivCLM ℂ (Space d) ℂ) + +@[inherit_doc momentumOperator] +macro "𝐩[" i:term "]" : term => `(momentumOperator $i) + +lemma momentumOperator_apply_fun {d : ℕ} (i : Fin d) (ψ : 𝓢(Space d, ℂ)) : + 𝐩[i] ψ = (- Complex.I * ℏ) • ∂[i] ψ := rfl + +lemma momentumOperator_apply {d : ℕ} (i : Fin d) (ψ : 𝓢(Space d, ℂ)) (x : Space d) : + 𝐩[i] ψ x = - Complex.I * ℏ * ∂[i] ψ x := rfl + +/-- The square of the momentum operator, `𝐩² ≔ ∑ᵢ 𝐩ᵢ∘𝐩ᵢ`. -/ +def momentumOperatorSqr {d : ℕ} : 𝓢(Space d, ℂ) →L[ℂ] 𝓢(Space d, ℂ) := ∑ i, 𝐩[i] ∘L 𝐩[i] + +@[inherit_doc momentumOperatorSqr] +notation "𝐩²" => momentumOperatorSqr + +lemma momentumOperatorSqr_apply {d : ℕ} (ψ : 𝓢(Space d, ℂ)) (x : Space d) : + 𝐩² ψ x = ∑ i, 𝐩[i] (𝐩[i] ψ) x := by + dsimp only [momentumOperatorSqr] + rw [← SchwartzMap.coe_coeHom] + simp only [ContinuousLinearMap.coe_sum', ContinuousLinearMap.coe_comp', Finset.sum_apply, + Function.comp_apply, map_sum] + +end +end QuantumMechanics diff --git a/PhysLean/QuantumMechanics/DDimensions/Operators/Position.lean b/PhysLean/QuantumMechanics/DDimensions/Operators/Position.lean new file mode 100644 index 000000000..8523a01c4 --- /dev/null +++ b/PhysLean/QuantumMechanics/DDimensions/Operators/Position.lean @@ -0,0 +1,135 @@ +/- +Copyright (c) 2026 Gregory J. Loges. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gregory J. Loges +-/ +import PhysLean.SpaceAndTime.Space.Derivatives.Basic +/-! + +# Position operators + +In this module we define: +- The position vector operator on Schwartz maps, component-wise. +- The (regularized) real powers of the radius operator on Schwartz maps. + +-/ + +namespace QuantumMechanics +noncomputable section +open Space +open Function SchwartzMap ContDiff + +/- +## Position vector operator +-/ + +/-- Component `i` of the position operator is the continuous linear map +from `𝓢(Space d, ℂ)` to itself which maps `ψ` to `xᵢψ`. -/ +def positionOperator (i : Fin d) : 𝓢(Space d, ℂ) →L[ℂ] 𝓢(Space d, ℂ) := + SchwartzMap.smulLeftCLM ℂ (Complex.ofReal ∘ coordCLM i) + +@[inherit_doc positionOperator] +macro "𝐱[" i:term "]" : term => `(positionOperator $i) + +lemma positionOperator_apply_fun (i : Fin d) (ψ : 𝓢(Space d, ℂ)) : + 𝐱[i] ψ = (fun x ↦ x i * ψ x) := by + unfold positionOperator + ext x + rw [SchwartzMap.smulLeftCLM_apply_apply] + · rw [Function.comp_apply, smul_eq_mul] + rw [coordCLM_apply, coord_apply] + · fun_prop + +lemma positionOperator_apply (i : Fin d) (ψ : 𝓢(Space d, ℂ)) (x : Space d) : + 𝐱[i] ψ x = x i * ψ x := by rw [positionOperator_apply_fun] + +/- + +## Radius operator + +-/ +TODO "ZGCNP" "Incorporate normRegularizedPow into Space.Norm" + +/-- Power of regularized norm, `(‖x‖² + ε²)^(s/2)` -/ +private def normRegularizedPow (ε s : ℝ) : Space d → ℝ := + fun x ↦ (‖x‖ ^ 2 + ε ^ 2) ^ (s / 2) + +private lemma normRegularizedPow_hasTemperateGrowth (hε : 0 < ε) : + HasTemperateGrowth (normRegularizedPow (d := d) ε s) := by + -- Write `normRegularizedPow` as the composition of three simple functions + -- to take advantage of `hasTemperateGrowth_one_add_norm_sq_rpow` + let f1 := fun (x : ℝ) ↦ (ε ^ 2) ^ (s / 2) * x + let f2 := fun (x : Space d) ↦ (1 + ‖x‖ ^ 2) ^ (s / 2) + let f3 := fun (x : Space d) ↦ ε⁻¹ • x + + have h123 : normRegularizedPow (d := d) ε s = f1 ∘ f2 ∘ f3 := by + unfold normRegularizedPow f1 f2 f3 + ext x + simp only [Function.comp_apply, norm_smul, norm_inv, Real.norm_eq_abs] + rw [← Real.mul_rpow (sq_nonneg _) ?_] + · rw [mul_pow, mul_add, mul_one, ← mul_assoc, inv_pow, sq_abs] + rw [IsUnit.mul_inv_cancel ?_] + · rw [one_mul, add_comm] + · rw [pow_two, isUnit_mul_self_iff, isUnit_iff_ne_zero] + exact ne_of_gt hε + · exact add_nonneg (zero_le_one' _) (sq_nonneg _) + + rw [h123] + fun_prop + +/-- The radius operator to power `s`, regularized by `ε ≠ 0`, is the continuous linear map + from `𝓢(Space d, ℂ)` to itself which maps `ψ` to `(‖x‖² + ε²)^(s/2) • ψ`. -/ +def radiusRegPowOperator (ε s : ℝ) : 𝓢(Space d, ℂ) →L[ℂ] 𝓢(Space d, ℂ) := + SchwartzMap.smulLeftCLM ℂ (Complex.ofReal ∘ normRegularizedPow ε s) + +@[inherit_doc radiusRegPowOperator] +macro "𝐫[" ε:term "," s:term "]" : term => `(radiusRegPowOperator $ε $s) + +lemma radiusRegPowOperator_apply_fun (hε : 0 < ε) : + 𝐫[ε,s] ψ = fun x ↦ (‖x‖ ^ 2 + ε ^ 2) ^ (s / 2) • ψ x := by + unfold radiusRegPowOperator + ext x + rw [smulLeftCLM_apply_apply] + · unfold normRegularizedPow + rw [comp_apply, smul_eq_mul, Complex.real_smul] + · exact HasTemperateGrowth.comp (by fun_prop) (normRegularizedPow_hasTemperateGrowth hε) + +lemma radiusRegPowOperator_apply (hε : 0 < ε) : + 𝐫[ε,s] ψ x = (‖x‖ ^ 2 + ε ^ 2) ^ (s / 2) • ψ x := by + rw [radiusRegPowOperator_apply_fun hε] + +lemma radiusRegPowOperator_comp_eq (hε : 0 < ε) (s t : ℝ) : + (radiusRegPowOperator (d := d) ε s) ∘L 𝐫[ε,t] = 𝐫[ε,s+t] := by + unfold radiusRegPowOperator + ext ψ x + simp only [ContinuousLinearMap.coe_comp', comp_apply] + repeat rw [smulLeftCLM_apply_apply ?_] + · unfold normRegularizedPow + simp only [comp_apply, smul_eq_mul] + rw [← mul_assoc, ← Complex.ofReal_mul] + rw [← Real.rpow_add] + · congr + ring + · exact add_pos_of_nonneg_of_pos (sq_nonneg _) (sq_pos_of_pos hε) + repeat exact HasTemperateGrowth.comp (by fun_prop) (normRegularizedPow_hasTemperateGrowth hε) + +lemma radiusRegPowOperator_zero (hε : 0 < ε) : + 𝐫[ε,0] = ContinuousLinearMap.id ℂ 𝓢(Space d, ℂ) := by + ext ψ x + rw [radiusRegPowOperator_apply hε, zero_div, Real.rpow_zero, one_smul, + ContinuousLinearMap.coe_id', id_eq] + +lemma positionOperatorSqr_eq (hε : 0 < ε) : ∑ i, 𝐱[i] ∘L 𝐱[i] = + 𝐫[ε,2] - ε ^ 2 • ContinuousLinearMap.id ℂ 𝓢(Space d, ℂ) := by + ext ψ x + simp only [ContinuousLinearMap.coe_sum', Finset.sum_apply, SchwartzMap.sum_apply, + ContinuousLinearMap.comp_apply, ContinuousLinearMap.sub_apply, SchwartzMap.sub_apply, + ContinuousLinearMap.smul_apply, ContinuousLinearMap.id_apply, SchwartzMap.smul_apply] + simp only [positionOperator_apply_fun, radiusRegPowOperator_apply_fun hε] + simp only [← mul_assoc, ← Finset.sum_mul, ← Complex.ofReal_mul] + rw [div_self (by norm_num), Real.rpow_one, ← sub_smul, add_sub_cancel_right] + rw [Space.norm_sq_eq, Complex.real_smul, Complex.ofReal_sum] + simp only [pow_two] + +end +end QuantumMechanics diff --git a/PhysLean/QuantumMechanics/DDimensions/Operators/Unbounded.lean b/PhysLean/QuantumMechanics/DDimensions/Operators/Unbounded.lean new file mode 100644 index 000000000..aaae63111 --- /dev/null +++ b/PhysLean/QuantumMechanics/DDimensions/Operators/Unbounded.lean @@ -0,0 +1,206 @@ +/- +Copyright (c) 2026 Gregory J. Loges. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gregory J. Loges +-/ +import PhysLean.Mathematics.InnerProductSpace.Submodule +import PhysLean.QuantumMechanics.DDimensions.SpaceDHilbertSpace.SchwartzSubmodule +/-! + +# Unbounded operators + +In this file we define +- `UnboundedOperator`: an unbounded operator with domain a submodule of a generic Hilbert space. + All unbounded operators are assumed to be both densely defined and closable. +- The closure, `UnboundedOperator.closure`, and adjoint, `UnboundedOperator.adjoint`, with notation + `U† = U.adjoint`. That `U†` is densely defined is guaranteed by the closability of `U`. +- The concept of a generalized eigenvector in `IsGeneralizedEigenvector`. + +We prove some basic relations, making use of the density and closability assumptions: +- `U.closure† = U†` in `closure_adjoint_eq_adjoint` +- `U†† = U.closure` in `adjoint_adjoint_eq_closure` + +## References + +- K. Schmüdgen, (2012). "Unbounded self-adjoint operators on Hilbert space" (Vol. 265). Springer. + https://doi.org/10.1007/978-94-007-4753-1 + +-/ + +namespace QuantumMechanics + +open LinearPMap Submodule + +/-- An `UnboundedOperator` is a linear map from a submodule of the Hilbert space + to the Hilbert space, assumed to be both densely defined and closable. -/ +@[ext] +structure UnboundedOperator + (HS : Type*) [NormedAddCommGroup HS] [InnerProductSpace ℂ HS] [CompleteSpace HS] + extends LinearPMap ℂ HS HS where + /-- The domain of an unbounded operator is dense in the Hilbert space. -/ + dense_domain : Dense (domain : Set HS) + /-- An unbounded operator is closable. -/ + is_closable : toLinearPMap.IsClosable + +namespace UnboundedOperator + +variable + {HS : Type*} [NormedAddCommGroup HS] [InnerProductSpace ℂ HS] [CompleteSpace HS] + (U : UnboundedOperator HS) + +lemma ext' (U T : UnboundedOperator HS) (h : U.toLinearPMap = T.toLinearPMap) : U = T := by + apply UnboundedOperator.ext + · exact toSubMulAction_inj.mp (congrArg toSubMulAction (congrArg domain h)) + · exact congr_arg_heq toFun h + +lemma ext_iff' (U T : UnboundedOperator HS) : U = T ↔ U.toLinearPMap = T.toLinearPMap := by + refine ⟨?_, UnboundedOperator.ext' U T⟩ + intro h + rw [h] + +/-! +### Construction of unbounded operators +-/ + +variable {E : Submodule ℂ HS} {hE : Dense (E : Set HS)} + +/-- An `UnboundedOperator` constructed from a symmetric linear map on a dense submodule `E`. -/ +def ofSymmetric (f : E →ₗ[ℂ] E) (hf : f.IsSymmetric) : UnboundedOperator HS where + toLinearPMap := LinearPMap.mk E (E.subtype ∘ₗ f) + dense_domain := hE + is_closable := by + refine isClosable_iff_exists_closed_extension.mpr ?_ + use (LinearPMap.mk E (E.subtype ∘ₗ f))† + exact ⟨adjoint_isClosed hE, IsFormalAdjoint.le_adjoint hE hf⟩ + +@[simp] +lemma ofSymmetric_apply {f : E →ₗ[ℂ] E} {hf : f.IsSymmetric} (ψ : E) : + (ofSymmetric (hE := hE) f hf).toLinearPMap ψ = E.subtypeL (f ψ) := rfl + +/-! +### Closure +-/ + +section Closure + +/-- The closure of an unbounded operator. -/ +noncomputable def closure : UnboundedOperator HS where + toLinearPMap := U.toLinearPMap.closure + dense_domain := Dense.mono (HasCore.le_domain (closureHasCore U.toLinearPMap)) U.dense_domain + is_closable := IsClosed.isClosable (IsClosable.closure_isClosed U.is_closable) + +@[simp] +lemma closure_toLinearPMap : U.closure.toLinearPMap = U.toLinearPMap.closure := rfl + +/-- An unbounded operator is closed iff the graph of its defining LinearPMap is closed. -/ +def IsClosed : Prop := U.toLinearPMap.IsClosed + +lemma closure_isClosed : U.closure.IsClosed := IsClosable.closure_isClosed U.is_closable + +end Closure + +/-! +### Adjoints +-/ + +section Adjoints + +open InnerProductSpaceSubmodule + +/-- The adjoint of a densely defined, closable `LinearPMap` is densely defined. -/ +lemma adjoint_isClosable_dense (f : LinearPMap ℂ HS HS) (h_dense : Dense (f.domain : Set HS)) + (h_closable : f.IsClosable) : Dense (f†.domain : Set HS) := by + by_contra hd + have : ∃ x ∈ f†.domainᗮ, x ≠ 0 := by + apply not_forall.mp at hd + rcases hd with ⟨y, hy⟩ + have hnetop : f†.domainᗮᗮ ≠ ⊤ := by + rw [orthogonal_orthogonal_eq_closure] + exact Ne.symm (ne_of_mem_of_not_mem' trivial hy) + have hnebot : f†.domainᗮ ≠ ⊥ := by + by_contra + apply hnetop + rwa [orthogonal_eq_top_iff] + exact exists_mem_ne_zero_of_ne_bot hnebot + rcases this with ⟨x, hx, hx'⟩ + apply hx' + apply graph_fst_eq_zero_snd f.closure _ rfl + rw [← IsClosable.graph_closure_eq_closure_graph h_closable, + mem_submodule_closure_iff_mem_submoduleToLp_closure, + ← orthogonal_orthogonal_eq_closure, + ← mem_submodule_adjoint_adjoint_iff_mem_submoduleToLp_orthogonal_orthogonal, + ← LinearPMap.adjoint_graph_eq_graph_adjoint h_dense, + mem_submodule_adjoint_iff_mem_submoduleToLp_orthogonal] + rintro ⟨y, Uy⟩ hy + simp only [neg_zero, WithLp.prod_inner_apply, inner_zero_right, add_zero] + exact hx y (mem_domain_of_mem_graph hy) + +/-- The adjoint of an unbounded operator, denoted as `U†`. -/ +noncomputable def adjoint : UnboundedOperator HS where + toLinearPMap := U.toLinearPMap.adjoint + dense_domain := adjoint_isClosable_dense U.toLinearPMap U.dense_domain U.is_closable + is_closable := IsClosed.isClosable (adjoint_isClosed U.dense_domain) + +@[inherit_doc] +scoped postfix:1024 "†" => UnboundedOperator.adjoint + +noncomputable instance instStar : Star (UnboundedOperator HS) where + star := fun U ↦ U.adjoint + +@[simp] +lemma adjoint_toLinearPMap : U†.toLinearPMap = U.toLinearPMap† := rfl + +lemma isSelfAdjoint_def : IsSelfAdjoint U ↔ U† = U := Iff.rfl + +lemma isSelfAdjoint_iff : IsSelfAdjoint U ↔ IsSelfAdjoint U.toLinearPMap := by + rw [isSelfAdjoint_def, LinearPMap.isSelfAdjoint_def, ← adjoint_toLinearPMap, + UnboundedOperator.ext_iff'] + +lemma adjoint_isClosed : (U†).IsClosed := LinearPMap.adjoint_isClosed U.dense_domain + +lemma closure_adjoint_eq_adjoint : U.closure† = U† := by + -- Reduce to statement about graphs using density and closability assumptions + apply UnboundedOperator.ext' + apply LinearPMap.eq_of_eq_graph + rw [adjoint_toLinearPMap, adjoint_graph_eq_graph_adjoint U.closure.dense_domain] + rw [adjoint_toLinearPMap, adjoint_graph_eq_graph_adjoint U.dense_domain] + rw [closure_toLinearPMap, ← IsClosable.graph_closure_eq_closure_graph U.is_closable] + ext f + rw [mem_submodule_closure_adjoint_iff_mem_submoduleToLp_closure_orthogonal, + orthogonal_closure, mem_submodule_adjoint_iff_mem_submoduleToLp_orthogonal] + +lemma adjoint_adjoint_eq_closure : U†† = U.closure := by + -- Reduce to statement about graphs using density and closability assumptions + apply UnboundedOperator.ext' + apply LinearPMap.eq_of_eq_graph + rw [adjoint_toLinearPMap, adjoint_graph_eq_graph_adjoint U†.dense_domain] + rw [adjoint_toLinearPMap, adjoint_graph_eq_graph_adjoint U.dense_domain] + rw [closure_toLinearPMap, ← IsClosable.graph_closure_eq_closure_graph U.is_closable] + ext f + rw [mem_submodule_adjoint_adjoint_iff_mem_submoduleToLp_orthogonal_orthogonal, + orthogonal_orthogonal_eq_closure, mem_submodule_closure_iff_mem_submoduleToLp_closure] + +end Adjoints + +/-! +### Generalized eigenvectors +-/ + +/-- A map `F : D(U) →L[ℂ] ℂ` is a generalized eigenvector of an unbounded operator `U` + if there is an eigenvalue `c` such that for all `ψ ∈ D(U)`, `F (U ψ) = c ⬝ F ψ`. -/ +def IsGeneralizedEigenvector (F : U.domain →L[ℂ] ℂ) (c : ℂ) : Prop := + ∀ ψ : U.domain, ∃ ψ' : U.domain, ψ' = U.toFun ψ ∧ F ψ' = c • F ψ + +lemma isGeneralizedEigenvector_ofSymmetric_iff + {f : E →ₗ[ℂ] E} (hf : f.IsSymmetric) (F : E →L[ℂ] ℂ) (c : ℂ) : + IsGeneralizedEigenvector (ofSymmetric (hE := hE) f hf) F c ↔ ∀ ψ : E, F (f ψ) = c • F ψ := by + constructor <;> intro h ψ + · obtain ⟨ψ', hψ', hψ''⟩ := h ψ + apply SetLike.coe_eq_coe.mp at hψ' + subst hψ' + exact hψ'' + · use f ψ + exact ⟨by simp, h ψ⟩ + +end UnboundedOperator +end QuantumMechanics diff --git a/PhysLean/QuantumMechanics/DDimensions/SpaceDHilbertSpace/Basic.lean b/PhysLean/QuantumMechanics/DDimensions/SpaceDHilbertSpace/Basic.lean new file mode 100644 index 000000000..5aeb42810 --- /dev/null +++ b/PhysLean/QuantumMechanics/DDimensions/SpaceDHilbertSpace/Basic.lean @@ -0,0 +1,151 @@ +/- +Copyright (c) 2026 Gregory J. Loges. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gregory J. Loges +-/ +import Mathlib.Analysis.InnerProductSpace.Dual +import Mathlib.MeasureTheory.Function.L2Space +import PhysLean.SpaceAndTime.Space.Basic +/-! + +# Hilbert space for quantum mechanics on Space d + +-/ + +namespace QuantumMechanics + +noncomputable section + +/-- The Hilbert space for single-particle quantum mechanics on `Space d` is defined to be + `L²(Space d, ℂ)`, the space of almost-everywhere equal equivalence classes of square-integrable + functions from `Space d` to `ℂ`. -/ +abbrev SpaceDHilbertSpace (d : ℕ) := MeasureTheory.Lp (α := Space d) ℂ 2 + +namespace SpaceDHilbertSpace +open MeasureTheory +open InnerProductSpace + +/-- The anti-linear map from the Hilbert space to its dual. -/ +def toBra {d : ℕ} : SpaceDHilbertSpace d →ₛₗ[starRingEnd ℂ] (StrongDual ℂ (SpaceDHilbertSpace d)) := + toDual ℂ (SpaceDHilbertSpace d) + +@[simp] +lemma toBra_apply (f g : SpaceDHilbertSpace d) : toBra f g = ⟪f, g⟫_ℂ := rfl + +/-- The anti-linear map `toBra` taking a ket to its corresponding bra is surjective. -/ +lemma toBra_surjective : Function.Surjective (toBra (d := d)) := + (toDual ℂ (SpaceDHilbertSpace d)).surjective + +/-- The anti-linear map `toBra` taking a ket to its corresponding bra is injective. -/ +lemma toBra_injective : Function.Injective (toBra (d := d)) := by + intro f g h + simpa [toBra] using h + +/-! +## Member of the Hilbert space as a property +-/ + +/-- The proposition `MemHS f` for a function `f : Space d → ℂ` is defined + to be true if the function `f` can be lifted to the Hilbert space. -/ +def MemHS (f : Space d → ℂ) : Prop := MemLp f 2 + +lemma aeStronglyMeasurable_of_memHS {f : Space d → ℂ} (h : MemHS f) : AEStronglyMeasurable f := + MemLp.aestronglyMeasurable h + +/-- A function `f` satisfies `MemHS f` if and only if it is almost everywhere + strongly measurable and square integrable. -/ +lemma memHS_iff {f : Space d → ℂ} : MemHS f ↔ + AEStronglyMeasurable f ∧ Integrable (fun x ↦ ‖f x‖ ^ 2) := by + rw [MemHS, MemLp, and_congr_right] + intro h + rw [eLpNorm_lt_top_iff_lintegral_rpow_enorm_lt_top + (NeZero.ne' 2).symm ENNReal.top_ne_ofNat.symm] + simp only [ENNReal.toReal_ofNat, ENNReal.rpow_ofNat] + have h' : AEStronglyMeasurable (fun x ↦ ‖f x‖ ^ 2) := + AEStronglyMeasurable.pow (AEStronglyMeasurable.norm h) 2 + simp [Integrable, h', HasFiniteIntegral] + +@[simp] +lemma zero_memHS : MemHS (d := d) 0 := by + rw [memHS_iff] + simp only [Pi.zero_apply, norm_zero, ne_eq, OfNat.ofNat_ne_zero, not_false_eq_true, zero_pow, + integrable_zero, and_true] + fun_prop + +@[simp] +lemma zero_fun_memHS : MemHS (fun _ : Space d ↦ (0 : ℂ)) := zero_memHS + +lemma memHS_add {f g : Space d → ℂ} (hf : MemHS f) (hg : MemHS g) : MemHS (f + g) := + MemLp.add hf hg + +lemma memHS_const_smul {f : Space d → ℂ} {c : ℂ} (hf : MemHS f) : MemHS (c • f) := + MemLp.const_smul hf c + +lemma memHS_of_ae {g : Space d → ℂ} (f : Space d → ℂ) (hf : MemHS f) (hfg : f =ᵐ[volume] g) : + MemHS g := MemLp.ae_eq hfg hf + +/-! +## Construction of elements of the Hilbert space +-/ + +lemma aeEqFun_mk_mem_iff (f : Space d → ℂ) (hf : AEStronglyMeasurable f volume) : + AEEqFun.mk f hf ∈ SpaceDHilbertSpace d ↔ MemHS f := by + rw [Lp.mem_Lp_iff_memLp] + exact memLp_congr_ae (AEEqFun.coeFn_mk f hf) + +/-- Given a function `f : Space d → ℂ` such that `MemHS f` is true via `hf`, + `SpaceDHilbertSpace.mk f` is the element of the Hilbert space defined by `f`. -/ +def mk {f : Space d → ℂ} (hf : MemHS f) : SpaceDHilbertSpace d := + ⟨AEEqFun.mk f hf.1, (aeEqFun_mk_mem_iff f hf.1).mpr hf⟩ + +lemma coe_hilbertSpace_memHS (f : SpaceDHilbertSpace d) : MemHS (f : Space d → ℂ) := by + rw [← aeEqFun_mk_mem_iff f (Lp.aestronglyMeasurable f)] + have hf : f = AEEqFun.mk f (Lp.aestronglyMeasurable f) := (AEEqFun.mk_coeFn _).symm + exact hf ▸ f.2 + +lemma mk_surjective (f : SpaceDHilbertSpace d) : + ∃ (g : Space d → ℂ) (hg : MemHS g), mk hg = f := by + use f, coe_hilbertSpace_memHS f + simp [mk] + +lemma coe_mk_ae {f : Space d → ℂ} (hf : MemHS f) : (mk hf) =ᵐ[volume] f := + AEEqFun.coeFn_mk f hf.1 + +lemma inner_mk_mk {f g : Space d → ℂ} (hf : MemHS f) (hg : MemHS g) : + ⟪mk hf, mk hg⟫_ℂ = ∫ x : Space d, starRingEnd ℂ (f x) * g x := by + apply integral_congr_ae + filter_upwards [coe_mk_ae hf, coe_mk_ae hg] with x hf hg + simp [hf, hg, mul_comm] + +@[simp] +lemma eLpNorm_mk {f : Space d → ℂ} {hf : MemHS f} : eLpNorm (mk hf) 2 = eLpNorm f 2 := + eLpNorm_congr_ae (coe_mk_ae hf) + +lemma mem_iff {f : Space d → ℂ} (hf : AEStronglyMeasurable f volume) : + AEEqFun.mk f hf ∈ SpaceDHilbertSpace d ↔ Integrable (fun x ↦ ‖f x‖ ^ 2) := by + rw [Lp.mem_Lp_iff_memLp, MemLp, eLpNorm_aeeqFun] + have h1 := AEEqFun.aestronglyMeasurable (AEEqFun.mk f hf) + have h2 : AEStronglyMeasurable (fun x ↦ norm (f x) ^ 2) := + AEStronglyMeasurable.pow (continuous_norm.comp_aestronglyMeasurable hf) 2 + simp only [h1] + simp only [eLpNorm_lt_top_iff_lintegral_rpow_enorm_lt_top (NeZero.ne' 2).symm + (ENNReal.top_ne_ofNat).symm, ENNReal.toReal_ofNat, ENNReal.rpow_ofNat] + simp [h2, Integrable, HasFiniteIntegral] + +@[simp] +lemma mk_add {f g : Space d → ℂ} {hf : MemHS f} {hg : MemHS g} : + mk (memHS_add hf hg) = mk hf + mk hg := rfl + +@[simp] +lemma mk_const_smul {f : Space d → ℂ} {c : ℂ} {hf : MemHS f} : + mk (memHS_const_smul (c := c) hf) = c • mk hf := rfl + +lemma mk_eq_iff {f g : Space d → ℂ} {hf : MemHS f} {hg : MemHS g} : + mk hf = mk hg ↔ f =ᵐ[volume] g := by simp [mk] + +lemma ext_iff {f g : SpaceDHilbertSpace d} : + f = g ↔ (f : Space d → ℂ) =ᵐ[volume] (g : Space d → ℂ) := Lp.ext_iff + +end SpaceDHilbertSpace +end +end QuantumMechanics diff --git a/PhysLean/QuantumMechanics/DDimensions/SpaceDHilbertSpace/SchwartzSubmodule.lean b/PhysLean/QuantumMechanics/DDimensions/SpaceDHilbertSpace/SchwartzSubmodule.lean new file mode 100644 index 000000000..b7e25c449 --- /dev/null +++ b/PhysLean/QuantumMechanics/DDimensions/SpaceDHilbertSpace/SchwartzSubmodule.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Gregory J. Loges. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gregory J. Loges +-/ +import Mathlib.Analysis.Distribution.SchwartzSpace.Basic +import PhysLean.QuantumMechanics.DDimensions.SpaceDHilbertSpace.Basic +/-! + +# Schwartz submodule of the Hilbert space + +-/ + +namespace QuantumMechanics +namespace SpaceDHilbertSpace + +noncomputable section + +open MeasureTheory +open InnerProductSpace +open SchwartzMap + +/-- The continuous linear map including Schwartz functions into `SpaceDHilbertSpace d`. -/ +def schwartzIncl {d : ℕ} : 𝓢(Space d, ℂ) →L[ℂ] SpaceDHilbertSpace d := toLpCLM ℂ (E := Space d) ℂ 2 + +lemma schwartzIncl_injective {d : ℕ} : Function.Injective (schwartzIncl (d := d)) := + injective_toLp (E := Space d) 2 + +lemma schwartzIncl_coe_ae {d : ℕ} (f : 𝓢(Space d, ℂ)) : f.1 =ᵐ[volume] (schwartzIncl f) := + (coeFn_toLp f 2).symm + +lemma schwartzIncl_inner {d : ℕ} (f g : 𝓢(Space d, ℂ)) : + ⟪schwartzIncl f, schwartzIncl g⟫_ℂ = ∫ x : Space d, starRingEnd ℂ (f x) * g x := by + apply integral_congr_ae + filter_upwards [schwartzIncl_coe_ae f, schwartzIncl_coe_ae g] with _ hf hg + rw [← hf, ← hg, RCLike.inner_apply, mul_comm] + rfl + +/-- The submodule of `SpaceDHilbertSpace d` consisting of Schwartz functions. -/ +abbrev schwartzSubmodule (d : ℕ) := (schwartzIncl (d := d)).range + +lemma schwartzSubmodule_dense {d : ℕ} : + Dense (schwartzSubmodule d : Set (SpaceDHilbertSpace d)) := + denseRange_toLpCLM ENNReal.top_ne_ofNat.symm + +end +end SpaceDHilbertSpace +end QuantumMechanics diff --git a/PhysLean/QuantumMechanics/FiniteTarget/Basic.lean b/PhysLean/QuantumMechanics/FiniteTarget/Basic.lean index aaee81f6d..e46e35ddf 100644 --- a/PhysLean/QuantumMechanics/FiniteTarget/Basic.lean +++ b/PhysLean/QuantumMechanics/FiniteTarget/Basic.lean @@ -42,7 +42,7 @@ variable {n : ℕ}(A : FiniteTarget H n) /-- Given a finite target QM system `A`, the time evolution operator for a `t : ℝ`, `A.timeEvolution t` is defined as `exp(- I t /ℏ * A.Ham)`. Still a map. -/ noncomputable def timeEvolution (t : ℝ) : H →L[ℂ] H := - NormedSpace.exp ℂ (-(Complex.I * t / ℏ) • A.Ham) + NormedSpace.exp (-(Complex.I * t / ℏ) • A.Ham) -- Note that the `H →L[ℂ] H`s make an algebra over 𝕂 := ℂ, so [Algebra 𝕂 𝔸] is satisfied. /-- The matrix representation of the time evolution operator in a given basis. Given a diff --git a/PhysLean/QuantumMechanics/OneDimension/HarmonicOscillator/Basic.lean b/PhysLean/QuantumMechanics/OneDimension/HarmonicOscillator/Basic.lean index 31886975f..29c7c4426 100644 --- a/PhysLean/QuantumMechanics/OneDimension/HarmonicOscillator/Basic.lean +++ b/PhysLean/QuantumMechanics/OneDimension/HarmonicOscillator/Basic.lean @@ -4,6 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.QuantumMechanics.OneDimension.Operators.Parity +import PhysLean.QuantumMechanics.OneDimension.Operators.Momentum +import PhysLean.QuantumMechanics.OneDimension.Operators.Position + /-! # 1d Harmonic Oscillator @@ -16,7 +19,6 @@ This file contains - proof that eigenfunctions and eigenvalues are indeed eigenfunctions and eigenvalues. ## TODO -- Show that Schrodinger operator is linear. -/ @@ -133,25 +135,9 @@ lemma one_over_ξ_sq : (1/Q.ξ)^2 = Q.m * Q.ω / ℏ := by rw [one_over_ξ] refine Real.sq_sqrt (le_of_lt Q.m_mul_ω_div_ℏ_pos) -TODO "6VZH3" "The momentum operator should be moved to a more general file." - -/-- The momentum operator is defined as the map from `ℝ → ℂ` to `ℝ → ℂ` taking - `ψ` to `- i ℏ ψ'`. - - The notation `Pᵒᵖ` can be used for the momentum operator. -/ -noncomputable def momentumOperator (ψ : ℝ → ℂ) : ℝ → ℂ := - fun x => - Complex.I * ℏ * deriv ψ x - @[inherit_doc momentumOperator] scoped[QuantumMechanics.OneDimension.HarmonicOscillator] notation "Pᵒᵖ" => momentumOperator -/-- The position operator is defined as the map from `ℝ → ℂ` to `ℝ → ℂ` taking - `ψ` to `x ψ'`. - - The notation `Xᵒᵖ` can be used for the momentum operator. -/ -noncomputable def positionOperator (ψ : ℝ → ℂ) : ℝ → ℂ := - fun x => x * ψ x - @[inherit_doc positionOperator] scoped[QuantumMechanics.OneDimension.HarmonicOscillator] notation "Xᵒᵖ" => positionOperator @@ -191,6 +177,35 @@ lemma schrodingerOperator_parity (ψ : ℝ → ℂ) : rw [← deriv_comp_neg] simp [schrodingerOperator, parityOperator, this] +/-- The Schrodinger operator is additive. -/ +lemma schrodingerOperator_add (ψ φ : ℝ → ℂ) + (hψ : Differentiable ℝ ψ) (hψ' : Differentiable ℝ (deriv ψ)) + (hφ : Differentiable ℝ φ) (hφ' : Differentiable ℝ (deriv φ)) : + Q.schrodingerOperator (ψ + φ) = Q.schrodingerOperator ψ + Q.schrodingerOperator φ := by + unfold schrodingerOperator + funext x + have h_deriv_add : deriv (ψ + φ) = deriv ψ + deriv φ := by + funext y + exact deriv_add (hψ y) (hφ y) + rw [h_deriv_add] + rw [deriv_add (hψ' x) (hφ' x)] + simp only [Pi.add_apply] + ring + +/-- The Schrodinger operator is homogeneous. -/ +lemma schrodingerOperator_smul (c : ℂ) (ψ : ℝ → ℂ) + (hψ : Differentiable ℝ ψ) (hψ' : Differentiable ℝ (deriv ψ)) : + Q.schrodingerOperator (c • ψ) = c • Q.schrodingerOperator ψ := by + unfold schrodingerOperator + funext x + have h_deriv_smul : deriv (c • ψ) = c • deriv ψ := by + funext y + exact deriv_const_smul c (hψ y) + rw [h_deriv_smul] + rw [deriv_const_smul c (hψ' x)] + simp only [Pi.smul_apply, smul_eq_mul] + ring + end HarmonicOscillator end OneDimension end QuantumMechanics diff --git a/PhysLean/QuantumMechanics/OneDimension/HarmonicOscillator/Completeness.lean b/PhysLean/QuantumMechanics/OneDimension/HarmonicOscillator/Completeness.lean index d948bfefc..95e94e52f 100644 --- a/PhysLean/QuantumMechanics/OneDimension/HarmonicOscillator/Completeness.lean +++ b/PhysLean/QuantumMechanics/OneDimension/HarmonicOscillator/Completeness.lean @@ -105,7 +105,7 @@ lemma mul_polynomial_integrable (f : ℝ → ℂ) (hf : MemHS f) (P : Polynomial simp only [Complex.ofReal_exp, Complex.ofReal_div, Complex.ofReal_neg, Complex.ofReal_pow, Complex.ofReal_mul, Complex.ofReal_ofNat, Complex.real_smul] rw [hf'] - apply MeasureTheory.Integrable.smul + apply MeasureTheory.Integrable.fun_smul exact Q.mul_physHermite_integrable f hf i lemma mul_power_integrable (f : ℝ → ℂ) (hf : MemHS f) (r : ℕ) : @@ -431,7 +431,7 @@ lemma fourierIntegral_zero_of_mem_orthogonal (f : ℝ → ℂ) (hf : MemHS f) (hOrth : ∀ n : ℕ, ⟪HilbertSpace.mk (Q.eigenfunction_memHS n), HilbertSpace.mk hf⟫_ℂ = 0) : 𝓕 (fun x => f x * Real.exp (- x^2 / (2 * Q.ξ^2))) = 0 := by funext c - rw [Real.fourierIntegral_eq] + rw [Real.fourier_eq] simp only [RCLike.inner_apply, conj_trivial, ofReal_exp, ofReal_div, ofReal_neg, ofReal_mul, ofReal_pow, ofReal_ofNat, Pi.zero_apply] rw [← Q.orthogonal_exp_of_mem_orthogonal f hf hOrth (- 2 * Real.pi * c)] diff --git a/PhysLean/QuantumMechanics/OneDimension/HarmonicOscillator/Examples.lean b/PhysLean/QuantumMechanics/OneDimension/HarmonicOscillator/Examples.lean new file mode 100644 index 000000000..e1951072a --- /dev/null +++ b/PhysLean/QuantumMechanics/OneDimension/HarmonicOscillator/Examples.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2025 Nicola Bernini. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nicola Bernini +-/ +import PhysLean.QuantumMechanics.OneDimension.HarmonicOscillator.TISE +/-! +# Examples: 1d Quantum Harmonic Oscillator + +This module gives simple examples of how to use the +`QuantumMechanics.OneDimension.HarmonicOscillator` API. + +It is intended for experimentation and pedagogical use, and should +not be imported into other modules. + +To run it from the command line: +``` +lake env lean PhysLean/QuantumMechanics/OneDimension/HarmonicOscillator/Examples.lean +``` +-/ + +namespace QuantumMechanics +namespace OneDimension +namespace HarmonicOscillator +namespace Examples + +open QuantumMechanics OneDimension HarmonicOscillator Constants + +/-- A concrete harmonic oscillator with `m = 1`, `ω = 1`. -/ +noncomputable def Q : HarmonicOscillator where + m := 1 + ω := 1 + hω := by norm_num + hm := by norm_num + +-- Schrödinger operator acting on the ground state +-- Commenting out the checks to reduce noise in the output +-- #check Q.schrodingerOperator (Q.eigenfunction 0) + +-- The time-independent Schrödinger equation for n = 0 +-- Commenting out the checks to reduce noise in the output +-- #check Q.schrodingerOperator_eigenfunction 0 + +/-- The explicit pointwise form of the time-independent Schrödinger equation +for the ground state `n = 0`. -/ +example : + ∀ x, Q.schrodingerOperator (Q.eigenfunction 0) x = + (Q.eigenValue 0) * Q.eigenfunction 0 x := + Q.schrodingerOperator_eigenfunction 0 + +/-- The explicit formula for the ground-state energy for `Q`. -/ +example : + Q.eigenValue 0 = ((0 : ℝ) + 1 / 2) * ℏ * Q.ω := by + simp [QuantumMechanics.OneDimension.HarmonicOscillator.eigenValue] + +/-- Explicit formula for the ground-state wavefunction for `Q`. -/ +example : + Q.eigenfunction 0 = + fun x : ℝ => + (1 / √(√Real.pi * Q.ξ)) * Complex.exp (- x^2 / (2 * Q.ξ^2)) := by + -- This is exactly eigenfunction_zero specialized to our Q. + simpa using + (QuantumMechanics.OneDimension.HarmonicOscillator.eigenfunction_zero (Q := Q)) + +end Examples +end HarmonicOscillator +end OneDimension +end QuantumMechanics diff --git a/PhysLean/QuantumMechanics/OneDimension/HilbertSpace/PlaneWaves.lean b/PhysLean/QuantumMechanics/OneDimension/HilbertSpace/PlaneWaves.lean index c34811ee9..d952fabb8 100644 --- a/PhysLean/QuantumMechanics/OneDimension/HilbertSpace/PlaneWaves.lean +++ b/PhysLean/QuantumMechanics/OneDimension/HilbertSpace/PlaneWaves.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.QuantumMechanics.OneDimension.HilbertSpace.SchwartzSubmodule +import Mathlib.Analysis.Distribution.TemperedDistribution /-! # Plane waves @@ -20,7 +21,7 @@ namespace OneDimension noncomputable section namespace HilbertSpace -open MeasureTheory SchwartzMap +open MeasureTheory SchwartzMap TemperedDistribution /-- Plane waves as a member of the dual of the Schwartz submodule of the Hilbert space. @@ -28,7 +29,7 @@ open MeasureTheory SchwartzMap For a given `k` this corresponds to the plane wave `exp (2π I k x)`. -/ def planewaveFunctional (k : ℝ) : 𝓢(ℝ, ℂ) →L[ℂ] ℂ := - (delta ℂ ℂ k : SchwartzMap ℝ ℂ →L[ℂ] ℂ) ∘L (SchwartzMap.fourierTransformCLM ℂ) + (TemperedDistribution.delta k : SchwartzMap ℝ ℂ →L[ℂ] ℂ) ∘L (SchwartzMap.fourierTransformCLM ℂ) open FourierTransform in lemma planewaveFunctional_apply (k : ℝ) (ψ : 𝓢(ℝ, ℂ)) : @@ -39,7 +40,7 @@ lemma planewaveFunctional_apply (k : ℝ) (ψ : 𝓢(ℝ, ℂ)) : lemma eq_of_eq_planewaveFunctional {ψ1 ψ2 : 𝓢(ℝ, ℂ)} (h : ∀ k, planewaveFunctional k ψ1 = planewaveFunctional k ψ2) : ψ1 = ψ2 := by - apply (SchwartzMap.fourierTransformCLE ℂ).injective + apply (FourierTransform.fourierCLE ℂ 𝓢(ℝ, ℂ)).injective ext k exact h k diff --git a/PhysLean/QuantumMechanics/OneDimension/HilbertSpace/PositionStates.lean b/PhysLean/QuantumMechanics/OneDimension/HilbertSpace/PositionStates.lean index 503200c2e..39ba41723 100644 --- a/PhysLean/QuantumMechanics/OneDimension/HilbertSpace/PositionStates.lean +++ b/PhysLean/QuantumMechanics/OneDimension/HilbertSpace/PositionStates.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.QuantumMechanics.OneDimension.HilbertSpace.SchwartzSubmodule +import Mathlib.Analysis.Distribution.TemperedDistribution /-! # Position states @@ -23,7 +24,7 @@ open MeasureTheory SchwartzMap /-- Position state as a member of the dual of the Schwartz submodule of the Hilbert space. -/ -def positionState (x : ℝ) : 𝓢(ℝ, ℂ) →L[ℂ] ℂ := delta ℂ ℂ x +def positionState (x : ℝ) : 𝓢(ℝ, ℂ) →L[ℂ] ℂ := TemperedDistribution.delta x lemma positionState_apply (x : ℝ) (ψ : 𝓢(ℝ, ℂ)) : positionState x ψ = ψ x := rfl diff --git a/PhysLean/QuantumMechanics/OneDimension/HilbertSpace/SchwartzSubmodule.lean b/PhysLean/QuantumMechanics/OneDimension/HilbertSpace/SchwartzSubmodule.lean index 0f9df48ef..a1bb2507b 100644 --- a/PhysLean/QuantumMechanics/OneDimension/HilbertSpace/SchwartzSubmodule.lean +++ b/PhysLean/QuantumMechanics/OneDimension/HilbertSpace/SchwartzSubmodule.lean @@ -4,8 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.QuantumMechanics.OneDimension.HilbertSpace.Basic -import Mathlib.Analysis.Distribution.FourierSchwartz -import PhysLean.Meta.TODO.Basic +import Mathlib.Analysis.Distribution.SchwartzSpace.Fourier /-! # Schwartz submodule of the Hilbert space diff --git a/PhysLean/QuantumMechanics/OneDimension/Operators/Momentum.lean b/PhysLean/QuantumMechanics/OneDimension/Operators/Momentum.lean index ba4d149a9..2c8a71ab7 100644 --- a/PhysLean/QuantumMechanics/OneDimension/Operators/Momentum.lean +++ b/PhysLean/QuantumMechanics/OneDimension/Operators/Momentum.lean @@ -74,7 +74,7 @@ lemma momentumOperator_add {ψ1 ψ2 : ℝ → ℂ} /-- The parity operator on the Schwartz maps is defined as the linear map from `𝓢(ℝ, ℂ)` to itself, such that `ψ` is taken to `fun x => - I ℏ * ψ' x`. -/ def momentumOperatorSchwartz : 𝓢(ℝ, ℂ) →L[ℂ] 𝓢(ℝ, ℂ) where - toFun ψ := (- Complex.I * ℏ) • SchwartzMap.derivCLM ℂ ψ + toFun ψ := (- Complex.I * ℏ) • SchwartzMap.derivCLM ℂ ℂ ψ map_add' ψ1 ψ2 := by simp only [neg_mul, map_add, smul_add, neg_smul] map_smul' a ψ := by @@ -105,17 +105,21 @@ lemma planeWaveFunctional_generalized_eigenvector_momentumOperatorUnbounded (k : rw [UnboundedOperator.isGeneralizedEigenvector_ofSelfCLM_iff] intro ψ trans (-((Complex.I * ↑↑ℏ) • - (SchwartzMap.fourierTransformCLM ℂ) ((SchwartzMap.derivCLM ℂ) ψ) k)) + (SchwartzMap.fourierTransformCLM ℂ) ((SchwartzMap.derivCLM ℂ ℂ) ψ) k)) · simp [momentumOperatorSchwartz] left rfl conv_lhs => simp only [SchwartzMap.fourierTransformCLM_apply, smul_eq_mul] - erw [Real.fourierIntegral_deriv (SchwartzMap.integrable ψ) - (SchwartzMap.differentiable (ψ)) (SchwartzMap.integrable ((SchwartzMap.derivCLM ℂ) ψ))] + change -(Complex.I * ↑↑ℏ * (FourierTransform.fourier ((deriv ψ)) k)) = _ + rw [Real.fourier_deriv (SchwartzMap.integrable ψ) + (SchwartzMap.differentiable (ψ)) (SchwartzMap.integrable ((SchwartzMap.derivCLM ℂ ℂ) ψ))] simp [planewaveFunctional] ring_nf - simp + simp only [Complex.I_sq, neg_mul, one_mul, neg_neg, mul_eq_mul_right_iff, mul_eq_mul_left_iff, + mul_eq_zero, Complex.ofReal_eq_zero, Real.pi_ne_zero, or_false, OfNat.ofNat_ne_zero] + left + rfl /-! @@ -129,13 +133,13 @@ lemma momentumOperatorUnbounded_isSelfAdjoint : momentumOperatorUnbounded.IsSelf rw [schwartzIncl_inner, schwartzIncl_inner] conv_rhs => change ∫ (x : ℝ), (starRingEnd ℂ) ((ψ1) x) * - ((-Complex.I * ↑↑ℏ) * (SchwartzMap.derivCLM ℂ) (ψ2) x) + ((-Complex.I * ↑↑ℏ) * (SchwartzMap.derivCLM ℂ ℂ) (ψ2) x) enter [2, x] rw [← mul_assoc] rw [mul_comm _ (-Complex.I * ↑↑ℏ)] rw [mul_assoc] simp only [SchwartzMap.derivCLM_apply] - rw [← fderiv_deriv] + rw [← fderiv_apply_one_eq_deriv] rw [MeasureTheory.integral_const_mul] rw [integral_mul_fderiv_eq_neg_fderiv_mul_of_integrable] conv_rhs => @@ -153,9 +157,9 @@ lemma momentumOperatorUnbounded_isSelfAdjoint : momentumOperatorUnbounded.IsSelf enter [1, x] change (fderiv ℝ (fun a => star ((ψ1) a)) x) 1 rw [fderiv_star] - change (starL' ℝ) (SchwartzMap.derivCLM ℂ (ψ1) x) + change (starL' ℝ) (SchwartzMap.derivCLM ℂ ℂ (ψ1) x) rw [ContinuousLinearEquiv.integrable_comp_iff] - exact SchwartzMap.integrable ((SchwartzMap.derivCLM ℂ) (ψ1)) + exact SchwartzMap.integrable ((SchwartzMap.derivCLM ℂ ℂ) (ψ1)) · exact SchwartzMap.memLp_top (ψ2) MeasureTheory.volume · apply MeasureTheory.Integrable.mul_of_top_left · change MeasureTheory.Integrable @@ -163,8 +167,8 @@ lemma momentumOperatorUnbounded_isSelfAdjoint : momentumOperatorUnbounded.IsSelf rw [ContinuousLinearEquiv.integrable_comp_iff] exact SchwartzMap.integrable (ψ1) · change MeasureTheory.MemLp - (fun x => SchwartzMap.derivCLM ℂ (ψ2) x) ⊤ MeasureTheory.volume - exact SchwartzMap.memLp_top ((SchwartzMap.derivCLM ℂ) (ψ2)) + (fun x => SchwartzMap.derivCLM ℂ ℂ (ψ2) x) ⊤ MeasureTheory.volume + exact SchwartzMap.memLp_top ((SchwartzMap.derivCLM ℂ ℂ) (ψ2)) MeasureTheory.volume · apply MeasureTheory.Integrable.mul_of_top_left · change MeasureTheory.Integrable diff --git a/PhysLean/QuantumMechanics/OneDimension/Operators/Parity.lean b/PhysLean/QuantumMechanics/OneDimension/Operators/Parity.lean index 072ba6d4f..75234b108 100644 --- a/PhysLean/QuantumMechanics/OneDimension/Operators/Parity.lean +++ b/PhysLean/QuantumMechanics/OneDimension/Operators/Parity.lean @@ -58,11 +58,11 @@ def parityOperatorSchwartz : 𝓢(ℝ, ℂ) →L[ℂ] 𝓢(ℝ, ℂ) := by | 0 => simp | 1 => rw [iteratedFDeriv_succ_eq_comp_right] - simp + simp [ContinuousLinearMap.norm_id] | .succ (.succ n) => rw [iteratedFDeriv_succ_eq_comp_right] - simp only [Nat.succ_eq_add_one, fderiv_id', Function.comp_apply, LinearIsometryEquiv.norm_map, - ge_iff_le] + simp only [Nat.succ_eq_add_one, fderiv_id', Function.comp_apply, + LinearIsometryEquiv.norm_map, ge_iff_le] rw [iteratedFDeriv_const_of_ne] simp only [Pi.zero_apply, norm_zero] apply add_nonneg diff --git a/PhysLean/QuantumMechanics/OneDimension/ReflectionlessPotential/Basic.lean b/PhysLean/QuantumMechanics/OneDimension/ReflectionlessPotential/Basic.lean index c3fc505d0..752d82c76 100644 --- a/PhysLean/QuantumMechanics/OneDimension/ReflectionlessPotential/Basic.lean +++ b/PhysLean/QuantumMechanics/OneDimension/ReflectionlessPotential/Basic.lean @@ -6,7 +6,6 @@ Authors: Afiq Hatta import PhysLean.QuantumMechanics.OneDimension.Operators.Parity import PhysLean.QuantumMechanics.OneDimension.Operators.Momentum import PhysLean.QuantumMechanics.OneDimension.Operators.Position -import PhysLean.SpaceAndTime.Space.VectorIdentities import PhysLean.SpaceAndTime.Time.Basic import PhysLean.Mathematics.Trigonometry.Tanh /-! @@ -80,7 +79,7 @@ lemma scaled_tanh_hasTemperateGrowth (κ : ℝ) : Function.HasTemperateGrowth (fun x => (Real.tanh (κ * x))) := by exact tanh_const_mul_hasTemperateGrowth κ -/-- This is a helper lemma to show that the embedding of a real functio with temperate growth in ℂ +/-- This is a helper lemma to show that the embedding of a real function with temperate growth in ℂ also has temperate growth -/ private lemma complex_embedding_of_temperate_growth (f : ℝ → ℝ) (h : Function.HasTemperateGrowth f) : Function.HasTemperateGrowth (fun x => (f x : ℂ)) := by @@ -136,7 +135,7 @@ noncomputable def creationOperatorSchwartz (Q : ReflectionlessPotential) : 𝓢( noncomputable def annihilationOperatorSchwartz (Q : ReflectionlessPotential) : 𝓢(ℝ, ℂ) →L[ℂ] 𝓢(ℝ, ℂ) := (1 / Real.sqrt (2 * Q.m)) • momentumOperatorSchwartz + - ((Complex.I * Q.ℏ * Q.κ) / Real.sqrt (2 * Q.m)) • Q.tanhOperatorSchwartz + ((-Complex.I * Q.ℏ * Q.κ) / Real.sqrt (2 * Q.m)) • Q.tanhOperatorSchwartz end ReflectionlessPotential end OneDimension diff --git a/PhysLean/QuantumMechanics/PlanckConstant.lean b/PhysLean/QuantumMechanics/PlanckConstant.lean index f02baba35..2412f5818 100644 --- a/PhysLean/QuantumMechanics/PlanckConstant.lean +++ b/PhysLean/QuantumMechanics/PlanckConstant.lean @@ -9,15 +9,14 @@ import Mathlib.Data.NNReal.Defs # Planck's constant In this module we define the Planck's constant `ℏ` as a positive real number. -This is introduced as an axiom. -/ open NNReal namespace Constants -/-- Planck's constant. -/ -axiom ℏ : Subtype fun x : ℝ => 0 < x +/-- The value of the reduced Planck's constant in units of J.s. -/ +def ℏ : Subtype fun x : ℝ => 0 < x := ⟨1.054571817e-34, by norm_num⟩ /-- Planck's constant is positive. -/ lemma ℏ_pos : 0 < (ℏ : ℝ) := ℏ.2 diff --git a/PhysLean/Relativity/CliffordAlgebra.lean b/PhysLean/Relativity/CliffordAlgebra.lean index 5d16f0346..c9aeff39e 100644 --- a/PhysLean/Relativity/CliffordAlgebra.lean +++ b/PhysLean/Relativity/CliffordAlgebra.lean @@ -10,10 +10,28 @@ import PhysLean.Meta.TODO.Basic /-! # The Clifford Algebra -This file defines the Gamma matrices. +This file defines the Gamma matrices and their relationship to the Clifford algebra. + +## Main Definitions + +- `γ0, γ1, γ2, γ3`: The four gamma matrices in the Dirac representation (4×4 complex matrices) +- `γSet`: The set of gamma matrices +- `diracForm`: The quadratic form with Minkowski signature (+,-,-,-) + corresponding to the gamma matrices +- `diracAlgebra`: The algebra generated by the gamma matrices over ℝ +- `ofCliffordAlgebra`: The algebra homomorphism from the Clifford algebra to `diracAlgebra` + +## Main Results + +- `ofCliffordAlgebra_surjective`: The homomorphism `ofCliffordAlgebra` is surjective + +## TODO + +- Complete the isomorphism by proving injectivity of `ofCliffordAlgebra` (requires dimension theory) +- Construct the `AlgEquiv` between `CliffordAlgebra diracForm` and `diracAlgebra` -/ -TODO "6VZF2" "Prove algebra generated by gamma matrices is isomorphic to Clifford algebra." +TODO "6VZF2" "Prove injectivity of ofCliffordAlgebra and construct the full isomorphism." namespace spaceTime open Complex @@ -112,6 +130,57 @@ lemma ofCliffordAlgebra_ι_single (i : Fin 4) (r : ℝ) : CliffordAlgebra.lift_ι_apply _ _ _ |>.trans <| Subtype.ext <| by simp +contextual [Fintype.sum_eq_single i, -γ] +/-! ### Surjectivity of ofCliffordAlgebra -/ + +/-- Each gamma matrix (as an element of diracAlgebra) is in the range of ofCliffordAlgebra. -/ +lemma γ_subtype_in_range (i : Fin 4) : + ⟨γ i, γ_in_diracAlgebra i⟩ ∈ ofCliffordAlgebra.range := by + use CliffordAlgebra.ι diracForm (Pi.single i 1) + simp [ofCliffordAlgebra_ι_single] + +/-- Helper lemma: If a matrix is in Algebra.adjoin ℝ γSet, then its subtype is in the range. -/ +private lemma mem_adjoin_imp_subtype_in_range (m : Matrix (Fin 4) (Fin 4) ℂ) + (hm : m ∈ Algebra.adjoin ℝ γSet) : ⟨m, hm⟩ ∈ ofCliffordAlgebra.range := by + induction hm using Algebra.adjoin_induction with + | mem y hy => + -- y ∈ γSet, so y = γ i for some i + obtain ⟨i, rfl⟩ := hy + exact γ_subtype_in_range i + | algebraMap r => + -- r from ℝ + use algebraMap ℝ _ r + ext + simp [Algebra.algebraMap_eq_smul_one] + | add y z _ _ hy hz => + -- If y and z are in range, so is y + z + obtain ⟨y', hy'⟩ := hy + obtain ⟨z', hz'⟩ := hz + use y' + z' + ext : 1 + have hy'' : (ofCliffordAlgebra y' : Matrix (Fin 4) (Fin 4) ℂ) = y := congr_arg Subtype.val hy' + have hz'' : (ofCliffordAlgebra z' : Matrix (Fin 4) (Fin 4) ℂ) = z := congr_arg Subtype.val hz' + simp [hy'', hz''] + | mul y z _ _ hy hz => + -- If y and z are in range, so is y * z + obtain ⟨y', hy'⟩ := hy + obtain ⟨z', hz'⟩ := hz + use y' * z' + ext : 1 + have hy'' : (ofCliffordAlgebra y' : Matrix (Fin 4) (Fin 4) ℂ) = y := congr_arg Subtype.val hy' + have hz'' : (ofCliffordAlgebra z' : Matrix (Fin 4) (Fin 4) ℂ) = z := congr_arg Subtype.val hz' + simp [hy'', hz''] + +/-- The range of ofCliffordAlgebra equals the top subalgebra (i.e., all of diracAlgebra). -/ +lemma ofCliffordAlgebra_range_eq_top : ofCliffordAlgebra.range = ⊤ := by + rw [eq_top_iff] + intro x _ + exact mem_adjoin_imp_subtype_in_range x.val x.property + +/-- The homomorphism `ofCliffordAlgebra` is surjective. -/ +theorem ofCliffordAlgebra_surjective : Function.Surjective ofCliffordAlgebra := by + rw [← AlgHom.range_eq_top] + exact ofCliffordAlgebra_range_eq_top + end γ end diracRepresentation diff --git a/PhysLean/Relativity/LorentzAlgebra/Basis.lean b/PhysLean/Relativity/LorentzAlgebra/Basis.lean index e36aaf6b0..340632cc3 100644 --- a/PhysLean/Relativity/LorentzAlgebra/Basis.lean +++ b/PhysLean/Relativity/LorentzAlgebra/Basis.lean @@ -6,14 +6,158 @@ Authors: Joseph Tooby-Smith import PhysLean.Relativity.LorentzAlgebra.Basic import PhysLean.Meta.TODO.Basic /-! -# Basis of the Lorentz Algebra +# Generators of the Lorentz Algebra -This file is currently a stub. +This file defines the 6 standard generators of the Lorentz algebra so(1,3) : +- **Boost generators** K₀, K₁, K₂: Generate Lorentz transformations (velocity changes) +- **Rotation generators** J₀, J₁, J₂: Generate spatial rotations -Old commits contained code here, however this has not being ported forward. +These generators form a basis for the 6-dimensional Lie algebra so(1,3), though the full +basis structure (linear independence and spanning) is not yet proven here. -This file is waiting for Lorentz Tensors to be done formally, before -it can be completed. +## Physical Interpretation +- `boostGenerator i`: Infinitesimal boost in the i-th spatial direction. Exponentiating + this generator produces finite Lorentz boosts. +- `rotationGenerator i`: Infinitesimal rotation about the i-th axis following the + right-hand rule. Exponentiating this generator produces spatial rotations. + +## Mathematical Structure + +Each generator satisfies the Lorentz algebra condition: Aᵀ η = -η A, where η is the +Minkowski metric with signature (+,-,-,-). + +The boost generators are symmetric matrices with non-zero entries only in the time-space +block, while rotation generators are antisymmetric matrices acting only on spatial indices. + +## References + +- Weinberg, *The Quantum Theory of Fields*, Vol 1, Section 2.7 +- Peskin & Schroeder, *An Introduction to QFT*, Appendix A + +## Future Work + +TODO "6VZKA" can be completed by proving linear independence and spanning of these +6 generators, then constructing a formal `Basis (Fin 2 × Fin 3) ℝ lorentzAlgebra`. + +-/ + +open Matrix + +namespace lorentzAlgebra + +/-- The boost generator K_i in the Lorentz algebra so(1,3). + +This matrix generates infinitesimal Lorentz boosts in the i-th spatial direction. +The matrix has non-zero entries only at positions (0, i+1) and (i+1, 0) with value 1, +where we use the index convention 0 = time, 1,2,3 = space. + +## Properties +- Symmetric: K_iᵀ = K_i +- Traceless: tr(K_i) = 0 +- Satisfies Lorentz algebra condition: K_iᵀ η = -η K_i + +## Physical Meaning +Exponentiating β·K_i produces a finite Lorentz boost with rapidity β in direction i. +-/ +def boostGenerator (i : Fin 3) : Matrix (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) ℝ := + fun μ ν => + if (μ = Sum.inl 0 ∧ ν = Sum.inr i) ∨ (μ = Sum.inr i ∧ ν = Sum.inl 0) then 1 + else 0 + +/-- The rotation generator J_i in the Lorentz algebra so(1,3). + +This matrix generates infinitesimal rotations about the i-th axis following the right-hand rule. +The matrix acts only on spatial indices in the antisymmetric pattern characteristic of +angular momentum generators. + +## Properties +- Antisymmetric: J_iᵀ = -J_i +- Traceless: tr(J_i) = 0 +- Satisfies Lorentz algebra condition: J_iᵀ η = -η J_i + +## Structure +- J_0 (rotation about x-axis) : Acts on (y,z) components +- J_1 (rotation about y-axis) : Acts on (z,x) components +- J_2 (rotation about z-axis) : Acts on (x,y) components + +## Physical Meaning +Exponentiating θ·J_i produces a finite rotation by angle θ about axis i. +-/ +def rotationGenerator (i : Fin 3) : Matrix (Fin 1 ⊕ Fin 3) (Fin 1 ⊕ Fin 3) ℝ := + fun μ ν => + match i with + | 0 => if μ = Sum.inr 1 ∧ ν = Sum.inr 2 then -1 + else if μ = Sum.inr 2 ∧ ν = Sum.inr 1 then 1 + else 0 + | 1 => if μ = Sum.inr 0 ∧ ν = Sum.inr 2 then 1 + else if μ = Sum.inr 2 ∧ ν = Sum.inr 0 then -1 + else 0 + | 2 => if μ = Sum.inr 0 ∧ ν = Sum.inr 1 then -1 + else if μ = Sum.inr 1 ∧ ν = Sum.inr 0 then 1 + else 0 + +/-- The boost generator K_i is in the Lorentz algebra. -/ +lemma boostGenerator_mem (i : Fin 3) : boostGenerator i ∈ lorentzAlgebra := by + rw [lorentzAlgebra.mem_iff] + ext μ ν + simp only [boostGenerator, minkowskiMatrix.as_diagonal, mul_diagonal, transpose_apply] + rcases μ with μ | μ <;> rcases ν with ν | ν + · -- (time, time) case + simp only [Sum.elim_inl] + have : μ = 0 := Subsingleton.elim _ _ + have : ν = 0 := Subsingleton.elim _ _ + simp [boostGenerator, *] + · -- (time, space) case + simp only [Sum.elim_inr] + have : μ = 0 := Subsingleton.elim _ _ + simp [boostGenerator, *] + split_ifs <;> norm_num + · -- (space, time) case + simp only [Sum.elim_inl] + have : ν = 0 := Subsingleton.elim _ _ + simp [boostGenerator, *] + · -- (space, space) case + simp [Sum.elim_inr, boostGenerator] + +/-- The rotation generator J_i is in the Lorentz algebra. -/ +lemma rotationGenerator_mem (i : Fin 3) : rotationGenerator i ∈ lorentzAlgebra := by + rw [lorentzAlgebra.mem_iff] + ext μ ν + simp only [rotationGenerator, minkowskiMatrix.as_diagonal, mul_diagonal, transpose_apply] + rcases μ with μ | μ <;> rcases ν with ν | ν + · -- (time, time) case + have : μ = 0 := Subsingleton.elim _ _ + have : ν = 0 := Subsingleton.elim _ _ + simp [rotationGenerator, *] + fin_cases i <;> norm_num + · -- (time, space) case + have : μ = 0 := Subsingleton.elim _ _ + simp [rotationGenerator, *] + · -- (space, time) case + have : ν = 0 := Subsingleton.elim _ _ + simp [rotationGenerator, *] + · -- (space, space) case: need explicit computation + simp only [Sum.elim_inr] + fin_cases i <;> fin_cases μ <;> fin_cases ν <;> simp [rotationGenerator] + +/-! +## TODO: Properties of Generators + +The following properties are documented in the docstrings but not yet formally proven. +These should be established in future PRs to complete the characterization of the generators. -/ -TODO "6VZKA" "Define the standard basis of the Lorentz algebra." + +TODO "BOOST_SYM" "Prove that boost generators are symmetric: \ + (boostGenerator i)ᵀ = boostGenerator i" + +TODO "BOOST_TRACE" "Prove that boost generators are traceless: \ + Matrix.trace (boostGenerator i) = 0" + +TODO "ROT_ANTISYM" "Prove that rotation generators are antisymmetric: \ + (rotationGenerator i)ᵀ = -(rotationGenerator i)" + +TODO "ROT_TRACE" "Prove that rotation generators are traceless: \ + Matrix.trace (rotationGenerator i) = 0" + +end lorentzAlgebra diff --git a/PhysLean/Relativity/LorentzAlgebra/ExponentialMap.lean b/PhysLean/Relativity/LorentzAlgebra/ExponentialMap.lean index c53fe647c..73281c771 100644 --- a/PhysLean/Relativity/LorentzAlgebra/ExponentialMap.lean +++ b/PhysLean/Relativity/LorentzAlgebra/ExponentialMap.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Matteo Cipollina -/ import Mathlib.Analysis.Normed.Field.Instances -import Mathlib.Topology.Metrizable.CompletelyMetrizable import PhysLean.Mathematics.DataStructures.Matrix.LieTrace import PhysLean.Relativity.LorentzAlgebra.Basic import PhysLean.Relativity.LorentzGroup.Restricted.Basic @@ -51,7 +50,7 @@ The exponential of the transpose of a Lorentz algebra element. This connects `exp(Aᵀ)` to a conjugation of `exp(-A)`. -/ lemma exp_transpose_of_mem_algebra (A : lorentzAlgebra) : - (NormedSpace.exp ℝ) (A.1ᵀ) = η * ((NormedSpace.exp ℝ) (-A.1)) * η := by + NormedSpace.exp (A.1ᵀ) = η * (NormedSpace.exp (-A.1)) * η := by rw [transpose_eq_neg_eta_conj A] let P_gl : GL (Fin 1 ⊕ Fin 3) ℝ := { val := η, @@ -59,24 +58,24 @@ lemma exp_transpose_of_mem_algebra (A : lorentzAlgebra) : val_inv := minkowskiMatrix.sq, inv_val := minkowskiMatrix.sq } rw [show -(η * A.1 * η) = η * (-A.1) * η by noncomm_ring] - erw [NormedSpace.exp_units_conj ℝ P_gl (-A.1)] + erw [NormedSpace.exp_units_conj P_gl (-A.1)] rfl /-- The exponential of an element of the Lorentz algebra is a member of the Lorentz group. -/ -theorem exp_mem_lorentzGroup (A : lorentzAlgebra) : (NormedSpace.exp ℝ) A.1 ∈ LorentzGroup 3 := by +theorem exp_mem_lorentzGroup (A : lorentzAlgebra) : NormedSpace.exp A.1 ∈ LorentzGroup 3 := by rw [LorentzGroup.mem_iff_transpose_mul_minkowskiMatrix_mul_self] rw [← Matrix.exp_transpose] rw [exp_transpose_of_mem_algebra A] calc - (η * (NormedSpace.exp ℝ) (-A.1) * η) * η * (NormedSpace.exp ℝ) A.1 - _ = η * (NormedSpace.exp ℝ) (-A.1) * (η * η) * (NormedSpace.exp ℝ) A.1 := by noncomm_ring - _ = η * (NormedSpace.exp ℝ) (-A.1) * 1 * (NormedSpace.exp ℝ) A.1 := by rw [minkowskiMatrix.sq] - _ = η * (NormedSpace.exp ℝ) (-A.1 + A.1) := by + (η * NormedSpace.exp (-A.1) * η) * η * NormedSpace.exp A.1 + _ = η * NormedSpace.exp (-A.1) * (η * η) * NormedSpace.exp A.1 := by noncomm_ring + _ = η * NormedSpace.exp (-A.1) * 1 * NormedSpace.exp A.1 := by rw [minkowskiMatrix.sq] + _ = η * NormedSpace.exp (-A.1 + A.1) := by rw [mul_one, mul_assoc, NormedSpace.exp_add_of_commute] exact Commute.neg_left rfl - _ = η * (NormedSpace.exp ℝ) 0 := by rw [neg_add_cancel] + _ = η * NormedSpace.exp 0 := by rw [neg_add_cancel] _ = η * 1 := by rw [NormedSpace.exp_zero] _ = η := by rw [mul_one] @@ -113,10 +112,10 @@ variable {n R ι : Type*} [Fintype n] [DecidableEq n] @[simp] lemma exp_reindex {k : Type*} [RCLike k] [Fintype ι] [DecidableEq ι] (e : n ≃ ι) (A : Matrix n n k) : - NormedSpace.exp k (A.submatrix e.symm e.symm) = reindex e e (NormedSpace.exp k A) := by + NormedSpace.exp (A.submatrix e.symm e.symm) = reindex e e (NormedSpace.exp A) := by let f := reindexAlgEquiv k k e have h_cont : Continuous f := f.toLinearEquiv.continuous_of_finiteDimensional - exact (NormedSpace.map_exp k f.toAlgHom h_cont A).symm + exact (NormedSpace.map_exp f.toAlgHom h_cont A).symm end Matrix @@ -127,7 +126,7 @@ attribute [local instance] Matrix.linftyOpNormedAlgebra /-- The exponential of an element of the Lorentz algebra is proper (has determinant 1). -/ theorem exp_isProper (A : lorentzAlgebra) : - LorentzGroup.IsProper ⟨(NormedSpace.exp ℝ) A.1, exp_mem_lorentzGroup A⟩ := by + LorentzGroup.IsProper ⟨NormedSpace.exp A.1, exp_mem_lorentzGroup A⟩ := by simp only [LorentzGroup.IsProper] let e : (Fin 1 ⊕ Fin 3) ≃ Fin 4 := finSumFinEquiv -- we reindex to Fin 4 to use the faster LinearOrder @@ -137,7 +136,7 @@ theorem exp_isProper (A : lorentzAlgebra) : /-- The exponential of an element of the Lorentz algebra is orthochronous. -/ theorem exp_isOrthochronous (A : lorentzAlgebra) : - LorentzGroup.IsOrthochronous ⟨(NormedSpace.exp ℝ) A.1, exp_mem_lorentzGroup A⟩ := by + LorentzGroup.IsOrthochronous ⟨NormedSpace.exp A.1, exp_mem_lorentzGroup A⟩ := by -- The Lie algebra is a vector space, so there is a path from 0 to A. let γ : Path (0 : lorentzAlgebra) A := { toFun := fun t => t.val • A, @@ -147,8 +146,8 @@ theorem exp_isOrthochronous (A : lorentzAlgebra) : · exact continuous_const, source' := by simp [zero_smul], target' := by simp [one_smul] } - let exp_γ : Path (1 : LorentzGroup 3) ⟨(NormedSpace.exp ℝ) A.1, exp_mem_lorentzGroup A⟩ := - { toFun := fun t => ⟨(NormedSpace.exp ℝ) (γ t).val, exp_mem_lorentzGroup (γ t)⟩, + let exp_γ : Path (1 : LorentzGroup 3) ⟨NormedSpace.exp A.1, exp_mem_lorentzGroup A⟩ := + { toFun := fun t => ⟨NormedSpace.exp (γ t).val, exp_mem_lorentzGroup (γ t)⟩, continuous_toFun := by apply Continuous.subtype_mk apply Continuous.comp @@ -162,9 +161,9 @@ theorem exp_isOrthochronous (A : lorentzAlgebra) : ext i j simp only [γ] simp} - have h_joined : Joined (1 : LorentzGroup 3) ⟨(NormedSpace.exp ℝ) A.1, exp_mem_lorentzGroup A⟩ := + have h_joined : Joined (1 : LorentzGroup 3) ⟨NormedSpace.exp A.1, exp_mem_lorentzGroup A⟩ := ⟨exp_γ⟩ - have h_connected : ⟨(NormedSpace.exp ℝ) A.1, exp_mem_lorentzGroup A⟩ ∈ connectedComponent + have h_connected : ⟨NormedSpace.exp A.1, exp_mem_lorentzGroup A⟩ ∈ connectedComponent (1 : LorentzGroup 3) := pathComponent_subset_component _ h_joined rw [← LorentzGroup.isOrthochronous_on_connected_component h_connected] @@ -173,6 +172,6 @@ theorem exp_isOrthochronous (A : lorentzAlgebra) : /-- The exponential of an element of the Lorentz algebra is a member of the restricted Lorentz group. -/ theorem exp_mem_restricted_lorentzGroup (A : lorentzAlgebra) : - (⟨(NormedSpace.exp ℝ) A.1, exp_mem_lorentzGroup A⟩ : LorentzGroup 3) ∈ + (⟨NormedSpace.exp A.1, exp_mem_lorentzGroup A⟩ : LorentzGroup 3) ∈ LorentzGroup.restricted 3 := by exact ⟨exp_isProper A, exp_isOrthochronous A⟩ diff --git a/PhysLean/Relativity/LorentzGroup/Basic.lean b/PhysLean/Relativity/LorentzGroup/Basic.lean index ba29cb5ff..1a66d9dda 100644 --- a/PhysLean/Relativity/LorentzGroup/Basic.lean +++ b/PhysLean/Relativity/LorentzGroup/Basic.lean @@ -59,7 +59,7 @@ lemma mem_iff_self_mul_dual : Λ ∈ LorentzGroup d ↔ Λ * dual Λ = 1 := by lemma mem_iff_dual_mul_self : Λ ∈ LorentzGroup d ↔ dual Λ * Λ = 1 := by rw [mem_iff_self_mul_dual] - exact mul_eq_one_comm + exact _root_.mul_eq_one_comm lemma mem_iff_transpose : Λ ∈ LorentzGroup d ↔ Λᵀ ∈ LorentzGroup d := by refine Iff.intro (fun h ↦ ?_) (fun h ↦ ?_) @@ -125,12 +125,12 @@ end LorentzGroup @[simps! mul_coe one_coe div] instance lorentzGroupIsGroup : Group (LorentzGroup d) where mul A B := ⟨A.1 * B.1, LorentzGroup.mem_mul A.2 B.2⟩ - mul_assoc A B C := Subtype.eq (Matrix.mul_assoc A.1 B.1 C.1) + mul_assoc A B C := Subtype.ext (Matrix.mul_assoc A.1 B.1 C.1) one := ⟨1, LorentzGroup.one_mem⟩ - one_mul A := Subtype.eq (Matrix.one_mul A.1) - mul_one A := Subtype.eq (Matrix.mul_one A.1) + one_mul A := Subtype.ext (Matrix.one_mul A.1) + mul_one A := Subtype.ext (Matrix.mul_one A.1) inv A := ⟨minkowskiMatrix.dual A.1, LorentzGroup.dual_mem A.2⟩ - inv_mul_cancel A := Subtype.eq (LorentzGroup.mem_iff_dual_mul_self.mp A.2) + inv_mul_cancel A := Subtype.ext (LorentzGroup.mem_iff_dual_mul_self.mp A.2) /-- `LorentzGroup` has the subtype topology. -/ instance : TopologicalSpace (LorentzGroup d) := instTopologicalSpaceSubtype @@ -192,16 +192,16 @@ def transpose (Λ : LorentzGroup d) : LorentzGroup d := ⟨Λ.1ᵀ, mem_iff_transpose.mp Λ.2⟩ @[simp] -lemma transpose_one : @transpose d 1 = 1 := Subtype.eq Matrix.transpose_one +lemma transpose_one : @transpose d 1 = 1 := Subtype.ext Matrix.transpose_one @[simp] lemma transpose_mul : transpose (Λ * Λ') = transpose Λ' * transpose Λ := - Subtype.eq (Matrix.transpose_mul Λ.1 Λ'.1) + Subtype.ext (Matrix.transpose_mul Λ.1 Λ'.1) lemma transpose_val : (transpose Λ).1 = Λ.1ᵀ := rfl lemma transpose_inv : (transpose Λ)⁻¹ = transpose Λ⁻¹ := by - refine Subtype.eq ?_ + refine Subtype.ext ?_ rw [transpose_val, coe_inv, transpose_val, coe_inv, Matrix.transpose_nonsing_inv] lemma comm_minkowskiMatrix : Λ.1 * minkowskiMatrix = minkowskiMatrix * (transpose Λ⁻¹).1 := by @@ -233,7 +233,7 @@ instance : Neg (LorentzGroup d) where lemma coe_neg : (-Λ).1 = -Λ.1 := rfl lemma inv_neg : (-Λ)⁻¹ = -Λ⁻¹ := by - refine Subtype.eq ?_ + refine Subtype.ext ?_ simp [inv_eq_dual, dual] /-! @@ -248,7 +248,7 @@ embedding. /-- The homomorphism of the Lorentz group into `GL (Fin 4) ℝ`. -/ def toGL : LorentzGroup d →* GL (Fin 1 ⊕ Fin d) ℝ where - toFun A := ⟨A.1, (A⁻¹).1, mul_eq_one_comm.mpr $ mem_iff_dual_mul_self.mp A.2, + toFun A := ⟨A.1, (A⁻¹).1, _root_.mul_eq_one_comm.mpr $ mem_iff_dual_mul_self.mp A.2, mem_iff_dual_mul_self.mp A.2⟩ map_one' := (GeneralLinearGroup.ext_iff _ 1).mpr fun _ => congrFun rfl @@ -256,7 +256,7 @@ def toGL : LorentzGroup d →* GL (Fin 1 ⊕ Fin d) ℝ where (GeneralLinearGroup.ext_iff _ _).mpr fun _ => congrFun rfl lemma toGL_injective : Function.Injective (@toGL d) := by - refine fun A B h => Subtype.eq ?_ + refine fun A B h => Subtype.ext ?_ rw [@Units.ext_iff] at h exact h @@ -273,7 +273,7 @@ lemma toProd_injective : Function.Injective (@toProd d) := by intro A B h rw [toProd_eq_transpose_η, toProd_eq_transpose_η] at h rw [Prod.mk_inj] at h - exact Subtype.eq h.1 + exact Subtype.ext h.1 lemma toProd_continuous : Continuous (@toProd d) := by refine continuous_prodMk.mpr ⟨continuous_iff_le_induced.mpr fun U a ↦ a, @@ -384,7 +384,7 @@ def parity : LorentzGroup d := ⟨minkowskiMatrix, by lemma eq_of_mulVec_eq {Λ Λ' : LorentzGroup d} (h : ∀ (x : Fin 1 ⊕ Fin d → ℝ), Λ.1 *ᵥ x = Λ'.1 *ᵥ x) : Λ = Λ' := by - apply Subtype.eq + apply Subtype.ext exact ext_of_mulVec_single fun i => h (Pi.single i 1) end LorentzGroup diff --git a/PhysLean/Relativity/LorentzGroup/Boosts/Apply.lean b/PhysLean/Relativity/LorentzGroup/Boosts/Apply.lean index b19bcb23c..afd25c735 100644 --- a/PhysLean/Relativity/LorentzGroup/Boosts/Apply.lean +++ b/PhysLean/Relativity/LorentzGroup/Boosts/Apply.lean @@ -3,7 +3,6 @@ Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ -import PhysLean.Relativity.Tensors.RealTensor.Vector.MinkowskiProduct import PhysLean.Relativity.LorentzGroup.Boosts.Basic /-! diff --git a/PhysLean/Relativity/LorentzGroup/Boosts/Basic.lean b/PhysLean/Relativity/LorentzGroup/Boosts/Basic.lean index 8a22b3958..37893b22a 100644 --- a/PhysLean/Relativity/LorentzGroup/Boosts/Basic.lean +++ b/PhysLean/Relativity/LorentzGroup/Boosts/Basic.lean @@ -3,7 +3,7 @@ Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ -import PhysLean.Relativity.LorentzGroup.Basic +import PhysLean.SpaceAndTime.SpaceTime.Basic /-! # Boosts in the Lorentz group @@ -298,6 +298,68 @@ lemma boost_inr_inr_other {i j k : Fin d} {β : ℝ} (hβ : |β| < 1) (hij : j simp only [transpose, transpose_apply] rw [boost_inr_other_inr] exact hij +/-! + +## Properties of boosts in the zero-direction + +-/ + +@[simp] +lemma boost_zero_inl_0_inr_succ {d : ℕ} {β : ℝ} (hβ : |β| < 1) (i : Fin d) : + (boost (0 : Fin d.succ) β hβ).1 (Sum.inl 0) (Sum.inr i.succ) = 0 := by + rw [boost_inl_0_inr_other] + simp + +@[simp] +lemma boost_zero_inr_succ_inl_0{d : ℕ} {β : ℝ} (hβ : |β| < 1) (i : Fin d) : + (boost (0 : Fin d.succ) β hβ).1 (Sum.inr i.succ) (Sum.inl 0) = 0 := by + rw [boost_inr_other_inl_0] + simp + +@[simp] +lemma boost_zero_inl_0_inr_nat_succ {d : ℕ} {β : ℝ} (hβ : |β| < 1) (i : ℕ) (h : i + 1 < d + 1) : + (boost (0 : Fin d.succ) β hβ).1 (Sum.inl 0) (Sum.inr ⟨i + 1, h⟩) = 0 := by + rw [boost_inl_0_inr_other] + simp + +@[simp] +lemma boost_zero_inr_nat_succ_inl_0 {d : ℕ} {β : ℝ} (hβ : |β| < 1) (i : ℕ) (h : i + 1 < d + 1) : + (boost (0 : Fin d.succ) β hβ).1 (Sum.inr ⟨i + 1, h⟩) (Sum.inl 0) = 0 := by + rw [boost_inr_other_inl_0] + simp + +@[simp] +lemma boost_zero_inr_0_inr_succ {d : ℕ} {β : ℝ} (hβ : |β| < 1) (i : Fin d) : + (boost (0 : Fin d.succ) β hβ).1 (Sum.inr 0) (Sum.inr i.succ) = 0 := by + rw [boost_inr_self_inr_other] + simp + +@[simp] +lemma boost_zero_inr_succ_inr_0 {d : ℕ} {β : ℝ} (hβ : |β| < 1) (i : Fin d) : + (boost (0 : Fin d.succ) β hβ).1 (Sum.inr i.succ) (Sum.inr 0) = 0 := by + rw [boost_inr_other_inr_self] + simp + +@[simp] +lemma boost_zero_inr_0_inr_nat_succ {d : ℕ} {β : ℝ} (hβ : |β| < 1) (i : ℕ) (h : i + 1 < d + 1) : + (boost (0 : Fin d.succ) β hβ).1 (Sum.inr 0) (Sum.inr ⟨i + 1, h⟩) = 0 := by + rw [boost_inr_self_inr_other] + simp + +@[simp] +lemma boost_zero_inr_nat_succ_inr_0 {d : ℕ} {β : ℝ} (hβ : |β| < 1) (i : ℕ) (h : i + 1 < d + 1) : + (boost (0 : Fin d.succ) β hβ).1 (Sum.inr ⟨i + 1, h⟩) (Sum.inr 0) = 0 := by + rw [boost_inr_other_inr_self] + simp + +lemma boost_zero_inr_succ_inr_succ {d : ℕ} {β : ℝ} (hβ : |β| < 1) (i1 i2 : Fin d) : + (boost (0 : Fin d.succ) β hβ).1 (Sum.inr i1.succ) (Sum.inr i2.succ) = + if i1 = i2 then 1 else 0 := by + rw [boost_inr_inr_other] + simp only [Nat.succ_eq_add_one, Fin.succ_inj] + congr 1 + exact Eq.propIntro (fun a => id (Eq.symm a)) fun a => id (Eq.symm a) + simp end LorentzGroup diff --git a/PhysLean/Relativity/LorentzGroup/Boosts/Generalized.lean b/PhysLean/Relativity/LorentzGroup/Boosts/Generalized.lean index 518df339d..193ce93b3 100644 --- a/PhysLean/Relativity/LorentzGroup/Boosts/Generalized.lean +++ b/PhysLean/Relativity/LorentzGroup/Boosts/Generalized.lean @@ -56,7 +56,7 @@ def genBoostAux₂ (u v : Velocity d) : Vector d →ₗ[ℝ] Vector d where map_add' x y := by rw [← _root_.add_smul] apply congrFun (congrArg _ _) - have hx := Velocity.one_add_minkowskiProduct_neq_zero u v + have hx := Velocity.one_add_minkowskiProduct_ne_zero u v field_simp [add_tmul] simp only [map_add, ContinuousLinearMap.add_apply, neg_add_rev] ring @@ -120,7 +120,7 @@ lemma genBoostAux₂_basis_minkowskiProduct (u v : Velocity d) (μ ν : Fin 1 dsimp rw [h1] have h2 : (1 + ⟪u.1, v.1⟫ₘ) ≠ 0 := by - exact Velocity.one_add_minkowskiProduct_neq_zero u v + exact Velocity.one_add_minkowskiProduct_ne_zero u v field_simp [h2] lemma genBoostAux₁_basis_genBoostAux₂_minkowskiProduct (u v : Velocity d) (μ ν : Fin 1 ⊕ Fin d) : @@ -135,7 +135,7 @@ lemma genBoostAux₁_basis_genBoostAux₂_minkowskiProduct (u v : Velocity d) ( dsimp rw [h1] have h2 : (1 + ⟪u.1, v.1⟫ₘ) ≠ 0 := by - exact Velocity.one_add_minkowskiProduct_neq_zero u v + exact Velocity.one_add_minkowskiProduct_ne_zero u v field_simp [h2] lemma genBoostAux₂_toMatrix_apply (u v : Velocity d) (μ ν : Fin 1 ⊕ Fin d) : @@ -144,7 +144,7 @@ lemma genBoostAux₂_toMatrix_apply (u v : Velocity d) (μ ν : Fin 1 ⊕ Fin d) / (1 + ⟪u.1, v.1⟫ₘ)) := by rw [LinearMap.toMatrix_apply, basis_repr_apply] simp only [genBoostAux₂, LinearMap.coe_mk, AddHom.coe_mk, minkowskiProduct_basis_left] - have h1 := Velocity.one_add_minkowskiProduct_neq_zero u v + have h1 := Velocity.one_add_minkowskiProduct_ne_zero u v simp only [apply_add, apply_smul, neg_mul, neg_add_rev] field_simp ring @@ -175,7 +175,7 @@ lemma basis_minkowskiProduct_genBoostAux₁_add_genBoostAux₂ (u v : Velocity d rw [map_smul, map_smul] simp have h2 : (1 + ⟪u.1, v.1⟫ₘ) ≠ 0 := by - exact Velocity.one_add_minkowskiProduct_neq_zero u v + exact Velocity.one_add_minkowskiProduct_ne_zero u v field_simp ring @@ -243,7 +243,7 @@ lemma generalizedBoost_apply_mul_one_plus_contr (u v : Velocity d) (x : Vector d simp only [LinearMap.coe_mk, AddHom.coe_mk] rw [smul_smul] congr - have h1 := Velocity.one_add_minkowskiProduct_neq_zero u v + have h1 := Velocity.one_add_minkowskiProduct_ne_zero u v field_simp · rw [_root_.neg_smul] rfl @@ -251,20 +251,20 @@ lemma generalizedBoost_apply_mul_one_plus_contr (u v : Velocity d) (x : Vector d lemma generalizedBoost_apply_expand (u v : Velocity d) (x : Vector d) : generalizedBoost u v • x = x + (2 * ⟪x, u⟫ₘ) • v.1 - (⟪x, u + v⟫ₘ / (1 + ⟪u, v.1⟫ₘ)) • (u.1 + v.1) := by - apply (smul_right_inj (Velocity.one_add_minkowskiProduct_neq_zero u v)).mp + apply (smul_right_inj (Velocity.one_add_minkowskiProduct_ne_zero u v)).mp rw [generalizedBoost_apply_mul_one_plus_contr] conv_rhs => rw [_root_.smul_sub, _root_.smul_add, smul_smul, smul_smul] congr 1 · ring_nf · congr - have := (Velocity.one_add_minkowskiProduct_neq_zero u v) + have := (Velocity.one_add_minkowskiProduct_ne_zero u v) field_simp @[simp] lemma generalizedBoost_apply_fst (u v : Velocity d) : generalizedBoost u v • u.1 = v.1 := by - apply (smul_right_inj (Velocity.one_add_minkowskiProduct_neq_zero u v)).mp + apply (smul_right_inj (Velocity.one_add_minkowskiProduct_ne_zero u v)).mp rw [generalizedBoost_apply_mul_one_plus_contr] simp only [Velocity.minkowskiProduct_self_eq_one, mul_one, map_add] simp only [_root_.smul_add, add_sub_add_left_eq_sub] @@ -275,7 +275,7 @@ lemma generalizedBoost_apply_fst (u v : Velocity d) : @[simp] lemma generalizedBoost_apply_snd (u v : Velocity d) : generalizedBoost u v • v.1 = (2 * ⟪u, v.1⟫ₘ) • ↑v - ↑u:= by - apply (smul_right_inj (Velocity.one_add_minkowskiProduct_neq_zero u v)).mp + apply (smul_right_inj (Velocity.one_add_minkowskiProduct_ne_zero u v)).mp rw [generalizedBoost_apply_mul_one_plus_contr] simp only [map_add, Velocity.minkowskiProduct_self_eq_one, _root_.smul_add] repeat rw [minkowskiProduct_symm v.1 u.1] @@ -354,7 +354,7 @@ lemma generalizedBoost_continuous_snd (u : Velocity d) : Continuous (generalized refine Continuous.sub (by fun_prop) (?_) refine .mul (by fun_prop) ?_ · refine .inv₀ (by fun_prop) ?_ - exact fun x => Velocity.one_add_minkowskiProduct_neq_zero u x + exact fun x => Velocity.one_add_minkowskiProduct_ne_zero u x refine Continuous.subtype_mk this _ @[fun_prop] @@ -367,7 +367,7 @@ lemma generalizedBoost_continuous_fst (u : Velocity d) : Continuous (generalized refine Continuous.sub (by fun_prop) (?_) refine .mul (by fun_prop) ?_ · refine .inv₀ (by fun_prop) ?_ - exact fun x => Velocity.one_add_minkowskiProduct_neq_zero _ _ + exact fun x => Velocity.one_add_minkowskiProduct_ne_zero _ _ refine Continuous.subtype_mk this _ lemma id_joined_generalizedBoost (u v : Velocity d) : Joined 1 (generalizedBoost u v) := by @@ -401,8 +401,8 @@ lemma generalizedBoost_inv (u v : Velocity d) : rw [← mul_eq_one_iff_inv_eq'] apply LorentzGroup.eq_of_action_vector_eq intro p - apply (smul_right_inj (Velocity.one_add_minkowskiProduct_neq_zero v u)).mp - rw [MulAction.mul_smul] + apply (smul_right_inj (Velocity.one_add_minkowskiProduct_ne_zero v u)).mp + rw [SemigroupAction.mul_smul] rw [generalizedBoost_apply_mul_one_plus_contr] conv_lhs => enter [1, 1] @@ -428,7 +428,7 @@ lemma generalizedBoost_inv (u v : Velocity d) : rw [_root_.smul_add] abel trans (1 + ⟪u.1, v.1⟫ₘ) • p + ((0 : ℝ) • v.1 + (0 : ℝ) • u.1) - · have h1 := Velocity.one_add_minkowskiProduct_neq_zero u v + · have h1 := Velocity.one_add_minkowskiProduct_ne_zero u v congr 1 congr 1 · congr 1 @@ -451,25 +451,27 @@ lemma generalizedBoost_inv (u v : Velocity d) : · simp simp [minkowskiProduct_symm] -/-- -The time component of a generalised boost is equal to -``` -1 + - ‖u.1.timeComponent • v.1.spatialPart - v.1.timeComponent • u.1.spatialPart‖ / (1 + ⟪u.1, v.1⟫ₘ) -``` +/-- The time component of a generalised boost. A proof of this result can be found at the below link: https://leanprover.zulipchat.com/#narrow/channel/479953-PhysLean/topic/Lorentz.20group/near/523249684 - -Note that the declaration of this semiformal result will be similar once -the TODO item `FXQ45` is completed. -/ -@[sorryful] lemma generalizedBoost_timeComponent_eq (u v : Velocity d) : (generalizedBoost u v).1 (Sum.inl 0) (Sum.inl 0) = 1 + ‖u.1.timeComponent • v.1.spatialPart - - v.1.timeComponent • u.1.spatialPart‖ / (1 + ⟪u.1, v.1⟫ₘ) := by - sorry + v.1.timeComponent • u.1.spatialPart‖ ^ 2 / (1 + ⟪u.1, v.1⟫ₘ) := by + rw [generalizedBoost_apply_eq_toCoord] + simp only [Matrix.one_apply_eq, inl_0_inl_0, one_mul] + have h := Velocity.one_add_minkowskiProduct_ne_zero u v + rw [norm_sub_sq_real, norm_smul, norm_smul, Real.norm_eq_abs, Real.norm_eq_abs, + Velocity.timeComponent_abs u, Velocity.timeComponent_abs v, + real_inner_smul_left, real_inner_smul_right] + simp only [timeComponent, minkowskiProduct_eq_timeComponent_spatialPart] at * + field_simp [h] + nlinarith [mul_pow (u.1 (Sum.inl 0)) (‖v.1.spatialPart‖) 2, + mul_pow (v.1 (Sum.inl 0)) (‖u.1.spatialPart‖) 2, + Velocity.norm_spatialPart_sq_eq u, Velocity.norm_spatialPart_sq_eq v, + real_inner_comm (u.1.spatialPart) (v.1.spatialPart)] end LorentzGroup diff --git a/PhysLean/Relativity/LorentzGroup/Restricted/Basic.lean b/PhysLean/Relativity/LorentzGroup/Restricted/Basic.lean index 34af2a622..c068108f5 100644 --- a/PhysLean/Relativity/LorentzGroup/Restricted/Basic.lean +++ b/PhysLean/Relativity/LorentzGroup/Restricted/Basic.lean @@ -13,7 +13,7 @@ This file is currently a stub. -/ TODO "6VZNP" "Prove that every member of the restricted Lorentz group is - combiniation of a boost and a rotation." + combination of a boost and a rotation." namespace LorentzGroup diff --git a/PhysLean/Relativity/LorentzGroup/Restricted/FromBoostRotation.lean b/PhysLean/Relativity/LorentzGroup/Restricted/FromBoostRotation.lean index a2078d6c6..63d2e0ee0 100644 --- a/PhysLean/Relativity/LorentzGroup/Restricted/FromBoostRotation.lean +++ b/PhysLean/Relativity/LorentzGroup/Restricted/FromBoostRotation.lean @@ -69,7 +69,7 @@ def toBoostRotation {d} : LorentzGroup.restricted d ≃ₜ Lorentz.Velocity d × · exact rotations_subset_restricted d (ofSpecialOrthogonal p.2).2 · refine ⟨generalizedBoost_isProper 0 p.1, generalizedBoost_isOrthochronous 0 p.1⟩⟩ left_inv Λ := by - apply Subtype.eq + apply Subtype.ext simp only [toRotation, MulEquiv.apply_symm_apply] rw [mul_inv_cancel_left] right_inv p := by @@ -86,12 +86,12 @@ def toBoostRotation {d} : LorentzGroup.restricted d ≃ₜ Lorentz.Velocity d × rw [toRotation] apply ofSpecialOrthogonal.injective rw [MulEquiv.apply_symm_apply] - apply Subtype.eq + apply Subtype.ext simp only trans (generalizedBoost 0 ⟨v, hv⟩)⁻¹ * ((generalizedBoost 0 ⟨v, hv⟩) * (ofSpecialOrthogonal R).1) · congr - apply Subtype.eq + apply Subtype.ext simp [toVelocity, h0] group continuous_toFun := by fun_prop diff --git a/PhysLean/Relativity/LorentzGroup/Rotations.lean b/PhysLean/Relativity/LorentzGroup/Rotations.lean index cea5372b0..a180ad4b6 100644 --- a/PhysLean/Relativity/LorentzGroup/Rotations.lean +++ b/PhysLean/Relativity/LorentzGroup/Rotations.lean @@ -117,9 +117,9 @@ def ofSpecialOrthogonal {d} : simp · exact h.2⟩ map_mul' A B := by - apply Subtype.eq + apply Subtype.ext simp only [Submonoid.coe_mul, MulMemClass.mk_mul_mk] - apply Subtype.eq + apply Subtype.ext simp [Matrix.fromBlocks_multiply] left_inv Λ := by simp @@ -151,7 +151,7 @@ def ofSpecialOrthogonal {d} : rw [← h1] simp | .inr i, .inr j => rfl - apply Subtype.eq + apply Subtype.ext simp only exact eq_of_mulVec_eq (congrFun (congrArg Matrix.mulVec h1)) diff --git a/PhysLean/Relativity/LorentzGroup/ToVector.lean b/PhysLean/Relativity/LorentzGroup/ToVector.lean index aa16de511..623746902 100644 --- a/PhysLean/Relativity/LorentzGroup/ToVector.lean +++ b/PhysLean/Relativity/LorentzGroup/ToVector.lean @@ -44,7 +44,7 @@ lemma toVector_continuous {d : ℕ} : Continuous (toVector (d := d)) := by conv => enter [1, Λ] rw [toVector_eq_fun] - refine continuous_pi ?_ + refine Vector.continuous_of_apply _ ?_ intro i refine Continuous.matrix_elem ?_ i (Sum.inl 0) fun_prop @@ -81,6 +81,8 @@ lemma toVector_eq_basis_iff_timeComponent_eq_one {d : ℕ} (Λ : LorentzGroup d) simp only [Fin.isValue, reduceCtorEq, ↓reduceIte] trans (toVector Λ).spatialPart j · simp + simp only [toVector_apply, Fin.isValue] + change (fun i => Λ.1 (Sum.inr i) (Sum.inl 0)) j = _ rw [h1] simp diff --git a/PhysLean/Relativity/MinkowskiMatrix.lean b/PhysLean/Relativity/MinkowskiMatrix.lean index 2f6cbee65..0af4324d8 100644 --- a/PhysLean/Relativity/MinkowskiMatrix.lean +++ b/PhysLean/Relativity/MinkowskiMatrix.lean @@ -78,16 +78,14 @@ We show some basic equalities for the Minkowski matrix. In particular, we show it can be expressed as a block matrix. -/ +/-- The Minkowski matrix as a diagonal matrix. -/ +lemma as_diagonal : @minkowskiMatrix d = diagonal (Sum.elim 1 (-1)) := by + simp [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal] /-- The Minkowski matrix as a block matrix. -/ -lemma as_block : @minkowskiMatrix d = +lemma as_block : minkowskiMatrix = Matrix.fromBlocks (1 : Matrix (Fin 1) (Fin 1) ℝ) 0 0 (-1 : Matrix (Fin d) (Fin d) ℝ) := by - rw [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, ← fromBlocks_diagonal] - refine fromBlocks_inj.mpr ?_ - simp only [diagonal_one, true_and] - funext i j - rw [← diagonal_neg] - rfl + simp [as_diagonal, ← fromBlocks_diagonal, ← diagonal_one] /-! @@ -117,20 +115,15 @@ lemma inl_0_inl_0 : @minkowskiMatrix d (Sum.inl 0) (Sum.inl 0) = 1 := by /-- The space diagonal components of the Minkowski matrix are `-1`. -/ @[simp] lemma inr_i_inr_i (i : Fin d) : @minkowskiMatrix d (Sum.inr i) (Sum.inr i) = -1 := by - simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal] - simp_all only [diagonal_apply_eq, Sum.elim_inr] + simp [as_diagonal] /-- The off diagonal elements of the Minkowski matrix are zero. -/ @[simp] lemma off_diag_zero {μ ν : Fin 1 ⊕ Fin d} (h : μ ≠ ν) : η μ ν = 0 := by - simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal] - exact diagonal_apply_ne _ h + aesop (add safe forward as_diagonal) -lemma η_diag_ne_zero {μ : Fin 1 ⊕ Fin d} : - η μ μ ≠ 0 := by - match μ with - | Sum.inl 0 => simp - | Sum.inr _ => simp +lemma η_diag_ne_zero {μ : Fin 1 ⊕ Fin d} : η μ μ ≠ 0 := by + aesop (add safe forward as_diagonal) /-! @@ -144,37 +137,16 @@ as well as other properties related to squaring the Minkowski matrix. /-- The Minkowski matrix is self-inverting. -/ @[simp] lemma sq : @minkowskiMatrix d * minkowskiMatrix = 1 := by - simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, diagonal_mul_diagonal] - ext1 i j - rcases i with i | i <;> rcases j with j | j - · simp only [diagonal, of_apply, Sum.inl.injEq, Sum.elim_inl, mul_one] - split - · rename_i h - subst h - simp_all only [one_apply_eq] - · simp_all only [ne_eq, Sum.inl.injEq, not_false_eq_true, one_apply_ne] - · rfl - · rfl - · simp only [diagonal, of_apply, Sum.inr.injEq, Sum.elim_inr, mul_neg, mul_one, neg_neg] - split - · rename_i h - subst h - simp_all only [one_apply_eq] - · simp_all only [ne_eq, Sum.inr.injEq, not_false_eq_true, one_apply_ne] + simp [as_block, fromBlocks_multiply] /-- Multiplying any element on the diagonal of the Minkowski matrix by itself gives `1`. -/ @[simp] lemma η_apply_mul_η_apply_diag (μ : Fin 1 ⊕ Fin d) : η μ μ * η μ μ = 1 := by - match μ with - | Sum.inl 0 => simp - | Sum.inr _ => simp + aesop (add safe forward as_diagonal) @[simp] -lemma η_apply_sq_eq_one (μ : Fin 1 ⊕ Fin d) : - η μ μ ^ 2 = 1 := by - trans η μ μ * η μ μ - · exact pow_two (η μ μ) - simp +lemma η_apply_sq_eq_one (μ : Fin 1 ⊕ Fin d) : η μ μ ^ 2 = 1 := by + cases μ <;> simp [as_diagonal] /-! @@ -187,7 +159,7 @@ The Minkowski matrix is symmetric, due to it being diagonal. /-- The Minkowski matrix is symmetric. -/ @[simp] lemma eq_transpose : minkowskiMatrixᵀ = @minkowskiMatrix d := by - simp only [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, diagonal_transpose] + simp [as_diagonal] /-! @@ -202,7 +174,7 @@ We show the determinant of the Minkowski matrix is equal to `(-1)^d` where of the number of spatial dimensions. -/ @[simp] lemma det_eq_neg_one_pow_d : (@minkowskiMatrix d).det = (- 1) ^ d := by - simp [minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal] + simp [as_diagonal] /-! @@ -215,9 +187,8 @@ This is a useful part of the API but is not used often. -/ lemma mul_η_diag_eq_iff {μ : Fin 1 ⊕ Fin d} {x y : ℝ} : - η μ μ * x = η μ μ * y ↔ x = y := by - refine mul_right_inj' ?_ - exact η_diag_ne_zero + η μ μ * x = η μ μ * y ↔ x = y := + mul_right_inj' η_diag_ne_zero /-! @@ -231,15 +202,13 @@ We show properties of the action of the Minkowski matrix on vectors. @[simp] lemma mulVec_inl_0 (v : (Fin 1 ⊕ Fin d) → ℝ) : (η *ᵥ v) (Sum.inl 0) = v (Sum.inl 0) := by - simp only [mulVec, minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal] - simp only [Fin.isValue, diagonal_dotProduct, Sum.elim_inl, one_mul] + simp [as_diagonal, mulVec_diagonal] /-- The space components of a vector acted on by the Minkowski matrix swaps sign. -/ @[simp] lemma mulVec_inr_i (v : (Fin 1 ⊕ Fin d) → ℝ) (i : Fin d) : (η *ᵥ v) (Sum.inr i) = - v (Sum.inr i) := by - simp only [mulVec, minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal] - simp only [diagonal_dotProduct, Sum.elim_inr, neg_mul, one_mul] + simp [as_diagonal, mulVec_diagonal] /-! @@ -287,10 +256,8 @@ We show that the dual swaps multiplication, i.e. `dual (Λ * Λ') = dual Λ' * d /-- The Minkowski dual swaps multiplications (acts contravariantly). -/ @[simp] lemma dual_mul : dual (Λ * Λ') = dual Λ' * dual Λ := by - simp only [dual, transpose_mul] - trans η * Λ'ᵀ * (η * η) * Λᵀ * η - · noncomm_ring [minkowskiMatrix.sq] - · noncomm_ring + simp only [dual, transpose_mul, ← mul_assoc] + noncomm_ring [minkowskiMatrix.sq] /-! @@ -303,10 +270,8 @@ We show that the dual is an involution, i.e. `dual (dual Λ) = Λ`. @[simp] lemma dual_dual : Function.Involutive (@dual d) := by intro Λ - simp only [dual, transpose_mul, transpose_transpose, eq_transpose] - trans (η * η) * Λ * (η * η) - · noncomm_ring - · noncomm_ring [minkowskiMatrix.sq] + simp only [dual, transpose_mul, eq_transpose, transpose_transpose, ← mul_assoc] + noncomm_ring [minkowskiMatrix.sq] /-! @@ -317,8 +282,7 @@ lemma dual_dual : Function.Involutive (@dual d) := by /-- The Minkowski dual commutes with the transpose. -/ @[simp] lemma dual_transpose : dual Λᵀ = (dual Λ)ᵀ := by - simp only [dual, transpose_transpose, transpose_mul, eq_transpose] - noncomm_ring + simp [dual, mul_assoc] /-! @@ -329,8 +293,7 @@ lemma dual_transpose : dual Λᵀ = (dual Λ)ᵀ := by /-- The Minkowski dual preserves the Minkowski matrix. -/ @[simp] lemma dual_eta : @dual d η = η := by - simp only [dual, eq_transpose] - noncomm_ring [minkowskiMatrix.sq] + simp [dual] /-! @@ -358,14 +321,12 @@ We show a number of properties related to the components of the duals. of the original matrix. -/ lemma dual_apply (μ ν : Fin 1 ⊕ Fin d) : dual Λ μ ν = η μ μ * Λ ν μ * η ν ν := by - simp only [dual, minkowskiMatrix, LieAlgebra.Orthogonal.indefiniteDiagonal, mul_diagonal, - diagonal_mul, transpose_apply, diagonal_apply_eq] + simp [dual, as_diagonal] /-- The components of the Minkowski dual of a matrix multiplied by the Minkowski matrix in terms of the original matrix. -/ lemma dual_apply_minkowskiMatrix (μ ν : Fin 1 ⊕ Fin d) : dual Λ μ ν * η ν ν = η μ μ * Λ ν μ := by - rw [dual_apply, mul_assoc] - simp + simp [dual_apply, mul_assoc] end minkowskiMatrix diff --git a/PhysLean/Relativity/SL2C/Basic.lean b/PhysLean/Relativity/SL2C/Basic.lean index 19609e175..9d5133c64 100644 --- a/PhysLean/Relativity/SL2C/Basic.lean +++ b/PhysLean/Relativity/SL2C/Basic.lean @@ -308,12 +308,10 @@ lemma toLorentzGroup_det_one (M : SL(2, ℂ)) : det (toLorentzGroup M).val = 1 : _ = 1 := M.property /-- The homomorphism from `SL(2, ℂ)` to the restricted Lorentz group. -/ -informal_lemma toRestrictedLorentzGroup where - deps := [``toLorentzGroup, ``toLorentzGroup_det_one, ``toLorentzGroup_isOrthochronous, - ``LorentzGroup.restricted] - tag := "6VZP6" - -TODO "6VZQF" "Define homomorphism from `SL(2, ℂ)` to the restricted Lorentz group." +@[simps!] +def toRestrictedLorentzGroup : SL(2, ℂ) →* LorentzGroup.restricted 3 := + toLorentzGroup.codRestrict (LorentzGroup.restricted 3) + (fun M => And.intro (toLorentzGroup_det_one M) (toLorentzGroup_isOrthochronous M)) end end SL2C diff --git a/PhysLean/Relativity/SL2C/SelfAdjoint.lean b/PhysLean/Relativity/SL2C/SelfAdjoint.lean index 415d94459..398d0e6fd 100644 --- a/PhysLean/Relativity/SL2C/SelfAdjoint.lean +++ b/PhysLean/Relativity/SL2C/SelfAdjoint.lean @@ -3,7 +3,6 @@ Copyright (c) 2025 Gordon Hsu. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Gordon Hsu -/ -import Mathlib.LinearAlgebra.Matrix.SchurComplement import PhysLean.Mathematics.SchurTriangulation import Mathlib.LinearAlgebra.Matrix.Hermitian /-! # Extra lemmas regarding `Lorentz.SL2C.toSelfAdjointMap` diff --git a/PhysLean/Relativity/SpeedOfLight.lean b/PhysLean/Relativity/SpeedOfLight.lean new file mode 100644 index 000000000..10f8ecd6d --- /dev/null +++ b/PhysLean/Relativity/SpeedOfLight.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +import Mathlib.Algebra.Lie.Classical +import Mathlib.Analysis.Normed.Ring.Lemmas +/-! + +# The Speed of Light + +## i. Overview + +In this module we define a type for the speed of light in a vacuum, +along with some basic properties. An element of this type is a positive real number, +and should be thought of as the speed of light in some chosen but arbitrary system of units. + +## ii. Key results + +- `SpeedOfLight` : The type of speeds of light in a vacuum. + +## iii. Table of contents + +- A. The Speed of Light type +- B. Instances on the type +- C. The instance of one +- D. Positivity properties + +## iv. References + +-/ +open Matrix + +/-! + +## A. The Speed of Light type + +-/ + +/-- The speed of light in a vacuum. An element of this type should be thought of as + the speed of light in some chosen but arbitrary system of units. -/ +structure SpeedOfLight where + /-- The underlying value of the speed of light. -/ + val : ℝ + pos : 0 < val + +namespace SpeedOfLight + +/-! + +## B. Instances on the type + +-/ + +instance : Coe SpeedOfLight ℝ := ⟨SpeedOfLight.val⟩ + +/-! + +## C. The instance of one + +We define the instance of one for `SpeedOfLight` to be the speed of light equal to `1`. +This is useful when we are working in units where the speed of light is equal to one. + +-/ + +instance : One SpeedOfLight := ⟨1, by grind⟩ + +@[simp] +lemma val_one : (1 : SpeedOfLight).val = 1 := rfl + +/-! + +## D. Positivity properties + +-/ + +@[simp] +lemma val_pos (c : SpeedOfLight) : 0 < (c : ℝ) := c.pos + +@[simp] +lemma val_nonneg (c : SpeedOfLight) : 0 ≤ (c : ℝ) := le_of_lt c.pos + +@[simp] +lemma val_ne_zero (c : SpeedOfLight) : (c : ℝ) ≠ 0 := ne_of_gt c.pos + +end SpeedOfLight diff --git a/PhysLean/Relativity/Tensors/Basic.lean b/PhysLean/Relativity/Tensors/Basic.lean index 23471ddf5..f491b47c9 100644 --- a/PhysLean/Relativity/Tensors/Basic.lean +++ b/PhysLean/Relativity/Tensors/Basic.lean @@ -4,10 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Relativity.Tensors.TensorSpecies.Basic -import Mathlib.GroupTheory.GroupAction.Ring +import Mathlib.Topology.Algebra.Module.ModuleTopology +import Mathlib.Analysis.RCLike.Basic /-! -# Products of tensors. +# Tensors -/ @@ -409,6 +410,18 @@ lemma finrank_tensor_eq {n : ℕ} [StrongRankCondition k] (c : Fin n → C) : rw [Module.finrank_pi] simp +instance {k : Type} [Field k] {C G : Type} [Group G] (S : TensorSpecies k C G) + {c : Fin n → C} : FiniteDimensional k (S.Tensor c) := + Module.Basis.finiteDimensional_of_finite (Tensor.basis c) + +instance {k : Type} [RCLike k] {C G : Type} [Group G] (S : TensorSpecies k C G) + {c : Fin n → C} : TopologicalSpace (S.Tensor c) := + moduleTopology k (S.Tensor c) + +instance {k : Type} [RCLike k] {C G : Type} [Group G] (S : TensorSpecies k C G) + {c : Fin n → C} : IsTopologicalAddGroup (S.Tensor c) := + IsModuleTopology.topologicalAddGroup (R := k) (S.Tensor c) + /-! ## The action @@ -552,9 +565,7 @@ lemma PermCond.preserve_color {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} simp only [Function.comp_apply] rw [h.2] -TODO "7ESNL" "We want to add `inv_perserve_color` to Simp database, however this fires the linter - simpVarHead. This should be investigated." - +@[simp, nolint simpVarHead] lemma PermCond.inv_perserve_color {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} {σ : Fin m → Fin n} (h : PermCond c c1 σ) (x : Fin n) : c1 (h.inv σ x) = c x := by @@ -564,6 +575,19 @@ lemma PermCond.inv_perserve_color {n m : ℕ} {c : Fin n → C} {c1 : Fin m → rw [h.preserve_color] rfl +lemma PermCond.symm {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} + {σ : Fin m → Fin n} (h : PermCond c c1 σ) : + PermCond c1 c (h.inv σ) := by + apply And.intro + · refine Function.bijective_iff_has_inverse.mpr ?_ + use σ + apply And.intro + · intro x + simp [inv_apply_apply] + · intro x + simp [apply_inv_apply] + · intro x + rw [h.inv_perserve_color] /-- For a map `σ : Fin m → Fin n` satisfying `PermCond c c1 σ`, that map lifted to a morphism in the `OverColor C` category. -/ def PermCond.toHom {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} @@ -767,6 +791,23 @@ lemma permT_basis_repr_symm_apply {n m : ℕ} {c : Fin n → C} {c1 : Fin m → · intro t1 t2 h1 h2 simp [h1, h2] +lemma permT_eq_zero_iff {n m : ℕ} {c : Fin n → C} {c1 : Fin m → C} + {σ : Fin m → Fin n} (h : PermCond c c1 σ) (t : S.Tensor c) : + permT σ h t = 0 ↔ t = 0 := by + apply Iff.intro + · intro h' + trans permT (h.inv σ) (PermCond.symm h) ((permT σ h) t) + · rw [permT_permT] + rw [permT_congr_eq_id'] + · funext x + simp [PermCond.inv_apply_apply] + · rfl + · rw [h'] + simp + · intro hzero + rw [hzero] + simp + /-! ## field -/ diff --git a/PhysLean/Relativity/Tensors/Color/Basic.lean b/PhysLean/Relativity/Tensors/Color/Basic.lean index 5fe148ba1..37bee803d 100644 --- a/PhysLean/Relativity/Tensors/Color/Basic.lean +++ b/PhysLean/Relativity/Tensors/Color/Basic.lean @@ -470,13 +470,10 @@ lemma equivToIso_mkIso_inv {c1 c2 : X → C} (h : c1 = c2) : Hom.toEquiv (mkIso h).inv = Equiv.refl _ := by rfl -TODO "6VZTR" "In the definition equivToHomEq the tactic `try {simp; decide}; try decide` - can probably be made more efficient." - /-- The morphism from `mk c` to `mk c1` obtained by an equivalence and an equality lemma. -/ def equivToHomEq {c : X → C} {c1 : Y → C} (e : X ≃ Y) - (h : ∀ x, c1 x = (c ∘ e.symm) x := by try {simp; decide}; try decide) : mk c ⟶ mk c1 := + (h : ∀ x, c1 x = (c ∘ e.symm) x := by simp; decide) : mk c ⟶ mk c1 := (equivToHom e) ≫ (mkIso (funext fun x => (h x).symm)).hom @[simp] diff --git a/PhysLean/Relativity/Tensors/Color/Lift.lean b/PhysLean/Relativity/Tensors/Color/Lift.lean index 381efd829..26a2f568f 100644 --- a/PhysLean/Relativity/Tensors/Color/Lift.lean +++ b/PhysLean/Relativity/Tensors/Color/Lift.lean @@ -716,13 +716,13 @@ open lift `BraidedFunctor (OverColor C) (Rep k G)`, built on the PiTensorProduct. -/ noncomputable def lift : (Discrete C ⥤ Rep k G) ⥤ LaxBraidedFunctor (OverColor C) (Rep k G) where obj F := LaxBraidedFunctor.of (lift.toRepFunc F) - map η := LaxMonoidalFunctor.homMk (repNatTransOfColor η) + map η := LaxBraidedFunctor.homMk (repNatTransOfColor η) map_id F := by simp only [repNatTransOfColor] - refine LaxMonoidalFunctor.hom_ext ?_ + refine LaxBraidedFunctor.hom_ext ?_ ext X : 2 simp only [LaxBraidedFunctor.toLaxMonoidalFunctor_toFunctor, LaxBraidedFunctor.of_toFunctor, - LaxMonoidalFunctor.homMk_hom, LaxBraidedFunctor.id_hom, NatTrans.id_app] + LaxBraidedFunctor.homMk_hom_hom, LaxBraidedFunctor.id_hom, NatTrans.id_app] ext x refine PiTensorProduct.induction_on' x ?_ (by intro x y hx hy @@ -734,10 +734,11 @@ noncomputable def lift : (Discrete C ⥤ Rep k G) ⥤ LaxBraidedFunctor (OverCol rw [repNatTransOfColorApp_tprod] rfl map_comp {F G H} η θ := by - refine LaxMonoidalFunctor.hom_ext ?_ + refine LaxBraidedFunctor.hom_ext ?_ ext X : 2 simp only [LaxBraidedFunctor.toLaxMonoidalFunctor_toFunctor, LaxBraidedFunctor.of_toFunctor, - LaxMonoidalFunctor.homMk_hom, LaxBraidedFunctor.comp_hom, NatTrans.comp_app] + LaxBraidedFunctor.homMk_hom_hom, LaxBraidedFunctor.comp_hom, LaxMonoidalFunctor.comp_hom, + NatTrans.comp_app] ext x refine PiTensorProduct.induction_on' x ?_ (by intro x y hx hy @@ -828,7 +829,7 @@ noncomputable section built on the inclusion `incl` and forgetting the monoidal structure. -/ def forget : LaxBraidedFunctor (OverColor C) (Rep k G) ⥤ (Discrete C ⥤ Rep k G) where obj F := Discrete.functor fun c => F.obj (incl.obj (Discrete.mk c)) - map η := Discrete.natTrans fun c => η.hom.app (incl.obj c) + map η := Discrete.natTrans fun c => η.hom.hom.app (incl.obj c) variable (F F' : Discrete C ⥤ Rep k G) (η : F ⟶ F') @@ -847,6 +848,11 @@ def forgetLiftAppV (c : C) : ((lift.obj F).obj (OverColor.mk (fun (_ : Fin 1) => @[simp] lemma forgetLiftAppV_symm_apply (c : C) (x : (F.obj (Discrete.mk c)).V) : (forgetLiftAppV F c).symm x = PiTensorProduct.tprod k (fun _ => x) := by + simp [forgetLiftAppV] + erw [PiTensorProduct.subsingletonEquiv_symm_apply] + congr + funext i + fin_cases i rfl /-- The `forgetLiftAppV` function takes an object `c` of type `C` and returns a isomorphism diff --git a/PhysLean/Relativity/Tensors/ComplexTensor/Metrics/Basic.lean b/PhysLean/Relativity/Tensors/ComplexTensor/Metrics/Basic.lean index 4ba428f32..0b1161b51 100644 --- a/PhysLean/Relativity/Tensors/ComplexTensor/Metrics/Basic.lean +++ b/PhysLean/Relativity/Tensors/ComplexTensor/Metrics/Basic.lean @@ -109,27 +109,33 @@ lemma altRightMetric_eq_fromConstPair : εR' = fromConstPair Fermion.altRightMet lemma coMetric_eq_fromPairT : η' = fromPairT (Lorentz.coMetricVal) := by rw [coMetric_eq_fromConstPair, fromConstPair] - erw [Lorentz.coMetric_apply_one] + congr 1 + exact Lorentz.coMetric_apply_one lemma contrMetric_eq_fromPairT : η = fromPairT (Lorentz.contrMetricVal) := by rw [contrMetric_eq_fromConstPair, fromConstPair] - erw [Lorentz.contrMetric_apply_one] + congr 1 + exact Lorentz.contrMetric_apply_one lemma leftMetric_eq_fromPairT : εL = fromPairT (Fermion.leftMetricVal) := by rw [leftMetric_eq_fromConstPair, fromConstPair] - erw [Fermion.leftMetric_apply_one] + congr 1 + exact Fermion.leftMetric_apply_one lemma rightMetric_eq_fromPairT : εR = fromPairT (Fermion.rightMetricVal) := by rw [rightMetric_eq_fromConstPair, fromConstPair] - erw [Fermion.rightMetric_apply_one] + congr 1 + exact Fermion.rightMetric_apply_one lemma altLeftMetric_eq_fromPairT : εL' = fromPairT (Fermion.altLeftMetricVal) := by rw [altLeftMetric_eq_fromConstPair, fromConstPair] - erw [Fermion.altLeftMetric_apply_one] + congr 1 + exact Fermion.altLeftMetric_apply_one lemma altRightMetric_eq_fromPairT : εR' = fromPairT (Fermion.altRightMetricVal) := by rw [altRightMetric_eq_fromConstPair, fromConstPair] - erw [Fermion.altRightMetric_apply_one] + congr 1 + exact Fermion.altRightMetric_apply_one /-! diff --git a/PhysLean/Relativity/Tensors/ComplexTensor/Metrics/Lemmas.lean b/PhysLean/Relativity/Tensors/ComplexTensor/Metrics/Lemmas.lean index 1ab62dc24..dc87b9620 100644 --- a/PhysLean/Relativity/Tensors/ComplexTensor/Metrics/Lemmas.lean +++ b/PhysLean/Relativity/Tensors/ComplexTensor/Metrics/Lemmas.lean @@ -107,43 +107,37 @@ lemma altRightMetric_antisymm : {εR' | α α' = - (εR' | α' α)}ᵀ := by `{η' | μ ρ ⊗ η | ρ ν = δ' | μ ν}ᵀ`. -/ lemma coMetric_contr_contrMetric : {η' | μ ρ ⊗ η | ρ ν = δ' | μ ν}ᵀ := by - erw [contrT_metricTensor_metricTensor_eq_dual_unit] - rfl + exact contrT_metricTensor_metricTensor_eq_dual_unit /-- The contraction of the contravariant metric with the covariant metric is the unit `{η | μ ρ ⊗ η' | ρ ν = δ | μ ν}ᵀ`. -/ lemma contrMetric_contr_coMetric : {η | μ ρ ⊗ η' | ρ ν = δ | μ ν}ᵀ := by - erw [contrT_metricTensor_metricTensor_eq_dual_unit] - rfl + exact contrT_metricTensor_metricTensor_eq_dual_unit /-- The contraction of the left metric with the alt-left metric is the unit `{εL | α β ⊗ εL' | β γ = δL | α γ}ᵀ`. -/ lemma leftMetric_contr_altLeftMetric : {εL | α β ⊗ εL' | β γ = δL | α γ}ᵀ := by - erw [contrT_metricTensor_metricTensor_eq_dual_unit] - rfl + exact contrT_metricTensor_metricTensor_eq_dual_unit /-- The contraction of the right metric with the alt-right metric is the unit `{εR | α β ⊗ εR' | β γ = δR | α γ}ᵀ`. -/ lemma rightMetric_contr_altRightMetric : {εR | α β ⊗ εR' | β γ = δR | α γ}ᵀ := by - erw [contrT_metricTensor_metricTensor_eq_dual_unit] - rfl + exact contrT_metricTensor_metricTensor_eq_dual_unit /-- The contraction of the alt-left metric with the left metric is the unit `{εL' | α β ⊗ εL | β γ = δL' | α γ}ᵀ`. -/ lemma altLeftMetric_contr_leftMetric : {εL' | α β ⊗ εL | β γ = δL' | α γ}ᵀ := by - erw [contrT_metricTensor_metricTensor_eq_dual_unit] - rfl + exact contrT_metricTensor_metricTensor_eq_dual_unit /-- The contraction of the alt-right metric with the right metric is the unit `{εR' | α β ⊗ εR | β γ = δR' | α γ}ᵀ`. -/ lemma altRightMetric_contr_rightMetric : {εR' | α β ⊗ εR | β γ = δR' | α γ}ᵀ := by - erw [contrT_metricTensor_metricTensor_eq_dual_unit] - rfl + exact contrT_metricTensor_metricTensor_eq_dual_unit /-! diff --git a/PhysLean/Relativity/Tensors/ComplexTensor/OfRat.lean b/PhysLean/Relativity/Tensors/ComplexTensor/OfRat.lean index be8caa5a6..34f7da5ab 100644 --- a/PhysLean/Relativity/Tensors/ComplexTensor/OfRat.lean +++ b/PhysLean/Relativity/Tensors/ComplexTensor/OfRat.lean @@ -38,12 +38,10 @@ noncomputable def ofRat {n : ℕ} {c : Fin n → complexLorentzTensor.Color} : apply (Tensor.basis _).repr.injective ext b simp - rfl map_smul' r f := by apply (Tensor.basis _).repr.injective ext b simp - rfl @[simp] lemma ofRat_basis_repr_apply {n : ℕ} {c : Fin n → complexLorentzTensor.Color} @@ -51,7 +49,6 @@ lemma ofRat_basis_repr_apply {n : ℕ} {c : Fin n → complexLorentzTensor.Color (b :(ComponentIdx c)) : (Tensor.basis c).repr (ofRat f) b = toComplexNum (f b) := by simp [ofRat] - rfl lemma basis_eq_ofRat {n : ℕ} {c : Fin n → complexLorentzTensor.Color} (b : (ComponentIdx c)) : @@ -130,7 +127,7 @@ lemma contrT_ofRat_eq_sum_dropPairSection {n : ℕ} {c : Fin (n + 1 + 1) → com enter [2, x] rw [contr_basis_ratComplexNum] simp only [Nat.succ_eq_add_one, Finset.univ_eq_attach, - ofRat_basis_repr_apply, Fin.coe_cast, mul_one, + ofRat_basis_repr_apply, Fin.val_cast, mul_one, mul_zero, Function.comp_apply] rw [← PhysLean.RatComplexNum.toComplexNum.map_mul] rw [← map_sum PhysLean.RatComplexNum.toComplexNum] @@ -157,7 +154,7 @@ lemma contrT_ofRat {n : ℕ} {c : Fin (n + 1 + 1) → complexLorentzTensor.Color · simp · simp only [DropPairSection.ofFinEquiv_apply_fst, DropPairSection.ofFinEquiv_apply_snd] rw [@Fin.ne_iff_vne] at hy - simp only [Fin.coe_cast, ne_eq] at hy + simp only [Fin.val_cast, ne_eq] at hy exact fun a => hy ((Eq.symm a)) · simp diff --git a/PhysLean/Relativity/Tensors/ComplexTensor/Units/Basic.lean b/PhysLean/Relativity/Tensors/ComplexTensor/Units/Basic.lean index 28bccce83..dfaad874f 100644 --- a/PhysLean/Relativity/Tensors/ComplexTensor/Units/Basic.lean +++ b/PhysLean/Relativity/Tensors/ComplexTensor/Units/Basic.lean @@ -117,27 +117,33 @@ lemma rightAltRightUnit_eq_fromConstPair : δR = fromConstPair Fermion.rightAltR lemma coContrUnit_eq_fromPairT : δ' = fromPairT (Lorentz.coContrUnitVal) := by rw [coContrUnit_eq_fromConstPair, fromConstPair] - erw [Lorentz.coContrUnit_apply_one] + congr 1 + exact Lorentz.coContrUnit_apply_one lemma contrCoUnit_eq_fromPairT : δ = fromPairT (Lorentz.contrCoUnitVal) := by rw [contrCoUnit_eq_fromConstPair, fromConstPair] - erw [Lorentz.contrCoUnit_apply_one] + congr 1 + exact Lorentz.contrCoUnit_apply_one lemma altLeftLeftUnit_eq_fromPairT : δL' = fromPairT (Fermion.altLeftLeftUnitVal) := by rw [altLeftLeftUnit_eq_fromConstPair, fromConstPair] - erw [Fermion.altLeftLeftUnit_apply_one] + congr 1 + exact Fermion.altLeftLeftUnit_apply_one lemma leftAltLeftUnit_eq_fromPairT : δL = fromPairT (Fermion.leftAltLeftUnitVal) := by rw [leftAltLeftUnit_eq_fromConstPair, fromConstPair] - erw [Fermion.leftAltLeftUnit_apply_one] + congr 1 + exact Fermion.leftAltLeftUnit_apply_one lemma altRightRightUnit_eq_fromPairT : δR' = fromPairT (Fermion.altRightRightUnitVal) := by rw [altRightRightUnit_eq_fromConstPair, fromConstPair] - erw [Fermion.altRightRightUnit_apply_one] + congr 1 + exact Fermion.altRightRightUnit_apply_one lemma rightAltRightUnit_eq_fromPairT : δR = fromPairT (Fermion.rightAltRightUnitVal) := by rw [rightAltRightUnit_eq_fromConstPair, fromConstPair] - erw [Fermion.rightAltRightUnit_apply_one] + congr 1 + exact Fermion.rightAltRightUnit_apply_one /-! diff --git a/PhysLean/Relativity/Tensors/ComplexTensor/Units/Pre.lean b/PhysLean/Relativity/Tensors/ComplexTensor/Units/Pre.lean index a3e64c519..d9765b587 100644 --- a/PhysLean/Relativity/Tensors/ComplexTensor/Units/Pre.lean +++ b/PhysLean/Relativity/Tensors/ComplexTensor/Units/Pre.lean @@ -143,10 +143,8 @@ lemma contr_contrCoUnit (x : complexCo) : (coContrContraction.hom ▷ complexCo.V) (z ⊗ₜ[ℂ] y) = (coContrContraction.hom z) ⊗ₜ[ℂ] y := rfl repeat rw (config := { transparency := .instances }) [h1''] repeat rw [coContrContraction_basis'] - simp only [Fin.isValue, leftUnitor, ModuleCat.MonoidalCategory.leftUnitor, - LinearEquiv.toModuleIso_hom, ModuleCat.hom_ofHom, Action.tensorUnit_V, ↓reduceIte, - LinearEquiv.coe_coe, reduceCtorEq, zero_tmul, map_zero, smul_zero, add_zero, Sum.inr.injEq, - one_ne_zero, Fin.reduceEq, zero_add, zero_ne_one] + simp only [Fin.isValue, Action.tensorUnit_V, ↓reduceIte, reduceCtorEq, zero_tmul, map_zero, + smul_zero, add_zero, Sum.inr.injEq, one_ne_zero, Fin.reduceEq, zero_add, zero_ne_one] erw [TensorProduct.lid_tmul, TensorProduct.lid_tmul, TensorProduct.lid_tmul, TensorProduct.lid_tmul] simp only [Fin.isValue, one_smul] diff --git a/PhysLean/Relativity/Tensors/ComplexTensor/Weyl/Modules.lean b/PhysLean/Relativity/Tensors/ComplexTensor/Weyl/Modules.lean index 9d19736ad..cb7af4638 100644 --- a/PhysLean/Relativity/Tensors/ComplexTensor/Weyl/Modules.lean +++ b/PhysLean/Relativity/Tensors/ComplexTensor/Weyl/Modules.lean @@ -5,7 +5,6 @@ Authors: Joseph Tooby-Smith -/ import Mathlib.Algebra.Lie.OfAssociative import Mathlib.Analysis.Complex.Basic -import Mathlib.Algebra.Module.TransferInstance /-! ## Modules associated with Fermions diff --git a/PhysLean/Relativity/Tensors/ComplexTensor/Weyl/Two.lean b/PhysLean/Relativity/Tensors/ComplexTensor/Weyl/Two.lean index be5a26b58..634468d6c 100644 --- a/PhysLean/Relativity/Tensors/ComplexTensor/Weyl/Two.lean +++ b/PhysLean/Relativity/Tensors/ComplexTensor/Weyl/Two.lean @@ -39,10 +39,7 @@ lemma leftLeftToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] · rw [Fintype.sum_prod_type] refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - conv_lhs => - enter [2] - erw [Basis.tensorProduct_apply leftBasis leftBasis i j] - rfl + exact congrArg _ (Basis.tensorProduct_apply leftBasis leftBasis i j) · simp /-- Equivalence of `altLeftHanded ⊗ altLeftHanded` to `2 x 2` complex matrices. -/ @@ -59,8 +56,7 @@ lemma altLeftaltLeftToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] · rw [Fintype.sum_prod_type] refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - erw [Basis.tensorProduct_apply altLeftBasis altLeftBasis i j] - rfl + exact congrArg _ (Basis.tensorProduct_apply altLeftBasis altLeftBasis i j) · simp /-- Equivalence of `leftHanded ⊗ altLeftHanded` to `2 x 2` complex matrices. -/ @@ -77,8 +73,7 @@ lemma leftAltLeftToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] · rw [Fintype.sum_prod_type] refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - erw [Basis.tensorProduct_apply leftBasis altLeftBasis i j] - rfl + exact congrArg _ (Basis.tensorProduct_apply leftBasis altLeftBasis i j) · simp /-- Equivalence of `altLeftHanded ⊗ leftHanded` to `2 x 2` complex matrices. -/ @@ -95,8 +90,7 @@ lemma altLeftLeftToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] · rw [Fintype.sum_prod_type] refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - erw [Basis.tensorProduct_apply altLeftBasis leftBasis i j] - rfl + exact congrArg _ (Basis.tensorProduct_apply altLeftBasis leftBasis i j) · simp /-- Equivalence of `rightHanded ⊗ rightHanded` to `2 x 2` complex matrices. -/ @@ -113,8 +107,7 @@ lemma rightRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] · rw [Fintype.sum_prod_type] refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - erw [Basis.tensorProduct_apply rightBasis rightBasis i j] - rfl + exact congrArg _ (Basis.tensorProduct_apply rightBasis rightBasis i j) · simp /-- Equivalence of `altRightHanded ⊗ altRightHanded` to `2 x 2` complex matrices. -/ @@ -132,8 +125,7 @@ lemma altRightAltRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] · rw [Fintype.sum_prod_type] refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - erw [Basis.tensorProduct_apply altRightBasis altRightBasis i j] - rfl + exact congrArg _ (Basis.tensorProduct_apply altRightBasis altRightBasis i j) · simp /-- Equivalence of `rightHanded ⊗ altRightHanded` to `2 x 2` complex matrices. -/ @@ -150,8 +142,7 @@ lemma rightAltRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] · rw [Fintype.sum_prod_type] refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - erw [Basis.tensorProduct_apply rightBasis altRightBasis i j] - rfl + exact congrArg _ (Basis.tensorProduct_apply rightBasis altRightBasis i j) · simp /-- Equivalence of `altRightHanded ⊗ rightHanded` to `2 x 2` complex matrices. -/ @@ -168,8 +159,7 @@ lemma altRightRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] · rw [Fintype.sum_prod_type] refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - erw [Basis.tensorProduct_apply altRightBasis rightBasis i j] - rfl + exact congrArg _ (Basis.tensorProduct_apply altRightBasis rightBasis i j) · simp /-- Equivalence of `altLeftHanded ⊗ altRightHanded` to `2 x 2` complex matrices. -/ @@ -186,8 +176,7 @@ lemma altLeftAltRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] · rw [Fintype.sum_prod_type] refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - erw [Basis.tensorProduct_apply altLeftBasis altRightBasis i j] - rfl + exact congrArg _ (Basis.tensorProduct_apply altLeftBasis altRightBasis i j) · simp /-- Equivalence of `leftHanded ⊗ rightHanded` to `2 x 2` complex matrices. -/ @@ -204,8 +193,7 @@ lemma leftRightToMatrix_symm_expand_tmul (M : Matrix (Fin 2) (Fin 2) ℂ) : rw [Finsupp.linearCombination_apply_of_mem_supported ℂ (s := Finset.univ)] · rw [Fintype.sum_prod_type] refine Finset.sum_congr rfl (fun i _ => Finset.sum_congr rfl (fun j _ => ?_)) - erw [Basis.tensorProduct_apply leftBasis rightBasis i j] - rfl + exact congrArg _ (Basis.tensorProduct_apply leftBasis rightBasis i j) · simp /-! diff --git a/PhysLean/Relativity/Tensors/ComplexTensor/Weyl/Unit.lean b/PhysLean/Relativity/Tensors/ComplexTensor/Weyl/Unit.lean index f1be2463e..1665f5def 100644 --- a/PhysLean/Relativity/Tensors/ComplexTensor/Weyl/Unit.lean +++ b/PhysLean/Relativity/Tensors/ComplexTensor/Weyl/Unit.lean @@ -227,9 +227,8 @@ lemma contr_altLeftLeftUnit (x : leftHanded) : (leftAltContraction.hom (x ⊗ₜ[ℂ] z)) ⊗ₜ[ℂ] y := rfl erw [h1, h1, h1, h1] repeat rw [leftAltContraction_basis] - simp only [Fin.isValue, leftUnitor, ModuleCat.MonoidalCategory.leftUnitor, - LinearEquiv.toModuleIso_hom, ModuleCat.hom_ofHom, Fin.val_zero, ↓reduceIte, LinearEquiv.coe_coe, - Fin.val_one, one_ne_zero, zero_tmul, map_zero, smul_zero, add_zero, zero_ne_one, zero_add] + simp only [Fin.isValue, Fin.val_zero, ↓reduceIte, Fin.val_one, one_ne_zero, zero_tmul, map_zero, + smul_zero, add_zero, zero_ne_one, zero_add] erw [TensorProduct.lid_tmul, TensorProduct.lid_tmul] simp only [Fin.isValue, one_smul] diff --git a/PhysLean/Relativity/Tensors/Constructors.lean b/PhysLean/Relativity/Tensors/Constructors.lean index c72df9969..a7cfd2618 100644 --- a/PhysLean/Relativity/Tensors/Constructors.lean +++ b/PhysLean/Relativity/Tensors/Constructors.lean @@ -68,7 +68,9 @@ noncomputable def fromSingleT {c : C} : S.FD.obj {as := c} ≃ₗ[k] S.Tensor ![ lemma fromSingleT_symm_pure {c : C} (p : Pure S ![c]) : fromSingleT.symm p.toTensor = Pure.fromSingleP.symm p := by simp [fromSingleT] - change (forgetLiftApp S.FD c).hom.hom _ = _ + trans (forgetLiftApp S.FD c).hom.hom + (((lift.obj S.FD).mapIso (mkIso (by aesop))).hom.hom.hom' p.toTensor) + · rfl rw [forgetLiftApp_hom_hom_apply_eq] simp [Pure.toTensor] conv_lhs => @@ -403,8 +405,9 @@ lemma fromPairTContr_tmul_tmul {c c1 c2 : C} change x1 ⊗ₜ[k] ((S.contr.app (Discrete.mk (c))) (x2 ⊗ₜ[k] y1) ⊗ₜ[k] y2) conv_lhs => enter [2] - change x1 ⊗ₜ[k] ((S.contr.app (Discrete.mk (c))) (x2 ⊗ₜ[k] y1) • y2) - simp [tmul_smul] + change x1 ⊗ₜ[k] (((S.contr.app (Discrete.mk (c))) (x2 ⊗ₜ[k] y1) :k) • y2) + rw [tmul_smul (R := k) (R' := k)] + simp set_option maxHeartbeats 400000 in lemma fromPairT_contr_fromPairT_eq_fromPairTContr_tmul (c c1 c2 : C) diff --git a/PhysLean/Relativity/Tensors/Contraction/Basis.lean b/PhysLean/Relativity/Tensors/Contraction/Basis.lean index f10b87dba..7f254819d 100644 --- a/PhysLean/Relativity/Tensors/Contraction/Basis.lean +++ b/PhysLean/Relativity/Tensors/Contraction/Basis.lean @@ -93,9 +93,9 @@ lemma ofFin_mem_dropPairEmbSection {n : ℕ} {c : Fin (n + 1 + 1) → C} ofFin hij b x ∈ DropPairSection b := by simp only [DropPairSection, Finset.mem_filter, Finset.mem_univ, true_and] ext m - simp only [ofFin, dropPair, Pure.dropPairEmb_neq_fst, ↓reduceDIte, Pure.dropPairEmb_neq_snd, + simp only [ofFin, dropPair, Pure.dropPairEmb_ne_fst, ↓reduceDIte, Pure.dropPairEmb_ne_snd, Function.comp_apply] - simp only [Fin.coe_cast] + simp only [Fin.val_cast] rw [Pure.dropPairEmbPre_dropPairEmb] /-- The equivalence between `ContrSection b` and diff --git a/PhysLean/Relativity/Tensors/Contraction/Products.lean b/PhysLean/Relativity/Tensors/Contraction/Products.lean index 26447b1f7..4e0c53213 100644 --- a/PhysLean/Relativity/Tensors/Contraction/Products.lean +++ b/PhysLean/Relativity/Tensors/Contraction/Products.lean @@ -39,7 +39,7 @@ lemma Pure.dropPairEmb_apply_lt_lt {n : ℕ} rw [dropPairEmb_succAbove] simp only [Function.comp_apply] have hj'' : m.val < j.val := by - simp_all only [Fin.succAbove, Fin.lt_def, Fin.coe_castSucc, ne_eq] + simp_all only [Fin.succAbove, Fin.lt_def, Fin.val_castSucc, ne_eq] by_cases hj : j.val < i.val · simp_all · simp_all only [ite_false, Fin.val_succ, not_lt] @@ -47,7 +47,7 @@ lemma Pure.dropPairEmb_apply_lt_lt {n : ℕ} rw [Fin.succAbove_of_succ_le, Fin.succAbove_of_succ_le] · simp only [Fin.le_def, Fin.val_succ] omega - · simp_all only [Fin.succAbove, Fin.lt_def, Fin.coe_castSucc, ne_eq, ite_true, Fin.le_def, + · simp_all only [Fin.succAbove, Fin.lt_def, Fin.val_castSucc, ne_eq, ite_true, Fin.le_def, Fin.val_succ] omega @@ -60,9 +60,9 @@ lemma Pure.dropPairEmb_natAdd_apply_castAdd {n n1 : ℕ} rw [dropPairEmb_apply_lt_lt] · simp [Fin.ext_iff] · simp_all [Fin.ne_iff_vne] - · simp only [Fin.coe_castAdd, Fin.coe_natAdd] + · simp only [Fin.val_castAdd, Fin.val_natAdd] omega - · simp only [Fin.coe_castAdd, Fin.coe_natAdd] + · simp only [Fin.val_castAdd, Fin.val_natAdd] omega lemma Pure.dropPairEmb_natAdd_image_range_castAdd {n n1 : ℕ} @@ -101,7 +101,7 @@ lemma Pure.dropPairEmb_comm_natAdd {n n1 : ℕ} let g : Fin n ↪o Fin (n1 + n + 1 + 1) := ⟨⟨(Fin.natAdd (n1) ∘ dropPairEmb i j), by intro a b - simp only [Function.comp_apply, Fin.ext_iff, Fin.coe_natAdd, add_right_inj] + simp only [Function.comp_apply, Fin.ext_iff, Fin.val_natAdd, add_right_inj] simp [← Fin.ext_iff]⟩, by intro a b simp only [Function.Embedding.coeFn_mk, Function.comp_apply] @@ -143,7 +143,7 @@ lemma Pure.dropPairEmb_comm_natAdd {n n1 : ℕ} apply Iff.intro · intro h use ⟨a - n1, by omega⟩ - simp only [Fin.ext_iff, Fin.coe_natAdd, Fin.natAdd_mk] at h ⊢ + simp only [Fin.ext_iff, Fin.val_natAdd, Fin.natAdd_mk] at h ⊢ omega · intro h obtain ⟨x, h1, rfl⟩ := h diff --git a/PhysLean/Relativity/Tensors/Contraction/Pure.lean b/PhysLean/Relativity/Tensors/Contraction/Pure.lean index 7b2b3e666..865f11088 100644 --- a/PhysLean/Relativity/Tensors/Contraction/Pure.lean +++ b/PhysLean/Relativity/Tensors/Contraction/Pure.lean @@ -229,7 +229,7 @@ lemma dropPairEmb_image_compl {i j : Fin (n + 1 + 1)} (hij : i ≠ j) exact Set.union_comm ((dropPairEmb i j) '' X) {i, j} @[simp] -lemma fst_neq_dropPairEmb_pre (i j : Fin (n + 1 + 1)) (m : Fin n) : +lemma fst_ne_dropPairEmb_pre (i j : Fin (n + 1 + 1)) (m : Fin n) : ¬ i = dropPairEmb i j m := by by_cases hij : i = j · subst hij @@ -246,19 +246,19 @@ lemma fst_neq_dropPairEmb_pre (i j : Fin (n + 1 + 1)) (m : Fin n) : simp [- dropPairEmb_range] at hi @[simp] -lemma dropPairEmb_neq_fst (i j : Fin (n + 1 + 1)) (m : Fin n) : +lemma dropPairEmb_ne_fst (i j : Fin (n + 1 + 1)) (m : Fin n) : ¬ dropPairEmb i j m = i := by apply Ne.symm simp @[simp] -lemma snd_neq_dropPairEmb_pre (i j : Fin (n + 1 + 1)) (m : Fin n) : +lemma snd_ne_dropPairEmb_pre (i j : Fin (n + 1 + 1)) (m : Fin n) : ¬ j = (dropPairEmb i j) m := by rw [dropPairEmb_symm] - exact fst_neq_dropPairEmb_pre j i m + exact fst_ne_dropPairEmb_pre j i m @[simp] -lemma dropPairEmb_neq_snd (i j : Fin (n + 1 + 1)) (m : Fin n) : +lemma dropPairEmb_ne_snd (i j : Fin (n + 1 + 1)) (m : Fin n) : ¬ dropPairEmb i j m = j := by apply Ne.symm simp @@ -548,7 +548,7 @@ lemma dropPair_update_fst {n : ℕ} [inst : DecidableEq (Fin (n + 1 +1))] {c : F ext m simp only [Function.comp_apply, dropPair, update] rw [Function.update_of_ne] - exact Ne.symm (fst_neq_dropPairEmb_pre i j m) + exact Ne.symm (fst_ne_dropPairEmb_pre i j m) @[simp] lemma dropPair_update_snd {n : ℕ} [inst : DecidableEq (Fin (n + 1 +1))] {c : Fin (n + 1 + 1) → C} diff --git a/PhysLean/Relativity/Tensors/Elab.lean b/PhysLean/Relativity/Tensors/Elab.lean index 0663c7221..186c230d9 100644 --- a/PhysLean/Relativity/Tensors/Elab.lean +++ b/PhysLean/Relativity/Tensors/Elab.lean @@ -40,7 +40,7 @@ import PhysLean.Relativity.Tensors.Tensorial ## Comments -- In all of theses expressions `μ`, `ν` etc are free. It does not matter what they are called, +- In all of these expressions `μ`, `ν` etc are free. It does not matter what they are called, Lean will elaborate them in the same way. In other words, `{T | μ ν ⊗ T3 | μ ν }ᵀ` is exactly the same to Lean as `{T | α β ⊗ T3 | α β }ᵀ`. - Note that compared to ordinary index notation, we do not rise or lower the indices. diff --git a/PhysLean/Relativity/Tensors/Evaluation.lean b/PhysLean/Relativity/Tensors/Evaluation.lean index 80f6f3bc2..12bac69eb 100644 --- a/PhysLean/Relativity/Tensors/Evaluation.lean +++ b/PhysLean/Relativity/Tensors/Evaluation.lean @@ -117,6 +117,15 @@ noncomputable def evalT {n : ℕ} {c : Fin (n + 1) → C} (i : Fin (n + 1)) Tensor S c →ₗ[k] Tensor S (c ∘ i.succAbove) := PiTensorProduct.lift (Pure.evalPMultilinear i b) +@[simp] +lemma evalT_pure {n : ℕ} {c : Fin (n + 1) → C} (i : Fin (n + 1)) + (b : Fin (S.repDim (c i))) (p : Pure S c) : + evalT i b p.toTensor = Pure.evalP i b p := by + simp only [evalT, Pure.toTensor] + change _ = Pure.evalPMultilinear i b p + conv_rhs => rw [← PiTensorProduct.lift.tprod] + rfl + TODO "6VZ6G" "Add lemmas related to the interaction of evalT and permT, prodT and contrT." end Tensor diff --git a/PhysLean/Relativity/Tensors/Product.lean b/PhysLean/Relativity/Tensors/Product.lean index e4713bc4c..a1a2d2bdc 100644 --- a/PhysLean/Relativity/Tensors/Product.lean +++ b/PhysLean/Relativity/Tensors/Product.lean @@ -158,14 +158,14 @@ def ComponentIdx.prodEquiv {n1 n2 : ℕ} {c : Fin n1 → C} {c1 : Fin n2 → C} simp only · rw [ComponentIdx.prodIndexEquiv] rw [Equiv.piCongr_symm_apply] - simp only [Sum.elim_inl, finCongr_symm, finCongr_apply, Fin.coe_cast] + simp only [Sum.elim_inl, finCongr_symm, finCongr_apply, Fin.val_cast] rw [prod_apply_finSumFinEquiv] rfl · rw [ComponentIdx.prodIndexEquiv] simp only erw [Equiv.piCongr_symm_apply] simp only [Sum.elim_inr, finCongr_symm, - finCongr_apply, Fin.coe_cast] + finCongr_apply, Fin.val_cast] rw [prod_apply_finSumFinEquiv] rfl @@ -528,7 +528,7 @@ lemma prodAssocMap_castAdd_natAdd {n1 n2 n3 : ℕ} (i : Fin n2) : lemma prodAssocMap_natAdd {n1 n2 n3 : ℕ} (i : Fin (n3)) : prodAssocMap n1 n2 n3 (Fin.natAdd (n1 + n2) i) = finSumFinEquiv (Sum.inr (finSumFinEquiv (Sum.inr i))) := by - simp only [prodAssocMap, finSumFinEquiv_apply_right, Fin.ext_iff, Fin.coe_cast, Fin.coe_natAdd] + simp only [prodAssocMap, finSumFinEquiv_apply_right, Fin.ext_iff, Fin.val_cast, Fin.val_natAdd] omega @[simp] @@ -592,7 +592,7 @@ lemma prodAssocMap'_natAdd_castAdd {n1 n2 n3 : ℕ} (i : Fin n2) : lemma prodAssocMap'_natAdd_natAdd {n1 n2 n3 : ℕ} (i : Fin n3) : prodAssocMap' n1 n2 n3 (Fin.natAdd n1 (Fin.natAdd n2 i)) = finSumFinEquiv (Sum.inr i) := by - simp only [prodAssocMap', finSumFinEquiv_apply_right, Fin.ext_iff, Fin.coe_cast, Fin.coe_natAdd] + simp only [prodAssocMap', finSumFinEquiv_apply_right, Fin.ext_iff, Fin.val_cast, Fin.val_natAdd] omega @[simp] diff --git a/PhysLean/Relativity/Tensors/RealTensor/Basic.lean b/PhysLean/Relativity/Tensors/RealTensor/Basic.lean index faed440e2..d5797bd5c 100644 --- a/PhysLean/Relativity/Tensors/RealTensor/Basic.lean +++ b/PhysLean/Relativity/Tensors/RealTensor/Basic.lean @@ -226,8 +226,8 @@ lemma contrT_basis_repr_apply_eq_fin {n d: ℕ} {c : Fin (n + 1 + 1) → realLor · dsimp only [ne_eq, OrderIso.toEquiv_symm, RelIso.coe_fn_toEquiv, e] simp · dsimp only [OrderIso.toEquiv_symm, RelIso.coe_fn_toEquiv, ne_eq, id_eq, - eq_mpr_eq_cast, Fin.coe_cast, e] - simp_all only [ne_eq, Fin.ext_iff, Finset.mem_univ, Fin.coe_cast, + eq_mpr_eq_cast, Fin.val_cast, e] + simp_all only [ne_eq, Fin.ext_iff, Finset.mem_univ, Fin.val_cast, OrderIso.coe_symm_toEquiv, Fin.symm_castOrderIso, Fin.castOrderIso_apply] omega · simp diff --git a/PhysLean/Relativity/Tensors/RealTensor/CoVector/Basic.lean b/PhysLean/Relativity/Tensors/RealTensor/CoVector/Basic.lean index 5e405412c..61a1abb45 100644 --- a/PhysLean/Relativity/Tensors/RealTensor/CoVector/Basic.lean +++ b/PhysLean/Relativity/Tensors/RealTensor/CoVector/Basic.lean @@ -36,21 +36,67 @@ namespace CoVector open TensorSpecies open Tensor -instance {d} : AddCommMonoid (CoVector d) := inferInstanceAs (AddCommMonoid (Fin 1 ⊕ Fin d → ℝ)) +instance {d} : AddCommMonoid (CoVector d) := + inferInstanceAs (AddCommMonoid (Fin 1 ⊕ Fin d → ℝ)) -instance {d} : Module ℝ (CoVector d) := inferInstanceAs (Module ℝ (Fin 1 ⊕ Fin d → ℝ)) +instance {d} : Module ℝ (CoVector d) := + inferInstanceAs (Module ℝ (Fin 1 ⊕ Fin d → ℝ)) -instance {d} : AddCommGroup (CoVector d) := inferInstanceAs (AddCommGroup (Fin 1 ⊕ Fin d → ℝ)) +instance {d} : AddCommGroup (CoVector d) := + inferInstanceAs (AddCommGroup (Fin 1 ⊕ Fin d → ℝ)) instance {d} : FiniteDimensional ℝ (CoVector d) := inferInstanceAs (FiniteDimensional ℝ (Fin 1 ⊕ Fin d → ℝ)) -instance isNormedAddCommGroup (d : ℕ) : NormedAddCommGroup (CoVector d) := - inferInstanceAs (NormedAddCommGroup (Fin 1 ⊕ Fin d → ℝ)) - -instance isNormedSpace (d : ℕ) : - NormedSpace ℝ (CoVector d) := - inferInstanceAs (NormedSpace ℝ (Fin 1 ⊕ Fin d → ℝ)) +/-- The equivalence between `CoVector d` and `EuclideanSpace ℝ (Fin 1 ⊕ Fin d)`. -/ +def equivEuclid (d : ℕ) : + CoVector d ≃ₗ[ℝ] EuclideanSpace ℝ (Fin 1 ⊕ Fin d) := + (WithLp.linearEquiv _ _ _).symm + +instance (d : ℕ) : Norm (CoVector d) where + norm := fun v => ‖equivEuclid d v‖ + +lemma norm_eq_equivEuclid (d : ℕ) (v : CoVector d) : + ‖v‖ = ‖equivEuclid d v‖ := rfl + +instance isNormedAddCommGroup (d : ℕ) : NormedAddCommGroup (CoVector d) where + dist_self x := by simp [norm_eq_equivEuclid] + dist_comm x y := by + simpa [norm_eq_equivEuclid] using dist_comm ((equivEuclid d) x) _ + dist_triangle x y z := by + simpa [norm_eq_equivEuclid] using dist_triangle + ((equivEuclid d) x) ((equivEuclid d) y) ((equivEuclid d) z) + eq_of_dist_eq_zero {x y} := by + simp only [norm_eq_equivEuclid, map_sub] + intro h + apply (equivEuclid d).injective + exact (eq_of_dist_eq_zero h) + +instance isNormedSpace (d : ℕ) : NormedSpace ℝ (CoVector d) where + norm_smul_le c v := by + simp only [norm_eq_equivEuclid, map_smul] + exact norm_smul_le c (equivEuclid d v) +open InnerProductSpace + +instance (d : ℕ) : Inner ℝ (CoVector d) where + inner := fun v w => ⟪equivEuclid d v, equivEuclid d w⟫_ℝ + +lemma inner_eq_equivEuclid (d : ℕ) (v w : CoVector d) : + ⟪v, w⟫_ℝ = ⟪equivEuclid d v, equivEuclid d w⟫_ℝ := rfl +/-- The Euclidean inner product structure on `CoVector`. -/ +instance innerProductSpace (d : ℕ) : InnerProductSpace ℝ (CoVector d) where + norm_sq_eq_re_inner v := by + simp only [inner_eq_equivEuclid, norm_eq_equivEuclid] + exact InnerProductSpace.norm_sq_eq_re_inner (equivEuclid d v) + conj_inner_symm x y := by + simp only [inner_eq_equivEuclid] + exact InnerProductSpace.conj_inner_symm (equivEuclid d x) (equivEuclid d y) + add_left x y z := by + simp only [inner_eq_equivEuclid, map_add] + exact InnerProductSpace.add_left (equivEuclid d x) (equivEuclid d y) (equivEuclid d z) + smul_left x y r := by + simp only [inner_eq_equivEuclid, map_smul] + exact InnerProductSpace.smul_left (equivEuclid d x) (equivEuclid d y) r /-- The instance of a `ChartedSpace` on `Vector d`. -/ instance : ChartedSpace (CoVector d) (CoVector d) := chartedSpaceSelf (CoVector d) diff --git a/PhysLean/Relativity/Tensors/RealTensor/Derivative.lean b/PhysLean/Relativity/Tensors/RealTensor/Derivative.lean index 495664fab..bb870a8f3 100644 --- a/PhysLean/Relativity/Tensors/RealTensor/Derivative.lean +++ b/PhysLean/Relativity/Tensors/RealTensor/Derivative.lean @@ -32,7 +32,7 @@ noncomputable def derivative {d n m : ℕ} {cm : Fin m → realLorentzTensor.Col ℝT(d, cm) → ℝT(d, (Fin.append (fun i => (realLorentzTensor d).τ (cm i)) cn)) := fun y => (Tensor.basis _).repr.toEquiv.symm <| Finsupp.equivFunOnFinite.symm <| fun b => - /- The `b` componenet of the derivative of `f` evaluated at `y` is: -/ + /- The `b` component of the derivative of `f` evaluated at `y` is: -/ /- The derivative of `mapToBasis f` -/ fderiv ℝ (mapToBasis f) /- evaluated at the point `y` in `ℝT(d, cm)` -/ diff --git a/PhysLean/Relativity/Tensors/RealTensor/Metrics/Basic.lean b/PhysLean/Relativity/Tensors/RealTensor/Metrics/Basic.lean index 6036827f6..f8a8c2384 100644 --- a/PhysLean/Relativity/Tensors/RealTensor/Metrics/Basic.lean +++ b/PhysLean/Relativity/Tensors/RealTensor/Metrics/Basic.lean @@ -69,12 +69,14 @@ lemma contrMetric_eq_fromConstPair {d : ℕ} : lemma coMetric_eq_fromPairT {d : ℕ} : η' d = fromPairT (Lorentz.preCoMetricVal d) := by rw [coMetric_eq_fromConstPair, fromConstPair] - erw [Lorentz.preCoMetric_apply_one] + congr 1 + exact Lorentz.preCoMetric_apply_one lemma contrMetric_eq_fromPairT {d : ℕ} : η d = fromPairT (Lorentz.preContrMetricVal d) := by rw [contrMetric_eq_fromConstPair, fromConstPair] - erw [Lorentz.preContrMetric_apply_one] + congr 1 + exact Lorentz.preContrMetric_apply_one /- diff --git a/PhysLean/Relativity/Tensors/RealTensor/Metrics/Pre.lean b/PhysLean/Relativity/Tensors/RealTensor/Metrics/Pre.lean index 50548784b..676693d75 100644 --- a/PhysLean/Relativity/Tensors/RealTensor/Metrics/Pre.lean +++ b/PhysLean/Relativity/Tensors/RealTensor/Metrics/Pre.lean @@ -28,8 +28,7 @@ lemma preContrMetricVal_expand_tmul {d : ℕ} : preContrMetricVal d = Fin.isValue, Finset.sum_singleton, ne_eq, reduceCtorEq, not_false_eq_true, minkowskiMatrix.off_diag_zero, zero_smul, Finset.sum_const_zero, add_zero, minkowskiMatrix.inl_0_inl_0, one_smul, zero_add] - congr - rw [← Finset.sum_neg_distrib] + rw [sub_eq_add_neg, ← Finset.sum_neg_distrib] congr funext x rw [Finset.sum_eq_single x] @@ -93,8 +92,7 @@ lemma preCoMetricVal_expand_tmul {d : ℕ} : preCoMetricVal d = simp only [preCoMetricVal, Fin.isValue] rw [coCoToMatrixRe_symm_expand_tmul] simp [minkowskiMatrix.inl_0_inl_0] - congr - rw [← Finset.sum_neg_distrib] + rw [sub_eq_add_neg, ← Finset.sum_neg_distrib] congr funext x rw [Finset.sum_eq_single x] diff --git a/PhysLean/Relativity/Tensors/RealTensor/ToComplex.lean b/PhysLean/Relativity/Tensors/RealTensor/ToComplex.lean index 4c2f8261b..5cd280b2e 100644 --- a/PhysLean/Relativity/Tensors/RealTensor/ToComplex.lean +++ b/PhysLean/Relativity/Tensors/RealTensor/ToComplex.lean @@ -7,9 +7,53 @@ import PhysLean.Meta.Linters.Sorry import PhysLean.Relativity.Tensors.ComplexTensor.Basic /-! -## Complex Lorentz tensors from Real Lorentz tensors +# Complex Lorentz tensors from real Lorentz tensors -In this module we define the equivariant semi-linear map from real Lorentz tensors to +## i. Overview + +In this module we describe how to pass from real Lorentz tensors to complex Lorentz tensors +in a functorial way. +Specifically, we construct a canonical equivariant semilinear map + +* `toComplex : ℝT(3, c) →ₛₗ[Complex.ofRealHom] ℂT(colorToComplex ∘ c)` + +which is compatible with the natural operations on tensors (permutations of +indices, tensor products, contractions and evaluations). + +## ii. Key results + +The main definitions and statements are: + +* `colorToComplex` upgrades the colour of a real Lorentz tensor to the + corresponding complex Lorentz colour. +* `TensorSpecies.Tensor.ComponentIdx.complexify` transports component indices + along `colorToComplex`. +* `toComplex` is the basic semilinear map from real to complex Lorentz tensors. +* `toComplex_basis` and `toComplex_pure_basisVector` show that `toComplex` + sends basis tensors to basis tensors. +* `toComplex_eq_zero_iff` and `toComplex_injective` show that `toComplex` is + injective. +* `toComplex_equivariant` states that `toComplex` is equivariant for the action + of the complexified Lorentz group. +* `permT_toComplex`, `prodT_toComplex`, `contrT_toComplex` and `evalT_toComplex` + express that `toComplex` commutes with the basic tensor operations. + +## iii. Table of contents + +* A. Colours and component indices +* B. The semilinear map `toComplex` + * B.1. Expression in the tensor basis + * B.2. Behaviour on basis vectors and injectivity + * B.3. Equivariance under the Lorentz action +* C. Compatibility with permutations: `permT` +* D. Compatibility with tensor products: `prodT` +* E. Compatibility with contraction: `contrT` +* F. Compatibility with evaluation: `evalT` + +## iv. References + +The general formalism of Lorentz tensors and their operations is developed in +other parts of the library; here we only specialise to the passage from real to complex Lorentz tensors. -/ @@ -20,6 +64,15 @@ open Module TensorSpecies open Tensor open complexLorentzTensor +/-! + +## A. Colours and component indices + +We first explain how the Lorentz colour data and component indices for real +tensors are transported to the complex setting. + +-/ + /-- The map from colors of real Lorentz tensors to complex Lorentz tensors. -/ def colorToComplex (c : realLorentzTensor.Color) : complexLorentzTensor.Color := match c with @@ -48,6 +101,34 @@ def _root_.TensorSpecies.Tensor.ComponentIdx.complexify {n} {c : Fin n → realL right_inv i := by rfl +@[simp] +lemma ComponentIdx.complexify_apply {n} {c : Fin n → realLorentzTensor.Color} + (f : ComponentIdx (S := realLorentzTensor) c) (j : Fin n) : + (ComponentIdx.complexify f) j = Fin.cast (by + simp only [repDim_eq_one_plus_dim, Nat.reduceAdd, Function.comp_apply] + generalize c j = cj + match cj with + | .up => rfl + | .down => rfl) (f j) := + rfl + +@[simp] +lemma ComponentIdx.complexify_toFun_apply {n} {c : Fin n → realLorentzTensor.Color} + (f : ComponentIdx (S := realLorentzTensor) c) (j : Fin n) : + (ComponentIdx.complexify.toFun f) j = (ComponentIdx.complexify f) j := + rfl + +/-! + +## B. The semilinear map `toComplex` + +We now define the basic semilinear map from real Lorentz tensors to complex +Lorentz tensors. It is characterised by sending the standard tensor basis on +the real side to the corresponding basis on the complex side, and is therefore +determined by the behaviour on components. + +-/ + /-- The semilinear map from real Lorentz tensors to complex Lorentz tensors, defined through basis. -/ noncomputable def toComplex {n} {c : Fin n → realLorentzTensor.Color} : @@ -76,6 +157,41 @@ lemma toComplex_eq_sum_basis {n} (c : Fin n → realLorentzTensor.Color) (v : rw [← Equiv.sum_comp ComponentIdx.complexify] rfl +/-- `toComplex` sends basis elements to basis elements. -/ +@[simp] +lemma toComplex_basis {n} {c : Fin n → realLorentzTensor.Color} + (i : ComponentIdx (S := realLorentzTensor) c) : + toComplex (c := c) ((Tensor.basis (S := realLorentzTensor) c) i) = + (Tensor.basis (S := complexLorentzTensor) (colorToComplex ∘ c)) i.complexify := by + classical + simp only [toComplex, LinearMap.coe_mk, AddHom.coe_mk] + rw [Basis.repr_self] + simp_rw [Finsupp.single_apply] + -- collapse the sum: only the `i`-term survives + refine (Fintype.sum_eq_single i ?_).trans ?_ + · intro j hj + have hij : i ≠ j := Ne.symm hj + simp [hij] + · -- now the remaining term is the `i`-term + simp + +/-- `toComplex` on a pure basis vector. -/ +@[simp] +lemma toComplex_pure_basisVector {n} {c : Fin n → realLorentzTensor.Color} + (b : ComponentIdx (S := realLorentzTensor) c) : + toComplex (c := c) (Pure.basisVector c b |>.toTensor) + = + (Pure.basisVector (colorToComplex ∘ c) b.complexify).toTensor := by + classical + -- rewrite pure basis vector back to tensor basis, use `toComplex_basis`, then rewrite back + rw [← Tensor.basis_apply (S := realLorentzTensor) (c := c) b] + rw [toComplex_basis (c := c) b] + rw [Tensor.basis_apply (S := complexLorentzTensor) (c := (colorToComplex ∘ c)) b.complexify] + +lemma toComplex_map_smul {n} (c : Fin n → realLorentzTensor.Color) (r : ℝ) (t : ℝT(3, c)) : + toComplex (c := c) (r • t) = (Complex.ofReal r) • toComplex (c := c) t := + (toComplex (c := c)).map_smulₛₗ r t + @[simp] lemma toComplex_eq_zero_iff {n} (c : Fin n → realLorentzTensor.Color) (v : ℝT(3, c)) : toComplex v = 0 ↔ v = 0 := by @@ -104,6 +220,16 @@ open Matrix open MatrixGroups open complexLorentzTensor open Lorentz.SL2C in + +/-! + +### B.3. Equivariance under the Lorentz action + +Finally we record that `toComplex` is equivariant for the natural action of +`SL(2, ℂ)` (and hence the induced Lorentz action) on tensors. + +-/ + /-- The map `toComplex` is equivariant. -/ @[sorryful] lemma toComplex_equivariant {n} {c : Fin n → realLorentzTensor.Color} @@ -113,28 +239,564 @@ lemma toComplex_equivariant {n} {c : Fin n → realLorentzTensor.Color} /-! -## Relation to tensor operations +## C. Compatibility with permutations: `permT` + +We first show that complexification is compatible with permutation of tensor +slots. On colours this is encoded in the `PermCond` predicate, and on tensors +by the operator `permT`. -/ +/-- The `PermCond` condition is preserved under `colorToComplex`. -/ +@[simp] lemma permCond_colorToComplex {n m : ℕ} + {c : Fin n → realLorentzTensor.Color} {c1 : Fin m → realLorentzTensor.Color} + {σ : Fin m → Fin n} (h : PermCond c c1 σ) : + PermCond (colorToComplex ∘ c) (colorToComplex ∘ c1) σ := by + refine And.intro h.1 ?_ + intro i + simpa [Function.comp_apply] using congrArg colorToComplex (h.2 i) + +/-- `permT` sends basis vectors to basis vectors. -/ +@[simp] lemma permT_basis_real {n m : ℕ} + {c : Fin n → realLorentzTensor.Color} {c1 : Fin m → realLorentzTensor.Color} + {σ : Fin m → Fin n} (h : PermCond c c1 σ) + (b : ComponentIdx (S := realLorentzTensor) c) : + permT (S := realLorentzTensor) σ h ((Tensor.basis (S := realLorentzTensor) c) b) + = + (Tensor.basis (S := realLorentzTensor) c1) + (fun j => Fin.cast (by simp [repDim_eq_one_plus_dim]) (b (σ j))) := by + classical + simp [Tensor.basis_apply, permT_pure, Pure.permP_basisVector] + +@[simp] lemma permT_basis_complex {n m : ℕ} + {c : Fin n → complexLorentzTensor.Color} {c1 : Fin m → complexLorentzTensor.Color} + {σ : Fin m → Fin n} (h : PermCond c c1 σ) + (b : ComponentIdx (S := complexLorentzTensor) c) : + permT (S := complexLorentzTensor) σ h ((Tensor.basis (S := complexLorentzTensor) c) b) + = + (Tensor.basis (S := complexLorentzTensor) c1) + (fun j => Fin.cast + (by + -- from the color agreement we get the repDim agreement + -- if one has `h.2 j : c1 j = c (σ j)`, then replace it with `(h.2 j).symm` + simpa using congrArg (fun col => (complexLorentzTensor).repDim col) (h.2 j)) + (b (σ j))) := by + classical + simp [Tensor.basis_apply, permT_pure, Pure.permP_basisVector] + /-- The map `toComplex` commutes with permT. -/ -informal_lemma permT_toComplex where - deps := [``permT] - tag := "7RKA6" +lemma permT_toComplex {n m : ℕ} + {c : Fin n → realLorentzTensor.Color} + {c1 : Fin m → realLorentzTensor.Color} + {σ : Fin m → Fin n} (h : PermCond c c1 σ) (t : ℝT(3, c)) : + toComplex (permT (S := realLorentzTensor) σ h t) + = + permT (S := complexLorentzTensor) σ (permCond_colorToComplex (c := c) (c1 := c1) h) + (toComplex (c := c) t) := by + classical + let h' : PermCond (colorToComplex ∘ c) (colorToComplex ∘ c1) σ := + permCond_colorToComplex (c := c) (c1 := c1) h + let P : ℝT(3, c) → Prop := fun t => + toComplex (permT (S := realLorentzTensor) σ h t) + = + permT (S := complexLorentzTensor) σ h' (toComplex (c := c) t) + change P t + apply induction_on_basis + · intro b + dsimp [P, h'] + + -- permT on (real/complex) basis + toComplex on basis + simp (config := { failIfUnchanged := false }) + [permT_basis_real, permT_basis_complex, toComplex_basis] + + -- index equality + apply congrArg (Tensor.basis (S := complexLorentzTensor) (colorToComplex ∘ c1)) + funext j + simp [TensorSpecies.Tensor.ComponentIdx.complexify, colorToComplex, Function.comp_apply] + · simp [P] + · intro r t ht + dsimp [P] at ht ⊢ + refine (by + simp [map_smul, ht]) + · intro t1 t2 h1 h2 + dsimp [P] at h1 h2 ⊢ + refine (by + simp [map_add, h1, h2]) + +/-! + +### D. Compatibility with tensor products: `prodT` + +-/ + +/-- `colorToComplex` commutes with `Fin.append` (as functions). -/ +@[simp] +lemma colorToComplex_append {n m : ℕ} + (c : Fin n → realLorentzTensor.Color) (c1 : Fin m → realLorentzTensor.Color) : + (colorToComplex ∘ Fin.append c c1) = Fin.append (colorToComplex ∘ c) (colorToComplex ∘ c1) := by + funext x + -- breaking down x : Fin (n+m) into left/right parts + refine Fin.addCases (fun i => ?_) (fun j => ?_) x + · -- left case: x = castAdd m i + -- here `simp` should expand `Fin.append` on castAdd + simp [Fin.append, Function.comp_apply] + · -- right case: x = natAdd n j + simp [Fin.append, Function.comp_apply] + +lemma permCond_prodTColorToComplex {n m : ℕ} + {c : Fin n → realLorentzTensor.Color} {c1 : Fin m → realLorentzTensor.Color} : + PermCond (Fin.append (colorToComplex ∘ c) (colorToComplex ∘ c1)) + (colorToComplex ∘ Fin.append c c1) + (id : Fin (n + m) → Fin (n + m)) := by + -- For `σ = id`, `PermCond.on_id` reduces the goal to pointwise color equality. + -- Here that equality is exactly `colorToComplex_append`. + apply (PermCond.on_id + (c := Fin.append (colorToComplex ∘ c) (colorToComplex ∘ c1)) + (c1 := colorToComplex ∘ Fin.append c c1)).2 + intro x + -- `colorToComplex_append` states the two color functions are extensionally equal, + -- but with the sides reversed, so we use its symmetric form. + have hx := congrArg (fun f => f x) + (colorToComplex_append (c := c) (c1 := c1)).symm + simpa [Function.comp_apply] using hx + +/-- `prodT` on the complex side, with colors written as `colorToComplex ∘ Fin.append ...`. +This is `prodT` followed by a cast using `colorToComplex_append`. -/ +noncomputable def prodTColorToComplex {n m : ℕ} + {c : Fin n → realLorentzTensor.Color} {c1 : Fin m → realLorentzTensor.Color} : + ℂT(colorToComplex ∘ c) → ℂT(colorToComplex ∘ c1) → ℂT(colorToComplex ∘ Fin.append c c1) := + fun x y => + permT (S := complexLorentzTensor) (σ := (id : Fin (n + m) → Fin (n + m))) + (permCond_prodTColorToComplex (c := c) (c1 := c1)) + (prodT (S := complexLorentzTensor) x y) + +private lemma cast_componentIdx_apply {n : ℕ} {c c' : Fin n → complexLorentzTensor.Color} + (h : c' = c) (f : ComponentIdx (S := complexLorentzTensor) c') (x : Fin n) : + (cast (congr_arg ComponentIdx h) f) x = + Fin.cast (congr_arg (fun c => complexLorentzTensor.repDim (c x)) h) (f x) := by + subst h + rfl + +@[simp] +private lemma cast_componentIdx_eq_fun {n : ℕ} + {c c' : Fin n → complexLorentzTensor.Color} + (h : c' = c) (f : ComponentIdx (S := complexLorentzTensor) c') : + cast (congr_arg ComponentIdx h) f = + (fun x => + Fin.cast (congr_arg (fun col => complexLorentzTensor.repDim (col x)) h) (f x)) := by + funext x + exact cast_componentIdx_apply (c := c) (c' := c') h f x + +/-- `complexify` commutes with `prod` of component indices. -/ +@[simp] +lemma complexify_prod {n m : ℕ} + {c : Fin n → realLorentzTensor.Color} {c1 : Fin m → realLorentzTensor.Color} + (b : ComponentIdx (S := realLorentzTensor) c) + (b1 : ComponentIdx (S := realLorentzTensor) c1) : + ComponentIdx.complexify (c := Fin.append c c1) (b.prod b1) + = + cast (congr_arg ComponentIdx (colorToComplex_append c c1).symm) + ((ComponentIdx.complexify (c := c) b).prod (ComponentIdx.complexify (c := c1) b1)) := by + ext x + obtain ⟨i, rfl⟩ := finSumFinEquiv.surjective x + cases i with + | inl i => + rw [ComponentIdx.complexify_apply, ComponentIdx.prod_apply_finSumFinEquiv b b1 (Sum.inl i)] + have cast_apply_rhs : (cast (congr_arg ComponentIdx (colorToComplex_append c c1).symm) + ((ComponentIdx.complexify b).prod (ComponentIdx.complexify b1))) + (finSumFinEquiv (Sum.inl i)) = + Fin.cast (congr_arg (fun c => + complexLorentzTensor.repDim (c (finSumFinEquiv (Sum.inl i)))) + (colorToComplex_append c c1).symm) + (((ComponentIdx.complexify b).prod (ComponentIdx.complexify b1)) + (finSumFinEquiv (Sum.inl i))) := + cast_componentIdx_apply (colorToComplex_append c c1).symm _ _ + rw [cast_apply_rhs, + ComponentIdx.prod_apply_finSumFinEquiv (ComponentIdx.complexify b) + (ComponentIdx.complexify b1) (Sum.inl i)] + congr 1 + | inr j => + rw [ComponentIdx.complexify_apply, ComponentIdx.prod_apply_finSumFinEquiv b b1 (Sum.inr j)] + have cast_apply_rhs : (cast (congr_arg ComponentIdx (colorToComplex_append c c1).symm) + ((ComponentIdx.complexify b).prod (ComponentIdx.complexify b1))) + (finSumFinEquiv (Sum.inr j)) = + Fin.cast (congr_arg (fun c => complexLorentzTensor.repDim + (c (finSumFinEquiv (Sum.inr j)))) (colorToComplex_append c c1).symm) + (((ComponentIdx.complexify b).prod (ComponentIdx.complexify b1)) + (finSumFinEquiv (Sum.inr j))) := + cast_componentIdx_apply (colorToComplex_append c c1).symm _ _ + rw [cast_apply_rhs, + ComponentIdx.prod_apply_finSumFinEquiv (ComponentIdx.complexify b) + (ComponentIdx.complexify b1) (Sum.inr j)] + congr 1 /-- The map `toComplex` commutes with prodT. -/ -informal_lemma prodT_toComplex where - deps := [``prodT] - tag := "7RKFF" - -/-- The map `toComplex` commutes with contrT. -/ -informal_lemma contrT_toComplex where - deps := [``contrT] - tag := "7RKFR" - -/-- The map `toComplex` commutes with evalT. -/ -informal_lemma evalT_toComplex where - deps := [``evalT] - tag := "7RKGK" +lemma prodT_toComplex {n m : ℕ} + {c : Fin n → realLorentzTensor.Color} + {c1 : Fin m → realLorentzTensor.Color} + (t : ℝT(3, c)) (t1 : ℝT(3, c1)) : + toComplex (c := Fin.append c c1) (prodT (S := realLorentzTensor) t t1) + = + prodTColorToComplex (c := c) (c1 := c1) + (toComplex (c := c) t) (toComplex (c := c1) t1) := by + classical + -- Induction on the first tensor using the tensor basis. + let P : ℝT(3, c) → Prop := fun t => + ∀ t1 : ℝT(3, c1), + toComplex (c := Fin.append c c1) (prodT (S := realLorentzTensor) t t1) + = + prodTColorToComplex (c := c) (c1 := c1) + (toComplex (c := c) t) (toComplex (c := c1) t1) + have hP : P t := by + -- `induction_on_basis` over the first tensor. + apply + induction_on_basis + (c := c) + (P := P) + (t := t) + · -- basis case for the first tensor and we must show the property for all `t1` + intro b t1 + -- Define the property on the second tensor, with the first fixed to a basis vector. + let P1 : ℝT(3, c1) → Prop := fun t1' => + toComplex (c := Fin.append c c1) + (prodT (S := realLorentzTensor) + ((Tensor.basis (S := realLorentzTensor) c) b) t1') + = + prodTColorToComplex (c := c) (c1 := c1) + (toComplex (c := c) ((Tensor.basis (S := realLorentzTensor) c) b)) + (toComplex (c := c1) t1') + have hP1 : P1 t1 := by + -- Induction on the second tensor using the tensor basis. + apply + induction_on_basis + (c := c1) + (P := P1) + (t := t1) + · -- basis case for the second tensor + intro b1 + -- Unfold `P1` and compute both sides explicitly on pure basis tensors. + dsimp [P1] + simp (config := { failIfUnchanged := false }) + [prodTColorToComplex, + prodT_pure, + permT_pure, + Pure.prodP_basisVector, + Pure.permP_basisVector, + Tensor.basis_apply, + toComplex_pure_basisVector, + colorToComplex_append] + · -- zero tensor in the second argument + simp [P1, prodTColorToComplex] + · -- scalar multiplication in the second argument + intro r t1' ht' + dsimp [P1] at ht' ⊢ + refine (by + simp [map_smul, ht', prodTColorToComplex]) + · -- addition in the second argument + intro t1' t2' h1 h2 + dsimp [P1] at h1 h2 ⊢ + refine (by + simp [map_add, h1, h2, prodTColorToComplex]) + -- Apply the resulting property to `t1`. + exact hP1 + · -- zero tensor in the first argument + intro t1 + simp [prodTColorToComplex] + · -- scalar multiplication in the first argument + intro r t ht t1 + dsimp [P] at ht ⊢ + refine (by + simp [map_smul, ht, prodTColorToComplex]) + · -- addition in the first argument + intro t1 t2 h1 h2 t1' + dsimp [P] at h1 h2 ⊢ + refine (by + simp [map_add, h1 t1', h2 t1', prodTColorToComplex]) + -- Apply the resulting property to `t1`. + exact hP t1 + +/-! + +### E. Compatibility with contraction: `contrT` + +-/ + +/-- `τ` commutes with `colorToComplex` on the Lorentz `up/down` colors. -/ +@[simp] +lemma tau_colorToComplex (x : realLorentzTensor.Color) : + (complexLorentzTensor).τ (colorToComplex x) = colorToComplex ((realLorentzTensor).τ x) := by + cases x <;> rfl + +/-- `complexify` commutes with precomposition by `dropPairEmb`. + We use `fun k => b (Pure.dropPairEmb i j k)` and direct application + `(ComponentIdx.complexify b) (Pure.dropPairEmb i j m)` rather than composition so that + dependent `ComponentIdx` types unify correctly (avoiding `Function.comp` type mismatch). -/ +@[simp] +lemma ComponentIdx.complexify_comp_dropPairEmb + {n : ℕ} {c : Fin (n + 1 + 1) → realLorentzTensor.Color} + {i j : Fin (n + 1 + 1)} (b : ComponentIdx (S := realLorentzTensor) c) (m : Fin n) : + (ComponentIdx.complexify (c := c ∘ Pure.dropPairEmb i j) + (fun k => b (Pure.dropPairEmb i j k))) m = + (ComponentIdx.complexify (c := c) b) (Pure.dropPairEmb i j m) := by + simp only [ComponentIdx.complexify_apply, Function.comp_apply] + +/-- For a real basis vector, `toComplex(contrP(basisVector c b))` equals + `contrP(basisVector (colorToComplex ∘ c) (complexify b))` (complex species). -/ +lemma toComplex_contrP_basisVector {n : ℕ} {c : Fin (n + 1 + 1) → realLorentzTensor.Color} + {i j : Fin (n + 1 + 1)} (h : i ≠ j ∧ (realLorentzTensor).τ (c i) = c j) + (b : ComponentIdx (S := realLorentzTensor) c) : + toComplex (c := c ∘ Pure.dropPairEmb i j) + (Pure.contrP (S := realLorentzTensor) i j h (Pure.basisVector c b)) + = + Pure.contrP (S := complexLorentzTensor) i j + (by + simpa [Function.comp_apply] using And.intro h.1 + (by simpa [tau_colorToComplex] using congrArg colorToComplex h.2)) + (Pure.basisVector (colorToComplex ∘ c) (ComponentIdx.complexify b)) := by + let c' := c ∘ Pure.dropPairEmb i j + simp only [Pure.contrP] + rw [toComplex_map_smul c' (Pure.contrPCoeff i j h (Pure.basisVector c b)) + ((Pure.dropPair i j h.1 (Pure.basisVector c b)).toTensor), + Pure.dropPair_basisVector (c := c), + ← Tensor.basis_apply (S := realLorentzTensor) c' (fun k => b (Pure.dropPairEmb i j k)), + toComplex_basis (c := c') (i := fun k => b (Pure.dropPairEmb i j k))] + congr 1 + · -- contrPCoeff: real and complex both equal 0 or 1 with same condition + have h_real := realLorentzTensor.contr_basis (b i) (Fin.cast (by rw [h.2]) (b j)) + have h_complex := complexLorentzTensor.basis_contr ((colorToComplex ∘ c) i) + ((ComponentIdx.complexify b) i) + (Fin.cast (by simp [tau_colorToComplex, h.2]) ((ComponentIdx.complexify b) j)) + dsimp only [Pure.contrPCoeff] + simp only [Pure.basisVector] + erw [← realLorentzTensor.basis_congr (h.2) (Fin.cast (by rw [h.2]) (b j))] + have heq := (TensorSpecies.castToField_eq_self (S := realLorentzTensor) + (v := (realLorentzTensor.contr.app { as := c i }).hom + ((realLorentzTensor.basis (c i)) (b i) + ⊗ₜ[ℝ] (realLorentzTensor.basis (realLorentzTensor.τ (c i))) + (Fin.cast (by rw [h.2]) (b j))))).symm + have hcoeq : ↑((realLorentzTensor.contr.app { as := c i }).hom + ((realLorentzTensor.basis (c i)) (b i) + ⊗ₜ[ℝ] (realLorentzTensor.basis (realLorentzTensor.τ (c i))) + (Fin.cast (by rw [h.2]) (b j)))) = + ↑(realLorentzTensor.castToField ((realLorentzTensor.contr.app { as := c i }).hom + ((realLorentzTensor.basis (c i)) (b i) + ⊗ₜ[ℝ] (realLorentzTensor.basis (realLorentzTensor.τ (c i))) + (Fin.cast (by rw [h.2]) (b j))))) := congrArg (↑·) heq + erw [hcoeq, h_real] + erw [← complexLorentzTensor.basis_congr (by simp [tau_colorToComplex, h.2]) + (Fin.cast (by simp [tau_colorToComplex, h.2]) + ((ComponentIdx.complexify b) j))] + have hc := (TensorSpecies.castToField_eq_self (S := complexLorentzTensor) + (v := (complexLorentzTensor.contr.app { as := (colorToComplex ∘ c) i }).hom + ((complexLorentzTensor.basis ((colorToComplex ∘ c) i)) (ComponentIdx.complexify b i) + ⊗ₜ[ℂ] + (complexLorentzTensor.basis (complexLorentzTensor.τ ((colorToComplex ∘ c) i))) + (Fin.cast (by simp [tau_colorToComplex, h.2]) ((ComponentIdx.complexify b) j))))).symm + erw [hc, h_complex] + simp only [ComponentIdx.complexify_apply, Fin.val_cast]; split_ifs <;> rfl + · -- complexify(fun k => b (dropPairEmb k)) = (complexify b) ∘ dropPairEmb + conv_rhs => enter [1]; rw [Pure.dropPair_basisVector (S := complexLorentzTensor) + (c := colorToComplex ∘ c) h.1 (b := ComponentIdx.complexify b)] + conv_rhs => rw [← Tensor.basis_apply (S := complexLorentzTensor) + (c := (colorToComplex ∘ c) ∘ Pure.dropPairEmb i j) + (b := fun m => (ComponentIdx.complexify b) (Pure.dropPairEmb i j m))] + refine congr_arg _ (funext fun m => ComponentIdx.complexify_comp_dropPairEmb b m) + +/-- The map `toComplex` commutes with `contrT`. -/ +lemma contrT_toComplex {n : ℕ} + {c : Fin (n + 1 + 1) → realLorentzTensor.Color} {i j : Fin (n + 1 + 1)} + (h : i ≠ j ∧ (realLorentzTensor).τ (c i) = c j) (t : ℝT(3, c)) : + toComplex (c := c ∘ Pure.dropPairEmb i j) (contrT (S := realLorentzTensor) n i j h t) + = + contrT (S := complexLorentzTensor) n i j (by + simpa [Function.comp_apply] using + And.intro h.1 (by + simpa [tau_colorToComplex] using congrArg colorToComplex h.2)) + (toComplex (c := c) t) := by + classical + -- We prove the statement by induction on the tensor `t` using the tensor basis. + -- After contracting two indices, the resulting colour function lives on `Fin n`. + let c' : Fin n → realLorentzTensor.Color := c ∘ Pure.dropPairEmb i j + have hP : + ∀ t : ℝT(3, c), + toComplex (c := c') (contrT (S := realLorentzTensor) n i j h t) = + contrT (S := complexLorentzTensor) n i j + (by + -- transport the colour relation along `colorToComplex` + simpa [Function.comp_apply] using + And.intro h.1 + (by + simpa [tau_colorToComplex] using congrArg colorToComplex h.2)) + (toComplex (c := c) t) := by + intro t + -- Work with the property as a predicate for `induction_on_basis`. + let P : ℝT(3, c) → Prop := fun t => + toComplex (c := c') (contrT (S := realLorentzTensor) n i j h t) = + contrT (S := complexLorentzTensor) n i j + (by + simpa [Function.comp_apply] using + And.intro h.1 + (by + simpa [tau_colorToComplex] using congrArg colorToComplex h.2)) + (toComplex (c := c) t) + have hP' : P t := by + -- `induction_on_basis` over the tensor `t`. + apply + induction_on_basis + (c := c) + (P := P) + (t := t) + · -- basis case + intro b + -- (Tensor.basis c) b = (Pure.basisVector c b).toTensor; + -- then equate both sides via toComplex_contrP_basisVector. + rw [Tensor.basis_apply (S := realLorentzTensor) c b] + show toComplex (c := c') + (contrT (S := realLorentzTensor) n i j h ((Pure.basisVector c b).toTensor)) + = contrT (S := complexLorentzTensor) n i j _ + (toComplex (c := c) ((Pure.basisVector c b).toTensor)) + rw [contrT_pure (S := realLorentzTensor) (p := Pure.basisVector c b), + toComplex_pure_basisVector (c := c) b, + contrT_pure (S := complexLorentzTensor) + (p := Pure.basisVector (colorToComplex ∘ c) (ComponentIdx.complexify b))] + exact toComplex_contrP_basisVector h b + · -- zero tensor + dsimp [P] + simp + · -- scalar multiplication + intro r t ht + dsimp [P] at ht ⊢ + refine (by + simp [map_smul, ht]) + · -- addition + intro t1 t2 h1 h2 + dsimp [P] at h1 h2 ⊢ + refine (by + simp [map_add, h1, h2]) + exact hP' + exact hP t + +/-! + +### F. Compatibility with evaluation: `evalT` + +-/ + +/-- `complexify` commutes with precomposition by `succAbove`. -/ +@[simp] +lemma ComponentIdx.complexify_comp_succAbove + {n : ℕ} {c : Fin (n + 1) → realLorentzTensor.Color} (i : Fin (n + 1)) + (b : ComponentIdx (S := realLorentzTensor) c) (m : Fin n) : + (ComponentIdx.complexify (c := c ∘ i.succAbove) (fun k => b (i.succAbove k))) m = + (ComponentIdx.complexify (c := c) b) (i.succAbove m) := by + simp only [ComponentIdx.complexify_apply, Function.comp_apply] + +@[simp] +lemma complex_repDim_up : + (complexLorentzTensor).repDim complexLorentzTensor.Color.up = 4 := rfl + +@[simp] +lemma complex_repDim_down : + (complexLorentzTensor).repDim complexLorentzTensor.Color.down = 4 := rfl + +/-- Convert an evaluation index from the real repDim to the complex repDim. -/ +def evalIdxToComplex {n : ℕ} + {c : Fin (n + 1) → realLorentzTensor.Color} (i : Fin (n + 1)) + (b : Fin ((realLorentzTensor).repDim (c i))) : + Fin ((complexLorentzTensor).repDim ((colorToComplex ∘ c) i)) := + Fin.cast (by + cases hci : c i with + | up => + simp [hci, colorToComplex, Function.comp_apply, complex_repDim_up] + | down => + simp [hci, colorToComplex, Function.comp_apply, complex_repDim_down]) b + +/-- `evalT` on the complex side, but with output colors as `colorToComplex ∘ (c ∘ i.succAbove)`. +Implemented via `permT (σ := id) (by simp)` as a transport. -/ +noncomputable def evalTColorToComplex {n : ℕ} + {c : Fin (n + 1) → realLorentzTensor.Color} (i : Fin (n + 1)) + (b : Fin ((realLorentzTensor).repDim (c i))) : + ℂT(colorToComplex ∘ c) → ℂT(colorToComplex ∘ (c ∘ i.succAbove)) := + fun t => + permT (S := complexLorentzTensor) (σ := (id : Fin n → Fin n)) + (by + -- transport ((colorToComplex ∘ c) ∘ i.succAbove) and (colorToComplex ∘ (c ∘ i.succAbove)) + simp [Function.comp_apply]) + ((TensorSpecies.Tensor.evalT (S := complexLorentzTensor) (c := (colorToComplex ∘ c)) + i (evalIdxToComplex (c := c) i b)) t) + +/-- For a real basis vector, `toComplex(evalP(basisVector c b))` equals + `evalP(basisVector (colorToComplex ∘ c) (complexify b))` (complex species). -/ +lemma toComplex_evalP_basisVector {n : ℕ} {c : Fin (n + 1) → realLorentzTensor.Color} + (i : Fin (n + 1)) (b : Fin ((realLorentzTensor).repDim (c i))) + (b' : ComponentIdx (S := realLorentzTensor) c) : + toComplex (c := c ∘ i.succAbove) + (Pure.evalP (S := realLorentzTensor) i b (Pure.basisVector c b')) + = + permT (S := complexLorentzTensor) (σ := (id : Fin n → Fin n)) + (by simp [Function.comp_apply]) + (Pure.evalP (S := complexLorentzTensor) i (evalIdxToComplex (c := c) i b) + (Pure.basisVector (colorToComplex ∘ c) (ComponentIdx.complexify b'))) := by + simp only [Pure.evalP] + have hdrop : (Pure.basisVector c b').drop i = + Pure.basisVector (c ∘ i.succAbove) (fun k => b' (i.succAbove k)) := by + ext j; simp only [Pure.drop, Pure.basisVector, Function.comp_apply] + rw [hdrop, toComplex_map_smul (c ∘ i.succAbove) (Pure.evalPCoeff i b (Pure.basisVector c b')) + ((Pure.basisVector (c ∘ i.succAbove)) (fun k => b' (i.succAbove k)) |>.toTensor)] + · -- evalPCoeff: real and complex match; then tensor equality + simp only [Pure.evalPCoeff, Pure.basisVector, Basis.repr_self, Finsupp.single_apply, + ComponentIdx.complexify_apply, evalIdxToComplex] + · by_cases h : b' i = b + · simp [h] + have hdrop' : (Pure.basisVector (colorToComplex ∘ c) (ComponentIdx.complexify b')).drop i = + Pure.basisVector (colorToComplex ∘ (c ∘ i.succAbove)) + (ComponentIdx.complexify (c := c ∘ i.succAbove) (fun k => b' (i.succAbove k))) := by + ext j; simp only [Pure.drop, Pure.basisVector, ComponentIdx.complexify_apply, + Function.comp_apply] + rw [hdrop'] + exact (permT_id_self (S := complexLorentzTensor) (c := colorToComplex ∘ (c ∘ i.succAbove)) + (t := (Pure.basisVector (colorToComplex ∘ (c ∘ i.succAbove)) + (ComponentIdx.complexify (c := c ∘ i.succAbove) (fun k => b' + (i.succAbove k)))).toTensor)).symm + · simp [h] + +/-- The map `toComplex` commutes with `evalT`. -/ +lemma evalT_toComplex {n : ℕ} + {c : Fin (n + 1) → realLorentzTensor.Color} + (i : Fin (n + 1)) (b : Fin ((realLorentzTensor).repDim (c i))) (t : ℝT(3, c)) : + toComplex (c := c ∘ i.succAbove) + ((TensorSpecies.Tensor.evalT (S := realLorentzTensor) (c := c) i b) t) + = + evalTColorToComplex (c := c) i b (toComplex (c := c) t) := by + classical + let c' := c ∘ i.succAbove + let P : ℝT(3, c) → Prop := fun t => + toComplex (c := c') + ((TensorSpecies.Tensor.evalT (S := realLorentzTensor) (c := c) i b) t) = + evalTColorToComplex (c := c) i b (toComplex (c := c) t) + have hP : ∀ t, P t := by + intro t + apply induction_on_basis (c := c) (P := P) (t := t) + · intro b' + rw [Tensor.basis_apply (S := realLorentzTensor) c b'] + simp only [evalTColorToComplex, P] + rw [evalT_pure (S := realLorentzTensor) (p := Pure.basisVector c b'), + toComplex_pure_basisVector (c := c) b', + evalT_pure (S := complexLorentzTensor) + (p := Pure.basisVector (colorToComplex ∘ c) (ComponentIdx.complexify b'))] + exact toComplex_evalP_basisVector i b b' + · dsimp [P] + simp only [evalTColorToComplex, map_zero] + · intro r t' ht' + dsimp [P] at ht' ⊢ + rw [LinearMap.map_smul, toComplex_map_smul (c ∘ i.succAbove) r + ((evalT (S := realLorentzTensor) i b) t'), + ht', toComplex_map_smul (c := c) r t'] + simp only [evalTColorToComplex, LinearMap.map_smul] + · intro t1 t2 h1 h2 + dsimp [P] at h1 h2 ⊢ + rw [LinearMap.map_add, map_add, h1, h2] + simp only [evalTColorToComplex, LinearMap.map_add] + exact hP t end realLorentzTensor diff --git a/PhysLean/Relativity/Tensors/RealTensor/Vector/Basic.lean b/PhysLean/Relativity/Tensors/RealTensor/Vector/Basic.lean index 46076c0ca..699bb2ea5 100644 --- a/PhysLean/Relativity/Tensors/RealTensor/Vector/Basic.lean +++ b/PhysLean/Relativity/Tensors/RealTensor/Vector/Basic.lean @@ -4,8 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Matteo Cipollina, Joseph Tooby-Smith -/ import PhysLean.Relativity.Tensors.RealTensor.Metrics.Basic -import Mathlib.Geometry.Manifold.IsManifold.Basic import PhysLean.Relativity.Tensors.Elab +import Mathlib.Geometry.Manifold.IsManifold.Basic /-! # Lorentz Vectors @@ -37,23 +37,80 @@ open TensorSpecies open Tensor instance {d} : AddCommMonoid (Vector d) := - inferInstanceAs (AddCommMonoid (EuclideanSpace ℝ (Fin 1 ⊕ Fin d))) + inferInstanceAs (AddCommMonoid (Fin 1 ⊕ Fin d → ℝ)) instance {d} : Module ℝ (Vector d) := - inferInstanceAs (Module ℝ (EuclideanSpace ℝ (Fin 1 ⊕ Fin d))) + inferInstanceAs (Module ℝ (Fin 1 ⊕ Fin d → ℝ)) instance {d} : AddCommGroup (Vector d) := - inferInstanceAs (AddCommGroup (EuclideanSpace ℝ (Fin 1 ⊕ Fin d))) + inferInstanceAs (AddCommGroup (Fin 1 ⊕ Fin d → ℝ)) instance {d} : FiniteDimensional ℝ (Vector d) := inferInstanceAs (FiniteDimensional ℝ (Fin 1 ⊕ Fin d → ℝ)) -instance isNormedAddCommGroup (d : ℕ) : NormedAddCommGroup (Vector d) := - inferInstanceAs (NormedAddCommGroup (EuclideanSpace ℝ (Fin 1 ⊕ Fin d))) +/-- The equivalence between `Vector d` and `EuclideanSpace ℝ (Fin 1 ⊕ Fin d)`. -/ +def equivEuclid (d : ℕ) : + Vector d ≃ₗ[ℝ] EuclideanSpace ℝ (Fin 1 ⊕ Fin d) := + (WithLp.linearEquiv _ _ _).symm + +@[simp] +lemma equivEuclid_apply (d : ℕ) (v : Vector d) (i : Fin 1 ⊕ Fin d) : + equivEuclid d v i = v i := rfl -instance isNormedSpace (d : ℕ) : - NormedSpace ℝ (Vector d) := - inferInstanceAs (NormedSpace ℝ (EuclideanSpace ℝ (Fin 1 ⊕ Fin d))) +instance (d : ℕ) : Norm (Vector d) where + norm := fun v => ‖equivEuclid d v‖ + +lemma norm_eq_equivEuclid (d : ℕ) (v : Vector d) : + ‖v‖ = ‖equivEuclid d v‖ := rfl + +@[simp] +lemma abs_component_le_norm {d : ℕ} (v : Vector d) (i : Fin 1 ⊕ Fin d) : + |v i| ≤ ‖v‖ := by + simp [norm_eq_equivEuclid, PiLp.norm_eq_of_L2, -Fintype.sum_sum_type] + refine Real.abs_le_sqrt ?_ + trans ∑ j ∈ {i}, (v j) ^ 2 + · simp + refine Finset.sum_le_univ_sum_of_nonneg (fun i => by positivity) + +instance isNormedAddCommGroup (d : ℕ) : NormedAddCommGroup (Vector d) where + dist_self x := by simp [norm_eq_equivEuclid] + dist_comm x y := by + simpa [norm_eq_equivEuclid] using dist_comm ((equivEuclid d) x) _ + dist_triangle x y z := by + simpa [norm_eq_equivEuclid] using dist_triangle + ((equivEuclid d) x) ((equivEuclid d) y) ((equivEuclid d) z) + eq_of_dist_eq_zero {x y} := by + simp only [norm_eq_equivEuclid, map_sub] + intro h + apply (equivEuclid d).injective + exact (eq_of_dist_eq_zero h) + +instance isNormedSpace (d : ℕ) : NormedSpace ℝ (Vector d) where + norm_smul_le c v := by + simp only [norm_eq_equivEuclid, map_smul] + exact norm_smul_le c (equivEuclid d v) +open InnerProductSpace + +instance (d : ℕ) : Inner ℝ (Vector d) where + inner := fun v w => ⟪equivEuclid d v, equivEuclid d w⟫_ℝ + +lemma inner_eq_equivEuclid (d : ℕ) (v w : Vector d) : + ⟪v, w⟫_ℝ = ⟪equivEuclid d v, equivEuclid d w⟫_ℝ := rfl + +/-- The Euclidean inner product structure on `CoVector`. -/ +instance innerProductSpace (d : ℕ) : InnerProductSpace ℝ (Vector d) where + norm_sq_eq_re_inner v := by + simp only [inner_eq_equivEuclid, norm_eq_equivEuclid] + exact InnerProductSpace.norm_sq_eq_re_inner (equivEuclid d v) + conj_inner_symm x y := by + simp only [inner_eq_equivEuclid] + exact InnerProductSpace.conj_inner_symm (equivEuclid d x) (equivEuclid d y) + add_left x y z := by + simp only [inner_eq_equivEuclid, map_add] + exact InnerProductSpace.add_left (equivEuclid d x) (equivEuclid d y) (equivEuclid d z) + smul_left x y r := by + simp only [inner_eq_equivEuclid, map_smul] + exact InnerProductSpace.smul_left (equivEuclid d x) (equivEuclid d y) r /-- The instance of a `ChartedSpace` on `Vector d`. -/ instance : ChartedSpace (Vector d) (Vector d) := chartedSpaceSelf (Vector d) @@ -101,17 +158,99 @@ lemma zero_apply {d : ℕ} (i : Fin 1 ⊕ Fin d) : (0 : Vector d) i = 0 := rfl /-- The continuous linear map from a Lorentz vector to one of its coordinates. -/ -def coordCLM {d : ℕ} (i : Fin 1 ⊕ Fin d) : Vector d →L[ℝ] ℝ where +def coordCLM {d : ℕ} (i : Fin 1 ⊕ Fin d) : Vector d →L[ℝ] ℝ := LinearMap.toContinuousLinearMap { toFun v := v i map_add' := by simp - map_smul' := by simp - cont := by fun_prop + map_smul' := by simp} lemma coordCLM_apply {d : ℕ} (i : Fin 1 ⊕ Fin d) (v : Vector d) : coordCLM i v = v i := rfl +@[fun_prop] +lemma coord_continuous {d : ℕ} (i : Fin 1 ⊕ Fin d) : + Continuous (fun v : Vector d => v i) := + (coordCLM i).continuous + +@[fun_prop] +lemma coord_contDiff {n} {d : ℕ} (i : Fin 1 ⊕ Fin d) : + ContDiff ℝ n (fun v : Vector d => v i) := + (coordCLM i).contDiff + +@[fun_prop] +lemma coord_differentiable {d : ℕ} (i : Fin 1 ⊕ Fin d) : + Differentiable ℝ (fun v : Vector d => v i) := + (coordCLM i).differentiable + +@[fun_prop] +lemma coord_differentiableAt {d : ℕ} (i : Fin 1 ⊕ Fin d) (v : Vector d) : + DifferentiableAt ℝ (fun v : Vector d => v i) v := + (coordCLM i).differentiableAt + +/-- The continuous linear equivalence between `Vector d` and Euclidean space. -/ +def euclidCLE (d : ℕ) : Vector d ≃L[ℝ] EuclideanSpace ℝ (Fin 1 ⊕ Fin d) := + LinearEquiv.toContinuousLinearEquiv (equivEuclid d) + +/-- The continuous linear equivalence between `Vector d` and the corresponding `Pi` type. -/ +def equivPi (d : ℕ) : + Vector d ≃L[ℝ] Π (_ : Fin 1 ⊕ Fin d), ℝ := + LinearEquiv.toContinuousLinearEquiv (LinearEquiv.refl _ _) + @[simp] -lemma fderiv_apply {d : ℕ} (μ : Fin 1 ⊕ Fin d) (x : Vector d) : +lemma equivPi_apply {d : ℕ} (v : Vector d) (i : Fin 1 ⊕ Fin d) : + equivPi d v i = v i := rfl + +@[fun_prop] +lemma continuous_of_apply {d : ℕ} {α : Type*} [TopologicalSpace α] + (f : α → Vector d) + (h : ∀ i : Fin 1 ⊕ Fin d, Continuous (fun x => f x i)) : + Continuous f := by + rw [← (equivPi d).comp_continuous_iff] + apply continuous_pi + intro i + simp only [Function.comp_apply, equivPi_apply] + fun_prop + +lemma differentiable_apply {d : ℕ} {α : Type*} [NormedAddCommGroup α] [NormedSpace ℝ α] + (f : α → Vector d) : + (∀ i : Fin 1 ⊕ Fin d, Differentiable ℝ (fun x => f x i)) ↔ Differentiable ℝ f := by + apply Iff.intro + · intro h + rw [← (Lorentz.Vector.equivPi d).comp_differentiable_iff] + exact differentiable_pi'' h + · intro h ν + change Differentiable ℝ (Lorentz.Vector.coordCLM ν ∘ f) + apply Differentiable.comp + · fun_prop + · exact h + +lemma contDiff_apply {n : WithTop ℕ∞} {d : ℕ} {α : Type*} + [NormedAddCommGroup α] [NormedSpace ℝ α] + (f : α → Vector d) : + (∀ i : Fin 1 ⊕ Fin d, ContDiff ℝ n (fun x => f x i)) ↔ ContDiff ℝ n f := by + apply Iff.intro + · intro h + rw [← (Lorentz.Vector.equivPi d).comp_contDiff_iff] + apply contDiff_pi' + intro ν + exact h ν + · intro h ν + change ContDiff ℝ n (Lorentz.Vector.coordCLM ν ∘ f) + apply ContDiff.comp + · fun_prop + · exact h + +lemma fderiv_apply {d : ℕ} {α : Type*} + [NormedAddCommGroup α] [NormedSpace ℝ α] + (f : α → Vector d) (h : Differentiable ℝ f) + (x : α) (dt : α) (ν : Fin 1 ⊕ Fin d) : + fderiv ℝ f x dt ν = fderiv ℝ (fun y => f y ν) x dt := by + change _ = (fderiv ℝ (Lorentz.Vector.coordCLM ν ∘ f) x) dt + rw [fderiv_comp _ (by fun_prop) (by fun_prop)] + simp only [ContinuousLinearMap.fderiv, ContinuousLinearMap.coe_comp', Function.comp_apply] + rfl + +@[simp] +lemma fderiv_coord {d : ℕ} (μ : Fin 1 ⊕ Fin d) (x : Vector d) : fderiv ℝ (fun v : Vector d => v μ) x = coordCLM μ := by change fderiv ℝ (coordCLM μ) x = coordCLM μ simp @@ -245,6 +384,28 @@ lemma map_apply_eq_basis_mulVec {d : ℕ} (f : Vector d →ₗ[ℝ] Vector d) (p (f p) = (LinearMap.toMatrix basis basis) f *ᵥ p := by exact Eq.symm (LinearMap.toMatrix_mulVec_repr basis basis f p) +lemma sum_basis_eq_zero_iff {d : ℕ} (f : Fin 1 ⊕ Fin d → ℝ) : + (∑ μ, f μ • basis μ) = 0 ↔ ∀ μ, f μ = 0 := by + apply Iff.intro + · intro h + have h1 := (linearIndependent_iff').mp basis.linearIndependent Finset.univ f h + intro μ + exact h1 μ (by simp) + · intro h + simp [h] + +lemma sum_inl_inr_basis_eq_zero_iff {d : ℕ} (f₀ : ℝ) (f : Fin d → ℝ) : + f₀ • basis (Sum.inl 0) + (∑ i, f i • basis (Sum.inr i)) = 0 ↔ + f₀ = 0 ∧ ∀ i, f i = 0 := by + let f' : Fin 1 ⊕ Fin d → ℝ := fun μ => + match μ with + | Sum.inl 0 => f₀ + | Sum.inr i => f i + have h1 : f₀ • basis (Sum.inl 0) + (∑ i, f i • basis (Sum.inr i)) + = ∑ μ, f' μ • basis μ := by simp [f'] + rw [h1, sum_basis_eq_zero_iff] + simp [f'] + /-! ## The action of the Lorentz group @@ -327,6 +488,12 @@ lemma _root_.LorentzGroup.eq_of_action_vector_eq {d : ℕ} apply LorentzGroup.eq_of_mulVec_eq simpa only [smul_eq_mulVec] using fun x => h x +/-! + +## B. The continuous action of the Lorentz group + +-/ + /-- The Lorentz action on vectors as a continuous linear map. -/ def actionCLM {d : ℕ} (Λ : LorentzGroup d) : Vector d →L[ℝ] Vector d := @@ -347,6 +514,17 @@ def actionCLM {d : ℕ} (Λ : LorentzGroup d) : lemma actionCLM_apply {d : ℕ} (Λ : LorentzGroup d) (p : Vector d) : actionCLM Λ p = Λ • p := rfl +lemma actionCLM_injective {d : ℕ} (Λ : LorentzGroup d) : + Function.Injective (actionCLM Λ) := by + intro x1 x2 + simp [actionCLM_apply] + +lemma actionCLM_surjective {d : ℕ} (Λ : LorentzGroup d) : + Function.Surjective (actionCLM Λ) := by + intro x1 + use (actionCLM Λ⁻¹) x1 + simp [actionCLM_apply] + lemma smul_basis {d : ℕ} (Λ : LorentzGroup d) (μ : Fin 1 ⊕ Fin d) : Λ • basis μ = ∑ ν, Λ.1 ν μ • basis ν := by funext i @@ -359,14 +537,14 @@ lemma smul_basis {d : ℕ} (Λ : LorentzGroup d) (μ : Fin 1 ⊕ Fin d) : /-! -## Spatial part +## C. The Spatial part -/ /-- Extract spatial components from a Lorentz vector, returning them as a vector in Euclidean space. -/ abbrev spatialPart {d : ℕ} (v : Vector d) : EuclideanSpace ℝ (Fin d) := - fun i => v (Sum.inr i) + WithLp.toLp 2 fun i => v (Sum.inr i) lemma spatialPart_apply_eq_toCoord {d : ℕ} (v : Vector d) (i : Fin d) : spatialPart v i = v (Sum.inr i) := rfl @@ -374,16 +552,41 @@ lemma spatialPart_apply_eq_toCoord {d : ℕ} (v : Vector d) (i : Fin d) : lemma spatialPart_basis_sum_inr {d : ℕ} (i : Fin d) (j : Fin d) : spatialPart (basis (Sum.inr i)) j = (Finsupp.single (Sum.inr i : Fin 1 ⊕ Fin d) 1) (Sum.inr j) := by - simp [spatialPart, basis_apply] + simp [basis_apply] rw [Finsupp.single_apply] simp lemma spatialPart_basis_sum_inl {d : ℕ} (i : Fin d) : spatialPart (basis (Sum.inl 0)) i = 0 := by simp +/-- The spatial part of a Lorentz vector as a continuous linear map. -/ +def spatialCLM (d : ℕ) : Vector d →L[ℝ] EuclideanSpace ℝ (Fin d) where + toFun v := WithLp.toLp 2 fun i => v (Sum.inr i) + map_add' v1 v2 := by rfl + map_smul' c v := by rfl + cont := by fun_prop + +lemma spatialCLM_apply_eq_spatialPart {d : ℕ} (v : Vector d) (i : Fin d) : + spatialCLM d v i = spatialPart v i := rfl + +@[simp] +lemma spatialCLM_basis_sum_inl {d : ℕ} : + spatialCLM d (basis (Sum.inl 0)) = 0 := by + ext i + exact spatialPart_basis_sum_inl i + +@[simp] +lemma spatialCLM_basis_sum_inr {d : ℕ} (i : Fin d) : + spatialCLM d (basis (Sum.inr i)) = EuclideanSpace.basisFun (Fin d) ℝ i := by + ext j + rw [spatialCLM_apply_eq_spatialPart, spatialPart_basis_sum_inr i j] + simp [Finsupp.single_apply] + congr 1 + exact Eq.propIntro (fun a => id (Eq.symm a)) fun a => id (Eq.symm a) + /-! -## The time component +## The Temporal component -/ @@ -396,6 +599,27 @@ lemma timeComponent_basis_sum_inr {d : ℕ} (i : Fin d) : lemma timeComponent_basis_sum_inl {d : ℕ} : timeComponent (d := d) (basis (Sum.inl 0)) = 1 := by simp + +/-- The temporal part of a Lorentz vector as a continuous linear map. -/ +def temporalCLM (d : ℕ) : Vector d →L[ℝ] ℝ := + LinearMap.toContinuousLinearMap { + toFun := fun v => v (Sum.inl 0) + map_add' := by simp + map_smul' := by simp} + +lemma temporalCLM_apply_eq_timeComponent {d : ℕ} (v : Vector d) : + temporalCLM d v = timeComponent v := rfl + +@[simp] +lemma temporalCLM_basis_sum_inr {d : ℕ} (i : Fin d) : + temporalCLM d (basis (Sum.inr i)) = 0 := by + simp [temporalCLM_apply_eq_timeComponent, basis_apply] + +@[simp] +lemma temporalCLM_basis_sum_inl {d : ℕ} : + temporalCLM d (basis (Sum.inl 0)) = 1 := by + simp [temporalCLM_apply_eq_timeComponent, basis_apply] + /-! ## Smoothness @@ -406,6 +630,25 @@ open Manifold in /-- The structure of a smooth manifold on Vector . -/ def asSmoothManifold (d : ℕ) : ModelWithCorners ℝ (Vector d) (Vector d) := 𝓘(ℝ, Vector d) +/-! + +## Properties of the inner product (note not the Minkowski product) + +-/ +open InnerProductSpace + +lemma basis_inner {d : ℕ} (μ : Fin 1 ⊕ Fin d) (p : Lorentz.Vector d) : + ⟪Lorentz.Vector.basis μ, p⟫_ℝ = p μ := by + simp [inner_eq_equivEuclid] + rw [PiLp.inner_apply] + simp + +lemma inner_basis {d : ℕ} (p : Lorentz.Vector d) (μ : Fin 1 ⊕ Fin d) : + ⟪p, Lorentz.Vector.basis μ⟫_ℝ = p μ := by + simp [inner_eq_equivEuclid] + rw [PiLp.inner_apply] + simp + end Vector end Lorentz diff --git a/PhysLean/Relativity/Tensors/RealTensor/Vector/Causality/TimeLike.lean b/PhysLean/Relativity/Tensors/RealTensor/Vector/Causality/TimeLike.lean index 59b0d7dc1..cd62e135b 100644 --- a/PhysLean/Relativity/Tensors/RealTensor/Vector/Causality/TimeLike.lean +++ b/PhysLean/Relativity/Tensors/RealTensor/Vector/Causality/TimeLike.lean @@ -48,7 +48,7 @@ lemma timelike_time_dominates_space {d : ℕ} {v : Vector d} simp only [PiLp.inner_apply, RCLike.inner_apply, conj_trivial] have h_spatial_sum : ∑ x, spatialPart v x * spatialPart v x = ∑ i, v (Sum.inr i) * v (Sum.inr i) := by - simp only [spatialPart] + simp only have h_time : timeComponent v = v (Sum.inl 0) := rfl rw [h_spatial_sum, h_time] have h_norm_pos : 0 < v (Sum.inl 0) * v (Sum.inl 0) - diff --git a/PhysLean/Relativity/Tensors/RealTensor/Vector/Pre/Modules.lean b/PhysLean/Relativity/Tensors/RealTensor/Vector/Pre/Modules.lean index 6a938dd22..3e3bc43c9 100644 --- a/PhysLean/Relativity/Tensors/RealTensor/Vector/Pre/Modules.lean +++ b/PhysLean/Relativity/Tensors/RealTensor/Vector/Pre/Modules.lean @@ -188,7 +188,7 @@ def norm : NormedAddCommGroup (ContrMod d) where /-- The underlying space part of a `ContrMod` formed by removing the first element. A better name for this might be `tail`. -/ -def toSpace (v : ContrMod d) : EuclideanSpace ℝ (Fin d) := v.val ∘ Sum.inr +def toSpace (v : ContrMod d) : EuclideanSpace ℝ (Fin d) := WithLp.toLp 2 (v.val ∘ Sum.inr) /-! diff --git a/PhysLean/Relativity/Tensors/RealTensor/Velocity/Basic.lean b/PhysLean/Relativity/Tensors/RealTensor/Velocity/Basic.lean index fa78676c6..46cbe1331 100644 --- a/PhysLean/Relativity/Tensors/RealTensor/Velocity/Basic.lean +++ b/PhysLean/Relativity/Tensors/RealTensor/Velocity/Basic.lean @@ -82,7 +82,7 @@ lemma zero_le_minkowskiProduct (u v : Velocity d) : · simp · exact real_inner_le_norm u.1.spatialPart v.1.spatialPart -lemma one_add_minkowskiProduct_neq_zero (u v : Velocity d) : +lemma one_add_minkowskiProduct_ne_zero (u v : Velocity d) : 1 + ⟪u.1, v.1⟫ₘ ≠ 0 := by linarith [zero_le_minkowskiProduct u v] @@ -106,7 +106,7 @@ lemma minkowskiProduct_continuous_fst (u : Vector d) : -/ -/-- The `Velcoity d` which has all space components zero. -/ +/-- The `Velocity d` which has all space components zero. -/ noncomputable def zero : Velocity d := ⟨Vector.basis (Sum.inl 0), by simp [mem_iff, minkowskiMatrix.inl_0_inl_0]⟩ diff --git a/PhysLean/Relativity/Tensors/TensorSpecies/Basic.lean b/PhysLean/Relativity/Tensors/TensorSpecies/Basic.lean index f764daa6e..2888e9b97 100644 --- a/PhysLean/Relativity/Tensors/TensorSpecies/Basic.lean +++ b/PhysLean/Relativity/Tensors/TensorSpecies/Basic.lean @@ -133,6 +133,10 @@ set_option linter.unusedVariables false in def castToField {S : TensorSpecies k C G} (v : (↑((𝟙_ (Discrete C ⥤ Rep k G)).obj { as := c }).V)) : k := v +lemma castToField_eq_self {S : TensorSpecies k C G} {c} + (v : (↑((𝟙_ (Discrete C ⥤ Rep k G)).obj { as := c }).V)) : + S.castToField v = v := rfl + /-- Casts an element of `(S.F.obj (OverColor.mk c)).V` for `c` a map from `Fin 0` to an element of the field. -/ def castFin0ToField {c : Fin 0 → C} : (S.F.obj (OverColor.mk c)).V →ₗ[k] k := diff --git a/PhysLean/Relativity/Tensors/Tensorial.lean b/PhysLean/Relativity/Tensors/Tensorial.lean index 74a58f912..646c2f480 100644 --- a/PhysLean/Relativity/Tensors/Tensorial.lean +++ b/PhysLean/Relativity/Tensors/Tensorial.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Relativity.Tensors.Product +import Mathlib.Topology.Algebra.Module.FiniteDimension /-! # Tensorial class @@ -34,11 +35,16 @@ We define the class `Tensorial` here, and provide an API around its use. - B.1. Relation between the action and the equivalence to tensors - B.2. Linear properties of the action - B.3. The action as a linear map + - B.4. The SMulCommClass property - C. Properties of the basis - D. Products of tensorial instances - D.1. The equivalence to tensors on products - D.2. The group action on products - D.3. The basis on products +- E. Continuous properties + - E.1. Finite dimensionality + - E.2. The map to tensors as a continuous linear equivalence + - E.3. The Lorentz action as a continuous linear equivalence ## iv. References @@ -112,8 +118,10 @@ We now define the action of the group `G` on a type `M` carrying a tensorial ins -/ -noncomputable instance mulAction [Tensorial S c M] : MulAction G M where +noncomputable instance (priority := high) smulAction [Tensorial S c M] : SMul G M where smul g m := toTensor.symm (g • toTensor m) + +noncomputable instance mulAction [Tensorial S c M] : MulAction G M where one_smul m := by change toTensor.symm (1 • toTensor m) = _ simp @@ -150,22 +158,14 @@ lemma smul_toTensor_symm {g : G} {t : Tensor S c} [self : Tensorial S c M] : -/ -@[simp] -lemma smul_add {g : G} [Tensorial S c M] (m m' : M) : - g • (m + m') = g • m + g • m' := by - apply toTensor.injective - simp [toTensor_smul, map_add, Tensor.actionT_add] - -@[simp] -lemma smul_neg {n : ℕ} {c : Fin n → C} {M : Type} [AddCommGroup M] [Module k M] - [Tensorial S c M] (g : G) (m : M) : - g • (-m) = - (g • m) := toTensor.injective <| by - simp [toTensor_smul, map_neg, Tensor.actionT_neg] - -@[simp] -lemma smul_zero [Tensorial S c M] {g : G} : - g • (0 : M) = 0 := toTensor.injective <| by - simp [toTensor_smul, map_zero, Tensor.actionT_zero] +noncomputable instance (priority := high) distribMulAction [Tensorial S c M] : + DistribMulAction G M where + smul_add g m m' := by + apply toTensor.injective + simp [toTensor_smul, map_add, Tensor.actionT_add] + smul_zero g := by + apply toTensor.injective + simp only [toTensor_smul, map_zero, Tensor.actionT_zero] /-! @@ -188,6 +188,17 @@ lemma smulLinearMap_apply {g : G} [Tensorial S c M] (m : M) : /-! +### B.4. The SMulCommClass property + +-/ + +instance [Tensorial S c M] : SMulCommClass k G M where + smul_comm c g m := by + apply toTensor.injective + simp [toTensor_smul] + +/-! + ## C. Properties of the basis We now prove some properties of the basis induced on a `Tensorial` instance. @@ -205,7 +216,7 @@ lemma basis_toTensor_apply [Tensorial S c M] (m : M) : open TensorProduct -noncomputable instance prod [Tensorial S c M] {n2 : ℕ} {c2 : Fin n2 → C} +noncomputable instance (priority := high) prod [Tensorial S c M] {n2 : ℕ} {c2 : Fin n2 → C} {M₂ : Type} [AddCommMonoid M₂] [Module k M₂] [Tensorial S c2 M₂] : Tensorial S (Fin.append c c2) (M ⊗[k] M₂) where toTensor := (TensorProduct.congr toTensor toTensor).trans @@ -227,6 +238,7 @@ lemma toTensor_tprod {n2 : ℕ} {c2 : Fin n2 → C} {M₂ : Type} ### D.2. The group action on products -/ + lemma smul_prod {n2 : ℕ} {c2 : Fin n2 → C} {M₂ : Type} [Tensorial S c M] [AddCommMonoid M₂] [Module k M₂] [Tensorial S c2 M₂] (g : G) (m : M) (m2 : M₂) : @@ -260,4 +272,62 @@ lemma basis_map_prod {n2 : ℕ} {c2 : Fin n2 → C} {M₂ : Type} simp only [LinearEquiv.apply_symm_apply] rfl +/-! + +## E. Continuous properties + +-/ + +section Continuous + +variable {k : Type} [RCLike k] {C G : Type} [Group G] (S : TensorSpecies k C G) + {c : Fin n → C} {M : Type} [AddCommGroup M] [Module k M] + [TopologicalSpace M] + +/-! + +### E.1. Finite dimensionality + +-/ +instance [Tensorial S c M] : FiniteDimensional k M := LinearEquiv.finiteDimensional + (Tensorial.toTensor (M := M)).symm + +/-! + +### E.2. The map to tensors as a continuous linear equivalence + +-/ + +/-- The map from a type carrying an Tensorial instance to tensors, as a + continuous linear map. -/ +def toTensorCLM [IsTopologicalAddGroup M] + [ContinuousSMul k M] [Tensorial S c M] [T2Space M] : M ≃L[k] (S.Tensor c) where + toLinearMap := (Tensorial.toTensor (M := M)) + invFun := (Tensorial.toTensor (M := M)).symm + left_inv x := by simp + right_inv x := by simp + continuous_toFun := by + let e : M →L[k] (S.Tensor c) := LinearMap.toContinuousLinearMap + (Tensorial.toTensor (M := M)) + change Continuous e + exact ContinuousLinearMap.continuous e + continuous_invFun := by apply IsModuleTopology.continuous_of_linearMap + +/-! + +### E.3. The Lorentz action as a continuous linear equivalence + +-/ + +/-- The Lorentz action on types carrying a tensorial instance as a continuous linear + map. -/ +noncomputable def actionCLM (g : G) [IsTopologicalAddGroup M] + [ContinuousSMul k M] [Tensorial S c M] [T2Space M] : M →L[k] M := + LinearMap.toContinuousLinearMap (smulLinearMap g) + +lemma actionCLM_apply {g : G} [IsTopologicalAddGroup M] + [ContinuousSMul k M] [Tensorial S c M] [T2Space M] (m : M) : + actionCLM S g m = g • m := rfl + +end Continuous end Tensorial diff --git a/PhysLean/SpaceAndTime/Space/Basic.lean b/PhysLean/SpaceAndTime/Space/Basic.lean index 365a409da..097d66181 100644 --- a/PhysLean/SpaceAndTime/Space/Basic.lean +++ b/PhysLean/SpaceAndTime/Space/Basic.lean @@ -8,7 +8,8 @@ import PhysLean.Meta.TODO.Basic import PhysLean.Meta.Linters.Sorry import Mathlib.Topology.ContinuousMap.CompactlySupported import Mathlib.Geometry.Manifold.IsManifold.Basic -import Mathlib.MeasureTheory.Measure.Haar.InnerProductSpace +import Mathlib.MeasureTheory.Measure.Lebesgue.VolumeOfBalls +import Mathlib.Analysis.InnerProductSpace.Calculus /-! # Space @@ -33,29 +34,368 @@ TODO "HB6RR" "In the above documentation describe the notion of a type, and TODO "HB6VC" "Convert `Space` from an `abbrev` to a `def`." /-- The type `Space d` represents `d` dimensional Euclidean space. - The default value of `d` is `3`. Thus `Space = Space 3`. + The default value of `d` is `3`. Thus `Space = Space 3`. -/ +structure Space (d : ℕ := 3) where + /-- The underlying map `Fin d → ℝ` associated with a point in `Space`. -/ + val : Fin d → ℝ + +namespace Space + +lemma eq_of_val {d} {p q : Space d} (h : p.val = q.val) : + p = q := by + cases p + cases q + congr + +@[simp] +lemma val_eq_iff {d} {p q : Space d} : + p.val = q.val ↔ p = q := by + apply Iff.intro + · exact eq_of_val + · intro h + rw [h] + +/-! + +## B. Instances on `Space` -/ -abbrev Space (d : ℕ := 3) := EuclideanSpace ℝ (Fin d) -namespace Space +/-! + +## B.1. Instance of coercion to functions + +-/ + +instance {d} : CoeFun (Space d) (fun _ => Fin d → ℝ) where + coe p := p.val + +@[ext] +lemma eq_of_apply {d} {p q : Space d} + (h : ∀ i : Fin d, p i = q i) : p = q := by + apply eq_of_val + funext i + exact h i + +/-! + +## B.1. Instance of an additive commutative monoid + +-/ + +instance {d} : Add (Space d) where + add p q := ⟨fun i => p.val i + q.val i⟩ + +@[simp] +lemma add_val {d: ℕ} (x y : Space d) : + (x + y).val = x.val + y.val := rfl + +@[simp] +lemma add_apply {d : ℕ} (x y : Space d) (i : Fin d) : + (x + y) i = x i + y i := by + simp [add_val] + +instance {d} : Zero (Space d) where + zero := ⟨fun _ => 0⟩ + +@[simp] +lemma zero_val {d : ℕ} : (0 : Space d).val = fun _ => 0 := rfl + +@[simp] +lemma zero_apply {d : ℕ} (i : Fin d) : + (0 : Space d) i = 0 := by + simp [zero_val] + +instance {d} : AddCommMonoid (Space d) where + add_assoc a b c:= by + apply eq_of_val + simp only [add_val] + ring + zero_add a := by + apply eq_of_val + simp only [zero_val, add_val, add_eq_right] + rfl + add_zero a := by + apply eq_of_val + simp only [zero_val, add_val, add_eq_left] + rfl + add_comm a b := by + apply eq_of_val + simp only [add_val] + ring + nsmul n a := ⟨fun i => n • a.val i⟩ + +@[simp] +lemma nsmul_val {d : ℕ} (n : ℕ) (a : Space d) : + (n • a).val = fun i => n • a.val i := rfl + +@[simp] +lemma nsmul_apply {d : ℕ} (n : ℕ) (a : Space d) (i : Fin d) : + (n • a) i = n • (a i) := by rfl + +/-! + +## B.2. Instance of a module over `ℝ` + +-/ + +instance {d} : SMul ℝ (Space d) where + smul c p := ⟨fun i => c * p.val i⟩ + +@[simp] +lemma smul_val {d : ℕ} (c : ℝ) (p : Space d) : + (c • p).val = fun i => c * p.val i := rfl + +@[simp] +lemma smul_apply {d : ℕ} (c : ℝ) (p : Space d) (i : Fin d) : + (c • p) i = c * (p i) := by rfl + +instance {d} : Module ℝ (Space d) where + one_smul x := by + ext i + simp + mul_smul a b x := by + ext i + simp only [smul_apply] + ring + smul_add a x y := by + ext i + simp only [smul_apply, add_apply] + ring + smul_zero a := by + ext i + simp + add_smul a b x := by + ext i + simp only [smul_apply, add_apply] + ring + zero_smul x := by + ext i + simp /-! -## Basic operations on `Space`. +## B.3. Addition of Euclidean spaces -/ + +noncomputable instance : VAdd (EuclideanSpace ℝ (Fin d)) (Space d) where + vadd v s := ⟨fun i => v i + s.val i⟩ + +@[simp] +lemma vadd_val {d} (v : EuclideanSpace ℝ (Fin d)) (s : Space d) : + (v +ᵥ s).val = fun i => v i + s.val i := rfl + +@[simp] +lemma vadd_apply {d} (v : EuclideanSpace ℝ (Fin d)) + (s : Space d) (i : Fin d) : + (v +ᵥ s) i = v i + s i := by rfl + +lemma vadd_transitive {d} (s1 s2 : Space d) : + ∃ v : EuclideanSpace ℝ (Fin d), v +ᵥ s1 = s2 := by + use WithLp.toLp 2 fun i => s2 i - s1 i + ext i + simp + +lemma eq_vadd_zero {d} (s : Space d) : + ∃ v : EuclideanSpace ℝ (Fin d), s = v +ᵥ (0 : Space d) := by + obtain ⟨v, h⟩ := vadd_transitive 0 s + use v + rw [h] + +@[simp] +lemma smul_vadd_zero {d} (k : ℝ) (v : EuclideanSpace ℝ (Fin d)) : + k • (v +ᵥ (0 : Space d)) = (k • v) +ᵥ (0 : Space d) := by + ext i + simp + +noncomputable instance : AddAction (EuclideanSpace ℝ (Fin d)) (Space d) where + zero_vadd s := by + ext i + simp + add_vadd v1 v2 s := by + ext i + simp only [vadd_apply, PiLp.add_apply] + ring + +@[simp] +lemma add_vadd_zero {d} (v1 v2 : EuclideanSpace ℝ (Fin d)) : + (v1 +ᵥ (0 : Space d)) + (v2 +ᵥ (0 : Space d)) = (v1 + v2) +ᵥ (0 : Space d) := by + ext i + simp + /-! -## Instances on `Space` +## B.3. Instance of an inner product space -/ +noncomputable instance {d} : Norm (Space d) where + norm p := √ (∑ i, (p i)^2) + +lemma norm_eq {d} (p : Space d) : ‖p‖ = √ (∑ i, (p i) ^ 2) := by + rfl + +@[simp] +lemma abs_eval_le_norm {d} (p : Space d) (i : Fin d) : + |p i| ≤ ‖p‖ := by + simp [norm_eq] + refine Real.abs_le_sqrt ?_ + trans ∑ j ∈ {i}, (p j) ^ 2 + · simp + refine Finset.sum_le_univ_sum_of_nonneg (fun i => by positivity) + +lemma norm_sq_eq {d} (p : Space d) : + ‖p‖ ^ 2 = ∑ i, (p i) ^ 2 := by + rw [norm_eq] + refine Real.sq_sqrt ?_ + positivity + +lemma point_dim_zero_eq (p : Space 0) : p = 0 := by + ext i + fin_cases i + +@[simp] +lemma norm_vadd_zero {d} (v : EuclideanSpace ℝ (Fin d)) : + ‖v +ᵥ (0 : Space d)‖ = ‖v‖ := by + simp [norm_eq, PiLp.norm_eq_of_L2] + +instance : Neg (Space d) where + neg p := ⟨fun i => - (p.val i)⟩ + +@[simp] +lemma neg_val {d : ℕ} (p : Space d) : + (-p).val = fun i => - (p.val i) := rfl + +@[simp] +lemma neg_apply {d : ℕ} (p : Space d) (i : Fin d) : + (-p) i = - (p i) := by rfl + +noncomputable instance {d} : AddCommGroup (Space d) where + zsmul z p := ⟨fun i => z * p.val i⟩ + neg_add_cancel p := by + ext i + simp + zsmul_zero' p := by + ext i + simp + zsmul_succ' n p := by + ext i + simp only [Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one, Int.cast_add, Int.cast_natCast, + Int.cast_one, add_apply] + ring + zsmul_neg' n p := by + ext i + simp only [Int.cast_negSucc, Nat.cast_add, Nat.cast_one, neg_add_rev, Nat.succ_eq_add_one, + Int.cast_add, Int.cast_natCast, Int.cast_one, neg_apply] + ring + +@[simp] +lemma sub_apply {d} (p q : Space d) (i : Fin d) : + (p - q) i = p i - q i := by + simp [sub_eq_add_neg, neg_apply, add_apply] + +@[simp] +lemma sub_val {d} (p q : Space d) : + (p - q).val = fun i => p.val i - q.val i := by rfl + +@[simp] +lemma vadd_zero_sub_vadd_zero {d} (v1 v2 : EuclideanSpace ℝ (Fin d)) : + (v1 +ᵥ (0 : Space d)) - (v2 +ᵥ (0 : Space d)) = (v1 - v2) +ᵥ (0 : Space d) := by + ext i + simp [sub_apply, vadd_apply] + +noncomputable instance {d} : SeminormedAddCommGroup (Space d) where + dist_self x := by + simp [norm_eq] + dist_comm x y := by + simp [norm_eq] + congr + funext i + ring + dist_triangle := by + intros x y z + obtain ⟨v1, rfl⟩ := eq_vadd_zero x + obtain ⟨v2, rfl⟩ := eq_vadd_zero y + obtain ⟨v3, rfl⟩ := eq_vadd_zero z + simp [vadd_zero_sub_vadd_zero, norm_vadd_zero] + exact norm_sub_le_norm_sub_add_norm_sub v1 v2 v3 + +@[simp] +lemma dist_eq {d} (p q : Space d) : + dist p q = ‖p - q‖ := by + rfl + +noncomputable instance : NormedAddCommGroup (Space d) where + eq_of_dist_eq_zero := by + intro x y h + simp at h + obtain ⟨v1, rfl⟩ := eq_vadd_zero x + obtain ⟨v2, rfl⟩ := eq_vadd_zero y + simp only [vadd_zero_sub_vadd_zero, norm_vadd_zero] at h + congr + exact eq_of_dist_eq_zero h + +instance {d} : Inner ℝ (Space d) where + inner p q := ∑ i, p i * q i + +@[simp] +lemma inner_vadd_zero {d} (v1 v2 : EuclideanSpace ℝ (Fin d)) : + inner ℝ (v1 +ᵥ (0 : Space d)) (v2 +ᵥ (0 : Space d)) = Inner.inner ℝ v1 v2 := by + simp [inner, vadd_apply] + apply Finset.sum_congr rfl + intro i hi + ring + +lemma inner_apply {d} (p q : Space d) : + inner ℝ p q = ∑ i, p i * q i := by rfl + +instance {d} : InnerProductSpace ℝ (Space d) where + norm_smul_le a x := by + obtain ⟨v, rfl⟩ := eq_vadd_zero x + simp only [smul_vadd_zero, norm_vadd_zero, Real.norm_eq_abs] + exact norm_smul_le a v + norm_sq_eq_re_inner x := by + obtain ⟨v, rfl⟩ := eq_vadd_zero x + simp + conj_inner_symm x y := by + simp [inner_apply] + congr + funext i + ring + add_left x y z := by + obtain ⟨v1, rfl⟩ := eq_vadd_zero x + obtain ⟨v2, rfl⟩ := eq_vadd_zero y + obtain ⟨v3, rfl⟩ := eq_vadd_zero z + simp only [add_vadd_zero, inner_vadd_zero] + exact InnerProductSpace.add_left v1 v2 v3 + smul_left x y a := by + obtain ⟨v1, rfl⟩ := eq_vadd_zero x + obtain ⟨v2, rfl⟩ := eq_vadd_zero y + simp only [smul_vadd_zero, inner_vadd_zero, conj_trivial] + exact InnerProductSpace.smul_left v1 v2 a + +/-! + +## B.4. Instance of a measurable space + +-/ + +instance {d : ℕ} : MeasurableSpace (Space d) := borel (Space d) + +instance {d : ℕ} : BorelSpace (Space d) where + measurable_eq := by rfl + TODO "HB6YZ" "In the above documentation describe what an instance is, and why it is useful to have instances for `Space d`." TODO "HB6WN" "After TODO 'HB6VC', give `Space d` the necessary instances using `inferInstanceAs`." +/-! + +## The norm on `Space` + +-/ /-! @@ -65,15 +405,22 @@ TODO "HB6WN" "After TODO 'HB6VC', give `Space d` the necessary instances lemma inner_eq_sum {d} (p q : Space d) : inner ℝ p q = ∑ i, p i * q i := by - simp only [PiLp.inner_apply, RCLike.inner_apply, conj_trivial] - congr - funext x - exact Lean.Grind.CommSemiring.mul_comm (q x) (p x) + simp [inner] @[simp] lemma sum_apply {ι : Type} [Fintype ι] (f : ι → Space d) (i : Fin d) : (∑ x, f x) i = ∑ x, f x i := by - erw [Finset.sum_apply] + let P (ι : Type) [Fintype ι] : Prop := ∀ (f : ι → Space d) (i : Fin d), (∑ x, f x) i = ∑ x, f x i + have h1 : P ι := by + apply Fintype.induction_empty_option + · intro α β h e h f i + rw [← @e.sum_comp _, h, ← @e.sum_comp _] + · simp [P] + · intro α _ h f i + simp only [Fintype.sum_option, add_apply, add_right_inj] + rw [h] + exact h1 f i + /-! ## Basis @@ -84,12 +431,42 @@ TODO "HB6Z4" "In the above documentation describe the notion of a basis in Lean." /-- The standard basis of Space based on `Fin d`. -/ -noncomputable def basis {d} : OrthonormalBasis (Fin d) ℝ (Space d) := - EuclideanSpace.basisFun (Fin d) ℝ +noncomputable def basis {d} : OrthonormalBasis (Fin d) ℝ (Space d) where + repr := { + toFun p := WithLp.toLp 2 fun i => p i + invFun := fun v => ⟨v⟩ + left_inv := by + intro p + rfl + right_inv := by + intro v + rfl + map_add' := by + intro v1 v2 + rfl + map_smul' := by + intro c v + rfl + norm_map' := by + intro x + simp [norm_eq, PiLp.norm_eq_of_L2]} + +lemma apply_eq_basis_repr_apply {d} (p : Space d) (i : Fin d) : + p i = basis.repr p i := by + simp [basis] + +@[simp] +lemma basis_repr_apply {d} (p : Space d) (i : Fin d) : + basis.repr p i = p i := by + simp [apply_eq_basis_repr_apply] + +@[simp] +lemma basis_repr_symm_apply {d} (v : EuclideanSpace ℝ (Fin d)) (i : Fin d) : + basis.repr.symm v i = v i := by rfl lemma basis_apply {d} (i j : Fin d) : basis i j = if i = j then 1 else 0 := by - simp [basis, EuclideanSpace.basisFun_apply] + simp [apply_eq_basis_repr_apply] congr 1 exact Lean.Grind.eq_congr' rfl rfl @@ -97,9 +474,6 @@ lemma basis_apply {d} (i j : Fin d) : lemma basis_self {d} (i : Fin d) : basis i i = 1 := by simp [basis_apply] -@[simp] -lemma basis_repr {d} (p : Space d) : basis.repr p = p := by rfl - @[simp high] lemma inner_basis {d} (p : Space d) (i : Fin d) : inner ℝ p (basis i) = p i := by @@ -110,6 +484,35 @@ lemma basis_inner {d} (i : Fin d) (p : Space d) : inner ℝ (basis i) p = p i := by simp [inner_eq_sum, basis_apply] +open InnerProductSpace + +lemma basis_repr_inner_eq {d} (p : Space d) (v : EuclideanSpace ℝ (Fin d)) : + ⟪basis.repr p, v⟫_ℝ = ⟪p, basis.repr.symm v⟫_ℝ := by + exact LinearIsometryEquiv.inner_map_eq_flip basis.repr p v + +instance {d : ℕ} : FiniteDimensional ℝ (Space d) := + Module.Basis.finiteDimensional_of_finite (h := basis.toBasis) + +@[simp] +lemma finrank_eq_dim {d : ℕ} : Module.finrank ℝ (Space d) = d := by + simp [Module.finrank_eq_nat_card_basis (basis.toBasis)] + +@[simp] +lemma rank_eq_dim {d : ℕ} : Module.rank ℝ (Space d) = d := by + simp [rank_eq_card_basis (basis.toBasis)] + +@[simp] +lemma fderiv_basis_repr {d} (p : Space d) : + fderiv ℝ basis.repr p = basis.repr.toContinuousLinearMap := by + change fderiv ℝ basis.repr.toContinuousLinearMap p = _ + rw [ContinuousLinearMap.fderiv] + +@[simp] +lemma fderiv_basis_repr_symm {d} (v : EuclideanSpace ℝ (Fin d)) : + fderiv ℝ basis.repr.symm v = basis.repr.symm.toContinuousLinearMap := by + change fderiv ℝ basis.repr.symm.toContinuousLinearMap v = _ + rw [ContinuousLinearMap.fderiv] + /-! ## Coordinates @@ -151,119 +554,57 @@ lemma coordCLM_apply (μ : Fin d) (p : Space d) : @[inherit_doc coord] scoped notation "𝔁" => coord -/-! - -## Derivatives - --/ - -TODO "HB63O" "In the above documentation describe the different notions - of a derivative in Lean." - -/-- Given a function `f : Space d → M` the derivative of `f` in direction `μ`. -/ -noncomputable def deriv {M d} [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] - (μ : Fin d) (f : Space d → M) : Space d → M := - (fun x => fderiv ℝ f x (EuclideanSpace.single μ (1:ℝ))) - -@[inherit_doc deriv] -macro "∂[" i:term "]" : term => `(deriv $i) - -lemma deriv_eq [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] - (μ : Fin d) (f : Space d → M) (x : Space d) : - deriv μ f x = fderiv ℝ f x (EuclideanSpace.single μ (1:ℝ)) := by - rfl - -lemma deriv_eq_fderiv_basis [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] - (μ : Fin d) (f : Space d → M) (x : Space d) : - deriv μ f x = fderiv ℝ f x (basis μ) := by - rw [deriv_eq] - congr 1 - funext i - simp only [EuclideanSpace.single_apply, basis_apply] - congr 1 - exact Lean.Grind.eq_congr' rfl rfl - -/-! - -## Gradient - --/ - -/-- The vector calculus operator `grad`. -/ -noncomputable def grad {d} (f : Space d → ℝ) : - Space d → EuclideanSpace ℝ (Fin d) := fun x i => ∂[i] f x - -@[inherit_doc grad] -scoped[Space] notation "∇" => grad - -/-! - -## Curl - --/ - -/-- The vector calculus operator `curl`. -/ -noncomputable def curl (f : Space → EuclideanSpace ℝ (Fin 3)) : - Space → EuclideanSpace ℝ (Fin 3) := fun x => - -- get i-th component of `f` - let fi i x := coord i (f x) - -- derivative of i-th component in j-th coordinate - -- ∂fᵢ/∂xⱼ - let df i j x := ∂[j] (fi i) x - fun i => - match i with - | 0 => df 2 1 x - df 1 2 x - | 1 => df 0 2 x - df 2 0 x - | 2 => df 1 0 x - df 0 1 x - -@[inherit_doc curl] -macro (name := curlNotation) "∇" "×" f:term:100 : term => `(curl $f) - -/-! - -## Div - --/ - -/-- The vector calculus operator `div`. -/ -noncomputable def div {d} (f : Space d → EuclideanSpace ℝ (Fin d)) : - Space d → ℝ := fun x => - -- get i-th component of `f` - let fi i x := coord i (f x) - -- derivative of i-th component in i-th coordinate - -- ∂fᵢ/∂xⱼ - let df i x := ∂[i] (fi i) x - ∑ i, df i x - -@[inherit_doc div] -macro (name := divNotation) "∇" "⬝" f:term:100 : term => `(div $f) +@[fun_prop] +lemma eval_continuous {d} (i : Fin d) : + Continuous (fun p : Space d => p i) := by + convert (coordCLM i).continuous + simp [coordCLM_apply, coord] -/-! +@[fun_prop] +lemma eval_differentiable {d} (i : Fin d) : + Differentiable ℝ (fun p : Space d => p i) := by + convert (coordCLM i).differentiable + simp [coordCLM_apply, coord] -## Laplacians +@[fun_prop] +lemma eval_contDiff {d n} (i : Fin d) : + ContDiff ℝ n (fun p : Space d => p i) := by + convert (coordCLM i).contDiff + simp [coordCLM_apply, coord] + +/-- The continuous linear equivalence between `Space d` and the corresponding `Pi` type. -/ +def equivPi (d : ℕ) : + Space d ≃L[ℝ] Π (_ : Fin d), ℝ := LinearEquiv.toContinuousLinearEquiv <| + { + toFun := fun p i => p i + map_add' p1 p2 := by funext i; simp + map_smul' p r := by funext i; simp + invFun := fun f => ⟨f⟩ + } --/ +@[fun_prop] +lemma mk_continuous {d : ℕ} : + Continuous (fun (f : Fin d → ℝ) => (⟨f⟩ : Space d)) := (equivPi d).symm.continuous -/-- The scalar `laplacian` operator. -/ -noncomputable def laplacian {d} (f : Space d → ℝ) : - Space d → ℝ := fun x => - -- second derivative of f in i-th coordinate - -- ∂²f/∂xᵢ² - let df2 i x := ∂[i] (∂[i] f) x - ∑ i, df2 i x +@[fun_prop] +lemma mk_differentiable {d : ℕ} : + Differentiable ℝ (fun (f : Fin d → ℝ) => (⟨f⟩ : Space d)) := (equivPi d).symm.differentiable -@[inherit_doc laplacian] -scoped[Space] notation "Δ" => laplacian +@[fun_prop] +lemma mk_contDiff {d n : ℕ} : + ContDiff ℝ n (fun (f : Fin d → ℝ) => (⟨f⟩ : Space d)) := (equivPi d).symm.contDiff -/-- The vector `laplacianVec` operator. -/ -noncomputable def laplacianVec {d} (f : Space d → EuclideanSpace ℝ (Fin d)) : - Space d → EuclideanSpace ℝ (Fin d) := fun x i => - -- get i-th component of `f` - let fi i x := coord i (f x) - Δ (fi i) x +@[simp] +lemma fderiv_mk {d : ℕ} (f : Fin d → ℝ) : + fderiv ℝ Space.mk f = (equivPi d).symm := by + change fderiv ℝ (equivPi d).symm f = _ + rw [@ContinuousLinearEquiv.fderiv] -@[inherit_doc laplacianVec] -scoped[Space] notation "Δ" => laplacianVec +@[simp] +lemma fderiv_val {d : ℕ} (p : Space d) : + fderiv ℝ Space.val p = (equivPi d) := by + change fderiv ℝ (equivPi d) p = _ + rw [@ContinuousLinearEquiv.fderiv] /-! @@ -274,20 +615,19 @@ scoped[Space] notation "Δ" => laplacianVec /-- Notion of direction where `unit` returns a unit vector in the direction specified. -/ structure Direction (d : ℕ := 3) where /-- Unit vector specifying the direction. -/ - unit : EuclideanSpace ℝ (Fin d) + unit : Space d norm : ‖unit‖ = 1 /-- Direction of a `Space` value with respect to the origin. -/ noncomputable def toDirection {d : ℕ} (x : Space d) (h : x ≠ 0) : Direction d where - unit := (‖x‖⁻¹) • (x) + unit := (‖x‖⁻¹) • x norm := norm_smul_inv_norm h @[simp] lemma direction_unit_sq_sum {d} (s : Direction d) : ∑ i : Fin d, (s.unit i) ^ 2 = 1 := by trans (‖s.unit‖) ^ 2 - · rw [PiLp.norm_sq_eq_of_L2] - simp + · rw [norm_sq_eq] · rw [s.norm] simp @@ -300,16 +640,16 @@ lemma direction_unit_sq_sum {d} (s : Direction d) : /-- The linear isometric equivalence between `Space 1` and `ℝ`. -/ noncomputable def oneEquiv : Space 1 ≃ₗᵢ[ℝ] ℝ where toFun x := x 0 - invFun x := fun _ => x - left_inv x := by funext i; fin_cases i; simp + invFun x := ⟨fun _ => x⟩ + left_inv x := by + ext i; fin_cases i; simp right_inv x := by simp map_add' x y := by rfl map_smul' c x := by rfl norm_map' x := by simp only [Fin.isValue, LinearEquiv.coe_mk, LinearMap.coe_mk, AddHom.coe_mk, Real.norm_eq_abs] - rw [@PiLp.norm_eq_of_L2] - simp only [Fin.isValue, Finset.univ_unique, Fin.default_eq_zero, Real.norm_eq_abs, sq_abs, - Finset.sum_singleton] + rw [norm_eq] + simp only [Fin.isValue, Finset.univ_unique, Fin.default_eq_zero, Finset.sum_singleton] exact Eq.symm (Real.sqrt_sq_eq_abs (x 0)) lemma oneEquiv_coe : @@ -317,7 +657,7 @@ lemma oneEquiv_coe : rfl lemma oneEquiv_symm_coe : - (oneEquiv.symm : ℝ → Space 1) = fun x => fun _ => x := by + (oneEquiv.symm : ℝ → Space 1) = (fun x => ⟨fun _ => x⟩) := by rfl lemma oneEquiv_symm_apply (x : ℝ) (i : Fin 1) : @@ -336,7 +676,7 @@ lemma oneEquiv_symm_continuous : fun_prop /-- The continuous linear equivalence between `Space 1` and `ℝ`. -/ -noncomputable def oneEquivCLE : EuclideanSpace ℝ (Fin 1) ≃L[ℝ] ℝ where +noncomputable def oneEquivCLE : Space 1 ≃L[ℝ] ℝ where toLinearEquiv := oneEquiv continuous_toFun := by simp only [AddHom.toFun_eq_coe, LinearMap.coe_toAddHom, LinearEquiv.coe_coe] @@ -354,7 +694,7 @@ lemma oneEquiv_measurableEmbedding : MeasurableEmbedding oneEquiv where measurableSet_image' := by intro s hs change MeasurableSet (⇑oneEquivCLE '' s) - rw [ContinuousLinearEquiv.image_eq_preimage] + rw [ContinuousLinearEquiv.image_eq_preimage_symm] exact oneEquiv.symm.continuous.measurable hs lemma oneEquiv_symm_measurableEmbedding : MeasurableEmbedding oneEquiv.symm where @@ -363,7 +703,7 @@ lemma oneEquiv_symm_measurableEmbedding : MeasurableEmbedding oneEquiv.symm wher measurableSet_image' := by intro s hs change MeasurableSet (⇑oneEquivCLE.symm '' s) - rw [ContinuousLinearEquiv.image_eq_preimage] + rw [ContinuousLinearEquiv.image_eq_preimage_symm] exact oneEquiv.continuous.measurable hs lemma oneEquiv_measurePreserving : MeasurePreserving oneEquiv volume volume := @@ -372,4 +712,83 @@ lemma oneEquiv_measurePreserving : MeasurePreserving oneEquiv volume volume := lemma oneEquiv_symm_measurePreserving : MeasurePreserving oneEquiv.symm volume volume := by exact LinearIsometryEquiv.measurePreserving oneEquiv.symm +lemma volume_eq_addHaar {d} : (volume (α := Space d)) = Space.basis.toBasis.addHaar := by + exact (OrthonormalBasis.addHaar_eq_volume _).symm + +instance {d : ℕ} : Nontrivial (Space d.succ) := by + refine { exists_pair_ne := ?_ } + use 0, basis 0 + simp only [Nat.succ_eq_add_one, ne_eq] + by_contra hn + have h0 : (basis 0 : Space d.succ) 0 = 1 := by simp + rw [← hn] at h0 + simp at h0 + +instance : Subsingleton (Space 0) := by + apply Subsingleton.intro + intro x y + ext i + fin_cases i + +lemma volume_closedBall_ne_zero {d : ℕ} (x : Space d.succ) (r : ℝ) (hr : 0 < r) : + volume (Metric.closedBall x r) ≠ 0 := by + obtain ⟨k,hk⟩ := Nat.even_or_odd' d.succ + rcases hk with hk | hk + · rw [InnerProductSpace.volume_closedBall_of_dim_even (k := k)] + simp only [Nat.succ_eq_add_one, finrank_eq_dim, ne_eq, mul_eq_zero, Nat.add_eq_zero_iff, + one_ne_zero, and_false, not_false_eq_true, pow_eq_zero_iff, ENNReal.ofReal_eq_zero, not_or, + not_le] + apply And.intro + · simp_all + · positivity + · simpa using hk + · rw [InnerProductSpace.volume_closedBall_of_dim_odd (k := k)] + simp only [Nat.succ_eq_add_one, finrank_eq_dim, ne_eq, mul_eq_zero, Nat.add_eq_zero_iff, + one_ne_zero, and_false, not_false_eq_true, pow_eq_zero_iff, ENNReal.ofReal_eq_zero, not_or, + not_le] + apply And.intro + · simp_all + · positivity + · simpa using hk + +lemma volume_closedBall_ne_top {d : ℕ} (x : Space d.succ) (r : ℝ) : + volume (Metric.closedBall x r) ≠ ⊤ := by + obtain ⟨k,hk⟩ := Nat.even_or_odd' d.succ + rcases hk with hk | hk + · rw [InnerProductSpace.volume_closedBall_of_dim_even (k := k)] + simp only [Nat.succ_eq_add_one, finrank_eq_dim, ne_eq] + apply not_eq_of_beq_eq_false + rfl + simpa using hk + · rw [InnerProductSpace.volume_closedBall_of_dim_odd (k := k)] + simp only [Nat.succ_eq_add_one, finrank_eq_dim, ne_eq] + apply not_eq_of_beq_eq_false + rfl + simpa using hk + +@[simp] +lemma volume_metricBall_three : + volume (Metric.ball (0 : Space 3) 1) = ENNReal.ofReal (4 / 3 * Real.pi) := by + rw [InnerProductSpace.volume_ball_of_dim_odd (k := 1)] + simp only [ENNReal.ofReal_one, finrank_eq_dim, one_pow, pow_one, Nat.reduceAdd, + Nat.doubleFactorial.eq_3, Nat.doubleFactorial, mul_one, Nat.cast_ofNat, one_mul] + ring_nf + simp + +@[simp] +lemma volume_metricBall_two : + volume (Metric.ball (0 : Space 2) 1) = ENNReal.ofReal Real.pi := by + rw [InnerProductSpace.volume_ball_of_dim_even (k := 1)] + simp [finrank_eq_dim] + simp [finrank_eq_dim] + +@[simp] +lemma volume_metricBall_two_real : + (volume.real (Metric.ball (0 : Space 2) 1)) = Real.pi := by + trans (volume (Metric.ball (0 : Space 2) 1)).toReal + · rfl + rw [volume_metricBall_two] + simp only [ENNReal.toReal_ofReal_eq_iff] + exact Real.pi_nonneg + end Space diff --git a/PhysLean/SpaceAndTime/Space/ConstantSliceDist.lean b/PhysLean/SpaceAndTime/Space/ConstantSliceDist.lean new file mode 100644 index 000000000..7ffce0503 --- /dev/null +++ b/PhysLean/SpaceAndTime/Space/ConstantSliceDist.lean @@ -0,0 +1,709 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +import PhysLean.SpaceAndTime.Space.Slice +/-! + +# Constant slice distributions + +## i. Overview + +In this module we define the lift of distributions on `Space d` to distributions +on `Space d.succ` which are constant between slices in the `i`th direction. + +This is used, for example, to define distributions which are translationally invariant +in the `i`th direction. + +Examples of distributions which can be constructed in this way include the dirac deltas for +lines and planes, rather then points. + +## ii. Key results + +- `sliceSchwartz` : The continuous linear map which takes a Schwartz map on + `Space d.succ` and gives a Schwartz map on `Space d` by integrating over the `i`th direction. +- `constantSliceDist` : The distribution on `Space d.succ` formed by a distribution on `Space d` + which is translationally invariant in the `i`th direction. + +## iii. Table of contents + +- A. Schwartz maps + - A.1. Bounded condition for derivatives of Schwartz maps on slices + - A.2. Integrability for of Schwartz maps on slices + - A.3. Continiuity of integrations of slices of Schwartz maps + - A.4. Derivative of integrations of slices of Schwartz maps + - A.5. Differentiability as a slices of Schwartz maps + - A.6. Smoothness as slices of Schwartz maps + - A.7. Iterated derivatives of integrations of slices of Schwartz maps + - A.8. The map integrating over one component of a Schwartz map +- B. Constant slice distribution + - B.1. Derivative of constant slice distributions + +## iv. References + +-/ +open SchwartzMap NNReal +noncomputable section + +variable (𝕜 : Type) {E F F' : Type} [RCLike 𝕜] [NormedAddCommGroup E] [NormedAddCommGroup F] + [NormedAddCommGroup F'] [NormedSpace ℝ E] [NormedSpace ℝ F] + +namespace Space + +open MeasureTheory Real + +/-! + +## A. Schwartz maps + +-/ + +/-! + +### A.1. Bounded condition for derivatives of Schwartz maps on slices + +-/ + +lemma schwartzMap_slice_bound {n m} {d : ℕ} (i : Fin d.succ) : + ∃ rt, ∀ (η : 𝓢(Space d.succ, ℝ)), ∃ k, + Integrable (fun x : ℝ => ‖((1 + ‖x‖) ^ rt)⁻¹‖) volume ∧ + (∀ (x : Space d), ∀ r, ‖(slice i).symm (r, x)‖ ^ m * + ‖iteratedFDeriv ℝ n ⇑η ((slice i).symm (r, x))‖ ≤ k * ‖(1 + ‖r‖) ^ (rt)‖⁻¹) + ∧ k = (2 ^ (rt + m, n).1 * ((Finset.Iic (rt + m, n)).sup + fun m => SchwartzMap.seminorm ℝ m.1 m.2) η) := by + obtain ⟨rt, hrt⟩ : ∃ r, Integrable (fun x : ℝ => ‖((1 + ‖x‖) ^ r)⁻¹‖) volume := by + obtain ⟨r, h⟩ := Measure.HasTemperateGrowth.exists_integrable (μ := volume (α := ℝ)) + use r + convert h using 1 + funext x + simp only [norm_inv, norm_pow, Real.norm_eq_abs, Real.rpow_neg_natCast, zpow_neg, + zpow_natCast, inv_inj] + rw [abs_of_nonneg (by positivity)] + use rt + intro η + have h0 := one_add_le_sup_seminorm_apply (𝕜 := ℝ) (m := (rt + m, n)) + (k := rt + m) (n := n) le_rfl (le_rfl) η + simp at h0 + let k := 2 ^ (rt + m, n).1 * + ((Finset.Iic (rt + m, n)).sup fun m => SchwartzMap.seminorm ℝ m.1 m.2) η + refine ⟨k, ⟨hrt, fun x r => ?_, by rfl⟩⟩ + trans k * ‖(1 + ‖((slice i).symm (r, x))‖) ^ rt‖⁻¹; swap + · refine mul_le_mul_of_nonneg (by rfl) ?_ (by positivity) (by positivity) + by_cases rt = 0 + · subst rt + simp + refine inv_anti₀ ?_ ?_ + · simp only [norm_eq_abs, norm_pow] + rw [abs_of_nonneg (by positivity)] + positivity + simp only [norm_pow, Real.norm_eq_abs, Nat.succ_eq_add_one] + refine pow_le_pow_left₀ (by positivity) ?_ rt + rw [abs_of_nonneg (by positivity)] + conv_rhs => rw [abs_of_nonneg (by positivity)] + simp only [add_le_add_iff_left] + exact abs_right_le_norm_slice_symm i r x + refine (le_mul_inv_iff₀ ?_).mpr (le_trans ?_ (h0 ((slice i).symm (r, x)))) + · simp + by_cases hr : rt = 0 + · subst rt + simp + positivity + trans (‖((slice i).symm (r, x))‖ ^ m * ‖(1 + ‖((slice i).symm (r, x))‖) ^ rt‖) * + ‖iteratedFDeriv ℝ n ⇑η (((slice i).symm (r, x)))‖ + · apply le_of_eq + simp [mul_assoc] + left + ring + apply mul_le_mul_of_nonneg _ (by rfl) (by positivity) (by positivity) + trans (1 + ‖((slice i).symm (r, x))‖) ^ m * (1 + ‖((slice i).symm (r, x))‖) ^ rt + · refine mul_le_mul_of_nonneg ?_ ?_ (by positivity) (by positivity) + · apply pow_le_pow_left₀ (by positivity) ?_ m + simp + · simp + rw [abs_of_nonneg (by positivity)] + apply le_of_eq + ring_nf + +/-! + +### A.2. Integrability for of Schwartz maps on slices + +-/ + +@[fun_prop] +lemma schwartzMap_mul_iteratedFDeriv_integrable_slice_symm {d : ℕ} (n m : ℕ) + (η : 𝓢(Space d.succ, ℝ)) + (x : Space d) (i : Fin d.succ) : + Integrable (fun r => ‖(slice i).symm (r, x)‖ ^ m * + ‖iteratedFDeriv ℝ n ⇑η ((slice i).symm (r, x))‖) volume := by + obtain ⟨rt, hrt⟩ := schwartzMap_slice_bound (m := m) (n := n) (d := d) i + obtain ⟨k, hrt, hbound, k_eq⟩ := hrt η + apply Integrable.mono' (g := fun t => k * ‖(1 + ‖t‖) ^ (rt)‖⁻¹) + · apply Integrable.const_mul + convert hrt using 1 + simp + · apply Continuous.aestronglyMeasurable + apply Continuous.mul + · fun_prop + apply Continuous.norm + apply Continuous.comp' + apply ContDiff.continuous_iteratedFDeriv (n := (n + 1 : ℕ)) + exact Nat.cast_le.mpr (by omega) + have hη := η.smooth' + apply hη.of_le (ENat.LEInfty.out) + fun_prop + · filter_upwards with t + apply le_trans _ (hbound x t) + apply le_of_eq + simp only [Nat.succ_eq_add_one, norm_mul, norm_pow, Real.norm_eq_abs] + rw [abs_of_nonneg (by positivity)] + simp + +lemma schwartzMap_integrable_slice_symm {d : ℕ} (i : Fin d.succ) (η : 𝓢(Space d.succ, ℝ)) + (x : Space d) : Integrable (fun r => η ((slice i).symm (r, x))) volume := by + apply (schwartzMap_mul_iteratedFDeriv_integrable_slice_symm 0 0 η x i).congr' + · fun_prop + · simp + +set_option maxSynthPendingDepth 10000 in +lemma schwartzMap_fderiv_integrable_slice_symm {d : ℕ} (η : 𝓢(Space d.succ, ℝ)) (x : Space d) + (i : Fin d.succ) : + Integrable (fun r => fderiv ℝ (fun x => η (((slice i).symm (r, x)))) x) volume := by + apply Integrable.mono' (g := fun r => + ‖iteratedFDeriv ℝ 1 ⇑η ((slice i).symm (r, x))‖ * ‖(slice i).symm.toContinuousLinearMap.comp + (ContinuousLinearMap.prod (0 : Space d →L[ℝ] ℝ) (ContinuousLinearMap.id ℝ (Space d)))‖) + · apply Integrable.mul_const + simpa using (schwartzMap_mul_iteratedFDeriv_integrable_slice_symm 1 0 η x i) + · apply Continuous.aestronglyMeasurable + refine Continuous.fderiv_one ?_ ?_ + · exact (η.smooth'.of_le (by simp)).comp ((slice i).symm.contDiff) + · fun_prop + · filter_upwards with r + calc _ + _ ≤ ‖(fderiv ℝ ⇑η (((slice i).symm (r, x))))‖ * + ‖fderiv ℝ (fun x => (slice i).symm (r, x)) x‖ := by + rw [fderiv_comp' _ _ (by fun_prop)]; swap + · apply Differentiable.differentiableAt + exact η.smooth'.differentiable (by simp) + exact ContinuousLinearMap.opNorm_comp_le (fderiv ℝ ⇑η (((slice i).symm (r, x)))) _ + _ ≤ ‖iteratedFDeriv ℝ 1 (⇑η) ((((slice i).symm (r, x))))‖ * + ‖fderiv ℝ (fun x => (slice i).symm (r, x)) x‖ := by + apply le_of_eq + congr 1 + simp only [Nat.succ_eq_add_one] + rw [← iteratedFDerivWithin_univ, norm_iteratedFDerivWithin_one, fderivWithin_univ] + exact uniqueDiffWithinAt_univ + _ ≤ ‖iteratedFDeriv ℝ 1 (⇑η) ((((slice i).symm (r, x))))‖ + * ‖(slice i).symm.toContinuousLinearMap.comp + (ContinuousLinearMap.prod (0 : Space d →L[ℝ] ℝ) + (ContinuousLinearMap.id ℝ (Space d)))‖ := by + apply le_of_eq + congr + rw [fderiv_comp', DifferentiableAt.fderiv_prodMk (by fun_prop) (by fun_prop)] + simp only [Nat.succ_eq_add_one, fderiv_slice_symm, fderiv_fun_const, Pi.zero_apply, + fderiv_id'] + fun_prop + fun_prop + +@[fun_prop] +lemma schwartzMap_fderiv_left_integrable_slice_symm {d : ℕ} (η : 𝓢(Space d.succ, ℝ)) (x : Space d) + (i : Fin d.succ) : + Integrable (fun r => fderiv ℝ (fun r => η (((slice i).symm (r, x)))) r 1) volume := by + conv_lhs => + enter [r] + simp only [Nat.succ_eq_add_one, one_mul] + change fderiv ℝ (η ∘ fun r => ((slice i).symm (r, x))) r 1 + rw [fderiv_comp _ (by + apply Differentiable.differentiableAt + exact η.smooth'.differentiable (by simp)) + (by fun_prop)] + simp only [Nat.succ_eq_add_one, ContinuousLinearMap.coe_comp', Function.comp_apply, + fderiv_slice_symm_left_apply] + change (SchwartzMap.evalCLM ℝ (Space d.succ) ℝ (((slice i).symm (1, 0)))).comp + (SchwartzMap.fderivCLM ℝ (Space d.succ) ℝ) η (((slice i).symm (r, x))) + rw [← SchwartzMap.lineDerivOpCLM_eq] + exact schwartzMap_integrable_slice_symm _ _ _ + +@[fun_prop] +lemma schwartzMap_iteratedFDeriv_norm_slice_symm_integrable {n} {d : ℕ} (η : 𝓢(Space d.succ, ℝ)) + (x : Space d) (i : Fin d.succ) : + Integrable (fun r => ‖iteratedFDeriv ℝ n ⇑η (((slice i).symm (r, x)))‖) volume := by + convert schwartzMap_mul_iteratedFDeriv_integrable_slice_symm n 0 η x i using 1 + funext t + simp + +@[fun_prop] +lemma schwartzMap_iteratedFDeriv_slice_symm_integrable {n} {d : ℕ} (η : 𝓢(Space d.succ, ℝ)) + (x : Space d) (i : Fin d.succ) : + Integrable (fun r => iteratedFDeriv ℝ n ⇑η (((slice i).symm (r, x)))) volume := by + rw [← MeasureTheory.integrable_norm_iff] + · fun_prop + · apply Continuous.aestronglyMeasurable + apply Continuous.comp' + apply ContDiff.continuous_iteratedFDeriv (n := (n + 1 : ℕ)) + exact Nat.cast_le.mpr (by omega) + have hη := η.smooth' + apply hη.of_le (ENat.LEInfty.out) + fun_prop + +/-! + +### A.3. Continiuity of integrations of slices of Schwartz maps +-/ + +lemma continuous_schwartzMap_slice_integral {d} (i : Fin d.succ) (η : 𝓢(Space d.succ, ℝ)) : + Continuous (fun x : Space d => ∫ r : ℝ, η ((slice i).symm (r, x))) := by + obtain ⟨rt, hrt⟩ := schwartzMap_slice_bound (m := 0) (n := 0) (d := d) i + obtain ⟨k, hrt, hbound, k_eq⟩ := hrt η + apply MeasureTheory.continuous_of_dominated (bound := fun t => k * ‖(1 + ‖t‖) ^ (rt)‖⁻¹) + · intro x + fun_prop + · intro x + filter_upwards with t + simpa using hbound x t + · apply Integrable.const_mul + convert hrt using 1 + funext t + simp + · filter_upwards with t + fun_prop + +/-! + +### A.4. Derivative of integrations of slices of Schwartz maps + +-/ + +lemma schwartzMap_slice_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Space d.succ, ℝ)) (i : Fin d.succ) + (x₀ : Space d) : + HasFDerivAt (fun x => ∫ (r : ℝ), η ((slice i).symm (r, x))) + (∫ (r : ℝ), fderiv ℝ (fun x : Space d => η ((slice i).symm (r, x))) x₀) x₀ := by + let F : Space d → ℝ → ℝ := fun x r => η ((slice i).symm (r, x)) + let F' : Space d → ℝ → Space d →L[ℝ] ℝ := + fun x₀ r => fderiv ℝ (fun x : Space d => η ((slice i).symm (r, x))) x₀ + have hF : ∀ t, ∀ x, HasFDerivAt (F · t) (F' x t) x := by + intro t x + dsimp [F, F'] + refine DifferentiableAt.hasFDerivAt ?_ + have hf := η.smooth' + apply Differentiable.differentiableAt + apply Differentiable.comp + · exact hf.differentiable (by simp) + · fun_prop + obtain ⟨rt, hrt⟩ := schwartzMap_slice_bound (m := 0) (n := 1) (d := d) i + obtain ⟨k, hrt, hbound, k_eq⟩ := hrt η + suffices h1 : HasFDerivAt (fun x => ∫ (a : ℝ), F x a) (∫ (a : ℝ), F' x₀ a) x₀ by exact h1 + apply hasFDerivAt_integral_of_dominated_of_fderiv_le + (bound := fun t => (k * ‖(slice i).symm.toContinuousLinearMap.comp + (ContinuousLinearMap.prod (0 : Space d →L[ℝ] ℝ) (ContinuousLinearMap.id ℝ (Space d)))‖) + * ‖(1 + ‖t‖) ^ (rt)‖⁻¹) + · exact Filter.univ_mem' (hF (F x₀ 0)) + · filter_upwards with x + fun_prop + · simp [F] + exact schwartzMap_integrable_slice_symm i η x₀ + · simp [F'] + apply Continuous.aestronglyMeasurable + refine Continuous.fderiv_one ?_ ?_ + · apply ContDiff.comp + change ContDiff ℝ 1 η + apply η.smooth'.of_le (by simp) + apply ContDiff.comp + · exact ContinuousLinearEquiv.contDiff (slice i).symm + · fun_prop + · fun_prop + · filter_upwards with r + intro x _ + calc _ + _ ≤ ‖(fderiv ℝ ⇑η (((slice i).symm (r, x))))‖ * + ‖fderiv ℝ (fun x => (slice i).symm (r, x)) x‖ := by + simp [F'] + rw [fderiv_comp' _ _ (by fun_prop)]; swap + · apply Differentiable.differentiableAt + exact η.smooth'.differentiable (by simp) + exact ContinuousLinearMap.opNorm_comp_le (fderiv ℝ ⇑η (((slice i).symm (r, x)))) _ + _ ≤ ‖iteratedFDeriv ℝ 1 (⇑η) ((((slice i).symm (r, x))))‖ * + ‖fderiv ℝ (fun x => (slice i).symm (r, x)) x‖ := by + apply le_of_eq + congr 1 + simp only [Nat.succ_eq_add_one] + rw [← iteratedFDerivWithin_univ, norm_iteratedFDerivWithin_one, fderivWithin_univ] + exact uniqueDiffWithinAt_univ + _ ≤ k * (|1 + ‖r‖| ^ rt)⁻¹ * ‖fderiv ℝ (fun x => (slice i).symm (r, x)) x‖ := by + refine mul_le_mul_of_nonneg_right ?_ (by positivity) + simpa using hbound x r + _ ≤ k * (|1 + ‖r‖| ^ rt)⁻¹ * ‖(slice i).symm.toContinuousLinearMap.comp + (ContinuousLinearMap.prod (0 : Space d →L[ℝ] ℝ) + (ContinuousLinearMap.id ℝ (Space d)))‖ := by + apply le_of_eq + congr 1 + rw [fderiv_comp', DifferentiableAt.fderiv_prodMk (by fun_prop) (by fun_prop)] + simp only [Nat.succ_eq_add_one, fderiv_slice_symm, fderiv_fun_const, Pi.zero_apply, + fderiv_id'] + fun_prop + fun_prop + apply le_of_eq + simp only [norm_eq_abs, Nat.succ_eq_add_one, norm_pow] + ring + · apply Integrable.const_mul + convert hrt using 1 + funext t + simp + · filter_upwards with t + intro x _ + exact hF t x + +/-! + +### A.5. Differentiability as a slices of Schwartz maps + +-/ + +lemma schwartzMap_slice_integral_differentiable {d : ℕ} (η : 𝓢(Space d.succ, ℝ)) + (i : Fin d.succ) : + Differentiable ℝ (fun x => ∫ (r : ℝ), η ((slice i).symm (r, x))) := + fun x => (schwartzMap_slice_integral_hasFDerivAt η i x).differentiableAt + +/-! + +### A.6. Smoothness as slices of Schwartz maps + +-/ + +lemma schwartzMap_slice_integral_contDiff {d : ℕ} (n : ℕ) (η : 𝓢(Space d.succ, ℝ)) + (i : Fin d.succ) : + ContDiff ℝ n (fun x => ∫ (r : ℝ), η ((slice i).symm (r, x))) := by + revert η + induction n with + | zero => + intro η + simp only [Nat.succ_eq_add_one, CharP.cast_eq_zero, contDiff_zero] + exact continuous_schwartzMap_slice_integral i η + | succ n ih => + intro η + simp only [Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one] + rw [contDiff_succ_iff_hasFDerivAt] + use fun x₀ => (∫ (r : ℝ), fderiv ℝ (fun x : Space d => η ((slice i).symm (r, x))) x₀) + apply And.intro + · rw [contDiff_clm_apply_iff] + intro y + have hl : (fun x => (∫ (r : ℝ), fderiv ℝ (fun x => η (((slice i).symm (r, x)))) x) y) = + fun x => (∫ (r : ℝ), fderiv ℝ (fun x => η (((slice i).symm (r, x)))) x y) := by + funext x + simp only [Nat.succ_eq_add_one] + rw [ContinuousLinearMap.integral_apply] + exact schwartzMap_fderiv_integrable_slice_symm η x i + rw [hl] + have hl2 : (fun x => ∫ (r : ℝ), (fderiv ℝ (fun x => η (((slice i).symm (r, x)))) x) y)= + fun x => ∫ (r : ℝ), LineDeriv.lineDerivOpCLM ℝ _ ((slice i).symm (0, y)) η + (((slice i).symm (r, x))) := by + funext x + congr + funext t + simp only [Nat.succ_eq_add_one, LineDeriv.lineDerivOpCLM_apply] + rw [fderiv_comp'] + simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, + fderiv_slice_symm_right_apply, Nat.succ_eq_add_one] + rw [SchwartzMap.lineDerivOp_apply_eq_fderiv] + · apply Differentiable.differentiableAt + exact η.smooth'.differentiable (by simp) + fun_prop + rw [hl2] + apply ih + · exact fun x => schwartzMap_slice_integral_hasFDerivAt η i x +/-! + +### A.7. Iterated derivatives of integrations of slices of Schwartz maps + +-/ + +lemma schwartzMap_slice_integral_iteratedFDeriv_apply {d : ℕ} (n : ℕ) (η : 𝓢(Space d.succ, ℝ)) + (i : Fin d.succ) : + ∀ x, ∀ y, iteratedFDeriv ℝ n (fun x => ∫ (r : ℝ), η ((slice i).symm (r, x))) x y = + ∫ (r : ℝ), (iteratedFDeriv ℝ n η ((slice i).symm (r, x))) + (fun j => (slice i).symm (0, y j)) := by + induction n with + | zero => + simp + | succ n ih => + intro x y + calc _ + _ = ((fderiv ℝ (fun x => iteratedFDeriv ℝ n + (fun x => ∫ (r : ℝ), η ((slice i).symm (r, x))) x (Fin.tail y)) x) (y 0)) := by + rw [iteratedFDeriv_succ_apply_left] + refine Eq.symm (fderiv_continuousMultilinear_apply_const_apply ?_ (Fin.tail y) (y 0)) + apply Differentiable.differentiableAt + apply (schwartzMap_slice_integral_contDiff (n + 1) η i).differentiable_iteratedFDeriv + refine Nat.cast_lt.mpr ?_ + omega + _ = (fderiv ℝ (fun x => ∫ (r : ℝ), (iteratedFDeriv ℝ n (⇑η) ((slice i).symm (r, x))) + fun j => (slice i).symm (0, Fin.tail y j)) x) (y 0) := by + conv_lhs => + enter [1, 2, x] + rw [ih] + _ = (fderiv ℝ (fun x => ∫ (r : ℝ), (LineDeriv.iteratedLineDerivOpCLM ℝ 𝓢(Space d.succ, ℝ) + (fun j => (slice i).symm (0, Fin.tail y j)) η (((slice i).symm (r, x)))))) x (y 0) := by + congr + funext x + congr + funext t + erw [SchwartzMap.iteratedLineDerivOp_eq_iteratedFDeriv] + _ = ∫ (r : ℝ), (fderiv ℝ (fun x => ((LineDeriv.iteratedLineDerivOpCLM ℝ _ fun j => + (slice i).symm (0, Fin.tail y j)) η) + ((slice i).symm (r, x))) x) (y 0) := by + rw [(schwartzMap_slice_integral_hasFDerivAt _ i x).fderiv] + rw [ContinuousLinearMap.integral_apply] + exact + schwartzMap_fderiv_integrable_slice_symm + ((LineDeriv.iteratedLineDerivOpCLM ℝ _ fun j => (slice i).symm (0, Fin.tail y j)) η) x i + congr + funext r + calc _ + _ = (fderiv ℝ (fun x => (iteratedFDeriv ℝ n (⇑η) ((slice i).symm (r, x)) + (fun j => (slice i).symm (0, Fin.tail y j)))) x) (y 0) := by + congr + funext x + erw [SchwartzMap.iteratedLineDerivOp_eq_iteratedFDeriv] + rw [iteratedFDeriv_succ_apply_left] + simp only [Nat.succ_eq_add_one] + rw [← fderiv_continuousMultilinear_apply_const_apply] + rw [← fderiv_fun_slice_symm_right_apply] + rfl + · apply Differentiable.differentiableAt + refine Differentiable.continuousMultilinear_apply_const ?_ + (Fin.tail fun j => (slice i).symm (0, y j)) + refine Differentiable.fun_comp ?_ ?_ + apply ContDiff.differentiable_iteratedFDeriv (n := (n + 1 : ℕ)) + refine Nat.cast_lt.mpr ?_ + simp only [lt_add_iff_pos_right, zero_lt_one] + have hη := η.smooth' + apply ContDiff.comp + · exact hη.of_le (by exact ENat.LEInfty.out) + · fun_prop + fun_prop + · apply Differentiable.differentiableAt + refine Differentiable.fun_comp ?_ ?_ + apply ContDiff.differentiable_iteratedFDeriv (n := (n + 1 : ℕ)) + refine Nat.cast_lt.mpr ?_ + simp only [lt_add_iff_pos_right, zero_lt_one] + have hη := η.smooth' + apply ContDiff.comp + · exact hη.of_le (by exact ENat.LEInfty.out) + · fun_prop + fun_prop + +lemma schwartzMap_slice_integral_iteratedFDeriv {d : ℕ} (n : ℕ) (η : 𝓢(Space d.succ, ℝ)) + (i : Fin d.succ) (x : Space d) : + iteratedFDeriv ℝ n (fun x => ∫ (r : ℝ), η ((slice i).symm (r, x))) x + = (∫ (r : ℝ), iteratedFDeriv ℝ n η ((slice i).symm (r, x))).compContinuousLinearMap + (fun _ => (slice i).symm.toContinuousLinearMap.comp + (ContinuousLinearMap.prod (0 : Space d →L[ℝ] ℝ) (ContinuousLinearMap.id ℝ (Space d)))) := by + ext y + rw [schwartzMap_slice_integral_iteratedFDeriv_apply] + rw [← ContinuousMultilinearMap.integral_apply] + rfl + simp only [Nat.succ_eq_add_one] + exact schwartzMap_iteratedFDeriv_slice_symm_integrable η x i + +lemma schwartzMap_slice_integral_iteratedFDeriv_norm_le {d : ℕ} (n : ℕ) (η : 𝓢(Space d.succ, ℝ)) + (i : Fin d.succ) (x : Space d) : + ‖iteratedFDeriv ℝ n (fun x => ∫ (r : ℝ), η ((slice i).symm (r, x))) x‖ ≤ + (∫ (r : ℝ), ‖iteratedFDeriv ℝ n η ((slice i).symm (r, x))‖) * + ‖(slice i).symm.toContinuousLinearMap.comp + (ContinuousLinearMap.prod (0 : Space d →L[ℝ] ℝ) + (ContinuousLinearMap.id ℝ (Space d)))‖ ^ n := by + rw [schwartzMap_slice_integral_iteratedFDeriv] + apply le_trans (ContinuousMultilinearMap.norm_compContinuousLinearMap_le _ _) + simp + refine mul_le_mul ?_ (by rfl) (by positivity) (by positivity) + exact norm_integral_le_integral_norm fun a => iteratedFDeriv ℝ n ⇑η _ + +lemma schwartzMap_mul_pow_slice_integral_iteratedFDeriv_norm_le {d : ℕ} (n m : ℕ) (i : Fin d.succ) : + ∃ rt, ∀ (η : 𝓢(Space d.succ, ℝ)),∀ (x : Space d), + Integrable (fun x : ℝ => ‖((1 + ‖x‖) ^ rt)⁻¹‖) volume ∧ + ‖x‖ ^ m * ‖iteratedFDeriv ℝ n (fun x => ∫ (r : ℝ), η ((slice i).symm (r, x))) x‖ ≤ + ((∫ (r : ℝ), ‖((1 + ‖r‖) ^ rt)⁻¹‖) * + ‖(slice i).symm.toContinuousLinearMap.comp + (ContinuousLinearMap.prod (0 : Space d →L[ℝ] ℝ) + (ContinuousLinearMap.id ℝ (Space d)))‖ ^ n) + * (2 ^ (rt + m, n).1 * ((Finset.Iic (rt + m, n)).sup + fun m => SchwartzMap.seminorm ℝ m.1 m.2) η) := by + obtain ⟨rt, hrt⟩ := schwartzMap_slice_bound (m := m) (n := n) (d := d) i + use rt + intro η x + obtain ⟨k, hrt, hbound, k_eq⟩ := hrt η + refine ⟨hrt, ?_⟩ + generalize hk : 2 ^ (rt + m, n).1 * ((Finset.Iic (rt + m, n)).sup + fun m => SchwartzMap.seminorm ℝ m.1 m.2) η = k' at * + subst k_eq + have hk' : 0 ≤ k := by rw [← hk]; positivity + calc _ + _ ≤ ‖x‖ ^ m * ((∫ (r : ℝ), ‖iteratedFDeriv ℝ n η ((slice i).symm (r, x))‖) * + ‖(slice i).symm.toContinuousLinearMap.comp + ((0 : Space d →L[ℝ] ℝ).prod (ContinuousLinearMap.id ℝ (Space d)))‖ ^ n) := by + refine mul_le_mul_of_nonneg (by rfl) ?_ (by positivity) (by positivity) + exact schwartzMap_slice_integral_iteratedFDeriv_norm_le n η i x + _ ≤ (∫ (r : ℝ), ‖x‖ ^ m * ‖iteratedFDeriv ℝ n η ((slice i).symm (r, x))‖) * + ‖(slice i).symm.toContinuousLinearMap.comp + ((0 : Space d →L[ℝ] ℝ).prod (ContinuousLinearMap.id ℝ (Space d)))‖ ^ n := by + apply le_of_eq + rw [← mul_assoc, MeasureTheory.integral_const_mul] + _ ≤ (∫ (r : ℝ), ‖((slice i).symm (r, x))‖ ^ m * + ‖iteratedFDeriv ℝ n η (((slice i).symm (r, x)))‖) * + ‖(slice i).symm.toContinuousLinearMap.comp + ((0 : Space d →L[ℝ] ℝ).prod (ContinuousLinearMap.id ℝ (Space d)))‖ ^ n := by + refine mul_le_mul_of_nonneg ?_ (by rfl) (by positivity) (by positivity) + refine integral_mono ?_ ?_ ?_ + · apply Integrable.const_mul + fun_prop + · fun_prop + · refine Pi.le_def.mpr ?_ + intro t + apply mul_le_mul_of_nonneg _ (by rfl) (by positivity) (by positivity) + refine pow_le_pow_left₀ (by positivity) ?_ m + simp + _ ≤ ((∫ (r : ℝ), k * ‖((1 + ‖r‖) ^ rt)⁻¹‖)) * + ‖(slice i).symm.toContinuousLinearMap.comp + ((0 : Space d →L[ℝ] ℝ).prod (ContinuousLinearMap.id ℝ (Space d)))‖ ^ n := by + refine mul_le_mul_of_nonneg ?_ (by rfl) (by positivity) (by positivity) + refine integral_mono ?_ ?_ ?_ + · fun_prop + · apply Integrable.const_mul + exact hrt + · refine Pi.le_def.mpr ?_ + intro t + convert hbound x t using 1 + simp + apply le_of_eq + rw [MeasureTheory.integral_const_mul] + ring + +/-! + +### A.8. The map integrating over one component of a Schwartz map + +-/ + +/-- The continuous linear map taking a Schwartz map and integrating over the `i`th component, + to give a Schwartz map of one dimension lower. -/ +def sliceSchwartz {d : ℕ} (i : Fin d.succ) : + 𝓢(Space d.succ, ℝ) →L[ℝ] 𝓢(Space d, ℝ) := by + refine SchwartzMap.mkCLM (fun η x => ∫ (r : ℝ), η ((slice i).symm (r, x))) ?_ ?_ ?_ ?_ + · intro η1 η2 x + simp only [Nat.succ_eq_add_one, SchwartzMap.add_apply] + rw [integral_add] + · exact schwartzMap_integrable_slice_symm i η1 x + · exact schwartzMap_integrable_slice_symm i η2 x + · intro a η x + simp only [Nat.succ_eq_add_one, SchwartzMap.smul_apply, smul_eq_mul, RingHom.id_apply] + rw [integral_const_mul] + · intro η + simp only [Nat.succ_eq_add_one] + refine contDiff_infty.mpr ?_ + intro n + exact schwartzMap_slice_integral_contDiff n η i + · simp + intro m n + obtain ⟨rt, hrt⟩ := schwartzMap_mul_pow_slice_integral_iteratedFDeriv_norm_le + (d := d) (n := n) (m := m) i + use (Finset.Iic (rt + m, n)) + use 2 ^ (rt + m, n).1 * (∫ (r : ℝ), ‖((1 + ‖r‖) ^ rt)⁻¹‖) * + ‖(slice i).symm.toContinuousLinearMap.comp + ((0 : Space d →L[ℝ] ℝ).prod (ContinuousLinearMap.id ℝ (Space d)))‖ ^ n + apply And.intro + · positivity + intro η x + specialize hrt η x + obtain ⟨hrt1, hbound⟩ := hrt + apply le_trans hbound + apply le_of_eq + ring_nf + rfl + +lemma sliceSchwartz_apply {d : ℕ} (i : Fin d.succ) (η : 𝓢(Space d.succ, ℝ)) (x : Space d) : + sliceSchwartz i η x = ∫ (r : ℝ), η ((slice i).symm (r, x)) := by + rfl +/-! + +## B. Constant slice distribution +-/ + +/-- Distributions on `Space d.succ` from distributions on `Space d` given a + direction `i`. + These distributions are constant on slices in the `i` direction.. -/ +def constantSliceDist {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] {d : ℕ} (i : Fin d.succ) : + ((Space d) →d[ℝ] M) →ₗ[ℝ] (Space d.succ) →d[ℝ] M where + toFun f := f ∘L sliceSchwartz i + map_add' f g := by + ext η + simp + map_smul' c f := by + ext η + simp + +lemma constantSliceDist_apply {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] + {d : ℕ} (i : Fin d.succ) (f : (Space d) →d[ℝ] M) (η : 𝓢(Space d.succ, ℝ)) : + constantSliceDist i f η = f (sliceSchwartz i η) := by + rfl + +/-! + +### B.1. Derivative of constant slice distributions + +-/ + +lemma distDeriv_constantSliceDist_same {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] + {d : ℕ} (i : Fin d.succ) (f : (Space d) →d[ℝ] M) : + distDeriv i (constantSliceDist i f) = 0 := by + ext η + simp [constantSliceDist_apply, Space.distDeriv_apply, Distribution.fderivD_apply] + trans f 0; swap + · simp + congr + ext x + simp [sliceSchwartz_apply] + calc _ + _ = ∫ r, fderiv ℝ η ((slice i).symm (r, x)) (basis i) := by rfl + _ = ∫ r, fderiv ℝ (fun r => η ((slice i).symm (r, x))) r 1 := by + congr + funext r + rw [basis_self_eq_slice, fderiv_fun_slice_symm_left_apply] + apply Differentiable.differentiableAt + exact η.differentiable + _ = ∫ (r : ℝ), (fun r => 1) r * fderiv ℝ (fun r => η ((slice i).symm (r, x))) r 1 := by simp + _ = - ∫ (r : ℝ), fderiv ℝ (fun t => 1) r 1 * (fun r => η ((slice i).symm (r, x))) r := by + rw [integral_mul_fderiv_eq_neg_fderiv_mul_of_integrable] + · simp + · simp + change Integrable (fun r => fderiv ℝ (fun r => η ((slice i).symm (r, x))) r 1) volume + fun_prop + · simp + exact schwartzMap_integrable_slice_symm i η x + · fun_prop + · apply Differentiable.comp + · exact η.smooth'.differentiable (by simp) + · fun_prop + simp + +lemma distDeriv_constantSliceDist_succAbove {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] + {d : ℕ} (i : Fin d.succ) (j : Fin d) (f : (Space d) →d[ℝ] M) : + distDeriv (i.succAbove j) (constantSliceDist i f) = + constantSliceDist i (distDeriv j f) := by + ext η + simp [constantSliceDist_apply, Space.distDeriv_apply, Distribution.fderivD_apply] + congr 1 + ext x + simp [sliceSchwartz_apply] + change ∫ (r : ℝ), fderiv ℝ η _ _ = fderiv ℝ (fun x => ∫ (r : ℝ), η _) _ _ + rw [(schwartzMap_slice_integral_hasFDerivAt η i x).fderiv] + rw [ContinuousLinearMap.integral_apply] + congr + rw [basis_succAbove_eq_slice] + funext r + rw [fderiv_fun_slice_symm_right_apply] + · apply Differentiable.differentiableAt + exact η.differentiable + · exact schwartzMap_fderiv_integrable_slice_symm η x i + +end Space diff --git a/PhysLean/SpaceAndTime/Space/CrossProduct.lean b/PhysLean/SpaceAndTime/Space/CrossProduct.lean new file mode 100644 index 000000000..ddba5156a --- /dev/null +++ b/PhysLean/SpaceAndTime/Space/CrossProduct.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2025 Zhi Kai Pong. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong, Joseph Tooby-Smith +-/ +import Mathlib.LinearAlgebra.CrossProduct +import PhysLean.SpaceAndTime.Time.Derivatives +/-! + +# The cross product on Euclidean vectors in three dimensions + +## i. Overview + +In this module we define the cross product on `EuclideanSpace ℝ (Fin 3)`, +and prove various properties about it related to time derivatives and inner products. + +## ii. Key results + +- `⨯ₑ₃` : The cross product on `EuclideanSpace ℝ (Fin 3)`. +- `time_deriv_cross_commute` : Time derivatives move out of cross products. +- `inner_cross_self` : Inner product of a vector with the cross product of another vector + and itself is zero. +- `inner_self_cross` : Inner product of a vector with the cross product of itself + and another vector is zero. + +## iii. Table of contents + +- A. The notation for the cross product +- B. Time derivatives move out of cross products +- C. Inner product of vectors with cross products involving themselves + +## iv. References + +-/ + +namespace Space +open Time Matrix + +/-! + +## A. The notation for the cross product + +-/ + +set_option quotPrecheck false in +/-- Cross product in `EuclideanSpace ℝ (Fin 3)`. Uses `⨯` which is typed using `\X` or +`\vectorproduct` or `\crossproduct`. -/ +infixl:70 " ⨯ₑ₃ " => fun a b => (WithLp.equiv 2 (Fin 3 → ℝ)).symm + (WithLp.equiv 2 (Fin 3 → ℝ) a ⨯₃ WithLp.equiv 2 (Fin 3 → ℝ) b) + +/-! + +## B. Time derivatives move out of cross products + +-/ + +/-- Cross product and fderiv commute. -/ +lemma fderiv_cross_commute {t : Time} {s : EuclideanSpace ℝ (Fin 3)} + {f : Time → EuclideanSpace ℝ (Fin 3)} (hf : Differentiable ℝ f) : + s ⨯ₑ₃ (fderiv ℝ (fun t' => f t') t) 1 + = fderiv ℝ (fun t' => s ⨯ₑ₃ (f t')) t 1 := by + have h (i j : Fin 3) : s i * (fderiv ℝ (fun u => f u) t) 1 j - + s j * (fderiv ℝ (fun u => f u) t) 1 i + = (fderiv ℝ (fun t => s i * f t j - s j * f t i) t) 1:= by + rw [fderiv_fun_sub, fderiv_const_mul, fderiv_const_mul] + simp only [ContinuousLinearMap.coe_sub', ContinuousLinearMap.coe_smul', Pi.sub_apply, + Pi.smul_apply, smul_eq_mul] + rw [Time.fderiv_euclid, Time.fderiv_euclid] + intro i + repeat fun_prop + rw [crossProduct] + ext i + fin_cases i <;> + · simp [Nat.succ_eq_add_one, Nat.reduceAdd, Fin.isValue, WithLp.equiv_apply, + LinearMap.mk₂_apply, Fin.reduceFinMk, WithLp.equiv_symm_apply, + PiLp.toLp_apply, cons_val] + rw [h] + simp only [Fin.isValue] + rw [← Time.fderiv_euclid] + simp [Fin.isValue, cons_val_zero] + apply Time.differentiable_euclid + intro i + fin_cases i + all_goals + simp [Fin.zero_eta, Fin.isValue] + fun_prop + +/-- Cross product and time derivative commute. -/ +lemma time_deriv_cross_commute {s : EuclideanSpace ℝ (Fin 3)} {f : Time → EuclideanSpace ℝ (Fin 3)} + (hf : Differentiable ℝ f) : + s ⨯ₑ₃ (∂ₜ (fun t => f t) t) = ∂ₜ (fun t => s ⨯ₑ₃ (f t)) t := by + repeat rw [Time.deriv] + rw [fderiv_cross_commute] + fun_prop + +/-! + +## C. Inner product of vectors with cross products involving themselves + +-/ + +lemma inner_cross_self (v w : EuclideanSpace ℝ (Fin 3)) : + inner ℝ v (w ⨯ₑ₃ v) = 0 := by + cases v using WithLp.rec with | _ v => + cases w using WithLp.rec with | _ w => + simp only [WithLp.equiv_apply, WithLp.equiv_symm_apply] + change (crossProduct w) v ⬝ᵥ v = _ + rw [dotProduct_comm, dot_cross_self] + +lemma inner_self_cross (v w : EuclideanSpace ℝ (Fin 3)) : + inner ℝ v (v ⨯ₑ₃ w) = 0 := by + cases v using WithLp.rec with | _ v => + cases w using WithLp.rec with | _ w => + simp only [WithLp.equiv_apply, WithLp.equiv_symm_apply, PiLp.inner_apply, RCLike.inner_apply, + conj_trivial] + change (crossProduct v) w ⬝ᵥ v = _ + rw [dotProduct_comm, dot_self_cross] + +end Space diff --git a/PhysLean/SpaceAndTime/Space/Derivatives/Basic.lean b/PhysLean/SpaceAndTime/Space/Derivatives/Basic.lean new file mode 100644 index 000000000..54f1c697e --- /dev/null +++ b/PhysLean/SpaceAndTime/Space/Derivatives/Basic.lean @@ -0,0 +1,490 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong, Joseph Tooby-Smith, Lode Vermeulen +-/ +import Mathlib.Analysis.Calculus.FDeriv.Symmetric +import Mathlib.Analysis.Calculus.Gradient.Basic +import PhysLean.SpaceAndTime.Space.DistOfFunction +/-! + +# Derivatives on Space + +## i. Overview + +In this module we define derivatives of functions and distributions on space `Space d`, +in the standard directions. + +## ii. Key results + +- `deriv` : The derivative of a function on space in a given direction. +- `distDeriv` : The derivative of a distribution on space in a given direction. + +## iii. Table of contents + +- A. Derivatives of functions on `Space d` + - A.1. Basic equalities + - A.2. Derivative of the constant function + - A.3. Derivative distributes over addition + - A.4. Derivative distributes over scalar multiplication + - A.5. Two spatial derivatives commute + - A.6. Derivative of a component + - A.7. Derivative of a component squared + - A.8. Derivivatives of components + - A.9. Derivative of a norm squared + - A.9.1. Differentiability of the norm squared function + - A.9.2. Derivative of the norm squared function + - A.10. Derivative of the inner product + - A.10.1. Differentiability of the inner product function + - A.10.2. Derivative of the inner product function + - A.10.3. Derivative of the inner product on one side + - A.11. Differentiability of derivatives +- B. Derivatives of distributions on `Space d` + - B.1. The definition + - B.2. Basic equality + - B.3. Commutation of derivatives + +## iv. References + +-/ + +namespace Space + +/-! + +## A. Derivatives of functions on `Space d` + +-/ + +/-- Given a function `f : Space d → M` the derivative of `f` in direction `μ`. -/ +noncomputable def deriv {M d} [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] + (μ : Fin d) (f : Space d → M) : Space d → M := + (fun x => fderiv ℝ f x (basis μ)) + +@[inherit_doc deriv] +macro "∂[" i:term "]" : term => `(deriv $i) + +/-! + +### A.1. Basic equalities + +-/ + +lemma deriv_eq [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] + (μ : Fin d) (f : Space d → M) (x : Space d) : + deriv μ f x = fderiv ℝ f x (basis μ) := by rfl + +lemma deriv_eq_fderiv_basis [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] + (μ : Fin d) (f : Space d → M) (x : Space d) : + deriv μ f x = fderiv ℝ f x (basis μ) := by rfl + +lemma fderiv_eq_sum_deriv {M d} [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] + (f : Space d → M) (x y : Space d) : + fderiv ℝ f x y = ∑ i : Fin d, y i • ∂[i] f x := by + have h1 : y = ∑ i, y i • basis i := by + exact Eq.symm (OrthonormalBasis.sum_repr basis y) + conv_lhs => rw [h1] + simp [deriv_eq_fderiv_basis] + +/-! + +### A.2. Derivative of the constant function + +-/ + +@[simp] +lemma deriv_const [NormedAddCommGroup M] [NormedSpace ℝ M] (m : M) (μ : Fin d) : + deriv μ (fun _ => m) t = 0 := by + rw [deriv] + simp + +/-! + +### A.3. Derivative distributes over addition + +-/ + +/-- Derivatives on space distribute over addition. -/ +lemma deriv_add [NormedAddCommGroup M] [NormedSpace ℝ M] + (f1 f2 : Space d → M) (hf1 : Differentiable ℝ f1) (hf2 : Differentiable ℝ f2) : + ∂[u] (f1 + f2) = ∂[u] f1 + ∂[u] f2 := by + unfold deriv + ext x + rw [fderiv_add] + rfl + repeat fun_prop + +/-- Derivatives on space distribute coordinate-wise over addition. -/ +lemma deriv_coord_add (f1 f2 : Space d → EuclideanSpace ℝ (Fin d)) + (hf1 : Differentiable ℝ f1) (hf2 : Differentiable ℝ f2) : + (∂[u] (fun x => f1 x i + f2 x i)) = + (∂[u] (fun x => f1 x i)) + (∂[u] (fun x => f2 x i)) := by + unfold deriv + simp only + ext x + rw [fderiv_fun_add] + simp only [ContinuousLinearMap.add_apply, Pi.add_apply] + repeat fun_prop + +/-! + +### A.4. Derivative distributes over scalar multiplication + +-/ + +/-- Space derivatives on scalar product of functions. -/ +lemma deriv_smul [NormedAddCommGroup M] [NormedSpace ℝ M] [NontriviallyNormedField 𝕜] + [NormedAlgebra ℝ 𝕜] [NormedSpace 𝕜 M] {c : Space d → 𝕜} {f : Space d → M} + (hc : DifferentiableAt ℝ c x) (hf : DifferentiableAt ℝ f x) : + ∂[u] (c • f) x = c x • ∂[u] f x + ∂[u] c x • f x := by + unfold deriv + rw [fderiv_smul hc hf] + rfl + +/-- Space derivatives on scalar times function. -/ +lemma deriv_const_smul [NormedAddCommGroup M] [NormedSpace ℝ M] [Semiring R] + [Module R M] [SMulCommClass ℝ R M] [ContinuousConstSMul R M] {f : Space d → M} (c : R) + (h : Differentiable ℝ f) : ∂[u] (c • f) = c • ∂[u] f := by + unfold deriv + ext x + rw [fderiv_const_smul] + rw [ContinuousLinearMap.coe_smul', Pi.smul_apply, Pi.smul_apply] + fun_prop + +/-- Coordinate-wise scalar multiplication on space derivatives. -/ +lemma deriv_coord_smul (f : Space d → EuclideanSpace ℝ (Fin d)) (k : ℝ) + (hf : Differentiable ℝ f) : + ∂[u] (fun x => k * f x i) x = k * ∂[u] (fun x => f x i) x := by + unfold deriv + rw [fderiv_const_mul] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] + fun_prop + +/-! + +### A.5. Two spatial derivatives commute + +-/ + +/-- Derivatives on space commute with one another. -/ +lemma deriv_commute [NormedAddCommGroup M] [NormedSpace ℝ M] + (f : Space d → M) (hf : ContDiff ℝ 2 f) : ∂[u] (∂[v] f) = ∂[v] (∂[u] f) := by + unfold deriv + ext x + rw [fderiv_clm_apply, fderiv_clm_apply] + simp only [fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.comp_zero, zero_add, + ContinuousLinearMap.flip_apply] + rw [IsSymmSndFDerivAt.eq] + apply ContDiffAt.isSymmSndFDerivAt + exact ContDiff.contDiffAt hf + simp only [minSmoothness_of_isRCLikeNormedField, le_refl] + repeat fun_prop + +/-! + +### A.6. Derivative of a component + +-/ + +@[simp] +lemma deriv_component_same (μ : Fin d) (x : Space d) : + ∂[μ] (fun x => x μ) x = 1 := by + conv_lhs => + enter [2, x] + rw [← Space.coord_apply μ x] + change deriv μ (Space.coordCLM μ) x = 1 + simp only [deriv_eq, ContinuousLinearMap.fderiv] + simp [Space.coordCLM, Space.coord] + +lemma deriv_component_diff (μ ν : Fin d) (x : Space d) (h : μ ≠ ν) : + (deriv μ (fun x => x ν) x) = 0 := by + conv_lhs => + enter [2, x] + rw [← Space.coord_apply _ x] + change deriv μ (Space.coordCLM ν) x = 0 + simp [deriv_eq, ContinuousLinearMap.fderiv] + simpa [Space.coordCLM, Space.coord, basis_apply] using h + +lemma deriv_component (μ ν : Fin d) (x : Space d) : + (deriv ν (fun x => x μ) x) = if ν = μ then 1 else 0 := by + by_cases h' : ν = μ + · subst h' + simp + · rw [deriv_component_diff ν μ] + simp only [right_eq_ite_iff, zero_ne_one, imp_false] + simpa using h' + simpa using h' + +/-! + +### A.7. Derivative of a component squared + +-/ + +lemma deriv_component_sq {d : ℕ} {ν μ : Fin d} (x : Space d) : + (deriv ν (fun x => (x μ) ^ 2) x) = if ν = μ then 2 * x μ else 0:= by + rw [deriv_eq_fderiv_basis] + rw [fderiv_pow] + simp only [Nat.add_one_sub_one, pow_one, nsmul_eq_mul, Nat.cast_ofNat, + ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] + rw [← deriv_eq_fderiv_basis, deriv_component] + simp only [mul_ite, mul_one, mul_zero] + fun_prop + +/-! + +### A.8. Derivivatives of components + +-/ + +lemma deriv_euclid {d ν μ} {f : Space d → EuclideanSpace ℝ (Fin n)} + (hf : Differentiable ℝ f) (x : Space d) : + deriv ν (fun x => f x μ) x = deriv ν (fun x => f x) x μ := by + rw [deriv_eq_fderiv_basis] + change fderiv ℝ (EuclideanSpace.proj μ ∘ fun x => f x) x (basis ν) = _ + rw [fderiv_comp] + · simp + rw [← deriv_eq_fderiv_basis] + · fun_prop + · fun_prop + +lemma deriv_lorentz_vector {d ν μ} {f : Space d → Lorentz.Vector d} + (hf : Differentiable ℝ f) (x : Space d) : + deriv ν (fun x => f x μ) x = deriv ν (fun x => f x) x μ := by + rw [deriv_eq_fderiv_basis] + change fderiv ℝ (Lorentz.Vector.coordCLM μ ∘ fun x => f x) x (basis ν) = _ + rw [fderiv_comp] + · simp + rw [← deriv_eq_fderiv_basis] + rfl + · fun_prop + · fun_prop + +/-! + +### A.9. Derivative of a norm squared + +-/ + +/-! + +#### A.9.1. Differentiability of the norm squared function + +-/ +@[fun_prop] +lemma norm_sq_differentiable : Differentiable ℝ (fun x : Space d => ‖x‖ ^ 2) := by + simp [Space.norm_sq_eq] + fun_prop + +/-! + +#### A.9.2. Derivative of the norm squared function + +-/ + +lemma deriv_norm_sq (x : Space d) (i : Fin d) : + deriv i (fun x => ‖x‖ ^ 2) x = 2 * x i := by + simp [Space.norm_sq_eq] + rw [deriv_eq_fderiv_basis] + rw [fderiv_fun_sum] + simp only [ContinuousLinearMap.coe_sum', Finset.sum_apply] + conv_lhs => + enter [2, j] + rw [← deriv_eq_fderiv_basis] + simp + simp [deriv_component_sq] + intro i hi + fun_prop + +/-! + +### A.10. Derivative of the inner product + +-/ + +open InnerProductSpace + +/-! + +#### A.10.1. Differentiability of the inner product function + +-/ + +/-- The inner product is differentiable. -/ +@[fun_prop] +lemma inner_differentiable {d : ℕ} : + Differentiable ℝ (fun y : Space d => ⟪y, y⟫_ℝ) := by + simp only [inner_self_eq_norm_sq_to_K, RCLike.ofReal_real_eq_id, id_eq] + fun_prop + +@[fun_prop] +lemma inner_differentiableAt {d : ℕ} (x : Space d) : + DifferentiableAt ℝ (fun y : Space d => ⟪y, y⟫_ℝ) x := by + apply inner_differentiable.differentiableAt + +@[fun_prop] +lemma inner_apply_differentiableAt {d : ℕ} [NormedAddCommGroup M] + [NormedSpace ℝ M] + {f : M → Space d} {g : M → Space d} (x : M) + (hf : DifferentiableAt ℝ f x) (hg : DifferentiableAt ℝ g x) : + DifferentiableAt ℝ (fun y : M => ⟪f y, g y⟫_ℝ) x := by + apply DifferentiableAt.inner + · fun_prop + · fun_prop + +@[fun_prop] +lemma inner_apply_differentiable {d : ℕ} [NormedAddCommGroup M] + [NormedSpace ℝ M] + {f : M → Space d} {g : M → Space d} + (hf : Differentiable ℝ f) (hg : Differentiable ℝ g) : + Differentiable ℝ (fun y : M => ⟪f y, g y⟫_ℝ) := by + apply Differentiable.inner + · fun_prop + · fun_prop +@[fun_prop] +lemma inner_contDiff {n : WithTop ℕ∞} {d : ℕ} : + ContDiff ℝ n (fun y : Space d => ⟪y, y⟫_ℝ) := by + apply ContDiff.inner + · fun_prop + · fun_prop + +@[fun_prop] +lemma inner_apply_contDiff {n : WithTop ℕ∞} {d : ℕ} [NormedAddCommGroup M] + [NormedSpace ℝ M] + {f : M → Space d} {g : M → Space d} + (hf : ContDiff ℝ n f) (hg : ContDiff ℝ n g) : + ContDiff ℝ n (fun y : M => ⟪f y, g y⟫_ℝ) := by + apply ContDiff.inner + · fun_prop + · fun_prop +/-! + +#### A.10.2. Derivative of the inner product function + +-/ + +lemma deriv_eq_inner_self (x : Space d) (i : Fin d) : + deriv i (fun x => ⟪x, x⟫_ℝ) x = 2 * x i := by + convert deriv_norm_sq x i + exact real_inner_self_eq_norm_sq _ + +/-! + +#### A.10.3. Derivative of the inner product on one side + +-/ + +@[simp] +lemma deriv_inner_left {d} (x1 x2 : Space d) (i : Fin d) : + deriv i (fun x => ⟪x, x2⟫_ℝ) x1 = x2 i := by + rw [deriv_eq_fderiv_basis] + rw [fderiv_inner_apply] + simp only [fderiv_fun_const, Pi.zero_apply, ContinuousLinearMap.zero_apply, inner_zero_right, + fderiv_id', ContinuousLinearMap.coe_id', id_eq, basis_inner, zero_add] + · fun_prop + · fun_prop + +@[simp] +lemma deriv_inner_right {d} (x1 x2 : Space d) (i : Fin d) : + deriv i (fun x => ⟪x1, x⟫_ℝ) x2 = x1 i := by + rw [deriv_eq_fderiv_basis] + rw [fderiv_inner_apply] + simp only [fderiv_id', ContinuousLinearMap.coe_id', id_eq, inner_basis, fderiv_fun_const, + Pi.ofNat_apply, ContinuousLinearMap.zero_apply, inner_zero_left, add_zero] + · fun_prop + · fun_prop +/-! + +### A.11. Differentiability of derivatives + +-/ + +lemma deriv_differentiable {M} [NormedAddCommGroup M] + [NormedSpace ℝ M] {d : ℕ} {f : Space d → M} + (hf : ContDiff ℝ 2 f) (i : Fin d) : + Differentiable ℝ (deriv i f) := by + suffices h1 : Differentiable ℝ (fun x => fderiv ℝ f x (basis i)) by exact h1 + fun_prop + +/-! + +## B. Derivatives of distributions on `Space d` + +-/ + +open Distribution SchwartzMap + +/-! + +### B.1. The definition + +-/ +/-- Given a distribution (function) `f : Space d →d[ℝ] M` the derivative + of `f` in direction `μ`. -/ +noncomputable def distDeriv {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (μ : Fin d) : ((Space d) →d[ℝ] M) →ₗ[ℝ] (Space d) →d[ℝ] M where + toFun f := + let ev : (Space d →L[ℝ] M) →L[ℝ] M := { + toFun v := v (basis μ) + map_add' v1 v2 := by + simp only [ContinuousLinearMap.add_apply] + map_smul' a v := by + simp + } + ev.comp (Distribution.fderivD ℝ f) + map_add' f1 f2 := by + simp + map_smul' a f := by simp + +/-! + +### B.2. Basic equality + +-/ + +lemma distDeriv_apply {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (μ : Fin d) (f : (Space d) →d[ℝ] M) (ε : 𝓢(Space d, ℝ)) : + (distDeriv μ f) ε = fderivD ℝ f ε (basis μ) := by + simp [distDeriv, Distribution.fderivD] + +/-! + +### B.3. Commutation of derivatives + +-/ + +lemma schwartMap_fderiv_comm {d} + (μ ν : Fin d) (x : Space d) (η : 𝓢(Space d, ℝ)) : + ((SchwartzMap.evalCLM ℝ (Space d) ℝ (basis μ)) + ((fderivCLM ℝ (Space d) ℝ) ((SchwartzMap.evalCLM ℝ (Space d) ℝ (basis ν)) + ((fderivCLM ℝ (Space d) ℝ) η)))) x = + ((SchwartzMap.evalCLM ℝ (Space d) ℝ (basis ν)) + ((fderivCLM ℝ (Space d) ℝ) ((SchwartzMap.evalCLM ℝ (Space d) ℝ (basis μ)) + ((fderivCLM ℝ (Space d) ℝ) η)))) x := by + have h1 := η.smooth + have h2 := h1 2 + change fderiv ℝ (fun x => fderiv ℝ η x (basis ν)) x (basis μ) = + fderiv ℝ (fun x => fderiv ℝ η x (basis μ)) x (basis ν) + rw [fderiv_clm_apply, fderiv_clm_apply] + simp only [fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.comp_zero, zero_add, + ContinuousLinearMap.flip_apply] + rw [IsSymmSndFDerivAt.eq] + apply ContDiffAt.isSymmSndFDerivAt (n := 2) + · refine ContDiff.contDiffAt ?_ + exact h2 + · simp + · fun_prop + · exact differentiableAt_const (basis μ) + · fun_prop + · exact differentiableAt_const (basis ν) + +lemma distDeriv_commute {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (μ ν : Fin d) (f : (Space d) →d[ℝ] M) : + (distDeriv ν (distDeriv μ f)) = (distDeriv μ (distDeriv ν f)) := by + ext η + simp [distDeriv, Distribution.fderivD] + congr 1 + ext x + rw [schwartMap_fderiv_comm μ ν x η] + +end Space diff --git a/PhysLean/SpaceAndTime/Space/Derivatives/Curl.lean b/PhysLean/SpaceAndTime/Space/Derivatives/Curl.lean new file mode 100644 index 000000000..3b29816ab --- /dev/null +++ b/PhysLean/SpaceAndTime/Space/Derivatives/Curl.lean @@ -0,0 +1,358 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong, Joseph Tooby-Smith, Lode Vermeulen +-/ +import PhysLean.SpaceAndTime.Space.Derivatives.Laplacian +/-! + +# Curl on Space + +## i. Overview + +In this module we define the curl of functions and distributions on 3-dimensional +space `Space 3`. + +We also prove some basic vector-identities involving of the curl operator. + +## ii. Key results + +- `curl` : The curl operator on functions from `Space 3` to `EuclideanSpace ℝ (Fin 3)`. +- `distCurl` : The curl operator on distributions from `Space 3` to `EuclideanSpace ℝ (Fin 3)`. +- `div_of_curl_eq_zero` : The divergence of the curl of a function is zero. +- `distCurl_distGrad_eq_zero` : The curl of the gradient of a distribution is zero. + +## iii. Table of contents + +- A. The curl on functions + - A.1. The curl on the zero function + - A.2. The curl on a constant function + - A.3. The curl distributes over addition + - A.4. The curl distributes over scalar multiplication + - A.5. The curl of a linear map is a linear map + - A.6. Preliminary lemmas about second derivatives + - A.7. The div of a curl is zero + - A.8. The curl of a curl +- B. The curl on distributions + - B.1. The components of the curl + - B.2. Basic equalities + - B.3. The curl of a grad is zero + +## iv. References + +-/ + +namespace Space + +/-! + +## A. The curl on functions + +-/ + +/-- The vector calculus operator `curl`. -/ +noncomputable def curl (f : Space → EuclideanSpace ℝ (Fin 3)) : + Space → EuclideanSpace ℝ (Fin 3) := fun x => + -- get i-th component of `f` + let fi i x := (f x) i + -- derivative of i-th component in j-th coordinate + -- ∂fᵢ/∂xⱼ + let df i j x := ∂[j] (fi i) x + WithLp.toLp 2 fun i => + match i with + | 0 => df 2 1 x - df 1 2 x + | 1 => df 0 2 x - df 2 0 x + | 2 => df 1 0 x - df 0 1 x + +@[inherit_doc curl] +macro (name := curlNotation) "∇" "×" f:term:100 : term => `(curl $f) + +/-! + +### A.1. The curl on the zero function + +-/ + +@[simp] +lemma curl_zero : ∇ × (0 : Space → EuclideanSpace ℝ (Fin 3)) = 0 := by + unfold curl Space.deriv + simp only [Fin.isValue, Pi.ofNat_apply, fderiv_fun_const, ContinuousLinearMap.zero_apply, + sub_self] + ext x i + fin_cases i <;> + rfl + +/-! + +### A.2. The curl on a constant function + +-/ + +@[simp] +lemma curl_const : ∇ × (fun _ : Space => v₃) = 0 := by + unfold curl Space.deriv + simp only [Fin.isValue, fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.zero_apply, + sub_self] + ext x i + fin_cases i <;> + rfl + +/-! + +### A.3. The curl distributes over addition + +-/ + +lemma curl_add (f1 f2 : Space → EuclideanSpace ℝ (Fin 3)) + (hf1 : Differentiable ℝ f1) (hf2 : Differentiable ℝ f2) : + ∇ × (f1 + f2) = ∇ × f1 + ∇ × f2 := by + unfold curl + ext x i + fin_cases i <;> + · simp only [Fin.isValue, Pi.add_apply, PiLp.add_apply, Fin.zero_eta] + repeat rw [deriv_coord_add] + simp only [Fin.isValue, Pi.add_apply] + ring + repeat assumption + +/-! + +### A.4. The curl distributes over scalar multiplication + +-/ + +lemma curl_smul (f : Space → EuclideanSpace ℝ (Fin 3)) (k : ℝ) + (hf : Differentiable ℝ f) : + ∇ × (k • f) = k • ∇ × f := by + unfold curl + ext x i + fin_cases i <;> + · simp only [Fin.isValue, Pi.smul_apply, PiLp.smul_apply, smul_eq_mul, Fin.zero_eta] + rw [deriv_coord_smul, deriv_coord_smul, mul_sub] + repeat fun_prop + +/-! + +### A.5. The curl of a linear map is a linear map + +-/ + +variable {W} [NormedAddCommGroup W] [NormedSpace ℝ W] + +lemma curl_linear_map (f : W → Space 3 → EuclideanSpace ℝ (Fin 3)) + (hf : ∀ w, Differentiable ℝ (f w)) + (hf' : IsLinearMap ℝ f) : + IsLinearMap ℝ (fun w => ∇ × (f w)) := by + constructor + · intro w w' + rw [hf'.map_add] + rw [curl_add] + repeat fun_prop + · intros k w + rw [hf'.map_smul] + rw [curl_smul] + fun_prop + +/-! + +### A.6. Preliminary lemmas about second derivatives + +-/ + +/-- Second derivatives distribute coordinate-wise over addition (all three components for div). -/ +lemma deriv_coord_2nd_add (f : Space → EuclideanSpace ℝ (Fin 3)) (hf : ContDiff ℝ 2 f) : + ∂[i] (fun x => ∂[u] (fun x => f x u) x + (∂[v] (fun x => f x v) x + ∂[w] (fun x => f x w) x)) = + (∂[i] (∂[u] (fun x => f x u))) + (∂[i] (∂[v] (fun x => f x v))) + + (∂[i] (∂[w] (fun x => f x w))) := by + unfold deriv + ext x + rw [fderiv_fun_add, fderiv_fun_add] + simp only [ContinuousLinearMap.add_apply, Pi.add_apply] + ring + repeat fun_prop + +/-- Second derivatives distribute coordinate-wise over subtraction (two components for curl). -/ +lemma deriv_coord_2nd_sub (f : Space → EuclideanSpace ℝ (Fin 3)) (hf : ContDiff ℝ 2 f) : + ∂[u] (fun x => ∂[v] (fun x => f x w) x - ∂[w] (fun x => f x v) x) = + (∂[u] (∂[v] (fun x => f x w))) - (∂[u] (∂[w] (fun x => f x v))) := by + unfold deriv + ext x + simp only [Pi.sub_apply] + rw [fderiv_fun_sub] + simp only [ContinuousLinearMap.coe_sub', Pi.sub_apply] + repeat fun_prop + +/-! + +### A.7. The div of a curl is zero + +-/ + +lemma div_of_curl_eq_zero (f : Space → EuclideanSpace ℝ (Fin 3)) (hf : ContDiff ℝ 2 f) : + ∇ ⬝ (∇ × f) = 0 := by + unfold div curl Finset.sum + ext x + simp only [Fin.isValue, Fin.univ_val_map, List.ofFn_succ, Fin.succ_zero_eq_one, + Fin.succ_one_eq_two, List.ofFn_zero, Multiset.sum_coe, List.sum_cons, List.sum_nil, add_zero, + Pi.zero_apply] + rw [deriv_coord_2nd_sub, deriv_coord_2nd_sub, deriv_coord_2nd_sub] + simp only [Fin.isValue, Pi.sub_apply] + rw [deriv_commute fun x => f x 0, deriv_commute fun x => f x 1, + deriv_commute fun x => f x 2] + simp only [Fin.isValue, sub_add_sub_cancel', sub_self] + repeat + try apply contDiff_euclidean.mp + exact hf + +/-! + +### A.8. The curl of a curl + +-/ + +lemma curl_of_curl (f : Space → EuclideanSpace ℝ (Fin 3)) (hf : ContDiff ℝ 2 f) : + ∇ × (∇ × f) = ∇ (∇ ⬝ f) - Δ f := by + unfold laplacianVec laplacian div grad curl Finset.sum + simp only [Fin.isValue, Fin.univ_val_map, List.ofFn_succ, Fin.succ_zero_eq_one, + Fin.succ_one_eq_two, List.ofFn_zero, Multiset.sum_coe, List.sum_cons, List.sum_nil, add_zero] + ext x i + fin_cases i <;> + · simp only [Fin.isValue, Fin.reduceFinMk, Pi.sub_apply] + rw [deriv_coord_2nd_sub, deriv_coord_2nd_sub] + simp only [Fin.isValue, Pi.sub_apply, PiLp.sub_apply] + rw [deriv_coord_2nd_add] + rw [deriv_commute fun x => f x 0, deriv_commute fun x => f x 1, + deriv_commute fun x => f x 2] + simp only [Fin.isValue, Pi.add_apply] + ring + repeat + try apply contDiff_euclidean.mp + exact hf + +/-! + +## B. The curl on distributions + +-/ + +open MeasureTheory SchwartzMap InnerProductSpace Distribution + +/-- The curl of a distribution `Space →d[ℝ] (EuclideanSpace ℝ (Fin 3))` as a distribution + `Space →d[ℝ] (EuclideanSpace ℝ (Fin 3))`. -/ +noncomputable def distCurl : (Space →d[ℝ] (EuclideanSpace ℝ (Fin 3))) →ₗ[ℝ] + (Space) →d[ℝ] (EuclideanSpace ℝ (Fin 3)) where + toFun f := + let curl : (Space →L[ℝ] (EuclideanSpace ℝ (Fin 3))) →L[ℝ] (EuclideanSpace ℝ (Fin 3)) := { + toFun dfdx:= WithLp.toLp 2 fun i => + match i with + | 0 => dfdx (basis 2) 1 - dfdx (basis 1) 2 + | 1 => dfdx (basis 0) 2 - dfdx (basis 2) 0 + | 2 => dfdx (basis 1) 0 - dfdx (basis 0) 1 + map_add' v1 v2 := by + ext i + fin_cases i + all_goals + simp only [Fin.isValue, ContinuousLinearMap.add_apply, PiLp.add_apply, Fin.zero_eta] + ring + map_smul' a v := by + ext i + fin_cases i + all_goals + simp only [Fin.isValue, ContinuousLinearMap.coe_smul', Pi.smul_apply, PiLp.smul_apply, + smul_eq_mul, RingHom.id_apply, Fin.reduceFinMk] + ring + cont := by + apply Continuous.comp + · fun_prop + rw [continuous_pi_iff] + intro i + fin_cases i + all_goals + fun_prop + } + curl.comp (Distribution.fderivD ℝ f) + map_add' f1 f2 := by + ext x + simp + map_smul' a f := by + ext x + simp + +/-! + +### B.1. The components of the curl + +-/ + +lemma distCurl_apply_zero (f : Space →d[ℝ] (EuclideanSpace ℝ (Fin 3))) (η : 𝓢(Space, ℝ)) : + distCurl f η 0 = - f (SchwartzMap.evalCLM ℝ Space ℝ (basis 2) (fderivCLM ℝ Space ℝ η)) 1 + + f (SchwartzMap.evalCLM ℝ Space ℝ (basis 1) (fderivCLM ℝ Space ℝ η)) 2 := by + simp [distCurl] + rw [fderivD_apply, fderivD_apply] + simp + +lemma distCurl_apply_one (f : Space →d[ℝ] (EuclideanSpace ℝ (Fin 3))) (η : 𝓢(Space, ℝ)) : + distCurl f η 1 = - f (SchwartzMap.evalCLM ℝ Space ℝ (basis 0) (fderivCLM ℝ Space ℝ η)) 2 + + f (SchwartzMap.evalCLM ℝ Space ℝ (basis 2) (fderivCLM ℝ Space ℝ η)) 0 := by + simp [distCurl] + rw [fderivD_apply, fderivD_apply] + simp + +lemma distCurl_apply_two (f : Space →d[ℝ] (EuclideanSpace ℝ (Fin 3))) (η : 𝓢(Space, ℝ)) : + distCurl f η 2 = - f (SchwartzMap.evalCLM ℝ Space ℝ (basis 1) (fderivCLM ℝ Space ℝ η)) 0 + + f (SchwartzMap.evalCLM ℝ Space ℝ (basis 0) (fderivCLM ℝ Space ℝ η)) 1 := by + simp [distCurl] + rw [fderivD_apply, fderivD_apply] + simp + +/-! + +### B.2. Basic equalities + +-/ + +lemma distCurl_apply (f : Space →d[ℝ] (EuclideanSpace ℝ (Fin 3))) (η : 𝓢(Space, ℝ)) : + distCurl f η = WithLp.toLp 2 fun + | 0 => - f (SchwartzMap.evalCLM ℝ Space ℝ (basis 2) (fderivCLM ℝ Space ℝ η)) 1 + + f (SchwartzMap.evalCLM ℝ Space ℝ (basis 1) (fderivCLM ℝ Space ℝ η)) 2 + | 1 => - f (SchwartzMap.evalCLM ℝ Space ℝ (basis 0) (fderivCLM ℝ Space ℝ η)) 2 + + f (SchwartzMap.evalCLM ℝ Space ℝ (basis 2) (fderivCLM ℝ Space ℝ η)) 0 + | 2 => - f (SchwartzMap.evalCLM ℝ Space ℝ (basis 1) (fderivCLM ℝ Space ℝ η)) 0 + + f (SchwartzMap.evalCLM ℝ Space ℝ (basis 0) (fderivCLM ℝ Space ℝ η)) 1 := by + ext i + fin_cases i + · simp [distCurl_apply_zero] + · simp [distCurl_apply_one] + · simp [distCurl_apply_two] + +/-! + +### B.3. The curl of a grad is zero + +-/ + +/-- The curl of a grad is equal to zero. -/ +@[simp] +lemma distCurl_distGrad_eq_zero (f : (Space) →d[ℝ] ℝ) : + distCurl (distGrad f) = 0 := by + ext η i + fin_cases i + all_goals + · dsimp + try rw [distCurl_apply_zero] + try rw [distCurl_apply_one] + try rw [distCurl_apply_two] + rw [distGrad_eq_sum_basis, distGrad_eq_sum_basis] + simp [Pi.single_apply] + rw [← map_neg, ← map_add, ← ContinuousLinearMap.map_zero f] + congr + ext x + simp only [Fin.isValue, SchwartzMap.add_apply, SchwartzMap.neg_apply, SchwartzMap.zero_apply] + rw [schwartMap_fderiv_comm] + change ((SchwartzMap.evalCLM ℝ Space ℝ _) + ((fderivCLM ℝ Space ℝ) ((SchwartzMap.evalCLM ℝ Space ℝ _) ((fderivCLM ℝ Space ℝ) η)))) x + + - ((SchwartzMap.evalCLM ℝ Space ℝ _) + ((fderivCLM ℝ Space ℝ) ((SchwartzMap.evalCLM ℝ Space ℝ _) ((fderivCLM ℝ Space ℝ) η)))) x = _ + simp + +end Space diff --git a/PhysLean/SpaceAndTime/Space/Derivatives/Div.lean b/PhysLean/SpaceAndTime/Space/Derivatives/Div.lean new file mode 100644 index 000000000..f3105cac5 --- /dev/null +++ b/PhysLean/SpaceAndTime/Space/Derivatives/Div.lean @@ -0,0 +1,247 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong, Joseph Tooby-Smith, Lode Vermeulen +-/ +import PhysLean.SpaceAndTime.Space.Derivatives.Grad +/-! + +# Divergence on Space + +## i. Overview + +In this module we define the divergence operator on functions and +distributions from `Space d` to `EuclideanSpace ℝ (Fin d)`, and prove various basic +properties about it. + +## ii. Key results + +- `div` : The divergence operator on functions from `Space d` to `EuclideanSpace ℝ (Fin d)`. +- `distDiv` : The divergence operator on distributions from `Space d` to `EuclideanSpace ℝ (Fin d)`. +- `distDiv_ofFunction` : The divergence of a distribution from a bounded function. + +## iii. Table of contents + +- A. The divergence on functions + - A.1. The divergence on the zero function + - A.2. The divergence on a constant function + - A.3. The divergence distributes over addition + - A.4. The divergence distributes over scalar multiplication + - A.5. The divergence of a linear map is a linear map +- B. Divergence of distributions + - B.1. Basic equalities + - B.2. Divergence on distributions from bounded functions + +## iv. References + +-/ + +namespace Space + +variable {W} [NormedAddCommGroup W] [NormedSpace ℝ W] + +/-! + +## A. The divergence on functions + +-/ + +/-- The vector calculus operator `div`. -/ +noncomputable def div {d} (f : Space d → EuclideanSpace ℝ (Fin d)) : + Space d → ℝ := fun x => + -- get i-th component of `f` + let fi i x := (f x) i + -- derivative of i-th component in i-th coordinate + -- ∂fᵢ/∂xⱼ + let df i x := ∂[i] (fi i) x + ∑ i, df i x + +@[inherit_doc div] +macro (name := divNotation) "∇" "⬝" f:term:100 : term => `(div $f) + +/-! + +### A.1. The divergence on the zero function + +-/ + +@[simp] +lemma div_zero : ∇ ⬝ (0 : Space d → EuclideanSpace ℝ (Fin d)) = 0 := by + unfold div Space.deriv Finset.sum + simp only [Pi.ofNat_apply, fderiv_fun_const, ContinuousLinearMap.zero_apply, Multiset.map_const', + Finset.card_val, Finset.card_univ, Fintype.card_fin, Multiset.sum_replicate, smul_zero] + rfl + +/-! + +### A.2. The divergence on a constant function + +-/ + +@[simp] +lemma div_const : ∇ ⬝ (fun _ : Space d => v) = 0 := by + unfold div Space.deriv Finset.sum + simp only [fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.zero_apply, Multiset.map_const', + Finset.card_val, Finset.card_univ, Fintype.card_fin, Multiset.sum_replicate, smul_zero] + rfl + +/-! + +### A.3. The divergence distributes over addition + +-/ + +lemma div_add (f1 f2 : Space d → EuclideanSpace ℝ (Fin d)) + (hf1 : Differentiable ℝ f1) (hf2 : Differentiable ℝ f2) : + ∇ ⬝ (f1 + f2) = ∇ ⬝ f1 + ∇ ⬝ f2 := by + unfold div + simp only [Pi.add_apply] + funext x + simp only [Pi.add_apply] + rw [← Finset.sum_add_distrib] + congr + funext i + simp [Space.deriv] + rw [fderiv_fun_add] + simp only [ContinuousLinearMap.add_apply] + · fun_prop + · fun_prop + +/-! + +### A.4. The divergence distributes over scalar multiplication + +-/ + +lemma div_smul (f : Space d → EuclideanSpace ℝ (Fin d)) (k : ℝ) + (hf : Differentiable ℝ f) : + ∇ ⬝ (k • f) = k • ∇ ⬝ f := by + unfold div + simp only [Pi.smul_apply] + funext x + simp only [Pi.smul_apply, smul_eq_mul] + rw [Finset.mul_sum] + congr + funext i + simp [Space.deriv] + rw [fderiv_const_mul] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] + · fun_prop + +/-! + +### A.5. The divergence of a linear map is a linear map + +-/ + +lemma div_linear_map (f : W → Space 3 → EuclideanSpace ℝ (Fin 3)) + (hf : ∀ w, Differentiable ℝ (f w)) + (hf' : IsLinearMap ℝ f) : + IsLinearMap ℝ (fun w => ∇ ⬝ (f w)) := by + constructor + · intro w w' + rw [hf'.map_add] + rw [div_add] + repeat fun_prop + · intros k w + rw [hf'.map_smul] + rw [div_smul] + fun_prop + +/-! + +## B. Divergence of distributions + +-/ + +open MeasureTheory SchwartzMap InnerProductSpace Distribution + +/-- The divergence of a distribution `(Space d) →d[ℝ] (EuclideanSpace ℝ (Fin d))` as a distribution + `(Space d) →d[ℝ] ℝ`. -/ +noncomputable def distDiv {d} : + ((Space d) →d[ℝ] (EuclideanSpace ℝ (Fin d))) →ₗ[ℝ] (Space d) →d[ℝ] ℝ where + toFun f := + let trace : (Space d →L[ℝ] (EuclideanSpace ℝ (Fin d))) →L[ℝ] ℝ := { + toFun v := ∑ i, ⟪v (basis i), EuclideanSpace.single i 1⟫_ℝ + map_add' v1 v2 := by + simp only [ContinuousLinearMap.add_apply, EuclideanSpace.inner_single_right, PiLp.add_apply, + conj_trivial, one_mul] + rw [Finset.sum_add_distrib] + map_smul' a v := by + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, EuclideanSpace.inner_single_right, + PiLp.smul_apply, smul_eq_mul, conj_trivial, one_mul, RingHom.id_apply] + rw [Finset.mul_sum] + cont := by fun_prop} + trace.comp (Distribution.fderivD ℝ f) + map_add' f1 f2 := by + ext x + simp + map_smul' a f := by + ext x + simp + +/-! + +### B.1. Basic equalities + +-/ + +lemma distDiv_apply_eq_sum_fderivD {d} + (f : (Space d) →d[ℝ] EuclideanSpace ℝ (Fin d)) (η : 𝓢(Space d, ℝ)) : + distDiv f η = ∑ i, fderivD ℝ f η (basis i) i := by + simp [distDiv, EuclideanSpace.inner_single_right] + +lemma distDiv_apply_eq_sum_distDeriv {d} + (f : (Space d) →d[ℝ] EuclideanSpace ℝ (Fin d)) (η : 𝓢(Space d, ℝ)) : + distDiv f η = ∑ i, distDeriv i f η i := by + rw [distDiv_apply_eq_sum_fderivD] + rfl + +/-! + +### B.2. Divergence on distributions from bounded functions + +-/ + +/-- The divergence of a distribution from a bounded function. -/ +lemma distDiv_ofFunction {dm1 : ℕ} {f : Space dm1.succ → EuclideanSpace ℝ (Fin dm1.succ)} + {hf : IsDistBounded f} (η : 𝓢(Space dm1.succ, ℝ)) : + distDiv (distOfFunction f hf) η = + - ∫ x : Space dm1.succ, ⟪f x, Space.grad η x⟫_ℝ := by + rw [distDiv_apply_eq_sum_fderivD] + conv_rhs => + enter [1, 2, x] + rw [grad_eq_sum, inner_sum] + conv_lhs => + enter [2, i] + rw [fderivD_apply, distOfFunction_apply] + /- The following lemma could probably be moved out of this result. -/ + have integrable_lemma (i j : Fin (dm1 + 1)) : + Integrable (fun x => + (((SchwartzMap.evalCLM ℝ (Space dm1.succ) ℝ (basis i)) + ((fderivCLM ℝ (Space dm1.succ) ℝ) η)) x • f x) j) volume := by + simp only [PiLp.smul_apply] + exact (hf.pi_comp j).integrable_space _ + rw [MeasureTheory.integral_finset_sum] + · simp + congr + funext i + rw [MeasureTheory.eval_integral_piLp] + · congr + funext x + simp [inner_smul_right, EuclideanSpace.inner_single_right] + left + rw [deriv_eq_fderiv_basis] + · intro j + exact integrable_lemma i j + · intro i hi + simp only [Nat.succ_eq_add_one, inner_smul_right, EuclideanSpace.inner_single_right] + convert integrable_lemma i i using 2 + rename_i x + simp only [conj_trivial, one_mul, Nat.succ_eq_add_one, PiLp.smul_apply, smul_eq_mul, + mul_eq_mul_right_iff] + left + rw [deriv_eq_fderiv_basis] + rfl + +end Space diff --git a/PhysLean/SpaceAndTime/Space/Derivatives/Grad.lean b/PhysLean/SpaceAndTime/Space/Derivatives/Grad.lean new file mode 100644 index 000000000..6eae8e3a9 --- /dev/null +++ b/PhysLean/SpaceAndTime/Space/Derivatives/Grad.lean @@ -0,0 +1,501 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong, Joseph Tooby-Smith, Lode Vermeulen +-/ +import PhysLean.SpaceAndTime.Space.Derivatives.Basic +/-! + +# Gradient of functions and distributions on `Space d` + +## i. Overview + +This module defines and proves basic properties of the gradient operator +on functions from `Space d` to `ℝ` and on distributions from `Space d` to `ℝ`. + +The gradient operator returns a vector field whose components are the partial derivatives +of the input function with respect to each spatial coordinate. + +## ii. Key results + +- `grad` : The gradient operator on functions from `Space d` to `ℝ`. +- `distGrad` : The gradient operator on distributions from `Space d` to `ℝ`. + +## iii. Table of contents + +- A. The gradient of functions on `Space d` + - A.1. Gradient of the zero function + - A.2. Gradient distributes over addition + - A.3. Gradient of a constant function + - A.4. Gradient distributes over scalar multiplication + - A.5. Gradient distributes over negation + - A.6. Expansion in terms of basis vectors + - A.7. Components of the gradient + - A.8. Inner product with a gradient + - A.9. Gradient is equal to `gradient` from Mathlib + - A.10. Value of gradient in the direction of the position vector + - A.11. Gradient of the norm squared function + - A.12. Gradient of the inner product function + - A.13. Integrability with bounded functions +- B. Gradient of distributions + - B.1. The definition + - B.2. The gradient of inner products + - B.3. The gradient as a sum over basis vectors + - B.4. The underlying function of the gradient distribution + - B.5. The gradient applied to a Schwartz function + +## iv. References + +-/ + +namespace Space + +/-! + +## A. The gradient of functions on `Space d` + +-/ + +/-- The vector calculus operator `grad`. -/ +noncomputable def grad {d} (f : Space d → ℝ) : + Space d → EuclideanSpace ℝ (Fin d) := fun x => WithLp.toLp 2 fun i => ∂[i] f x + +@[inherit_doc grad] +scoped[Space] notation "∇" => grad + +/-! + +### A.1. Gradient of the zero function + +-/ + +@[simp] +lemma grad_zero : ∇ (0 : Space d → ℝ) = 0 := by + unfold grad Space.deriv + simp only [fderiv_zero, Pi.zero_apply, ContinuousLinearMap.zero_apply] + rfl + +/-! + +### A.2. Gradient distributes over addition + +-/ + +lemma grad_add (f1 f2 : Space d → ℝ) + (hf1 : Differentiable ℝ f1) (hf2 : Differentiable ℝ f2) : + ∇ (f1 + f2) = ∇ f1 + ∇ f2 := by + unfold grad + ext x i + simp only [Pi.add_apply] + rw [deriv_add] + rfl + exact hf1 + exact hf2 + +/-! + +### A.3. Gradient of a constant function + +-/ + +@[simp] +lemma grad_const : ∇ (fun _ : Space d => c) = 0 := by + unfold grad Space.deriv + simp only [fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.zero_apply] + rfl + +/-! + +### A.4. Gradient distributes over scalar multiplication + +-/ + +lemma grad_smul (f : Space d → ℝ) (k : ℝ) + (hf : Differentiable ℝ f) : + ∇ (k • f) = k • ∇ f := by + unfold grad + ext x i + simp only [Pi.smul_apply] + rw [deriv_const_smul] + rfl + exact hf + +/-! + +### A.5. Gradient distributes over negation + +-/ + +lemma grad_neg (f : Space d → ℝ) : + ∇ (- f) = - ∇ f := by + unfold grad + ext x i + simp only [Pi.neg_apply] + rw [Space.deriv_eq, fderiv_neg] + rfl + +/-! + +### A.6. Expansion in terms of basis vectors + +-/ + +lemma grad_eq_sum {d} (f : Space d → ℝ) (x : Space d) : + ∇ f x = ∑ i, deriv i f x • EuclideanSpace.single i 1 := by + ext i + simp [grad, deriv_eq, - WithLp.ofLp_sum] + trans ∑ x_1, (fderiv ℝ f x) (basis x_1) • (EuclideanSpace.single x_1 1).ofLp i; swap + · change _ = WithLp.linearEquiv 2 ℝ (V := Fin d → ℝ) (∑ x_1, (fderiv ℝ f x) (basis x_1) • + EuclideanSpace.single x_1 1) i + rw [map_sum, Finset.sum_apply] + rfl + rw [Finset.sum_eq_single i] + · simp [basis] + · intro j hj + simp [basis] + exact fun a a_1 => False.elim (a (id (Eq.symm a_1))) + · simp + +/-! + +### A.7. Components of the gradient + +-/ + +lemma grad_apply {d} (f : Space d → ℝ) (x : Space d) (i : Fin d) : + (∇ f x) i = deriv i f x := by + rw [grad_eq_sum] + change WithLp.linearEquiv 2 ℝ (Fin d → ℝ) (∑ x_1, (fderiv ℝ f x) (basis x_1) • + EuclideanSpace.single x_1 1) i = _ + rw [map_sum, Finset.sum_apply] + simp [Pi.single_apply] + rfl + +/-! + +### A.8. Inner product with a gradient + +-/ + +open InnerProductSpace + +lemma grad_inner_single {d} (f : Space d → ℝ) (x : Space d) (i : Fin d) : + ⟪∇ f x, EuclideanSpace.single i 1⟫_ℝ = deriv i f x := by + simp only [EuclideanSpace.inner_single_right, conj_trivial, + one_mul] + exact rfl + +lemma grad_inner_eq {d} (f : Space d → ℝ) (x : Space d) (y : EuclideanSpace ℝ (Fin d)) : + ⟪∇ f x, y⟫_ℝ = ∑ i, y i * ∂[i] f x:= by + have hy : y = ∑ i, y i • EuclideanSpace.basisFun (Fin d) ℝ i := by + conv_lhs => rw [← OrthonormalBasis.sum_repr (EuclideanSpace.basisFun (Fin d) ℝ) y] + dsimp [basis] + conv_lhs => rw [hy, inner_sum] + simp [inner_smul_right, grad_inner_single] + +lemma inner_grad_eq {d} (f : Space d → ℝ) (x : EuclideanSpace ℝ (Fin d)) (y : Space d) : + ⟪x, ∇ f y⟫_ℝ = ∑ i, x i * ∂[i] f y := by + rw [← grad_inner_eq] + exact real_inner_comm (∇ f y) x + +lemma grad_inner_repr_eq {d} (f : Space d → ℝ) (x y : Space d) : + ⟪∇ f x, (Space.basis).repr y⟫_ℝ = fderiv ℝ f x y := by + rw [grad_inner_eq f x ((Space.basis).repr y), Space.fderiv_eq_sum_deriv] + simp + +lemma repr_grad_inner_eq {d} (f : Space d → ℝ) (x y : Space d) : + ⟪(Space.basis).repr x, ∇ f y⟫_ℝ = fderiv ℝ f y x := by + rw [← grad_inner_repr_eq f y x] + exact real_inner_comm (∇ f y) ((Space.basis).repr x) + +/-! + +### A.9. Gradient is equal to `gradient` from Mathlib + +-/ + +lemma grad_eq_gradiant {d} (f : Space d → ℝ) : + ∇ f = basis.repr ∘ gradient f := by + funext x + have hx (y : EuclideanSpace ℝ (Fin d)) : ⟪(Space.basis).repr (gradient f x), y⟫_ℝ = + ⟪∇ f x, y⟫_ℝ := by + rw [gradient, basis_repr_inner_eq, toDual_symm_apply] + simp [grad_inner_eq f x, fderiv_eq_sum_deriv] + have h1 : ∀ y, ⟪(Space.basis).repr (gradient f x) - ∇ f x, y⟫_ℝ = 0 := by + intro y + rw [inner_sub_left, hx y] + simp + have h2 := h1 (basis.repr (gradient f x) - ∇ f x) + rw [inner_self_eq_zero, sub_eq_zero] at h2 + simp [h2] + +lemma gradient_eq_grad {d} (f : Space d → ℝ) : + gradient f = basis.repr.symm ∘ ∇ f := by + rw [grad_eq_gradiant f] + ext x + simp + +lemma gradient_eq_sum {d} (f : Space d → ℝ) (x : Space d) : + gradient f x = ∑ i, deriv i f x • basis i := by + simp [gradient_eq_grad, grad_eq_sum f x] + +lemma euclid_gradient_eq_sum {d} (f : EuclideanSpace ℝ (Fin d) → ℝ) (x : EuclideanSpace ℝ (Fin d)) : + gradient f x = ∑ i, fderiv ℝ f x (EuclideanSpace.single i 1) • EuclideanSpace.single i 1 := by + apply ext_inner_right (𝕜 := ℝ) fun y => ?_ + simp [gradient] + have hy : y = ∑ i, y i • EuclideanSpace.single i 1 := by + conv_lhs => rw [← OrthonormalBasis.sum_repr (EuclideanSpace.basisFun (Fin d) ℝ) y] + simp + conv_lhs => rw [hy] + simp [sum_inner, inner_smul_left, EuclideanSpace.inner_single_left] + congr + funext i + ring + +/-! + +### A.10. Value of gradient in the direction of the position vector + +-/ + +/-- The gradient in the direction of the space position. -/ +lemma grad_inner_space_unit_vector {d} (x : Space d) (f : Space d → ℝ) (hd : Differentiable ℝ f) : + ⟪∇ f x, ‖x‖⁻¹ • basis.repr x⟫_ℝ = _root_.deriv (fun r => f (r • ‖x‖⁻¹ • x)) ‖x‖ := by + by_cases hx : x = 0 + · subst hx + simp + symm + calc _ + _ = fderiv ℝ (f ∘ (fun r => r • ‖x‖⁻¹ • x)) ‖x‖ 1 := by rfl + _ = (fderiv ℝ f (‖x‖ • ‖x‖⁻¹ • x)) (_root_.deriv (fun r => r • ‖x‖⁻¹ • x) ‖x‖) := by + rw [fderiv_comp _ (by fun_prop) (by fun_prop)] + simp + _ = (fderiv ℝ f x) (_root_.deriv (fun r => r • ‖x‖⁻¹ • x) ‖x‖) := by + have hx : ‖x‖ ≠ 0 := norm_ne_zero_iff.mpr hx + rw [smul_smul] + field_simp + simp + rw [grad_inner_eq f x (‖x‖⁻¹ • basis.repr x)] + rw [deriv_smul_const (by fun_prop)] + simp only [deriv_id'', one_smul, map_smul, fderiv_eq_sum_deriv, smul_eq_mul, Finset.mul_sum, + PiLp.smul_apply, basis_repr_apply] + ring_nf + +lemma grad_inner_space {d} (x : Space d) (f : Space d → ℝ) (hd : Differentiable ℝ f) : + ⟪∇ f x, basis.repr x⟫_ℝ = ‖x‖ * _root_.deriv (fun r => f (r • ‖x‖⁻¹ • x)) ‖x‖ := by + rw [← grad_inner_space_unit_vector _ _ hd, inner_smul_right] + by_cases hx : x = 0 + · subst hx + simp + have hx : ‖x‖ ≠ 0 := norm_ne_zero_iff.mpr hx + field_simp + +/-! + +### A.11. Gradient of the norm squared function + +-/ + +lemma grad_norm_sq (x : Space d) : + ∇ (fun x => ‖x‖ ^ 2) x = (2 : ℝ) • basis.repr x := by + ext i + rw [grad_eq_sum] + change WithLp.linearEquiv 2 ℝ (Fin d → ℝ) (∑ x_1, (fderiv ℝ (fun x => ‖x‖ ^ 2) x) (basis x_1) • + EuclideanSpace.single x_1 1) i = _ + rw [map_sum, Finset.sum_apply] + simp [Pi.single_apply] + +/-! + +### A.12. Gradient of the inner product function + +-/ + +/-- The gradient of the inner product is given by `2 • x`. -/ +lemma grad_inner {d : ℕ} : + ∇ (fun y : Space d => ⟪y, y⟫_ℝ) = fun z => (2 : ℝ) • basis.repr z := by + ext z i + simp [Space.grad] + rw [deriv] + simp only [fderiv_norm_sq_apply, ContinuousLinearMap.coe_smul', coe_innerSL_apply, Pi.smul_apply, + nsmul_eq_mul, Nat.cast_ofNat, mul_eq_mul_left_iff, OfNat.ofNat_ne_zero, or_false] + simp + +lemma grad_inner_left {d : ℕ} (x : Space d) : + ∇ (fun y : Space d => ⟪y, x⟫_ℝ) = fun _ => basis.repr x := by + ext z i + simp [Space.grad] + +lemma grad_inner_right {d : ℕ} (x : Space d) : + ∇ (fun y : Space d => ⟪x, y⟫_ℝ) = fun _ => basis.repr x := by + rw [← grad_inner_left x] + congr + funext y + exact real_inner_comm y x + +/-! + +### A.13. Integrability with bounded functions + +-/ + +open InnerProductSpace Distribution SchwartzMap MeasureTheory + +/- The quantity `⟪f x, Space.grad η x⟫_ℝ` is integrable for `f` bounded + and `η` a Schwartz map. -/ +lemma integrable_isDistBounded_inner_grad_schwartzMap {dm1 : ℕ} + {f : Space dm1.succ → EuclideanSpace ℝ (Fin dm1.succ)} + (hf : IsDistBounded f) (η : 𝓢(Space dm1.succ, ℝ)) : + Integrable (fun x => ⟪f x, Space.grad η x⟫_ℝ) volume := by + conv => + enter [1, x] + rw [grad_eq_sum, inner_sum] + apply MeasureTheory.integrable_finset_sum + intro i _ + simp [inner_smul_right] + have integrable_lemma (i j : Fin (dm1 + 1)) : + Integrable (fun x => (((SchwartzMap.evalCLM ℝ (Space dm1.succ) ℝ (basis i)) + ((fderivCLM ℝ (Space dm1.succ) ℝ) η)) x • f x) j) volume := by + simp only [PiLp.smul_apply] + exact (hf.pi_comp j).integrable_space _ + convert integrable_lemma i i using 2 + rename_i x + simp only [EuclideanSpace.inner_single_right, Nat.succ_eq_add_one, conj_trivial, one_mul, + PiLp.smul_apply, smul_eq_mul, mul_eq_mul_right_iff] + left + rw [deriv_eq_fderiv_basis] + rfl + +lemma integrable_isDistBounded_inner_grad_schwartzMap_spherical{dm1 : ℕ} + {f : Space dm1.succ → EuclideanSpace ℝ (Fin dm1.succ)} + (hf : IsDistBounded f) (η : 𝓢(Space dm1.succ, ℝ)) : + Integrable ((fun x => ⟪f x.1, Space.grad η x.1⟫_ℝ) + ∘ (homeomorphUnitSphereProd (Space dm1.succ)).symm) + ((volume (α := Space dm1.succ)).toSphere.prod + (Measure.volumeIoiPow (Module.finrank ℝ (Space dm1.succ) - 1))) := by + have h1 : Integrable ((fun x => ⟪f x.1, Space.grad η x.1⟫_ℝ)) + (.comap (Subtype.val (p := fun x => x ∈ ({0}ᶜ : Set _))) volume) := by + change Integrable ((fun x => ⟪f x, Space.grad η x⟫_ℝ) ∘ Subtype.val) + (.comap (Subtype.val (p := fun x => x ∈ ({0}ᶜ : Set _))) volume) + rw [← MeasureTheory.integrableOn_iff_comap_subtypeVal] + apply Integrable.integrableOn + exact integrable_isDistBounded_inner_grad_schwartzMap hf η + simp + have he := (MeasureTheory.Measure.measurePreserving_homeomorphUnitSphereProd + (volume (α := Space dm1.succ))) + rw [← he.integrable_comp_emb] + convert h1 + simp only [Nat.succ_eq_add_one, Function.comp_apply, Homeomorph.symm_apply_apply] + exact Homeomorph.measurableEmbedding (homeomorphUnitSphereProd (Space dm1.succ)) + +/-! + +## B. Gradient of distributions + +-/ + +/-! + +### B.1. The definition + +-/ + +/-- The gradient of a distribution `(Space d) →d[ℝ] ℝ` as a distribution + `(Space d) →d[ℝ] (EuclideanSpace ℝ (Fin d))`. -/ +noncomputable def distGrad {d} : + ((Space d) →d[ℝ] ℝ) →ₗ[ℝ] (Space d) →d[ℝ] (EuclideanSpace ℝ (Fin d)) where + toFun f := basis.repr.toContinuousLinearMap ∘L + ((InnerProductSpace.toDual ℝ (Space d)).symm.toContinuousLinearMap).comp (fderivD ℝ f) + map_add' f1 f2 := by + ext x + simp + map_smul' a f := by + ext x + simp + +/-! + +### B.2. The gradient of inner products + +-/ + +lemma distGrad_inner_eq {d} (f : (Space d) →d[ℝ] ℝ) (η : 𝓢(Space d, ℝ)) + (y : EuclideanSpace ℝ (Fin d)) : ⟪distGrad f η, y⟫_ℝ = fderivD ℝ f η (basis.repr.symm y) := by + rw [distGrad] + simp only [LinearIsometryEquiv.toLinearEquiv_symm, LinearMap.coe_mk, AddHom.coe_mk, + ContinuousLinearMap.coe_comp', LinearMap.coe_toContinuousLinearMap', LinearEquiv.coe_coe, + LinearIsometryEquiv.coe_toLinearEquiv, LinearIsometryEquiv.coe_symm_toLinearEquiv, + Function.comp_apply, basis_repr_inner_eq, toDual_symm_apply] + +lemma distGrad_eq_of_inner {d} (f : (Space d) →d[ℝ] ℝ) + (g : (Space d) →d[ℝ] EuclideanSpace ℝ (Fin d)) + (h : ∀ η y, fderivD ℝ f η y = ⟪g η, basis.repr y⟫_ℝ) : + distGrad f = g := by + ext1 η + apply ext_inner_right (𝕜 := ℝ) fun v => ?_ + simp [distGrad_inner_eq, h] + +/-! + +### B.3. The gradient as a sum over basis vectors + +-/ + +lemma distGrad_eq_sum_basis {d} (f : (Space d) →d[ℝ] ℝ) (η : 𝓢(Space d, ℝ)) : + distGrad f η = + ∑ i, - f (SchwartzMap.evalCLM ℝ (Space d) ℝ (basis i) (fderivCLM ℝ (Space d) ℝ η)) • + EuclideanSpace.single i 1 := by + have h1 (y : EuclideanSpace ℝ (Fin d)) : + ⟪∑ i, - f (SchwartzMap.evalCLM ℝ (Space d) ℝ (basis i) (fderivCLM ℝ (Space d) ℝ η)) • + EuclideanSpace.single i 1, y⟫_ℝ = + fderivD ℝ f η (basis.repr.symm y) := by + have hy : y = ∑ i, y i • EuclideanSpace.single i 1 := by + conv_lhs => rw [← OrthonormalBasis.sum_repr (EuclideanSpace.basisFun (Fin d) ℝ) y] + simp + rw [hy] + simp [PiLp.inner_apply, RCLike.inner_apply, conj_trivial, map_sum, map_smul, smul_eq_mul, + Pi.single_apply, fderivD_apply] + have hx (y : EuclideanSpace ℝ (Fin d)) : ⟪distGrad f η, y⟫_ℝ = + ⟪∑ i, - f (SchwartzMap.evalCLM ℝ (Space d) ℝ (basis i) (fderivCLM ℝ (Space d) ℝ η)) • + EuclideanSpace.single i 1, y⟫_ℝ := by + rw [distGrad_inner_eq, h1] + have h1 : ∀ y, ⟪distGrad f η - + (∑ i, - f (SchwartzMap.evalCLM ℝ (Space d) ℝ (basis i) (fderivCLM ℝ (Space d) ℝ η)) • + EuclideanSpace.single i 1), y⟫_ℝ = 0 := by + intro y + rw [inner_sub_left, hx y] + simp + have h2 := h1 (distGrad f η - + (∑ i, - f (SchwartzMap.evalCLM ℝ (Space d) ℝ (basis i) (fderivCLM ℝ (Space d) ℝ η)) • + EuclideanSpace.single i 1)) + rw [inner_self_eq_zero, sub_eq_zero] at h2 + rw [h2] + +/-! + +### B.4. The underlying function of the gradient distribution + +-/ + +lemma distGrad_toFun_eq_distDeriv {d} (f : (Space d) →d[ℝ] ℝ) : + (distGrad f).toFun = fun ε => WithLp.toLp 2 fun i => distDeriv i f ε := by + ext ε i + simp only [AddHom.toFun_eq_coe, LinearMap.coe_toAddHom, ContinuousLinearMap.coe_coe] + rw [distGrad_eq_sum_basis] + simp only [neg_smul, Finset.sum_neg_distrib, PiLp.neg_apply, WithLp.ofLp_sum, WithLp.ofLp_smul, + EuclideanSpace.ofLp_single, Finset.sum_apply, Pi.smul_apply, Pi.single_apply, smul_eq_mul, + mul_ite, mul_one, mul_zero, Finset.sum_ite_eq, Finset.mem_univ, ↓reduceIte] + rfl + +/-! + +### B.5. The gradient applied to a Schwartz function + +-/ + +lemma distGrad_apply {d} (f : (Space d) →d[ℝ] ℝ) (ε : 𝓢(Space d, ℝ)) : + (distGrad f) ε = fun i => distDeriv i f ε := by + change (distGrad f).toFun ε = fun i => distDeriv i f ε + rw [distGrad_toFun_eq_distDeriv] + +end Space diff --git a/PhysLean/SpaceAndTime/Space/Derivatives/Laplacian.lean b/PhysLean/SpaceAndTime/Space/Derivatives/Laplacian.lean new file mode 100644 index 000000000..f0d71413c --- /dev/null +++ b/PhysLean/SpaceAndTime/Space/Derivatives/Laplacian.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong, Joseph Tooby-Smith, Lode Vermeulen +-/ +import PhysLean.SpaceAndTime.Space.Derivatives.Div +/-! + +# The Laplacian operator on `Space d` + +## i. Overview + +In this module we define the Laplacian operator on functions and vector-valued +functions defined on `Space d`. + +## ii. Key results + +- `laplacian` : The Laplacian operator on scalar functions on `Space d`. +- `laplacianVec` : The Laplacian operator on vector-valued functions on `Space d`. + +## iii. Table of contents + +- A. Laplacian on functions to ℝ + - A.1. Relation between laplacian and divergence of gradient +- B. Laplacian on vector valued functions + +## iv. References + +-/ + +namespace Space + +/-! + +## A. Laplacian on functions to ℝ + +-/ + +/-- The scalar `laplacian` operator. -/ +noncomputable def laplacian {d} (f : Space d → ℝ) : + Space d → ℝ := fun x => + -- second derivative of f in i-th coordinate + -- ∂²f/∂xᵢ² + let df2 i x := ∂[i] (∂[i] f) x + ∑ i, df2 i x + +@[inherit_doc laplacian] +scoped[Space] notation "Δ" => laplacian + +/-! + +### A.1. Relation between laplacian and divergence of gradient + +-/ + +lemma laplacian_eq_div_of_grad (f : Space → ℝ) : + Δ f = ∇ ⬝ ∇ f := by + unfold laplacian div grad Finset.sum + simp only [Fin.univ_val_map, List.ofFn_succ, Fin.isValue, Fin.succ_zero_eq_one, + Fin.succ_one_eq_two, List.ofFn_zero, Multiset.sum_coe, List.sum_cons, List.sum_nil, add_zero] + +/-! + +## B. Laplacian on vector valued functions + +-/ + +/-- The vector `laplacianVec` operator. -/ +noncomputable def laplacianVec {d} (f : Space d → EuclideanSpace ℝ (Fin d)) : + Space d → EuclideanSpace ℝ (Fin d) := fun x => WithLp.toLp 2 fun i => + -- get i-th component of `f` + let fi i x := (f x) i + Δ (fi i) x + +@[inherit_doc laplacianVec] +scoped[Space] notation "Δ" => laplacianVec + +end Space diff --git a/PhysLean/SpaceAndTime/Space/DistConst.lean b/PhysLean/SpaceAndTime/Space/DistConst.lean new file mode 100644 index 000000000..72f9b6bb5 --- /dev/null +++ b/PhysLean/SpaceAndTime/Space/DistConst.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +import PhysLean.SpaceAndTime.Space.Derivatives.Curl +/-! + +# The constant distribution on space + +## i. Overview + +In this module we define the constant distribution from `Space d` to a module `M`. +That is the distribution which sends every Schwartz function to its +integral multiplied by a fixed element `m : M`. + +We show that the derivatives of this constant distribution are zero. +## ii. Key results + +- `distConst` : The constant distribution from `Space d` to a module `M`. + +## iii. Table of contents + +- A. The definition of the constant distribution +- B. Derivatives of the constant distribution + +## iv. References + +-/ + +namespace Space +open Distribution + +/-! + +## A. The definition of the constant distribution + +-/ + +/-- The constant distribution from `Space d` to a module `M` associated with + `m : M`. -/ +noncomputable def distConst {M } [NormedAddCommGroup M] [NormedSpace ℝ M] (d : ℕ) (m : M) : + (Space d) →d[ℝ] M := const ℝ (Space d) m + +/-! + +## B. Derivatives of the constant distribution + +-/ + +@[simp] +lemma distDeriv_distConst {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (μ : Fin d) (m : M) : + distDeriv μ (distConst d m) = 0 := by + ext η + simp [distDeriv, distConst] + +@[simp] +lemma distGrad_distConst {d} (m : ℝ) : + distGrad (distConst d m) = 0 := by + ext η + simp [distGrad, distConst] + +@[simp] +lemma distDiv_distConst {d} (m : EuclideanSpace ℝ (Fin d)) : + distDiv (distConst d m) = 0 := by + ext η + simp [distDiv, distConst] + +@[simp] +lemma distCurl_distConst (m : EuclideanSpace ℝ (Fin 3)) : + distCurl (distConst 3 m) = 0 := by + ext η + simp [distCurl, distConst] + +end Space diff --git a/PhysLean/SpaceAndTime/Space/DistOfFunction.lean b/PhysLean/SpaceAndTime/Space/DistOfFunction.lean new file mode 100644 index 000000000..5e86d651f --- /dev/null +++ b/PhysLean/SpaceAndTime/Space/DistOfFunction.lean @@ -0,0 +1,171 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +import PhysLean.SpaceAndTime.Space.IsDistBounded +import Mathlib.MeasureTheory.SpecificCodomains.WithLp +/-! + +# Distributions from functions on space + +## i. Overview + +In this module we define distributions on space constructed from functions +`f : Space d → F` satisfying the condition `IsDistBounded f`. + +This gives a convenient way to construct distributions from functions, without needing +to reference the underlying Schwartz maps. + +## ii. Key results + +- `distOfFunction f hf` : The distribution on space constructed from the function + `f : Space d → F` satisfying the `IsDistBounded f` condition. + +## iii. Table of contents + +- A. Definition of a distribution from a function +- B. Linarity properties of getting distributions from functions +- C. Properties related to inner products +- D. Components + +## iv. References + +-/ +open SchwartzMap NNReal +noncomputable section + +variable (𝕜 : Type) {E F F' : Type} [RCLike 𝕜] [NormedAddCommGroup E] [NormedAddCommGroup F] + [NormedAddCommGroup F'] [NormedSpace ℝ E] [NormedSpace ℝ F] + +namespace Space + +open MeasureTheory + +/-! + +## A. Definition of a distribution from a function + +-/ + +/-- A distribution `Space d →d[ℝ] F` from a function + `f : Space d → F` which satisfies the `IsDistBounded f` condition. -/ +def distOfFunction {d : ℕ} (f : Space d → F) (hf : IsDistBounded f) : + (Space d) →d[ℝ] F := by + refine mkCLMtoNormedSpace (fun η => ∫ x, η x • f x) ?_ ?_ hf.integral_mul_schwartzMap_bounded + · /- Addition -/ + intro η κ + simp only [SchwartzMap.add_apply] + conv_lhs => + enter [2, a] + rw [add_smul] + rw [integral_add (by fun_prop) (by fun_prop)] + · /- SMul-/ + intro a η + simp only [SchwartzMap.smul_apply, smul_eq_mul, RingHom.id_apply] + conv_lhs => + enter [2, a] + rw [← smul_smul] + rw [integral_smul] + +lemma distOfFunction_apply {d : ℕ} (f : Space d → F) + (hf : IsDistBounded f) (η : 𝓢(Space d, ℝ)) : + distOfFunction f hf η = ∫ x, η x • f x := rfl + +/-! + +## B. Linarity properties of getting distributions from functions + +-/ +@[simp] +lemma distOfFunction_zero_eq_zero {d : ℕ} : + distOfFunction (fun _ : Space d => (0 : F)) (by fun_prop) = 0 := by + ext η + simp [distOfFunction_apply] + +lemma distOfFunction_smul {d : ℕ} (f : Space d → F) + (hf : IsDistBounded f) (c : ℝ) : + distOfFunction (c • f) (by fun_prop) = c • distOfFunction f hf := by + ext η + change _ = c • ∫ x, η x • f x + rw [distOfFunction_apply] + simp only [Pi.smul_apply] + rw [← integral_smul] + congr + funext x + rw [smul_comm] + +lemma distOfFunction_smul_fun {d : ℕ} (f : Space d → F) + (hf : IsDistBounded f) (c : ℝ) : + distOfFunction (fun x => c • f x) (by fun_prop) = c • distOfFunction f hf := by + ext η + change _ = c • ∫ x, η x • f x + rw [distOfFunction_apply] + rw [← integral_smul] + congr + funext x + rw [smul_comm] + +lemma distOfFunction_mul_fun {d : ℕ} (f : Space d → ℝ) + (hf : IsDistBounded f) (c : ℝ) : + distOfFunction (fun x => c * f x) (by fun_prop) = c • distOfFunction f hf := by + exact distOfFunction_smul_fun f hf c + +lemma distOfFunction_neg {d : ℕ} (f : Space d → F) + (hf : IsDistBounded (fun x => - f x)) : + distOfFunction (fun x => - f x) hf = - distOfFunction f (by simpa using hf.neg) := by + convert distOfFunction_smul_fun f (by simpa using hf.neg) (-1) using 1 + · simp + · simp + +/-! + +## C. Properties related to inner products + +-/ + +open InnerProductSpace + +lemma distOfFunction_inner {d n : ℕ} (f : Space d → EuclideanSpace ℝ (Fin n)) + (hf : IsDistBounded f) + (η : 𝓢(Space d, ℝ)) (y : EuclideanSpace ℝ (Fin n)) : + ⟪distOfFunction f hf η, y⟫_ℝ = ∫ x, η x * ⟪f x, y⟫_ℝ := by + rw [distOfFunction_apply] + trans ∫ x, ⟪y, η x • f x⟫_ℝ; swap + · congr + funext x + rw [real_inner_comm] + simp [inner_smul_left] + rw [integral_inner, real_inner_comm] + fun_prop + +TODO "LV5RM" "Add a general lemma specifying the derivative of + functions from distributions." + +/-! + +## D. Components + +-/ + +lemma distOfFunction_eculid_eval {d n : ℕ} (f : Space d → EuclideanSpace ℝ (Fin n)) + (hf : IsDistBounded f) (η : 𝓢(Space d, ℝ)) (i : Fin n) : + distOfFunction f hf η i = distOfFunction (fun x => f x i) (hf.pi_comp i) η := by + simp [distOfFunction_apply] + rw [MeasureTheory.eval_integral_piLp] + simp only [PiLp.smul_apply, smul_eq_mul] + intro i + simp only [PiLp.smul_apply, smul_eq_mul] + fun_prop + +lemma distOfFunction_vector_eval {d n : ℕ} (f : Space d → Lorentz.Vector n) + (hf : IsDistBounded f) (η : 𝓢(Space d, ℝ)) (i : Fin 1 ⊕ Fin n) : + distOfFunction f hf η i = distOfFunction (fun x => f x i) (hf.vector_component i) η := by + simp [distOfFunction_apply] + trans ⟪Lorentz.Vector.basis i, ∫ x, η x • f x⟫_ℝ + · rw [Lorentz.Vector.basis_inner] + rw [← integral_inner] + simp [Lorentz.Vector.basis_inner] + fun_prop + +end Space diff --git a/PhysLean/SpaceAndTime/Space/Distributions/Basic.lean b/PhysLean/SpaceAndTime/Space/Distributions/Basic.lean deleted file mode 100644 index bd0495f89..000000000 --- a/PhysLean/SpaceAndTime/Space/Distributions/Basic.lean +++ /dev/null @@ -1,597 +0,0 @@ -/- -Copyright (c) 2025 Zhi Kai Pong. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Zhi Kai Pong --/ -import PhysLean.SpaceAndTime.Space.VectorIdentities -import PhysLean.SpaceAndTime.Time.Basic -import PhysLean.Mathematics.Distribution.Function.OfFunction -import Mathlib.MeasureTheory.SpecificCodomains.WithLp -/-! - -# Distributions on Space - -In this module we define the derivatives, gradient, divergence and curl of distributions -on `Space`. - -Contrary to the usual definition of derivatives on functions, when working with -distributions one does not need to check that the function is differentiable to perform -basic operations. This has the consequence that in a lot of cases, distributions are in fact -somewhat easier to work with than functions. - -## Examples of distributions - -Distributions cover a wide range of objects that we use in physics. - -- The dirac delta function. -- The potential 1/r (which is not defined at the origin). -- The Heaviside step function. -- Interfaces between materials, such as a charged sphere. - --/ - -namespace Space - -open Distribution -open SchwartzMap - -/-! - -## The constant distribution on space - --/ - -/-- The constant distribution from `Space d` to a module `M` associated with - `m : M`. -/ -noncomputable def constD {M } [NormedAddCommGroup M] [NormedSpace ℝ M] (d : ℕ) (m : M) : - (Space d) →d[ℝ] M := const ℝ (Space d) m - -/-! - -## Derivatives - --/ - -/-- Given a distribution (function) `f : Space d →d[ℝ] M` the derivative - of `f` in direction `μ`. -/ -noncomputable def derivD {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] - (μ : Fin d) : ((Space d) →d[ℝ] M) →ₗ[ℝ] (Space d) →d[ℝ] M where - toFun f := - let ev : (Space d →L[ℝ] M) →L[ℝ] M := { - toFun v := v (basis μ) - map_add' v1 v2 := by - simp only [ContinuousLinearMap.add_apply] - map_smul' a v := by - simp - } - ev.comp (Distribution.fderivD ℝ f) - map_add' f1 f2 := by - simp - map_smul' a f := by simp - -lemma schwartMap_fderiv_comm { d} - (μ ν : Fin d) (x : Space d) (η : 𝓢(Space d, ℝ)) : - ((SchwartzMap.evalCLM (𝕜 := ℝ) (basis μ)) - ((fderivCLM ℝ) ((SchwartzMap.evalCLM (𝕜 := ℝ) (basis ν)) ((fderivCLM ℝ) η)))) x = - ((SchwartzMap.evalCLM (𝕜 := ℝ) (basis ν)) - ((fderivCLM ℝ) ((SchwartzMap.evalCLM (𝕜 := ℝ) (basis μ)) ((fderivCLM ℝ) η)))) x := by - have h1 := η.smooth - have h2 := h1 2 - change fderiv ℝ (fun x => fderiv ℝ η x (basis ν)) x (basis μ) = - fderiv ℝ (fun x => fderiv ℝ η x (basis μ)) x (basis ν) - rw [fderiv_clm_apply, fderiv_clm_apply] - simp only [fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.comp_zero, zero_add, - ContinuousLinearMap.flip_apply] - rw [IsSymmSndFDerivAt.eq] - apply ContDiffAt.isSymmSndFDerivAt (n := 2) - · refine ContDiff.contDiffAt ?_ - exact h2 - · simp - · fun_prop - · exact differentiableAt_const (basis μ) - · fun_prop - · exact differentiableAt_const (basis ν) - -lemma derivD_comm {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] - (μ ν : Fin d) (f : (Space d) →d[ℝ] M) : - (derivD ν (derivD μ f)) = (derivD μ (derivD ν f)) := by - ext η - simp [derivD, Distribution.fderivD] - congr 1 - ext x - rw [schwartMap_fderiv_comm μ ν x η] - -@[simp] -lemma derivD_constD {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] - (μ : Fin d) (m : M) : - derivD μ (constD d m) = 0 := by - ext η - simp [derivD, constD] - -lemma derivD_apply {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] - (μ : Fin d) (f : (Space d) →d[ℝ] M) (ε : 𝓢(Space d, ℝ)) : - (derivD μ f) ε = fderivD ℝ f ε (basis μ) := by - simp [derivD, Distribution.fderivD] - -/-! - -## The gradient - --/ - -open InnerProductSpace - -/-- The gradient of a distribution `(Space d) →d[ℝ] ℝ` as a distribution - `(Space d) →d[ℝ] (EuclideanSpace ℝ (Fin d))`. -/ -noncomputable def gradD {d} : - ((Space d) →d[ℝ] ℝ) →ₗ[ℝ] (Space d) →d[ℝ] (EuclideanSpace ℝ (Fin d)) where - toFun f := - ((InnerProductSpace.toDual ℝ (Space d)).symm.toContinuousLinearMap).comp (fderivD ℝ f) - map_add' f1 f2 := by - ext x - simp - map_smul' a f := by - ext x - simp - -lemma gradD_inner_eq {d} (f : (Space d) →d[ℝ] ℝ) (η : 𝓢(Space d, ℝ)) - (y : EuclideanSpace ℝ (Fin d)) : ⟪gradD f η, y⟫_ℝ = fderivD ℝ f η y := by - rw [gradD] - simp only [LinearIsometryEquiv.toLinearEquiv_symm, LinearMap.coe_mk, AddHom.coe_mk, - ContinuousLinearMap.coe_comp', LinearMap.coe_toContinuousLinearMap', LinearEquiv.coe_coe, - LinearIsometryEquiv.coe_symm_toLinearEquiv, Function.comp_apply, toDual_symm_apply] - -lemma gradD_eq_of_inner {d} (f : (Space d) →d[ℝ] ℝ) (g : (Space d) →d[ℝ] EuclideanSpace ℝ (Fin d)) - (h : ∀ η y, fderivD ℝ f η y = ⟪g η, y⟫_ℝ) : - gradD f = g := by - ext1 η - specialize h η - conv at h => enter [x]; rw [← gradD_inner_eq] - exact ext_inner_right (𝕜 := ℝ) h - -lemma gradD_eq_sum_basis {d} (f : (Space d) →d[ℝ] ℝ) (η : 𝓢(Space d, ℝ)) : - gradD f η = ∑ i, - f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis i) (fderivCLM ℝ η)) • basis i := by - have h1 (y : EuclideanSpace ℝ (Fin d)) : - ⟪∑ i, - f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis i) (fderivCLM ℝ η)) • basis i, y⟫_ℝ = - fderivD ℝ f η y := by - have hy : y = ∑ i, y i • basis i := by - conv_lhs => rw [← OrthonormalBasis.sum_repr basis y] - dsimp [basis] - rw [hy] - simp only [PiLp.inner_apply, RCLike.inner_apply, conj_trivial, map_sum, map_smul, smul_eq_mul] - conv_lhs => - enter [2, x] - rw [Fintype.sum_apply, Fintype.sum_apply] - simp only [PiLp.smul_apply, basis_apply, smul_eq_mul, mul_ite, mul_one, mul_zero, - Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte, mul_neg] - congr - ext i - rw [fderivD_apply] - ring - have hx (y : EuclideanSpace ℝ (Fin d)) : ⟪gradD f η, y⟫_ℝ = - ⟪∑ i, - f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis i) (fderivCLM ℝ η)) • basis i, y⟫_ℝ := by - rw [gradD_inner_eq, h1] - have h1 : ∀ y, ⟪gradD f η - - (∑ i, - f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis i) (fderivCLM ℝ η)) • basis i), y⟫_ℝ = 0 := by - intro y - rw [inner_sub_left, hx y] - simp - have h2 := h1 (gradD f η - - (∑ i, - f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis i) (fderivCLM ℝ η)) • basis i)) - rw [inner_self_eq_zero, sub_eq_zero] at h2 - rw [h2] - -@[simp] -lemma gradD_constD {d} (m : ℝ) : - gradD (constD d m) = 0 := by - ext η - simp [gradD, constD] - -lemma gradD_toFun_eq_derivD {d} (f : (Space d) →d[ℝ] ℝ) : - (gradD f).toFun = fun ε i => derivD i f ε := by - ext ε i - simp only [AddHom.toFun_eq_coe, LinearMap.coe_toAddHom, ContinuousLinearMap.coe_coe] - rw [gradD_eq_sum_basis] - simp only [neg_smul, sum_apply, PiLp.neg_apply, PiLp.smul_apply, smul_eq_mul, - Finset.sum_neg_distrib] - rw [Finset.sum_eq_single i] - · simp - rfl - · intro b _ h - simp only [mul_eq_zero] - right - simpa [basis_apply] using h - · simp - -lemma gradD_apply {d} (f : (Space d) →d[ℝ] ℝ) (ε : 𝓢(Space d, ℝ)) : - (gradD f) ε = fun i => derivD i f ε := by - change (gradD f).toFun ε = fun i => derivD i f ε - rw [gradD_toFun_eq_derivD] - -/-! - -## The divergence - --/ - -/-- The divergence of a distribution `(Space d) →d[ℝ] (EuclideanSpace ℝ (Fin d))` as a distribution - `(Space d) →d[ℝ] ℝ`. -/ -noncomputable def divD {d} : - ((Space d) →d[ℝ] (EuclideanSpace ℝ (Fin d))) →ₗ[ℝ] (Space d) →d[ℝ] ℝ where - toFun f := - let trace : (Space d →L[ℝ] (EuclideanSpace ℝ (Fin d))) →L[ℝ] ℝ := { - toFun v := ∑ i, ⟪v (basis i), basis i⟫_ℝ - map_add' v1 v2 := by - simp only [ContinuousLinearMap.add_apply, inner_basis, PiLp.add_apply] - rw [Finset.sum_add_distrib] - map_smul' a v := by - simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, inner_basis, PiLp.smul_apply, - smul_eq_mul, RingHom.id_apply] - rw [Finset.mul_sum] - cont := by fun_prop} - trace.comp (Distribution.fderivD ℝ f) - map_add' f1 f2 := by - ext x - simp - map_smul' a f := by - ext x - simp - -lemma divD_apply_eq_sum_fderivD {d} - (f : (Space d) →d[ℝ] EuclideanSpace ℝ (Fin d)) (η : 𝓢(Space d, ℝ)) : - divD f η = ∑ i, fderivD ℝ f η (basis i) i := by - simp [divD] - -lemma divD_apply_eq_sum_derivD {d} - (f : (Space d) →d[ℝ] EuclideanSpace ℝ (Fin d)) (η : 𝓢(Space d, ℝ)) : - divD f η = ∑ i, derivD i f η i := by - rw [divD_apply_eq_sum_fderivD] - rfl - -@[simp] -lemma divD_constD {d} (m : EuclideanSpace ℝ (Fin d)) : - divD (constD d m) = 0 := by - ext η - simp [divD, constD] - -open MeasureTheory -open SchwartzMap - -/-- The divergence of a distribution from a bounded function. -/ -lemma divD_ofFunction {dm1 : ℕ} {f : Space dm1.succ → EuclideanSpace ℝ (Fin dm1.succ)} - {hf : IsDistBounded f} - {hae: AEStronglyMeasurable (fun x => f x) volume} (η : 𝓢(EuclideanSpace ℝ (Fin dm1.succ), ℝ)) : - divD (Distribution.ofFunction f hf hae) η = - - ∫ x : Space dm1.succ, ⟪f x, Space.grad η x⟫_ℝ := by - rw [divD_apply_eq_sum_fderivD] - conv_rhs => - enter [1, 2, x] - rw [grad_eq_sum, inner_sum] - conv_lhs => - enter [2, i] - rw [fderivD_apply, ofFunction_apply] - /- The following lemma could probably be moved out of this result. -/ - have integrable_lemma (i j : Fin (dm1 + 1)) : - Integrable (fun x => - (((SchwartzMap.evalCLM (𝕜 := ℝ) (basis i)) ((fderivCLM ℝ) η)) x • f x) j) volume := by - simp only [PiLp.smul_apply] - apply IsDistBounded.schwartzMap_smul_integrable - · exact IsDistBounded.pi_comp hf j - · fun_prop - rw [MeasureTheory.integral_finset_sum] - · simp - congr - funext i - rw [MeasureTheory.eval_integral_piLp] - · congr - funext x - simp [inner_smul_right] - left - rw [deriv_eq_fderiv_basis] - rfl - · intro j - exact integrable_lemma i j - · intro i hi - simp only [Nat.succ_eq_add_one, inner_smul_right, inner_basis] - convert integrable_lemma i i - rename_i x - simp only [Nat.succ_eq_add_one, PiLp.smul_apply, smul_eq_mul, mul_eq_mul_right_iff] - left - rw [deriv_eq_fderiv_basis] - rfl - -/- The quantity `⟪f x, Space.grad η x⟫_ℝ` is integrable for `f` bounded - and `η` a Schwartz map. -/ -lemma integrable_isDistBounded_inner_grad_schwartzMap {dm1 : ℕ} - {f : Space dm1.succ → EuclideanSpace ℝ (Fin dm1.succ)} - (hf : IsDistBounded f) - (hae: AEStronglyMeasurable (fun x => f x) volume) (η : 𝓢(EuclideanSpace ℝ (Fin dm1.succ), ℝ)) : - Integrable (fun x => ⟪f x, Space.grad η x⟫_ℝ) volume := by - conv => - enter [1, x] - rw [grad_eq_sum, inner_sum] - apply MeasureTheory.integrable_finset_sum - intro i _ - simp [inner_smul_right] - have integrable_lemma (i j : Fin (dm1 + 1)) : - Integrable (fun x => (((SchwartzMap.evalCLM (𝕜 := ℝ) (basis i)) ((fderivCLM ℝ) η)) x • f x) j) - volume := by - simp only [PiLp.smul_apply] - apply IsDistBounded.schwartzMap_smul_integrable - · exact IsDistBounded.pi_comp hf j - · fun_prop - convert integrable_lemma i i - rename_i x - simp only [Nat.succ_eq_add_one, PiLp.smul_apply, smul_eq_mul, mul_eq_mul_right_iff] - left - rw [deriv_eq_fderiv_basis] - rfl - -lemma integrable_isDistBounded_inner_grad_schwartzMap_spherical{dm1 : ℕ} - {f : Space dm1.succ → EuclideanSpace ℝ (Fin dm1.succ)} - (hf : IsDistBounded f) - (hae: AEStronglyMeasurable (fun x => f x) volume) (η : 𝓢(EuclideanSpace ℝ (Fin dm1.succ), ℝ)) : - Integrable ((fun x => ⟪f x.1, Space.grad η x.1⟫_ℝ) - ∘ (homeomorphUnitSphereProd (Space dm1.succ)).symm) - ((volume (α := Space dm1.succ)).toSphere.prod - (Measure.volumeIoiPow (Module.finrank ℝ (EuclideanSpace ℝ (Fin dm1.succ)) - 1))) := by - have h1 : Integrable ((fun x => ⟪f x.1, Space.grad η x.1⟫_ℝ)) - (.comap (Subtype.val (p := fun x => x ∈ ({0}ᶜ : Set _))) volume) := by - change Integrable ((fun x => ⟪f x, Space.grad η x⟫_ℝ) ∘ Subtype.val) - (.comap (Subtype.val (p := fun x => x ∈ ({0}ᶜ : Set _))) volume) - rw [← MeasureTheory.integrableOn_iff_comap_subtypeVal] - apply Integrable.integrableOn - exact integrable_isDistBounded_inner_grad_schwartzMap hf hae η - simp - have he := (MeasureTheory.Measure.measurePreserving_homeomorphUnitSphereProd - (volume (α := EuclideanSpace ℝ (Fin dm1.succ)))) - rw [← he.integrable_comp_emb] - convert h1 - simp only [Nat.succ_eq_add_one, Function.comp_apply, Homeomorph.symm_apply_apply] - exact Homeomorph.measurableEmbedding (homeomorphUnitSphereProd (EuclideanSpace ℝ (Fin dm1.succ))) - -/-! - -## The curl - --/ - -/-- The curl of a distribution `Space →d[ℝ] (EuclideanSpace ℝ (Fin 3))` as a distribution - `Space →d[ℝ] (EuclideanSpace ℝ (Fin 3))`. -/ -noncomputable def curlD : (Space →d[ℝ] (EuclideanSpace ℝ (Fin 3))) →ₗ[ℝ] - (Space) →d[ℝ] (EuclideanSpace ℝ (Fin 3)) where - toFun f := - let curl : (Space →L[ℝ] (EuclideanSpace ℝ (Fin 3))) →L[ℝ] (EuclideanSpace ℝ (Fin 3)) := { - toFun dfdx:= fun i => - match i with - | 0 => dfdx (basis 2) 1 - dfdx (basis 1) 2 - | 1 => dfdx (basis 0) 2 - dfdx (basis 2) 0 - | 2 => dfdx (basis 1) 0 - dfdx (basis 0) 1 - map_add' v1 v2 := by - ext i - fin_cases i - all_goals - simp only [Fin.isValue, ContinuousLinearMap.add_apply, PiLp.add_apply, Fin.zero_eta] - ring - map_smul' a v := by - ext i - fin_cases i - all_goals - simp only [Fin.isValue, ContinuousLinearMap.coe_smul', Pi.smul_apply, PiLp.smul_apply, - smul_eq_mul, RingHom.id_apply, Fin.reduceFinMk] - ring - cont := by - rw [continuous_pi_iff] - intro i - fin_cases i - all_goals - fun_prop - } - curl.comp (Distribution.fderivD ℝ f) - map_add' f1 f2 := by - ext x - simp - map_smul' a f := by - ext x - simp - -lemma curlD_apply_zero (f : Space →d[ℝ] (EuclideanSpace ℝ (Fin 3))) (η : 𝓢(Space, ℝ)) : - curlD f η 0 = - f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis 2) (fderivCLM ℝ η)) 1 - + f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis 1) (fderivCLM ℝ η)) 2 := by - simp [curlD] - rw [fderivD_apply, fderivD_apply] - simp - -lemma curlD_apply_one (f : Space →d[ℝ] (EuclideanSpace ℝ (Fin 3))) (η : 𝓢(Space, ℝ)) : - curlD f η 1 = - f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis 0) (fderivCLM ℝ η)) 2 - + f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis 2) (fderivCLM ℝ η)) 0 := by - simp [curlD] - rw [fderivD_apply, fderivD_apply] - simp - -lemma curlD_apply_two (f : Space →d[ℝ] (EuclideanSpace ℝ (Fin 3))) (η : 𝓢(Space, ℝ)) : - curlD f η 2 = - f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis 1) (fderivCLM ℝ η)) 0 - + f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis 0) (fderivCLM ℝ η)) 1 := by - simp [curlD] - rw [fderivD_apply, fderivD_apply] - simp - -lemma curlD_apply (f : Space →d[ℝ] (EuclideanSpace ℝ (Fin 3))) (η : 𝓢(Space, ℝ)) : - curlD f η = fun - | 0 => - f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis 2) (fderivCLM ℝ η)) 1 - + f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis 1) (fderivCLM ℝ η)) 2 - | 1 => - f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis 0) (fderivCLM ℝ η)) 2 - + f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis 2) (fderivCLM ℝ η)) 0 - | 2 => - f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis 1) (fderivCLM ℝ η)) 0 - + f (SchwartzMap.evalCLM (𝕜 := ℝ) (basis 0) (fderivCLM ℝ η)) 1 := by - funext i - fin_cases i - · simp [curlD_apply_zero] - · simp [curlD_apply_one] - · simp [curlD_apply_two] - -@[simp] -lemma curlD_constD (m : EuclideanSpace ℝ (Fin 3)) : - curlD (constD 3 m) = 0 := by - ext η - simp [curlD, constD] - -/-! - -## Vector identities - --/ - -/-- The curl of a grad is equal to zero. -/ -@[simp] -lemma curlD_gradD_eq_zero (f : (Space) →d[ℝ] ℝ) : - curlD (gradD f) = 0 := by - ext η i - fin_cases i - all_goals - · dsimp - try rw [curlD_apply_zero] - try rw [curlD_apply_one] - try rw [curlD_apply_two] - rw [gradD_eq_sum_basis, gradD_eq_sum_basis] - simp [basis_apply] - rw [← map_neg, ← map_add, ← ContinuousLinearMap.map_zero f] - congr - ext x - simp only [Fin.isValue, add_apply, zero_apply] - rw [schwartMap_fderiv_comm] - change ((SchwartzMap.evalCLM (𝕜 := ℝ) _) - ((fderivCLM ℝ) ((SchwartzMap.evalCLM (𝕜 := ℝ) _) ((fderivCLM ℝ) η)))) x + - - ((SchwartzMap.evalCLM (𝕜 := ℝ) _) - ((fderivCLM ℝ) ((SchwartzMap.evalCLM (𝕜 := ℝ) _) ((fderivCLM ℝ) η)))) x = _ - simp - -/-! - -## For time-dependent distributions - --/ - -/-- The time derivative of a distribution dependent on time and space. -/ -noncomputable def timeDerivD {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] : - ((Time × Space d) →d[ℝ] M) →ₗ[ℝ] (Time × Space d) →d[ℝ] M where - toFun f := - let ev : ((Time × Space d) →L[ℝ] M) →L[ℝ] M := { - toFun v := v (1, 0) - map_add' v1 v2 := by - simp only [ContinuousLinearMap.add_apply] - map_smul' a v := by - simp - } - ev.comp (Distribution.fderivD ℝ f) - map_add' f1 f2 := by - simp - map_smul' a f := by simp - -lemma timeDerivD_apply {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] - (f : (Time × Space d) →d[ℝ] M) (ε : 𝓢(Time × Space d, ℝ)) : - (timeDerivD f) ε = fderivD ℝ f ε (1, 0) := by - simp [timeDerivD] - -/-- The space derivative of a distribution dependent on time and space. -/ -noncomputable def spaceDerivD {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] - (i : Fin d) : ((Time × Space d) →d[ℝ] M) →ₗ[ℝ] (Time × Space d) →d[ℝ] M where - toFun f := - let ev : (Time × Space d →L[ℝ] M) →L[ℝ] M := { - toFun v := v (0, basis i) - map_add' v1 v2 := by - simp only [ContinuousLinearMap.add_apply] - map_smul' a v := by - simp - } - ev.comp (Distribution.fderivD ℝ f) - map_add' f1 f2 := by - simp - map_smul' a f := by simp - -lemma spaceDerivD_apply {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] - (i : Fin d) (f : (Time × Space d) →d[ℝ] M) (ε : 𝓢(Time × Space d, ℝ)) : - (spaceDerivD i f) ε = fderivD ℝ f ε (0, basis i) := by - simp [spaceDerivD] - -/-- The spatial gradient of a distribution dependent on time and space. -/ -noncomputable def spaceGradD {d} : - ((Time × Space d) →d[ℝ] ℝ) →ₗ[ℝ] (Time × Space d) →d[ℝ] (EuclideanSpace ℝ (Fin d)) where - toFun f := { - toFun := fun ε i => spaceDerivD i f ε - map_add' ε1 ε2 := by funext i; simp - map_smul' a ε := by funext i; simp - cont := by fun_prop} - map_add' f1 f2 := by - ext x - simp - map_smul' a f := by - ext x - simp - -lemma spaceGradD_apply {d} (f : (Time × Space d) →d[ℝ] ℝ) (ε : 𝓢(Time × Space d, ℝ)) : - spaceGradD f ε = fun i => spaceDerivD i f ε := by - rfl -/-- The spatial divergence of a distribution dependent on time and space. -/ -noncomputable def spaceDivD {d} : - ((Time × Space d) →d[ℝ] (EuclideanSpace ℝ (Fin d))) →ₗ[ℝ] (Time × Space d) →d[ℝ] ℝ where - toFun f := { - toFun ε := ∑ i, spaceDerivD i f ε i - map_add' ε1 ε2 := by simp [Finset.sum_add_distrib] - map_smul' a ε := by simp [Finset.mul_sum] - cont := by fun_prop} - map_add' f1 f2 := by - ext x - simp [Finset.sum_add_distrib] - map_smul' a f := by - ext x - simp [Finset.mul_sum] - -lemma spaceDivD_apply_eq_sum_spaceDerivD {d} - (f : (Time × Space d) →d[ℝ] EuclideanSpace ℝ (Fin d)) (η : 𝓢(Time ×Space d, ℝ)) : - spaceDivD f η = ∑ i, spaceDerivD i f η i := by rfl - -/-- The curl of a distribution dependent on time and space. -/ -noncomputable def spaceCurlD : ((Time × Space 3) →d[ℝ] (EuclideanSpace ℝ (Fin 3))) →ₗ[ℝ] - (Time × Space 3) →d[ℝ] (EuclideanSpace ℝ (Fin 3)) where - toFun f :={ - toFun ε := fun i => - match i with - | 0 => spaceDerivD 2 f ε 1 - spaceDerivD 1 f ε 2 - | 1 => spaceDerivD 0 f ε 2 - spaceDerivD 2 f ε 0 - | 2 => spaceDerivD 1 f ε 0 - spaceDerivD 0 f ε 1 - map_add' ε1 ε2 := by - funext i - fin_cases i - all_goals - simp only [Fin.isValue, map_add, PiLp.add_apply, Fin.reduceFinMk] - ring - map_smul' a ε := by - funext i - fin_cases i - all_goals - simp only [Fin.isValue, map_smul, PiLp.smul_apply, smul_eq_mul, RingHom.id_apply, - Fin.zero_eta] - ring - cont := by - rw [continuous_pi_iff] - intro i - fin_cases i <;> fun_prop - } - map_add' f1 f2 := by - ext x i - fin_cases i - all_goals - simp only [Fin.isValue, map_add, ContinuousLinearMap.add_apply, PiLp.add_apply, Fin.zero_eta, - ContinuousLinearMap.coe_mk', LinearMap.coe_mk, AddHom.coe_mk] - ring - map_smul' a f := by - ext x i - fin_cases i - all_goals - simp only [Fin.isValue, map_smul, ContinuousLinearMap.coe_smul', Pi.smul_apply, - PiLp.smul_apply, smul_eq_mul, Fin.reduceFinMk, ContinuousLinearMap.coe_mk', - LinearMap.coe_mk, AddHom.coe_mk, RingHom.id_apply] - ring - -end Space diff --git a/PhysLean/SpaceAndTime/Space/IsDistBounded.lean b/PhysLean/SpaceAndTime/Space/IsDistBounded.lean new file mode 100644 index 000000000..2de860704 --- /dev/null +++ b/PhysLean/SpaceAndTime/Space/IsDistBounded.lean @@ -0,0 +1,1308 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +import PhysLean.SpaceAndTime.Space.RadialAngularMeasure +import PhysLean.SpaceAndTime.Time.Derivatives +import Mathlib.Tactic.Cases +/-! + +# Functions on `Space d` which can be made into distributions + +## i. Overview + +In this module, for functions `f : Space d → F`, we define the property `IsDistBounded f`. +Functions satisfying this property can be used to create distributions `Space d →d[ℝ] F` +by integrating them against Schwartz maps. + +The condition `IsDistBounded f` essentially says that `f` is bounded by a finite sum of terms +of the form `c * ‖x + g‖ ^ p` for constants `c`, `g` and `- (d - 1) ≤ p ` where `d` is the dimension +of the space. + +## ii. Key results + +- `IsDistBounded` : The boundedness condition on functions `Space d → F` for them to + form distributions. +- `IsDistBounded.integrable_space` : If `f` satisfies `IsDistBounded f`, then + `fun x => η x • f x` is integrable for any Schwartz map `η : 𝓢(Space d, ℝ)`. +- `IsDistBounded.integrable_time_space` : If `f` satisfies `IsDistBounded f`, then + `fun x => η x • f x.2` is integrable for any Schwartz map + `η : 𝓢(Time × Space d, ℝ)`. +- `IsDistBounded.mono` : If `f₁` satisfies `IsDistBounded f₁` and + `‖f₂ x‖ ≤ ‖f₁ x‖` for all `x`, then `f₂` satisfies `IsDistBounded f₂`. + +## iii. Table of contents + +- A. The predicate `IsDistBounded f` +- B. Integrability properties of functions satisfying `IsDistBounded f` + - B.1. `AEStronglyMeasurable` conditions + - B.2. Integrability with respect to Schwartz maps on space + - B.3. Integrability with respect to Schwartz maps on time and space + - B.4. Integrability with respect to inverse powers +- C. Integral on Schwartz maps is bounded by seminorms +- D. Construction rules for `IsDistBounded f` + - D.1. Addition + - D.2. Finite sums + - D.3. Scalar multiplication + - D.4. Components of functions + - D.5. Compositions with additions and subtractions + - D.6. Congruence with respect to the norm + - D.7. Monotonicity with respect to the norm + - D.8. Inner products + - D.9. Scalar multiplication with constant +- E. Specific functions that are `IsDistBounded` + - E.1. Constant functions + - E.2. Powers of norms +- F. Multiplication by norms and components + +## iv. References + +-/ +open SchwartzMap NNReal +noncomputable section + +variable (𝕜 : Type) {E F F' : Type} [RCLike 𝕜] [NormedAddCommGroup E] [NormedAddCommGroup F] + [NormedAddCommGroup F'] [NormedSpace ℝ F] [NormedSpace ℝ F'] + +namespace Space + +variable [NormedSpace ℝ E] + +open MeasureTheory + +/-! + +## A. The predicate `IsDistBounded f` + +-/ + +/-- The boundedness condition on a function ` EuclideanSpace ℝ (Fin dm1.succ) → F` + for it to form a distribution. -/ +@[fun_prop] +def IsDistBounded {d : ℕ} (f : Space d → F) : Prop := + AEStronglyMeasurable (fun x => f x) volume ∧ + ∃ n, ∃ c : Fin n → ℝ, ∃ g : Fin n → Space d, + ∃ p : Fin n → ℤ, + (∀ i, 0 ≤ c i) ∧ + (∀ i, - (d - 1 : ℕ) ≤ p i) ∧ + ∀ x, ‖f x‖ ≤ ∑ i, c i * ‖x + g i‖ ^ p i + +namespace IsDistBounded + +/-! + +## B. Integrability properties of functions satisfying `IsDistBounded f` + +-/ + +/-! + +### B.1. `AEStronglyMeasurable` conditions + +-/ +omit [NormedSpace ℝ F] in +@[fun_prop] +lemma aestronglyMeasurable {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) : + AEStronglyMeasurable (fun x => f x) volume := hf.1 + +@[fun_prop] +lemma aeStronglyMeasurable_schwartzMap_smul {d : ℕ} {f : Space d → F} + (hf : IsDistBounded f) (η : 𝓢(Space d, ℝ)) : + AEStronglyMeasurable (fun x => η x • f x) := by + fun_prop + +@[fun_prop] +lemma aeStronglyMeasurable_fderiv_schwartzMap_smul {d : ℕ} {f : Space d → F} + (hf : IsDistBounded f) (η : 𝓢(Space d, ℝ)) (y : Space d) : + AEStronglyMeasurable (fun x => fderiv ℝ η x y • f x) := by + fun_prop + +@[fun_prop] +lemma aeStronglyMeasurable_inv_pow {d r : ℕ} {f : Space d → F} + (hf : IsDistBounded f) : + AEStronglyMeasurable (fun x => ‖((1 + ‖x‖) ^ r)⁻¹‖ • f x) := by + apply AEStronglyMeasurable.smul + · apply AEMeasurable.aestronglyMeasurable + fun_prop + · fun_prop + +@[fun_prop] +lemma aeStronglyMeasurable_time_schwartzMap_smul {d : ℕ} {f : Space d → F} + (hf : IsDistBounded f) (η : 𝓢(Time × Space d, ℝ)) : + AEStronglyMeasurable (fun x => η x • f x.2) := by + apply AEStronglyMeasurable.smul + · fun_prop + · apply MeasureTheory.AEStronglyMeasurable.comp_snd + fun_prop + +/-! + +### B.2. Integrability with respect to Schwartz maps on space + +-/ + +@[fun_prop] +lemma integrable_space {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) + (η : 𝓢(Space d, ℝ)) : + Integrable (fun x : Space d => η x • f x) volume := by + /- Reducing the problem to `Integrable (fun x : Space d => η x * ‖x + c‖ ^ p)` -/ + suffices h2 : ∀ (p : ℤ) (hp : - (d - 1 : ℕ) ≤ p) (c : Space d) (η : 𝓢(Space d, ℝ)), + Integrable (fun x : Space d => η x * ‖x + c‖ ^ p) volume by + obtain ⟨n, c, g, p, c_nonneg, p_bound, bound⟩ := hf.2 + apply Integrable.mono (g := fun x => ∑ i, (c i * (‖η x‖ * ‖x + g i‖ ^ p i))) _ + · fun_prop + · filter_upwards with x + rw [norm_smul] + apply le_trans (mul_le_mul_of_nonneg_left (bound x) (norm_nonneg (η x))) + apply le_of_eq + simp only [Real.norm_eq_abs] + rw [Finset.abs_sum_of_nonneg (fun i _ => mul_nonneg (c_nonneg i) (by positivity)), + Finset.mul_sum] + ring_nf + · apply MeasureTheory.integrable_finset_sum + intro i _ + apply Integrable.const_mul + specialize h2 (p i) (p_bound i) (g i) η + rw [← MeasureTheory.integrable_norm_iff] at h2 + simpa using h2 + apply AEMeasurable.aestronglyMeasurable + fun_prop + /- Reducing the problem to `Integrable (fun x : Space d => η x * ‖x‖ ^ p)` -/ + suffices h0 : ∀ (p : ℤ) (hp : - (d - 1 : ℕ) ≤ p) (η : 𝓢(Space d, ℝ)), + Integrable (fun x : Space d => η x * ‖x‖ ^ p) volume by + intro p hp c η + suffices h1 : Integrable (fun x => η ((x + c) - c) * ‖x + c‖ ^ p) volume by + simpa using h1 + apply MeasureTheory.Integrable.comp_add_right (g := c) (f := fun x => η (x - c) * ‖x‖ ^ p) + apply h0 p hp (η.compCLM (𝕜 := ℝ) ?_ ?_) + · apply Function.HasTemperateGrowth.of_fderiv (k := 1) (C := 1 + ‖c‖) + · convert Function.HasTemperateGrowth.const (ContinuousLinearMap.id ℝ (Space d)) + simp [fderiv_sub_const] + · fun_prop + · refine fun x => (norm_sub_le _ _).trans (le_of_sub_nonneg ?_) + ring_nf + positivity + · refine ⟨1, (1 + ‖c‖), fun x => (norm_le_norm_add_norm_sub' x c).trans (le_of_sub_nonneg ?_)⟩ + ring_nf + positivity + /- Proving `Integrable (fun x : Space d => η x * ‖x + c‖ ^ p)` -/ + intro p hp η + have h1 : AEStronglyMeasurable (fun (x : Space d) => ‖x‖ ^ p) volume := + AEMeasurable.aestronglyMeasurable <| by fun_prop + rw [← MeasureTheory.integrable_norm_iff (by fun_prop)] + simp only [norm_mul, norm_zpow, norm_norm] + match d with + | 0 => simp only [Real.norm_eq_abs, Integrable.of_finite] + | d + 1 => + by_cases hp' : p = 0 + · subst hp' + simp only [zpow_zero, mul_one] + apply Integrable.norm + exact η.integrable + suffices h1 : Integrable (fun x => ‖η x‖ * ‖x‖ ^ (p + d)) (radialAngularMeasure (d := (d + 1))) by + rw [integrable_radialAngularMeasure_iff] at h1 + convert h1 using 1 + funext x + have hx : 0 ≤ ‖x‖ := norm_nonneg x + generalize ‖x‖ = r at * + simp only [Real.norm_eq_abs, add_tsub_cancel_right, one_div, smul_eq_mul] + trans |η x| * ((r ^ d)⁻¹ *r ^ (p + d)); swap + · ring + congr + by_cases hr : r = 0 + · subst hr + simp [zero_pow_eq, zero_zpow_eq, hp'] + omega + field_simp + rw [zpow_add₀ hr] + rfl + convert integrable_pow_mul_iteratedFDeriv radialAngularMeasure η (p + d).toNat 0 using 1 + funext x + simp only [Real.norm_eq_abs, norm_iteratedFDeriv_zero] + rw [mul_comm] + congr 1 + rw [← zpow_natCast] + congr + refine Int.eq_natCast_toNat.mpr ?_ + omega + +@[fun_prop] +lemma integrable_space_mul {d : ℕ} {f : Space d → ℝ} (hf : IsDistBounded f) + (η : 𝓢(Space d, ℝ)) : + Integrable (fun x : Space d => η x * f x) volume := by + exact hf.integrable_space η + +@[fun_prop] +lemma integrable_space_fderiv {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) + (η : 𝓢(Space d, ℝ)) (y : Space d) : + Integrable (fun x : Space d => fderiv ℝ η x y • f x) volume := by + exact hf.integrable_space (LineDeriv.lineDerivOpCLM ℝ _ y η) + +@[fun_prop] +lemma integrable_space_fderiv_mul {d : ℕ} {f : Space d → ℝ} (hf : IsDistBounded f) + (η : 𝓢(Space d, ℝ)) (y : Space d) : + Integrable (fun x : Space d => fderiv ℝ η x y * f x) volume := by + exact hf.integrable_space (LineDeriv.lineDerivOpCLM ℝ _ y η) + +/-! + +### B.3. Integrability with respect to Schwartz maps on time and space + +-/ + +instance {D1 : Type} [NormedAddCommGroup D1] [MeasurableSpace D1] + {D2 : Type} [NormedAddCommGroup D2] [MeasurableSpace D2] + (μ1 : Measure D1) (μ2 : Measure D2) + [Measure.HasTemperateGrowth μ1] [Measure.HasTemperateGrowth μ2] + [OpensMeasurableSpace (D1 × D2)] : + Measure.HasTemperateGrowth (μ1.prod μ2) where + exists_integrable := by + obtain ⟨rt1, h1⟩ := Measure.HasTemperateGrowth.exists_integrable (μ := μ1) + obtain ⟨rt2, h2⟩ := Measure.HasTemperateGrowth.exists_integrable (μ := μ2) + use rt1 + rt2 + apply Integrable.mono' (h1.mul_prod h2) + · apply AEMeasurable.aestronglyMeasurable + fun_prop + filter_upwards with x + simp only [Nat.cast_add, neg_add_rev, Real.norm_eq_abs, Real.rpow_neg_natCast, zpow_neg, + zpow_natCast] + calc _ + _ = |(1 + ‖x‖) ^ (-(rt1 : ℝ)) * (1 + ‖x‖) ^ (-(rt2 : ℝ))| := by + rw [Real.rpow_add (by positivity), mul_comm] + _ = (1 + ‖x‖) ^ (-(rt1 : ℝ)) * (1 + ‖x‖) ^ (-(rt2 : ℝ)) := by + rw [abs_of_nonneg (by positivity)] + simp only [Real.rpow_neg_natCast, zpow_neg, zpow_natCast] + apply mul_le_mul _ _ (by positivity) (by positivity) + · refine inv_anti₀ (by positivity) (pow_le_pow_left₀ (by positivity) ?_ rt1) + rcases x + simp + · refine inv_anti₀ (by positivity) (pow_le_pow_left₀ (by positivity) ?_ rt2) + rcases x + simp + +@[fun_prop] +lemma integrable_time_space {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) + (η : 𝓢(Time × Space d, ℝ)) : + Integrable (fun x : Time × Space d => η x • f x.2) volume := by + /- Reducing the problem to `Integrable (fun x : Time × Space d => η x * ‖x.2 + c‖ ^ p)` -/ + suffices h2 : ∀ (p : ℤ) (hp : - (d - 1 : ℕ) ≤ p) (c : Space d) (η : 𝓢(Time × Space d, ℝ)), + Integrable (fun x : Time × Space d => η x * ‖x.2 + c‖ ^ p) volume by + obtain ⟨n, c, g, p, c_nonneg, p_bound, bound⟩ := hf.2 + apply Integrable.mono (g := fun x => ∑ i, (c i * (‖η x‖ * ‖x.2 + g i‖ ^ p i))) _ + · fun_prop + · filter_upwards with x + rw [norm_smul] + apply le_trans (mul_le_mul_of_nonneg_left (bound x.2) (norm_nonneg (η x))) + apply le_of_eq + simp only [Real.norm_eq_abs] + rw [Finset.abs_sum_of_nonneg (fun i _ => mul_nonneg (c_nonneg i) (by positivity)), + Finset.mul_sum] + ring_nf + · apply MeasureTheory.integrable_finset_sum + intro i _ + apply Integrable.const_mul + specialize h2 (p i) (p_bound i) (g i) η + rw [← MeasureTheory.integrable_norm_iff] at h2 + simpa using h2 + apply AEMeasurable.aestronglyMeasurable + fun_prop + /- Reducing the problem to `Integrable (fun x : Space d => η x * ‖x‖ ^ p)` -/ + suffices h0 : ∀ (p : ℤ) (hp : - (d - 1 : ℕ) ≤ p) (η : 𝓢(Time × Space d, ℝ)), + Integrable (fun x : Time × Space d => η x * ‖x.2‖ ^ p) volume by + intro p hp c η + suffices h1 : Integrable (fun (x : Time × Space d) => + η ((x + (0, c)) - (0, c)) * ‖(x + (0, c)).2‖ ^ p) (volume.prod volume) by + simpa using h1 + apply MeasureTheory.Integrable.comp_add_right (g := (0, c)) + (f := fun x => η (x - (0, c)) * ‖x.2‖ ^ p) + apply h0 p hp (η.compCLM (𝕜 := ℝ) ?_ ?_) + · apply Function.HasTemperateGrowth.of_fderiv (k := 1) (C := 1 + ‖c‖) + · convert Function.HasTemperateGrowth.const (ContinuousLinearMap.id ℝ (Time × Space d)) + simp [fderiv_sub_const] + · fun_prop + · refine fun x => (norm_sub_le _ _).trans (le_of_sub_nonneg ?_) + ring_nf + simp only [Prod.norm_mk, norm_zero, norm_nonneg, sup_of_le_right, + add_add_sub_cancel] + positivity + · refine ⟨1, (1 + ‖((0, c) : Time × Space d)‖), + fun x => (norm_le_norm_add_norm_sub' x (0,c)).trans (le_of_sub_nonneg ?_)⟩ + ring_nf + positivity + /- Proving `Integrable (fun x : Space d => η x * ‖x.2‖ ^ p)` -/ + intro p hp η + rw [← MeasureTheory.integrable_norm_iff (AEMeasurable.aestronglyMeasurable (by fun_prop))] + simp only [norm_mul, norm_zpow, norm_norm] + by_cases hp : p = 0 + · subst hp + simp only [zpow_zero, mul_one] + apply Integrable.norm + change Integrable (⇑η) (volume.prod volume) + exact η.integrable + suffices h1 : Integrable (fun x => ‖η x‖ * ‖x.2‖ ^ (p + (d - 1 : ℕ))) + (volume.prod (radialAngularMeasure (d := d))) by + match d with + | 0 => simpa using h1 + | d + 1 => + rw [radialAngularMeasure, MeasureTheory.prod_withDensity_right] at h1 + erw [integrable_withDensity_iff_integrable_smul₀ (by fun_prop)] at h1 + convert h1 using 1 + funext x + simp only [Real.norm_eq_abs, one_div] + rw [Real.toNNReal_of_nonneg, NNReal.smul_def] + simp only [inv_nonneg, norm_nonneg, pow_nonneg, coe_mk, smul_eq_mul] + ring_nf + rw [mul_assoc] + congr + have hx : 0 ≤ ‖x.2‖ := norm_nonneg x.2 + generalize ‖x.2‖ = r at * + by_cases hr : r = 0 + · subst hr + simp only [inv_zero] + rw [zero_pow_eq, zero_zpow_eq, zero_zpow_eq] + split_ifs <;> simp + any_goals omega + · simp only [inv_pow] + field_simp + rw [zpow_add₀ hr] + simp + · simp + · fun_prop + apply Integrable.mono' (integrable_pow_mul_iteratedFDeriv _ η (p + (d - 1 : ℕ)).toNat 0) + · apply AEMeasurable.aestronglyMeasurable + fun_prop + filter_upwards with x + simp only [Real.norm_eq_abs, norm_iteratedFDeriv_zero] + rw [mul_comm] + rw [← zpow_natCast] + rw [abs_of_nonneg (by positivity)] + apply mul_le_mul _ (by rfl) (by positivity) (by positivity) + rw [zpow_natCast] + trans ‖x.2‖ ^ ((p + (d - 1 : ℕ)).toNat : ℤ) + · apply le_of_eq + congr + refine Int.eq_natCast_toNat.mpr (by omega) + rw [zpow_natCast] + ring_nf + apply pow_le_pow_left₀ (by positivity) _ (p + (d - 1 : ℕ)).toNat + rcases x + simp + +/-! + +### B.4. Integrability with respect to inverse powers + +-/ + +lemma integrable_mul_inv_pow {d : ℕ} + {f : Space d → F} (hf : IsDistBounded f) : + ∃ r, Integrable (fun x => ‖((1 + ‖x‖) ^ r)⁻¹‖ • f x) volume := by + suffices h0 : ∀ pmax, ∃ r, ∀ (p : ℤ) (hp : - (d - 1 : ℕ) ≤ p) (c : Space d) + (p_le : p ≤ pmax), + Integrable (fun x => ‖((1 + ‖x‖) ^ r)⁻¹‖ * ‖x + c‖ ^ p) volume by + obtain ⟨n, c, g, p, c_nonneg, p_bound, bound⟩ := hf.2 + match n with + | 0 => simp at bound; simp [bound] + | n + 1 => + let pMax := Finset.max' (Finset.image p Finset.univ) (by simp) + have pMax_max (i : Fin n.succ) : p i ≤ pMax := by + simp [pMax] + apply Finset.le_max' + simp + obtain ⟨r, hr⟩ := h0 pMax + use r + apply Integrable.mono (g := fun x => ∑ i, (c i * (‖((1 + ‖x‖) ^ r)⁻¹‖ * ‖x + g i‖ ^ p i))) _ + · fun_prop + · filter_upwards with x + rw [norm_smul] + apply le_trans (mul_le_mul_of_nonneg_left (bound x) (by positivity)) + apply le_of_eq + simp only [norm_inv, norm_pow, Real.norm_eq_abs, abs_abs] + rw [Finset.abs_sum_of_nonneg (fun i _ => mul_nonneg (c_nonneg i) (by positivity)), + Finset.mul_sum] + ring_nf + · apply MeasureTheory.integrable_finset_sum + intro i _ + apply Integrable.const_mul + apply (hr (p i) (p_bound i) (g i) (pMax_max i)).mono + · fun_prop + · filter_upwards with x + simp + match d with + | 0 => simp + | d + 1 => + suffices h0 : ∀ (q : ℕ) (c : Space (d + 1)), Integrable (fun x => ‖x + c‖ ^ (q - d : ℤ) + * ‖((1 + ‖x‖) ^ (q + (radialAngularMeasure (d := d + 1)).integrablePower))⁻¹‖) volume by + intro pMax + use (pMax + d).toNat + (radialAngularMeasure (d := d + 1)).integrablePower + intro p hp c p_le + apply (h0 (p + d).toNat c).mono + · fun_prop + · filter_upwards with x + simp only [norm_inv, norm_pow, Real.norm_eq_abs, norm_mul, abs_abs, norm_zpow, + Int.ofNat_toNat] + rw [mul_comm] + refine mul_le_mul ?_ ?_ (by positivity) (by positivity) + · rw [max_eq_left (by omega)] + simp + · refine inv_pow_le_inv_pow_of_le ?_ ?_ + · rw [abs_of_nonneg (by positivity)] + simp + · simp_all + let m := (radialAngularMeasure (d := (d + 1))).integrablePower + suffices h0 : ∀ (q : ℕ) (c : Space (d + 1)), + Integrable (fun x => ‖x‖ ^ (q - d : ℤ) * ‖((1 + ‖x - c‖) ^ (q + m))⁻¹‖) volume by + intro q c + convert (h0 q c).comp_add_right c using 1 + funext x + simp [m] + suffices h0 : ∀ (q : ℕ) (v : Space (d + 1)), + Integrable (fun x => ‖x‖ ^ q * ‖((1 + ‖x - v‖) ^ (q + m))⁻¹‖) radialAngularMeasure by + intro q v + specialize h0 q v + rw [integrable_radialAngularMeasure_iff] at h0 + apply Integrable.congr h0 + rw [Filter.eventuallyEq_iff_exists_mem] + use {0}ᶜ + constructor + · rw [compl_mem_ae_iff, measure_singleton] + intro x hx + simp [← mul_assoc] + left + rw [zpow_sub₀ (by simpa using hx), zpow_natCast, zpow_natCast] + field_simp + intro q v + have hr1 (x : Space (d + 1)) : + ‖((1 + ‖x - v‖) ^ (q + m))⁻¹‖ = ((1 + ‖x - v‖) ^ (q + m))⁻¹ := by + simp only [norm_inv, norm_pow, Real.norm_eq_abs, inv_inj] + rw [abs_of_nonneg (by positivity)] + apply integrable_of_le_of_pow_mul_le (C₁ := 1) (C₂ :=2 ^ (q + m - 1) * (‖v‖ ^ (q + m) + 1)) + · simp + intro x + refine inv_le_one_of_one_le₀ ?_ + rw [abs_of_nonneg (by positivity)] + refine one_le_pow₀ ?_ + simp + · intro x + rw [hr1] + refine mul_inv_le_of_le_mul₀ ?_ (by positivity) ?_ + · positivity + change ‖x‖^ (q + m) ≤ _ + by_cases hzero : m = 0 ∧ q = 0 + · rcases hzero with ⟨hm, hq⟩ + generalize hm : m = m' at * + subst hm hq + rw [pow_zero, pow_zero] + simp + trans (‖v‖ + ‖x - v‖) ^ (q + m) + · rw [pow_le_pow_iff_left₀] + · apply norm_le_norm_add_norm_sub' + · positivity + · positivity + simp only [ne_eq, Nat.add_eq_zero_iff, not_and] + intro hq + omega + apply (add_pow_le _ _ _).trans + trans 2 ^ (q + m - 1) * (‖v‖ ^ (q + m) + ‖x - v‖ ^ (q + m)) + (2 ^ (q + m - 1) + + 2 ^ (q + m - 1) * ‖v‖ ^ (q + m) * ‖x - v‖ ^ (q + m)) + · simp + positivity + trans (2 ^ (q + m - 1) * (‖v‖ ^ (q + m) + 1)) * (1 + ‖x - v‖ ^ (q + m)) + · ring_nf + apply le_of_eq + rfl + refine mul_le_mul_of_nonneg (by rfl) ?_ ?_ ?_ + · trans 1 ^ (q + m) + ‖x - v‖ ^ (q + m) + · simp + apply pow_add_pow_le + · simp + · positivity + · simp + omega + · positivity + · positivity + · positivity + · positivity + · refine Measurable.aestronglyMeasurable ?_ + fun_prop + +/-! + +## C. Integral on Schwartz maps is bounded by seminorms + +-/ + +lemma integral_mul_schwartzMap_bounded {d : ℕ} {f : Space d → F} (hf : IsDistBounded f) : + ∃ (s : Finset (ℕ × ℕ)) (C : ℝ), + 0 ≤ C ∧ ∀ (η : 𝓢(Space d, ℝ)), + ‖∫ (x : Space d), η x • f x‖ ≤ C * (s.sup (schwartzSeminormFamily ℝ (Space d) ℝ)) η := by + obtain ⟨r, hr⟩ := hf.integrable_mul_inv_pow + use Finset.Iic (r, 0), 2 ^ r * ∫ x, ‖f x‖ * ‖((1 + ‖x‖) ^ r)⁻¹‖ + refine ⟨by positivity, fun η ↦ (norm_integral_le_integral_norm _).trans ?_⟩ + rw [← integral_const_mul, ← integral_mul_const] + refine integral_mono_of_nonneg ?_ ?_ ?_ + · filter_upwards with x + positivity + · apply Integrable.mul_const + apply Integrable.const_mul + apply Integrable.congr' hr + · apply AEStronglyMeasurable.mul + · fun_prop + · apply AEMeasurable.aestronglyMeasurable + fun_prop + filter_upwards with x + simp [norm_smul, mul_comm] + · filter_upwards with x + simp [norm_smul] + trans (2 ^ r * + ((Finset.Iic (r, 0)).sup (schwartzSeminormFamily ℝ (Space d) ℝ)) η + *(|1 + ‖x‖| ^ r)⁻¹) * ‖f x‖; swap + · apply le_of_eq + ring + apply mul_le_mul_of_nonneg ?_ (by rfl) (by positivity) (by positivity) + have h0 := one_add_le_sup_seminorm_apply (𝕜 := ℝ) (m := (r, 0)) + (k := r) (n := 0) le_rfl le_rfl η x + rw [Lean.Grind.Field.IsOrdered.le_mul_inv_iff_mul_le _ _ (by positivity)] + convert h0 using 1 + simp only [norm_iteratedFDeriv_zero, Real.norm_eq_abs] + ring_nf + congr + rw [abs_of_nonneg (by positivity)] + +/-! + +## D. Construction rules for `IsDistBounded f` + +-/ + +section constructors + +variable (𝕜 : Type) {E F F' : Type} [RCLike 𝕜] [NormedAddCommGroup E] [NormedAddCommGroup F] + [NormedAddCommGroup F'] [NormedSpace ℝ F'] + +@[fun_prop] +lemma zero {d} : IsDistBounded (0 : Space d → F) := by + apply And.intro + · fun_prop + use 1, fun _ => 0, fun _ => 0, fun _ => 0 + simp + +/-! + +### D.1. Addition + +-/ +@[fun_prop] +lemma add {d : ℕ} {f g : Space d → F} + (hf : IsDistBounded f) (hg : IsDistBounded g) : IsDistBounded (f + g) := by + apply And.intro + · fun_prop + rcases hf with ⟨hae1, ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩⟩ + rcases hg with ⟨hae2, ⟨n2, c2, g2, p2, c2_nonneg, p2_bound, bound2⟩⟩ + refine ⟨n1 + n2, Fin.append c1 c2, Fin.append g1 g2, Fin.append p1 p2, ?_, ?_, ?_⟩ + · intro i + obtain ⟨i, rfl⟩ := finSumFinEquiv.surjective i + match i with + | .inl i => + simp only [finSumFinEquiv_apply_left, Fin.append_left, ge_iff_le] + exact c1_nonneg i + | .inr i => + simp only [finSumFinEquiv_apply_right, Fin.append_right, ge_iff_le] + exact c2_nonneg i + · intro i + obtain ⟨i, rfl⟩ := finSumFinEquiv.surjective i + match i with + | .inl i => + simp only [finSumFinEquiv_apply_left, Fin.append_left, ge_iff_le] + exact p1_bound i + | .inr i => + simp only [finSumFinEquiv_apply_right, Fin.append_right, ge_iff_le] + exact p2_bound i + · intro x + apply (norm_add_le _ _).trans + apply (add_le_add (bound1 x) (bound2 x)).trans + apply le_of_eq + rw [← finSumFinEquiv.sum_comp] + simp + +@[fun_prop] +lemma fun_add {d : ℕ} {f g : Space d → F} + (hf : IsDistBounded f) (hg : IsDistBounded g) : IsDistBounded (fun x => f x + g x) := by + exact hf.add hg + +/-! + +### D.2. Finite sums + +-/ + +lemma sum {ι : Type*} {s : Finset ι} {d : ℕ} {f : ι → Space d → F} + (hf : ∀ i ∈ s, IsDistBounded (f i)) : IsDistBounded (∑ i ∈ s, f i) := by + classical + induction' s using Finset.induction with i s hi ih + · simp + fun_prop + rw [Finset.sum_insert] + apply IsDistBounded.add + · exact hf i (s.mem_insert_self i) + · exact ih (fun j hj => hf j (s.mem_insert_of_mem hj)) + exact hi + +lemma sum_fun {ι : Type*} {s : Finset ι} {d : ℕ} {f : ι → Space d → F} + (hf : ∀ i ∈ s, IsDistBounded (f i)) : IsDistBounded (fun x => ∑ i ∈ s, f i x) := by + convert sum hf using 1 + funext x + simp + +/-! + +### D.3. Scalar multiplication + +-/ + +@[fun_prop] +lemma const_smul {d : ℕ} [NormedSpace ℝ F] {f : Space d → F} + (hf : IsDistBounded f) (c : ℝ) : IsDistBounded (c • f) := by + rcases hf with ⟨hae1, ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩⟩ + apply And.intro + · fun_prop + refine ⟨n1, ‖c‖ • c1, g1, p1, ?_, p1_bound, ?_⟩ + · intro i + simp only [Real.norm_eq_abs, Pi.smul_apply, smul_eq_mul] + have hi := c1_nonneg i + positivity + · intro x + simp [norm_smul] + conv_rhs => enter [2, x]; rw [mul_assoc] + rw [← Finset.mul_sum] + refine mul_le_mul (by rfl) (bound1 x) ?_ ?_ + · exact norm_nonneg (f x) + · exact abs_nonneg c + +@[fun_prop] +lemma neg {d : ℕ} [NormedSpace ℝ F] {f : Space d → F} + (hf : IsDistBounded f) : IsDistBounded (fun x => - f x) := by + convert hf.const_smul (-1) using 1 + funext x + simp + +@[fun_prop] +lemma const_fun_smul {d : ℕ} [NormedSpace ℝ F] {f : Space d → F} + (hf : IsDistBounded f) (c : ℝ) : IsDistBounded (fun x => c • f x) := by + convert hf.const_smul c using 1 + +@[fun_prop] +lemma const_mul_fun {d : ℕ} + {f : Space d → ℝ} + (hf : IsDistBounded f) (c : ℝ) : IsDistBounded (fun x => c * f x) := by + convert hf.const_smul c using 1 + +@[fun_prop] +lemma mul_const_fun {d : ℕ} + {f : Space d → ℝ} + (hf : IsDistBounded f) (c : ℝ) : IsDistBounded (fun x => f x * c) := by + convert hf.const_smul c using 2 + simp only [Pi.smul_apply, smul_eq_mul] + ring + +/-! + +### D.4. Components of functions + +-/ + +@[fun_prop] +lemma pi_comp {d n : ℕ} + {f : Space d → EuclideanSpace ℝ (Fin n)} + (hf : IsDistBounded f) (j : Fin n) : IsDistBounded (fun x => f x j) := by + rcases hf with ⟨hae1, ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩⟩ + apply And.intro + · fun_prop + refine ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, ?_⟩ + intro x + apply le_trans ?_ (bound1 x) + simp only [Real.norm_eq_abs] + rw [@PiLp.norm_eq_of_L2] + refine Real.abs_le_sqrt ?_ + trans ∑ i ∈ {j}, ‖(f x) i‖ ^ 2 + · simp + apply Finset.sum_le_univ_sum_of_nonneg + intro y + exact sq_nonneg ‖f x y‖ + +lemma vector_component {d n : ℕ} {f : Space d → Lorentz.Vector n} + (hf : IsDistBounded f) (j : Fin 1 ⊕ Fin n) : IsDistBounded (fun x => f x j) := by + rcases hf with ⟨hae1, ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩⟩ + apply And.intro + · fun_prop + refine ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, ?_⟩ + intro x + apply le_trans ?_ (bound1 x) + simp [Real.norm_eq_abs] + +/-! + +### D.5. Compositions with additions and subtractions + +-/ + +lemma comp_add_right {d : ℕ} {f : Space d → F} + (hf : IsDistBounded f) (c : Space d) : + IsDistBounded (fun x => f (x + c)) := by + rcases hf with ⟨hae1, ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩⟩ + apply And.intro + · simp + apply AEStronglyMeasurable.comp_measurable + · rw [Measure.IsAddRightInvariant.map_add_right_eq_self] + fun_prop + · fun_prop + refine ⟨n1, c1, fun i => g1 i + c, p1, c1_nonneg, p1_bound, ?_⟩ + intro x + apply (bound1 (x + c)).trans + apply le_of_eq + congr 1 + funext x + congr 3 + module + +lemma comp_sub_right {d : ℕ} {f : Space d → F} + (hf : IsDistBounded f) (c : Space d) : + IsDistBounded (fun x => f (x - c)) := by + convert hf.comp_add_right (- c) using 1 + +/-! + +### D.6. Congruence with respect to the norm + +-/ + +omit [NormedSpace ℝ F'] in +lemma congr {d : ℕ} {f : Space d → F} + {g : Space d → F'} + (hf : IsDistBounded f) (hae : AEStronglyMeasurable g) (hfg : ∀ x, ‖g x‖ = ‖f x‖) : + IsDistBounded g := by + rcases hf with ⟨hae1, ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩⟩ + apply And.intro + · exact hae + refine ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, ?_⟩ + intro x + rw [hfg x] + exact bound1 x + +/-! + +### D.7. Monotonicity with respect to the norm + +-/ + +omit [NormedSpace ℝ F'] in +lemma mono {d : ℕ} {f : Space d → F} + {g : Space d → F'} + (hf : IsDistBounded f) (hae : AEStronglyMeasurable g) + (hfg : ∀ x, ‖g x‖ ≤ ‖f x‖) : IsDistBounded g := by + rcases hf with ⟨hae1, ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩⟩ + apply And.intro + · exact hae + refine ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, ?_⟩ + intro x + exact (hfg x).trans (bound1 x) + +/-! + +### D.8. Inner products + +-/ + +open InnerProductSpace +@[fun_prop] +lemma inner_left {d n : ℕ} + {f : Space d → EuclideanSpace ℝ (Fin n) } + (hf : IsDistBounded f) (y : EuclideanSpace ℝ (Fin n)) : + IsDistBounded (fun x => ⟪f x, y⟫_ℝ) := by + rcases hf with ⟨hae1, ⟨n1, c1, g1, p1, c1_nonneg, p1_bound, bound1⟩⟩ + apply And.intro + · fun_prop + refine ⟨n1, fun i => ‖y‖ * c1 i, g1, p1, ?_, p1_bound, ?_⟩ + · intro i + simp only + have hi := c1_nonneg i + positivity + · intro x + apply (norm_inner_le_norm (f x) y).trans + rw [mul_comm] + conv_rhs => enter [2, i]; rw [mul_assoc] + rw [← Finset.mul_sum] + refine mul_le_mul (by rfl) (bound1 x) ?_ ?_ + · exact norm_nonneg (f x) + · exact norm_nonneg y + +/-! + +### D.9. Scalar multiplication with constant +-/ + +@[fun_prop] +lemma smul_const {d : ℕ} [NormedSpace ℝ F] {c : Space d → ℝ} + (hc : IsDistBounded c) (f : F) : IsDistBounded (fun x => c x • f) := by + apply IsDistBounded.congr (f := fun x => (c x) * ‖f‖) + · fun_prop + · fun_prop + · intro x + simp [norm_smul] +/-! + +## E. Specific functions that are `IsDistBounded` + +-/ + +/-! + +### E.1. Constant functions + +-/ + +@[fun_prop] +lemma const {d : ℕ} (f : F) : + IsDistBounded (d := d) (fun _ : Space d => f) := by + apply And.intro + · fun_prop + use 1, fun _ => ‖f‖, fun _ => 0, fun _ => 0 + simp + +/-! + +### E.2. Powers of norms + +-/ + +@[fun_prop] +lemma pow {d : ℕ} (n : ℤ) (hn : - (d - 1 : ℕ) ≤ n) : + IsDistBounded (d := d) (fun x => ‖x‖ ^ n) := by + apply And.intro + · apply AEMeasurable.aestronglyMeasurable + fun_prop + refine ⟨1, fun _ => 1, fun _ => 0, fun _ => n, ?_, ?_, ?_⟩ + · simp + · simp + exact hn + · intro x + simp + +@[fun_prop] +lemma pow_shift {d : ℕ} (n : ℤ) + (g : Space d) (hn : - (d - 1 : ℕ) ≤ n) : + IsDistBounded (d := d) (fun x => ‖x - g‖ ^ n) := by + apply And.intro + · apply AEMeasurable.aestronglyMeasurable + fun_prop + refine ⟨1, fun _ => 1, fun _ => (- g), fun _ => n, ?_, ?_, ?_⟩ + · simp + · simp + exact hn + · intro x + simp + rfl + +@[fun_prop] +lemma inv_shift {d : ℕ} + (g : Space d.succ.succ) : + IsDistBounded (d := d.succ.succ) (fun x => ‖x - g‖⁻¹) := by + convert IsDistBounded.pow_shift (d := d.succ.succ) (-1) g (by simp) using 1 + ext1 x + simp +@[fun_prop] +lemma nat_pow {d : ℕ} (n : ℕ) : + IsDistBounded (d := d) (fun x => ‖x‖ ^ n) := by + exact IsDistBounded.pow (d := d) (n : ℤ) (by omega) + +@[fun_prop] +lemma norm_add_nat_pow {d : ℕ} (n : ℕ) (a : ℝ) : + IsDistBounded (d := d) (fun x => (‖x‖ + a) ^ n) := by + conv => + enter [1, x] + rw [add_pow] + apply IsDistBounded.sum_fun + intro i _ + fun_prop + +@[fun_prop] +lemma norm_add_pos_nat_zpow {d : ℕ} (n : ℤ) (a : ℝ) (ha : 0 < a) : + IsDistBounded (d := d) (fun x => (‖x‖ + a) ^ n) := by + match n with + | Int.ofNat n => fun_prop + | Int.negSucc n => + apply IsDistBounded.mono (f := fun x => (a ^ ((n + 1)))⁻¹) + · fun_prop + · apply AEMeasurable.aestronglyMeasurable + fun_prop + · intro x + simp only [zpow_negSucc, norm_inv, norm_pow, Real.norm_eq_abs] + refine inv_anti₀ (by positivity) ?_ + refine (pow_le_pow_iff_left₀ (by positivity) (by positivity) (by simp)).mpr ?_ + rw [abs_of_nonneg (by positivity), abs_of_nonneg (by positivity)] + simp + +@[fun_prop] +lemma nat_pow_shift {d : ℕ} (n : ℕ) + (g : Space d) : + IsDistBounded (d := d) (fun x => ‖x - g‖ ^ n) := by + exact IsDistBounded.pow_shift (d := d) (n : ℤ) g (by omega) + +@[fun_prop] +lemma norm_sub {d : ℕ} (g : Space d) : + IsDistBounded (d := d) (fun x => ‖x - g‖) := by + convert IsDistBounded.nat_pow_shift (d := d) 1 g using 1 + ext1 x + simp + +@[fun_prop] +lemma norm_add {d : ℕ} (g : Space d) : + IsDistBounded (d := d) (fun x => ‖x + g‖) := by + convert IsDistBounded.nat_pow_shift (d := d) 1 (- g) using 1 + ext1 x + simp + +@[fun_prop] +lemma inv {n : ℕ} : + IsDistBounded (d := n.succ.succ) (fun x => ‖x‖⁻¹) := by + convert IsDistBounded.pow (d := n.succ.succ) (-1) (by simp) using 1 + ext1 x + simp + +@[fun_prop] +lemma norm {d : ℕ} : IsDistBounded (d := d) (fun x => ‖x‖) := by + convert IsDistBounded.nat_pow (d := d) 1 using 1 + ext1 x + simp + +@[fun_prop] +lemma log_norm {d : ℕ} : + IsDistBounded (d := d.succ.succ) (fun x => Real.log ‖x‖) := by + apply IsDistBounded.mono (f := fun x => ‖x‖⁻¹ + ‖x‖) + · fun_prop + · apply AEMeasurable.aestronglyMeasurable + fun_prop + · intro x + simp only [Nat.succ_eq_add_one, Real.norm_eq_abs] + conv_rhs => rw [abs_of_nonneg (by positivity)] + have h1 := Real.neg_inv_le_log (x := ‖x‖) (by positivity) + have h2 := Real.log_le_rpow_div (x := ‖x‖) (by positivity) (ε := 1) (by positivity) + simp_all + rw [abs_le'] + generalize Real.log ‖x‖ = r at * + apply And.intro + · apply h2.trans + simp + · rw [neg_le] + apply le_trans _ h1 + simp + +lemma zpow_smul_self {d : ℕ} (n : ℤ) (hn : - (d - 1 : ℕ) - 1 ≤ n) : + IsDistBounded (d := d) (fun x => ‖x‖ ^ n • x) := by + by_cases hzero : n = -1 + · apply IsDistBounded.mono (f := fun x => (1 : ℝ)) + · fun_prop + · apply AEMeasurable.aestronglyMeasurable + fun_prop + · intro x + simp [norm_smul] + subst hzero + simp only [Int.reduceNeg, zpow_neg, zpow_one] + by_cases hx : x = 0 + · subst hx + simp + rw [inv_mul_cancel₀] + simpa using hx + apply IsDistBounded.congr (f := fun x => ‖x‖ ^ (n + 1)) + · apply pow + omega + · apply AEMeasurable.aestronglyMeasurable + fun_prop + · intro x + by_cases hx : x = 0 + · subst hx + simp only [norm_zero, smul_zero, norm_zpow] + rw [@zero_zpow_eq] + rw [if_neg] + omega + · simp [norm_smul] + rw [zpow_add₀] + simp only [zpow_one] + ring_nf + simpa using hx + +lemma zpow_smul_repr_self {d : ℕ} (n : ℤ) (hn : - (d - 1 : ℕ) - 1 ≤ n) : + IsDistBounded (d := d) (fun x => ‖x‖ ^ n • basis.repr x) := by + apply IsDistBounded.congr (f := fun x => ‖x‖ ^ n • x) + · apply zpow_smul_self + exact hn + · apply AEMeasurable.aestronglyMeasurable + fun_prop + · intro x + simp [norm_smul] + +lemma zpow_smul_repr_self_sub {d : ℕ} (n : ℤ) (hn : - (d - 1 : ℕ) - 1 ≤ n) + (y : Space d) : + IsDistBounded (d := d) (fun x => ‖x - y‖ ^ n • basis.repr (x - y)) := by + apply (zpow_smul_repr_self n hn).comp_sub_right y + +lemma inv_pow_smul_self {d : ℕ} (n : ℕ) (hn : - (d - 1 : ℕ) - 1 ≤ (- n : ℤ)) : + IsDistBounded (d := d) (fun x => ‖x‖⁻¹ ^ n • x) := by + convert zpow_smul_self (n := - (n : ℤ)) (by omega) using 1 + funext x + simp + +lemma inv_pow_smul_repr_self {d : ℕ} (n : ℕ) (hn : - (d - 1 : ℕ) - 1 ≤ (- n : ℤ)) : + IsDistBounded (d := d) (fun x => ‖x‖⁻¹ ^ n • basis.repr x) := by + convert zpow_smul_repr_self (n := - (n : ℤ)) (by omega) using 1 + funext x + simp + +/-! + +## F. Multiplication by norms and components + +-/ + +lemma norm_smul_nat_pow {d} (p : ℕ) (c : Space d) : + IsDistBounded (fun x => ‖x‖ * ‖x + c‖ ^ p) := by + apply IsDistBounded.mono (f := fun x => ‖x‖ * (‖x‖ + ‖c‖) ^ p) + · conv => + enter [1, x] + rw [add_pow] + rw [Finset.mul_sum] + apply IsDistBounded.sum_fun + intro i _ + conv => + enter [1, x] + rw [← mul_assoc, ← mul_assoc] + apply IsDistBounded.mul_const_fun + apply IsDistBounded.mul_const_fun + convert IsDistBounded.nat_pow (n := i + 1) using 1 + funext x + ring + · apply AEMeasurable.aestronglyMeasurable + fun_prop + · intro x + simp [norm_mul, norm_pow, Real.norm_eq_abs] + rw [abs_of_nonneg (by positivity)] + have h1 : ‖x + c‖ ≤ ‖x‖ + ‖c‖ := norm_add_le x c + have h2 : ‖x + c‖ ^ p ≤ (‖x‖ + ‖c‖) ^ p := by + refine pow_le_pow_left₀ (by positivity) h1 p + apply (mul_le_mul (by rfl) h2 (by positivity) (by positivity)).trans + rfl + +lemma norm_smul_zpow {d} (p : ℤ) (c : Space d) (hn : - (d - 1 : ℕ) ≤ p) : + IsDistBounded (fun x => ‖x‖ * ‖x + c‖ ^ p) := by + match p with + | Int.ofNat p => exact norm_smul_nat_pow p c + | Int.negSucc p => + suffices h0 : IsDistBounded (fun x => ‖x - c‖ * (‖x‖ ^ (p + 1))⁻¹) by + convert h0.comp_sub_right (- c) using 1 + funext x + simp + suffices h0 : IsDistBounded (fun x => (‖x‖ + ‖c‖) * (‖x‖ ^ (p + 1))⁻¹) by + apply h0.mono + · fun_prop + · intro x + simp [norm_mul, norm_inv, norm_pow, Real.norm_eq_abs] + rw [abs_of_nonneg (by positivity)] + apply mul_le_mul (norm_sub_le x c) (by rfl) (by positivity) (by positivity) + suffices h0 : IsDistBounded (fun x => ‖x‖ * (‖x‖ ^ (p + 1))⁻¹ + ‖c‖ * (‖x‖ ^ (p + 1))⁻¹) by + convert h0 using 1 + funext x + ring + suffices h0 : IsDistBounded (fun x => ‖x‖ * (‖x‖ ^ (p + 1))⁻¹) by + apply h0.add + · apply IsDistBounded.const_mul_fun + exact IsDistBounded.pow (d := d) (n := -(p + 1)) (by grind) + by_cases hp : p = 0 + · subst hp + simp only [zero_add, pow_one] + apply IsDistBounded.mono (f := fun x => (1 : ℝ)) + · fun_prop + · apply AEMeasurable.aestronglyMeasurable + fun_prop + · intro x + simp only [norm_mul, norm_norm, norm_inv, one_mem, CStarRing.norm_of_mem_unitary] + by_cases hx : ‖x‖ ≠ 0 + · rw [mul_inv_cancel₀ (by positivity)] + · simp at hx + subst hx + simp + convert IsDistBounded.pow (d := d) (n := - p) (by grind) using 1 + funext x + trans (‖x‖ ^ p)⁻¹; swap + · rw [@zpow_neg] + simp + by_cases hx : ‖x‖ ≠ 0 + field_simp + ring + simp at hx + subst hx + simp only [norm_zero, ne_eq, Nat.add_eq_zero_iff, one_ne_zero, and_false, not_false_eq_true, + zero_pow, inv_zero, mul_zero, zero_eq_inv] + rw [@zero_pow_eq] + simp [hp] + +@[fun_prop] +lemma norm_smul_isDistBounded {d : ℕ} [NormedSpace ℝ F] {f : Space d → F} + (hf : IsDistBounded f) : + IsDistBounded (fun x => ‖x‖ • f x) := by + obtain ⟨hae, ⟨n, c, g, p, c_nonneg, p_bound, bound⟩⟩ := hf + apply IsDistBounded.mono (f := fun x => ‖x‖ * ∑ i, (c i * ‖x + g i‖ ^ (p i))) + · apply IsDistBounded.congr (f := fun x => ∑ i, (c i * (‖x‖ * ‖x + g i‖ ^ (p i)))) + · apply IsDistBounded.sum_fun + intro i _ + apply IsDistBounded.const_mul_fun + exact norm_smul_zpow (p i) (g i) (p_bound i) + · fun_prop + · intro x + congr + rw [Finset.mul_sum] + congr + funext i + ring + · fun_prop + · intro x + simp [_root_.norm_smul] + apply (mul_le_mul (by rfl) (bound x) (by positivity) (by positivity)).trans + rw [abs_of_nonneg] + apply Finset.sum_nonneg + intro i _ + apply mul_nonneg + · exact c_nonneg i + · positivity + +@[fun_prop] +lemma norm_mul_isDistBounded {d : ℕ} {f : Space d → ℝ} + (hf : IsDistBounded f) : + IsDistBounded (fun x => ‖x‖ * f x) := by + convert hf.norm_smul_isDistBounded using 1 + +@[fun_prop] +lemma component_smul_isDistBounded {d : ℕ} [NormedSpace ℝ F] {f : Space d → F} + (hf : IsDistBounded f) (i : Fin d) : + IsDistBounded (fun x => x i • f x) := by + apply IsDistBounded.mono (f := fun x => ‖x‖ • f x) + · fun_prop + · apply AEStronglyMeasurable.smul + · have h1 : AEStronglyMeasurable (fun x => Space.coordCLM i x) := by + fun_prop + convert h1 using 1 + funext i + simp [coordCLM_apply, coord_apply] + · fun_prop + · intro x + simp [norm_smul] + apply mul_le_mul ?_ (by rfl) (by positivity) (by positivity) + exact abs_eval_le_norm x i + +@[fun_prop] +lemma component_mul_isDistBounded {d : ℕ} {f : Space d → ℝ} + (hf : IsDistBounded f) (i : Fin d) : + IsDistBounded (fun x => x i * f x) := by + convert hf.component_smul_isDistBounded i using 2 + +@[fun_prop] +lemma isDistBounded_smul_self {d : ℕ} {f : Space d → ℝ} + (hf : IsDistBounded f) : IsDistBounded (fun x => f x • x) := by + apply IsDistBounded.congr (f := fun x => ‖x‖ * f x) + · fun_prop + · apply AEStronglyMeasurable.smul + · fun_prop + · fun_prop + · intro x + simp [norm_smul] + ring + +@[fun_prop] +lemma isDistBounded_smul_self_repr {d : ℕ} {f : Space d → ℝ} + (hf : IsDistBounded f) : IsDistBounded (fun x => f x • basis.repr x) := by + apply IsDistBounded.congr (f := fun x => ‖x‖ * f x) + · fun_prop + · apply AEStronglyMeasurable.smul + · fun_prop + · fun_prop + · intro x + simp [norm_smul] + ring + +@[fun_prop] +lemma isDistBounded_smul_inner {d : ℕ} [NormedSpace ℝ F] {f : Space d → F} + (hf : IsDistBounded f) (y : Space d) : IsDistBounded (fun x => ⟪y, x⟫_ℝ • f x) := by + have h1 (x : Space d) : ⟪y, x⟫_ℝ • f x = ∑ i, (y i * x i) • f x := by + rw [inner_eq_sum, ← Finset.sum_smul] + conv => + enter [1, x] + rw [h1 x] + apply IsDistBounded.sum_fun + intro i _ + simp [← smul_smul] + refine const_fun_smul ?_ (y i) + fun_prop + +lemma isDistBounded_smul_inner_of_smul_norm {d : ℕ} [NormedSpace ℝ F] {f : Space d → F} + (hf : IsDistBounded (fun x => ‖x‖ • f x)) (hae : AEStronglyMeasurable f) (y : Space d) : + IsDistBounded (fun x => ⟪y, x⟫_ℝ • f x) := by + have h1 (x : Space d) : ⟪y, x⟫_ℝ • f x = ∑ i, (y i * x i) • f x := by + rw [inner_eq_sum, ← Finset.sum_smul] + conv => + enter [1, x] + rw [h1 x] + apply IsDistBounded.sum_fun + intro i _ + simp [← smul_smul] + refine const_fun_smul ?_ (y i) + apply hf.mono + · fun_prop + · intro x + simp [norm_smul] + refine mul_le_mul_of_nonneg_right ?_ (by positivity) + exact abs_eval_le_norm x i + +@[fun_prop] +lemma isDistBounded_mul_inner {d : ℕ} {f : Space d → ℝ} + (hf : IsDistBounded f) (y : Space d) : IsDistBounded (fun x => ⟪y, x⟫_ℝ * f x) := by + convert hf.isDistBounded_smul_inner y using 2 + +lemma isDistBounded_mul_inner' {d : ℕ} {f : Space d → ℝ} + (hf : IsDistBounded f) (y : Space d) : IsDistBounded (fun x => ⟪x, y⟫_ℝ * f x) := by + convert hf.isDistBounded_smul_inner y using 2 + rw [real_inner_comm] + simp + +lemma isDistBounded_mul_inner_of_smul_norm {d : ℕ} {f : Space d → ℝ} + (hf : IsDistBounded (fun x => ‖x‖ * f x)) (hae : AEStronglyMeasurable f) (y : Space d) : + IsDistBounded (fun x => ⟪y, x⟫_ℝ * f x) := by + convert hf.isDistBounded_smul_inner_of_smul_norm hae y using 2 + +@[fun_prop] +lemma mul_inner_pow_neg_two {d : ℕ} + (y : Space d.succ.succ) : + IsDistBounded (fun x => ⟪y, x⟫_ℝ * ‖x‖ ^ (- 2 : ℤ)) := by + apply IsDistBounded.mono (f := fun x => (‖y‖ * ‖x‖) * ‖x‖ ^ (- 2 : ℤ)) + · simp [mul_assoc] + apply IsDistBounded.const_mul_fun + apply IsDistBounded.congr (f := fun x => ‖x‖ ^ (- 1 : ℤ)) + · apply IsDistBounded.pow (d := d.succ.succ) (-1) (by simp) + · apply AEMeasurable.aestronglyMeasurable + fun_prop + · intro x + simp only [norm_mul, norm_norm, norm_inv, norm_zpow, Int.reduceNeg, zpow_neg, zpow_one] + by_cases hx : x = 0 + · subst hx + simp + have hx' : ‖x‖ ≠ 0 := by + simpa using hx + field_simp + · apply AEMeasurable.aestronglyMeasurable + fun_prop + · intro x + simp + apply mul_le_mul_of_nonneg _ (by rfl) (by positivity) (by positivity) + exact abs_real_inner_le_norm y x + +end constructors +end IsDistBounded diff --git a/PhysLean/SpaceAndTime/Space/LengthUnit.lean b/PhysLean/SpaceAndTime/Space/LengthUnit.lean index c376bcc4e..b034cf59e 100644 --- a/PhysLean/SpaceAndTime/Space/LengthUnit.lean +++ b/PhysLean/SpaceAndTime/Space/LengthUnit.lean @@ -5,7 +5,6 @@ Authors: Joseph Tooby-Smith -/ import Mathlib.Geometry.Manifold.Diffeomorph import PhysLean.SpaceAndTime.Time.Basic -import PhysLean.Meta.TODO.Basic /-! # Units on Length @@ -18,8 +17,8 @@ positive reals. On `LengthUnit` there is an instance of division giving a real number, corresponding to the ratio of the two scales of length unit. -To define specific length units, we first axiomise the existence of a -a given length unit, and then construct all other length units from it. We choose to axiomise the +To define specific length units, we first state the existence of a +a given length unit, and then construct all other length units from it. We choose to state the existence of the length unit of meters, and construct all other length units from that. -/ @@ -34,7 +33,7 @@ structure LengthUnit where namespace LengthUnit @[simp] -lemma val_neq_zero (x : LengthUnit) : x.val ≠ 0 := by +lemma val_ne_zero (x : LengthUnit) : x.val ≠ 0 := by exact Ne.symm (ne_of_lt x.property) lemma val_pos (x : LengthUnit) : 0 < x.val := x.property @@ -57,7 +56,7 @@ lemma div_eq_val (x y : LengthUnit) : (x / y) = (⟨x.val / y.val, div_nonneg (le_of_lt x.val_pos) (le_of_lt y.val_pos)⟩ : ℝ≥0) := rfl @[simp] -lemma div_neq_zero (x y : LengthUnit) : ¬ x / y = (0 : ℝ≥0) := by +lemma div_ne_zero (x y : LengthUnit) : ¬ x / y = (0 : ℝ≥0) := by rw [div_eq_val] refine coe_ne_zero.mp ?_ simp @@ -66,12 +65,12 @@ lemma div_neq_zero (x y : LengthUnit) : ¬ x / y = (0 : ℝ≥0) := by lemma div_pos (x y : LengthUnit) : (0 : ℝ≥0) < x/ y := by apply lt_of_le_of_ne · exact zero_le (x / y) - · exact Ne.symm (div_neq_zero x y) + · exact Ne.symm (div_ne_zero x y) @[simp] lemma div_self (x : LengthUnit) : x / x = (1 : ℝ≥0) := by - simp [div_eq_val, x.val_neq_zero] + simp [div_eq_val, x.val_ne_zero] lemma div_symm (x y : LengthUnit) : x / y = (y / x)⁻¹ := NNReal.eq <| by @@ -127,16 +126,16 @@ lemma scale_scale (x : LengthUnit) (r1 r2 : ℝ) (hr1 : 0 < r1) (hr2 : 0 < r2) : ## Specific choices of Length units -To define a specific length units, we must first axiomise the existence of a -a given length unit, and then construct all other length units from it. -We choose to axiomise the existence of the length unit of meters. - -We need an axiom since this relates something to something in the physical world. +To define a specific length units. +We first define the notion of a meter to correspond to the length unit with underlying value +equal to `1`. This is really down to a choice in the isomorphism between the set of metrics +on the space manifold and the positive reals. +From this choice of meters, we can define other length units by scaling meters. -/ -/-- The axiom corresponding to the definition of a length unit of meters. -/ -axiom meters : LengthUnit +/-- The definition of a length unit of meters. -/ +def meters : LengthUnit := ⟨1, by norm_num⟩ /-- The length unit of femtometers (10⁻¹⁵ of a meter). -/ noncomputable def femtometers : LengthUnit := scale ((1/10) ^ (15)) meters diff --git a/PhysLean/SpaceAndTime/Space/Norm.lean b/PhysLean/SpaceAndTime/Space/Norm.lean new file mode 100644 index 000000000..1fcbc4778 --- /dev/null +++ b/PhysLean/SpaceAndTime/Space/Norm.lean @@ -0,0 +1,1091 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +import PhysLean.SpaceAndTime.Space.Derivatives.Div +import Mathlib.Analysis.InnerProductSpace.NormPow +import Mathlib.Analysis.Calculus.FDeriv.Norm +/-! + +# The norm on space + +## i. Overview + +The main content of this file is defining `Space.normPowerSeries`, a power series which is +differentiable everywhere, and which tends to the norm in the limit as `n → ∞`. + +We use properties of this power series to prove various results about distributions involving norms. + +## ii. Key results + +- `normPowerSeries` : A power series which is differentiable everywhere, and in the limit + as `n → ∞` tends to `‖x‖`. +- `normPowerSeries_differentiable` : The power series is differentiable everywhere. +- `normPowerSeries_tendsto` : The power series tends to the norm in the limit as `n → ∞`. +- `distGrad_distOfFunction_norm_zpow` : The gradient of the distribution defined by a power of the + norm. +- `distGrad_distOfFunction_log_norm` : The gradient of the distribution defined by the logarithm + of the norm. +- `distDiv_inv_pow_eq_dim` : The divergence of the distribution defined by the + inverse power of the norm proportional to the Dirac delta distribution. + +## iii. Table of contents + +- A. The norm as a power series + - A.1. Differentiability of the norm power series + - A.2. The limit of the norm power series + - A.3. The derivative of the norm power series + - A.4. Limits of the derivative of the power series + - A.5. The power series is AEStronglyMeasurable + - A.6. Bounds on the norm power series + - A.7. The `IsDistBounded` property of the norm power series + - A.8. Differentiability of functions + - A.9. Derivatives of functions + - A.10. Gradients of distributions based on powers + - A.10.1. The limits of gradients of distributions based on powers + - A.11. Gradients of distributions based on logs + - A.11.1. The limits of gradients of distributions based on logs +- B. Distributions involving norms + - B.1. The gradient of distributions based on powers + - B.2. The gradient of distributions based on logs + - B.3. Divergence equal dirac delta + +## iv. References + +-/ +open SchwartzMap NNReal +noncomputable section + +variable (𝕜 : Type) {E F F' : Type} [RCLike 𝕜] [NormedAddCommGroup E] [NormedAddCommGroup F] + [NormedAddCommGroup F'] [NormedSpace ℝ E] [NormedSpace ℝ F] + +namespace Space + +open MeasureTheory + +/-! + +## A. The norm as a power series + +-/ + +/-- A power series which is differentiable everywhere, and in the limit + as `n → ∞` tends to `‖x‖`. -/ +def normPowerSeries {d} : ℕ → Space d → ℝ := fun n x => + √(‖x‖ ^ 2 + 1/(n + 1)) + +lemma normPowerSeries_eq (n : ℕ) : + normPowerSeries (d := d) n = fun x => √(‖x‖ ^ 2 + 1/(n + 1)) := rfl + +lemma normPowerSeries_eq_rpow {d} (n : ℕ) : + normPowerSeries (d := d) n = fun x => ((‖x‖ ^ 2 + 1/(n + 1))) ^ (1/2 : ℝ) := by + rw [normPowerSeries_eq] + funext x + rw [← Real.sqrt_eq_rpow] + +/-! + +### A.1. Differentiability of the norm power series + +-/ + +@[fun_prop] +lemma normPowerSeries_differentiable {d} (n : ℕ) : + Differentiable ℝ (fun (x : Space d) => normPowerSeries n x) := by + rw [normPowerSeries_eq_rpow] + refine Differentiable.rpow_const ?_ ?_ + · refine (Differentiable.fun_add_iff_right ?_).mpr ?_ + · apply Differentiable.norm_sq ℝ + fun_prop + · fun_prop + · intro x + have h1 : 0 < ‖x‖ ^ 2 + 1 / (↑n + 1) := by positivity + grind + +/-! + +### A.2. The limit of the norm power series + +-/ +open InnerProductSpace + +open scoped Topology BigOperators FourierTransform + +lemma normPowerSeries_tendsto {d} (x : Space d) (hx : x ≠ 0) : + Filter.Tendsto (fun n => normPowerSeries n x) Filter.atTop (𝓝 (‖x‖)) := by + conv => enter [1, n]; rw [normPowerSeries_eq_rpow] + simp only [one_div] + have hx_norm : ‖x‖ = (‖x‖ ^ 2 + 0) ^ (1 / 2 : ℝ) := by + rw [← Real.sqrt_eq_rpow] + simp + conv_rhs => rw [hx_norm] + refine Filter.Tendsto.rpow ?_ ?_ ?_ + · apply Filter.Tendsto.add + · exact tendsto_const_nhds + · simpa using tendsto_one_div_add_atTop_nhds_zero_nat (𝕜 := ℝ) + · simp + · left + simpa using hx + +lemma normPowerSeries_inv_tendsto {d} (x : Space d) (hx : x ≠ 0) : + Filter.Tendsto (fun n => (normPowerSeries n x)⁻¹) Filter.atTop (𝓝 (‖x‖⁻¹)) := by + apply Filter.Tendsto.inv₀ + · exact normPowerSeries_tendsto x hx + · simpa using hx + +/-! + +### A.3. The derivative of the norm power series + +-/ +open Space + +lemma deriv_normPowerSeries {d} (n : ℕ) (x : Space d) (i : Fin d) : + ∂[i] (normPowerSeries n) x = x i * (normPowerSeries n x)⁻¹ := by + rw [deriv_eq_fderiv_basis] + rw [normPowerSeries_eq] + rw [fderiv_sqrt] + simp only [one_div, mul_inv_rev, fderiv_add_const, ContinuousLinearMap.coe_smul', Pi.smul_apply, + smul_eq_mul] + rw [← deriv_eq_fderiv_basis] + rw [deriv_norm_sq] + ring + · simp + apply DifferentiableAt.norm_sq ℝ + fun_prop + · positivity + +lemma fderiv_normPowerSeries {d} (n : ℕ) (x y : Space d) : + fderiv ℝ (fun (x : Space d) => normPowerSeries n x) x y = + ⟪y, x⟫_ℝ * (normPowerSeries n x)⁻¹ := by + rw [fderiv_eq_sum_deriv, inner_eq_sum, Finset.sum_mul] + congr + funext i + simp [deriv_normPowerSeries] + ring + +/-! + +### A.4. Limits of the derivative of the power series + +-/ + +lemma deriv_normPowerSeries_tendsto {d} (x : Space d) (hx : x ≠ 0) (i : Fin d) : + Filter.Tendsto (fun n => ∂[i] (normPowerSeries n) x) Filter.atTop (𝓝 (x i * (‖x‖)⁻¹)) := by + conv => enter [1, n]; rw [deriv_normPowerSeries] + refine Filter.Tendsto.mul ?_ ?_ + · exact tendsto_const_nhds + · exact normPowerSeries_inv_tendsto x hx + +lemma fderiv_normPowerSeries_tendsto {d} (x y : Space d) (hx : x ≠ 0) : + Filter.Tendsto (fun n => fderiv ℝ (fun (x : Space d) => normPowerSeries n x) x y) + Filter.atTop (𝓝 (⟪y, x⟫_ℝ * (‖x‖)⁻¹)) := by + conv => enter [1, n]; rw [fderiv_normPowerSeries] + refine Filter.Tendsto.mul ?_ ?_ + · exact tendsto_const_nhds + · exact normPowerSeries_inv_tendsto x hx + +/-! + +### A.5. The power series is AEStronglyMeasurable + +-/ + +@[fun_prop] +lemma normPowerSeries_aestronglyMeasurable {d} (n : ℕ) : + AEStronglyMeasurable (normPowerSeries n : Space d → ℝ) volume := by + rw [normPowerSeries_eq_rpow] + refine StronglyMeasurable.aestronglyMeasurable ?_ + refine stronglyMeasurable_iff_measurable.mpr ?_ + fun_prop + +/-! + +### A.6. Bounds on the norm power series + +-/ + +@[simp] +lemma normPowerSeries_nonneg {d} (n : ℕ) (x : Space d) : + 0 ≤ normPowerSeries n x := by + rw [normPowerSeries_eq] + simp + +@[simp] +lemma normPowerSeries_pos {d} (n : ℕ) (x : Space d) : + 0 < normPowerSeries n x := by + rw [normPowerSeries_eq] + simp only [one_div, Real.sqrt_pos] + positivity + +@[simp] +lemma normPowerSeries_ne_zero {d} (n : ℕ) (x : Space d) : + normPowerSeries n x ≠ 0 := by + rw [normPowerSeries_eq] + simp only [one_div, ne_eq] + positivity + +lemma normPowerSeries_le_norm_sq_add_one {d} (n : ℕ) (x : Space d) : + normPowerSeries n x ≤ ‖x‖ + 1 := by + trans √(‖x‖ ^ 2 + 1) + · rw [normPowerSeries_eq] + apply Real.sqrt_le_sqrt + simp only [one_div, add_le_add_iff_left] + refine inv_le_one_iff₀.mpr ?_ + right + simp + · refine (Real.sqrt_le_left (by positivity)).mpr ?_ + trans (‖x‖ ^ 2 + 1) + (2 * ‖x‖) + · simp + · ring_nf + rfl + +@[simp] +lemma norm_lt_normPowerSeries {d} (n : ℕ) (x : Space d) : + ‖x‖ < normPowerSeries n x := by + rw [normPowerSeries_eq] + apply Real.lt_sqrt_of_sq_lt + simp only [one_div, lt_add_iff_pos_right, inv_pos] + positivity + +lemma norm_le_normPowerSeries {d} (n : ℕ) (x : Space d) : + ‖x‖ ≤ normPowerSeries n x := by + rw [normPowerSeries_eq] + apply Real.le_sqrt_of_sq_le + simp only [one_div, le_add_iff_nonneg_right, inv_nonneg] + positivity + +lemma normPowerSeries_zpow_le_norm_sq_add_one {d} (n : ℕ) (m : ℤ) (x : Space d) + (hx : x ≠ 0) : + (normPowerSeries n x) ^ m ≤ (‖x‖ + 1) ^ m + ‖x‖ ^ m := by + match m with + | .ofNat m => + trans (‖x‖ + 1) ^ m + · simp + refine pow_le_pow_left₀ (by simp) ?_ m + exact normPowerSeries_le_norm_sq_add_one n x + · simp + | .negSucc m => + trans (‖x‖ ^ (m + 1))⁻¹; swap + · simp + positivity + simp only [zpow_negSucc] + refine inv_anti₀ ?_ ?_ + · positivity + refine pow_le_pow_left₀ (by simp) ?_ (m + 1) + exact norm_le_normPowerSeries n x + +lemma normPowerSeries_inv_le {d} (n : ℕ) (x : Space d) (hx : x ≠ 0) : + (normPowerSeries n x)⁻¹ ≤ ‖x‖⁻¹ := by + refine inv_anti₀ ?_ ?_ + · positivity + apply Real.le_sqrt_of_sq_le + simp only [one_div, le_add_iff_nonneg_right, inv_nonneg] + positivity + +lemma normPowerSeries_log_le_normPowerSeries {d} (n : ℕ) (x : Space d) : + |Real.log (normPowerSeries n x)| ≤ (normPowerSeries n x)⁻¹ + (normPowerSeries n x) := by + have h1 := Real.neg_inv_le_log (x := (normPowerSeries n x)) (by simp) + have h2 := Real.log_le_rpow_div (x := (normPowerSeries n x)) (by simp) (ε := 1) (by positivity) + simp_all + rw [abs_le'] + generalize Real.log ‖x‖ = r at * + apply And.intro + · apply h2.trans + simp + · rw [neg_le] + apply le_trans _ h1 + simp +lemma normPowerSeries_log_le {d} (n : ℕ) (x : Space d) (hx : x ≠ 0) : + |Real.log (normPowerSeries n x)| ≤ ‖x‖⁻¹ + (‖x‖ + 1) := by + apply le_trans (normPowerSeries_log_le_normPowerSeries n x) ?_ + apply add_le_add + · exact normPowerSeries_inv_le n x hx + · exact normPowerSeries_le_norm_sq_add_one n x + +/-! + +### A.7. The `IsDistBounded` property of the norm power series + +-/ + +@[fun_prop] +lemma IsDistBounded.normPowerSeries_zpow {d : ℕ} {n : ℕ} (m : ℤ) : + IsDistBounded (d := d) (fun x => (normPowerSeries n x) ^ m) := by + match m with + | .ofNat m => + simp only [Int.ofNat_eq_natCast, zpow_natCast] + apply IsDistBounded.mono (f := fun (x : Space d) => (‖x‖ + 1) ^ m) + · fun_prop + · fun_prop + intro x + simp only [norm_pow, Real.norm_eq_abs] + refine pow_le_pow_left₀ (by positivity) ?_ m + rw [abs_of_nonneg (by simp),abs_of_nonneg (by positivity)] + exact normPowerSeries_le_norm_sq_add_one n x + | .negSucc m => + simp only [zpow_negSucc] + apply IsDistBounded.mono (f := fun (x : Space d) => ((√(1/(n + 1)) : ℝ) ^ (m + 1))⁻¹) + · fun_prop + · rw [normPowerSeries_eq_rpow] + refine StronglyMeasurable.aestronglyMeasurable ?_ + refine stronglyMeasurable_iff_measurable.mpr ?_ + fun_prop + · intro x + simp only [norm_inv, norm_pow, Real.norm_eq_abs, one_div] + refine inv_anti₀ (by positivity) ?_ + refine (pow_le_pow_iff_left₀ (by positivity) (by positivity) (by simp)).mpr ?_ + rw [abs_of_nonneg (by positivity), abs_of_nonneg (by simp)] + rw [normPowerSeries_eq] + simp only [Real.sqrt_inv, one_div] + rw [← Real.sqrt_inv] + apply Real.sqrt_le_sqrt + simp + +@[fun_prop] +lemma IsDistBounded.normPowerSeries_single {d : ℕ} {n : ℕ} : + IsDistBounded (d := d) (fun x => (normPowerSeries n x)) := by + convert IsDistBounded.normPowerSeries_zpow (n := n) (m := 1) using 1 + simp + +@[fun_prop] +lemma IsDistBounded.normPowerSeries_inv {d : ℕ} {n : ℕ} : + IsDistBounded (d := d) (fun x => (normPowerSeries n x)⁻¹) := by + convert normPowerSeries_zpow (n := n) (-1) using 1 + simp + +@[fun_prop] +lemma IsDistBounded.normPowerSeries_deriv {d : ℕ} (n : ℕ) (i : Fin d) : + IsDistBounded (d := d) (fun x => ∂[i] (normPowerSeries n) x) := by + conv => + enter [1, x]; + rw [deriv_normPowerSeries] + fun_prop + +@[fun_prop] +lemma IsDistBounded.normPowerSeries_fderiv {d : ℕ} (n : ℕ) (y : Space d) : + IsDistBounded (d := d) (fun x => fderiv ℝ (fun (x : Space d) => normPowerSeries n x) x y) := by + conv => + enter [1, x]; + rw [fderiv_eq_sum_deriv] + apply IsDistBounded.sum_fun + fun_prop + +@[fun_prop] +lemma IsDistBounded.normPowerSeries_log {d : ℕ} (n : ℕ) : + IsDistBounded (d := d) (fun x => Real.log (normPowerSeries n x)) := by + apply IsDistBounded.mono (f := fun x => (normPowerSeries n x)⁻¹ + (normPowerSeries n x)) + · fun_prop + · apply AEMeasurable.aestronglyMeasurable + fun_prop + · intro x + simp only [Real.norm_eq_abs] + conv_rhs => rw [abs_of_nonneg (by + apply add_nonneg + · simp + · simp)] + exact normPowerSeries_log_le_normPowerSeries n x + +/-! + +### A.8. Differentiability of functions + +-/ + +@[fun_prop] +lemma differentiable_normPowerSeries_zpow {d : ℕ} {n : ℕ} (m : ℤ) : + Differentiable ℝ (fun x : Space d => (normPowerSeries n x) ^ m) := by + refine Differentiable.zpow ?_ ?_ + · fun_prop + · left + exact normPowerSeries_ne_zero n + +@[fun_prop] +lemma differentiable_normPowerSeries_inv {d : ℕ} {n : ℕ} : + Differentiable ℝ (fun x : Space d => (normPowerSeries n x)⁻¹) := by + convert differentiable_normPowerSeries_zpow (n := n) (m := -1) using 1 + funext x + simp + +@[fun_prop] +lemma differentiable_log_normPowerSeries {d : ℕ} {n : ℕ} : + Differentiable ℝ (fun x : Space d => Real.log (normPowerSeries n x)) := by + refine Differentiable.log ?_ ?_ + · fun_prop + · intro x + exact normPowerSeries_ne_zero n x +/-! + +### A.9. Derivatives of functions + +-/ + +lemma deriv_normPowerSeries_zpow {d : ℕ} {n : ℕ} (m : ℤ) (x : Space d) (i : Fin d) : + ∂[i] (fun x : Space d => (normPowerSeries n x) ^ m) x = + m * x i * (normPowerSeries n x) ^ (m - 2) := by + rw [deriv_eq_fderiv_basis] + change (fderiv ℝ ((fun x => x ^ m) ∘ normPowerSeries n) x) (basis i) = _ + rw [fderiv_comp] + simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, fderiv_eq_smul_deriv, deriv_zpow', + smul_eq_mul] + rw [fderiv_normPowerSeries] + simp only [basis_inner] + field_simp + ring_nf + have h1 : normPowerSeries n x ^ (-1 + m) = normPowerSeries n x ^ ((-2 + m) + 1) := by + ring_nf + rw [h1, zpow_add₀] + simp only [Int.reduceNeg, zpow_one] + ring + · simp + · refine DifferentiableAt.zpow ?_ ?_ + · fun_prop + · left + exact normPowerSeries_ne_zero n x + · fun_prop + +lemma fderiv_normPowerSeries_zpow {d : ℕ} {n : ℕ} (m : ℤ) (x y : Space d) : + fderiv ℝ (fun x : Space d => (normPowerSeries n x) ^ m) x y = + m * ⟪y, x⟫_ℝ * (normPowerSeries n x) ^ (m - 2) := by + rw [fderiv_eq_sum_deriv, inner_eq_sum, Finset.mul_sum, Finset.sum_mul] + congr + funext i + simp [deriv_normPowerSeries_zpow] + ring + +lemma deriv_log_normPowerSeries {d : ℕ} {n : ℕ} (x : Space d) (i : Fin d) : + ∂[i] (fun x : Space d => Real.log (normPowerSeries n x)) x = + x i * (normPowerSeries n x) ^ (-2 : ℤ) := by + rw [deriv_eq_fderiv_basis] + change (fderiv ℝ (Real.log ∘ normPowerSeries n) x) (basis i) = _ + rw [fderiv_comp,] + simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, fderiv_eq_smul_deriv, + Real.deriv_log', smul_eq_mul, Int.reduceNeg, zpow_neg] + rw [fderiv_normPowerSeries] + simp [zpow_ofNat, sq] + ring + · apply DifferentiableAt.log ?_ ?_ + · fun_prop + exact normPowerSeries_ne_zero n x + · fun_prop + +lemma fderiv_log_normPowerSeries {d : ℕ} {n : ℕ} (x y : Space d) : + fderiv ℝ (fun x : Space d => Real.log (normPowerSeries n x)) x y = + ⟪y, x⟫_ℝ * (normPowerSeries n x) ^ (-2 : ℤ) := by + rw [fderiv_eq_sum_deriv, inner_eq_sum, Finset.sum_mul] + congr + funext i + simp [deriv_log_normPowerSeries] + ring + +/-! + +### A.10. Gradients of distributions based on powers + +-/ + +lemma gradient_dist_normPowerSeries_zpow {d : ℕ} {n : ℕ} (m : ℤ) : + distGrad (distOfFunction (fun x : Space d => (normPowerSeries n x) ^ m) (by fun_prop)) = + distOfFunction (fun x : Space d => (m * (normPowerSeries n x) ^ (m - 2)) • basis.repr x) + (by fun_prop) := by + ext1 η + apply ext_inner_right ℝ + intro y + simp [distGrad_inner_eq] + rw [Distribution.fderivD_apply, distOfFunction_apply, distOfFunction_inner] + calc _ + _ = - ∫ (x : Space d), fderiv ℝ η x (basis.repr.symm y) * normPowerSeries n x ^ m := by + rfl + _ = ∫ (x : Space d), η x * fderiv ℝ (normPowerSeries n · ^ m) x (basis.repr.symm y) := by + rw [integral_mul_fderiv_eq_neg_fderiv_mul_of_integrable] + · fun_prop + · refine IsDistBounded.integrable_space_mul ?_ η + conv => enter [1, x]; rw [fderiv_normPowerSeries_zpow] + simp [mul_assoc] + fun_prop + · fun_prop + · exact η.differentiable + · fun_prop + _ = ∫ (x : Space d), η x * + (m * ⟪(basis.repr.symm y), x⟫_ℝ * (normPowerSeries n x) ^ (m - 2)) := by + congr + funext x + rw [fderiv_normPowerSeries_zpow] + congr + funext x + simp [inner_smul_left_eq_smul] + left + rw [real_inner_comm, basis_repr_inner_eq] + ring + +/-! + +#### A.10.1. The limits of gradients of distributions based on powers + +-/ + +lemma gradient_dist_normPowerSeries_zpow_tendsTo_distGrad_norm {d : ℕ} (m : ℤ) + (hm : - (d.succ - 1 : ℕ) ≤ m) (η : 𝓢(Space d.succ, ℝ)) + (y : EuclideanSpace ℝ (Fin d.succ)) : + Filter.Tendsto (fun n => + ⟪(distGrad (distOfFunction + (fun x : Space d.succ => (normPowerSeries n x) ^ m) (by fun_prop))) η, y⟫_ℝ) + Filter.atTop + (𝓝 (⟪distGrad (distOfFunction (fun x : Space d.succ => ‖x‖ ^ m) + (IsDistBounded.pow m hm)) η, y⟫_ℝ)) := by + simp only [distGrad_inner_eq, Distribution.fderivD_apply, distOfFunction_apply] + change Filter.Tendsto (fun n => - ∫ (x : Space d.succ), + fderiv ℝ η x (basis.repr.symm y) * normPowerSeries n x ^ m) + Filter.atTop (𝓝 (- ∫ (x : Space d.succ), fderiv ℝ η x (basis.repr.symm y) * ‖x‖ ^ m)) + apply Filter.Tendsto.neg + apply MeasureTheory.tendsto_integral_of_dominated_convergence + (bound := fun x => |fderiv ℝ η x (basis.repr.symm y)| * ((‖x‖ + 1) ^ m + ‖x‖ ^ m)) + · intro n + apply IsDistBounded.aeStronglyMeasurable_fderiv_schwartzMap_smul (F := ℝ) ?_ + fun_prop + · have h1 : Integrable (fun x => + (fderiv ℝ (⇑η) x) (basis.repr.symm y) * ((‖x‖ + 1) ^ m + ‖x‖ ^ m)) volume := by + apply IsDistBounded.integrable_space_fderiv ?_ + apply IsDistBounded.add + · refine IsDistBounded.norm_add_pos_nat_zpow m 1 ?_ + simp + · exact IsDistBounded.pow m hm + rw [← integrable_norm_iff] at h1 + convert h1 using 1 + funext x + simp only [Nat.succ_eq_add_one, norm_mul, Real.norm_eq_abs, mul_eq_mul_left_iff, abs_eq_zero] + left + rw [abs_of_nonneg (by positivity)] + fun_prop + · intro n + rw [Filter.eventually_iff_exists_mem] + use {0}ᶜ + constructor + · rw [compl_mem_ae_iff, measure_singleton] + intro x hx + simp at hx + simp + apply mul_le_mul (by rfl) _ (by positivity) (by positivity) + rw [abs_of_nonneg (by simp)] + exact normPowerSeries_zpow_le_norm_sq_add_one n m x hx + · rw [Filter.eventually_iff_exists_mem] + use {0}ᶜ + constructor + · rw [compl_mem_ae_iff, measure_singleton] + intro x hx + apply Filter.Tendsto.mul + · exact tendsto_const_nhds + have h1 : Filter.Tendsto (fun x_1 => normPowerSeries x_1 x ^ (m : ℝ)) + Filter.atTop (𝓝 (‖x‖ ^ (m : ℝ))) := by + refine Filter.Tendsto.rpow ?_ ?_ ?_ + · apply normPowerSeries_tendsto x hx + · simp + · left + simpa using hx + simpa using h1 + +lemma gradient_dist_normPowerSeries_zpow_tendsTo {d : ℕ} (m : ℤ) (hm : - (d.succ - 1 : ℕ) + 1 ≤ m) + (η : 𝓢(Space d.succ, ℝ)) (y : EuclideanSpace ℝ (Fin d.succ)) : + Filter.Tendsto (fun n => + ⟪(distGrad (distOfFunction (fun x : Space d.succ => (normPowerSeries n x) ^ m) + (by fun_prop))) η, y⟫_ℝ) + Filter.atTop + (𝓝 (⟪distOfFunction (fun x : Space d.succ => (m * ‖x‖ ^ (m - 2)) • basis.repr x) (by + simp [← smul_smul] + refine IsDistBounded.const_fun_smul ?_ ↑m + apply IsDistBounded.zpow_smul_repr_self + simp_all + grind) η, y⟫_ℝ)) := by + conv => + enter [1, n]; + rw [gradient_dist_normPowerSeries_zpow] + simp [distOfFunction_inner] + have h1 (n : ℕ) (x : Space d.succ) : + η x * ⟪(↑m * normPowerSeries n x ^ (m - 2)) • basis.repr x, (y)⟫_ℝ = + η x * (m * (⟪basis.repr x, y⟫_ℝ * (normPowerSeries n x) ^ (m - 2))) := by + simp [inner_smul_left] + ring_nf + left + trivial + + conv => + enter [1, n, 2, x]; + rw [h1 n x] + apply MeasureTheory.tendsto_integral_of_dominated_convergence + (bound := fun x => |η x| * |m| * |⟪basis.repr x, y⟫_ℝ| * ((‖x‖ + 1) ^ (m - 2) + ‖x‖ ^ (m - 2))) + · intro n + apply IsDistBounded.aeStronglyMeasurable_schwartzMap_smul (F := ℝ) ?_ η + apply IsDistBounded.const_mul_fun + simp [basis_repr_inner_eq] + apply IsDistBounded.isDistBounded_mul_inner' + fun_prop + · have h1 : Integrable (fun x => + η x * (m * (⟪basis.repr x, y⟫_ℝ * ((‖x‖ + 1) ^ (m - 2) + ‖x‖ ^ (m - 2))))) volume := by + apply IsDistBounded.integrable_space_mul ?_ η + apply IsDistBounded.const_mul_fun + simp [mul_add] + apply IsDistBounded.add + · simp [basis_repr_inner_eq] + apply IsDistBounded.isDistBounded_mul_inner' + refine IsDistBounded.norm_add_pos_nat_zpow (m - 2) 1 ?_ + simp + · simp [basis_repr_inner_eq] + conv => + enter [1, x] + rw [real_inner_comm] + apply IsDistBounded.isDistBounded_mul_inner_of_smul_norm + · apply IsDistBounded.mono (f := fun x => ‖x‖ ^ (m - 1) + 1) + · apply IsDistBounded.add + · apply IsDistBounded.pow (m - 1) + simp_all + · fun_prop + · apply AEMeasurable.aestronglyMeasurable + fun_prop + · intro x + simp only [norm_mul, Real.norm_eq_abs, abs_norm, norm_zpow] + rw [abs_of_nonneg (by positivity)] + by_cases hx : x = 0 + · subst hx + simp [zero_zpow_eq] + split_ifs <;> grind + · trans ‖x‖ ^ (m - 1); swap + · simp + apply le_of_eq + trans ‖x‖ ^ (m - 2 + 1) + rw [zpow_add₀, zpow_one] + ring + simpa using hx + ring_nf + · apply AEMeasurable.aestronglyMeasurable + fun_prop + rw [← integrable_norm_iff] at h1 + convert h1 using 1 + funext x + simp [mul_assoc] + rw [abs_of_nonneg (by positivity)] + simp only [true_or] + fun_prop + · intro n + rw [Filter.eventually_iff_exists_mem] + use {0}ᶜ + constructor + · rw [compl_mem_ae_iff, measure_singleton] + intro x hx + simp at hx + simp [mul_assoc] + apply mul_le_mul (by rfl) _ (by positivity) (by positivity) + apply mul_le_mul (by rfl) _ (by positivity) (by positivity) + apply mul_le_mul (by rfl) _ (by positivity) (by positivity) + rw [abs_of_nonneg (by simp)] + exact normPowerSeries_zpow_le_norm_sq_add_one n (m - 2) x hx + · rw [Filter.eventually_iff_exists_mem] + use {0}ᶜ + constructor + · rw [compl_mem_ae_iff, measure_singleton] + intro x hx + apply Filter.Tendsto.mul + · exact tendsto_const_nhds + simp [inner_smul_left, mul_assoc] + apply Filter.Tendsto.mul + · exact tendsto_const_nhds + ring_nf + apply Filter.Tendsto.mul + · exact tendsto_const_nhds + have h1 : Filter.Tendsto (fun x_1 => normPowerSeries x_1 x ^ ((m - 2 : ℤ) : ℝ)) + Filter.atTop (𝓝 (‖x‖ ^ ((m - 2 : ℤ) : ℝ))) := by + refine Filter.Tendsto.rpow ?_ ?_ ?_ + · apply normPowerSeries_tendsto x hx + · simp + · left + simpa using hx + simp [-Int.cast_sub, Real.rpow_intCast] at h1 + convert h1 using 3 + · ring + · ring + +/-! + +### A.11. Gradients of distributions based on logs + +-/ + +lemma gradient_dist_normPowerSeries_log {d : ℕ} {n : ℕ} : + distGrad (distOfFunction (fun x : Space d => Real.log (normPowerSeries n x)) (by fun_prop)) = + distOfFunction (fun x : Space d => ((normPowerSeries n x) ^ (- 2 : ℤ)) • basis.repr x) + (by fun_prop) := by + ext1 η + apply ext_inner_right ℝ + intro y + simp [distGrad_inner_eq] + rw [Distribution.fderivD_apply, distOfFunction_apply, distOfFunction_inner] + calc _ + _ = - ∫ (x : Space d), fderiv ℝ η x (basis.repr.symm y) * Real.log (normPowerSeries n x) := by + rfl + _ = ∫ (x : Space d), η x * + fderiv ℝ (fun x => Real.log (normPowerSeries n x)) x (basis.repr.symm y) := by + rw [integral_mul_fderiv_eq_neg_fderiv_mul_of_integrable] + · fun_prop + · refine IsDistBounded.integrable_space_mul ?_ η + conv => enter [1, x]; rw [fderiv_log_normPowerSeries] + fun_prop + · fun_prop + · exact η.differentiable + · fun_prop + _ = ∫ (x : Space d), η x * (⟪basis.repr.symm y, x⟫_ℝ * (normPowerSeries n x) ^ (- 2 : ℤ)) := by + congr + funext x + rw [fderiv_log_normPowerSeries] + congr + funext x + simp [inner_smul_left_eq_smul] + left + rw [real_inner_comm] + rw [basis_repr_inner_eq] + ring + +/-! + +#### A.11.1. The limits of gradients of distributions based on logs + +-/ + +lemma gradient_dist_normPowerSeries_log_tendsTo_distGrad_norm {d : ℕ} + (η : 𝓢(Space d.succ.succ, ℝ)) (y : EuclideanSpace ℝ (Fin d.succ.succ)) : + Filter.Tendsto (fun n => + ⟪(distGrad (distOfFunction + (fun x : Space d.succ.succ => Real.log (normPowerSeries n x)) (by fun_prop))) η, y⟫_ℝ) + Filter.atTop + (𝓝 (⟪distGrad (distOfFunction (fun x : Space d.succ.succ => Real.log ‖x‖) + (IsDistBounded.log_norm)) η, y⟫_ℝ)) := by + simp only [distGrad_inner_eq, Distribution.fderivD_apply, distOfFunction_apply] + change Filter.Tendsto (fun n => - + ∫ (x : Space d.succ.succ), fderiv ℝ η x (basis.repr.symm y) * Real.log (normPowerSeries n x)) + Filter.atTop (𝓝 (- ∫ (x : Space d.succ.succ), fderiv ℝ η x (basis.repr.symm y) * Real.log ‖x‖)) + apply Filter.Tendsto.neg + apply MeasureTheory.tendsto_integral_of_dominated_convergence + (bound := fun x => |fderiv ℝ η x (basis.repr.symm y)| * (‖x‖⁻¹ + (‖x‖ + 1))) + · intro n + apply IsDistBounded.aeStronglyMeasurable_fderiv_schwartzMap_smul (F := ℝ) ?_ + fun_prop + · have h1 : Integrable (fun x => (fderiv ℝ (⇑η) x) (basis.repr.symm y) * + (‖x‖⁻¹ + (‖x‖ + 1))) volume := by + apply IsDistBounded.integrable_space_fderiv ?_ + apply IsDistBounded.add + · exact IsDistBounded.inv + · fun_prop + rw [← integrable_norm_iff] at h1 + convert h1 using 1 + funext x + simp only [Nat.succ_eq_add_one, norm_mul, Real.norm_eq_abs, mul_eq_mul_left_iff, abs_eq_zero] + left + rw [abs_of_nonneg (by positivity)] + fun_prop + · intro n + rw [Filter.eventually_iff_exists_mem] + use {0}ᶜ + constructor + · rw [compl_mem_ae_iff, measure_singleton] + intro x hx + simp at hx + simp + apply mul_le_mul (by rfl) _ (by positivity) (by positivity) + exact normPowerSeries_log_le n x hx + · rw [Filter.eventually_iff_exists_mem] + use {0}ᶜ + constructor + · rw [compl_mem_ae_iff, measure_singleton] + intro x hx + apply Filter.Tendsto.mul + · exact tendsto_const_nhds + apply Filter.Tendsto.log + · exact normPowerSeries_tendsto x hx + · simpa using hx + +lemma gradient_dist_normPowerSeries_log_tendsTo {d : ℕ} + (η : 𝓢(Space d.succ.succ, ℝ)) (y : EuclideanSpace ℝ (Fin d.succ.succ)) : + Filter.Tendsto (fun n => + ⟪(distGrad (distOfFunction (fun x : Space d.succ.succ => Real.log (normPowerSeries n x)) + (by fun_prop))) η, y⟫_ℝ) + Filter.atTop + (𝓝 (⟪distOfFunction (fun x : Space d.succ.succ => (‖x‖ ^ (- 2 : ℤ)) • basis.repr x) (by + refine (IsDistBounded.zpow_smul_repr_self _ ?_) + simp_all) η, y⟫_ℝ)) := by + conv => + enter [1, n]; + rw [gradient_dist_normPowerSeries_log] + simp only [Nat.succ_eq_add_one, Int.reduceNeg, distOfFunction_inner] + have h1 (n : ℕ) (x : Space d.succ.succ) : + η x * ⟪(normPowerSeries n x ^ (- 2 : ℤ)) • basis.repr x, y⟫_ℝ = + η x * ((⟪basis.repr x, y⟫_ℝ * (normPowerSeries n x) ^ (- 2 : ℤ))) := by + simp [inner_smul_left] + ring_nf + left + trivial + conv => + enter [1, n, 2, x]; + rw [h1 n x] + apply MeasureTheory.tendsto_integral_of_dominated_convergence + (bound := fun x => |η x| * |⟪basis.repr x, y⟫_ℝ| * ((‖x‖ + 1) ^ (- 2 : ℤ) + ‖x‖ ^ (- 2 : ℤ))) + · intro n + apply IsDistBounded.aeStronglyMeasurable_schwartzMap_smul (F := ℝ) ?_ η + simp only [Nat.succ_eq_add_one, basis_repr_inner_eq] + apply IsDistBounded.isDistBounded_mul_inner' + fun_prop + · have h1 : Integrable (fun x => + η x * ((⟪basis.repr x, y⟫_ℝ * ((‖x‖ + 1) ^ (- 2 : ℤ) + ‖x‖ ^ (- 2 : ℤ))))) volume := by + apply IsDistBounded.integrable_space_mul ?_ η + simp [mul_add] + apply IsDistBounded.add + · simp only [basis_repr_inner_eq] + apply IsDistBounded.isDistBounded_mul_inner' + refine IsDistBounded.norm_add_pos_nat_zpow (- 2) 1 ?_ + simp + · simp only [basis_repr_inner_eq] + convert IsDistBounded.mul_inner_pow_neg_two (basis.repr.symm y) using 1 + funext x + simp [real_inner_comm] + + rw [← integrable_norm_iff] at h1 + convert h1 using 1 + funext x + simp [mul_assoc] + rw [abs_of_nonneg (by positivity)] + simp only [true_or] + fun_prop + · intro n + rw [Filter.eventually_iff_exists_mem] + use {0}ᶜ + constructor + · rw [compl_mem_ae_iff, measure_singleton] + intro x hx + simp at hx + simp [mul_assoc] + apply mul_le_mul (by rfl) _ (by positivity) (by positivity) + apply mul_le_mul (by rfl) _ (by positivity) (by positivity) + rw [abs_of_nonneg (by simp)] + exact normPowerSeries_zpow_le_norm_sq_add_one n (- 2 : ℤ) x hx + · rw [Filter.eventually_iff_exists_mem] + use {0}ᶜ + constructor + · rw [compl_mem_ae_iff, measure_singleton] + intro x hx + apply Filter.Tendsto.mul + · exact tendsto_const_nhds + simp [inner_smul_left, inner_smul_left] + rw [mul_comm] + apply Filter.Tendsto.mul + · exact tendsto_const_nhds + have h1 : Filter.Tendsto (fun x_1 => normPowerSeries x_1 x ^ ((- 2 : ℤ) : ℝ)) + Filter.atTop (𝓝 (‖x‖ ^ ((- 2 : ℤ) : ℝ))) := by + refine Filter.Tendsto.rpow ?_ ?_ ?_ + · apply normPowerSeries_tendsto x hx + · simp + · left + simpa using hx + simpa using h1 + +/-! + +## B. Distributions involving norms + +-/ + +/-! + +### B.1. The gradient of distributions based on powers + +-/ + +lemma distGrad_distOfFunction_norm_zpow {d : ℕ} (m : ℤ) (hm : - (d.succ - 1 : ℕ) + 1 ≤ m) : + distGrad (distOfFunction (fun x : Space d.succ => ‖x‖ ^ m) + (IsDistBounded.pow m (by simp_all; omega))) + = distOfFunction (fun x : Space d.succ => (m * ‖x‖ ^ (m - 2)) • basis.repr x) (by + simp [← smul_smul] + refine IsDistBounded.const_fun_smul ?_ ↑m + apply IsDistBounded.zpow_smul_repr_self + simp_all + omega) := by + ext1 η + exact ext_inner_right ℝ fun y => tendsto_nhds_unique + (gradient_dist_normPowerSeries_zpow_tendsTo_distGrad_norm m (by simp_all; omega) η y) + (gradient_dist_normPowerSeries_zpow_tendsTo m hm η y) + +/-! + +### B.2. The gradient of distributions based on logs + +-/ + +lemma distGrad_distOfFunction_log_norm {d : ℕ} : + distGrad (distOfFunction (fun x : Space d.succ.succ => Real.log ‖x‖) + (IsDistBounded.log_norm)) + = distOfFunction (fun x : Space d.succ.succ => (‖x‖ ^ (- 2 : ℤ)) • basis.repr x) (by + refine (IsDistBounded.zpow_smul_repr_self _ ?_) + simp_all) := by + ext1 η + exact ext_inner_right ℝ fun y => tendsto_nhds_unique + (gradient_dist_normPowerSeries_log_tendsTo_distGrad_norm η y) + (gradient_dist_normPowerSeries_log_tendsTo η y) + +/-! + +### B.3. Divergence equal dirac delta + +We show that the divergence of `x ↦ ‖x‖ ^ (- d) • x` is equal to a multiple of the Dirac delta +at `0`. + +The proof + +-/ +open Distribution + +lemma distDiv_inv_pow_eq_dim {d : ℕ} : + distDiv (distOfFunction (fun x : Space d.succ => ‖x‖ ^ (- d.succ : ℤ) • basis.repr x) + (IsDistBounded.zpow_smul_repr_self (- d.succ : ℤ) (by omega))) = + (d.succ * (volume (α := Space d.succ)).real (Metric.ball 0 1)) • diracDelta ℝ 0 := by + ext η + calc _ + _ = - ∫ x, ⟪‖x‖⁻¹ ^ d.succ • basis.repr x, Space.grad η x⟫_ℝ := by + simp only [Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one, zpow_neg, distDiv_ofFunction, + inv_pow] + rfl + _ = - ∫ x, ‖x‖⁻¹ ^ d * ⟪‖x‖⁻¹ • basis.repr x, Space.grad η x⟫_ℝ := by + simp only [Nat.succ_eq_add_one, inv_pow, inner_smul_left, map_inv₀, conj_trivial, neg_inj] + ring_nf + _ = - ∫ x, ‖x‖⁻¹ ^ d * (_root_.deriv (fun a => η (a • ‖x‖⁻¹ • x)) ‖x‖) := by + simp only [real_inner_comm, + ← grad_inner_space_unit_vector _ _ (SchwartzMap.differentiable η)] + _ = - ∫ r, ‖r.2.1‖⁻¹ ^ d * (_root_.deriv (fun a => η (a • r.1)) ‖r.2.1‖) + ∂(volume (α := Space d.succ).toSphere.prod + (Measure.volumeIoiPow (Module.finrank ℝ (Space d.succ) - 1))) := by + rw [← MeasureTheory.MeasurePreserving.integral_comp (f := homeomorphUnitSphereProd _) + (MeasureTheory.Measure.measurePreserving_homeomorphUnitSphereProd + (volume (α := Space d.succ))) + (Homeomorph.measurableEmbedding (homeomorphUnitSphereProd (Space d.succ)))] + congr 1 + simp only [inv_pow, homeomorphUnitSphereProd_apply_snd_coe, norm_norm, + homeomorphUnitSphereProd_apply_fst_coe] + let f (x : Space d.succ) : ℝ := + (‖↑x‖ ^ d)⁻¹ * _root_.deriv (fun a => η (a • ‖↑x‖⁻¹ • ↑x)) ‖↑x‖ + conv_rhs => + enter [2, x] + change f x.1 + rw [MeasureTheory.integral_subtype_comap (by simp), ← setIntegral_univ] + change ∫ x in Set.univ, f x = ∫ (x : Space d.succ) in _, f x + refine (setIntegral_congr_set ?_) + rw [← MeasureTheory.ae_eq_set_compl] + trans (∅ : Set (Space d.succ)) + · apply Filter.EventuallyEq.of_eq + rw [← Set.compl_empty] + exact compl_compl _ + · symm + simp + _ = - ∫ n, (∫ r, ‖r.1‖⁻¹ ^ d * + (_root_.deriv (fun a => η (a • n)) ‖r.1‖) + ∂((Measure.volumeIoiPow (Module.finrank ℝ (Space d.succ) - 1)))) + ∂(volume (α := Space d.succ).toSphere) := by + rw [MeasureTheory.integral_prod] + /- Integrable condition. -/ + convert integrable_isDistBounded_inner_grad_schwartzMap_spherical + (IsDistBounded.inv_pow_smul_repr_self (d.succ) (by omega)) η + rename_i r + simp only [Nat.succ_eq_add_one, Real.norm_eq_abs, inv_pow, Function.comp_apply, + homeomorphUnitSphereProd_symm_apply_coe] + let x : Space d.succ := r.2.1 • r.1.1 + have hr := r.2.2 + simp [-Subtype.coe_prop] at hr + have hr2 : r.2.1 ≠ 0 := by exact Ne.symm (ne_of_lt hr) + rw [abs_of_nonneg (le_of_lt hr)] + trans (r.2.1 ^ d)⁻¹ * _root_.deriv (fun a => η (a • ‖↑x‖⁻¹ • ↑x)) ‖x‖ + · simp [x, norm_smul] + left + congr + funext a + congr + simp [smul_smul] + rw [abs_of_nonneg (le_of_lt hr)] + field_simp + simp only [one_smul] + rw [abs_of_nonneg (le_of_lt hr)] + rw [← grad_inner_space_unit_vector] + rw [real_inner_comm] + simp [inner_smul_left, x, norm_smul, abs_of_nonneg (le_of_lt hr)] + field_simp + ring + exact SchwartzMap.differentiable η + _ = - ∫ n, (∫ (r : Set.Ioi (0 : ℝ)), + (_root_.deriv (fun a => η (a • n)) r.1) ∂(.comap Subtype.val volume)) + ∂(volume (α := Space d.succ).toSphere) := by + congr + funext n + simp [Measure.volumeIoiPow] + erw [integral_withDensity_eq_integral_smul] + congr + funext r + have hr := r.2 + simp [-Subtype.coe_prop] at hr + trans ((r.1 ^ d).toNNReal : ℝ) • ((r.1 ^ d)⁻¹ * _root_.deriv (fun a => η (a • ↑n)) |r.1|) + · rw [NNReal.smul_def] + simp only [Real.coe_toNNReal', smul_eq_mul, Nat.succ_eq_add_one, mul_eq_mul_left_iff, + mul_eq_mul_right_iff, inv_inj, sup_eq_right] + rw [abs_of_nonneg (le_of_lt hr)] + simp + trans ((r.1 ^ d) : ℝ) • ((r.1 ^ d)⁻¹ * _root_.deriv (fun a => η (a • ↑n)) |r.1|) + · congr + rw [Real.coe_toNNReal'] + rw [max_eq_left] + apply pow_nonneg + grind + have h1 : r.1 ≠ 0 := by exact ne_of_gt r.2 + simp only [smul_eq_mul] + field_simp + congr + rw [abs_of_nonneg (le_of_lt hr)] + fun_prop + _ = - ∫ n, (-η 0) ∂(volume (α := Space d.succ).toSphere) := by + congr + funext n + let η' (n : ↑(Metric.sphere 0 1)) : 𝓢(ℝ, ℝ) := compCLM (g := fun a => a • n.1) ℝ (by + apply And.intro + · fun_prop + · intro n' + match n' with + | 0 => + use 1, 1 + simp [norm_smul] + | 1 => + use 0, 1 + intro x + simp [fderiv_smul_const, iteratedFDeriv_succ_eq_comp_right, + ContinuousLinearMap.norm_id] + | n' + 1 + 1 => + use 0, 0 + intro x + simp only [Real.norm_eq_abs, pow_zero, mul_one, norm_le_zero_iff] + rw [iteratedFDeriv_succ_eq_comp_right] + conv_lhs => + enter [2, 3, y] + simp [fderiv_smul_const] + rw [iteratedFDeriv_succ_const] + rfl) (by use 1, 1; simp [norm_smul]) η + rw [MeasureTheory.integral_subtype_comap (by simp)] + rw [MeasureTheory.integral_Ioi_of_hasDerivAt_of_tendsto (f := fun a => η (a • n)) (m := 0)] + · simp + · refine ContinuousAt.continuousWithinAt ?_ + fun_prop + · intro x hx + refine DifferentiableAt.hasDerivAt ?_ + have := η.differentiable + fun_prop + · exact (integrable ((derivCLM ℝ ℝ) (η' n))).integrableOn + · exact Filter.Tendsto.mono_left (η' n).toZeroAtInfty.zero_at_infty' atTop_le_cocompact + _ = η 0 * (d.succ * (volume (α := Space d.succ)).real (Metric.ball 0 1)) := by + simp only [Nat.succ_eq_add_one, integral_const, Measure.toSphere_real_apply_univ, + finrank_eq_dim, Nat.cast_add, Nat.cast_one, smul_eq_mul, mul_neg, neg_neg] + ring + simp only [Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one, ContinuousLinearMap.coe_smul', + Pi.smul_apply, diracDelta_apply, smul_eq_mul] + ring + +end Space diff --git a/PhysLean/Mathematics/Distribution/Function/InvPowMeasure.lean b/PhysLean/SpaceAndTime/Space/RadialAngularMeasure.lean similarity index 67% rename from PhysLean/Mathematics/Distribution/Function/InvPowMeasure.lean rename to PhysLean/SpaceAndTime/Space/RadialAngularMeasure.lean index 5bbb58c52..0000e19f0 100644 --- a/PhysLean/Mathematics/Distribution/Function/InvPowMeasure.lean +++ b/PhysLean/SpaceAndTime/Space/RadialAngularMeasure.lean @@ -4,14 +4,35 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Mathematics.Distribution.Basic -import PhysLean.Meta.Linters.Sorry -import Mathlib.MeasureTheory.Constructions.HaarToSphere +import PhysLean.SpaceAndTime.Space.Basic /-! -# The inverse pow measure on Euclidean space +# The radial angular measure on Space + +## i. Overview + +The normal measure on `Space d` is `r^(d-1) dr dΩ` in spherical coordinates, +where `dΩ` is the angular measure on the unit sphere. The radial angular measure +is the measure `dr dΩ`, cancelling the radius contribution from the measure in spherical +coordinates. + +This file is equivalent to `invPowMeasure`, which will slowly be deprecated. + +## ii. Key results + +- `radialAngularMeasure`: The radial angular measure on `Space d`. + +## iii. Table of contents + +- A. The definition of the radial angular measure + - A.1. Basic equalities +- B. Integrals with respect to radialAngularMeasure +- C. HasTemperateGrowth of measures + - C.1. Integrability of powers + - C.2. radialAngularMeasure has temperate growth + +## iv. References -The measure `‖x‖^(- d) dx` on `EuclideanSpace ℝ (Fin d.succ)`, cancelling -the radius contribution from the measure in spherical coordinates. -/ open SchwartzMap NNReal noncomputable section @@ -19,32 +40,58 @@ noncomputable section variable (𝕜 : Type) {E F F' : Type} [RCLike 𝕜] [NormedAddCommGroup E] [NormedAddCommGroup F] [NormedAddCommGroup F'] -namespace Distribution - variable [NormedSpace ℝ E] [NormedSpace ℝ F] +namespace Space + open MeasureTheory /-! -## The measures. +## A. The definition of the radial angular measure -/ -/-- The measure on `EuclideanSpace ℝ (Fin 3)` weighted by `1 / ‖x‖ ^ 2`. -/ -def invPowMeasure {dm1 : ℕ} : Measure (EuclideanSpace ℝ (Fin dm1.succ)) := - volume.withDensity (fun x : EuclideanSpace ℝ (Fin dm1.succ) => ENNReal.ofReal (1 / ‖x‖ ^ dm1)) +/-- The measure on `Space d` weighted by `1 / ‖x‖ ^ (d - 1)`. -/ +def radialAngularMeasure {d : ℕ} : Measure (Space d) := + volume.withDensity (fun x : Space d => ENNReal.ofReal (1 / ‖x‖ ^ (d - 1))) + +/-! + +### A.1. Basic equalities + +-/ + +lemma radialAngularMeasure_eq_volume_withDensity {d : ℕ} : radialAngularMeasure = + volume.withDensity (fun x : Space d => ENNReal.ofReal (1 / ‖x‖ ^ (d - 1))) := by + rfl + +@[simp] +lemma radialAngularMeasure_zero_eq_volume : + radialAngularMeasure (d := 0) = volume := by + simp [radialAngularMeasure] + +lemma integrable_radialAngularMeasure_iff {d : ℕ} {f : Space d → F} : + Integrable f (radialAngularMeasure (d := d)) ↔ + Integrable (fun x => (1 / ‖x‖ ^ (d - 1)) • f x) volume := by + dsimp [radialAngularMeasure] + erw [integrable_withDensity_iff_integrable_smul₀ (by fun_prop)] + simp only [one_div] + refine integrable_congr ?_ + filter_upwards with x + rw [Real.toNNReal_of_nonneg, NNReal.smul_def] + simp only [inv_nonneg, norm_nonneg, pow_nonneg, coe_mk] + positivity -open MeasureTheory /-! -## Integrals with respect to the measures. +## B. Integrals with respect to radialAngularMeasure -/ -lemma integral_invPowMeasure {dm1 : ℕ} (f : EuclideanSpace ℝ (Fin dm1.succ) → F) : - ∫ x, f x ∂invPowMeasure = ∫ x, (1 / ‖x‖^dm1) • f x := by - dsimp [invPowMeasure] +lemma integral_radialAngularMeasure {d : ℕ} (f : Space d → F) : + ∫ x, f x ∂radialAngularMeasure = ∫ x, (1 / ‖x‖ ^ (d - 1)) • f x := by + dsimp [radialAngularMeasure] erw [integral_withDensity_eq_integral_smul (by fun_prop)] congr funext x @@ -54,10 +101,15 @@ lemma integral_invPowMeasure {dm1 : ℕ} (f : EuclideanSpace ℝ (Fin dm1.succ) /-! -## HasTemperateGrowth of measures +## C. HasTemperateGrowth of measures -/ +/-! + +### C.1. Integrability of powers + +-/ private lemma integrable_neg_pow_on_ioi (n : ℕ) : IntegrableOn (fun x : ℝ => (|((1 : ℝ) + ↑x) ^ (- (n + 2) : ℝ)|)) (Set.Ioi 0) := by rw [MeasureTheory.integrableOn_iff_comap_subtypeVal] @@ -117,7 +169,6 @@ private lemma integrable_neg_pow_on_ioi (n : ℕ) : simp only [Nat.cast_add, Nat.cast_ofNat, neg_add_rev] positivity positivity - rw [integral_Ioi_rpow_of_lt] field_simp have h0 : (-2 + -(n : ℝ) + 1) ≠ 0 := by @@ -136,10 +187,16 @@ private lemma integrable_neg_pow_on_ioi (n : ℕ) : · simp · simp -lemma invPowMeasure_integrable_pow_neg_two {dm1 : ℕ} : - Integrable (fun x : EuclideanSpace ℝ (Fin dm1.succ) => (1 + ‖x‖) ^ (- (dm1 + 2) : ℝ)) - invPowMeasure := by - simp [invPowMeasure] +lemma radialAngularMeasure_integrable_pow_neg_two {d : ℕ} : + Integrable (fun x : Space d => (1 + ‖x‖) ^ (- (d + 1) : ℝ)) + radialAngularMeasure := by + match d with + | 0 => simp + | dm1 + 1 => + suffices h1 : Integrable (fun x => (1 + ‖x‖) ^ (-(dm1 + 2) : ℝ)) radialAngularMeasure by + convert h1 using 3 + grind + simp [radialAngularMeasure] rw [MeasureTheory.integrable_withDensity_iff] swap · fun_prop @@ -150,27 +207,27 @@ lemma invPowMeasure_integrable_pow_neg_two {dm1 : ℕ} : enter [1, i] rw [ENNReal.toReal_ofReal (by positivity)] have h1 := (MeasureTheory.Measure.measurePreserving_homeomorphUnitSphereProd - (volume (α := EuclideanSpace ℝ (Fin dm1.succ)))) - have h2 : IntegrableOn (fun x : EuclideanSpace ℝ (Fin dm1.succ) => + (volume (α := Space dm1.succ))) + have h2 : IntegrableOn (fun x : Space dm1.succ => ((1 + ‖x‖) ^ (- (dm1 + 2) : ℝ)) * (‖x‖ ^ dm1)⁻¹) {0}ᶜ := by rw [MeasureTheory.integrableOn_iff_comap_subtypeVal] swap · refine MeasurableSet.compl_iff.mpr ?_ simp - let f := (fun x : EuclideanSpace ℝ (Fin dm1.succ) => + let f := (fun x :Space dm1.succ => ((1 + ‖x‖) ^ (- (dm1 + 2) : ℝ)) * (‖x‖ ^ dm1)⁻¹) - ∘ @Subtype.val (EuclideanSpace ℝ (Fin dm1.succ)) fun x => - (@Membership.mem (EuclideanSpace ℝ (Fin dm1.succ)) - (Set (EuclideanSpace ℝ (Fin dm1.succ))) Set.instMembership {0}ᶜ x) - have hf : (f ∘ (homeomorphUnitSphereProd (EuclideanSpace ℝ (Fin dm1.succ))).symm)∘ - (homeomorphUnitSphereProd (EuclideanSpace ℝ (Fin dm1.succ))) = f := by + ∘ @Subtype.val (Space dm1.succ) fun x => + (@Membership.mem (Space dm1.succ) + (Set (Space dm1.succ)) Set.instMembership {0}ᶜ x) + have hf : (f ∘ (homeomorphUnitSphereProd (Space dm1.succ)).symm)∘ + (homeomorphUnitSphereProd (Space dm1.succ)) = f := by funext x simp change Integrable f _ rw [← hf] refine (h1.integrable_comp_emb ?_).mpr ?_ · exact Homeomorph.measurableEmbedding - (homeomorphUnitSphereProd (EuclideanSpace ℝ (Fin dm1.succ))) + (homeomorphUnitSphereProd (Space dm1.succ)) haveI sfinite : SFinite (@Measure.comap ↑(Set.Ioi 0) ℝ Subtype.instMeasurableSpace Real.measureSpace.toMeasurableSpace Subtype.val volume) := by refine { out' := ?_ } @@ -197,7 +254,7 @@ lemma invPowMeasure_integrable_pow_neg_two {dm1 : ℕ} : refine MeasurableSet.subtype_image measurableSet_Ioi hs exact hs exact MeasurableEmbedding.subtype_coe measurableSet_Ioi - have hf' : (f ∘ (homeomorphUnitSphereProd (EuclideanSpace ℝ (Fin dm1.succ))).symm) = + have hf' : (f ∘ (homeomorphUnitSphereProd (Space dm1.succ)).symm) = fun x =>((1 + x.2.val) ^ (- (dm1 + 2) : ℝ)) * (x.2.val ^ dm1)⁻¹ := by funext x simp only [Function.comp_apply, homeomorphUnitSphereProd_symm_apply_coe, f] @@ -220,7 +277,7 @@ lemma invPowMeasure_integrable_pow_neg_two {dm1 : ℕ} : · apply Filter.Eventually.of_forall intro x exact ENNReal.ofReal_lt_top - have hf'' : (fun (x : ↑(Metric.sphere (α := (EuclideanSpace ℝ (Fin dm1.succ))) 0 1) × + have hf'' : (fun (x : ↑(Metric.sphere (α := (Space dm1.succ)) 0 1) × ↑(Set.Ioi (α := ℝ) 0)) => (((1 + x.2.val) ^ (- (dm1 + 2) : ℝ)) * (x.2.val ^ dm1)⁻¹ * (ENNReal.ofReal (↑x.2.val ^ dm1)).toReal)) @@ -250,19 +307,25 @@ lemma invPowMeasure_integrable_pow_neg_two {dm1 : ℕ} : simpa using h1 exact measurableSet_Ioi rw [← MeasureTheory.integrableOn_univ] - simp at h2 + simp only [Nat.succ_eq_add_one, neg_add_rev] at h2 apply MeasureTheory.IntegrableOn.congr_set_ae h2 rw [← MeasureTheory.ae_eq_set_compl] - trans (∅ : Set (EuclideanSpace ℝ (Fin dm1.succ))) + trans (∅ : Set (Space dm1.succ)) · apply Filter.EventuallyEq.of_eq rw [← Set.compl_empty] exact compl_compl _ · symm simp -instance (dm1 : ℕ) : Measure.HasTemperateGrowth (invPowMeasure (dm1 := dm1)) where +/-! + +### C.2. radialAngularMeasure has temperate growth + +-/ + +instance (d : ℕ) : Measure.HasTemperateGrowth (radialAngularMeasure (d := d)) where exists_integrable := by - use dm1 + 2 - simpa using invPowMeasure_integrable_pow_neg_two (dm1 := dm1) + use d + 1 + simpa using radialAngularMeasure_integrable_pow_neg_two (d := d) -end Distribution +end Space diff --git a/PhysLean/SpaceAndTime/Space/Slice.lean b/PhysLean/SpaceAndTime/Space/Slice.lean new file mode 100644 index 000000000..885ac77f8 --- /dev/null +++ b/PhysLean/SpaceAndTime/Space/Slice.lean @@ -0,0 +1,232 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +import Mathlib.Analysis.Calculus.ContDiff.FiniteDimension +import PhysLean.SpaceAndTime.Space.Derivatives.Basic +/-! + +# Slices of space + +## i. Overview + +In this module we will define the equivalence between `Space d.succ` and `ℝ × Space d` which +extracts the `i`th coordinate on `Space d.succ`. + +## ii. Key results + +- `slice` : The continuous linear equivalence between `Space d.succ` and `ℝ × Space d` extracting + the `i`th coordinate. + +## iii. Table of contents + +- A. Slicing spaces + - A.1. Basic applications of the slicing map + - A.2. Slice as a measurable embedding + - A.3. The norm of the slice map + - A.4. Derivative of the slice map + - A.5. Basis in terms of slices + +## iv. References + +- https://leanprover.zulipchat.com/#narrow/channel/479953-PhysLean/topic/API.20around.20.60Space.20.28d1.20.2B.20d2.29.60.20to.20.60Space.20d1.20x.20Space.20d2.60/with/556754634 + +-/ +open SchwartzMap NNReal +noncomputable section + +variable (𝕜 : Type) {E F F' : Type} [RCLike 𝕜] [NormedAddCommGroup E] [NormedAddCommGroup F] + [NormedAddCommGroup F'] [NormedSpace ℝ E] [NormedSpace ℝ F] + +namespace Space + +open MeasureTheory Real + +/-! + +## A. Slicing spaces + +-/ + +/-- The linear equivalence between `Space d.succ` and `ℝ × Space d` + extracting the `i`th coordinate. -/ +def slice {d} (i : Fin d.succ) : Space d.succ ≃L[ℝ] ℝ × Space d where + toFun x := ⟨x i, ⟨fun j => x (Fin.succAbove i j)⟩⟩ + invFun p := ⟨fun j => Fin.insertNthEquiv (fun _ => ℝ) i (p.fst, p.snd) j⟩ + map_add' x y := by + simp only [Nat.succ_eq_add_one, Prod.mk_add_mk, Prod.mk.injEq] + apply And.intro + · simp + · ext j + simp + map_smul' c x := by + simp only [Nat.succ_eq_add_one, smul_eq_mul, RingHom.id_apply, Prod.smul_mk, + Prod.mk.injEq] + apply And.intro + · simp + · ext j + simp + left_inv p := by + simp only [Nat.succ_eq_add_one, Fin.insertNthEquiv_apply] + ext j + rcases Fin.eq_self_or_eq_succAbove i j with rfl | ⟨k, rfl⟩ + · simp + · simp only [Fin.insertNth_apply_succAbove] + right_inv p := by + match p with + | (p1, p2) => + simp + continuous_toFun := by fun_prop + continuous_invFun := by + apply Continuous.comp + · fun_prop + apply continuous_pi + intro j + rcases Fin.eq_self_or_eq_succAbove i j with rfl | ⟨k, rfl⟩ + · simp + fun_prop + · simp + fun_prop + +/-! + +### A.1. Basic applications of the slicing map + +-/ + +lemma slice_symm_apply {d : ℕ} (i : Fin d.succ) (r : ℝ) (x : Space d) : + (slice i).symm (r, x) = fun j => + Fin.insertNthEquiv (fun _ => ℝ) i (r, x) j := by rfl + +@[simp] +lemma slice_symm_apply_self {d : ℕ} (i : Fin d.succ) (r : ℝ) (x : Space d) : + (slice i).symm (r, x) i = r := by + simp [slice_symm_apply] + +@[simp] +lemma slice_symm_apply_succAbove {d : ℕ} (i : Fin d.succ) (r : ℝ) (x : Space d) (j : Fin d) : + (slice i).symm (r, x) (Fin.succAbove i j) = x j := by + simp [slice_symm_apply] + +/-! + +### A.2. Slice as a measurable embedding + +-/ + +lemma slice_symm_measurableEmbedding {d : ℕ} (i : Fin d.succ) : + MeasurableEmbedding (slice i).symm := by + change MeasurableEmbedding (fun (p : ℝ × Space d) => (Space.equivPi d.succ).symm + ((MeasurableEquiv.piFinSuccAbove (fun _ => ℝ) i).symm (p.fst, p.snd))) + apply MeasurableEmbedding.comp + · apply Measurable.measurableEmbedding + · fun_prop + · exact ContinuousLinearEquiv.injective (equivPi d.succ).symm + apply MeasurableEmbedding.comp + · exact MeasurableEquiv.measurableEmbedding (MeasurableEquiv.piFinSuccAbove (fun x => ℝ) i).symm + · apply Measurable.measurableEmbedding + · fun_prop + · intro a b h + match a, b with + | (r1, x1), (r2, x2) => + simp_all +/-! + +### A.3. The norm of the slice map + +-/ + +lemma norm_slice_symm_eq {d : ℕ} (i : Fin d.succ) (r : ℝ) (x : Space d) : + ‖(slice i).symm (r, x)‖ = √(‖r‖ ^ 2 + ‖x‖ ^ 2) := by + simp [Nat.succ_eq_add_one, norm_eq] + congr + rw [Fin.sum_univ_succAbove _ i] + simp [slice_symm_apply_succAbove] + refine Eq.symm (Real.sq_sqrt ?_) + positivity + +lemma abs_right_le_norm_slice_symm {d : ℕ} (i : Fin d.succ) (r : ℝ) (x : Space d) : + |r| ≤ ‖(slice i).symm (r, x)‖ := by + rw [norm_slice_symm_eq] + refine (le_sqrt (by positivity) (by positivity)).mpr ?_ + simp + +@[simp] +lemma norm_left_le_norm_slice_symm {d : ℕ} (i : Fin d.succ) (r : ℝ) (x : Space d) : + ‖x‖ ≤ ‖(slice i).symm (r, x)‖ := by + rw [norm_slice_symm_eq] + refine (le_sqrt (by positivity) (by positivity)).mpr ?_ + simp only [norm_eq_abs, sq_abs, le_add_iff_nonneg_left] + positivity + +/-! + +### A.4. Derivative of the slice map + +-/ + +@[simp] +lemma fderiv_slice_symm {d : ℕ} (i : Fin d.succ) (p1 : ℝ × Space d) : + fderiv ℝ (slice i).symm p1 = (slice i).symm := by + rw [ContinuousLinearEquiv.fderiv] + +lemma fderiv_slice_symm_left_apply {d : ℕ} (i : Fin d.succ) (x : Space d) (r1 r2 : ℝ) : + (fderiv ℝ (fun r => (slice i).symm (r, x))) r1 r2 = (slice i).symm (r2, 0) := by + rw [fderiv_comp', DifferentiableAt.fderiv_prodMk (by fun_prop)] + simp only [Nat.succ_eq_add_one, fderiv_slice_symm, fderiv_id', fderiv_fun_const, Pi.zero_apply, + ContinuousLinearMap.coe_comp', ContinuousLinearEquiv.coe_coe, Function.comp_apply, + ContinuousLinearMap.prod_apply, ContinuousLinearMap.coe_id', id_eq, + ContinuousLinearMap.zero_apply] + repeat' fun_prop + +@[simp] +lemma fderiv_slice_symm_right_apply {d : ℕ} (i : Fin d.succ) (r : ℝ) + (x1 x2 : Space d) : + (fderiv ℝ (fun x => (slice i).symm (r, x))) x1 x2 = (slice i).symm (0, x2) := by + rw [fderiv_comp', DifferentiableAt.fderiv_prodMk (by fun_prop)] + simp only [Nat.succ_eq_add_one, fderiv_slice_symm, fderiv_fun_const, Pi.zero_apply, fderiv_id', + ContinuousLinearMap.coe_comp', ContinuousLinearEquiv.coe_coe, Function.comp_apply, + ContinuousLinearMap.prod_apply, ContinuousLinearMap.zero_apply, ContinuousLinearMap.coe_id', + id_eq] + repeat' fun_prop + +lemma fderiv_fun_slice_symm_right_apply {d : ℕ} (i : Fin d.succ) (r : ℝ) + (x1 x2 : Space d) (f : Space d.succ → F) (hf : DifferentiableAt ℝ f ((slice i).symm (r, x1))) : + (fderiv ℝ (fun x => f ((slice i).symm (r, x)))) x1 x2 = + fderiv ℝ f ((slice i).symm (r, x1)) ((slice i).symm (0, x2)) := by + rw [fderiv_comp' _ _ (by fun_prop)] + simp only [Nat.succ_eq_add_one, ContinuousLinearMap.coe_comp', Function.comp_apply, + fderiv_slice_symm_right_apply] + fun_prop + +lemma fderiv_fun_slice_symm_left_apply {d : ℕ} (i : Fin d.succ) (r1 r2 : ℝ) + (x : Space d) (f : Space d.succ → F) (hf : DifferentiableAt ℝ f ((slice i).symm (r1, x))) : + (fderiv ℝ (fun r => f ((slice i).symm (r, x)))) r1 r2 = + fderiv ℝ f ((slice i).symm (r1, x)) ((slice i).symm (r2, 0)) := by + rw [fderiv_comp' _ _ (by fun_prop)] + simp only [Nat.succ_eq_add_one, ContinuousLinearMap.coe_comp', Function.comp_apply, + fderiv_slice_symm_left_apply] + fun_prop + +/-! + +### A.5. Basis in terms of slices + +-/ + +lemma basis_self_eq_slice {d : ℕ} (i : Fin d.succ) : + basis i = (slice i).symm (1, 0) := by + ext j + rcases Fin.eq_self_or_eq_succAbove i j with rfl | ⟨k, rfl⟩ + · simp [slice_symm_apply_self] + · simp [basis_apply] + +lemma basis_succAbove_eq_slice {d : ℕ} (i : Fin d.succ) (j : Fin d) : + basis (Fin.succAbove i j) = (slice i).symm (0, basis j) := by + ext k + rcases Fin.eq_self_or_eq_succAbove i k with rfl | ⟨l, rfl⟩ + · simp [basis_apply, slice_symm_apply_self] + · simp [basis_apply, slice_symm_apply_succAbove] + +end Space diff --git a/PhysLean/SpaceAndTime/Space/SpaceStruct.lean b/PhysLean/SpaceAndTime/Space/SpaceStruct.lean deleted file mode 100644 index 0795dab4d..000000000 --- a/PhysLean/SpaceAndTime/Space/SpaceStruct.lean +++ /dev/null @@ -1,98 +0,0 @@ -/- -Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Hou Run Feng, Joseph Tooby-Smith --/ -import Mathlib.MeasureTheory.Measure.Haar.InnerProductSpace -/-! - -# `SpaceStruct d` - -This is a work in progress reimplementation of `Space d` -that abstracts over the underlying `EuclideanSpace` - -`Space d` is planned to be deprecated in favor of `SpaceStruct d`. -Once the necessary components are migrated to be compatible with `SpaceStruct`, -it will become the default implementation of `Space` - --/ - -/-- - The type `SpaceStruct d` represents `d` dimensional Euclidean space. - The default value of `d` is `3`. Thus `SpaceStuct = Spacestruct 3`. --/ -structure SpaceStruct (d : ℕ := 3) where - /-- The underlying EuclideanSpace associated `SpaceStruct d` -/ - val : EuclideanSpace ℝ (Fin d) - -/-! - -## Basic operations on `Space`. - --/ -noncomputable instance {d : Nat} : Add (SpaceStruct d) where - add x y := ⟨x.val + y.val⟩ - -@[simp] -lemma add_val {d: ℕ} (x y : SpaceStruct d) : - x + y = ⟨x.val + y.val⟩ := rfl - -instance {d : Nat} : Neg (SpaceStruct d) where - neg x := ⟨-x.val⟩ - -@[simp] -lemma neg_val {d: ℕ} (x : SpaceStruct d) : - (-x).val = -x.val := rfl - -noncomputable instance {d: ℕ} : Sub (SpaceStruct d) - where sub x y := ⟨x.val - y.val⟩ - -instance {d : Nat} : SMul ℝ (SpaceStruct d) where - smul k x := ⟨k • x.val⟩ - -instance {d : Nat} : Zero (SpaceStruct d) := ⟨⟨0⟩⟩ - -noncomputable instance (d: ℕ) : Inner ℝ (SpaceStruct d) where - inner x y := Inner.inner ℝ x.val y.val - -noncomputable instance : VAdd (EuclideanSpace ℝ (Fin d)) (SpaceStruct d) where - vadd v s := ⟨v + s.val⟩ - -/-! - -## Instances on `Space` - --/ - -noncomputable instance {d : Nat} : AddGroup (SpaceStruct d) where - add_assoc := by simp [add_assoc] - zero_add := fun ⟨x⟩ => by - show SpaceStruct.mk (0 + x) = SpaceStruct.mk x - rw [zero_add] - add_zero := fun ⟨x⟩ => by - show SpaceStruct.mk (x + 0) = SpaceStruct.mk x - rw [add_zero] - neg_add_cancel := fun ⟨x⟩ => by - show SpaceStruct.mk (-x) + SpaceStruct.mk x = SpaceStruct.mk 0 - show SpaceStruct.mk (-x + x) = SpaceStruct.mk 0 - rw [add_comm (-x) x, add_neg_cancel] - nsmul n x := ⟨n • x.val⟩ - zsmul n x := ⟨n • x.val⟩ - -noncomputable instance {d: ℕ} : AddCommMonoid (SpaceStruct d) where - add_comm := by simp [add_comm] - -noncomputable instance {d : Nat} : AddCommGroup (SpaceStruct d) where - -/-! - -## Inner product - --/ - -lemma inner_eq_sum {d} (p q : SpaceStruct d) : - inner ℝ p q = ∑ i, p.val i * q.val i := by - simp only [inner, RCLike.inner_apply, conj_trivial] - apply Finset.sum_congr rfl - intro i hi - exact mul_comm (q.val i) (p.val i) diff --git a/PhysLean/SpaceAndTime/Space/Translations.lean b/PhysLean/SpaceAndTime/Space/Translations.lean index 5cf88aada..1a798fe4d 100644 --- a/PhysLean/SpaceAndTime/Space/Translations.lean +++ b/PhysLean/SpaceAndTime/Space/Translations.lean @@ -3,7 +3,7 @@ Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ -import PhysLean.SpaceAndTime.Space.Distributions.Basic +import PhysLean.SpaceAndTime.Space.Derivatives.Curl /-! # Translations on space @@ -24,13 +24,6 @@ variable namespace Space -noncomputable instance {d} : VAdd (EuclideanSpace ℝ (Fin d)) (Space d) where - vadd v s := v + s - -noncomputable instance {d} : AddAction (EuclideanSpace ℝ (Fin d)) (Space d) where - add_vadd v1 v2 s := by simp [add_assoc] - zero_vadd s := by simp - /-! ## Translations of distributions @@ -44,11 +37,11 @@ open SchwartzMap noncomputable def translateSchwartz {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) : 𝓢(Space d, X) →L[ℝ] 𝓢(Space d, X) := SchwartzMap.compCLM (𝕜 := ℝ) - (g := fun x => x - a) + (g := fun x => x - basis.repr.symm a) (by apply Function.HasTemperateGrowth.of_fderiv (k := 1) (C := 1 + ‖a‖) - · have hx : (fderiv ℝ (fun x => x - a)) = - fun _ => ContinuousLinearMap.id ℝ (EuclideanSpace ℝ (Fin d)) := by + · have hx : (fderiv ℝ (fun (x : Space d) => (x - basis.repr.symm a: Space d))) = + fun _ => ContinuousLinearMap.id ℝ (Space d) := by funext x simp only erw [fderiv_sub] @@ -56,14 +49,15 @@ noncomputable def translateSchwartz {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) : fun_prop fun_prop rw [hx] - exact - Function.HasTemperateGrowth.const - (ContinuousLinearMap.id ℝ (EuclideanSpace ℝ (Fin d))) + exact Function.HasTemperateGrowth.const + (ContinuousLinearMap.id ℝ (Space d)) · fun_prop · intro x simp only [pow_one] + change ‖x - basis.repr.symm a‖ ≤ _ trans ‖x‖ + ‖a‖ - · apply norm_sub_le + · apply (norm_sub_le x (basis.repr.symm a)).trans + simp simp [mul_add, add_mul] trans 1 + (‖x‖ + ‖a‖) · simp @@ -76,10 +70,10 @@ noncomputable def translateSchwartz {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) : use 1, (1 + ‖a‖) intro x simp only [pow_one] - apply (norm_le_norm_add_norm_sub' x a).trans - trans 1 + (‖a‖ + ‖x - a‖) + apply (norm_le_norm_add_norm_sub' x (basis.repr.symm a)).trans + trans 1 + (‖a‖ + ‖x - basis.repr.symm a‖) · simp - trans (1 + (‖a‖ + ‖x - a‖)) + ‖a‖ * ‖x - a‖ + trans (1 + (‖a‖ + ‖x - basis.repr.symm a‖)) + ‖a‖ * ‖x - basis.repr.symm a‖ · simp positivity ring_nf @@ -88,16 +82,16 @@ noncomputable def translateSchwartz {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) : @[simp] lemma translateSchwartz_apply {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) (η : 𝓢(Space d, X)) (x : Space d) : - translateSchwartz a η x = η (x - a) := rfl + translateSchwartz a η x = η (x - basis.repr.symm a) := rfl lemma translateSchwartz_coe_eq {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) (η : 𝓢(Space d, X)) : - (translateSchwartz a η : Space d → X) = fun x => η (x - a) := by + (translateSchwartz a η : Space d → X) = fun x => η (x - basis.repr.symm a) := by ext simp /-- The continuous linear map translating distributions. -/ -noncomputable def translateD {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) : +noncomputable def distTranslate {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) : ((Space d) →d[ℝ] X) →ₗ[ℝ] ((Space d) →d[ℝ] X) where toFun T := T.comp (translateSchwartz (-a)) map_add' T1 T2 := by @@ -106,71 +100,68 @@ noncomputable def translateD {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) : map_smul' c T := by simp -lemma translateD_apply {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) +lemma distTranslate_apply {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) (T : (Space d) →d[ℝ] X) (η : 𝓢(Space d, ℝ)) : - translateD a T η = T (translateSchwartz (-a) η) := rfl + distTranslate a T η = T (translateSchwartz (-a) η) := rfl open InnerProductSpace @[simp] -lemma translateD_gradD {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) +lemma distTranslate_distGrad {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) (T : (Space d) →d[ℝ] ℝ) : - gradD (translateD a T) = translateD a (gradD T) := by - apply gradD_eq_of_inner + distGrad (distTranslate a T) = distTranslate a (distGrad T) := by + apply distGrad_eq_of_inner intro η y - rw [translateD_apply, gradD_inner_eq] - rw [fderivD_apply, fderivD_apply, translateD_apply] + rw [distTranslate_apply, distGrad_inner_eq] + rw [fderivD_apply, fderivD_apply, distTranslate_apply] congr 2 ext x - simp only [translateSchwartz_apply, sub_neg_eq_add] - change fderiv ℝ η (x + a) y = fderiv ℝ _ x y + simp only [translateSchwartz_apply, map_neg, sub_neg_eq_add, + LinearIsometryEquiv.symm_apply_apply] + change fderiv ℝ η (x + basis.repr.symm a) y = fderiv ℝ _ x y rw [translateSchwartz_coe_eq] - simp only [sub_neg_eq_add] + simp only [map_neg, sub_neg_eq_add] rw [fderiv_comp_add_right] open MeasureTheory -lemma translateD_ofFunction {d : ℕ} (a : EuclideanSpace ℝ (Fin d.succ)) - (f : Space d.succ → X) (hf : IsDistBounded f) - (hae: AEStronglyMeasurable f volume) : - translateD a (ofFunction f hf hae) = - ofFunction (fun x => f (x - a)) (IsDistBounded.comp_add_right hf fun i => -a i) - (by - change AEStronglyMeasurable (f ∘ fun x => x - a) volume - rw [MeasureTheory.MeasurePreserving.aestronglyMeasurable_comp_iff (μb := volume)] - · fun_prop - · exact measurePreserving_sub_right volume a - · exact measurableEmbedding_subRight a) := by +lemma distTranslate_ofFunction {d : ℕ} (a : EuclideanSpace ℝ (Fin d.succ)) + (f : Space d.succ → X) (hf : IsDistBounded f) : + distTranslate a (distOfFunction f hf) = + distOfFunction (fun x => f (x - basis.repr.symm a)) + (IsDistBounded.comp_add_right hf (- basis.repr.symm a)) := by ext η - rw [translateD_apply, ofFunction_apply, ofFunction_apply] - trans ∫ (x : EuclideanSpace ℝ (Fin d.succ)), η ((x - a) + a) • f (x - a); swap + rw [distTranslate_apply, distOfFunction_apply, distOfFunction_apply] + trans ∫ (x : Space d.succ), η ((x - basis.repr.symm a) + basis.repr.symm a) • + f (x - basis.repr.symm a); swap · simp - let f' := fun x : EuclideanSpace ℝ (Fin d.succ) => η (x + a) • f (x) - change _ = ∫ (x : EuclideanSpace ℝ (Fin d.succ)), f' (x - a) + let f' := fun x : Space d.succ => η (x + basis.repr.symm a) • f (x) + change _ = ∫ (x : Space d.succ), f' (x - basis.repr.symm a) rw [MeasureTheory.integral_sub_right_eq_self] congr funext x simp [f'] @[simp] -lemma divD_translateD {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) +lemma distDiv_distTranslate {d : ℕ} (a : EuclideanSpace ℝ (Fin d)) (T : (Space d) →d[ℝ] EuclideanSpace ℝ (Fin d)) : - divD (translateD a T) = translateD a (divD T) := by + distDiv (distTranslate a T) = distTranslate a (distDiv T) := by ext η - rw [divD_apply_eq_sum_fderivD] - rw [translateD_apply, divD_apply_eq_sum_fderivD] + rw [distDiv_apply_eq_sum_fderivD] + rw [distTranslate_apply, distDiv_apply_eq_sum_fderivD] congr funext i - rw [fderivD_apply, fderivD_apply, translateD_apply] + rw [fderivD_apply, fderivD_apply, distTranslate_apply] simp only [PiLp.neg_apply, neg_inj] - have h1 : ((translateSchwartz (-a)) ((SchwartzMap.evalCLM (𝕜 := ℝ) (basis i)) ((fderivCLM ℝ) η))) - = ((SchwartzMap.evalCLM (𝕜 := ℝ) (basis i)) - ((fderivCLM ℝ) ((translateSchwartz (-a)) η))) := by + have h1 : ((translateSchwartz (-a)) ((SchwartzMap.evalCLM ℝ (Space d) ℝ (basis i)) + ((fderivCLM ℝ (Space d) ℝ) η))) = + ((SchwartzMap.evalCLM ℝ (Space d) ℝ (basis i)) + ((fderivCLM ℝ (Space d) ℝ) ((translateSchwartz (-a)) η))) := by ext x rw [translateSchwartz_apply] - simp only [sub_neg_eq_add] - change fderiv ℝ η (x + a) (basis i) = fderiv ℝ _ x (basis i) + simp only [map_neg, sub_neg_eq_add] + change fderiv ℝ η (x + basis.repr.symm a) (basis i) = fderiv ℝ _ x (basis i) rw [translateSchwartz_coe_eq] - simp only [sub_neg_eq_add] + simp only [map_neg, sub_neg_eq_add] rw [fderiv_comp_add_right] rw [h1] diff --git a/PhysLean/SpaceAndTime/Space/VectorIdentities.lean b/PhysLean/SpaceAndTime/Space/VectorIdentities.lean deleted file mode 100644 index 41b62e89b..000000000 --- a/PhysLean/SpaceAndTime/Space/VectorIdentities.lean +++ /dev/null @@ -1,911 +0,0 @@ -/- -Copyright (c) 2025 Zhi Kai Pong. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Zhi Kai Pong, Joseph Tooby-Smith, Lode Vermeulen --/ -import PhysLean.SpaceAndTime.Space.Basic -import PhysLean.SpaceAndTime.SpaceTime.Basic -import Mathlib.Analysis.InnerProductSpace.Calculus -import Mathlib.Analysis.Calculus.FDeriv.Symmetric -import Mathlib.Analysis.SpecialFunctions.Pow.Deriv -import Mathlib.Analysis.Calculus.Gradient.Basic -/-! - -# Vector identities - -## i. Overview - -In this module we prove properties of the gradient, divergence, and curl operators. -We show that on differentiable functions they are linear, -show their action on basic functions, and prove vector calculus identities - -## ii. Key results - -- `grad_inner_space_unit_vector` : The gradient in the direction of the space position. -- `curl_of_curl` : `∇ × (∇ × f) = ∇ (∇ ⬝ f) - Δ f` -- `div_of_curl_eq_zero` : `∇ ⬝ (∇ × f) = 0` - -## iii. Table of contents - -- A. Basic lemmas about derivatives of space - - A.1. Derivative distributes over addition - - A.2. Derivative distributes over scalar multiplication - - A.3. Two spatial derivatives commute - - A.4. Derivative of a component - - A.5. Derivative of a component squared - - A.6. Derivivatives of components - - A.7. Derivative of a norm squared - - A.7.1. Differentiability of the norm squared function - - A.7.2. Derivative of the norm squared function - - A.8. Derivative of the inner product - - A.8.1. Differentiability of the inner product function - - A.8.2. Derivative of the inner product function - - A.9. Differentiability of derivatives -- B. Properties of the gradient operator - - B.1. Gradient of the zero function - - B.2. Gradient distributes over addition - - B.3. Gradient of a constant function - - B.4. Gradient distributes over scalar multiplication - - B.5. Gradient distributes over negation - - B.6. Expansion in terms of basis vectors - - B.7. Components of the gradient - - B.8. Inner product with a gradient - - B.9. Gradient is equal to `gradient` from Mathlib - - B.10. Value of gradient in the direction of the position vector - - B.11. Gradient of the norm squared function - - B.12. Gradient of the inner product function -- C. Properties of the curl operator - - C.1. The curl on the zero function - - C.2. The curl on a constant function - - C.3. The curl distributes over addition - - C.4. The curl distributes over scalar multiplication - - C.5. The curl of a linear map is a linear map - - C.6. Preliminary lemmas about second derivatives - - C.7. The div of a curl is zero - - C.8. The curl of a curl -- D. Properties of the divergence operator - - D.1. The divergence on the zero function - - D.2. The divergence on a constant function - - D.3. The divergence distributes over addition - - D.4. The divergence distributes over scalar multiplication - - D.5. The divergence of a linear map is a linear map -- E. Properties of the Laplacian operator - -## iv. References - --/ - -namespace Space - -/-! - -## A. Basic lemmas about derivatives of space - --/ - -/-! - -### A.1. Derivative distributes over addition - --/ - -/-- Derivatives on space distribute over addition. -/ -lemma deriv_add [NormedAddCommGroup M] [NormedSpace ℝ M] - (f1 f2 : Space d → M) (hf1 : Differentiable ℝ f1) (hf2 : Differentiable ℝ f2) : - ∂[u] (f1 + f2) = ∂[u] f1 + ∂[u] f2 := by - unfold deriv - simp only - ext x - rw [fderiv_add] - rfl - repeat fun_prop - -/-- Derivatives on space distribute coordinate-wise over addition. -/ -lemma deriv_coord_add (f1 f2 : Space d → EuclideanSpace ℝ (Fin d)) - (hf1 : Differentiable ℝ f1) (hf2 : Differentiable ℝ f2) : - (∂[u] (fun x => f1 x i + f2 x i)) = - (∂[u] (fun x => f1 x i)) + (∂[u] (fun x => f2 x i)) := by - unfold deriv - simp only - ext x - rw [fderiv_fun_add] - simp only [ContinuousLinearMap.add_apply, Pi.add_apply] - repeat fun_prop - -/-! - -### A.2. Derivative distributes over scalar multiplication - --/ - -/-- Scalar multiplication on space derivatives. -/ -lemma deriv_smul [NormedAddCommGroup M] [NormedSpace ℝ M] - (f : Space d → M) (k : ℝ) (hf : Differentiable ℝ f) : - ∂[u] (k • f) = (k • ∂[u] f) := by - unfold deriv - ext x - rw [fderiv_const_smul] - rfl - fun_prop - -/-- Coordinate-wise scalar multiplication on space derivatives. -/ -lemma deriv_coord_smul (f : Space d → EuclideanSpace ℝ (Fin d)) (k : ℝ) - (hf : Differentiable ℝ f) : - ∂[u] (fun x => k * f x i) x= (k • ∂[u] (fun x => f x i)) x:= by - unfold deriv - rw [fderiv_const_mul] - simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] - fun_prop - -/-! - -### A.3. Two spatial derivatives commute - --/ - -/-- Derivatives on space commute with one another. -/ -lemma deriv_commute [NormedAddCommGroup M] [NormedSpace ℝ M] - (f : Space d → M) (hf : ContDiff ℝ 2 f) : ∂[u] (∂[v] f) = ∂[v] (∂[u] f) := by - unfold deriv - ext x - rw [fderiv_clm_apply, fderiv_clm_apply] - simp only [fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.comp_zero, zero_add, - ContinuousLinearMap.flip_apply] - rw [IsSymmSndFDerivAt.eq] - apply ContDiffAt.isSymmSndFDerivAt - exact ContDiff.contDiffAt hf - simp only [minSmoothness_of_isRCLikeNormedField, le_refl] - repeat fun_prop - -/-! - -### A.4. Derivative of a component - --/ - -@[simp] -lemma deriv_component_same (μ : Fin d) (x : Space d) : - ∂[μ] (fun x => x μ) x = 1 := by - conv_lhs => - enter [2, x] - rw [← Space.coord_apply μ x] - change deriv μ (Space.coordCLM μ) x = 1 - simp only [deriv_eq, ContinuousLinearMap.fderiv] - simp [Space.coordCLM, Space.coord] - -lemma deriv_component_diff (μ ν : Fin d) (x : Space d) (h : μ ≠ ν) : - (deriv μ (fun x => x ν) x) = 0 := by - conv_lhs => - enter [2, x] - rw [← Space.coord_apply _ x] - change deriv μ (Space.coordCLM ν) x = 0 - simp only [deriv_eq, ContinuousLinearMap.fderiv] - simpa [Space.coordCLM, Space.coord] using h.symm - -lemma deriv_component (μ ν : Fin d) (x : Space d) : - (deriv ν (fun x => x μ) x) = if ν = μ then 1 else 0 := by - by_cases h' : ν = μ - · subst h' - simp - · rw [deriv_component_diff ν μ] - simp only [right_eq_ite_iff, zero_ne_one, imp_false] - simpa using h' - simpa using h' - -/-! - -### A.5. Derivative of a component squared - --/ - -lemma deriv_component_sq {d : ℕ} {ν μ : Fin d} (x : Space d) : - (deriv ν (fun x => (x μ) ^ 2) x) = if ν = μ then 2 * x μ else 0:= by - rw [deriv_eq_fderiv_basis] - rw [fderiv_pow] - simp only [Nat.add_one_sub_one, pow_one, nsmul_eq_mul, Nat.cast_ofNat, - ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] - rw [← deriv_eq_fderiv_basis, deriv_component] - simp only [mul_ite, mul_one, mul_zero] - fun_prop - -/-! - -### A.6. Derivivatives of components - --/ - -lemma deriv_euclid {d ν μ} {f : Space d → EuclideanSpace ℝ (Fin n)} - (hf : Differentiable ℝ f) (x : Space d) : - deriv ν (fun x => f x μ) x = deriv ν (fun x => f x) x μ := by - rw [deriv_eq_fderiv_basis] - change fderiv ℝ (EuclideanSpace.proj μ ∘ fun x => f x) x (basis ν) = _ - rw [fderiv_comp] - · simp - rw [← deriv_eq_fderiv_basis] - · fun_prop - · fun_prop - -lemma deriv_lorentz_vector {d ν μ} {f : Space d → Lorentz.Vector d} - (hf : Differentiable ℝ f) (x : Space d) : - deriv ν (fun x => f x μ) x = deriv ν (fun x => f x) x μ := by - rw [deriv_eq_fderiv_basis] - change fderiv ℝ (Lorentz.Vector.coordCLM μ ∘ fun x => f x) x (basis ν) = _ - rw [fderiv_comp] - · simp - rw [← deriv_eq_fderiv_basis] - rfl - · fun_prop - · fun_prop - -/-! - -### A.7. Derivative of a norm squared - --/ - -/-! - -#### A.7.1. Differentiability of the norm squared function - --/ -@[fun_prop] -lemma norm_sq_differentiable : Differentiable ℝ (fun x : Space d => ‖x‖ ^ 2) := by - simp [@PiLp.norm_sq_eq_of_L2] - fun_prop - -/-! - -#### A.7.2. Derivative of the norm squared function - --/ - -lemma deriv_norm_sq (x : Space d) (i : Fin d) : - deriv i (fun x => ‖x‖ ^ 2) x = 2 * x i := by - simp [@PiLp.norm_sq_eq_of_L2] - rw [deriv_eq_fderiv_basis] - rw [fderiv_fun_sum] - simp only [ContinuousLinearMap.coe_sum', Finset.sum_apply] - conv_lhs => - enter [2, j] - rw [← deriv_eq_fderiv_basis] - simp - simp [deriv_component_sq] - intro i hi - fun_prop - -/-! - -### A.8. Derivative of the inner product - --/ - -open InnerProductSpace - -/-! - -#### A.8.1. Differentiability of the inner product function - --/ - -/-- The inner product is differentiable. -/ -lemma inner_differentiable {d : ℕ} : - Differentiable ℝ (fun y : Space d => ⟪y, y⟫_ℝ) := by - simp only [PiLp.inner_apply, RCLike.inner_apply, conj_trivial] - fun_prop - -/-! - -#### A.8.2. Derivative of the inner product function - --/ - -lemma deriv_eq_inner_self (x : Space d) (i : Fin d) : - deriv i (fun x => ⟪x, x⟫_ℝ) x = 2 * x i := by - convert deriv_norm_sq x i - exact real_inner_self_eq_norm_sq _ - -/-! - -### A.9. Differentiability of derivatives - --/ - -lemma deriv_differentiable {M} [NormedAddCommGroup M] - [NormedSpace ℝ M] {d : ℕ} {f : Space d → M} - (hf : ContDiff ℝ 2 f) (i : Fin d) : - Differentiable ℝ (deriv i f) := by - have h1 : Differentiable ℝ (fun x => fderiv ℝ f x (basis i)) := by - fun_prop - convert h1 using 1 - funext x - rw [deriv_eq_fderiv_basis] - -/-! - -## B. Properties of the gradient operator - --/ - -/-! - -### B.1. Gradient of the zero function - --/ - -@[simp] -lemma grad_zero : ∇ (0 : Space d → ℝ) = 0 := by - unfold grad Space.deriv - simp only [fderiv_zero, Pi.zero_apply, ContinuousLinearMap.zero_apply] - rfl - -/-! - -### B.2. Gradient distributes over addition - --/ - -lemma grad_add (f1 f2 : Space d → ℝ) - (hf1 : Differentiable ℝ f1) (hf2 : Differentiable ℝ f2) : - ∇ (f1 + f2) = ∇ f1 + ∇ f2 := by - unfold grad - ext x i - simp only [Pi.add_apply] - rw [deriv_add] - rfl - exact hf1 - exact hf2 - -/-! - -### B.3. Gradient of a constant function - --/ - -@[simp] -lemma grad_const : ∇ (fun _ : Space d => c) = 0 := by - unfold grad Space.deriv - simp only [fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.zero_apply] - rfl - -/-! - -### B.4. Gradient distributes over scalar multiplication - --/ - -lemma grad_smul (f : Space d → ℝ) (k : ℝ) - (hf : Differentiable ℝ f) : - ∇ (k • f) = k • ∇ f := by - unfold grad - ext x i - simp only [Pi.smul_apply, smul_eq_mul] - rw [deriv_smul] - rfl - exact hf - -/-! - -### B.5. Gradient distributes over negation - --/ - -lemma grad_neg (f : Space d → ℝ) : - ∇ (- f) = - ∇ f := by - unfold grad - ext x i - simp only [Pi.neg_apply] - rw [Space.deriv_eq, fderiv_neg] - rfl - -/-! - -### B.6. Expansion in terms of basis vectors - --/ - -lemma grad_eq_sum {d} (f : Space d → ℝ) (x : Space d) : - ∇ f x = ∑ i, deriv i f x • basis i := by - funext i - rw [grad, deriv_eq] - simp only - rw [Fintype.sum_apply] - simp only [PiLp.smul_apply, smul_eq_mul] - rw [Finset.sum_eq_single i] - · simp [basis] - rfl - · intro j hj - simp [basis] - exact fun a a_1 => False.elim (a (id (Eq.symm a_1))) - · simp - -/-! - -### B.7. Components of the gradient - --/ - -lemma grad_apply {d} (f : Space d → ℝ) (x : Space d) (i : Fin d) : - (∇ f x) i = deriv i f x := by - rw [grad_eq_sum] - simp [basis_apply] - -/-! - -### B.8. Inner product with a gradient - --/ - -open InnerProductSpace - -lemma grad_inner_eq {d} (f : Space d → ℝ) (x : Space d) (y : Space d) : - ⟪∇ f x, y⟫_ℝ = (fderiv ℝ f x) y:= by - rw [grad_eq_sum] - have hy : y = ∑ i, y i • basis i := by - conv_lhs => rw [← OrthonormalBasis.sum_repr basis y] - dsimp [basis] - rw [hy] - simp only [PiLp.inner_apply, RCLike.inner_apply, conj_trivial, map_sum, map_smul, smul_eq_mul] - conv_lhs => - enter [2, x] - rw [Fintype.sum_apply, Fintype.sum_apply] - simp [basis_apply] - congr - funext x - rw [deriv_eq_fderiv_basis] - -lemma inner_grad_eq {d} (f : Space d → ℝ) (x : Space d) (y : Space d) : - ⟪x, ∇ f y⟫_ℝ = (fderiv ℝ f y) x := by - rw [← grad_inner_eq] - exact real_inner_comm (∇ f y) x - -/-! - -### B.9. Gradient is equal to `gradient` from Mathlib - --/ - -lemma grad_eq_gradiant {d} (f : Space d → ℝ) : - ∇ f = gradient f := by - funext x - have hx (y : Space d) : ⟪gradient f x, y⟫_ℝ = - ⟪∇ f x, y⟫_ℝ := by - rw [gradient, toDual_symm_apply] - exact Eq.symm (grad_inner_eq f x y) - have h1 : ∀ y, ⟪gradient f x - ∇ f x, y⟫_ℝ = 0 := by - intro y - rw [inner_sub_left, hx y] - simp - have h2 := h1 (gradient f x - ∇ f x) - rw [inner_self_eq_zero, sub_eq_zero] at h2 - rw [h2] - -/-! - -### B.10. Value of gradient in the direction of the position vector - --/ - -/-- The gradient in the direction of the space position. -/ -lemma grad_inner_space_unit_vector {d} (x : Space d) (f : Space d → ℝ) (hd : Differentiable ℝ f) : - ⟪∇ f x, ‖x‖⁻¹ • x⟫_ℝ = _root_.deriv (fun r => f (r • ‖x‖⁻¹ • x)) ‖x‖ := by - by_cases hx : x = 0 - · subst hx - simp - symm - calc _ - _ = fderiv ℝ (f ∘ (fun r => r • ‖x‖⁻¹ • x)) ‖x‖ 1 := by rfl - _ = (fderiv ℝ f (‖x‖ • ‖x‖⁻¹ • x)) (_root_.deriv (fun r => r • ‖x‖⁻¹ • x) ‖x‖) := by - rw [fderiv_comp _ (by fun_prop) (by fun_prop)] - simp - _ = (fderiv ℝ f x) (_root_.deriv (fun r => r • ‖x‖⁻¹ • x) ‖x‖) := by - have hx : ‖x‖ ≠ 0 := norm_ne_zero_iff.mpr hx - rw [smul_smul] - field_simp - simp - rw [grad_inner_eq f x (‖x‖⁻¹ • x)] - congr - rw [deriv_smul_const (by fun_prop)] - simp - -lemma grad_inner_space {d} (x : Space d) (f : Space d → ℝ) (hd : Differentiable ℝ f) : - ⟪∇ f x, x⟫_ℝ = ‖x‖ * _root_.deriv (fun r => f (r • ‖x‖⁻¹ • x)) ‖x‖ := by - rw [← grad_inner_space_unit_vector _ _ hd, inner_smul_right] - by_cases hx : x = 0 - · subst hx - simp - have hx : ‖x‖ ≠ 0 := norm_ne_zero_iff.mpr hx - field_simp - -/-! - -### B.11. Gradient of the norm squared function - --/ - -lemma grad_norm_sq (x : Space d) : - ∇ (fun x => ‖x‖ ^ 2) x = (2 : ℝ) • x := by - funext i - rw [grad_eq_sum] - simp [deriv_norm_sq, basis_apply] - -/-! - -### B.12. Gradient of the inner product function - --/ - -/-- The gradient of the inner product is given by `2 • x`. -/ -lemma grad_inner {d : ℕ} : - ∇ (fun y : Space d => ⟪y, y⟫_ℝ) = fun z => (2:ℝ) • z := by - ext z i - simp [Space.grad] - rw [deriv] - erw [fderiv_fun_sum] - · simp - rw [Finset.sum_eq_single i] - · trans (fderiv ℝ (fun y => y i ^ 2) z) (EuclideanSpace.single i 1) - · congr - funext y - ring - trans deriv i ((fun x => x^ 2) ∘ fun y => y i) z - · rfl - rw [deriv, fderiv_comp] - · simp - rw [← deriv_eq] - simp - · fun_prop - · fun_prop - · intro b _ hb - trans (fderiv ℝ (fun y => y b ^ 2) z) (EuclideanSpace.single i 1) - · congr - funext y - ring - trans deriv i ((fun x => x^ 2) ∘ fun y => y b) z - · rfl - rw [deriv, fderiv_comp] - simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, fderiv_eq_smul_deriv, - smul_eq_mul, mul_eq_zero] - · left - rw [← deriv_eq] - rw [deriv_component_diff] - omega - · fun_prop - · fun_prop - · simp - · intro i _ - refine DifferentiableAt.inner ℝ ?_ ?_ - · fun_prop - · fun_prop - -lemma grad_inner_left {d : ℕ} (x : Space d) : - ∇ (fun y : Space d => ⟪y, x⟫_ℝ) = fun _ => x := by - ext z i - simp [Space.grad] - rw [deriv] - erw [fderiv_fun_sum] - · simp - rw [Finset.sum_eq_single i] - rw [fderiv_const_mul] - simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] - trans x i * fderiv ℝ (Space.coordCLM i) z (EuclideanSpace.single i 1) - · congr - funext x - simp [Space.coordCLM, Space.coord_apply] - simp only [ContinuousLinearMap.fderiv] - simp [Space.coordCLM, Space.coord_apply] - · fun_prop - · intro b hb _ - rw [fderiv_const_mul] - simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul, mul_eq_zero] - right - trans fderiv ℝ (Space.coordCLM b) z (EuclideanSpace.single i 1) - · congr - funext x - simp [Space.coordCLM, Space.coord_apply] - simp only [ContinuousLinearMap.fderiv] - simp [Space.coordCLM, Space.coord_apply] - (expose_names; exact h) - fun_prop - · simp - · intro i _ - apply DifferentiableAt.inner ℝ ?_ ?_ - fun_prop - fun_prop - -lemma grad_inner_right {d : ℕ} (x : Space d) : - ∇ (fun y : Space d => ⟪x, y⟫_ℝ) = fun _ => x := by - rw [← grad_inner_left x] - congr - funext y - exact real_inner_comm y x - -/-! - -## C. Properties of the curl operator - --/ - -/-! - -### C.1. The curl on the zero function - --/ - -@[simp] -lemma curl_zero : ∇ × (0 : Space → EuclideanSpace ℝ (Fin 3)) = 0 := by - unfold curl Space.deriv - simp only [Fin.isValue, Pi.ofNat_apply, fderiv_fun_const, ContinuousLinearMap.zero_apply, - sub_self] - ext x i - fin_cases i <;> - rfl - -/-! - -### C.2. The curl on a constant function - --/ - -@[simp] -lemma curl_const : ∇ × (fun _ : Space => v₃) = 0 := by - unfold curl Space.deriv - simp only [Fin.isValue, fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.zero_apply, - sub_self] - ext x i - fin_cases i <;> - rfl - -/-! - -### C.3. The curl distributes over addition - --/ - -lemma curl_add (f1 f2 : Space → EuclideanSpace ℝ (Fin 3)) - (hf1 : Differentiable ℝ f1) (hf2 : Differentiable ℝ f2) : - ∇ × (f1 + f2) = ∇ × f1 + ∇ × f2 := by - unfold curl coord basis - ext x i - fin_cases i <;> - · simp only [Fin.isValue, Pi.add_apply, EuclideanSpace.basisFun_apply, PiLp.inner_apply, - PiLp.add_apply, EuclideanSpace.single_apply, RCLike.inner_apply, conj_trivial, ite_mul, one_mul, - zero_mul, Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte, Fin.zero_eta] - repeat rw [deriv_coord_add] - simp only [Fin.isValue, Pi.add_apply] - ring - repeat assumption - -/-! - -### C.4. The curl distributes over scalar multiplication - --/ - -lemma curl_smul (f : Space → EuclideanSpace ℝ (Fin 3)) (k : ℝ) - (hf : Differentiable ℝ f) : - ∇ × (k • f) = k • ∇ × f := by - unfold curl coord basis - ext x i - fin_cases i <;> - · simp only [Fin.isValue, Pi.smul_apply, EuclideanSpace.basisFun_apply, PiLp.inner_apply, - PiLp.smul_apply, smul_eq_mul, EuclideanSpace.single_apply, RCLike.inner_apply, conj_trivial, - ite_mul, one_mul, zero_mul, Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte, Fin.zero_eta] - rw [deriv_coord_smul, deriv_coord_smul, mul_sub] - simp only [Fin.isValue, Pi.smul_apply, smul_eq_mul] - repeat fun_prop - -/-! - -### C.5. The curl of a linear map is a linear map - --/ - -variable {W} [NormedAddCommGroup W] [NormedSpace ℝ W] - -lemma curl_linear_map (f : W → Space 3 → EuclideanSpace ℝ (Fin 3)) - (hf : ∀ w, Differentiable ℝ (f w)) - (hf' : IsLinearMap ℝ f) : - IsLinearMap ℝ (fun w => ∇ × (f w)) := by - constructor - · intro w w' - rw [hf'.map_add] - rw [curl_add] - repeat fun_prop - · intros k w - rw [hf'.map_smul] - rw [curl_smul] - fun_prop - -/-! - -### C.6. Preliminary lemmas about second derivatives - --/ - -/-- Second derivatives distribute coordinate-wise over addition (all three components for div). -/ -lemma deriv_coord_2nd_add (f : Space → EuclideanSpace ℝ (Fin 3)) (hf : ContDiff ℝ 2 f) : - ∂[i] (fun x => ∂[u] (fun x => f x u) x + (∂[v] (fun x => f x v) x + ∂[w] (fun x => f x w) x)) = - (∂[i] (∂[u] (fun x => f x u))) + (∂[i] (∂[v] (fun x => f x v))) + - (∂[i] (∂[w] (fun x => f x w))) := by - unfold deriv - ext x - rw [fderiv_fun_add, fderiv_fun_add] - simp only [ContinuousLinearMap.add_apply, Pi.add_apply] - ring - repeat fun_prop - -/-- Second derivatives distribute coordinate-wise over subtraction (two components for curl). -/ -lemma deriv_coord_2nd_sub (f : Space → EuclideanSpace ℝ (Fin 3)) (hf : ContDiff ℝ 2 f) : - ∂[u] (fun x => ∂[v] (fun x => f x w) x - ∂[w] (fun x => f x v) x) = - (∂[u] (∂[v] (fun x => f x w))) - (∂[u] (∂[w] (fun x => f x v))) := by - unfold deriv - ext x - simp only [Pi.sub_apply] - rw [fderiv_fun_sub] - simp only [ContinuousLinearMap.coe_sub', Pi.sub_apply] - repeat fun_prop - -/-! - -### C.7. The div of a curl is zero - --/ - -lemma div_of_curl_eq_zero (f : Space → EuclideanSpace ℝ (Fin 3)) (hf : ContDiff ℝ 2 f) : - ∇ ⬝ (∇ × f) = 0 := by - unfold div curl Finset.sum coord basis - ext x - simp only [Fin.isValue, EuclideanSpace.basisFun_apply, PiLp.inner_apply, - EuclideanSpace.single_apply, RCLike.inner_apply, conj_trivial, ite_mul, one_mul, zero_mul, - Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte, Fin.univ_val_map, List.ofFn_succ, - Fin.succ_zero_eq_one, Fin.succ_one_eq_two, List.ofFn_zero, Multiset.sum_coe, List.sum_cons, - List.sum_nil, add_zero, Pi.zero_apply] - rw [deriv_coord_2nd_sub, deriv_coord_2nd_sub, deriv_coord_2nd_sub] - simp only [Fin.isValue, Pi.sub_apply] - rw [deriv_commute fun x => f x 0, deriv_commute fun x => f x 1, - deriv_commute fun x => f x 2] - simp only [Fin.isValue, sub_add_sub_cancel', sub_self] - repeat - try apply contDiff_euclidean.mp - exact hf - -/-! - -### C.8. The curl of a curl - --/ - -lemma curl_of_curl (f : Space → EuclideanSpace ℝ (Fin 3)) (hf : ContDiff ℝ 2 f) : - ∇ × (∇ × f) = ∇ (∇ ⬝ f) - Δ f := by - unfold laplacianVec laplacian div grad curl Finset.sum coord basis - simp only [Fin.isValue, EuclideanSpace.basisFun_apply, PiLp.inner_apply, - EuclideanSpace.single_apply, RCLike.inner_apply, conj_trivial, ite_mul, one_mul, zero_mul, - Finset.sum_ite_eq', Finset.mem_univ, ↓reduceIte, Fin.univ_val_map, List.ofFn_succ, - Fin.succ_zero_eq_one, Fin.succ_one_eq_two, List.ofFn_zero, Multiset.sum_coe, List.sum_cons, - List.sum_nil, add_zero] - ext x i - fin_cases i <;> - · simp only [Fin.isValue, Fin.reduceFinMk, Pi.sub_apply] - rw [deriv_coord_2nd_sub, deriv_coord_2nd_sub, deriv_coord_2nd_add] - rw [deriv_commute fun x => f x 0, deriv_commute fun x => f x 1, - deriv_commute fun x => f x 2] - simp only [Fin.isValue, Pi.sub_apply, Pi.add_apply] - ring - repeat - try apply contDiff_euclidean.mp - exact hf - -/-! - -## D. Properties of the divergence operator - --/ - -/-! - -### D.1. The divergence on the zero function - --/ - -@[simp] -lemma div_zero : ∇ ⬝ (0 : Space d → EuclideanSpace ℝ (Fin d)) = 0 := by - unfold div Space.deriv Finset.sum - simp only [Pi.ofNat_apply, fderiv_fun_const, ContinuousLinearMap.zero_apply, Multiset.map_const', - Finset.card_val, Finset.card_univ, Fintype.card_fin, Multiset.sum_replicate, smul_zero] - rfl - -/-! - -### D.2. The divergence on a constant function - --/ - -@[simp] -lemma div_const : ∇ ⬝ (fun _ : Space d => v) = 0 := by - unfold div Space.deriv Finset.sum - simp only [fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.zero_apply, Multiset.map_const', - Finset.card_val, Finset.card_univ, Fintype.card_fin, Multiset.sum_replicate, smul_zero] - rfl - -/-! - -### D.3. The divergence distributes over addition - --/ - -lemma div_add (f1 f2 : Space d → EuclideanSpace ℝ (Fin d)) - (hf1 : Differentiable ℝ f1) (hf2 : Differentiable ℝ f2) : - ∇ ⬝ (f1 + f2) = ∇ ⬝ f1 + ∇ ⬝ f2 := by - unfold div - simp only [Pi.add_apply] - funext x - simp only [Pi.add_apply] - rw [← Finset.sum_add_distrib] - congr - funext i - simp [coord_apply, Space.deriv] - rw [fderiv_fun_add] - simp only [ContinuousLinearMap.add_apply] - · fun_prop - · fun_prop - -/-! - -### D.4. The divergence distributes over scalar multiplication - --/ - -lemma div_smul (f : Space d → EuclideanSpace ℝ (Fin d)) (k : ℝ) - (hf : Differentiable ℝ f) : - ∇ ⬝ (k • f) = k • ∇ ⬝ f := by - unfold div - simp only [Pi.smul_apply] - funext x - simp only [Pi.smul_apply, smul_eq_mul] - rw [Finset.mul_sum] - congr - funext i - simp [coord_apply] - simp [Space.deriv] - rw [fderiv_const_mul] - simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply, smul_eq_mul] - · fun_prop - -/-! - -### D.5. The divergence of a linear map is a linear map - --/ - -lemma div_linear_map (f : W → Space 3 → EuclideanSpace ℝ (Fin 3)) - (hf : ∀ w, Differentiable ℝ (f w)) - (hf' : IsLinearMap ℝ f) : - IsLinearMap ℝ (fun w => ∇ ⬝ (f w)) := by - constructor - · intro w w' - rw [hf'.map_add] - rw [div_add] - repeat fun_prop - · intros k w - rw [hf'.map_smul] - rw [div_smul] - fun_prop - -/-! - -## E. Properties of the Laplacian operator - --/ - -lemma laplacian_eq_div_of_grad (f : Space → ℝ) : - Δ f = ∇ ⬝ ∇ f := by - unfold laplacian div grad Finset.sum coord basis - simp only [Fin.univ_val_map, List.ofFn_succ, Fin.isValue, Fin.succ_zero_eq_one, - Fin.succ_one_eq_two, List.ofFn_zero, Multiset.sum_coe, List.sum_cons, List.sum_nil, add_zero, - EuclideanSpace.basisFun_apply, PiLp.inner_apply, EuclideanSpace.single_apply, - RCLike.inner_apply, conj_trivial, ite_mul, one_mul, zero_mul, Finset.sum_ite_eq', - Finset.mem_univ, ↓reduceIte] - -open InnerProductSpace - -end Space diff --git a/PhysLean/SpaceAndTime/SpaceTime/Basic.lean b/PhysLean/SpaceAndTime/SpaceTime/Basic.lean index 9e48048e6..1ff5048b1 100644 --- a/PhysLean/SpaceAndTime/SpaceTime/Basic.lean +++ b/PhysLean/SpaceAndTime/SpaceTime/Basic.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Relativity.Tensors.RealTensor.Vector.MinkowskiProduct -import PhysLean.SpaceAndTime.Space.Basic +import PhysLean.Relativity.SpeedOfLight import PhysLean.SpaceAndTime.Time.Basic /-! # Spacetime @@ -23,16 +23,18 @@ allowing it to be used in tensorial expressions. - `SpaceTime d` : The type corresponding to `d+1` dimensional spacetime. - `toTimeAndSpace` : A continuous linear equivalence between `SpaceTime d` and `Time × Space d`. -- `deriv` : The derivative of a function `SpaceTime d → M` along the `μ` coordinate. -- `deriv_sum_inr` : The derivative along a spatial coordinate in terms of the - derivative on `Space d`. -- `deriv_sum_inl` : The derivative along the temporal coordinate in terms of the - derivative on `Time`. -- `innerProductSpace` : The Euclidean inner product structure on `SpaceTime d`. ## iii. Table of contents - A. The definition of `SpaceTime d` +- C. Continuous linear map to coordinates +- D. Measures on `SpaceTime d` + - D.1. Instance of a measurable space + - D.2. Instance of a borel space + - D.4. Instance of a measure space + - D.5. Volume measure is positive on non-empty open sets + - D.6. Volume measure is a finite measure on compact sets + - D.7. Volume measure is an additive Haar measure - B. Maps to and from `Space` and `Time` - B.1. Linear map to `Space d` - B.1.1. Explicit expansion of map to space @@ -44,21 +46,15 @@ allowing it to be used in tensorial expressions. - B.3.2. Derivative of the inverse of `toTimeAndSpace` - B.3.3. `toTimeAndSpace` acting on spatial basis vectors - B.3.4. `toTimeAndSpace` acting on the temporal basis vectors -- C. Continuous linear map to coordinates -- D. Derivatives of functions on `SpaceTime d` - - D.1. The definition of the derivative - - D.2. Basic equality lemmas - - D.3. Derivative of the zero function - - D.4. The derivative of a function composed with a Lorentz transformation - - D.5. Spacetime derivatives in terms of time and space derivatives -- E. Measures on `SpaceTime d` - - E.1. Instance of a measurable space - - E.2. Instance of a borel space - - E.3. Definition of an inner product space structure on `SpaceTime d` - - E.4. Instance of a measure space - - E.5. Volume measure is positive on non-empty open sets - - E.6. Volume measure is a finite measure on compact sets - - E.7. Volume measure is an additive Haar measure + - B.4. Time space basis + - B.4.1. Elements of the basis + - B.4.2. Equivalence adjusting time basis vector + - B.4.3. Determinant of the equivalence + - B.4.4. Time space basis expressed in terms of the Lorentz basis + - B.4.5. The additive Haar measure associated to the time space basis + - B.5. Integrals over `SpaceTime d` + - B.5.1. Measure preserving property of `toTimeAndSpace.symm` + - B.5.2. Integrals over `SpaceTime d` expressed as integrals over `Time` and `Space d` ## iv. References @@ -89,6 +85,100 @@ open TensorSpecies /-! +## C. Continuous linear map to coordinates + +-/ + +/-- For a given `μ : Fin (1 + d)` `coord μ p` is the coordinate of + `p` in the direction `μ`. + + This is denoted `𝔁 μ p`, where `𝔁` is typed with `\MCx`. -/ +def coord {d : ℕ} (μ : Fin (1 + d)) : SpaceTime d →ₗ[ℝ] ℝ where + toFun x := x (finSumFinEquiv.symm μ) + map_add' x1 x2 := by + simp + map_smul' c x := by + simp + +@[inherit_doc coord] +scoped notation "𝔁" => coord + +lemma coord_apply {d : ℕ} (μ : Fin (1 + d)) (y : SpaceTime d) : + 𝔁 μ y = y (finSumFinEquiv.symm μ) := by + rfl + +/-- The continuous linear map from a point in space time to one of its coordinates. -/ +def coordCLM (μ : Fin 1 ⊕ Fin d) : SpaceTime d →L[ℝ] ℝ where + toFun x := x μ + map_add' x1 x2 := by + simp + map_smul' c x := by + simp + cont := by + fun_prop + +/-! + +## D. Measures on `SpaceTime d` + +-/ +open MeasureTheory + +/-! + +### D.1. Instance of a measurable space + +-/ + +instance {d : ℕ} : MeasurableSpace (SpaceTime d) := borel (SpaceTime d) + +/-! + +### D.2. Instance of a borel space + +-/ + +instance {d : ℕ} : BorelSpace (SpaceTime d) where + measurable_eq := by rfl + +/-! + +### D.4. Instance of a measure space + +-/ + +instance {d : ℕ} : MeasureSpace (SpaceTime d) where + volume := Lorentz.Vector.basis.addHaar + +/-! + +### D.5. Volume measure is positive on non-empty open sets + +-/ + +instance {d : ℕ} : (volume (α := SpaceTime d)).IsOpenPosMeasure := + inferInstanceAs ((Lorentz.Vector.basis.addHaar).IsOpenPosMeasure) + +/-! + +### D.6. Volume measure is a finite measure on compact sets + +-/ + +instance {d : ℕ} : IsFiniteMeasureOnCompacts (volume (α := SpaceTime d)) := + inferInstanceAs (IsFiniteMeasureOnCompacts (Lorentz.Vector.basis.addHaar)) + +/-! + +### D.7. Volume measure is an additive Haar measure + +-/ + +instance {d : ℕ} : Measure.IsAddHaarMeasure (volume (α := SpaceTime d)) := + inferInstanceAs (Measure.IsAddHaarMeasure (Lorentz.Vector.basis.addHaar)) + +/-! + ## B. Maps to and from `Space` and `Time` -/ @@ -101,13 +191,13 @@ open TensorSpecies /-- The space part of spacetime. -/ def space {d : ℕ} : SpaceTime d →L[ℝ] Space d where - toFun x := Lorentz.Vector.spatialPart x + toFun x := ⟨Lorentz.Vector.spatialPart x⟩ map_add' x1 x2 := by ext i - simp [Lorentz.Vector.spatialPart] + simp map_smul' c x := by ext i - simp [Lorentz.Vector.spatialPart] + simp cont := by fun_prop @@ -120,7 +210,7 @@ def space {d : ℕ} : SpaceTime d →L[ℝ] Space d where lemma space_toCoord_symm {d : ℕ} (f : Fin 1 ⊕ Fin d → ℝ) : space f = fun i => f (Sum.inr i) := by funext i - simp [space, Lorentz.Vector.spatialPart] + simp [space] /-! @@ -143,14 +233,16 @@ informal_lemma space_equivariant where -/ /-- The time part of spacetime. -/ -def time {d : ℕ} : SpaceTime d →ₗ[ℝ] Time where - toFun x := ⟨Lorentz.Vector.timeComponent x⟩ +def time {d : ℕ} (c : SpeedOfLight := 1) : SpaceTime d →ₗ[ℝ] Time where + toFun x := ⟨Lorentz.Vector.timeComponent x / c⟩ map_add' x1 x2 := by ext simp [Lorentz.Vector.timeComponent] + grind map_smul' c x := by ext simp [Lorentz.Vector.timeComponent] + grind /-! @@ -159,8 +251,8 @@ def time {d : ℕ} : SpaceTime d →ₗ[ℝ] Time where -/ @[simp] -lemma time_val_toCoord_symm {d : ℕ} (f : Fin 1 ⊕ Fin d → ℝ) : - (time f).val = f (Sum.inl 0) := by +lemma time_val_toCoord_symm {d : ℕ} (c : SpeedOfLight) (f : Fin 1 ⊕ Fin d → ℝ) : + (time c f).val = f (Sum.inl 0) / c := by simp [time, Lorentz.Vector.timeComponent] /-! @@ -171,56 +263,63 @@ lemma time_val_toCoord_symm {d : ℕ} (f : Fin 1 ⊕ Fin d → ℝ) : /-- A continuous linear equivalence between `SpaceTime d` and `Time × Space d`. -/ -def toTimeAndSpace {d : ℕ} : SpaceTime d ≃L[ℝ] Time × Space d := +def toTimeAndSpace {d : ℕ} (c : SpeedOfLight := 1) : SpaceTime d ≃L[ℝ] Time × Space d := LinearEquiv.toContinuousLinearEquiv { - toFun x := (x.time, x.space) + toFun x := (x.time c, x.space) invFun tx := (fun i => match i with - | Sum.inl _ => tx.1.val + | Sum.inl _ => c * tx.1.val | Sum.inr i => tx.2 i) left_inv x := by simp only [time, LinearMap.coe_mk, AddHom.coe_mk, space] funext i match i with - | Sum.inl 0 => simp [Lorentz.Vector.timeComponent] - | Sum.inr i => simp [Lorentz.Vector.spatialPart] + | Sum.inl 0 => + simp [Lorentz.Vector.timeComponent] + field_simp + | Sum.inr i => simp right_inv tx := by simp only [time, Lorentz.Vector.timeComponent, Fin.isValue, LinearMap.coe_mk, AddHom.coe_mk, - space, ContinuousLinearMap.coe_mk'] + ne_eq, SpeedOfLight.val_ne_zero, not_false_eq_true, mul_div_cancel_left₀, space, + ContinuousLinearMap.coe_mk'] map_add' x y := by - simp only [space_toCoord_symm, Lorentz.Vector.apply_add, Prod.mk_add_mk, Prod.mk.injEq] + simp only [Prod.mk_add_mk, Prod.mk.injEq] constructor · ext simp - funext i + ext i simp map_smul' := by simp } -lemma toTimeAndSpace_symm_apply_time_space {d : ℕ} (x : SpaceTime d) : - toTimeAndSpace.symm (x.time, x.space) = x := by - apply toTimeAndSpace.left_inv +@[simp] +lemma toTimeAndSpace_symm_apply_time_space {d : ℕ} {c : SpeedOfLight} (x : SpaceTime d) : + (toTimeAndSpace c).symm (x.time c, x.space) = x := by + apply (toTimeAndSpace c).left_inv @[simp] -lemma space_toTimeAndSpace_symm {d : ℕ} (t : Time) (s : Space d) : - (toTimeAndSpace.symm (t, s)).space = s := by +lemma space_toTimeAndSpace_symm {d : ℕ} {c : SpeedOfLight} (t : Time) (s : Space d) : + ((toTimeAndSpace c).symm (t, s)).space = s := by simp only [space, toTimeAndSpace] - funext i + ext i simp @[simp] -lemma toTimeAndSpace_symm_apply_time_space' {d : ℕ} (x : SpaceTime d) : - toTimeAndSpace.symm (x.time, x.space) = x := by - apply toTimeAndSpace.left_inv - -@[simp] -lemma time_toTimeAndSpace_symm {d : ℕ} (t : Time) (s : Space d) : - (toTimeAndSpace.symm (t, s)).time = t := by +lemma time_toTimeAndSpace_symm {d : ℕ} {c : SpeedOfLight} (t : Time) (s : Space d) : + ((toTimeAndSpace c).symm (t, s)).time c = t := by simp only [time, toTimeAndSpace] ext simp +@[simp] +lemma toTimeAndSpace_symm_apply_inl {d : ℕ} {c : SpeedOfLight} (t : Time) (s : Space d) : + (toTimeAndSpace c).symm (t, s) (Sum.inl 0) = c * t := by rfl + +@[simp] +lemma toTimeAndSpace_symm_apply_inr {d : ℕ} {c : SpeedOfLight} (t : Time) (x : Space d) + (i : Fin d) : + (toTimeAndSpace c).symm (t, x) (Sum.inr i) = x i := by rfl /-! #### B.3.1. Derivative of `toTimeAndSpace` @@ -228,8 +327,8 @@ lemma time_toTimeAndSpace_symm {d : ℕ} (t : Time) (s : Space d) : -/ @[simp] -lemma toTimeAndSpace_fderiv {d : ℕ} (x : SpaceTime d) : - fderiv ℝ toTimeAndSpace x = toTimeAndSpace.toContinuousLinearMap := by +lemma toTimeAndSpace_fderiv {d : ℕ} {c : SpeedOfLight} (x : SpaceTime d) : + fderiv ℝ (toTimeAndSpace c) x = (toTimeAndSpace c).toContinuousLinearMap := by rw [ContinuousLinearEquiv.fderiv] /-! @@ -239,8 +338,8 @@ lemma toTimeAndSpace_fderiv {d : ℕ} (x : SpaceTime d) : -/ @[simp] -lemma toTimeAndSpace_symm_fderiv {d : ℕ} (x : Time × Space d) : - fderiv ℝ toTimeAndSpace.symm x = toTimeAndSpace.symm.toContinuousLinearMap := by +lemma toTimeAndSpace_symm_fderiv {d : ℕ} {c : SpeedOfLight} (x : Time × Space d) : + fderiv ℝ (toTimeAndSpace c).symm x = (toTimeAndSpace c).symm.toContinuousLinearMap := by rw [ContinuousLinearEquiv.fderiv] /-! @@ -248,15 +347,15 @@ lemma toTimeAndSpace_symm_fderiv {d : ℕ} (x : Time × Space d) : #### B.3.3. `toTimeAndSpace` acting on spatial basis vectors -/ -lemma toTimeAndSpace_basis_inr {d : ℕ} (i : Fin d) : - toTimeAndSpace (Lorentz.Vector.basis (Sum.inr i)) +lemma toTimeAndSpace_basis_inr {d : ℕ} {c : SpeedOfLight} (i : Fin d) : + toTimeAndSpace c (Lorentz.Vector.basis (Sum.inr i)) = (0, Space.basis i) := by simp only [toTimeAndSpace, time, LinearMap.coe_mk, AddHom.coe_mk, LinearEquiv.coe_toContinuousLinearEquiv', LinearEquiv.coe_mk, Prod.mk.injEq] rw [Lorentz.Vector.timeComponent_basis_sum_inr] constructor · simp - funext j + ext j simp [Space.basis_apply, space] /-! @@ -265,262 +364,289 @@ lemma toTimeAndSpace_basis_inr {d : ℕ} (i : Fin d) : -/ -lemma toTimeAndSpace_basis_inl {d : ℕ} : - toTimeAndSpace (d := d) (Lorentz.Vector.basis (Sum.inl 0)) = (1, 0) := by +lemma toTimeAndSpace_basis_inl {d : ℕ} {c : SpeedOfLight} : + toTimeAndSpace (d := d) c (Lorentz.Vector.basis (Sum.inl 0)) = (⟨1/c.val⟩, 0) := by simp only [toTimeAndSpace, time, LinearMap.coe_mk, AddHom.coe_mk, LinearEquiv.coe_toContinuousLinearEquiv', LinearEquiv.coe_mk, Prod.mk.injEq] rw [Lorentz.Vector.timeComponent_basis_sum_inl] constructor · simp - funext j + ext j simp [space] -/-! - -## C. Continuous linear map to coordinates - --/ - -/-- For a given `μ : Fin (1 + d)` `coord μ p` is the coordinate of - `p` in the direction `μ`. - - This is denoted `𝔁 μ p`, where `𝔁` is typed with `\MCx`. -/ -def coord {d : ℕ} (μ : Fin (1 + d)) : SpaceTime d →ₗ[ℝ] ℝ where - toFun x := x (finSumFinEquiv.symm μ) - map_add' x1 x2 := by - simp - map_smul' c x := by - simp - -@[inherit_doc coord] -scoped notation "𝔁" => coord - -lemma coord_apply {d : ℕ} (μ : Fin (1 + d)) (y : SpaceTime d) : - 𝔁 μ y = y (finSumFinEquiv.symm μ) := by - rfl - -/-- The continuous linear map from a point in space time to one of its coordinates. -/ -def coordCLM (μ : Fin 1 ⊕ Fin d) : SpaceTime d →L[ℝ] ℝ where - toFun x := x μ - map_add' x1 x2 := by - simp - map_smul' c x := by - simp - cont := by - fun_prop -/-! - -## D. Derivatives of functions on `SpaceTime d` - --/ - -/-! - -### D.1. The definition of the derivative - --/ - -/-- The derivative of a function `SpaceTime d → ℝ` along the `μ` coordinate. -/ -noncomputable def deriv {M : Type} [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] - {d : ℕ} (μ : Fin 1 ⊕ Fin d) (f : SpaceTime d → M) : SpaceTime d → M := - fun y => fderiv ℝ f y (Lorentz.Vector.basis μ) - -@[inherit_doc deriv] -scoped notation "∂_" => deriv +lemma toTimeAndSpace_basis_inl' {d : ℕ} {c : SpeedOfLight} : + toTimeAndSpace (d := d) c (Lorentz.Vector.basis (Sum.inl 0)) = (1/c.val) • (1, 0) := by + rw [toTimeAndSpace_basis_inl] + simp only [one_div, Prod.smul_mk, smul_zero, Prod.mk.injEq, and_true] + congr + simp /-! -### D.2. Basic equality lemmas +### B.4. Time space basis -/ -variable {M : Type} [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] -lemma deriv_eq {d : ℕ} (μ : Fin 1 ⊕ Fin d) (f : SpaceTime d → M) (y : SpaceTime d) : - ∂_ μ f y = - fderiv ℝ f y (Lorentz.Vector.basis μ) := by - rfl - -lemma deriv_apply_eq {d : ℕ} (μ ν : Fin 1 ⊕ Fin d) (f : SpaceTime d → Lorentz.Vector d) - (hf : Differentiable ℝ f) - (y : SpaceTime d) : - ∂_ μ f y ν = fderiv ℝ (fun x => f x ν) y (Lorentz.Vector.basis μ) := by - rw [deriv_eq] - rw [fderiv_pi] - rfl - fun_prop - -@[simp] -lemma deriv_coord {d : ℕ} (μ ν : Fin 1 ⊕ Fin d) : - ∂_ μ (fun x => x ν) = if μ = ν then 1 else 0 := by - change ∂_ μ (coordCLM ν) = _ - funext x - rw [deriv_eq] - simp only [ContinuousLinearMap.fderiv] - simp [coordCLM] - split_ifs - rfl - rfl +/-- The basis of `SpaceTime` where the first component is `(c, 0, 0, ...)` instead +of `(1, 0, 0, ....).`-/ +def timeSpaceBasis {d : ℕ} (c : SpeedOfLight := 1) : + Module.Basis (Fin 1 ⊕ Fin d) ℝ (SpaceTime d) where + repr := (toTimeAndSpace (d := d) c).toLinearEquiv.trans <| + (Time.basis.toBasis.prod (Space.basis (d := d)).toBasis).repr /-! -### D.3. Derivative of the zero function +#### B.4.1. Elements of the basis -/ @[simp] -lemma deriv_zero {d : ℕ} (μ : Fin 1 ⊕ Fin d) : SpaceTime.deriv μ (fun _ => (0 : ℝ)) = 0 := by - ext y - rw [SpaceTime.deriv_eq] +lemma timeSpaceBasis_apply_inl {d : ℕ} (c : SpeedOfLight) : + timeSpaceBasis (d := d) c (Sum.inl 0) = c.val • Lorentz.Vector.basis (Sum.inl 0) := by + simp [timeSpaceBasis] + apply (toTimeAndSpace (d := d) c).injective + simp only [ContinuousLinearEquiv.apply_symm_apply, Fin.isValue, map_smul] + rw [@toTimeAndSpace_basis_inl] + simp only [one_div, Prod.smul_mk, smul_zero, Prod.mk.injEq, and_true] + ext simp -attribute [-simp] Fintype.sum_sum_type - -/-! - -### D.4. The derivative of a function composed with a Lorentz transformation - --/ - -lemma deriv_comp_lorentz_action {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] {d : ℕ} - (μ : Fin 1 ⊕ Fin d) - (f : SpaceTime d → M) (hf : Differentiable ℝ f) (Λ : LorentzGroup d) - (x : SpaceTime d) : - ∂_ μ (fun x => f (Λ • x)) x = ∑ ν, Λ.1 ν μ • ∂_ ν f (Λ • x) := by - change fderiv ℝ (f ∘ Lorentz.Vector.actionCLM Λ) x (Lorentz.Vector.basis μ) = _ - rw [fderiv_comp] - simp only [Lorentz.Vector.actionCLM_apply, Nat.succ_eq_add_one, Nat.reduceAdd, - ContinuousLinearMap.fderiv, ContinuousLinearMap.coe_comp', Function.comp_apply] - -- Fintype.sum_sum_type - rw [Lorentz.Vector.smul_basis] - simp - rfl - · fun_prop - · fun_prop +@[simp] +lemma timeSpaceBasis_apply_inr {d : ℕ} (c : SpeedOfLight) (i : Fin d) : + timeSpaceBasis (d := d) c (Sum.inr i) = Lorentz.Vector.basis (Sum.inr i) := by + simp [timeSpaceBasis] + apply (toTimeAndSpace (d := d) c).injective + simp only [ContinuousLinearEquiv.apply_symm_apply] + rw [toTimeAndSpace_basis_inr] /-! -### D.5. Spacetime derivatives in terms of time and space derivatives +#### B.4.2. Equivalence adjusting time basis vector -/ -lemma deriv_sum_inr {d : ℕ} {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] - (f : SpaceTime d → M) - (hf : Differentiable ℝ f) (x : SpaceTime d) (i : Fin d) : - ∂_ (Sum.inr i) f x - = Space.deriv i (fun y => f (toTimeAndSpace.symm ((toTimeAndSpace x).1, y))) - (toTimeAndSpace x).2 := by - rw [deriv_eq, Space.deriv_eq] - conv_rhs => rw [fderiv_comp' _ (by fun_prop) (by fun_prop)] - simp only [Prod.mk.eta, ContinuousLinearEquiv.symm_apply_apply, ContinuousLinearMap.coe_comp', - Function.comp_apply] - congr 1 - rw [fderiv_comp'] - simp only [Prod.mk.eta, toTimeAndSpace_symm_fderiv, ContinuousLinearMap.coe_comp', - ContinuousLinearEquiv.coe_coe, Function.comp_apply] - change _ = toTimeAndSpace.symm ((fderiv ℝ ((toTimeAndSpace x).1, ·) (toTimeAndSpace x).2) - (EuclideanSpace.single i 1)) - rw [DifferentiableAt.fderiv_prodMk] - simp only [fderiv_fun_const, Pi.zero_apply, fderiv_id', ContinuousLinearMap.prod_apply, - ContinuousLinearMap.zero_apply, ContinuousLinearMap.coe_id', id_eq] - trans toTimeAndSpace.symm (0, Space.basis i) - · rw [← toTimeAndSpace_basis_inr] - simp - · congr - rw [Space.basis] - simp - repeat' fun_prop - -lemma deriv_sum_inl {d : ℕ} {M : Type} [NormedAddCommGroup M] - [NormedSpace ℝ M] (f : SpaceTime d → M) - (hf : Differentiable ℝ f) (x : SpaceTime d) : - ∂_ (Sum.inl 0) f x - = Time.deriv (fun t => f (toTimeAndSpace.symm (t, (toTimeAndSpace x).2))) - (toTimeAndSpace x).1 := by - rw [deriv_eq, Time.deriv_eq] - conv_rhs => rw [fderiv_comp' _ (by fun_prop) (by fun_prop)] - simp only [Fin.isValue, Prod.mk.eta, ContinuousLinearEquiv.symm_apply_apply, - ContinuousLinearMap.coe_comp', Function.comp_apply] - congr 1 - rw [fderiv_comp'] - simp only [Fin.isValue, Prod.mk.eta, toTimeAndSpace_symm_fderiv, ContinuousLinearMap.coe_comp', - ContinuousLinearEquiv.coe_coe, Function.comp_apply] - rw [DifferentiableAt.fderiv_prodMk] - simp only [Fin.isValue, fderiv_id', fderiv_fun_const, Pi.zero_apply, - ContinuousLinearMap.prod_apply, ContinuousLinearMap.coe_id', id_eq, - ContinuousLinearMap.zero_apply] - rw [← toTimeAndSpace_basis_inl] - simp only [Fin.isValue, ContinuousLinearEquiv.symm_apply_apply] - repeat' fun_prop - -/-! - -## E. Measures on `SpaceTime d` - --/ -open MeasureTheory +/-- The equivalence on of `SpaceTime` taking `(1, 0, 0, ...)` to +of `(c, 0, 0, ....)` and keeping all other components the same. -/ +def timeSpaceBasisEquiv {d : ℕ} (c : SpeedOfLight) : + SpaceTime d ≃L[ℝ] SpaceTime d where + toFun x := fun μ => + match μ with + | Sum.inl 0 => c.val * x (Sum.inl 0) + | Sum.inr i => x (Sum.inr i) + invFun x := fun μ => + match μ with + | Sum.inl 0 => (1 / c.val) * x (Sum.inl 0) + | Sum.inr i => x (Sum.inr i) + left_inv x := by + funext μ + match μ with + | Sum.inl 0 => + field_simp + | Sum.inr i => + rfl + right_inv x := by + funext μ + match μ with + | Sum.inl 0 => + field_simp + | Sum.inr i => + rfl + map_add' x y := by + funext μ + match μ with + | Sum.inl 0 => + simp only [Fin.isValue, Lorentz.Vector.apply_add] + ring + | Sum.inr i => + simp + map_smul' c x := by + funext μ + match μ with + | Sum.inl 0 => + simp only [Fin.isValue, Lorentz.Vector.apply_smul, RingHom.id_apply] + ring + | Sum.inr i => + simp + continuous_invFun := by + simp only [one_div, Fin.isValue] + apply Lorentz.Vector.continuous_of_apply + intro μ + match μ with + | Sum.inl 0 => + simp only [Fin.isValue] + fun_prop + | Sum.inr i => + simp only + fun_prop + continuous_toFun := by + apply Lorentz.Vector.continuous_of_apply + intro μ + match μ with + | Sum.inl 0 => + simp only [Fin.isValue] + fun_prop + | Sum.inr i => + simp only + fun_prop /-! -### E.1. Instance of a measurable space +#### B.4.3. Determinant of the equivalence -/ -instance {d : ℕ} : MeasurableSpace (SpaceTime d) := borel (SpaceTime d) +lemma det_timeSpaceBasisEquiv {d : ℕ} (c : SpeedOfLight) : + (timeSpaceBasisEquiv (d := d) c).det = c.val := by + rw [@LinearEquiv.coe_det] + let e := toTimeAndSpace (d := d) c + trans LinearMap.det (e.toLinearMap ∘ₗ (timeSpaceBasisEquiv (d := d) c).toLinearMap ∘ₗ + e.symm.toLinearMap) + · simp only [ContinuousLinearEquiv.toLinearEquiv_symm, LinearMap.det_conj] + have h1 : e.toLinearMap ∘ₗ (timeSpaceBasisEquiv (d := d) c).toLinearMap ∘ₗ + e.symm.toLinearMap = (c.val • LinearMap.id).prodMap LinearMap.id := by + apply LinearMap.ext + intro tx + simp [e, timeSpaceBasisEquiv, toTimeAndSpace] + apply And.intro + · ext + simp + · ext i + simp [space] + rw [h1] + rw [LinearMap.det_prodMap] + simp /-! -### E.2. Instance of a borel space +#### B.4.4. Time space basis expressed in terms of the Lorentz basis -/ -instance {d : ℕ} : BorelSpace (SpaceTime d) where - measurable_eq := by rfl +lemma timeSpaceBasis_eq_map_basis {d : ℕ} (c : SpeedOfLight) : + timeSpaceBasis (d := d) c = + Module.Basis.map (Lorentz.Vector.basis (d := d)) (timeSpaceBasisEquiv c).toLinearEquiv := by + ext μ + match μ with + | Sum.inl 0 => + simp [timeSpaceBasisEquiv] + funext ν + match ν with + | Sum.inl 0 => simp + | Sum.inr i => simp + | Sum.inr i => + simp [timeSpaceBasisEquiv] + funext ν + match ν with + | Sum.inl 0 => simp + | Sum.inr j => simp /-! -### E.3. Definition of an inner product space structure on `SpaceTime d` +#### B.4.5. The additive Haar measure associated to the time space basis -/ -/-- The Euclidean inner product structure on `SpaceTime`. -/ -instance innerProductSpace (d : ℕ) : InnerProductSpace ℝ (SpaceTime d) := - inferInstanceAs (InnerProductSpace ℝ (EuclideanSpace ℝ (Fin 1 ⊕ Fin d))) +lemma timeSpaceBasis_addHaar {d : ℕ} (c : SpeedOfLight := 1) : + (timeSpaceBasis (d := d) c).addHaar = (ENNReal.ofReal (c⁻¹)) • volume := by + rw [timeSpaceBasis_eq_map_basis c, ← Module.Basis.map_addHaar] + have h1 := MeasureTheory.Measure.map_linearMap_addHaar_eq_smul_addHaar + (f := (timeSpaceBasisEquiv (d := d) c).toLinearMap) (μ := Lorentz.Vector.basis.addHaar) + (by simp [← LinearEquiv.coe_det, det_timeSpaceBasisEquiv]) + simp at h1 + rw [h1] + simp [← LinearEquiv.coe_det, det_timeSpaceBasisEquiv] + congr + simp /-! - -### E.4. Instance of a measure space +### B.5. Integrals over `SpaceTime d` -/ -instance {d : ℕ} : MeasureSpace (SpaceTime d) where - volume := Lorentz.Vector.basis.addHaar - /-! -### E.5. Volume measure is positive on non-empty open sets +#### B.5.1. Measure preserving property of `toTimeAndSpace.symm` -/ -instance {d : ℕ} : (volume (α := SpaceTime d)).IsOpenPosMeasure := - inferInstanceAs ((Lorentz.Vector.basis.addHaar).IsOpenPosMeasure) +open MeasureTheory +lemma toTimeAndSpace_symm_measurePreserving {d : ℕ} (c : SpeedOfLight) : + MeasurePreserving (toTimeAndSpace c).symm (volume.prod (volume (α := Space d))) + (ENNReal.ofReal c⁻¹ • volume) := by + have h : volume (α := SpaceTime d) = Lorentz.Vector.basis.addHaar := rfl + refine { measurable := ?_, map_eq := ?_ } + · fun_prop + rw [Space.volume_eq_addHaar, Time.volume_eq_basis_addHaar, ← Module.Basis.prod_addHaar, + Module.Basis.map_addHaar] + rw [← timeSpaceBasis_addHaar c] + rfl /-! -### E.6. Volume measure is a finite measure on compact sets +#### B.5.2. Integrals over `SpaceTime d` expressed as integrals over `Time` and `Space d` -/ -instance {d : ℕ} : IsFiniteMeasureOnCompacts (volume (α := SpaceTime d)) := - inferInstanceAs (IsFiniteMeasureOnCompacts (Lorentz.Vector.basis.addHaar)) - -/-! - -### E.7. Volume measure is an additive Haar measure - --/ +lemma spaceTime_integral_eq_time_space_integral {M} [NormedAddCommGroup M] + [NormedSpace ℝ M] {d : ℕ} (c : SpeedOfLight) + (f : SpaceTime d → M) : + ∫ x : SpaceTime d, f x ∂(volume) = + c.val • ∫ tx : Time × Space d, f ((toTimeAndSpace c).symm tx) ∂(volume.prod volume) := by + symm + have h1 : ∫ tx : Time × Space d, f ((toTimeAndSpace c).symm tx) ∂(volume.prod volume) + = ∫ x : SpaceTime d, f x ∂((ENNReal.ofReal (c⁻¹)) • volume) := by + apply MeasureTheory.MeasurePreserving.integral_comp + · refine { measurable := ?_, map_eq := ?_ } + · fun_prop + have hs : volume (α := Space d) = Space.basis.toBasis.addHaar := by + exact Space.volume_eq_addHaar + have ht : volume (α := Time) = Time.basis.toBasis.addHaar := by + exact Time.volume_eq_basis_addHaar + rw [hs, ht] + rw [← Module.Basis.prod_addHaar] + rw [Module.Basis.map_addHaar] + rw [← timeSpaceBasis_addHaar c] + congr + · refine Measurable.measurableEmbedding ?_ ?_ + · fun_prop + · exact ContinuousLinearEquiv.injective (toTimeAndSpace c).symm + rw [h1] + simp -instance {d : ℕ} : Measure.IsAddHaarMeasure (volume (α := SpaceTime d)) := - inferInstanceAs (Measure.IsAddHaarMeasure (Lorentz.Vector.basis.addHaar)) +lemma spaceTime_integrable_iff_space_time_integrable {M} [NormedAddCommGroup M] + {d : ℕ} (c : SpeedOfLight) + (f : SpaceTime d → M) : + Integrable f volume ↔ Integrable (f ∘ ((toTimeAndSpace c).symm)) (volume.prod volume) := by + symm + trans Integrable f (ENNReal.ofReal (c⁻¹) • volume); swap + · rw [MeasureTheory.integrable_smul_measure] + · simp + · simp + apply MeasureTheory.MeasurePreserving.integrable_comp_emb + · exact toTimeAndSpace_symm_measurePreserving c + · refine Measurable.measurableEmbedding ?_ ?_ + · fun_prop + · exact ContinuousLinearEquiv.injective (toTimeAndSpace c).symm + +lemma spaceTime_integral_eq_time_integral_space_integral {M} [NormedAddCommGroup M] + [NormedSpace ℝ M] {d : ℕ} (c : SpeedOfLight) + (f : SpaceTime d → M) + (h : Integrable f volume) : + ∫ x : SpaceTime d, f x = + c.val • ∫ t : Time, ∫ x : Space d, f ((toTimeAndSpace c).symm (t, x)) := by + rw [spaceTime_integral_eq_time_space_integral, MeasureTheory.integral_prod] + rw [spaceTime_integrable_iff_space_time_integrable] at h + exact h + +lemma spaceTime_integral_eq_space_integral_time_integral {M} [NormedAddCommGroup M] + [NormedSpace ℝ M] {d : ℕ} (c : SpeedOfLight) + (f : SpaceTime d → M) + (h : Integrable f volume) : + ∫ x : SpaceTime d, f x = + c.val • ∫ x : Space d, ∫ t : Time, f ((toTimeAndSpace c).symm (t, x)) := by + rw [spaceTime_integral_eq_time_space_integral, MeasureTheory.integral_prod_symm] + rw [spaceTime_integrable_iff_space_time_integrable] at h + exact h end SpaceTime diff --git a/PhysLean/SpaceAndTime/SpaceTime/Boosts.lean b/PhysLean/SpaceAndTime/SpaceTime/Boosts.lean index 14b425428..ffc56dd96 100644 --- a/PhysLean/SpaceAndTime/SpaceTime/Boosts.lean +++ b/PhysLean/SpaceAndTime/SpaceTime/Boosts.lean @@ -3,7 +3,6 @@ Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ -import PhysLean.SpaceAndTime.SpaceTime.Basic import PhysLean.Relativity.LorentzGroup.Boosts.Basic import PhysLean.Meta.Informal.SemiFormal import PhysLean.Mathematics.FDerivCurry @@ -83,6 +82,43 @@ lemma boost_x_smul (β : ℝ) (hβ : |β| < 1) (x : SpaceTime) : LorentzGroup.boost_inr_other_inr _ (by decide)] simp +lemma boost_zero_apply_time_space {d : ℕ} {β : ℝ} (hβ : |β| < 1) (c : SpeedOfLight) + (t : Time) (x : Space d.succ) : + ((boost (0 : Fin d.succ) β hβ)⁻¹ • (SpaceTime.toTimeAndSpace c).symm (t, x)) = + (SpaceTime.toTimeAndSpace c).symm + (γ β * (t.val + β /c * x 0), + ⟨fun + | (0 : Fin d.succ) => γ β * (x 0 + c * β * t.val) + | ⟨Nat.succ n, ih⟩ => x ⟨Nat.succ n, ih⟩⟩) := by + funext μ + rw [boost_inverse, Lorentz.Vector.smul_eq_sum] + simp only [Nat.succ_eq_add_one, Fintype.sum_sum_type, Finset.univ_unique, Fin.default_eq_zero, + Fin.isValue, Finset.sum_singleton, toTimeAndSpace_symm_apply_inl, toTimeAndSpace_symm_apply_inr] + rw [Fin.sum_univ_succ] + match μ with + | Sum.inl 0 => + simp only [Nat.succ_eq_add_one, Fin.isValue, boost_inl_0_inl_0, γ_neg, boost_inl_0_inr_self, + mul_neg, neg_mul, neg_neg, boost_zero_inl_0_inr_succ, zero_mul, Finset.sum_const_zero, + add_zero, toTimeAndSpace_symm_apply_inl] + field_simp + | Sum.inr ⟨0, h⟩ => + simp only [Nat.succ_eq_add_one, Fin.isValue, toTimeAndSpace_symm_apply_inr] + simp only [Fin.zero_eta, Fin.isValue, boost_inr_self_inl_0, γ_neg, mul_neg, neg_mul, neg_neg, + boost_inr_self_inr_self, boost_zero_inr_0_inr_succ, zero_mul, Finset.sum_const_zero, add_zero] + field_simp + ring + | Sum.inr ⟨Nat.succ n, h⟩ => + simp only [Nat.succ_eq_add_one, Fin.isValue, boost_zero_inr_nat_succ_inl_0, zero_mul, + boost_zero_inr_nat_succ_inr_0, zero_add, toTimeAndSpace_symm_apply_inr] + rw [Finset.sum_eq_single ⟨n, by omega⟩] + simp [boost_inr_inr_other] + simp only [Finset.mem_univ, ne_eq, mul_eq_zero, forall_const] + simp [boost_inr_inr_other] + intro b hb + left + simpa [Fin.ext_iff] using hb + simp + end SpaceTime end diff --git a/PhysLean/SpaceAndTime/SpaceTime/Derivatives.lean b/PhysLean/SpaceAndTime/SpaceTime/Derivatives.lean new file mode 100644 index 000000000..b969a6abe --- /dev/null +++ b/PhysLean/SpaceAndTime/SpaceTime/Derivatives.lean @@ -0,0 +1,552 @@ +/- +Copyright (c) 2024 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +import PhysLean.SpaceAndTime.SpaceTime.LorentzAction +import PhysLean.Relativity.Tensors.RealTensor.CoVector.Basic +import Mathlib.Analysis.InnerProductSpace.TensorProduct +/-! + +# Derivatives on SpaceTime + +## i. Overview + +In this module we define and prove basic lemmas about derivatives of functions and +distributions on `SpaceTime d`. + +## ii. Key results + +- `deriv` : The derivative of a function `SpaceTime d → M` along the `μ` coordinate. +- `deriv_sum_inr` : The derivative along a spatial coordinate in terms of the + derivative on `Space d`. +- `deriv_sum_inl` : The derivative along the temporal coordinate in terms of the + derivative on `Time`. +- `distDeriv` : The derivative of a distribution on `SpaceTime d` along the `μ` coordinate. +- `distDeriv_commute` : Derivatives of distributions on `SpaceTime d` commute. + +## iii. Table of contents + +- A. Derivatives of functions on `SpaceTime d` + - A.1. The definition of the derivative + - A.2. Basic equality lemmas + - A.3. Derivative of the zero function + - A.4. The derivative of a function composed with a Lorentz transformation + - A.5. Spacetime derivatives in terms of time and space derivatives +- B. Derivatives of distributions + - B.1. Commutation of derivatives of distributions + - B.2. Lorentz group action on derivatives of distributions +- C. Derivatives of tensors + - C.1. Derivatives of tensors for distributions + +## iv. References + +-/ +noncomputable section + +namespace SpaceTime + +open Manifold +open Matrix +open Complex +open ComplexConjugate +open TensorSpecies + +/-! + +## A. Derivatives of functions on `SpaceTime d` + +-/ + +/-! + +### A.1. The definition of the derivative + +-/ + +/-- The derivative of a function `SpaceTime d → ℝ` along the `μ` coordinate. -/ +noncomputable def deriv {M : Type} [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] + {d : ℕ} (μ : Fin 1 ⊕ Fin d) (f : SpaceTime d → M) : SpaceTime d → M := + fun y => fderiv ℝ f y (Lorentz.Vector.basis μ) + +@[inherit_doc deriv] +scoped notation "∂_" => deriv + +/-! + +### A.2. Basic equality lemmas + +-/ + +variable {M : Type} [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] +lemma deriv_eq {d : ℕ} (μ : Fin 1 ⊕ Fin d) (f : SpaceTime d → M) (y : SpaceTime d) : + ∂_ μ f y = + fderiv ℝ f y (Lorentz.Vector.basis μ) := by + rfl + +lemma differentiable_vector {d : ℕ} (f : SpaceTime d → Lorentz.Vector d) : + (∀ ν, Differentiable ℝ (fun x => f x ν)) ↔ Differentiable ℝ f := by + apply Iff.intro + · intro h + rw [← (Lorentz.Vector.equivPi d).comp_differentiable_iff] + exact differentiable_pi'' h + · intro h ν + change Differentiable ℝ (Lorentz.Vector.coordCLM ν ∘ f) + apply Differentiable.comp + · fun_prop + · exact h + +lemma contDiff_vector {d : ℕ} (f : SpaceTime d → Lorentz.Vector d) : + (∀ ν, ContDiff ℝ n (fun x => f x ν)) ↔ ContDiff ℝ n f := by + apply Iff.intro + · intro h + rw [← (Lorentz.Vector.equivPi d).comp_contDiff_iff] + apply contDiff_pi' + intro ν + exact h ν + · intro h ν + change ContDiff ℝ n (Lorentz.Vector.coordCLM ν ∘ f) + apply ContDiff.comp + · fun_prop + · exact h + +lemma deriv_apply_eq {d : ℕ} (μ ν : Fin 1 ⊕ Fin d) (f : SpaceTime d → Lorentz.Vector d) + (hf : Differentiable ℝ f) + (y : SpaceTime d) : + ∂_ μ f y ν = fderiv ℝ (fun x => f x ν) y (Lorentz.Vector.basis μ) := by + rw [deriv_eq] + change _ = (fderiv ℝ (Lorentz.Vector.coordCLM ν ∘ f) y) (Lorentz.Vector.basis μ) + rw [fderiv_comp _ (by fun_prop) (by fun_prop)] + simp only [ContinuousLinearMap.fderiv, ContinuousLinearMap.coe_comp', Function.comp_apply] + rfl + +lemma fderiv_vector {d : ℕ} (f : SpaceTime d → Lorentz.Vector d) + (hf : Differentiable ℝ f) (y dt : SpaceTime d) (ν : Fin 1 ⊕ Fin d) : + fderiv ℝ f y dt ν = fderiv ℝ (fun x => f x ν) y dt := by + change _ = (fderiv ℝ (Lorentz.Vector.coordCLM ν ∘ f) y) dt + rw [fderiv_comp _ (by fun_prop) (by fun_prop)] + simp only [ContinuousLinearMap.fderiv, ContinuousLinearMap.coe_comp', Function.comp_apply] + rfl + +@[simp] +lemma deriv_coord {d : ℕ} (μ ν : Fin 1 ⊕ Fin d) : + ∂_ μ (fun x => x ν) = if μ = ν then 1 else 0 := by + change ∂_ μ (coordCLM ν) = _ + funext x + rw [deriv_eq] + simp only [ContinuousLinearMap.fderiv] + simp [coordCLM] + split_ifs + rfl + rfl + +/-! + +### A.3. Derivative of the zero function + +-/ + +@[simp] +lemma deriv_zero {d : ℕ} (μ : Fin 1 ⊕ Fin d) : SpaceTime.deriv μ (fun _ => (0 : ℝ)) = 0 := by + ext y + rw [SpaceTime.deriv_eq] + simp + +attribute [-simp] Fintype.sum_sum_type + +/-! + +### A.4. The derivative of a function composed with a Lorentz transformation + +-/ + +lemma deriv_comp_lorentz_action {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] {d : ℕ} + (μ : Fin 1 ⊕ Fin d) + (f : SpaceTime d → M) (hf : Differentiable ℝ f) (Λ : LorentzGroup d) + (x : SpaceTime d) : + ∂_ μ (fun x => f (Λ • x)) x = ∑ ν, Λ.1 ν μ • ∂_ ν f (Λ • x) := by + change fderiv ℝ (f ∘ Lorentz.Vector.actionCLM Λ) x (Lorentz.Vector.basis μ) = _ + rw [fderiv_comp] + simp only [Lorentz.Vector.actionCLM_apply, Nat.succ_eq_add_one, Nat.reduceAdd, + ContinuousLinearMap.fderiv, ContinuousLinearMap.coe_comp', Function.comp_apply] + -- Fintype.sum_sum_type + rw [Lorentz.Vector.smul_basis] + simp + rfl + · fun_prop + · fun_prop + +variable + {c : Fin n → realLorentzTensor.Color} {M : Type} [NormedAddCommGroup M] + [NormedSpace ℝ M] [Tensorial (realLorentzTensor d) c M] [T2Space M] +lemma deriv_equivariant (f : SpaceTime d → M) (Λ : LorentzGroup d) (x : SpaceTime d) + (hf : Differentiable ℝ f) (μ : Fin 1 ⊕ Fin d) : + ∂_ μ (fun x => Λ • f (Λ⁻¹ • x)) x = + ∑ ν, Λ⁻¹.1 ν μ • Λ • ∂_ ν f (Λ⁻¹ • x) := by + have h1 (μ : Fin 1 ⊕ Fin d) (x : SpaceTime d) : + ∂_ μ (fun x => Λ • f (Λ⁻¹ • x)) x = + Λ • ∂_ μ (fun x => f (Λ⁻¹ • x)) x := by + change ∂_ μ (TensorSpecies.Tensorial.actionCLM _ Λ ∘ fun x => f (Λ⁻¹ • x)) x = _ + rw [deriv_eq] + rw [fderiv_comp] + simp [Tensorial.actionCLM_apply, ← deriv_eq] + · fun_prop + · apply Differentiable.differentiableAt + have hx : Differentiable ℝ (f ∘ (Lorentz.Vector.actionCLM Λ⁻¹)) := by fun_prop + exact hx + rw [h1 μ x, deriv_comp_lorentz_action] + change (TensorSpecies.Tensorial.actionCLM _ Λ) (∑ ν, (Λ⁻¹).1 ν μ • ∂_ ν f (Λ⁻¹ • x)) = _ + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, map_sum, map_smul] + simp [TensorSpecies.Tensorial.actionCLM_apply] + · fun_prop + +/-! + +### A.5. Spacetime derivatives in terms of time and space derivatives + +-/ + +lemma deriv_sum_inr {d : ℕ} {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] + (c : SpeedOfLight) (f : SpaceTime d → M) + (hf : Differentiable ℝ f) (x : SpaceTime d) (i : Fin d) : + ∂_ (Sum.inr i) f x + = Space.deriv i (fun y => f ((toTimeAndSpace c).symm ((toTimeAndSpace c x).1, y))) + (toTimeAndSpace c x).2 := by + rw [deriv_eq, Space.deriv_eq] + conv_rhs => rw [fderiv_comp' _ (by fun_prop) (by fun_prop)] + simp only [Prod.mk.eta, ContinuousLinearEquiv.symm_apply_apply, ContinuousLinearMap.coe_comp', + Function.comp_apply] + congr 1 + rw [fderiv_comp'] + simp only [Prod.mk.eta, toTimeAndSpace_symm_fderiv, ContinuousLinearMap.coe_comp', + ContinuousLinearEquiv.coe_coe, Function.comp_apply] + change _ = (toTimeAndSpace c).symm ((fderiv ℝ ((toTimeAndSpace c x).1, ·) (toTimeAndSpace c x).2) + (Space.basis i)) + rw [DifferentiableAt.fderiv_prodMk] + simp only [fderiv_fun_const, Pi.zero_apply, fderiv_id', ContinuousLinearMap.prod_apply, + ContinuousLinearMap.zero_apply, ContinuousLinearMap.coe_id', id_eq] + trans (toTimeAndSpace c).symm (0, Space.basis i) + · rw [← toTimeAndSpace_basis_inr (c := c)] + simp + · rfl + repeat' fun_prop + +lemma deriv_sum_inl {d : ℕ} {M : Type} [NormedAddCommGroup M] + [NormedSpace ℝ M] (c : SpeedOfLight) (f : SpaceTime d → M) + (hf : Differentiable ℝ f) (x : SpaceTime d) : + ∂_ (Sum.inl 0) f x + = (1/(c : ℝ)) • Time.deriv (fun t => f ((toTimeAndSpace c).symm (t, (toTimeAndSpace c x).2))) + (toTimeAndSpace c x).1 := by + rw [deriv_eq, Time.deriv_eq] + conv_rhs => rw [fderiv_comp' _ (by fun_prop) (by fun_prop)] + simp only [Fin.isValue, Prod.mk.eta, ContinuousLinearEquiv.symm_apply_apply, + ContinuousLinearMap.coe_comp', Function.comp_apply] + trans + (fderiv ℝ f x) + ((1 / c.val) • (fderiv ℝ (fun t => (toTimeAndSpace c).symm (t, ((toTimeAndSpace c) x).2)) + ((toTimeAndSpace c) x).1) 1) + swap + · exact ContinuousLinearMap.map_smul_of_tower (fderiv ℝ f x) (1 / c.val) _ + congr 1 + + rw [fderiv_comp'] + simp only [Fin.isValue, Prod.mk.eta, toTimeAndSpace_symm_fderiv, ContinuousLinearMap.coe_comp', + ContinuousLinearEquiv.coe_coe, Function.comp_apply] + rw [DifferentiableAt.fderiv_prodMk] + simp only [Fin.isValue, fderiv_id', fderiv_fun_const, Pi.zero_apply, + ContinuousLinearMap.prod_apply, ContinuousLinearMap.coe_id', id_eq, + ContinuousLinearMap.zero_apply] + rw [← map_smul] + rw [← toTimeAndSpace_basis_inl' (c := c)] + simp only [Fin.isValue, ContinuousLinearEquiv.symm_apply_apply] + repeat' fun_prop + +/-! + +## B. Derivatives of distributions + +-/ + +open Distribution SchwartzMap +/-- Given a distribution (function) `f : Space d →d[ℝ] M` the derivative + of `f` in direction `μ`. -/ +noncomputable def distDeriv {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (μ : Fin 1 ⊕ Fin d) : ((SpaceTime d) →d[ℝ] M) →ₗ[ℝ] (SpaceTime d) →d[ℝ] M where + toFun f := + let ev : (SpaceTime d →L[ℝ] M) →L[ℝ] M := { + toFun v := v (Lorentz.Vector.basis μ) + map_add' v1 v2 := by + simp only [ContinuousLinearMap.add_apply] + map_smul' a v := by + simp + } + ev.comp (Distribution.fderivD ℝ f) + map_add' f1 f2 := by + simp + map_smul' a f := by simp + +lemma distDeriv_apply {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (μ : Fin 1 ⊕ Fin d) (f : (SpaceTime d) →d[ℝ] M) (ε : 𝓢(SpaceTime d, ℝ)) : + distDeriv μ f ε = fderivD ℝ f ε (Lorentz.Vector.basis μ) := by + simp [distDeriv, Distribution.fderivD] + +lemma distDeriv_apply' {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (μ : Fin 1 ⊕ Fin d) (f : (SpaceTime d) →d[ℝ] M) (ε : 𝓢(SpaceTime d, ℝ)) : + distDeriv μ f ε = + - f ((SchwartzMap.evalCLM ℝ (SpaceTime d) ℝ (Lorentz.Vector.basis μ)) + ((fderivCLM ℝ (SpaceTime d) ℝ) ε)) := by + simp [distDeriv_apply, Distribution.fderivD] + +lemma apply_fderiv_eq_distDeriv {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (μ : Fin 1 ⊕ Fin d) (f : (SpaceTime d) →d[ℝ] M) (ε : 𝓢(SpaceTime d, ℝ)) : + f ((SchwartzMap.evalCLM ℝ (SpaceTime d) ℝ (Lorentz.Vector.basis μ)) + ((fderivCLM ℝ (SpaceTime d) ℝ) ε)) = + - distDeriv μ f ε := by + rw [distDeriv_apply'] + simp + +/-! + +### B.1. Commutation of derivatives of distributions + +-/ + +open ContDiff +lemma distDeriv_commute {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (μ ν : Fin 1 ⊕ Fin d) (f : (SpaceTime d) →d[ℝ] M) : + distDeriv μ (distDeriv ν f) = distDeriv ν (distDeriv μ f) := by + ext κ + rw [distDeriv_apply, distDeriv_apply, fderivD_apply, fderivD_apply] + rw [distDeriv_apply, distDeriv_apply, fderivD_apply, fderivD_apply] + simp only [neg_neg] + congr 1 + ext x + change fderiv ℝ (fun x => fderiv ℝ κ x (Lorentz.Vector.basis μ)) x (Lorentz.Vector.basis ν) = + fderiv ℝ (fun x => fderiv ℝ κ x (Lorentz.Vector.basis ν)) x (Lorentz.Vector.basis μ) + rw [fderiv_clm_apply, fderiv_clm_apply] + simp only [fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.comp_zero, zero_add, + ContinuousLinearMap.flip_apply] + rw [IsSymmSndFDerivAt.eq] + · apply ContDiffAt.isSymmSndFDerivAt (n := ∞) + apply ContDiff.contDiffAt + exact smooth κ ⊤ + simp only [minSmoothness_of_isRCLikeNormedField] + exact ENat.LEInfty.out + · have h1 := smooth κ 2 + fun_prop + · fun_prop + · have h1 := smooth κ 2 + fun_prop + · fun_prop + +/-! + +### B.2. Lorentz group action on derivatives of distributions + +We now show how the Lorentz group action on distributions interacts with derivatives. + +-/ + +lemma distDeriv_comp_lorentz_action {μ : Fin 1 ⊕ Fin d} (Λ : LorentzGroup d) + (f : (SpaceTime d) →d[ℝ] M) : + distDeriv μ (Λ • f) = ∑ ν, Λ⁻¹.1 ν μ • (Λ • distDeriv ν f) := by + symm + trans (∑ ν, Λ • Λ⁻¹.1 ν μ • (distDeriv ν) f) + · congr + funext i + rw [SMulCommClass.smul_comm] + trans Λ • (∑ ν, Λ⁻¹.1 ν μ • (distDeriv ν) f) + · exact Eq.symm Finset.smul_sum + ext η + rw [lorentzGroup_smul_dist_apply, distDeriv_apply, fderivD_apply, + lorentzGroup_smul_dist_apply] + rw [← smul_neg] + congr + rw [ContinuousLinearMap.sum_apply] + simp only [ContinuousLinearMap.coe_smul', Pi.smul_apply] + conv_lhs => + enter [2, x] + rw [distDeriv_apply, fderivD_apply] + simp only [smul_neg] + rw [← map_smul] + rw [Finset.sum_neg_distrib] + congr + rw [← map_sum] + congr + /- Reduced to Schwartz maps -/ + ext x + rw [SchwartzMap.sum_apply] + symm + simp [schwartzAction_apply] + change ∂_ μ η (Λ • x) = ∑ ν, Λ⁻¹.1 ν μ • ∂_ ν (schwartzAction Λ⁻¹ η) (x) + obtain ⟨η, rfl⟩ := schwartzAction_surjective Λ η + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, smul_eq_mul] + rw [schwartzAction_mul_apply] + simp only [inv_mul_cancel, map_one, ContinuousLinearMap.one_apply] + change ∂_ μ (fun x => η (Λ⁻¹ • x)) (Λ • x) = _ + rw [deriv_comp_lorentz_action] + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, inv_smul_smul, smul_eq_mul] + exact SchwartzMap.differentiable η + +/-! + +## C. Derivatives of tensors + +Given a function `f : SpaceTime d → M` where `M` is a tensor space, we can define the +derivative of `f` as a tensor. In particular this is `∂_μ f` viewed as a tensor in +`Lorentz.CoVector d ⊗[ℝ] M`. + +-/ +open TensorProduct + +/-- The derivative of a tensor, as a tensor. -/ +def tensorDeriv (f : SpaceTime d → M) : + SpaceTime d → Lorentz.CoVector d ⊗[ℝ] M := fun x => + ∑ μ, (Lorentz.CoVector.basis μ) ⊗ₜ (∂_ μ f x) + +lemma tensorDeriv_equivariant (f : SpaceTime d → M) (Λ : LorentzGroup d) (x : SpaceTime d) + (hf : Differentiable ℝ f) : + tensorDeriv (fun x => Λ • f (Λ⁻¹ • x)) x = + Λ • tensorDeriv f (Λ⁻¹ • x) := by + simp [tensorDeriv] + conv_lhs => + enter [2, μ] + rw [deriv_equivariant f Λ x hf μ, tmul_sum] + enter [2, ν] + rw [← smul_tmul] + rw [Finset.sum_comm] + conv_lhs => + enter [2, ν] + rw [← sum_tmul, ← Lorentz.CoVector.smul_basis, ← Tensorial.smul_prod] + change _ = (TensorSpecies.Tensorial.smulLinearMap Λ) _ + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, map_sum] + simp [TensorSpecies.Tensorial.smulLinearMap_apply] + +lemma tensorDeriv_toTensor_basis_repr + {f : SpaceTime d → M} + (hf : Differentiable ℝ f) (x : SpaceTime d) + (b : Tensor.ComponentIdx (Fin.append ![realLorentzTensor.Color.down] c)) : + (Tensor.basis _).repr (Tensorial.toTensor (tensorDeriv f x)) b = + ∂_ (Lorentz.CoVector.indexEquiv (Tensor.ComponentIdx.prodEquiv b).1) + (fun x => (Tensor.basis _).repr (Tensorial.toTensor (f x)) + (Tensor.ComponentIdx.prodEquiv b).2) x := by + simp [tensorDeriv] + conv_lhs => + enter [2, μ] + rw [Tensorial.toTensor_tprod, Tensor.prodT_basis_repr_apply] + simp [Lorentz.CoVector.toTensor_basis_eq_tensor_basis, Finsupp.single_apply] + rw [Finset.sum_eq_single (Lorentz.CoVector.indexEquiv (Tensor.ComponentIdx.prodEquiv b).1)] + · simp + generalize (Lorentz.CoVector.indexEquiv (Tensor.ComponentIdx.prodEquiv b).1) = μ at * + generalize (Tensor.ComponentIdx.prodEquiv b).2 = ν at * + have h1 (x : SpaceTime d) : ((Tensor.basis c).repr (Tensorial.toTensor (f x))) ν = + (ContinuousLinearMap.proj ν ∘L ((Tensor.basis c).map + (Tensorial.toTensor).symm).equivFunL.toContinuousLinearMap) (f x) := by + simp + conv_rhs => + enter [2, x] + rw [h1 x] + conv_rhs => + rw [deriv_eq] + rw [fderiv_comp' _ (by fun_prop) (by fun_prop)] + rw [ContinuousLinearMap.fderiv] + simp [deriv_eq] + · intro b' _ hb + simp only [ite_eq_right_iff] + intro hx + grind + · simp + +/-! + +### C.1. Derivatives of tensors for distributions + +-/ +open InnerProductSpace +/-- The derivative of a tensor, as a tensor for distributions. -/ +def distTensorDeriv {M d} [NormedAddCommGroup M] + [InnerProductSpace ℝ M] [FiniteDimensional ℝ M] : + ((SpaceTime d) →d[ℝ] M) →ₗ[ℝ] ((SpaceTime d) →d[ℝ] Lorentz.CoVector d ⊗[ℝ] M) where + toFun f := { + toFun ε := ∑ μ, (Lorentz.CoVector.basis μ) ⊗ₜ distDeriv μ f ε + map_add' ε1 ε2 := by + simp [← Finset.sum_add_distrib, tmul_add] + map_smul' a ε := by + simp [← Finset.smul_sum, tmul_smul] + cont := by + refine continuous_finset_sum Finset.univ (fun μ _ => ?_) + refine Continuous.comp' ?_ ?_ + · change Continuous (fun y => (Lorentz.CoVector.basis μ) ⊗ₜ y) + obtain ⟨w,b,hb1⟩ := exists_orthonormalBasis ℝ M + have h1 : ∀ (y : M), (Lorentz.CoVector.basis μ) ⊗ₜ y = + ∑ i, ⟪b i, y⟫_ℝ • ((Lorentz.CoVector.basis μ) ⊗ₜ[ℝ] (b i)) := by + intro y + conv_lhs => rw [← OrthonormalBasis.sum_repr' b y] + simp [tmul_sum] + conv => enter [1, y]; rw [h1] + fun_prop + · fun_prop + } + map_add' f1 f2 := by + ext ε + simp [tmul_add, Finset.sum_add_distrib] + map_smul' a f := by + ext ε + simp [tmul_smul, Finset.smul_sum] + +lemma distTensorDeriv_apply {M d} [NormedAddCommGroup M] + [InnerProductSpace ℝ M] [FiniteDimensional ℝ M] (f : (SpaceTime d) →d[ℝ] M) + (ε : 𝓢(SpaceTime d, ℝ)) : + distTensorDeriv f ε = ∑ μ, (Lorentz.CoVector.basis μ) ⊗ₜ distDeriv μ f ε := by + simp [distTensorDeriv] + +lemma distTensorDeriv_equivariant {M : Type} [NormedAddCommGroup M] + [InnerProductSpace ℝ M] [FiniteDimensional ℝ M] [(realLorentzTensor d).Tensorial c M] + (f : (SpaceTime d) →d[ℝ] M) (Λ : LorentzGroup d) : + distTensorDeriv (Λ • f) = Λ • distTensorDeriv f := by + ext ε + rw [distTensorDeriv_apply] + conv_lhs => + enter [2, μ] + rw [distDeriv_comp_lorentz_action] + simp only [ContinuousLinearMap.coe_sum', ContinuousLinearMap.coe_smul', Finset.sum_apply, + Pi.smul_apply] + rw [tmul_sum] + enter [2, ν] + rw [← smul_tmul, lorentzGroup_smul_dist_apply] + rw [Finset.sum_comm] + conv_lhs => + enter [2, ν] + rw [← sum_tmul, ← Lorentz.CoVector.smul_basis, ← Tensorial.smul_prod] + change _ = (TensorSpecies.Tensorial.smulLinearMap Λ) _ + simp only [Nat.succ_eq_add_one, Nat.reduceAdd, ContinuousLinearMap.coe_comp, LinearMap.coe_comp, + ContinuousLinearMap.coe_coe, Function.comp_apply] + rw [distTensorDeriv_apply] + simp only [map_sum] + simp [TensorSpecies.Tensorial.smulLinearMap_apply] + +lemma distTensorDeriv_toTensor_basis_repr {M : Type} [NormedAddCommGroup M] + [InnerProductSpace ℝ M] [FiniteDimensional ℝ M] [(realLorentzTensor d).Tensorial c M] + {f : (SpaceTime d) →d[ℝ] M} + (ε : 𝓢(SpaceTime d, ℝ)) + (b : Tensor.ComponentIdx (Fin.append ![realLorentzTensor.Color.down] c)) : + (Tensor.basis _).repr (Tensorial.toTensor (distTensorDeriv f ε)) b = + (Tensor.basis _).repr (Tensorial.toTensor + (distDeriv (Lorentz.CoVector.indexEquiv (Tensor.ComponentIdx.prodEquiv b).1) f ε)) + (Tensor.ComponentIdx.prodEquiv b).2 := by + simp [distTensorDeriv] + conv_lhs => + enter [2, μ] + rw [Tensorial.toTensor_tprod, Tensor.prodT_basis_repr_apply] + simp [Lorentz.CoVector.toTensor_basis_eq_tensor_basis, Finsupp.single_apply] + rw [Finset.sum_eq_single (Lorentz.CoVector.indexEquiv (Tensor.ComponentIdx.prodEquiv b).1)] + · simp + · intro b' _ hb + simp only [ite_eq_right_iff] + intro hx + grind + · simp + +end SpaceTime + +end diff --git a/PhysLean/SpaceAndTime/SpaceTime/Distributions.lean b/PhysLean/SpaceAndTime/SpaceTime/Distributions.lean deleted file mode 100644 index 344fd4ffe..000000000 --- a/PhysLean/SpaceAndTime/SpaceTime/Distributions.lean +++ /dev/null @@ -1,201 +0,0 @@ -/- -Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Tooby-Smith --/ -import PhysLean.SpaceAndTime.Space.Distributions.Basic -import PhysLean.SpaceAndTime.SpaceTime.Basic -/-! - -# Distributions on SpaceTime - -## i. Overview - -In this module we give the basic properties of distributions on `SpaceTime d`, -and derivatives thereof. - -## ii. Key results - -- `SpaceTime.constD d m` : the constant distribution on `SpaceTime d` with value `m`. -- `SpaceTime.timeSliceD` : the time slice of a distribution on `SpaceTime d` to a distribution - on `Time × Space d`. -- `SpaceTime.derivD μ f` : the derivative of a distribution `f : (SpaceTime d) →d[ℝ] M` in - direction `μ : Fin 1 ⊕ Fin d`. - -## iii. Table of contents - -- A. The constant distribution on SpaceTime -- B. The time slice of a distribution on SpaceTime -- C. Derivatives of distributions - - C.1. Relationship between the time slice and derivatives - -## iv. References - --/ -namespace SpaceTime - -open Distribution -open SchwartzMap - -/-! - -## A. The constant distribution on SpaceTime - --/ - -/-- The constant distribution from `SpaceTime d` to a module `M` associated with - `m : M`. -/ -noncomputable def constD {M } [NormedAddCommGroup M] [NormedSpace ℝ M] (d : ℕ) (m : M) : - (SpaceTime d) →d[ℝ] M := const ℝ (SpaceTime d) m - -/-! - -## B. The time slice of a distribution on SpaceTime - --/ - -/-- The time slice of a distribution on `SpaceTime d` to form a distribution - on `Time × Space d`. -/ -noncomputable def timeSliceD {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] : - ((SpaceTime d) →d[ℝ] M) ≃L[ℝ] ((Time × Space d) →d[ℝ] M) where - toFun f := - f ∘L SchwartzMap.compCLMOfContinuousLinearEquiv (F := ℝ) ℝ (SpaceTime.toTimeAndSpace (d := d)) - invFun f := - f ∘L SchwartzMap.compCLMOfContinuousLinearEquiv - (F := ℝ) ℝ (SpaceTime.toTimeAndSpace (d := d)).symm - left_inv f := by - ext κ - simp only [ContinuousLinearMap.coe_comp', Function.comp_apply] - congr - ext x - simp [SchwartzMap.compCLMOfContinuousLinearEquiv_apply] - right_inv f := by - ext κ - simp only [ContinuousLinearMap.coe_comp', Function.comp_apply] - congr - map_add' f1 f2 := by - simp - map_smul' a f := by simp - continuous_toFun := ((compCLMOfContinuousLinearEquiv ℝ toTimeAndSpace).precomp M).continuous - continuous_invFun := - ((compCLMOfContinuousLinearEquiv ℝ toTimeAndSpace.symm).precomp M).continuous - -/-! - -## C. Derivatives of distributions - --/ - -/-- Given a distribution (function) `f : Space d →d[ℝ] M` the derivative - of `f` in direction `μ`. -/ -noncomputable def derivD {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] - (μ : Fin 1 ⊕ Fin d) : ((SpaceTime d) →d[ℝ] M) →ₗ[ℝ] (SpaceTime d) →d[ℝ] M where - toFun f := - let ev : (SpaceTime d →L[ℝ] M) →L[ℝ] M := { - toFun v := v (Lorentz.Vector.basis μ) - map_add' v1 v2 := by - simp only [ContinuousLinearMap.add_apply] - map_smul' a v := by - simp - } - ev.comp (Distribution.fderivD ℝ f) - map_add' f1 f2 := by - simp - map_smul' a f := by simp - -lemma derivD_apply {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] - (μ : Fin 1 ⊕ Fin d) (f : (SpaceTime d) →d[ℝ] M) (ε : 𝓢(SpaceTime d, ℝ)) : - (derivD μ f) ε = fderivD ℝ f ε (Lorentz.Vector.basis μ) := by - simp [derivD, Distribution.fderivD] - -/-! - -### C.1. Relationship between the time slice and derivatives - --/ - -lemma timeSliceD_derivD_inl {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] - (f : (SpaceTime d) →d[ℝ] M) : - timeSliceD (derivD (Sum.inl 0) f) = - Space.timeDerivD (timeSliceD f) := by - ext ε - simp [timeSliceD] - rw [derivD_apply, Space.timeDerivD_apply] - rw [fderivD_apply, fderivD_apply] - simp only [Fin.isValue, ContinuousLinearMap.coe_comp', Function.comp_apply, neg_inj] - congr 1 - ext x - simp only [Fin.isValue, compCLMOfContinuousLinearEquiv_apply, Function.comp_apply] - change ((fderivCLM ℝ) ((compCLMOfContinuousLinearEquiv ℝ toTimeAndSpace) ε)) - x (Lorentz.Vector.basis (Sum.inl 0)) = ((fderivCLM ℝ) ε) (toTimeAndSpace x) (1, 0) - trans SpaceTime.deriv (Sum.inl 0) ((compCLMOfContinuousLinearEquiv ℝ toTimeAndSpace) ε) x - · rfl - rw [SpaceTime.deriv_sum_inl] - simp [Time.deriv] - change (fderiv ℝ (ε ∘ (fun t => (t, (toTimeAndSpace x).2))) (toTimeAndSpace x).1) 1 = _ - rw [fderiv_comp, DifferentiableAt.fderiv_prodMk] - simp only [Prod.mk.eta, fderiv_id', fderiv_fun_const, Pi.zero_apply, - ContinuousLinearMap.coe_comp', Function.comp_apply, ContinuousLinearMap.prod_apply, - ContinuousLinearMap.coe_id', id_eq, ContinuousLinearMap.zero_apply] - · fun_prop - · fun_prop - · apply Differentiable.differentiableAt - exact SchwartzMap.differentiable ε - · fun_prop - exact SchwartzMap.differentiable ((compCLMOfContinuousLinearEquiv ℝ toTimeAndSpace) ε) - -lemma timeSliceD_symm_derivD_inl {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] - (f : (Time × Space d) →d[ℝ] M) : - (derivD (Sum.inl 0) (timeSliceD.symm f)) = - timeSliceD.symm (Space.timeDerivD f) := by - obtain ⟨f, rfl⟩ := timeSliceD.surjective f - simp only [Fin.isValue, ContinuousLinearEquiv.symm_apply_apply] - apply timeSliceD.injective - simp only [Fin.isValue, ContinuousLinearEquiv.apply_symm_apply] - exact timeSliceD_derivD_inl f - -lemma timeSliceD_derivD_inr {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] - (i : Fin d) (f : (SpaceTime d) →d[ℝ] M) : - timeSliceD (derivD (Sum.inr i) f) = - Space.spaceDerivD i (timeSliceD f) := by - ext ε - simp [timeSliceD] - rw [derivD_apply, Space.spaceDerivD_apply] - rw [fderivD_apply, fderivD_apply] - simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, neg_inj] - congr 1 - ext x - simp only [compCLMOfContinuousLinearEquiv_apply, Function.comp_apply] - change ((fderivCLM ℝ) ((compCLMOfContinuousLinearEquiv ℝ toTimeAndSpace) ε)) - x (Lorentz.Vector.basis (Sum.inr i)) = ((fderivCLM ℝ) ε) (toTimeAndSpace x) (0, Space.basis i) - trans SpaceTime.deriv (Sum.inr i) ((compCLMOfContinuousLinearEquiv ℝ toTimeAndSpace) ε) x - · rfl - rw [SpaceTime.deriv_sum_inr] - simp [Space.deriv] - change (fderiv ℝ (ε ∘ (fun y => ((toTimeAndSpace x).1, y))) (toTimeAndSpace x).2) _ = _ - rw [fderiv_comp, DifferentiableAt.fderiv_prodMk] - simp only [Prod.mk.eta, fderiv_fun_const, Pi.zero_apply, fderiv_id', - ContinuousLinearMap.coe_comp', Function.comp_apply, ContinuousLinearMap.prod_apply, - ContinuousLinearMap.zero_apply, ContinuousLinearMap.coe_id', id_eq] - congr 1 - simp only [Prod.mk.injEq, true_and] - rw [Space.basis] - simp only [EuclideanSpace.basisFun_apply] - · fun_prop - · fun_prop - · apply Differentiable.differentiableAt - exact SchwartzMap.differentiable ε - · fun_prop - · exact SchwartzMap.differentiable ((compCLMOfContinuousLinearEquiv ℝ toTimeAndSpace) ε) - -lemma timeSliceD_symm_derivD_inr {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] (i : Fin d) - (f : (Time × Space d) →d[ℝ] M) : - (derivD (Sum.inr i) (timeSliceD.symm f)) = - timeSliceD.symm (Space.spaceDerivD i f) := by - obtain ⟨f, rfl⟩ := timeSliceD.surjective f - simp only [ContinuousLinearEquiv.symm_apply_apply] - apply timeSliceD.injective - simp only [ContinuousLinearEquiv.apply_symm_apply] - exact timeSliceD_derivD_inr i f - -end SpaceTime diff --git a/PhysLean/SpaceAndTime/SpaceTime/LorentzAction.lean b/PhysLean/SpaceAndTime/SpaceTime/LorentzAction.lean new file mode 100644 index 000000000..ec55b2f5d --- /dev/null +++ b/PhysLean/SpaceAndTime/SpaceTime/LorentzAction.lean @@ -0,0 +1,204 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +import PhysLean.SpaceAndTime.Space.Derivatives.Basic +/-! + +# Lorentz group actions related to SpaceTime + +## i. Overview + +We already have a Lorentz group action on `SpaceTime d`, in this module +we define the induced action on Schwartz functions and distributions. + +## ii. Key results + +- `schwartzAction` : Defines the action of the Lorentz group on Schwartz functions. +- An instance of `DistribMulAction` for the Lorentz group acting on distributions. + +## iii. Table of contents + +- A. Lorentz group action on Schwartz functions + - A.1. The definition of the action + - A.2. Basic properties of the action + - A.3. Injectivity of the action + - A.4. Surjectivity of the action +- B. Lorentz group action on distributions + - B.1. The SMul instance + - B.2. The DistribMulAction instance + - B.3. The SMulCommClass instance + - B.4. Action as a linear map + +## iv. References + +-/ +noncomputable section + +namespace SpaceTime + +open Manifold +open Matrix +open Complex +open ComplexConjugate +open TensorSpecies +open SchwartzMap +attribute [-simp] Fintype.sum_sum_type + +/-! + +## A. Lorentz group action on Schwartz functions + +-/ + +/-! + +### A.1. The definition of the action + +-/ + +/-- The Lorentz group action on Schwartz functions taking the Lorentz group to + continuous linear maps. -/ +def schwartzAction {d} : LorentzGroup d →* 𝓢(SpaceTime d, ℝ) →L[ℝ] 𝓢(SpaceTime d, ℝ) where + toFun Λ := SchwartzMap.compCLM (𝕜 := ℝ) + (Lorentz.Vector.actionCLM Λ⁻¹).hasTemperateGrowth <| by + use 1, ‖Lorentz.Vector.actionCLM Λ‖ + simp only [pow_one] + intro x + obtain ⟨x, rfl⟩ := Lorentz.Vector.actionCLM_surjective Λ x + apply (ContinuousLinearMap.le_opNorm (Lorentz.Vector.actionCLM Λ) x).trans + simp [Lorentz.Vector.actionCLM_apply, mul_add] + map_one' := by + ext η x + simp [Lorentz.Vector.actionCLM_apply] + map_mul' Λ₁ Λ₂ := by + ext η x + simp only [_root_.mul_inv_rev, compCLM_apply, Function.comp_apply, + Lorentz.Vector.actionCLM_apply, ContinuousLinearMap.coe_mul] + rw [SemigroupAction.mul_smul] + +/-! + +### A.2. Basic properties of the action + +-/ + +lemma schwartzAction_mul_apply {d} (Λ₁ Λ₂ : LorentzGroup d) + (η : 𝓢(SpaceTime d, ℝ)) : + schwartzAction Λ₂ (schwartzAction (Λ₁) η) = + schwartzAction (Λ₂ * Λ₁) η := by + simp + +lemma schwartzAction_apply {d} (Λ : LorentzGroup d) + (η : 𝓢(SpaceTime d, ℝ)) (x : SpaceTime d) : + (schwartzAction Λ η) x = η (Λ⁻¹ • x) := rfl + +/-! + +### A.3. Injectivity of the action + +-/ + +lemma schwartzAction_injective {d} (Λ : LorentzGroup d) : + Function.Injective (schwartzAction Λ) := by + intro η1 η2 h + ext x + have h1 : (schwartzAction Λ⁻¹ * schwartzAction Λ) η1 = + (schwartzAction Λ⁻¹ * schwartzAction Λ) η2 := by simp [h] + rw [← map_mul] at h1 + simp at h1 + rw [h1] + +/-! + +### A.4. Surjectivity of the action + +-/ + +lemma schwartzAction_surjective {d} (Λ : LorentzGroup d) : + Function.Surjective (schwartzAction Λ) := by + intro η + use (schwartzAction Λ⁻¹ η) + change (schwartzAction Λ * schwartzAction Λ⁻¹) η = _ + rw [← map_mul] + simp + +/-! + +## B. Lorentz group action on distributions + +-/ +section Distribution + +/-! + +### B.1. The SMul instance + +-/ +variable + {c : Fin n → realLorentzTensor.Color} {M : Type} [NormedAddCommGroup M] + [NormedSpace ℝ M] [Tensorial (realLorentzTensor d) c M] [T2Space M] + +open Distribution +instance : SMul (LorentzGroup d) ((SpaceTime d) →d[ℝ] M) where + smul Λ f := (Tensorial.actionCLM (realLorentzTensor d) Λ) ∘L f ∘L (schwartzAction Λ⁻¹) + +lemma lorentzGroup_smul_dist_apply (Λ : LorentzGroup d) (f : (SpaceTime d) →d[ℝ] M) + (η : 𝓢(SpaceTime d, ℝ)) : (Λ • f) η = Λ • (f (schwartzAction Λ⁻¹ η)) := rfl + +/-! + +### B.2. The DistribMulAction instance + +-/ + +instance : DistribMulAction (LorentzGroup d) ((SpaceTime d) →d[ℝ] M) where + one_smul f := by + ext η + simp [lorentzGroup_smul_dist_apply] + mul_smul Λ₁ Λ₂ f := by + ext η + simp [lorentzGroup_smul_dist_apply, SemigroupAction.mul_smul] + smul_zero Λ := by + ext η + rw [lorentzGroup_smul_dist_apply] + simp + smul_add Λ f1 f2 := by + ext η + simp [ContinuousLinearMap.add_apply, smul_add, lorentzGroup_smul_dist_apply] + +/-! + +### B.3. The SMulCommClass instance + +-/ + +instance : SMulCommClass ℝ (LorentzGroup d) ((SpaceTime d) →d[ℝ] M) where + smul_comm a Λ f := by + ext η + simp [lorentzGroup_smul_dist_apply] + rw [SMulCommClass.smul_comm] + +/-! + +### B.4. Action as a linear map + +-/ + +/-- The Lorentz action on distributions as a linear map. -/ +def distActionLinearMap {d} {M : Type} [NormedAddCommGroup M] + [NormedSpace ℝ M] [Tensorial (realLorentzTensor d) c M] [T2Space M](Λ : LorentzGroup d) : + ((SpaceTime d) →d[ℝ] M) →ₗ[ℝ] ((SpaceTime d) →d[ℝ] M) where + toFun f := Λ • f + map_add' f1 f2 := by + ext η + simp [lorentzGroup_smul_dist_apply, ContinuousLinearMap.add_apply, smul_add] + map_smul' a f := by + ext η + simp [lorentzGroup_smul_dist_apply] + rw [← @smul_comm] +end Distribution +end SpaceTime + +end diff --git a/PhysLean/SpaceAndTime/SpaceTime/TimeSlice.lean b/PhysLean/SpaceAndTime/SpaceTime/TimeSlice.lean index 2b25f14a9..9b1ac246b 100644 --- a/PhysLean/SpaceAndTime/SpaceTime/TimeSlice.lean +++ b/PhysLean/SpaceAndTime/SpaceTime/TimeSlice.lean @@ -3,7 +3,8 @@ Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ -import PhysLean.SpaceAndTime.SpaceTime.Basic +import PhysLean.SpaceAndTime.SpaceTime.Derivatives +import PhysLean.SpaceAndTime.TimeAndSpace.Basic import PhysLean.Meta.Informal.SemiFormal import PhysLean.Mathematics.FDerivCurry /-! @@ -26,9 +27,10 @@ open Space /-- The timeslice of a function `SpaceTime d → M` forming a function `Time → Space d → M`. -/ -def timeSlice {d : ℕ} {M : Type} : (SpaceTime d → M) ≃ (Time → Space d → M) where - toFun f := Function.curry (f ∘ toTimeAndSpace.symm) - invFun f := Function.uncurry f ∘ toTimeAndSpace +def timeSlice {d : ℕ} {M : Type} (c : SpeedOfLight := 1) : + (SpaceTime d → M) ≃ (Time → Space d → M) where + toFun f := Function.curry (f ∘ (toTimeAndSpace c).symm) + invFun f := Function.uncurry f ∘ toTimeAndSpace c left_inv f := by funext x simp @@ -38,28 +40,29 @@ def timeSlice {d : ℕ} {M : Type} : (SpaceTime d → M) ≃ (Time → Space d lemma timeSlice_contDiff {d : ℕ} {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] - {n} (f : SpaceTime d → M) (h : ContDiff ℝ n f) : - ContDiff ℝ n ↿(timeSlice f) := by - change ContDiff ℝ n (f ∘ toTimeAndSpace.symm) + {n} (c : SpeedOfLight) (f : SpaceTime d → M) (h : ContDiff ℝ n f) : + ContDiff ℝ n ↿(timeSlice c f) := by + change ContDiff ℝ n (f ∘ (toTimeAndSpace c).symm) apply ContDiff.comp · exact h - · exact ContinuousLinearEquiv.contDiff toTimeAndSpace.symm + · exact ContinuousLinearEquiv.contDiff (toTimeAndSpace c).symm lemma timeSlice_differentiable {d : ℕ} {M : Type} [NormedAddCommGroup M] - [NormedSpace ℝ M] + [NormedSpace ℝ M] (c : SpeedOfLight) (f : SpaceTime d → M) (h : Differentiable ℝ f) : - Differentiable ℝ ↿(timeSlice f) := by - change Differentiable ℝ (f ∘ toTimeAndSpace.symm) + Differentiable ℝ ↿(timeSlice c f) := by + change Differentiable ℝ (f ∘ (toTimeAndSpace c).symm) apply Differentiable.comp · exact h - · exact ContinuousLinearEquiv.differentiable toTimeAndSpace.symm + · exact ContinuousLinearEquiv.differentiable (toTimeAndSpace c).symm /-- The timeslice of a function `SpaceTime d → M` forming a function `Time → Space d → M`, as a linear equivalence. -/ -def timeSliceLinearEquiv {d : ℕ} {M : Type} [AddCommGroup M] [Module ℝ M] : +def timeSliceLinearEquiv {d : ℕ} {M : Type} [AddCommGroup M] [Module ℝ M] + (c : SpeedOfLight := 1) : (SpaceTime d → M) ≃ₗ[ℝ] (Time → Space d → M) where - toFun := timeSlice - invFun := timeSlice.symm + toFun := timeSlice c + invFun := (timeSlice c).symm map_add' f g := by ext t x simp [timeSlice] @@ -71,13 +74,142 @@ def timeSliceLinearEquiv {d : ℕ} {M : Type} [AddCommGroup M] [Module ℝ M] : right_inv f := by simp lemma timeSliceLinearEquiv_apply {d : ℕ} {M : Type} [AddCommGroup M] [Module ℝ M] - (f : SpaceTime d → M) : timeSliceLinearEquiv f = timeSlice f := by + (c : SpeedOfLight) (f : SpaceTime d → M) : timeSliceLinearEquiv c f = timeSlice c f := by simp [timeSliceLinearEquiv, timeSlice] lemma timeSliceLinearEquiv_symm_apply {d : ℕ} {M : Type} [AddCommGroup M] [Module ℝ M] - (f : Time → Space d → M) : timeSliceLinearEquiv.symm f = timeSlice.symm f := by + (c : SpeedOfLight) (f : Time → Space d → M) : + (timeSliceLinearEquiv c).symm f = (timeSlice c).symm f := by simp [timeSliceLinearEquiv, timeSlice] +/-! + +## B. Time slices of distributions + +-/ +open Distribution SchwartzMap + +/-- The time slice of a distribution on `SpaceTime d` to form a distribution + on `Time × Space d`. -/ +noncomputable def distTimeSlice {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (c : SpeedOfLight := 1) : + ((SpaceTime d) →d[ℝ] M) ≃L[ℝ] ((Time × Space d) →d[ℝ] M) where + toFun f := + f ∘L compCLMOfContinuousLinearEquiv (F := ℝ) ℝ (SpaceTime.toTimeAndSpace c (d := d)) + invFun f := f ∘L compCLMOfContinuousLinearEquiv + (F := ℝ) ℝ (SpaceTime.toTimeAndSpace c (d := d)).symm + left_inv f := by + ext κ + simp only [ContinuousLinearMap.coe_comp', Function.comp_apply] + congr + ext x + simp [compCLMOfContinuousLinearEquiv_apply] + right_inv f := by + ext κ + simp only [ContinuousLinearMap.coe_comp', Function.comp_apply] + congr + ext x + simp + map_add' f1 f2 := by + simp + map_smul' a f := by simp + continuous_toFun := ((compCLMOfContinuousLinearEquiv ℝ (toTimeAndSpace c)).precomp M).continuous + continuous_invFun := + ((compCLMOfContinuousLinearEquiv ℝ (toTimeAndSpace c).symm).precomp M).continuous + +lemma distTimeSlice_apply {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (c : SpeedOfLight) (f : (SpaceTime d) →d[ℝ] M) + (κ : 𝓢(Time × Space d, ℝ)) : distTimeSlice c f κ = + f (compCLMOfContinuousLinearEquiv ℝ (toTimeAndSpace c) κ) := by rfl + +lemma distTimeSlice_symm_apply {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (c : SpeedOfLight) (f : (Time × (Space d)) →d[ℝ] M) + (κ : 𝓢(SpaceTime d, ℝ)) : (distTimeSlice c).symm f κ = + f (compCLMOfContinuousLinearEquiv ℝ (toTimeAndSpace c).symm κ) := by rfl + +/-! + +### B.1. Time slices and derivatives + +-/ + +lemma distTimeSlice_distDeriv_inl {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + {c : SpeedOfLight} + (f : (SpaceTime d) →d[ℝ] M) : + distTimeSlice c (distDeriv (Sum.inl 0) f) = + (1/c.val) • Space.distTimeDeriv (distTimeSlice c f) := by + ext κ + rw [distTimeSlice_apply, distDeriv_apply, fderivD_apply] + simp only [Fin.isValue, one_div, ContinuousLinearMap.coe_smul', Pi.smul_apply] + rw [distTimeDeriv_apply, fderivD_apply, distTimeSlice_apply] + simp only [Fin.isValue, smul_neg, neg_inj] + rw [← map_smul] + congr + ext x + change fderiv ℝ (κ ∘ toTimeAndSpace c) x (Lorentz.Vector.basis (Sum.inl 0)) = + c.val⁻¹ • fderiv ℝ κ (toTimeAndSpace c x) (1, 0) + rw [fderiv_comp] + simp only [toTimeAndSpace_fderiv, Fin.isValue, ContinuousLinearMap.coe_comp', + ContinuousLinearEquiv.coe_coe, Function.comp_apply, smul_eq_mul] + rw [toTimeAndSpace_basis_inl'] + rw [map_smul] + simp only [one_div, smul_eq_mul] + · apply Differentiable.differentiableAt + exact SchwartzMap.differentiable κ + · fun_prop + +lemma distDeriv_inl_distTimeSlice_symm {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + {c : SpeedOfLight} + (f : (Time × Space d) →d[ℝ] M) : + distDeriv (Sum.inl 0) ((distTimeSlice c).symm f) = + (1/c.val) • (distTimeSlice c).symm (Space.distTimeDeriv f) := by + obtain ⟨f, rfl⟩ := (distTimeSlice c).surjective f + simp only [ContinuousLinearEquiv.symm_apply_apply] + apply (distTimeSlice c).injective + simp only [Fin.isValue, one_div, map_smul, ContinuousLinearEquiv.apply_symm_apply] + rw [distTimeSlice_distDeriv_inl] + simp + +lemma distTimeSlice_symm_distTimeDeriv_eq {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + {c : SpeedOfLight} + (f : (Time × Space d) →d[ℝ] M) : + (distTimeSlice c).symm (Space.distTimeDeriv f) = + c.val • distDeriv (Sum.inl 0) ((distTimeSlice c).symm f) := by + rw [distDeriv_inl_distTimeSlice_symm] + simp + +lemma distTimeSlice_distDeriv_inr {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + {c : SpeedOfLight} + (i : Fin d) (f : (SpaceTime d) →d[ℝ] M) : + distTimeSlice c (distDeriv (Sum.inr i) f) = + Space.distSpaceDeriv i (distTimeSlice c f) := by + ext κ + rw [distTimeSlice_apply, distDeriv_apply, fderivD_apply] + rw [distSpaceDeriv_apply, fderivD_apply, distTimeSlice_apply] + simp only [neg_inj] + congr 1 + ext x + change fderiv ℝ (κ ∘ toTimeAndSpace c) x (Lorentz.Vector.basis (Sum.inr i)) = + fderiv ℝ κ (toTimeAndSpace c x) (0, Space.basis i) + rw [fderiv_comp] + simp only [toTimeAndSpace_fderiv, ContinuousLinearMap.coe_comp', ContinuousLinearEquiv.coe_coe, + Function.comp_apply] + rw [toTimeAndSpace_basis_inr] + · apply Differentiable.differentiableAt + exact SchwartzMap.differentiable κ + · fun_prop + +lemma distDeriv_inr_distTimeSlice_symm {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + {c : SpeedOfLight} + (i : Fin d) (f : (Time × Space d) →d[ℝ] M) : + distDeriv (Sum.inr i) ((distTimeSlice c).symm f) = + (distTimeSlice c).symm (Space.distSpaceDeriv i f) := by + obtain ⟨f, rfl⟩ := (distTimeSlice c).surjective f + simp only [ContinuousLinearEquiv.symm_apply_apply] + apply (distTimeSlice c).injective + simp only [ContinuousLinearEquiv.apply_symm_apply] + rw [distTimeSlice_distDeriv_inr] + end SpaceTime end diff --git a/PhysLean/SpaceAndTime/Time/Basic.lean b/PhysLean/SpaceAndTime/Time/Basic.lean index 8b1cd9b5a..a700d8292 100644 --- a/PhysLean/SpaceAndTime/Time/Basic.lean +++ b/PhysLean/SpaceAndTime/Time/Basic.lean @@ -3,13 +3,12 @@ Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ -import PhysLean.Meta.Informal.Basic -import Mathlib.MeasureTheory.Measure.Haar.InnerProductSpace -import Mathlib.Topology.ContinuousMap.CompactlySupported -import Mathlib.Geometry.Manifold.IsManifold.Basic +import PhysLean.SpaceAndTime.Space.Basic /-! # Time +## i. Overview + In this module we define the type `Time`, corresponding to time in a given (but arbitrary) set of units, with a given (but arbitrary) choice of origin (time zero), and a choice of orientation (i.e. a positive time direction). @@ -33,6 +32,38 @@ Within other modules e.g. `TimeMan` and `TimeTransMan`, we define versions of time with less choices made, and relate them to `Time` via a choice of units or origin. +## ii. Key results + +- `Time` : The type representing time with a choice of units and origin. + +## iii. Table of contents + +- A. The definition of `Time` +- B. Instances on Time + - B.1. Natural numbers as elements of `Time` + - B.2. Real numbers as elements of `Time` + - B.3. Time is inhabited + - B.4. The order on `Time` + - B.5. Addition of times + - B.6. Negation of times + - B.7. Subtraction of times + - B.8. Scalar multiplication of time + - B.9. Module on `Time` + - B.10. Norm of time + - B.11. Inner product on `Time` + - B.12. Decidability of `Time` + - B.13. Measurability of `Time` +- C. Basis of `Time` +- D. Maps from `Time` to `ℝ` + +## iv. References + +-/ + +/-! + +## A. The definition of `Time` + -/ /-- The type `Time` represents the time in a given (but arbitrary) set of units, and @@ -49,6 +80,18 @@ lemma val_injective : Function.Injective val := by ext exact h +/-! + +## B. Instances on Time + +-/ + +/-! + +### B.1. Natural numbers as elements of `Time` + +-/ + instance : NatCast Time where natCast n := ⟨n⟩ @@ -57,21 +100,6 @@ instance : NatCast Time where instance {n : ℕ} : OfNat Time n where ofNat := ⟨n⟩ -instance : Coe ℝ Time where - coe r := ⟨r⟩ - -lemma realCast_val {r : ℝ} : (r : Time).val = r := rfl - -instance : Inhabited Time where - default := 0 - -@[simp] -lemma default_eq_zero : default = 0 := rfl - -/-! -## Coercions --/ - @[simp] lemma natCast_val {n : ℕ} : val n = n := rfl @@ -89,13 +117,6 @@ lemma one_ne_zero : (1 : Time) ≠ (0 : Time) := by rw [Time.ext_iff, ofNat_val, ofNat_val] at h norm_cast at h -@[simp] -lemma realCast_of_natCast {n : ℕ} : ((n : ℝ) : Time) = n := rfl - -/-! -## The choice of zero, one, and orientation --/ - @[simp] lemma zero_val : val 0 = 0 := by rw [ofNat_val] @@ -114,6 +135,41 @@ lemma one_val : val 1 = 1 := by lemma eq_one_iff (t : Time) : t = 1 ↔ t.val = 1 := by aesop +/-! + +### B.2. Real numbers as elements of `Time` + +-/ + +instance : Coe ℝ Time where + coe r := ⟨r⟩ + +instance : Coe Time ℝ where + coe := Time.val + +lemma realCast_val {r : ℝ} : (r : Time).val = r := rfl + +@[simp] +lemma realCast_of_natCast {n : ℕ} : ((n : ℝ) : Time) = n := rfl + +/-! + +### B.3. Time is inhabited + +-/ + +instance : Inhabited Time where + default := 0 + +@[simp] +lemma default_eq_zero : default = 0 := rfl + +/-! + +### B.4. The order on `Time` + +-/ + /-- The choice of an orientation on `Time`. -/ instance : LE Time where le t1 t2 := t1.val ≤ t2.val @@ -121,8 +177,25 @@ instance : LE Time where lemma le_def (t1 t2 : Time) : t1 ≤ t2 ↔ t1.val ≤ t2.val := Iff.rfl +instance : PartialOrder Time where + le_refl t := by simp [le_def] + le_trans t1 t2 t3 := by simp [le_def]; exact le_trans + le_antisymm t1 t2 h1 h2 := by simp_all [le_def]; ext; exact le_antisymm h1 h2 + +lemma lt_def (t1 t2 : Time) : + t1 < t2 ↔ t1.val < t2.val := by + constructor + · intro h + exact lt_iff_le_not_ge.mpr h + · intro h + apply lt_iff_le_not_ge.mpr + simp_all [le_def] + apply le_of_lt h + /-! -## Basic operations on `Time`. + +### B.5. Addition of times + -/ instance : Add Time where @@ -132,6 +205,12 @@ instance : Add Time where lemma add_val (t1 t2 : Time) : (t1 + t2).val = t1.val + t2.val := rfl +/-! + +### B.6. Negation of times + +-/ + instance : Neg Time where neg t := ⟨-t.val⟩ @@ -139,6 +218,12 @@ instance : Neg Time where lemma neg_val (t : Time) : (-t).val = -t.val := rfl +/-! + +### B.7. Subtraction of times + +-/ + instance : Sub Time where sub t1 t2 := ⟨t1.val - t2.val⟩ @@ -146,6 +231,12 @@ instance : Sub Time where lemma sub_val (t1 t2 : Time) : (t1 - t2).val = t1.val - t2.val := rfl +/-! + +### B.8. Scalar multiplication of time + +-/ + instance : SMul ℝ Time where smul k t := ⟨k * t.val⟩ @@ -153,30 +244,9 @@ instance : SMul ℝ Time where lemma smul_real_val (k : ℝ) (t : Time) : (k • t).val = k * t.val := rfl -instance : Norm Time where - norm t := ‖t.val‖ - -instance : Dist Time where - dist t1 t2 := ‖t1 - t2‖ - -lemma dist_eq_val (t1 t2 : Time) : - dist t1 t2 = ‖t1.val - t2.val‖ := rfl - -lemma dist_eq_real_dist (t1 t2 : Time) : - dist t1 t2 = dist t1.val t2.val := by rfl - -open InnerProductSpace - -instance : Inner ℝ Time where - inner t1 t2 := t1.val * t2.val - -@[simp] -lemma inner_def (t1 t2 : Time) : - ⟪t1, t2⟫_ℝ = t1.val * t2.val := rfl - /-! -## Instances on `Time`. +### B.9. Module on `Time` -/ @@ -199,6 +269,24 @@ instance : Module ℝ Time where mul_smul k1 k2 t := by ext; simp [mul_assoc] zero_smul t := by ext; simp +/-! + +### B.10. Norm of time + +-/ + +instance : Norm Time where + norm t := ‖t.val‖ + +instance : Dist Time where + dist t1 t2 := ‖t1 - t2‖ + +lemma dist_eq_val (t1 t2 : Time) : + dist t1 t2 = ‖t1.val - t2.val‖ := rfl + +lemma dist_eq_real_dist (t1 t2 : Time) : + dist t1 t2 = dist t1.val t2.val := by rfl + instance : SeminormedAddCommGroup Time where dist_self t := by simp [dist_eq_real_dist] dist_comm t1 t2 := by simp [dist_eq_real_dist, dist_comm] @@ -215,31 +303,95 @@ instance : NormedAddCommGroup Time where instance : NormedSpace ℝ Time where norm_smul_le k t := by simp [abs_mul, norm] -instance : PartialOrder Time where - le_refl t := by simp [le_def] - le_trans t1 t2 t3 := by simp [le_def]; exact le_trans - le_antisymm t1 t2 h1 h2 := by simp_all [le_def]; ext; exact le_antisymm h1 h2 +/-! -lemma lt_def (t1 t2 : Time) : - t1 < t2 ↔ t1.val < t2.val := by - constructor - · intro h - exact lt_iff_le_not_ge.mpr h - · intro h - apply lt_iff_le_not_ge.mpr - simp_all [le_def] - apply le_of_lt h +### B.11. Inner product on `Time` + +-/ + +open InnerProductSpace + +instance : Inner ℝ Time where + inner t1 t2 := t1.val * t2.val + +@[simp] +lemma inner_def (t1 t2 : Time) : + ⟪t1, t2⟫_ℝ = t1.val * t2.val := rfl + +noncomputable instance : InnerProductSpace ℝ Time where + norm_sq_eq_re_inner := by intros; simp [norm]; ring + conj_inner_symm := by intros; simp [inner_def]; ring + add_left := by intros; simp [inner_def, add_mul] + smul_left := by intros; simp [inner_def]; ring + +/-! + +### B.12. Decidability of `Time` + +-/ noncomputable instance : DecidableEq Time := fun t1 t2 => decidable_of_iff (t1.val = t2.val) (Time.ext_iff.symm) +/-! + +### B.13. Measurability of `Time` + +-/ instance : MeasurableSpace Time := borel Time instance : BorelSpace Time where measurable_eq := by rfl -instance : FiniteDimensional ℝ Time := by - refine Module.finite_of_rank_eq_one ?_ +/-! + +## C. Basis of `Time` + +-/ +open MeasureTheory + +/-- The orthonomral basis on `Time` defined by `1`. -/ +noncomputable def basis : OrthonormalBasis (Fin 1) ℝ Time where + repr := { + toFun := fun x => WithLp.toLp 2 (fun _ => x) + invFun := fun f => ⟨f 0⟩ + left_inv := by + intro x + rfl + right_inv := by + intro f + ext i + fin_cases i + rfl + map_add' := by + intro f g + ext i + fin_cases i + rfl + map_smul' := by + intro c f + ext i + fin_cases i + rfl + norm_map' := by + intro x + simp only [Fin.isValue, LinearEquiv.coe_mk, LinearMap.coe_mk, AddHom.coe_mk] + rw [@PiLp.norm_eq_of_L2] + simp only [Finset.univ_unique, Fin.default_eq_zero, Fin.isValue, Real.norm_eq_abs, sq_abs, + Finset.sum_const, Finset.card_singleton, one_smul] + rw [Real.sqrt_sq_eq_abs] + rfl + } + +@[simp] +lemma basis_apply_eq_one (i : Fin 1) : + basis i = 1 := by + fin_cases i + simp [basis] + rfl + +@[simp] +lemma rank_eq_one : Module.rank ℝ Time = 1 := by rw [@rank_eq_one_iff] use 1 constructor @@ -249,20 +401,31 @@ instance : FiniteDimensional ℝ Time := by ext simp [one_val] -noncomputable instance : InnerProductSpace ℝ Time where - norm_sq_eq_re_inner := by intros; simp [norm]; ring - conj_inner_symm := by intros; simp [inner_def]; ring - add_left := by intros; simp [inner_def, add_mul] - smul_left := by intros; simp [inner_def]; ring +@[simp] +lemma finRank_eq_one : Module.finrank ℝ Time = 1 := by + rw [@finrank_eq_one_iff'] + use 1 + constructor + · simp + · intro v + use v.val + ext + simp [one_val] + +instance : FiniteDimensional ℝ Time := by + refine Module.finite_of_rank_eq_one ?_ + simp + +lemma volume_eq_basis_addHaar : + (volume (α := Time)) = basis.toBasis.addHaar := by + exact (OrthonormalBasis.addHaar_eq_volume _).symm /-! -## Maps from `Time` to `ℝ`. +## D. Maps from `Time` to `ℝ` -/ -open MeasureTheory - /-- The continuous linear map from `Time` to `ℝ`. -/ noncomputable def toRealCLM : Time →L[ℝ] ℝ := LinearMap.toContinuousLinearMap { @@ -293,9 +456,6 @@ noncomputable def toRealLIE : Time ≃ₗᵢ[ℝ] ℝ where simp rfl -instance : Coe Time ℝ where - coe := Time.val - lemma eq_one_smul (t : Time) : t = t.val • 1 := by ext @@ -312,43 +472,12 @@ lemma val_measurableEmbedding : MeasurableEmbedding Time.val where measurableSet_image' := by intro s hs change MeasurableSet (⇑toRealCLE '' s) - rw [ContinuousLinearEquiv.image_eq_preimage] + rw [ContinuousLinearEquiv.image_eq_preimage_symm] exact toRealCLE.symm.continuous.measurable hs lemma val_measurePreserving : MeasurePreserving Time.val volume volume := LinearIsometryEquiv.measurePreserving toRealLIE -/-! - -## Derivatives - --/ - -variable {M : Type} {d : ℕ} {t : Time} - -/-- Given a function `f : Time → M` the derivative of `f`. -/ -noncomputable def deriv [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] - (f : Time → M) : Time → M := - (fun t => fderiv ℝ f t 1) - -@[inherit_doc deriv] -scoped notation "∂ₜ" => deriv - -lemma deriv_eq [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] - (f : Time → M) (t : Time) : Time.deriv f t = fderiv ℝ f t 1 := rfl - -lemma deriv_smul (f : Time → EuclideanSpace ℝ (Fin d)) (k : ℝ) - (hf : Differentiable ℝ f) : - ∂ₜ (fun t => k • f t) t = k • ∂ₜ (fun t => f t) t := by - rw [deriv, fderiv_fun_const_smul] - rfl - fun_prop - -lemma deriv_neg [NormedAddCommGroup M] [NormedSpace ℝ M] (f : Time → M) : - ∂ₜ (-f) t = -∂ₜ f t := by - rw [deriv, fderiv_neg] - rfl - @[fun_prop] lemma val_differentiable : Differentiable ℝ Time.val := by change Differentiable ℝ toRealCLM @@ -360,38 +489,4 @@ lemma fderiv_val (t : Time) : fderiv ℝ Time.val t 1 = 1 := by rw [ContinuousLinearMap.fderiv, toRealCLM] simp -open MeasureTheory ContDiff InnerProductSpace Time - -@[fun_prop] -lemma deriv_differentiable_of_contDiff {M : Type} - [NormedAddCommGroup M] [NormedSpace ℝ M] (f : Time → M) (hf : ContDiff ℝ ∞ f) : - Differentiable ℝ (∂ₜ f) := by - unfold deriv - change Differentiable ℝ ((fun x => x 1) ∘ (fun t => fderiv ℝ f t)) - apply Differentiable.comp - · fun_prop - · rw [contDiff_infty_iff_fderiv, contDiff_infty_iff_fderiv] at hf - exact hf.2.1 - -@[fun_prop] -lemma deriv_contDiff_of_contDiff {M : Type} - [NormedAddCommGroup M] [NormedSpace ℝ M] (f : Time → M) (hf : ContDiff ℝ ∞ f) : - ContDiff ℝ ∞ (∂ₜ f) := by - unfold deriv - change ContDiff ℝ ∞ ((fun x => x 1) ∘ (fun t => fderiv ℝ f t)) - apply ContDiff.comp - · fun_prop - · fun_prop - -lemma deriv_euclid { μ} {f : Time→ EuclideanSpace ℝ (Fin n)} - (hf : Differentiable ℝ f) (t : Time) : - deriv (fun t => f t μ) t = deriv (fun t => f t) t μ := by - rw [deriv_eq] - change fderiv ℝ (EuclideanSpace.proj μ ∘ fun x => f x) t 1 = _ - rw [fderiv_comp] - · simp - rw [← deriv_eq] - · fun_prop - · fun_prop - end Time diff --git a/PhysLean/SpaceAndTime/Time/Derivatives.lean b/PhysLean/SpaceAndTime/Time/Derivatives.lean new file mode 100644 index 000000000..cff90407e --- /dev/null +++ b/PhysLean/SpaceAndTime/Time/Derivatives.lean @@ -0,0 +1,154 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +import PhysLean.SpaceAndTime.SpaceTime.Basic +/-! + +# Time Derivatives + +## i. Overview + +In this module we define and prove basic lemmas about derivatives of functions on `Time`. + +## ii. Key results + +- `deriv` : The derivative of a function `Time → M` at a given time. + +## iii. Table of contents + +- A. The definition of the derivative +- B. Linearlity properties of the derivative +- C. Derivative of constant functions +- D. Smoothness properties of the derivative +- E. Derivatives of components + +## iv. References + +-/ + +namespace Time + +variable {M : Type} {d : ℕ} {t : Time} + +/-! + +## A. The definition of the derivative + +-/ +/-- Given a function `f : Time → M` the derivative of `f`. -/ +noncomputable def deriv [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] + (f : Time → M) : Time → M := + (fun t => fderiv ℝ f t 1) + +@[inherit_doc deriv] +scoped notation "∂ₜ" => deriv + +lemma deriv_eq [AddCommGroup M] [Module ℝ M] [TopologicalSpace M] + (f : Time → M) (t : Time) : Time.deriv f t = fderiv ℝ f t 1 := rfl + +/-! + +## B. Linearlity properties of the derivative + +-/ + +lemma deriv_smul (f : Time → EuclideanSpace ℝ (Fin d)) (k : ℝ) + (hf : Differentiable ℝ f) : + ∂ₜ (fun t => k • f t) t = k • ∂ₜ (fun t => f t) t := by + rw [deriv, fderiv_fun_const_smul] + rfl + fun_prop + +lemma deriv_neg [NormedAddCommGroup M] [NormedSpace ℝ M] (f : Time → M) : + ∂ₜ (-f) t = -∂ₜ f t := by + rw [deriv, fderiv_neg] + rfl + +/-! + +## C. Derivative of constant functions + +-/ + +@[simp] +lemma deriv_const [NormedAddCommGroup M] [NormedSpace ℝ M] (m : M) : + ∂ₜ (fun _ => m) t = 0 := by + rw [deriv] + simp + +/-! + +## D. Smoothness properties of the derivative + +-/ + +open MeasureTheory ContDiff InnerProductSpace Time + +@[fun_prop] +lemma deriv_differentiable_of_contDiff {M : Type} + [NormedAddCommGroup M] [NormedSpace ℝ M] (f : Time → M) (hf : ContDiff ℝ ∞ f) : + Differentiable ℝ (∂ₜ f) := by + unfold deriv + change Differentiable ℝ ((fun x => x 1) ∘ (fun t => fderiv ℝ f t)) + apply Differentiable.comp + · fun_prop + · rw [contDiff_infty_iff_fderiv, contDiff_infty_iff_fderiv] at hf + exact hf.2.1 + +@[fun_prop] +lemma deriv_contDiff_of_contDiff {M : Type} + [NormedAddCommGroup M] [NormedSpace ℝ M] (f : Time → M) (hf : ContDiff ℝ ∞ f) : + ContDiff ℝ ∞ (∂ₜ f) := by + unfold deriv + change ContDiff ℝ ∞ ((fun x => x 1) ∘ (fun t => fderiv ℝ f t)) + apply ContDiff.comp + · fun_prop + · fun_prop + +/-! + +## E. Derivatives of components + +-/ + +lemma differentiable_euclid {f : Time → EuclideanSpace ℝ (Fin n)} + (hf : ∀ i, Differentiable ℝ (fun t => f t i)) : + Differentiable ℝ f := by + rw [differentiable_euclidean] + fun_prop + +lemma deriv_euclid { μ} {f : Time→ EuclideanSpace ℝ (Fin n)} + (hf : Differentiable ℝ f) (t : Time) : + deriv (fun t => f t μ) t = deriv (fun t => f t) t μ := by + rw [deriv_eq] + change fderiv ℝ (EuclideanSpace.proj μ ∘ fun x => f x) t 1 = _ + rw [fderiv_comp] + · simp + rw [← deriv_eq] + · fun_prop + · fun_prop + +lemma fderiv_euclid { μ} {f : Time→ EuclideanSpace ℝ (Fin n)} + (hf : Differentiable ℝ f) (t dt : Time) : + fderiv ℝ (fun t => f t μ) t dt = fderiv ℝ (fun t => f t) t dt μ := by + change fderiv ℝ (EuclideanSpace.proj μ ∘ fun x => f x) t dt = _ + rw [fderiv_comp] + · simp + · fun_prop + · fun_prop + +lemma deriv_lorentzVector {d : ℕ} {f : Time → Lorentz.Vector d} + (hf : Differentiable ℝ f) (t : Time) (i : Fin 1 ⊕ Fin d) : + deriv (fun t => f t i) t = deriv (fun t => f t) t i := by + rw [deriv_eq] + change fderiv ℝ (Lorentz.Vector.coordCLM i ∘ fun x => f x) t 1 = _ + rw [fderiv_comp] + · simp + rw [← deriv_eq] + rfl + · fun_prop + · fun_prop + +end Time diff --git a/PhysLean/SpaceAndTime/Time/TimeTransMan.lean b/PhysLean/SpaceAndTime/Time/TimeTransMan.lean index 05fa5b3eb..8847d7eda 100644 --- a/PhysLean/SpaceAndTime/Time/TimeTransMan.lean +++ b/PhysLean/SpaceAndTime/Time/TimeTransMan.lean @@ -3,6 +3,7 @@ Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ +import PhysLean.SpaceAndTime.Time.Derivatives import PhysLean.SpaceAndTime.Time.TimeUnit /-! @@ -225,7 +226,7 @@ lemma diff_eq_val (x : TimeUnit) (t1 t2 : TimeTransMan) : · simp [diff, dist, h] simp [le_def] at h rw [abs_of_neg] - have hx : x.val ≠ 0 := x.val_neq_zero + have hx : x.val ≠ 0 := x.val_ne_zero field_simp linarith @@ -267,7 +268,7 @@ lemma diff_fst_surjective (x : TimeUnit) (t : TimeTransMan) : use x.1 * r +ᵥ t simp [abs_mul] rw [abs_of_nonneg (le_of_lt x.val_pos)] - simp only [ne_eq, TimeUnit.val_neq_zero, not_false_eq_true, inv_mul_cancel_left₀] + simp only [ne_eq, TimeUnit.val_ne_zero, not_false_eq_true, inv_mul_cancel_left₀] by_cases h : 0 ≤ r · rw [if_pos] exact abs_of_nonneg h @@ -335,7 +336,6 @@ lemma neg_eq_negMetric (zero : TimeTransMan) (x : TimeUnit) (t : TimeTransMan) : ### The map from TimeTransMan to Time -/ - /-- With a choice of zero `zero : TimeTransMan` and a choice of units `x : TimeUnit`, `toTime` is the homeomorphism between the type `TimeTransMan` and `Time`. -/ noncomputable def toTime (zero : TimeTransMan) (x : TimeUnit) : TimeTransMan ≃ₜ Time where @@ -354,7 +354,13 @@ noncomputable def toTime (zero : TimeTransMan) (x : TimeUnit) : TimeTransMan ≃ ext simp [valHomeomorphism, addTime_val] rw [h1] - fun_prop + · apply Continuous.add + · apply Continuous.fun_mul + · fun_prop + · apply Differentiable.continuous (𝕜 := ℝ) + fun_prop + · fun_prop + continuous_toFun := by rw [← Homeomorph.comp_continuous_iff Time.toRealCLE.toHomeomorph] have h1 : (⇑Time.toRealCLE.toHomeomorph ∘ (fun t => ⟨diff x t zero⟩)) = fun t => diff --git a/PhysLean/SpaceAndTime/Time/TimeUnit.lean b/PhysLean/SpaceAndTime/Time/TimeUnit.lean index 3ed20d945..e126364f0 100644 --- a/PhysLean/SpaceAndTime/Time/TimeUnit.lean +++ b/PhysLean/SpaceAndTime/Time/TimeUnit.lean @@ -20,8 +20,8 @@ ratio of the two scales of time unit. We define `HasTimeDimension` to be a property of a function from `TimeUnit` to a type `M` which is a function that scales with the time unit with respect to the rational power `d`. -To define specific time units, we first axiomise the existence of a -a given time unit, and then construct all other time units from it. We choose to axiomise the +To define specific time units, we first state the existence of a +a given time unit, and then construct all other time units from it. We choose to state the existence of the time unit of seconds, and construct all other time units from that. -/ @@ -38,7 +38,7 @@ structure TimeUnit : Type where namespace TimeUnit @[simp] -lemma val_neq_zero (x : TimeUnit) : x.val ≠ 0 := by +lemma val_ne_zero (x : TimeUnit) : x.val ≠ 0 := by exact Ne.symm (ne_of_lt x.property) lemma val_pos (x : TimeUnit) : 0 < x.val := x.property @@ -59,7 +59,7 @@ lemma div_eq_val (x y : TimeUnit) : x / y = (⟨x.val / y.val, div_nonneg (le_of_lt x.val_pos) (le_of_lt y.val_pos)⟩ : ℝ≥0) := rfl @[simp] -lemma div_neq_zero (x y : TimeUnit) : ¬ x / y = (0 : ℝ≥0) := by +lemma div_ne_zero (x y : TimeUnit) : ¬ x / y = (0 : ℝ≥0) := by rw [div_eq_val] refine coe_ne_zero.mp ?_ simp @@ -68,12 +68,12 @@ lemma div_neq_zero (x y : TimeUnit) : ¬ x / y = (0 : ℝ≥0) := by lemma div_pos (x y : TimeUnit) : (0 : ℝ≥0) < x/ y := by apply lt_of_le_of_ne · exact zero_le (x / y) - · exact Ne.symm (div_neq_zero x y) + · exact Ne.symm (div_ne_zero x y) @[simp] lemma div_self (x : TimeUnit) : x / x = (1 : ℝ≥0) := by - simp [div_eq_val, x.val_neq_zero] + simp [div_eq_val, x.val_ne_zero] lemma div_symm (x y : TimeUnit) : x / y = (y / x)⁻¹ := NNReal.eq <| by @@ -129,16 +129,16 @@ lemma scale_scale (x : TimeUnit) (r1 r2 : ℝ) (hr1 : 0 < r1) (hr2 : 0 < r2) : ## Specific choices of time units -To define a specific time units, we must first axiomise the existence of a -a given time unit, and then construct all other time units from it. -We choose to axiomise the existence of the time unit of seconds. - -We need an axiom since this relates something to something in the physical world. +To define a specific time units. +We first define the notion of a second to correspond to the length unit with underlying value +equal to `1`. This is really down to a choice in the isomorphism between the set of metrics +on the time manifold and the positive reals. +From this choice of second, we can define other length units by scaling second. -/ -/-- The axiom corresponding to the definition of a time unit of seconds. -/ -axiom seconds : TimeUnit +/-- The definition of a time unit of seconds. -/ +def seconds : TimeUnit := ⟨1, by norm_num⟩ /-- The time unit of femtoseconds (10⁻¹⁵ of a second). -/ noncomputable def femtoseconds : TimeUnit := scale ((1/10) ^ (15)) seconds diff --git a/PhysLean/SpaceAndTime/TimeAndSpace/Basic.lean b/PhysLean/SpaceAndTime/TimeAndSpace/Basic.lean new file mode 100644 index 000000000..5c678ce8b --- /dev/null +++ b/PhysLean/SpaceAndTime/TimeAndSpace/Basic.lean @@ -0,0 +1,616 @@ +/- +Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhi Kai Pong, Joseph Tooby-Smith +-/ +import PhysLean.SpaceAndTime.Space.Derivatives.Curl +/-! + +# Functions and distributions on Time and Space d + +## i. Overview + +In this module we define and prove basic lemmas about derivatives of functions and +distributions on both `Time` and `Space d`. + +We put these results in the namespace `Space` by convention. + +## ii. Key results + +- `distTimeDeriv` : The derivative of a distribution on `Time × Space d` along the + temporal coordinate. +- `distSpaceDeriv` : The derivative of a distribution on `Time × Space d` along the + spatial `i` coordinate. +- `distSpaceGrad` : The spatial gradient of a distribution on `Time × Space d`. +- `distSpaceDiv` : The spatial divergence of a distribution on `Time × Space d`. +- `distSpaceCurl` : The spatial curl of a distribution on `Time × Space 3`. + +## iii. Table of contents + +- A. Derivatives involving time and space + - A.1. Space and time derivatives in terms of curried functions + - A.2. Commuting time and space derivatives + - A.3. Differentiablity conditions + - A.4. Time derivative commute with curl + - A.5. Constant of time deriative and space derivatives zero + - A.6. Equal up to a constant of time and space derivatives equal +- B. Derivatives of distributions on Time × Space d + - B.1. Time derivatives + - B.1.1. Composition with a CLM + - B.2. Space derivatives + - B.2.1. Space derivatives commute + - B.2.2. Composition with a CLM + - B.3. Time and space derivatives commute + - B.4. The spatial gradient + - B.5. The spatial divergence + - B.6. The spatial curl + +## iv. References + +-/ +namespace Space + +/-! + +## A. Derivatives involving time and space + +-/ + +/-! + +### A.1. Space and time derivatives in terms of curried functions + +-/ + +lemma fderiv_space_eq_fderiv_curry {M} [NormedAddCommGroup M] [NormedSpace ℝ M] + (f : Time → Space d → M) (t : Time) (x dx : Space d) + (hf : Differentiable ℝ ↿f) : + fderiv ℝ (fun x' => f t x') x dx = fderiv ℝ ↿f (t, x) (0, dx) := by + change fderiv ℝ (↿f ∘ fun x' => (t, x')) x dx = _ + rw [fderiv_comp] + simp only [ContinuousLinearMap.coe_comp', Function.comp_apply] + rw [DifferentiableAt.fderiv_prodMk] + simp only [fderiv_fun_const, Pi.zero_apply, fderiv_id', ContinuousLinearMap.prod_apply, + ContinuousLinearMap.zero_apply, ContinuousLinearMap.coe_id', id_eq] + repeat' fun_prop + +lemma fderiv_time_eq_fderiv_curry {M} [NormedAddCommGroup M] [NormedSpace ℝ M] + (f : Time → Space d → M) (t dt : Time) (x : Space d) + (hf : Differentiable ℝ ↿f) : + fderiv ℝ (fun t' => f t' x) t dt = fderiv ℝ ↿f (t, x) (dt, 0) := by + change fderiv ℝ (↿f ∘ fun t' => (t', x)) t dt = _ + rw [fderiv_comp] + simp only [ContinuousLinearMap.coe_comp', Function.comp_apply] + rw [DifferentiableAt.fderiv_prodMk] + simp only [fderiv_id', fderiv_fun_const, Pi.zero_apply, ContinuousLinearMap.prod_apply, + ContinuousLinearMap.coe_id', id_eq, ContinuousLinearMap.zero_apply] + repeat' fun_prop + +/-! + +### A.2. Commuting time and space derivatives + +-/ + +/-- Derivatives along space coordinates and time commute. -/ +lemma fderiv_time_commute_fderiv_space {M} [NormedAddCommGroup M] [NormedSpace ℝ M] + (f : Time → Space d → M) (t dt : Time) (x dx : Space d) + (hf : ContDiff ℝ 2 ↿f) : + fderiv ℝ (fun t' => fderiv ℝ (fun x' => f t' x') x dx) t dt + = fderiv ℝ (fun x' => fderiv ℝ (fun t' => f t' x') t dt) x dx := by + trans fderiv ℝ (fun t' => (fderiv ℝ (↿f) (t', x) (0, dx))) t dt + · congr + funext t' + apply fderiv_space_eq_fderiv_curry + exact hf.differentiable (by simp) + trans fderiv ℝ (fun x => (fderiv ℝ (↿f) x (0, dx))) (t, x) (dt, 0) + · let f' : Time → Space d → M := fun t x => fderiv ℝ (↿f) (t, x) (0, dx) + change (fderiv ℝ (fun t' => f' t' x) t) dt = _ + rw [fderiv_time_eq_fderiv_curry] + rfl + fun_prop + symm + trans fderiv ℝ (fun x' => (fderiv ℝ (↿f) (t, x') (dt, 0))) x dx + · congr + funext x' + apply fderiv_time_eq_fderiv_curry + exact hf.differentiable (by simp) + trans fderiv ℝ (fun t => (fderiv ℝ (↿f) t (dt, 0))) (t, x) (0, dx) + · let f'' : Time → Space d → M := fun t x => fderiv ℝ (↿f) (t, x) (dt, 0) + change (fderiv ℝ (fun x' => f'' t x') x) dx = _ + rw [fderiv_space_eq_fderiv_curry] + rfl + fun_prop + rw [fderiv_clm_apply, fderiv_clm_apply] + simp only [fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.comp_zero, zero_add, + ContinuousLinearMap.flip_apply] + rw [IsSymmSndFDerivAt.eq] + · apply ContDiffAt.isSymmSndFDerivAt + apply ContDiff.contDiffAt + exact hf + simp + repeat' fun_prop + +lemma time_deriv_comm_space_deriv {d i} {M} [NormedAddCommGroup M] [NormedSpace ℝ M] + {f : Time → Space d → M} (hf : ContDiff ℝ 2 ↿f) (t : Time) (x : Space d) : + Time.deriv (fun t' => Space.deriv i (f t') x) t + = Space.deriv i (fun x' => Time.deriv (fun t' => f t' x') t) x := by + simp only [Time.deriv_eq, Space.deriv_eq_fderiv_basis] + exact fderiv_time_commute_fderiv_space f t 1 x (Space.basis i) hf + +/-! + +### A.3. Differentiablity conditions + +-/ + +@[fun_prop] +lemma space_deriv_differentiable_time {d i} {M} [NormedAddCommGroup M] [NormedSpace ℝ M] + {f : Time → Space d → M} (hf : ContDiff ℝ 2 ↿f) (x : Space d) : + Differentiable ℝ (fun t => Space.deriv i (f t) x) := by + conv => + enter [2, t]; + rw [Space.deriv_eq_fderiv_basis] + apply Differentiable.clm_apply + · have hdd : Differentiable ℝ ↿f := hf.differentiable (by simp) + have h1 (t : Time) : fderiv ℝ (fun x => f t x) x + = fderiv ℝ (↿f) (t, x) ∘L (ContinuousLinearMap.inr ℝ Time (Space d)) := by + ext w + simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, ContinuousLinearMap.inr_apply] + rw [← fderiv_space_eq_fderiv_curry f t x w hdd] + conv => + enter [2, y] + change fderiv ℝ (fun x => f y x) x + rw [h1] + fun_prop + · fun_prop + +@[fun_prop] +lemma time_deriv_differentiable_space {d } {M} [NormedAddCommGroup M] [NormedSpace ℝ M] + {f : Time → Space d → M} (hf : ContDiff ℝ 2 ↿f) (t : Time) : + Differentiable ℝ (fun x => Time.deriv (f · x) t) := by + conv => + enter [2, x]; + rw [Time.deriv_eq] + apply Differentiable.clm_apply + · have hdd : Differentiable ℝ ↿f := hf.differentiable (by simp) + have h1 (x : Space d) : fderiv ℝ (fun t => f t x) t + = fderiv ℝ (↿f) (t, x) ∘L (ContinuousLinearMap.inl ℝ Time (Space d)) := by + ext w + simp only [ContinuousLinearMap.coe_comp', Function.comp_apply, ContinuousLinearMap.inl_apply] + rw [← fderiv_time_eq_fderiv_curry f t w x hdd] + conv => + enter [2, t'] + change fderiv ℝ (fun x => f x t') t + rw [h1] + fun_prop + · fun_prop + +@[fun_prop] +lemma curl_differentiable_time + (fₜ : Time → Space → EuclideanSpace ℝ (Fin 3)) + (hf : ContDiff ℝ 2 ↿fₜ) (x : Space) : + Differentiable ℝ (fun t => (∇ × fₜ t) x) := by + rw [differentiable_euclidean] + intro i + fin_cases i + all_goals + simp only [Fin.zero_eta, Fin.isValue, curl] + fun_prop + +/-! + +### A.4. Time derivative commute with curl + +-/ +open Time + +/-- Curl and time derivative commute. -/ +lemma time_deriv_curl_commute (fₜ : Time → Space → EuclideanSpace ℝ (Fin 3)) + (t : Time) (x : Space) (hf : ContDiff ℝ 2 ↿fₜ) : + ∂ₜ (fun t => (∇ × fₜ t) x) t = (∇ × fun x => (∂ₜ (fun t => fₜ t x) t)) x:= by + ext i + rw [← Time.deriv_euclid] + · fin_cases i + all_goals + simp [curl] + rw [Time.deriv_eq] + rw [fderiv_fun_sub] + simp [← Time.deriv_eq] + rw [time_deriv_comm_space_deriv, time_deriv_comm_space_deriv] + congr + · funext x' + rw [Time.deriv_euclid] + have h1 := hf.differentiable (by simp) + fun_prop + · funext x' + rw [Time.deriv_euclid] + have h1 := hf.differentiable (by simp) + fun_prop + repeat' fun_prop + · apply Differentiable.differentiableAt + fun_prop + · apply Differentiable.differentiableAt + fun_prop + · fun_prop + +/-! + +### A.5. Constant of time deriative and space derivatives zero + +-/ + +lemma space_fun_of_time_deriv_eq_zero {d} {M} [NormedAddCommGroup M] [NormedSpace ℝ M] + {f : Time → Space d → M} (hf : Differentiable ℝ ↿f) + (h : ∀ t x, ∂ₜ (f · x) t = 0) : + ∃ (g : Space d → M), ∀ t x, f t x = g x := by + use fun x => f 0 x + intro t x + simp only + change (fun t' => f t' x) t = (fun t' => f t' x) 0 + apply is_const_of_fderiv_eq_zero (f := fun t' => f t' x) (𝕜 := ℝ) + · fun_prop + intro t + ext r + simp only [ContinuousLinearMap.zero_apply] + trans r.val • (fderiv ℝ (fun t' => f t' x) t) 1 + · rw [← map_smul] + congr + ext + simp + simp only [smul_eq_zero] + right + rw [← h t x] + rfl + +lemma time_fun_of_space_deriv_eq_zero {d} {M} [NormedAddCommGroup M] [NormedSpace ℝ M] + {f : Time → Space d → M} (hf : Differentiable ℝ ↿f) + (h : ∀ t x i, Space.deriv i (f t) x = 0) : + ∃ (g : Time → M), ∀ t x, f t x = g t := by + use fun t => f t 0 + intro t x + simp only + change (fun x' => f t x') x = (fun x' => f t x') 0 + apply is_const_of_fderiv_eq_zero (f := fun x' => f t x') (𝕜 := ℝ) + · fun_prop + intro x + have h1 : (fderiv ℝ (fun x' => f t x') x).toLinearMap = 0 := by + apply (Space.basis (d := d)).toBasis.ext + intro i + simp only [OrthonormalBasis.coe_toBasis, ContinuousLinearMap.coe_coe, LinearMap.zero_apply] + rw [← h t x i] + rw [Space.deriv_eq_fderiv_basis] + ext r + change (fderiv ℝ (fun x' => f t x') x).toLinearMap r = 0 + rw [h1] + simp + +lemma const_of_time_deriv_space_deriv_eq_zero {d} {M} [NormedAddCommGroup M] [NormedSpace ℝ M] + {f : Time → Space d → M} (hf : Differentiable ℝ ↿f) + (h₁ : ∀ t x, ∂ₜ (f · x) t = 0) + (h₂ : ∀ t x i, Space.deriv i (f t) x = 0) : + ∃ (c : M), ∀ t x, f t x = c := by + obtain ⟨g, hg⟩ := space_fun_of_time_deriv_eq_zero hf h₁ + obtain ⟨k, hk⟩ := time_fun_of_space_deriv_eq_zero hf h₂ + use g 0 + intro t x + have h1 : ∀ t x, g x = k t := by + intro t x + rw [← hg t x] + rw [hk t x] + rw [hk] + rw [← h1 t 0] + +/-! + +### A.6. Equal up to a constant of time and space derivatives equal + +-/ + +lemma equal_up_to_const_of_deriv_eq {d} {M} [NormedAddCommGroup M] [NormedSpace ℝ M] + {f g : Time → Space d → M} (hf : Differentiable ℝ ↿f) (hg : Differentiable ℝ ↿g) + (h₁ : ∀ t x, ∂ₜ (f · x) t = ∂ₜ (g · x) t) + (h₂ : ∀ t x i, Space.deriv i (f t) x = Space.deriv i (g t) x) : + ∃ (c : M), ∀ t x, f t x = g t x + c := by + suffices h : ∃ c', ∀ t x, f t x - g t x = c' by + obtain ⟨c', hc'⟩ := h + use c' + intro t x + rw [← hc' t x] + simp + apply const_of_time_deriv_space_deriv_eq_zero + · exact Differentiable.fun_sub hf hg + · intro t x + rw [Time.deriv_eq] + rw [fderiv_fun_sub] + simp [← Time.deriv_eq, h₁] + · fun_prop + · fun_prop + · intro t x i + rw [Space.deriv_eq_fderiv_basis] + rw [fderiv_fun_sub] + simp [← Space.deriv_eq_fderiv_basis, h₂] + · fun_prop + · fun_prop +/-! + +## B. Derivatives of distributions on Time × Space d + +-/ + +open Distribution SchwartzMap + +/-! + +### B.1. Time derivatives + +-/ + +/-- The time derivative of a distribution dependent on time and space. -/ +noncomputable def distTimeDeriv {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] : + ((Time × Space d) →d[ℝ] M) →ₗ[ℝ] (Time × Space d) →d[ℝ] M where + toFun f := + let ev : ((Time × Space d) →L[ℝ] M) →L[ℝ] M := { + toFun v := v (1, 0) + map_add' v1 v2 := by + simp only [ContinuousLinearMap.add_apply] + map_smul' a v := by + simp + } + ev.comp (Distribution.fderivD ℝ f) + map_add' f1 f2 := by + simp + map_smul' a f := by simp + +lemma distTimeDeriv_apply {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (f : (Time × Space d) →d[ℝ] M) (ε : 𝓢(Time × Space d, ℝ)) : + (distTimeDeriv f) ε = fderivD ℝ f ε (1, 0) := by + simp [distTimeDeriv] + +lemma distTimeDeriv_apply' {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (f : (Time × Space d) →d[ℝ] M) (ε : 𝓢(Time × Space d, ℝ)) : + (distTimeDeriv f) ε = + -f (SchwartzMap.evalCLM ℝ (Time × Space d) ℝ (1, 0) + ((fderivCLM ℝ (Time × Space d) ℝ) ε)) := by + rw [distTimeDeriv_apply, fderivD_apply] + +lemma apply_fderiv_eq_distTimeDeriv {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (f : (Time × Space d) →d[ℝ] M) (ε : 𝓢(Time × Space d, ℝ)) : + f (SchwartzMap.evalCLM ℝ (Time × Space d) ℝ (1, 0) ((fderivCLM ℝ (Time × Space d) ℝ) ε)) = + - (distTimeDeriv f) ε := by + simp [distTimeDeriv_apply'] + +/-! + +#### B.1.1. Composition with a CLM + +-/ + +lemma distTimeDeriv_apply_CLM {M M2 d} [NormedAddCommGroup M] [NormedSpace ℝ M] + [NormedAddCommGroup M2] [NormedSpace ℝ M2] (f : (Time × Space d) →d[ℝ] M) + (c : M →L[ℝ] M2) : distTimeDeriv (c ∘L f) = c ∘L (distTimeDeriv f) := by + ext ε + simp [distTimeDeriv_apply, fderivD_apply] + +/-! + +### B.2. Space derivatives + +-/ + +/-- The space derivative of a distribution dependent on time and space. -/ +noncomputable def distSpaceDeriv {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (i : Fin d) : ((Time × Space d) →d[ℝ] M) →ₗ[ℝ] (Time × Space d) →d[ℝ] M where + toFun f := + let ev : (Time × Space d →L[ℝ] M) →L[ℝ] M := { + toFun v := v (0, basis i) + map_add' v1 v2 := by + simp only [ContinuousLinearMap.add_apply] + map_smul' a v := by + simp + } + ev.comp (Distribution.fderivD ℝ f) + map_add' f1 f2 := by + simp + map_smul' a f := by simp + +lemma distSpaceDeriv_apply {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (i : Fin d) (f : (Time × Space d) →d[ℝ] M) (ε : 𝓢(Time × Space d, ℝ)) : + (distSpaceDeriv i f) ε = fderivD ℝ f ε (0, basis i) := by + simp [distSpaceDeriv] + +lemma distSpaceDeriv_apply' {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (i : Fin d) (f : (Time × Space d) →d[ℝ] M) (ε : 𝓢(Time × Space d, ℝ)) : + (distSpaceDeriv i f) ε = + - f ((SchwartzMap.evalCLM ℝ (Time × Space d) ℝ (0, basis i)) + ((fderivCLM ℝ (Time × Space d) ℝ) ε)) := by + rw [distSpaceDeriv_apply, fderivD_apply] + +lemma apply_fderiv_eq_distSpaceDeriv {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (i : Fin d) (f : (Time × Space d) →d[ℝ] M) (ε : 𝓢(Time × Space d, ℝ)) : + f ((SchwartzMap.evalCLM ℝ (Time × Space d) ℝ (0, basis i)) + ((fderivCLM ℝ (Time × Space d) ℝ) ε)) = + - (distSpaceDeriv i f) ε := by + simp [distSpaceDeriv_apply'] + +/-! + +#### B.2.1. Space derivatives commute + +-/ + +lemma distSpaceDeriv_commute {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (i j : Fin d) (f : (Time × Space d) →d[ℝ] M) : + distSpaceDeriv i (distSpaceDeriv j f) = distSpaceDeriv j (distSpaceDeriv i f) := by + ext κ + rw [distSpaceDeriv_apply, distSpaceDeriv_apply, fderivD_apply, fderivD_apply] + rw [distSpaceDeriv_apply, distSpaceDeriv_apply, fderivD_apply, fderivD_apply] + simp only [neg_neg] + congr 1 + ext x + change fderiv ℝ (fun x => fderiv ℝ κ x (0, basis i)) x (0, basis j) = + fderiv ℝ (fun x => fderiv ℝ κ x (0, basis j)) x (0, basis i) + rw [fderiv_clm_apply, fderiv_clm_apply] + simp only [fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.comp_zero, zero_add, + ContinuousLinearMap.flip_apply] + rw [IsSymmSndFDerivAt.eq] + · apply ContDiffAt.isSymmSndFDerivAt + apply ContDiff.contDiffAt + exact smooth κ ⊤ + simp only [minSmoothness_of_isRCLikeNormedField] + exact ENat.LEInfty.out + · have h1 := smooth κ 2 + fun_prop + · fun_prop + · have h1 := smooth κ 2 + fun_prop + · fun_prop + +/-! + +#### B.2.2. Composition with a CLM + +-/ + +lemma distSpaceDeriv_apply_CLM {M M2 d} [NormedAddCommGroup M] [NormedSpace ℝ M] + [NormedAddCommGroup M2] [NormedSpace ℝ M2] + (i : Fin d) (f : (Time × Space d) →d[ℝ] M) + (c : M →L[ℝ] M2) : distSpaceDeriv i (c ∘L f) = c ∘L (distSpaceDeriv i f) := by + ext ε + simp [distSpaceDeriv_apply, fderivD_apply] + +/-! + +### B.3. Time and space derivatives commute + +-/ + +lemma distTimeDeriv_commute_distSpaceDeriv {M d} [NormedAddCommGroup M] [NormedSpace ℝ M] + (i : Fin d) (f : (Time × Space d) →d[ℝ] M) : + distTimeDeriv (distSpaceDeriv i f) = distSpaceDeriv i (distTimeDeriv f) := by + ext κ + rw [distTimeDeriv_apply, distSpaceDeriv_apply, fderivD_apply, fderivD_apply] + rw [distTimeDeriv_apply, distSpaceDeriv_apply, fderivD_apply, fderivD_apply] + simp only [neg_neg] + congr 1 + ext x + change fderiv ℝ (fun x => fderiv ℝ κ x (1, 0)) x (0, basis i) = + fderiv ℝ (fun x => fderiv ℝ κ x (0, basis i)) x (1, 0) + rw [fderiv_clm_apply, fderiv_clm_apply] + simp only [fderiv_fun_const, Pi.ofNat_apply, ContinuousLinearMap.comp_zero, zero_add, + ContinuousLinearMap.flip_apply] + rw [IsSymmSndFDerivAt.eq] + · apply ContDiffAt.isSymmSndFDerivAt + apply ContDiff.contDiffAt + exact smooth κ ⊤ + simp only [minSmoothness_of_isRCLikeNormedField] + exact ENat.LEInfty.out + · have h1 := smooth κ 2 + fun_prop + · fun_prop + · have h1 := smooth κ 2 + fun_prop + · fun_prop + +/-! + +### B.4. The spatial gradient + +-/ + +/-- The spatial gradient of a distribution dependent on time and space. -/ +noncomputable def distSpaceGrad {d} : + ((Time × Space d) →d[ℝ] ℝ) →ₗ[ℝ] (Time × Space d) →d[ℝ] (EuclideanSpace ℝ (Fin d)) where + toFun f := { + toFun := fun ε => WithLp.toLp 2 fun i => distSpaceDeriv i f ε + map_add' ε1 ε2 := by ext i; simp + map_smul' a ε := by ext i; simp + cont := by fun_prop} + map_add' f1 f2 := by + ext x + simp + map_smul' a f := by + ext x + simp + +lemma distSpaceGrad_apply {d} (f : (Time × Space d) →d[ℝ] ℝ) (ε : 𝓢(Time × Space d, ℝ)) : + distSpaceGrad f ε = fun i => distSpaceDeriv i f ε := by + rfl + +/-! + +### B.5. The spatial divergence + +-/ + +/-- The spatial divergence of a distribution dependent on time and space. -/ +noncomputable def distSpaceDiv {d} : + ((Time × Space d) →d[ℝ] (EuclideanSpace ℝ (Fin d))) →ₗ[ℝ] (Time × Space d) →d[ℝ] ℝ where + toFun f := { + toFun ε := ∑ i, distSpaceDeriv i f ε i + map_add' ε1 ε2 := by simp [Finset.sum_add_distrib] + map_smul' a ε := by simp [Finset.mul_sum] + cont := by fun_prop} + map_add' f1 f2 := by + ext x + simp [Finset.sum_add_distrib] + map_smul' a f := by + ext x + simp [Finset.mul_sum] + +lemma distSpaceDiv_apply_eq_sum_distSpaceDeriv {d} + (f : (Time × Space d) →d[ℝ] EuclideanSpace ℝ (Fin d)) (η : 𝓢(Time ×Space d, ℝ)) : + distSpaceDiv f η = ∑ i, distSpaceDeriv i f η i := by rfl + +/-! + +### B.6. The spatial curl + +-/ + +/-- The curl of a distribution dependent on time and space. -/ +noncomputable def distSpaceCurl : ((Time × Space 3) →d[ℝ] (EuclideanSpace ℝ (Fin 3))) →ₗ[ℝ] + (Time × Space 3) →d[ℝ] (EuclideanSpace ℝ (Fin 3)) where + toFun f :={ + toFun ε := WithLp.toLp 2 fun i => + match i with + | 0 => distSpaceDeriv 2 f ε 1 - distSpaceDeriv 1 f ε 2 + | 1 => distSpaceDeriv 0 f ε 2 - distSpaceDeriv 2 f ε 0 + | 2 => distSpaceDeriv 1 f ε 0 - distSpaceDeriv 0 f ε 1 + map_add' ε1 ε2 := by + ext i + fin_cases i + all_goals + simp only [Fin.isValue, map_add, PiLp.add_apply, Fin.reduceFinMk] + ring + map_smul' a ε := by + ext i + fin_cases i + all_goals + simp only [Fin.isValue, map_smul, PiLp.smul_apply, smul_eq_mul, RingHom.id_apply, + Fin.zero_eta] + ring + cont := by + apply Continuous.comp + · fun_prop + rw [continuous_pi_iff] + intro i + fin_cases i <;> fun_prop + } + map_add' f1 f2 := by + ext x i + fin_cases i + all_goals + simp only [Fin.isValue, map_add, ContinuousLinearMap.add_apply, PiLp.add_apply, Fin.zero_eta, + ContinuousLinearMap.coe_mk', LinearMap.coe_mk, AddHom.coe_mk] + ring + map_smul' a f := by + ext x i + fin_cases i + all_goals + simp only [Fin.isValue, map_smul, ContinuousLinearMap.coe_smul', Pi.smul_apply, + PiLp.smul_apply, smul_eq_mul, Fin.reduceFinMk, ContinuousLinearMap.coe_mk', + LinearMap.coe_mk, AddHom.coe_mk, RingHom.id_apply] + ring + +end Space diff --git a/PhysLean/SpaceAndTime/Space/Distributions/ConstantTime.lean b/PhysLean/SpaceAndTime/TimeAndSpace/ConstantTimeDist.lean similarity index 79% rename from PhysLean/SpaceAndTime/Space/Distributions/ConstantTime.lean rename to PhysLean/SpaceAndTime/TimeAndSpace/ConstantTimeDist.lean index ebcec827f..c3c4b1406 100644 --- a/PhysLean/SpaceAndTime/Space/Distributions/ConstantTime.lean +++ b/PhysLean/SpaceAndTime/TimeAndSpace/ConstantTimeDist.lean @@ -3,7 +3,7 @@ Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ -import PhysLean.SpaceAndTime.Space.Distributions.Basic +import PhysLean.SpaceAndTime.TimeAndSpace.Basic import Mathlib.Analysis.Calculus.ContDiff.FiniteDimension /-! @@ -137,12 +137,14 @@ lemma continuous_time_integral {d} (η : 𝓢(Time × Space d, ℝ)) : -/ -lemma time_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) (x₀ : Space d.succ) : +set_option maxSynthPendingDepth 10000 in + +lemma time_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Time × Space d, ℝ)) (x₀ : Space d) : HasFDerivAt (fun x => ∫ (t : Time), η (t, x)) - (∫ (t : Time), fderiv ℝ (fun x : Space d.succ => η (t, x)) x₀) x₀ := by - let F : Space d.succ → Time → ℝ := fun x t => η (t, x) - let F' : Space d.succ → Time → Space d.succ →L[ℝ] ℝ := - fun x₀ t => fderiv ℝ (fun x : Space d.succ => η (t, x)) x₀ + (∫ (t : Time), fderiv ℝ (fun x : Space d => η (t, x)) x₀) x₀ := by + let F : Space d → Time → ℝ := fun x t => η (t, x) + let F' : Space d → Time → Space d →L[ℝ] ℝ := + fun x₀ t => fderiv ℝ (fun x : Space d => η (t, x)) x₀ have hF : ∀ t, ∀ x, HasFDerivAt (F · t) (F' x t) x := by intro t x dsimp [F, F'] @@ -166,7 +168,7 @@ lemma time_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) generalize hk : 2 ^ (rt, 1).1 * ((Finset.Iic (rt, 1)).sup fun m => SchwartzMap.seminorm ℝ m.1 m.2) η = k at * simp at h0 - have h1 : ∀ x : Space d.succ, ∀ t : Time, + have h1 : ∀ x : Space d, ∀ t : Time, ‖iteratedFDeriv ℝ 1 ⇑η (t, x)‖ ≤ k * ‖(1 + ‖t‖) ^ (rt)‖⁻¹ := by intro x t trans k * ‖(1 + ‖(t, x)‖) ^ (rt)‖⁻¹; swap @@ -178,7 +180,7 @@ lemma time_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) · simp rw [abs_of_nonneg (by positivity)] positivity - simp only [norm_pow, Real.norm_eq_abs, Nat.succ_eq_add_one, Prod.norm_mk] + simp only [norm_pow, Real.norm_eq_abs, Prod.norm_mk] refine pow_le_pow_left₀ (by positivity) ?_ rt rw [abs_of_nonneg (by positivity), abs_of_nonneg (by positivity)] simp @@ -191,14 +193,15 @@ lemma time_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) positivity convert h0' using 1 rw [mul_comm] - congr - simp only [Nat.succ_eq_add_one, Prod.norm_mk, norm_pow, Real.norm_eq_abs] + simp only [Prod.norm_mk, norm_pow, Real.norm_eq_abs, norm_iteratedFDeriv_one, + mul_eq_mul_right_iff, norm_eq_zero] + left rw [abs_of_nonneg (by positivity)] have h1 : HasFDerivAt (fun x => ∫ (a : Time), F x a) (∫ (a : Time), F' x₀ a) x₀ := by apply hasFDerivAt_integral_of_dominated_of_fderiv_le - (bound := fun t => (k * ‖(ContinuousLinearMap.prod (0 : Space d.succ →L[ℝ] Time) - (ContinuousLinearMap.id ℝ (Space d.succ)))‖) * ‖(1 + ‖t‖) ^ (rt)‖⁻¹) (ε := 1) - · simp + (bound := fun t => (k * ‖(ContinuousLinearMap.prod (0 : Space d →L[ℝ] Time) + (ContinuousLinearMap.id ℝ (Space d)))‖) * ‖(1 + ‖t‖) ^ (rt)‖⁻¹) + · exact Filter.univ_mem' (hF (F x₀ 0)) · filter_upwards with x fun_prop · simp [F] @@ -209,7 +212,7 @@ lemma time_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) refine { exists_integrable := ?_ } obtain ⟨r, hr⟩ := Measure.HasTemperateGrowth.exists_integrable (μ := volume (α := Time)) use r - simp only [Nat.succ_eq_add_one, Real.rpow_neg_natCast, zpow_neg, zpow_natCast] + simp only [Real.rpow_neg_natCast, zpow_neg, zpow_natCast] rw [MeasurableEmbedding.integrable_map_iff] change Integrable ((fun t => ((1 + ‖(t, x₀)‖) ^ r)⁻¹)) volume apply hr.mono @@ -220,7 +223,7 @@ lemma time_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) intro x positivity filter_upwards with t - simp only [Nat.succ_eq_add_one, Prod.norm_mk, norm_inv, norm_pow, Real.norm_eq_abs, + simp only [Prod.norm_mk, norm_inv, norm_pow, Real.norm_eq_abs, Real.rpow_neg_natCast, zpow_neg, zpow_natCast] apply inv_anti₀ (by positivity) refine pow_le_pow_left₀ (by positivity) ?_ r @@ -240,15 +243,14 @@ lemma time_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) simp [F'] rw [fderiv_comp', DifferentiableAt.fderiv_prodMk] simp only [fderiv_fun_const, Pi.zero_apply, fderiv_id'] - trans ‖(fderiv ℝ ⇑η (t, x))‖ * ‖(ContinuousLinearMap.prod (0 : Space d.succ →L[ℝ] Time) - (ContinuousLinearMap.id ℝ (Space d.succ)))‖ + trans ‖(fderiv ℝ ⇑η (t, x))‖ * ‖(ContinuousLinearMap.prod (0 : Space d →L[ℝ] Time) + (ContinuousLinearMap.id ℝ (Space d)))‖ · exact ContinuousLinearMap.opNorm_comp_le (fderiv ℝ ⇑η (t, x)) - (ContinuousLinearMap.prod 0 (ContinuousLinearMap.id ℝ (Space d.succ))) + (ContinuousLinearMap.prod 0 (ContinuousLinearMap.id ℝ (Space d))) trans ‖iteratedFDeriv ℝ 1 (⇑η) (t, x)‖ * - ‖((0 : Space d.succ →L[ℝ] Time).prod (ContinuousLinearMap.id ℝ (Space d.succ)))‖ + ‖((0 : Space d →L[ℝ] Time).prod (ContinuousLinearMap.id ℝ (Space d)))‖ · apply le_of_eq congr 1 - simp only [Nat.succ_eq_add_one] rw [← iteratedFDerivWithin_univ] rw [norm_iteratedFDerivWithin_one] rw [fderivWithin_univ] @@ -267,10 +269,12 @@ lemma time_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) simp rw [basis_apply] at ht simp at ht - trans k * (|1 + ‖t‖| ^ rt)⁻¹ * ‖ContinuousLinearMap.prod (0 : Space d.succ →L[ℝ] Time) - (ContinuousLinearMap.id ℝ (Space d.succ))‖ + trans k * (|1 + ‖t‖| ^ rt)⁻¹ * ‖ContinuousLinearMap.prod (0 : Space d →L[ℝ] Time) + (ContinuousLinearMap.id ℝ (Space d))‖ swap · apply le_of_eq + simp only [ContinuousLinearMap.opNorm_prod, Prod.norm_mk, norm_zero, norm_nonneg, + sup_of_le_right] ring refine mul_le_mul_of_nonneg ?_ ?_ (by positivity) (by positivity) · convert h1 x t @@ -290,7 +294,6 @@ lemma time_integral_hasFDerivAt {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) intro x _ exact hF t x exact h1 - /-! ### A.3. Differentiability as a function of space @@ -307,8 +310,9 @@ lemma time_integral_differentiable {d : ℕ} (η : 𝓢(Time × Space d.succ, -/ +set_option maxSynthPendingDepth 10000 in @[fun_prop] -lemma integrable_fderiv_space {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) (x : Space d.succ) : +lemma integrable_fderiv_space {d : ℕ} (η : 𝓢(Time × Space d, ℝ)) (x : Space d) : Integrable (fun t => fderiv ℝ (fun x => η (t, x)) x) volume := by obtain ⟨rt, hrt⟩ : ∃ r, Integrable (fun x : Time => ‖((1 + ‖x‖) ^ r)⁻¹‖) volume := by obtain ⟨r, h⟩ := Measure.HasTemperateGrowth.exists_integrable (μ := volume (α := Time)) @@ -323,7 +327,7 @@ lemma integrable_fderiv_space {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) ( generalize hk : 2 ^ (rt, 1).1 * ((Finset.Iic (rt, 1)).sup fun m => SchwartzMap.seminorm ℝ m.1 m.2) η = k at * simp at h0 - have h1 : ∀ x : Space d.succ, ∀ t : Time, + have h1 : ∀ x : Space d, ∀ t : Time, ‖iteratedFDeriv ℝ 1 ⇑η (t, x)‖ ≤ k * ‖(1 + ‖t‖) ^ (rt)‖⁻¹ := by intro x t trans k * ‖(1 + ‖(t, x)‖) ^ (rt)‖⁻¹; swap @@ -335,7 +339,7 @@ lemma integrable_fderiv_space {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) ( · simp rw [abs_of_nonneg (by positivity)] positivity - simp only [norm_pow, Real.norm_eq_abs, Nat.succ_eq_add_one, Prod.norm_mk] + simp only [norm_pow, Real.norm_eq_abs, Prod.norm_mk] refine pow_le_pow_left₀ (by positivity) ?_ rt rw [abs_of_nonneg (by positivity), abs_of_nonneg (by positivity)] simp @@ -348,59 +352,67 @@ lemma integrable_fderiv_space {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) ( positivity convert h0' using 1 rw [mul_comm] + simp only [Prod.norm_mk, norm_pow, Real.norm_eq_abs, norm_iteratedFDeriv_one, + mul_eq_mul_right_iff, norm_eq_zero] + left congr - simp only [Nat.succ_eq_add_one, Prod.norm_mk, norm_pow, Real.norm_eq_abs] rw [abs_of_nonneg (by positivity)] - have h2 : ∀ x : Space d.succ, ∀ t : Time, ‖fderiv ℝ (fun x => η (t, x)) x‖ ≤ - k * ‖ContinuousLinearMap.prod (0 : Space d.succ →L[ℝ] Time) - (ContinuousLinearMap.id ℝ (Space (d + 1)))‖ * (|1 + ‖t‖| ^ rt)⁻¹ := by + have hx : ∀ x : Space d, ∀ t : Time, ‖iteratedFDeriv ℝ 1 ⇑η (t, x)‖ * ‖ContinuousLinearMap.prod + (0 : Space d →L[ℝ] Time) (ContinuousLinearMap.id ℝ (Space d))‖ ≤ + k * ‖ContinuousLinearMap.prod (0 : Space d →L[ℝ] Time) + (ContinuousLinearMap.id ℝ (Space d))‖ * (|1 + ‖t‖| ^ rt)⁻¹ := by + intro x t + match d with + | 0 => simp + | .succ d => + have h0 : ‖ContinuousLinearMap.prod (0 : Space d.succ →L[ℝ] Time) + (ContinuousLinearMap.id ℝ (Space d.succ))‖ ≠ 0 := by + rw [@norm_ne_zero_iff] + simp only [Nat.succ_eq_add_one, ne_eq] + rw [@ContinuousLinearMap.ext_iff] + simp only [ContinuousLinearMap.prod_apply, ContinuousLinearMap.zero_apply, + ContinuousLinearMap.coe_id', id_eq, Prod.mk_eq_zero, true_and, not_forall] + use Space.basis 0 + by_contra hn + have ht : (basis 0 : Space d.succ) 0 = 0 := by + rw [hn] + simp + rw [basis_apply] at ht + simp at ht + trans k * (|1 + ‖t‖| ^ rt)⁻¹ * ‖ContinuousLinearMap.prod (0 : Space d.succ →L[ℝ] Time) + (ContinuousLinearMap.id ℝ (Space d.succ))‖ + swap + · apply le_of_eq + ring + refine mul_le_mul_of_nonneg ?_ ?_ (by positivity) (by positivity) + · convert h1 x t + simp + · rfl + have h2 : ∀ x : Space d, ∀ t : Time, ‖fderiv ℝ (fun x => η (t, x)) x‖ ≤ + k * ‖ContinuousLinearMap.prod (0 : Space d →L[ℝ] Time) + (ContinuousLinearMap.id ℝ (Space d))‖ * (|1 + ‖t‖| ^ rt)⁻¹ := by intro x t rw [fderiv_comp', DifferentiableAt.fderiv_prodMk] - simp only [Nat.succ_eq_add_one, fderiv_fun_const, Pi.zero_apply, fderiv_id'] - trans ‖(fderiv ℝ ⇑η (t, x))‖ * ‖(ContinuousLinearMap.prod (0 : Space d.succ →L[ℝ] Time) - (ContinuousLinearMap.id ℝ (Space d.succ)))‖ + simp only [fderiv_fun_const, Pi.zero_apply, fderiv_id'] + trans ‖(fderiv ℝ ⇑η (t, x))‖ * ‖(ContinuousLinearMap.prod (0 : Space d →L[ℝ] Time) + (ContinuousLinearMap.id ℝ (Space d)))‖ · exact ContinuousLinearMap.opNorm_comp_le (fderiv ℝ ⇑η (t, x)) - (ContinuousLinearMap.prod 0 (ContinuousLinearMap.id ℝ (Space d.succ))) + (ContinuousLinearMap.prod 0 (ContinuousLinearMap.id ℝ (Space d))) trans ‖iteratedFDeriv ℝ 1 (⇑η) (t, x)‖ * ‖(ContinuousLinearMap.prod - (0 : Space d.succ →L[ℝ] Time) (ContinuousLinearMap.id ℝ (Space d.succ)))‖ + (0 : Space d →L[ℝ] Time) (ContinuousLinearMap.id ℝ (Space d)))‖ · apply le_of_eq congr 1 - simp only [Nat.succ_eq_add_one] - rw [← iteratedFDerivWithin_univ] - rw [norm_iteratedFDerivWithin_one] - rw [fderivWithin_univ] + rw [← iteratedFDerivWithin_univ, norm_iteratedFDerivWithin_one, fderivWithin_univ] exact uniqueDiffWithinAt_univ - have h0 : ‖ContinuousLinearMap.prod (0 : Space d.succ →L[ℝ] Time) - (ContinuousLinearMap.id ℝ (Space d.succ))‖ ≠ 0 := by - rw [@norm_ne_zero_iff] - simp only [Nat.succ_eq_add_one, ne_eq] - rw [@ContinuousLinearMap.ext_iff] - simp only [ContinuousLinearMap.prod_apply, ContinuousLinearMap.zero_apply, - ContinuousLinearMap.coe_id', id_eq, Prod.mk_eq_zero, true_and, not_forall] - use Space.basis 0 - by_contra hn - have ht : (basis 0 : Space d.succ) 0 = 0 := by - rw [hn] - simp - rw [basis_apply] at ht - simp at ht - trans k * (|1 + ‖t‖| ^ rt)⁻¹ * ‖ContinuousLinearMap.prod (0 : Space d.succ →L[ℝ] Time) - (ContinuousLinearMap.id ℝ (Space d.succ))‖ - swap - · apply le_of_eq - ring - refine mul_le_mul_of_nonneg ?_ ?_ (by positivity) (by positivity) - · convert h1 x t - simp - · rfl - fun_prop - fun_prop + · exact hx x t + · fun_prop + · fun_prop · apply Differentiable.differentiableAt exact η.smooth'.differentiable (by simp) - fun_prop + · fun_prop rw [← MeasureTheory.integrable_norm_iff] - apply Integrable.mono' (g := fun t => k * ‖ContinuousLinearMap.prod (0 : Space d.succ →L[ℝ] Time) - (ContinuousLinearMap.id ℝ (Space (d + 1)))‖ * (|1 + ‖t‖| ^ rt)⁻¹) + apply Integrable.mono' (g := fun t => k * ‖ContinuousLinearMap.prod (0 : Space d →L[ℝ] Time) + (ContinuousLinearMap.id ℝ (Space d))‖ * (|1 + ‖t‖| ^ rt)⁻¹) · apply Integrable.const_mul convert hrt using 1 funext x @@ -429,39 +441,39 @@ lemma integrable_fderiv_space {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) ( -/ -lemma time_integral_contDiff {d : ℕ} (n : ℕ) (η : 𝓢(Time × Space d.succ, ℝ)) : +lemma time_integral_contDiff {d : ℕ} (n : ℕ) (η : 𝓢(Time × Space d, ℝ)) : ContDiff ℝ n (fun x => ∫ (t : Time), η (t, x)) := by revert η induction n with | zero => intro η - simp only [Nat.succ_eq_add_one, CharP.cast_eq_zero, contDiff_zero] + simp only [CharP.cast_eq_zero, contDiff_zero] exact continuous_time_integral η | succ n ih => intro η - simp only [Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one] + simp only [Nat.cast_add, Nat.cast_one] rw [contDiff_succ_iff_hasFDerivAt] - use fun x₀ => (∫ (t : Time), fderiv ℝ (fun x : Space d.succ => η (t, x)) x₀) + use fun x₀ => (∫ (t : Time), fderiv ℝ (fun x : Space d => η (t, x)) x₀) apply And.intro · rw [contDiff_clm_apply_iff] intro y have hl : (fun x => (∫ (t : Time), fderiv ℝ (fun x => η (t, x)) x) y) = fun x => (∫ (t : Time), fderiv ℝ (fun x => η (t, x)) x y) := by funext x - simp only [Nat.succ_eq_add_one] rw [ContinuousLinearMap.integral_apply] exact integrable_fderiv_space η x rw [hl] have hl2 : (fun x => ∫ (t : Time), (fderiv ℝ (fun x => η (t, x)) x) y)= - fun x => ∫ (t : Time), SchwartzMap.pderivCLM ℝ (0, y) η (t, x) := by + fun x => ∫ (t : Time), (LineDeriv.lineDerivOpCLM ℝ 𝓢(Time × Space d, ℝ) ((0, y) : + Time × Space d) η) (t, x) := by funext x congr funext t - simp only [Nat.succ_eq_add_one, pderivCLM_apply] + simp only [LineDeriv.lineDerivOpCLM_apply] rw [fderiv_comp', DifferentiableAt.fderiv_prodMk] simp only [fderiv_fun_const, Pi.zero_apply, fderiv_id', ContinuousLinearMap.coe_comp', Function.comp_apply, ContinuousLinearMap.prod_apply, ContinuousLinearMap.zero_apply, - ContinuousLinearMap.coe_id', id_eq] + ContinuousLinearMap.coe_id', id_eq, SchwartzMap.lineDerivOp_apply_eq_fderiv] fun_prop fun_prop · apply Differentiable.differentiableAt @@ -484,7 +496,7 @@ lemma time_integral_contDiff {d : ℕ} (n : ℕ) (η : 𝓢(Time × Space d.succ -/ @[fun_prop] -lemma integrable_time_integral {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) (x : Space d.succ) : +lemma integrable_time_integral {d : ℕ} (η : 𝓢(Time × Space d, ℝ)) (x : Space d) : Integrable (fun t => η (t, x)) volume := by haveI : Measure.HasTemperateGrowth ((Measure.map (fun t => (t, x)) (volume (α := Time)))) := by refine { exists_integrable := ?_ } @@ -527,7 +539,7 @@ lemma integrable_time_integral {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) -/ lemma pow_mul_iteratedFDeriv_norm_le {n m} {d : ℕ} : - ∃ rt, ∀ (η : 𝓢(Time × Space d.succ, ℝ)), ∀ (x : Space d.succ), + ∃ rt, ∀ (η : 𝓢(Time × Space d, ℝ)), ∀ (x : Space d), Integrable (fun x : Time => ‖((1 + ‖x‖) ^ rt)⁻¹‖) volume ∧ ∀ t, ‖(t, x)‖ ^m * ‖iteratedFDeriv ℝ n ⇑η (t, x)‖ ≤ (2 ^ (rt + m, n).1 * @@ -548,7 +560,7 @@ lemma pow_mul_iteratedFDeriv_norm_le {n m} {d : ℕ} : generalize hk : 2 ^ (rt, n).1 * ((Finset.Iic (rt, n)).sup fun m => SchwartzMap.seminorm ℝ m.1 m.2) η = k at * simp at h0 - have h1 : ∀ x : Space d.succ, ∀ t : Time, ‖(t,x)‖ ^ m * ‖iteratedFDeriv ℝ n ⇑η (t, x)‖ ≤ + have h1 : ∀ x : Space d, ∀ t : Time, ‖(t,x)‖ ^ m * ‖iteratedFDeriv ℝ n ⇑η (t, x)‖ ≤ (2 ^ (rt + m, n).1 * ((Finset.Iic (rt + m, n)).sup fun m => SchwartzMap.seminorm ℝ m.1 m.2) η) * ‖(1 + ‖t‖) ^ (rt)‖⁻¹ := by @@ -564,7 +576,7 @@ lemma pow_mul_iteratedFDeriv_norm_le {n m} {d : ℕ} : · simp rw [abs_of_nonneg (by positivity)] positivity - simp only [norm_pow, Real.norm_eq_abs, Nat.succ_eq_add_one, Prod.norm_mk] + simp only [norm_pow, Real.norm_eq_abs, Prod.norm_mk] refine pow_le_pow_left₀ (by positivity) ?_ rt rw [abs_of_nonneg (by positivity), abs_of_nonneg (by positivity)] simp @@ -598,8 +610,8 @@ lemma pow_mul_iteratedFDeriv_norm_le {n m} {d : ℕ} : -/ @[fun_prop] -lemma iteratedFDeriv_norm_mul_pow_integrable {d : ℕ} (n m : ℕ) (η : 𝓢(Time × Space d.succ, ℝ)) - (x : Space d.succ) : +lemma iteratedFDeriv_norm_mul_pow_integrable {d : ℕ} (n m : ℕ) (η : 𝓢(Time × Space d, ℝ)) + (x : Space d) : Integrable (fun t => ‖(t, x)‖ ^ m * ‖iteratedFDeriv ℝ n ⇑η (t, x)‖) volume := by obtain ⟨rt, hrt⟩ := pow_mul_iteratedFDeriv_norm_le (m := m) (d := d) have hbound := (hrt η x).2 @@ -616,14 +628,14 @@ lemma iteratedFDeriv_norm_mul_pow_integrable {d : ℕ} (n m : ℕ) (η : 𝓢(Ti apply Continuous.norm apply Continuous.comp' apply ContDiff.continuous_iteratedFDeriv (n := (n + 1 : ℕ)) - refine GCongr.natCast_le_natCast (by omega) + refine Nat.cast_le.mpr (by omega) have hη := η.smooth' apply hη.of_le (ENat.LEInfty.out) fun_prop · filter_upwards with t apply le_trans _ (hbound t) apply le_of_eq - simp only [Nat.succ_eq_add_one, Prod.norm_mk, norm_mul, norm_pow, Real.norm_eq_abs] + simp only [Prod.norm_mk, norm_mul, norm_pow, Real.norm_eq_abs] rw [abs_of_nonneg (by positivity)] simp @@ -634,22 +646,28 @@ lemma iteratedFDeriv_norm_mul_pow_integrable {d : ℕ} (n m : ℕ) (η : 𝓢(Ti -/ @[fun_prop] -lemma iteratedFDeriv_norm_integrable {n} {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) - (x : Space d.succ) : +lemma iteratedFDeriv_norm_integrable {n} {d : ℕ} (η : 𝓢(Time × Space d, ℝ)) + (x : Space d) : Integrable (fun t => ‖iteratedFDeriv ℝ n ⇑η (t, x)‖) volume := by convert iteratedFDeriv_norm_mul_pow_integrable n 0 η x using 1 funext t simp @[fun_prop] -lemma iteratedFDeriv_integrable {n} {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) (x : Space d.succ) : +lemma iteratedFDeriv_integrable {n} {d : ℕ} (η : 𝓢(Time × Space d, ℝ)) (x : Space d) : Integrable (fun t => iteratedFDeriv ℝ n ⇑η (t, x)) volume := by rw [← MeasureTheory.integrable_norm_iff] apply iteratedFDeriv_norm_integrable η x - apply Continuous.aestronglyMeasurable + haveI : SecondCountableTopologyEither Time + (ContinuousMultilinearMap ℝ (fun i : Fin n => Time × Space d) ℝ) := { + out := by + left + infer_instance + } + apply Continuous.aestronglyMeasurable (α := Time) apply Continuous.comp' apply ContDiff.continuous_iteratedFDeriv (n := (n + 1 : ℕ)) - refine GCongr.natCast_le_natCast (by omega) + refine Nat.cast_le.mpr (by omega) have hη := η.smooth' apply hη.of_le (ENat.LEInfty.out) fun_prop @@ -665,7 +683,7 @@ lemma iteratedFDeriv_integrable {n} {d : ℕ} (η : 𝓢(Time × Space d.succ, ### C.1. Moving the iterated derivative inside the time integral -/ -lemma time_integral_iteratedFDeriv_apply {d : ℕ} (n : ℕ) (η : 𝓢(Time × Space d.succ, ℝ)) : +lemma time_integral_iteratedFDeriv_apply {d : ℕ} (n : ℕ) (η : 𝓢(Time × Space d, ℝ)) : ∀ x, ∀ y, iteratedFDeriv ℝ n (fun x => ∫ (t : Time), η (t, x)) x y = ∫ (t : Time), (iteratedFDeriv ℝ n η (t, x)) (fun i => (0, y i)) := by induction n with @@ -713,7 +731,7 @@ lemma time_integral_iteratedFDeriv_apply {d : ℕ} (n : ℕ) (η : 𝓢(Time × trans (fderiv ℝ (iteratedFDeriv ℝ n ⇑η ∘ fun x => (t, x)) x) (y 0) · rfl rw [fderiv_comp, DifferentiableAt.fderiv_prodMk] - simp only [Nat.succ_eq_add_one, fderiv_fun_const, Pi.zero_apply, fderiv_id', + simp only [fderiv_fun_const, Pi.zero_apply, fderiv_id', ContinuousLinearMap.coe_comp', Function.comp_apply, ContinuousLinearMap.prod_apply, ContinuousLinearMap.zero_apply, ContinuousLinearMap.coe_id', id_eq] fun_prop @@ -738,14 +756,15 @@ lemma time_integral_iteratedFDeriv_apply {d : ℕ} (n : ℕ) (η : 𝓢(Time × · fun_prop fun_prop trans (fderiv ℝ (fun x => ∫ (t : Time), - (SchwartzMap.iteratedPDeriv ℝ (fun i => (0, Fin.tail y i)) η (t, x)))) x (y 0) + (LineDeriv.iteratedLineDerivOpCLM ℝ _ (fun i => ((0, Fin.tail y i) : Time × Space d)) + η (t, x)))) x (y 0) · congr funext x congr funext t - rw [iteratedPDeriv_eq_iteratedFDeriv] + erw [SchwartzMap.iteratedLineDerivOp_eq_iteratedFDeriv] have h1 := time_integral_hasFDerivAt - (SchwartzMap.iteratedPDeriv ℝ (fun i => (0, Fin.tail y i)) η) x + (LineDeriv.iteratedLineDerivOpCLM ℝ _ (fun i => ((0, Fin.tail y i) : Time × Space d)) η) x rw [h1.fderiv] rw [ContinuousLinearMap.integral_apply] congr @@ -753,7 +772,7 @@ lemma time_integral_iteratedFDeriv_apply {d : ℕ} (n : ℕ) (η : 𝓢(Time × rw [iteratedFDeriv_succ_apply_left] conv_lhs => enter [1, 2, t] - rw [iteratedPDeriv_eq_iteratedFDeriv] + erw [SchwartzMap.iteratedLineDerivOp_eq_iteratedFDeriv] rw [fderiv_continuousMultilinear_apply_const_apply] change (((fderiv ℝ (iteratedFDeriv ℝ n ⇑η ∘ fun x => (t, x)) x) (y 0)) fun i => (0, Fin.tail y i)) = _ @@ -783,17 +802,16 @@ lemma time_integral_iteratedFDeriv_apply {d : ℕ} (n : ℕ) (η : 𝓢(Time × fun_prop exact integrable_fderiv_space _ x -lemma time_integral_iteratedFDeriv_eq {d : ℕ} (n : ℕ) (η : 𝓢(Time × Space d.succ, ℝ)) - (x : Space d.succ) : +lemma time_integral_iteratedFDeriv_eq {d : ℕ} (n : ℕ) (η : 𝓢(Time × Space d, ℝ)) + (x : Space d) : iteratedFDeriv ℝ n (fun x => ∫ (t : Time), η (t, x)) x = ((∫ (t : Time), iteratedFDeriv ℝ n η (t, x)).compContinuousLinearMap - (fun _ => ContinuousLinearMap.prod (0 : Space d.succ →L[ℝ] Time) - (ContinuousLinearMap.id ℝ (Space d.succ)))) := by + (fun _ => ContinuousLinearMap.prod (0 : Space d →L[ℝ] Time) + (ContinuousLinearMap.id ℝ (Space d)))) := by ext y rw [time_integral_iteratedFDeriv_apply] rw [← ContinuousMultilinearMap.integral_apply] rfl - simp only [Nat.succ_eq_add_one] exact iteratedFDeriv_integrable η x /-! @@ -802,12 +820,12 @@ lemma time_integral_iteratedFDeriv_eq {d : ℕ} (n : ℕ) (η : 𝓢(Time × Spa -/ -lemma time_integral_iteratedFDeriv_norm_le {d : ℕ} (n : ℕ) (η : 𝓢(Time × Space d.succ, ℝ)) - (x : Space d.succ) : +lemma time_integral_iteratedFDeriv_norm_le {d : ℕ} (n : ℕ) (η : 𝓢(Time × Space d, ℝ)) + (x : Space d) : ‖iteratedFDeriv ℝ n (fun x => ∫ (t : Time), η (t, x)) x‖ ≤ (∫ (t : Time), ‖iteratedFDeriv ℝ n η (t, x)‖) * - ‖(ContinuousLinearMap.prod (0 : Space d.succ →L[ℝ] Time) - (ContinuousLinearMap.id ℝ (Space d.succ)))‖ ^ n := by + ‖(ContinuousLinearMap.prod (0 : Space d →L[ℝ] Time) + (ContinuousLinearMap.id ℝ (Space d)))‖ ^ n := by rw [time_integral_iteratedFDeriv_eq] apply le_trans (ContinuousMultilinearMap.norm_compContinuousLinearMap_le _ _) simp @@ -820,11 +838,11 @@ lemma time_integral_iteratedFDeriv_norm_le {d : ℕ} (n : ℕ) (η : 𝓢(Time -/ lemma time_integral_mul_pow_iteratedFDeriv_norm_le {d : ℕ} (n m : ℕ) : - ∃ rt, ∀ (η : 𝓢(Time × Space d.succ, ℝ)),∀ (x : Space d.succ), + ∃ rt, ∀ (η : 𝓢(Time × Space d, ℝ)),∀ (x : Space d), Integrable (fun x : Time => ‖((1 + ‖x‖) ^ rt)⁻¹‖) volume ∧ ‖x‖ ^ m * ‖iteratedFDeriv ℝ n (fun x => ∫ (t : Time), η (t, x)) x‖ ≤ ((∫ (t : Time), ‖((1 + ‖t‖) ^ rt)⁻¹‖) * - ‖((0 : Space d.succ →L[ℝ] Time).prod (.id ℝ (Space d.succ)))‖ ^ n) + ‖((0 : Space d →L[ℝ] Time).prod (.id ℝ (Space d)))‖ ^ n) * (2 ^ (rt + m, n).1 * ((Finset.Iic (rt + m, n)).sup fun m => SchwartzMap.seminorm ℝ m.1 m.2) η) := by obtain ⟨rt, hrt⟩ := pow_mul_iteratedFDeriv_norm_le (n := n) (m := m) (d := d) @@ -838,15 +856,15 @@ lemma time_integral_mul_pow_iteratedFDeriv_norm_le {d : ℕ} (n m : ℕ) : have hk' : 0 ≤ k := by rw [← hk]; positivity calc _ _ ≤ ‖x‖ ^ m * ((∫ (t : Time), ‖iteratedFDeriv ℝ n η (t, x)‖) * - ‖((0 : Space d.succ →L[ℝ] Time).prod (.id ℝ (Space d.succ)))‖ ^ n) := by + ‖((0 : Space d →L[ℝ] Time).prod (.id ℝ (Space d)))‖ ^ n) := by refine mul_le_mul_of_nonneg (by rfl) ?_ (by positivity) (by positivity) exact time_integral_iteratedFDeriv_norm_le n η x _ ≤ (∫ (t : Time), ‖x‖ ^ m * ‖iteratedFDeriv ℝ n η (t, x)‖) * - ‖((0 : Space d.succ →L[ℝ] Time).prod (.id ℝ (Space d.succ)))‖ ^ n := by + ‖((0 : Space d →L[ℝ] Time).prod (.id ℝ (Space d)))‖ ^ n := by apply le_of_eq rw [← mul_assoc, MeasureTheory.integral_const_mul] _ ≤ (∫ (t : Time), ‖(t, x)‖ ^ m * ‖iteratedFDeriv ℝ n η (t, x)‖) * - ‖((0 : Space d.succ →L[ℝ] Time).prod (.id ℝ (Space d.succ)))‖ ^ n := by + ‖((0 : Space d →L[ℝ] Time).prod (.id ℝ (Space d)))‖ ^ n := by refine mul_le_mul_of_nonneg ?_ (by rfl) (by positivity) (by positivity) refine integral_mono ?_ ?_ ?_ · apply Integrable.const_mul @@ -858,7 +876,7 @@ lemma time_integral_mul_pow_iteratedFDeriv_norm_le {d : ℕ} (n m : ℕ) : refine pow_le_pow_left₀ (by positivity) ?_ m simp _ ≤ ((∫ (t : Time), k * ‖((1 + ‖t‖) ^ rt)⁻¹‖)) * - ‖((0 : Space d.succ →L[ℝ] Time).prod (.id ℝ (Space d.succ)))‖ ^ n := by + ‖((0 : Space d →L[ℝ] Time).prod (.id ℝ (Space d)))‖ ^ n := by refine mul_le_mul_of_nonneg ?_ (by rfl) (by positivity) (by positivity) refine integral_mono ?_ ?_ ?_ · exact iteratedFDeriv_norm_mul_pow_integrable n m η x @@ -880,18 +898,17 @@ lemma time_integral_mul_pow_iteratedFDeriv_norm_le {d : ℕ} (n m : ℕ) : /-- The continuous linear map taking Schwartz maps on `Time × Space d` to `space d` by integrating over time. -/ def timeIntegralSchwartz {d : ℕ} : - 𝓢(Time × Space d.succ, ℝ) →L[ℝ] 𝓢(Space d.succ, ℝ) := by + 𝓢(Time × Space d, ℝ) →L[ℝ] 𝓢(Space d, ℝ) := by refine SchwartzMap.mkCLM (fun η x => ∫ (t : Time), η (t, x)) ?_ ?_ ?_ ?_ · intro η1 η2 x - simp only [Nat.succ_eq_add_one, add_apply] + simp only [SchwartzMap.add_apply] rw [integral_add] · exact integrable_time_integral η1 x · exact integrable_time_integral η2 x · intro a η x - simp only [Nat.succ_eq_add_one, smul_apply, smul_eq_mul, RingHom.id_apply] + simp only [SchwartzMap.smul_apply, smul_eq_mul, RingHom.id_apply] rw [integral_const_mul] · intro η - simp only [Nat.succ_eq_add_one] refine contDiff_infty.mpr ?_ intro n exact time_integral_contDiff n η @@ -900,7 +917,7 @@ def timeIntegralSchwartz {d : ℕ} : obtain ⟨rt, hrt⟩ := time_integral_mul_pow_iteratedFDeriv_norm_le (d := d) (n := n) (m := m) use (Finset.Iic (rt + m, n)) use 2 ^ (rt + m, n).1 * (∫ (t : Time), ‖((1 + ‖t‖) ^ rt)⁻¹‖) * - ‖((0 : Space d.succ →L[ℝ] Time).prod (.id ℝ (Space d.succ)))‖ ^ n + ‖((0 : Space d →L[ℝ] Time).prod (.id ℝ (Space d)))‖ ^ n apply And.intro · positivity intro η x @@ -911,7 +928,7 @@ def timeIntegralSchwartz {d : ℕ} : ring_nf rfl -lemma timeIntegralSchwartz_apply {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ)) (x : Space d.succ) : +lemma timeIntegralSchwartz_apply {d : ℕ} (η : 𝓢(Time × Space d, ℝ)) (x : Space d) : timeIntegralSchwartz η x = ∫ (t : Time), η (t, x) := by rfl /-! @@ -923,7 +940,7 @@ lemma timeIntegralSchwartz_apply {d : ℕ} (η : 𝓢(Time × Space d.succ, ℝ) /-- Distributions on `Time × Space d` from distributions on `Space d`. These distributions are constant in time. -/ def constantTime {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] {d : ℕ} : - ((Space d.succ) →d[ℝ] M) →ₗ[ℝ] (Time × Space d.succ) →d[ℝ] M where + ((Space d) →d[ℝ] M) →ₗ[ℝ] (Time × Space d) →d[ℝ] M where toFun f := f ∘L timeIntegralSchwartz map_add' f g := by ext η @@ -933,8 +950,8 @@ def constantTime {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] {d : ℕ} simp lemma constantTime_apply {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] - {d : ℕ} (f : (Space d.succ) →d[ℝ] M) - (η : 𝓢(Time × Space d.succ, ℝ)) : + {d : ℕ} (f : (Space d) →d[ℝ] M) + (η : 𝓢(Time × Space d, ℝ)) : constantTime f η = f (timeIntegralSchwartz η) := by rfl /-! @@ -942,12 +959,12 @@ lemma constantTime_apply {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] ### E.1. Space derivatives of constant time distributions -/ -lemma constantTime_spaceDerivD {M : Type} {d : ℕ} [NormedAddCommGroup M] [NormedSpace ℝ M] - (i : Fin d.succ) (f : (Space d.succ) →d[ℝ] M) : - Space.spaceDerivD i (constantTime f) = constantTime (Space.derivD i f) := by +lemma constantTime_distSpaceDeriv {M : Type} {d : ℕ} [NormedAddCommGroup M] [NormedSpace ℝ M] + (i : Fin d) (f : (Space d) →d[ℝ] M) : + Space.distSpaceDeriv i (constantTime f) = constantTime (Space.distDeriv i f) := by ext η simp [constantTime_apply] - rw [Space.derivD_apply, Space.spaceDerivD_apply] + rw [Space.distDeriv_apply, Space.distSpaceDeriv_apply] rw [fderivD_apply, fderivD_apply, constantTime_apply] congr 2 ext x @@ -966,8 +983,9 @@ lemma constantTime_spaceDerivD {M : Type} {d : ℕ} [NormedAddCommGroup M] [Norm funext t change (fderiv ℝ (η ∘ fun x => (t, x)) x) (basis i) = _ rw [fderiv_comp, DifferentiableAt.fderiv_prodMk] - simp - rfl + simp only [fderiv_fun_const, Pi.zero_apply, fderiv_id', ContinuousLinearMap.coe_comp', + Function.comp_apply, ContinuousLinearMap.prod_apply, ContinuousLinearMap.zero_apply, + ContinuousLinearMap.coe_id', id_eq] · fun_prop · fun_prop · apply Differentiable.differentiableAt @@ -980,13 +998,13 @@ lemma constantTime_spaceDerivD {M : Type} {d : ℕ} [NormedAddCommGroup M] [Norm -/ -lemma constantTime_spaceGradD {d : ℕ} (f : (Space d.succ) →d[ℝ] ℝ) : - Space.spaceGradD (constantTime f) = constantTime (Space.gradD f) := by +lemma constantTime_distSpaceGrad {d : ℕ} (f : (Space d) →d[ℝ] ℝ) : + Space.distSpaceGrad (constantTime f) = constantTime (Space.distGrad f) := by ext η i simp [constantTime_apply] - rw [Space.spaceGradD_apply, Space.gradD_apply] + rw [Space.distSpaceGrad_apply, Space.distGrad_apply] simp only - rw [constantTime_spaceDerivD, constantTime_apply] + rw [constantTime_distSpaceDeriv, constantTime_apply] /-! @@ -994,14 +1012,14 @@ lemma constantTime_spaceGradD {d : ℕ} (f : (Space d.succ) →d[ℝ] ℝ) : -/ -lemma constantTime_spaceDivD {d : ℕ} (f : (Space d.succ) →d[ℝ] EuclideanSpace ℝ (Fin d.succ)) : - Space.spaceDivD (constantTime f) = constantTime (Space.divD f) := by +lemma constantTime_distSpaceDiv {d : ℕ} (f : (Space d) →d[ℝ] EuclideanSpace ℝ (Fin d)) : + Space.distSpaceDiv (constantTime f) = constantTime (Space.distDiv f) := by ext η simp [constantTime_apply] - rw [Space.spaceDivD_apply_eq_sum_spaceDerivD, Space.divD_apply_eq_sum_derivD] + rw [Space.distSpaceDiv_apply_eq_sum_distSpaceDeriv, Space.distDiv_apply_eq_sum_distDeriv] congr funext i - rw [constantTime_spaceDerivD] + rw [constantTime_distSpaceDeriv] rfl /-! @@ -1011,12 +1029,12 @@ lemma constantTime_spaceDivD {d : ℕ} (f : (Space d.succ) →d[ℝ] EuclideanSp -/ lemma constantTime_spaceCurlD (f : (Space 3) →d[ℝ] EuclideanSpace ℝ (Fin 3)) : - Space.spaceCurlD (constantTime f) = constantTime (Space.curlD f) := by + Space.distSpaceCurl (constantTime f) = constantTime (Space.distCurl f) := by ext η i rw [constantTime_apply] fin_cases i all_goals - simp [Space.spaceCurlD, Space.curlD, constantTime_spaceDerivD, constantTime_apply] + simp [Space.distSpaceCurl, Space.distCurl, constantTime_distSpaceDeriv, constantTime_apply] rfl /-! @@ -1026,14 +1044,13 @@ lemma constantTime_spaceCurlD (f : (Space 3) →d[ℝ] EuclideanSpace ℝ (Fin 3 -/ @[simp] -lemma constantTime_timeDerivD {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] {d : ℕ} - (f : (Space d.succ) →d[ℝ] M) : - Space.timeDerivD (constantTime f) = 0 := by +lemma constantTime_distTimeDeriv {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ M] {d : ℕ} + (f : (Space d) →d[ℝ] M) : + Space.distTimeDeriv (constantTime f) = 0 := by ext η - rw [Space.timeDerivD_apply] - rw [fderivD_apply] - simp [constantTime_apply] - suffices h : (timeIntegralSchwartz ((SchwartzMap.evalCLM (1, 0)) ((fderivCLM ℝ) η))) = 0 by + simp [Space.distTimeDeriv_apply, fderivD_apply, constantTime_apply] + suffices h : (timeIntegralSchwartz ((SchwartzMap.evalCLM ℝ (Time × Space d) ℝ (1, 0)) + ((fderivCLM ℝ (Time × Space d) ℝ) η))) = 0 by rw [h] simp ext x @@ -1045,7 +1062,7 @@ lemma constantTime_timeDerivD {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ funext t change _ = (fderiv ℝ (η ∘ fun t => (t, x)) t) 1 rw [fderiv_comp, DifferentiableAt.fderiv_prodMk] - simp only [Nat.succ_eq_add_one, fderiv_id', fderiv_fun_const, Pi.zero_apply, + simp only [fderiv_id', fderiv_fun_const, Pi.zero_apply, ContinuousLinearMap.coe_comp', Function.comp_apply, ContinuousLinearMap.prod_apply, ContinuousLinearMap.coe_id', id_eq, ContinuousLinearMap.zero_apply] · fun_prop @@ -1068,8 +1085,7 @@ lemma constantTime_timeDerivD {M : Type} [NormedAddCommGroup M] [NormedSpace ℝ simp only [Nat.succ_eq_add_one, fderiv_id', fderiv_fun_const, Pi.zero_apply, ContinuousLinearMap.coe_comp', Function.comp_apply, ContinuousLinearMap.prod_apply, ContinuousLinearMap.coe_id', id_eq, ContinuousLinearMap.zero_apply] - change SchwartzMap.pderivCLM ℝ (1, 0) η (t, x) - exact integrable_time_integral ((pderivCLM ℝ (1, 0)) η) x + exact integrable_time_integral (LineDeriv.lineDerivOpCLM ℝ _ ((1, 0) : Time × Space d) η) x · simp exact integrable_time_integral η x · fun_prop diff --git a/PhysLean/StatisticalMechanics/BoltzmannConstant.lean b/PhysLean/StatisticalMechanics/BoltzmannConstant.lean index 065ea3b36..5ddf4e05a 100644 --- a/PhysLean/StatisticalMechanics/BoltzmannConstant.lean +++ b/PhysLean/StatisticalMechanics/BoltzmannConstant.lean @@ -11,16 +11,17 @@ import Mathlib.Data.NNReal.Defs The Boltzmann constant is a constant `kB` of dimension `m² kg s⁻² K⁻¹`, that is `Energy/Temperature`. It is named after Ludwig Boltzmann. -In this module we axiomise the existence of the Boltzmann constant in a given (but arbitrary) -set of units. +In this module give the value of the Boltzmann constant. -/ open NNReal namespace Constants -/-- The axiom introducing the Boltzmann constant in a given but arbitrary set of units. -/ -axiom kBAx : {p : ℝ | 0 < p} +/-- The Boltzmann constant in units of `m ^ 2 kg s ^ (-2) K ^ (-1)`. + As long as one does not use the underlying value of this quantity, + then it can be used as Boltzmann's constant in an arbitrary set of units. -/ +def kBAx : {p : ℝ | 0 < p} := ⟨1.380649e-23, by norm_num⟩ /-- The Boltzmann constant in a given but arbitrary set of units. Boltzman's constant has dimension equivalent to `Energy/Temperature`. -/ @@ -33,7 +34,7 @@ lemma kB_pos : 0 < kB := kBAx.2 lemma kB_nonneg : 0 ≤ kB := le_of_lt kBAx.2 /-- The Boltzmann constant is not equal to zero. -/ -lemma kB_neq_zero : kB ≠ 0 := by +lemma kB_ne_zero : kB ≠ 0 := by linarith [kB_pos] end Constants diff --git a/PhysLean/StatisticalMechanics/CanonicalEnsemble/Finite.lean b/PhysLean/StatisticalMechanics/CanonicalEnsemble/Finite.lean index 969a05109..faeb73508 100644 --- a/PhysLean/StatisticalMechanics/CanonicalEnsemble/Finite.lean +++ b/PhysLean/StatisticalMechanics/CanonicalEnsemble/Finite.lean @@ -294,7 +294,7 @@ lemma sum_probability_eq_one have hZpos := mathematicalPartitionFunction_pos_finite (𝓒:=𝓒) (T:=T) have hZne : 𝓒.mathematicalPartitionFunction T ≠ 0 := hZpos.ne' simp [hZdef] - simp_all only [neg_mul, ne_eq, not_false_eq_true, div_self] + simp_all only [neg_mul, ne_eq, not_false_eq_true] /-- The entropy of a finite canonical ensemble (Shannon entropy) is non-negative. -/ lemma entropy_nonneg [MeasurableSingletonClass ι] [IsFinite 𝓒] [Nonempty ι] (T : Temperature) : diff --git a/PhysLean/StatisticalMechanics/CanonicalEnsemble/Lemmas.lean b/PhysLean/StatisticalMechanics/CanonicalEnsemble/Lemmas.lean index 5e1646b08..ef1c14fcf 100644 --- a/PhysLean/StatisticalMechanics/CanonicalEnsemble/Lemmas.lean +++ b/PhysLean/StatisticalMechanics/CanonicalEnsemble/Lemmas.lean @@ -125,7 +125,7 @@ lemma log_probability @[simp] lemma kB_mul_beta (T : Temperature) (hT : 0 < T.val) : (kB : ℝ) * (T.β : ℝ) = 1 / T.val := by - have hkB : (kB : ℝ) ≠ 0 := kB_neq_zero + have hkB : (kB : ℝ) ≠ 0 := kB_ne_zero have hT0 : (T.val : ℝ) ≠ 0 := by exact_mod_cast (ne_of_gt hT) simp [Temperature.β] @@ -339,7 +339,7 @@ theorem differentialEntropy_eq_meanEnergy_sub_helmholtz_div_temp_add_correction have hkβ : kB * (T.β : ℝ) = 1 / (T.val : ℝ) := by unfold Temperature.β change kB * (1 / (kB * (T.val : ℝ))) = 1 / (T.val : ℝ) - field_simp [Constants.kB_neq_zero, Tne] + field_simp [Constants.kB_ne_zero, Tne] have hS' : 𝓒.differentialEntropy T = E / T.val + kB * Real.log Zmath := by rw [hS, hkβ] @@ -796,7 +796,7 @@ theorem fluctuation_dissipation_energy_parametric 𝓒.heatCapacity T = dUdβ * (-1 / (kB * (T.val : ℝ)^2)) := heatCapacity_eq_deriv_meanEnergyBeta 𝓒 T hT_pos hU_deriv.hasDerivWithinAt rw [hCV_eq_dUdβ_mul, h_Var_eq_neg_dUdβ] - have hkB_ne_zero := kB_neq_zero + have hkB_ne_zero := kB_ne_zero field_simp [hkB_ne_zero, pow_ne_zero 2] ring diff --git a/PhysLean/StatisticalMechanics/CanonicalEnsemble/TwoState.lean b/PhysLean/StatisticalMechanics/CanonicalEnsemble/TwoState.lean index 918b088e6..73655c342 100644 --- a/PhysLean/StatisticalMechanics/CanonicalEnsemble/TwoState.lean +++ b/PhysLean/StatisticalMechanics/CanonicalEnsemble/TwoState.lean @@ -19,91 +19,79 @@ namespace CanonicalEnsemble open Temperature open Real MeasureTheory -TODO "EVJNH" "Generalize the results for the two-state canonical ensemble so that the two - states have arbitrary energies, rather than one state having energy `0`." - /-- The canonical ensemble corresponding to state system, with one state of energy - `E` and the other state of energy `0`. -/ -noncomputable def twoState (E : ℝ) : CanonicalEnsemble (Fin 2) where - energy := fun | 0 => 0 | 1 => E + `E₀` and the other state of energy `E₁`. -/ +noncomputable def twoState (E₀ E₁ : ℝ) : CanonicalEnsemble (Fin 2) where + energy := fun | 0 => E₀ | 1 => E₁ dof := 0 μ := Measure.count energy_measurable := by fun_prop -instance {E} : IsFinite (twoState E) where +instance {E₀ E₁} : IsFinite (twoState E₀ E₁) where μ_eq_count := rfl dof_eq_zero := rfl phase_space_unit_eq_one := rfl -lemma twoState_partitionFunction_apply_eq_one_add_exp (E : ℝ) (T : Temperature) : - (twoState E).partitionFunction T = 1 + exp (- β T * E) := by +lemma twoState_partitionFunction_apply (E₀ E₁ : ℝ) (T : Temperature) : + (twoState E₀ E₁).partitionFunction T = exp (- β T * E₀) + exp (- β T * E₁) := by rw [partitionFunction_of_fintype, twoState] - simp + simp [Fin.sum_univ_two] -lemma twoState_partitionFunction_apply_eq_cosh (E : ℝ) (T : Temperature) : - (twoState E).partitionFunction T = 2 * exp (- β T * E / 2) * cosh (β T * E / 2) := by - rw [twoState_partitionFunction_apply_eq_one_add_exp, Real.cosh_eq] - field_simp - simp only [mul_add, ← exp_add, neg_add_cancel, exp_zero, add_right_inj, exp_eq_exp] +lemma twoState_partitionFunction_apply_eq_cosh (E₀ E₁ : ℝ) (T : Temperature) : + (twoState E₀ E₁).partitionFunction T = + 2 * exp (- β T * (E₀ + E₁) / 2) * cosh (β T * (E₁ - E₀) / 2) := by + rw [twoState_partitionFunction_apply, Real.cosh_eq] field_simp - ring + simp only [mul_add, ← exp_add] + ring_nf @[simp] -lemma twoState_energy_fst (E : ℝ) : (twoState E).energy 0 = 0 := by +lemma twoState_energy_fst (E₀ E₁ : ℝ) : (twoState E₀ E₁).energy 0 = E₀ := by rfl @[simp] -lemma twoState_energy_snd (E : ℝ) : (twoState E).energy 1 = E := by +lemma twoState_energy_snd (E₀ E₁ : ℝ) : (twoState E₀ E₁).energy 1 = E₁ := by rfl -/-- Probability of the excited (energy `E`) state in closed form. -/ -lemma twoState_probability_snd (E : ℝ) (T : Temperature) : - (twoState E).probability T 1 = 1 / 2 * (1 - Real.tanh (β T * E / 2)) := by - have h_basic : - (twoState E).probability T 1 = - Real.exp (-β T * E) / (1 + Real.exp (-β T * E)) := by - -- The mathematical partition function of `twoState` is `1 + e^{-βE}`. - have hZ : - (twoState E).mathematicalPartitionFunction T = - 1 + Real.exp (-β T * E) := by - rw [mathematicalPartitionFunction_of_fintype] - simp [twoState, Fin.sum_univ_two] - simp [probability, hZ] - set x : ℝ := β T * E with hx - have h_sym : - Real.exp (-x) / (1 + Real.exp (-x)) = - Real.exp (-x / 2) / (Real.exp (x / 2) + Real.exp (-x / 2)) := by - calc - _ = (Real.exp (-x) * Real.exp (x / 2)) / ((1 + Real.exp (-x)) * Real.exp (x / 2)) := by - field_simp - _ = _ := by - congr - · rw [← Real.exp_add]; ring_nf - · rw [add_mul, one_mul, ← Real.exp_add]; ring_nf - have h_tanh (y : ℝ) : - 1 / 2 * (1 - Real.tanh y) = Real.exp (-y) / (Real.exp y + Real.exp (-y)) := by - rw [Real.tanh_eq_sinh_div_cosh, Real.sinh_eq, Real.cosh_eq, Real.exp_neg] - field_simp - ring - have h_half : - Real.exp (-x / 2) / (Real.exp (x / 2) + Real.exp (-x / 2)) = - 1 / 2 * (1 - Real.tanh (x / 2)) := by - rw [h_tanh] - ring_nf - calc - (twoState E).probability T 1 - = Real.exp (-x) / (1 + Real.exp (-x)) := by rw [hx, h_basic]; ring_nf - _ = Real.exp (-x / 2) / (Real.exp (x / 2) + Real.exp (-x / 2)) := h_sym - _ = 1 / 2 * (1 - Real.tanh (x / 2)) := h_half - _ = 1 / 2 * (1 - Real.tanh (β T * E / 2)) := by rw [hx] - -lemma twoState_meanEnergy_eq (E : ℝ) (T : Temperature) : - (twoState E).meanEnergy T = E / 2 * (1 - tanh (β T * E / 2)) := by - calc - _ = ∑ i : Fin 2, (twoState E).energy i * (twoState E).probability T i := - meanEnergy_of_fintype (twoState E) T - _ = E * (twoState E).probability T 1 := by simp [twoState] - rw [twoState_probability_snd] +/-- Probability of the first state (energy `E₀`) in closed form. -/ +lemma twoState_probability_fst (E₀ E₁ : ℝ) (T : Temperature) : + (twoState E₀ E₁).probability T 0 = 1 / 2 * (1 + Real.tanh (β T * (E₁ - E₀) / 2)) := by + set x := β T * (E₁ - E₀) / 2 + set C := β T * (E₀ + E₁) / 2 + have hE0 : - β T * E₀ = x - C := by + simp [x, C]; ring + have hE1 : - β T * E₁ = -x - C := by + simp [x, C]; ring + rw [probability, mathematicalPartitionFunction_of_fintype] + simp only [twoState, Fin.sum_univ_two, Fin.isValue] + rw [hE0, hE1] + rw [Real.tanh_eq_sinh_div_cosh, Real.sinh_eq, Real.cosh_eq] + simp only [Real.exp_sub, Real.exp_neg] + field_simp + ring + +/-- Probability of the second state (energy `E₁`) in closed form. -/ +lemma twoState_probability_snd (E₀ E₁ : ℝ) (T : Temperature) : + (twoState E₀ E₁).probability T 1 = 1 / 2 * (1 - Real.tanh (β T * (E₁ - E₀) / 2)) := by + set x := β T * (E₁ - E₀) / 2 + set C := β T * (E₀ + E₁) / 2 + have hE0 : - β T * E₀ = x - C := by + simp [x, C]; ring + have hE1 : - β T * E₁ = -x - C := by + simp [x, C]; ring + rw [probability, mathematicalPartitionFunction_of_fintype] + simp only [twoState, Fin.sum_univ_two, Fin.isValue] + rw [hE0, hE1] + rw [Real.tanh_eq_sinh_div_cosh, Real.sinh_eq, Real.cosh_eq] + simp only [Real.exp_sub, Real.exp_neg] + field_simp + ring + +lemma twoState_meanEnergy_eq (E₀ E₁ : ℝ) (T : Temperature) : + (twoState E₀ E₁).meanEnergy T = + (E₀ + E₁) / 2 - (E₁ - E₀) / 2 * Real.tanh (β T * (E₁ - E₀) / 2) := by + rw [meanEnergy_of_fintype] + simp [Fin.sum_univ_two, twoState_probability_fst, twoState_probability_snd] ring /-- A simplification of the `entropy` of the two-state canonical ensemble. -/ diff --git a/PhysLean/StringTheory/FTheory/SU5/Quanta/FiveQuanta.lean b/PhysLean/StringTheory/FTheory/SU5/Quanta/FiveQuanta.lean index 90f4f6d6f..525f19d2d 100644 --- a/PhysLean/StringTheory/FTheory/SU5/Quanta/FiveQuanta.lean +++ b/PhysLean/StringTheory/FTheory/SU5/Quanta/FiveQuanta.lean @@ -698,7 +698,7 @@ lemma decompose_toCharges_dedup [DecidableEq 𝓩] (x : FiveQuanta 𝓩) x.decompose.toCharges.dedup = x.toCharges.dedup := by refine Multiset.dedup_ext.mpr ?_ intro q - simp [decompose, toCharges] + simp [decompose, toCharges, -existsAndEq] constructor · rintro ⟨a, b, c, h1, h2, rfl⟩ exact ⟨c, h1⟩ @@ -780,7 +780,7 @@ def liftCharge (c : Finset 𝓩) : Multiset (FiveQuanta 𝓩) := /- Pairs of multisets (s1, s2) such that s1 and s2 are cardinality of `3` containing elements of `c` and that all elements of `c` are in `s1 + s2`. -/ let S5p : Multiset (Multiset 𝓩 × Multiset 𝓩) := - (S53.product S53).filter fun (s1, s2) => c.val ≤ s1 + s2 + (S53 ×ˢ S53).filter fun (s1, s2) => c.val ≤ s1 + s2 let Fp : Multiset (FiveQuanta 𝓩) := S5p.map (fun y => y.1.map (fun z => (z, ⟨1, -1⟩)) + y.2.map (fun z => (z, ⟨0, 1⟩))) Fp.map reduce diff --git a/PhysLean/StringTheory/FTheory/SU5/Quanta/TenQuanta.lean b/PhysLean/StringTheory/FTheory/SU5/Quanta/TenQuanta.lean index 03cc4fa06..358abc48c 100644 --- a/PhysLean/StringTheory/FTheory/SU5/Quanta/TenQuanta.lean +++ b/PhysLean/StringTheory/FTheory/SU5/Quanta/TenQuanta.lean @@ -760,7 +760,7 @@ lemma decompose_toCharges_dedup [DecidableEq 𝓩] (x : TenQuanta 𝓩) x.decompose.toCharges.dedup = x.toCharges.dedup := by refine Multiset.dedup_ext.mpr ?_ intro q - simp [decompose, toCharges] + simp [decompose, toCharges, -existsAndEq] constructor · rintro ⟨a, b, c, h1, h2, rfl⟩ exact ⟨c, h1⟩ @@ -886,7 +886,6 @@ lemma toCharge_toFinset_of_mem_liftCharge (c : Finset 𝓩) simpa using Multiset.mem_of_le h' hr · intro hr simp at hr - simp only [SProd.sprod, Multiset.mem_product] at h rcases hr with rfl | rfl | rfl · exact h.1 · exact h.2.1 @@ -985,9 +984,8 @@ lemma mem_liftCharge_of_exists_toCharges_toFluxesTen (c : Finset 𝓩) {x : TenQ obtain ⟨p3, hp3, hp3_2⟩ := h2 apply And.intro · use p1.1, p2.1, p3.1 - simp only [SProd.sprod, Multiset.mem_product] subst h - simp only [Multiset.toFinset_val, Multiset.mem_dedup, Int.reduceNeg] + simp only [Multiset.toFinset_val, Multiset.mem_product, Multiset.mem_dedup, Int.reduceNeg] refine ⟨⟨?_, ?_, ?_⟩, ?_⟩ · simp [toCharges] use p1.2 diff --git a/PhysLean/Thermodynamics/IdealGas/Basic.lean b/PhysLean/Thermodynamics/IdealGas/Basic.lean new file mode 100644 index 000000000..24a339c48 --- /dev/null +++ b/PhysLean/Thermodynamics/IdealGas/Basic.lean @@ -0,0 +1,212 @@ +/- +Copyright (c) 2025 Fabio Anza. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mitch Scheffer, Fabio Anza +-/ +import Mathlib.Analysis.SpecialFunctions.Pow.Real -- for Real.rpow_def_of_pos + +/-! +# Ideal gas: basic entropy and adiabatic relations + +In this module we formalize a simple thermodynamic model of a monophase +ideal gas. We: + +* Define the entropy + S(U,V,N) = N s₀ + N R (c \log(U/U₀) + \log(V/V₀) - (c+1)\log(N/N₀)), +* Prove equivalent formulations of the adiabatic relation for two states + (U_a, V_a) and (U_b, V_b) at fixed N: + + 1. c \log(U_a/U_b) + \log(V_a/V_b) = 0, + 2. (U_a/U_b)^c (V_a/V_b) = 1, + 3. U_a^c V_a = U_b^c V_b (the latter follows from (2)). +-/ + +open Real + +noncomputable section + +/-- Entropy of a monophase ideal gas: + S(U,V,N) = N s0 + N R (c log(U/U0) + log(V/V0) - (c+1) log(N/N0)). -/ +def entropy + (c R s0 U0 V0 N0 : ℝ) (U V N : ℝ) : ℝ := + N * s0 + + N * R * + (c * log (U / U0) + + log (V / V0) - + (c + 1) * log (N / N0)) + +/-- Adiabatic relation in logarithmic form: + If S(Ua,Va,N) = S(Ub,Vb,N) with N fixed, + then c * log (Ua/Ub) + log (Va/Vb) = 0. +-/ +theorem adiabatic_relation_log + {s0 U0 V0 N0 c R : ℝ} + {Ua Ub Va Vb N : ℝ} + (hUa : 0 < Ua) (hUb : 0 < Ub) + (hVa : 0 < Va) (hVb : 0 < Vb) + (hN : 0 < N) + (hU0 : 0 < U0) (hV0 : 0 < V0) + (hR : 0 < R) + (hS : + entropy c R s0 U0 V0 N0 Ua Va N = + entropy c R s0 U0 V0 N0 Ub Vb N) : + c * log (Ua / Ub) + log (Va / Vb) = 0 := by + -- Step 1: cancel `N * s0` and isolate the `N * R * (...)` pieces. + have h1 : + N * R * + (c * log (Ua / U0) + + log (Va / V0) - + (c + 1) * log (N / N0)) = + N * R * + (c * log (Ub / U0) + + log (Vb / V0) - + (c + 1) * log (N / N0)) := by + -- unfold entropy and use `add_left_cancel` to cancel `N * s0` + unfold entropy at hS + -- now `hS` is: N*s0 + N*R*(...) = N*s0 + N*R*(...)` + -- cancel `N*s0` from both sides + exact add_left_cancel hS + + -- Step 2: cancel the common factor `N * R`. + have hNR : N * R ≠ 0 := + mul_ne_zero (ne_of_gt hN) (ne_of_gt hR) + have h2 : + c * log (Ua / U0) + + log (Va / V0) - + (c + 1) * log (N / N0) = + c * log (Ub / U0) + + log (Vb / V0) - + (c + 1) * log (N / N0) := + mul_left_cancel₀ hNR h1 + + -- Step 3: cancel the common `-(c+1) * log (N/N0)` term. + have h3 : + c * log (Ua / U0) + log (Va / V0) = + c * log (Ub / U0) + log (Vb / V0) := by + + -- rewrite with `sub_eq_add_neg` so we can use `add_right_cancel` + + have h2' : + c * log (Ua / U0) + log (Va / V0) + - (c + 1) * log (N / N0) = + c * log (Ub / U0) + log (Vb / V0) + - (c + 1) * log (N / N0) := by + simpa [sub_eq_add_neg, add_assoc, add_left_comm, add_comm] using h2 + -- now cancel the same term on the right + exact add_right_cancel h2' + + -- Step 4: turn this equality into a “difference = 0” form + -- and rearrange algebraically. + have h4 : + c * (log (Ua / U0) - log (Ub / U0)) + + (log (Va / V0) - log (Vb / V0)) = 0 := by + -- from `a = b`, we get `a - b = 0` + have h4' : + (c * log (Ua / U0) + log (Va / V0)) - + (c * log (Ub / U0) + log (Vb / V0)) = 0 := + sub_eq_zero.mpr h3 + -- expand `a - b` and simplify + simpa [sub_eq_add_neg, add_comm, add_left_comm, add_assoc, + mul_add, add_mul, mul_comm, mul_left_comm, mul_assoc] using h4' + + -- Step 5: use `log_div` to turn differences of logs into logs of ratios. + have hUaU0 : 0 < Ua / U0 := div_pos hUa hU0 + have hUbU0 : 0 < Ub / U0 := div_pos hUb hU0 + have hVaV0 : 0 < Va / V0 := div_pos hVa hV0 + have hVbV0 : 0 < Vb / V0 := div_pos hVb hV0 + + have hU : + log (Ua / U0) - log (Ub / U0) = + log ((Ua / U0) / (Ub / U0)) := by + -- log_div hx hy : log (x / y) = log x - log y + -- log_div needs ≠ 0, not just positivity + have hneqx : Ua / U0 ≠ 0 := ne_of_gt hUaU0 + have hneqy : Ub / U0 ≠ 0 := ne_of_gt hUbU0 + + have h := Real.log_div (x := Ua / U0) (y := Ub / U0) hneqx hneqy + -- we want "difference = log(ratio)", so flip and rewrite + simpa [sub_eq_add_neg] using h.symm + + have hV : + log (Va / V0) - log (Vb / V0) = + log ((Va / V0) / (Vb / V0)) := by + -- log_div hx hy : log (x / y) = log x - log y + -- log_div needs ≠ 0, not just positivity + have hneqxV : Va / V0 ≠ 0 := ne_of_gt hVaV0 + have hneqyV : Vb / V0 ≠ 0 := ne_of_gt hVbV0 + + have h := Real.log_div (x := Va / V0) (y := Vb / V0) hneqxV hneqyV + + simpa [sub_eq_add_neg] using h.symm + + have h5 : + c * log ((Ua / U0) / (Ub / U0)) + + log ((Va / V0) / (Vb / V0)) = 0 := by + simpa [hU, hV] using h4 + + -- Step 6: simplify the ratios to Ua/Ub and Va/Vb using `field_simp`. + have h_ratio_U : + (Ua / U0) / (Ub / U0) = Ua / Ub := by + -- `field_simp` uses the nonzero denominators in the context + field_simp [div_eq_mul_inv] + + have h_ratio_V : + (Va / V0) / (Vb / V0) = Va / Vb := by + field_simp [div_eq_mul_inv] + + have h6 : + c * log (Ua / Ub) + log (Va / Vb) = 0 := by + -- rewrite the log arguments using the two equalities above + simpa [h_ratio_U, h_ratio_V] using h5 + + exact h6 + +/-- Adiabatic relation in product form: + If S(Ua,Va,N) = S(Ub,Vb,N) with N fixed, + then (Ua/Ub)^c * (Va/Vb) = 1. +-/ + +theorem adiabatic_relation_UaUbVaVb + {s0 U0 V0 N0 c R : ℝ} + {Ua Ub Va Vb N : ℝ} + (hUa : 0 < Ua) (hUb : 0 < Ub) + (hVa : 0 < Va) (hVb : 0 < Vb) + (hN : 0 < N) + (hU0 : 0 < U0) (hV0 : 0 < V0) + (hR : 0 < R) + (hS : + entropy c R s0 U0 V0 N0 Ua Va N = + entropy c R s0 U0 V0 N0 Ub Vb N) : + (Real.rpow (Ua / Ub) c) * (Va / Vb) = 1 := by + have hlog := adiabatic_relation_log + (Ua := Ua) (Ub := Ub) (Va := Va) (Vb := Vb) (N := N) + hUa hUb hVa hVb hN hU0 hV0 hR hS + + have hUaUb_pos : 0 < Ua / Ub := div_pos hUa hUb + have hVaVb_pos : 0 < Va / Vb := div_pos hVa hVb + + -- exponentiate both sides and rewrite with `rpow` + have h := congrArg Real.exp hlog + have h' : + Real.exp (c * log (Ua / Ub) + log (Va / Vb)) = 1 := by + simpa using h + + -- use `exp_add` and `exp_log` / `rpow_def_of_pos` to rewrite + have hx : + Real.exp (c * log (Ua / Ub)) = (Ua / Ub) ^ c := by + -- rpow_def_of_pos: x^y = exp (y * log x) for x>0 + simp [Real.rpow_def_of_pos hUaUb_pos, mul_comm] + + have hy : + Real.exp (log (Va / Vb)) = Va / Vb := by + have : Va / Vb ≠ 0 := ne_of_gt hVaVb_pos + simpa using Real.exp_log hVaVb_pos + + -- now simplify the LHS of h' + have : + (Ua / Ub) ^ c * (Va / Vb) = 1 := by + have := h' + -- rewrite LHS using `exp_add`, `hx`, `hy` + simpa [Real.exp_add, hx, hy, mul_comm, mul_left_comm, mul_assoc] using this + + exact this diff --git a/PhysLean/Thermodynamics/Temperature/Basic.lean b/PhysLean/Thermodynamics/Temperature/Basic.lean index a7cddcc9e..ef6109dea 100644 --- a/PhysLean/Thermodynamics/Temperature/Basic.lean +++ b/PhysLean/Thermodynamics/Temperature/Basic.lean @@ -80,7 +80,7 @@ lemma ofβ_eq : ofβ = fun β => ⟨⟨1 / (kB * β), by lemma β_ofβ (β' : ℝ≥0) : β (ofβ β') = β' := by ext simp [β, ofβ, toReal] - field_simp [kB_neq_zero] + field_simp [kB_ne_zero] @[simp] lemma ofβ_β (T : Temperature) : ofβ (β T) = T := by @@ -89,7 +89,7 @@ lemma ofβ_β (T : Temperature) : ofβ (β T) = T := by have : (β T : ℝ) = (1 : ℝ) / (kB * (T : ℝ)) := rfl simpa [this] using show (1 / (kB * (1 / (kB * (T : ℝ))))) = (T : ℝ) from by - field_simp [kB_neq_zero] + field_simp [kB_ne_zero] /-- Positivity of `β` from positivity of temperature. -/ lemma beta_pos (T : Temperature) (hT_pos : 0 < T.val) : 0 < (T.β : ℝ) := by @@ -111,7 +111,7 @@ lemma ofβ_continuousOn : ContinuousOn (ofβ : ℝ≥0 → Temperature) (Set.Ioi · fun_prop · simp constructor - · exact kB_neq_zero + · exact kB_ne_zero · exact ne_of_gt hx have hℝ : ContinuousAt (fun b : ℝ≥0 => (1 : ℝ) / (kB * (b : ℝ))) x := h1.comp (continuous_subtype_val.continuousAt) @@ -141,7 +141,7 @@ lemma ofβ_differentiableOn : · fun_prop · intro x hx have hx0 : x ≠ 0 := ne_of_gt (by simpa using hx) - simp [mul_eq_zero, kB_neq_zero, hx0] + simp [mul_eq_zero, kB_ne_zero, hx0] · intro x hx simp at hx have hx' : 0 < x := by simpa using hx @@ -321,7 +321,7 @@ lemma deriv_beta_wrt_T (T : Temperature) (hT_pos : 0 < T.val) : simp [one_div] _ = -1 / (kB * (T.val : ℝ) ^ 2) := by rw [one_div] - field_simp [pow_two, mul_comm, mul_left_comm, mul_assoc, kB_neq_zero, hTne] + field_simp [pow_two, mul_comm, mul_left_comm, mul_assoc, kB_ne_zero, hTne] have h_deriv_f : HasDerivAt f (-1 / (kB * (T.val : ℝ)^2)) (T.val : ℝ) := by simpa [hf_def, h_pow_simp] using h_deriv_aux diff --git a/PhysLean/Thermodynamics/Temperature/TemperatureUnits.lean b/PhysLean/Thermodynamics/Temperature/TemperatureUnits.lean index b7a03b7d0..cff880aba 100644 --- a/PhysLean/Thermodynamics/Temperature/TemperatureUnits.lean +++ b/PhysLean/Thermodynamics/Temperature/TemperatureUnits.lean @@ -5,7 +5,6 @@ Authors: Joseph Tooby-Smith -/ import Mathlib.Geometry.Manifold.Diffeomorph import PhysLean.SpaceAndTime.Time.Basic -import PhysLean.Meta.TODO.Basic /-! # Units on Temperature @@ -19,9 +18,9 @@ positive reals. On `TemperatureUnit` there is an instance of division giving a real number, corresponding to the ratio of the two scales of temperature unit. -To define specific temperature units, we first axiomise the existence of a +To define specific temperature units, we first state the existence of a a given temperature unit, and then construct all other temperature units from it. -We choose to axiomise the +We choose to state the existence of the temperature unit of kelvin, and construct all other temperature units from that. -/ @@ -38,7 +37,7 @@ structure TemperatureUnit where namespace TemperatureUnit @[simp] -lemma val_neq_zero (x : TemperatureUnit) : x.val ≠ 0 := by +lemma val_ne_zero (x : TemperatureUnit) : x.val ≠ 0 := by exact Ne.symm (ne_of_lt x.property) lemma val_pos (x : TemperatureUnit) : 0 < x.val := x.property @@ -59,7 +58,7 @@ lemma div_eq_val (x y : TemperatureUnit) : x / y = (⟨x.val / y.val, div_nonneg (le_of_lt x.val_pos) (le_of_lt y.val_pos)⟩ : ℝ≥0) := rfl @[simp] -lemma div_neq_zero (x y : TemperatureUnit) : ¬ x / y = (0 : ℝ≥0) := by +lemma div_ne_zero (x y : TemperatureUnit) : ¬ x / y = (0 : ℝ≥0) := by rw [div_eq_val] refine coe_ne_zero.mp ?_ simp @@ -68,12 +67,12 @@ lemma div_neq_zero (x y : TemperatureUnit) : ¬ x / y = (0 : ℝ≥0) := by lemma div_pos (x y : TemperatureUnit) : (0 : ℝ≥0) < x/ y := by apply lt_of_le_of_ne · exact zero_le (x / y) - · exact Ne.symm (div_neq_zero x y) + · exact Ne.symm (div_ne_zero x y) @[simp] lemma div_self (x : TemperatureUnit) : x / x = (1 : ℝ≥0) := by - simp [div_eq_val, x.val_neq_zero] + simp [div_eq_val, x.val_ne_zero] lemma div_symm (x y : TemperatureUnit) : x / y = (y / x)⁻¹ := NNReal.eq <| by @@ -130,16 +129,17 @@ lemma scale_scale (x : TemperatureUnit) (r1 r2 : ℝ) (hr1 : 0 < r1) (hr2 : 0 < ## Specific choices of temperature units -To define a specific temperature units, we must first axiomise the existence of a -a given temperature unit, and then construct all other temperature units from it. -We choose to axiomise the existence of the temperature unit of kelvin. +To define a specific temperature units. +We first define the notion of a kelvin to correspond to the temperature unit with underlying value +equal to `1`. This is really down to a choice in the isomorphism between the set of metrics +on the temperature manifold and the positive reals. -We need an axiom since this relates something to something in the physical world. +Once we have defined kelvin, we can define other temperature units by scaling kelvin. -/ -/-- The axiom corresponding to the definition of a temperature unit of kelvin. -/ -axiom kelvin : TemperatureUnit +/-- The definition of a temperature unit of kelvin. -/ +def kelvin : TemperatureUnit := ⟨1, by norm_num⟩ /-- The temperature unit of degrees nanokelvin (10^(-9) kelvin). -/ noncomputable def nanokelvin : TemperatureUnit := scale (1e-9) kelvin diff --git a/PhysLean/Units/Basic.lean b/PhysLean/Units/Basic.lean index 5b4b976bf..13c79c3aa 100644 --- a/PhysLean/Units/Basic.lean +++ b/PhysLean/Units/Basic.lean @@ -156,7 +156,7 @@ lemma dimScale_coe_mul_symm (u1 u2 : UnitChoices) (d : Dimension) : simp @[simp] -lemma dimScale_neq_zero (u1 u2 : UnitChoices) (d : Dimension) : +lemma dimScale_ne_zero (u1 u2 : UnitChoices) (d : Dimension) : dimScale u1 u2 d ≠ 0 := by simp [dimScale] @@ -189,7 +189,7 @@ lemma dimScale_pos (u1 u2 : UnitChoices) (d : Dimension) : 0 < (dimScale u1 u2 d) := by apply lt_of_le_of_ne · simp - · exact Ne.symm (dimScale_neq_zero u1 u2 d) + · exact Ne.symm (dimScale_ne_zero u1 u2 d) TODO "LCSAY" "Make SI : UnitChoices computable, probably by replacing the axioms defining the units. See here: diff --git a/PhysLean/Units/Examples.lean b/PhysLean/Units/Examples.lean index 1e3bf8c5d..0850a3478 100644 --- a/PhysLean/Units/Examples.lean +++ b/PhysLean/Units/Examples.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Units.WithDim.Speed -import Mathlib.Analysis.SpecialFunctions.Trigonometric.Complex /-! # Examples of units in PhysLean @@ -143,7 +142,7 @@ lemma energyMass_isDimensionallyCorrect : IsDimensionallyCorrect EnergyMass := by /- Scale such that the unit u1 is taken to u2. -/ intro u1 u2 - /- Let `m` be the mass, `E` be the energy and `u` be the acutal units we start with. -/ + /- Let `m` be the mass, `E` be the energy and `u` be the actual units we start with. -/ funext m E u calc _ _ = ((scaleUnit u2 u1 E).1 = @@ -173,7 +172,7 @@ lemma energyMass_isDimensionallyCorrect : (m.1 * ((speedOfLight.1 u).1) ^ 2)) := by rfl simp only [map_mul, NNReal.val_eq_coe, NNReal.coe_mul, smul_eq_mul, mul_eq_mul_left_iff, - mul_eq_zero, NNReal.coe_eq_zero, dimScale_neq_zero, or_self, or_false, eq_iff_iff] + mul_eq_zero, NNReal.coe_eq_zero, dimScale_ne_zero, or_self, or_false, eq_iff_iff] rfl /-! diff --git a/PhysLean/Units/Integral.lean b/PhysLean/Units/Integral.lean index 62c876b34..b1d7dc136 100644 --- a/PhysLean/Units/Integral.lean +++ b/PhysLean/Units/Integral.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Tooby-Smith -/ import PhysLean.Units.UnitDependent -import Mathlib.MeasureTheory.Integral.Bochner.Basic /-! # Dimensional invariance of the integral diff --git a/README.md b/README.md index 701e6e291..28e2cfcc6 100644 --- a/README.md +++ b/README.md @@ -19,23 +19,37 @@ [![](https://img.shields.io/badge/PhysLean-Search-purple)](https://loogle.physlean.com) [![](https://img.shields.io/badge/PhysLean-Online-purple)](https://live.physlean.com) - [![](https://img.shields.io/badge/View_The-Stats-blue)](https://physlean.com/Stats) -[![](https://img.shields.io/badge/Lean-v4.24.0-blue)](https://github.com/leanprover/lean4/releases/tag/v4.24.0) +[![](https://img.shields.io/badge/View_The-Stats-blue)](https://physlean.com/Stats) +[![](https://img.shields.io/badge/Lean-v4.28.0-blue)](https://github.com/leanprover/lean4/releases/tag/v4.28.0) [![Gitpod Ready-to-Code](https://img.shields.io/badge/Gitpod-ready--to--code-blue?logo=gitpod)](https://gitpod.io/#https://github.com/HEPLean/HepLean) [![Ask DeepWiki](https://deepwiki.com/badge.svg)](https://deepwiki.com/HEPLean/PhysLean) +[![api_docs](https://img.shields.io/badge/doc-API_docs-blue)](https://physlean.com/docs/) -## Aims of this project +## Requirements of the project -🎯 __Digitalize__ results (meaning calculations, definitions, and theorems) from physics -into Lean 4. +🎯 The project shall contain results (definitions, theorems, lemmas and calculations) from **physics** formalized (or **digitalized**) into the interactive theorem prover **Lean 4**. -🎯 Develop structures to aid the __creation__ of new results in physics using Lean, - with the potential future use of AI. +🎯 The project shall be **organized** by **physics**. + +🎯 Each definition in the project shall carry a physics-based **documentation**. + +🎯 Each module (file) in the project shall carry a physics-based **documentation**. + +🎯 The project shall contain Physics Lean **tactics**, **notation** and **syntax** for physicists. + +🎯 The project shall *not* be tied to physics axiomizations (e.g. axiomatic QFT), but rather lexiable enough to accommodate different approaches and starting points. + +🎯 The content of the project shall be carefully **reviewed** and curated, to ensure reusability, readability and fit. + +🎯 The project shall be completely open-source, community run and independent from any company or organization. + +🎯 The project shall not be tied to any specific AI model or tool. + +🎯 The project shall be for **main-stream** physics only. -🎯 Create good documentation so that the project can be used for __pedagogical__ purposes. ## How to get involved @@ -45,7 +59,7 @@ See the [Get Involved](https://physlean.com/GetInvolved.html) for more details. 📣 tackle a [TODO item](https://physlean.com/TODOList), -📣 or, start formalizing an area that you find intresting. +📣 or, start formalizing an area that you find interesting. Feel free to come to the [PhysLean zulip](https://leanprover.zulipchat.com/#narrow/channel/479953-PhysLean/) to ask questions and advice. diff --git a/docs/MaintainerTeam.md b/docs/MaintainerTeam.md new file mode 100644 index 000000000..2a35d7e20 --- /dev/null +++ b/docs/MaintainerTeam.md @@ -0,0 +1,26 @@ +# The Maintainer Team + +The default policies around the maintainer team are those of Mathlib, and where conflict +or disagreement arises these are the fall-back. + +## Role + +The role of the maintainer team is to: + +1. Give final reviews of pull-requests. +2. Help structure and guide the project. +3. Help foster a pleasant and active community around the project. + +## Becoming a maintainer + +Maintainers have research-level knowledge of physics or mathematics, and have +experience with either the PhysLean or Mathlib review process. + +To become a maintainer, you either need an invitation from current maintainers, or +need to nominate yourself to a current maintainer. + +## Term of a maintainer + +A maintainer will serve for a period for one-year, which will renew unless they are +inactive for a period of 6 months before renewal or wish to step down (which they can +do at any point). diff --git a/docs/_data/harmonicOscillator.yml b/docs/_data/harmonicOscillator.yml index 44fc6a8ca..019b695bd 100644 --- a/docs/_data/harmonicOscillator.yml +++ b/docs/_data/harmonicOscillator.yml @@ -502,8 +502,8 @@ parts: haveI hi : CauSeq.IsComplete ℂ norm := inferInstanceAs (CauSeq.IsComplete ℂ Complex.abs) exact CauSeq.tendsto_limit (Complex.exp' (Complex.I * c * y)) - /- End of rewritting the intergrand as a limit. -/ - /- Rewritting the integral as a limit using dominated_convergence -/ + /- End of rewriting the intergrand as a limit. -/ + /- Rewriting the integral as a limit using dominated_convergence -/ have h1' : Filter.Tendsto (fun n => ∫ y : ℝ, ∑ r ∈ range n, (Complex.I * ↑c * ↑y) ^ r / r ! * (f y * Real.exp (- m * ω * y^2 / (2 * ℏ)))) Filter.atTop (nhds (∫ y : ℝ, Complex.exp (Complex.I * c * y) * diff --git a/docs/_data/perturbationTheory.yml b/docs/_data/perturbationTheory.yml index 9d6183ff1..55fb88e7a 100644 --- a/docs/_data/perturbationTheory.yml +++ b/docs/_data/perturbationTheory.yml @@ -3102,7 +3102,7 @@ parts: simp only [MulMemClass.coe_mul] rw [singleton_staticContract] rw [timeOrder_timeOrder_left] - rw [timeOrder_superCommute_anPart_ofFieldOp_neq_time] + rw [timeOrder_superCommute_anPart_ofFieldOp_ne_time] simp only [zero_mul, map_zero] intro h simp_all diff --git a/lake-manifest.json b/lake-manifest.json index 5f21b0ac3..60641765b 100644 --- a/lake-manifest.json +++ b/lake-manifest.json @@ -5,27 +5,27 @@ "type": "git", "subDir": null, "scope": "", - "rev": "1cd7a1113090e216703e323e8fdcdf099f0a9c8a", + "rev": "a41d5ebebfa77afe737fec8de8ad03fc8b08fdff", "name": "«doc-gen4»", "manifestFile": "lake-manifest.json", - "inputRev": "v4.24.0", + "inputRev": "v4.28.0", "inherited": false, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/mathlib4.git", "type": "git", "subDir": null, "scope": "", - "rev": "f897ebcf72cd16f89ab4577d0c826cd14afaafc7", + "rev": "8f9d9cff6bd728b17a24e163c9402775d9e6a365", "name": "mathlib", "manifestFile": "lake-manifest.json", - "inputRev": "v4.24.0", + "inputRev": "v4.28.0", "inherited": false, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover/lean4-cli", "type": "git", "subDir": null, "scope": "", - "rev": "91c18fa62838ad0ab7384c03c9684d99d306e1da", + "rev": "4f10f47646cb7d5748d6f423f4a07f98f7bbcc9e", "name": "Cli", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -35,7 +35,7 @@ "type": "git", "subDir": null, "scope": "", - "rev": "e5aaa4949aad9a866aead1da5d5619e8decc8da7", + "rev": "ff04f5c424e50e23476d3539c7c0cc4956e971ad", "name": "UnicodeBasic", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -45,7 +45,7 @@ "type": "git", "subDir": null, "scope": "", - "rev": "1b05159ad44f220cec7489e65e6bc4b1e178b67f", + "rev": "058ada3acad7dd0d55657476bf292c8e02a2f650", "name": "BibtexQuery", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -55,7 +55,7 @@ "type": "git", "subDir": null, "scope": "", - "rev": "66aefec2852d3e229517694e642659f316576591", + "rev": "7e097e9a076d5fbe48aa39aceee871af0d011101", "name": "MD4Lean", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -65,7 +65,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "dfd06ebfe8d0e8fa7faba9cb5e5a2e74e7bd2805", + "rev": "55c8532eb21ec9f6d565d51d96b8ca50bd1fbef3", "name": "plausible", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -75,7 +75,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "99657ad92e23804e279f77ea6dbdeebaa1317b98", + "rev": "c5d5b8fe6e5158def25cd28eb94e4141ad97c843", "name": "LeanSearchClient", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -85,7 +85,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "d768126816be17600904726ca7976b185786e6b9", + "rev": "85b59af46828c029a9168f2f9c35119bd0721e6e", "name": "importGraph", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -95,17 +95,17 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "556caed0eadb7901e068131d1be208dd907d07a2", + "rev": "be3b2e63b1bbf496c478cef98b86972a37c1417d", "name": "proofwidgets", "manifestFile": "lake-manifest.json", - "inputRev": "v0.0.74", + "inputRev": "v0.0.87", "inherited": true, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/aesop", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "725ac8cd67acd70a7beaf47c3725e23484c1ef50", + "rev": "f642a64c76df8ba9cb53dba3b919425a0c2aeaf1", "name": "aesop", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -115,7 +115,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "dea6a3361fa36d5a13f87333dc506ada582e025c", + "rev": "b8f98e9087e02c8553945a2c5abf07cec8e798c3", "name": "Qq", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -125,7 +125,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "8da40b72fece29b7d3fe3d768bac4c8910ce9bee", + "rev": "495c008c3e3f4fb4256ff5582ddb3abf3198026f", "name": "batteries", "manifestFile": "lake-manifest.json", "inputRev": "main", diff --git a/lakefile.toml b/lakefile.toml index 0137c8026..173fd1127 100644 --- a/lakefile.toml +++ b/lakefile.toml @@ -11,12 +11,12 @@ warn.sorry = false [[require]] name = "mathlib" git = "https://github.com/leanprover-community/mathlib4.git" -rev = "v4.24.0" +rev = "v4.28.0" [[require]] name = "«doc-gen4»" git = "https://github.com/leanprover/doc-gen4" -rev = "v4.24.0" +rev = "v4.28.0" [[lean_lib]] name = "PhysLean" diff --git a/lean-toolchain b/lean-toolchain index 58ae2451c..ea6ca7fff 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.24.0 \ No newline at end of file +leanprover/lean4:v4.28.0 \ No newline at end of file diff --git a/scripts/MetaPrograms/TODO_to_yml.lean b/scripts/MetaPrograms/TODO_to_yml.lean index fc0b320b5..ff987787a 100644 --- a/scripts/MetaPrograms/TODO_to_yml.lean +++ b/scripts/MetaPrograms/TODO_to_yml.lean @@ -156,7 +156,7 @@ structure FullTODOInfo where category : PhysLeanCategory tag : String -/-- Coverts a `FullTODOInfo` to an entry in a YAML code. -/ +/-- Converts a `FullTODOInfo` to an entry in a YAML code. -/ def FullTODOInfo.toYAML (todo : FullTODOInfo) : MetaM String := do let content := todo.content let contentIndent := content.replace "\n" "\n " @@ -292,7 +292,7 @@ unsafe def categoriesToYML : MetaM String := do unsafe def todosToYAML : MetaM String := do let todos ← allTODOs - /- Check no dulicate tags-/ + /- Check no duplicate tags-/ let tags := todos.map (fun x => x.tag) if !tags.Nodup then let duplicates := tags.filter (fun tag => tags.count tag > 1) |>.eraseDups diff --git a/scripts/MetaPrograms/make_tag.lean b/scripts/MetaPrograms/make_tag.lean index b6f38ccb5..4053a3cf5 100644 --- a/scripts/MetaPrograms/make_tag.lean +++ b/scripts/MetaPrograms/make_tag.lean @@ -90,6 +90,6 @@ unsafe def main (_ : List String) : IO Unit := do | some n => n | none => panic! "Failed to convert timeString to Nat" let digits := toDigits 32 timeNat - let tag := String.mk (digits.drop 2) + let tag := String.ofList (digits.drop 2) println! tag pure () diff --git a/scripts/MetaPrograms/module_doc_lint.lean b/scripts/MetaPrograms/module_doc_lint.lean index 3ed6ebcc7..c4adeba93 100644 --- a/scripts/MetaPrograms/module_doc_lint.lean +++ b/scripts/MetaPrograms/module_doc_lint.lean @@ -188,7 +188,7 @@ def checkHeadings (f : FilePath) : IO (List DocLintError) := do errors := Function.update errors .tableOfContentsCorrect (true, tocCorrectError) /- - ## Formating the error + ## Formatting the error -/ if Steps.anyTrue errors then let mut errormsg := "\n" @@ -225,7 +225,7 @@ def main (_ : List String) : IO UInt32 := do if imp.module == `Init then none else - some ((mkFilePath (imp.module.toString.split (· == '.'))).addExtension "lean")) + some ((mkFilePath (imp.module.toString.splitToList (· == '.'))).addExtension "lean")) let noLint ← noLintArray let modulesToCheck := filePaths.filter (fun p ↦ !noLint.contains p) let errors := (← modulesToCheck.mapM checkHeadings).toList.flatten diff --git a/scripts/MetaPrograms/module_doc_no_lint.txt b/scripts/MetaPrograms/module_doc_no_lint.txt index a04f3f11c..01842ff4c 100644 --- a/scripts/MetaPrograms/module_doc_no_lint.txt +++ b/scripts/MetaPrograms/module_doc_no_lint.txt @@ -15,7 +15,6 @@ PhysLean/Electromagnetism/Basic.lean PhysLean/Electromagnetism/Charge/ChargeUnit.lean PhysLean/Electromagnetism/Electrostatics/Basic.lean PhysLean/Electromagnetism/Electrostatics/OneDimension/Vacuum.lean -PhysLean/Electromagnetism/Electrostatics/ThreeDimension/FiniteCollection.lean PhysLean/Electromagnetism/Electrostatics/ThreeDimension/InfinitePlane.lean PhysLean/Electromagnetism/Electrostatics/ThreeDimension/PointParticle.lean PhysLean/Electromagnetism/FieldStrength/Basic.lean @@ -175,14 +174,12 @@ PhysLean/QFT/PerturbationTheory/WickContraction/UncontractedList.lean PhysLean/QFT/QED/AnomalyCancellation/Basic.lean PhysLean/QFT/QED/AnomalyCancellation/BasisLinear.lean PhysLean/QFT/QED/AnomalyCancellation/ConstAbs.lean -PhysLean/QFT/QED/AnomalyCancellation/Even/BasisLinear.lean PhysLean/QFT/QED/AnomalyCancellation/Even/LineInCubic.lean PhysLean/QFT/QED/AnomalyCancellation/Even/Parameterization.lean PhysLean/QFT/QED/AnomalyCancellation/LineInPlaneCond.lean PhysLean/QFT/QED/AnomalyCancellation/LowDim/One.lean PhysLean/QFT/QED/AnomalyCancellation/LowDim/Three.lean PhysLean/QFT/QED/AnomalyCancellation/LowDim/Two.lean -PhysLean/QFT/QED/AnomalyCancellation/Odd/BasisLinear.lean PhysLean/QFT/QED/AnomalyCancellation/Odd/LineInCubic.lean PhysLean/QFT/QED/AnomalyCancellation/Odd/Parameterization.lean PhysLean/QFT/QED/AnomalyCancellation/Permutations.lean @@ -287,10 +284,8 @@ PhysLean/Relativity/Tensors/UnitTensor.lean PhysLean/SpaceAndTime/Space/Basic.lean PhysLean/SpaceAndTime/Space/Distributions/Basic.lean PhysLean/SpaceAndTime/Space/LengthUnit.lean -PhysLean/SpaceAndTime/Space/SpaceStruct.lean PhysLean/SpaceAndTime/Space/Translations.lean PhysLean/SpaceAndTime/SpaceTime/TimeSlice.lean -PhysLean/SpaceAndTime/Time/Basic.lean PhysLean/SpaceAndTime/Time/TimeMan.lean PhysLean/SpaceAndTime/Time/TimeTransMan.lean PhysLean/SpaceAndTime/Time/TimeUnit.lean @@ -318,3 +313,7 @@ PhysLean/Units/WithDim/Momentum.lean PhysLean/Units/WithDim/Pressure.lean PhysLean/Units/WithDim/Speed.lean PhysLean/Units/WithDim/Velocity.lean +PhysLean/Electromagnetism/Vacuum/Homogeneous.lean +PhysLean/Electromagnetism/Vacuum/OneDimension.lean +PhysLean/Particles/NeutrinoPhysics/Basic.lean +PhysLean/QuantumMechanics/OneDimension/HarmonicOscillator/Examples.lean diff --git a/scripts/MetaPrograms/runPhysLeanLinters.lean b/scripts/MetaPrograms/runPhysLeanLinters.lean index efde77588..edf46d6d5 100644 --- a/scripts/MetaPrograms/runPhysLeanLinters.lean +++ b/scripts/MetaPrograms/runPhysLeanLinters.lean @@ -1,4 +1,3 @@ -import Lean.Util.SearchPath import Batteries.Tactic.Lint import Batteries.Data.Array.Basic import Lake.CLI.Main @@ -39,7 +38,7 @@ unsafe def runLinterOnModule (module : Name): IO Unit := do let linters ← getChecks (slow := true) (runAlways := none) (runOnly := none) println! "Results been linted with the following linters:" println! linters.map (·.name) - println! "Starting parallel running on linters on all declerations. Results if any are + println! "Starting parallel running on linters on all declarations. Results if any are shown below." let results ← lintCore decls linters let results := results.map fun (linter, decls) => @@ -54,6 +53,7 @@ unsafe def runLinterOnModule (module : Name): IO Unit := do IO.Process.exit 1 else IO.println s!"-- Linting passed for {module}." + IO.Process.exit 0 unsafe def main (_ : List String) : IO Unit := do let modulesToLint := #[`PhysLean] diff --git a/scripts/MetaPrograms/sorry_lint.lean b/scripts/MetaPrograms/sorry_lint.lean index 6030c8bb0..75702adf3 100644 --- a/scripts/MetaPrograms/sorry_lint.lean +++ b/scripts/MetaPrograms/sorry_lint.lean @@ -9,11 +9,11 @@ import PhysLean.Meta.Linters.Sorry import PhysLean.Meta.Sorry /-! -# Script to check sorryful/psuedo attribution +# Script to check sorryful/pseudo attribution This script checks that all declarations which depend on `sorryAx` are marked with the `sorryful` attribute, and vice versa. It also checks that all declarations which depend on -`Lean.ofReduceBool` are marked with the `psuedo` attribute, and vice versa. +`Lean.ofReduceBool` are marked with the `pseudo` attribute, and vice versa. -/ open Lean diff --git a/scripts/MetaPrograms/spelling.lean b/scripts/MetaPrograms/spelling.lean index 4746c0614..4ab0feae6 100644 --- a/scripts/MetaPrograms/spelling.lean +++ b/scripts/MetaPrograms/spelling.lean @@ -20,7 +20,7 @@ of correctly spelled words. It then outputs all words which are not in the dicti so that the user can either correct them or add them to the dictionary file. This code makes no attempt to guess the correct spelling of words, it simply lists -all unkown words found. +all unknown words found. -/ diff --git a/scripts/MetaPrograms/style_lint.lean b/scripts/MetaPrograms/style_lint.lean index 1ebd1d181..3ae28d32a 100644 --- a/scripts/MetaPrograms/style_lint.lean +++ b/scripts/MetaPrograms/style_lint.lean @@ -130,7 +130,7 @@ def main (_ : List String) : IO UInt32 := do if imp.module == `Init then none else - some ((mkFilePath (imp.module.toString.split (· == '.'))).addExtension "lean")) + some ((mkFilePath (imp.module.toString.splitToList (· == '.'))).addExtension "lean")) let errors := (← filePaths.mapM hepLeanLintFile).flatten let errorMessagesPresent := (errors.map (fun e => e.error)).sortDedup for eM in errorMessagesPresent do diff --git a/scripts/lint_all.lean b/scripts/lint_all.lean index 7c70d1016..028134d0d 100644 --- a/scripts/lint_all.lean +++ b/scripts/lint_all.lean @@ -43,7 +43,7 @@ def main (args : List String) : IO UInt32 := do println! "\x1b[36m(7/7) Transitive imports \x1b[0m" println! "\x1b[2mExpect this linter to take a while to run, it can be skipped with lake exe lint_all --fast\x1b[0m" - let redundentImports ← IO.Process.output {cmd := "lake", args := #["exe", "redundent_imports"]} + let redundentImports ← IO.Process.output {cmd := "lake", args := #["exe", "redundant_imports"]} println! redundentImports.stdout diff --git a/scripts/treemap_gen.py b/scripts/treemap_gen.py index 076aac29d..86086d567 100644 --- a/scripts/treemap_gen.py +++ b/scripts/treemap_gen.py @@ -14,9 +14,9 @@ #debugging #print(folder_map) -##################################################### names that end with a "." are actually ending with .lean but lean is removed for visiblity +##################################################### names that end with a "." are actually ending with .lean but lean is removed for visibility -#generating the tree for treemap, id has to be unique and is assigned the aboslute path, label is what is displayed, this is immediate file or folder name for visiblity +#generating the tree for treemap, id has to be unique and is assigned the absolute path, label is what is displayed, this is immediate file or folder name for visibility # size decides the area occupied by each label, here it is just the file size, value is what decides the color, here it is the number assigned to the parent folder, so each file inside stats mech is assigned same number blobs = [{ 'parent': os.path.dirname(blob.path) or "/", diff --git a/scripts/type_former_lint.lean b/scripts/type_former_lint.lean index 0091caaad..000f49be2 100644 --- a/scripts/type_former_lint.lean +++ b/scripts/type_former_lint.lean @@ -19,7 +19,7 @@ open Lean System Meta /-- A rough definition of Upper Camal, checking that if a string starts with a -latin letter then that letter is captial. -/ +latin letter then that letter is capital. -/ def IsUpperCamal (s : String) : Bool := let parts := s.splitOn "." let lastPart := parts.get! (parts.length - 1)