Physlib.QFT.PerturbationTheory.WickContraction.Join

Imports

/-
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
-/
module

public import Physlib.QFT.PerturbationTheory.WickContraction.Singleton

Join of contractions

@[expose] public section

Given a list φs of 𝓕.FieldOp, a Wick contraction φsΛ of φs and a Wick contraction φsucΛ of [φsΛ]ᵘᶜ, join φsΛ φsucΛ is defined as the Wick contraction of φs consisting of the contractions in φsΛ and those in φsucΛ.

As an example, for φs = [φ1, φ2, φ3, φ4], φsΛ = {{0, 1}} corresponding to the contraction of φ1 and φ2 in φs and φsucΛ = {{0, 1}} corresponding to the contraction of φ3 and φ4 in [φsΛ]ᵘᶜ = [φ3, φ4], then join φsΛ φsucΛ is the contraction {{0, 1}, {2, 3}} of φs.


def join {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) : WickContraction φs.length :=
  ⟨φsΛ.1 ∪ φsucΛ.1.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding, by𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ∀ a ∈ ↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, a.card = 2
    intro a ha𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ⊢ a.card = 2
    simp only [Finset.mem_union, Finset.mem_map,
      RelEmbedding.coe_toEmbedding] at ha𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛ ∨ ∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ a.card = 2
    rcases ha with ha | hainl𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛ⊢ a.card = 2inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ a.card = 2
    ·inl𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛ⊢ a.card = 2 exact φsΛ.2.1 a haAll goals completed! 🐙
    ·inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ a.card = 2 obtain ⟨a, ha, rfl⟩ := hainr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛ⊢ ((Finset.mapEmbedding uncontractedListEmd) a).card = 2
      rw [Finset.mapEmbedding_applyinr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛ⊢ (Finset.map uncontractedListEmd a).card = 2inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛ⊢ (Finset.map uncontractedListEmd a).card = 2]inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛ⊢ (Finset.map uncontractedListEmd a).card = 2
      simp only [Finset.card_map]inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛ⊢ a.card = 2
      exact φsucΛ.2.1 a haAll goals completed! 🐙, by𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ∀ a ∈ ↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ,
  ∀ b ∈ ↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, a = b ∨ Disjoint a b
    intro a ha b hb𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛb:Finset (Fin φs.length)hb:b ∈ ↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ⊢ a = b ∨ Disjoint a b
    simp only [Finset.mem_union, Finset.mem_map,
      RelEmbedding.coe_toEmbedding] at ha hb𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)b:Finset (Fin φs.length)ha:a ∈ ↑φsΛ ∨ ∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = ahb:b ∈ ↑φsΛ ∨ ∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = b⊢ a = b ∨ Disjoint a b
    rcases ha with ha | hainl𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)b:Finset (Fin φs.length)hb:b ∈ ↑φsΛ ∨ ∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = bha:a ∈ ↑φsΛ⊢ a = b ∨ Disjoint a binr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)b:Finset (Fin φs.length)hb:b ∈ ↑φsΛ ∨ ∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = bha:∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ a = b ∨ Disjoint a b <;>inl𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)b:Finset (Fin φs.length)hb:b ∈ ↑φsΛ ∨ ∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = bha:a ∈ ↑φsΛ⊢ a = b ∨ Disjoint a binr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)b:Finset (Fin φs.length)hb:b ∈ ↑φsΛ ∨ ∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = bha:∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ a = b ∨ Disjoint a b rcases hb with hb | hbinr.inl𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)b:Finset (Fin φs.length)ha:∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = ahb:b ∈ ↑φsΛ⊢ a = b ∨ Disjoint a binr.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)b:Finset (Fin φs.length)ha:∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = ahb:∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = b⊢ a = b ∨ Disjoint a b
    ·inl.inl𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)b:Finset (Fin φs.length)ha:a ∈ ↑φsΛhb:b ∈ ↑φsΛ⊢ a = b ∨ Disjoint a b exact φsΛ.2.2 a ha b hbAll goals completed! 🐙
    ·inl.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)b:Finset (Fin φs.length)ha:a ∈ ↑φsΛhb:∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = b⊢ a = b ∨ Disjoint a b obtain ⟨b, hb, rfl⟩ := hbinl.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ a = (Finset.mapEmbedding uncontractedListEmd) b ∨ Disjoint a ((Finset.mapEmbedding uncontractedListEmd) b)
      rightinl.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ Disjoint a ((Finset.mapEmbedding uncontractedListEmd) b)
      symminl.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ Disjoint ((Finset.mapEmbedding uncontractedListEmd) b) a
      rw [Finset.mapEmbedding_applyinl.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ Disjoint (Finset.map uncontractedListEmd b) ainl.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ Disjoint (Finset.map uncontractedListEmd b) a]inl.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ Disjoint (Finset.map uncontractedListEmd b) a
      apply uncontractedListEmd_finset_disjoint_leftinl.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ a ∈ ↑φsΛ
      exact haAll goals completed! 🐙
    ·inr.inl𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)b:Finset (Fin φs.length)ha:∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = ahb:b ∈ ↑φsΛ⊢ a = b ∨ Disjoint a b obtain ⟨a, ha, rfl⟩ := hainr.inl𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthb:Finset (Fin φs.length)hb:b ∈ ↑φsΛa:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛ⊢ (Finset.mapEmbedding uncontractedListEmd) a = b ∨ Disjoint ((Finset.mapEmbedding uncontractedListEmd) a) b
      rightinr.inl𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthb:Finset (Fin φs.length)hb:b ∈ ↑φsΛa:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛ⊢ Disjoint ((Finset.mapEmbedding uncontractedListEmd) a) b
      rw [Finset.mapEmbedding_applyinr.inl𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthb:Finset (Fin φs.length)hb:b ∈ ↑φsΛa:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛ⊢ Disjoint (Finset.map uncontractedListEmd a) binr.inl𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthb:Finset (Fin φs.length)hb:b ∈ ↑φsΛa:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛ⊢ Disjoint (Finset.map uncontractedListEmd a) b]inr.inl𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthb:Finset (Fin φs.length)hb:b ∈ ↑φsΛa:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛ⊢ Disjoint (Finset.map uncontractedListEmd a) b
      apply uncontractedListEmd_finset_disjoint_leftinr.inl𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthb:Finset (Fin φs.length)hb:b ∈ ↑φsΛa:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛ⊢ b ∈ ↑φsΛ
      exact hbAll goals completed! 🐙
    ·inr.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)b:Finset (Fin φs.length)ha:∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = ahb:∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = b⊢ a = b ∨ Disjoint a b obtain ⟨a, ha, rfl⟩ := hainr.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthb:Finset (Fin φs.length)hb:∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = ba:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛ⊢ (Finset.mapEmbedding uncontractedListEmd) a = b ∨ Disjoint ((Finset.mapEmbedding uncontractedListEmd) a) b
      obtain ⟨b, hb, rfl⟩ := hbinr.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ (Finset.mapEmbedding uncontractedListEmd) a = (Finset.mapEmbedding uncontractedListEmd) b ∨
  Disjoint ((Finset.mapEmbedding uncontractedListEmd) a) ((Finset.mapEmbedding uncontractedListEmd) b)
      simp only [EmbeddingLike.apply_eq_iff_eq]inr.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ a = b ∨ Disjoint ((Finset.mapEmbedding uncontractedListEmd) a) ((Finset.mapEmbedding uncontractedListEmd) b)
      rw [Finset.mapEmbedding_apply,inr.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ a = b ∨ Disjoint (Finset.map uncontractedListEmd a) ((Finset.mapEmbedding uncontractedListEmd) b)inr.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ a = b ∨ Disjoint (Finset.map uncontractedListEmd a) (Finset.map uncontractedListEmd b) Finset.mapEmbedding_applyinr.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ a = b ∨ Disjoint (Finset.map uncontractedListEmd a) (Finset.map uncontractedListEmd b)inr.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ a = b ∨ Disjoint (Finset.map uncontractedListEmd a) (Finset.map uncontractedListEmd b)]inr.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ a = b ∨ Disjoint (Finset.map uncontractedListEmd a) (Finset.map uncontractedListEmd b)
      rw [Finset.disjoint_mapinr.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ a = b ∨ Disjoint a binr.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ a = b ∨ Disjoint a b]inr.inr𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛb:Finset (Fin [φsΛ]ᵘᶜ.length)hb:b ∈ ↑φsucΛ⊢ a = b ∨ Disjoint a b
      exact φsucΛ.2.2 a ha b hbAll goals completed! 🐙⟩

lemma join_congr {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length}
    {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} {φsΛ' : WickContraction φs.length}
    (h1 : φsΛ = φsΛ') :
    join φsΛ φsucΛ = join φsΛ' (congr (by𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsΛ':WickContraction φs.lengthh1:φsΛ = φsΛ'⊢ [φsΛ]ᵘᶜ.length = [φsΛ']ᵘᶜ.length simp [h1]All goals completed! 🐙) φsucΛ) := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsΛ':WickContraction φs.lengthh1:φsΛ = φsΛ'⊢ φsΛ.join φsucΛ = φsΛ'.join ((congr ⋯) φsucΛ)
  subst h1𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ φsΛ.join φsucΛ = φsΛ.join ((congr ⋯) φsucΛ)
  rflAll goals completed! 🐙

Given a contracting pair within φsΛ the corresponding contracting pair within (join φsΛ φsucΛ).

def joinLiftLeft {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length}
    {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} : φsΛ.1 → (join φsΛ φsucΛ).1 :=
  fun a => ⟨a, by𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛ⊢ ↑a ∈ ↑(φsΛ.join φsucΛ) simp [join]All goals completed! 🐙⟩

lemma jointLiftLeft_injective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length}
    {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} :
    Function.Injective (@joinLiftLeft _ _ φsΛ φsucΛ) := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ Function.Injective joinLiftLeft
  intro a b h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛb:↥↑φsΛh:joinLiftLeft a = joinLiftLeft b⊢ a = b
  simp only [joinLiftLeft, Subtype.mk_eq_mk] at h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛb:↥↑φsΛh:↑a = ↑b⊢ a = b
  exact Subtype.ext hAll goals completed! 🐙

Given a contracting pair within φsucΛ the corresponding contracting pair within (join φsΛ φsucΛ).

def joinLiftRight {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length}
    {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} : φsucΛ.1 → (join φsΛ φsucΛ).1 :=
  fun a => ⟨a.1.map uncontractedListEmd, by𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ Finset.map uncontractedListEmd ↑a ∈ ↑(φsΛ.join φsucΛ)
    simp only [join, Finset.mem_union, Finset.mem_map,
      RelEmbedding.coe_toEmbedding]𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ Finset.map uncontractedListEmd ↑a ∈ ↑φsΛ ∨
  ∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = Finset.map uncontractedListEmd ↑a
    right𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ ∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = Finset.map uncontractedListEmd ↑a
    use a.1h𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ ↑a ∈ ↑φsucΛ ∧ (Finset.mapEmbedding uncontractedListEmd) ↑a = Finset.map uncontractedListEmd ↑a
    simp only [Finset.coe_mem, true_and]h𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ (Finset.mapEmbedding uncontractedListEmd) ↑a = Finset.map uncontractedListEmd ↑a
    rflAll goals completed! 🐙⟩

              lemma joinLiftRight_injective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length}
    {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} :
    Function.Injective (@joinLiftRight _ _ φsΛ φsucΛ) := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ Function.Injective joinLiftRight
  intro a b h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛb:↥↑φsucΛh:joinLiftRight a = joinLiftRight b⊢ a = b
  simp only [joinLiftRight, Subtype.mk_eq_mk, Finset.map_inj] at h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛb:↥↑φsucΛh:↑a = ↑b⊢ a = b
  exact Subtype.ext hAll goals completed! 🐙lemma jointLiftLeft_disjoint_joinLiftRight {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length}
    {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} (a : φsΛ.1) (b : φsucΛ.1) :
    Disjoint (@joinLiftLeft _ _ _ φsucΛ a).1 (joinLiftRight b).1 :=
  (uncontractedListEmd_finset_disjoint_left b.1 a.1 a.2).symm

lemma jointLiftLeft_ne_joinLiftRight {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length}
    {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} (a : φsΛ.1) (b : φsucΛ.1) :
    joinLiftLeft a ≠ joinLiftRight b := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛb:↥↑φsucΛ⊢ joinLiftLeft a ≠ joinLiftRight b
  by_contra hn𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛb:↥↑φsucΛhn:joinLiftLeft a = joinLiftRight b⊢ False
  have h1 := jointLiftLeft_disjoint_joinLiftRight a b𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛb:↥↑φsucΛhn:joinLiftLeft a = joinLiftRight bh1:Disjoint ↑(joinLiftLeft a) ↑(joinLiftRight b)⊢ False
  rw [hn,𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛb:↥↑φsucΛhn:joinLiftLeft a = joinLiftRight bh1:Disjoint ↑(joinLiftRight b) ↑(joinLiftRight b)⊢ False𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛb:↥↑φsucΛhn:joinLiftLeft a = joinLiftRight bh1:↑(joinLiftRight b) = ∅⊢ False disjoint_self,𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛb:↥↑φsucΛhn:joinLiftLeft a = joinLiftRight bh1:↑(joinLiftRight b) = ⊥⊢ False𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛb:↥↑φsucΛhn:joinLiftLeft a = joinLiftRight bh1:↑(joinLiftRight b) = ∅⊢ False Finset.bot_eq_empty𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛb:↥↑φsucΛhn:joinLiftLeft a = joinLiftRight bh1:↑(joinLiftRight b) = ∅⊢ False𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛb:↥↑φsucΛhn:joinLiftLeft a = joinLiftRight bh1:↑(joinLiftRight b) = ∅⊢ False] at h1𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛb:↥↑φsucΛhn:joinLiftLeft a = joinLiftRight bh1:↑(joinLiftRight b) = ∅⊢ False
  have hj := (join φsΛ φsucΛ).2.1 (joinLiftRight b).1 (joinLiftRight b).2𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛb:↥↑φsucΛhn:joinLiftLeft a = joinLiftRight bh1:↑(joinLiftRight b) = ∅hj:(↑(joinLiftRight b)).card = 2⊢ False
  simp [h1] at hjAll goals completed! 🐙

The map from contracted pairs of φsΛ and φsucΛ to contracted pairs in (join φsΛ φsucΛ).

def joinLift {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length}
    {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} : φsΛ.1 ⊕ φsucΛ.1 → (join φsΛ φsucΛ).1 := fun a =>
  match a with
  | Sum.inl a => joinLiftLeft a
  | Sum.inr a => joinLiftRight a

              lemma joinLift_injective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length}
    {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} : Function.Injective (@joinLift _ _ φsΛ φsucΛ) := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ Function.Injective joinLift
  intro a b h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛ ⊕ ↥↑φsucΛb:↥↑φsΛ ⊕ ↥↑φsucΛh:joinLift a = joinLift b⊢ a = b
  match a, b with
  | Sum.inl a, Sum.inl b =>𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha✝:↥↑φsΛ ⊕ ↥↑φsucΛb✝:↥↑φsΛ ⊕ ↥↑φsucΛa:↥↑φsΛb:↥↑φsΛh:joinLift (Sum.inl a) = joinLift (Sum.inl b)⊢ Sum.inl a = Sum.inl b
    exact congrArg Sum.inl (jointLiftLeft_injective h)All goals completed! 🐙
  | Sum.inr a, Sum.inr b =>𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha✝:↥↑φsΛ ⊕ ↥↑φsucΛb✝:↥↑φsΛ ⊕ ↥↑φsucΛa:↥↑φsucΛb:↥↑φsucΛh:joinLift (Sum.inr a) = joinLift (Sum.inr b)⊢ Sum.inr a = Sum.inr b
    exact congrArg Sum.inr (joinLiftRight_injective h)All goals completed! 🐙
  | Sum.inl a, Sum.inr b =>𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha✝:↥↑φsΛ ⊕ ↥↑φsucΛb✝:↥↑φsΛ ⊕ ↥↑φsucΛa:↥↑φsΛb:↥↑φsucΛh:joinLift (Sum.inl a) = joinLift (Sum.inr b)⊢ Sum.inl a = Sum.inr b
    exact absurd h (jointLiftLeft_ne_joinLiftRight a b)All goals completed! 🐙
  | Sum.inr a, Sum.inl b =>𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha✝:↥↑φsΛ ⊕ ↥↑φsucΛb✝:↥↑φsΛ ⊕ ↥↑φsucΛa:↥↑φsucΛb:↥↑φsΛh:joinLift (Sum.inr a) = joinLift (Sum.inl b)⊢ Sum.inr a = Sum.inl b
    exact absurd h.symm (jointLiftLeft_ne_joinLiftRight b a)All goals completed! 🐙

