feat: Wick's theorem for normal order

2025-02-01 11:51:06 +00:00 · 2025-02-01 11:51:06 +00:00 · 006e29fd08
commit 006e29fd08
parent 12d36dc1d9
11 changed files with 1055 additions and 2 deletions
--- a/HepLean/PerturbationTheory/Algebras/FieldOpAlgebra/TimeContraction.lean
+++ b/HepLean/PerturbationTheory/Algebras/FieldOpAlgebra/TimeContraction.lean
@ -55,6 +55,13 @@ lemma timeContract_of_not_timeOrderRel (φ ψ : 𝓕.States) (h : ¬ timeOrderRe
  simp only [instCommGroup.eq_1, map_smul, map_add, smul_add]
  rw [smul_smul, smul_smul, mul_comm]

+lemma timeContract_of_not_timeOrderRel_expand (φ ψ : 𝓕.States) (h : ¬ timeOrderRel φ ψ) :
+    timeContract φ ψ = 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ψ) • [anPart ψ, ofFieldOp φ]ₛ := by
+  rw [timeContract_of_not_timeOrderRel _ _ h]
+  rw [timeContract_of_timeOrderRel _ _ _]
+  have h1 := IsTotal.total (r := 𝓕.timeOrderRel) φ ψ
+  simp_all
+
 lemma timeContract_mem_center (φ ψ : 𝓕.States) :
    timeContract φ ψ ∈ Subalgebra.center ℂ 𝓕.FieldOpAlgebra := by
  by_cases h : timeOrderRel φ ψ
@ -94,6 +101,77 @@ lemma normalOrder_timeContract (φ ψ : 𝓕.States) :
    rw [timeContract_of_timeOrderRel _ _ h1]
    simp

+lemma timeOrder_timeContract_eq_time_mid {φ ψ : 𝓕.States}
+    (h1 : timeOrderRel φ ψ) (h2 : timeOrderRel ψ φ) (a b : 𝓕.FieldOpAlgebra) :
+    𝓣(a * timeContract φ ψ * b) = timeContract φ ψ * 𝓣(a * b):= by
+  rw [timeContract_of_timeOrderRel _ _ h1]
+  rw [ofFieldOp_eq_sum]
+  simp [Finset.mul_sum, Finset.sum_mul]
+  congr
+  funext x
+  match φ with
+  | .inAsymp φ =>
+    simp
+  | .position φ =>
+    simp only [anPart_position, instCommGroup.eq_1]
+    apply timeOrder_superCommute_eq_time_mid _ _
+    simp [crAnTimeOrderRel, h1]
+    simp [crAnTimeOrderRel, h2]
+  | .outAsymp φ =>
+    simp only [anPart_posAsymp, instCommGroup.eq_1]
+    apply timeOrder_superCommute_eq_time_mid _ _
+    simp [crAnTimeOrderRel, h1]
+    simp [crAnTimeOrderRel, h2]
+
+lemma timeOrder_timeContract_eq_time_left {φ ψ : 𝓕.States}
+    (h1 : timeOrderRel φ ψ) (h2 : timeOrderRel ψ φ) (b : 𝓕.FieldOpAlgebra) :
+    𝓣(timeContract φ ψ * b) = timeContract φ ψ * 𝓣(b):= by
+  trans 𝓣(1 * timeContract φ ψ * b)
+  simp
+  rw [timeOrder_timeContract_eq_time_mid h1 h2]
+  simp
+
+lemma timeOrder_timeContract_neq_time {φ ψ : 𝓕.States}
+    (h1 : ¬ (timeOrderRel φ ψ ∧ timeOrderRel ψ φ)) :
+    𝓣(timeContract φ ψ) = 0 := by
+  by_cases h2 : timeOrderRel φ ψ
+  · simp_all
+    rw [timeContract_of_timeOrderRel _ _ h2]
+    simp
+    rw [ofFieldOp_eq_sum]
+    simp [Finset.mul_sum, Finset.sum_mul]
+    apply Finset.sum_eq_zero
+    intro x hx
+    match φ with
+    | .inAsymp φ =>
+      simp
+    | .position φ =>
+      simp only [anPart_position, instCommGroup.eq_1]
+      apply timeOrder_superCommute_neq_time
+      simp_all [crAnTimeOrderRel]
+    | .outAsymp φ =>
+      simp only [anPart_posAsymp, instCommGroup.eq_1]
+      apply timeOrder_superCommute_neq_time
+      simp_all [crAnTimeOrderRel]
+  · rw [timeContract_of_not_timeOrderRel_expand _ _ h2]
+    simp
+    right
+    rw [ofFieldOp_eq_sum]
+    simp [Finset.mul_sum, Finset.sum_mul]
+    apply Finset.sum_eq_zero
+    intro x hx
+    match ψ with
+    | .inAsymp ψ =>
+      simp
+    | .position ψ =>
+      simp only [anPart_position, instCommGroup.eq_1]
+      apply timeOrder_superCommute_neq_time
+      simp_all [crAnTimeOrderRel]
+    | .outAsymp ψ =>
+      simp only [anPart_posAsymp, instCommGroup.eq_1]
+      apply timeOrder_superCommute_neq_time
+      simp_all [crAnTimeOrderRel]
+
 end FieldOpAlgebra

 end
