/-
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

! This file was ported from Lean 3 source module algebraic_topology.split_simplicial_object
! leanprover-community/mathlib commit dd1f8496baa505636a82748e6b652165ea888733
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicTopology.SimplicialObject
import Mathbin.CategoryTheory.Limits.Shapes.FiniteProducts

/-!

# Split simplicial objects

In this file, we introduce the notion of split simplicial object.
If `C` is a category that has finite coproducts, a splitting
`s : splitting X` of a simplical object `X` in `C` consists
of the datum of a sequence of objects `s.N : ℕ → C` (which
we shall refer to as "nondegenerate simplices") and a
sequence of morphisms `s.ι n : s.N n → X _[n]` that have
the property that a certain canonical map identifies `X _[n]`
with the coproduct of objects `s.N i` indexed by all possible
epimorphisms `[n] ⟶ [i]` in `simplex_category`. (We do not
assume that the morphisms `s.ι n` are monomorphisms: in the
most common categories, this would be a consequence of the
axioms.)

Simplicial objects equipped with a splitting form a category
`simplicial_object.split C`.

## References
* [Stacks: Splitting simplicial objects] https://stacks.math.columbia.edu/tag/017O

-/

noncomputable section

open CategoryTheory CategoryTheory.Category CategoryTheory.Limits Opposite SimplexCategory

open Simplicial

universe u

variable {C : Type _} [Category C]

namespace SimplicialObject

namespace Splitting

/-- The index set which appears in the definition of split simplicial objects. -/
def IndexSet (Δ : SimplexCategoryᵒᵖ) :=
  ΣΔ' : SimplexCategoryᵒᵖ, { α : Δ.unop ⟶ Δ'.unop // Epi α }
#align simplicial_object.splitting.index_set SimplicialObject.Splitting.IndexSet

namespace IndexSet

/-- The element in `splitting.index_set Δ` attached to an epimorphism `f : Δ ⟶ Δ'`. -/
@[simps]
def mk {Δ Δ' : SimplexCategory} (f : Δ ⟶ Δ') [Epi f] : IndexSet (op Δ) :=
  ⟨op Δ', f, inferInstance⟩
#align simplicial_object.splitting.index_set.mk SimplicialObject.Splitting.IndexSet.mk

variable {Δ' Δ : SimplexCategoryᵒᵖ} (A : IndexSet Δ) (θ : Δ ⟶ Δ')

/-- The epimorphism in `simplex_category` associated to `A : splitting.index_set Δ` -/
def e :=
  A.2.1
#align simplicial_object.splitting.index_set.e SimplicialObject.Splitting.IndexSet.e

instance : Epi A.e :=
  A.2.2

theorem ext' : A = ⟨A.1, ⟨A.e, A.2.2⟩⟩ := by tidy
#align simplicial_object.splitting.index_set.ext' SimplicialObject.Splitting.IndexSet.ext'

theorem ext (A₁ A₂ : IndexSet Δ) (h₁ : A₁.1 = A₂.1) (h₂ : A₁.e ≫ eqToHom (by rw [h₁]) = A₂.e) :
    A₁ = A₂ := by
  rcases A₁ with ⟨Δ₁, ⟨α₁, hα₁⟩⟩
  rcases A₂ with ⟨Δ₂, ⟨α₂, hα₂⟩⟩
  simp only at h₁
  subst h₁
  simp only [eq_to_hom_refl, comp_id, index_set.e] at h₂
  simp only [h₂]
#align simplicial_object.splitting.index_set.ext SimplicialObject.Splitting.IndexSet.ext

instance : Fintype (IndexSet Δ) :=
  Fintype.ofInjective
    (fun A =>
      ⟨⟨A.1.unop.len, Nat.lt_succ_iff.mpr (len_le_of_epi (inferInstance : Epi A.e))⟩,
        A.e.toOrderHom⟩ :
      IndexSet Δ → Sigma fun k : Fin (Δ.unop.len + 1) => Fin (Δ.unop.len + 1) → Fin (k + 1))
    (by
      rintro ⟨Δ₁, α₁⟩ ⟨Δ₂, α₂⟩ h₁
      induction Δ₁ using Opposite.rec
      induction Δ₂ using Opposite.rec
      simp only at h₁
      have h₂ : Δ₁ = Δ₂ := by
        ext1
        simpa only [Fin.mk_eq_mk] using h₁.1
      subst h₂
      refine' ext _ _ rfl _
      ext : 2
      exact eq_of_hEq h₁.2)

variable (Δ)

/-- The distinguished element in `splitting.index_set Δ` which corresponds to the
identity of `Δ`. -/
def id : IndexSet Δ :=
  ⟨Δ, ⟨𝟙 _, by infer_instance⟩⟩
#align simplicial_object.splitting.index_set.id SimplicialObject.Splitting.IndexSet.id

instance : Inhabited (IndexSet Δ) :=
  ⟨id Δ⟩

variable {Δ}

/-- The condition that an element `splitting.index_set Δ` is the distinguished
element `splitting.index_set.id Δ`. -/
@[simp]
def EqId : Prop :=
  A = id _
#align simplicial_object.splitting.index_set.eq_id SimplicialObject.Splitting.IndexSet.EqId

theorem eqId_iff_eq : A.EqId ↔ A.1 = Δ := by
  constructor
  · intro h
    dsimp at h
    rw [h]
    rfl
  · intro h
    rcases A with ⟨Δ', ⟨f, hf⟩⟩
    simp only at h
    subst h
    refine' ext _ _ rfl _
    · haveI := hf
      simp only [eq_to_hom_refl, comp_id]
      exact eq_id_of_epi f
#align simplicial_object.splitting.index_set.eq_id_iff_eq SimplicialObject.Splitting.IndexSet.eqId_iff_eq

theorem eqId_iff_len_eq : A.EqId ↔ A.1.unop.len = Δ.unop.len :=
  by
  rw [eq_id_iff_eq]
  constructor
  · intro h
    rw [h]
  · intro h
    rw [← unop_inj_iff]
    ext
    exact h
#align simplicial_object.splitting.index_set.eq_id_iff_len_eq SimplicialObject.Splitting.IndexSet.eqId_iff_len_eq

theorem eqId_iff_len_le : A.EqId ↔ Δ.unop.len ≤ A.1.unop.len :=
  by
  rw [eq_id_iff_len_eq]
  constructor
  · intro h
    rw [h]
  · exact le_antisymm (len_le_of_epi (inferInstance : epi A.e))
#align simplicial_object.splitting.index_set.eq_id_iff_len_le SimplicialObject.Splitting.IndexSet.eqId_iff_len_le

theorem eqId_iff_mono : A.EqId ↔ Mono A.e :=
  by
  constructor
  · intro h
    dsimp at h
    subst h
    dsimp only [id, e]
    infer_instance
  · intro h
    rw [eq_id_iff_len_le]
    exact len_le_of_mono h
#align simplicial_object.splitting.index_set.eq_id_iff_mono SimplicialObject.Splitting.IndexSet.eqId_iff_mono

/-- Given `A : index_set Δ₁`, if `p.unop : unop Δ₂ ⟶ unop Δ₁` is an epi, this
is the obvious element in `A : index_set Δ₂` associated to the composition
of epimorphisms `p.unop ≫ A.e`. -/
@[simps]
def epiComp {Δ₁ Δ₂ : SimplexCategoryᵒᵖ} (A : IndexSet Δ₁) (p : Δ₁ ⟶ Δ₂) [Epi p.unop] :
    IndexSet Δ₂ :=
  ⟨A.1, ⟨p.unop ≫ A.e, epi_comp _ _⟩⟩
#align simplicial_object.splitting.index_set.epi_comp SimplicialObject.Splitting.IndexSet.epiComp

/-- When `A : index_set Δ` and `θ : Δ → Δ'` is a morphism in `simplex_categoryᵒᵖ`,
an element in `index_set Δ'` can be defined by using the epi-mono factorisation
of `θ.unop ≫ A.e`. -/
def pull : IndexSet Δ' :=
  mk (factorThruImage (θ.unop ≫ A.e))
#align simplicial_object.splitting.index_set.pull SimplicialObject.Splitting.IndexSet.pull

@[reassoc.1]
theorem fac_pull : (A.pull θ).e ≫ image.ι (θ.unop ≫ A.e) = θ.unop ≫ A.e :=
  image.fac _
#align simplicial_object.splitting.index_set.fac_pull SimplicialObject.Splitting.IndexSet.fac_pull

end IndexSet

variable (N : ℕ → C) (Δ : SimplexCategoryᵒᵖ) (X : SimplicialObject C) (φ : ∀ n, N n ⟶ X _[n])

/-- Given a sequences of objects `N : ℕ → C` in a category `C`, this is
a family of objects indexed by the elements `A : splitting.index_set Δ`.
The `Δ`-simplices of a split simplicial objects shall identify to the
coproduct of objects in such a family. -/
@[simp, nolint unused_arguments]
def summand (A : IndexSet Δ) : C :=
  N A.1.unop.len
#align simplicial_object.splitting.summand SimplicialObject.Splitting.summand

variable [HasFiniteCoproducts C]

/-- The coproduct of the family `summand N Δ` -/
@[simp]
def coprod :=
  ∐ summand N Δ
#align simplicial_object.splitting.coprod SimplicialObject.Splitting.coprod

variable {Δ}

/-- The inclusion of a summand in the coproduct. -/
@[simp]
def ιCoprod (A : IndexSet Δ) : N A.1.unop.len ⟶ coprod N Δ :=
  Sigma.ι _ A
#align simplicial_object.splitting.ι_coprod SimplicialObject.Splitting.ιCoprod

variable {N}

/-- The canonical morphism `coprod N Δ ⟶ X.obj Δ` attached to a sequence
of objects `N` and a sequence of morphisms `N n ⟶ X _[n]`. -/
@[simp]
def map (Δ : SimplexCategoryᵒᵖ) : coprod N Δ ⟶ X.obj Δ :=
  Sigma.desc fun A => φ A.1.unop.len ≫ X.map A.e.op
#align simplicial_object.splitting.map SimplicialObject.Splitting.map

end Splitting

variable [HasFiniteCoproducts C]

/-- A splitting of a simplicial object `X` consists of the datum of a sequence
of objects `N`, a sequence of morphisms `ι : N n ⟶ X _[n]` such that
for all `Δ : simplex_categoryhᵒᵖ`, the canonical map `splitting.map X ι Δ`
is an isomorphism. -/
@[nolint has_nonempty_instance]
structure Splitting (X : SimplicialObject C) where
  n : ℕ → C
  ι : ∀ n, N n ⟶ X _[n]
  map_is_iso' : ∀ Δ : SimplexCategoryᵒᵖ, IsIso (Splitting.map X ι Δ)
#align simplicial_object.splitting SimplicialObject.Splitting

namespace Splitting

variable {X Y : SimplicialObject C} (s : Splitting X)

instance map_isIso (Δ : SimplexCategoryᵒᵖ) : IsIso (Splitting.map X s.ι Δ) :=
  s.map_is_iso' Δ
#align simplicial_object.splitting.map_is_iso SimplicialObject.Splitting.map_isIso

/-- The isomorphism on simplices given by the axiom `splitting.map_is_iso'` -/
@[simps]
def iso (Δ : SimplexCategoryᵒᵖ) : coprod s.n Δ ≅ X.obj Δ :=
  asIso (Splitting.map X s.ι Δ)
#align simplicial_object.splitting.iso SimplicialObject.Splitting.iso

/-- Via the isomorphism `s.iso Δ`, this is the inclusion of a summand
in the direct sum decomposition given by the splitting `s : splitting X`. -/
def ιSummand {Δ : SimplexCategoryᵒᵖ} (A : IndexSet Δ) : s.n A.1.unop.len ⟶ X.obj Δ :=
  Splitting.ιCoprod s.n A ≫ (s.Iso Δ).Hom
#align simplicial_object.splitting.ι_summand SimplicialObject.Splitting.ιSummand

@[reassoc.1]
theorem ιSummand_eq {Δ : SimplexCategoryᵒᵖ} (A : IndexSet Δ) :
    s.ιSummand A = s.ι A.1.unop.len ≫ X.map A.e.op :=
  by
  dsimp only [ι_summand, iso.hom]
  erw [colimit.ι_desc, cofan.mk_ι_app]
#align simplicial_object.splitting.ι_summand_eq SimplicialObject.Splitting.ιSummand_eq

theorem ιSummand_id (n : ℕ) : s.ιSummand (IndexSet.id (op [n])) = s.ι n :=
  by
  erw [ι_summand_eq, X.map_id, comp_id]
  rfl
#align simplicial_object.splitting.ι_summand_id SimplicialObject.Splitting.ιSummand_id

/-- As it is stated in `splitting.hom_ext`, a morphism `f : X ⟶ Y` from a split
simplicial object to any simplicial object is determined by its restrictions
`s.φ f n : s.N n ⟶ Y _[n]` to the distinguished summands in each degree `n`. -/
@[simp]
def φ (f : X ⟶ Y) (n : ℕ) : s.n n ⟶ Y _[n] :=
  s.ι n ≫ f.app (op [n])
#align simplicial_object.splitting.φ SimplicialObject.Splitting.φ

@[simp, reassoc.1]
theorem ιSummand_comp_app (f : X ⟶ Y) {Δ : SimplexCategoryᵒᵖ} (A : IndexSet Δ) :
    s.ιSummand A ≫ f.app Δ = s.φ f A.1.unop.len ≫ Y.map A.e.op := by
  simp only [ι_summand_eq_assoc, φ, nat_trans.naturality, assoc]
#align simplicial_object.splitting.ι_summand_comp_app SimplicialObject.Splitting.ιSummand_comp_app

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:73:14: unsupported tactic `discrete_cases #[] -/
theorem hom_ext' {Z : C} {Δ : SimplexCategoryᵒᵖ} (f g : X.obj Δ ⟶ Z)
    (h : ∀ A : IndexSet Δ, s.ιSummand A ≫ f = s.ιSummand A ≫ g) : f = g :=
  by
  rw [← cancel_epi (s.iso Δ).Hom]
  ext A
  trace
    "./././Mathport/Syntax/Translate/Tactic/Builtin.lean:73:14: unsupported tactic `discrete_cases #[]"
  simpa only [ι_summand_eq, iso_hom, colimit.ι_desc_assoc, cofan.mk_ι_app, assoc] using h A
#align simplicial_object.splitting.hom_ext' SimplicialObject.Splitting.hom_ext'

theorem hom_ext (f g : X ⟶ Y) (h : ∀ n : ℕ, s.φ f n = s.φ g n) : f = g :=
  by
  ext Δ
  apply s.hom_ext'
  intro A
  induction Δ using Opposite.rec
  induction' Δ using SimplexCategory.rec with n
  dsimp
  simp only [s.ι_summand_comp_app, h]
#align simplicial_object.splitting.hom_ext SimplicialObject.Splitting.hom_ext

/-- The map `X.obj Δ ⟶ Z` obtained by providing a family of morphisms on all the
terms of decomposition given by a splitting `s : splitting X`  -/
def desc {Z : C} (Δ : SimplexCategoryᵒᵖ) (F : ∀ A : IndexSet Δ, s.n A.1.unop.len ⟶ Z) :
    X.obj Δ ⟶ Z :=
  (s.Iso Δ).inv ≫ Sigma.desc F
#align simplicial_object.splitting.desc SimplicialObject.Splitting.desc

@[simp, reassoc.1]
theorem ι_desc {Z : C} (Δ : SimplexCategoryᵒᵖ) (F : ∀ A : IndexSet Δ, s.n A.1.unop.len ⟶ Z)
    (A : IndexSet Δ) : s.ιSummand A ≫ s.desc Δ F = F A :=
  by
  dsimp only [ι_summand, desc]
  simp only [assoc, iso.hom_inv_id_assoc, ι_coprod]
  erw [colimit.ι_desc, cofan.mk_ι_app]
