import category_theory.products.basic
import category_theory.limits.concrete_category

import for_mathlib.Cech.adjunction
import for_mathlib.simplicial.iso

import polyhedral_lattice.cosimplicial_extra

import prop_92.prop_92
import normed_snake_dual
import thm95.double_complex
import thm95.col_exact_prep
import thm95.double_complex
import thm95.pfpng_iso

noncomputable theory

open_locale nnreal big_operators nat
open category_theory opposite simplex_category
local attribute [instance] type_pow

universe variables u v u₀ uₘ
-- set_option pp.universes true

namespace thm95

variables (BD : breen_deligne.data) (κ : ℕ → ℝ≥0) [BD.suitable κ]
variables (r r' : ℝ≥0)
variables (V : SemiNormedGroup.{v})
variables (Λ : PolyhedralLattice.{u}) (M : ProFiltPseuNormGrpWithTinv.{u} r')
variables (N : ℕ) [fact (0 < N)] (n : ℕ)

@[simps obj map]
def scale_factorial : system_of_complexes.{u} ⥤ system_of_complexes.{u} :=
(whiskering_right _ _ _).obj $
homological_complex.modify_functor
  (λ m, SemiNormedGroup.rescale m!) (λ m₁ m₂, SemiNormedGroup.scale _ _)
.

namespace scale_factorial
open system_of_complexes SemiNormedGroup homological_complex

lemma is_weak_bounded_exact {C : system_of_complexes} {k K : ℝ≥0} [fact (1 ≤ k)] {m : ℕ} {c₀ : ℝ≥0}
  (hC : C.is_weak_bounded_exact k K m c₀) :
  (scale_factorial.obj C).is_weak_bounded_exact k (K * (m + 1)) m c₀ :=
begin
  intros c hc i hi x ε hε,
  let δ := ε * i!,
  have hδ : 0 < δ := mul_pos hε (nat.cast_pos.2 (nat.factorial_pos i)),
  have hifact : ¬(↑(i!) : ℝ) = 0 := by exact_mod_cast nat.factorial_ne_zero _,
  have him : 1 ≤ (↑m + 1) * ((↑i : ℝ) + 1)⁻¹,
  { refine le_trans _ (mul_le_mul_of_nonneg_right (show (↑i : ℝ) + 1 ≤ (↑m + 1),
      by rwa [add_le_add_iff_right, nat.cast_le])
      (inv_nonneg.2 (add_nonneg ((@nat.cast_nonneg ℝ _ i)) zero_le_one))),
    rw mul_inv_cancel (ne_of_lt (add_pos_of_nonneg_of_pos (@nat.cast_nonneg ℝ _ i) zero_lt_one)).symm },
  obtain ⟨_, _, rfl, rfl, y, hy⟩ := hC c hc i hi ((of_rescale i!).app _ x) δ hδ,
  refine ⟨_, _, rfl, rfl, ((SemiNormedGroup.to_rescale (i - 1)!).app _ y), _⟩,
  erw [rescale.norm_def, rescale.norm_def],
  simp only [nnreal.coe_nat_cast, nnreal.coe_add, nat.cast_succ, nat.factorial_succ,
    nat.cast_mul, nnreal.coe_one, nnreal.coe_mul, div_eq_mul_inv],
  rw [mul_inv_le_iff], swap, { exact_mod_cast nat.factorial_pos i },
  refine hy.trans _,
  rw [left_distrib, mul_inv, ← mul_assoc ↑i!, mul_comm ↑i!, mul_assoc _ ↑i!, mul_comm ↑i!,
    mul_assoc _ _ ↑i!, inv_mul_cancel_right₀ hifact, mul_comm _ ε, add_le_add_iff_right,
    mul_assoc ↑K],
  refine mul_le_mul_of_nonneg_left _ (nnreal.coe_nonneg _),
  rw [mul_comm _ ((↑i : ℝ) + 1)⁻¹, ← mul_assoc],
  refine le_trans (le_mul_of_one_le_left (by simp only [one_mul, norm_nonneg]) him)
    (mul_le_mul_of_nonneg_left _ (mul_nonneg (add_nonneg (nat.cast_nonneg m) zero_le_one)
    (inv_nonneg.2 (add_nonneg (nat.cast_nonneg i) zero_le_one)))),
  simpa using le_refl _
end

end scale_factorial

section
open PolyhedralLattice

def CLCFP' : (ProFiltPseuNormGrpWithTinv r')ᵒᵖ ⥤ ℝ≥0ᵒᵖ ⥤ SemiNormedGroup :=
(ProFiltPseuNormGrpWithTinv.Pow r' n ⋙ (_root_.Filtration r').flip).op ⋙
  functor.op_hom _ _ ⋙ (whiskering_right ℝ≥0ᵒᵖ Profiniteᵒᵖ _).obj (CLC V)