--- a/HepLean/PerturbationTheory/Algebras/FieldOpAlgebra/TimeOrder.lean
+++ b/HepLean/PerturbationTheory/Algebras/FieldOpAlgebra/TimeOrder.lean
@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Joseph Tooby-Smith
 -/
 import HepLean.PerturbationTheory.Algebras.CrAnAlgebra.TimeOrder
-import HepLean.PerturbationTheory.Algebras.FieldOpAlgebra.Basic
+import HepLean.PerturbationTheory.Algebras.FieldOpAlgebra.SuperCommute
 /-!

 # Time Ordering on Field operator algebra
@ -429,5 +429,80 @@ lemma timeOrder_eq_maxTimeField_mul_finset (φ : 𝓕.States) (φs : List 𝓕.S
  rw [ofFieldOpList, timeOrder_eq_ι_timeOrderF, timeOrderF_eq_maxTimeField_mul_finset]
  rfl

+lemma timeOrder_superCommute_eq_time_mid {φ ψ : 𝓕.CrAnStates}
+    (hφψ : crAnTimeOrderRel φ ψ) (hψφ : crAnTimeOrderRel ψ φ) (a b : 𝓕.FieldOpAlgebra) :
+    𝓣(a * [ofCrAnFieldOp φ, ofCrAnFieldOp ψ]ₛ * b) =
+    [ofCrAnFieldOp φ, ofCrAnFieldOp ψ]ₛ * 𝓣(a * b) := by
+  rw [ofCrAnFieldOp, ofCrAnFieldOp]
+  rw [superCommute_eq_ι_superCommuteF]
+  obtain ⟨a, rfl⟩ := ι_surjective a
+  obtain ⟨b, rfl⟩ := ι_surjective b
+  rw [← map_mul, ← map_mul, timeOrder_eq_ι_timeOrderF]
+  rw [ι_timeOrderF_superCommuteF_eq_time]
+  rfl
+  simp_all
+  simp_all
+
+lemma timeOrder_superCommute_eq_time_left {φ ψ : 𝓕.CrAnStates}
+    (hφψ : crAnTimeOrderRel φ ψ) (hψφ : crAnTimeOrderRel ψ φ) (b : 𝓕.FieldOpAlgebra) :
+    𝓣([ofCrAnFieldOp φ, ofCrAnFieldOp ψ]ₛ * b) =
+    [ofCrAnFieldOp φ, ofCrAnFieldOp ψ]ₛ * 𝓣(b) := by
+  trans 𝓣(1 * [ofCrAnFieldOp φ, ofCrAnFieldOp ψ]ₛ * b)
+  simp
+  rw [timeOrder_superCommute_eq_time_mid hφψ hψφ]
+  simp
+
+lemma timeOrder_superCommute_neq_time {φ ψ : 𝓕.CrAnStates}
+    (hφψ : ¬ (crAnTimeOrderRel φ ψ ∧ crAnTimeOrderRel ψ φ)) :
+    𝓣([ofCrAnFieldOp φ, ofCrAnFieldOp ψ]ₛ) = 0 := by
+  rw [ofCrAnFieldOp, ofCrAnFieldOp]
+  rw [superCommute_eq_ι_superCommuteF]
+  rw [timeOrder_eq_ι_timeOrderF]
+  trans  ι (timeOrderF (1 * (superCommuteF (ofCrAnState φ)) (ofCrAnState ψ) * 1))
+  simp
+  rw [ι_timeOrderF_superCommuteF_neq_time ]
+  exact hφψ
+
+lemma timeOrder_superCommute_anPart_ofFieldOp_neq_time {φ ψ : 𝓕.States}
+    (hφψ : ¬ (timeOrderRel φ ψ ∧ timeOrderRel ψ φ)) :
+    𝓣([anPart φ,ofFieldOp ψ]ₛ) = 0 := by
+  rw [ofFieldOp_eq_sum]
+  simp
+  apply Finset.sum_eq_zero
+  intro a ha
+  match φ with
+  | .inAsymp φ =>
+    simp
+  | .position φ =>
+    simp only [anPart_position, instCommGroup.eq_1]
+    apply timeOrder_superCommute_neq_time
+    simp_all [crAnTimeOrderRel]
+  | .outAsymp φ =>
+    simp only [anPart_posAsymp, instCommGroup.eq_1]
+    apply timeOrder_superCommute_neq_time
+    simp_all [crAnTimeOrderRel]
+
+lemma timeOrder_timeOrder_mid (a b c : 𝓕.FieldOpAlgebra) :
+    𝓣(a * b * c) = 𝓣(a * 𝓣(b) * c):= by
+  obtain ⟨a, rfl⟩ := ι_surjective a
+  obtain ⟨b, rfl⟩ := ι_surjective b
+  obtain ⟨c, rfl⟩ := ι_surjective c
+  rw [← map_mul, ← map_mul, timeOrder_eq_ι_timeOrderF, timeOrder_eq_ι_timeOrderF,
+   ← map_mul, ← map_mul,  timeOrder_eq_ι_timeOrderF, timeOrderF_timeOrderF_mid]
+
+lemma timeOrder_timeOrder_left (b c : 𝓕.FieldOpAlgebra) :
+    𝓣(b * c) = 𝓣(𝓣(b) * c):= by
+  trans 𝓣(1 * b * c)
+  simp
+  rw [timeOrder_timeOrder_mid]
+  simp
+
+lemma timeOrder_timeOrder_right (a b : 𝓕.FieldOpAlgebra) :
+    𝓣(a * b) = 𝓣(a * 𝓣(b)) := by
+  trans 𝓣(a * b * 1)
+  simp
+  rw [timeOrder_timeOrder_mid]
+  simp
+
 end FieldOpAlgebra
 end FieldSpecification
--- a/HepLean/PerturbationTheory/Algebras/FieldOpAlgebra/WicksTheoremNormal.lean
+++ b/HepLean/PerturbationTheory/Algebras/FieldOpAlgebra/WicksTheoremNormal.lean
@ -0,0 +1,191 @@
+/-
+Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joseph Tooby-Smith
+-/
+import HepLean.PerturbationTheory.WickContraction.TimeSet
+import HepLean.PerturbationTheory.Algebras.FieldOpAlgebra.StaticWickTheorem
+import HepLean.Meta.Remark.Basic
+/-!
+
+# Wick's theorem for normal ordered lists
+
+-/
+
+namespace FieldSpecification
+variable {𝓕 : FieldSpecification}
+open CrAnAlgebra
+namespace FieldOpAlgebra
+open WickContraction
+open EqTimeOnly
+
+lemma timeOrder_ofFieldOpList_eqTimeOnly (φs : List 𝓕.States) :
+    timeOrder (ofFieldOpList φs) = ∑ (φsΛ : EqTimeOnly φs),
+     φsΛ.1.sign • φsΛ.1.timeContract.1 * 𝓣(𝓝(ofFieldOpList [φsΛ.1]ᵘᶜ)):= by
+  rw [static_wick_theorem φs]
+  let e2 : WickContraction φs.length ≃ {φsΛ // φsΛ ∈ EqTimeOnly φs} ⊕ {φsΛ // ¬ φsΛ ∈ EqTimeOnly φs} :=
+    (Equiv.sumCompl (Membership.mem (EqTimeOnly φs))).symm
+  rw [← e2.symm.sum_comp]
+  simp only [Equiv.symm_symm, Algebra.smul_mul_assoc, Fintype.sum_sum_type,
+    Equiv.sumCompl_apply_inl, Equiv.sumCompl_apply_inr, map_add, map_sum, map_smul, e2]
+  conv_lhs =>
+    enter [2, 2, x]
+    rw [timeOrder_timeOrder_left]
+    rw [timeOrder_staticContract_of_not_mem _ x.2]
+  simp
+  congr
+  funext x
+  rw [staticContract_eq_timeContract]
+  rw [timeOrder_timeContract_mul_of_mem_left]
+  exact x.2
+
+lemma timeOrder_ofFieldOpList_eq_eqTimeOnly_empty (φs : List 𝓕.States) :
+    timeOrder (ofFieldOpList φs) =  𝓣(𝓝(ofFieldOpList φs)) +
+    ∑ (φsΛ : {φsΛ // φsΛ ∈ EqTimeOnly φs ∧ φsΛ ≠ empty}),
+     φsΛ.1.sign • φsΛ.1.timeContract.1 * 𝓣(𝓝(ofFieldOpList [φsΛ.1]ᵘᶜ)) := by
+  let e1 : EqTimeOnly φs ≃ {φsΛ : EqTimeOnly φs // φsΛ.1 = empty} ⊕ {φsΛ : EqTimeOnly φs // ¬ φsΛ.1 = empty} :=
+     (Equiv.sumCompl fun (a : EqTimeOnly φs) => a.1 = empty).symm
+  rw [timeOrder_ofFieldOpList_eqTimeOnly, ← e1.symm.sum_comp]
+  simp [e1]
+  congr 1
+  · let e2 : { φsΛ :  EqTimeOnly φs // φsΛ.1 = empty } ≃ Unit := {
+      toFun := fun x => (), invFun := fun x => ⟨⟨empty, by simp⟩, rfl⟩,
+      left_inv a := by
+        ext
+        simp [a.2], right_inv a := by simp }
+    rw [← e2.symm.sum_comp]
+    simp [e2, sign_empty]
+  · let e2 : { φsΛ :  EqTimeOnly φs // ¬ φsΛ.1 = empty } ≃
+      {φsΛ // φsΛ ∈ EqTimeOnly φs ∧ φsΛ ≠ empty} := {
+        toFun := fun x => ⟨x, ⟨x.1.2, x.2⟩⟩, invFun := fun x => ⟨⟨x.1, x.2.1⟩, x.2.2⟩,
+        left_inv a := by rfl, right_inv a := by rfl }
+    rw [← e2.symm.sum_comp]
+    rfl
+
+lemma normalOrder_timeOrder_ofFieldOpList_eq_eqTimeOnly_empty (φs : List 𝓕.States) :
+    𝓣(𝓝(ofFieldOpList φs)) =  𝓣(ofFieldOpList φs) -
+    ∑ (φsΛ : {φsΛ // φsΛ ∈ EqTimeOnly φs ∧ φsΛ ≠ empty}),
+     φsΛ.1.sign • φsΛ.1.timeContract.1 * 𝓣(𝓝(ofFieldOpList [φsΛ.1]ᵘᶜ)) := by
+  rw [timeOrder_ofFieldOpList_eq_eqTimeOnly_empty]
+  simp
+
+lemma normalOrder_timeOrder_ofFieldOpList_eq_haveEqTime_sum_not_haveEqTime (φs : List 𝓕.States) :
+    𝓣(𝓝(ofFieldOpList φs)) =  (∑ (φsΛ : {φsΛ : WickContraction φs.length // ¬ HaveEqTime φsΛ}),
+     φsΛ.1.sign • φsΛ.1.timeContract.1 * 𝓝(ofFieldOpList [φsΛ.1]ᵘᶜ))
+     + (∑ (φsΛ : {φsΛ : WickContraction φs.length // HaveEqTime φsΛ}),
+     φsΛ.1.sign • φsΛ.1.timeContract.1 * 𝓝(ofFieldOpList [φsΛ.1]ᵘᶜ))
+     - ∑ (φsΛ : {φsΛ // φsΛ ∈ EqTimeOnly φs ∧ φsΛ ≠ empty}),
+     φsΛ.1.sign • φsΛ.1.timeContract.1 * 𝓣(𝓝(ofFieldOpList [φsΛ.1]ᵘᶜ)) := by
+  rw [normalOrder_timeOrder_ofFieldOpList_eq_eqTimeOnly_empty]
+  rw [wicks_theorem]
+  let e1 : WickContraction φs.length ≃ {φsΛ //  HaveEqTime φsΛ} ⊕  {φsΛ // ¬ HaveEqTime φsΛ} := by
+    exact (Equiv.sumCompl HaveEqTime).symm
+  rw [← e1.symm.sum_comp]
+  simp [e1]
+  rw [add_comm]
+
+lemma haveEqTime_wick_sum_eq_split (φs : List 𝓕.States) :
+    (∑ (φsΛ : {φsΛ : WickContraction φs.length // HaveEqTime φsΛ}),
+     φsΛ.1.sign • φsΛ.1.timeContract.1 * 𝓝(ofFieldOpList [φsΛ.1]ᵘᶜ)) =
+    ∑ (φsΛ : {φsΛ // φsΛ ∈ EqTimeOnly φs ∧ φsΛ ≠ empty}), (sign φs ↑φsΛ • (φsΛ.1).timeContract *
+    ∑ φssucΛ : { φssucΛ : WickContraction [φsΛ.1]ᵘᶜ.length // ¬φssucΛ.HaveEqTime },
+      sign [φsΛ.1]ᵘᶜ φssucΛ •
+      (φssucΛ.1).timeContract * normalOrder (ofFieldOpList [φssucΛ.1]ᵘᶜ)) := by
+  let f : WickContraction φs.length → 𝓕.FieldOpAlgebra := fun φsΛ =>
+    φsΛ.sign • φsΛ.timeContract.1 * 𝓝(ofFieldOpList [φsΛ]ᵘᶜ)
+  change ∑ (φsΛ : {φsΛ : WickContraction φs.length // HaveEqTime φsΛ}), f φsΛ.1 = _
+  rw [sum_haveEqTime]
+  congr
+  funext φsΛ
+  simp only [ f]
+  conv_lhs =>
+    enter [2, φsucΛ]
+    enter [1]
+    rw [join_sign_timeContract φsΛ.1 φsucΛ.1]
+  conv_lhs =>
+    enter [2, φsucΛ]
+    rw [mul_assoc]
+  rw [← Finset.mul_sum]
+  congr
+  funext φsΛ'
+  simp
+  congr 1
+  rw [@join_uncontractedListGet]
+
+
+lemma normalOrder_timeOrder_ofFieldOpList_eq_not_haveEqTime_sub_inductive (φs : List 𝓕.States) :
+    𝓣(𝓝(ofFieldOpList φs)) = (∑ (φsΛ : {φsΛ : WickContraction φs.length // ¬ HaveEqTime φsΛ}),
+     φsΛ.1.sign • φsΛ.1.timeContract.1 * 𝓝(ofFieldOpList [φsΛ.1]ᵘᶜ))
+      + ∑ (φsΛ : {φsΛ // φsΛ ∈ EqTimeOnly φs ∧ φsΛ ≠ empty}),
+        sign φs ↑φsΛ • (φsΛ.1).timeContract *
+        (∑ φssucΛ : { φssucΛ : WickContraction [φsΛ.1]ᵘᶜ.length // ¬ φssucΛ.HaveEqTime },
+      sign [φsΛ.1]ᵘᶜ φssucΛ • (φssucΛ.1).timeContract * normalOrder (ofFieldOpList [φssucΛ.1]ᵘᶜ) -
+       𝓣(𝓝(ofFieldOpList [φsΛ.1]ᵘᶜ))) := by
+  rw [normalOrder_timeOrder_ofFieldOpList_eq_haveEqTime_sum_not_haveEqTime]
+  rw [add_sub_assoc]
+  congr 1
+  rw [haveEqTime_wick_sum_eq_split]
+  simp
+  rw [← Finset.sum_sub_distrib]
+  congr 1
+  funext x
+  simp
+  rw [← smul_sub, ← mul_sub]
+
+lemma wicks_theorem_normal_order_empty : 𝓣(𝓝(ofFieldOpList [])) = ∑ (φsΛ : {φsΛ : WickContraction ([] : List 𝓕.States).length // ¬ HaveEqTime φsΛ}),
+     φsΛ.1.sign • φsΛ.1.timeContract.1 * 𝓝(ofFieldOpList [φsΛ.1]ᵘᶜ)  := by
+  let e2 : {φsΛ : WickContraction ([] : List 𝓕.States).length // ¬ HaveEqTime φsΛ} ≃ Unit :=
+    {
+      toFun := fun x => (),
+      invFun := fun x => ⟨empty, by simp⟩,
+      left_inv := by
+        intro a
+        simp
+        apply Subtype.eq
+        apply Subtype.eq
+        simp [empty]
+        ext i
+        simp
+        by_contra hn
+        have h2 := a.1.2.1 i hn
+        rw [@Finset.card_eq_two] at h2
+        obtain ⟨a, b, ha, hb, hab⟩ := h2
+        exact Fin.elim0 a,
+      right_inv := by intro a; simp}
+  rw [← e2.symm.sum_comp]
+  simp [e2, sign_empty]
+  have h1' : ofFieldOpList (𝓕 := 𝓕) [] = ofCrAnFieldOpList [] := by rfl
+  rw [h1']
+  rw [normalOrder_ofCrAnFieldOpList]
+  simp
+  rw [ofCrAnFieldOpList, timeOrder_eq_ι_timeOrderF]
+  rw [timeOrderF_ofCrAnList]
+  simp
+
+theorem wicks_theorem_normal_order : (φs : List 𝓕.States) →
+    𝓣(𝓝(ofFieldOpList φs)) = ∑ (φsΛ : {φsΛ : WickContraction φs.length // ¬ HaveEqTime φsΛ}),
+     φsΛ.1.sign • φsΛ.1.timeContract.1 * 𝓝(ofFieldOpList [φsΛ.1]ᵘᶜ)
+  | [] => wicks_theorem_normal_order_empty
+  | φ :: φs => by
+    rw [normalOrder_timeOrder_ofFieldOpList_eq_not_haveEqTime_sub_inductive]
+    simp only [ Algebra.smul_mul_assoc, ne_eq, add_right_eq_self]
+    apply Finset.sum_eq_zero
+    intro φsΛ hφsΛ
+    simp only [smul_eq_zero]
+    right
+    have ih := wicks_theorem_normal_order [φsΛ.1]ᵘᶜ
+    rw [ih]
+    simp
+termination_by φs => φs.length
+decreasing_by
+  simp only [uncontractedListGet, List.length_cons, List.length_map, gt_iff_lt]
+  rw [uncontractedList_length_eq_card]
+  have hc := uncontracted_card_eq_iff φsΛ.1
+  simp [φsΛ.2.2] at hc
+  have hc' := uncontracted_card_le φsΛ.1
+  simp_all
+  omega
+
+
+end FieldOpAlgebra
+end FieldSpecification