/-
Copyright (c) 2021 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.shapes.wide_equalizers
import category_theory.limits.shapes.products
import category_theory.limits.shapes.terminal

/-!
# Constructions related to weakly initial objects

This file gives constructions related to weakly initial objects, namely:
* If a category has small products and a small weakly initial set of objects, then it has a weakly
  initial object.
* If a category has wide equalizers and a weakly initial object, then it has an initial object.

These are primarily useful to show the General Adjoint Functor Theorem.
-/
universes v u

namespace category_theory
open limits

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

/--
If `C` has (small) products and a small weakly initial set of objects, then it has a weakly initial
object.
-/
lemma has_weakly_initial_of_weakly_initial_set_and_has_products [has_products C]
  {ι : Type v} {B : ι → C} (hB : ∀ (A : C), ∃ i, nonempty (B i ⟶ A)) :
  ∃ (T : C), ∀ X, nonempty (T ⟶ X) :=
⟨∏ B, λ X, ⟨pi.π _ _ ≫ (hB X).some_spec.some⟩⟩

/--
If `C` has (small) wide equalizers and a weakly initial object, then it has an initial object.

The initial object is constructed as the wide equalizer of all endomorphisms on the given weakly
initial object.
-/
lemma has_initial_of_weakly_initial_and_has_wide_equalizers [has_wide_equalizers C]
  {T : C} (hT : ∀ X, nonempty (T ⟶ X)) :
  has_initial C :=
begin
  let endos := T ⟶ T,
  let i := wide_equalizer.ι (id : endos → endos),
  haveI : nonempty endos := ⟨𝟙 _⟩,
  have : ∀ (X : C), unique (wide_equalizer (id : endos → endos) ⟶ X),
  { intro X,
    refine ⟨⟨i ≫ classical.choice (hT X)⟩, λ a, _⟩,
    let E := equalizer a (i ≫ classical.choice (hT _)),
    let e : E ⟶ wide_equalizer id := equalizer.ι _ _,
    let h : T ⟶ E := classical.choice (hT E),
    have : ((i ≫ h) ≫ e) ≫ i = i ≫ 𝟙 _,
    { rw [category.assoc, category.assoc],
      apply wide_equalizer.condition (id : endos → endos) (h ≫ e ≫ i) },
    rw [category.comp_id, cancel_mono_id i] at this,
    haveI : split_epi e := ⟨i ≫ h, this⟩,
    rw ←cancel_epi e,
    apply equalizer.condition },
  exactI has_initial_of_unique (wide_equalizer (id : endos → endos)),
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

! This file was ported from Lean 3 source module category_theory.limits.shapes.strong_epi
! leanprover-community/mathlib commit 32253a1a1071173b33dc7d6a218cf722c6feb514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Balanced
import Mathlib.CategoryTheory.LiftingProperties.Basic

/-!
# Strong epimorphisms

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 `StrongMonoCategory` and `StrongEpiCategory` 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]
-/

universe v u

namespace CategoryTheory

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

variable {P Q : C}

/-- A strong epimorphism `f` is an epimorphism which has the left lifting property
with respect to monomorphisms. -/
class StrongEpi (f : P ⟶ Q) : Prop where
  /-- The epimorphism condition on `f` -/
  epi : Epi f
  /-- The left lifting property with respect to all monomorphism -/
  llp : ∀ ⦃X Y : C⦄ (z : X ⟶ Y) [Mono z], HasLiftingProperty f z
#align category_theory.strong_epi CategoryTheory.StrongEpi
#align category_theory.strong_epi.epi CategoryTheory.StrongEpi.epi

theorem StrongEpi.mk' {f : P ⟶ Q} [Epi f]
    (hf : ∀ (X Y : C) (z : X ⟶ Y)
      (_ : Mono z) (u : P ⟶ X) (v : Q ⟶ Y) (sq : CommSq u f z v), sq.HasLift) :
    StrongEpi f :=
  { epi := inferInstance
    llp := fun {X Y} z hz => ⟨fun {u v} sq => hf X Y z hz u v sq⟩ }
#align category_theory.strong_epi.mk' CategoryTheory.StrongEpi.mk'

/-- A strong monomorphism `f` is a monomorphism which has the right lifting property
with respect to epimorphisms. -/
class StrongMono (f : P ⟶ Q) : Prop where
  /-- The monomorphism condition on `f` -/
  mono : Mono f
  /-- The right lifting property with respect to all epimorphisms -/
  rlp : ∀ ⦃X Y : C⦄ (z : X ⟶ Y) [Epi z], HasLiftingProperty z f
#align category_theory.strong_mono CategoryTheory.StrongMono

theorem StrongMono.mk' {f : P ⟶ Q} [Mono f]
    (hf : ∀ (X Y : C) (z : X ⟶ Y) (_ : Epi z) (u : X ⟶ P)
      (v : Y ⟶ Q) (sq : CommSq u z f v), sq.HasLift) : StrongMono f where
  mono := inferInstance
  rlp := fun {X Y} z hz => ⟨fun {u v} sq => hf X Y z hz u v sq⟩
#align category_theory.strong_mono.mk' CategoryTheory.StrongMono.mk'

attribute [instance] StrongEpi.llp

attribute [instance] StrongMono.rlp

instance (priority := 100) epi_of_strongEpi (f : P ⟶ Q) [StrongEpi f] : Epi f :=
  StrongEpi.epi
#align category_theory.epi_of_strong_epi CategoryTheory.epi_of_strongEpi

instance (priority := 100) mono_of_strongMono (f : P ⟶ Q) [StrongMono f] : Mono f :=
  StrongMono.mono
#align category_theory.mono_of_strong_mono CategoryTheory.mono_of_strongMono

section

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

/-- The composition of two strong epimorphisms is a strong epimorphism. -/
theorem strongEpi_comp [StrongEpi f] [StrongEpi g] : StrongEpi (f ≫ g) :=
  { epi := epi_comp _ _
    llp := by
      intros
      infer_instance }
#align category_theory.strong_epi_comp CategoryTheory.strongEpi_comp

/-- The composition of two strong monomorphisms is a strong monomorphism. -/
theorem strongMono_comp [StrongMono f] [StrongMono g] : StrongMono (f ≫ g) :=
  { mono := mono_comp _ _
    rlp := by
      intros
      infer_instance }
#align category_theory.strong_mono_comp CategoryTheory.strongMono_comp

/-- If `f ≫ g` is a strong epimorphism, then so is `g`. -/
theorem strongEpi_of_strongEpi [StrongEpi (f ≫ g)] : StrongEpi g :=
  { epi := epi_of_epi f g
    llp := fun {X Y} z _ => by
      constructor
      intro u v sq
      have h₀ : (f ≫ u) ≫ z = (f ≫ g) ≫ v := by simp only [Category.assoc, sq.w]
      exact
        CommSq.HasLift.mk'
          ⟨(CommSq.mk h₀).lift, by
            simp only [← cancel_mono z, Category.assoc, CommSq.fac_right, sq.w], by simp⟩ }
#align category_theory.strong_epi_of_strong_epi CategoryTheory.strongEpi_of_strongEpi

