/-
Copyright (c) 2020 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn
-/
import data.equiv.encodable.basic
import order.atoms

/-!
# Order ideals, cofinal sets, and the Rasiowa–Sikorski lemma

## Main definitions

Throughout this file, `P` is at least a preorder, but some sections require more
structure, such as a bottom element, a top element, or a join-semilattice structure.
- `order.ideal P`: the type of nonempty, upward directed, and downward closed subsets of `P`.
  Dual to the notion of a filter on a preorder.
- `order.is_ideal P`: a predicate for when a `set P` is an ideal.
- `order.ideal.principal p`: the principal ideal generated by `p : P`.
- `order.ideal.is_proper P`: a predicate for proper ideals.
  Dual to the notion of a proper filter.
- `order.ideal.is_maximal`: a predicate for maximal ideals.
  Dual to the notion of an ultrafilter.
- `ideal_Inter_nonempty P`: a predicate for when the intersection of all ideals of
  `P` is nonempty.
- `order.cofinal P`: the type of subsets of `P` containing arbitrarily large elements.
  Dual to the notion of 'dense set' used in forcing.
- `order.ideal_of_cofinals p 𝒟`, where `p : P`, and `𝒟` is a countable family of cofinal
  subsets of P: an ideal in `P` which contains `p` and intersects every set in `𝒟`. (This a form
  of the Rasiowa–Sikorski lemma.)

## References

- <https://en.wikipedia.org/wiki/Ideal_(order_theory)>
- <https://en.wikipedia.org/wiki/Cofinal_(mathematics)>
- <https://en.wikipedia.org/wiki/Rasiowa%E2%80%93Sikorski_lemma>

Note that for the Rasiowa–Sikorski lemma, Wikipedia uses the opposite ordering on `P`,
in line with most presentations of forcing.

## TODO

`order.ideal.ideal_Inter_nonempty` is a complicated way to say that `P` has a bottom element. It
should be replaced by this clearer condition, which could be called strong directedness and which
is a Prop version of `order_bot`.

## Tags

ideal, cofinal, dense, countable, generic

-/

open function

namespace order

variables {P : Type*}

/-- An ideal on an order `P` is a subset of `P` that is
  - nonempty
  - upward directed (any pair of elements in the ideal has an upper bound in the ideal)
  - downward closed (any element less than an element of the ideal is in the ideal). -/
structure ideal (P) [has_le P] :=
(carrier   : set P)
(nonempty  : carrier.nonempty)
(directed  : directed_on (≤) carrier)
(mem_of_le : ∀ {x y : P}, x ≤ y → y ∈ carrier → x ∈ carrier)

/-- A subset of a preorder `P` is an ideal if it is
  - nonempty
  - upward directed (any pair of elements in the ideal has an upper bound in the ideal)
  - downward closed (any element less than an element of the ideal is in the ideal). -/
@[mk_iff] structure is_ideal {P} [has_le P] (I : set P) : Prop :=
(nonempty : I.nonempty)
(directed : directed_on (≤) I)
(mem_of_le : ∀ {x y : P}, x ≤ y → y ∈ I → x ∈ I)

attribute [protected] ideal.nonempty ideal.directed is_ideal.nonempty is_ideal.directed

/-- Create an element of type `order.ideal` from a set satisfying the predicate
`order.is_ideal`. -/
def is_ideal.to_ideal [has_le P] {I : set P} (h : is_ideal I) : ideal P :=
⟨I, h.1, h.2, h.3⟩

namespace ideal
section has_le
variables [has_le P] {I J : ideal P} {x y : P}

/-- An ideal of `P` can be viewed as a subset of `P`. -/
instance : has_coe (ideal P) (set P) := ⟨carrier⟩

/-- For the notation `x ∈ I`. -/
instance : has_mem P (ideal P) := ⟨λ x I, x ∈ (I : set P)⟩

@[simp] lemma mem_coe : x ∈ (I : set P) ↔ x ∈ I := iff_of_eq rfl

/-- Two ideals are equal when their underlying sets are equal. -/
@[ext] lemma ext : ∀ {I J : ideal P}, (I : set P) = J → I = J
| ⟨_, _, _, _⟩ ⟨_, _, _, _⟩ rfl := rfl

lemma coe_injective : injective (coe : ideal P → set P) := λ _ _, ext

@[simp, norm_cast] lemma coe_inj : (I : set P) = J ↔ I = J := ⟨by ext, congr_arg _⟩

lemma ext_iff : I = J ↔ (I : set P) = J := coe_inj.symm

protected lemma is_ideal (I : ideal P) : is_ideal (I : set P) := ⟨I.2, I.3, I.4⟩

/-- The partial ordering by subset inclusion, inherited from `set P`. -/
instance : partial_order (ideal P) := partial_order.lift coe coe_injective

@[trans] lemma mem_of_mem_of_le : x ∈ I → I ≤ J → x ∈ J :=
@set.mem_of_mem_of_subset P x I J

/-- A proper ideal is one that is not the whole set.
    Note that the whole set might not be an ideal. -/
@[mk_iff] class is_proper (I : ideal P) : Prop := (ne_univ : (I : set P) ≠ set.univ)

lemma is_proper_of_not_mem {I : ideal P} {p : P} (nmem : p ∉ I) : is_proper I :=
⟨λ hp, begin
  change p ∉ ↑I at nmem,
  rw hp at nmem,
  exact nmem (set.mem_univ p),
end⟩

/-- An ideal is maximal if it is maximal in the collection of proper ideals.

Note that `is_coatom` is less general because ideals only have a top element when `P` is directed
and nonempty. -/
@[mk_iff] class is_maximal (I : ideal P) extends is_proper I : Prop :=
(maximal_proper : ∀ ⦃J : ideal P⦄, I < J → (J : set P) = set.univ)

variable (P)

/-- An order `P` has the `ideal_Inter_nonempty` property if the intersection of all ideals is
nonempty. Most importantly, the ideals of a `semilattice_sup` with this property form a complete
lattice.

TODO: This is equivalent to the existence of a bottom element and shouldn't be specialized to
ideals. -/
class ideal_Inter_nonempty : Prop :=
(Inter_nonempty : (⋂ (I : ideal P), (I : set P)).nonempty)

variable {P}

lemma Inter_nonempty [ideal_Inter_nonempty P] :
  (⋂ (I : ideal P), (I : set P)).nonempty :=
ideal_Inter_nonempty.Inter_nonempty

lemma ideal_Inter_nonempty.exists_all_mem [ideal_Inter_nonempty P] :
  ∃ a : P, ∀ I : ideal P, a ∈ I :=
begin
  change ∃ (a : P), ∀ (I : ideal P), a ∈ (I : set P),
  rw ← set.nonempty_Inter,
  exact Inter_nonempty,
end

lemma ideal_Inter_nonempty_of_exists_all_mem (h : ∃ a : P, ∀ I : ideal P, a ∈ I) :
  ideal_Inter_nonempty P :=
{ Inter_nonempty := by rwa set.nonempty_Inter }

lemma ideal_Inter_nonempty_iff :
  ideal_Inter_nonempty P ↔ ∃ a : P, ∀ I : ideal P, a ∈ I :=
⟨λ _, by exactI ideal_Inter_nonempty.exists_all_mem, ideal_Inter_nonempty_of_exists_all_mem⟩

lemma inter_nonempty [is_directed P (swap (≤))] (I J : ideal P) : (I ∩ J : set P).nonempty :=
begin
  obtain ⟨a, ha⟩ := I.nonempty,
  obtain ⟨b, hb⟩ := J.nonempty,
  obtain ⟨c, hac, hbc⟩ := directed_of (swap (≤)) a b,
  exact ⟨c, I.mem_of_le hac ha, J.mem_of_le hbc hb⟩,
end

end has_le

section preorder
variables [preorder P] {I J : ideal P} {x y : P}

/-- The smallest ideal containing a given element. -/
def principal (p : P) : ideal P :=
{ carrier   := { x | x ≤ p },
  nonempty  := ⟨p, le_rfl⟩,
  directed  := λ x hx y hy, ⟨p, le_rfl, hx, hy⟩,
  mem_of_le := λ x y hxy hy, le_trans hxy hy, }

instance [inhabited P] : inhabited (ideal P) := ⟨ideal.principal default⟩

@[simp] lemma principal_le_iff : principal x ≤ I ↔ x ∈ I :=
⟨λ (h : ∀ {y}, y ≤ x → y ∈ I), h (le_refl x),
 λ h_mem y (h_le : y ≤ x), I.mem_of_le h_le h_mem⟩

@[simp] lemma mem_principal : x ∈ principal y ↔ x ≤ y := iff.rfl

lemma mem_compl_of_ge {x y : P} : x ≤ y → x ∈ (I : set P)ᶜ → y ∈ (I : set P)ᶜ :=
λ h, mt (I.mem_of_le h)

end preorder

section order_bot

/-- A specific witness of `I.nonempty` when `P` has a bottom element. -/
@[simp] lemma bot_mem [has_le P] [order_bot P] {I : ideal P} : ⊥ ∈ I :=
I.mem_of_le bot_le I.nonempty.some_mem

variables [preorder P] [order_bot P] {I : ideal P}

/-- There is a bottom ideal when `P` has a bottom element. -/
instance : order_bot (ideal P) :=
{ bot := principal ⊥,
  bot_le := by simp }

@[priority 100]
instance order_bot.ideal_Inter_nonempty : ideal_Inter_nonempty P :=
by { rw ideal_Inter_nonempty_iff, exact ⟨⊥, λ I, bot_mem⟩ }

end order_bot

section directed
variables [has_le P] [is_directed P (≤)] [nonempty P] {I : ideal P}

/-- In a directed and nonempty order, the top ideal of a is `set.univ`. -/
instance : order_top (ideal P) :=
{ top := { carrier := set.univ,
           nonempty := set.univ_nonempty,
           directed := directed_on_univ,
           mem_of_le := λ _ _ _ _, trivial },
  le_top := λ I, le_top }

@[simp] lemma coe_top : ((⊤ : ideal P) : set P) = set.univ := rfl

lemma is_proper_of_ne_top (ne_top : I ≠ ⊤) : is_proper I := ⟨λ h, ne_top $ ext h⟩

lemma is_proper.ne_top (hI : is_proper I) : I ≠ ⊤ :=
begin
  intro h,
  rw [ext_iff, coe_top] at h,
  apply hI.ne_univ,
  assumption,
end

lemma _root_.is_coatom.is_proper (hI : is_coatom I) : is_proper I := is_proper_of_ne_top hI.1

lemma is_proper_iff_ne_top : is_proper I ↔ I ≠ ⊤ := ⟨λ h, h.ne_top, λ h, is_proper_of_ne_top h⟩

lemma is_maximal.is_coatom (h : is_maximal I) : is_coatom I :=
⟨is_maximal.to_is_proper.ne_top,
  λ _ _, by { rw [ext_iff, coe_top], exact is_maximal.maximal_proper ‹_› }⟩

lemma is_maximal.is_coatom' [is_maximal I] : is_coatom I := is_maximal.is_coatom ‹_›

lemma _root_.is_coatom.is_maximal (hI : is_coatom I) : is_maximal I :=
{ maximal_proper := λ _ _, by simp [hI.2 _ ‹_›],
  ..is_coatom.is_proper ‹_› }

lemma is_maximal_iff_is_coatom : is_maximal I ↔ is_coatom I := ⟨λ h, h.is_coatom, λ h, h.is_maximal⟩

end directed

section order_top
variables [has_le P] [order_top P] {I : ideal P}

lemma top_of_top_mem (hI : ⊤ ∈ I) : I = ⊤ :=
by { ext, exact iff_of_true (I.mem_of_le le_top hI) trivial }

lemma is_proper.top_not_mem (hI : is_proper I) : ⊤ ∉ I := λ h, hI.ne_top $ top_of_top_mem h

end order_top

section semilattice_sup
variables [semilattice_sup P] {x y : P} {I : ideal P}

/-- A specific witness of `I.directed` when `P` has joins. -/
lemma sup_mem (x y ∈ I) : x ⊔ y ∈ I :=
let ⟨z, h_mem, hx, hy⟩ := I.directed x ‹_› y ‹_› in
I.mem_of_le (sup_le hx hy) h_mem

@[simp] lemma sup_mem_iff : x ⊔ y ∈ I ↔ x ∈ I ∧ y ∈ I :=
⟨λ h, ⟨I.mem_of_le le_sup_left h, I.mem_of_le le_sup_right h⟩,
 λ h, sup_mem x h.left y h.right⟩

end semilattice_sup

section semilattice_sup_directed
variables [semilattice_sup P] [is_directed P (swap (≤))] {x : P} {I J K : ideal P}

/-- The infimum of two ideals of a co-directed order is their intersection. -/
instance : has_inf (ideal P) :=
⟨λ I J, { carrier   := I ∩ J,
  nonempty  := inter_nonempty I J,
  directed  := λ x ⟨_, _⟩ y ⟨_, _⟩, ⟨x ⊔ y, ⟨sup_mem x ‹_› y ‹_›, sup_mem x ‹_› y ‹_›⟩, by simp⟩,
  mem_of_le := λ x y h ⟨_, _⟩, ⟨mem_of_le I h ‹_›, mem_of_le J h ‹_›⟩ }⟩

/-- The supremum of two ideals of a co-directed order is the union of the down sets of the pointwise
supremum of `I` and `J`. -/
instance : has_sup (ideal P) :=
⟨λ I J, { carrier   := {x | ∃ (i ∈ I) (j ∈ J), x ≤ i ⊔ j},
  nonempty  := by { cases inter_nonempty I J, exact ⟨w, w, h.1, w, h.2, le_sup_left⟩ },
  directed  := λ x ⟨xi, _, xj, _, _⟩ y ⟨yi, _, yj, _, _⟩,
    ⟨x ⊔ y,
     ⟨xi ⊔ yi, sup_mem xi ‹_› yi ‹_›,
      xj ⊔ yj, sup_mem xj ‹_› yj ‹_›,
      sup_le
        (calc x ≤ xi ⊔ xj               : ‹_›
         ...    ≤ (xi ⊔ yi) ⊔ (xj ⊔ yj) : sup_le_sup le_sup_left le_sup_left)
        (calc y ≤ yi ⊔ yj               : ‹_›
         ...    ≤ (xi ⊔ yi) ⊔ (xj ⊔ yj) : sup_le_sup le_sup_right le_sup_right)⟩,
     le_sup_left, le_sup_right⟩,
  mem_of_le := λ x y _ ⟨yi, _, yj, _, _⟩, ⟨yi, ‹_›, yj, ‹_›, le_trans ‹x ≤ y› ‹_›⟩ }⟩

instance : lattice (ideal P) :=
{ sup          := (⊔),
  le_sup_left  := λ I J (i ∈ I), by { cases J.nonempty, exact ⟨i, ‹_›, w, ‹_›, le_sup_left⟩ },
  le_sup_right := λ I J (j ∈ J), by { cases I.nonempty, exact ⟨w, ‹_›, j, ‹_›, le_sup_right⟩ },
  sup_le       := λ I J K hIK hJK a ⟨i, hi, j, hj, ha⟩,
    K.mem_of_le ha $ sup_mem i (mem_of_mem_of_le hi hIK) j (mem_of_mem_of_le hj hJK),
  inf          := (⊓),
  inf_le_left  := λ I J, set.inter_subset_left I J,
  inf_le_right := λ I J, set.inter_subset_right I J,
  le_inf       := λ I J K, set.subset_inter,
  .. ideal.partial_order }

@[simp] lemma mem_inf : x ∈ I ⊓ J ↔ x ∈ I ∧ x ∈ J := iff.rfl
@[simp] lemma mem_sup : x ∈ I ⊔ J ↔ ∃ (i ∈ I) (j ∈ J), x ≤ i ⊔ j := iff.rfl

lemma lt_sup_principal_of_not_mem (hx : x ∉ I) : I < I ⊔ principal x :=
le_sup_left.lt_of_ne $ λ h, hx $ by simpa only [left_eq_sup, principal_le_iff] using h

end semilattice_sup_directed

section ideal_Inter_nonempty

variables [preorder P] [ideal_Inter_nonempty P]

