import algebraic_topology.simplicial_set
import category_theory.limits.kan_extension
import for_mathlib.split_simplicial_object
import for_mathlib.category_theory.limits.concrete
import data.fintype.basic

noncomputable theory

universes u

open category_theory
open category_theory.limits
open opposite
open_locale simplicial

namespace simplex_category

section
variables {X Y : simplex_category} (θ : X ⟶ Y)
instance : strong_epi (factor_thru_image θ) :=
strong_epi_factor_thru_image_of_strong_epi_mono_factorisation
  (has_strong_epi_mono_factorisations.has_fac θ).some

lemma is_iso_of_epi_and_card [hθ : epi θ] (h : X.len = Y.len) : is_iso θ :=
begin
  apply is_iso_of_bijective,
  split,
  { by_contra h',
    rw epi_iff_surjective at hθ,
    simpa only [fintype.card_fin, add_lt_add_iff_right, h, lt_self_iff_false]
      using fintype.card_lt_of_surjective_not_injective _ hθ h', },
  { change function.surjective θ.to_order_hom,
    rw ← epi_iff_surjective,
    apply_instance, },
end

end

--protected def rec {F : Π (X : simplex_category), Sort u} (h : ∀ (n : ℕ), F [n]) :
--  Π X, F X := λ n, h n.len

end simplex_category

namespace sSet

lemma map_comp' (X : sSet) {Δ₀ Δ₁ Δ₂ : simplex_categoryᵒᵖ} (θ : Δ₀ ⟶ Δ₁) (θ' : Δ₁ ⟶ Δ₂)
  (x : X.obj Δ₀) : X.map (θ ≫ θ') x = X.map θ' (X.map θ x) :=
congr_fun (X.map_comp θ θ') x

namespace truncated

def i (n : ℕ) : truncated n ⥤ sSet.{u} :=
Lan simplex_category.truncated.inclusion.op

def adjunction (n : ℕ) : i n ⊣ sk n :=
category_theory.Lan.adjunction _ simplex_category.truncated.inclusion.op

instance adjunction.unit_is_iso (n : ℕ) : is_iso (adjunction n).unit :=
Lan.coreflective _ _

end truncated

def sk' (n : ℕ) : sSet ⥤ sSet := sk n ⋙ truncated.i n

def ι_sk' (n : ℕ) : sk' n ⟶ 𝟭 sSet := (truncated.adjunction n).counit

instance sk_ι_sk'_is_iso (n : ℕ) : is_iso (whisker_right (ι_sk' n) (sk.{u} n)) :=
begin
  let f := (whisker_left (sk.{u} n) (truncated.adjunction n).unit),
  let g := whisker_right (truncated.adjunction n).counit (sk.{u} n),
  haveI : is_iso (f ≫ g),
  { rw (truncated.adjunction n).right_triangle,
    apply_instance, },
  change is_iso g,
  exact is_iso.of_is_iso_comp_left f g,
end

