/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.category.Module.basic
import Mathlib.algebra.category.Group.limits
import Mathlib.algebra.direct_limit
import Mathlib.PostPort

universes u v u_1

namespace Mathlib

/-!
# The category of R-modules has all limits

Further, these limits are preserved by the forgetful functor --- that is,
the underlying types are just the limits in the category of types.
-/

namespace Module

protected instance add_comm_group_obj {R : Type u} [ring R] {J : Type v}
    [category_theory.small_category J] (F : J ⥤ Module R) (j : J) :
    add_comm_group (category_theory.functor.obj (F ⋙ category_theory.forget (Module R)) j) :=
  id (is_add_comm_group (category_theory.functor.obj F j))

protected instance module_obj {R : Type u} [ring R] {J : Type v} [category_theory.small_category J]
    (F : J ⥤ Module R) (j : J) :
    module R (category_theory.functor.obj (F ⋙ category_theory.forget (Module R)) j) :=
  id (is_module (category_theory.functor.obj F j))

/--
The flat sections of a functor into `Module R` form a submodule of all sections.
-/
def sections_submodule {R : Type u} [ring R] {J : Type v} [category_theory.small_category J]
    (F : J ⥤ Module R) : submodule R ((j : J) → ↥(category_theory.functor.obj F j)) :=
  submodule.mk (category_theory.functor.sections (F ⋙ category_theory.forget (Module R))) sorry
    sorry sorry

protected instance limit_add_comm_group {R : Type u} [ring R] {J : Type v}
    [category_theory.small_category J] (F : J ⥤ Module R) :
    add_comm_group
        (category_theory.limits.cone.X
          (category_theory.limits.types.limit_cone (F ⋙ category_theory.forget (Module R)))) :=
  id (submodule.add_comm_group (sections_submodule F))

protected instance limit_module {R : Type u} [ring R] {J : Type v}
    [category_theory.small_category J] (F : J ⥤ Module R) :
    module R
        (category_theory.limits.cone.X
          (category_theory.limits.types.limit_cone (F ⋙ category_theory.forget (Module R)))) :=
  id (submodule.semimodule (sections_submodule F))

/-- `limit.π (F ⋙ forget Ring) j` as a `ring_hom`. -/
def limit_π_linear_map {R : Type u} [ring R] {J : Type v} [category_theory.small_category J]
    (F : J ⥤ Module R) (j : J) :
    linear_map R
        (category_theory.limits.cone.X
          (category_theory.limits.types.limit_cone (F ⋙ category_theory.forget (Module R))))
        (category_theory.functor.obj (F ⋙ category_theory.forget (Module R)) j) :=
  linear_map.mk
    (category_theory.nat_trans.app
      (category_theory.limits.cone.π
        (category_theory.limits.types.limit_cone (F ⋙ category_theory.forget (Module R))))
      j)
    sorry sorry

namespace has_limits

-- The next two definitions are used in the construction of `has_limits (Module R)`.

-- After that, the limits should be constructed using the generic limits API,

-- e.g. `limit F`, `limit.cone F`, and `limit.is_limit F`.

/--
Construction of a limit cone in `Module R`.
(Internal use only; use the limits API.)
-/
def limit_cone {R : Type u} [ring R] {J : Type v} [category_theory.small_category J]
    (F : J ⥤ Module R) : category_theory.limits.cone F :=
  category_theory.limits.cone.mk
    (of R
      (category_theory.limits.cone.X
        (category_theory.limits.types.limit_cone (F ⋙ category_theory.forget (Module R)))))
    (category_theory.nat_trans.mk (limit_π_linear_map F))

/--
Witness that the limit cone in `Module R` is a limit cone.
(Internal use only; use the limits API.)
-/
def limit_cone_is_limit {R : Type u} [ring R] {J : Type v} [category_theory.small_category J]
    (F : J ⥤ Module R) : category_theory.limits.is_limit (limit_cone F) :=
  category_theory.limits.is_limit.of_faithful (category_theory.forget (Module R))
    (category_theory.limits.types.limit_cone_is_limit (F ⋙ category_theory.forget (Module R)))
    (fun (s : category_theory.limits.cone F) =>
      linear_map.mk
        (fun
          (v :
          category_theory.limits.cone.X
            (category_theory.functor.map_cone (category_theory.forget (Module R)) s)) =>
          { val :=
              fun (j : J) =>
                category_theory.nat_trans.app
                  (category_theory.limits.cone.π
                    (category_theory.functor.map_cone (category_theory.forget (Module R)) s))
                  j v,
            property := sorry })
        sorry sorry)
    sorry

end has_limits

/-- The category of R-modules has all limits. -/
protected instance has_limits {R : Type u} [ring R] :
    category_theory.limits.has_limits (Module R) :=
  category_theory.limits.has_limits.mk
    fun (J : Type v) (𝒥 : category_theory.small_category J) =>
      category_theory.limits.has_limits_of_shape.mk
        fun (F : J ⥤ Module R) =>
          category_theory.limits.has_limit.mk (category_theory.limits.limit_cone.mk sorry sorry)

/--
An auxiliary declaration to speed up typechecking.
-/
def forget₂_AddCommGroup_preserves_limits_aux {R : Type u} [ring R] {J : Type v}
    [category_theory.small_category J] (F : J ⥤ Module R) :
    category_theory.limits.is_limit
        (category_theory.functor.map_cone (category_theory.forget₂ (Module R) AddCommGroup)
          (has_limits.limit_cone F)) :=
  AddCommGroup.limit_cone_is_limit (F ⋙ category_theory.forget₂ (Module R) AddCommGroup)

/--
The forgetful functor from R-modules to abelian groups preserves all limits.
-/
protected instance forget₂_AddCommGroup_preserves_limits {R : Type u} [ring R] :
    category_theory.limits.preserves_limits (category_theory.forget₂ (Module R) AddCommGroup) :=
  category_theory.limits.preserves_limits.mk
    fun (J : Type v) (𝒥 : category_theory.small_category J) =>
      category_theory.limits.preserves_limits_of_shape.mk
        fun (F : J ⥤ Module R) =>
          category_theory.limits.preserves_limit_of_preserves_limit_cone
            (has_limits.limit_cone_is_limit F) (forget₂_AddCommGroup_preserves_limits_aux F)

/--
The forgetful functor from R-modules to types preserves all limits.
-/
protected instance forget_preserves_limits {R : Type u} [ring R] :
    category_theory.limits.preserves_limits (category_theory.forget (Module R)) :=
  category_theory.limits.preserves_limits.mk
    fun (J : Type u_1) (𝒥 : category_theory.small_category J) =>
      category_theory.limits.preserves_limits_of_shape.mk
        fun (F : J ⥤ Module R) =>
          category_theory.limits.preserves_limit_of_preserves_limit_cone
            (has_limits.limit_cone_is_limit F)
            (category_theory.limits.types.limit_cone_is_limit
              (F ⋙ category_theory.forget (Module R)))

/-- The diagram (in the sense of `category_theory`)
 of an unbundled `direct_limit` of modules. -/
@[simp] theorem direct_limit_diagram_map {R : Type u} [ring R] {ι : Type v} [directed_order ι]
    (G : ι → Type v) [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)]
    (f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)) [module.directed_system G f] (i : ι) (j : ι)
    (hij : i ⟶ j) :
    category_theory.functor.map (direct_limit_diagram G f) hij =
        f i j (direct_limit_diagram._proof_1 i j hij) :=
  Eq.refl (category_theory.functor.map (direct_limit_diagram G f) hij)

/-- The `cocone` on `direct_limit_diagram` corresponding to
the unbundled `direct_limit` of modules.

In `direct_limit_is_colimit` we show that it is a colimit cocone. -/
@[simp] theorem direct_limit_cocone_ι_app {R : Type u} [ring R] {ι : Type v} [directed_order ι]
    (G : ι → Type v) [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)]
    (f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)) [module.directed_system G f] [DecidableEq ι]
    (i : ι) :
    category_theory.nat_trans.app (category_theory.limits.cocone.ι (direct_limit_cocone G f)) i =
        module.direct_limit.of R ι G f i :=
  Eq.refl
    (category_theory.nat_trans.app (category_theory.limits.cocone.ι (direct_limit_cocone G f)) i)

/-- The unbundled `direct_limit` of modules is a colimit
in the sense of `category_theory`. -/
def direct_limit_is_colimit {R : Type u} [ring R] {ι : Type v} [directed_order ι] (G : ι → Type v)
    [(i : ι) → add_comm_group (G i)] [(i : ι) → module R (G i)]
    (f : (i j : ι) → i ≤ j → linear_map R (G i) (G j)) [module.directed_system G f] [DecidableEq ι]
    [Nonempty ι] : category_theory.limits.is_colimit (direct_limit_cocone G f) :=
  category_theory.limits.is_colimit.mk
    fun (s : category_theory.limits.cocone (direct_limit_diagram G f)) =>
      module.direct_limit.lift R ι G f
        (category_theory.nat_trans.app (category_theory.limits.cocone.ι s)) sorry

end Mathlib


import ALC

open Concept Role ALCStatement

axiom LEM :∀ (A : Prop), A ∨ ¬A

lemma dir1 : ∀ KB R o1 o2, ((RoleAssertion R (o1, o2)) ∈ KB) -> entails KB (RoleAssertion R (o1, o2)) :=
begin
  intros KB, intros R, intros o1, intros o2,
  intros H,
  rewrite entails,
  intros Δi, intros Iac, intros Iar, intros Io,
  intros H2,
  specialize H2 (RoleAssertion R (o1, o2)),
  apply H2,
  exact H,
end

lemma dir2 : ∀ KB R o1 o2, (entails KB (RoleAssertion R (o1, o2)) -> (RoleAssertion R (o1, o2)) ∈ KB) :=
begin
  intros KB R o1 o2,
  by_contra,

  rewrite entails at H,

  let Domain : set DomainType := {"arbitrary"},
  let ConI : AtomicConceptType → set DomainType := (λx,{"arbitrary"}),
  let RolI : AtomicRoleType -> set (DomainType × DomainType):= (λx,{("arbitrary", "arbitrary")}),
  let ObjI : IndividualType -> DomainType:= (λx, "arbitrary"),
  specialize H Domain,    --Domain
  specialize H ConI,  --Concept map
  specialize H RolI,  --RoleMap
  specialize H ObjI,
end

example : ∀ KB R o1 o2, (entails KB (RoleAssertion R (o1, o2)) ↔ (RoleAssertion R (o1, o2)) ∈ KB) :=
begin
  intros KB R o1 o2,
  apply iff.not,
end

--Trash

theorem contraposition1 (A B : Prop) (h : ¬ B → ¬ A) : A → B :=
assume h1 : A,
show B, from
  by_contradiction
    (assume h2 : ¬ B,
      have h3 : ¬ A, from h h2,
      show false, from h3 h1)

theorem contraposition (A B : Prop) : (¬B → ¬A) ↔ (A → B) :=
begin
  apply iff.intro,{
    apply contraposition1,
  },{
    intros H,
    intros NB,
    by_contradiction,
    have B : B, from H h,
    apply not.elim NB B,
  }
end

/-
--This is equivlent to trying prove a contradiction
theorem counterEx : ¬∀ KB R o1 o2, entails KB (RoleAssertion R (o1, o2)) → RoleAssertion R (o1, o2) ∈ KB :=
begin
  simp,
  existsi {RoleAssertion (atomicRole "ArbitraryRole") ("o1", "o2")},
  existsi (atomicRole "ArbitraryRole"),
  existsi "o1",
  existsi "o2",
  split,{
    rewrite entails,
    intros Domain Iac Iar Io,
    intros H,
    specialize H (RoleAssertion (atomicRole "ArbitraryRole") ("o1", "o2")),
    apply H,
    sorry,
  },{
    sorry,
  },
  sorry,
end

theorem counterEx2 : ∀ KB R o1 o2, ¬(entails KB (RoleAssertion R (o1, o2)) → RoleAssertion R (o1, o2) ∈ KB) :=
begin
  intros KB, intros R, intros o1, intros o2,
  simp,
  split,
  {
    rewrite entails,
    intros Domain Iac Iar Io,
    intros H,
    specialize H (RoleAssertion R (o1, o2)),
    apply H,
    admit,
  },
  {
    sorry,
  },
end
-/

/-
   --apply contraposition at H,

    --have N, from not.intro H,
    /-simp at N,
    cases N,
    cases N_w,
    {
      rewrite eval at N_h,
      induction N_w_ᾰ,{
        rewrite Ic at N_h,
        cases N_h,
        simp at N_h_right,
        sorry,
      },{
        rewrite Ic at N_h,
        sorry,
      },{
        rewrite Ic at N_h,

      },{

      },{

      }

    },{

      sorry
    },{
      sorry
    }
    -/
    --simp ite at H,

    /-
    apply contraposition,
    intros H,
    rewrite entails,
    simp,
    existsi {o1, o2},    --Domain
    existsi (λx,∅), --Concept map
    existsi (λx,{∅}),
    existsi (λx,∅),
    split,{

      intros S,
      apply contraposition,

      sorry,
      /-intros S,
      intros S2,
      cases S,{

        sorry,
      },{

        rewrite eval,

        sorry,
      },{
        sorry,
      },-/
      --specialize H (RoleAssertion R (o1, o2)),
    },
    {
      rewrite eval,
      cases R,
      rewrite Ir,
      admit,
    },
    -/

    --specialize H Δi Iac Iar Io,

    --apply contraposition at H,
    --by_cases (∀ (s : ALCStatement), s ∈ KB → eval Δi Iac Iar Io s),
    --{
    --  apply H at h,
    --  sorry,
    --},
    --{
    --  sorry,
    --}
    --rewrite entails at H,
    --specialize H Δi Iac Iar Io,
    --by_contra,
    --by_cases ,
-/

/-
    axiom LEM :∀ (A : Prop), A ∨ ¬A

    intro H,
    rewrite entails at H,
    let Domain : set DomainType := {"arbitrary"},
    let ConI : AtomicConceptType → set DomainType := (λx,{"arbitrary"}),
    let RolI : AtomicRoleType -> set (DomainType × DomainType):= (λx,{("arbitrary", "arbitrary")}),
    let ObjI : IndividualType -> DomainType:= (λx, "arbitrary"),
    specialize H Domain,    --Domain
    specialize H ConI,  --Concept map
    specialize H RolI,  --RoleMap
    specialize H ObjI,
    rewrite eval at H,
    cases R,
    rewrite Ir at H,
    let P : Prop := models Domain ConI RolI ObjI KB,
    have LEMP: P ∨ ¬P := LEM P,
    cases LEMP,{
      have p : (models Domain ConI RolI ObjI KB), from LEMP,
      rewrite models at p,
      by_contra,
      specialize p (RoleAssertion (atomicRole R) (o1, o2)),
      rewrite eval at p,
      rewrite Ir at p,
      simp at p,

    },{
      have p : ¬(models Domain ConI RolI ObjI KB), from LEMP,
      rewrite models at p,
      simp at p,
    }
-/