lemma joinLift_surjective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length}
    {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} : Function.Surjective (@joinLift _ _ φsΛ φsucΛ) := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ Function.Surjective joinLift
  intro a𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑(φsΛ.join φsucΛ)⊢ ∃ a_1, joinLift a_1 = a
  have ha2 := a.2𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑(φsΛ.join φsucΛ)ha2:↑a ∈ ↑(φsΛ.join φsucΛ)⊢ ∃ a_1, joinLift a_1 = a
  simp only [join, Finset.mem_union, Finset.mem_map,
    RelEmbedding.coe_toEmbedding] at ha2𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑(φsΛ.join φsucΛ)ha2:↑a ∈ ↑φsΛ ∨ ∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = ↑a⊢ ∃ a_1, joinLift a_1 = a
  rcases ha2 with ha2 | ⟨a2, ha3⟩inl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑(φsΛ.join φsucΛ)ha2:↑a ∈ ↑φsΛ⊢ ∃ a_1, joinLift a_1 = ainr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑(φsΛ.join φsucΛ)a2:Finset (Fin [φsΛ]ᵘᶜ.length)ha3:a2 ∈ ↑φsucΛ ∧ (Finset.mapEmbedding uncontractedListEmd) a2 = ↑a⊢ ∃ a_1, joinLift a_1 = a
  ·inl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑(φsΛ.join φsucΛ)ha2:↑a ∈ ↑φsΛ⊢ ∃ a_1, joinLift a_1 = a use Sum.inl ⟨a, ha2⟩h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑(φsΛ.join φsucΛ)ha2:↑a ∈ ↑φsΛ⊢ joinLift (Sum.inl ⟨↑a, ha2⟩) = a
    simp [joinLift, joinLiftLeft]All goals completed! 🐙
  ·inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑(φsΛ.join φsucΛ)a2:Finset (Fin [φsΛ]ᵘᶜ.length)ha3:a2 ∈ ↑φsucΛ ∧ (Finset.mapEmbedding uncontractedListEmd) a2 = ↑a⊢ ∃ a_1, joinLift a_1 = a rw [Finset.mapEmbedding_applyinr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑(φsΛ.join φsucΛ)a2:Finset (Fin [φsΛ]ᵘᶜ.length)ha3:a2 ∈ ↑φsucΛ ∧ Finset.map uncontractedListEmd a2 = ↑a⊢ ∃ a_1, joinLift a_1 = ainr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑(φsΛ.join φsucΛ)a2:Finset (Fin [φsΛ]ᵘᶜ.length)ha3:a2 ∈ ↑φsucΛ ∧ Finset.map uncontractedListEmd a2 = ↑a⊢ ∃ a_1, joinLift a_1 = a] at ha3inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑(φsΛ.join φsucΛ)a2:Finset (Fin [φsΛ]ᵘᶜ.length)ha3:a2 ∈ ↑φsucΛ ∧ Finset.map uncontractedListEmd a2 = ↑a⊢ ∃ a_1, joinLift a_1 = a
    use Sum.inr ⟨a2, ha3.1⟩h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑(φsΛ.join φsucΛ)a2:Finset (Fin [φsΛ]ᵘᶜ.length)ha3:a2 ∈ ↑φsucΛ ∧ Finset.map uncontractedListEmd a2 = ↑a⊢ joinLift (Sum.inr ⟨a2, ⋯⟩) = a
    simp only [joinLift, joinLiftRight]h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑(φsΛ.join φsucΛ)a2:Finset (Fin [φsΛ]ᵘᶜ.length)ha3:a2 ∈ ↑φsucΛ ∧ Finset.map uncontractedListEmd a2 = ↑a⊢ ⟨Finset.map uncontractedListEmd a2, ⋯⟩ = a
    refine Subtype.ext ?_h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑(φsΛ.join φsucΛ)a2:Finset (Fin [φsΛ]ᵘᶜ.length)ha3:a2 ∈ ↑φsucΛ ∧ Finset.map uncontractedListEmd a2 = ↑a⊢ ↑⟨Finset.map uncontractedListEmd a2, ⋯⟩ = ↑a
    exact ha3.2All goals completed! 🐙lemma joinLift_bijective {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length}
    {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} : Function.Bijective (@joinLift _ _ φsΛ φsucΛ) :=
  ⟨joinLift_injective, joinLift_surjective⟩

lemma prod_join {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) (f : (join φsΛ φsucΛ).1 → M) [CommMonoid M]:
      ∏ (a : (join φsΛ φsucΛ).1), f a = (∏ (a : φsΛ.1), f (joinLiftLeft a)) *
      ∏ (a : φsucΛ.1), f (joinLiftRight a) := by𝓕:FieldSpecificationM:Type u_1φs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthf:↥↑(φsΛ.join φsucΛ) → Minst✝:CommMonoid M⊢ ∏ a, f a = (∏ a, f (joinLiftLeft a)) * ∏ a, f (joinLiftRight a)
  rw [← (Equiv.ofBijective (@joinLift _ _ φsΛ φsucΛ) joinLift_bijective).prod_comp𝓕:FieldSpecificationM:Type u_1φs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthf:↥↑(φsΛ.join φsucΛ) → Minst✝:CommMonoid M⊢ ∏ i, f ((Equiv.ofBijective joinLift ⋯) i) = (∏ a, f (joinLiftLeft a)) * ∏ a, f (joinLiftRight a)𝓕:FieldSpecificationM:Type u_1φs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthf:↥↑(φsΛ.join φsucΛ) → Minst✝:CommMonoid M⊢ ∏ i, f ((Equiv.ofBijective joinLift ⋯) i) = (∏ a, f (joinLiftLeft a)) * ∏ a, f (joinLiftRight a)]𝓕:FieldSpecificationM:Type u_1φs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthf:↥↑(φsΛ.join φsucΛ) → Minst✝:CommMonoid M⊢ ∏ i, f ((Equiv.ofBijective joinLift ⋯) i) = (∏ a, f (joinLiftLeft a)) * ∏ a, f (joinLiftRight a)
  simp only [Fintype.prod_sum_type, Finset.univ_eq_attach]𝓕:FieldSpecificationM:Type u_1φs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthf:↥↑(φsΛ.join φsucΛ) → Minst✝:CommMonoid M⊢ (∏ a₁ ∈ (↑φsΛ).attach, f ((Equiv.ofBijective joinLift ⋯) (Sum.inl a₁))) *
    ∏ a₂ ∈ (↑φsucΛ).attach, f ((Equiv.ofBijective joinLift ⋯) (Sum.inr a₂)) =
  (∏ a ∈ (↑φsΛ).attach, f (joinLiftLeft a)) * ∏ a ∈ (↑φsucΛ).attach, f (joinLiftRight a)
  rflAll goals completed! 🐙lemma joinLiftLeft_or_joinLiftRight_of_mem_join {φs : List 𝓕.FieldOp}
    (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) {a : Finset (Fin φs.length)}
    (ha : a ∈ (join φsΛ φsucΛ).1) :
    (∃ b, a = (joinLiftLeft (φsucΛ := φsucΛ) b).1) ∨
    (∃ b, a = (joinLiftRight (φsucΛ := φsucΛ) b).1) := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑(φsΛ.join φsucΛ)⊢ (∃ b, a = ↑(joinLiftLeft b)) ∨ ∃ b, a = ↑(joinLiftRight b)
  simp only [join, Finset.mem_union, Finset.mem_map,
    RelEmbedding.coe_toEmbedding] at ha𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛ ∨ ∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ (∃ b, a = ↑(joinLiftLeft b)) ∨ ∃ b, a = ↑(joinLiftRight b)
  rcases ha with ha | ⟨a, ha, rfl⟩inl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛ⊢ (∃ b, a = ↑(joinLiftLeft b)) ∨ ∃ b, a = ↑(joinLiftRight b)inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛ⊢ (∃ b, (Finset.mapEmbedding uncontractedListEmd) a = ↑(joinLiftLeft b)) ∨
  ∃ b, (Finset.mapEmbedding uncontractedListEmd) a = ↑(joinLiftRight b)
  ·inl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛ⊢ (∃ b, a = ↑(joinLiftLeft b)) ∨ ∃ b, a = ↑(joinLiftRight b) exact Or.inl ⟨⟨a, ha⟩, rfl⟩All goals completed! 🐙
  ·inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛ⊢ (∃ b, (Finset.mapEmbedding uncontractedListEmd) a = ↑(joinLiftLeft b)) ∨
  ∃ b, (Finset.mapEmbedding uncontractedListEmd) a = ↑(joinLiftRight b) exact Or.inr ⟨⟨a, ha⟩, rfl⟩All goals completed! 🐙@[simp]
lemma join_fstFieldOfContract_joinLiftRight {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) (a : φsucΛ.1) :
    (join φsΛ φsucΛ).fstFieldOfContract (joinLiftRight a) =
    uncontractedListEmd (φsucΛ.fstFieldOfContract a) := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ (φsΛ.join φsucΛ).fstFieldOfContract (joinLiftRight a) = uncontractedListEmd (φsucΛ.fstFieldOfContract a)
  apply eq_fstFieldOfContract_of_mem _ _ _ (uncontractedListEmd (φsucΛ.sndFieldOfContract a))hi𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ uncontractedListEmd (φsucΛ.fstFieldOfContract a) ∈ ↑(joinLiftRight a)hj𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ uncontractedListEmd (φsucΛ.sndFieldOfContract a) ∈ ↑(joinLiftRight a)hij𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ uncontractedListEmd (φsucΛ.fstFieldOfContract a) < uncontractedListEmd (φsucΛ.sndFieldOfContract a)
  ·hi𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ uncontractedListEmd (φsucΛ.fstFieldOfContract a) ∈ ↑(joinLiftRight a) simp [joinLiftRight]All goals completed! 🐙
  ·hj𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ uncontractedListEmd (φsucΛ.sndFieldOfContract a) ∈ ↑(joinLiftRight a) simp [joinLiftRight]All goals completed! 🐙
  ·hij𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ uncontractedListEmd (φsucΛ.fstFieldOfContract a) < uncontractedListEmd (φsucΛ.sndFieldOfContract a) apply uncontractedListEmd_strictMonohij𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ φsucΛ.fstFieldOfContract a < φsucΛ.sndFieldOfContract a
    exact fstFieldOfContract_lt_sndFieldOfContract φsucΛ aAll goals completed! 🐙@[simp]
lemma join_sndFieldOfContract_joinLiftRight {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) (a : φsucΛ.1) :
    (join φsΛ φsucΛ).sndFieldOfContract (joinLiftRight a) =
    uncontractedListEmd (φsucΛ.sndFieldOfContract a) := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ (φsΛ.join φsucΛ).sndFieldOfContract (joinLiftRight a) = uncontractedListEmd (φsucΛ.sndFieldOfContract a)
  apply eq_sndFieldOfContract_of_mem _ _ (uncontractedListEmd (φsucΛ.fstFieldOfContract a))hi𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ uncontractedListEmd (φsucΛ.fstFieldOfContract a) ∈ ↑(joinLiftRight a)hj𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ uncontractedListEmd (φsucΛ.sndFieldOfContract a) ∈ ↑(joinLiftRight a)hij𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ uncontractedListEmd (φsucΛ.fstFieldOfContract a) < uncontractedListEmd (φsucΛ.sndFieldOfContract a)
  ·hi𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ uncontractedListEmd (φsucΛ.fstFieldOfContract a) ∈ ↑(joinLiftRight a) simp [joinLiftRight]All goals completed! 🐙
  ·hj𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ uncontractedListEmd (φsucΛ.sndFieldOfContract a) ∈ ↑(joinLiftRight a) simp [joinLiftRight]All goals completed! 🐙
  ·hij𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ uncontractedListEmd (φsucΛ.fstFieldOfContract a) < uncontractedListEmd (φsucΛ.sndFieldOfContract a) apply uncontractedListEmd_strictMonohij𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛ⊢ φsucΛ.fstFieldOfContract a < φsucΛ.sndFieldOfContract a
    exact fstFieldOfContract_lt_sndFieldOfContract φsucΛ aAll goals completed! 🐙@[simp]
lemma join_fstFieldOfContract_joinLiftLeft {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) (a : φsΛ.1) :
    (join φsΛ φsucΛ).fstFieldOfContract (joinLiftLeft a) =
    (φsΛ.fstFieldOfContract a) := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛ⊢ (φsΛ.join φsucΛ).fstFieldOfContract (joinLiftLeft a) = φsΛ.fstFieldOfContract a
  apply eq_fstFieldOfContract_of_mem _ _ _ (φsΛ.sndFieldOfContract a)hi𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛ⊢ φsΛ.fstFieldOfContract a ∈ ↑(joinLiftLeft a)hj𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛ⊢ φsΛ.sndFieldOfContract a ∈ ↑(joinLiftLeft a)hij𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛ⊢ φsΛ.fstFieldOfContract a < φsΛ.sndFieldOfContract a
  ·hi𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛ⊢ φsΛ.fstFieldOfContract a ∈ ↑(joinLiftLeft a) simp [joinLiftLeft]All goals completed! 🐙
  ·hj𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛ⊢ φsΛ.sndFieldOfContract a ∈ ↑(joinLiftLeft a) simp [joinLiftLeft]All goals completed! 🐙
  ·hij𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛ⊢ φsΛ.fstFieldOfContract a < φsΛ.sndFieldOfContract a exact fstFieldOfContract_lt_sndFieldOfContract φsΛ aAll goals completed! 🐙@[simp]
lemma join_sndFieldOfContract_joinLift {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) (a : φsΛ.1) :
    (join φsΛ φsucΛ).sndFieldOfContract (joinLiftLeft a) =
    (φsΛ.sndFieldOfContract a) := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛ⊢ (φsΛ.join φsucΛ).sndFieldOfContract (joinLiftLeft a) = φsΛ.sndFieldOfContract a
  apply eq_sndFieldOfContract_of_mem _ _ (φsΛ.fstFieldOfContract a) (φsΛ.sndFieldOfContract a)hi𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛ⊢ φsΛ.fstFieldOfContract a ∈ ↑(joinLiftLeft a)hj𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛ⊢ φsΛ.sndFieldOfContract a ∈ ↑(joinLiftLeft a)hij𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛ⊢ φsΛ.fstFieldOfContract a < φsΛ.sndFieldOfContract a
  ·hi𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛ⊢ φsΛ.fstFieldOfContract a ∈ ↑(joinLiftLeft a) simp [joinLiftLeft]All goals completed! 🐙
  ·hj𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛ⊢ φsΛ.sndFieldOfContract a ∈ ↑(joinLiftLeft a) simp [joinLiftLeft]All goals completed! 🐙
  ·hij𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsΛ⊢ φsΛ.fstFieldOfContract a < φsΛ.sndFieldOfContract a exact fstFieldOfContract_lt_sndFieldOfContract φsΛ aAll goals completed! 🐙

lemma mem_join_right_iff {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) (a : Finset (Fin [φsΛ]ᵘᶜ.length)) :
    a ∈ φsucΛ.1 ↔ a.map uncontractedListEmd ∈ (join φsΛ φsucΛ).1 := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)⊢ a ∈ ↑φsucΛ ↔ Finset.map uncontractedListEmd a ∈ ↑(φsΛ.join φsucΛ)
  simp only [join, Finset.mem_union, Finset.mem_map,
    RelEmbedding.coe_toEmbedding]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)⊢ a ∈ ↑φsucΛ ↔
  Finset.map uncontractedListEmd a ∈ ↑φsΛ ∨
    ∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = Finset.map uncontractedListEmd a
  have h1' : ¬ Finset.map uncontractedListEmd a ∈ φsΛ.1 :=
    uncontractedListEmd_finset_not_mem a𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)h1':Finset.map uncontractedListEmd a ∉ ↑φsΛ⊢ a ∈ ↑φsucΛ ↔
  Finset.map uncontractedListEmd a ∈ ↑φsΛ ∨
    ∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = Finset.map uncontractedListEmd a
  simp only [h1', false_or]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)h1':Finset.map uncontractedListEmd a ∉ ↑φsΛ⊢ a ∈ ↑φsucΛ ↔ ∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = Finset.map uncontractedListEmd a
  apply Iff.intromp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)h1':Finset.map uncontractedListEmd a ∉ ↑φsΛ⊢ a ∈ ↑φsucΛ → ∃ a_2 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_2 = Finset.map uncontractedListEmd ampr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)h1':Finset.map uncontractedListEmd a ∉ ↑φsΛ⊢ (∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = Finset.map uncontractedListEmd a) → a ∈ ↑φsucΛ
  ·mp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)h1':Finset.map uncontractedListEmd a ∉ ↑φsΛ⊢ a ∈ ↑φsucΛ → ∃ a_2 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_2 = Finset.map uncontractedListEmd a intro hmp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)h1':Finset.map uncontractedListEmd a ∉ ↑φsΛh:a ∈ ↑φsucΛ⊢ ∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = Finset.map uncontractedListEmd a
    exact ⟨a, h, Finset.mapEmbedding_apply⟩All goals completed! 🐙
  ·mpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)h1':Finset.map uncontractedListEmd a ∉ ↑φsΛ⊢ (∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = Finset.map uncontractedListEmd a) → a ∈ ↑φsucΛ rintro ⟨a, ha, h2⟩mpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha✝:Finset (Fin [φsΛ]ᵘᶜ.length)h1':Finset.map uncontractedListEmd a ∉ ↑φsΛa:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛh2:(Finset.mapEmbedding uncontractedListEmd) a = Finset.map uncontractedListEmd a✝⊢ a ∈ ↑φsucΛ
    rw [Finset.mapEmbedding_apply,mpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha✝:Finset (Fin [φsΛ]ᵘᶜ.length)h1':Finset.map uncontractedListEmd a ∉ ↑φsΛa:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛh2:Finset.map uncontractedListEmd a = Finset.map uncontractedListEmd a✝⊢ a ∈ ↑φsucΛmpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha✝:Finset (Fin [φsΛ]ᵘᶜ.length)h1':Finset.map uncontractedListEmd a ∉ ↑φsΛa:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛh2:a = a✝⊢ a ∈ ↑φsucΛ Finset.map_injmpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha✝:Finset (Fin [φsΛ]ᵘᶜ.length)h1':Finset.map uncontractedListEmd a ∉ ↑φsΛa:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛh2:a = a✝⊢ a ∈ ↑φsucΛmpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha✝:Finset (Fin [φsΛ]ᵘᶜ.length)h1':Finset.map uncontractedListEmd a ∉ ↑φsΛa:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛh2:a = a✝⊢ a ∈ ↑φsucΛ] at h2mpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha✝:Finset (Fin [φsΛ]ᵘᶜ.length)h1':Finset.map uncontractedListEmd a ∉ ↑φsΛa:Finset (Fin [φsΛ]ᵘᶜ.length)ha:a ∈ ↑φsucΛh2:a = a✝⊢ a ∈ ↑φsucΛ
    exact h2 ▸ haAll goals completed! 🐙