#align simplicial_object.splitting.ι_desc SimplicialObject.Splitting.ι_desc

/-- A simplicial object that is isomorphic to a split simplicial object is split. -/
@[simps]
def ofIso (e : X ≅ Y) : Splitting Y where
  n := s.n
  ι n := s.ι n ≫ e.Hom.app (op [n])
  map_is_iso' Δ := by
    convert(inferInstance : is_iso ((s.iso Δ).Hom ≫ e.hom.app Δ))
    tidy
#align simplicial_object.splitting.of_iso SimplicialObject.Splitting.ofIso

@[reassoc.1]
theorem ιSummand_epi_naturality {Δ₁ Δ₂ : SimplexCategoryᵒᵖ} (A : IndexSet Δ₁) (p : Δ₁ ⟶ Δ₂)
    [Epi p.unop] : s.ιSummand A ≫ X.map p = s.ιSummand (A.epi_comp p) :=
  by
  dsimp [ι_summand]
  erw [colimit.ι_desc, colimit.ι_desc, cofan.mk_ι_app, cofan.mk_ι_app]
  dsimp only [index_set.epi_comp, index_set.e]
  rw [op_comp, X.map_comp, assoc, Quiver.Hom.op_unop]
#align simplicial_object.splitting.ι_summand_epi_naturality SimplicialObject.Splitting.ιSummand_epi_naturality

end Splitting

variable (C)

/-- The category `simplicial_object.split C` is the category of simplicial objects
in `C` equipped with a splitting, and morphisms are morphisms of simplicial objects
which are compatible with the splittings. -/
@[ext, nolint has_nonempty_instance]
structure Split where
  pt : SimplicialObject C
  s : Splitting X
#align simplicial_object.split SimplicialObject.Split

namespace Split

variable {C}

/-- The object in `simplicial_object.split C` attached to a splitting `s : splitting X`
of a simplicial object `X`. -/
@[simps]
def mk' {X : SimplicialObject C} (s : Splitting X) : Split C :=
  ⟨X, s⟩
#align simplicial_object.split.mk' SimplicialObject.Split.mk'

/-- Morphisms in `simplicial_object.split C` are morphisms of simplicial objects that
are compatible with the splittings. -/
@[nolint has_nonempty_instance]
structure Hom (S₁ S₂ : Split C) where
  f : S₁.pt ⟶ S₂.pt
  f : ∀ n : ℕ, S₁.s.n n ⟶ S₂.s.n n
  comm' : ∀ n : ℕ, S₁.s.ι n ≫ F.app (op [n]) = f n ≫ S₂.s.ι n
#align simplicial_object.split.hom SimplicialObject.Split.Hom

@[ext]
theorem Hom.ext {S₁ S₂ : Split C} (Φ₁ Φ₂ : Hom S₁ S₂) (h : ∀ n : ℕ, Φ₁.f n = Φ₂.f n) : Φ₁ = Φ₂ :=
  by
  rcases Φ₁ with ⟨F₁, f₁, c₁⟩
  rcases Φ₂ with ⟨F₂, f₂, c₂⟩
  have h' : f₁ = f₂ := by
    ext
    apply h
  subst h'
  simp only [eq_self_iff_true, and_true_iff]
  apply S₁.s.hom_ext
  intro n
  dsimp
  rw [c₁, c₂]
#align simplicial_object.split.hom.ext SimplicialObject.Split.Hom.ext

restate_axiom hom.comm'

attribute [simp, reassoc.1] hom.comm

end Split