/-- If `f ≫ g` is a strong monomorphism, then so is `f`. -/
theorem strongMono_of_strongMono [StrongMono (f ≫ g)] : StrongMono f :=
  { mono := mono_of_mono f g
    rlp := fun {X Y} z => by
      intros
      constructor
      intro u v sq
      have h₀ : u ≫ f ≫ g = z ≫ v ≫ g := by
        rw [←Category.assoc, eq_whisker sq.w, Category.assoc]
      exact CommSq.HasLift.mk' ⟨(CommSq.mk h₀).lift, by simp, by simp [← cancel_epi z, sq.w]⟩ }
#align category_theory.strong_mono_of_strong_mono CategoryTheory.strongMono_of_strongMono

/-- An isomorphism is in particular a strong epimorphism. -/
instance (priority := 100) strongEpi_of_isIso [IsIso f] : StrongEpi f where
  epi := by infer_instance
  llp {X Y} z := HasLiftingProperty.of_left_iso _ _
#align category_theory.strong_epi_of_is_iso CategoryTheory.strongEpi_of_isIso

/-- An isomorphism is in particular a strong monomorphism. -/
instance (priority := 100) strongMono_of_isIso [IsIso f] : StrongMono f where
  mono := by infer_instance
  rlp {X Y} z := HasLiftingProperty.of_right_iso _ _
#align category_theory.strong_mono_of_is_iso CategoryTheory.strongMono_of_isIso

theorem StrongEpi.of_arrow_iso {A B A' B' : C} {f : A ⟶ B} {g : A' ⟶ B'}
    (e : Arrow.mk f ≅ Arrow.mk g) [h : StrongEpi f] : StrongEpi g :=
  { epi := by
      rw [Arrow.iso_w' e]
      haveI := epi_comp f e.hom.right
      apply epi_comp
    llp := fun {X Y} z => by
      intro
      apply HasLiftingProperty.of_arrow_iso_left e z }
#align category_theory.strong_epi.of_arrow_iso CategoryTheory.StrongEpi.of_arrow_iso

theorem StrongMono.of_arrow_iso {A B A' B' : C} {f : A ⟶ B} {g : A' ⟶ B'}
    (e : Arrow.mk f ≅ Arrow.mk g) [h : StrongMono f] : StrongMono g :=
  { mono := by
      rw [Arrow.iso_w' e]
      haveI := mono_comp f e.hom.right
      apply mono_comp
    rlp := fun {X Y} z => by
      intro
      apply HasLiftingProperty.of_arrow_iso_right z e }
#align category_theory.strong_mono.of_arrow_iso CategoryTheory.StrongMono.of_arrow_iso

theorem StrongEpi.iff_of_arrow_iso {A B A' B' : C} {f : A ⟶ B} {g : A' ⟶ B'}
    (e : Arrow.mk f ≅ Arrow.mk g) : StrongEpi f ↔ StrongEpi g := by
  constructor <;> intro
  exacts [StrongEpi.of_arrow_iso e, StrongEpi.of_arrow_iso e.symm]
#align category_theory.strong_epi.iff_of_arrow_iso CategoryTheory.StrongEpi.iff_of_arrow_iso

theorem StrongMono.iff_of_arrow_iso {A B A' B' : C} {f : A ⟶ B} {g : A' ⟶ B'}
    (e : Arrow.mk f ≅ Arrow.mk g) : StrongMono f ↔ StrongMono g := by
  constructor <;> intro
  exacts [StrongMono.of_arrow_iso e, StrongMono.of_arrow_iso e.symm]
#align category_theory.strong_mono.iff_of_arrow_iso CategoryTheory.StrongMono.iff_of_arrow_iso

end

/-- A strong epimorphism that is a monomorphism is an isomorphism. -/
theorem isIso_of_mono_of_strongEpi (f : P ⟶ Q) [Mono f] [StrongEpi f] : IsIso f :=
  ⟨⟨(CommSq.mk (show 𝟙 P ≫ f = f ≫ 𝟙 Q by simp)).lift, by aesop_cat⟩⟩
#align category_theory.is_iso_of_mono_of_strong_epi CategoryTheory.isIso_of_mono_of_strongEpi

/-- A strong monomorphism that is an epimorphism is an isomorphism. -/
theorem isIso_of_epi_of_strongMono (f : P ⟶ Q) [Epi f] [StrongMono f] : IsIso f :=
  ⟨⟨(CommSq.mk (show 𝟙 P ≫ f = f ≫ 𝟙 Q by simp)).lift, by aesop_cat⟩⟩
#align category_theory.is_iso_of_epi_of_strong_mono CategoryTheory.isIso_of_epi_of_strongMono

section

variable (C)

/-- A strong epi category is a category in which every epimorphism is strong. -/
class StrongEpiCategory : Prop where
  /-- A strong epi category is a category in which every epimorphism is strong. -/
  strongEpi_of_epi : ∀ {X Y : C} (f : X ⟶ Y) [Epi f], StrongEpi f
#align category_theory.strong_epi_category CategoryTheory.StrongEpiCategory
#align category_theory.strong_epi_category.strong_epi_of_epi CategoryTheory.StrongEpiCategory.strongEpi_of_epi

/-- A strong mono category is a category in which every monomorphism is strong. -/
class StrongMonoCategory : Prop where
  /-- A strong mono category is a category in which every monomorphism is strong. -/
  strongMono_of_mono : ∀ {X Y : C} (f : X ⟶ Y) [Mono f], StrongMono f
#align category_theory.strong_mono_category CategoryTheory.StrongMonoCategory
#align category_theory.strong_mono_category.strong_mono_of_mono CategoryTheory.StrongMonoCategory.strongMono_of_mono

end

theorem strongEpi_of_epi [StrongEpiCategory C] (f : P ⟶ Q) [Epi f] : StrongEpi f :=
  StrongEpiCategory.strongEpi_of_epi _
#align category_theory.strong_epi_of_epi CategoryTheory.strongEpi_of_epi

theorem strongMono_of_mono [StrongMonoCategory C] (f : P ⟶ Q) [Mono f] : StrongMono f :=
  StrongMonoCategory.strongMono_of_mono _
#align category_theory.strong_mono_of_mono CategoryTheory.strongMono_of_mono

section

attribute [local instance] strongEpi_of_epi

instance (priority := 100) balanced_of_strongEpiCategory [StrongEpiCategory C] : Balanced C where
  isIso_of_mono_of_epi _ _ _ := isIso_of_mono_of_strongEpi _
#align category_theory.balanced_of_strong_epi_category CategoryTheory.balanced_of_strongEpiCategory

end

section

attribute [local instance] strongMono_of_mono

instance (priority := 100) balanced_of_strongMonoCategory [StrongMonoCategory C] : Balanced C where
  isIso_of_mono_of_epi _ _ _ := isIso_of_epi_of_strongMono _
#align category_theory.balanced_of_strong_mono_category CategoryTheory.balanced_of_strongMonoCategory

end

end CategoryTheory


import data.list.basic
import data.polynomial.eval
import data.mv_polynomial.basic
import order.compare
import data.finmap
import tree

namespace list

section all_some

@[simp] lemma all_some_nil {α : Type*} : (@list.nil $ option α).all_some = some [] := rfl

@[simp] lemma all_some_cons_none {α} (x : list (option α)) :
  (none :: x).all_some = none := rfl

@[simp] lemma all_some_cons_some {α} (x : list (option α)) (y) :
  (some y :: x).all_some = x.all_some.map (list.cons y) := rfl

@[simp] theorem all_some_of_map_some {α} (x : list α) :
  (x.map some).all_some = some x :=
by induction x; simp [*]

end all_some

section init

@[simp] lemma init_nil {α : Type*} : ([] : list α).init = [] := rfl

@[simp] lemma snoc_init {α : Type*} (x : list α) (y : α) : (x ++ [y]).init = x :=
by simp [list.init]

@[simp] lemma map_init {α β : Type*} (x : list α) (f : α → β) : x.init.map f = (x.map f).init :=
by { induction x using list.reverse_rec_on with x lst; simp, }

end init

section foldl

@[simp] lemma foldl_eq_iterate {α β : Type*} (ls : list α) (acc : β) (f : β → β) :
  ls.foldl (λ x _, f x) acc = (f^[ls.length] acc) :=
by { induction ls generalizing acc; simp [*], }

lemma foldl_transport_equiv {α β β' : Type*} (ls : list α) (acc : β) (f : β → α → β) (eqv : β ≃ β') :
  eqv (ls.foldl f acc) = ls.foldl (λ x e, eqv $ f (eqv.symm x) e) (eqv acc) :=
by { induction ls generalizing acc; simp [*], }

end foldl

section drop

@[simp] lemma tail_iterate {α : Type*} (ls : list α) (n : ℕ) : tail^[n] ls = ls.drop n :=
by { induction n generalizing ls; simp [*, nat.succ_eq_add_one, list.drop_add], }

/- Note: `list.drop_drop` is duplicated as a lemma also as `list.drop_add` -/

lemma drop_tail {α : Type*} (ls : list α) (n : ℕ) : ls.tail.drop n = ls.drop (n + 1) :=
by rw [← drop_one, drop_drop]

end drop

section count

lemma count_map_of_equiv {α β : Type*} [decidable_eq α] [decidable_eq β] (l : list α) (e : α ≃ β) (x : β) :
  (l.map e).count x = l.count (e.symm x) :=
by simpa using l.count_map_of_injective ⇑e e.injective (e.symm x)

end count

section take

lemma iterate_append_nth_eq_self {α : Type*} (l : list α) (n : ℕ) :
  (λ x : list α, x ++ (l.nth x.length).to_list)^[n] [] = l.take n :=
begin
  induction n with n ih, { simp, },
  rw [function.iterate_succ_apply', ih, take_succ, length_take, min_def],
  split_ifs with h, { refl, },
  push_neg at h, rw [nth_eq_none_iff.mpr h.le, nth_eq_none_iff.mpr rfl.le],
end

end take

end list

namespace vector

-- TODO: swap equality, LHS should be simp normal form
lemma nth_one_eq_tail_head {α : Type*} {n} (v : vector α (n + 2)) :
  v.nth 1 = v.tail.head := by simp [← vector.nth_zero]

@[simp] lemma cons_cons_nth_one {α : Type*} {n} (v : vector α n) (a b : α) :
  (a ::ᵥ b ::ᵥ v).nth 1 = b := by simp [nth_one_eq_tail_head]

lemma one_eq_head {α : Type*} (v : vector α 1) : v.head ::ᵥ vector.nil = v :=
by { ext i, fin_cases i, simp, }

end vector

namespace option

lemma to_list_length_le_one {α : Type*} (l : option α) :
  l.to_list.length ≤ 1 := by cases l; simp [to_list]

end option

namespace tree

lemma left_num_nodes_le {α} : ∀ (x : tree α), x.left.num_nodes ≤ x.num_nodes
| nil := rfl.le
| (node _ a b) := nat.le_succ_of_le le_self_add

lemma right_num_nodes_le {α} : ∀ (x : tree α), x.right.num_nodes ≤ x.num_nodes
| nil := rfl.le
| (node _ a b) := nat.le_succ_of_le le_add_self

end tree

namespace polynomial

@[mono]
lemma eval_mono (p : polynomial ℕ) : monotone (λ n : ℕ, p.eval n) :=
begin
  induction p using polynomial.induction_on' with p q h₀ h₁ n a,
  { simp, apply monotone.add; assumption, },
  simp, apply monotone.const_mul _ (zero_le a),
  { intros x y hxy, apply pow_le_pow_of_le_left (zero_le x) hxy, },
end

noncomputable def to_mv {R σ : Type*} [comm_semiring R] (x : σ) :
  polynomial R →+* mv_polynomial σ R := polynomial.eval₂_ring_hom mv_polynomial.C (mv_polynomial.X x)

@[simp] lemma to_mv_eval {R σ : Type*} [comm_semiring R] {x : σ} (p : polynomial R) (i : σ → R) :
  mv_polynomial.eval i (to_mv x p) = p.eval (i x) :=
by { rw [← coe_eval_ring_hom, to_mv, ← ring_hom.comp_apply], congr, ext; simp, }

end polynomial

namespace mv_polynomial
variables {σ : Type*} {R : Type*} [comm_semiring R]

noncomputable def to_polynomial (p : mv_polynomial σ R) : polynomial R :=
p.eval₂ polynomial.C (λ _, polynomial.X)

lemma to_polynomial_eval_eq_coe (p : mv_polynomial σ R) (x : R) :
  p.to_polynomial.eval x = (polynomial.eval_ring_hom x).comp (mv_polynomial.eval₂_hom (@polynomial.C R _) (λ _, polynomial.X)) p :=
rfl

@[simp] lemma to_polynomial_eval_diag (p : mv_polynomial σ R) (x : R) :
  mv_polynomial.eval (λ _ : σ, x) p = p.to_polynomial.eval x :=
begin
  rw to_polynomial_eval_eq_coe,
  apply mv_polynomial.hom_eq_hom,
  { ext y, simp, },
  { intro n, simp, },
end

lemma eval_mono (p : mv_polynomial σ ℕ) : monotone (λ x : σ → ℕ, mv_polynomial.eval x p) :=
begin
  induction p using mv_polynomial.induction_on with n p q ih₁ ih₂ p x ih,
  { simpa using monotone_const, },
  { simp, apply monotone.add; assumption, },
  simp, apply monotone.mul,
  exacts [ih, function.monotone_eval _, λ _, zero_le', λ _, zero_le'],
end

lemma le_to_polynomial_of_le (p : mv_polynomial σ ℕ) (a : ℕ) (x : σ → ℕ)
  (hx : ∀ i, x i ≤ a) : mv_polynomial.eval x p ≤ p.to_polynomial.eval a :=
calc mv_polynomial.eval x p ≤ mv_polynomial.eval (λ _, a) p : p.eval_mono hx
                      ...   = p.to_polynomial.eval a : p.to_polynomial_eval_diag a

lemma le_to_polynomial_of_le_sum₂ (p : mv_polynomial (fin 2) ℕ) (x y : ℕ) :
  mv_polynomial.eval ![x, y] p ≤ p.to_polynomial.eval (x + y) :=
by { apply le_to_polynomial_of_le, simp [fin.forall_fin_two], }

lemma to_polynomial_le_of_le (p : mv_polynomial σ ℕ) (a : ℕ) (x : σ → ℕ)
  (hx : ∀ i, a ≤ x i) : p.to_polynomial.eval a ≤ mv_polynomial.eval x p :=
calc p.to_polynomial.eval a = mv_polynomial.eval (λ _, a) p : (p.to_polynomial_eval_diag a).symm
                        ... ≤ mv_polynomial.eval x p : p.eval_mono hx

end mv_polynomial

namespace list

theorem scanl_nth_le_eq_foldl {α β : Type*} (l : list β) (f : α → β → α) (x : α)
  (n : ℕ) (hn : n < (l.scanl f x).length) :
  (l.scanl f x).nth_le n hn = (l.take n).foldl f x :=
begin
  revert hn, simp only [length_scanl],
  induction l with hd tl ih generalizing x n, { simp, },
  cases n, { simp, },
  simpa [nat.succ_eq_add_one] using ih (f x hd) n,
end

theorem scanl_last_eq_foldl {α β : Type*} (l : list β) (f : α → β → α) (x : α) :
  (l.scanl f x).last' = some (l.foldl f x) :=
by simp [last'_eq_last_of_ne_nil (ne_nil_of_length_eq_succ (l.length_scanl x)), last_eq_nth_le, l.scanl_nth_le_eq_foldl f x, l.length_scanl x]

@[simp] theorem reverse_last' {α : Type*} (l : list α) :
  l.reverse.last' = l.head' := by cases l; simp

@[simp] theorem reverse_head' {α : Type*} (l : list α) :
  l.reverse.head' = l.last' := by simpa [eq_comm] using l.reverse.reverse_last'

end list

namespace tree
variables {α : Type*}

protected def cmp [has_lt α] [decidable_rel ((<) : α → α → Prop)] : tree α → tree α → ordering
| tree.nil tree.nil := ordering.eq
| tree.nil (tree.node _ _ _) := ordering.lt
| (tree.node _ _ _) tree.nil := ordering.gt
| (tree.node x₁ a₁ b₁) (tree.node x₂ a₂ b₂) :=
  (_root_.cmp x₁ x₂).or_else ((cmp a₁ a₂).or_else (cmp b₁ b₂))

instance [has_lt α] : has_lt (tree α) :=
{ lt := λ a b, by classical; exact a.cmp b = ordering.lt }

lemma tree_lt_def [has_lt α] [decidable_rel ((<) : α → α → Prop)] (x y : tree α) :
  x < y ↔ x.cmp y = ordering.lt := by convert iff.rfl

@[simp] lemma _root_.ordering.or_else_eq_eq_iff (x y : ordering) :
  x.or_else y = ordering.eq ↔ x = ordering.eq ∧ y = ordering.eq :=
by cases x; cases y; simp [ordering.or_else]

@[simp] lemma tree_cmp_eq_eq_iff [linear_order α] {x y : tree α} : x.cmp y = ordering.eq ↔ x = y :=
begin
  induction y generalizing x;
  cases x;
  simp [tree.cmp, *],
end

@[simp] lemma tree_cmp_swap [linear_order α] {x y : tree α} : (x.cmp y).swap = y.cmp x :=
begin
  induction y generalizing x;
  cases x;
  simp [tree.cmp, ordering.swap, ordering.swap_or_else, *],
end

@[simp] lemma tree_cmp_eq_gt_iff [linear_order α] {x y : tree α} : (x.cmp y) = ordering.gt ↔ (y.cmp x) = ordering.lt :=
by { split; intro h; apply_fun ordering.swap at h; simpa using h, }

lemma tree_cmp_compares [linear_order α] (x y : tree α) : (x.cmp y).compares x y :=
by { cases H : x.cmp y; simp [tree_lt_def, *] at *, }

instance [linear_order α] : is_strict_order (tree α) (<) :=
{ irrefl := λ x, by simp [tree_lt_def, tree_cmp_eq_eq_iff.mpr rfl],
  trans := λ a b c h₁ h₂, begin
    induction c with xc lc rc ih₁ ih₂ generalizing a b,
    { exfalso, cases b; exact ordering.no_confusion h₂, },
    cases a with xa la ra, { exact rfl, },
    cases b with xb lb rb, { exfalso, exact ordering.no_confusion h₁, },
    simp [tree_lt_def, cmp_eq_lt_iff, tree.cmp, ordering.or_else_eq_lt, tree_cmp_eq_eq_iff] at *,
    rcases h₁ with h₁|⟨rfl, h₁⟩, { left, exact lt_of_lt_of_le h₁ (le_of_lt_or_eq $ h₂.imp_right and.left), },
    refine h₂.imp_right _, clear h₂, rintro ⟨rfl, h₂⟩, refine ⟨rfl, _⟩,
    rcases h₁ with h₁|⟨rfl, h₁⟩,
    { left, rcases h₂ with h₂|⟨rfl, h₂⟩, { exact ih₁ _ _ h₁ h₂, }, exact h₁, },
    refine h₂.imp_right _, clear h₂, rintro ⟨rfl, h₂⟩,
    exact ⟨rfl, ih₂ _ _ h₁ h₂⟩,
  end }

instance [linear_order α] : preorder (tree α) :=
@partial_order.to_preorder _ (partial_order_of_SO (<))

instance [linear_order α] : linear_order (tree α) :=
linear_order_of_compares tree.cmp tree_cmp_compares

instance [linear_order α] : decidable_rel ((≤) : tree α → tree α → Prop) :=
has_le.le.decidable

instance [linear_order α] : decidable_rel ((<) : tree α → tree α → Prop) :=
has_lt.lt.decidable

end tree

namespace multiset

lemma nodupkeys_iff {α : Type*} {β : α → Type*} {s : multiset (sigma β)} :
  s.nodupkeys ↔ s.keys.nodup := quotient.induction_on s $ λ l, iff.rfl

end multiset

namespace finmap

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

lemma keysnodup (f : finmap β) : f.entries.keys.nodup := multiset.nodupkeys_iff.mp f.nodupkeys

def of_fun [fintype α] (f : Π x, β x) :
  finmap β :=
{ entries := finset.univ.val.map (λ x : α, ⟨x, f x⟩),
  nodupkeys := by simpa [multiset.nodupkeys_iff, multiset.keys] using finset.univ.nodup }

lemma mem_lookup_iff [decidable_eq α] {f : finmap β} {x : α} (y : β x) :
   f.lookup x = some y ↔ (⟨x, y⟩ : sigma β) ∈ f.entries :=
induction_on f (λ a, alist.mem_lookup_iff)

@[simp] lemma of_fun_lookup [fintype α] [decidable_eq α] {f : Π x, β x} (x : α) :
  (of_fun f).lookup x = some (f x) :=
by { rw mem_lookup_iff, exact multiset.mem_map_of_mem _ (finset.mem_univ_val x), }

def comap {α β γ : Type*} (m : @finmap α (λ _, β)) (f : α ↪ γ) : @finmap γ (λ _, β) :=
{ entries := m.entries.map (λ x, ⟨f x.1, x.2⟩),
  nodupkeys := multiset.nodupkeys_iff.mpr (by simpa [multiset.keys] using m.keysnodup.map f.2) }

def disj_union {α β γ : Type*} (m₁ : @finmap α (λ _, γ)) (m₂ : @finmap β (λ _, γ)) : @finmap (α ⊕ β) (λ _, γ) :=
{ entries := m₁.entries.map (λ x, ⟨sum.inl x.1, x.2⟩) + m₂.entries.map (λ x, ⟨sum.inr x.1, x.2⟩),
  nodupkeys := begin
    rw [multiset.nodupkeys_iff, multiset.keys, multiset.map_add, multiset.nodup_add],
    refine ⟨_, _, _⟩,
    { simpa [multiset.keys] using m₁.keysnodup.map sum.inl_injective, },
    { simpa [multiset.keys] using m₂.keysnodup.map sum.inr_injective, },
    { simp [multiset.disjoint], }
  end }

@[simp] lemma disj_union_lookup_left {α β γ : Type*} [decidable_eq α] [decidable_eq β] (m₁ : @finmap α (λ _, γ)) (m₂ : @finmap β (λ _, γ)) (x : α) :
  (m₁.disj_union m₂).lookup (sum.inl x) = m₁.lookup x :=
by { ext y, simp [finmap.mem_lookup_iff, finmap.disj_union], }

@[simp] lemma disj_union_lookup_right {α β γ : Type*} [decidable_eq α] [decidable_eq β] (m₁ : @finmap α (λ _, γ)) (m₂ : @finmap β (λ _, γ)) (x : β) :
  (m₁.disj_union m₂).lookup (sum.inr x) = m₂.lookup x :=
by { ext y, simp [finmap.mem_lookup_iff, finmap.disj_union], }

def map {γ : α → Type*} (m : finmap β) (f : ∀ x, β x → γ x) : finmap γ :=
{ entries := m.entries.map (λ x, ⟨x.1, f x.1 x.2⟩),
  nodupkeys := by simpa [multiset.nodupkeys_iff, multiset.keys] using m.keysnodup }

end finmap


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

/-!
# Balanced categories

A category is called balanced if any morphism that is both monic and epic is an isomorphism.

Balanced categories arise frequently. For example, categories in which every monomorphism
(or epimorphism) is strong are balanced. Examples of this are abelian categories and toposes, such
as the category of types.

-/

universes v u

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

section
variables (C)

/-- A category is called balanced if any morphism that is both monic and epic is an isomorphism. -/
class balanced : Prop :=
(is_iso_of_mono_of_epi : ∀ {X Y : C} (f : X ⟶ Y) [mono f] [epi f], is_iso f)

end

lemma is_iso_of_mono_of_epi [balanced C] {X Y : C} (f : X ⟶ Y) [mono f] [epi f] : is_iso f :=
balanced.is_iso_of_mono_of_epi _

lemma is_iso_iff_mono_and_epi [balanced C] {X Y : C} (f : X ⟶ Y) : is_iso f ↔ mono f ∧ epi f :=
⟨λ _, by exactI ⟨infer_instance, infer_instance⟩, λ ⟨_, _⟩, by exactI is_iso_of_mono_of_epi _⟩

section
local attribute [instance] is_iso_of_mono_of_epi

lemma balanced_opposite [balanced C] : balanced Cᵒᵖ :=
{ is_iso_of_mono_of_epi := λ X Y f fmono fepi,
    by { rw ← quiver.hom.op_unop f, exactI is_iso_of_op _ } }

end

end category_theory


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Markus Himmel
-/
import category_theory.limits.preserves.shapes.zero

/-!
# Kernels and cokernels

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

In a category with zero morphisms, the kernel of a morphism `f : X ⟶ Y` is
the equalizer of `f` and `0 : X ⟶ Y`. (Similarly the cokernel is the coequalizer.)

The basic definitions are
* `kernel : (X ⟶ Y) → C`

* `kernel.ι : kernel f ⟶ X`
* `kernel.condition : kernel.ι f ≫ f = 0` and
* `kernel.lift (k : W ⟶ X) (h : k ≫ f = 0) : W ⟶ kernel f` (as well as the dual versions)

## Main statements

Besides the definition and lifts, we prove
* `kernel.ι_zero_is_iso`: a kernel map of a zero morphism is an isomorphism
* `kernel.eq_zero_of_epi_kernel`: if `kernel.ι f` is an epimorphism, then `f = 0`
* `kernel.of_mono`: the kernel of a monomorphism is the zero object
* `kernel.lift_mono`: the lift of a monomorphism `k : W ⟶ X` such that `k ≫ f = 0`
  is still a monomorphism
* `kernel.is_limit_cone_zero_cone`: if our category has a zero object, then the map from the zero
  obect is a kernel map of any monomorphism
* `kernel.ι_of_zero`: `kernel.ι (0 : X ⟶ Y)` is an isomorphism

and the corresponding dual statements.

## Future work
* TODO: connect this with existing working in the group theory and ring theory libraries.

## Implementation notes
As with the other special shapes in the limits library, all the definitions here are given as
`abbreviation`s of the general statements for limits, so all the `simp` lemmas and theorems about
general limits can be used.

## References

* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2]
-/

noncomputable theory

universes v v₂ u u' u₂

open category_theory
open category_theory.limits.walking_parallel_pair

namespace category_theory.limits

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

/-- A morphism `f` has a kernel if the functor `parallel_pair f 0` has a limit. -/
abbreviation has_kernel {X Y : C} (f : X ⟶ Y) : Prop := has_limit (parallel_pair f 0)
/-- A morphism `f` has a cokernel if the functor `parallel_pair f 0` has a colimit. -/
abbreviation has_cokernel {X Y : C} (f : X ⟶ Y) : Prop := has_colimit (parallel_pair f 0)

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

section

/-- A kernel fork is just a fork where the second morphism is a zero morphism. -/
abbreviation kernel_fork := fork f 0

variables {f}

@[simp, reassoc] lemma kernel_fork.condition (s : kernel_fork f) : fork.ι s ≫ f = 0 :=
by erw [fork.condition, has_zero_morphisms.comp_zero]

@[simp] lemma kernel_fork.app_one (s : kernel_fork f) : s.π.app one = 0 :=
by simp [fork.app_one_eq_ι_comp_right]

/-- A morphism `ι` satisfying `ι ≫ f = 0` determines a kernel fork over `f`. -/
abbreviation kernel_fork.of_ι {Z : C} (ι : Z ⟶ X) (w : ι ≫ f = 0) : kernel_fork f :=
fork.of_ι ι $ by rw [w, has_zero_morphisms.comp_zero]

@[simp] lemma kernel_fork.ι_of_ι {X Y P : C} (f : X ⟶ Y) (ι : P ⟶ X) (w : ι ≫ f = 0) :
  fork.ι (kernel_fork.of_ι ι w) = ι := rfl

section
local attribute [tidy] tactic.case_bash

/-- Every kernel fork `s` is isomorphic (actually, equal) to `fork.of_ι (fork.ι s) _`. -/
def iso_of_ι (s : fork f 0) : s ≅ fork.of_ι (fork.ι s) (fork.condition s) :=
cones.ext (iso.refl _) $ by tidy

/-- If `ι = ι'`, then `fork.of_ι ι _` and `fork.of_ι ι' _` are isomorphic. -/
def of_ι_congr {P : C} {ι ι' : P ⟶ X} {w : ι ≫ f = 0} (h : ι = ι') :
  kernel_fork.of_ι ι w ≅ kernel_fork.of_ι ι' (by rw [←h, w]) :=
cones.ext (iso.refl _) $ by tidy

/-- If `F` is an equivalence, then applying `F` to a diagram indexing a (co)kernel of `f` yields
    the diagram indexing the (co)kernel of `F.map f`. -/
def comp_nat_iso {D : Type u'} [category.{v} D] [has_zero_morphisms D] (F : C ⥤ D)
  [is_equivalence F] : parallel_pair f 0 ⋙ F ≅ parallel_pair (F.map f) 0 :=
nat_iso.of_components (λ j, match j with
  | zero := iso.refl _
  | one := iso.refl _
  end) $ by tidy

end

/-- If `s` is a limit kernel fork and `k : W ⟶ X` satisfies ``k ≫ f = 0`, then there is some
    `l : W ⟶ s.X` such that `l ≫ fork.ι s = k`. -/
def kernel_fork.is_limit.lift' {s : kernel_fork f} (hs : is_limit s) {W : C} (k : W ⟶ X)
  (h : k ≫ f = 0) : {l : W ⟶ s.X // l ≫ fork.ι s = k} :=
⟨hs.lift $ kernel_fork.of_ι _ h, hs.fac _ _⟩

/-- This is a slightly more convenient method to verify that a kernel fork is a limit cone. It
    only asks for a proof of facts that carry any mathematical content -/
def is_limit_aux (t : kernel_fork f)
  (lift : Π (s : kernel_fork f), s.X ⟶ t.X)
  (fac : ∀ (s : kernel_fork f), lift s ≫ t.ι = s.ι)
  (uniq : ∀ (s : kernel_fork f) (m : s.X ⟶ t.X) (w : m ≫ t.ι = s.ι), m = lift s) :
  is_limit t :=
{ lift := lift,
  fac' := λ s j, by { cases j, { exact fac s, }, { simp, }, },
  uniq' := λ s m w, uniq s m (w limits.walking_parallel_pair.zero), }

/--
This is a more convenient formulation to show that a `kernel_fork` constructed using
`kernel_fork.of_ι` is a limit cone.
-/
def kernel_fork.is_limit.of_ι {W : C} (g : W ⟶ X) (eq : g ≫ f = 0)
  (lift : Π {W' : C} (g' : W' ⟶ X) (eq' : g' ≫ f = 0), W' ⟶ W)
  (fac : ∀ {W' : C} (g' : W' ⟶ X) (eq' : g' ≫ f = 0), lift g' eq' ≫ g = g')
  (uniq :
    ∀ {W' : C} (g' : W' ⟶ X) (eq' : g' ≫ f = 0) (m : W' ⟶ W) (w : m ≫ g = g'), m = lift g' eq') :
  is_limit (kernel_fork.of_ι g eq) :=
is_limit_aux _ (λ s, lift s.ι s.condition) (λ s, fac s.ι s.condition) (λ s, uniq s.ι s.condition)

/-- Every kernel of `f` induces a kernel of `f ≫ g` if `g` is mono. -/
def is_kernel_comp_mono {c : kernel_fork f} (i : is_limit c) {Z} (g : Y ⟶ Z) [hg : mono g]
  {h : X ⟶ Z} (hh : h = f ≫ g) :
  is_limit (kernel_fork.of_ι c.ι (by simp [hh]) : kernel_fork h) :=
fork.is_limit.mk' _ $ λ s,
  let s' : kernel_fork f := fork.of_ι s.ι (by rw [←cancel_mono g]; simp [←hh, s.condition]) in
  let l := kernel_fork.is_limit.lift' i s'.ι s'.condition in
  ⟨l.1, l.2, λ m hm, by apply fork.is_limit.hom_ext i; rw fork.ι_of_ι at hm; rw hm; exact l.2.symm⟩

lemma is_kernel_comp_mono_lift {c : kernel_fork f} (i : is_limit c) {Z} (g : Y ⟶ Z) [hg : mono g]
  {h : X ⟶ Z} (hh : h = f ≫ g) (s : kernel_fork h) :
  (is_kernel_comp_mono i g hh).lift s
  = i.lift (fork.of_ι s.ι (by { rw [←cancel_mono g, category.assoc, ←hh], simp })) := rfl

/-- Every kernel of `f ≫ g` is also a kernel of `f`, as long as `c.ι ≫ f` vanishes. -/
def is_kernel_of_comp {W : C} (g : Y ⟶ W) (h : X ⟶ W) {c : kernel_fork h} (i : is_limit c)
  (hf : c.ι ≫ f = 0) (hfg : f ≫ g = h) : is_limit (kernel_fork.of_ι c.ι hf) :=
fork.is_limit.mk _
  (λ s, i.lift (kernel_fork.of_ι s.ι (by simp [← hfg])))
  (λ s, by simp only [kernel_fork.ι_of_ι, fork.is_limit.lift_ι])
  (λ s m h, by { apply fork.is_limit.hom_ext i, simpa using h })

end

section
variables [has_kernel f]

/-- The kernel of a morphism, expressed as the equalizer with the 0 morphism. -/
abbreviation kernel : C := equalizer f 0

/-- The map from `kernel f` into the source of `f`. -/
abbreviation kernel.ι : kernel f ⟶ X := equalizer.ι f 0

@[simp] lemma equalizer_as_kernel : equalizer.ι f 0 = kernel.ι f := rfl

@[simp, reassoc] lemma kernel.condition : kernel.ι f ≫ f = 0 :=
kernel_fork.condition _

/-- The kernel built from `kernel.ι f` is limiting. -/
def kernel_is_kernel :
  is_limit (fork.of_ι (kernel.ι f) ((kernel.condition f).trans (comp_zero.symm))) :=
is_limit.of_iso_limit (limit.is_limit _) (fork.ext (iso.refl _) (by tidy))

/-- Given any morphism `k : W ⟶ X` satisfying `k ≫ f = 0`, `k` factors through `kernel.ι f`
    via `kernel.lift : W ⟶ kernel f`. -/
abbreviation kernel.lift {W : C} (k : W ⟶ X) (h : k ≫ f = 0) : W ⟶ kernel f :=
(kernel_is_kernel f).lift (kernel_fork.of_ι k h)

@[simp, reassoc]
lemma kernel.lift_ι {W : C} (k : W ⟶ X) (h : k ≫ f = 0) : kernel.lift f k h ≫ kernel.ι f = k :=
(kernel_is_kernel f).fac (kernel_fork.of_ι k h) walking_parallel_pair.zero

@[simp]
lemma kernel.lift_zero {W : C} {h} : kernel.lift f (0 : W ⟶ X) h = 0 :=
by { ext, simp, }

instance kernel.lift_mono {W : C} (k : W ⟶ X) (h : k ≫ f = 0) [mono k] : mono (kernel.lift f k h) :=
⟨λ Z g g' w,
begin
  replace w := w =≫ kernel.ι f,
  simp only [category.assoc, kernel.lift_ι] at w,
  exact (cancel_mono k).1 w,
end⟩

/-- Any morphism `k : W ⟶ X` satisfying `k ≫ f = 0` induces a morphism `l : W ⟶ kernel f` such that
    `l ≫ kernel.ι f = k`. -/
def kernel.lift' {W : C} (k : W ⟶ X) (h : k ≫ f = 0) : {l : W ⟶ kernel f // l ≫ kernel.ι f = k} :=
⟨kernel.lift f k h, kernel.lift_ι _ _ _⟩

/-- A commuting square induces a morphism of kernels. -/
abbreviation kernel.map {X' Y' : C} (f' : X' ⟶ Y') [has_kernel f']
  (p : X ⟶ X') (q : Y ⟶ Y') (w : f ≫ q = p ≫ f') : kernel f ⟶ kernel f' :=
kernel.lift f' (kernel.ι f ≫ p) (by simp [←w])

/--
Given a commutative diagram
    X --f--> Y --g--> Z
    |        |        |
    |        |        |
    v        v        v
    X' -f'-> Y' -g'-> Z'
with horizontal arrows composing to zero,
then we obtain a commutative square
   X ---> kernel g
   |         |
   |         | kernel.map
   |         |
   v         v
   X' --> kernel g'
-/
lemma kernel.lift_map {X Y Z X' Y' Z' : C}
  (f : X ⟶ Y) (g : Y ⟶ Z) [has_kernel g] (w : f ≫ g = 0)
  (f' : X' ⟶ Y') (g' : Y' ⟶ Z') [has_kernel g'] (w' : f' ≫ g' = 0)
  (p : X ⟶ X') (q : Y ⟶ Y') (r : Z ⟶ Z') (h₁ : f ≫ q = p ≫ f') (h₂ : g ≫ r = q ≫ g') :
  kernel.lift g f w ≫ kernel.map g g' q r h₂ = p ≫ kernel.lift g' f' w' :=
by { ext, simp [h₁], }

/-- A commuting square of isomorphisms induces an isomorphism of kernels. -/
@[simps]
def kernel.map_iso {X' Y' : C} (f' : X' ⟶ Y') [has_kernel f']
  (p : X ≅ X') (q : Y ≅ Y') (w : f ≫ q.hom = p.hom ≫ f') : kernel f ≅ kernel f' :=
{ hom := kernel.map f f' p.hom q.hom w,
  inv := kernel.map f' f p.inv q.inv (by { refine (cancel_mono q.hom).1 _, simp [w], }), }

/-- Every kernel of the zero morphism is an isomorphism -/
instance kernel.ι_zero_is_iso : is_iso (kernel.ι (0 : X ⟶ Y)) :=
equalizer.ι_of_self _

lemma eq_zero_of_epi_kernel [epi (kernel.ι f)] : f = 0 :=
(cancel_epi (kernel.ι f)).1 (by simp)

/-- The kernel of a zero morphism is isomorphic to the source. -/
def kernel_zero_iso_source : kernel (0 : X ⟶ Y) ≅ X :=
equalizer.iso_source_of_self 0

@[simp] lemma kernel_zero_iso_source_hom :
  kernel_zero_iso_source.hom = kernel.ι (0 : X ⟶ Y) := rfl

@[simp] lemma kernel_zero_iso_source_inv :
  kernel_zero_iso_source.inv = kernel.lift (0 : X ⟶ Y) (𝟙 X) (by simp) :=
by { ext, simp [kernel_zero_iso_source], }

/-- If two morphisms are known to be equal, then their kernels are isomorphic. -/
def kernel_iso_of_eq {f g : X ⟶ Y} [has_kernel f] [has_kernel g] (h : f = g) :
  kernel f ≅ kernel g :=
has_limit.iso_of_nat_iso (by simp[h])

@[simp]
lemma kernel_iso_of_eq_refl {h : f = f} : kernel_iso_of_eq h = iso.refl (kernel f) :=
by { ext, simp [kernel_iso_of_eq], }

@[simp, reassoc]
lemma kernel_iso_of_eq_hom_comp_ι {f g : X ⟶ Y} [has_kernel f] [has_kernel g] (h : f = g) :
  (kernel_iso_of_eq h).hom ≫ kernel.ι _ = kernel.ι _ :=
by { unfreezingI { induction h, simp } }

@[simp, reassoc]
lemma kernel_iso_of_eq_inv_comp_ι {f g : X ⟶ Y} [has_kernel f] [has_kernel g] (h : f = g) :
  (kernel_iso_of_eq h).inv ≫ kernel.ι _ = kernel.ι _ :=
by { unfreezingI { induction h, simp } }

@[simp, reassoc]
lemma lift_comp_kernel_iso_of_eq_hom {Z} {f g : X ⟶ Y} [has_kernel f] [has_kernel g]
  (h : f = g) (e : Z ⟶ X) (he) :
  kernel.lift _ e he ≫ (kernel_iso_of_eq h).hom = kernel.lift _ e (by simp [← h, he]) :=
by { unfreezingI { induction h, simp } }

@[simp, reassoc]
lemma lift_comp_kernel_iso_of_eq_inv {Z} {f g : X ⟶ Y} [has_kernel f] [has_kernel g]
  (h : f = g) (e : Z ⟶ X) (he) :
  kernel.lift _ e he ≫ (kernel_iso_of_eq h).inv = kernel.lift _ e (by simp [h, he]) :=
by { unfreezingI { induction h, simp } }

@[simp]
lemma kernel_iso_of_eq_trans {f g h : X ⟶ Y} [has_kernel f] [has_kernel g] [has_kernel h]
  (w₁ : f = g) (w₂ : g = h) :
  kernel_iso_of_eq w₁ ≪≫ kernel_iso_of_eq w₂ = kernel_iso_of_eq (w₁.trans w₂) :=
by { unfreezingI { induction w₁, induction w₂, }, ext, simp [kernel_iso_of_eq], }

variables {f}

lemma kernel_not_epi_of_nonzero (w : f ≠ 0) : ¬epi (kernel.ι f) :=
λ I, by exactI w (eq_zero_of_epi_kernel f)

lemma kernel_not_iso_of_nonzero (w : f ≠ 0) : (is_iso (kernel.ι f)) → false :=
λ I, kernel_not_epi_of_nonzero w $ by { resetI, apply_instance }

instance has_kernel_comp_mono {X Y Z : C} (f : X ⟶ Y) [has_kernel f] (g : Y ⟶ Z) [mono g] :
  has_kernel (f ≫ g) :=
⟨⟨{ cone := _, is_limit := is_kernel_comp_mono (limit.is_limit _) g rfl }⟩⟩

/--
When `g` is a monomorphism, the kernel of `f ≫ g` is isomorphic to the kernel of `f`.
-/
@[simps]
def kernel_comp_mono {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_kernel f] [mono g] :
  kernel (f ≫ g) ≅ kernel f :=
{ hom := kernel.lift _ (kernel.ι _) (by { rw [←cancel_mono g], simp, }),
  inv := kernel.lift _ (kernel.ι _) (by simp), }

instance has_kernel_iso_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso f] [has_kernel g] :
  has_kernel (f ≫ g) :=
{ exists_limit :=
  ⟨{ cone := kernel_fork.of_ι (kernel.ι g ≫ inv f) (by simp),
     is_limit := is_limit_aux _ (λ s, kernel.lift _ (s.ι ≫ f) (by tidy)) (by tidy)
       (λ s m w, by { simp_rw [←w], ext, simp, }), }⟩ }

/--
When `f` is an isomorphism, the kernel of `f ≫ g` is isomorphic to the kernel of `g`.
-/
@[simps]
def kernel_is_iso_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso f] [has_kernel g] :
  kernel (f ≫ g) ≅ kernel g :=
{ hom := kernel.lift _ (kernel.ι _ ≫ f) (by simp),
  inv := kernel.lift _ (kernel.ι _ ≫ inv f) (by simp), }

end

section has_zero_object
variables [has_zero_object C]

open_locale zero_object

/-- The morphism from the zero object determines a cone on a kernel diagram -/
def kernel.zero_kernel_fork : kernel_fork f :=
{ X := 0,
  π := { app := λ j, 0 }}

/-- The map from the zero object is a kernel of a monomorphism -/
def kernel.is_limit_cone_zero_cone [mono f] : is_limit (kernel.zero_kernel_fork f) :=
fork.is_limit.mk _ (λ s, 0)
  (λ s, by { erw zero_comp,
    convert (zero_of_comp_mono f _).symm,
    exact kernel_fork.condition _ })
  (λ _ _ _, zero_of_to_zero _)

/-- The kernel of a monomorphism is isomorphic to the zero object -/
def kernel.of_mono [has_kernel f] [mono f] : kernel f ≅ 0 :=
functor.map_iso (cones.forget _) $ is_limit.unique_up_to_iso
  (limit.is_limit (parallel_pair f 0)) (kernel.is_limit_cone_zero_cone f)

/-- The kernel morphism of a monomorphism is a zero morphism -/
lemma kernel.ι_of_mono [has_kernel f] [mono f] : kernel.ι f = 0 :=
zero_of_source_iso_zero _ (kernel.of_mono f)

/-- If `g ≫ f = 0` implies `g = 0` for all `g`, then `0 : 0 ⟶ X` is a kernel of `f`. -/
def zero_kernel_of_cancel_zero {X Y : C} (f : X ⟶ Y)
  (hf : ∀ (Z : C) (g : Z ⟶ X) (hgf : g ≫ f = 0), g = 0) :
    is_limit (kernel_fork.of_ι (0 : 0 ⟶ X) (show 0 ≫ f = 0, by simp)) :=
fork.is_limit.mk _ (λ s, 0)
  (λ s, by rw [hf _ _ (kernel_fork.condition s), zero_comp])
  (λ s m h, by ext)

end has_zero_object

section transport

/-- If `i` is an isomorphism such that `l ≫ i.hom = f`, then any kernel of `f` is a kernel of `l`.-/
def is_kernel.of_comp_iso {Z : C} (l : X ⟶ Z) (i : Z ≅ Y) (h : l ≫ i.hom = f)
  {s : kernel_fork f} (hs : is_limit s) : is_limit (kernel_fork.of_ι (fork.ι s) $
    show fork.ι s ≫ l = 0, by simp [←i.comp_inv_eq.2 h.symm]) :=
fork.is_limit.mk _
  (λ s, hs.lift $ kernel_fork.of_ι (fork.ι s) $ by simp [←h])
  (λ s, by simp)
  (λ s m h, by { apply fork.is_limit.hom_ext hs, simpa using h })

/-- If `i` is an isomorphism such that `l ≫ i.hom = f`, then the kernel of `f` is a kernel of `l`.-/
def kernel.of_comp_iso [has_kernel f]
  {Z : C} (l : X ⟶ Z) (i : Z ≅ Y) (h : l ≫ i.hom = f) :
  is_limit (kernel_fork.of_ι (kernel.ι f) $
    show kernel.ι f ≫ l = 0, by simp [←i.comp_inv_eq.2 h.symm]) :=
is_kernel.of_comp_iso f l i h $ limit.is_limit _

/-- If `s` is any limit kernel cone over `f` and if  `i` is an isomorphism such that
    `i.hom ≫ s.ι  = l`, then `l` is a kernel of `f`. -/
def is_kernel.iso_kernel {Z : C} (l : Z ⟶ X) {s : kernel_fork f} (hs : is_limit s)
  (i : Z ≅ s.X) (h : i.hom ≫ fork.ι s = l) : is_limit (kernel_fork.of_ι l $
    show l ≫ f = 0, by simp [←h]) :=
is_limit.of_iso_limit hs $ cones.ext i.symm $ λ j,
  by { cases j, { exact (iso.eq_inv_comp i).2 h }, { simp } }

/-- If `i` is an isomorphism such that `i.hom ≫ kernel.ι f = l`, then `l` is a kernel of `f`. -/
def kernel.iso_kernel [has_kernel f]
  {Z : C} (l : Z ⟶ X) (i : Z ≅ kernel f) (h : i.hom ≫ kernel.ι f = l) :
  is_limit (kernel_fork.of_ι l $ by simp [←h]) :=
is_kernel.iso_kernel f l (limit.is_limit _) i h

end transport

section
variables (X Y)

/-- The kernel morphism of a zero morphism is an isomorphism -/
lemma kernel.ι_of_zero : is_iso (kernel.ι (0 : X ⟶ Y)) :=
equalizer.ι_of_self _

end

section

/-- A cokernel cofork is just a cofork where the second morphism is a zero morphism. -/
abbreviation cokernel_cofork := cofork f 0

variables {f}

@[simp, reassoc] lemma cokernel_cofork.condition (s : cokernel_cofork f) : f ≫ s.π = 0 :=
by rw [cofork.condition, zero_comp]

@[simp] lemma cokernel_cofork.π_eq_zero (s : cokernel_cofork f) : s.ι.app zero = 0 :=
by simp [cofork.app_zero_eq_comp_π_right]

/-- A morphism `π` satisfying `f ≫ π = 0` determines a cokernel cofork on `f`. -/
abbreviation cokernel_cofork.of_π {Z : C} (π : Y ⟶ Z) (w : f ≫ π = 0) : cokernel_cofork f :=
cofork.of_π π $ by rw [w, zero_comp]

@[simp] lemma cokernel_cofork.π_of_π {X Y P : C} (f : X ⟶ Y) (π : Y ⟶ P) (w : f ≫ π = 0) :
  cofork.π (cokernel_cofork.of_π π w) = π := rfl

/-- Every cokernel cofork `s` is isomorphic (actually, equal) to `cofork.of_π (cofork.π s) _`. -/
def iso_of_π (s : cofork f 0) : s ≅ cofork.of_π (cofork.π s) (cofork.condition s) :=
cocones.ext (iso.refl _) $ λ j, by cases j; tidy

/-- If `π = π'`, then `cokernel_cofork.of_π π _` and `cokernel_cofork.of_π π' _` are isomorphic. -/
def of_π_congr {P : C} {π π' : Y ⟶ P} {w : f ≫ π = 0} (h : π = π') :
  cokernel_cofork.of_π π w ≅ cokernel_cofork.of_π π' (by rw [←h, w]) :=
cocones.ext (iso.refl _) $ λ j, by cases j; tidy

/-- If `s` is a colimit cokernel cofork, then every `k : Y ⟶ W` satisfying `f ≫ k = 0` induces
    `l : s.X ⟶ W` such that `cofork.π s ≫ l = k`. -/
def cokernel_cofork.is_colimit.desc' {s : cokernel_cofork f} (hs : is_colimit s) {W : C} (k : Y ⟶ W)
  (h : f ≫ k = 0) : {l : s.X ⟶ W // cofork.π s ≫ l = k} :=
⟨hs.desc $ cokernel_cofork.of_π _ h, hs.fac _ _⟩

/--
This is a slightly more convenient method to verify that a cokernel cofork is a colimit cocone.
It only asks for a proof of facts that carry any mathematical content -/
def is_colimit_aux (t : cokernel_cofork f)
  (desc : Π (s : cokernel_cofork f), t.X ⟶ s.X)
  (fac : ∀ (s : cokernel_cofork f), t.π ≫ desc s = s.π)
  (uniq : ∀ (s : cokernel_cofork f) (m : t.X ⟶ s.X) (w : t.π ≫ m = s.π), m = desc s) :
  is_colimit t :=
{ desc := desc,
  fac' := λ s j, by { cases j, { simp, }, { exact fac s, }, },
  uniq' := λ s m w, uniq s m (w limits.walking_parallel_pair.one), }

/--
This is a more convenient formulation to show that a `cokernel_cofork` constructed using
`cokernel_cofork.of_π` is a limit cone.
-/
def cokernel_cofork.is_colimit.of_π {Z : C} (g : Y ⟶ Z) (eq : f ≫ g = 0)
  (desc : Π {Z' : C} (g' : Y ⟶ Z') (eq' : f ≫ g' = 0), Z ⟶ Z')
  (fac : ∀ {Z' : C} (g' : Y ⟶ Z') (eq' : f ≫ g' = 0), g ≫ desc g' eq' = g')
  (uniq :
    ∀ {Z' : C} (g' : Y ⟶ Z') (eq' : f ≫ g' = 0) (m : Z ⟶ Z') (w : g ≫ m = g'), m = desc g' eq') :
  is_colimit (cokernel_cofork.of_π g eq) :=
is_colimit_aux _ (λ s, desc s.π s.condition) (λ s, fac s.π s.condition) (λ s, uniq s.π s.condition)

/-- Every cokernel of `f` induces a cokernel of `g ≫ f` if `g` is epi. -/
def is_cokernel_epi_comp  {c : cokernel_cofork f} (i : is_colimit c) {W} (g : W ⟶ X) [hg : epi g]
  {h : W ⟶ Y} (hh : h = g ≫ f) :
  is_colimit (cokernel_cofork.of_π c.π (by rw [hh]; simp) : cokernel_cofork h) :=
cofork.is_colimit.mk' _ $ λ s,
  let s' : cokernel_cofork f := cofork.of_π s.π
    (by { apply hg.left_cancellation, rw [←category.assoc, ←hh, s.condition], simp }) in
  let l := cokernel_cofork.is_colimit.desc' i s'.π s'.condition in
  ⟨l.1, l.2,
    λ m hm, by apply cofork.is_colimit.hom_ext i; rw cofork.π_of_π at hm; rw hm; exact l.2.symm⟩

@[simp]
lemma is_cokernel_epi_comp_desc {c : cokernel_cofork f} (i : is_colimit c) {W}
  (g : W ⟶ X) [hg : epi g] {h : W ⟶ Y} (hh : h = g ≫ f) (s : cokernel_cofork h) :
  (is_cokernel_epi_comp i g hh).desc s
  = i.desc (cofork.of_π s.π (by { rw [←cancel_epi g, ←category.assoc, ←hh], simp })) := rfl

/-- Every cokernel of `g ≫ f` is also a cokernel of `f`, as long as `f ≫ c.π` vanishes. -/
def is_cokernel_of_comp {W : C} (g : W ⟶ X) (h : W ⟶ Y) {c : cokernel_cofork h} (i : is_colimit c)
  (hf : f ≫ c.π = 0) (hfg : g ≫ f = h) : is_colimit (cokernel_cofork.of_π c.π hf) :=
cofork.is_colimit.mk _
  (λ s, i.desc (cokernel_cofork.of_π s.π (by simp [← hfg])))
  (λ s, by simp only [cokernel_cofork.π_of_π, cofork.is_colimit.π_desc])
  (λ s m h, by { apply cofork.is_colimit.hom_ext i, simpa using h })

end

section
variables [has_cokernel f]

/-- The cokernel of a morphism, expressed as the coequalizer with the 0 morphism. -/
abbreviation cokernel : C := coequalizer f 0

/-- The map from the target of `f` to `cokernel f`. -/
abbreviation cokernel.π : Y ⟶ cokernel f := coequalizer.π f 0

@[simp] lemma coequalizer_as_cokernel : coequalizer.π f 0 = cokernel.π f := rfl

@[simp, reassoc] lemma cokernel.condition : f ≫ cokernel.π f = 0 :=
cokernel_cofork.condition _

/-- The cokernel built from `cokernel.π f` is colimiting. -/
def cokernel_is_cokernel :
  is_colimit (cofork.of_π (cokernel.π f) ((cokernel.condition f).trans (zero_comp.symm))) :=
is_colimit.of_iso_colimit (colimit.is_colimit _) (cofork.ext (iso.refl _) (by tidy))

/-- Given any morphism `k : Y ⟶ W` such that `f ≫ k = 0`, `k` factors through `cokernel.π f`
    via `cokernel.desc : cokernel f ⟶ W`. -/
abbreviation cokernel.desc {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) : cokernel f ⟶ W :=
(cokernel_is_cokernel f).desc (cokernel_cofork.of_π k h)

@[simp, reassoc]
lemma cokernel.π_desc {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) :
  cokernel.π f ≫ cokernel.desc f k h = k :=
(cokernel_is_cokernel f).fac (cokernel_cofork.of_π k h) walking_parallel_pair.one

@[simp]
lemma cokernel.desc_zero {W : C} {h} : cokernel.desc f (0 : Y ⟶ W) h = 0 :=
by { ext, simp, }

instance cokernel.desc_epi
  {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) [epi k] : epi (cokernel.desc f k h) :=
⟨λ Z g g' w,
begin
  replace w := cokernel.π f ≫= w,
  simp only [cokernel.π_desc_assoc] at w,
  exact (cancel_epi k).1 w,
end⟩

/-- Any morphism `k : Y ⟶ W` satisfying `f ≫ k = 0` induces `l : cokernel f ⟶ W` such that
    `cokernel.π f ≫ l = k`. -/
def cokernel.desc' {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) :
  {l : cokernel f ⟶ W // cokernel.π f ≫ l = k} :=
⟨cokernel.desc f k h, cokernel.π_desc _ _ _⟩

/-- A commuting square induces a morphism of cokernels. -/
abbreviation cokernel.map {X' Y' : C} (f' : X' ⟶ Y') [has_cokernel f']
  (p : X ⟶ X') (q : Y ⟶ Y') (w : f ≫ q = p ≫ f') : cokernel f ⟶ cokernel f' :=
cokernel.desc f (q ≫ cokernel.π f') (by simp [reassoc_of w])

/--
Given a commutative diagram
    X --f--> Y --g--> Z
    |        |        |
    |        |        |
    v        v        v
    X' -f'-> Y' -g'-> Z'
with horizontal arrows composing to zero,
then we obtain a commutative square
   cokernel f ---> Z
   |               |
   | cokernel.map  |
   |               |
   v               v
   cokernel f' --> Z'
-/
lemma cokernel.map_desc {X Y Z X' Y' Z' : C}
  (f : X ⟶ Y) [has_cokernel f] (g : Y ⟶ Z) (w : f ≫ g = 0)
  (f' : X' ⟶ Y') [has_cokernel f'] (g' : Y' ⟶ Z') (w' : f' ≫ g' = 0)
  (p : X ⟶ X') (q : Y ⟶ Y') (r : Z ⟶ Z') (h₁ : f ≫ q = p ≫ f') (h₂ : g ≫ r = q ≫ g') :
  cokernel.map f f' p q h₁ ≫ cokernel.desc f' g' w' = cokernel.desc f g w ≫ r :=
by { ext, simp [h₂], }

/-- A commuting square of isomorphisms induces an isomorphism of cokernels. -/
@[simps]
def cokernel.map_iso {X' Y' : C} (f' : X' ⟶ Y') [has_cokernel f']
  (p : X ≅ X') (q : Y ≅ Y') (w : f ≫ q.hom = p.hom ≫ f') : cokernel f ≅ cokernel f' :=
{ hom := cokernel.map f f' p.hom q.hom w,
  inv := cokernel.map f' f p.inv q.inv (by { refine (cancel_mono q.hom).1 _, simp [w], }), }

/-- The cokernel of the zero morphism is an isomorphism -/
instance cokernel.π_zero_is_iso :
  is_iso (cokernel.π (0 : X ⟶ Y)) :=
coequalizer.π_of_self _

lemma eq_zero_of_mono_cokernel [mono (cokernel.π f)] : f = 0 :=
(cancel_mono (cokernel.π f)).1 (by simp)

/-- The cokernel of a zero morphism is isomorphic to the target. -/
def cokernel_zero_iso_target : cokernel (0 : X ⟶ Y) ≅ Y :=
coequalizer.iso_target_of_self 0

@[simp] lemma cokernel_zero_iso_target_hom :
  cokernel_zero_iso_target.hom = cokernel.desc (0 : X ⟶ Y) (𝟙 Y) (by simp) :=
by { ext, simp [cokernel_zero_iso_target], }

@[simp] lemma cokernel_zero_iso_target_inv :
  cokernel_zero_iso_target.inv = cokernel.π (0 : X ⟶ Y) := rfl

/-- If two morphisms are known to be equal, then their cokernels are isomorphic. -/
def cokernel_iso_of_eq {f g : X ⟶ Y} [has_cokernel f] [has_cokernel g] (h : f = g) :
  cokernel f ≅ cokernel g :=
has_colimit.iso_of_nat_iso (by simp[h])

@[simp]
lemma cokernel_iso_of_eq_refl {h : f = f} : cokernel_iso_of_eq h = iso.refl (cokernel f) :=
by { ext, simp [cokernel_iso_of_eq], }

@[simp, reassoc]
lemma π_comp_cokernel_iso_of_eq_hom {f g : X ⟶ Y} [has_cokernel f] [has_cokernel g] (h : f = g) :
  cokernel.π _ ≫ (cokernel_iso_of_eq h).hom = cokernel.π _ :=
by { unfreezingI { induction h, simp } }

@[simp, reassoc]

@[simp, reassoc]
lemma cokernel_iso_of_eq_hom_comp_desc {Z} {f g : X ⟶ Y} [has_cokernel f] [has_cokernel g]
  (h : f = g) (e : Y ⟶ Z) (he) :
  (cokernel_iso_of_eq h).hom ≫ cokernel.desc _ e he = cokernel.desc _ e (by simp [h, he]) :=
by { unfreezingI { induction h, simp } }

@[simp, reassoc]
lemma cokernel_iso_of_eq_inv_comp_desc {Z} {f g : X ⟶ Y} [has_cokernel f] [has_cokernel g]
  (h : f = g) (e : Y ⟶ Z) (he) :
  (cokernel_iso_of_eq h).inv ≫ cokernel.desc _ e he = cokernel.desc _ e (by simp [← h, he]) :=
by { unfreezingI { induction h, simp } }

@[simp]
lemma cokernel_iso_of_eq_trans {f g h : X ⟶ Y} [has_cokernel f] [has_cokernel g] [has_cokernel h]
  (w₁ : f = g) (w₂ : g = h) :
  cokernel_iso_of_eq w₁ ≪≫ cokernel_iso_of_eq w₂ = cokernel_iso_of_eq (w₁.trans w₂) :=
by { unfreezingI { induction w₁, induction w₂, }, ext, simp [cokernel_iso_of_eq], }

variables {f}

lemma cokernel_not_mono_of_nonzero (w : f ≠ 0) : ¬mono (cokernel.π f) :=
λ I, by exactI w (eq_zero_of_mono_cokernel f)

lemma cokernel_not_iso_of_nonzero (w : f ≠ 0) : (is_iso (cokernel.π f)) → false :=
λ I, cokernel_not_mono_of_nonzero w $ by { resetI, apply_instance }

-- TODO the remainder of this section has obvious generalizations to `has_coequalizer f g`.

instance has_cokernel_comp_iso {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_cokernel f] [is_iso g] :
  has_cokernel (f ≫ g) :=
{ exists_colimit :=
  ⟨{ cocone := cokernel_cofork.of_π (inv g ≫ cokernel.π f) (by simp),
     is_colimit := is_colimit_aux _ (λ s, cokernel.desc _ (g ≫ s.π)
       (by { rw [←category.assoc, cokernel_cofork.condition], }))
       (by tidy)
       (λ s m w, by { simp_rw [←w], ext, simp, }), }⟩ }

/--
When `g` is an isomorphism, the cokernel of `f ≫ g` is isomorphic to the cokernel of `f`.
-/
@[simps]
def cokernel_comp_is_iso {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_cokernel f] [is_iso g] :
  cokernel (f ≫ g) ≅ cokernel f :=
{ hom := cokernel.desc _ (inv g ≫ cokernel.π f) (by simp),
  inv := cokernel.desc _ (g ≫ cokernel.π (f ≫ g)) (by rw [←category.assoc, cokernel.condition]), }

instance has_cokernel_epi_comp {X Y : C} (f : X ⟶ Y) [has_cokernel f] {W} (g : W ⟶ X) [epi g] :
  has_cokernel (g ≫ f) :=
⟨⟨{ cocone := _, is_colimit := is_cokernel_epi_comp (colimit.is_colimit _) g rfl }⟩⟩

/--
When `f` is an epimorphism, the cokernel of `f ≫ g` is isomorphic to the cokernel of `g`.
-/
@[simps]
def cokernel_epi_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [epi f] [has_cokernel g] :
  cokernel (f ≫ g) ≅ cokernel g :=
{ hom := cokernel.desc _ (cokernel.π g) (by simp),
  inv := cokernel.desc _ (cokernel.π (f ≫ g)) (by { rw [←cancel_epi f, ←category.assoc], simp, }), }

end

section has_zero_object
variables [has_zero_object C]

open_locale zero_object

/-- The morphism to the zero object determines a cocone on a cokernel diagram -/
def cokernel.zero_cokernel_cofork : cokernel_cofork f :=
{ X := 0,
  ι := { app := λ j, 0 } }

/-- The morphism to the zero object is a cokernel of an epimorphism -/
def cokernel.is_colimit_cocone_zero_cocone [epi f] :
  is_colimit (cokernel.zero_cokernel_cofork f) :=
cofork.is_colimit.mk _ (λ s, 0)
  (λ s, by { erw zero_comp,
    convert (zero_of_epi_comp f _).symm,
    exact cokernel_cofork.condition _ })
  (λ _ _ _, zero_of_from_zero _)

/-- The cokernel of an epimorphism is isomorphic to the zero object -/
def cokernel.of_epi [has_cokernel f] [epi f] : cokernel f ≅ 0 :=
functor.map_iso (cocones.forget _) $ is_colimit.unique_up_to_iso
  (colimit.is_colimit (parallel_pair f 0)) (cokernel.is_colimit_cocone_zero_cocone f)

/-- The cokernel morphism of an epimorphism is a zero morphism -/
lemma cokernel.π_of_epi [has_cokernel f] [epi f] : cokernel.π f = 0 :=
zero_of_target_iso_zero _ (cokernel.of_epi f)

end has_zero_object

section mono_factorisation
variables {f}

@[simp] lemma mono_factorisation.kernel_ι_comp [has_kernel f] (F : mono_factorisation f) :
  kernel.ι f ≫ F.e = 0 :=
by rw [← cancel_mono F.m, zero_comp, category.assoc, F.fac, kernel.condition]

end mono_factorisation

section has_image

/--
The cokernel of the image inclusion of a morphism `f` is isomorphic to the cokernel of `f`.

(This result requires that the factorisation through the image is an epimorphism.
This holds in any category with equalizers.)
-/
@[simps]
def cokernel_image_ι {X Y : C} (f : X ⟶ Y)
  [has_image f] [has_cokernel (image.ι f)] [has_cokernel f] [epi (factor_thru_image f)] :
  cokernel (image.ι f) ≅ cokernel f :=
{ hom := cokernel.desc _ (cokernel.π f)
  begin
    have w := cokernel.condition f,
    conv at w { to_lhs, congr, rw ←image.fac f, },
    rw [←has_zero_morphisms.comp_zero (limits.factor_thru_image f), category.assoc, cancel_epi]
      at w,
    exact w,
  end,
  inv := cokernel.desc _ (cokernel.π _)
  begin
    conv { to_lhs, congr, rw ←image.fac f, },
    rw [category.assoc, cokernel.condition, has_zero_morphisms.comp_zero],
  end, }

end has_image

section
variables (X Y)

/-- The cokernel of a zero morphism is an isomorphism -/
lemma cokernel.π_of_zero :
  is_iso (cokernel.π (0 : X ⟶ Y)) :=
coequalizer.π_of_self _

end

section has_zero_object
variables [has_zero_object C]

open_locale zero_object

/-- The kernel of the cokernel of an epimorphism is an isomorphism -/
instance kernel.of_cokernel_of_epi [has_cokernel f]
  [has_kernel (cokernel.π f)] [epi f] : is_iso (kernel.ι (cokernel.π f)) :=
equalizer.ι_of_eq $ cokernel.π_of_epi f

/-- The cokernel of the kernel of a monomorphism is an isomorphism -/
instance cokernel.of_kernel_of_mono [has_kernel f]
  [has_cokernel (kernel.ι f)] [mono f] : is_iso (cokernel.π (kernel.ι f)) :=
coequalizer.π_of_eq $ kernel.ι_of_mono f

/-- If `f ≫ g = 0` implies `g = 0` for all `g`, then `0 : Y ⟶ 0` is a cokernel of `f`. -/
def zero_cokernel_of_zero_cancel {X Y : C} (f : X ⟶ Y)
  (hf : ∀ (Z : C) (g : Y ⟶ Z) (hgf : f ≫ g = 0), g = 0) :
    is_colimit (cokernel_cofork.of_π (0 : Y ⟶ 0) (show f ≫ 0 = 0, by simp)) :=
cofork.is_colimit.mk _ (λ s, 0)
  (λ s, by rw [hf _ _ (cokernel_cofork.condition s), comp_zero])
  (λ s m h, by ext)

end has_zero_object

section transport

/-- If `i` is an isomorphism such that `i.hom ≫ l = f`, then any cokernel of `f` is a cokernel of
    `l`. -/
def is_cokernel.of_iso_comp {Z : C} (l : Z ⟶ Y) (i : X ≅ Z) (h : i.hom ≫ l = f)
  {s : cokernel_cofork f} (hs : is_colimit s) : is_colimit (cokernel_cofork.of_π (cofork.π s) $
    show l ≫ cofork.π s = 0, by simp [i.eq_inv_comp.2 h]) :=
cofork.is_colimit.mk _
  (λ s, hs.desc $ cokernel_cofork.of_π (cofork.π s) $ by simp [←h])
  (λ s, by simp)
  (λ s m h, by { apply cofork.is_colimit.hom_ext hs, simpa using h })

/-- If `i` is an isomorphism such that `i.hom ≫ l = f`, then the cokernel of `f` is a cokernel of
    `l`. -/
def cokernel.of_iso_comp [has_cokernel f]
  {Z : C} (l : Z ⟶ Y) (i : X ≅ Z) (h : i.hom ≫ l = f) :
  is_colimit (cokernel_cofork.of_π (cokernel.π f) $
    show l ≫ cokernel.π f = 0, by simp [i.eq_inv_comp.2 h]) :=
is_cokernel.of_iso_comp f l i h $ colimit.is_colimit _

/-- If `s` is any colimit cokernel cocone over `f` and `i` is an isomorphism such that
    `s.π ≫ i.hom = l`, then `l` is a cokernel of `f`. -/
def is_cokernel.cokernel_iso {Z : C} (l : Y ⟶ Z) {s : cokernel_cofork f} (hs : is_colimit s)
  (i : s.X ≅ Z) (h : cofork.π s ≫ i.hom = l) : is_colimit (cokernel_cofork.of_π l $
    show f ≫ l = 0, by simp [←h]) :=
is_colimit.of_iso_colimit hs $ cocones.ext i $ λ j, by { cases j, { simp }, { exact h } }

/-- If `i` is an isomorphism such that `cokernel.π f ≫ i.hom = l`, then `l` is a cokernel of `f`. -/
def cokernel.cokernel_iso [has_cokernel f]
  {Z : C} (l : Y ⟶ Z) (i : cokernel f ≅ Z) (h : cokernel.π f ≫ i.hom = l) :
  is_colimit (cokernel_cofork.of_π l $ by simp [←h]) :=
is_cokernel.cokernel_iso f l (colimit.is_colimit _) i h

end transport

section comparison

variables {D : Type u₂} [category.{v₂} D] [has_zero_morphisms D]
variables (G : C ⥤ D) [functor.preserves_zero_morphisms G]

/--
The comparison morphism for the kernel of `f`.
This is an isomorphism iff `G` preserves the kernel of `f`; see
`category_theory/limits/preserves/shapes/kernels.lean`
-/
def kernel_comparison [has_kernel f] [has_kernel (G.map f)] :
  G.obj (kernel f) ⟶ kernel (G.map f) :=
kernel.lift _ (G.map (kernel.ι f)) (by simp only [←G.map_comp, kernel.condition, functor.map_zero])

@[simp, reassoc]
lemma kernel_comparison_comp_ι [has_kernel f] [has_kernel (G.map f)] :
  kernel_comparison f G ≫ kernel.ι (G.map f) = G.map (kernel.ι f) :=
kernel.lift_ι _ _ _

@[simp, reassoc]
lemma map_lift_kernel_comparison [has_kernel f] [has_kernel (G.map f)]
  {Z : C} {h : Z ⟶ X} (w : h ≫ f = 0) :
    G.map (kernel.lift _ h w) ≫ kernel_comparison f G =
      kernel.lift _ (G.map h) (by simp only [←G.map_comp, w, functor.map_zero]) :=
by { ext, simp [← G.map_comp] }

@[reassoc] lemma kernel_comparison_comp_kernel_map {X' Y' : C} [has_kernel f]
  [has_kernel (G.map f)] (g : X' ⟶ Y') [has_kernel g] [has_kernel (G.map g)] (p : X ⟶ X')
  (q : Y ⟶ Y') (hpq : f ≫ q = p ≫ g) :
  kernel_comparison f G ≫ (kernel.map (G.map f) (G.map g) (G.map p) (G.map q)
    (by rw [←G.map_comp, hpq, G.map_comp])) =
  G.map (kernel.map f g p q hpq) ≫ kernel_comparison g G :=
kernel.lift_map _ _ (by rw [←G.map_comp, kernel.condition, G.map_zero]) _ _
  (by rw [←G.map_comp, kernel.condition, G.map_zero]) _ _ _
  (by simp only [←G.map_comp]; exact G.congr_map (kernel.lift_ι _ _ _).symm) _

/-- The comparison morphism for the cokernel of `f`. -/
def cokernel_comparison [has_cokernel f] [has_cokernel (G.map f)] :
  cokernel (G.map f) ⟶ G.obj (cokernel f) :=
cokernel.desc _ (G.map (coequalizer.π _ _))
  (by simp only [←G.map_comp, cokernel.condition, functor.map_zero])

@[simp, reassoc]
lemma π_comp_cokernel_comparison [has_cokernel f] [has_cokernel (G.map f)] :
  cokernel.π (G.map f) ≫ cokernel_comparison f G = G.map (cokernel.π _) :=
cokernel.π_desc _ _ _

@[simp, reassoc]
lemma cokernel_comparison_map_desc [has_cokernel f] [has_cokernel (G.map f)]
  {Z : C} {h : Y ⟶ Z} (w : f ≫ h = 0) :
  cokernel_comparison f G ≫ G.map (cokernel.desc _ h w) =
    cokernel.desc _ (G.map h) (by simp only [←G.map_comp, w, functor.map_zero]) :=
by { ext, simp [← G.map_comp] }

@[reassoc] lemma cokernel_map_comp_cokernel_comparison {X' Y' : C} [has_cokernel f]
  [has_cokernel (G.map f)] (g : X' ⟶ Y') [has_cokernel g] [has_cokernel (G.map g)]
  (p : X ⟶ X') (q : Y ⟶ Y') (hpq : f ≫ q = p ≫ g) :
  cokernel.map (G.map f) (G.map g) (G.map p) (G.map q) (by rw [←G.map_comp, hpq, G.map_comp])
    ≫ cokernel_comparison _ G = cokernel_comparison _ G ≫ G.map (cokernel.map f g p q hpq) :=
cokernel.map_desc _ _ (by rw [←G.map_comp, cokernel.condition, G.map_zero]) _ _
  (by rw [←G.map_comp, cokernel.condition, G.map_zero]) _ _ _ _
  (by simp only [←G.map_comp]; exact G.congr_map (cokernel.π_desc _ _ _))

end comparison

end category_theory.limits

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

variables [has_zero_morphisms C]

/-- `has_kernels` represents the existence of kernels for every morphism. -/
class has_kernels : Prop :=
(has_limit : Π {X Y : C} (f : X ⟶ Y), has_kernel f . tactic.apply_instance)

/-- `has_cokernels` represents the existence of cokernels for every morphism. -/
class has_cokernels : Prop :=
(has_colimit : Π {X Y : C} (f : X ⟶ Y), has_cokernel f . tactic.apply_instance)

attribute [instance, priority 100] has_kernels.has_limit has_cokernels.has_colimit

@[priority 100]
instance has_kernels_of_has_equalizers [has_equalizers C] : has_kernels C :=
{}

@[priority 100]
instance has_cokernels_of_has_coequalizers [has_coequalizers C] : has_cokernels C :=
{}

end category_theory.limits


/-
Copyright (c) 2022 Violeta Hernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Violeta Hernández
-/
import data.finsupp.basic
import data.list.alist

/-!
# Connections between `finsupp` and `alist`

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

## Main definitions

* `finsupp.to_alist`
* `alist.lookup_finsupp`: converts an association list into a finitely supported function
  via `alist.lookup`, sending absent keys to zero.

-/

namespace finsupp
variables {α M : Type*} [has_zero M]

/-- Produce an association list for the finsupp over its support using choice. -/
@[simps] noncomputable def to_alist (f : α →₀ M) : alist (λ x : α, M) :=
⟨f.graph.to_list.map prod.to_sigma, begin
  rw [list.nodupkeys, list.keys, list.map_map, prod.fst_comp_to_sigma, list.nodup_map_iff_inj_on],
  { rintros ⟨b, m⟩ hb ⟨c, n⟩ hc (rfl : b = c),
    rw [finset.mem_to_list, finsupp.mem_graph_iff] at hb hc,
    dsimp at hb hc,
    rw [←hc.1, hb.1] },
  { apply finset.nodup_to_list }
end⟩

@[simp] lemma to_alist_keys_to_finset [decidable_eq α] (f : α →₀ M) :
  f.to_alist.keys.to_finset = f.support :=
by { ext, simp [to_alist, alist.mem_keys, alist.keys, list.keys] }

@[simp] lemma mem_to_alist {f : α →₀ M} {x : α} : x ∈ f.to_alist ↔ f x ≠ 0 :=
begin
  classical,
  rw [alist.mem_keys, ←list.mem_to_finset, to_alist_keys_to_finset, mem_support_iff]
end

end finsupp

namespace alist
variables {α M : Type*} [has_zero M]
open list

/-- Converts an association list into a finitely supported function via `alist.lookup`, sending
absent keys to zero. -/
noncomputable def lookup_finsupp (l : alist (λ x : α, M)) : α →₀ M :=
{ support := by haveI := classical.dec_eq α; haveI := classical.dec_eq M; exact
    (l.1.filter $ λ x, sigma.snd x ≠ 0).keys.to_finset,
  to_fun := λ a, by haveI := classical.dec_eq α; exact (l.lookup a).get_or_else 0,
  mem_support_to_fun := λ a, begin
    classical,
    simp_rw [mem_to_finset, list.mem_keys, list.mem_filter, ←mem_lookup_iff],
    cases lookup a l;
    simp
  end }

@[simp] lemma lookup_finsupp_apply [decidable_eq α] (l : alist (λ x : α, M)) (a : α) :
  l.lookup_finsupp a = (l.lookup a).get_or_else 0 :=
by convert rfl

@[simp] lemma lookup_finsupp_support [decidable_eq α] [decidable_eq M] (l : alist (λ x : α, M)) :
  l.lookup_finsupp.support = (l.1.filter $ λ x, sigma.snd x ≠ 0).keys.to_finset :=
by convert rfl

lemma lookup_finsupp_eq_iff_of_ne_zero [decidable_eq α]
  {l : alist (λ x : α, M)} {a : α} {x : M} (hx : x ≠ 0) :
  l.lookup_finsupp a = x ↔ x ∈ l.lookup a :=
by { rw lookup_finsupp_apply, cases lookup a l with m; simp [hx.symm] }

lemma lookup_finsupp_eq_zero_iff [decidable_eq α] {l : alist (λ x : α, M)} {a : α} :
  l.lookup_finsupp a = 0 ↔ a ∉ l ∨ (0 : M) ∈ l.lookup a :=
by { rw [lookup_finsupp_apply, ←lookup_eq_none], cases lookup a l with m; simp }

@[simp] lemma empty_lookup_finsupp : lookup_finsupp (∅ : alist (λ x : α, M)) = 0 :=
by { classical, ext, simp }

@[simp] lemma insert_lookup_finsupp [decidable_eq α] (l : alist (λ x : α, M)) (a : α) (m : M) :
  (l.insert a m).lookup_finsupp = l.lookup_finsupp.update a m :=
by { ext b, by_cases h : b = a; simp [h] }

@[simp] lemma singleton_lookup_finsupp (a : α) (m : M) :
  (singleton a m).lookup_finsupp = finsupp.single a m :=
by { classical, simp [←alist.insert_empty] }

@[simp] lemma _root_.finsupp.to_alist_lookup_finsupp (f : α →₀ M) : f.to_alist.lookup_finsupp = f :=
begin
  ext,
  classical,
  by_cases h : f a = 0,
  { suffices : f.to_alist.lookup a = none,
    { simp [h, this] },
    { simp [lookup_eq_none, h] } },
  { suffices : f.to_alist.lookup a = some (f a),
    { simp [h, this] },
    { apply mem_lookup_iff.2,
      simpa using h } }
end

lemma lookup_finsupp_surjective : function.surjective (@lookup_finsupp α M _) :=
λ f, ⟨_, finsupp.to_alist_lookup_finsupp f⟩

end alist


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Yury Kudryashov, Yaël Dillies

! This file was ported from Lean 3 source module order.max
! leanprover-community/mathlib commit 6623e6af705e97002a9054c1c05a980180276fc1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Synonym
import Mathlib.Tactic.Classical

/-!
# Minimal/maximal and bottom/top elements

This file defines predicates for elements to be minimal/maximal or bottom/top and typeclasses
saying that there are no such elements.

## Predicates

* `IsBot`: An element is *bottom* if all elements are greater than it.
* `IsTop`: An element is *top* if all elements are less than it.
* `IsMin`: An element is *minimal* if no element is strictly less than it.
* `IsMax`: An element is *maximal* if no element is strictly greater than it.

See also `isBot_iff_isMin` and `isTop_iff_isMax` for the equivalences in a (co)directed order.

## Typeclasses

* `NoBotOrder`: An order without bottom elements.
* `NoTopOrder`: An order without top elements.
* `NoMinOrder`: An order without minimal elements.
* `NoMaxOrder`: An order without maximal elements.
-/

open OrderDual

universe u v

variable {α β : Type _}

/-- Order without bottom elements. -/
class NoBotOrder (α : Type _) [LE α] : Prop where
  /-- For each term `a`, there is some `b` which is either incomparable or strictly smaller. -/
  exists_not_ge (a : α) : ∃ b, ¬a ≤ b
#align no_bot_order NoBotOrder

/-- Order without top elements. -/
class NoTopOrder (α : Type _) [LE α] : Prop where
  /-- For each term `a`, there is some `b` which is either incomparable or strictly larger. -/
  exists_not_le (a : α) : ∃ b, ¬b ≤ a
#align no_top_order NoTopOrder

/-- Order without minimal elements. Sometimes called coinitial or dense. -/
class NoMinOrder (α : Type _) [LT α] : Prop where
  /-- For each term `a`, there is some strictly smaller `b`. -/
  exists_lt (a : α) : ∃ b, b < a
#align no_min_order NoMinOrder

/-- Order without maximal elements. Sometimes called cofinal. -/
class NoMaxOrder (α : Type _) [LT α] : Prop where
  /-- For each term `a`, there is some strictly greater `b`. -/
  exists_gt (a : α) : ∃ b, a < b
#align no_max_order NoMaxOrder

export NoBotOrder (exists_not_ge)

export NoTopOrder (exists_not_le)

export NoMinOrder (exists_lt)

export NoMaxOrder (exists_gt)

instance nonempty_lt [LT α] [NoMinOrder α] (a : α) : Nonempty { x // x < a } :=
  nonempty_subtype.2 (exists_lt a)

instance nonempty_gt [LT α] [NoMaxOrder α] (a : α) : Nonempty { x // a < x } :=
  nonempty_subtype.2 (exists_gt a)

instance OrderDual.noBotOrder [LE α] [NoTopOrder α] : NoBotOrder αᵒᵈ :=
  ⟨fun a => @exists_not_le α _ _ a⟩
#align order_dual.no_bot_order OrderDual.noBotOrder

instance OrderDual.noTopOrder [LE α] [NoBotOrder α] : NoTopOrder αᵒᵈ :=
  ⟨fun a => @exists_not_ge α _ _ a⟩
#align order_dual.no_top_order OrderDual.noTopOrder

instance OrderDual.noMinOrder [LT α] [NoMaxOrder α] : NoMinOrder αᵒᵈ :=
  ⟨fun a => @exists_gt α _ _ a⟩
#align order_dual.no_min_order OrderDual.noMinOrder

instance OrderDual.noMaxOrder [LT α] [NoMinOrder α] : NoMaxOrder αᵒᵈ :=
  ⟨fun a => @exists_lt α _ _ a⟩
#align order_dual.no_max_order OrderDual.noMaxOrder

-- See note [lower instance priority]
instance (priority := 100) [Preorder α] [NoMinOrder α] : NoBotOrder α :=
  ⟨fun a => (exists_lt a).imp fun _ => not_le_of_lt⟩

-- See note [lower instance priority]
instance (priority := 100) [Preorder α] [NoMaxOrder α] : NoTopOrder α :=
  ⟨fun a => (exists_gt a).imp fun _ => not_le_of_lt⟩

instance noMaxOrder_of_left [Preorder α] [Preorder β] [NoMaxOrder α] : NoMaxOrder (α × β) :=
  ⟨fun ⟨a, b⟩ => by
    obtain ⟨c, h⟩ := exists_gt a
    exact ⟨(c, b), Prod.mk_lt_mk_iff_left.2 h⟩⟩
#align no_max_order_of_left noMaxOrder_of_left

instance noMaxOrder_of_right [Preorder α] [Preorder β] [NoMaxOrder β] : NoMaxOrder (α × β) :=
  ⟨fun ⟨a, b⟩ => by
    obtain ⟨c, h⟩ := exists_gt b
    exact ⟨(a, c), Prod.mk_lt_mk_iff_right.2 h⟩⟩
#align no_max_order_of_right noMaxOrder_of_right

instance noMinOrder_of_left [Preorder α] [Preorder β] [NoMinOrder α] : NoMinOrder (α × β) :=
  ⟨fun ⟨a, b⟩ => by
    obtain ⟨c, h⟩ := exists_lt a
    exact ⟨(c, b), Prod.mk_lt_mk_iff_left.2 h⟩⟩
#align no_min_order_of_left noMinOrder_of_left

instance noMinOrder_of_right [Preorder α] [Preorder β] [NoMinOrder β] : NoMinOrder (α × β) :=
  ⟨fun ⟨a, b⟩ => by
    obtain ⟨c, h⟩ := exists_lt b
    exact ⟨(a, c), Prod.mk_lt_mk_iff_right.2 h⟩⟩
#align no_min_order_of_right noMinOrder_of_right

instance {ι : Type u} {π : ι → Type _} [Nonempty ι] [∀ i, Preorder (π i)] [∀ i, NoMaxOrder (π i)] :
    NoMaxOrder (∀ i, π i) :=
  ⟨fun a => by
    classical
    obtain ⟨b, hb⟩ := exists_gt (a <| Classical.arbitrary _)
    exact ⟨_, lt_update_self_iff.2 hb⟩⟩

instance {ι : Type u} {π : ι → Type _} [Nonempty ι] [∀ i, Preorder (π i)] [∀ i, NoMinOrder (π i)] :
    NoMinOrder (∀ i, π i) :=
  ⟨fun a => by
     classical
      obtain ⟨b, hb⟩ := exists_lt (a <| Classical.arbitrary _)
      exact ⟨_, update_lt_self_iff.2 hb⟩⟩

-- Porting note: mathlib3 proof uses `convert`
theorem NoBotOrder.to_noMinOrder (α : Type _) [LinearOrder α] [NoBotOrder α] : NoMinOrder α :=
  { exists_lt := fun a => by simpa [not_le] using exists_not_ge a }
#align no_bot_order.to_no_min_order NoBotOrder.to_noMinOrder

-- Porting note: mathlib3 proof uses `convert`
theorem NoTopOrder.to_noMaxOrder (α : Type _) [LinearOrder α] [NoTopOrder α] : NoMaxOrder α :=
  { exists_gt := fun a => by simpa [not_le] using exists_not_le a }
#align no_top_order.to_no_max_order NoTopOrder.to_noMaxOrder

theorem noBotOrder_iff_noMinOrder (α : Type _) [LinearOrder α] : NoBotOrder α ↔ NoMinOrder α :=
  ⟨fun h =>
    haveI := h
    NoBotOrder.to_noMinOrder α,
    fun h =>
    haveI := h
    inferInstance⟩
#align no_bot_order_iff_no_min_order noBotOrder_iff_noMinOrder

theorem noTopOrder_iff_noMaxOrder (α : Type _) [LinearOrder α] : NoTopOrder α ↔ NoMaxOrder α :=
  ⟨fun h =>
    haveI := h
    NoTopOrder.to_noMaxOrder α,
    fun h =>
    haveI := h
    inferInstance⟩
#align no_top_order_iff_no_max_order noTopOrder_iff_noMaxOrder

theorem NoMinOrder.not_acc [LT α] [NoMinOrder α] (a : α) : ¬Acc (· < ·) a := fun h =>
  Acc.recOn h fun x _ => (exists_lt x).recOn
#align no_min_order.not_acc NoMinOrder.not_acc

theorem NoMaxOrder.not_acc [LT α] [NoMaxOrder α] (a : α) : ¬Acc (· > ·) a := fun h =>
  Acc.recOn h fun x _ => (exists_gt x).recOn
#align no_max_order.not_acc NoMaxOrder.not_acc

section LE

variable [LE α] {a b : α}

/-- `a : α` is a bottom element of `α` if it is less than or equal to any other element of `α`.
This predicate is roughly an unbundled version of `OrderBot`, except that a preorder may have
several bottom elements. When `α` is linear, this is useful to make a case disjunction on
`NoMinOrder α` within a proof. -/
def IsBot (a : α) : Prop :=
  ∀ b, a ≤ b
#align is_bot IsBot

/-- `a : α` is a top element of `α` if it is greater than or equal to any other element of `α`.
This predicate is roughly an unbundled version of `OrderBot`, except that a preorder may have
several top elements. When `α` is linear, this is useful to make a case disjunction on
`NoMaxOrder α` within a proof. -/
def IsTop (a : α) : Prop :=
  ∀ b, b ≤ a
#align is_top IsTop

/-- `a` is a minimal element of `α` if no element is strictly less than it. We spell it without `<`
to avoid having to convert between `≤` and `<`. Instead, `isMin_iff_forall_not_lt` does the
conversion. -/
def IsMin (a : α) : Prop :=
  ∀ ⦃b⦄, b ≤ a → a ≤ b
#align is_min IsMin

/-- `a` is a maximal element of `α` if no element is strictly greater than it. We spell it without
`<` to avoid having to convert between `≤` and `<`. Instead, `isMax_iff_forall_not_lt` does the
conversion. -/
def IsMax (a : α) : Prop :=
  ∀ ⦃b⦄, a ≤ b → b ≤ a
#align is_max IsMax

@[simp]
theorem not_isBot [NoBotOrder α] (a : α) : ¬IsBot a := fun h =>
  let ⟨_, hb⟩ := exists_not_ge a
  hb <| h _
#align not_is_bot not_isBot

@[simp]
theorem not_isTop [NoTopOrder α] (a : α) : ¬IsTop a := fun h =>
  let ⟨_, hb⟩ := exists_not_le a
  hb <| h _
#align not_is_top not_isTop

protected theorem IsBot.isMin (h : IsBot a) : IsMin a := fun b _ => h b
#align is_bot.is_min IsBot.isMin

protected theorem IsTop.isMax (h : IsTop a) : IsMax a := fun b _ => h b
#align is_top.is_max IsTop.isMax

@[simp]
theorem isBot_toDual_iff : IsBot (toDual a) ↔ IsTop a :=
  Iff.rfl
#align is_bot_to_dual_iff isBot_toDual_iff

@[simp]
theorem isTop_toDual_iff : IsTop (toDual a) ↔ IsBot a :=
  Iff.rfl
#align is_top_to_dual_iff isTop_toDual_iff

@[simp]
theorem isMin_toDual_iff : IsMin (toDual a) ↔ IsMax a :=
  Iff.rfl
#align is_min_to_dual_iff isMin_toDual_iff

@[simp]
theorem isMax_toDual_iff : IsMax (toDual a) ↔ IsMin a :=
  Iff.rfl
#align is_max_to_dual_iff isMax_toDual_iff

@[simp]
theorem isBot_ofDual_iff {a : αᵒᵈ} : IsBot (ofDual a) ↔ IsTop a :=
  Iff.rfl
#align is_bot_of_dual_iff isBot_ofDual_iff

@[simp]
theorem isTop_ofDual_iff {a : αᵒᵈ} : IsTop (ofDual a) ↔ IsBot a :=
  Iff.rfl
#align is_top_of_dual_iff isTop_ofDual_iff

@[simp]
theorem isMin_ofDual_iff {a : αᵒᵈ} : IsMin (ofDual a) ↔ IsMax a :=
  Iff.rfl
#align is_min_of_dual_iff isMin_ofDual_iff

@[simp]
theorem isMax_ofDual_iff {a : αᵒᵈ} : IsMax (ofDual a) ↔ IsMin a :=
  Iff.rfl
#align is_max_of_dual_iff isMax_ofDual_iff

alias isBot_toDual_iff ↔ _ IsTop.toDual
#align is_top.to_dual IsTop.toDual

alias isTop_toDual_iff ↔ _ IsBot.toDual
#align is_bot.to_dual IsBot.toDual

alias isMin_toDual_iff ↔ _ IsMax.toDual
#align is_max.to_dual IsMax.toDual

alias isMax_toDual_iff ↔ _ IsMin.toDual
#align is_min.to_dual IsMin.toDual

alias isBot_ofDual_iff ↔ _ IsTop.ofDual
#align is_top.of_dual IsTop.ofDual

alias isTop_ofDual_iff ↔ _ IsBot.ofDual
#align is_bot.of_dual IsBot.ofDual

alias isMin_ofDual_iff ↔ _ IsMax.ofDual
#align is_max.of_dual IsMax.ofDual

alias isMax_ofDual_iff ↔ _ IsMin.ofDual
#align is_min.of_dual IsMin.ofDual

end LE

section Preorder

variable [Preorder α] {a b : α}

theorem IsBot.mono (ha : IsBot a) (h : b ≤ a) : IsBot b := fun _ => h.trans <| ha _
#align is_bot.mono IsBot.mono

theorem IsTop.mono (ha : IsTop a) (h : a ≤ b) : IsTop b := fun _ => (ha _).trans h
#align is_top.mono IsTop.mono

theorem IsMin.mono (ha : IsMin a) (h : b ≤ a) : IsMin b := fun _ hc => h.trans <| ha <| hc.trans h
#align is_min.mono IsMin.mono

theorem IsMax.mono (ha : IsMax a) (h : a ≤ b) : IsMax b := fun _ hc => (ha <| h.trans hc).trans h
#align is_max.mono IsMax.mono

theorem IsMin.not_lt (h : IsMin a) : ¬b < a := fun hb => hb.not_le <| h hb.le
#align is_min.not_lt IsMin.not_lt

theorem IsMax.not_lt (h : IsMax a) : ¬a < b := fun hb => hb.not_le <| h hb.le
#align is_max.not_lt IsMax.not_lt

@[simp]
theorem not_isMin_of_lt (h : b < a) : ¬IsMin a := fun ha => ha.not_lt h
#align not_is_min_of_lt not_isMin_of_lt

@[simp]
theorem not_isMax_of_lt (h : a < b) : ¬IsMax a := fun ha => ha.not_lt h
#align not_is_max_of_lt not_isMax_of_lt

alias not_isMin_of_lt ← LT.lt.not_isMin

alias not_isMax_of_lt ← LT.lt.not_isMax

theorem isMin_iff_forall_not_lt : IsMin a ↔ ∀ b, ¬b < a :=
  ⟨fun h _ => h.not_lt, fun h _ hba => of_not_not fun hab => h _ <| hba.lt_of_not_le hab⟩
#align is_min_iff_forall_not_lt isMin_iff_forall_not_lt

theorem isMax_iff_forall_not_lt : IsMax a ↔ ∀ b, ¬a < b :=
  ⟨fun h _ => h.not_lt, fun h _ hba => of_not_not fun hab => h _ <| hba.lt_of_not_le hab⟩
#align is_max_iff_forall_not_lt isMax_iff_forall_not_lt

@[simp]
theorem not_isMin_iff : ¬IsMin a ↔ ∃ b, b < a := by
  simp [lt_iff_le_not_le, IsMin, not_forall, exists_prop]
#align not_is_min_iff not_isMin_iff

@[simp]
theorem not_isMax_iff : ¬IsMax a ↔ ∃ b, a < b := by
  simp [lt_iff_le_not_le, IsMax, not_forall, exists_prop]
#align not_is_max_iff not_isMax_iff

@[simp]
theorem not_isMin [NoMinOrder α] (a : α) : ¬IsMin a :=
  not_isMin_iff.2 <| exists_lt a
#align not_is_min not_isMin

@[simp]
theorem not_isMax [NoMaxOrder α] (a : α) : ¬IsMax a :=
  not_isMax_iff.2 <| exists_gt a
#align not_is_max not_isMax

namespace Subsingleton

variable [Subsingleton α]

protected theorem isBot (a : α) : IsBot a := fun _ => (Subsingleton.elim _ _).le
#align subsingleton.is_bot Subsingleton.isBot

protected theorem isTop (a : α) : IsTop a := fun _ => (Subsingleton.elim _ _).le
#align subsingleton.is_top Subsingleton.isTop

protected theorem isMin (a : α) : IsMin a :=
  (Subsingleton.isBot _).isMin
#align subsingleton.is_min Subsingleton.isMin

protected theorem isMax (a : α) : IsMax a :=
  (Subsingleton.isTop _).isMax
#align subsingleton.is_max Subsingleton.isMax

end Subsingleton

end Preorder

section PartialOrder

variable [PartialOrder α] {a b : α}

protected theorem IsMin.eq_of_le (ha : IsMin a) (h : b ≤ a) : b = a :=
  h.antisymm <| ha h
#align is_min.eq_of_le IsMin.eq_of_le

protected theorem IsMin.eq_of_ge (ha : IsMin a) (h : b ≤ a) : a = b :=
  h.antisymm' <| ha h
#align is_min.eq_of_ge IsMin.eq_of_ge

protected theorem IsMax.eq_of_le (ha : IsMax a) (h : a ≤ b) : a = b :=
  h.antisymm <| ha h
#align is_max.eq_of_le IsMax.eq_of_le

protected theorem IsMax.eq_of_ge (ha : IsMax a) (h : a ≤ b) : b = a :=
  h.antisymm' <| ha h
#align is_max.eq_of_ge IsMax.eq_of_ge

end PartialOrder

section Prod

variable [Preorder α] [Preorder β] {a a₁ a₂ : α} {b b₁ b₂ : β} {x y : α × β}

theorem IsBot.prod_mk (ha : IsBot a) (hb : IsBot b) : IsBot (a, b) := fun _ => ⟨ha _, hb _⟩
#align is_bot.prod_mk IsBot.prod_mk

theorem IsTop.prod_mk (ha : IsTop a) (hb : IsTop b) : IsTop (a, b) := fun _ => ⟨ha _, hb _⟩
#align is_top.prod_mk IsTop.prod_mk

theorem IsMin.prod_mk (ha : IsMin a) (hb : IsMin b) : IsMin (a, b) := fun _ hc => ⟨ha hc.1, hb hc.2⟩
#align is_min.prod_mk IsMin.prod_mk

theorem IsMax.prod_mk (ha : IsMax a) (hb : IsMax b) : IsMax (a, b) := fun _ hc => ⟨ha hc.1, hb hc.2⟩
#align is_max.prod_mk IsMax.prod_mk

theorem IsBot.fst (hx : IsBot x) : IsBot x.1 := fun c => (hx (c, x.2)).1
#align is_bot.fst IsBot.fst

theorem IsBot.snd (hx : IsBot x) : IsBot x.2 := fun c => (hx (x.1, c)).2
#align is_bot.snd IsBot.snd

theorem IsTop.fst (hx : IsTop x) : IsTop x.1 := fun c => (hx (c, x.2)).1
#align is_top.fst IsTop.fst

theorem IsTop.snd (hx : IsTop x) : IsTop x.2 := fun c => (hx (x.1, c)).2
#align is_top.snd IsTop.snd

theorem IsMin.fst (hx : IsMin x) : IsMin x.1 :=
  fun c hc => (hx <| show (c, x.2) ≤ x from (and_iff_left le_rfl).2 hc).1
#align is_min.fst IsMin.fst

theorem IsMin.snd (hx : IsMin x) : IsMin x.2 :=
  fun c hc => (hx <| show (x.1, c) ≤ x from (and_iff_right le_rfl).2 hc).2
#align is_min.snd IsMin.snd

theorem IsMax.fst (hx : IsMax x) : IsMax x.1 :=
  fun c hc => (hx <| show x ≤ (c, x.2) from (and_iff_left le_rfl).2 hc).1
#align is_max.fst IsMax.fst

theorem IsMax.snd (hx : IsMax x) : IsMax x.2 :=
  fun c hc => (hx <| show x ≤ (x.1, c) from (and_iff_right le_rfl).2 hc).2
#align is_max.snd IsMax.snd

theorem Prod.isBot_iff : IsBot x ↔ IsBot x.1 ∧ IsBot x.2 :=
  ⟨fun hx => ⟨hx.fst, hx.snd⟩, fun h => h.1.prod_mk h.2⟩
#align prod.is_bot_iff Prod.isBot_iff

theorem Prod.isTop_iff : IsTop x ↔ IsTop x.1 ∧ IsTop x.2 :=
  ⟨fun hx => ⟨hx.fst, hx.snd⟩, fun h => h.1.prod_mk h.2⟩
#align prod.is_top_iff Prod.isTop_iff

theorem Prod.isMin_iff : IsMin x ↔ IsMin x.1 ∧ IsMin x.2 :=
  ⟨fun hx => ⟨hx.fst, hx.snd⟩, fun h => h.1.prod_mk h.2⟩
#align prod.is_min_iff Prod.isMin_iff

theorem Prod.isMax_iff : IsMax x ↔ IsMax x.1 ∧ IsMax x.2 :=
  ⟨fun hx => ⟨hx.fst, hx.snd⟩, fun h => h.1.prod_mk h.2⟩
#align prod.is_max_iff Prod.isMax_iff

end Prod


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Yaël Dillies, Bhavik Mehta
-/
import data.finset.lattice
import data.set.sigma

/-!
# Finite sets in a sigma type

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

This file defines a few `finset` constructions on `Σ i, α i`.

## Main declarations

* `finset.sigma`: Given a finset `s` in `ι` and finsets `t i` in each `α i`, `s.sigma t` is the
  finset of the dependent sum `Σ i, α i`
* `finset.sigma_lift`: Lifts maps `α i → β i → finset (γ i)` to a map
  `Σ i, α i → Σ i, β i → finset (Σ i, γ i)`.

## TODO

`finset.sigma_lift` can be generalized to any alternative functor. But to make the generalization
worth it, we must first refactor the functor library so that the `alternative` instance for `finset`
is computable and universe-polymorphic.
-/

open function multiset

variables {ι : Type*}

namespace finset
section sigma
variables {α : ι → Type*} {β : Type*} (s s₁ s₂ : finset ι) (t t₁ t₂ : Π i, finset (α i))

/-- `s.sigma t` is the finset of dependent pairs `⟨i, a⟩` such that `i ∈ s` and `a ∈ t i`. -/
protected def sigma : finset (Σ i, α i) := ⟨_, s.nodup.sigma $ λ i, (t i).nodup⟩

variables {s s₁ s₂ t t₁ t₂}

@[simp] lemma mem_sigma {a : Σ i, α i} : a ∈ s.sigma t ↔ a.1 ∈ s ∧ a.2 ∈ t a.1 := mem_sigma

@[simp, norm_cast] lemma coe_sigma (s : finset ι) (t : Π i, finset (α i)) :
  (s.sigma t : set (Σ i, α i)) = (s : set ι).sigma (λ i, t i) :=
set.ext $ λ _, mem_sigma

@[simp] lemma sigma_nonempty : (s.sigma t).nonempty ↔ ∃ i ∈ s, (t i).nonempty :=
by simp [finset.nonempty]

@[simp] lemma sigma_eq_empty : s.sigma t = ∅ ↔ ∀ i ∈ s, t i = ∅ :=
by simp only [← not_nonempty_iff_eq_empty, sigma_nonempty, not_exists]

@[mono] lemma sigma_mono (hs : s₁ ⊆ s₂) (ht : ∀ i, t₁ i ⊆ t₂ i) : s₁.sigma t₁ ⊆ s₂.sigma t₂ :=
λ ⟨i, a⟩ h, let ⟨hi, ha⟩ := mem_sigma.1 h in mem_sigma.2 ⟨hs hi, ht i ha⟩

lemma pairwise_disjoint_map_sigma_mk :
  (s : set ι).pairwise_disjoint (λ i, (t i).map (embedding.sigma_mk i)) :=
begin
  intros i hi j hj hij,
  rw [function.on_fun, disjoint_left],
  simp_rw [mem_map, function.embedding.sigma_mk_apply],
  rintros _ ⟨y, hy, rfl⟩ ⟨z, hz, hz'⟩,
  exact hij (congr_arg sigma.fst hz'.symm)
end

@[simp]
lemma disj_Union_map_sigma_mk :
  s.disj_Union (λ i, (t i).map (embedding.sigma_mk i))
    pairwise_disjoint_map_sigma_mk = s.sigma t := rfl

lemma sigma_eq_bUnion [decidable_eq (Σ i, α i)] (s : finset ι) (t : Π i, finset (α i)) :
  s.sigma t = s.bUnion (λ i, (t i).map $ embedding.sigma_mk i) :=
by { ext ⟨x, y⟩, simp [and.left_comm] }

variables (s t) (f : (Σ i, α i) → β)

lemma sup_sigma [semilattice_sup β] [order_bot β] :
  (s.sigma t).sup f = s.sup (λ i, (t i).sup $ λ b, f ⟨i, b⟩) :=
begin
  simp only [le_antisymm_iff, finset.sup_le_iff, mem_sigma, and_imp, sigma.forall],
  exact ⟨λ i a hi ha, (le_sup hi).trans' $ le_sup ha, λ i hi a ha, le_sup $ mem_sigma.2 ⟨hi, ha⟩⟩,
end

lemma inf_sigma [semilattice_inf β] [order_top β] :
  (s.sigma t).inf f = s.inf (λ i, (t i).inf $ λ b, f ⟨i, b⟩) :=
@sup_sigma _ _ βᵒᵈ _ _ _ _ _

end sigma

section sigma_lift
variables {α β γ : ι → Type*} [decidable_eq ι]

/-- Lifts maps `α i → β i → finset (γ i)` to a map `Σ i, α i → Σ i, β i → finset (Σ i, γ i)`. -/
def sigma_lift (f : Π ⦃i⦄, α i → β i → finset (γ i)) (a : sigma α) (b : sigma β) :
  finset (sigma γ) :=
dite (a.1 = b.1) (λ h, (f (h.rec a.2) b.2).map $ embedding.sigma_mk _) (λ _, ∅)

lemma mem_sigma_lift (f : Π ⦃i⦄, α i → β i → finset (γ i))
  (a : sigma α) (b : sigma β) (x : sigma γ) :
  x ∈ sigma_lift f a b ↔ ∃ (ha : a.1 = x.1) (hb : b.1 = x.1), x.2 ∈ f (ha.rec a.2) (hb.rec b.2) :=
begin
  obtain ⟨⟨i, a⟩, j, b⟩ := ⟨a, b⟩,
  obtain rfl | h := decidable.eq_or_ne i j,
  { split,
    { simp_rw [sigma_lift, dif_pos rfl, mem_map, embedding.sigma_mk_apply],
      rintro ⟨x, hx, rfl⟩,
      exact ⟨rfl, rfl, hx⟩ },
    { rintro ⟨⟨⟩, ⟨⟩, hx⟩,
      rw [sigma_lift, dif_pos rfl, mem_map],
      exact ⟨_, hx, by simp [sigma.ext_iff]⟩ } },
  { rw [sigma_lift, dif_neg h],
    refine iff_of_false (not_mem_empty _) _,
    rintro ⟨⟨⟩, ⟨⟩, _⟩,
    exact h rfl }
end

lemma mk_mem_sigma_lift (f : Π ⦃i⦄, α i → β i → finset (γ i)) (i : ι) (a : α i) (b : β i)
  (x : γ i) :
  (⟨i, x⟩ : sigma γ) ∈ sigma_lift f ⟨i, a⟩ ⟨i, b⟩ ↔ x ∈ f a b :=
begin
  rw [sigma_lift, dif_pos rfl, mem_map],
  refine ⟨_, λ hx, ⟨_, hx, rfl⟩⟩,
  rintro ⟨x, hx, _, rfl⟩,
  exact hx,
end

lemma not_mem_sigma_lift_of_ne_left (f : Π ⦃i⦄, α i → β i → finset (γ i))
  (a : sigma α) (b : sigma β) (x : sigma γ) (h : a.1 ≠ x.1) :
  x ∉ sigma_lift f a b :=
by { rw mem_sigma_lift, exact λ H, h H.fst }

lemma not_mem_sigma_lift_of_ne_right (f : Π ⦃i⦄, α i → β i → finset (γ i))
  {a : sigma α} (b : sigma β) {x : sigma γ} (h : b.1 ≠ x.1) :
  x ∉ sigma_lift f a b :=
by { rw mem_sigma_lift, exact λ H, h H.snd.fst }

variables {f g : Π ⦃i⦄, α i → β i → finset (γ i)} {a : Σ i, α i} {b : Σ i, β i}

lemma sigma_lift_nonempty :
  (sigma_lift f a b).nonempty ↔ ∃ h : a.1 = b.1, (f (h.rec a.2) b.2).nonempty :=
begin
  simp_rw nonempty_iff_ne_empty,
  convert dite_ne_right_iff,
  ext h,
  simp_rw ←nonempty_iff_ne_empty,
  exact map_nonempty.symm,
end

lemma sigma_lift_eq_empty : (sigma_lift f a b) = ∅ ↔ ∀ h : a.1 = b.1, (f (h.rec a.2) b.2) = ∅ :=
begin
  convert dite_eq_right_iff,
  exact forall_congr_eq (λ h, propext map_eq_empty.symm),
end

lemma sigma_lift_mono (h : ∀ ⦃i⦄ ⦃a : α i⦄ ⦃b : β i⦄, f a b ⊆ g a b) (a : Σ i, α i) (b : Σ i, β i) :
  sigma_lift f a b ⊆ sigma_lift g a b :=
begin
  rintro x hx,
  rw mem_sigma_lift at ⊢ hx,
  obtain ⟨ha, hb, hx⟩ := hx,
  exact ⟨ha, hb, h hx⟩,
end

variables (f a b)

lemma card_sigma_lift :
  (sigma_lift f a b).card = dite (a.1 = b.1) (λ h, (f (h.rec a.2) b.2).card) (λ _, 0) :=
by { convert apply_dite _ _ _ _, ext h, exact (card_map _).symm }

end sigma_lift

end finset


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import topology.instances.int
/-!
# Topology on the natural numbers

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

The structure of a metric space on `ℕ` is introduced in this file, induced from `ℝ`.
-/
noncomputable theory
open metric set filter

namespace nat

noncomputable instance : has_dist ℕ := ⟨λ x y, dist (x : ℝ) y⟩

theorem dist_eq (x y : ℕ) : dist x y = |x - y| := rfl

lemma dist_coe_int (x y : ℕ) : dist (x : ℤ) (y : ℤ) = dist x y := rfl

@[norm_cast, simp] theorem dist_cast_real (x y : ℕ) : dist (x : ℝ) y = dist x y := rfl

lemma pairwise_one_le_dist : pairwise (λ m n : ℕ, 1 ≤ dist m n) :=
begin
  intros m n hne,
  rw ← dist_coe_int,
  apply int.pairwise_one_le_dist,
  exact_mod_cast hne
end

lemma uniform_embedding_coe_real : uniform_embedding (coe : ℕ → ℝ) :=
uniform_embedding_bot_of_pairwise_le_dist zero_lt_one pairwise_one_le_dist

lemma closed_embedding_coe_real : closed_embedding (coe : ℕ → ℝ) :=
closed_embedding_of_pairwise_le_dist zero_lt_one pairwise_one_le_dist

instance : metric_space ℕ := nat.uniform_embedding_coe_real.comap_metric_space _

theorem preimage_closed_ball (x : ℕ) (r : ℝ) :
  coe ⁻¹' (closed_ball (x : ℝ) r) = closed_ball x r := rfl

theorem closed_ball_eq_Icc (x : ℕ) (r : ℝ) :
  closed_ball x r = Icc ⌈↑x - r⌉₊ ⌊↑x + r⌋₊ :=
begin
  rcases le_or_lt 0 r with hr|hr,
  { rw [← preimage_closed_ball, real.closed_ball_eq_Icc, preimage_Icc],
    exact add_nonneg (cast_nonneg x) hr },
  { rw closed_ball_eq_empty.2 hr,
    apply (Icc_eq_empty _).symm,
    rw not_le,
    calc ⌊(x : ℝ) + r⌋₊ ≤ ⌊(x : ℝ)⌋₊ : by { apply floor_mono, linarith }
    ... < ⌈↑x - r⌉₊ : by { rw [floor_coe, nat.lt_ceil], linarith } }
end

instance : proper_space ℕ :=
⟨ begin
    intros x r,
    rw closed_ball_eq_Icc,
    exact (set.finite_Icc _ _).is_compact,
  end ⟩

instance : noncompact_space ℕ :=
noncompact_space_of_ne_bot $ by simp [filter.at_top_ne_bot]

end nat


import data.list

namespace listplayground

example (l : list ℕ) (hl : list.sorted nat.lt l) (hl' : l ≠ []) : list.sorted nat.lt l.tail :=
list.sorted.tail hl

example (l : list ℕ) (h : l ≠ []) : l = l.head :: l.tail := (list.cons_head_tail h).symm

-- surprised this isn't in mathlib... maybe bc this is too simple or something similar is?
-- either in head or tail
example (l : list ℕ) (a ∈ l) : a = l.head ∨ a ∈ l.tail :=
begin
  induction l,
  { right,
    exact H },
  { cases H,
    { left,
      exact H },
    { right,
      exact H } }
end

-- ahah this version is more succinct
example (l : list ℕ) (h : l ≠ []) (a ∈ l) : a = l.head ∨ a ∈ l.tail :=
begin
  rw (list.cons_head_tail h).symm at H,
  exact (list.mem_cons_iff a (list.head l) (list.tail l)).mp H,
end

-- cons smol is still sorted in lt order
lemma cons_smol_sorted (l : list ℕ) (hl : list.sorted nat.lt l) (hl' : l ≠ []) (a : ℕ) (h : a < l.head) :
list.sorted nat.lt (a :: l) :=
begin
  rw list.sorted_cons,
  split,
  { intros b hb,
    rw <- list.cons_head_tail hl' at hl,
    have hb' := list.rel_of_sorted_cons hl,
    rw (list.cons_head_tail hl').symm at hb,
    rw list.mem_cons_iff b (list.head l) (list.tail l) at hb,
    cases hb,
    { rwa hb },
    { specialize hb' b hb,
      exact lt_trans h hb' } },
  { exact hl }
end

example (a : ℕ) : list.sorted nat.lt (a :: []) :=
begin
  exact list.sorted_singleton a,
end

example (a : ℕ) : [a] = a :: [] := rfl

example (l : list ℕ) (h : l ≠ []) : ∃ x, x ∈ l :=
begin
  use l.head,
  exact list.mem_of_mem_head' (list.head_mem_head' h),
end

example (l : list ℕ) (h : ∀ x x' ∈ l, x ≠ x') : l = [] :=
begin
  contrapose! h,
  use [l.head, l.head],
  repeat { split, exact list.mem_of_mem_head' (list.head_mem_head' h) },
  refl,
end

example (l l' t : list ℕ) (h : l ~ l') : l ++ t ~ t ++ l' :=
begin
  calc l ++ t ~ t ++ l : list.perm_append_comm
       ... ~ t ++ l' : list.perm.append_left t h,
end

example (l : list ℕ) (a : ℕ) : list.cons a l  = [a] ++ l := list.singleton_append.symm

-- TODO define as appending all lists together
def flatten_lists : list (list ℕ) → list ℕ
| list.nil := list.nil
| [list.nil] := list.nil
| [h :: x] := h :: x
| sorry

example (l l' : list (list ℕ)) (h : l ~ l') : flatten_lists l ~ flatten_lists l' :=
begin
  sorry
end

example (a : ℕ) (l l' : list ℕ) : list.cons a (l ++ l') = a :: l ++ l' := (list.cons_append a l l').symm

end listplayground