lemma ι_sk'_bij (X : sSet) (n : ℕ) (Δ : simplex_categoryᵒᵖ) (h : Δ.unop.len ≤ n) :
  is_iso (((ι_sk' n).app X).app Δ) :=
begin
  induction Δ using opposite.rec,
  have h' : ∃ (Δ' : simplex_category.truncated n), Δ = Δ'.1 := ⟨⟨Δ, h⟩, rfl⟩,
  cases h' with Δ' hΔ',
  subst hΔ',
  let e := as_iso (whisker_right (ι_sk' n) (sk n)),
  exact is_iso.of_iso ((e.app X).app (opposite.op Δ')),
end

def simplex_is_degenerate {X : sSet} {Δ : simplex_categoryᵒᵖ} (x : X.obj Δ) : Prop :=
∃ (Δ' : simplex_categoryᵒᵖ) (θ : Δ' ⟶ Δ) (hθ₁ : epi θ.unop) (hθ₂ : ¬mono θ.unop)
  (y : X.obj Δ'), x = X.map θ y

@[simp]
def nondegenerate_simplices (X : sSet) (Δ : simplex_categoryᵒᵖ) : set (X.obj Δ) :=
compl simplex_is_degenerate

lemma is_iso_of_nondegenerate_simplices {X : sSet} {Δ Δ' : simplex_categoryᵒᵖ}
  (x : X.nondegenerate_simplices Δ) (θ : Δ' ⟶ Δ) (hθ : epi θ.unop) (y : X.obj Δ')
  (hy : x.1 = X.map θ y) : is_iso θ :=
begin
  suffices : is_iso θ.unop,
  { haveI := this,
    change is_iso θ.unop.op,
    apply_instance, },
  apply simplex_category.is_iso_of_bijective,
  split,
  { change function.injective θ.unop.to_order_hom,
    rw ← simplex_category.mono_iff_injective,
    by_contra,
    exact x.2 ⟨Δ', θ, hθ, h, y, hy⟩, },
  { change function.surjective θ.unop.to_order_hom,
    rw ← simplex_category.epi_iff_surjective,
    exact hθ, },
end

@[simp]
def ι_nondegenerate_simplices (X : sSet.{u}) (Δ : simplex_categoryᵒᵖ) :
  (X.nondegenerate_simplices Δ : Type u) ⟶ X.obj Δ := subtype.val

lemma zero_simplices_are_nondegenerate (X : sSet) : X.nondegenerate_simplices (op [0]) = ⊤ :=
begin
  ext,
  split,
  { intro h,
    simp only [set.top_eq_univ], },
  { intros h₀ h,
    rcases h with ⟨Δ', θ, hθ₁, hθ₂, y, hy⟩,
    apply hθ₂,
    rw simplex_category.mono_iff_injective,
    intros a₁ a₂ h,
    rw [fin.eq_zero a₁, fin.eq_zero a₂], },
end

lemma is_epi_image_of_nondegenerate_simplex (X : sSet) {Δ : simplex_categoryᵒᵖ} (x : X.obj Δ) :
  ∃ (Δ' : simplex_categoryᵒᵖ) (θ : Δ' ⟶ Δ) (hθ : epi θ.unop) (y : X.obj Δ')
    (hy : y ∈ X.nondegenerate_simplices Δ'), x = X.map θ y :=
begin
  induction Δ using opposite.rec,
  induction Δ with n,
  induction n using nat.strong_rec' with n hn,
  cases n,
  { refine ⟨op [0], 𝟙 _, infer_instance, x, _, by simp only [functor_to_types.map_id_apply]⟩,
    rw zero_simplices_are_nondegenerate,
    simp only [set.top_eq_univ], },
 { by_cases x ∈ X.nondegenerate_simplices (op [n.succ]),
    { exact ⟨_, 𝟙 _, infer_instance, x, h, by simp only [functor_to_types.map_id_apply]⟩, },
    { dsimp [nondegenerate_simplices] at h,
      simp only [set.not_not_mem] at h,
      rcases h with ⟨Δ', π, hπ₁, hπ₂, y, hy⟩,
      induction Δ' using opposite.rec,
      induction Δ' with m,
      have hm : m < n.succ,
      { have hπ₁' := (simplex_category.len_le_of_epi hπ₁),
        dsimp at hπ₁',
        cases hπ₁'.lt_or_eq,
        { assumption, },
        { subst h,
          exfalso,
          apply hπ₂,
          rw simplex_category.mono_iff_injective,
          rw simplex_category.epi_iff_surjective at hπ₁,
          rw finite.injective_iff_bijective at ⊢,
          rw finite.surjective_iff_bijective at hπ₁,
          assumption, }, },
      rcases hn m hm y with ⟨Δ'', θ, hθ, z, hz, eq⟩,
      haveI := hπ₁,
      haveI := hθ,
      refine ⟨Δ'', θ ≫ π, by { rw unop_comp, apply epi_comp, }, z, hz, _⟩,
      simp only [functor_to_types.map_comp_apply, hy, eq], }, },
end

--lemma splitting.sum.concrete_bijective (N : ℕ → Type u) (Δ : simplex_categoryᵒᵖ) :
--  function.bijective (limits.concrete.coproduct_map (simplicial_object.splitting.summand N Δ) :
--    sigma (simplicial_object.splitting.summand N Δ) → simplicial_object.splitting.sum N Δ) :=
--limits.concrete.coproduct_map_bijective _

lemma image_of_nondegenerate_simplex_uniqueness₀ (X : sSet)
  {Δ Δ₁ Δ₂ : simplex_categoryᵒᵖ} (y₁ : X.obj Δ₁) (y₂ : X.obj Δ₂)
  (hy₁ : y₁ ∈ X.nondegenerate_simplices Δ₁)
  (θ₁ : Δ₁ ⟶ Δ) (θ₂ : Δ₂ ⟶ Δ) (hθ₁ : epi θ₁.unop) (hθ₂ : epi θ₂.unop)
  (eq : X.map θ₁ y₁ = X.map θ₂ y₂) : Δ₁.unop.len ≤ Δ₂.unop.len :=
begin
  haveI := is_split_epi_of_epi θ₁.unop,
  let f := section_ θ₁.unop ≫ θ₂.unop,
  have eq₁ : y₁ = X.map f.op y₂,
  { dsimp only [f],
    rw [op_comp, X.map_comp', quiver.hom.op_unop, ← eq, ← X.map_comp'],
    change _ = X.map (θ₁.unop.op ≫ _) _,
    rw [← op_comp, is_split_epi.id θ₁.unop, op_id, X.map_id, types_id_apply], },
  let F := limits.image.mono_factorisation f,
  rw [← F.fac, op_comp, X.map_comp'] at eq₁,
  haveI : epi F.e := by { simp only [limits.as_factor_thru_image], apply_instance, },
  haveI he := is_iso_of_nondegenerate_simplices ⟨y₁, hy₁⟩ F.e.op infer_instance _ eq₁,
  haveI : is_iso F.e,
  { change is_iso F.e.op.unop,
    apply_instance, },
  have hf : mono f,
  { rw ← F.fac,
    apply mono_comp, },
  exact simplex_category.len_le_of_mono hf,
end

lemma image_of_nondegenerate_simplex_uniqueness₁ (X : sSet)
  {Δ Δ₁ Δ₂ : simplex_categoryᵒᵖ} (y₁ : X.obj Δ₁) (y₂ : X.obj Δ₂)
  (hy₁ : y₁ ∈ X.nondegenerate_simplices Δ₁) (hy₂ : y₂ ∈ X.nondegenerate_simplices Δ₂)
  (θ₁ : Δ₁ ⟶ Δ) (θ₂ : Δ₂ ⟶ Δ) (hθ₁ : epi θ₁.unop) (hθ₂ : epi θ₂.unop)
  (eq : X.map θ₁ y₁ = X.map θ₂ y₂) : Δ₁ = Δ₂ :=
begin
  unfreezingI { induction Δ₁ using opposite.rec, induction Δ₂ using opposite.rec, },
  congr,
  ext,
  apply le_antisymm,
  { exact image_of_nondegenerate_simplex_uniqueness₀ X y₁ y₂ hy₁ θ₁ θ₂ hθ₁ hθ₂ eq, },
  { exact image_of_nondegenerate_simplex_uniqueness₀ X y₂ y₁ hy₂ θ₂ θ₁ hθ₂ hθ₁ eq.symm, },
end

lemma image_of_nondegenerate_simplex_uniqueness₂ (X : sSet)
  {Δ Δ' : simplex_categoryᵒᵖ} (y₁ : X.obj Δ') (y₂ : X.obj Δ')
  (hy₁ : y₁ ∈ X.nondegenerate_simplices Δ') (hy₂ : y₂ ∈ X.nondegenerate_simplices Δ')
  (θ₁ : Δ' ⟶ Δ) (θ₂ : Δ' ⟶ Δ) (hθ₁ : epi θ₁.unop) (hθ₂ : epi θ₂.unop)
  (eq : X.map θ₁ y₁ = X.map θ₂ y₂) : y₁ = y₂ :=
begin
  haveI := is_split_epi_of_epi θ₁.unop,
  let f := section_ θ₁.unop ≫ θ₂.unop,
  have eq₁ : y₁ = X.map f.op y₂,
  { dsimp only [f],
    rw [op_comp, X.map_comp', quiver.hom.op_unop, ← eq, ← X.map_comp'],
    change _ = X.map (θ₁.unop.op ≫ _) _,
    rw [← op_comp, is_split_epi.id θ₁.unop, op_id, X.map_id, types_id_apply], },
  have eq₂ := eq₁,
  let F := limits.image.mono_factorisation f,
  rw [← F.fac, op_comp, X.map_comp'] at eq₂,
  haveI : epi F.e := by { simp only [limits.as_factor_thru_image], apply_instance, },
  haveI he := is_iso_of_nondegenerate_simplices ⟨y₁, hy₁⟩ F.e.op infer_instance _ eq₂,
  haveI : is_iso F.e,
  { change is_iso F.e.op.unop,
    apply_instance, },
  haveI : mono f,
  { rw ← F.fac,
    apply mono_comp, },
  simpa only [simplex_category.eq_id_of_mono f, op_id, X.map_id, types_id_apply] using eq₁,
end

lemma ext_epi_of_sections {Δ₁ Δ₂ : simplex_category} (θ₁ θ₂ : Δ₁ ⟶ Δ₂) [epi θ₁]
  (h : ∀ (s : split_epi θ₁), s.section_ ≫ θ₂ = 𝟙 _) : θ₁ = θ₂ :=
begin
  ext1, ext1, ext1 x,
  have h₂ : ∃ (s : split_epi θ₁), s.section_.to_order_hom (θ₁.to_order_hom x) = x,
  { haveI := is_split_epi_of_epi θ₁,
    let α : fin (Δ₂.len+1) → fin (Δ₁.len+1) := λ y,
      if (y = θ₁.to_order_hom x) then x else (section_ θ₁).to_order_hom y,
    have hα : ∀ y, θ₁.to_order_hom (α y) = y,
    { intro y,
      dsimp [α],
      split_ifs with h₁,
      { rw ← h₁, },
      { have h₃ := congr_arg order_hom.to_fun (congr_arg simplex_category.hom.to_order_hom (is_split_epi.id θ₁)),
        exact congr_fun h₃ y, }, },
    let β : Δ₂ ⟶ Δ₁ := simplex_category.hom.mk ⟨α, begin
      intros x₁ x₂,
      contrapose,
      intro h,
      simp only [not_le] at h ⊢,
      suffices : x₂ ≤ x₁,
      { cases this.lt_or_eq with h₁ h₂,
        { assumption, },
        { exfalso,
          simpa only [h₂, lt_self_iff_false] using h, }, },
      simpa only [hα, order_hom.to_fun_eq_coe] using θ₁.to_order_hom.monotone' h.le,
    end⟩,
    refine ⟨⟨β, _⟩, _⟩,
    { ext1, ext1, ext1 y,
      apply hα, },
    { simp only [simplex_category.hom.to_order_hom_mk, order_hom.coe_fun_mk,
        ite_eq_left_iff, eq_self_iff_true, not_true, is_empty.forall_iff], }, },
  rcases h₂ with ⟨s, hs⟩,
  rw ← hs,
  have eq := h s,
  have h₃ := s.id',
  simp only [auto_param_eq] at h₃,
  rw ← h₃ at eq,
  have h₄ : (θ₁ ≫ s.section_ ≫ θ₁).to_order_hom x =
    (θ₁ ≫ s.section_ ≫ θ₂).to_order_hom x := by rw eq,
  exact h₄,
end

lemma image_of_nondegenerate_simplex_uniqueness₃ (X : sSet)
  {Δ Δ' : simplex_categoryᵒᵖ} (y : X.obj Δ')
  (hy : y ∈ X.nondegenerate_simplices Δ')
  (θ₁ : Δ' ⟶ Δ) (θ₂ : Δ' ⟶ Δ) (hθ₁ : epi θ₁.unop) (hθ₂ : epi θ₂.unop)
  (eq : X.map θ₁ y = X.map θ₂ y) : θ₁ = θ₂ :=
begin
  apply quiver.hom.unop_inj,
  apply ext_epi_of_sections,
  introI s,
  let f := s.section_ ≫ θ₂.unop,
  change f = 𝟙 _,
  have eq₁ : y = X.map f.op y,
  { dsimp only [f],
    rw [op_comp, X.map_comp', quiver.hom.op_unop, ← eq, ← X.map_comp'],
    change _ = X.map (θ₁.unop.op ≫ _) _,
    rw [← op_comp, s.id, op_id, X.map_id, types_id_apply], },
  let F := limits.image.mono_factorisation f,
  rw [← F.fac, op_comp, X.map_comp'] at eq₁,
  haveI : epi F.e := by { simp only [limits.as_factor_thru_image], apply_instance, },
  haveI he := is_iso_of_nondegenerate_simplices ⟨y, hy⟩ F.e.op infer_instance _ eq₁,
  haveI : is_iso F.e,
  { change is_iso F.e.op.unop,
    apply_instance, },
  haveI : mono f,
  { rw ← F.fac,
    apply mono_comp, },
  exact simplex_category.eq_id_of_mono f,
end

@[simp]
def splitting_map (X : sSet.{u}) (Δ : simplex_categoryᵒᵖ) :
  sigma (simplicial_object.splitting.summand
    (λ n, (X.nondegenerate_simplices (op [n]) : Type u)) Δ) → X.obj Δ :=
λ s, X.map s.1.e.op s.2.1

lemma splitting_map_bijective (X : sSet.{u}) (Δ : simplex_categoryᵒᵖ) :
  function.bijective (X.splitting_map Δ) :=
begin
  split,
  { rintros ⟨⟨Δ₁, θ₁, hθ₁⟩, y₁, hy₁⟩ ⟨⟨Δ₂, θ₂, hθ₂⟩, y₂, hy₂⟩ eq,
    induction Δ₁ using opposite.rec,
    induction Δ₂ using opposite.rec,
    have h₁ := X.image_of_nondegenerate_simplex_uniqueness₁ y₁ y₂ hy₁ hy₂ θ₁.op θ₂.op
      hθ₁ hθ₂ eq,
    simp only [simplex_category.mk_len, op_inj_iff, unop_op] at h₁,
    subst h₁,
    have h₂ := X.image_of_nondegenerate_simplex_uniqueness₂ y₁ y₂ hy₁ hy₂ θ₁.op θ₂.op
      hθ₁ hθ₂ eq,
    subst h₂,
    have h₃ := X.image_of_nondegenerate_simplex_uniqueness₃ y₁ hy₁ θ₁.op θ₂.op hθ₁ hθ₂ eq,
    have h₃' : θ₁ = θ₂ := by { apply quiver.hom.op_inj, exact h₃, },
    subst h₃', },
  { intro y,
    rcases X.is_epi_image_of_nondegenerate_simplex y with ⟨Δ', θ, hθ, y, hy, eq⟩,
    exact ⟨⟨⟨Δ', ⟨θ.unop, hθ⟩⟩, ⟨y, hy⟩⟩, eq.symm⟩, },
end

@[simps]
def splitting (X : sSet.{u}) : simplicial_object.splitting X :=
begin
  let N : ℕ → Type u := λ n, X.nondegenerate_simplices (op [n]),
  let ι : Π (n : ℕ), N n → X.obj (op [n]) := λ n, subtype.val,
  exact
  { N := N,
    ι := ι,
    map_is_iso' := λ Δ, begin
      rw is_iso_iff_bijective,
      let α := X.splitting_map Δ,
      let β := simplicial_object.splitting.map X ι Δ,
      let γ := concrete.coproduct_map (simplicial_object.splitting.summand N Δ),
      have hγ : function.bijective γ := concrete.coproduct_map_bijective _,
      change function.bijective β,
      have eq : β ∘ γ = α,
      { ext s,
        rcases s with ⟨A, x⟩,
        dsimp [α, β, γ],
        have h := comp_apply (simplicial_object.splitting.ι_coprod N A)
          (simplicial_object.splitting.map X ι Δ) x,
        simp only [concrete_category.has_coe_to_fun_Type,
          simplicial_object.splitting.ι_coprod, simplicial_object.splitting.map] at h,
        erw [colimit.ι_desc, cofan.mk_ι_app] at h,
        exact h.symm, },
      rw [← function.bijective.of_comp_iff β hγ, eq],
      apply splitting_map_bijective,
    end, },
end

end sSet


import data.set.basic -- hide
open set -- hide
/- Tactic : apply

## Summary

If `h : P → Q` is a hypothesis, and the goal is `⊢ Q` then
`apply h` changes the goal to `⊢ P`.

## Details

If you have a function `h : P → Q` and your goal is `⊢ Q`
then `apply h` changes the goal to `⊢ P`. The logic is
simple: if you are trying to create a term of type `Q`,
but `h` is a function which turns terms of type `P` into
terms of type `Q`, then it will suffice to construct a
term of type `P`. A mathematician might say: "we need
to construct an element of $Q$, but we have a function $h:P\to Q$
so it suffices to construct an element of $P$". Or alternatively
"we need to prove $Q$, but we have a proof $h$ that $P\implies Q$
so it suffices to prove $P$".

-/

/-
In this level we introduce the new tactic `apply`. Look at what it does and try to solve it!
-/

/- Hint : Click here for a hint, in case you get stuck.
Start with an `intro`, then try to `apply` the right hypothesis.
-/

variables {X Y : Type} -- hide

/- Lemma : no-side-bar
If A, B and C are sets and x ∈ A, and we know that x ∈ A → x ∈ B and that x ∈ B → x ∈ C, then
we can deduce that x ∈ C.
-/
lemma subset_transitive_basic (A B C : set X) (x : X) (hAB : x ∈ A → x ∈ B) (hBC : x ∈ B → x ∈ C) :
  x ∈ A → x ∈ C :=
begin
  intro h,
  apply hBC,
  apply hAB,
  exact h,

end


/-
Copyright (c) 2018 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad, Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.control.functor.multivariate
import Mathlib.data.pfunctor.univariate.default
import Mathlib.data.sigma.default
import Mathlib.PostPort

universes u l u_1

namespace Mathlib

/-!
# Multivariate polynomial functors.

Multivariate polynomial functors are used for defining M-types and W-types.
They map a type vector `α` to the type `Σ a : A, B a ⟹ α`, with `A : Type` and
`B : A → typevec n`. They interact well with Lean's inductive definitions because
they guarantee that occurrences of `α` are positive.
-/

/--
multivariate polynomial functors
-/
structure mvpfunctor (n : ℕ)
where
  A : Type u
  B : A → typevec n

namespace mvpfunctor

/-- Applying `P` to an object of `Type` -/
def obj {n : ℕ} (P : mvpfunctor n) (α : typevec n) :=
  sigma fun (a : A P) => typevec.arrow (B P a) α

/-- Applying `P` to a morphism of `Type` -/
def map {n : ℕ} (P : mvpfunctor n) {α : typevec n} {β : typevec n} (f : typevec.arrow α β) : obj P α → obj P β :=
  fun (_x : obj P α) => sorry

protected instance inhabited {n : ℕ} : Inhabited (mvpfunctor n) :=
  { default := mk Inhabited.default fun (_x : Inhabited.default) => Inhabited.default }

protected instance obj.inhabited {n : ℕ} (P : mvpfunctor n) {α : typevec n} [Inhabited (A P)] [(i : fin2 n) → Inhabited (α i)] : Inhabited (obj P α) :=
  { default := sigma.mk Inhabited.default fun (_x : fin2 n) (_x_1 : B P Inhabited.default _x) => Inhabited.default }

protected instance obj.mvfunctor {n : ℕ} (P : mvpfunctor n) : mvfunctor (obj P) :=
  mvfunctor.mk (map P)

theorem map_eq {n : ℕ} (P : mvpfunctor n) {α : typevec n} {β : typevec n} (g : typevec.arrow α β) (a : A P) (f : typevec.arrow (B P a) α) : mvfunctor.map g (sigma.mk a f) = sigma.mk a (typevec.comp g f) :=
  rfl

theorem id_map {n : ℕ} (P : mvpfunctor n) {α : typevec n} (x : obj P α) : mvfunctor.map typevec.id x = x :=
  sigma.cases_on x
    fun (x_fst : A P) (x_snd : typevec.arrow (B P x_fst) α) =>
      idRhs (mvfunctor.map typevec.id (sigma.mk x_fst x_snd) = mvfunctor.map typevec.id (sigma.mk x_fst x_snd)) rfl

theorem comp_map {n : ℕ} (P : mvpfunctor n) {α : typevec n} {β : typevec n} {γ : typevec n} (f : typevec.arrow α β) (g : typevec.arrow β γ) (x : obj P α) : mvfunctor.map (typevec.comp g f) x = mvfunctor.map g (mvfunctor.map f x) := sorry

protected instance obj.is_lawful_mvfunctor {n : ℕ} (P : mvpfunctor n) : is_lawful_mvfunctor (obj P) :=
  is_lawful_mvfunctor.mk (id_map P) (comp_map P)

/-- Constant functor where the input object does not affect the output -/
def const (n : ℕ) (A : Type u) : mvpfunctor n :=
  mk A fun (a : A) (i : fin2 n) => pempty

/-- Constructor for the constant functor -/
def const.mk (n : ℕ) {A : Type u} (x : A) {α : typevec n} : obj (const n A) α :=
  sigma.mk x fun (i : fin2 n) (a : B (const n A) x i) => pempty.elim a

/-- Destructor for the constant functor -/
def const.get {n : ℕ} {A : Type u} {α : typevec n} (x : obj (const n A) α) : A :=
  sigma.fst x

@[simp] theorem const.get_map {n : ℕ} {A : Type u} {α : typevec n} {β : typevec n} (f : typevec.arrow α β) (x : obj (const n A) α) : const.get (mvfunctor.map f x) = const.get x :=
  sigma.cases_on x
    fun (x_fst : A (const n A)) (x_snd : typevec.arrow (B (const n A) x_fst) α) =>
      Eq.refl (const.get (mvfunctor.map f (sigma.mk x_fst x_snd)))

@[simp] theorem const.get_mk {n : ℕ} {A : Type u} {α : typevec n} (x : A) : const.get (const.mk n x) = x :=
  Eq.refl (const.get (const.mk n x))

@[simp] theorem const.mk_get {n : ℕ} {A : Type u} {α : typevec n} (x : obj (const n A) α) : const.mk n (const.get x) = x := sorry

/-- Functor composition on polynomial functors -/
def comp {n : ℕ} {m : ℕ} (P : mvpfunctor n) (Q : fin2 n → mvpfunctor m) : mvpfunctor m :=
  mk (sigma fun (a₂ : A P) => (i : fin2 n) → B P a₂ i → A (Q i))
    fun (a : sigma fun (a₂ : A P) => (i : fin2 n) → B P a₂ i → A (Q i)) (i : fin2 m) =>
      sigma fun (j : fin2 n) => sigma fun (b : B P (sigma.fst a) j) => B (Q j) (sigma.snd a j b) i

/-- Constructor for functor composition -/
def comp.mk {n : ℕ} {m : ℕ} {P : mvpfunctor n} {Q : fin2 n → mvpfunctor m} {α : typevec m} (x : obj P fun (i : fin2 n) => obj (Q i) α) : obj (comp P Q) α :=
  sigma.mk (sigma.mk (sigma.fst x) fun (i : fin2 n) (a : B P (sigma.fst x) i) => sigma.fst (sigma.snd x i a))
    fun (i : fin2 m)
      (a :
      B (comp P Q) (sigma.mk (sigma.fst x) fun (i : fin2 n) (a : B P (sigma.fst x) i) => sigma.fst (sigma.snd x i a))
        i) =>
      sigma.snd (sigma.snd x (sigma.fst a) (sigma.fst (sigma.snd a))) i (sigma.snd (sigma.snd a))

/-- Destructor for functor composition -/
def comp.get {n : ℕ} {m : ℕ} {P : mvpfunctor n} {Q : fin2 n → mvpfunctor m} {α : typevec m} (x : obj (comp P Q) α) : obj P fun (i : fin2 n) => obj (Q i) α :=
  sigma.mk (sigma.fst (sigma.fst x))
    fun (i : fin2 n) (a : B P (sigma.fst (sigma.fst x)) i) =>
      sigma.mk (sigma.snd (sigma.fst x) i a)
        fun (j : fin2 m) (b : B (Q i) (sigma.snd (sigma.fst x) i a) j) => sigma.snd x j (sigma.mk i (sigma.mk a b))

theorem comp.get_map {n : ℕ} {m : ℕ} {P : mvpfunctor n} {Q : fin2 n → mvpfunctor m} {α : typevec m} {β : typevec m} (f : typevec.arrow α β) (x : obj (comp P Q) α) : comp.get (mvfunctor.map f x) = mvfunctor.map (fun (i : fin2 n) (x : obj (Q i) α) => mvfunctor.map f x) (comp.get x) :=
  sigma.cases_on x
    fun (x_fst : A (comp P Q)) (x_snd : typevec.arrow (B (comp P Q) x_fst) α) =>
      Eq.refl (comp.get (mvfunctor.map f (sigma.mk x_fst x_snd)))

@[simp] theorem comp.get_mk {n : ℕ} {m : ℕ} {P : mvpfunctor n} {Q : fin2 n → mvpfunctor m} {α : typevec m} (x : obj P fun (i : fin2 n) => obj (Q i) α) : comp.get (comp.mk x) = x := sorry

@[simp] theorem comp.mk_get {n : ℕ} {m : ℕ} {P : mvpfunctor n} {Q : fin2 n → mvpfunctor m} {α : typevec m} (x : obj (comp P Q) α) : comp.mk (comp.get x) = x := sorry

/-
lifting predicates and relations
-/

theorem liftp_iff {n : ℕ} {P : mvpfunctor n} {α : typevec n} (p : {i : fin2 n} → α i → Prop) (x : obj P α) : mvfunctor.liftp p x ↔
  ∃ (a : A P), ∃ (f : typevec.arrow (B P a) α), x = sigma.mk a f ∧ ∀ (i : fin2 n) (j : B P a i), p (f i j) := sorry

theorem liftp_iff' {n : ℕ} {P : mvpfunctor n} {α : typevec n} (p : {i : fin2 n} → α i → Prop) (a : A P) (f : typevec.arrow (B P a) α) : mvfunctor.liftp p (sigma.mk a f) ↔ ∀ (i : fin2 n) (x : B P a i), p (f i x) := sorry

theorem liftr_iff {n : ℕ} {P : mvpfunctor n} {α : typevec n} (r : {i : fin2 n} → α i → α i → Prop) (x : obj P α) (y : obj P α) : mvfunctor.liftr r x y ↔
  ∃ (a : A P),
    ∃ (f₀ : typevec.arrow (B P a) α),
      ∃ (f₁ : typevec.arrow (B P a) α),
        x = sigma.mk a f₀ ∧ y = sigma.mk a f₁ ∧ ∀ (i : fin2 n) (j : B P a i), r (f₀ i j) (f₁ i j) := sorry

theorem supp_eq {n : ℕ} {P : mvpfunctor n} {α : typevec n} (a : A P) (f : typevec.arrow (B P a) α) (i : fin2 n) : mvfunctor.supp (sigma.mk a f) i = f i '' set.univ := sorry

end mvpfunctor

/-
Decomposing an n+1-ary pfunctor.
-/

namespace mvpfunctor

/-- Split polynomial functor, get a n-ary functor
from a `n+1`-ary functor -/
def drop {n : ℕ} (P : mvpfunctor (n + 1)) : mvpfunctor n :=
  mk (A P) fun (a : A P) => typevec.drop (B P a)

/-- Split polynomial functor, get a univariate functor
from a `n+1`-ary functor -/
def last {n : ℕ} (P : mvpfunctor (n + 1)) : pfunctor :=
  pfunctor.mk (A P) fun (a : A P) => typevec.last (B P a)

/-- append arrows of a polynomial functor application -/
def append_contents {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {β : Type u_1} {a : A P} (f' : typevec.arrow (B (drop P) a) α) (f : pfunctor.B (last P) a → β) : typevec.arrow (B P a) (α ::: β) :=
  typevec.split_fun f' f


import Smt

def curryAdd : Int → Int → Int := Int.add

example (a b : Int) : curryAdd a b = curryAdd b a := by
  smt [curryAdd]
  sorry

def partCurryAdd (a : Int) : Int → Int := Int.add a

example (a b : Int) : partCurryAdd a b = partCurryAdd b a := by
  smt [partCurryAdd]
  sorry

example (a b : Int)
    : let partCurryAdd' := fun a => Int.add a;
    partCurryAdd' a b = partCurryAdd' b a := by
  intro partCurryAdd'
  smt [partCurryAdd']
  sorry

set_option linter.unusedVariables false in
def mismatchNamesAdd : ∀ (a b : Int), Int := fun c d => c + d

example (a b : Int) : mismatchNamesAdd a b = mismatchNamesAdd b a := by
  smt [mismatchNamesAdd]
  sorry


--

-- New notation that overlaps with existing notation
syntax (name := myPair) (priority := high) "(" term "," term ")" : term

macro_rules (kind := myPair)
| `(($a, $b)) => `([$a, $b])

#eval (1, 2) -- not ambiguous since myPair parser has higher priority

theorem ex1 : (1, 2) = [1, 2] :=
rfl

-- Define macro for expanding the builtin triple notation
-- Macros bypass builtin elaboration functions
macro_rules
| `(($a, $b, $c)) => `($a + $b + $c)

#eval (1, 2, 3)

syntax (name := mySingleton) "[" term "]" : term

macro_rules (kind := mySingleton)
| `([$a]) => `(2 * $a)

#check [1] -- ambiguous it can be `mySingleton` or the singleton list

syntax (priority := 100) "(" term "," term ", " term ")" : term -- priority without a kind

macro_rules
| `(($a, $b, $c)) => `([$a, $b, $c])

#eval (1,2,3)

theorem ex2 : (1, 2, 3) = [1, 2, 3] :=
rfl

theorem ex3 : (1, 2, 3, 4) = Prod.mk 1 (Prod.mk 2 (Prod.mk 3 4)) :=
rfl


import IIT.PropInversion
import IIT.ClarifyIndices

/-
iit A : Type
| ι   : (n : Nat) → A
| mid : (x y : A) → (p : lt' x y) → A

iit lt' : (x : A) → (y : A) → Type
| ι'    : (m n : Nat) → (p : m < n) → lt' (A.ι m) (A.ι n)
| mid_l : (x y : A) → (p : lt' x y) → lt' x (A.mid x y p)
| mid_r : (x y : A) → (p : lt' x y) → lt' (A.mid x y p) y
-/

mutual
inductive Aₑ : Type 1
| ιₑ   : Nat → Aₑ
| midₑ : (x y : Aₑ) → (p : lt'ₑ) → Aₑ

inductive lt'ₑ : Type 1
| ι'ₑ : (m n : Nat) → (p : m < n) → lt'ₑ
| mid_lₑ : (x y : Aₑ) → (p : lt'ₑ) → lt'ₑ
| mid_rₑ : (x y : Aₑ) → (p : lt'ₑ) → lt'ₑ
end

open Aₑ lt'ₑ

mutual
inductive A_w : Aₑ → Prop
| ι_w : ∀ n, A_w (ιₑ n)
| mid_w : ∀ {x}, A_w x → ∀ {y}, A_w y → ∀ {p}, lt'_w x y p → A_w (midₑ x y p)

inductive lt'_w : Aₑ → Aₑ → lt'ₑ → Prop
| ι'_w : ∀ m n p, lt'_w (ιₑ m) (ιₑ n) (ι'ₑ m n p)
| mid_l_w : ∀ {x}, A_w x → ∀ {y}, A_w y → ∀ {p}, lt'_w x y p
    → lt'_w x (midₑ x y p) (mid_lₑ x y p)
| mid_r_w : ∀ {x}, A_w x → ∀ {y}, A_w y → ∀ {p}, lt'_w x y p
    → lt'_w (midₑ x y p) y (mid_rₑ x y p)
end

open A_w lt'_w

def A := PSigma A_w
def lt' := fun (x y : A) => PSigma (lt'_w x.1 y.1)

def ι : Nat → A := fun n => ⟨ιₑ n, ι_w n⟩
def mid (x y : A) (p : lt' x y) : A := ⟨midₑ x.1 y.1 p.1, mid_w x.2 y.2 p.2⟩
def ι' (m n : Nat) (p : m < n) : lt' (ι m) (ι n) := ⟨ι'ₑ m n p, ι'_w m n p⟩
def mid_l (x y : A) (p : lt' x y) : lt' x (mid x y p) :=
  ⟨mid_lₑ x.1 y.1 p.1, mid_l_w x.2 y.2 p.2⟩
def mid_r (x y : A) (p : lt' x y) : lt' (mid x y p) y :=
  ⟨mid_rₑ x.1 y.1 p.1, mid_r_w x.2 y.2 p.2⟩

section
variable
  (Aₘ     : A → Type 1)
  (lt'ₘ   : ∀ {x}, Aₘ x → ∀ {y}, Aₘ y → lt' x y → Type 1)
  (ιₘ     : ∀ n, Aₘ (ι n))
  (midₘ   : ∀ {x}, (xₘ : Aₘ x) → ∀ {y}, (yₘ : Aₘ y) → ∀ {p}, (pₘ : lt'ₘ xₘ yₘ p) → Aₘ (mid x y p))
  (ι'ₘ    : ∀ m n p, lt'ₘ (ιₘ m) (ιₘ n) (ι' m n p))
  (mid_lₘ : ∀ {x}, (xₘ : Aₘ x) → ∀ {y}, (yₘ : Aₘ y) → ∀ {p}, (pₘ : lt'ₘ xₘ yₘ p)
    → lt'ₘ xₘ (midₘ xₘ yₘ pₘ) (mid_l x y p))
  (mid_rₘ : ∀ {x}, (xₘ : Aₘ x) → ∀ {y}, (yₘ : Aₘ y) → ∀ {p}, (pₘ : lt'ₘ xₘ yₘ p)
    → lt'ₘ (midₘ xₘ yₘ pₘ) yₘ (mid_r x y p))

mutual
inductive Aᵣ : (x : A) → Aₘ x → Type 1
| ιᵣ : ∀ n, Aᵣ (ι n) (ιₘ n)
| midᵣ : ∀ {x} {xₘ : Aₘ x}, Aᵣ x xₘ →
           ∀ {y} {yₘ : Aₘ y}, Aᵣ y yₘ →
             ∀ {p} {pₘ : lt'ₘ xₘ yₘ p}, lt'ᵣ xₘ yₘ p pₘ → Aᵣ (mid x y p) (midₘ xₘ yₘ pₘ)

inductive lt'ᵣ : {x : A} → (xₘ : Aₘ x) → {y : A} → (yₘ : Aₘ y) → (p : lt' x y) → lt'ₘ xₘ yₘ p → Type 1
| ι'ᵣ : ∀ m n p, lt'ᵣ (ιₘ m) (ιₘ n) (ι' m n p) (ι'ₘ m n p)
| mid_lᵣ : ∀ {x} {xₘ : Aₘ x}, Aᵣ x xₘ →
             ∀ {y} {yₘ : Aₘ y}, Aᵣ y yₘ →
               ∀ {p} {pₘ : lt'ₘ xₘ yₘ p}, lt'ᵣ xₘ yₘ p pₘ →
                 lt'ᵣ xₘ (midₘ xₘ yₘ pₘ) (mid_l x y p) (mid_lₘ xₘ yₘ pₘ)
| mid_rᵣ : ∀ {x} {xₘ : Aₘ x}, Aᵣ x xₘ →
             ∀ {y} {yₘ : Aₘ y}, Aᵣ y yₘ →
               ∀ {p} {pₘ : lt'ₘ xₘ yₘ p}, lt'ᵣ xₘ yₘ p pₘ →
                 lt'ᵣ (midₘ xₘ yₘ pₘ) yₘ (mid_r x y p) (mid_rₘ xₘ yₘ pₘ)
end

open Aᵣ lt'ᵣ

structure PSigmaUnique {α : Type _} (β : α → Type _) :=
  fst : α
  snd : β fst
  unique : ∀ {a}, β a → a = fst

noncomputable def A_tot (x : A) : PSigmaUnique (Aᵣ Aₘ lt'ₘ ιₘ midₘ ι'ₘ mid_lₘ mid_rₘ x) := by
  cases x with | mk xₑ x_w => ?_
  apply Aₑ.recOn xₑ
    (motive_1 := fun xₑ => ∀ x_w, PSigmaUnique (Aᵣ Aₘ lt'ₘ ιₘ midₘ ι'ₘ mid_lₘ mid_rₘ ⟨xₑ, x_w⟩))
    (motive_2 := fun pₑ => ∀ {x xₘ} (xᵣ : Aᵣ Aₘ lt'ₘ ιₘ midₘ ι'ₘ mid_lₘ mid_rₘ x xₘ)
                  {y yₘ} (yᵣ : Aᵣ Aₘ lt'ₘ ιₘ midₘ ι'ₘ mid_lₘ mid_rₘ y yₘ)
                   p_w, PSigmaUnique (lt'ᵣ Aₘ lt'ₘ ιₘ midₘ ι'ₘ mid_lₘ mid_rₘ xₘ yₘ ⟨pₑ, p_w⟩))
  skip
  · intro n _
    exact ⟨ιₘ n, ιᵣ n, fun {xₘ} xᵣ => by cases xᵣ; rfl⟩
  · intro x y p x_ih y_ih p_ih ctor_w
    inversion ctor_w with x_w y_w p_w
    cases x_ih x_w with | mk xₘ xᵣ x_unique => ?_
    cases y_ih y_w with | mk yₘ yᵣ y_unique => ?_
    cases p_ih xᵣ yᵣ p_w with | mk pₘ pᵣ p_unique => ?_
    exact ⟨midₘ xₘ yₘ pₘ, midᵣ xᵣ yᵣ pᵣ, fun {zₘ} zᵣ => by
      cases zᵣ with | @midᵣ x' x'ₘ x'ᵣ y' y'ₘ y'ᵣ p' p'ₘ p'ᵣ => ?_
      cases x_unique x'ᵣ
      cases y_unique y'ᵣ
      cases p_unique p'ᵣ
      rfl ⟩
  · intro m n p x xₘ xᵣ y yₘ yᵣ ctor_w
    cases x with | mk xₑ x_w => ?_
    cases y with | mk yₑ y_w => ?_
    simp only at ctor_w
    clarifyIndices ctor_w
    cases xᵣ
    cases yᵣ
    exact ⟨ι'ₘ m n p, ι'ᵣ m n p, fun {qₘ} qᵣ => by
      cases qᵣ
      rfl ⟩
  · intro yₑ zₑ pₑ y_ih z_ih p_ih x' x'ₘ x'ᵣ y' y'ₘ y'ᵣ ctor_w
    cases x' with | mk x'ₑ x'_w => ?_
    cases y' with | mk y'ₑ y'_w => ?_
    simp only at ctor_w
    clarifyIndices ctor_w
    cases y'ᵣ with | @midᵣ x'' x''ₘ x''ᵣ y'' y''ₘ y''ᵣ p'' p''ₘ p''ᵣ => ?_
    simp only at ctor_w
    cases x'' with | mk x''ₑ x''_w => ?_
    cases y'' with | mk y''ₑ y''_w => ?_
    cases p'' with | mk p''ₑ p''_w => ?_
    clarifyIndices ctor_w
    simp only at ctor_w
    cases y_ih x''_w with | mk x'''ₘ x'''ᵣ x'''_unique => ?_
    cases z_ih y''_w with | mk y'''ₘ y'''ᵣ y'''_unique => ?_
    cases p_ih x'''ᵣ y'''ᵣ p''_w with | mk p'''ₘ p'''ᵣ p'''_unique => ?_
    simp only at *
    cases x'''_unique x'ᵣ
    cases x'''_unique x''ᵣ
    cases y'''_unique y''ᵣ
    cases p'''_unique p''ᵣ
    exact ⟨mid_lₘ _ _ _, mid_lᵣ x''ᵣ y''ᵣ p''ᵣ, fun {qₘ} qᵣ => by
      match qᵣ with
      | mid_lᵣ x'''ᵣ y'''ᵣ p'''ᵣ => skip ⟩

noncomputable def Ty_tot (Γ : Con) (A : Ty Γ) :
  PSigma (Tyᵣ Conₘ Tyₘ nilₘ extₘ baseₘ piₘ (Con_tot Conₘ Tyₘ nilₘ extₘ baseₘ piₘ Γ).1 A) := by
  cases Γ with | mk Γₑ Γ_w => ?_
  cases A with | mk Aₑ A_w => ?_
  apply Tyₑ.recOn Aₑ
    (motive_1 := fun Γₑ => ∀ Γ_w, PSigma (Conᵣ Conₘ Tyₘ nilₘ extₘ baseₘ piₘ ⟨Γₑ, Γ_w⟩))
    (motive_2 := fun Aₑ => ∀ {Γ Γₘ} (Γᵣ : Conᵣ Conₘ Tyₘ nilₘ extₘ baseₘ piₘ Γ Γₘ)
                   A_w, PSigma (Tyᵣ Conₘ Tyₘ nilₘ extₘ baseₘ piₘ Γₘ ⟨Aₑ, A_w⟩))
  · intro Γ_w
    exact PSigma.mk nilₘ nilᵣ
  · intro Δₑ Aₑ Δ_ih A_ih ctor_w
    inversion ctor_w with Δ_w A_w
    cases Δ_ih Δ_w with | mk Δₘ Δᵣ => ?_
    cases A_ih Δᵣ A_w with | mk Aₘ Aᵣ => ?_
    exact PSigma.mk (extₘ Δₘ Aₘ) (extᵣ Δᵣ Aᵣ)
  · intro Γₑ Γ_ih Δ Δₘ Δᵣ ctor_w
    cases Δ with | mk Δₑ Δ_w => ?_
    simp only at ctor_w
    clarifyIndices ctor_w
    exact PSigma.mk (baseₘ Δₘ) (baseᵣ Δᵣ)
  · intro Δₑ Aₑ Bₑ Δ_ih A_ih B_ih Δ' Δ'ₘ Δ'ᵣ ctor_w
    cases Δ' with | mk Δ'ₑ Δ_w => ?_
    simp only at ctor_w
    clarifyIndices ctor_w
    inversion ctor_w with Δ_w A_w B_w
    cases A_ih Δ'ᵣ A_w with | mk Aₘ Aᵣ => ?_
    cases B_ih (extᵣ Δ'ᵣ Aᵣ) B_w with | mk Bₘ Bᵣ => ?_
    exact PSigma.mk (piₘ Δ'ₘ Aₘ Bₘ) (piᵣ Δ'ᵣ Aᵣ Bᵣ)
  · exact (Con_tot Conₘ Tyₘ nilₘ extₘ baseₘ piₘ ⟨Γₑ, Γ_w⟩).2

noncomputable def Con.rec (Γ : Con) : Conₘ Γ :=
(Con_tot Conₘ Tyₘ nilₘ extₘ baseₘ piₘ Γ).1

noncomputable def Ty.rec (Γ : Con) (A : Ty Γ) : Tyₘ (Con.rec Conₘ Tyₘ nilₘ extₘ baseₘ piₘ Γ) A :=
(Ty_tot Conₘ Tyₘ nilₘ extₘ baseₘ piₘ Γ A).1

theorem nil_beta : Con.rec Conₘ Tyₘ nilₘ extₘ baseₘ piₘ nil = nilₘ :=
rfl

theorem ext_beta (Γ : Con) (A : Ty Γ) :
  Con.rec Conₘ Tyₘ nilₘ extₘ baseₘ piₘ (ext Γ A)
  = extₘ (Con.rec Conₘ Tyₘ nilₘ extₘ baseₘ piₘ Γ)
    (Ty.rec Conₘ Tyₘ nilₘ extₘ baseₘ piₘ Γ A) :=
rfl

theorem base_beta (Γ : Con) :
  Ty.rec Conₘ Tyₘ nilₘ extₘ baseₘ piₘ Γ (base Γ)
  = baseₘ (Con.rec Conₘ Tyₘ nilₘ extₘ baseₘ piₘ Γ) :=
rfl

theorem pi_beta (Γ : Con) (A : Ty Γ) (B : Ty (ext Γ A)) :
  Ty.rec Conₘ Tyₘ nilₘ extₘ baseₘ piₘ Γ (pi Γ A B)
  = piₘ (Con.rec Conₘ Tyₘ nilₘ extₘ baseₘ piₘ Γ)
      (Ty.rec Conₘ Tyₘ nilₘ extₘ baseₘ piₘ Γ A)
      (Ty.rec Conₘ Tyₘ nilₘ extₘ baseₘ piₘ (ext Γ A) B) :=
rfl

end


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import category_theory.balanced
import category_theory.lifting_properties.basic

/-!
# Strong epimorphisms

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

In this file, we define strong epimorphisms. A strong epimorphism is an epimorphism `f`
which has the (unique) left lifting property with respect to monomorphisms. Similarly,
a strong monomorphisms in a monomorphism which has the (unique) right lifting property
with respect to epimorphisms.

## Main results

Besides the definition, we show that
* the composition of two strong epimorphisms is a strong epimorphism,
* if `f ≫ g` is a strong epimorphism, then so is `g`,
* if `f` is both a strong epimorphism and a monomorphism, then it is an isomorphism

We also define classes `strong_mono_category` and `strong_epi_category` for categories in which
every monomorphism or epimorphism is strong, and deduce that these categories are balanced.

## TODO

Show that the dual of a strong epimorphism is a strong monomorphism, and vice versa.

## References

* [F. Borceux, *Handbook of Categorical Algebra 1*][borceux-vol1]
-/

universes v u

namespace category_theory
variables {C : Type u} [category.{v} C]

variables {P Q : C}

/-- A strong epimorphism `f` is an epimorphism which has the left lifting property
with respect to monomorphisms. -/
class strong_epi (f : P ⟶ Q) : Prop :=
(epi : epi f)
(llp : ∀ ⦃X Y : C⦄ (z : X ⟶ Y) [mono z], has_lifting_property f z)

lemma strong_epi.mk' {f : P ⟶ Q} [epi f]
  (hf : ∀ (X Y : C) (z : X ⟶ Y) (hz : mono z) (u : P ⟶ X) (v : Q ⟶ Y)
    (sq : comm_sq u f z v), sq.has_lift) : strong_epi f :=
{ epi := infer_instance,
  llp := λ X Y z hz, ⟨λ u v sq, hf X Y z hz u v sq⟩, }

/-- A strong monomorphism `f` is a monomorphism which has the right lifting property
with respect to epimorphisms. -/
class strong_mono (f : P ⟶ Q) : Prop :=
(mono : mono f)
(rlp : ∀ ⦃X Y : C⦄ (z : X ⟶ Y) [epi z], has_lifting_property z f)

lemma strong_mono.mk' {f : P ⟶ Q} [mono f]
  (hf : ∀ (X Y : C) (z : X ⟶ Y) (hz : epi z) (u : X ⟶ P) (v : Y ⟶ Q)
    (sq : comm_sq u z f v), sq.has_lift) : strong_mono f :=
{ mono := infer_instance,
  rlp := λ X Y z hz, ⟨λ u v sq, hf X Y z hz u v sq⟩, }

attribute [instance, priority 100] strong_epi.llp
attribute [instance, priority 100] strong_mono.rlp

@[priority 100]
instance epi_of_strong_epi (f : P ⟶ Q) [strong_epi f] : epi f := strong_epi.epi

@[priority 100]
instance mono_of_strong_mono (f : P ⟶ Q) [strong_mono f] : mono f := strong_mono.mono

section
variables {R : C} (f : P ⟶ Q) (g : Q ⟶ R)

/-- The composition of two strong epimorphisms is a strong epimorphism. -/
lemma strong_epi_comp [strong_epi f] [strong_epi g] : strong_epi (f ≫ g) :=
{ epi := epi_comp _ _,
  llp := by { introsI, apply_instance, }, }

/-- The composition of two strong monomorphisms is a strong monomorphism. -/
lemma strong_mono_comp [strong_mono f] [strong_mono g] : strong_mono (f ≫ g) :=
{ mono := mono_comp _ _,
  rlp := by { introsI, apply_instance, }, }

/-- If `f ≫ g` is a strong epimorphism, then so is `g`. -/
lemma strong_epi_of_strong_epi [strong_epi (f ≫ g)] : strong_epi g :=
{ epi := epi_of_epi f g,
  llp := begin
    introsI,
    constructor,
    intros u v sq,
    have h₀ : (f ≫ u) ≫ z = (f ≫ g) ≫ v, by simp only [category.assoc, sq.w],
    exact comm_sq.has_lift.mk' ⟨(comm_sq.mk h₀).lift,
      by simp only [← cancel_mono z, category.assoc, comm_sq.fac_right, sq.w], by simp⟩,
  end, }

/-- If `f ≫ g` is a strong monomorphism, then so is `f`. -/

/-- An isomorphism is in particular a strong epimorphism. -/
@[priority 100] instance strong_epi_of_is_iso [is_iso f] : strong_epi f :=
{ epi := by apply_instance,
  llp := λ X Y z hz, has_lifting_property.of_left_iso _ _, }

/-- An isomorphism is in particular a strong monomorphism. -/
@[priority 100] instance strong_mono_of_is_iso [is_iso f] : strong_mono f :=
{ mono := by apply_instance,
  rlp := λ X Y z hz, has_lifting_property.of_right_iso _ _, }

lemma strong_epi.of_arrow_iso {A B A' B' : C} {f : A ⟶ B} {g : A' ⟶ B'}
  (e : arrow.mk f ≅ arrow.mk g) [h : strong_epi f] : strong_epi g :=
{ epi := begin
    rw arrow.iso_w' e,
    haveI := epi_comp f e.hom.right,
    apply epi_comp,
  end,
  llp := λ X Y z, by { introI, apply has_lifting_property.of_arrow_iso_left e z, }, }

lemma strong_mono.of_arrow_iso {A B A' B' : C} {f : A ⟶ B} {g : A' ⟶ B'}
  (e : arrow.mk f ≅ arrow.mk g) [h : strong_mono f] : strong_mono g :=
{ mono := begin
    rw arrow.iso_w' e,
    haveI := mono_comp f e.hom.right,
    apply mono_comp,
  end,
  rlp := λ X Y z, by { introI, apply has_lifting_property.of_arrow_iso_right z e, }, }

lemma strong_epi.iff_of_arrow_iso {A B A' B' : C} {f : A ⟶ B} {g : A' ⟶ B'}
  (e : arrow.mk f ≅ arrow.mk g) : strong_epi f ↔ strong_epi g :=
by { split; introI, exacts [strong_epi.of_arrow_iso e, strong_epi.of_arrow_iso e.symm], }

lemma strong_mono.iff_of_arrow_iso {A B A' B' : C} {f : A ⟶ B} {g : A' ⟶ B'}
  (e : arrow.mk f ≅ arrow.mk g) : strong_mono f ↔ strong_mono g :=
by { split; introI, exacts [strong_mono.of_arrow_iso e, strong_mono.of_arrow_iso e.symm], }

end

/-- A strong epimorphism that is a monomorphism is an isomorphism. -/
lemma is_iso_of_mono_of_strong_epi (f : P ⟶ Q) [mono f] [strong_epi f] : is_iso f :=
⟨⟨(comm_sq.mk (show 𝟙 P ≫ f = f ≫ 𝟙 Q, by simp)).lift, by tidy⟩⟩

/-- A strong monomorphism that is an epimorphism is an isomorphism. -/
lemma is_iso_of_epi_of_strong_mono (f : P ⟶ Q) [epi f] [strong_mono f] : is_iso f :=
⟨⟨(comm_sq.mk (show 𝟙 P ≫ f = f ≫ 𝟙 Q, by simp)).lift, by tidy⟩⟩

section
variables (C)

/-- A strong epi category is a category in which every epimorphism is strong. -/
class strong_epi_category : Prop :=
(strong_epi_of_epi : ∀ {X Y : C} (f : X ⟶ Y) [epi f], strong_epi f)

/-- A strong mono category is a category in which every monomorphism is strong. -/
class strong_mono_category : Prop :=
(strong_mono_of_mono : ∀ {X Y : C} (f : X ⟶ Y) [mono f], strong_mono f)

end

lemma strong_epi_of_epi [strong_epi_category C] (f : P ⟶ Q) [epi f] : strong_epi f :=
strong_epi_category.strong_epi_of_epi _

lemma strong_mono_of_mono [strong_mono_category C] (f : P ⟶ Q) [mono f] : strong_mono f :=
strong_mono_category.strong_mono_of_mono _

section
local attribute [instance] strong_epi_of_epi

@[priority 100]
instance balanced_of_strong_epi_category [strong_epi_category C] : balanced C :=
{ is_iso_of_mono_of_epi := λ _ _ _ _ _, by exactI is_iso_of_mono_of_strong_epi _ }

end

section
local attribute [instance] strong_mono_of_mono

@[priority 100]
instance balanced_of_strong_mono_category [strong_mono_category C] : balanced C :=
{ is_iso_of_mono_of_epi := λ _ _ _ _ _, by exactI is_iso_of_epi_of_strong_mono _ }

end

end category_theory


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel, Johan Commelin, Scott Morrison

! This file was ported from Lean 3 source module category_theory.abelian.basic
! leanprover-community/mathlib commit 8c75ef3517d4106e89fe524e6281d0b0545f47fc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Limits.Constructions.Pullbacks
import Mathbin.CategoryTheory.Preadditive.Biproducts
import Mathbin.CategoryTheory.Limits.Shapes.Images
import Mathbin.CategoryTheory.Limits.Constructions.LimitsOfProductsAndEqualizers
import Mathbin.CategoryTheory.Abelian.NonPreadditive

/-!
# Abelian categories

This file contains the definition and basic properties of abelian categories.

There are many definitions of abelian category. Our definition is as follows:
A category is called abelian if it is preadditive,
has a finite products, kernels and cokernels,
and if every monomorphism and epimorphism is normal.

It should be noted that if we also assume coproducts, then preadditivity is
actually a consequence of the other properties, as we show in
`non_preadditive_abelian.lean`. However, this fact is of little practical
relevance, since essentially all interesting abelian categories come with a
preadditive structure. In this way, by requiring preadditivity, we allow the
user to pass in the "native" preadditive structure for the specific category they are
working with.

## Main definitions

* `abelian` is the type class indicating that a category is abelian. It extends `preadditive`.
* `abelian.image f` is `kernel (cokernel.π f)`, and
* `abelian.coimage f` is `cokernel (kernel.ι f)`.

## Main results

* In an abelian category, mono + epi = iso.
* If `f : X ⟶ Y`, then the map `factor_thru_image f : X ⟶ image f` is an epimorphism, and the map
  `factor_thru_coimage f : coimage f ⟶ Y` is a monomorphism.
* Factoring through the image and coimage is a strong epi-mono factorisation. This means that
  * every abelian category has images. We provide the isomorphism
    `image_iso_image : abelian.image f ≅ limits.image f`.
  * the canonical morphism `coimage_image_comparison : coimage f ⟶ image f`
    is an isomorphism.
* We provide the alternate characterisation of an abelian category as a category with
  (co)kernels and finite products, and in which the canonical coimage-image comparison morphism
  is always an isomorphism.
* Every epimorphism is a cokernel of its kernel. Every monomorphism is a kernel of its cokernel.
* The pullback of an epimorphism is an epimorphism. The pushout of a monomorphism is a monomorphism.
  (This is not to be confused with the fact that the pullback of a monomorphism is a monomorphism,
  which is true in any category).

## Implementation notes

The typeclass `abelian` does not extend `non_preadditive_abelian`,
to avoid having to deal with comparing the two `has_zero_morphisms` instances
(one from `preadditive` in `abelian`, and the other a field of `non_preadditive_abelian`).
As a consequence, at the beginning of this file we trivially build
a `non_preadditive_abelian` instance from an `abelian` instance,
and use this to restate a number of theorems,
in each case just reusing the proof from `non_preadditive_abelian.lean`.

We don't show this yet, but abelian categories are finitely complete and finitely cocomplete.
However, the limits we can construct at this level of generality will most likely be less nice than
the ones that can be created in specific applications. For this reason, we adopt the following
convention:

* If the statement of a theorem involves limits, the existence of these limits should be made an
  explicit typeclass parameter.
* If a limit only appears in a proof, but not in the statement of a theorem, the limit should not
  be a typeclass parameter, but instead be created using `abelian.has_pullbacks` or a similar
  definition.

## References

* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2]
* [P. Aluffi, *Algebra: Chapter 0*][aluffi2016]

-/

noncomputable section

open CategoryTheory

open CategoryTheory.Preadditive

open CategoryTheory.Limits

universe v u

namespace CategoryTheory

variable {C : Type u} [Category.{v} C]

variable (C)

/-- A (preadditive) category `C` is called abelian if it has all finite products,
all kernels and cokernels, and if every monomorphism is the kernel of some morphism
and every epimorphism is the cokernel of some morphism.

(This definition implies the existence of zero objects:
finite products give a terminal object, and in a preadditive category
any terminal object is a zero object.)
-/
class Abelian extends Preadditive C, NormalMonoCategory C, NormalEpiCategory C where
  [HasFiniteProducts : HasFiniteProducts C]
  [HasKernels : HasKernels C]
  [HasCokernels : HasCokernels C]
#align category_theory.abelian CategoryTheory.Abelian

attribute [instance] abelian.has_finite_products

attribute [instance] abelian.has_kernels abelian.has_cokernels

end CategoryTheory

open CategoryTheory

/-!
We begin by providing an alternative constructor:
a preadditive category with kernels, cokernels, and finite products,
in which the coimage-image comparison morphism is always an isomorphism,
is an abelian category.
-/

namespace CategoryTheory.Abelian

variable {C : Type u} [Category.{v} C] [Preadditive C]

variable [Limits.HasKernels C] [Limits.HasCokernels C]

namespace OfCoimageImageComparisonIsIso

/-- The factorisation of a morphism through its abelian image. -/
@[simps]
def imageMonoFactorisation {X Y : C} (f : X ⟶ Y) : MonoFactorisation f
    where
  i := Abelian.image f
  m := kernel.ι _
  m_mono := inferInstance
  e := kernel.lift _ f (cokernel.condition _)
  fac := kernel.lift_ι _ _ _
#align category_theory.abelian.of_coimage_image_comparison_is_iso.image_mono_factorisation CategoryTheory.Abelian.OfCoimageImageComparisonIsIso.imageMonoFactorisation

theorem imageMonoFactorisation_e' {X Y : C} (f : X ⟶ Y) :
    (imageMonoFactorisation f).e = cokernel.π _ ≫ Abelian.coimageImageComparison f :=
  by
  ext
  simp only [abelian.coimage_image_comparison, image_mono_factorisation_e, category.assoc,
    cokernel.π_desc_assoc]
#align category_theory.abelian.of_coimage_image_comparison_is_iso.image_mono_factorisation_e' CategoryTheory.Abelian.OfCoimageImageComparisonIsIso.imageMonoFactorisation_e'

/-- If the coimage-image comparison morphism for a morphism `f` is an isomorphism,
we obtain an image factorisation of `f`. -/
def imageFactorisation {X Y : C} (f : X ⟶ Y) [IsIso (Abelian.coimageImageComparison f)] :
    ImageFactorisation f where
  f := imageMonoFactorisation f
  IsImage :=
    { lift := fun F => inv (Abelian.coimageImageComparison f) ≫ cokernel.desc _ F.e F.kernel_ι_comp
      lift_fac := fun F =>
        by
        simp only [image_mono_factorisation_m, is_iso.inv_comp_eq, category.assoc,
          abelian.coimage_image_comparison]
        ext
        simp only [cokernel.π_desc_assoc, mono_factorisation.fac, image.fac] }
#align category_theory.abelian.of_coimage_image_comparison_is_iso.image_factorisation CategoryTheory.Abelian.OfCoimageImageComparisonIsIso.imageFactorisation

instance [HasZeroObject C] {X Y : C} (f : X ⟶ Y) [Mono f]
    [IsIso (Abelian.coimageImageComparison f)] : IsIso (imageMonoFactorisation f).e :=
  by
  rw [image_mono_factorisation_e']
  exact is_iso.comp_is_iso

instance [HasZeroObject C] {X Y : C} (f : X ⟶ Y) [Epi f] : IsIso (imageMonoFactorisation f).m :=
  by
  dsimp
  infer_instance

variable [∀ {X Y : C} (f : X ⟶ Y), IsIso (Abelian.coimageImageComparison f)]

/-- A category in which coimage-image comparisons are all isomorphisms has images. -/
theorem hasImages : HasImages C :=
  { HasImage := fun X Y f => { exists_image := ⟨imageFactorisation f⟩ } }
#align category_theory.abelian.of_coimage_image_comparison_is_iso.has_images CategoryTheory.Abelian.OfCoimageImageComparisonIsIso.hasImages

variable [Limits.HasFiniteProducts C]

attribute [local instance] limits.has_finite_biproducts.of_has_finite_products

/-- A category with finite products in which coimage-image comparisons are all isomorphisms
is a normal mono category.
-/
def normalMonoCategory : NormalMonoCategory C
    where normalMonoOfMono X Y f m :=
    { z := _
      g := cokernel.π f
      w := by simp
      IsLimit := by
        haveI : limits.has_images C := has_images
        haveI : has_equalizers C := preadditive.has_equalizers_of_has_kernels
        haveI : has_zero_object C := limits.has_zero_object_of_has_finite_biproducts _
        have aux : _ := _
        refine' is_limit_aux _ (fun A => limit.lift _ _ ≫ inv (image_mono_factorisation f).e) aux _
        · intro A g hg
          rw [kernel_fork.ι_of_ι] at hg
          rw [← cancel_mono f, hg, ← aux, kernel_fork.ι_of_ι]
        · intro A
          simp only [kernel_fork.ι_of_ι, category.assoc]
          convert limit.lift_π _ _ using 2
          rw [is_iso.inv_comp_eq, eq_comm]
          exact (image_mono_factorisation f).fac }
#align category_theory.abelian.of_coimage_image_comparison_is_iso.normal_mono_category CategoryTheory.Abelian.OfCoimageImageComparisonIsIso.normalMonoCategory

/-- A category with finite products in which coimage-image comparisons are all isomorphisms
is a normal epi category.
-/
def normalEpiCategory : NormalEpiCategory C
    where normalEpiOfEpi X Y f m :=
    { w := kernel f
      g := kernel.ι _
      w := kernel.condition _
      IsColimit := by
        haveI : limits.has_images C := has_images
        haveI : has_equalizers C := preadditive.has_equalizers_of_has_kernels
        haveI : has_zero_object C := limits.has_zero_object_of_has_finite_biproducts _
        have aux : _ := _
        refine'
          is_colimit_aux _
            (fun A =>
              inv (image_mono_factorisation f).m ≫
                inv (abelian.coimage_image_comparison f) ≫ colimit.desc _ _)
            aux _
        · intro A g hg
          rw [cokernel_cofork.π_of_π] at hg
          rw [← cancel_epi f, hg, ← aux, cokernel_cofork.π_of_π]
        · intro A
          simp only [cokernel_cofork.π_of_π, ← category.assoc]
          convert colimit.ι_desc _ _ using 2
          rw [is_iso.comp_inv_eq, is_iso.comp_inv_eq, eq_comm, ← image_mono_factorisation_e']
          exact (image_mono_factorisation f).fac }
#align category_theory.abelian.of_coimage_image_comparison_is_iso.normal_epi_category CategoryTheory.Abelian.OfCoimageImageComparisonIsIso.normalEpiCategory

end OfCoimageImageComparisonIsIso

variable [∀ {X Y : C} (f : X ⟶ Y), IsIso (Abelian.coimageImageComparison f)]
  [Limits.HasFiniteProducts C]

attribute [local instance] of_coimage_image_comparison_is_iso.normal_mono_category

attribute [local instance] of_coimage_image_comparison_is_iso.normal_epi_category

/-- A preadditive category with kernels, cokernels, and finite products,
in which the coimage-image comparison morphism is always an isomorphism,
is an abelian category.

The Stacks project uses this characterisation at the definition of an abelian category.
See <https://stacks.math.columbia.edu/tag/0109>.
-/
def ofCoimageImageComparisonIsIso : Abelian C where
#align category_theory.abelian.of_coimage_image_comparison_is_iso CategoryTheory.Abelian.ofCoimageImageComparisonIsIso

end CategoryTheory.Abelian

namespace CategoryTheory.Abelian

variable {C : Type u} [Category.{v} C] [Abelian C]

/-- An abelian category has finite biproducts. -/
instance (priority := 100) hasFiniteBiproducts : HasFiniteBiproducts C :=
  Limits.HasFiniteBiproducts.of_hasFiniteProducts
#align category_theory.abelian.has_finite_biproducts CategoryTheory.Abelian.hasFiniteBiproducts

instance (priority := 100) hasBinaryBiproducts : HasBinaryBiproducts C :=
  Limits.hasBinaryBiproducts_of_finite_biproducts _
#align category_theory.abelian.has_binary_biproducts CategoryTheory.Abelian.hasBinaryBiproducts

instance (priority := 100) hasZeroObject : HasZeroObject C :=
  hasZeroObject_of_hasInitial_object
#align category_theory.abelian.has_zero_object CategoryTheory.Abelian.hasZeroObject

section ToNonPreadditiveAbelian

/-- Every abelian category is, in particular, `non_preadditive_abelian`. -/
def nonPreadditiveAbelian : NonPreadditiveAbelian C :=
  { ‹Abelian C› with }
#align category_theory.abelian.non_preadditive_abelian CategoryTheory.Abelian.nonPreadditiveAbelian

end ToNonPreadditiveAbelian

section

/-! We now promote some instances that were constructed using `non_preadditive_abelian`. -/

attribute [local instance] non_preadditive_abelian

variable {P Q : C} (f : P ⟶ Q)

/-- The map `p : P ⟶ image f` is an epimorphism -/
instance : Epi (Abelian.factorThruImage f) := by infer_instance

instance isIso_factorThruImage [Mono f] : IsIso (Abelian.factorThruImage f) := by infer_instance
#align category_theory.abelian.is_iso_factor_thru_image CategoryTheory.Abelian.isIso_factorThruImage

/-- The canonical morphism `i : coimage f ⟶ Q` is a monomorphism -/
instance : Mono (Abelian.factorThruCoimage f) := by infer_instance

instance isIso_factorThruCoimage [Epi f] : IsIso (Abelian.factorThruCoimage f) := by infer_instance
#align category_theory.abelian.is_iso_factor_thru_coimage CategoryTheory.Abelian.isIso_factorThruCoimage

end

section Factor

attribute [local instance] non_preadditive_abelian

variable {P Q : C} (f : P ⟶ Q)

section

theorem mono_of_kernel_ι_eq_zero (h : kernel.ι f = 0) : Mono f :=
  mono_of_kernel_zero h
#align category_theory.abelian.mono_of_kernel_ι_eq_zero CategoryTheory.Abelian.mono_of_kernel_ι_eq_zero

theorem epi_of_cokernel_π_eq_zero (h : cokernel.π f = 0) : Epi f :=
  by
  apply normal_mono_category.epi_of_zero_cokernel _ (cokernel f)
  simp_rw [← h]
  exact is_colimit.of_iso_colimit (colimit.is_colimit (parallel_pair f 0)) (iso_of_π _)
#align category_theory.abelian.epi_of_cokernel_π_eq_zero CategoryTheory.Abelian.epi_of_cokernel_π_eq_zero

end

section

variable {f}

theorem image_ι_comp_eq_zero {R : C} {g : Q ⟶ R} (h : f ≫ g = 0) : Abelian.image.ι f ≫ g = 0 :=
  zero_of_epi_comp (Abelian.factorThruImage f) <| by simp [h]
#align category_theory.abelian.image_ι_comp_eq_zero CategoryTheory.Abelian.image_ι_comp_eq_zero

theorem comp_coimage_π_eq_zero {R : C} {g : Q ⟶ R} (h : f ≫ g = 0) : f ≫ Abelian.coimage.π g = 0 :=
  zero_of_comp_mono (Abelian.factorThruCoimage g) <| by simp [h]
#align category_theory.abelian.comp_coimage_π_eq_zero CategoryTheory.Abelian.comp_coimage_π_eq_zero

end

/-- Factoring through the image is a strong epi-mono factorisation. -/
@[simps]
def imageStrongEpiMonoFactorisation : StrongEpiMonoFactorisation f
    where
  i := Abelian.image f
  m := image.ι f
  m_mono := by infer_instance
  e := Abelian.factorThruImage f
  e_strongEpi := strongEpi_of_epi _
#align category_theory.abelian.image_strong_epi_mono_factorisation CategoryTheory.Abelian.imageStrongEpiMonoFactorisation

/-- Factoring through the coimage is a strong epi-mono factorisation. -/
@[simps]
def coimageStrongEpiMonoFactorisation : StrongEpiMonoFactorisation f
    where
  i := Abelian.coimage f
  m := Abelian.factorThruCoimage f
  m_mono := by infer_instance
  e := coimage.π f
  e_strongEpi := strongEpi_of_epi _
#align category_theory.abelian.coimage_strong_epi_mono_factorisation CategoryTheory.Abelian.coimageStrongEpiMonoFactorisation

end Factor

section HasStrongEpiMonoFactorisations

/-- An abelian category has strong epi-mono factorisations. -/
instance (priority := 100) : HasStrongEpiMonoFactorisations C :=
  HasStrongEpiMonoFactorisations.mk fun X Y f => imageStrongEpiMonoFactorisation f

-- In particular, this means that it has well-behaved images.
example : HasImages C := by infer_instance

example : HasImageMaps C := by infer_instance

end HasStrongEpiMonoFactorisations

section Images

variable {X Y : C} (f : X ⟶ Y)

/-- The coimage-image comparison morphism is always an isomorphism in an abelian category.
See `category_theory.abelian.of_coimage_image_comparison_is_iso` for the converse.
-/
instance : IsIso (coimageImageComparison f) :=
  by
  convert is_iso.of_iso
      (is_image.iso_ext (coimage_strong_epi_mono_factorisation f).toMonoIsImage
        (image_strong_epi_mono_factorisation f).toMonoIsImage)
  ext
  change _ = _ ≫ (image_strong_epi_mono_factorisation f).m
  simp [-image_strong_epi_mono_factorisation_to_mono_factorisation_m]

/-- There is a canonical isomorphism between the abelian coimage and the abelian image of a
    morphism. -/
abbrev coimageIsoImage : Abelian.coimage f ≅ Abelian.image f :=
  asIso (coimageImageComparison f)
#align category_theory.abelian.coimage_iso_image CategoryTheory.Abelian.coimageIsoImage

/-- There is a canonical isomorphism between the abelian coimage and the categorical image of a
    morphism. -/
abbrev coimageIsoImage' : Abelian.coimage f ≅ image f :=
  IsImage.isoExt (coimageStrongEpiMonoFactorisation f).toMonoIsImage (Image.isImage f)
#align category_theory.abelian.coimage_iso_image' CategoryTheory.Abelian.coimageIsoImage'

theorem coimageIsoImage'_hom :
    (coimageIsoImage' f).Hom =
      cokernel.desc _ (factorThruImage f) (by simp [← cancel_mono (limits.image.ι f)]) :=
  by
  ext
  simp only [← cancel_mono (limits.image.ι f), is_image.iso_ext_hom, cokernel.π_desc,
    category.assoc, is_image.lift_ι, coimage_strong_epi_mono_factorisation_to_mono_factorisation_m,
    limits.image.fac]
#align category_theory.abelian.coimage_iso_image'_hom CategoryTheory.Abelian.coimageIsoImage'_hom

theorem factorThruImage_comp_coimageIsoImage'_inv :
    factorThruImage f ≫ (coimageIsoImage' f).inv = cokernel.π _ := by
  simp only [is_image.iso_ext_inv, image.is_image_lift, image.fac_lift,
    coimage_strong_epi_mono_factorisation_to_mono_factorisation_e]
#align category_theory.abelian.factor_thru_image_comp_coimage_iso_image'_inv CategoryTheory.Abelian.factorThruImage_comp_coimageIsoImage'_inv

/-- There is a canonical isomorphism between the abelian image and the categorical image of a
    morphism. -/
abbrev imageIsoImage : Abelian.image f ≅ image f :=
  IsImage.isoExt (imageStrongEpiMonoFactorisation f).toMonoIsImage (Image.isImage f)
#align category_theory.abelian.image_iso_image CategoryTheory.Abelian.imageIsoImage

theorem imageIsoImage_hom_comp_image_ι : (imageIsoImage f).Hom ≫ Limits.image.ι _ = kernel.ι _ := by
  simp only [is_image.iso_ext_hom, is_image.lift_ι,
    image_strong_epi_mono_factorisation_to_mono_factorisation_m]
#align category_theory.abelian.image_iso_image_hom_comp_image_ι CategoryTheory.Abelian.imageIsoImage_hom_comp_image_ι

theorem imageIsoImage_inv :
    (imageIsoImage f).inv =
      kernel.lift _ (Limits.image.ι f) (by simp [← cancel_epi (factor_thru_image f)]) :=
  by
  ext
  simp only [is_image.iso_ext_inv, image.is_image_lift, limits.image.fac_lift,
    image_strong_epi_mono_factorisation_to_mono_factorisation_e, category.assoc, kernel.lift_ι,
    limits.image.fac]
#align category_theory.abelian.image_iso_image_inv CategoryTheory.Abelian.imageIsoImage_inv

end Images

section CokernelOfKernel

variable {X Y : C} {f : X ⟶ Y}

attribute [local instance] non_preadditive_abelian

/-- In an abelian category, an epi is the cokernel of its kernel. More precisely:
    If `f` is an epimorphism and `s` is some limit kernel cone on `f`, then `f` is a cokernel
    of `fork.ι s`. -/
def epiIsCokernelOfKernel [Epi f] (s : Fork f 0) (h : IsLimit s) :
    IsColimit (CokernelCofork.ofπ f (KernelFork.condition s)) :=
  NonPreadditiveAbelian.epiIsCokernelOfKernel s h
#align category_theory.abelian.epi_is_cokernel_of_kernel CategoryTheory.Abelian.epiIsCokernelOfKernel

/-- In an abelian category, a mono is the kernel of its cokernel. More precisely:
    If `f` is a monomorphism and `s` is some colimit cokernel cocone on `f`, then `f` is a kernel
    of `cofork.π s`. -/
def monoIsKernelOfCokernel [Mono f] (s : Cofork f 0) (h : IsColimit s) :
    IsLimit (KernelFork.ofι f (CokernelCofork.condition s)) :=
  NonPreadditiveAbelian.monoIsKernelOfCokernel s h
#align category_theory.abelian.mono_is_kernel_of_cokernel CategoryTheory.Abelian.monoIsKernelOfCokernel

variable (f)

/-- In an abelian category, any morphism that turns to zero when precomposed with the kernel of an
    epimorphism factors through that epimorphism. -/
def epiDesc [Epi f] {T : C} (g : X ⟶ T) (hg : kernel.ι f ≫ g = 0) : Y ⟶ T :=
  (epiIsCokernelOfKernel _ (limit.isLimit _)).desc (CokernelCofork.ofπ _ hg)
#align category_theory.abelian.epi_desc CategoryTheory.Abelian.epiDesc

@[simp, reassoc.1]
theorem comp_epiDesc [Epi f] {T : C} (g : X ⟶ T) (hg : kernel.ι f ≫ g = 0) :
    f ≫ epiDesc f g hg = g :=
  (epiIsCokernelOfKernel _ (limit.isLimit _)).fac (CokernelCofork.ofπ _ hg) WalkingParallelPair.one
#align category_theory.abelian.comp_epi_desc CategoryTheory.Abelian.comp_epiDesc

/-- In an abelian category, any morphism that turns to zero when postcomposed with the cokernel of a
    monomorphism factors through that monomorphism. -/
def monoLift [Mono f] {T : C} (g : T ⟶ Y) (hg : g ≫ cokernel.π f = 0) : T ⟶ X :=
  (monoIsKernelOfCokernel _ (colimit.isColimit _)).lift (KernelFork.ofι _ hg)
#align category_theory.abelian.mono_lift CategoryTheory.Abelian.monoLift

@[simp, reassoc.1]
theorem monoLift_comp [Mono f] {T : C} (g : T ⟶ Y) (hg : g ≫ cokernel.π f = 0) :
    monoLift f g hg ≫ f = g :=
  (monoIsKernelOfCokernel _ (colimit.isColimit _)).fac (KernelFork.ofι _ hg)
    WalkingParallelPair.zero
#align category_theory.abelian.mono_lift_comp CategoryTheory.Abelian.monoLift_comp

end CokernelOfKernel

section

instance (priority := 100) hasEqualizers : HasEqualizers C :=
  Preadditive.hasEqualizers_of_hasKernels
#align category_theory.abelian.has_equalizers CategoryTheory.Abelian.hasEqualizers

/-- Any abelian category has pullbacks -/
instance (priority := 100) hasPullbacks : HasPullbacks C :=
  hasPullbacks_of_hasBinaryProducts_of_hasEqualizers C
#align category_theory.abelian.has_pullbacks CategoryTheory.Abelian.hasPullbacks

end

section

instance (priority := 100) hasCoequalizers : HasCoequalizers C :=
  Preadditive.hasCoequalizers_of_hasCokernels
#align category_theory.abelian.has_coequalizers CategoryTheory.Abelian.hasCoequalizers

/-- Any abelian category has pushouts -/
instance (priority := 100) hasPushouts : HasPushouts C :=
  hasPushouts_of_hasBinaryCoproducts_of_hasCoequalizers C
#align category_theory.abelian.has_pushouts CategoryTheory.Abelian.hasPushouts

instance (priority := 100) hasFiniteLimits : HasFiniteLimits C :=
  Limits.hasFiniteLimits_of_hasEqualizers_and_finite_products
#align category_theory.abelian.has_finite_limits CategoryTheory.Abelian.hasFiniteLimits

instance (priority := 100) hasFiniteColimits : HasFiniteColimits C :=
  Limits.hasFiniteColimits_of_hasCoequalizers_and_finite_coproducts
#align category_theory.abelian.has_finite_colimits CategoryTheory.Abelian.hasFiniteColimits

end

namespace PullbackToBiproductIsKernel

variable [Limits.HasPullbacks C] {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z)

/-! This section contains a slightly technical result about pullbacks and biproducts.
    We will need it in the proof that the pullback of an epimorphism is an epimorpism. -/

/-- The canonical map `pullback f g ⟶ X ⊞ Y` -/
abbrev pullbackToBiproduct : pullback f g ⟶ X ⊞ Y :=
  biprod.lift pullback.fst pullback.snd
#align category_theory.abelian.pullback_to_biproduct_is_kernel.pullback_to_biproduct CategoryTheory.Abelian.PullbackToBiproductIsKernel.pullbackToBiproduct

/-- The canonical map `pullback f g ⟶ X ⊞ Y` induces a kernel cone on the map
    `biproduct X Y ⟶ Z` induced by `f` and `g`. A slightly more intuitive way to think of
    this may be that it induces an equalizer fork on the maps induced by `(f, 0)` and
    `(0, g)`. -/
abbrev pullbackToBiproductFork : KernelFork (biprod.desc f (-g)) :=
  KernelFork.ofι (pullbackToBiproduct f g) <| by
    rw [biprod.lift_desc, comp_neg, pullback.condition, add_right_neg]
#align category_theory.abelian.pullback_to_biproduct_is_kernel.pullback_to_biproduct_fork CategoryTheory.Abelian.PullbackToBiproductIsKernel.pullbackToBiproductFork

/-- The canonical map `pullback f g ⟶ X ⊞ Y` is a kernel of the map induced by
    `(f, -g)`. -/
def isLimitPullbackToBiproduct : IsLimit (pullbackToBiproductFork f g) :=
  Fork.IsLimit.mk _
    (fun s =>
      pullback.lift (Fork.ι s ≫ biprod.fst) (Fork.ι s ≫ biprod.snd) <|
        sub_eq_zero.1 <| by
          rw [category.assoc, category.assoc, ← comp_sub, sub_eq_add_neg, ← comp_neg, ←
            biprod.desc_eq, kernel_fork.condition s])
    (fun s => by
      ext <;> rw [fork.ι_of_ι, category.assoc]
      · rw [biprod.lift_fst, pullback.lift_fst]
      · rw [biprod.lift_snd, pullback.lift_snd])
    fun s m h => by ext <;> simp [← h]
#align category_theory.abelian.pullback_to_biproduct_is_kernel.is_limit_pullback_to_biproduct CategoryTheory.Abelian.PullbackToBiproductIsKernel.isLimitPullbackToBiproduct

end PullbackToBiproductIsKernel

namespace BiproductToPushoutIsCokernel

variable [Limits.HasPushouts C] {W X Y Z : C} (f : X ⟶ Y) (g : X ⟶ Z)

/-- The canonical map `Y ⊞ Z ⟶ pushout f g` -/
abbrev biproductToPushout : Y ⊞ Z ⟶ pushout f g :=
  biprod.desc pushout.inl pushout.inr
#align category_theory.abelian.biproduct_to_pushout_is_cokernel.biproduct_to_pushout CategoryTheory.Abelian.BiproductToPushoutIsCokernel.biproductToPushout

/-- The canonical map `Y ⊞ Z ⟶ pushout f g` induces a cokernel cofork on the map
    `X ⟶ Y ⊞ Z` induced by `f` and `-g`. -/
abbrev biproductToPushoutCofork : CokernelCofork (biprod.lift f (-g)) :=
  CokernelCofork.ofπ (biproductToPushout f g) <| by
    rw [biprod.lift_desc, neg_comp, pushout.condition, add_right_neg]
#align category_theory.abelian.biproduct_to_pushout_is_cokernel.biproduct_to_pushout_cofork CategoryTheory.Abelian.BiproductToPushoutIsCokernel.biproductToPushoutCofork

/-- The cofork induced by the canonical map `Y ⊞ Z ⟶ pushout f g` is in fact a colimit cokernel
    cofork. -/
def isColimitBiproductToPushout : IsColimit (biproductToPushoutCofork f g) :=
  Cofork.IsColimit.mk _
    (fun s =>
      pushout.desc (biprod.inl ≫ Cofork.π s) (biprod.inr ≫ Cofork.π s) <|
        sub_eq_zero.1 <| by
          rw [← category.assoc, ← category.assoc, ← sub_comp, sub_eq_add_neg, ← neg_comp, ←
            biprod.lift_eq, cofork.condition s, zero_comp])
    (fun s => by ext <;> simp) fun s m h => by ext <;> simp [← h]
#align category_theory.abelian.biproduct_to_pushout_is_cokernel.is_colimit_biproduct_to_pushout CategoryTheory.Abelian.BiproductToPushoutIsCokernel.isColimitBiproductToPushout

end BiproductToPushoutIsCokernel

section EpiPullback

variable [Limits.HasPullbacks C] {W X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z)

/-- In an abelian category, the pullback of an epimorphism is an epimorphism.
    Proof from [aluffi2016, IX.2.3], cf. [borceux-vol2, 1.7.6] -/
instance epi_pullback_of_epi_f [Epi f] : Epi (pullback.snd : pullback f g ⟶ Y) :=
  -- It will suffice to consider some morphism e : Y ⟶ R such that
    -- pullback.snd ≫ e = 0 and show that e = 0.
    epi_of_cancel_zero
    _ fun R e h =>
    by
    -- Consider the morphism u := (0, e) : X ⊞ Y⟶ R.
    let u := biprod.desc (0 : X ⟶ R) e
    -- The composite pullback f g ⟶ X ⊞ Y ⟶ R is zero by assumption.
    have hu : pullback_to_biproduct_is_kernel.pullback_to_biproduct f g ≫ u = 0 := by simpa
    -- pullback_to_biproduct f g is a kernel of (f, -g), so (f, -g) is a
    -- cokernel of pullback_to_biproduct f g
    have :=
      epi_is_cokernel_of_kernel _
        (pullback_to_biproduct_is_kernel.is_limit_pullback_to_biproduct f g)
    -- We use this fact to obtain a factorization of u through (f, -g) via some d : Z ⟶ R.
    obtain ⟨d, hd⟩ := cokernel_cofork.is_colimit.desc' this u hu
    change Z ⟶ R at d
    change biprod.desc f (-g) ≫ d = u at hd
    -- But then f ≫ d = 0:
    have : f ≫ d = 0;
    calc
      f ≫ d = (biprod.inl ≫ biprod.desc f (-g)) ≫ d := by rw [biprod.inl_desc]
      _ = biprod.inl ≫ u := by rw [category.assoc, hd]
      _ = 0 := biprod.inl_desc _ _

    -- But f is an epimorphism, so d = 0...
    have : d = 0 := (cancel_epi f).1 (by simpa)
    -- ...or, in other words, e = 0.
    calc
      e = biprod.inr ≫ u := by rw [biprod.inr_desc]
      _ = biprod.inr ≫ biprod.desc f (-g) ≫ d := by rw [← hd]
      _ = biprod.inr ≫ biprod.desc f (-g) ≫ 0 := by rw [this]
      _ = (biprod.inr ≫ biprod.desc f (-g)) ≫ 0 := by rw [← category.assoc]
      _ = 0 := has_zero_morphisms.comp_zero _ _

#align category_theory.abelian.epi_pullback_of_epi_f CategoryTheory.Abelian.epi_pullback_of_epi_f

/-- In an abelian category, the pullback of an epimorphism is an epimorphism. -/
instance epi_pullback_of_epi_g [Epi g] : Epi (pullback.fst : pullback f g ⟶ X) :=
  -- It will suffice to consider some morphism e : X ⟶ R such that
    -- pullback.fst ≫ e = 0 and show that e = 0.
    epi_of_cancel_zero
    _ fun R e h =>
    by
    -- Consider the morphism u := (e, 0) : X ⊞ Y ⟶ R.
    let u := biprod.desc e (0 : Y ⟶ R)
    -- The composite pullback f g ⟶ X ⊞ Y ⟶ R is zero by assumption.
    have hu : pullback_to_biproduct_is_kernel.pullback_to_biproduct f g ≫ u = 0 := by simpa
    -- pullback_to_biproduct f g is a kernel of (f, -g), so (f, -g) is a
    -- cokernel of pullback_to_biproduct f g
    have :=
      epi_is_cokernel_of_kernel _
        (pullback_to_biproduct_is_kernel.is_limit_pullback_to_biproduct f g)
    -- We use this fact to obtain a factorization of u through (f, -g) via some d : Z ⟶ R.
    obtain ⟨d, hd⟩ := cokernel_cofork.is_colimit.desc' this u hu
    change Z ⟶ R at d
    change biprod.desc f (-g) ≫ d = u at hd
    -- But then (-g) ≫ d = 0:
    have : (-g) ≫ d = 0;
    calc
      (-g) ≫ d = (biprod.inr ≫ biprod.desc f (-g)) ≫ d := by rw [biprod.inr_desc]
      _ = biprod.inr ≫ u := by rw [category.assoc, hd]
      _ = 0 := biprod.inr_desc _ _

    -- But g is an epimorphism, thus so is -g, so d = 0...
    have : d = 0 := (cancel_epi (-g)).1 (by simpa)
    -- ...or, in other words, e = 0.
    calc
      e = biprod.inl ≫ u := by rw [biprod.inl_desc]
      _ = biprod.inl ≫ biprod.desc f (-g) ≫ d := by rw [← hd]
      _ = biprod.inl ≫ biprod.desc f (-g) ≫ 0 := by rw [this]
      _ = (biprod.inl ≫ biprod.desc f (-g)) ≫ 0 := by rw [← category.assoc]
      _ = 0 := has_zero_morphisms.comp_zero _ _

#align category_theory.abelian.epi_pullback_of_epi_g CategoryTheory.Abelian.epi_pullback_of_epi_g

theorem epi_snd_of_isLimit [Epi f] {s : PullbackCone f g} (hs : IsLimit s) : Epi s.snd :=
  by
  convert epi_of_epi_fac (is_limit.cone_point_unique_up_to_iso_hom_comp (limit.is_limit _) hs _)
  · rfl
  · exact abelian.epi_pullback_of_epi_f _ _
#align category_theory.abelian.epi_snd_of_is_limit CategoryTheory.Abelian.epi_snd_of_isLimit

theorem epi_fst_of_isLimit [Epi g] {s : PullbackCone f g} (hs : IsLimit s) : Epi s.fst :=
  by
  convert epi_of_epi_fac (is_limit.cone_point_unique_up_to_iso_hom_comp (limit.is_limit _) hs _)
  · rfl
  · exact abelian.epi_pullback_of_epi_g _ _
#align category_theory.abelian.epi_fst_of_is_limit CategoryTheory.Abelian.epi_fst_of_isLimit

/-- Suppose `f` and `g` are two morphisms with a common codomain and suppose we have written `g` as
    an epimorphism followed by a monomorphism. If `f` factors through the mono part of this
    factorization, then any pullback of `g` along `f` is an epimorphism. -/
theorem epi_fst_of_factor_thru_epi_mono_factorization (g₁ : Y ⟶ W) [Epi g₁] (g₂ : W ⟶ Z) [Mono g₂]
    (hg : g₁ ≫ g₂ = g) (f' : X ⟶ W) (hf : f' ≫ g₂ = f) (t : PullbackCone f g) (ht : IsLimit t) :
    Epi t.fst := by
  apply epi_fst_of_is_limit _ _ (pullback_cone.is_limit_of_factors f g g₂ f' g₁ hf hg t ht)
#align category_theory.abelian.epi_fst_of_factor_thru_epi_mono_factorization CategoryTheory.Abelian.epi_fst_of_factor_thru_epi_mono_factorization

end EpiPullback

section MonoPushout

variable [Limits.HasPushouts C] {W X Y Z : C} (f : X ⟶ Y) (g : X ⟶ Z)

instance mono_pushout_of_mono_f [Mono f] : Mono (pushout.inr : Z ⟶ pushout f g) :=
  mono_of_cancel_zero _ fun R e h =>
    by
    let u := biprod.lift (0 : R ⟶ Y) e
    have hu : u ≫ biproduct_to_pushout_is_cokernel.biproduct_to_pushout f g = 0 := by simpa
    have :=
      mono_is_kernel_of_cokernel _
        (biproduct_to_pushout_is_cokernel.is_colimit_biproduct_to_pushout f g)
    obtain ⟨d, hd⟩ := kernel_fork.is_limit.lift' this u hu
    change R ⟶ X at d
    change d ≫ biprod.lift f (-g) = u at hd
    have : d ≫ f = 0;
    calc
      d ≫ f = d ≫ biprod.lift f (-g) ≫ biprod.fst := by rw [biprod.lift_fst]
      _ = u ≫ biprod.fst := by rw [← category.assoc, hd]
      _ = 0 := biprod.lift_fst _ _

    have : d = 0 := (cancel_mono f).1 (by simpa)
    calc
      e = u ≫ biprod.snd := by rw [biprod.lift_snd]
      _ = (d ≫ biprod.lift f (-g)) ≫ biprod.snd := by rw [← hd]
      _ = (0 ≫ biprod.lift f (-g)) ≫ biprod.snd := by rw [this]
      _ = 0 ≫ biprod.lift f (-g) ≫ biprod.snd := by rw [category.assoc]
      _ = 0 := zero_comp

#align category_theory.abelian.mono_pushout_of_mono_f CategoryTheory.Abelian.mono_pushout_of_mono_f

instance mono_pushout_of_mono_g [Mono g] : Mono (pushout.inl : Y ⟶ pushout f g) :=
  mono_of_cancel_zero _ fun R e h =>
    by
    let u := biprod.lift e (0 : R ⟶ Z)
    have hu : u ≫ biproduct_to_pushout_is_cokernel.biproduct_to_pushout f g = 0 := by simpa
    have :=
      mono_is_kernel_of_cokernel _
        (biproduct_to_pushout_is_cokernel.is_colimit_biproduct_to_pushout f g)
    obtain ⟨d, hd⟩ := kernel_fork.is_limit.lift' this u hu
    change R ⟶ X at d
    change d ≫ biprod.lift f (-g) = u at hd
    have : d ≫ (-g) = 0;
    calc
      d ≫ (-g) = d ≫ biprod.lift f (-g) ≫ biprod.snd := by rw [biprod.lift_snd]
      _ = u ≫ biprod.snd := by rw [← category.assoc, hd]
      _ = 0 := biprod.lift_snd _ _

    have : d = 0 := (cancel_mono (-g)).1 (by simpa)
    calc
      e = u ≫ biprod.fst := by rw [biprod.lift_fst]
      _ = (d ≫ biprod.lift f (-g)) ≫ biprod.fst := by rw [← hd]
      _ = (0 ≫ biprod.lift f (-g)) ≫ biprod.fst := by rw [this]
      _ = 0 ≫ biprod.lift f (-g) ≫ biprod.fst := by rw [category.assoc]
      _ = 0 := zero_comp

#align category_theory.abelian.mono_pushout_of_mono_g CategoryTheory.Abelian.mono_pushout_of_mono_g

theorem mono_inr_of_isColimit [Mono f] {s : PushoutCocone f g} (hs : IsColimit s) : Mono s.inr :=
  by
  convert mono_of_mono_fac
      (is_colimit.comp_cocone_point_unique_up_to_iso_hom hs (colimit.is_colimit _) _)
  · rfl
  · exact abelian.mono_pushout_of_mono_f _ _
#align category_theory.abelian.mono_inr_of_is_colimit CategoryTheory.Abelian.mono_inr_of_isColimit

theorem mono_inl_of_isColimit [Mono g] {s : PushoutCocone f g} (hs : IsColimit s) : Mono s.inl :=
  by
  convert mono_of_mono_fac
      (is_colimit.comp_cocone_point_unique_up_to_iso_hom hs (colimit.is_colimit _) _)
  · rfl
  · exact abelian.mono_pushout_of_mono_g _ _
#align category_theory.abelian.mono_inl_of_is_colimit CategoryTheory.Abelian.mono_inl_of_isColimit

/-- Suppose `f` and `g` are two morphisms with a common domain and suppose we have written `g` as
    an epimorphism followed by a monomorphism. If `f` factors through the epi part of this
    factorization, then any pushout of `g` along `f` is a monomorphism. -/
theorem mono_inl_of_factor_thru_epi_mono_factorization (f : X ⟶ Y) (g : X ⟶ Z) (g₁ : X ⟶ W) [Epi g₁]
    (g₂ : W ⟶ Z) [Mono g₂] (hg : g₁ ≫ g₂ = g) (f' : W ⟶ Y) (hf : g₁ ≫ f' = f)
    (t : PushoutCocone f g) (ht : IsColimit t) : Mono t.inl := by
  apply mono_inl_of_is_colimit _ _ (pushout_cocone.is_colimit_of_factors _ _ _ _ _ hf hg t ht)
#align category_theory.abelian.mono_inl_of_factor_thru_epi_mono_factorization CategoryTheory.Abelian.mono_inl_of_factor_thru_epi_mono_factorization

end MonoPushout

end CategoryTheory.Abelian

namespace CategoryTheory.NonPreadditiveAbelian

variable (C : Type u) [Category.{v} C] [NonPreadditiveAbelian C]

/-- Every non_preadditive_abelian category can be promoted to an abelian category. -/
def abelian : Abelian C :=
  {/- We need the `convert`s here because the instances we have are slightly different from the
       instances we need: `has_kernels` depends on an instance of `has_zero_morphisms`. In the
       case of `non_preadditive_abelian`, this instance is an explicit argument. However, in the case
       of `abelian`, the `has_zero_morphisms` instance is derived from `preadditive`. So we need to
       transform an instance of "has kernels with non_preadditive_abelian.has_zero_morphisms" to an
       instance of "has kernels with non_preadditive_abelian.preadditive.has_zero_morphisms". Luckily,
       we have a `subsingleton` instance for `has_zero_morphisms`, so `convert` can immediately close
       the goal it creates for the two instances of `has_zero_morphisms`, and the proof is complete. -/
    NonPreadditiveAbelian.preadditive with
    HasFiniteProducts := by infer_instance
    HasKernels := by convert(by infer_instance : limits.has_kernels C)
    HasCokernels := by convert(by infer_instance : limits.has_cokernels C)
    normalMonoOfMono := by
      intros
      convert normal_mono_of_mono f
    normalEpiOfEpi := by
      intros
      convert normal_epi_of_epi f }
#align category_theory.non_preadditive_abelian.abelian CategoryTheory.NonPreadditiveAbelian.abelian

end CategoryTheory.NonPreadditiveAbelian


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import data.multiset.nodup

/-!
# The cartesian product of multisets
-/

namespace multiset

section pi
variables {α : Type*}
open function

/-- Given `δ : α → Type*`, `pi.empty δ` is the trivial dependent function out of the empty
multiset. -/
def pi.empty (δ : α → Type*) : (Πa∈(0:multiset α), δ a) .

variables [decidable_eq α] {δ : α → Type*}

/-- Given `δ : α → Type*`, a multiset `m` and a term `a`, as well as a term `b : δ a` and a
function `f` such that `f a' : δ a'` for all `a'` in `m`, `pi.cons m a b f` is a function `g` such
that `g a'' : δ a''` for all `a''` in `a ::ₘ m`. -/
def pi.cons (m : multiset α) (a : α) (b : δ a) (f : Πa∈m, δ a) : Πa'∈a ::ₘ m, δ a' :=
λa' ha', if h : a' = a then eq.rec b h.symm else f a' $ (mem_cons.1 ha').resolve_left h

lemma pi.cons_same {m : multiset α} {a : α} {b : δ a} {f : Πa∈m, δ a} (h : a ∈ a ::ₘ m) :
  pi.cons m a b f a h = b :=
dif_pos rfl

lemma pi.cons_ne {m : multiset α} {a a' : α} {b : δ a} {f : Πa∈m, δ a}
  (h' : a' ∈ a ::ₘ m) (h : a' ≠ a) :
  pi.cons m a b f a' h' = f a' ((mem_cons.1 h').resolve_left h) :=
dif_neg h

lemma pi.cons_swap {a a' : α} {b : δ a} {b' : δ a'} {m : multiset α} {f : Πa∈m, δ a} (h : a ≠ a') :
  pi.cons (a' ::ₘ m) a b (pi.cons m a' b' f) == pi.cons (a ::ₘ m) a' b' (pi.cons m a b f) :=
begin
  apply hfunext, { refl }, intros a'' _ h, subst h,
  apply hfunext, { rw [cons_swap] }, intros ha₁ ha₂ h,
  by_cases h₁ : a'' = a; by_cases h₂ : a'' = a';
    simp [*, pi.cons_same, pi.cons_ne] at *,
  { subst h₁, rw [pi.cons_same, pi.cons_same] },
  { subst h₂, rw [pi.cons_same, pi.cons_same] }
end

/-- `pi m t` constructs the Cartesian product over `t` indexed by `m`. -/
def pi (m : multiset α) (t : Πa, multiset (δ a)) : multiset (Πa∈m, δ a) :=
m.rec_on {pi.empty δ} (λa m (p : multiset (Πa∈m, δ a)), (t a).bind $ λb, p.map $ pi.cons m a b)
begin
  intros a a' m n,
  by_cases eq : a = a',
  { subst eq },
  { simp [map_bind, bind_bind (t a') (t a)],
    apply bind_hcongr, { rw [cons_swap a a'] },
    intros b hb,
    apply bind_hcongr, { rw [cons_swap a a'] },
    intros b' hb',
    apply map_hcongr, { rw [cons_swap a a'] },
    intros f hf,
    exact pi.cons_swap eq }
end

@[simp] lemma pi_zero (t : Πa, multiset (δ a)) : pi 0 t = pi.empty δ ::ₘ 0 := rfl

@[simp] lemma pi_cons (m : multiset α) (t : Πa, multiset (δ a)) (a : α) :
  pi (a ::ₘ m) t = ((t a).bind $ λb, (pi m t).map $ pi.cons m a b) :=
rec_on_cons a m

lemma pi_cons_injective {a : α} {b : δ a} {s : multiset α} (hs : a ∉ s) :
  function.injective (pi.cons s a b) :=
assume f₁ f₂ eq, funext $ assume a', funext $ assume h',
have ne : a ≠ a', from assume h, hs $ h.symm ▸ h',
have a' ∈ a ::ₘ s, from mem_cons_of_mem h',
calc f₁ a' h' = pi.cons s a b f₁ a' this : by rw [pi.cons_ne this ne.symm]
  ... = pi.cons s a b f₂ a' this : by rw [eq]
  ... = f₂ a' h' : by rw [pi.cons_ne this ne.symm]

lemma card_pi (m : multiset α) (t : Πa, multiset (δ a)) :
  card (pi m t) = prod (m.map $ λa, card (t a)) :=
multiset.induction_on m (by simp) (by simp [mul_comm] {contextual := tt})

lemma nodup_pi {s : multiset α} {t : Πa, multiset (δ a)} :
  nodup s → (∀a∈s, nodup (t a)) → nodup (pi s t) :=
multiset.induction_on s (assume _ _, nodup_singleton _)
begin
  assume a s ih hs ht,
  have has : a ∉ s, by simp at hs; exact hs.1,
  have hs : nodup s, by simp at hs; exact hs.2,
  simp,
  split,
  { assume b hb,
    from nodup_map (pi_cons_injective has) (ih hs $ assume a' h', ht a' $ mem_cons_of_mem h') },
  { apply pairwise_of_nodup _ (ht a $ mem_cons_self _ _),
    from assume b₁ hb₁ b₂ hb₂ neb, disjoint_map_map.2 (assume f hf g hg eq,
      have pi.cons s a b₁ f a (mem_cons_self _ _) = pi.cons s a b₂ g a (mem_cons_self _ _),
        by rw [eq],
      neb $ show b₁ = b₂, by rwa [pi.cons_same, pi.cons_same] at this) }
end

lemma mem_pi (m : multiset α) (t : Πa, multiset (δ a)) :
  ∀f:Πa∈m, δ a, (f ∈ pi m t) ↔ (∀a (h : a ∈ m), f a h ∈ t a) :=
begin
  refine multiset.induction_on m (λ f, _) (λ a m ih f, _),
  { simpa using show f = pi.empty δ, by funext a ha; exact ha.elim },
  simp only [mem_bind, exists_prop, mem_cons, pi_cons, mem_map], split,
  { rintro ⟨b, hb, f', hf', rfl⟩ a' ha',
    rw [ih] at hf',
    by_cases a' = a,
    { subst h, rwa [pi.cons_same] },
    { rw [pi.cons_ne _ h], apply hf' } },
  { intro hf,
    refine ⟨_, hf a (mem_cons_self a _), λa ha, f a (mem_cons_of_mem ha),
      (ih _).2 (λ a' h', hf _ _), _⟩,
    funext a' h',
    by_cases a' = a,
    { subst h, rw [pi.cons_same] },
    { rw [pi.cons_ne _ h] } }
end

end pi

end multiset


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

Monad encapsulating continuation passing programming style, similar to
Haskell's `Cont`, `ContT` and `MonadCont`:
http://hackage.haskell.org/package/mtl-2.2.2/docs/Control-Monad-Cont.html
-/

import tactic.interactive

universes u v w

structure monad_cont.label (α : Type w) (m : Type u → Type v) (β : Type u) :=
(apply : α → m β)

def monad_cont.goto {α β} {m : Type u → Type v} (f : monad_cont.label α m β) (x : α) := f.apply x

class monad_cont (m : Type u → Type v)
extends monad m :=
(call_cc : Π {α β}, ((monad_cont.label α m β) → m α) → m α)

open monad_cont

class is_lawful_monad_cont (m : Type u → Type v) [monad_cont m]
extends is_lawful_monad m :=
(call_cc_bind_right {α ω γ} (cmd : m α) (next : (label ω m γ) → α → m ω) :
  call_cc (λ f, cmd >>= next f) = cmd >>= λ x, call_cc (λ f, next f x))
(call_cc_bind_left {α} (β) (x : α) (dead : label α m β → β → m α) :
  call_cc (λ f : label α m β, goto f x >>= dead f) = pure x)
(call_cc_dummy {α β} (dummy : m α) :
  call_cc (λ f : label α m β, dummy) = dummy)

export is_lawful_monad_cont

def cont_t (r : Type u) (m : Type u → Type v) (α : Type w) := (α → m r) → m r

namespace cont_t

export monad_cont (label goto)

variables {r : Type u} {m : Type u → Type v} {α β γ ω : Type w}

def run : cont_t r m α → (α → m r) → m r := id

def map (f : m r → m r) (x : cont_t r m α) : cont_t r m α := f ∘ x

lemma run_cont_t_map_cont_t (f : m r → m r) (x : cont_t r m α) :
  run (map f x) = f ∘ run x := rfl

def with_cont_t (f : (β → m r) → α → m r) (x : cont_t r m α) : cont_t r m β :=
λ g, x $ f g

lemma run_with_cont_t (f : (β → m r) → α → m r) (x : cont_t r m α) :
  run (with_cont_t f x) = run x ∘ f := rfl

instance : monad (cont_t r m) :=
{ pure := λ α x f, f x,
  bind := λ α β x f g, x $ λ i, f i g }

instance : is_lawful_monad (cont_t r m) :=
{ id_map := by { intros, refl },
  pure_bind := by { intros, ext, refl },
  bind_assoc := by { intros, ext, refl } }

instance [monad m] : has_monad_lift m (cont_t r m) :=
{ monad_lift := λ a x f, x >>= f }

lemma monad_lift_bind [monad m] [is_lawful_monad m] {α β} (x : m α) (f : α → m β) :
  (monad_lift (x >>= f) : cont_t r m β) = monad_lift x >>= monad_lift ∘ f :=
by { ext, simp only [monad_lift,has_monad_lift.monad_lift,(∘),(>>=),bind_assoc,id.def] }

instance : monad_cont (cont_t r m) :=
{ call_cc := λ α β f g, f ⟨λ x h, g x⟩ g }

instance : is_lawful_monad_cont (cont_t r m) :=
{ call_cc_bind_right := by intros; ext; refl,
  call_cc_bind_left := by intros; ext; refl,
  call_cc_dummy := by intros; ext; refl }

end cont_t


/-
Copyright (c) 2022 Rémi Bottinelli. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémi Bottinelli
-/
import category_theory.category.basic
import category_theory.functor.basic
import category_theory.groupoid
import tactic.nth_rewrite
import category_theory.path_category
import category_theory.quotient
import combinatorics.quiver.symmetric

/-!
# Free groupoid on a quiver

This file defines the free groupoid on a quiver, the lifting of a prefunctor to its unique
extension as a functor from the free groupoid, and proves uniqueness of this extension.

## Main results

Given the type `V` and a quiver instance on `V`:

- `free_groupoid V`: a type synonym for `V`.
- `free_groupoid_groupoid`: the `groupoid` instance on `free_groupoid V`.
- `lift`: the lifting of a prefunctor from `V` to `V'` where `V'` is a groupoid, to a functor.
  `free_groupoid V ⥤ V'`.
- `lift_spec` and `lift_unique`: the proofs that, respectively, `lift` indeed is a lifting
  and is the unique one.

## Implementation notes

The free groupoid is first defined by symmetrifying the quiver, taking the induced path category
and finally quotienting by the reducibility relation.

-/

open set classical function
local attribute [instance] prop_decidable

namespace category_theory
namespace groupoid
namespace free

universes u v u' v' u'' v''

variables {V : Type u} [quiver.{v+1} V]

/-- Shorthand for the "forward" arrow corresponding to `f` in `paths $ symmetrify V` -/
abbreviation quiver.hom.to_pos_path {X Y : V} (f : X ⟶ Y) :
  ((category_theory.paths.category_paths $ quiver.symmetrify V).hom X Y) := f.to_pos.to_path

/-- Shorthand for the "forward" arrow corresponding to `f` in `paths $ symmetrify V` -/
abbreviation quiver.hom.to_neg_path {X Y : V} (f : X ⟶ Y) :
  ((category_theory.paths.category_paths $ quiver.symmetrify V).hom Y X) := f.to_neg.to_path

/-- The "reduction" relation -/
inductive red_step : hom_rel (paths (quiver.symmetrify V))
| step (X Z : quiver.symmetrify V) (f : X ⟶ Z) :
    red_step (𝟙 X) (f.to_path ≫ (quiver.reverse f).to_path)

/-- The underlying vertices of the free groupoid -/
def _root_.category_theory.free_groupoid (V) [Q : quiver V] := quotient (@red_step V Q)

instance {V} [Q : quiver V] [h : nonempty V] : nonempty (free_groupoid V) := ⟨⟨h.some⟩⟩

lemma congr_reverse {X Y : paths $ quiver.symmetrify V} (p q : X ⟶ Y) :
  quotient.comp_closure red_step p q →
  quotient.comp_closure red_step (p.reverse) (q.reverse) :=
begin
  rintro ⟨XW, pp, qq, WY, _, Z, f⟩,
  have : quotient.comp_closure red_step (WY.reverse ≫ 𝟙 _ ≫ XW.reverse)
    (WY.reverse ≫ (f.to_path ≫ (quiver.reverse f).to_path) ≫ XW.reverse),
  { apply quotient.comp_closure.intro,
    apply red_step.step, },
  simpa only [category_struct.comp, category_struct.id, quiver.path.reverse, quiver.path.nil_comp,
    quiver.path.reverse_comp, quiver.reverse_reverse, quiver.path.reverse_to_path,
    quiver.path.comp_assoc] using this,
end

lemma congr_comp_reverse {X Y : paths $ quiver.symmetrify V} (p : X ⟶ Y) :
  quot.mk (@quotient.comp_closure _ _ red_step _ _) (p ≫ p.reverse) =
  quot.mk (@quotient.comp_closure _ _ red_step _ _) (𝟙 X) :=
begin
  apply quot.eqv_gen_sound,
  induction p with _ _ q f ih,
  { apply eqv_gen.refl, },
  { simp only [quiver.path.reverse],
    fapply eqv_gen.trans,
    { exact q ≫ q.reverse, },
    { apply eqv_gen.symm, apply eqv_gen.rel,
      have : quotient.comp_closure
               red_step (q ≫ (𝟙 _) ≫ q.reverse)
               (q ≫ (f.to_path ≫ (quiver.reverse f).to_path) ≫ q.reverse), by
      { apply quotient.comp_closure.intro, apply red_step.step, },
      have that : q.cons f = q.comp f.to_path, by refl, rw that,
      simp only [category.assoc, category.id_comp] at this ⊢,
      simp only [category_struct.comp, quiver.path.comp_assoc] at this ⊢,
      exact this, },
    { exact ih }, },
end

lemma congr_reverse_comp {X Y : paths $ quiver.symmetrify V} (p : X ⟶ Y) :
  quot.mk (@quotient.comp_closure _ _ red_step _ _) (p.reverse ≫ p) =
  quot.mk (@quotient.comp_closure _ _ red_step _ _) (𝟙 Y) :=
begin
  nth_rewrite 1 ←quiver.path.reverse_reverse p,
  apply congr_comp_reverse,
end

instance : category (free_groupoid V) := quotient.category red_step

/-- The inverse of an arrow in the free groupoid -/
def quot_inv {X Y : free_groupoid V} (f : X ⟶ Y) : Y ⟶ X :=
quot.lift_on f
            (λ pp, quot.mk _ $ pp.reverse)
            (λ pp qq con, quot.sound $ congr_reverse pp qq con)

instance : groupoid (free_groupoid V) :=
{ inv := λ X Y f, quot_inv f,
  inv_comp' := λ X Y p, quot.induction_on p $ λ pp, congr_reverse_comp pp,
  comp_inv' := λ X Y p, quot.induction_on p $ λ pp, congr_comp_reverse pp }

/-- The inclusion of the quiver on `V` to the underlying quiver on `free_groupoid V`-/
def of (V) [quiver V] : V ⥤q (free_groupoid V) :=
{ obj := λ X, ⟨X⟩,
  map := λ X Y f, quot.mk _ f.to_pos_path }

lemma of_eq : of V =
  (quiver.symmetrify.of ⋙q paths.of).comp (quotient.functor $ @red_step V _).to_prefunctor :=
begin
  apply prefunctor.ext, rotate,
  { rintro X, refl, },
  { rintro X Y f, refl, }
end

section universal_property

variables {V' : Type u'} [groupoid V'] (φ : V ⥤q V')

/-- The lift of a prefunctor to a groupoid, to a functor from `free_groupoid V` -/
def lift (φ : V ⥤q V') : free_groupoid V ⥤ V' :=
quotient.lift _
  (paths.lift $ quiver.symmetrify.lift φ)
  (by
    { rintros _ _ _ _ ⟨X,Y,f⟩,
      simp only [quiver.symmetrify.lift_reverse, paths.lift_nil, quiver.path.comp_nil,
                 paths.lift_cons, paths.lift_to_path],
      symmetry,
      apply groupoid.comp_inv, })

lemma lift_spec (φ : V ⥤q V') : of V ⋙q (lift φ).to_prefunctor = φ :=
begin
  rw [of_eq, prefunctor.comp_assoc, prefunctor.comp_assoc, functor.to_prefunctor_comp],
  dsimp [lift],
  rw [quotient.lift_spec, paths.lift_spec, quiver.symmetrify.lift_spec],
end

lemma lift_unique (φ : V ⥤q V') (Φ : free_groupoid V ⥤ V')
  (hΦ : of V ⋙q Φ.to_prefunctor = φ) : Φ = lift φ :=
begin
  apply quotient.lift_unique,
  apply paths.lift_unique,
  fapply @quiver.symmetrify.lift_unique _ _ _ _ _ _ _ _ _,
  { rw ←functor.to_prefunctor_comp, exact hΦ, },
  { constructor, rintros X Y f,
    simp only [←functor.to_prefunctor_comp,prefunctor.comp_map, paths.of_map, inv_eq_inv],
    change Φ.map (inv ((quotient.functor red_step).to_prefunctor.map f.to_path)) =
           inv (Φ.map ((quotient.functor red_step).to_prefunctor.map f.to_path)),
    have := functor.map_inv Φ ((quotient.functor red_step).to_prefunctor.map f.to_path),
    convert this; simp only [inv_eq_inv], },
end

end universal_property

section functoriality

variables {V' : Type u'} [quiver.{v'+1} V'] {V'' : Type u''} [quiver.{v''+1} V'']

/-- The functor of free groupoid induced by a prefunctor of quivers -/
def _root_.category_theory.free_groupoid_functor (φ : V ⥤q V') :
  free_groupoid V ⥤ free_groupoid V' := lift (φ ⋙q of V')

lemma free_groupoid_functor_comp
  (φ : V ⥤q V') (φ' : V' ⥤q V'') :
  free_groupoid_functor (φ ⋙q φ') = free_groupoid_functor φ ⋙ free_groupoid_functor φ' :=
begin
  dsimp only [free_groupoid_functor], symmetry,
  apply lift_unique, refl,
end

end functoriality

end free
end groupoid
end category_theory


-- Iteration of equivalences over the integers

-- Idea -- if f is a bijection then we can talk about f^n for n an integer,
-- because f⁻¹ is just the inverse bijection

import tactic

namespace int

-- First we define f^n as a function
-- This is the n'th iterate of f as a function from X to X

-- honest approach via iterations needs big API before
-- you can make ℤ → ≃ → ≃

-- there is already the notation `f^[n]` when f is a function and
-- n is a natural. I will steal their binding power.

-- _ `^[`:1 _:1 `]`:0 := nat.iterate #1 #0

-- here is some cool notation (hopefully with the correct binding power)

def iterate {X : Type} (n : ℤ) (f : X ≃ X) : X ≃ X := f^n

-- make a definition for iterate
-- Not sure what we need

-- currently: no interface at all for `iterate`.

-- I mean that there are functions in the iterate namespace.
-- For example

-- notation might have to be changed but all I care about is
-- that n must be to left of f. No arguments until it
-- turns out rubbish
--notation `⦃`:1 n `⦄^`:1 f := int.iterate n f

namespace iterate

variables {X : Type} (m n : ℤ) (f : X ≃ X) (x : X)

lemma comp : int.iterate m f (int.iterate n f x) = int.iterate (m + n) f x :=
begin
  suffices : (f ^ m * f ^ n) x = (f ^ (m + n)) x,
    convert this,
  rw gpow_add,
end

@[simp] lemma zero : iterate 0 f = equiv.refl X := rfl
@[simp] lemma one : iterate 1 f = f := by { ext x, refl }
@[simp] lemma neg_one : iterate (-1) f = f.symm := by { ext x, refl }

lemma neg (a : ℤ) : iterate (-a) f = iterate a f.symm :=
by show f^(-a) = f⁻¹^a; group

lemma succ : iterate n f (f x) = iterate (n + 1) f x := comp n 1 f x

lemma succ' : f (iterate n f x) = iterate (n + 1) f x :=
by rw add_comm; exact comp 1 n f x

theorem mul (f : X ≃ X) (a b : ℤ) (x : X) : iterate a (iterate b f) =
int.iterate (a * b) f := by show (f ^ b) ^ a = f ^ (a * b); group

end iterate

end int