instance : Category (Split C) where
  Hom := Split.Hom
  id S :=
    { f := 𝟙 _
      f := fun n => 𝟙 _
      comm' := by tidy }
  comp S₁ S₂ S₃ Φ₁₂ Φ₂₃ :=
    { f := Φ₁₂.f ≫ Φ₂₃.f
      f := fun n => Φ₁₂.f n ≫ Φ₂₃.f n
      comm' := by tidy }

variable {C}

namespace Split

theorem congr_f {S₁ S₂ : Split C} {Φ₁ Φ₂ : S₁ ⟶ S₂} (h : Φ₁ = Φ₂) : Φ₁.f = Φ₂.f := by rw [h]
#align simplicial_object.split.congr_F SimplicialObject.Split.congr_f

/- warning: simplicial_object.split.congr_f clashes with simplicial_object.split.congr_F -> SimplicialObject.Split.congr_f
warning: simplicial_object.split.congr_f -> SimplicialObject.Split.congr_f is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Category.{u2, u1} C] [_inst_2 : CategoryTheory.Limits.HasFiniteCoproducts.{u2, u1} C _inst_1] {S₁ : SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2} {S₂ : SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2} {Φ₁ : Quiver.Hom.{succ u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.CategoryStruct.toQuiver.{u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.Category.toCategoryStruct.{u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (SimplicialObject.Split.CategoryTheory.category.{u1, u2} C _inst_1 _inst_2))) S₁ S₂} {Φ₂ : Quiver.Hom.{succ u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.CategoryStruct.toQuiver.{u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.Category.toCategoryStruct.{u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (SimplicialObject.Split.CategoryTheory.category.{u1, u2} C _inst_1 _inst_2))) S₁ S₂}, (Eq.{succ u2} (Quiver.Hom.{succ u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.CategoryStruct.toQuiver.{u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.Category.toCategoryStruct.{u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (SimplicialObject.Split.CategoryTheory.category.{u1, u2} C _inst_1 _inst_2))) S₁ S₂) Φ₁ Φ₂) -> (forall (n : Nat), Eq.{succ u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) (SimplicialObject.Splitting.n.{u1, u2} C _inst_1 _inst_2 (SimplicialObject.Split.x.{u1, u2} C _inst_1 _inst_2 S₁) (SimplicialObject.Split.s.{u1, u2} C _inst_1 _inst_2 S₁) n) (SimplicialObject.Splitting.n.{u1, u2} C _inst_1 _inst_2 (SimplicialObject.Split.x.{u1, u2} C _inst_1 _inst_2 S₂) (SimplicialObject.Split.s.{u1, u2} C _inst_1 _inst_2 S₂) n)) (SimplicialObject.Split.Hom.f.{u1, u2} C _inst_1 _inst_2 S₁ S₂ Φ₁ n) (SimplicialObject.Split.Hom.f.{u1, u2} C _inst_1 _inst_2 S₁ S₂ Φ₂ n))
but is expected to have type
  PUnit.{0}
Case conversion may be inaccurate. Consider using '#align simplicial_object.split.congr_f SimplicialObject.Split.congr_fₓ'. -/
theorem congr_f {S₁ S₂ : Split C} {Φ₁ Φ₂ : S₁ ⟶ S₂} (h : Φ₁ = Φ₂) (n : ℕ) : Φ₁.f n = Φ₂.f n := by
  rw [h]
#align simplicial_object.split.congr_f SimplicialObject.Split.congr_f

@[simp]
theorem id_f (S : Split C) : (𝟙 S : S ⟶ S).f = 𝟙 S.pt :=
  rfl
#align simplicial_object.split.id_F SimplicialObject.Split.id_f

/- warning: simplicial_object.split.id_f clashes with simplicial_object.split.id_F -> SimplicialObject.Split.id_f
warning: simplicial_object.split.id_f -> SimplicialObject.Split.id_f is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Category.{u2, u1} C] [_inst_2 : CategoryTheory.Limits.HasFiniteCoproducts.{u2, u1} C _inst_1] (S : SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (n : Nat), Eq.{succ u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) (SimplicialObject.Splitting.n.{u1, u2} C _inst_1 _inst_2 (SimplicialObject.Split.x.{u1, u2} C _inst_1 _inst_2 S) (SimplicialObject.Split.s.{u1, u2} C _inst_1 _inst_2 S) n) (SimplicialObject.Splitting.n.{u1, u2} C _inst_1 _inst_2 (SimplicialObject.Split.x.{u1, u2} C _inst_1 _inst_2 S) (SimplicialObject.Split.s.{u1, u2} C _inst_1 _inst_2 S) n)) (SimplicialObject.Split.Hom.f.{u1, u2} C _inst_1 _inst_2 S S (CategoryTheory.CategoryStruct.id.{u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.Category.toCategoryStruct.{u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (SimplicialObject.Split.CategoryTheory.category.{u1, u2} C _inst_1 _inst_2)) S) n) (CategoryTheory.CategoryStruct.id.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1) (SimplicialObject.Splitting.n.{u1, u2} C _inst_1 _inst_2 (SimplicialObject.Split.x.{u1, u2} C _inst_1 _inst_2 S) (SimplicialObject.Split.s.{u1, u2} C _inst_1 _inst_2 S) n))
but is expected to have type
  PUnit.{0}
Case conversion may be inaccurate. Consider using '#align simplicial_object.split.id_f SimplicialObject.Split.id_fₓ'. -/
@[simp]
theorem id_f (S : Split C) (n : ℕ) : (𝟙 S : S ⟶ S).f n = 𝟙 (S.s.n n) :=
  rfl
#align simplicial_object.split.id_f SimplicialObject.Split.id_f

@[simp]
theorem comp_f {S₁ S₂ S₃ : Split C} (Φ₁₂ : S₁ ⟶ S₂) (Φ₂₃ : S₂ ⟶ S₃) :
    (Φ₁₂ ≫ Φ₂₃).f = Φ₁₂.f ≫ Φ₂₃.f :=
  rfl
#align simplicial_object.split.comp_F SimplicialObject.Split.comp_f

/- warning: simplicial_object.split.comp_f clashes with simplicial_object.split.comp_F -> SimplicialObject.Split.comp_f
warning: simplicial_object.split.comp_f -> SimplicialObject.Split.comp_f is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Category.{u2, u1} C] [_inst_2 : CategoryTheory.Limits.HasFiniteCoproducts.{u2, u1} C _inst_1] {S₁ : SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2} {S₂ : SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2} {S₃ : SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2} (Φ₁₂ : Quiver.Hom.{succ u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.CategoryStruct.toQuiver.{u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.Category.toCategoryStruct.{u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (SimplicialObject.Split.CategoryTheory.category.{u1, u2} C _inst_1 _inst_2))) S₁ S₂) (Φ₂₃ : Quiver.Hom.{succ u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.CategoryStruct.toQuiver.{u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.Category.toCategoryStruct.{u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (SimplicialObject.Split.CategoryTheory.category.{u1, u2} C _inst_1 _inst_2))) S₂ S₃) (n : Nat), Eq.{succ u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1)) (SimplicialObject.Splitting.n.{u1, u2} C _inst_1 _inst_2 (SimplicialObject.Split.x.{u1, u2} C _inst_1 _inst_2 S₁) (SimplicialObject.Split.s.{u1, u2} C _inst_1 _inst_2 S₁) n) (SimplicialObject.Splitting.n.{u1, u2} C _inst_1 _inst_2 (SimplicialObject.Split.x.{u1, u2} C _inst_1 _inst_2 S₃) (SimplicialObject.Split.s.{u1, u2} C _inst_1 _inst_2 S₃) n)) (SimplicialObject.Split.Hom.f.{u1, u2} C _inst_1 _inst_2 S₁ S₃ (CategoryTheory.CategoryStruct.comp.{u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (CategoryTheory.Category.toCategoryStruct.{u2, max u1 u2} (SimplicialObject.Split.{u1, u2} C _inst_1 _inst_2) (SimplicialObject.Split.CategoryTheory.category.{u1, u2} C _inst_1 _inst_2)) S₁ S₂ S₃ Φ₁₂ Φ₂₃) n) (CategoryTheory.CategoryStruct.comp.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C _inst_1) (SimplicialObject.Splitting.n.{u1, u2} C _inst_1 _inst_2 (SimplicialObject.Split.x.{u1, u2} C _inst_1 _inst_2 S₁) (SimplicialObject.Split.s.{u1, u2} C _inst_1 _inst_2 S₁) n) (SimplicialObject.Splitting.n.{u1, u2} C _inst_1 _inst_2 (SimplicialObject.Split.x.{u1, u2} C _inst_1 _inst_2 S₂) (SimplicialObject.Split.s.{u1, u2} C _inst_1 _inst_2 S₂) n) (SimplicialObject.Splitting.n.{u1, u2} C _inst_1 _inst_2 (SimplicialObject.Split.x.{u1, u2} C _inst_1 _inst_2 S₃) (SimplicialObject.Split.s.{u1, u2} C _inst_1 _inst_2 S₃) n) (SimplicialObject.Split.Hom.f.{u1, u2} C _inst_1 _inst_2 S₁ S₂ Φ₁₂ n) (SimplicialObject.Split.Hom.f.{u1, u2} C _inst_1 _inst_2 S₂ S₃ Φ₂₃ n))
but is expected to have type
  PUnit.{0}
Case conversion may be inaccurate. Consider using '#align simplicial_object.split.comp_f SimplicialObject.Split.comp_fₓ'. -/
@[simp]
theorem comp_f {S₁ S₂ S₃ : Split C} (Φ₁₂ : S₁ ⟶ S₂) (Φ₂₃ : S₂ ⟶ S₃) (n : ℕ) :
    (Φ₁₂ ≫ Φ₂₃).f n = Φ₁₂.f n ≫ Φ₂₃.f n :=
  rfl
#align simplicial_object.split.comp_f SimplicialObject.Split.comp_f

@[simp, reassoc.1]
theorem ιSummand_naturality_symm {S₁ S₂ : Split C} (Φ : S₁ ⟶ S₂) {Δ : SimplexCategoryᵒᵖ}
    (A : Splitting.IndexSet Δ) : S₁.s.ιSummand A ≫ Φ.f.app Δ = Φ.f A.1.unop.len ≫ S₂.s.ιSummand A :=
  by rw [S₁.s.ι_summand_eq, S₂.s.ι_summand_eq, assoc, Φ.F.naturality, ← Φ.comm_assoc]
#align simplicial_object.split.ι_summand_naturality_symm SimplicialObject.Split.ιSummand_naturality_symm

variable (C)

/-- The functor `simplicial_object.split C ⥤ simplicial_object C` which forgets
the splitting. -/
@[simps]
def forget : Split C ⥤ SimplicialObject C
    where
  obj S := S.pt
  map S₁ S₂ Φ := Φ.f
#align simplicial_object.split.forget SimplicialObject.Split.forget

/-- The functor `simplicial_object.split C ⥤ C` which sends a simplicial object equipped
with a splitting to its nondegenerate `n`-simplices. -/
@[simps]
def evalN (n : ℕ) : Split C ⥤ C where
  obj S := S.s.n n
  map S₁ S₂ Φ := Φ.f n
#align simplicial_object.split.eval_N SimplicialObject.Split.evalN

/-- The inclusion of each summand in the coproduct decomposition of simplices
in split simplicial objects is a natural transformation of functors
`simplicial_object.split C ⥤ C` -/
@[simps]
def natTransιSummand {Δ : SimplexCategoryᵒᵖ} (A : Splitting.IndexSet Δ) :
    evalN C A.1.unop.len ⟶ forget C ⋙ (evaluation SimplexCategoryᵒᵖ C).obj Δ
    where
  app S := S.s.ιSummand A
  naturality' S₁ S₂ Φ := (ιSummand_naturality_symm Φ A).symm
#align simplicial_object.split.nat_trans_ι_summand SimplicialObject.Split.natTransιSummand

end Split

end SimplicialObject


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Simon Hudon

Type classes for traversing collections. The concepts and laws are taken from
http://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Traversable.html
-/

import tactic.cache
import category.applicative

open function (hiding comp)

universes u v w

section applicative_transformation

variables (F : Type u → Type v) [applicative F] [is_lawful_applicative F]
variables (G : Type u → Type w) [applicative G] [is_lawful_applicative G]

structure applicative_transformation : Type (max (u+1) v w) :=
(app : ∀ {α : Type u}, F α → G α)
(preserves_pure' : ∀ {α : Type u} (x : α), app (pure x) = pure x)
(preserves_seq' : ∀ {α β : Type u} (x : F (α → β)) (y : F α), app (x <*> y) = app x <*> app y)

end applicative_transformation

namespace applicative_transformation

variables (F : Type u → Type v) [applicative F] [is_lawful_applicative F]
variables (G : Type u → Type w) [applicative G] [is_lawful_applicative G]

instance : has_coe_to_fun (applicative_transformation F G) := ⟨_, λ m, m.app⟩

variables {F G}
variables (η : applicative_transformation F G)

@[functor_norm]
lemma preserves_pure : ∀ {α} (x : α), η (pure x) = pure x := η.preserves_pure'

@[functor_norm]
lemma preserves_seq :
  ∀ {α β : Type u} (x : F (α → β)) (y : F α), η (x <*> y) = η x <*> η y :=
η.preserves_seq'

@[functor_norm]
lemma preserves_map {α β} (x : α → β) (y : F α) : η (x <$> y) = x <$> η y :=
by rw [← pure_seq_eq_map, η.preserves_seq]; simp with functor_norm

end applicative_transformation

open applicative_transformation

class traversable (t : Type u → Type u) extends functor t :=
(traverse : Π {m : Type u → Type u} [applicative m] {α β},
   (α → m β) → t α → m (t β))

open functor

export traversable (traverse)

section functions

variables {t : Type u → Type u}
variables {m : Type u → Type v} [applicative m]
variables {α β : Type u}

variables {f : Type u → Type u} [applicative f]

def sequence [traversable t] : t (f α) → f (t α) := traverse id

end functions

class is_lawful_traversable (t : Type u → Type u) [traversable t]
  extends is_lawful_functor t : Type (u+1) :=
(id_traverse : ∀ {α} (x : t α), traverse id.mk x = x )
(comp_traverse : ∀ {F G} [applicative F] [applicative G]
    [is_lawful_applicative F] [is_lawful_applicative G]
    {α β γ} (f : β → F γ) (g : α → G β) (x : t α),
  traverse (comp.mk ∘ map f ∘ g) x =
  comp.mk (map (traverse f) (traverse g x)))
(traverse_eq_map_id : ∀ {α β} (f : α → β) (x : t α),
  traverse (id.mk ∘ f) x = id.mk (f <$> x))
(naturality : ∀ {F G} [applicative F] [applicative G]
    [is_lawful_applicative F] [is_lawful_applicative G]
    (η : applicative_transformation F G) {α β} (f : α → F β) (x : t α),
  η (traverse f x) = traverse (@η _ ∘ f) x)


-------------------------------------------------------------------
-- The PEDANTIC (Proof Engine for Deductive Automation using Non-deterministic
-- Traversal of Instruction Code) verification framework
--
-- Developed by Kenneth Roe
-- For more information, check out www.cs.jhu.edu/~roe
--
-- traversal.v
--
-- Tree traversal example.
--
-------------------------------------------------------------------

import .PEDANTIC2

def P := 0.
def RR := 1.
def I := 2.
def N := 3.
def T := 4.
def Tmp_l := 5.
def Tmp_r := 6.

def initCode : com :=
    I ::= A0;
    T ::= !RR;
    P ::= A0.

def precondition : absState :=
    (absExists (λ (x:Value), (absTree (λ env, env RR) 2 (0::1::list.nil) x))).

def afterAssigns : absState := (absExists (λ rTree, (absExists (λ iTree, (absExists (λ pTree,
         (absTree (λ env, env RR) 2 [0,1] rTree) **
         (absTree (λ env, env I) 2 [0] iTree) **
         (absTree (λ env, env P) 2 [0] pTree) **
         (absAllU (treeRecords iTree) (λ v,(λ st, inTree (nthval 2 (find v iTree)) rTree))) **
         (absAllU (treeRecords pTree) (λ v,(λ st, inTree (nthval 2 (find v pTree)) rTree))))))))).

open tactic
open monad
open expr
open smt_tactic

--@[simp] theorem dist_conj1 {a : absState} {b:absState} (st : imp_state) {v:ident} {e:ℕ} :
--       (a**b) st =
--       a st ** b st :=
--begin
--    admit
--end

--@[simp] theorem dist_conj2 {a : absState} {b:absState} {v:ident} {e:ℕ} :
--       (λ (st : imp_state), (a**b) (st.fst, override (st.snd) v e))=
--       (absCompose (λ (st : imp_state), a (st.fst, override (st.snd) v e))
--          (λ (st : imp_state), b (st.fst, override (st.snd) v e))) :=
--begin
--    admit
--end

--@[simp] theorem dist_exists {t} {a : absState} {v:ident} {e:ℕ} :
--       (λ (st : imp_state),
--              (@absExists t (λ (x:t), a) (st.fst, override (st.snd) v e)))=
--       @absExists t (λ (x:t), (λ (st : imp_state), a (st.fst, override (st.snd) v e))) :=
--begin
--    admit
--end

--@[simp] theorem beta_x (t:Type) (r:Type) (v:t) (a : t → r) :
--    (λ (v:t), a v) = a :=
--begin
--    admit
--end

theorem initWorks: {{precondition}} initCode {{ afterAssigns }} := begin
    unfold initCode, unfold precondition,
    apply strengthenPost,
    apply compose, apply compose,
    apply assignPropagate,
    dsimp [aeval, A0,A1,A2,A3,A4,A5,A6], simp,
    unfold I, unfold RR, unfold override, have : 2=1, sorry, simp [if_neg,*],
    --simplify_override,
    --simplify_override,
    --simplify_override2, simplify_override_predicate,
    --simplify_tree,
end.


import category_theory.preadditive.yoneda
import category_theory.triangulated.pretriangulated
import for_mathlib.algebra.homology.basic_five_lemma
import for_mathlib.category_theory.triangulated.pretriangulated_misc

noncomputable theory

namespace category_theory

open limits category pretriangulated

lemma is_iso_of_yoneda_bijective {C : Type*} [category C] {X Y : C} (f : X ⟶ Y)
  (hf : ∀ (A : C), function.bijective (λ (x : A ⟶ X), x ≫ f)) : is_iso f :=
begin
  haveI : ∀ (A : Cᵒᵖ), is_iso ((yoneda.map f).app A),
  { intro A,
    induction A using opposite.rec,
    rw is_iso_iff_bijective,
    exact hf A, },
  haveI : is_iso (yoneda.map f) := nat_iso.is_iso_of_is_iso_app _,
  exact yoneda.is_iso f,
end

lemma yoneda_bijective_of_is_iso {C : Type*} [category C] {X Y : C} (f : X ⟶ Y) (hf : is_iso f)
  (A : C) : function.bijective (λ (x : A ⟶ X), x ≫ f) :=
begin
  have h : is_iso ((yoneda.map f).app (opposite.op A)) := infer_instance,
  simpa only [is_iso_iff_bijective] using h,
end

namespace pretriangulated

variables {C : Type*} [category C] [preadditive C] [has_shift C ℤ]

@[simps]
def triangle.product {I : Type*} (T : I → triangle C) [has_product (λ i, (T i).obj₁)]
  [has_product (λ i, (T i).obj₂)] [has_product (λ i, (T i).obj₃)]
  [has_product (λ i, (shift_functor C (1 : ℤ)).obj (T i).obj₁)] : triangle C :=
{ obj₁ := ∏ (λ i, (T i).obj₁),
  obj₂ := ∏ (λ i, (T i).obj₂),
  obj₃ := ∏ (λ i, (T i).obj₃),
  mor₁ := limits.pi.map (λ i, (T i).mor₁),
  mor₂ := limits.pi.map (λ i, (T i).mor₂),
  mor₃ := limits.pi.map (λ i, (T i).mor₃) ≫ inv (pi_comparison _ _), }

@[simps]
def triangle.product.lift {I : Type*} {T' : triangle C}
  {T : I → triangle C} [has_product (λ i, (T i).obj₁)]
  [has_product (λ i, (T i).obj₂)] [has_product (λ i, (T i).obj₃)]
  [has_product (λ i, (shift_functor C (1 : ℤ)).obj (T i).obj₁)]
  (f : Π i, T' ⟶ T i) :
  T' ⟶ triangle.product T :=
{ hom₁ := pi.lift (λ i, (f i).hom₁),
  hom₂ := pi.lift (λ i, (f i).hom₂),
  hom₃ := pi.lift (λ i, (f i).hom₃),
  comm₃' := begin
    simp only [triangle.product_mor₃,
      ← cancel_mono (pi_comparison (shift_functor C (1 : ℤ)) (λ (i : I), (T i).obj₁)),
      assoc, is_iso.inv_hom_id, comp_id],
    ext j,
    discrete_cases,
    simp only [map_lift_pi_comparison, assoc, limit.lift_π, fan.mk_π_app,
      triangle_morphism.comm₃, limit.lift_map, cones.postcompose_obj_π,
      nat_trans.comp_app, discrete.nat_trans_app],
  end, }

open algebra.homology

structure triangle.comp_eq_zero (T : triangle C) : Prop :=
(zero₁₂ : T.mor₁ ≫ T.mor₂ = 0)
(zero₂₃ : T.mor₂ ≫ T.mor₃ = 0)
(zero₃₁ : T.mor₃ ≫ T.mor₁⟦1⟧' = 0)

variables [has_zero_object C]
  [∀ (n : ℤ), functor.additive (shift_functor C n)] [pretriangulated C]

lemma triangle.comp_eq_zero.of_distinguished (T : triangle C) (hT : T ∈ dist_triang C) :
  T.comp_eq_zero :=
begin
  constructor,
  exact pretriangulated.comp_dist_triangle_mor_zero₁₂ _ T hT,
  exact pretriangulated.comp_dist_triangle_mor_zero₂₃ _ T hT,
  exact pretriangulated.comp_dist_triangle_mor_zero₃₁ _ T hT,
end

variable (C)

@[derive category]
def candidate_triangle := full_subcategory (λ (T : triangle C), T.comp_eq_zero)

variable {C}

@[simps]
def candidate_triangle.mk (T : triangle C) (hT : T.comp_eq_zero) :
  candidate_triangle C := ⟨T, hT⟩

@[simps]
def candidate_triangle.of_distinguished (T : triangle C) (hT : T ∈ dist_triang C) :
  candidate_triangle C := ⟨T, triangle.comp_eq_zero.of_distinguished T hT⟩

@[simps]
def candidate_triangle.short_complex (T : candidate_triangle C) :
  short_complex C :=
short_complex.mk _ _ T.property.zero₁₂

variable (C)

@[simps]
def candidate_triangle.to_short_complex_functor :
  candidate_triangle C ⥤ short_complex C :=
{ obj := candidate_triangle.short_complex,
  map := λ T₁ T₂ φ,
  { τ₁ := φ.hom₁,
    τ₂ := φ.hom₂,
    τ₃ := φ.hom₃, }, }

@[simps]
def candidate_triangle.to_five_complex : candidate_triangle C ⥤ five_complex C :=
{ obj := λ T,
  { X₁ := T.1.obj₁,
    X₂ := T.1.obj₂,
    X₃ := T.1.obj₃,
    X₄ := T.1.obj₁⟦(1 : ℤ)⟧,
    X₅ := T.1.obj₂⟦(1 : ℤ)⟧,
    f₁ := T.1.mor₁,
    f₂ := T.1.mor₂,
    f₃ := T.1.mor₃,
    f₄ := T.1.mor₁⟦1⟧',
    h₁₂ := T.2.zero₁₂,
    h₂₃ := T.2.zero₂₃,
    h₃₄ := T.2.zero₃₁, },
  map := λ T T' φ,
  { τ₁ := φ.hom₁,
    τ₂ := φ.hom₂,
    τ₃ := φ.hom₃,
    τ₄ := φ.hom₁⟦1⟧',
    τ₅ := φ.hom₂⟦1⟧',
    comm₁ := φ.comm₁,
    comm₂ := φ.comm₂,
    comm₃ := φ.comm₃,
    comm₄ := by { dsimp, simp only [← functor.map_comp, φ.comm₁], }, },
  map_id' := λ T, by { ext; try { refl, }; apply functor.map_id, },
  map_comp' := λ T T' T'' φ ψ, by { ext; try { refl, }; apply functor.map_comp, }, }

variable {C}

lemma candidate_triangle.coyoneda_exact_of_distinguished (T : triangle C) (hT : T ∈ dist_triang C)
  (A : C) : five_complex.exact (((candidate_triangle.to_five_complex C) ⋙
    (preadditive_coyoneda.obj (opposite.op A)).map_five_complex).obj
      (candidate_triangle.of_distinguished T hT)) :=
{ ex₂ := λ x₂ hx₂, ⟨_, (covariant_yoneda_exact₂ T hT x₂ hx₂).some_spec.symm⟩,
  ex₃ := λ x₃ hx₃, ⟨_, (covariant_yoneda_exact₃ T hT x₃ hx₃).some_spec.symm⟩,
  ex₄ := λ x₁ hx₁, ⟨_, (covariant_yoneda_exact₁ T hT x₁ hx₁).some_spec.symm⟩, }

lemma is_iso_hom₃_of_distinguished {T T' : triangle C} (φ : T ⟶ T') [is_iso φ.hom₁]
  [is_iso φ.hom₂] (hT : T ∈ dist_triang C) (hT' : T' ∈ dist_triang C) : is_iso φ.hom₃ :=
is_iso_of_yoneda_bijective _ (λ A, begin
  let ψ : candidate_triangle.of_distinguished T hT ⟶
    candidate_triangle.of_distinguished T' hT' := φ,
  refine five_complex.five_lemma_bijective ((preadditive_coyoneda.obj
      (opposite.op A)).map_five_complex.map ((candidate_triangle.to_five_complex C).map ψ))
    (candidate_triangle.coyoneda_exact_of_distinguished _ _ _)
    (candidate_triangle.coyoneda_exact_of_distinguished _ _ _)
    (yoneda_bijective_of_is_iso _ _ _)
    (yoneda_bijective_of_is_iso _ _ _)
    (yoneda_bijective_of_is_iso _ _ _)
    (yoneda_bijective_of_is_iso _ _ _),
  all_goals { dsimp, apply_instance, },
end)

lemma is_iso_hom₂_of_distinguished {T T' : triangle C} (φ : T ⟶ T') [is_iso φ.hom₁]
  [is_iso φ.hom₃] (hT : T ∈ dist_triang C) (hT' : T' ∈ dist_triang C) : is_iso φ.hom₂ :=
begin
  haveI : is_iso ((inv_rotate C).map φ).hom₁,
  { dsimp, apply_instance, },
  haveI : is_iso ((inv_rotate C).map φ).hom₂,
  { dsimp, apply_instance, },
  exact is_iso_hom₃_of_distinguished ((inv_rotate C).map φ) (pretriangulated.inv_rot_of_dist_triangle _ _ hT)
    (pretriangulated.inv_rot_of_dist_triangle _ _ hT'),
end

lemma is_iso_hom₁_of_distinguished {T T' : triangle C} (φ : T ⟶ T') [is_iso φ.hom₂]
  [is_iso φ.hom₃] (hT : T ∈ dist_triang C) (hT' : T' ∈ dist_triang C) : is_iso φ.hom₁ :=
begin
  haveI : is_iso ((rotate C).map φ).hom₁ := by { dsimp, apply_instance, },
  haveI : is_iso ((rotate C).map φ).hom₂ := by { dsimp, apply_instance, },
  haveI : is_iso ((shift_functor C (1 : ℤ)).map φ.hom₁) := is_iso_hom₃_of_distinguished
    ((rotate C).map φ) (pretriangulated.rot_of_dist_triangle _ _ hT)
    (pretriangulated.rot_of_dist_triangle _ _ hT'),
  exact is_iso_of_reflects_iso φ.hom₁ (shift_functor C (1 : ℤ)),
end

@[simps hom_hom₁ hom_hom₂ inv_hom₁ inv_hom₂]
def iso_triangle_of_distinguished_of_is_iso₁₂ (T T' : triangle C) (hT : T ∈ dist_triang C)
  (hT' : T' ∈ dist_triang C) (e₁ : T.obj₁ ≅ T'.obj₁) (e₂ : T.obj₂ ≅ T'.obj₂)
  (comm : T.mor₁ ≫ e₂.hom = e₁.hom ≫ T'.mor₁) : T ≅ T' :=
begin
  let h := pretriangulated.complete_distinguished_triangle_morphism
    T T' hT hT' e₁.hom e₂.hom comm,
  let φ : T ⟶ T' :=
  { hom₁ := e₁.hom,
    hom₂ := e₂.hom,
    hom₃ := h.some,
    comm₁' := comm,
    comm₂' := h.some_spec.1,
    comm₃' := h.some_spec.2, },
  haveI : is_iso φ.hom₃ := is_iso_hom₃_of_distinguished φ hT hT',
  exact triangle.mk_iso _ _ e₁ e₂ (as_iso φ.hom₃) φ.comm₁ φ.comm₂ φ.comm₃,
end

lemma map_pi_map_pi_comparison {C D I : Type*} [category C] [category D]
  {X : I → C} {Y : I → C} (f : Π i, X i ⟶ Y i) (F : C ⥤ D) [has_product X]
  [has_product Y] [has_product (λ i, F.obj (X i))] [has_product (λ i, F.obj (Y i))] :
  F.map (pi.map f) ≫ pi_comparison F Y =
    pi_comparison F X ≫ pi.map (λ i, F.map (f i) : Π i, F.obj (X i) ⟶ F.obj (Y i)) :=
begin
  ext i,
  discrete_cases,
  simp only [assoc, pi_comparison_comp_π, lim_map_π, discrete.nat_trans_app,
    pi_comparison_comp_π_assoc, ← F.map_comp],
end

@[simps]
def candidate_triangle.pi {I : Type*} (T : I → candidate_triangle C)
  [has_product (λ i, (T i).1.obj₁)]
  [has_product (λ i, (T i).1.obj₂)] [has_product (λ i, (T i).1.obj₃)]
  [has_product (λ i, (shift_functor C (1 : ℤ)).obj (T i).1.obj₁)]
  [has_product (λ i, (shift_functor C (1 : ℤ)).obj (T i).1.obj₂)] :
  candidate_triangle C :=
begin
  refine ⟨triangle.product (λ i, (T i).1), ⟨_, _, _⟩⟩,
  { ext i,
    discrete_cases,
    simp only [triangle.product_mor₁, triangle.product_mor₂, assoc, lim_map_π,
      discrete.nat_trans_app, lim_map_π_assoc, zero_comp, (T i).2.1, comp_zero], },
  { simp only [triangle.product_mor₂, triangle.product_mor₃,
      ← cancel_mono (pi_comparison (shift_functor C (1 : ℤ)) (λ (i : I), (T i).1.obj₁)),
      is_iso.inv_hom_id, comp_id, zero_comp, assoc],
    ext i,
    discrete_cases,
    simp only [assoc, lim_map_π, discrete.nat_trans_app, lim_map_π_assoc, zero_comp,
      (T i).2.2, comp_zero], },
  { simp only [triangle.product_mor₃, triangle.product_mor₁, assoc],
    rw [← cancel_mono (pi_comparison (shift_functor C (1 : ℤ)) (λ (i : I), (T i).1.obj₂)),
      assoc, assoc, zero_comp, map_pi_map_pi_comparison, is_iso.inv_hom_id_assoc],
    ext i,
    discrete_cases,
    simp only [assoc, lim_map_π, discrete.nat_trans_app, lim_map_π_assoc, zero_comp],
    erw [(T i).2.3, comp_zero], },
end

@[simps]
def candidate_triangle.pi.π {I : Type} (T : I → candidate_triangle C)
  [has_product (λ i, (T i).1.obj₁)]
  [has_product (λ i, (T i).1.obj₂)] [has_product (λ i, (T i).1.obj₃)]
  [has_product (λ i, (shift_functor C (1 : ℤ)).obj (T i).1.obj₁)]
  [has_product (λ i, (shift_functor C (1 : ℤ)).obj (T i).1.obj₂)]
   (i : I) :
  candidate_triangle.pi T ⟶ T i :=
{ hom₁ := limits.pi.π _ i,
  hom₂ := limits.pi.π _ i,
  hom₃ := limits.pi.π _ i,
  comm₁' := by tidy,
  comm₂' := by tidy,
  comm₃' := begin
    dsimp,
    rw [← pi_comparison_comp_π, assoc, is_iso.inv_hom_id_assoc, lim_map_π,
      discrete.nat_trans_app],
  end, }

lemma function_bijective_product_coyoneda' {I : Type} (X : I → C) (s : fan X) (hs : is_limit s)
  (A : C) : function.bijective (λ (f : A ⟶ s.X), λ i, f ≫ s.proj i) :=
begin
  split,
  { intros f₁ f₂ h,
    dsimp at h,
    apply hs.hom_ext,
    intro i,
    discrete_cases,
    convert congr_fun h i, },
  { intro g,
    refine ⟨hs.lift (fan.mk _ g), _⟩,
    ext i,
    apply hs.fac, },
end

lemma function_bijective_product_coyoneda {I : Type} (X : I → C) [has_product X] (A : C) :
  function.bijective (λ (f : A ⟶ ∏ X), λ i, f ≫ pi.π _ i) :=
function_bijective_product_coyoneda' X _ (limit.is_limit _) A

lemma function_bijective_product_coyoneda_equivalence {I : Type} (X : I → C) [has_product X]
  (F : C ⥤ C) [is_equivalence F] [has_product (λ i, F.obj (X i))] (A : C) :
  function.bijective (λ (f : A ⟶ F.obj (∏ X)), λ i, (f ≫ pi_comparison F X) ≫ pi.π _ i) :=
begin
  have h₁ : function.bijective (λ (f : A ⟶ F.obj (∏ X)), f ≫ pi_comparison F X),
  { split,
    { intros f₁ f₂ h,
      dsimp at h,
      simpa only [cancel_mono] using h, },
    { intro g,
      refine ⟨g ≫ inv (pi_comparison F X), _⟩,
      dsimp,
      rw [assoc, is_iso.inv_hom_id, comp_id], }, },
  have h₂ : function.bijective (λ (f : A ⟶ ∏ (λ i, F.obj (X i))), λ i, f ≫ pi.π _ i) :=
    by apply function_bijective_product_coyoneda,
  exact h₂.comp h₁,
end

lemma candidate_triangle.pi_coyoneda_exact {I : Type} (T : I → candidate_triangle C)
  [has_product (λ i, (T i).1.obj₁)]
  [has_product (λ i, (T i).1.obj₂)] [has_product (λ i, (T i).1.obj₃)]
  [has_product (λ i, (shift_functor C (1 : ℤ)).obj (T i).1.obj₁)]
  [has_product (λ i, (shift_functor C (1 : ℤ)).obj (T i).1.obj₂)]
  (A : C)
  (hT : ∀ (i : I), ((preadditive_coyoneda.obj (opposite.op A)).map_five_complex.obj ((candidate_triangle.to_five_complex C).obj (T i))).exact) :
  ((preadditive_coyoneda.obj (opposite.op A)).map_five_complex.obj ((candidate_triangle.to_five_complex C).obj (candidate_triangle.pi T))).exact :=
begin
  refine five_complex.exact.of_iso _ _ (five_complex.pi'_exact _ hT),
  refine five_complex.pi'_lift (λ i, _),
  refine (preadditive_coyoneda.obj (opposite.op A)).map_five_complex.map ((candidate_triangle.to_five_complex C).map (candidate_triangle.pi.π T i)),
  have is_iso_of_bijective : ∀ {X Y : AddCommGroup} (φ : X ⟶ Y) (hφ : function.bijective φ), is_iso φ,
  { intros X Y φ hφ,
    haveI : is_iso ((forget AddCommGroup).map φ),
    { rw is_iso_iff_bijective,
      exact hφ, },
    exact is_iso_of_reflects_iso φ (forget AddCommGroup), },
  apply five_complex.is_iso_of_isos,
  any_goals { apply is_iso_of_bijective, apply function_bijective_product_coyoneda, },
  { apply is_iso_of_bijective,
    convert function_bijective_product_coyoneda_equivalence
      (λ i, (T i).1.obj₁) (shift_functor C (1 : ℤ)) A,
    ext x i,
    dsimp at x ⊢,
    simp only [pi_comparison_comp_π, assoc], },
  { apply is_iso_of_bijective,
    convert function_bijective_product_coyoneda_equivalence
      (λ i, (T i).1.obj₂) (shift_functor C (1 : ℤ)) A,
    ext x i,
    dsimp at x ⊢,
    simp only [pi_comparison_comp_π, assoc], },
end

end pretriangulated

end category_theory


/-
Copyright (c) 2021 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn, Scott Morrison
Ported by: Scott Morrison

! This file was ported from Lean 3 source module combinatorics.quiver.basic
! leanprover-community/mathlib commit 56adee5b5eef9e734d82272918300fca4f3e7cef
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Opposite

/-!
# Quivers

This module defines quivers. A quiver on a type `V` of vertices assigns to every
pair `a b : V` of vertices a type `a ⟶ b` of arrows from `a` to `b`. This
is a very permissive notion of directed graph.

## Implementation notes

Currently `Quiver` is defined with `arrow : V → V → Sort v`.
This is different from the category theory setup,
where we insist that morphisms live in some `Type`.
There's some balance here: it's nice to allow `Prop` to ensure there are no multiple arrows,
but it is also results in error-prone universe signatures when constraints require a `Type`.
-/

open Opposite

-- We use the same universe order as in category theory.
-- See note [CategoryTheory universes]
universe v v₁ v₂ u u₁ u₂

/-- A quiver `G` on a type `V` of vertices assigns to every pair `a b : V` of vertices
a type `a ⟶ b` of arrows from `a` to `b`.

For graphs with no repeated edges, one can use `Quiver.{0} V`, which ensures
`a ⟶ b : Prop`. For multigraphs, one can use `Quiver.{v+1} V`, which ensures
`a ⟶ b : Type v`.

Because `Category` will later extend this class, we call the field `hom`.
Except when constructing instances, you should rarely see this, and use the `⟶` notation instead.
-/
class Quiver (V : Type u) where
  /-- The type of edges/arrows/morphisms between a given source and target. -/
  Hom : V → V → Sort v
#align quiver Quiver
#align quiver.hom Quiver.Hom

/--
Notation for the type of edges/arrows/morphisms between a given source and target
in a quiver or category.
-/
infixr:10 " ⟶ " => Quiver.Hom

/-- A morphism of quivers. As we will later have categorical functors extend this structure,
we call it a `Prefunctor`. -/
structure Prefunctor (V : Type u₁) [Quiver.{v₁} V] (W : Type u₂) [Quiver.{v₂} W] where
  /-- The action of a (pre)functor on vertices/objects. -/
  obj : V → W
  /-- The action of a (pre)functor on edges/arrows/morphisms. -/
  map : ∀ {X Y : V}, (X ⟶ Y) → (obj X ⟶ obj Y)
#align prefunctor Prefunctor

namespace Prefunctor

@[ext]
theorem ext {V : Type u} [Quiver.{v₁} V] {W : Type u₂} [Quiver.{v₂} W] {F G : Prefunctor V W}
    (h_obj : ∀ X, F.obj X = G.obj X)
    (h_map : ∀ (X Y : V) (f : X ⟶ Y),
      F.map f = Eq.recOn (h_obj Y).symm (Eq.recOn (h_obj X).symm (G.map f))) : F = G := by
  cases' F with F_obj _
  cases' G with G_obj _
  obtain rfl : F_obj = G_obj := by
    ext X
    apply h_obj
  congr
  funext X Y f
  simpa using h_map X Y f
#align prefunctor.ext Prefunctor.ext

/-- The identity morphism between quivers. -/
@[simps]
def id (V : Type _) [Quiver V] : Prefunctor V V where
  obj := fun X => X
  map f := f
#align prefunctor.id Prefunctor.id
#align prefunctor.id_obj Prefunctor.id_obj
#align prefunctor.id_map Prefunctor.id_map

instance (V : Type _) [Quiver V] : Inhabited (Prefunctor V V) :=
  ⟨id V⟩

/-- Composition of morphisms between quivers. -/
@[simps]
def comp {U : Type _} [Quiver U] {V : Type _} [Quiver V] {W : Type _} [Quiver W]
    (F : Prefunctor U V) (G : Prefunctor V W) : Prefunctor U W where
  obj X := G.obj (F.obj X)
  map f := G.map (F.map f)
#align prefunctor.comp Prefunctor.comp
#align prefunctor.comp_obj Prefunctor.comp_obj
#align prefunctor.comp_map Prefunctor.comp_map

@[simp]
theorem comp_id {U V : Type _} [Quiver U] [Quiver V] (F : Prefunctor U V) :
    F.comp (id _) = F := rfl
#align prefunctor.comp_id Prefunctor.comp_id

@[simp]

@[simp]
theorem comp_assoc {U V W Z : Type _} [Quiver U] [Quiver V] [Quiver W] [Quiver Z]
    (F : Prefunctor U V) (G : Prefunctor V W) (H : Prefunctor W Z) :
    (F.comp G).comp H = F.comp (G.comp H) :=
  rfl
#align prefunctor.comp_assoc Prefunctor.comp_assoc

/-- Notation for a prefunctor between quivers. -/
infixl:50 " ⥤q " => Prefunctor

/-- Notation for composition of prefunctors. -/
infixl:60 " ⋙q " => Prefunctor.comp

/-- Notation for the identity prefunctor on a quiver. -/
notation "𝟭q" => id

end Prefunctor

namespace Quiver

/-- `Vᵒᵖ` reverses the direction of all arrows of `V`. -/
instance opposite {V} [Quiver V] : Quiver Vᵒᵖ :=
  ⟨fun a b => unop b ⟶ unop a⟩
#align quiver.opposite Quiver.opposite

/-- The opposite of an arrow in `V`.
-/
def Hom.op {V} [Quiver V] {X Y : V} (f : X ⟶ Y) : op Y ⟶ op X := f
#align quiver.hom.op Quiver.Hom.op

/-- Given an arrow in `Vᵒᵖ`, we can take the "unopposite" back in `V`.
-/
def Hom.unop {V} [Quiver V] {X Y : Vᵒᵖ} (f : X ⟶ Y) : unop Y ⟶ unop X := f
#align quiver.hom.unop Quiver.Hom.unop

/-- A type synonym for a quiver with no arrows. -/
-- Porting note: no has_nonempty_instance linter yet
-- @[nolint has_nonempty_instance]
def Empty (V : Type u) : Type u := V
#align quiver.empty Quiver.Empty

instance emptyQuiver (V : Type u) : Quiver.{u} (Empty V) := ⟨fun _ _ => PEmpty⟩
#align quiver.empty_quiver Quiver.emptyQuiver

@[simp]
theorem empty_arrow {V : Type u} (a b : Empty V) : (a ⟶ b) = PEmpty := rfl
#align quiver.empty_arrow Quiver.empty_arrow

/-- A quiver is thin if it has no parallel arrows. -/
@[reducible]
def IsThin (V : Type u) [Quiver V] : Prop := ∀ a b : V, Subsingleton (a ⟶ b)
#align quiver.is_thin Quiver.IsThin

end Quiver


/-
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.limits.colimit_limit
import category_theory.limits.preserves.functor_category
import category_theory.limits.preserves.finite
import category_theory.limits.shapes.finite_limits
import category_theory.limits.preserves.filtered
import category_theory.concrete_category.basic

/-!
# Filtered colimits commute with finite limits.

We show that for a functor `F : J × K ⥤ Type v`, when `J` is finite and `K` is filtered,
the universal morphism `colimit_limit_to_limit_colimit F` comparing the
colimit (over `K`) of the limits (over `J`) with the limit of the colimits is an isomorphism.

(In fact, to prove that it is injective only requires that `J` has finitely many objects.)

## References
* Borceux, Handbook of categorical algebra 1, Theorem 2.13.4
* [Stacks: Filtered colimits](https://stacks.math.columbia.edu/tag/002W)
-/

universes v u

open category_theory
open category_theory.category
open category_theory.limits.types
open category_theory.limits.types.filtered_colimit

namespace category_theory.limits

variables {J K : Type v} [small_category J] [small_category K]
variables (F : J × K ⥤ Type v)

open category_theory.prod

variables [is_filtered K]

section
/-!
Injectivity doesn't need that we have finitely many morphisms in `J`,
only that there are finitely many objects.
-/
variables [finite J]

/--
This follows this proof from
* Borceux, Handbook of categorical algebra 1, Theorem 2.13.4
-/
lemma colimit_limit_to_limit_colimit_injective :
  function.injective (colimit_limit_to_limit_colimit F) :=
begin
  classical,
  casesI nonempty_fintype J,
  -- Suppose we have two terms `x y` in the colimit (over `K`) of the limits (over `J`),
  -- and that these have the same image under `colimit_limit_to_limit_colimit F`.
  intros x y h,
  -- These elements of the colimit have representatives somewhere:
  obtain ⟨kx, x, rfl⟩ := jointly_surjective'.{v v} x,
  obtain ⟨ky, y, rfl⟩ := jointly_surjective'.{v v} y,
  dsimp at x y,

  -- Since the images of `x` and `y` are equal in a limit, they are equal componentwise
  -- (indexed by `j : J`),
  replace h := λ j, congr_arg (limit.π ((curry.obj F) ⋙ colim) j) h,
  -- and they are equations in a filtered colimit,
  -- so for each `j` we have some place `k j` to the right of both `kx` and `ky`
  simp [colimit_eq_iff.{v v}] at h,
  let k := λ j, (h j).some,
  let f : Π j, kx ⟶ k j := λ j, (h j).some_spec.some,
  let g : Π j, ky ⟶ k j := λ j, (h j).some_spec.some_spec.some,
  -- where the images of the components of the representatives become equal:
  have w : Π j,
    F.map ((𝟙 j, f j) : (j, kx) ⟶ (j, k j)) (limit.π ((curry.obj (swap K J ⋙ F)).obj kx) j x) =
    F.map ((𝟙 j, g j) : (j, ky) ⟶ (j, k j)) (limit.π ((curry.obj (swap K J ⋙ F)).obj ky) j y) :=
    λ j, (h j).some_spec.some_spec.some_spec,

  -- We now use that `K` is filtered, picking some point to the right of all these
  -- morphisms `f j` and `g j`.
  let O : finset K := finset.univ.image k ∪ {kx, ky},
  have kxO : kx ∈ O := finset.mem_union.mpr (or.inr (by simp)),
  have kyO : ky ∈ O := finset.mem_union.mpr (or.inr (by simp)),
  have kjO : ∀ j, k j ∈ O := λ j, finset.mem_union.mpr (or.inl (by simp)),

  let H : finset (Σ' (X Y : K) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y) :=
    (finset.univ).image (λ j : J, ⟨kx, k j, kxO,
      finset.mem_union.mpr (or.inl (by simp)),
      f j⟩) ∪
    (finset.univ).image (λ j : J, ⟨ky, k j, kyO,
      finset.mem_union.mpr (or.inl (by simp)),
      g j⟩),
  obtain ⟨S, T, W⟩ := is_filtered.sup_exists O H,

  have fH :
    ∀ j, (⟨kx, k j, kxO, kjO j, f j⟩ : (Σ' (X Y : K) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y)) ∈ H :=
    λ j, (finset.mem_union.mpr (or.inl
    begin
      simp only [true_and, finset.mem_univ, eq_self_iff_true, exists_prop_of_true,
        finset.mem_image, heq_iff_eq],
      refine ⟨j, rfl, _⟩,
      simp only [heq_iff_eq],
      exact ⟨rfl, rfl, rfl⟩,
    end)),
  have gH :
    ∀ j, (⟨ky, k j, kyO, kjO j, g j⟩ : (Σ' (X Y : K) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y)) ∈ H :=
    λ j, (finset.mem_union.mpr (or.inr
    begin
      simp only [true_and, finset.mem_univ, eq_self_iff_true, exists_prop_of_true,
        finset.mem_image, heq_iff_eq],
      refine ⟨j, rfl, _⟩,
      simp only [heq_iff_eq],
      exact ⟨rfl, rfl, rfl⟩,
    end)),

  -- Our goal is now an equation between equivalence classes of representatives of a colimit,
  -- and so it suffices to show those representative become equal somewhere, in particular at `S`.
  apply colimit_sound'.{v v} (T kxO) (T kyO),

  -- We can check if two elements of a limit (in `Type`) are equal by comparing them componentwise.
  ext,

  -- Now it's just a calculation using `W` and `w`.
  simp only [functor.comp_map, limit.map_π_apply, curry_obj_map_app, swap_map],
  rw ←W _ _ (fH j),
  rw ←W _ _ (gH j),
  simp [w],
end

end

variables [fin_category J]

/--
This follows this proof from
* Borceux, Handbook of categorical algebra 1, Theorem 2.13.4
although with different names.
-/
lemma colimit_limit_to_limit_colimit_surjective :
  function.surjective (colimit_limit_to_limit_colimit F) :=
begin
  classical,
  -- We begin with some element `x` in the limit (over J) over the colimits (over K),
  intro x,
  -- This consists of some coherent family of elements in the various colimits,
  -- and so our first task is to pick representatives of these elements.
  have z := λ j, jointly_surjective'.{v v} (limit.π (curry.obj F ⋙ limits.colim) j x),
  -- `k : J ⟶ K` records where the representative of the element in the `j`-th element of `x` lives
  let k : J → K := λ j, (z j).some,
  -- `y j : F.obj (j, k j)` is the representative
  let y : Π j, F.obj (j, k j) := λ j, (z j).some_spec.some,
  -- and we record that these representatives, when mapped back into the relevant colimits,
  -- are actually the components of `x`.
  have e : ∀ j,
    colimit.ι ((curry.obj F).obj j) (k j) (y j) =
    limit.π (curry.obj F ⋙ limits.colim) j x := λ j, (z j).some_spec.some_spec,
  clear_value k y, -- A little tidying up of things we no longer need.
  clear z,

  -- As a first step, we use that `K` is filtered to pick some point `k' : K` above all the `k j`
  let k' : K := is_filtered.sup (finset.univ.image k) ∅,
  -- and name the morphisms as `g j : k j ⟶ k'`.
  have g : Π j, k j ⟶ k' := λ j, is_filtered.to_sup (finset.univ.image k) ∅ (by simp),
  clear_value k',

  -- Recalling that the components of `x`, which are indexed by `j : J`, are "coherent",
  -- in other words preserved by morphisms in the `J` direction,
  -- we see that for any morphism `f : j ⟶ j'` in `J`,
  -- the images of `y j` and `y j'`, when mapped to `F.obj (j', k')` respectively by
  -- `(f, g j)` and `(𝟙 j', g j')`, both represent the same element in the colimit.
  have w : ∀ {j j' : J} (f : j ⟶ j'),
    colimit.ι ((curry.obj F).obj j') k' (F.map ((𝟙 j', g j') : (j', k j') ⟶ (j', k')) (y j')) =
    colimit.ι ((curry.obj F).obj j') k' (F.map ((f, g j) : (j, k j) ⟶ (j', k')) (y j)),
  { intros j j' f,
    have t : (f, g j) = (((f, 𝟙 (k j)) : (j, k j) ⟶ (j', k j)) ≫ (𝟙 j', g j) : (j, k j) ⟶ (j', k')),
    { simp only [id_comp, comp_id, prod_comp], },
    erw [colimit.w_apply', t, functor_to_types.map_comp_apply, colimit.w_apply', e,
      ←limit.w_apply' f, ←e],
    simp, },

  -- Because `K` is filtered, we can restate this as saying that
  -- for each such `f`, there is some place to the right of `k'`
  -- where these images of `y j` and `y j'` become equal.
  simp_rw colimit_eq_iff.{v v} at w,

  -- We take a moment to restate `w` more conveniently.
  let kf : Π {j j'} (f : j ⟶ j'), K := λ _ _ f, (w f).some,
  let gf : Π {j j'} (f : j ⟶ j'), k' ⟶ kf f := λ _ _ f, (w f).some_spec.some,
  let hf : Π {j j'} (f : j ⟶ j'), k' ⟶ kf f := λ _ _ f, (w f).some_spec.some_spec.some,
  have wf : Π {j j'} (f : j ⟶ j'),
    F.map ((𝟙 j', g j' ≫ gf f) : (j', k j') ⟶ (j', kf f)) (y j') =
    F.map ((f, g j ≫ hf f) : (j, k j) ⟶ (j', kf f)) (y j) := λ j j' f,
  begin
    have q :
      ((curry.obj F).obj j').map (gf f) (F.map _ (y j')) =
      ((curry.obj F).obj j').map (hf f) (F.map _ (y j)) :=
      (w f).some_spec.some_spec.some_spec,
    dsimp at q,
    simp_rw ←functor_to_types.map_comp_apply at q,
    convert q; simp only [comp_id],
  end,
  clear_value kf gf hf, -- and clean up some things that are no longer needed.
  clear w,

  -- We're now ready to use the fact that `K` is filtered a second time,
  -- picking some place to the right of all of
  -- the morphisms `gf f : k' ⟶ kh f` and `hf f : k' ⟶ kf f`.
  -- At this point we're relying on there being only finitely morphisms in `J`.
  let O := finset.univ.bUnion (λ j, finset.univ.bUnion (λ j', finset.univ.image (@kf j j'))) ∪ {k'},
  have kfO : ∀ {j j'} (f : j ⟶ j'), kf f ∈ O := λ j j' f, finset.mem_union.mpr (or.inl (
  begin
    rw [finset.mem_bUnion],
    refine ⟨j, finset.mem_univ j, _⟩,
    rw [finset.mem_bUnion],
    refine ⟨j', finset.mem_univ j', _⟩,
    rw [finset.mem_image],
    refine ⟨f, finset.mem_univ _, _⟩,
    refl,
  end)),
  have k'O : k' ∈ O := finset.mem_union.mpr (or.inr (finset.mem_singleton.mpr rfl)),
  let H : finset (Σ' (X Y : K) (mX : X ∈ O) (mY : Y ∈ O), X ⟶ Y) :=
    finset.univ.bUnion (λ j : J, finset.univ.bUnion (λ j' : J, finset.univ.bUnion (λ f : j ⟶ j',
      {⟨k', kf f, k'O, kfO f, gf f⟩, ⟨k', kf f, k'O, kfO f, hf f⟩}))),

  obtain ⟨k'', i', s'⟩ := is_filtered.sup_exists O H,
  -- We then restate this slightly more conveniently, as a family of morphism `i f : kf f ⟶ k''`,
  -- satisfying `gf f ≫ i f = hf f' ≫ i f'`.
  let i : Π {j j'} (f : j ⟶ j'), kf f ⟶ k'' := λ j j' f, i' (kfO f),
  have s : ∀ {j₁ j₂ j₃ j₄} (f : j₁ ⟶ j₂) (f' : j₃ ⟶ j₄), gf f ≫ i f = hf f' ≫ i f' :=
  begin
    intros,
    rw [s', s'],
    swap 2,
    exact k'O,
    swap 2,
    { rw [finset.mem_bUnion],
      refine ⟨j₁, finset.mem_univ _, _⟩,
      rw [finset.mem_bUnion],
      refine ⟨j₂, finset.mem_univ _, _⟩,
      rw [finset.mem_bUnion],
      refine ⟨f, finset.mem_univ _, _⟩,
      simp only [true_or, eq_self_iff_true, and_self, finset.mem_insert, heq_iff_eq], },
    { rw [finset.mem_bUnion],
      refine ⟨j₃, finset.mem_univ _, _⟩,
      rw [finset.mem_bUnion],
      refine ⟨j₄, finset.mem_univ _, _⟩,
      rw [finset.mem_bUnion],
      refine ⟨f', finset.mem_univ _, _⟩,
      simp only [eq_self_iff_true, or_true, and_self, finset.mem_insert, finset.mem_singleton,
        heq_iff_eq], }
  end,
  clear_value i,
  clear s' i' H kfO k'O O,

  -- We're finally ready to construct the pre-image, and verify it really maps to `x`.
  fsplit,

  { -- We construct the pre-image (which, recall is meant to be a point
    -- in the colimit (over `K`) of the limits (over `J`)) via a representative at `k''`.
    apply colimit.ι (curry.obj (swap K J ⋙ F) ⋙ limits.lim) k'' _,
    dsimp,
    -- This representative is meant to be an element of a limit,
    -- so we need to construct a family of elements in `F.obj (j, k'')` for varying `j`,
    -- then show that are coherent with respect to morphisms in the `j` direction.
    apply limit.mk.{v v}, swap,
    { -- We construct the elements as the images of the `y j`.
      exact λ j, F.map (⟨𝟙 j, g j ≫ gf (𝟙 j) ≫ i (𝟙 j)⟩ : (j, k j) ⟶ (j, k'')) (y j), },
    { -- After which it's just a calculation, using `s` and `wf`, to see they are coherent.
      dsimp,
      intros j j' f,
      simp only [←functor_to_types.map_comp_apply, prod_comp, id_comp, comp_id],
      calc F.map ((f, g j ≫ gf (𝟙 j) ≫ i (𝟙 j)) : (j, k j) ⟶ (j', k'')) (y j)
          = F.map ((f, g j ≫ hf f ≫ i f) : (j, k j) ⟶ (j', k'')) (y j)
                : by rw s (𝟙 j) f
      ... = F.map ((𝟙 j', i f) : (j', kf f) ⟶ (j', k''))
              (F.map ((f, g j ≫ hf f) : (j, k j) ⟶ (j', kf f)) (y j))
                : by rw [←functor_to_types.map_comp_apply, prod_comp, comp_id, assoc]
      ... = F.map ((𝟙 j', i f) : (j', kf f) ⟶ (j', k''))
              (F.map ((𝟙 j', g j' ≫ gf f) : (j', k j') ⟶ (j', kf f)) (y j'))
                : by rw ←wf f
      ... = F.map ((𝟙 j', g j' ≫ gf f ≫ i f) : (j', k j') ⟶ (j', k'')) (y j')
                : by rw [←functor_to_types.map_comp_apply, prod_comp, id_comp, assoc]
      ... = F.map ((𝟙 j', g j' ≫ gf (𝟙 j') ≫ i (𝟙 j')) : (j', k j') ⟶ (j', k'')) (y j')
                : by rw [s f (𝟙 j'), ←s (𝟙 j') (𝟙 j')], }, },

  -- Finally we check that this maps to `x`.
  { -- We can do this componentwise:
    apply limit_ext',
    intro j,

    -- and as each component is an equation in a colimit, we can verify it by
    -- pointing out the morphism which carries one representative to the other:
    simp only [←e, colimit_eq_iff.{v v}, curry_obj_obj_map, limit.π_mk',
      bifunctor.map_id_comp, id.def, types_comp_apply,
      limits.ι_colimit_limit_to_limit_colimit_π_apply],
    refine ⟨k'', 𝟙 k'', g j ≫ gf (𝟙 j) ≫ i (𝟙 j), _⟩,
    simp only [bifunctor.map_id_comp, types_comp_apply, bifunctor.map_id, types_id_apply], },
end

instance colimit_limit_to_limit_colimit_is_iso :
  is_iso (colimit_limit_to_limit_colimit F) :=
(is_iso_iff_bijective _).mpr
  ⟨colimit_limit_to_limit_colimit_injective F, colimit_limit_to_limit_colimit_surjective F⟩

instance colimit_limit_to_limit_colimit_cone_iso (F : J ⥤ K ⥤ Type v) :
  is_iso (colimit_limit_to_limit_colimit_cone F) :=
begin
  haveI : is_iso (colimit_limit_to_limit_colimit_cone F).hom,
  { dsimp only [colimit_limit_to_limit_colimit_cone], apply_instance },
  apply cones.cone_iso_of_hom_iso,
end

noncomputable instance filtered_colim_preserves_finite_limits_of_types :
  preserves_finite_limits (colim : (K ⥤ Type v) ⥤ _) :=
begin
  apply preserves_finite_limits_of_preserves_finite_limits_of_size.{v},
  intros J _ _, resetI, constructor,
  intro F, constructor,
  intros c hc,
  apply is_limit.of_iso_limit (limit.is_limit _),
  symmetry, transitivity (colim.map_cone (limit.cone F)),
  exact functor.map_iso _ (hc.unique_up_to_iso (limit.is_limit F)),
  exact as_iso (colimit_limit_to_limit_colimit_cone.{v (v + 1)} F),
end

variables {C : Type u} [category.{v} C] [concrete_category.{v} C]
section
variables [has_limits_of_shape J C] [has_colimits_of_shape K C]
variables [reflects_limits_of_shape J (forget C)] [preserves_colimits_of_shape K (forget C)]
variables [preserves_limits_of_shape J (forget C)]

noncomputable
instance filtered_colim_preserves_finite_limits :
  preserves_limits_of_shape J (colim : (K ⥤ C) ⥤ _) :=
begin
  haveI : preserves_limits_of_shape J ((colim : (K ⥤ C) ⥤ _) ⋙ forget C) :=
    preserves_limits_of_shape_of_nat_iso (preserves_colimit_nat_iso _).symm,
  exactI preserves_limits_of_shape_of_reflects_of_preserves _ (forget C)
end
end

local attribute [instance] reflects_limits_of_shape_of_reflects_isomorphisms

noncomputable
instance [preserves_finite_limits (forget C)] [preserves_filtered_colimits (forget C)]
  [has_finite_limits C] [has_colimits_of_shape K C] [reflects_isomorphisms (forget C)] :
    preserves_finite_limits (colim : (K ⥤ C) ⥤ _) :=
begin
  apply preserves_finite_limits_of_preserves_finite_limits_of_size.{v},
  intros J _ _, resetI, apply_instance
end

section

variables [has_limits_of_shape J C] [has_colimits_of_shape K C]
variables [reflects_limits_of_shape J (forget C)] [preserves_colimits_of_shape K (forget C)]
variables [preserves_limits_of_shape J (forget C)]

/-- A curried version of the fact that filtered colimits commute with finite limits. -/
noncomputable def colimit_limit_iso (F : J ⥤ K ⥤ C) :
  colimit (limit F) ≅ limit (colimit F.flip) :=
(is_limit_of_preserves colim (limit.is_limit _)).cone_point_unique_up_to_iso (limit.is_limit _) ≪≫
  (has_limit.iso_of_nat_iso (colimit_flip_iso_comp_colim _).symm)

@[simp, reassoc]
lemma ι_colimit_limit_iso_limit_π (F : J ⥤ K ⥤ C) (a) (b) :
  colimit.ι (limit F) a ≫ (colimit_limit_iso F).hom ≫ limit.π (colimit F.flip) b =
  (limit.π F b).app a ≫ (colimit.ι F.flip a).app b :=
begin
  dsimp [colimit_limit_iso],
  simp only [functor.map_cone_π_app, iso.symm_hom,
    limits.limit.cone_point_unique_up_to_iso_hom_comp_assoc, limits.limit.cone_π,
    limits.colimit.ι_map_assoc, limits.colimit_flip_iso_comp_colim_inv_app, assoc,
    limits.has_limit.iso_of_nat_iso_hom_π],
  congr' 1,
  simp only [← category.assoc, iso.comp_inv_eq,
    limits.colimit_obj_iso_colimit_comp_evaluation_ι_app_hom,
    limits.has_colimit.iso_of_nat_iso_ι_hom, nat_iso.of_components_hom_app],
  dsimp,
  simp,
end

end

end category_theory.limits


import
  tactic
  data.vector
  data.vector3
  data.vector.zip
  init.data.nat.basic
  init.data.nat.div
  data.fintype.card
  data.real.basic
  data.real.sqrt
  algebra.order.field
  analysis.special_functions.pow

universes u v

open_locale big_operators

namespace list

notation `𝔹` := list bool
notation `𝕓` := vector bool

variables {α : Type*} {β : Type*}

lemma join_to_chunks {l : list (list α)} {n : ℕ} (hn : n ≠ 0) (hl : ∀ x ∈ l, length x = n) : l.join.to_chunks n = l :=
begin
  induction l with x l IH; simp,
  have : n = x.length, from (hl x (by simp)).symm,
  rcases this with rfl,
  calc to_chunks x.length (x ++ l.join) = x :: to_chunks x.length l.join
  : by simpa using list.to_chunks_eq_cons hn (by { show x ++ l.join ≠ nil, simp, rintros rfl, exfalso, simpa using hn })
                                    ... = x :: l
  : by rw show to_chunks x.length l.join = l, from IH (λ y hy, hl y (by simp[hy])),
end

lemma reverse_nth (l : list α) {i j} (h : i + j + 1 = l.length) : l.reverse.nth i = l.nth j :=
by { induction l with a l IH generalizing i j, { simp },
  { simp, rcases j,
    { simp, rw[show i = l.reverse.length, by simpa using h, list.nth_concat_length] },
    { simp at h ⊢, rw list.nth_append, exact IH (by omega), { simp, omega } } } }

lemma reverse_nth_le (l : list α) {i j hi hj} (h : i + j + 1 = l.length) : l.reverse.nth_le i hi = l.nth_le j hj :=
option.some_inj.mp (by { rw [←list.nth_le_nth, ←list.nth_le_nth], exact reverse_nth l h })

section sup
variables [linear_order α] [order_bot α]

@[simp] def sup : list α → α
| []        := ⊥
| (a :: as) := a ⊔ as.sup

lemma sup_mem : ∀ {l : list α}, l ≠ [] → l.sup ∈ l
| [] h := by contradiction
| (a :: as) h := by { simp, by_cases C : as = nil,
  { rcases C with rfl, simp },
  { have ih : as.sup ∈ as, from sup_mem C,
    have : as.sup ≤ a ∨ a ≤ as.sup, from le_total (sup as) a,
    rcases this with (le | le),
    { exact or.inl le },
    { have : a ⊔ as.sup = as.sup, from sup_eq_right.mpr le,
      exact or.inr (by simpa[this] using ih) } } }

lemma le_sup_of_mem : ∀ {l : list α} {x}, x ∈ l → x ≤ l.sup
| []        x h := by exfalso; simpa using h
| (a :: as) x h := by { simp at h ⊢, rcases h with (rfl | h), { simp }, { simp[le_sup_of_mem h] } }

@[simp] lemma nth_le_le_sup {l : list α} {i} {h} : l.nth_le i h ≤ l.sup :=
le_sup_of_mem (nth_le_mem l i h)

@[simp] lemma sup_append : ∀ l₁ l₂ : list α, (l₁ ++ l₂).sup = l₁.sup ⊔ l₂.sup
| []        l₂ := by simp
| (a :: l₁) l₂ := by simp[sup_append l₁ l₂, sup_assoc]

end sup

section inf
variables [linear_order α] [order_top α]

@[simp] def inf : list α → α
| []        := ⊤
| (a :: as) := a ⊓ as.inf

lemma inf_mem : ∀ {l : list α}, l ≠ [] → l.inf ∈ l
| [] h := by contradiction
| (a :: as) h := by { simp, by_cases C : as = nil,
  { rcases C with rfl, simp },
  { have ih : as.inf ∈ as, from inf_mem C,
    have : as.inf ≤ a ∨ a ≤ as.inf, from le_total _ _,
    rcases this with (le | le),
    { have : a ⊓ as.inf = as.inf, from inf_eq_right.mpr le,
      exact or.inr (by simpa[this] using ih) },
    { simp[le] } } }

lemma inf_le_of_mem : ∀ {l : list α} {x}, x ∈ l → l.inf ≤ x
| []        x h := by exfalso; simpa using h
| (a :: as) x h := by { simp at h ⊢, rcases h with (rfl | h), { simp }, { simp[inf_le_of_mem h] } }

@[simp] lemma nth_le_le_inf {l : list α} {i} {h} : l.inf ≤ l.nth_le i h :=
inf_le_of_mem (nth_le_mem l i h)

@[simp] lemma inf_append : ∀ l₁ l₂ : list α, (l₁ ++ l₂).inf = l₁.inf ⊓ l₂.inf
| []        l₂ := by simp
| (a :: l₁) l₂ := by simp[inf_append l₁ l₂, inf_assoc]

end inf

end list

namespace vector
variables {α β γ δ : Type*}

section
variables {α} {n : ℕ}

def concat : vector α n → α → vector α n.succ
| ⟨l, h⟩ a := ⟨l.concat a, by simp[h]⟩

end

section zip_with3

variables {α β γ δ} {n : ℕ} (f : α → β → γ → δ)

def zip_with3 (v₁ : vector α n) (v₂ : vector β n) (v₃ : vector γ n) : vector δ n :=
@vector.zip_with (α × β) γ δ n (λ p z, f p.1 p.2 z) (vector.zip_with (λ x y, (x, y)) v₁ v₂) v₃

@[simp] lemma zip_with3_nth (v₁ : vector α n) (v₂ : vector β n) (v₃ : vector γ n) (i) :
  (vector.zip_with3 f v₁ v₂ v₃).nth i = f (v₁.nth i) (v₂.nth i) (v₃.nth i) :=
by simp [vector.zip_with3]

end zip_with3

section sim_update_nth
variables {α} {n m : ℕ}

def sim_update_nth (v : vector (vector α n) m) (i : vector (fin n) m) (a : vector α m) : vector (vector α n) m :=
vector.zip_with3 (λ d i b, vector.update_nth d i b) v i a

@[simp] lemma nth_sim_update_nth {V : vector (vector α n) m} {I : vector (fin n) m} {A : vector α m} {i} :
  ((sim_update_nth V I A).nth i).nth (I.nth i) = A.nth i :=
by simp[sim_update_nth]

lemma nth_sim_update_nth_of_ne {V : vector (vector α n) m} {I : vector (fin n) m} {A : vector α m} (i) {k} (h : I.nth i ≠ k) :
  ((sim_update_nth V I A).nth i).nth k = (V.nth i).nth k :=
by simp[sim_update_nth]; exact nth_update_nth_of_ne h _

lemma nth_sim_update_nth_if {V : vector (vector α n) m} {I : vector (fin n) m} {A : vector α m} (i) {k} :
  ((sim_update_nth V I A).nth i).nth k = if I.nth i = k then A.nth i else (V.nth i).nth k :=
by { by_cases C : I.nth i = k, { simp[←C] }, { simp[C, nth_sim_update_nth_of_ne] } }

end sim_update_nth

section rep
variables {α} (n : ℕ)

abbreviation rep (a : α) {n} : vector α n := repeat a n

end rep

lemma reverse_nth {n} (v : vector α n) {i j : fin n} (h : ↑i + ↑j + 1 = n) : v.reverse.nth i = v.nth j :=
by { rcases v with ⟨v, hv⟩, simp[reverse, nth], refine v.reverse_nth_le (by simp[hv, h]) }

section append
/-
@[simp] lemma nth_append {n₁ n₂} {v₁ : vector α n₁} {v₂ : vector α n₂} {i : fin n₁} {h} :
  (v₁.append v₂).nth ⟨i, h⟩ = v₁.nth i :=
by rcases v₁ with ⟨l₁, rfl⟩; rcases v₂ with ⟨l₂, rfl⟩; refine list.nth_le_append _ _

example (a b c : ℕ) : a + b - a = b := add_tsub_cancel_left a b

@[simp] lemma nth_append_right {n₁ n₂} {v₁ : vector α n₁} {v₂ : vector α n₂} {i : fin n₂} {h} :
  (v₁.append v₂).nth ⟨n₁ + i, h⟩ = v₂.nth i :=
by rcases v₁ with ⟨l₁, rfl⟩; rcases v₂ with ⟨l₂, rfl⟩; by { simp[append, nth],
  simpa[add_tsub_cancel_left] using @list.nth_le_append_right _ l₁ l₂ (l₁.length + i) le_self_add (by simp) }
-/

@[simp] lemma nth_append_of_lt {n₁ n₂} {v₁ : vector α n₁} {v₂ : vector α n₂} {i : ℕ} {h} (hi : i < n₁) :
  (v₁.append v₂).nth ⟨i, h⟩ = v₁.nth ⟨i, hi⟩ :=
by rcases v₁ with ⟨l₁, rfl⟩; rcases v₂ with ⟨l₂, rfl⟩; refine list.nth_le_append _ _

@[simp] lemma nth_append_of_ge {n₁ n₂} {v₁ : vector α n₁} {v₂ : vector α n₂} {i : ℕ} {h} (hi : i ≥ n₁) :
  (v₁.append v₂).nth ⟨i, h⟩ = v₂.nth ⟨i - n₁, by omega⟩ :=
by rcases v₁ with ⟨l₁, rfl⟩; rcases v₂ with ⟨l₂, rfl⟩;
{ simp[nth], refine list.nth_le_append_right hi (by simpa using h) }

end append

section append'

@[simp] def append' {n m : nat} : vector α n → vector α m → vector α (m + n)
| ⟨l₁, h₁⟩ ⟨l₂, h₂⟩ := ⟨ l₁ ++ l₂, by simp[h₁, h₂, add_comm]⟩
-- 以下の帰納法が使えるようなappendの改良版

infixl ` ++ᵥ `:60 := append'

@[simp] lemma append'_nil : ∀ (v₁ : vector α 0) {n} (v₂ : vector α n), v₁ ++ᵥ v₂ = v₂
| ⟨[], _⟩ _ ⟨l, h⟩ := by simp[(++ᵥ)]

@[simp] lemma append'_cons : ∀ {n m} (a : α) (v₁ : vector α n) (v₂ : vector α m), (a ::ᵥ v₁) ++ᵥ v₂ = a ::ᵥ (v₁ ++ᵥ v₂)
| _ _ a ⟨l₁, h₁⟩ ⟨l₂, h₂⟩ := by simp[cons, (++ᵥ)]

lemma to_list_append' : ∀ {n m} (v : vector α n) (w : vector α m), (v ++ᵥ w).to_list = (v.append w).to_list
| _ _ ⟨l₁, h₁⟩ ⟨l₂, h₂⟩ := by simp

@[simp] lemma nth_append'_of_lt {n₁ n₂} {v₁ : vector α n₁} {v₂ : vector α n₂} {i : ℕ} {h} (hi : i < n₁) :
  (v₁ ++ᵥ v₂).nth ⟨i, h⟩ = v₁.nth ⟨i, hi⟩ :=
by rcases v₁ with ⟨l₁, rfl⟩; rcases v₂ with ⟨l₂, rfl⟩; refine list.nth_le_append _ _

@[simp] lemma nth_append'_of_ge {n₁ n₂} {v₁ : vector α n₁} {v₂ : vector α n₂} {i : ℕ} {h} (hi : i ≥ n₁) :
  (v₁ ++ᵥ v₂).nth ⟨i, h⟩ = v₂.nth ⟨i - n₁, by omega⟩ :=
by rcases v₁ with ⟨l₁, rfl⟩; rcases v₂ with ⟨l₂, rfl⟩;
{ simp[nth], refine list.nth_le_append_right hi (by simpa[add_comm] using h) }

end append'

section sup
variables [linear_order α] [order_bot α]

def sup {n} (v : vector α n) := v.to_list.sup

@[simp] lemma nth_le_le_sup {n} {v : vector α n} {i} : v.nth i ≤ v.sup :=
list.le_sup_of_mem (by { rw nth_eq_nth_le, exact list.nth_le_mem _ _ _ })

@[simp] lemma zero_sup : ∀ (v : vector α 0), v.sup = ⊥
| ⟨[], _⟩ := by simp[sup]

@[simp] lemma one_sip : ∀ (v : vector α 1), v.sup = v.head
| ⟨[a], _⟩ := by simp[sup]

@[simp] lemma two_sup : ∀ (v : vector α 2), v.sup = v.head ⊔ v.nth 1
| ⟨[a, b], _⟩ := by simp[sup, head, nth]

@[simp] lemma succ_sup (a : α) {n} (v : vector α n) : (a ::ᵥ v).sup = a ⊔ v.sup :=
by simp[sup]

@[simp] lemma sup_append {n m} (v : vector α n) (w : vector α m) : (v ++ᵥ w).sup = v.sup ⊔ w.sup :=
by rcases v; rcases w; simp[sup]

end sup

section inf
variables [linear_order α] [order_top α]

def inf {n} (v : vector α n) := v.to_list.inf

@[simp] lemma nth_le_le_inf {n} (v : vector α n) (i) : v.inf ≤ v.nth i :=
list.inf_le_of_mem (by { rw nth_eq_nth_le, exact list.nth_le_mem _ _ _ })

@[simp] lemma zero_inf : ∀ (v : vector α 0), v.inf = ⊤
| ⟨[], _⟩ := by simp[inf]

@[simp] lemma one_inf : ∀ (v : vector α 1), v.inf = v.head
| ⟨[a], _⟩ := by simp[inf]

@[simp] lemma two_inf : ∀ (v : vector α 2), v.inf = v.head ⊓ v.nth 1
| ⟨[a, b], _⟩ := by simp[inf, head, nth]

@[simp] lemma succ_inf (a : α) {n} (v : vector α n) : (a ::ᵥ v).inf = a ⊓ v.inf :=
by simp[inf]

@[simp] lemma inf_append {n m} (v : vector α n) (w : vector α m) : (v ++ᵥ w).inf = v.inf ⊓ w.inf :=
by rcases v; rcases w; simp[inf]

end inf

section
variables {α} {n : ℕ}

instance : has_coe α (vector α n) := ⟨λ a, repeat a _⟩

@[simp] lemma coe_val (a : α) : (a : vector α n).to_list = list.repeat a n := rfl

@[simp] lemma coe_head (a : α) : (a : vector α n.succ).head = a := by unfold_coes; simp[repeat, head]

@[simp] lemma coe_nth (a : α) (i) : (a : vector α n).nth i = a := by unfold_coes; simp[nth]

@[simp] lemma coe_ext (h : n ≠ 0) (a b : α) : (a : vector α n) = b ↔ a = b :=
⟨λ h, by {
  rcases n, { contradiction },
  { have : (a : vector α n.succ).nth 0 = (b : vector α n.succ).nth 0, from congr_fun (congr_arg nth h) 0,
    simpa using this } },
  congr_arg coe ⟩

@[simp] lemma coe_head_one : ∀ (v : vector α 1), ↑(v.head) = v
| ⟨[a], _⟩ := by simp[head]; refl

lemma coe_succ (n : ℕ) (a : α) : (a : vector α n.succ) = a ::ᵥ a :=
by unfold_coes; simp[repeat, cons]

end

lemma one_eq : ∀ (v : vector α 1), v.nth 0 ::ᵥ nil = v
| ⟨[a], h⟩         := by simp[head]; refl

lemma two_eq : ∀ (v : vector α 2), v.nth 0 ::ᵥ v.nth 1 ::ᵥ nil = v
| ⟨[a, b], h⟩           := by simpa using h

def half_even {n} (v : vector α (bit0 n)) : vector α n × vector α n :=
have le_bit0 : n ≤ bit0 n, { rw[bit0_eq_two_mul], linarith },
(of_fn (λ i, v.nth ⟨i, gt_of_ge_of_gt le_bit0 i.property⟩),
 of_fn (λ i, v.nth ⟨n + i, by simp[bit0]⟩))

lemma append'_half_even {n} (v : vector α (bit0 n)) : (v.half_even).1 ++ᵥ (v.half_even).2 = v :=
by { ext ⟨i, h⟩, rcases v with ⟨v, hv⟩,
     have : i < n ∨ n ≤ i, from lt_or_ge i n,
     rcases this with (lt | le),
     { simp[lt, half_even], refl }, { simp[le, half_even], refl } }

def half_odd {n} (v : vector α (bit1 n)) : α × vector α n × vector α n := (v.head, v.tail.half_even)

lemma append'_half_odd {n} (v : vector α (bit1 n)) :
  v.half_odd.1 ::ᵥ (v.half_odd).2.1 ++ᵥ (v.half_odd).2.2 = v := by simp[half_odd, append'_half_even]

@[simp] lemma nth_one {n : ℕ} (a b : α) (v : vector α n) : (a ::ᵥ b ::ᵥ v).nth 1 = b :=
by rcases v; simp[cons, nth]

end vector

namespace fin
variables (n : ℕ)

def max : fin n.succ := ⟨n, lt_add_one n⟩

def succ' : fin n → fin n
| ⟨i, hi⟩ := if h : i.succ < n then ⟨i.succ, h⟩ else ⟨i, hi⟩

variables {n}

lemma max_succ_top : (n : fin n.succ) = ⊤ :=
by { ext, rw fin.coe_coe_of_lt, { refl }, { exact lt_add_one n } }

lemma coe_top : ((⊤ : fin n.succ) : ℕ) = n := by refl

lemma lt_top_iff {i : fin n.succ} : i < ⊤ ↔ ↑i < n :=
by rcases i; simp[fin.lt_def]; refl

end fin

namespace finset
variables {α : Type*}

section
variables [decidable_eq α] {n : ℕ} (s : fin n → α)

def of_fn : finset α := (list.of_fn s).to_finset

@[simp] lemma of_fn_card : (of_fn s).card ≤ n :=
by simpa[of_fn] using list.to_finset_card_le (list.of_fn s)

@[simp] lemma mem_of_fn {i} : s i ∈ of_fn s :=
by { simp[of_fn],
     rw[show s i = (list.of_fn s).nth_le i _, from (list.nth_le_of_fn s i).symm],
     exact (list.of_fn s).nth_le_mem _ _ }

lemma mem_of_fn_iff {x} : x ∈ of_fn s ↔ ∃ i, s i = x :=
⟨by { simp[of_fn, list.mem_iff_nth_le], rintros i h rfl, refine ⟨⟨i, h⟩, rfl⟩ },
 by { rintros ⟨i, rfl⟩, exact mem_of_fn s }⟩

end

section
variables [decidable_eq α] {ι : Type*} [fintype ι] (s : ι → α)

def cod (s : ι → α) : finset α := (univ : finset ι).image s

lemma mem_cod_iff {x} : x ∈ cod s ↔ ∃ i, s i = x := by simp[cod]

@[simp] lemma codomain_mem_cod {x} : s x ∈ cod s := by simp[cod]

lemma cod_card : (cod s).card ≤ fintype.card ι :=
  calc
    (image s univ).card ≤ univ.card      : finset.card_image_le
                    ... = fintype.card ι : card_univ

end

section
variables {α} [semilattice_inf α] [order_top α]
  {β : Type*} [decidable_eq β] [semilattice_inf β] [order_top β] {γ : Type*} {s : finset γ} {f : γ → β} {g : β → α}

end

end finset

namespace relation
variables {α : Type u} (r : α → α → Prop) {x y z : α}

def deterministic : Prop := ∀ x y z, r x y → r x z → y = z

inductive transitive_closure : α → α → Prop
| refl : ∀ x, transitive_closure x x
| trans' : ∀ {x y z}, transitive_closure x y → r y z → transitive_closure x z

attribute [simp, refl] transitive_closure.refl

namespace transitive_closure
variables {r}

@[trans] lemma trans (hxy : transitive_closure r x y) (hyz : transitive_closure r y z) : transitive_closure r x z :=
begin
  induction hyz,
  case refl { exact hxy },
  case trans' : _ _ _ _ ry'z' IH { exact (IH hxy).trans' ry'z' }
end

lemma of_r (h : r x y) : transitive_closure r x y := (transitive_closure.refl x).trans' h

end transitive_closure

inductive power : ℕ → α → α → Prop
| zero : ∀ x, power 0 x x
| succ : ∀ {n x y z}, power n x y → r y z → power n.succ x z

attribute [simp, refl] power.zero

namespace power
variables {r}

lemma add {n m} (hn : power r n x y) (hm : power r m y z) : power r (n + m) x z :=
by { induction m with m IH generalizing z, { rcases hm, simpa using hn },
     { rcases hm with (_ | ⟨_, _, v, _, hyv, rvz⟩), simpa using (IH hyv).succ rvz } }

lemma to_trcl {n} (h : power r n x y) : transitive_closure r x y :=
by { induction n with n IH generalizing y, { rcases h, refl }, { rcases h with (_ | ⟨_, _, v, _, hxv, rvy⟩), exact (IH hxv).trans' rvy } }

@[simp] lemma zero_iff : power r 0 x y ↔ x = y :=
⟨by { rintros ⟨⟩, refl }, by { rintros rfl, simp }⟩

lemma one_iff : power r 1 x y ↔ r x y :=
⟨by { rintros (_|⟨_, _, z, _, ⟨⟩, h⟩), exact h }, by { rintros h, exact (power.zero x).succ h }⟩

lemma deterministic {n} (d : deterministic r) : deterministic (power r n) :=
by { induction n with n IH, { rintros x y z ⟨⟩ ⟨⟩, refl },
     { rintros x y z (_ | ⟨_, _, v, _, hxv, rvy⟩) (_ | ⟨_, _, w, _, hxw, rwz⟩),
     have : v = w, from IH x v w hxv hxw, rcases this with rfl,
     refine d v y z rvy rwz } }

lemma succ_inv {k : ℕ} : r x y → power r k y z → power r k.succ x z := λ h hp,
by { have : power r 1 x y, by simp[one_iff, h],
     simpa[show 1 + k = k.succ, by omega] using this.add hp }

end power

lemma trans_iff_epower : transitive_closure r x y ↔ ∃ n, power r n x y :=
⟨λ h, by { induction h with _ x y z hxy ryz IH, { refine ⟨0, by refl⟩ },
           { rcases IH with ⟨n, IH⟩, refine ⟨n.succ, IH.succ ryz⟩ } },
 by { rintros ⟨n, h⟩, refine h.to_trcl }⟩

def power_le (k : ℕ) (x y : α) : Prop := ∃ n ≤ k, power r n x y

namespace power_le
variables {r}

@[refl, simp] lemma refl {k : ℕ} : power_le r k x x := ⟨0, by simp⟩

lemma of_le {k l : ℕ} (le : k ≤ l) : power_le r k x y → power_le r l x y :=
by { rintros ⟨n, len, h⟩, refine ⟨n, le_trans len le, h⟩ }

lemma succ {k : ℕ} : power_le r k x y → r y z → power_le r k.succ x z :=
by { rintros ⟨n, len, hn⟩ ryz, refine ⟨n.succ, nat.succ_le_succ len, hn.succ ryz⟩ }

@[trans] lemma add {k l : ℕ} : power_le r k x y → power_le r l y z → power_le r (k + l) x z :=
by { rintros ⟨n, len, hn⟩ ⟨m, lem, hm⟩, refine ⟨ n + m, add_le_add len lem, hn.add hm⟩ }

end power_le

end relation

section complete_lattice
variables {ι₁ : Sort*} {ι₂ : Sort*} {κ : ι₁ → ι₂ → Sort*} {α : Type*} [complete_lattice α]

lemma le_supr₃ {f : Π i j, κ i j → α} (i : ι₁) (j : ι₂) (k : κ i j) : f i j k ≤ ⨆ i j k, f i j k :=
le_supr_of_le i $ le_supr_of_le j $ le_supr (f i j) k

end complete_lattice

namespace set
variables {ι₁ : Sort*} {ι₂ : Sort*} {κ : ι₁ → ι₂ → Sort*} {α : Type*}

lemma subset_Union₃ {f : Π i j, κ i j → set α} (i : ι₁) (j : ι₂) (k : κ i j) : f i j k ⊆ ⋃ i j k, f i j k :=
@le_supr₃ _ _ _ _ _ f i j k

end set

namespace nat

lemma bit_ff (n : ℕ) : bit ff n = 2 * n := bit0_eq_two_mul n

lemma bit_tt (n : ℕ) : bit tt n = 2 * n + 1 := by simpa[bit, bit1] using bit0_eq_two_mul n

attribute [simp] div2_bit

@[simp] lemma bit_div2 : ∀ n : ℕ, bit n.bodd n.div2 = n :=
binary_rec (by simp[bit_ff]) (λ b n IH, by simp[bodd_bit, div2_bit])

noncomputable def of_real (f : ℝ → ℝ → ℝ) (r : ℝ) (n : ℕ) : ℕ := floor (f r n)

noncomputable def pow_le_two_mul_pow_of_le_bound (k : ℕ) : ℕ := ⌈(1 / (2^(k : ℝ)⁻¹ - 1) : ℝ)⌉₊

lemma pow_le_two_mul_pow_of_le {m : ℕ} (hm : m ≠ 0) {n : ℕ} (h : pow_le_two_mul_pow_of_le_bound m ≤ n) : (n + 1)^m ≤ 2 * n^m :=
begin
  have : (1 / (2^(m : ℝ)⁻¹ - 1) : ℝ) ≤ n, from ceil_le.mp h,
  have : 1 ≤ (n : ℝ) * (2^(m : ℝ)⁻¹ - 1),
    from (div_le_iff (by simp; refine real.one_lt_rpow one_lt_two (by simpa using zero_lt_iff.mpr hm))).mp this,
  have : ((n + 1 : ℕ) : ℝ) ≤ (n : ℝ) * 2^(m : ℝ)⁻¹, { simp [mul_sub, cast_succ] at this ⊢, exact le_sub_iff_add_le'.mp this },
  have : ((n + 1 : ℕ) : ℝ)^(m : ℝ) ≤ ((n : ℝ) * 2^(m : ℝ)⁻¹)^(m : ℝ), from real.rpow_le_rpow (n + 1).cast_nonneg this m.cast_nonneg,
  have : (↑((n + 1)^m) : ℝ) ≤ (↑(2 * n^m) : ℝ),
  calc
    (↑((n + 1)^m) : ℝ) = ((n + 1 : ℕ) : ℝ)^(m : ℝ) : by simp
                    ... ≤ ((n : ℝ) * 2^(m : ℝ)⁻¹)^(m : ℝ) : this
                    ... = ((n : ℝ)^(m : ℝ) * 2^((m : ℝ)⁻¹ * (m : ℝ))) : by rw [real.rpow_mul zero_le_two]; simp[mul_pow]
                    ... = ((n : ℝ)^(m : ℝ) * 2) : by rw [inv_mul_cancel, real.rpow_one]; exact cast_ne_zero.mpr hm
                    ... = (↑(2 * n^m) : ℝ) : by simp[mul_comm],
  refine nat.cast_le.mp this
end

end nat


import Smt

theorem prop_ext (p q : Bool) : (p ↔ q) → p == q := by
  smt
  intro ⟨hpq, hqp⟩
  cases p <;> cases q <;> simp_all


/-
Copyright (c) 2020 Bhavik Mehta, E. W. Ayers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, E. W. Ayers
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.sites.sieves
import Mathlib.category_theory.limits.shapes.pullbacks
import Mathlib.order.copy
import Mathlib.PostPort

universes v u l

namespace Mathlib

/-!
# Grothendieck topologies

Definition and lemmas about Grothendieck topologies.
A Grothendieck topology for a category `C` is a set of sieves on each object `X` satisfying
certain closure conditions.

Alternate versions of the axioms (in arrow form) are also described.
Two explicit examples of Grothendieck topologies are given:
* The dense topology
* The atomic topology
as well as the complete lattice structure on Grothendieck topologies (which gives two additional
explicit topologies: the discrete and trivial topologies.)

A pretopology, or a basis for a topology is defined in `pretopology.lean`. The topology associated
to a topological space is defined in `spaces.lean`.

## Tags

Grothendieck topology, coverage, pretopology, site

## References

* [https://ncatlab.org/nlab/show/Grothendieck+topology][nlab]
* [S. MacLane, I. Moerdijk, *Sheaves in Geometry and Logic*][MM91]

## Implementation notes

We use the definition of [nlab] and [MM91](Chapter III, Section 2), where Grothendieck topologies
are saturated collections of morphisms, rather than the notions of the Stacks project (00VG) and
the Elephant, in which topologies are allowed to be unsaturated, and are then completed.
TODO (BM): Add the definition from Stacks, as a pretopology, and complete to a topology.

This is so that we can produce a bijective correspondence between Grothendieck topologies on a
small category and Lawvere-Tierney topologies on its presheaf topos, as well as the equivalence
between Grothendieck topoi and left exact reflective subcategories of presheaf toposes.
-/

namespace category_theory

/--
The definition of a Grothendieck topology: a set of sieves `J X` on each object `X` satisfying
three axioms:
1. For every object `X`, the maximal sieve is in `J X`.
2. If `S ∈ J X` then its pullback along any `h : Y ⟶ X` is in `J Y`.
3. If `S ∈ J X` and `R` is a sieve on `X`, then provided that the pullback of `R` along any arrow
   `f : Y ⟶ X` in `S` is in `J Y`, we have that `R` itself is in `J X`.

A sieve `S` on `X` is referred to as `J`-covering, (or just covering), if `S ∈ J X`.

See https://stacks.math.columbia.edu/tag/00Z4, or [nlab], or [MM92] Chapter III, Section 2,
Definition 1.
-/
structure grothendieck_topology (C : Type u) [category C] where
  sieves : (X : C) → set (sieve X)
  top_mem' : ∀ (X : C), ⊤ ∈ sieves X
  pullback_stable' :
    ∀ {X Y : C} {S : sieve X} (f : Y ⟶ X), S ∈ sieves X → sieve.pullback f S ∈ sieves Y
  transitive' :
    ∀ {X : C} {S : sieve X},
      S ∈ sieves X →
        ∀ (R : sieve X),
          (∀ {Y : C} {f : Y ⟶ X}, coe_fn S Y f → sieve.pullback f R ∈ sieves Y) → R ∈ sieves X

namespace grothendieck_topology

protected instance has_coe_to_fun (C : Type u) [category C] :
    has_coe_to_fun (grothendieck_topology C) :=
  has_coe_to_fun.mk (fun (J : grothendieck_topology C) => (X : C) → set (sieve X))
    fun (J : grothendieck_topology C) => sieves J

/--
An extensionality lemma in terms of the coercion to a pi-type.
We prove this explicitly rather than deriving it so that it is in terms of the coercion rather than
the projection `.sieves`.
-/
theorem ext {C : Type u} [category C] {J₁ : grothendieck_topology C} {J₂ : grothendieck_topology C}
    (h : ⇑J₁ = ⇑J₂) : J₁ = J₂ :=
  sorry

@[simp] theorem mem_sieves_iff_coe {C : Type u} [category C] {X : C} {S : sieve X}
    (J : grothendieck_topology C) : S ∈ sieves J X ↔ S ∈ coe_fn J X :=
  iff.rfl

-- Also known as the maximality axiom.

-- Also known as the stability axiom.

@[simp] theorem top_mem {C : Type u} [category C] (J : grothendieck_topology C) (X : C) :
    ⊤ ∈ coe_fn J X :=
  top_mem' J X

@[simp] theorem pullback_stable {C : Type u} [category C] {X : C} {Y : C} {S : sieve X}
    (J : grothendieck_topology C) (f : Y ⟶ X) (hS : S ∈ coe_fn J X) :
    sieve.pullback f S ∈ coe_fn J Y :=
  pullback_stable' J f hS

theorem transitive {C : Type u} [category C] {X : C} {S : sieve X} (J : grothendieck_topology C)
    (hS : S ∈ coe_fn J X) (R : sieve X)
    (h : ∀ {Y : C} {f : Y ⟶ X}, coe_fn S Y f → sieve.pullback f R ∈ coe_fn J Y) : R ∈ coe_fn J X :=
  transitive' J hS R h

theorem covering_of_eq_top {C : Type u} [category C] {X : C} {S : sieve X}
    (J : grothendieck_topology C) : S = ⊤ → S ∈ coe_fn J X :=
  fun (h : S = ⊤) => Eq.symm h ▸ top_mem J X

/--
If `S` is a subset of `R`, and `S` is covering, then `R` is covering as well.

See https://stacks.math.columbia.edu/tag/00Z5 (2), or discussion after [MM92] Chapter III,
Section 2, Definition 1.
-/
theorem superset_covering {C : Type u} [category C] {X : C} {S : sieve X} {R : sieve X}
    (J : grothendieck_topology C) (Hss : S ≤ R) (sjx : S ∈ coe_fn J X) : R ∈ coe_fn J X :=
  sorry

/--
The intersection of two covering sieves is covering.

See https://stacks.math.columbia.edu/tag/00Z5 (1), or [MM92] Chapter III,
Section 2, Definition 1 (iv).
-/
theorem intersection_covering {C : Type u} [category C] {X : C} {S : sieve X} {R : sieve X}
    (J : grothendieck_topology C) (rj : R ∈ coe_fn J X) (sj : S ∈ coe_fn J X) :
    R ⊓ S ∈ coe_fn J X :=
  sorry

@[simp] theorem intersection_covering_iff {C : Type u} [category C] {X : C} {S : sieve X}
    {R : sieve X} (J : grothendieck_topology C) :
    R ⊓ S ∈ coe_fn J X ↔ R ∈ coe_fn J X ∧ S ∈ coe_fn J X :=
  sorry

theorem bind_covering {C : Type u} [category C] {X : C} (J : grothendieck_topology C) {S : sieve X}
    {R : {Y : C} → {f : Y ⟶ X} → coe_fn S Y f → sieve Y} (hS : S ∈ coe_fn J X)
    (hR : ∀ {Y : C} {f : Y ⟶ X} (H : coe_fn S Y f), R H ∈ coe_fn J Y) :
    sieve.bind (⇑S) R ∈ coe_fn J X :=
  transitive J hS (sieve.bind (⇑S) R)
    fun (Y : C) (f : Y ⟶ X) (hf : coe_fn S Y f) =>
      superset_covering J (sieve.le_pullback_bind (⇑S) R f hf) (hR hf)

/--
The sieve `S` on `X` `J`-covers an arrow `f` to `X` if `S.pullback f ∈ J Y`.
This definition is an alternate way of presenting a Grothendieck topology.
-/
def covers {C : Type u} [category C] {X : C} {Y : C} (J : grothendieck_topology C) (S : sieve X)
    (f : Y ⟶ X) :=
  sieve.pullback f S ∈ coe_fn J Y

theorem covers_iff {C : Type u} [category C] {X : C} {Y : C} (J : grothendieck_topology C)
    (S : sieve X) (f : Y ⟶ X) : covers J S f ↔ sieve.pullback f S ∈ coe_fn J Y :=
  iff.rfl

theorem covering_iff_covers_id {C : Type u} [category C] {X : C} (J : grothendieck_topology C)
    (S : sieve X) : S ∈ coe_fn J X ↔ covers J S 𝟙 :=
  sorry

/-- The maximality axiom in 'arrow' form: Any arrow `f` in `S` is covered by `S`. -/
theorem arrow_max {C : Type u} [category C] {X : C} {Y : C} (J : grothendieck_topology C)
    (f : Y ⟶ X) (S : sieve X) (hf : coe_fn S Y f) : covers J S f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (covers J S f)) (covers.equations._eqn_1 J S f)))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (sieve.pullback f S ∈ coe_fn J Y))
          (iff.mp (sieve.pullback_eq_top_iff_mem f) hf)))
      (top_mem J Y))

/-- The stability axiom in 'arrow' form: If `S` covers `f` then `S` covers `g ≫ f` for any `g`. -/
theorem arrow_stable {C : Type u} [category C] {X : C} {Y : C} (J : grothendieck_topology C)
    (f : Y ⟶ X) (S : sieve X) (h : covers J S f) {Z : C} (g : Z ⟶ Y) : covers J S (g ≫ f) :=
  sorry

/--
The transitivity axiom in 'arrow' form: If `S` covers `f` and every arrow in `S` is covered by
`R`, then `R` covers `f`.
-/
theorem arrow_trans {C : Type u} [category C] {X : C} {Y : C} (J : grothendieck_topology C)
    (f : Y ⟶ X) (S : sieve X) (R : sieve X) (h : covers J S f) :
    (∀ {Z : C} (g : Z ⟶ X), coe_fn S Z g → covers J R g) → covers J R f :=
  sorry

theorem arrow_intersect {C : Type u} [category C] {X : C} {Y : C} (J : grothendieck_topology C)
    (f : Y ⟶ X) (S : sieve X) (R : sieve X) (hS : covers J S f) (hR : covers J R f) :
    covers J (S ⊓ R) f :=
  sorry

/--
The trivial Grothendieck topology, in which only the maximal sieve is covering. This topology is
also known as the indiscrete, coarse, or chaotic topology.

See [MM92] Chapter III, Section 2, example (a), or
https://en.wikipedia.org/wiki/Grothendieck_topology#The_discrete_and_indiscrete_topologies
-/
def trivial (C : Type u) [category C] : grothendieck_topology C :=
  mk (fun (X : C) => singleton ⊤) sorry sorry sorry

/--
The discrete Grothendieck topology, in which every sieve is covering.

See https://en.wikipedia.org/wiki/Grothendieck_topology#The_discrete_and_indiscrete_topologies.
-/
def discrete (C : Type u) [category C] : grothendieck_topology C :=
  mk (fun (X : C) => set.univ) sorry sorry sorry

theorem trivial_covering {C : Type u} [category C] {X : C} {S : sieve X} :
    S ∈ coe_fn (trivial C) X ↔ S = ⊤ :=
  set.mem_singleton_iff

/-- See https://stacks.math.columbia.edu/tag/00Z6 -/
protected instance partial_order {C : Type u} [category C] :
    partial_order (grothendieck_topology C) :=
  partial_order.mk (fun (J₁ J₂ : grothendieck_topology C) => ⇑J₁ ≤ ⇑J₂)
    (preorder.lt._default fun (J₁ J₂ : grothendieck_topology C) => ⇑J₁ ≤ ⇑J₂) sorry sorry sorry

/-- See https://stacks.math.columbia.edu/tag/00Z7 -/
protected instance has_Inf {C : Type u} [category C] : has_Inf (grothendieck_topology C) :=
  has_Inf.mk fun (T : set (grothendieck_topology C)) => mk (Inf (sieves '' T)) sorry sorry sorry

/-- See https://stacks.math.columbia.edu/tag/00Z7 -/
theorem is_glb_Inf {C : Type u} [category C] (s : set (grothendieck_topology C)) :
    is_glb s (Inf s) :=
  is_glb.of_image (fun (x y : grothendieck_topology C) => iff.refl (sieves x ≤ sieves y))
    (is_glb_Inf (sieves '' s))

/--
Construct a complete lattice from the `Inf`, but make the trivial and discrete topologies
definitionally equal to the bottom and top respectively.
-/
protected instance complete_lattice {C : Type u} [category C] :
    complete_lattice (grothendieck_topology C) :=
  complete_lattice.copy (complete_lattice_of_Inf (grothendieck_topology C) is_glb_Inf)
    complete_lattice.le sorry (discrete C) sorry (trivial C) sorry complete_lattice.sup sorry
    complete_lattice.inf sorry complete_lattice.Sup sorry Inf sorry

protected instance inhabited {C : Type u} [category C] : Inhabited (grothendieck_topology C) :=
  { default := ⊤ }

@[simp] theorem trivial_eq_bot {C : Type u} [category C] : trivial C = ⊥ := rfl

@[simp] theorem discrete_eq_top {C : Type u} [category C] : discrete C = ⊤ := rfl

@[simp] theorem bot_covering {C : Type u} [category C] {X : C} {S : sieve X} :
    S ∈ coe_fn ⊥ X ↔ S = ⊤ :=
  trivial_covering

@[simp] theorem top_covering {C : Type u} [category C] {X : C} {S : sieve X} : S ∈ coe_fn ⊤ X :=
  True.intro

theorem bot_covers {C : Type u} [category C] {X : C} {Y : C} (S : sieve X) (f : Y ⟶ X) :
    covers ⊥ S f ↔ coe_fn S Y f :=
  sorry

@[simp] theorem top_covers {C : Type u} [category C] {X : C} {Y : C} (S : sieve X) (f : Y ⟶ X) :
    covers ⊤ S f :=
  eq.mpr (id (Eq.trans (propext (covers_iff ⊤ S f)) (propext (iff_true_intro top_covering))))
    trivial

/--
The dense Grothendieck topology.

See https://ncatlab.org/nlab/show/dense+topology, or [MM92] Chapter III, Section 2, example (e).
-/
def dense {C : Type u} [category C] : grothendieck_topology C :=
  mk
    (fun (X : C) (S : sieve X) =>
      ∀ {Y : C} (f : Y ⟶ X), ∃ (Z : C), ∃ (g : Z ⟶ Y), coe_fn S Z (g ≫ f))
    sorry sorry sorry

theorem dense_covering {C : Type u} [category C] {X : C} {S : sieve X} :
    S ∈ coe_fn dense X ↔ ∀ {Y : C} (f : Y ⟶ X), ∃ (Z : C), ∃ (g : Z ⟶ Y), coe_fn S Z (g ≫ f) :=
  iff.rfl

/--
A category satisfies the right Ore condition if any span can be completed to a commutative square.
NB. Any category with pullbacks obviously satisfies the right Ore condition, see
`right_ore_of_pullbacks`.
-/
def right_ore_condition (C : Type u) [category C] :=
  ∀ {X Y Z : C} (yx : Y ⟶ X) (zx : Z ⟶ X),
    ∃ (W : C), ∃ (wy : W ⟶ Y), ∃ (wz : W ⟶ Z), wy ≫ yx = wz ≫ zx

theorem right_ore_of_pullbacks {C : Type u} [category C] [limits.has_pullbacks C] :
    right_ore_condition C :=
  fun (X Y Z : C) (yx : Y ⟶ X) (zx : Z ⟶ X) =>
    Exists.intro (limits.pullback yx zx)
      (Exists.intro limits.pullback.fst
        (Exists.intro limits.pullback.snd limits.pullback.condition))

/--
The atomic Grothendieck topology: a sieve is covering iff it is nonempty.
For the pullback stability condition, we need the right Ore condition to hold.

See https://ncatlab.org/nlab/show/atomic+site, or [MM92] Chapter III, Section 2, example (f).
-/
def atomic {C : Type u} [category C] (hro : right_ore_condition C) : grothendieck_topology C :=
  mk (fun (X : C) (S : sieve X) => ∃ (Y : C), ∃ (f : Y ⟶ X), coe_fn S Y f) sorry sorry sorry

end Mathlib