@[priority 100]
instance ideal_Inter_nonempty.to_directed_ge : is_directed P (swap (≤)) :=
⟨λ a b, begin
    obtain ⟨c, hc⟩ : ∃ a, ∀ I : ideal P, a ∈ I := ideal_Inter_nonempty.exists_all_mem,
    exact ⟨c, hc (principal a), hc (principal b)⟩,
  end⟩

variables {α β γ : Type*} {ι : Sort*}

lemma ideal_Inter_nonempty.all_Inter_nonempty {f : ι → ideal P} :
  (⋂ x, (f x : set P)).nonempty :=
begin
  obtain ⟨a, ha⟩ : ∃ a : P, ∀ I : ideal P, a ∈ I := ideal_Inter_nonempty.exists_all_mem,
  exact ⟨a, by simp [ha]⟩
end

lemma ideal_Inter_nonempty.all_bInter_nonempty {f : α → ideal P} {s : set α} :
  (⋂ x ∈ s, (f x : set P)).nonempty :=
begin
  obtain ⟨a, ha⟩ : ∃ a : P, ∀ I : ideal P, a ∈ I := ideal_Inter_nonempty.exists_all_mem,
  exact ⟨a, by simp [ha]⟩
end

end ideal_Inter_nonempty

section semilattice_sup_ideal_Inter_nonempty

variables [semilattice_sup P] [ideal_Inter_nonempty P] {x : P} {I J K : ideal P}

instance : has_Inf (ideal P) :=
{ Inf := λ s, { carrier := ⋂ (I ∈ s), (I : set P),
  nonempty := ideal_Inter_nonempty.all_bInter_nonempty,
  directed := λ x hx y hy, ⟨x ⊔ y, ⟨λ S ⟨I, hS⟩,
    begin
      simp only [←hS, sup_mem_iff, mem_coe, set.mem_Inter],
      intro hI,
      rw set.mem_Inter₂ at *,
      exact ⟨hx _ hI, hy _ hI⟩
    end,
    le_sup_left, le_sup_right⟩⟩,
  mem_of_le := λ x y hxy hy,
    begin
      rw set.mem_Inter₂ at *,
      exact λ I hI, mem_of_le I ‹_› (hy I hI)
    end } }

variables {s : set (ideal P)}

@[simp] lemma mem_Inf : x ∈ Inf s ↔ ∀ I ∈ s, x ∈ I :=
by { change x ∈ (⋂ (I ∈ s), (I : set P)) ↔ ∀ I ∈ s, x ∈ I, simp }

@[simp] lemma coe_Inf : ↑(Inf s) = ⋂ (I ∈ s), (I : set P) := rfl

lemma Inf_le (hI : I ∈ s) : Inf s ≤ I :=
λ _ hx, hx I ⟨I, by simp [hI]⟩

lemma le_Inf (h : ∀ J ∈ s, I ≤ J) : I ≤ Inf s :=
λ _ _, by { simp only [mem_coe, coe_Inf, set.mem_Inter], tauto }

lemma is_glb_Inf : is_glb s (Inf s) := ⟨λ _, Inf_le, λ _, le_Inf⟩

instance : complete_lattice (ideal P) :=
{ ..ideal.lattice,
  ..complete_lattice_of_Inf (ideal P) (λ _, @is_glb_Inf _ _ _ _) }

end semilattice_sup_ideal_Inter_nonempty

section distrib_lattice

variables [distrib_lattice P]
variables {I J : ideal P}

lemma eq_sup_of_le_sup {x i j: P} (hi : i ∈ I) (hj : j ∈ J) (hx : x ≤ i ⊔ j) :
  ∃ (i' ∈ I) (j' ∈ J), x = i' ⊔ j' :=
begin
  refine ⟨x ⊓ i, I.mem_of_le inf_le_right hi, x ⊓ j, J.mem_of_le inf_le_right hj, _⟩,
  calc
  x    = x ⊓ (i ⊔ j)       : left_eq_inf.mpr hx
  ...  = (x ⊓ i) ⊔ (x ⊓ j) : inf_sup_left,
end

lemma coe_sup_eq : ↑(I ⊔ J) = {x | ∃ i ∈ I, ∃ j ∈ J, x = i ⊔ j} :=
begin
  ext,
  rw [mem_coe, mem_sup],
  exact ⟨λ ⟨_, _, _, _, _⟩, eq_sup_of_le_sup ‹_› ‹_› ‹_›,
  λ ⟨i, _, j, _, _⟩, ⟨i, ‹_›, j, ‹_›, le_of_eq ‹_›⟩⟩
end

end distrib_lattice

section boolean_algebra

variables [boolean_algebra P] {x : P} {I : ideal P}

lemma is_proper.not_mem_of_compl_mem (hI : is_proper I) (hxc : xᶜ ∈ I) : x ∉ I :=
begin
  intro hx,
  apply hI.top_not_mem,
  have ht : x ⊔ xᶜ ∈ I := sup_mem _ ‹_› _ ‹_›,
  rwa sup_compl_eq_top at ht,
end

lemma is_proper.not_mem_or_compl_not_mem (hI : is_proper I) : x ∉ I ∨ xᶜ ∉ I :=
have h : xᶜ ∈ I → x ∉ I := hI.not_mem_of_compl_mem, by tauto

end boolean_algebra

end ideal

/-- For a preorder `P`, `cofinal P` is the type of subsets of `P`
  containing arbitrarily large elements. They are the dense sets in
  the topology whose open sets are terminal segments. -/
structure cofinal (P) [preorder P] :=
(carrier : set P)
(mem_gt  : ∀ x : P, ∃ y ∈ carrier, x ≤ y)

namespace cofinal

variables [preorder P]

instance : inhabited (cofinal P) :=
⟨{ carrier := set.univ, mem_gt := λ x, ⟨x, trivial, le_rfl⟩ }⟩

instance : has_mem P (cofinal P) := ⟨λ x D, x ∈ D.carrier⟩

variables (D : cofinal P) (x : P)
/-- A (noncomputable) element of a cofinal set lying above a given element. -/
noncomputable def above : P := classical.some $ D.mem_gt x

lemma above_mem : D.above x ∈ D :=
exists.elim (classical.some_spec $ D.mem_gt x) $ λ a _, a

lemma le_above : x ≤ D.above x :=
exists.elim (classical.some_spec $ D.mem_gt x) $ λ _ b, b

end cofinal

section ideal_of_cofinals

variables [preorder P] (p : P) {ι : Type*} [encodable ι] (𝒟 : ι → cofinal P)

/-- Given a starting point, and a countable family of cofinal sets,
  this is an increasing sequence that intersects each cofinal set. -/
noncomputable def sequence_of_cofinals : ℕ → P
| 0 := p
| (n+1) := match encodable.decode ι n with
           | none   := sequence_of_cofinals n
           | some i := (𝒟 i).above (sequence_of_cofinals n)
           end

lemma sequence_of_cofinals.monotone : monotone (sequence_of_cofinals p 𝒟) :=
by { apply monotone_nat_of_le_succ, intros n, dunfold sequence_of_cofinals,
  cases encodable.decode ι n, { refl }, { apply cofinal.le_above }, }

lemma sequence_of_cofinals.encode_mem (i : ι) :
  sequence_of_cofinals p 𝒟 (encodable.encode i + 1) ∈ 𝒟 i :=
by { dunfold sequence_of_cofinals, rw encodable.encodek, apply cofinal.above_mem, }

/-- Given an element `p : P` and a family `𝒟` of cofinal subsets of a preorder `P`,
  indexed by a countable type, `ideal_of_cofinals p 𝒟` is an ideal in `P` which
  - contains `p`, according to `mem_ideal_of_cofinals p 𝒟`, and
  - intersects every set in `𝒟`, according to `cofinal_meets_ideal_of_cofinals p 𝒟`.

  This proves the Rasiowa–Sikorski lemma. -/
def ideal_of_cofinals : ideal P :=
{ carrier   := { x : P | ∃ n, x ≤ sequence_of_cofinals p 𝒟 n },
  nonempty  := ⟨p, 0, le_rfl⟩,
  directed  := λ x ⟨n, hn⟩ y ⟨m, hm⟩,
               ⟨_, ⟨max n m, le_rfl⟩,
               le_trans hn $ sequence_of_cofinals.monotone p 𝒟 (le_max_left _ _),
               le_trans hm $ sequence_of_cofinals.monotone p 𝒟 (le_max_right _ _) ⟩,
  mem_of_le := λ x y hxy ⟨n, hn⟩, ⟨n, le_trans hxy hn⟩, }

lemma mem_ideal_of_cofinals : p ∈ ideal_of_cofinals p 𝒟 := ⟨0, le_rfl⟩

/-- `ideal_of_cofinals p 𝒟` is `𝒟`-generic. -/
lemma cofinal_meets_ideal_of_cofinals (i : ι) : ∃ x : P, x ∈ 𝒟 i ∧ x ∈ ideal_of_cofinals p 𝒟 :=
⟨_, sequence_of_cofinals.encode_mem p 𝒟 i, _, le_rfl⟩

end ideal_of_cofinals

end order


section Logic

theorem andSymm : p ∧ q → q ∧ p := λ (And.intro x y) => And.intro y x

theorem andComm : p ∧ q ↔ q ∧ p := Iff.intro andSymm andSymm

theorem orSymm : p ∨ q → q ∨ p
| Or.inl x => Or.inr x
| Or.inr x => Or.inl x

theorem orComm : p ∨ q ↔ q ∨ p := Iff.intro orSymm orSymm

end Logic

def Set (α : Type u) : Type u := α → Prop

@[reducible]
def Set.mk (p : α → Prop) : Set α := p

class HasMem (α : outParam $ Type u) (β : Type v) where
    mem : α → β → Prop

infix:50 " ∈ " => HasMem.mem

instance : HasMem α (Set α) where
    mem x s := s x

syntax "{ " ident (" : " term)? " | " term " }" : term

macro_rules
  | `({ $x : $type | $p }) => `(Set.mk (λ ($x:ident : $type) => $p))
  | `({ $x | $p })         => `(Set.mk (λ ($x:ident : _) => $p))

abbrev setOf (b : β) [HasMem α β] : Set α := {x | x ∈ b}

namespace Set

theorem ext {s t : Set α} (h : (x : α) → x ∈ s ↔ x ∈ t) : s = t := by
    funext x
    exact propext (h x)

def univ {α : Type u} : Set α := λ _ => True

def subset (s t : Set α) : Prop := ∀ {x}, x ∈ s → x ∈ t
def inter (s t : Set α) : Set α := {x | x ∈ s ∧ x ∈ t}
def union (s t : Set α) : Set α := {x | x ∈ s ∨ x ∈ t}

infixl:70 " ∩ " => inter
infixl:65 " ∪ " => union
infix:50 " ⊆ " => subset

@[simp] theorem memUniv (a : α) : a ∈ univ := trivial

@[simp] theorem memInter (x : α) (s t : Set α) : x ∈ s ∩ t ↔ x ∈ s ∧ x ∈ t := Iff.rfl
@[simp] theorem memUnion (x : α) (s t : Set α) : x ∈ s ∪ t ↔ x ∈ s ∨ x ∈ t := Iff.rfl

theorem interComm (s t : Set α) : s ∩ t = t ∩ s := by
    apply ext
    simp
    intro
    rw andComm
    exact Iff.rfl

theorem unionComm (s t : Set α) : s ∪ t = t ∪ s := by
    apply ext
    simp
    intro
    rw orComm
    exact Iff.rfl

end Set


/-
© 2021 by the Rector and Visitors of the University of Virginia
-/

import .lin2kcoord

/-
We illustrate the use of, and test, lin2kcoord.lean.
-/

-- 2D coordinate vectors over a field, K = ℚ
def v1 := ((1, 1) : ℚ × ℚ)
def v2 := ((-1,1) : ℚ × ℚ)

-- element addition, abstract now
def v3 := v1 + v2

example : v3 = (0,2) :=
begin
unfold v1 v2 v3,
simp,
trivial,
end

-- scaling (smul)
def v4 := 5 • v3
example : v4 = (0,10) :=
begin
  unfold v4 v3 v2 v1,
  simp,
  trivial,
end


-- SETSIMP

import syntax

@[simp]
lemma union_singleton_is_insert {X : finset formula} {ϕ: formula} :
  X ∪ {ϕ} = insert ϕ X :=
begin
  have fo := finset.insert_eq ϕ X,
  finish,
end

@[simp]
lemma sdiff_singleton_is_erase {X : finset formula} {ϕ: formula} :
  X \ {ϕ} = X.erase ϕ :=
begin
  apply finset.induction_on X,
  simp,
  intros g Y gNotInY IH,
  ext1,
  finish,
end

@[simp]
lemma lengthAdd {X : finset formula} :
  ∀ {ϕ} (h : ϕ ∉ X), lengthOfSet (insert ϕ X) = lengthOfSet X + lengthOfFormula ϕ :=
begin
  apply finset.induction_on X,
  {
    unfold lengthOfSet,
    simp,
  },
  {
    intros ψ Y psiNotInY IH,
    unfold lengthOfSet at *,
    intros ϕ h,
    finish,
  },
end

@[simp]
lemma lengthOf_insert_leq_plus {X: finset formula} {ϕ : formula} :
  lengthOfSet (insert ϕ X) ≤ lengthOfSet X + lengthOfFormula ϕ :=
begin
cases (em (ϕ ∈ X)) with in_x not_in_x,
{ rw finset.insert_eq_of_mem in_x, simp, },
{ rw lengthAdd not_in_x, },
end

@[simp]
lemma lengthRemove (X : finset formula) :
  ∀ ϕ ∈ X, lengthOfSet (X.erase ϕ) + lengthOfFormula ϕ = lengthOfSet X :=
begin
  intros ϕ in_X,
  have claim : lengthOfSet (insert ϕ (X \ {ϕ})) = lengthOfSet (X \ {ϕ}) + lengthOfFormula ϕ,
  {
    apply lengthAdd,
    simp,
  },
  have anotherClaim : insert ϕ (X \ {ϕ}) = X, {
    ext1,
    simp only [finset.mem_sdiff, finset.mem_insert, finset.mem_singleton],
    split,
    finish,
    tauto,
  },
  rw anotherClaim at claim,
  finish,
end

@[simp]
lemma sum_union_le { T } [decidable_eq T] : ∀ { X Y : finset T } { F : T → ℕ }, (X ∪ Y).sum F ≤ X.sum F + Y.sum F :=
begin
  intros X Y F,
  { calc (X ∪ Y).sum F
       ≤ (X ∪ Y).sum F + (X ∩ Y).sum F : by { simp, }
   ... = X.sum F + Y.sum F : finset.sum_union_inter,
  },
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
Ported by: Anatole Dedecker

! This file was ported from Lean 3 source module order.chain
! leanprover-community/mathlib commit c227d107bbada5d0d9d20287e3282c0a7f1651a0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Pairwise.Basic
import Mathlib.Data.Set.Lattice
import Mathlib.Data.SetLike.Basic

/-!
# Chains and flags

This file defines chains for an arbitrary relation and flags for an order and proves Hausdorff's
Maximality Principle.

## Main declarations

* `IsChain s`: A chain `s` is a set of comparable elements.
* `maxChain_spec`: Hausdorff's Maximality Principle.
* `Flag`: The type of flags, aka maximal chains, of an order.

## Notes

