refactor: Docs around Wick's theorem (#289)

* refactor: Organize supercommute for CrAnAlgebra

* refactor: Normal order results

* refactor: Uncontracted List organization

* refactor: Rename OperatorAlgebra

* refactor: Lint
This commit is contained in:
Joseph Tooby-Smith 2025-01-22 09:15:13 +00:00 committed by GitHub
parent 7b396501e7
commit 36d3be1cbf
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
17 changed files with 685 additions and 619 deletions

View file

@ -3,7 +3,7 @@ Copyright (c) 2025 Joseph Tooby-Smith. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.PerturbationTheory.Algebras.OperatorAlgebra.NormalOrder
import HepLean.PerturbationTheory.Algebras.ProtoOperatorAlgebra.NormalOrder
import HepLean.Mathematics.List.InsertIdx
/-!

View file

@ -5,7 +5,7 @@ Authors: Joseph Tooby-Smith
-/
import HepLean.PerturbationTheory.WickContraction.Uncontracted
import HepLean.PerturbationTheory.Algebras.StateAlgebra.TimeOrder
import HepLean.PerturbationTheory.Algebras.OperatorAlgebra.TimeContraction
import HepLean.PerturbationTheory.Algebras.ProtoOperatorAlgebra.TimeContraction
import HepLean.PerturbationTheory.WickContraction.InsertList
/-!

View file