--This proof says that if the domain is empty, concept interpretation is also empty
lemma ICEmptyDomain: ∀Iac Iar c, Ic ∅ Iac Iar c = ∅ :=
begin
  intros Iac Iar c,
  induction c,{
    rewrite Ic,
    have H, from conceptsInDomain,
    specialize H ∅ Iac c,
    have H2, from set.eq_empty_of_subset_empty H,
    exact H2,
  },{
    rewrite Ic,
  },{
    rewrite Ic,
  },{
    rewrite Ic,
    rewrite c_ih_ᾰ,
    rewrite c_ih_ᾰ_1,
    apply set.empty_inter,
  },{
    rewrite Ic,
    rewrite c_ih_ᾰ,
    rewrite c_ih_ᾰ_1,
    apply set.empty_union,
  },{
    rewrite Ic,
    rewrite c_ih,
    apply set.empty_diff
  },{
    rewrite Ic,
    rewrite c_ih,
    simp,
  },{
    rewrite Ic,
    rewrite c_ih,
    simp,
  }
end

lemma notMem (α : Type) (e : α) (H : e ∉ ({e} : set α)): false :=
begin
  simp at H,
  exact H,
end

lemma rewriteOvb : ("arbitrary", "arbitrary") ∈ ({("arbitrary", "arbitrary")} : set (DomainType ×  DomainType)) = true :=
begin
  simp,
end

/-
intros KB, intros R, intros o1, intros o2,
  apply iff.intro,
  {
    intros H,
    rewrite entails at H,

  },
  {
    apply dir1,
  }

-/


import for_mathlib.mapping_cone
import category_theory.triangulated.pretriangulated

noncomputable theory

universes v u

open_locale classical zero_object

open category_theory category_theory.limits category_theory.triangulated
open homological_complex

namespace homotopy_category

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

local notation `𝒦` := homotopy_category V (complex_shape.up ℤ)

def distinguished_triangles : set (triangle 𝒦) :=
λ T, ∃ (X Y Z : cochain_complex V ℤ) (f : X ⟶ Y) (g : Y ⟶ Z) h,
  nonempty (T ≅ triangleₕ_of_termwise_split f g h)

variable {V}
local notation `𝒦` := homotopy_category V (complex_shape.up ℤ)

lemma mem_distinguished_of_iso {T₁ T₂ : triangle 𝒦} (e : T₁ ≅ T₂)
  (hT : T₁ ∈ distinguished_triangles V) : T₂ ∈ distinguished_triangles V :=
⟨_, _, _, _, _, _,
  ⟨e.symm ≪≫ hT.some_spec.some_spec.some_spec.some_spec.some_spec.some_spec.some⟩⟩

lemma mem_distinguished_iff_exists_iso_cone (T : triangle 𝒦) :
  T ∈ distinguished_triangles V ↔ ∃ (X Y) (f : X ⟶ Y),
    nonempty (T ≅ (neg₃_functor _).obj (cone.triangleₕ f)) :=
begin
  split,
  { rintro ⟨X, Y, Z, f, g, h, ⟨e⟩⟩,
    refine ⟨_, _, f, ⟨e ≪≫ iso_cone_of_termwise_split f g h⟩⟩ },
  { rintro ⟨X, Y, f, ⟨e⟩⟩,
    refine ⟨_, _, _, _, _, _, ⟨e ≪≫ iso_termwise_split_of_cone f⟩⟩ }
end

lemma triangleₕ_of_termwise_split_mem_distinguished_triangles (X Y Z : cochain_complex V ℤ)
  (f : X ⟶ Y) (g : Y ⟶ Z) (h : ∀ i, splitting (f.f i) (g.f i)) :
    triangleₕ_of_termwise_split f g h ∈ distinguished_triangles V :=
⟨_, _, _, _, _, _, ⟨iso.refl _⟩⟩

lemma cone_triangleₕ_mem_distinguished_triangles (X Y : cochain_complex V ℤ)
  (f : X ⟶ Y) : (neg₃_functor _).obj (cone.triangleₕ f) ∈ distinguished_triangles V :=
(mem_distinguished_iff_exists_iso_cone _).mpr ⟨_, _, _, ⟨iso.refl _⟩⟩

lemma rotate_mem_distinguished_triangles (T : triangle 𝒦) (h : T ∈ distinguished_triangles V) :
  T.rotate ∈ distinguished_triangles V :=
begin
  obtain ⟨X, Y, f, ⟨e⟩⟩ := (mem_distinguished_iff_exists_iso_cone _).mp h,
  exact ⟨_, _, _, _, _, _, ⟨(rotate _).map_iso e ≪≫ neg₃_rotate.app _ ≪≫
    (triangle.nonneg_rotate_iso _).symm ≪≫
      (homotopy_category.lift_triangle _).map_iso (triangle_of_termwise_split_cone_iso f).symm⟩⟩,
end

def inv_rotate_lift_triangle (V : Type u) [category.{v} V] [abelian V] :
  (inv_rotate _) ⋙ homotopy_category.lift_triangle V ≅
    homotopy_category.lift_triangle _ ⋙ (inv_rotate _) :=
nat_iso.of_components (λ X, mk_triangle_iso (iso.refl _) (iso.refl _) (iso.refl _)
  (by { dsimp, simp only [category.comp_id, functor.map_neg, discrete.functor_map_id,
    category.id_comp, preadditive.comp_neg, shift_ε_inv_app, category.assoc, neg_inj,
    functor.map_comp, nat_trans.id_app, preadditive.neg_comp] })
  (by { dsimp, rw [category.comp_id, category.id_comp] })
  (by { dsimp, simp only [shift_ε_app, discrete.functor_map_id, category.id_comp, category.assoc,
    functor.map_comp, nat_trans.id_app, category_theory.functor.map_id,
    unit_of_tensor_iso_unit_inv_app, shift_μ_inv_app], erw category.comp_id }))
  (by { intros, ext; exact (category.comp_id _).trans (category.id_comp _).symm })

lemma inv_rotate_mem_distinguished_triangles (T : triangle 𝒦) (h : T ∈ distinguished_triangles V) :
  T.inv_rotate ∈ distinguished_triangles V :=
begin
  obtain ⟨X, Y, Z, f, g, h, ⟨e⟩⟩ := h,
  exact (mem_distinguished_iff_exists_iso_cone _).mpr ⟨_, _, _,
    ⟨(inv_rotate _).map_iso e ≪≫ ((inv_rotate_lift_triangle _).app _).symm ≪≫
    (homotopy_category.lift_triangle _).map_iso ((neg₃_equiv _).iso_equiv _ _
    ((triangle.nonneg_inv_rotate_iso _).symm ≪≫ inv_rotate_iso_cone_triangle f g h))⟩⟩
end

instance : pretriangulated 𝒦 :=
{ distinguished_triangles := distinguished_triangles V,
  isomorphic_distinguished := λ T₁ hT T₂ e, mem_distinguished_of_iso e.symm hT,
  contractible_distinguished := begin
    rintro ⟨X⟩,
    refine ⟨X, X, homological_complex.zero, 𝟙 _, 0, _, ⟨_⟩⟩,
    { intro i, simp only [id_f, zero_f_apply],
      refine splitting.splitting_of_is_iso_zero _ (homological_complex.zero_X _ _),
      exact homological_complex.is_zero_zero },
    refine mk_triangle_iso (iso.refl _) (iso.refl _) _ _ _ _,
    { dsimp [triangleₕ_of_termwise_split],
      refine homotopy_category.is_zero_zero.iso_zero.symm, },
    all_goals { dsimp; simp; refl },
  end,
  distinguished_cocone_triangle := begin
    rintros ⟨X⟩ ⟨Y⟩ f,
    induction f using quot.induction_on,
    exact ⟨_, _, _, _, _, _, _, _, _, ⟨iso_termwise_split_of_cone f⟩⟩,
  end,
  rotate_distinguished_triangle := begin
    intro T,
    split,
    { apply rotate_mem_distinguished_triangles },
    { intro h,
      exact mem_distinguished_of_iso ((triangle_rotation _).unit_iso.app T).symm
        (inv_rotate_mem_distinguished_triangles _ h) }
  end,
  complete_distinguished_triangle_morphism := begin
    intros,
    obtain ⟨X₁, Y₁, f₁, ⟨e₁⟩⟩ := (mem_distinguished_iff_exists_iso_cone _).mp h₁,
    obtain ⟨X₂, Y₂, f₂, ⟨e₂⟩⟩ := (mem_distinguished_iff_exists_iso_cone _).mp h₂,
    let h : homotopy (f₁ ≫ quot.out (e₁.inv.hom₂ ≫ b ≫ e₂.hom.hom₂))
      (quot.out (e₁.inv.hom₁ ≫ a ≫ e₂.hom.hom₁) ≫ f₂),
    { apply homotopy_of_eq,
      simp only [quotient_map_out, category.assoc, functor.map_comp],
      erw [← e₂.hom.comm₁, reassoc_of e₁.inv.comm₁, reassoc_of comm₁] },
    refine ⟨e₁.hom.hom₃ ≫ (quotient V _).map (cone.map h) ≫ e₂.inv.hom₃, _, _⟩,
    { rw [reassoc_of e₁.hom.comm₂, ← is_iso.eq_inv_comp],
      simp_rw ← category.assoc,
      rw [← is_iso.eq_comp_inv, ← inv_hom₃, ← inv_hom₂, is_iso.iso.inv_inv, is_iso.iso.inv_hom],
      simp_rw category.assoc,
      rw [e₂.hom.comm₂],
      convert (cone.triangleₕ_map h).comm₂ using 1,
      dsimp, simp },
    { simp_rw category.assoc,
      rw [← is_iso.inv_comp_eq, ← inv_hom₃, is_iso.iso.inv_hom, ← reassoc_of e₁.inv.comm₃,
        ← e₂.inv.comm₃],
      dsimp,
      have := (cone.triangleₕ_map h).comm₃,
      dsimp at this,
      rw [← homotopy_category.quotient_map_shift, quotient_map_out] at this,
      simp only [preadditive.neg_comp_assoc, preadditive.comp_neg, category.assoc, neg_inj,
        preadditive.neg_comp],
      rw [← reassoc_of this, ← functor.map_comp, ← functor.map_comp],
      congr' 2,
      rw [← is_iso.comp_inv_eq, ← inv_hom₁, is_iso.iso.inv_inv, category.assoc] }
  end }

end homotopy_category


import algebraic_geometry.AffineScheme

open category_theory category_theory.limits opposite topological_space

namespace algebraic_geometry

universes v u

lemma structure_sheaf.open_to_localization_localization_to_stalk {R : Type*} [comm_ring R]
  (U : opens (prime_spectrum.Top R)) (x : U) :
  structure_sheaf.open_to_localization R U x x.2 ≫ structure_sheaf.localization_to_stalk R x =
    (Spec.structure_sheaf R).presheaf.germ x :=
begin
  rw [← structure_sheaf.germ_comp_stalk_to_fiber_ring_hom, category.assoc,
    structure_sheaf.stalk_to_fiber_ring_hom_localization_to_stalk, category.comp_id],
end

lemma specializes_of_eq {α : Type*} [topological_space α] {x y : α} (e : x = y) :
  x ⤳ y := e ▸ specializes_refl x

@[simp, reassoc, elementwise]
lemma _root_.Top.presheaf.stalk_specializes_comp {C : Type*} [category C] [limits.has_colimits C]
  {X : Top} (F : X.presheaf C)
  {x y z : X} (h : x ⤳ y) (h' : y ⤳ z) :
  F.stalk_specializes h' ≫ F.stalk_specializes h = F.stalk_specializes (h.trans h') :=
F.stalk_hom_ext $ λ _ _, by simp

@[simp]
lemma _root_.Top.presheaf.stalk_specializes_refl {C : Type*} [category C] [limits.has_colimits C]
  {X : Top} (F : X.presheaf C) (x : X) :
  F.stalk_specializes (specializes_refl x) = 𝟙 _ :=
F.stalk_hom_ext $ λ _ _, by { dsimp, simpa }

lemma _root_.Top.presheaf.stalk_hom_ext_of_is_basis {C : Type*} [category C] [limits.has_colimits C] {X : Top}
  {B : set (opens X)} (hB : opens.is_basis B)
  (F : X.presheaf C) {x} {Y : C}
  {f₁ f₂ : F.stalk x ⟶ Y}
  (ih : ∀ (U ∈ B) (hxU : x ∈ U), F.germ ⟨x, hxU⟩ ≫ f₁ = F.germ ⟨x, hxU⟩ ≫ f₂) : f₁ = f₂ :=
Top.presheaf.stalk_hom_ext _
begin
  intros U hxU,
  obtain ⟨V, hV, hxV, hVU : V ≤ U⟩ := opens.is_basis_iff_nbhd.mp hB hxU,
  have := congr_arg (λ f, F.map (hom_of_le hVU).op ≫ f) (ih V hV hxV),
  convert this using 1; rw [← category.assoc, F.germ_res]; refl
end

lemma Scheme.stalk_hom_affine_ext {X : Scheme} (x : X.carrier) {Y : CommRing}
  {f₁ f₂ : X.stalk x ⟶ Y} (ih : ∀ (U : opens X.carrier) (hU : is_affine_open U) (hxU : x ∈ U),
    X.presheaf.germ ⟨x, hxU⟩ ≫ f₁ = X.presheaf.germ ⟨x, hxU⟩ ≫ f₂) : f₁ = f₂ :=
Top.presheaf.stalk_hom_ext_of_is_basis (is_basis_affine_open X) _ ih

@[reassoc]
lemma Spec_Γ_naturality' {R S : CommRing} (f : R ⟶ S) :
  f ≫ to_Spec_Γ S = to_Spec_Γ R ≫ Scheme.Γ.map (Scheme.Spec.map f.op).op :=
Spec_Γ_naturality f

@[simp, reassoc]
lemma PresheafedSpace.stalk_map_germ' {C : Type u} [category.{v} C] [has_colimits C]
  {X Y : PresheafedSpace.{v} C} (α : X ⟶ Y) (x : X) {U : opens Y} (hxU : α.base x ∈ U) :
  Y.presheaf.germ ⟨α.base x, hxU⟩ ≫ PresheafedSpace.stalk_map α x = α.c.app _ ≫
    X.presheaf.germ ⟨x, show x ∈ (opens.map α.base).obj U, from hxU⟩ :=
PresheafedSpace.stalk_map_germ α U ⟨_, _⟩

lemma PresheafedSpace.stalk_map.congr_hom' {C : Type u} [category.{v} C] [has_colimits C]
  {X Y : PresheafedSpace.{v} C} (α β : X ⟶ Y) (h : α = β) (x : X) :
  PresheafedSpace.stalk_map α x =
    Y.presheaf.stalk_specializes (by subst h) ≫ PresheafedSpace.stalk_map β x :=
begin
  subst h,
  apply Top.presheaf.stalk_hom_ext,
  intros U hxU,
  simp,
end

instance {R : Type*} [comm_ring R] [local_ring R] :
  is_iso (structure_sheaf.to_stalk R (local_ring.closed_point R)) :=