lemma CLCFP'_map_app {M₁ M₂ : (ProFiltPseuNormGrpWithTinv r')ᵒᵖ} (f : M₁ ⟶ M₂) (c : ℝ≥0ᵒᵖ) :
  ((CLCFP' r' V n).map f).app c = (CLCFP V r' c.unop n).map f := rfl

lemma CLCFP'_obj_map (M₁ : (ProFiltPseuNormGrpWithTinv r')ᵒᵖ) (c₁ c₂ : ℝ≥0ᵒᵖ) (h : c₁ ⟶ c₂) :
  ((CLCFP' r' V n).obj M₁).map h =
    (by haveI : fact (c₂.unop ≤ c₁.unop) := ⟨le_of_hom h.unop⟩;
      exact (CLCFP.res V r' c₁.unop c₂.unop n).app M₁) :=
rfl

lemma FLC_arrow_hom' {M₁ M₂ : ProFiltPseuNormGrpWithTinv r'} (f : M₁ ⟶ M₂) (c : ℝ≥0) :
  (FLC_complex_arrow f.to_comphaus_filtered_pseudo_normed_group_hom f.strict c).hom =
    ((Filtration r').obj c).map f :=
rfl

section

variables [fact (0 < r')] [fact (r' ≤ 1)]

def Cech_nerve' :
  cosimplicial_object.augmented (ℝ≥0ᵒᵖ ⥤ SemiNormedGroup) :=
(cosimplicial_object.augmented.whiskering_obj.{u} _ _ (CLCFP' r' V n)).obj
  (Cech_nerve r' Λ M N)

lemma Cech_nerve'_hom_zero :
  (Cech_nerve'.{u} r' V Λ M N n).hom.app (mk 0) =
    (CLCFP' r' V n).map (Cech_augmentation_map.{u} r' Λ M N).op :=
begin
  dsimp only [Cech_nerve', cosimplicial_object.augmented.whiskering_obj],
  simp only [whisker_right_app, category.id_comp, functor.right_op_map, nat_trans.comp_app,
    functor.const_comp_inv_app, Cech_nerve_hom_zero],
end

@[simps obj map]
def Cech_nerve_level : ℝ≥0 ⥤ simplicial_object.augmented Profinite.{u} :=
(ProFiltPseuNormGrpWithTinv.Pow r' n ⋙ (Filtration r').flip).flip ⋙
  (simplicial_object.augmented.whiskering _ _).flip.obj (Cech_nerve.{u} r' Λ M N).left_op
.

lemma Cech_nerve_level_left_map (c : ℝ≥0) (i j : simplex_categoryᵒᵖ) (g : i ⟶ j) :
  ((Cech_nerve_level r' Λ M N n).obj c).left.map g =
    ((Filtration r').obj c).map ((ProFiltPseuNormGrpWithTinv.Pow r' n).map
      ((Hom M).map ((Cech_conerve (Λ.diagonal_embedding N)).map g.unop).op)) :=
rfl

lemma Cech_nerve_level_left_map' (c : ℝ≥0) (i j : simplex_categoryᵒᵖ) (g : i ⟶ j)
  (x : ((Cech_nerve_level r' Λ M N n).obj c).left.obj i) (k : fin n) :
  (((Cech_nerve_level r' Λ M N n).obj c).left.map g x).1 k =
    add_monoid_hom.comp (x.1 k) (polyhedral_lattice.conerve.map
      (Λ.diagonal_embedding N) ⇑(hom.to_order_hom g.unop)).to_add_monoid_hom :=
rfl

lemma Cech_nerve_level_hom_app (c : ℝ≥0) :
  ((Cech_nerve_level r' Λ M N n).obj c).hom.app (op (mk 0)) =
    ((Filtration r').obj c).map
      ((ProFiltPseuNormGrpWithTinv.Pow r' n).map (Cech_augmentation_map r' Λ M N)) :=
begin
  dsimp only [Cech_nerve_level_obj, nat_trans.comp_app, whisker_right_app,
    functor.const_comp_hom_app],
  erw [category.comp_id],
  dsimp only [nat_trans.left_op_app, unop_op],
  rw [Cech_nerve_hom_zero],
  dsimp only [functor.flip_obj_map, functor.comp_map, quiver.hom.unop_op,
    functor.flip_map_app],
  refl
end

@[simps X d]
def col_complex_aux : cochain_complex (ℝ≥0ᵒᵖ ⥤ SemiNormedGroup) ℕ :=
(Cech_nerve' r' V Λ M N n).to_cocomplex
.

@[simps obj obj_d map]
def col_complex_level : system_of_complexes :=
((whiskering_right _ _ _).obj $ FLC_functor' V).obj (Cech_nerve_level r' Λ M N n).op
.

@[simps obj obj_d map]
def col_complex : system_of_complexes :=
(col_complex_aux r' V Λ M N n).as_functor
.

def col_complex_level_iso_obj_X (c : ℝ≥0ᵒᵖ) :
  Π (i : ℕ), ((col_complex_level r' V Λ M N n).obj c).X i ≅ ((col_complex r' V Λ M N n).obj c).X i
| 0     := iso.refl _
| (i+1) := iso.refl _

lemma col_complex_level_iso_obj_comm (c : ℝ≥0ᵒᵖ) (i : ℕ) :
  (col_complex_level_iso_obj_X r' V Λ M N n c i).hom ≫
    ((col_complex r' V Λ M N n).obj c).d i (i + 1) =
  ((col_complex_level r' V Λ M N n).obj c).d i (i + 1) ≫
    (col_complex_level_iso_obj_X r' V Λ M N n c (i + 1)).hom :=
begin
  cases i,
  all_goals {
    dsimp only [col_complex_level_iso_obj_X],
    simp only [iso.refl_hom, category.id_comp, category.comp_id],
    dsimp only [col_complex_obj_d, col_complex_level_obj_d,
      cosimplicial_object.augmented.cocomplex,
      cosimplicial_object.augmented.to_cocomplex_d_2,
      cosimplicial_object.augmented.to_cocomplex_d,
      functor.const_comp_hom_app, functor.const_comp_inv_app,
      nat_trans.comp_app, whisker_right_app, nat_trans.right_op_app, nat_trans.left_op_app,
      cosimplicial_object.augmented.drop_obj, cosimplicial_object.coboundary,
      cosimplicial_object.δ, cosimplicial_object.whiskering_obj_obj_map],
    rw [dif_pos rfl, eq_to_hom_refl, category.comp_id,
        dif_pos rfl, eq_to_hom_refl, category.comp_id], },
  { erw [Cech_nerve'_hom_zero, SemiNormedGroup.LCC_obj_map', category.id_comp],
    dsimp only [unop_op],
    erw [Cech_nerve_hom_zero, op_id, category.id_comp],
    refl },
  { simp only [nat_trans.app_sum, nat_trans.app_zsmul],
    apply fintype.sum_congr, intro j, congr' 1,
    rw [SemiNormedGroup.LCC_obj_map'],
    refl, }
end

def col_complex_level_iso_obj (c : ℝ≥0ᵒᵖ) :
  (col_complex_level r' V Λ M N n).obj c ≅ (col_complex r' V Λ M N n).obj c :=
homological_complex.hom.iso_of_components (col_complex_level_iso_obj_X r' V Λ M N n c)
(by { rintro i j (rfl : i + 1 = j), apply col_complex_level_iso_obj_comm })

lemma col_complex_level_iso_comm (c₁ c₂ : ℝ≥0ᵒᵖ) (h : c₁ ⟶ c₂) (i : ℕ) :
  ((col_complex_level r' V Λ M N n).map h ≫ (col_complex_level_iso_obj r' V Λ M N n c₂).hom).f i =
    ((col_complex_level_iso_obj r' V Λ M N n c₁).hom ≫ (col_complex r' V Λ M N n).map h).f i :=
begin
  cases i,
  all_goals {
    dsimp only [col_complex_level_iso_obj, col_complex_level_iso_obj_X,
      homological_complex.comp_f, homological_complex.hom.iso_of_components_hom_f, iso.refl_hom],
      rw [category.id_comp, category.comp_id],
    dsimp only [col_complex_level_map, col_complex_map, whisker_right_app,
      cosimplicial_object.augmented.cocomplex,
      cosimplicial_object.augmented.point_map,
      cosimplicial_object.augmented.drop_map],
      rw [SemiNormedGroup.LCC_obj_map'], refl },
end

def col_complex_level_iso :
  col_complex_level r' V Λ M N n ≅ col_complex r' V Λ M N n :=
nat_iso.of_components (col_complex_level_iso_obj r' V Λ M N n)
(by { intros c₁ c₂ h, ext i : 2, apply col_complex_level_iso_comm })

lemma col_complex_level_iso_strict (c : ℝ≥0ᵒᵖ) (i : ℕ) :
  isometry (((col_complex_level_iso r' V Λ M N n).hom.app c).f i) :=
by { cases i; exact isometry_id }

def aug_map :=
((ProFiltPseuNormGrpWithTinv.Pow r' n).map (Cech_augmentation_map r' Λ M N))
  .to_comphaus_filtered_pseudo_normed_group_hom

section open comphaus_filtered_pseudo_normed_group_with_Tinv_hom
lemma aug_map_strict : (aug_map r' Λ M N n).strict :=
to_profinitely_filtered_pseudo_normed_group_hom_strict _
end

section open category_theory.simplicial_object

@[simps left right]
def Cech_nerve_level_hom' (c : ℝ≥0) :
  augmented.to_arrow.obj ((Cech_nerve_level r' Λ M N n).obj c) ⟶
    FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c :=
@arrow.hom_mk _ _
  (augmented.to_arrow.obj ((Cech_nerve_level r' Λ M N n).obj c))
  (FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c)
  (𝟙 _) (𝟙 _)
begin
  erw [category.comp_id, category.id_comp, augmented.to_arrow_obj_hom],
  dsimp only [Cech_nerve_level_obj, nat_trans.comp_app, whisker_right_app,
    functor.const_comp_hom_app, nat_trans.left_op_app, unop_op,
    functor.flip_obj_map, functor.comp_map, functor.flip_map_app],
  erw [category.comp_id, Cech_nerve_hom_zero],
  refl,
end

@[simps left right]
def Cech_nerve_level_inv' (c : ℝ≥0) :
  FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c ⟶
    augmented.to_arrow.obj ((Cech_nerve_level r' Λ M N n).obj c) :=
@arrow.hom_mk _ _
  (FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c)
  (augmented.to_arrow.obj ((Cech_nerve_level r' Λ M N n).obj c))
  (𝟙 _) (𝟙 _)
begin
  erw [category.comp_id, category.id_comp, augmented.to_arrow_obj_hom],
  dsimp only [Cech_nerve_level_obj, nat_trans.comp_app, whisker_right_app,
    functor.const_comp_hom_app, nat_trans.left_op_app, unop_op,
    functor.flip_obj_map, functor.comp_map, functor.flip_map_app],
  erw [category.comp_id, Cech_nerve_hom_zero],
  refl,
end

@[simps left right]
def Cech_nerve_level_hom (c : ℝ≥0) :
  (Cech_nerve_level r' Λ M N n).obj c ⟶
    (FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c).augmented_cech_nerve :=
equivalence_left_to_right _ _ $ Cech_nerve_level_hom' _ _ _ _ _ _
.

lemma Cech_nerve_level_hom_injective' (c : ℝ≥0) (i : simplex_categoryᵒᵖ)
  (x y: ((((Cech_nerve_level r' Λ M N n).obj c).left.obj i)))
  (h : ∀ (j : (fin ((unop i).len + 1))),
    (((Cech_nerve_level r' Λ M N n).obj c).left.map ((unop i).const j).op) x =
    (((Cech_nerve_level r' Λ M N n).obj c).left.map ((unop i).const j).op) y) : x = y :=
begin
  ext j : 2,
  let π := (polyhedral_lattice.conerve.π
    (Λ.diagonal_embedding N) (i.unop.len + 1)).to_add_monoid_hom,
  have hπ : function.surjective π := polyhedral_lattice.conerve.π_surjective _ _,
  rw ← add_monoid_hom.cancel_right hπ, -- Bingo!
  apply finsupp.add_hom_ext',
  intro k, specialize h k,
  rw subtype.ext_iff at h,
  replace h := congr_fun h j,
  rw add_monoid_hom.ext_iff at h ⊢,
  intro l, specialize h ((Cech_conerve.obj_zero_iso _).inv l),
  dsimp only [Cech_nerve_level_obj, Cech_nerve_level_map,
    whiskering_obj_obj_map, functor.flip_obj_map, functor.flip_map_app,
    functor.comp_map, functor.left_op_map, quiver.hom.unop_op,
    Cech_nerve, cosimplicial_object.augmented.whiskering_obj, cosimplicial_object.whiskering,
    whiskering_right_obj_obj, whiskering_right_obj_map,
    functor.right_op_map, unop_op,
    cosimplicial_object.augmented.drop_obj, cosimplicial_object.augmented.drop_map,
    augmented_cosimplicial, augmented_Cech_conerve,
    cosimplicial_object.augment_right, Cech_conerve_map,
    Filtration_obj_map_apply, ProFiltPseuNormGrpWithTinv.Pow_map,
    Hom_obj, Hom_map_to_fun, polyhedral_lattice.Hom,
    comphaus_filtered_pseudo_normed_group_with_Tinv_hom.level,
    profinitely_filtered_pseudo_normed_group_with_Tinv.pi_map_to_fun,
    profinitely_filtered_pseudo_normed_group_with_Tinv.pi_lift_to_fun,
    comphaus_filtered_pseudo_normed_group_with_Tinv_hom.comp_to_fun,
    pseudo_normed_group.level, finsupp.single_add_hom_apply,
    subtype.coe_mk, add_monoid_hom.coe_mk_from_pi, add_monoid_hom.comp_apply] at h ⊢,
  erw [Cech_conerve.map_const_obj_zero_iso] at h,
  exact h,
end
.

open category_theory.limits.wide_pullback

lemma Cech_nerve_level_hom_injective (c : ℝ≥0) (i : simplex_categoryᵒᵖ) :
  function.injective ⇑((Cech_nerve_level_hom r' Λ M N n c).left.app i) :=
begin
  let F := FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c,
  let G := (Cech_nerve_level_hom r' Λ M N n c).left.app i,
  intros x y h,
  replace h : ∀ j, π (λ i, F.hom) j (G x) = π (λ i, F.hom) j (G y), { intros j, rw h },
  have aux := λ j, (augmented_cech_nerve.left_map_comp_obj_zero_iso F i.unop j).symm,
  dsimp only [unop_op] at aux,
  simp only [← comp_apply, aux] at h,
  have aux' := (Cech_nerve_level_hom r' Λ M N n c).left.naturality,
  simp only [← category.assoc, ← aux'] at h, clear aux aux',
  simp only [category.assoc, Cech_nerve_level_hom, augmented_cech_nerve.left_obj_zero_iso_hom,
    equivalence_left_to_right_left_app_zero_comp_π, Cech_nerve_level_hom'_left,
    coe_comp, function.comp, id_apply] at h,
  apply Cech_nerve_level_hom_injective',
  exact h
end
.

namespace Cech_nerve_level_hom

/-! The goal is to build a section to `Cech_nerve_level_hom` -/

variables {r' Λ M N n}
variables {c : ℝ≥0} {i : simplex_categoryᵒᵖ}
variables (y : (FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c).augmented_cech_nerve.left.obj i)

def z₀' := limits.wide_pullback.base
(λ _, (FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c).hom) y

def z' := λ j, limits.wide_pullback.π
(λ _, (FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c).hom) j y

lemma hz' : ∀ j, ((FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c).hom (z' y j)) = z₀' y :=
begin
  intro j,
  dsimp only [z₀', z'],
  rw [← comp_apply, limits.wide_pullback.π_arrow],
end

def z₀ := (Cech_nerve_level_inv' r' Λ M N n c).right (z₀' y)

def z := λ j, (Cech_nerve_level_inv' r' Λ M N n c).left (z' y j)

lemma hz : ∀ j, (augmented.to_arrow.obj ((Cech_nerve_level r' Λ M N n).obj c)).hom (z y j) = z₀ y :=
begin
  intro j, dsimp only [z₀, z],
  have := (Cech_nerve_level_inv' r' Λ M N n c).w,
  simp only [functor.id_map, augmented.to_arrow_obj_hom] at this,
  erw [← comp_apply, this, comp_apply, hz'],
  refl
end

def s' (y : (FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c).augmented_cech_nerve.left.obj i) :
  (ProFiltPseuNormGrpWithTinv.Pow r' n).obj
    ((augmented.drop.obj (Cech_nerve r' Λ M N).left_op).obj i) :=
begin
  refine λ k,
    cosimplicial_lift Λ N _
      ((z₀ y).1 k)
      (λ j, add_monoid_hom.comp ((z y j).1 k)
        (Cech_conerve.obj_zero_iso (Λ.diagonal_embedding N)).inv.to_add_monoid_hom) _,
  intros j l,
  dsimp only [add_monoid_hom.comp_apply, subtype.coe_mk,
    polyhedral_lattice_hom.coe_to_add_monoid_hom],
  rw [← hz y j],
  dsimp only [augmented.to_arrow_obj_hom],
  rw [Cech_nerve_level_hom_app],
  dsimp only [Filtration_obj_map_apply, Cech_augmentation_map,
    comphaus_filtered_pseudo_normed_group_with_Tinv_hom.level,
    pseudo_normed_group.level,
    ProFiltPseuNormGrpWithTinv.Pow_map,
    profinitely_filtered_pseudo_normed_group_with_Tinv.pi_map_to_fun,
    cosimplicial_augmentation_map,
    Hom_map_to_fun, add_monoid_hom.comp_apply, subtype.coe_mk,
    polyhedral_lattice_hom.coe_to_add_monoid_hom, quiver.hom.unop_op,
    PolyhedralLattice.Cech_augmentation_map],
  refl,
end
.

def s (y : (FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c).augmented_cech_nerve.left.obj i) :
  ((Cech_nerve_level r' Λ M N n).obj c).left.obj i :=
begin
  refine ⟨s' y, _⟩,
  intros k,
  apply cosimplicial_lift_mem_filtration,
  intros j c' l hl,
  dsimp only [add_monoid_hom.comp_apply, polyhedral_lattice_hom.coe_to_add_monoid_hom],
  apply (z y j).property,
  rw [seminormed_add_comm_group.mem_filtration_iff] at hl ⊢,
  refine le_trans _ hl,
  exact (Cech_conerve.obj_zero_iso (Λ.diagonal_embedding N)).inv.strict l
end
.

set_option pp.universes true

lemma surjective (c : ℝ≥0) (i : simplex_categoryᵒᵖ) :
  function.surjective ⇑((Cech_nerve_level_hom r' Λ M N n c).left.app i) :=
begin
  let F := FLC_complex_arrow (aug_map r' Λ M N n) _ c,
  intro y,
  refine ⟨Cech_nerve_level_hom.s y, _⟩,
  { apply limits.concrete.wide_pullback_ext'.{0} (λ i, F.hom),
    rotate, { apply_instance },
    { haveI := limits.preserves_limits_of_size_shrink.{0 u 0 u} (forget.{u+1} Profinite.{u}),
      apply_instance, },
    intro j,
    erw [← augmented_cech_nerve.left_map_comp_obj_zero_iso _ _ j, ← comp_apply,
      ← category.assoc, ← (Cech_nerve_level_hom r' Λ M N n c).left.naturality,
      augmented_cech_nerve.left_map_comp_obj_zero_iso _ _ j, category.assoc],
    dsimp only [Cech_nerve_level_hom, augmented_cech_nerve.left_obj_zero_iso],
    erw [equivalence_left_to_right_left_app_zero_comp_π, Cech_nerve_level_hom'_left,
      category.comp_id],
    apply subtype.ext, apply funext, rintro k, -- ext k : 2
    have := Cech_nerve_level_left_map' r' Λ M N n c i _ (i.unop.const j).op,
    simp only [subtype.val_eq_coe] at this,
    erw this _ k, clear this,
    apply add_monoid_hom.ext, rintro l', -- ext1 l'
    obtain ⟨l, rfl⟩ : ∃ l, quotient_add_group.mk l = l',
    { exact quotient.surjective_quotient_mk' l' },
    dsimp only [z₀, z, s', s, add_monoid_hom.comp_apply, subtype.coe_mk,
      polyhedral_lattice_hom.coe_to_add_monoid_hom,
      polyhedral_lattice.conerve.map_apply,
      add_monoid_hom.to_fun_eq_coe,
      polyhedral_lattice.conerve.map_add_hom_mk,
      cosimplicial_lift, polyhedral_lattice.conerve.lift'],
    refine (quotient_add_group.lift_mk'
      (polyhedral_lattice.conerve.L (Λ.diagonal_embedding N) ((unop i).len + 1)) _ _).trans _,
    dsimp only [finsupp.lift_add_hom_apply, finsupp.map_domain.add_monoid_hom_apply,
      unop_op],
    rw [finsupp.sum_map_domain_index_add_monoid_hom, finsupp.sum_fintype,
      fin.sum_univ_succ, finset.sum_eq_zero, add_zero],
    swap, { intros m hm, exfalso, change fin 0 at m, exact nat.not_lt_zero m m.2 },
    swap, { intro, rw add_monoid_hom.map_zero },
    dsimp only [add_monoid_hom.comp_apply, subtype.coe_mk,
      polyhedral_lattice_hom.coe_to_add_monoid_hom,
      Cech_nerve_level_inv'_left, Cech_conerve.obj_zero_iso,
      iso.trans_inv, subtype.val_eq_coe, quiver.hom.unop_op],
    rw [id_apply, comp_apply, Cech_conerve.obj_zero_iso'_inv,
      Cech_conerve.finsupp_fin_one_iso_inv],
    suffices : finsupp.single_add_hom 0 (l 0) = l,
    { cases j, rw this, refl },
    apply finsupp.ext, rintro m, apply finsupp.ext, rintro o, -- ext m o
    change fin 1 at m,
    have hm : m = 0, { exact subsingleton.elim _ _ },
    simp only [hm, finsupp.single_add_hom_apply, finsupp.single_apply, if_pos rfl], }
end

end Cech_nerve_level_hom

instance Cech_nerve_level_hom_is_iso (c : ℝ≥0) : is_iso (Cech_nerve_level_hom r' Λ M N n c) :=
begin
  refine @simplicial_object.augmented.is_iso_of _ _ _ _ _ (id _) (id _),
  swap, { exact is_iso.id _ },
  intro i,
  apply Profinite.is_iso_of_bijective,
  exact ⟨Cech_nerve_level_hom_injective r' Λ M N n c i,
        Cech_nerve_level_hom.surjective c i⟩,
end

def Cech_nerve_level_iso (c : ℝ≥0) :
  (Cech_nerve_level r' Λ M N n).obj c ≅
    (FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c).augmented_cech_nerve :=
as_iso (Cech_nerve_level_hom r' Λ M N n c)

def FLC_complex_aug_iso_obj (c : ℝ≥0ᵒᵖ) :
  (FLC_complex V _ (aug_map_strict r' Λ M N n)).obj c ≅ (col_complex_level r' V Λ M N n).obj c :=
(FLC_functor' V).map_iso (Cech_nerve_level_iso r' Λ M N n c.unop).op

def FLC_complex_aug_iso :
  FLC_complex V _ (aug_map_strict r' Λ M N n) ≅ col_complex_level r' V Λ M N n :=
nat_iso.of_components (FLC_complex_aug_iso_obj r' V Λ M N n)
begin
  intros c₁ c₂ h,
  dsimp only [FLC_complex, col_complex_level, FLC_functor, FLC_complex_aug_iso_obj,
    functor.comp_map, functor.map_iso_hom, whiskering_right_obj_obj,
    Cech_nerve_level_iso, iso.op_hom, as_iso_hom, functor.op_map],
  simp only [← category_theory.functor.map_comp, ← op_comp, quiver.hom.unop_op],
  congr' 2,
  apply simplicial_object.hom_ext,
  { dsimp only [unop_op],
    let f := FLC_complex_arrow _ (aug_map_strict r' Λ M N n) (unop c₁),
    rw ← cancel_mono (augmented_cech_nerve.left_obj_zero_iso f).hom,
    dsimp only [comma.comp_left, nat_trans.comp_app,
      Cech_nerve_level_hom, augmented_cech_nerve_map, arrow.map_augmented_cech_nerve_left,
      cech_nerve_map, arrow.map_cech_nerve_app,
      arrow.hom_mk_right, arrow.hom_mk_left, augmented_cech_nerve.left_obj_zero_iso_hom],
    simp only [category.assoc, limits.wide_pullback.lift_π,
      simplicial_object.equivalence_left_to_right_left_app_zero_comp_π],
    erw [← category.assoc, simplicial_object.equivalence_left_to_right_left_app_zero_comp_π],
    refl, },
  { dsimp only [equivalence_right_to_left_right, comma.comp_right, Cech_nerve_level_hom_right],
    erw [category.comp_id, category.id_comp],
    refl, }
end

end

lemma FLC_complex_aug_iso_strict (c : ℝ≥0ᵒᵖ) (i : ℕ) :
  isometry (((FLC_complex_aug_iso r' V Λ M N n).hom.app c).f i) :=
begin
  rw [← iso.app_hom, ← homological_complex.hom.iso_app_hom],
  refine SemiNormedGroup.iso_isometry_of_norm_noninc _ _ _;
  [ rw [homological_complex.hom.iso_app_hom, iso.app_hom],
    rw [homological_complex.hom.iso_app_inv, iso.app_inv] ];
  { apply cosimplicial_object.augmented.cocomplex_map_norm_noninc;
    intros; apply SemiNormedGroup.LCC_obj_map_norm_noninc, },
end

def col_complex_obj_iso_X_zero (c : ℝ≥0ᵒᵖ) :
  ((col_complex r' V Λ M N n).obj c).X 0 ≅
    ((FLC_functor V).obj (op $ FLC_complex_arrow _ (aug_map_strict r' Λ M N n) (c.unop))).X 0 :=
iso.refl _

section
open profinitely_filtered_pseudo_normed_group

def FLC_arrow_iso_aux :
  ((ProFiltPseuNormGrpWithTinv.Pow r' n).obj
    (unop ((Cech_nerve r' Λ M N).right.obj (mk 0)))) ≅
  ProFiltPseuNormGrpWithTinv.of r' (rescale ↑N (((↥Λ →+ (↥M: Type u)) ^ n) ^ N)) :=
(ProFiltPseuNormGrpWithTinv.Pow r' n).map_iso
    (Hom_cosimplicial_zero_iso Λ N r' M N rfl) ≪≫
  (ProFiltPseuNormGrpWithTinv.Pow_rescale_Pow_iso.{u u} r' N N n).app
    (polyhedral_lattice.Hom ↥Λ (↥M: Type u))
.

section open ProFiltPseuNormGrpWithTinv

--move this
attribute [simps] linear_equiv.to_add_equiv

lemma FLC_arrow_iso_w (c : ℝ≥0) :
  ((((Filtration r').obj c).map_iso (FLC_arrow_iso_aux r' Λ M N n)).hom ≫
    (FLC_complex_arrow _ (sum_hom_strict ((↥Λ →+ ↥M) ^ n) N) c).hom : _) =
  ((FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c).hom) :=
begin
  rw [← iso.eq_inv_comp],
  ext x i l,
  dsimp only [FLC_arrow_iso_aux, iso.trans_inv, functor.map_iso_inv, aug_map,
    Pow_rescale_Pow_iso, iso.app_inv, iso.symm_inv,
    nat_trans.comp_app, functor.associator_hom_app, functor.associator_inv_app,
    iso_whisker_left_inv, iso_whisker_right_inv, whisker_left_app, whisker_right_app,
    Pow_comm, Pow_rescale, FLC_arrow_hom'],
  erw [category.id_comp, category.id_comp, FLC_arrow_hom',
    ← ((Filtration r').obj c).map_comp, category.assoc, ← (Pow r' n).map_comp,
    Cech_augmentation_map_eq_Hom_sum],
  dsimp only [FLC_complex_arrow, arrow.mk_hom,
    Filtration_obj_map_apply, comp_apply,
    continuous_map.coe_mk, pseudo_normed_group.level, subtype.coe_mk,
    comphaus_filtered_pseudo_normed_group_with_Tinv_hom.to_comphaus_filtered_pseudo_normed_group_hom,
    comphaus_filtered_pseudo_normed_group_hom.mk_of_strict,
    comphaus_filtered_pseudo_normed_group_hom.mk_of_bound,
    comphaus_filtered_pseudo_normed_group_hom.coe_mk,
    add_monoid_hom.to_fun_eq_coe,
    comphaus_filtered_pseudo_normed_group_with_Tinv_hom.coe_to_add_monoid_hom,
    ProFiltPseuNormGrpWithTinv.Pow_map, nat_iso.of_components_hom_app, id,
    comphaus_filtered_pseudo_normed_group_with_Tinv_hom.level_coe],
  erw [comp_apply, comp_apply, iso_of_equiv_of_strict'_hom_apply],
  dsimp only [profinitely_filtered_pseudo_normed_group_with_Tinv.pi_map_to_fun,
    ProFiltPseuNormGrpWithTinv.Pow_mul_inv, Pow_comm, Pow_mul_comm,
    Pow_mul_comm_obj_hom_to_fun, Pow_mul_comm_obj_inv_to_fun,
    nat_iso.of_components_inv_app, Pow_rescale_aux_apply],
  simp only [comp_apply, rescale.of, equiv.refl_apply, equiv.refl_symm,
    nat_iso.of_components_inv_app, id, iso_of_equiv_of_strict'_inv_apply,
    rescale_map, rescale.map_comphaus_filtered_pseudo_normed_group_with_Tinv_hom_to_fun,
    ProFiltPseuNormGrpWithTinv.Pow_mul_hom,
    equiv.symm_apply_apply, ProFiltPseuNormGrpWithTinv.Pow_Pow_X_hom_to_fun,
    ProFiltPseuNormGrpWithTinv.Pow_Pow_X_inv_to_fun,
    Pow_Pow_X_equiv_apply, Pow_Pow_X_equiv_symm_apply,
    Pow_mul_comm_obj_hom_to_fun, Pow_mul_comm_obj_inv_to_fun],
  rw [sum_hom_apply, Hom_sum_apply, finset.sum_apply],
  congr' 1,
  refine fintype.sum_congr _ _ _,
  intro j,
  simp only [function.comp_apply, equiv.refl_apply, comp_apply],
  simp only [Pow_Pow_X_equiv_apply, Pow_Pow_X_equiv_symm_apply,
    ProFiltPseuNormGrpWithTinv.Pow_Pow_X_hom_to_fun,
    ProFiltPseuNormGrpWithTinv.Pow_Pow_X_inv_to_fun,
    Pow_mul_comm_obj_hom_to_fun, Pow_mul_comm_obj_inv_to_fun, comp_apply,
    equiv.symm_trans_apply, equiv.symm_symm, equiv.curry_apply, equiv.curry_symm_apply,
    function.curry, function.uncurry, equiv.arrow_congr_symm, equiv.arrow_congr_apply,
    function.comp, equiv.refl_apply, equiv.refl_symm, equiv.trans_apply,
    linear_equiv.to_add_equiv_symm_apply, equiv.prod_comm_apply,
    linear_equiv.inv_fun_eq_symm, equiv.inv_fun_as_coe,
    linear_equiv.trans_apply, linear_equiv.symm_apply_apply, linear_equiv.symm_trans_apply,
    linear_equiv.fun_congr_left_symm, linear_equiv.fun_congr_left_apply, linear_map.fun_left_apply,
    equiv.symm_apply_apply, equiv.apply_symm_apply, equiv.prod_comm_symm],
  refl
end

end

def FLC_arrow_iso (c : ℝ≥0) :
  FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c ≅
  FLC_complex_arrow _ (sum_hom_strict ((↥Λ →+ ↥M) ^ n) N) c :=
arrow.iso_mk (((Filtration r').obj c).map_iso (FLC_arrow_iso_aux r' Λ M N n)) (iso.refl _)
begin
  erw [functor.map_iso_hom, iso.refl_hom, category.comp_id],
  exact (FLC_arrow_iso_w r' Λ M N n c : _),
end

-- lemma FLC_arrow_iso_left_eq (c₁ c₂ : ℝ≥0) {_ : fact (c₁ ≤ c₂)}
--   (x : ((FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c₁).left.to_Top)) :
--   pseudo_normed_group.cast_le (((FLC_arrow_iso r' Λ M N n c₁).hom.left) x) =
--     ((FLC_arrow_iso r' Λ M N n c₂).hom.left) (pseudo_normed_group.cast_le x) :=
-- by admit

-- lemma FLC_arrow_iso_right_eq (c₁ c₂ : ℝ≥0) {_ : fact (c₁ ≤ c₂)}
--   (x : ((FLC_complex_arrow _ (aug_map_strict r' Λ M N n) c₁).right.to_Top)) :
--   pseudo_normed_group.cast_le (((FLC_arrow_iso r' Λ M N n c₁).hom.right) x) =
--     ((FLC_arrow_iso r' Λ M N n c₂).hom.right) (pseudo_normed_group.cast_le x) :=
-- by admit

def col_complex_iso_obj (c : ℝ≥0ᵒᵖ) :
  (FLC_complex V _ (sum_hom_strict ((↥Λ →+ ↥M) ^ n) N)).obj c ≅
    (FLC_complex V _ (aug_map_strict r' Λ M N n)).obj c :=
begin
  refine (cosimplicial_object.augmented.cocomplex.map_iso _),
  refine functor.map_iso _ _,
  refine functor.map_iso _ _,
  refine functor.map_iso _ _,
  refine iso.op _,
  exact FLC_arrow_iso r' Λ M N n c.unop
end

def col_complex_iso_aux2 :
  FLC_complex V _ (sum_hom_strict ((↥Λ →+ ↥M) ^ n) N) ≅
  FLC_complex V _ (aug_map_strict r' Λ M N n) :=
nat_iso.of_components (col_complex_iso_obj r' V Λ M N n)
begin
  intros c₁ c₂ h,
  dsimp only [FLC_complex, FLC_functor, FLC_functor', col_complex_iso_obj, functor.comp_map,
    functor.map_iso_hom, iso.op_hom],
  simp only [← category_theory.functor.map_comp, ← op_comp],
  refl
end

section open cosimplicial_object

lemma col_complex_iso_aux2_strict (c : ℝ≥0ᵒᵖ) (i : ℕ) :
  isometry (((col_complex_iso_aux2 r' V Λ M N n).hom.app c).f i) :=
begin
  rw [← iso.app_hom, ← homological_complex.hom.iso_app_hom],
  refine SemiNormedGroup.iso_isometry_of_norm_noninc _ _ _;
  [ rw [homological_complex.hom.iso_app_hom, iso.app_hom],
    rw [homological_complex.hom.iso_app_inv, iso.app_inv] ];
  { dsimp only [col_complex_iso_aux2, col_complex_iso_obj, nat_iso.of_components, functor.comp_map,
      functor.map_iso_hom, iso.op_hom, quiver.hom.unop_op, functor.op_map,
      cosimplicial_object.augmented.whiskering_obj_2,
      cosimplicial_object.augmented.whiskering_obj],
    apply augmented.cocomplex_map_norm_noninc;
    { intros, apply SemiNormedGroup.LCC_obj_map_norm_noninc, }, },
end

end

def col_complex_iso :
  FLC_complex V _ (sum_hom_strict ((↥Λ →+ ↥M)^n) N) ≅
  col_complex r' V Λ M N n :=
col_complex_iso_aux2 r' V Λ M N n ≪≫ FLC_complex_aug_iso r' V Λ M N n ≪≫ col_complex_level_iso r' V Λ M N n

lemma col_complex_iso_strict (c : ℝ≥0ᵒᵖ) (i : ℕ) :
  isometry (((col_complex_iso r' V Λ M N n).hom.app c).f i) :=
begin
  refine isometry.comp _ (col_complex_iso_aux2_strict r' V Λ M N n c i),
  exact (col_complex_level_iso_strict r' V Λ M N n c i).comp
    (FLC_complex_aug_iso_strict r' V Λ M N n c i),
end

end

lemma col_complex.is_weak_bounded_exact (d : ℝ≥0) [pseudo_normed_group.splittable ((Λ →+ M)^n) N d]
  (k : ℝ≥0) [fact (1 ≤ k)] (m : ℕ) (c₀ : ℝ≥0) (hdkc₀N : d ≤ (k - 1) * c₀ / N) :
  (col_complex r' V Λ M N n).is_weak_bounded_exact k 1 m c₀ :=
begin
  have key := FLC_complex.weak_bounded_exact V ((Λ →+ M)^n) N d k m c₀ hdkc₀N,
  exact key.of_iso _ (λ c, col_complex_iso_strict r' V Λ M N n (op c)),
end

@[simps obj map]
def col_complex_rescaled : system_of_complexes :=
scale_factorial.obj (col_complex r' V Λ M N n)
.

lemma col_complex_rescaled.is_weak_bounded_exact
  (d : ℝ≥0) [pseudo_normed_group.splittable ((Λ →+ M)^n) N d]
  (k : ℝ≥0) [fact (1 ≤ k)] (m : ℕ) (c₀ : ℝ≥0) (hdkc₀N : d ≤ (k - 1) * c₀ / N) :
  (col_complex_rescaled r' V Λ M N n).is_weak_bounded_exact k (m+1) m c₀ :=
begin
  have := scale_factorial.is_weak_bounded_exact
    (col_complex.is_weak_bounded_exact r' V Λ M N n d k m c₀ hdkc₀N),
  rwa [one_mul] at this,
end

end

end

namespace col_complex_rescaled

open polyhedral_lattice (Hom)
open PolyhedralLattice (cosimplicial)

instance move_pls (r' : ℝ≥0) (c : ℝ≥0ᵒᵖ) : fact (unop (r'.MulLeft.op.obj c) ≤ r' * unop c) :=
⟨le_rfl⟩

instance move_pls2 [fact (r' < 1)] (c : ℝ≥0ᵒᵖ) : fact (unop (r'.MulLeft.op.obj c) ≤ unop c) :=
by { dsimp [nnreal.MulLeft], apply_instance }

variables [fact (0 < r)] [fact (0 < r')] [fact (r' < 1)]

def T_inv_sub_Tinv_f_succ [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) (i : ℕ) :
  ((col_complex_rescaled.{u} r' V Λ M N n).obj c).X (i + 1) ⟶
    (((col_complex_rescaled.{u} r' V Λ M N n).scale_index_left r').obj c).X (i + 1) :=
(SemiNormedGroup.rescale (i+1)!).map $ (CLCFP.T_inv_sub_Tinv r r' V _ _ n).app _

def T_inv_sub_Tinv_f [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) :
  Π i, ((col_complex_rescaled.{u} r' V Λ M N n).obj c).X i ⟶
  (((col_complex_rescaled.{u} r' V Λ M N n).scale_index_left r').obj c).X i
| 0     := (SemiNormedGroup.rescale 0!).map $ (CLCFP.T_inv_sub_Tinv r r' V _ _ n).app _
| (i+1) := T_inv_sub_Tinv_f_succ r r' V Λ M N n c i

section open system_of_complexes category_theory.preadditive category_theory.cosimplicial_object
  homological_complex

lemma T_inv_sub_Tinv_comm_zero [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) :
  T_inv_sub_Tinv_f r r' V Λ M N n c 0 ≫
    (((col_complex_rescaled r' V Λ M N n).scale_index_left r').obj c).d 0 1 =
  ((col_complex_rescaled r' V Λ M N n).obj c).d 0 1 ≫
    T_inv_sub_Tinv_f r r' V Λ M N n c 1 :=
begin
  dsimp only [T_inv_sub_Tinv_f, T_inv_sub_Tinv_f_succ, scale_index_left, col_complex_rescaled],
  refine SemiNormedGroup.scale_comm _ _ _ _ _ _ _,
  dsimp,
  rw [if_pos rfl, category.comp_id],
  dsimp only [augmented.to_cocomplex_d],
  erw [Cech_nerve'_hom_zero],
  dsimp only [CLCFP'_map_app],
  erw nat_trans.naturality,
  refl
end
.

lemma T_inv_sub_Tinv_comm_succ [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) (i : ℕ) :
  T_inv_sub_Tinv_f r r' V Λ M N n c (i+1) ≫
    (((col_complex_rescaled r' V Λ M N n).scale_index_left r').obj c).d (i+1) (i+2) =
  ((col_complex_rescaled r' V Λ M N n).obj c).d (i+1) (i+2) ≫
    T_inv_sub_Tinv_f r r' V Λ M N n c (i+2) :=
begin
  dsimp only [T_inv_sub_Tinv_f, T_inv_sub_Tinv_f_succ, scale_index_left, col_complex_rescaled],
  refine SemiNormedGroup.scale_comm _ _ _ _ _ _ _,
  dsimp,
  rw [if_pos rfl, category.comp_id],
  dsimp only [augmented.to_cocomplex_d, coboundary, augmented.drop_obj, Cech_nerve',
    augmented.whiskering_obj_2, augmented.whiskering_obj, cosimplicial_object.δ,
    whiskering_obj_obj_map],
  simp only [nat_trans.app_sum, nat_trans.app_zsmul, sum_comp, comp_sum, zsmul_comp, comp_zsmul],
  apply fintype.sum_congr,
  intro j,
  congr' 1,
  dsimp only [CLCFP'_map_app],
  erw nat_trans.naturality,
  refl,
end
.

lemma T_inv_sub_Tinv_naturality_zero [normed_with_aut r V] (c₁ c₂ : ℝ≥0ᵒᵖ) (h : c₁ ⟶ c₂) :
  ((col_complex_rescaled r' V Λ M N n).map h).f 0 ≫ T_inv_sub_Tinv_f r r' V Λ M N n c₂ 0 =
    T_inv_sub_Tinv_f r r' V Λ M N n c₁ 0 ≫
      (((col_complex_rescaled r' V Λ M N n).scale_index_left r').map h).f 0 :=
begin
  dsimp only [T_inv_sub_Tinv_f, scale_index_left, ScaleIndexLeft_obj_map,
    col_complex_rescaled, scale_factorial_obj, functor.comp_map, modify_functor_map_f,
    col_complex_map, augmented.to_cocomplex_obj, augmented.point_obj, Cech_nerve',
    augmented.whiskering_obj],
  simp only [← category_theory.functor.map_comp],
  congr' 1,
  dsimp only [CLCFP'_obj_map, CLCFP.T_inv_sub_Tinv, nnreal.MulLeft, functor.op_obj, unop_op],
  simp only [nat_trans.app_sub, comp_sub, sub_comp, ← nat_trans.comp_app],
  congr' 2,
  { rw [category.assoc, ← CLCFP.res_comp_T_inv],
    haveI : fact (c₂.unop ≤ c₁.unop) := ⟨le_of_hom h.unop⟩,
    simp only [← category.assoc, CLCFP.res_comp_res], },
  { dsimp only [CLCFP.Tinv, CLCFP.res, CLC, LC],
    simp only [← whisker_right_comp, ← nat_trans.op_comp],
    refl, }
end
.

lemma T_inv_sub_Tinv_naturality_succ [normed_with_aut r V] (c₁ c₂ : ℝ≥0ᵒᵖ) (h : c₁ ⟶ c₂) (i : ℕ) :
  ((col_complex_rescaled r' V Λ M N n).map h).f (i+1) ≫ T_inv_sub_Tinv_f r r' V Λ M N n c₂ (i+1) =
    T_inv_sub_Tinv_f r r' V Λ M N n c₁ (i+1) ≫
      (((col_complex_rescaled r' V Λ M N n).scale_index_left r').map h).f (i+1) :=
begin
  dsimp only [T_inv_sub_Tinv_f, T_inv_sub_Tinv_f_succ, scale_index_left, ScaleIndexLeft_obj_map,
    col_complex_rescaled, scale_factorial_obj, functor.comp_map, modify_functor_map_f,
    col_complex_map, augmented.to_cocomplex_obj, augmented.drop_obj, Cech_nerve',
    augmented.whiskering_obj, whiskering_obj_obj_obj],
  simp only [← category_theory.functor.map_comp],
  congr' 1,
  dsimp only [CLCFP'_obj_map, CLCFP.T_inv_sub_Tinv, nnreal.MulLeft, functor.op_obj, unop_op],
  simp only [nat_trans.app_sub, comp_sub, sub_comp],
  erw [← nat_trans.comp_app, ← nat_trans.comp_app, ← nat_trans.comp_app, ← nat_trans.comp_app],
  congr' 2,
  { rw [category.assoc, ← CLCFP.res_comp_T_inv],
    haveI : fact (c₂.unop ≤ c₁.unop) := ⟨le_of_hom h.unop⟩,
    simp only [← category.assoc, CLCFP.res_comp_res], },
  { dsimp only [CLCFP.Tinv, CLCFP.res, CLC, LC],
    simp only [← whisker_right_comp, ← nat_trans.op_comp],
    refl, }
end

end

def T_inv_sub_Tinv [normed_with_aut r V] :
  col_complex_rescaled r' V Λ M N n ⟶ (col_complex_rescaled r' V Λ M N n).scale_index_left r' :=
{ app := λ c,
  { f := T_inv_sub_Tinv_f r r' V Λ M N n c,
    comm' :=
    begin
      rintros i j (rfl : i + 1 = j),
      cases i, { apply T_inv_sub_Tinv_comm_zero }, { apply T_inv_sub_Tinv_comm_succ }
    end },
  naturality' :=
  begin
    intros c₁ c₂ h, ext i : 2, cases i,
    { apply T_inv_sub_Tinv_naturality_zero },
    { apply T_inv_sub_Tinv_naturality_succ },
  end }

def T_inv_sub_Tinv' (c : ℝ≥0) [normed_with_aut r V] :=
(system_of_complexes.ScaleIndexRight c).map
  (col_complex_rescaled.T_inv_sub_Tinv r r' V Λ M N n)

end col_complex_rescaled

namespace double_complex

open polyhedral_lattice (Hom)

local attribute [semireducible] CLCFPTinv CLCFPTinv₂ CLCFP -- CLCTinv

variables [fact (0 < r)] [fact (0 < r')] [fact (r < r')] [fact (r' < 1)]

@[simps obj map]
def col'_aux [normed_with_aut r V] (n : ℕ) : system_of_complexes :=
(double_complex' BD κ r r' V Λ M N).col n

@[simps obj map]
def col' [normed_with_aut r V] (n : ℕ) : system_of_complexes :=
scale_factorial.obj (col'_aux BD κ r r' V Λ M N n)
.

def col_iso_obj_X [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) :
  Π m, (((double_complex.{u} BD κ r r' V Λ M N).col n).obj c).X m ≅
  ((col'.{u} BD κ r r' V Λ M N n).obj c).X m
| 0     := (SemiNormedGroup.iso_rescale _).app _
| 1     := (SemiNormedGroup.iso_rescale _).app _
| (m+2) := iso.refl _

section

open homological_complex system_of_complexes

lemma col_iso_comm₁_0 [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) :
  (col_iso_obj_X BD κ r r' V Λ M N n c 0).hom ≫
    ((col' BD κ r r' V Λ M N n).obj c).d 0 1 =
  (((double_complex BD κ r r' V Λ M N).col n).obj c).d 0 1 ≫
    (col_iso_obj_X BD κ r r' V Λ M N n c 1).hom :=
by { dsimp only [col_iso_obj_X], ext, refl }
.

lemma col_iso_comm₁_1 [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) :
  (col_iso_obj_X BD κ r r' V Λ M N n c 1).hom ≫
    ((col' BD κ r r' V Λ M N n).obj c).d 1 2 =
  (((double_complex BD κ r r' V Λ M N).col n).obj c).d 1 2 ≫
    (col_iso_obj_X BD κ r r' V Λ M N n c 2).hom :=
begin
  delta col_iso_obj_X,
  simp only [iso.refl_hom, nat.rec_add_one, category.id_comp, category.comp_id,
    system_of_double_complexes.col_obj_d],
  dsimp only [col'_obj, col'_aux_obj, double_complex', double_complex,
    double_complex_aux_rescaled, as_functor_obj, modify_d, eval_obj, eval_map,
    functor.map_homological_complex_obj_d, functor.map_homological_complex_obj_X,
    nat_trans.comp_app, comp_f, rescale_functor, rescale_nat_trans,
    system_of_complexes.rescale, scale],
  refl
end
.

lemma col_iso_comm₂_0 [normed_with_aut r V] (c₁ c₂ : ℝ≥0ᵒᵖ) (h : c₁ ⟶ c₂) :
  (((double_complex.{u} BD κ r r' V Λ M N).col n).map h).f 0 ≫
    (col_iso_obj_X BD κ r r' V Λ M N n c₂ 0).hom =
  (col_iso_obj_X BD κ r r' V Λ M N n c₁ 0).hom ≫
    ((col'.{u} BD κ r r' V Λ M N n).map h).f 0 :=
by { dsimp only [col_iso_obj_X], ext, refl }
.

lemma col_iso_comm₂_1 [normed_with_aut r V] (c₁ c₂ : ℝ≥0ᵒᵖ) (h : c₁ ⟶ c₂) :
  (((double_complex.{u} BD κ r r' V Λ M N).col n).map h).f 1 ≫
    (col_iso_obj_X BD κ r r' V Λ M N n c₂ 1).hom =
  (col_iso_obj_X BD κ r r' V Λ M N n c₁ 1).hom ≫
    ((col'.{u} BD κ r r' V Λ M N n).map h).f 1 :=
by { dsimp only [col_iso_obj_X], ext, refl }
.

local attribute [irreducible] CLCFPTinv CLCFPTinv₂ CLCFP
  SemiNormedGroup.rescale SemiNormedGroup.scale
  double_complex_aux

lemma col_iso_comm₁_succ [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) (i : ℕ) :
  (col_iso_obj_X BD κ r r' V Λ M N n c i.succ.succ).hom ≫
    ((col'.{u} BD κ r r' V Λ M N n).obj c).d i.succ.succ (i.succ.succ + 1) =
  (((double_complex.{u} BD κ r r' V Λ M N).col n).obj c).d i.succ.succ (i.succ.succ + 1) ≫
    (col_iso_obj_X BD κ r r' V Λ M N n c (i.succ.succ + 1)).hom :=
begin
  dsimp only [col_iso_obj_X, iso.refl_hom],
  simp only [category.id_comp, category.comp_id, system_of_double_complexes.col_obj_d],
  refl,
end
.

lemma col_iso_comm₂_succ [normed_with_aut r V] (c₁ c₂ : ℝ≥0ᵒᵖ) (h : c₁ ⟶ c₂) (i : ℕ) :
  (((double_complex.{u} BD κ r r' V Λ M N).col n).map h).f (i+2) ≫
    (col_iso_obj_X BD κ r r' V Λ M N n c₂ (i+2)).hom =
  (col_iso_obj_X BD κ r r' V Λ M N n c₁ (i+2)).hom ≫
    ((col'.{u} BD κ r r' V Λ M N n).map h).f (i+2) :=
begin
  dsimp only [col_iso_obj_X, iso.refl_hom],
  simp only [category.id_comp, category.comp_id, system_of_double_complexes.col_obj_d],
  refl
end

lemma col_iso_comm₂ [normed_with_aut r V] (c₁ c₂ : ℝ≥0ᵒᵖ) (h : c₁ ⟶ c₂) :
  ∀ i, (((double_complex.{u} BD κ r r' V Λ M N).col n).map h).f i ≫
    (col_iso_obj_X BD κ r r' V Λ M N n c₂ i).hom =
  (col_iso_obj_X BD κ r r' V Λ M N n c₁ i).hom ≫
    ((col'.{u} BD κ r r' V Λ M N n).map h).f i
| 0     := col_iso_comm₂_0 _ _ _ _ _ _ _ _ _ _ _ _
| 1     := col_iso_comm₂_1 _ _ _ _ _ _ _ _ _ _ _ _
| (i+2) := col_iso_comm₂_succ _ _ _ _ _ _ _ _ _ _ _ _ _
.

end

section

open homological_complex

-- set_option pp.universes true

@[simps]
def col_iso [normed_with_aut r V] :
  (double_complex.{u} BD κ r r' V Λ M N).col n ≅
  col'.{u} BD κ r r' V Λ M N n :=
nat_iso.of_components (λ c, hom.iso_of_components (col_iso_obj_X.{u} BD κ r r' V Λ M N n _)
  begin
    rintro i j (rfl : i + 1 = j),
    cases i, { exact col_iso_comm₁_0 BD κ r r' V Λ M N n c, },
    cases i, { exact col_iso_comm₁_1 BD κ r r' V Λ M N n c, },
    { exact col_iso_comm₁_succ BD κ r r' V Λ M N n c i, },
  end)
  begin
    intros c₁ c₂ h, ext i : 2,
    dsimp only [comp_f, hom.iso_of_components_hom_f],
    exact col_iso_comm₂ BD κ r r' V Λ M N n c₁ c₂ h i,
  end
.

lemma col_iso_strict [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) (i : ℕ) :
  isometry (hom.iso_app ((col_iso BD κ r r' V Λ M N n).app c) i).hom :=
begin
  dsimp only [hom.iso_app_hom, nat_iso.app_hom, col_iso_hom_app_f],
  cases i, { delta col_iso_obj_X, apply SemiNormedGroup.iso_rescale_isometry, exact nat.cast_one },
  cases i, { delta col_iso_obj_X, apply SemiNormedGroup.iso_rescale_isometry, exact nat.cast_one },
  { delta col_iso_obj_X, exact isometry_id }
end

lemma col_iso_inv_strict [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) (i : ℕ) :
  isometry (hom.iso_app ((col_iso BD κ r r' V Λ M N n).app c) i).inv :=
(col_iso_strict BD κ r r' V Λ M N n c i).right_inv $
λ x, by rw [← comp_apply, iso.inv_hom_id, id_apply]

end

lemma col_obj_X_zero [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) :
  (((double_complex BD κ r r' V Λ M N).col n).obj c).X 0 =
  (CLCFPTinv r V r' (c.unop * κ n) (BD.X n)).obj (op $ Hom Λ M) := rfl

-- local attribute [semireducible] opposite

def col_ι_f_succ [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) (i : ℕ) :
  ((col'.{u} BD κ r r' V Λ M N n).obj c).X (i+1) ⟶
    (((col_complex_rescaled.{u} r' V Λ M N (BD.X n)).scale_index_right (κ n)).obj c).X (i+1) :=
(SemiNormedGroup.rescale (i+1)!).map (CLCTinv.ι r V _ _)

def col_ι_f [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) :
  Π i, ((col'.{u} BD κ r r' V Λ M N n).obj c).X i ⟶
    (((col_complex_rescaled.{u} r' V Λ M N (BD.X n)).scale_index_right (κ n)).obj c).X i
| 0     := (SemiNormedGroup.rescale 0!).map (CLCTinv.ι r V _ _)
| (i+1) := col_ι_f_succ _ _ _ _ _ _ _ _ _ _ i

section open homological_complex system_of_complexes breen_deligne

lemma col_ι_f_comm_zero [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) :
  col_ι_f BD κ r r' V Λ M N n c 0 ≫
    (((col_complex_rescaled r' V Λ M N (BD.X n)).scale_index_right (κ n)).obj c).d 0 1 =
  ((col' BD κ r r' V Λ M N n).obj c).d 0 1 ≫ col_ι_f BD κ r r' V Λ M N n c 1 :=
begin
  dsimp only [col_ι_f, col_ι_f_succ, col'_obj, functor.map_homological_complex_obj_d,
    modify_d, eval_map, scale_index_right, ScaleIndexRight_obj_obj, col_complex_rescaled_obj,
    scale'_app],
  refine SemiNormedGroup.scale_comm _ _ _ _ _ _ _,
  rw [dif_pos rfl, dif_pos rfl],
  simp only [cosimplicial_object.augmented.to_cocomplex_d, eq_to_hom_refl, category.comp_id],
  erw [Cech_nerve'_hom_zero, cosimplicial_system_of_complexes_hom_zero],
  dsimp only [data.system_map, data.complex, data.complex₂_map_f, CLCFPTinv₂, CLCTinv.F_map],
  symmetry,
  apply CLCTinv.map_comp_ι,
end

section open category_theory.preadditive

lemma col_ι_f_comm_succ [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) (i : ℕ) :
  col_ι_f BD κ r r' V Λ M N n c (i + 1) ≫
    (((col_complex_rescaled r' V Λ M N (BD.X n)).scale_index_right (κ n)).obj c).d (i+1) (i+2) =
  ((col' BD κ r r' V Λ M N n).obj c).d (i + 1) (i + 2) ≫ col_ι_f BD κ r r' V Λ M N n c (i+2) :=
begin
  dsimp only [col_ι_f, col_ι_f_succ, col'_obj, functor.map_homological_complex_obj_d,
    modify_d, eval_map, scale_index_right, ScaleIndexRight_obj_obj, col_complex_rescaled_obj,
    scale'_app],
  refine SemiNormedGroup.scale_comm _ _ _ _ _ _ _,
  rw [dif_pos rfl, dif_pos rfl],
  simp only [cosimplicial_object.augmented.to_cocomplex_d, eq_to_hom_refl, category.comp_id,
    cosimplicial_object.coboundary, nat_trans.app_sum, nat_trans.app_zsmul,
    ← homological_complex.hom.f_add_monoid_hom_apply, add_monoid_hom.map_sum,
    add_monoid_hom.map_zsmul, sum_comp, comp_sum, zsmul_comp, comp_zsmul],
  symmetry,
  apply fintype.sum_congr,
  intro j,
  refl,
end

end

lemma col_ι_f_comm [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) :
  ∀ i, col_ι_f BD κ r r' V Λ M N n c i ≫
    (((col_complex_rescaled r' V Λ M N (BD.X n)).scale_index_right (κ n)).obj c).d i (i + 1) =
  ((col' BD κ r r' V Λ M N n).obj c).d i (i + 1) ≫ col_ι_f BD κ r r' V Λ M N n c (i + 1)
| 0     := by apply col_ι_f_comm_zero
| (i+1) := by apply col_ι_f_comm_succ

section open category_theory.cosimplicial_object

lemma col_ι_naturality_zero [normed_with_aut r V] (c₁ c₂ : ℝ≥0ᵒᵖ) (h : c₁ ⟶ c₂) :
  ((col' BD κ r r' V Λ M N n).map h).f 0 ≫ col_ι_f BD κ r r' V Λ M N n c₂ 0 =
  col_ι_f BD κ r r' V Λ M N n c₁ 0 ≫ (((col_complex_rescaled r' V Λ M N (BD.X n)).scale_index_right (κ n)).map h).f 0 :=
begin
  dsimp only [col'_map, functor.map_homological_complex_map_f, eval_map,
    modify_functor_map_f, col_ι_f,
    scale_index_right, ScaleIndexRight_obj_map, col_complex_rescaled_map],
  simp only [← category_theory.functor.map_comp],
  congr' 1,
  dsimp only [augmented.to_cocomplex_obj, augmented.point_obj, cosimplicial_system_of_complexes,
    Cech_nerve', augmented.whiskering_obj, CLCFP',
    data.system_obj, data.complex, data.complex₂_obj_X, CLCFPTinv₂.res, CLCTinv.map_nat,
    functor.comp_obj, functor.comp_map, functor.op_obj, functor.op_map, whiskering_right_obj_obj,
    functor.op_hom_obj, unop_op, functor.flip_obj_map],
  apply CLCTinv.map_comp_ι,
end
.

lemma col_ι_naturality_succ [normed_with_aut r V] (c₁ c₂ : ℝ≥0ᵒᵖ) (h : c₁ ⟶ c₂) (i : ℕ) :
  ((col' BD κ r r' V Λ M N n).map h).f (i+1) ≫ col_ι_f BD κ r r' V Λ M N n c₂ (i+1) =
  col_ι_f BD κ r r' V Λ M N n c₁ (i+1) ≫ (((col_complex_rescaled r' V Λ M N (BD.X n)).scale_index_right (κ n)).map h).f (i+1) :=
begin
  dsimp only [col'_map, functor.map_homological_complex_map_f, eval_map,
    modify_functor_map_f, col_ι_f, col_ι_f_succ,
    scale_index_right, ScaleIndexRight_obj_map, col_complex_rescaled_map],
  simp only [← category_theory.functor.map_comp],
  congr' 1,
  dsimp only [augmented.to_cocomplex_obj, augmented.drop_obj, cosimplicial_system_of_complexes,
    Cech_nerve', augmented.whiskering_obj, CLCFP', whiskering_obj_obj_obj,
    data.system_obj, data.complex, data.complex₂_obj_X, CLCFPTinv₂.res, CLCTinv.map_nat,
    functor.comp_obj, functor.comp_map, functor.op_obj, functor.op_map, whiskering_right_obj_obj,
    functor.op_hom_obj, unop_op, functor.flip_obj_map],
  apply CLCTinv.map_comp_ι,
end
.

end

end

def col_ι [normed_with_aut r V] :
  col'.{u} BD κ r r' V Λ M N n ⟶
    (col_complex_rescaled.{u} r' V Λ M N (BD.X n)).scale_index_right (κ n) :=
{ app := λ c,
  { f := col_ι_f BD κ r r' V Λ M N n c,
    comm' := by { rintro i j (rfl : i + 1 = j), apply col_ι_f_comm } },
  naturality' :=
  begin
    intros c₁ c₂ h, ext i : 2,
    cases i,
    { apply col_ι_naturality_zero },
    { apply col_ι_naturality_succ },
  end }

variables [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) (i : ℕ)

lemma col_ι_range :
  (((double_complex.col_ι BD κ r r' V Λ M N n).app c).f i).range =
  (((col_complex_rescaled.T_inv_sub_Tinv' r r' V Λ M N (BD.X n) (κ n)).app c).f i).ker :=
begin
  cases i;
  { refine SemiNormedGroup.rescale_exact _ _ _ _,
    rw CLCTinv.ι_range',
    ext1 x,
    refl, },
end

lemma col_ι_isometry :
  isometry (((double_complex.col_ι BD κ r r' V Λ M N n).app c).f i) :=
begin
  cases i;
  { refine SemiNormedGroup.rescale_map_isometry _ _,
    apply add_monoid_hom_class.isometry_of_norm,
    intro, refl },
end

end double_complex

namespace col_complex_rescaled

variables [fact (0 < r')] [fact (r' ≤ 1)]

lemma d_zero_norm_noninc (c : ℝ≥0) :
  (@system_of_complexes.d (col_complex_rescaled r' V Λ M N n) c 0 1).norm_noninc :=
begin
  apply normed_add_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.2,
  refine normed_add_group_hom.norm_comp_le_of_le' (1:ℕ) _ 1 _ (SemiNormedGroup.norm_scale_le _ _ _) _,
  { simp only [mul_one, nat.factorial_zero, nat.factorial_one, nat.cast_one, div_one, nnreal.coe_one]},
  apply SemiNormedGroup.norm_rescale_map_le,
  have : (1 : ℝ) = ∑ i : fin 1, 1,
  { simp only [finset.card_fin, mul_one, finset.sum_const, nsmul_eq_mul, nat.cast_id,
      nat.cast_bit1, nat.cast_add, nat.cast_one] },
  dsimp [system_of_complexes.rescale_functor, double_complex_aux,
    cosimplicial_object.augmented.to_cocomplex_d],
  erw [category.comp_id, if_pos rfl, Cech_nerve'_hom_zero, nat.cast_one],
  apply normed_add_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.1,
  apply CLC.map_norm_noninc,
end

lemma d_succ_norm_noninc (c : ℝ≥0) (p : ℕ) :
  (@system_of_complexes.d (col_complex_rescaled r' V Λ M N n) c (p+1) (p+2)).norm_noninc :=
begin
  apply normed_add_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.2,
  refine normed_add_group_hom.norm_comp_le_of_le' (p+2:ℕ) _ 1 _ (SemiNormedGroup.norm_scale_le _ _ _) _,
  { norm_cast,
    rw [mul_comm, ← mul_div_assoc, eq_comm, ← nat.cast_mul, nat.factorial_succ], apply div_self,
    norm_num [nat.factorial_ne_zero] },
  apply SemiNormedGroup.norm_rescale_map_le,
  have : (p+1+1 : ℝ) = ∑ i : fin (p+1+1), 1,
  { simp only [finset.card_fin, mul_one, finset.sum_const, nsmul_eq_mul, nat.cast_id,
      nat.cast_bit1, nat.cast_add, nat.cast_one] },
  dsimp [system_of_complexes.rescale_functor, double_complex_aux,
    cosimplicial_object.augmented.to_cocomplex_d],
  erw [category.comp_id, if_pos rfl],
  dsimp [cosimplicial_object.coboundary],
  rw [add_assoc, show (1 : ℝ)+1=2, by norm_num] at this,
  simp only [← nat_trans.app_hom_apply, add_monoid_hom.map_sum, add_monoid_hom.map_zsmul,
    ← homological_complex.hom.f_add_monoid_hom_apply, nat.cast_add, nat.cast_bit0, nat.cast_one,
    this],
  apply norm_sum_le_of_le,
  rintro i -,
  refine le_trans (norm_zsmul_le _ _) _,
  rw [← int.norm_cast_real, int.cast_pow, norm_pow, int.cast_neg, int.cast_one, norm_neg, norm_one,
    one_pow, one_mul],
  apply normed_add_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.1,
  apply CLC.map_norm_noninc
end

lemma admissible : (col_complex_rescaled r' V Λ M N n).admissible :=
{ d_norm_noninc' :=
  begin
    rintro c i j rfl, cases i,
    { apply d_zero_norm_noninc, },
    { apply d_succ_norm_noninc, }
  end,
  res_norm_noninc :=
  begin
    intros c₁ c₂ i h,
    apply normed_add_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.2,
    cases i;
    { apply SemiNormedGroup.norm_rescale_map_le,
      apply normed_add_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.1,
      apply CLC.map_norm_noninc, },
  end }

end col_complex_rescaled

variables [fact (0 < r)] [fact (0 < r')] [fact (r' < 1)]

lemma col_exact'_aux1 [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) (i : ℕ) :
  ∀ x, ∥(((col_complex_rescaled.T_inv_sub_Tinv' r r' V Λ M N (BD.X n) (κ n)).app c).f i) x∥ ≤
    (1 + r⁻¹) * ∥x∥ :=
begin
  intro x,
  cases i;
  { apply normed_add_group_hom.le_of_op_norm_le,
    refine @SemiNormedGroup.norm_rescale_map_le _ _ _ _ _ (1 + r⁻¹) _,
    exact CLCFP.norm_T_inv_sub_Tinv_le _ _ _ _ _ _ _ }
end

variables [fact (r < r')]

lemma col_exact'_aux2 [normed_with_aut r V] (c : ℝ≥0ᵒᵖ) (i : ℕ) :
  ∀ y, ∃ x,
    (((col_complex_rescaled.T_inv_sub_Tinv' r r' V Λ M N (BD.X n) (κ n)).app c).f i) x = y ∧
    ∥x∥ ≤ ↑(r / (1 - r) + 1) * ∥y∥ :=
begin
  haveI : fact (r < 1) := ⟨@lt_trans _ _ r r' 1 (fact.out _) (fact.out _)⟩,
  cases i;
  { refine SemiNormedGroup.rescale_exists_norm_le _ _ _ _,
    intro y,
    obtain ⟨x, h1, h2⟩ := CLCFP.T_inv_sub_Tinv_exists_preimage r r' y 1 zero_lt_one,
    refine ⟨x, h1, _⟩,
    rwa [nnreal.coe_add, nnreal.coe_div, nnreal.coe_sub],
    exact fact.out _ }
end

lemma col_exact' [normed_with_aut r V] [fact (r < 1)]
  (d : ℝ≥0) [pseudo_normed_group.splittable (Λ →+ M) N d]
  (k : ℝ≥0) [fact (1 ≤ k)] (m : ℕ) (c₀ : ℝ≥0) (hdkc₀N : d ≤ (k - 1) * c₀ / N)
  (k' K' : ℝ≥0) [fact (1 ≤ k')] (hk' : k * k ≤ k')
  (hK' : (m + 2 + (r + 1) / (r * (1 - r)) * (m + 2)^2 : ℝ≥0) ≤ K')
  (c₁ c₂ : ℝ≥0) [fact (c₀ ≤ r' * c₁)] [fact (c₀ ≤ κ n * c₂)] [fact (c₁ ≤ κ n * c₂)] :
  (double_complex.col'.{u} BD κ r r' V Λ M N n).is_weak_bounded_exact k' K' m c₂ :=
begin
  have adm := (col_complex_rescaled.admissible.{u} r' V Λ M N (BD.X n)),
  have adm2 := adm.scale_index_left r',
  let T_T := col_complex_rescaled.T_inv_sub_Tinv' r r' V Λ M N (BD.X n) (κ n),
  have H := (col_complex_rescaled.is_weak_bounded_exact.{u}
    r' V Λ M N (BD.X n) d k (m+1) c₀ hdkc₀N),
  have H1 := H.scale_index_right _ c₂ (κ n) adm,
  have H2 := (H.scale_index_left _ c₁ r' adm).scale_index_right _ c₂ (κ n) adm2,
  have key := weak_normed_snake_dual
    (double_complex.col'.{u} BD κ r r' V Λ M N n) _ _
    (double_complex.col_ι BD κ r r' V Λ M N n) T_T
    k _ ((m + 1) + 1) _ (1 + r⁻¹) (r / (1 - r) + 1) (by simpa using H1) H2 (adm.scale_index_right _),
  have h_isom : _ := _,
  apply (key _ _ _ h_isom).of_le _ ⟨hk'⟩ _ le_rfl ⟨le_rfl⟩,
  any_goals { clear key adm2 H1 H2 },
  { intros, apply col_exact'_aux1 },
  { intros, apply col_exact'_aux2 },
  { intros c i, apply double_complex.col_ι_range },
  { apply system_of_complexes.admissible_of_isometry (adm.scale_index_right _) h_isom, },
  { refine ⟨le_trans (le_of_eq _) hK'⟩,
    rw [pow_two, ← mul_assoc],
    simp only [nat.cast_add, nat.cast_one, bit0, ← add_assoc, or_false, add_eq_zero_iff,
      one_ne_zero, add_right_inj, mul_eq_mul_right_iff, and_false, div_eq_mul_inv],
    have hr0 : r ≠ 0, { exact ne_of_gt (fact.out _) },
    have h1r : 1 - r ≠ 0,
    { rw [← nnreal.coe_injective.ne_iff, nnreal.coe_sub, nnreal.coe_zero, sub_ne_zero],
      { norm_cast, exact ne_of_gt (fact.out _) },
      { exact fact.out _ } },
    calc (1 + r⁻¹) * (r * (1 - r)⁻¹ + 1)
        = (1 + r⁻¹) * (r * (1 - r)⁻¹ + (1 - r) * (1 - r)⁻¹) : by rw [mul_inv_cancel h1r]
    ... = (1 + r⁻¹) * (1 - r)⁻¹ : congr_arg _ _
    ... = (1 + r⁻¹) * (r * r⁻¹) * (1 - r)⁻¹ : by rw [mul_inv_cancel hr0, mul_one]
    ... = ((1 + r⁻¹) * r) * (r⁻¹ * (1 - r)⁻¹) : by simp only [mul_assoc]
    ... = (r + 1) * (r * (1 - r))⁻¹ : _,
    { rw [← add_mul, add_comm, tsub_add_cancel_of_le, one_mul], exact fact.out _ },
    { rw [add_mul, one_mul, inv_mul_cancel, mul_inv],
      exact ne_of_gt (fact.out _) } },
  { intros c i, apply double_complex.col_ι_isometry, }
end

lemma col_exact [normed_with_aut r V] [fact (r < 1)]
  (d : ℝ≥0) [pseudo_normed_group.splittable (Λ →+ M) N d]
  (k : ℝ≥0) [fact (1 ≤ k)] (m : ℕ) (c₀ : ℝ≥0) (hdkc₀N : d ≤ (k - 1) * c₀ / N)
  (k' K' : ℝ≥0) [fact (1 ≤ k')] (hk' : k * k ≤ k')
  (hK' : (m + 2 + (r + 1) / (r * (1 - r)) * (m + 2)^2 : ℝ≥0) ≤ K')
  (c₁ c₂ : ℝ≥0) (_ : fact (c₀ ≤ r' * c₁)) (_ : fact (c₀ ≤ κ n * c₂)) (_ : fact (c₁ ≤ κ n * c₂)) :
  ((double_complex.{u} BD κ r r' V Λ M N).col n).is_weak_bounded_exact k' K' m c₂ :=
begin
  have key := col_exact' BD κ r r' V Λ M N n d k m c₀ hdkc₀N k' K' hk' hK' c₁ c₂,
  apply key.of_iso (double_complex.col_iso BD κ r r' V Λ M N n).symm,
  intros,
  apply double_complex.col_iso_inv_strict
end

end thm95


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.shapes.terminal
import category_theory.limits.shapes.binary_products
import category_theory.limits.shapes.products
import category_theory.limits.shapes.images
import category_theory.isomorphism_classes

/-!
# Zero morphisms and zero objects

A category "has zero morphisms" if there is a designated "zero morphism" in each morphism space,
and compositions of zero morphisms with anything give the zero morphism. (Notice this is extra
structure, not merely a property.)

A category "has a zero object" if it has an object which is both initial and terminal. Having a
zero object provides zero morphisms, as the unique morphisms factoring through the zero object.

## References

* https://en.wikipedia.org/wiki/Zero_morphism
* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2]
-/

noncomputable theory

universes v u

open category_theory
open category_theory.category

namespace category_theory.limits

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

/-- A category "has zero morphisms" if there is a designated "zero morphism" in each morphism space,
and compositions of zero morphisms with anything give the zero morphism. -/
class has_zero_morphisms :=
[has_zero : Π X Y : C, has_zero (X ⟶ Y)]
(comp_zero' : ∀ {X Y : C} (f : X ⟶ Y) (Z : C), f ≫ (0 : Y ⟶ Z) = (0 : X ⟶ Z) . obviously)
(zero_comp' : ∀ (X : C) {Y Z : C} (f : Y ⟶ Z), (0 : X ⟶ Y) ≫ f = (0 : X ⟶ Z) . obviously)

attribute [instance] has_zero_morphisms.has_zero
restate_axiom has_zero_morphisms.comp_zero'
restate_axiom has_zero_morphisms.zero_comp'

variables {C}

@[simp] lemma comp_zero [has_zero_morphisms C] {X Y : C} {f : X ⟶ Y} {Z : C} :
  f ≫ (0 : Y ⟶ Z) = (0 : X ⟶ Z) := has_zero_morphisms.comp_zero f Z
@[simp] lemma zero_comp [has_zero_morphisms C] {X : C} {Y Z : C} {f : Y ⟶ Z} :
  (0 : X ⟶ Y) ≫ f = (0 : X ⟶ Z) := has_zero_morphisms.zero_comp X f

instance has_zero_morphisms_pempty : has_zero_morphisms (discrete pempty) :=
{ has_zero := by tidy }

instance has_zero_morphisms_punit : has_zero_morphisms (discrete punit) :=
{ has_zero := by tidy }

namespace has_zero_morphisms
variables {C}

/-- This lemma will be immediately superseded by `ext`, below. -/
private lemma ext_aux (I J : has_zero_morphisms C)
  (w : ∀ X Y : C, (@has_zero_morphisms.has_zero _ _ I X Y).zero =
    (@has_zero_morphisms.has_zero _ _ J X Y).zero) : I = J :=
begin
  casesI I, casesI J,
  congr,
  { ext X Y,
    exact w X Y },
  { apply proof_irrel_heq, },
  { apply proof_irrel_heq, }
end

/--
If you're tempted to use this lemma "in the wild", you should probably
carefully consider whether you've made a mistake in allowing two
instances of `has_zero_morphisms` to exist at all.

See, particularly, the note on `zero_morphisms_of_zero_object` below.
-/
lemma ext (I J : has_zero_morphisms C) : I = J :=
begin
  apply ext_aux,
  intros X Y,
  rw ←@has_zero_morphisms.comp_zero _ _ I X X (@has_zero_morphisms.has_zero _ _ J X X).zero,
  rw @has_zero_morphisms.zero_comp _ _ J,
end

instance : subsingleton (has_zero_morphisms C) :=
⟨ext⟩

end has_zero_morphisms

open has_zero_morphisms

section
variables {C} [has_zero_morphisms C]

lemma zero_of_comp_mono {X Y Z : C} {f : X ⟶ Y} (g : Y ⟶ Z) [mono g] (h : f ≫ g = 0) : f = 0 :=
by { rw [←zero_comp, cancel_mono] at h, exact h }

lemma zero_of_epi_comp {X Y Z : C} (f : X ⟶ Y) {g : Y ⟶ Z} [epi f] (h : f ≫ g = 0) : g = 0 :=
by { rw [←comp_zero, cancel_epi] at h, exact h }

lemma eq_zero_of_image_eq_zero {X Y : C} {f : X ⟶ Y} [has_image f] (w : image.ι f = 0) : f = 0 :=
by rw [←image.fac f, w, has_zero_morphisms.comp_zero]

lemma nonzero_image_of_nonzero {X Y : C} {f : X ⟶ Y} [has_image f] (w : f ≠ 0) : image.ι f ≠ 0 :=
λ h, w (eq_zero_of_image_eq_zero h)
end

section
universes v' u'
variables (D : Type u') [category.{v'} D]

variables [has_zero_morphisms D]

instance : has_zero_morphisms (C ⥤ D) :=
{ has_zero := λ F G, ⟨{ app := λ X, 0, }⟩ }

@[simp] lemma zero_app (F G : C ⥤ D) (j : C) : (0 : F ⟶ G).app j = 0 := rfl

variables [has_zero_morphisms C]

lemma equivalence_preserves_zero_morphisms (F : C ≌ D) (X Y : C) :
  F.functor.map (0 : X ⟶ Y) = (0 : F.functor.obj X ⟶ F.functor.obj Y) :=
begin
  have t : F.functor.map (0 : X ⟶ Y) =
    F.functor.map (0 : X ⟶ Y) ≫ (0 : F.functor.obj Y ⟶ F.functor.obj Y),
  { apply faithful.map_injective (F.inverse),
    rw [functor.map_comp, equivalence.inv_fun_map],
    dsimp,
    rw [zero_comp, comp_zero, zero_comp], },
  exact t.trans (by simp)
end

@[simp] lemma is_equivalence_preserves_zero_morphisms (F : C ⥤ D) [is_equivalence F] (X Y : C) :
  F.map (0 : X ⟶ Y) = 0 :=
by rw [←functor.as_equivalence_functor F, equivalence_preserves_zero_morphisms]

end

variables (C)

/-- A category "has a zero object" if it has an object which is both initial and terminal. -/
class has_zero_object :=
(zero : C)
(unique_to : Π X : C, unique (zero ⟶ X))
(unique_from : Π X : C, unique (X ⟶ zero))

instance has_zero_object_punit : has_zero_object (discrete punit) :=
{ zero := punit.star,
  unique_to := by tidy,
  unique_from := by tidy, }

variables {C}

namespace has_zero_object

variables [has_zero_object C]

/--
Construct a `has_zero C` for a category with a zero object.
This can not be a global instance as it will trigger for every `has_zero C` typeclass search.
-/
protected def has_zero : has_zero C :=
{ zero := has_zero_object.zero }

local attribute [instance] has_zero_object.has_zero
local attribute [instance] has_zero_object.unique_to has_zero_object.unique_from

@[ext]
lemma to_zero_ext {X : C} (f g : X ⟶ 0) : f = g :=
by rw [(has_zero_object.unique_from X).uniq f, (has_zero_object.unique_from X).uniq g]

@[ext]
lemma from_zero_ext {X : C} (f g : 0 ⟶ X) : f = g :=
by rw [(has_zero_object.unique_to X).uniq f, (has_zero_object.unique_to X).uniq g]

instance (X : C) : subsingleton (X ≅ 0) := by tidy

instance {X : C} (f : 0 ⟶ X) : mono f :=
{ right_cancellation := λ Z g h w, by ext, }

instance {X : C} (f : X ⟶ 0) : epi f :=
{ left_cancellation := λ Z g h w, by ext, }

/-- A category with a zero object has zero morphisms.

    It is rarely a good idea to use this. Many categories that have a zero object have zero
    morphisms for some other reason, for example from additivity. Library code that uses
    `zero_morphisms_of_zero_object` will then be incompatible with these categories because
    the `has_zero_morphisms` instances will not be definitionally equal. For this reason library
    code should generally ask for an instance of `has_zero_morphisms` separately, even if it already
    asks for an instance of `has_zero_objects`. -/
def zero_morphisms_of_zero_object : has_zero_morphisms C :=
{ has_zero := λ X Y,
  { zero := inhabited.default (X ⟶ 0) ≫ inhabited.default (0 ⟶ Y) },
  zero_comp' := λ X Y Z f, by { dunfold has_zero.zero, rw category.assoc, congr, },
  comp_zero' := λ X Y Z f, by { dunfold has_zero.zero, rw ←category.assoc, congr, }}

/-- A zero object is in particular initial. -/
lemma has_initial : has_initial C :=
has_initial_of_unique 0
/-- A zero object is in particular terminal. -/
lemma has_terminal : has_terminal C :=
has_terminal_of_unique 0

end has_zero_object

section
variables [has_zero_object C] [has_zero_morphisms C]
local attribute [instance] has_zero_object.has_zero

@[simp]
lemma id_zero : 𝟙 (0 : C) = (0 : 0 ⟶ 0) :=
by ext

/--  An arrow ending in the zero object is zero -/
-- This can't be a `simp` lemma because the left hand side would be a metavariable.
lemma zero_of_to_zero {X : C} (f : X ⟶ 0) : f = 0 :=
by ext

lemma zero_of_target_iso_zero {X Y : C} (f : X ⟶ Y) (i : Y ≅ 0) : f = 0 :=
begin
  have h : f = f ≫ i.hom ≫ 𝟙 0 ≫ i.inv := by simp only [iso.hom_inv_id, id_comp, comp_id],
  simpa using h,
end

/-- An arrow starting at the zero object is zero -/
lemma zero_of_from_zero {X : C} (f : 0 ⟶ X) : f = 0 :=
by ext

lemma zero_of_source_iso_zero {X Y : C} (f : X ⟶ Y) (i : X ≅ 0) : f = 0 :=
begin
  have h : f = i.hom ≫ 𝟙 0 ≫ i.inv ≫ f := by simp only [iso.hom_inv_id_assoc, id_comp, comp_id],
  simpa using h,
end

lemma zero_of_source_iso_zero' {X Y : C} (f : X ⟶ Y) (i : is_isomorphic X 0) : f = 0 :=
zero_of_source_iso_zero f (nonempty.some i)
lemma zero_of_target_iso_zero' {X Y : C} (f : X ⟶ Y) (i : is_isomorphic Y 0) : f = 0 :=
zero_of_target_iso_zero f (nonempty.some i)

lemma mono_of_source_iso_zero {X Y : C} (f : X ⟶ Y) (i : X ≅ 0) : mono f :=
⟨λ Z g h w, by rw [zero_of_target_iso_zero g i, zero_of_target_iso_zero h i]⟩

lemma epi_of_target_iso_zero {X Y : C} (f : X ⟶ Y) (i : Y ≅ 0) : epi f :=
⟨λ Z g h w, by rw [zero_of_source_iso_zero g i, zero_of_source_iso_zero h i]⟩

/--
An object `X` has `𝟙 X = 0` if and only if it is isomorphic to the zero object.

Because `X ≅ 0` contains data (even if a subsingleton), we express this `↔` as an `≃`.
-/
def id_zero_equiv_iso_zero (X : C) : (𝟙 X = 0) ≃ (X ≅ 0) :=
{ to_fun    := λ h, { hom := 0, inv := 0, },
  inv_fun   := λ i, zero_of_target_iso_zero (𝟙 X) i,
  left_inv  := by tidy,
  right_inv := by tidy, }

@[simp]
lemma id_zero_equiv_iso_zero_apply_hom (X : C) (h : 𝟙 X = 0) :
  ((id_zero_equiv_iso_zero X) h).hom = 0 := rfl

@[simp]
lemma id_zero_equiv_iso_zero_apply_inv (X : C) (h : 𝟙 X = 0) :
  ((id_zero_equiv_iso_zero X) h).inv = 0 := rfl

/-- If an object `X` is isomorphic to 0, there's no need to use choice to construct
an explicit isomorphism: the zero morphism suffices. -/
def iso_of_is_isomorphic_zero {X : C} (P : is_isomorphic X 0) : X ≅ 0 :=
{ hom := 0,
  inv := 0,
  hom_inv_id' :=
  begin
    casesI P,
    rw ←P.hom_inv_id,
    rw ←category.id_comp P.inv,
    simp,
  end,
  inv_hom_id' := by simp, }

end

section is_iso
variables [has_zero_morphisms C]

/--
A zero morphism `0 : X ⟶ Y` is an isomorphism if and only if
the identities on both `X` and `Y` are zero.
-/
@[simps]
def is_iso_zero_equiv (X Y : C) : is_iso (0 : X ⟶ Y) ≃ (𝟙 X = 0 ∧ 𝟙 Y = 0) :=
{ to_fun := by { introsI i, rw ←is_iso.hom_inv_id (0 : X ⟶ Y),
    rw ←is_iso.inv_hom_id (0 : X ⟶ Y), simp },
  inv_fun := λ h, ⟨⟨(0 : Y ⟶ X), by tidy⟩⟩,
  left_inv := by tidy,
  right_inv := by tidy, }

/--
A zero morphism `0 : X ⟶ X` is an isomorphism if and only if
the identity on `X` is zero.
-/
def is_iso_zero_self_equiv (X : C) : is_iso (0 : X ⟶ X) ≃ (𝟙 X = 0) :=
by simpa using is_iso_zero_equiv X X

variables [has_zero_object C]
local attribute [instance] has_zero_object.has_zero

/--
A zero morphism `0 : X ⟶ Y` is an isomorphism if and only if
`X` and `Y` are isomorphic to the zero object.
-/
def is_iso_zero_equiv_iso_zero (X Y : C) : is_iso (0 : X ⟶ Y) ≃ (X ≅ 0) × (Y ≅ 0) :=
begin
  -- This is lame, because `prod` can't cope with `Prop`, so we can't use `equiv.prod_congr`.
  refine (is_iso_zero_equiv X Y).trans _,
  symmetry,
  fsplit,
  { rintros ⟨eX, eY⟩, fsplit,
    exact (id_zero_equiv_iso_zero X).symm eX,
    exact (id_zero_equiv_iso_zero Y).symm eY, },
  { rintros ⟨hX, hY⟩, fsplit,
    exact (id_zero_equiv_iso_zero X) hX,
    exact (id_zero_equiv_iso_zero Y) hY, },
  { tidy, },
  { tidy, },
end

/--
A zero morphism `0 : X ⟶ X` is an isomorphism if and only if
`X` is isomorphic to the zero object.
-/
def is_iso_zero_self_equiv_iso_zero (X : C) : is_iso (0 : X ⟶ X) ≃ (X ≅ 0) :=
(is_iso_zero_equiv_iso_zero X X).trans subsingleton_prod_self_equiv

end is_iso

/-- If there are zero morphisms, any initial object is a zero object. -/
@[priority 50]
instance has_zero_object_of_has_initial_object
  [has_zero_morphisms C] [has_initial C] : has_zero_object C :=
{ zero := ⊥_ C,
  unique_to := λ X, ⟨⟨0⟩, by tidy⟩,
  unique_from := λ X, ⟨⟨0⟩, λ f,
  calc
    f = f ≫ 𝟙 _ : (category.comp_id _).symm
    ... = f ≫ 0 : by congr
    ... = 0     : has_zero_morphisms.comp_zero _ _
  ⟩ }

/-- If there are zero morphisms, any terminal object is a zero object. -/
@[priority 50]
instance has_zero_object_of_has_terminal_object
  [has_zero_morphisms C] [has_terminal C] : has_zero_object C :=
{ zero := ⊤_ C,
  unique_from := λ X, ⟨⟨0⟩, by tidy⟩,
  unique_to := λ X, ⟨⟨0⟩, λ f,
  calc
    f = 𝟙 _ ≫ f : (category.id_comp _).symm
    ... = 0 ≫ f : by congr
    ... = 0     : zero_comp
  ⟩ }

section image
variable [has_zero_morphisms C]

lemma image_ι_comp_eq_zero {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} [has_image f]
  [epi (factor_thru_image f)] (h : f ≫ g = 0) : image.ι f ≫ g = 0 :=
zero_of_epi_comp (factor_thru_image f) $ by simp [h]

variables [has_zero_object C]
local attribute [instance] has_zero_object.has_zero

/--
The zero morphism has a `mono_factorisation` through the zero object.
-/
@[simps]
def mono_factorisation_zero (X Y : C) : mono_factorisation (0 : X ⟶ Y) :=
{ I := 0, m := 0, e := 0, }

/--
The factorisation through the zero object is an image factorisation.
-/
def image_factorisation_zero (X Y : C) : image_factorisation (0 : X ⟶ Y) :=
{ F := mono_factorisation_zero X Y,
  is_image := { lift := λ F', 0 } }

instance has_image_zero {X Y : C} : has_image (0 : X ⟶ Y) :=
has_image.mk $ image_factorisation_zero _ _

/-- The image of a zero morphism is the zero object. -/
def image_zero {X Y : C} : image (0 : X ⟶ Y) ≅ 0 :=
is_image.iso_ext (image.is_image (0 : X ⟶ Y)) (image_factorisation_zero X Y).is_image

/-- The image of a morphism which is equal to zero is the zero object. -/
def image_zero' {X Y : C} {f : X ⟶ Y} (h : f = 0) [has_image f] : image f ≅ 0 :=
image.eq_to_iso h ≪≫ image_zero

@[simp]
lemma image.ι_zero {X Y : C} [has_image (0 : X ⟶ Y)] : image.ι (0 : X ⟶ Y) = 0 :=
begin
  rw ←image.lift_fac (mono_factorisation_zero X Y),
  simp,
end

/--
If we know `f = 0`,
it requires a little work to conclude `image.ι f = 0`,
because `f = g` only implies `image f ≅ image g`.
-/
@[simp]
lemma image.ι_zero' [has_equalizers C] {X Y : C} {f : X ⟶ Y} (h : f = 0) [has_image f] :
  image.ι f = 0 :=
by { rw image.eq_fac h, simp }

end image

/-- In the presence of zero morphisms, coprojections into a coproduct are (split) monomorphisms. -/
instance split_mono_sigma_ι
  {β : Type v} [decidable_eq β]
  [has_zero_morphisms C]
  (f : β → C) [has_colimit (discrete.functor f)] (b : β) : split_mono (sigma.ι f b) :=
{ retraction := sigma.desc (λ b', if h : b' = b then eq_to_hom (congr_arg f h) else 0), }

/-- In the presence of zero morphisms, projections into a product are (split) epimorphisms. -/
instance split_epi_pi_π
  {β : Type v} [decidable_eq β]
  [has_zero_morphisms C]
  (f : β → C) [has_limit (discrete.functor f)] (b : β) : split_epi (pi.π f b) :=
{ section_ := pi.lift (λ b', if h : b = b' then eq_to_hom (congr_arg f h) else 0), }

/-- In the presence of zero morphisms, coprojections into a coproduct are (split) monomorphisms. -/
instance split_mono_coprod_inl
  [has_zero_morphisms C] {X Y : C} [has_colimit (pair X Y)] :
  split_mono (coprod.inl : X ⟶ X ⨿ Y) :=
{ retraction := coprod.desc (𝟙 X) 0, }
/-- In the presence of zero morphisms, coprojections into a coproduct are (split) monomorphisms. -/
instance split_mono_coprod_inr
  [has_zero_morphisms C] {X Y : C} [has_colimit (pair X Y)] :
  split_mono (coprod.inr : Y ⟶ X ⨿ Y) :=
{ retraction := coprod.desc 0 (𝟙 Y), }

/-- In the presence of zero morphisms, projections into a product are (split) epimorphisms. -/
instance split_epi_prod_fst
  [has_zero_morphisms C] {X Y : C} [has_limit (pair X Y)] :
  split_epi (prod.fst : X ⨯ Y ⟶ X) :=
{ section_ := prod.lift (𝟙 X) 0, }
/-- In the presence of zero morphisms, projections into a product are (split) epimorphisms. -/
instance split_epi_prod_snd
  [has_zero_morphisms C] {X Y : C} [has_limit (pair X Y)] :
  split_epi (prod.snd : X ⨯ Y ⟶ Y) :=
{ section_ := prod.lift 0 (𝟙 Y), }

end category_theory.limits


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Johan Commelin, Bhavik Mehta
-/
import category_theory.equivalence

/-!
# Adjunctions between functors

`F ⊣ G` represents the data of an adjunction between two functors
`F : C ⥤ D` and `G : D ⥤ C`. `F` is the left adjoint and `G` is the right adjoint.

We provide various useful constructors:
* `mk_of_hom_equiv`
* `mk_of_unit_counit`
* `left_adjoint_of_equiv` / `right_adjoint_of equiv`
  construct a left/right adjoint of a given functor given the action on objects and
  the relevant equivalence of morphism spaces.
* `adjunction_of_equiv_left` / `adjunction_of_equiv_right` witness that these constructions
  give adjunctions.

There are also typeclasses `is_left_adjoint` / `is_right_adjoint`, carrying data witnessing
that a given functor is a left or right adjoint.
Given `[is_left_adjoint F]`, a right adjoint of `F` can be constructed as `right_adjoint F`.

`adjunction.comp` composes adjunctions.

`to_equivalence` upgrades an adjunction to an equivalence,
given witnesses that the unit and counit are pointwise isomorphisms.
Conversely `equivalence.to_adjunction` recovers the underlying adjunction from an equivalence.
-/

namespace category_theory
open category

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes v₁ v₂ v₃ u₁ u₂ u₃

local attribute [elab_simple] whisker_left whisker_right

variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D]

/--
`F ⊣ G` represents the data of an adjunction between two functors
`F : C ⥤ D` and `G : D ⥤ C`. `F` is the left adjoint and `G` is the right adjoint.

To construct an `adjunction` between two functors, it's often easier to instead use the
constructors `mk_of_hom_equiv` or `mk_of_unit_counit`. To construct a left adjoint,
there are also constructors `left_adjoint_of_equiv` and `adjunction_of_equiv_left` (as
well as their duals) which can be simpler in practice.

Uniqueness of adjoints is shown in `category_theory.adjunction.opposites`.

See https://stacks.math.columbia.edu/tag/0037.
-/
structure adjunction (F : C ⥤ D) (G : D ⥤ C) :=
(hom_equiv : Π (X Y), (F.obj X ⟶ Y) ≃ (X ⟶ G.obj Y))
(unit : 𝟭 C ⟶ F.comp G)
(counit : G.comp F ⟶ 𝟭 D)
(hom_equiv_unit' : Π {X Y f}, (hom_equiv X Y) f = (unit : _ ⟶ _).app X ≫ G.map f . obviously)
(hom_equiv_counit' : Π {X Y g}, (hom_equiv X Y).symm g = F.map g ≫ counit.app Y . obviously)

infix ` ⊣ `:15 := adjunction

/-- A class giving a chosen right adjoint to the functor `left`. -/
class is_left_adjoint (left : C ⥤ D) :=
(right : D ⥤ C)
(adj : left ⊣ right)

/-- A class giving a chosen left adjoint to the functor `right`. -/
class is_right_adjoint (right : D ⥤ C) :=
(left : C ⥤ D)
(adj : left ⊣ right)

/-- Extract the left adjoint from the instance giving the chosen adjoint. -/
def left_adjoint (R : D ⥤ C) [is_right_adjoint R] : C ⥤ D :=
is_right_adjoint.left R
/-- Extract the right adjoint from the instance giving the chosen adjoint. -/
def right_adjoint (L : C ⥤ D) [is_left_adjoint L] : D ⥤ C :=
is_left_adjoint.right L

/-- The adjunction associated to a functor known to be a left adjoint. -/
def adjunction.of_left_adjoint (left : C ⥤ D) [is_left_adjoint left] :
  adjunction left (right_adjoint left) :=
is_left_adjoint.adj
/-- The adjunction associated to a functor known to be a right adjoint. -/
def adjunction.of_right_adjoint (right : C ⥤ D) [is_right_adjoint right] :
  adjunction (left_adjoint right) right :=
is_right_adjoint.adj

namespace adjunction

restate_axiom hom_equiv_unit'
restate_axiom hom_equiv_counit'
attribute [simp, priority 10] hom_equiv_unit hom_equiv_counit

section

variables {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {X' X : C} {Y Y' : D}

@[simp, priority 10] lemma hom_equiv_naturality_left_symm (f : X' ⟶ X) (g : X ⟶ G.obj Y) :
  (adj.hom_equiv X' Y).symm (f ≫ g) = F.map f ≫ (adj.hom_equiv X Y).symm g :=
by rw [hom_equiv_counit, F.map_comp, assoc, adj.hom_equiv_counit.symm]

@[simp] lemma hom_equiv_naturality_left (f : X' ⟶ X) (g : F.obj X ⟶ Y) :
  (adj.hom_equiv X' Y) (F.map f ≫ g) = f ≫ (adj.hom_equiv X Y) g :=
by rw [← equiv.eq_symm_apply]; simp [-hom_equiv_unit]

@[simp, priority 10] lemma hom_equiv_naturality_right (f : F.obj X ⟶ Y) (g : Y ⟶ Y') :
  (adj.hom_equiv X Y') (f ≫ g) = (adj.hom_equiv X Y) f ≫ G.map g :=
by rw [hom_equiv_unit, G.map_comp, ← assoc, ←hom_equiv_unit]

@[simp] lemma hom_equiv_naturality_right_symm (f : X ⟶ G.obj Y) (g : Y ⟶ Y') :
  (adj.hom_equiv X Y').symm (f ≫ G.map g) = (adj.hom_equiv X Y).symm f ≫ g :=
by rw [equiv.symm_apply_eq]; simp [-hom_equiv_counit]

@[simp] lemma left_triangle :
  (whisker_right adj.unit F) ≫ (whisker_left F adj.counit) = nat_trans.id _ :=
begin
  ext, dsimp,
  erw [← adj.hom_equiv_counit, equiv.symm_apply_eq, adj.hom_equiv_unit],
  simp
end

@[simp]

@[simp, reassoc] lemma left_triangle_components :
  F.map (adj.unit.app X) ≫ adj.counit.app (F.obj X) = 𝟙 (F.obj X) :=
congr_arg (λ (t : nat_trans _ (𝟭 C ⋙ F)), t.app X) adj.left_triangle

@[simp, reassoc] lemma right_triangle_components {Y : D} :
  adj.unit.app (G.obj Y) ≫ G.map (adj.counit.app Y) = 𝟙 (G.obj Y) :=
congr_arg (λ (t : nat_trans _ (G ⋙ 𝟭 C)), t.app Y) adj.right_triangle

@[simp, reassoc] lemma counit_naturality {X Y : D} (f : X ⟶ Y) :
  F.map (G.map f) ≫ (adj.counit).app Y = (adj.counit).app X ≫ f :=
adj.counit.naturality f

@[simp, reassoc] lemma unit_naturality {X Y : C} (f : X ⟶ Y) :
  (adj.unit).app X ≫ G.map (F.map f) = f ≫ (adj.unit).app Y :=
(adj.unit.naturality f).symm

lemma hom_equiv_apply_eq {A : C} {B : D} (f : F.obj A ⟶ B) (g : A ⟶ G.obj B) :
  adj.hom_equiv A B f = g ↔ f = (adj.hom_equiv A B).symm g :=
⟨λ h, by {cases h, simp}, λ h, by {cases h, simp}⟩

lemma eq_hom_equiv_apply {A : C} {B : D} (f : F.obj A ⟶ B) (g : A ⟶ G.obj B) :
  g = adj.hom_equiv A B f ↔ (adj.hom_equiv A B).symm g = f :=
⟨λ h, by {cases h, simp}, λ h, by {cases h, simp}⟩

end

end adjunction

namespace adjunction

/--
This is an auxiliary data structure useful for constructing adjunctions.
See `adjunction.mk_of_hom_equiv`.
This structure won't typically be used anywhere else.
-/
@[nolint has_inhabited_instance]
structure core_hom_equiv (F : C ⥤ D) (G : D ⥤ C) :=
(hom_equiv : Π (X Y), (F.obj X ⟶ Y) ≃ (X ⟶ G.obj Y))
(hom_equiv_naturality_left_symm' : Π {X' X Y} (f : X' ⟶ X) (g : X ⟶ G.obj Y),
  (hom_equiv X' Y).symm (f ≫ g) = F.map f ≫ (hom_equiv X Y).symm g . obviously)
(hom_equiv_naturality_right' : Π {X Y Y'} (f : F.obj X ⟶ Y) (g : Y ⟶ Y'),
  (hom_equiv X Y') (f ≫ g) = (hom_equiv X Y) f ≫ G.map g . obviously)

namespace core_hom_equiv

restate_axiom hom_equiv_naturality_left_symm'
restate_axiom hom_equiv_naturality_right'
attribute [simp, priority 10] hom_equiv_naturality_left_symm hom_equiv_naturality_right

variables {F : C ⥤ D} {G : D ⥤ C} (adj : core_hom_equiv F G) {X' X : C} {Y Y' : D}

@[simp] lemma hom_equiv_naturality_left (f : X' ⟶ X) (g : F.obj X ⟶ Y) :
  (adj.hom_equiv X' Y) (F.map f ≫ g) = f ≫ (adj.hom_equiv X Y) g :=
by rw [← equiv.eq_symm_apply]; simp

@[simp] lemma hom_equiv_naturality_right_symm (f : X ⟶ G.obj Y) (g : Y ⟶ Y') :
  (adj.hom_equiv X Y').symm (f ≫ G.map g) = (adj.hom_equiv X Y).symm f ≫ g :=
by rw [equiv.symm_apply_eq]; simp

end core_hom_equiv

/--
This is an auxiliary data structure useful for constructing adjunctions.
See `adjunction.mk_of_unit_counit`.
This structure won't typically be used anywhere else.
-/
@[nolint has_inhabited_instance]
structure core_unit_counit (F : C ⥤ D) (G : D ⥤ C) :=
(unit : 𝟭 C ⟶ F.comp G)
(counit : G.comp F ⟶ 𝟭 D)
(left_triangle' : whisker_right unit F ≫ (functor.associator F G F).hom ≫ whisker_left F counit =
  nat_trans.id (𝟭 C ⋙ F) . obviously)
(right_triangle' : whisker_left G unit ≫ (functor.associator G F G).inv ≫ whisker_right counit G =
  nat_trans.id (G ⋙ 𝟭 C) . obviously)

namespace core_unit_counit

restate_axiom left_triangle'
restate_axiom right_triangle'
attribute [simp] left_triangle right_triangle

end core_unit_counit

variables {F : C ⥤ D} {G : D ⥤ C}

/-- Construct an adjunction between `F` and `G` out of a natural bijection between each
`F.obj X ⟶ Y` and `X ⟶ G.obj Y`. -/
@[simps]
def mk_of_hom_equiv (adj : core_hom_equiv F G) : F ⊣ G :=
{ unit :=
  { app := λ X, (adj.hom_equiv X (F.obj X)) (𝟙 (F.obj X)),
    naturality' :=
    begin
      intros,
      erw [← adj.hom_equiv_naturality_left, ← adj.hom_equiv_naturality_right],
      dsimp, simp -- See note [dsimp, simp].
    end },
  counit :=
  { app := λ Y, (adj.hom_equiv _ _).inv_fun (𝟙 (G.obj Y)),
    naturality' :=
    begin
      intros,
      erw [← adj.hom_equiv_naturality_left_symm, ← adj.hom_equiv_naturality_right_symm],
      dsimp, simp
    end },
  hom_equiv_unit' := λ X Y f, by erw [← adj.hom_equiv_naturality_right]; simp,
  hom_equiv_counit' := λ X Y f, by erw [← adj.hom_equiv_naturality_left_symm]; simp,
  .. adj }

/-- Construct an adjunction between functors `F` and `G` given a unit and counit for the adjunction
satisfying the triangle identities. -/
@[simps]
def mk_of_unit_counit (adj : core_unit_counit F G) : F ⊣ G :=
{ hom_equiv := λ X Y,
  { to_fun := λ f, adj.unit.app X ≫ G.map f,
    inv_fun := λ g, F.map g ≫ adj.counit.app Y,
    left_inv := λ f, begin
      change F.map (_ ≫ _) ≫ _ = _,
      rw [F.map_comp, assoc, ←functor.comp_map, adj.counit.naturality, ←assoc],
      convert id_comp f,
      have t := congr_arg (λ t : nat_trans _ _, t.app _) adj.left_triangle,
      dsimp at t,
      simp only [id_comp] at t,
      exact t,
    end,
    right_inv := λ g, begin
      change _ ≫ G.map (_ ≫ _) = _,
      rw [G.map_comp, ←assoc, ←functor.comp_map, ←adj.unit.naturality, assoc],
      convert comp_id g,
      have t := congr_arg (λ t : nat_trans _ _, t.app _) adj.right_triangle,
      dsimp at t,
      simp only [id_comp] at t,
      exact t,
  end },
  .. adj }

/-- The adjunction between the identity functor on a category and itself. -/
def id : 𝟭 C ⊣ 𝟭 C :=
{ hom_equiv := λ X Y, equiv.refl _,
  unit := 𝟙 _,
  counit := 𝟙 _ }

-- Satisfy the inhabited linter.
instance : inhabited (adjunction (𝟭 C) (𝟭 C)) := ⟨id⟩

/-- If F and G are naturally isomorphic functors, establish an equivalence of hom-sets. -/
@[simps]
def equiv_homset_left_of_nat_iso
  {F F' : C ⥤ D} (iso : F ≅ F') {X : C} {Y : D} :
  (F.obj X ⟶ Y) ≃ (F'.obj X ⟶ Y) :=
{ to_fun := λ f, iso.inv.app _ ≫ f,
  inv_fun := λ g, iso.hom.app _ ≫ g,
  left_inv := λ f, by simp,
  right_inv := λ g, by simp }

/-- If G and H are naturally isomorphic functors, establish an equivalence of hom-sets. -/
@[simps]
def equiv_homset_right_of_nat_iso
  {G G' : D ⥤ C} (iso : G ≅ G') {X : C} {Y : D} :
  (X ⟶ G.obj Y) ≃ (X ⟶ G'.obj Y) :=
{ to_fun := λ f, f ≫ iso.hom.app _,
  inv_fun := λ g, g ≫ iso.inv.app _,
  left_inv := λ f, by simp,
  right_inv := λ g, by simp }

/-- Transport an adjunction along an natural isomorphism on the left. -/
def of_nat_iso_left
  {F G : C ⥤ D} {H : D ⥤ C} (adj : F ⊣ H) (iso : F ≅ G) :
  G ⊣ H :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X Y, (equiv_homset_left_of_nat_iso iso.symm).trans (adj.hom_equiv X Y) }

/-- Transport an adjunction along an natural isomorphism on the right. -/
def of_nat_iso_right
  {F : C ⥤ D} {G H : D ⥤ C} (adj : F ⊣ G) (iso : G ≅ H) :
  F ⊣ H :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X Y, (adj.hom_equiv X Y).trans (equiv_homset_right_of_nat_iso iso) }

/-- Transport being a right adjoint along a natural isomorphism. -/
def right_adjoint_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [r : is_right_adjoint F] :
  is_right_adjoint G :=
{ left := r.left,
  adj := of_nat_iso_right r.adj h }

/-- Transport being a left adjoint along a natural isomorphism. -/
def left_adjoint_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [r : is_left_adjoint F] : is_left_adjoint G :=
{ right := r.right,
  adj := of_nat_iso_left r.adj h }

section
variables {E : Type u₃} [ℰ : category.{v₃} E] (H : D ⥤ E) (I : E ⥤ D)

/--
Composition of adjunctions.

See https://stacks.math.columbia.edu/tag/0DV0.
-/
def comp (adj₁ : F ⊣ G) (adj₂ : H ⊣ I) : F ⋙ H ⊣ I ⋙ G :=
{ hom_equiv := λ X Z, equiv.trans (adj₂.hom_equiv _ _) (adj₁.hom_equiv _ _),
  unit := adj₁.unit ≫
  (whisker_left F $ whisker_right adj₂.unit G) ≫ (functor.associator _ _ _).inv,
  counit := (functor.associator _ _ _).hom ≫
    (whisker_left I $ whisker_right adj₁.counit H) ≫ adj₂.counit }

/-- If `F` and `G` are left adjoints then `F ⋙ G` is a left adjoint too. -/
instance left_adjoint_of_comp {E : Type u₃} [ℰ : category.{v₃} E] (F : C ⥤ D) (G : D ⥤ E)
  [Fl : is_left_adjoint F] [Gl : is_left_adjoint G] : is_left_adjoint (F ⋙ G) :=
{ right := Gl.right ⋙ Fl.right,
  adj := comp _ _ Fl.adj Gl.adj }

/-- If `F` and `G` are right adjoints then `F ⋙ G` is a right adjoint too. -/
instance right_adjoint_of_comp {E : Type u₃} [ℰ : category.{v₃} E] {F : C ⥤ D} {G : D ⥤ E}
  [Fr : is_right_adjoint F] [Gr : is_right_adjoint G] : is_right_adjoint (F ⋙ G) :=
{ left := Gr.left ⋙ Fr.left,
  adj := comp _ _ Gr.adj Fr.adj }

end

section construct_left
-- Construction of a left adjoint. In order to construct a left
-- adjoint to a functor G : D → C, it suffices to give the object part
-- of a functor F : C → D together with isomorphisms Hom(FX, Y) ≃
-- Hom(X, GY) natural in Y. The action of F on morphisms can be
-- constructed from this data.
variables {F_obj : C → D} {G}
variables (e : Π X Y, (F_obj X ⟶ Y) ≃ (X ⟶ G.obj Y))
variables (he : ∀ X Y Y' g h, e X Y' (h ≫ g) = e X Y h ≫ G.map g)
include he

private lemma he' {X Y Y'} (f g) : (e X Y').symm (f ≫ G.map g) = (e X Y).symm f ≫ g :=
by intros; rw [equiv.symm_apply_eq, he]; simp

/-- Construct a left adjoint functor to `G`, given the functor's value on objects `F_obj` and
a bijection `e` between `F_obj X ⟶ Y` and `X ⟶ G.obj Y` satisfying a naturality law
`he : ∀ X Y Y' g h, e X Y' (h ≫ g) = e X Y h ≫ G.map g`.
Dual to `right_adjoint_of_equiv`. -/
@[simps]
def left_adjoint_of_equiv : C ⥤ D :=
{ obj := F_obj,
  map := λ X X' f, (e X (F_obj X')).symm (f ≫ e X' (F_obj X') (𝟙 _)),
  map_comp' := λ X X' X'' f f', begin
    rw [equiv.symm_apply_eq, he, equiv.apply_symm_apply],
    conv { to_rhs, rw [assoc, ←he, id_comp, equiv.apply_symm_apply] },
    simp
  end }

/-- Show that the functor given by `left_adjoint_of_equiv` is indeed left adjoint to `G`. Dual
to `adjunction_of_equiv_right`. -/
@[simps]
def adjunction_of_equiv_left : left_adjoint_of_equiv e he ⊣ G :=
mk_of_hom_equiv
{ hom_equiv := e,
  hom_equiv_naturality_left_symm' :=
  begin
    intros,
    erw [← he' e he, ← equiv.apply_eq_iff_eq],
    simp [(he _ _ _ _ _).symm]
  end }

end construct_left

section construct_right
-- Construction of a right adjoint, analogous to the above.
variables {F} {G_obj : D → C}
variables (e : Π X Y, (F.obj X ⟶ Y) ≃ (X ⟶ G_obj Y))
variables (he : ∀ X' X Y f g, e X' Y (F.map f ≫ g) = f ≫ e X Y g)
include he

private lemma he' {X' X Y} (f g) : F.map f ≫ (e X Y).symm g = (e X' Y).symm (f ≫ g) :=
by intros; rw [equiv.eq_symm_apply, he]; simp

/-- Construct a right adjoint functor to `F`, given the functor's value on objects `G_obj` and
a bijection `e` between `F.obj X ⟶ Y` and `X ⟶ G_obj Y` satisfying a naturality law
`he : ∀ X Y Y' g h, e X' Y (F.map f ≫ g) = f ≫ e X Y g`.
Dual to `left_adjoint_of_equiv`. -/
@[simps]
def right_adjoint_of_equiv : D ⥤ C :=
{ obj := G_obj,
  map := λ Y Y' g, (e (G_obj Y) Y') ((e (G_obj Y) Y).symm (𝟙 _) ≫ g),
  map_comp' := λ Y Y' Y'' g g', begin
    rw [← equiv.eq_symm_apply, ← he' e he, equiv.symm_apply_apply],
    conv { to_rhs, rw [← assoc, he' e he, comp_id, equiv.symm_apply_apply] },
    simp
  end }

/-- Show that the functor given by `right_adjoint_of_equiv` is indeed right adjoint to `F`. Dual
to `adjunction_of_equiv_left`. -/
@[simps]
def adjunction_of_equiv_right : F ⊣ right_adjoint_of_equiv e he :=
mk_of_hom_equiv
{ hom_equiv := e,
  hom_equiv_naturality_left_symm' := by intros; rw [equiv.symm_apply_eq, he]; simp,
  hom_equiv_naturality_right' :=
  begin
    intros X Y Y' g h,
    erw [←he, equiv.apply_eq_iff_eq, ←assoc, he' e he, comp_id, equiv.symm_apply_apply]
  end }

end construct_right

/--
If the unit and counit of a given adjunction are (pointwise) isomorphisms, then we can upgrade the
adjunction to an equivalence.
-/
@[simps]
noncomputable
def to_equivalence (adj : F ⊣ G) [∀ X, is_iso (adj.unit.app X)] [∀ Y, is_iso (adj.counit.app Y)] :
  C ≌ D :=
{ functor := F,
  inverse := G,
  unit_iso := nat_iso.of_components (λ X, as_iso (adj.unit.app X)) (by simp),
  counit_iso := nat_iso.of_components (λ Y, as_iso (adj.counit.app Y)) (by simp) }

/--
If the unit and counit for the adjunction corresponding to a right adjoint functor are (pointwise)
isomorphisms, then the functor is an equivalence of categories.
-/
@[simps]
noncomputable
def is_right_adjoint_to_is_equivalence [is_right_adjoint G]
  [∀ X, is_iso ((adjunction.of_right_adjoint G).unit.app X)]
  [∀ Y, is_iso ((adjunction.of_right_adjoint G).counit.app Y)] :
  is_equivalence G :=
is_equivalence.of_equivalence_inverse (adjunction.of_right_adjoint G).to_equivalence

end adjunction

open adjunction

namespace equivalence

/-- The adjunction given by an equivalence of categories. (To obtain the opposite adjunction,
simply use `e.symm.to_adjunction`. -/
def to_adjunction (e : C ≌ D) : e.functor ⊣ e.inverse :=
mk_of_unit_counit ⟨e.unit, e.counit,
  by { ext, dsimp, simp only [id_comp], exact e.functor_unit_comp _, },
  by { ext, dsimp, simp only [id_comp], exact e.unit_inverse_comp _, }⟩

end equivalence

namespace functor

/-- An equivalence `E` is left adjoint to its inverse. -/
def adjunction (E : C ⥤ D) [is_equivalence E] : E ⊣ E.inv :=
(E.as_equivalence).to_adjunction

/-- If `F` is an equivalence, it's a left adjoint. -/
@[priority 10]
instance left_adjoint_of_equivalence {F : C ⥤ D} [is_equivalence F] : is_left_adjoint F :=
{ right := _,
  adj := functor.adjunction F }

@[simp]
lemma right_adjoint_of_is_equivalence {F : C ⥤ D} [is_equivalence F] : right_adjoint F = inv F :=
rfl

/-- If `F` is an equivalence, it's a right adjoint. -/
@[priority 10]
instance right_adjoint_of_equivalence {F : C ⥤ D} [is_equivalence F] : is_right_adjoint F :=
{ left := _,
  adj := functor.adjunction F.inv }

@[simp]
lemma left_adjoint_of_is_equivalence {F : C ⥤ D} [is_equivalence F] : left_adjoint F = inv F :=
rfl

end functor

end category_theory


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

/-!
# Factoring through subobjects

The predicate `h : P.factors f`, for `P : subobject Y` and `f : X ⟶ Y`
asserts the existence of some `P.factor_thru f : X ⟶ (P : C)` making the obvious diagram commute.

-/

universes v₁ v₂ u₁ u₂

noncomputable theory

open category_theory category_theory.category category_theory.limits

variables {C : Type u₁} [category.{v₁} C] {X Y Z : C}
variables {D : Type u₂} [category.{v₂} D]

namespace category_theory

namespace mono_over

/-- When `f : X ⟶ Y` and `P : mono_over Y`,
`P.factors f` expresses that there exists a factorisation of `f` through `P`.
Given `h : P.factors f`, you can recover the morphism as `P.factor_thru f h`.
-/
def factors {X Y : C} (P : mono_over Y) (f : X ⟶ Y) : Prop := ∃ g : X ⟶ (P : C), g ≫ P.arrow = f

lemma factors_congr {X : C} {f g : mono_over X} {Y : C} (h : Y ⟶ X) (e : f ≅ g) :
  f.factors h ↔ g.factors h :=
⟨λ ⟨u, hu⟩, ⟨u ≫ (((mono_over.forget _).map e.hom)).left, by simp [hu]⟩,
 λ ⟨u, hu⟩, ⟨u ≫ (((mono_over.forget _).map e.inv)).left, by simp [hu]⟩⟩

/-- `P.factor_thru f h` provides a factorisation of `f : X ⟶ Y` through some `P : mono_over Y`,
given the evidence `h : P.factors f` that such a factorisation exists. -/
def factor_thru {X Y : C} (P : mono_over Y) (f : X ⟶ Y) (h : factors P f) : X ⟶ (P : C) :=
classical.some h

end mono_over

namespace subobject

/-- When `f : X ⟶ Y` and `P : subobject Y`,
`P.factors f` expresses that there exists a factorisation of `f` through `P`.
Given `h : P.factors f`, you can recover the morphism as `P.factor_thru f h`.
-/
def factors {X Y : C} (P : subobject Y) (f : X ⟶ Y) : Prop :=
quotient.lift_on' P (λ P, P.factors f)
begin
  rintros P Q ⟨h⟩,
  apply propext,
  split,
  { rintro ⟨i, w⟩,
    exact ⟨i ≫ h.hom.left, by erw [category.assoc, over.w h.hom, w]⟩, },
  { rintro ⟨i, w⟩,
    exact ⟨i ≫ h.inv.left, by erw [category.assoc, over.w h.inv, w]⟩, },
end

@[simp]

lemma factors_iff {X Y : C} (P : subobject Y) (f : X ⟶ Y) :
  P.factors f ↔ (representative.obj P).factors f :=
quot.induction_on P $ λ a, mono_over.factors_congr _ (representative_iso _).symm

lemma factors_self {X : C} (P : subobject X) : P.factors P.arrow :=
(factors_iff _ _).mpr ⟨𝟙 P, (by simp)⟩

lemma factors_comp_arrow {X Y : C} {P : subobject Y} (f : X ⟶ P) : P.factors (f ≫ P.arrow) :=
(factors_iff _ _).mpr ⟨f, rfl⟩

lemma factors_of_factors_right {X Y Z : C} {P : subobject Z} (f : X ⟶ Y) {g : Y ⟶ Z}
  (h : P.factors g) : P.factors (f ≫ g) :=
begin
  revert P,
  refine quotient.ind' _,
  intro P,
  rintro ⟨g, rfl⟩,
  exact ⟨f ≫ g, by simp⟩,
end

lemma factors_zero [has_zero_morphisms C] {X Y : C} {P : subobject Y} :
  P.factors (0 : X ⟶ Y) :=
(factors_iff _ _).mpr ⟨0, by simp⟩

lemma factors_of_le {Y Z : C} {P Q : subobject Y} (f : Z ⟶ Y) (h : P ≤ Q) :
  P.factors f → Q.factors f :=
by { simp only [factors_iff], exact λ ⟨u, hu⟩, ⟨u ≫ of_le _ _ h, by simp [←hu]⟩ }

/-- `P.factor_thru f h` provides a factorisation of `f : X ⟶ Y` through some `P : subobject Y`,
given the evidence `h : P.factors f` that such a factorisation exists. -/
def factor_thru {X Y : C} (P : subobject Y) (f : X ⟶ Y) (h : factors P f) : X ⟶ P :=
classical.some ((factors_iff _ _).mp h)

@[simp, reassoc] lemma factor_thru_arrow {X Y : C} (P : subobject Y) (f : X ⟶ Y) (h : factors P f) :
  P.factor_thru f h ≫ P.arrow = f :=
classical.some_spec ((factors_iff _ _).mp h)

@[simp] lemma factor_thru_self {X : C} (P : subobject X) (h) :
  P.factor_thru P.arrow h = 𝟙 P :=
by { ext, simp, }

@[simp] lemma factor_thru_comp_arrow {X Y : C} {P : subobject Y} (f : X ⟶ P) (h) :
  P.factor_thru (f ≫ P.arrow) h = f :=
by { ext, simp, }

@[simp] lemma factor_thru_eq_zero [has_zero_morphisms C]
  {X Y : C} {P : subobject Y} {f : X ⟶ Y} {h : factors P f} :
  P.factor_thru f h = 0 ↔ f = 0 :=
begin
  fsplit,
  { intro w,
    replace w := w =≫ P.arrow,
    simpa using w, },
  { rintro rfl,
    ext, simp, },
end

lemma factor_thru_right {X Y Z : C} {P : subobject Z} (f : X ⟶ Y) (g : Y ⟶ Z) (h : P.factors g) :
  f ≫ P.factor_thru g h = P.factor_thru (f ≫ g) (factors_of_factors_right f h) :=
begin
  apply (cancel_mono P.arrow).mp,
  simp,
end

@[simp]
lemma factor_thru_zero
  [has_zero_morphisms C] {X Y : C} {P : subobject Y} (h : P.factors (0 : X ⟶ Y)) :
  P.factor_thru 0 h = 0 :=
by simp

-- `h` is an explicit argument here so we can use
-- `rw factor_thru_le h`, obtaining a subgoal `P.factors f`.
-- (While the reverse direction looks plausible as a simp lemma, it seems to be unproductive.)
lemma factor_thru_of_le
  {Y Z : C} {P Q : subobject Y} {f : Z ⟶ Y} (h : P ≤ Q) (w : P.factors f) :
  Q.factor_thru f (factors_of_le f h w) = P.factor_thru f w ≫ of_le P Q h :=
by { ext, simp, }

section preadditive

variables [preadditive C]

lemma factors_add {X Y : C} {P : subobject Y} (f g : X ⟶ Y) (wf : P.factors f) (wg : P.factors g) :
  P.factors (f + g) :=
(factors_iff _ _).mpr ⟨P.factor_thru f wf + P.factor_thru g wg, by simp⟩

-- This can't be a `simp` lemma as `wf` and `wg` may not exist.
-- However you can `rw` by it to assert that `f` and `g` factor through `P` separately.
lemma factor_thru_add {X Y : C} {P : subobject Y} (f g : X ⟶ Y)
   (w : P.factors (f + g)) (wf : P.factors f) (wg : P.factors g) :
  P.factor_thru (f + g) w = P.factor_thru f wf + P.factor_thru g wg :=
by { ext, simp, }

lemma factors_left_of_factors_add {X Y : C} {P : subobject Y} (f g : X ⟶ Y)
  (w : P.factors (f + g)) (wg : P.factors g) : P.factors f :=
(factors_iff _ _).mpr ⟨P.factor_thru (f + g) w - P.factor_thru g wg, by simp⟩

@[simp]
lemma factor_thru_add_sub_factor_thru_right {X Y : C} {P : subobject Y} (f g : X ⟶ Y)
  (w : P.factors (f + g)) (wg : P.factors g) :
  P.factor_thru (f + g) w - P.factor_thru g wg =
    P.factor_thru f (factors_left_of_factors_add f g w wg) :=
by { ext, simp, }

lemma factors_right_of_factors_add {X Y : C} {P : subobject Y} (f g : X ⟶ Y)
  (w : P.factors (f + g)) (wf : P.factors f) : P.factors g :=
(factors_iff _ _).mpr ⟨P.factor_thru (f + g) w - P.factor_thru f wf, by simp⟩

@[simp]
lemma factor_thru_add_sub_factor_thru_left {X Y : C} {P : subobject Y} (f g : X ⟶ Y)
  (w : P.factors (f + g)) (wf : P.factors f) :
  P.factor_thru (f + g) w - P.factor_thru f wf =
    P.factor_thru g (factors_right_of_factors_add f g w wf) :=
by { ext, simp, }

end preadditive

end subobject

end category_theory