Imports
/- Copyright (c) 2026 Bjørn Kjos-Hanssen. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Bjørn Kjos-Hanssen -/ module public import Mathlib.Analysis.Calculus.Gradient.Basic public import Mathlib.Analysis.Calculus.ContDiff.FTaylorSeries public import Mathlib.LinearAlgebra.QuadraticForm.Basic public import Mathlib.Analysis.Calculus.FDeriv.Analytic public import Mathlib.Analysis.Analytic.IteratedFDeriv public import Mathlib.Analysis.Calculus.FDeriv.Symmetric public import Mathlib.Analysis.InnerProductSpace.PiL2 public import PhyslibAlpha.Mathematics.PartialDerivativeTest

Coupled spring potential

As a proof of concept, we use the second derivative test in PhyslibAlpha.Mathematics.PartialDerivativeTest to prove that the coupled spring potential U := fun x : EuclideanSpace ℝ (Fin 2) => (x 0)^2 + x 0 * x 1 + (x 1)^2 has a local minimum at zero.

@[expose] public section/- The coupling potential is analytic everywhere (it is a polynomial). -/ lemma couplingPotential_analyticAt (z : EuclideanSpace (Fin 2)) : AnalyticAt couplingPotential z := z:EuclideanSpace (Fin 2)AnalyticAt couplingPotential z z:EuclideanSpace (Fin 2)h0:AnalyticAt (fun x => x.ofLp 0) zAnalyticAt couplingPotential z z:EuclideanSpace (Fin 2)h0:AnalyticAt (fun x => x.ofLp 0) zh1:AnalyticAt (fun x => x.ofLp 1) zAnalyticAt couplingPotential z z:EuclideanSpace (Fin 2)h0:AnalyticAt (fun x => x.ofLp 0) zh1:AnalyticAt (fun x => x.ofLp 1) zAnalyticAt (fun x => x.ofLp 0 ^ 2 + x.ofLp 0 * x.ofLp 1 + x.ofLp 1 ^ 2) z All goals completed! 🐙x:EuclideanSpace (Fin 2)h0:HasFDerivAt (fun x => x.ofLp 0) (EuclideanSpace.proj 0) xh1:HasFDerivAt (fun x => x.ofLp 1) (EuclideanSpace.proj 1) xHasFDerivAt couplingPotential ((2 * x.ofLp 0 + x.ofLp 1) EuclideanSpace.proj 0 + (x.ofLp 0 + 2 * x.ofLp 1) EuclideanSpace.proj 1) x x:EuclideanSpace (Fin 2)h0:HasFDerivAt (fun x => x.ofLp 0) (EuclideanSpace.proj 0) xh1:HasFDerivAt (fun x => x.ofLp 1) (EuclideanSpace.proj 1) xe_4✝:WithLp.instAddCommGroup 2 ((i : Fin 2) (fun x => ) i) = (PiLp.normedAddCommGroup 2 fun x => ).toAddCommGrouphe✝¹:WithLp.instModule 2 ((i : Fin 2) (fun x => ) i) = (PiLp.normedSpace 2 fun x => ).toModulee_6✝:(PiLp.topologicalSpace 2 fun x => ) = PseudoMetricSpace.toUniformSpace.toTopologicalSpacee_8✝:Real.instAddCommGroup = Real.normedAddCommGroup.toAddCommGrouphe✝:Semiring.toModule = RCLike.toInnerProductSpaceReal.toModule(2 * x.ofLp 0 + x.ofLp 1) EuclideanSpace.proj 0 + (x.ofLp 0 + 2 * x.ofLp 1) EuclideanSpace.proj 1 = (2 x.ofLp 0 ^ (2 - 1)) EuclideanSpace.proj 0 + (x.ofLp 0 EuclideanSpace.proj 1 + x.ofLp 1 EuclideanSpace.proj 0) + (2 x.ofLp 1 ^ (2 - 1)) EuclideanSpace.proj 1 x:EuclideanSpace (Fin 2)h0:HasFDerivAt (fun x => x.ofLp 0) (EuclideanSpace.proj 0) xh1:HasFDerivAt (fun x => x.ofLp 1) (EuclideanSpace.proj 1) xe_4✝:WithLp.instAddCommGroup 2 ((i : Fin 2) (fun x => ) i) = (PiLp.normedAddCommGroup 2 fun x => ).toAddCommGrouphe✝¹:WithLp.instModule 2 ((i : Fin 2) (fun x => ) i) = (PiLp.normedSpace 2 fun x => ).toModulee_6✝:(PiLp.topologicalSpace 2 fun x => ) = PseudoMetricSpace.toUniformSpace.toTopologicalSpacee_8✝:Real.instAddCommGroup = Real.normedAddCommGroup.toAddCommGrouphe✝:Semiring.toModule = RCLike.toInnerProductSpaceReal.toModulex✝:EuclideanSpace (Fin 2)((2 * x.ofLp 0 + x.ofLp 1) EuclideanSpace.proj 0 + (x.ofLp 0 + 2 * x.ofLp 1) EuclideanSpace.proj 1) x✝ = ((2 x.ofLp 0 ^ (2 - 1)) EuclideanSpace.proj 0 + (x.ofLp 0 EuclideanSpace.proj 1 + x.ofLp 1 EuclideanSpace.proj 0) + (2 x.ofLp 1 ^ (2 - 1)) EuclideanSpace.proj 1) x✝; x:EuclideanSpace (Fin 2)h0:HasFDerivAt (fun x => x.ofLp 0) (EuclideanSpace.proj 0) xh1:HasFDerivAt (fun x => x.ofLp 1) (EuclideanSpace.proj 1) xe_4✝:WithLp.instAddCommGroup 2 ((i : Fin 2) (fun x => ) i) = (PiLp.normedAddCommGroup 2 fun x => ).toAddCommGrouphe✝¹:WithLp.instModule 2 ((i : Fin 2) (fun x => ) i) = (PiLp.normedSpace 2 fun x => ).toModulee_6✝:(PiLp.topologicalSpace 2 fun x => ) = PseudoMetricSpace.toUniformSpace.toTopologicalSpacee_8✝:Real.instAddCommGroup = Real.normedAddCommGroup.toAddCommGrouphe✝:Semiring.toModule = RCLike.toInnerProductSpaceReal.toModulex✝:EuclideanSpace (Fin 2)(2 * x.ofLp 0 + x.ofLp 1) * x✝.ofLp 0 + (x.ofLp 0 + 2 * x.ofLp 1) * x✝.ofLp 1 = 2 * x.ofLp 0 * x✝.ofLp 0 + (x.ofLp 0 * x✝.ofLp 1 + x.ofLp 1 * x✝.ofLp 0) + 2 * x.ofLp 1 * x✝.ofLp 1; All goals completed! 🐙/- The gradient of the coupling potential vanishes at the origin. -/ lemma couplingPotential_gradient_zero : gradient couplingPotential (!2[0, 0] : EuclideanSpace (Fin 2)) = 0 := gradient couplingPotential ![0, 0] = 0 fderiv couplingPotential ![0, 0] = (InnerProductSpace.toDual (EuclideanSpace (Fin 2))).toLinearEquiv 0; (InnerProductSpace.toDual (EuclideanSpace (Fin 2))).toLinearEquiv 0 = (2 * ![0, 0].ofLp 0 + ![0, 0].ofLp 1) EuclideanSpace.proj 0 + (![0, 0].ofLp 0 + 2 * ![0, 0].ofLp 1) EuclideanSpace.proj 1 All goals completed! 🐙z:EuclideanSpace (Fin 2)a:EuclideanSpace (Fin 2)b:EuclideanSpace (Fin 2)h_second_deriv:fderiv (fderiv couplingPotential) z = 2 ContinuousLinearMap.smulRight (EuclideanSpace.proj 0) (EuclideanSpace.proj 0) + ContinuousLinearMap.smulRight (EuclideanSpace.proj 0) (EuclideanSpace.proj 1) + ContinuousLinearMap.smulRight (EuclideanSpace.proj 1) (EuclideanSpace.proj 0) + 2 ContinuousLinearMap.smulRight (EuclideanSpace.proj 1) (EuclideanSpace.proj 1)((iteratedFDeriv 1 (fun y => fderiv couplingPotential y) z) (Fin.init ![a, b])) (![a, b] (Fin.last 1)) = 2 * a.ofLp 0 * b.ofLp 0 + a.ofLp 0 * b.ofLp 1 + a.ofLp 1 * b.ofLp 0 + 2 * a.ofLp 1 * b.ofLp 1; z:EuclideanSpace (Fin 2)a:EuclideanSpace (Fin 2)b:EuclideanSpace (Fin 2)h_second_deriv:fderiv (fderiv couplingPotential) z = 2 ContinuousLinearMap.smulRight (EuclideanSpace.proj 0) (EuclideanSpace.proj 0) + ContinuousLinearMap.smulRight (EuclideanSpace.proj 0) (EuclideanSpace.proj 1) + ContinuousLinearMap.smulRight (EuclideanSpace.proj 1) (EuclideanSpace.proj 0) + 2 ContinuousLinearMap.smulRight (EuclideanSpace.proj 1) (EuclideanSpace.proj 1)2 * ((Fin.init ![a, b] 0).ofLp 0 * b.ofLp 0) + (Fin.init ![a, b] 0).ofLp 0 * b.ofLp 1 + (Fin.init ![a, b] 0).ofLp 1 * b.ofLp 0 + 2 * ((Fin.init ![a, b] 0).ofLp 1 * b.ofLp 1) = 2 * a.ofLp 0 * b.ofLp 0 + a.ofLp 0 * b.ofLp 1 + a.ofLp 1 * b.ofLp 0 + 2 * a.ofLp 1 * b.ofLp 1; All goals completed! 🐙;/- The second derivative quadratic map of the coupling potential is positive definite at the origin. -/ lemma couplingPotential_posDef : (iteratedFDerivQuadraticMap couplingPotential (!2[0, 0] : EuclideanSpace (Fin 2))).PosDef := (iteratedFDerivQuadraticMap couplingPotential ![0, 0]).PosDef y:EuclideanSpace (Fin 2)hy:y 00 < (iteratedFDerivQuadraticMap couplingPotential ![0, 0]) y; convert! (show 0 < 2 * y 0 ^ 2 + 2 * y 0 * y 1 + 2 * y 1 ^ 2 (iteratedFDerivQuadraticMap couplingPotential ![0, 0]).PosDef exact not_le.mp fun h => hy <| y:EuclideanSpace (Fin 2)hy:y 0h:2 * y.ofLp 0 ^ 2 + 2 * y.ofLp 0 * y.ofLp 1 + 2 * y.ofLp 1 ^ 2 0y = 0 y:EuclideanSpace (Fin 2)hy:y 0h:2 * y.ofLp 0 ^ 2 + 2 * y.ofLp 0 * y.ofLp 1 + 2 * y.ofLp 1 ^ 2 0i:Fin 2y.ofLp i = WithLp.ofLp 0 i y:EuclideanSpace (Fin 2)hy:y 0h:2 * y.ofLp 0 ^ 2 + 2 * y.ofLp 0 * y.ofLp 1 + 2 * y.ofLp 1 ^ 2 0y.ofLp ((fun i => i) 0, ) = WithLp.ofLp 0 ((fun i => i) 0, )y:EuclideanSpace (Fin 2)hy:y 0h:2 * y.ofLp 0 ^ 2 + 2 * y.ofLp 0 * y.ofLp 1 + 2 * y.ofLp 1 ^ 2 0y.ofLp ((fun i => i) 1, ) = WithLp.ofLp 0 ((fun i => i) 1, ) y:EuclideanSpace (Fin 2)hy:y 0h:2 * y.ofLp 0 ^ 2 + 2 * y.ofLp 0 * y.ofLp 1 + 2 * y.ofLp 1 ^ 2 0y.ofLp ((fun i => i) 0, ) = WithLp.ofLp 0 ((fun i => i) 0, )y:EuclideanSpace (Fin 2)hy:y 0h:2 * y.ofLp 0 ^ 2 + 2 * y.ofLp 0 * y.ofLp 1 + 2 * y.ofLp 1 ^ 2 0y.ofLp ((fun i => i) 1, ) = WithLp.ofLp 0 ((fun i => i) 1, ) y:EuclideanSpace (Fin 2)hy:y 0h:2 * y.ofLp 0 ^ 2 + 2 * y.ofLp 0 * y.ofLp 1 + 2 * y.ofLp 1 ^ 2 0y.ofLp 1 = 0 y:EuclideanSpace (Fin 2)hy:y 0h:2 * y.ofLp 0 ^ 2 + 2 * y.ofLp 0 * y.ofLp 1 + 2 * y.ofLp 1 ^ 2 0y.ofLp 0 = 0y:EuclideanSpace (Fin 2)hy:y 0h:2 * y.ofLp 0 ^ 2 + 2 * y.ofLp 0 * y.ofLp 1 + 2 * y.ofLp 1 ^ 2 0y.ofLp 1 = 0 All goals completed! 🐙) using 1 y:EuclideanSpace (Fin 2)hy:y 0pf✝¹:Nat.AtLeastTwo 2pf✝:NeZero 2(iteratedFDerivQuadraticMap couplingPotential ![0, 0]) y = 2 * y.ofLp 0 ^ 2 + 2 * y.ofLp 0 * y.ofLp 1 + 2 * y.ofLp 1 ^ 2; y:EuclideanSpace (Fin 2)hy:y 0pf✝¹:Nat.AtLeastTwo 2pf✝:NeZero 22 * y.ofLp 0 ^ 2 + 2 * y.ofLp 0 * y.ofLp 1 + 2 * y.ofLp 1 ^ 2 = 2 * y.ofLp 0 * y.ofLp 0 + y.ofLp 0 * y.ofLp 1 + y.ofLp 1 * y.ofLp 0 + 2 * y.ofLp 1 * y.ofLp 1; All goals completed! 🐙lemma coupled_spring_potential : let U := fun x : EuclideanSpace (Fin 2) => (x 0)^2 + x 0 * x 1 + (x 1)^2 IsLocalMin U { ofLp := ![0,0] } := let U := fun x => x.ofLp 0 ^ 2 + x.ofLp 0 * x.ofLp 1 + x.ofLp 1 ^ 2; IsLocalMin U ![0, 0] IsLocalMin couplingPotential ![0, 0] All goals completed! 🐙