refactor: free simps

HepLean/PerturbationTheory/Contractions/Basic.lean

@@ -41,9 +41,9 @@ lemma auxCongr_ext {φs: List 𝓕} {c c2 : Contractions φs} (h : c.1 = c2.1)
     (hx : c.2 =  auxCongr h.symm c2.2) : c = c2 := by
   cases c
   cases c2
-  simp at h
+  simp only at h
   subst h
-  simp [auxCongr] at hx
+  simp only [auxCongr, Equiv.refl_apply] at hx
   subst hx
   rfl
 
@@ -97,11 +97,11 @@ lemma embedUncontracted_injective  {l : List 𝓕} (c : Contractions l) :
     Function.Injective c.embedUncontracted := by
   match l, c with
   | [], ⟨[], ContractionsAux.nil⟩ =>
-    dsimp [embedUncontracted]
+    dsimp only [List.length_nil, embedUncontracted]
     intro i
     exact Fin.elim0 i
   | φ :: φs, ⟨_, .cons (φsᵤₙ := aux) none c⟩ =>
-    dsimp [embedUncontracted]
+    dsimp only [List.length_cons, embedUncontracted, Fin.zero_eta]
     refine Fin.cons_injective_iff.mpr ?_
     apply And.intro
     · simp only [Set.mem_range, Function.comp_apply, not_exists]
@@ -109,7 +109,7 @@ lemma embedUncontracted_injective  {l : List 𝓕} (c : Contractions l) :
     · exact Function.Injective.comp (Fin.succ_injective φs.length)
         (embedUncontracted_injective ⟨aux, c⟩)
   |  φ :: φs, ⟨_, .cons (φsᵤₙ := aux) (some i) c⟩ =>
-      dsimp [embedUncontracted]
+      dsimp only [List.length_cons, embedUncontracted]
       refine Function.Injective.comp (Fin.succ_injective φs.length) ?hf
       refine Function.Injective.comp (embedUncontracted_injective ⟨aux, c⟩) ?hf.hf
       refine Function.Injective.comp (Fin.cast_injective (embedUncontracted.proof_5 φ φs aux i c))
@@ -251,7 +251,7 @@ lemma toCenterTerm_none (f : 𝓕 → Type) [∀ i, Fintype (f i)]
     toCenterTerm f q le F c S := by
   rw [consEquiv]
   simp only [Equiv.coe_fn_symm_mk]
-  dsimp [toCenterTerm]
+  dsimp only [toCenterTerm]
   rfl
 
 /-- Proves that the part of the term gained from Wick contractions is in
@@ -264,13 +264,13 @@ lemma toCenterTerm_center (f : 𝓕 → Type) [∀ i, Fintype (f i)]
     {φs : List 𝓕} → (c : Contractions φs) → (S : Splitting f le) →
     (c.toCenterTerm f q le F S) ∈ Subalgebra.center ℂ A
   | [], ⟨[], .nil⟩, _ => by
