import condensed.ab
import condensed.short_exact
import for_mathlib.AddCommGroup.direct_sum_colimit

import for_mathlib.AddCommGroup.explicit_products

open_locale classical big_operators

open category_theory
open category_theory.limits
open opposite

namespace Condensed

universes u
variables (F : as_small.{u+1} ℕ ⥤ Condensed.{u} Ab.{u+1})

noncomputable theory

def coproduct_to_colimit : (∐ F.obj) ⟶ colimit F :=
sigma.desc (λ i, colimit.ι _ i)

def coproduct_to_coproduct :
  (∐ F.obj) ⟶ (∐ F.obj)  :=
sigma.desc $ λ i,
  F.map (as_small.up.map $ hom_of_le $ nat.le_succ _) ≫
  sigma.ι _ (as_small.up.obj (as_small.down.obj i + 1))

def sigma_eval_iso {α : Type (u+1)} (X : α → Condensed.{u} Ab.{u+1})
  (S : ExtrDisc.{u}) :
  (∐ X).val.obj (op S.val) ≅ ∐ (λ a, (X a).val.obj (op S.val)) :=
preserves_colimit_iso (Condensed.evaluation _ S.val) _ ≪≫
has_colimit.iso_of_nat_iso (discrete.nat_iso $ λ i, iso.refl _)

@[reassoc]
lemma ι_sigma_eval_iso {α : Type (u+1)} (X : α → Condensed.{u} Ab.{u+1})
  (S : ExtrDisc.{u}) (i : α) :
  (sigma.ι X i : X i ⟶ _).val.app (op S.val) ≫
  (sigma_eval_iso X S).hom = sigma.ι _ i :=
begin
  dsimp only [sigma_eval_iso],
  erw (is_colimit_of_preserves (Condensed.evaluation _ S.val) _).fac_assoc,
  erw colimit.ι_desc, dsimp, simp,
end

def sigma_eval_iso_direct_sum
  {α : Type (u+1)} (X : α → Condensed.{u} Ab.{u+1})
  (S : ExtrDisc.{u}) :
  (∐ X).val.obj (op S.val) ≅
  AddCommGroup.of (direct_sum α $ λ i, (X i).val.obj (op S.val)) :=
let φ : α → AddCommGroup.{u+1} := λ i, (X i).val.obj (op S.val) in
sigma_eval_iso _ _ ≪≫
(colimit.is_colimit (discrete.functor φ)).cocone_point_unique_up_to_iso
  (AddCommGroup.is_colimit_direct_sum_cofan.{u+1 u+1} φ)

def shift_cofan (S : ExtrDisc.{u}) (T : cofan (λ i, (F.obj i).val.obj (op S.val))) :
  cofan (λ i, (F.obj i).val.obj (op S.val)) :=
cofan.mk T.X $ λ (i : as_small.{u+1} ℕ),
begin
  refine _ ≫ T.ι.app ⟨as_small.up.obj $ as_small.down.obj i + 1⟩,
  refine (F.map _).val.app _,
  refine as_small.up.map _,
  refine hom_of_le _,
  exact nat.le_succ _,
end

def direct_sum_to_direct_sum (S : ExtrDisc.{u}) :
  AddCommGroup.of (direct_sum (as_small.{u+1} ℕ) (λ i, (F.obj i).val.obj (op S.val))) ⟶
  AddCommGroup.of (direct_sum (as_small.{u+1} ℕ) (λ i, (F.obj i).val.obj (op S.val))) :=
let φ : as_small.{u+1} ℕ → AddCommGroup := λ i, (F.obj i).val.obj (op S.val) in
(AddCommGroup.is_colimit_direct_sum_cofan.{u+1 u+1} φ).desc
  (shift_cofan F S $ AddCommGroup.direct_sum_cofan.{u+1 u+1} φ)

def direct_sum_to_explicit_colimit (S : ExtrDisc.{u}) :
  AddCommGroup.of (direct_sum (as_small.{u+1} ℕ) (λ i, (F.obj i).val.obj (op S.val))) ⟶
  (AddCommGroup.explicit_cocone (F ⋙ Condensed.evaluation _ S.val)).X :=
(AddCommGroup.is_colimit_direct_sum_cofan.{u+1 u+1} (λ i, (F.obj i).val.obj (op S.val))).desc
(cofan.mk (AddCommGroup.explicit_cocone (F ⋙ Condensed.evaluation _ S.val)).X $
  λ i, (AddCommGroup.explicit_cocone.{u+1}
  (F ⋙ Condensed.evaluation _ S.val)).ι.app i)

lemma key_lemma_aux (S : ExtrDisc.{u}) :
  direct_sum_to_explicit_colimit F S = quotient_add_group.mk' _ :=
begin
  apply (AddCommGroup.is_colimit_direct_sum_cofan.{u+1 u+1}
      (λ i, (F.obj i).val.obj (op S.val))).hom_ext, intros j,
  erw (AddCommGroup.is_colimit_direct_sum_cofan.{u+1 u+1}
      (λ i, (F.obj i).val.obj (op S.val))).fac, ext t,
  refl,
end

lemma key_lemma (S : ExtrDisc.{u}) :
  exact (direct_sum_to_direct_sum F S - 𝟙 _) (direct_sum_to_explicit_colimit F S) :=
begin
  rw AddCommGroup.exact_iff', split,
  { apply (AddCommGroup.is_colimit_direct_sum_cofan.{u+1 u+1}
      (λ i, (F.obj i).val.obj (op S.val))).hom_ext,
    intros j,
    simp only [preadditive.sub_comp, category.id_comp, preadditive.comp_sub, comp_zero],
    rw sub_eq_zero,
    dsimp [direct_sum_to_direct_sum, direct_sum_to_explicit_colimit],
    rw (AddCommGroup.is_colimit_direct_sum_cofan.{u+1 u+1}
      (λ i, (F.obj i).val.obj (op S.val))).fac_assoc,
    rw (AddCommGroup.is_colimit_direct_sum_cofan.{u+1 u+1}
      (λ i, (F.obj i).val.obj (op S.val))).fac,
    dsimp [shift_cofan], simp only [category.assoc],
    rw (AddCommGroup.is_colimit_direct_sum_cofan.{u+1 u+1}
      (λ i, (F.obj i).val.obj (op S.val))).fac,
    dsimp,
    apply (AddCommGroup.explicit_cocone (F ⋙ evaluation Ab S.val)).w },
  { rintros x hx, rw add_monoid_hom.mem_ker at hx, rw key_lemma_aux at hx,
    dsimp at hx,
    rw quotient_add_group.eq_zero_iff at hx,
    rw AddCommGroup.explicit_cocone_point_kernel_eq_of_as_small_nat at hx,
    apply add_subgroup.closure_induction hx,
    { rintros x ⟨i,t,rfl⟩, let tt := (AddCommGroup.direct_sum_cofan.{u+1 u+1}
        (λ j, (F.obj j).val.obj (op S.val))).ι.app ⟨i⟩ t,
      use tt,
      change _ - _ = _ - _, congr' 1,
      swap,
      { dsimp only [tt], rw id_apply,
        dsimp [AddCommGroup.direct_sum_cofan, AddCommGroup.direct_sum_ι],
        congr },
      { dsimp [tt], rw ← comp_apply,
        erw (AddCommGroup.is_colimit_direct_sum_cofan.{u+1 u+1}
          (λ j, (F.obj j).val.obj (op S.val))).fac,
        dsimp [shift_cofan, AddCommGroup.direct_sum_cofan, AddCommGroup.direct_sum_ι,
          AddCommGroup.to_as_small_succ],
        rw comp_apply,
        dsimp [AddCommGroup.as_small_succ],
        congr } },
    { use 0, simp only [map_zero], },
    { rintros x y ⟨x,rfl⟩ ⟨y,rfl⟩, use x + y, simp only [map_add], },
    { rintros x ⟨x,rfl⟩, use -x, simp only [map_neg], } },
end

lemma sigma_eval_iso_direct_sum_direct_sum_to_direct_sum (S : ExtrDisc.{u}) :
  (sigma_eval_iso_direct_sum F.obj S).hom ≫ direct_sum_to_direct_sum F S =
  (coproduct_to_coproduct _).val.app _ ≫ (sigma_eval_iso_direct_sum F.obj S).hom :=
begin
  apply (is_colimit_of_preserves (Condensed.evaluation Ab.{u+1} S.val)
    (colimit.is_colimit (discrete.functor F.obj))).hom_ext, intros j,
  dsimp [coproduct_to_coproduct],
  slice_rhs 1 2
  { rw [← nat_trans.comp_app, ← Sheaf.hom.comp_val, colimit.ι_desc], },
  dsimp [sigma_eval_iso_direct_sum, sigma_eval_iso], simp only [category.assoc],
  slice_lhs 1 2
  { erw (is_colimit_of_preserves (Condensed.evaluation Ab.{u+1} S.val)
    (colimit.is_colimit (discrete.functor F.obj))).fac },
  slice_rhs 2 3
  { erw (is_colimit_of_preserves (Condensed.evaluation Ab.{u+1} S.val)
    (colimit.is_colimit (discrete.functor F.obj))).fac },
  dsimp,
  simp only [has_colimit.iso_of_nat_iso_ι_hom, discrete.nat_iso_hom_app, category.assoc,
    colimit.comp_cocone_point_unique_up_to_iso_hom], dsimp,
  simp only [category.id_comp],
  erw (AddCommGroup.is_colimit_direct_sum_cofan.{u+1 u+1} (λ i, (F.obj i).val.obj (op S.val))).fac,
  refl,
end

def colimit_val_app_iso_explicit_colimit (S : ExtrDisc.{u}) :
  (colimit F).val.obj (op S.val) ≅
  (AddCommGroup.explicit_cocone (F ⋙ Condensed.evaluation _ S.val)).X :=
(is_colimit_of_preserves (Condensed.evaluation _ S.val)
  (colimit.is_colimit F)).cocone_point_unique_up_to_iso
  (AddCommGroup.is_colimit_explicit_cocone _)

lemma sigma_eval_iso_direct_sum_to_explicit_colimit (S : ExtrDisc.{u}) :
  (sigma_eval_iso_direct_sum F.obj S).hom ≫ direct_sum_to_explicit_colimit F S =
  (coproduct_to_colimit _).val.app _ ≫ (colimit_val_app_iso_explicit_colimit _ _).hom :=
begin
  apply (is_colimit_of_preserves (Condensed.evaluation Ab.{u+1} S.val)
    (colimit.is_colimit (discrete.functor F.obj))).hom_ext, intros j,
  dsimp [sigma_eval_iso_direct_sum, sigma_eval_iso, coproduct_to_colimit,
    colimit_val_app_iso_explicit_colimit],
  simp only [category.assoc],

  erw (is_colimit_of_preserves (Condensed.evaluation Ab.{u+1} S.val)
    (colimit.is_colimit (discrete.functor F.obj))).fac_assoc,
  slice_rhs 1 2
  { rw [← nat_trans.comp_app, ← Sheaf.hom.comp_val, colimit.ι_desc], },

  erw colimit.ι_desc_assoc,
  dsimp,
  simp only [category.id_comp, colimit.comp_cocone_point_unique_up_to_iso_hom_assoc],

  dsimp [direct_sum_to_explicit_colimit],
  erw
    (AddCommGroup.is_colimit_direct_sum_cofan.{u+1 u+1} (λ (i : as_small ℕ),
      (F.obj i).val.obj (op S.val))).fac,

  erw (is_colimit_of_preserves (evaluation Ab S.val) (colimit.is_colimit F)).fac,

  refl,
end

lemma ι_sigma_eval_iso_direct_sum {α : Type (u+1)} (X : α → Condensed.{u} Ab.{u+1})
  (S : ExtrDisc.{u}) (i : α) :
  (sigma.ι X i : X i ⟶ _).val.app (op S.val) ≫ (sigma_eval_iso_direct_sum X S).hom =
  direct_sum.of _ i :=
begin
  dsimp only [sigma_eval_iso_direct_sum],
  erw ι_sigma_eval_iso_assoc, erw colimit.ι_desc, refl,
end

instance epi_coproduct_to_colimit :
  epi (coproduct_to_colimit F) :=
begin
  constructor,
  intros Z a b h,
  apply colimit.hom_ext,
  intros j,
  apply_fun (λ e, sigma.ι F.obj j ≫ e) at h,
  dsimp [coproduct_to_colimit] at h,
  simpa using h,
end

instance mono_coproduct_to_coproduct :
  mono (coproduct_to_coproduct F - 𝟙 _) :=