Originally ported from Isabelle/HOL. The
[original file](https://isabelle.in.tum.de/dist/library/HOL/HOL/Zorn.html) was written by Jacques D.
Fleuriot, Tobias Nipkow, Christian Sternagel.
-/

open Classical Set

variable {α β : Type _}

/-! ### Chains -/

section Chain

variable (r : α → α → Prop)

/-- In this file, we use `≺` as a local notation for any relation `r`. -/
local infixl:50 " ≺ " => r

/-- A chain is a set `s` satisfying `x ≺ y ∨ x = y ∨ y ≺ x` for all `x y ∈ s`. -/
def IsChain (s : Set α) : Prop :=
  s.Pairwise fun x y => x ≺ y ∨ y ≺ x
#align is_chain IsChain

/-- `SuperChain s t` means that `t` is a chain that strictly includes `s`. -/
def SuperChain (s t : Set α) : Prop :=
  IsChain r t ∧ s ⊂ t
#align super_chain SuperChain

/-- A chain `s` is a maximal chain if there does not exists a chain strictly including `s`. -/
def IsMaxChain (s : Set α) : Prop :=
  IsChain r s ∧ ∀ ⦃t⦄, IsChain r t → s ⊆ t → s = t
#align is_max_chain IsMaxChain

variable {r} {c c₁ c₂ c₃ s t : Set α} {a b x y : α}

theorem isChain_empty : IsChain r ∅ :=
  Set.pairwise_empty _
#align is_chain_empty isChain_empty

theorem Set.Subsingleton.isChain (hs : s.Subsingleton) : IsChain r s :=
  hs.pairwise _
#align set.subsingleton.is_chain Set.Subsingleton.isChain

theorem IsChain.mono : s ⊆ t → IsChain r t → IsChain r s :=
  Set.Pairwise.mono
#align is_chain.mono IsChain.mono

theorem IsChain.mono_rel {r' : α → α → Prop} (h : IsChain r s) (h_imp : ∀ x y, r x y → r' x y) :
    IsChain r' s :=
  h.mono' fun x y => Or.imp (h_imp x y) (h_imp y x)
#align is_chain.mono_rel IsChain.mono_rel

/-- This can be used to turn `IsChain (≥)` into `IsChain (≤)` and vice-versa. -/
theorem IsChain.symm (h : IsChain r s) : IsChain (flip r) s :=
  h.mono' fun _ _ => Or.symm
#align is_chain.symm IsChain.symm

theorem isChain_of_trichotomous [IsTrichotomous α r] (s : Set α) : IsChain r s :=
  fun a _ b _ hab => (trichotomous_of r a b).imp_right fun h => h.resolve_left hab
#align is_chain_of_trichotomous isChain_of_trichotomous

theorem IsChain.insert (hs : IsChain r s) (ha : ∀ b ∈ s, a ≠ b → a ≺ b ∨ b ≺ a) :
    IsChain r (insert a s) :=
  hs.insert_of_symmetric (fun _ _ => Or.symm) ha
#align is_chain.insert IsChain.insert

theorem isChain_univ_iff : IsChain r (univ : Set α) ↔ IsTrichotomous α r := by
  refine' ⟨fun h => ⟨fun a b => _⟩, fun h => @isChain_of_trichotomous _ _ h univ⟩
  rw [or_left_comm, or_iff_not_imp_left]
  exact h trivial trivial
#align is_chain_univ_iff isChain_univ_iff

theorem IsChain.image (r : α → α → Prop) (s : β → β → Prop) (f : α → β)
    (h : ∀ x y, r x y → s (f x) (f y)) {c : Set α} (hrc : IsChain r c) : IsChain s (f '' c) :=
  fun _ ⟨_, ha₁, ha₂⟩ _ ⟨_, hb₁, hb₂⟩ =>
  ha₂ ▸ hb₂ ▸ fun hxy => (hrc ha₁ hb₁ <| ne_of_apply_ne f hxy).imp (h _ _) (h _ _)
#align is_chain.image IsChain.image

section Total

variable [IsRefl α r]

theorem IsChain.total (h : IsChain r s) (hx : x ∈ s) (hy : y ∈ s) : x ≺ y ∨ y ≺ x :=
  (eq_or_ne x y).elim (fun e => Or.inl <| e ▸ refl _) (h hx hy)
#align is_chain.total IsChain.total

theorem IsChain.directedOn (H : IsChain r s) : DirectedOn r s := fun x hx y hy =>
  ((H.total hx hy).elim fun h => ⟨y, hy, h, refl _⟩) fun h => ⟨x, hx, refl _, h⟩
#align is_chain.directed_on IsChain.directedOn

protected theorem IsChain.directed {f : β → α} {c : Set β} (h : IsChain (f ⁻¹'o r) c) :
    Directed r fun x : { a : β // a ∈ c } => f x :=
  fun ⟨a, ha⟩ ⟨b, hb⟩ =>
    (by_cases fun hab : a = b => by
      simp only [hab, exists_prop, and_self_iff, Subtype.exists]
      exact ⟨b, hb, refl _⟩)
    fun hab => ((h ha hb hab).elim fun h => ⟨⟨b, hb⟩, h, refl _⟩) fun h => ⟨⟨a, ha⟩, refl _, h⟩
#align is_chain.directed IsChain.directed

theorem IsChain.exists3 (hchain : IsChain r s) [IsTrans α r] {a b c} (mem1 : a ∈ s) (mem2 : b ∈ s)
    (mem3 : c ∈ s) : ∃ (z : _) (_ : z ∈ s), r a z ∧ r b z ∧ r c z := by
  rcases directedOn_iff_directed.mpr (IsChain.directed hchain) a mem1 b mem2 with ⟨z, mem4, H1, H2⟩
  rcases directedOn_iff_directed.mpr (IsChain.directed hchain) z mem4 c mem3 with
    ⟨z', mem5, H3, H4⟩
  exact ⟨z', mem5, _root_.trans H1 H3, _root_.trans H2 H3, H4⟩
#align is_chain.exists3 IsChain.exists3

end Total

theorem IsMaxChain.isChain (h : IsMaxChain r s) : IsChain r s :=
  h.1
#align is_max_chain.is_chain IsMaxChain.isChain

theorem IsMaxChain.not_superChain (h : IsMaxChain r s) : ¬SuperChain r s t := fun ht =>
  ht.2.ne <| h.2 ht.1 ht.2.1
#align is_max_chain.not_super_chain IsMaxChain.not_superChain

theorem IsMaxChain.bot_mem [LE α] [OrderBot α] (h : IsMaxChain (· ≤ ·) s) : ⊥ ∈ s :=
  (h.2 (h.1.insert fun _ _ _ => Or.inl bot_le) <| subset_insert _ _).symm ▸ mem_insert _ _
#align is_max_chain.bot_mem IsMaxChain.bot_mem

theorem IsMaxChain.top_mem [LE α] [OrderTop α] (h : IsMaxChain (· ≤ ·) s) : ⊤ ∈ s :=
  (h.2 (h.1.insert fun _ _ _ => Or.inr le_top) <| subset_insert _ _).symm ▸ mem_insert _ _
#align is_max_chain.top_mem IsMaxChain.top_mem

open Classical

/-- Given a set `s`, if there exists a chain `t` strictly including `s`, then `SuccChain s`
is one of these chains. Otherwise it is `s`. -/
def SuccChain (r : α → α → Prop) (s : Set α) : Set α :=
  if h : ∃ t, IsChain r s ∧ SuperChain r s t then choose h else s
#align succ_chain SuccChain

theorem succChain_spec (h : ∃ t, IsChain r s ∧ SuperChain r s t) :
    SuperChain r s (SuccChain r s) := by
  have : IsChain r s ∧ SuperChain r s (choose h) :=
    @choose_spec _ (fun t => IsChain r s ∧ SuperChain r s t) _
  simpa [SuccChain, dif_pos, exists_and_left.mp h] using this.2

#align succ_chain_spec succChain_spec

theorem IsChain.succ (hs : IsChain r s) : IsChain r (SuccChain r s) :=
  if h : ∃ t, IsChain r s ∧ SuperChain r s t then (succChain_spec h).1
  else by
    rw [exists_and_left] at h
    simpa [SuccChain, dif_neg, h] using hs
#align is_chain.succ IsChain.succ

theorem IsChain.superChain_succChain (hs₁ : IsChain r s) (hs₂ : ¬IsMaxChain r s) :
    SuperChain r s (SuccChain r s) := by
  simp only [IsMaxChain, not_and, not_forall, exists_prop, exists_and_left] at hs₂
  obtain ⟨t, ht, hst⟩ := hs₂ hs₁
  exact succChain_spec ⟨t, hs₁, ht, ssubset_iff_subset_ne.2 hst⟩
#align is_chain.super_chain_succ_chain IsChain.superChain_succChain

theorem subset_succChain : s ⊆ SuccChain r s :=
  if h : ∃ t, IsChain r s ∧ SuperChain r s t then (succChain_spec h).2.1
  else by
    rw [exists_and_left] at h
    simp [SuccChain, dif_neg, h, Subset.rfl]
#align subset_succ_chain subset_succChain

/-- Predicate for whether a set is reachable from `∅` using `SuccChain` and `⋃₀`. -/
inductive ChainClosure (r : α → α → Prop) : Set α → Prop
  | succ : ∀ {s}, ChainClosure r s → ChainClosure r (SuccChain r s)
  | union : ∀ {s}, (∀ a ∈ s, ChainClosure r a) → ChainClosure r (⋃₀s)
#align chain_closure ChainClosure

/-- An explicit maximal chain. `maxChain` is taken to be the union of all sets in `ChainClosure`.
-/
def maxChain (r : α → α → Prop) : Set α :=
  ⋃₀ setOf (ChainClosure r)
#align max_chain maxChain

theorem chainClosure_empty : ChainClosure r ∅ := by
  have : ChainClosure r (⋃₀∅) := ChainClosure.union fun a h => False.rec h
  simpa using this
#align chain_closure_empty chainClosure_empty

theorem chainClosure_maxChain : ChainClosure r (maxChain r) :=
  ChainClosure.union fun _ => id
#align chain_closure_max_chain chainClosure_maxChain

private theorem chainClosure_succ_total_aux (hc₁ : ChainClosure r c₁) (_ : ChainClosure r c₂)
    (h : ∀ ⦃c₃⦄, ChainClosure r c₃ → c₃ ⊆ c₂ → c₂ = c₃ ∨ SuccChain r c₃ ⊆ c₂) :
    SuccChain r c₂ ⊆ c₁ ∨ c₁ ⊆ c₂ := by
  induction hc₁
  case succ c₃ hc₃ ih =>
    cases' ih with ih ih
    · exact Or.inl (ih.trans subset_succChain)
    · exact (h hc₃ ih).imp_left fun (h : c₂ = c₃) => h ▸ Subset.rfl
  case union s _ ih =>
    refine' or_iff_not_imp_left.2 fun hn => unionₛ_subset fun a ha => _
    exact (ih a ha).resolve_left fun h => hn <| h.trans <| subset_unionₛ_of_mem ha

private theorem chainClosure_succ_total (hc₁ : ChainClosure r c₁) (hc₂ : ChainClosure r c₂)
    (h : c₁ ⊆ c₂) : c₂ = c₁ ∨ SuccChain r c₁ ⊆ c₂ := by
  induction hc₂ generalizing c₁ hc₁
  case succ c₂ hc₂ ih =>
    refine' ((chainClosure_succ_total_aux hc₁ hc₂) fun c₁ => ih).imp h.antisymm' fun h₁ => _
    obtain rfl | h₂ := ih hc₁ h₁
    · exact Subset.rfl
    · exact h₂.trans subset_succChain
  case union s hs ih =>
    apply Or.imp_left h.antisymm'
    apply by_contradiction
    simp only [unionₛ_subset_iff, not_or, not_forall, exists_prop, and_imp, forall_exists_index]
    intro c₃ hc₃ h₁ h₂
    obtain h | h := chainClosure_succ_total_aux hc₁ (hs c₃ hc₃) fun c₄ => ih _ hc₃
    · exact h₁ (subset_succChain.trans h)
    obtain h' | h' := ih c₃ hc₃ hc₁ h
    · exact h₁ h'.subset
    · exact h₂ (h'.trans <| subset_unionₛ_of_mem hc₃)

theorem ChainClosure.total (hc₁ : ChainClosure r c₁) (hc₂ : ChainClosure r c₂) :
    c₁ ⊆ c₂ ∨ c₂ ⊆ c₁ :=
  ((chainClosure_succ_total_aux hc₂ hc₁) fun _ hc₃ => chainClosure_succ_total hc₃ hc₁).imp_left
    subset_succChain.trans
#align chain_closure.total ChainClosure.total

theorem ChainClosure.succ_fixpoint (hc₁ : ChainClosure r c₁) (hc₂ : ChainClosure r c₂)
    (hc : SuccChain r c₂ = c₂) : c₁ ⊆ c₂ := by
  induction hc₁
  case succ s₁ hc₁ h => exact (chainClosure_succ_total hc₁ hc₂ h).elim (fun h => h ▸ hc.subset) id
  case union s _ ih => exact unionₛ_subset ih
#align chain_closure.succ_fixpoint ChainClosure.succ_fixpoint

theorem ChainClosure.succ_fixpoint_iff (hc : ChainClosure r c) :
    SuccChain r c = c ↔ c = maxChain r :=
  ⟨fun h => (subset_unionₛ_of_mem hc).antisymm <| chainClosure_maxChain.succ_fixpoint hc h,
    fun h => subset_succChain.antisymm' <| (subset_unionₛ_of_mem hc.succ).trans h.symm.subset⟩
#align chain_closure.succ_fixpoint_iff ChainClosure.succ_fixpoint_iff

theorem ChainClosure.isChain (hc : ChainClosure r c) : IsChain r c := by
  induction hc
  case succ c _ h => exact h.succ
  case union s hs h =>
    exact fun c₁ ⟨t₁, ht₁, (hc₁ : c₁ ∈ t₁)⟩ c₂ ⟨t₂, ht₂, (hc₂ : c₂ ∈ t₂)⟩ hneq =>
      ((hs _ ht₁).total <| hs _ ht₂).elim (fun ht => h t₂ ht₂ (ht hc₁) hc₂ hneq) fun ht =>
        h t₁ ht₁ hc₁ (ht hc₂) hneq
#align chain_closure.is_chain ChainClosure.isChain

/-- **Hausdorff's maximality principle**

There exists a maximal totally ordered set of `α`.
Note that we do not require `α` to be partially ordered by `r`. -/
theorem maxChain_spec : IsMaxChain r (maxChain r) :=
  by_contradiction fun h =>
    let ⟨_, H⟩ := chainClosure_maxChain.isChain.superChain_succChain h
    H.ne (chainClosure_maxChain.succ_fixpoint_iff.mpr rfl).symm
#align max_chain_spec maxChain_spec

end Chain

/-! ### Flags -/

/-- The type of flags, aka maximal chains, of an order. -/
structure Flag (α : Type _) [LE α] where
  /-- The `carrier` of a flag is the underlying set. -/
  carrier : Set α
  /-- By definition, a flag is a chain -/
  Chain' : IsChain (· ≤ ·) carrier
  /-- By definition, a flag is a maximal chain -/
  max_chain' : ∀ ⦃s⦄, IsChain (· ≤ ·) s → carrier ⊆ s → carrier = s
#align flag Flag

namespace Flag

section LE

variable [LE α] {s t : Flag α} {a : α}

instance : SetLike (Flag α) α where
  coe := carrier
  coe_injective' s t h := by
    cases s
    cases t
    congr

@[ext]
theorem ext : (s : Set α) = t → s = t :=
  SetLike.ext'
#align flag.ext Flag.ext

-- Porting note: `simp` can now prove this
-- @[simp]
theorem mem_coe_iff : a ∈ (s : Set α) ↔ a ∈ s :=
  Iff.rfl
#align flag.mem_coe_iff Flag.mem_coe_iff

@[simp]
theorem coe_mk (s : Set α) (h₁ h₂) : (mk s h₁ h₂ : Set α) = s :=
  rfl
#align flag.coe_mk Flag.coe_mk

@[simp]
theorem mk_coe (s : Flag α) : mk (s : Set α) s.Chain' s.max_chain' = s :=
  ext rfl
#align flag.mk_coe Flag.mk_coe

theorem chain_le (s : Flag α) : IsChain (· ≤ ·) (s : Set α) :=
  s.Chain'
#align flag.chain_le Flag.chain_le

protected theorem maxChain (s : Flag α) : IsMaxChain (· ≤ ·) (s : Set α) :=
  ⟨s.chain_le, s.max_chain'⟩
#align flag.max_chain Flag.maxChain

theorem top_mem [OrderTop α] (s : Flag α) : (⊤ : α) ∈ s :=
  s.maxChain.top_mem
#align flag.top_mem Flag.top_mem

theorem bot_mem [OrderBot α] (s : Flag α) : (⊥ : α) ∈ s :=
  s.maxChain.bot_mem
#align flag.bot_mem Flag.bot_mem

end LE

section Preorder

variable [Preorder α] {a b : α}

protected theorem le_or_le (s : Flag α) (ha : a ∈ s) (hb : b ∈ s) : a ≤ b ∨ b ≤ a :=
  s.chain_le.total ha hb
#align flag.le_or_le Flag.le_or_le

instance [OrderTop α] (s : Flag α) : OrderTop s :=
  Subtype.orderTop s.top_mem

instance [OrderBot α] (s : Flag α) : OrderBot s :=
  Subtype.orderBot s.bot_mem

instance [BoundedOrder α] (s : Flag α) : BoundedOrder s :=
  Subtype.boundedOrder s.bot_mem s.top_mem

end Preorder

section PartialOrder

variable [PartialOrder α]

theorem chain_lt (s : Flag α) : IsChain (· < ·) (s : Set α) := fun _ ha _ hb h =>
  (s.le_or_le ha hb).imp h.lt_of_le h.lt_of_le'
#align flag.chain_lt Flag.chain_lt

instance [@DecidableRel α (· ≤ ·)] [@DecidableRel α (· < ·)] (s : Flag α) :
    LinearOrder s :=
  { Subtype.partialOrder _ with
    le_total := fun a b => s.le_or_le a.2 b.2
    decidable_le := Subtype.decidableLE
    decidable_lt := Subtype.decidableLT }

end PartialOrder

instance [LinearOrder α] : Unique (Flag α) where
  default := ⟨univ, isChain_of_trichotomous _, fun s _ => s.subset_univ.antisymm'⟩
  uniq s := SetLike.coe_injective <| s.3 (isChain_of_trichotomous _) <| subset_univ _

end Flag


import data.real.basic
import algebra.pi_instances
import tuto_lib

notation `|`x`|` := abs x

/-
In this file we manipulate the elementary definition of limits of
sequences of real numbers.
mathlib has a much more general definition of limits, but here
we want to practice using the logical operators and relations
covered in the previous files.

A sequence u is a function from ℕ to ℝ, hence Lean says
u : ℕ → ℝ
The definition we'll be using is:

-- Definition of « u tends to l »
def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

Note the use of `∀ ε > 0, ...` which is an abbreviation of
`∀ ε, ε > 0 → ... `

In particular, a statement like `h : ∀ ε > 0, ...`
can be specialized to a given ε₀ by
  `specialize h ε₀ hε₀`
where hε₀ is a proof of ε₀ > 0.

Also recall that, wherever Lean expects some proof term, we can
start a tactic mode proof using the keyword `by` (followed by curly braces
if you need more than one tactic invocation).
For instance, if the local context contains:

δ : ℝ
δ_pos : δ > 0
h : ∀ ε > 0, ...

then we can specialize h to the real number δ/2 using:
  `specialize h (δ/2) (by linarith)`
where `by linarith` will provide the proof of `δ/2 > 0` expected by Lean.

We'll take this opportunity to use two new tactics:

`norm_num` will perform numerical normalization on the goal and `norm_num at h`
will do the same in assumption `h`. This will get rid of trivial calculations on numbers,
like replacing |l - l| by zero in the next exercise.

`congr'` will try to prove equalities between applications of functions by recursively
proving the arguments are the same.
For instance, if the goal is `f x + g y = f z + g t` then congr will replace it by
two goals: `x = z` and `y = t`.
You can limit the recursion depth by specifying a natural number after `congr'`.
For instance, in the above example, `congr' 1` will give new goals
`f x = f z` and `g y = g t`, which only inspect arguments of the addition and not deeper.
-/

variables (u v w : ℕ → ℝ) (l l' : ℝ)

-- If u is constant with value l then u tends to l
-- 0033
example : (∀ n, u n = l) → seq_limit u l :=
begin
  intros h e epos,
  have t : (∀ n : ℕ, n ≥ 0 ->  |u n - l| ≤ e), by
    {intros n hn,
    have h1 : -0 ≤ (0:ℝ) ∧ (0:ℝ) ≤ 0, from ⟨by linarith, by linarith⟩,
    have h2 : |(0:ℝ)| ≤ 0, from abs_le.mpr h1,
    calc | u n - l | = | l - l | : by rw (h n)
                 ... = |(0:ℝ)| : by rw (sub_self l)
                 ... ≤ 0 : by exact h2
                 ... ≤ e : by linarith [epos]},
  exact ⟨0, t⟩
end

/- When dealing with absolute values, we'll use lemmas:

abs_le (x y : ℝ) : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

abs_add (x y : ℝ) : |x + y| ≤ |x| + |y|

abs_sub (x y : ℝ) : |x - y| = |y - x|

You should probably write them down on a sheet of paper that you keep at
hand since they are used in many exercises.
-/

-- Assume l > 0. Then u tends to l implies u n ≥ l/2 for large enough n
-- 0034
example (hl : l > 0) : seq_limit u l → ∃ N, ∀ n ≥ N, u n ≥ l/2 :=
begin
  intros h,
  unfold seq_limit at h,
  specialize h (l/2) (by linarith [hl]),
  rcases h with ⟨t,rfl⟩,

  exact h
end

/-
When dealing with max, you can use

ge_max_iff (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

le_max_left p q : p ≤ max p q

le_max_right p q : q ≤ max p q

You should probably add them to the sheet of paper where you wrote
the `abs` lemmas since they are used in many exercises.

Let's see an example.
-/

-- If u tends to l and v tends l' then u+v tends to l+l'
example (hu : seq_limit u l) (hv : seq_limit v l') :
seq_limit (u + v) (l + l') :=
begin
  intros ε ε_pos,
  cases hu (ε/2) (by linarith) with N₁ hN₁,
  cases hv (ε/2) (by linarith) with N₂ hN₂,
  use max N₁ N₂,
  intros n hn,
  cases ge_max_iff.mp hn with hn₁ hn₂,
  have fact₁ : |u n - l| ≤ ε/2,
    from hN₁ n (by linarith),  -- note the use of `from`.
                               -- This is an alias for `exact`,
                               -- but reads nicer in this context
  have fact₂ : |v n - l'| ≤ ε/2,
    from hN₂ n (by linarith),
  calc
  |(u + v) n - (l + l')| = |u n + v n - (l + l')|   : rfl
                     ... = |(u n - l) + (v n - l')| : by congr' 1 ; ring
                     ... ≤ |u n - l| + |v n - l'|   : by apply abs_add
                     ... ≤  ε                       : by linarith,
end

/-
In the above proof, we used `have` to prepare facts for `linarith` consumption in the last line.
Since we have direct proof terms for them, we can feed them directly to `linarith` as in the next proof
of the same statement.
Another variation we introduce is rewriting using `ge_max_iff` and letting `linarith` handle the
conjunction, instead of creating two new assumptions.
-/

example (hu : seq_limit u l) (hv : seq_limit v l') :
seq_limit (u + v) (l + l') :=
begin
  intros ε ε_pos,
  cases hu (ε/2) (by linarith) with N₁ hN₁,
  cases hv (ε/2) (by linarith) with N₂ hN₂,
  use max N₁ N₂,
  intros n hn,
  rw ge_max_iff at hn,
  calc
  |(u + v) n - (l + l')| = |u n + v n - (l + l')|   : rfl
                     ... = |(u n - l) + (v n - l')| : by congr' 1 ; ring
                     ... ≤ |u n - l| + |v n - l'|   : by apply abs_add
                     ... ≤  ε                       : by linarith [hN₁ n (by sorry), hN₂ n (by sorry)],
end

/- Let's do something similar: the squeezing theorem. -/
-- 0035
example (hu : seq_limit u l) (hw : seq_limit w l)
(h : ∀ n, u n ≤ v n)
(h' : ∀ n, v n ≤ w n) : seq_limit v l :=
begin
  sorry

end

/- What about < ε? -/
-- 0036
example (u l) : seq_limit u l ↔
 ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| < ε :=
begin
  sorry
end

/- In the next exercise, we'll use

eq_of_abs_sub_le_all (x y : ℝ) : (∀ ε > 0, |x - y| ≤ ε) → x = y
-/

-- A sequence admits at most one limit
-- 0037
example : seq_limit u l → seq_limit u l' → l = l' :=
begin
  sorry
end

/-
Let's now practice deciphering definitions before proving.
-/

def non_decreasing (u : ℕ → ℝ) := ∀ n m, n ≤ m → u n ≤ u m

def is_seq_sup (M : ℝ) (u : ℕ → ℝ) :=
(∀ n, u n ≤ M) ∧ ∀ ε > 0, ∃ n₀, u n₀ ≥ M - ε

-- 0038
example (M : ℝ) (h : is_seq_sup M u) (h' : non_decreasing u) :
seq_limit u M :=
begin
  sorry
end


import .algebra_util

section definitions
variables {R : Type _} [ring R]

def is_nilpotent (x : R) := ∃ n : ℕ, x^n = 0
def is_unit (u : R) := ∃ v, u*v = 1

def sequence (A : Type _) := nat → A
def convolve (a b : sequence R) :=
  λ n, sum_over (λ j : fin (nat.succ n), a j.val * b (n - j.val))
infix ` ∗ `:70 := convolve

lemma convolution_assoc
  : ∀ a b c : sequence R, (a ∗ b) ∗ c = a ∗ (b ∗ c) :=
begin
  intros, funext, dsimp [(∗), (∗)],
  transitivity sum_over
      (λ (j : fin (nat.succ n)),
         sum_over (λ (j_1 : fin (nat.succ (j.val))), a (j_1.val) * b (j.val - j_1.val) * c (n - j.val))),
  { congr, funext, rw mul_sum_over_right },
  transitivity sum_over
      (λ (j : fin (nat.succ n)),
         sum_over (λ (j_1 : fin (nat.succ (n - j.val))), a (j.val) * (b (j_1.val) * c (n - j.val - j_1.val)))),
  { rw double_sum_triangle (λ (j j_1 : fin (nat.succ n)), a (j_1.val) * b (j.val - j_1.val) * c (n - j.val)),
    congr, funext,
    have : nat.succ n - k.val = nat.succ (n - k.val),
    rw nat.succ_sub (nat.le_of_succ_le_succ k.is_lt),
    congr, funext, exact this, apply fin.funext _ this,
    intro x, cases x, simp *,
    rw nat.add_sub_cancel, rw ← mul_assoc, apply congr_arg,
    apply congr_arg, rw nat.sub_sub, rw add_comm },
  { congr, funext, rw mul_sum_over_left }
end

structure power_series (R' : Type _) :=
(coefficients : sequence R')

lemma power_series.eq {R' : Type _}
  : ∀ p q : power_series R',
    (∀ n, p.coefficients n = q.coefficients n)
  → p = q
| (power_series.mk a) (power_series.mk b) :=
  λ h, congr_arg power_series.mk (funext h)

postfix `[[x]]`:100 := power_series

def power_series.zero_coeff : sequence R := λ _, 0
def power_series.one_coeff : sequence R
| 0 := 1
| (nat.succ _) := 0
lemma power_series.one_coeff_of_pos
  : ∀ {n}, 0 < n → power_series.one_coeff n = (0 : R) :=
by { intros, cases n, exfalso, exact lt_irrefl 0 a, refl }

meta def power_series_preamble :=
`[intros, apply power_series.eq, intro, dsimp [power_series.coefficients]]

instance : ring (R[[x]]) := { ring .
  zero := power_series.mk power_series.zero_coeff,
  one  := power_series.mk power_series.one_coeff,
  add  := λ p q, power_series.mk (λ n, p.coefficients n + q.coefficients n),
  neg  := λ p, power_series.mk (λ n, - p.coefficients n),
  mul  := λ p q, power_series.mk (convolve p.coefficients q.coefficients),
  zero_add := by { power_series_preamble, apply zero_add },
  add_zero := by { power_series_preamble, apply add_zero },
  add_left_neg := by { power_series_preamble, apply add_left_neg },
  add_assoc := by { power_series_preamble, apply add_assoc },
  add_comm := by { power_series_preamble, apply add_comm },
  mul_assoc := by { intros, cases a, cases b, cases c,
                    dsimp [power_series.coefficients], rw convolution_assoc },
  one_mul := by { power_series_preamble, dsimp [(∗)],
                  rw sum_over.step_front, dsimp [power_series.one_coeff],
                  rw one_mul, transitivity a.coefficients n + 0, congr,
                  rw ← sum_over_eq_zero, congr, funext,
                  transitivity 0 * a.coefficients (n - nat.succ (j.val)),
                  congr, apply sum_over_eq_zero, apply zero_mul, apply add_zero },
  mul_one := by { power_series_preamble, dsimp [(∗)],
                  rw sum_over.step, rw nat.sub_self, dsimp [power_series.one_coeff],
                  rw mul_one, transitivity 0 + a.coefficients n, congr,
                  rw ← sum_over_eq_zero, congr, funext, dsimp [fin.restrict],
                  transitivity a.coefficients k.val * 0, congr,
                  rw power_series.one_coeff_of_pos (nat.sub_pos_of_lt k.is_lt),
                  apply mul_zero, apply zero_add },
  left_distrib := by { power_series_preamble, dsimp [(∗)],
                       rw ← sum_over_sum, congr, funext, apply left_distrib },
  right_distrib := by { power_series_preamble, dsimp [(∗)],
                       rw ← sum_over_sum, congr, funext, apply right_distrib } }

end definitions

section lemmas
variables {R : Type _} [ring R]

lemma my_mul_zero : ∀ x : R, x * 0 = 0 :=
λ x, add_group.eq_zero_of_add_eq_self $ eq.symm $
     calc x * 0 = x * (0 + 0)   : by rw zero_add
          ...   = x * 0 + x * 0 : left_distrib _ _ _

end lemmas

namespace problem1 section
parameters {R : Type _} [ring R]

lemma a : 1 * 1 = (1 : R) := mul_one 1

lemma b : (- 1) * (- 1) = (1 : R) :=
  have (-1)*(-1) = -(-1 : R),
  from add_group.inv_unique (-1 : R) (-1 * -1)
       $ calc -1 * (-1 : R) + -1 = -1 * -1 + -1 * 1 : by rw mul_one
             ...                = (-1) * (-1 + 1)   : by rw eq.symm (left_distrib (-1 : R) (-1) 1)
             ...                = (-1) * 0          : by rw [neg_add_eq_sub, sub_self]
             ...                = 0                 : my_mul_zero (-1),
  show (-1 : R) * (-1) = 1, from eq.trans this $ neg_neg (1 : R)
end end problem1

namespace problem2 section
parameters {R : Type _} [comm_ring R]

lemma a : ∀ x y : R, is_nilpotent x → is_nilpotent y → is_nilpotent (x + y) :=
begin
  intros x y hx hy, cases hx with n hx, cases hy with m hy,
  existsi n + m, rw binomial_theorem x y (mul_comm x y),
  rw ← @sum_over_eq_zero _ _ (n+m+1), dsimp [binomial_expansion],
  congr, funext,
  cases k with k hk, simp, by_cases k < n,
  { rw (_ : n + m - k = m + (n - k)),
    rw [monoid.pow_of_sum_eq_mul, hy], simp,
    rw [nat.add_comm, nat.add_sub_assoc],
    apply le_of_lt, assumption },
  { rw (_ : x^k = x^(n + (k - n))),
    rw [monoid.pow_of_sum_eq_mul, hx], simp,
    congr, rw [nat.add_comm, nat.sub_add_cancel],
    apply le_of_not_gt, assumption }
end

lemma b.helper1 : ∀ (x : R) (n : nat), x^n = 0 → (- x)^n = 0 :=
by intros; rw neg_eq_neg_one_mul; rw [power_of_prod, a, mul_zero]

lemma b.helper2 : ∀ (x y : R), x * y = 1 → ∀ (n : nat), x^n * y^n = 1 :=
by intros; rw [← power_of_prod]; rw a; rw power_of_one n

lemma b : ∀ x y : R, is_nilpotent x → is_unit y → is_unit (x + y) :=
begin
  intros x y hx hy, cases hy with y_inv hy, cases hx with n hx,
  cases n with n; simp [(^), mul_n_times] at hx,
  { existsi (0 : R), rw hx, apply mul_zero },
  cases n with n,
  { simp [ mul_n_times] at hx, subst hx,
    rw zero_add, existsi y_inv, assumption },
  rw (_ : (x + y) = -((- 1) - x * y_inv) * y),
  { existsi y_inv * elephant (- 1) (x * y_inv) (nat.succ (nat.succ (n * 2))),
    rw mul_assoc, transitivity -(-1 - x * y_inv) * ((y * y_inv) * elephant (-1) (x * y_inv) (nat.succ (nat.succ (n * 2)))),
    rw mul_assoc, rw [hy, one_mul],
    { rw [neg_eq_neg_one_mul, mul_assoc],
      rw [← elephant_teacup],
      rw (_ : (x * y_inv) ^ nat.succ (nat.succ (nat.succ (n * 2))) = (x * y_inv) ^ ((n+2) + (n + 1))),
      { rw [monoid.pow_of_sum_eq_mul, power_of_prod],
        rw (_ : x ^ (n + 2) = mul_n_times x (nat.succ n) * x),
        rw [hx, zero_mul, zero_mul, sub_zero, mul_comm],
        transitivity (-1 : R)^((n+2)*2),
        { dsimp [(^)], congr, dsimp [(*)],
          rw [(_ : nat.add 1 0 = 1), (_ : nat.add n 0 = n), (_ : nat.mul (n+2) 1 = n + 2)],
          rw [(_ : nat.mul n 2 = n + n), (_ : n + 2 = n.succ.succ)],
          rw ← nat.succ_add, rw ← nat.succ_add, refl,
          any_goals {refl},
          rw ← nat.mul_two, refl,
          transitivity (n+2)*1, refl, rw mul_one },
        { rw mul_comm, rw exp_of_prod, rw (_ : (-1)^2 = (1 : R)),
          apply power_of_one, dsimp [(^), mul_n_times],
          rw [one_mul], rw problem1.b },
        { refl } },
      congr, rw nat.mul_two,
      rw [(_ : nat.add n 0 = n), (_ : n + 2 = n.succ.succ)],
      rw [← nat.succ_add, ← nat.succ_add], refl, refl, refl,
      rw mul_comm, } },
  { rw [neg_sub, sub_neg_eq_add, right_distrib],
    rw [one_mul, mul_assoc, mul_comm _ y, hy, mul_one] }
end

end end problem2

-- for parts a and c, see boolean_rings
namespace problem3

lemma b {R} [integral_domain R]
  : (∀ x : R, x*x = x) → (∀ x : R, x = 1 ∨ x = 0) :=
begin
  intros is_bool x,
  rw (_ : x = 1 ↔ 1 + -x = 0),
  apply eq_zero_or_eq_zero_of_mul_eq_zero,
  rw [right_distrib, neg_mul_eq_neg_mul_symm, is_bool],
  rw one_mul, apply add_neg_self,
  constructor; intro h, subst h, apply add_neg_self,
  rw eq_add_of_add_neg_eq h, simp,
end

end problem3

namespace problem4 section

parameters {R : Type _} [ring R]

def a.helper1 (aₙ : sequence R) (b₀ : R) : sequence R
| 0 := b₀
| (nat.succ n) := b₀ * -sum_over
        (λ (j : fin (nat.succ n)),
           have this : n - j.val < nat.succ n := nat.lt_of_le_of_lt (nat.sub_le _ _) (nat.lt_succ_self _),
           aₙ j.val.succ * a.helper1 (n - j.val))

lemma a.helper1.of_zero (aₙ : sequence R) (b₀ : R) : a.helper1 aₙ b₀ 0 = b₀ := rfl
lemma a.helper1.of_succ (aₙ : sequence R) (b₀ : R)
  : ∀ n, a.helper1 aₙ b₀ (nat.succ n)
       = b₀ * -sum_over
          (λ (j : fin (nat.succ n)),
            aₙ j.val.succ * a.helper1 aₙ b₀ (n - j.val)) :=
  λ _, rfl

lemma a : ∀ p : R[[x]], is_unit p ↔ is_unit (p.coefficients 0) :=
begin
  intro p,
  constructor,
  { intro h, cases h with q h,
    existsi q.coefficients 0,
    have : (p*q).coefficients 0 = power_series.coefficients 1 0,
    { rw h }, dsimp [power_series.coefficients, (∗)] at this,
    dsimp [sum_over] at this, rw zero_add at this, exact this },
  { intro h, cases h with b₀ h,
    existsi (power_series.mk (a.helper1 p.coefficients b₀)),
    apply power_series.eq, intro, dsimp [power_series.coefficients],
    cases n with n,
    { dsimp [(∗), sum_over], rw (a.helper1.of_zero), rw [zero_add, h], refl },
    { dsimp [(∗)], rw sum_over.step_front, simp,
      rw [a.helper1.of_succ, ← mul_assoc, h, one_mul],
      rw add_comm, rw add_neg_self, refl } }
end

end end problem4

section week2

end week2


import algebra.homology.homological_complex
import category_theory.abelian.exact
import algebra.category.Module.abelian

import tactic.interval_cases

import .test

/-!

# Collapsing double complex into a single complex

We can consider homological bicomplexes indexed by either natural numbers or integers
(or maybe even $\mathbb Z_n$ for shorter complexes) and the arrows can be either up or down
(homology or cohomology). Below is an example where the indexing set is integers and arrows are
going up (going from smaller number to bigger numbers). We want to collapse a double complex
$(C_{i, j}, d_h, d_v)$ into a single complex $\operatorname{Tot}^{\oplus}_k := \bigoplus_{i+j = k}C_{i, j}$
with differential $d^{\oplus} = d_h + d_v$. For this to be a differential,
the bicomplex need to have anticommutative squares (i.e. $d_hd_v + d_vd_h = 0$).
$$
\begin{CD}
@. \cdots @.\cdots @.\cdots\\
@. @VVV @VVV @VVV \\
\cdots @>>> C_{-1,0} @>{d_h}>>C_{-1, 1} @>{d_h}>> C_{-1, 2} @>>>\cdots\\
@. @V{d_v}VV @V{d_v}VV @V{d_v}VV\\
\cdots @>>> C_{0,0} @>{d_h}>> C_{0, 1} @>{d_h}>> C_{0, 2} @>>>\cdots\\
@. @V{d_v}VV @V{d_v}VV @V{d_v}VV\\
\cdots @>>> C_{1,0} @>{d_h}>> C_{1, 1} @>{d_h}>> C_{1,2} @>>> \cdots\\
@. @VVV @VVV @VVV \\
@. \cdots @. \cdots @. \cdots
\end{CD}
$$

The only issue is that we don't want to keep repeating for different indexing sets and different directions of arrows. So we generalize to allow the homological bicomplex to have a row shape $a$ indexed by $\alpha$ and a column shape $b$ indexed by $\beta$. Then we collect $\operatorname{Tot}^{\oplus}$ using a new shape $c$ on $\gamma$. To achieve this, we need a heterogeneous addition function $(+) : \alpha \to \beta \to \gamma$ such that

- for all $i, i' \in \alpha$ and $j \in \beta$, $i \to_a i'$ if and only if $i + j \to_c i' + j$;
- for all $j, j' \in \beta$ and $i \in \alpha$, $j \to_b j'$ if and only if $i+j\to_c i + j'$;
- addition is cancellative on both input: $i + j = i' + j$ if and only if $i = i'$ and $i + j = i + j'$ if and only if $j = j'$;
- if $i+j\to_c k \to_c \operatorname{succ}(i) + \operatorname{succ}(j)$ then $k$ is equal to both $\operatorname{succ}(i) + j$ and $i + \operatorname{succ}(j)$;

and the shapes $a, b, c$ must all be irreflexive. Then the total differential $\bigoplus_{i+j=k}\to \bigoplus_{m+n=k'}$ is defined to be the linear map whose $(i,j)$-th projection is
$$
\sum_{m=i~\mathrm{or}~n=j}\left(C_{i,j}\stackrel{D}{\to} C_{m,n}\hookrightarrow\bigoplus_{m+n=k}\right),
$$
where
$$
D =\left\{
\begin{aligned}
d_h & & i = j \\
d_v & & m = n \\
0 & & \text{otherwise}
\end{aligned}\right..
$$

## Main definitions

- `has_hadd`: the typeclass of heterogeneous addition respecting row shape, column shape and result
  shape.
- `has_sign`: the typeclass allowing a complex shape to act on group by either `1` or `-1` with the
  constrain that `rel i i'` implies the sign of `i` and `i'` is different.
- `homological_bicomplex`: a web of the form `α -> β -> C` with rows and columns as complexes and
  anticommutative squares.
- `total_at`: (only in category of modules), given bicomplex `{C_ij}`, the `n`-th module of the total
  complex is defined to be `⨁_{i + j = n}, C_ij`.
- `total_d`: (only in category of modules), given bicomplex `{C_ij}`, the linear map
  from `⨁_{i + j = n}, C_ij` to `⨁_{i + j = n'}, C_ij` is defined to be the linear map whose
  `(i,j)`-th projection is `∑_{i' + j' = n' | i' = i ∨ j' = j} (C_ij ⟶ C_{i', j'} ⟶ ⨁_{p+q = n'} C_pq)`.
- `total_d_comp_d`: if the resulting shape is irreflexive, then `total_d ≫ total_d` is zero whenever
  `n, n', n''` are all related
- `total_d_shape`: if row shape and column shape is irreflexive, then `total_d` is zero whenever
  `n, n'` is not related
- `total_complex`: the total complex of `{C_ij}` by means of direct sum with total differential
  `total_d`.

-/

noncomputable theory

universes v u

open category_theory category_theory.category category_theory.limits

variables {α β : Type}
variables (V : Type u) [category.{v} V] [preadditive V]

section

/--
A complex shape `a` on `α` is irreflexive if `i` is not relate to `i` for all `i : α`.
-/
def complex_shape.irrefl (a : complex_shape α) : Prop :=
∀ (i : α), ¬ a.rel i i

lemma complex_shape.irrefl.ne {a : complex_shape α} (ha : a.irrefl) {i i' : α} :
  a.rel i i' → i ≠ i' :=
begin
  contrapose!,
  rintro rfl,
  exact ha _,
end

/--
A homological bicomplex `C` on `γ` with rows of shape `a` on `α` and columns of shape `b` on `β` is
`α → β → γ` such that the diagram below has the following property
```
           ...      ->          ...
            |                    |
            v                    v
... -> C (prev i) j -> C (prev i) (next j) -> ...
            |        (†)         |
            v                    v
... -> C i  j       -> C i   (next j)      -> ...
            |                    |
            v                    v
           ...      ->          ...
```

* rows are homological complex of shape `a` with differential `d_h`;
* columns are homological complex of shape `β` with differential `d_v`;
* each square like (†) anticommutes, i.e. `d_h ≫ d_v + d_v ≫ d_h = 0`.

**WARNING**: Thus the diagram is not commutative.
-/
@[nolint has_nonempty_instance]
structure homological_bicomplex (a : complex_shape α) (b : complex_shape β) :=
(X : α → β → V)
(d_h : Π (i : α) (j j' : β), X i j ⟶ X i j')
(shape_h' : ∀ (i : α) (j j' : β), ¬ b.rel j j' → d_h i j j' = 0)
(d_v : Π (j : β) (i i' : α), X i j ⟶ X i' j)
(shape_v' : ∀ (j : β) (i i' : α), ¬ a.rel i i' → d_v j i i' = 0)
(d_comp_d_v' : ∀ (j : β) (i₁ i₂ i₃ : α), a.rel i₁ i₂ → a.rel i₂ i₃ →
  d_v j i₁ i₂ ≫ d_v j i₂ i₃ = 0)
(d_comp_d_h' : ∀ (i : α) (j₁ j₂ j₃ : β), b.rel j₁ j₂ → b.rel j₂ j₃ →
  d_h i j₁ j₂ ≫ d_h i j₂ j₃ = 0)
(anticomm' : ∀ (i₁ i₂ : α) (j₁ j₂ : β), a.rel i₁ i₂ → b.rel j₁ j₂ →
  d_h i₁ j₁ j₂ ≫ d_v j₂ i₁ i₂ + d_v j₁ i₁ i₂ ≫ d_h i₂ j₁ j₂ = 0)

end

namespace homological_bicomplex

restate_axiom shape_h'
restate_axiom shape_v'
attribute [simp] shape_h shape_v

variables {V}  {γ : Type} (a : complex_shape α) (b : complex_shape β) (c : complex_shape γ)

/--
A complex shape `a` on `α` can be treated as having signs if any two related terms have different
sign.
-/
class has_sign :=
(sign : α → zmod 2)
(rel : ∀ (i i' : α), a.rel i i' → sign i ≠ sign i')

/--
Given three complex shapes `a` on `α`, `b` on `β` and `c` on `γ`, a heterogeneous addition
`(+[a,b,c]) : α → β → γ` (written as `(+)` if `a, b, c` are clear from content) with respect to
the said complex shapes is such that:
* for all `j : β`, `i -> i'` according to `a` if and only if `i + j -> i' + j` according to `c`;
* for all `i : α`, `j -> j'` according to `b` if and only if `i + j -> i + j'` according to `c`;
* addition is cancellative, i.e. `i + j = i + j'` if and only if `i = j` and `i' + j = i' + j`
  if and only if `j = j'`;
* it is possible to "squeeze" the middle term: if `i : α`, `j : β` and `k : γ` are three terms such
  that `(i + j) -> k` and `k -> (next i + next j)` according to `c`, then `k` is equal to both
  `next i + j` and `i + next j`.
-/
class has_hadd :=
(add' {} : α → β → γ)
(rel_h' {} : ∀ (i₁ i₂ : α) (j : β), a.rel i₁ i₂ ↔ c.rel (add' i₁ j) (add' i₂ j))
(rel_v' {} : ∀ (i : α) (j₁ j₂ : β), b.rel j₁ j₂ ↔ c.rel (add' i j₁) (add' i j₂))
(add_cancel_h' : ∀ (i₁ i₂ : α) (j : β), add' i₁ j = add' i₂ j ↔ i₁ = i₂)
(add_cancel_v' : ∀ (i : α) (j₁ j₂ : β), add' i j₁ = add' i j₂ ↔ j₁ = j₂)
(squeeze' : ∀ (i : α) (j : β) (k : γ), c.rel (add' i j) k → c.rel k (add' (a.next i) (b.next j)) →
  (k = add' (a.next i) j ∧ k = add' i (b.next j)))

notation (name := hadd.add) i `+[` a, b, c`]` j := (has_hadd.add' a b c i j)
variables [has_hadd a b c]

instance has_hadd_down_nat : has_hadd (complex_shape.down ℕ) (complex_shape.down ℕ) (complex_shape.down ℕ) :=
{ add' := (+),
  rel_h' := λ i i' j,
  begin
    dsimp,
    split,
    { rintro rfl, ring, },
    { intros h, linarith, },
  end,
  rel_v' := λ i j j',
  begin
    dsimp,
    split,
    { rintro rfl, ring, },
    { intros h, linarith, },
  end,
  add_cancel_h' := λ _ _ _, add_left_inj _,
  add_cancel_v' := λ _ _ _, add_right_inj _,
  squeeze' := λ i j k h1 h2,
  begin
    dsimp at h1 h2,
    have eq0 : (complex_shape.down ℕ).next 0 = 0,
    { dunfold complex_shape.next,
      rw dif_neg,
      push_neg,
      intros j, dsimp, linarith, },
    have eq1 : ∀ (k : ℕ), (complex_shape.down ℕ).next k.succ = k,
    { intros k,
      rw complex_shape.next_eq',
      dsimp,
      refl, },
    cases i; cases j,
    { exfalso,
      rw eq0 at *,
      linarith, },
    { rw [eq0, zero_add] at h2,
      rw zero_add at h1,
      have eq' : k = j,
      { rw nat.succ_eq_add_one at h1,
        linarith, },
      subst eq',
      rw [eq1] at h2,
      linarith, },
    { rw [eq0, eq1, add_zero] at h2 ⊢,
      subst h2,
      rw [add_zero, nat.succ_eq_add_one] at h1,
      linarith, },
    { simp only [eq1] at *,
      subst h2,
      refine ⟨rfl, _⟩,
      rw [nat.succ_eq_add_one],
      ring, },
  end }

instance has_hadd_up_nat : has_hadd (complex_shape.up ℕ) (complex_shape.up ℕ) (complex_shape.up ℕ) :=
{ add' := (+),
  rel_h' := λ i i' j,
  begin
    dsimp,
    split,
    { rintro rfl, ring, },
    { intros h, linarith, },
  end,
  rel_v' := λ i j j',
  begin
    dsimp,
    split,
    { rintro rfl, ring, },
    { intros h, linarith, },
  end,
  add_cancel_h' := λ _ _ _, add_left_inj _,
  add_cancel_v' := λ _ _ _, add_right_inj _,
  squeeze' := λ i j k h1 h2,
  begin
    dsimp at h1 h2,
    have eq1 : ∀ (k : ℕ), (complex_shape.up ℕ).next k = k + 1,
    { intros k,
      rw complex_shape.next_eq',
      dsimp,
      refl, },
    simp only [eq1] at *,
    split;
    linarith,
  end }

def complex_shape.up_fin : Π (m : ℕ), complex_shape (fin m)
| 0 :=
{ rel := λ _ _, false,
  next_eq := λ _ _ _ _ _, fin_zero_elim _,
  prev_eq := λ _ _ _ _ _, fin_zero_elim _ }
| 1 :=
{ rel := λ i j, false,
  next_eq := λ _ _ _ _ h, h.elim,
  prev_eq := λ _ _ _ _ h, h.elim }
| (m+2) :=
{ rel := λ i j, i.val < m + 1 ∧ i + 1 = j,
  next_eq := begin
    rintros ⟨i, hi1⟩ ⟨j, hj1⟩ ⟨k, hk1⟩ ⟨hi2, hi3⟩ ⟨-, hi3'⟩,
    rw [← hi3, ← hi3'],
  end,
  prev_eq := begin
    rintros ⟨i, hi1⟩ ⟨j, hj1⟩ ⟨k, hk1⟩ ⟨hi2, hi3⟩ ⟨hi2', hi3'⟩,
    have eq1 : (⟨i, hi1⟩ + 1 : fin (m + 2)) = ⟨i+1, by linarith⟩,
    { ext, rw [fin.coe_add_eq_ite, if_neg],
      { refl, },
      { push_neg, dsimp, linarith, } },
    have eq2 : (⟨j, hj1⟩ + 1 : fin (m + 2)) = ⟨j+1, by linarith⟩,
    { ext, rw [fin.coe_add_eq_ite, if_neg],
      { refl, },
      { push_neg, dsimp, linarith,  } },

    rw [← hi3', eq1, eq2, fin.eq_iff_veq] at hi3,
    simp_rw nat.add_right_cancel hi3,
  end }

example : true := trivial

@[simp] lemma complex_shape.up_fin_zero_rel : (complex_shape.up_fin 0).rel = λ _ _, false := rfl
@[simp] lemma complex_shape.up_fin_one_rel : (complex_shape.up_fin 1).rel = λ _ _, false := rfl
@[simp] lemma complex_shape.up_fin_rel (m : ℕ) :
  (complex_shape.up_fin (m + 2)).rel = λ i j, i.val < m + 1 ∧ i + 1 = j :=
rfl

instance has_hadd_fin (m n : ℕ) :
  has_hadd (complex_shape.up_fin (m + 2)) (complex_shape.up_fin (n + 2)) (complex_shape.up_fin (m + n + 5)) :=
{ add' := λ i j, ⟨i.1 + j.1, begin
    have hi := i.2, have hj := j.2,
    linarith,
  end⟩,
  rel_h' := begin
    rintros ⟨i₁, hi₁⟩ ⟨i₂, hi₂⟩ ⟨j, hj⟩,
    dsimp [nat.succ_eq_add_one] at *,
    generalize_proofs h3 h4,
    split,
    { rintros ⟨H1, H2⟩,
      refine ⟨by linarith, _⟩,
      sorry },
    { rintros ⟨H1, H2⟩,
      refine ⟨_, _⟩,
      { sorry,
        /-
        i₂ = i₁ + 1 < m + 2 so i₁ < m + 1
        -/
      },
      { sorry }, }
  end,
  rel_v' := sorry,
  add_cancel_h' := λ i₁ i₂ j, ⟨sorry, λ h, h ▸ rfl⟩,
  add_cancel_v' := λ i j₁ j₂, ⟨sorry, λ h, h ▸ rfl⟩,
  squeeze' := λ i j k h1 h2,
  begin
    dsimp at h1 h2,
    sorry
  end }

variables {a b c}

@[simp] lemma d_comp_d_v (C : homological_bicomplex V a b) (j : β) (i₁ i₂ i₃ : α) :
  C.d_v j i₁ i₂ ≫ C.d_v j i₂ i₃ = 0 :=
begin
  classical,
  by_cases h₁₂ : a.rel i₁ i₂,
  { refine (em (a.rel i₂ i₃)).elim (λ h₂₃, C.d_comp_d_v' j i₁ i₂ i₃ h₁₂ h₂₃) (λ h₂₃, _),
    rw [C.shape_v j _ _ h₂₃, comp_zero], },
  rw [C.shape_v _ _ _ h₁₂, zero_comp],
end

@[simp] lemma anticomm (C : homological_bicomplex V a b) (j₁ j₂ : β) (i₁ i₂ : α) :
  C.d_h i₁ j₁ j₂ ≫ C.d_v j₂ i₁ i₂ +
  C.d_v j₁ i₁ i₂ ≫ C.d_h i₂ j₁ j₂ = 0 :=
begin
  classical,
  by_cases ha : a.rel i₁ i₂;
  by_cases hb : b.rel j₁ j₂,
  { rw C.anticomm'; assumption },
  { rw [C.shape_h, C.shape_h, comp_zero, zero_comp]; abel <|> assumption },
  { rw [C.shape_v, C.shape_v, comp_zero, zero_comp]; abel <|> assumption },
  { rw [C.shape_v, C.shape_v, comp_zero, zero_comp]; abel <|> assumption },
end

@[simp] lemma d_comp_d_h (C : homological_bicomplex V a b) (i : α) (j₁ j₂ j₃ : β) :
  C.d_h i j₁ j₂ ≫ C.d_h i j₂ j₃ = 0 :=
begin
  by_cases h₁₂ : b.rel j₁ j₂,
  { refine (em (b.rel j₂ j₃)).elim (λ h₂₃, C.d_comp_d_h' i j₁ j₂ j₃ h₁₂ h₂₃) (λ h₂₃, _),
    rw [C.shape_h i _ _ h₂₃, comp_zero], },
  rw [C.shape_h _ _ _ h₁₂, zero_comp],
end

variables [decidable_eq α] [decidable_eq β] [decidable_eq γ]

/--
A general differential for the bicomplex from `(i, j)` to `(i', j')` where it acts as the horizontal
differential if `i = i'` and the vertical differential if `j = j'` and zero otherwise.
-/
def D (C : homological_bicomplex V a b) (i₁ i₂ : α) (j₁ j₂ : β) :
  C.X i₁ j₁ ⟶ C.X i₂ j₂ :=
if H_h : i₁ = i₂
then C.d_h i₁ j₁ j₂ ≫ eq_to_hom (by rw H_h)
else if H_v : j₁ = j₂
  then C.d_v j₁ i₁ i₂ ≫ eq_to_hom (by rw H_v)
  else 0

lemma D_eq_of_eq_h (C : homological_bicomplex V a b) (i₁ i₂ : α) (j₁ j₂ : β)
  (h : i₁ = i₂) :
  C.D i₁ i₂ j₁ j₂ = C.d_h i₁ j₁ j₂ ≫ eq_to_hom (by rw h) :=
by rw [D, dif_pos h]

lemma D_eq_of_eq_v (C : homological_bicomplex V a b) (ha : a.irrefl) (hb : b.irrefl)
  (i₁ i₂ : α) (j₁ j₂ : β)
  (h : j₁ = j₂) :
  C.D i₁ i₂ j₁ j₂ = C.d_v j₁ i₁ i₂ ≫ eq_to_hom (by rw h) :=
begin
  rw [D],
  split_ifs with h1,
  { rw [C.shape_h, C.shape_v, zero_comp, zero_comp],
    { substs h1 h, exact ha _, },
    { substs h1 h, exact hb _, }, },
  { refl, },
end

lemma D_comp_D (C : homological_bicomplex V a b) (i₁ i₂ i₃ : α) (j₁ j₂ j₃ : β) :
  C.D i₁ i₂ j₁ j₂ ≫ C.D i₂ i₃ j₂ j₃ =
  if i₁ = i₂
  then if i₂ = i₃
    then 0
    else if j₂ = j₃
      then C.d_h _ _ _ ≫ C.d_v _ _ _
      else 0
  else if i₂ = i₃
    then if j₁ = j₂
      then C.d_v _ _ _ ≫ C.d_h _ _ _
      else 0
    else 0 :=
begin
  rw [D, D],
  by_cases i₁ = i₂,
  { subst h,
    rw [dif_pos rfl, eq_to_hom_refl, comp_id],
    by_cases i₁ = i₃,
    { subst h,
      rw [dif_pos rfl, eq_to_hom_refl, comp_id, d_comp_d_h, if_pos rfl, if_pos rfl], },
    { rw [dif_neg h, if_pos rfl, if_neg h],
      by_cases j₂ = j₃,
      { subst h,
        rw [dif_pos rfl, if_pos rfl, eq_to_hom_refl, comp_id], },
      { rw [dif_neg h, if_neg h, comp_zero], }, }, },
  { rw [dif_neg h, if_neg h],
    by_cases i₂ = i₃,
    { subst h,
      rw [dif_pos rfl, if_pos rfl, eq_to_hom_refl, comp_id],
      by_cases j₁ = j₂,
      { subst h,
        rw [dif_pos rfl, if_pos rfl, eq_to_hom_refl, comp_id], },
      { rw [dif_neg h, zero_comp, if_neg h], }, },
    { rw [if_neg h, dif_neg h],
      split_ifs with h2 h3,
      { substs h2 h3,
        rw [eq_to_hom_refl, eq_to_hom_refl, comp_id, comp_id, d_comp_d_v], },
      { rw comp_zero },
      { rw zero_comp },
      { rw zero_comp }, }, },
end

section

variables {R : Type u} [comm_ring R] (C : homological_bicomplex (Module.{v} R) a b)
variables (c) (k k' : γ)

open_locale direct_sum big_operators

lemma direct_sum.to_module_comp (R : Type*) [comm_ring R]
  {α β γ} [decidable_eq α] [decidable_eq β]
  (L : (α → Type*))  [∀ i , add_comm_monoid (L i)] [∀ i , module R (L i)]
  (M : (β → Type*))  [∀ i , add_comm_monoid (M i)] [∀ i , module R (M i)]
  (N : (γ → Type*))  [∀ i , add_comm_monoid (N i)] [∀ i , module R (N i)]
  (fLM : Π (a : α) , L a →ₗ[R] ⨁ j, M j)
  (fMN : Π (b : β), M b →ₗ[R] ⨁ k, N k)
  (fLN : Π (a : α) , L a →ₗ[R] ⨁ k, N k)
  (H : ∀ (i : α), (direct_sum.to_module _ _ _ fMN).comp (fLM i) = fLN i) :
  (direct_sum.to_module _ _ _ fMN :
      (⨁ i, M i) →ₗ[R] (⨁ i, N i)).comp
    (direct_sum.to_module _ _ _ fLM :
      (⨁ i, L i) →ₗ[R] (⨁ i, M i)) =
  direct_sum.to_module _ _ _ fLN :=
begin
  classical,
  apply direct_sum.linear_map_ext,
  intros i,
  ext1 y,
  simp only [linear_map.comp_apply, direct_sum.to_module_lof],
  specialize H i,
  rw ← H,
  refl,
end

section

variables (a b c)

/--
The diagonal of `k : γ` with respect to shapes `a`, `b` and `c` is pairs `(i, j) ∈ a × b` such that
`i +[a, b, c] j = k`.
-/
@[ext, nolint has_nonempty_instance]
structure diagonal (k : γ) :=
(fst : α) (snd : β) (add_eq : (fst +[a, b, c] snd) = k)

end

variables {a b}
/--
The total complex at `k`-th position is `⨁_{i + j = k} C_ij`.
-/
def total_at (j : γ) : Module R :=
Module.of.{v} R $ ⨁ (p : diagonal a b c j), C.X p.fst p.snd

/--
The map `C_mn ⟶ ⨁_{i + j = k} C_ij` where `m + n = k`
-/
@[reducible]
def total_at_embed (k : γ) (p : diagonal a b c k) [∀ k, decidable_eq $ diagonal a b c k] :
  C.X p.fst p.snd →ₗ[R] C.total_at c k :=
direct_sum.lof R _ _ p

lemma total_at_embed_comp_D_congr (k : γ) (p p' : diagonal a b c k) (EQ : p = p') (M : Module.{v} R)
  (f : Π (p : diagonal a b c k), (M →ₗ[R] C.X p.1 p.2)) [∀ k, decidable_eq $ diagonal a b c k] :
  (total_at_embed c C k p).comp (f p) =
  (total_at_embed c C k p').comp (f p') :=
begin
  rcases ⟨p, p'⟩ with ⟨⟨i, j, h⟩, ⟨i', j', h'⟩⟩,
  rw diagonal.ext_iff at EQ,
  dsimp only at EQ,
  cases EQ with EQ1 EQ2,
  substs EQ1 EQ2,
end

/--
Considering `C_ij ⟶ C_mn`, only if `i = m` or `j = n` will `D` be potentially nonzero.
-/
@[reducible]
def diagonal.potentially_nonzero ⦃k : γ⦄ (p : diagonal a b c k) (k') : set (diagonal a b c k') :=
{p' | p'.1 = p.1} ∪ {p' | p'.2 = p.2}

lemma diagonal.subsingleton_of_fst_eq ⦃k : γ⦄ (p : diagonal a b c k) (k' : γ) :
  {p' : diagonal a b c k' | p'.1 = p.1}.subsingleton :=
begin
  rintros ⟨x1, y1, eq1⟩ hx1 ⟨x2, y2, eq2⟩ hx2,
  dsimp at hx1 hx2,
  substs hx1 hx2,
  ext,
  { refl },
  { rw [← eq1, has_hadd.add_cancel_v'] at eq2,
    subst eq2, },
end

lemma diagonal.subsingleton_of_snd_eq ⦃k : γ⦄ (p : diagonal a b c k) (k' : γ) :
  {p' : diagonal a b c k' | p'.2 = p.2}.subsingleton :=
begin
  rintros ⟨x1, y1, eq1⟩ hx1 ⟨x2, y2, eq2⟩ hx2,
  dsimp at hx1 hx2,
  substs hx1 hx2,
  ext,
  { rw [← eq1, has_hadd.add_cancel_h'] at eq2,
    subst eq2, },
  { refl },
end

lemma diagonal.potentially_nonzero_finite ⦃k : γ⦄ (p : diagonal a b c k) (k' : γ) :
  (p.potentially_nonzero c k').finite :=
begin
  refine set.finite.union (set.subsingleton.finite _) (set.subsingleton.finite _),
  { exact p.subsingleton_of_fst_eq c k' },
  { exact p.subsingleton_of_snd_eq c k' },
end

/--
`⨁_{i + j = k} C_ij ⟶ ⨁_{i + j = k'} C_ij` is defined to be the linear map whose `(i, j)`-th
projection `C_ij ⟶ ⨁_{m + n = k'} C_mn` is defined to be the sum of all `C_ij ⟶ C_mn ⟶ ⨁`.
-/
@[reducible]
def total_d [∀ k, decidable_eq $ diagonal a b c k] : C.total_at c k ⟶ C.total_at c k' :=
direct_sum.to_module R _ _ $ λ p,
  ∑ (p' : diagonal a b c k') in (p.potentially_nonzero_finite c k').to_finset,
    (C.total_at_embed c k' p').comp (C.D p.1 p'.1 p.2 p'.2)

instance t1 {k k'} (p : diagonal a b c k) : fintype {p' : diagonal a b c k' | p'.fst = p.fst} :=
(p.subsingleton_of_fst_eq c k').finite.fintype

instance t2 {k k'} (p : diagonal a b c k) : fintype {p' : diagonal a b c k' | p'.snd = p.snd} :=
(p.subsingleton_of_snd_eq c k').finite.fintype

lemma sum_potentially_nonzero_finite_eq_union (c_ir : c.irrefl) (hc : c.rel k k')
  {M : Type*} [add_comm_monoid M]
  (p : diagonal a b c k) (f : diagonal a b c k' → M) :
  ∑ (p' : diagonal a b c k') in (p.potentially_nonzero_finite c k').to_finset, f p' =
  (∑ p' in {p' : diagonal a b c k' | p'.fst = p.fst}.to_finset, f p') +
  (∑ p' in {p' : diagonal a b c k' | p'.snd = p.snd}.to_finset, f p') :=
begin
  classical,
  haveI : fintype {p' : diagonal a b c k' | p'.fst = p.fst},
  { exact (p.subsingleton_of_fst_eq c k').finite.fintype, },
  haveI : fintype {p' : diagonal a b c k' | p'.snd = p.snd},
  { exact (p.subsingleton_of_snd_eq c k').finite.fintype, },

  transitivity ∑ (p' : diagonal a b c k') in
    ({p' | p'.1 = p.1} : set (diagonal a b c k')).to_finset ∪ {p' : diagonal a b c k' | p'.2 = p.2}.to_finset,
    f p',
  { refine finset.sum_congr _ (λ _ _, rfl),
    ext1, simp only [set.finite.mem_to_finset, set.mem_union, finset.mem_union, set.mem_to_finset], },
  transitivity ∑ (p' : diagonal a b c k') in
    ({p' | p'.1 = p.1} : set (diagonal a b c k')).to_finset.disj_union
      ({p' : diagonal a b c k' | p'.2 = p.2}.to_finset) _, f p',
  work_on_goal 2 {
    rw finset.disjoint_iff_ne,
    rintros ⟨i1, j1, h1⟩ hi1 ⟨i2, j2, h2⟩ hi2 H,
    simp only [set.mem_to_finset, set.mem_set_of_eq] at hi1 hi2,
    rw [diagonal.ext_iff] at H,
    dsimp only at H,
    rcases H with ⟨H1, H2⟩,
    substs H1 H2,
    rw [hi1, hi2, p.add_eq] at h1,
    exact c_ir.ne hc h1,
  },
  { refine finset.sum_congr _ (λ _ _, rfl),
    exact (finset.disj_union_eq_union _ _ _).symm, },
  rw finset.sum_disj_union,
  congr,
end

lemma total_d_comp_d_eq_double_sum (k₁ k₂ k₃ : γ) [∀ k, decidable_eq $ diagonal a b c k] :
  (C.total_d c k₂ k₃).comp (C.total_d c k₁ k₂) =
  direct_sum.to_module _ _ _ (λ p₁,
    ∑ (p₂ : diagonal a b c k₂) in (p₁.potentially_nonzero_finite c k₂).to_finset,
      ∑ (p₃ : diagonal a b c k₃) in (p₂.potentially_nonzero_finite c k₃).to_finset,
        (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2))) :=
begin
  rw [total_d, total_d],
  refine direct_sum.to_module_comp R _ _ _ _ _ _ _,
  intros p₁,
  rw [linear_map.comp_sum],
  refine finset.sum_congr rfl _,
  intros p₂ hp₂,
  simp only [set.finite.mem_to_finset, set.mem_union, set.mem_set_of_eq] at hp₂,
  ext1 x,
  simp only [linear_map.comp_apply, direct_sum.to_module_lof, linear_map.sum_apply],
end

lemma total_d_comp_d_eq_4_sums (k₁ k₂ k₃ : γ) (c_ir : c.irrefl)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) [∀ k, decidable_eq $ diagonal a b c k] :
  (C.total_d c k₂ k₃).comp (C.total_d c k₁ k₂) =
  direct_sum.to_module _ _ _ (λ p₁,
    (∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.fst = p₁.fst}.to_finset,
      ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.fst = p₂.fst}.to_finset,
        (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2))) +
    (∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.fst = p₁.fst}.to_finset,
      ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.snd = p₂.snd}.to_finset,
        (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2))) +
    (∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.snd = p₁.snd}.to_finset,
      ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.fst = p₂.fst}.to_finset,
        (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2))) +
    (∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.snd = p₁.snd}.to_finset,
      ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.snd = p₂.snd}.to_finset,
        (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)))) :=
begin
  classical,
  rw total_d_comp_d_eq_double_sum c C _ _ _,
  ext p₁ x : 2,
  simp only [direct_sum.to_module_lof, linear_map.comp_apply, linear_map.sum_apply,
    linear_map.zero_apply, direct_sum.zero_apply],
  rw sum_potentially_nonzero_finite_eq_union c k₁ k₂ c_ir hc12 p₁ _,
  simp only [linear_map.add_apply, linear_map.sum_apply],
  rw [add_assoc],
  congr' 1,
  { rw [← finset.sum_add_distrib],
    refine finset.sum_congr rfl _,
    intros p₂ hp₂,
    rw sum_potentially_nonzero_finite_eq_union c k₂ k₃ c_ir hc23 p₂ _,
    congr, },
  { rw [← finset.sum_add_distrib],
    refine finset.sum_congr rfl _,
    intros p₂ hp₂,
    rw sum_potentially_nonzero_finite_eq_union c k₂ k₃ c_ir hc23 p₂ _,
    congr, },
end

lemma total_d_comp_d_eq_4_sums.fourth_zero (k₁ k₂ k₃ : γ) (c_ir : c.irrefl)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) (p₁ : diagonal a b c k₁)
  [∀ k, decidable_eq $ diagonal a b c k] :
  ∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.snd = p₁.snd}.to_finset,
      ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.snd = p₂.snd}.to_finset,
        (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)) = 0 :=
begin
  apply finset.sum_eq_zero,
  intros p₂ hp₂,
  apply finset.sum_eq_zero,
  intros p₃ hp₃,
  simp only [set.mem_to_finset, set.mem_set_of_eq] at hp₂ hp₃,
  suffices :  C.D p₁.fst p₂.fst p₁.snd p₂.snd ≫ C.D p₂.fst p₃.fst p₂.snd p₃.snd = 0,
  { change linear_map.comp _ _ = 0 at this,
    rw [this, linear_map.comp_zero], },
  rw [D_comp_D, if_neg],
  work_on_goal 2
  { intro rid,
    have EQ1 := p₁.add_eq,
    have EQ2 := p₂.add_eq,
    rw [← rid, hp₂, EQ1] at EQ2,
    exact c_ir.ne hc12 EQ2, },
  rw [if_neg],
  { intro rid,
    have EQ2 := p₂.add_eq,
    have EQ3 := p₃.add_eq,
    rw [← rid, hp₃, EQ2] at EQ3,
    exact c_ir.ne hc23 EQ3, },
end

lemma total_d_comp_d_eq_4_sums.fst_zero (k₁ k₂ k₃ : γ) (p₁ : diagonal a b c k₁)
  [∀ k, decidable_eq $ diagonal a b c k] :
  ∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.fst = p₁.fst}.to_finset,
    ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.fst = p₂.fst}.to_finset,
      (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)) = 0 :=
begin
  apply finset.sum_eq_zero,
  intros p₂ hp₂,
  apply finset.sum_eq_zero,
  intros p₃ hp₃,
  simp only [set.mem_to_finset, set.mem_set_of_eq] at hp₂ hp₃,
  suffices :  C.D p₁.fst p₂.fst p₁.snd p₂.snd ≫ C.D p₂.fst p₃.fst p₂.snd p₃.snd = 0,
  { change linear_map.comp _ _ = 0 at this,
    rw [this, linear_map.comp_zero], },
  rw [D_comp_D, if_pos hp₃.symm, if_pos hp₂.symm],
end

lemma total_d_comp_d_eq_2_sums (k₁ k₂ k₃ : γ) (c_ir : c.irrefl)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) [∀ k, decidable_eq $ diagonal a b c k] :
  (C.total_d c k₂ k₃).comp (C.total_d c k₁ k₂) =
  direct_sum.to_module _ _ _ (λ p₁,
    (∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.fst = p₁.fst}.to_finset,
      ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.snd = p₂.snd}.to_finset,
        (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2))) +
    (∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.snd = p₁.snd}.to_finset,
      ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.fst = p₂.fst}.to_finset,
        (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)))) :=
begin
  classical,
  rw total_d_comp_d_eq_4_sums c C _ _ _ c_ir hc12 hc23,
  congr' 1,
  ext p₁ : 1,
  rw total_d_comp_d_eq_4_sums.fst_zero;
  try { assumption },
  rw [zero_add, total_d_comp_d_eq_4_sums.fourth_zero];
  try { assumption },
  rw [add_zero],
end

lemma diagonal.subsingleton_of_fst_eq_and_snd_eq (i : α) (j : β) :
  set.subsingleton {p : diagonal a b c k | p.1 = i ∧ p.2 = j} :=
begin
  rintros ⟨i1, j1, h1⟩ ⟨rfl, rfl⟩ ⟨i2, j2, h2⟩ ⟨h21, h22⟩,
  dsimp at h21 h22,
  substs h21 h22,
end

instance diagonal.fintype_of_fst_eq_and_snd_eq (i : α) (j : β) :
  fintype {p : diagonal a b c k | p.1 = i ∧ p.2 = j} :=
begin
  haveI : subsingleton {p : diagonal a b c k | p.fst = i ∧ p.snd = j},
  { fconstructor,
    rintros ⟨p1, h1⟩ ⟨p2, h2⟩,
    ext1,
    exact diagonal.subsingleton_of_fst_eq_and_snd_eq c k i j h1 h2, },
  exact fintype.of_finite _,
end

lemma diagonal.fixed_of_fst_eq (p : diagonal a b c k) (hc : c.rel k k') :
  {p' : diagonal a b c k' | p'.1 = p.1} =
  {p' : diagonal a b c k' | p'.1 = p.1 ∧ p'.2 = b.next p.2} :=
begin
  rcases p with ⟨i, j, h⟩,
  ext1 ⟨i', j', h'⟩,
  dsimp,
  split,
  { rintro rfl,
    refine ⟨rfl, _⟩,
    rw [← h, ← h', ←has_hadd.rel_v'] at hc,
    exact (b.next_eq' hc).symm, },
  { rintro ⟨rfl, -⟩, refl, },
end

lemma diagonal.fixed_of_snd_eq (p : diagonal a b c k) (hc : c.rel k k') :
  {p' : diagonal a b c k' | p'.2 = p.2} =
  {p' : diagonal a b c k' | p'.1 = a.next p.1 ∧ p'.2 = p.2} :=
begin
  rcases p with ⟨i, j, h⟩,
  ext1 ⟨i', j', h'⟩,
  dsimp,
  split,
  { rintro rfl,
    refine ⟨_, rfl⟩,
    rw [← h, ← h', ←has_hadd.rel_h'] at hc,
    exact (a.next_eq' hc).symm, },
  { rintro ⟨-, rfl⟩, refl, },
end

lemma total_d_comp_d_eq_2_sums.fst_eq1 (k₁ k₂ k₃ : γ)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) (p₁ : diagonal a b c k₁)
  [∀ k, decidable_eq $ diagonal a b c k] :
  ∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.fst = p₁.fst}.to_finset,
    ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.snd = p₂.snd}.to_finset,
      (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)) =
  ∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.fst = p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset,
    ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.fst = a.next p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset,
      (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)) :=
begin
  classical,
  refine finset.sum_congr _ (λ p₂ hp₂, finset.sum_congr _ (λ _ _, rfl)),
  { rw set.to_finset_inj,
    rw diagonal.fixed_of_fst_eq,
    assumption, },
  { rw set.to_finset_inj,
    rw diagonal.fixed_of_snd_eq,
    work_on_goal 2 { assumption, },
    simp only [set.mem_to_finset, set.mem_set_of_eq] at hp₂,
    rw [hp₂.1, hp₂.2], }
end

lemma total_d_comp_d_eq_2_sums.snd_eq1 (k₁ k₂ k₃ : γ)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) (p₁ : diagonal a b c k₁)
  [∀ k, decidable_eq $ diagonal a b c k] :
  ∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.snd = p₁.snd}.to_finset,
    ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.fst = p₂.fst}.to_finset,
      (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)) =
  ∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.fst = a.next p₁.fst ∧ p'.snd = p₁.snd}.to_finset,
    ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.fst = a.next p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset,
      (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)) :=
begin
  classical,
  refine finset.sum_congr _ (λ p₂ hp₂, finset.sum_congr _ (λ _ _, rfl)),
  { rw set.to_finset_inj,
    rw diagonal.fixed_of_snd_eq,
    assumption, },
  { rw set.to_finset_inj,
    rw diagonal.fixed_of_fst_eq,
    work_on_goal 2 { assumption, },
    simp only [set.mem_to_finset, set.mem_set_of_eq] at hp₂,
    rw [hp₂.1, hp₂.2], }
end

lemma total_d_comp_d_eq_2_sums.fst_eq2 (k₁ k₂ k₃ : γ)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) (p₁ : diagonal a b c k₁)
  [∀ k, decidable_eq $ diagonal a b c k] :
  ∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.fst = p₁.fst}.to_finset,
    ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.snd = p₂.snd}.to_finset,
      (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)) =
  ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.fst = a.next p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset,
    ∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.fst = p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset,
      (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)) :=
begin
  rw total_d_comp_d_eq_2_sums.fst_eq1;
  try { assumption },
  exact finset.sum_comm,
end

lemma total_d_comp_d_eq_2_sums.snd_eq2 (k₁ k₂ k₃ : γ)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) (p₁ : diagonal a b c k₁)
  [∀ k, decidable_eq $ diagonal a b c k] :
  ∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.snd = p₁.snd}.to_finset,
    ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.fst = p₂.fst}.to_finset,
      (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)) =
  ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.fst = a.next p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset,
    ∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.fst = a.next p₁.fst ∧ p'.snd = p₁.snd}.to_finset,
      (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)) :=
begin
  rw total_d_comp_d_eq_2_sums.snd_eq1;
  try { assumption },
  exact finset.sum_comm,
end

lemma total_d_comp_d_eq_2_sums.fst_eq3 (k₁ k₂ k₃ : γ)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) (p₁ : diagonal a b c k₁)
  [∀ k, decidable_eq $ diagonal a b c k] :
  ∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.fst = p₁.fst}.to_finset,
    ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.snd = p₂.snd}.to_finset,
      (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)) =
  ∑ p₃ in {p' : diagonal a b c k₃ | p'.fst = a.next p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset.attach,
    ∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.fst = p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset,
      (C.total_at_embed c _ ⟨a.next p₁.fst, b.next p₁.snd, begin
        have h3 := p₃.2, simp only [set.mem_to_finset, set.mem_set_of_eq] at h3,
        rw [←h3.1], simp_rw [←h3.2], exact p₃.1.add_eq,
      end⟩).comp ((C.D p₂.1 (a.next p₁.1) p₂.2 (b.next p₁.2)).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)) :=
begin
  rw total_d_comp_d_eq_2_sums.fst_eq2;
  try { assumption },
  rw ← finset.sum_attach,
  refine finset.sum_congr rfl _,
  rintros ⟨p₃, hp3⟩ -,
  refine finset.sum_congr rfl _,
  rintros p₂ hp2,
  simp only [set.mem_to_finset, set.mem_set_of_eq, finset.mem_attach] at hp3 hp2,
  rw [subtype.coe_mk],
  apply total_at_embed_comp_D_congr,
  ext,
  { exact hp3.1 },
  { exact hp3.2 }
end

lemma total_d_comp_d_eq_2_sums.snd_eq3 (k₁ k₂ k₃ : γ)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) (p₁ : diagonal a b c k₁)
  [∀ k, decidable_eq $ diagonal a b c k] :
  ∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.snd = p₁.snd}.to_finset,
    ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.fst = p₂.fst}.to_finset,
      (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)) =
  ∑ p₃ in {p' : diagonal a b c k₃ | p'.fst = a.next p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset.attach,
    ∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.fst = a.next p₁.fst ∧ p'.snd = p₁.snd}.to_finset,
      (C.total_at_embed c _ ⟨a.next p₁.1, b.next p₁.2, begin
        have h3 := p₃.2, simp only [set.mem_to_finset, set.mem_set_of_eq] at h3,
        rw [←h3.1], simp_rw [←h3.2], exact p₃.1.add_eq,
      end⟩).comp ((C.D p₂.1 (a.next p₁.1) p₂.2 (b.next p₁.2)).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)) :=
begin
  rw total_d_comp_d_eq_2_sums.snd_eq2;
  try { assumption },
  rw ← finset.sum_attach,
  refine finset.sum_congr rfl _,
  rintros ⟨p₃, hp3⟩ -,
  refine finset.sum_congr rfl _,
  rintros p₂ hp2,
  simp only [set.mem_to_finset, set.mem_set_of_eq, finset.mem_attach] at hp3 hp2,
  rw [subtype.coe_mk],
  apply total_at_embed_comp_D_congr,
  ext,
  { exact hp3.1 },
  { exact hp3.2 }
end

lemma total_d_comp_d_eq_2_sums.fst_eq4 (k₁ k₂ k₃ : γ)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) (p₁ : diagonal a b c k₁)
  [∀ k, decidable_eq $ diagonal a b c k] :
  ∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.fst = p₁.fst}.to_finset,
    ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.snd = p₂.snd}.to_finset,
      (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)) =
  ∑ p₃ in {p' : diagonal a b c k₃ | p'.fst = a.next p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset.attach,
    (C.total_at_embed c _ ⟨a.next p₁.fst, b.next p₁.snd, begin
      have h3 := p₃.2, simp only [set.mem_to_finset, set.mem_set_of_eq] at h3,
      rw [←h3.1], simp_rw [←h3.2], exact p₃.1.add_eq,
    end⟩).comp ((C.D p₁.1 (a.next p₁.1) (b.next p₁.2) (b.next p₁.2)).comp (C.D p₁.1 p₁.1 p₁.2 (b.next p₁.2))) :=
begin
  rw total_d_comp_d_eq_2_sums.fst_eq3;
  try { assumption },
  refine finset.sum_congr rfl _,
  rintros ⟨p₃, hp3⟩ -,
  simp only [set.mem_to_finset, set.mem_set_of_eq] at hp3,
  have add_eq1 : (p₁.fst+[a,b,c]b.next p₁.snd) = k₂,
  { have add_eq3 := p₃.add_eq,
    rw [hp3.1, hp3.2] at add_eq3,
    rw ← add_eq3 at hc23,
    rw ← p₁.add_eq at hc12,
    exact (has_hadd.squeeze' _ _ _ hc12 hc23).2.symm,
  },
  have EQ : {p' : diagonal a b c k₂ | p'.fst = p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset =
    {⟨p₁.1, b.next p₁.2, add_eq1⟩},
  { ext1 p₂,
    simp only [set.mem_to_finset, set.mem_set_of_eq, finset.mem_singleton],
    split,
    { rintros ⟨h1, h2⟩, simp_rw [←h1, ←h2], ext, { refl, }, { refl, } },
    { intros h, rw diagonal.ext_iff at h, exact ⟨h.1, h.2⟩, }, },
  rw [EQ, finset.sum_singleton],
end

lemma total_d_comp_d_eq_2_sums.snd_eq4 (k₁ k₂ k₃ : γ)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) (p₁ : diagonal a b c k₁)
  [∀ k, decidable_eq $ diagonal a b c k] :
  ∑ (p₂ : diagonal a b c k₂) in {p' : diagonal a b c k₂ | p'.snd = p₁.snd}.to_finset,
    ∑ (p₃ : diagonal a b c k₃) in {p' : diagonal a b c k₃ | p'.fst = p₂.fst}.to_finset,
      (C.total_at_embed c _ p₃).comp ((C.D p₂.1 p₃.1 p₂.2 p₃.2).comp (C.D p₁.1 p₂.1 p₁.2 p₂.2)) =
  ∑ p₃ in {p' : diagonal a b c k₃ | p'.fst = a.next p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset.attach,
    (C.total_at_embed c _ ⟨a.next p₁.1, b.next p₁.2, begin
      have h3 := p₃.2, simp only [set.mem_to_finset, set.mem_set_of_eq] at h3,
      rw [←h3.1], simp_rw [←h3.2], exact p₃.1.add_eq,
    end⟩).comp ((C.D (a.next p₁.1) (a.next p₁.1) p₁.2 (b.next p₁.2)).comp (C.D p₁.1 (a.next p₁.1) p₁.2 p₁.2)) :=
begin
  rw total_d_comp_d_eq_2_sums.snd_eq3;
  try { assumption },
  refine finset.sum_congr rfl _,
  rintros ⟨p₃, hp3⟩ -,
  simp only [set.mem_to_finset, set.mem_set_of_eq] at hp3,
  have add_eq1 : (a.next p₁.fst +[a,b,c] p₁.snd) = k₂,
  { have add_eq3 := p₃.add_eq,
    rw [hp3.1, hp3.2] at add_eq3,
    rw ← add_eq3 at hc23,
    rw ← p₁.add_eq at hc12,
    exact (has_hadd.squeeze' _ _ _ hc12 hc23).1.symm,
  },
  have EQ : {p' : diagonal a b c k₂ | p'.fst = a.next p₁.fst ∧ p'.snd = p₁.snd}.to_finset =
    {⟨a.next p₁.1, p₁.2, add_eq1⟩},
  { ext1 p₂,
    simp only [set.mem_to_finset, set.mem_set_of_eq, finset.mem_singleton],
    split,
    { rintros ⟨h1, h2⟩, simp_rw [←h1, ←h2], ext, { refl, }, { refl, } },
    { intros h, rw diagonal.ext_iff at h, exact ⟨h.1, h.2⟩, }, },
  rw [EQ, finset.sum_singleton],
end

lemma total_d_comp_d_eq_2_sums' (k₁ k₂ k₃ : γ) (c_ir : c.irrefl)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) [∀ k, decidable_eq $ diagonal a b c k] :
  (C.total_d c k₂ k₃).comp (C.total_d c k₁ k₂) =
  direct_sum.to_module _ _ _ (λ p₁,
    (∑ p₃ in {p' : diagonal a b c k₃ | p'.fst = a.next p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset.attach,
      (C.total_at_embed c _ ⟨a.next p₁.fst, b.next p₁.snd, begin
        have h3 := p₃.2, simp only [set.mem_to_finset, set.mem_set_of_eq] at h3,
        rw [←h3.1], simp_rw [←h3.2], exact p₃.1.add_eq,
      end⟩).comp ((C.D p₁.1 (a.next p₁.1) (b.next p₁.2) (b.next p₁.2)).comp (C.D p₁.1 p₁.1 p₁.2 (b.next p₁.2)))) +
    (∑ p₃ in {p' : diagonal a b c k₃ | p'.fst = a.next p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset.attach,
      (C.total_at_embed c _ ⟨a.next p₁.1, b.next p₁.2, begin
        have h3 := p₃.2, simp only [set.mem_to_finset, set.mem_set_of_eq] at h3,
        rw [←h3.1], simp_rw [←h3.2], exact p₃.1.add_eq,
      end⟩).comp ((C.D (a.next p₁.1) (a.next p₁.1) p₁.2 (b.next p₁.2)).comp (C.D p₁.1 (a.next p₁.1) p₁.2 p₁.2)))) :=
begin
  rw total_d_comp_d_eq_2_sums;
  try { assumption },
  congr' 1,
  ext p₁ : 1,
  congr' 1,
  { rw [total_d_comp_d_eq_2_sums.fst_eq4];
    assumption },
  { rw [total_d_comp_d_eq_2_sums.snd_eq4];
    assumption },
end

lemma total_d_comp_d_eq_single_sum (k₁ k₂ k₃ : γ) (c_ir : c.irrefl)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) [∀ k, decidable_eq $ diagonal a b c k] :
  (C.total_d c k₂ k₃).comp (C.total_d c k₁ k₂) =
  direct_sum.to_module _ _ _ (λ p₁,
    (∑ p₃ in {p' : diagonal a b c k₃ | p'.fst = a.next p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset.attach,
      ((C.total_at_embed c _ ⟨a.next p₁.fst, b.next p₁.snd, begin
        have h3 := p₃.2, simp only [set.mem_to_finset, set.mem_set_of_eq] at h3,
        rw [←h3.1], simp_rw [←h3.2], exact p₃.1.add_eq,
      end⟩).comp ((C.D p₁.1 (a.next p₁.1) (b.next p₁.2) (b.next p₁.2)).comp (C.D p₁.1 p₁.1 p₁.2 (b.next p₁.2))) +
      (C.total_at_embed c _ ⟨a.next p₁.1, b.next p₁.2, begin
          have h3 := p₃.2, simp only [set.mem_to_finset, set.mem_set_of_eq] at h3,
          rw [←h3.1], simp_rw [←h3.2], exact p₃.1.add_eq,
        end⟩).comp ((C.D (a.next p₁.1) (a.next p₁.1) p₁.2 (b.next p₁.2)).comp (C.D p₁.1 (a.next p₁.1) p₁.2 p₁.2))))) :=
begin
  rw total_d_comp_d_eq_2_sums';
  try { assumption },
  congr' 1,
  ext1 p₁,
  rw finset.sum_add_distrib,
end

lemma total_d_comp_d_eq_single_sum' (k₁ k₂ k₃ : γ) (c_ir : c.irrefl)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) [∀ k, decidable_eq $ diagonal a b c k] :
  (C.total_d c k₂ k₃).comp (C.total_d c k₁ k₂) =
  direct_sum.to_module _ _ _ (λ p₁,
    (∑ p₃ in {p' : diagonal a b c k₃ | p'.fst = a.next p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset.attach,
      ((C.total_at_embed c _ ⟨a.next p₁.fst, b.next p₁.snd, begin
        have h3 := p₃.2, simp only [set.mem_to_finset, set.mem_set_of_eq] at h3,
        rw [←h3.1], simp_rw [←h3.2], exact p₃.1.add_eq,
      end⟩).comp
        (((C.D p₁.1 (a.next p₁.1) (b.next p₁.2) (b.next p₁.2)).comp (C.D p₁.1 p₁.1 p₁.2 (b.next p₁.2))) +
         ((C.D (a.next p₁.1) (a.next p₁.1) p₁.2 (b.next p₁.2)).comp (C.D p₁.1 (a.next p₁.1) p₁.2 p₁.2)))))) :=
begin
  rw total_d_comp_d_eq_single_sum;
  try { assumption },
  congr' 1,
  ext1 p₁,
  refine finset.sum_congr rfl _,
  rintros ⟨p₂, hp2⟩ -,
  rw linear_map.comp_add,
end

lemma total_d_comp_d_eq_single_sum'' (k₁ k₂ k₃ : γ) (c_ir : c.irrefl)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) [∀ k, decidable_eq $ diagonal a b c k] :
  (C.total_d c k₂ k₃).comp (C.total_d c k₁ k₂) =
  direct_sum.to_module _ _ _ (λ p₁,
    (∑ p₃ in {p' : diagonal a b c k₃ | p'.fst = a.next p₁.fst ∧ p'.snd = b.next p₁.snd}.to_finset.attach,
      ((C.total_at_embed c _ ⟨a.next p₁.fst, b.next p₁.snd, begin
        have h3 := p₃.2, simp only [set.mem_to_finset, set.mem_set_of_eq] at h3,
        rw [←h3.1], simp_rw [←h3.2], exact p₃.1.add_eq,
      end⟩).comp
        (((C.d_v (b.next p₁.2) p₁.1 (a.next p₁.1)).comp (C.d_h p₁.1 p₁.2 (b.next p₁.2))) +
         ((C.d_h (a.next p₁.1) p₁.2 (b.next p₁.2)).comp (C.d_v p₁.2 p₁.1 (a.next p₁.1))))))) :=
begin
  rw total_d_comp_d_eq_single_sum';
  try { assumption },
  congr' 1,
  ext1 p₁,
  refine finset.sum_congr rfl _,
  rintros ⟨p₂, hp2⟩ -,
  simp only [set.mem_to_finset, set.mem_set_of_eq] at hp2,
  have hc12' := hc12,
  have hc23' := hc23,
  rw [← p₂.add_eq, hp2.1, hp2.2] at hc23,
  rw [← p₁.add_eq] at hc12,
  have hk2 := has_hadd.squeeze' _ _ _ hc12 hc23,
  have h1 : p₁.fst ≠ a.next p₁.fst,
  { intro rid,
    rw [← rid] at hk2,
    simp_rw ← p₁.add_eq at hk2,
    suffices : k₂ = k₁,
    { rw this at hc12',
      refine c_ir.ne hc12' rfl, },
    rw [hk2.1, p₁.add_eq], },
  congr' 3;
  rw [D],
  { rw [dif_neg h1, dif_pos rfl, eq_to_hom_refl, comp_id], },
  { rw [dif_pos rfl, eq_to_hom_refl, comp_id], },
  { rw [dif_pos rfl, eq_to_hom_refl, comp_id], },
  { rw [dif_neg h1, dif_pos rfl, eq_to_hom_refl, comp_id], },
end

lemma total_d_comp_d_eq_0' (k₁ k₂ k₃ : γ) (c_ir : c.irrefl)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) [∀ k, decidable_eq $ diagonal a b c k] :
  (C.total_d c k₂ k₃).comp (C.total_d c k₁ k₂) =
  direct_sum.to_module _ _ _ (λ p₁, 0) :=
begin
  rw total_d_comp_d_eq_single_sum'';
  try { assumption },
  congr' 1,
  ext p₁ : 1,
  refine finset.sum_eq_zero _,
  rintros ⟨p₃, hp3⟩ -,
  convert linear_map.comp_zero _,
  work_on_goal 2 { exact ring_hom_comp_triple.ids, },
  change (C.d_h p₁.fst p₁.snd (b.next p₁.snd) ≫ C.d_v (b.next p₁.snd) p₁.fst (a.next p₁.fst)) +
    (C.d_v p₁.snd p₁.fst (a.next p₁.fst) ≫ C.d_h (a.next p₁.fst) p₁.snd (b.next p₁.snd)) = 0,
  exact C.anticomm _ _ _ _,
end

lemma total_d_comp_d' (k₁ k₂ k₃ : γ) (c_ir : c.irrefl)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) [∀ k, decidable_eq $ diagonal a b c k] :
  (C.total_d c k₂ k₃).comp (C.total_d c k₁ k₂) = 0 :=
begin
  rw total_d_comp_d_eq_0';
  try { assumption },
  apply direct_sum.linear_map_ext,
  intros p₁,
  rw [linear_map.zero_comp],
  ext1 x,
  simp only [linear_map.comp_apply, linear_map.zero_apply, direct_sum.to_module_lof],
end

lemma total_d_comp_d (k₁ k₂ k₃ : γ) (c_ir : c.irrefl)
  (hc12 : c.rel k₁ k₂) (hc23 : c.rel k₂ k₃) [∀ k, decidable_eq $ diagonal a b c k] :
  (C.total_d c k₁ k₂) ≫ (C.total_d c k₂ k₃) = 0 :=
C.total_d_comp_d' c k₁ k₂ k₃ c_ir hc12 hc23

lemma total_d_shape' (a_ir : a.irrefl) (b_ir : b.irrefl) (hc : ¬ c.rel k k') [Π (k : γ), decidable_eq (diagonal a b c k)] :
  C.total_d c k k' = 0 :=
begin
  rw [total_d],
  apply direct_sum.linear_map_ext,
  intros p,
  ext1 x,
  simp only [linear_map.comp_apply, linear_map.zero_apply, direct_sum.to_module_lof,
    linear_map.zero_comp, linear_map.sum_apply],
  refine finset.sum_eq_zero (λ p' hp', _),
  simp only [set.finite.mem_to_finset, set.mem_union, set.mem_set_of_eq] at hp',
  suffices : C.D p.fst p'.fst p.snd p'.snd = 0,
  { rw [this, linear_map.zero_apply, map_zero] },
  rcases hp' with (hp'|hp'),
  { rw [D, dif_pos hp'.symm, C.shape_h, zero_comp],
    contrapose! hc,
    rwa [← p.add_eq, ← p'.add_eq, hp', ← has_hadd.rel_v'], },
  { rw [D_eq_of_eq_v C a_ir b_ir _ _ _ _ hp'.symm, C.shape_v, zero_comp],
    { contrapose! hc,
      rwa [← p.add_eq, ← p'.add_eq, hp', ← has_hadd.rel_h'], }, },
end

/--
The total complex associated with a double complex by taking direct sums.
-/
@[simps]
def total_complex (a_ir : a.irrefl) (b_ir : b.irrefl) (c_ir : c.irrefl)
  [Π (k : γ), decidable_eq (diagonal a b c k)] :
  homological_complex (Module R) c :=
{ X := C.total_at c,
  d := λ i j, C.total_d c i j,
  shape' := λ i j hc, C.total_d_shape' c i j a_ir b_ir hc,
  d_comp_d' := λ i j k h1 h2, C.total_d_comp_d c i j k c_ir h1 h2 }

end

end homological_bicomplex