begin
  have : ∀ x : (local_ring.closed_point R).as_ideal.prime_compl, is_unit (x : R),
  { exact λ x, not_not.mp x.2 },
  have : is_iso (is_localization.at_units R
    (local_ring.closed_point R).as_ideal.prime_compl
    ((Spec.structure_sheaf R).presheaf.stalk
    (local_ring.closed_point R)) this).to_ring_equiv.to_CommRing_iso.hom := infer_instance,
  convert this using 1,
  let S := _, change S = CommRing.of S, clear_value S, cases S, refl
end

instance {C} [category C] [has_colimits C] {X : Top} (F : X.presheaf C) {x y} (e : x = y) :
  is_iso (F.stalk_specializes (specializes_of_eq e)) :=
⟨⟨F.stalk_specializes (specializes_of_eq e.symm), by simp, by simp⟩⟩

lemma Γ_Spec.adjunction_unit_app_base_apply  {X : Scheme} (x) :
  (Γ_Spec.adjunction.unit.app X).1.base x =
    prime_spectrum.comap (X.to_LocallyRingedSpace.Γ_to_stalk x) (local_ring.closed_point _) :=
rfl

lemma morphism_restrict_val_base {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) :
  ⇑(f ∣_ U).1.base = U.1.restrict_preimage f.1.base :=
funext (λ x, subtype.ext (morphism_restrict_base_coe f U x))

/-- The stalks are isomorphic on inseparable points -/
@[simps] noncomputable
def _root_.Top.presheaf.stalk_congr {X : Top} {C : Type*} [category C] [has_colimits C]
  (F : X.presheaf C) {x y : X}
  (e : inseparable x y) : F.stalk x ≅ F.stalk y :=
⟨F.stalk_specializes e.ge, F.stalk_specializes e.le, by simp, by simp⟩

lemma _root_.inseparable.of_eq {α :Type*} [topological_space α] {x y :α}
  (e : x = y) : inseparable x y := e ▸ inseparable.refl x

/--
The stalk map of a restriction of a morphism is isomorphic to the stalk map of the original map.
-/
noncomputable
def morphism_restrict_stalk_map {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) (x) :
  arrow.mk (PresheafedSpace.stalk_map (f ∣_ U).1 x) ≅
    arrow.mk (PresheafedSpace.stalk_map f.1 x.1) :=