begin
  rw mono_iff_ExtrDisc, intros S,
  let φ : as_small.{u+1} ℕ → AddCommGroup := λ i, (F.obj i).val.obj (op S.val),
  let e : (∐ F.obj).val.obj (ExtrDisc_to_Profinite.op.obj (op S)) ≅
    AddCommGroup.of (direct_sum (as_small.{u+1} ℕ) (λ i, φ i)) := sigma_eval_iso_direct_sum _ _,
  change mono (_ - _), dsimp,
  let D := AddCommGroup.direct_sum_cofan.{u+1 u+1} φ,
  let hD : is_colimit D := AddCommGroup.is_colimit_direct_sum_cofan _,
  let D' : cofan φ := cofan.mk D.X
    (λ i, _ ≫ D.ι.app ⟨as_small.up.obj (as_small.down.obj i + 1)⟩),
  swap,
  { refine (F.map _).val.app _,
    refine as_small.up.map _,
    refine hom_of_le _,
    exact nat.le_succ _ },
  let t : D.X ⟶ D'.X := (AddCommGroup.is_colimit_direct_sum_cofan.{u+1 u+1} φ).desc D',
  have ht : (coproduct_to_coproduct F).val.app (op S.val) = e.hom ≫ t ≫ e.inv,
  { rw [← category.assoc, iso.eq_comp_inv],
    apply (is_colimit_of_preserves (Condensed.evaluation Ab.{u+1} S.val)
      (colimit.is_colimit _)).hom_ext, rintro ⟨j⟩, swap, apply_instance,
    dsimp [coproduct_to_coproduct],
    rw [← category.assoc, ← nat_trans.comp_app, ← Sheaf.hom.comp_val, colimit.ι_desc],
    dsimp, rw category.assoc,
    erw ι_sigma_eval_iso_direct_sum,
    rw ← category.assoc,
    erw ι_sigma_eval_iso_direct_sum,
    exact (hD.fac D' ⟨j⟩).symm, },
  rw ht,
  have : 𝟙 ((∐ F.obj).val.obj (op S.val)) = e.hom ≫ 𝟙 _ ≫ e.inv, by simp,
  rw this,
  simp only [← preadditive.comp_sub, ← preadditive.sub_comp],
  suffices : mono (t - 𝟙 (AddCommGroup.of (direct_sum (as_small ℕ) (λ (i : as_small ℕ), ↥(φ i))))),
  { apply_with mono_comp { instances := ff }, apply_instance,
    apply_with mono_comp { instances := ff }, exact this, apply_instance },
  rw [AddCommGroup.mono_iff_injective, injective_iff_map_eq_zero],
  intros x hx,
  erw [sub_eq_zero, id_apply] at hx,
  ext ⟨i⟩,
  induction i with i IH,
  { rw ← hx,
    dsimp [t, AddCommGroup.is_colimit_direct_sum_cofan,
      AddCommGroup.direct_sum_desc, discrete.nat_trans, direct_sum.to_add_monoid],
    rw [dfinsupp.sum_add_hom_apply, dfinsupp.sum_apply],
    apply finset.sum_eq_zero,
    rintro ⟨j⟩ -, convert dif_neg _,
    intro H, rw ulift.ext_iff at H, revert H, apply nat.no_confusion },
  { rw ← hx,
    dsimp [t, AddCommGroup.is_colimit_direct_sum_cofan,
      AddCommGroup.direct_sum_desc, discrete.nat_trans, direct_sum.to_add_monoid],
    rw [dfinsupp.sum_add_hom_apply, dfinsupp.sum_apply],
    rw dfinsupp.zero_apply at IH,
    convert finset.sum_eq_single (ulift.up $ i) _ _,
    { rw [IH, add_monoid_hom.map_zero, dfinsupp.zero_apply], },
    { rintro ⟨j⟩ - hj, convert dif_neg _,
      intro H, apply hj, rw ulift.ext_iff at H ⊢, change i+1 = j+1 at H,
      change j = i, linarith only [H] },
    { intro, rw [IH, add_monoid_hom.map_zero, dfinsupp.zero_apply], } },
  recover, all_goals { apply_instance }
end

.

theorem exactness_in_the_middle_part_one :
  (coproduct_to_coproduct F - 𝟙 _) ≫ (coproduct_to_colimit F) = 0 :=
begin
  apply colimit.hom_ext, intros j,
  dsimp [coproduct_to_coproduct, coproduct_to_colimit],
  simp only [preadditive.comp_sub, preadditive.sub_comp, colimit.ι_desc_assoc,
    category.id_comp, category.comp_id, colimit.ι_desc],
  dsimp, simp,
end

theorem exactness_in_the_middle :
  exact (coproduct_to_coproduct F - 𝟙 _) (coproduct_to_colimit F) :=
begin
  rw exact_iff_ExtrDisc, intros S,
  let e₁ : (∐ F.obj).val.obj (ExtrDisc_to_Profinite.op.obj (op S)) ≅
    _ := sigma_eval_iso_direct_sum F.obj S,
  let e₂ : (colimit F).val.obj (op S.val) ≅ _ :=
    colimit_val_app_iso_explicit_colimit F S,
  let a := _, let b := _, change exact a b,
  have ha : a = e₁.hom ≫ (direct_sum_to_direct_sum _ _ - 𝟙 _) ≫ e₁.inv,
  { simp only [preadditive.sub_comp, category.id_comp, preadditive.comp_sub, iso.hom_inv_id],
    rw ← category.assoc,
    erw [sigma_eval_iso_direct_sum_direct_sum_to_direct_sum],
    simp only [category.assoc, iso.hom_inv_id, category.comp_id],
    refl },
  have hb : b = e₁.hom ≫ direct_sum_to_explicit_colimit _ _ ≫ e₂.inv,
  { dsimp [e₁, e₂],
    rw [← category.assoc, sigma_eval_iso_direct_sum_to_explicit_colimit],
    simp only [category.assoc, iso.hom_inv_id, category.comp_id],
    refl },
  rw [ha, hb], clear ha hb a b,
  suffices : exact (direct_sum_to_direct_sum F S - 𝟙 _) (direct_sum_to_explicit_colimit _ _),
  { rw ← category.assoc, apply exact_comp_inv_hom_comp,
    rw exact_iso_comp, rw exact_comp_iso, exact this },
  apply key_lemma,
end

theorem short_exact_sequence_aux :
  short_exact (coproduct_to_coproduct F - 𝟙 _) (coproduct_to_colimit F) :=
begin
  constructor,
  apply exactness_in_the_middle,
end

end Condensed


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta, Adam Topaz
-/
import category_theory.functor_category
import category_theory.fully_faithful
import category_theory.reflects_isomorphisms

namespace category_theory
open category

universes v₁ u₁ -- morphism levels before object levels. See note [category_theory universes].

variables (C : Type u₁) [category.{v₁} C]

/--
The data of a monad on C consists of an endofunctor T together with natural transformations
η : 𝟭 C ⟶ T and μ : T ⋙ T ⟶ T satisfying three equations:
- T μ_X ≫ μ_X = μ_(TX) ≫ μ_X (associativity)
- η_(TX) ≫ μ_X = 1_X (left unit)
- Tη_X ≫ μ_X = 1_X (right unit)
-/
structure monad extends C ⥤ C :=
(η' [] : 𝟭 _ ⟶ to_functor)
(μ' [] : to_functor ⋙ to_functor ⟶ to_functor)
(assoc' : ∀ X, to_functor.map (nat_trans.app μ' X) ≫ μ'.app _ = μ'.app _ ≫ μ'.app _ . obviously)
(left_unit' : ∀ X : C, η'.app (to_functor.obj X) ≫ μ'.app _ = 𝟙 _ . obviously)
(right_unit' : ∀ X : C, to_functor.map (η'.app X) ≫ μ'.app _ = 𝟙 _ . obviously)

/--
The data of a comonad on C consists of an endofunctor G together with natural transformations
ε : G ⟶ 𝟭 C and δ : G ⟶ G ⋙ G satisfying three equations:
- δ_X ≫ G δ_X = δ_X ≫ δ_(GX) (coassociativity)
- δ_X ≫ ε_(GX) = 1_X (left counit)
- δ_X ≫ G ε_X = 1_X (right counit)
-/
structure comonad extends C ⥤ C :=
(ε' [] : to_functor ⟶ 𝟭 _)
(δ' [] : to_functor ⟶ to_functor ⋙ to_functor)
(coassoc' : ∀ X, nat_trans.app δ' _ ≫ to_functor.map (δ'.app X) = δ'.app _ ≫ δ'.app _ . obviously)
(left_counit' : ∀ X : C, δ'.app X ≫ ε'.app (to_functor.obj X) = 𝟙 _ . obviously)
(right_counit' : ∀ X : C, δ'.app X ≫ to_functor.map (ε'.app X) = 𝟙 _ . obviously)

variables {C} (T : monad C) (G : comonad C)

instance coe_monad : has_coe (monad C) (C ⥤ C) := ⟨λ T, T.to_functor⟩
instance coe_comonad : has_coe (comonad C) (C ⥤ C) := ⟨λ G, G.to_functor⟩

@[simp] lemma monad_to_functor_eq_coe : T.to_functor = T := rfl
@[simp] lemma comonad_to_functor_eq_coe : G.to_functor = G := rfl

/-- The unit for the monad `T`. -/
def monad.η : 𝟭 _ ⟶ (T : C ⥤ C) := T.η'
/-- The multiplication for the monad `T`. -/
def monad.μ : (T : C ⥤ C) ⋙ (T : C ⥤ C) ⟶ T := T.μ'

/-- The counit for the comonad `G`. -/
def comonad.ε : (G : C ⥤ C) ⟶ 𝟭 _  := G.ε'
/-- The comultiplication for the comonad `G`. -/
def comonad.δ : (G : C ⥤ C) ⟶ (G : C ⥤ C) ⋙ G := G.δ'

/-- A custom simps projection for the functor part of a monad, as a coercion. -/
def monad.simps.coe := (T : C ⥤ C)
/-- A custom simps projection for the unit of a monad, in simp normal form. -/
def monad.simps.η : 𝟭 _ ⟶ (T : C ⥤ C) := T.η
/-- A custom simps projection for the multiplication of a monad, in simp normal form. -/
def monad.simps.μ : (T : C ⥤ C) ⋙ (T : C ⥤ C) ⟶ (T : C ⥤ C) := T.μ

/-- A custom simps projection for the functor part of a comonad, as a coercion. -/
def comonad.simps.coe := (G : C ⥤ C)
/-- A custom simps projection for the counit of a comonad, in simp normal form. -/
def comonad.simps.ε : (G : C ⥤ C) ⟶ 𝟭 _ := G.ε
/-- A custom simps projection for the comultiplication of a comonad, in simp normal form. -/
def comonad.simps.δ : (G : C ⥤ C) ⟶ (G : C ⥤ C) ⋙ (G : C ⥤ C) := G.δ

initialize_simps_projections category_theory.monad (to_functor → coe, η' → η, μ' → μ)
initialize_simps_projections category_theory.comonad (to_functor → coe, ε' → ε, δ' → δ)

@[reassoc]
lemma monad.assoc (T : monad C) (X : C) :
  (T : C ⥤ C).map (T.μ.app X) ≫ T.μ.app _ = T.μ.app _ ≫ T.μ.app _ :=
T.assoc' X

@[simp, reassoc] lemma monad.left_unit (T : monad C) (X : C) :
  T.η.app ((T : C ⥤ C).obj X) ≫ T.μ.app X = 𝟙 ((T : C ⥤ C).obj X) :=
T.left_unit' X

@[simp, reassoc] lemma monad.right_unit (T : monad C) (X : C) :
  (T : C ⥤ C).map (T.η.app X) ≫ T.μ.app X = 𝟙 ((T : C ⥤ C).obj X) :=
T.right_unit' X

@[reassoc]
lemma comonad.coassoc (G : comonad C) (X : C) :
  G.δ.app _ ≫ (G : C ⥤ C).map (G.δ.app X) = G.δ.app _ ≫ G.δ.app _ :=
G.coassoc' X

@[simp, reassoc] lemma comonad.left_counit (G : comonad C) (X : C) :
  G.δ.app X ≫ G.ε.app ((G : C ⥤ C).obj X) = 𝟙 ((G : C ⥤ C).obj X) :=
G.left_counit' X

@[simp, reassoc] lemma comonad.right_counit (G : comonad C) (X : C) :
  G.δ.app X ≫ (G : C ⥤ C).map (G.ε.app X) = 𝟙 ((G : C ⥤ C).obj X) :=
G.right_counit' X

/-- A morphism of monads is a natural transformation compatible with η and μ. -/
@[ext]
structure monad_hom (T₁ T₂ : monad C) extends nat_trans (T₁ : C ⥤ C) T₂ :=
(app_η' : ∀ X, T₁.η.app X ≫ app X = T₂.η.app X . obviously)
(app_μ' : ∀ X, T₁.μ.app X ≫ app X = ((T₁ : C ⥤ C).map (app X) ≫ app _) ≫ T₂.μ.app X . obviously)

/-- A morphism of comonads is a natural transformation compatible with ε and δ. -/
@[ext]
structure comonad_hom (M N : comonad C) extends nat_trans (M : C ⥤ C) N :=
(app_ε' : ∀ X, app X ≫ N.ε.app X = M.ε.app X . obviously)
(app_δ' : ∀ X, app X ≫ N.δ.app X = M.δ.app X ≫ app _ ≫ (N : C ⥤ C).map (app X) . obviously)

restate_axiom monad_hom.app_η'
restate_axiom monad_hom.app_μ'
attribute [simp, reassoc] monad_hom.app_η monad_hom.app_μ

restate_axiom comonad_hom.app_ε'
restate_axiom comonad_hom.app_δ'
attribute [simp, reassoc] comonad_hom.app_ε comonad_hom.app_δ

instance : category (monad C) :=
{ hom := monad_hom,
  id := λ M, { to_nat_trans := 𝟙 (M : C ⥤ C) },
  comp := λ _ _ _ f g,
  { to_nat_trans := { app := λ X, f.app X ≫ g.app X } } }

instance : category (comonad C) :=
{ hom := comonad_hom,
  id := λ M, { to_nat_trans := 𝟙 (M : C ⥤ C) },
  comp := λ M N L f g,
  { to_nat_trans := { app := λ X, f.app X ≫ g.app X } } }

instance {T : monad C} : inhabited (monad_hom T T) := ⟨𝟙 T⟩

@[simp]

instance {G : comonad C} : inhabited (comonad_hom G G) := ⟨𝟙 G⟩

@[simp] lemma comonad_hom.id_to_nat_trans (T : comonad C) :
  (𝟙 T : T ⟶ T).to_nat_trans = 𝟙 (T : C ⥤ C) :=
rfl
@[simp] lemma comp_to_nat_trans {T₁ T₂ T₃ : comonad C} (f : T₁ ⟶ T₂) (g : T₂ ⟶ T₃) :
  (f ≫ g).to_nat_trans =
    ((f.to_nat_trans : _ ⟶ (T₂ : C ⥤ C)) ≫ g.to_nat_trans : (T₁ : C ⥤ C) ⟶ T₃) :=
rfl

/-- Construct a monad isomorphism from a natural isomorphism of functors where the forward
direction is a monad morphism. -/
@[simps]
def monad_iso.mk {M N : monad C} (f : (M : C ⥤ C) ≅ N) (f_η f_μ) :
  M ≅ N :=
{ hom := { to_nat_trans := f.hom, app_η' := f_η, app_μ' := f_μ },
  inv :=
  { to_nat_trans := f.inv,
    app_η' := λ X, by simp [←f_η],
    app_μ' := λ X,
    begin
      rw ←nat_iso.cancel_nat_iso_hom_right f,
      simp only [nat_trans.naturality, iso.inv_hom_id_app, assoc, comp_id, f_μ,
        nat_trans.naturality_assoc, iso.inv_hom_id_app_assoc, ←functor.map_comp_assoc],
      simp,
    end } }

/-- Construct a comonad isomorphism from a natural isomorphism of functors where the forward
direction is a comonad morphism. -/
@[simps]
def comonad_iso.mk {M N : comonad C} (f : (M : C ⥤ C) ≅ N) (f_ε f_δ) :
  M ≅ N :=
{ hom := { to_nat_trans := f.hom, app_ε' := f_ε, app_δ' := f_δ },
  inv :=
  { to_nat_trans := f.inv,
    app_ε' := λ X, by simp [←f_ε],
    app_δ' := λ X,
    begin
      rw ←nat_iso.cancel_nat_iso_hom_left f,
      simp only [reassoc_of (f_δ X), iso.hom_inv_id_app_assoc, nat_trans.naturality_assoc],
      rw [←functor.map_comp, iso.hom_inv_id_app, functor.map_id],
      apply (comp_id _).symm
    end } }

variable (C)

/--
The forgetful functor from the category of monads to the category of endofunctors.
-/
@[simps]
def monad_to_functor : monad C ⥤ (C ⥤ C) :=
{ obj := λ T, T,
  map := λ M N f, f.to_nat_trans }

instance : faithful (monad_to_functor C) := {}.

@[simp]
lemma monad_to_functor_map_iso_monad_iso_mk {M N : monad C} (f : (M : C ⥤ C) ≅ N) (f_η f_μ) :
  (monad_to_functor _).map_iso (monad_iso.mk f f_η f_μ) = f :=
by { ext, refl }

instance : reflects_isomorphisms (monad_to_functor C) :=
{ reflects := λ M N f i,
  begin
    resetI,
    convert is_iso.of_iso (monad_iso.mk (as_iso ((monad_to_functor C).map f)) f.app_η f.app_μ),
    ext; refl,
  end }

/--
The forgetful functor from the category of comonads to the category of endofunctors.
-/
@[simps]
def comonad_to_functor : comonad C ⥤ (C ⥤ C) :=
{ obj := λ G, G,
  map := λ M N f, f.to_nat_trans }

instance : faithful (comonad_to_functor C) := {}.

@[simp]
lemma comonad_to_functor_map_iso_comonad_iso_mk {M N : comonad C} (f : (M : C ⥤ C) ≅ N) (f_ε f_δ) :
  (comonad_to_functor _).map_iso (comonad_iso.mk f f_ε f_δ) = f :=
by { ext, refl }

instance : reflects_isomorphisms (comonad_to_functor C) :=
{ reflects := λ M N f i,
  begin
    resetI,
    convert is_iso.of_iso (comonad_iso.mk (as_iso ((comonad_to_functor C).map f)) f.app_ε f.app_δ),
    ext; refl,
  end }

variable {C}

/--
An isomorphism of monads gives a natural isomorphism of the underlying functors.
-/
@[simps {rhs_md := semireducible}]
def monad_iso.to_nat_iso {M N : monad C} (h : M ≅ N) : (M : C ⥤ C) ≅ N :=
(monad_to_functor C).map_iso h

/--
An isomorphism of comonads gives a natural isomorphism of the underlying functors.
-/
@[simps {rhs_md := semireducible}]
def comonad_iso.to_nat_iso {M N : comonad C} (h : M ≅ N) : (M : C ⥤ C) ≅ N :=
(comonad_to_functor C).map_iso h

variable (C)

namespace monad

/-- The identity monad. -/
@[simps]
def id : monad C :=
{ to_functor := 𝟭 C,
  η' := 𝟙 (𝟭 C),
  μ' := 𝟙 (𝟭 C) }

instance : inhabited (monad C) := ⟨monad.id C⟩

end monad

namespace comonad

/-- The identity comonad. -/
@[simps]
def id : comonad C :=
{ to_functor := 𝟭 _,
  ε' := 𝟙 (𝟭 C),
  δ' := 𝟙 (𝟭 C) }

instance : inhabited (comonad C) := ⟨comonad.id C⟩

end comonad

end category_theory


import tactic
import category_theory.functor
import data.W.basic
import category_theory.closed.types
import algebra.category.CommRing.basic
import algebra.category.Module.basic

universes w x u v

open category_theory

variables (𝒞 : Type u) [category.{v} 𝒞]

@[protect_proj] structure struc : Type (max u v (w+1) (x+1)) :=
( F : 𝒞 → Type w )
( hom : Π (A B : sigma F) (f : A.1 ⟶ B.1), Type x )
( id : Π (A : sigma F), hom A A (𝟙 A.1) )
( comp : Π {A B C : sigma F}
    (f : Σ f : A.1 ⟶ B.1, hom A B f)
    (g : Σ g : B.1 ⟶ C.1, hom B C g),
    hom A C (f.1 ≫ g.1) )
( id_comp' : Π {A B : sigma F} (f : Σ f : A.1 ⟶ B.1, hom A B f),
    sigma.mk (𝟙 A.1 ≫ f.1) (comp ⟨𝟙 A.1, id A⟩ f) = f )
( comp_id' : Π {A B : sigma F} (f : Σ f : A.1 ⟶ B.1, hom A B f),
    sigma.mk (f.1 ≫ 𝟙 B.1) (comp f ⟨𝟙 B.1, id B⟩) = f )
( assoc' : Π {A B C D : sigma F}
    (f : Σ f : A.1 ⟶ B.1, hom A B f)
    (g : Σ g : B.1 ⟶ C.1, hom B C g)
    (h : Σ h : C.1 ⟶ D.1, hom C D h),
    sigma.mk ((f.1 ≫ g.1) ≫ h.1) (comp ⟨f.1 ≫ g.1, comp f g⟩ h) =
    sigma.mk (f.1 ≫ (g.1 ≫ h.1)) (comp f ⟨g.1 ≫ h.1, comp g h⟩) )

@[protect_proj] structure strucp : Type (max u v (w+1)) :=
( F : 𝒞 → Type w )
( hom : Π (A B : sigma F) (f : A.1 ⟶ B.1), Prop )
( id : Π (A : sigma F), hom A A (𝟙 A.1) )
( comp : Π {A B C : sigma F}
    (f : { f : A.1 ⟶ B.1 // hom A B f } )
    (g : { g : B.1 ⟶ C.1 // hom B C g } ),
    hom A C (f.1 ≫ g.1) )

namespace struc

instance : has_coe_to_fun (struc 𝒞) (λ _, 𝒞 → Type w) :=
{ coe := struc.F }

variables {𝒞} {F : struc 𝒞} {Fp : strucp 𝒞}

instance : category (sigma F) :=
{ hom := λ A B, Σ f : A.1 ⟶ B.1, F.hom A B f,
  id := λ A, ⟨𝟙 A.1, F.id A⟩,
  comp := λ A B C f g, ⟨f.1 ≫ g.1, F.comp f g⟩,
  comp_id' := λ A B f, F.comp_id' f,
  id_comp' := λ A B f, F.id_comp' f,
  assoc' := λ A B C D f g h, F.assoc' f g h }

def fst : sigma F ⥤ 𝒞 :=
{ obj := sigma.fst,
  map := λ _ _, sigma.fst,
  map_id' := λ _, rfl,
  map_comp' := λ _ _ _ _ _, rfl }

instance (X : 𝒞) : category_struct (F X) :=
{ hom := λ A B, F.hom ⟨X, A⟩ ⟨X, B⟩ (𝟙 X),
  id := λ A, F.id ⟨X, A⟩,
  comp := λ A B C f g, cast
    (show F.hom ⟨X, A⟩ ⟨X, C⟩ (𝟙 X ≫ 𝟙 X) = F.hom ⟨X, A⟩ ⟨X, C⟩ (𝟙 X), by simp)
    (@struc.comp 𝒞 _ F ⟨X, A⟩ ⟨X, B⟩ ⟨X, C⟩ ⟨𝟙 X, f⟩ ⟨𝟙 X, g⟩), }

lemma comp_mk_cast_left {A B C : sigma F}
  {f₁ f₂ : A.fst ⟶ B.fst} (h : f₁ = f₂)
  (f' : F.hom A B f₂)
  {g : Σ (g : B.fst ⟶ C.fst), F.hom B C g} :
  F.comp ⟨f₁, cast (by rw h) f'⟩ g =
  cast (show F.hom A C (f₂ ≫ g.fst) = F.hom A C (f₁ ≫ g.fst),
    by subst h) (F.comp ⟨f₂, f'⟩ g) :=
by subst h; refl

lemma comp_mk_cast_right {A B C : sigma F}
  {f : Σ (f : A.1 ⟶ B.1), F.hom A B f}
  {g₁ g₂ : B.fst ⟶ C.fst} (h : g₁ = g₂)
  (g' : F.hom B C g₂) :
  F.comp f ⟨g₁, cast (by rw h) g'⟩ =
  cast (show F.hom A C (f.1 ≫ g₂) = F.hom A C (f.1 ≫ g₁),
    by subst h) (F.comp f ⟨g₂, g'⟩) :=
by subst h; refl

instance (X : 𝒞) : category (F X) :=
{ comp_id' := λ A B f, cast_eq_iff_heq.2 $
    (sigma.ext_iff.1 (@category.comp_id (sigma F) _ ⟨X, A⟩ ⟨X, B⟩ ⟨𝟙 X, f⟩)).2,
  id_comp' := λ A B f, cast_eq_iff_heq.2 $
    (sigma.ext_iff.1 (@category.id_comp (sigma F) _ ⟨X, A⟩ ⟨X, B⟩ ⟨𝟙 X, f⟩)).2,
  assoc' := λ A B C D f g h, begin
    dunfold category_struct.comp,
    dsimp,
    rw [comp_mk_cast_left, comp_mk_cast_right, cast_cast, cast_cast, cast_eq_iff_heq],
    symmetry,
    rw [← cast_eq_iff_heq, cast_cast, cast_eq_iff_heq],
    exact (sigma.ext_iff.1 (@category.assoc (sigma F) _ ⟨X, A⟩ ⟨X, B⟩ ⟨X, C⟩ ⟨X, D⟩
      ⟨𝟙 X, f⟩ ⟨𝟙 X, g⟩ ⟨𝟙 X, h⟩)).2.symm,
    all_goals { simp; refl }
  end }

open opposite

-- def of_functor (F : 𝒞 ⥤ Type w) : struc 𝒞 :=
-- { F := F.obj,
--   cat :=
--   { hom := λ A B, {f : A.1 ⟶ B.1 // F.map f A.2 = B.2 },
--     id := λ A, ⟨𝟙 A.1, by simp⟩,
--     comp := λ A B C f g, ⟨f.1 ≫ g.1, by simp [f.prop, g.prop]⟩,
--     comp_id' := λ _ _ _, subtype.ext (category.comp_id _),
--     id_comp' := λ _ _ _, subtype.ext (category.id_comp _),
--     assoc' := λ _ _ _ _ _ _ _, subtype.ext (category.assoc _ _ _) },
--   fst_map := λ _ _, subtype.val,
--   fst_map_id := by intros; refl,
--   fst_map_comp := by intros; refl }

-- def Module₂ : struc Ring :=
-- { F := λ R, Module R,
--   cat :=
--   { hom := λ A B, Σ f : A.1 ⟶ B.1, A.2 →ₛₗ[f] B.2,
--     id := λ A, ⟨𝟙 A.1, linear_map.id⟩,
--     comp := λ A B C f g, ⟨f.1 ≫ g.1,
--       @linear_map.comp _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ⟨rfl⟩ g.2 f.2⟩,
--     comp_id' := by { intros, cases f, cases f_fst, cases f_snd, refl },
--     id_comp' := by { intros, cases f, cases f_fst, cases f_snd, refl },
--     assoc' := by { intros, refl } },
--   fst_map := λ _ _ f, f.fst,
--   fst_map_id := by intros; refl,
--   fst_map_comp := by intros; refl }

def of_category (𝒟 : Type*) [category 𝒟] : struc 𝒞 :=
{ F := λ _, 𝒟,

  fst_map := λ _ _, prod.fst,
  fst_map_id := λ _, rfl,
  fst_map_comp := by intros; refl }

variable (𝒞)

def type : struc 𝒞 := of_category (Type v)

def prop : struc 𝒞 := of_category Prop

lemma hcongr {α α' : Sort*}
  {β : α → Sort*} {β' : α' → Sort*} {f : Π a, β a}
  {g : Π a, β' a} (hβ : β == β')
  (a a') (h : f == g) (ha : a == a') :
  f a == g a' :=
begin
  have := type_eq_of_heq ha,
  subst this,
  simp at *,
  substs hβ ha,
  simp at *,
  subst h
end

def sigma_pi (F : 𝒞 ⥤ Type) (G : struc (sigma (of_functor F))) : struc 𝒞 :=
{ F := λ X, Π a : F.obj X, G.F ⟨X, a⟩,
  cat :=
  { hom := λ A B, Σ (f : A.1 ⟶ B.1),
      Π (a : of_functor F A.1) (b : of_functor F B.1) (hab : b = F.map f a),
      sigma.mk (sigma.mk A.1 a) (A.2 a) ⟶ sigma.mk (sigma.mk B.1 b) (B.2 b),
    id := λ X, ⟨𝟙 X.1, λ x y h, cast (by simp [F.map_id] at h; rw h)
        (𝟙 (sigma.mk (sigma.mk X.1 x) (X.2 x)))⟩,
    comp := λ X Y Z f g, ⟨f.1 ≫ g.1,
        λ a b h, cast (by simp) (f.2 a _ rfl ≫ g.2 (F.map f.1 a) b (by simp [h]))⟩,
    comp_id' := λ X Y f, begin
        cases f with f₁ f₂,
        ext,
        { simp },
        { refl },
        { intros a a' h,
          rw heq_iff_eq at h,
          subst a',
          dsimp,
          apply function.hfunext,
          { refl },
          { intros b b' h,
            rw [heq_iff_eq] at h,
            subst b',
            apply function.hfunext,
            simp,
            intros _ h _,
            subst h,
            simp } }
      end,
    id_comp' := λ X Y f, begin
        cases f with f₁ f₂,
        ext,
        { simp },
        { refl },
        { intros a a' h,
          dsimp,
          rw heq_iff_eq at h,
          subst a',
          apply function.hfunext,
          { refl },
          { intros b b' h,
            rw heq_iff_eq at h,
            subst b',
            apply function.hfunext,
            { simp * at * },
            { intros,
              simp * at *,
              convert category.id_comp (f₂ a b a'),
              { simp },
              { rw [F.map_id],
                refl },
              { simp },
              { simp } } } }
      end,
    assoc' := λ W X Y Z f g h, begin
        ext, simp [category.assoc],
        intros a a' h,
        rw [heq_iff_eq] at h,
        subst h,
        simp,
        apply function.hfunext,
        { refl },
        { intros b b' h,
          rw heq_iff_eq at h,
          subst b',
          apply function.hfunext,
          { simp [category.assoc] },
          { intros c c' h,
            simp,
            dsimp,
            congr,
            { simp },
            { rw F.map_comp, refl },
            { apply hcongr,
              apply function.hfunext,
              rw F.map_comp; refl,
              intros,
              rw [F.map_comp],
              refl,
              rw [F.map_comp],
              refl,
              exact proof_irrel_heq _ _ },
            { apply hcongr,
              apply function.hfunext,
              rw F.map_comp; refl,
              intros,
              rw [F.map_comp],
              refl,
              rw [F.map_comp],
              refl,
              exact proof_irrel_heq _ _ } } }
      end },
  fst_map := λ _ _ f, f.fst,
  fst_map_id := by intros; refl,
  fst_map_comp := by intros; refl }

example : 1 = 1 := rfl

def sigma_arrow (F : 𝒞 ⥤ Type) (G : struc 𝒞) : struc 𝒞 :=
{ F := λ X, F.obj X → G X,
  cat :=
  { hom := λ A B, Σ (f : A.1 ⟶ B.1),
      Π (a : of_functor F A.1) (b : of_functor F B.1) (h : b = F.map f a),
      { g : sigma.mk A.1 (A.2 a) ⟶ sigma.mk B.1 (B.2 b) // fst.map g = f } ,
    id := λ X, ⟨𝟙 X.1, λ x y h, ⟨cast (by simp [h]) (𝟙 (sigma.mk X.1 (X.2 x))),
      begin simp, end⟩⟩,
    comp := λ X Y Z f g, ⟨f.1 ≫ g.1,
        λ x z h, cast (by simp [h]) (f.2 x (F.map f.1 x) rfl ≫ g.2 (F.map f.1 x) z (by simp [h]))⟩,
    comp_id' := λ X Y f,
      begin
        cases f with f₁ f₂,
        ext,
        { simp },
        { refl },
        { intros a a' h,
          rw heq_iff_eq at h,
          subst a',
          apply function.hfunext,
          { refl },
          { intros b b' h,
            rw heq_iff_eq at h,
            subst b',
            dsimp,
            apply function.hfunext,
            { simp },
            { intros _ h _,
              subst h,
              simp } } }
      end,
    id_comp' := λ X Y f, begin
        cases f with f₁ f₂,
        ext,
        { simp },
        { refl },
        { intros a a' h,
          dsimp,
          rw heq_iff_eq at h,
          subst a',
          apply function.hfunext,
          { refl },
          { intros b b' h,
            rw heq_iff_eq at h,
            subst b',
            apply function.hfunext,
            { simp * at * },
            { intros,
              simp * at *,
              convert category.id_comp (f₂ a b a'),
              { simp },
              { simp },
              { simp } } } }
      end,
    assoc' := λ W X Y Z f g h, begin
        ext, simp [category.assoc],
        intros a a' h,
        rw [heq_iff_eq] at h,
        subst h,
        simp,
        apply function.hfunext,
        { refl },
        { intros b b' h,
          rw heq_iff_eq at h,
          subst b',
          apply function.hfunext,
          { simp [category.assoc] },
          { intros c c' h,
            simp,
            dsimp,
            congr,
            { simp },
            { apply hcongr,
              apply function.hfunext,
              rw F.map_comp; refl,
              intros,
              rw [F.map_comp],
              refl,
              rw [F.map_comp],
              refl,
              exact proof_irrel_heq _ _ },
            { apply hcongr,
              apply function.hfunext,
              rw F.map_comp; refl,
              intros,
              rw [F.map_comp],
              refl,
              rw [F.map_comp],
              refl,
              exact proof_irrel_heq _ _ } } }
      end },
  fst_map := λ _ _ f, f.fst,
  fst_map_id := by intros; refl,
  fst_map_comp := by intros; refl }

-- def sigma_arrow (F : struc 𝒞) (G : struc 𝒞) : struc 𝒞 :=
-- { F := λ X, Σ (i : F X → G X),
--     (Π (a b : F X), (sigma.mk X a ⟶ ⟨X, b⟩) →
--       { f : sigma.mk X (i a) ⟶ ⟨X, i b⟩ // fst.map f = 𝟙 X}),
--   cat :=
--   { hom := λ A B, Σ (f : A.1 ⟶ B.1), Π (a : F A.1) (b : F B.1),
--       (sigma.mk A.1 a ⟶ sigma.mk B.1 b) →
--       { g : (sigma.mk A.1 (A.2.1 a)) ⟶ (sigma.mk B.1 (B.2.1 b)) // fst.map g = f },
--     id := λ A, ⟨𝟙 _, λ a b f, A.2.2 a b f⟩,
--     comp := λ A B C f g, ⟨f.1 ≫ g.1, λ a c h,
--       begin
--         have := sigma.snd f a,

--       end⟩,
--     comp_id' := sorry,
--     id_comp' := sorry,
--     assoc' := sorry },

--   fst_map := λ _ _ f, f.fst,
--   fst_map_id := by intros; refl,
--   fst_map_comp := by intros; refl }

-- def sigma_pi₂ (F : struc 𝒞) (G : struc (sigma F)) : struc 𝒞 :=
-- { F := λ X, Σ (i : Π a : F X, G.F ⟨X, a⟩),
--     (Π (a b : F X) (f : sigma.mk X a ⟶ sigma.mk X b),
--       { g : sigma.mk (sigma.mk X a) (i a) ⟶ ⟨⟨X, b⟩, i b⟩ // fst.map g = f }),
--   cat :=
--   { hom := λ A B, Σ (f : A.1 ⟶ B.1), (Π (a : F A.1) (b : F B.1),
--       (sigma.mk A.1 a ⟶ sigma.mk B.1 b) →
--         (sigma.mk (sigma.mk A.1 a) (A.2.1 a) ⟶ ⟨⟨B.1, b⟩, B.2.1 b⟩)),
--     id := λ A, ⟨𝟙 _, λ a b f, (A.2.2 a b f).1⟩,
--     comp := λ A B C f g, ⟨f.1 ≫ g.1, λ a c h,
--       begin
--         have := sigma.snd f a,

--       end⟩,
--     comp_id' := sorry,
--     id_comp' := sorry,
--     assoc' := sorry },

--   fst_map := λ _ _ f, f.fst,
--   fst_map_id := by intros; refl,
--   fst_map_comp := by intros; refl }

end struc


import category_theory.abelian.projective
import for_mathlib.homological_complex_shift
import tactic.linarith
import algebra.homology.quasi_iso
import algebra.homology.homotopy
import for_mathlib.abelian_category

.

open category_theory category_theory.limits

open_locale zero_object

section zero_object

variables {V : Type*} [category V] [has_zero_morphisms V]

noncomputable
lemma split_epi_of_is_zero {X Y : V} (f : X ⟶ Y) (h : is_zero Y) : split_epi f :=
⟨0, by simp [is_zero_iff_id_eq_zero.mp h]⟩

lemma epi_of_is_zero {X Y : V} (f : X ⟶ Y) (h : is_zero Y) : epi f :=
@@split_epi.epi _ _ (split_epi_of_is_zero f h)

noncomputable
lemma split_mono_of_is_zero {X Y : V} (f : X ⟶ Y) (h : is_zero X) : split_mono f :=
⟨0, by simp [is_zero_iff_id_eq_zero.mp h]⟩

lemma mono_of_is_zero_object {X Y : V} (f : X ⟶ Y) (h : is_zero X) : mono f :=
@@split_mono.mono _ _ (split_mono_of_is_zero f h)

lemma is_iso_of_is_zero {X Y : V} (f : X ⟶ Y)
  (h₁ : is_zero X) (h₂ : is_zero Y) : is_iso f :=
begin
  use 0,
  rw [is_zero_iff_id_eq_zero.mp h₁, is_zero_iff_id_eq_zero.mp h₂],
  split; simp
end

end zero_object

variables {V : Type*} [category V] [abelian V] [enough_projectives V] (X : cochain_complex V ℤ)
variables (a : ℤ) (H : ∀ i (h : a ≤ i), is_zero (X.X i))

lemma comp_eq_to_hom_heq_iff {C : Type*} [category C] {X X' Y Y' Y'' : C}
  (f : X ⟶ Y) (f' : X' ⟶ Y') (e : Y = Y'') : f ≫ eq_to_hom e == f' ↔ f == f' :=
by { subst e, erw category.comp_id }

lemma eq_to_hom_comp_heq_iff {C : Type*} [category C] {X X' Y Y' X'' : C}
  (f : X ⟶ Y) (f' : X' ⟶ Y') (e : X'' = X) : eq_to_hom e ≫ f == f' ↔ f == f' :=
by { subst e, erw category.id_comp }

lemma heq_eq_to_hom_comp_iff {C : Type*} [category C] {X X' Y Y' X'' : C}
  (f : X ⟶ Y) (f' : X' ⟶ Y') (e : X'' = X') : f == eq_to_hom e ≫ f' ↔ f == f' :=
by { subst e, erw category.id_comp }

lemma heq_comp_eq_to_hom_iff {C : Type*} [category C] {X X' Y Y' Y'' : C}
  (f : X ⟶ Y) (f' : X' ⟶ Y') (e : Y' = Y'') : f == f' ≫ eq_to_hom e ↔ f == f' :=
by { subst e, erw category.comp_id }

include H

namespace category_theory.projective

noncomputable
def replacement_aux : Π n : ℕ, Σ f : arrow V, (f.left ⟶ X.X (a-n))
| 0 := ⟨⟨0, 0, 0⟩, 0⟩
| (n+1) := ⟨⟨over
    (pullback (X.d (a-n-1) (a-n)) (kernel.ι (replacement_aux n).1.hom ≫ (replacement_aux n).2)),
  (replacement_aux n).1.left, π _ ≫ pullback.snd ≫ kernel.ι _⟩,
  π _ ≫ pullback.fst ≫ (X.X_eq_to_iso (by { norm_num, exact sub_sub _ _ _ })).hom⟩
.

lemma replacement_aux_right_eq (n : ℕ) :
  (replacement_aux X a H (n + 1)).1.right = (replacement_aux X a H n).1.left :=
by { delta replacement_aux, exact rfl }

lemma replacement_aux_hom_eq (n : ℕ) :
  (replacement_aux X a H (n + 1)).1.hom = eq_to_hom (by { delta replacement_aux, exact rfl }) ≫
    π (pullback (X.d (a-n-1) (a-n)) (kernel.ι
      (replacement_aux X a H n).1.hom ≫ (replacement_aux X a H n).2)) ≫
    pullback.snd ≫ kernel.ι (replacement_aux X a H n).1.hom ≫
    eq_to_hom (by { delta replacement_aux, exact rfl }) :=
by { delta replacement_aux, erw [category.id_comp, category.comp_id], exact rfl }
.

lemma replacement_aux_snd_comm (n : ℕ) :
  (replacement_aux X a H (n + 1)).1.hom ≫ eq_to_hom (replacement_aux_right_eq X a H n) ≫
    (replacement_aux X a H n).2 = (replacement_aux X a H (n + 1)).2 ≫ X.d _ _ :=
begin
  rw replacement_aux_hom_eq,
  simp only [category.id_comp, eq_to_hom_refl, category.assoc, eq_to_hom_trans_assoc],
  delta replacement_aux,
  rw [eq_to_hom_refl, category.id_comp, ← pullback.condition],
  erw [category.assoc, category.assoc, homological_complex.X_eq_to_iso_d],
end

noncomputable
def replacement : cochain_complex V ℤ :=
{ X := λ i, if a < i then 0 else (replacement_aux X a H ((a - i).nat_abs + 1)).1.right,
  d := λ i j, if h₁ : i + 1 = j then if h₂ : j > a then 0 else
      eq_to_hom (begin
        rw [if_neg, replacement_aux_right_eq, functor.id_obj],
        subst h₁,
        suffices : (a - i).nat_abs = (a - (i + 1)).nat_abs + 1,
        { rw this },
        apply int.coe_nat_inj,
        norm_num [← int.abs_eq_nat_abs],
        rw [abs_eq_self.mpr _, abs_eq_self.mpr _],
        all_goals { linarith }
      end) ≫
      (replacement_aux X a H ((a - j).nat_abs + 1)).fst.hom ≫ eq_to_hom (dif_neg h₂).symm else 0,
  shape' := λ _ _ e, dif_neg e,
  d_comp_d' := begin
    rintros i j k (rfl : i+1 = j) (rfl : i+1+1 = k),
    simp only [dif_pos, dif_ctx_congr],
    by_cases h : i + 1 + 1 > a,
    { rw [dif_pos h, comp_zero] },
    rw [dif_neg h, dif_neg],
    rw [← category.assoc, ← category.assoc, ← is_iso.eq_comp_inv],
    simp only [category.assoc, eq_to_hom_trans_assoc],
    rw [← is_iso.eq_inv_comp, zero_comp, comp_zero, replacement_aux_hom_eq],
    simp only [category.assoc, eq_to_hom_trans_assoc],
    iterate 3 { convert comp_zero },
    suffices : (a - (i + 1)).nat_abs = (a - (i + 1 + 1)).nat_abs + 1,
    { convert kernel.condition _; try { rw this }, apply (eq_to_hom_comp_heq_iff _ _ _).mpr,
      congr; rw this },
    apply int.coe_nat_inj,
    norm_num [← int.abs_eq_nat_abs],
    rw [abs_eq_self.mpr _, abs_eq_self.mpr _],
    all_goals { linarith }
  end }

noncomputable
def replacement.hom : replacement X a H ⟶ X :=
{ f := λ i, if h : a < i then 0 else eq_to_hom (if_neg h) ≫
    eq_to_hom (by rw replacement_aux_right_eq) ≫
    (replacement_aux X a H ((a - i).nat_abs)).snd ≫
    (X.X_eq_to_iso (by { rw [← int.abs_eq_nat_abs, sub_eq_iff_eq_add, ← sub_eq_iff_eq_add',
      eq_comm, abs_eq_self], linarith })).hom,
  comm' := begin
    rintros i j (rfl : i+1 = j),
    split_ifs with h',
    { rw [zero_comp, comp_zero] },
    { exfalso, linarith },
    { rw comp_zero, apply (H _ (le_of_lt h)).eq_of_tgt },
    { dsimp only [replacement],
      rw [dif_pos rfl, dif_neg h],
      simp only [← category.assoc, eq_to_hom_trans_assoc],
      rw [← is_iso.comp_inv_eq],
      simp only [homological_complex.X_d_eq_to_iso, homological_complex.X_eq_to_iso_inv,
        category.assoc, homological_complex.X_eq_to_iso_d, eq_to_hom_trans, is_iso.iso.inv_hom],
      rw [← is_iso.inv_comp_eq, inv_eq_to_hom, eq_to_hom_trans_assoc],
      refine eq.trans _ (replacement_aux_snd_comm X a H _).symm,
      suffices : (a - (i + 1)).nat_abs + 1 = (a - i).nat_abs,
      { rw ← heq_iff_eq, apply (eq_to_hom_comp_heq_iff _ _ _).mpr, rw this },
      apply int.coe_nat_inj,
      norm_num [← int.abs_eq_nat_abs],
      rw [abs_eq_self.mpr _, abs_eq_self.mpr _],
      all_goals { linarith } }
  end }

omit H
variables {V} {A B C : V} (f : A ⟶ B) (g : B ⟶ C) (w : f ≫ g = 0)
variables {A' B' C' : V} {f' : A' ⟶ B'} {g' : B' ⟶ C'} (w' : f' ≫ g' = 0)
variables (α : arrow.mk f ⟶ arrow.mk f') (β : arrow.mk g ⟶ arrow.mk g')
variables (p : α.right = β.left)

instance : epi (homology.π f g w) :=
by { delta homology.π, apply_instance }

instance : strong_epi (factor_thru_image f) :=
strong_epi_factor_thru_image_of_strong_epi_mono_factorisation $
      classical.choice $ has_strong_epi_mono_factorisations.has_fac f

instance : epi (factor_thru_image f ≫ (image_subobject_iso f).inv) :=
epi_comp _ _

instance : mono (homology.ι f g w) :=
by { delta homology.ι, apply_instance }

@[simp, reassoc]
lemma π_cokernel_iso_of_eq {f₁ f₂ : A ⟶ B} (e : f₁ = f₂) :
  cokernel.π f₁ ≫ (cokernel_iso_of_eq e).hom = cokernel.π f₂ :=
by { subst e, erw has_colimit.iso_of_nat_iso_ι_hom, exact category.id_comp _ }

@[simp, reassoc]
lemma homology.π_iso_cokernel_lift_hom :
  homology.π f g w ≫ (homology_iso_cokernel_lift f g w).hom =
    (kernel_subobject_iso _).hom ≫ cokernel.π _ :=
begin
  simp only [limits.cokernel_epi_comp_inv, iso.symm_hom, homology_iso_cokernel_lift,
    iso.trans_hom],
  erw homology.π_desc_assoc,
  simp only [cokernel.π_desc_assoc, category.assoc, iso.cancel_iso_hom_left,
    π_cokernel_iso_of_eq],
end

@[simp, reassoc]
lemma homology.π'_ι :
  homology.π' f g w ≫ homology.ι f g w = kernel.ι g ≫ cokernel.π f :=
by { delta homology.π' homology.ι homology_iso_kernel_desc, simp }

@[simp, reassoc]
lemma homology.π_ι :
  homology.π f g w ≫ homology.ι f g w = (kernel_subobject _).arrow ≫ cokernel.π _ :=
by rw [← homology.π'_eq_π, category.assoc, homology.π'_ι, kernel_subobject_arrow_assoc]

open_locale pseudoelement
open category_theory.abelian

lemma mono_homology_map_of_pseudoelement
  (H : ∀ (x : B) (y : A') (h₁ : g x = 0) (h₂ : f' y = α.right x), ∃ z : A, f z = x) :
  mono (homology.map w w' α β p) :=
begin
  apply pseudoelement.mono_of_zero_of_map_zero,
  intros x e,
  obtain ⟨x', rfl⟩ := pseudoelement.pseudo_surjective_of_epi (homology.π f g w) x,
  rw [← pseudoelement.comp_apply, homology.π_map, pseudoelement.comp_apply] at e,
  obtain ⟨y, hy⟩ := (@pseudoelement.pseudo_exact_of_exact _ _ _ _ _ _ _
    (homology.π f' g' w') (exact_cokernel _)).2 _ e,
  obtain ⟨y', rfl⟩ := pseudoelement.pseudo_surjective_of_epi
    (factor_thru_image f' ≫ (image_subobject_iso _).inv) y,
  obtain ⟨z, e'⟩ := H ((kernel_subobject g).arrow x') y'
    (by rw [← pseudoelement.comp_apply, kernel_subobject_arrow_comp, pseudoelement.zero_apply])
    (by simpa [← pseudoelement.comp_apply, p] using congr_arg (kernel_subobject g').arrow hy),
  have : f = (factor_thru_image f ≫ (image_subobject_iso _).inv ≫ image_to_kernel f g w) ≫
    (kernel_subobject g).arrow := by simp,
  rw [this, pseudoelement.comp_apply] at e',
  have := pseudoelement.pseudo_injective_of_mono _ e', subst this,
  simp [← pseudoelement.comp_apply]
end
.
lemma mono_homology_map_of_epi_pullback_lift
  (H : epi (pullback.lift _ _
    (show α.left ≫ f' = (kernel.lift g f w) ≫ kernel.ι _ ≫ α.right, by simp))) :
  mono (homology.map w w' α β p) :=
begin
  apply mono_homology_map_of_pseudoelement,
  intros x y e₁ e₂,
  obtain ⟨x', rfl⟩ := (@pseudoelement.pseudo_exact_of_exact _ _ _ _ _ _ _ _ exact_kernel_ι).2 x e₁,
  rw ← pseudoelement.comp_apply at e₂,
  obtain ⟨z, rfl, rfl⟩ := pseudoelement.pseudo_pullback e₂,
  obtain ⟨z', rfl⟩ := @@pseudoelement.pseudo_surjective_of_epi _ _ _ H z,
  use z',
  simp [← pseudoelement.comp_apply]
end
.

lemma epi_homology_map_of_pseudoelement
  (H : ∀ (x : B') (h : g' x = 0),
    ∃ (y : B), g y = 0 ∧ (cokernel.π f') (α.right y) = cokernel.π f' x) :
  epi (homology.map w w' α β p) :=
begin
  apply pseudoelement.epi_of_pseudo_surjective,
  intro x,
  obtain ⟨x', rfl⟩ := pseudoelement.pseudo_surjective_of_epi (homology.π f' g' w') x,
  obtain ⟨y, e₁, e₂⟩ := H ((kernel_subobject g').arrow x')
    (by rw [← pseudoelement.comp_apply, kernel_subobject_arrow_comp, pseudoelement.zero_apply]),
  obtain ⟨y', rfl⟩ := (@pseudoelement.pseudo_exact_of_exact _ _ _ _ _ _ _ _
    exact_kernel_subobject_arrow).2 y e₁,
  use homology.π f g w y',
  apply pseudoelement.pseudo_injective_of_mono (homology.ι f' g' w'),
  simpa [← pseudoelement.comp_apply, p] using e₂,
end

local attribute [instance] epi_comp mono_comp

noncomputable
def pullback_comp_mono_iso {X Y Z Z' : V} (f : X ⟶ Z) (g : Y ⟶ Z) (h : Z ⟶ Z') [mono h] :
  pullback (f ≫ h) (g ≫ h) ≅ pullback f g :=
limit.iso_limit_cone ⟨_, pullback_is_pullback_of_comp_mono f g h⟩

@[simp, reassoc]
lemma pullback_comp_mono_iso_fst {X Y Z Z' : V} (f : X ⟶ Z) (g : Y ⟶ Z) (h : Z ⟶ Z') [mono h] :
  (pullback_comp_mono_iso f g h).hom ≫ pullback.fst = pullback.fst :=
limit.iso_limit_cone_hom_π _ walking_cospan.left

lemma kernel_ι_replacement_aux_eq_zero (i : ℕ) :
  kernel.ι (replacement_aux X a H i).fst.hom ≫ (replacement_aux X a H i).snd ≫
    X.d (a - i) (a - i + 1) = 0 :=
begin
  cases i,
  { dsimp [replacement_aux], simp },
  { have : a - i.succ + 1 = a - i, { norm_num [sub_add] },
    rw [this, ← replacement_aux_snd_comm, kernel.condition_assoc, zero_comp] }
end

instance replacement_kernel_map_epi (i : ℕ) : epi (kernel.lift (X.d (a - i) (a - i + 1))
    (kernel.ι (replacement_aux X a H i).fst.hom ≫ (replacement_aux X a H i).snd)
    (by rw [category.assoc, kernel_ι_replacement_aux_eq_zero])) :=
begin
  cases i,
  { apply epi_of_is_zero,
    refine is_zero_of_mono (kernel.ι _) _,
    { apply H, simp }, },
  { apply pseudoelement.epi_of_pseudo_surjective,
    intro x,
    obtain ⟨y, h₁, h₂⟩ := @pseudoelement.pseudo_pullback _ _ _ _ _ _ _ (X.d (a - i - 1) (a - i))
      (kernel.ι (replacement_aux X a H i).fst.hom ≫ (replacement_aux X a H i).snd)
      ((X.X_eq_to_iso (by norm_num [sub_sub])).hom (kernel.ι (X.d _ _) x)) 0 _,
    swap,
    { simp only [← pseudoelement.comp_apply, category.assoc,
        homological_complex.X_eq_to_iso_d, pseudoelement.apply_zero],
      convert pseudoelement.zero_apply _ _,
      have : a - ↑i = a - ↑(i + 1) + 1 := by norm_num [← sub_sub],
      convert kernel.condition _ },
    obtain ⟨z, rfl⟩ := pseudoelement.pseudo_surjective_of_epi (projective.π _) y,
    apply_fun kernel.ι (replacement_aux X a H i).fst.hom at h₂,
    simp only [← pseudoelement.comp_apply, category.assoc, pseudoelement.apply_zero] at h₂,
    obtain ⟨w, rfl⟩ := (@pseudoelement.pseudo_exact_of_exact _ _ _ _ _ _ _ _
      exact_kernel_ι).2 z h₂,
    dsimp [replacement_aux],
    use w,
    simp only [← pseudoelement.comp_apply] at h₁,
    apply pseudoelement.pseudo_injective_of_mono (kernel.ι (X.d (a - ↑(i + 1))
      (a - ↑(i + 1) + 1)) ≫ (homological_complex.X_eq_to_iso X _).hom),
    refine eq.trans _ h₁,
    simp only [← pseudoelement.comp_apply, category.assoc],
    congr' 1,
    refine (kernel.lift_ι_assoc _ _ _ _).trans _,
    simpa,
    apply_instance }
end

instance (i : ℕ) : epi (replacement_aux X a H i).snd :=
begin
  cases i; dsimp [replacement_aux],
  { apply epi_of_is_zero, apply H, simp },
  { apply_with epi_comp { instances := ff },
    { apply_instance },
    apply_with epi_comp { instances := ff },
    swap, { apply_instance },
    let e : pullback (X.d (a - i - 1) (a - i))
      (kernel.ι (replacement_aux X a H i).fst.hom ≫ (replacement_aux X a H i).snd) ≅
        pullback (kernel.lift (X.d (a - i) (a - i + 1)) _ _) (kernel.lift _ _ _),
    { refine pullback.congr_hom (kernel.lift_ι _ _ (X.d_comp_d _ _ _)).symm
        (kernel.lift_ι _ _ _).symm ≪≫ pullback_comp_mono_iso _ _ (kernel.ι _),
      rw [category.assoc, kernel_ι_replacement_aux_eq_zero] },
    have : e.hom ≫ pullback.fst = pullback.fst,
    { simp },
    refine (eq_iff_iff.mp (congr_arg epi this)).mp _,
    apply_instance },
end

noncomputable
def homology_functor_obj_iso (X) (i : ℤ) :
  (homology_functor V (complex_shape.up ℤ) i).obj X ≅ homology _ _ (X.d_comp_d (i-1) i (i+1)) :=
homology.map_iso _ _
  (arrow.iso_mk (X.X_prev_iso (sub_add_cancel _ _)) (iso.refl _) (by { dsimp, simp [← X.d_to_eq] }))
  (arrow.iso_mk (iso.refl _) (X.X_next_iso rfl) (by { dsimp, simp })) (by { dsimp, simp})

lemma homology_functor_map_iso {X Y : cochain_complex V ℤ} (f : X ⟶ Y) (i : ℤ) :
  (homology_functor V (complex_shape.up ℤ) i).map f =
    (homology_functor_obj_iso X i).hom ≫
    homology.map _ _ (arrow.hom_mk (f.comm _ _)) (arrow.hom_mk (f.comm _ _)) rfl ≫
    (homology_functor_obj_iso Y i).inv :=
begin
  delta homology_functor_obj_iso homology.map_iso,
  simp only [homology_functor_map, homology.map_comp],
  congr; ext; dsimp,
  { delta homological_complex.hom.prev, rw (complex_shape.up ℤ).prev_eq_some (sub_add_cancel _ _) },
  { simp only [category.comp_id, category.id_comp] },
  { simp only [category.comp_id, category.id_comp] },
  { delta homological_complex.hom.next, rw (complex_shape.up ℤ).next_eq_some rfl },
end

lemma mono_homology_functor_of_pseudoelement (i : ℤ) {X Y : cochain_complex V ℤ} (f : X ⟶ Y)
  (H : ∀ (x : X.X i) (y : Y.X (i - 1)), X.d i (i + 1) x = 0 → Y.d (i - 1) i y = f.f i x →
    (∃ (z : X.X (i - 1)), X.d (i - 1) i z = x)) :
  mono ((homology_functor V (complex_shape.up ℤ) i).map f) :=
begin
  haveI := mono_homology_map_of_pseudoelement _ _ (X.d_comp_d (i-1) i (i+1))
    (Y.d_comp_d (i-1) i (i+1)) (arrow.hom_mk (f.comm _ _)) (arrow.hom_mk (f.comm _ _)) rfl H,
  rw homology_functor_map_iso,
  apply_instance
end

local attribute [instance] pseudoelement.setoid

lemma pseudoelement.id_apply {X : V} (x : X) : @@coe_fn _ pseudoelement.hom_to_fun (𝟙 X) x = x :=
begin
  apply quot.induction_on x,
  intro a,
  change ⟦over.mk _⟧ = ⟦a⟧,
  erw category.comp_id,
  rcases a with ⟨_, ⟨⟩, _⟩,
  congr,
end

lemma replacement_aux_comp_eq_zero (i : ℕ) :
  (replacement_aux X a H (i+1)).fst.hom ≫ eq_to_hom (by { dsimp [replacement_aux], refl }) ≫
  (replacement_aux X a H i).fst.hom = 0 :=
begin
  dsimp [replacement_aux],
  simp only [category.assoc, category.id_comp],
  refine (category.assoc _ _ _).symm.trans (eq.trans _ comp_zero),
  swap 3,
  congr' 1,
  exact kernel.condition (replacement_aux X a H i).fst.hom,
end

noncomputable
def replacement_homology_map (i : ℕ) :
  homology _ _ ((category.assoc _ _ _).trans (replacement_aux_comp_eq_zero X a H (i+1))) ⟶
  homology _ _ (X.d_comp_d (a-(i+1 : ℕ) - 1) (a-(i+1 : ℕ)) (a-i)) :=
homology.map _ _
  (arrow.hom_mk $ (begin
    have := (replacement_aux_snd_comm X a H (i+1)).symm.trans (category.assoc _ _ _).symm,
    rw [← X.X_eq_to_iso_d (show a - ↑(i + 2) = a - ↑(i + 1) - 1, by norm_num [sub_sub]),
      ← category.assoc] at this,
    exact this,
  end))
  (arrow.hom_mk (replacement_aux_snd_comm X a H i).symm) rfl

instance (i : ℕ) : mono (replacement_homology_map X a H i) :=
begin
  apply mono_homology_map_of_epi_pullback_lift,
  dsimp [replacement_aux],
  convert projective.π_epi _,
  apply pullback.hom_ext,
  { simpa only [category.comp_id, category.assoc, arrow.hom_mk_left, X.X_eq_to_iso_trans,
      X.X_eq_to_iso_refl, pullback.lift_fst] },
  { refine (cancel_mono (kernel.ι _)).mp _,
    simp only [category.comp_id, category.assoc, arrow.hom_mk_left, kernel.lift_ι,
      X.X_eq_to_iso_trans, pullback.lift_snd, X.X_eq_to_iso_refl],
    simp_rw ← category.assoc,
    exact category.comp_id _ },
end
.

lemma comp_left_epi_iff {V : Type*} [category V] {X Y Z : V} (f : X ⟶ Y) (g : Y ⟶ Z) [epi f] :
  epi (f ≫ g) ↔ epi g :=
⟨λ h, @@epi_of_epi _ _ _ h, λ h, @@epi_comp _ _ _ _ h⟩

lemma comp_right_epi_iff {V : Type*} [category V] {X Y Z : V} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso g] :
  epi (f ≫ g) ↔ epi f :=
⟨λ h, by simpa using @@epi_comp _ (f ≫ g) h (inv g) _, λ h, @@epi_comp _ _ h _ _⟩

instance replacement_kernel_map_epi' (i : ℕ) :
  epi (kernel.lift (X.d (a - (i + 1)) (a - i))
    (kernel.ι (replacement_aux X a H (i + 1)).fst.hom ≫ (replacement_aux X a H (i + 1)).snd)
    (by { rw category.assoc,
      convert kernel_ι_replacement_aux_eq_zero X a H _; norm_num [sub_add] })) :=
begin
  convert projective.replacement_kernel_map_epi X a H _; norm_num [sub_add]
end

instance (i : ℕ) : epi (replacement_homology_map X a H i) :=
begin
  apply_with (epi_of_epi (homology.π _ _ _)) { instances := ff },
  erw homology.π_map,
  apply_with epi_comp { instances := ff },
  swap, { apply_instance },
  rw [← comp_left_epi_iff (kernel_subobject_iso _).inv,
    ← comp_right_epi_iff _ (kernel_subobject_iso _).hom],
  convert projective.replacement_kernel_map_epi' X a H _ using 1,
  refine (cancel_mono (kernel.ι _)).mp _,
  simp only [kernel_subobject_arrow'_assoc, category.assoc, kernel_subobject_map_arrow,
    kernel_subobject_arrow, arrow.hom_mk_left],
  erw kernel.lift_ι,
  apply_instance
end

instance (i : ℕ) : is_iso (replacement_homology_map X a H i) :=
is_iso_of_mono_of_epi _

lemma replacement_aux_eq_of_eq (i j : ℕ) (e : i + 1 = j) :
  (replacement_aux X a H j).1.right = (replacement_aux X a H i).1.left :=
begin
  subst e,
  dsimp [replacement_aux],
  refl
end

lemma replacement_aux_fst_hom_congr (i j : ℕ) (e : i = j) :
  (replacement_aux X a H i).1.hom == (replacement_aux X a H j).1.hom :=
by { subst e }

lemma replacement_aux_snd_congr (i j : ℕ) (e : i = j) :
  (replacement_aux X a H i).2 == (replacement_aux X a H j).2 :=
by { subst e }

def replacement_homology_eq (i : ℕ) :
  homology _ _ ((replacement X a H).d_comp_d (a - ↑(i + 1) - 1) (a - ↑(i + 1)) (a - i)) =
    homology _ _ (replacement_homology_map._proof_4 X a H i) :=
begin
  dsimp [replacement],
  have e₁ : a - (↑i + 1) - 1 + 1 = a - (↑i + 1) := by norm_num [sub_add],
  have e₂ :a - (↑i + 1) + 1 = a - ↑i := by norm_num [sub_add],
  have e₃ : ¬ a - (↑i + 1) - 1 > a :=
    by { simp only [gt_iff_lt, tsub_le_iff_right, not_lt], linarith },
  have e₄ : ¬a - (↑i + 1) > a := by { simp only [gt_iff_lt, tsub_le_iff_right, not_lt], linarith },
  have e₅ : ¬a - i > a := by { simp only [gt_iff_lt, tsub_le_iff_right, not_lt], linarith },
  have e₆ : (a - (a - (↑i + 1))).nat_abs = i + 1,
  { rw [← sub_add, sub_self, zero_add], exact int.nat_abs_of_nat_core _ },
  have e₇ : (a - (a - (↑i + 1) - 1)).nat_abs = i + 1 + 1,
  { rw [sub_sub, ← sub_add, sub_self, zero_add], exact int.nat_abs_of_nat_core _ },
  have e₈ : (a - (a - i)).nat_abs = i := by norm_num,
  simp only [dif_pos e₁, dif_pos e₂, dif_neg e₄, dif_neg e₅],
  congr' 1,
  { rw if_neg e₃, apply replacement_aux_eq_of_eq, rw e₇ },
  { rw if_neg e₄, apply replacement_aux_eq_of_eq, rw e₆ },
  { rw if_neg e₅, { congr, { ext, congr, exact e₈ }, { exact e₈ } } },
  { rw [eq_to_hom_comp_heq_iff, comp_eq_to_hom_heq_iff, category.comp_id, e₆] },
  { rw [eq_to_hom_comp_heq_iff, comp_eq_to_hom_heq_iff, e₈] },
end

lemma replacement_hom_homology_iso (i : ℕ) :
  homology.map ((replacement X a H).d_comp_d _ _ _) (X.d_comp_d _ _ _)
    (arrow.hom_mk ((replacement.hom X a H).comm _ _))
    (arrow.hom_mk ((replacement.hom X a H).comm _ _)) rfl =
  (eq_to_hom (replacement_homology_eq X a H i)) ≫ replacement_homology_map X a H i :=
begin
  rw [← heq_iff_eq, heq_eq_to_hom_comp_iff],
  delta replacement_homology_map,
  dsimp [replacement],
  congr' 3,
  any_goals { rw if_neg, apply replacement_aux_eq_of_eq,
    { norm_num [← sub_add], exact (int.nat_abs_of_nat_core _).symm },
    { simp only [gt_iff_lt, tsub_le_iff_right, not_lt], linarith } },
  any_goals { rw if_neg, dsimp [replacement_aux], congr, { ext, congr, norm_num }, { norm_num },
    { simp only [gt_iff_lt, tsub_le_iff_right, not_lt], linarith } },
  any_goals { rw category.comp_id },
  any_goals { rw heq_eq_to_hom_comp_iff},
  any_goals { delta homological_complex.X_eq_to_iso, erw heq_comp_eq_to_hom_iff },
  any_goals { dsimp [replacement.hom],
    rw [dif_neg, eq_to_hom_comp_heq_iff, eq_to_hom_comp_heq_iff],
    erw comp_eq_to_hom_heq_iff,
    { apply replacement_aux_snd_congr,
      refine eq.trans _ (int.nat_abs_of_nat_core _),
      congr' 1,
      norm_num [sub_sub, sub_add] },
    { simp only [gt_iff_lt, tsub_le_iff_right, not_lt], linarith } },
  all_goals { rw [dif_pos, dif_neg, eq_to_hom_comp_heq_iff, comp_eq_to_hom_heq_iff],
    apply replacement_aux_fst_hom_congr,
    { congr' 1,
      refine eq.trans _ (int.nat_abs_of_nat_core _),
      congr' 1,
      norm_num [sub_sub, sub_add] },
    { simp only [gt_iff_lt, tsub_le_iff_right, not_lt], linarith },
    { norm_num [sub_sub, sub_add] } },
end
.

lemma homology_functor_map_iso' {X Y : cochain_complex V ℤ} (f : X ⟶ Y) (i j k : ℤ)
  (e₁ : i + 1 = j) (e₂ : j + 1 = k) :
  (homology_functor V (complex_shape.up ℤ) j).map f =
    (homology_functor_obj_iso X _).hom ≫
      (eq_to_hom $ by { have e₁ : i = j - 1 := by simp [← e₁], substs e₁ e₂ }) ≫
    homology.map (X.d_comp_d i j k) (Y.d_comp_d i j k)
      (arrow.hom_mk (f.comm i j)) (arrow.hom_mk (f.comm j k)) rfl ≫
    (eq_to_hom $ by { have e₁ : i = j - 1 := by simp [← e₁], substs e₁ e₂ }) ≫
      (homology_functor_obj_iso Y _).inv :=
begin
  have e₁ : i = j - 1 := by simp [← e₁], substs e₁ e₂,
  erw [category.id_comp, category.id_comp],
  rw homology_functor_map_iso
end

include H

lemma homology_is_zero_of_bounded (i : ℤ) (e : a ≤ i) :
  is_zero ((homology_functor V (complex_shape.up ℤ) i).obj X) :=
begin
  apply is_zero_of_mono (homology_iso_cokernel_image_to_kernel' _ _ _).hom,
  apply is_zero_of_epi (cokernel.π _),
  apply is_zero_of_mono (kernel.ι _),
  apply H i e,
  all_goals { apply_instance }
end

omit H

lemma replacement_is_projective (i : ℤ) : projective ((replacement X a H).X i) :=
begin
  dsimp [replacement],
  split_ifs,
  { apply_instance },
  { dsimp [replacement_aux],
    induction (a - i).nat_abs; dsimp [replacement_aux]; apply_instance }
end

instance (i : ℤ) : epi ((replacement.hom X a H).f i) :=
begin
  dsimp [replacement.hom],
  split_ifs,
  { apply epi_of_is_zero, apply H, exact le_of_lt h },
  { apply_instance }
end

lemma replacement_is_bounded : ∀ i (h : a ≤ i), is_zero ((replacement X a H).X i) :=
begin
  intros i h,
  dsimp [replacement],
  split_ifs,
  { exact is_zero_zero _ },
  { have : a = i := by linarith, subst this,
    rw [sub_self, int.nat_abs_zero],
    dsimp [replacement_aux],
    exact is_zero_zero _ }
end

instance : quasi_iso (replacement.hom X a H) :=
begin
  constructor,
  intro i,
  rw ← sub_add_cancel i a,
  induction (i - a) with i i,
  { apply is_iso_of_is_zero,
    exact homology_is_zero_of_bounded _ a (replacement_is_bounded X a H) _ (by simp),
    exact homology_is_zero_of_bounded _ a H _ (by simp) },
  { rw (show (-[1+ i] + a) = (a - ↑(i + 1)), by { rw [add_comm], refl }),
    rw homology_functor_map_iso' _ (a - ↑(i + 1) - 1) (a - ↑(i + 1)) (a - i),
    { rw replacement_hom_homology_iso X a H i,
      apply_instance },
    { norm_num },
    { norm_num [sub_add] },
    apply_instance }
end
.

@[simps]
def _root_.cochain_complex.as_nat_chain_complex (X : cochain_complex V ℤ) (a : ℤ) :
  chain_complex V ℕ :=
{ X := λ i, X.X (a - i),
  d := λ i j, X.d _ _,
  shape' := λ i j r, by { refine X.shape _ _ (λ e, r _), dsimp at e ⊢,
    apply int.coe_nat_inj, dsimp, linarith },
  d_comp_d' := λ i j k _ _, X.d_comp_d _ _ _ }

@[simps]
def _root_.cochain_complex.to_nat_chain_complex (a : ℤ) :
  cochain_complex V ℤ ⥤ chain_complex V ℕ :=
{ obj := λ X, X.as_nat_chain_complex a,
  map := λ X Y f, { f := λ i, f.f _ } }

lemma is_zero_iff_iso_zero (X : V) :
  is_zero X ↔ nonempty (X ≅ 0) :=
⟨λ e, ⟨e.iso_zero⟩, λ ⟨e⟩, is_zero_of_iso_of_zero (is_zero_zero _) e.symm⟩

lemma preadditive.exact_iff_homology_is_zero {X Y Z : V} (f : X ⟶ Y) (g : Y ⟶ Z) :
  exact f g ↔ ∃ w, is_zero (homology f g w) :=
begin
  rw preadditive.exact_iff_homology_zero,
  simp_rw is_zero_iff_iso_zero,
end

noncomputable
def null_homotopic_of_projective_to_acyclic_aux {X Y : cochain_complex V ℤ} (f : X ⟶ Y) (a : ℤ)
  (h₁ : ∀ i, projective (X.X i))
  (h₂ : ∀ i, a ≤ i → is_zero (X.X i))
  (h₃ : ∀ i, is_zero ((homology_functor _ _ i).obj Y)) :
  homotopy ((cochain_complex.to_nat_chain_complex a).map f) 0 :=
begin
  have h₄ : ∀ i, a ≤ i → f.f i = 0,
  { intros i e, apply (h₂ i e).eq_of_src },
  fapply homotopy.mk_inductive _ 0,
  { dsimp, rw zero_comp, apply h₄, linarith },
  all_goals { dsimp },
  { have := f.comm (a - (0 + 1)) a,
    rw [h₄ _ (le_of_eq rfl), comp_zero] at this,
    refine projective.factor_thru (kernel.lift _ _ this) _,
    exact kernel.lift _ _ (Y.d_comp_d _ _ _),
    { apply_with kernel.lift.epi { instances := ff },
      rw preadditive.exact_iff_homology_is_zero,
      refine ⟨Y.d_comp_d _ _ _,
        is_zero_of_iso_of_zero (h₃ (a - (0 + 1))) (homology_iso _ _ _ _ _ _)⟩,
      all_goals { dsimp, abel } } },
  { rw comp_zero, conv_rhs { rw [zero_add] },
    slice_rhs 2 3 { rw ← kernel.lift_ι _ _ (Y.d_comp_d (a - (0 + 1 + 1)) (a - (0 + 1)) a) },
    rw [← category.assoc, projective.factor_thru_comp, kernel.lift_ι] },
  { rintros n ⟨g₁, g₂, e⟩, dsimp only,
    have : X.d (a - (n + 1 + 1)) (a - (n + 1)) ≫
      (f.f (a - (↑n + 1)) - g₂ ≫ Y.d (a - (↑n + 1 + 1)) (a - (↑n + 1))) = 0,
    { rw ← sub_eq_iff_eq_add at e, rw [e, X.d_comp_d_assoc, zero_comp] },
    rw [preadditive.comp_sub, ← f.comm, ← category.assoc, ← preadditive.sub_comp] at this,
    fsplit,
    { refine projective.factor_thru (kernel.lift _ _ this) _,
      exact kernel.lift _ _ (Y.d_comp_d _ _ _),
      apply_with kernel.lift.epi { instances := ff },
      rw preadditive.exact_iff_homology_is_zero,
      refine ⟨Y.d_comp_d _ _ _, is_zero_of_iso_of_zero (h₃ _) (homology_iso _ _ _ _ _ _)⟩,
      all_goals { dsimp, abel } },
    { rw ← sub_eq_iff_eq_add',
      slice_rhs 2 3 { rw ← kernel.lift_ι (Y.d (a-(n+1+1)) (a-(n+1))) _ (Y.d_comp_d _ _ _) },
      rw [← category.assoc, projective.factor_thru_comp, kernel.lift_ι] } }
end

noncomputable
def null_homotopic_of_projective_to_acyclic {X Y : cochain_complex V ℤ} (f : X ⟶ Y) (a : ℤ)
  (h₁ : ∀ i, projective (X.X i))
  (h₂ : ∀ i, a ≤ i → is_zero (X.X i))
  (h₃ : ∀ i, is_zero ((homology_functor _ _ i).obj Y)) :
  homotopy f 0 :=
{ hom := λ i j, if h : i ≤ a ∧ j ≤ a then begin
    refine (X.X_eq_to_iso _).hom ≫ (null_homotopic_of_projective_to_acyclic_aux f a h₁ h₂ h₃).hom
      (a - i).nat_abs (a - j).nat_abs ≫ (Y.X_eq_to_iso _).hom,
    swap, symmetry,
    all_goals { rw [← int.abs_eq_nat_abs, eq_sub_iff_add_eq, ← eq_sub_iff_add_eq', abs_eq_self],
      cases h, rwa sub_nonneg }
  end else 0,
  zero' := begin
    intros i j e,
    split_ifs,
    { cases h,
      rw [(null_homotopic_of_projective_to_acyclic_aux f a h₁ h₂ h₃).zero, zero_comp, comp_zero],
      intro e', apply e,
      dsimp at e' ⊢,
      apply_fun (coe : ℕ → ℤ) at e',
      rw [int.coe_nat_add, ← int.abs_eq_nat_abs, ← int.abs_eq_nat_abs, abs_eq_self.mpr _,
        abs_eq_self.mpr _, int.coe_nat_one, sub_add, sub_right_inj] at e',
      rw [← e', sub_add_cancel],
      all_goals { rwa sub_nonneg } },
    { refl }
  end,
  comm := begin
    intros i,
    rw [d_next_eq _ (show (complex_shape.up ℤ).rel i (i+1), from rfl),
      prev_d_eq _ (show (complex_shape.up ℤ).rel (i-1) i, from sub_add_cancel _ _)],
    have e₁ : i + 1 ≤ a ∧ i ≤ a ↔ i + 1 ≤ a := by { rw and_iff_left_iff_imp, intro e, linarith },
    have e₂ : i ≤ a ∧ i - 1 ≤ a ↔ i ≤ a := by { rw and_iff_left_iff_imp, intro e, linarith },
    split_ifs; rw e₁ at h; rw e₂ at h_1,
    { have e : a - (a - i).nat_abs = i,
      { rw [← int.abs_eq_nat_abs, abs_eq_self.mpr _, ← sub_add, sub_self, zero_add],
        rwa sub_nonneg },
      rw [← cancel_mono (Y.X_eq_to_iso e.symm).hom, ← cancel_epi (X.X_eq_to_iso e).hom],
      dsimp,
      simp only [homological_complex.X_d_eq_to_iso_assoc, category.comp_id, add_zero,
        homological_complex.X_d_eq_to_iso, category.id_comp,
        homological_complex.X_eq_to_iso_d_assoc, homological_complex.X_eq_to_iso_trans_assoc,
        preadditive.comp_add, category.assoc, homological_complex.X_eq_to_iso_d,
        homological_complex.X_eq_to_iso_trans, homological_complex.X_eq_to_iso_f_assoc,
        homological_complex.X_eq_to_iso_refl, preadditive.add_comp],
      have := (null_homotopic_of_projective_to_acyclic_aux f a h₁ h₂ h₃).comm (a - i).nat_abs,
      dsimp at this,
      rw [this, add_zero],
      congr' 1,
      { apply d_next_eq, dsimp, apply int.coe_nat_inj, norm_num [← int.abs_eq_nat_abs],
        rw [abs_eq_self.mpr _, abs_eq_self.mpr _, sub_add, add_sub_cancel],
        all_goals { rwa sub_nonneg } },
      { apply prev_d_eq, dsimp, apply int.coe_nat_inj, norm_num [← int.abs_eq_nat_abs],
        rw [abs_eq_self.mpr _, abs_eq_self.mpr _, ← sub_add],
        all_goals { rw sub_nonneg, linarith } } },
    { exfalso, linarith },
    { have : a = i := by linarith, subst this,
      suffices : (null_homotopic_of_projective_to_acyclic_aux f a h₁ h₂ h₃).hom
        (a - a).nat_abs (a - (a - 1)).nat_abs = 0,
      { rw this,
        simp only [add_zero, limits.comp_zero, homological_complex.zero_f_apply,
          limits.zero_comp], apply (h₂ _ h_1).eq_of_src },
        rw [← sub_add, sub_self, zero_add, int.nat_abs_zero, int.nat_abs_one],
        dsimp [null_homotopic_of_projective_to_acyclic_aux, homotopy.mk_inductive],
        rw [dif_pos (zero_add _), zero_comp, zero_comp] },
    { simp only [add_zero, limits.comp_zero, homological_complex.zero_f_apply, limits.zero_comp],
      apply (h₂ _ _).eq_of_src, linarith }
  end }

end category_theory.projective


import ..lang
import ..irsem
import ..irsem_exec
import .lemmas_basic
import .lemmas

open irsem_exec

-- a single small-step function
@[simp]
def step := irsem.step irsem_exec

-- a new udiv instruction
@[simp]
def udiv (isz:nat) (name:string) (op1 op2:operand): instruction
  := instruction.binop (ty.int isz) (reg.r name) (bopcode.udiv) [] op1 op2

-- ub check
@[simp]
def has_ub (st:irsem.irstate irsem_exec):Prop :=
  irsem.irstate.getub irsem_exec st = ff

-- get value
@[simp]
def get_value (st:irsem.irstate irsem_exec) (op:operand) (opty:ty) :=
  irsem.get_value irsem_exec st op opty

-- is poison?
@[simp]
def is_poison: irsem.valty irsem_exec → Prop
| (irsem.valty.ival sz o b) :=
  b = (@bool_like.ff irsem_exec.poisonty irsem_exec.pbl)

set_option eqn_compiler.zeta true
set_option pp.proofs true

local attribute [simp] option.bind irsem.step irsem.step_bop
  irsem.bop irsem.bop_ub irsem.irstate.updateub irsem.irstate.updatereg

lemma never_poison:
  ∀ isz name op1 op2 st st' val
    (HSTEP:step st (udiv isz name op1 op2) = some st')
    (HNOUB:¬ has_ub st')
    (HVAL:some val = get_value st op2 (ty.int isz)),
  ¬ is_poison val
:= begin
  intros,
  cases st with ub regs, cases st' with ub' regs',
  cases ub'; simp at HNOUB; unfold irsem.irstate.getub at HNOUB,
    injection HNOUB, clear HNOUB,
  cases op2, simp at *,
  {
    cases (irsem.get_value irsem_exec (ub, regs) op1 (ty.int isz)) with val1;
      unfold has_bind.bind at *; unfold option.bind at *,
    injection HSTEP,
    rw ← HVAL at HSTEP, simp at HSTEP,
    cases val1 with isz1 ii1 ip1,
    cases val with isz2 ii2 ip2,
    simp at HSTEP,
    have HISZDEC:decidable (isz1 = isz2), apply_instance,
    cases HISZDEC; unfold irsem.bop_val at HSTEP,
    { rw dif_neg at HSTEP, injection HSTEP },
    { rw (dif_pos HISZDEC) at HSTEP,
      injection HSTEP with HSTEP', clear HSTEP,
      cases ub; cases ip2,
      any_goals {
        -- if dividend was poison or previous state was ub..
        unfold_coes at HSTEP', unfold has_and.and at HSTEP',
        unfold bool_like.and at HSTEP', simp at HSTEP', injection HSTEP' with HH _,
        injection HH },
      { simp }
    }
  },
  {
    simp at HVAL,
    cases op2,
    unfold irsem.get_value at HVAL,
    have HSZDEC1: decidable (0 < isz), apply_instance,
    cases HSZDEC1,
    { rw (dif_neg HSZDEC1) at HVAL, injection HVAL },
    { rw (dif_pos HSZDEC1) at HVAL,
      simp at HVAL,
      have HVAL2 := ite_or _ HVAL,
      cases HVAL2,
      { injection HVAL2, rw h_1, simp },
      { have HVAL3 := ite_or _ HVAL2,
        cases HVAL3,
        { injection HVAL3, rw h_1, simp },
        { injection HVAL3 }
      }
    }
  }
end


import for_mathlib.category_theory.triangulated.triangulated
import for_mathlib.algebra.homology.pretriangulated

open category_theory category_theory.pretriangulated category_theory.triangulated
  category_theory.limits category_theory.category

noncomputable theory

variables {C : Type*} [category C] [preadditive C] [has_zero_object C]
  [has_binary_biproducts C]

namespace cochain_complex

open hom_complex

variables {X₁ X₂ X₃ : cochain_complex C ℤ} (f : X₁ ⟶ X₂) (g : X₂ ⟶ X₃)

@[simps mor₁ mor₂ mor₃]
def mapping_cone_comp_triangle : triangle (cochain_complex C ℤ) :=
triangle.mk (mapping_cone.map f (f ≫ g) (𝟙 X₁) g (by rw id_comp))
  (mapping_cone.map (f ≫ g) g f (𝟙 X₃) (by rw comp_id))
    (mapping_cone.δ g ≫ (mapping_cone.inr f)⟦1⟧')

@[simp]
def mapping_cone_comp_homotopy_equiv.hom :
  mapping_cone g ⟶ mapping_cone (mapping_cone_comp_triangle f g).mor₁ :=
mapping_cone.lift _
  (mapping_cone.desc_cocycle g (cochain.of_hom (mapping_cone.inr f)) 0 (zero_add 1)
    (by simp only [cocycle.δ_cochain_of_hom, subtype.val_eq_coe, add_subgroup.coe_zero,
  cochain.comp_zero, smul_zero]))
    (mapping_cone.desc_cochain _ 0 (cochain.of_hom (mapping_cone.inr (f ≫ g))) (neg_add_self 1))
  begin
    simp only [mapping_cone.δ_desc_cochain _ _ _ _ (zero_add 1),
      zero_add, cocycle.δ_cochain_of_hom, cochain.comp_zero, δ_zero, ε_1, neg_smul,
      one_zsmul, cochain.comp_neg, add_zero, mapping_cone_comp_triangle_mor₁, neg_add_eq_zero],
    rw mapping_cone.cochain_ext _ _ (zero_add 1).symm,
    split,
    { simp only [← hom_complex.cochain.comp_assoc_of_third_is_zero_cochain,
        mapping_cone.inl_comp_fst, cochain.id_comp, mapping_cone.desc_cocycle_coe,
        mapping_cone.inl_desc_cochain],
      simp only [← cochain.of_hom_comp, mapping_cone.inr_comp_map], },
    { simp only [← hom_complex.cochain.comp_assoc_of_first_is_zero_cochain,
        add_subgroup.coe_zero, mapping_cone.inr_comp_fst, cochain.zero_comp,
        mapping_cone.desc_cocycle_coe, mapping_cone.inr_desc_cochain], },
  end

@[simp]
def mapping_cone_comp_homotopy_equiv.inv :
  mapping_cone (mapping_cone_comp_triangle f g).mor₁ ⟶ mapping_cone g :=
mapping_cone.desc _ ((mapping_cone.snd f).comp (mapping_cone.inl g) (zero_add _).symm)
  (mapping_cone.desc _ ((cochain.of_hom f).comp (mapping_cone.inl g)
    (zero_add _).symm) (mapping_cone.inr g)
    (by simp only [add_zero, add_left_neg, δ_comp_of_first_is_zero_cochain,
      mapping_cone.δ_inl, cochain.of_hom_comp,
      cocycle.δ_cochain_of_hom, cochain.zero_comp, smul_zero, assoc]))
begin
  dsimp,
  simp only [add_left_neg, δ_comp_of_first_is_zero_cochain, mapping_cone.δ_inl,
    cochain.of_hom_comp, eq_self_iff_true, mapping_cone.δ_snd, cochain.neg_comp, one_smul,
    cochain.comp_assoc_of_second_is_zero_cochain, zsmul_neg', neg_smul, ε_neg, ε_1, neg_neg,
    mapping_cone.cochain_ext _ _ (neg_add_self 1).symm, mapping_cone.map,
    cochain.comp_add],
  split,
  { simpa only [← hom_complex.cochain.comp_assoc_of_second_is_zero_cochain,
      ← hom_complex.cochain.comp_assoc_of_third_is_zero_cochain,
      ← hom_complex.cochain.comp_assoc _ _ _ (neg_add_self 1).symm (add_neg_self 1).symm
      (show (-1 : ℤ) = _, by linarith), mapping_cone.inl_comp_fst,
      mapping_cone.inl_comp_snd, cochain.zero_comp, zero_add, cochain.id_comp,
      mapping_cone.inl_desc], },
  { simp only [← hom_complex.cochain.comp_assoc_of_second_is_zero_cochain,
      ← hom_complex.cochain.comp_assoc_of_first_is_zero_cochain,
      mapping_cone.inr_comp_fst, mapping_cone.inr_comp_snd, cochain.zero_comp, add_zero,
      cochain.id_comp, ← cochain.of_hom_comp, mapping_cone.inr_desc_assoc, assoc,
      mapping_cone.inr_desc, id_comp], },
end

@[simps hom inv]
def mapping_cone_comp_homotopy_equiv :
  homotopy_equiv (mapping_cone g) (mapping_cone (mapping_cone_comp_triangle f g).mor₁) :=
{ hom := mapping_cone_comp_homotopy_equiv.hom f g,
  inv := mapping_cone_comp_homotopy_equiv.inv f g,
  homotopy_hom_inv_id := homotopy.of_eq begin
    simp only [mapping_cone_comp_homotopy_equiv.hom, mapping_cone_comp_homotopy_equiv.inv],
    ext n : 2,
    simp only [homological_complex.comp_f, homological_complex.id_f,
      mapping_cone.lift_desc_f _ _ _ _ _ _ _ _ _ rfl,
      mapping_cone.desc_cocycle_coe, add_subgroup.coe_zero, cochain.zero_cochain_comp,
      mapping_cone.from_ext_iff _ _ _ rfl, preadditive.comp_add,
      mapping_cone.inl_desc_cochain_v_assoc, mapping_cone.inr_desc_cochain_v_assoc,
      cochain.zero_v, zero_comp, zero_add, cochain.of_hom_v,
      mapping_cone.inr_snd_assoc, add_zero, comp_id, mapping_cone.inr_desc_f,
      eq_self_iff_true, and_self],
  end,
  homotopy_inv_hom_id := (equiv_homotopy _ _).symm begin
    refine ⟨-(mapping_cone.snd _).comp
      (((mapping_cone.fst (f ≫ g)).1.comp (mapping_cone.inl f) (add_neg_self 1).symm).comp
        (mapping_cone.inl _) (zero_add _).symm) (zero_add (-1)).symm, _⟩,
    ext1 n,
    dsimp,
    simp only [mapping_cone.from_ext_iff _ _ (n+1) rfl,
      mapping_cone.to_ext_iff _ _ (n+1) rfl,
      mapping_cone.from_ext_iff _ _ (n+2) (show n+2=n+1+1, by linarith),
      mapping_cone.from_ext_iff _ _ (n+1) rfl,
      preadditive.comp_add, preadditive.add_comp,
      neg_neg, δ_neg, preadditive.comp_neg, preadditive.neg_comp,
      δ_comp_of_first_is_zero_cochain _ _ _ (neg_add_self 1), mapping_cone.δ_inl,
      mapping_cone.δ_snd, cochain.of_hom_v, homological_complex.comp_f, assoc,
      mapping_cone.inl_desc_v_assoc, cochain.zero_cochain_comp,
      homological_complex.id_f, cochain.add_v, cochain.zsmul_v, ε_neg, ε_1, neg_smul,
      one_smul, cochain.neg_comp, cochain.neg_v, mapping_cone.inl_snd_assoc,
      zero_comp, zero_add, comp_id, cochain.comp_assoc_of_second_is_zero_cochain,
      cochain.comp_v _ _ (add_neg_self 1).symm n (n+1) n rfl (by linarith),
      mapping_cone.inl_fst_assoc, mapping_cone.inr_snd_assoc,
      mapping_cone.inr_fst_assoc, add_zero, mapping_cone.inr_desc_f_assoc,
      δ_comp _ _ (add_neg_self 1).symm 2 0 1 (zero_add 1) (by linarith) (neg_add_self 1),
      cocycle.δ_eq_zero, cochain.zero_comp, cochain.zero_v, neg_zero,
      mapping_cone.map, mapping_cone.inl_fst, mapping_cone.lift_fst_f,
      mapping_cone.desc_cocycle_coe, mapping_cone.inl_desc_cochain_v,
      cochain.comp_v _ _ (add_neg_self 1).symm (n+1) (n+2) (n+1) (by linarith) (by linarith),
      mapping_cone.lift_snd_f, comp_zero, mapping_cone.inl_snd, id_comp,
      mapping_cone.inr_fst, mapping_cone.inr_desc_cochain_v,
      neg_add_self, mapping_cone.inl_desc_cochain_v_assoc,
      mapping_cone.inr_desc_cochain_v_assoc, eq_self_iff_true,
      add_subgroup.coe_zero, cochain.zero_v],
    dsimp,
    erw comp_id,
    simp only [eq_self_iff_true, and_self],
  end, }

lemma mapping_cone_comp_homotopy_equiv_comm₁ :
  mapping_cone.inr (mapping_cone_comp_triangle f g).mor₁ ≫
    (mapping_cone_comp_homotopy_equiv f g).inv = (mapping_cone_comp_triangle f g).mor₂ :=
begin
  ext n : 2,
  dsimp [mapping_cone_comp_homotopy_equiv],
  simp only [mapping_cone.inr_desc_f, mapping_cone.map, mapping_cone.from_ext_iff _ _ _ rfl,
    mapping_cone.inl_desc_v, id_comp],
  tauto,
end

lemma mapping_cone_comp_homotopy_equiv_comm₂ :
  (mapping_cone_comp_homotopy_equiv f g).hom ≫
    mapping_cone.δ (mapping_cone_comp_triangle f g).mor₁ =
      (mapping_cone_comp_triangle f g).mor₃ :=
begin
  ext n : 2,
  simp only [mapping_cone_comp_homotopy_equiv_hom,
    mapping_cone_comp_homotopy_equiv.hom, mapping_cone_comp_triangle_mor₃,
    homological_complex.comp_f, shift_functor_map_f', mapping_cone.δ,
    mapping_cone.lift_f _ _ _ _ _ _ rfl, assoc,
    cocycle.hom_of_f, cocycle.right_shift_coe, mapping_cone.δ_as_cocycle_coe,
    preadditive.add_comp, preadditive.neg_comp, preadditive.comp_neg, cochain.neg_v,
    cochain.right_shift_v  _ _ _ (zero_add 1).symm _ _ (add_zero n).symm _ rfl,
    mapping_cone.inl_fst_assoc, mapping_cone.inr_fst_assoc, zero_comp, comp_zero, add_zero,
    neg_inj, mapping_cone.desc_cocycle_coe, add_subgroup.coe_zero, shift_functor_obj_X_iso,
    homological_complex.X_iso_of_eq_refl],
  dsimp [iso.refl],
  rw [comp_id, id_comp, mapping_cone.from_ext_iff _ _ (n+1) rfl],
  split,
  { simp only [mapping_cone.inl_fst_assoc, mapping_cone.inl_desc_cochain_v,
      cochain.of_hom_v], },
  { simp only [mapping_cone.inr_fst_assoc, mapping_cone.inr_desc_cochain_v, zero_comp,
      cochain.zero_v], },
end

end cochain_complex

namespace homotopy_category

instance {C ι : Type*} [category C] [preadditive C] (c : complex_shape ι) :
  full (homotopy_category.quotient C c) :=
by { dsimp [quotient], apply_instance, }

lemma mapping_cone_comp_triangle_distinguished {X₁ X₂ X₃ : cochain_complex C ℤ}
  (f : X₁ ⟶ X₂) (g : X₂ ⟶ X₃) :
  (homotopy_category.quotient _ _).map_triangle.obj
    (cochain_complex.mapping_cone_comp_triangle f g) ∈ dist_triang (homotopy_category C (complex_shape.up ℤ)) :=
begin
  refine ⟨_,_, (cochain_complex.mapping_cone_comp_triangle f g).mor₁,
    ⟨triangle.mk_iso _ _ (iso.refl _) (iso.refl _)
    (iso_of_homotopy_equiv (cochain_complex.mapping_cone_comp_homotopy_equiv f g))
    (by { dsimp, rw [id_comp, comp_id], refl, }) _ _⟩⟩,
  { simp only [iso.refl_hom, id_comp, ← cancel_mono (iso_of_homotopy_equiv
      (cochain_complex.mapping_cone_comp_homotopy_equiv f g)).inv, assoc, iso.hom_inv_id, comp_id],
    dsimp [mapping_cone_triangle'],
    erw [← functor.map_comp, cochain_complex.mapping_cone_comp_homotopy_equiv_comm₁],
    refl, },
  { dsimp [mapping_cone_triangle', cochain_complex.mapping_cone.δ'],
    erw [(shift_functor (homotopy_category C (complex_shape.up ℤ)) (1 : ℤ)).map_id,
      comp_id, comp_id, ← functor.map_comp, cochain_complex.mapping_cone_comp_homotopy_equiv_comm₂],
    refl, },
end

instance : is_triangulated (homotopy_category C (complex_shape.up ℤ)) :=
is_triangulated.mk' (begin
  rintro ⟨X₁ : cochain_complex C ℤ⟩ ⟨X₂ : cochain_complex C ℤ⟩ ⟨X₃ : cochain_complex C ℤ⟩
    u₁₂' u₂₃',
  obtain ⟨u₁₂, rfl⟩ := (homotopy_category.quotient _ _).map_surjective u₁₂',
  obtain ⟨u₂₃, rfl⟩ := (homotopy_category.quotient _ _).map_surjective u₂₃',
  refine ⟨_, _, _, _, _, _, _, _,
    iso.refl _, iso.refl _, iso.refl _,
    by { dsimp, rw [comp_id, id_comp], }, by { dsimp, rw [comp_id, id_comp], },
     _, _, mapping_cone_triangle'_distinguished u₁₂,
     _, _, mapping_cone_triangle'_distinguished u₂₃,
     _, _, mapping_cone_triangle'_distinguished (u₁₂ ≫ u₂₃), ⟨_⟩⟩,
  let α := cochain_complex.mapping_cone.triangle_map u₁₂ (u₁₂ ≫ u₂₃) (𝟙 X₁) u₂₃ (by rw id_comp),
  let β := cochain_complex.mapping_cone.triangle_map (u₁₂ ≫ u₂₃) u₂₃ u₁₂ (𝟙 X₃) (by rw comp_id),
  refine octahedron.mk ((homotopy_category.quotient _ _).map α.hom₃)
    ((homotopy_category.quotient _ _).map β.hom₃)
    ((homotopy_category.quotient _ _).map_triangle.map α).comm₂
    begin
      have eq := ((homotopy_category.quotient _ _).map_triangle.map α).comm₃,
      dsimp at eq,
      erw [comp_id, comp_id, comp_id] at eq,
      exact eq.symm,
    end
    (trans ((homotopy_category.quotient _ _).map_triangle.map β).comm₂ (id_comp _))
    begin
      have eq := ((homotopy_category.quotient _ _).map_triangle.map β).comm₃,
      dsimp at eq,
      erw comp_id at eq,
      conv_rhs at eq { congr, skip, erw comp_id, },
      exact eq,
    end _,
  exact pretriangulated.isomorphic_distinguished _
    (mapping_cone_comp_triangle_distinguished u₁₂ u₂₃) _
    (triangle.mk_iso _ _ (iso.refl _) (iso.refl _) (iso.refl _) (by tidy) (by tidy)
    (by { dsimp, erw [comp_id, id_comp], })),
end)

end homotopy_category


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import category_theory.discrete_category

/-!
# The empty category

Defines a category structure on `pempty`, and the unique functor `pempty ⥤ C` for any category `C`.
-/

universes v u w -- morphism levels before object levels. See note [category_theory universes].

namespace category_theory
namespace functor

variables (C : Type u) [category.{v} C]

/-- The canonical functor out of the empty category. -/
def empty : discrete pempty.{v+1} ⥤ C := discrete.functor pempty.elim

variable {C}
/-- Any two functors out of the empty category are isomorphic. -/
def empty_ext (F G : discrete pempty.{v+1} ⥤ C) : F ≅ G :=
discrete.nat_iso (λ x, pempty.elim x)

/--
Any functor out of the empty category is isomorphic to the canonical functor from the empty
category.
-/
def unique_from_empty (F : discrete pempty.{v+1} ⥤ C) : F ≅ empty C :=
empty_ext _ _

/--
Any two functors out of the empty category are *equal*. You probably want to use
`empty_ext` instead of this.
-/
lemma empty_ext' (F G : discrete pempty.{v+1} ⥤ C) : F = G :=
functor.ext (λ x, x.elim) (λ x _ _, x.elim)

end functor

end category_theory


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, ∃ N : ℤ, |y - (N : ℝ) * x| < 1 :=
begin
  assume (y : ℝ) (h1 : y ∈ Icc 0 1),
  have h2 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h3 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h4 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h5 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h6 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h7 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h8 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h9 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h10 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h11 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h12 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h13 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h14 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h15 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h16 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h17 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h18 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h19 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h20 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h21 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h22 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h23 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h24 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h25 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h26 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h27 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h28 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h29 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h30 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h31 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h32 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h33 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from sorry,
  have h34 : ∀ i j : ℤ, i
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
Squeeze Theorem for Real Numbers
Let $\sequence {x_n}$, $\sequence {y_n}$ and $\sequence {z_n}$ be sequences in $\R$.

Let $\sequence {y_n}$ and $\sequence {z_n}$ both be convergent to the following limit:
:$\ds \lim_{n \mathop \to \infty} y_n = l, \lim_{n \mathop \to \infty} z_n = l$

Suppose that:
:$\forall n \in \N: y_n \le x_n \le z_n$

Then:
:$x_n \to l$ as $n \to \infty$
that is:
:$\ds \lim_{n \mathop \to \infty} x_n = l$

`proof`
From Negative of Absolute Value:
:$\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$

Let $\epsilon > 0$.

We need to prove that:
:$\exists N: \forall n > N: \size {x_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that:
:$\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that:
:$\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$

Let $N = \max \set {N_1, N_2}$.

Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.

So:
:$\forall n > N: l - \epsilon < y_n < l + \epsilon$
:$\forall n > N: l - \epsilon < z_n < l + \epsilon$

But:
:$\forall n \in \N: y_n \le x_n \le z_n$

So:
:$\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$

and so:
:$\forall n > N: l - \epsilon < x_n < l + \epsilon$

So:
:$\forall n > N: \size {x_n - l} < \epsilon$

Hence the result.
{{qed}}

-/
theorem squeeze_theorem_real_numbers (x y z : ℕ → ℝ) (l : ℝ) :
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
 seq_limit y l → seq_limit z l →  (∀ n : ℕ, (y n) ≤ (x n) ∧ (x n) ≤ (z n)) → seq_limit x l :=
begin
  assume seq_limit (h2 : seq_limit y l) (h3 : seq_limit z l) (h4 : ∀ (n : ℕ), y n ≤ x n ∧ x n ≤ z n) (ε),

  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from sorry,

  assume (h7 : ε > 0),
  cases h2 ε h7 with N1 h8,
  cases h3 ε h7 with N2 h9,
  let N := max N1 N2,
  use N,

  have h10 : ∀ n > N, n > N1 ∧ n > N2 := sorry,
  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from sorry,

  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from sorry,

  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from sorry,
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


import free_pfpng.basic
import condensed.projective_resolution
import condensed.condensify
import condensed.adjunctions
import condensed.sheafification_mono
import condensed.coproducts
import free_pfpng.lemmas
import condensed.exact

import for_mathlib.int
import for_mathlib.AddCommGroup_instances

.

noncomputable theory

open_locale classical

open category_theory
open opposite

universe u

def Profinite.condensed_free_pfpng (S : Profinite.{u}) : Condensed Ab :=
CompHausFiltPseuNormGrp.to_Condensed.obj $
  CHFPNG₁_to_CHFPNGₑₗ.obj
  (PFPNG₁_to_CHFPNG₁ₑₗ.obj S.free_pfpng)

def Profinite.to_free_pfpng_level (S : Profinite.{u}) :
  S.to_Condensed ⟶ ((ProFiltPseuNormGrp₁.level.obj 1).obj S.free_pfpng).to_Condensed :=
Profinite_to_Condensed.map $ S.to_free_pfpng

def Profinite.to_condensed_free_pfpng (S : Profinite.{u}) :
  S.to_Condensed ⟶ Condensed_Ab_to_CondensedSet.obj S.condensed_free_pfpng :=
S.to_free_pfpng_level ≫
(CompHausFiltPseuNormGrp.level_Condensed_diagram_cocone
  (CHFPNG₁_to_CHFPNGₑₗ.obj
  (PFPNG₁_to_CHFPNG₁ₑₗ.obj S.free_pfpng))).ι.app ⟨1⟩

@[simp]
lemma Profinite.to_condensed_free_pfpng_app (S T : Profinite.{u}) (f) :
  S.to_condensed_free_pfpng.val.app (op T) f = ulift.up
  ⟨_, 1, S.to_free_pfpng ∘ (ulift.down f).1,
    S.to_free_pfpng.2.comp (ulift.down f).2, rfl⟩ :=
rfl

/-
def profinite_to_condensed_unit :
  Profinite_to_Condensed ⟶
  Profinite.extend free_pfpng_functor ⋙
  PFPNG₁_to_CHFPNG₁ₑₗ ⋙
  CHFPNG₁_to_CHFPNGₑₗ ⋙
  CompHausFiltPseuNormGrp.to_Condensed ⋙
  Condensed_Ab_to_CondensedSet :=
{ app := λ S, S.to_condensed_free_pfpng,
  naturality' := λ S T f, begin
    ext X s x, induction X using opposite.rec,
    dsimp at x,
    admit
  end }
-/

def Profinite.free' (S : Profinite.{u}) : Condensed.{u} Ab.{u+1} :=
CondensedSet_to_Condensed_Ab'.obj S.to_Condensed

def Profinite.free'_lift (S : Profinite.{u}) {A : Condensed.{u} Ab.{u+1}}
  (η : S.to_Condensed ⟶ Condensed_Ab_to_CondensedSet.obj A) :
  S.free' ⟶ A :=
(Condensed_Ab_CondensedSet_adjunction'.hom_equiv _ _).symm η

def free'_lift {X : Type (u+1)} {A : Ab.{u+1}} (f : X → A) :
  AddCommGroup.free'.obj X ⟶ A :=
(AddCommGroup.adj'.hom_equiv _ _).symm f

-- TODO: Consider redefining `AddCommGroup.free'` so that this is true by rfl.
lemma free'_lift_eq_finsupp_lift {X : Type (u+1)} {A : Ab.{u+1}} (f : X → A) :
  free'_lift f = (finsupp.lift _ _ _ f).to_add_monoid_hom :=
begin
  dsimp [free'_lift],
  apply_fun AddCommGroup.adj'.hom_equiv X A,
  rw equiv.apply_symm_apply,
  dsimp [AddCommGroup.adj', adjunction.of_nat_iso_left,
    AddCommGroup.free_iso_free'],
  simp only [adjunction.hom_equiv_unit, forget_map_eq_coe],
  dsimp [AddCommGroup.adj, AddCommGroup.free],
  ext i,
  simp only [types_comp_apply, comp_apply, add_equiv.coe_to_add_monoid_hom,
    free_abelian_group.equiv_finsupp_apply,
    linear_map.to_add_monoid_hom_coe, finsupp.lift_apply],
  change _ = (free_abelian_group.to_finsupp (free_abelian_group.of i)).sum _,
  simp only [free_abelian_group.to_finsupp_of, finsupp.sum_single_index, zero_smul, one_zsmul],
end

open category_theory.grothendieck_topology

lemma Profinite.free'_lift_val_eq_sheafification_lift (S : Profinite.{u})
  {A : Condensed.{u} Ab.{u+1}}
  (η : S.to_Condensed ⟶ Condensed_Ab_to_CondensedSet.obj A)
  (T : Profinite.{u}) :
(S.free'_lift η).val.app (opposite.op T) =
  (sheafify_lift _ (((AddCommGroup.adj'.whiskering_right _).hom_equiv _ _).symm η.val)
    A.cond).app (opposite.op T) := rfl

def Profinite.free'_to_condensed_free_pfpng (S : Profinite.{u}) :
  S.free' ⟶ S.condensed_free_pfpng :=
S.free'_lift S.to_condensed_free_pfpng

--instance : limits.has_limits_of_size.{u u} Ab.{u+1} :=
--category_theory.limits.has_limits_of_size_shrink.{u u (u+1) (u+1)} Ab.{u+1}

/-- the limit `lim_i ℤ[S_i]`. -/
def Profinite.limit_free (S : Profinite.{u}) : Ab.{u+1} :=
limits.limit $ (S.fintype_diagram ⋙ forget Fintype ⋙
  AddCommGroup.free') ⋙ Ab.ulift.{u+1}

-- move me
lemma _root_.finsupp.map_domain_equiv_fun_on_fintype_symm
  {α β R : Type*} [fintype α] [semiring R] (f : α → β) (g : α → R) :
  finsupp.map_domain f (finsupp.equiv_fun_on_fintype.symm g) =
    finset.univ.sum (λ (x : α), finsupp.single (f x) (g x)) :=
begin
  dsimp [finsupp.map_domain],
  rw [finsupp.sum_fintype], swap, { intro, apply finsupp.single_zero },
  simp only [finsupp.equiv_fun_on_fintype_symm_apply_to_fun],
end

-- move me
lemma _root_.finsupp.map_domain_equiv_fun_on_fintype_symm_apply
  {α β R : Type*} [fintype α] [semiring R] (f : α → β) (g : α → R) (b : β)
  [decidable_pred (λ (a : α), f a = b)] :
  finsupp.map_domain f (finsupp.equiv_fun_on_fintype.symm g) b =
    (finset.filter (λ (a : α), f a = b) finset.univ).sum g :=
begin
  rw [finsupp.map_domain_equiv_fun_on_fintype_symm, finset.sum_apply'],
  classical,
  simp only [finsupp.single_apply, ← finset.sum_filter],
end

def Profinite.condensed_free_pfpng_specialize_cone (S B : Profinite.{u}) (b : B) :
  limits.cone ((S.fintype_diagram ⋙ forget Fintype ⋙ AddCommGroup.free') ⋙ Ab.ulift.{u+1}) :=
{ X := S.condensed_free_pfpng.val.obj (op B),
  π :=
  { app := λ T, add_monoid_hom.mk'
      (λ t, ⟨finsupp.equiv_fun_on_fintype.symm (S.free_pfpng_π T (t.down.1 b))⟩)
      begin
        intros f g,
        ext x,
        simp only [ulift.add_down, subtype.val_eq_coe,
          finsupp.equiv_fun_on_fintype_symm_apply_to_fun, finsupp.coe_add, pi.add_apply],
        erw strict_comphaus_filtered_pseudo_normed_group_hom.map_add,
        refl,
      end,
    naturality' := λ T₁ T₂ f, begin
      ext g x,
      rw [← Profinite.free_pfpng_π_w _ f],
      simp only [subtype.val_eq_coe, finsupp.equiv_fun_on_fintype_symm_apply_to_fun,
        functor.const_obj_map, comp_apply, id_apply, add_monoid_hom.mk'_apply, functor.comp_map,
        forget_map_eq_coe, concrete_category.has_coe_to_fun_Type, AddCommGroup.free'_map,
        Ab.ulift_map_apply_down, finsupp.map_domain.add_monoid_hom_apply, free_pfpng.map,
        free_pfpng_functor_map, strict_comphaus_filtered_pseudo_normed_group_hom.coe_mk],
      classical,
      rw finsupp.map_domain_equiv_fun_on_fintype_symm_apply, congr',
    end } }

def Profinite.condensed_free_pfpng_specialize (S B : Profinite.{u}) (b : B) :
  S.condensed_free_pfpng.val.obj (op B) ⟶ S.limit_free :=
limits.limit.lift _ (S.condensed_free_pfpng_specialize_cone B b)

lemma finsupp.fun_ext {α γ : Type*}
  [add_comm_group γ]
  (f g : (α →₀ ℤ) → γ)
  (haddf : ∀ x y, f (x + y) = f x + f y)
  (haddg : ∀ x y, g (x + y) = g x + g y)
  (h : ∀ x : α, f (finsupp.single x 1) = g (finsupp.single x 1)) :
  f = g :=
congr_arg add_monoid_hom.to_fun $
@finsupp.add_hom_ext α ℤ γ _ _ (add_monoid_hom.mk' f haddf) (add_monoid_hom.mk' g haddg)
begin
  intros x n,
  apply int.induction_on_iff n; clear n,
  { simp only [finsupp.single_zero, map_zero], },
  { intro n,
    { simp only [finsupp.single_add, map_add],
      simp only [h, add_monoid_hom.mk'_apply, add_left_inj], }, },
end

def ProFiltPseuNormGrp₁.limit_π_coe_eq
  {r : nnreal} {J : Type u} [small_category J]
  (F : J ⥤ ProFiltPseuNormGrp₁.{u})
  (k : (ProFiltPseuNormGrp₁.level.obj r).obj (limits.limit F))
  (j) :
  limits.limit.π F j (k.1 : limits.limit F) =
  (((ProFiltPseuNormGrp₁.level.obj r).map (limits.limit.π F j)) k).1 := rfl