@ -19,6 +19,7 @@ namespace WickContraction
variable {n : } (c : WickContraction n)
open HepLean.List
open FieldStatistic
open Nat
/-- A contraction is full if there are no uncontracted fields, i.e. the finite set
of uncontracted fields is empty. -/
@ -46,8 +47,6 @@ def isFullInvolutionEquiv : {c : WickContraction n // IsFull c} ≃
left_inv c := by simp
right_inv f := by simp
open Nat
/-- If `n` is even then the number of full contractions is `(n-1)!!`. -/
theorem card_of_isfull_even (he : Even n) :
Fintype.card {c : WickContraction n // IsFull c} = (n - 1)‼ := by

View file

@ -85,8 +85,7 @@ lemma signFinset_insertList_none (φ : 𝓕.States) (φs : List 𝓕.States)
lemma stat_ofFinset_of_insertListLiftFinset (φ : 𝓕.States) (φs : List 𝓕.States)
(i : Fin φs.length.succ) (a : Finset (Fin φs.length)) :
(𝓕 |>ₛ ⟨(φs.insertIdx i φ).get, insertListLiftFinset φ i a⟩) =
𝓕 |>ₛ ⟨φs.get, a⟩ := by
(𝓕 |>ₛ ⟨(φs.insertIdx i φ).get, insertListLiftFinset φ i a⟩) = 𝓕 |>ₛ ⟨φs.get, a⟩ := by
simp only [ofFinset, Nat.succ_eq_add_one]
congr 1
rw [get_eq_insertIdx_succAbove φ _ i]
@ -823,8 +822,7 @@ lemma stat_signFinset_insert_some_self_fst
simpa [Option.get_map] using hy2
lemma stat_signFinset_insert_some_self_snd (φ : 𝓕.States) (φs : List 𝓕.States)
(c : WickContraction φs.length)
(i : Fin φs.length.succ) (j : c.uncontracted) :
(c : WickContraction φs.length) (i : Fin φs.length.succ) (j : c.uncontracted) :
(𝓕 |>ₛ ⟨(φs.insertIdx i φ).get,
(signFinset (c.insertList φ φs i (some j))
(finCongr (insertIdx_length_fin φ φs i).symm (i.succAbove j))
@ -832,8 +830,7 @@ lemma stat_signFinset_insert_some_self_snd (φ : 𝓕.States) (φs : List 𝓕.S
𝓕 |>ₛ ⟨φs.get,
(Finset.univ.filter (fun x => j < x ∧ i.succAbove x < i ∧ ((c.getDual? x = none)
∀ (h : (c.getDual? x).isSome), j < ((c.getDual? x).get h))))⟩ := by
rw [get_eq_insertIdx_succAbove φ _ i]
rw [ofFinset_finset_map]
rw [get_eq_insertIdx_succAbove φ _ i, ofFinset_finset_map]
swap
refine
(Equiv.comp_injective i.succAbove (finCongr (Eq.symm (insertIdx_length_fin φ φs i)))).mpr ?hi.a
@ -905,55 +902,43 @@ lemma stat_signFinset_insert_some_self_snd (φ : 𝓕.States) (φs : List 𝓕.S
exact Fin.succAbove_lt_succAbove_iff.mpr hy2
lemma signInsertSomeCoef_eq_finset (φ : 𝓕.States) (φs : List 𝓕.States)
(c : WickContraction φs.length)
(i : Fin φs.length.succ) (j : c.uncontracted) (hφj : (𝓕 |>ₛ φ) = (𝓕 |>ₛ φs[j.1])) :
c.signInsertSomeCoef φ φs i j =
(c : WickContraction φs.length) (i : Fin φs.length.succ) (j : c.uncontracted)
(hφj : (𝓕 |>ₛ φ) = (𝓕 |>ₛ φs[j.1])) : c.signInsertSomeCoef φ φs i j =
if i < i.succAbove j then
𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ⟨φs.get,
(Finset.univ.filter (fun x => i < i.succAbove x ∧ x < j ∧ ((c.getDual? x = none)
∀ (h : (c.getDual? x).isSome), i < i.succAbove ((c.getDual? x).get h))))⟩) else
𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ⟨φs.get,
(Finset.univ.filter (fun x => j < x ∧ i.succAbove x < i ∧ ((c.getDual? x = none)
∀ (h : (c.getDual? x).isSome), j < ((c.getDual? x).get h))))⟩) := by
rw [signInsertSomeCoef_if]
rw [stat_signFinset_insert_some_self_snd]
rw [stat_signFinset_insert_some_self_fst]
𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ⟨φs.get,
(Finset.univ.filter (fun x => i < i.succAbove x ∧ x < j ∧ ((c.getDual? x = none)
∀ (h : (c.getDual? x).isSome), i < i.succAbove ((c.getDual? x).get h))))⟩)
else
𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ⟨φs.get,
(Finset.univ.filter (fun x => j < x ∧ i.succAbove x < i ∧ ((c.getDual? x = none)
∀ (h : (c.getDual? x).isSome), j < ((c.getDual? x).get h))))⟩) := by
rw [signInsertSomeCoef_if, stat_signFinset_insert_some_self_snd,
stat_signFinset_insert_some_self_fst]
simp [hφj]
lemma signInsertSome_mul_filter_contracted_of_lt (φ : 𝓕.States) (φs : List 𝓕.States)
(c : WickContraction φs.length) (i : Fin φs.length.succ) (k : c.uncontracted)
(hk : i.succAbove k < i)
(hg : GradingCompliant φs c ∧ 𝓕.statesStatistic φ = 𝓕.statesStatistic φs[k.1]) :
(hk : i.succAbove k < i) (hg : GradingCompliant φs c ∧ (𝓕 |>ₛ φ) = 𝓕 |>ₛ φs[k.1]) :
signInsertSome φ φs c i k *
𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ⟨φs.get, c.uncontracted.filter (fun x => x ≤ ↑k)⟩)
= 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ⟨φs.get, Finset.univ.filter (fun x => i.succAbove x < i)⟩) := by
rw [signInsertSome, signInsertSomeProd_eq_finset, signInsertSomeCoef_eq_finset]
rw [if_neg (by omega), ← map_mul, ← map_mul]
rw [signInsertSome, signInsertSomeProd_eq_finset (hφj := hg.2) (hg := hg.1),
signInsertSomeCoef_eq_finset (hφj := hg.2), if_neg (by omega), ← map_mul, ← map_mul]
congr 1
rw [mul_eq_iff_eq_mul, ofFinset_union_disjoint]
swap
· rw [Finset.disjoint_filter]
· /- Disjointness needed for `ofFinset_union_disjoint`. -/
rw [Finset.disjoint_filter]
intro j _ h
simp only [Nat.succ_eq_add_one, not_lt, not_and, not_forall, not_or, not_le]
intro h1
use h1
omega
trans 𝓕 |>ₛ ⟨φs.get, (Finset.filter (fun x =>
(↑k < x ∧ i.succAbove x < i ∧ (c.getDual? x = none
∀ (h : (c.getDual? x).isSome = true), ↑k < (c.getDual? x).get h))
((c.getDual? x).isSome = true ∧
∀ (h : (c.getDual? x).isSome = true), x < ↑k ∧
(i.succAbove x < i ∧ i < i.succAbove ((c.getDual? x).get h)
↑k < (c.getDual? x).get h ∧ ¬i.succAbove x < i))) Finset.univ)⟩
· congr
ext j
simp
rw [ofFinset_union, ← mul_eq_one_iff, ofFinset_union]
simp only [Nat.succ_eq_add_one, not_lt]
apply stat_ofFinset_eq_one_of_gradingCompliant
· exact hg.1
/- the getDual? is none case-/
· intro j hn
apply stat_ofFinset_eq_one_of_gradingCompliant _ _ _ hg.1
· /- The `c.getDual? i = none` case for `stat_ofFinset_eq_one_of_gradingCompliant`. -/
intro j hn
simp only [uncontracted, Finset.mem_sdiff, Finset.mem_union, Finset.mem_filter, Finset.mem_univ,
hn, Option.isSome_none, Bool.false_eq_true, IsEmpty.forall_iff, or_self, and_true, or_false,
true_and, and_self, Finset.mem_inter, not_and, not_lt, Classical.not_imp, not_le, and_imp]
@ -978,8 +963,8 @@ lemma signInsertSome_mul_filter_contracted_of_lt (φ : 𝓕.States) (φs : List
apply Fin.ne_succAbove i j
omega
· exact h1'
/- the getDual? is some case-/
· intro j hj
· /- The `(c.getDual? i).isSome` case for `stat_ofFinset_eq_one_of_gradingCompliant`. -/
intro j hj
have hn : ¬ c.getDual? j = none := by exact Option.isSome_iff_ne_none.mp hj
simp only [uncontracted, Finset.mem_sdiff, Finset.mem_union, Finset.mem_filter, Finset.mem_univ,
hn, hj, forall_true_left, false_or, true_and, and_false, false_and, Finset.mem_inter,
@ -1033,28 +1018,24 @@ lemma signInsertSome_mul_filter_contracted_of_lt (φ : 𝓕.States) (φs : List
· simp_all only [Fin.getElem_fin, ne_eq, not_lt, false_and, false_or, or_false, and_self,
or_true, imp_self]
omega
· exact hg.2
· exact hg.2
· exact hg.1
lemma signInsertSome_mul_filter_contracted_of_not_lt (φ : 𝓕.States) (φs : List 𝓕.States)
(c : WickContraction φs.length) (i : Fin φs.length.succ) (k : c.uncontracted)
(hk : ¬ i.succAbove k < i)
(hg : GradingCompliant φs c ∧ 𝓕.statesStatistic φ = 𝓕.statesStatistic φs[k.1]) :
(hk : ¬ i.succAbove k < i) (hg : GradingCompliant φs c ∧ (𝓕 |>ₛ φ) = 𝓕 |>ₛ φs[k.1]) :
signInsertSome φ φs c i k *
𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ⟨φs.get, c.uncontracted.filter (fun x => x < ↑k)⟩)
= 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ⟨φs.get, Finset.univ.filter (fun x => i.succAbove x < i)⟩) := by
have hik : i.succAbove ↑k ≠ i := by exact Fin.succAbove_ne i ↑k
rw [signInsertSome, signInsertSomeProd_eq_finset, signInsertSomeCoef_eq_finset]
rw [if_pos (by omega), ← map_mul, ← map_mul]
rw [signInsertSome, signInsertSomeProd_eq_finset (hφj := hg.2) (hg := hg.1),
signInsertSomeCoef_eq_finset (hφj := hg.2), if_pos (by omega), ← map_mul, ← map_mul]
congr 1
rw [mul_eq_iff_eq_mul, ofFinset_union, ofFinset_union]
apply (mul_eq_one_iff _ _).mp
rw [ofFinset_union]
simp only [Nat.succ_eq_add_one, not_lt]
apply stat_ofFinset_eq_one_of_gradingCompliant
· exact hg.1
· intro j hj
apply stat_ofFinset_eq_one_of_gradingCompliant _ _ _ hg.1
· /- The `c.getDual? i = none` case for `stat_ofFinset_eq_one_of_gradingCompliant`. -/
intro j hj
have hijsucc : i.succAbove j ≠ i := by exact Fin.succAbove_ne i j
simp only [uncontracted, Finset.mem_sdiff, Finset.mem_union, Finset.mem_filter, Finset.mem_univ,
hj, Option.isSome_none, Bool.false_eq_true, IsEmpty.forall_iff, or_self, and_true, true_and,
@ -1072,7 +1053,8 @@ lemma signInsertSome_mul_filter_contracted_of_not_lt (φ : 𝓕.States) (φs : L
omega
simp only [hij, true_and] at h ⊢
omega
· intro j hj
· /- The `(c.getDual? i).isSome` case for `stat_ofFinset_eq_one_of_gradingCompliant`. -/
intro j hj
have hn : ¬ c.getDual? j = none := by exact Option.isSome_iff_ne_none.mp hj
have hijSuc : i.succAbove j ≠ i := by exact Fin.succAbove_ne i j
have hkneqj : ↑k ≠ j := by
@ -1136,8 +1118,5 @@ lemma signInsertSome_mul_filter_contracted_of_not_lt (φ : 𝓕.States) (φs : L
simp only [hijn, true_and, hijn', and_false, or_false, or_true, imp_false, not_lt,
forall_const]
exact fun h => lt_of_le_of_ne h (Fin.succAbove_ne i ((c.getDual? j).get hj))
· exact hg.2
· exact hg.2
· exact hg.1
end WickContraction

View file

@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Tooby-Smith
-/
import HepLean.PerturbationTheory.WickContraction.Sign
import HepLean.PerturbationTheory.Algebras.OperatorAlgebra.TimeContraction
import HepLean.PerturbationTheory.Algebras.ProtoOperatorAlgebra.TimeContraction
/-!
# Time contractions
@ -18,23 +18,17 @@ namespace WickContraction
variable {n : } (c : WickContraction n)
open HepLean.List
/-!
## Time contract.
-/
/-- Given a Wick contraction `c` associated with a list `φs`, the
product of all time-contractions of pairs of contracted elements in `φs`,
as a member of the center of `𝓞.A`. -/
noncomputable def timeContract (𝓞 : 𝓕.OperatorAlgebra) {φs : List 𝓕.States}
noncomputable def timeContract (𝓞 : 𝓕.ProtoOperatorAlgebra) {φs : List 𝓕.States}
(c : WickContraction φs.length) :
Subalgebra.center 𝓞.A :=
∏ (a : c.1), ⟨𝓞.timeContract (φs.get (c.fstFieldOfContract a)) (φs.get (c.sndFieldOfContract a)),
𝓞.timeContract_mem_center _ _⟩
@[simp]
lemma timeContract_insertList_none (𝓞 : 𝓕.OperatorAlgebra) (φ : 𝓕.States) (φs : List 𝓕.States)
lemma timeContract_insertList_none (𝓞 : 𝓕.ProtoOperatorAlgebra) (φ : 𝓕.States) (φs : List 𝓕.States)
(c : WickContraction φs.length) (i : Fin φs.length.succ) :
(c.insertList φ φs i none).timeContract 𝓞 = c.timeContract 𝓞 := by
rw [timeContract, insertList_none_prod_contractions]
@ -42,7 +36,7 @@ lemma timeContract_insertList_none (𝓞 : 𝓕.OperatorAlgebra) (φ : 𝓕.Stat
ext a
simp
lemma timeConract_insertList_some (𝓞 : 𝓕.OperatorAlgebra) (φ : 𝓕.States) (φs : List 𝓕.States)
lemma timeConract_insertList_some (𝓞 : 𝓕.ProtoOperatorAlgebra) (φ : 𝓕.States) (φs : List 𝓕.States)
(c : WickContraction φs.length) (i : Fin φs.length.succ) (j : c.uncontracted) :
(c.insertList φ φs i (some j)).timeContract 𝓞 =
(if i < i.succAbove j then
@ -62,7 +56,7 @@ lemma timeConract_insertList_some (𝓞 : 𝓕.OperatorAlgebra) (φ : 𝓕.State
open FieldStatistic
lemma timeConract_insertList_some_eq_mul_contractStateAtIndex_lt
(𝓞 : 𝓕.OperatorAlgebra) (φ : 𝓕.States) (φs : List 𝓕.States)
(𝓞 : 𝓕.ProtoOperatorAlgebra) (φ : 𝓕.States) (φs : List 𝓕.States)
(c : WickContraction φs.length) (i : Fin φs.length.succ) (k : c.uncontracted)
(ht : 𝓕.timeOrderRel φ φs[k.1]) (hik : i < i.succAbove k) :
(c.insertList φ φs i (some k)).timeContract 𝓞 =
@ -71,9 +65,9 @@ lemma timeConract_insertList_some_eq_mul_contractStateAtIndex_lt
((uncontractedStatesEquiv φs c) (some k)) * c.timeContract 𝓞) := by
rw [timeConract_insertList_some]
simp only [Nat.succ_eq_add_one, Fin.getElem_fin, ite_mul, instCommGroup.eq_1,
OperatorAlgebra.contractStateAtIndex, uncontractedStatesEquiv, Equiv.optionCongr_apply,
ProtoOperatorAlgebra.contractStateAtIndex, uncontractedStatesEquiv, Equiv.optionCongr_apply,
Equiv.coe_trans, Option.map_some', Function.comp_apply, finCongr_apply, Fin.coe_cast,
List.getElem_map, uncontractedList_getElem_uncontractedFinEquiv_symm, List.get_eq_getElem,
List.getElem_map, uncontractedList_getElem_uncontractedIndexEquiv_symm, List.get_eq_getElem,
Algebra.smul_mul_assoc]
· simp only [hik, ↓reduceIte, MulMemClass.coe_mul]
rw [𝓞.timeContract_of_timeOrderRel]
@ -83,21 +77,21 @@ lemma timeConract_insertList_some_eq_mul_contractStateAtIndex_lt
· simp
simp only [smul_smul]
congr
have h1 : ofList 𝓕.statesStatistic (List.take (↑(c.uncontractedFinEquiv.symm k))
have h1 : ofList 𝓕.statesStatistic (List.take (↑(c.uncontractedIndexEquiv.symm k))
(List.map φs.get c.uncontractedList))
= (𝓕 |>ₛ ⟨φs.get, (Finset.filter (fun x => x < k) c.uncontracted)⟩) := by
simp only [ofFinset]
congr
rw [← List.map_take]
congr
rw [take_uncontractedFinEquiv_symm]
rw [take_uncontractedIndexEquiv_symm]
rw [filter_uncontractedList]
rw [h1]
simp only [exchangeSign_mul_self]
· exact ht
lemma timeConract_insertList_some_eq_mul_contractStateAtIndex_not_lt
(𝓞 : 𝓕.OperatorAlgebra) (φ : 𝓕.States) (φs : List 𝓕.States)
(𝓞 : 𝓕.ProtoOperatorAlgebra) (φ : 𝓕.States) (φs : List 𝓕.States)
(c : WickContraction φs.length) (i : Fin φs.length.succ) (k : c.uncontracted)
(ht : ¬ 𝓕.timeOrderRel φs[k.1] φ) (hik : ¬ i < i.succAbove k) :
(c.insertList φ φs i (some k)).timeContract 𝓞 =
@ -106,22 +100,22 @@ lemma timeConract_insertList_some_eq_mul_contractStateAtIndex_not_lt
((uncontractedStatesEquiv φs c) (some k)) * c.timeContract 𝓞) := by
rw [timeConract_insertList_some]
simp only [Nat.succ_eq_add_one, Fin.getElem_fin, ite_mul, instCommGroup.eq_1,
OperatorAlgebra.contractStateAtIndex, uncontractedStatesEquiv, Equiv.optionCongr_apply,
ProtoOperatorAlgebra.contractStateAtIndex, uncontractedStatesEquiv, Equiv.optionCongr_apply,
Equiv.coe_trans, Option.map_some', Function.comp_apply, finCongr_apply, Fin.coe_cast,
List.getElem_map, uncontractedList_getElem_uncontractedFinEquiv_symm, List.get_eq_getElem,
List.getElem_map, uncontractedList_getElem_uncontractedIndexEquiv_symm, List.get_eq_getElem,
Algebra.smul_mul_assoc]
simp only [hik, ↓reduceIte, MulMemClass.coe_mul]
rw [𝓞.timeContract_of_not_timeOrderRel, 𝓞.timeContract_of_timeOrderRel]
simp only [instCommGroup.eq_1, Algebra.smul_mul_assoc, smul_smul]
congr
have h1 : ofList 𝓕.statesStatistic (List.take (↑(c.uncontractedFinEquiv.symm k))
have h1 : ofList 𝓕.statesStatistic (List.take (↑(c.uncontractedIndexEquiv.symm k))
(List.map φs.get c.uncontractedList))
= (𝓕 |>ₛ ⟨φs.get, (Finset.filter (fun x => x < k) c.uncontracted)⟩) := by
simp only [ofFinset]
congr
rw [← List.map_take]
congr
rw [take_uncontractedFinEquiv_symm, filter_uncontractedList]
rw [take_uncontractedIndexEquiv_symm, filter_uncontractedList]
rw [h1]
trans 𝓢(𝓕 |>ₛ φ, 𝓕 |>ₛ ⟨φs.get, {k.1}⟩)
· rw [exchangeSign_symm, ofFinset_singleton]
@ -148,7 +142,7 @@ lemma timeConract_insertList_some_eq_mul_contractStateAtIndex_not_lt
simp_all only [Fin.getElem_fin, Nat.succ_eq_add_one, not_lt, false_or]
exact ht
lemma timeContract_of_not_gradingCompliant (𝓞 : 𝓕.OperatorAlgebra) (φs : List 𝓕.States)
lemma timeContract_of_not_gradingCompliant (𝓞 : 𝓕.ProtoOperatorAlgebra) (φs : List 𝓕.States)
(c : WickContraction φs.length) (h : ¬ GradingCompliant φs c) :
c.timeContract 𝓞 = 0 := by
rw [timeContract]
@ -159,7 +153,7 @@ lemma timeContract_of_not_gradingCompliant (𝓞 : 𝓕.OperatorAlgebra) (φs :
simp only [Finset.univ_eq_attach, Finset.mem_attach]
apply Subtype.eq
simp only [List.get_eq_getElem, ZeroMemClass.coe_zero]
rw [OperatorAlgebra.timeContract_zero_of_diff_grade]
rw [ProtoOperatorAlgebra.timeContract_zero_of_diff_grade]
simp [ha2]
end WickContraction

View file

@ -219,6 +219,99 @@ lemma uncontractedList_length_eq_card (c : WickContraction n) :
rw [uncontractedList_eq_sort]
exact Finset.length_sort fun x1 x2 => x1 ≤ x2
lemma filter_uncontractedList (c : WickContraction n) (p : Fin n → Prop) [DecidablePred p] :
(c.uncontractedList.filter p) = (c.uncontracted.filter p).sort (· ≤ ·) := by
have h1 : (c.uncontractedList.filter p).Sorted (· ≤ ·) := by
apply List.Sorted.filter
exact uncontractedList_sorted c
have h2 : (c.uncontractedList.filter p).Nodup := by
refine List.Nodup.filter _ ?_
exact uncontractedList_nodup c
have h3 : (c.uncontractedList.filter p).toFinset = (c.uncontracted.filter p) := by
ext a
simp only [List.toFinset_filter, decide_eq_true_eq, Finset.mem_filter, List.mem_toFinset,
and_congr_left_iff]
rw [uncontractedList_mem_iff]
simp
have hx := (List.toFinset_sort (· ≤ ·) h2).mpr h1
rw [← hx, h3]
/-!
## uncontractedIndexEquiv
-/
/-- The equivalence between the positions of `c.uncontractedList` i.e. elements of
`Fin (c.uncontractedList).length` and the finite set `c.uncontracted` considered as a finite type.
-/
def uncontractedIndexEquiv (c : WickContraction n) :
Fin (c.uncontractedList).length ≃ c.uncontracted where
toFun i := ⟨c.uncontractedList.get i, c.uncontractedList_get_mem_uncontracted i⟩
invFun i := ⟨List.indexOf i.1 c.uncontractedList,
List.indexOf_lt_length.mpr ((c.uncontractedList_mem_iff i.1).mpr i.2)⟩
left_inv i := by
ext
exact List.get_indexOf (uncontractedList_nodup c) _
right_inv i := by
ext
simp
@[simp]
lemma uncontractedList_getElem_uncontractedIndexEquiv_symm (k : c.uncontracted) :
c.uncontractedList[(c.uncontractedIndexEquiv.symm k).val] = k := by
simp [uncontractedIndexEquiv]
lemma uncontractedIndexEquiv_symm_eq_filter_length (k : c.uncontracted) :
(c.uncontractedIndexEquiv.symm k).val =
(List.filter (fun i => i < k.val) c.uncontractedList).length := by
simp only [uncontractedIndexEquiv, List.get_eq_getElem, Equiv.coe_fn_symm_mk]
rw [fin_list_sorted_indexOf_mem]
· simp
· exact uncontractedList_sorted c
· rw [uncontractedList_mem_iff]
exact k.2
lemma take_uncontractedIndexEquiv_symm (k : c.uncontracted) :
c.uncontractedList.take (c.uncontractedIndexEquiv.symm k).val =
c.uncontractedList.filter (fun i => i < k.val) := by
have hl := fin_list_sorted_split c.uncontractedList (uncontractedList_sorted c) k.val
conv_lhs =>
rhs
rw [hl]
rw [uncontractedIndexEquiv_symm_eq_filter_length]
simp
/-!
## uncontractedStatesEquiv
-/
/-- The equivalence between the type `Option c.uncontracted` for `WickContraction φs.length` and
`Option (Fin (c.uncontractedList.map φs.get).length)`, that is optional positions of
`c.uncontractedList.map φs.get` induced by `uncontractedIndexEquiv`. -/
def uncontractedStatesEquiv (φs : List 𝓕.States) (c : WickContraction φs.length) :
Option c.uncontracted ≃ Option (Fin (c.uncontractedList.map φs.get).length) :=
Equiv.optionCongr (c.uncontractedIndexEquiv.symm.trans (finCongr (by simp)))
@[simp]
lemma uncontractedStatesEquiv_none (φs : List 𝓕.States) (c : WickContraction φs.length) :
(uncontractedStatesEquiv φs c).toFun none = none := by
simp [uncontractedStatesEquiv]
lemma uncontractedStatesEquiv_list_sum [AddCommMonoid α] (φs : List 𝓕.States)
(c : WickContraction φs.length) (f : Option (Fin (c.uncontractedList.map φs.get).length) → α) :
∑ (i : Option (Fin (c.uncontractedList.map φs.get).length)), f i =
∑ (i : Option c.uncontracted), f (c.uncontractedStatesEquiv φs i) := by
rw [(c.uncontractedStatesEquiv φs).sum_comp]
/-!
## Uncontracted List for extractEquiv symm none
-/
lemma uncontractedList_succAboveEmb_sorted (c : WickContraction n) (i : Fin n.succ) :
((List.map i.succAboveEmb c.uncontractedList)).Sorted (· ≤ ·) := by
apply fin_list_sorted_succAboveEmb_sorted
@ -230,33 +323,54 @@ lemma uncontractedList_succAboveEmb_nodup (c : WickContraction n) (i : Fin n.suc
· exact Function.Embedding.injective i.succAboveEmb
· exact uncontractedList_nodup c
lemma uncontractedList_succAboveEmb_toFinset (c : WickContraction n) (i : Fin n.succ) :
(List.map i.succAboveEmb c.uncontractedList).toFinset =
(Finset.map i.succAboveEmb c.uncontracted) := by
ext a
simp only [Fin.coe_succAboveEmb, List.mem_toFinset, List.mem_map, Finset.mem_map,
Fin.succAboveEmb_apply]
rw [← c.uncontractedList_toFinset]
simp
lemma uncontractedList_succAboveEmb_eq_sort(c : WickContraction n) (i : Fin n.succ) :
(List.map i.succAboveEmb c.uncontractedList) =
(c.uncontracted.map i.succAboveEmb).sort (· ≤ ·) := by
rw [← uncontractedList_succAboveEmb_toFinset]
symm
refine (List.toFinset_sort (α := Fin n.succ) (· ≤ ·) ?_).mpr ?_
lemma uncontractedList_succAbove_orderedInsert_nodup (c : WickContraction n) (i : Fin n.succ) :
(List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList)).Nodup := by
have h1 : (List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList)).Perm
(i :: List.map i.succAboveEmb c.uncontractedList) := by
exact List.perm_orderedInsert (fun x1 x2 => x1 ≤ x2) i _
apply List.Perm.nodup h1.symm
simp only [Nat.succ_eq_add_one, List.nodup_cons, List.mem_map, not_exists,
not_and]
apply And.intro
· intro x _
exact Fin.succAbove_ne i x
· exact uncontractedList_succAboveEmb_nodup c i
· exact uncontractedList_succAboveEmb_sorted c i
lemma uncontractedList_succAboveEmb_eraseIdx_sorted (c : WickContraction n) (i : Fin n.succ)
(k: ) : ((List.map i.succAboveEmb c.uncontractedList).eraseIdx k).Sorted (· ≤ ·) := by
apply HepLean.List.eraseIdx_sorted
lemma uncontractedList_succAbove_orderedInsert_sorted (c : WickContraction n) (i : Fin n.succ) :
(List.orderedInsert (· ≤ ·) i
(List.map i.succAboveEmb c.uncontractedList)).Sorted (· ≤ ·) := by
refine List.Sorted.orderedInsert i (List.map (⇑i.succAboveEmb) c.uncontractedList) ?_
exact uncontractedList_succAboveEmb_sorted c i
lemma uncontractedList_succAboveEmb_eraseIdx_nodup (c : WickContraction n) (i : Fin n.succ) (k: ) :
((List.map i.succAboveEmb c.uncontractedList).eraseIdx k).Nodup := by
refine List.Nodup.eraseIdx k ?_
exact uncontractedList_succAboveEmb_nodup c i
lemma uncontractedList_succAbove_orderedInsert_toFinset (c : WickContraction n) (i : Fin n.succ) :
(List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList)).toFinset =
(Insert.insert i (Finset.map i.succAboveEmb c.uncontracted)) := by
ext a
simp only [Nat.succ_eq_add_one, Fin.coe_succAboveEmb, List.mem_toFinset, List.mem_orderedInsert,
List.mem_map, Finset.mem_insert, Finset.mem_map, Fin.succAboveEmb_apply]
rw [← uncontractedList_toFinset]
simp
lemma uncontractedList_succAbove_orderedInsert_eq_sort (c : WickContraction n) (i : Fin n.succ) :
(List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList)) =
(Insert.insert i (Finset.map i.succAboveEmb c.uncontracted)).sort (· ≤ ·) := by
rw [← uncontractedList_succAbove_orderedInsert_toFinset]
symm
refine (List.toFinset_sort (α := Fin n.succ) (· ≤ ·) ?_).mpr ?_
· exact uncontractedList_succAbove_orderedInsert_nodup c i
· exact uncontractedList_succAbove_orderedInsert_sorted c i
lemma uncontractedList_extractEquiv_symm_none (c : WickContraction n) (i : Fin n.succ) :
((extractEquiv i).symm ⟨c, none⟩).uncontractedList =
List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList) := by
rw [uncontractedList_eq_sort, extractEquiv_symm_none_uncontracted]
rw [uncontractedList_succAbove_orderedInsert_eq_sort]
/-!
## Uncontracted List for extractEquiv symm some
-/
lemma uncontractedList_succAboveEmb_eraseIdx_toFinset (c : WickContraction n) (i : Fin n.succ)
(k : ) (hk : k < c.uncontractedList.length) :
@ -286,6 +400,16 @@ lemma uncontractedList_succAboveEmb_eraseIdx_toFinset (c : WickContraction n) (i
simp_all [uncontractedList]
exact uncontractedList_succAboveEmb_nodup c i
lemma uncontractedList_succAboveEmb_eraseIdx_sorted (c : WickContraction n) (i : Fin n.succ)
(k: ) : ((List.map i.succAboveEmb c.uncontractedList).eraseIdx k).Sorted (· ≤ ·) := by
apply HepLean.List.eraseIdx_sorted
exact uncontractedList_succAboveEmb_sorted c i
lemma uncontractedList_succAboveEmb_eraseIdx_nodup (c : WickContraction n) (i : Fin n.succ) (k: ) :
((List.map i.succAboveEmb c.uncontractedList).eraseIdx k).Nodup := by
refine List.Nodup.eraseIdx k ?_
exact uncontractedList_succAboveEmb_nodup c i
lemma uncontractedList_succAboveEmb_eraseIdx_eq_sort (c : WickContraction n) (i : Fin n.succ)
(k : ) (hk : k < c.uncontractedList.length) :
((List.map i.succAboveEmb c.uncontractedList).eraseIdx k) =
@ -297,48 +421,34 @@ lemma uncontractedList_succAboveEmb_eraseIdx_eq_sort (c : WickContraction n) (i
· exact uncontractedList_succAboveEmb_eraseIdx_nodup c i k
· exact uncontractedList_succAboveEmb_eraseIdx_sorted c i k
lemma uncontractedList_succAbove_orderedInsert_sorted (c : WickContraction n) (i : Fin n.succ) :
(List.orderedInsert (· ≤ ·) i
(List.map i.succAboveEmb c.uncontractedList)).Sorted (· ≤ ·) := by
refine List.Sorted.orderedInsert i (List.map (⇑i.succAboveEmb) c.uncontractedList) ?_
exact uncontractedList_succAboveEmb_sorted c i
lemma uncontractedList_succAbove_orderedInsert_nodup (c : WickContraction n) (i : Fin n.succ) :
(List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList)).Nodup := by
have h1 : (List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList)).Perm
(i :: List.map i.succAboveEmb c.uncontractedList) := by
exact List.perm_orderedInsert (fun x1 x2 => x1 ≤ x2) i _
apply List.Perm.nodup h1.symm
simp only [Nat.succ_eq_add_one, List.nodup_cons, List.mem_map, not_exists,
not_and]
apply And.intro
· intro x _
exact Fin.succAbove_ne i x
· exact uncontractedList_succAboveEmb_nodup c i
lemma uncontractedList_succAbove_orderedInsert_toFinset (c : WickContraction n) (i : Fin n.succ) :
(List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList)).toFinset =
(Insert.insert i (Finset.map i.succAboveEmb c.uncontracted)) := by
lemma uncontractedList_extractEquiv_symm_some (c : WickContraction n) (i : Fin n.succ)
(k : c.uncontracted) : ((extractEquiv i).symm ⟨c, some k⟩).uncontractedList =
((c.uncontractedList).map i.succAboveEmb).eraseIdx (c.uncontractedIndexEquiv.symm k) := by
rw [uncontractedList_eq_sort]
rw [uncontractedList_succAboveEmb_eraseIdx_eq_sort]
swap
simp only [Fin.is_lt]
congr
simp only [Nat.succ_eq_add_one, extractEquiv, Equiv.coe_fn_symm_mk,
uncontractedList_getElem_uncontractedIndexEquiv_symm, Fin.succAboveEmb_apply]
rw [insert_some_uncontracted]
ext a
simp only [Nat.succ_eq_add_one, Fin.coe_succAboveEmb, List.mem_toFinset, List.mem_orderedInsert,
List.mem_map, Finset.mem_insert, Finset.mem_map, Fin.succAboveEmb_apply]
rw [← uncontractedList_toFinset]
simp
lemma uncontractedList_succAbove_orderedInsert_eq_sort (c : WickContraction n) (i : Fin n.succ) :
(List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList)) =
(Insert.insert i (Finset.map i.succAboveEmb c.uncontracted)).sort (· ≤ ·) := by
rw [← uncontractedList_succAbove_orderedInsert_toFinset]
symm
refine (List.toFinset_sort (α := Fin n.succ) (· ≤ ·) ?_).mpr ?_
· exact uncontractedList_succAbove_orderedInsert_nodup c i
· exact uncontractedList_succAbove_orderedInsert_sorted c i
lemma uncontractedList_succAboveEmb_toFinset (c : WickContraction n) (i : Fin n.succ) :
(List.map i.succAboveEmb c.uncontractedList).toFinset =
(Finset.map i.succAboveEmb c.uncontracted) := by
ext a
simp only [Fin.coe_succAboveEmb, List.mem_toFinset, List.mem_map, Finset.mem_map,
Fin.succAboveEmb_apply]
rw [← c.uncontractedList_toFinset]
simp
lemma uncontractedList_extractEquiv_symm_none (c : WickContraction n) (i : Fin n.succ) :
((extractEquiv i).symm ⟨c, none⟩).uncontractedList =
List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList) := by
rw [uncontractedList_eq_sort, extractEquiv_symm_none_uncontracted]
rw [uncontractedList_succAbove_orderedInsert_eq_sort]
/-!
## uncontractedListOrderPos
-/
/-- Given a Wick contraction `c : WickContraction n` and a `Fin n.succ`, the number of elements
of `c.uncontractedList` which are less then `i`.
@ -383,108 +493,18 @@ lemma orderedInsert_succAboveEmb_uncontractedList_eq_insertIdx (c : WickContract
(List.orderedInsert (· ≤ ·) i (List.map i.succAboveEmb c.uncontractedList)) =
(List.map i.succAboveEmb c.uncontractedList).insertIdx (uncontractedListOrderPos c i) i := by
rw [orderedInsert_eq_insertIdx_of_fin_list_sorted]
swap
exact uncontractedList_succAboveEmb_sorted c i
congr 1
simp only [Nat.succ_eq_add_one, Fin.val_fin_lt, Fin.coe_succAboveEmb, uncontractedListOrderPos]
rw [List.filter_map]
simp only [List.length_map]
congr
funext x
simp only [Function.comp_apply, Fin.succAbove, decide_eq_decide]
split
simp only [Fin.lt_def, Fin.coe_castSucc]
rename_i h
simp_all only [Fin.lt_def, Fin.coe_castSucc, not_lt, Fin.val_succ]
omega
/-- The equivalence between the positions of `c.uncontractedList` i.e. elements of
`Fin (c.uncontractedList).length` and the finite set `c.uncontracted` considered as a finite type.
-/
def uncontractedFinEquiv (c : WickContraction n) :
Fin (c.uncontractedList).length ≃ c.uncontracted where
toFun i := ⟨c.uncontractedList.get i, c.uncontractedList_get_mem_uncontracted i⟩
invFun i := ⟨List.indexOf i.1 c.uncontractedList,
List.indexOf_lt_length.mpr ((c.uncontractedList_mem_iff i.1).mpr i.2)⟩
left_inv i := by
ext
exact List.get_indexOf (uncontractedList_nodup c) _
right_inv i := by
ext
simp
@[simp]
lemma uncontractedList_getElem_uncontractedFinEquiv_symm (k : c.uncontracted) :
c.uncontractedList[(c.uncontractedFinEquiv.symm k).val] = k := by
simp [uncontractedFinEquiv]
lemma uncontractedFinEquiv_symm_eq_filter_length (k : c.uncontracted) :
(c.uncontractedFinEquiv.symm k).val =
(List.filter (fun i => i < k.val) c.uncontractedList).length := by
simp only [uncontractedFinEquiv, List.get_eq_getElem, Equiv.coe_fn_symm_mk]
rw [fin_list_sorted_indexOf_mem]
· simp
· exact uncontractedList_sorted c
· rw [uncontractedList_mem_iff]
exact k.2
lemma take_uncontractedFinEquiv_symm (k : c.uncontracted) :
c.uncontractedList.take (c.uncontractedFinEquiv.symm k).val =
c.uncontractedList.filter (fun i => i < k.val) := by
have hl := fin_list_sorted_split c.uncontractedList (uncontractedList_sorted c) k.val
conv_lhs =>
rhs
rw [hl]
rw [uncontractedFinEquiv_symm_eq_filter_length]
simp
/-- The equivalence between the type `Option c.uncontracted` for `WickContraction φs.length` and
`Option (Fin (c.uncontractedList.map φs.get).length)`, that is optional positions of
`c.uncontractedList.map φs.get` induced by `uncontractedFinEquiv`. -/
def uncontractedStatesEquiv (φs : List 𝓕.States) (c : WickContraction φs.length) :
Option c.uncontracted ≃ Option (Fin (c.uncontractedList.map φs.get).length) :=
Equiv.optionCongr (c.uncontractedFinEquiv.symm.trans (finCongr (by simp)))
@[simp]
lemma uncontractedStatesEquiv_none (φs : List 𝓕.States) (c : WickContraction φs.length) :
(uncontractedStatesEquiv φs c).toFun none = none := by
simp [uncontractedStatesEquiv]
lemma uncontractedStatesEquiv_list_sum [AddCommMonoid α] (φs : List 𝓕.States)
(c : WickContraction φs.length) (f : Option (Fin (c.uncontractedList.map φs.get).length) → α) :
∑ (i : Option (Fin (c.uncontractedList.map φs.get).length)), f i =
∑ (i : Option c.uncontracted), f (c.uncontractedStatesEquiv φs i) := by
rw [(c.uncontractedStatesEquiv φs).sum_comp]
lemma uncontractedList_extractEquiv_symm_some (c : WickContraction n) (i : Fin n.succ)
(k : c.uncontracted) : ((extractEquiv i).symm ⟨c, some k⟩).uncontractedList =
((c.uncontractedList).map i.succAboveEmb).eraseIdx (c.uncontractedFinEquiv.symm k) := by
rw [uncontractedList_eq_sort]
rw [uncontractedList_succAboveEmb_eraseIdx_eq_sort]
swap
simp only [Fin.is_lt]
congr
simp only [Nat.succ_eq_add_one, extractEquiv, Equiv.coe_fn_symm_mk,
uncontractedList_getElem_uncontractedFinEquiv_symm, Fin.succAboveEmb_apply]
rw [insert_some_uncontracted]
ext a
simp
lemma filter_uncontractedList (c : WickContraction n) (p : Fin n → Prop) [DecidablePred p] :
(c.uncontractedList.filter p) = (c.uncontracted.filter p).sort (· ≤ ·) := by
have h1 : (c.uncontractedList.filter p).Sorted (· ≤ ·) := by
apply List.Sorted.filter
exact uncontractedList_sorted c
have h2 : (c.uncontractedList.filter p).Nodup := by
refine List.Nodup.filter _ ?_
exact uncontractedList_nodup c
have h3 : (c.uncontractedList.filter p).toFinset = (c.uncontracted.filter p) := by
ext a
simp only [List.toFinset_filter, decide_eq_true_eq, Finset.mem_filter, List.mem_toFinset,
and_congr_left_iff]
rw [uncontractedList_mem_iff]
simp
have hx := (List.toFinset_sort (· ≤ ·) h2).mpr h1
rw [← hx, h3]
· congr 1
simp only [Nat.succ_eq_add_one, Fin.val_fin_lt, Fin.coe_succAboveEmb, uncontractedListOrderPos]
rw [List.filter_map]
simp only [List.length_map]
congr
funext x
simp only [Function.comp_apply, Fin.succAbove, decide_eq_decide]
split
· simp only [Fin.lt_def, Fin.coe_castSucc]
· rename_i h
simp_all only [Fin.lt_def, Fin.coe_castSucc, not_lt, Fin.val_succ]
omega
· exact uncontractedList_succAboveEmb_sorted c i
end WickContraction