begin
  fapply arrow.iso_mk',
  { refine Y.restrict_stalk_iso U.open_embedding ((f ∣_ U).1 x) ≪≫ Top.presheaf.stalk_congr _ _,
    apply inseparable.of_eq,
    exact morphism_restrict_base_coe f U x },
  { exact X.restrict_stalk_iso _ _ },
  { apply Top.presheaf.stalk_hom_ext,
    intros V hxV,
    simp only [Top.presheaf.stalk_congr_hom, category_theory.category.assoc,
      category_theory.iso.trans_hom],
    erw PresheafedSpace.restrict_stalk_iso_hom_eq_germ_assoc,
    erw PresheafedSpace.stalk_map_germ_assoc _ _ ⟨_, _⟩,
    rw [Top.presheaf.germ_stalk_specializes'_assoc],
    erw PresheafedSpace.stalk_map_germ _ _ ⟨_, _⟩,
    erw PresheafedSpace.restrict_stalk_iso_hom_eq_germ,
    rw [morphism_restrict_c_app, category.assoc, Top.presheaf.germ_res],
    refl }
end

lemma prime_spectrum.Union_basic_open_eq_top_iff {R : Type*} [comm_ring R] {ι : Type*}
  (f : ι → R) : (⨆ i : ι, prime_spectrum.basic_open (f i)) = ⊤ ↔ ideal.span (set.range f) = ⊤ :=
begin
  erw opens.supr_mk (λ i : ι, (prime_spectrum.basic_open (f i)).1),
  rw [← opens.ext_iff, subtype.coe_mk],
  simp_rw [subtype.val_eq_coe, prime_spectrum.basic_open_eq_zero_locus_compl],
  rw [← set.compl_Inter, opens.coe_top],
  erw compl_eq_top,
  rw [← prime_spectrum.zero_locus_Union, ← prime_spectrum.zero_locus_span],
  erw prime_spectrum.zero_locus_empty_iff_eq_top,
  simp,
end

lemma CommRing.is_iso_iff_bijective {R S : CommRing} (f : R ⟶ S) :
  is_iso f ↔ function.bijective f :=
begin
  rw ← is_iso_iff_bijective,
  change is_iso f ↔ is_iso ((forget CommRing).map f),
  refine ⟨λ H, by exactI infer_instance, λ H, by exactI is_iso_of_reflects_iso f (forget CommRing)⟩,
end

lemma bijective_of_is_localization {R S T : Type*} [comm_ring R] [comm_ring S] [comm_ring T]
  [algebra R S] [algebra R T] (M : submonoid R) [is_localization M S] [is_localization M T]
  (f : S →+* T) (hf : f.comp (algebra_map R S) = algebra_map R T) : function.bijective f :=
begin
  have : f = is_localization.alg_equiv M S T,
  { apply is_localization.ring_hom_ext M, { rw hf, ext, simp }, { apply_instance } },
  rw this,
  exact (is_localization.alg_equiv M S T).to_equiv.bijective,
end

lemma Γ_Spec.adjunction.unit_app_map_basic_open {X : Scheme} (r : X.presheaf.obj (op ⊤)) :
  (opens.map (Γ_Spec.adjunction.unit.app X).1.base).obj (prime_spectrum.basic_open r) =
    X.basic_open r :=
begin
  rw ← basic_open_eq_of_affine,
  erw Scheme.preimage_basic_open,
  change X.basic_open _ = _,
  congr,
  rw [Γ_Spec.adjunction_unit_app_app_top, ← comp_apply],
  simp [-comp_apply]
end

lemma preimage_adjunction_unit_basic_open (X : Scheme) (r : X.presheaf.obj (op ⊤)) :
  (opens.map (Γ_Spec.adjunction.unit.app X).1.base).obj (prime_spectrum.basic_open r) =
    X.basic_open r :=
begin
  rw ← basic_open_eq_of_affine,
  erw Scheme.preimage_basic_open,
  congr',
  rw [Γ_Spec.adjunction_unit_app_app_top, ← comp_apply],
  simp [-comp_apply]
end

lemma supr_basic_open_eq_top_of_span_eq_top (X : Scheme) (s : set (X.presheaf.obj $ op ⊤))
  (h : ideal.span s = ⊤) : (⨆ i : s, X.basic_open i.1) = ⊤ :=
begin
  have := prime_spectrum.Union_basic_open_eq_top_iff (coe : s → X.presheaf.obj (op ⊤)),
  rw subtype.range_coe at this,
  rw ← this at h,
  apply_fun (opens.map (Γ_Spec.adjunction.unit.app X).1.base).obj at h,
  rw opens.map_supr at h,
  convert h,
  ext1 i,
  exact (preimage_adjunction_unit_basic_open X _).symm
end

noncomputable
def Spec_Γ_arrow_iso_of_is_affine {X Y : Scheme} (f : X ⟶ Y) [is_affine X] [is_affine Y] :
  arrow.mk f ≅ arrow.mk (Scheme.Spec.map (Scheme.Γ.map f.op).op) :=
arrow.iso_mk' _ _ (as_iso $ Γ_Spec.adjunction.unit.app _) (as_iso $ Γ_Spec.adjunction.unit.app _)
  (Γ_Spec.adjunction.unit_naturality f)

noncomputable
def Γ_Spec_arrow_iso {R S : CommRing} (f : R ⟶ S) :
  arrow.mk f ≅ arrow.mk (Scheme.Γ.map (Scheme.Spec.map f.op).op) :=
(arrow.iso_of_nat_iso Spec_Γ_identity (arrow.mk f)).symm

end algebraic_geometry


/-
Copyright (c) 2022 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou
-/

import algebraic_topology.split_simplicial_object
import algebraic_topology.dold_kan.degeneracies
import algebraic_topology.dold_kan.functor_n

/-!

# Split simplicial objects in preadditive categories

In this file we define a functor `nondeg_complex : simplicial_object.split C ⥤ chain_complex C ℕ`
when `C` is a preadditive category with finite coproducts, and get an isomorphism
`to_karoubi_nondeg_complex_iso_N₁ : nondeg_complex ⋙ to_karoubi _ ≅ forget C ⋙ dold_kan.N₁`.
-/

noncomputable theory

open category_theory category_theory.limits category_theory.category
  category_theory.preadditive category_theory.idempotents opposite
  algebraic_topology algebraic_topology.dold_kan

open_locale big_operators simplicial dold_kan

namespace simplicial_object

namespace splitting

variables {C : Type*} [category C] [has_finite_coproducts C]
  {X : simplicial_object C} (s : splitting X)

/-- The projection on a summand of the coproduct decomposition given
by a splitting of a simplicial object. -/
def π_summand [has_zero_morphisms C] {Δ : simplex_categoryᵒᵖ} (A : index_set Δ) :
  X.obj Δ ⟶ s.N A.1.unop.len :=
begin
  refine (s.iso Δ).inv ≫ sigma.desc (λ B, _),
  by_cases B = A,
  { exact eq_to_hom (by { subst h, refl, }), },
  { exact 0, },
end

@[simp, reassoc]
lemma ι_π_summand_eq_id [has_zero_morphisms C] {Δ : simplex_categoryᵒᵖ} (A : index_set Δ) :
  s.ι_summand A ≫ s.π_summand A = 𝟙 _ :=
begin
  dsimp [ι_summand, π_summand],
  simp only [summand, assoc, is_iso.hom_inv_id_assoc],
  erw [colimit.ι_desc, cofan.mk_ι_app],
  dsimp,
  simp only [eq_self_iff_true, if_true],
end

@[simp, reassoc]
lemma ι_π_summand_eq_zero [has_zero_morphisms C] {Δ : simplex_categoryᵒᵖ} (A B : index_set Δ)
  (h : B ≠ A) : s.ι_summand A ≫ s.π_summand B = 0 :=
begin
  dsimp [ι_summand, π_summand],
  simp only [summand, assoc, is_iso.hom_inv_id_assoc],
  erw [colimit.ι_desc, cofan.mk_ι_app],
  apply dif_neg,
  exact h.symm,
end

variable [preadditive C]

lemma decomposition_id (Δ : simplex_categoryᵒᵖ) :
  𝟙 (X.obj Δ) = ∑ (A : index_set Δ), s.π_summand A ≫ s.ι_summand A :=
begin
  apply s.hom_ext',
  intro A,
  rw [comp_id, comp_sum, finset.sum_eq_single A, ι_π_summand_eq_id_assoc],
  { intros B h₁ h₂,
    rw [s.ι_π_summand_eq_zero_assoc _ _ h₂, zero_comp], },
  { simp only [finset.mem_univ, not_true, is_empty.forall_iff], },
end

@[simp, reassoc]
lemma σ_comp_π_summand_id_eq_zero {n : ℕ} (i : fin (n+1)) :
  X.σ i ≫ s.π_summand (index_set.id (op [n+1])) = 0 :=
begin
  apply s.hom_ext',
  intro A,
  dsimp only [simplicial_object.σ],
  rw [comp_zero, s.ι_summand_epi_naturality_assoc A (simplex_category.σ i).op,
    ι_π_summand_eq_zero],
  symmetry,
  change ¬ (A.epi_comp (simplex_category.σ i).op).eq_id,
  rw index_set.eq_id_iff_len_eq,
  have h := simplex_category.len_le_of_epi (infer_instance : epi A.e),
  dsimp at ⊢ h,
  linarith,
end

/-- If a simplicial object `X` in an additive category is split,
then `P_infty` vanishes on all the summands of `X _[n]` which do
not correspond to the identity of `[n]`. -/
lemma ι_summand_comp_P_infty_eq_zero {X : simplicial_object C}
  (s : simplicial_object.splitting X)
  {n : ℕ} (A : simplicial_object.splitting.index_set (op [n]))
  (hA : ¬ A.eq_id) :
  s.ι_summand A ≫ P_infty.f n = 0 :=
begin
  rw simplicial_object.splitting.index_set.eq_id_iff_mono at hA,
  rw [simplicial_object.splitting.ι_summand_eq, assoc,
    degeneracy_comp_P_infty X n A.e hA, comp_zero],
end

lemma comp_P_infty_eq_zero_iff {Z : C} {n : ℕ} (f : Z ⟶ X _[n]) :
  f ≫ P_infty.f n = 0 ↔ f ≫ s.π_summand (index_set.id (op [n])) = 0 :=
begin
  split,
  { intro h,
    cases n,
    { dsimp at h,
      rw [comp_id] at h,
      rw [h, zero_comp], },
    { have h' := f ≫= P_infty_f_add_Q_infty_f (n+1),
      dsimp at h',
      rw [comp_id, comp_add, h, zero_add] at h',
      rw [← h', assoc, Q_infty_f, decomposition_Q, preadditive.sum_comp,
        preadditive.comp_sum, finset.sum_eq_zero],
      intros i hi,
      simp only [assoc, σ_comp_π_summand_id_eq_zero, comp_zero], }, },
  { intro h,
    rw [← comp_id f, assoc, s.decomposition_id, preadditive.sum_comp,
      preadditive.comp_sum, fintype.sum_eq_zero],
    intro A,
    by_cases hA : A.eq_id,
    { dsimp at hA,
      subst hA,
      rw [assoc, reassoc_of h, zero_comp], },
    { simp only [assoc, s.ι_summand_comp_P_infty_eq_zero A hA, comp_zero], }, },
end

@[simp, reassoc]
lemma P_infty_comp_π_summand_id (n : ℕ) :
  P_infty.f n ≫ s.π_summand (index_set.id (op [n])) = s.π_summand (index_set.id (op [n])) :=
begin
  conv_rhs { rw ← id_comp (s.π_summand _), },
  symmetry,
  rw [← sub_eq_zero, ← sub_comp, ← comp_P_infty_eq_zero_iff, sub_comp, id_comp,
    P_infty_f_idem, sub_self],
end

@[simp, reassoc]
lemma π_summand_comp_ι_summand_comp_P_infty_eq_P_infty (n : ℕ) :
  s.π_summand (index_set.id (op [n])) ≫ s.ι_summand (index_set.id (op [n])) ≫ P_infty.f n =
    P_infty.f n :=
begin
  conv_rhs { rw ← id_comp (P_infty.f n), },
  erw [s.decomposition_id, preadditive.sum_comp],
  rw [fintype.sum_eq_single (index_set.id (op [n])), assoc],
  rintros A (hA : ¬A.eq_id),
  rw [assoc, s.ι_summand_comp_P_infty_eq_zero A hA, comp_zero],
end

/-- The differentials `s.d i j : s.N i ⟶ s.N j` on nondegenerate simplices of a split
simplicial object are induced by the differentials on the alternating face map complex. -/
@[simp]
def d (i j : ℕ) : s.N i ⟶ s.N j :=
s.ι_summand (index_set.id (op [i])) ≫ K[X].d i j ≫ s.π_summand (index_set.id (op [j]))

lemma ι_summand_comp_d_comp_π_summand_eq_zero (j k : ℕ) (A : index_set (op [j])) (hA : ¬A.eq_id) :
  s.ι_summand A ≫ K[X].d j k ≫ s.π_summand (index_set.id (op [k])) = 0 :=
begin
  rw A.eq_id_iff_mono at hA,
  rw [← assoc, ← s.comp_P_infty_eq_zero_iff, assoc, ← P_infty.comm j k, s.ι_summand_eq, assoc,
    degeneracy_comp_P_infty_assoc X j A.e hA, zero_comp, comp_zero],
end

/-- If `s` is a splitting of a simplicial object `X` in a preadditive category,
`s.nondeg_complex` is a chain complex which is given in degree `n` by
the nondegenerate `n`-simplices of `X`. -/
@[simps]
def nondeg_complex : chain_complex C ℕ :=
{ X := s.N,
  d := s.d,
  shape' := λ i j hij, by simp only [d, K[X].shape i j hij, zero_comp, comp_zero],
  d_comp_d' := λ i j k hij hjk, begin
    simp only [d, assoc],
    have eq : K[X].d i j ≫ 𝟙 (X.obj (op [j])) ≫ K[X].d j k ≫
      s.π_summand (index_set.id (op [k])) = 0 :=
      by erw [id_comp, homological_complex.d_comp_d_assoc, zero_comp],
    rw s.decomposition_id at eq,
    classical,
    rw [fintype.sum_eq_add_sum_compl (index_set.id (op [j])), add_comp, comp_add, assoc,
      preadditive.sum_comp, preadditive.comp_sum, finset.sum_eq_zero, add_zero] at eq, swap,
    { intros A hA,
      simp only [finset.mem_compl, finset.mem_singleton] at hA,
      simp only [assoc, ι_summand_comp_d_comp_π_summand_eq_zero _ _ _ _ hA, comp_zero], },
    rw [eq, comp_zero],
  end }

/-- The chain complex `s.nondeg_complex` attached to a splitting of a simplicial object `X`
becomes isomorphic to the normalized Moore complex `N₁.obj X` defined as a formal direct
factor in the category `karoubi (chain_complex C ℕ)`. -/
@[simps]
def to_karoubi_nondeg_complex_iso_N₁ : (to_karoubi _).obj s.nondeg_complex ≅ N₁.obj X :=
{ hom :=
  { f :=
    { f := λ n, s.ι_summand (index_set.id (op [n])) ≫ P_infty.f n,
      comm' := λ i j hij, begin
        dsimp,
        rw [assoc, assoc, assoc, π_summand_comp_ι_summand_comp_P_infty_eq_P_infty,
          homological_complex.hom.comm],
      end, },
    comm := by { ext n, dsimp, rw [id_comp, assoc, P_infty_f_idem], }, },
  inv :=
  { f :=
    { f := λ n, s.π_summand (index_set.id (op [n])),
      comm' := λ i j hij, begin
        dsimp,
        slice_rhs 1 1 { rw ← id_comp (K[X].d i j), },
        erw s.decomposition_id,
        rw [sum_comp, sum_comp, finset.sum_eq_single (index_set.id (op [i])), assoc, assoc],
        { intros A h hA,
          simp only [assoc, s.ι_summand_comp_d_comp_π_summand_eq_zero _ _ _ hA, comp_zero], },
        { simp only [finset.mem_univ, not_true, is_empty.forall_iff], },
      end, },
    comm := by { ext n, dsimp, simp only [comp_id, P_infty_comp_π_summand_id], }, },
  hom_inv_id' := begin
    ext n,
    simpa only [assoc, P_infty_comp_π_summand_id, karoubi.comp_f,
      homological_complex.comp_f, ι_π_summand_eq_id],
  end,
  inv_hom_id' := begin
    ext n,
    simp only [π_summand_comp_ι_summand_comp_P_infty_eq_P_infty, karoubi.comp_f,
      homological_complex.comp_f, N₁_obj_p, karoubi.id_eq],
  end, }

end splitting

namespace split

variables {C : Type*} [category C] [preadditive C] [has_finite_coproducts C]

/-- The functor which sends a split simplicial object in a preadditive category to
the chain complex which consists of nondegenerate simplices. -/
@[simps]
def nondeg_complex_functor : split C ⥤ chain_complex C ℕ :=
{ obj := λ S, S.s.nondeg_complex,
  map := λ S₁ S₂ Φ,
  { f := Φ.f,
    comm' := λ i j hij, begin
      dsimp,
      erw [← ι_summand_naturality_symm_assoc Φ (splitting.index_set.id (op [i])),
        ((alternating_face_map_complex C).map Φ.F).comm_assoc i j],
      simp only [assoc],
      congr' 2,
      apply S₁.s.hom_ext',
      intro A,
      dsimp [alternating_face_map_complex],
      erw ι_summand_naturality_symm_assoc Φ A,
      by_cases A.eq_id,
      { dsimp at h,
        subst h,
        simpa only [splitting.ι_π_summand_eq_id, comp_id, splitting.ι_π_summand_eq_id_assoc], },
      { have h' : splitting.index_set.id (op [j]) ≠ A := by { symmetry, exact h, },
        rw [S₁.s.ι_π_summand_eq_zero_assoc _ _ h', S₂.s.ι_π_summand_eq_zero _ _ h',
          zero_comp, comp_zero], },
    end }, }

/-- The natural isomorphism (in `karoubi (chain_complex C ℕ)`) between the chain complex
of nondegenerate simplices of a split simplicial object and the normalized Moore complex
defined as a formal direct factor of the alternating face map complex. -/
@[simps]
def to_karoubi_nondeg_complex_functor_iso_N₁ :
  nondeg_complex_functor ⋙ to_karoubi (chain_complex C ℕ) ≅ forget C ⋙ dold_kan.N₁ :=
nat_iso.of_components (λ S, S.s.to_karoubi_nondeg_complex_iso_N₁)
  (λ S₁ S₂ Φ, begin
    ext n,
    dsimp,
    simp only [karoubi.comp_f, to_karoubi_map_f, homological_complex.comp_f,
      nondeg_complex_functor_map_f, splitting.to_karoubi_nondeg_complex_iso_N₁_hom_f_f,
      N₁_map_f, alternating_face_map_complex.map_f, assoc, P_infty_f_idem_assoc],
    erw ← split.ι_summand_naturality_symm_assoc Φ (splitting.index_set.id (op [n])),
    rw P_infty_f_naturality,
  end)

end split

end simplicial_object


import data.polynomial.eval
import tactic.expand_exists
import complexity_class.lemmas
import polytime.size

open tree tencodable function
open_locale tree

namespace tree

inductive polytime : (tree unit → tree unit) → Prop
| nil : polytime (λ _, nil)
| id' : polytime id
| left : polytime (λ x, x.left)
| right : polytime (λ x, x.right)
| pair {f₁ f₂} : polytime f₁ → polytime f₂ → polytime (λ x, (f₁ x) △ (f₂ x))
| comp {f₁ f₂} : polytime f₁ → polytime f₂ → polytime (f₁ ∘ f₂)
| ite {f g₁ g₂} : polytime f → polytime g₁ → polytime g₂ → polytime (λ x, if f x = nil then g₁ x else g₂ x)
| bounded_rec {f} : polytime f → polysize_fun (λ x : tree unit, f^[x.left.num_nodes] x.right) →
    polytime (λ x : tree unit, f^[x.left.num_nodes] x.right)

namespace polytime

theorem of_eq {f g : tree unit → tree unit} (hf : polytime f) (H : ∀ n, f n = g n) : polytime g :=
(funext H : f = g) ▸ hf

protected theorem const : ∀ (n : tree unit), polytime (λ _, n)
| tree.nil := nil
| (x △ y) := (const x).pair (const y)

-- TODO: how to do make original lemma protected?
protected lemma id : polytime (λ x, x) := id'

@[simp] lemma uncurry_unary {α β : Type*} (f : α → β) : ↿f = f := rfl

theorem num_nodes_poly {f : tree unit → tree unit} (hf : polytime f) :
  polysize_fun f :=
begin
  induction hf,
  case nil { use 0, simp, },
  case id' { use polynomial.X, simp, },
  case left { use polynomial.X, simpa using left_num_nodes_le, },
  case right { use polynomial.X, simpa using right_num_nodes_le, },
  case pair : f₁ f₂ _ _ ih₁ ih₂
  { rcases ih₁ with ⟨P₁, ih₁⟩, rcases ih₂ with ⟨P₂, ih₂⟩,
    use P₁ + P₂ + 1,
    intro x,
    simp, mono, },
  case comp : f₁ f₂ _ _ ih₁ ih₂
  { rcases ih₁ with ⟨P₁, ih₁⟩, rcases ih₂ with ⟨P₂, ih₂⟩,
    use P₁.comp P₂,
    intro x,
    simp only [comp_app, polynomial.eval_comp],
    exact (ih₁ _).trans (P₁.eval_mono (ih₂ x)), },
  case ite : f g₁ g₂ _ _ _ _ ih₁ ih₂ { exact polysize_fun.ite ih₁ ih₂, },
  case bounded_rec : _ _ H { exact H, }
end

end polytime

end tree

def polytime : complexity_class :=
{ prop := tree.polytime,
  nil := tree.polytime.nil,
  left := tree.polytime.left,
  right := tree.polytime.right,
  id := tree.polytime.id,
  pair := λ f₁ f₂, tree.polytime.pair,
  comp := λ f₁ f₂, tree.polytime.comp,
  ite' := λ c f g, tree.polytime.ite }

open_locale complexity_class
localized "notation `PTIME` := polytime" in complexity_class

@[simp] lemma tree.polytime_iff {f : tree unit → tree unit} :
  tree.polytime f ↔ f ∈ₑ PTIME := @complexity_class.prop_iff_mem PTIME f

@[complexity] lemma tree.polytime_of_polytime {f : tree unit → tree unit} (h : f ∈ₑ PTIME) :
  tree.polytime f := by rwa tree.polytime_iff

class polycodable (α : Type) extends tencodable α :=
(poly [] : tencodable.decode α ∈ₑ PTIME)

attribute [complexity] polycodable.poly

variables {α β : Type}

instance : polycodable (tree unit) :=
⟨complexity_class.decode⟩

instance [polycodable α] : polycodable (option α) :=
⟨complexity_class.option_decode (polycodable.poly α)⟩

instance [polycodable α] [polycodable β] : polycodable (α ⊕ β) :=
⟨complexity_class.sum_decode (polycodable.poly α) (polycodable.poly β)⟩

instance [polycodable α] [polycodable β] : polycodable (α × β) :=
⟨complexity_class.prod_decode (polycodable.poly α) (polycodable.poly β)⟩

lemma polycodable.mem'_iff_mem [polycodable α] [tencodable β] {γ : Type} [has_uncurry γ α β] (f : γ) :
  f ∈ₛ PTIME ↔ f ∈ₑ PTIME := complexity_class.mem'_iff_mem_decode (polycodable.poly α)

open polysize
variables [tencodable α] [tencodable β]

@[complexity] lemma polytime.size_le {γ : Type} [has_uncurry γ α β] [polysize α] [polysize β] {f : γ} (hf : f ∈ₑ PTIME) :
  polysize_fun f :=
begin
  rcases hf with ⟨f', pf, hf⟩, cases polysize.upper β with u hu, cases polysize.lower α with l hl,
  obtain ⟨p, hp⟩ := pf.num_nodes_poly,
  use u.comp (p.comp l),
  intro x,
  refine (hu (↿f x)).trans _,
  simp [← hf],
  exact u.eval_mono ((hp _).trans $ p.eval_mono (hl _)),
end

lemma polycodable.decode_num_nodes_le (α : Type) [polycodable α] :
  ∃ p : polynomial ℕ, ∀ x y, decode α x = some y → (encode y).num_nodes ≤ p.eval x.num_nodes :=
let ⟨p, hp⟩ := @tree.polytime.num_nodes_poly (λ x, encode (decode α x)) (by complexity) in
  ⟨p, λ x y h, nat.le_of_succ_le (by simpa [h, encode, of_option] using hp x)⟩

namespace polytime

section iterate

lemma nil_node_iterate (n : ℕ) (y : tree unit) : ((λ x, tree.nil △ x)^[n] y).num_nodes = y.num_nodes + n :=
by { induction n; simp [function.iterate_succ', *], refl, }

@[complexity] lemma num_nodes : (@tree.num_nodes unit) ∈ₑ PTIME :=
⟨_, (tree.polytime.bounded_rec (tree.polytime.pair tree.polytime.nil tree.polytime.id) (⟨polynomial.X, (λ x, by { simp [nil_node_iterate], rw add_comm, cases x; simp, })⟩)).comp (tree.polytime.pair tree.polytime.id tree.polytime.nil),
  λ x, by simp [encode_nat_eq_iterate]⟩

instance : polycodable ℕ :=
⟨complexity_class.some.comp polytime.num_nodes⟩

theorem iterate_aux {n : tree unit → ℕ} {f : tree unit → tree unit → tree unit} {st : tree unit → tree unit}
  (hn : n ∈ₑ PTIME) (hf : f ∈ₑ PTIME) (hst : st ∈ₑ PTIME)
  (hf' : polysize_fun (λ (n : ℕ) (x y : tree unit), (f x)^[n] y)) : (λ x, (f x)^[n x] (st x)) ∈ₑ PTIME :=
begin
  set F : tree unit → tree unit := λ x, x.left △ (f x.left x.right),
  have hF : tree.polytime F := by { dsimp [F], complexity, },
  have hF' : ∀ n x y, F^[n] (x △ y) = x △ ((f x)^[n] y),
  { intros n x y, induction n generalizing y; simp [F, *], },
  rcases hn with ⟨n', pn, hn⟩, rcases hst with ⟨st', pst, hst⟩,
  refine ⟨_, tree.polytime.right.comp ((tree.polytime.bounded_rec hF _).comp
    (tree.polytime.pair pn (tree.polytime.pair tree.polytime.id pst))), _⟩,
  swap, { intro x, simp only [encode_unit_tree] at hn hst, simp [hF', hn, hst], },
  cases hf' with p hp,
  use polynomial.X + p + 1,
  rintro (_|⟨⟨⟩, n, xy⟩), { simp, },
  have : ∀ x y, (F^[n.num_nodes] (x △ y)).num_nodes ≤
    x.num_nodes + (p.eval $ n.num_nodes + (x.num_nodes + y.num_nodes) + 1) + 1,
  { intros x y, rw hF', specialize hp (n.num_nodes, x, y), simp [has_uncurry.uncurry, add_assoc] at hp ⊢, refine hp.trans (p.eval_mono _), simp, },
  rcases xy with (_|⟨⟨⟩, x, y⟩),
  { simp, cases n.num_nodes with n, { simp, }, refine (this _ _).trans _, simp, },
  { refine (this _ _).trans _, simp [add_assoc x.num_nodes y.num_nodes 1],
    mono*, exacts [le_add_right $ le_add_left $ le_self_add, le_self_add], },
end

theorem iterate_safe_aux {n : tree unit → ℕ} {f : tree unit → tree unit → tree unit} {st : tree unit → tree unit}
  (hn : n ∈ₑ PTIME) (hf : f ∈ₑ PTIME) (hst : st ∈ₑ PTIME)
  (hf' : polysize_safe f) : (λ x, (f x)^[n x] (st x)) ∈ₑ PTIME :=
begin
  apply iterate_aux hn hf hst,
  use polynomial.X + polynomial.X * hf'.poly,
  rintros ⟨n, x, y⟩,
  refine (hf'.size_le n x y).trans _,
  simp [has_uncurry.uncurry], mono*,
  exacts [le_add_left le_add_self, le_self_add, le_add_left le_self_add, zero_le', zero_le'],
end

local attribute [complexity] iterate_safe_aux

@[complexity] lemma nat_add : ((+) : ℕ → ℕ → ℕ) ∈ₑ PTIME :=
by { complexity using λ m n, ((encode m) △ (encode n)).num_nodes.pred, simp, }

@[complexity] lemma nat_mul : ((*) : ℕ → ℕ → ℕ) ∈ₑ PTIME :=
begin
  refine ⟨λ x, ((λ acc : tree unit, encode (x.left.num_nodes + acc.num_nodes))^[x.right.num_nodes] tree.nil), by complexity, _⟩,
  rintro ⟨m, n⟩,
  suffices : ((λ acc, encode (m + acc.num_nodes))^[n] tree.nil) = encode (m * n), { simpa [encode_prod], },
  induction n with n ih, { simp [encode], },
  simp [iterate_succ_apply', ih, nat.mul_succ, add_comm],
end

lemma encode_pred (n : ℕ) : encode n.pred = (encode n).right :=
by { cases n; simp [encode], }

@[complexity] lemma nat_tsub : (has_sub.sub : ℕ → ℕ → ℕ) ∈ₑ PTIME :=
begin
  refine ⟨λ x, tree.right^[x.right.num_nodes] x.left, by complexity, _⟩,
  rintro ⟨m, n⟩,
  suffices : (tree.right^[n] (encode m)) = encode (m - n), { simpa [encode_prod], },
  induction n with n ih, { simp, }, { simp [iterate_succ_apply', ih, nat.sub_succ, encode_pred], }
end

/-- For any fixed polynomial `p`, `p.eval` runs in polynomial time -/
lemma polynomial_eval (p : polynomial ℕ) :
  polytime.mem (λ n : ℕ, p.eval n) :=
begin
  induction p using polynomial.induction_on with p p q ih₁ ih₂ p q ih,
  { simpa using polytime.const _, },
  { simpa using nat_add.comp₂ ih₁ ih₂, },
  simpa [pow_add, ← mul_assoc] using nat_mul.comp₂ ih polytime.id',
end

@[complexity] lemma polynomial_eval' (p : polynomial ℕ) {f : α → ℕ} (hf : f ∈ₑ PTIME) :
  polytime.mem (λ x, p.eval (f x)) := (polynomial_eval p).comp hf

@[complexity] lemma nat_le : polytime.mem_pred ((≤) : ℕ → ℕ → Prop) :=
by { complexity using (λ x y, x - y = 0), rw tsub_eq_zero_iff_le, }

@[complexity] lemma nat_lt : polytime.mem_pred ((<) : ℕ → ℕ → Prop) :=
by { complexity using (λ x y, x ≤ y ∧ ¬(y ≤ x)), rw lt_iff_le_not_le, }

/- Combining these allows us to iterate a function which automatically exits when it takes too long.
Thus, even on "bad" inputs, it does not take more than polynomial time. -/
def tree.guard_size (x : tree unit) (n : ℕ) : tree unit :=
if x.num_nodes ≤ n then x else tree.nil

@[complexity] lemma tree_guard_size : tree.guard_size ∈ₑ PTIME :=
by { delta tree.guard_size, complexity, }

lemma tree.guard_size_num_nodes_le (x : tree unit) (n) : (x.guard_size n).num_nodes ≤ n :=
by { simp only [tree.guard_size], split_ifs, { assumption, }, exact zero_le', }

lemma tree.guard_size_pos (x : tree unit) {n} (h : x.num_nodes ≤ n) : x.guard_size n = x :=
by rwa [tree.guard_size, if_pos]

local attribute [-complexity] iterate_safe_aux

theorem iterate_encode_size {n : α → ℕ} {f : α → β → β} {g : α → β} : n ∈ₑ PTIME → f ∈ₑ PTIME → g ∈ₑ PTIME →
  (∃ p : polynomial ℕ, ∀ x (m ≤ n x), (encode $ (f x)^[m] (g x)).num_nodes ≤ p.eval (encode x).num_nodes) →
  polytime.mem (λ x, (f x)^[n x] (g x))
| ⟨n', pn, hn⟩ ⟨f', pf, hf⟩ ⟨g', pg, hg⟩ ⟨p, hp⟩ := begin
  refine ⟨λ x, (λ y, (f' (x △ y)).guard_size (p.eval $ x.num_nodes))^[(n' x).num_nodes] (g' x), _, _⟩,
  { rw [complexity_class.prop_iff_mem] at *, apply iterate_aux,
    { complexity, }, { complexity, }, { exact pg, },
    use p + polynomial.X,
    rintros ⟨(_|n), x, y⟩, { simp [has_uncurry.uncurry, ← add_assoc], },
    transitivity p.eval x.num_nodes,
    { simpa [-iterate_succ, iterate_succ_apply', has_uncurry.uncurry] using tree.guard_size_num_nodes_le _ _, },
    simp only [polynomial.eval_add, polynomial.eval_X],
    exact le_add_right (p.eval_mono $ le_add_left le_self_add), },
  intros x,
  dsimp only [has_uncurry.uncurry, id] at hn hf hg ⊢,
  simp only [prod.forall, encode_prod] at hf,
  simp only [hn, hg, encode_num_nodes],
  specialize hp x, revert hp, generalize : (n x) = M, intro hp,
  induction M with M ih, { simp, },
  specialize ih (λ m hm, hp m (nat.le_succ_of_le hm)), specialize hp _ rfl.le,
  simp only [iterate_succ_apply', ih, hf] at ⊢ hp,
  rwa tree.guard_size_pos,
end

theorem iterate [polysize α] [polysize β] {n : α → ℕ} {f : α → β → β} {g : α → β} (hn : n ∈ₑ PTIME)
  (hf : f ∈ₑ PTIME) (hg : g ∈ₑ PTIME) :
  (∃ p : polynomial ℕ, ∀ x (m ≤ n x), size ((f x)^[m] (g x)) ≤ p.eval (size x)) →
  polytime.mem (λ x, (f x)^[n x] (g x))
| ⟨p, hp⟩ :=
let ⟨q₁, hq₁⟩ := polysize.upper α, ⟨q₂, hq₂⟩ := polysize.lower β in
 iterate_encode_size hn hf hg ⟨q₂.comp (p.comp q₁),
 λ x m hm, by { simpa using (hq₂ _).trans (q₂.eval_mono $ (hp x m hm).trans $ p.eval_mono $ hq₁ _), }⟩

@[complexity] theorem iterate_safe [polysize α] [polysize β] {n : α → ℕ} {f : α → β → β} {g : α → β} (hn : n ∈ₑ PTIME)
  (hf : f ∈ₑ PTIME) (hg : g ∈ₑ PTIME) (hp : polysize_safe f) : polytime.mem (λ x, (f x)^[n x] (g x)) :=
let ⟨p₁, hp₁⟩ := polytime.size_le hg, ⟨p₂, hp₂⟩ := polytime.size_le hn in
iterate hn hf hg ⟨p₁ + p₂ * hp.poly, λ x m hm,
  (hp.size_le m x (g x)).trans (by { simp, mono*, exacts [hm.trans (hp₂ _), zero_le'], })⟩

end iterate

end polytime


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.punit
import category_theory.structured_arrow
import category_theory.is_connected
import category_theory.limits.yoneda
import category_theory.limits.types

/-!
# Final and initial functors

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

A functor `F : C ⥤ D` is final if for every `d : D`,
the comma category of morphisms `d ⟶ F.obj c` is connected.

Dually, a functor `F : C ⥤ D` is initial if for every `d : D`,
the comma category of morphisms `F.obj c ⟶ d` is connected.

We show that right adjoints are examples of final functors, while
left adjoints are examples of initial functors.

For final functors, we prove that the following three statements are equivalent:
1. `F : C ⥤ D` is final.
2. Every functor `G : D ⥤ E` has a colimit if and only if `F ⋙ G` does,
   and these colimits are isomorphic via `colimit.pre G F`.
3. `colimit (F ⋙ coyoneda.obj (op d)) ≅ punit`.

Starting at 1. we show (in `cocones_equiv`) that
the categories of cocones over `G : D ⥤ E` and over `F ⋙ G` are equivalent.
(In fact, via an equivalence which does not change the cocone point.)
This readily implies 2., as `comp_has_colimit`, `has_colimit_of_comp`, and `colimit_iso`.

From 2. we can specialize to `G = coyoneda.obj (op d)` to obtain 3., as `colimit_comp_coyoneda_iso`.

From 3., we prove 1. directly in `cofinal_of_colimit_comp_coyoneda_iso_punit`.

Dually, we prove that if a functor `F : C ⥤ D` is initial, then any functor `G : D ⥤ E` has a
limit if and only if `F ⋙ G` does, and these limits are isomorphic via `limit.pre G F`.

## Naming
There is some discrepancy in the literature about naming; some say 'cofinal' instead of 'final'.
The explanation for this is that the 'co' prefix here is *not* the usual category-theoretic one
indicating duality, but rather indicating the sense of "along with".

## Future work
Dualise condition 3 above and the implications 2 ⇒ 3 and 3 ⇒ 1 to initial functors.

## References
* https://stacks.math.columbia.edu/tag/09WN
* https://ncatlab.org/nlab/show/final+functor
* Borceux, Handbook of Categorical Algebra I, Section 2.11.
  (Note he reverses the roles of definition and main result relative to here!)
-/

noncomputable theory

universes v v₁ v₂ v₃ u₁ u₂ u₃

namespace category_theory

namespace functor

open opposite
open category_theory.limits

section arbitrary_universe

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

/--
A functor `F : C ⥤ D` is final if for every `d : D`, the comma category of morphisms `d ⟶ F.obj c`
is connected.

See <https://stacks.math.columbia.edu/tag/04E6>
-/
class final (F : C ⥤ D) : Prop :=
(out (d : D) : is_connected (structured_arrow d F))

attribute [instance] final.out

/--
A functor `F : C ⥤ D` is initial if for every `d : D`, the comma category of morphisms
`F.obj c ⟶ d` is connected.
-/
class initial (F : C ⥤ D) : Prop :=
(out (d : D) : is_connected (costructured_arrow F d))

attribute [instance] initial.out

instance final_op_of_initial (F : C ⥤ D) [initial F] : final F.op :=
{ out := λ d, is_connected_of_equivalent (costructured_arrow_op_equivalence F (unop d)) }

instance initial_op_of_final (F : C ⥤ D) [final F] : initial F.op :=
{ out := λ d, is_connected_of_equivalent (structured_arrow_op_equivalence F (unop d)) }

lemma final_of_initial_op (F : C ⥤ D) [initial F.op] : final F :=
{ out := λ d, @is_connected_of_is_connected_op _ _
  (is_connected_of_equivalent (structured_arrow_op_equivalence F d).symm) }

lemma initial_of_final_op (F : C ⥤ D) [final F.op] : initial F :=
{ out := λ d, @is_connected_of_is_connected_op _ _
  (is_connected_of_equivalent (costructured_arrow_op_equivalence F d).symm) }

/-- If a functor `R : D ⥤ C` is a right adjoint, it is final. -/
lemma final_of_adjunction {L : C ⥤ D} {R : D ⥤ C} (adj : L ⊣ R) : final R :=
{ out := λ c,
  let u : structured_arrow c R := structured_arrow.mk (adj.unit.app c) in
  @zigzag_is_connected _ _ ⟨u⟩ $ λ f g, relation.refl_trans_gen.trans
    (relation.refl_trans_gen.single (show zag f u, from
      or.inr ⟨structured_arrow.hom_mk ((adj.hom_equiv c f.right).symm f.hom) (by simp)⟩))
    (relation.refl_trans_gen.single (show zag u g, from
      or.inl ⟨structured_arrow.hom_mk ((adj.hom_equiv c g.right).symm g.hom) (by simp)⟩)) }

/-- If a functor `L : C ⥤ D` is a left adjoint, it is initial. -/
lemma initial_of_adjunction {L : C ⥤ D} {R : D ⥤ C} (adj : L ⊣ R) : initial L :=
{ out := λ d,
  let u : costructured_arrow L d := costructured_arrow.mk (adj.counit.app d) in
  @zigzag_is_connected _ _ ⟨u⟩ $ λ f g, relation.refl_trans_gen.trans
    (relation.refl_trans_gen.single (show zag f u, from
      or.inl ⟨costructured_arrow.hom_mk (adj.hom_equiv f.left d f.hom) (by simp)⟩))
    (relation.refl_trans_gen.single (show zag u g, from
      or.inr ⟨costructured_arrow.hom_mk (adj.hom_equiv g.left d g.hom) (by simp)⟩)) }

@[priority 100]
instance final_of_is_right_adjoint (F : C ⥤ D) [h : is_right_adjoint F] : final F :=
final_of_adjunction h.adj

@[priority 100]
instance initial_of_is_left_adjoint (F : C ⥤ D) [h : is_left_adjoint F] : initial F :=
initial_of_adjunction h.adj

namespace final

variables (F : C ⥤ D) [final F]

instance (d : D) : nonempty (structured_arrow d F) := is_connected.is_nonempty

variables {E : Type u₃} [category.{v₃} E] (G : D ⥤ E)

/--
When `F : C ⥤ D` is cofinal, we denote by `lift F d` an arbitrary choice of object in `C` such that
there exists a morphism `d ⟶ F.obj (lift F d)`.
-/
def lift (d : D) : C :=
(classical.arbitrary (structured_arrow d F)).right

/--
When `F : C ⥤ D` is cofinal, we denote by `hom_to_lift` an arbitrary choice of morphism
`d ⟶ F.obj (lift F d)`.
-/
def hom_to_lift (d : D) : d ⟶ F.obj (lift F d) :=
(classical.arbitrary (structured_arrow d F)).hom

/--
We provide an induction principle for reasoning about `lift` and `hom_to_lift`.
We want to perform some construction (usually just a proof) about
the particular choices `lift F d` and `hom_to_lift F d`,
it suffices to perform that construction for some other pair of choices
(denoted `X₀ : C` and `k₀ : d ⟶ F.obj X₀` below),
and to show how to transport such a construction
*both* directions along a morphism between such choices.
-/
def induction {d : D} (Z : Π (X : C) (k : d ⟶ F.obj X), Sort*)
  (h₁ : Π X₁ X₂ (k₁ : d ⟶ F.obj X₁) (k₂ : d ⟶ F.obj X₂) (f : X₁ ⟶ X₂),
    (k₁ ≫ F.map f = k₂) → Z X₁ k₁ → Z X₂ k₂)
  (h₂ : Π X₁ X₂ (k₁ : d ⟶ F.obj X₁) (k₂ : d ⟶ F.obj X₂) (f : X₁ ⟶ X₂),
    (k₁ ≫ F.map f = k₂) → Z X₂ k₂ → Z X₁ k₁)
  {X₀ : C} {k₀ : d ⟶ F.obj X₀} (z : Z X₀ k₀) : Z (lift F d) (hom_to_lift F d) :=
begin
  apply nonempty.some,
  apply @is_preconnected_induction _ _ _
    (λ (Y : structured_arrow d F), Z Y.right Y.hom) _ _ (structured_arrow.mk k₀) z,
  { intros j₁ j₂ f a, fapply h₁ _ _ _ _ f.right _ a, convert f.w.symm, dsimp, simp, },
  { intros j₁ j₂ f a, fapply h₂ _ _ _ _ f.right _ a, convert f.w.symm, dsimp, simp, },
end

variables {F G}

/--
Given a cocone over `F ⋙ G`, we can construct a `cocone G` with the same cocone point.
-/
@[simps]
def extend_cocone : cocone (F ⋙ G) ⥤ cocone G :=
{ obj := λ c,
  { X := c.X,
    ι :=
    { app := λ X, G.map (hom_to_lift F X) ≫ c.ι.app (lift F X),
      naturality' := λ X Y f,
      begin
        dsimp, simp,
        -- This would be true if we'd chosen `lift F X` to be `lift F Y`
        -- and `hom_to_lift F X` to be `f ≫ hom_to_lift F Y`.
        apply induction F
          (λ Z k, G.map f ≫ G.map (hom_to_lift F Y) ≫ c.ι.app (lift F Y) = G.map k ≫ c.ι.app Z),
        { intros Z₁ Z₂ k₁ k₂ g a z,
        rw [←a, functor.map_comp, category.assoc, ←functor.comp_map, c.w, z], },
        { intros Z₁ Z₂ k₁ k₂ g a z,
        rw [←a, functor.map_comp, category.assoc, ←functor.comp_map, c.w] at z,
        rw z, },
        { rw [←functor.map_comp_assoc], },
      end } },
  map := λ X Y f,
  { hom := f.hom, } }

@[simp]
lemma colimit_cocone_comp_aux (s : cocone (F ⋙ G)) (j : C) :
  G.map (hom_to_lift F (F.obj j)) ≫ s.ι.app (lift F (F.obj j)) =
    s.ι.app j :=
begin
  -- This point is that this would be true if we took `lift (F.obj j)` to just be `j`
  -- and `hom_to_lift (F.obj j)` to be `𝟙 (F.obj j)`.
  apply induction F (λ X k, G.map k ≫ s.ι.app X = (s.ι.app j : _)),
  { intros j₁ j₂ k₁ k₂ f w h, rw ←w, rw ← s.w f at h, simpa using h, },
  { intros j₁ j₂ k₁ k₂ f w h, rw ←w at h, rw ← s.w f, simpa using h, },
  { exact s.w (𝟙 _), },
end

variables (F G)

/--
If `F` is cofinal,
the category of cocones on `F ⋙ G` is equivalent to the category of cocones on `G`,
for any `G : D ⥤ E`.
-/
@[simps]
def cocones_equiv : cocone (F ⋙ G) ≌ cocone G :=
{ functor := extend_cocone,
  inverse := cocones.whiskering F,
  unit_iso := nat_iso.of_components (λ c, cocones.ext (iso.refl _) (by tidy)) (by tidy),
  counit_iso := nat_iso.of_components (λ c, cocones.ext (iso.refl _) (by tidy)) (by tidy), }.

variables {G}

/--
When `F : C ⥤ D` is cofinal, and `t : cocone G` for some `G : D ⥤ E`,
`t.whisker F` is a colimit cocone exactly when `t` is.
-/
def is_colimit_whisker_equiv (t : cocone G) : is_colimit (t.whisker F) ≃ is_colimit t :=
is_colimit.of_cocone_equiv (cocones_equiv F G).symm

/--
When `F` is cofinal, and `t : cocone (F ⋙ G)`,
`extend_cocone.obj t` is a colimit coconne exactly when `t` is.
-/
def is_colimit_extend_cocone_equiv (t : cocone (F ⋙ G)) :
  is_colimit (extend_cocone.obj t) ≃ is_colimit t :=
is_colimit.of_cocone_equiv (cocones_equiv F G)

/-- Given a colimit cocone over `G : D ⥤ E` we can construct a colimit cocone over `F ⋙ G`. -/
@[simps]
def colimit_cocone_comp (t : colimit_cocone G) :
  colimit_cocone (F ⋙ G) :=
{ cocone := _,
  is_colimit := (is_colimit_whisker_equiv F _).symm (t.is_colimit) }

@[priority 100]
instance comp_has_colimit [has_colimit G] :
  has_colimit (F ⋙ G) :=
has_colimit.mk (colimit_cocone_comp F (get_colimit_cocone G))

lemma colimit_pre_is_iso_aux {t : cocone G} (P : is_colimit t) :
  ((is_colimit_whisker_equiv F _).symm P).desc (t.whisker F) = 𝟙 t.X :=
begin
  dsimp [is_colimit_whisker_equiv],
  apply P.hom_ext,
  intro j,
  dsimp, simp,
end

instance colimit_pre_is_iso [has_colimit G] :
  is_iso (colimit.pre G F) :=
begin
  rw colimit.pre_eq (colimit_cocone_comp F (get_colimit_cocone G)) (get_colimit_cocone G),
  erw colimit_pre_is_iso_aux,
  dsimp,
  apply_instance,
end

section
variables (G)

/--
When `F : C ⥤ D` is cofinal, and `G : D ⥤ E` has a colimit, then `F ⋙ G` has a colimit also and
`colimit (F ⋙ G) ≅ colimit G`

https://stacks.math.columbia.edu/tag/04E7
-/
def colimit_iso [has_colimit G] : colimit (F ⋙ G) ≅ colimit G := as_iso (colimit.pre G F)

end

/-- Given a colimit cocone over `F ⋙ G` we can construct a colimit cocone over `G`. -/
@[simps]
def colimit_cocone_of_comp (t : colimit_cocone (F ⋙ G)) :
  colimit_cocone G :=
{ cocone := extend_cocone.obj t.cocone,
  is_colimit := (is_colimit_extend_cocone_equiv F _).symm (t.is_colimit), }

/--
When `F` is cofinal, and `F ⋙ G` has a colimit, then `G` has a colimit also.

We can't make this an instance, because `F` is not determined by the goal.
(Even if this weren't a problem, it would cause a loop with `comp_has_colimit`.)
-/
lemma has_colimit_of_comp [has_colimit (F ⋙ G)] :
  has_colimit G :=
has_colimit.mk (colimit_cocone_of_comp F (get_colimit_cocone (F ⋙ G)))

section
local attribute [instance] has_colimit_of_comp

/--
When `F` is cofinal, and `F ⋙ G` has a colimit, then `G` has a colimit also and
`colimit (F ⋙ G) ≅ colimit G`

https://stacks.math.columbia.edu/tag/04E7
-/
def colimit_iso' [has_colimit (F ⋙ G)] : colimit (F ⋙ G) ≅ colimit G := as_iso (colimit.pre G F)

end

end final
end arbitrary_universe

namespace final

variables {C : Type v} [category.{v} C] {D : Type v} [category.{v} D] (F : C ⥤ D) [final F]

/--
If the universal morphism `colimit (F ⋙ coyoneda.obj (op d)) ⟶ colimit (coyoneda.obj (op d))`
is an isomorphism (as it always is when `F` is cofinal),
then `colimit (F ⋙ coyoneda.obj (op d)) ≅ punit`
(simply because `colimit (coyoneda.obj (op d)) ≅ punit`).
-/
def colimit_comp_coyoneda_iso (d : D) [is_iso (colimit.pre (coyoneda.obj (op d)) F)] :
  colimit (F ⋙ coyoneda.obj (op d)) ≅ punit :=
as_iso (colimit.pre (coyoneda.obj (op d)) F) ≪≫ coyoneda.colimit_coyoneda_iso (op d)

/--
If `colimit (F ⋙ coyoneda.obj (op d)) ≅ punit` for all `d : D`, then `F` is cofinal.
-/
lemma cofinal_of_colimit_comp_coyoneda_iso_punit
  (I : Π d, colimit (F ⋙ coyoneda.obj (op d)) ≅ punit) : final F :=
⟨λ d, begin
  haveI : nonempty (structured_arrow d F),
  { have := (I d).inv punit.star,
    obtain ⟨j, y, rfl⟩ := limits.types.jointly_surjective'.{v v} this,
    exact ⟨structured_arrow.mk y⟩, },
  apply zigzag_is_connected,
  rintros ⟨⟨⟨⟩⟩,X₁,f₁⟩ ⟨⟨⟨⟩⟩,X₂,f₂⟩,
  dsimp at *,
  let y₁ := colimit.ι (F ⋙ coyoneda.obj (op d)) X₁ f₁,
  let y₂ := colimit.ι (F ⋙ coyoneda.obj (op d)) X₂ f₂,
  have e : y₁ = y₂,
  { apply (I d).to_equiv.injective, ext, },
  have t := types.colimit_eq.{v v} e,
  clear e y₁ y₂,
  exact zigzag_of_eqv_gen_quot_rel t,
end⟩

end final

namespace initial

variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D] (F : C ⥤ D) [initial F]

instance (d : D) : nonempty (costructured_arrow F d) := is_connected.is_nonempty

variables {E : Type u₃} [category.{v₃} E] (G : D ⥤ E)

/--
When `F : C ⥤ D` is initial, we denote by `lift F d` an arbitrary choice of object in `C` such that
there exists a morphism `F.obj (lift F d) ⟶ d`.
-/
def lift (d : D) : C := (classical.arbitrary (costructured_arrow F d)).left

/--
When `F : C ⥤ D` is initial, we denote by `hom_to_lift` an arbitrary choice of morphism
`F.obj (lift F d) ⟶ d`.
-/
def hom_to_lift (d : D) : F.obj (lift F d) ⟶ d :=
  (classical.arbitrary (costructured_arrow F d)).hom

/--
We provide an induction principle for reasoning about `lift` and `hom_to_lift`.
We want to perform some construction (usually just a proof) about
the particular choices `lift F d` and `hom_to_lift F d`,
it suffices to perform that construction for some other pair of choices
(denoted `X₀ : C` and `k₀ : F.obj X₀ ⟶ d` below),
and to show how to transport such a construction
*both* directions along a morphism between such choices.
-/
def induction {d : D} (Z : Π (X : C) (k : F.obj X ⟶ d), Sort*)
  (h₁ : Π X₁ X₂ (k₁ : F.obj X₁ ⟶ d) (k₂ : F.obj X₂ ⟶ d) (f : X₁ ⟶ X₂),
    (F.map f ≫ k₂ = k₁) → Z X₁ k₁ → Z X₂ k₂)
  (h₂ : Π X₁ X₂ (k₁ : F.obj X₁ ⟶ d) (k₂ : F.obj X₂ ⟶ d) (f : X₁ ⟶ X₂),
    (F.map f ≫ k₂ = k₁) → Z X₂ k₂ → Z X₁ k₁)
  {X₀ : C} {k₀ : F.obj X₀ ⟶ d} (z : Z X₀ k₀) : Z (lift F d) (hom_to_lift F d) :=
begin
  apply nonempty.some,
  apply @is_preconnected_induction _ _ _
    (λ Y : costructured_arrow F d, Z Y.left Y.hom) _ _ (costructured_arrow.mk k₀) z,
  { intros j₁ j₂ f a, fapply h₁ _ _ _ _ f.left _ a, convert f.w, dsimp, simp, },
  { intros j₁ j₂ f a, fapply h₂ _ _ _ _ f.left _ a, convert f.w, dsimp, simp, },
end

variables {F G}

/--
Given a cone over `F ⋙ G`, we can construct a `cone G` with the same cocone point.
-/
@[simps]
def extend_cone : cone (F ⋙ G) ⥤ cone G :=
{ obj := λ c,
  { X := c.X,
    π :=
    { app := λ d, c.π.app (lift F d) ≫ G.map (hom_to_lift F d),
      naturality' := λ X Y f,
      begin
        dsimp, simp,
        -- This would be true if we'd chosen `lift F Y` to be `lift F X`
        -- and `hom_to_lift F Y` to be `hom_to_lift F X ≫ f`.
        apply induction F (λ Z k, (c.π.app Z ≫ G.map k : c.X ⟶ _) =
          c.π.app (lift F X) ≫ G.map (hom_to_lift F X) ≫ G.map f),
        { intros Z₁ Z₂ k₁ k₂ g a z,
        rw [←a, functor.map_comp, ←functor.comp_map, ←category.assoc, ←category.assoc, c.w] at z,
        rw [z, category.assoc] },
        { intros Z₁ Z₂ k₁ k₂ g a z,
        rw [←a, functor.map_comp, ←functor.comp_map, ←category.assoc, ←category.assoc,
          c.w, z, category.assoc] },
        { rw [←functor.map_comp], },
      end } },
  map := λ X Y f,
  { hom := f.hom, } }

@[simp]
lemma limit_cone_comp_aux (s : cone (F ⋙ G)) (j : C) :
  s.π.app (lift F (F.obj j)) ≫ G.map (hom_to_lift F (F.obj j)) =
    s.π.app j :=
begin
  -- This point is that this would be true if we took `lift (F.obj j)` to just be `j`
  -- and `hom_to_lift (F.obj j)` to be `𝟙 (F.obj j)`.
  apply induction F (λ X k, s.π.app X ≫ G.map k = (s.π.app j : _)),
  { intros j₁ j₂ k₁ k₂ f w h, rw ←s.w f, rw ←w at h, simpa using h, },
  { intros j₁ j₂ k₁ k₂ f w h, rw ←s.w f at h, rw ←w, simpa using h, },
  { exact s.w (𝟙 _), },
end

variables (F G)

/--
If `F` is initial,
the category of cones on `F ⋙ G` is equivalent to the category of cones on `G`,
for any `G : D ⥤ E`.
-/
@[simps]
def cones_equiv : cone (F ⋙ G) ≌ cone G :=
{ functor := extend_cone,
  inverse := cones.whiskering F,
  unit_iso := nat_iso.of_components (λ c, cones.ext (iso.refl _) (by tidy)) (by tidy),
  counit_iso := nat_iso.of_components (λ c, cones.ext (iso.refl _) (by tidy)) (by tidy), }.

variables {G}

/--
When `F : C ⥤ D` is initial, and `t : cone G` for some `G : D ⥤ E`,
`t.whisker F` is a limit cone exactly when `t` is.
-/
def is_limit_whisker_equiv (t : cone G) : is_limit (t.whisker F) ≃ is_limit t :=
is_limit.of_cone_equiv (cones_equiv F G).symm

/--
When `F` is initial, and `t : cone (F ⋙ G)`,
`extend_cone.obj t` is a limit cone exactly when `t` is.
-/
def is_limit_extend_cone_equiv (t : cone (F ⋙ G)) :
  is_limit (extend_cone.obj t) ≃ is_limit t :=
is_limit.of_cone_equiv (cones_equiv F G)

/-- Given a limit cone over `G : D ⥤ E` we can construct a limit cone over `F ⋙ G`. -/
@[simps]
def limit_cone_comp (t : limit_cone G) :
  limit_cone (F ⋙ G) :=
{ cone := _,
  is_limit := (is_limit_whisker_equiv F _).symm (t.is_limit) }

@[priority 100]
instance comp_has_limit [has_limit G] :
  has_limit (F ⋙ G) :=
has_limit.mk (limit_cone_comp F (get_limit_cone G))

lemma limit_pre_is_iso_aux {t : cone G} (P : is_limit t) :
  ((is_limit_whisker_equiv F _).symm P).lift (t.whisker F) = 𝟙 t.X :=
begin
  dsimp [is_limit_whisker_equiv],
  apply P.hom_ext,
  intro j,
  simp,
end

instance limit_pre_is_iso [has_limit G] :
  is_iso (limit.pre G F) :=
begin
  rw limit.pre_eq (limit_cone_comp F (get_limit_cone G)) (get_limit_cone G),
  erw limit_pre_is_iso_aux,
  dsimp,
  apply_instance,
end

section
variables (G)

/--
When `F : C ⥤ D` is initial, and `G : D ⥤ E` has a limit, then `F ⋙ G` has a limit also and
`limit (F ⋙ G) ≅ limit G`

https://stacks.math.columbia.edu/tag/04E7
-/
def limit_iso [has_limit G] : limit (F ⋙ G) ≅ limit G := (as_iso (limit.pre G F)).symm

end

/-- Given a limit cone over `F ⋙ G` we can construct a limit cone over `G`. -/
@[simps]
def limit_cone_of_comp (t : limit_cone (F ⋙ G)) :
  limit_cone G :=
{ cone := extend_cone.obj t.cone,
  is_limit := (is_limit_extend_cone_equiv F _).symm (t.is_limit), }

/--
When `F` is initial, and `F ⋙ G` has a limit, then `G` has a limit also.

We can't make this an instance, because `F` is not determined by the goal.
(Even if this weren't a problem, it would cause a loop with `comp_has_limit`.)
-/
lemma has_limit_of_comp [has_limit (F ⋙ G)] :
  has_limit G :=
has_limit.mk (limit_cone_of_comp F (get_limit_cone (F ⋙ G)))

section
local attribute [instance] has_limit_of_comp

/--
When `F` is initial, and `F ⋙ G` has a limit, then `G` has a limit also and
`limit (F ⋙ G) ≅ limit G`

https://stacks.math.columbia.edu/tag/04E7
-/
def limit_iso' [has_limit (F ⋙ G)] : limit (F ⋙ G) ≅ limit G :=
(as_iso (limit.pre G F)).symm

end

end initial

end functor

end category_theory


import algebra.homology.homological_complex
import algebra.homology.additive

noncomputable theory

universes v

open category_theory category_theory.limits

variables {C D : Type*} [category C] [category D]
variables [has_zero_object C] [has_zero_object D]
variables {M : Type*} {c : complex_shape M}

/- there are already `prev_eq_zero` and `next_eq_zero`
  in `les_homology.lean`, but with extra assumptions -/
lemma homological_complex.prev_eq_zero' [has_zero_morphisms C]
  {X Y : homological_complex C c} (f : X ⟶ Y) (i : M) (h : c.prev i = none) : f.prev i = 0 :=
by { dsimp [homological_complex.hom.prev], simpa only [h], }

lemma homological_complex.next_eq_zero' [has_zero_morphisms C]
  {X Y : homological_complex C c} (f : X ⟶ Y) (i : M) (h : c.next i = none) : f.next i = 0 :=
by { dsimp [homological_complex.hom.next], simpa only [h], }

namespace category_theory

namespace functor

variables [preadditive C] [preadditive D]
variables (F : C ⥤ D) [functor.additive F] (X Y : homological_complex C c)

def obj_X_prev (i : M) : F.obj (X.X_prev i) ≅ ((F.map_homological_complex c).obj X).X_prev i :=
begin
  rcases h : c.prev i with _ | ⟨j, hij⟩,
  { exact F.map_iso (homological_complex.X_prev_iso_zero X h) ≪≫ (map_zero_object F) ≪≫
      (homological_complex.X_prev_iso_zero _ h).symm, },
  { exact F.map_iso (homological_complex.X_prev_iso X hij) ≪≫ (by refl) ≪≫
    (homological_complex.X_prev_iso _ hij).symm, },
end

lemma obj_X_prev_hom_eq (j i : M) (hij : c.rel j i) :
  (F.obj_X_prev X i).hom = F.map (homological_complex.X_prev_iso X hij).hom ≫
    (eq_to_hom (by refl)) ≫ (homological_complex.X_prev_iso _ hij).inv :=
begin
  dsimp [homological_complex.X_prev_iso, obj_X_prev],
  simp only [c.prev_eq_some hij, eq_to_iso_map, iso.refl_trans, iso.trans_hom,
    eq_to_iso.hom, iso.symm_hom, eq_to_iso.inv, eq_to_hom_map, category.id_comp],
end

@[reassoc]
lemma map_prev_iso_hom (j i : M) (hij : c.rel j i) :
  F.map (X.X_prev_iso hij).hom = (F.obj_X_prev X i).hom ≫
    (((F.map_homological_complex c).obj X).X_prev_iso hij).hom :=
by simp only [F.obj_X_prev_hom_eq X j i hij, eq_to_hom_refl,
    category.assoc, iso.inv_hom_id, category.comp_id]

def obj_X_next {M : Type*} {c : complex_shape M} (X : homological_complex C c) (i : M) :
  F.obj (X.X_next i) ≅ ((F.map_homological_complex c).obj X).X_next i :=
begin
  rcases h : c.next i with _ | ⟨j, hij⟩,
  { exact F.map_iso (homological_complex.X_next_iso_zero X h) ≪≫ (map_zero_object F) ≪≫
      (homological_complex.X_next_iso_zero _ h).symm, },
  { exact F.map_iso (homological_complex.X_next_iso X hij) ≪≫ (by refl) ≪≫
    (homological_complex.X_next_iso _ hij).symm, },
end

lemma obj_X_next_hom_eq (i j : M) (hij : c.rel i j) :
  (F.obj_X_next X i).hom = F.map (homological_complex.X_next_iso X hij).hom ≫
    (eq_to_hom (by refl)) ≫ (homological_complex.X_next_iso _ hij).inv :=
begin
  dsimp [homological_complex.X_next_iso, obj_X_next],
  simp only [c.next_eq_some hij, eq_to_iso_map, iso.refl_trans, iso.trans_hom,
    eq_to_iso.hom, iso.symm_hom, eq_to_iso.inv, eq_to_hom_map, category.id_comp],
end

@[reassoc]
lemma map_next_iso_inv (i j : M) (hij : c.rel i j) :
  F.map (X.X_next_iso hij).inv ≫ (F.obj_X_next X i).hom =
    (((F.map_homological_complex c).obj X).X_next_iso hij).inv :=
by simp only [F.obj_X_next_hom_eq X i j hij, ← F.map_comp_assoc,
    eq_to_hom_refl, category.id_comp, iso.inv_hom_id, map_id]

lemma map_d_to (i : M) :
  F.map (X.d_to i) = (F.obj_X_prev X i).hom ≫ ((F.map_homological_complex c).obj X).d_to i :=
begin
  rcases h : c.prev i with _ | ⟨j, hij⟩,
  { simp only [homological_complex.d_to_eq_zero _ h, functor.map_zero, comp_zero], },
  { rw homological_complex.d_to_eq _ hij,
    rw homological_complex.d_to_eq _ hij,
    rw ← ((F.map_homological_complex c).obj X).X_prev_iso_comp_d_to hij,
    simp only [map_comp, homological_complex.X_prev_iso_comp_d_to, map_homological_complex_obj_d,
      map_prev_iso_hom_assoc], },
end

lemma d_from_map (i : M) :
  F.map (X.d_from i) ≫ (F.obj_X_next X i).hom = ((F.map_homological_complex c).obj X).d_from i :=
begin
  rcases h : c.next i with _ | ⟨j, hij⟩,
  { simp only [homological_complex.d_from_eq_zero _ h, functor.map_zero, zero_comp], },
  { rw homological_complex.d_from_eq _ hij,
    rw homological_complex.d_from_eq _ hij,
    rw ← ((F.map_homological_complex c).obj X).d_from_comp_X_next_iso hij,
    simp only [map_comp, category.assoc, homological_complex.d_from_comp_X_next_iso,
      map_homological_complex_obj_d, map_next_iso_inv], },
end

variables {X Y}

def map_prev (f : X ⟶ Y) (i : M) :
  F.map (homological_complex.hom.prev f i) ≫ (F.obj_X_prev Y i).hom =
  (F.obj_X_prev X i).hom ≫ homological_complex.hom.prev ((F.map_homological_complex c).map f) i :=
begin
  rcases h : c.prev i with _ | ⟨j, hij⟩,
  { simp only [homological_complex.prev_eq_zero' _ _ h, functor.map_zero,
      zero_comp, comp_zero], },
  { simp only [homological_complex.hom.prev_eq _ hij,
      F.obj_X_prev_hom_eq _ j i hij,
      F.map_comp, eq_to_hom_refl, category.id_comp],
    slice_lhs 3 4 { rw [← F.map_comp, iso.inv_hom_id, F.map_id], },
    simp only [category.id_comp, map_homological_complex_map_f, category.assoc,
      iso.inv_hom_id_assoc], },
end

def map_next (f : X ⟶ Y) (i : M) :
  F.map (homological_complex.hom.next f i) ≫ (F.obj_X_next Y i).hom =
  (F.obj_X_next X i).hom ≫ homological_complex.hom.next ((F.map_homological_complex c).map f) i :=
begin
  rcases h : c.next i with _ | ⟨j, hij⟩,
  { simp only [homological_complex.next_eq_zero' _ _ h, functor.map_zero,
      zero_comp, comp_zero], },
  { simp only [homological_complex.hom.next_eq _ hij,
      F.obj_X_next_hom_eq _ i j hij, F.map_comp, eq_to_hom_refl, category.id_comp],
    slice_lhs 3 4 { rw [← F.map_comp, iso.inv_hom_id, F.map_id], },
    simp only [category.id_comp, map_homological_complex_map_f, category.assoc,
      iso.inv_hom_id_assoc], },
end

end functor

namespace nat_trans

variables [preadditive C] [preadditive D]
  {F G : C ⥤ D} [functor.additive F] [functor.additive G] (φ : F ⟶ G)
  (X : homological_complex C c)

lemma map_prev (i : M) : φ.app (X.X_prev i) ≫ (G.obj_X_prev X i).hom =
  (F.obj_X_prev X i).hom ≫
    homological_complex.hom.prev ((nat_trans.map_homological_complex φ c).app X) i :=
begin
  rcases h : c.prev i with _ | ⟨j, hij⟩,
  { suffices : φ.app (X.X_prev i) = 0,
    { simp only [this, homological_complex.prev_eq_zero' _ _ h, zero_comp, comp_zero], },
    apply is_zero.eq_zero_of_src,
    exact is_zero.of_iso (is_zero_zero _)
      (F.map_iso (X.X_prev_iso_zero h) ≪≫ F.map_zero_object), },
  { simp only [functor.obj_X_prev_hom_eq _ X j i hij,
      eq_to_hom_refl, category.id_comp, category.assoc, ← φ.naturality_assoc,
      homological_complex.hom.prev_eq _ hij, iso.inv_hom_id_assoc,
      map_homological_complex_app_f], },
end

lemma map_next (i : M) : φ.app (X.X_next i) ≫ (G.obj_X_next X i).hom =
  (F.obj_X_next X i).hom ≫
    homological_complex.hom.next ((nat_trans.map_homological_complex φ c).app X) i :=
begin
  rcases h : c.next i with _ | ⟨j, hij⟩,
  { suffices : φ.app (X.X_next i) = 0,
    { simp only [this, homological_complex.next_eq_zero' _ _ h, zero_comp, comp_zero], },
    apply is_zero.eq_zero_of_tgt,
    exact is_zero.of_iso (is_zero_zero _)
      (G.map_iso (X.X_next_iso_zero h) ≪≫ G.map_zero_object), },
  { simp only [functor.obj_X_next_hom_eq _ X i j hij,
      eq_to_hom_refl, category.id_comp, category.assoc, ← φ.naturality_assoc,
      homological_complex.hom.next_eq _ hij, iso.inv_hom_id_assoc,
      map_homological_complex_app_f], },
end

end nat_trans

end category_theory


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.int.basic
import category_theory.shift.basic
import category_theory.concrete_category.basic

/-!
# Differential objects in a category.

A differential object in a category with zero morphisms and a shift is
an object `X` equipped with
a morphism `d : X ⟶ X⟦1⟧`, such that `d^2 = 0`.

We build the category of differential objects, and some basic constructions
such as the forgetful functor, zero morphisms and zero objects, and the shift functor
on differential objects.
-/

open category_theory.limits

universes v u

namespace category_theory

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

-- TODO: generalize to `has_shift C A` for an arbitrary `[add_monoid A]` `[has_one A]`.
variables [has_zero_morphisms C] [has_shift C ℤ]

/--
A differential object in a category with zero morphisms and a shift is
an object `X` equipped with
a morphism `d : X ⟶ X⟦1⟧`, such that `d^2 = 0`.
-/
@[nolint has_nonempty_instance]
structure differential_object :=
(X : C)
(d : X ⟶ X⟦1⟧)
(d_squared' : d ≫ d⟦(1:ℤ)⟧' = 0 . obviously)

restate_axiom differential_object.d_squared'
attribute [simp] differential_object.d_squared

variables {C}

namespace differential_object

/--
A morphism of differential objects is a morphism commuting with the differentials.
-/
@[ext, nolint has_nonempty_instance]
structure hom (X Y : differential_object C) :=
(f : X.X ⟶ Y.X)
(comm' : X.d ≫ f⟦1⟧' = f ≫ Y.d . obviously)

restate_axiom hom.comm'
attribute [simp, reassoc] hom.comm

namespace hom

/-- The identity morphism of a differential object. -/
@[simps]
def id (X : differential_object C) : hom X X :=
{ f := 𝟙 X.X }

/-- The composition of morphisms of differential objects. -/
@[simps]
def comp {X Y Z : differential_object C} (f : hom X Y) (g : hom Y Z) : hom X Z :=
{ f := f.f ≫ g.f, }

end hom

instance category_of_differential_objects : category (differential_object C) :=
{ hom := hom,
  id := hom.id,
  comp := λ X Y Z f g, hom.comp f g, }

@[simp]

@[simp]
lemma comp_f {X Y Z : differential_object C} (f : X ⟶ Y) (g : Y ⟶ Z) :
  (f ≫ g).f = f.f ≫ g.f :=
rfl

@[simp]
lemma eq_to_hom_f {X Y : differential_object C} (h : X = Y) :
  hom.f (eq_to_hom h) = eq_to_hom (congr_arg _ h) :=
by { subst h, rw [eq_to_hom_refl, eq_to_hom_refl], refl }

variables (C)

/-- The forgetful functor taking a differential object to its underlying object. -/
def forget : (differential_object C) ⥤ C :=
{ obj := λ X, X.X,
  map := λ X Y f, f.f, }

instance forget_faithful : faithful (forget C) :=
{ }

instance has_zero_morphisms : has_zero_morphisms (differential_object C) :=
{ has_zero := λ X Y,
  ⟨{ f := 0 }⟩}

variables {C}

@[simp]
lemma zero_f (P Q : differential_object C) : (0 : P ⟶ Q).f = 0 := rfl

/--
An isomorphism of differential objects gives an isomorphism of the underlying objects.
-/
@[simps] def iso_app {X Y : differential_object C} (f : X ≅ Y) : X.X ≅ Y.X :=
⟨f.hom.f, f.inv.f, by { dsimp, rw [← comp_f, iso.hom_inv_id, id_f] },
  by { dsimp, rw [← comp_f, iso.inv_hom_id, id_f] }⟩

@[simp] lemma iso_app_refl (X : differential_object C) : iso_app (iso.refl X) = iso.refl X.X := rfl
@[simp] lemma iso_app_symm {X Y : differential_object C} (f : X ≅ Y) :
  iso_app f.symm = (iso_app f).symm := rfl
@[simp] lemma iso_app_trans {X Y Z : differential_object C} (f : X ≅ Y) (g : Y ≅ Z) :
  iso_app (f ≪≫ g) = iso_app f ≪≫ iso_app g := rfl

/-- An isomorphism of differential objects can be constructed
from an isomorphism of the underlying objects that commutes with the differentials. -/
@[simps] def mk_iso {X Y : differential_object C}
  (f : X.X ≅ Y.X) (hf : X.d ≫ f.hom⟦1⟧' = f.hom ≫ Y.d) : X ≅ Y :=
{ hom := ⟨f.hom, hf⟩,
  inv := ⟨f.inv, by { dsimp, rw [← functor.map_iso_inv, iso.comp_inv_eq, category.assoc,
    iso.eq_inv_comp, functor.map_iso_hom, hf] }⟩,
  hom_inv_id' := by { ext1, dsimp, exact f.hom_inv_id },
  inv_hom_id' := by { ext1, dsimp, exact f.inv_hom_id } }

end differential_object

namespace functor

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

/--
A functor `F : C ⥤ D` which commutes with shift functors on `C` and `D` and preserves zero morphisms
can be lifted to a functor `differential_object C ⥤ differential_object D`.
-/
@[simps]
def map_differential_object (F : C ⥤ D)
  (η : (shift_functor C (1:ℤ)).comp F ⟶ F.comp (shift_functor D (1:ℤ)))
  (hF : ∀ c c', F.map (0 : c ⟶ c') = 0) :
  differential_object C ⥤ differential_object D :=
{ obj := λ X, { X := F.obj X.X,
    d := F.map X.d ≫ η.app X.X,
    d_squared' := begin
      rw [functor.map_comp, ← functor.comp_map F (shift_functor D (1:ℤ))],
      slice_lhs 2 3 { rw [← η.naturality X.d] },
      rw [functor.comp_map],
      slice_lhs 1 2 { rw [← F.map_comp, X.d_squared, hF] },
      rw [zero_comp, zero_comp],
    end },
  map := λ X Y f, { f := F.map f.f,
    comm' := begin
      dsimp,
      slice_lhs 2 3 { rw [← functor.comp_map F (shift_functor D (1:ℤ)), ← η.naturality f.f] },
      slice_lhs 1 2 { rw [functor.comp_map, ← F.map_comp, f.comm, F.map_comp] },
      rw [category.assoc]
    end },
  map_id' := by { intros, ext, simp },
  map_comp' := by { intros, ext, simp }, }

end functor

end category_theory

namespace category_theory

namespace differential_object

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

variables [has_zero_object C] [has_zero_morphisms C] [has_shift C ℤ]

open_locale zero_object

instance has_zero_object : has_zero_object (differential_object C) :=
by { refine ⟨⟨⟨0, 0⟩, λ X, ⟨⟨⟨⟨0⟩⟩, λ f, _⟩⟩, λ X, ⟨⟨⟨⟨0⟩⟩, λ f, _⟩⟩⟩⟩; ext, }

end differential_object

namespace differential_object

variables (C : Type (u+1)) [large_category C] [concrete_category C]
  [has_zero_morphisms C] [has_shift C ℤ]

instance concrete_category_of_differential_objects :
  concrete_category (differential_object C) :=
{ forget := forget C ⋙ category_theory.forget C }

instance : has_forget₂ (differential_object C) C :=
{ forget₂ := forget C }

end differential_object

/-! The category of differential objects itself has a shift functor. -/
namespace differential_object

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

noncomputable theory

/-- The shift functor on `differential_object C`. -/
@[simps]
def shift_functor (n : ℤ) : differential_object C ⥤ differential_object C :=
{ obj := λ X,
  { X := X.X⟦n⟧,
    d := X.d⟦n⟧' ≫ (shift_comm _ _ _).hom,
    d_squared' := by rw [functor.map_comp, category.assoc, shift_comm_hom_comp_assoc,
        ←functor.map_comp_assoc, X.d_squared, functor.map_zero, zero_comp] },
  map := λ X Y f,
  { f := f.f⟦n⟧',
    comm' := begin
      dsimp,
      erw [category.assoc, shift_comm_hom_comp, ← functor.map_comp_assoc, f.comm,
        functor.map_comp_assoc],
      refl,
    end, },
  map_id' := by { intros X, ext1, dsimp, rw functor.map_id },
  map_comp' := by { intros X Y Z f g, ext1, dsimp, rw functor.map_comp } }

/-- The shift functor on `differential_object C` is additive. -/
@[simps] def shift_functor_add (m n : ℤ) :
  shift_functor C (m + n) ≅ shift_functor C m ⋙ shift_functor C n :=
begin
  refine nat_iso.of_components (λ X, mk_iso (shift_add X.X _ _) _) _,
  { dsimp,
    rw [← cancel_epi ((shift_functor_add C m n).inv.app X.X)],
    simp only [category.assoc, iso.inv_hom_id_app_assoc],
    erw [← nat_trans.naturality_assoc],
    dsimp,
    simp only [functor.map_comp, category.assoc,
      shift_functor_comm_hom_app_comp_shift_shift_functor_add_hom_app 1 m n X.X,
      iso.inv_hom_id_app_assoc], },
  { intros X Y f, ext, dsimp, exact nat_trans.naturality _ _ }
end

section

/-- The shift by zero is naturally isomorphic to the identity. -/
@[simps]
def shift_zero : shift_functor C 0 ≅ 𝟭 (differential_object C) :=
begin
  refine nat_iso.of_components (λ X, mk_iso ((shift_functor_zero C ℤ).app X.X) _) _,
  { erw [← nat_trans.naturality],
    dsimp,
    simp only [shift_functor_zero_hom_app_shift, category.assoc], },
  { tidy, },
end

end

instance : has_shift (differential_object C) ℤ :=
has_shift_mk _ _
{ F := shift_functor C,
  zero := shift_zero C,
  add := shift_functor_add C,
  assoc_hom_app := λ m₁ m₂ m₃ X, begin
    ext1,
    convert shift_functor_add_assoc_hom_app m₁ m₂ m₃ X.X,
    dsimp [shift_functor_add'],
    simpa,
  end,
  zero_add_hom_app := λ n X, begin
    ext1,
    convert shift_functor_add_zero_add_hom_app n X.X,
    simpa,
  end,
  add_zero_hom_app := λ n X, begin
    ext1,
    convert shift_functor_add_add_zero_hom_app n X.X,
    simpa,
  end, }

end differential_object

end category_theory


/-
  Copyright (c) 2022 Arthur Paulino. All rights reserved.
  Released under Apache 2.0 license as described in the file LICENSE.
  Authors: Arthur Paulino
-/

import DataEntries
import Utils

inductive DataType
  | TInt
  | TFloat
  | TString
  deriving Inhabited

/- Prouces a `DataEntry` given its `DataType` and a `String` -/
def DataType.entryOfString! (dataType : DataType) (s : String) : DataEntry :=
  if s = "NULL" then NIL
  else match dataType with
  | DataType.TInt    => s.toInt!
  | DataType.TFloat  => toFloat! s
  | DataType.TString => s

open DataType in
/- Whether a `DataEntry` is of a `DataType` or not -/
@[simp] def DataEntry.ofType : DataEntry → DataType → Bool
  | EInt _,    TInt    => true
  | EFloat _,  TFloat  => true
  | EString _, TString => true
  | ENull,     _       => true
  | _,         _       => false

instance : ToString DataEntry where
  toString e := e.toString

abbrev Header := List (DataType × String)

/- Returns the column types of a `Header` -/
def Header.colTypes (h : Header) : List DataType :=
  h.map fun x => x.1

/- Returns the column names of a `Header` -/
def Header.colNames (h : Header) : List String :=
  h.map fun x => x.2

abbrev DataEntries := List DataEntry

/- Given a list of `DataEntry` and a list of `DataType`, tells whether
  every `DataEntry` is of `DataType` in a "zip" logic -/
@[simp] def DataEntries.ofTypes : DataEntries → List DataType → Bool
  | e :: es, t :: ts => e.ofType t && ofTypes es ts
  | [],      []      => true
  | _,       _       => false

/-- Given a list of `DataType`, turns a list of `String` into a list of
  `DataEntry` according to the respective type from the list -/
def entriesOfStrings! : List DataType → List String → DataEntries
  | t :: ts, s :: ss => t.entryOfString! s :: (entriesOfStrings! ts ss)
  | _,       _       => []

/- Whether every list of `DataEntry` obeys to `DataEntries.ofTypes` -/
@[simp] def rowsOfTypes : List DataEntries → List DataType → Prop
  | row :: rows, types => row.ofTypes types ∧ rowsOfTypes rows types
  | [],          _     => True

/- Turns a list of `DataEntry` into a list of their respective `String`
  representation-/
def DataEntries.toStrings (r : DataEntries) : List String :=
  r.map DataEntry.toString

/- A DataFrame consists of:
  * A header, containing the column names and their types
  * The rows, containing the actual data
  * A consistenty rule, guaranteeing that every row obeys to the scheme -/
structure DataFrame where
  header     : Header
  rows       : List DataEntries
  consistent : rowsOfTypes rows header.colTypes := by simp

namespace DataFrame

/- The column types of a `DataFrame` -/
def colTypes (df : DataFrame) : List DataType :=
  df.header.colTypes

/- The column names of a `DataFrame` -/
def colNames (df : DataFrame) : List String :=
  df.header.colNames

/- Returns an empty `DataFrame` -/
def empty (header : Header := []) : DataFrame :=
  ⟨header, [], by simp⟩

/- Given a `DataFrame` `df` and a new `Row` `r` that's consistent with its
  scheme, the concatenation of the `df.rows` and `r` is also consistent
  with the scheme of `df` -/
theorem consistentConcatOfConsistentRow
    {df : DataFrame} (row : DataEntries)
    (hc : row.ofTypes df.colTypes) :
      rowsOfTypes (df.rows.concat row) (Header.colTypes df.header) :=
  match df with
    | ⟨_, rows, hr⟩ => by
      induction rows with
        | nil         => simp only [colTypes] at hc; simp [hc]
        | cons _ _ hi => exact ⟨hr.1, hi hr.2 hc⟩

/- Adds a new row on a `DataFrame` -/
def addRow (df : DataFrame) (row : DataEntries)
    (h : row.ofTypes df.colTypes := by simp) : DataFrame :=
  ⟨df.header, df.rows.concat row, consistentConcatOfConsistentRow row h⟩

/- The number of rows in a `DataFrame` -/
def nRows (df : DataFrame) : Nat :=
  df.rows.length

/- The number of columns in a `DataFrame` -/
def nCols (df : DataFrame) : Nat :=
  df.header.length

/- The shape of a `DataFrame` (# of rows × # of columns) -/
def shape (df : DataFrame) : Nat × Nat :=
  (df.nRows, df.nCols)

/- The i-th row of a `DataFrame` -/
def row! (df : DataFrame) (i : Nat) : DataEntries :=
  if i >= df.rows.length then
    panic! s!"invalid index {i}"
  else
    (df.rows.get! i)

/- The i-th's rows of a `DataFrame` -/
def rows! (df : DataFrame) (li : List Nat) : List DataEntries := Id.run do
  let mut invalidIndexes : List Nat := []
  for i in li do
    if i >= df.rows.length then
      invalidIndexes := invalidIndexes.concat i
  if ¬invalidIndexes.isEmpty then
    panic! s!"invalid indexes {invalidIndexes}"
  else
    li.map fun i => df.row! i

/- The j-th column of a `DataFrame` -/
def col! (df : DataFrame) (j : Nat) : DataEntries :=
  if j >= df.header.length then
    panic! s!"invalid index {j}"
  else
    df.rows.map fun r => r.get! j

/- The j-th's columns of a `DataFrame` -/
def cols! (df : DataFrame) (lj : List Nat) : List DataEntries := Id.run do
  let mut invalidIndexes : List Nat := []
  for j in lj do
    if j >= df.header.length then
      invalidIndexes := invalidIndexes.concat j
  if ¬invalidIndexes.isEmpty then
    panic! s!"invalid indexes {invalidIndexes}"
  else
    lj.map fun j => df.col! j

/- The element at the i-th row and j-th column -/
def at! (df : DataFrame) (i j : Nat) : DataEntry :=
  if i >= df.rows.length then
    panic! s!"invalid row index {i}"
  else
    if j >= df.header.length then
      panic! s!"invalid column index {j}"
    else
      (df.row! i).get! j

/- The `String` representation of a `DataFrame` -/
def toString (df : DataFrame) : String := Id.run do
  if df.nCols = 0 then ""
  else
    let mut cells : List (List String) := []
    let mut colLengths : List Nat := []
    let mut header : List String := []
    for colName in df.colNames do
      colLengths := colLengths.concat colName.length
      header := header.concat colName
    cells := cells.concat header
    for row in df.rows do
      let mut line : List String := []
      let rowStrings : List String := row.toStrings
      for j in [0 : rowStrings.length] do
        let s := rowStrings.get! j
        let s_length : Nat := s.length
        if s_length > (colLengths.get! j) then
          colLengths := colLengths.set j s_length
        line := line.concat s
      cells := cells.concat line
    let mut res : String := ""
    for i in [0 : cells.length] do
      let row := cells.get! i
      for j in [0 : row.length] do
        let val : String := row.get! j
        res := res ++ "|" ++
          (leftFillWithUntil val ' ' (colLengths.get! j))
      res := res ++ "|"
      if cells.length = 1 ∨ i < cells.length - 1 then
        res := res ++ "\n"
      if i = 0 then
        for j in [0 : row.length] do
          res := res ++ "|" ++
            leftFillWithUntil "" '-' (colLengths.get! j)
        res := res ++ "|\n"
    res

instance : ToString DataFrame where
  toString df := df.toString

end DataFrame