From 99ad74177aa0a840ceb94953329d4d7779f33ac6 Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 08:33:20 +0100 Subject: [PATCH 01/25] feat: Add effective potential --- .../BeyondTheStandardModel/TwoHDM/Basic.lean | 58 +++++++++++++ .../TwoHDM/EffectivePotential.lean | 87 +++++++++++++++++++ .../HiggsBoson/EffectivePotential.lean | 10 +-- 3 files changed, 150 insertions(+), 5 deletions(-) create mode 100644 Physlib/Particles/BeyondTheStandardModel/TwoHDM/EffectivePotential.lean diff --git a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean index e7a1bdb23..d4fe5cc37 100644 --- a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean +++ b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean @@ -77,4 +77,62 @@ noncomputable instance : MulAction StandardModel.GaugeGroupI TwoHiggsDoublet whe mul_smul g1 g2 H := by ext <;> simp [mul_smul] +/-! + +## The structure of a module + +-/ + +instance : Add TwoHiggsDoublet where + add H1 H2 := { Φ1 := H1.Φ1 + H2.Φ1, Φ2 := H1.Φ2 + H2.Φ2 } + +@[simp] +lemma add_fst (H1 H2 : TwoHiggsDoublet) : (H1 + H2).Φ1 = H1.Φ1 + H2.Φ1 := rfl + +@[simp] +lemma add_snd (H1 H2 : TwoHiggsDoublet) : (H1 + H2).Φ2 = H1.Φ2 + H2.Φ2 := rfl + +instance : Zero TwoHiggsDoublet where + zero := { Φ1 := 0, Φ2 := 0 } + +@[simp] +lemma zero_fst : (0 : TwoHiggsDoublet).Φ1 = 0 := rfl + +@[simp] +lemma zero_snd : (0 : TwoHiggsDoublet).Φ2 = 0 := rfl + +instance : SMul ℂ TwoHiggsDoublet where + smul c H := { Φ1 := c • H.Φ1, Φ2 := c • H.Φ2 } + +@[simp] +lemma smul_fst (c : ℂ) (H : TwoHiggsDoublet) : (c • H).Φ1 = c • H.Φ1 := rfl + +@[simp] +lemma smul_snd (c : ℂ) (H : TwoHiggsDoublet) : (c • H).Φ2 = c • H.Φ2 := rfl + +instance : AddCommMonoid TwoHiggsDoublet where + add_assoc H1 H2 H3 := by + ext <;> simp [add_assoc] + zero_add H := by + ext <;> simp + add_zero H := by + ext <;> simp + nsmul := nsmulRec + add_comm H1 H2 := by + ext <;> simp [add_comm] + +instance : Module ℂ TwoHiggsDoublet where + smul_add c H1 H2 := by + ext <;> simp [smul_add] + add_smul c1 c2 H := by + ext <;> simp [add_smul] + one_smul H := by + ext <;> simp [one_smul] + mul_smul c1 c2 H := by + ext <;> simp [mul_smul] + smul_zero c := by + ext <;> simp [smul_zero] + zero_smul H := by + ext <;> simp [zero_smul] + end TwoHiggsDoublet diff --git a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/EffectivePotential.lean b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/EffectivePotential.lean new file mode 100644 index 000000000..4b060cd6c --- /dev/null +++ b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/EffectivePotential.lean @@ -0,0 +1,87 @@ +/- +Copyright (c) 2026 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +module + +public import Physlib.Particles.BeyondTheStandardModel.TwoHDM.GramMatrix +public import Mathlib.RingTheory.MvPolynomial.Homogeneous +/-! +# The effective potential of the two Higgs doublet model + + +-/ + +@[expose] public section + +noncomputable section + +namespace TwoHiggsDoublet +open InnerProductSpace +open StandardModel + +open SpaceTime + + +/-- A general potential of the Higgs field. -/ +abbrev EffectivePotential : Type := TwoHiggsDoublet → ℝ + +namespace EffectivePotential + +/-! + +## A. The invariance of the general potential under the gauge group + +-/ + +/-- The proposition that the general potential is invariant under + the global action of the gauge group. -/ +def IsInvariant (V : EffectivePotential) : Prop := + ∀ (g : GaugeGroupI), ∀ (φ : TwoHiggsDoublet), V (g • φ) = V φ + +namespace IsInvariant + +/-- An invariant potential is equal on gauge orbits. -/ +lemma eq_on_orbits {φ1 φ2 : TwoHiggsDoublet} {V : EffectivePotential} (h : IsInvariant V) + (hφ : φ1 ∈ MulAction.orbit GaugeGroupI φ2) : + V φ1 = V φ2 := by + obtain ⟨g, hg⟩ := hφ + rw [← hg] + exact h g φ2 + +/-- An invariant potential is equal on Higgs vectors with identical Gram vectors. -/ +lemma eq_of_gramVector_eq {φ1 φ2 : TwoHiggsDoublet} {V : EffectivePotential} (h : IsInvariant V) + (hφ : φ1.gramVector = φ2.gramVector) : + V φ1 = V φ2 := h.eq_on_orbits <| (mem_orbit_gaugeGroupI_iff_gramVector φ1 φ2).mpr hφ + +end IsInvariant + +/-! + +## B. Maximum mass dimension + +-/ + +/-- The proposition that the potential `V` has a maximum mass dimension + less then or equal to `n` - also implying it is a polynomial. -/ +def HasMaxMassDimLE (V : EffectivePotential) (n : ℕ) : Prop := + ∃ p : MvPolynomial (Module.dual ℝ TwoHiggsDoublet) ℝ, (∀ φ : TwoHiggsDoublet, V φ = p.eval + (fun i => φ.|) + ) ∧ + p.totalDegree ≤ n + +/-- The polynomial associated to a potential `V` with a maximum mass dimension + less than or equal to `n`. -/ +def polynomial (V : EffectivePotential) {n : ℕ} (h : HasMaxMassDimLE V n) : + MvPolynomial (Fin 4) ℝ := Classical.choose h + +lemma polynomial_totalDegree {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) : + (polynomial V h).totalDegree ≤ n := (Classical.choose_spec h).2 + +lemma apply_eq_polynomial {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) + (φ : TwoHiggsDoublet) : V φ = (polynomial V h).eval φ.toRealScalars := (Classical.choose_spec h).1 φ + +end EffectivePotential + +end TwoHiggsDoublet diff --git a/Physlib/Particles/StandardModel/HiggsBoson/EffectivePotential.lean b/Physlib/Particles/StandardModel/HiggsBoson/EffectivePotential.lean index c102110c3..6e5a33f28 100644 --- a/Physlib/Particles/StandardModel/HiggsBoson/EffectivePotential.lean +++ b/Physlib/Particles/StandardModel/HiggsBoson/EffectivePotential.lean @@ -81,19 +81,19 @@ end IsInvariant /-- The proposition that the potential `V` has a maximum mass dimension less then or equal to `n` - also implying it is a polynomial. -/ def HasMaxMassDimLE (V : EffectivePotential) (n : ℕ) : Prop := - ∃ p : MvPolynomial (Fin 4) ℝ, (∀ φ : HiggsVec, V φ = p.eval φ.toRealScalars) ∧ + ∃ p : MvPolynomial (Module.Dual ℝ HiggsVec) ℝ, (∀ φ : HiggsVec, V φ = p.eval (fun ι => ι φ)) ∧ p.totalDegree ≤ n /-- The polynomial associated to a potential `V` with a maximum mass dimension less than or equal to `n`. -/ def polynomial (V : EffectivePotential) {n : ℕ} (h : HasMaxMassDimLE V n) : - MvPolynomial (Fin 4) ℝ := Classical.choose h + MvPolynomial (Module.Dual ℝ HiggsVec) ℝ := Classical.choose h lemma polynomial_totalDegree {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) : (polynomial V h).totalDegree ≤ n := (Classical.choose_spec h).2 lemma apply_eq_polynomial {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) - (φ : HiggsVec) : V φ = (polynomial V h).eval φ.toRealScalars := (Classical.choose_spec h).1 φ + (φ : HiggsVec) : V φ = (polynomial V h).eval (fun ι => ι φ) := (Classical.choose_spec h).1 φ /-! @@ -103,7 +103,7 @@ lemma apply_eq_polynomial {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimL /-- The part of a potential at a given mass-dimension. -/ def termOfMassDim (V : EffectivePotential) {n : ℕ} (h : HasMaxMassDimLE V n) (m : ℕ) : - HiggsVec → ℝ := fun φ => ((polynomial V h).homogeneousComponent m).eval φ.toRealScalars + HiggsVec → ℝ := fun φ => ((polynomial V h).homogeneousComponent m).eval (fun ι => ι φ) lemma termOfMassDim_eq_zero_of_max_lt {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) {m : ℕ} (hm : n < m) (φ : HiggsVec) : @@ -112,7 +112,7 @@ lemma termOfMassDim_eq_zero_of_max_lt {V : EffectivePotential} {n : ℕ} (h : Ha rw [MvPolynomial.homogeneousComponent_eq_zero] simp only [map_zero] have h1 := polynomial_totalDegree h - grind + omega lemma termOfMassDim_homogeneity {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) (m : ℕ) (φ : HiggsVec) (t : ℝ) : termOfMassDim V h m (t • φ) = t ^ m * termOfMassDim V h m φ := by From 6c9e217875940940f4e16cbc7ae821342f0ca2b3 Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 08:52:06 +0100 Subject: [PATCH 02/25] feat: my edits --- .../BeyondTheStandardModel/TwoHDM/Basic.lean | 14 ++++++++++- .../TwoHDM/EffectivePotential.lean | 24 +++++++------------ 2 files changed, 22 insertions(+), 16 deletions(-) diff --git a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean index d4fe5cc37..8317ce607 100644 --- a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean +++ b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean @@ -110,7 +110,16 @@ lemma smul_fst (c : ℂ) (H : TwoHiggsDoublet) : (c • H).Φ1 = c • H.Φ1 := @[simp] lemma smul_snd (c : ℂ) (H : TwoHiggsDoublet) : (c • H).Φ2 = c • H.Φ2 := rfl -instance : AddCommMonoid TwoHiggsDoublet where +instance : Neg TwoHiggsDoublet where + neg H := { Φ1 := -H.Φ1, Φ2 := -H.Φ2 } + +@[simp] +lemma neg_fst (H : TwoHiggsDoublet) : (-H).Φ1 = -H.Φ1 := rfl + +@[simp] +lemma neg_snd (H : TwoHiggsDoublet) : (-H).Φ2 = -H.Φ2 := rfl + +instance : AddCommGroup TwoHiggsDoublet where add_assoc H1 H2 H3 := by ext <;> simp [add_assoc] zero_add H := by @@ -120,6 +129,9 @@ instance : AddCommMonoid TwoHiggsDoublet where nsmul := nsmulRec add_comm H1 H2 := by ext <;> simp [add_comm] + zsmul := zsmulRec + neg_add_cancel H := by + ext <;> simp [neg_add_cancel] instance : Module ℂ TwoHiggsDoublet where smul_add c H1 H2 := by diff --git a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/EffectivePotential.lean b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/EffectivePotential.lean index 4b060cd6c..04e7c06ca 100644 --- a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/EffectivePotential.lean +++ b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/EffectivePotential.lean @@ -66,21 +66,15 @@ end IsInvariant /-- The proposition that the potential `V` has a maximum mass dimension less then or equal to `n` - also implying it is a polynomial. -/ def HasMaxMassDimLE (V : EffectivePotential) (n : ℕ) : Prop := - ∃ p : MvPolynomial (Module.dual ℝ TwoHiggsDoublet) ℝ, (∀ φ : TwoHiggsDoublet, V φ = p.eval - (fun i => φ.|) - ) ∧ - p.totalDegree ≤ n - -/-- The polynomial associated to a potential `V` with a maximum mass dimension - less than or equal to `n`. -/ -def polynomial (V : EffectivePotential) {n : ℕ} (h : HasMaxMassDimLE V n) : - MvPolynomial (Fin 4) ℝ := Classical.choose h - -lemma polynomial_totalDegree {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) : - (polynomial V h).totalDegree ≤ n := (Classical.choose_spec h).2 - -lemma apply_eq_polynomial {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) - (φ : TwoHiggsDoublet) : V φ = (polynomial V h).eval φ.toRealScalars := (Classical.choose_spec h).1 φ + ∃ p : MvPolynomial (Module.Dual ℝ TwoHiggsDoublet) ℝ, (∀ φ : TwoHiggsDoublet, V φ = p.eval + (fun i => i φ) ) ∧ p.totalDegree ≤ n + +/-- An invariant effective potential with maximum mass dimension n can be written as a + polynomial in the entries of the Gram vector. -/ +lemma effectivePotential_is_polynomial_gramVector {V : EffectivePotential} {n : ℕ} + (hI: IsInvariant V) (h : HasMaxMassDimLE V n) : + ∃ p : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ, (∀ φ : TwoHiggsDoublet, V φ = p.eval φ.gramVector) := by + sorry end EffectivePotential From 8ed95b25393e0eee051008c94e49bce65ce78e9d Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 09:21:36 +0100 Subject: [PATCH 03/25] feat: Move to PhyslibAlpha --- .../TwoHDM => PhyslibAlpha/2HDM}/EffectivePotential.lean | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename {Physlib/Particles/BeyondTheStandardModel/TwoHDM => PhyslibAlpha/2HDM}/EffectivePotential.lean (100%) diff --git a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/EffectivePotential.lean b/PhyslibAlpha/2HDM/EffectivePotential.lean similarity index 100% rename from Physlib/Particles/BeyondTheStandardModel/TwoHDM/EffectivePotential.lean rename to PhyslibAlpha/2HDM/EffectivePotential.lean From 68288b85981be37652e67c77ca63a9a624764b6b Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 10:24:05 +0100 Subject: [PATCH 04/25] feat: First pass by claude Co-Authored-By: Claude --- PhyslibAlpha/2HDM/Determinant.lean | 104 ++++++++++++++++ PhyslibAlpha/2HDM/EffectivePotential.lean | 51 +++++++- PhyslibAlpha/2HDM/OrbitRepresentative.lean | 138 +++++++++++++++++++++ 3 files changed, 292 insertions(+), 1 deletion(-) create mode 100644 PhyslibAlpha/2HDM/Determinant.lean create mode 100644 PhyslibAlpha/2HDM/OrbitRepresentative.lean diff --git a/PhyslibAlpha/2HDM/Determinant.lean b/PhyslibAlpha/2HDM/Determinant.lean new file mode 100644 index 000000000..81a3e7c72 --- /dev/null +++ b/PhyslibAlpha/2HDM/Determinant.lean @@ -0,0 +1,104 @@ +/- +Copyright (c) 2026 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +module + +public import Physlib.Particles.BeyondTheStandardModel.TwoHDM.GramMatrix +/-! +# The doublet determinant of the two Higgs doublet model + +The two Higgs doublets `Φ1, Φ2 : ℂ²` form a `2 × 2` matrix whose determinant +`Φ1₀ Φ2₁ - Φ1₁ Φ2₀` is the basic `SU(2)`-invariant built out of the two doublets that is +*not* one of the entries of the Gram matrix. + +Under the gauge group it carries hypercharge (it is rescaled by a phase under the `U(1)` factor +and is genuinely invariant under `SU(2)`), so it only contributes to gauge invariants through its +modulus squared. The central result of this file, `norm_doubletDet_sq`, is the Lagrange identity +which expresses this modulus squared in terms of the Gram data: +`‖doubletDet H‖² = ‖Φ1‖² ‖Φ2‖² - ‖⟪Φ1, Φ2⟫‖² = (gramMatrix H).det.re`. + +-/ + +@[expose] public section + +noncomputable section + +namespace TwoHiggsDoublet + +open InnerProductSpace +open StandardModel +open ComplexConjugate +open Matrix + +/-- The determinant of the `2 × 2` matrix whose columns are the two Higgs doublets. This is the + basic `SU(2)`-invariant of the two doublets which is not an entry of the Gram matrix. -/ +def doubletDet (H : TwoHiggsDoublet) : ℂ := + H.Φ1 0 * H.Φ2 1 - H.Φ1 1 * H.Φ2 0 + +lemma doubletDet_eq (H : TwoHiggsDoublet) : + H.doubletDet = H.Φ1 0 * H.Φ2 1 - H.Φ1 1 * H.Φ2 0 := rfl + +/-- The Lagrange identity: the modulus squared of the doublet determinant equals the determinant + of the Gram matrix. -/ +lemma norm_doubletDet_sq (H : TwoHiggsDoublet) : + ‖doubletDet H‖ ^ 2 = ‖H.Φ1‖ ^ 2 * ‖H.Φ2‖ ^ 2 - ‖⟪H.Φ1, H.Φ2⟫_ℂ‖ ^ 2 := by + rw [doubletDet] + rw [PiLp.norm_sq_eq_of_L2, PiLp.norm_sq_eq_of_L2, PiLp.inner_apply] + rw [Fin.sum_univ_two, Fin.sum_univ_two, Fin.sum_univ_two] + simp only [← Complex.normSq_eq_norm_sq, Complex.normSq_apply, Complex.add_re, Complex.add_im, + Complex.mul_re, Complex.mul_im, Complex.sub_re, Complex.sub_im, Complex.conj_re, + Complex.conj_im, RCLike.inner_apply] + ring + +/-- The modulus squared of the doublet determinant equals the real part of the determinant of the + Gram matrix. -/ +lemma norm_doubletDet_sq_eq_det (H : TwoHiggsDoublet) : + ‖doubletDet H‖ ^ 2 = H.gramMatrix.det.re := by + rw [norm_doubletDet_sq, gramMatrix_det_eq_real] + +/-- The modulus squared of the doublet determinant in terms of the Gram vector. -/ +lemma norm_doubletDet_sq_eq_gramVector (H : TwoHiggsDoublet) : + ‖doubletDet H‖ ^ 2 = + (1 / 4 : ℝ) * (H.gramVector (Sum.inl 0) ^ 2 - ∑ μ : Fin 3, H.gramVector (Sum.inr μ) ^ 2) := by + rw [norm_doubletDet_sq_eq_det, gramMatrix_det_eq_gramVector] + +/-! + +## Gauge covariance of the doublet determinant + +The doublet determinant is genuinely invariant under `SU(2)` (whose determinant is `1`) and is +rescaled by the sixth power of the `U(1)` phase. In particular its modulus is gauge invariant, +consistent with `norm_doubletDet_sq_eq_det`. + +-/ + +/-- The action of the gauge group on a single Higgs vector, written componentwise. -/ +lemma gaugeGroupI_smul_apply (g : StandardModel.GaugeGroupI) (φ : HiggsVec) (i : Fin 2) : + (g • φ) i = (g.toU1 ^ 3 : ℂ) * (g.toSU2.1 *ᵥ φ.ofLp) i := by + rw [HiggsVec.gaugeGroupI_smul_eq] + rfl + +/-- The doublet determinant is a relative invariant: under a gauge transformation it picks up the + sixth power of the `U(1)` phase (and is genuinely `SU(2)`-invariant). -/ +lemma doubletDet_smul (g : StandardModel.GaugeGroupI) (H : TwoHiggsDoublet) : + doubletDet (g • H) = (g.toU1 ^ 3 : ℂ) ^ 2 * doubletDet H := by + rw [doubletDet, doubletDet, gaugeGroupI_smul_fst, gaugeGroupI_smul_snd, + gaugeGroupI_smul_apply, gaugeGroupI_smul_apply, gaugeGroupI_smul_apply, gaugeGroupI_smul_apply] + have hdet : (g.toSU2.1).det = 1 := g.toSU2.2.2 + rw [Matrix.det_fin_two] at hdet + simp only [mulVec, dotProduct, Fin.sum_univ_two] + linear_combination ((g.toU1 ^ 3 : ℂ) ^ 2 * + (H.Φ1.ofLp 0 * H.Φ2.ofLp 1 - H.Φ1.ofLp 1 * H.Φ2.ofLp 0)) * hdet + +/-- The modulus of the doublet determinant is gauge invariant. -/ +@[simp] +lemma norm_doubletDet_smul (g : StandardModel.GaugeGroupI) (H : TwoHiggsDoublet) : + ‖doubletDet (g • H)‖ = ‖doubletDet H‖ := by + have h2 : ‖doubletDet (g • H)‖ ^ 2 = ‖doubletDet H‖ ^ 2 := by + rw [norm_doubletDet_sq_eq_det, norm_doubletDet_sq_eq_det, gaugeGroupI_smul_gramMatrix] + rw [← Real.sqrt_sq (norm_nonneg (doubletDet (g • H))), h2, + Real.sqrt_sq (norm_nonneg (doubletDet H))] + +end TwoHiggsDoublet diff --git a/PhyslibAlpha/2HDM/EffectivePotential.lean b/PhyslibAlpha/2HDM/EffectivePotential.lean index 04e7c06ca..a18d86ab6 100644 --- a/PhyslibAlpha/2HDM/EffectivePotential.lean +++ b/PhyslibAlpha/2HDM/EffectivePotential.lean @@ -7,6 +7,8 @@ module public import Physlib.Particles.BeyondTheStandardModel.TwoHDM.GramMatrix public import Mathlib.RingTheory.MvPolynomial.Homogeneous +public import PhyslibAlpha.«2HDM».Determinant +public import PhyslibAlpha.«2HDM».OrbitRepresentative /-! # The effective potential of the two Higgs doublet model @@ -69,12 +71,59 @@ def HasMaxMassDimLE (V : EffectivePotential) (n : ℕ) : Prop := ∃ p : MvPolynomial (Module.Dual ℝ TwoHiggsDoublet) ℝ, (∀ φ : TwoHiggsDoublet, V φ = p.eval (fun i => i φ) ) ∧ p.totalDegree ≤ n +/-! + +## C. Reduction to the polynomial family of orbit representatives + +The two structural ingredients of the proof live elsewhere: + +* `TwoHiggsDoublet.exists_smul_eq_repHiggs` shows every configuration is gauge equivalent to a + representative `repHiggs X` from the *polynomial* family of orbit representatives, and +* `TwoHiggsDoublet.gramVector_repHiggs_*` show the Gram vector of a representative is a polynomial + in the four real parameters `X` (with no square roots). + +Because the potential is gauge invariant, its value on any configuration equals its value on a +representative, and the Gram vector is likewise unchanged. Hence the whole statement reduces to the +question of whether `V ∘ repHiggs` is a polynomial in the (polynomial) Gram components of the +representative family — see `exists_polynomial_on_repHiggs`. + +-/ + +/-- **The two Higgs doublet model first fundamental theorem (representative form).** + +This is the irreducible invariant–theoretic core of the theorem: a gauge invariant polynomial +potential, restricted to the polynomial family of orbit representatives `repHiggs X`, is a +polynomial in the Gram components of that family. + +This statement is square-root free (in contrast to the normalised representatives, whose +coordinates contain `√‖Φ1‖²`). It cannot follow from the parities of `V ∘ repHiggs` alone — e.g. +`X₁²` is parity invariant yet is `(Re ⟪Φ1,Φ2⟫)²/‖Φ1‖²`, which is not polynomial; it is excluded +precisely because it does not extend to a *global* polynomial invariant. The content is therefore +the non-abelian `SU(2)` first fundamental theorem specialised to two doublets in `ℂ²`, established +by the unipotent (shear group) reduction together with the Lagrange identity `norm_doubletDet_sq` +which folds the `SU(2)` determinant invariant back into the Gram data. -/ +lemma exists_polynomial_on_repHiggs {V : EffectivePotential} {n : ℕ} + (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : + ∃ p : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ, + ∀ X : Fin 4 → ℝ, V (repHiggs X) = p.eval (repHiggs X).gramVector := by + sorry + /-- An invariant effective potential with maximum mass dimension n can be written as a polynomial in the entries of the Gram vector. -/ lemma effectivePotential_is_polynomial_gramVector {V : EffectivePotential} {n : ℕ} (hI: IsInvariant V) (h : HasMaxMassDimLE V n) : ∃ p : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ, (∀ φ : TwoHiggsDoublet, V φ = p.eval φ.gramVector) := by - sorry + obtain ⟨p, hp⟩ := exists_polynomial_on_repHiggs hI h + refine ⟨p, fun φ => ?_⟩ + obtain ⟨X, g, hg⟩ := exists_smul_eq_repHiggs φ + have hgram : φ.gramVector = (repHiggs X).gramVector := by + rw [← hg] + funext μ + exact (gaugeGroupI_smul_fst_gramVector g φ μ).symm + have hV : V φ = V (repHiggs X) := by + rw [← hg] + exact (hI g φ).symm + rw [hV, hp X, hgram] end EffectivePotential diff --git a/PhyslibAlpha/2HDM/OrbitRepresentative.lean b/PhyslibAlpha/2HDM/OrbitRepresentative.lean new file mode 100644 index 000000000..327de2bed --- /dev/null +++ b/PhyslibAlpha/2HDM/OrbitRepresentative.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2026 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +module + +public import Physlib.Particles.BeyondTheStandardModel.TwoHDM.GramMatrix +/-! +# A polynomial family of orbit representatives for the two Higgs doublet model + +Every gauge orbit of the two Higgs doublet model meets the four–real–parameter family + +`repHiggs X = ⟨(X₀, 0), (X₁ + i X₂, X₃)⟩`. + +The crucial feature of this family (compared with the normalised representatives of +`gaugeGroupI_exists_fst_eq_snd_eq`) is that it is a *polynomial* family: the Gram vector of +`repHiggs X` is a polynomial in `X`, with no square roots. Consequently the value of a gauge +invariant potential on any field configuration is `V (repHiggs X)` for a suitable `X`, and the +question of whether `V` is a polynomial in the Gram vector reduces to the purely algebraic question +of whether `V ∘ repHiggs` lies in the subring generated by the (polynomial) Gram components of the +representative family. + +-/ + +@[expose] public section + +noncomputable section + +namespace TwoHiggsDoublet + +open InnerProductSpace +open StandardModel +open ComplexConjugate + +/-- A four–real–parameter polynomial family of representatives for the gauge orbits: the first + doublet is `(X₀, 0)` and the second is `(X₁ + i X₂, X₃)`. -/ +def repHiggs (X : Fin 4 → ℝ) : TwoHiggsDoublet where + Φ1 := !₂[(X 0 : ℂ), 0] + Φ2 := !₂[(X 1 : ℂ) + Complex.I * (X 2 : ℂ), (X 3 : ℂ)] + +@[simp] +lemma repHiggs_Φ1 (X : Fin 4 → ℝ) : (repHiggs X).Φ1 = !₂[(X 0 : ℂ), 0] := rfl + +@[simp] +lemma repHiggs_Φ2 (X : Fin 4 → ℝ) : + (repHiggs X).Φ2 = !₂[(X 1 : ℂ) + Complex.I * (X 2 : ℂ), (X 3 : ℂ)] := rfl + +lemma normSq_repHiggs_Φ1 (X : Fin 4 → ℝ) : ‖(repHiggs X).Φ1‖ ^ 2 = X 0 ^ 2 := by + rw [repHiggs_Φ1, PiLp.norm_sq_eq_of_L2, Fin.sum_univ_two] + simp [Complex.norm_real, Real.norm_eq_abs, sq_abs] + +lemma normSq_repHiggs_Φ2 (X : Fin 4 → ℝ) : + ‖(repHiggs X).Φ2‖ ^ 2 = X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2 := by + rw [repHiggs_Φ2, PiLp.norm_sq_eq_of_L2, Fin.sum_univ_two] + rw [← Complex.normSq_eq_norm_sq, ← Complex.normSq_eq_norm_sq] + simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Complex.normSq_apply, + Complex.add_re, Complex.add_im, Complex.ofReal_re, Complex.ofReal_im, Complex.mul_re, + Complex.mul_im, Complex.I_re, Complex.I_im] + ring + +lemma inner_repHiggs (X : Fin 4 → ℝ) : + ⟪(repHiggs X).Φ1, (repHiggs X).Φ2⟫_ℂ = (X 0 : ℂ) * ((X 1 : ℂ) + Complex.I * (X 2 : ℂ)) := by + rw [repHiggs_Φ1, repHiggs_Φ2, PiLp.inner_apply, Fin.sum_univ_two] + simp only [Matrix.cons_val_zero, Matrix.cons_val_one, RCLike.inner_apply, + map_zero, Complex.conj_ofReal] + ring + +/-! + +## The Gram vector of a representative + +The Gram vector of `repHiggs X` is an explicit polynomial in the four real parameters `X`. + +-/ + +@[simp] +lemma gramVector_repHiggs_inl (X : Fin 4 → ℝ) : + (repHiggs X).gramVector (Sum.inl 0) = X 0 ^ 2 + (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2) := by + rw [gramVector_inl_zero_eq, normSq_repHiggs_Φ1, normSq_repHiggs_Φ2] + +@[simp] +lemma gramVector_repHiggs_inr0 (X : Fin 4 → ℝ) : + (repHiggs X).gramVector (Sum.inr 0) = 2 * X 0 * X 1 := by + rw [gramVector_inr_zero_eq, inner_repHiggs] + simp only [Complex.mul_re, Complex.add_re, Complex.add_im, Complex.ofReal_re, Complex.ofReal_im, + Complex.I_re, Complex.I_im, Complex.mul_im] + ring + +@[simp] +lemma gramVector_repHiggs_inr1 (X : Fin 4 → ℝ) : + (repHiggs X).gramVector (Sum.inr 1) = 2 * X 0 * X 2 := by + rw [gramVector_inr_one_eq, inner_repHiggs] + simp only [Complex.mul_im, Complex.add_re, Complex.add_im, Complex.ofReal_re, Complex.ofReal_im, + Complex.I_re, Complex.I_im, Complex.mul_re] + ring + +@[simp] +lemma gramVector_repHiggs_inr2 (X : Fin 4 → ℝ) : + (repHiggs X).gramVector (Sum.inr 2) = X 0 ^ 2 - (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2) := by + rw [gramVector_inr_two_eq, normSq_repHiggs_Φ1, normSq_repHiggs_Φ2] + +/-! + +## Every configuration is gauge equivalent to a representative + +-/ + +/-- Every field configuration is in the gauge orbit of a representative `repHiggs X`. This is the + key fact that lets a gauge invariant potential be evaluated on the polynomial family. -/ +lemma exists_smul_eq_repHiggs (φ : TwoHiggsDoublet) : + ∃ (X : Fin 4 → ℝ) (g : GaugeGroupI), g • φ = repHiggs X := by + by_cases h : φ.Φ1 = 0 + · refine ⟨![0, ‖φ.Φ2‖, 0, 0], HiggsVec.toRealGroupElem φ.Φ2, ?_⟩ + ext1 + · rw [gaugeGroupI_smul_fst, h, smul_zero, repHiggs_Φ1] + ext i + fin_cases i <;> simp + · rw [gaugeGroupI_smul_snd, HiggsVec.toRealGroupElem_smul_self, repHiggs_Φ2, + HiggsVec.ofReal] + ext i + fin_cases i <;> simp [Real.sqrt_sq, norm_nonneg] + · obtain ⟨g, h1, h2⟩ := gaugeGroupI_exists_fst_eq_snd_eq h + refine ⟨![‖φ.Φ1‖, (⟪φ.Φ1, φ.Φ2⟫_ℂ / ‖φ.Φ1‖).re, (⟪φ.Φ1, φ.Φ2⟫_ℂ / ‖φ.Φ1‖).im, + √(φ.gramMatrix.det.re) / ‖φ.Φ1‖], g, ?_⟩ + ext1 + · rw [gaugeGroupI_smul_fst, h1, repHiggs_Φ1] + ext i + fin_cases i <;> simp + · rw [gaugeGroupI_smul_snd, h2, repHiggs_Φ2] + ext i + fin_cases i + · show ⟪φ.Φ1, φ.Φ2⟫_ℂ / ↑‖φ.Φ1‖ = + ↑(⟪φ.Φ1, φ.Φ2⟫_ℂ / ↑‖φ.Φ1‖).re + Complex.I * ↑(⟪φ.Φ1, φ.Φ2⟫_ℂ / ↑‖φ.Φ1‖).im + rw [mul_comm Complex.I, Complex.re_add_im] + · simp [Complex.ofReal_div] + +end TwoHiggsDoublet From 9a8cd668c4afb94a7969f0d342a831fd093c6e6c Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 11:23:07 +0100 Subject: [PATCH 05/25] feat: Claude build 2 Co-Authored-By: Claude --- PhyslibAlpha/2HDM/GaugeTorus.lean | 67 +++++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) create mode 100644 PhyslibAlpha/2HDM/GaugeTorus.lean diff --git a/PhyslibAlpha/2HDM/GaugeTorus.lean b/PhyslibAlpha/2HDM/GaugeTorus.lean new file mode 100644 index 000000000..49779ba6b --- /dev/null +++ b/PhyslibAlpha/2HDM/GaugeTorus.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +module + +public import Physlib.Particles.BeyondTheStandardModel.TwoHDM.GramMatrix +/-! +# The gauge torus acting on Higgs vectors + +The maximal torus of the gauge group acting on a Higgs doublet is the group of diagonal phase +rotations `diag(a, b)` of the two components. We realise it using + +* the `SU(2)` Cartan element `diag(a, ā)` (constructed here as `gaugeCartan`), and +* the existing `ofU1Subgroup`, whose action is `diag(1, μ)`. + +Together these realise an arbitrary diagonal phase `diag(a, b)`, which is the symmetry underlying +the charge-balancing ("Condition A") of the effective potential on the orbit representatives. +-/ + +@[expose] public section + +noncomputable section + +namespace StandardModel +namespace GaugeGroupI + +open Matrix Complex + +/-- The Cartan `SU(2)` gauge element `diag(a, ā)`, for `a` a phase. -/ +noncomputable def gaugeCartan (a : unitary ℂ) : GaugeGroupI := + (1, + ⟨!![(a : ℂ), 0; 0, (star a : ℂ)], by + have h1 : (starRingEnd ℂ) (a : ℂ) * (a : ℂ) = 1 := a.2.1 + have h2 : (a : ℂ) * (starRingEnd ℂ) (a : ℂ) = 1 := a.2.2 + simp only [SetLike.mem_coe] + rw [mem_unitaryGroup_iff'] + funext i j + rw [Matrix.mul_apply] + fin_cases i <;> fin_cases j <;> + simp [Fin.sum_univ_two, h1, h2], by + simp only [RCLike.star_def, SetLike.mem_coe, MonoidHom.mem_mker, coe_detMonoidHom, + det_fin_two_of, mul_zero, sub_zero] + simpa using a.2.2⟩, 1) + +@[simp] +lemma gaugeCartan_toU1 (a : unitary ℂ) : (gaugeCartan a).toU1 = 1 := rfl + +@[simp] +lemma gaugeCartan_toSU2_coe (a : unitary ℂ) : + ((gaugeCartan a).toSU2 : Matrix (Fin 2) (Fin 2) ℂ) = !![(a : ℂ), 0; 0, (star a : ℂ)] := rfl + +/-- The Cartan element phases the two components of a Higgs vector by `a` and `ā`. -/ +lemma gaugeCartan_smul_apply_zero (a : unitary ℂ) (φ : HiggsVec) : + (gaugeCartan a • φ) 0 = (a : ℂ) * φ 0 := by + rw [HiggsVec.gaugeGroupI_smul_eq, gaugeCartan_toU1, one_pow, one_smul] + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, gaugeCartan_toSU2_coe] + +/-- The Cartan element phases the two components of a Higgs vector by `a` and `ā`. -/ +lemma gaugeCartan_smul_apply_one (a : unitary ℂ) (φ : HiggsVec) : + (gaugeCartan a • φ) 1 = (star a : ℂ) * φ 1 := by + rw [HiggsVec.gaugeGroupI_smul_eq, gaugeCartan_toU1, one_pow, one_smul] + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, gaugeCartan_toSU2_coe] + +end GaugeGroupI +end StandardModel From 9aef3a361e7c56a866456d552a7c7f7cc9b97bd2 Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 11:34:44 +0100 Subject: [PATCH 06/25] feat: Claude block 3 Co-Authored-By: Claude --- PhyslibAlpha/2HDM/ChargeBalance.lean | 89 ++++++++++++++++++++++++++++ 1 file changed, 89 insertions(+) create mode 100644 PhyslibAlpha/2HDM/ChargeBalance.lean diff --git a/PhyslibAlpha/2HDM/ChargeBalance.lean b/PhyslibAlpha/2HDM/ChargeBalance.lean new file mode 100644 index 000000000..2fc721157 --- /dev/null +++ b/PhyslibAlpha/2HDM/ChargeBalance.lean @@ -0,0 +1,89 @@ +/- +Copyright (c) 2026 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +module + +public import Mathlib.Algebra.MvPolynomial.Basic +public import Mathlib.Algebra.MvPolynomial.CommRing +public import Mathlib.Tactic.Ring +/-! +# Charge balancing for polynomials + +If the variables of a polynomial carry charges under a phase (here a single element `c` of infinite +order), then invariance under the simultaneous phase rotation `Xᵢ ↦ c^{wᵢ} Xᵢ` forces every +monomial to be *charge balanced* (net charge zero). This is the algebraic content of the statement +that a gauge invariant potential, restricted to a slice on which the gauge torus acts diagonally, +can only contain charge-balanced monomials. +-/ + +@[expose] public section + +namespace MvPolynomial + +open scoped Classical in +/-- Rescaling each variable `Xᵢ` by a constant `d i` multiplies the coefficient of the monomial `m` + by `∏ᵢ (d i) ^ (m i)`. -/ +lemma coeff_aeval_diag {σ R : Type*} [CommRing R] (d : σ → R) (f : MvPolynomial σ R) + (m : σ →₀ ℕ) : + coeff m (aeval (fun i => C (d i) * X i) f) = (m.prod fun i k => d i ^ k) * coeff m f := by + induction f using MvPolynomial.induction_on generalizing m with + | C a => + rw [aeval_C, MvPolynomial.algebraMap_eq, coeff_C] + by_cases hm : (0 : σ →₀ ℕ) = m + · subst hm; simp + · rw [if_neg hm, mul_zero] + | add p q hp hq => + rw [map_add, coeff_add, coeff_add, hp m, hq m, mul_add] + | mul_X p i hp => + rw [map_mul, aeval_X] + have hrw : (aeval (fun i => C (d i) * X i) p) * (C (d i) * X i) + = C (d i) * ((aeval (fun i => C (d i) * X i) p) * X i) := by + rw [mul_left_comm] + rw [hrw, coeff_C_mul, coeff_mul_X', coeff_mul_X'] + by_cases hi : i ∈ m.support + · rw [if_pos hi, if_pos hi, hp (m - Finsupp.single i 1)] + have hmi : 1 ≤ m i := Nat.one_le_iff_ne_zero.mpr (Finsupp.mem_support_iff.mp hi) + have hle : Finsupp.single i 1 ≤ m := Finsupp.single_le_iff.mpr hmi + have hsplit : m = (m - Finsupp.single i 1) + Finsupp.single i 1 := + (tsub_add_cancel_of_le hle).symm + have hprod : (m.prod fun i k => d i ^ k) + = ((m - Finsupp.single i 1).prod fun i k => d i ^ k) * d i := by + conv_lhs => rw [hsplit] + rw [Finsupp.prod_add_index' (by intro a; simp) (by intro a b c; rw [pow_add]), + Finsupp.prod_single_index (by simp)] + simp + rw [hprod] + ring + · rw [if_neg hi, if_neg hi, mul_zero, mul_zero] + +/-- **Charge balancing.** If each variable `Xᵢ` carries an integer charge `w i`, `c` is a phase of + infinite order, and the polynomial `f` is invariant under the charge rotation + `Xᵢ ↦ c^{wᵢ} Xᵢ`, then every monomial with nonzero net charge has vanishing coefficient. -/ +lemma coeff_eq_zero_of_charge_ne_zero {σ K : Type*} [Field K] (w : σ → ℤ) (c : K) (hc : c ≠ 0) + (hroot : ∀ n : ℤ, c ^ n = 1 → n = 0) {f : MvPolynomial σ K} + (hf : aeval (fun i => C (c ^ (w i)) * X i) f = f) {m : σ →₀ ℕ} + (hm : ∑ i ∈ m.support, (m i : ℤ) * w i ≠ 0) : + coeff m f = 0 := by + classical + have key := coeff_aeval_diag (fun i => c ^ (w i)) f m + rw [hf] at key + have hgen : ∀ s : Finset σ, ∏ i ∈ s, (c ^ (w i)) ^ (m i) + = c ^ (∑ i ∈ s, (m i : ℤ) * w i) := by + intro s + induction s using Finset.induction with + | empty => simp + | @insert x t hx ih => + rw [Finset.prod_insert hx, Finset.sum_insert hx, ih, zpow_add₀ hc] + congr 1 + rw [← zpow_natCast (c ^ w x) (m x), ← zpow_mul, mul_comm] + rw [Finsupp.prod, hgen] at key + have hne : c ^ (∑ i ∈ m.support, (m i : ℤ) * w i) ≠ 1 := fun h => hm (hroot _ h) + have h2 : (1 - c ^ (∑ i ∈ m.support, (m i : ℤ) * w i)) * coeff m f = 0 := by + rw [sub_mul, one_mul, ← key, sub_self] + rcases mul_eq_zero.mp h2 with h | h + · exact absurd (sub_eq_zero.mp h).symm hne + · exact h + +end MvPolynomial From af7b736ee1f6131be23d6ff015b8aa5c6e4d3098 Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 11:48:03 +0100 Subject: [PATCH 07/25] feat: Next claude batch Co-Authored-By: Claude --- PhyslibAlpha/2HDM/GaugeSlice.lean | 74 +++++++++++++++++++++++++++++++ PhyslibAlpha/2HDM/GaugeTorus.lean | 5 +++ 2 files changed, 79 insertions(+) create mode 100644 PhyslibAlpha/2HDM/GaugeSlice.lean diff --git a/PhyslibAlpha/2HDM/GaugeSlice.lean b/PhyslibAlpha/2HDM/GaugeSlice.lean new file mode 100644 index 000000000..2e2674baa --- /dev/null +++ b/PhyslibAlpha/2HDM/GaugeSlice.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +module + +public import PhyslibAlpha.«2HDM».GaugeTorus +public import PhyslibAlpha.«2HDM».OrbitRepresentative +/-! +# The gauge slice and the hypercharges of the doublet components + +After using `SU(2)` to align the first doublet with the first axis, a configuration lies on the +*upper-triangular slice* `sliceHiggs z w₀ w₁ = ⟨(z, 0), (w₀, w₁)⟩`. The gauge torus acts on the +three surviving components `z = Φ1₀`, `w₀ = Φ2₀`, `w₁ = Φ2₁` by their hypercharges: + +* the Cartan phase `a` multiplies the *first* components `z, w₀` (and conjugates the would-be second + component of `Φ1`, which vanishes here), giving `(z, w₀, w₁) ↦ (a z, a w₀, ā w₁)`; +* the residual `U(1)` (`ofU1Subgroup c`) multiplies the *second* component `w₁` by `c⁶`, giving + `(z, w₀, w₁) ↦ (z, w₀, c⁶ w₁)`. + +These two phase rotations are the source of the charge balancing of the effective potential. +-/ + +@[expose] public section + +noncomputable section + +namespace TwoHiggsDoublet + +open InnerProductSpace +open StandardModel +open ComplexConjugate + +/-- The upper-triangular slice configuration `⟨(z, 0), (w₀, w₁)⟩`. It specialises to `repHiggs` + when the components take their real "canonical frame" values. -/ +def sliceHiggs (z w0 w1 : ℂ) : TwoHiggsDoublet where + Φ1 := !₂[z, 0] + Φ2 := !₂[w0, w1] + +@[simp] lemma sliceHiggs_Φ1 (z w0 w1 : ℂ) : (sliceHiggs z w0 w1).Φ1 = !₂[z, 0] := rfl +@[simp] lemma sliceHiggs_Φ2 (z w0 w1 : ℂ) : (sliceHiggs z w0 w1).Φ2 = !₂[w0, w1] := rfl + +/-- The representative family is the real slice. -/ +lemma repHiggs_eq_sliceHiggs (X : Fin 4 → ℝ) : + repHiggs X = sliceHiggs (X 0) ((X 1 : ℂ) + Complex.I * (X 2 : ℂ)) (X 3) := rfl + +/-- Hypercharge action of the Cartan phase on the slice: it multiplies the first components by `a` + and the perpendicular second component by `ā`. -/ +lemma gaugeCartan_smul_sliceHiggs (a : unitary ℂ) (z w0 w1 : ℂ) : + GaugeGroupI.gaugeCartan a • sliceHiggs z w0 w1 + = sliceHiggs ((a : ℂ) * z) ((a : ℂ) * w0) ((star a : ℂ) * w1) := by + apply ext_of_fst_snd + · rw [gaugeGroupI_smul_fst, GaugeGroupI.gaugeCartan_smul_eq] + ext i + fin_cases i <;> simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] + · rw [gaugeGroupI_smul_snd, GaugeGroupI.gaugeCartan_smul_eq] + ext i + fin_cases i <;> simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] + +/-- Hypercharge action of the residual `U(1)` on the slice: it multiplies the perpendicular second + component by `c⁶` and leaves the first components fixed. -/ +lemma ofU1Subgroup_smul_sliceHiggs (c : unitary ℂ) (z w0 w1 : ℂ) : + GaugeGroupI.ofU1Subgroup c • sliceHiggs z w0 w1 + = sliceHiggs z w0 ((c : ℂ) ^ 6 * w1) := by + apply ext_of_fst_snd + · rw [gaugeGroupI_smul_fst, HiggsVec.ofU1Subgroup_smul_eq_smul] + ext i + fin_cases i <;> simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] + · rw [gaugeGroupI_smul_snd, HiggsVec.ofU1Subgroup_smul_eq_smul] + ext i + fin_cases i <;> simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] + +end TwoHiggsDoublet diff --git a/PhyslibAlpha/2HDM/GaugeTorus.lean b/PhyslibAlpha/2HDM/GaugeTorus.lean index 49779ba6b..d0cb6a4b7 100644 --- a/PhyslibAlpha/2HDM/GaugeTorus.lean +++ b/PhyslibAlpha/2HDM/GaugeTorus.lean @@ -51,6 +51,11 @@ lemma gaugeCartan_toU1 (a : unitary ℂ) : (gaugeCartan a).toU1 = 1 := rfl lemma gaugeCartan_toSU2_coe (a : unitary ℂ) : ((gaugeCartan a).toSU2 : Matrix (Fin 2) (Fin 2) ℂ) = !![(a : ℂ), 0; 0, (star a : ℂ)] := rfl +/-- The Cartan element acts as the diagonal matrix `diag(a, ā)`. -/ +lemma gaugeCartan_smul_eq (a : unitary ℂ) (φ : HiggsVec) : + gaugeCartan a • φ = WithLp.toLp 2 (!![(a : ℂ), 0; 0, (star a : ℂ)] *ᵥ φ.ofLp) := by + rw [HiggsVec.gaugeGroupI_smul_eq, gaugeCartan_toU1, one_pow, one_smul, gaugeCartan_toSU2_coe] + /-- The Cartan element phases the two components of a Higgs vector by `a` and `ā`. -/ lemma gaugeCartan_smul_apply_zero (a : unitary ℂ) (φ : HiggsVec) : (gaugeCartan a • φ) 0 = (a : ℂ) * φ 0 := by From 19cd46b12e64c62bd80153dcac7d25b28d67cb2a Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 12:05:45 +0100 Subject: [PATCH 08/25] feat: Claude next batch Co-Authored-By: Claude --- PhyslibAlpha/2HDM/EffectivePotential.lean | 28 +++++++++++++++++++++++ PhyslibAlpha/2HDM/GaugeSlice.lean | 21 +++++++++++++++++ 2 files changed, 49 insertions(+) diff --git a/PhyslibAlpha/2HDM/EffectivePotential.lean b/PhyslibAlpha/2HDM/EffectivePotential.lean index a18d86ab6..78050bfbc 100644 --- a/PhyslibAlpha/2HDM/EffectivePotential.lean +++ b/PhyslibAlpha/2HDM/EffectivePotential.lean @@ -9,6 +9,8 @@ public import Physlib.Particles.BeyondTheStandardModel.TwoHDM.GramMatrix public import Mathlib.RingTheory.MvPolynomial.Homogeneous public import PhyslibAlpha.«2HDM».Determinant public import PhyslibAlpha.«2HDM».OrbitRepresentative +public import PhyslibAlpha.«2HDM».GaugeSlice +public import PhyslibAlpha.«2HDM».ChargeBalance /-! # The effective potential of the two Higgs doublet model @@ -71,6 +73,32 @@ def HasMaxMassDimLE (V : EffectivePotential) (n : ℕ) : Prop := ∃ p : MvPolynomial (Module.Dual ℝ TwoHiggsDoublet) ℝ, (∀ φ : TwoHiggsDoublet, V φ = p.eval (fun i => i φ) ) ∧ p.totalDegree ≤ n +/-- A polynomial potential, restricted along any real-linear parametrisation `L` of field + configurations, is a genuine polynomial in the parameters. This is the bookkeeping that lets the + potential be evaluated on the field components of a gauge slice. -/ +lemma HasMaxMassDimLE.exists_comp_linear_poly {V : EffectivePotential} {n : ℕ} + (h : HasMaxMassDimLE V n) {ι : Type*} [Fintype ι] [DecidableEq ι] + (L : (ι → ℝ) →ₗ[ℝ] TwoHiggsDoublet) : + ∃ P : MvPolynomial ι ℝ, ∀ a : ι → ℝ, V (L a) = P.eval a := by + obtain ⟨p, hp, -⟩ := h + refine ⟨MvPolynomial.aeval + (fun i => ∑ k : ι, MvPolynomial.C (i (L (Pi.single k 1))) * MvPolynomial.X k) p, fun a => ?_⟩ + have key : (fun i : Module.Dual ℝ TwoHiggsDoublet => i (L a)) + = fun i => MvPolynomial.eval a + (∑ k : ι, MvPolynomial.C (i (L (Pi.single k 1))) * MvPolynomial.X k) := by + funext i + have ha : a = ∑ k : ι, a k • (Pi.single k 1 : ι → ℝ) := by + funext j + simp [Finset.sum_apply, Pi.single_apply, Finset.sum_ite_eq] + rw [map_sum] + conv_lhs => rw [ha, map_sum, map_sum] + apply Finset.sum_congr rfl + intro k _ + rw [map_smul, map_smul, MvPolynomial.eval_mul, MvPolynomial.eval_C, MvPolynomial.eval_X, + smul_eq_mul, mul_comm] + rw [hp, key, MvPolynomial.aeval_def, MvPolynomial.algebraMap_eq, ← MvPolynomial.eval_assoc] + rfl + /-! ## C. Reduction to the polynomial family of orbit representatives diff --git a/PhyslibAlpha/2HDM/GaugeSlice.lean b/PhyslibAlpha/2HDM/GaugeSlice.lean index 2e2674baa..babdd8a97 100644 --- a/PhyslibAlpha/2HDM/GaugeSlice.lean +++ b/PhyslibAlpha/2HDM/GaugeSlice.lean @@ -41,6 +41,27 @@ def sliceHiggs (z w0 w1 : ℂ) : TwoHiggsDoublet where @[simp] lemma sliceHiggs_Φ1 (z w0 w1 : ℂ) : (sliceHiggs z w0 w1).Φ1 = !₂[z, 0] := rfl @[simp] lemma sliceHiggs_Φ2 (z w0 w1 : ℂ) : (sliceHiggs z w0 w1).Φ2 = !₂[w0, w1] := rfl +@[simp] lemma real_smul_fst (c : ℝ) (H : TwoHiggsDoublet) : (c • H).Φ1 = c • H.Φ1 := rfl +@[simp] lemma real_smul_snd (c : ℝ) (H : TwoHiggsDoublet) : (c • H).Φ2 = c • H.Φ2 := rfl + +/-- The slice as a real-linear map from the six real field parameters + `(Re Φ1₀, Im Φ1₀, Re Φ2₀, Im Φ2₀, Re Φ2₁, Im Φ2₁)`. -/ +def sliceR : (Fin 6 → ℝ) →ₗ[ℝ] TwoHiggsDoublet where + toFun a := sliceHiggs (↑(a 0) + Complex.I * ↑(a 1)) (↑(a 2) + Complex.I * ↑(a 3)) + (↑(a 4) + Complex.I * ↑(a 5)) + map_add' a b := by + apply ext_of_fst_snd + · ext i; fin_cases i <;> simp [sliceHiggs] <;> ring + · ext i; fin_cases i <;> simp [sliceHiggs] <;> ring + map_smul' c a := by + apply ext_of_fst_snd + · ext i; fin_cases i <;> simp [sliceHiggs, Complex.real_smul] <;> ring + · ext i; fin_cases i <;> simp [sliceHiggs, Complex.real_smul] <;> ring + +@[simp] lemma sliceR_apply (a : Fin 6 → ℝ) : + sliceR a = sliceHiggs (↑(a 0) + Complex.I * ↑(a 1)) (↑(a 2) + Complex.I * ↑(a 3)) + (↑(a 4) + Complex.I * ↑(a 5)) := rfl + /-- The representative family is the real slice. -/ lemma repHiggs_eq_sliceHiggs (X : Fin 4 → ℝ) : repHiggs X = sliceHiggs (X 0) ((X 1 : ℂ) + Complex.I * (X 2 : ℂ)) (X 3) := rfl From 5ee8ab3cc5bfd5959ebb208f5d7140b30fcf7051 Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 12:18:33 +0100 Subject: [PATCH 09/25] feat: next batch. Co-Authored-By: Claude --- PhyslibAlpha/2HDM/GaugeSlice.lean | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/PhyslibAlpha/2HDM/GaugeSlice.lean b/PhyslibAlpha/2HDM/GaugeSlice.lean index babdd8a97..a33882447 100644 --- a/PhyslibAlpha/2HDM/GaugeSlice.lean +++ b/PhyslibAlpha/2HDM/GaugeSlice.lean @@ -62,6 +62,20 @@ def sliceR : (Fin 6 → ℝ) →ₗ[ℝ] TwoHiggsDoublet where sliceR a = sliceHiggs (↑(a 0) + Complex.I * ↑(a 1)) (↑(a 2) + Complex.I * ↑(a 3)) (↑(a 4) + Complex.I * ↑(a 5)) := rfl +/-- The representative family as a real-linear map of its four real parameters. -/ +def repHiggsLin : (Fin 4 → ℝ) →ₗ[ℝ] TwoHiggsDoublet where + toFun X := repHiggs X + map_add' a b := by + apply ext_of_fst_snd + · ext i; fin_cases i <;> simp [repHiggs] <;> ring + · ext i; fin_cases i <;> simp [repHiggs] <;> ring + map_smul' c a := by + apply ext_of_fst_snd + · ext i; fin_cases i <;> simp [repHiggs, Complex.real_smul] <;> ring + · ext i; fin_cases i <;> simp [repHiggs, Complex.real_smul] <;> ring + +@[simp] lemma repHiggsLin_apply (X : Fin 4 → ℝ) : repHiggsLin X = repHiggs X := rfl + /-- The representative family is the real slice. -/ lemma repHiggs_eq_sliceHiggs (X : Fin 4 → ℝ) : repHiggs X = sliceHiggs (X 0) ((X 1 : ℂ) + Complex.I * (X 2 : ℂ)) (X 3) := rfl From 4403284817af05aae8dab427fae940b75e2e03a1 Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 12:34:48 +0100 Subject: [PATCH 10/25] feat: Next batch Co-Authored-By: Claude --- PhyslibAlpha/2HDM/EffectivePotential.lean | 56 +++++++++++++++++++++++ PhyslibAlpha/2HDM/GaugeSlice.lean | 32 +++++++++++++ 2 files changed, 88 insertions(+) diff --git a/PhyslibAlpha/2HDM/EffectivePotential.lean b/PhyslibAlpha/2HDM/EffectivePotential.lean index 78050bfbc..0b993dadc 100644 --- a/PhyslibAlpha/2HDM/EffectivePotential.lean +++ b/PhyslibAlpha/2HDM/EffectivePotential.lean @@ -7,6 +7,7 @@ module public import Physlib.Particles.BeyondTheStandardModel.TwoHDM.GramMatrix public import Mathlib.RingTheory.MvPolynomial.Homogeneous +public import Mathlib.Algebra.MvPolynomial.Funext public import PhyslibAlpha.«2HDM».Determinant public import PhyslibAlpha.«2HDM».OrbitRepresentative public import PhyslibAlpha.«2HDM».GaugeSlice @@ -99,6 +100,61 @@ lemma HasMaxMassDimLE.exists_comp_linear_poly {V : EffectivePotential} {n : ℕ} rw [hp, key, MvPolynomial.aeval_def, MvPolynomial.algebraMap_eq, ← MvPolynomial.eval_assoc] rfl +open MvPolynomial in +/-- The Cartan hypercharge rotation of the slice parameters, as a substitution of the polynomial + variables. -/ +noncomputable def rotSubst (u : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℝ := + ![C (u : ℂ).re * X 0 - C (u : ℂ).im * X 1, C (u : ℂ).im * X 0 + C (u : ℂ).re * X 1, + C (u : ℂ).re * X 2 - C (u : ℂ).im * X 3, C (u : ℂ).im * X 2 + C (u : ℂ).re * X 3, + C (u : ℂ).re * X 4 + C (u : ℂ).im * X 5, C (u : ℂ).re * X 5 - C (u : ℂ).im * X 4] + +open MvPolynomial in +lemma eval_rotSubst (u : unitary ℂ) (a : Fin 6 → ℝ) : + (fun k => MvPolynomial.eval a (rotSubst u k)) = cartanRotParam u a := by + funext k + fin_cases k <;> + simp [rotSubst, cartanRotParam, Complex.mul_re, Complex.mul_im] <;> ring + +open MvPolynomial in +/-- Gauge (Cartan) invariance of the potential forces the slice polynomial to be invariant under the + hypercharge rotation of its variables. -/ +lemma aeval_rotSubst_eq {V : EffectivePotential} (hI : IsInvariant V) + {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (u : unitary ℂ) : + aeval (rotSubst u) P = P := by + apply MvPolynomial.funext + intro a + have hcomp : eval a (aeval (rotSubst u) P) = P.eval (fun k => eval a (rotSubst u k)) := by + rw [aeval_def, algebraMap_eq, ← MvPolynomial.eval_assoc] + rfl + rw [hcomp, eval_rotSubst, ← hP (cartanRotParam u a), ← gaugeCartan_smul_sliceR, + hI (StandardModel.GaugeGroupI.gaugeCartan u), hP a] + +open MvPolynomial in +/-- The residual `U(1)` rotation of the perpendicular parameter, as a substitution. -/ +noncomputable def resSubst (c : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℝ := + ![X 0, X 1, X 2, X 3, + C (((c : ℂ) ^ 6).re) * X 4 - C (((c : ℂ) ^ 6).im) * X 5, + C (((c : ℂ) ^ 6).im) * X 4 + C (((c : ℂ) ^ 6).re) * X 5] + +open MvPolynomial in +lemma eval_resSubst (c : unitary ℂ) (a : Fin 6 → ℝ) : + (fun k => MvPolynomial.eval a (resSubst c k)) = resRotParam c a := by + funext k + fin_cases k <;> simp [resSubst, resRotParam, Complex.mul_re, Complex.mul_im] <;> ring + +open MvPolynomial in +/-- Gauge (residual `U(1)`) invariance forces the slice polynomial to be invariant under the + perpendicular rotation of its variables. -/ +lemma aeval_resSubst_eq {V : EffectivePotential} (hI : IsInvariant V) + {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (c : unitary ℂ) : + aeval (resSubst c) P = P := by + apply MvPolynomial.funext + intro a + have hcomp : eval a (aeval (resSubst c) P) = P.eval (fun k => eval a (resSubst c k)) := by + rw [aeval_def, algebraMap_eq, ← MvPolynomial.eval_assoc]; rfl + rw [hcomp, eval_resSubst, ← hP (resRotParam c a), ← ofU1Subgroup_smul_sliceR, + hI (StandardModel.GaugeGroupI.ofU1Subgroup c), hP a] + /-! ## C. Reduction to the polynomial family of orbit representatives diff --git a/PhyslibAlpha/2HDM/GaugeSlice.lean b/PhyslibAlpha/2HDM/GaugeSlice.lean index a33882447..ff7844ab1 100644 --- a/PhyslibAlpha/2HDM/GaugeSlice.lean +++ b/PhyslibAlpha/2HDM/GaugeSlice.lean @@ -106,4 +106,36 @@ lemma ofU1Subgroup_smul_sliceHiggs (c : unitary ℂ) (z w0 w1 : ℂ) : ext i fin_cases i <;> simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two] +open Complex in +/-- The Cartan hypercharge phase `u`, transported to a rotation of the six real field parameters: + it phases the first-component pairs by `u` and the perpendicular pair by `ū`. -/ +def cartanRotParam (u : unitary ℂ) (a : Fin 6 → ℝ) : Fin 6 → ℝ := + ![((u : ℂ) * (↑(a 0) + I * ↑(a 1))).re, ((u : ℂ) * (↑(a 0) + I * ↑(a 1))).im, + ((u : ℂ) * (↑(a 2) + I * ↑(a 3))).re, ((u : ℂ) * (↑(a 2) + I * ↑(a 3))).im, + ((star u : ℂ) * (↑(a 4) + I * ↑(a 5))).re, ((star u : ℂ) * (↑(a 4) + I * ↑(a 5))).im] + +/-- Acting by the Cartan phase on a slice configuration is the same as rotating its parameters. -/ +lemma gaugeCartan_smul_sliceR (u : unitary ℂ) (a : Fin 6 → ℝ) : + GaugeGroupI.gaugeCartan u • sliceR a = sliceR (cartanRotParam u a) := by + have h : ∀ z : ℂ, (↑z.re + Complex.I * ↑z.im) = z := fun z => by + rw [mul_comm]; exact Complex.re_add_im z + rw [sliceR_apply, gaugeCartan_smul_sliceHiggs, sliceR_apply] + congr 1 <;> simp only [cartanRotParam, Matrix.cons_val_zero, Matrix.cons_val_one, + Matrix.cons_val, Fin.isValue] <;> rw [h] + +open Complex in +/-- The residual `U(1)` phase `c`, transported to a rotation of the perpendicular parameter pair. -/ +def resRotParam (c : unitary ℂ) (a : Fin 6 → ℝ) : Fin 6 → ℝ := + ![a 0, a 1, a 2, a 3, (((c : ℂ) ^ 6) * ((a 4 : ℂ) + I * (a 5 : ℂ))).re, + (((c : ℂ) ^ 6) * ((a 4 : ℂ) + I * (a 5 : ℂ))).im] + +/-- Acting by the residual `U(1)` on a slice configuration rotates only the perpendicular pair. -/ +lemma ofU1Subgroup_smul_sliceR (c : unitary ℂ) (a : Fin 6 → ℝ) : + GaugeGroupI.ofU1Subgroup c • sliceR a = sliceR (resRotParam c a) := by + have h : ∀ z : ℂ, (↑z.re + Complex.I * ↑z.im) = z := fun z => by + rw [mul_comm]; exact Complex.re_add_im z + rw [sliceR_apply, ofU1Subgroup_smul_sliceHiggs, sliceR_apply] + congr 1 <;> simp only [resRotParam, Matrix.cons_val_zero, Matrix.cons_val_one, + Matrix.cons_val, Fin.isValue] <;> first | rfl | rw [h] + end TwoHiggsDoublet From a22dbdbf9e2d07dc9a512da66b2a8599d26c99b3 Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 13:11:34 +0100 Subject: [PATCH 11/25] refactor: Next turn Co-Authored-By: Claude --- PhyslibAlpha/2HDM/EffectivePotential.lean | 161 ++++++++++++++++++++++ 1 file changed, 161 insertions(+) diff --git a/PhyslibAlpha/2HDM/EffectivePotential.lean b/PhyslibAlpha/2HDM/EffectivePotential.lean index 0b993dadc..fc59871da 100644 --- a/PhyslibAlpha/2HDM/EffectivePotential.lean +++ b/PhyslibAlpha/2HDM/EffectivePotential.lean @@ -8,6 +8,8 @@ module public import Physlib.Particles.BeyondTheStandardModel.TwoHDM.GramMatrix public import Mathlib.RingTheory.MvPolynomial.Homogeneous public import Mathlib.Algebra.MvPolynomial.Funext +public import Mathlib.Algebra.MvPolynomial.Monad +public import Mathlib.Analysis.Real.Pi.Irrational public import PhyslibAlpha.«2HDM».Determinant public import PhyslibAlpha.«2HDM».OrbitRepresentative public import PhyslibAlpha.«2HDM».GaugeSlice @@ -155,6 +157,165 @@ lemma aeval_resSubst_eq {V : EffectivePotential} (hI : IsInvariant V) rw [hcomp, eval_resSubst, ← hP (resRotParam c a), ← ofU1Subgroup_smul_sliceR, hI (StandardModel.GaugeGroupI.ofU1Subgroup c), hP a] +open MvPolynomial in +/-- Change to hypercharge eigen-coordinates: `aₖ` in terms of `z, z̄, w₀, w̄₀, w₁, w̄₁` + (indices `0..5`). This diagonalises the gauge-torus rotation into a scaling. -/ +noncomputable def cplxEigen : Fin 6 → MvPolynomial (Fin 6) ℂ := + ![(X 0 + X 1) * C (1 / 2), (X 0 - X 1) * C (-Complex.I / 2), + (X 2 + X 3) * C (1 / 2), (X 2 - X 3) * C (-Complex.I / 2), + (X 4 + X 5) * C (1 / 2), (X 4 - X 5) * C (-Complex.I / 2)] + +open MvPolynomial in +/-- The Cartan hypercharge, diagonal in eigen-coordinates: charges `(1,-1,1,-1,-1,1)`. -/ +noncomputable def diagCartan (u : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℂ := + ![C (u : ℂ) * X 0, C (star (u : ℂ)) * X 1, C (u : ℂ) * X 2, C (star (u : ℂ)) * X 3, + C (star (u : ℂ)) * X 4, C (u : ℂ) * X 5] + +open MvPolynomial in +/-- The residual `U(1)`, diagonal in eigen-coordinates: only the perpendicular pair is charged. -/ +noncomputable def diagRes (c : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℂ := + ![X 0, X 1, X 2, X 3, C ((c : ℂ) ^ 6) * X 4, C (star ((c : ℂ) ^ 6)) * X 5] + +open MvPolynomial in +/-- Conjugation identity: the diagonal Cartan scaling, pulled back through the eigen-coordinate + change, is the (complexified) Cartan rotation substitution. -/ +lemma bind₁_diagCartan_cplxEigen (u : unitary ℂ) (k : Fin 6) : + bind₁ (diagCartan u) (cplxEigen k) + = bind₁ cplxEigen (map (algebraMap ℝ ℂ) (rotSubst u k)) := by + apply MvPolynomial.funext + intro x + fin_cases k <;> + simp only [cplxEigen, diagCartan, rotSubst, Matrix.cons_val, Fin.isValue, + map_add, map_sub, map_mul, MvPolynomial.bind₁_X_right, + MvPolynomial.bind₁_C_right, MvPolynomial.map_C, MvPolynomial.map_X, MvPolynomial.algebraMap_eq, + MvPolynomial.eval_X, MvPolynomial.eval_C] <;> + (apply Complex.ext <;> + simp [Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, + Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, + Complex.star_def, Complex.conj_re, Complex.conj_im] <;> ring) + +open MvPolynomial in +/-- Conjugation identity for the residual `U(1)`. -/ +lemma bind₁_diagRes_cplxEigen (c : unitary ℂ) (k : Fin 6) : + bind₁ (diagRes c) (cplxEigen k) + = bind₁ cplxEigen (map (algebraMap ℝ ℂ) (resSubst c k)) := by + apply MvPolynomial.funext + intro x + simp only [diagRes, resSubst] + generalize (c : ℂ) ^ 6 = μ + fin_cases k <;> + simp only [cplxEigen, Matrix.cons_val, Fin.isValue, + map_add, map_sub, map_mul, MvPolynomial.bind₁_X_right, + MvPolynomial.bind₁_C_right, MvPolynomial.map_C, MvPolynomial.map_X, MvPolynomial.algebraMap_eq, + MvPolynomial.eval_X, MvPolynomial.eval_C] <;> + (apply Complex.ext <;> + simp [Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, + Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, + Complex.star_def, Complex.conj_re, Complex.conj_im] <;> ring) + +/-- The Cartan hypercharges of `z, z̄, w₀, w̄₀, w₁, w̄₁`. -/ +def chargeA : Fin 6 → ℤ := ![1, -1, 1, -1, -1, 1] + +/-- The residual-`U(1)` hypercharges (only the perpendicular pair is charged). -/ +def chargeB : Fin 6 → ℤ := ![0, 0, 0, 0, 1, -1] + +open MvPolynomial in +/-- The slice potential, complexified and written in hypercharge eigen-coordinates. -/ +noncomputable def Qslice (P : MvPolynomial (Fin 6) ℝ) : MvPolynomial (Fin 6) ℂ := + bind₁ cplxEigen (map (algebraMap ℝ ℂ) P) + +open MvPolynomial in +/-- The Cartan diagonal in the charge form consumed by the charge-balancing engine. -/ +lemma diagCartan_eq (u : unitary ℂ) : + diagCartan u = fun i => C ((u : ℂ) ^ (chargeA i)) * X i := by + have hinv : star (u : ℂ) = (u : ℂ) ^ (-1 : ℤ) := by + rw [zpow_neg_one]; exact (inv_eq_of_mul_eq_one_right u.2.2).symm + funext i + fin_cases i <;> simp [diagCartan, chargeA, hinv] + +open MvPolynomial in +/-- The residual diagonal in the charge form consumed by the engine. -/ +lemma diagRes_eq (c : unitary ℂ) : + diagRes c = fun i => C (((c : ℂ) ^ 6) ^ (chargeB i)) * X i := by + have hinv : star ((c : ℂ) ^ 6) = ((c : ℂ) ^ 6) ^ (-1 : ℤ) := by + rw [zpow_neg_one] + refine (inv_eq_of_mul_eq_one_right ?_).symm + rw [star_pow, ← mul_pow, c.2.2, one_pow] + funext i + fin_cases i <;> simp [diagRes, chargeB, hinv] + +open MvPolynomial in +/-- In eigen-coordinates, the Cartan hypercharge acts by the diagonal scaling, and the slice + potential is invariant under it. -/ +lemma bind₁_diagCartan_Qslice {V : EffectivePotential} (hI : IsInvariant V) + {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (u : unitary ℂ) : + bind₁ (diagCartan u) (Qslice P) = Qslice P := by + simp only [Qslice] + rw [bind₁_bind₁] + simp only [bind₁_diagCartan_cplxEigen] + rw [← bind₁_bind₁, ← map_bind₁] + congr 2 + exact aeval_rotSubst_eq hI hP u + +open MvPolynomial in +/-- Likewise for the residual `U(1)`. -/ +lemma bind₁_diagRes_Qslice {V : EffectivePotential} (hI : IsInvariant V) + {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (c : unitary ℂ) : + bind₁ (diagRes c) (Qslice P) = Qslice P := by + simp only [Qslice] + rw [bind₁_bind₁] + simp only [bind₁_diagRes_cplxEigen] + rw [← bind₁_bind₁, ← map_bind₁] + congr 2 + exact aeval_resSubst_eq hI hP c + +/-- There is a gauge phase of infinite order (`exp i`), needed to run charge balancing. -/ +lemma exists_infiniteOrder_unitary : + ∃ ω : unitary ℂ, ∀ n : ℤ, (ω : ℂ) ^ n = 1 → n = 0 := by + have key : star (Complex.exp Complex.I) * Complex.exp Complex.I = 1 := by + rw [Complex.star_def, ← Complex.exp_conj, Complex.conj_I, ← Complex.exp_add]; simp + have key2 : Complex.exp Complex.I * star (Complex.exp Complex.I) = 1 := by + rw [Complex.star_def, ← Complex.exp_conj, Complex.conj_I, ← Complex.exp_add]; simp + refine ⟨⟨Complex.exp Complex.I, key, key2⟩, fun n hn => ?_⟩ + simp only at hn + rw [← Complex.exp_int_mul, Complex.exp_eq_one_iff] at hn + obtain ⟨k, hk⟩ := hn + have hc : (n : ℂ) = (k : ℂ) * (2 * Real.pi) := by + have hI : (Complex.I) ≠ 0 := Complex.I_ne_zero + apply mul_right_cancel₀ hI + rw [hk]; ring + have hr : (n : ℝ) = (k : ℝ) * (2 * Real.pi) := by exact_mod_cast hc + rcases eq_or_ne k 0 with hk0 | hk0 + · simp [hk0] at hr; exact_mod_cast hr + · exfalso + have h2k : (2 * (k : ℝ)) ≠ 0 := by + simp only [mul_ne_zero_iff]; exact ⟨two_ne_zero, by exact_mod_cast hk0⟩ + have hpi : Real.pi = (n : ℝ) / (2 * (k : ℝ)) := by rw [eq_div_iff h2k, hr]; ring + exact irrational_pi.ne_rat ((n : ℚ) / (2 * (k : ℚ))) (by rw [hpi]; push_cast; ring) + +open MvPolynomial in +/-- **Hypercharge balancing.** Every monomial of the slice potential `Qslice P` (in eigen- + coordinates) that carries nonzero Cartan or residual hypercharge has vanishing coefficient. -/ +lemma coeff_Qslice_eq_zero {V : EffectivePotential} (hI : IsInvariant V) + {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (m : Fin 6 →₀ ℕ) + (hm : (∑ i ∈ m.support, (m i : ℤ) * chargeA i ≠ 0) ∨ + (∑ i ∈ m.support, (m i : ℤ) * chargeB i ≠ 0)) : + coeff m (Qslice P) = 0 := by + obtain ⟨ω, hω⟩ := exists_infiniteOrder_unitary + have hω0 : (ω : ℂ) ≠ 0 := by intro h; have := ω.2.1; rw [h] at this; simp at this + rcases hm with hmA | hmB + · refine coeff_eq_zero_of_charge_ne_zero chargeA (ω : ℂ) hω0 hω ?_ hmA + have h := bind₁_diagCartan_Qslice hI hP ω + rwa [diagCartan_eq] at h + · have hω6 : ((ω : ℂ) ^ 6) ≠ 0 := pow_ne_zero 6 hω0 + have hroot6 : ∀ n : ℤ, ((ω : ℂ) ^ 6) ^ n = 1 → n = 0 := by + intro n hn + rw [← zpow_natCast (ω : ℂ) 6, ← zpow_mul] at hn + have := hω _ hn; omega + refine coeff_eq_zero_of_charge_ne_zero chargeB ((ω : ℂ) ^ 6) hω6 hroot6 ?_ hmB + have h := bind₁_diagRes_Qslice hI hP ω + rwa [diagRes_eq] at h + /-! ## C. Reduction to the polynomial family of orbit representatives From 9a4b275f1c75396537febcf85f1dc0f1014815af Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 13:52:54 +0100 Subject: [PATCH 12/25] feat: Next pass Co-Authored-By: Claude --- PhyslibAlpha/2HDM/EffectivePotential.lean | 242 ++++++++++++++++++++++ 1 file changed, 242 insertions(+) diff --git a/PhyslibAlpha/2HDM/EffectivePotential.lean b/PhyslibAlpha/2HDM/EffectivePotential.lean index fc59871da..f4a3b756c 100644 --- a/PhyslibAlpha/2HDM/EffectivePotential.lean +++ b/PhyslibAlpha/2HDM/EffectivePotential.lean @@ -9,6 +9,7 @@ public import Physlib.Particles.BeyondTheStandardModel.TwoHDM.GramMatrix public import Mathlib.RingTheory.MvPolynomial.Homogeneous public import Mathlib.Algebra.MvPolynomial.Funext public import Mathlib.Algebra.MvPolynomial.Monad +public import Mathlib.RingTheory.MvPolynomial.Tower public import Mathlib.Analysis.Real.Pi.Irrational public import PhyslibAlpha.«2HDM».Determinant public import PhyslibAlpha.«2HDM».OrbitRepresentative @@ -318,6 +319,247 @@ lemma coeff_Qslice_eq_zero {V : EffectivePotential} (hI : IsInvariant V) /-! +## C'. Generation of neutral monomials by the bilinears + +The hypercharge-neutral monomials of `Qslice P` are exactly the products of the five neutral +quadratic bilinears `z z̄, w₀ w̄₀, z w̄₀, z̄ w₀, w₁ w̄₁`. This is the (abelian) generation step: +combined Cartan- and residual-neutrality of a monomial forces it to be a product of these five, +because every charged variable carries a unit Cartan charge and the residual charges come in an +exact `±1` pair. + +-/ + +open MvPolynomial in +/-- The five hypercharge-neutral quadratic bilinears in eigen-coordinates: + `z z̄`, `w₀ w̄₀`, `z w̄₀`, `z̄ w₀`, `w₁ w̄₁`. -/ +noncomputable def bilin : Fin 5 → MvPolynomial (Fin 6) ℂ := + ![X 0 * X 1, X 2 * X 3, X 0 * X 3, X 1 * X 2, X 4 * X 5] + +/-- The charge of a monomial, summed over the whole index set, equals the sum over its support. -/ +lemma charge_univ_eq_support (w : Fin 6 → ℤ) (m : Fin 6 →₀ ℕ) : + ∑ i, (m i : ℤ) * w i = ∑ i ∈ m.support, (m i : ℤ) * w i := by + symm + apply Finset.sum_subset (Finset.subset_univ _) + intro i _ hi + rw [Finsupp.notMem_support_iff.mp hi]; simp + +/-- A charge sum is additive in the monomial. -/ +lemma chargeSum_add (w : Fin 6 → ℤ) (a b : Fin 6 →₀ ℕ) : + ∑ k, ((a + b) k : ℤ) * w k = (∑ k, (a k : ℤ) * w k) + ∑ k, (b k : ℤ) * w k := by + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro k _ + rw [Finsupp.add_apply]; push_cast; ring + +/-- The charge sum of a single generator is the charge of that variable. -/ +lemma chargeSum_single (w : Fin 6 → ℤ) (i : Fin 6) : + ∑ k, ((Finsupp.single i (1 : ℕ)) k : ℤ) * w k = w i := by + simp [Finsupp.single_apply, ite_mul, Finset.sum_ite_eq] + +open MvPolynomial in +/-- **Generation.** Every hypercharge-neutral monomial is a product of the five bilinears. -/ +lemma monomial_mem_adjoin_bilin (m : Fin 6 →₀ ℕ) + (hA : ∑ i, (m i : ℤ) * chargeA i = 0) (hB : ∑ i, (m i : ℤ) * chargeB i = 0) : + monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range bilin) := by + suffices H : ∀ n : ℕ, ∀ m : Fin 6 →₀ ℕ, (∑ i, m i) = n → + (∑ i, (m i : ℤ) * chargeA i = 0) → (∑ i, (m i : ℤ) * chargeB i = 0) → + monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range bilin) by + exact H (∑ i, m i) m rfl hA hB + intro n + induction n using Nat.strong_induction_on with + | _ n ih => + intro m hsum hA hB + -- The reduction step: pair up two variables whose bilinear is a generator. + have reduce : ∀ i j : Fin 6, i ≠ j → m i ≠ 0 → m j ≠ 0 → + X i * X j ∈ Algebra.adjoin ℂ (Set.range bilin) → + chargeA i + chargeA j = 0 → chargeB i + chargeB j = 0 → + monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range bilin) := by + intro i j hij hmi hmj hgen hcA hcB + have hle : Finsupp.single i 1 + Finsupp.single j 1 ≤ m := by + intro k + rw [Finsupp.add_apply, Finsupp.single_apply, Finsupp.single_apply] + by_cases h1 : i = k + · by_cases h2 : j = k + · exact absurd (h1.trans h2.symm) hij + · rw [if_pos h1, if_neg h2]; subst h1; simpa using Nat.one_le_iff_ne_zero.mpr hmi + · by_cases h2 : j = k + · rw [if_neg h1, if_pos h2]; subst h2; simpa using Nat.one_le_iff_ne_zero.mpr hmj + · rw [if_neg h1, if_neg h2]; simp + set m' := m - (Finsupp.single i 1 + Finsupp.single j 1) with hm'def + have hdecomp : m = (Finsupp.single i 1 + Finsupp.single j 1) + m' := by + rw [hm'def, add_tsub_cancel_of_le hle] + -- m' is still neutral + have hA' : ∑ k, (m' k : ℤ) * chargeA k = 0 := by + have h := hA + rw [hdecomp, chargeSum_add, chargeSum_add, chargeSum_single, chargeSum_single] at h + omega + have hB' : ∑ k, (m' k : ℤ) * chargeB k = 0 := by + have h := hB + rw [hdecomp, chargeSum_add, chargeSum_add, chargeSum_single, chargeSum_single] at h + omega + -- the degree drops by 2 + have hsum' : ∑ k, m' k < n := by + have e : (∑ k, m k) = (∑ k, (Finsupp.single i 1) k) + (∑ k, (Finsupp.single j 1) k) + + ∑ k, m' k := by + rw [← Finset.sum_add_distrib, ← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro k _ + rw [← Finsupp.add_apply, ← Finsupp.add_apply, ← hdecomp] + have e1 : ∑ k, (Finsupp.single i 1) k = 1 := by + simp [Finsupp.single_apply, Finset.sum_ite_eq] + have e2 : ∑ k, (Finsupp.single j 1) k = 1 := by + simp [Finsupp.single_apply, Finset.sum_ite_eq] + rw [hsum, e1, e2] at e + omega + -- factor and recurse + have hfact : monomial m (1 : ℂ) = (X i * X j) * monomial m' 1 := by + rw [hdecomp, + show (X i : MvPolynomial (Fin 6) ℂ) = monomial (Finsupp.single i 1) 1 from + by rw [← X_pow_eq_monomial, pow_one], + show (X j : MvPolynomial (Fin 6) ℂ) = monomial (Finsupp.single j 1) 1 from + by rw [← X_pow_eq_monomial, pow_one], + monomial_mul, monomial_mul, one_mul, one_mul, add_assoc] + rw [hfact] + exact Subalgebra.mul_mem _ hgen (ih (∑ k, m' k) hsum' m' rfl hA' hB') + -- main case split + rcases eq_or_ne n 0 with hn0 | hn0 + · -- degree zero: m = 0, monomial is 1 + have hm0 : m = 0 := by + ext k + have hk : m k ≤ ∑ i, m i := Finset.single_le_sum (fun _ _ => Nat.zero_le _) (Finset.mem_univ k) + rw [hsum, hn0] at hk + simpa using Nat.le_zero.mp hk + rw [hm0] + have h1 : monomial (0 : Fin 6 →₀ ℕ) (1 : ℂ) = 1 := by simp + rw [h1]; exact Subalgebra.one_mem _ + · -- positive degree: find a neutral pair + rcases eq_or_ne (m 4) 0 with h4 | h4 + · -- m 4 = 0; then m 5 = 0 by residual neutrality + have h5 : m 5 = 0 := by + have h := hB + simp [chargeB, Fin.sum_univ_six] at h + omega + -- Cartan neutrality on {0,1,2,3}: m0 + m2 = m1 + m3 + have hcart : (m 0 : ℤ) + (m 2 : ℤ) = (m 1 : ℤ) + (m 3 : ℤ) := by + have h := hA + simp [chargeA, Fin.sum_univ_six] at h + omega + -- total degree on {0,1,2,3} is n > 0 + have hposL : 0 < m 0 + m 2 := by + rcases Nat.eq_zero_or_pos (m 0 + m 2) with hc | hc + · exfalso + have h02 : m 0 = 0 ∧ m 2 = 0 := by omega + have h13 : m 1 = 0 ∧ m 3 = 0 := by omega + have hz : ∑ i, m i = 0 := by + simp [Fin.sum_univ_six, h02.1, h02.2, h13.1, h13.2, h4, h5] + rw [hsum] at hz; exact hn0 hz + · exact hc + have hposR : 0 < m 1 + m 3 := by omega + -- choose a positive index in {0,2} and one in {1,3} + rcases Nat.eq_zero_or_pos (m 0) with hm0 | hm0 + · -- m 0 = 0, so m 2 > 0 + have hm2 : m 2 ≠ 0 := by omega + rcases Nat.eq_zero_or_pos (m 1) with hm1 | hm1 + · -- m 1 = 0, so m 3 > 0 : pair (2,3) -> bilin 1 + have hm3 : m 3 ≠ 0 := by omega + refine reduce 2 3 (by decide) hm2 hm3 ?_ (by decide) (by decide) + exact Algebra.subset_adjoin ⟨1, rfl⟩ + · -- m 1 > 0 : pair (1,2) -> bilin 3 + refine reduce 1 2 (by decide) (by omega) hm2 ?_ (by decide) (by decide) + exact Algebra.subset_adjoin ⟨3, rfl⟩ + · -- m 0 > 0 + rcases Nat.eq_zero_or_pos (m 1) with hm1 | hm1 + · -- m 1 = 0, so m 3 > 0 : pair (0,3) -> bilin 2 + have hm3 : m 3 ≠ 0 := by omega + refine reduce 0 3 (by decide) (by omega) hm3 ?_ (by decide) (by decide) + exact Algebra.subset_adjoin ⟨2, rfl⟩ + · -- m 1 > 0 : pair (0,1) -> bilin 0 + refine reduce 0 1 (by decide) (by omega) (by omega) ?_ (by decide) (by decide) + exact Algebra.subset_adjoin ⟨0, rfl⟩ + · -- m 4 > 0; then m 5 > 0 : pair (4,5) -> bilin 4 + have h5 : m 5 ≠ 0 := by + have h := hB + simp [chargeB, Fin.sum_univ_six] at h + omega + refine reduce 4 5 (by decide) h4 h5 ?_ (by decide) (by decide) + exact Algebra.subset_adjoin ⟨4, rfl⟩ + +open MvPolynomial in +/-- The slice potential lies in the subalgebra generated by the five bilinears: every monomial that + survives is hypercharge-neutral, hence a product of the bilinears. -/ +lemma Qslice_mem_adjoin_bilin {V : EffectivePotential} (hI : IsInvariant V) + {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) : + Qslice P ∈ Algebra.adjoin ℂ (Set.range bilin) := by + rw [(Qslice P).as_sum] + apply Subalgebra.sum_mem + intro m hm + have hcoeff : coeff m (Qslice P) ≠ 0 := MvPolynomial.mem_support_iff.mp hm + have hsuppA : ∑ i ∈ m.support, (m i : ℤ) * chargeA i = 0 := by + by_contra h0 + exact hcoeff (coeff_Qslice_eq_zero hI hP m (Or.inl h0)) + have hsuppB : ∑ i ∈ m.support, (m i : ℤ) * chargeB i = 0 := by + by_contra h0 + exact hcoeff (coeff_Qslice_eq_zero hI hP m (Or.inr h0)) + have hmono : monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range bilin) := + monomial_mem_adjoin_bilin m + ((charge_univ_eq_support chargeA m).trans hsuppA) + ((charge_univ_eq_support chargeB m).trans hsuppB) + have hrw : monomial m (coeff m (Qslice P)) = C (coeff m (Qslice P)) * monomial m 1 := by + rw [C_mul_monomial, mul_one] + rw [hrw] + exact Subalgebra.mul_mem _ + (by rw [← MvPolynomial.algebraMap_eq]; exact Subalgebra.algebraMap_mem _ _) hmono + +open MvPolynomial in +/-- Consequently the complexified slice potential is `aeval bilin G` for some polynomial `G` in the + five bilinears. -/ +lemma exists_aeval_bilin {V : EffectivePotential} (hI : IsInvariant V) + {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) : + ∃ G : MvPolynomial (Fin 5) ℂ, aeval bilin G = Qslice P := by + have h := Qslice_mem_adjoin_bilin hI hP + rw [Algebra.adjoin_range_eq_range_aeval ℂ bilin] at h + obtain ⟨G, hG⟩ := h + exact ⟨G, hG⟩ + +/-! ### Evaluating at the eigen-point of a representative -/ + +/-- The slice parameters realising `repHiggs X` as a point of the slice family. -/ +def aRep (X : Fin 4 → ℝ) : Fin 6 → ℝ := ![X 0, 0, X 1, X 2, X 3, 0] + +lemma repHiggs_eq_sliceR (X : Fin 4 → ℝ) : repHiggs X = sliceR (aRep X) := by + rw [repHiggs_eq_sliceHiggs, sliceR_apply] + simp [aRep] + +/-- The hypercharge eigen-point `(z, z̄, w₀, w̄₀, w₁, w̄₁)` of `repHiggs X`: here `z = X₀` is real, + `w₀ = X₁ + i X₂` and `w₁ = X₃` is real. -/ +noncomputable def eigenPt (X : Fin 4 → ℝ) : Fin 6 → ℂ := + ![(X 0 : ℂ), (X 0 : ℂ), (X 1 : ℂ) + Complex.I * (X 2 : ℂ), (X 1 : ℂ) - Complex.I * (X 2 : ℂ), + (X 3 : ℂ), (X 3 : ℂ)] + +open MvPolynomial in +/-- The eigen-coordinate change sends the eigen-point of `repHiggs X` back to its slice parameters. -/ +lemma aeval_cplxEigen_eigenPt (X : Fin 4 → ℝ) (k : Fin 6) : + aeval (eigenPt X) (cplxEigen k) = algebraMap ℝ ℂ (aRep X k) := by + fin_cases k <;> + simp only [cplxEigen, eigenPt, aRep, Matrix.cons_val, Fin.isValue, map_add, map_sub, map_mul, + aeval_X, aeval_C, MvPolynomial.algebraMap_eq] <;> + (apply Complex.ext <;> + simp [Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, + Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im] <;> ring) + +open MvPolynomial in +/-- The complexified slice potential, evaluated at the eigen-point of `repHiggs X`, returns the real + value `V (repHiggs X)`. -/ +lemma eval_Qslice_eigenPt (P : MvPolynomial (Fin 6) ℝ) (X : Fin 4 → ℝ) : + eval (eigenPt X) (Qslice P) = algebraMap ℝ ℂ (P.eval (aRep X)) := by + rw [Qslice, ← aeval_eq_eval, aeval_bind₁, + show (fun i => aeval (eigenPt X) (cplxEigen i)) = (fun i => (Algebra.ofId ℝ ℂ) (aRep X i)) from + funext (fun i => (aeval_cplxEigen_eigenPt X i).trans (Algebra.ofId_apply ℂ (aRep X i)).symm), + MvPolynomial.aeval_map_algebraMap ℂ, ← MvPolynomial.comp_aeval] + simp [aeval_eq_eval, Algebra.ofId_apply] + +/-! + ## C. Reduction to the polynomial family of orbit representatives The two structural ingredients of the proof live elsewhere: From 225b122e0cec8955f4ce5f61c04060caeed6fec9 Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 14:36:48 +0100 Subject: [PATCH 13/25] refactor: Next round Co-Authored-By: Claude --- PhyslibAlpha/2HDM/EffectivePotential.lean | 91 +++++++++++++++++++++++ 1 file changed, 91 insertions(+) diff --git a/PhyslibAlpha/2HDM/EffectivePotential.lean b/PhyslibAlpha/2HDM/EffectivePotential.lean index f4a3b756c..15b2bb9bc 100644 --- a/PhyslibAlpha/2HDM/EffectivePotential.lean +++ b/PhyslibAlpha/2HDM/EffectivePotential.lean @@ -558,6 +558,97 @@ lemma eval_Qslice_eigenPt (P : MvPolynomial (Fin 6) ℝ) (X : Fin 4 → ℝ) : MvPolynomial.aeval_map_algebraMap ℂ, ← MvPolynomial.comp_aeval] simp [aeval_eq_eval, Algebra.ofId_apply] +/-! ### Real-part descent: from a complex value back to a real polynomial -/ + +open MvPolynomial in +/-- The real part of a complex polynomial, taken coefficient-wise. -/ +noncomputable def realPart (H : MvPolynomial (Fin 5) ℂ) : MvPolynomial (Fin 5) ℝ := + Finsupp.mapRange Complex.re Complex.zero_re H + +open MvPolynomial in +@[simp] lemma realPart_coeff (H : MvPolynomial (Fin 5) ℂ) (m : Fin 5 →₀ ℕ) : + coeff m (realPart H) = (coeff m H).re := Finsupp.mapRange_apply + +open MvPolynomial in +lemma realPart_C (a : ℂ) : realPart (C a) = C a.re := by + ext m; rw [realPart_coeff, coeff_C, coeff_C]; split_ifs <;> simp + +open MvPolynomial in +lemma realPart_add (p q : MvPolynomial (Fin 5) ℂ) : + realPart (p + q) = realPart p + realPart q := by + ext m; simp [Complex.add_re] + +open MvPolynomial in +lemma realPart_mul_X (p : MvPolynomial (Fin 5) ℂ) (i : Fin 5) : + realPart (p * X i) = realPart p * X i := by + ext m + rw [realPart_coeff, coeff_mul_X', coeff_mul_X', realPart_coeff] + split_ifs <;> simp + +open MvPolynomial in +/-- Evaluating a complex polynomial at a real point and taking the real part is the same as + evaluating its real part. -/ +lemma realPart_eval (H : MvPolynomial (Fin 5) ℂ) (y : Fin 5 → ℝ) : + (eval (fun j => (↑(y j) : ℂ)) H).re = (realPart H).eval y := by + induction H using MvPolynomial.induction_on with + | C a => rw [realPart_C]; simp + | add p q hp hq => rw [realPart_add, map_add, map_add, Complex.add_re, hp, hq] + | mul_X p i hp => + rw [realPart_mul_X, map_mul, map_mul, eval_X, eval_X, Complex.mul_re, Complex.ofReal_re, + Complex.ofReal_im, mul_zero, sub_zero, hp] + +/-! ### Condition A: the value is a polynomial in the five bilinear generators -/ + +/-- The five real bilinear generators of `T'`, evaluated at `repHiggs X`: + `‖Φ1‖², Re⟪⟫, Im⟪⟫, |Φ2₀|², |Φ2₁|²`. -/ +def realGen (X : Fin 4 → ℝ) : Fin 5 → ℝ := + ![X 0 ^ 2, X 0 * X 1, X 0 * X 2, X 1 ^ 2 + X 2 ^ 2, X 3 ^ 2] + +open MvPolynomial in +/-- The complex substitution expressing each bilinear, at the eigen-point, through the real + generators (the off-diagonal pair `z w̄₀, z̄ w₀` mix `Re⟪⟫` and `Im⟪⟫`). -/ +noncomputable def transf : Fin 5 → MvPolynomial (Fin 5) ℂ := + ![X 0, X 3, X 1 - C Complex.I * X 2, X 1 + C Complex.I * X 2, X 4] + +open MvPolynomial in +/-- The bilinears at the eigen-point of `repHiggs X` are the real generators, read through `transf`. -/ +lemma bilin_eval_eigenPt (X : Fin 4 → ℝ) (i : Fin 5) : + eval (eigenPt X) (bilin i) = eval (fun j => (↑(realGen X j) : ℂ)) (transf i) := by + fin_cases i <;> + simp only [bilin, transf, eigenPt, realGen, Matrix.cons_val, Fin.isValue, map_mul, map_sub, + map_add, eval_X, eval_C] <;> + (apply Complex.ext <;> + simp [pow_two, Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, + Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im] <;> ring) + +open MvPolynomial in +/-- Pushing an evaluation through an `aeval` substitution. -/ +lemma eval_aeval_comp {κ ι : Type*} (x : ι → ℂ) (f : κ → MvPolynomial ι ℂ) + (G : MvPolynomial κ ℂ) : + eval x (aeval f G) = eval (fun i => eval x (f i)) G := by + rw [show (aeval f) G = bind₁ f G from rfl, ← aeval_eq_eval x, aeval_bind₁] + simp [aeval_eq_eval] + +open MvPolynomial in +/-- **Condition A.** A gauge-invariant polynomial potential, on the representative family, is a + polynomial in the five real bilinear generators `‖Φ1‖², Re⟪⟫, Im⟪⟫, |Φ2₀|², |Φ2₁|²`. -/ +lemma exists_polynomial_repHiggs_realGen {V : EffectivePotential} {n : ℕ} + (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : + ∃ p : MvPolynomial (Fin 5) ℝ, ∀ X : Fin 4 → ℝ, V (repHiggs X) = p.eval (realGen X) := by + obtain ⟨P, hP⟩ := h.exists_comp_linear_poly sliceR + obtain ⟨G, hG⟩ := exists_aeval_bilin hI hP + refine ⟨realPart (aeval transf G), fun X => ?_⟩ + have hval : (algebraMap ℝ ℂ) (V (repHiggs X)) + = eval (fun j => (↑(realGen X j) : ℂ)) (aeval transf G) := by + rw [repHiggs_eq_sliceR, hP, ← eval_Qslice_eigenPt, ← hG] + simp only [eval_aeval_comp] + rw [show (fun i => eval (eigenPt X) (bilin i)) + = (fun i => eval (fun j => (↑(realGen X j) : ℂ)) (transf i)) from + funext (bilin_eval_eigenPt X)] + have hre : V (repHiggs X) = (eval (fun j => (↑(realGen X j) : ℂ)) (aeval transf G)).re := by + rw [← hval]; simp + rw [hre, realPart_eval] + /-! ## C. Reduction to the polynomial family of orbit representatives From 24ebca2e02e2bb6502b47d65a0ab00c5a66b3fb7 Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 15:06:04 +0100 Subject: [PATCH 14/25] feat: Next build Co-Authored-By: Claude --- PhyslibAlpha/2HDM/FullSpace.lean | 64 ++++++++++++++++++++++++++++++++ 1 file changed, 64 insertions(+) create mode 100644 PhyslibAlpha/2HDM/FullSpace.lean diff --git a/PhyslibAlpha/2HDM/FullSpace.lean b/PhyslibAlpha/2HDM/FullSpace.lean new file mode 100644 index 000000000..0bb4b0e1e --- /dev/null +++ b/PhyslibAlpha/2HDM/FullSpace.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +module + +public import PhyslibAlpha.«2HDM».EffectivePotential +/-! +# The full configuration space of the two Higgs doublet model + +The orbit-representative slice `repHiggs` captures the *abelian* (gauge-torus) content of the first +fundamental theorem (`Condition A`: the value is a polynomial in the five bilinears `‖Φ1‖²`, +`Re⟪⟫`, `Im⟪⟫`, `|Φ2₀|²`, `|Φ2₁|²`). It cannot, however, capture the non-abelian content: only the +diagonal torus preserves the slice `{Φ1₁ = 0}`, so the slice value polynomial is blind to the +component-mixing `SU(2)` rotations needed to fuse `|Φ2₀|²` and `|Φ2₁|²` into `‖Φ2‖²`. + +To access that content we parametrise the *entire* eight–real–dimensional configuration space and +work with the two gauge tori (the standard diagonal one and a component-mixing one); their combined +invariance is the genuine `SU(2)` first fundamental theorem. +-/ + +@[expose] public section + +noncomputable section + +namespace TwoHiggsDoublet + +open InnerProductSpace +open StandardModel +open scoped ComplexConjugate + +/-- The full configuration space as a real-linear map of the eight real field components + `(Re Φ1₀, Im Φ1₀, Re Φ1₁, Im Φ1₁, Re Φ2₀, Im Φ2₀, Re Φ2₁, Im Φ2₁)`. -/ +def fullR : (Fin 8 → ℝ) →ₗ[ℝ] TwoHiggsDoublet where + toFun a := + { Φ1 := !₂[(a 0 : ℂ) + Complex.I * (a 1 : ℂ), (a 2 : ℂ) + Complex.I * (a 3 : ℂ)] + Φ2 := !₂[(a 4 : ℂ) + Complex.I * (a 5 : ℂ), (a 6 : ℂ) + Complex.I * (a 7 : ℂ)] } + map_add' a b := by + apply ext_of_fst_snd + · ext i; fin_cases i <;> simp <;> ring + · ext i; fin_cases i <;> simp <;> ring + map_smul' c a := by + apply ext_of_fst_snd + · ext i; fin_cases i <;> simp [Complex.real_smul] <;> ring + · ext i; fin_cases i <;> simp [Complex.real_smul] <;> ring + +@[simp] lemma fullR_Φ1 (a : Fin 8 → ℝ) : + (fullR a).Φ1 = !₂[(a 0 : ℂ) + Complex.I * (a 1 : ℂ), (a 2 : ℂ) + Complex.I * (a 3 : ℂ)] := rfl + +@[simp] lemma fullR_Φ2 (a : Fin 8 → ℝ) : + (fullR a).Φ2 = !₂[(a 4 : ℂ) + Complex.I * (a 5 : ℂ), (a 6 : ℂ) + Complex.I * (a 7 : ℂ)] := rfl + +/-- Every configuration is `fullR` of its eight real components. -/ +lemma exists_fullR (φ : TwoHiggsDoublet) : ∃ a : Fin 8 → ℝ, fullR a = φ := by + refine ⟨![(φ.Φ1 0).re, (φ.Φ1 0).im, (φ.Φ1 1).re, (φ.Φ1 1).im, + (φ.Φ2 0).re, (φ.Φ2 0).im, (φ.Φ2 1).re, (φ.Φ2 1).im], ?_⟩ + apply ext_of_fst_snd + · ext i; fin_cases i <;> + simp [Matrix.cons_val_zero, Matrix.cons_val_one, mul_comm Complex.I, Complex.re_add_im] + · ext i; fin_cases i <;> + simp [Matrix.cons_val_zero, Matrix.cons_val_one, mul_comm Complex.I, Complex.re_add_im] + +end TwoHiggsDoublet From 456ba58bc9158b9515ddb1e3f74c00eb4d0e0cab Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 15:20:15 +0100 Subject: [PATCH 15/25] feat: Next batch Co-Authored-By: Claude --- PhyslibAlpha/2HDM/FullSpace.lean | 61 ++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/PhyslibAlpha/2HDM/FullSpace.lean b/PhyslibAlpha/2HDM/FullSpace.lean index 0bb4b0e1e..af1288f84 100644 --- a/PhyslibAlpha/2HDM/FullSpace.lean +++ b/PhyslibAlpha/2HDM/FullSpace.lean @@ -61,4 +61,65 @@ lemma exists_fullR (φ : TwoHiggsDoublet) : ∃ a : Fin 8 → ℝ, fullR a = φ · ext i; fin_cases i <;> simp [Matrix.cons_val_zero, Matrix.cons_val_one, mul_comm Complex.I, Complex.re_add_im] +/-! ### The standard diagonal gauge torus on the full space -/ + +open Complex in +/-- The Cartan phase `u = diag(a, ā)`, transported to a rotation of the eight real parameters: it + phases the *first*-component pairs `(0,1),(4,5)` by `a` and the *second*-component pairs + `(2,3),(6,7)` by `ā`. -/ +def cartanParam8 (u : unitary ℂ) (a : Fin 8 → ℝ) : Fin 8 → ℝ := + ![((u : ℂ) * (↑(a 0) + I * ↑(a 1))).re, ((u : ℂ) * (↑(a 0) + I * ↑(a 1))).im, + ((star u : ℂ) * (↑(a 2) + I * ↑(a 3))).re, ((star u : ℂ) * (↑(a 2) + I * ↑(a 3))).im, + ((u : ℂ) * (↑(a 4) + I * ↑(a 5))).re, ((u : ℂ) * (↑(a 4) + I * ↑(a 5))).im, + ((star u : ℂ) * (↑(a 6) + I * ↑(a 7))).re, ((star u : ℂ) * (↑(a 6) + I * ↑(a 7))).im] + +/-- Acting by the Cartan phase on a full configuration is the same as rotating its parameters. -/ +lemma gaugeCartan_smul_fullR (u : unitary ℂ) (a : Fin 8 → ℝ) : + GaugeGroupI.gaugeCartan u • fullR a = fullR (cartanParam8 u a) := by + apply ext_of_fst_snd + · rw [gaugeGroupI_smul_fst, GaugeGroupI.gaugeCartan_smul_eq, fullR_Φ1] + ext i + fin_cases i <;> + (apply Complex.ext <;> + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, cartanParam8, fullR, Complex.mul_re, + Complex.mul_im, Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, + Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, Complex.star_def, + Complex.conj_re, Complex.conj_im] <;> ring) + · rw [gaugeGroupI_smul_snd, GaugeGroupI.gaugeCartan_smul_eq, fullR_Φ2] + ext i + fin_cases i <;> + (apply Complex.ext <;> + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, cartanParam8, fullR, Complex.mul_re, + Complex.mul_im, Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, + Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, Complex.star_def, + Complex.conj_re, Complex.conj_im] <;> ring) + +open Complex in +/-- The residual `U(1)` phase `c`, transported to a rotation of the eight real parameters: it + phases the *second*-component pairs `(2,3),(6,7)` by `c⁶` and fixes the first-component pairs. -/ +def resParam8 (c : unitary ℂ) (a : Fin 8 → ℝ) : Fin 8 → ℝ := + ![a 0, a 1, ((c : ℂ) ^ 6 * (↑(a 2) + I * ↑(a 3) : ℂ)).re, + ((c : ℂ) ^ 6 * (↑(a 2) + I * ↑(a 3) : ℂ)).im, + a 4, a 5, ((c : ℂ) ^ 6 * (↑(a 6) + I * ↑(a 7) : ℂ)).re, + ((c : ℂ) ^ 6 * (↑(a 6) + I * ↑(a 7) : ℂ)).im] + +/-- Acting by the residual `U(1)` on a full configuration is the same as rotating its parameters. -/ +lemma ofU1Subgroup_smul_fullR (c : unitary ℂ) (a : Fin 8 → ℝ) : + GaugeGroupI.ofU1Subgroup c • fullR a = fullR (resParam8 c a) := by + apply ext_of_fst_snd + · rw [gaugeGroupI_smul_fst, HiggsVec.ofU1Subgroup_smul_eq_smul, fullR_Φ1] + ext i + fin_cases i <;> + (apply Complex.ext <;> + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, resParam8, fullR, Complex.mul_re, + Complex.mul_im, Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, + Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im]) + · rw [gaugeGroupI_smul_snd, HiggsVec.ofU1Subgroup_smul_eq_smul, fullR_Φ2] + ext i + fin_cases i <;> + (apply Complex.ext <;> + simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, resParam8, fullR, Complex.mul_re, + Complex.mul_im, Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, + Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im]) + end TwoHiggsDoublet From dcf63f56592d5747852026c80c323eed397ea19b Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 15:48:49 +0100 Subject: [PATCH 16/25] feat: next batch Co-Authored-By: Claude --- PhyslibAlpha/2HDM/EffectivePotential.lean | 110 +++++++++++++++++++++- 1 file changed, 108 insertions(+), 2 deletions(-) diff --git a/PhyslibAlpha/2HDM/EffectivePotential.lean b/PhyslibAlpha/2HDM/EffectivePotential.lean index 15b2bb9bc..8027b36a0 100644 --- a/PhyslibAlpha/2HDM/EffectivePotential.lean +++ b/PhyslibAlpha/2HDM/EffectivePotential.lean @@ -623,8 +623,8 @@ lemma bilin_eval_eigenPt (X : Fin 4 → ℝ) (i : Fin 5) : open MvPolynomial in /-- Pushing an evaluation through an `aeval` substitution. -/ -lemma eval_aeval_comp {κ ι : Type*} (x : ι → ℂ) (f : κ → MvPolynomial ι ℂ) - (G : MvPolynomial κ ℂ) : +lemma eval_aeval_comp {R : Type*} [CommRing R] {κ ι : Type*} (x : ι → R) + (f : κ → MvPolynomial ι R) (G : MvPolynomial κ R) : eval x (aeval f G) = eval (fun i => eval x (f i)) G := by rw [show (aeval f) G = bind₁ f G from rfl, ← aeval_eq_eval x, aeval_bind₁] simp [aeval_eq_eval] @@ -649,6 +649,112 @@ lemma exists_polynomial_repHiggs_realGen {V : EffectivePotential} {n : ℕ} rw [← hval]; simp rw [hre, realPart_eval] +/-! ### Clearing the `‖Φ1‖²` denominator: Condition A value times `‖Φ1‖²ᴺ` is a Gram polynomial -/ + +open MvPolynomial in +/-- The five bilinear generators, as polynomials in the four representative parameters. -/ +noncomputable def realGenP : Fin 5 → MvPolynomial (Fin 4) ℝ := + ![X 0 ^ 2, X 0 * X 1, X 0 * X 2, X 1 ^ 2 + X 2 ^ 2, X 3 ^ 2] + +open MvPolynomial in +/-- The four Gram components, as polynomials in the four representative parameters. -/ +noncomputable def gramP : Fin 1 ⊕ Fin 3 → MvPolynomial (Fin 4) ℝ := + Sum.elim (fun _ => X 0 ^ 2 + (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2)) + ![2 * (X 0 * X 1), 2 * (X 0 * X 2), X 0 ^ 2 - (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2)] + +open MvPolynomial in +@[simp] lemma realGenP_eval (X : Fin 4 → ℝ) (i : Fin 5) : (realGenP i).eval X = realGen X i := by + fin_cases i <;> simp [realGenP, realGen] + +open MvPolynomial in +@[simp] lemma gramP_eval (X : Fin 4 → ℝ) (μ : Fin 1 ⊕ Fin 3) : + (gramP μ).eval X = (repHiggs X).gramVector μ := by + match μ with + | Sum.inl 0 => simp [gramP] + | Sum.inr 0 => simp [gramP]; ring + | Sum.inr 1 => simp [gramP]; ring + | Sum.inr 2 => simp [gramP] + +open MvPolynomial in +/-- Some power of `‖Φ1‖² = X₀²` times the Condition-A value polynomial lies in the Gram + subalgebra: multiplying by `X₀²` pairs each `X₁²+X₂²` into `(X₀X₁)²+(X₀X₂)²` and each `X₃²` into + the determinant `X₀²X₃²`, both of which are Gram polynomials. -/ +lemma exists_clearing_mem (p : MvPolynomial (Fin 5) ℝ) : + ∃ N : ℕ, (X 0) ^ (2 * N) * aeval realGenP p ∈ Algebra.adjoin ℝ (Set.range gramP) := by + set S := Algebra.adjoin ℝ (Set.range gramP) with hS + have hgmem : ∀ μ, gramP μ ∈ S := fun μ => Algebra.subset_adjoin ⟨μ, rfl⟩ + have hC : ∀ r : ℝ, (C r : MvPolynomial (Fin 4) ℝ) ∈ S := fun r => by + rw [← MvPolynomial.algebraMap_eq]; exact Subalgebra.algebraMap_mem _ _ + have hX0sq : (X 0 ^ 2 : MvPolynomial (Fin 4) ℝ) ∈ S := by + have e : (X 0 ^ 2 : MvPolynomial (Fin 4) ℝ) + = C (1 / 2) * (gramP (Sum.inl 0) + gramP (Sum.inr 2)) := by + apply MvPolynomial.funext; intro x; simp [gramP]; ring + rw [e]; exact Subalgebra.mul_mem _ (hC _) (Subalgebra.add_mem _ (hgmem _) (hgmem _)) + have hX0X1 : (X 0 * X 1 : MvPolynomial (Fin 4) ℝ) ∈ S := by + have e : (X 0 * X 1 : MvPolynomial (Fin 4) ℝ) = C (1 / 2) * gramP (Sum.inr 0) := by + apply MvPolynomial.funext; intro x; simp [gramP] + rw [e]; exact Subalgebra.mul_mem _ (hC _) (hgmem _) + have hX0X2 : (X 0 * X 2 : MvPolynomial (Fin 4) ℝ) ∈ S := by + have e : (X 0 * X 2 : MvPolynomial (Fin 4) ℝ) = C (1 / 2) * gramP (Sum.inr 1) := by + apply MvPolynomial.funext; intro x; simp [gramP] + rw [e]; exact Subalgebra.mul_mem _ (hC _) (hgmem _) + have hmm : (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2 : MvPolynomial (Fin 4) ℝ) ∈ S := by + have e : (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2 : MvPolynomial (Fin 4) ℝ) + = C (1 / 2) * (gramP (Sum.inl 0) - gramP (Sum.inr 2)) := by + apply MvPolynomial.funext; intro x; simp [gramP]; ring + rw [e]; exact Subalgebra.mul_mem _ (hC _) (Subalgebra.sub_mem _ (hgmem _) (hgmem _)) + have her : (X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2) : MvPolynomial (Fin 4) ℝ) ∈ S := by + have e : (X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2) : MvPolynomial (Fin 4) ℝ) + = (X 0 * X 1) ^ 2 + (X 0 * X 2) ^ 2 := by ring + rw [e]; exact Subalgebra.add_mem _ (pow_mem hX0X1 2) (pow_mem hX0X2 2) + have hes : (X 0 ^ 2 * X 3 ^ 2 : MvPolynomial (Fin 4) ℝ) ∈ S := by + have e : (X 0 ^ 2 * X 3 ^ 2 : MvPolynomial (Fin 4) ℝ) + = X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2) - X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2) := by ring + rw [e]; exact Subalgebra.sub_mem _ (Subalgebra.mul_mem _ hX0sq hmm) her + induction p using MvPolynomial.induction_on' with + | monomial m c => + refine ⟨m 3 + m 4, ?_⟩ + have hmemRHS : C c * ((X 0 ^ 2) ^ m 0 * (X 0 * X 1) ^ m 1 * (X 0 * X 2) ^ m 2 * + (X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2)) ^ m 3 * (X 0 ^ 2 * X 3 ^ 2) ^ m 4) ∈ S := + Subalgebra.mul_mem _ (hC _) (Subalgebra.mul_mem _ (Subalgebra.mul_mem _ + (Subalgebra.mul_mem _ (Subalgebra.mul_mem _ (pow_mem hX0sq _) (pow_mem hX0X1 _)) + (pow_mem hX0X2 _)) (pow_mem her _)) (pow_mem hes _)) + rw [aeval_monomial, Finsupp.prod_fintype _ _ (fun i => by simp), Fin.prod_univ_five] + simp only [realGenP, Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val, Fin.isValue, + MvPolynomial.algebraMap_eq] + convert hmemRHS using 1 + rw [pow_mul, pow_add] + simp only [mul_pow] + ring + | add p q hp hq => + obtain ⟨Np, hp'⟩ := hp + obtain ⟨Nq, hq'⟩ := hq + refine ⟨max Np Nq, ?_⟩ + rw [map_add, mul_add] + apply Subalgebra.add_mem + · rw [show 2 * max Np Nq = 2 * (max Np Nq - Np) + 2 * Np from by omega, pow_add, mul_assoc] + exact Subalgebra.mul_mem _ (by rw [pow_mul]; exact pow_mem hX0sq _) hp' + · rw [show 2 * max Np Nq = 2 * (max Np Nq - Nq) + 2 * Nq from by omega, pow_add, mul_assoc] + exact Subalgebra.mul_mem _ (by rw [pow_mul]; exact pow_mem hX0sq _) hq' + +open MvPolynomial in +/-- **Denominator clearing.** For the Condition-A value polynomial `p`, some power of `‖Φ1‖² = X₀²` + times `p ∘ realGen` is a polynomial in the Gram vector. -/ +lemma exists_gram_clearing (p : MvPolynomial (Fin 5) ℝ) : + ∃ (A : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) (N : ℕ), ∀ X : Fin 4 → ℝ, + (X 0) ^ (2 * N) * p.eval (realGen X) = A.eval ((repHiggs X).gramVector) := by + obtain ⟨N, hmem⟩ := exists_clearing_mem p + rw [Algebra.adjoin_range_eq_range_aeval ℝ gramP] at hmem + obtain ⟨A, hA⟩ := hmem + change aeval gramP A = _ at hA + refine ⟨A, N, fun X => ?_⟩ + have hL : eval X (aeval gramP A) = A.eval ((repHiggs X).gramVector) := by + rw [eval_aeval_comp]; simp only [gramP_eval] + have hR : eval X (MvPolynomial.X 0 ^ (2 * N) * aeval realGenP p) + = (X 0) ^ (2 * N) * p.eval (realGen X) := by + rw [map_mul, map_pow, eval_X, eval_aeval_comp]; simp only [realGenP_eval] + rw [← hR, ← hL, hA] + /-! ## C. Reduction to the polynomial family of orbit representatives From 99526cbbbe59de9b5be3ba4b158f434cb5ae4ad3 Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Tue, 30 Jun 2026 16:12:25 +0100 Subject: [PATCH 17/25] feat: Next batch. Co-Authored-By: Claude --- PhyslibAlpha/2HDM/EffectivePotential.lean | 101 ++++++++++++++++++++++ 1 file changed, 101 insertions(+) diff --git a/PhyslibAlpha/2HDM/EffectivePotential.lean b/PhyslibAlpha/2HDM/EffectivePotential.lean index 8027b36a0..823aec09a 100644 --- a/PhyslibAlpha/2HDM/EffectivePotential.lean +++ b/PhyslibAlpha/2HDM/EffectivePotential.lean @@ -755,6 +755,107 @@ lemma exists_gram_clearing (p : MvPolynomial (Fin 5) ℝ) : rw [map_mul, map_pow, eval_X, eval_aeval_comp]; simp only [realGenP_eval] rw [← hR, ← hL, hA] +open MvPolynomial in +/-- **`‖Φ1‖²`-clearing, on all configurations.** A power of `‖Φ1‖²` times a gauge-invariant + polynomial potential is, everywhere, a polynomial in the Gram vector. -/ +lemma exists_clearing_all {V : EffectivePotential} {n : ℕ} + (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : + ∃ (A : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) (N : ℕ), ∀ φ : TwoHiggsDoublet, + (‖φ.Φ1‖ ^ 2) ^ N * V φ = A.eval φ.gramVector := by + obtain ⟨p5, hp5⟩ := exists_polynomial_repHiggs_realGen hI h + obtain ⟨A, N, hAN⟩ := exists_gram_clearing p5 + refine ⟨A, N, fun φ => ?_⟩ + obtain ⟨X, g, hg⟩ := exists_smul_eq_repHiggs φ + have hV : V φ = V (repHiggs X) := by rw [← hg]; exact (hI g φ).symm + have hgram : φ.gramVector = (repHiggs X).gramVector := by + rw [← hg]; funext μ; exact (gaugeGroupI_smul_fst_gramVector g φ μ).symm + have hΦ1 : ‖φ.Φ1‖ ^ 2 = (X 0) ^ 2 := by + rw [normSq_Φ1_eq_gramVector, hgram, ← normSq_Φ1_eq_gramVector, normSq_repHiggs_Φ1] + rw [hΦ1, hV, hgram, ← pow_mul, hp5] + exact hAN X + +/-! ### Swapping the two doublets (to clear the `‖Φ2‖²` denominator) -/ + +/-- Swapping the two doublets, as an `ℝ`-linear map. It commutes with the gauge action, so it sends + gauge-invariant polynomial potentials to gauge-invariant polynomial potentials, but turns the + alignment of `Φ1` into the alignment of `Φ2`. -/ +def swapDoublet : TwoHiggsDoublet →ₗ[ℝ] TwoHiggsDoublet where + toFun φ := { Φ1 := φ.Φ2, Φ2 := φ.Φ1 } + map_add' _ _ := rfl + map_smul' _ _ := rfl + +@[simp] lemma swapDoublet_Φ1 (φ : TwoHiggsDoublet) : (swapDoublet φ).Φ1 = φ.Φ2 := rfl +@[simp] lemma swapDoublet_Φ2 (φ : TwoHiggsDoublet) : (swapDoublet φ).Φ2 = φ.Φ1 := rfl + +@[simp] lemma swapDoublet_swapDoublet (φ : TwoHiggsDoublet) : swapDoublet (swapDoublet φ) = φ := by + apply ext_of_fst_snd <;> rfl + +lemma swapDoublet_smul (g : StandardModel.GaugeGroupI) (φ : TwoHiggsDoublet) : + swapDoublet (g • φ) = g • swapDoublet φ := by + apply ext_of_fst_snd <;> simp + +/-- Swapping the doublets sends the gram vector through the sign flip of the imaginary and + difference components. -/ +lemma gramVector_swapDoublet_inl (φ : TwoHiggsDoublet) : + (swapDoublet φ).gramVector (Sum.inl 0) = φ.gramVector (Sum.inl 0) := by + rw [gramVector_inl_zero_eq, gramVector_inl_zero_eq, swapDoublet_Φ1, swapDoublet_Φ2]; ring + +lemma gramVector_swapDoublet_inr0 (φ : TwoHiggsDoublet) : + (swapDoublet φ).gramVector (Sum.inr 0) = φ.gramVector (Sum.inr 0) := by + rw [gramVector_inr_zero_eq, gramVector_inr_zero_eq, swapDoublet_Φ1, swapDoublet_Φ2, + ← inner_conj_symm, Complex.conj_re] + +lemma gramVector_swapDoublet_inr1 (φ : TwoHiggsDoublet) : + (swapDoublet φ).gramVector (Sum.inr 1) = -φ.gramVector (Sum.inr 1) := by + rw [gramVector_inr_one_eq, gramVector_inr_one_eq, swapDoublet_Φ1, swapDoublet_Φ2, + ← inner_conj_symm, Complex.conj_im]; ring + +lemma gramVector_swapDoublet_inr2 (φ : TwoHiggsDoublet) : + (swapDoublet φ).gramVector (Sum.inr 2) = -φ.gramVector (Sum.inr 2) := by + rw [gramVector_inr_two_eq, gramVector_inr_two_eq, swapDoublet_Φ1, swapDoublet_Φ2]; ring + +lemma HasMaxMassDimLE.comp_swapDoublet {V : EffectivePotential} {n : ℕ} + (h : HasMaxMassDimLE V n) : HasMaxMassDimLE (fun φ => V (swapDoublet φ)) n := by + obtain ⟨p, hp, hdeg⟩ := h + refine ⟨MvPolynomial.rename + (fun i : Module.Dual ℝ TwoHiggsDoublet => i.comp swapDoublet) p, fun φ => ?_, ?_⟩ + · change V (swapDoublet φ) = _ + rw [MvPolynomial.eval_rename, hp (swapDoublet φ)]; rfl + · exact le_trans (MvPolynomial.totalDegree_rename_le _ _) hdeg + +lemma IsInvariant.comp_swapDoublet {V : EffectivePotential} (hI : IsInvariant V) : + IsInvariant (fun φ => V (swapDoublet φ)) := by + intro g φ + show V (swapDoublet (g • φ)) = V (swapDoublet φ) + rw [swapDoublet_smul, hI g] + +open MvPolynomial in +/-- The Gram-vector substitution induced by swapping the doublets (sign flip on the imaginary and + difference components). -/ +noncomputable def swapSubst : (Fin 1 ⊕ Fin 3) → MvPolynomial (Fin 1 ⊕ Fin 3) ℝ := + Sum.elim (fun _ => X (Sum.inl 0)) ![X (Sum.inr 0), -X (Sum.inr 1), -X (Sum.inr 2)] + +open MvPolynomial in +/-- **`‖Φ2‖²`-clearing, on all configurations.** A power of `‖Φ2‖²` times a gauge-invariant + polynomial potential is, everywhere, a polynomial in the Gram vector. Obtained from + `exists_clearing_all` for the doublet-swapped potential. -/ +lemma exists_clearing_all_snd {V : EffectivePotential} {n : ℕ} + (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : + ∃ (B : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) (M : ℕ), ∀ φ : TwoHiggsDoublet, + (‖φ.Φ2‖ ^ 2) ^ M * V φ = B.eval φ.gramVector := by + obtain ⟨B0, M, hB0⟩ := exists_clearing_all hI.comp_swapDoublet h.comp_swapDoublet + refine ⟨aeval swapSubst B0, M, fun φ => ?_⟩ + have hb := hB0 (swapDoublet φ) + simp only [swapDoublet_Φ1, swapDoublet_swapDoublet] at hb + have hpt : (swapDoublet φ).gramVector = fun μ => eval φ.gramVector (swapSubst μ) := by + funext μ + match μ with + | Sum.inl 0 => simp [swapSubst, gramVector_swapDoublet_inl] + | Sum.inr 0 => simp [swapSubst, gramVector_swapDoublet_inr0] + | Sum.inr 1 => simp [swapSubst, gramVector_swapDoublet_inr1] + | Sum.inr 2 => simp [swapSubst, gramVector_swapDoublet_inr2] + rw [hb, eval_aeval_comp, hpt] + /-! ## C. Reduction to the polynomial family of orbit representatives From cf5f38fde252a2c81c3c8caf101c5868089d555b Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Wed, 1 Jul 2026 08:11:56 +0100 Subject: [PATCH 18/25] feat: next batch Co-Authored-By: Claude --- PhyslibAlpha/2HDM/EffectivePotential.lean | 174 ++++++++++++++++++++-- 1 file changed, 162 insertions(+), 12 deletions(-) diff --git a/PhyslibAlpha/2HDM/EffectivePotential.lean b/PhyslibAlpha/2HDM/EffectivePotential.lean index 823aec09a..49eaf8bbf 100644 --- a/PhyslibAlpha/2HDM/EffectivePotential.lean +++ b/PhyslibAlpha/2HDM/EffectivePotential.lean @@ -10,6 +10,7 @@ public import Mathlib.RingTheory.MvPolynomial.Homogeneous public import Mathlib.Algebra.MvPolynomial.Funext public import Mathlib.Algebra.MvPolynomial.Monad public import Mathlib.RingTheory.MvPolynomial.Tower +public import Mathlib.Algebra.MvPolynomial.Division public import Mathlib.Analysis.Real.Pi.Irrational public import PhyslibAlpha.«2HDM».Determinant public import PhyslibAlpha.«2HDM».OrbitRepresentative @@ -874,24 +875,173 @@ representative family — see `exists_polynomial_on_repHiggs`. -/ -/-- **The two Higgs doublet model first fundamental theorem (representative form).** +/-! **The two Higgs doublet model first fundamental theorem (representative form).** -This is the irreducible invariant–theoretic core of the theorem: a gauge invariant polynomial -potential, restricted to the polynomial family of orbit representatives `repHiggs X`, is a -polynomial in the Gram components of that family. +`exists_polynomial_on_repHiggs` is the irreducible invariant–theoretic core: a gauge invariant +polynomial potential, restricted to the polynomial family of orbit representatives `repHiggs X`, is +a polynomial in the Gram components of that family. It is the non-abelian `SU(2)` first fundamental +theorem specialised to two doublets in `ℂ²`, proved here by the *doublet-swap* argument: clearing +the `‖Φ1‖²` denominator (aligning `Φ1`) and the `‖Φ2‖²` denominator (aligning `Φ2`, via the +gauge-commuting swap), then using that `‖Φ1‖²` and `‖Φ2‖²` are coprime in the Gram ring. -/ -This statement is square-root free (in contrast to the normalised representatives, whose -coordinates contain `√‖Φ1‖²`). It cannot follow from the parities of `V ∘ repHiggs` alone — e.g. -`X₁²` is parity invariant yet is `(Re ⟪Φ1,Φ2⟫)²/‖Φ1‖²`, which is not polynomial; it is excluded -precisely because it does not extend to a *global* polynomial invariant. The content is therefore -the non-abelian `SU(2)` first fundamental theorem specialised to two doublets in `ℂ²`, established -by the unipotent (shear group) reduction together with the Lagrange identity `norm_doubletDet_sq` -which folds the `SU(2)` determinant invariant back into the Gram data. -/ +open MvPolynomial in +/-- The four Gram generators are algebraically independent: the Gram substitution is injective. -/ +lemma gramP_injective : + Function.Injective (aeval gramP : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ → MvPolynomial (Fin 4) ℝ) := by + rw [injective_iff_map_eq_zero] + intro P hP + -- `P` vanishes on every Gram vector of a representative. + have hvanish : ∀ y : Fin 4 → ℝ, P.eval ((repHiggs y).gramVector) = 0 := by + intro y + have h := congrArg (eval y) hP + rw [eval_aeval_comp, map_zero] at h + rwa [show (fun μ => eval y (gramP μ)) = (repHiggs y).gramVector from funext (gramP_eval y)] at h + -- The Gram cone contains an infinite box; `P` vanishes there, hence `P = 0`. + refine MvPolynomial.funext_set + (fun μ => Sum.elim (fun _ => Set.Ioi (2 : ℝ)) (fun _ => Set.Ioo (-1 : ℝ) 1) μ) ?_ ?_ + · intro μ + rcases μ with _ | i + · exact Set.Ioi_infinite _ + · exact Set.Ioo_infinite (by norm_num) + · intro x hx + rw [Set.mem_univ_pi] at hx + have hxl : (2 : ℝ) < x (Sum.inl 0) := hx (Sum.inl 0) + have hx0 : x (Sum.inr 0) ∈ Set.Ioo (-1 : ℝ) 1 := hx (Sum.inr 0) + have hx1 : x (Sum.inr 1) ∈ Set.Ioo (-1 : ℝ) 1 := hx (Sum.inr 1) + have hx2 : x (Sum.inr 2) ∈ Set.Ioo (-1 : ℝ) 1 := hx (Sum.inr 2) + have hdpos : 0 < (x (Sum.inl 0) + x (Sum.inr 2)) / 2 := by have := hx2.1; linarith + set y0 : ℝ := Real.sqrt ((x (Sum.inl 0) + x (Sum.inr 2)) / 2) with hy0def + have hy0pos : 0 < y0 := Real.sqrt_pos.mpr hdpos + have hy0sq : y0 ^ 2 = (x (Sum.inl 0) + x (Sum.inr 2)) / 2 := + Real.sq_sqrt hdpos.le + set y1 : ℝ := x (Sum.inr 0) / (2 * y0) with hy1def + set y2 : ℝ := x (Sum.inr 1) / (2 * y0) with hy2def + -- the perpendicular component squared is nonnegative (PSD condition on the box) + have hbound : x (Sum.inr 0) ^ 2 + x (Sum.inr 1) ^ 2 + ≤ x (Sum.inl 0) ^ 2 - x (Sum.inr 2) ^ 2 := by + nlinarith [hx0.1, hx0.2, hx1.1, hx1.2, hx2.1, hx2.2, hxl] + have h2y0sq : (2 * y0) ^ 2 = 2 * (x (Sum.inl 0) + x (Sum.inr 2)) := by + rw [mul_pow, hy0sq]; ring + have hsumpos : 0 < x (Sum.inl 0) + x (Sum.inr 2) := by linarith [hx2.1] + have hkey : 2 * (x (Sum.inl 0) + x (Sum.inr 2)) * (y1 ^ 2 + y2 ^ 2) + = x (Sum.inr 0) ^ 2 + x (Sum.inr 1) ^ 2 := by + rw [hy1def, hy2def, div_pow, div_pow, ← h2y0sq] + field_simp + have hy3arg : 0 ≤ (x (Sum.inl 0) - x (Sum.inr 2)) / 2 - y1 ^ 2 - y2 ^ 2 := by + nlinarith [hkey, hbound, hsumpos] + set y3 : ℝ := Real.sqrt ((x (Sum.inl 0) - x (Sum.inr 2)) / 2 - y1 ^ 2 - y2 ^ 2) with hy3def + have hy3sq : y3 ^ 2 = (x (Sum.inl 0) - x (Sum.inr 2)) / 2 - y1 ^ 2 - y2 ^ 2 := + Real.sq_sqrt hy3arg + have hgram : (repHiggs ![y0, y1, y2, y3]).gramVector = x := by + funext μ + match μ with + | Sum.inl 0 => + rw [gramVector_repHiggs_inl] + simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.head_cons, Matrix.cons_val, + Fin.isValue] + rw [hy0sq, hy3sq]; ring + | Sum.inr 0 => + rw [gramVector_repHiggs_inr0] + simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.head_cons] + rw [hy1def]; field_simp + | Sum.inr 1 => + rw [gramVector_repHiggs_inr1] + simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.head_cons, Matrix.cons_val, + Fin.isValue] + rw [hy2def]; field_simp + | Sum.inr 2 => + rw [gramVector_repHiggs_inr2] + simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.head_cons, Matrix.cons_val, + Fin.isValue] + rw [hy0sq, hy3sq]; ring + rw [map_zero, ← hgram] + exact hvanish ![y0, y1, y2, y3] + +open MvPolynomial in +/-- `‖Φ1‖²` and `‖Φ2‖²`, as the distinct linear forms `(g₀±g₃)/2` of the Gram ring, are coprime: + if `‖Φ1‖²ᴺ · B = ‖Φ2‖²ᴹ · A` then `‖Φ1‖²ᴺ ∣ A`. -/ +lemma uPow_dvd {N M : ℕ} {A B : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ} + (hAB : (C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2))) ^ N * B + = (C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2))) ^ M * A) : + (C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2))) ^ N ∣ A := by + -- `X (inl 0)` does not divide `X (inr 2)` (distinct variables). + have hnd : ¬ ((X (Sum.inl 0) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) ∣ X (Sum.inr 2)) := by + rintro ⟨q, hq⟩ + have h0 := congrArg (eval (fun μ => if μ = Sum.inr 2 then (1 : ℝ) else 0)) hq + simp [eval_mul, eval_X] at h0 + -- hence `X (inl 0)` and `X (inr 2)` are relatively prime. + have hrelXX : IsRelPrime (X (Sum.inl 0) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) (X (Sum.inr 2)) := by + intro d hd1 hd2 + obtain ⟨c, hc⟩ := hd1 + rcases (MvPolynomial.X_prime).irreducible.isUnit_or_isUnit hc with h | h + · exact h + · exfalso + apply hnd + obtain ⟨e, he⟩ := hd2 + exact ⟨(↑h.unit⁻¹ : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) * e, by + rw [he, ← mul_assoc] + congr 1 + rw [hc, mul_assoc, IsUnit.mul_val_inv, mul_one]⟩ + -- `u` and `w` are relatively prime: any common divisor divides `u ± w = X inl0, X inr2`. + have hsum : (X (Sum.inl 0) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) + = C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2)) + C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2)) := by + apply MvPolynomial.funext; intro y + simp only [eval_add, eval_mul, eval_sub, eval_C, eval_X]; ring + have hdiff : (X (Sum.inr 2) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) + = C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2)) - C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2)) := by + apply MvPolynomial.funext; intro y + simp only [eval_add, eval_mul, eval_sub, eval_C, eval_X]; ring + have hrel : IsRelPrime (C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2))) + (C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2)) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) := by + intro d hdu hdw + exact hrelXX (hsum ▸ dvd_add hdu hdw) (hdiff ▸ dvd_sub hdu hdw) + exact (hrel.pow).dvd_of_dvd_mul_left (hAB ▸ Dvd.intro B rfl) + +open MvPolynomial in lemma exists_polynomial_on_repHiggs {V : EffectivePotential} {n : ℕ} (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : ∃ p : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ, ∀ X : Fin 4 → ℝ, V (repHiggs X) = p.eval (repHiggs X).gramVector := by - sorry + obtain ⟨p5, hp5⟩ := exists_polynomial_repHiggs_realGen hI h + obtain ⟨A, N, hA'⟩ := exists_clearing_all hI h + obtain ⟨B, M, hB'⟩ := exists_clearing_all_snd hI h + set F : MvPolynomial (Fin 4) ℝ := aeval realGenP p5 with hF_def + have hFeval : ∀ x : Fin 4 → ℝ, F.eval x = V (repHiggs x) := by + intro x; rw [hF_def, eval_aeval_comp]; simp only [realGenP_eval]; exact (hp5 x).symm + have hgramfun : ∀ x : Fin 4 → ℝ, + (fun μ => eval x (gramP μ)) = (repHiggs x).gramVector := fun x => funext (gramP_eval x) + have hu : aeval gramP ((C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2)) : + MvPolynomial (Fin 1 ⊕ Fin 3) ℝ)) = X 0 ^ 2 := by + apply MvPolynomial.funext; intro x + rw [eval_aeval_comp, hgramfun, eval_mul, eval_C, eval_add, eval_X, eval_X, + gramVector_repHiggs_inl, gramVector_repHiggs_inr2, eval_pow, eval_X]; ring + have hw : aeval gramP ((C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2)) : + MvPolynomial (Fin 1 ⊕ Fin 3) ℝ)) = X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2 := by + apply MvPolynomial.funext; intro x + rw [eval_aeval_comp, hgramfun, eval_mul, eval_C, eval_sub, eval_X, eval_X, + gramVector_repHiggs_inl, gramVector_repHiggs_inr2] + simp only [eval_add, eval_pow, eval_X]; ring + have hIp : aeval gramP A = (X 0 ^ 2) ^ N * F := by + apply MvPolynomial.funext; intro x + rw [eval_aeval_comp, hgramfun, ← hA' (repHiggs x), normSq_repHiggs_Φ1] + simp only [eval_mul, eval_pow, eval_X, hFeval] + have hIIp : aeval gramP B = (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2) ^ M * F := by + apply MvPolynomial.funext; intro x + rw [eval_aeval_comp, hgramfun, ← hB' (repHiggs x), normSq_repHiggs_Φ2] + simp only [eval_mul, eval_pow, eval_add, eval_X, hFeval] + have hcross : (C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2))) ^ N * B + = (C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2))) ^ M * A := by + apply gramP_injective + rw [map_mul, map_mul, map_pow, map_pow, hu, hw, hIp, hIIp]; ring + obtain ⟨C0, hC0⟩ := uPow_dvd hcross + refine ⟨C0, fun X => ?_⟩ + have key : (MvPolynomial.X 0 ^ 2) ^ N * F = (MvPolynomial.X 0 ^ 2) ^ N * aeval gramP C0 := by + rw [← hIp, hC0, map_mul, map_pow, hu] + have hFC : F = aeval gramP C0 := by + have hne : ((MvPolynomial.X 0 : MvPolynomial (Fin 4) ℝ) ^ 2) ^ N ≠ 0 := + pow_ne_zero _ (pow_ne_zero _ (MvPolynomial.X_ne_zero 0)) + exact mul_left_cancel₀ hne key + rw [← hFeval X, hFC, eval_aeval_comp, hgramfun] /-- An invariant effective potential with maximum mass dimension n can be written as a polynomial in the entries of the Gram vector. -/ From 1d1c18ff9a32d8d5fdb929c966cbca97ec0a7f3c Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Wed, 1 Jul 2026 08:23:22 +0100 Subject: [PATCH 19/25] feat: Calude finishes the proof prompt> Continue Co-Authored-By: Claude --- PhyslibAlpha/2HDM/EffectivePotential.lean | 36 +++---- PhyslibAlpha/2HDM/FullSpace.lean | 125 ---------------------- 2 files changed, 13 insertions(+), 148 deletions(-) delete mode 100644 PhyslibAlpha/2HDM/FullSpace.lean diff --git a/PhyslibAlpha/2HDM/EffectivePotential.lean b/PhyslibAlpha/2HDM/EffectivePotential.lean index 49eaf8bbf..8c8693dd8 100644 --- a/PhyslibAlpha/2HDM/EffectivePotential.lean +++ b/PhyslibAlpha/2HDM/EffectivePotential.lean @@ -144,7 +144,8 @@ open MvPolynomial in lemma eval_resSubst (c : unitary ℂ) (a : Fin 6 → ℝ) : (fun k => MvPolynomial.eval a (resSubst c k)) = resRotParam c a := by funext k - fin_cases k <;> simp [resSubst, resRotParam, Complex.mul_re, Complex.mul_im] <;> ring + fin_cases k <;> simp [resSubst, resRotParam, Complex.mul_re, Complex.mul_im] + ring open MvPolynomial in /-- Gauge (residual `U(1)`) invariance forces the slice polynomial to be invariant under the @@ -187,14 +188,11 @@ lemma bind₁_diagCartan_cplxEigen (u : unitary ℂ) (k : Fin 6) : apply MvPolynomial.funext intro x fin_cases k <;> - simp only [cplxEigen, diagCartan, rotSubst, Matrix.cons_val, Fin.isValue, - map_add, map_sub, map_mul, MvPolynomial.bind₁_X_right, - MvPolynomial.bind₁_C_right, MvPolynomial.map_C, MvPolynomial.map_X, MvPolynomial.algebraMap_eq, - MvPolynomial.eval_X, MvPolynomial.eval_C] <;> + simp only [cplxEigen, diagCartan, rotSubst, Fin.isValue] <;> (apply Complex.ext <;> simp [Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, - Complex.star_def, Complex.conj_re, Complex.conj_im] <;> ring) + Complex.conj_re, Complex.conj_im] <;> ring) open MvPolynomial in /-- Conjugation identity for the residual `U(1)`. -/ @@ -206,14 +204,11 @@ lemma bind₁_diagRes_cplxEigen (c : unitary ℂ) (k : Fin 6) : simp only [diagRes, resSubst] generalize (c : ℂ) ^ 6 = μ fin_cases k <;> - simp only [cplxEigen, Matrix.cons_val, Fin.isValue, - map_add, map_sub, map_mul, MvPolynomial.bind₁_X_right, - MvPolynomial.bind₁_C_right, MvPolynomial.map_C, MvPolynomial.map_X, MvPolynomial.algebraMap_eq, - MvPolynomial.eval_X, MvPolynomial.eval_C] <;> + simp only [cplxEigen, Fin.isValue] <;> (apply Complex.ext <;> simp [Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, - Complex.star_def, Complex.conj_re, Complex.conj_im] <;> ring) + Complex.conj_re, Complex.conj_im] <;> ring) /-- The Cartan hypercharges of `z, z̄, w₀, w̄₀, w₁, w̄₁`. -/ def chargeA : Fin 6 → ℤ := ![1, -1, 1, -1, -1, 1] @@ -542,10 +537,9 @@ open MvPolynomial in lemma aeval_cplxEigen_eigenPt (X : Fin 4 → ℝ) (k : Fin 6) : aeval (eigenPt X) (cplxEigen k) = algebraMap ℝ ℂ (aRep X k) := by fin_cases k <;> - simp only [cplxEigen, eigenPt, aRep, Matrix.cons_val, Fin.isValue, map_add, map_sub, map_mul, - aeval_X, aeval_C, MvPolynomial.algebraMap_eq] <;> + simp only [cplxEigen, eigenPt, aRep, Fin.isValue] <;> (apply Complex.ext <;> - simp [Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, + simp [Complex.add_re, Complex.add_im, Complex.mul_re, Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im] <;> ring) open MvPolynomial in @@ -616,8 +610,7 @@ open MvPolynomial in lemma bilin_eval_eigenPt (X : Fin 4 → ℝ) (i : Fin 5) : eval (eigenPt X) (bilin i) = eval (fun j => (↑(realGen X j) : ℂ)) (transf i) := by fin_cases i <;> - simp only [bilin, transf, eigenPt, realGen, Matrix.cons_val, Fin.isValue, map_mul, map_sub, - map_add, eval_X, eval_C] <;> + simp only [bilin, transf, eigenPt, realGen, Fin.isValue] <;> (apply Complex.ext <;> simp [pow_two, Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im] <;> ring) @@ -937,22 +930,19 @@ lemma gramP_injective : match μ with | Sum.inl 0 => rw [gramVector_repHiggs_inl] - simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.head_cons, Matrix.cons_val, - Fin.isValue] + simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val, Fin.isValue] rw [hy0sq, hy3sq]; ring | Sum.inr 0 => rw [gramVector_repHiggs_inr0] - simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.head_cons] + simp only [Matrix.cons_val_zero, Matrix.cons_val_one] rw [hy1def]; field_simp | Sum.inr 1 => rw [gramVector_repHiggs_inr1] - simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.head_cons, Matrix.cons_val, - Fin.isValue] + simp only [Matrix.cons_val_zero, Matrix.cons_val, Fin.isValue] rw [hy2def]; field_simp | Sum.inr 2 => rw [gramVector_repHiggs_inr2] - simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.head_cons, Matrix.cons_val, - Fin.isValue] + simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val, Fin.isValue] rw [hy0sq, hy3sq]; ring rw [map_zero, ← hgram] exact hvanish ![y0, y1, y2, y3] diff --git a/PhyslibAlpha/2HDM/FullSpace.lean b/PhyslibAlpha/2HDM/FullSpace.lean deleted file mode 100644 index af1288f84..000000000 --- a/PhyslibAlpha/2HDM/FullSpace.lean +++ /dev/null @@ -1,125 +0,0 @@ -/- -Copyright (c) 2026 Joseph Tooby-Smith. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Tooby-Smith --/ -module - -public import PhyslibAlpha.«2HDM».EffectivePotential -/-! -# The full configuration space of the two Higgs doublet model - -The orbit-representative slice `repHiggs` captures the *abelian* (gauge-torus) content of the first -fundamental theorem (`Condition A`: the value is a polynomial in the five bilinears `‖Φ1‖²`, -`Re⟪⟫`, `Im⟪⟫`, `|Φ2₀|²`, `|Φ2₁|²`). It cannot, however, capture the non-abelian content: only the -diagonal torus preserves the slice `{Φ1₁ = 0}`, so the slice value polynomial is blind to the -component-mixing `SU(2)` rotations needed to fuse `|Φ2₀|²` and `|Φ2₁|²` into `‖Φ2‖²`. - -To access that content we parametrise the *entire* eight–real–dimensional configuration space and -work with the two gauge tori (the standard diagonal one and a component-mixing one); their combined -invariance is the genuine `SU(2)` first fundamental theorem. --/ - -@[expose] public section - -noncomputable section - -namespace TwoHiggsDoublet - -open InnerProductSpace -open StandardModel -open scoped ComplexConjugate - -/-- The full configuration space as a real-linear map of the eight real field components - `(Re Φ1₀, Im Φ1₀, Re Φ1₁, Im Φ1₁, Re Φ2₀, Im Φ2₀, Re Φ2₁, Im Φ2₁)`. -/ -def fullR : (Fin 8 → ℝ) →ₗ[ℝ] TwoHiggsDoublet where - toFun a := - { Φ1 := !₂[(a 0 : ℂ) + Complex.I * (a 1 : ℂ), (a 2 : ℂ) + Complex.I * (a 3 : ℂ)] - Φ2 := !₂[(a 4 : ℂ) + Complex.I * (a 5 : ℂ), (a 6 : ℂ) + Complex.I * (a 7 : ℂ)] } - map_add' a b := by - apply ext_of_fst_snd - · ext i; fin_cases i <;> simp <;> ring - · ext i; fin_cases i <;> simp <;> ring - map_smul' c a := by - apply ext_of_fst_snd - · ext i; fin_cases i <;> simp [Complex.real_smul] <;> ring - · ext i; fin_cases i <;> simp [Complex.real_smul] <;> ring - -@[simp] lemma fullR_Φ1 (a : Fin 8 → ℝ) : - (fullR a).Φ1 = !₂[(a 0 : ℂ) + Complex.I * (a 1 : ℂ), (a 2 : ℂ) + Complex.I * (a 3 : ℂ)] := rfl - -@[simp] lemma fullR_Φ2 (a : Fin 8 → ℝ) : - (fullR a).Φ2 = !₂[(a 4 : ℂ) + Complex.I * (a 5 : ℂ), (a 6 : ℂ) + Complex.I * (a 7 : ℂ)] := rfl - -/-- Every configuration is `fullR` of its eight real components. -/ -lemma exists_fullR (φ : TwoHiggsDoublet) : ∃ a : Fin 8 → ℝ, fullR a = φ := by - refine ⟨![(φ.Φ1 0).re, (φ.Φ1 0).im, (φ.Φ1 1).re, (φ.Φ1 1).im, - (φ.Φ2 0).re, (φ.Φ2 0).im, (φ.Φ2 1).re, (φ.Φ2 1).im], ?_⟩ - apply ext_of_fst_snd - · ext i; fin_cases i <;> - simp [Matrix.cons_val_zero, Matrix.cons_val_one, mul_comm Complex.I, Complex.re_add_im] - · ext i; fin_cases i <;> - simp [Matrix.cons_val_zero, Matrix.cons_val_one, mul_comm Complex.I, Complex.re_add_im] - -/-! ### The standard diagonal gauge torus on the full space -/ - -open Complex in -/-- The Cartan phase `u = diag(a, ā)`, transported to a rotation of the eight real parameters: it - phases the *first*-component pairs `(0,1),(4,5)` by `a` and the *second*-component pairs - `(2,3),(6,7)` by `ā`. -/ -def cartanParam8 (u : unitary ℂ) (a : Fin 8 → ℝ) : Fin 8 → ℝ := - ![((u : ℂ) * (↑(a 0) + I * ↑(a 1))).re, ((u : ℂ) * (↑(a 0) + I * ↑(a 1))).im, - ((star u : ℂ) * (↑(a 2) + I * ↑(a 3))).re, ((star u : ℂ) * (↑(a 2) + I * ↑(a 3))).im, - ((u : ℂ) * (↑(a 4) + I * ↑(a 5))).re, ((u : ℂ) * (↑(a 4) + I * ↑(a 5))).im, - ((star u : ℂ) * (↑(a 6) + I * ↑(a 7))).re, ((star u : ℂ) * (↑(a 6) + I * ↑(a 7))).im] - -/-- Acting by the Cartan phase on a full configuration is the same as rotating its parameters. -/ -lemma gaugeCartan_smul_fullR (u : unitary ℂ) (a : Fin 8 → ℝ) : - GaugeGroupI.gaugeCartan u • fullR a = fullR (cartanParam8 u a) := by - apply ext_of_fst_snd - · rw [gaugeGroupI_smul_fst, GaugeGroupI.gaugeCartan_smul_eq, fullR_Φ1] - ext i - fin_cases i <;> - (apply Complex.ext <;> - simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, cartanParam8, fullR, Complex.mul_re, - Complex.mul_im, Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, - Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, Complex.star_def, - Complex.conj_re, Complex.conj_im] <;> ring) - · rw [gaugeGroupI_smul_snd, GaugeGroupI.gaugeCartan_smul_eq, fullR_Φ2] - ext i - fin_cases i <;> - (apply Complex.ext <;> - simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, cartanParam8, fullR, Complex.mul_re, - Complex.mul_im, Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, - Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, Complex.star_def, - Complex.conj_re, Complex.conj_im] <;> ring) - -open Complex in -/-- The residual `U(1)` phase `c`, transported to a rotation of the eight real parameters: it - phases the *second*-component pairs `(2,3),(6,7)` by `c⁶` and fixes the first-component pairs. -/ -def resParam8 (c : unitary ℂ) (a : Fin 8 → ℝ) : Fin 8 → ℝ := - ![a 0, a 1, ((c : ℂ) ^ 6 * (↑(a 2) + I * ↑(a 3) : ℂ)).re, - ((c : ℂ) ^ 6 * (↑(a 2) + I * ↑(a 3) : ℂ)).im, - a 4, a 5, ((c : ℂ) ^ 6 * (↑(a 6) + I * ↑(a 7) : ℂ)).re, - ((c : ℂ) ^ 6 * (↑(a 6) + I * ↑(a 7) : ℂ)).im] - -/-- Acting by the residual `U(1)` on a full configuration is the same as rotating its parameters. -/ -lemma ofU1Subgroup_smul_fullR (c : unitary ℂ) (a : Fin 8 → ℝ) : - GaugeGroupI.ofU1Subgroup c • fullR a = fullR (resParam8 c a) := by - apply ext_of_fst_snd - · rw [gaugeGroupI_smul_fst, HiggsVec.ofU1Subgroup_smul_eq_smul, fullR_Φ1] - ext i - fin_cases i <;> - (apply Complex.ext <;> - simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, resParam8, fullR, Complex.mul_re, - Complex.mul_im, Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, - Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im]) - · rw [gaugeGroupI_smul_snd, HiggsVec.ofU1Subgroup_smul_eq_smul, fullR_Φ2] - ext i - fin_cases i <;> - (apply Complex.ext <;> - simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, resParam8, fullR, Complex.mul_re, - Complex.mul_im, Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, - Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im]) - -end TwoHiggsDoublet From e4866082d604f69ebdd811b9408f8bf5c9b32abf Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Wed, 1 Jul 2026 08:35:23 +0100 Subject: [PATCH 20/25] feat: Claude prompt: Tidy up the files removing everything which is unnessary in proving effectivePotential_is_polynomial_gramVector Co-Authored-By: Claude --- PhyslibAlpha/2HDM/Determinant.lean | 104 ---------------------- PhyslibAlpha/2HDM/EffectivePotential.lean | 19 ---- PhyslibAlpha/2HDM/GaugeSlice.lean | 14 --- PhyslibAlpha/2HDM/GaugeTorus.lean | 12 --- 4 files changed, 149 deletions(-) delete mode 100644 PhyslibAlpha/2HDM/Determinant.lean diff --git a/PhyslibAlpha/2HDM/Determinant.lean b/PhyslibAlpha/2HDM/Determinant.lean deleted file mode 100644 index 81a3e7c72..000000000 --- a/PhyslibAlpha/2HDM/Determinant.lean +++ /dev/null @@ -1,104 +0,0 @@ -/- -Copyright (c) 2026 Joseph Tooby-Smith. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Tooby-Smith --/ -module - -public import Physlib.Particles.BeyondTheStandardModel.TwoHDM.GramMatrix -/-! -# The doublet determinant of the two Higgs doublet model - -The two Higgs doublets `Φ1, Φ2 : ℂ²` form a `2 × 2` matrix whose determinant -`Φ1₀ Φ2₁ - Φ1₁ Φ2₀` is the basic `SU(2)`-invariant built out of the two doublets that is -*not* one of the entries of the Gram matrix. - -Under the gauge group it carries hypercharge (it is rescaled by a phase under the `U(1)` factor -and is genuinely invariant under `SU(2)`), so it only contributes to gauge invariants through its -modulus squared. The central result of this file, `norm_doubletDet_sq`, is the Lagrange identity -which expresses this modulus squared in terms of the Gram data: -`‖doubletDet H‖² = ‖Φ1‖² ‖Φ2‖² - ‖⟪Φ1, Φ2⟫‖² = (gramMatrix H).det.re`. - --/ - -@[expose] public section - -noncomputable section - -namespace TwoHiggsDoublet - -open InnerProductSpace -open StandardModel -open ComplexConjugate -open Matrix - -/-- The determinant of the `2 × 2` matrix whose columns are the two Higgs doublets. This is the - basic `SU(2)`-invariant of the two doublets which is not an entry of the Gram matrix. -/ -def doubletDet (H : TwoHiggsDoublet) : ℂ := - H.Φ1 0 * H.Φ2 1 - H.Φ1 1 * H.Φ2 0 - -lemma doubletDet_eq (H : TwoHiggsDoublet) : - H.doubletDet = H.Φ1 0 * H.Φ2 1 - H.Φ1 1 * H.Φ2 0 := rfl - -/-- The Lagrange identity: the modulus squared of the doublet determinant equals the determinant - of the Gram matrix. -/ -lemma norm_doubletDet_sq (H : TwoHiggsDoublet) : - ‖doubletDet H‖ ^ 2 = ‖H.Φ1‖ ^ 2 * ‖H.Φ2‖ ^ 2 - ‖⟪H.Φ1, H.Φ2⟫_ℂ‖ ^ 2 := by - rw [doubletDet] - rw [PiLp.norm_sq_eq_of_L2, PiLp.norm_sq_eq_of_L2, PiLp.inner_apply] - rw [Fin.sum_univ_two, Fin.sum_univ_two, Fin.sum_univ_two] - simp only [← Complex.normSq_eq_norm_sq, Complex.normSq_apply, Complex.add_re, Complex.add_im, - Complex.mul_re, Complex.mul_im, Complex.sub_re, Complex.sub_im, Complex.conj_re, - Complex.conj_im, RCLike.inner_apply] - ring - -/-- The modulus squared of the doublet determinant equals the real part of the determinant of the - Gram matrix. -/ -lemma norm_doubletDet_sq_eq_det (H : TwoHiggsDoublet) : - ‖doubletDet H‖ ^ 2 = H.gramMatrix.det.re := by - rw [norm_doubletDet_sq, gramMatrix_det_eq_real] - -/-- The modulus squared of the doublet determinant in terms of the Gram vector. -/ -lemma norm_doubletDet_sq_eq_gramVector (H : TwoHiggsDoublet) : - ‖doubletDet H‖ ^ 2 = - (1 / 4 : ℝ) * (H.gramVector (Sum.inl 0) ^ 2 - ∑ μ : Fin 3, H.gramVector (Sum.inr μ) ^ 2) := by - rw [norm_doubletDet_sq_eq_det, gramMatrix_det_eq_gramVector] - -/-! - -## Gauge covariance of the doublet determinant - -The doublet determinant is genuinely invariant under `SU(2)` (whose determinant is `1`) and is -rescaled by the sixth power of the `U(1)` phase. In particular its modulus is gauge invariant, -consistent with `norm_doubletDet_sq_eq_det`. - --/ - -/-- The action of the gauge group on a single Higgs vector, written componentwise. -/ -lemma gaugeGroupI_smul_apply (g : StandardModel.GaugeGroupI) (φ : HiggsVec) (i : Fin 2) : - (g • φ) i = (g.toU1 ^ 3 : ℂ) * (g.toSU2.1 *ᵥ φ.ofLp) i := by - rw [HiggsVec.gaugeGroupI_smul_eq] - rfl - -/-- The doublet determinant is a relative invariant: under a gauge transformation it picks up the - sixth power of the `U(1)` phase (and is genuinely `SU(2)`-invariant). -/ -lemma doubletDet_smul (g : StandardModel.GaugeGroupI) (H : TwoHiggsDoublet) : - doubletDet (g • H) = (g.toU1 ^ 3 : ℂ) ^ 2 * doubletDet H := by - rw [doubletDet, doubletDet, gaugeGroupI_smul_fst, gaugeGroupI_smul_snd, - gaugeGroupI_smul_apply, gaugeGroupI_smul_apply, gaugeGroupI_smul_apply, gaugeGroupI_smul_apply] - have hdet : (g.toSU2.1).det = 1 := g.toSU2.2.2 - rw [Matrix.det_fin_two] at hdet - simp only [mulVec, dotProduct, Fin.sum_univ_two] - linear_combination ((g.toU1 ^ 3 : ℂ) ^ 2 * - (H.Φ1.ofLp 0 * H.Φ2.ofLp 1 - H.Φ1.ofLp 1 * H.Φ2.ofLp 0)) * hdet - -/-- The modulus of the doublet determinant is gauge invariant. -/ -@[simp] -lemma norm_doubletDet_smul (g : StandardModel.GaugeGroupI) (H : TwoHiggsDoublet) : - ‖doubletDet (g • H)‖ = ‖doubletDet H‖ := by - have h2 : ‖doubletDet (g • H)‖ ^ 2 = ‖doubletDet H‖ ^ 2 := by - rw [norm_doubletDet_sq_eq_det, norm_doubletDet_sq_eq_det, gaugeGroupI_smul_gramMatrix] - rw [← Real.sqrt_sq (norm_nonneg (doubletDet (g • H))), h2, - Real.sqrt_sq (norm_nonneg (doubletDet H))] - -end TwoHiggsDoublet diff --git a/PhyslibAlpha/2HDM/EffectivePotential.lean b/PhyslibAlpha/2HDM/EffectivePotential.lean index 8c8693dd8..c80260c62 100644 --- a/PhyslibAlpha/2HDM/EffectivePotential.lean +++ b/PhyslibAlpha/2HDM/EffectivePotential.lean @@ -6,13 +6,11 @@ Authors: Joseph Tooby-Smith module public import Physlib.Particles.BeyondTheStandardModel.TwoHDM.GramMatrix -public import Mathlib.RingTheory.MvPolynomial.Homogeneous public import Mathlib.Algebra.MvPolynomial.Funext public import Mathlib.Algebra.MvPolynomial.Monad public import Mathlib.RingTheory.MvPolynomial.Tower public import Mathlib.Algebra.MvPolynomial.Division public import Mathlib.Analysis.Real.Pi.Irrational -public import PhyslibAlpha.«2HDM».Determinant public import PhyslibAlpha.«2HDM».OrbitRepresentative public import PhyslibAlpha.«2HDM».GaugeSlice public import PhyslibAlpha.«2HDM».ChargeBalance @@ -49,23 +47,6 @@ namespace EffectivePotential def IsInvariant (V : EffectivePotential) : Prop := ∀ (g : GaugeGroupI), ∀ (φ : TwoHiggsDoublet), V (g • φ) = V φ -namespace IsInvariant - -/-- An invariant potential is equal on gauge orbits. -/ -lemma eq_on_orbits {φ1 φ2 : TwoHiggsDoublet} {V : EffectivePotential} (h : IsInvariant V) - (hφ : φ1 ∈ MulAction.orbit GaugeGroupI φ2) : - V φ1 = V φ2 := by - obtain ⟨g, hg⟩ := hφ - rw [← hg] - exact h g φ2 - -/-- An invariant potential is equal on Higgs vectors with identical Gram vectors. -/ -lemma eq_of_gramVector_eq {φ1 φ2 : TwoHiggsDoublet} {V : EffectivePotential} (h : IsInvariant V) - (hφ : φ1.gramVector = φ2.gramVector) : - V φ1 = V φ2 := h.eq_on_orbits <| (mem_orbit_gaugeGroupI_iff_gramVector φ1 φ2).mpr hφ - -end IsInvariant - /-! ## B. Maximum mass dimension diff --git a/PhyslibAlpha/2HDM/GaugeSlice.lean b/PhyslibAlpha/2HDM/GaugeSlice.lean index ff7844ab1..7726cb7d7 100644 --- a/PhyslibAlpha/2HDM/GaugeSlice.lean +++ b/PhyslibAlpha/2HDM/GaugeSlice.lean @@ -62,20 +62,6 @@ def sliceR : (Fin 6 → ℝ) →ₗ[ℝ] TwoHiggsDoublet where sliceR a = sliceHiggs (↑(a 0) + Complex.I * ↑(a 1)) (↑(a 2) + Complex.I * ↑(a 3)) (↑(a 4) + Complex.I * ↑(a 5)) := rfl -/-- The representative family as a real-linear map of its four real parameters. -/ -def repHiggsLin : (Fin 4 → ℝ) →ₗ[ℝ] TwoHiggsDoublet where - toFun X := repHiggs X - map_add' a b := by - apply ext_of_fst_snd - · ext i; fin_cases i <;> simp [repHiggs] <;> ring - · ext i; fin_cases i <;> simp [repHiggs] <;> ring - map_smul' c a := by - apply ext_of_fst_snd - · ext i; fin_cases i <;> simp [repHiggs, Complex.real_smul] <;> ring - · ext i; fin_cases i <;> simp [repHiggs, Complex.real_smul] <;> ring - -@[simp] lemma repHiggsLin_apply (X : Fin 4 → ℝ) : repHiggsLin X = repHiggs X := rfl - /-- The representative family is the real slice. -/ lemma repHiggs_eq_sliceHiggs (X : Fin 4 → ℝ) : repHiggs X = sliceHiggs (X 0) ((X 1 : ℂ) + Complex.I * (X 2 : ℂ)) (X 3) := rfl diff --git a/PhyslibAlpha/2HDM/GaugeTorus.lean b/PhyslibAlpha/2HDM/GaugeTorus.lean index d0cb6a4b7..9a358ad73 100644 --- a/PhyslibAlpha/2HDM/GaugeTorus.lean +++ b/PhyslibAlpha/2HDM/GaugeTorus.lean @@ -56,17 +56,5 @@ lemma gaugeCartan_smul_eq (a : unitary ℂ) (φ : HiggsVec) : gaugeCartan a • φ = WithLp.toLp 2 (!![(a : ℂ), 0; 0, (star a : ℂ)] *ᵥ φ.ofLp) := by rw [HiggsVec.gaugeGroupI_smul_eq, gaugeCartan_toU1, one_pow, one_smul, gaugeCartan_toSU2_coe] -/-- The Cartan element phases the two components of a Higgs vector by `a` and `ā`. -/ -lemma gaugeCartan_smul_apply_zero (a : unitary ℂ) (φ : HiggsVec) : - (gaugeCartan a • φ) 0 = (a : ℂ) * φ 0 := by - rw [HiggsVec.gaugeGroupI_smul_eq, gaugeCartan_toU1, one_pow, one_smul] - simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, gaugeCartan_toSU2_coe] - -/-- The Cartan element phases the two components of a Higgs vector by `a` and `ā`. -/ -lemma gaugeCartan_smul_apply_one (a : unitary ℂ) (φ : HiggsVec) : - (gaugeCartan a • φ) 1 = (star a : ℂ) * φ 1 := by - rw [HiggsVec.gaugeGroupI_smul_eq, gaugeCartan_toU1, one_pow, one_smul] - simp [Matrix.mulVec, dotProduct, Fin.sum_univ_two, gaugeCartan_toSU2_coe] - end GaugeGroupI end StandardModel From 63b903e21911e04a9845a08536e15d684fc36eca Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Wed, 1 Jul 2026 08:55:04 +0100 Subject: [PATCH 21/25] feat: More claude Prompt: Reorganize the proof so we follow the API structure of Physlib. This means: Rephrase things in terms of results on physically meaningful definitions, make sure all the results around one definition sit within the same place within the project. Co-Authored-By: Claude --- PhyslibAlpha/2HDM/EffectivePotential.lean | 983 +---------------- .../2HDM/FirstFundamentalTheorem.lean | 985 ++++++++++++++++++ PhyslibAlpha/2HDM/SwapDoublet.lean | 120 +++ 3 files changed, 1127 insertions(+), 961 deletions(-) create mode 100644 PhyslibAlpha/2HDM/FirstFundamentalTheorem.lean create mode 100644 PhyslibAlpha/2HDM/SwapDoublet.lean diff --git a/PhyslibAlpha/2HDM/EffectivePotential.lean b/PhyslibAlpha/2HDM/EffectivePotential.lean index c80260c62..9d9a83789 100644 --- a/PhyslibAlpha/2HDM/EffectivePotential.lean +++ b/PhyslibAlpha/2HDM/EffectivePotential.lean @@ -6,17 +6,31 @@ Authors: Joseph Tooby-Smith module public import Physlib.Particles.BeyondTheStandardModel.TwoHDM.GramMatrix -public import Mathlib.Algebra.MvPolynomial.Funext -public import Mathlib.Algebra.MvPolynomial.Monad public import Mathlib.RingTheory.MvPolynomial.Tower -public import Mathlib.Algebra.MvPolynomial.Division -public import Mathlib.Analysis.Real.Pi.Irrational -public import PhyslibAlpha.«2HDM».OrbitRepresentative -public import PhyslibAlpha.«2HDM».GaugeSlice -public import PhyslibAlpha.«2HDM».ChargeBalance /-! # The effective potential of the two Higgs doublet model +## i. Overview + +An *effective potential* of the two Higgs doublet model is a real-valued function +`V : TwoHiggsDoublet → ℝ` of the field configuration. This file introduces the two physical +properties of such a potential that the First Fundamental Theorem depends on: + +* `IsInvariant V` — invariance under the global gauge group, and +* `HasMaxMassDimLE V n` — being a polynomial in the field components of mass dimension `≤ n`. + +## ii. Key results + +* `EffectivePotential` — the type of effective potentials. +* `IsInvariant` — gauge invariance of a potential. +* `HasMaxMassDimLE` — being a bounded-degree polynomial in the field components. +* `HasMaxMassDimLE.exists_comp_linear_poly` — a polynomial potential, restricted along any + real-linear parametrisation of configurations, is a polynomial in the parameters. + +## iii. Table of contents + +* A. The effective potential and its gauge invariance +* B. Maximum mass dimension -/ @@ -28,18 +42,13 @@ namespace TwoHiggsDoublet open InnerProductSpace open StandardModel -open SpaceTime - - /-- A general potential of the Higgs field. -/ abbrev EffectivePotential : Type := TwoHiggsDoublet → ℝ namespace EffectivePotential /-! - -## A. The invariance of the general potential under the gauge group - +## A. The effective potential and its gauge invariance -/ /-- The proposition that the general potential is invariant under @@ -48,9 +57,7 @@ def IsInvariant (V : EffectivePotential) : Prop := ∀ (g : GaugeGroupI), ∀ (φ : TwoHiggsDoublet), V (g • φ) = V φ /-! - ## B. Maximum mass dimension - -/ /-- The proposition that the potential `V` has a maximum mass dimension @@ -85,952 +92,6 @@ lemma HasMaxMassDimLE.exists_comp_linear_poly {V : EffectivePotential} {n : ℕ} rw [hp, key, MvPolynomial.aeval_def, MvPolynomial.algebraMap_eq, ← MvPolynomial.eval_assoc] rfl -open MvPolynomial in -/-- The Cartan hypercharge rotation of the slice parameters, as a substitution of the polynomial - variables. -/ -noncomputable def rotSubst (u : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℝ := - ![C (u : ℂ).re * X 0 - C (u : ℂ).im * X 1, C (u : ℂ).im * X 0 + C (u : ℂ).re * X 1, - C (u : ℂ).re * X 2 - C (u : ℂ).im * X 3, C (u : ℂ).im * X 2 + C (u : ℂ).re * X 3, - C (u : ℂ).re * X 4 + C (u : ℂ).im * X 5, C (u : ℂ).re * X 5 - C (u : ℂ).im * X 4] - -open MvPolynomial in -lemma eval_rotSubst (u : unitary ℂ) (a : Fin 6 → ℝ) : - (fun k => MvPolynomial.eval a (rotSubst u k)) = cartanRotParam u a := by - funext k - fin_cases k <;> - simp [rotSubst, cartanRotParam, Complex.mul_re, Complex.mul_im] <;> ring - -open MvPolynomial in -/-- Gauge (Cartan) invariance of the potential forces the slice polynomial to be invariant under the - hypercharge rotation of its variables. -/ -lemma aeval_rotSubst_eq {V : EffectivePotential} (hI : IsInvariant V) - {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (u : unitary ℂ) : - aeval (rotSubst u) P = P := by - apply MvPolynomial.funext - intro a - have hcomp : eval a (aeval (rotSubst u) P) = P.eval (fun k => eval a (rotSubst u k)) := by - rw [aeval_def, algebraMap_eq, ← MvPolynomial.eval_assoc] - rfl - rw [hcomp, eval_rotSubst, ← hP (cartanRotParam u a), ← gaugeCartan_smul_sliceR, - hI (StandardModel.GaugeGroupI.gaugeCartan u), hP a] - -open MvPolynomial in -/-- The residual `U(1)` rotation of the perpendicular parameter, as a substitution. -/ -noncomputable def resSubst (c : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℝ := - ![X 0, X 1, X 2, X 3, - C (((c : ℂ) ^ 6).re) * X 4 - C (((c : ℂ) ^ 6).im) * X 5, - C (((c : ℂ) ^ 6).im) * X 4 + C (((c : ℂ) ^ 6).re) * X 5] - -open MvPolynomial in -lemma eval_resSubst (c : unitary ℂ) (a : Fin 6 → ℝ) : - (fun k => MvPolynomial.eval a (resSubst c k)) = resRotParam c a := by - funext k - fin_cases k <;> simp [resSubst, resRotParam, Complex.mul_re, Complex.mul_im] - ring - -open MvPolynomial in -/-- Gauge (residual `U(1)`) invariance forces the slice polynomial to be invariant under the - perpendicular rotation of its variables. -/ -lemma aeval_resSubst_eq {V : EffectivePotential} (hI : IsInvariant V) - {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (c : unitary ℂ) : - aeval (resSubst c) P = P := by - apply MvPolynomial.funext - intro a - have hcomp : eval a (aeval (resSubst c) P) = P.eval (fun k => eval a (resSubst c k)) := by - rw [aeval_def, algebraMap_eq, ← MvPolynomial.eval_assoc]; rfl - rw [hcomp, eval_resSubst, ← hP (resRotParam c a), ← ofU1Subgroup_smul_sliceR, - hI (StandardModel.GaugeGroupI.ofU1Subgroup c), hP a] - -open MvPolynomial in -/-- Change to hypercharge eigen-coordinates: `aₖ` in terms of `z, z̄, w₀, w̄₀, w₁, w̄₁` - (indices `0..5`). This diagonalises the gauge-torus rotation into a scaling. -/ -noncomputable def cplxEigen : Fin 6 → MvPolynomial (Fin 6) ℂ := - ![(X 0 + X 1) * C (1 / 2), (X 0 - X 1) * C (-Complex.I / 2), - (X 2 + X 3) * C (1 / 2), (X 2 - X 3) * C (-Complex.I / 2), - (X 4 + X 5) * C (1 / 2), (X 4 - X 5) * C (-Complex.I / 2)] - -open MvPolynomial in -/-- The Cartan hypercharge, diagonal in eigen-coordinates: charges `(1,-1,1,-1,-1,1)`. -/ -noncomputable def diagCartan (u : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℂ := - ![C (u : ℂ) * X 0, C (star (u : ℂ)) * X 1, C (u : ℂ) * X 2, C (star (u : ℂ)) * X 3, - C (star (u : ℂ)) * X 4, C (u : ℂ) * X 5] - -open MvPolynomial in -/-- The residual `U(1)`, diagonal in eigen-coordinates: only the perpendicular pair is charged. -/ -noncomputable def diagRes (c : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℂ := - ![X 0, X 1, X 2, X 3, C ((c : ℂ) ^ 6) * X 4, C (star ((c : ℂ) ^ 6)) * X 5] - -open MvPolynomial in -/-- Conjugation identity: the diagonal Cartan scaling, pulled back through the eigen-coordinate - change, is the (complexified) Cartan rotation substitution. -/ -lemma bind₁_diagCartan_cplxEigen (u : unitary ℂ) (k : Fin 6) : - bind₁ (diagCartan u) (cplxEigen k) - = bind₁ cplxEigen (map (algebraMap ℝ ℂ) (rotSubst u k)) := by - apply MvPolynomial.funext - intro x - fin_cases k <;> - simp only [cplxEigen, diagCartan, rotSubst, Fin.isValue] <;> - (apply Complex.ext <;> - simp [Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, - Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, - Complex.conj_re, Complex.conj_im] <;> ring) - -open MvPolynomial in -/-- Conjugation identity for the residual `U(1)`. -/ -lemma bind₁_diagRes_cplxEigen (c : unitary ℂ) (k : Fin 6) : - bind₁ (diagRes c) (cplxEigen k) - = bind₁ cplxEigen (map (algebraMap ℝ ℂ) (resSubst c k)) := by - apply MvPolynomial.funext - intro x - simp only [diagRes, resSubst] - generalize (c : ℂ) ^ 6 = μ - fin_cases k <;> - simp only [cplxEigen, Fin.isValue] <;> - (apply Complex.ext <;> - simp [Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, - Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, - Complex.conj_re, Complex.conj_im] <;> ring) - -/-- The Cartan hypercharges of `z, z̄, w₀, w̄₀, w₁, w̄₁`. -/ -def chargeA : Fin 6 → ℤ := ![1, -1, 1, -1, -1, 1] - -/-- The residual-`U(1)` hypercharges (only the perpendicular pair is charged). -/ -def chargeB : Fin 6 → ℤ := ![0, 0, 0, 0, 1, -1] - -open MvPolynomial in -/-- The slice potential, complexified and written in hypercharge eigen-coordinates. -/ -noncomputable def Qslice (P : MvPolynomial (Fin 6) ℝ) : MvPolynomial (Fin 6) ℂ := - bind₁ cplxEigen (map (algebraMap ℝ ℂ) P) - -open MvPolynomial in -/-- The Cartan diagonal in the charge form consumed by the charge-balancing engine. -/ -lemma diagCartan_eq (u : unitary ℂ) : - diagCartan u = fun i => C ((u : ℂ) ^ (chargeA i)) * X i := by - have hinv : star (u : ℂ) = (u : ℂ) ^ (-1 : ℤ) := by - rw [zpow_neg_one]; exact (inv_eq_of_mul_eq_one_right u.2.2).symm - funext i - fin_cases i <;> simp [diagCartan, chargeA, hinv] - -open MvPolynomial in -/-- The residual diagonal in the charge form consumed by the engine. -/ -lemma diagRes_eq (c : unitary ℂ) : - diagRes c = fun i => C (((c : ℂ) ^ 6) ^ (chargeB i)) * X i := by - have hinv : star ((c : ℂ) ^ 6) = ((c : ℂ) ^ 6) ^ (-1 : ℤ) := by - rw [zpow_neg_one] - refine (inv_eq_of_mul_eq_one_right ?_).symm - rw [star_pow, ← mul_pow, c.2.2, one_pow] - funext i - fin_cases i <;> simp [diagRes, chargeB, hinv] - -open MvPolynomial in -/-- In eigen-coordinates, the Cartan hypercharge acts by the diagonal scaling, and the slice - potential is invariant under it. -/ -lemma bind₁_diagCartan_Qslice {V : EffectivePotential} (hI : IsInvariant V) - {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (u : unitary ℂ) : - bind₁ (diagCartan u) (Qslice P) = Qslice P := by - simp only [Qslice] - rw [bind₁_bind₁] - simp only [bind₁_diagCartan_cplxEigen] - rw [← bind₁_bind₁, ← map_bind₁] - congr 2 - exact aeval_rotSubst_eq hI hP u - -open MvPolynomial in -/-- Likewise for the residual `U(1)`. -/ -lemma bind₁_diagRes_Qslice {V : EffectivePotential} (hI : IsInvariant V) - {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (c : unitary ℂ) : - bind₁ (diagRes c) (Qslice P) = Qslice P := by - simp only [Qslice] - rw [bind₁_bind₁] - simp only [bind₁_diagRes_cplxEigen] - rw [← bind₁_bind₁, ← map_bind₁] - congr 2 - exact aeval_resSubst_eq hI hP c - -/-- There is a gauge phase of infinite order (`exp i`), needed to run charge balancing. -/ -lemma exists_infiniteOrder_unitary : - ∃ ω : unitary ℂ, ∀ n : ℤ, (ω : ℂ) ^ n = 1 → n = 0 := by - have key : star (Complex.exp Complex.I) * Complex.exp Complex.I = 1 := by - rw [Complex.star_def, ← Complex.exp_conj, Complex.conj_I, ← Complex.exp_add]; simp - have key2 : Complex.exp Complex.I * star (Complex.exp Complex.I) = 1 := by - rw [Complex.star_def, ← Complex.exp_conj, Complex.conj_I, ← Complex.exp_add]; simp - refine ⟨⟨Complex.exp Complex.I, key, key2⟩, fun n hn => ?_⟩ - simp only at hn - rw [← Complex.exp_int_mul, Complex.exp_eq_one_iff] at hn - obtain ⟨k, hk⟩ := hn - have hc : (n : ℂ) = (k : ℂ) * (2 * Real.pi) := by - have hI : (Complex.I) ≠ 0 := Complex.I_ne_zero - apply mul_right_cancel₀ hI - rw [hk]; ring - have hr : (n : ℝ) = (k : ℝ) * (2 * Real.pi) := by exact_mod_cast hc - rcases eq_or_ne k 0 with hk0 | hk0 - · simp [hk0] at hr; exact_mod_cast hr - · exfalso - have h2k : (2 * (k : ℝ)) ≠ 0 := by - simp only [mul_ne_zero_iff]; exact ⟨two_ne_zero, by exact_mod_cast hk0⟩ - have hpi : Real.pi = (n : ℝ) / (2 * (k : ℝ)) := by rw [eq_div_iff h2k, hr]; ring - exact irrational_pi.ne_rat ((n : ℚ) / (2 * (k : ℚ))) (by rw [hpi]; push_cast; ring) - -open MvPolynomial in -/-- **Hypercharge balancing.** Every monomial of the slice potential `Qslice P` (in eigen- - coordinates) that carries nonzero Cartan or residual hypercharge has vanishing coefficient. -/ -lemma coeff_Qslice_eq_zero {V : EffectivePotential} (hI : IsInvariant V) - {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (m : Fin 6 →₀ ℕ) - (hm : (∑ i ∈ m.support, (m i : ℤ) * chargeA i ≠ 0) ∨ - (∑ i ∈ m.support, (m i : ℤ) * chargeB i ≠ 0)) : - coeff m (Qslice P) = 0 := by - obtain ⟨ω, hω⟩ := exists_infiniteOrder_unitary - have hω0 : (ω : ℂ) ≠ 0 := by intro h; have := ω.2.1; rw [h] at this; simp at this - rcases hm with hmA | hmB - · refine coeff_eq_zero_of_charge_ne_zero chargeA (ω : ℂ) hω0 hω ?_ hmA - have h := bind₁_diagCartan_Qslice hI hP ω - rwa [diagCartan_eq] at h - · have hω6 : ((ω : ℂ) ^ 6) ≠ 0 := pow_ne_zero 6 hω0 - have hroot6 : ∀ n : ℤ, ((ω : ℂ) ^ 6) ^ n = 1 → n = 0 := by - intro n hn - rw [← zpow_natCast (ω : ℂ) 6, ← zpow_mul] at hn - have := hω _ hn; omega - refine coeff_eq_zero_of_charge_ne_zero chargeB ((ω : ℂ) ^ 6) hω6 hroot6 ?_ hmB - have h := bind₁_diagRes_Qslice hI hP ω - rwa [diagRes_eq] at h - -/-! - -## C'. Generation of neutral monomials by the bilinears - -The hypercharge-neutral monomials of `Qslice P` are exactly the products of the five neutral -quadratic bilinears `z z̄, w₀ w̄₀, z w̄₀, z̄ w₀, w₁ w̄₁`. This is the (abelian) generation step: -combined Cartan- and residual-neutrality of a monomial forces it to be a product of these five, -because every charged variable carries a unit Cartan charge and the residual charges come in an -exact `±1` pair. - --/ - -open MvPolynomial in -/-- The five hypercharge-neutral quadratic bilinears in eigen-coordinates: - `z z̄`, `w₀ w̄₀`, `z w̄₀`, `z̄ w₀`, `w₁ w̄₁`. -/ -noncomputable def bilin : Fin 5 → MvPolynomial (Fin 6) ℂ := - ![X 0 * X 1, X 2 * X 3, X 0 * X 3, X 1 * X 2, X 4 * X 5] - -/-- The charge of a monomial, summed over the whole index set, equals the sum over its support. -/ -lemma charge_univ_eq_support (w : Fin 6 → ℤ) (m : Fin 6 →₀ ℕ) : - ∑ i, (m i : ℤ) * w i = ∑ i ∈ m.support, (m i : ℤ) * w i := by - symm - apply Finset.sum_subset (Finset.subset_univ _) - intro i _ hi - rw [Finsupp.notMem_support_iff.mp hi]; simp - -/-- A charge sum is additive in the monomial. -/ -lemma chargeSum_add (w : Fin 6 → ℤ) (a b : Fin 6 →₀ ℕ) : - ∑ k, ((a + b) k : ℤ) * w k = (∑ k, (a k : ℤ) * w k) + ∑ k, (b k : ℤ) * w k := by - rw [← Finset.sum_add_distrib] - apply Finset.sum_congr rfl - intro k _ - rw [Finsupp.add_apply]; push_cast; ring - -/-- The charge sum of a single generator is the charge of that variable. -/ -lemma chargeSum_single (w : Fin 6 → ℤ) (i : Fin 6) : - ∑ k, ((Finsupp.single i (1 : ℕ)) k : ℤ) * w k = w i := by - simp [Finsupp.single_apply, ite_mul, Finset.sum_ite_eq] - -open MvPolynomial in -/-- **Generation.** Every hypercharge-neutral monomial is a product of the five bilinears. -/ -lemma monomial_mem_adjoin_bilin (m : Fin 6 →₀ ℕ) - (hA : ∑ i, (m i : ℤ) * chargeA i = 0) (hB : ∑ i, (m i : ℤ) * chargeB i = 0) : - monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range bilin) := by - suffices H : ∀ n : ℕ, ∀ m : Fin 6 →₀ ℕ, (∑ i, m i) = n → - (∑ i, (m i : ℤ) * chargeA i = 0) → (∑ i, (m i : ℤ) * chargeB i = 0) → - monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range bilin) by - exact H (∑ i, m i) m rfl hA hB - intro n - induction n using Nat.strong_induction_on with - | _ n ih => - intro m hsum hA hB - -- The reduction step: pair up two variables whose bilinear is a generator. - have reduce : ∀ i j : Fin 6, i ≠ j → m i ≠ 0 → m j ≠ 0 → - X i * X j ∈ Algebra.adjoin ℂ (Set.range bilin) → - chargeA i + chargeA j = 0 → chargeB i + chargeB j = 0 → - monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range bilin) := by - intro i j hij hmi hmj hgen hcA hcB - have hle : Finsupp.single i 1 + Finsupp.single j 1 ≤ m := by - intro k - rw [Finsupp.add_apply, Finsupp.single_apply, Finsupp.single_apply] - by_cases h1 : i = k - · by_cases h2 : j = k - · exact absurd (h1.trans h2.symm) hij - · rw [if_pos h1, if_neg h2]; subst h1; simpa using Nat.one_le_iff_ne_zero.mpr hmi - · by_cases h2 : j = k - · rw [if_neg h1, if_pos h2]; subst h2; simpa using Nat.one_le_iff_ne_zero.mpr hmj - · rw [if_neg h1, if_neg h2]; simp - set m' := m - (Finsupp.single i 1 + Finsupp.single j 1) with hm'def - have hdecomp : m = (Finsupp.single i 1 + Finsupp.single j 1) + m' := by - rw [hm'def, add_tsub_cancel_of_le hle] - -- m' is still neutral - have hA' : ∑ k, (m' k : ℤ) * chargeA k = 0 := by - have h := hA - rw [hdecomp, chargeSum_add, chargeSum_add, chargeSum_single, chargeSum_single] at h - omega - have hB' : ∑ k, (m' k : ℤ) * chargeB k = 0 := by - have h := hB - rw [hdecomp, chargeSum_add, chargeSum_add, chargeSum_single, chargeSum_single] at h - omega - -- the degree drops by 2 - have hsum' : ∑ k, m' k < n := by - have e : (∑ k, m k) = (∑ k, (Finsupp.single i 1) k) + (∑ k, (Finsupp.single j 1) k) - + ∑ k, m' k := by - rw [← Finset.sum_add_distrib, ← Finset.sum_add_distrib] - apply Finset.sum_congr rfl - intro k _ - rw [← Finsupp.add_apply, ← Finsupp.add_apply, ← hdecomp] - have e1 : ∑ k, (Finsupp.single i 1) k = 1 := by - simp [Finsupp.single_apply, Finset.sum_ite_eq] - have e2 : ∑ k, (Finsupp.single j 1) k = 1 := by - simp [Finsupp.single_apply, Finset.sum_ite_eq] - rw [hsum, e1, e2] at e - omega - -- factor and recurse - have hfact : monomial m (1 : ℂ) = (X i * X j) * monomial m' 1 := by - rw [hdecomp, - show (X i : MvPolynomial (Fin 6) ℂ) = monomial (Finsupp.single i 1) 1 from - by rw [← X_pow_eq_monomial, pow_one], - show (X j : MvPolynomial (Fin 6) ℂ) = monomial (Finsupp.single j 1) 1 from - by rw [← X_pow_eq_monomial, pow_one], - monomial_mul, monomial_mul, one_mul, one_mul, add_assoc] - rw [hfact] - exact Subalgebra.mul_mem _ hgen (ih (∑ k, m' k) hsum' m' rfl hA' hB') - -- main case split - rcases eq_or_ne n 0 with hn0 | hn0 - · -- degree zero: m = 0, monomial is 1 - have hm0 : m = 0 := by - ext k - have hk : m k ≤ ∑ i, m i := Finset.single_le_sum (fun _ _ => Nat.zero_le _) (Finset.mem_univ k) - rw [hsum, hn0] at hk - simpa using Nat.le_zero.mp hk - rw [hm0] - have h1 : monomial (0 : Fin 6 →₀ ℕ) (1 : ℂ) = 1 := by simp - rw [h1]; exact Subalgebra.one_mem _ - · -- positive degree: find a neutral pair - rcases eq_or_ne (m 4) 0 with h4 | h4 - · -- m 4 = 0; then m 5 = 0 by residual neutrality - have h5 : m 5 = 0 := by - have h := hB - simp [chargeB, Fin.sum_univ_six] at h - omega - -- Cartan neutrality on {0,1,2,3}: m0 + m2 = m1 + m3 - have hcart : (m 0 : ℤ) + (m 2 : ℤ) = (m 1 : ℤ) + (m 3 : ℤ) := by - have h := hA - simp [chargeA, Fin.sum_univ_six] at h - omega - -- total degree on {0,1,2,3} is n > 0 - have hposL : 0 < m 0 + m 2 := by - rcases Nat.eq_zero_or_pos (m 0 + m 2) with hc | hc - · exfalso - have h02 : m 0 = 0 ∧ m 2 = 0 := by omega - have h13 : m 1 = 0 ∧ m 3 = 0 := by omega - have hz : ∑ i, m i = 0 := by - simp [Fin.sum_univ_six, h02.1, h02.2, h13.1, h13.2, h4, h5] - rw [hsum] at hz; exact hn0 hz - · exact hc - have hposR : 0 < m 1 + m 3 := by omega - -- choose a positive index in {0,2} and one in {1,3} - rcases Nat.eq_zero_or_pos (m 0) with hm0 | hm0 - · -- m 0 = 0, so m 2 > 0 - have hm2 : m 2 ≠ 0 := by omega - rcases Nat.eq_zero_or_pos (m 1) with hm1 | hm1 - · -- m 1 = 0, so m 3 > 0 : pair (2,3) -> bilin 1 - have hm3 : m 3 ≠ 0 := by omega - refine reduce 2 3 (by decide) hm2 hm3 ?_ (by decide) (by decide) - exact Algebra.subset_adjoin ⟨1, rfl⟩ - · -- m 1 > 0 : pair (1,2) -> bilin 3 - refine reduce 1 2 (by decide) (by omega) hm2 ?_ (by decide) (by decide) - exact Algebra.subset_adjoin ⟨3, rfl⟩ - · -- m 0 > 0 - rcases Nat.eq_zero_or_pos (m 1) with hm1 | hm1 - · -- m 1 = 0, so m 3 > 0 : pair (0,3) -> bilin 2 - have hm3 : m 3 ≠ 0 := by omega - refine reduce 0 3 (by decide) (by omega) hm3 ?_ (by decide) (by decide) - exact Algebra.subset_adjoin ⟨2, rfl⟩ - · -- m 1 > 0 : pair (0,1) -> bilin 0 - refine reduce 0 1 (by decide) (by omega) (by omega) ?_ (by decide) (by decide) - exact Algebra.subset_adjoin ⟨0, rfl⟩ - · -- m 4 > 0; then m 5 > 0 : pair (4,5) -> bilin 4 - have h5 : m 5 ≠ 0 := by - have h := hB - simp [chargeB, Fin.sum_univ_six] at h - omega - refine reduce 4 5 (by decide) h4 h5 ?_ (by decide) (by decide) - exact Algebra.subset_adjoin ⟨4, rfl⟩ - -open MvPolynomial in -/-- The slice potential lies in the subalgebra generated by the five bilinears: every monomial that - survives is hypercharge-neutral, hence a product of the bilinears. -/ -lemma Qslice_mem_adjoin_bilin {V : EffectivePotential} (hI : IsInvariant V) - {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) : - Qslice P ∈ Algebra.adjoin ℂ (Set.range bilin) := by - rw [(Qslice P).as_sum] - apply Subalgebra.sum_mem - intro m hm - have hcoeff : coeff m (Qslice P) ≠ 0 := MvPolynomial.mem_support_iff.mp hm - have hsuppA : ∑ i ∈ m.support, (m i : ℤ) * chargeA i = 0 := by - by_contra h0 - exact hcoeff (coeff_Qslice_eq_zero hI hP m (Or.inl h0)) - have hsuppB : ∑ i ∈ m.support, (m i : ℤ) * chargeB i = 0 := by - by_contra h0 - exact hcoeff (coeff_Qslice_eq_zero hI hP m (Or.inr h0)) - have hmono : monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range bilin) := - monomial_mem_adjoin_bilin m - ((charge_univ_eq_support chargeA m).trans hsuppA) - ((charge_univ_eq_support chargeB m).trans hsuppB) - have hrw : monomial m (coeff m (Qslice P)) = C (coeff m (Qslice P)) * monomial m 1 := by - rw [C_mul_monomial, mul_one] - rw [hrw] - exact Subalgebra.mul_mem _ - (by rw [← MvPolynomial.algebraMap_eq]; exact Subalgebra.algebraMap_mem _ _) hmono - -open MvPolynomial in -/-- Consequently the complexified slice potential is `aeval bilin G` for some polynomial `G` in the - five bilinears. -/ -lemma exists_aeval_bilin {V : EffectivePotential} (hI : IsInvariant V) - {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) : - ∃ G : MvPolynomial (Fin 5) ℂ, aeval bilin G = Qslice P := by - have h := Qslice_mem_adjoin_bilin hI hP - rw [Algebra.adjoin_range_eq_range_aeval ℂ bilin] at h - obtain ⟨G, hG⟩ := h - exact ⟨G, hG⟩ - -/-! ### Evaluating at the eigen-point of a representative -/ - -/-- The slice parameters realising `repHiggs X` as a point of the slice family. -/ -def aRep (X : Fin 4 → ℝ) : Fin 6 → ℝ := ![X 0, 0, X 1, X 2, X 3, 0] - -lemma repHiggs_eq_sliceR (X : Fin 4 → ℝ) : repHiggs X = sliceR (aRep X) := by - rw [repHiggs_eq_sliceHiggs, sliceR_apply] - simp [aRep] - -/-- The hypercharge eigen-point `(z, z̄, w₀, w̄₀, w₁, w̄₁)` of `repHiggs X`: here `z = X₀` is real, - `w₀ = X₁ + i X₂` and `w₁ = X₃` is real. -/ -noncomputable def eigenPt (X : Fin 4 → ℝ) : Fin 6 → ℂ := - ![(X 0 : ℂ), (X 0 : ℂ), (X 1 : ℂ) + Complex.I * (X 2 : ℂ), (X 1 : ℂ) - Complex.I * (X 2 : ℂ), - (X 3 : ℂ), (X 3 : ℂ)] - -open MvPolynomial in -/-- The eigen-coordinate change sends the eigen-point of `repHiggs X` back to its slice parameters. -/ -lemma aeval_cplxEigen_eigenPt (X : Fin 4 → ℝ) (k : Fin 6) : - aeval (eigenPt X) (cplxEigen k) = algebraMap ℝ ℂ (aRep X k) := by - fin_cases k <;> - simp only [cplxEigen, eigenPt, aRep, Fin.isValue] <;> - (apply Complex.ext <;> - simp [Complex.add_re, Complex.add_im, Complex.mul_re, - Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im] <;> ring) - -open MvPolynomial in -/-- The complexified slice potential, evaluated at the eigen-point of `repHiggs X`, returns the real - value `V (repHiggs X)`. -/ -lemma eval_Qslice_eigenPt (P : MvPolynomial (Fin 6) ℝ) (X : Fin 4 → ℝ) : - eval (eigenPt X) (Qslice P) = algebraMap ℝ ℂ (P.eval (aRep X)) := by - rw [Qslice, ← aeval_eq_eval, aeval_bind₁, - show (fun i => aeval (eigenPt X) (cplxEigen i)) = (fun i => (Algebra.ofId ℝ ℂ) (aRep X i)) from - funext (fun i => (aeval_cplxEigen_eigenPt X i).trans (Algebra.ofId_apply ℂ (aRep X i)).symm), - MvPolynomial.aeval_map_algebraMap ℂ, ← MvPolynomial.comp_aeval] - simp [aeval_eq_eval, Algebra.ofId_apply] - -/-! ### Real-part descent: from a complex value back to a real polynomial -/ - -open MvPolynomial in -/-- The real part of a complex polynomial, taken coefficient-wise. -/ -noncomputable def realPart (H : MvPolynomial (Fin 5) ℂ) : MvPolynomial (Fin 5) ℝ := - Finsupp.mapRange Complex.re Complex.zero_re H - -open MvPolynomial in -@[simp] lemma realPart_coeff (H : MvPolynomial (Fin 5) ℂ) (m : Fin 5 →₀ ℕ) : - coeff m (realPart H) = (coeff m H).re := Finsupp.mapRange_apply - -open MvPolynomial in -lemma realPart_C (a : ℂ) : realPart (C a) = C a.re := by - ext m; rw [realPart_coeff, coeff_C, coeff_C]; split_ifs <;> simp - -open MvPolynomial in -lemma realPart_add (p q : MvPolynomial (Fin 5) ℂ) : - realPart (p + q) = realPart p + realPart q := by - ext m; simp [Complex.add_re] - -open MvPolynomial in -lemma realPart_mul_X (p : MvPolynomial (Fin 5) ℂ) (i : Fin 5) : - realPart (p * X i) = realPart p * X i := by - ext m - rw [realPart_coeff, coeff_mul_X', coeff_mul_X', realPart_coeff] - split_ifs <;> simp - -open MvPolynomial in -/-- Evaluating a complex polynomial at a real point and taking the real part is the same as - evaluating its real part. -/ -lemma realPart_eval (H : MvPolynomial (Fin 5) ℂ) (y : Fin 5 → ℝ) : - (eval (fun j => (↑(y j) : ℂ)) H).re = (realPart H).eval y := by - induction H using MvPolynomial.induction_on with - | C a => rw [realPart_C]; simp - | add p q hp hq => rw [realPart_add, map_add, map_add, Complex.add_re, hp, hq] - | mul_X p i hp => - rw [realPart_mul_X, map_mul, map_mul, eval_X, eval_X, Complex.mul_re, Complex.ofReal_re, - Complex.ofReal_im, mul_zero, sub_zero, hp] - -/-! ### Condition A: the value is a polynomial in the five bilinear generators -/ - -/-- The five real bilinear generators of `T'`, evaluated at `repHiggs X`: - `‖Φ1‖², Re⟪⟫, Im⟪⟫, |Φ2₀|², |Φ2₁|²`. -/ -def realGen (X : Fin 4 → ℝ) : Fin 5 → ℝ := - ![X 0 ^ 2, X 0 * X 1, X 0 * X 2, X 1 ^ 2 + X 2 ^ 2, X 3 ^ 2] - -open MvPolynomial in -/-- The complex substitution expressing each bilinear, at the eigen-point, through the real - generators (the off-diagonal pair `z w̄₀, z̄ w₀` mix `Re⟪⟫` and `Im⟪⟫`). -/ -noncomputable def transf : Fin 5 → MvPolynomial (Fin 5) ℂ := - ![X 0, X 3, X 1 - C Complex.I * X 2, X 1 + C Complex.I * X 2, X 4] - -open MvPolynomial in -/-- The bilinears at the eigen-point of `repHiggs X` are the real generators, read through `transf`. -/ -lemma bilin_eval_eigenPt (X : Fin 4 → ℝ) (i : Fin 5) : - eval (eigenPt X) (bilin i) = eval (fun j => (↑(realGen X j) : ℂ)) (transf i) := by - fin_cases i <;> - simp only [bilin, transf, eigenPt, realGen, Fin.isValue] <;> - (apply Complex.ext <;> - simp [pow_two, Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, - Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im] <;> ring) - -open MvPolynomial in -/-- Pushing an evaluation through an `aeval` substitution. -/ -lemma eval_aeval_comp {R : Type*} [CommRing R] {κ ι : Type*} (x : ι → R) - (f : κ → MvPolynomial ι R) (G : MvPolynomial κ R) : - eval x (aeval f G) = eval (fun i => eval x (f i)) G := by - rw [show (aeval f) G = bind₁ f G from rfl, ← aeval_eq_eval x, aeval_bind₁] - simp [aeval_eq_eval] - -open MvPolynomial in -/-- **Condition A.** A gauge-invariant polynomial potential, on the representative family, is a - polynomial in the five real bilinear generators `‖Φ1‖², Re⟪⟫, Im⟪⟫, |Φ2₀|², |Φ2₁|²`. -/ -lemma exists_polynomial_repHiggs_realGen {V : EffectivePotential} {n : ℕ} - (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : - ∃ p : MvPolynomial (Fin 5) ℝ, ∀ X : Fin 4 → ℝ, V (repHiggs X) = p.eval (realGen X) := by - obtain ⟨P, hP⟩ := h.exists_comp_linear_poly sliceR - obtain ⟨G, hG⟩ := exists_aeval_bilin hI hP - refine ⟨realPart (aeval transf G), fun X => ?_⟩ - have hval : (algebraMap ℝ ℂ) (V (repHiggs X)) - = eval (fun j => (↑(realGen X j) : ℂ)) (aeval transf G) := by - rw [repHiggs_eq_sliceR, hP, ← eval_Qslice_eigenPt, ← hG] - simp only [eval_aeval_comp] - rw [show (fun i => eval (eigenPt X) (bilin i)) - = (fun i => eval (fun j => (↑(realGen X j) : ℂ)) (transf i)) from - funext (bilin_eval_eigenPt X)] - have hre : V (repHiggs X) = (eval (fun j => (↑(realGen X j) : ℂ)) (aeval transf G)).re := by - rw [← hval]; simp - rw [hre, realPart_eval] - -/-! ### Clearing the `‖Φ1‖²` denominator: Condition A value times `‖Φ1‖²ᴺ` is a Gram polynomial -/ - -open MvPolynomial in -/-- The five bilinear generators, as polynomials in the four representative parameters. -/ -noncomputable def realGenP : Fin 5 → MvPolynomial (Fin 4) ℝ := - ![X 0 ^ 2, X 0 * X 1, X 0 * X 2, X 1 ^ 2 + X 2 ^ 2, X 3 ^ 2] - -open MvPolynomial in -/-- The four Gram components, as polynomials in the four representative parameters. -/ -noncomputable def gramP : Fin 1 ⊕ Fin 3 → MvPolynomial (Fin 4) ℝ := - Sum.elim (fun _ => X 0 ^ 2 + (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2)) - ![2 * (X 0 * X 1), 2 * (X 0 * X 2), X 0 ^ 2 - (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2)] - -open MvPolynomial in -@[simp] lemma realGenP_eval (X : Fin 4 → ℝ) (i : Fin 5) : (realGenP i).eval X = realGen X i := by - fin_cases i <;> simp [realGenP, realGen] - -open MvPolynomial in -@[simp] lemma gramP_eval (X : Fin 4 → ℝ) (μ : Fin 1 ⊕ Fin 3) : - (gramP μ).eval X = (repHiggs X).gramVector μ := by - match μ with - | Sum.inl 0 => simp [gramP] - | Sum.inr 0 => simp [gramP]; ring - | Sum.inr 1 => simp [gramP]; ring - | Sum.inr 2 => simp [gramP] - -open MvPolynomial in -/-- Some power of `‖Φ1‖² = X₀²` times the Condition-A value polynomial lies in the Gram - subalgebra: multiplying by `X₀²` pairs each `X₁²+X₂²` into `(X₀X₁)²+(X₀X₂)²` and each `X₃²` into - the determinant `X₀²X₃²`, both of which are Gram polynomials. -/ -lemma exists_clearing_mem (p : MvPolynomial (Fin 5) ℝ) : - ∃ N : ℕ, (X 0) ^ (2 * N) * aeval realGenP p ∈ Algebra.adjoin ℝ (Set.range gramP) := by - set S := Algebra.adjoin ℝ (Set.range gramP) with hS - have hgmem : ∀ μ, gramP μ ∈ S := fun μ => Algebra.subset_adjoin ⟨μ, rfl⟩ - have hC : ∀ r : ℝ, (C r : MvPolynomial (Fin 4) ℝ) ∈ S := fun r => by - rw [← MvPolynomial.algebraMap_eq]; exact Subalgebra.algebraMap_mem _ _ - have hX0sq : (X 0 ^ 2 : MvPolynomial (Fin 4) ℝ) ∈ S := by - have e : (X 0 ^ 2 : MvPolynomial (Fin 4) ℝ) - = C (1 / 2) * (gramP (Sum.inl 0) + gramP (Sum.inr 2)) := by - apply MvPolynomial.funext; intro x; simp [gramP]; ring - rw [e]; exact Subalgebra.mul_mem _ (hC _) (Subalgebra.add_mem _ (hgmem _) (hgmem _)) - have hX0X1 : (X 0 * X 1 : MvPolynomial (Fin 4) ℝ) ∈ S := by - have e : (X 0 * X 1 : MvPolynomial (Fin 4) ℝ) = C (1 / 2) * gramP (Sum.inr 0) := by - apply MvPolynomial.funext; intro x; simp [gramP] - rw [e]; exact Subalgebra.mul_mem _ (hC _) (hgmem _) - have hX0X2 : (X 0 * X 2 : MvPolynomial (Fin 4) ℝ) ∈ S := by - have e : (X 0 * X 2 : MvPolynomial (Fin 4) ℝ) = C (1 / 2) * gramP (Sum.inr 1) := by - apply MvPolynomial.funext; intro x; simp [gramP] - rw [e]; exact Subalgebra.mul_mem _ (hC _) (hgmem _) - have hmm : (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2 : MvPolynomial (Fin 4) ℝ) ∈ S := by - have e : (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2 : MvPolynomial (Fin 4) ℝ) - = C (1 / 2) * (gramP (Sum.inl 0) - gramP (Sum.inr 2)) := by - apply MvPolynomial.funext; intro x; simp [gramP]; ring - rw [e]; exact Subalgebra.mul_mem _ (hC _) (Subalgebra.sub_mem _ (hgmem _) (hgmem _)) - have her : (X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2) : MvPolynomial (Fin 4) ℝ) ∈ S := by - have e : (X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2) : MvPolynomial (Fin 4) ℝ) - = (X 0 * X 1) ^ 2 + (X 0 * X 2) ^ 2 := by ring - rw [e]; exact Subalgebra.add_mem _ (pow_mem hX0X1 2) (pow_mem hX0X2 2) - have hes : (X 0 ^ 2 * X 3 ^ 2 : MvPolynomial (Fin 4) ℝ) ∈ S := by - have e : (X 0 ^ 2 * X 3 ^ 2 : MvPolynomial (Fin 4) ℝ) - = X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2) - X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2) := by ring - rw [e]; exact Subalgebra.sub_mem _ (Subalgebra.mul_mem _ hX0sq hmm) her - induction p using MvPolynomial.induction_on' with - | monomial m c => - refine ⟨m 3 + m 4, ?_⟩ - have hmemRHS : C c * ((X 0 ^ 2) ^ m 0 * (X 0 * X 1) ^ m 1 * (X 0 * X 2) ^ m 2 * - (X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2)) ^ m 3 * (X 0 ^ 2 * X 3 ^ 2) ^ m 4) ∈ S := - Subalgebra.mul_mem _ (hC _) (Subalgebra.mul_mem _ (Subalgebra.mul_mem _ - (Subalgebra.mul_mem _ (Subalgebra.mul_mem _ (pow_mem hX0sq _) (pow_mem hX0X1 _)) - (pow_mem hX0X2 _)) (pow_mem her _)) (pow_mem hes _)) - rw [aeval_monomial, Finsupp.prod_fintype _ _ (fun i => by simp), Fin.prod_univ_five] - simp only [realGenP, Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val, Fin.isValue, - MvPolynomial.algebraMap_eq] - convert hmemRHS using 1 - rw [pow_mul, pow_add] - simp only [mul_pow] - ring - | add p q hp hq => - obtain ⟨Np, hp'⟩ := hp - obtain ⟨Nq, hq'⟩ := hq - refine ⟨max Np Nq, ?_⟩ - rw [map_add, mul_add] - apply Subalgebra.add_mem - · rw [show 2 * max Np Nq = 2 * (max Np Nq - Np) + 2 * Np from by omega, pow_add, mul_assoc] - exact Subalgebra.mul_mem _ (by rw [pow_mul]; exact pow_mem hX0sq _) hp' - · rw [show 2 * max Np Nq = 2 * (max Np Nq - Nq) + 2 * Nq from by omega, pow_add, mul_assoc] - exact Subalgebra.mul_mem _ (by rw [pow_mul]; exact pow_mem hX0sq _) hq' - -open MvPolynomial in -/-- **Denominator clearing.** For the Condition-A value polynomial `p`, some power of `‖Φ1‖² = X₀²` - times `p ∘ realGen` is a polynomial in the Gram vector. -/ -lemma exists_gram_clearing (p : MvPolynomial (Fin 5) ℝ) : - ∃ (A : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) (N : ℕ), ∀ X : Fin 4 → ℝ, - (X 0) ^ (2 * N) * p.eval (realGen X) = A.eval ((repHiggs X).gramVector) := by - obtain ⟨N, hmem⟩ := exists_clearing_mem p - rw [Algebra.adjoin_range_eq_range_aeval ℝ gramP] at hmem - obtain ⟨A, hA⟩ := hmem - change aeval gramP A = _ at hA - refine ⟨A, N, fun X => ?_⟩ - have hL : eval X (aeval gramP A) = A.eval ((repHiggs X).gramVector) := by - rw [eval_aeval_comp]; simp only [gramP_eval] - have hR : eval X (MvPolynomial.X 0 ^ (2 * N) * aeval realGenP p) - = (X 0) ^ (2 * N) * p.eval (realGen X) := by - rw [map_mul, map_pow, eval_X, eval_aeval_comp]; simp only [realGenP_eval] - rw [← hR, ← hL, hA] - -open MvPolynomial in -/-- **`‖Φ1‖²`-clearing, on all configurations.** A power of `‖Φ1‖²` times a gauge-invariant - polynomial potential is, everywhere, a polynomial in the Gram vector. -/ -lemma exists_clearing_all {V : EffectivePotential} {n : ℕ} - (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : - ∃ (A : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) (N : ℕ), ∀ φ : TwoHiggsDoublet, - (‖φ.Φ1‖ ^ 2) ^ N * V φ = A.eval φ.gramVector := by - obtain ⟨p5, hp5⟩ := exists_polynomial_repHiggs_realGen hI h - obtain ⟨A, N, hAN⟩ := exists_gram_clearing p5 - refine ⟨A, N, fun φ => ?_⟩ - obtain ⟨X, g, hg⟩ := exists_smul_eq_repHiggs φ - have hV : V φ = V (repHiggs X) := by rw [← hg]; exact (hI g φ).symm - have hgram : φ.gramVector = (repHiggs X).gramVector := by - rw [← hg]; funext μ; exact (gaugeGroupI_smul_fst_gramVector g φ μ).symm - have hΦ1 : ‖φ.Φ1‖ ^ 2 = (X 0) ^ 2 := by - rw [normSq_Φ1_eq_gramVector, hgram, ← normSq_Φ1_eq_gramVector, normSq_repHiggs_Φ1] - rw [hΦ1, hV, hgram, ← pow_mul, hp5] - exact hAN X - -/-! ### Swapping the two doublets (to clear the `‖Φ2‖²` denominator) -/ - -/-- Swapping the two doublets, as an `ℝ`-linear map. It commutes with the gauge action, so it sends - gauge-invariant polynomial potentials to gauge-invariant polynomial potentials, but turns the - alignment of `Φ1` into the alignment of `Φ2`. -/ -def swapDoublet : TwoHiggsDoublet →ₗ[ℝ] TwoHiggsDoublet where - toFun φ := { Φ1 := φ.Φ2, Φ2 := φ.Φ1 } - map_add' _ _ := rfl - map_smul' _ _ := rfl - -@[simp] lemma swapDoublet_Φ1 (φ : TwoHiggsDoublet) : (swapDoublet φ).Φ1 = φ.Φ2 := rfl -@[simp] lemma swapDoublet_Φ2 (φ : TwoHiggsDoublet) : (swapDoublet φ).Φ2 = φ.Φ1 := rfl - -@[simp] lemma swapDoublet_swapDoublet (φ : TwoHiggsDoublet) : swapDoublet (swapDoublet φ) = φ := by - apply ext_of_fst_snd <;> rfl - -lemma swapDoublet_smul (g : StandardModel.GaugeGroupI) (φ : TwoHiggsDoublet) : - swapDoublet (g • φ) = g • swapDoublet φ := by - apply ext_of_fst_snd <;> simp - -/-- Swapping the doublets sends the gram vector through the sign flip of the imaginary and - difference components. -/ -lemma gramVector_swapDoublet_inl (φ : TwoHiggsDoublet) : - (swapDoublet φ).gramVector (Sum.inl 0) = φ.gramVector (Sum.inl 0) := by - rw [gramVector_inl_zero_eq, gramVector_inl_zero_eq, swapDoublet_Φ1, swapDoublet_Φ2]; ring - -lemma gramVector_swapDoublet_inr0 (φ : TwoHiggsDoublet) : - (swapDoublet φ).gramVector (Sum.inr 0) = φ.gramVector (Sum.inr 0) := by - rw [gramVector_inr_zero_eq, gramVector_inr_zero_eq, swapDoublet_Φ1, swapDoublet_Φ2, - ← inner_conj_symm, Complex.conj_re] - -lemma gramVector_swapDoublet_inr1 (φ : TwoHiggsDoublet) : - (swapDoublet φ).gramVector (Sum.inr 1) = -φ.gramVector (Sum.inr 1) := by - rw [gramVector_inr_one_eq, gramVector_inr_one_eq, swapDoublet_Φ1, swapDoublet_Φ2, - ← inner_conj_symm, Complex.conj_im]; ring - -lemma gramVector_swapDoublet_inr2 (φ : TwoHiggsDoublet) : - (swapDoublet φ).gramVector (Sum.inr 2) = -φ.gramVector (Sum.inr 2) := by - rw [gramVector_inr_two_eq, gramVector_inr_two_eq, swapDoublet_Φ1, swapDoublet_Φ2]; ring - -lemma HasMaxMassDimLE.comp_swapDoublet {V : EffectivePotential} {n : ℕ} - (h : HasMaxMassDimLE V n) : HasMaxMassDimLE (fun φ => V (swapDoublet φ)) n := by - obtain ⟨p, hp, hdeg⟩ := h - refine ⟨MvPolynomial.rename - (fun i : Module.Dual ℝ TwoHiggsDoublet => i.comp swapDoublet) p, fun φ => ?_, ?_⟩ - · change V (swapDoublet φ) = _ - rw [MvPolynomial.eval_rename, hp (swapDoublet φ)]; rfl - · exact le_trans (MvPolynomial.totalDegree_rename_le _ _) hdeg - -lemma IsInvariant.comp_swapDoublet {V : EffectivePotential} (hI : IsInvariant V) : - IsInvariant (fun φ => V (swapDoublet φ)) := by - intro g φ - show V (swapDoublet (g • φ)) = V (swapDoublet φ) - rw [swapDoublet_smul, hI g] - -open MvPolynomial in -/-- The Gram-vector substitution induced by swapping the doublets (sign flip on the imaginary and - difference components). -/ -noncomputable def swapSubst : (Fin 1 ⊕ Fin 3) → MvPolynomial (Fin 1 ⊕ Fin 3) ℝ := - Sum.elim (fun _ => X (Sum.inl 0)) ![X (Sum.inr 0), -X (Sum.inr 1), -X (Sum.inr 2)] - -open MvPolynomial in -/-- **`‖Φ2‖²`-clearing, on all configurations.** A power of `‖Φ2‖²` times a gauge-invariant - polynomial potential is, everywhere, a polynomial in the Gram vector. Obtained from - `exists_clearing_all` for the doublet-swapped potential. -/ -lemma exists_clearing_all_snd {V : EffectivePotential} {n : ℕ} - (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : - ∃ (B : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) (M : ℕ), ∀ φ : TwoHiggsDoublet, - (‖φ.Φ2‖ ^ 2) ^ M * V φ = B.eval φ.gramVector := by - obtain ⟨B0, M, hB0⟩ := exists_clearing_all hI.comp_swapDoublet h.comp_swapDoublet - refine ⟨aeval swapSubst B0, M, fun φ => ?_⟩ - have hb := hB0 (swapDoublet φ) - simp only [swapDoublet_Φ1, swapDoublet_swapDoublet] at hb - have hpt : (swapDoublet φ).gramVector = fun μ => eval φ.gramVector (swapSubst μ) := by - funext μ - match μ with - | Sum.inl 0 => simp [swapSubst, gramVector_swapDoublet_inl] - | Sum.inr 0 => simp [swapSubst, gramVector_swapDoublet_inr0] - | Sum.inr 1 => simp [swapSubst, gramVector_swapDoublet_inr1] - | Sum.inr 2 => simp [swapSubst, gramVector_swapDoublet_inr2] - rw [hb, eval_aeval_comp, hpt] - -/-! - -## C. Reduction to the polynomial family of orbit representatives - -The two structural ingredients of the proof live elsewhere: - -* `TwoHiggsDoublet.exists_smul_eq_repHiggs` shows every configuration is gauge equivalent to a - representative `repHiggs X` from the *polynomial* family of orbit representatives, and -* `TwoHiggsDoublet.gramVector_repHiggs_*` show the Gram vector of a representative is a polynomial - in the four real parameters `X` (with no square roots). - -Because the potential is gauge invariant, its value on any configuration equals its value on a -representative, and the Gram vector is likewise unchanged. Hence the whole statement reduces to the -question of whether `V ∘ repHiggs` is a polynomial in the (polynomial) Gram components of the -representative family — see `exists_polynomial_on_repHiggs`. - --/ - -/-! **The two Higgs doublet model first fundamental theorem (representative form).** - -`exists_polynomial_on_repHiggs` is the irreducible invariant–theoretic core: a gauge invariant -polynomial potential, restricted to the polynomial family of orbit representatives `repHiggs X`, is -a polynomial in the Gram components of that family. It is the non-abelian `SU(2)` first fundamental -theorem specialised to two doublets in `ℂ²`, proved here by the *doublet-swap* argument: clearing -the `‖Φ1‖²` denominator (aligning `Φ1`) and the `‖Φ2‖²` denominator (aligning `Φ2`, via the -gauge-commuting swap), then using that `‖Φ1‖²` and `‖Φ2‖²` are coprime in the Gram ring. -/ - -open MvPolynomial in -/-- The four Gram generators are algebraically independent: the Gram substitution is injective. -/ -lemma gramP_injective : - Function.Injective (aeval gramP : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ → MvPolynomial (Fin 4) ℝ) := by - rw [injective_iff_map_eq_zero] - intro P hP - -- `P` vanishes on every Gram vector of a representative. - have hvanish : ∀ y : Fin 4 → ℝ, P.eval ((repHiggs y).gramVector) = 0 := by - intro y - have h := congrArg (eval y) hP - rw [eval_aeval_comp, map_zero] at h - rwa [show (fun μ => eval y (gramP μ)) = (repHiggs y).gramVector from funext (gramP_eval y)] at h - -- The Gram cone contains an infinite box; `P` vanishes there, hence `P = 0`. - refine MvPolynomial.funext_set - (fun μ => Sum.elim (fun _ => Set.Ioi (2 : ℝ)) (fun _ => Set.Ioo (-1 : ℝ) 1) μ) ?_ ?_ - · intro μ - rcases μ with _ | i - · exact Set.Ioi_infinite _ - · exact Set.Ioo_infinite (by norm_num) - · intro x hx - rw [Set.mem_univ_pi] at hx - have hxl : (2 : ℝ) < x (Sum.inl 0) := hx (Sum.inl 0) - have hx0 : x (Sum.inr 0) ∈ Set.Ioo (-1 : ℝ) 1 := hx (Sum.inr 0) - have hx1 : x (Sum.inr 1) ∈ Set.Ioo (-1 : ℝ) 1 := hx (Sum.inr 1) - have hx2 : x (Sum.inr 2) ∈ Set.Ioo (-1 : ℝ) 1 := hx (Sum.inr 2) - have hdpos : 0 < (x (Sum.inl 0) + x (Sum.inr 2)) / 2 := by have := hx2.1; linarith - set y0 : ℝ := Real.sqrt ((x (Sum.inl 0) + x (Sum.inr 2)) / 2) with hy0def - have hy0pos : 0 < y0 := Real.sqrt_pos.mpr hdpos - have hy0sq : y0 ^ 2 = (x (Sum.inl 0) + x (Sum.inr 2)) / 2 := - Real.sq_sqrt hdpos.le - set y1 : ℝ := x (Sum.inr 0) / (2 * y0) with hy1def - set y2 : ℝ := x (Sum.inr 1) / (2 * y0) with hy2def - -- the perpendicular component squared is nonnegative (PSD condition on the box) - have hbound : x (Sum.inr 0) ^ 2 + x (Sum.inr 1) ^ 2 - ≤ x (Sum.inl 0) ^ 2 - x (Sum.inr 2) ^ 2 := by - nlinarith [hx0.1, hx0.2, hx1.1, hx1.2, hx2.1, hx2.2, hxl] - have h2y0sq : (2 * y0) ^ 2 = 2 * (x (Sum.inl 0) + x (Sum.inr 2)) := by - rw [mul_pow, hy0sq]; ring - have hsumpos : 0 < x (Sum.inl 0) + x (Sum.inr 2) := by linarith [hx2.1] - have hkey : 2 * (x (Sum.inl 0) + x (Sum.inr 2)) * (y1 ^ 2 + y2 ^ 2) - = x (Sum.inr 0) ^ 2 + x (Sum.inr 1) ^ 2 := by - rw [hy1def, hy2def, div_pow, div_pow, ← h2y0sq] - field_simp - have hy3arg : 0 ≤ (x (Sum.inl 0) - x (Sum.inr 2)) / 2 - y1 ^ 2 - y2 ^ 2 := by - nlinarith [hkey, hbound, hsumpos] - set y3 : ℝ := Real.sqrt ((x (Sum.inl 0) - x (Sum.inr 2)) / 2 - y1 ^ 2 - y2 ^ 2) with hy3def - have hy3sq : y3 ^ 2 = (x (Sum.inl 0) - x (Sum.inr 2)) / 2 - y1 ^ 2 - y2 ^ 2 := - Real.sq_sqrt hy3arg - have hgram : (repHiggs ![y0, y1, y2, y3]).gramVector = x := by - funext μ - match μ with - | Sum.inl 0 => - rw [gramVector_repHiggs_inl] - simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val, Fin.isValue] - rw [hy0sq, hy3sq]; ring - | Sum.inr 0 => - rw [gramVector_repHiggs_inr0] - simp only [Matrix.cons_val_zero, Matrix.cons_val_one] - rw [hy1def]; field_simp - | Sum.inr 1 => - rw [gramVector_repHiggs_inr1] - simp only [Matrix.cons_val_zero, Matrix.cons_val, Fin.isValue] - rw [hy2def]; field_simp - | Sum.inr 2 => - rw [gramVector_repHiggs_inr2] - simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val, Fin.isValue] - rw [hy0sq, hy3sq]; ring - rw [map_zero, ← hgram] - exact hvanish ![y0, y1, y2, y3] - -open MvPolynomial in -/-- `‖Φ1‖²` and `‖Φ2‖²`, as the distinct linear forms `(g₀±g₃)/2` of the Gram ring, are coprime: - if `‖Φ1‖²ᴺ · B = ‖Φ2‖²ᴹ · A` then `‖Φ1‖²ᴺ ∣ A`. -/ -lemma uPow_dvd {N M : ℕ} {A B : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ} - (hAB : (C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2))) ^ N * B - = (C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2))) ^ M * A) : - (C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2))) ^ N ∣ A := by - -- `X (inl 0)` does not divide `X (inr 2)` (distinct variables). - have hnd : ¬ ((X (Sum.inl 0) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) ∣ X (Sum.inr 2)) := by - rintro ⟨q, hq⟩ - have h0 := congrArg (eval (fun μ => if μ = Sum.inr 2 then (1 : ℝ) else 0)) hq - simp [eval_mul, eval_X] at h0 - -- hence `X (inl 0)` and `X (inr 2)` are relatively prime. - have hrelXX : IsRelPrime (X (Sum.inl 0) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) (X (Sum.inr 2)) := by - intro d hd1 hd2 - obtain ⟨c, hc⟩ := hd1 - rcases (MvPolynomial.X_prime).irreducible.isUnit_or_isUnit hc with h | h - · exact h - · exfalso - apply hnd - obtain ⟨e, he⟩ := hd2 - exact ⟨(↑h.unit⁻¹ : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) * e, by - rw [he, ← mul_assoc] - congr 1 - rw [hc, mul_assoc, IsUnit.mul_val_inv, mul_one]⟩ - -- `u` and `w` are relatively prime: any common divisor divides `u ± w = X inl0, X inr2`. - have hsum : (X (Sum.inl 0) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) - = C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2)) + C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2)) := by - apply MvPolynomial.funext; intro y - simp only [eval_add, eval_mul, eval_sub, eval_C, eval_X]; ring - have hdiff : (X (Sum.inr 2) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) - = C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2)) - C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2)) := by - apply MvPolynomial.funext; intro y - simp only [eval_add, eval_mul, eval_sub, eval_C, eval_X]; ring - have hrel : IsRelPrime (C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2))) - (C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2)) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) := by - intro d hdu hdw - exact hrelXX (hsum ▸ dvd_add hdu hdw) (hdiff ▸ dvd_sub hdu hdw) - exact (hrel.pow).dvd_of_dvd_mul_left (hAB ▸ Dvd.intro B rfl) - -open MvPolynomial in -lemma exists_polynomial_on_repHiggs {V : EffectivePotential} {n : ℕ} - (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : - ∃ p : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ, - ∀ X : Fin 4 → ℝ, V (repHiggs X) = p.eval (repHiggs X).gramVector := by - obtain ⟨p5, hp5⟩ := exists_polynomial_repHiggs_realGen hI h - obtain ⟨A, N, hA'⟩ := exists_clearing_all hI h - obtain ⟨B, M, hB'⟩ := exists_clearing_all_snd hI h - set F : MvPolynomial (Fin 4) ℝ := aeval realGenP p5 with hF_def - have hFeval : ∀ x : Fin 4 → ℝ, F.eval x = V (repHiggs x) := by - intro x; rw [hF_def, eval_aeval_comp]; simp only [realGenP_eval]; exact (hp5 x).symm - have hgramfun : ∀ x : Fin 4 → ℝ, - (fun μ => eval x (gramP μ)) = (repHiggs x).gramVector := fun x => funext (gramP_eval x) - have hu : aeval gramP ((C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2)) : - MvPolynomial (Fin 1 ⊕ Fin 3) ℝ)) = X 0 ^ 2 := by - apply MvPolynomial.funext; intro x - rw [eval_aeval_comp, hgramfun, eval_mul, eval_C, eval_add, eval_X, eval_X, - gramVector_repHiggs_inl, gramVector_repHiggs_inr2, eval_pow, eval_X]; ring - have hw : aeval gramP ((C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2)) : - MvPolynomial (Fin 1 ⊕ Fin 3) ℝ)) = X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2 := by - apply MvPolynomial.funext; intro x - rw [eval_aeval_comp, hgramfun, eval_mul, eval_C, eval_sub, eval_X, eval_X, - gramVector_repHiggs_inl, gramVector_repHiggs_inr2] - simp only [eval_add, eval_pow, eval_X]; ring - have hIp : aeval gramP A = (X 0 ^ 2) ^ N * F := by - apply MvPolynomial.funext; intro x - rw [eval_aeval_comp, hgramfun, ← hA' (repHiggs x), normSq_repHiggs_Φ1] - simp only [eval_mul, eval_pow, eval_X, hFeval] - have hIIp : aeval gramP B = (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2) ^ M * F := by - apply MvPolynomial.funext; intro x - rw [eval_aeval_comp, hgramfun, ← hB' (repHiggs x), normSq_repHiggs_Φ2] - simp only [eval_mul, eval_pow, eval_add, eval_X, hFeval] - have hcross : (C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2))) ^ N * B - = (C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2))) ^ M * A := by - apply gramP_injective - rw [map_mul, map_mul, map_pow, map_pow, hu, hw, hIp, hIIp]; ring - obtain ⟨C0, hC0⟩ := uPow_dvd hcross - refine ⟨C0, fun X => ?_⟩ - have key : (MvPolynomial.X 0 ^ 2) ^ N * F = (MvPolynomial.X 0 ^ 2) ^ N * aeval gramP C0 := by - rw [← hIp, hC0, map_mul, map_pow, hu] - have hFC : F = aeval gramP C0 := by - have hne : ((MvPolynomial.X 0 : MvPolynomial (Fin 4) ℝ) ^ 2) ^ N ≠ 0 := - pow_ne_zero _ (pow_ne_zero _ (MvPolynomial.X_ne_zero 0)) - exact mul_left_cancel₀ hne key - rw [← hFeval X, hFC, eval_aeval_comp, hgramfun] - -/-- An invariant effective potential with maximum mass dimension n can be written as a - polynomial in the entries of the Gram vector. -/ -lemma effectivePotential_is_polynomial_gramVector {V : EffectivePotential} {n : ℕ} - (hI: IsInvariant V) (h : HasMaxMassDimLE V n) : - ∃ p : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ, (∀ φ : TwoHiggsDoublet, V φ = p.eval φ.gramVector) := by - obtain ⟨p, hp⟩ := exists_polynomial_on_repHiggs hI h - refine ⟨p, fun φ => ?_⟩ - obtain ⟨X, g, hg⟩ := exists_smul_eq_repHiggs φ - have hgram : φ.gramVector = (repHiggs X).gramVector := by - rw [← hg] - funext μ - exact (gaugeGroupI_smul_fst_gramVector g φ μ).symm - have hV : V φ = V (repHiggs X) := by - rw [← hg] - exact (hI g φ).symm - rw [hV, hp X, hgram] - end EffectivePotential end TwoHiggsDoublet diff --git a/PhyslibAlpha/2HDM/FirstFundamentalTheorem.lean b/PhyslibAlpha/2HDM/FirstFundamentalTheorem.lean new file mode 100644 index 000000000..7ec18cbcb --- /dev/null +++ b/PhyslibAlpha/2HDM/FirstFundamentalTheorem.lean @@ -0,0 +1,985 @@ +/- +Copyright (c) 2026 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +module + +public import PhyslibAlpha.«2HDM».EffectivePotential +public import PhyslibAlpha.«2HDM».SwapDoublet +public import PhyslibAlpha.«2HDM».GaugeSlice +public import PhyslibAlpha.«2HDM».OrbitRepresentative +public import PhyslibAlpha.«2HDM».ChargeBalance +public import Mathlib.Algebra.MvPolynomial.Funext +public import Mathlib.Algebra.MvPolynomial.Monad +public import Mathlib.Algebra.MvPolynomial.Division +public import Mathlib.RingTheory.MvPolynomial.Tower +public import Mathlib.Analysis.Real.Pi.Irrational +/-! +# The first fundamental theorem for the two Higgs doublet model + +## i. Overview + +The **First Fundamental Theorem** states that a gauge-invariant polynomial effective potential is a +polynomial in the four Gram bilinears `gramVector`. The proof reduces the potential to the +polynomial family of orbit representatives `repHiggs X` and runs the following pipeline: + +1. **Charge balancing.** Gauge (torus) invariance forces the slice potential, written in + hypercharge eigen-coordinates, to be supported only on hypercharge-neutral monomials. +2. **Generation.** Every neutral monomial is a product of the five neutral quadratic bilinears, + so the slice potential is a polynomial in them (Condition A). +3. **Denominator clearing.** A power of `‖Φ1‖²` (resp. `‖Φ2‖²`, via the doublet swap) times the + potential is a genuine Gram polynomial. +4. **Coprimality.** `‖Φ1‖²` and `‖Φ2‖²` are coprime in the (algebraically independent) Gram ring, + which removes the denominators and yields the Gram polynomial. + +## ii. Key results + +* `exists_polynomial_repHiggs_realGen` — Condition A: on representatives, the value is a polynomial + in the five real bilinear generators. +* `exists_clearing_all`, `exists_clearing_all_snd` — clearing the `‖Φ1‖²` and `‖Φ2‖²` denominators. +* `exists_polynomial_on_repHiggs` — the invariant-theoretic core on the representative family. +* `effectivePotential_is_polynomial_gramVector` — the First Fundamental Theorem. + +## iii. Table of contents + +* A. Gauge invariance as invariance of the slice polynomial under the torus +* B. Hypercharge eigen-coordinates and charge balancing +* C. Generation of neutral monomials by the bilinears +* D. Condition A: the value is a polynomial in the bilinear generators +* E. Clearing the `‖Φ1‖²` and `‖Φ2‖²` denominators +* F. Algebraic independence and coprimality of the Gram generators +* G. The first fundamental theorem + +## iv. References + +The statement is the `SU(2)` first fundamental theorem specialised to two doublets in `ℂ²`. + +-/ + +@[expose] public section + +noncomputable section + +namespace TwoHiggsDoublet +open InnerProductSpace +open StandardModel + +namespace EffectivePotential + +open MvPolynomial in +/-- Pushing an evaluation through an `aeval` substitution. -/ +lemma eval_aeval_comp {R : Type*} [CommRing R] {κ ι : Type*} (x : ι → R) + (f : κ → MvPolynomial ι R) (G : MvPolynomial κ R) : + eval x (aeval f G) = eval (fun i => eval x (f i)) G := by + rw [show (aeval f) G = bind₁ f G from rfl, ← aeval_eq_eval x, aeval_bind₁] + simp [aeval_eq_eval] + +/-! +## A. Gauge invariance as invariance of the slice polynomial under the torus + +Gauge (torus) invariance of the potential forces the slice polynomial `P` to be invariant under the +hypercharge rotations of its variables: the Cartan rotation `rotSubst` and the residual `U(1)` +rotation `resSubst`. +-/ + +open MvPolynomial in +/-- The Cartan hypercharge rotation of the slice parameters, as a substitution of the polynomial + variables. -/ +noncomputable def rotSubst (u : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℝ := + ![C (u : ℂ).re * X 0 - C (u : ℂ).im * X 1, C (u : ℂ).im * X 0 + C (u : ℂ).re * X 1, + C (u : ℂ).re * X 2 - C (u : ℂ).im * X 3, C (u : ℂ).im * X 2 + C (u : ℂ).re * X 3, + C (u : ℂ).re * X 4 + C (u : ℂ).im * X 5, C (u : ℂ).re * X 5 - C (u : ℂ).im * X 4] + +open MvPolynomial in +lemma eval_rotSubst (u : unitary ℂ) (a : Fin 6 → ℝ) : + (fun k => MvPolynomial.eval a (rotSubst u k)) = cartanRotParam u a := by + funext k + fin_cases k <;> + simp [rotSubst, cartanRotParam, Complex.mul_re, Complex.mul_im] <;> ring + +open MvPolynomial in +/-- Gauge (Cartan) invariance of the potential forces the slice polynomial to be invariant under the + hypercharge rotation of its variables. -/ +lemma aeval_rotSubst_eq {V : EffectivePotential} (hI : IsInvariant V) + {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (u : unitary ℂ) : + aeval (rotSubst u) P = P := by + apply MvPolynomial.funext + intro a + have hcomp : eval a (aeval (rotSubst u) P) = P.eval (fun k => eval a (rotSubst u k)) := by + rw [aeval_def, algebraMap_eq, ← MvPolynomial.eval_assoc] + rfl + rw [hcomp, eval_rotSubst, ← hP (cartanRotParam u a), ← gaugeCartan_smul_sliceR, + hI (StandardModel.GaugeGroupI.gaugeCartan u), hP a] + +open MvPolynomial in +/-- The residual `U(1)` rotation of the perpendicular parameter, as a substitution. -/ +noncomputable def resSubst (c : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℝ := + ![X 0, X 1, X 2, X 3, + C (((c : ℂ) ^ 6).re) * X 4 - C (((c : ℂ) ^ 6).im) * X 5, + C (((c : ℂ) ^ 6).im) * X 4 + C (((c : ℂ) ^ 6).re) * X 5] + +open MvPolynomial in +lemma eval_resSubst (c : unitary ℂ) (a : Fin 6 → ℝ) : + (fun k => MvPolynomial.eval a (resSubst c k)) = resRotParam c a := by + funext k + fin_cases k <;> simp [resSubst, resRotParam, Complex.mul_re, Complex.mul_im] + ring + +open MvPolynomial in +/-- Gauge (residual `U(1)`) invariance forces the slice polynomial to be invariant under the + perpendicular rotation of its variables. -/ +lemma aeval_resSubst_eq {V : EffectivePotential} (hI : IsInvariant V) + {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (c : unitary ℂ) : + aeval (resSubst c) P = P := by + apply MvPolynomial.funext + intro a + have hcomp : eval a (aeval (resSubst c) P) = P.eval (fun k => eval a (resSubst c k)) := by + rw [aeval_def, algebraMap_eq, ← MvPolynomial.eval_assoc]; rfl + rw [hcomp, eval_resSubst, ← hP (resRotParam c a), ← ofU1Subgroup_smul_sliceR, + hI (StandardModel.GaugeGroupI.ofU1Subgroup c), hP a] + +/-! +## B. Hypercharge eigen-coordinates and charge balancing + +Changing to hypercharge eigen-coordinates `z, z̄, w₀, w̄₀, w₁, w̄₁` diagonalises the torus rotation +into a scaling by the hypercharges `chargeA` (Cartan) and `chargeB` (residual). Feeding an +infinite-order phase into the invariance from part A shows that every monomial of the slice +potential carrying nonzero hypercharge has vanishing coefficient. +-/ + +open MvPolynomial in +/-- Change to hypercharge eigen-coordinates: `aₖ` in terms of `z, z̄, w₀, w̄₀, w₁, w̄₁` + (indices `0..5`). This diagonalises the gauge-torus rotation into a scaling. -/ +noncomputable def cplxEigen : Fin 6 → MvPolynomial (Fin 6) ℂ := + ![(X 0 + X 1) * C (1 / 2), (X 0 - X 1) * C (-Complex.I / 2), + (X 2 + X 3) * C (1 / 2), (X 2 - X 3) * C (-Complex.I / 2), + (X 4 + X 5) * C (1 / 2), (X 4 - X 5) * C (-Complex.I / 2)] + +open MvPolynomial in +/-- The Cartan hypercharge, diagonal in eigen-coordinates: charges `(1,-1,1,-1,-1,1)`. -/ +noncomputable def diagCartan (u : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℂ := + ![C (u : ℂ) * X 0, C (star (u : ℂ)) * X 1, C (u : ℂ) * X 2, C (star (u : ℂ)) * X 3, + C (star (u : ℂ)) * X 4, C (u : ℂ) * X 5] + +open MvPolynomial in +/-- The residual `U(1)`, diagonal in eigen-coordinates: only the perpendicular pair is charged. -/ +noncomputable def diagRes (c : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℂ := + ![X 0, X 1, X 2, X 3, C ((c : ℂ) ^ 6) * X 4, C (star ((c : ℂ) ^ 6)) * X 5] + +open MvPolynomial in +/-- Conjugation identity: the diagonal Cartan scaling, pulled back through the eigen-coordinate + change, is the (complexified) Cartan rotation substitution. -/ +lemma bind₁_diagCartan_cplxEigen (u : unitary ℂ) (k : Fin 6) : + bind₁ (diagCartan u) (cplxEigen k) + = bind₁ cplxEigen (map (algebraMap ℝ ℂ) (rotSubst u k)) := by + apply MvPolynomial.funext + intro x + fin_cases k <;> + simp only [cplxEigen, diagCartan, rotSubst, Fin.isValue] <;> + (apply Complex.ext <;> + simp [Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, + Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, + Complex.conj_re, Complex.conj_im] <;> ring) + +open MvPolynomial in +/-- Conjugation identity for the residual `U(1)`. -/ +lemma bind₁_diagRes_cplxEigen (c : unitary ℂ) (k : Fin 6) : + bind₁ (diagRes c) (cplxEigen k) + = bind₁ cplxEigen (map (algebraMap ℝ ℂ) (resSubst c k)) := by + apply MvPolynomial.funext + intro x + simp only [diagRes, resSubst] + generalize (c : ℂ) ^ 6 = μ + fin_cases k <;> + simp only [cplxEigen, Fin.isValue] <;> + (apply Complex.ext <;> + simp [Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, + Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, + Complex.conj_re, Complex.conj_im] <;> ring) + +/-- The Cartan hypercharges of `z, z̄, w₀, w̄₀, w₁, w̄₁`. -/ +def chargeA : Fin 6 → ℤ := ![1, -1, 1, -1, -1, 1] + +/-- The residual-`U(1)` hypercharges (only the perpendicular pair is charged). -/ +def chargeB : Fin 6 → ℤ := ![0, 0, 0, 0, 1, -1] + +open MvPolynomial in +/-- The slice potential, complexified and written in hypercharge eigen-coordinates. -/ +noncomputable def Qslice (P : MvPolynomial (Fin 6) ℝ) : MvPolynomial (Fin 6) ℂ := + bind₁ cplxEigen (map (algebraMap ℝ ℂ) P) + +open MvPolynomial in +/-- The Cartan diagonal in the charge form consumed by the charge-balancing engine. -/ +lemma diagCartan_eq (u : unitary ℂ) : + diagCartan u = fun i => C ((u : ℂ) ^ (chargeA i)) * X i := by + have hinv : star (u : ℂ) = (u : ℂ) ^ (-1 : ℤ) := by + rw [zpow_neg_one]; exact (inv_eq_of_mul_eq_one_right u.2.2).symm + funext i + fin_cases i <;> simp [diagCartan, chargeA, hinv] + +open MvPolynomial in +/-- The residual diagonal in the charge form consumed by the engine. -/ +lemma diagRes_eq (c : unitary ℂ) : + diagRes c = fun i => C (((c : ℂ) ^ 6) ^ (chargeB i)) * X i := by + have hinv : star ((c : ℂ) ^ 6) = ((c : ℂ) ^ 6) ^ (-1 : ℤ) := by + rw [zpow_neg_one] + refine (inv_eq_of_mul_eq_one_right ?_).symm + rw [star_pow, ← mul_pow, c.2.2, one_pow] + funext i + fin_cases i <;> simp [diagRes, chargeB, hinv] + +open MvPolynomial in +/-- In eigen-coordinates, the Cartan hypercharge acts by the diagonal scaling, and the slice + potential is invariant under it. -/ +lemma bind₁_diagCartan_Qslice {V : EffectivePotential} (hI : IsInvariant V) + {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (u : unitary ℂ) : + bind₁ (diagCartan u) (Qslice P) = Qslice P := by + simp only [Qslice] + rw [bind₁_bind₁] + simp only [bind₁_diagCartan_cplxEigen] + rw [← bind₁_bind₁, ← map_bind₁] + congr 2 + exact aeval_rotSubst_eq hI hP u + +open MvPolynomial in +/-- Likewise for the residual `U(1)`. -/ +lemma bind₁_diagRes_Qslice {V : EffectivePotential} (hI : IsInvariant V) + {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (c : unitary ℂ) : + bind₁ (diagRes c) (Qslice P) = Qslice P := by + simp only [Qslice] + rw [bind₁_bind₁] + simp only [bind₁_diagRes_cplxEigen] + rw [← bind₁_bind₁, ← map_bind₁] + congr 2 + exact aeval_resSubst_eq hI hP c + +/-- There is a gauge phase of infinite order (`exp i`), needed to run charge balancing. -/ +lemma exists_infiniteOrder_unitary : + ∃ ω : unitary ℂ, ∀ n : ℤ, (ω : ℂ) ^ n = 1 → n = 0 := by + have key : star (Complex.exp Complex.I) * Complex.exp Complex.I = 1 := by + rw [Complex.star_def, ← Complex.exp_conj, Complex.conj_I, ← Complex.exp_add]; simp + have key2 : Complex.exp Complex.I * star (Complex.exp Complex.I) = 1 := by + rw [Complex.star_def, ← Complex.exp_conj, Complex.conj_I, ← Complex.exp_add]; simp + refine ⟨⟨Complex.exp Complex.I, key, key2⟩, fun n hn => ?_⟩ + simp only at hn + rw [← Complex.exp_int_mul, Complex.exp_eq_one_iff] at hn + obtain ⟨k, hk⟩ := hn + have hc : (n : ℂ) = (k : ℂ) * (2 * Real.pi) := by + have hI : (Complex.I) ≠ 0 := Complex.I_ne_zero + apply mul_right_cancel₀ hI + rw [hk]; ring + have hr : (n : ℝ) = (k : ℝ) * (2 * Real.pi) := by exact_mod_cast hc + rcases eq_or_ne k 0 with hk0 | hk0 + · simp [hk0] at hr; exact_mod_cast hr + · exfalso + have h2k : (2 * (k : ℝ)) ≠ 0 := by + simp only [mul_ne_zero_iff]; exact ⟨two_ne_zero, by exact_mod_cast hk0⟩ + have hpi : Real.pi = (n : ℝ) / (2 * (k : ℝ)) := by rw [eq_div_iff h2k, hr]; ring + exact irrational_pi.ne_rat ((n : ℚ) / (2 * (k : ℚ))) (by rw [hpi]; push_cast; ring) + +open MvPolynomial in +/-- **Hypercharge balancing.** Every monomial of the slice potential `Qslice P` (in eigen- + coordinates) that carries nonzero Cartan or residual hypercharge has vanishing coefficient. -/ +lemma coeff_Qslice_eq_zero {V : EffectivePotential} (hI : IsInvariant V) + {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (m : Fin 6 →₀ ℕ) + (hm : (∑ i ∈ m.support, (m i : ℤ) * chargeA i ≠ 0) ∨ + (∑ i ∈ m.support, (m i : ℤ) * chargeB i ≠ 0)) : + coeff m (Qslice P) = 0 := by + obtain ⟨ω, hω⟩ := exists_infiniteOrder_unitary + have hω0 : (ω : ℂ) ≠ 0 := by intro h; have := ω.2.1; rw [h] at this; simp at this + rcases hm with hmA | hmB + · refine coeff_eq_zero_of_charge_ne_zero chargeA (ω : ℂ) hω0 hω ?_ hmA + have h := bind₁_diagCartan_Qslice hI hP ω + rwa [diagCartan_eq] at h + · have hω6 : ((ω : ℂ) ^ 6) ≠ 0 := pow_ne_zero 6 hω0 + have hroot6 : ∀ n : ℤ, ((ω : ℂ) ^ 6) ^ n = 1 → n = 0 := by + intro n hn + rw [← zpow_natCast (ω : ℂ) 6, ← zpow_mul] at hn + have := hω _ hn; omega + refine coeff_eq_zero_of_charge_ne_zero chargeB ((ω : ℂ) ^ 6) hω6 hroot6 ?_ hmB + have h := bind₁_diagRes_Qslice hI hP ω + rwa [diagRes_eq] at h + +/-! +## C. Generation of neutral monomials by the bilinears + +The hypercharge-neutral monomials of `Qslice P` are exactly the products of the five neutral +quadratic bilinears `z z̄, w₀ w̄₀, z w̄₀, z̄ w₀, w₁ w̄₁`. This is the (abelian) generation step: +combined Cartan- and residual-neutrality of a monomial forces it to be a product of these five, +because every charged variable carries a unit Cartan charge and the residual charges come in an +exact `±1` pair. +-/ + +open MvPolynomial in +/-- The five hypercharge-neutral quadratic bilinears in eigen-coordinates: + `z z̄`, `w₀ w̄₀`, `z w̄₀`, `z̄ w₀`, `w₁ w̄₁`. -/ +noncomputable def bilin : Fin 5 → MvPolynomial (Fin 6) ℂ := + ![X 0 * X 1, X 2 * X 3, X 0 * X 3, X 1 * X 2, X 4 * X 5] + +/-- The charge of a monomial, summed over the whole index set, equals the sum over its support. -/ +lemma charge_univ_eq_support (w : Fin 6 → ℤ) (m : Fin 6 →₀ ℕ) : + ∑ i, (m i : ℤ) * w i = ∑ i ∈ m.support, (m i : ℤ) * w i := by + symm + apply Finset.sum_subset (Finset.subset_univ _) + intro i _ hi + rw [Finsupp.notMem_support_iff.mp hi]; simp + +/-- A charge sum is additive in the monomial. -/ +lemma chargeSum_add (w : Fin 6 → ℤ) (a b : Fin 6 →₀ ℕ) : + ∑ k, ((a + b) k : ℤ) * w k = (∑ k, (a k : ℤ) * w k) + ∑ k, (b k : ℤ) * w k := by + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro k _ + rw [Finsupp.add_apply]; push_cast; ring + +/-- The charge sum of a single generator is the charge of that variable. -/ +lemma chargeSum_single (w : Fin 6 → ℤ) (i : Fin 6) : + ∑ k, ((Finsupp.single i (1 : ℕ)) k : ℤ) * w k = w i := by + simp [Finsupp.single_apply, ite_mul, Finset.sum_ite_eq] + +open MvPolynomial in +/-- **Generation.** Every hypercharge-neutral monomial is a product of the five bilinears. -/ +lemma monomial_mem_adjoin_bilin (m : Fin 6 →₀ ℕ) + (hA : ∑ i, (m i : ℤ) * chargeA i = 0) (hB : ∑ i, (m i : ℤ) * chargeB i = 0) : + monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range bilin) := by + suffices H : ∀ n : ℕ, ∀ m : Fin 6 →₀ ℕ, (∑ i, m i) = n → + (∑ i, (m i : ℤ) * chargeA i = 0) → (∑ i, (m i : ℤ) * chargeB i = 0) → + monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range bilin) by + exact H (∑ i, m i) m rfl hA hB + intro n + induction n using Nat.strong_induction_on with + | _ n ih => + intro m hsum hA hB + -- The reduction step: pair up two variables whose bilinear is a generator. + have reduce : ∀ i j : Fin 6, i ≠ j → m i ≠ 0 → m j ≠ 0 → + X i * X j ∈ Algebra.adjoin ℂ (Set.range bilin) → + chargeA i + chargeA j = 0 → chargeB i + chargeB j = 0 → + monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range bilin) := by + intro i j hij hmi hmj hgen hcA hcB + have hle : Finsupp.single i 1 + Finsupp.single j 1 ≤ m := by + intro k + rw [Finsupp.add_apply, Finsupp.single_apply, Finsupp.single_apply] + by_cases h1 : i = k + · by_cases h2 : j = k + · exact absurd (h1.trans h2.symm) hij + · rw [if_pos h1, if_neg h2]; subst h1; simpa using Nat.one_le_iff_ne_zero.mpr hmi + · by_cases h2 : j = k + · rw [if_neg h1, if_pos h2]; subst h2; simpa using Nat.one_le_iff_ne_zero.mpr hmj + · rw [if_neg h1, if_neg h2]; simp + set m' := m - (Finsupp.single i 1 + Finsupp.single j 1) with hm'def + have hdecomp : m = (Finsupp.single i 1 + Finsupp.single j 1) + m' := by + rw [hm'def, add_tsub_cancel_of_le hle] + -- m' is still neutral + have hA' : ∑ k, (m' k : ℤ) * chargeA k = 0 := by + have h := hA + rw [hdecomp, chargeSum_add, chargeSum_add, chargeSum_single, chargeSum_single] at h + omega + have hB' : ∑ k, (m' k : ℤ) * chargeB k = 0 := by + have h := hB + rw [hdecomp, chargeSum_add, chargeSum_add, chargeSum_single, chargeSum_single] at h + omega + -- the degree drops by 2 + have hsum' : ∑ k, m' k < n := by + have e : (∑ k, m k) = (∑ k, (Finsupp.single i 1) k) + (∑ k, (Finsupp.single j 1) k) + + ∑ k, m' k := by + rw [← Finset.sum_add_distrib, ← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro k _ + rw [← Finsupp.add_apply, ← Finsupp.add_apply, ← hdecomp] + have e1 : ∑ k, (Finsupp.single i 1) k = 1 := by + simp [Finsupp.single_apply, Finset.sum_ite_eq] + have e2 : ∑ k, (Finsupp.single j 1) k = 1 := by + simp [Finsupp.single_apply, Finset.sum_ite_eq] + rw [hsum, e1, e2] at e + omega + -- factor and recurse + have hfact : monomial m (1 : ℂ) = (X i * X j) * monomial m' 1 := by + rw [hdecomp, + show (X i : MvPolynomial (Fin 6) ℂ) = monomial (Finsupp.single i 1) 1 from + by rw [← X_pow_eq_monomial, pow_one], + show (X j : MvPolynomial (Fin 6) ℂ) = monomial (Finsupp.single j 1) 1 from + by rw [← X_pow_eq_monomial, pow_one], + monomial_mul, monomial_mul, one_mul, one_mul, add_assoc] + rw [hfact] + exact Subalgebra.mul_mem _ hgen (ih (∑ k, m' k) hsum' m' rfl hA' hB') + -- main case split + rcases eq_or_ne n 0 with hn0 | hn0 + · -- degree zero: m = 0, monomial is 1 + have hm0 : m = 0 := by + ext k + have hk : m k ≤ ∑ i, m i := Finset.single_le_sum (fun _ _ => Nat.zero_le _) (Finset.mem_univ k) + rw [hsum, hn0] at hk + simpa using Nat.le_zero.mp hk + rw [hm0] + have h1 : monomial (0 : Fin 6 →₀ ℕ) (1 : ℂ) = 1 := by simp + rw [h1]; exact Subalgebra.one_mem _ + · -- positive degree: find a neutral pair + rcases eq_or_ne (m 4) 0 with h4 | h4 + · -- m 4 = 0; then m 5 = 0 by residual neutrality + have h5 : m 5 = 0 := by + have h := hB + simp [chargeB, Fin.sum_univ_six] at h + omega + -- Cartan neutrality on {0,1,2,3}: m0 + m2 = m1 + m3 + have hcart : (m 0 : ℤ) + (m 2 : ℤ) = (m 1 : ℤ) + (m 3 : ℤ) := by + have h := hA + simp [chargeA, Fin.sum_univ_six] at h + omega + -- total degree on {0,1,2,3} is n > 0 + have hposL : 0 < m 0 + m 2 := by + rcases Nat.eq_zero_or_pos (m 0 + m 2) with hc | hc + · exfalso + have h02 : m 0 = 0 ∧ m 2 = 0 := by omega + have h13 : m 1 = 0 ∧ m 3 = 0 := by omega + have hz : ∑ i, m i = 0 := by + simp [Fin.sum_univ_six, h02.1, h02.2, h13.1, h13.2, h4, h5] + rw [hsum] at hz; exact hn0 hz + · exact hc + have hposR : 0 < m 1 + m 3 := by omega + -- choose a positive index in {0,2} and one in {1,3} + rcases Nat.eq_zero_or_pos (m 0) with hm0 | hm0 + · -- m 0 = 0, so m 2 > 0 + have hm2 : m 2 ≠ 0 := by omega + rcases Nat.eq_zero_or_pos (m 1) with hm1 | hm1 + · -- m 1 = 0, so m 3 > 0 : pair (2,3) -> bilin 1 + have hm3 : m 3 ≠ 0 := by omega + refine reduce 2 3 (by decide) hm2 hm3 ?_ (by decide) (by decide) + exact Algebra.subset_adjoin ⟨1, rfl⟩ + · -- m 1 > 0 : pair (1,2) -> bilin 3 + refine reduce 1 2 (by decide) (by omega) hm2 ?_ (by decide) (by decide) + exact Algebra.subset_adjoin ⟨3, rfl⟩ + · -- m 0 > 0 + rcases Nat.eq_zero_or_pos (m 1) with hm1 | hm1 + · -- m 1 = 0, so m 3 > 0 : pair (0,3) -> bilin 2 + have hm3 : m 3 ≠ 0 := by omega + refine reduce 0 3 (by decide) (by omega) hm3 ?_ (by decide) (by decide) + exact Algebra.subset_adjoin ⟨2, rfl⟩ + · -- m 1 > 0 : pair (0,1) -> bilin 0 + refine reduce 0 1 (by decide) (by omega) (by omega) ?_ (by decide) (by decide) + exact Algebra.subset_adjoin ⟨0, rfl⟩ + · -- m 4 > 0; then m 5 > 0 : pair (4,5) -> bilin 4 + have h5 : m 5 ≠ 0 := by + have h := hB + simp [chargeB, Fin.sum_univ_six] at h + omega + refine reduce 4 5 (by decide) h4 h5 ?_ (by decide) (by decide) + exact Algebra.subset_adjoin ⟨4, rfl⟩ + +open MvPolynomial in +/-- The slice potential lies in the subalgebra generated by the five bilinears: every monomial that + survives is hypercharge-neutral, hence a product of the bilinears. -/ +lemma Qslice_mem_adjoin_bilin {V : EffectivePotential} (hI : IsInvariant V) + {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) : + Qslice P ∈ Algebra.adjoin ℂ (Set.range bilin) := by + rw [(Qslice P).as_sum] + apply Subalgebra.sum_mem + intro m hm + have hcoeff : coeff m (Qslice P) ≠ 0 := MvPolynomial.mem_support_iff.mp hm + have hsuppA : ∑ i ∈ m.support, (m i : ℤ) * chargeA i = 0 := by + by_contra h0 + exact hcoeff (coeff_Qslice_eq_zero hI hP m (Or.inl h0)) + have hsuppB : ∑ i ∈ m.support, (m i : ℤ) * chargeB i = 0 := by + by_contra h0 + exact hcoeff (coeff_Qslice_eq_zero hI hP m (Or.inr h0)) + have hmono : monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range bilin) := + monomial_mem_adjoin_bilin m + ((charge_univ_eq_support chargeA m).trans hsuppA) + ((charge_univ_eq_support chargeB m).trans hsuppB) + have hrw : monomial m (coeff m (Qslice P)) = C (coeff m (Qslice P)) * monomial m 1 := by + rw [C_mul_monomial, mul_one] + rw [hrw] + exact Subalgebra.mul_mem _ + (by rw [← MvPolynomial.algebraMap_eq]; exact Subalgebra.algebraMap_mem _ _) hmono + +open MvPolynomial in +/-- Consequently the complexified slice potential is `aeval bilin G` for some polynomial `G` in the + five bilinears. -/ +lemma exists_aeval_bilin {V : EffectivePotential} (hI : IsInvariant V) + {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) : + ∃ G : MvPolynomial (Fin 5) ℂ, aeval bilin G = Qslice P := by + have h := Qslice_mem_adjoin_bilin hI hP + rw [Algebra.adjoin_range_eq_range_aeval ℂ bilin] at h + obtain ⟨G, hG⟩ := h + exact ⟨G, hG⟩ + +/-! +## D. Condition A: the value is a polynomial in the bilinear generators + +Evaluating at the hypercharge eigen-point of a representative `repHiggs X`, and descending from the +complex value back to its real part, turns the generation result of part C into **Condition A**: the +value `V (repHiggs X)` is a polynomial in the five real bilinear generators +`‖Φ1‖², Re⟪⟫, Im⟪⟫, |Φ2₀|², |Φ2₁|²`. +-/ + +/-- The slice parameters realising `repHiggs X` as a point of the slice family. -/ +def aRep (X : Fin 4 → ℝ) : Fin 6 → ℝ := ![X 0, 0, X 1, X 2, X 3, 0] + +lemma repHiggs_eq_sliceR (X : Fin 4 → ℝ) : repHiggs X = sliceR (aRep X) := by + rw [repHiggs_eq_sliceHiggs, sliceR_apply] + simp [aRep] + +/-- The hypercharge eigen-point `(z, z̄, w₀, w̄₀, w₁, w̄₁)` of `repHiggs X`: here `z = X₀` is real, + `w₀ = X₁ + i X₂` and `w₁ = X₃` is real. -/ +noncomputable def eigenPt (X : Fin 4 → ℝ) : Fin 6 → ℂ := + ![(X 0 : ℂ), (X 0 : ℂ), (X 1 : ℂ) + Complex.I * (X 2 : ℂ), (X 1 : ℂ) - Complex.I * (X 2 : ℂ), + (X 3 : ℂ), (X 3 : ℂ)] + +open MvPolynomial in +/-- The eigen-coordinate change sends the eigen-point of `repHiggs X` back to its slice parameters. -/ +lemma aeval_cplxEigen_eigenPt (X : Fin 4 → ℝ) (k : Fin 6) : + aeval (eigenPt X) (cplxEigen k) = algebraMap ℝ ℂ (aRep X k) := by + fin_cases k <;> + simp only [cplxEigen, eigenPt, aRep, Fin.isValue] <;> + (apply Complex.ext <;> + simp [Complex.add_re, Complex.add_im, Complex.mul_re, + Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im] <;> ring) + +open MvPolynomial in +/-- The complexified slice potential, evaluated at the eigen-point of `repHiggs X`, returns the real + value `V (repHiggs X)`. -/ +lemma eval_Qslice_eigenPt (P : MvPolynomial (Fin 6) ℝ) (X : Fin 4 → ℝ) : + eval (eigenPt X) (Qslice P) = algebraMap ℝ ℂ (P.eval (aRep X)) := by + rw [Qslice, ← aeval_eq_eval, aeval_bind₁, + show (fun i => aeval (eigenPt X) (cplxEigen i)) = (fun i => (Algebra.ofId ℝ ℂ) (aRep X i)) from + funext (fun i => (aeval_cplxEigen_eigenPt X i).trans (Algebra.ofId_apply ℂ (aRep X i)).symm), + MvPolynomial.aeval_map_algebraMap ℂ, ← MvPolynomial.comp_aeval] + simp [aeval_eq_eval, Algebra.ofId_apply] + +open MvPolynomial in +/-- The real part of a complex polynomial, taken coefficient-wise. -/ +noncomputable def realPart (H : MvPolynomial (Fin 5) ℂ) : MvPolynomial (Fin 5) ℝ := + Finsupp.mapRange Complex.re Complex.zero_re H + +open MvPolynomial in +@[simp] lemma realPart_coeff (H : MvPolynomial (Fin 5) ℂ) (m : Fin 5 →₀ ℕ) : + coeff m (realPart H) = (coeff m H).re := Finsupp.mapRange_apply + +open MvPolynomial in +lemma realPart_C (a : ℂ) : realPart (C a) = C a.re := by + ext m; rw [realPart_coeff, coeff_C, coeff_C]; split_ifs <;> simp + +open MvPolynomial in +lemma realPart_add (p q : MvPolynomial (Fin 5) ℂ) : + realPart (p + q) = realPart p + realPart q := by + ext m; simp [Complex.add_re] + +open MvPolynomial in +lemma realPart_mul_X (p : MvPolynomial (Fin 5) ℂ) (i : Fin 5) : + realPart (p * X i) = realPart p * X i := by + ext m + rw [realPart_coeff, coeff_mul_X', coeff_mul_X', realPart_coeff] + split_ifs <;> simp + +open MvPolynomial in +/-- Evaluating a complex polynomial at a real point and taking the real part is the same as + evaluating its real part. -/ +lemma realPart_eval (H : MvPolynomial (Fin 5) ℂ) (y : Fin 5 → ℝ) : + (eval (fun j => (↑(y j) : ℂ)) H).re = (realPart H).eval y := by + induction H using MvPolynomial.induction_on with + | C a => rw [realPart_C]; simp + | add p q hp hq => rw [realPart_add, map_add, map_add, Complex.add_re, hp, hq] + | mul_X p i hp => + rw [realPart_mul_X, map_mul, map_mul, eval_X, eval_X, Complex.mul_re, Complex.ofReal_re, + Complex.ofReal_im, mul_zero, sub_zero, hp] + +/-- The five real bilinear generators of `T'`, evaluated at `repHiggs X`: + `‖Φ1‖², Re⟪⟫, Im⟪⟫, |Φ2₀|², |Φ2₁|²`. -/ +def realGen (X : Fin 4 → ℝ) : Fin 5 → ℝ := + ![X 0 ^ 2, X 0 * X 1, X 0 * X 2, X 1 ^ 2 + X 2 ^ 2, X 3 ^ 2] + +open MvPolynomial in +/-- The complex substitution expressing each bilinear, at the eigen-point, through the real + generators (the off-diagonal pair `z w̄₀, z̄ w₀` mix `Re⟪⟫` and `Im⟪⟫`). -/ +noncomputable def transf : Fin 5 → MvPolynomial (Fin 5) ℂ := + ![X 0, X 3, X 1 - C Complex.I * X 2, X 1 + C Complex.I * X 2, X 4] + +open MvPolynomial in +/-- The bilinears at the eigen-point of `repHiggs X` are the real generators, read through `transf`. -/ +lemma bilin_eval_eigenPt (X : Fin 4 → ℝ) (i : Fin 5) : + eval (eigenPt X) (bilin i) = eval (fun j => (↑(realGen X j) : ℂ)) (transf i) := by + fin_cases i <;> + simp only [bilin, transf, eigenPt, realGen, Fin.isValue] <;> + (apply Complex.ext <;> + simp [pow_two, Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, + Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im] <;> ring) + +open MvPolynomial in +/-- **Condition A.** A gauge-invariant polynomial potential, on the representative family, is a + polynomial in the five real bilinear generators `‖Φ1‖², Re⟪⟫, Im⟪⟫, |Φ2₀|², |Φ2₁|²`. -/ +lemma exists_polynomial_repHiggs_realGen {V : EffectivePotential} {n : ℕ} + (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : + ∃ p : MvPolynomial (Fin 5) ℝ, ∀ X : Fin 4 → ℝ, V (repHiggs X) = p.eval (realGen X) := by + obtain ⟨P, hP⟩ := h.exists_comp_linear_poly sliceR + obtain ⟨G, hG⟩ := exists_aeval_bilin hI hP + refine ⟨realPart (aeval transf G), fun X => ?_⟩ + have hval : (algebraMap ℝ ℂ) (V (repHiggs X)) + = eval (fun j => (↑(realGen X j) : ℂ)) (aeval transf G) := by + rw [repHiggs_eq_sliceR, hP, ← eval_Qslice_eigenPt, ← hG] + simp only [eval_aeval_comp] + rw [show (fun i => eval (eigenPt X) (bilin i)) + = (fun i => eval (fun j => (↑(realGen X j) : ℂ)) (transf i)) from + funext (bilin_eval_eigenPt X)] + have hre : V (repHiggs X) = (eval (fun j => (↑(realGen X j) : ℂ)) (aeval transf G)).re := by + rw [← hval]; simp + rw [hre, realPart_eval] + +/-! +## E. Clearing the `‖Φ1‖²` and `‖Φ2‖²` denominators + +Condition A expresses the value as a polynomial in the bilinear generators, but two of them — +`‖Φ2₀‖²` and `‖Φ2₁‖²` — are not directly Gram polynomials. Multiplying by a power of `‖Φ1‖²` +clears these denominators; the doublet swap of part `SwapDoublet` then gives the mirror statement +with `‖Φ2‖²`. +-/ + +open MvPolynomial in +/-- The five bilinear generators, as polynomials in the four representative parameters. -/ +noncomputable def realGenP : Fin 5 → MvPolynomial (Fin 4) ℝ := + ![X 0 ^ 2, X 0 * X 1, X 0 * X 2, X 1 ^ 2 + X 2 ^ 2, X 3 ^ 2] + +open MvPolynomial in +/-- The four Gram components, as polynomials in the four representative parameters. -/ +noncomputable def gramP : Fin 1 ⊕ Fin 3 → MvPolynomial (Fin 4) ℝ := + Sum.elim (fun _ => X 0 ^ 2 + (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2)) + ![2 * (X 0 * X 1), 2 * (X 0 * X 2), X 0 ^ 2 - (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2)] + +open MvPolynomial in +@[simp] lemma realGenP_eval (X : Fin 4 → ℝ) (i : Fin 5) : (realGenP i).eval X = realGen X i := by + fin_cases i <;> simp [realGenP, realGen] + +open MvPolynomial in +@[simp] lemma gramP_eval (X : Fin 4 → ℝ) (μ : Fin 1 ⊕ Fin 3) : + (gramP μ).eval X = (repHiggs X).gramVector μ := by + match μ with + | Sum.inl 0 => simp [gramP] + | Sum.inr 0 => simp [gramP]; ring + | Sum.inr 1 => simp [gramP]; ring + | Sum.inr 2 => simp [gramP] + +open MvPolynomial in +/-- Some power of `‖Φ1‖² = X₀²` times the Condition-A value polynomial lies in the Gram + subalgebra: multiplying by `X₀²` pairs each `X₁²+X₂²` into `(X₀X₁)²+(X₀X₂)²` and each `X₃²` into + the determinant `X₀²X₃²`, both of which are Gram polynomials. -/ +lemma exists_clearing_mem (p : MvPolynomial (Fin 5) ℝ) : + ∃ N : ℕ, (X 0) ^ (2 * N) * aeval realGenP p ∈ Algebra.adjoin ℝ (Set.range gramP) := by + set S := Algebra.adjoin ℝ (Set.range gramP) with hS + have hgmem : ∀ μ, gramP μ ∈ S := fun μ => Algebra.subset_adjoin ⟨μ, rfl⟩ + have hC : ∀ r : ℝ, (C r : MvPolynomial (Fin 4) ℝ) ∈ S := fun r => by + rw [← MvPolynomial.algebraMap_eq]; exact Subalgebra.algebraMap_mem _ _ + have hX0sq : (X 0 ^ 2 : MvPolynomial (Fin 4) ℝ) ∈ S := by + have e : (X 0 ^ 2 : MvPolynomial (Fin 4) ℝ) + = C (1 / 2) * (gramP (Sum.inl 0) + gramP (Sum.inr 2)) := by + apply MvPolynomial.funext; intro x; simp [gramP]; ring + rw [e]; exact Subalgebra.mul_mem _ (hC _) (Subalgebra.add_mem _ (hgmem _) (hgmem _)) + have hX0X1 : (X 0 * X 1 : MvPolynomial (Fin 4) ℝ) ∈ S := by + have e : (X 0 * X 1 : MvPolynomial (Fin 4) ℝ) = C (1 / 2) * gramP (Sum.inr 0) := by + apply MvPolynomial.funext; intro x; simp [gramP] + rw [e]; exact Subalgebra.mul_mem _ (hC _) (hgmem _) + have hX0X2 : (X 0 * X 2 : MvPolynomial (Fin 4) ℝ) ∈ S := by + have e : (X 0 * X 2 : MvPolynomial (Fin 4) ℝ) = C (1 / 2) * gramP (Sum.inr 1) := by + apply MvPolynomial.funext; intro x; simp [gramP] + rw [e]; exact Subalgebra.mul_mem _ (hC _) (hgmem _) + have hmm : (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2 : MvPolynomial (Fin 4) ℝ) ∈ S := by + have e : (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2 : MvPolynomial (Fin 4) ℝ) + = C (1 / 2) * (gramP (Sum.inl 0) - gramP (Sum.inr 2)) := by + apply MvPolynomial.funext; intro x; simp [gramP]; ring + rw [e]; exact Subalgebra.mul_mem _ (hC _) (Subalgebra.sub_mem _ (hgmem _) (hgmem _)) + have her : (X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2) : MvPolynomial (Fin 4) ℝ) ∈ S := by + have e : (X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2) : MvPolynomial (Fin 4) ℝ) + = (X 0 * X 1) ^ 2 + (X 0 * X 2) ^ 2 := by ring + rw [e]; exact Subalgebra.add_mem _ (pow_mem hX0X1 2) (pow_mem hX0X2 2) + have hes : (X 0 ^ 2 * X 3 ^ 2 : MvPolynomial (Fin 4) ℝ) ∈ S := by + have e : (X 0 ^ 2 * X 3 ^ 2 : MvPolynomial (Fin 4) ℝ) + = X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2) - X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2) := by ring + rw [e]; exact Subalgebra.sub_mem _ (Subalgebra.mul_mem _ hX0sq hmm) her + induction p using MvPolynomial.induction_on' with + | monomial m c => + refine ⟨m 3 + m 4, ?_⟩ + have hmemRHS : C c * ((X 0 ^ 2) ^ m 0 * (X 0 * X 1) ^ m 1 * (X 0 * X 2) ^ m 2 * + (X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2)) ^ m 3 * (X 0 ^ 2 * X 3 ^ 2) ^ m 4) ∈ S := + Subalgebra.mul_mem _ (hC _) (Subalgebra.mul_mem _ (Subalgebra.mul_mem _ + (Subalgebra.mul_mem _ (Subalgebra.mul_mem _ (pow_mem hX0sq _) (pow_mem hX0X1 _)) + (pow_mem hX0X2 _)) (pow_mem her _)) (pow_mem hes _)) + rw [aeval_monomial, Finsupp.prod_fintype _ _ (fun i => by simp), Fin.prod_univ_five] + simp only [realGenP, Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val, Fin.isValue, + MvPolynomial.algebraMap_eq] + convert hmemRHS using 1 + rw [pow_mul, pow_add] + simp only [mul_pow] + ring + | add p q hp hq => + obtain ⟨Np, hp'⟩ := hp + obtain ⟨Nq, hq'⟩ := hq + refine ⟨max Np Nq, ?_⟩ + rw [map_add, mul_add] + apply Subalgebra.add_mem + · rw [show 2 * max Np Nq = 2 * (max Np Nq - Np) + 2 * Np from by omega, pow_add, mul_assoc] + exact Subalgebra.mul_mem _ (by rw [pow_mul]; exact pow_mem hX0sq _) hp' + · rw [show 2 * max Np Nq = 2 * (max Np Nq - Nq) + 2 * Nq from by omega, pow_add, mul_assoc] + exact Subalgebra.mul_mem _ (by rw [pow_mul]; exact pow_mem hX0sq _) hq' + +open MvPolynomial in +/-- **Denominator clearing.** For the Condition-A value polynomial `p`, some power of `‖Φ1‖² = X₀²` + times `p ∘ realGen` is a polynomial in the Gram vector. -/ +lemma exists_gram_clearing (p : MvPolynomial (Fin 5) ℝ) : + ∃ (A : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) (N : ℕ), ∀ X : Fin 4 → ℝ, + (X 0) ^ (2 * N) * p.eval (realGen X) = A.eval ((repHiggs X).gramVector) := by + obtain ⟨N, hmem⟩ := exists_clearing_mem p + rw [Algebra.adjoin_range_eq_range_aeval ℝ gramP] at hmem + obtain ⟨A, hA⟩ := hmem + change aeval gramP A = _ at hA + refine ⟨A, N, fun X => ?_⟩ + have hL : eval X (aeval gramP A) = A.eval ((repHiggs X).gramVector) := by + rw [eval_aeval_comp]; simp only [gramP_eval] + have hR : eval X (MvPolynomial.X 0 ^ (2 * N) * aeval realGenP p) + = (X 0) ^ (2 * N) * p.eval (realGen X) := by + rw [map_mul, map_pow, eval_X, eval_aeval_comp]; simp only [realGenP_eval] + rw [← hR, ← hL, hA] + +open MvPolynomial in +/-- **`‖Φ1‖²`-clearing, on all configurations.** A power of `‖Φ1‖²` times a gauge-invariant + polynomial potential is, everywhere, a polynomial in the Gram vector. -/ +lemma exists_clearing_all {V : EffectivePotential} {n : ℕ} + (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : + ∃ (A : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) (N : ℕ), ∀ φ : TwoHiggsDoublet, + (‖φ.Φ1‖ ^ 2) ^ N * V φ = A.eval φ.gramVector := by + obtain ⟨p5, hp5⟩ := exists_polynomial_repHiggs_realGen hI h + obtain ⟨A, N, hAN⟩ := exists_gram_clearing p5 + refine ⟨A, N, fun φ => ?_⟩ + obtain ⟨X, g, hg⟩ := exists_smul_eq_repHiggs φ + have hV : V φ = V (repHiggs X) := by rw [← hg]; exact (hI g φ).symm + have hgram : φ.gramVector = (repHiggs X).gramVector := by + rw [← hg]; funext μ; exact (gaugeGroupI_smul_fst_gramVector g φ μ).symm + have hΦ1 : ‖φ.Φ1‖ ^ 2 = (X 0) ^ 2 := by + rw [normSq_Φ1_eq_gramVector, hgram, ← normSq_Φ1_eq_gramVector, normSq_repHiggs_Φ1] + rw [hΦ1, hV, hgram, ← pow_mul, hp5] + exact hAN X + +open MvPolynomial in +/-- The Gram-vector substitution induced by swapping the doublets (sign flip on the imaginary and + difference components). -/ +noncomputable def swapSubst : (Fin 1 ⊕ Fin 3) → MvPolynomial (Fin 1 ⊕ Fin 3) ℝ := + Sum.elim (fun _ => X (Sum.inl 0)) ![X (Sum.inr 0), -X (Sum.inr 1), -X (Sum.inr 2)] + +open MvPolynomial in +/-- **`‖Φ2‖²`-clearing, on all configurations.** A power of `‖Φ2‖²` times a gauge-invariant + polynomial potential is, everywhere, a polynomial in the Gram vector. Obtained from + `exists_clearing_all` for the doublet-swapped potential. -/ +lemma exists_clearing_all_snd {V : EffectivePotential} {n : ℕ} + (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : + ∃ (B : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) (M : ℕ), ∀ φ : TwoHiggsDoublet, + (‖φ.Φ2‖ ^ 2) ^ M * V φ = B.eval φ.gramVector := by + obtain ⟨B0, M, hB0⟩ := exists_clearing_all hI.comp_swapDoublet h.comp_swapDoublet + refine ⟨aeval swapSubst B0, M, fun φ => ?_⟩ + have hb := hB0 (swapDoublet φ) + simp only [swapDoublet_Φ1, swapDoublet_swapDoublet] at hb + have hpt : (swapDoublet φ).gramVector = fun μ => eval φ.gramVector (swapSubst μ) := by + funext μ + match μ with + | Sum.inl 0 => simp [swapSubst, gramVector_swapDoublet_inl] + | Sum.inr 0 => simp [swapSubst, gramVector_swapDoublet_inr0] + | Sum.inr 1 => simp [swapSubst, gramVector_swapDoublet_inr1] + | Sum.inr 2 => simp [swapSubst, gramVector_swapDoublet_inr2] + rw [hb, eval_aeval_comp, hpt] + +/-! +## F. Algebraic independence and coprimality of the Gram generators + +The four Gram generators are algebraically independent (`gramP_injective`), and the two linear +combinations `‖Φ1‖² = (g₀+g₃)/2` and `‖Φ2‖² = (g₀-g₃)/2` are coprime in the Gram ring +(`uPow_dvd`). Together these let the `‖Φ1‖²` and `‖Φ2‖²` powers be cancelled. +-/ + +open MvPolynomial in +/-- The four Gram generators are algebraically independent: the Gram substitution is injective. -/ +lemma gramP_injective : + Function.Injective (aeval gramP : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ → MvPolynomial (Fin 4) ℝ) := by + rw [injective_iff_map_eq_zero] + intro P hP + -- `P` vanishes on every Gram vector of a representative. + have hvanish : ∀ y : Fin 4 → ℝ, P.eval ((repHiggs y).gramVector) = 0 := by + intro y + have h := congrArg (eval y) hP + rw [eval_aeval_comp, map_zero] at h + rwa [show (fun μ => eval y (gramP μ)) = (repHiggs y).gramVector from funext (gramP_eval y)] at h + -- The Gram cone contains an infinite box; `P` vanishes there, hence `P = 0`. + refine MvPolynomial.funext_set + (fun μ => Sum.elim (fun _ => Set.Ioi (2 : ℝ)) (fun _ => Set.Ioo (-1 : ℝ) 1) μ) ?_ ?_ + · intro μ + rcases μ with _ | i + · exact Set.Ioi_infinite _ + · exact Set.Ioo_infinite (by norm_num) + · intro x hx + rw [Set.mem_univ_pi] at hx + have hxl : (2 : ℝ) < x (Sum.inl 0) := hx (Sum.inl 0) + have hx0 : x (Sum.inr 0) ∈ Set.Ioo (-1 : ℝ) 1 := hx (Sum.inr 0) + have hx1 : x (Sum.inr 1) ∈ Set.Ioo (-1 : ℝ) 1 := hx (Sum.inr 1) + have hx2 : x (Sum.inr 2) ∈ Set.Ioo (-1 : ℝ) 1 := hx (Sum.inr 2) + have hdpos : 0 < (x (Sum.inl 0) + x (Sum.inr 2)) / 2 := by have := hx2.1; linarith + set y0 : ℝ := Real.sqrt ((x (Sum.inl 0) + x (Sum.inr 2)) / 2) with hy0def + have hy0pos : 0 < y0 := Real.sqrt_pos.mpr hdpos + have hy0sq : y0 ^ 2 = (x (Sum.inl 0) + x (Sum.inr 2)) / 2 := + Real.sq_sqrt hdpos.le + set y1 : ℝ := x (Sum.inr 0) / (2 * y0) with hy1def + set y2 : ℝ := x (Sum.inr 1) / (2 * y0) with hy2def + -- the perpendicular component squared is nonnegative (PSD condition on the box) + have hbound : x (Sum.inr 0) ^ 2 + x (Sum.inr 1) ^ 2 + ≤ x (Sum.inl 0) ^ 2 - x (Sum.inr 2) ^ 2 := by + nlinarith [hx0.1, hx0.2, hx1.1, hx1.2, hx2.1, hx2.2, hxl] + have h2y0sq : (2 * y0) ^ 2 = 2 * (x (Sum.inl 0) + x (Sum.inr 2)) := by + rw [mul_pow, hy0sq]; ring + have hsumpos : 0 < x (Sum.inl 0) + x (Sum.inr 2) := by linarith [hx2.1] + have hkey : 2 * (x (Sum.inl 0) + x (Sum.inr 2)) * (y1 ^ 2 + y2 ^ 2) + = x (Sum.inr 0) ^ 2 + x (Sum.inr 1) ^ 2 := by + rw [hy1def, hy2def, div_pow, div_pow, ← h2y0sq] + field_simp + have hy3arg : 0 ≤ (x (Sum.inl 0) - x (Sum.inr 2)) / 2 - y1 ^ 2 - y2 ^ 2 := by + nlinarith [hkey, hbound, hsumpos] + set y3 : ℝ := Real.sqrt ((x (Sum.inl 0) - x (Sum.inr 2)) / 2 - y1 ^ 2 - y2 ^ 2) with hy3def + have hy3sq : y3 ^ 2 = (x (Sum.inl 0) - x (Sum.inr 2)) / 2 - y1 ^ 2 - y2 ^ 2 := + Real.sq_sqrt hy3arg + have hgram : (repHiggs ![y0, y1, y2, y3]).gramVector = x := by + funext μ + match μ with + | Sum.inl 0 => + rw [gramVector_repHiggs_inl] + simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val, Fin.isValue] + rw [hy0sq, hy3sq]; ring + | Sum.inr 0 => + rw [gramVector_repHiggs_inr0] + simp only [Matrix.cons_val_zero, Matrix.cons_val_one] + rw [hy1def]; field_simp + | Sum.inr 1 => + rw [gramVector_repHiggs_inr1] + simp only [Matrix.cons_val_zero, Matrix.cons_val, Fin.isValue] + rw [hy2def]; field_simp + | Sum.inr 2 => + rw [gramVector_repHiggs_inr2] + simp only [Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val, Fin.isValue] + rw [hy0sq, hy3sq]; ring + rw [map_zero, ← hgram] + exact hvanish ![y0, y1, y2, y3] + +open MvPolynomial in +/-- `‖Φ1‖²` and `‖Φ2‖²`, as the distinct linear forms `(g₀±g₃)/2` of the Gram ring, are coprime: + if `‖Φ1‖²ᴺ · B = ‖Φ2‖²ᴹ · A` then `‖Φ1‖²ᴺ ∣ A`. -/ +lemma uPow_dvd {N M : ℕ} {A B : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ} + (hAB : (C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2))) ^ N * B + = (C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2))) ^ M * A) : + (C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2))) ^ N ∣ A := by + -- `X (inl 0)` does not divide `X (inr 2)` (distinct variables). + have hnd : ¬ ((X (Sum.inl 0) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) ∣ X (Sum.inr 2)) := by + rintro ⟨q, hq⟩ + have h0 := congrArg (eval (fun μ => if μ = Sum.inr 2 then (1 : ℝ) else 0)) hq + simp [eval_mul, eval_X] at h0 + -- hence `X (inl 0)` and `X (inr 2)` are relatively prime. + have hrelXX : IsRelPrime (X (Sum.inl 0) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) (X (Sum.inr 2)) := by + intro d hd1 hd2 + obtain ⟨c, hc⟩ := hd1 + rcases (MvPolynomial.X_prime).irreducible.isUnit_or_isUnit hc with h | h + · exact h + · exfalso + apply hnd + obtain ⟨e, he⟩ := hd2 + exact ⟨(↑h.unit⁻¹ : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) * e, by + rw [he, ← mul_assoc] + congr 1 + rw [hc, mul_assoc, IsUnit.mul_val_inv, mul_one]⟩ + -- `u` and `w` are relatively prime: any common divisor divides `u ± w = X inl0, X inr2`. + have hsum : (X (Sum.inl 0) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) + = C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2)) + C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2)) := by + apply MvPolynomial.funext; intro y + simp only [eval_add, eval_mul, eval_sub, eval_C, eval_X]; ring + have hdiff : (X (Sum.inr 2) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) + = C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2)) - C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2)) := by + apply MvPolynomial.funext; intro y + simp only [eval_add, eval_mul, eval_sub, eval_C, eval_X]; ring + have hrel : IsRelPrime (C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2))) + (C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2)) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) := by + intro d hdu hdw + exact hrelXX (hsum ▸ dvd_add hdu hdw) (hdiff ▸ dvd_sub hdu hdw) + exact (hrel.pow).dvd_of_dvd_mul_left (hAB ▸ Dvd.intro B rfl) + +/-! +## G. The first fundamental theorem + +The two structural ingredients from elsewhere are that every configuration is gauge equivalent to a +representative `repHiggs X` (`exists_smul_eq_repHiggs`) with a polynomial Gram vector +(`gramVector_repHiggs_*`). Combining the two denominator clearings of part E with the coprimality of +part F removes the `‖Φ1‖²`/`‖Φ2‖²` powers and produces the Gram polynomial on representatives +(`exists_polynomial_on_repHiggs`); gauge invariance then transports it to all configurations. +-/ + +open MvPolynomial in +/-- **First fundamental theorem (representative form).** A gauge-invariant polynomial potential, + restricted to the polynomial family of orbit representatives `repHiggs X`, is a polynomial in the + Gram components of that family. This is the non-abelian `SU(2)` first fundamental theorem + specialised to two doublets in `ℂ²`, proved by the doublet-swap argument: clearing the `‖Φ1‖²` + denominator (aligning `Φ1`) and the `‖Φ2‖²` denominator (aligning `Φ2`, via the gauge-commuting + swap), then using that `‖Φ1‖²` and `‖Φ2‖²` are coprime in the Gram ring. -/ +lemma exists_polynomial_on_repHiggs {V : EffectivePotential} {n : ℕ} + (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : + ∃ p : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ, + ∀ X : Fin 4 → ℝ, V (repHiggs X) = p.eval (repHiggs X).gramVector := by + obtain ⟨p5, hp5⟩ := exists_polynomial_repHiggs_realGen hI h + obtain ⟨A, N, hA'⟩ := exists_clearing_all hI h + obtain ⟨B, M, hB'⟩ := exists_clearing_all_snd hI h + set F : MvPolynomial (Fin 4) ℝ := aeval realGenP p5 with hF_def + have hFeval : ∀ x : Fin 4 → ℝ, F.eval x = V (repHiggs x) := by + intro x; rw [hF_def, eval_aeval_comp]; simp only [realGenP_eval]; exact (hp5 x).symm + have hgramfun : ∀ x : Fin 4 → ℝ, + (fun μ => eval x (gramP μ)) = (repHiggs x).gramVector := fun x => funext (gramP_eval x) + have hu : aeval gramP ((C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2)) : + MvPolynomial (Fin 1 ⊕ Fin 3) ℝ)) = X 0 ^ 2 := by + apply MvPolynomial.funext; intro x + rw [eval_aeval_comp, hgramfun, eval_mul, eval_C, eval_add, eval_X, eval_X, + gramVector_repHiggs_inl, gramVector_repHiggs_inr2, eval_pow, eval_X]; ring + have hw : aeval gramP ((C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2)) : + MvPolynomial (Fin 1 ⊕ Fin 3) ℝ)) = X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2 := by + apply MvPolynomial.funext; intro x + rw [eval_aeval_comp, hgramfun, eval_mul, eval_C, eval_sub, eval_X, eval_X, + gramVector_repHiggs_inl, gramVector_repHiggs_inr2] + simp only [eval_add, eval_pow, eval_X]; ring + have hIp : aeval gramP A = (X 0 ^ 2) ^ N * F := by + apply MvPolynomial.funext; intro x + rw [eval_aeval_comp, hgramfun, ← hA' (repHiggs x), normSq_repHiggs_Φ1] + simp only [eval_mul, eval_pow, eval_X, hFeval] + have hIIp : aeval gramP B = (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2) ^ M * F := by + apply MvPolynomial.funext; intro x + rw [eval_aeval_comp, hgramfun, ← hB' (repHiggs x), normSq_repHiggs_Φ2] + simp only [eval_mul, eval_pow, eval_add, eval_X, hFeval] + have hcross : (C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2))) ^ N * B + = (C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2))) ^ M * A := by + apply gramP_injective + rw [map_mul, map_mul, map_pow, map_pow, hu, hw, hIp, hIIp]; ring + obtain ⟨C0, hC0⟩ := uPow_dvd hcross + refine ⟨C0, fun X => ?_⟩ + have key : (MvPolynomial.X 0 ^ 2) ^ N * F = (MvPolynomial.X 0 ^ 2) ^ N * aeval gramP C0 := by + rw [← hIp, hC0, map_mul, map_pow, hu] + have hFC : F = aeval gramP C0 := by + have hne : ((MvPolynomial.X 0 : MvPolynomial (Fin 4) ℝ) ^ 2) ^ N ≠ 0 := + pow_ne_zero _ (pow_ne_zero _ (MvPolynomial.X_ne_zero 0)) + exact mul_left_cancel₀ hne key + rw [← hFeval X, hFC, eval_aeval_comp, hgramfun] + +/-- **The first fundamental theorem.** An invariant effective potential with maximum mass dimension + `n` can be written as a polynomial in the entries of the Gram vector. -/ +lemma effectivePotential_is_polynomial_gramVector {V : EffectivePotential} {n : ℕ} + (hI: IsInvariant V) (h : HasMaxMassDimLE V n) : + ∃ p : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ, (∀ φ : TwoHiggsDoublet, V φ = p.eval φ.gramVector) := by + obtain ⟨p, hp⟩ := exists_polynomial_on_repHiggs hI h + refine ⟨p, fun φ => ?_⟩ + obtain ⟨X, g, hg⟩ := exists_smul_eq_repHiggs φ + have hgram : φ.gramVector = (repHiggs X).gramVector := by + rw [← hg] + funext μ + exact (gaugeGroupI_smul_fst_gramVector g φ μ).symm + have hV : V φ = V (repHiggs X) := by + rw [← hg] + exact (hI g φ).symm + rw [hV, hp X, hgram] + +end EffectivePotential + +end TwoHiggsDoublet diff --git a/PhyslibAlpha/2HDM/SwapDoublet.lean b/PhyslibAlpha/2HDM/SwapDoublet.lean new file mode 100644 index 000000000..b0382c661 --- /dev/null +++ b/PhyslibAlpha/2HDM/SwapDoublet.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2026 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +module + +public import PhyslibAlpha.«2HDM».EffectivePotential +public import Mathlib.Algebra.MvPolynomial.Rename +public import Mathlib.Algebra.MvPolynomial.Degrees +/-! +# Swapping the two Higgs doublets + +## i. Overview + +Exchanging the two doublets `Φ1 ↔ Φ2` is an `ℝ`-linear map `swapDoublet` that commutes with the +gauge action. It therefore preserves gauge invariance and the maximum mass dimension, while turning +the alignment of `Φ1` into the alignment of `Φ2`. This is precisely the symmetry used to clear the +`‖Φ2‖²` denominator in the First Fundamental Theorem, mirroring the `‖Φ1‖²` clearing. + +## ii. Key results + +* `swapDoublet` — the doublet exchange, as an `ℝ`-linear map. +* `swapDoublet_smul` — it commutes with the gauge action. +* `gramVector_swapDoublet_*` — its effect on the Gram vector (a sign flip on the imaginary and + difference components). +* `IsInvariant.comp_swapDoublet`, `HasMaxMassDimLE.comp_swapDoublet` — it preserves gauge invariance + and bounded mass dimension. + +## iii. Table of contents + +* A. The doublet-swap map and its components +* B. Commutation with the gauge action +* C. The action on the Gram vector +* D. Effect on gauge invariance and mass dimension + +-/ + +@[expose] public section + +noncomputable section + +namespace TwoHiggsDoublet +open InnerProductSpace +open StandardModel + +namespace EffectivePotential + +/-! +## A. The doublet-swap map and its components +-/ + +/-- Swapping the two doublets, as an `ℝ`-linear map. It commutes with the gauge action, so it sends + gauge-invariant polynomial potentials to gauge-invariant polynomial potentials, but turns the + alignment of `Φ1` into the alignment of `Φ2`. -/ +def swapDoublet : TwoHiggsDoublet →ₗ[ℝ] TwoHiggsDoublet where + toFun φ := { Φ1 := φ.Φ2, Φ2 := φ.Φ1 } + map_add' _ _ := rfl + map_smul' _ _ := rfl + +@[simp] lemma swapDoublet_Φ1 (φ : TwoHiggsDoublet) : (swapDoublet φ).Φ1 = φ.Φ2 := rfl +@[simp] lemma swapDoublet_Φ2 (φ : TwoHiggsDoublet) : (swapDoublet φ).Φ2 = φ.Φ1 := rfl + +@[simp] lemma swapDoublet_swapDoublet (φ : TwoHiggsDoublet) : swapDoublet (swapDoublet φ) = φ := by + apply ext_of_fst_snd <;> rfl + +/-! +## B. Commutation with the gauge action +-/ + +lemma swapDoublet_smul (g : StandardModel.GaugeGroupI) (φ : TwoHiggsDoublet) : + swapDoublet (g • φ) = g • swapDoublet φ := by + apply ext_of_fst_snd <;> simp + +/-! +## C. The action on the Gram vector +-/ + +/-- Swapping the doublets sends the gram vector through the sign flip of the imaginary and + difference components. -/ +lemma gramVector_swapDoublet_inl (φ : TwoHiggsDoublet) : + (swapDoublet φ).gramVector (Sum.inl 0) = φ.gramVector (Sum.inl 0) := by + rw [gramVector_inl_zero_eq, gramVector_inl_zero_eq, swapDoublet_Φ1, swapDoublet_Φ2]; ring + +lemma gramVector_swapDoublet_inr0 (φ : TwoHiggsDoublet) : + (swapDoublet φ).gramVector (Sum.inr 0) = φ.gramVector (Sum.inr 0) := by + rw [gramVector_inr_zero_eq, gramVector_inr_zero_eq, swapDoublet_Φ1, swapDoublet_Φ2, + ← inner_conj_symm, Complex.conj_re] + +lemma gramVector_swapDoublet_inr1 (φ : TwoHiggsDoublet) : + (swapDoublet φ).gramVector (Sum.inr 1) = -φ.gramVector (Sum.inr 1) := by + rw [gramVector_inr_one_eq, gramVector_inr_one_eq, swapDoublet_Φ1, swapDoublet_Φ2, + ← inner_conj_symm, Complex.conj_im]; ring + +lemma gramVector_swapDoublet_inr2 (φ : TwoHiggsDoublet) : + (swapDoublet φ).gramVector (Sum.inr 2) = -φ.gramVector (Sum.inr 2) := by + rw [gramVector_inr_two_eq, gramVector_inr_two_eq, swapDoublet_Φ1, swapDoublet_Φ2]; ring + +/-! +## D. Effect on gauge invariance and mass dimension +-/ + +lemma HasMaxMassDimLE.comp_swapDoublet {V : EffectivePotential} {n : ℕ} + (h : HasMaxMassDimLE V n) : HasMaxMassDimLE (fun φ => V (swapDoublet φ)) n := by + obtain ⟨p, hp, hdeg⟩ := h + refine ⟨MvPolynomial.rename + (fun i : Module.Dual ℝ TwoHiggsDoublet => i.comp swapDoublet) p, fun φ => ?_, ?_⟩ + · change V (swapDoublet φ) = _ + rw [MvPolynomial.eval_rename, hp (swapDoublet φ)]; rfl + · exact le_trans (MvPolynomial.totalDegree_rename_le _ _) hdeg + +lemma IsInvariant.comp_swapDoublet {V : EffectivePotential} (hI : IsInvariant V) : + IsInvariant (fun φ => V (swapDoublet φ)) := by + intro g φ + show V (swapDoublet (g • φ)) = V (swapDoublet φ) + rw [swapDoublet_smul, hI g] + +end EffectivePotential + +end TwoHiggsDoublet From 8ef7b40c10cab66ff3ecb667f1b531bf686712b7 Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Wed, 1 Jul 2026 09:14:50 +0100 Subject: [PATCH 22/25] feat: Clude prompt: "The first fundamental Theorm" is not physics focused, nor does it correspond to building lemmas around physically relevant definitions. Please do this throughout this directory. To bring the physics back to the front you may also need to rename some things Co-Authored-By: Claude --- PhyslibAlpha/2HDM/EffectivePotential.lean | 2 +- ...undamentalTheorem.lean => Invariants.lean} | 441 +++++++++--------- PhyslibAlpha/2HDM/SwapDoublet.lean | 3 +- 3 files changed, 232 insertions(+), 214 deletions(-) rename PhyslibAlpha/2HDM/{FirstFundamentalTheorem.lean => Invariants.lean} (69%) diff --git a/PhyslibAlpha/2HDM/EffectivePotential.lean b/PhyslibAlpha/2HDM/EffectivePotential.lean index 9d9a83789..4d518ed90 100644 --- a/PhyslibAlpha/2HDM/EffectivePotential.lean +++ b/PhyslibAlpha/2HDM/EffectivePotential.lean @@ -14,7 +14,7 @@ public import Mathlib.RingTheory.MvPolynomial.Tower An *effective potential* of the two Higgs doublet model is a real-valued function `V : TwoHiggsDoublet → ℝ` of the field configuration. This file introduces the two physical -properties of such a potential that the First Fundamental Theorem depends on: +properties of such a potential used when expressing it through the gauge-invariant bilinears: * `IsInvariant V` — invariance under the global gauge group, and * `HasMaxMassDimLE V n` — being a polynomial in the field components of mass dimension `≤ n`. diff --git a/PhyslibAlpha/2HDM/FirstFundamentalTheorem.lean b/PhyslibAlpha/2HDM/Invariants.lean similarity index 69% rename from PhyslibAlpha/2HDM/FirstFundamentalTheorem.lean rename to PhyslibAlpha/2HDM/Invariants.lean index 7ec18cbcb..9f050214e 100644 --- a/PhyslibAlpha/2HDM/FirstFundamentalTheorem.lean +++ b/PhyslibAlpha/2HDM/Invariants.lean @@ -16,44 +16,55 @@ public import Mathlib.Algebra.MvPolynomial.Division public import Mathlib.RingTheory.MvPolynomial.Tower public import Mathlib.Analysis.Real.Pi.Irrational /-! -# The first fundamental theorem for the two Higgs doublet model +# The two Higgs doublet potential as a polynomial in the gauge invariants ## i. Overview -The **First Fundamental Theorem** states that a gauge-invariant polynomial effective potential is a -polynomial in the four Gram bilinears `gramVector`. The proof reduces the potential to the -polynomial family of orbit representatives `repHiggs X` and runs the following pipeline: +In the *bilinear formalism* of the two Higgs doublet model (hep-ph/0605184) the four +gauge-invariant bilinears — the Gram vector `gramVector` — describe the gauge orbits of the +configuration space. This file proves the corresponding statement for the potential: every +gauge-invariant polynomial effective potential is a polynomial in these four gauge-invariant +bilinears. -1. **Charge balancing.** Gauge (torus) invariance forces the slice potential, written in +The proof gauge-fixes the potential to the polynomial family of orbit representatives `repHiggs X` +and runs the following physical pipeline: + +1. **Charge balancing.** Invariance under the gauge torus forces the potential, written in hypercharge eigen-coordinates, to be supported only on hypercharge-neutral monomials. -2. **Generation.** Every neutral monomial is a product of the five neutral quadratic bilinears, - so the slice potential is a polynomial in them (Condition A). -3. **Denominator clearing.** A power of `‖Φ1‖²` (resp. `‖Φ2‖²`, via the doublet swap) times the - potential is a genuine Gram polynomial. +2. **Generation.** Every neutral monomial is a product of the five neutral gauge-invariant + quadratic bilinears, so the potential is a polynomial in them. +3. **Clearing the norms.** A power of `‖Φ1‖²` (resp. `‖Φ2‖²`, via the doublet swap) times the + potential is a genuine polynomial in the Gram vector. 4. **Coprimality.** `‖Φ1‖²` and `‖Φ2‖²` are coprime in the (algebraically independent) Gram ring, - which removes the denominators and yields the Gram polynomial. + which removes these factors and yields the Gram polynomial. ## ii. Key results -* `exists_polynomial_repHiggs_realGen` — Condition A: on representatives, the value is a polynomial - in the five real bilinear generators. -* `exists_clearing_all`, `exists_clearing_all_snd` — clearing the `‖Φ1‖²` and `‖Φ2‖²` denominators. -* `exists_polynomial_on_repHiggs` — the invariant-theoretic core on the representative family. -* `effectivePotential_is_polynomial_gramVector` — the First Fundamental Theorem. +* `exists_polynomial_repHiggs_sliceBilinear` — on gauge representatives, the potential is a + polynomial in the five real gauge-invariant bilinears. +* `exists_normSq_Φ1_clearing`, `exists_normSq_Φ2_clearing` — a power of `‖Φ1‖²` (resp. `‖Φ2‖²`) + times the potential is a polynomial in the Gram vector. +* `exists_polynomial_on_repHiggs` — the potential on representatives is a polynomial in the Gram + vector. +* `effectivePotential_is_polynomial_gramVector` — a gauge-invariant polynomial potential is a + polynomial in the four gauge-invariant bilinears. ## iii. Table of contents -* A. Gauge invariance as invariance of the slice polynomial under the torus +* A. Gauge-torus invariance of the potential on the slice * B. Hypercharge eigen-coordinates and charge balancing -* C. Generation of neutral monomials by the bilinears -* D. Condition A: the value is a polynomial in the bilinear generators -* E. Clearing the `‖Φ1‖²` and `‖Φ2‖²` denominators -* F. Algebraic independence and coprimality of the Gram generators -* G. The first fundamental theorem +* C. Generation by the neutral gauge-invariant bilinears +* D. The potential on representatives as a polynomial in the bilinears +* E. Clearing the `‖Φ1‖²` and `‖Φ2‖²` factors +* F. Independence and coprimality of the Gram invariants +* G. The gauge-invariant potential as a polynomial in the Gram vector ## iv. References -The statement is the `SU(2)` first fundamental theorem specialised to two doublets in `ℂ²`. +* The bilinear formalism: https://arxiv.org/abs/hep-ph/0605184. + +Mathematically the result is the first fundamental theorem of invariant theory for `SU(2)` acting on +two doublets in `ℂ²`. -/ @@ -76,82 +87,82 @@ lemma eval_aeval_comp {R : Type*} [CommRing R] {κ ι : Type*} (x : ι → R) simp [aeval_eq_eval] /-! -## A. Gauge invariance as invariance of the slice polynomial under the torus +## A. Gauge-torus invariance of the potential on the slice -Gauge (torus) invariance of the potential forces the slice polynomial `P` to be invariant under the -hypercharge rotations of its variables: the Cartan rotation `rotSubst` and the residual `U(1)` -rotation `resSubst`. +Invariance of the potential under the gauge torus forces the slice polynomial `P` to be invariant +under the hypercharge rotations of its variables: the Cartan rotation `cartanSubst` and the residual +`U(1)` rotation `residualSubst`. -/ open MvPolynomial in /-- The Cartan hypercharge rotation of the slice parameters, as a substitution of the polynomial variables. -/ -noncomputable def rotSubst (u : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℝ := +noncomputable def cartanSubst (u : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℝ := ![C (u : ℂ).re * X 0 - C (u : ℂ).im * X 1, C (u : ℂ).im * X 0 + C (u : ℂ).re * X 1, C (u : ℂ).re * X 2 - C (u : ℂ).im * X 3, C (u : ℂ).im * X 2 + C (u : ℂ).re * X 3, C (u : ℂ).re * X 4 + C (u : ℂ).im * X 5, C (u : ℂ).re * X 5 - C (u : ℂ).im * X 4] open MvPolynomial in -lemma eval_rotSubst (u : unitary ℂ) (a : Fin 6 → ℝ) : - (fun k => MvPolynomial.eval a (rotSubst u k)) = cartanRotParam u a := by +lemma eval_cartanSubst (u : unitary ℂ) (a : Fin 6 → ℝ) : + (fun k => MvPolynomial.eval a (cartanSubst u k)) = cartanRotParam u a := by funext k fin_cases k <;> - simp [rotSubst, cartanRotParam, Complex.mul_re, Complex.mul_im] <;> ring + simp [cartanSubst, cartanRotParam, Complex.mul_re, Complex.mul_im] <;> ring open MvPolynomial in /-- Gauge (Cartan) invariance of the potential forces the slice polynomial to be invariant under the hypercharge rotation of its variables. -/ -lemma aeval_rotSubst_eq {V : EffectivePotential} (hI : IsInvariant V) +lemma aeval_cartanSubst_eq {V : EffectivePotential} (hI : IsInvariant V) {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (u : unitary ℂ) : - aeval (rotSubst u) P = P := by + aeval (cartanSubst u) P = P := by apply MvPolynomial.funext intro a - have hcomp : eval a (aeval (rotSubst u) P) = P.eval (fun k => eval a (rotSubst u k)) := by + have hcomp : eval a (aeval (cartanSubst u) P) = P.eval (fun k => eval a (cartanSubst u k)) := by rw [aeval_def, algebraMap_eq, ← MvPolynomial.eval_assoc] rfl - rw [hcomp, eval_rotSubst, ← hP (cartanRotParam u a), ← gaugeCartan_smul_sliceR, + rw [hcomp, eval_cartanSubst, ← hP (cartanRotParam u a), ← gaugeCartan_smul_sliceR, hI (StandardModel.GaugeGroupI.gaugeCartan u), hP a] open MvPolynomial in /-- The residual `U(1)` rotation of the perpendicular parameter, as a substitution. -/ -noncomputable def resSubst (c : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℝ := +noncomputable def residualSubst (c : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℝ := ![X 0, X 1, X 2, X 3, C (((c : ℂ) ^ 6).re) * X 4 - C (((c : ℂ) ^ 6).im) * X 5, C (((c : ℂ) ^ 6).im) * X 4 + C (((c : ℂ) ^ 6).re) * X 5] open MvPolynomial in -lemma eval_resSubst (c : unitary ℂ) (a : Fin 6 → ℝ) : - (fun k => MvPolynomial.eval a (resSubst c k)) = resRotParam c a := by +lemma eval_residualSubst (c : unitary ℂ) (a : Fin 6 → ℝ) : + (fun k => MvPolynomial.eval a (residualSubst c k)) = resRotParam c a := by funext k - fin_cases k <;> simp [resSubst, resRotParam, Complex.mul_re, Complex.mul_im] + fin_cases k <;> simp [residualSubst, resRotParam, Complex.mul_re, Complex.mul_im] ring open MvPolynomial in /-- Gauge (residual `U(1)`) invariance forces the slice polynomial to be invariant under the perpendicular rotation of its variables. -/ -lemma aeval_resSubst_eq {V : EffectivePotential} (hI : IsInvariant V) +lemma aeval_residualSubst_eq {V : EffectivePotential} (hI : IsInvariant V) {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (c : unitary ℂ) : - aeval (resSubst c) P = P := by + aeval (residualSubst c) P = P := by apply MvPolynomial.funext intro a - have hcomp : eval a (aeval (resSubst c) P) = P.eval (fun k => eval a (resSubst c k)) := by + have hcomp : eval a (aeval (residualSubst c) P) = P.eval (fun k => eval a (residualSubst c k)) := by rw [aeval_def, algebraMap_eq, ← MvPolynomial.eval_assoc]; rfl - rw [hcomp, eval_resSubst, ← hP (resRotParam c a), ← ofU1Subgroup_smul_sliceR, + rw [hcomp, eval_residualSubst, ← hP (resRotParam c a), ← ofU1Subgroup_smul_sliceR, hI (StandardModel.GaugeGroupI.ofU1Subgroup c), hP a] /-! ## B. Hypercharge eigen-coordinates and charge balancing -Changing to hypercharge eigen-coordinates `z, z̄, w₀, w̄₀, w₁, w̄₁` diagonalises the torus rotation -into a scaling by the hypercharges `chargeA` (Cartan) and `chargeB` (residual). Feeding an -infinite-order phase into the invariance from part A shows that every monomial of the slice +Changing to hypercharge eigen-coordinates `z, z̄, w₀, w̄₀, w₁, w̄₁` diagonalises the gauge-torus +rotation into a scaling by the hypercharges `cartanCharge` (Cartan) and `hyperCharge` (residual). +Feeding an infinite-order phase into the invariance from part A shows that every monomial of the potential carrying nonzero hypercharge has vanishing coefficient. -/ open MvPolynomial in /-- Change to hypercharge eigen-coordinates: `aₖ` in terms of `z, z̄, w₀, w̄₀, w₁, w̄₁` (indices `0..5`). This diagonalises the gauge-torus rotation into a scaling. -/ -noncomputable def cplxEigen : Fin 6 → MvPolynomial (Fin 6) ℂ := +noncomputable def hyperchargeEigen : Fin 6 → MvPolynomial (Fin 6) ℂ := ![(X 0 + X 1) * C (1 / 2), (X 0 - X 1) * C (-Complex.I / 2), (X 2 + X 3) * C (1 / 2), (X 2 - X 3) * C (-Complex.I / 2), (X 4 + X 5) * C (1 / 2), (X 4 - X 5) * C (-Complex.I / 2)] @@ -170,13 +181,13 @@ noncomputable def diagRes (c : unitary ℂ) : Fin 6 → MvPolynomial (Fin 6) ℂ open MvPolynomial in /-- Conjugation identity: the diagonal Cartan scaling, pulled back through the eigen-coordinate change, is the (complexified) Cartan rotation substitution. -/ -lemma bind₁_diagCartan_cplxEigen (u : unitary ℂ) (k : Fin 6) : - bind₁ (diagCartan u) (cplxEigen k) - = bind₁ cplxEigen (map (algebraMap ℝ ℂ) (rotSubst u k)) := by +lemma bind₁_diagCartan_hyperchargeEigen (u : unitary ℂ) (k : Fin 6) : + bind₁ (diagCartan u) (hyperchargeEigen k) + = bind₁ hyperchargeEigen (map (algebraMap ℝ ℂ) (cartanSubst u k)) := by apply MvPolynomial.funext intro x fin_cases k <;> - simp only [cplxEigen, diagCartan, rotSubst, Fin.isValue] <;> + simp only [hyperchargeEigen, diagCartan, cartanSubst, Fin.isValue] <;> (apply Complex.ext <;> simp [Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, @@ -184,50 +195,50 @@ lemma bind₁_diagCartan_cplxEigen (u : unitary ℂ) (k : Fin 6) : open MvPolynomial in /-- Conjugation identity for the residual `U(1)`. -/ -lemma bind₁_diagRes_cplxEigen (c : unitary ℂ) (k : Fin 6) : - bind₁ (diagRes c) (cplxEigen k) - = bind₁ cplxEigen (map (algebraMap ℝ ℂ) (resSubst c k)) := by +lemma bind₁_diagRes_hyperchargeEigen (c : unitary ℂ) (k : Fin 6) : + bind₁ (diagRes c) (hyperchargeEigen k) + = bind₁ hyperchargeEigen (map (algebraMap ℝ ℂ) (residualSubst c k)) := by apply MvPolynomial.funext intro x - simp only [diagRes, resSubst] + simp only [diagRes, residualSubst] generalize (c : ℂ) ^ 6 = μ fin_cases k <;> - simp only [cplxEigen, Fin.isValue] <;> + simp only [hyperchargeEigen, Fin.isValue] <;> (apply Complex.ext <;> simp [Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im, Complex.conj_re, Complex.conj_im] <;> ring) /-- The Cartan hypercharges of `z, z̄, w₀, w̄₀, w₁, w̄₁`. -/ -def chargeA : Fin 6 → ℤ := ![1, -1, 1, -1, -1, 1] +def cartanCharge : Fin 6 → ℤ := ![1, -1, 1, -1, -1, 1] /-- The residual-`U(1)` hypercharges (only the perpendicular pair is charged). -/ -def chargeB : Fin 6 → ℤ := ![0, 0, 0, 0, 1, -1] +def hyperCharge : Fin 6 → ℤ := ![0, 0, 0, 0, 1, -1] open MvPolynomial in /-- The slice potential, complexified and written in hypercharge eigen-coordinates. -/ noncomputable def Qslice (P : MvPolynomial (Fin 6) ℝ) : MvPolynomial (Fin 6) ℂ := - bind₁ cplxEigen (map (algebraMap ℝ ℂ) P) + bind₁ hyperchargeEigen (map (algebraMap ℝ ℂ) P) open MvPolynomial in /-- The Cartan diagonal in the charge form consumed by the charge-balancing engine. -/ lemma diagCartan_eq (u : unitary ℂ) : - diagCartan u = fun i => C ((u : ℂ) ^ (chargeA i)) * X i := by + diagCartan u = fun i => C ((u : ℂ) ^ (cartanCharge i)) * X i := by have hinv : star (u : ℂ) = (u : ℂ) ^ (-1 : ℤ) := by rw [zpow_neg_one]; exact (inv_eq_of_mul_eq_one_right u.2.2).symm funext i - fin_cases i <;> simp [diagCartan, chargeA, hinv] + fin_cases i <;> simp [diagCartan, cartanCharge, hinv] open MvPolynomial in /-- The residual diagonal in the charge form consumed by the engine. -/ lemma diagRes_eq (c : unitary ℂ) : - diagRes c = fun i => C (((c : ℂ) ^ 6) ^ (chargeB i)) * X i := by + diagRes c = fun i => C (((c : ℂ) ^ 6) ^ (hyperCharge i)) * X i := by have hinv : star ((c : ℂ) ^ 6) = ((c : ℂ) ^ 6) ^ (-1 : ℤ) := by rw [zpow_neg_one] refine (inv_eq_of_mul_eq_one_right ?_).symm rw [star_pow, ← mul_pow, c.2.2, one_pow] funext i - fin_cases i <;> simp [diagRes, chargeB, hinv] + fin_cases i <;> simp [diagRes, hyperCharge, hinv] open MvPolynomial in /-- In eigen-coordinates, the Cartan hypercharge acts by the diagonal scaling, and the slice @@ -237,10 +248,10 @@ lemma bind₁_diagCartan_Qslice {V : EffectivePotential} (hI : IsInvariant V) bind₁ (diagCartan u) (Qslice P) = Qslice P := by simp only [Qslice] rw [bind₁_bind₁] - simp only [bind₁_diagCartan_cplxEigen] + simp only [bind₁_diagCartan_hyperchargeEigen] rw [← bind₁_bind₁, ← map_bind₁] congr 2 - exact aeval_rotSubst_eq hI hP u + exact aeval_cartanSubst_eq hI hP u open MvPolynomial in /-- Likewise for the residual `U(1)`. -/ @@ -249,10 +260,10 @@ lemma bind₁_diagRes_Qslice {V : EffectivePotential} (hI : IsInvariant V) bind₁ (diagRes c) (Qslice P) = Qslice P := by simp only [Qslice] rw [bind₁_bind₁] - simp only [bind₁_diagRes_cplxEigen] + simp only [bind₁_diagRes_hyperchargeEigen] rw [← bind₁_bind₁, ← map_bind₁] congr 2 - exact aeval_resSubst_eq hI hP c + exact aeval_residualSubst_eq hI hP c /-- There is a gauge phase of infinite order (`exp i`), needed to run charge balancing. -/ lemma exists_infiniteOrder_unitary : @@ -283,13 +294,13 @@ open MvPolynomial in coordinates) that carries nonzero Cartan or residual hypercharge has vanishing coefficient. -/ lemma coeff_Qslice_eq_zero {V : EffectivePotential} (hI : IsInvariant V) {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) (m : Fin 6 →₀ ℕ) - (hm : (∑ i ∈ m.support, (m i : ℤ) * chargeA i ≠ 0) ∨ - (∑ i ∈ m.support, (m i : ℤ) * chargeB i ≠ 0)) : + (hm : (∑ i ∈ m.support, (m i : ℤ) * cartanCharge i ≠ 0) ∨ + (∑ i ∈ m.support, (m i : ℤ) * hyperCharge i ≠ 0)) : coeff m (Qslice P) = 0 := by obtain ⟨ω, hω⟩ := exists_infiniteOrder_unitary have hω0 : (ω : ℂ) ≠ 0 := by intro h; have := ω.2.1; rw [h] at this; simp at this rcases hm with hmA | hmB - · refine coeff_eq_zero_of_charge_ne_zero chargeA (ω : ℂ) hω0 hω ?_ hmA + · refine coeff_eq_zero_of_charge_ne_zero cartanCharge (ω : ℂ) hω0 hω ?_ hmA have h := bind₁_diagCartan_Qslice hI hP ω rwa [diagCartan_eq] at h · have hω6 : ((ω : ℂ) ^ 6) ≠ 0 := pow_ne_zero 6 hω0 @@ -297,24 +308,24 @@ lemma coeff_Qslice_eq_zero {V : EffectivePotential} (hI : IsInvariant V) intro n hn rw [← zpow_natCast (ω : ℂ) 6, ← zpow_mul] at hn have := hω _ hn; omega - refine coeff_eq_zero_of_charge_ne_zero chargeB ((ω : ℂ) ^ 6) hω6 hroot6 ?_ hmB + refine coeff_eq_zero_of_charge_ne_zero hyperCharge ((ω : ℂ) ^ 6) hω6 hroot6 ?_ hmB have h := bind₁_diagRes_Qslice hI hP ω rwa [diagRes_eq] at h /-! -## C. Generation of neutral monomials by the bilinears +## C. Generation by the neutral gauge-invariant bilinears The hypercharge-neutral monomials of `Qslice P` are exactly the products of the five neutral -quadratic bilinears `z z̄, w₀ w̄₀, z w̄₀, z̄ w₀, w₁ w̄₁`. This is the (abelian) generation step: -combined Cartan- and residual-neutrality of a monomial forces it to be a product of these five, -because every charged variable carries a unit Cartan charge and the residual charges come in an -exact `±1` pair. +quadratic bilinears `z z̄, w₀ w̄₀, z w̄₀, z̄ w₀, w₁ w̄₁` — the gauge invariants. This is the (abelian) +generation step: combined Cartan- and residual-neutrality of a monomial forces it to be a product of +these five, because every charged variable carries a unit Cartan charge and the residual charges +come in an exact `±1` pair. -/ open MvPolynomial in /-- The five hypercharge-neutral quadratic bilinears in eigen-coordinates: `z z̄`, `w₀ w̄₀`, `z w̄₀`, `z̄ w₀`, `w₁ w̄₁`. -/ -noncomputable def bilin : Fin 5 → MvPolynomial (Fin 6) ℂ := +noncomputable def neutralBilinear : Fin 5 → MvPolynomial (Fin 6) ℂ := ![X 0 * X 1, X 2 * X 3, X 0 * X 3, X 1 * X 2, X 4 * X 5] /-- The charge of a monomial, summed over the whole index set, equals the sum over its support. -/ @@ -340,12 +351,12 @@ lemma chargeSum_single (w : Fin 6 → ℤ) (i : Fin 6) : open MvPolynomial in /-- **Generation.** Every hypercharge-neutral monomial is a product of the five bilinears. -/ -lemma monomial_mem_adjoin_bilin (m : Fin 6 →₀ ℕ) - (hA : ∑ i, (m i : ℤ) * chargeA i = 0) (hB : ∑ i, (m i : ℤ) * chargeB i = 0) : - monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range bilin) := by +lemma monomial_mem_adjoin_neutralBilinear (m : Fin 6 →₀ ℕ) + (hA : ∑ i, (m i : ℤ) * cartanCharge i = 0) (hB : ∑ i, (m i : ℤ) * hyperCharge i = 0) : + monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range neutralBilinear) := by suffices H : ∀ n : ℕ, ∀ m : Fin 6 →₀ ℕ, (∑ i, m i) = n → - (∑ i, (m i : ℤ) * chargeA i = 0) → (∑ i, (m i : ℤ) * chargeB i = 0) → - monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range bilin) by + (∑ i, (m i : ℤ) * cartanCharge i = 0) → (∑ i, (m i : ℤ) * hyperCharge i = 0) → + monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range neutralBilinear) by exact H (∑ i, m i) m rfl hA hB intro n induction n using Nat.strong_induction_on with @@ -353,9 +364,9 @@ lemma monomial_mem_adjoin_bilin (m : Fin 6 →₀ ℕ) intro m hsum hA hB -- The reduction step: pair up two variables whose bilinear is a generator. have reduce : ∀ i j : Fin 6, i ≠ j → m i ≠ 0 → m j ≠ 0 → - X i * X j ∈ Algebra.adjoin ℂ (Set.range bilin) → - chargeA i + chargeA j = 0 → chargeB i + chargeB j = 0 → - monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range bilin) := by + X i * X j ∈ Algebra.adjoin ℂ (Set.range neutralBilinear) → + cartanCharge i + cartanCharge j = 0 → hyperCharge i + hyperCharge j = 0 → + monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range neutralBilinear) := by intro i j hij hmi hmj hgen hcA hcB have hle : Finsupp.single i 1 + Finsupp.single j 1 ≤ m := by intro k @@ -371,11 +382,11 @@ lemma monomial_mem_adjoin_bilin (m : Fin 6 →₀ ℕ) have hdecomp : m = (Finsupp.single i 1 + Finsupp.single j 1) + m' := by rw [hm'def, add_tsub_cancel_of_le hle] -- m' is still neutral - have hA' : ∑ k, (m' k : ℤ) * chargeA k = 0 := by + have hA' : ∑ k, (m' k : ℤ) * cartanCharge k = 0 := by have h := hA rw [hdecomp, chargeSum_add, chargeSum_add, chargeSum_single, chargeSum_single] at h omega - have hB' : ∑ k, (m' k : ℤ) * chargeB k = 0 := by + have hB' : ∑ k, (m' k : ℤ) * hyperCharge k = 0 := by have h := hB rw [hdecomp, chargeSum_add, chargeSum_add, chargeSum_single, chargeSum_single] at h omega @@ -419,12 +430,12 @@ lemma monomial_mem_adjoin_bilin (m : Fin 6 →₀ ℕ) · -- m 4 = 0; then m 5 = 0 by residual neutrality have h5 : m 5 = 0 := by have h := hB - simp [chargeB, Fin.sum_univ_six] at h + simp [hyperCharge, Fin.sum_univ_six] at h omega -- Cartan neutrality on {0,1,2,3}: m0 + m2 = m1 + m3 have hcart : (m 0 : ℤ) + (m 2 : ℤ) = (m 1 : ℤ) + (m 3 : ℤ) := by have h := hA - simp [chargeA, Fin.sum_univ_six] at h + simp [cartanCharge, Fin.sum_univ_six] at h omega -- total degree on {0,1,2,3} is n > 0 have hposL : 0 < m 0 + m 2 := by @@ -442,26 +453,26 @@ lemma monomial_mem_adjoin_bilin (m : Fin 6 →₀ ℕ) · -- m 0 = 0, so m 2 > 0 have hm2 : m 2 ≠ 0 := by omega rcases Nat.eq_zero_or_pos (m 1) with hm1 | hm1 - · -- m 1 = 0, so m 3 > 0 : pair (2,3) -> bilin 1 + · -- m 1 = 0, so m 3 > 0 : pair (2,3) -> neutralBilinear 1 have hm3 : m 3 ≠ 0 := by omega refine reduce 2 3 (by decide) hm2 hm3 ?_ (by decide) (by decide) exact Algebra.subset_adjoin ⟨1, rfl⟩ - · -- m 1 > 0 : pair (1,2) -> bilin 3 + · -- m 1 > 0 : pair (1,2) -> neutralBilinear 3 refine reduce 1 2 (by decide) (by omega) hm2 ?_ (by decide) (by decide) exact Algebra.subset_adjoin ⟨3, rfl⟩ · -- m 0 > 0 rcases Nat.eq_zero_or_pos (m 1) with hm1 | hm1 - · -- m 1 = 0, so m 3 > 0 : pair (0,3) -> bilin 2 + · -- m 1 = 0, so m 3 > 0 : pair (0,3) -> neutralBilinear 2 have hm3 : m 3 ≠ 0 := by omega refine reduce 0 3 (by decide) (by omega) hm3 ?_ (by decide) (by decide) exact Algebra.subset_adjoin ⟨2, rfl⟩ - · -- m 1 > 0 : pair (0,1) -> bilin 0 + · -- m 1 > 0 : pair (0,1) -> neutralBilinear 0 refine reduce 0 1 (by decide) (by omega) (by omega) ?_ (by decide) (by decide) exact Algebra.subset_adjoin ⟨0, rfl⟩ - · -- m 4 > 0; then m 5 > 0 : pair (4,5) -> bilin 4 + · -- m 4 > 0; then m 5 > 0 : pair (4,5) -> neutralBilinear 4 have h5 : m 5 ≠ 0 := by have h := hB - simp [chargeB, Fin.sum_univ_six] at h + simp [hyperCharge, Fin.sum_univ_six] at h omega refine reduce 4 5 (by decide) h4 h5 ?_ (by decide) (by decide) exact Algebra.subset_adjoin ⟨4, rfl⟩ @@ -469,23 +480,23 @@ lemma monomial_mem_adjoin_bilin (m : Fin 6 →₀ ℕ) open MvPolynomial in /-- The slice potential lies in the subalgebra generated by the five bilinears: every monomial that survives is hypercharge-neutral, hence a product of the bilinears. -/ -lemma Qslice_mem_adjoin_bilin {V : EffectivePotential} (hI : IsInvariant V) +lemma Qslice_mem_adjoin_neutralBilinear {V : EffectivePotential} (hI : IsInvariant V) {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) : - Qslice P ∈ Algebra.adjoin ℂ (Set.range bilin) := by + Qslice P ∈ Algebra.adjoin ℂ (Set.range neutralBilinear) := by rw [(Qslice P).as_sum] apply Subalgebra.sum_mem intro m hm have hcoeff : coeff m (Qslice P) ≠ 0 := MvPolynomial.mem_support_iff.mp hm - have hsuppA : ∑ i ∈ m.support, (m i : ℤ) * chargeA i = 0 := by + have hsuppA : ∑ i ∈ m.support, (m i : ℤ) * cartanCharge i = 0 := by by_contra h0 exact hcoeff (coeff_Qslice_eq_zero hI hP m (Or.inl h0)) - have hsuppB : ∑ i ∈ m.support, (m i : ℤ) * chargeB i = 0 := by + have hsuppB : ∑ i ∈ m.support, (m i : ℤ) * hyperCharge i = 0 := by by_contra h0 exact hcoeff (coeff_Qslice_eq_zero hI hP m (Or.inr h0)) - have hmono : monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range bilin) := - monomial_mem_adjoin_bilin m - ((charge_univ_eq_support chargeA m).trans hsuppA) - ((charge_univ_eq_support chargeB m).trans hsuppB) + have hmono : monomial m (1 : ℂ) ∈ Algebra.adjoin ℂ (Set.range neutralBilinear) := + monomial_mem_adjoin_neutralBilinear m + ((charge_univ_eq_support cartanCharge m).trans hsuppA) + ((charge_univ_eq_support hyperCharge m).trans hsuppB) have hrw : monomial m (coeff m (Qslice P)) = C (coeff m (Qslice P)) * monomial m 1 := by rw [C_mul_monomial, mul_one] rw [hrw] @@ -493,22 +504,22 @@ lemma Qslice_mem_adjoin_bilin {V : EffectivePotential} (hI : IsInvariant V) (by rw [← MvPolynomial.algebraMap_eq]; exact Subalgebra.algebraMap_mem _ _) hmono open MvPolynomial in -/-- Consequently the complexified slice potential is `aeval bilin G` for some polynomial `G` in the - five bilinears. -/ -lemma exists_aeval_bilin {V : EffectivePotential} (hI : IsInvariant V) +/-- Consequently the complexified slice potential is `aeval neutralBilinear G` for some polynomial + `G` in the five bilinears. -/ +lemma exists_aeval_neutralBilinear {V : EffectivePotential} (hI : IsInvariant V) {P : MvPolynomial (Fin 6) ℝ} (hP : ∀ a, V (sliceR a) = P.eval a) : - ∃ G : MvPolynomial (Fin 5) ℂ, aeval bilin G = Qslice P := by - have h := Qslice_mem_adjoin_bilin hI hP - rw [Algebra.adjoin_range_eq_range_aeval ℂ bilin] at h + ∃ G : MvPolynomial (Fin 5) ℂ, aeval neutralBilinear G = Qslice P := by + have h := Qslice_mem_adjoin_neutralBilinear hI hP + rw [Algebra.adjoin_range_eq_range_aeval ℂ neutralBilinear] at h obtain ⟨G, hG⟩ := h exact ⟨G, hG⟩ /-! -## D. Condition A: the value is a polynomial in the bilinear generators +## D. The potential on representatives as a polynomial in the bilinears Evaluating at the hypercharge eigen-point of a representative `repHiggs X`, and descending from the -complex value back to its real part, turns the generation result of part C into **Condition A**: the -value `V (repHiggs X)` is a polynomial in the five real bilinear generators +complex value back to its real part, turns the generation result of part C into the statement that +the value `V (repHiggs X)` is a polynomial in the five real gauge-invariant bilinears `‖Φ1‖², Re⟪⟫, Im⟪⟫, |Φ2₀|², |Φ2₁|²`. -/ @@ -521,16 +532,16 @@ lemma repHiggs_eq_sliceR (X : Fin 4 → ℝ) : repHiggs X = sliceR (aRep X) := b /-- The hypercharge eigen-point `(z, z̄, w₀, w̄₀, w₁, w̄₁)` of `repHiggs X`: here `z = X₀` is real, `w₀ = X₁ + i X₂` and `w₁ = X₃` is real. -/ -noncomputable def eigenPt (X : Fin 4 → ℝ) : Fin 6 → ℂ := +noncomputable def eigenPoint (X : Fin 4 → ℝ) : Fin 6 → ℂ := ![(X 0 : ℂ), (X 0 : ℂ), (X 1 : ℂ) + Complex.I * (X 2 : ℂ), (X 1 : ℂ) - Complex.I * (X 2 : ℂ), (X 3 : ℂ), (X 3 : ℂ)] open MvPolynomial in /-- The eigen-coordinate change sends the eigen-point of `repHiggs X` back to its slice parameters. -/ -lemma aeval_cplxEigen_eigenPt (X : Fin 4 → ℝ) (k : Fin 6) : - aeval (eigenPt X) (cplxEigen k) = algebraMap ℝ ℂ (aRep X k) := by +lemma aeval_hyperchargeEigen_eigenPoint (X : Fin 4 → ℝ) (k : Fin 6) : + aeval (eigenPoint X) (hyperchargeEigen k) = algebraMap ℝ ℂ (aRep X k) := by fin_cases k <;> - simp only [cplxEigen, eigenPt, aRep, Fin.isValue] <;> + simp only [hyperchargeEigen, eigenPoint, aRep, Fin.isValue] <;> (apply Complex.ext <;> simp [Complex.add_re, Complex.add_im, Complex.mul_re, Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im] <;> ring) @@ -538,11 +549,13 @@ lemma aeval_cplxEigen_eigenPt (X : Fin 4 → ℝ) (k : Fin 6) : open MvPolynomial in /-- The complexified slice potential, evaluated at the eigen-point of `repHiggs X`, returns the real value `V (repHiggs X)`. -/ -lemma eval_Qslice_eigenPt (P : MvPolynomial (Fin 6) ℝ) (X : Fin 4 → ℝ) : - eval (eigenPt X) (Qslice P) = algebraMap ℝ ℂ (P.eval (aRep X)) := by +lemma eval_Qslice_eigenPoint (P : MvPolynomial (Fin 6) ℝ) (X : Fin 4 → ℝ) : + eval (eigenPoint X) (Qslice P) = algebraMap ℝ ℂ (P.eval (aRep X)) := by rw [Qslice, ← aeval_eq_eval, aeval_bind₁, - show (fun i => aeval (eigenPt X) (cplxEigen i)) = (fun i => (Algebra.ofId ℝ ℂ) (aRep X i)) from - funext (fun i => (aeval_cplxEigen_eigenPt X i).trans (Algebra.ofId_apply ℂ (aRep X i)).symm), + show (fun i => aeval (eigenPoint X) (hyperchargeEigen i)) + = (fun i => (Algebra.ofId ℝ ℂ) (aRep X i)) from + funext (fun i => (aeval_hyperchargeEigen_eigenPoint X i).trans + (Algebra.ofId_apply ℂ (aRep X i)).symm), MvPolynomial.aeval_map_algebraMap ℂ, ← MvPolynomial.comp_aeval] simp [aeval_eq_eval, Algebra.ofId_apply] @@ -583,9 +596,9 @@ lemma realPart_eval (H : MvPolynomial (Fin 5) ℂ) (y : Fin 5 → ℝ) : rw [realPart_mul_X, map_mul, map_mul, eval_X, eval_X, Complex.mul_re, Complex.ofReal_re, Complex.ofReal_im, mul_zero, sub_zero, hp] -/-- The five real bilinear generators of `T'`, evaluated at `repHiggs X`: +/-- The five real gauge-invariant bilinears, evaluated at `repHiggs X`: `‖Φ1‖², Re⟪⟫, Im⟪⟫, |Φ2₀|², |Φ2₁|²`. -/ -def realGen (X : Fin 4 → ℝ) : Fin 5 → ℝ := +def sliceBilinear (X : Fin 4 → ℝ) : Fin 5 → ℝ := ![X 0 ^ 2, X 0 * X 1, X 0 * X 2, X 1 ^ 2 + X 2 ^ 2, X 3 ^ 2] open MvPolynomial in @@ -596,94 +609,96 @@ noncomputable def transf : Fin 5 → MvPolynomial (Fin 5) ℂ := open MvPolynomial in /-- The bilinears at the eigen-point of `repHiggs X` are the real generators, read through `transf`. -/ -lemma bilin_eval_eigenPt (X : Fin 4 → ℝ) (i : Fin 5) : - eval (eigenPt X) (bilin i) = eval (fun j => (↑(realGen X j) : ℂ)) (transf i) := by +lemma neutralBilinear_eval_eigenPoint (X : Fin 4 → ℝ) (i : Fin 5) : + eval (eigenPoint X) (neutralBilinear i) + = eval (fun j => (↑(sliceBilinear X j) : ℂ)) (transf i) := by fin_cases i <;> - simp only [bilin, transf, eigenPt, realGen, Fin.isValue] <;> + simp only [neutralBilinear, transf, eigenPoint, sliceBilinear, Fin.isValue] <;> (apply Complex.ext <;> simp [pow_two, Complex.add_re, Complex.add_im, Complex.sub_re, Complex.sub_im, Complex.mul_re, Complex.mul_im, Complex.ofReal_re, Complex.ofReal_im, Complex.I_re, Complex.I_im] <;> ring) open MvPolynomial in -/-- **Condition A.** A gauge-invariant polynomial potential, on the representative family, is a - polynomial in the five real bilinear generators `‖Φ1‖², Re⟪⟫, Im⟪⟫, |Φ2₀|², |Φ2₁|²`. -/ -lemma exists_polynomial_repHiggs_realGen {V : EffectivePotential} {n : ℕ} +/-- **The potential on representatives, in the bilinears.** A gauge-invariant polynomial potential, + on the representative family, is a polynomial in the five real gauge-invariant bilinears + `‖Φ1‖², Re⟪⟫, Im⟪⟫, |Φ2₀|², |Φ2₁|²`. -/ +lemma exists_polynomial_repHiggs_sliceBilinear {V : EffectivePotential} {n : ℕ} (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : - ∃ p : MvPolynomial (Fin 5) ℝ, ∀ X : Fin 4 → ℝ, V (repHiggs X) = p.eval (realGen X) := by + ∃ p : MvPolynomial (Fin 5) ℝ, ∀ X : Fin 4 → ℝ, V (repHiggs X) = p.eval (sliceBilinear X) := by obtain ⟨P, hP⟩ := h.exists_comp_linear_poly sliceR - obtain ⟨G, hG⟩ := exists_aeval_bilin hI hP + obtain ⟨G, hG⟩ := exists_aeval_neutralBilinear hI hP refine ⟨realPart (aeval transf G), fun X => ?_⟩ have hval : (algebraMap ℝ ℂ) (V (repHiggs X)) - = eval (fun j => (↑(realGen X j) : ℂ)) (aeval transf G) := by - rw [repHiggs_eq_sliceR, hP, ← eval_Qslice_eigenPt, ← hG] + = eval (fun j => (↑(sliceBilinear X j) : ℂ)) (aeval transf G) := by + rw [repHiggs_eq_sliceR, hP, ← eval_Qslice_eigenPoint, ← hG] simp only [eval_aeval_comp] - rw [show (fun i => eval (eigenPt X) (bilin i)) - = (fun i => eval (fun j => (↑(realGen X j) : ℂ)) (transf i)) from - funext (bilin_eval_eigenPt X)] - have hre : V (repHiggs X) = (eval (fun j => (↑(realGen X j) : ℂ)) (aeval transf G)).re := by + rw [show (fun i => eval (eigenPoint X) (neutralBilinear i)) + = (fun i => eval (fun j => (↑(sliceBilinear X j) : ℂ)) (transf i)) from + funext (neutralBilinear_eval_eigenPoint X)] + have hre : V (repHiggs X) = (eval (fun j => (↑(sliceBilinear X j) : ℂ)) (aeval transf G)).re := by rw [← hval]; simp rw [hre, realPart_eval] /-! -## E. Clearing the `‖Φ1‖²` and `‖Φ2‖²` denominators +## E. Clearing the `‖Φ1‖²` and `‖Φ2‖²` factors -Condition A expresses the value as a polynomial in the bilinear generators, but two of them — -`‖Φ2₀‖²` and `‖Φ2₁‖²` — are not directly Gram polynomials. Multiplying by a power of `‖Φ1‖²` -clears these denominators; the doublet swap of part `SwapDoublet` then gives the mirror statement -with `‖Φ2‖²`. +Part D expresses the value as a polynomial in the bilinears, but two of them — `|Φ2₀|²` and `|Φ2₁|²` +— are not directly Gram polynomials. Multiplying by a power of `‖Φ1‖²` clears these; the doublet swap +of `SwapDoublet` then gives the mirror statement with `‖Φ2‖²`. -/ open MvPolynomial in /-- The five bilinear generators, as polynomials in the four representative parameters. -/ -noncomputable def realGenP : Fin 5 → MvPolynomial (Fin 4) ℝ := +noncomputable def sliceBilinearPoly : Fin 5 → MvPolynomial (Fin 4) ℝ := ![X 0 ^ 2, X 0 * X 1, X 0 * X 2, X 1 ^ 2 + X 2 ^ 2, X 3 ^ 2] open MvPolynomial in /-- The four Gram components, as polynomials in the four representative parameters. -/ -noncomputable def gramP : Fin 1 ⊕ Fin 3 → MvPolynomial (Fin 4) ℝ := +noncomputable def gramPoly : Fin 1 ⊕ Fin 3 → MvPolynomial (Fin 4) ℝ := Sum.elim (fun _ => X 0 ^ 2 + (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2)) ![2 * (X 0 * X 1), 2 * (X 0 * X 2), X 0 ^ 2 - (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2)] open MvPolynomial in -@[simp] lemma realGenP_eval (X : Fin 4 → ℝ) (i : Fin 5) : (realGenP i).eval X = realGen X i := by - fin_cases i <;> simp [realGenP, realGen] +@[simp] lemma sliceBilinearPoly_eval (X : Fin 4 → ℝ) (i : Fin 5) : + (sliceBilinearPoly i).eval X = sliceBilinear X i := by + fin_cases i <;> simp [sliceBilinearPoly, sliceBilinear] open MvPolynomial in -@[simp] lemma gramP_eval (X : Fin 4 → ℝ) (μ : Fin 1 ⊕ Fin 3) : - (gramP μ).eval X = (repHiggs X).gramVector μ := by +@[simp] lemma gramPoly_eval (X : Fin 4 → ℝ) (μ : Fin 1 ⊕ Fin 3) : + (gramPoly μ).eval X = (repHiggs X).gramVector μ := by match μ with - | Sum.inl 0 => simp [gramP] - | Sum.inr 0 => simp [gramP]; ring - | Sum.inr 1 => simp [gramP]; ring - | Sum.inr 2 => simp [gramP] + | Sum.inl 0 => simp [gramPoly] + | Sum.inr 0 => simp [gramPoly]; ring + | Sum.inr 1 => simp [gramPoly]; ring + | Sum.inr 2 => simp [gramPoly] open MvPolynomial in -/-- Some power of `‖Φ1‖² = X₀²` times the Condition-A value polynomial lies in the Gram +/-- Some power of `‖Φ1‖² = X₀²` times the value polynomial lies in the Gram subalgebra: multiplying by `X₀²` pairs each `X₁²+X₂²` into `(X₀X₁)²+(X₀X₂)²` and each `X₃²` into the determinant `X₀²X₃²`, both of which are Gram polynomials. -/ lemma exists_clearing_mem (p : MvPolynomial (Fin 5) ℝ) : - ∃ N : ℕ, (X 0) ^ (2 * N) * aeval realGenP p ∈ Algebra.adjoin ℝ (Set.range gramP) := by - set S := Algebra.adjoin ℝ (Set.range gramP) with hS - have hgmem : ∀ μ, gramP μ ∈ S := fun μ => Algebra.subset_adjoin ⟨μ, rfl⟩ + ∃ N : ℕ, (X 0) ^ (2 * N) * aeval sliceBilinearPoly p ∈ Algebra.adjoin ℝ (Set.range gramPoly) := by + set S := Algebra.adjoin ℝ (Set.range gramPoly) with hS + have hgmem : ∀ μ, gramPoly μ ∈ S := fun μ => Algebra.subset_adjoin ⟨μ, rfl⟩ have hC : ∀ r : ℝ, (C r : MvPolynomial (Fin 4) ℝ) ∈ S := fun r => by rw [← MvPolynomial.algebraMap_eq]; exact Subalgebra.algebraMap_mem _ _ have hX0sq : (X 0 ^ 2 : MvPolynomial (Fin 4) ℝ) ∈ S := by have e : (X 0 ^ 2 : MvPolynomial (Fin 4) ℝ) - = C (1 / 2) * (gramP (Sum.inl 0) + gramP (Sum.inr 2)) := by - apply MvPolynomial.funext; intro x; simp [gramP]; ring + = C (1 / 2) * (gramPoly (Sum.inl 0) + gramPoly (Sum.inr 2)) := by + apply MvPolynomial.funext; intro x; simp [gramPoly]; ring rw [e]; exact Subalgebra.mul_mem _ (hC _) (Subalgebra.add_mem _ (hgmem _) (hgmem _)) have hX0X1 : (X 0 * X 1 : MvPolynomial (Fin 4) ℝ) ∈ S := by - have e : (X 0 * X 1 : MvPolynomial (Fin 4) ℝ) = C (1 / 2) * gramP (Sum.inr 0) := by - apply MvPolynomial.funext; intro x; simp [gramP] + have e : (X 0 * X 1 : MvPolynomial (Fin 4) ℝ) = C (1 / 2) * gramPoly (Sum.inr 0) := by + apply MvPolynomial.funext; intro x; simp [gramPoly] rw [e]; exact Subalgebra.mul_mem _ (hC _) (hgmem _) have hX0X2 : (X 0 * X 2 : MvPolynomial (Fin 4) ℝ) ∈ S := by - have e : (X 0 * X 2 : MvPolynomial (Fin 4) ℝ) = C (1 / 2) * gramP (Sum.inr 1) := by - apply MvPolynomial.funext; intro x; simp [gramP] + have e : (X 0 * X 2 : MvPolynomial (Fin 4) ℝ) = C (1 / 2) * gramPoly (Sum.inr 1) := by + apply MvPolynomial.funext; intro x; simp [gramPoly] rw [e]; exact Subalgebra.mul_mem _ (hC _) (hgmem _) have hmm : (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2 : MvPolynomial (Fin 4) ℝ) ∈ S := by have e : (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2 : MvPolynomial (Fin 4) ℝ) - = C (1 / 2) * (gramP (Sum.inl 0) - gramP (Sum.inr 2)) := by - apply MvPolynomial.funext; intro x; simp [gramP]; ring + = C (1 / 2) * (gramPoly (Sum.inl 0) - gramPoly (Sum.inr 2)) := by + apply MvPolynomial.funext; intro x; simp [gramPoly]; ring rw [e]; exact Subalgebra.mul_mem _ (hC _) (Subalgebra.sub_mem _ (hgmem _) (hgmem _)) have her : (X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2) : MvPolynomial (Fin 4) ℝ) ∈ S := by have e : (X 0 ^ 2 * (X 1 ^ 2 + X 2 ^ 2) : MvPolynomial (Fin 4) ℝ) @@ -702,8 +717,8 @@ lemma exists_clearing_mem (p : MvPolynomial (Fin 5) ℝ) : (Subalgebra.mul_mem _ (Subalgebra.mul_mem _ (pow_mem hX0sq _) (pow_mem hX0X1 _)) (pow_mem hX0X2 _)) (pow_mem her _)) (pow_mem hes _)) rw [aeval_monomial, Finsupp.prod_fintype _ _ (fun i => by simp), Fin.prod_univ_five] - simp only [realGenP, Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val, Fin.isValue, - MvPolynomial.algebraMap_eq] + simp only [sliceBilinearPoly, Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val, + Fin.isValue, MvPolynomial.algebraMap_eq] convert hmemRHS using 1 rw [pow_mul, pow_add] simp only [mul_pow] @@ -720,31 +735,31 @@ lemma exists_clearing_mem (p : MvPolynomial (Fin 5) ℝ) : exact Subalgebra.mul_mem _ (by rw [pow_mul]; exact pow_mem hX0sq _) hq' open MvPolynomial in -/-- **Denominator clearing.** For the Condition-A value polynomial `p`, some power of `‖Φ1‖² = X₀²` - times `p ∘ realGen` is a polynomial in the Gram vector. -/ +/-- **Denominator clearing.** For the value polynomial `p`, some power of `‖Φ1‖² = X₀²` + times `p ∘ sliceBilinear` is a polynomial in the Gram vector. -/ lemma exists_gram_clearing (p : MvPolynomial (Fin 5) ℝ) : ∃ (A : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) (N : ℕ), ∀ X : Fin 4 → ℝ, - (X 0) ^ (2 * N) * p.eval (realGen X) = A.eval ((repHiggs X).gramVector) := by + (X 0) ^ (2 * N) * p.eval (sliceBilinear X) = A.eval ((repHiggs X).gramVector) := by obtain ⟨N, hmem⟩ := exists_clearing_mem p - rw [Algebra.adjoin_range_eq_range_aeval ℝ gramP] at hmem + rw [Algebra.adjoin_range_eq_range_aeval ℝ gramPoly] at hmem obtain ⟨A, hA⟩ := hmem - change aeval gramP A = _ at hA + change aeval gramPoly A = _ at hA refine ⟨A, N, fun X => ?_⟩ - have hL : eval X (aeval gramP A) = A.eval ((repHiggs X).gramVector) := by - rw [eval_aeval_comp]; simp only [gramP_eval] - have hR : eval X (MvPolynomial.X 0 ^ (2 * N) * aeval realGenP p) - = (X 0) ^ (2 * N) * p.eval (realGen X) := by - rw [map_mul, map_pow, eval_X, eval_aeval_comp]; simp only [realGenP_eval] + have hL : eval X (aeval gramPoly A) = A.eval ((repHiggs X).gramVector) := by + rw [eval_aeval_comp]; simp only [gramPoly_eval] + have hR : eval X (MvPolynomial.X 0 ^ (2 * N) * aeval sliceBilinearPoly p) + = (X 0) ^ (2 * N) * p.eval (sliceBilinear X) := by + rw [map_mul, map_pow, eval_X, eval_aeval_comp]; simp only [sliceBilinearPoly_eval] rw [← hR, ← hL, hA] open MvPolynomial in /-- **`‖Φ1‖²`-clearing, on all configurations.** A power of `‖Φ1‖²` times a gauge-invariant polynomial potential is, everywhere, a polynomial in the Gram vector. -/ -lemma exists_clearing_all {V : EffectivePotential} {n : ℕ} +lemma exists_normSq_Φ1_clearing {V : EffectivePotential} {n : ℕ} (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : ∃ (A : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) (N : ℕ), ∀ φ : TwoHiggsDoublet, (‖φ.Φ1‖ ^ 2) ^ N * V φ = A.eval φ.gramVector := by - obtain ⟨p5, hp5⟩ := exists_polynomial_repHiggs_realGen hI h + obtain ⟨p5, hp5⟩ := exists_polynomial_repHiggs_sliceBilinear hI h obtain ⟨A, N, hAN⟩ := exists_gram_clearing p5 refine ⟨A, N, fun φ => ?_⟩ obtain ⟨X, g, hg⟩ := exists_smul_eq_repHiggs φ @@ -765,12 +780,12 @@ noncomputable def swapSubst : (Fin 1 ⊕ Fin 3) → MvPolynomial (Fin 1 ⊕ Fin open MvPolynomial in /-- **`‖Φ2‖²`-clearing, on all configurations.** A power of `‖Φ2‖²` times a gauge-invariant polynomial potential is, everywhere, a polynomial in the Gram vector. Obtained from - `exists_clearing_all` for the doublet-swapped potential. -/ -lemma exists_clearing_all_snd {V : EffectivePotential} {n : ℕ} + `exists_normSq_Φ1_clearing` for the doublet-swapped potential. -/ +lemma exists_normSq_Φ2_clearing {V : EffectivePotential} {n : ℕ} (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : ∃ (B : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) (M : ℕ), ∀ φ : TwoHiggsDoublet, (‖φ.Φ2‖ ^ 2) ^ M * V φ = B.eval φ.gramVector := by - obtain ⟨B0, M, hB0⟩ := exists_clearing_all hI.comp_swapDoublet h.comp_swapDoublet + obtain ⟨B0, M, hB0⟩ := exists_normSq_Φ1_clearing hI.comp_swapDoublet h.comp_swapDoublet refine ⟨aeval swapSubst B0, M, fun φ => ?_⟩ have hb := hB0 (swapDoublet φ) simp only [swapDoublet_Φ1, swapDoublet_swapDoublet] at hb @@ -784,17 +799,18 @@ lemma exists_clearing_all_snd {V : EffectivePotential} {n : ℕ} rw [hb, eval_aeval_comp, hpt] /-! -## F. Algebraic independence and coprimality of the Gram generators +## F. Independence and coprimality of the Gram invariants -The four Gram generators are algebraically independent (`gramP_injective`), and the two linear +The four Gram invariants are algebraically independent (`gramPoly_injective`), and the two linear combinations `‖Φ1‖² = (g₀+g₃)/2` and `‖Φ2‖² = (g₀-g₃)/2` are coprime in the Gram ring -(`uPow_dvd`). Together these let the `‖Φ1‖²` and `‖Φ2‖²` powers be cancelled. +(`uPow_dvd`). Together these let the `‖Φ1‖²` and `‖Φ2‖²` factors be cancelled. -/ open MvPolynomial in -/-- The four Gram generators are algebraically independent: the Gram substitution is injective. -/ -lemma gramP_injective : - Function.Injective (aeval gramP : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ → MvPolynomial (Fin 4) ℝ) := by +/-- The four Gram invariants are algebraically independent: the Gram substitution is injective. -/ +lemma gramPoly_injective : + Function.Injective + (aeval gramPoly : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ → MvPolynomial (Fin 4) ℝ) := by rw [injective_iff_map_eq_zero] intro P hP -- `P` vanishes on every Gram vector of a representative. @@ -802,7 +818,8 @@ lemma gramP_injective : intro y have h := congrArg (eval y) hP rw [eval_aeval_comp, map_zero] at h - rwa [show (fun μ => eval y (gramP μ)) = (repHiggs y).gramVector from funext (gramP_eval y)] at h + rwa [show (fun μ => eval y (gramPoly μ)) = (repHiggs y).gramVector from + funext (gramPoly_eval y)] at h -- The Gram cone contains an infinite box; `P` vanishes there, hence `P = 0`. refine MvPolynomial.funext_set (fun μ => Sum.elim (fun _ => Set.Ioi (2 : ℝ)) (fun _ => Set.Ioo (-1 : ℝ) 1) μ) ?_ ?_ @@ -902,69 +919,69 @@ lemma uPow_dvd {N M : ℕ} {A B : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ} exact (hrel.pow).dvd_of_dvd_mul_left (hAB ▸ Dvd.intro B rfl) /-! -## G. The first fundamental theorem +## G. The gauge-invariant potential as a polynomial in the Gram vector -The two structural ingredients from elsewhere are that every configuration is gauge equivalent to a -representative `repHiggs X` (`exists_smul_eq_repHiggs`) with a polynomial Gram vector -(`gramVector_repHiggs_*`). Combining the two denominator clearings of part E with the coprimality of -part F removes the `‖Φ1‖²`/`‖Φ2‖²` powers and produces the Gram polynomial on representatives +Every configuration is gauge equivalent to a representative `repHiggs X` +(`exists_smul_eq_repHiggs`) whose Gram vector is polynomial in the parameters +(`gramVector_repHiggs_*`). Combining the two norm clearings of part E with the coprimality of part F +removes the `‖Φ1‖²`/`‖Φ2‖²` factors and produces the Gram polynomial on representatives (`exists_polynomial_on_repHiggs`); gauge invariance then transports it to all configurations. -/ open MvPolynomial in -/-- **First fundamental theorem (representative form).** A gauge-invariant polynomial potential, - restricted to the polynomial family of orbit representatives `repHiggs X`, is a polynomial in the - Gram components of that family. This is the non-abelian `SU(2)` first fundamental theorem - specialised to two doublets in `ℂ²`, proved by the doublet-swap argument: clearing the `‖Φ1‖²` - denominator (aligning `Φ1`) and the `‖Φ2‖²` denominator (aligning `Φ2`, via the gauge-commuting - swap), then using that `‖Φ1‖²` and `‖Φ2‖²` are coprime in the Gram ring. -/ +/-- **On representatives.** A gauge-invariant polynomial potential, restricted to the polynomial + family of orbit representatives `repHiggs X`, is a polynomial in the Gram components of that + family. Proved by the doublet-swap argument: clearing the `‖Φ1‖²` factor (aligning `Φ1`) and the + `‖Φ2‖²` factor (aligning `Φ2`, via the gauge-commuting swap), then using that `‖Φ1‖²` and `‖Φ2‖²` + are coprime in the Gram ring. -/ lemma exists_polynomial_on_repHiggs {V : EffectivePotential} {n : ℕ} (hI : IsInvariant V) (h : HasMaxMassDimLE V n) : ∃ p : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ, ∀ X : Fin 4 → ℝ, V (repHiggs X) = p.eval (repHiggs X).gramVector := by - obtain ⟨p5, hp5⟩ := exists_polynomial_repHiggs_realGen hI h - obtain ⟨A, N, hA'⟩ := exists_clearing_all hI h - obtain ⟨B, M, hB'⟩ := exists_clearing_all_snd hI h - set F : MvPolynomial (Fin 4) ℝ := aeval realGenP p5 with hF_def + obtain ⟨p5, hp5⟩ := exists_polynomial_repHiggs_sliceBilinear hI h + obtain ⟨A, N, hA'⟩ := exists_normSq_Φ1_clearing hI h + obtain ⟨B, M, hB'⟩ := exists_normSq_Φ2_clearing hI h + set F : MvPolynomial (Fin 4) ℝ := aeval sliceBilinearPoly p5 with hF_def have hFeval : ∀ x : Fin 4 → ℝ, F.eval x = V (repHiggs x) := by - intro x; rw [hF_def, eval_aeval_comp]; simp only [realGenP_eval]; exact (hp5 x).symm + intro x; rw [hF_def, eval_aeval_comp]; simp only [sliceBilinearPoly_eval]; exact (hp5 x).symm have hgramfun : ∀ x : Fin 4 → ℝ, - (fun μ => eval x (gramP μ)) = (repHiggs x).gramVector := fun x => funext (gramP_eval x) - have hu : aeval gramP ((C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2)) : + (fun μ => eval x (gramPoly μ)) = (repHiggs x).gramVector := fun x => funext (gramPoly_eval x) + have hu : aeval gramPoly ((C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2)) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ)) = X 0 ^ 2 := by apply MvPolynomial.funext; intro x rw [eval_aeval_comp, hgramfun, eval_mul, eval_C, eval_add, eval_X, eval_X, gramVector_repHiggs_inl, gramVector_repHiggs_inr2, eval_pow, eval_X]; ring - have hw : aeval gramP ((C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2)) : + have hw : aeval gramPoly ((C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2)) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ)) = X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2 := by apply MvPolynomial.funext; intro x rw [eval_aeval_comp, hgramfun, eval_mul, eval_C, eval_sub, eval_X, eval_X, gramVector_repHiggs_inl, gramVector_repHiggs_inr2] simp only [eval_add, eval_pow, eval_X]; ring - have hIp : aeval gramP A = (X 0 ^ 2) ^ N * F := by + have hIp : aeval gramPoly A = (X 0 ^ 2) ^ N * F := by apply MvPolynomial.funext; intro x rw [eval_aeval_comp, hgramfun, ← hA' (repHiggs x), normSq_repHiggs_Φ1] simp only [eval_mul, eval_pow, eval_X, hFeval] - have hIIp : aeval gramP B = (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2) ^ M * F := by + have hIIp : aeval gramPoly B = (X 1 ^ 2 + X 2 ^ 2 + X 3 ^ 2) ^ M * F := by apply MvPolynomial.funext; intro x rw [eval_aeval_comp, hgramfun, ← hB' (repHiggs x), normSq_repHiggs_Φ2] simp only [eval_mul, eval_pow, eval_add, eval_X, hFeval] have hcross : (C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2))) ^ N * B = (C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2))) ^ M * A := by - apply gramP_injective + apply gramPoly_injective rw [map_mul, map_mul, map_pow, map_pow, hu, hw, hIp, hIIp]; ring obtain ⟨C0, hC0⟩ := uPow_dvd hcross refine ⟨C0, fun X => ?_⟩ - have key : (MvPolynomial.X 0 ^ 2) ^ N * F = (MvPolynomial.X 0 ^ 2) ^ N * aeval gramP C0 := by + have key : (MvPolynomial.X 0 ^ 2) ^ N * F = (MvPolynomial.X 0 ^ 2) ^ N * aeval gramPoly C0 := by rw [← hIp, hC0, map_mul, map_pow, hu] - have hFC : F = aeval gramP C0 := by + have hFC : F = aeval gramPoly C0 := by have hne : ((MvPolynomial.X 0 : MvPolynomial (Fin 4) ℝ) ^ 2) ^ N ≠ 0 := pow_ne_zero _ (pow_ne_zero _ (MvPolynomial.X_ne_zero 0)) exact mul_left_cancel₀ hne key rw [← hFeval X, hFC, eval_aeval_comp, hgramfun] -/-- **The first fundamental theorem.** An invariant effective potential with maximum mass dimension - `n` can be written as a polynomial in the entries of the Gram vector. -/ +/-- **The two Higgs doublet potential in the bilinear formalism.** A gauge-invariant polynomial + effective potential of maximum mass dimension `n` is a polynomial in the four gauge-invariant + bilinears — the entries of the Gram vector. -/ lemma effectivePotential_is_polynomial_gramVector {V : EffectivePotential} {n : ℕ} (hI: IsInvariant V) (h : HasMaxMassDimLE V n) : ∃ p : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ, (∀ φ : TwoHiggsDoublet, V φ = p.eval φ.gramVector) := by diff --git a/PhyslibAlpha/2HDM/SwapDoublet.lean b/PhyslibAlpha/2HDM/SwapDoublet.lean index b0382c661..04c4abd2e 100644 --- a/PhyslibAlpha/2HDM/SwapDoublet.lean +++ b/PhyslibAlpha/2HDM/SwapDoublet.lean @@ -16,7 +16,8 @@ public import Mathlib.Algebra.MvPolynomial.Degrees Exchanging the two doublets `Φ1 ↔ Φ2` is an `ℝ`-linear map `swapDoublet` that commutes with the gauge action. It therefore preserves gauge invariance and the maximum mass dimension, while turning the alignment of `Φ1` into the alignment of `Φ2`. This is precisely the symmetry used to clear the -`‖Φ2‖²` denominator in the First Fundamental Theorem, mirroring the `‖Φ1‖²` clearing. +`‖Φ2‖²` factor when writing the potential through the gauge invariants, mirroring the `‖Φ1‖²` +clearing. ## ii. Key results From 03e8f7a4c7f40d657acad4c7cccbf1eee238e0d5 Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Thu, 2 Jul 2026 10:05:03 +0100 Subject: [PATCH 23/25] refactor: Human clean up --- .../BeyondTheStandardModel/TwoHDM/Basic.lean | 70 --------------- .../HiggsBoson/EffectivePotential.lean | 10 +-- PhyslibAlpha.lean | 8 ++ .../TwoHDM}/ChargeBalance.lean | 0 .../TwoHDM}/EffectivePotential.lean | 1 + .../TwoHDM}/GaugeSlice.lean | 16 ++-- .../TwoHDM}/GaugeTorus.lean | 0 .../TwoHDM}/Invariants.lean | 10 +-- .../BeyondTheStandardModel/TwoHDM/Module.lean | 87 +++++++++++++++++++ .../TwoHDM}/OrbitRepresentative.lean | 0 .../TwoHDM}/SwapDoublet.lean | 2 +- 11 files changed, 117 insertions(+), 87 deletions(-) rename PhyslibAlpha/{2HDM => Particles/BeyondTheStandardModel/TwoHDM}/ChargeBalance.lean (100%) rename PhyslibAlpha/{2HDM => Particles/BeyondTheStandardModel/TwoHDM}/EffectivePotential.lean (98%) rename PhyslibAlpha/{2HDM => Particles/BeyondTheStandardModel/TwoHDM}/GaugeSlice.lean (93%) rename PhyslibAlpha/{2HDM => Particles/BeyondTheStandardModel/TwoHDM}/GaugeTorus.lean (100%) rename PhyslibAlpha/{2HDM => Particles/BeyondTheStandardModel/TwoHDM}/Invariants.lean (99%) create mode 100644 PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Module.lean rename PhyslibAlpha/{2HDM => Particles/BeyondTheStandardModel/TwoHDM}/OrbitRepresentative.lean (100%) rename PhyslibAlpha/{2HDM => Particles/BeyondTheStandardModel/TwoHDM}/SwapDoublet.lean (98%) diff --git a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean index 8317ce607..e7a1bdb23 100644 --- a/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean +++ b/Physlib/Particles/BeyondTheStandardModel/TwoHDM/Basic.lean @@ -77,74 +77,4 @@ noncomputable instance : MulAction StandardModel.GaugeGroupI TwoHiggsDoublet whe mul_smul g1 g2 H := by ext <;> simp [mul_smul] -/-! - -## The structure of a module - --/ - -instance : Add TwoHiggsDoublet where - add H1 H2 := { Φ1 := H1.Φ1 + H2.Φ1, Φ2 := H1.Φ2 + H2.Φ2 } - -@[simp] -lemma add_fst (H1 H2 : TwoHiggsDoublet) : (H1 + H2).Φ1 = H1.Φ1 + H2.Φ1 := rfl - -@[simp] -lemma add_snd (H1 H2 : TwoHiggsDoublet) : (H1 + H2).Φ2 = H1.Φ2 + H2.Φ2 := rfl - -instance : Zero TwoHiggsDoublet where - zero := { Φ1 := 0, Φ2 := 0 } - -@[simp] -lemma zero_fst : (0 : TwoHiggsDoublet).Φ1 = 0 := rfl - -@[simp] -lemma zero_snd : (0 : TwoHiggsDoublet).Φ2 = 0 := rfl - -instance : SMul ℂ TwoHiggsDoublet where - smul c H := { Φ1 := c • H.Φ1, Φ2 := c • H.Φ2 } - -@[simp] -lemma smul_fst (c : ℂ) (H : TwoHiggsDoublet) : (c • H).Φ1 = c • H.Φ1 := rfl - -@[simp] -lemma smul_snd (c : ℂ) (H : TwoHiggsDoublet) : (c • H).Φ2 = c • H.Φ2 := rfl - -instance : Neg TwoHiggsDoublet where - neg H := { Φ1 := -H.Φ1, Φ2 := -H.Φ2 } - -@[simp] -lemma neg_fst (H : TwoHiggsDoublet) : (-H).Φ1 = -H.Φ1 := rfl - -@[simp] -lemma neg_snd (H : TwoHiggsDoublet) : (-H).Φ2 = -H.Φ2 := rfl - -instance : AddCommGroup TwoHiggsDoublet where - add_assoc H1 H2 H3 := by - ext <;> simp [add_assoc] - zero_add H := by - ext <;> simp - add_zero H := by - ext <;> simp - nsmul := nsmulRec - add_comm H1 H2 := by - ext <;> simp [add_comm] - zsmul := zsmulRec - neg_add_cancel H := by - ext <;> simp [neg_add_cancel] - -instance : Module ℂ TwoHiggsDoublet where - smul_add c H1 H2 := by - ext <;> simp [smul_add] - add_smul c1 c2 H := by - ext <;> simp [add_smul] - one_smul H := by - ext <;> simp [one_smul] - mul_smul c1 c2 H := by - ext <;> simp [mul_smul] - smul_zero c := by - ext <;> simp [smul_zero] - zero_smul H := by - ext <;> simp [zero_smul] - end TwoHiggsDoublet diff --git a/Physlib/Particles/StandardModel/HiggsBoson/EffectivePotential.lean b/Physlib/Particles/StandardModel/HiggsBoson/EffectivePotential.lean index 6e5a33f28..c102110c3 100644 --- a/Physlib/Particles/StandardModel/HiggsBoson/EffectivePotential.lean +++ b/Physlib/Particles/StandardModel/HiggsBoson/EffectivePotential.lean @@ -81,19 +81,19 @@ end IsInvariant /-- The proposition that the potential `V` has a maximum mass dimension less then or equal to `n` - also implying it is a polynomial. -/ def HasMaxMassDimLE (V : EffectivePotential) (n : ℕ) : Prop := - ∃ p : MvPolynomial (Module.Dual ℝ HiggsVec) ℝ, (∀ φ : HiggsVec, V φ = p.eval (fun ι => ι φ)) ∧ + ∃ p : MvPolynomial (Fin 4) ℝ, (∀ φ : HiggsVec, V φ = p.eval φ.toRealScalars) ∧ p.totalDegree ≤ n /-- The polynomial associated to a potential `V` with a maximum mass dimension less than or equal to `n`. -/ def polynomial (V : EffectivePotential) {n : ℕ} (h : HasMaxMassDimLE V n) : - MvPolynomial (Module.Dual ℝ HiggsVec) ℝ := Classical.choose h + MvPolynomial (Fin 4) ℝ := Classical.choose h lemma polynomial_totalDegree {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) : (polynomial V h).totalDegree ≤ n := (Classical.choose_spec h).2 lemma apply_eq_polynomial {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) - (φ : HiggsVec) : V φ = (polynomial V h).eval (fun ι => ι φ) := (Classical.choose_spec h).1 φ + (φ : HiggsVec) : V φ = (polynomial V h).eval φ.toRealScalars := (Classical.choose_spec h).1 φ /-! @@ -103,7 +103,7 @@ lemma apply_eq_polynomial {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimL /-- The part of a potential at a given mass-dimension. -/ def termOfMassDim (V : EffectivePotential) {n : ℕ} (h : HasMaxMassDimLE V n) (m : ℕ) : - HiggsVec → ℝ := fun φ => ((polynomial V h).homogeneousComponent m).eval (fun ι => ι φ) + HiggsVec → ℝ := fun φ => ((polynomial V h).homogeneousComponent m).eval φ.toRealScalars lemma termOfMassDim_eq_zero_of_max_lt {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) {m : ℕ} (hm : n < m) (φ : HiggsVec) : @@ -112,7 +112,7 @@ lemma termOfMassDim_eq_zero_of_max_lt {V : EffectivePotential} {n : ℕ} (h : Ha rw [MvPolynomial.homogeneousComponent_eq_zero] simp only [map_zero] have h1 := polynomial_totalDegree h - omega + grind lemma termOfMassDim_homogeneity {V : EffectivePotential} {n : ℕ} (h : HasMaxMassDimLE V n) (m : ℕ) (φ : HiggsVec) (t : ℝ) : termOfMassDim V h m (t • φ) = t ^ m * termOfMassDim V h m φ := by diff --git a/PhyslibAlpha.lean b/PhyslibAlpha.lean index 05dc86888..d30900833 100644 --- a/PhyslibAlpha.lean +++ b/PhyslibAlpha.lean @@ -30,3 +30,11 @@ public import PhyslibAlpha.QuantumMechanics.QuantumHarmonicOscillator public import PhyslibAlpha.QuantumMechanics.StinespringDilation public import PhyslibAlpha.Mathematics.PartialDerivativeTest public import PhyslibAlpha.ClassicalMechanics.CoupledSpringPotential +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.ChargeBalance +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.EffectivePotential +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.GaugeSlice +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.GaugeTorus +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.Invariants +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.Module +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.OrbitRepresentative +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.SwapDoublet diff --git a/PhyslibAlpha/2HDM/ChargeBalance.lean b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/ChargeBalance.lean similarity index 100% rename from PhyslibAlpha/2HDM/ChargeBalance.lean rename to PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/ChargeBalance.lean diff --git a/PhyslibAlpha/2HDM/EffectivePotential.lean b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/EffectivePotential.lean similarity index 98% rename from PhyslibAlpha/2HDM/EffectivePotential.lean rename to PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/EffectivePotential.lean index 4d518ed90..cfac53f6a 100644 --- a/PhyslibAlpha/2HDM/EffectivePotential.lean +++ b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/EffectivePotential.lean @@ -6,6 +6,7 @@ Authors: Joseph Tooby-Smith module public import Physlib.Particles.BeyondTheStandardModel.TwoHDM.GramMatrix +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.Module public import Mathlib.RingTheory.MvPolynomial.Tower /-! # The effective potential of the two Higgs doublet model diff --git a/PhyslibAlpha/2HDM/GaugeSlice.lean b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/GaugeSlice.lean similarity index 93% rename from PhyslibAlpha/2HDM/GaugeSlice.lean rename to PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/GaugeSlice.lean index 7726cb7d7..e221ed220 100644 --- a/PhyslibAlpha/2HDM/GaugeSlice.lean +++ b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/GaugeSlice.lean @@ -5,8 +5,9 @@ Authors: Joseph Tooby-Smith -/ module -public import PhyslibAlpha.«2HDM».GaugeTorus -public import PhyslibAlpha.«2HDM».OrbitRepresentative +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.Module +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.GaugeTorus +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.OrbitRepresentative /-! # The gauge slice and the hypercharges of the doublet components @@ -51,11 +52,13 @@ def sliceR : (Fin 6 → ℝ) →ₗ[ℝ] TwoHiggsDoublet where (↑(a 4) + Complex.I * ↑(a 5)) map_add' a b := by apply ext_of_fst_snd - · ext i; fin_cases i <;> simp [sliceHiggs] <;> ring + · ext i; fin_cases i <;> simp [sliceHiggs] + ring · ext i; fin_cases i <;> simp [sliceHiggs] <;> ring map_smul' c a := by apply ext_of_fst_snd - · ext i; fin_cases i <;> simp [sliceHiggs, Complex.real_smul] <;> ring + · ext i; fin_cases i <;> simp [sliceHiggs, Complex.real_smul] + ring · ext i; fin_cases i <;> simp [sliceHiggs, Complex.real_smul] <;> ring @[simp] lemma sliceR_apply (a : Fin 6 → ℝ) : @@ -121,7 +124,8 @@ lemma ofU1Subgroup_smul_sliceR (c : unitary ℂ) (a : Fin 6 → ℝ) : have h : ∀ z : ℂ, (↑z.re + Complex.I * ↑z.im) = z := fun z => by rw [mul_comm]; exact Complex.re_add_im z rw [sliceR_apply, ofU1Subgroup_smul_sliceHiggs, sliceR_apply] - congr 1 <;> simp only [resRotParam, Matrix.cons_val_zero, Matrix.cons_val_one, - Matrix.cons_val, Fin.isValue] <;> first | rfl | rw [h] + congr 1 + simp only [resRotParam, Matrix.cons_val, Fin.isValue] + first | rfl | rw [h] end TwoHiggsDoublet diff --git a/PhyslibAlpha/2HDM/GaugeTorus.lean b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/GaugeTorus.lean similarity index 100% rename from PhyslibAlpha/2HDM/GaugeTorus.lean rename to PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/GaugeTorus.lean diff --git a/PhyslibAlpha/2HDM/Invariants.lean b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Invariants.lean similarity index 99% rename from PhyslibAlpha/2HDM/Invariants.lean rename to PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Invariants.lean index 9f050214e..7ef245bd7 100644 --- a/PhyslibAlpha/2HDM/Invariants.lean +++ b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Invariants.lean @@ -5,11 +5,11 @@ Authors: Joseph Tooby-Smith -/ module -public import PhyslibAlpha.«2HDM».EffectivePotential -public import PhyslibAlpha.«2HDM».SwapDoublet -public import PhyslibAlpha.«2HDM».GaugeSlice -public import PhyslibAlpha.«2HDM».OrbitRepresentative -public import PhyslibAlpha.«2HDM».ChargeBalance +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.EffectivePotential +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.SwapDoublet +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.GaugeSlice +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.OrbitRepresentative +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.ChargeBalance public import Mathlib.Algebra.MvPolynomial.Funext public import Mathlib.Algebra.MvPolynomial.Monad public import Mathlib.Algebra.MvPolynomial.Division diff --git a/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Module.lean b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Module.lean new file mode 100644 index 000000000..98003cc8f --- /dev/null +++ b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Module.lean @@ -0,0 +1,87 @@ +/- +Copyright (c) 2026 Joseph Tooby-Smith. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Tooby-Smith +-/ +module + +public import Physlib.Particles.BeyondTheStandardModel.TwoHDM.Basic +/-! + +# The Module structure on the two Higgs doublet model + +-/ +@[expose] public section +/-! + +## The structure of a module + +-/ + +namespace TwoHiggsDoublet + +instance : Add TwoHiggsDoublet where + add H1 H2 := { Φ1 := H1.Φ1 + H2.Φ1, Φ2 := H1.Φ2 + H2.Φ2 } + +@[simp] +lemma add_fst (H1 H2 : TwoHiggsDoublet) : (H1 + H2).Φ1 = H1.Φ1 + H2.Φ1 := rfl + +@[simp] +lemma add_snd (H1 H2 : TwoHiggsDoublet) : (H1 + H2).Φ2 = H1.Φ2 + H2.Φ2 := rfl + +instance : Zero TwoHiggsDoublet where + zero := { Φ1 := 0, Φ2 := 0 } + +@[simp] +lemma zero_fst : (0 : TwoHiggsDoublet).Φ1 = 0 := rfl + +@[simp] +lemma zero_snd : (0 : TwoHiggsDoublet).Φ2 = 0 := rfl + +instance : SMul ℂ TwoHiggsDoublet where + smul c H := { Φ1 := c • H.Φ1, Φ2 := c • H.Φ2 } + +@[simp] +lemma smul_fst (c : ℂ) (H : TwoHiggsDoublet) : (c • H).Φ1 = c • H.Φ1 := rfl + +@[simp] +lemma smul_snd (c : ℂ) (H : TwoHiggsDoublet) : (c • H).Φ2 = c • H.Φ2 := rfl + +instance : Neg TwoHiggsDoublet where + neg H := { Φ1 := -H.Φ1, Φ2 := -H.Φ2 } + +@[simp] +lemma neg_fst (H : TwoHiggsDoublet) : (-H).Φ1 = -H.Φ1 := rfl + +@[simp] +lemma neg_snd (H : TwoHiggsDoublet) : (-H).Φ2 = -H.Φ2 := rfl + +instance : AddCommGroup TwoHiggsDoublet where + add_assoc H1 H2 H3 := by + ext <;> simp [add_assoc] + zero_add H := by + ext <;> simp + add_zero H := by + ext <;> simp + nsmul := nsmulRec + add_comm H1 H2 := by + ext <;> simp [add_comm] + zsmul := zsmulRec + neg_add_cancel H := by + ext <;> simp [neg_add_cancel] + +instance : Module ℂ TwoHiggsDoublet where + smul_add c H1 H2 := by + ext <;> simp [smul_add] + add_smul c1 c2 H := by + ext <;> simp [add_smul] + one_smul H := by + ext <;> simp [one_smul] + mul_smul c1 c2 H := by + ext <;> simp [mul_smul] + smul_zero c := by + ext <;> simp [smul_zero] + zero_smul H := by + ext <;> simp [zero_smul] + +end TwoHiggsDoublet diff --git a/PhyslibAlpha/2HDM/OrbitRepresentative.lean b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/OrbitRepresentative.lean similarity index 100% rename from PhyslibAlpha/2HDM/OrbitRepresentative.lean rename to PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/OrbitRepresentative.lean diff --git a/PhyslibAlpha/2HDM/SwapDoublet.lean b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/SwapDoublet.lean similarity index 98% rename from PhyslibAlpha/2HDM/SwapDoublet.lean rename to PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/SwapDoublet.lean index 04c4abd2e..9ce2adcf0 100644 --- a/PhyslibAlpha/2HDM/SwapDoublet.lean +++ b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/SwapDoublet.lean @@ -5,7 +5,7 @@ Authors: Joseph Tooby-Smith -/ module -public import PhyslibAlpha.«2HDM».EffectivePotential +public import PhyslibAlpha.Particles.BeyondTheStandardModel.TwoHDM.EffectivePotential public import Mathlib.Algebra.MvPolynomial.Rename public import Mathlib.Algebra.MvPolynomial.Degrees /-! From 0b7068c44b5cc58c6d9b0ba72f533aa596c4c5c6 Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Thu, 2 Jul 2026 10:12:45 +0100 Subject: [PATCH 24/25] refactor: Lint --- .../TwoHDM/Invariants.lean | 32 ++++++++++++------- 1 file changed, 20 insertions(+), 12 deletions(-) diff --git a/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Invariants.lean b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Invariants.lean index 7ef245bd7..12ef03e1e 100644 --- a/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Invariants.lean +++ b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Invariants.lean @@ -145,7 +145,8 @@ lemma aeval_residualSubst_eq {V : EffectivePotential} (hI : IsInvariant V) aeval (residualSubst c) P = P := by apply MvPolynomial.funext intro a - have hcomp : eval a (aeval (residualSubst c) P) = P.eval (fun k => eval a (residualSubst c k)) := by + have hcomp : eval a (aeval (residualSubst c) P) = P.eval + (fun k => eval a (residualSubst c k)) := by rw [aeval_def, algebraMap_eq, ← MvPolynomial.eval_assoc]; rfl rw [hcomp, eval_residualSubst, ← hP (resRotParam c a), ← ofU1Subgroup_smul_sliceR, hI (StandardModel.GaugeGroupI.ofU1Subgroup c), hP a] @@ -419,7 +420,8 @@ lemma monomial_mem_adjoin_neutralBilinear (m : Fin 6 →₀ ℕ) · -- degree zero: m = 0, monomial is 1 have hm0 : m = 0 := by ext k - have hk : m k ≤ ∑ i, m i := Finset.single_le_sum (fun _ _ => Nat.zero_le _) (Finset.mem_univ k) + have hk : m k ≤ ∑ i, m i := Finset.single_le_sum (fun _ _ => Nat.zero_le _) + (Finset.mem_univ k) rw [hsum, hn0] at hk simpa using Nat.le_zero.mp hk rw [hm0] @@ -537,7 +539,8 @@ noncomputable def eigenPoint (X : Fin 4 → ℝ) : Fin 6 → ℂ := (X 3 : ℂ), (X 3 : ℂ)] open MvPolynomial in -/-- The eigen-coordinate change sends the eigen-point of `repHiggs X` back to its slice parameters. -/ +/-- The eigen-coordinate change sends the eigen-point of `repHiggs X` back to its + slice parameters. -/ lemma aeval_hyperchargeEigen_eigenPoint (X : Fin 4 → ℝ) (k : Fin 6) : aeval (eigenPoint X) (hyperchargeEigen k) = algebraMap ℝ ℂ (aRep X k) := by fin_cases k <;> @@ -608,7 +611,8 @@ noncomputable def transf : Fin 5 → MvPolynomial (Fin 5) ℂ := ![X 0, X 3, X 1 - C Complex.I * X 2, X 1 + C Complex.I * X 2, X 4] open MvPolynomial in -/-- The bilinears at the eigen-point of `repHiggs X` are the real generators, read through `transf`. -/ +/-- The bilinears at the eigen-point of `repHiggs X` are the real generators, + read through `transf`. -/ lemma neutralBilinear_eval_eigenPoint (X : Fin 4 → ℝ) (i : Fin 5) : eval (eigenPoint X) (neutralBilinear i) = eval (fun j => (↑(sliceBilinear X j) : ℂ)) (transf i) := by @@ -635,16 +639,17 @@ lemma exists_polynomial_repHiggs_sliceBilinear {V : EffectivePotential} {n : ℕ rw [show (fun i => eval (eigenPoint X) (neutralBilinear i)) = (fun i => eval (fun j => (↑(sliceBilinear X j) : ℂ)) (transf i)) from funext (neutralBilinear_eval_eigenPoint X)] - have hre : V (repHiggs X) = (eval (fun j => (↑(sliceBilinear X j) : ℂ)) (aeval transf G)).re := by - rw [← hval]; simp + have hre : V (repHiggs X) = (eval (fun j => (↑(sliceBilinear X j) : ℂ)) ( + aeval transf G)).re := by rw [← hval]; simp rw [hre, realPart_eval] /-! ## E. Clearing the `‖Φ1‖²` and `‖Φ2‖²` factors -Part D expresses the value as a polynomial in the bilinears, but two of them — `|Φ2₀|²` and `|Φ2₁|²` -— are not directly Gram polynomials. Multiplying by a power of `‖Φ1‖²` clears these; the doublet swap -of `SwapDoublet` then gives the mirror statement with `‖Φ2‖²`. +Part D expresses the value as a polynomial in the bilinears, but two of them — `|Φ2₀|²` + and `|Φ2₁|²` +— are not directly Gram polynomials. Multiplying by a power of `‖Φ1‖²` clears these; the +doublet swap of `SwapDoublet` then gives the mirror statement with `‖Φ2‖²`. -/ open MvPolynomial in @@ -677,7 +682,8 @@ open MvPolynomial in subalgebra: multiplying by `X₀²` pairs each `X₁²+X₂²` into `(X₀X₁)²+(X₀X₂)²` and each `X₃²` into the determinant `X₀²X₃²`, both of which are Gram polynomials. -/ lemma exists_clearing_mem (p : MvPolynomial (Fin 5) ℝ) : - ∃ N : ℕ, (X 0) ^ (2 * N) * aeval sliceBilinearPoly p ∈ Algebra.adjoin ℝ (Set.range gramPoly) := by + ∃ N : ℕ, (X 0) ^ (2 * N) * aeval sliceBilinearPoly p ∈ + Algebra.adjoin ℝ (Set.range gramPoly) := by set S := Algebra.adjoin ℝ (Set.range gramPoly) with hS have hgmem : ∀ μ, gramPoly μ ∈ S := fun μ => Algebra.subset_adjoin ⟨μ, rfl⟩ have hC : ∀ r : ℝ, (C r : MvPolynomial (Fin 4) ℝ) ∈ S := fun r => by @@ -905,11 +911,13 @@ lemma uPow_dvd {N M : ℕ} {A B : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ} rw [hc, mul_assoc, IsUnit.mul_val_inv, mul_one]⟩ -- `u` and `w` are relatively prime: any common divisor divides `u ± w = X inl0, X inr2`. have hsum : (X (Sum.inl 0) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) - = C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2)) + C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2)) := by + = C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2)) + C (1 / 2) * + (X (Sum.inl 0) - X (Sum.inr 2)) := by apply MvPolynomial.funext; intro y simp only [eval_add, eval_mul, eval_sub, eval_C, eval_X]; ring have hdiff : (X (Sum.inr 2) : MvPolynomial (Fin 1 ⊕ Fin 3) ℝ) - = C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2)) - C (1 / 2) * (X (Sum.inl 0) - X (Sum.inr 2)) := by + = C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2)) - C (1 / 2) * + (X (Sum.inl 0) - X (Sum.inr 2)) := by apply MvPolynomial.funext; intro y simp only [eval_add, eval_mul, eval_sub, eval_C, eval_X]; ring have hrel : IsRelPrime (C (1 / 2) * (X (Sum.inl 0) + X (Sum.inr 2))) From 5b47a61185f62cdff8e64b780b601510c8013994 Mon Sep 17 00:00:00 2001 From: Joseph Tooby-Smith <72603918+jstoobysmith@users.noreply.github.com> Date: Thu, 2 Jul 2026 10:17:42 +0100 Subject: [PATCH 25/25] refactor: Lint --- .../Particles/BeyondTheStandardModel/TwoHDM/Invariants.lean | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Invariants.lean b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Invariants.lean index 12ef03e1e..d547143b1 100644 --- a/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Invariants.lean +++ b/PhyslibAlpha/Particles/BeyondTheStandardModel/TwoHDM/Invariants.lean @@ -317,8 +317,9 @@ lemma coeff_Qslice_eq_zero {V : EffectivePotential} (hI : IsInvariant V) ## C. Generation by the neutral gauge-invariant bilinears The hypercharge-neutral monomials of `Qslice P` are exactly the products of the five neutral -quadratic bilinears `z z̄, w₀ w̄₀, z w̄₀, z̄ w₀, w₁ w̄₁` — the gauge invariants. This is the (abelian) -generation step: combined Cartan- and residual-neutrality of a monomial forces it to be a product of +quadratic bilinears `z z̄, w₀ w̄₀, z w̄₀, z̄ w₀, w₁ w̄₁` — the gauge invariants. +This is the (abelian)generation step: combined Cartan- and residual-neutrality of a +monomial forces it to be a product of these five, because every charged variable carries a unit Cartan charge and the residual charges come in an exact `±1` pair. -/