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

import ..test

noncomputable theory

universes v u

open category_theory category_theory.category category_theory.limits

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

section

def complex_shape.not_rfl (a : complex_shape α) : Prop :=
∀ (i : α), ¬ a.rel i i

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

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)
(comm' : ∀ (i₁ i₂ : α) (j₁ j₂ : β), a.rel i₁ i₂ → b.rel j₁ j₂ →
  d_v j₁ i₁ i₂ ≫ d_h i₂ j₁ j₂ = d_h i₁ j₁ j₂ ≫ d_v j₂ i₁ i₂)

end

namespace homological_bicomplex

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

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

class has_sign :=
(sign : α → zmod 2)
(rel : ∀ (i i' : α), a.rel i i' → sign i = - (sign i'))

section

instance [has_sign a] (T : Type*) [has_neg T] : has_smul α T :=
{ smul := λ x f, if has_sign.sign a x = 0 then f else - f }

lemma has_sign.smul_zero [has_sign a] (T : Type*) [add_comm_group T]
  (x : α) : x • (0 : T) = 0 :=
begin
  dunfold has_smul.smul,
  dsimp,
  split_ifs;
  abel,
end

lemma has_sign.smul_eq_zero [has_sign a] (T : Type*) [add_comm_group T] (x : α) (t : T) :
  x • t = 0 ↔ t = 0 :=
begin
  split,
  { intros h,
    dunfold has_smul.smul at h,
    dsimp at h,
    split_ifs at h,
    { exact h },
    { rwa neg_eq_zero at h, }, },
  { rintro rfl, rw has_sign.smul_zero }
end

lemma has_sign.smul_comp [has_sign a] [preadditive V] (i : α)
  {v₁ v₂ v₃ : V} (f : v₁ ⟶ v₂) (g : v₂ ⟶ v₃) :
  (i • f) ≫ g = i • (f ≫ g) :=
begin
  dunfold has_smul.smul,
  dsimp,
  split_ifs,
  { refl },
  { rw preadditive.neg_comp },
end

local attribute [instance] concrete_category.has_coe_to_fun
local attribute [instance] concrete_category.has_coe_to_sort

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₂)
(balanced' : ∀ (i : α) (j : β) (k' : γ), c.rel (add' i j) k' →
  ((∃ j', k' = add' i j') ↔ (∃ i', k' = add' i' j)))

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

variables {a b c} [decidable_eq α] [decidable_eq β] [decidable_eq γ]

def D_h (C : homological_bicomplex V a b) (i₁ i₂ : α) (j₁ j₂ : β) :
  C.X i₁ j₁ ⟶ C.X i₂ j₂ :=
C.d_h i₁ j₁ j₂ ≫ if h : i₁ = i₂ then eq_to_hom (by rw h) else 0

def D_v (C : homological_bicomplex V a b) (i₁ i₂ : α) (j₁ j₂ : β) :
  C.X i₁ j₁ ⟶ C.X i₂ j₂ :=
C.d_v j₁ i₁ i₂ ≫ if h : j₁ = j₂ then eq_to_hom (by rw h) else 0

@[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
  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

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

lemma D_v_of_ne (C : homological_bicomplex V a b)
  (i₁ i₂ : α) (j₁ j₂ : β) (h : j₁ ≠ j₂) :
  C.D_v i₁ i₂ j₁ j₂ = 0 :=
by rw [D_v, dif_neg h, comp_zero]

lemma D_comp_D_v (C : homological_bicomplex V a b)
  (i₁ i₂ i₃ : α) (j₁ j₂ j₃ : β) :
  C.D_v i₁ i₂ j₁ j₂ ≫ C.D_v i₂ i₃ j₂ j₃ = 0 :=
begin
  rw [D_v, D_v],
  split_ifs with h1 h2,
  { substs h1 h2,
    rw [eq_to_hom_refl, eq_to_hom_refl, comp_id, comp_id, d_comp_d_v], },
  all_goals { simp only [comp_zero, zero_comp], },
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

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

lemma D_h_of_ne (C : homological_bicomplex V a b)
  (i₁ i₂ : α) (j₁ j₂ : β) (h : i₁ ≠ i₂) :
  C.D_h i₁ i₂ j₁ j₂ = 0 :=
by rw [D_h, dif_neg h, comp_zero]

lemma D_comp_D_h (C : homological_bicomplex V a b)
  (i₁ i₂ i₃ : α) (j₁ j₂ j₃ : β) :
  C.D_h i₁ i₂ j₁ j₂ ≫ C.D_h i₂ i₃ j₂ j₃ = 0 :=
begin
  rw [D_h, D_h],
  split_ifs with h1 h2,
  { substs h1 h2,
    rw [eq_to_hom_refl, eq_to_hom_refl, comp_id, comp_id, d_comp_d_h], },
  all_goals { simp only [comp_zero, zero_comp], },
end

@[simps]
def vertical_component (C : homological_bicomplex V a b) (j : β) : homological_complex V a :=
{ X := λ i, C.X i j,
  d := C.d_v j,
  shape' := λ _ _ h, C.shape_v _ _ _ h,
  d_comp_d' := λ _ _ _ _ _, C.d_comp_d_v _ _ _ _ }

@[simps]
def vertical_component_map (C : homological_bicomplex V a b) (j₁ j₂ : β) :
  C.vertical_component j₁ ⟶ C.vertical_component j₂ :=
{ f := λ i, C.d_h i j₁ j₂,
  comm' :=
  begin
    intros i₁ i₂ h₁₂,
    dsimp,
    by_cases H : b.rel j₁ j₂,
    { exact (C.comm i₁ i₂ j₁ j₂ h₁₂ H).symm, },
    { rw [C.shape_h _ _ _ H, C.shape_h _ _ _ H, zero_comp, comp_zero], },
  end }

@[simps]
def as_vertical_complex (C : homological_bicomplex V a b) :
  homological_complex (homological_complex V a) b :=
{ X := C.vertical_component,
  d := C.vertical_component_map,
  shape' := λ j₁ j₂ h₁₂,
  begin
    ext i,
    simpa only [vertical_component_map_f, homological_complex.zero_apply] using C.shape_h _ _ _ h₁₂,
  end,
  d_comp_d' := by { intros, ext, simp } }

@[simps]
def horizontal_component (C : homological_bicomplex V a b) (i : α) : homological_complex V b :=
{ X := C.X i,
  d := C.d_h i,
  shape' := λ _ _ h, C.shape_h _ _ _ h,
  d_comp_d' := λ _ _ _ _ _, C.d_comp_d_h _ _ _ _ }

@[simps]
def horizontal_component_map (C : homological_bicomplex V a b) (i₁ i₂ : α) :
  C.horizontal_component i₁ ⟶ C.horizontal_component i₂ :=
{ f := λ j, C.d_v j i₁ i₂,
  comm' :=
  begin
    intros j₁ j₂ h₁₂,
    dsimp,
    by_cases H : a.rel i₁ i₂,
    { exact C.comm _ _ _ _ H h₁₂, },
    { rw [C.shape_v _ _ _ H, C.shape_v _ _ _ H, zero_comp, comp_zero], },
  end }

@[simps]
def as_horizontal_complex (C : homological_bicomplex V a b) :
  homological_complex (homological_complex V b) a :=
{ X := C.horizontal_component,
  d := C.horizontal_component_map,
  shape' := λ i₁ i₂ h₁₂,
  begin
    ext j,
    simpa only [horizontal_component_map_f, homological_complex.zero_apply] using
      C.shape_v _ _ _ h₁₂,
  end,
  d_comp_d' := by { intros, ext, simp } }

section

variables {R : Type*} [comm_ring R] (C : homological_bicomplex (Module R) a b)
variables (a b c)

@[ext]
structure diagonal (k : γ) :=
(fst : α) (snd : β) (add_eq : (fst +[a, b, c] snd) = k)

open_locale direct_sum big_operators

variables {a b} [∀ k, decidable_eq $ diagonal a b c k]
def total_at (j : γ) : Module R :=
Module.of R $ ⨁ (p : diagonal a b c j), C.X p.fst p.snd

variables [∀ (k' : γ) (i : α), decidable (∃ (j : β), c.rel (i+[a,b,c]j) k')]

def total_d [has_sign a] (k k' : γ) :
  C.total_at c k ⟶ C.total_at c k' :=
direct_sum.to_module _ _ _ $ λ p,
∑ᶠ (q : diagonal a b c k'),
  (direct_sum.lof R _ _ q).comp
    (C.D_h p.fst q.fst p.snd q.snd + p.fst • C.D_v p.fst q.fst p.snd q.snd)

lemma total_d_aux.finsupp_aux
  [has_sign a] (k₁ k₂ : γ) (p : diagonal a b c k₁) (q : diagonal a b c k₂) :
  (direct_sum.lof R _ _ q).comp
    (C.D_h p.fst q.fst p.snd q.snd + p.fst • C.D_v p.fst q.fst p.snd q.snd) = 0 ↔
  (C.D_h p.fst q.fst p.snd q.snd + p.fst • C.D_v p.fst q.fst p.snd q.snd) = 0 :=
begin
  split,
  { intros h,
    ext1 x,
    have EQ0 := fun_like.congr_fun h x,
    rw [linear_map.zero_apply, linear_map.comp_apply,
      linear_map.add_apply, direct_sum.ext_iff R] at EQ0,
    work_on_goal 2 { intros i, apply_instance, },
    specialize EQ0 q,
    rw [direct_sum.component.lof_self] at EQ0,
    rw [linear_map.add_apply, EQ0, map_zero, linear_map.zero_apply], },
  { intro h, rw [h, linear_map.comp_zero],},
end

lemma total_d_aux.finsupp_aux'
  [has_sign a] (k₁ k₂ : γ) (p : diagonal a b c k₁) (q : diagonal a b c k₂) :
  (direct_sum.lof R _ _ q).comp
    (C.D_h p.fst q.fst p.snd q.snd + p.fst • C.D_v p.fst q.fst p.snd q.snd) ≠ 0 ↔
  (C.D_h p.fst q.fst p.snd q.snd + p.fst • C.D_v p.fst q.fst p.snd q.snd) ≠ 0 :=
begin
  split,
  { contrapose!, rw total_d_aux.finsupp_aux, exact id },
  { contrapose!, rw total_d_aux.finsupp_aux, exact id },
end

lemma total_d_aux.finsupp_case0_aux [has_sign a] (k₁ k₂ : γ) (p : diagonal a b c k₁)
  (hc : ¬ c.rel k₁ k₂) (q : diagonal a b c k₂) :
  (direct_sum.lof R _ _ q).comp
    (C.D_h p.fst q.fst p.snd q.snd + p.fst • C.D_v p.fst q.fst p.snd q.snd) = 0 :=
begin
  rw [show C.D_h p.fst q.fst p.snd q.snd = 0,
  begin
    rw [D_h],
    split_ifs,
    { rw [C.shape_h, zero_comp],
      contrapose! hc,
      have EQ := (has_hadd.rel_v' _ _ _).mp hc,
      rwa [p.add_eq, h, q.add_eq] at EQ, },
    { rw comp_zero, },
  end, show C.D_v p.fst q.fst p.snd q.snd = 0,
  begin
    rw [D_v],
    split_ifs,
    { rw [C.shape_v, zero_comp],
      contrapose! hc,
      have EQ := (has_hadd.rel_h' _ _ _).mp hc,
      rwa [p.add_eq, h, q.add_eq] at EQ, },
    { rw comp_zero },
  end, zero_add, has_sign.smul_zero, linear_map.comp_zero],
end

lemma total_d_aux.finsupp_case0 [has_sign a] (j₁ j₂ : γ) (p : diagonal a b c j₁)
  (hc : ¬ c.rel j₁ j₂) :
(function.support (λ (i : diagonal a b c j₂),
  (direct_sum.lof R (diagonal a b c j₂) (λ (i : diagonal a b c j₂), (C.X i.fst i.snd)) i).comp
    (C.D_h p.fst i.fst p.snd i.snd + p.fst • C.D_v p.fst i.fst p.snd i.snd))).finite :=
begin
  convert set.finite_empty,
  rw function.support_eq_empty_iff,
  ext1,
  apply total_d_aux.finsupp_case0_aux,
  assumption
end

lemma total_d_aux.finsupp_case1_aux0
  [has_sign a] (a_not_rfl : a.not_rfl)
  (k₁ k₂ : γ)
  (p : diagonal a b c k₁)
  (hc : c.rel k₁ k₂) (q : diagonal a b c k₂)
  (ha : a.rel p.fst q.fst)  :
  C.D_h p.fst q.fst p.snd q.snd + p.fst • C.D_v p.fst q.fst p.snd q.snd =
  p.fst • C.D_v p.fst q.fst p.snd q.snd :=
begin
  rw [D_h, dif_neg (a_not_rfl.ne ha), comp_zero, zero_add],
end

lemma total_d_aux.finsupp_case1_aux1
  [has_sign a] (b_not_rfl : b.not_rfl)
  (k₁ k₂ : γ)
  (p : diagonal a b c k₁)
  (hc : c.rel k₁ k₂) (q : diagonal a b c k₂)
  (hb : b.rel p.snd q.snd) :
  C.D_h p.fst q.fst p.snd q.snd + p.fst • C.D_v p.fst q.fst p.snd q.snd =
  C.D_h p.fst q.fst p.snd q.snd :=
begin
  rw [D_v, dif_neg (b_not_rfl.ne hb), comp_zero, has_sign.smul_zero, add_zero],
end

lemma total_d_aux.finsupp_case1_aux2
  [has_sign a] (a_not_rfl : a.not_rfl) (b_not_rfl : b.not_rfl)
  (k₁ k₂ : γ)
  (p : diagonal a b c k₁)
  (hc : c.rel k₁ k₂) (q : diagonal a b c k₂)
  (heq : C.D_h p.fst q.fst p.snd q.snd + p.fst • C.D_v p.fst q.fst p.snd q.snd ≠ 0) :
  a.rel p.fst q.fst ∨ b.rel p.snd q.snd :=
begin
  rcases p with ⟨i₁, j₁, h₁⟩,
  rcases q with ⟨i₂, j₂, h₂⟩,
  dsimp at *,
  by_cases ha : i₁ = i₂,
  { subst ha,
    rw [D_h_of_eq _ _ _ _ _ rfl, eq_to_hom_refl, comp_id] at heq,
    rw [←h₁, ←h₂] at hc,
    right,
    exact (has_hadd.rel_v' _ _ _).mpr hc, },
  { rw [C.D_h_of_ne _ _ _ _ ha, zero_add, has_sign.smul_eq_zero, D_v] at heq,
    split_ifs at heq,
    { subst h,
      rw [←h₁, ←h₂] at hc,
      left,
      exact (has_hadd.rel_h' _ _ _).mpr hc, },
    { rw [comp_zero] at heq,
      exact (heq rfl).elim, } },
end

lemma total_d_aux.finsupp_case1_aux3
  [has_sign a] (a_not_rfl : a.not_rfl) (b_not_rfl : b.not_rfl)
  (k₁ k₂ : γ)
  (p : diagonal a b c k₁)
  (hc : c.rel k₁ k₂) (q : diagonal a b c k₂)
  (heq : C.D_h p.fst q.fst p.snd q.snd + p.fst • C.D_v p.fst q.fst p.snd q.snd ≠ 0) :
  q.fst = p.fst ∨ q.snd = p.snd :=
begin
  obtain (h|h) := total_d_aux.finsupp_case1_aux2 c C a_not_rfl b_not_rfl
    k₁ k₂ p hc q heq;
  rcases p with ⟨i₁, j₁, h₁⟩;
  rcases q with ⟨i₂, j₂, h₂⟩;
  dsimp at *;
  rw [←h₁, ←h₂] at hc,
  { right,
    rw (has_hadd.add_cancel_v' _ _ _).mp (c.next_eq hc ((has_hadd.rel_h' i₁ i₂ j₁).mp h)), },
  { left,
    rw (has_hadd.add_cancel_h' _ _ _).mp (c.next_eq hc ((has_hadd.rel_v' i₁ j₁ j₂).mp h)), },
end

lemma total_d_aux.finsupp_case1
  [has_sign a] (a_not_rfl : a.not_rfl) (b_not_rfl : b.not_rfl)
  (k₁ k₂ : γ)
  (p : diagonal a b c k₁)
  (hc : c.rel k₁ k₂) :
(function.support (λ (i : diagonal a b c k₂),
  (direct_sum.lof R (diagonal a b c k₂) (λ i, (C.X i.fst i.snd)) i).comp
    (C.D_h p.fst i.fst p.snd i.snd + p.fst • C.D_v p.fst i.fst p.snd i.snd))).finite :=
begin
  rcases p with ⟨i₁, j₁, h₁⟩,
  rw function.support,
  simp_rw [total_d_aux.finsupp_aux'],
  dsimp,
  have subset1 : {x : diagonal a b c k₂ | ¬C.D_h i₁ x.fst j₁ x.snd + i₁ • C.D_v i₁ x.fst j₁ x.snd = 0} ⊆
    {x : diagonal a b c k₂ | x.fst = i₁ ∨ x.snd = j₁},
  { intros q hq,
    simp only [set.mem_set_of_eq] at hq,
    obtain (H|H) := total_d_aux.finsupp_case1_aux3 c C a_not_rfl b_not_rfl _ _ ⟨i₁, j₁, h₁⟩ hc q hq,
    { left, assumption },
    { right, assumption } },
  have finite1 : set.finite {x : diagonal a b c k₂ | x.fst = i₁ ∨ x.snd = j₁},
  { rw show {x : diagonal a b c k₂ | x.fst = i₁ ∨ x.snd = j₁} =
    {x : diagonal a b c k₂ | x.fst = i₁} ∪ {x : diagonal a b c k₂ | x.snd = j₁}, from rfl,
    refine set.finite.union _ _,
    { refine set.subsingleton.finite _,
      rintros ⟨i₂, j₂, h₂⟩ H₂ ⟨i₂', j₂', h₂'⟩ H₂',
      simp only [set.mem_set_of_eq] at H₂ H₂',
      substs H₂ H₂',
      ext,
      { refl, },
      { dsimp,
        rwa [← h₂', has_hadd.add_cancel_v'] at h₂, }, },
    { refine set.subsingleton.finite _,
      rintros ⟨i₂, j₂, h₂⟩ H₂ ⟨i₂', j₂', h₂'⟩ H₂',
      simp only [set.mem_set_of_eq] at H₂ H₂',
      substs H₂ H₂',
      ext,
      { dsimp,
        rwa [← h₂', has_hadd.add_cancel_h'] at h₂, },
      { refl, }, }, },
  exact finite1.subset subset1,
end

lemma total_d_aux.left_finite (k₁ k₂) (p : diagonal a b c k₁) :
  {x : diagonal a b c k₂ | x.fst = p.1}.finite :=
begin
  refine set.subsingleton.finite _,
  rintros ⟨i₂, j₂, h₂⟩ H₂ ⟨i₂', j₂', h₂'⟩ H₂',
  simp only [set.mem_set_of_eq] at H₂ H₂',
  substs H₂ H₂',
  ext,
  { refl, },
  { dsimp,
    rwa [← h₂', has_hadd.add_cancel_v'] at h₂, },
end

instance total_d_aux.left_subsingleton (k₁ k₂) (p : diagonal a b c k₁) :
  subsingleton (total_d_aux.left_finite _ k₁ k₂ p).to_finset :=
begin
  fconstructor,
  rintros ⟨⟨i₂, j₂, h₂⟩, H₂⟩ ⟨⟨i₂', j₂', h₂'⟩, H₂'⟩,
  simp only [set.mem_set_of_eq, set.finite.mem_to_finset] at H₂ H₂',
  substs H₂ H₂',
  ext,
  { refl, },
  { dsimp,
    rwa [← h₂', has_hadd.add_cancel_v'] at h₂, },
end

lemma total_d_aux.right_finite (k₁ k₂) (p : diagonal a b c k₁) :
  {x : diagonal a b c k₂ | x.snd = p.2}.finite :=
begin
  refine set.subsingleton.finite _,
  rintros ⟨i₂, j₂, h₂⟩ H₂ ⟨i₂', j₂', h₂'⟩ H₂',
  simp only [set.mem_set_of_eq] at H₂ H₂',
  substs H₂ H₂',
  ext,
  { dsimp,
    rwa [← h₂', has_hadd.add_cancel_h'] at h₂, },
  { refl, },
end

instance total_d_aux.right_subsingleton (k₁ k₂) (p : diagonal a b c k₁) :
  subsingleton (total_d_aux.right_finite _ k₁ k₂ p).to_finset :=
begin
  fconstructor,
  rintros ⟨⟨i₂, j₂, h₂⟩, H₂⟩ ⟨⟨i₂', j₂', h₂'⟩, H₂'⟩,
  simp only [set.finite.mem_to_finset, set.mem_set_of_eq] at H₂ H₂',
  substs H₂ H₂',
  ext,
  { dsimp,
    rwa [← h₂', has_hadd.add_cancel_h'] at h₂, },
  { refl, },
end

lemma total_d_aux.union_finite (k₁ k₂) (p : diagonal a b c k₁) :
  ({x : diagonal a b c k₂ | x.fst = p.1} ∪ {x : diagonal a b c k₂ | x.snd = p.2}).finite :=
begin
  refine set.finite.union _ _,
  { apply total_d_aux.left_finite },
  { apply total_d_aux.right_finite },
end

lemma total_d_aux.finsupp_subset
  [has_sign a] (a_not_rfl : a.not_rfl) (b_not_rfl : b.not_rfl)
  (k₁ k₂ : γ)
  (p : diagonal a b c k₁) :
(function.support (λ (i : diagonal a b c k₂),
  (direct_sum.lof R (diagonal a b c k₂) (λ i, (C.X i.fst i.snd)) i).comp
    (C.D_h p.fst i.fst p.snd i.snd + p.fst • C.D_v p.fst i.fst p.snd i.snd))) ⊆
{x : diagonal a b c k₂ | x.fst = p.1 ∨ x.snd = p.2} :=
begin
  by_cases hc : (c.rel k₁ k₂),
  {  rcases p with ⟨i₁, j₁, h₁⟩,
    rw function.support,
    simp_rw [total_d_aux.finsupp_aux'],
    intros q hq,
    simp only [set.mem_set_of_eq] at hq,
    obtain (H|H) := total_d_aux.finsupp_case1_aux3 c C a_not_rfl b_not_rfl _ _ ⟨i₁, j₁, h₁⟩ hc q hq,
    { left, assumption },
    { right, assumption } },
  { convert set.empty_subset _,
    rw function.support_eq_empty_iff,
    ext1,
    apply total_d_aux.finsupp_case0_aux,
    assumption },
end

lemma total_d_aux.finsupp
  [has_sign a] (a_not_rfl : a.not_rfl) (b_not_rfl : b.not_rfl)
  (k₁ k₂ : γ)
  (p : diagonal a b c k₁) :
(function.support (λ (i : diagonal a b c k₂),
  (direct_sum.lof R (diagonal a b c k₂) (λ (i : diagonal a b c k₂), (C.X i.fst i.snd)) i).comp
    (C.D_h p.fst i.fst p.snd i.snd + p.fst • C.D_v p.fst i.fst p.snd i.snd))).finite :=
begin
  by_cases hc : c.rel k₁ k₂,
  { apply total_d_aux.finsupp_case1; assumption },
  { apply total_d_aux.finsupp_case0; assumption },
end

lemma total_d_eq_sum [has_sign a]
  (a_not_rfl : a.not_rfl) (b_not_rfl : b.not_rfl)
  (k k' : γ) :
  C.total_d c k k' =
direct_sum.to_module _ _ _ (λ p,
∑ (q : diagonal a b c k') in (total_d_aux.union_finite _ k k' p).to_finset,
  (direct_sum.lof R _ _ q).comp
    (C.D_h p.fst q.fst p.snd q.snd + p.fst • C.D_v p.fst q.fst p.snd q.snd)) :=
begin
  rw [total_d],
  congr' 1,
  ext1 p,
  rw finsum_eq_sum_of_support_subset,
  simp only [set.finite.coe_to_finset],
  apply total_d_aux.finsupp_subset;
  try { assumption },
end

lemma total_d_eq_sum' [has_sign a]
  (a_not_rfl : a.not_rfl) (b_not_rfl : b.not_rfl)
  (k k' : γ) :
  C.total_d c k k' =
direct_sum.to_module _ _ _ (λ p,
∑ (q : diagonal a b c k') in ((total_d_aux.left_finite _ k k' p).to_finset ∪ (total_d_aux.right_finite _ k k' p).to_finset),
  (direct_sum.lof R _ _ q).comp
    (C.D_h p.fst q.fst p.snd q.snd + p.fst • C.D_v p.fst q.fst p.snd q.snd)) :=
begin
  rw [total_d_eq_sum];
  try { assumption },
  congr' 1,
  ext1,
  refine finset.sum_congr _ _,
  { ext z,
    simp only [set.finite.mem_to_finset, set.mem_union, finset.mem_union], },
  { intros, refl, }
end

lemma total_d_eq_sum_of_rel [has_sign a]
  (a_not_rfl : a.not_rfl) (b_not_rfl : b.not_rfl) (c_not_rfl : c.not_rfl)
  (k k' : γ) (hc : c.rel k k') :
  C.total_d c k k' =
direct_sum.to_module _ _ _ (λ p,
∑ (q : diagonal a b c k') in ((total_d_aux.left_finite _ k k' p).to_finset.disj_union
  (total_d_aux.right_finite _ k k' p).to_finset)
  begin
    rw finset.disjoint_iff_inter_eq_empty,
    rw finset.eq_empty_iff_forall_not_mem,
    intros z hz,
    simp only [finset.mem_inter, set.finite.mem_to_finset, set.mem_set_of_eq] at hz,
    have := z.add_eq,
    rw [hz.1, hz.2, p.add_eq] at this,
    exact c_not_rfl.ne hc this,
  end,
  (direct_sum.lof R _ _ q).comp
    (C.D_h p.fst q.fst p.snd q.snd + p.fst • C.D_v p.fst q.fst p.snd q.snd)) :=
begin
  rw [total_d_eq_sum'];
  try { assumption },
  congr' 1,
  ext1,
  refine finset.sum_congr _ _,
  { ext z,
    simp only [finset.disj_union_eq_union], },
  { intros, refl, }
end

variables [∀ i k', decidable (∃ (q : diagonal a b c k'), q.fst = i)]
variables [∀ i k', decidable (∃ (q : diagonal a b c k'), q.snd = i)]

section

variables {c}

@[simps]
def diagonal.from_balancing1
  {k k' : γ} (p : diagonal a b c k) (hc : c.rel k k')
  (q : diagonal a b c k') (hq : q.1 = p.1) :
  diagonal a b c k' :=
{ fst := ((has_hadd.balanced' p.1 p.2 k' (by rwa p.add_eq : c.rel (p.1+[a,b,c]p.2) k')).mp
      ⟨q.2, by rw [← hq, q.add_eq]⟩).some,
  snd := p.2,
  add_eq := begin
    generalize_proofs h,
    exact h.some_spec.symm,
  end }

@[simps]
def diagonal.from_balancing1'
  {k k' : γ} (p : diagonal a b c k) (hc : c.rel k k')
  (q : diagonal a b c k') (hq : q.1 = p.1) :
  diagonal a b c k' :=
{ fst := a.next p.1,
  snd := p.2,
  add_eq := begin
    suffices :
    ((has_hadd.balanced' p.1 p.2 k' (by rwa p.add_eq : c.rel (p.1+[a,b,c]p.2) k')).mp
      ⟨q.2, by rw [← hq, q.add_eq]⟩).some = a.next p.1,
    { rw ← this,
      generalize_proofs h,
      exact h.some_spec.symm },
    generalize_proofs h,
    have : c.rel (p.1 +[a,b,c] p.2) (h.some +[a,b,c] p.snd),
    { rw p.add_eq,
      convert hc,
      exact h.some_spec.symm },
    rw ← has_hadd.rel_h' at this,
    rwa a.next_eq',
  end }

lemma diagonal.from_balancing1_uniq
  {k k' : γ} (p : diagonal a b c k) (hc : c.rel k k')
  (q : diagonal a b c k') (hq : q.1 = p.1)
  (q' : diagonal a b c k')
  (hq' : q'.2 = p.2) :
  p.from_balancing1 hc q hq = q' :=
begin
  ext,
  { dsimp,
    generalize_proofs h,
    have := h.some_spec,
    simp_rw ←q'.add_eq at this,
    simp_rw hq' at this,
    rw has_hadd.add_cancel_h' at this,
    convert this.symm,
    ext,
    rw [← hq', q'.add_eq], },
  { dsimp, rw [←hq'], }
end

lemma diagonal.from_balancing1_fst_eq {k k' : γ} (p : diagonal a b c k) (hc : c.rel k k')
  (q : diagonal a b c k') (hq : q.1 = p.1) :
  (p.from_balancing1 hc q hq).fst = a.next p.1 :=
begin
  rw p.from_balancing1_uniq hc q hq (p.from_balancing1' hc q hq) rfl,
  refl,
end

@[simps]
def diagonal.from_balancing2
  {k k' : γ} (p : diagonal a b c k) (hc : c.rel k k')
  (q : diagonal a b c k') (hq : q.2 = p.2) :
  diagonal a b c k' :=
{ fst := p.1,
  snd := ((has_hadd.balanced' p.1 p.2 k' (by rwa p.add_eq : c.rel (p.1+[a,b,c]p.2) k')).mpr
      ⟨q.1, by rw [← hq, q.add_eq]⟩).some,
  add_eq := begin
    generalize_proofs h,
    exact h.some_spec.symm,
  end }

lemma diagonal.from_balancing2_uniq
  {k k' : γ} (p : diagonal a b c k) (hc : c.rel k k')
  (q : diagonal a b c k') (hq : q.2 = p.2)
  (q' : diagonal a b c k')
  (hq' : q'.1 = p.1) :
  p.from_balancing2 hc q hq = q' :=
begin
  ext,
  { dsimp, rw [←hq'], },
  { dsimp,
    generalize_proofs h,
    have := h.some_spec,
    simp_rw ←q'.add_eq at this,
    simp_rw hq' at this,
    rw has_hadd.add_cancel_v' at this,
    convert this.symm,
    ext,
    rw [← hq', q'.add_eq], },
end

@[simps]
def diagonal.from_balancing2'
  {k k' : γ} (p : diagonal a b c k) (hc : c.rel k k')
  (q : diagonal a b c k') (hq : q.2 = p.2) :
  diagonal a b c k' :=
{ fst := p.1,
  snd := b.next p.2,
  add_eq := begin
    suffices :
    ((has_hadd.balanced' p.1 p.2 k' (by rwa p.add_eq : c.rel (p.1+[a,b,c]p.2) k')).mpr
      ⟨q.1, by rw [← hq, q.add_eq]⟩).some = b.next p.2,
    { rw ← this,
      generalize_proofs h,
      exact h.some_spec.symm },
    generalize_proofs h,
    have : c.rel (p.1 +[a,b,c] p.2) (p.1 +[a,b,c] h.some),
    { rw p.add_eq,
      convert hc,
      exact h.some_spec.symm },
    rw ← has_hadd.rel_v' at this,
    rwa b.next_eq',
  end }

lemma diagonal.from_balancing2_snd_eq {k k' : γ} (p : diagonal a b c k) (hc : c.rel k k')
  (q : diagonal a b c k') (hq : q.2 = p.2) :
  (p.from_balancing2 hc q hq).snd = b.next p.2 :=
begin
  rw p.from_balancing2_uniq hc q hq (p.from_balancing2' hc q hq) rfl,
  refl,
end

end

lemma total_d_eq_ite_of_rel [has_sign a]
  (a_not_rfl : a.not_rfl) (b_not_rfl : b.not_rfl) (c_not_rfl : c.not_rfl)
  (k k' : γ) (hc : c.rel k k') :
  C.total_d c k k' =
direct_sum.to_module _ _ _ (λ p,
  (if H : ∃ (q : diagonal a b c k'), q.1 = p.1
  then (direct_sum.lof R _ _ H.some).comp
    (C.D_h p.fst H.some.fst p.snd H.some.snd)
  else 0) +
  (if H : ∃ (q : diagonal a b c k'), q.2 = p.2
  then (direct_sum.lof R _ _ H.some).comp
    (p.fst • C.D_v p.fst H.some.fst p.snd H.some.snd)
  else 0)) :=
begin
  rw [total_d_eq_sum_of_rel];
  try { assumption },
  congr' 1,
  ext1 p,
  rw finset.sum_disj_union,
  congr' 1,
  { split_ifs with H,
    { rw ← finset.sum_attach,
      erw fintype.sum_subsingleton,
      work_on_goal 2
      { refine ⟨H.some, _⟩,
        simpa only [set.finite.mem_to_finset] using H.some_spec, },
      rw subtype.coe_mk,
      congr' 1,
      convert add_zero _,
      rw has_sign.smul_eq_zero,
      rw D_v_of_ne,
      intro rid,
      refine c_not_rfl.ne hc _,
      rw [← p.add_eq, ← H.some.add_eq, rid],
      congr' 1,
      exact H.some_spec.symm, },
    { convert finset.sum_empty,
      rw [finset.eq_empty_iff_forall_not_mem],
      intros x,
      contrapose! H,
      simp only [set.finite.mem_to_finset, set.mem_set_of_eq] at H,
      refine ⟨x, H⟩, }, },
  { split_ifs with H,
    { rw ← finset.sum_attach,
      erw fintype.sum_subsingleton,
      work_on_goal 2
      { refine ⟨H.some, _⟩,
        simpa only [set.finite.mem_to_finset] using H.some_spec, },
      rw subtype.coe_mk,
      congr' 1,
      convert zero_add _,
      rw D_h_of_ne,
      intro rid,
      refine c_not_rfl.ne hc _,
      rw [← p.add_eq, ← H.some.add_eq, rid],
      congr' 1,
      exact H.some_spec.symm, },
    { convert finset.sum_empty,
      rw [finset.eq_empty_iff_forall_not_mem],
      intros x,
      contrapose! H,
      simp only [set.finite.mem_to_finset, set.mem_set_of_eq] at H,
      refine ⟨x, H⟩, }, },
end

lemma has_sign.smul_apply [has_sign a] (i : α)
  {v₁ v₂ : Module R} (f : v₁ ⟶ v₂) (x)  :
  (i • f) x = i • (f x) :=
begin
  dunfold has_smul.smul,
  dsimp,
  split_ifs,
  { refl },
  { rw linear_map.neg_apply, },
end

lemma has_sign.map_smul [has_sign a] (i : α)
  {v₁ v₂ : Module R} (f : v₁ ⟶ v₂) (x)  :
  f (i • x) = i • (f x) :=
begin
  dunfold has_smul.smul,
  dsimp,
  split_ifs,
  { refl },
  { rw map_neg, },
end

lemma total_d_eq_ite_of_rel' [has_sign a]
  (a_not_rfl : a.not_rfl) (b_not_rfl : b.not_rfl) (c_not_rfl : c.not_rfl)
  (k k' : γ) (hc : c.rel k k') :
  C.total_d c k k' =
direct_sum.to_module _ _ _ (λ p,
  if H : ∃ (q : diagonal a b c k'), q.1 = p.1
  then (direct_sum.lof R _ _ H.some).comp
    (C.D_h p.fst H.some.fst p.snd H.some.snd) +
      (direct_sum.lof R _ _ (p.from_balancing1 hc H.some H.some_spec)).comp
    (p.fst • C.D_v p.fst (p.from_balancing1 hc H.some H.some_spec).fst p.snd
      (p.from_balancing1 hc H.some H.some_spec).snd)
  else 0) :=
begin
  rw [total_d_eq_ite_of_rel]; try { assumption },
  congr' 1,
  ext1 p,
  by_cases H : ∃ (q : diagonal a b c k'), q.fst = p.fst,
  { have H' : ∃ (q : diagonal a b c k'), q.snd = p.snd,
    { refine ⟨p.from_balancing1 hc H.some H.some_spec, rfl⟩, },
    rw [dif_pos H, dif_pos H', dif_pos H],
    congr' 1,
    suffices EQ : H'.some = p.from_balancing1 hc H.some H.some_spec,
    { rw EQ, },
    { symmetry,
      apply diagonal.from_balancing1_uniq,
      exact H'.some_spec, }, },
  { rw [dif_neg H, zero_add, dif_neg H, dif_neg],
    contrapose! H,
    refine ⟨p.from_balancing2 hc H.some H.some_spec, rfl⟩, },
end

lemma total_d_eq_of_rel [has_sign a]
  (a_not_rfl : a.not_rfl) (b_not_rfl : b.not_rfl) (c_not_rfl : c.not_rfl)
  (k k' : γ) (hc : c.rel k k') :
  C.total_d c k k' =
direct_sum.to_module _ _ _ (λ p,
  if H : ∃ (q : diagonal a b c k'), q.1 = p.1
  then (direct_sum.lof R _ _ H.some).comp
    (C.D_h p.fst H.some.fst p.snd H.some.snd) +
      (direct_sum.lof R _ _ (p.from_balancing1' hc H.some H.some_spec)).comp
    (p.fst • C.D_v p.fst (a.next p.fst) p.snd p.snd)
  else 0) :=
begin
  rw [total_d_eq_ite_of_rel']; try { assumption },
  congr,
  ext1 p,
  by_cases H : ∃ (q : diagonal a b c k'), q.fst = p.fst,
  { rw [dif_pos H, dif_pos H],
    congr' 1,
    suffices EQ : p.from_balancing1 hc H.some H.some_spec = p.from_balancing1' hc H.some H.some_spec,
    { rw EQ, congr' 1 },
    { ext,
      rw p.from_balancing1_fst_eq hc H.some H.some_spec, refl,
      refl, }, },
  { rw [dif_neg H, dif_neg H], },
end

lemma D_comp_D_h_apply
  (i₁ i₂ i₃ : α) (j₁ j₂ j₃ : β) (x) :
  C.D_h i₂ i₃ j₂ j₃ (C.D_h i₁ i₂ j₁ j₂ x)  = 0 :=
begin
  rw [←comp_apply, D_comp_D_h, linear_map.zero_apply],
end

lemma D_comp_D_v_apply
  (i₁ i₂ i₃ : α) (j₁ j₂ j₃ : β) (x) :
  C.D_v i₂ i₃ j₂ j₃ (C.D_v i₁ i₂ j₁ j₂ x)  = 0 :=
begin
  rw [←comp_apply, D_comp_D_v, linear_map.zero_apply],
end

-- example [has_sign a]
--   (a_not_rfl : a.not_rfl) (b_not_rfl : b.not_rfl) (c_not_rfl : c.not_rfl)
--   (k₁ k₂ k₃ : γ) (h₁₂ : c.rel k₁ k₂) (h₂₃ : c.rel k₂ k₃) :
--   C.total_d c k₁ k₂ ≫ C.total_d c k₂ k₃ = 0 :=
-- begin
--   apply direct_sum.linear_map_ext,
--   intros p,
--   ext x : 1,
--   rw [linear_map.zero_comp, linear_map.zero_apply, linear_map.comp_apply, comp_apply,
--     total_d_eq_of_rel, total_d_eq_of_rel];
--   try { assumption },
--   rw [ direct_sum.to_module_lof, linear_map.map_dite],
--   simp_rw [linear_map.add_apply, linear_map.zero_apply],
--   split_ifs with H1,
--   { simp only [map_add, direct_sum.to_module_lof, linear_map.comp_apply, linear_map.dite_apply,
--       linear_map.add_apply, D_comp_D_h_apply, map_zero, zero_add, linear_map.zero_apply,
--       has_sign.smul_apply, has_sign.map_smul], },
--   -- { rw [linear_map.add_apply, map_add, linear_map.comp_apply, linear_map.comp_apply,
--   --     direct_sum.to_module_lof, direct_sum.to_module_lof, linear_map.dite_apply,
--   --     linear_map.dite_apply],
--   --   simp_rw [linear_map.add_apply, linear_map.comp_apply, linear_map.zero_apply],
--   --   simp_rw [← comp_apply, D_comp_D_h, linear_map.zero_apply, map_zero, zero_add,
--   --     has_sign.smul_apply, has_sign.map_smul],
--   --   simp_rw [← comp_apply, p.from_balancing1'_fst],

--   --   sorry },
--   -- { rw [linear_map.zero_apply, map_zero], },
-- end

example [has_sign a]
  (a_not_rfl : a.not_rfl) (b_not_rfl : b.not_rfl) (c_not_rfl : c.not_rfl)
  (k₁ k₂ k₃ : γ) (h₁₂ : c.rel k₁ k₂) (h₂₃ : c.rel k₂ k₃) :
  C.total_d c k₁ k₂ ≫ C.total_d c k₂ k₃ = 0 :=
begin
  apply direct_sum.linear_map_ext,
  intros p,
  ext x : 1,
  rw [linear_map.zero_comp, linear_map.zero_apply, linear_map.comp_apply, comp_apply,
    total_d_eq_ite_of_rel', total_d_eq_ite_of_rel', direct_sum.to_module_lof];
  try { assumption },
  rw [linear_map.map_dite],
  split_ifs with H1,
  { rw [linear_map.add_apply, map_add, linear_map.comp_apply, linear_map.comp_apply,
      direct_sum.to_module_lof, direct_sum.to_module_lof, linear_map.dite_apply,
      linear_map.dite_apply],
    simp_rw [linear_map.add_apply, linear_map.comp_apply, linear_map.zero_apply],
    simp_rw [← comp_apply, D_comp_D_h, linear_map.zero_apply, map_zero, zero_add,
      has_sign.smul_apply, has_sign.map_smul],
    simp_rw [← comp_apply, D_comp_D_v, linear_map.zero_apply, has_sign.smul_zero,
      map_zero, add_zero],
    by_cases H2 : ∃ (q : diagonal a b c k₃), q.fst = H1.some.fst,
    { rw (p.from_balancing1_fst_eq h₁₂ H1.some H1.some_spec),
      -- rw [dif_pos H2],
      have h1 : b.rel p.snd H1.some.snd,
      { rwa [← p.add_eq, ← H1.some.add_eq, H1.some_spec, ← has_hadd.rel_v'] at h₁₂, },
      have h2 : c.rel ((p.from_balancing1 h₁₂ H1.some H1.some_spec).fst +[a, b, c] p.snd)
        ((p.from_balancing1 h₁₂ H1.some H1.some_spec).fst +[a,b,c] H1.some.snd),
      { rwa [← has_hadd.rel_v'], },
      have h3 : ((p.from_balancing1 h₁₂ H1.some H1.some_spec).fst +[a,b,c] H1.some.snd) = k₃,
      { erw (p.from_balancing1 h₁₂ H1.some H1.some_spec).add_eq at h2,
        rwa c.next_eq h₂₃ h2, },
      have H3 : ∃ (q : diagonal a b c k₃), q.fst = (p.from_balancing1 h₁₂ H1.some H1.some_spec).fst,
      { refine ⟨⟨(p.from_balancing1 h₁₂ H1.some H1.some_spec).fst, H1.some.snd, h3⟩, rfl⟩, },
      simp_rw (p.from_balancing1_fst_eq h₁₂ H1.some H1.some_spec) at H3,
      rw [dif_pos H2, dif_pos H3],
      generalize_proofs H4 H5,
      generalize_proofs at H4,
      have EQ : H1.some.from_balancing1 h₂₃ H2.some H4 = H3.some,
      { apply H1.some.from_balancing1_uniq,
        have EQ1 := H3.some.add_eq,
        rw H3.some_spec at EQ1,
        simp_rw ←h3 at EQ1,
        rw (p.from_balancing1_fst_eq h₁₂ H1.some H1.some_spec) at EQ1,
        rwa has_hadd.add_cancel_v' at EQ1, },
      rw [EQ],
      rw (p.from_balancing1_snd h₁₂ H1.some H1.some_spec),
      -- convert map_zero _,
      -- simp_rw diagonal.from_balancing1_fst_eq,
      -- sorry
      },
    sorry { rw [dif_neg H2, dif_neg, add_zero],
      contrapose! H2,
      -- exfalso,
      have h1 : b.rel p.snd H2.some.snd,
      { rw [←(p.from_balancing1 h₁₂ H1.some H1.some_spec).add_eq, ←H2.some.add_eq, H2.some_spec,
          ← has_hadd.rel_v'] at h₂₃,
        exact h₂₃, },
      have h1' : c.rel (p.fst+[a,b,c]p.snd) (p.fst +[a,b,c] H2.some.snd),
      { rwa ←has_hadd.rel_v',  },
      have h2 : b.rel p.snd H1.some.snd,
      { rwa [← p.add_eq, ← H1.some.add_eq, H1.some_spec,
          ← has_hadd.rel_v'] at h₁₂, },
      have h3 : H2.some.snd = H1.some.snd,
      { exact b.next_eq h1 h2 },
      have h4 : c.rel (p.fst+[a,b,c] H1.some.snd)
        ((p.from_balancing1 h₁₂ H1.some H1.some_spec).fst +[a,b,c] H2.some.snd),
      { convert h₂₃,
        { convert H1.some.add_eq using 1,
          congr' 1,
          exact H1.some_spec.symm, },
        { convert H2.some.add_eq using 1,
          congr' 1,
          exact H2.some_spec.symm, }, },rw H1.some_spec,
      use H1.some.from_balancing2' h₂₃ H2.some h3,
      exact H1.some_spec, } },
  { rw [linear_map.zero_apply, map_zero], },
end

#exit
/-

      p.fst •
    begin
      have : ∃ (q : diagonal a b c k'), q.2 = p.2,
      { use p.from_balancing1 hc H.some H.some_spec,
        refl, },
      have := C.D_v p.fst this.some.fst p.snd this.some.2,
    end
-/

lemma total_d_comp_d [has_sign a]
  (a_not_rfl : a.not_rfl) (b_not_rfl : b.not_rfl) (c_not_rfl : c.not_rfl)
  (k₁ k₂ k₃ : γ) (h₁₂ : c.rel k₁ k₂) (h₂₃ : c.rel k₂ k₃) :
  C.total_d c k₁ k₂ ≫ C.total_d c k₂ k₃ = 0 :=
begin
  apply direct_sum.linear_map_ext,
  intros p,
  ext x q : 2,
  rw [linear_map.zero_comp, linear_map.zero_apply, linear_map.comp_apply, comp_apply,
    total_d_eq_ite_of_rel, total_d_eq_ite_of_rel, direct_sum.to_module_lof, linear_map.add_apply,
    map_add, direct_sum.zero_apply],
  all_goals { try { assumption } },
  rw [linear_map.map_dite, linear_map.map_dite],
  simp_rw [linear_map.comp_apply, direct_sum.to_module_lof, linear_map.zero_apply, map_zero],
  by_cases H : ¬ (∃ (q : diagonal a b c k₂), q.fst = p.fst) ∧ ¬ (∃ (q : diagonal a b c k₂), q.snd = p.snd),
  { rcases H with ⟨H1, H2⟩,
    rw [dif_neg H1, dif_neg H2, zero_add, direct_sum.zero_apply], },
  rw [not_and_distrib, not_not, not_not] at H,
  rcases H with (H|H),
  { have H' : ∃ (q : diagonal a b c k₂), q.snd = p.snd,
    { refine ⟨p.from_balancing1 h₁₂ H.some H.some_spec, rfl⟩, },
    simp only [dif_pos H, dif_pos H', linear_map.add_apply, linear_map.dite_apply,
      direct_sum.add_apply, direct_sum.dite_apply R],
    simp_rw [linear_map.comp_apply, ← comp_apply, D_comp_D_h, linear_map.zero_apply,
      map_zero, direct_sum.zero_apply, has_sign.smul_comp],
    rw [dif_eq_if, if_t_t, zero_add],
    convert_to _ + (_ + 0) = (0 : C.X _ _),
    { congr' 2,
      by_cases H'' : ∃ (q : diagonal a b c k₃), q.snd = H'.some.snd,
      { rw [dif_pos H''],
        convert_to (0 : ⨁ (q : diagonal a b c k₃), (C.X q.fst q.snd)) q = 0,
        { congr' 1,
          convert map_zero _,
          rw [has_sign.smul_apply, has_sign.smul_apply, has_sign.map_smul, ←comp_apply, D_comp_D_v,
            linear_map.zero_apply, has_sign.smul_zero, has_sign.smul_zero], },
        { rw direct_sum.zero_apply }, },
      { rw [dif_neg H''], }, },
    rw [add_zero],
    by_cases H'' : ∃ (q : diagonal a b c k₃), q.snd = H.some.snd,
    { rw [dif_pos H'', dif_pos],

      sorry },
    sorry,

     },
  sorry
end

#exit
-- @[ext]
-- structure relatable_diagonal ⦃k₁ k₂ : γ⦄ (h : c.rel k₁ k₂) (p : diagonal a b c k₁) :=
-- (to_diagonal : diagonal a b c k₂)
-- (rel : a.rel p.fst to_diagonal.fst ∨ b.rel p.snd to_diagonal.snd)

@[simps]
def relatable_diagonal_horizontal ⦃k₁ k₂ : γ⦄ (h : c.rel k₁ k₂) (p : diagonal a b c k₁)
  ⦃i : α⦄ (ha : a.rel p.fst i) :
  relatable_diagonal k₁ k₂ p :=
{ to_diagonal :=
  { fst := i,
    snd := p.snd,
    add_eq :=
    begin
      have rel1 := (has_hadd.rel_h' p.fst i p.snd).1 ha,
      rw p.add_eq at rel1,
      rw c.next_eq h rel1,
    end },
  rel := or.intro_left _ ha }

lemma relatable_diagonal_horizontal_uniq ⦃k₁ k₂ : γ⦄ (h : c.rel k₁ k₂) (p : diagonal a b c k₁)
  ⦃i : α⦄ (ha : a.rel p.fst i)
  (P : relatable_diagonal k₁ k₂ p) (hP : a.rel p.fst P.to_diagonal.fst) :
  P = relatable_diagonal_horizontal h p ha :=
begin
  have eq1 : P.to_diagonal.fst = i := a.next_eq hP ha,
  ext,
  { exact eq1 },
  { dsimp,
    have eq3 : (i+[a,b,c]p.snd) = k₂ := (relatable_diagonal_horizontal h p ha).to_diagonal.add_eq,
    rw [← P.to_diagonal.add_eq, eq1, has_hadd.add_cancel_v'] at eq3,
    rw eq3, },
end

@[simps]
def relatable_diagonal_vertical ⦃k₁ k₂ : γ⦄ (h : c.rel k₁ k₂) (p : diagonal a b c k₁)
  ⦃j : β⦄ (hb : b.rel p.snd j) :
  relatable_diagonal k₁ k₂ p :=
{ to_diagonal :=
  { fst := p.fst,
    snd := j,
    add_eq :=
    begin
      have rel1 := (has_hadd.rel_v' p.fst p.snd j).1 hb,
      rw p.add_eq at rel1,
      rw c.next_eq h rel1,
    end },
  rel := or.intro_right _ hb }

lemma relatable_diagonal_vertical_uniq ⦃k₁ k₂ : γ⦄ (h : c.rel k₁ k₂) (p : diagonal a b c k₁)
  ⦃j : β⦄ (hb : b.rel p.snd j)
  (P : relatable_diagonal k₁ k₂ p) (hP : b.rel p.snd P.to_diagonal.snd) :
  P = relatable_diagonal_vertical h p hb :=
begin
  have eq1 : P.to_diagonal.snd = j := b.next_eq hP hb,
  ext,
  { dsimp,
    have eq3 : (p.fst+[a,b,c]j) = k₂ := (relatable_diagonal_vertical h p hb).to_diagonal.add_eq,
    rw [← P.to_diagonal.add_eq, eq1, has_hadd.add_cancel_h'] at eq3,
    rw eq3, },
  { exact eq1 },
end

lemma relatable_diagonal_either_or ⦃k₁ k₂ : γ⦄ (h : c.rel k₁ k₂) (p : diagonal a b c k₁)
  (P : relatable_diagonal k₁ k₂ p) :
  (∃ (i : α) (ha : a.rel p.fst i), P = relatable_diagonal_horizontal h p ha) ∨
  (∃ (j : β) (hb : b.rel p.snd j), P = relatable_diagonal_vertical h p hb) :=
begin
  rcases P with ⟨⟨i, j, hij⟩, (hP|hP)⟩,
  { left,
    refine ⟨i, hP, relatable_diagonal_horizontal_uniq _ _ hP _ _⟩,
    assumption, },
  { right,
    refine ⟨j, hP, relatable_diagonal_vertical_uniq _ _ hP _ _⟩,
    assumption, },
end

lemma relatable_diagonal_of_not_c_rel ⦃k₁ k₂ : γ⦄ (h : ¬ c.rel k₁ k₂) (p : diagonal a b c k₁)

lemma relatable_diagonal_not_both ⦃k₁ k₂ : γ⦄
  (a_not_rfl : a.not_rfl) (b_not_rfl : b.not_rfl)
  (h : c.rel k₁ k₂) (p : diagonal a b c k₁)
  (P : relatable_diagonal h p)
  (i : α) (ha : a.rel p.fst i) (hPa : P = relatable_diagonal_horizontal h p ha)
  (j : β) (hb : b.rel p.snd j) (hPb : P = relatable_diagonal_vertical h p hb) :
  false :=
begin
  rw hPb at hPa,
  rw [relatable_diagonal.ext_iff, diagonal.ext_iff] at hPa,
  rcases hPa with ⟨h1, h2⟩,
  dsimp at *,
  rw h1 at ha,
  refine a_not_rfl _ ha,
end

-- instance ⦃k₁ k₂ : γ⦄ (h : c.rel k₁ k₂) (p : diagonal a b c k₁) :
--   finite (relatable_diagonal h p) :=
-- begin
--   by_cases h1 : ∃ (i : α), a.rel p.fst i,
--   all_goals { by_cases h2 : ∃ (j : β), b.rel p.snd j },
--   { sorry },
--   { sorry },
--   { sorry },
--   { haveI : is_empty (relatable_diagonal h p),
--     { by_contradiction rid,
--       rw not_is_empty_iff at rid,
--       rcases rid with ⟨⟨_, (rid|rid)⟩⟩,
--       { rw not_exists at h1, tauto },
--       { rw not_exists at h2, tauto }, },
--     apply_instance, }
-- end

variables [∀ p q, decidable $ c.rel p q]

def total_d (k₁ k₂ : γ) : C.total_at c k₁ ⟶ C.total_at c k₂ :=
Module.of_hom $ direct_sum.to_module _ _ _ $ λ i,
{ to_fun := λ x, _,
  map_add' := _,
  map_smul' := _ }
-- if c_rel : c.rel k₁ k₂
-- then Module.of_hom $ direct_sum.to_module _ _ _ $ λ i,
-- { to_fun := λ x, direct_sum.of _ begin
--     refine ((relatable_diagonal_horizontal c_rel i) _).to_diagonal,
--   end _,
--   map_add' := _,
--   map_smul' := _ }
-- else 0
-- Module.of_hom $ direct_sum.to_module _ _ _ $ λ i, _

end

end homological_bicomplex

def double_chain_complex (α : Type*) [add_right_cancel_semigroup α] [has_one α] : Type* :=
homological_bicomplex V (complex_shape.down α) (complex_shape.down α)

def double_cochain_complex (α : Type*) [add_right_cancel_semigroup α] [has_one α] : Type* :=
homological_bicomplex V (complex_shape.up α) (complex_shape.up α)

namespace double_chain_complex

variables {R : Type*} [comm_ring R] (C : double_chain_complex (Module R) ℤ)

@[ext, derive [decidable_eq]]
structure diagonal (n : ℤ) :=
(fst : ℤ) (snd : ℤ) (add_eq : fst + snd = n)

@[reducible]
def total_at (n : ℤ) : Module R :=
Module.of R $ direct_sum (diagonal n) $ λ p, C.X p.fst p.snd

variables [Π (m : ℤ), decidable $ even m]

def total_d (m : ℤ) : C.total_at m ⟶ C.total_at (m - 1) :=
Module.of_hom $ direct_sum.to_module _ _ _ $ λ p,
-- vertical component
(direct_sum.lof R (diagonal $ m - 1) (λ p, C.X p.fst p.snd)
  ⟨p.fst - 1, p.snd, by rw [sub_add_eq_add_sub, p.add_eq]⟩ :
  C.X (p.fst - 1) p.snd →ₗ[R]
  direct_sum (diagonal $ m - 1) $ λ p, C.X p.fst p.snd).comp
(C.d_v p.snd p.fst (p.fst - 1) : C.X p.fst p.snd →ₗ[R] C.X (p.fst - 1) p.snd) +
-- alternating horizontal component
((if even p.fst then id else has_neg.neg :
  (C.X p.fst p.snd →ₗ[R] direct_sum (diagonal (m - 1)) (λ p, C.X p.fst p.snd)) →
  (C.X p.fst p.snd →ₗ[R] direct_sum (diagonal (m - 1)) (λ p, C.X p.fst p.snd))) $
(direct_sum.lof R (diagonal $ m - 1) (λ p, C.X p.fst p.snd)
  ⟨p.fst, p.snd - 1, by rw [←add_sub_assoc, p.add_eq]⟩ :
  C.X p.fst (p.snd - 1) →ₗ[R]
  direct_sum (diagonal $ m - 1) $ λ p, C.X p.fst p.snd).comp
(C.d_h p.fst p.snd (p.snd - 1) : C.X p.fst p.snd →ₗ[R] C.X p.fst (p.snd - 1)))

lemma total_d_apply_of_even (p q : ℤ) (x : C.X p q) (h : even p) :
  C.total_d (p + q) (direct_sum.of (λ (y : diagonal (p + q)), C.X y.fst y.snd) ⟨p, q, rfl⟩ x) =
  direct_sum.of (λ (y : diagonal (p + q - 1)), C.X y.fst y.snd) ⟨p - 1, q, by ring⟩
    (C.d_v _ _ _ x) +
  direct_sum.of (λ (y : diagonal (p + q - 1)), C.X y.fst y.snd) ⟨p, q - 1, by ring⟩
    (C.d_h _ _ _ x) :=
begin
  erw direct_sum.to_module_lof,
  simp only [if_pos h, id.def, linear_map.add_apply, linear_map.coe_comp, function.comp_app,
    direct_sum.lof_eq_of],
end

lemma total_d_apply_of_even' (m p q : ℤ) (hpq : p + q = m) (x : C.X p q)
  (h : even p) :
  C.total_d m (direct_sum.of (λ (y : diagonal m), C.X y.fst y.snd) ⟨p, q, hpq⟩ x) =
  direct_sum.of (λ (y : diagonal m), C.X y.fst y.snd) ⟨p - 1, q, by { rw [sub_add_co] }⟩
    (C.d_v _ _ _ x) +
  direct_sum.of (λ (y : diagonal m), C.X y.fst y.snd) ⟨p, q - 1, by ring⟩
    (C.d_h _ _ _ x) :=
sorry

lemma total_d_apply_of_odd (p q : ℤ) (x : C.X p q) (h : ¬ even p) :
  C.total_d (p + q) (direct_sum.of (λ (y : diagonal (p + q)), C.X y.fst y.snd) ⟨p, q, rfl⟩ x) =
  direct_sum.of (λ (y : diagonal (p + q - 1)), C.X y.fst y.snd) ⟨p - 1, q, by ring⟩
    (C.d_v _ _ _ x) -
  direct_sum.of (λ (y : diagonal (p + q - 1)), C.X y.fst y.snd) ⟨p, q - 1, by ring⟩
    (C.d_h _ _ _ x) :=
begin
  erw direct_sum.to_module_lof,
  simp only [if_neg h, linear_map.add_apply, linear_map.coe_comp, function.comp_app,
    direct_sum.lof_eq_of, linear_map.neg_apply, sub_eq_add_neg],
end

lemma total_d_comp_d (m : ℤ) :
  (C.total_d (m - 1)).comp (C.total_d m) = 0 :=
  -- (0 : direct_sum (diagonal (p + q - 1 - 1)) $ λ p, C.X p.fst p.snd)
begin
  ext ⟨a, b, eq1⟩ (x : C.X a b) ⟨a', b', eq2⟩,
  simp only [linear_map.comp_apply, linear_map.zero_apply, direct_sum.zero_apply],
end

#exit
example (p q : ℕ) :
  C.X p q ⟶ C.X (p - 1) q :=
C.d_v q p (p - 1)

example (p q : ℤ) :
  C.X p q ⟶ C.X p (q - 1) :=
C.d_h p q (q - 1)

example (p q p' q' : ℤ) :
  C.X p q ⟶ C.X p' q' :=
C.d_h p q q' ≫ C.d_v q' p p'

example (p q p' q' : ℤ) :
  C.X p q ⟶ C.X p' q' :=
C.d_v q p p' ≫ C.d_h p' q q'

example (p q p' q' : ℤ) :
  C.X p q ⟶ C.X p' q' :=
C.d_h p q q' ≫ C.d_v q' p p' +
if even q
then C.d_v q p p' ≫ C.d_h p' q q'
else - C.d_v q p p' ≫ C.d_h p' q q'

def total_complex_direct_sum.d' (n : ℤ) :
  C.total_at n ⟶ C.total_at (n - 1) :=

def total_complex_direct_sum (C : double_chain_complex (Module R) ℤ) : chain_complex (Module R) ℤ :=
{ X := λ n, Module.of R $ direct_sum {p : ℤ × ℤ | p.1 + p.2 = n} (λ p, C.X p.val.fst p.val.snd),
  d := λ i j, Module.of_hom _,
  shape' := _,
  d_comp_d' := _ }

end double_chain_complex


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under MIT license as described in the file LICENSE.
Authors: Eric Wieser
-/
import linear_algebra.clifford_algebra.basic

variables {R : Type*} [comm_ring R]
variables {M : Type*} [add_comm_group M] [module R M]
variables {Q : quadratic_form R M}

notation `↑ₐ`:max x:max := algebra_map _ _ x

namespace clifford_algebra

-- if this fails then you have the wrong branch of mathlib
example : ring (clifford_algebra Q) := infer_instance

variables (Q)
abbreviation clifford_hom (A : Type*) [semiring A] [algebra R A] :=
{ f : M →ₗ[R] A // ∀ m, f m * f m = ↑ₐ(Q m) }
variables {Q}

/-- TODO: work out what the necessary conditions are here, then make this an instance -/
example : nontrivial (clifford_algebra Q) := sorry

/-- A wedge product of n vectors. Note this does not define the wedge product of arbitrary multivectors. -/
def ι_wedge (n : ℕ) [invertible (n.factorial : R)] : alternating_map R M (clifford_algebra Q) (fin n) :=
⅟(n.factorial : R) • ((multilinear_map.mk_pi_algebra_fin R n _).comp_linear_map (λ i, ι Q)).alternatization

end clifford_algebra


import unitb.scheduling.basic
import unitb.scheduling.finite
import unitb.scheduling.infinite

import util.data.stream

import temporal_logic

namespace scheduling

open stream temporal has_mem scheduling.unitb nat

section rules

variables  {lbl : Type}
variables [sched lbl] [nonempty lbl]

lemma sched.sched_str
  (r : target_mch lbl)
: ∃ τ : stream r.σ, fair r τ :=
begin
  cases _inst_1 with _fin _inf,
  { apply finite.sched' ; apply_instance },
  { apply infinite.sched' ; apply_instance },
end

end rules

variables {lbl : Type}
variables [sched lbl] [nonempty lbl]
variables (t : target_mch lbl)

noncomputable def fair_sched_of
: stream t.σ :=
classical.some (sched.sched_str t)

noncomputable def fair_sched : stream t.σ :=
fair_sched_of _

variables {lbl}

lemma fair_sched_of_spec
: fair t (fair_sched_of t) :=
by apply classical.some_spec (sched.sched_str t)

lemma fair_sched_succ (i : ℕ) {τ : stream t.σ}
  (H : fair t τ)
: ∃ l (P : l ∈ t.req.apply (τ i)), τ (succ i) = t.next l (τ i) P :=
begin
  apply exists_imp_exists _ (H.valid i),
  intros l h,
  simp [init_drop,action_drop] at h,
  exact h.left
end

lemma fair_sched_of_is_fair
  (l : lbl)
  (h : fair_sched_of t ⊨ (◻◇•(↑l ∊ t.req)) )
: fair_sched_of t ⊨ (◻◇(•(↑l ∊ t.req) ⋀ ⟦ t.action l ⟧)) :=
(fair_sched_of_spec t).fair l h

instance {lbl} [i : nonempty lbl] : nonempty (stream lbl) :=
begin
  cases i with l,
  apply nonempty.intro,
  intro i, apply l,
end

end scheduling


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem algebra_2rootspoly_apatapbeq2asqp2ab
  (a b : ℂ) :
  (a + a) * (a + b) = 2 * a^2 + 2 * (a * b) :=
begin
  ring,
end


example (a b c : ℕ) : a * (b * c) = a * (c * b) :=
begin
  conv
  begin          -- | a * (b * c) = a * (c * b)
    to_lhs,      -- | a * (b * c)
    congr,       -- 2 goals : | a and | b * c
    skip,        -- | b * c
    rw mul_comm, -- | c * b
  end
end
example : (λ x : ℕ, 0 + x) = (λ x, x) :=
begin
  conv
  begin           -- | (λ (x : ℕ), 0 + x) = λ (x : ℕ), x
    to_lhs,       -- | λ (x : ℕ), 0 + x
    funext,       -- | 0 + x
    rw zero_add,  -- | x
  end
end
example (a b c : ℕ) : a * (b * c) = a * (c * b) :=
begin
conv in (b*c)
begin          -- | b * c
  rw mul_comm, -- | c * b
end
end
meta def find_matching_type (e : expr) : list expr → tactic expr
| []         := tactic.failed
| (H :: Hs)  := do t ← tactic.infer_type H,
                   (tactic.unify e t >> return H) <|> find_matching_type Hs
meta def my_assumption : tactic unit :=
do { ctx ← tactic.local_context,
     t   ← tactic.target,
     find_matching_type t ctx >>= tactic.exact }
<|> tactic.fail "my_assumption tactic failed"
meta def my_first_tactic : tactic unit := tactic.trace "Hello, World."
meta def trace_goal' : tactic unit :=
do
 goal ← tactic.target,
 tactic.trace goal
example : 3 =2+1:=
begin
   trace_goal',
  trivial,
end


import algebra.group_power tactic.norm_num algebra.big_operators

theorem Q5 : (¬ (∃ a b c : ℕ, 6*a+9*b+20*c = 43))
             ∧ ∀ m, m ≥ 44 → ∃ a b c : ℕ, 6*a+9*b+20*c = m :=
begin
split,
  intro H,
  cases H with a H,
  cases H with b H,
  cases H with c H,
  revert H,
  cases c with c,tactic.swap,
    cases c with c,tactic.swap,
      cases c with c,tactic.swap,
        show 6*a+9*b+20*(c+3) = 43 → false,
        rw [mul_add],
        apply ne_of_gt,
        exact calc 6 * a + 9 * b + (20 * c + 20 * 3)
                = 6*a + (9*b+(20*c+20*3)) : by simp
            ... ≥ 9 * b + (20 * c + 20 * 3) : nat.le_add_left (9 * b + (20 * c + 20 * 3)) (6*a)
            ... ≥  20 * c + 20 * 3 : nat.le_add_left _ _
            ... ≥ 20*3 : nat.le_add_left _ _
            ... > 43 : dec_trivial,
      cases b with b,tactic.swap,
        show (6*a+9*(b+1)+20*2=43 → false),
        rw [mul_add],
        apply ne_of_gt,
        exact calc 6 * a + (9 * b + 9 * 1) + 20 * 2
            = (6*a+9*b)+9*1+20*2 : by simp
        ... ≥ 9*1+20*2 : nat.le_add_left _ _
        ... > 43 : dec_trivial,
      cases a with a,
        exact dec_trivial,
      show 6*(a+1) + 9 * 0 + 20 * 2 = 43 → false,
      rw [mul_add],
      apply ne_of_gt,
      exact calc 6 * a + 6 * 1 + 9 * 0 + 20 * 2
              ≥  6 * 1 + 9 * 0 + 20 * 2 : nat.le_add_left _ _
          ... > 43 : dec_trivial,

    cases b with b,tactic.swap,
      cases b with b,tactic.swap,
        cases b with b,tactic.swap,
          show (6*a+9*(b+3)+20*1=43 → false),
          rw [mul_add],
          apply ne_of_gt,
          exact calc 6 * a + (9 * b + 9 * 3) + 20 * 1
            = (6*a+9*b)+9*3+20*1 : by simp
        ... ≥ 9*3+20*1 : nat.le_add_left _ _
        ... > 43 : dec_trivial,
      cases a with a,
        exact dec_trivial,
      show 6*(a+1) + 9 * 2 + 20 * 1 = 43 → false,
      rw [mul_add],
      apply ne_of_gt,
      exact calc 6 * a + 6 * 1 + 9 * 2 + 20 * 1
              ≥  6 * 1 + 9 * 2 + 20 * 1 : nat.le_add_left _ _
          ... > 43 : dec_trivial,
      cases a with a,
        exact dec_trivial,
      cases a with a,
        exact dec_trivial,
      cases a with a,
        exact dec_trivial,
      show 6*(a+3) + 9 * 1 + 20 * 1 = 43 → false,
      rw [mul_add],
      apply ne_of_gt,
      exact calc 6 * a + 6 * 3 + 9 * 1 + 20 * 1
              ≥  6 * 3 + 9 * 1 + 20 * 1 : nat.le_add_left _ _
          ... > 43 : dec_trivial,
    cases a with a,
      exact dec_trivial,
    cases a with a,
      exact dec_trivial,
    cases a with a,
      exact dec_trivial,
    cases a with a,
      exact dec_trivial,
    show 6*(a+4) + 9 * 0 + 20 * 1 = 43 → false,
    rw [mul_add],
    apply ne_of_gt,
    exact calc 6 * a + 6 * 4 + 9 * 0 + 20 * 1
            ≥  6 * 4 + 9 * 0 + 20 * 1 : nat.le_add_left _ _
        ... > 43 : dec_trivial,

  cases b with b,tactic.swap,
    cases b with b,tactic.swap,
      cases b with b,tactic.swap,
        cases b with b,tactic.swap,
          cases b with b,tactic.swap,
            show (6*a+9*(b+5)+20*0=43 → false),
            rw [mul_add],
            apply ne_of_gt,
            exact calc 6 * a + (9 * b + 9 * 5) + 20 * 0
              = (6*a+9*b)+9*5+20*0 : by simp
          ... ≥ 9*5+20*0 : nat.le_add_left _ _
          ... > 43 : dec_trivial,
      cases a with a,
        exact dec_trivial,
      cases a with a,
        exact dec_trivial,
      show 6*(a+2) + 9 * 4 + 20 * 0 = 43 → false,
      rw [mul_add],
      apply ne_of_gt,
      exact calc 6 * a + 6 * 2 + 9 * 4 + 20 * 0
              ≥  6 * 2 + 9 * 4 + 20 * 0 : nat.le_add_left _ _
          ... > 43 : dec_trivial,
        cases a with a,exact dec_trivial,
        cases a with a,exact dec_trivial,
        cases a with a,exact dec_trivial,
        show 6*(a+3) + 9 * 3 + 20 * 0 = 43 → false,
        rw [mul_add],
        apply ne_of_gt,
        exact calc 6 * a + 6 * 3 + 9 * 3 + 20 * 0
              ≥  6 * 3 + 9 * 3 + 20 * 0 : nat.le_add_left _ _
          ... > 43 : dec_trivial,
    cases a with a,exact dec_trivial,
    cases a with a,exact dec_trivial,
    cases a with a,exact dec_trivial,
    cases a with a,exact dec_trivial,
    cases a with a,exact dec_trivial,
    show 6*(a+5) + 9 * 2 + 20 * 0 = 43 → false,
    rw [mul_add],
    apply ne_of_gt,
    exact calc 6 * a + 6 * 5 + 9 * 2 + 20 * 0
            ≥  6 * 5 + 9 * 2 + 20 * 0 : nat.le_add_left _ _
        ... > 43 : dec_trivial,
    cases a with a,exact dec_trivial,
    cases a with a,exact dec_trivial,
    cases a with a,exact dec_trivial,
    cases a with a,exact dec_trivial,
    cases a with a,exact dec_trivial,
    cases a with a,exact dec_trivial,
    show 6*(a+6) + 9 * 1 + 20 * 0 = 43 → false,
    rw [mul_add],
    apply ne_of_gt,
    exact calc 6 * a + 6 * 6 + 9 * 1 + 20 * 0
            ≥  6 * 6 + 9 * 1 + 20 * 0 : nat.le_add_left _ _
        ... > 43 : dec_trivial,
  cases a with a,exact dec_trivial,
  cases a with a,exact dec_trivial,
  cases a with a,exact dec_trivial,
  cases a with a,exact dec_trivial,
  cases a with a,exact dec_trivial,
  cases a with a,exact dec_trivial,
  cases a with a,exact dec_trivial,
  cases a with a,exact dec_trivial,
  show 6*(a+8) + 9 * 0 + 20 * 0 = 43 → false,
  rw [mul_add],
  apply ne_of_gt,
  exact calc 6 * a + 6 * 8 + 9 * 0 + 20 * 0
          ≥  6 * 8 + 9 * 0 + 20 * 0 : nat.le_add_left _ _
      ... > 43 : dec_trivial,

-- now the opposite

-- proof that if m>=44 then it's 44+n
-- probably would have been easier to do by induction on 44

intros m Hm,
have H44 : ∃ n : ℕ, m=44+n,
  let c:ℤ := m-((44:ℕ):ℤ),
  have Hc_nonneg : c ≥ 0 := calc
  c = ↑m - ↑44 : rfl
  ... = ↑m + -↑44 : sub_eq_add_neg _ _
  ... ≥ ↑44 + -↑44 : add_le_add_right ((int.coe_nat_le_coe_nat_iff _ _).2 Hm) _
  ... = 0 : add_neg_self _,
  have H := int.nat_abs_of_nonneg Hc_nonneg,
  let n := int.nat_abs c,
  existsi n,
  apply (int.of_nat_eq_of_nat_iff _ _).1,
  rw [←int.coe_nat_eq,←int.coe_nat_eq,int.coe_nat_add,H,add_comm,sub_add_cancel],

cases H44 with n H,
rw [H],
clear Hm H m,

/- State now
n : ℕ
⊢ ∃ (a b c : ℕ), 6 * a + 9 * b + 20 * c = 44 + n
-/

-- Now need division with remainder

have H6 : ∃ q r : ℕ, n=6*q+r ∧ (r=0 ∨ r=1 ∨ r=2 ∨ r=3 ∨ r=4 ∨ r=5),
  induction n with d Hd,
    existsi 0,
    existsi 0,
    split,
      simp,
    simp,
  cases Hd with q Hd',
  cases Hd' with r HI,
  cases HI.right with H0 H15,
    existsi q,
    existsi 1,
    split,
      simp [HI.left,H0,nat.succ_eq_add_one],
    simp,
  cases H15 with H H25,
    existsi q,
    existsi 2,
    split,
--      simp [nat.succ_eq_add_one,HI.left,H1],
      rw [nat.succ_eq_add_one,HI.left,H],
    simp,
  cases H25 with H H35,
    existsi q,
    existsi 3,
    split,
      rw [nat.succ_eq_add_one,HI.left,H],
    simp,
  cases H35 with H H45,
    existsi q,
    existsi 4,
    split,
      rw [nat.succ_eq_add_one,HI.left,H],
    simp,
  cases H45 with H H5,
    existsi q,
    existsi 5,
    split,
      rw [nat.succ_eq_add_one,HI.left,H],
    simp,
  existsi q+1,
  existsi 0,
  split,
    rw [nat.succ_eq_add_one,HI.left,H5,mul_add,mul_one],
  simp,

cases H6 with q H6',
cases H6' with r H,
rw [H.left],
have Hrsmall := H.right,
clear H n,

/-
State now
q r : ℕ
Hrsmall : r = 0 ∨ r = 1 ∨ r = 2 ∨ r = 3 ∨ r = 4 ∨ r = 5
⊢ ∃ (a b c : ℕ), 6 * a + 9 * b + 20 * c = 44 + (6 * q + r)
-/

induction q with d Hd,
  cases Hrsmall with H H15,
    existsi 4,existsi 0,existsi 1,
    rw [H],exact dec_trivial,
 cases H15 with H H25,
    existsi 0,existsi 5,existsi 0,
    rw [H],exact dec_trivial,
 cases H25 with H H35,
    existsi 1,existsi 0,existsi 2,
    rw [H],exact dec_trivial,
 cases H35 with H H45,
    existsi 0,existsi 3,existsi 1,
    rw [H],exact dec_trivial,
 cases H45 with H H5,
    existsi 8,existsi 0,existsi 0,
    rw [H],exact dec_trivial,
  existsi 0,existsi 1,existsi 2,
    rw [H5],exact dec_trivial,

clear Hrsmall,

cases Hd with a Hd',
cases Hd' with b Hd'',
cases Hd'' with c H,
existsi (a+1),
existsi b,
existsi c,
rw [nat.succ_eq_add_one,mul_add,mul_add,mul_one],
rw [add_comm (6*a) 6,add_assoc,add_assoc],
rw add_assoc at H,
rw H,
simp,
end


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.subobject.limits

/-!
# Image-to-kernel comparison maps

Whenever `f : A ⟶ B` and `g : B ⟶ C` satisfy `w : f ≫ g = 0`,
we have `image_le_kernel f g w : image_subobject f ≤ kernel_subobject g`
(assuming the appropriate images and kernels exist).

`image_to_kernel f g w` is the corresponding morphism between objects in `C`.

We define `homology f g w` of such a pair as the cokernel of `image_to_kernel f g w`.
-/

universes v u

open category_theory category_theory.limits

variables {ι : Type*}
variables {V : Type u} [category.{v} V] [has_zero_morphisms V]

open_locale classical
noncomputable theory

section
variables {A B C : V} (f : A ⟶ B) [has_image f] (g : B ⟶ C) [has_kernel g]

lemma image_le_kernel (w : f ≫ g = 0) :
  image_subobject f ≤ kernel_subobject g :=
image_subobject_le_mk _ _ (kernel.lift _ _ w) (by simp)

/--
The canonical morphism `image_subobject f ⟶ kernel_subobject g` when `f ≫ g = 0`.
-/
@[derive mono]
def image_to_kernel (w : f ≫ g = 0) :
  (image_subobject f : V) ⟶ (kernel_subobject g : V) :=
(subobject.of_le _ _ (image_le_kernel _ _ w))

/-- Prefer `image_to_kernel`. -/
@[simp] lemma subobject_of_le_as_image_to_kernel (w : f ≫ g = 0) (h) :
  subobject.of_le (image_subobject f) (kernel_subobject g) h = image_to_kernel f g w :=
rfl

@[simp, reassoc, elementwise]
lemma image_to_kernel_arrow (w : f ≫ g = 0) :
  image_to_kernel f g w ≫ (kernel_subobject g).arrow = (image_subobject f).arrow :=
by simp [image_to_kernel]

-- This is less useful as a `simp` lemma than it initially appears,
-- as it "loses" the information the morphism factors through the image.
lemma factor_thru_image_subobject_comp_image_to_kernel (w : f ≫ g = 0) :
  factor_thru_image_subobject f ≫ image_to_kernel f g w = factor_thru_kernel_subobject g f w :=
by { ext, simp, }

end

section
variables {A B C : V} (f : A ⟶ B) (g : B ⟶ C)

@[simp]
lemma image_to_kernel_zero_left [has_kernels V] [has_zero_object V] {w} :
  image_to_kernel (0 : A ⟶ B) g w = 0 :=
by { ext, simp, }

lemma image_to_kernel_zero_right [has_images V] {w} :
  image_to_kernel f (0 : B ⟶ C) w =
    (image_subobject f).arrow ≫ inv (kernel_subobject (0 : B ⟶ C)).arrow :=
by { ext, simp }

section
variables [has_kernels V] [has_images V]

lemma image_to_kernel_comp_right {D : V} (h : C ⟶ D) (w : f ≫ g = 0) :
  image_to_kernel f (g ≫ h) (by simp [reassoc_of w]) =
    image_to_kernel f g w ≫ subobject.of_le _ _ (kernel_subobject_comp_le g h) :=
by { ext, simp }

lemma image_to_kernel_comp_left {Z : V} (h : Z ⟶ A) (w : f ≫ g = 0) :
  image_to_kernel (h ≫ f) g (by simp [w]) =
    subobject.of_le _ _ (image_subobject_comp_le h f) ≫ image_to_kernel f g w :=
by { ext, simp }

@[simp]
lemma image_to_kernel_comp_mono {D : V} (h : C ⟶ D) [mono h] (w) :
  image_to_kernel f (g ≫ h) w =
  image_to_kernel f g ((cancel_mono h).mp (by simpa using w : (f ≫ g) ≫ h = 0 ≫ h)) ≫
    (subobject.iso_of_eq _ _ (kernel_subobject_comp_mono g h)).inv :=
by { ext, simp, }

@[simp]
lemma image_to_kernel_epi_comp {Z : V} (h : Z ⟶ A) [epi h] (w) :
  image_to_kernel (h ≫ f) g w =
  subobject.of_le _ _ (image_subobject_comp_le h f) ≫
    image_to_kernel f g ((cancel_epi h).mp (by simpa using w : h ≫ f ≫ g = h ≫ 0)) :=
by { ext, simp, }

end

@[simp]
lemma image_to_kernel_comp_hom_inv_comp [has_equalizers V] [has_images V] {Z : V} {i : B ≅ Z} (w) :
  image_to_kernel (f ≫ i.hom) (i.inv ≫ g) w =
  (image_subobject_comp_iso _ _).hom ≫ image_to_kernel f g (by simpa using w) ≫
    (kernel_subobject_iso_comp i.inv g).inv :=
by { ext, simp, }

open_locale zero_object

/--
`image_to_kernel` for `A --0--> B --g--> C`, where `g` is a mono is itself an epi
(i.e. the sequence is exact at `B`).
-/
instance image_to_kernel_epi_of_zero_of_mono [has_kernels V] [has_zero_object V] [mono g] :
  epi (image_to_kernel (0 : A ⟶ B) g (by simp)) :=
epi_of_target_iso_zero _ (kernel_subobject_iso g ≪≫ kernel.of_mono g)

/--
`image_to_kernel` for `A --f--> B --0--> C`, where `g` is an epi is itself an epi
(i.e. the sequence is exact at `B`).
-/
instance image_to_kernel_epi_of_epi_of_zero [has_images V] [epi f] :
  epi (image_to_kernel f (0 : B ⟶ C) (by simp)) :=
begin
  simp only [image_to_kernel_zero_right],
  haveI := epi_image_of_epi f,
  rw ←image_subobject_arrow,
  refine @epi_comp _ _ _ _ _ _ (epi_comp _ _) _ _,
end

end

section
variables {A B C : V} (f : A ⟶ B) [has_image f] (g : B ⟶ C) [has_kernel g]

/--
The homology of a pair of morphisms `f : A ⟶ B` and `g : B ⟶ C` satisfying `f ≫ g = 0`
is the cokernel of the `image_to_kernel` morphism for `f` and `g`.
-/
def homology {A B C : V} (f : A ⟶ B) [has_image f] (g : B ⟶ C) [has_kernel g]
  (w : f ≫ g = 0) [has_cokernel (image_to_kernel f g w)] : V :=
cokernel (image_to_kernel f g w)

section
variables (w : f ≫ g = 0) [has_cokernel (image_to_kernel f g w)]

/-- The morphism from cycles to homology. -/
def homology.π : (kernel_subobject g : V) ⟶ homology f g w :=
cokernel.π _

@[simp] lemma homology.condition : image_to_kernel f g w ≫ homology.π f g w = 0 :=
cokernel.condition _

/--
To construct a map out of homology, it suffices to construct a map out of the cycles
which vanishes on boundaries.
-/
def homology.desc {D : V} (k : (kernel_subobject g : V) ⟶ D) (p : image_to_kernel f g w ≫ k = 0) :
  homology f g w ⟶ D :=
cokernel.desc _ k p

@[simp, reassoc, elementwise]
lemma homology.π_desc
  {D : V} (k : (kernel_subobject g : V) ⟶ D) (p : image_to_kernel f g w ≫ k = 0) :
  homology.π f g w ≫ homology.desc f g w k p = k :=
by { simp [homology.π, homology.desc], }

/-- To check two morphisms out of `homology f g w` are equal, it suffices to check on cycles. -/
@[ext]
lemma homology.ext {D : V} {k k' : homology f g w ⟶ D}
  (p : homology.π f g w ≫ k = homology.π f g w ≫ k') : k = k' :=
by { ext, exact p, }

/-- The cokernel of the map `Im f ⟶ Ker 0` is isomorphic to the cokernel of `f.` -/
def homology_of_zero_right [has_cokernel (image_to_kernel f (0 : B ⟶ C) comp_zero)]
  [has_cokernel f] [has_cokernel (image.ι f)] [epi (factor_thru_image f)] :
  homology f (0 : B ⟶ C) comp_zero ≅ cokernel f :=
(cokernel.map_iso _ _ (image_subobject_iso _) ((kernel_subobject_iso 0).trans
  kernel_zero_iso_source) (by simp)).trans (cokernel_image_ι _)

/-- The kernel of the map `Im 0 ⟶ Ker f` is isomorphic to the kernel of `f.` -/
def homology_of_zero_left [has_zero_object V] [has_kernels V] [has_image (0 : A ⟶ B)]
  [has_cokernel (image_to_kernel (0 : A ⟶ B) g zero_comp)] :
  homology (0 : A ⟶ B) g zero_comp ≅ kernel g :=
((cokernel_iso_of_eq $ image_to_kernel_zero_left _).trans cokernel_zero_iso_target).trans
  (kernel_subobject_iso _)

/-- `homology 0 0 _` is just the middle object. -/
@[simps]
def homology_zero_zero [has_zero_object V]
  [has_image (0 : A ⟶ B)] [has_cokernel (image_to_kernel (0 : A ⟶ B) (0 : B ⟶ C) (by simp))] :
  homology (0 : A ⟶ B) (0 : B ⟶ C) (by simp) ≅ B :=
{ hom := homology.desc (0 : A ⟶ B) (0 : B ⟶ C) (by simp) (kernel_subobject 0).arrow (by simp),
  inv := inv (kernel_subobject 0).arrow ≫ homology.π _ _ _, }

end

section
variables {f g} (w : f ≫ g = 0)
  {A' B' C' : V} {f' : A' ⟶ B'} [has_image f'] {g' : B' ⟶ C'} [has_kernel g'] (w' : f' ≫ g' = 0)
  (α : arrow.mk f ⟶ arrow.mk f') [has_image_map α] (β : arrow.mk g ⟶ arrow.mk g')
  {A₁ B₁ C₁ : V} {f₁ : A₁ ⟶ B₁} [has_image f₁] {g₁ : B₁ ⟶ C₁} [has_kernel g₁] (w₁ : f₁ ≫ g₁ = 0)
  {A₂ B₂ C₂ : V} {f₂ : A₂ ⟶ B₂} [has_image f₂] {g₂ : B₂ ⟶ C₂} [has_kernel g₂] (w₂ : f₂ ≫ g₂ = 0)
  {A₃ B₃ C₃ : V} {f₃ : A₃ ⟶ B₃} [has_image f₃] {g₃ : B₃ ⟶ C₃} [has_kernel g₃] (w₃ : f₃ ≫ g₃ = 0)
  (α₁ : arrow.mk f₁ ⟶ arrow.mk f₂) [has_image_map α₁] (β₁ : arrow.mk g₁ ⟶ arrow.mk g₂)
  (α₂ : arrow.mk f₂ ⟶ arrow.mk f₃) [has_image_map α₂] (β₂ : arrow.mk g₂ ⟶ arrow.mk g₃)

/--
Given compatible commutative squares between
a pair `f g` and a pair `f' g'` satisfying `f ≫ g = 0` and `f' ≫ g' = 0`,
the `image_to_kernel` morphisms intertwine the induced map on kernels and the induced map on images.
-/
@[reassoc]
lemma image_subobject_map_comp_image_to_kernel (p : α.right = β.left) :
  image_to_kernel f g w ≫ kernel_subobject_map β =
    image_subobject_map α ≫ image_to_kernel f' g' w' :=
by { ext, simp [p], }

variables [has_cokernel (image_to_kernel f g w)] [has_cokernel (image_to_kernel f' g' w')]
variables [has_cokernel (image_to_kernel f₁ g₁ w₁)]
variables [has_cokernel (image_to_kernel f₂ g₂ w₂)]
variables [has_cokernel (image_to_kernel f₃ g₃ w₃)]

/--
Given compatible commutative squares between
a pair `f g` and a pair `f' g'` satisfying `f ≫ g = 0` and `f' ≫ g' = 0`,
we get a morphism on homology.
-/
def homology.map (p : α.right = β.left) :
  homology f g w ⟶ homology f' g' w' :=
cokernel.desc _ (kernel_subobject_map β ≫ cokernel.π _)
  begin
    rw [image_subobject_map_comp_image_to_kernel_assoc w w' α β p],
    simp only [cokernel.condition, comp_zero],
  end

@[simp, reassoc, elementwise]
lemma homology.π_map (p : α.right = β.left) :
  homology.π f g w ≫ homology.map w w' α β p = kernel_subobject_map β ≫ homology.π f' g' w' :=
by simp only [homology.π, homology.map, cokernel.π_desc]

@[simp, reassoc, elementwise]
lemma homology.map_desc (p : α.right = β.left)
  {D : V} (k : (kernel_subobject g' : V) ⟶ D) (z : image_to_kernel f' g' w' ≫ k = 0) :
  homology.map w w' α β p ≫ homology.desc f' g' w' k z =
    homology.desc f g w (kernel_subobject_map β ≫ k)
      (by simp only [image_subobject_map_comp_image_to_kernel_assoc w w' α β p, z, comp_zero]) :=
by ext; simp only [homology.π_desc, homology.π_map_assoc]

@[simp]
lemma homology.map_id : homology.map w w (𝟙 _) (𝟙 _) rfl = 𝟙 _ :=
by ext; simp only [homology.π_map, kernel_subobject_map_id, category.id_comp, category.comp_id]

/-- Auxiliary lemma for homology computations. -/
lemma homology.comp_right_eq_comp_left
  {V : Type*} [category V] {A₁ B₁ C₁ A₂ B₂ C₂ A₃ B₃ C₃ : V}
  {f₁ : A₁ ⟶ B₁} {g₁ : B₁ ⟶ C₁} {f₂ : A₂ ⟶ B₂} {g₂ : B₂ ⟶ C₂} {f₃ : A₃ ⟶ B₃} {g₃ : B₃ ⟶ C₃}
  {α₁ : arrow.mk f₁ ⟶ arrow.mk f₂} {β₁ : arrow.mk g₁ ⟶ arrow.mk g₂}
  {α₂ : arrow.mk f₂ ⟶ arrow.mk f₃} {β₂ : arrow.mk g₂ ⟶ arrow.mk g₃}
  (p₁ : α₁.right = β₁.left) (p₂ : α₂.right = β₂.left) :
  (α₁ ≫ α₂).right = (β₁ ≫ β₂).left :=
by simp only [comma.comp_left, comma.comp_right, p₁, p₂]

@[reassoc]
lemma homology.map_comp (p₁ : α₁.right = β₁.left) (p₂ : α₂.right = β₂.left) :
  homology.map w₁ w₂ α₁ β₁ p₁ ≫ homology.map w₂ w₃ α₂ β₂ p₂ =
    homology.map w₁ w₃ (α₁ ≫ α₂) (β₁ ≫ β₂) (homology.comp_right_eq_comp_left p₁ p₂) :=
by ext; simp only [kernel_subobject_map_comp, homology.π_map_assoc, homology.π_map, category.assoc]

/-- An isomorphism between two three-term complexes induces an isomorphism on homology. -/
def homology.map_iso (α : arrow.mk f₁ ≅ arrow.mk f₂) (β : arrow.mk g₁ ≅ arrow.mk g₂)
  (p : α.hom.right = β.hom.left) :
  homology f₁ g₁ w₁ ≅ homology f₂ g₂ w₂ :=
{ hom := homology.map w₁ w₂ α.hom β.hom p,
  inv := homology.map w₂ w₁ α.inv β.inv
  (by { rw [← cancel_mono (α.hom.right), ← comma.comp_right, α.inv_hom_id, comma.id_right, p,
      ← comma.comp_left, β.inv_hom_id, comma.id_left], refl }),
  hom_inv_id' := by { rw [homology.map_comp], convert homology.map_id _; rw [iso.hom_inv_id] },
  inv_hom_id' := by { rw [homology.map_comp], convert homology.map_id _; rw [iso.inv_hom_id] } }

end

end

section
variables {A B C : V} {f : A ⟶ B} {g : B ⟶ C} (w : f ≫ g = 0)
  {f' : A ⟶ B} {g' : B ⟶ C} (w' : f' ≫ g' = 0)
  [has_kernels V] [has_cokernels V] [has_images V] [has_image_maps V]

/-- Custom tactic to golf and speedup boring proofs in `homology.congr`. -/
private meta def aux_tac : tactic unit :=
`[ dsimp only [auto_param_eq], erw [category.id_comp, category.comp_id], cases pf, cases pg, refl ]

/--
`homology f g w ≅ homology f' g' w'` if `f = f'` and `g = g'`.
(Note the objects are not changing here.)
-/
@[simps]
def homology.congr (pf : f = f') (pg : g = g') : homology f g w ≅ homology f' g' w' :=
{ hom := homology.map w w' ⟨𝟙 _, 𝟙 _, by aux_tac⟩ ⟨𝟙 _, 𝟙 _, by aux_tac⟩ rfl,
  inv := homology.map w' w ⟨𝟙 _, 𝟙 _, by aux_tac⟩ ⟨𝟙 _, 𝟙 _, by aux_tac⟩ rfl,
  hom_inv_id' := begin
    cases pf, cases pg, rw [homology.map_comp, ← homology.map_id],
    congr' 1; exact category.comp_id _,
  end,
  inv_hom_id' := begin
    cases pf, cases pg, rw [homology.map_comp, ← homology.map_id],
    congr' 1; exact category.comp_id _,
  end, }

end

/-!
We provide a variant `image_to_kernel' : image f ⟶ kernel g`,
and use this to give alternative formulas for `homology f g w`.
-/
section image_to_kernel'
variables {A B C : V} (f : A ⟶ B) (g : B ⟶ C) (w : f ≫ g = 0)
  [has_kernels V] [has_images V]

/--
While `image_to_kernel f g w` provides a morphism
`image_subobject f ⟶ kernel_subobject g`
in terms of the subobject API,
this variant provides a morphism
`image f ⟶ kernel g`,
which is sometimes more convenient.
-/
def image_to_kernel' (w : f ≫ g = 0) : image f ⟶ kernel g :=
kernel.lift g (image.ι f) (by { ext, simpa using w, })

@[simp] lemma image_subobject_iso_image_to_kernel' (w : f ≫ g = 0) :
  (image_subobject_iso f).hom ≫ image_to_kernel' f g w =
    image_to_kernel f g w ≫ (kernel_subobject_iso g).hom :=
by { ext, simp [image_to_kernel'], }

@[simp] lemma image_to_kernel'_kernel_subobject_iso (w : f ≫ g = 0) :
  image_to_kernel' f g w ≫ (kernel_subobject_iso g).inv =
    (image_subobject_iso f).inv ≫ image_to_kernel f g w :=
by { ext, simp [image_to_kernel'], }

variables [has_cokernels V]

/--
`homology f g w` can be computed as the cokernel of `image_to_kernel' f g w`.
-/
def homology_iso_cokernel_image_to_kernel' (w : f ≫ g = 0) :
  homology f g w ≅ cokernel (image_to_kernel' f g w) :=
{ hom := cokernel.map _ _ (image_subobject_iso f).hom (kernel_subobject_iso g).hom
    (by simp only [image_subobject_iso_image_to_kernel']),
  inv := cokernel.map _ _ (image_subobject_iso f).inv (kernel_subobject_iso g).inv
    (by simp only [image_to_kernel'_kernel_subobject_iso]),
  hom_inv_id' := begin
    apply coequalizer.hom_ext,
    simp only [iso.hom_inv_id_assoc, cokernel.π_desc, cokernel.π_desc_assoc, category.assoc,
      coequalizer_as_cokernel],
    exact (category.comp_id _).symm,
  end,
  inv_hom_id' := by { ext1, simp only [iso.inv_hom_id_assoc, cokernel.π_desc, category.comp_id,
    cokernel.π_desc_assoc, category.assoc], } }

variables [has_equalizers V]

/--
`homology f g w` can be computed as the cokernel of `kernel.lift g f w`.
-/
def homology_iso_cokernel_lift (w : f ≫ g = 0) :
  homology f g w ≅ cokernel (kernel.lift g f w) :=
begin
  refine homology_iso_cokernel_image_to_kernel' f g w ≪≫ _,
  have p : factor_thru_image f ≫ image_to_kernel' f g w = kernel.lift g f w,
  { ext, simp [image_to_kernel'], },
  exact (cokernel_epi_comp _ _).symm ≪≫ cokernel_iso_of_eq p,
end

end image_to_kernel'


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.adjunction
import category_theory.elements
import category_theory.limits.functor_category
import category_theory.limits.preserves.limits
import category_theory.limits.shapes.terminal
import category_theory.limits.types

/-!
# Colimit of representables

This file constructs an adjunction `yoneda_adjunction` between `(Cᵒᵖ ⥤ Type u)` and `ℰ` given a
functor `A : C ⥤ ℰ`, where the right adjoint sends `(E : ℰ)` to `c ↦ (A.obj c ⟶ E)` (provided `ℰ`
has colimits).

This adjunction is used to show that every presheaf is a colimit of representables.

Further, the left adjoint `colimit_adj.extend_along_yoneda : (Cᵒᵖ ⥤ Type u) ⥤ ℰ` satisfies
`yoneda ⋙ L ≅ A`, that is, an extension of `A : C ⥤ ℰ` to `(Cᵒᵖ ⥤ Type u) ⥤ ℰ` through
`yoneda : C ⥤ Cᵒᵖ ⥤ Type u`. It is the left Kan extension of `A` along the yoneda embedding,
sometimes known as the Yoneda extension.

`unique_extension_along_yoneda` shows `extend_along_yoneda` is unique amongst cocontinuous functors
with this property, establishing the presheaf category as the free cocompletion of a small category.

## Tags
colimit, representable, presheaf, free cocompletion

## References
* [S. MacLane, I. Moerdijk, *Sheaves in Geometry and Logic*][MM92]
* https://ncatlab.org/nlab/show/Yoneda+extension
-/

namespace category_theory

noncomputable theory

open category limits
universes u₁ u₂

variables {C : Type u₁} [small_category C]
variables {ℰ : Type u₂} [category.{u₁} ℰ]
variable (A : C ⥤ ℰ)

namespace colimit_adj

/--
The functor taking `(E : ℰ) (c : Cᵒᵖ)` to the homset `(A.obj C ⟶ E)`. It is shown in `L_adjunction`
that this functor has a left adjoint (provided `E` has colimits) given by taking colimits over
categories of elements.
In the case where `ℰ = Cᵒᵖ ⥤ Type u` and `A = yoneda`, this functor is isomorphic to the identity.

Defined as in [MM92], Chapter I, Section 5, Theorem 2.
-/
@[simps]
def restricted_yoneda : ℰ ⥤ (Cᵒᵖ ⥤ Type u₁) :=
yoneda ⋙ (whiskering_left _ _ (Type u₁)).obj (functor.op A)

/--
The functor `restricted_yoneda` is isomorphic to the identity functor when evaluated at the yoneda
embedding.
-/
def restricted_yoneda_yoneda : restricted_yoneda (yoneda : C ⥤ Cᵒᵖ ⥤ Type u₁) ≅ 𝟭 _ :=
nat_iso.of_components
(λ P, nat_iso.of_components (λ X, yoneda_sections_small X.unop _)
  (λ X Y f, funext $ λ x,
  begin
    dsimp,
    rw ← functor_to_types.naturality _ _ x f (𝟙 _),
    dsimp,
    simp,
  end))
(λ _ _ _, rfl)

/--
(Implementation). The equivalence of homsets which helps construct the left adjoint to
`colimit_adj.restricted_yoneda`.
It is shown in `restrict_yoneda_hom_equiv_natural` that this is a natural bijection.
-/
def restrict_yoneda_hom_equiv (P : Cᵒᵖ ⥤ Type u₁) (E : ℰ)
  {c : cocone ((category_of_elements.π P).left_op ⋙ A)} (t : is_colimit c) :
  (c.X ⟶ E) ≃ (P ⟶ (restricted_yoneda A).obj E) :=
(t.hom_iso' E).to_equiv.trans
{ to_fun := λ k,
  { app := λ c p, k.1 (opposite.op ⟨_, p⟩),
    naturality' := λ c c' f, funext $ λ p,
      (k.2 (quiver.hom.op ⟨f, rfl⟩ :
              (opposite.op ⟨c', P.map f p⟩ : P.elementsᵒᵖ) ⟶ opposite.op ⟨c, p⟩)).symm },
  inv_fun := λ τ,
  { val := λ p, τ.app p.unop.1 p.unop.2,
    property := λ p p' f,
    begin
      simp_rw [← f.unop.2],
      apply (congr_fun (τ.naturality f.unop.1) p'.unop.2).symm,
    end },
  left_inv :=
  begin
    rintro ⟨k₁, k₂⟩,
    ext,
    dsimp,
    congr' 1,
    simp,
  end,
  right_inv :=
  begin
    rintro ⟨_, _⟩,
    refl,
  end }

/--
(Implementation). Show that the bijection in `restrict_yoneda_hom_equiv` is natural (on the right).
-/
lemma restrict_yoneda_hom_equiv_natural (P : Cᵒᵖ ⥤ Type u₁) (E₁ E₂ : ℰ) (g : E₁ ⟶ E₂)
  {c : cocone _} (t : is_colimit c) (k : c.X ⟶ E₁) :
restrict_yoneda_hom_equiv A P E₂ t (k ≫ g) =
  restrict_yoneda_hom_equiv A P E₁ t k ≫ (restricted_yoneda A).map g :=
begin
  ext _ X p,
  apply (assoc _ _ _).symm,
end

variables [has_colimits ℰ]

/--
The left adjoint to the functor `restricted_yoneda` (shown in `yoneda_adjunction`). It is also an
extension of `A` along the yoneda embedding (shown in `is_extension_along_yoneda`), in particular
it is the left Kan extension of `A` through the yoneda embedding.
-/
def extend_along_yoneda : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ :=
adjunction.left_adjoint_of_equiv
  (λ P E, restrict_yoneda_hom_equiv A P E (colimit.is_colimit _))
  (λ P E E' g, restrict_yoneda_hom_equiv_natural A P E E' g _)

@[simp]
lemma extend_along_yoneda_obj (P : Cᵒᵖ ⥤ Type u₁) : (extend_along_yoneda A).obj P =
colimit ((category_of_elements.π P).left_op ⋙ A) := rfl

/--
Show `extend_along_yoneda` is left adjoint to `restricted_yoneda`.

The construction of [MM92], Chapter I, Section 5, Theorem 2.
-/
def yoneda_adjunction : extend_along_yoneda A ⊣ restricted_yoneda A :=
adjunction.adjunction_of_equiv_left _ _

/--
The initial object in the category of elements for a representable functor. In `is_initial` it is
shown that this is initial.
-/
def elements.initial (A : C) : (yoneda.obj A).elements :=
⟨opposite.op A, 𝟙 _⟩

/--
Show that `elements.initial A` is initial in the category of elements for the `yoneda` functor.
-/
def is_initial (A : C) : is_initial (elements.initial A) :=
{ desc := λ s, ⟨s.X.2.op, comp_id _⟩,
  uniq' := λ s m w,
  begin
    simp_rw ← m.2,
    dsimp [elements.initial],
    simp,
  end }

/--
`extend_along_yoneda A` is an extension of `A` to the presheaf category along the yoneda embedding.
`unique_extension_along_yoneda` shows it is unique among functors preserving colimits with this
property (up to isomorphism).

The first part of [MM92], Chapter I, Section 5, Corollary 4.
See Property 1 of https://ncatlab.org/nlab/show/Yoneda+extension#properties.
-/
def is_extension_along_yoneda : (yoneda : C ⥤ Cᵒᵖ ⥤ Type u₁) ⋙ extend_along_yoneda A ≅ A :=
nat_iso.of_components
(λ X, (colimit.is_colimit _).cocone_point_unique_up_to_iso
      (colimit_of_diagram_terminal (terminal_op_of_initial (is_initial _)) _))
begin
  intros X Y f,
  change (colimit.desc _ ⟨_, _⟩ ≫ colimit.desc _ _) = colimit.desc _ _ ≫ _,
  apply colimit.hom_ext,
  intro j,
  rw [colimit.ι_desc_assoc, colimit.ι_desc_assoc],
  change (colimit.ι _ _ ≫ 𝟙 _) ≫ colimit.desc _ _ = _,
  rw [comp_id, colimit.ι_desc],
  dsimp,
  rw ← A.map_comp,
  congr' 1,
end

/-- See Property 2 of https://ncatlab.org/nlab/show/Yoneda+extension#properties. -/
instance : preserves_colimits (extend_along_yoneda A) :=
(yoneda_adjunction A).left_adjoint_preserves_colimits

end colimit_adj

open colimit_adj

/--
Since `extend_along_yoneda A` is adjoint to `restricted_yoneda A`, if we use `A = yoneda`
then `restricted_yoneda A` is isomorphic to the identity, and so `extend_along_yoneda A` is as well.
-/
def extend_along_yoneda_yoneda : extend_along_yoneda (yoneda : C ⥤ _) ≅ 𝟭 _ :=
adjunction.nat_iso_of_right_adjoint_nat_iso
  (yoneda_adjunction _)
  adjunction.id
  restricted_yoneda_yoneda

/--
A functor to the presheaf category in which everything in the image is representable (witnessed
by the fact that it factors through the yoneda embedding).
`cocone_of_representable` gives a cocone for this functor which is a colimit and has point `P`.
-/
-- Maybe this should be reducible or an abbreviation?
def functor_to_representables (P : Cᵒᵖ ⥤ Type u₁) :
  (P.elements)ᵒᵖ ⥤ Cᵒᵖ ⥤ Type u₁ :=
(category_of_elements.π P).left_op ⋙ yoneda

/--
This is a cocone with point `P` for the functor `functor_to_representables P`. It is shown in
`colimit_of_representable P` that this cocone is a colimit: that is, we have exhibited an arbitrary
presheaf `P` as a colimit of representables.

The construction of [MM92], Chapter I, Section 5, Corollary 3.
-/
def cocone_of_representable (P : Cᵒᵖ ⥤ Type u₁) :
  cocone (functor_to_representables P) :=
cocone.extend (colimit.cocone _) (extend_along_yoneda_yoneda.hom.app P)

@[simp] lemma cocone_of_representable_X (P : Cᵒᵖ ⥤ Type u₁) :
  (cocone_of_representable P).X = P :=
rfl

/-- An explicit formula for the legs of the cocone `cocone_of_representable`. -/
-- Marking this as a simp lemma seems to make things more awkward.
lemma cocone_of_representable_ι_app (P : Cᵒᵖ ⥤ Type u₁) (j : (P.elements)ᵒᵖ):
  (cocone_of_representable P).ι.app j = (yoneda_sections_small _ _).inv j.unop.2 :=
colimit.ι_desc _ _

/-- The legs of the cocone `cocone_of_representable` are natural in the choice of presheaf. -/
lemma cocone_of_representable_naturality {P₁ P₂ : Cᵒᵖ ⥤ Type u₁} (α : P₁ ⟶ P₂)
  (j : (P₁.elements)ᵒᵖ) :
  (cocone_of_representable P₁).ι.app j ≫ α =
    (cocone_of_representable P₂).ι.app ((category_of_elements.map α).op.obj j) :=
begin
  ext T f,
  simpa [cocone_of_representable_ι_app] using functor_to_types.naturality _ _ α f.op _,
end

/--
The cocone with point `P` given by `the_cocone` is a colimit: that is, we have exhibited an
arbitrary presheaf `P` as a colimit of representables.

The result of [MM92], Chapter I, Section 5, Corollary 3.
-/
def colimit_of_representable (P : Cᵒᵖ ⥤ Type u₁) : is_colimit (cocone_of_representable P) :=
begin
  apply is_colimit.of_point_iso (colimit.is_colimit (functor_to_representables P)),
  change is_iso (colimit.desc _ (cocone.extend _ _)),
  rw [colimit.desc_extend, colimit.desc_cocone],
  apply_instance,
end

/--
Given two functors L₁ and L₂ which preserve colimits, if they agree when restricted to the
representable presheaves then they agree everywhere.
-/
def nat_iso_of_nat_iso_on_representables (L₁ L₂ : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ)
  [preserves_colimits L₁] [preserves_colimits L₂]
  (h : yoneda ⋙ L₁ ≅ yoneda ⋙ L₂) : L₁ ≅ L₂ :=
begin
  apply nat_iso.of_components _ _,
  { intro P,
    refine (is_colimit_of_preserves L₁ (colimit_of_representable P)).cocone_points_iso_of_nat_iso
           (is_colimit_of_preserves L₂ (colimit_of_representable P)) _,
    apply functor.associator _ _ _ ≪≫ _,
    exact iso_whisker_left (category_of_elements.π P).left_op h },
  { intros P₁ P₂ f,
    apply (is_colimit_of_preserves L₁ (colimit_of_representable P₁)).hom_ext,
    intro j,
    dsimp only [id.def, is_colimit.cocone_points_iso_of_nat_iso_hom, iso_whisker_left_hom],
    have :
      (L₁.map_cocone (cocone_of_representable P₁)).ι.app j ≫ L₁.map f =
      (L₁.map_cocone (cocone_of_representable P₂)).ι.app ((category_of_elements.map f).op.obj j),
    { dsimp,
      rw [← L₁.map_comp, cocone_of_representable_naturality],
      refl },
    rw [reassoc_of this, is_colimit.ι_map_assoc, is_colimit.ι_map],
    dsimp,
    rw [← L₂.map_comp, cocone_of_representable_naturality],
    refl }
end

variable [has_colimits ℰ]

/--
Show that `extend_along_yoneda` is the unique colimit-preserving functor which extends `A` to
the presheaf category.

The second part of [MM92], Chapter I, Section 5, Corollary 4.
See Property 3 of https://ncatlab.org/nlab/show/Yoneda+extension#properties.
-/
def unique_extension_along_yoneda (L : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ) (hL : yoneda ⋙ L ≅ A)
  [preserves_colimits L] :
  L ≅ extend_along_yoneda A :=
nat_iso_of_nat_iso_on_representables _ _ (hL ≪≫ (is_extension_along_yoneda _).symm)

/--
If `L` preserves colimits and `ℰ` has them, then it is a left adjoint. This is a special case of
`is_left_adjoint_of_preserves_colimits` used to prove that.
-/
def is_left_adjoint_of_preserves_colimits_aux (L : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ) [preserves_colimits L] :
  is_left_adjoint L :=
{ right := restricted_yoneda (yoneda ⋙ L),
  adj := (yoneda_adjunction _).of_nat_iso_left
            ((unique_extension_along_yoneda _ L (iso.refl _)).symm) }

/--
If `L` preserves colimits and `ℰ` has them, then it is a left adjoint. Note this is a (partial)
converse to `left_adjoint_preserves_colimits`.
-/
def is_left_adjoint_of_preserves_colimits (L : (C ⥤ Type u₁) ⥤ ℰ) [preserves_colimits L] :
  is_left_adjoint L :=
let e : (_ ⥤ Type u₁) ≌ (_ ⥤ Type u₁) := (op_op_equivalence C).congr_left,
    t := is_left_adjoint_of_preserves_colimits_aux (e.functor ⋙ L : _)
in by exactI adjunction.left_adjoint_of_nat_iso (e.inv_fun_id_assoc _)

end category_theory