lemma join_card {φs : List 𝓕.FieldOp} {φsΛ : WickContraction φs.length}
    {φsucΛ : WickContraction [φsΛ]ᵘᶜ.length} :
    (join φsΛ φsucΛ).1.card = φsΛ.1.card + φsucΛ.1.card := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (↑(φsΛ.join φsucΛ)).card = (↑φsΛ).card + (↑φsucΛ).card
  simp only [join]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ).card = (↑φsΛ).card + (↑φsucΛ).card
  rw [Finset.card_union_of_disjoint𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (↑φsΛ).card + (Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ).card =
  (↑φsΛ).card + (↑φsucΛ).card𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ Disjoint (↑φsΛ) (Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ)𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (↑φsΛ).card + (Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ).card =
  (↑φsΛ).card + (↑φsucΛ).card𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ Disjoint (↑φsΛ) (Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ)]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (↑φsΛ).card + (Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ).card =
  (↑φsΛ).card + (↑φsucΛ).card𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ Disjoint (↑φsΛ) (Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ)
  simp only [Finset.card_map]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ Disjoint (↑φsΛ) (Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ)
  rw [@Finset.disjoint_left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ∀ ⦃a : Finset (Fin φs.length)⦄, a ∈ ↑φsΛ → a ∉ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ∀ ⦃a : Finset (Fin φs.length)⦄, a ∈ ↑φsΛ → a ∉ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ∀ ⦃a : Finset (Fin φs.length)⦄, a ∈ ↑φsΛ → a ∉ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ
  intro a ha𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛ⊢ a ∉ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ
  simp only [Finset.mem_map, RelEmbedding.coe_toEmbedding, not_exists, not_and]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛ⊢ ∀ x ∈ ↑φsucΛ, ¬(Finset.mapEmbedding uncontractedListEmd) x = a
  intro x hx𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛx:Finset (Fin [φsΛ]ᵘᶜ.length)hx:x ∈ ↑φsucΛ⊢ ¬(Finset.mapEmbedding uncontractedListEmd) x = a
  by_contra hn𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛx:Finset (Fin [φsΛ]ᵘᶜ.length)hx:x ∈ ↑φsucΛhn:(Finset.mapEmbedding uncontractedListEmd) x = a⊢ False
  have hdis : Disjoint (Finset.map uncontractedListEmd x) a :=
    uncontractedListEmd_finset_disjoint_left x a ha𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛx:Finset (Fin [φsΛ]ᵘᶜ.length)hx:x ∈ ↑φsucΛhn:(Finset.mapEmbedding uncontractedListEmd) x = ahdis:Disjoint (Finset.map uncontractedListEmd x) a⊢ False
  rw [Finset.mapEmbedding_apply𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛx:Finset (Fin [φsΛ]ᵘᶜ.length)hx:x ∈ ↑φsucΛhn:Finset.map uncontractedListEmd x = ahdis:Disjoint (Finset.map uncontractedListEmd x) a⊢ False𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛx:Finset (Fin [φsΛ]ᵘᶜ.length)hx:x ∈ ↑φsucΛhn:Finset.map uncontractedListEmd x = ahdis:Disjoint (Finset.map uncontractedListEmd x) a⊢ False] at hn𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛx:Finset (Fin [φsΛ]ᵘᶜ.length)hx:x ∈ ↑φsucΛhn:Finset.map uncontractedListEmd x = ahdis:Disjoint (Finset.map uncontractedListEmd x) a⊢ False
  rw [hn𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛx:Finset (Fin [φsΛ]ᵘᶜ.length)hx:x ∈ ↑φsucΛhn:Finset.map uncontractedListEmd x = ahdis:Disjoint a a⊢ False𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛx:Finset (Fin [φsΛ]ᵘᶜ.length)hx:x ∈ ↑φsucΛhn:Finset.map uncontractedListEmd x = ahdis:Disjoint a a⊢ False] at hdis𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛx:Finset (Fin [φsΛ]ᵘᶜ.length)hx:x ∈ ↑φsucΛhn:Finset.map uncontractedListEmd x = ahdis:Disjoint a a⊢ False
  have hcard := φsΛ.2.1 a ha𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛx:Finset (Fin [φsΛ]ᵘᶜ.length)hx:x ∈ ↑φsucΛhn:Finset.map uncontractedListEmd x = ahdis:Disjoint a ahcard:a.card = 2⊢ False
  simp_allAll goals completed! 🐙

@[simp]
lemma empty_join {φs : List 𝓕.FieldOp} (φsΛ : WickContraction [empty (n := φs.length)]ᵘᶜ.length) :
    join empty φsΛ = congr (by𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.length⊢ [empty]ᵘᶜ.length = φs.length simpAll goals completed! 🐙) φsΛ := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.length⊢ empty.join φsΛ = (congr ⋯) φsΛ
  apply Subtype.ext𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.length⊢ ↑(empty.join φsΛ) = ↑((congr ⋯) φsΛ)
  simp only [join, uncontractedListEmd_empty]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.length⊢ ↑empty ∪ Finset.map (Finset.mapEmbedding (finCongr ⋯).toEmbedding).toEmbedding ↑φsΛ = ↑((congr ⋯) φsΛ)
  ext a𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)⊢ a ∈ ↑empty ∪ Finset.map (Finset.mapEmbedding (finCongr ⋯).toEmbedding).toEmbedding ↑φsΛ ↔ a ∈ ↑((congr ⋯) φsΛ)
  conv_lhs =>
    left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)| ↑empty ∪ Finset.map (Finset.mapEmbedding (finCongr ⋯).toEmbedding).toEmbedding ↑φsΛ
    left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)| ↑empty
    rw [empty]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)| ↑⟨∅, ⋯⟩
  simp only [Finset.empty_union, Finset.mem_map, RelEmbedding.coe_toEmbedding]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)⊢ (∃ a_1 ∈ ↑φsΛ, (Finset.mapEmbedding (finCongr ⋯).toEmbedding) a_1 = a) ↔ a ∈ ↑((congr ⋯) φsΛ)
  rw [mem_congr_iff𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)⊢ (∃ a_1 ∈ ↑φsΛ, (Finset.mapEmbedding (finCongr ⋯).toEmbedding) a_1 = a) ↔ Finset.map (finCongr ⋯).toEmbedding a ∈ ↑φsΛ𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)⊢ (∃ a_1 ∈ ↑φsΛ, (Finset.mapEmbedding (finCongr ⋯).toEmbedding) a_1 = a) ↔ Finset.map (finCongr ⋯).toEmbedding a ∈ ↑φsΛ]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)⊢ (∃ a_1 ∈ ↑φsΛ, (Finset.mapEmbedding (finCongr ⋯).toEmbedding) a_1 = a) ↔ Finset.map (finCongr ⋯).toEmbedding a ∈ ↑φsΛ
  apply Iff.intromp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)⊢ (∃ a_1 ∈ ↑φsΛ, (Finset.mapEmbedding (finCongr ⋯).toEmbedding) a_1 = a) → Finset.map (finCongr ⋯).toEmbedding a ∈ ↑φsΛmpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)⊢ Finset.map (finCongr ⋯).toEmbedding a ∈ ↑φsΛ → ∃ a_2 ∈ ↑φsΛ, (Finset.mapEmbedding (finCongr ⋯).toEmbedding) a_2 = a
  ·mp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)⊢ (∃ a_1 ∈ ↑φsΛ, (Finset.mapEmbedding (finCongr ⋯).toEmbedding) a_1 = a) → Finset.map (finCongr ⋯).toEmbedding a ∈ ↑φsΛ intro hmp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)h:∃ a_1 ∈ ↑φsΛ, (Finset.mapEmbedding (finCongr ⋯).toEmbedding) a_1 = a⊢ Finset.map (finCongr ⋯).toEmbedding a ∈ ↑φsΛ
    obtain ⟨a, ha, rfl⟩ := hmp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin [empty]ᵘᶜ.length)ha:a ∈ ↑φsΛ⊢ Finset.map (finCongr ⋯).toEmbedding ((Finset.mapEmbedding (finCongr ⋯).toEmbedding) a) ∈ ↑φsΛ
    rw [Finset.mapEmbedding_applymp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin [empty]ᵘᶜ.length)ha:a ∈ ↑φsΛ⊢ Finset.map (finCongr ⋯).toEmbedding (Finset.map (finCongr ⋯).toEmbedding a) ∈ ↑φsΛmp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin [empty]ᵘᶜ.length)ha:a ∈ ↑φsΛ⊢ Finset.map (finCongr ⋯).toEmbedding (Finset.map (finCongr ⋯).toEmbedding a) ∈ ↑φsΛ]mp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin [empty]ᵘᶜ.length)ha:a ∈ ↑φsΛ⊢ Finset.map (finCongr ⋯).toEmbedding (Finset.map (finCongr ⋯).toEmbedding a) ∈ ↑φsΛ
    rw [Finset.map_mapmp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin [empty]ᵘᶜ.length)ha:a ∈ ↑φsΛ⊢ Finset.map ((finCongr ⋯).toEmbedding.trans (finCongr ⋯).toEmbedding) a ∈ ↑φsΛmp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin [empty]ᵘᶜ.length)ha:a ∈ ↑φsΛ⊢ Finset.map ((finCongr ⋯).toEmbedding.trans (finCongr ⋯).toEmbedding) a ∈ ↑φsΛ]mp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin [empty]ᵘᶜ.length)ha:a ∈ ↑φsΛ⊢ Finset.map ((finCongr ⋯).toEmbedding.trans (finCongr ⋯).toEmbedding) a ∈ ↑φsΛ
    apply Set.mem_of_eq_of_mem _ ha𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin [empty]ᵘᶜ.length)ha:a ∈ ↑φsΛ⊢ Finset.map ((finCongr ⋯).toEmbedding.trans (finCongr ⋯).toEmbedding) a = a
    exact Finset.map_reflAll goals completed! 🐙
  ·mpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)⊢ Finset.map (finCongr ⋯).toEmbedding a ∈ ↑φsΛ → ∃ a_2 ∈ ↑φsΛ, (Finset.mapEmbedding (finCongr ⋯).toEmbedding) a_2 = a intro hmpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)h:Finset.map (finCongr ⋯).toEmbedding a ∈ ↑φsΛ⊢ ∃ a_1 ∈ ↑φsΛ, (Finset.mapEmbedding (finCongr ⋯).toEmbedding) a_1 = a
    use Finset.map (finCongr (by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)h:Finset.map (finCongr ⋯).toEmbedding a ∈ ↑φsΛ⊢ φs.length = [empty]ᵘᶜ.length simpAll goals completed! 🐙)).toEmbedding a
    simp only [h, true_and]h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)h:Finset.map (finCongr ⋯).toEmbedding a ∈ ↑φsΛ⊢ (Finset.mapEmbedding (finCongr ⋯).toEmbedding) (Finset.map (finCongr ⋯).toEmbedding a) = a
    rw [Finset.mapEmbedding_apply,h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)h:Finset.map (finCongr ⋯).toEmbedding a ∈ ↑φsΛ⊢ Finset.map (finCongr ⋯).toEmbedding (Finset.map (finCongr ⋯).toEmbedding a) = ah𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)h:Finset.map (finCongr ⋯).toEmbedding a ∈ ↑φsΛ⊢ Finset.map ((finCongr ⋯).toEmbedding.trans (finCongr ⋯).toEmbedding) a = a Finset.map_maph𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)h:Finset.map (finCongr ⋯).toEmbedding a ∈ ↑φsΛ⊢ Finset.map ((finCongr ⋯).toEmbedding.trans (finCongr ⋯).toEmbedding) a = ah𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)h:Finset.map (finCongr ⋯).toEmbedding a ∈ ↑φsΛ⊢ Finset.map ((finCongr ⋯).toEmbedding.trans (finCongr ⋯).toEmbedding) a = a]h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction [empty]ᵘᶜ.lengtha:Finset (Fin φs.length)h:Finset.map (finCongr ⋯).toEmbedding a ∈ ↑φsΛ⊢ Finset.map ((finCongr ⋯).toEmbedding.trans (finCongr ⋯).toEmbedding) a = a
    exact Finset.map_reflAll goals completed! 🐙@[simp]
lemma join_empty {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length) :
    join φsΛ empty = φsΛ := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.length⊢ φsΛ.join empty = φsΛ
  apply Subtype.ext𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.length⊢ ↑(φsΛ.join empty) = ↑φsΛ
  ext a𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengtha:Finset (Fin φs.length)⊢ a ∈ ↑(φsΛ.join empty) ↔ a ∈ ↑φsΛ
  simp [join, empty]All goals completed! 🐙

lemma join_timeContract {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) :
    (join φsΛ φsucΛ).timeContract = φsΛ.timeContract * φsucΛ.timeContract := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (φsΛ.join φsucΛ).timeContract = φsΛ.timeContract * φsucΛ.timeContract
  simp only [timeContract, List.get_eq_getElem]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ∏ x,
    ⟨WickAlgebra.timeContract φs[↑((φsΛ.join φsucΛ).fstFieldOfContract x)] φs[↑((φsΛ.join φsucΛ).sndFieldOfContract x)],
      ⋯⟩ =
  (∏ x, ⟨WickAlgebra.timeContract φs[↑(φsΛ.fstFieldOfContract x)] φs[↑(φsΛ.sndFieldOfContract x)], ⋯⟩) *
    ∏ x, ⟨WickAlgebra.timeContract [φsΛ]ᵘᶜ[↑(φsucΛ.fstFieldOfContract x)] [φsΛ]ᵘᶜ[↑(φsucΛ.sndFieldOfContract x)], ⋯⟩
  rw [prod_join𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (∏ a,
      ⟨WickAlgebra.timeContract φs[↑((φsΛ.join φsucΛ).fstFieldOfContract (joinLiftLeft a))]
          φs[↑((φsΛ.join φsucΛ).sndFieldOfContract (joinLiftLeft a))],
        ⋯⟩) *
    ∏ a,
      ⟨WickAlgebra.timeContract φs[↑((φsΛ.join φsucΛ).fstFieldOfContract (joinLiftRight a))]
          φs[↑((φsΛ.join φsucΛ).sndFieldOfContract (joinLiftRight a))],
        ⋯⟩ =
  (∏ x, ⟨WickAlgebra.timeContract φs[↑(φsΛ.fstFieldOfContract x)] φs[↑(φsΛ.sndFieldOfContract x)], ⋯⟩) *
    ∏ x, ⟨WickAlgebra.timeContract [φsΛ]ᵘᶜ[↑(φsucΛ.fstFieldOfContract x)] [φsΛ]ᵘᶜ[↑(φsucΛ.sndFieldOfContract x)], ⋯⟩𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (∏ a,
      ⟨WickAlgebra.timeContract φs[↑((φsΛ.join φsucΛ).fstFieldOfContract (joinLiftLeft a))]
          φs[↑((φsΛ.join φsucΛ).sndFieldOfContract (joinLiftLeft a))],
        ⋯⟩) *
    ∏ a,
      ⟨WickAlgebra.timeContract φs[↑((φsΛ.join φsucΛ).fstFieldOfContract (joinLiftRight a))]
          φs[↑((φsΛ.join φsucΛ).sndFieldOfContract (joinLiftRight a))],
        ⋯⟩ =
  (∏ x, ⟨WickAlgebra.timeContract φs[↑(φsΛ.fstFieldOfContract x)] φs[↑(φsΛ.sndFieldOfContract x)], ⋯⟩) *
    ∏ x, ⟨WickAlgebra.timeContract [φsΛ]ᵘᶜ[↑(φsucΛ.fstFieldOfContract x)] [φsΛ]ᵘᶜ[↑(φsucΛ.sndFieldOfContract x)], ⋯⟩]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (∏ a,
      ⟨WickAlgebra.timeContract φs[↑((φsΛ.join φsucΛ).fstFieldOfContract (joinLiftLeft a))]
          φs[↑((φsΛ.join φsucΛ).sndFieldOfContract (joinLiftLeft a))],
        ⋯⟩) *
    ∏ a,
      ⟨WickAlgebra.timeContract φs[↑((φsΛ.join φsucΛ).fstFieldOfContract (joinLiftRight a))]
          φs[↑((φsΛ.join φsucΛ).sndFieldOfContract (joinLiftRight a))],
        ⋯⟩ =
  (∏ x, ⟨WickAlgebra.timeContract φs[↑(φsΛ.fstFieldOfContract x)] φs[↑(φsΛ.sndFieldOfContract x)], ⋯⟩) *
    ∏ x, ⟨WickAlgebra.timeContract [φsΛ]ᵘᶜ[↑(φsucΛ.fstFieldOfContract x)] [φsΛ]ᵘᶜ[↑(φsucΛ.sndFieldOfContract x)], ⋯⟩
  congr 1e_a𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ∏ a,
    ⟨WickAlgebra.timeContract φs[↑((φsΛ.join φsucΛ).fstFieldOfContract (joinLiftRight a))]
        φs[↑((φsΛ.join φsucΛ).sndFieldOfContract (joinLiftRight a))],
      ⋯⟩ =
  ∏ x, ⟨WickAlgebra.timeContract [φsΛ]ᵘᶜ[↑(φsucΛ.fstFieldOfContract x)] [φsΛ]ᵘᶜ[↑(φsucΛ.sndFieldOfContract x)], ⋯⟩
  exact Finset.prod_congr rfl fun a _ => by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛx✝:a ∈ Finset.univ⊢ ⟨WickAlgebra.timeContract φs[↑((φsΛ.join φsucΛ).fstFieldOfContract (joinLiftRight a))]
      φs[↑((φsΛ.join φsucΛ).sndFieldOfContract (joinLiftRight a))],
    ⋯⟩ =
  ⟨WickAlgebra.timeContract [φsΛ]ᵘᶜ[↑(φsucΛ.fstFieldOfContract a)] [φsΛ]ᵘᶜ[↑(φsucΛ.sndFieldOfContract a)], ⋯⟩ simpAll goals completed! 🐙