-    dsimp [toCenterTerm]
+    dsimp only [toCenterTerm]
     exact Subalgebra.one_mem (Subalgebra.center ℂ A)
   | _ :: _, ⟨_, .cons (φsᵤₙ := aux') none c⟩, S => by
-    dsimp [toCenterTerm]
+    dsimp only [toCenterTerm]
     exact toCenterTerm_center f q le F ⟨aux', c⟩ S
   | a :: _, ⟨_, .cons (φsᵤₙ := aux') (some n) c⟩, S => by
-    dsimp [toCenterTerm]
+    dsimp only [toCenterTerm, List.get_eq_getElem]
     refine Subalgebra.mul_mem (Subalgebra.center ℂ A) ?hx ?hy
     exact toCenterTerm_center f q le F ⟨aux', c⟩ S
     apply Subalgebra.smul_mem

HepLean/PerturbationTheory/Contractions/Card.lean

@@ -31,7 +31,7 @@ lemma card_of_full_contractions_odd {φs : List 𝓕} (ho : Odd φs.length ) :
   by_contra hn
   have hc := uncontracted_length_even_iff c
   rw [hn] at hc
-  simp at hc
+  simp only [List.length_nil, even_zero, iff_true] at hc
   rw [← Nat.not_odd_iff_even] at hc
   exact hc ho
 

HepLean/PerturbationTheory/Contractions/Involutions.lean

@@ -36,6 +36,8 @@ variable {l : List 𝓕}
 
 -/
 
+/-- Given an involution the uncontracted fields associated with it (corresponding
+  to the fixed points of that involution). -/
 def uncontractedFromInvolution :  {φs : List 𝓕} →
     (f : {f : Fin φs.length → Fin φs.length // Function.Involutive f}) →
     {l : List 𝓕 // l.length = (Finset.univ.filter fun i => f.1 i = i).card}
@@ -43,10 +45,11 @@ def uncontractedFromInvolution :  {φs : List 𝓕} →
   | φ :: φs, f =>
     let luc := uncontractedFromInvolution (involutionCons φs.length f).fst
     let n' := involutionAddEquiv (involutionCons φs.length f).1 (involutionCons φs.length f).2
+    let np : Option (Fin luc.1.length) := Option.map (finCongr luc.2.symm) n'
     if  hn : n' = none then
       have hn' := involutionAddEquiv_none_image_zero (n := φs.length) (f := f) hn
       ⟨optionEraseZ luc φ none, by
-        simp [optionEraseZ]
+        simp only [optionEraseZ, Nat.succ_eq_add_one, List.length_cons, Mathlib.Vector.length_val]
         rw [← luc.2]
         conv_rhs => rw [Finset.card_filter]
         rw [Fin.sum_univ_succ]
@@ -61,13 +64,13 @@ def uncontractedFromInvolution :  {φs : List 𝓕} →
         rw [involutionAddEquiv_none_succ hn]⟩
     else
       let n := n'.get (Option.isSome_iff_ne_none.mpr hn)
-      let np : Fin luc.1.length := ⟨n.1, by
-        rw [luc.2]
-        exact n.prop⟩
+      let np : Fin luc.1.length := Fin.cast luc.2.symm n
       ⟨optionEraseZ luc φ (some np), by
       let k' := (involutionCons φs.length f).2
       have hkIsSome : (k'.1).isSome := by
-        simp [n', involutionAddEquiv ] at hn
+        simp only [Nat.succ_eq_add_one, involutionAddEquiv, Option.isSome_some, Option.get_some,
+          Option.isSome_none, Equiv.trans_apply, Equiv.coe_fn_mk, Equiv.optionCongr_apply,
+          Equiv.coe_trans, RelIso.coe_fn_toEquiv, Option.map_eq_none', n'] at hn
         split at hn
         · simp_all only [reduceCtorEq, not_false_eq_true, Nat.succ_eq_add_one, Option.isSome_some, k']
         · simp_all only [not_true_eq_false]
@@ -76,39 +79,34 @@ def uncontractedFromInvolution :  {φs : List 𝓕} →
       have hksucc : k.succ = f.1 ⟨0, Nat.zero_lt_succ φs.length⟩ := by
         simp [k, k', involutionCons]
       have hzero : ⟨0, Nat.zero_lt_succ φs.length⟩  = f.1 k.succ := by
-        rw [hksucc]
-        rw [f.2]
-      have hkcons : ((involutionCons φs.length) f).1.1 k = k := by
-        exact k'.2 hkIsSome
+        rw [hksucc, f.2]
       have hksuccNe : f.1 k.succ ≠ k.succ := by
         conv_rhs => rw [hksucc]
         exact fun hn => Fin.succ_ne_zero k (Function.Involutive.injective f.2 hn )
       have hluc : 1 ≤ luc.1.length := by
-        simp
+        simp only [Nat.succ_eq_add_one, Mathlib.Vector.length_val, Finset.one_le_card]
         use k
-        simp [involutionCons]
+        simp only [involutionCons, Nat.succ_eq_add_one, Fin.cons_update, Equiv.coe_fn_mk,
+          dite_eq_left_iff, Finset.mem_filter, Finset.mem_univ, true_and]
         rw [hksucc, f.2]
         simp
       rw [propext (Nat.sub_eq_iff_eq_add' hluc)]
-      have h0 : ¬  f.1 ⟨0, Nat.zero_lt_succ φs.length⟩ = ⟨0, Nat.zero_lt_succ φs.length⟩ := by
-        exact Option.isSome_dite'.mp hkIsSome
       conv_rhs =>
         rw [Finset.card_filter]
-        erw [Fin.sum_univ_succ]
-        erw [if_neg h0]
+        erw [Fin.sum_univ_succ, if_neg (Option.isSome_dite'.mp hkIsSome)]
       simp only [Nat.succ_eq_add_one, Mathlib.Vector.length_val, List.length_cons,
         Nat.cast_id, zero_add]
       conv_rhs => lhs; rw [Eq.symm (Fintype.sum_ite_eq' k fun j => 1)]
-      rw [← Finset.sum_add_distrib]
-      rw [Finset.card_filter]
+      rw [← Finset.sum_add_distrib, Finset.card_filter]
       apply congrArg
       funext i
       by_cases hik : i = k
       · subst hik
-        simp [hkcons, hksuccNe]
-      · simp [hik]
+        simp only [k'.2 hkIsSome, Nat.succ_eq_add_one, ↓reduceIte, hksuccNe, add_zero]
+      · simp only [hik, ↓reduceIte, zero_add]
         refine ite_congr ?_ (congrFun rfl) (congrFun rfl)
-        simp [involutionCons]
+        simp only [involutionCons, Nat.succ_eq_add_one, Fin.cons_update, Equiv.coe_fn_mk,
+          dite_eq_left_iff, eq_iff_iff]
         have hfi : f.1 i.succ ≠ ⟨0, Nat.zero_lt_succ φs.length⟩ := by
           rw [hzero]
           by_contra hn
@@ -121,7 +119,7 @@ def uncontractedFromInvolution :  {φs : List 𝓕} →
           conv_rhs => rw [← h']
           simp
         · intro h hfi
-          simp [Fin.ext_iff]
+          simp only [Fin.ext_iff, Fin.coe_pred]
           rw [h]
           simp⟩
 
@@ -135,18 +133,17 @@ lemma uncontractedFromInvolution_cons {φs : List 𝓕} {φ : 𝓕}
   let n' := involutionAddEquiv (involutionCons φs.length f).1 (involutionCons φs.length f).2
   change _ = optionEraseZ luc φ
     (Option.map (finCongr ((uncontractedFromInvolution (involutionCons φs.length f).fst).2.symm)) n')
-  dsimp [uncontractedFromInvolution]
+  dsimp only [List.length_cons, uncontractedFromInvolution, Nat.succ_eq_add_one, Fin.zero_eta]
   by_cases hn : n' = none
   · have hn' := hn
-    simp [n'] at hn'
-    simp [hn']
-    rw [hn]
+    simp only [Nat.succ_eq_add_one, n'] at hn'
+    simp only [hn', ↓reduceDIte, hn]
     rfl
   · have hn' := hn
-    simp [n'] at hn'
-    simp [hn']
+    simp only [Nat.succ_eq_add_one, n'] at hn'
+    simp only [hn', ↓reduceDIte]
     congr
-    simp [n']
+    simp only [Nat.succ_eq_add_one, n']
     simp_all only [Nat.succ_eq_add_one, not_false_eq_true, n', luc]
     obtain ⟨val, property⟩ := f
     obtain ⟨val_1, property_1⟩ := luc
@@ -166,10 +163,10 @@ lemma uncontractedFromInvolution_cons {φs : List 𝓕} {φ : 𝓕}
       obtain ⟨left, right⟩ := h
       subst right
       simp_all only [Option.get_some]
-      rfl
 
+/-- The `ContractionsAux` associated to an involution. -/
 def fromInvolutionAux  : {l : List 𝓕} →
-  (f : {f : Fin l.length → Fin l.length // Function.Involutive f}) →
+    (f : {f : Fin l.length → Fin l.length // Function.Involutive f}) →
     ContractionsAux l (uncontractedFromInvolution f)
   | [] => fun _ =>  ContractionsAux.nil
   | _ :: φs => fun f =>
@@ -179,6 +176,7 @@ def fromInvolutionAux  : {l : List 𝓕} →
       (involutionAddEquiv f'.1 f'.2)
     auxCongr (uncontractedFromInvolution_cons f).symm (ContractionsAux.cons n' c')
 
+/-- The contraction associated with an involution. -/
 def fromInvolution {φs : List 𝓕} (f : {f : Fin φs.length → Fin φs.length // Function.Involutive f}) :
     Contractions φs := ⟨uncontractedFromInvolution f, fromInvolutionAux f⟩
 
@@ -189,32 +187,31 @@ lemma fromInvolution_cons {φs : List 𝓕} {φ : 𝓕}
     ⟨fromInvolution f'.1, Option.map (finCongr ((uncontractedFromInvolution f'.fst).2.symm))
       (involutionAddEquiv f'.1 f'.2)⟩ := by
   refine auxCongr_ext ?_ ?_
-  · dsimp [fromInvolution]
+  · dsimp only [fromInvolution, List.length_cons, Nat.succ_eq_add_one]
     rw [uncontractedFromInvolution_cons]
     rfl
-  · dsimp [fromInvolution, fromInvolutionAux]
+  · dsimp only [fromInvolution, List.length_cons, fromInvolutionAux, Nat.succ_eq_add_one, id_eq,
+    eq_mpr_eq_cast]
     rfl
 
-lemma fromInvolution_of_involutionCons
-    {φs : List 𝓕} {φ : 𝓕}
+lemma fromInvolution_of_involutionCons {φs : List 𝓕} {φ : 𝓕}
     (f : {f : Fin (φs ).length → Fin (φs).length // Function.Involutive f})
     (n : { i : Option (Fin φs.length) // ∀ (h : i.isSome = true), f.1 (i.get h) = i.get h }):
     fromInvolution (φs := φ :: φs) ((involutionCons φs.length).symm ⟨f, n⟩) =
-    consEquiv.symm
-    ⟨fromInvolution f, Option.map (finCongr ((uncontractedFromInvolution f).2.symm))
+    consEquiv.symm ⟨fromInvolution f, Option.map (finCongr ((uncontractedFromInvolution f).2.symm))
       (involutionAddEquiv f n)⟩ := by
   rw [fromInvolution_cons]
   congr 1
-  simp
+  simp only [Nat.succ_eq_add_one, Sigma.mk.inj_iff, Equiv.apply_symm_apply, true_and]
   rw [Equiv.apply_symm_apply]
 
-
 /-!
 
 ## To Involution.
 
 -/
 
+/-- The involution associated with a contraction. -/
 def toInvolution  : {φs : List 𝓕} →  (c : Contractions φs) →
     {f : {f : Fin φs.length → Fin φs.length // Function.Involutive f} //
     uncontractedFromInvolution f = c.1}
@@ -245,35 +242,35 @@ def toInvolution  : {φs : List 𝓕} →  (c : Contractions φs) →
       rw [@Sigma.subtype_ext_iff] at hF0
       ext1
       rw [hF0.2]
-      simp
+      simp only [Nat.succ_eq_add_one]
       congr 1
       · rw [hF1]
       · refine involutionAddEquiv_cast' ?_ n' _ _
         rw [hF1]
     rw [uncontractedFromInvolution_cons]
     have hx := (toInvolution ⟨aux, c⟩).2
-    simp at hx
-    simp
+    simp only at hx
+    simp only [Nat.succ_eq_add_one]
     refine optionEraseZ_ext ?_ ?_ ?_
-    · dsimp [F]
+    · dsimp only [F]
       rw [Equiv.apply_symm_apply]
-      simp
+      simp only
       rw [← hx]
       simp_all only
     · rfl
-    · simp [hF2]
-      dsimp [n']
-      simp [finCongr]
+    · simp only [hF2, Nat.succ_eq_add_one, Equiv.apply_symm_apply, Option.map_map]
+      dsimp only [id_eq, eq_mpr_eq_cast, Nat.succ_eq_add_one, n']
+      simp only [finCongr, Equiv.coe_fn_mk, Option.map_map]
       simp only [Nat.succ_eq_add_one, id_eq, eq_mpr_eq_cast, F, n']
       ext a : 1
       simp only [Option.mem_def, Option.map_eq_some', Function.comp_apply, Fin.cast_trans,
         Fin.cast_eq_self, exists_eq_right]
 
-lemma toInvolution_length {φs φsᵤₙ : List 𝓕} {c : ContractionsAux φs φsᵤₙ} :
-    φsᵤₙ.length = (Finset.filter (fun i => (toInvolution ⟨φsᵤₙ, c⟩).1.1 i = i) Finset.univ).card
-     := by
+lemma toInvolution_length_uncontracted {φs φsᵤₙ : List 𝓕} {c : ContractionsAux φs φsᵤₙ} :
+    φsᵤₙ.length =
+    (Finset.filter (fun i => (toInvolution ⟨φsᵤₙ, c⟩).1.1 i = i) Finset.univ).card := by
   have h2 := (toInvolution ⟨φsᵤₙ, c⟩).2
-  simp at h2
+  simp only at h2
   conv_lhs => rw [← h2]
   exact Mathlib.Vector.length_val (uncontractedFromInvolution (toInvolution ⟨φsᵤₙ, c⟩).1)
 
@@ -282,11 +279,11 @@ lemma toInvolution_cons {φs φsᵤₙ : List 𝓕} {φ : 𝓕}
     (toInvolution ⟨optionEraseZ φsᵤₙ φ n, ContractionsAux.cons n c⟩).1
     = (involutionCons φs.length).symm ⟨(toInvolution ⟨φsᵤₙ, c⟩).1,
       (involutionAddEquiv (toInvolution ⟨φsᵤₙ, c⟩).1).symm
-      (Option.map (finCongr (toInvolution_length)) n)⟩ := by
-  dsimp [toInvolution]
+      (Option.map (finCongr (toInvolution_length_uncontracted)) n)⟩ := by
+  dsimp only [List.length_cons, toInvolution, Nat.succ_eq_add_one, subset_refl, Set.coe_inclusion]
   congr 3
   rw [Option.map_map]
-  simp [finCongr]
+  simp only [finCongr, Equiv.coe_fn_mk]
   rfl
 
 lemma toInvolution_consEquiv {φs : List 𝓕} {φ : 𝓕}
@@ -294,7 +291,7 @@ lemma toInvolution_consEquiv {φs : List 𝓕} {φ : 𝓕}
     (toInvolution ((consEquiv (φ := φ)).symm ⟨c, n⟩)).1 =
     (involutionCons φs.length).symm ⟨(toInvolution c).1,
       (involutionAddEquiv (toInvolution c).1).symm
-      (Option.map (finCongr (toInvolution_length)) n)⟩ := by
+      (Option.map (finCongr (toInvolution_length_uncontracted)) n)⟩ := by
   erw [toInvolution_cons]
   rfl
 
@@ -308,13 +305,11 @@ lemma toInvolution_fromInvolution : {φs : List 𝓕} → (c : Contractions φs)
     fromInvolution (toInvolution c) = c
   | [], ⟨[], ContractionsAux.nil⟩ => rfl
   | φ :: φs, ⟨_, .cons (φsᵤₙ := φsᵤₙ) n c⟩ => by
-    rw [toInvolution_cons]
-    rw [fromInvolution_of_involutionCons]
-    rw [Equiv.symm_apply_eq]
-    dsimp [consEquiv]
+    rw [toInvolution_cons, fromInvolution_of_involutionCons, Equiv.symm_apply_eq]
+    dsimp only [consEquiv, Equiv.coe_fn_mk]
     refine consEquiv_ext ?_ ?_
     · exact toInvolution_fromInvolution ⟨φsᵤₙ, c⟩
-    · simp [finCongr]
+    · simp only [finCongr, Equiv.coe_fn_mk, Equiv.apply_symm_apply, Option.map_map]
       ext a : 1
       simp only [Option.mem_def, Option.map_eq_some', Function.comp_apply, Fin.cast_trans,
         Fin.cast_eq_self, exists_eq_right]
@@ -337,9 +332,11 @@ lemma fromInvolution_toInvolution : {φs : List 𝓕} →  (f : {f : Fin (φs ).
       conv_rhs =>
         lhs
         rw  [involutionAddEquiv_cast hx]
-      simp  [Nat.succ_eq_add_one,- eq_mpr_eq_cast, Equiv.trans_apply, -Equiv.optionCongr_apply]
+      simp only [Nat.succ_eq_add_one, Equiv.trans_apply]
       rfl
 
+/-- The equivalence between contractions and involutions.
+  Note: This shows that the type of contractions only depends on the length of the list `φs`. -/
 def equivInvolutions {φs : List 𝓕} :
     Contractions φs ≃ {f : Fin φs.length → Fin φs.length // Function.Involutive f} where
   toFun := fun c =>  toInvolution c
@@ -347,11 +344,11 @@ def equivInvolutions {φs : List 𝓕} :
   left_inv := toInvolution_fromInvolution
   right_inv := fromInvolution_toInvolution
 
-
 /-!
 
 ## Full contractions and involutions.
 -/
+
 lemma isFull_iff_uncontractedFromInvolution_empty {φs : List 𝓕} (c : Contractions φs) :
     IsFull c ↔ (uncontractedFromInvolution (equivInvolutions c)).1 = [] := by
   let l := toInvolution c
@@ -366,7 +363,7 @@ lemma isFull_iff_filter_card_involution_zero  {φs : List 𝓕} (c : Contraction
 lemma isFull_iff_involution_no_fixed_points {φs : List 𝓕} (c : Contractions φs) :
     IsFull c ↔ ∀ (i : Fin φs.length), (equivInvolutions c).1 i ≠ i := by
   rw [isFull_iff_filter_card_involution_zero]
-  simp
+  simp only [Finset.card_eq_zero, ne_eq]
   rw [Finset.filter_eq_empty_iff]
   apply Iff.intro
   · intro h
@@ -376,9 +373,9 @@ lemma isFull_iff_involution_no_fixed_points {φs : List 𝓕} (c : Contractions
     exact fun a => i h
 
 
-open Nat in
-def isFullInvolutionEquiv {φs : List 𝓕} :
-    {c : Contractions φs // IsFull c} ≃ {f : Fin φs.length → Fin φs.length // Function.Involutive f ∧ (∀ i, f i ≠ i)} where
+/-- The equivalence between full contractions and fixed-point free involutions. -/
+def isFullInvolutionEquiv {φs : List 𝓕} : {c : Contractions φs // IsFull c} ≃
+    {f : Fin φs.length → Fin φs.length // Function.Involutive f ∧ (∀ i, f i ≠ i)} where
   toFun c := ⟨equivInvolutions c.1, by
     apply And.intro (equivInvolutions c.1).2
     rw [← isFull_iff_involution_no_fixed_points]
@@ -392,5 +389,4 @@ def isFullInvolutionEquiv {φs : List 𝓕} :
 
 
 end Contractions
-
 end Wick