lemma join_staticContract {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) :
    (join φsΛ φsucΛ).staticContract = φsΛ.staticContract * φsucΛ.staticContract := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (φsΛ.join φsucΛ).staticContract = φsΛ.staticContract * φsucΛ.staticContract
  simp only [staticContract, List.get_eq_getElem]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ∏ x,
    ⟨(superCommute (anPart φs[↑((φsΛ.join φsucΛ).fstFieldOfContract x)]))
        (ofFieldOp φs[↑((φsΛ.join φsucΛ).sndFieldOfContract x)]),
      ⋯⟩ =
  (∏ x, ⟨(superCommute (anPart φs[↑(φsΛ.fstFieldOfContract x)])) (ofFieldOp φs[↑(φsΛ.sndFieldOfContract x)]), ⋯⟩) *
    ∏ x,
      ⟨(superCommute (anPart [φsΛ]ᵘᶜ[↑(φsucΛ.fstFieldOfContract x)]))
          (ofFieldOp [φsΛ]ᵘᶜ[↑(φsucΛ.sndFieldOfContract x)]),
        ⋯⟩
  rw [prod_join𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (∏ a,
      ⟨(superCommute (anPart φs[↑((φsΛ.join φsucΛ).fstFieldOfContract (joinLiftLeft a))]))
          (ofFieldOp φs[↑((φsΛ.join φsucΛ).sndFieldOfContract (joinLiftLeft a))]),
        ⋯⟩) *
    ∏ a,
      ⟨(superCommute (anPart φs[↑((φsΛ.join φsucΛ).fstFieldOfContract (joinLiftRight a))]))
          (ofFieldOp φs[↑((φsΛ.join φsucΛ).sndFieldOfContract (joinLiftRight a))]),
        ⋯⟩ =
  (∏ x, ⟨(superCommute (anPart φs[↑(φsΛ.fstFieldOfContract x)])) (ofFieldOp φs[↑(φsΛ.sndFieldOfContract x)]), ⋯⟩) *
    ∏ x,
      ⟨(superCommute (anPart [φsΛ]ᵘᶜ[↑(φsucΛ.fstFieldOfContract x)]))
          (ofFieldOp [φsΛ]ᵘᶜ[↑(φsucΛ.sndFieldOfContract x)]),
        ⋯⟩𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (∏ a,
      ⟨(superCommute (anPart φs[↑((φsΛ.join φsucΛ).fstFieldOfContract (joinLiftLeft a))]))
          (ofFieldOp φs[↑((φsΛ.join φsucΛ).sndFieldOfContract (joinLiftLeft a))]),
        ⋯⟩) *
    ∏ a,
      ⟨(superCommute (anPart φs[↑((φsΛ.join φsucΛ).fstFieldOfContract (joinLiftRight a))]))
          (ofFieldOp φs[↑((φsΛ.join φsucΛ).sndFieldOfContract (joinLiftRight a))]),
        ⋯⟩ =
  (∏ x, ⟨(superCommute (anPart φs[↑(φsΛ.fstFieldOfContract x)])) (ofFieldOp φs[↑(φsΛ.sndFieldOfContract x)]), ⋯⟩) *
    ∏ x,
      ⟨(superCommute (anPart [φsΛ]ᵘᶜ[↑(φsucΛ.fstFieldOfContract x)]))
          (ofFieldOp [φsΛ]ᵘᶜ[↑(φsucΛ.sndFieldOfContract x)]),
        ⋯⟩]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (∏ a,
      ⟨(superCommute (anPart φs[↑((φsΛ.join φsucΛ).fstFieldOfContract (joinLiftLeft a))]))
          (ofFieldOp φs[↑((φsΛ.join φsucΛ).sndFieldOfContract (joinLiftLeft a))]),
        ⋯⟩) *
    ∏ a,
      ⟨(superCommute (anPart φs[↑((φsΛ.join φsucΛ).fstFieldOfContract (joinLiftRight a))]))
          (ofFieldOp φs[↑((φsΛ.join φsucΛ).sndFieldOfContract (joinLiftRight a))]),
        ⋯⟩ =
  (∏ x, ⟨(superCommute (anPart φs[↑(φsΛ.fstFieldOfContract x)])) (ofFieldOp φs[↑(φsΛ.sndFieldOfContract x)]), ⋯⟩) *
    ∏ x,
      ⟨(superCommute (anPart [φsΛ]ᵘᶜ[↑(φsucΛ.fstFieldOfContract x)]))
          (ofFieldOp [φsΛ]ᵘᶜ[↑(φsucΛ.sndFieldOfContract x)]),
        ⋯⟩
  congr 1e_a𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ∏ a,
    ⟨(superCommute (anPart φs[↑((φsΛ.join φsucΛ).fstFieldOfContract (joinLiftRight a))]))
        (ofFieldOp φs[↑((φsΛ.join φsucΛ).sndFieldOfContract (joinLiftRight a))]),
      ⋯⟩ =
  ∏ x,
    ⟨(superCommute (anPart [φsΛ]ᵘᶜ[↑(φsucΛ.fstFieldOfContract x)])) (ofFieldOp [φsΛ]ᵘᶜ[↑(φsucΛ.sndFieldOfContract x)]),
      ⋯⟩
  exact Finset.prod_congr rfl fun a _ => by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:↥↑φsucΛx✝:a ∈ Finset.univ⊢ ⟨(superCommute (anPart φs[↑((φsΛ.join φsucΛ).fstFieldOfContract (joinLiftRight a))]))
      (ofFieldOp φs[↑((φsΛ.join φsucΛ).sndFieldOfContract (joinLiftRight a))]),
    ⋯⟩ =
  ⟨(superCommute (anPart [φsΛ]ᵘᶜ[↑(φsucΛ.fstFieldOfContract a)])) (ofFieldOp [φsΛ]ᵘᶜ[↑(φsucΛ.sndFieldOfContract a)]), ⋯⟩ simpAll goals completed! 🐙

lemma mem_join_uncontracted_of_mem_right_uncontracted {φs : List 𝓕.FieldOp}
    (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) (i : Fin [φsΛ]ᵘᶜ.length)
    (ha : i ∈ φsucΛ.uncontracted) :
    uncontractedListEmd i ∈ (join φsΛ φsucΛ).uncontracted := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontracted⊢ uncontractedListEmd i ∈ (φsΛ.join φsucΛ).uncontracted
  rw [mem_uncontracted_iff_not_contracted𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontracted⊢ ∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd i ∉ p𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontracted⊢ ∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd i ∉ p]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontracted⊢ ∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd i ∉ p
  intro p hp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin φs.length)hp:p ∈ ↑(φsΛ.join φsucΛ)⊢ uncontractedListEmd i ∉ p
  simp only [join, Finset.mem_union, Finset.mem_map,
    RelEmbedding.coe_toEmbedding] at hp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin φs.length)hp:p ∈ ↑φsΛ ∨ ∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = p⊢ uncontractedListEmd i ∉ p
  rcases hp with hp | hpinl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin φs.length)hp:p ∈ ↑φsΛ⊢ uncontractedListEmd i ∉ pinr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin φs.length)hp:∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = p⊢ uncontractedListEmd i ∉ p
  ·inl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin φs.length)hp:p ∈ ↑φsΛ⊢ uncontractedListEmd i ∉ p have hi : uncontractedListEmd i ∈ φsΛ.uncontracted := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontracted⊢ uncontractedListEmd i ∈ (φsΛ.join φsucΛ).uncontractedinl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin φs.length)hp:p ∈ ↑φsΛhi:uncontractedListEmd i ∈ φsΛ.uncontracted⊢ uncontractedListEmd i ∉ p
      exact uncontractedListEmd_mem_uncontracted iinl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin φs.length)hp:p ∈ ↑φsΛhi:uncontractedListEmd i ∈ φsΛ.uncontracted⊢ uncontractedListEmd i ∉ pinl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin φs.length)hp:p ∈ ↑φsΛhi:uncontractedListEmd i ∈ φsΛ.uncontracted⊢ uncontractedListEmd i ∉ p
    rw [mem_uncontracted_iff_not_contractedinl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin φs.length)hp:p ∈ ↑φsΛhi:∀ p ∈ ↑φsΛ, uncontractedListEmd i ∉ p⊢ uncontractedListEmd i ∉ pinl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin φs.length)hp:p ∈ ↑φsΛhi:∀ p ∈ ↑φsΛ, uncontractedListEmd i ∉ p⊢ uncontractedListEmd i ∉ p] at hiinl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin φs.length)hp:p ∈ ↑φsΛhi:∀ p ∈ ↑φsΛ, uncontractedListEmd i ∉ p⊢ uncontractedListEmd i ∉ p
    exact hi p hpAll goals completed! 🐙
  ·inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin φs.length)hp:∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = p⊢ uncontractedListEmd i ∉ p obtain ⟨p, hp, rfl⟩ := hpinr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛ⊢ uncontractedListEmd i ∉ (Finset.mapEmbedding uncontractedListEmd) p
    rw [Finset.mapEmbedding_applyinr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛ⊢ uncontractedListEmd i ∉ Finset.map uncontractedListEmd pinr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛ⊢ uncontractedListEmd i ∉ Finset.map uncontractedListEmd p]inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛ⊢ uncontractedListEmd i ∉ Finset.map uncontractedListEmd p
    simp only [Finset.mem_map']inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:i ∈ φsucΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛ⊢ i ∉ p
    rw [mem_uncontracted_iff_not_contractedinr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:∀ p ∈ ↑φsucΛ, i ∉ pp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛ⊢ i ∉ pinr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:∀ p ∈ ↑φsucΛ, i ∉ pp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛ⊢ i ∉ p] at hainr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthha:∀ p ∈ ↑φsucΛ, i ∉ pp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛ⊢ i ∉ p
    exact ha p hpAll goals completed! 🐙

lemma exists_mem_left_uncontracted_of_mem_join_uncontracted {φs : List 𝓕.FieldOp}
    (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) (i : Fin φs.length)
    (ha : i ∈ (join φsΛ φsucΛ).uncontracted) :
    i ∈ φsΛ.uncontracted := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin φs.lengthha:i ∈ (φsΛ.join φsucΛ).uncontracted⊢ i ∈ φsΛ.uncontracted
  rw [@mem_uncontracted_iff_not_contracted𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin φs.lengthha:i ∈ (φsΛ.join φsucΛ).uncontracted⊢ ∀ p ∈ ↑φsΛ, i ∉ p𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin φs.lengthha:i ∈ (φsΛ.join φsucΛ).uncontracted⊢ ∀ p ∈ ↑φsΛ, i ∉ p]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin φs.lengthha:i ∈ (φsΛ.join φsucΛ).uncontracted⊢ ∀ p ∈ ↑φsΛ, i ∉ p
  rw [@mem_uncontracted_iff_not_contracted𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin φs.lengthha:∀ p ∈ ↑(φsΛ.join φsucΛ), i ∉ p⊢ ∀ p ∈ ↑φsΛ, i ∉ p𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin φs.lengthha:∀ p ∈ ↑(φsΛ.join φsucΛ), i ∉ p⊢ ∀ p ∈ ↑φsΛ, i ∉ p] at ha𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin φs.lengthha:∀ p ∈ ↑(φsΛ.join φsucΛ), i ∉ p⊢ ∀ p ∈ ↑φsΛ, i ∉ p
  simp only [join, Finset.mem_union, Finset.mem_map,
    RelEmbedding.coe_toEmbedding] at ha𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin φs.lengthha:∀ (p : Finset (Fin φs.length)), (p ∈ ↑φsΛ ∨ ∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = p) → i ∉ p⊢ ∀ p ∈ ↑φsΛ, i ∉ p
  intro p hp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin φs.lengthha:∀ (p : Finset (Fin φs.length)), (p ∈ ↑φsΛ ∨ ∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = p) → i ∉ pp:Finset (Fin φs.length)hp:p ∈ ↑φsΛ⊢ i ∉ p
  simp_allAll goals completed! 🐙

lemma exists_mem_right_uncontracted_of_mem_join_uncontracted {φs : List 𝓕.FieldOp}
    (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) (i : Fin φs.length)
    (hi : i ∈ (join φsΛ φsucΛ).uncontracted) :
    ∃ a, uncontractedListEmd a = i ∧ a ∈ φsucΛ.uncontracted := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin φs.lengthhi:i ∈ (φsΛ.join φsucΛ).uncontracted⊢ ∃ a, uncontractedListEmd a = i ∧ a ∈ φsucΛ.uncontracted
  have hi' := exists_mem_left_uncontracted_of_mem_join_uncontracted _ _ i hi𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin φs.lengthhi:i ∈ (φsΛ.join φsucΛ).uncontractedhi':i ∈ φsΛ.uncontracted⊢ ∃ a, uncontractedListEmd a = i ∧ a ∈ φsucΛ.uncontracted
  obtain ⟨j, rfl⟩ := uncontractedListEmd_surjective_mem_uncontracted i hi'𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:uncontractedListEmd j ∈ (φsΛ.join φsucΛ).uncontractedhi':uncontractedListEmd j ∈ φsΛ.uncontracted⊢ ∃ a, uncontractedListEmd a = uncontractedListEmd j ∧ a ∈ φsucΛ.uncontracted
  refine ⟨j, rfl, ?_⟩𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:uncontractedListEmd j ∈ (φsΛ.join φsucΛ).uncontractedhi':uncontractedListEmd j ∈ φsΛ.uncontracted⊢ j ∈ φsucΛ.uncontracted
  rw [mem_uncontracted_iff_not_contracted𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontracted⊢ ∀ p ∈ ↑φsucΛ, j ∉ p𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontracted⊢ ∀ p ∈ ↑φsucΛ, j ∉ p] at hi ⊢𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontracted⊢ ∀ p ∈ ↑φsucΛ, j ∉ p
  intro p hp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛ⊢ j ∉ p
  have hip := hi (p.map uncontractedListEmd) (by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛ⊢ Finset.map uncontractedListEmd p ∈ ↑(φsΛ.join φsucΛ)𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛhip:uncontractedListEmd j ∉ Finset.map uncontractedListEmd p⊢ j ∉ p
    simp only [join, Finset.mem_union, Finset.mem_map,
      RelEmbedding.coe_toEmbedding]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛ⊢ Finset.map uncontractedListEmd p ∈ ↑φsΛ ∨
  ∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = Finset.map uncontractedListEmd p𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛhip:uncontractedListEmd j ∉ Finset.map uncontractedListEmd p⊢ j ∉ p
    right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛ⊢ ∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = Finset.map uncontractedListEmd p𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛhip:uncontractedListEmd j ∉ Finset.map uncontractedListEmd p⊢ j ∉ p
    use ph𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛ⊢ p ∈ ↑φsucΛ ∧ (Finset.mapEmbedding uncontractedListEmd) p = Finset.map uncontractedListEmd p𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛhip:uncontractedListEmd j ∉ Finset.map uncontractedListEmd p⊢ j ∉ p
    simp only [hp, true_and]h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛ⊢ (Finset.mapEmbedding uncontractedListEmd) p = Finset.map uncontractedListEmd p𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛhip:uncontractedListEmd j ∉ Finset.map uncontractedListEmd p⊢ j ∉ p
    rw [Finset.mapEmbedding_applyh𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛ⊢ Finset.map uncontractedListEmd p = Finset.map uncontractedListEmd pAll goals completed! 🐙𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛhip:uncontractedListEmd j ∉ Finset.map uncontractedListEmd p⊢ j ∉ p]All goals completed! 🐙𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛhip:uncontractedListEmd j ∉ Finset.map uncontractedListEmd p⊢ j ∉ p)𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthj:Fin [φsΛ]ᵘᶜ.lengthhi:∀ p ∈ ↑(φsΛ.join φsucΛ), uncontractedListEmd j ∉ phi':uncontractedListEmd j ∈ φsΛ.uncontractedp:Finset (Fin [φsΛ]ᵘᶜ.length)hp:p ∈ ↑φsucΛhip:uncontractedListEmd j ∉ Finset.map uncontractedListEmd p⊢ j ∉ p
  simpa using hipAll goals completed! 🐙

lemma join_uncontractedList {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) :
    (join φsΛ φsucΛ).uncontractedList = List.map uncontractedListEmd φsucΛ.uncontractedList := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (φsΛ.join φsucΛ).uncontractedList = List.map (⇑uncontractedListEmd) φsucΛ.uncontractedList
  rw [uncontractedList_eq_sort𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ((φsΛ.join φsucΛ).uncontracted.sort fun x1 x2 => x1 ≤ x2) = List.map (⇑uncontractedListEmd) φsucΛ.uncontractedList𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ((φsΛ.join φsucΛ).uncontracted.sort fun x1 x2 => x1 ≤ x2) = List.map (⇑uncontractedListEmd) φsucΛ.uncontractedList]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ((φsΛ.join φsucΛ).uncontracted.sort fun x1 x2 => x1 ≤ x2) = List.map (⇑uncontractedListEmd) φsucΛ.uncontractedList
  rw [uncontractedList_eq_sort𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ((φsΛ.join φsucΛ).uncontracted.sort fun x1 x2 => x1 ≤ x2) =
  List.map (⇑uncontractedListEmd) (φsucΛ.uncontracted.sort fun x1 x2 => x1 ≤ x2)𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ((φsΛ.join φsucΛ).uncontracted.sort fun x1 x2 => x1 ≤ x2) =
  List.map (⇑uncontractedListEmd) (φsucΛ.uncontracted.sort fun x1 x2 => x1 ≤ x2)]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ((φsΛ.join φsucΛ).uncontracted.sort fun x1 x2 => x1 ≤ x2) =
  List.map (⇑uncontractedListEmd) (φsucΛ.uncontracted.sort fun x1 x2 => x1 ≤ x2)
  rw [fin_finset_sort_map_monotone𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ((φsΛ.join φsucΛ).uncontracted.sort fun x1 x2 => x1 ≤ x2) =
  (Finset.map uncontractedListEmd φsucΛ.uncontracted).sort fun x1 x2 => x1 ≤ x2hf𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ StrictMono ⇑uncontractedListEmd𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ((φsΛ.join φsucΛ).uncontracted.sort fun x1 x2 => x1 ≤ x2) =
  (Finset.map uncontractedListEmd φsucΛ.uncontracted).sort fun x1 x2 => x1 ≤ x2hf𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ StrictMono ⇑uncontractedListEmd]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ((φsΛ.join φsucΛ).uncontracted.sort fun x1 x2 => x1 ≤ x2) =
  (Finset.map uncontractedListEmd φsucΛ.uncontracted).sort fun x1 x2 => x1 ≤ x2hf𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ StrictMono ⇑uncontractedListEmd
  congre_s𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (φsΛ.join φsucΛ).uncontracted = Finset.map uncontractedListEmd φsucΛ.uncontractedhf𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ StrictMono ⇑uncontractedListEmd
  ext ae_s𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Fin φs.length⊢ a ∈ (φsΛ.join φsucΛ).uncontracted ↔ a ∈ Finset.map uncontractedListEmd φsucΛ.uncontractedhf𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ StrictMono ⇑uncontractedListEmd
  simp only [Finset.mem_map]e_s𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Fin φs.length⊢ a ∈ (φsΛ.join φsucΛ).uncontracted ↔ ∃ a_1 ∈ φsucΛ.uncontracted, uncontractedListEmd a_1 = ahf𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ StrictMono ⇑uncontractedListEmd
  apply Iff.introe_s.mp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Fin φs.length⊢ a ∈ (φsΛ.join φsucΛ).uncontracted → ∃ a_2 ∈ φsucΛ.uncontracted, uncontractedListEmd a_2 = ae_s.mpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Fin φs.length⊢ (∃ a_1 ∈ φsucΛ.uncontracted, uncontractedListEmd a_1 = a) → a ∈ (φsΛ.join φsucΛ).uncontractedhf𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ StrictMono ⇑uncontractedListEmd
  ·e_s.mp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Fin φs.length⊢ a ∈ (φsΛ.join φsucΛ).uncontracted → ∃ a_2 ∈ φsucΛ.uncontracted, uncontractedListEmd a_2 = a intro he_s.mp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Fin φs.lengthh:a ∈ (φsΛ.join φsucΛ).uncontracted⊢ ∃ a_1 ∈ φsucΛ.uncontracted, uncontractedListEmd a_1 = a
    obtain ⟨a, rfl, ha⟩ := exists_mem_right_uncontracted_of_mem_join_uncontracted _ _ a he_s.mp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Fin [φsΛ]ᵘᶜ.lengthha:a ∈ φsucΛ.uncontractedh:uncontractedListEmd a ∈ (φsΛ.join φsucΛ).uncontracted⊢ ∃ a_1 ∈ φsucΛ.uncontracted, uncontractedListEmd a_1 = uncontractedListEmd a
    use a, haAll goals completed! 🐙
  ·e_s.mpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Fin φs.length⊢ (∃ a_1 ∈ φsucΛ.uncontracted, uncontractedListEmd a_1 = a) → a ∈ (φsΛ.join φsucΛ).uncontracted intro he_s.mpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Fin φs.lengthh:∃ a_1 ∈ φsucΛ.uncontracted, uncontractedListEmd a_1 = a⊢ a ∈ (φsΛ.join φsucΛ).uncontracted
    obtain ⟨a, ha, rfl⟩ := he_s.mpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Fin [φsΛ]ᵘᶜ.lengthha:a ∈ φsucΛ.uncontracted⊢ uncontractedListEmd a ∈ (φsΛ.join φsucΛ).uncontracted
    exact mem_join_uncontracted_of_mem_right_uncontracted φsΛ φsucΛ a haAll goals completed! 🐙
  ·hf𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ StrictMono ⇑uncontractedListEmd intro a b hhf𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Fin [φsΛ]ᵘᶜ.lengthb:Fin [φsΛ]ᵘᶜ.lengthh:a < b⊢ uncontractedListEmd a < uncontractedListEmd b
    exact uncontractedListEmd_strictMono hAll goals completed! 🐙

lemma join_uncontractedList_get {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) :
    ((join φsΛ φsucΛ).uncontractedList).get =
    φsΛ.uncontractedListEmd ∘ (φsucΛ.uncontractedList).get ∘
        (Fin.cast (by𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (φsΛ.join φsucΛ).uncontractedList.length = φsucΛ.uncontractedList.length rw [join_uncontractedList𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (List.map (⇑uncontractedListEmd) φsucΛ.uncontractedList).length = φsucΛ.uncontractedList.length𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (List.map (⇑uncontractedListEmd) φsucΛ.uncontractedList).length = φsucΛ.uncontractedList.length]𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (List.map (⇑uncontractedListEmd) φsucΛ.uncontractedList).length = φsucΛ.uncontractedList.length; simpAll goals completed! 🐙)) := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (φsΛ.join φsucΛ).uncontractedList.get = ⇑uncontractedListEmd ∘ φsucΛ.uncontractedList.get ∘ Fin.cast ⋯
  have h1 {n : ℕ} (l1 l2 : List (Fin n)) (h : l1 = l2) :
      l1.get = l2.get ∘ Fin.cast (by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthn:ℕl1:List (Fin n)l2:List (Fin n)h:l1 = l2⊢ l1.length = l2.length𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthh1:∀ {n : ℕ} (l1 l2 : List (Fin n)) (h : l1 = l2), l1.get = l2.get ∘ Fin.cast ⋯⊢ (φsΛ.join φsucΛ).uncontractedList.get = ⇑uncontractedListEmd ∘ φsucΛ.uncontractedList.get ∘ Fin.cast ⋯ rw [h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthn:ℕl1:List (Fin n)l2:List (Fin n)h:l1 = l2⊢ l2.length = l2.lengthAll goals completed! 🐙𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthh1:∀ {n : ℕ} (l1 l2 : List (Fin n)) (h : l1 = l2), l1.get = l2.get ∘ Fin.cast ⋯⊢ (φsΛ.join φsucΛ).uncontractedList.get = ⇑uncontractedListEmd ∘ φsucΛ.uncontractedList.get ∘ Fin.cast ⋯]All goals completed! 🐙𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthh1:∀ {n : ℕ} (l1 l2 : List (Fin n)) (h : l1 = l2), l1.get = l2.get ∘ Fin.cast ⋯⊢ (φsΛ.join φsucΛ).uncontractedList.get = ⇑uncontractedListEmd ∘ φsucΛ.uncontractedList.get ∘ Fin.cast ⋯) := by
    subst h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthn:ℕl1:List (Fin n)⊢ l1.get = l1.get ∘ Fin.cast ⋯𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthh1:∀ {n : ℕ} (l1 l2 : List (Fin n)) (h : l1 = l2), l1.get = l2.get ∘ Fin.cast ⋯⊢ (φsΛ.join φsucΛ).uncontractedList.get = ⇑uncontractedListEmd ∘ φsucΛ.uncontractedList.get ∘ Fin.cast ⋯
    rfl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthh1:∀ {n : ℕ} (l1 l2 : List (Fin n)) (h : l1 = l2), l1.get = l2.get ∘ Fin.cast ⋯⊢ (φsΛ.join φsucΛ).uncontractedList.get = ⇑uncontractedListEmd ∘ φsucΛ.uncontractedList.get ∘ Fin.cast ⋯𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthh1:∀ {n : ℕ} (l1 l2 : List (Fin n)) (h : l1 = l2), l1.get = l2.get ∘ Fin.cast ⋯⊢ (φsΛ.join φsucΛ).uncontractedList.get = ⇑uncontractedListEmd ∘ φsucΛ.uncontractedList.get ∘ Fin.cast ⋯
  conv_lhs => rw [h1 _ _ (join_uncontractedList φsΛ φsucΛ)]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthh1:∀ {n : ℕ} (l1 l2 : List (Fin n)) (h : l1 = l2), l1.get = l2.get ∘ Fin.cast ⋯| (List.map (⇑uncontractedListEmd) φsucΛ.uncontractedList).get ∘ Fin.cast ⋯
  ext i𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthh1:∀ {n : ℕ} (l1 l2 : List (Fin n)) (h : l1 = l2), l1.get = l2.get ∘ Fin.cast ⋯i:Fin (φsΛ.join φsucΛ).uncontractedList.length⊢ ↑(((List.map (⇑uncontractedListEmd) φsucΛ.uncontractedList).get ∘ Fin.cast ⋯) i) =
  ↑((⇑uncontractedListEmd ∘ φsucΛ.uncontractedList.get ∘ Fin.cast ⋯) i)
  simpAll goals completed! 🐙lemma join_uncontractedListGet {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) :
    (join φsΛ φsucΛ).uncontractedListGet = φsucΛ.uncontractedListGet := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ [φsΛ.join φsucΛ]ᵘᶜ = [φsucΛ]ᵘᶜ
  simp only [uncontractedListGet, join_uncontractedList, List.map_map, List.map_inj_left,
    Function.comp_apply, List.get_eq_getElem, List.getElem_map]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ∀ a ∈ φsucΛ.uncontractedList, φs[↑(uncontractedListEmd a)] = φs[↑φsΛ.uncontractedList[↑a]]
  intro a ha𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Fin (List.map φs.get φsΛ.uncontractedList).lengthha:a ∈ φsucΛ.uncontractedList⊢ φs[↑(uncontractedListEmd a)] = φs[↑φsΛ.uncontractedList[↑a]]
  simp only [uncontractedListEmd, uncontractedIndexEquiv, List.get_eq_getElem,
    Equiv.trans_toEmbedding]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Fin (List.map φs.get φsΛ.uncontractedList).lengthha:a ∈ φsucΛ.uncontractedList⊢ φs[↑((((finCongr ⋯).toEmbedding.trans
              { toFun := fun i => ⟨φsΛ.uncontractedList[↑i], ⋯⟩,
                  invFun := fun i => ⟨List.idxOf (↑i) φsΛ.uncontractedList, ⋯⟩, left_inv := ⋯,
                  right_inv := ⋯ }.toEmbedding).trans
          (Function.Embedding.subtype fun x => x ∈ φsΛ.uncontracted))
        a)] =
  φs[↑φsΛ.uncontractedList[↑a]]
  rflAll goals completed! 🐙

lemma join_uncontractedListEmb {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) :
    (join φsΛ φsucΛ).uncontractedListEmd =
    ((finCongr (congrArg List.length (join_uncontractedListGet _ _))).toEmbedding.trans
      φsucΛ.uncontractedListEmd).trans φsΛ.uncontractedListEmd := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ uncontractedListEmd = ((finCongr ⋯).toEmbedding.trans uncontractedListEmd).trans uncontractedListEmd
  refine Function.Embedding.ext_iff.mpr (congrFun ?_)𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ ⇑uncontractedListEmd = ⇑(((finCongr ⋯).toEmbedding.trans uncontractedListEmd).trans uncontractedListEmd)
  change uncontractedListEmd.toFun = _𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ uncontractedListEmd.toFun = ⇑(((finCongr ⋯).toEmbedding.trans uncontractedListEmd).trans uncontractedListEmd)
  rw [uncontractedListEmd_toFun_eq_get,𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (φsΛ.join φsucΛ).uncontractedList.get ∘ ⇑(finCongr ⋯) =
  ⇑(((finCongr ⋯).toEmbedding.trans uncontractedListEmd).trans uncontractedListEmd)𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (⇑uncontractedListEmd ∘ φsucΛ.uncontractedList.get ∘ Fin.cast ⋯) ∘ ⇑(finCongr ⋯) =
  ⇑(((finCongr ⋯).toEmbedding.trans uncontractedListEmd).trans uncontractedListEmd) join_uncontractedList_get𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (⇑uncontractedListEmd ∘ φsucΛ.uncontractedList.get ∘ Fin.cast ⋯) ∘ ⇑(finCongr ⋯) =
  ⇑(((finCongr ⋯).toEmbedding.trans uncontractedListEmd).trans uncontractedListEmd)𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (⇑uncontractedListEmd ∘ φsucΛ.uncontractedList.get ∘ Fin.cast ⋯) ∘ ⇑(finCongr ⋯) =
  ⇑(((finCongr ⋯).toEmbedding.trans uncontractedListEmd).trans uncontractedListEmd)]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.length⊢ (⇑uncontractedListEmd ∘ φsucΛ.uncontractedList.get ∘ Fin.cast ⋯) ∘ ⇑(finCongr ⋯) =
  ⇑(((finCongr ⋯).toEmbedding.trans uncontractedListEmd).trans uncontractedListEmd)
  rflAll goals completed! 🐙

set_option backward.isDefEq.respectTransparency false in
lemma join_assoc {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) (φsucΛ' : WickContraction [φsΛ.join φsucΛ]ᵘᶜ.length) :
    join (join φsΛ φsucΛ) (φsucΛ') = join φsΛ (join φsucΛ (congr
      (congrArg List.length (join_uncontractedListGet _ _)) φsucΛ')) := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.length⊢ (φsΛ.join φsucΛ).join φsucΛ' = φsΛ.join (φsucΛ.join ((congr ⋯) φsucΛ'))
  apply Subtype.ext𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.length⊢ ↑((φsΛ.join φsucΛ).join φsucΛ') = ↑(φsΛ.join (φsucΛ.join ((congr ⋯) φsucΛ')))
  ext a𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)⊢ a ∈ ↑((φsΛ.join φsucΛ).join φsucΛ') ↔ a ∈ ↑(φsΛ.join (φsucΛ.join ((congr ⋯) φsucΛ')))
  by_cases ha : a ∈ φsΛ.1pos𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛ⊢ a ∈ ↑((φsΛ.join φsucΛ).join φsucΛ') ↔ a ∈ ↑(φsΛ.join (φsucΛ.join ((congr ⋯) φsucΛ')))neg𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∉ ↑φsΛ⊢ a ∈ ↑((φsΛ.join φsucΛ).join φsucΛ') ↔ a ∈ ↑(φsΛ.join (φsucΛ.join ((congr ⋯) φsucΛ')))
  ·pos𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛ⊢ a ∈ ↑((φsΛ.join φsucΛ).join φsucΛ') ↔ a ∈ ↑(φsΛ.join (φsucΛ.join ((congr ⋯) φsucΛ'))) simp [ha, join]All goals completed! 🐙
  simp only [join, Finset.union_assoc, Finset.mem_union, ha, Finset.mem_map,
    RelEmbedding.coe_toEmbedding, false_or]neg𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∉ ↑φsΛ⊢ ((∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = a) ∨
    ∃ a_1 ∈ ↑φsucΛ', (Finset.mapEmbedding uncontractedListEmd) a_1 = a) ↔
  ∃ a_1,
    (a_1 ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = a_1) ∧
      (Finset.mapEmbedding uncontractedListEmd) a_1 = a
  apply Iff.introneg.mp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∉ ↑φsΛ⊢ ((∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = a) ∨
    ∃ a_1 ∈ ↑φsucΛ', (Finset.mapEmbedding uncontractedListEmd) a_1 = a) →
  ∃ a_2,
    (a_2 ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = a_2) ∧
      (Finset.mapEmbedding uncontractedListEmd) a_2 = aneg.mpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∉ ↑φsΛ⊢ (∃ a_1,
    (a_1 ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = a_1) ∧
      (Finset.mapEmbedding uncontractedListEmd) a_1 = a) →
  (∃ a_2 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_2 = a) ∨
    ∃ a_2 ∈ ↑φsucΛ', (Finset.mapEmbedding uncontractedListEmd) a_2 = a
  ·neg.mp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∉ ↑φsΛ⊢ ((∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = a) ∨
    ∃ a_1 ∈ ↑φsucΛ', (Finset.mapEmbedding uncontractedListEmd) a_1 = a) →
  ∃ a_2,
    (a_2 ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = a_2) ∧
      (Finset.mapEmbedding uncontractedListEmd) a_2 = a intro hneg.mp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∉ ↑φsΛh:(∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = a) ∨
  ∃ a_1 ∈ ↑φsucΛ', (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ ∃ a_1,
  (a_1 ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = a_1) ∧
    (Finset.mapEmbedding uncontractedListEmd) a_1 = a
    rcases h with h | hneg.mp.inl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∉ ↑φsΛh:∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ ∃ a_1,
  (a_1 ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = a_1) ∧
    (Finset.mapEmbedding uncontractedListEmd) a_1 = aneg.mp.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∉ ↑φsΛh:∃ a_1 ∈ ↑φsucΛ', (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ ∃ a_1,
  (a_1 ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = a_1) ∧
    (Finset.mapEmbedding uncontractedListEmd) a_1 = a
    ·neg.mp.inl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∉ ↑φsΛh:∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ ∃ a_1,
  (a_1 ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = a_1) ∧
    (Finset.mapEmbedding uncontractedListEmd) a_1 = a obtain ⟨a, ha', rfl⟩ := hneg.mp.inl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha':a ∈ ↑φsucΛha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛ⊢ ∃ a_1,
  (a_1 ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = a_1) ∧
    (Finset.mapEmbedding uncontractedListEmd) a_1 = (Finset.mapEmbedding uncontractedListEmd) a
      use ah𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha':a ∈ ↑φsucΛha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛ⊢ (a ∈ ↑φsucΛ ∨ ∃ a_1 ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a_1 = a) ∧
  (Finset.mapEmbedding uncontractedListEmd) a = (Finset.mapEmbedding uncontractedListEmd) a
      simp [ha']All goals completed! 🐙
    ·neg.mp.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∉ ↑φsΛh:∃ a_1 ∈ ↑φsucΛ', (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ ∃ a_1,
  (a_1 ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = a_1) ∧
    (Finset.mapEmbedding uncontractedListEmd) a_1 = a obtain ⟨a, ha', rfl⟩ := hneg.mp.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛ⊢ ∃ a_1,
  (a_1 ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = a_1) ∧
    (Finset.mapEmbedding uncontractedListEmd) a_1 = (Finset.mapEmbedding uncontractedListEmd) a
      let a' := congrLift (congrArg List.length (join_uncontractedListGet _ _)) ⟨a, ha'⟩neg.mp.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩⊢ ∃ a_1,
  (a_1 ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = a_1) ∧
    (Finset.mapEmbedding uncontractedListEmd) a_1 = (Finset.mapEmbedding uncontractedListEmd) a
      let a'' := joinLiftRight a'neg.mp.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ ∃ a_1,
  (a_1 ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = a_1) ∧
    (Finset.mapEmbedding uncontractedListEmd) a_1 = (Finset.mapEmbedding uncontractedListEmd) a
      use a''h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ (↑a'' ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = ↑a'') ∧
  (Finset.mapEmbedding uncontractedListEmd) ↑a'' = (Finset.mapEmbedding uncontractedListEmd) a
      apply And.introh.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ ↑a'' ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = ↑a''h.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ (Finset.mapEmbedding uncontractedListEmd) ↑a'' = (Finset.mapEmbedding uncontractedListEmd) a
      ·h.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ ↑a'' ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = ↑a'' righth.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = ↑a''
        use a'h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ ↑a' ∈ ↑((congr ⋯) φsucΛ') ∧ (Finset.mapEmbedding uncontractedListEmd) ↑a' = ↑a''
        apply And.introh.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ ↑a' ∈ ↑((congr ⋯) φsucΛ')h.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ (Finset.mapEmbedding uncontractedListEmd) ↑a' = ↑a''
        ·h.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ ↑a' ∈ ↑((congr ⋯) φsucΛ') exact a'.2All goals completed! 🐙
        ·h.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ (Finset.mapEmbedding uncontractedListEmd) ↑a' = ↑a'' simp only [joinLiftRight, a'']h.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ (Finset.mapEmbedding uncontractedListEmd) ↑a' = Finset.map uncontractedListEmd ↑a'
          rflAll goals completed! 🐙
      ·h.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ (Finset.mapEmbedding uncontractedListEmd) ↑a'' = (Finset.mapEmbedding uncontractedListEmd) a simp only [a'']h.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ (Finset.mapEmbedding uncontractedListEmd) ↑(joinLiftRight a') = (Finset.mapEmbedding uncontractedListEmd) a
        rw [Finset.mapEmbedding_apply,h.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ Finset.map uncontractedListEmd ↑(joinLiftRight a') = (Finset.mapEmbedding uncontractedListEmd) ah.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ Finset.map uncontractedListEmd ↑(joinLiftRight a') = Finset.map uncontractedListEmd a Finset.mapEmbedding_applyh.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ Finset.map uncontractedListEmd ↑(joinLiftRight a') = Finset.map uncontractedListEmd ah.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ Finset.map uncontractedListEmd ↑(joinLiftRight a') = Finset.map uncontractedListEmd a]h.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ Finset.map uncontractedListEmd ↑(joinLiftRight a') = Finset.map uncontractedListEmd a
        simp only [a', joinLiftRight, congrLift]h.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ Finset.map uncontractedListEmd (Finset.map uncontractedListEmd (Finset.map (finCongr ⋯).toEmbedding a)) =
  Finset.map uncontractedListEmd a
        rw [join_uncontractedListEmbh.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ Finset.map uncontractedListEmd (Finset.map uncontractedListEmd (Finset.map (finCongr ⋯).toEmbedding a)) =
  Finset.map (((finCongr ⋯).toEmbedding.trans uncontractedListEmd).trans uncontractedListEmd) ah.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ Finset.map uncontractedListEmd (Finset.map uncontractedListEmd (Finset.map (finCongr ⋯).toEmbedding a)) =
  Finset.map (((finCongr ⋯).toEmbedding.trans uncontractedListEmd).trans uncontractedListEmd) a]h.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [⟨↑φsΛ ∪ Finset.map (Finset.mapEmbedding uncontractedListEmd).toEmbedding ↑φsucΛ, ⋯⟩]ᵘᶜ.length)ha':a ∈ ↑φsucΛ'ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛa':↥↑((congr ⋯) φsucΛ') := congrLift ⋯ ⟨a, ha'⟩a'':↥↑(φsucΛ.join ((congr ⋯) φsucΛ')) := joinLiftRight a'⊢ Finset.map uncontractedListEmd (Finset.map uncontractedListEmd (Finset.map (finCongr ⋯).toEmbedding a)) =
  Finset.map (((finCongr ⋯).toEmbedding.trans uncontractedListEmd).trans uncontractedListEmd) a
        simp [Finset.map_map]All goals completed! 🐙
  ·neg.mpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∉ ↑φsΛ⊢ (∃ a_1,
    (a_1 ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = a_1) ∧
      (Finset.mapEmbedding uncontractedListEmd) a_1 = a) →
  (∃ a_2 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_2 = a) ∨
    ∃ a_2 ∈ ↑φsucΛ', (Finset.mapEmbedding uncontractedListEmd) a_2 = a intro hneg.mpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∉ ↑φsΛh:∃ a_1,
  (a_1 ∈ ↑φsucΛ ∨ ∃ a ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a = a_1) ∧
    (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ (∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = a) ∨
  ∃ a_1 ∈ ↑φsucΛ', (Finset.mapEmbedding uncontractedListEmd) a_1 = a
    obtain ⟨a, ha', rfl⟩ := hneg.mpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha':a ∈ ↑φsucΛ ∨ ∃ a_1 ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a_1 = aha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛ⊢ (∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = (Finset.mapEmbedding uncontractedListEmd) a) ∨
  ∃ a_1 ∈ ↑φsucΛ', (Finset.mapEmbedding uncontractedListEmd) a_1 = (Finset.mapEmbedding uncontractedListEmd) a
    rcases ha' with ha' | ha'neg.mpr.inl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛha':a ∈ ↑φsucΛ⊢ (∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = (Finset.mapEmbedding uncontractedListEmd) a) ∨
  ∃ a_1 ∈ ↑φsucΛ', (Finset.mapEmbedding uncontractedListEmd) a_1 = (Finset.mapEmbedding uncontractedListEmd) aneg.mpr.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛha':∃ a_1 ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ (∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = (Finset.mapEmbedding uncontractedListEmd) a) ∨
  ∃ a_1 ∈ ↑φsucΛ', (Finset.mapEmbedding uncontractedListEmd) a_1 = (Finset.mapEmbedding uncontractedListEmd) a
    ·neg.mpr.inl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛha':a ∈ ↑φsucΛ⊢ (∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = (Finset.mapEmbedding uncontractedListEmd) a) ∨
  ∃ a_1 ∈ ↑φsucΛ', (Finset.mapEmbedding uncontractedListEmd) a_1 = (Finset.mapEmbedding uncontractedListEmd) a leftneg.mpr.inl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛha':a ∈ ↑φsucΛ⊢ ∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = (Finset.mapEmbedding uncontractedListEmd) a
      use aAll goals completed! 🐙
    ·neg.mpr.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsΛ]ᵘᶜ.length)ha:(Finset.mapEmbedding uncontractedListEmd) a ∉ ↑φsΛha':∃ a_1 ∈ ↑((congr ⋯) φsucΛ'), (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ (∃ a_1 ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a_1 = (Finset.mapEmbedding uncontractedListEmd) a) ∨
  ∃ a_1 ∈ ↑φsucΛ', (Finset.mapEmbedding uncontractedListEmd) a_1 = (Finset.mapEmbedding uncontractedListEmd) a obtain ⟨a, ha', rfl⟩ := ha'neg.mpr.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛ⊢ (∃ a_1 ∈ ↑φsucΛ,
    (Finset.mapEmbedding uncontractedListEmd) a_1 =
      (Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a)) ∨
  ∃ a_1 ∈ ↑φsucΛ',
    (Finset.mapEmbedding uncontractedListEmd) a_1 =
      (Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a)
      rightneg.mpr.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛ⊢ ∃ a_1 ∈ ↑φsucΛ',
  (Finset.mapEmbedding uncontractedListEmd) a_1 =
    (Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a)
      let a' := congrLiftInv _ ⟨a, ha'⟩neg.mpr.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛa':↥↑φsucΛ' := congrLiftInv ⋯ ⟨a, ha'⟩⊢ ∃ a_1 ∈ ↑φsucΛ',
  (Finset.mapEmbedding uncontractedListEmd) a_1 =
    (Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a)
      use a'h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛa':↥↑φsucΛ' := congrLiftInv ⋯ ⟨a, ha'⟩⊢ ↑a' ∈ ↑φsucΛ' ∧
  (Finset.mapEmbedding uncontractedListEmd) ↑a' =
    (Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a)
      simp only [Finset.coe_mem, true_and]h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛa':↥↑φsucΛ' := congrLiftInv ⋯ ⟨a, ha'⟩⊢ (Finset.mapEmbedding uncontractedListEmd) ↑a' =
  (Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a)
      simp only [a']h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛa':↥↑φsucΛ' := congrLiftInv ⋯ ⟨a, ha'⟩⊢ (Finset.mapEmbedding uncontractedListEmd) ↑(congrLiftInv ⋯ ⟨a, ha'⟩) =
  (Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a)
      rw [Finset.mapEmbedding_applyh𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛa':↥↑φsucΛ' := congrLiftInv ⋯ ⟨a, ha'⟩⊢ Finset.map uncontractedListEmd ↑(congrLiftInv ⋯ ⟨a, ha'⟩) =
  (Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a)h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛa':↥↑φsucΛ' := congrLiftInv ⋯ ⟨a, ha'⟩⊢ Finset.map uncontractedListEmd ↑(congrLiftInv ⋯ ⟨a, ha'⟩) =
  (Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a)]h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛa':↥↑φsucΛ' := congrLiftInv ⋯ ⟨a, ha'⟩⊢ Finset.map uncontractedListEmd ↑(congrLiftInv ⋯ ⟨a, ha'⟩) =
  (Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a)
      rw [join_uncontractedListEmbh𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛa':↥↑φsucΛ' := congrLiftInv ⋯ ⟨a, ha'⟩⊢ Finset.map (((finCongr ⋯).toEmbedding.trans uncontractedListEmd).trans uncontractedListEmd) ↑(congrLiftInv ⋯ ⟨a, ha'⟩) =
  (Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a)h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛa':↥↑φsucΛ' := congrLiftInv ⋯ ⟨a, ha'⟩⊢ Finset.map (((finCongr ⋯).toEmbedding.trans uncontractedListEmd).trans uncontractedListEmd) ↑(congrLiftInv ⋯ ⟨a, ha'⟩) =
  (Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a)]h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛa':↥↑φsucΛ' := congrLiftInv ⋯ ⟨a, ha'⟩⊢ Finset.map (((finCongr ⋯).toEmbedding.trans uncontractedListEmd).trans uncontractedListEmd) ↑(congrLiftInv ⋯ ⟨a, ha'⟩) =
  (Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a)
      simp only [congrLiftInv, ← Finset.map_map]h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛa':↥↑φsucΛ' := congrLiftInv ⋯ ⟨a, ha'⟩⊢ Finset.map uncontractedListEmd
    (Finset.map uncontractedListEmd (Finset.map (finCongr ⋯).toEmbedding (Finset.map (finCongr ⋯).toEmbedding a))) =
  (Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a)
      congrh.e_s.e_s𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛa':↥↑φsucΛ' := congrLiftInv ⋯ ⟨a, ha'⟩⊢ Finset.map (finCongr ⋯).toEmbedding (Finset.map (finCongr ⋯).toEmbedding a) = a
      rw [Finset.map_maph.e_s.e_s𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛa':↥↑φsucΛ' := congrLiftInv ⋯ ⟨a, ha'⟩⊢ Finset.map ((finCongr ⋯).toEmbedding.trans (finCongr ⋯).toEmbedding) a = ah.e_s.e_s𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛa':↥↑φsucΛ' := congrLiftInv ⋯ ⟨a, ha'⟩⊢ Finset.map ((finCongr ⋯).toEmbedding.trans (finCongr ⋯).toEmbedding) a = a]h.e_s.e_s𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛa':↥↑φsucΛ' := congrLiftInv ⋯ ⟨a, ha'⟩⊢ Finset.map ((finCongr ⋯).toEmbedding.trans (finCongr ⋯).toEmbedding) a = a
      change Finset.map (Equiv.refl _).toEmbedding a = _h.e_s.e_s𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthφsucΛ':WickContraction [φsΛ.join φsucΛ]ᵘᶜ.lengtha:Finset (Fin [φsucΛ]ᵘᶜ.length)ha':a ∈ ↑((congr ⋯) φsucΛ')ha:(Finset.mapEmbedding uncontractedListEmd) ((Finset.mapEmbedding uncontractedListEmd) a) ∉ ↑φsΛa':↥↑φsucΛ' := congrLiftInv ⋯ ⟨a, ha'⟩⊢ Finset.map (Equiv.refl (Fin [φsucΛ]ᵘᶜ.length)).toEmbedding a = a
      simp only [Equiv.refl_toEmbedding, Finset.map_refl]All goals completed! 🐙

lemma join_getDual?_apply_uncontractedListEmb_eq_none_iff {φs : List 𝓕.FieldOp}
    (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) (i : Fin [φsΛ]ᵘᶜ.length) :
    (join φsΛ φsucΛ).getDual? (uncontractedListEmd i) = none
    ↔ φsucΛ.getDual? i = none := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.length⊢ (φsΛ.join φsucΛ).getDual? (uncontractedListEmd i) = none ↔ φsucΛ.getDual? i = none
  rw [getDual?_eq_none_iff_mem_uncontracted,𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.length⊢ uncontractedListEmd i ∈ (φsΛ.join φsucΛ).uncontracted ↔ φsucΛ.getDual? i = none𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.length⊢ uncontractedListEmd i ∈ (φsΛ.join φsucΛ).uncontracted ↔ i ∈ φsucΛ.uncontracted getDual?_eq_none_iff_mem_uncontracted𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.length⊢ uncontractedListEmd i ∈ (φsΛ.join φsucΛ).uncontracted ↔ i ∈ φsucΛ.uncontracted𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.length⊢ uncontractedListEmd i ∈ (φsΛ.join φsucΛ).uncontracted ↔ i ∈ φsucΛ.uncontracted]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.length⊢ uncontractedListEmd i ∈ (φsΛ.join φsucΛ).uncontracted ↔ i ∈ φsucΛ.uncontracted
  apply Iff.intromp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.length⊢ uncontractedListEmd i ∈ (φsΛ.join φsucΛ).uncontracted → i ∈ φsucΛ.uncontractedmpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.length⊢ i ∈ φsucΛ.uncontracted → uncontractedListEmd i ∈ (φsΛ.join φsucΛ).uncontracted
  ·mp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.length⊢ uncontractedListEmd i ∈ (φsΛ.join φsucΛ).uncontracted → i ∈ φsucΛ.uncontracted intro hmp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:uncontractedListEmd i ∈ (φsΛ.join φsucΛ).uncontracted⊢ i ∈ φsucΛ.uncontracted
    obtain ⟨a, ha', ha⟩ := exists_mem_right_uncontracted_of_mem_join_uncontracted _ _
      (uncontractedListEmd i) hmp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:uncontractedListEmd i ∈ (φsΛ.join φsucΛ).uncontracteda:Fin [φsΛ]ᵘᶜ.lengthha':uncontractedListEmd a = uncontractedListEmd iha:a ∈ φsucΛ.uncontracted⊢ i ∈ φsucΛ.uncontracted
    simp only [EmbeddingLike.apply_eq_iff_eq] at ha'mp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:uncontractedListEmd i ∈ (φsΛ.join φsucΛ).uncontracteda:Fin [φsΛ]ᵘᶜ.lengthha:a ∈ φsucΛ.uncontractedha':a = i⊢ i ∈ φsucΛ.uncontracted
    exact ha' ▸ haAll goals completed! 🐙
  ·mpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.length⊢ i ∈ φsucΛ.uncontracted → uncontractedListEmd i ∈ (φsΛ.join φsucΛ).uncontracted intro hmpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:i ∈ φsucΛ.uncontracted⊢ uncontractedListEmd i ∈ (φsΛ.join φsucΛ).uncontracted
    exact mem_join_uncontracted_of_mem_right_uncontracted φsΛ φsucΛ i hAll goals completed! 🐙

lemma join_getDual?_apply_uncontractedListEmb_isSome_iff {φs : List 𝓕.FieldOp}
    (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) (i : Fin [φsΛ]ᵘᶜ.length) :
    ((join φsΛ φsucΛ).getDual? (uncontractedListEmd i)).isSome
    ↔ (φsucΛ.getDual? i).isSome := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.length⊢ ((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true ↔ (φsucΛ.getDual? i).isSome = true
  rw [← Decidable.not_iff_not𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.length⊢ ¬((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true ↔ ¬(φsucΛ.getDual? i).isSome = true𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.length⊢ ¬((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true ↔ ¬(φsucΛ.getDual? i).isSome = true]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.length⊢ ¬((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true ↔ ¬(φsucΛ.getDual? i).isSome = true
  simp [join_getDual?_apply_uncontractedListEmb_eq_none_iff]All goals completed! 🐙

lemma join_getDual?_apply_uncontractedListEmb_some {φs : List 𝓕.FieldOp}
    (φsΛ : WickContraction φs.length)
    (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length) (i : Fin [φsΛ]ᵘᶜ.length)
    (hi :((join φsΛ φsucΛ).getDual? (uncontractedListEmd i)).isSome) :
    ((join φsΛ φsucΛ).getDual? (uncontractedListEmd i)) =
    some (uncontractedListEmd ((φsucΛ.getDual? i).get (by𝓕:FieldSpecificationn:ℕc:WickContraction nφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthhi:((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true⊢ (φsucΛ.getDual? i).isSome = true
    simpa [join_getDual?_apply_uncontractedListEmb_isSome_iff]using hiAll goals completed! 🐙))) := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthhi:((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true⊢ (φsΛ.join φsucΛ).getDual? (uncontractedListEmd i) = some (uncontractedListEmd ((φsucΛ.getDual? i).get ⋯))
  rw [getDual?_eq_some_iff_mem𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthhi:((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true⊢ {uncontractedListEmd i, uncontractedListEmd ((φsucΛ.getDual? i).get ⋯)} ∈ ↑(φsΛ.join φsucΛ)𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthhi:((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true⊢ {uncontractedListEmd i, uncontractedListEmd ((φsucΛ.getDual? i).get ⋯)} ∈ ↑(φsΛ.join φsucΛ)]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthhi:((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true⊢ {uncontractedListEmd i, uncontractedListEmd ((φsucΛ.getDual? i).get ⋯)} ∈ ↑(φsΛ.join φsucΛ)
  simp only [join, Finset.mem_union, Finset.mem_map,
    RelEmbedding.coe_toEmbedding]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthhi:((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true⊢ {uncontractedListEmd i, uncontractedListEmd ((φsucΛ.getDual? i).get ⋯)} ∈ ↑φsΛ ∨
  ∃ a ∈ ↑φsucΛ,
    (Finset.mapEmbedding uncontractedListEmd) a =
      {uncontractedListEmd i, uncontractedListEmd ((φsucΛ.getDual? i).get ⋯)}
  right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthhi:((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true⊢ ∃ a ∈ ↑φsucΛ,
  (Finset.mapEmbedding uncontractedListEmd) a = {uncontractedListEmd i, uncontractedListEmd ((φsucΛ.getDual? i).get ⋯)}
  use {i, (φsucΛ.getDual? i).get (by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthhi:((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true⊢ (φsucΛ.getDual? i).isSome = true
    simpa [join_getDual?_apply_uncontractedListEmb_isSome_iff] using hiAll goals completed! 🐙)}
  simp only [self_getDual?_get_mem, true_and]h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthhi:((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true⊢ (Finset.mapEmbedding uncontractedListEmd) {i, (φsucΛ.getDual? i).get ⋯} =
  {uncontractedListEmd i, uncontractedListEmd ((φsucΛ.getDual? i).get ⋯)}
  rw [Finset.mapEmbedding_applyh𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthhi:((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true⊢ Finset.map uncontractedListEmd {i, (φsucΛ.getDual? i).get ⋯} =
  {uncontractedListEmd i, uncontractedListEmd ((φsucΛ.getDual? i).get ⋯)}h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthhi:((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true⊢ Finset.map uncontractedListEmd {i, (φsucΛ.getDual? i).get ⋯} =
  {uncontractedListEmd i, uncontractedListEmd ((φsucΛ.getDual? i).get ⋯)}]h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthhi:((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true⊢ Finset.map uncontractedListEmd {i, (φsucΛ.getDual? i).get ⋯} =
  {uncontractedListEmd i, uncontractedListEmd ((φsucΛ.getDual? i).get ⋯)}
  simpAll goals completed! 🐙

@[simp]
lemma join_getDual?_apply_uncontractedListEmb {φs : List 𝓕.FieldOp}
    (φsΛ : WickContraction φs.length) (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length)
    (i : Fin [φsΛ]ᵘᶜ.length) : ((join φsΛ φsucΛ).getDual? (uncontractedListEmd i)) =
    Option.map uncontractedListEmd (φsucΛ.getDual? i) := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.length⊢ (φsΛ.join φsucΛ).getDual? (uncontractedListEmd i) = Option.map (⇑uncontractedListEmd) (φsucΛ.getDual? i)
  by_cases h : (φsucΛ.getDual? i).isSomepos𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:(φsucΛ.getDual? i).isSome = true⊢ (φsΛ.join φsucΛ).getDual? (uncontractedListEmd i) = Option.map (⇑uncontractedListEmd) (φsucΛ.getDual? i)neg𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:¬(φsucΛ.getDual? i).isSome = true⊢ (φsΛ.join φsucΛ).getDual? (uncontractedListEmd i) = Option.map (⇑uncontractedListEmd) (φsucΛ.getDual? i)
  ·pos𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:(φsucΛ.getDual? i).isSome = true⊢ (φsΛ.join φsucΛ).getDual? (uncontractedListEmd i) = Option.map (⇑uncontractedListEmd) (φsucΛ.getDual? i) rw [join_getDual?_apply_uncontractedListEmb_somepos𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:(φsucΛ.getDual? i).isSome = true⊢ some (uncontractedListEmd ((φsucΛ.getDual? i).get ⋯)) = Option.map (⇑uncontractedListEmd) (φsucΛ.getDual? i)pos.hi𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:(φsucΛ.getDual? i).isSome = true⊢ ((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = truepos𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:(φsucΛ.getDual? i).isSome = true⊢ some (uncontractedListEmd ((φsucΛ.getDual? i).get ⋯)) = Option.map (⇑uncontractedListEmd) (φsucΛ.getDual? i)pos.hi𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:(φsucΛ.getDual? i).isSome = true⊢ ((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true]pos𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:(φsucΛ.getDual? i).isSome = true⊢ some (uncontractedListEmd ((φsucΛ.getDual? i).get ⋯)) = Option.map (⇑uncontractedListEmd) (φsucΛ.getDual? i)pos.hi𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:(φsucΛ.getDual? i).isSome = true⊢ ((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true
    conv_rhs => rw [← Option.some_get h]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:(φsucΛ.getDual? i).isSome = true| Option.map (⇑uncontractedListEmd) (some ((φsucΛ.getDual? i).get h))
    simp only [Option.map_some]pos.hi𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:(φsucΛ.getDual? i).isSome = true⊢ ((φsΛ.join φsucΛ).getDual? (uncontractedListEmd i)).isSome = true
    exact (join_getDual?_apply_uncontractedListEmb_isSome_iff φsΛ φsucΛ i).mpr hAll goals completed! 🐙
  ·neg𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:¬(φsucΛ.getDual? i).isSome = true⊢ (φsΛ.join φsucΛ).getDual? (uncontractedListEmd i) = Option.map (⇑uncontractedListEmd) (φsucΛ.getDual? i) simp only [Bool.not_eq_true, Option.isSome_eq_false_iff, Option.isNone_iff_eq_none] at hneg𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthi:Fin [φsΛ]ᵘᶜ.lengthh:φsucΛ.getDual? i = none⊢ (φsΛ.join φsucΛ).getDual? (uncontractedListEmd i) = Option.map (⇑uncontractedListEmd) (φsucΛ.getDual? i)
    simp [h, join_getDual?_apply_uncontractedListEmb_eq_none_iff]All goals completed! 🐙

Subcontractions and quotient contractions

              lemma join_sub_quot (S : Finset (Finset (Fin φs.length))) (ha : S ⊆ φsΛ.1) :
    join (subContraction S ha) (quotContraction S ha) = φsΛ := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛ⊢ (subContraction S ha).join (quotContraction S ha) = φsΛ
  apply Subtype.ext𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛ⊢ ↑((subContraction S ha).join (quotContraction S ha)) = ↑φsΛ
  ext a𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)⊢ a ∈ ↑((subContraction S ha).join (quotContraction S ha)) ↔ a ∈ ↑φsΛ
  simp only [join, Finset.mem_union, Finset.mem_map,
    RelEmbedding.coe_toEmbedding]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)⊢ (a ∈ ↑(subContraction S ha) ∨ ∃ a_1 ∈ ↑(quotContraction S ha), (Finset.mapEmbedding uncontractedListEmd) a_1 = a) ↔
  a ∈ ↑φsΛ
  apply Iff.intromp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)⊢ (a ∈ ↑(subContraction S ha) ∨ ∃ a_1 ∈ ↑(quotContraction S ha), (Finset.mapEmbedding uncontractedListEmd) a_1 = a) →
  a ∈ ↑φsΛmpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)⊢ a ∈ ↑φsΛ →
  a ∈ ↑(subContraction S ha) ∨ ∃ a_2 ∈ ↑(quotContraction S ha), (Finset.mapEmbedding uncontractedListEmd) a_2 = a
  ·mp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)⊢ (a ∈ ↑(subContraction S ha) ∨ ∃ a_1 ∈ ↑(quotContraction S ha), (Finset.mapEmbedding uncontractedListEmd) a_1 = a) →
  a ∈ ↑φsΛ intro hmp𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)h:a ∈ ↑(subContraction S ha) ∨ ∃ a_1 ∈ ↑(quotContraction S ha), (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ a ∈ ↑φsΛ
    rcases h with h | hmp.inl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)h:a ∈ ↑(subContraction S ha)⊢ a ∈ ↑φsΛmp.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)h:∃ a_1 ∈ ↑(quotContraction S ha), (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ a ∈ ↑φsΛ
    ·mp.inl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)h:a ∈ ↑(subContraction S ha)⊢ a ∈ ↑φsΛ exact mem_of_mem_subContraction hAll goals completed! 🐙
    ·mp.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)h:∃ a_1 ∈ ↑(quotContraction S ha), (Finset.mapEmbedding uncontractedListEmd) a_1 = a⊢ a ∈ ↑φsΛ obtain ⟨a, ha, rfl⟩ := hmp.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha✝:S ⊆ ↑φsΛa:Finset (Fin [subContraction S ha✝]ᵘᶜ.length)ha:a ∈ ↑(quotContraction S ha✝)⊢ (Finset.mapEmbedding uncontractedListEmd) a ∈ ↑φsΛ
      apply mem_of_mem_quotContraction haAll goals completed! 🐙
  ·mpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)⊢ a ∈ ↑φsΛ →
  a ∈ ↑(subContraction S ha) ∨ ∃ a_2 ∈ ↑(quotContraction S ha), (Finset.mapEmbedding uncontractedListEmd) a_2 = a intro hmpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)h:a ∈ ↑φsΛ⊢ a ∈ ↑(subContraction S ha) ∨ ∃ a_1 ∈ ↑(quotContraction S ha), (Finset.mapEmbedding uncontractedListEmd) a_1 = a
    have h1 := mem_subContraction_or_quotContraction (S := S) (a := a) (hs := ha) hmpr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)h:a ∈ ↑φsΛh1:a ∈ ↑(subContraction S ha) ∨ ∃ a', Finset.map uncontractedListEmd a' = a ∧ a' ∈ ↑(quotContraction S ha)⊢ a ∈ ↑(subContraction S ha) ∨ ∃ a_1 ∈ ↑(quotContraction S ha), (Finset.mapEmbedding uncontractedListEmd) a_1 = a
    rcases h1 with h1 | h1mpr.inl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)h:a ∈ ↑φsΛh1:a ∈ ↑(subContraction S ha)⊢ a ∈ ↑(subContraction S ha) ∨ ∃ a_1 ∈ ↑(quotContraction S ha), (Finset.mapEmbedding uncontractedListEmd) a_1 = ampr.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)h:a ∈ ↑φsΛh1:∃ a', Finset.map uncontractedListEmd a' = a ∧ a' ∈ ↑(quotContraction S ha)⊢ a ∈ ↑(subContraction S ha) ∨ ∃ a_1 ∈ ↑(quotContraction S ha), (Finset.mapEmbedding uncontractedListEmd) a_1 = a
    ·mpr.inl𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)h:a ∈ ↑φsΛh1:a ∈ ↑(subContraction S ha)⊢ a ∈ ↑(subContraction S ha) ∨ ∃ a_1 ∈ ↑(quotContraction S ha), (Finset.mapEmbedding uncontractedListEmd) a_1 = a simp [h1]All goals completed! 🐙
    ·mpr.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)h:a ∈ ↑φsΛh1:∃ a', Finset.map uncontractedListEmd a' = a ∧ a' ∈ ↑(quotContraction S ha)⊢ a ∈ ↑(subContraction S ha) ∨ ∃ a_1 ∈ ↑(quotContraction S ha), (Finset.mapEmbedding uncontractedListEmd) a_1 = a rightmpr.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛa:Finset (Fin φs.length)h:a ∈ ↑φsΛh1:∃ a', Finset.map uncontractedListEmd a' = a ∧ a' ∈ ↑(quotContraction S ha)⊢ ∃ a_1 ∈ ↑(quotContraction S ha), (Finset.mapEmbedding uncontractedListEmd) a_1 = a
      obtain ⟨a, rfl, ha⟩ := h1mpr.inr𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha✝:S ⊆ ↑φsΛa:Finset (Fin [subContraction S ha✝]ᵘᶜ.length)ha:a ∈ ↑(quotContraction S ha✝)h:Finset.map uncontractedListEmd a ∈ ↑φsΛ⊢ ∃ a_1 ∈ ↑(quotContraction S ha✝), (Finset.mapEmbedding uncontractedListEmd) a_1 = Finset.map uncontractedListEmd a
      exact ⟨a, ha, Finset.mapEmbedding_apply⟩All goals completed! 🐙

lemma subContraction_card_plus_quotContraction_card_eq (S : Finset (Finset (Fin φs.length)))
    (ha : S ⊆ φsΛ.1) :
    (subContraction S ha).1.card + (quotContraction S ha).1.card = φsΛ.1.card := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛ⊢ (↑(subContraction S ha)).card + (↑(quotContraction S ha)).card = (↑φsΛ).card
  rw [← join_card𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛ⊢ (↑((subContraction S ha).join (quotContraction S ha))).card = (↑φsΛ).card𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛ⊢ (↑((subContraction S ha).join (quotContraction S ha))).card = (↑φsΛ).card]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthS:Finset (Finset (Fin φs.length))ha:S ⊆ ↑φsΛ⊢ (↑((subContraction S ha).join (quotContraction S ha))).card = (↑φsΛ).card
  simp [join_sub_quot]All goals completed! 🐙

@[simp]
lemma join_singleton_getDual?_left {φs : List 𝓕.FieldOp}
    {i j : Fin φs.length} (h : i < j)
    (φsucΛ : WickContraction [singleton h]ᵘᶜ.length) :
    (join (singleton h) φsucΛ).getDual? i = some j := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpi:Fin φs.lengthj:Fin φs.lengthh:i < jφsucΛ:WickContraction [singleton h]ᵘᶜ.length⊢ ((singleton h).join φsucΛ).getDual? i = some j
  rw [@getDual?_eq_some_iff_mem𝓕:FieldSpecificationφs:List 𝓕.FieldOpi:Fin φs.lengthj:Fin φs.lengthh:i < jφsucΛ:WickContraction [singleton h]ᵘᶜ.length⊢ {i, j} ∈ ↑((singleton h).join φsucΛ)𝓕:FieldSpecificationφs:List 𝓕.FieldOpi:Fin φs.lengthj:Fin φs.lengthh:i < jφsucΛ:WickContraction [singleton h]ᵘᶜ.length⊢ {i, j} ∈ ↑((singleton h).join φsucΛ)]𝓕:FieldSpecificationφs:List 𝓕.FieldOpi:Fin φs.lengthj:Fin φs.lengthh:i < jφsucΛ:WickContraction [singleton h]ᵘᶜ.length⊢ {i, j} ∈ ↑((singleton h).join φsucΛ)
  simp [singleton, join]All goals completed! 🐙

@[simp]
lemma join_singleton_getDual?_right {φs : List 𝓕.FieldOp}
    {i j : Fin φs.length} (h : i < j)
    (φsucΛ : WickContraction [singleton h]ᵘᶜ.length) :
    (join (singleton h) φsucΛ).getDual? j = some i := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpi:Fin φs.lengthj:Fin φs.lengthh:i < jφsucΛ:WickContraction [singleton h]ᵘᶜ.length⊢ ((singleton h).join φsucΛ).getDual? j = some i
  rw [@getDual?_eq_some_iff_mem𝓕:FieldSpecificationφs:List 𝓕.FieldOpi:Fin φs.lengthj:Fin φs.lengthh:i < jφsucΛ:WickContraction [singleton h]ᵘᶜ.length⊢ {j, i} ∈ ↑((singleton h).join φsucΛ)𝓕:FieldSpecificationφs:List 𝓕.FieldOpi:Fin φs.lengthj:Fin φs.lengthh:i < jφsucΛ:WickContraction [singleton h]ᵘᶜ.length⊢ {j, i} ∈ ↑((singleton h).join φsucΛ)]𝓕:FieldSpecificationφs:List 𝓕.FieldOpi:Fin φs.lengthj:Fin φs.lengthh:i < jφsucΛ:WickContraction [singleton h]ᵘᶜ.length⊢ {j, i} ∈ ↑((singleton h).join φsucΛ)
  simp only [join, singleton, Finset.mem_union, Finset.mem_singleton,
    Finset.mem_map, RelEmbedding.coe_toEmbedding]𝓕:FieldSpecificationφs:List 𝓕.FieldOpi:Fin φs.lengthj:Fin φs.lengthh:i < jφsucΛ:WickContraction [singleton h]ᵘᶜ.length⊢ {j, i} = {i, j} ∨ ∃ a ∈ ↑φsucΛ, (Finset.mapEmbedding uncontractedListEmd) a = {j, i}
  left𝓕:FieldSpecificationφs:List 𝓕.FieldOpi:Fin φs.lengthj:Fin φs.lengthh:i < jφsucΛ:WickContraction [singleton h]ᵘᶜ.length⊢ {j, i} = {i, j}
  exact Finset.pair_comm j iAll goals completed! 🐙lemma exists_contraction_pair_of_card_ge_zero {φs : List 𝓕.FieldOp}
    (φsΛ : WickContraction φs.length) (h : 0 < φsΛ.1.card) :
    ∃ a, a ∈ φsΛ.1 :=
  Finset.card_pos.mp h

set_option backward.isDefEq.respectTransparency false in
set_option maxHeartbeats 400000 in
lemma exists_join_singleton_of_card_ge_zero {φs : List 𝓕.FieldOp} (φsΛ : WickContraction φs.length)
    (h : 0 < φsΛ.1.card) (hc : φsΛ.GradingCompliant) :
    ∃ (i j : Fin φs.length) (h : i < j) (φsucΛ : WickContraction [singleton h]ᵘᶜ.length),
    φsΛ = join (singleton h) φsucΛ ∧ (𝓕 |>ₛ φs[i]) = (𝓕 |>ₛ φs[j])
    ∧ φsucΛ.GradingCompliant ∧ φsucΛ.1.card + 1 = φsΛ.1.card := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛ⊢ ∃ i j,
  ∃ (h : i < j),
    ∃ φsucΛ,
      φsΛ = (singleton h).join φsucΛ ∧
        ((𝓕|>ₛφs[i]) = 𝓕|>ₛφs[j]) ∧ GradingCompliant [singleton h]ᵘᶜ φsucΛ ∧ (↑φsucΛ).card + 1 = (↑φsΛ).card
  obtain ⟨a, ha⟩ := exists_contraction_pair_of_card_ge_zero φsΛ h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛ⊢ ∃ i j,
  ∃ (h : i < j),
    ∃ φsucΛ,
      φsΛ = (singleton h).join φsucΛ ∧
        ((𝓕|>ₛφs[i]) = 𝓕|>ₛφs[j]) ∧ GradingCompliant [singleton h]ᵘᶜ φsucΛ ∧ (↑φsucΛ).card + 1 = (↑φsΛ).card
  use φsΛ.fstFieldOfContract ⟨a, ha⟩h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛ⊢ ∃ j,
  ∃ (h : φsΛ.fstFieldOfContract ⟨a, ha⟩ < j),
    ∃ φsucΛ,
      φsΛ = (singleton h).join φsucΛ ∧
        ((𝓕|>ₛφs[φsΛ.fstFieldOfContract ⟨a, ha⟩]) = 𝓕|>ₛφs[j]) ∧
          GradingCompliant [singleton h]ᵘᶜ φsucΛ ∧ (↑φsucΛ).card + 1 = (↑φsΛ).card
  use φsΛ.sndFieldOfContract ⟨a, ha⟩h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛ⊢ ∃ (h : φsΛ.fstFieldOfContract ⟨a, ha⟩ < φsΛ.sndFieldOfContract ⟨a, ha⟩),
  ∃ φsucΛ,
    φsΛ = (singleton h).join φsucΛ ∧
      ((𝓕|>ₛφs[φsΛ.fstFieldOfContract ⟨a, ha⟩]) = 𝓕|>ₛφs[φsΛ.sndFieldOfContract ⟨a, ha⟩]) ∧
        GradingCompliant [singleton h]ᵘᶜ φsucΛ ∧ (↑φsucΛ).card + 1 = (↑φsΛ).card
  use φsΛ.fstFieldOfContract_lt_sndFieldOfContract ⟨a, ha⟩h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛ⊢ ∃ φsucΛ,
  φsΛ = (singleton ⋯).join φsucΛ ∧
    ((𝓕|>ₛφs[φsΛ.fstFieldOfContract ⟨a, ha⟩]) = 𝓕|>ₛφs[φsΛ.sndFieldOfContract ⟨a, ha⟩]) ∧
      GradingCompliant [singleton ⋯]ᵘᶜ φsucΛ ∧ (↑φsucΛ).card + 1 = (↑φsΛ).card
  let φsucΛ :
    WickContraction [singleton (φsΛ.fstFieldOfContract_lt_sndFieldOfContract ⟨a, ha⟩)]ᵘᶜ.length :=
    congr (by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛ⊢ [subContraction {a} ?m.139]ᵘᶜ.length = [singleton ⋯]ᵘᶜ.lengthh𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ ∃ φsucΛ,
  φsΛ = (singleton ⋯).join φsucΛ ∧
    ((𝓕|>ₛφs[φsΛ.fstFieldOfContract ⟨a, ha⟩]) = 𝓕|>ₛφs[φsΛ.sndFieldOfContract ⟨a, ha⟩]) ∧
      GradingCompliant [singleton ⋯]ᵘᶜ φsucΛ ∧ (↑φsucΛ).card + 1 = (↑φsΛ).card simp [← subContraction_singleton_eq_singleton]All goals completed! 🐙h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ ∃ φsucΛ,
  φsΛ = (singleton ⋯).join φsucΛ ∧
    ((𝓕|>ₛφs[φsΛ.fstFieldOfContract ⟨a, ha⟩]) = 𝓕|>ₛφs[φsΛ.sndFieldOfContract ⟨a, ha⟩]) ∧
      GradingCompliant [singleton ⋯]ᵘᶜ φsucΛ ∧ (↑φsucΛ).card + 1 = (↑φsΛ).card)
    (φsΛ.quotContraction {a} (by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛ⊢ {a} ⊆ ↑φsΛh𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ ∃ φsucΛ,
  φsΛ = (singleton ⋯).join φsucΛ ∧
    ((𝓕|>ₛφs[φsΛ.fstFieldOfContract ⟨a, ha⟩]) = 𝓕|>ₛφs[φsΛ.sndFieldOfContract ⟨a, ha⟩]) ∧
      GradingCompliant [singleton ⋯]ᵘᶜ φsucΛ ∧ (↑φsucΛ).card + 1 = (↑φsΛ).card simpa using haAll goals completed! 🐙h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ ∃ φsucΛ,
  φsΛ = (singleton ⋯).join φsucΛ ∧
    ((𝓕|>ₛφs[φsΛ.fstFieldOfContract ⟨a, ha⟩]) = 𝓕|>ₛφs[φsΛ.sndFieldOfContract ⟨a, ha⟩]) ∧
      GradingCompliant [singleton ⋯]ᵘᶜ φsucΛ ∧ (↑φsucΛ).card + 1 = (↑φsΛ).card))h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ ∃ φsucΛ,
  φsΛ = (singleton ⋯).join φsucΛ ∧
    ((𝓕|>ₛφs[φsΛ.fstFieldOfContract ⟨a, ha⟩]) = 𝓕|>ₛφs[φsΛ.sndFieldOfContract ⟨a, ha⟩]) ∧
      GradingCompliant [singleton ⋯]ᵘᶜ φsucΛ ∧ (↑φsucΛ).card + 1 = (↑φsΛ).card
  use φsucΛh𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ φsΛ = (singleton ⋯).join φsucΛ ∧
  ((𝓕|>ₛφs[φsΛ.fstFieldOfContract ⟨a, ha⟩]) = 𝓕|>ₛφs[φsΛ.sndFieldOfContract ⟨a, ha⟩]) ∧
    GradingCompliant [singleton ⋯]ᵘᶜ φsucΛ ∧ (↑φsucΛ).card + 1 = (↑φsΛ).card
  simp only [Fin.getElem_fin]h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ φsΛ = (singleton ⋯).join φsucΛ ∧
  ((𝓕|>ₛφs[↑(φsΛ.fstFieldOfContract ⟨a, ha⟩)]) = 𝓕|>ₛφs[↑(φsΛ.sndFieldOfContract ⟨a, ha⟩)]) ∧
    GradingCompliant [singleton ⋯]ᵘᶜ φsucΛ ∧ (↑φsucΛ).card + 1 = (↑φsΛ).card
  apply And.introh.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ φsΛ = (singleton ⋯).join φsucΛh.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ ((𝓕|>ₛφs[↑(φsΛ.fstFieldOfContract ⟨a, ha⟩)]) = 𝓕|>ₛφs[↑(φsΛ.sndFieldOfContract ⟨a, ha⟩)]) ∧
  GradingCompliant [singleton ⋯]ᵘᶜ φsucΛ ∧ (↑φsucΛ).card + 1 = (↑φsΛ).card
  ·h.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ φsΛ = (singleton ⋯).join φsucΛ have h1 := join_congr (subContraction_singleton_eq_singleton _ ⟨a, ha⟩).symm (φsucΛ := φsucΛ)h.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)h1:(singleton ⋯).join φsucΛ = (subContraction {↑⟨a, ha⟩} ⋯).join ((congr ⋯) φsucΛ)⊢ φsΛ = (singleton ⋯).join φsucΛ
    simp only [h1, congr_trans_apply, congr_refl, φsucΛ]h.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)h1:(singleton ⋯).join φsucΛ = (subContraction {↑⟨a, ha⟩} ⋯).join ((congr ⋯) φsucΛ)⊢ φsΛ = (subContraction {a} ⋯).join (quotContraction {a} ⋯)
    rw [join_sub_quoth.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)h1:(singleton ⋯).join φsucΛ = (subContraction {↑⟨a, ha⟩} ⋯).join ((congr ⋯) φsucΛ)⊢ φsΛ = φsΛAll goals completed! 🐙]All goals completed! 🐙
  ·h.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ ((𝓕|>ₛφs[↑(φsΛ.fstFieldOfContract ⟨a, ha⟩)]) = 𝓕|>ₛφs[↑(φsΛ.sndFieldOfContract ⟨a, ha⟩)]) ∧
  GradingCompliant [singleton ⋯]ᵘᶜ φsucΛ ∧ (↑φsucΛ).card + 1 = (↑φsΛ).card apply And.intro (hc ⟨a, ha⟩)h.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ GradingCompliant [singleton ⋯]ᵘᶜ φsucΛ ∧ (↑φsucΛ).card + 1 = (↑φsΛ).card
    apply And.introh.right.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ GradingCompliant [singleton ⋯]ᵘᶜ φsucΛh.right.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ (↑φsucΛ).card + 1 = (↑φsΛ).card
    ·h.right.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ GradingCompliant [singleton ⋯]ᵘᶜ φsucΛ simp only [φsucΛ]h.right.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ GradingCompliant [singleton ⋯]ᵘᶜ ((congr ⋯) (quotContraction {a} ⋯))
      rw [gradingCompliant_congr (φs' := [(φsΛ.subContraction {a} (by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ {a} ⊆ ↑φsΛh.right.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ GradingCompliant [subContraction {a} ⋯]ᵘᶜ ((congr ⋯) ((congr ⋯) (quotContraction {a} ⋯)))h.right.left.h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ [singleton ⋯]ᵘᶜ = [subContraction {a} ⋯]ᵘᶜ simpa using haAll goals completed! 🐙h.right.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ GradingCompliant [subContraction {a} ⋯]ᵘᶜ ((congr ⋯) ((congr ⋯) (quotContraction {a} ⋯)))h.right.left.h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ [singleton ⋯]ᵘᶜ = [subContraction {a} ⋯]ᵘᶜ))]ᵘᶜ)]h.right.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ GradingCompliant [subContraction {a} ⋯]ᵘᶜ ((congr ⋯) ((congr ⋯) (quotContraction {a} ⋯)))h.right.left.h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ [singleton ⋯]ᵘᶜ = [subContraction {a} ⋯]ᵘᶜ
      simp only [congr_trans_apply, congr_refl]h.right.left𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ GradingCompliant [subContraction {a} ⋯]ᵘᶜ (quotContraction {a} ⋯)h.right.left.h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ [singleton ⋯]ᵘᶜ = [subContraction {a} ⋯]ᵘᶜ
      exact quotContraction_gradingCompliant hch.right.left.h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ [singleton ⋯]ᵘᶜ = [subContraction {a} ⋯]ᵘᶜ
      rw [← subContraction_singleton_eq_singletonh.right.left.h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ [subContraction {↑⟨a, ha⟩} ⋯]ᵘᶜ = [subContraction {a} ⋯]ᵘᶜAll goals completed! 🐙]All goals completed! 🐙
    ·h.right.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ (↑φsucΛ).card + 1 = (↑φsΛ).card simp only [card_congr, φsucΛ]h.right.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ (↑(quotContraction {a} ⋯)).card + 1 = (↑φsΛ).card
      have h1 := subContraction_card_plus_quotContraction_card_eq _ {a} (by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)⊢ {a} ⊆ ↑?m.225h.right.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)h1:(↑(subContraction {a} ⋯)).card + (↑(quotContraction {a} ⋯)).card = (↑φsΛ).card⊢ (↑(quotContraction {a} ⋯)).card + 1 = (↑φsΛ).card simpa using haAll goals completed! 🐙h.right.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)h1:(↑(subContraction {a} ⋯)).card + (↑(quotContraction {a} ⋯)).card = (↑φsΛ).card⊢ (↑(quotContraction {a} ⋯)).card + 1 = (↑φsΛ).card)h.right.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)h1:(↑(subContraction {a} ⋯)).card + (↑(quotContraction {a} ⋯)).card = (↑φsΛ).card⊢ (↑(quotContraction {a} ⋯)).card + 1 = (↑φsΛ).card
      simp only [subContraction, Finset.card_singleton] at h1h.right.right𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthh:0 < (↑φsΛ).cardhc:GradingCompliant φs φsΛa:Finset (Fin φs.length)ha:a ∈ ↑φsΛφsucΛ:WickContraction [singleton ⋯]ᵘᶜ.length := (congr ⋯) (quotContraction {a} ⋯)h1:1 + (↑(quotContraction {a} ⋯)).card = (↑φsΛ).card⊢ (↑(quotContraction {a} ⋯)).card + 1 = (↑φsΛ).card
      omegaAll goals completed! 🐙lemma join_not_gradingCompliant_of_left_not_gradingCompliant {φs : List 𝓕.FieldOp}
    (φsΛ : WickContraction φs.length) (φsucΛ : WickContraction [φsΛ]ᵘᶜ.length)
    (hc : ¬ φsΛ.GradingCompliant) : ¬ (join φsΛ φsucΛ).GradingCompliant := by𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthhc:¬GradingCompliant φs φsΛ⊢ ¬GradingCompliant φs (φsΛ.join φsucΛ)
  simp_all only [GradingCompliant, Subtype.forall, not_forall]𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengthhc:∃ x, ∃ (x_1 : x ∈ ↑φsΛ), ¬(𝓕|>ₛφs[↑(φsΛ.fstFieldOfContract ⟨x, x_1⟩)]) = 𝓕|>ₛφs[↑(φsΛ.sndFieldOfContract ⟨x, x_1⟩)]⊢ ∃ x,
  ∃ (x_1 : x ∈ ↑(φsΛ.join φsucΛ)),
    ¬(𝓕|>ₛφs[↑((φsΛ.join φsucΛ).fstFieldOfContract ⟨x, x_1⟩)]) = 𝓕|>ₛφs[↑((φsΛ.join φsucΛ).sndFieldOfContract ⟨x, x_1⟩)]
  obtain ⟨a, ha, ha2⟩ := hc𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛha2:¬(𝓕|>ₛφs[↑(φsΛ.fstFieldOfContract ⟨a, ha⟩)]) = 𝓕|>ₛφs[↑(φsΛ.sndFieldOfContract ⟨a, ha⟩)]⊢ ∃ x,
  ∃ (x_1 : x ∈ ↑(φsΛ.join φsucΛ)),
    ¬(𝓕|>ₛφs[↑((φsΛ.join φsucΛ).fstFieldOfContract ⟨x, x_1⟩)]) = 𝓕|>ₛφs[↑((φsΛ.join φsucΛ).sndFieldOfContract ⟨x, x_1⟩)]
  use (joinLiftLeft (φsucΛ := φsucΛ) ⟨a, ha⟩).1h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛha2:¬(𝓕|>ₛφs[↑(φsΛ.fstFieldOfContract ⟨a, ha⟩)]) = 𝓕|>ₛφs[↑(φsΛ.sndFieldOfContract ⟨a, ha⟩)]⊢ ∃ (x : ↑(joinLiftLeft ⟨a, ha⟩) ∈ ↑(φsΛ.join φsucΛ)),
  ¬(𝓕|>ₛφs[↑((φsΛ.join φsucΛ).fstFieldOfContract ⟨↑(joinLiftLeft ⟨a, ha⟩), x⟩)]) =
      𝓕|>ₛφs[↑((φsΛ.join φsucΛ).sndFieldOfContract ⟨↑(joinLiftLeft ⟨a, ha⟩), x⟩)]
  use (joinLiftLeft (φsucΛ := φsucΛ) ⟨a, ha⟩).2h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛha2:¬(𝓕|>ₛφs[↑(φsΛ.fstFieldOfContract ⟨a, ha⟩)]) = 𝓕|>ₛφs[↑(φsΛ.sndFieldOfContract ⟨a, ha⟩)]⊢ ¬(𝓕|>ₛφs[↑((φsΛ.join φsucΛ).fstFieldOfContract ⟨↑(joinLiftLeft ⟨a, ha⟩), ⋯⟩)]) =
    𝓕|>ₛφs[↑((φsΛ.join φsucΛ).sndFieldOfContract ⟨↑(joinLiftLeft ⟨a, ha⟩), ⋯⟩)]
  simp only [Subtype.coe_eta, join_fstFieldOfContract_joinLiftLeft,
    join_sndFieldOfContract_joinLift]h𝓕:FieldSpecificationφs:List 𝓕.FieldOpφsΛ:WickContraction φs.lengthφsucΛ:WickContraction [φsΛ]ᵘᶜ.lengtha:Finset (Fin φs.length)ha:a ∈ ↑φsΛha2:¬(𝓕|>ₛφs[↑(φsΛ.fstFieldOfContract ⟨a, ha⟩)]) = 𝓕|>ₛφs[↑(φsΛ.sndFieldOfContract ⟨a, ha⟩)]⊢ ¬(𝓕|>ₛφs[↑(φsΛ.fstFieldOfContract ⟨a, ha⟩)]) = 𝓕|>ₛφs[↑(φsΛ.sndFieldOfContract ⟨a, ha⟩)]
  exact ha2All goals completed! 🐙